bool ExecuteIfCommandComplete(
void *theEnv)
{
if ((CompleteCommand(CommandLineData(theEnv)->CommandString) == 0) ||
(RouterData(theEnv)->CommandBufferInputCount == 0) ||
(RouterData(theEnv)->AwaitingInput == false))
{ return false; }
if (CommandLineData(theEnv)->BeforeCommandExecutionFunction != NULL)
{
if (! (*CommandLineData(theEnv)->BeforeCommandExecutionFunction)(theEnv))
{ return false; }
}
FlushPPBuffer(theEnv);
SetPPBufferStatus(theEnv,false);
RouterData(theEnv)->CommandBufferInputCount = 0;
RouterData(theEnv)->AwaitingInput = false;
RouteCommand(theEnv,CommandLineData(theEnv)->CommandString,true);
FlushPPBuffer(theEnv);
FlushParsingMessages(theEnv);
EnvSetHaltExecution(theEnv,false);
EnvSetEvaluationError(theEnv,false);
FlushCommandString(theEnv);
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
PrintPrompt(theEnv);
return true;
}
void CommandLoop(
void *theEnv)
{
int inchar;
EnvPrintRouter(theEnv,WPROMPT,CommandLineData(theEnv)->BannerString);
EnvSetHaltExecution(theEnv,false);
EnvSetEvaluationError(theEnv,false);
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
PrintPrompt(theEnv);
RouterData(theEnv)->CommandBufferInputCount = 0;
RouterData(theEnv)->AwaitingInput = true;
while (true)
{
/*===================================================*/
/* If a batch file is active, grab the command input */
/* directly from the batch file, otherwise call the */
/* event function. */
/*===================================================*/
if (BatchActive(theEnv) == true)
{
inchar = LLGetcBatch(theEnv,STDIN,true);
if (inchar == EOF)
{ (*CommandLineData(theEnv)->EventFunction)(theEnv); }
else
{ ExpandCommandString(theEnv,(char) inchar); }
}
else
{ (*CommandLineData(theEnv)->EventFunction)(theEnv); }
/*=================================================*/
/* If execution was halted, then remove everything */
/* from the command buffer. */
/*=================================================*/
if (EnvGetHaltExecution(theEnv) == true)
{
EnvSetHaltExecution(theEnv,false);
EnvSetEvaluationError(theEnv,false);
FlushCommandString(theEnv);
#if ! WINDOW_INTERFACE
fflush(stdin);
#endif
EnvPrintRouter(theEnv,WPROMPT,"\n");
PrintPrompt(theEnv);
}
/*=========================================*/
/* If a complete command is in the command */
/* buffer, then execute it. */
/*=========================================*/
ExecuteIfCommandComplete(theEnv);
}
}
void CommandLoopBatch(
void *theEnv)
{
EnvSetHaltExecution(theEnv,false);
EnvSetEvaluationError(theEnv,false);
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
PrintPrompt(theEnv);
RouterData(theEnv)->CommandBufferInputCount = 0;
RouterData(theEnv)->AwaitingInput = true;
CommandLoopBatchDriver(theEnv);
}
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 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 : DelayedQueryDoForAllFacts
DESCRIPTION : Finds all sets of facts which satisfy the query and
and exceutes a user-action for each set
This function differs from QueryDoForAllFacts() 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 template-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every fact set. The action is executed
for evry query satisfaction.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See FactParseQueryNoAction()
******************************************************************************/
void DelayedQueryDoForAllFacts(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt;
unsigned i;
GCBlock gcb;
QUERY_SOLN *theSet;
returnValue->value = FalseSymbol(theEnv);
qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
"delayed-do-for-all-facts",&rcnt);
if (qtemplates == NULL)
return;
PushQueryCore(theEnv);
FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
FactQueryData(theEnv)->QueryCore->solns = (Fact **) gm2(theEnv,(sizeof(Fact *) * rcnt));
FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
FactQueryData(theEnv)->QueryCore->action = NULL;
FactQueryData(theEnv)->QueryCore->soln_set = NULL;
FactQueryData(theEnv)->QueryCore->soln_size = rcnt;
FactQueryData(theEnv)->QueryCore->soln_cnt = 0;
TestEntireChain(theEnv,qtemplates,0);
FactQueryData(theEnv)->AbortQuery = false;
FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
/*==============================================================*/
/* Increment the busy count for all facts in the solution sets. */
/*==============================================================*/
GCBlockStart(theEnv,&gcb);
for (theSet = FactQueryData(theEnv)->QueryCore->soln_set;
theSet != NULL;
theSet = theSet->nxt)
{
for (i = 0; i < rcnt; i++)
{ theSet->soln[i]->patternHeader.busyCount++; }
}
/*=====================*/
/* Perform the action. */
/*=====================*/
for (theSet = FactQueryData(theEnv)->QueryCore->soln_set;
theSet != NULL; )
{
for (i = 0 ; i < rcnt ; i++)
{
if (theSet->soln[i]->garbage)
{ goto nextSet; }
FactQueryData(theEnv)->QueryCore->solns[i] = theSet->soln[i];
}
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,returnValue);
if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
{ break; }
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
nextSet: theSet = theSet->nxt;
}
/*==============================================================*/
/* Decrement the busy count for all facts in the solution sets. */
/*==============================================================*/
for (theSet = FactQueryData(theEnv)->QueryCore->soln_set;
theSet != NULL;
theSet = theSet->nxt)
{
for (i = 0; i < rcnt; i++)
{ theSet->soln[i]->patternHeader.busyCount--; }
}
GCBlockEndUDF(theEnv,&gcb,returnValue);
CallPeriodicTasks(theEnv);
/*==================================*/
/* Deallocate the query structures. */
/*==================================*/
while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
{ PopQuerySoln(theEnv); }
ProcedureFunctionData(theEnv)->BreakFlag = false;
rm(theEnv,FactQueryData(theEnv)->QueryCore->solns,(sizeof(Fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
}
void QSetDefglobalValue(
Environment *theEnv,
Defglobal *theGlobal,
UDFValue *vPtr,
bool resetVar)
{
CLIPSValue newValue;
/*====================================================*/
/* If the new value passed for the defglobal is NULL, */
/* then reset the defglobal to the initial value it */
/* had when it was defined. */
/*====================================================*/
if (resetVar)
{
EvaluateExpression(theEnv,theGlobal->initial,vPtr);
if (EvaluationData(theEnv)->EvaluationError)
{ vPtr->value = FalseSymbol(theEnv); }
}
/*==========================================*/
/* If globals are being watch, then display */
/* the change to the global variable. */
/*==========================================*/
#if DEBUGGING_FUNCTIONS
if (theGlobal->watch &&
(! ConstructData(theEnv)->ClearReadyInProgress) &&
(! ConstructData(theEnv)->ClearInProgress))
{
WriteString(theEnv,STDOUT,":== ?*");
WriteString(theEnv,STDOUT,theGlobal->header.name->contents);
WriteString(theEnv,STDOUT,"* ==> ");
WriteUDFValue(theEnv,STDOUT,vPtr);
WriteString(theEnv,STDOUT," <== ");
WriteCLIPSValue(theEnv,STDOUT,&theGlobal->current);
WriteString(theEnv,STDOUT,"\n");
}
#endif
/*==============================================*/
/* Retain the new value of the global variable. */
/*==============================================*/
NormalizeMultifield(theEnv,vPtr);
if (vPtr->header->type != MULTIFIELD_TYPE)
{ newValue.value = vPtr->value; }
else
{ newValue.value = CopyMultifield(theEnv,vPtr->multifieldValue); }
Retain(theEnv,newValue.header);
/*==============================================*/
/* Remove the old value of the global variable. */
/*==============================================*/
Release(theEnv,theGlobal->current.header);
if (theGlobal->current.header->type == MULTIFIELD_TYPE)
{
if (theGlobal->current.multifieldValue->busyCount == 0)
{ ReturnMultifield(theEnv,theGlobal->current.multifieldValue); }
else
{ AddToMultifieldList(theEnv,theGlobal->current.multifieldValue); }
}
/*===========================================*/
/* Set the new value of the global variable. */
/*===========================================*/
theGlobal->current.value = newValue.value;
/*===========================================*/
/* Set the variable indicating that a change */
/* has been made to a global variable. */
/*===========================================*/
DefglobalData(theEnv)->ChangeToGlobals = true;
if (EvaluationData(theEnv)->CurrentExpression == NULL)
{
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
}
}
/*****************************************************************
NAME : TestForFirstFactInTemplate
DESCRIPTION : Processes all facts in a template
INPUTS : 1) Visitation traversal id
2) The template
3) The current template restriction chain
4) The index of the current restriction
RETURNS : True if query succeeds, false otherwise
SIDE EFFECTS : Fact variable values set
NOTES : None
*****************************************************************/
static bool TestForFirstFactInTemplate(
Environment *theEnv,
Deftemplate *templatePtr,
QUERY_TEMPLATE *qchain,
unsigned indx)
{
Fact *theFact;
UDFValue temp;
GCBlock gcb;
unsigned j;
GCBlockStart(theEnv,&gcb);
theFact = templatePtr->factList;
while (theFact != NULL)
{
FactQueryData(theEnv)->QueryCore->solns[indx] = theFact;
if (qchain->nxt != NULL)
{
theFact->patternHeader.busyCount++;
if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == true)
{
theFact->patternHeader.busyCount--;
break;
}
theFact->patternHeader.busyCount--;
if ((EvaluationData(theEnv)->HaltExecution == true) || (FactQueryData(theEnv)->AbortQuery == true))
break;
}
else
{
for (j = 0; j < indx; j++)
{
if (FactQueryData(theEnv)->QueryCore->solns[j]->garbage)
{
theFact = NULL;
goto endTest;
}
}
theFact->patternHeader.busyCount++;
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp);
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
theFact->patternHeader.busyCount--;
if (EvaluationData(theEnv)->HaltExecution == true)
{ break; }
if (temp.value != FalseSymbol(theEnv))
{ break; }
}
/*================================================*/
/* Get the next fact that has not been retracted. */
/*================================================*/
theFact = theFact->nextTemplateFact;
while ((theFact != NULL) ? (theFact->garbage == 1) : false)
{ theFact = theFact->nextTemplateFact; }
}
endTest:
GCBlockEnd(theEnv,&gcb);
CallPeriodicTasks(theEnv);
if (theFact != NULL)
return(((EvaluationData(theEnv)->HaltExecution == true) || (FactQueryData(theEnv)->AbortQuery == true))
? false : true);
return false;
}
/*****************************************************************
NAME : TestEntireTemplate
DESCRIPTION : Processes all facts in a template
INPUTS : 1) The module for which templates tested must be
in scope
3) The template
4) The current template restriction chain
5) The index of the current restriction
RETURNS : Nothing useful
SIDE EFFECTS : Instance variable values set
Solution sets stored in global list
NOTES : None
*****************************************************************/
static void TestEntireTemplate(
Environment *theEnv,
Deftemplate *templatePtr,
QUERY_TEMPLATE *qchain,
unsigned indx)
{
Fact *theFact;
UDFValue temp;
GCBlock gcb;
unsigned j;
GCBlockStart(theEnv,&gcb);
theFact = templatePtr->factList;
while (theFact != NULL)
{
FactQueryData(theEnv)->QueryCore->solns[indx] = theFact;
if (qchain->nxt != NULL)
{
theFact->patternHeader.busyCount++;
TestEntireChain(theEnv,qchain->nxt,indx+1);
theFact->patternHeader.busyCount--;
if ((EvaluationData(theEnv)->HaltExecution == true) || (FactQueryData(theEnv)->AbortQuery == true))
break;
}
else
{
for (j = 0; j < indx; j++)
{
if (FactQueryData(theEnv)->QueryCore->solns[j]->garbage)
{ goto endTest; }
}
theFact->patternHeader.busyCount++;
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp);
theFact->patternHeader.busyCount--;
if (EvaluationData(theEnv)->HaltExecution == true)
break;
if (temp.value != FalseSymbol(theEnv))
{
if (FactQueryData(theEnv)->QueryCore->action != NULL)
{
theFact->patternHeader.busyCount++;
ReleaseUDFV(theEnv,FactQueryData(theEnv)->QueryCore->result);
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,FactQueryData(theEnv)->QueryCore->result);
RetainUDFV(theEnv,FactQueryData(theEnv)->QueryCore->result);
theFact->patternHeader.busyCount--;
if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
{
FactQueryData(theEnv)->AbortQuery = true;
break;
}
if (EvaluationData(theEnv)->HaltExecution == true)
break;
}
else
AddSolution(theEnv);
}
}
theFact = theFact->nextTemplateFact;
while ((theFact != NULL) ? (theFact->garbage == 1) : false)
{ theFact = theFact->nextTemplateFact; }
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
}
endTest:
GCBlockEnd(theEnv,&gcb);
CallPeriodicTasks(theEnv);
}
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);
}
/*****************************************************************
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);
}
/******************************************************************************
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 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 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);
}
