/******************************************************* NAME : CheckDeffunctionCall DESCRIPTION : Checks the number of arguments passed to a deffunction INPUTS : 1) Deffunction pointer 2) The number of arguments RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Message printed on errors NOTES : None *******************************************************/ globle int CheckDeffunctionCall( void *theEnv, void *vdptr, int args) { DEFFUNCTION *dptr; if (vdptr == NULL) return(FALSE); dptr = (DEFFUNCTION *) vdptr; if (args < dptr->minNumberOfParameters) { if (dptr->maxNumberOfParameters == -1) ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr), AT_LEAST,dptr->minNumberOfParameters); else ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr), EXACTLY,dptr->minNumberOfParameters); return(FALSE); } else if ((args > dptr->minNumberOfParameters) && (dptr->maxNumberOfParameters != -1)) { ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr), EXACTLY,dptr->minNumberOfParameters); return(FALSE); } return(TRUE); }
/*************************************************** NAME : RemoveAllDeffunctions DESCRIPTION : Removes all deffunctions INPUTS : None RETURNS : TRUE if all deffunctions removed, FALSE otherwise SIDE EFFECTS : Deffunctions removed NOTES : None ***************************************************/ static intBool RemoveAllDeffunctions( void *theEnv, EXEC_STATUS) { DEFFUNCTION *dptr,*dtmp; unsigned oldbusy; intBool success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv,execStatus) == TRUE) return(FALSE); #endif dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL); while (dptr != NULL) { if (dptr->executing > 0) { DeffunctionDeleteError(theEnv,execStatus,EnvGetDeffunctionName(theEnv,execStatus,(void *) dptr)); success = FALSE; } else { oldbusy = dptr->busy; ExpressionDeinstall(theEnv,execStatus,dptr->code); dptr->busy = oldbusy; ReturnPackedExpression(theEnv,execStatus,dptr->code); dptr->code = NULL; } dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr); } dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL); while (dptr != NULL) { dtmp = dptr; dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr); if (dtmp->executing == 0) { if (dtmp->busy > 0) { PrintWarningID(theEnv,execStatus,"DFFNXFUN",1,FALSE); EnvPrintRouter(theEnv,execStatus,WWARNING,"Deffunction "); EnvPrintRouter(theEnv,execStatus,WWARNING,EnvGetDeffunctionName(theEnv,execStatus,(void *) dtmp)); EnvPrintRouter(theEnv,execStatus,WWARNING," only partially deleted due to usage by other constructs.\n"); SetDeffunctionPPForm((void *) dtmp,NULL); success = FALSE; } else { RemoveConstructFromModule(theEnv,execStatus,(struct constructHeader *) dtmp); RemoveDeffunction(theEnv,execStatus,dtmp); } } } return(success); }
std::string Function::name( ) { if ( m_cobj ) return EnvGetDeffunctionName( m_environment.cobj(), m_cobj ); else return std::string(); }
/*************************************************** NAME : SaveDeffunctionHeader DESCRIPTION : Writes a deffunction forward declaration to the save file INPUTS : 1) The deffunction 2) The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : Defffunction header written NOTES : None ***************************************************/ static void SaveDeffunctionHeader( void *theEnv, struct constructHeader *theDeffunction, void *userBuffer) { DEFFUNCTION *dfnxPtr = (DEFFUNCTION *) theDeffunction; char *logicalName = (char *) userBuffer; register int i; if (EnvGetDeffunctionPPForm(theEnv,(void *) dfnxPtr) != NULL) { EnvPrintRouter(theEnv,logicalName,(char*)"(deffunction "); EnvPrintRouter(theEnv,logicalName,EnvDeffunctionModule(theEnv,(void *) dfnxPtr)); EnvPrintRouter(theEnv,logicalName,(char*)"::"); EnvPrintRouter(theEnv,logicalName,EnvGetDeffunctionName(theEnv,(void *) dfnxPtr)); EnvPrintRouter(theEnv,logicalName,(char*)" ("); for (i = 0 ; i < dfnxPtr->minNumberOfParameters ; i++) { EnvPrintRouter(theEnv,logicalName,(char*)"?p"); PrintLongInteger(theEnv,logicalName,(long long) i); if (i != dfnxPtr->minNumberOfParameters-1) EnvPrintRouter(theEnv,logicalName,(char*)" "); } if (dfnxPtr->maxNumberOfParameters == -1) { if (dfnxPtr->minNumberOfParameters != 0) EnvPrintRouter(theEnv,logicalName,(char*)" "); EnvPrintRouter(theEnv,logicalName,(char*)"$?wildargs))\n\n"); } else EnvPrintRouter(theEnv,logicalName,(char*)"))\n\n"); } }
/******************************************************* NAME : UnboundDeffunctionErr DESCRIPTION : Print out a synopis of the currently executing deffunction for unbound variable errors INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Error synopsis printed to WERROR NOTES : None *******************************************************/ static void UnboundDeffunctionErr( void *theEnv) { EnvPrintRouter(theEnv,WERROR,"deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) DeffunctionData(theEnv)->ExecutingDeffunction)); EnvPrintRouter(theEnv,WERROR,".\n"); }
/*************************************************** NAME : PrintDeffunctionCall DESCRIPTION : PrintExpression() support function for deffunction calls INPUTS : 1) The output logical name 2) The deffunction RETURNS : Nothing useful SIDE EFFECTS : Call expression printed NOTES : None ***************************************************/ static void PrintDeffunctionCall( void *theEnv, char *logName, void *value) { #if DEVELOPER EnvPrintRouter(theEnv,logName,(char*)"("); EnvPrintRouter(theEnv,logName,EnvGetDeffunctionName(theEnv,value)); if (GetFirstArgument() != NULL) { EnvPrintRouter(theEnv,logName,(char*)" "); PrintExpression(theEnv,logName,GetFirstArgument()); } EnvPrintRouter(theEnv,logName,(char*)")"); #else #endif }
static void PrintDeffunctionCall( void *theEnv, EXEC_STATUS, char *logName, void *value) { #if DEVELOPER EnvPrintRouter(theEnv,execStatus,logName,"("); EnvPrintRouter(theEnv,execStatus,logName,EnvGetDeffunctionName(theEnv,execStatus,value)); if (GetFirstArgument() != NULL) { EnvPrintRouter(theEnv,execStatus,logName," "); PrintExpression(theEnv,execStatus,logName,GetFirstArgument()); } EnvPrintRouter(theEnv,execStatus,logName,")"); #else #if MAC_MCW || WIN_MCW || MAC_XCD #pragma unused(theEnv,execStatus) #pragma unused(logName) #pragma unused(value) #endif #endif }
EXPORT void* STDCALL EnvGetDeffunctionName2(void* env, void* ptr) { return EnvGetDeffunctionName(env, ptr); }
static void OutputConstructsCodeInfo( void *theEnv) { #if (! DEFFUNCTION_CONSTRUCT) && (! DEFGENERIC_CONSTRUCT) && (! OBJECT_SYSTEM) && (! DEFRULE_CONSTRUCT) #pragma unused(theEnv) #endif #if DEFFUNCTION_CONSTRUCT DEFFUNCTION *theDeffunction; #endif #if DEFRULE_CONSTRUCT struct defrule *theDefrule; #endif #if DEFGENERIC_CONSTRUCT DEFGENERIC *theDefgeneric; DEFMETHOD *theMethod; unsigned methodIndex; char methodBuffer[512]; #endif #if OBJECT_SYSTEM DEFCLASS *theDefclass; HANDLER *theHandler; unsigned handlerIndex; #endif #if DEFGENERIC_CONSTRUCT || OBJECT_SYSTEM char *prefix, *prefixBefore, *prefixAfter; #endif char *banner; banner = "\n*** Deffunctions ***\n\n"; #if DEFFUNCTION_CONSTRUCT for (theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL); theDeffunction != NULL; theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,theDeffunction)) { OutputProfileInfo(theEnv,EnvGetDeffunctionName(theEnv,theDeffunction), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDeffunction->header.usrData), NULL,NULL,NULL,&banner); } #endif banner = "\n*** Defgenerics ***\n"; #if DEFGENERIC_CONSTRUCT for (theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); theDefgeneric != NULL; theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,theDefgeneric)) { prefixBefore = "\n"; prefix = EnvGetDefgenericName(theEnv,theDefgeneric); prefixAfter = "\n"; for (methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,0); methodIndex != 0; methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,methodIndex)) { theMethod = GetDefmethodPointer(theDefgeneric,methodIndex); EnvGetDefmethodDescription(theEnv,methodBuffer,510,theDefgeneric,methodIndex); if (OutputProfileInfo(theEnv,methodBuffer, (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theMethod->usrData), prefixBefore,prefix,prefixAfter,&banner)) { prefixBefore = NULL; prefix = NULL; prefixAfter = NULL; } } } #endif banner = "\n*** Defclasses ***\n"; #if OBJECT_SYSTEM for (theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL); theDefclass != NULL; theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,theDefclass)) { prefixAfter = "\n"; prefix = EnvGetDefclassName(theEnv,theDefclass); prefixBefore = "\n"; for (handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,0); handlerIndex != 0; handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,handlerIndex)) { theHandler = GetDefmessageHandlerPointer(theDefclass,handlerIndex); if (OutputProfileInfo(theEnv,EnvGetDefmessageHandlerName(theEnv,theDefclass,handlerIndex), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID, theHandler->usrData), prefixBefore,prefix,prefixAfter,&banner)) { prefixBefore = NULL; prefix = NULL; prefixAfter = NULL; } } } #endif banner = "\n*** Defrules ***\n\n"; #if DEFRULE_CONSTRUCT for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theDefrule != NULL; theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule)) { OutputProfileInfo(theEnv,EnvGetDefruleName(theEnv,theDefrule), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDefrule->header.usrData), NULL,NULL,NULL,&banner); } #endif }
/************************************************************ NAME : ValidDeffunctionName DESCRIPTION : Determines if a new deffunction of the given name can be defined in the current module INPUTS : The new deffunction name RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Error message printed if not OK NOTES : GetConstructNameAndComment() (called before this function) ensures that the deffunction name does not conflict with one from another module ************************************************************/ static BOOLEAN ValidDeffunctionName( void *theEnv, char *theDeffunctionName) { struct constructHeader *theDeffunction; #if DEFGENERIC_CONSTRUCT struct defmodule *theModule; struct constructHeader *theDefgeneric; #endif /* ============================================ A deffunction cannot be named the same as a construct type, e.g, defclass, defrule, etc. ============================================ */ if (FindConstruct(theEnv,theDeffunctionName) != NULL) { PrintErrorID(theEnv,"DFFNXPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace constructs.\n"); return(FALSE); } /* ============================================ A deffunction cannot be named the same as a pre-defined system function, e.g, watch, list-defrules, etc. ============================================ */ if (FindFunction(theEnv,theDeffunctionName) != NULL) { PrintErrorID(theEnv,"DFFNXPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace external functions.\n"); return(FALSE); } #if DEFGENERIC_CONSTRUCT /* ============================================ A deffunction cannot be named the same as a generic function (either in this module or imported from another) ============================================ */ theDefgeneric = (struct constructHeader *) LookupDefgenericInScope(theEnv,theDeffunctionName); if (theDefgeneric != NULL) { theModule = GetConstructModuleItem(theDefgeneric)->theModule; if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { PrintErrorID(theEnv,"DFFNXPSR",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Defgeneric "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) theDefgeneric)); EnvPrintRouter(theEnv,WERROR," imported from module "); EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,WERROR," conflicts with this deffunction.\n"); return(FALSE); } else { PrintErrorID(theEnv,"DFFNXPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace generic functions.\n"); } return(FALSE); } #endif theDeffunction = (struct constructHeader *) EnvFindDeffunction(theEnv,theDeffunctionName); if (theDeffunction != NULL) { /* =========================================== And a deffunction in the current module can only be redefined if it is not executing. =========================================== */ if (((DEFFUNCTION *) theDeffunction)->executing) { PrintErrorID(theEnv,"DFNXPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction)); EnvPrintRouter(theEnv,WERROR," may not be redefined while it is executing.\n"); return(FALSE); } } return(TRUE); }
globle void FuncallFunction( void *theEnv, DATA_OBJECT *returnValue) { int argCount, i, j; DATA_OBJECT theValue; FUNCTION_REFERENCE theReference; char *name; struct multifield *theMultifield; struct expr *lastAdd = NULL, *nextAdd, *multiAdd; /*==================================*/ /* Set up the default return value. */ /*==================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*=================================================*/ /* The funcall function has at least one argument: */ /* the name of the function being called. */ /*=================================================*/ if ((argCount = EnvArgCountCheck(theEnv,"funcall",AT_LEAST,1)) == -1) return; /*============================================*/ /* Get the name of the function to be called. */ /*============================================*/ if (EnvArgTypeCheck(theEnv,"funcall",1,SYMBOL_OR_STRING,&theValue) == FALSE) { return; } /*====================*/ /* Find the function. */ /*====================*/ name = DOToString(theValue); if (! GetFunctionReference(theEnv,name,&theReference)) { ExpectedTypeError1(theEnv,"funcall",1,"function, deffunction, or generic function name"); return; } ExpressionInstall(theEnv,&theReference); /*======================================*/ /* Add the arguments to the expression. */ /*======================================*/ for (i = 2; i <= argCount; i++) { EnvRtnUnknown(theEnv,i,&theValue); if (GetEvaluationError(theEnv)) { ExpressionDeinstall(theEnv,&theReference); return; } switch(GetType(theValue)) { case MULTIFIELD: nextAdd = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$")); if (lastAdd == NULL) { theReference.argList = nextAdd; } else { lastAdd->nextArg = nextAdd; } lastAdd = nextAdd; multiAdd = NULL; theMultifield = (struct multifield *) GetValue(theValue); for (j = GetDOBegin(theValue); j <= GetDOEnd(theValue); j++) { nextAdd = GenConstant(theEnv,GetMFType(theMultifield,j),GetMFValue(theMultifield,j)); if (multiAdd == NULL) { lastAdd->argList = nextAdd; } else { multiAdd->nextArg = nextAdd; } multiAdd = nextAdd; } ExpressionInstall(theEnv,lastAdd); break; default: nextAdd = GenConstant(theEnv,GetType(theValue),GetValue(theValue)); if (lastAdd == NULL) { theReference.argList = nextAdd; } else { lastAdd->nextArg = nextAdd; } lastAdd = nextAdd; ExpressionInstall(theEnv,lastAdd); break; } } /*===========================================================*/ /* Verify a deffunction has the correct number of arguments. */ /*===========================================================*/ #if DEFFUNCTION_CONSTRUCT if (theReference.type == PCALL) { if (CheckDeffunctionCall(theEnv,theReference.value,CountArguments(theReference.argList)) == FALSE) { PrintErrorID(theEnv,"MISCFUN",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Function funcall called with the wrong number of arguments for deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,theReference.value)); EnvPrintRouter(theEnv,WERROR,"\n"); ExpressionDeinstall(theEnv,&theReference); ReturnExpression(theEnv,theReference.argList); return; } } #endif /*======================*/ /* Call the expression. */ /*======================*/ EvaluateExpression(theEnv,&theReference,returnValue); /*========================================*/ /* Return the expression data structures. */ /*========================================*/ ExpressionDeinstall(theEnv,&theReference); ReturnExpression(theEnv,theReference.argList); }
globle const char *GetDeffunctionName( void *theDeffunction) { return EnvGetDeffunctionName(GetCurrentEnvironment(),theDeffunction); }
/**************************************************** NAME : CallDeffunction DESCRIPTION : Executes the body of a deffunction INPUTS : 1) The deffunction 2) Argument expressions 3) Data object buffer to hold result RETURNS : Nothing useful SIDE EFFECTS : Deffunction executed and result stored in data object buffer NOTES : Used in EvaluateExpression(theEnv,) ****************************************************/ globle void CallDeffunction( void *theEnv, DEFFUNCTION *dptr, EXPRESSION *args, DATA_OBJECT *result) { int oldce; DEFFUNCTION *previouslyExecutingDeffunction; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); EvaluationData(theEnv)->EvaluationError = FALSE; if (EvaluationData(theEnv)->HaltExecution) return; oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); previouslyExecutingDeffunction = DeffunctionData(theEnv)->ExecutingDeffunction; DeffunctionData(theEnv)->ExecutingDeffunction = dptr; EvaluationData(theEnv)->CurrentEvaluationDepth++; dptr->executing++; PushProcParameters(theEnv,args,CountArguments(args),EnvGetDeffunctionName(theEnv,(void *) dptr), "deffunction",UnboundDeffunctionErr); if (EvaluationData(theEnv)->EvaluationError) { dptr->executing--; DeffunctionData(theEnv)->ExecutingDeffunction = previouslyExecutingDeffunction; EvaluationData(theEnv)->CurrentEvaluationDepth--; RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); return; } #if DEBUGGING_FUNCTIONS if (dptr->trace) WatchDeffunction(theEnv,BEGIN_TRACE); #endif #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &dptr->header.usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,dptr->header.whichModule->theModule, dptr->code,dptr->numberOfLocalVars, result,UnboundDeffunctionErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif #if DEBUGGING_FUNCTIONS if (dptr->trace) WatchDeffunction(theEnv,END_TRACE); #endif ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; dptr->executing--; PopProcParameters(theEnv); DeffunctionData(theEnv)->ExecutingDeffunction = previouslyExecutingDeffunction; EvaluationData(theEnv)->CurrentEvaluationDepth--; RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); }