static void DestroyDefglobal(
Environment *theEnv,
Defglobal *theDefglobal)
{
if (theDefglobal == NULL) return;
/*====================================*/
/* Return the global's current value. */
/*====================================*/
if (theDefglobal->current.header->type == MULTIFIELD_TYPE)
{
if (theDefglobal->current.multifieldValue->busyCount == 0)
{ ReturnMultifield(theEnv,theDefglobal->current.multifieldValue); }
else
{ AddToMultifieldList(theEnv,theDefglobal->current.multifieldValue); }
}
#if (! RUN_TIME)
/*===============================*/
/* Release items stored in the */
/* defglobal's construct header. */
/*===============================*/
DeinstallConstructHeader(theEnv,&theDefglobal->header);
/*======================================*/
/* Return the defglobal data structure. */
/*======================================*/
rtn_struct(theEnv,defglobal,theDefglobal);
#endif
}
static void ClearBload()
{
long i;
unsigned long space;
/*=======================================================*/
/* Decrement in use counters for atomic values contained */
/* in the construct headers. Also decrement data */
/* structures used to store the defglobal's value. */
/*=======================================================*/
for (i = 0; i < NumberOfDefglobals; i++)
{
UnmarkConstructHeader(&DefglobalArray[i].header);
ValueDeinstall(&(DefglobalArray[i].current));
if (DefglobalArray[i].current.type == MULTIFIELD)
{ ReturnMultifield((struct multifield *) DefglobalArray[i].current.value); }
}
/*==============================================================*/
/* Deallocate the space used for the defglobal data structures. */
/*==============================================================*/
space = NumberOfDefglobals * sizeof(struct defglobal);
if (space != 0) genlongfree((void *) DefglobalArray,space);
/*=====================================================================*/
/* Deallocate the space used for the defglobal module data structures. */
/*=====================================================================*/
space = NumberOfDefglobalModules * sizeof(struct defglobalModule);
if (space != 0) genlongfree((void *) ModuleArray,space);
}
static void DestroyDefglobal(
void *theEnv,
void *vTheDefglobal)
{
#if (! BLOAD_ONLY)
struct defglobal *theDefglobal = (struct defglobal *) vTheDefglobal;
if (theDefglobal == NULL) return;
/*====================================*/
/* Return the global's current value. */
/*====================================*/
if (theDefglobal->current.type == MULTIFIELD)
{ ReturnMultifield(theEnv,(struct multifield *) theDefglobal->current.value); }
#if (! RUN_TIME)
/*===============================*/
/* Release items stored in the */
/* defglobal's construct header. */
/*===============================*/
DeinstallConstructHeader(theEnv,&theDefglobal->header);
/*======================================*/
/* Return the defglobal data structure. */
/*======================================*/
rtn_struct(theEnv,defglobal,theDefglobal);
#endif
#endif
}
static void DeallocateMultifieldData(
void *theEnv)
{
struct multifield *tmpPtr, *nextPtr;
tmpPtr = MultifieldData(theEnv)->ListOfMultifields;
while (tmpPtr != NULL)
{
nextPtr = tmpPtr->next;
ReturnMultifield(theEnv,tmpPtr);
tmpPtr = nextPtr;
}
}
static void ReturnDefglobal(
void *theEnv,
void *vTheDefglobal)
{
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,vTheDefglobal)
#endif
#if (! BLOAD_ONLY) && (! RUN_TIME)
struct defglobal *theDefglobal = (struct defglobal *) vTheDefglobal;
if (theDefglobal == NULL) return;
/*====================================*/
/* Return the global's current value. */
/*====================================*/
ValueDeinstall(theEnv,&theDefglobal->current);
if (theDefglobal->current.type == MULTIFIELD)
{ ReturnMultifield(theEnv,(struct multifield *) theDefglobal->current.value); }
/*================================================*/
/* Return the expression representing the initial */
/* value of the defglobal when it was defined. */
/*================================================*/
RemoveHashedExpression(theEnv,theDefglobal->initial);
/*===============================*/
/* Release items stored in the */
/* defglobal's construct header. */
/*===============================*/
DeinstallConstructHeader(theEnv,&theDefglobal->header);
/*======================================*/
/* Return the defglobal data structure. */
/*======================================*/
rtn_struct(theEnv,defglobal,theDefglobal);
/*===========================================*/
/* Set the variable indicating that a change */
/* has been made to a global variable. */
/*===========================================*/
DefglobalData(theEnv)->ChangeToGlobals = TRUE;
#endif
}
static void ReturnDefglobal(
Environment *theEnv,
Defglobal *theDefglobal)
{
#if (! BLOAD_ONLY) && (! RUN_TIME)
if (theDefglobal == NULL) return;
/*====================================*/
/* Return the global's current value. */
/*====================================*/
Release(theEnv,theDefglobal->current.header);
if (theDefglobal->current.header->type == MULTIFIELD_TYPE)
{
if (theDefglobal->current.multifieldValue->busyCount == 0)
{ ReturnMultifield(theEnv,theDefglobal->current.multifieldValue); }
else
{ AddToMultifieldList(theEnv,theDefglobal->current.multifieldValue); }
}
/*================================================*/
/* Return the expression representing the initial */
/* value of the defglobal when it was defined. */
/*================================================*/
RemoveHashedExpression(theEnv,theDefglobal->initial);
/*===============================*/
/* Release items stored in the */
/* defglobal's construct header. */
/*===============================*/
DeinstallConstructHeader(theEnv,&theDefglobal->header);
/*======================================*/
/* Return the defglobal data structure. */
/*======================================*/
rtn_struct(theEnv,defglobal,theDefglobal);
/*===========================================*/
/* Set the variable indicating that a change */
/* has been made to a global variable. */
/*===========================================*/
DefglobalData(theEnv)->ChangeToGlobals = true;
#endif
}
globle void ReturnFact(
struct fact *theFact)
{
struct multifield *theSegment;
int newSize, i;
theSegment = &theFact->theProposition;
for (i = 0; i < (int) theSegment->multifieldLength; i++)
{
if (theSegment->theFields[i].type == MULTIFIELD)
{ ReturnMultifield((struct multifield *) theSegment->theFields[i].value); }
}
if (theFact->theProposition.multifieldLength == 0) newSize = 1;
else newSize = theFact->theProposition.multifieldLength;
rtn_var_struct2(fact,sizeof(struct field) * (newSize - 1),theFact);
}
static void ClearBload(
void *theEnv,
EXEC_STATUS)
{
long i;
size_t space;
/*=======================================================*/
/* Decrement in use counters for atomic values contained */
/* in the construct headers. Also decrement data */
/* structures used to store the defglobal's value. */
/*=======================================================*/
for (i = 0; i < DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobals; i++)
{
UnmarkConstructHeader(theEnv,execStatus,&DefglobalBinaryData(theEnv,execStatus)->DefglobalArray[i].header);
ValueDeinstall(theEnv,execStatus,&(DefglobalBinaryData(theEnv,execStatus)->DefglobalArray[i].current));
if (DefglobalBinaryData(theEnv,execStatus)->DefglobalArray[i].current.type == MULTIFIELD)
{ ReturnMultifield(theEnv,execStatus,(struct multifield *) DefglobalBinaryData(theEnv,execStatus)->DefglobalArray[i].current.value); }
}
/*==============================================================*/
/* Deallocate the space used for the defglobal data structures. */
/*==============================================================*/
space = DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobals * sizeof(struct defglobal);
if (space != 0) genfree(theEnv,execStatus,(void *) DefglobalBinaryData(theEnv,execStatus)->DefglobalArray,space);
DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobals = 0;
/*=====================================================================*/
/* Deallocate the space used for the defglobal module data structures. */
/*=====================================================================*/
space = DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobalModules * sizeof(struct defglobalModule);
if (space != 0) genfree(theEnv,execStatus,(void *) DefglobalBinaryData(theEnv,execStatus)->ModuleArray,space);
DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobalModules = 0;
}
static void DeallocateDefglobalBloadData(
void *theEnv,
EXEC_STATUS)
{
#if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME)
size_t space;
long i;
for (i = 0; i < DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobals; i++)
{
if (DefglobalBinaryData(theEnv,execStatus)->DefglobalArray[i].current.type == MULTIFIELD)
{ ReturnMultifield(theEnv,execStatus,(struct multifield *) DefglobalBinaryData(theEnv,execStatus)->DefglobalArray[i].current.value); }
}
space = DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobals * sizeof(struct defglobal);
if (space != 0)
{ genfree(theEnv,execStatus,(void *) DefglobalBinaryData(theEnv,execStatus)->DefglobalArray,space); }
space = DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobalModules * sizeof(struct defglobalModule);
if (space != 0)
{ genfree(theEnv,execStatus,(void *) DefglobalBinaryData(theEnv,execStatus)->ModuleArray,space); }
#endif
}
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); }
}
void QSetDefglobalValue(
Environment *theEnv,
Defglobal *theGlobal,
UDFValue *vPtr,
bool resetVar)
{
CLIPSValue newValue;
/*====================================================*/
/* If the new value passed for the defglobal is NULL, */
/* then reset the defglobal to the initial value it */
/* had when it was defined. */
/*====================================================*/
if (resetVar)
{
EvaluateExpression(theEnv,theGlobal->initial,vPtr);
if (EvaluationData(theEnv)->EvaluationError)
{ vPtr->value = FalseSymbol(theEnv); }
}
/*==========================================*/
/* If globals are being watch, then display */
/* the change to the global variable. */
/*==========================================*/
#if DEBUGGING_FUNCTIONS
if (theGlobal->watch &&
(! ConstructData(theEnv)->ClearReadyInProgress) &&
(! ConstructData(theEnv)->ClearInProgress))
{
WriteString(theEnv,STDOUT,":== ?*");
WriteString(theEnv,STDOUT,theGlobal->header.name->contents);
WriteString(theEnv,STDOUT,"* ==> ");
WriteUDFValue(theEnv,STDOUT,vPtr);
WriteString(theEnv,STDOUT," <== ");
WriteCLIPSValue(theEnv,STDOUT,&theGlobal->current);
WriteString(theEnv,STDOUT,"\n");
}
#endif
/*==============================================*/
/* Retain the new value of the global variable. */
/*==============================================*/
NormalizeMultifield(theEnv,vPtr);
if (vPtr->header->type != MULTIFIELD_TYPE)
{ newValue.value = vPtr->value; }
else
{ newValue.value = CopyMultifield(theEnv,vPtr->multifieldValue); }
Retain(theEnv,newValue.header);
/*==============================================*/
/* Remove the old value of the global variable. */
/*==============================================*/
Release(theEnv,theGlobal->current.header);
if (theGlobal->current.header->type == MULTIFIELD_TYPE)
{
if (theGlobal->current.multifieldValue->busyCount == 0)
{ ReturnMultifield(theEnv,theGlobal->current.multifieldValue); }
else
{ AddToMultifieldList(theEnv,theGlobal->current.multifieldValue); }
}
/*===========================================*/
/* Set the new value of the global variable. */
/*===========================================*/
theGlobal->current.value = newValue.value;
/*===========================================*/
/* Set the variable indicating that a change */
/* has been made to a global variable. */
/*===========================================*/
DefglobalData(theEnv)->ChangeToGlobals = true;
if (EvaluationData(theEnv)->CurrentExpression == NULL)
{
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
}
}
static void AddDefglobal(
void *theEnv,
SYMBOL_HN *name,
DATA_OBJECT_PTR vPtr,
struct expr *ePtr)
{
struct defglobal *defglobalPtr;
intBool newGlobal = FALSE;
#if DEBUGGING_FUNCTIONS
int GlobalHadWatch = FALSE;
#endif
/*========================================================*/
/* If the defglobal is already defined, then use the old */
/* data structure and substitute new values. If it hasn't */
/* been defined, then create a new data structure. */
/*========================================================*/
defglobalPtr = QFindDefglobal(theEnv,name);
if (defglobalPtr == NULL)
{
newGlobal = TRUE;
defglobalPtr = get_struct(theEnv,defglobal);
}
else
{
DeinstallConstructHeader(theEnv,&defglobalPtr->header);
#if DEBUGGING_FUNCTIONS
GlobalHadWatch = defglobalPtr->watch;
#endif
}
/*===========================================*/
/* Remove the old values from the defglobal. */
/*===========================================*/
if (newGlobal == FALSE)
{
ValueDeinstall(theEnv,&defglobalPtr->current);
if (defglobalPtr->current.type == MULTIFIELD)
{ ReturnMultifield(theEnv,(struct multifield *) defglobalPtr->current.value); }
RemoveHashedExpression(theEnv,defglobalPtr->initial);
}
/*=======================================*/
/* Copy the new values to the defglobal. */
/*=======================================*/
defglobalPtr->current.type = vPtr->type;
if (vPtr->type != MULTIFIELD) defglobalPtr->current.value = vPtr->value;
else DuplicateMultifield(theEnv,&defglobalPtr->current,vPtr);
ValueInstall(theEnv,&defglobalPtr->current);
defglobalPtr->initial = AddHashedExpression(theEnv,ePtr);
ReturnExpression(theEnv,ePtr);
DefglobalData(theEnv)->ChangeToGlobals = TRUE;
/*=================================*/
/* Restore the old watch value to */
/* the defglobal if redefined. */
/*=================================*/
#if DEBUGGING_FUNCTIONS
defglobalPtr->watch = GlobalHadWatch ? TRUE : WatchGlobals;
#endif
/*======================================*/
/* Save the name and pretty print form. */
/*======================================*/
defglobalPtr->header.name = name;
defglobalPtr->header.usrData = NULL;
IncrementSymbolCount(name);
SavePPBuffer(theEnv,"\n");
if (EnvGetConserveMemory(theEnv) == TRUE)
{ defglobalPtr->header.ppForm = NULL; }
else
{ defglobalPtr->header.ppForm = CopyPPBuffer(theEnv); }
defglobalPtr->inScope = TRUE;
/*=============================================*/
/* If the defglobal was redefined, we're done. */
/*=============================================*/
if (newGlobal == FALSE) return;
/*===================================*/
/* Copy the defglobal variable name. */
/*===================================*/
defglobalPtr->busyCount = 0;
defglobalPtr->header.whichModule = (struct defmoduleItemHeader *)
GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defglobal")->moduleIndex);
/*=============================================*/
/* Add the defglobal to the list of defglobals */
/* for the current module. */
/*=============================================*/
AddConstructToModule(&defglobalPtr->header);
}
globle BOOLEAN PutFactSlot(
void *vTheFact,
char *slotName,
DATA_OBJECT *theValue)
{
struct fact *theFact = (struct fact *) vTheFact;
struct deftemplate *theDeftemplate;
struct templateSlot *theSlot;
int whichSlot;
/*===============================================*/
/* Get the deftemplate associated with the fact. */
/*===============================================*/
theDeftemplate = theFact->whichDeftemplate;
/*============================================*/
/* Handle setting the slot value of a fact */
/* having an implied deftemplate. An implied */
/* facts has a single multifield slot. */
/*============================================*/
if (theDeftemplate->implied)
{
if ((slotName != NULL) || (theValue->type != MULTIFIELD))
{ return(FALSE); }
if (theFact->theProposition.theFields[0].type == MULTIFIELD)
{ ReturnMultifield((struct multifield *) theFact->theProposition.theFields[0].value); }
theFact->theProposition.theFields[0].type = (short) theValue->type;
theFact->theProposition.theFields[0].value = DOToMultifield(theValue);
return(TRUE);
}
/*===================================*/
/* Make sure the slot name requested */
/* corresponds to a valid slot name. */
/*===================================*/
if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) AddSymbol(slotName),&whichSlot)) == NULL)
{ return(FALSE); }
/*=============================================*/
/* Make sure a single field value is not being */
/* stored in a multifield slot or vice versa. */
/*=============================================*/
if (((theSlot->multislot == 0) && (theValue->type == MULTIFIELD)) ||
((theSlot->multislot == 1) && (theValue->type != MULTIFIELD)))
{ return(FALSE); }
/*=====================*/
/* Set the slot value. */
/*=====================*/
if (theFact->theProposition.theFields[whichSlot-1].type == MULTIFIELD)
{ ReturnMultifield((struct multifield *) theFact->theProposition.theFields[whichSlot-1].value); }
theFact->theProposition.theFields[whichSlot-1].type = (short) theValue->type;
if (theValue->type == MULTIFIELD)
{ theFact->theProposition.theFields[whichSlot-1].value = DOToMultifield(theValue); }
else
{ theFact->theProposition.theFields[whichSlot-1].value = theValue->value; }
return(TRUE);
}
