static void ResetDefinstancesAction(
void *theEnv,
struct constructHeader *vDefinstances,
void *userBuffer)
{
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(userBuffer)
#endif
DEFINSTANCES *theDefinstances = (DEFINSTANCES *) vDefinstances;
EXPRESSION *theExp;
DATA_OBJECT temp;
SaveCurrentModule(theEnv);
EnvSetCurrentModule(theEnv,(void *) vDefinstances->whichModule->theModule);
theDefinstances->busy++;
for (theExp = theDefinstances->mkinstance ;
theExp != NULL ;
theExp = GetNextArgument(theExp))
{
EvaluateExpression(theEnv,theExp,&temp);
if (EvaluationData(theEnv)->HaltExecution ||
((GetType(temp) == SYMBOL) &&
(GetValue(temp) == EnvFalseSymbol(theEnv))))
{
RestoreCurrentModule(theEnv);
theDefinstances->busy--;
return;
}
}
theDefinstances->busy--;
RestoreCurrentModule(theEnv);
}
globle intBool EnvSetIncrementalReset(
void *theEnv,
int value)
{
int ov;
struct defmodule *theModule;
SaveCurrentModule(theEnv);
for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
theModule != NULL;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule))
{
EnvSetCurrentModule(theEnv,(void *) theModule);
if (EnvGetNextDefrule(theEnv,NULL) != NULL)
{
RestoreCurrentModule(theEnv);
return(-1);
}
}
RestoreCurrentModule(theEnv);
ov = EngineData(theEnv)->IncrementalResetFlag;
EngineData(theEnv)->IncrementalResetFlag = value;
return(ov);
}
globle int SetIncrementalResetCommand(
void *theEnv,
EXEC_STATUS)
{
int oldValue;
DATA_OBJECT argPtr;
struct defmodule *theModule;
oldValue = EnvGetIncrementalReset(theEnv,execStatus);
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,execStatus,"set-incremental-reset",EXACTLY,1) == -1)
{ return(oldValue); }
/*=========================================*/
/* The incremental reset behavior can't be */
/* changed when rules are loaded. */
/*=========================================*/
SaveCurrentModule(theEnv,execStatus);
for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,NULL);
theModule != NULL;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,theModule))
{
EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);
if (EnvGetNextDefrule(theEnv,execStatus,NULL) != NULL)
{
RestoreCurrentModule(theEnv,execStatus);
PrintErrorID(theEnv,execStatus,"INCRRSET",1,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,"The incremental reset behavior cannot be changed with rules loaded.\n");
SetEvaluationError(theEnv,execStatus,TRUE);
return(oldValue);
}
}
RestoreCurrentModule(theEnv,execStatus);
/*==================================================*/
/* The symbol FALSE disables incremental reset. Any */
/* other value enables incremental reset. */
/*==================================================*/
EnvRtnUnknown(theEnv,execStatus,1,&argPtr);
if ((argPtr.value == EnvFalseSymbol(theEnv,execStatus)) && (argPtr.type == SYMBOL))
{ EnvSetIncrementalReset(theEnv,execStatus,FALSE); }
else
{ EnvSetIncrementalReset(theEnv,execStatus,TRUE); }
/*=======================*/
/* Return the old value. */
/*=======================*/
return(oldValue);
}
/*******************************************************************
NAME : EnvFindDefclass
DESCRIPTION : Looks up a specified class in the class hash table
(Only looks in current or specified module)
INPUTS : The name-string of the class (including module)
RETURNS : The address of the found class, NULL otherwise
SIDE EFFECTS : None
NOTES : None
******************************************************************/
globle void *EnvFindDefclass( // TBD Needs to look in imported
void *theEnv,
const char *classAndModuleName)
{
SYMBOL_HN *classSymbol = NULL;
DEFCLASS *cls;
struct defmodule *theModule = NULL;
const char *className;
SaveCurrentModule(theEnv);
className = ExtractModuleAndConstructName(theEnv,classAndModuleName);
if (className != NULL)
{
classSymbol = FindSymbolHN(theEnv,ExtractModuleAndConstructName(theEnv,classAndModuleName));
theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
}
RestoreCurrentModule(theEnv);
if (classSymbol == NULL)
return(NULL);
cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];
while (cls != NULL)
{
if (cls->header.name == classSymbol)
{
if (cls->system || (cls->header.whichModule->theModule == theModule))
return(cls->installed ? (void *) cls : NULL);
}
cls = cls->nxtHash;
}
return(NULL);
}
globle void *CreateDeftemplateScopeMap(
void *theEnv,
struct deftemplate *theDeftemplate)
{
unsigned scopeMapSize;
char *scopeMap;
char *templateName;
struct defmodule *matchModule, *theModule;
int moduleID,count;
void *theBitMap;
templateName = ValueToString(theDeftemplate->header.name);
matchModule = theDeftemplate->header.whichModule->theModule;
scopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1));
scopeMap = (char *) gm2(theEnv,scopeMapSize);
ClearBitString((void *) scopeMap,scopeMapSize);
SaveCurrentModule(theEnv);
for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL) ;
theModule != NULL ;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule))
{
EnvSetCurrentModule(theEnv,(void *) theModule);
moduleID = (int) theModule->bsaveID;
if (FindImportedConstruct(theEnv,"deftemplate",matchModule,
templateName,&count,TRUE,NULL) != NULL)
SetBitMap(scopeMap,moduleID);
}
RestoreCurrentModule(theEnv);
theBitMap = EnvAddBitMap(theEnv,scopeMap,scopeMapSize);
IncrementBitMapCount(theBitMap);
rm(theEnv,(void *) scopeMap,scopeMapSize);
return(theBitMap);
}
/***************************************************
NAME : LookupDefclassByMdlOrScope
DESCRIPTION : Finds a class anywhere (if module
is specified) or in current or
imported modules
INPUTS : The class name
RETURNS : The class (NULL if not found)
SIDE EFFECTS : Error message printed on
ambiguous references
NOTES : Assumes no two classes of the same
name are ever in the same scope
***************************************************/
globle DEFCLASS *LookupDefclassByMdlOrScope(
void *theEnv,
const char *classAndModuleName)
{
DEFCLASS *cls;
const char *className;
SYMBOL_HN *classSymbol;
struct defmodule *theModule;
if (FindModuleSeparator(classAndModuleName) == FALSE)
return(LookupDefclassInScope(theEnv,classAndModuleName));
SaveCurrentModule(theEnv);
className = ExtractModuleAndConstructName(theEnv,classAndModuleName);
theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
RestoreCurrentModule(theEnv);
if(className == NULL)
return(NULL);
if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL)
return(NULL);
cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];
while (cls != NULL)
{
if ((cls->header.name == classSymbol) &&
(cls->header.whichModule->theModule == theModule))
return(cls->installed ? cls : NULL);
cls = cls->nxtHash;
}
return(NULL);
}
globle void DefruleRunTimeInitialize(
void *theEnv,
struct joinLink *rightPrime,
struct joinLink *leftPrime)
{
struct defmodule *theModule;
struct defrule *theRule, *theDisjunct;
DefruleData(theEnv)->RightPrimeJoins = rightPrime;
DefruleData(theEnv)->LeftPrimeJoins = leftPrime;
SaveCurrentModule(theEnv);
for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
theModule != NULL;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule))
{
EnvSetCurrentModule(theEnv,(void *) theModule);
for (theRule = EnvGetNextDefrule(theEnv,NULL);
theRule != NULL;
theRule = EnvGetNextDefrule(theEnv,theRule))
{
for (theDisjunct = theRule;
theDisjunct != NULL;
theDisjunct = theDisjunct->disjunct)
{ AddBetaMemoriesToRule(theEnv,theDisjunct->lastJoin); }
}
}
RestoreCurrentModule(theEnv);
}
void DefruleRunTimeInitialize(
Environment *theEnv,
struct joinLink *rightPrime,
struct joinLink *leftPrime)
{
Defmodule *theModule;
Defrule *theRule, *theDisjunct;
DefruleData(theEnv)->RightPrimeJoins = rightPrime;
DefruleData(theEnv)->LeftPrimeJoins = leftPrime;
SaveCurrentModule(theEnv);
for (theModule = GetNextDefmodule(theEnv,NULL);
theModule != NULL;
theModule = GetNextDefmodule(theEnv,theModule))
{
SetCurrentModule(theEnv,theModule);
for (theRule = GetNextDefrule(theEnv,NULL);
theRule != NULL;
theRule = GetNextDefrule(theEnv,theRule))
{
for (theDisjunct = theRule;
theDisjunct != NULL;
theDisjunct = theDisjunct->disjunct)
{
theDisjunct->header.env = theEnv;
AddBetaMemoriesToRule(theEnv,theDisjunct->lastJoin);
}
}
}
RestoreCurrentModule(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);
}
globle void MarkRuleNetwork(
int value)
{
struct defrule *rulePtr;
struct joinNode *joinPtr;
struct defmodule *modulePtr;
/*===========================*/
/* Loop through each module. */
/*===========================*/
SaveCurrentModule();
for (modulePtr = (struct defmodule *) GetNextDefmodule(NULL);
modulePtr != NULL;
modulePtr = (struct defmodule *) GetNextDefmodule(modulePtr))
{
SetCurrentModule((void *) modulePtr);
/*=========================*/
/* Loop through each rule. */
/*=========================*/
rulePtr = (struct defrule *) GetNextDefrule(NULL);
while (rulePtr != NULL)
{
/*=============================*/
/* Mark each join for the rule */
/* with the specified value. */
/*=============================*/
joinPtr = rulePtr->lastJoin;
while (joinPtr != NULL)
{
joinPtr->marked = value;
joinPtr = GetPreviousJoin(joinPtr);
}
/*=================================*/
/* Move on to the next rule or the */
/* next disjunct for this rule. */
/*=================================*/
if (rulePtr->disjunct != NULL) rulePtr = rulePtr->disjunct;
else rulePtr = (struct defrule *) GetNextDefrule(rulePtr);
}
}
RestoreCurrentModule();
}
globle intBool EnvSetIncrementalReset(
void *theEnv,
int value)
{
int ov;
struct defmodule *theModule;
/*============================================*/
/* The incremental reset behavior can only be */
/* changed if there are no existing rules. */
/*============================================*/
SaveCurrentModule(theEnv);
for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
theModule != NULL;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule))
{
EnvSetCurrentModule(theEnv,(void *) theModule);
if (EnvGetNextDefrule(theEnv,NULL) != NULL)
{
RestoreCurrentModule(theEnv);
return(-1);
}
}
RestoreCurrentModule(theEnv);
/*====================================*/
/* Change the incremental reset flag. */
/*====================================*/
ov = EngineData(theEnv)->IncrementalResetFlag;
EngineData(theEnv)->IncrementalResetFlag = value;
return(ov);
}
globle int FindImportExportConflict(
void *theEnv,
char *constructName,
struct defmodule *matchModule,
char *findName)
{
struct defmodule *theModule;
struct moduleItem *theModuleItem;
int count;
/*===========================================================*/
/* If the construct type can't be imported or exported, then */
/* it's not possible to have an import/export conflict. */
/*===========================================================*/
if (ValidPortConstructItem(theEnv,constructName) == NULL) return(FALSE);
/*============================================*/
/* There module name should already have been */
/* separated fromthe construct's name. */
/*============================================*/
if (FindModuleSeparator(findName)) return(FALSE);
/*===============================================================*/
/* The construct must be capable of being stored within a module */
/* (this test should never fail). The construct must also have */
/* a find function associated with it so we can actually look */
/* for import/export conflicts. */
/*===============================================================*/
if ((theModuleItem = FindModuleItem(theEnv,constructName)) == NULL) return(FALSE);
if (theModuleItem->findFunction == NULL) return(FALSE);
/*==========================*/
/* Save the current module. */
/*==========================*/
SaveCurrentModule(theEnv);
/*================================================================*/
/* Look at each module and count each definition of the specified */
/* construct which is visible to the module. If more than one */
/* definition is visible, then an import/export conflict exists */
/* and TRUE is returned. */
/*================================================================*/
for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
theModule != NULL;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule))
{
EnvSetCurrentModule(theEnv,(void *) theModule);
FindImportedConstruct(theEnv,constructName,NULL,findName,&count,TRUE,matchModule);
if (count > 1)
{
RestoreCurrentModule(theEnv);
return(TRUE);
}
}
/*==========================================*/
/* Restore the current module. No conflicts */
/* were detected so FALSE is returned. */
/*==========================================*/
RestoreCurrentModule(theEnv);
return(FALSE);
}
globle void EnvRefreshAgenda(
void *theEnv,
void *vTheModule)
{
struct activation *theActivation;
struct defmodule *theModule = (struct defmodule *) vTheModule;
intBool oldValue;
int allModules = FALSE;
/*==========================*/
/* Save the current module. */
/*==========================*/
SaveCurrentModule(theEnv);
/*=============================================*/
/* If the module specified is a NULL pointer, */
/* then every module has its agenda refreshed. */
/*=============================================*/
if (theModule == NULL)
{
allModules = TRUE;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
}
/*=======================================================*/
/* Remember the current setting for salience evaluation. */
/* To perform the refresh, the when activated setting is */
/* used to recompute the salience values. */
/*=======================================================*/
oldValue = EnvGetSalienceEvaluation(theEnv);
EnvSetSalienceEvaluation(theEnv,WHEN_ACTIVATED);
/*========================*/
/* Refresh the agenda(s). */
/*========================*/
for (;
theModule != NULL;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule))
{
/*=========================================*/
/* Change the current module to the module */
/* of the agenda being refreshed. */
/*=========================================*/
EnvSetCurrentModule(theEnv,(void *) theModule);
/*================================================================*/
/* Recompute the salience values for the current module's agenda. */
/*================================================================*/
for (theActivation = (struct activation *) EnvGetNextActivation(theEnv,NULL);
theActivation != NULL;
theActivation = (struct activation *) EnvGetNextActivation(theEnv,theActivation))
{
theActivation->salience = EvaluateSalience(theEnv,theActivation->theRule);
}
/*======================================================*/
/* Reorder the agenda based on the new salience values. */
/*======================================================*/
EnvReorderAgenda(theEnv,theModule);
/*===============================================*/
/* Return if only one agenda is being refreshed. */
/*===============================================*/
if (! allModules)
{
EnvSetSalienceEvaluation(theEnv,oldValue);
RestoreCurrentModule(theEnv);
return;
}
}
/*==========================================*/
/* Restore the salience evaluation setting. */
/*==========================================*/
EnvSetSalienceEvaluation(theEnv,oldValue);
/*=============================*/
/* Restore the current module. */
/*=============================*/
RestoreCurrentModule(theEnv);
}
static void ClearBload()
{
unsigned long int space;
long i;
struct patternParser *theParser = NULL;
struct patternEntity *theEntity = NULL;
void *theModule;
/*===========================================*/
/* Delete all known entities before removing */
/* the defrule data structures. */
/*===========================================*/
GetNextPatternEntity(&theParser,&theEntity);
while (theEntity != NULL)
{
(*theEntity->theInfo->base.deleteFunction)(theEntity);
theEntity = NULL;
GetNextPatternEntity(&theParser,&theEntity);
}
/*=========================================*/
/* Remove all activations from the agenda. */
/*=========================================*/
SaveCurrentModule();
for (theModule = GetNextDefmodule(NULL);
theModule != NULL;
theModule = GetNextDefmodule(theModule))
{
SetCurrentModule(theModule);
RemoveAllActivations();
}
RestoreCurrentModule();
ClearFocusStack();
/*==========================================================*/
/* Remove all partial matches from the beta memories in the */
/* join network. Alpha memories do not need to be examined */
/* since all pattern entities have been deleted by now. */
/*==========================================================*/
for (i = 0; i < NumberOfJoins; i++)
{ FlushAlphaBetaMemory(JoinArray[i].beta); }
/*================================================*/
/* Decrement the symbol count for each rule name. */
/*================================================*/
for (i = 0; i < NumberOfDefrules; i++)
{ UnmarkConstructHeader(&DefruleArray[i].header); }
/*==================================================*/
/* Return the space allocated for the bload arrays. */
/*==================================================*/
space = NumberOfDefruleModules * sizeof(struct defruleModule);
if (space != 0) genlongfree((void *) ModuleArray,space);
space = NumberOfDefrules * sizeof(struct defrule);
if (space != 0) genlongfree((void *) DefruleArray,space);
#if FUZZY_DEFTEMPLATES
space = NumberOfPatternFuzzyValues * sizeof(struct fzSlotLocator);
if (space != 0) genlongfree((void *) PatternFuzzyValueArray,space);
#endif
space = NumberOfJoins * sizeof(struct joinNode);
if (space != 0) genlongfree((void *) JoinArray,space);
}
globle intBool EnvBsave(
void *theEnv,
EXEC_STATUS,
char *fileName)
{
FILE *fp;
struct BinaryItem *biPtr;
char constructBuffer[CONSTRUCT_HEADER_SIZE];
long saveExpressionCount;
/*===================================*/
/* A bsave can't occur when a binary */
/* image is already loaded. */
/*===================================*/
if (Bloaded(theEnv,execStatus))
{
PrintErrorID(theEnv,execStatus,"BSAVE",1,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,
"Cannot perform a binary save while a binary load is in effect.\n");
return(0);
}
/*================*/
/* Open the file. */
/*================*/
if ((fp = GenOpen(theEnv,execStatus,fileName,"wb")) == NULL)
{
OpenErrorMessage(theEnv,execStatus,"bsave",fileName);
return(0);
}
/*==============================*/
/* Remember the current module. */
/*==============================*/
SaveCurrentModule(theEnv,execStatus);
/*==================================*/
/* Write binary header to the file. */
/*==================================*/
WriteBinaryHeader(theEnv,execStatus,fp);
/*===========================================*/
/* Initialize count variables, index values, */
/* and determine some of the data structures */
/* which need to be saved. */
/*===========================================*/
ExpressionData(theEnv,execStatus)->ExpressionCount = 0;
InitializeFunctionNeededFlags(theEnv,execStatus);
InitAtomicValueNeededFlags(theEnv,execStatus);
FindHashedExpressions(theEnv,execStatus);
FindNeededItems(theEnv,execStatus);
SetAtomicValueIndices(theEnv,execStatus,FALSE);
/*===============================*/
/* Save the functions and atoms. */
/*===============================*/
WriteNeededFunctions(theEnv,execStatus,fp);
WriteNeededAtomicValues(theEnv,execStatus,fp);
/*=========================================*/
/* Write out the number of expression data */
/* structures in the binary image. */
/*=========================================*/
GenWrite((void *) &ExpressionData(theEnv,execStatus)->ExpressionCount,(unsigned long) sizeof(unsigned long),fp);
/*===========================================*/
/* Save the numbers indicating the amount of */
/* memory needed to bload the constructs. */
/*===========================================*/
for (biPtr = BsaveData(theEnv,execStatus)->ListOfBinaryItems;
biPtr != NULL;
biPtr = biPtr->next)
{
if (biPtr->bsaveStorageFunction != NULL)
{
genstrncpy(constructBuffer,biPtr->name,CONSTRUCT_HEADER_SIZE);
GenWrite(constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE,fp);
(*biPtr->bsaveStorageFunction)(theEnv,execStatus,fp);
}
}
/*====================================*/
/* Write a binary footer to the file. */
/*====================================*/
WriteBinaryFooter(theEnv,execStatus,fp);
/*===================*/
/* Save expressions. */
/*===================*/
ExpressionData(theEnv,execStatus)->ExpressionCount = 0;
BsaveHashedExpressions(theEnv,execStatus,fp);
saveExpressionCount = ExpressionData(theEnv,execStatus)->ExpressionCount;
BsaveConstructExpressions(theEnv,execStatus,fp);
ExpressionData(theEnv,execStatus)->ExpressionCount = saveExpressionCount;
/*===================*/
/* Save constraints. */
/*===================*/
WriteNeededConstraints(theEnv,execStatus,fp);
/*==================*/
/* Save constructs. */
/*==================*/
for (biPtr = BsaveData(theEnv,execStatus)->ListOfBinaryItems;
biPtr != NULL;
biPtr = biPtr->next)
{
if (biPtr->bsaveFunction != NULL)
{
genstrncpy(constructBuffer,biPtr->name,CONSTRUCT_HEADER_SIZE);
GenWrite(constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE,fp);
(*biPtr->bsaveFunction)(theEnv,execStatus,fp);
}
}
/*===================================*/
/* Save a binary footer to the file. */
/*===================================*/
WriteBinaryFooter(theEnv,execStatus,fp);
/*===========*/
/* Clean up. */
/*===========*/
RestoreAtomicValueBuckets(theEnv,execStatus);
/*=================*/
/* Close the file. */
/*=================*/
GenClose(theEnv,execStatus,fp);
/*=============================*/
/* Restore the current module. */
/*=============================*/
RestoreCurrentModule(theEnv,execStatus);
/*========================================*/
/* Return TRUE to indicate success. */
/*========================================*/
return(TRUE);
}
static void FindAndSetDeftemplatePatternNetwork(
void *theEnv,
struct factPatternNode *rootNode,
struct factPatternNode *newRootNode)
{
struct deftemplate *theDeftemplate;
struct defmodule *theModule;
/*=======================================================*/
/* Save the current module since we will be changing it. */
/*=======================================================*/
SaveCurrentModule(theEnv);
/*=======================================================*/
/* Loop through every module looking for the deftemplate */
/* associated with the specified root node. */
/*=======================================================*/
for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
theModule != NULL;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule))
{
/*======================================================*/
/* Set the current module to the module being examined. */
/*======================================================*/
EnvSetCurrentModule(theEnv,(void *) theModule);
/*======================================================*/
/* Loop through every deftemplate in the current module */
/* searching for the deftemplate associated with the */
/* specified root node. */
/*======================================================*/
for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL);
theDeftemplate != NULL;
theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate))
{
/*===========================================================*/
/* When the associated deftemplate is found, change its root */
/* node from the current value to the new value. Restore the */
/* current module before leaving this routine. */
/*===========================================================*/
if (theDeftemplate->patternNetwork == rootNode)
{
RestoreCurrentModule(theEnv);
theDeftemplate->patternNetwork = newRootNode;
return;
}
}
}
/*========================================================*/
/* If the deftemplate wasn't found, then we're presumably */
/* we're in the the middle of a clear and the deftemplate */
/* has already been deleted so there's no need to update */
/* the links to the fact pattern network. */
/*========================================================*/
RestoreCurrentModule(theEnv);
}
/*******************************************************
NAME : DefmessageHandlerWatchSupport
DESCRIPTION : Sets or displays handlers specified
INPUTS : 1) The calling function name
2) The logical output name for displays
(can be NULL)
4) The new set state (can be -1)
5) The print function (can be NULL)
6) The trace function (can be NULL)
7) The handlers expression list
RETURNS : TRUE if all OK,
FALSE otherwise
SIDE EFFECTS : Handler trace flags set or displayed
NOTES : None
*******************************************************/
static unsigned DefmessageHandlerWatchSupport(
void *theEnv,
const char *funcName,
const char *logName,
int newState,
void (*printFunc)(void *,const char *,void *,int),
void (*traceFunc)(void *,int,void *,int),
EXPRESSION *argExprs)
{
struct defmodule *theModule;
void *theClass;
const char *theHandlerStr;
int theType;
int argIndex = 2;
DATA_OBJECT tmpData;
/* ===============================
If no handlers are specified,
show the trace for all handlers
in all handlers
=============================== */
if (argExprs == NULL)
{
SaveCurrentModule(theEnv);
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
while (theModule != NULL)
{
EnvSetCurrentModule(theEnv,(void *) theModule);
if (traceFunc == NULL)
{
EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule));
EnvPrintRouter(theEnv,logName,":\n");
}
theClass = EnvGetNextDefclass(theEnv,NULL);
while (theClass != NULL)
{
if (WatchClassHandlers(theEnv,theClass,NULL,-1,logName,newState,
TRUE,printFunc,traceFunc) == FALSE)
return(FALSE);
theClass = EnvGetNextDefclass(theEnv,theClass);
}
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule);
}
RestoreCurrentModule(theEnv);
return(TRUE);
}
/* ================================================
Set or show the traces for the specified handler
================================================ */
while (argExprs != NULL)
{
if (EvaluateExpression(theEnv,argExprs,&tmpData))
return(FALSE);
if (tmpData.type != SYMBOL)
{
ExpectedTypeError1(theEnv,funcName,argIndex,"class name");
return(FALSE);
}
theClass = (void *) LookupDefclassByMdlOrScope(theEnv,DOToString(tmpData));
if (theClass == NULL)
{
ExpectedTypeError1(theEnv,funcName,argIndex,"class name");
return(FALSE);
}
if (GetNextArgument(argExprs) != NULL)
{
argExprs = GetNextArgument(argExprs);
argIndex++;
if (EvaluateExpression(theEnv,argExprs,&tmpData))
return(FALSE);
if (tmpData.type != SYMBOL)
{
ExpectedTypeError1(theEnv,funcName,argIndex,"handler name");
return(FALSE);
}
theHandlerStr = DOToString(tmpData);
if (GetNextArgument(argExprs) != NULL)
{
argExprs = GetNextArgument(argExprs);
argIndex++;
if (EvaluateExpression(theEnv,argExprs,&tmpData))
return(FALSE);
if (tmpData.type != SYMBOL)
{
ExpectedTypeError1(theEnv,funcName,argIndex,"handler type");
return(FALSE);
}
if ((theType = (int) HandlerType(theEnv,funcName,DOToString(tmpData))) == MERROR)
return(FALSE);
}
else
theType = -1;
}
else
{
theHandlerStr = NULL;
theType = -1;
}
if (WatchClassHandlers(theEnv,theClass,theHandlerStr,theType,logName,
newState,FALSE,printFunc,traceFunc) == FALSE)
{
ExpectedTypeError1(theEnv,funcName,argIndex,"handler");
return(FALSE);
}
argIndex++;
argExprs = GetNextArgument(argExprs);
}
return(TRUE);
}
static void ClearBload(
void *theEnv)
{
unsigned long int space;
long i;
struct patternParser *theParser = NULL;
struct patternEntity *theEntity = NULL;
void *theModule;
/*===========================================*/
/* Delete all known entities before removing */
/* the defrule data structures. */
/*===========================================*/
GetNextPatternEntity(theEnv,&theParser,&theEntity);
while (theEntity != NULL)
{
(*theEntity->theInfo->base.deleteFunction)(theEnv,theEntity);
theEntity = NULL;
GetNextPatternEntity(theEnv,&theParser,&theEntity);
}
/*=========================================*/
/* Remove all activations from the agenda. */
/*=========================================*/
SaveCurrentModule(theEnv);
for (theModule = EnvGetNextDefmodule(theEnv,NULL);
theModule != NULL;
theModule = EnvGetNextDefmodule(theEnv,theModule))
{
EnvSetCurrentModule(theEnv,theModule);
RemoveAllActivations(theEnv);
}
RestoreCurrentModule(theEnv);
EnvClearFocusStack(theEnv);
/*==========================================================*/
/* Remove all partial matches from the beta memories in the */
/* join network. Alpha memories do not need to be examined */
/* since all pattern entities have been deleted by now. */
/*==========================================================*/
for (i = 0; i < DefruleBinaryData(theEnv)->NumberOfJoins; i++)
{ FlushAlphaBetaMemory(theEnv,DefruleBinaryData(theEnv)->JoinArray[i].beta); }
/*================================================*/
/* Decrement the symbol count for each rule name. */
/*================================================*/
for (i = 0; i < DefruleBinaryData(theEnv)->NumberOfDefrules; i++)
{ UnmarkConstructHeader(theEnv,&DefruleBinaryData(theEnv)->DefruleArray[i].header); }
/*==================================================*/
/* Return the space allocated for the bload arrays. */
/*==================================================*/
space = DefruleBinaryData(theEnv)->NumberOfDefruleModules * sizeof(struct defruleModule);
if (space != 0) genlongfree(theEnv,(void *) DefruleBinaryData(theEnv)->ModuleArray,space);
DefruleBinaryData(theEnv)->NumberOfDefruleModules = 0;
space = DefruleBinaryData(theEnv)->NumberOfDefrules * sizeof(struct defrule);
if (space != 0) genlongfree(theEnv,(void *) DefruleBinaryData(theEnv)->DefruleArray,space);
DefruleBinaryData(theEnv)->NumberOfDefrules = 0;
space = DefruleBinaryData(theEnv)->NumberOfJoins * sizeof(struct joinNode);
if (space != 0) genlongfree(theEnv,(void *) DefruleBinaryData(theEnv)->JoinArray,space);
DefruleBinaryData(theEnv)->NumberOfJoins = 0;
}
globle void *FindImportedConstruct(
void *theEnv,
EXEC_STATUS,
char *constructName,
struct defmodule *matchModule,
char *findName,
int *count,
int searchCurrent,
struct defmodule *notYetDefinedInModule)
{
void *rv;
struct moduleItem *theModuleItem;
/*=============================================*/
/* Set the number of references found to zero. */
/*=============================================*/
*count = 0;
/*===============================*/
/* The :: should not be included */
/* in the construct's name. */
/*===============================*/
if (FindModuleSeparator(findName)) return(NULL);
/*=============================================*/
/* Remember the current module since we'll be */
/* changing it during the search and will want */
/* to restore it once the search is completed. */
/*=============================================*/
SaveCurrentModule(theEnv,execStatus);
/*==========================================*/
/* Find the module related access functions */
/* for the construct type being sought. */
/*==========================================*/
if ((theModuleItem = FindModuleItem(theEnv,execStatus,constructName)) == NULL)
{
RestoreCurrentModule(theEnv,execStatus);
return(NULL);
}
/*===========================================*/
/* If the construct type doesn't have a find */
/* function, then we can't look for it. */
/*===========================================*/
if (theModuleItem->findFunction == NULL)
{
RestoreCurrentModule(theEnv,execStatus);
return(NULL);
}
/*==================================*/
/* Initialize the search by marking */
/* all modules as unvisited. */
/*==================================*/
MarkModulesAsUnvisited(theEnv,execStatus);
/*===========================*/
/* Search for the construct. */
/*===========================*/
rv = SearchImportedConstructModules(theEnv,execStatus,(SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,constructName),
matchModule,theModuleItem,
(SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,findName),count,
searchCurrent,notYetDefinedInModule);
/*=============================*/
/* Restore the current module. */
/*=============================*/
RestoreCurrentModule(theEnv,execStatus);
/*====================================*/
/* Return a pointer to the construct. */
/*====================================*/
return(rv);
}
static int ParseImportSpec(
void *theEnv,
char *readSource,
struct token *theToken,
struct defmodule *newModule)
{
struct defmodule *theModule;
struct portItem *thePort, *oldImportSpec;
int found, count;
/*===========================*/
/* Look for the module name. */
/*===========================*/
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,theToken);
if (theToken->type != SYMBOL)
{
SyntaxErrorMessage(theEnv,"defmodule import specification");
return(TRUE);
}
/*=====================================*/
/* Verify the existence of the module. */
/*=====================================*/
if ((theModule = (struct defmodule *)
EnvFindDefmodule(theEnv,ValueToString(theToken->value))) == NULL)
{
CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken->value));
return(TRUE);
}
/*========================================*/
/* If the specified module doesn't export */
/* any constructs, then the import */
/* specification is meaningless. */
/*========================================*/
if (theModule->exportList == NULL)
{
NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),NULL,NULL);
return(TRUE);
}
/*==============================================*/
/* Parse the remaining portion of the import */
/* specification and return if an error occurs. */
/*==============================================*/
oldImportSpec = newModule->importList;
if (ParseExportSpec(theEnv,readSource,theToken,newModule,theModule)) return(TRUE);
/*========================================================*/
/* If the ?NONE keyword was used with the import spec, */
/* then no constructs were actually imported and the */
/* import spec does not need to be checked for conflicts. */
/*========================================================*/
if (newModule->importList == oldImportSpec) return(FALSE);
/*======================================================*/
/* Check to see if the construct being imported can be */
/* by the specified module. This check exported doesn't */
/* guarantee that a specific named construct actually */
/* exists. It just checks that it could be exported if */
/* it does exists. */
/*======================================================*/
if (newModule->importList->constructType != NULL)
{
/*=============================*/
/* Look for the construct in */
/* the module that exports it. */
/*=============================*/
found = FALSE;
for (thePort = theModule->exportList;
(thePort != NULL) && (! found);
thePort = thePort->next)
{
if (thePort->constructType == NULL) found = TRUE;
else if (thePort->constructType == newModule->importList->constructType)
{
if (newModule->importList->constructName == NULL) found = TRUE;
else if (thePort->constructName == NULL) found = TRUE;
else if (thePort->constructName == newModule->importList->constructName)
{ found = TRUE; }
}
}
/*=======================================*/
/* If it's not exported by the specified */
/* module, print an error message. */
/*=======================================*/
if (! found)
{
if (newModule->importList->constructName == NULL)
{
NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
ValueToString(newModule->importList->constructType),
NULL);
}
else
{
NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
ValueToString(newModule->importList->constructType),
ValueToString(newModule->importList->constructName));
}
return(TRUE);
}
}
/*======================================================*/
/* Verify that specific named constructs actually exist */
/* and can be seen from the module importing them. */
/*======================================================*/
SaveCurrentModule(theEnv);
EnvSetCurrentModule(theEnv,(void *) newModule);
for (thePort = newModule->importList;
thePort != NULL;
thePort = thePort->next)
{
if ((thePort->constructType == NULL) || (thePort->constructName == NULL))
{ continue; }
theModule = (struct defmodule *)
EnvFindDefmodule(theEnv,ValueToString(thePort->moduleName));
EnvSetCurrentModule(theEnv,theModule);
if (FindImportedConstruct(theEnv,ValueToString(thePort->constructType),NULL,
ValueToString(thePort->constructName),&count,
TRUE,FALSE) == NULL)
{
NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
ValueToString(thePort->constructType),
ValueToString(thePort->constructName));
RestoreCurrentModule(theEnv);
return(TRUE);
}
}
RestoreCurrentModule(theEnv);
/*===============================================*/
/* The import list has been successfully parsed. */
/*===============================================*/
return(FALSE);
}
globle void EnvGetFactList(
void *theEnv,
DATA_OBJECT_PTR returnValue,
void *vTheModule)
{
struct fact *theFact;
unsigned long count;
struct multifield *theList;
struct defmodule *theModule = (struct defmodule *) vTheModule;
/*==========================*/
/* Save the current module. */
/*==========================*/
SaveCurrentModule(theEnv);
/*============================================*/
/* Count the number of facts to be retrieved. */
/*============================================*/
if (theModule == NULL)
{
for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL), count = 0;
theFact != NULL;
theFact = (struct fact *) EnvGetNextFact(theEnv,theFact), count++)
{ /* Do Nothing */ }
}
else
{
EnvSetCurrentModule(theEnv,(void *) theModule);
UpdateDeftemplateScope(theEnv);
for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL), count = 0;
theFact != NULL;
theFact = (struct fact *) GetNextFactInScope(theEnv,theFact), count++)
{ /* Do Nothing */ }
}
/*===========================================================*/
/* Create the multifield value to store the construct names. */
/*===========================================================*/
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,(long) count);
theList = (struct multifield *) EnvCreateMultifield(theEnv,count);
SetpValue(returnValue,(void *) theList);
/*==================================================*/
/* Store the fact pointers in the multifield value. */
/*==================================================*/
if (theModule == NULL)
{
for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL), count = 1;
theFact != NULL;
theFact = (struct fact *) EnvGetNextFact(theEnv,theFact), count++)
{
SetMFType(theList,count,FACT_ADDRESS);
SetMFValue(theList,count,(void *) theFact);
}
}
else
{
for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL), count = 1;
theFact != NULL;
theFact = (struct fact *) GetNextFactInScope(theEnv,theFact), count++)
{
SetMFType(theList,count,FACT_ADDRESS);
SetMFValue(theList,count,(void *) theFact);
}
}
/*=============================*/
/* Restore the current module. */
/*=============================*/
RestoreCurrentModule(theEnv);
UpdateDeftemplateScope(theEnv);
}
static int FindMultiImportConflict(
void *theEnv,
struct defmodule *theModule)
{
struct defmodule *testModule;
int count;
struct portConstructItem *thePCItem;
struct construct *theConstruct;
void *theCItem;
/*==========================*/
/* Save the current module. */
/*==========================*/
SaveCurrentModule(theEnv);
/*============================*/
/* Loop through every module. */
/*============================*/
for (testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
testModule != NULL;
testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,testModule))
{
/*========================================*/
/* Loop through every construct type that */
/* can be imported/exported by a module. */
/*========================================*/
for (thePCItem = DefmoduleData(theEnv)->ListOfPortConstructItems;
thePCItem != NULL;
thePCItem = thePCItem->next)
{
EnvSetCurrentModule(theEnv,(void *) testModule);
/*=====================================================*/
/* Loop through every construct of the specified type. */
/*=====================================================*/
theConstruct = FindConstruct(theEnv,thePCItem->constructName);
for (theCItem = (*theConstruct->getNextItemFunction)(theEnv,NULL);
theCItem != NULL;
theCItem = (*theConstruct->getNextItemFunction)(theEnv,theCItem))
{
/*===============================================*/
/* Check to see if the specific construct in the */
/* module can be imported with more than one */
/* reference into the module we're examining for */
/* ambiguous import specifications. */
/*===============================================*/
EnvSetCurrentModule(theEnv,(void *) theModule);
FindImportedConstruct(theEnv,thePCItem->constructName,NULL,
ValueToString((*theConstruct->getConstructNameFunction)
((struct constructHeader *) theCItem)),
&count,FALSE,NULL);
if (count > 1)
{
ImportExportConflictMessage(theEnv,"defmodule",EnvGetDefmoduleName(theEnv,theModule),
thePCItem->constructName,
ValueToString((*theConstruct->getConstructNameFunction)
((struct constructHeader *) theCItem)));
RestoreCurrentModule(theEnv);
return(TRUE);
}
EnvSetCurrentModule(theEnv,(void *) testModule);
}
}
}
/*=============================*/
/* Restore the current module. */
/*=============================*/
RestoreCurrentModule(theEnv);
/*=======================================*/
/* Return FALSE to indicate no ambiguous */
/* references were found. */
/*=======================================*/
return(FALSE);
}
globle void ListItemsDriver(
void *theEnv,
EXEC_STATUS,
char *logicalName,
struct defmodule *theModule,
char *singleName,
char *pluralName,
void *(*nextFunction)(void *,EXEC_STATUS,void *),
char *(*nameFunction)(void *,EXEC_STATUS),
void (*printFunction)(void *,EXEC_STATUS,char *,void *),
int (*doItFunction)(void *,EXEC_STATUS,void *))
{
void *constructPtr;
char *constructName;
long count = 0;
int allModules = FALSE;
int doIt;
/*==========================*/
/* Save the current module. */
/*==========================*/
SaveCurrentModule(theEnv,execStatus);
/*======================*/
/* Print out the items. */
/*======================*/
if (theModule == NULL)
{
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,NULL);
allModules = TRUE;
}
while (theModule != NULL)
{
if (allModules)
{
EnvPrintRouter(theEnv,execStatus,logicalName,EnvGetDefmoduleName(theEnv,execStatus,theModule));
EnvPrintRouter(theEnv,execStatus,logicalName,":\n");
}
EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);
constructPtr = (*nextFunction)(theEnv,execStatus,NULL);
while (constructPtr != NULL)
{
if (execStatus->HaltExecution == TRUE) return;
if (doItFunction == NULL) doIt = TRUE;
else doIt = (*doItFunction)(theEnv,execStatus,constructPtr);
if (! doIt) {}
else if (nameFunction != NULL)
{
constructName = (*nameFunction)(constructPtr,execStatus);
if (constructName != NULL)
{
if (allModules) EnvPrintRouter(theEnv,execStatus,logicalName," ");
EnvPrintRouter(theEnv,execStatus,logicalName,constructName);
EnvPrintRouter(theEnv,execStatus,logicalName,"\n");
}
}
else if (printFunction != NULL)
{
if (allModules) EnvPrintRouter(theEnv,execStatus,logicalName," ");
(*printFunction)(theEnv,execStatus,logicalName,constructPtr);
EnvPrintRouter(theEnv,execStatus,logicalName,"\n");
}
constructPtr = (*nextFunction)(theEnv,execStatus,constructPtr);
count++;
}
if (allModules) theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,theModule);
else theModule = NULL;
}
/*=================================================*/
/* Print the tally and restore the current module. */
/*=================================================*/
if (singleName != NULL) PrintTally(theEnv,execStatus,logicalName,count,singleName,pluralName);
RestoreCurrentModule(theEnv,execStatus);
}