/***************************************************
NAME : Send
DESCRIPTION : C Interface for sending messages to
instances
INPUTS : 1) The data object of the instance
2) The message name-string
3) The message arguments string
(Constants only)
4) Caller's buffer for result
RETURNS : Nothing useful
SIDE EFFECTS : Executes message and stores result
caller's buffer
NOTES : None
***************************************************/
globle void Send(
DATA_OBJECT *idata,
char *msg,
char *args,
DATA_OBJECT *result)
{
int error;
EXPRESSION *iexp;
SYMBOL_HN *msym;
SetEvaluationError(FALSE);
result->type = SYMBOL;
result->value = FalseSymbol;
msym = FindSymbol(msg);
if (msym == NULL)
{
PrintNoHandlerError(msg);
SetEvaluationError(TRUE);
return;
}
iexp = GenConstant(idata->type,idata->value);
iexp->nextArg = ParseConstantArguments(args,&error);
if (error == TRUE)
{
ReturnExpression(iexp);
SetEvaluationError(TRUE);
return;
}
PerformMessage(result,iexp,msym);
ReturnExpression(iexp);
if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
(CurrentExpression == NULL))
{ PeriodicCleanup(TRUE,FALSE); }
}
globle int FunctionCall2(
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 ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
(CurrentExpression == NULL))
{ PeriodicCleanup(TRUE,FALSE); }
/*========================*/
/* Reset the error state. */
/*========================*/
if (CurrentEvaluationDepth == 0) SetHaltExecution(FALSE);
EvaluationError = FALSE;
/*======================================*/
/* Initialize the default return value. */
/*======================================*/
result->type = SYMBOL;
result->value = FalseSymbol;
/*============================*/
/* Parse the argument string. */
/*============================*/
argexps = ParseConstantArguments(args,&error);
if (error == TRUE) return(TRUE);
/*====================*/
/* Call the function. */
/*====================*/
theReference->argList = argexps;
error = EvaluateExpression(theReference,result);
/*========================*/
/* Return the expression. */
/*========================*/
ReturnExpression(argexps);
theReference->argList = NULL;
/*==========================*/
/* Return the error status. */
/*==========================*/
return(error);
}
globle void WhileFunction(
DATA_OBJECT_PTR returnValue)
{
DATA_OBJECT theResult;
/*====================================================*/
/* Evaluate the body of the while loop as long as the */
/* while condition evaluates to a non-FALSE value. */
/*====================================================*/
CurrentEvaluationDepth++;
RtnUnknown(1,&theResult);
while (((theResult.value != FalseSymbol) ||
(theResult.type != SYMBOL)) &&
(HaltExecution != TRUE))
{
if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
break;
RtnUnknown(2,&theResult);
CurrentEvaluationDepth--;
if (ReturnFlag == TRUE)
{ PropagateReturnValue(&theResult); }
PeriodicCleanup(FALSE,TRUE);
CurrentEvaluationDepth++;
if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
break;
RtnUnknown(1,&theResult);
}
CurrentEvaluationDepth--;
/*=====================================================*/
/* 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. */
/*=====================================================*/
BreakFlag = FALSE;
/*====================================================*/
/* If the return command was issued, then return that */
/* value, otherwise return the symbol FALSE. */
/*====================================================*/
if (ReturnFlag == TRUE)
{
returnValue->type = theResult.type;
returnValue->value = theResult.value;
returnValue->begin = theResult.begin;
returnValue->end = theResult.end;
}
else
{
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
}
}
globle void CommandLoop(
void *theEnv)
{
int inchar;
EnvPrintRouter(theEnv,WPROMPT,CommandLineData(theEnv)->BannerString);
SetHaltExecution(theEnv,FALSE);
SetEvaluationError(theEnv,FALSE);
PeriodicCleanup(theEnv,TRUE,FALSE);
PrintPrompt(theEnv);
RouterData(theEnv)->CommandBufferInputCount = 0;
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 (GetHaltExecution(theEnv) == TRUE)
{
SetHaltExecution(theEnv,FALSE);
SetEvaluationError(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);
}
}
globle void CommandLoopBatch(
void *theEnv)
{
SetHaltExecution(theEnv,FALSE);
SetEvaluationError(theEnv,FALSE);
PeriodicCleanup(theEnv,TRUE,FALSE);
PrintPrompt(theEnv);
RouterData(theEnv)->CommandBufferInputCount = 0;
CommandLoopBatchDriver(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,
EXEC_STATUS,
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
unsigned rcnt;
register unsigned i;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv,execStatus);
qclasses = DetermineQueryClasses(theEnv,execStatus,GetFirstArgument()->nextArg->nextArg,
"delayed-do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore(theEnv,execStatus);
InstanceQueryData(theEnv,execStatus)->QueryCore = get_struct(theEnv,execStatus,query_core);
InstanceQueryData(theEnv,execStatus)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,execStatus,(sizeof(INSTANCE_TYPE *) * rcnt));
InstanceQueryData(theEnv,execStatus)->QueryCore->query = GetFirstArgument();
InstanceQueryData(theEnv,execStatus)->QueryCore->action = NULL;
InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set = NULL;
InstanceQueryData(theEnv,execStatus)->QueryCore->soln_size = rcnt;
InstanceQueryData(theEnv,execStatus)->QueryCore->soln_cnt = 0;
TestEntireChain(theEnv,execStatus,qclasses,0);
InstanceQueryData(theEnv,execStatus)->AbortQuery = FALSE;
InstanceQueryData(theEnv,execStatus)->QueryCore->action = GetFirstArgument()->nextArg;
while (InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set != NULL)
{
for (i = 0 ; i < rcnt ; i++)
InstanceQueryData(theEnv,execStatus)->QueryCore->solns[i] = InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set->soln[i];
PopQuerySoln(theEnv,execStatus);
execStatus->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->action,result);
execStatus->CurrentEvaluationDepth--;
if (ProcedureFunctionData(theEnv,execStatus)->ReturnFlag == TRUE)
{ PropagateReturnValue(theEnv,execStatus,result); }
PeriodicCleanup(theEnv,execStatus,FALSE,TRUE);
if (execStatus->HaltExecution || ProcedureFunctionData(theEnv,execStatus)->BreakFlag || ProcedureFunctionData(theEnv,execStatus)->ReturnFlag)
{
while (InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set != NULL)
PopQuerySoln(theEnv,execStatus);
break;
}
}
ProcedureFunctionData(theEnv,execStatus)->BreakFlag = FALSE;
rm(theEnv,execStatus,(void *) InstanceQueryData(theEnv,execStatus)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(theEnv,execStatus,query_core,InstanceQueryData(theEnv,execStatus)->QueryCore);
PopQueryCore(theEnv,execStatus);
DeleteQueryClasses(theEnv,execStatus,qclasses);
}
/*****************************************************************
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 int TestForFirstFactInTemplate(
void *theEnv,
struct deftemplate *templatePtr,
QUERY_TEMPLATE *qchain,
int indx)
{
struct fact *theFact;
DATA_OBJECT temp;
theFact = templatePtr->factList;
while (theFact != NULL)
{
FactQueryData(theEnv)->QueryCore->solns[indx] = theFact;
if (qchain->nxt != NULL)
{
theFact->factHeader.busyCount++;
if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == TRUE)
{
theFact->factHeader.busyCount--;
break;
}
theFact->factHeader.busyCount--;
if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
break;
}
else
{
theFact->factHeader.busyCount++;
EvaluationData(theEnv)->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp);
EvaluationData(theEnv)->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,FALSE,TRUE);
theFact->factHeader.busyCount--;
if (EvaluationData(theEnv)->HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != EnvFalseSymbol(theEnv)))
break;
}
theFact = theFact->nextTemplateFact;
while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE)
theFact = theFact->nextTemplateFact;
}
if (theFact != NULL)
return(((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
? FALSE : TRUE);
return(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()
******************************************************************************/
globle void DelayedQueryDoForAllFacts(
void *theEnv,
DATA_OBJECT *result)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt;
register unsigned i;
result->type = SYMBOL;
result->value = EnvFalseSymbol(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 = (struct fact **) gm2(theEnv,(sizeof(struct 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;
while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
{
for (i = 0 ; i < rcnt ; i++)
FactQueryData(theEnv)->QueryCore->solns[i] = FactQueryData(theEnv)->QueryCore->soln_set->soln[i];
PopQuerySoln(theEnv);
EvaluationData(theEnv)->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result);
EvaluationData(theEnv)->CurrentEvaluationDepth--;
if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)
{ PropagateReturnValue(theEnv,result); }
PeriodicCleanup(theEnv,FALSE,TRUE);
if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
{
while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
PopQuerySoln(theEnv);
break;
}
}
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
}
/******************************************************************************
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(
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
int rcnt;
register int i;
result->type = SYMBOL;
result->value = FalseSymbol;
qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg->nextArg,
"delayed-do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore();
QueryCore = get_struct(query_core);
QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
QueryCore->query = GetFirstArgument();
QueryCore->action = NULL;
QueryCore->soln_set = NULL;
QueryCore->soln_size = rcnt;
QueryCore->soln_cnt = 0;
TestEntireChain(qclasses,0);
AbortQuery = FALSE;
QueryCore->action = GetFirstArgument()->nextArg;
while (QueryCore->soln_set != NULL)
{
for (i = 0 ; i < rcnt ; i++)
QueryCore->solns[i] = QueryCore->soln_set->soln[i];
PopQuerySoln();
CurrentEvaluationDepth++;
EvaluateExpression(QueryCore->action,result);
CurrentEvaluationDepth--;
if (ReturnFlag == TRUE)
{ PropagateReturnValue(result); }
PeriodicCleanup(FALSE,TRUE);
if (HaltExecution || BreakFlag || ReturnFlag)
{
while (QueryCore->soln_set != NULL)
PopQuerySoln();
break;
}
}
BreakFlag = FALSE;
rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(query_core,QueryCore);
PopQueryCore();
DeleteQueryClasses(qclasses);
}
globle intBool ExecuteIfCommandComplete(
void *theEnv)
{
if ((CompleteCommand(CommandLineData(theEnv)->CommandString) == 0) ||
(RouterData(theEnv)->CommandBufferInputCount <= 0))
{ return FALSE; }
FlushPPBuffer(theEnv);
SetPPBufferStatus(theEnv,OFF);
RouterData(theEnv)->CommandBufferInputCount = -1;
RouteCommand(theEnv,CommandLineData(theEnv)->CommandString,TRUE);
FlushPPBuffer(theEnv);
SetHaltExecution(theEnv,FALSE);
SetEvaluationError(theEnv,FALSE);
FlushCommandString(theEnv);
FlushBindList(theEnv);
PeriodicCleanup(theEnv,TRUE,FALSE);
PrintPrompt(theEnv);
return TRUE;
}
/*****************************************************************
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,
EXEC_STATUS,
struct defmodule *theModule,
int id,
DEFCLASS *cls,
QUERY_CLASS *qchain,
int indx)
{
long i;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
if (TestTraversalID(cls->traversalRecord,id))
return(FALSE);
SetTraversalID(cls->traversalRecord,id);
if (DefclassInScope(theEnv,execStatus,cls,theModule) == FALSE)
return(FALSE);
ins = cls->instanceList;
while (ins != NULL)
{
InstanceQueryData(theEnv,execStatus)->QueryCore->solns[indx] = ins;
if (qchain->nxt != NULL)
{
ins->busy++;
if (TestForFirstInChain(theEnv,execStatus,qchain->nxt,indx+1) == TRUE)
{
ins->busy--;
break;
}
ins->busy--;
if ((execStatus->HaltExecution == TRUE) || (InstanceQueryData(theEnv,execStatus)->AbortQuery == TRUE))
break;
}
else
{
ins->busy++;
execStatus->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->query,&temp);
execStatus->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,execStatus,FALSE,TRUE);
ins->busy--;
if (execStatus->HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != EnvFalseSymbol(theEnv,execStatus)))
break;
}
ins = ins->nxtClass;
while ((ins != NULL) ? (ins->garbage == 1) : FALSE)
ins = ins->nxtClass;
}
if (ins != NULL)
return(((execStatus->HaltExecution == TRUE) || (InstanceQueryData(theEnv,execStatus)->AbortQuery == TRUE))
? FALSE : TRUE);
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
{
if (TestForFirstInstanceInClass(theEnv,execStatus,theModule,id,cls->directSubclasses.classArray[i],
qchain,indx))
return(TRUE);
if ((execStatus->HaltExecution == TRUE) || (InstanceQueryData(theEnv,execStatus)->AbortQuery == TRUE))
return(FALSE);
}
return(FALSE);
}
static int ConstructsToC(
char *fileName,
int theImageID,
int max)
{
char fname[FSIZE];
int fileVersion;
struct CodeGeneratorItem *cgPtr;
/*===============================================*/
/* Set the global MaxIndices variable indicating */
/* the maximum number of data structures to save */
/* in each file. */
/*===============================================*/
MaxIndices = max;
/*==================================*/
/* Call the list of functions to be */
/* executed before generating code. */
/*==================================*/
for (cgPtr = ListOfCodeGeneratorItems;
cgPtr != NULL;
cgPtr = cgPtr->next)
{ if (cgPtr->beforeFunction != NULL) (*cgPtr->beforeFunction)(); }
/*=================================================*/
/* Do a periodic cleanup without using heuristics */
/* to get rid of as much garbage as possible so */
/* that it isn't written out as C data structures. */
/*=================================================*/
PeriodicCleanup(FALSE,FALSE);
/*=====================================*/
/* Initialize some global information. */
/*=====================================*/
FilePrefix = fileName;
ImageID = theImageID;
ExpressionFP = NULL;
ExpressionVersion = 1;
ExpressionHeader = TRUE;
ExpressionCount = 0;
/*=====================================================*/
/* Open a header file for dumping general information. */
/*=====================================================*/
sprintf(fname,"%s.h",fileName);
if ((HeaderFP = fopen(fname,"w")) == NULL)
{
OpenErrorMessage("constructs-to-c",fname);
return(0);
}
fprintf(HeaderFP,"#ifndef _CONSTRUCT_COMPILER_HEADER_\n");
fprintf(HeaderFP,"#define _CONSTRUCT_COMPILER_HEADER_\n\n");
fprintf(HeaderFP,"#include <stdio.h>\n");
fprintf(HeaderFP,"#include \"setup.h\"\n");
fprintf(HeaderFP,"#include \"expressn.h\"\n");
fprintf(HeaderFP,"#include \"extnfunc.h\"\n");
fprintf(HeaderFP,"#include \"%s\"\n",API_HEADER);
fprintf(HeaderFP,"\n#define VS (void *)\n");
fprintf(HeaderFP,"\n");
/*=========================================================*/
/* Give extern declarations for user and system functions. */
/*=========================================================*/
WriteFunctionExternDeclarations(HeaderFP);
fprintf(HeaderFP,"\n#endif\n\n");
fprintf(HeaderFP,"/****************************/\n");
fprintf(HeaderFP,"/* EXTERN ARRAY DEFINITIONS */\n");
fprintf(HeaderFP,"/****************************/\n\n");
/*==================================*/
/* Generate code for atomic values, */
/* function definitions, hashed */
/* expressions, and constructs. */
/*==================================*/
AtomicValuesToCode(fileName);
FunctionsToCode(fileName);
HashedExpressionsToCode();
ConstraintsToCode(fileName,4,HeaderFP,ImageID,MaxIndices);
/*===============================*/
/* Call each code generator item */
/* for the various constructs. */
/*===============================*/
fileVersion = 5;
for (cgPtr = ListOfCodeGeneratorItems;
cgPtr != NULL;
cgPtr = cgPtr->next)
{
if (cgPtr->generateFunction != NULL)
{
(*cgPtr->generateFunction)(fileName,fileVersion,HeaderFP,ImageID,MaxIndices);
fileVersion++;
}
}
/*=========================================*/
/* Restore the atomic data bucket values */
/* (which were set to an index reference). */
/*=========================================*/
RestoreAtomicValueBuckets();
/*============================*/
/* Close the expression file. */
/*============================*/
if (ExpressionFP != NULL)
{
fprintf(ExpressionFP,"};\n");
fclose(ExpressionFP);
}
/*====================================*/
/* Write the initialization function. */
/*====================================*/
WriteInitializationFunction(fileName);
/*========================*/
/* Close the header file. */
/*========================*/
fclose(HeaderFP);
/*==================================================*/
/* Return TRUE to indicate that the constructs-to-c */
/* command was successfully executed. */
/*==================================================*/
return(TRUE);
}
globle long int EnvRun(
void *theEnv,
long int runLimit)
{
long int rulesFired = 0;
DATA_OBJECT result;
struct callFunctionItem *theRunFunction;
#if DEBUGGING_FUNCTIONS
unsigned long maxActivations = 0, sumActivations = 0;
#if DEFTEMPLATE_CONSTRUCT
unsigned long maxFacts = 0, sumFacts = 0;
#endif
#if OBJECT_SYSTEM
unsigned long maxInstances = 0, sumInstances = 0;
#endif
double endTime, startTime = 0.0;
unsigned long tempValue;
#endif
unsigned int i;
struct patternEntity *theMatchingItem;
struct partialMatch *theBasis;
ACTIVATION *theActivation;
char *ruleFiring;
#if PROFILING_FUNCTIONS
struct profileFrameInfo profileFrame;
#endif
/*=====================================================*/
/* Make sure the run command is not already executing. */
/*=====================================================*/
if (EngineData(theEnv)->AlreadyRunning) return(0);
EngineData(theEnv)->AlreadyRunning = TRUE;
/*================================*/
/* Set up statistics information. */
/*================================*/
#if DEBUGGING_FUNCTIONS
if (EngineData(theEnv)->WatchStatistics)
{
#if DEFTEMPLATE_CONSTRUCT
maxFacts = GetNumberOfFacts(theEnv);
sumFacts = maxFacts;
#endif
#if OBJECT_SYSTEM
maxInstances = GetGlobalNumberOfInstances(theEnv);
sumInstances = maxInstances;
#endif
maxActivations = GetNumberOfActivations(theEnv);
sumActivations = maxActivations;
startTime = gentime();
}
#endif
/*=============================*/
/* Set up execution variables. */
/*=============================*/
if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE);
EngineData(theEnv)->HaltRules = FALSE;
/*=====================================================*/
/* Fire rules until the agenda is empty, the run limit */
/* has been reached, or a rule execution error occurs. */
/*=====================================================*/
theActivation = NextActivationToFire(theEnv);
while ((theActivation != NULL) &&
(runLimit != 0) &&
(EvaluationData(theEnv)->HaltExecution == FALSE) &&
(EngineData(theEnv)->HaltRules == FALSE))
{
/*===========================================*/
/* Detach the activation from the agenda and */
/* determine which rule is firing. */
/*===========================================*/
DetachActivation(theEnv,theActivation);
ruleFiring = EnvGetActivationName(theEnv,theActivation);
theBasis = (struct partialMatch *) GetActivationBasis(theActivation);
EngineData(theEnv)->ExecutingRule = (struct defrule *) GetActivationRule(theActivation);
/*=============================================*/
/* Update the number of rules that have fired. */
/*=============================================*/
rulesFired++;
if (runLimit > 0) { runLimit--; }
/*==================================*/
/* If rules are being watched, then */
/* print an information message. */
/*==================================*/
#if DEBUGGING_FUNCTIONS
if (EngineData(theEnv)->ExecutingRule->watchFiring)
{
char printSpace[60];
sprintf(printSpace,"FIRE %4ld ",rulesFired);
EnvPrintRouter(theEnv,WTRACE,printSpace);
EnvPrintRouter(theEnv,WTRACE,ruleFiring);
EnvPrintRouter(theEnv,WTRACE,": ");
PrintPartialMatch(theEnv,WTRACE,theBasis);
EnvPrintRouter(theEnv,WTRACE,"\n");
}
#endif
/*=================================================*/
/* Remove the link between the activation and the */
/* completed match for the rule. Set the busy flag */
/* for the completed match to TRUE (so the match */
/* upon which our RHS variables are dependent is */
/* not deleted while our rule is firing). Set up */
/* the global pointers to the completed match for */
/* routines which do variable extractions. */
/*=================================================*/
theBasis->binds[theBasis->bcount].gm.theValue = NULL;
theBasis->busy = TRUE;
EngineData(theEnv)->GlobalLHSBinds = theBasis;
EngineData(theEnv)->GlobalRHSBinds = NULL;
/*===================================================================*/
/* Increment the count for each of the facts/objects associated with */
/* the rule activation so that the facts/objects cannot be deleted */
/* by garbage collection while the rule is executing. */
/*===================================================================*/
for (i = 0; i < theBasis->bcount; i++)
{
theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem;
if (theMatchingItem != NULL)
{ (*theMatchingItem->theInfo->incrementBasisCount)(theEnv,theMatchingItem); }
}
/*====================================================*/
/* Execute the rule's right hand side actions. If the */
/* rule has logical CEs, set up the pointer to the */
/* rules logical join so the assert command will */
/* attach the appropriate dependencies to the facts. */
/*====================================================*/
EngineData(theEnv)->TheLogicalJoin = EngineData(theEnv)->ExecutingRule->logicalJoin;
EvaluationData(theEnv)->CurrentEvaluationDepth++;
SetEvaluationError(theEnv,FALSE);
EngineData(theEnv)->ExecutingRule->executing = TRUE;
#if PROFILING_FUNCTIONS
StartProfile(theEnv,&profileFrame,
&EngineData(theEnv)->ExecutingRule->header.usrData,
ProfileFunctionData(theEnv)->ProfileConstructs);
#endif
EvaluateProcActions(theEnv,EngineData(theEnv)->ExecutingRule->header.whichModule->theModule,
EngineData(theEnv)->ExecutingRule->actions,EngineData(theEnv)->ExecutingRule->localVarCnt,
&result,NULL);
#if PROFILING_FUNCTIONS
EndProfile(theEnv,&profileFrame);
#endif
EngineData(theEnv)->ExecutingRule->executing = FALSE;
SetEvaluationError(theEnv,FALSE);
EvaluationData(theEnv)->CurrentEvaluationDepth--;
EngineData(theEnv)->TheLogicalJoin = NULL;
/*=====================================================*/
/* If rule execution was halted, then print a message. */
/*=====================================================*/
#if DEBUGGING_FUNCTIONS
if ((EvaluationData(theEnv)->HaltExecution) || (EngineData(theEnv)->HaltRules && EngineData(theEnv)->ExecutingRule->watchFiring))
#else
if ((EvaluationData(theEnv)->HaltExecution) || (EngineData(theEnv)->HaltRules))
#endif
{
PrintErrorID(theEnv,"PRCCODE",4,FALSE);
EnvPrintRouter(theEnv,WERROR,"Execution halted during the actions of defrule ");
EnvPrintRouter(theEnv,WERROR,ruleFiring);
EnvPrintRouter(theEnv,WERROR,".\n");
}
/*===================================================================*/
/* Decrement the count for each of the facts/objects associated with */
/* the rule activation. If the last match for the activation */
/* is from a not CE, then we need to make sure that the last */
/* match is an actual match for the CE and not a counter. */
/*===================================================================*/
theBasis->busy = FALSE;
for (i = 0; i < (theBasis->bcount - 1); i++)
{
theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem;
if (theMatchingItem != NULL)
{ (*theMatchingItem->theInfo->decrementBasisCount)(theEnv,theMatchingItem); }
}
i = (unsigned) (theBasis->bcount - 1);
if (theBasis->counterf == FALSE)
{
theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem;
if (theMatchingItem != NULL)
{ (*theMatchingItem->theInfo->decrementBasisCount)(theEnv,theMatchingItem); }
}
/*========================================*/
/* Return the agenda node to free memory. */
/*========================================*/
RemoveActivation(theEnv,theActivation,FALSE,FALSE);
/*======================================*/
/* Get rid of partial matches discarded */
/* while executing the rule's RHS. */
/*======================================*/
FlushGarbagePartialMatches(theEnv);
/*==================================*/
/* Get rid of other garbage created */
/* while executing the rule's RHS. */
/*==================================*/
PeriodicCleanup(theEnv,FALSE,TRUE);
/*==========================*/
/* Keep up with statistics. */
/*==========================*/
#if DEBUGGING_FUNCTIONS
if (EngineData(theEnv)->WatchStatistics)
{
#if DEFTEMPLATE_CONSTRUCT
tempValue = GetNumberOfFacts(theEnv);
if (tempValue > maxFacts) maxFacts = tempValue;
sumFacts += tempValue;
#endif
#if OBJECT_SYSTEM
tempValue = GetGlobalNumberOfInstances(theEnv);
if (tempValue > maxInstances) maxInstances = tempValue;
sumInstances += tempValue;
#endif
tempValue = GetNumberOfActivations(theEnv);
if (tempValue > maxActivations) maxActivations = tempValue;
sumActivations += tempValue;
}
#endif
/*==================================*/
/* Update saliences if appropriate. */
/*==================================*/
if (EnvGetSalienceEvaluation(theEnv) == EVERY_CYCLE) EnvRefreshAgenda(theEnv,NULL);
/*========================================*/
/* Execute the list of functions that are */
/* to be called after each rule firing. */
/*========================================*/
for (theRunFunction = EngineData(theEnv)->ListOfRunFunctions;
theRunFunction != NULL;
theRunFunction = theRunFunction->next)
{
if (theRunFunction->environmentAware)
{ (*theRunFunction->func)(theEnv); }
else
{ ((void (*)(void))(*theRunFunction->func))(); }
}
/*========================================*/
/* If a return was issued on the RHS of a */
/* rule, then remove *that* rule's module */
/* from the focus stack */
/*========================================*/
if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)
{ RemoveFocus(theEnv,EngineData(theEnv)->ExecutingRule->header.whichModule->theModule); }
ProcedureFunctionData(theEnv)->ReturnFlag = FALSE;
/*========================================*/
/* Determine the next activation to fire. */
/*========================================*/
theActivation = (struct activation *) NextActivationToFire(theEnv);
/*==============================*/
/* Check for a rule breakpoint. */
/*==============================*/
if (theActivation != NULL)
{
if (((struct defrule *) GetActivationRule(theActivation))->afterBreakpoint)
{
EngineData(theEnv)->HaltRules = TRUE;
EnvPrintRouter(theEnv,WDIALOG,"Breaking on rule ");
EnvPrintRouter(theEnv,WDIALOG,EnvGetActivationName(theEnv,theActivation));
EnvPrintRouter(theEnv,WDIALOG,".\n");
}
}
}
/*=====================================================*/
/* Make sure run functions are executed at least once. */
/*=====================================================*/
if (rulesFired == 0)
{
for (theRunFunction = EngineData(theEnv)->ListOfRunFunctions;
theRunFunction != NULL;
theRunFunction = theRunFunction->next)
{
if (theRunFunction->environmentAware)
{ (*theRunFunction->func)(theEnv); }
else
{ ((void (*)(void))(*theRunFunction->func))(); }
}
}
/*======================================================*/
/* If rule execution was halted because the rule firing */
/* limit was reached, then print a message. */
/*======================================================*/
if (runLimit == rulesFired)
{ EnvPrintRouter(theEnv,WDIALOG,"rule firing limit reached\n"); }
/*==============================*/
/* Restore execution variables. */
/*==============================*/
EngineData(theEnv)->ExecutingRule = NULL;
EngineData(theEnv)->HaltRules = FALSE;
/*=================================================*/
/* Print out statistics if they are being watched. */
/*=================================================*/
#if DEBUGGING_FUNCTIONS
if (EngineData(theEnv)->WatchStatistics)
{
char printSpace[60];
endTime = gentime();
PrintLongInteger(theEnv,WDIALOG,rulesFired);
EnvPrintRouter(theEnv,WDIALOG," rules fired");
#if (! GENERIC)
if (startTime != endTime)
{
EnvPrintRouter(theEnv,WDIALOG," Run time is ");
PrintFloat(theEnv,WDIALOG,endTime - startTime);
EnvPrintRouter(theEnv,WDIALOG," seconds.\n");
PrintFloat(theEnv,WDIALOG,(double) rulesFired / (endTime - startTime));
EnvPrintRouter(theEnv,WDIALOG," rules per second.\n");
}
else
{ EnvPrintRouter(theEnv,WDIALOG,"\n"); }
#endif
#if DEFTEMPLATE_CONSTRUCT
sprintf(printSpace,"%ld mean number of facts (%ld maximum).\n",
(long) (((double) sumFacts / (rulesFired + 1)) + 0.5),
maxFacts);
EnvPrintRouter(theEnv,WDIALOG,printSpace);
#endif
#if OBJECT_SYSTEM
sprintf(printSpace,"%ld mean number of instances (%ld maximum).\n",
(long) (((double) sumInstances / (rulesFired + 1)) + 0.5),
maxInstances);
EnvPrintRouter(theEnv,WDIALOG,printSpace);
#endif
sprintf(printSpace,"%ld mean number of activations (%ld maximum).\n",
(long) (((double) sumActivations / (rulesFired + 1)) + 0.5),
maxActivations);
EnvPrintRouter(theEnv,WDIALOG,printSpace);
}
#endif
/*==========================================*/
/* The current module should be the current */
/* focus when the run finishes. */
/*==========================================*/
if (EngineData(theEnv)->CurrentFocus != NULL)
{
if (EngineData(theEnv)->CurrentFocus->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
{ EnvSetCurrentModule(theEnv,(void *) EngineData(theEnv)->CurrentFocus->theModule); }
}
/*===================================*/
/* Return the number of rules fired. */
/*===================================*/
EngineData(theEnv)->AlreadyRunning = FALSE;
return(rulesFired);
}
globle BOOLEAN EnvClear_PY(
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 (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 FALSE;
}
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 ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
(EvaluationData(theEnv)->CurrentExpression == NULL))
{ PeriodicCleanup(theEnv,TRUE,FALSE); }
/*===========================*/
/* Clear has been completed. */
/*===========================*/
ConstructData(theEnv)->ClearInProgress = FALSE;
return TRUE;
}
globle void *Assert(
void *vTheFact)
{
int hashValue;
int length, i;
struct field *theField;
struct fact *theFact = (struct fact *) vTheFact;
/*==========================================*/
/* A fact can not be asserted while another */
/* fact is being asserted or retracted. */
/*==========================================*/
if (JoinOperationInProgress)
{
ReturnFact(theFact);
PrintErrorID("FACTMNGR",2,TRUE);
PrintRouter(WERROR,"Facts may not be asserted during pattern-matching\n");
return(NULL);
}
/*=============================================================*/
/* Replace invalid data types in the fact with the symbol nil. */
/*=============================================================*/
length = theFact->theProposition.multifieldLength;
theField = theFact->theProposition.theFields;
for (i = 0; i < length; i++)
{
if (theField[i].type == RVOID)
{
theField[i].type = SYMBOL;
theField[i].value = (void *) AddSymbol("nil");
}
}
/*========================================================*/
/* If fact assertions are being checked for duplications, */
/* then search the fact list for a duplicate fact. */
/*========================================================*/
hashValue = HandleFactDuplication(theFact);
if (hashValue < 0) return(NULL);
/*==========================================================*/
/* If necessary, add logical dependency links between the */
/* fact and the partial match which is its logical support. */
/*==========================================================*/
#if LOGICAL_DEPENDENCIES
if (AddLogicalDependencies((struct patternEntity *) theFact,FALSE) == FALSE)
{
ReturnFact(theFact);
return(NULL);
}
#endif
/*======================================*/
/* Add the fact to the fact hash table. */
/*======================================*/
AddHashedFact(theFact,hashValue);
/*================================*/
/* Add the fact to the fact list. */
/*================================*/
theFact->nextFact = NULL;
theFact->list = NULL;
theFact->previousFact = LastFact;
if (LastFact == NULL)
{ FactList = theFact; }
else
{ LastFact->nextFact = theFact; }
LastFact = theFact;
/*==================================*/
/* Set the fact index and time tag. */
/*==================================*/
theFact->factIndex = NextFactIndex++;
theFact->factHeader.timeTag = CurrentEntityTimeTag++;
/*=====================*/
/* Update busy counts. */
/*=====================*/
FactInstall(theFact);
/*==========================*/
/* Print assert output if */
/* facts are being watched. */
/*==========================*/
#if DEBUGGING_FUNCTIONS
if (theFact->whichDeftemplate->watch)
{
PrintRouter(WTRACE,"==> ");
PrintFactWithIdentifier(WTRACE,theFact);
PrintRouter(WTRACE,"\n");
}
#endif
/*==================================*/
/* Set the change flag to indicate */
/* the fact-list has been modified. */
/*==================================*/
ChangeToFactList = TRUE;
/*==========================================*/
/* Check for constraint errors in the fact. */
/*==========================================*/
CheckTemplateFact(theFact);
/*===================================================*/
/* Reset the evaluation error flag since expressions */
/* will be evaluated as part of the assert . */
/*===================================================*/
SetEvaluationError(FALSE);
/*=============================================*/
/* Pattern match the fact using the associated */
/* deftemplate's pattern network. */
/*=============================================*/
JoinOperationInProgress = TRUE;
FactPatternMatch(theFact,theFact->whichDeftemplate->patternNetwork,0,NULL,NULL);
JoinOperationInProgress = FALSE;
/*===================================================*/
/* Retract other facts that were logically dependent */
/* on the non-existence of the fact just asserted. */
/*===================================================*/
#if LOGICAL_DEPENDENCIES
ForceLogicalRetractions();
#endif
/*=========================================*/
/* Free partial matches that were released */
/* by the assertion of the fact. */
/*=========================================*/
if (ExecutingRule == NULL) FlushGarbagePartialMatches();
/*==========================================*/
/* Force periodic cleanup if the assert was */
/* executed from an embedded application. */
/*==========================================*/
if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
(CurrentExpression == NULL))
{ PeriodicCleanup(TRUE,FALSE); }
/*===============================*/
/* Return a pointer to the fact. */
/*===============================*/
return((void *) theFact);
}
globle void LoopForCountFunction(
DATA_OBJECT_PTR loopResult)
{
DATA_OBJECT arg_ptr;
long iterationEnd;
LOOP_COUNTER_STACK *tmpCounter;
tmpCounter = get_struct(loopCounterStack);
tmpCounter->loopCounter = 0L;
tmpCounter->nxt = LoopCounterStack;
LoopCounterStack = tmpCounter;
if (ArgTypeCheck("loop-for-count",1,INTEGER,&arg_ptr) == FALSE)
{
loopResult->type = SYMBOL;
loopResult->value = FalseSymbol;
LoopCounterStack = tmpCounter->nxt;
rtn_struct(loopCounterStack,tmpCounter);
return;
}
tmpCounter->loopCounter = DOToLong(arg_ptr);
if (ArgTypeCheck("loop-for-count",2,INTEGER,&arg_ptr) == FALSE)
{
loopResult->type = SYMBOL;
loopResult->value = FalseSymbol;
LoopCounterStack = tmpCounter->nxt;
rtn_struct(loopCounterStack,tmpCounter);
return;
}
iterationEnd = DOToLong(arg_ptr);
while ((tmpCounter->loopCounter <= iterationEnd) &&
(HaltExecution != TRUE))
{
if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
break;
CurrentEvaluationDepth++;
RtnUnknown(3,&arg_ptr);
CurrentEvaluationDepth--;
if (ReturnFlag == TRUE)
{ PropagateReturnValue(&arg_ptr); }
PeriodicCleanup(FALSE,TRUE);
if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
break;
tmpCounter->loopCounter++;
}
BreakFlag = FALSE;
if (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 = FalseSymbol;
}
LoopCounterStack = tmpCounter->nxt;
rtn_struct(loopCounterStack,tmpCounter);
}
globle void QSetDefglobalValue(
void *theEnv,
struct defglobal *theGlobal,
DATA_OBJECT_PTR vPtr,
int resetVar)
{
/*====================================================*/
/* 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->type = SYMBOL;
vPtr->value = EnvFalseSymbol(theEnv);
}
}
/*==========================================*/
/* If globals are being watch, then display */
/* the change to the global variable. */
/*==========================================*/
#if DEBUGGING_FUNCTIONS
if (theGlobal->watch)
{
EnvPrintRouter(theEnv,WTRACE,":== ?*");
EnvPrintRouter(theEnv,WTRACE,ValueToString(theGlobal->header.name));
EnvPrintRouter(theEnv,WTRACE,"* ==> ");
PrintDataObject(theEnv,WTRACE,vPtr);
EnvPrintRouter(theEnv,WTRACE," <== ");
PrintDataObject(theEnv,WTRACE,&theGlobal->current);
EnvPrintRouter(theEnv,WTRACE,"\n");
}
#endif
/*==============================================*/
/* Remove the old value of the global variable. */
/*==============================================*/
ValueDeinstall(theEnv,&theGlobal->current);
if (theGlobal->current.type == MULTIFIELD)
{ ReturnMultifield(theEnv,(struct multifield *) theGlobal->current.value); }
/*===========================================*/
/* Set the new value of the global variable. */
/*===========================================*/
theGlobal->current.type = vPtr->type;
if (vPtr->type != MULTIFIELD) theGlobal->current.value = vPtr->value;
else DuplicateMultifield(theEnv,&theGlobal->current,vPtr);
ValueInstall(theEnv,&theGlobal->current);
/*===========================================*/
/* Set the variable indicating that a change */
/* has been made to a global variable. */
/*===========================================*/
DefglobalData(theEnv)->ChangeToGlobals = TRUE;
if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
(EvaluationData(theEnv)->CurrentExpression == NULL))
{ PeriodicCleanup(theEnv,TRUE,FALSE); }
}
globle void Reset()
{
struct callFunctionItem *resetPtr;
/*=====================================*/
/* The reset command can't be executed */
/* while a reset is in progress. */
/*=====================================*/
if (ResetInProgress) return;
ResetInProgress = TRUE;
ResetReadyInProgress = TRUE;
/*================================================*/
/* If the reset is performed from the top level */
/* command prompt, reset the halt execution flag. */
/*================================================*/
if (CurrentEvaluationDepth == 0) SetHaltExecution(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 ((BeforeResetFunction != NULL) ? ((*BeforeResetFunction)() == FALSE) :
FALSE)
{
ResetReadyInProgress = FALSE;
ResetInProgress = FALSE;
return;
}
ResetReadyInProgress = FALSE;
/*===========================*/
/* Call each reset function. */
/*===========================*/
for (resetPtr = ListOfResetFunctions;
(resetPtr != NULL) && (GetHaltExecution() == FALSE);
resetPtr = resetPtr->next)
{ (*resetPtr->func)(); }
/*============================================*/
/* Set the current module to the MAIN module. */
/*============================================*/
SetCurrentModule((void *) FindDefmodule("MAIN"));
/*===========================================*/
/* Perform periodic cleanup if the reset was */
/* issued from an embedded controller. */
/*===========================================*/
if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
(CurrentExpression == NULL))
{ PeriodicCleanup(TRUE,FALSE); }
/*===================================*/
/* A reset is no longer in progress. */
/*===================================*/
ResetInProgress = FALSE;
}
globle void EnvReset(
void *theEnv,
EXEC_STATUS)
{
struct callFunctionItem *resetPtr;
/*=====================================*/
/* The reset command can't be executed */
/* while a reset is in progress. */
/*=====================================*/
if (ConstructData(theEnv,execStatus)->ResetInProgress) return;
ConstructData(theEnv,execStatus)->ResetInProgress = TRUE;
ConstructData(theEnv,execStatus)->ResetReadyInProgress = TRUE;
/*================================================*/
/* If the reset is performed from the top level */
/* command prompt, reset the halt execution flag. */
/*================================================*/
if (execStatus->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,execStatus,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,execStatus)->BeforeResetFunction != NULL) ?
((*ConstructData(theEnv,execStatus)->BeforeResetFunction)(theEnv,execStatus) == FALSE) :
FALSE)
{
ConstructData(theEnv,execStatus)->ResetReadyInProgress = FALSE;
ConstructData(theEnv,execStatus)->ResetInProgress = FALSE;
return;
}
ConstructData(theEnv,execStatus)->ResetReadyInProgress = FALSE;
/*===========================*/
/* Call each reset function. */
/*===========================*/
for (resetPtr = ConstructData(theEnv,execStatus)->ListOfResetFunctions;
(resetPtr != NULL) && (GetHaltExecution(theEnv,execStatus) == FALSE);
resetPtr = resetPtr->next)
{
if (resetPtr->environmentAware)
{ (*resetPtr->func)(theEnv,execStatus); }
else
{ (* (void (*)(void)) resetPtr->func)(); }
}
/*============================================*/
/* Set the current module to the MAIN module. */
/*============================================*/
EnvSetCurrentModule(theEnv,execStatus,(void *) EnvFindDefmodule(theEnv,execStatus,"MAIN"));
/*===========================================*/
/* Perform periodic cleanup if the reset was */
/* issued from an embedded controller. */
/*===========================================*/
if ((execStatus->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv,execStatus)->EvaluatingTopLevelCommand) &&
(execStatus->CurrentExpression == NULL))
{ PeriodicCleanup(theEnv,execStatus,TRUE,FALSE); }
/*===================================*/
/* A reset is no longer in progress. */
/*===================================*/
ConstructData(theEnv,execStatus)->ResetInProgress = FALSE;
}
globle void Clear()
{
struct callFunctionItem *theFunction;
/*==========================================*/
/* Activate the watch router which captures */
/* trace output so that it is not displayed */
/* during a clear. */
/*==========================================*/
#if DEBUGGING_FUNCTIONS
ActivateRouter(WTRACE);
#endif
/*===================================*/
/* Determine if a clear is possible. */
/*===================================*/
ClearReadyInProgress = TRUE;
if (ClearReady() == FALSE)
{
PrintErrorID("CONSTRCT",1,FALSE);
PrintRouter(WERROR,"Some constructs are still in use. Clear cannot continue.\n");
#if DEBUGGING_FUNCTIONS
DeactivateRouter(WTRACE);
#endif
ClearReadyInProgress = FALSE;
return;
}
ClearReadyInProgress = FALSE;
/*===========================*/
/* Call all clear functions. */
/*===========================*/
ClearInProgress = TRUE;
for (theFunction = ListOfClearFunctions;
theFunction != NULL;
theFunction = theFunction->next)
{ (*theFunction->func)(); }
/*=============================*/
/* Deactivate the watch router */
/* for capturing output. */
/*=============================*/
#if DEBUGGING_FUNCTIONS
DeactivateRouter(WTRACE);
#endif
/*===========================================*/
/* Perform periodic cleanup if the clear was */
/* issued from an embedded controller. */
/*===========================================*/
if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
(CurrentExpression == NULL))
{ PeriodicCleanup(TRUE,FALSE); }
/*===========================*/
/* Clear has been completed. */
/*===========================*/
ClearInProgress = FALSE;
}
/*****************************************************
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;
}
}
globle int LoadConstructsFromLogicalName(
void *theEnv,
char *readSource)
{
int constructFlag;
struct token theToken;
int noErrors = TRUE;
int foundConstruct;
/*=========================================*/
/* Reset the halt execution and evaluation */
/* error flags in preparation for parsing. */
/*=========================================*/
if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE);
SetEvaluationError(theEnv,FALSE);
/*========================================================*/
/* Find the beginning of the first construct in the file. */
/*========================================================*/
EvaluationData(theEnv)->CurrentEvaluationDepth++;
GetToken(theEnv,readSource,&theToken);
foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors);
/*==================================================*/
/* Parse the file until the end of file is reached. */
/*==================================================*/
while ((foundConstruct == TRUE) && (GetHaltExecution(theEnv) == FALSE))
{
/*===========================================================*/
/* Clear the pretty print buffer in preparation for parsing. */
/*===========================================================*/
FlushPPBuffer(theEnv);
/*======================*/
/* Parse the construct. */
/*======================*/
constructFlag = ParseConstruct(theEnv,ValueToString(theToken.value),readSource);
/*==============================================================*/
/* If an error occurred while parsing, then find the beginning */
/* of the next construct (but don't generate any more error */
/* messages--in effect, skip everything until another construct */
/* is found). */
/*==============================================================*/
if (constructFlag == 1)
{
EnvPrintRouter(theEnv,WERROR,"\nERROR:\n");
PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv));
EnvPrintRouter(theEnv,WERROR,"\n");
noErrors = FALSE;
GetToken(theEnv,readSource,&theToken);
foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,TRUE,&noErrors);
}
/*======================================================*/
/* Otherwise, find the beginning of the next construct. */
/*======================================================*/
else
{
GetToken(theEnv,readSource,&theToken);
foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors);
}
/*=====================================================*/
/* Yield time if necessary to foreground applications. */
/*=====================================================*/
if (foundConstruct)
{ IncrementSymbolCount(theToken.value); }
EvaluationData(theEnv)->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,FALSE,TRUE);
YieldTime(theEnv);
EvaluationData(theEnv)->CurrentEvaluationDepth++;
if (foundConstruct)
{ DecrementSymbolCount(theEnv,(SYMBOL_HN *) theToken.value); }
}
EvaluationData(theEnv)->CurrentEvaluationDepth--;
/*========================================================*/
/* Print a carriage return if a single character is being */
/* printed to indicate constructs are being processed. */
/*========================================================*/
#if DEBUGGING_FUNCTIONS
if ((EnvGetWatchItem(theEnv,"compilations") != TRUE) && GetPrintWhileLoading(theEnv))
#else
if (GetPrintWhileLoading(theEnv))
#endif
{ EnvPrintRouter(theEnv,WDIALOG,"\n"); }
/*=============================================================*/
/* Once the load is complete, destroy the pretty print buffer. */
/* This frees up any memory that was used to create the pretty */
/* print forms for constructs during parsing. Thus calls to */
/* the mem-used function will accurately reflect the amount of */
/* memory being used after a load command. */
/*=============================================================*/
DestroyPPBuffer(theEnv);
/*==========================================================*/
/* Return a boolean flag which indicates whether any errors */
/* were encountered while loading the constructs. */
/*==========================================================*/
return(noErrors);
}
globle BOOLEAN Retract(
void *vTheFact)
{
struct fact *theFact = (struct fact *) vTheFact;
/*===========================================*/
/* A fact can not be retracted while another */
/* fact is being asserted or retracted. */
/*===========================================*/
if (JoinOperationInProgress)
{
PrintErrorID("FACTMNGR",1,TRUE);
PrintRouter(WERROR,"Facts may not be retracted during pattern-matching\n");
return(FALSE);
}
/*====================================*/
/* A NULL fact pointer indicates that */
/* all facts should be retracted. */
/*====================================*/
if (theFact == NULL)
{
RemoveAllFacts();
return(TRUE);
}
/*======================================================*/
/* Check to see if the fact has already been retracted. */
/*======================================================*/
if (theFact->garbage) return(FALSE);
/*============================*/
/* Print retraction output if */
/* facts are being watched. */
/*============================*/
#if DEBUGGING_FUNCTIONS
if (theFact->whichDeftemplate->watch)
{
PrintRouter(WTRACE,"<== ");
PrintFactWithIdentifier(WTRACE,theFact);
PrintRouter(WTRACE,"\n");
}
#endif
/*==================================*/
/* Set the change flag to indicate */
/* the fact-list has been modified. */
/*==================================*/
ChangeToFactList = TRUE;
/*===============================================*/
/* Remove any links between the fact and partial */
/* matches in the join network. These links are */
/* used to keep track of logical dependencies. */
/*===============================================*/
#if LOGICAL_DEPENDENCIES
RemoveEntityDependencies((struct patternEntity *) theFact);
#endif
/*===========================================*/
/* Remove the fact from the fact hash table. */
/*===========================================*/
RemoveHashedFact(theFact);
/*=====================================*/
/* Remove the fact from the fact list. */
/*=====================================*/
if (theFact == LastFact)
{ LastFact = theFact->previousFact; }
if (theFact->previousFact == NULL)
{
FactList = FactList->nextFact;
if (FactList != NULL)
{ FactList->previousFact = NULL; }
}
else
{
theFact->previousFact->nextFact = theFact->nextFact;
if (theFact->nextFact != NULL)
{ theFact->nextFact->previousFact = theFact->previousFact; }
}
/*==================================*/
/* Update busy counts and ephemeral */
/* garbage information. */
/*==================================*/
FactDeinstall(theFact);
EphemeralItemCount++;
EphemeralItemSize += sizeof(struct fact) + (sizeof(struct field) * theFact->theProposition.multifieldLength);
/*========================================*/
/* Add the fact to the fact garbage list. */
/*========================================*/
theFact->nextFact = GarbageFacts;
GarbageFacts = theFact;
theFact->garbage = TRUE;
/*===================================================*/
/* Reset the evaluation error flag since expressions */
/* will be evaluated as part of the retract. */
/*===================================================*/
SetEvaluationError(FALSE);
/*===========================================*/
/* Loop through the list of all the patterns */
/* that matched the fact and process the */
/* retract operation for each one. */
/*===========================================*/
JoinOperationInProgress = TRUE;
NetworkRetract((struct patternMatch *) theFact->list);
JoinOperationInProgress = FALSE;
/*=========================================*/
/* Free partial matches that were released */
/* by the retraction of the fact. */
/*=========================================*/
if (ExecutingRule == NULL)
{ FlushGarbagePartialMatches(); }
/*=========================================*/
/* Retract other facts that were logically */
/* dependent on the fact just retracted. */
/*=========================================*/
#if LOGICAL_DEPENDENCIES
ForceLogicalRetractions();
#endif
/*===========================================*/
/* Force periodic cleanup if the retract was */
/* executed from an embedded application. */
/*===========================================*/
if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
(CurrentExpression == NULL))
{ PeriodicCleanup(TRUE,FALSE); }
/*==================================*/
/* Return TRUE to indicate the fact */
/* was successfully retracted. */
/*==================================*/
return(TRUE);
}
/*****************************************************************
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(
void *theEnv,
struct deftemplate *templatePtr,
QUERY_TEMPLATE *qchain,
int indx)
{
struct fact *theFact;
DATA_OBJECT temp;
theFact = templatePtr->factList;
while (theFact != NULL)
{
FactQueryData(theEnv)->QueryCore->solns[indx] = theFact;
if (qchain->nxt != NULL)
{
theFact->factHeader.busyCount++;
TestEntireChain(theEnv,qchain->nxt,indx+1);
theFact->factHeader.busyCount--;
if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
break;
}
else
{
theFact->factHeader.busyCount++;
EvaluationData(theEnv)->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp);
EvaluationData(theEnv)->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,FALSE,TRUE);
theFact->factHeader.busyCount--;
if (EvaluationData(theEnv)->HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != EnvFalseSymbol(theEnv)))
{
if (FactQueryData(theEnv)->QueryCore->action != NULL)
{
theFact->factHeader.busyCount++;
EvaluationData(theEnv)->CurrentEvaluationDepth++;
ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,FactQueryData(theEnv)->QueryCore->result);
ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
EvaluationData(theEnv)->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,FALSE,TRUE);
theFact->factHeader.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;
}
}
/*****************************************************************
NAME : TestEntireClass
DESCRIPTION : Processes all instances in a class and then
all subclasses of a class until 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 : Nothing useful
SIDE EFFECTS : Instance variable values set
Solution sets stored in global list
NOTES : None
*****************************************************************/
static void TestEntireClass(
struct defmodule *theModule,
int id,
DEFCLASS *cls,
QUERY_CLASS *qchain,
int indx)
{
register unsigned i;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
if (TestTraversalID(cls->traversalRecord,id))
return;
SetTraversalID(cls->traversalRecord,id);
if (DefclassInScope(cls,theModule) == FALSE)
return;
ins = cls->instanceList;
while (ins != NULL)
{
QueryCore->solns[indx] = ins;
if (qchain->nxt != NULL)
{
ins->busy++;
TestEntireChain(qchain->nxt,indx+1);
ins->busy--;
if ((HaltExecution == TRUE) || (AbortQuery == TRUE))
break;
}
else
{
ins->busy++;
CurrentEvaluationDepth++;
EvaluateExpression(QueryCore->query,&temp);
CurrentEvaluationDepth--;
PeriodicCleanup(FALSE,TRUE);
ins->busy--;
if (HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != FalseSymbol))
{
if (QueryCore->action != NULL)
{
ins->busy++;
CurrentEvaluationDepth++;
ValueDeinstall(QueryCore->result);
EvaluateExpression(QueryCore->action,QueryCore->result);
ValueInstall(QueryCore->result);
CurrentEvaluationDepth--;
PeriodicCleanup(FALSE,TRUE);
ins->busy--;
if (BreakFlag || ReturnFlag)
{
AbortQuery = TRUE;
break;
}
if (HaltExecution == TRUE)
break;
}
else
AddSolution();
}
}
ins = ins->nxtClass;
while ((ins != NULL) ? (ins->garbage == 1) : FALSE)
ins = ins->nxtClass;
}
if (ins != NULL)
return;
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
{
TestEntireClass(theModule,id,cls->directSubclasses.classArray[i],qchain,indx);
if ((HaltExecution == TRUE) || (AbortQuery == TRUE))
return;
}
}