/*************************************************************
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);
}
