globle void *EnvCreateMultifield(
void *theEnv,
unsigned long size)
{
struct multifield *theSegment;
unsigned long newSize;
if (size <= 0) newSize = 1;
else newSize = size;
theSegment = get_var_struct2(theEnv,multifield,(long) sizeof(struct field) * (newSize - 1L));
theSegment->multifieldLength = size;
theSegment->depth = (short) EvaluationData(theEnv)->CurrentEvaluationDepth;
theSegment->busyCount = 0;
theSegment->next = NULL;
theSegment->next = MultifieldData(theEnv)->ListOfMultifields;
MultifieldData(theEnv)->ListOfMultifields = theSegment;
UtilityData(theEnv)->EphemeralItemCount++;
UtilityData(theEnv)->EphemeralItemSize += sizeof(struct multifield) + (sizeof(struct field) * newSize);
return((void *) theSegment);
}
globle void FlushMultifields(
void *theEnv)
{
struct multifield *theSegment, *nextPtr, *lastPtr = NULL;
unsigned long newSize;
theSegment = UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields;
while (theSegment != NULL)
{
nextPtr = theSegment->next;
if (theSegment->busyCount == 0)
{
if (theSegment->multifieldLength == 0) newSize = 1;
else newSize = theSegment->multifieldLength;
rtn_var_struct(theEnv,multifield,sizeof(struct field) * (newSize - 1),theSegment);
if (lastPtr == NULL) UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields = nextPtr;
else lastPtr->next = nextPtr;
/*=================================================*/
/* If the multifield deleted was the last in the */
/* list, update the pointer to the last multifield */
/* to the prior multifield. */
/*=================================================*/
if (nextPtr == NULL)
{ UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield = lastPtr; }
}
else
{ lastPtr = theSegment; }
theSegment = nextPtr;
}
}
globle void FlushMultifields(
void *theEnv)
{
struct multifield *theSegment, *nextPtr, *lastPtr = NULL;
unsigned long newSize;
theSegment = MultifieldData(theEnv)->ListOfMultifields;
while (theSegment != NULL)
{
nextPtr = theSegment->next;
if ((theSegment->depth > EvaluationData(theEnv)->CurrentEvaluationDepth) && (theSegment->busyCount == 0))
{
UtilityData(theEnv)->EphemeralItemCount--;
UtilityData(theEnv)->EphemeralItemSize -= sizeof(struct multifield) +
(sizeof(struct field) * theSegment->multifieldLength);
if (theSegment->multifieldLength == 0) newSize = 1;
else newSize = theSegment->multifieldLength;
rtn_var_struct2(theEnv,multifield,sizeof(struct field) * (newSize - 1),theSegment);
if (lastPtr == NULL) MultifieldData(theEnv)->ListOfMultifields = nextPtr;
else lastPtr->next = nextPtr;
}
else
{ lastPtr = theSegment; }
theSegment = nextPtr;
}
}
globle void AddToMultifieldList(
void *theEnv,
struct multifield *theSegment)
{
theSegment->next = UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields;
UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields = theSegment;
UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE;
if (UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield == NULL)
{ UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield = theSegment; }
}
globle void AddToMultifieldList(
void *theEnv,
struct multifield *theSegment)
{
theSegment->depth = (short) EvaluationData(theEnv)->CurrentEvaluationDepth;
theSegment->next = MultifieldData(theEnv)->ListOfMultifields;
MultifieldData(theEnv)->ListOfMultifields = theSegment;
UtilityData(theEnv)->EphemeralItemCount++;
UtilityData(theEnv)->EphemeralItemSize += sizeof(struct multifield) + (sizeof(struct field) * theSegment->multifieldLength);
}
short SetGarbageCollectionHeuristics(
void *theEnv,
short newValue)
{
short oldValue;
oldValue = UtilityData(theEnv)->GarbageCollectionHeuristicsEnabled;
UtilityData(theEnv)->GarbageCollectionHeuristicsEnabled = newValue;
return(oldValue);
}
short EnableYieldFunction(
void *theEnv,
short value)
{
short oldValue;
oldValue = UtilityData(theEnv)->YieldFunctionEnabled;
UtilityData(theEnv)->YieldFunctionEnabled = value;
return(oldValue);
}
short EnablePeriodicFunctions(
void *theEnv,
short value)
{
short oldValue;
oldValue = UtilityData(theEnv)->PeriodicFunctionsEnabled;
UtilityData(theEnv)->PeriodicFunctionsEnabled = value;
return(oldValue);
}
globle BOOLEAN EnvAddPeriodicFunction(
void *theEnv,
char *name,
void (*theFunction)(void *),
int priority)
{
return(AddCPFunction(theEnv,name,theFunction,priority,&UtilityData(theEnv)->ListOfPeriodicFunctions,TRUE));
}
static void DeallocateUtilityData(
void *theEnv)
{
struct cleanupFunction *tmpPtr, *nextPtr;
tmpPtr = UtilityData(theEnv)->ListOfPeriodicFunctions;
while (tmpPtr != NULL)
{
nextPtr = tmpPtr->next;
rtn_struct(theEnv,cleanupFunction,tmpPtr);
tmpPtr = nextPtr;
}
tmpPtr = UtilityData(theEnv)->ListOfCleanupFunctions;
while (tmpPtr != NULL)
{
nextPtr = tmpPtr->next;
rtn_struct(theEnv,cleanupFunction,tmpPtr);
tmpPtr = nextPtr;
}
}
globle BOOLEAN AddPeriodicFunction(
char *name,
void (*theFunction)(void),
int priority)
{
void *theEnv;
theEnv = GetCurrentEnvironment();
return(AddCPFunction(theEnv,name,(void (*)(void *)) theFunction,priority,
&UtilityData(theEnv)->ListOfPeriodicFunctions,FALSE));
}
globle void *EnvCreateMultifield(
void *theEnv,
long size)
{
struct multifield *theSegment;
long newSize;
if (size <= 0) newSize = 1;
else newSize = size;
theSegment = get_var_struct(theEnv,multifield,(long) sizeof(struct field) * (newSize - 1L));
theSegment->multifieldLength = size;
theSegment->busyCount = 0;
theSegment->next = NULL;
theSegment->next = UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields;
UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields = theSegment;
UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE;
if (UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield == NULL)
{ UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield = theSegment; }
return((void *) theSegment);
}
globle void InitializeUtilityData(
void *theEnv)
{
AllocateEnvironmentData(theEnv,UTILITY_DATA,sizeof(struct utilityData),DeallocateUtilityData);
UtilityData(theEnv)->GarbageCollectionLocks = 0;
UtilityData(theEnv)->GarbageCollectionHeuristicsEnabled = TRUE;
UtilityData(theEnv)->PeriodicFunctionsEnabled = TRUE;
UtilityData(theEnv)->YieldFunctionEnabled = TRUE;
UtilityData(theEnv)->CurrentEphemeralCountMax = MAX_EPHEMERAL_COUNT;
UtilityData(theEnv)->CurrentEphemeralSizeMax = MAX_EPHEMERAL_SIZE;
UtilityData(theEnv)->LastEvaluationDepth = -1;
}
/******************************************************************************
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);
}
/*****************************************************************
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 int FunctionCall2(
void *theEnv,
FUNCTION_REFERENCE *theReference,
char *args,
DATA_OBJECT *result)
{
EXPRESSION *argexps;
int error = FALSE;
/*=============================================*/
/* Force periodic cleanup if the function call */
/* was executed from an embedded application. */
/*=============================================*/
if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
(EvaluationData(theEnv)->CurrentExpression == NULL))
{
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
}
/*========================*/
/* Reset the error state. */
/*========================*/
if (UtilityData(theEnv)->CurrentGarbageFrame->topLevel) SetHaltExecution(theEnv,FALSE);
EvaluationData(theEnv)->EvaluationError = FALSE;
/*======================================*/
/* Initialize the default return value. */
/*======================================*/
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
/*============================*/
/* Parse the argument string. */
/*============================*/
argexps = ParseConstantArguments(theEnv,args,&error);
if (error == TRUE) return(TRUE);
/*====================*/
/* Call the function. */
/*====================*/
theReference->argList = argexps;
error = EvaluateExpression(theEnv,theReference,result);
/*========================*/
/* Return the expression. */
/*========================*/
ReturnExpression(theEnv,argexps);
theReference->argList = NULL;
/*==========================*/
/* Return the error status. */
/*==========================*/
return(error);
}
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);
}
globle void EnvReset(
void *theEnv)
{
struct callFunctionItem *resetPtr;
/*=====================================*/
/* The reset command can't be executed */
/* while a reset is in progress. */
/*=====================================*/
if (ConstructData(theEnv)->ResetInProgress) return;
ConstructData(theEnv)->ResetInProgress = TRUE;
ConstructData(theEnv)->ResetReadyInProgress = TRUE;
/*================================================*/
/* If the reset is performed from the top level */
/* command prompt, reset the halt execution flag. */
/*================================================*/
if (UtilityData(theEnv)->CurrentGarbageFrame->topLevel) SetHaltExecution(theEnv,FALSE);
/*=======================================================*/
/* Call the before reset function to determine if the */
/* reset should continue. [Used by the some of the */
/* windowed interfaces to query the user whether a */
/* reset should proceed with activations on the agenda.] */
/*=======================================================*/
if ((ConstructData(theEnv)->BeforeResetFunction != NULL) ?
((*ConstructData(theEnv)->BeforeResetFunction)(theEnv) == FALSE) :
FALSE)
{
ConstructData(theEnv)->ResetReadyInProgress = FALSE;
ConstructData(theEnv)->ResetInProgress = FALSE;
return;
}
ConstructData(theEnv)->ResetReadyInProgress = FALSE;
/*===========================*/
/* Call each reset function. */
/*===========================*/
for (resetPtr = ConstructData(theEnv)->ListOfResetFunctions;
(resetPtr != NULL) && (GetHaltExecution(theEnv) == FALSE);
resetPtr = resetPtr->next)
{
if (resetPtr->environmentAware)
{ (*resetPtr->func)(theEnv); }
else
{ (* (void (*)(void)) resetPtr->func)(); }
}
/*============================================*/
/* Set the current module to the MAIN module. */
/*============================================*/
EnvSetCurrentModule(theEnv,(void *) EnvFindDefmodule(theEnv,"MAIN"));
/*===========================================*/
/* Perform periodic cleanup if the reset was */
/* issued from an embedded controller. */
/*===========================================*/
if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
(EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0))
{
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
}
/*===================================*/
/* A reset is no longer in progress. */
/*===================================*/
ConstructData(theEnv)->ResetInProgress = 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);
}
globle BOOLEAN EnvRemovePeriodicFunction(
void *theEnv,
char *name)
{
return(RemoveCPFunction(theEnv,name,&UtilityData(theEnv)->ListOfPeriodicFunctions));
}
globle BOOLEAN RemoveCleanupFunction(
void *theEnv,
char *name)
{
return(RemoveCPFunction(theEnv,name,&UtilityData(theEnv)->ListOfCleanupFunctions));
}
globle void EnvDecrementGCLocks(
void *theEnv)
{
if (UtilityData(theEnv)->GarbageCollectionLocks > 0)
{ UtilityData(theEnv)->GarbageCollectionLocks--; }
}
void YieldTime(
void *theEnv)
{
if ((UtilityData(theEnv)->YieldTimeFunction != NULL) && UtilityData(theEnv)->YieldFunctionEnabled)
{ (*UtilityData(theEnv)->YieldTimeFunction)(); }
}
globle void PeriodicCleanup(
void *theEnv,
BOOLEAN cleanupAllDepths,
BOOLEAN useHeuristics)
{
int oldDepth = -1;
struct cleanupFunction *cleanupPtr,*periodPtr;
/*===================================*/
/* Don't use heuristics if disabled. */
/*===================================*/
if (! UtilityData(theEnv)->GarbageCollectionHeuristicsEnabled)
{ useHeuristics = FALSE; }
/*=============================================*/
/* Call functions for handling periodic tasks. */
/*=============================================*/
if (UtilityData(theEnv)->PeriodicFunctionsEnabled)
{
for (periodPtr = UtilityData(theEnv)->ListOfPeriodicFunctions;
periodPtr != NULL;
periodPtr = periodPtr->next)
{
if (periodPtr->environmentAware)
{ (*periodPtr->ip)(theEnv); }
else
{ (* (void (*)(void)) periodPtr->ip)(); }
}
}
/*===================================================*/
/* If the last level we performed cleanup was deeper */
/* than the current level, reset the values used by */
/* the heuristics to determine if garbage collection */
/* should be performed. If the heuristic values had */
/* to be incremented because there was no garbage */
/* that could be cleaned up, we don't want to keep */
/* those same high values permanently so we reset */
/* them when we go back to a lower evaluation depth. */
/*===================================================*/
if (UtilityData(theEnv)->LastEvaluationDepth > EvaluationData(theEnv)->CurrentEvaluationDepth)
{
UtilityData(theEnv)->LastEvaluationDepth = EvaluationData(theEnv)->CurrentEvaluationDepth;
UtilityData(theEnv)->CurrentEphemeralCountMax = MAX_EPHEMERAL_COUNT;
UtilityData(theEnv)->CurrentEphemeralSizeMax = MAX_EPHEMERAL_SIZE;
}
/*======================================================*/
/* If we're using heuristics to determine if garbage */
/* collection to occur, then check to see if enough */
/* garbage has been created to make cleanup worthwhile. */
/*======================================================*/
if (UtilityData(theEnv)->GarbageCollectionLocks > 0) return;
if (useHeuristics &&
(UtilityData(theEnv)->EphemeralItemCount < UtilityData(theEnv)->CurrentEphemeralCountMax) &&
(UtilityData(theEnv)->EphemeralItemSize < UtilityData(theEnv)->CurrentEphemeralSizeMax))
{ return; }
/*==========================================================*/
/* If cleanup is being performed at all depths, rather than */
/* just the current evaluation depth, then temporarily set */
/* the evaluation depth to a level that will force cleanup */
/* at all depths. */
/*==========================================================*/
if (cleanupAllDepths)
{
oldDepth = EvaluationData(theEnv)->CurrentEvaluationDepth;
EvaluationData(theEnv)->CurrentEvaluationDepth = -1;
}
/*=============================================*/
/* Free up multifield values no longer in use. */
/*=============================================*/
FlushMultifields(theEnv);
/*=====================================*/
/* Call the list of cleanup functions. */
/*=====================================*/
for (cleanupPtr = UtilityData(theEnv)->ListOfCleanupFunctions;
cleanupPtr != NULL;
cleanupPtr = cleanupPtr->next)
{
if (cleanupPtr->environmentAware)
{ (*cleanupPtr->ip)(theEnv); }
else
{ (* (void (*)(void)) cleanupPtr->ip)(); }
}
/*================================================*/
/* Free up atomic values that are no longer used. */
/*================================================*/
RemoveEphemeralAtoms(theEnv);
/*=========================================*/
/* Restore the evaluation depth if cleanup */
/* was performed on all depths. */
/*=========================================*/
if (cleanupAllDepths) EvaluationData(theEnv)->CurrentEvaluationDepth = oldDepth;
/*============================================================*/
/* If very little memory was freed up, then increment the */
/* values used by the heuristics so that we don't continually */
/* try to free up memory that isn't being released. */
/*============================================================*/
if ((UtilityData(theEnv)->EphemeralItemCount + COUNT_INCREMENT) > UtilityData(theEnv)->CurrentEphemeralCountMax)
{ UtilityData(theEnv)->CurrentEphemeralCountMax = UtilityData(theEnv)->EphemeralItemCount + COUNT_INCREMENT; }
if ((UtilityData(theEnv)->EphemeralItemSize + SIZE_INCREMENT) > UtilityData(theEnv)->CurrentEphemeralSizeMax)
{ UtilityData(theEnv)->CurrentEphemeralSizeMax = UtilityData(theEnv)->EphemeralItemSize + SIZE_INCREMENT; }
/*===============================================================*/
/* Remember the evaluation depth at which garbage collection was */
/* last performed. This information is used for resetting the */
/* ephemeral count and size numbers used by the heuristics. */
/*===============================================================*/
UtilityData(theEnv)->LastEvaluationDepth = EvaluationData(theEnv)->CurrentEvaluationDepth;
}
globle struct multifield *GetMultifieldList(
void *theEnv)
{
return(UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields);
}
globle void EnvIncrementGCLocks(
void *theEnv)
{
UtilityData(theEnv)->GarbageCollectionLocks++;
}
globle void EnvClear(
void *theEnv)
{
struct callFunctionItem *theFunction;
/*==========================================*/
/* Activate the watch router which captures */
/* trace output so that it is not displayed */
/* during a clear. */
/*==========================================*/
#if DEBUGGING_FUNCTIONS
EnvActivateRouter(theEnv,WTRACE);
#endif
/*===================================*/
/* Determine if a clear is possible. */
/*===================================*/
ConstructData(theEnv)->ClearReadyInProgress = TRUE;
if ((ConstructData(theEnv)->ClearReadyLocks > 0) ||
(ConstructData(theEnv)->DanglingConstructs > 0) ||
(ClearReady(theEnv) == FALSE))
{
PrintErrorID(theEnv,"CONSTRCT",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"Some constructs are still in use. Clear cannot continue.\n");
#if DEBUGGING_FUNCTIONS
EnvDeactivateRouter(theEnv,WTRACE);
#endif
ConstructData(theEnv)->ClearReadyInProgress = FALSE;
return;
}
ConstructData(theEnv)->ClearReadyInProgress = FALSE;
/*===========================*/
/* Call all clear functions. */
/*===========================*/
ConstructData(theEnv)->ClearInProgress = TRUE;
for (theFunction = ConstructData(theEnv)->ListOfClearFunctions;
theFunction != NULL;
theFunction = theFunction->next)
{
if (theFunction->environmentAware)
{ (*theFunction->func)(theEnv); }
else
{ (* (void (*)(void)) theFunction->func)(); }
}
/*=============================*/
/* Deactivate the watch router */
/* for capturing output. */
/*=============================*/
#if DEBUGGING_FUNCTIONS
EnvDeactivateRouter(theEnv,WTRACE);
#endif
/*===========================================*/
/* Perform periodic cleanup if the clear was */
/* issued from an embedded controller. */
/*===========================================*/
if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
(EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0))
{
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
}
/*===========================*/
/* Clear has been completed. */
/*===========================*/
ConstructData(theEnv)->ClearInProgress = FALSE;
#if DEFRULE_CONSTRUCT
if ((DefruleData(theEnv)->RightPrimeJoins != NULL) ||
(DefruleData(theEnv)->LeftPrimeJoins != NULL))
{ SystemError(theEnv,"CONSTRCT",1); }
#endif
/*============================*/
/* Perform reset after clear. */
/*============================*/
EnvReset(theEnv);
}
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);
}