/****************************************************
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);
}
/*****************************************************************
NAME : TestForFirstInstanceInClass
DESCRIPTION : Processes all instances in a class and then
all subclasses of a class until success or done
INPUTS : 1) The module for which classes tested must be
in scope
2) Visitation traversal id
3) The class
4) The current class restriction chain
5) The index of the current restriction
RETURNS : TRUE if query succeeds, FALSE otherwise
SIDE EFFECTS : Instance variable values set
NOTES : None
*****************************************************************/
static int TestForFirstInstanceInClass(
void *theEnv,
struct defmodule *theModule,
int id,
DEFCLASS *cls,
QUERY_CLASS *qchain,
int indx)
{
long i;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
struct garbageFrame newGarbageFrame;
struct garbageFrame *oldGarbageFrame;
if (TestTraversalID(cls->traversalRecord,id))
return(FALSE);
SetTraversalID(cls->traversalRecord,id);
if (DefclassInScope(theEnv,cls,theModule) == FALSE)
return(FALSE);
oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame;
memset(&newGarbageFrame,0,sizeof(struct garbageFrame));
newGarbageFrame.priorFrame = oldGarbageFrame;
UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame;
ins = cls->instanceList;
while (ins != NULL)
{
InstanceQueryData(theEnv)->QueryCore->solns[indx] = ins;
if (qchain->nxt != NULL)
{
ins->busy++;
if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == TRUE)
{
ins->busy--;
break;
}
ins->busy--;
if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE))
break;
}
else
{
ins->busy++;
EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->query,&temp);
ins->busy--;
if (EvaluationData(theEnv)->HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != EnvFalseSymbol(theEnv)))
break;
}
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
ins = ins->nxtClass;
while ((ins != NULL) ? (ins->garbage == 1) : FALSE)
ins = ins->nxtClass;
}
RestorePriorGarbageFrame(theEnv,&newGarbageFrame, oldGarbageFrame,NULL);
CallPeriodicTasks(theEnv);
if (ins != NULL)
return(((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE))
? FALSE : TRUE);
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
{
if (TestForFirstInstanceInClass(theEnv,theModule,id,cls->directSubclasses.classArray[i],
qchain,indx))
return(TRUE);
if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE))
return(FALSE);
}
return(FALSE);
}
globle void LoopForCountFunction(
void *theEnv,
DATA_OBJECT_PTR loopResult)
{
DATA_OBJECT arg_ptr;
long long iterationEnd;
LOOP_COUNTER_STACK *tmpCounter;
struct garbageFrame newGarbageFrame;
struct garbageFrame *oldGarbageFrame;
tmpCounter = get_struct(theEnv,loopCounterStack);
tmpCounter->loopCounter = 0L;
tmpCounter->nxt = ProcedureFunctionData(theEnv)->LoopCounterStack;
ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter;
if (EnvArgTypeCheck(theEnv,"loop-for-count",1,INTEGER,&arg_ptr) == FALSE)
{
loopResult->type = SYMBOL;
loopResult->value = EnvFalseSymbol(theEnv);
ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt;
rtn_struct(theEnv,loopCounterStack,tmpCounter);
return;
}
tmpCounter->loopCounter = DOToLong(arg_ptr);
if (EnvArgTypeCheck(theEnv,"loop-for-count",2,INTEGER,&arg_ptr) == FALSE)
{
loopResult->type = SYMBOL;
loopResult->value = EnvFalseSymbol(theEnv);
ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt;
rtn_struct(theEnv,loopCounterStack,tmpCounter);
return;
}
oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame;
memset(&newGarbageFrame,0,sizeof(struct garbageFrame));
newGarbageFrame.priorFrame = oldGarbageFrame;
UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame;
iterationEnd = DOToLong(arg_ptr);
while ((tmpCounter->loopCounter <= iterationEnd) &&
(EvaluationData(theEnv)->HaltExecution != TRUE))
{
if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
break;
EnvRtnUnknown(theEnv,3,&arg_ptr);
if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
break;
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
tmpCounter->loopCounter++;
}
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)
{
loopResult->type = arg_ptr.type;
loopResult->value = arg_ptr.value;
loopResult->begin = arg_ptr.begin;
loopResult->end = arg_ptr.end;
}
else
{
loopResult->type = SYMBOL;
loopResult->value = EnvFalseSymbol(theEnv);
}
ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt;
rtn_struct(theEnv,loopCounterStack,tmpCounter);
RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,loopResult);
CallPeriodicTasks(theEnv);
}
/******************************************************************************
NAME : DelayedQueryDoForAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
and exceutes a user-action for each set
This function differs from QueryDoForAllInstances() in
that it forms the complete list of query satisfactions
BEFORE executing any actions.
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set. The action is executed
for evry query satisfaction.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See ParseQueryNoAction()
******************************************************************************/
globle void DelayedQueryDoForAllInstances(
void *theEnv,
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
unsigned rcnt;
register unsigned i;
struct garbageFrame newGarbageFrame;
struct garbageFrame *oldGarbageFrame;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg,
"delayed-do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore(theEnv);
InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt));
InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument();
InstanceQueryData(theEnv)->QueryCore->action = NULL;
InstanceQueryData(theEnv)->QueryCore->soln_set = NULL;
InstanceQueryData(theEnv)->QueryCore->soln_size = rcnt;
InstanceQueryData(theEnv)->QueryCore->soln_cnt = 0;
TestEntireChain(theEnv,qclasses,0);
InstanceQueryData(theEnv)->AbortQuery = FALSE;
InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame;
memset(&newGarbageFrame,0,sizeof(struct garbageFrame));
newGarbageFrame.priorFrame = oldGarbageFrame;
UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame;
while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL)
{
for (i = 0 ; i < rcnt ; i++)
InstanceQueryData(theEnv)->QueryCore->solns[i] = InstanceQueryData(theEnv)->QueryCore->soln_set->soln[i];
PopQuerySoln(theEnv);
EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,result);
if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
{
while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL)
PopQuerySoln(theEnv);
break;
}
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
}
RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result);
CallPeriodicTasks(theEnv);
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryClasses(theEnv,qclasses);
}
globle void WhileFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
DATA_OBJECT theResult;
struct garbageFrame newGarbageFrame;
struct garbageFrame *oldGarbageFrame;
/*====================================================*/
/* Evaluate the body of the while loop as long as the */
/* while condition evaluates to a non-FALSE value. */
/*====================================================*/
oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame;
memset(&newGarbageFrame,0,sizeof(struct garbageFrame));
newGarbageFrame.priorFrame = oldGarbageFrame;
UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame;
EnvRtnUnknown(theEnv,1,&theResult);
while (((theResult.value != EnvFalseSymbol(theEnv)) ||
(theResult.type != SYMBOL)) &&
(EvaluationData(theEnv)->HaltExecution != TRUE))
{
if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
break;
EnvRtnUnknown(theEnv,2,&theResult);
if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
break;
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
EnvRtnUnknown(theEnv,1,&theResult);
}
/*=====================================================*/
/* Reset the break flag. The return flag is not reset */
/* because the while loop is probably contained within */
/* a deffunction or RHS of a rule which needs to be */
/* returned from as well. */
/*=====================================================*/
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
/*====================================================*/
/* If the return command was issued, then return that */
/* value, otherwise return the symbol FALSE. */
/*====================================================*/
if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)
{
returnValue->type = theResult.type;
returnValue->value = theResult.value;
returnValue->begin = theResult.begin;
returnValue->end = theResult.end;
}
else
{
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
}
RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,returnValue);
CallPeriodicTasks(theEnv);
}
