/************************************************************* NAME : PreviewGeneric DESCRIPTION : Allows the user to see a printout of all the applicable methods for a particular generic function call INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments and evaluating query-functions to determine the set of applicable methods NOTES : H/L Syntax: (preview-generic <func> <args>) *************************************************************/ globle void PreviewGeneric( void *theEnv, EXEC_STATUS) { DEFGENERIC *gfunc; DEFGENERIC *previousGeneric; int oldce; DATA_OBJECT temp; execStatus->EvaluationError = FALSE; if (EnvArgTypeCheck(theEnv,execStatus,"preview-generic",1,SYMBOL,&temp) == FALSE) return; gfunc = LookupDefgenericByMdlOrScope(theEnv,execStatus,DOToString(temp)); if (gfunc == NULL) { PrintErrorID(theEnv,execStatus,"GENRCFUN",3,FALSE); EnvPrintRouter(theEnv,execStatus,WERROR,"Unable to find generic function "); EnvPrintRouter(theEnv,execStatus,WERROR,DOToString(temp)); EnvPrintRouter(theEnv,execStatus,WERROR," in function preview-generic.\n"); return; } oldce = ExecutingConstruct(theEnv,execStatus); SetExecutingConstruct(theEnv,execStatus,TRUE); previousGeneric = DefgenericData(theEnv,execStatus)->CurrentGeneric; DefgenericData(theEnv,execStatus)->CurrentGeneric = gfunc; execStatus->CurrentEvaluationDepth++; PushProcParameters(theEnv,execStatus,GetFirstArgument()->nextArg, CountArguments(GetFirstArgument()->nextArg), EnvGetDefgenericName(theEnv,execStatus,(void *) gfunc),"generic function", UnboundMethodErr); if (execStatus->EvaluationError) { PopProcParameters(theEnv,execStatus); DefgenericData(theEnv,execStatus)->CurrentGeneric = previousGeneric; execStatus->CurrentEvaluationDepth--; SetExecutingConstruct(theEnv,execStatus,oldce); return; } gfunc->busy++; DisplayGenericCore(theEnv,execStatus,gfunc); gfunc->busy--; PopProcParameters(theEnv,execStatus); DefgenericData(theEnv,execStatus)->CurrentGeneric = previousGeneric; execStatus->CurrentEvaluationDepth--; SetExecutingConstruct(theEnv,execStatus,oldce); }
/************************************************************* NAME : PreviewGeneric DESCRIPTION : Allows the user to see a printout of all the applicable methods for a particular generic function call INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments and evaluating query-functions to determine the set of applicable methods NOTES : H/L Syntax: (preview-generic <func> <args>) *************************************************************/ globle void PreviewGeneric() { DEFGENERIC *gfunc; DEFGENERIC *previousGeneric; int oldce; DATA_OBJECT temp; EvaluationError = FALSE; if (ArgTypeCheck("preview-generic",1,SYMBOL,&temp) == FALSE) return; gfunc = LookupDefgenericByMdlOrScope(DOToString(temp)); if (gfunc == NULL) { PrintErrorID("GENRCFUN",3,FALSE); PrintRouter(WERROR,"Unable to find generic function "); PrintRouter(WERROR,DOToString(temp)); PrintRouter(WERROR," in function preview-generic.\n"); return; } oldce = ExecutingConstruct(); SetExecutingConstruct(TRUE); previousGeneric = CurrentGeneric; CurrentGeneric = gfunc; CurrentEvaluationDepth++; PushProcParameters(GetFirstArgument()->nextArg, CountArguments(GetFirstArgument()->nextArg), GetDefgenericName((void *) gfunc),"generic function", UnboundMethodErr); if (EvaluationError) { PopProcParameters(); CurrentGeneric = previousGeneric; CurrentEvaluationDepth--; SetExecutingConstruct(oldce); return; } gfunc->busy++; DisplayGenericCore(gfunc); gfunc->busy--; PopProcParameters(); CurrentGeneric = previousGeneric; CurrentEvaluationDepth--; SetExecutingConstruct(oldce); }
/*********************************************************************************** NAME : GenericDispatch DESCRIPTION : Executes the most specific applicable method INPUTS : 1) The generic function 2) The method to start after in the search for an applicable method (ignored if arg #3 is not NULL). 3) A specific method to call (NULL if want highest precedence method to be called) 4) The generic function argument expressions 5) The caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments Any side-effects of evaluating query functions on method parameter restrictions when determining the core (see warning #1) Any side-effects of actual execution of methods (see warning #2) Caller's buffer set to the result of the generic function call In case of errors, the result is false, otherwise it is the result returned by the most specific method (which can choose to ignore or return the values of more general methods) NOTES : WARNING #1: Query functions on method parameter restrictions should not have side-effects, for they might be evaluated even for methods that aren't applicable to the generic function call. WARNING #2: Side-effects of method execution should not always rely on only being executed once per generic function call. Every time a method calls (shadow-call) the same next-most-specific method is executed. Thus, it is possible for a method to be executed multiple times per generic function call. ***********************************************************************************/ void GenericDispatch( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *prevmeth, DEFMETHOD *meth, EXPRESSION *params, DATA_OBJECT *result) { DEFGENERIC *previousGeneric; DEFMETHOD *previousMethod; int oldce; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif struct CLIPSBlock gcBlock; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); EvaluationData(theEnv)->EvaluationError = false; if (EvaluationData(theEnv)->HaltExecution) return; CLIPSBlockStart(theEnv,&gcBlock); oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,true); previousGeneric = DefgenericData(theEnv)->CurrentGeneric; previousMethod = DefgenericData(theEnv)->CurrentMethod; DefgenericData(theEnv)->CurrentGeneric = gfunc; EvaluationData(theEnv)->CurrentEvaluationDepth++; gfunc->busy++; PushProcParameters(theEnv,params,CountArguments(params), EnvGetDefgenericName(theEnv,(void *) gfunc), "generic function",UnboundMethodErr); if (EvaluationData(theEnv)->EvaluationError) { gfunc->busy--; DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; CLIPSBlockEnd(theEnv,&gcBlock,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); return; } if (meth != NULL) { if (IsMethodApplicable(theEnv,meth)) { meth->busy++; DefgenericData(theEnv)->CurrentMethod = meth; } else { PrintErrorID(theEnv,"GENRCEXE",4,false); EnvSetEvaluationError(theEnv,true); DefgenericData(theEnv)->CurrentMethod = NULL; EnvPrintRouter(theEnv,WERROR,"Generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR," method #"); PrintLongInteger(theEnv,WERROR,(long long) meth->index); EnvPrintRouter(theEnv,WERROR," is not applicable to the given arguments.\n"); } } else DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,gfunc,prevmeth); if (DefgenericData(theEnv)->CurrentMethod != NULL) { #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,BEGIN_TRACE); if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,BEGIN_TRACE); #endif if (DefgenericData(theEnv)->CurrentMethod->system) { EXPRESSION fcall; fcall.type = FCALL; fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value; fcall.nextArg = NULL; fcall.argList = GetProcParamExpressions(theEnv); EvaluateExpression(theEnv,&fcall,result); } else { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &DefgenericData(theEnv)->CurrentMethod->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule, DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount, result,UnboundMethodErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } DefgenericData(theEnv)->CurrentMethod->busy--; #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,END_TRACE); if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,END_TRACE); #endif } else if (! EvaluationData(theEnv)->EvaluationError) { PrintErrorID(theEnv,"GENRCEXE",1,false); EnvPrintRouter(theEnv,WERROR,"No applicable methods for "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR,".\n"); EnvSetEvaluationError(theEnv,true); } gfunc->busy--; ProcedureFunctionData(theEnv)->ReturnFlag = false; PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; CLIPSBlockEnd(theEnv,&gcBlock,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); }
/*********************************************************************************** NAME : GenericDispatch DESCRIPTION : Executes the most specific applicable method INPUTS : 1) The generic function 2) The method to start after in the search for an applicable method (ignored if arg #3 is not NULL). 3) A specific method to call (NULL if want highest precedence method to be called) 4) The generic function argument expressions 5) The caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments Any side-effects of evaluating query functions on method parameter restrictions when determining the core (see warning #1) Any side-effects of actual execution of methods (see warning #2) Caller's buffer set to the result of the generic function call In case of errors, the result is false, otherwise it is the result returned by the most specific method (which can choose to ignore or return the values of more general methods) NOTES : WARNING #1: Query functions on method parameter restrictions should not have side-effects, for they might be evaluated even for methods that aren't applicable to the generic function call. WARNING #2: Side-effects of method execution should not always rely on only being executed once per generic function call. Every time a method calls (shadow-call) the same next-most-specific method is executed. Thus, it is possible for a method to be executed multiple times per generic function call. ***********************************************************************************/ void GenericDispatch( Environment *theEnv, Defgeneric *gfunc, Defmethod *prevmeth, Defmethod *meth, Expression *params, UDFValue *returnValue) { Defgeneric *previousGeneric; Defmethod *previousMethod; bool oldce; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif GCBlock gcb; returnValue->value = FalseSymbol(theEnv); EvaluationData(theEnv)->EvaluationError = false; if (EvaluationData(theEnv)->HaltExecution) return; GCBlockStart(theEnv,&gcb); oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,true); previousGeneric = DefgenericData(theEnv)->CurrentGeneric; previousMethod = DefgenericData(theEnv)->CurrentMethod; DefgenericData(theEnv)->CurrentGeneric = gfunc; EvaluationData(theEnv)->CurrentEvaluationDepth++; gfunc->busy++; PushProcParameters(theEnv,params,CountArguments(params), DefgenericName(gfunc), "generic function",UnboundMethodErr); if (EvaluationData(theEnv)->EvaluationError) { gfunc->busy--; DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; GCBlockEndUDF(theEnv,&gcb,returnValue); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); return; } if (meth != NULL) { if (IsMethodApplicable(theEnv,meth)) { meth->busy++; DefgenericData(theEnv)->CurrentMethod = meth; } else { PrintErrorID(theEnv,"GENRCEXE",4,false); SetEvaluationError(theEnv,true); DefgenericData(theEnv)->CurrentMethod = NULL; WriteString(theEnv,STDERR,"Generic function '"); WriteString(theEnv,STDERR,DefgenericName(gfunc)); WriteString(theEnv,STDERR,"' method #"); PrintUnsignedInteger(theEnv,STDERR,meth->index); WriteString(theEnv,STDERR," is not applicable to the given arguments.\n"); } } else DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,gfunc,prevmeth); if (DefgenericData(theEnv)->CurrentMethod != NULL) { #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,BEGIN_TRACE); if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,BEGIN_TRACE); #endif if (DefgenericData(theEnv)->CurrentMethod->system) { Expression fcall; fcall.type = FCALL; fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value; fcall.nextArg = NULL; fcall.argList = GetProcParamExpressions(theEnv); EvaluateExpression(theEnv,&fcall,returnValue); } else { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &DefgenericData(theEnv)->CurrentMethod->header.usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule, DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount, returnValue,UnboundMethodErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } DefgenericData(theEnv)->CurrentMethod->busy--; #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,END_TRACE); if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,END_TRACE); #endif } else if (! EvaluationData(theEnv)->EvaluationError) { PrintErrorID(theEnv,"GENRCEXE",1,false); WriteString(theEnv,STDERR,"No applicable methods for '"); WriteString(theEnv,STDERR,DefgenericName(gfunc)); WriteString(theEnv,STDERR,"'.\n"); SetEvaluationError(theEnv,true); } gfunc->busy--; ProcedureFunctionData(theEnv)->ReturnFlag = false; PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; GCBlockEndUDF(theEnv,&gcb,returnValue); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); }
/***************************************************** NAME : PerformMessage DESCRIPTION : Calls core framework for a message INPUTS : 1) Caller's result buffer 2) Message argument expressions (including implicit object) 3) Message name RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of message execution and caller's result buffer set NOTES : None *****************************************************/ static void PerformMessage( DATA_OBJECT *result, EXPRESSION *args, SYMBOL_HN *mname) { int oldce; HANDLER_LINK *oldCore; DEFCLASS *cls = NULL; INSTANCE_TYPE *ins = NULL; SYMBOL_HN *oldName; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif result->type = SYMBOL; result->value = FalseSymbol; EvaluationError = FALSE; if (HaltExecution) return; oldce = ExecutingConstruct(); SetExecutingConstruct(TRUE); oldName = CurrentMessageName; CurrentMessageName = mname; CurrentEvaluationDepth++; PushProcParameters(args,CountArguments(args), ValueToString(CurrentMessageName),"message", UnboundHandlerErr); if (EvaluationError) { CurrentEvaluationDepth--; CurrentMessageName = oldName; PeriodicCleanup(FALSE,TRUE); SetExecutingConstruct(oldce); return; } if (ProcParamArray->type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) ProcParamArray->value; if (ins->garbage == 1) { StaleInstanceAddress("send",0); SetEvaluationError(TRUE); } else if (DefclassInScope(ins->cls,(struct defmodule *) GetCurrentModule()) == FALSE) NoInstanceError(ValueToString(ins->name),"send"); else { cls = ins->cls; ins->busy++; } } else if (ProcParamArray->type == INSTANCE_NAME) { ins = FindInstanceBySymbol((SYMBOL_HN *) ProcParamArray->value); if (ins == NULL) { PrintErrorID("MSGPASS",2,FALSE); PrintRouter(WERROR,"No such instance "); PrintRouter(WERROR,ValueToString((SYMBOL_HN *) ProcParamArray->value)); PrintRouter(WERROR," in function send.\n"); SetEvaluationError(TRUE); } else { ProcParamArray->value = (void *) ins; ProcParamArray->type = INSTANCE_ADDRESS; cls = ins->cls; ins->busy++; } } else if ((cls = PrimitiveClassMap[ProcParamArray->type]) == NULL) { SystemError("MSGPASS",1); ExitRouter(EXIT_FAILURE); } if (EvaluationError) { PopProcParameters(); CurrentEvaluationDepth--; CurrentMessageName = oldName; PeriodicCleanup(FALSE,TRUE); SetExecutingConstruct(oldce); return; } oldCore = TopOfCore; TopOfCore = FindApplicableHandlers(cls,mname); if (TopOfCore != NULL) { HANDLER_LINK *oldCurrent,*oldNext; oldCurrent = CurrentCore; oldNext = NextInCore; #if IMPERATIVE_MESSAGE_HANDLERS if (TopOfCore->hnd->type == MAROUND) { CurrentCore = TopOfCore; NextInCore = TopOfCore->nxt; #if DEBUGGING_FUNCTIONS if (WatchMessages) WatchMessage(WTRACE,BEGIN_TRACE); if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount()) { #if PROFILING_FUNCTIONS StartProfile(&profileFrame, &CurrentCore->hnd->usrData, ProfileConstructs); #endif EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule, CurrentCore->hnd->actions, CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,END_TRACE); if (WatchMessages) WatchMessage(WTRACE,END_TRACE); #endif } else #endif /* IMPERATIVE_MESSAGE_HANDLERS */ { CurrentCore = NULL; NextInCore = TopOfCore; #if DEBUGGING_FUNCTIONS if (WatchMessages) WatchMessage(WTRACE,BEGIN_TRACE); #endif CallHandlers(result); #if DEBUGGING_FUNCTIONS if (WatchMessages) WatchMessage(WTRACE,END_TRACE); #endif } DestroyHandlerLinks(TopOfCore); CurrentCore = oldCurrent; NextInCore = oldNext; } TopOfCore = oldCore; ReturnFlag = FALSE; if (ins != NULL) ins->busy--; /* ================================== Restore the original calling frame ================================== */ PopProcParameters(); CurrentEvaluationDepth--; CurrentMessageName = oldName; PropagateReturnValue(result); PeriodicCleanup(FALSE,TRUE); SetExecutingConstruct(oldce); if (EvaluationError) { result->type = SYMBOL; result->value = FalseSymbol; } }
/******************************************************** NAME : CallNextHandler DESCRIPTION : This function allows around-handlers to execute the rest of the core frame. It also allows primary handlers to execute shadowed primaries. The original handler arguments are left intact. INPUTS : The caller's result-value buffer RETURNS : Nothing useful SIDE EFFECTS : The core frame is called and any appropriate changes are made when used in an around handler See CallHandlers() But when call-next-handler is called from a primary, the same shadowed primary is called over and over again for repeated calls to call-next-handler. NOTES : H/L Syntax: (call-next-handler) OR (override-next-handler <arg> ...) ********************************************************/ globle void CallNextHandler( DATA_OBJECT *result) { EXPRESSION args; int overridep; HANDLER_LINK *oldNext,*oldCurrent; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif SetpType(result,SYMBOL); SetpValue(result,FalseSymbol); EvaluationError = FALSE; if (HaltExecution) return; if (NextHandlerAvailable() == FALSE) { PrintErrorID("MSGPASS",1,FALSE); PrintRouter(WERROR,"Shadowed message-handlers not applicable in current context.\n"); SetEvaluationError(TRUE); return; } if (CurrentExpression->value == (void *) FindFunction("override-next-handler")) { overridep = 1; args.type = (short) ProcParamArray[0].type; if (args.type != MULTIFIELD) args.value = (void *) ProcParamArray[0].value; else args.value = (void *) &ProcParamArray[0]; args.nextArg = GetFirstArgument(); args.argList = NULL; PushProcParameters(&args,CountArguments(&args), ValueToString(CurrentMessageName),"message", UnboundHandlerErr); if (EvaluationError) { ReturnFlag = FALSE; return; } } else overridep = 0; oldNext = NextInCore; oldCurrent = CurrentCore; if (CurrentCore->hnd->type == MAROUND) { if (NextInCore->hnd->type == MAROUND) { CurrentCore = NextInCore; NextInCore = NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount()) { #if PROFILING_FUNCTIONS StartProfile(&profileFrame, &CurrentCore->hnd->usrData, ProfileConstructs); #endif EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule, CurrentCore->hnd->actions, CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,END_TRACE); #endif } else CallHandlers(result); } else { CurrentCore = NextInCore; NextInCore = NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount()) { #if PROFILING_FUNCTIONS StartProfile(&profileFrame, &CurrentCore->hnd->usrData, ProfileConstructs); #endif EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule, CurrentCore->hnd->actions, CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,END_TRACE); #endif } NextInCore = oldNext; CurrentCore = oldCurrent; if (overridep) PopProcParameters(); ReturnFlag = FALSE; }
/**************************************************** 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); }