globle void PrognFunction(
DATA_OBJECT_PTR returnValue)
{
int numa, i;
numa = RtnArgCount();
if (numa == 0)
{
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
return;
}
i = 1;
while ((i <= numa) && (GetHaltExecution() != TRUE))
{
RtnUnknown(i,returnValue);
if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
break;
i++;
}
if (GetHaltExecution() == TRUE)
{
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
return;
}
return;
}
globle void Dependents(
void *theEnv,
struct patternEntity *theEntity)
{
struct patternEntity *entityPtr = NULL;
struct patternParser *theParser = NULL;
struct dependency *fdPtr;
struct partialMatch *theBinds;
int found = FALSE;
/*=================================*/
/* Loop through every data entity. */
/*=================================*/
for (GetNextPatternEntity(theEnv,&theParser,&entityPtr);
entityPtr != NULL;
GetNextPatternEntity(theEnv,&theParser,&entityPtr))
{
if (GetHaltExecution(theEnv) == TRUE) return;
/*====================================*/
/* Loop through every dependency link */
/* associated with the data entity. */
/*====================================*/
for (fdPtr = (struct dependency *) entityPtr->dependents;
fdPtr != NULL;
fdPtr = fdPtr->next)
{
if (GetHaltExecution(theEnv) == TRUE) return;
/*=====================================================*/
/* If the data entity which was the argument passed to */
/* the dependents command is contained in one of the */
/* partial matches of the data entity currently being */
/* examined, then the data entity being examined is a */
/* dependent. Print the data entity and then move on */
/* to the next data entity. */
/*=====================================================*/
theBinds = (struct partialMatch *) fdPtr->dPtr;
if (FindEntityInPartialMatch(theEntity,theBinds) == TRUE)
{
if (found) EnvPrintRouter(theEnv,WDISPLAY,",");
(*entityPtr->theInfo->base.shortPrintFunction)(theEnv,WDISPLAY,entityPtr);
found = TRUE;
break;
}
}
}
/*=================================================*/
/* If no dependents were found, then print "None." */
/* Otherwise print a carriage return after the */
/* list of dependents. */
/*=================================================*/
if (! found) EnvPrintRouter(theEnv,WDISPLAY,"None\n");
else EnvPrintRouter(theEnv,WDISPLAY,"\n");
}
globle void PrognFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
struct expr *argPtr;
argPtr = EvaluationData(theEnv)->CurrentExpression->argList;
if (argPtr == NULL)
{
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
return;
}
while ((argPtr != NULL) && (GetHaltExecution(theEnv) != TRUE))
{
EvaluateExpression(theEnv,argPtr,returnValue);
if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
break;
argPtr = argPtr->nextArg;
}
if (GetHaltExecution(theEnv) == TRUE)
{
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
return;
}
return;
}
globle void Dependencies(
void *theEnv,
struct patternEntity *theEntity)
{
struct dependency *fdPtr;
/*=========================================*/
/* If the data entity has no dependencies, */
/* then print "None" and return. */
/*=========================================*/
if (theEntity->dependents == NULL)
{
EnvPrintRouter(theEnv,WDISPLAY,"None\n");
return;
}
/*============================================*/
/* Loop through the list of the data entities */
/* dependencies and print them. */
/*============================================*/
for (fdPtr = (struct dependency *) theEntity->dependents;
fdPtr != NULL;
fdPtr = fdPtr->next)
{
if (GetHaltExecution(theEnv) == TRUE) return;
PrintPartialMatch(theEnv,WDISPLAY,(struct partialMatch *) fdPtr->dPtr);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
}
}
void Dependencies(
Environment *theEnv,
struct patternEntity *theEntity)
{
struct dependency *fdPtr;
/*=========================================*/
/* If the data entity has no dependencies, */
/* then print "None" and return. */
/*=========================================*/
if (theEntity->dependents == NULL)
{
WriteString(theEnv,STDOUT,"None\n");
return;
}
/*============================================*/
/* Loop through the list of the data entities */
/* dependencies and print them. */
/*============================================*/
for (fdPtr = (struct dependency *) theEntity->dependents;
fdPtr != NULL;
fdPtr = fdPtr->next)
{
if (GetHaltExecution(theEnv) == true) return;
PrintPartialMatch(theEnv,STDOUT,(struct partialMatch *) fdPtr->dPtr);
WriteString(theEnv,STDOUT,"\n");
}
}
static void PrintMatchesMemory(
void *theEnv,
struct joinNode *theJoin,
struct betaMemory *theMemory,
int startCE,
int endCE)
{
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(theJoin)
#endif
struct partialMatch *listOfMatches;
unsigned long b;
int matchesDisplayed;
if (GetHaltExecution(theEnv) == TRUE)
{ return; }
matchesDisplayed = 0;
EnvPrintRouter(theEnv,WDISPLAY,"Partial matches for CEs ");
PrintLongInteger(theEnv,WDISPLAY,(long int) startCE);
EnvPrintRouter(theEnv,WDISPLAY," - ");
PrintLongInteger(theEnv,WDISPLAY,(long int) endCE);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
for (b = 0; b < theMemory->size; b++)
{
listOfMatches = theMemory->beta[b];
while (listOfMatches != NULL)
{
if (GetHaltExecution(theEnv) == TRUE)
{ return; }
matchesDisplayed++;
PrintPartialMatch(theEnv,WDISPLAY,listOfMatches);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
listOfMatches = listOfMatches->nextInMemory;
}
}
if (matchesDisplayed == 0) { EnvPrintRouter(theEnv,WDISPLAY," None\n"); }
}
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 int ParseConstruct(
void *theEnv,
char *name,
char *logicalName)
{
struct construct *currentPtr;
int rv, ov;
/*=================================*/
/* Look for a valid construct name */
/* (e.g. defrule, deffacts). */
/*=================================*/
currentPtr = FindConstruct(theEnv,name);
if (currentPtr == NULL) return(-1);
/*==================================*/
/* Prepare the parsing environment. */
/*==================================*/
ov = GetHaltExecution(theEnv);
SetEvaluationError(theEnv,FALSE);
SetHaltExecution(theEnv,FALSE);
ClearParsedBindNames(theEnv);
PushRtnBrkContexts(theEnv);
ExpressionData(theEnv)->ReturnContext = FALSE;
ExpressionData(theEnv)->BreakContext = FALSE;
EvaluationData(theEnv)->CurrentEvaluationDepth++;
/*=======================================*/
/* Call the construct's parsing routine. */
/*=======================================*/
ConstructData(theEnv)->ParsingConstruct = TRUE;
rv = (*currentPtr->parseFunction)(theEnv,logicalName);
ConstructData(theEnv)->ParsingConstruct = FALSE;
/*===============================*/
/* Restore environment settings. */
/*===============================*/
EvaluationData(theEnv)->CurrentEvaluationDepth--;
PopRtnBrkContexts(theEnv);
ClearParsedBindNames(theEnv);
SetPPBufferStatus(theEnv,OFF);
SetHaltExecution(theEnv,ov);
/*==============================*/
/* Return the status of parsing */
/* the construct. */
/*==============================*/
return(rv);
}
globle void CommandLoopBatchDriver(
void *theEnv)
{
int inchar;
while (TRUE)
{
if (GetHaltCommandLoopBatch(theEnv) == TRUE)
{
CloseAllBatchSources(theEnv);
SetHaltCommandLoopBatch(theEnv,FALSE);
}
/*===================================================*/
/* 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)
{ return; }
else
{ ExpandCommandString(theEnv,(char) inchar); }
}
else
{ return; }
/*=================================================*/
/* 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 long DoForAllModules(
void *theEnv,
EXEC_STATUS,
void (*actionFunction)(struct defmodule *,void *),
int interruptable,
void *userBuffer)
{
void *theModule;
long moduleCount = 0L;
/*==========================*/
/* Save the current module. */
/*==========================*/
SaveCurrentModule(theEnv,execStatus);
/*==================================*/
/* Loop through all of the modules. */
/*==================================*/
for (theModule = EnvGetNextDefmodule(theEnv,execStatus,NULL);
theModule != NULL;
theModule = EnvGetNextDefmodule(theEnv,execStatus,theModule), moduleCount++)
{
EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);
if ((interruptable) && GetHaltExecution(theEnv,execStatus))
{
RestoreCurrentModule(theEnv,execStatus);
return(-1L);
}
(*actionFunction)((struct defmodule *) theModule,userBuffer);
}
/*=============================*/
/* Restore the current module. */
/*=============================*/
RestoreCurrentModule(theEnv,execStatus);
/*=========================================*/
/* Return the number of modules traversed. */
/*=========================================*/
return(moduleCount);
}
static int ListBetaMatches(
void *theEnv,
struct joinNode *theJoin,
int blockStart)
{
int patternsFound = 0, startPatterns;
if (GetHaltExecution(theEnv) == TRUE)
{ return(0); }
if (theJoin == NULL)
{ return(patternsFound); }
if (theJoin->lastLevel != NULL)
{ patternsFound += ListBetaMatches(theEnv,theJoin->lastLevel,blockStart); }
if (theJoin->depth > 2)
{
PrintMatchesMemory(theEnv,theJoin,
theJoin->leftMemory,
blockStart,
blockStart + patternsFound - 1);
}
startPatterns = patternsFound;
if (theJoin->joinFromTheRight)
{ patternsFound += ListBetaMatches(theEnv,(struct joinNode *) theJoin->rightSideEntryStructure,blockStart+patternsFound); }
if ((theJoin->joinFromTheRight) &&
(((struct joinNode *) (theJoin->rightSideEntryStructure))->depth > 1))
{
PrintMatchesMemory(theEnv,theJoin,
theJoin->rightMemory,
blockStart + startPatterns,
blockStart + patternsFound - 1);
}
if (theJoin->joinFromTheRight)
{ return(patternsFound); }
else
{ return(patternsFound + 1); }
}
globle double TimerFunction(
void *theEnv)
{
int numa, i;
double startTime;
DATA_OBJECT returnValue;
startTime = gentime();
numa = EnvRtnArgCount(theEnv);
i = 1;
while ((i <= numa) && (GetHaltExecution(theEnv) != TRUE))
{
EnvRtnUnknown(theEnv,i,&returnValue);
i++;
}
return(gentime() - startTime);
}
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;
}
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 EnvFacts(
void *theEnv,
char *logicalName,
void *vTheModule,
long long start,
long long end,
long long max)
{
struct fact *factPtr;
long count = 0;
struct defmodule *oldModule, *theModule = (struct defmodule *) vTheModule;
int allModules = FALSE;
/*==========================*/
/* Save the current module. */
/*==========================*/
oldModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
/*=========================================================*/
/* Determine if facts from all modules are to be displayed */
/* or just facts from the current module. */
/*=========================================================*/
if (theModule == NULL) allModules = TRUE;
else EnvSetCurrentModule(theEnv,(void *) theModule);
/*=====================================*/
/* Get the first fact to be displayed. */
/*=====================================*/
if (allModules) factPtr = (struct fact *) EnvGetNextFact(theEnv,NULL);
else factPtr = (struct fact *) GetNextFactInScope(theEnv,NULL);
/*===============================*/
/* Display facts until there are */
/* no more facts to display. */
/*===============================*/
while (factPtr != NULL)
{
/*==================================================*/
/* Abort the display of facts if the Halt Execution */
/* flag has been set (normally by user action). */
/*==================================================*/
if (GetHaltExecution(theEnv) == TRUE)
{
EnvSetCurrentModule(theEnv,(void *) oldModule);
return;
}
/*===============================================*/
/* If the maximum fact index of facts to display */
/* has been reached, then stop displaying facts. */
/*===============================================*/
if ((factPtr->factIndex > end) && (end != UNSPECIFIED))
{
PrintTally(theEnv,logicalName,count,(char*)"fact",(char*)"facts");
EnvSetCurrentModule(theEnv,(void *) oldModule);
return;
}
/*================================================*/
/* If the maximum number of facts to be displayed */
/* has been reached, then stop displaying facts. */
/*================================================*/
if (max == 0)
{
PrintTally(theEnv,logicalName,count,(char*)"fact",(char*)"facts");
EnvSetCurrentModule(theEnv,(void *) oldModule);
return;
}
/*======================================================*/
/* If the index of the fact is greater than the minimum */
/* starting fact index, then display the fact. */
/*======================================================*/
if (factPtr->factIndex >= start)
{
PrintFactWithIdentifier(theEnv,logicalName,factPtr);
EnvPrintRouter(theEnv,logicalName,(char*)"\n");
count++;
if (max > 0) max--;
}
/*========================================*/
/* Proceed to the next fact to be listed. */
/*========================================*/
if (allModules) factPtr = (struct fact *) EnvGetNextFact(theEnv,factPtr);
else factPtr = (struct fact *) GetNextFactInScope(theEnv,factPtr);
}
/*===================================================*/
/* Print the total of the number of facts displayed. */
/*===================================================*/
PrintTally(theEnv,logicalName,count,(char*)"fact",(char*)"facts");
/*=============================*/
/* Restore the current module. */
/*=============================*/
EnvSetCurrentModule(theEnv,(void *) oldModule);
}
globle intBool EnvMatchesCount(
void *theEnv,
void *theRule)
{
struct defrule *rulePtr, *tmpPtr;
struct betaMemory *theMemory, **theStorage;
struct partialMatch *listOfMatches;
struct alphaMemoryHash *listOfHashNodes, **theAlphaStorage;
struct joinNode *theJoin, *lastJoin;
int i, depth;
ACTIVATION *agendaPtr;
long count;
/*=================================================*/
/* Loop through each of the disjuncts for the rule */
/*=================================================*/
for (rulePtr = (struct defrule *) theRule, tmpPtr = rulePtr;
rulePtr != NULL;
rulePtr = rulePtr->disjunct)
{
/*======================================*/
/* Determine the last join in the rule. */
/*======================================*/
lastJoin = rulePtr->lastJoin;
/*===================================*/
/* Determine the number of patterns. */
/*===================================*/
depth = GetPatternNumberFromJoin(lastJoin);
/*=========================================*/
/* Store the alpha memory partial matches. */
/*=========================================*/
theAlphaStorage = (struct alphaMemoryHash **)
genalloc(theEnv,(unsigned) (depth * sizeof(struct alphaMemoryHash *)));
theJoin = lastJoin;
i = depth - 1;
while (theJoin != NULL)
{
if (theJoin->joinFromTheRight)
{ theJoin = (struct joinNode *) theJoin->rightSideEntryStructure; }
else
{
theAlphaStorage[i] = ((struct patternNodeHeader *) theJoin->rightSideEntryStructure)->firstHash;
i--;
theJoin = theJoin->lastLevel;
}
}
/*========================================*/
/* List the alpha memory partial matches. */
/*========================================*/
for (i = 0; i < depth; i++)
{
if (GetHaltExecution(theEnv) == TRUE)
{
genfree(theEnv,theAlphaStorage,(unsigned) (depth * sizeof(struct alphaMemoryHash *)));
return(TRUE);
}
EnvPrintRouter(theEnv,WDISPLAY,"Matches for Pattern ");
PrintLongInteger(theEnv,WDISPLAY,(long int) i + 1);
EnvPrintRouter(theEnv,WDISPLAY,": ");
count = 0;
for (listOfHashNodes = theAlphaStorage[i];
listOfHashNodes != NULL;
listOfHashNodes = listOfHashNodes->nextHash)
{
listOfMatches = listOfHashNodes->alphaMemory;
while (listOfMatches != NULL)
{
if (GetHaltExecution(theEnv) == TRUE)
{
genfree(theEnv,theAlphaStorage,(unsigned) (depth * sizeof(struct alphaMemoryHash *)));
return(TRUE);
}
count++;
listOfMatches = listOfMatches->nextInMemory;
}
}
PrintLongInteger(theEnv,WDISPLAY,count);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
}
genfree(theEnv,theAlphaStorage,(unsigned) (depth * sizeof(struct alphaMemoryHash *)));
/*========================================*/
/* Store the beta memory partial matches. */
/*========================================*/
depth = lastJoin->depth;
theStorage = (struct betaMemory **) genalloc(theEnv,(unsigned) (depth * sizeof(struct betaMemory *)));
theJoin = lastJoin;
for (i = depth - 1; i >= 0; i--)
{
/* theStorage[i] = GetBetaMemory(theEnv,theJoin); */
theStorage[i] = theJoin->leftMemory;
theJoin = theJoin->lastLevel;
}
/*=======================================*/
/* List the beta memory partial matches. */
/*=======================================*/
for (i = 1; i < depth; i++)
{
if (GetHaltExecution(theEnv) == TRUE)
{
genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct betaMemory *)));
return(TRUE);
}
/* count = 0; */
EnvPrintRouter(theEnv,WDISPLAY,"Partial matches for CEs 1 - ");
PrintLongInteger(theEnv,WDISPLAY,(long int) i + 1);
EnvPrintRouter(theEnv,WDISPLAY,": ");
theMemory = theStorage[i];
/*
for (b = 0; b < theMemory->size; b++)
{
listOfMatches = theMemory->beta[b];
while (listOfMatches != NULL)
{
if (GetHaltExecution(theEnv) == TRUE)
{
genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct betaMemory *)));
return(TRUE);
}
count++;
listOfMatches = listOfMatches->nextInMemory;
}
}
*/
count = theMemory->count;
PrintLongInteger(theEnv,WDISPLAY,count);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
}
genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct betaMemory *)));
}
/*===================*/
/* List activations. */
/*===================*/
rulePtr = tmpPtr;
EnvPrintRouter(theEnv,WDISPLAY,"Activations: ");
count = 0;
for (agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,NULL);
agendaPtr != NULL;
agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,agendaPtr))
{
if (GetHaltExecution(theEnv) == TRUE) return(TRUE);
if (((struct activation *) agendaPtr)->theRule->header.name == rulePtr->header.name)
{ count++; }
}
PrintLongInteger(theEnv,WDISPLAY,count);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
return(TRUE);
}
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);
}
static int ListAlphaMatches(
void *theEnv,
struct joinNode *theJoin,
int priorPatterns)
{
struct alphaMemoryHash *listOfHashNodes;
struct partialMatch *listOfMatches;
int flag;
if (theJoin == NULL)
{ return(priorPatterns); }
if (theJoin->rightSideEntryStructure == NULL)
{
priorPatterns++;
EnvPrintRouter(theEnv,WDISPLAY,"Matches for Pattern ");
PrintLongInteger(theEnv,WDISPLAY,(long int) priorPatterns);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
if (theJoin->rightMemory->beta[0]->children != NULL)
{ EnvPrintRouter(theEnv,WDISPLAY,"*\n"); }
else
{ EnvPrintRouter(theEnv,WDISPLAY," None\n"); }
return(priorPatterns);
}
if (theJoin->lastLevel != NULL)
{ priorPatterns = ListAlphaMatches(theEnv,theJoin->lastLevel,priorPatterns); }
if (theJoin->joinFromTheRight)
{ return ListAlphaMatches(theEnv,(struct joinNode *) theJoin->rightSideEntryStructure,priorPatterns); }
listOfHashNodes = ((struct patternNodeHeader *) theJoin->rightSideEntryStructure)->firstHash;
priorPatterns++;
if (GetHaltExecution(theEnv) == TRUE)
{ return(priorPatterns); }
EnvPrintRouter(theEnv,WDISPLAY,"Matches for Pattern ");
PrintLongInteger(theEnv,WDISPLAY,(long int) priorPatterns);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
for (flag = 1;
listOfHashNodes != NULL;
listOfHashNodes = listOfHashNodes->nextHash)
{
listOfMatches = listOfHashNodes->alphaMemory;
while (listOfMatches != NULL)
{
if (GetHaltExecution(theEnv) == TRUE)
{ return(priorPatterns); }
flag = 0;
PrintPartialMatch(theEnv,WDISPLAY,listOfMatches);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
listOfMatches = listOfMatches->nextInMemory;
}
}
if (flag) EnvPrintRouter(theEnv,WDISPLAY," None\n");
return(priorPatterns);
}
globle intBool EnvMatches(
void *theEnv,
void *theRule)
{
struct defrule *rulePtr, *tmpPtr;
struct joinNode *lastJoin;
ACTIVATION *agendaPtr;
int flag;
/*=================================================*/
/* Loop through each of the disjuncts for the rule */
/*=================================================*/
for (rulePtr = (struct defrule *) theRule, tmpPtr = rulePtr;
rulePtr != NULL;
rulePtr = rulePtr->disjunct)
{
/*======================================*/
/* Determine the last join in the rule. */
/*======================================*/
lastJoin = rulePtr->lastJoin;
/*========================================*/
/* List the alpha memory partial matches. */
/*========================================*/
ListAlphaMatches(theEnv,lastJoin->lastLevel,0);
/*=======================================*/
/* List the beta memory partial matches. */
/*=======================================*/
ListBetaMatches(theEnv,lastJoin,1);
}
/*===================*/
/* List activations. */
/*===================*/
rulePtr = tmpPtr;
EnvPrintRouter(theEnv,WDISPLAY,"Activations\n");
flag = 1;
for (agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,NULL);
agendaPtr != NULL;
agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,agendaPtr))
{
if (GetHaltExecution(theEnv) == TRUE) return(TRUE);
if (((struct activation *) agendaPtr)->theRule->header.name == rulePtr->header.name)
{
flag = 0;
PrintPartialMatch(theEnv,WDISPLAY,GetActivationBasis(agendaPtr));
EnvPrintRouter(theEnv,WDISPLAY,"\n");
}
}
if (flag) EnvPrintRouter(theEnv,WDISPLAY," None\n");
return(TRUE);
}
void Reset(
Environment *theEnv)
{
struct voidCallFunctionItem *resetPtr;
GCBlock gcb;
/*=====================================*/
/* 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 embedded, clear the error flags. */
/*=====================================*/
if (EvaluationData(theEnv)->CurrentExpression == NULL)
{ ResetErrorFlags(theEnv); }
SetErrorValue(theEnv,NULL);
/*========================================*/
/* Set up the frame for tracking garbage. */
/*========================================*/
GCBlockStart(theEnv,&gcb);
/*=======================================================*/
/* 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)->BeforeResetCallback != NULL) ?
((*ConstructData(theEnv)->BeforeResetCallback)(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)
{ (*resetPtr->func)(theEnv,resetPtr->context); }
/*============================================*/
/* Set the current module to the MAIN module. */
/*============================================*/
SetCurrentModule(theEnv,FindDefmodule(theEnv,"MAIN"));
/*===========================================*/
/* Perform periodic cleanup if the reset was */
/* issued from an embedded controller. */
/*===========================================*/
GCBlockEnd(theEnv,&gcb);
CallPeriodicTasks(theEnv);
/*===================================*/
/* A reset is no longer in progress. */
/*===================================*/
ConstructData(theEnv)->ResetInProgress = false;
}
globle BOOLEAN EnvMatches_PY(
void *theEnv,
char *logicalName,
void *theRule)
{
struct defrule *rulePtr, *tmpPtr;
struct partialMatch *listOfMatches, **theStorage;
struct joinNode *theJoin, *lastJoin;
int i, depth;
ACTIVATION *agendaPtr;
int flag;
int matchesDisplayed;
/*=================================================*/
/* Loop through each of the disjuncts for the rule */
/*=================================================*/
for (rulePtr = (struct defrule *) theRule, tmpPtr = rulePtr;
rulePtr != NULL;
rulePtr = rulePtr->disjunct)
{
/*======================================*/
/* Determine the last join in the rule. */
/*======================================*/
lastJoin = rulePtr->lastJoin;
/*===================================*/
/* Determine the number of patterns. */
/*===================================*/
depth = GetPatternNumberFromJoin(lastJoin);
/*=========================================*/
/* Store the alpha memory partial matches. */
/*=========================================*/
theStorage = (struct partialMatch **)
genalloc(theEnv,(unsigned) (depth * sizeof(struct partialMatch)));
theJoin = lastJoin;
i = depth - 1;
while (theJoin != NULL)
{
if (theJoin->joinFromTheRight)
{ theJoin = (struct joinNode *) theJoin->rightSideEntryStructure; }
else
{
theStorage[i] = ((struct patternNodeHeader *) theJoin->rightSideEntryStructure)->alphaMemory;
i--;
theJoin = theJoin->lastLevel;
}
}
/*========================================*/
/* List the alpha memory partial matches. */
/*========================================*/
for (i = 0; i < depth; i++)
{
if (GetHaltExecution(theEnv) == TRUE)
{
genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch)));
return(TRUE);
}
EnvPrintRouter(theEnv,logicalName,"Matches for Pattern ");
PrintLongInteger(theEnv,logicalName,(long int) i + 1);
EnvPrintRouter(theEnv,logicalName,"\n");
listOfMatches = theStorage[i];
if (listOfMatches == NULL) EnvPrintRouter(theEnv,logicalName," None\n");
while (listOfMatches != NULL)
{
if (GetHaltExecution(theEnv) == TRUE)
{
genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch)));
return(TRUE);
}
PrintPartialMatch(theEnv,logicalName,listOfMatches);
EnvPrintRouter(theEnv,logicalName,"\n");
listOfMatches = listOfMatches->next;
}
}
genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch)));
/*========================================*/
/* Store the beta memory partial matches. */
/*========================================*/
depth = lastJoin->depth;
theStorage = (struct partialMatch **) genalloc(theEnv,(unsigned) (depth * sizeof(struct partialMatch)));
theJoin = lastJoin;
for (i = depth - 1; i >= 0; i--)
{
theStorage[i] = theJoin->beta;
theJoin = theJoin->lastLevel;
}
/*=======================================*/
/* List the beta memory partial matches. */
/*=======================================*/
for (i = 1; i < depth; i++)
{
if (GetHaltExecution(theEnv) == TRUE)
{
genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch)));
return(TRUE);
}
matchesDisplayed = 0;
EnvPrintRouter(theEnv,logicalName,"Partial matches for CEs 1 - ");
PrintLongInteger(theEnv,logicalName,(long int) i + 1);
EnvPrintRouter(theEnv,logicalName,"\n");
listOfMatches = theStorage[i];
while (listOfMatches != NULL)
{
if (GetHaltExecution(theEnv) == TRUE)
{
genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch)));
return(TRUE);
}
if (listOfMatches->counterf == FALSE)
{
matchesDisplayed++;
PrintPartialMatch(theEnv,logicalName,listOfMatches);
EnvPrintRouter(theEnv,logicalName,"\n");
}
listOfMatches = listOfMatches->next;
}
if (matchesDisplayed == 0) { EnvPrintRouter(theEnv,logicalName," None\n"); }
}
genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch)));
}
/*===================*/
/* List activations. */
/*===================*/
rulePtr = tmpPtr;
EnvPrintRouter(theEnv,logicalName,"Activations\n");
flag = 1;
for (agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,NULL);
agendaPtr != NULL;
agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,agendaPtr))
{
if (GetHaltExecution(theEnv) == TRUE) return(TRUE);
if (((struct activation *) agendaPtr)->theRule->header.name == rulePtr->header.name)
{
flag = 0;
PrintPartialMatch(theEnv,logicalName,GetActivationBasis(agendaPtr));
EnvPrintRouter(theEnv,logicalName,"\n");
}
}
if (flag) EnvPrintRouter(theEnv,logicalName," None\n");
return(TRUE);
}
