/*************************************************** NAME : DeleteSlots DESCRIPTION : Deallocates a list of slots and their values INPUTS : The address of the slot list RETURNS : Nothing useful SIDE EFFECTS : The slot list is destroyed NOTES : None ***************************************************/ globle void DeleteSlots( void *theEnv, EXEC_STATUS, TEMP_SLOT_LINK *slots) { TEMP_SLOT_LINK *stmp; while (slots != NULL) { stmp = slots; slots = slots->nxt; DeleteSlotName(theEnv,execStatus,stmp->desc->slotName); DecrementSymbolCount(theEnv,execStatus,stmp->desc->overrideMessage); RemoveConstraint(theEnv,execStatus,stmp->desc->constraint); if (stmp->desc->dynamicDefault == 1) { ExpressionDeinstall(theEnv,execStatus,(EXPRESSION *) stmp->desc->defaultValue); ReturnPackedExpression(theEnv,execStatus,(EXPRESSION *) stmp->desc->defaultValue); } else if (stmp->desc->defaultValue != NULL) { ValueDeinstall(theEnv,execStatus,(DATA_OBJECT *) stmp->desc->defaultValue); rtn_struct(theEnv,execStatus,dataObject,stmp->desc->defaultValue); } rtn_struct(theEnv,execStatus,slotDescriptor,stmp->desc); rtn_struct(theEnv,execStatus,tempSlotLink,stmp); } }
/****************************************************************************** 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 : 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( 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 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); }
globle void ReturnValues( DATA_OBJECT_PTR garbagePtr) { DATA_OBJECT_PTR nextPtr; while (garbagePtr != NULL) { nextPtr = garbagePtr->next; ValueDeinstall(garbagePtr); rtn_struct(dataObject,garbagePtr); garbagePtr = 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 }
globle void ReturnValues( void *theEnv, DATA_OBJECT_PTR garbagePtr, intBool decrementSupplementalInfo) { DATA_OBJECT_PTR nextPtr; while (garbagePtr != NULL) { nextPtr = garbagePtr->next; ValueDeinstall(theEnv,garbagePtr); if ((garbagePtr->supplementalInfo != NULL) && decrementSupplementalInfo) { DecrementSymbolCount(theEnv,(struct symbolHashNode *) garbagePtr->supplementalInfo); } rtn_struct(theEnv,dataObject,garbagePtr); garbagePtr = nextPtr; } }
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 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); }
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; } }
/***************************************************************** 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, 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 : ClearBloadObjects DESCRIPTION : Release all binary-loaded class and handler structure arrays (and others) INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Memory cleared NOTES : None ***************************************************************/ static void ClearBloadObjects() { register long i; UNLN space; space = (unsigned long) (sizeof(DEFCLASS_MODULE) * ModuleCount); if (space == 0L) return; genlongfree((void *) ModuleArray,space); ModuleArray = NULL; ModuleCount = 0L; if (ClassCount != 0L) { rm((void *) ClassIDMap,(int) (sizeof(DEFCLASS *) * MaxClassID)); ClassIDMap = NULL; MaxClassID = 0; for (i = 0L ; i < ClassCount ; i++) { UnmarkConstructHeader(&defclassArray[i].header); #if DEFMODULE_CONSTRUCT DecrementBitMapCount(defclassArray[i].scopeMap); #endif RemoveClassFromTable((DEFCLASS *) &defclassArray[i]); } for (i = 0L ; i < SlotCount ; i++) { DecrementSymbolCount(slotArray[i].overrideMessage); if ((slotArray[i].defaultValue != NULL) && (slotArray[i].dynamicDefault == 0)) { ValueDeinstall((DATA_OBJECT *) slotArray[i].defaultValue); rtn_struct(dataObject,slotArray[i].defaultValue); } } for (i = 0L ; i < SlotNameCount ; i++) { SlotNameTable[slotNameArray[i].hashTableIndex] = NULL; DecrementSymbolCount(slotNameArray[i].name); DecrementSymbolCount(slotNameArray[i].putHandlerName); } space = (UNLN) (sizeof(DEFCLASS) * ClassCount); if (space != 0L) { genlongfree((void *) defclassArray,space); defclassArray = NULL; ClassCount = 0L; } space = (UNLN) (sizeof(DEFCLASS *) * LinkCount); if (space != 0L) { genlongfree((void *) linkArray,space); linkArray = NULL; LinkCount = 0L; } space = (UNLN) (sizeof(SLOT_DESC) * SlotCount); if (space != 0L) { genlongfree((void *) slotArray,space); slotArray = NULL; SlotCount = 0L; } space = (UNLN) (sizeof(SLOT_NAME) * SlotNameCount); if (space != 0L) { genlongfree((void *) slotNameArray,space); slotNameArray = NULL; SlotNameCount = 0L; } space = (UNLN) (sizeof(SLOT_DESC *) * TemplateSlotCount); if (space != 0L) { genlongfree((void *) tmpslotArray,space); tmpslotArray = NULL; TemplateSlotCount = 0L; } space = (UNLN) (sizeof(unsigned) * SlotNameMapCount); if (space != 0L) { genlongfree((void *) mapslotArray,space); mapslotArray = NULL; SlotNameMapCount = 0L; } } if (HandlerCount != 0L) { for (i = 0L ; i < HandlerCount ; i++) DecrementSymbolCount(handlerArray[i].name); space = (UNLN) (sizeof(HANDLER) * HandlerCount); if (space != 0L) { genlongfree((void *) handlerArray,space); handlerArray = NULL; space = (UNLN) (sizeof(unsigned) * HandlerCount); genlongfree((void *) maphandlerArray,space); maphandlerArray = NULL; HandlerCount = 0L; } } }
globle void QSetDefglobalValue( void *theEnv, struct defglobal *theGlobal, DATA_OBJECT_PTR vPtr, int resetVar) { /*====================================================*/ /* If the new value passed for the defglobal is NULL, */ /* then reset the defglobal to the initial value it */ /* had when it was defined. */ /*====================================================*/ if (resetVar) { EvaluateExpression(theEnv,theGlobal->initial,vPtr); if (EvaluationData(theEnv)->EvaluationError) { vPtr->type = SYMBOL; vPtr->value = EnvFalseSymbol(theEnv); } } /*==========================================*/ /* If globals are being watch, then display */ /* the change to the global variable. */ /*==========================================*/ #if DEBUGGING_FUNCTIONS if (theGlobal->watch) { EnvPrintRouter(theEnv,WTRACE,":== ?*"); EnvPrintRouter(theEnv,WTRACE,ValueToString(theGlobal->header.name)); EnvPrintRouter(theEnv,WTRACE,"* ==> "); PrintDataObject(theEnv,WTRACE,vPtr); EnvPrintRouter(theEnv,WTRACE," <== "); PrintDataObject(theEnv,WTRACE,&theGlobal->current); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*==============================================*/ /* Remove the old value of the global variable. */ /*==============================================*/ ValueDeinstall(theEnv,&theGlobal->current); if (theGlobal->current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theGlobal->current.value); } /*===========================================*/ /* Set the new value of the global variable. */ /*===========================================*/ theGlobal->current.type = vPtr->type; if (vPtr->type != MULTIFIELD) theGlobal->current.value = vPtr->value; else DuplicateMultifield(theEnv,&theGlobal->current,vPtr); ValueInstall(theEnv,&theGlobal->current); /*===========================================*/ /* Set the variable indicating that a change */ /* has been made to a global variable. */ /*===========================================*/ DefglobalData(theEnv)->ChangeToGlobals = TRUE; if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } }
globle void 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 : TestEntireTemplate DESCRIPTION : Processes all facts in a template INPUTS : 1) The module for which templates tested must be in scope 3) The template 4) The current template restriction chain 5) The index of the current restriction RETURNS : Nothing useful SIDE EFFECTS : Instance variable values set Solution sets stored in global list NOTES : None *****************************************************************/ static void TestEntireTemplate( void *theEnv, struct deftemplate *templatePtr, QUERY_TEMPLATE *qchain, int indx) { struct fact *theFact; DATA_OBJECT temp; theFact = templatePtr->factList; while (theFact != NULL) { FactQueryData(theEnv)->QueryCore->solns[indx] = theFact; if (qchain->nxt != NULL) { theFact->factHeader.busyCount++; TestEntireChain(theEnv,qchain->nxt,indx+1); theFact->factHeader.busyCount--; if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) break; } else { theFact->factHeader.busyCount++; EvaluationData(theEnv)->CurrentEvaluationDepth++; EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp); EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); theFact->factHeader.busyCount--; if (EvaluationData(theEnv)->HaltExecution == TRUE) break; if ((temp.type != SYMBOL) ? TRUE : (temp.value != EnvFalseSymbol(theEnv))) { if (FactQueryData(theEnv)->QueryCore->action != NULL) { theFact->factHeader.busyCount++; EvaluationData(theEnv)->CurrentEvaluationDepth++; ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result); EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,FactQueryData(theEnv)->QueryCore->result); ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result); EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); theFact->factHeader.busyCount--; if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { FactQueryData(theEnv)->AbortQuery = TRUE; break; } if (EvaluationData(theEnv)->HaltExecution == TRUE) break; } else AddSolution(theEnv); } } theFact = theFact->nextTemplateFact; while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE) theFact = theFact->nextTemplateFact; } }
/***************************************************************** NAME : TestEntireClass DESCRIPTION : Processes all instances in a class and then all subclasses of a class until done INPUTS : 1) The module for which classes tested must be in scope 2) Visitation traversal id 3) The class 4) The current class restriction chain 5) The index of the current restriction RETURNS : Nothing useful SIDE EFFECTS : Instance variable values set Solution sets stored in global list NOTES : None *****************************************************************/ static void TestEntireClass( 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; } }