/******************************************************************************
NAME : QueryDoForAllFacts
DESCRIPTION : Finds all sets of facts which satisfy the query and
executes a user-function for each set as it is found
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query template-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every fact set. Also, the action is
executed for every fact set.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See FactParseQueryAction()
******************************************************************************/
globle void QueryDoForAllFacts(
void *theEnv,
DATA_OBJECT *result)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
"do-for-all-facts",&rcnt);
if (qtemplates == NULL)
return;
PushQueryCore(theEnv);
FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
FactQueryData(theEnv)->QueryCore->result = result;
ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
TestEntireChain(theEnv,qtemplates,0);
ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
PropagateReturnValue(theEnv,FactQueryData(theEnv)->QueryCore->result);
FactQueryData(theEnv)->AbortQuery = FALSE;
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
}
/******************************************************************************
NAME : QueryDoForAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
executes a user-function for each set as it is found
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set. Also, the action is
executed for every instance set.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See ParseQueryAction()
******************************************************************************/
globle void QueryDoForAllInstances(
void *theEnv,
EXEC_STATUS,
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
unsigned rcnt;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv,execStatus);
qclasses = DetermineQueryClasses(theEnv,execStatus,GetFirstArgument()->nextArg->nextArg,
"do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore(theEnv,execStatus);
InstanceQueryData(theEnv,execStatus)->QueryCore = get_struct(theEnv,execStatus,query_core);
InstanceQueryData(theEnv,execStatus)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,execStatus,(sizeof(INSTANCE_TYPE *) * rcnt));
InstanceQueryData(theEnv,execStatus)->QueryCore->query = GetFirstArgument();
InstanceQueryData(theEnv,execStatus)->QueryCore->action = GetFirstArgument()->nextArg;
InstanceQueryData(theEnv,execStatus)->QueryCore->result = result;
ValueInstall(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
TestEntireChain(theEnv,execStatus,qclasses,0);
ValueDeinstall(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
PropagateReturnValue(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
InstanceQueryData(theEnv,execStatus)->AbortQuery = FALSE;
ProcedureFunctionData(theEnv,execStatus)->BreakFlag = FALSE;
rm(theEnv,execStatus,(void *) InstanceQueryData(theEnv,execStatus)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(theEnv,execStatus,query_core,InstanceQueryData(theEnv,execStatus)->QueryCore);
PopQueryCore(theEnv,execStatus);
DeleteQueryClasses(theEnv,execStatus,qclasses);
}
/******************************************************************************
NAME : QueryDoForAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
executes a user-function for each set as it is found
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set. Also, the action is
executed for every instance set.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See ParseQueryAction()
******************************************************************************/
globle void QueryDoForAllInstances(
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
int rcnt;
result->type = SYMBOL;
result->value = FalseSymbol;
qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg->nextArg,
"do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore();
QueryCore = get_struct(query_core);
QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
QueryCore->query = GetFirstArgument();
QueryCore->action = GetFirstArgument()->nextArg;
QueryCore->result = result;
ValueInstall(QueryCore->result);
TestEntireChain(qclasses,0);
ValueDeinstall(QueryCore->result);
PropagateReturnValue(QueryCore->result);
AbortQuery = FALSE;
BreakFlag = FALSE;
rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(query_core,QueryCore);
PopQueryCore();
DeleteQueryClasses(qclasses);
}
static void UpdateSlot(
void *buf,
long obji)
{
SLOT_DESC *sp;
BSAVE_SLOT_DESC *bsp;
sp = (SLOT_DESC *) &slotArray[obji];
bsp = (BSAVE_SLOT_DESC *) buf;
sp->dynamicDefault = bsp->dynamicDefault;
sp->noDefault = bsp->noDefault;
sp->shared = bsp->shared;
sp->multiple = bsp->multiple;
sp->composite = bsp->composite;
sp->noInherit = bsp->noInherit;
sp->noWrite = bsp->noWrite;
sp->initializeOnly = bsp->initializeOnly;
sp->reactive = bsp->reactive;
sp->publicVisibility = bsp->publicVisibility;
sp->createReadAccessor = bsp->createReadAccessor;
sp->createWriteAccessor = bsp->createWriteAccessor;
sp->cls = DefclassPointer(bsp->cls);
sp->slotName = SlotNamePointer(bsp->slotName);
sp->overrideMessage = SymbolPointer(bsp->overrideMessage);
IncrementSymbolCount(sp->overrideMessage);
if (bsp->defaultValue != -1L)
{
if (sp->dynamicDefault)
sp->defaultValue = (void *) ExpressionPointer(bsp->defaultValue);
else
{
sp->defaultValue = (void *) get_struct(dataObject);
EvaluateAndStoreInDataObject((int) sp->multiple,ExpressionPointer(bsp->defaultValue),
(DATA_OBJECT *) sp->defaultValue);
ValueInstall((DATA_OBJECT *) sp->defaultValue);
}
}
else
sp->defaultValue = NULL;
sp->constraint = ConstraintPointer(bsp->constraint);
sp->sharedCount = 0;
sp->sharedValue.value = NULL;
sp->bsaveIndex = 0L;
if (sp->shared)
{
sp->sharedValue.desc = sp;
sp->sharedValue.value = NULL;
}
}
/*****************************************************************
NAME : TestEntireTemplate
DESCRIPTION : Processes all facts in a template
INPUTS : 1) The module for which templates tested must be
in scope
3) The template
4) The current template restriction chain
5) The index of the current restriction
RETURNS : Nothing useful
SIDE EFFECTS : Instance variable values set
Solution sets stored in global list
NOTES : None
*****************************************************************/
static void TestEntireTemplate(
void *theEnv,
struct deftemplate *templatePtr,
QUERY_TEMPLATE *qchain,
int indx)
{
struct fact *theFact;
DATA_OBJECT temp;
theFact = templatePtr->factList;
while (theFact != NULL)
{
FactQueryData(theEnv)->QueryCore->solns[indx] = theFact;
if (qchain->nxt != NULL)
{
theFact->factHeader.busyCount++;
TestEntireChain(theEnv,qchain->nxt,indx+1);
theFact->factHeader.busyCount--;
if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
break;
}
else
{
theFact->factHeader.busyCount++;
EvaluationData(theEnv)->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp);
EvaluationData(theEnv)->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,FALSE,TRUE);
theFact->factHeader.busyCount--;
if (EvaluationData(theEnv)->HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != EnvFalseSymbol(theEnv)))
{
if (FactQueryData(theEnv)->QueryCore->action != NULL)
{
theFact->factHeader.busyCount++;
EvaluationData(theEnv)->CurrentEvaluationDepth++;
ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,FactQueryData(theEnv)->QueryCore->result);
ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
EvaluationData(theEnv)->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,FALSE,TRUE);
theFact->factHeader.busyCount--;
if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
{
FactQueryData(theEnv)->AbortQuery = TRUE;
break;
}
if (EvaluationData(theEnv)->HaltExecution == TRUE)
break;
}
else
AddSolution(theEnv);
}
}
theFact = theFact->nextTemplateFact;
while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE)
theFact = theFact->nextTemplateFact;
}
}
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); }
}
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);
}
/***************************************************
NAME : ObjectsRunTimeInitialize
DESCRIPTION : Initializes objects system lists
in a run-time module
INPUTS : 1) Pointer to new class hash table
2) Pointer to new slot name table
RETURNS : Nothing useful
SIDE EFFECTS : Global pointers set
NOTES : None
***************************************************/
globle void ObjectsRunTimeInitialize(
void *theEnv,
DEFCLASS *ctable[],
SLOT_NAME *sntable[],
DEFCLASS **cidmap,
unsigned mid)
{
DEFCLASS *cls;
void *tmpexp;
register unsigned int i,j;
if (DefclassData(theEnv)->ClassTable != NULL)
{
for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
{
for (i = 0 ; i < cls->slotCount ; i++)
{
/* =====================================================================
For static default values, the data object value needs to deinstalled
and deallocated, and the expression needs to be restored (which was
temporarily stored in the supplementalInfo field of the data object)
===================================================================== */
if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
{
tmpexp = ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo;
ValueDeinstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue);
cls->slots[i].defaultValue = tmpexp;
}
}
}
}
InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING);
MessageHandlerData(theEnv)->INIT_SYMBOL = FindSymbolHN(theEnv,INIT_STRING);
MessageHandlerData(theEnv)->DELETE_SYMBOL = FindSymbolHN(theEnv,DELETE_STRING);
MessageHandlerData(theEnv)->CREATE_SYMBOL = FindSymbolHN(theEnv,CREATE_STRING);
DefclassData(theEnv)->ISA_SYMBOL = FindSymbolHN(theEnv,SUPERCLASS_RLN);
DefclassData(theEnv)->NAME_SYMBOL = FindSymbolHN(theEnv,NAME_RLN);
#if DEFRULE_CONSTRUCT
DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = FindSymbolHN(theEnv,INITIAL_OBJECT_NAME);
#endif
DefclassData(theEnv)->ClassTable = (DEFCLASS **) ctable;
DefclassData(theEnv)->SlotNameTable = (SLOT_NAME **) sntable;
DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) cidmap;
DefclassData(theEnv)->MaxClassID = (unsigned short) mid;
DefclassData(theEnv)->PrimitiveClassMap[FLOAT] =
LookupDefclassByMdlOrScope(theEnv,FLOAT_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[INTEGER] =
LookupDefclassByMdlOrScope(theEnv,INTEGER_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[STRING] =
LookupDefclassByMdlOrScope(theEnv,STRING_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[SYMBOL] =
LookupDefclassByMdlOrScope(theEnv,SYMBOL_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD] =
LookupDefclassByMdlOrScope(theEnv,MULTIFIELD_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS] =
LookupDefclassByMdlOrScope(theEnv,EXTERNAL_ADDRESS_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS] =
LookupDefclassByMdlOrScope(theEnv,FACT_ADDRESS_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME] =
LookupDefclassByMdlOrScope(theEnv,INSTANCE_NAME_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS] =
LookupDefclassByMdlOrScope(theEnv,INSTANCE_ADDRESS_TYPE_NAME);
for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
{
for (i = 0 ; i < cls->slotCount ; i++)
{
if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
{
tmpexp = cls->slots[i].defaultValue;
cls->slots[i].defaultValue = (void *) get_struct(theEnv,dataObject);
EvaluateAndStoreInDataObject(theEnv,(int) cls->slots[i].multiple,(EXPRESSION *) tmpexp,
(DATA_OBJECT *) cls->slots[i].defaultValue,TRUE);
ValueInstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo = tmpexp;
}
}
}
SearchForHashedPatternNodes(theEnv,ObjectReteData(theEnv)->ObjectPatternNetworkPointer);
}
/********************************************************************
NAME : EvaluateSlotDefaultValue
DESCRIPTION : Checks the default value against the slot
constraints and evaluates static default values
INPUTS : 1) The slot descriptor
2) The bitmap marking which facets were specified in
the original slot definition
RETURNS : TRUE if all OK, FALSE otherwise
SIDE EFFECTS : Static default value expressions deleted and
replaced with data object evaluation
NOTES : On errors, slot is marked as dynamix so that
DeleteSlots() will erase the slot expression
********************************************************************/
static intBool EvaluateSlotDefaultValue(
void *theEnv,
EXEC_STATUS,
SLOT_DESC *sd,
char *specbits)
{
DATA_OBJECT temp;
int oldce,olddcc,vCode;
/* ===================================================================
Slot default value expression is marked as dynamic until now so
that DeleteSlots() would erase in the event of an error. The delay
was so that the evaluation of a static default value could be
delayed until all the constraints were parsed.
=================================================================== */
if (TestBitMap(specbits,DEFAULT_DYNAMIC_BIT) == 0)
sd->dynamicDefault = 0;
if (sd->noDefault)
return(TRUE);
if (sd->dynamicDefault == 0)
{
if (TestBitMap(specbits,DEFAULT_BIT))
{
oldce = ExecutingConstruct(theEnv,execStatus);
SetExecutingConstruct(theEnv,execStatus,TRUE);
olddcc = EnvSetDynamicConstraintChecking(theEnv,execStatus,EnvGetStaticConstraintChecking(theEnv,execStatus));
vCode = EvaluateAndStoreInDataObject(theEnv,execStatus,(int) sd->multiple,
(EXPRESSION *) sd->defaultValue,&temp,TRUE);
if (vCode != FALSE)
vCode = ValidSlotValue(theEnv,execStatus,&temp,sd,NULL,"slot default value");
EnvSetDynamicConstraintChecking(theEnv,execStatus,olddcc);
SetExecutingConstruct(theEnv,execStatus,oldce);
if (vCode)
{
ExpressionDeinstall(theEnv,execStatus,(EXPRESSION *) sd->defaultValue);
ReturnPackedExpression(theEnv,execStatus,(EXPRESSION *) sd->defaultValue);
sd->defaultValue = (void *) get_struct(theEnv,execStatus,dataObject);
GenCopyMemory(DATA_OBJECT,1,sd->defaultValue,&temp);
ValueInstall(theEnv,execStatus,(DATA_OBJECT *) sd->defaultValue);
}
else
{
sd->dynamicDefault = 1;
return(FALSE);
}
}
else if (sd->defaultSpecified == 0)
{
sd->defaultValue = (void *) get_struct(theEnv,execStatus,dataObject);
DeriveDefaultFromConstraints(theEnv,execStatus,sd->constraint,
(DATA_OBJECT *) sd->defaultValue,(int) sd->multiple,TRUE);
ValueInstall(theEnv,execStatus,(DATA_OBJECT *) sd->defaultValue);
}
}
else if (EnvGetStaticConstraintChecking(theEnv,execStatus))
{
vCode = ConstraintCheckExpressionChain(theEnv,execStatus,(EXPRESSION *) sd->defaultValue,sd->constraint);
if (vCode != NO_VIOLATION)
{
PrintErrorID(theEnv,execStatus,"CSTRNCHK",1,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,"Expression for ");
PrintSlot(theEnv,execStatus,WERROR,sd,NULL,"dynamic default value");
ConstraintViolationErrorMessage(theEnv,execStatus,NULL,NULL,0,0,NULL,0,
vCode,sd->constraint,FALSE);
return(FALSE);
}
}
return(TRUE);
}
/**************************************************************************
NAME : BuildCompositeFacets
DESCRIPTION : Composite slots are ones that get their facets
from more than one class. By default, the most
specific class in object's precedence list specifies
the complete set of facets for a slot. The composite
facet in a slot allows facets that are not overridden
by the most specific class to be obtained from other
classes.
Since all superclasses are predetermined before creating
a new class based on them, this routine need only
examine the immediately next most specific class for
extra facets. Even if that slot is also composite, the
other facets have already been filtered down. If the
slot is no-inherit, the next most specific class must
be examined.
INPUTS : 1) The slot descriptor
2) The class precedence list
3) The bitmap marking which facets were specified in
the original slot definition
RETURNS : Nothing useful
SIDE EFFECTS : Composite slot is updated to reflect facets from
a less specific class
NOTES : Assumes slot is composite
*************************************************************************/
static void BuildCompositeFacets(
void *theEnv,
EXEC_STATUS,
SLOT_DESC *sd,
PACKED_CLASS_LINKS *preclist,
char *specbits,
CONSTRAINT_PARSE_RECORD *parsedConstraint)
{
SLOT_DESC *compslot = NULL;
long i;
for (i = 1 ; i < preclist->classCount ; i++)
{
compslot = FindClassSlot(preclist->classArray[i],sd->slotName->name);
if ((compslot != NULL) ? (compslot->noInherit == 0) : FALSE)
break;
}
if (compslot != NULL)
{
if ((sd->defaultSpecified == 0) && (compslot->defaultSpecified == 1))
{
sd->dynamicDefault = compslot->dynamicDefault;
sd->noDefault = compslot->noDefault;
sd->defaultSpecified = 1;
if (compslot->defaultValue != NULL)
{
if (sd->dynamicDefault)
{
sd->defaultValue = (void *) PackExpression(theEnv,execStatus,(EXPRESSION *) compslot->defaultValue);
ExpressionInstall(theEnv,execStatus,(EXPRESSION *) sd->defaultValue);
}
else
{
sd->defaultValue = (void *) get_struct(theEnv,execStatus,dataObject);
GenCopyMemory(DATA_OBJECT,1,sd->defaultValue,compslot->defaultValue);
ValueInstall(theEnv,execStatus,(DATA_OBJECT *) sd->defaultValue);
}
}
}
if (TestBitMap(specbits,FIELD_BIT) == 0)
sd->multiple = compslot->multiple;
if (TestBitMap(specbits,STORAGE_BIT) == 0)
sd->shared = compslot->shared;
if (TestBitMap(specbits,ACCESS_BIT) == 0)
{
sd->noWrite = compslot->noWrite;
sd->initializeOnly = compslot->initializeOnly;
}
#if DEFRULE_CONSTRUCT
if (TestBitMap(specbits,MATCH_BIT) == 0)
sd->reactive = compslot->reactive;
#endif
if (TestBitMap(specbits,VISIBILITY_BIT) == 0)
sd->publicVisibility = compslot->publicVisibility;
if (TestBitMap(specbits,CREATE_ACCESSOR_BIT) == 0)
{
sd->createReadAccessor = compslot->createReadAccessor;
sd->createWriteAccessor = compslot->createWriteAccessor;
}
if ((TestBitMap(specbits,OVERRIDE_MSG_BIT) == 0) &&
compslot->overrideMessageSpecified)
{
DecrementSymbolCount(theEnv,execStatus,sd->overrideMessage);
sd->overrideMessage = compslot->overrideMessage;
IncrementSymbolCount(sd->overrideMessage);
sd->overrideMessageSpecified = TRUE;
}
OverlayConstraint(theEnv,execStatus,parsedConstraint,sd->constraint,compslot->constraint);
}
}
globle void BindFunction(
DATA_OBJECT_PTR returnValue)
{
DATA_OBJECT *theBind, *lastBind;
int found = FALSE,
unbindVar = FALSE;
SYMBOL_HN *variableName = NULL;
#if DEFGLOBAL_CONSTRUCT
struct defglobal *theGlobal = NULL;
#endif
/*===============================================*/
/* Determine the name of the variable to be set. */
/*===============================================*/
#if DEFGLOBAL_CONSTRUCT
if (GetFirstArgument()->type == DEFGLOBAL_PTR)
{ theGlobal = (struct defglobal *) GetFirstArgument()->value; }
else
#endif
{
EvaluateExpression(GetFirstArgument(),returnValue);
variableName = (SYMBOL_HN *) DOPToPointer(returnValue);
}
/*===========================================*/
/* Determine the new value for the variable. */
/*===========================================*/
if (GetFirstArgument()->nextArg == NULL)
{ unbindVar = TRUE; }
else if (GetFirstArgument()->nextArg->nextArg == NULL)
{ EvaluateExpression(GetFirstArgument()->nextArg,returnValue); }
else
{ StoreInMultifield(returnValue,GetFirstArgument()->nextArg,TRUE); }
/*==================================*/
/* Bind a defglobal if appropriate. */
/*==================================*/
#if DEFGLOBAL_CONSTRUCT
if (theGlobal != NULL)
{
QSetDefglobalValue(theGlobal,returnValue,unbindVar);
return;
}
#endif
/*===============================================*/
/* Search for the variable in the list of binds. */
/*===============================================*/
theBind = BindList;
lastBind = NULL;
while ((theBind != NULL) && (found == FALSE))
{
if (theBind->supplementalInfo == (void *) variableName)
{ found = TRUE; }
else
{
lastBind = theBind;
theBind = theBind->next;
}
}
/*========================================================*/
/* If variable was not in the list of binds, then add it. */
/* Make sure that this operation preserves the bind list */
/* as a stack. */
/*========================================================*/
if (found == FALSE)
{
if (unbindVar == FALSE)
{
theBind = get_struct(dataObject);
theBind->supplementalInfo = (void *) variableName;
theBind->next = NULL;
if (lastBind == NULL)
{ BindList = theBind; }
else
{ lastBind->next = theBind; }
}
else
{
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
return;
}
}
else
{ ValueDeinstall(theBind); }
/*================================*/
/* Set the value of the variable. */
/*================================*/
if (unbindVar == FALSE)
{
theBind->type = returnValue->type;
theBind->value = returnValue->value;
theBind->begin = returnValue->begin;
theBind->end = returnValue->end;
ValueInstall(returnValue);
}
else
{
if (lastBind == NULL) BindList = theBind->next;
else lastBind->next = theBind->next;
rtn_struct(dataObject,theBind);
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
}
}
globle void SortFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
long argumentCount, i, j, k = 0;
DATA_OBJECT *theArguments, *theArguments2;
DATA_OBJECT theArg;
struct multifield *theMultifield, *tempMultifield;
char *functionName;
struct expr *functionReference;
int argumentSize = 0;
struct FunctionDefinition *fptr;
#if DEFFUNCTION_CONSTRUCT
DEFFUNCTION *dptr;
#endif
/*==================================*/
/* Set up the default return value. */
/*==================================*/
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
/*=============================================*/
/* The function expects at least one argument. */
/*=============================================*/
if ((argumentCount = EnvArgCountCheck(theEnv,"sort",AT_LEAST,1)) == -1)
{ return; }
/*=============================================*/
/* Verify that the comparison function exists. */
/*=============================================*/
if (EnvArgTypeCheck(theEnv,"sort",1,SYMBOL,&theArg) == FALSE)
{ return; }
functionName = DOToString(theArg);
functionReference = FunctionReferenceExpression(theEnv,functionName);
if (functionReference == NULL)
{
ExpectedTypeError1(theEnv,"sort",1,"function name, deffunction name, or defgeneric name");
return;
}
/*======================================*/
/* For an external function, verify the */
/* correct number of arguments. */
/*======================================*/
if (functionReference->type == FCALL)
{
fptr = (struct FunctionDefinition *) functionReference->value;
if ((GetMinimumArgs(fptr) > 2) ||
(GetMaximumArgs(fptr) == 0) ||
(GetMaximumArgs(fptr) == 1))
{
ExpectedTypeError1(theEnv,"sort",1,"function name expecting two arguments");
ReturnExpression(theEnv,functionReference);
return;
}
}
/*=======================================*/
/* For a deffunction, verify the correct */
/* number of arguments. */
/*=======================================*/
#if DEFFUNCTION_CONSTRUCT
if (functionReference->type == PCALL)
{
dptr = (DEFFUNCTION *) functionReference->value;
if ((dptr->minNumberOfParameters > 2) ||
(dptr->maxNumberOfParameters == 0) ||
(dptr->maxNumberOfParameters == 1))
{
ExpectedTypeError1(theEnv,"sort",1,"deffunction name expecting two arguments");
ReturnExpression(theEnv,functionReference);
return;
}
}
#endif
/*=====================================*/
/* If there are no items to be sorted, */
/* then return an empty multifield. */
/*=====================================*/
if (argumentCount == 1)
{
EnvSetMultifieldErrorValue(theEnv,returnValue);
ReturnExpression(theEnv,functionReference);
return;
}
/*=====================================*/
/* Retrieve the arguments to be sorted */
/* and determine how many there are. */
/*=====================================*/
theArguments = (DATA_OBJECT *) genalloc(theEnv,(argumentCount - 1) * sizeof(DATA_OBJECT));
for (i = 2; i <= argumentCount; i++)
{
EnvRtnUnknown(theEnv,i,&theArguments[i-2]);
if (GetType(theArguments[i-2]) == MULTIFIELD)
{ argumentSize += GetpDOLength(&theArguments[i-2]); }
else
{ argumentSize++; }
}
if (argumentSize == 0)
{
genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT)); /* Bug Fix */
EnvSetMultifieldErrorValue(theEnv,returnValue);
ReturnExpression(theEnv,functionReference);
return;
}
/*====================================*/
/* Pack all of the items to be sorted */
/* into a data object array. */
/*====================================*/
theArguments2 = (DATA_OBJECT *) genalloc(theEnv,argumentSize * sizeof(DATA_OBJECT));
for (i = 2; i <= argumentCount; i++)
{
if (GetType(theArguments[i-2]) == MULTIFIELD)
{
tempMultifield = (struct multifield *) GetValue(theArguments[i-2]);
for (j = GetDOBegin(theArguments[i-2]); j <= GetDOEnd(theArguments[i-2]); j++, k++)
{
SetType(theArguments2[k],GetMFType(tempMultifield,j));
SetValue(theArguments2[k],GetMFValue(tempMultifield,j));
}
}
else
{
SetType(theArguments2[k],GetType(theArguments[i-2]));
SetValue(theArguments2[k],GetValue(theArguments[i-2]));
k++;
}
}
genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT));
functionReference->nextArg = SortFunctionData(theEnv)->SortComparisonFunction;
SortFunctionData(theEnv)->SortComparisonFunction = functionReference;
for (i = 0; i < argumentSize; i++)
{ ValueInstall(theEnv,&theArguments2[i]); }
MergeSort(theEnv,(unsigned long) argumentSize,theArguments2,DefaultCompareSwapFunction);
for (i = 0; i < argumentSize; i++)
{ ValueDeinstall(theEnv,&theArguments2[i]); }
SortFunctionData(theEnv)->SortComparisonFunction = SortFunctionData(theEnv)->SortComparisonFunction->nextArg;
functionReference->nextArg = NULL;
ReturnExpression(theEnv,functionReference);
theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,(unsigned long) argumentSize);
for (i = 0; i < argumentSize; i++)
{
SetMFType(theMultifield,i+1,GetType(theArguments2[i]));
SetMFValue(theMultifield,i+1,GetValue(theArguments2[i]));
}
genfree(theEnv,theArguments2,argumentSize * sizeof(DATA_OBJECT));
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,argumentSize);
SetpValue(returnValue,(void *) theMultifield);
}
/*****************************************************************
NAME : TestEntireClass
DESCRIPTION : Processes all instances in a class and then
all subclasses of a class until done
INPUTS : 1) The module for which classes tested must be
in scope
2) Visitation traversal id
3) The class
4) The current class restriction chain
5) The index of the current restriction
RETURNS : Nothing useful
SIDE EFFECTS : Instance variable values set
Solution sets stored in global list
NOTES : None
*****************************************************************/
static void TestEntireClass(
void *theEnv,
EXEC_STATUS,
struct defmodule *theModule,
int id,
DEFCLASS *cls,
QUERY_CLASS *qchain,
int indx)
{
long i;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
if (TestTraversalID(cls->traversalRecord,id))
return;
SetTraversalID(cls->traversalRecord,id);
if (DefclassInScope(theEnv,execStatus,cls,theModule) == FALSE)
return;
ins = cls->instanceList;
while (ins != NULL)
{
InstanceQueryData(theEnv,execStatus)->QueryCore->solns[indx] = ins;
if (qchain->nxt != NULL)
{
ins->busy++;
TestEntireChain(theEnv,execStatus,qchain->nxt,indx+1);
ins->busy--;
if ((execStatus->HaltExecution == TRUE) || (InstanceQueryData(theEnv,execStatus)->AbortQuery == TRUE))
break;
}
else
{
ins->busy++;
execStatus->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->query,&temp);
execStatus->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,execStatus,FALSE,TRUE);
ins->busy--;
if (execStatus->HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != EnvFalseSymbol(theEnv,execStatus)))
{
if (InstanceQueryData(theEnv,execStatus)->QueryCore->action != NULL)
{
ins->busy++;
execStatus->CurrentEvaluationDepth++;
ValueDeinstall(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
EvaluateExpression(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->action,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
ValueInstall(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
execStatus->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,execStatus,FALSE,TRUE);
ins->busy--;
if (ProcedureFunctionData(theEnv,execStatus)->BreakFlag || ProcedureFunctionData(theEnv,execStatus)->ReturnFlag)
{
InstanceQueryData(theEnv,execStatus)->AbortQuery = TRUE;
break;
}
if (execStatus->HaltExecution == TRUE)
break;
}
else
AddSolution(theEnv,execStatus);
}
}
ins = ins->nxtClass;
while ((ins != NULL) ? (ins->garbage == 1) : FALSE)
ins = ins->nxtClass;
}
if (ins != NULL)
return;
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
{
TestEntireClass(theEnv,execStatus,theModule,id,cls->directSubclasses.classArray[i],qchain,indx);
if ((execStatus->HaltExecution == TRUE) || (InstanceQueryData(theEnv,execStatus)->AbortQuery == TRUE))
return;
}
}
/*****************************************************************
NAME : TestEntireClass
DESCRIPTION : Processes all instances in a class and then
all subclasses of a class until done
INPUTS : 1) The module for which classes tested must be
in scope
2) Visitation traversal id
3) The class
4) The current class restriction chain
5) The index of the current restriction
RETURNS : Nothing useful
SIDE EFFECTS : Instance variable values set
Solution sets stored in global list
NOTES : None
*****************************************************************/
static void TestEntireClass(
struct defmodule *theModule,
int id,
DEFCLASS *cls,
QUERY_CLASS *qchain,
int indx)
{
register unsigned i;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
if (TestTraversalID(cls->traversalRecord,id))
return;
SetTraversalID(cls->traversalRecord,id);
if (DefclassInScope(cls,theModule) == FALSE)
return;
ins = cls->instanceList;
while (ins != NULL)
{
QueryCore->solns[indx] = ins;
if (qchain->nxt != NULL)
{
ins->busy++;
TestEntireChain(qchain->nxt,indx+1);
ins->busy--;
if ((HaltExecution == TRUE) || (AbortQuery == TRUE))
break;
}
else
{
ins->busy++;
CurrentEvaluationDepth++;
EvaluateExpression(QueryCore->query,&temp);
CurrentEvaluationDepth--;
PeriodicCleanup(FALSE,TRUE);
ins->busy--;
if (HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != FalseSymbol))
{
if (QueryCore->action != NULL)
{
ins->busy++;
CurrentEvaluationDepth++;
ValueDeinstall(QueryCore->result);
EvaluateExpression(QueryCore->action,QueryCore->result);
ValueInstall(QueryCore->result);
CurrentEvaluationDepth--;
PeriodicCleanup(FALSE,TRUE);
ins->busy--;
if (BreakFlag || ReturnFlag)
{
AbortQuery = TRUE;
break;
}
if (HaltExecution == TRUE)
break;
}
else
AddSolution();
}
}
ins = ins->nxtClass;
while ((ins != NULL) ? (ins->garbage == 1) : FALSE)
ins = ins->nxtClass;
}
if (ins != NULL)
return;
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
{
TestEntireClass(theModule,id,cls->directSubclasses.classArray[i],qchain,indx);
if ((HaltExecution == TRUE) || (AbortQuery == TRUE))
return;
}
}
/*****************************************************************
NAME : TestEntireClass
DESCRIPTION : Processes all instances in a class and then
all subclasses of a class until done
INPUTS : 1) The module for which classes tested must be
in scope
2) Visitation traversal id
3) The class
4) The current class restriction chain
5) The index of the current restriction
RETURNS : Nothing useful
SIDE EFFECTS : Instance variable values set
Solution sets stored in global list
NOTES : None
*****************************************************************/
static void TestEntireClass(
void *theEnv,
struct defmodule *theModule,
int id,
DEFCLASS *cls,
QUERY_CLASS *qchain,
int indx)
{
long i;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
struct garbageFrame newGarbageFrame;
struct garbageFrame *oldGarbageFrame;
if (TestTraversalID(cls->traversalRecord,id))
return;
SetTraversalID(cls->traversalRecord,id);
if (DefclassInScope(theEnv,cls,theModule) == FALSE)
return;
oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame;
memset(&newGarbageFrame,0,sizeof(struct garbageFrame));
newGarbageFrame.priorFrame = oldGarbageFrame;
UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame;
ins = cls->instanceList;
while (ins != NULL)
{
InstanceQueryData(theEnv)->QueryCore->solns[indx] = ins;
if (qchain->nxt != NULL)
{
ins->busy++;
TestEntireChain(theEnv,qchain->nxt,indx+1);
ins->busy--;
if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE))
break;
}
else
{
ins->busy++;
EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->query,&temp);
ins->busy--;
if (EvaluationData(theEnv)->HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != EnvFalseSymbol(theEnv)))
{
if (InstanceQueryData(theEnv)->QueryCore->action != NULL)
{
ins->busy++;
ValueDeinstall(theEnv,InstanceQueryData(theEnv)->QueryCore->result);
EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,InstanceQueryData(theEnv)->QueryCore->result);
ValueInstall(theEnv,InstanceQueryData(theEnv)->QueryCore->result);
ins->busy--;
if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
{
InstanceQueryData(theEnv)->AbortQuery = TRUE;
break;
}
if (EvaluationData(theEnv)->HaltExecution == TRUE)
break;
}
else
AddSolution(theEnv);
}
}
ins = ins->nxtClass;
while ((ins != NULL) ? (ins->garbage == 1) : FALSE)
ins = ins->nxtClass;
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
}
RestorePriorGarbageFrame(theEnv,&newGarbageFrame, oldGarbageFrame,NULL);
CallPeriodicTasks(theEnv);
if (ins != NULL)
return;
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
{
TestEntireClass(theEnv,theModule,id,cls->directSubclasses.classArray[i],qchain,indx);
if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE))
return;
}
}