bool UndefineFunction( void *theEnv, const char *functionName) { SYMBOL_HN *findValue; struct FunctionDefinition *fPtr, *lastPtr = NULL; findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,functionName); for (fPtr = ExternalFunctionData(theEnv)->ListOfFunctions; fPtr != NULL; fPtr = fPtr->next) { if (fPtr->callFunctionName == findValue) { DecrementSymbolCount(theEnv,fPtr->callFunctionName); RemoveHashFunction(theEnv,fPtr); if (lastPtr == NULL) { ExternalFunctionData(theEnv)->ListOfFunctions = fPtr->next; } else { lastPtr->next = fPtr->next; } if (fPtr->restrictions != NULL) { DecrementSymbolCount(theEnv,fPtr->restrictions); } ClearUserDataList(theEnv,fPtr->usrData); rtn_struct(theEnv,FunctionDefinition,fPtr); return(true); } lastPtr = fPtr; } return(false); }
globle int UndefineFunction( char *functionName) { SYMBOL_HN *findValue; struct FunctionDefinition *fPtr, *lastPtr = NULL; findValue = (SYMBOL_HN *) FindSymbol(functionName); for (fPtr = ListOfFunctions; fPtr != NULL; fPtr = fPtr->next) { if (fPtr->callFunctionName == findValue) { DecrementSymbolCount(fPtr->callFunctionName); RemoveHashFunction(fPtr); if (lastPtr == NULL) { ListOfFunctions = fPtr->next; } else { lastPtr->next = fPtr->next; } rtn_struct(FunctionDefinition,fPtr); return(TRUE); } lastPtr = fPtr; } return(FALSE); }
/*************************************************** 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); } }
static void ClearBload() { long i; unsigned long space; struct portItem *theList; /*===========================*/ /* Decrement in use counters */ /* used by the binary image. */ /*===========================*/ for (i = 0; i < NumberOfDefmodules; i++) { DecrementSymbolCount(DefmoduleArray[i].name); for (theList = DefmoduleArray[i].importList; theList != NULL; theList = theList->next) { if (theList->moduleName != NULL) DecrementSymbolCount(theList->moduleName); if (theList->constructType != NULL) DecrementSymbolCount(theList->constructType); if (theList->constructName != NULL) DecrementSymbolCount(theList->constructName); } for (theList = DefmoduleArray[i].exportList; theList != NULL; theList = theList->next) { if (theList->moduleName != NULL) DecrementSymbolCount(theList->moduleName); if (theList->constructType != NULL) DecrementSymbolCount(theList->constructType); if (theList->constructName != NULL) DecrementSymbolCount(theList->constructName); } rm(DefmoduleArray[i].itemsArray,(int) sizeof(void *) * GetNumberOfModuleItems()); } /*================================*/ /* Deallocate the space used for */ /* the defmodule data structures. */ /*================================*/ space = NumberOfDefmodules * sizeof(struct defmodule); if (space != 0) genlongfree((void *) DefmoduleArray,space); /*================================*/ /* Deallocate the space used for */ /* the port item data structures. */ /*================================*/ space = NumberOfPortItems * sizeof(struct portItem); if (space != 0) genlongfree((void *) PortItemArray,space); /*===========================*/ /* Reset module information. */ /*===========================*/ SetListOfDefmodules(NULL); CreateMainModule(); MainModuleRedefinable = TRUE; }
static void ClearBload( void *theEnv) { size_t space; int i; /*=============================================*/ /* Decrement in use counters for atomic values */ /* contained in the construct headers. */ /*=============================================*/ for (i = 0; i < DeftemplateBinaryData(theEnv)->NumberOfDeftemplates; i++) { UnmarkConstructHeader(theEnv,&DeftemplateBinaryData(theEnv)->DeftemplateArray[i].header); } /*=======================================*/ /* Decrement in use counters for symbols */ /* used as slot names. */ /*=======================================*/ for (i = 0; i < DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots; i++) { DecrementSymbolCount(theEnv,DeftemplateBinaryData(theEnv)->SlotArray[i].slotName); } /*======================================================================*/ /* Deallocate the space used for the deftemplateModule data structures. */ /*======================================================================*/ space = DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct deftemplateModule); if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->ModuleArray,space); DeftemplateBinaryData(theEnv)->NumberOfTemplateModules = 0; /*================================================================*/ /* Deallocate the space used for the deftemplate data structures. */ /*================================================================*/ space = DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(struct deftemplate); if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->DeftemplateArray,space); DeftemplateBinaryData(theEnv)->NumberOfDeftemplates = 0; /*=================================================================*/ /* Deallocate the space used for the templateSlot data structures. */ /*=================================================================*/ space = DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct templateSlot); if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->SlotArray,space); DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots = 0; /*======================================*/ /* Create the initial-fact deftemplate. */ /*======================================*/ #if (! BLOAD_ONLY) CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE); #endif }
/************************************************************** NAME : RemoveDefinstances DESCRIPTION : Deallocates and removes a definstance construct INPUTS : The definstance address RETURNS : Nothing useful SIDE EFFECTS : Existing definstance construct deleted NOTES : Assumes busy count of definstance is 0 **************************************************************/ static void RemoveDefinstances( void *theEnv, void *vdptr) { DEFINSTANCES *dptr = (DEFINSTANCES *) vdptr; DecrementSymbolCount(theEnv,GetDefinstancesNamePointer((void *) dptr)); ExpressionDeinstall(theEnv,dptr->mkinstance); ReturnPackedExpression(theEnv,dptr->mkinstance); SetDefinstancesPPForm((void *) dptr,NULL); ClearUserDataList(theEnv,dptr->header.usrData); rtn_struct(theEnv,definstances,dptr); }
static void ReturnDeftemplate( void *theEnv, void *vTheConstruct) { #if (MAC_MCW || WIN_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,vTheConstruct) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct deftemplate *theConstruct = (struct deftemplate *) vTheConstruct; struct templateSlot *slotPtr; if (theConstruct == NULL) return; /*====================================================================*/ /* If a template is redefined, then we want to save its debug status. */ /*====================================================================*/ #if DEBUGGING_FUNCTIONS DeftemplateData(theEnv)->DeletedTemplateDebugFlags = 0; if (theConstruct->watch) BitwiseSet(DeftemplateData(theEnv)->DeletedTemplateDebugFlags,0); #endif /*===========================================*/ /* Free storage used by the templates slots. */ /*===========================================*/ slotPtr = theConstruct->slotList; while (slotPtr != NULL) { DecrementSymbolCount(theEnv,slotPtr->slotName); RemoveHashedExpression(theEnv,slotPtr->defaultList); slotPtr->defaultList = NULL; RemoveHashedExpression(theEnv,slotPtr->facetList); slotPtr->facetList = NULL; RemoveConstraint(theEnv,slotPtr->constraints); slotPtr->constraints = NULL; slotPtr = slotPtr->next; } ReturnSlots(theEnv,theConstruct->slotList); /*==================================*/ /* Free storage used by the header. */ /*==================================*/ DeinstallConstructHeader(theEnv,&theConstruct->header); rtn_struct(theEnv,deftemplate,theConstruct); #endif }
/*************************************************** NAME : RemoveDeffunction DESCRIPTION : Removes a deffunction INPUTS : Deffunction pointer RETURNS : Nothing useful SIDE EFFECTS : Deffunction deallocated NOTES : Assumes deffunction is not in use!! ***************************************************/ globle void RemoveDeffunction( void *theEnv, void *vdptr) { DEFFUNCTION *dptr = (DEFFUNCTION *) vdptr; if (dptr == NULL) return; DecrementSymbolCount(theEnv,GetDeffunctionNamePointer((void *) dptr)); ExpressionDeinstall(theEnv,dptr->code); ReturnPackedExpression(theEnv,dptr->code); SetDeffunctionPPForm((void *) dptr,NULL); ClearUserDataList(theEnv,dptr->header.usrData); rtn_struct(theEnv,deffunctionStruct,dptr); }
/************************************************** NAME : RemoveDefgeneric DESCRIPTION : Removes a generic function node from the generic list along with all its methods INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : List adjusted Nodes deallocated NOTES : Assumes generic is not in use!!! **************************************************/ globle void RemoveDefgeneric( void *vgfunc) { DEFGENERIC *gfunc = (DEFGENERIC *) vgfunc; register int i; for (i = 0 ; i < gfunc->mcnt ; i++) DeleteMethodInfo(gfunc,&gfunc->methods[i]); if (gfunc->mcnt != 0) rm((void *) gfunc->methods,(int) (sizeof(DEFMETHOD) * gfunc->mcnt)); DecrementSymbolCount(GetDefgenericNamePointer((void *) gfunc)); SetDefgenericPPForm((void *) gfunc,NULL); ClearUserDataList(gfunc->header.usrData); rtn_struct(defgeneric,gfunc); }
globle void DeinstallConstructHeader( struct constructHeader *theHeader) { DecrementSymbolCount(theHeader->name); if (theHeader->ppForm != NULL) { rm(theHeader->ppForm, (int) sizeof(char) * ((int) strlen(theHeader->ppForm) + 1)); theHeader->ppForm = NULL; } if (theHeader->usrData != NULL) { ClearUserDataList(theHeader->usrData); theHeader->usrData = NULL; } }
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; } }
globle void AtomDeinstall( int type, void *vPtr) { switch (type) { case SYMBOL: case STRING: #if DEFGLOBAL_CONSTRUCT case GBL_VARIABLE: #endif #if OBJECT_SYSTEM case INSTANCE_NAME: #endif DecrementSymbolCount((SYMBOL_HN *) vPtr); break; case FLOAT: DecrementFloatCount((FLOAT_HN *) vPtr); break; case INTEGER: DecrementIntegerCount((INTEGER_HN *) vPtr); break; #if FUZZY_DEFTEMPLATES case FUZZY_VALUE: DeinstallFuzzyValue(vPtr); break; #endif case MULTIFIELD: MultifieldDeinstall((struct multifield *) vPtr); break; case RVOID: break; default: if (PrimitivesArray[type] == NULL) break; if (PrimitivesArray[type]->bitMap) DecrementBitMapCount((BITMAP_HN *) vPtr); else if (PrimitivesArray[type]->decrementBusyCount) { (*PrimitivesArray[type]->decrementBusyCount)(vPtr); } } }
/************************************************** NAME : RemoveDefgeneric DESCRIPTION : Removes a generic function node from the generic list along with all its methods INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : List adjusted Nodes deallocated NOTES : Assumes generic is not in use!!! **************************************************/ globle void RemoveDefgeneric( void *theEnv, EXEC_STATUS, void *vgfunc) { DEFGENERIC *gfunc = (DEFGENERIC *) vgfunc; long i; for (i = 0 ; i < gfunc->mcnt ; i++) DeleteMethodInfo(theEnv,execStatus,gfunc,&gfunc->methods[i]); if (gfunc->mcnt != 0) rm(theEnv,execStatus,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt)); DecrementSymbolCount(theEnv,execStatus,GetDefgenericNamePointer((void *) gfunc)); SetDefgenericPPForm((void *) gfunc,NULL); ClearUserDataList(theEnv,execStatus,gfunc->header.usrData); rtn_struct(theEnv,execStatus,defgeneric,gfunc); }
globle void AtomDeinstall( void *theEnv, int type, void *vPtr) { switch (type) { case SYMBOL: case STRING: #if DEFGLOBAL_CONSTRUCT case GBL_VARIABLE: #endif #if OBJECT_SYSTEM case INSTANCE_NAME: #endif DecrementSymbolCount(theEnv,(SYMBOL_HN *) vPtr); break; case FLOAT: DecrementFloatCount(theEnv,(FLOAT_HN *) vPtr); break; case INTEGER: DecrementIntegerCount(theEnv,(INTEGER_HN *) vPtr); break; case EXTERNAL_ADDRESS: DecrementExternalAddressCount(theEnv,(EXTERNAL_ADDRESS_HN *) vPtr); break; case MULTIFIELD: MultifieldDeinstall(theEnv,(struct multifield *) vPtr); break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[type]->bitMap) DecrementBitMapCount(theEnv,(BITMAP_HN *) vPtr); else if (EvaluationData(theEnv)->PrimitivesArray[type]->decrementBusyCount) { (*EvaluationData(theEnv)->PrimitivesArray[type]->decrementBusyCount)(theEnv,vPtr); } } }
globle void DeinstallConstructHeader( void *theEnv, EXEC_STATUS, struct constructHeader *theHeader) { DecrementSymbolCount(theEnv,execStatus,theHeader->name); if (theHeader->ppForm != NULL) { rm(theEnv,execStatus,theHeader->ppForm, sizeof(char) * (strlen(theHeader->ppForm) + 1)); theHeader->ppForm = NULL; } if (theHeader->usrData != NULL) { ClearUserDataList(theEnv,execStatus,theHeader->usrData); theHeader->usrData = NULL; } }
/************************************************************ NAME : ParseSlot DESCRIPTION : Parses slot definitions for a defclass statement INPUTS : 1) The logical name of the input source 2) The current slot list 3) The class precedence list for the class to which this slot is being attached (used to find facets for composite slots) 4) A flag indicating if this is a multifield slot or not 5) A flag indicating if the type of slot (single or multi) was explicitly specified or not RETURNS : The address of the list of slots, NULL if there was an error SIDE EFFECTS : The slot list is allocated NOTES : Assumes "(slot" has already been parsed. ************************************************************/ globle TEMP_SLOT_LINK *ParseSlot( void *theEnv, EXEC_STATUS, char *readSource, TEMP_SLOT_LINK *slist, PACKED_CLASS_LINKS *preclist, int multiSlot, int fieldSpecified) { SLOT_DESC *slot; CONSTRAINT_PARSE_RECORD parsedConstraint; char specbits[2]; int rtnCode; SYMBOL_HN *newOverrideMsg; /* =============================================================== Bits in specbits are when slot qualifiers are specified so that duplicate or conflicting qualifiers can be detected. Shared/local bit-0 Single/multiple bit-1 Read-only/Read-write/Initialize-Only bit-2 Inherit/No-inherit bit-3 Composite/Exclusive bit-4 Reactive/Nonreactive bit-5 Default bit-6 Default-dynamic bit-7 Visibility bit-8 Override-message bit-9 =============================================================== */ SavePPBuffer(theEnv,execStatus," "); specbits[0] = specbits[1] = '\0'; GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken); if (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) != SYMBOL) { DeleteSlots(theEnv,execStatus,slist); SyntaxErrorMessage(theEnv,execStatus,"defclass slot"); return(NULL); } if ((DefclassData(theEnv,execStatus)->ObjectParseToken.value == (void *) DefclassData(theEnv,execStatus)->ISA_SYMBOL) || (DefclassData(theEnv,execStatus)->ObjectParseToken.value == (void *) DefclassData(theEnv,execStatus)->NAME_SYMBOL)) { DeleteSlots(theEnv,execStatus,slist); SyntaxErrorMessage(theEnv,execStatus,"defclass slot"); return(NULL); } slot = NewSlot(theEnv,execStatus,(SYMBOL_HN *) GetValue(DefclassData(theEnv,execStatus)->ObjectParseToken)); slist = InsertSlot(theEnv,execStatus,slist,slot); if (slist == NULL) return(NULL); if (multiSlot) slot->multiple = TRUE; if (fieldSpecified) SetBitMap(specbits,FIELD_BIT); GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken); IncrementIndentDepth(theEnv,execStatus,3); InitializeConstraintParseRecord(&parsedConstraint); while (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) == LPAREN) { PPBackup(theEnv,execStatus); PPCRAndIndent(theEnv,execStatus); SavePPBuffer(theEnv,execStatus,"("); GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken); if (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,execStatus,"defclass slot"); goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),DEFAULT_FACET) == 0) { if (ParseDefaultFacet(theEnv,execStatus,readSource,specbits,slot) == FALSE) goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),DYNAMIC_FACET) == 0) { SetBitMap(specbits,DEFAULT_DYNAMIC_BIT); if (ParseDefaultFacet(theEnv,execStatus,readSource,specbits,slot) == FALSE) goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),ACCESS_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,ACCESS_FACET,ACCESS_BIT, SLOT_RDWRT_RLN,SLOT_RDONLY_RLN,SLOT_INIT_RLN, NULL,NULL); if (rtnCode == -1) goto ParseSlotError; else if (rtnCode == 1) slot->noWrite = 1; else if (rtnCode == 2) slot->initializeOnly = 1; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),STORAGE_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,STORAGE_FACET,STORAGE_BIT, SLOT_LOCAL_RLN,SLOT_SHARE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->shared = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),PROPAGATION_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,PROPAGATION_FACET,PROPAGATION_BIT, SLOT_INH_RLN,SLOT_NO_INH_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->noInherit = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),SOURCE_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,SOURCE_FACET,SOURCE_BIT, SLOT_EXCLUSIVE_RLN,SLOT_COMPOSITE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->composite = rtnCode; } #if DEFRULE_CONSTRUCT else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),MATCH_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,MATCH_FACET,MATCH_BIT, SLOT_NONREACTIVE_RLN,SLOT_REACTIVE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->reactive = rtnCode; } #endif else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),VISIBILITY_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,VISIBILITY_FACET,VISIBILITY_BIT, SLOT_PRIVATE_RLN,SLOT_PUBLIC_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->publicVisibility = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),CREATE_ACCESSOR_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,CREATE_ACCESSOR_FACET, CREATE_ACCESSOR_BIT, SLOT_READ_RLN,SLOT_WRITE_RLN,SLOT_RDWRT_RLN, SLOT_NONE_RLN,NULL); if (rtnCode == -1) goto ParseSlotError; if ((rtnCode == 0) || (rtnCode == 2)) slot->createReadAccessor = TRUE; if ((rtnCode == 1) || (rtnCode == 2)) slot->createWriteAccessor = TRUE; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),OVERRIDE_MSG_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,OVERRIDE_MSG_FACET,OVERRIDE_MSG_BIT, NULL,NULL,NULL,SLOT_DEFAULT_RLN,&newOverrideMsg); if (rtnCode == -1) goto ParseSlotError; if (rtnCode == 4) { DecrementSymbolCount(theEnv,execStatus,slot->overrideMessage); slot->overrideMessage = newOverrideMsg; IncrementSymbolCount(slot->overrideMessage); } slot->overrideMessageSpecified = TRUE; } else if (StandardConstraint(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken))) { if (ParseStandardConstraint(theEnv,execStatus,readSource,DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken), slot->constraint,&parsedConstraint,TRUE) == FALSE) goto ParseSlotError; } else { SyntaxErrorMessage(theEnv,execStatus,"defclass slot"); goto ParseSlotError; } GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken); } if (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,execStatus,"defclass slot"); goto ParseSlotError; } if (DefclassData(theEnv,execStatus)->ClassDefaultsMode == CONVENIENCE_MODE) { if (! TestBitMap(specbits,CREATE_ACCESSOR_BIT)) { slot->createReadAccessor = TRUE; if (! slot->noWrite) { slot->createWriteAccessor = TRUE; } } } if (slot->composite) BuildCompositeFacets(theEnv,execStatus,slot,preclist,specbits,&parsedConstraint); if (CheckForFacetConflicts(theEnv,execStatus,slot,&parsedConstraint) == FALSE) goto ParseSlotError; if (CheckConstraintParseConflicts(theEnv,execStatus,slot->constraint) == FALSE) goto ParseSlotError; if (EvaluateSlotDefaultValue(theEnv,execStatus,slot,specbits) == FALSE) goto ParseSlotError; if ((slot->dynamicDefault == 0) && (slot->noWrite == 1) && (slot->initializeOnly == 0)) slot->shared = 1; slot->constraint = AddConstraint(theEnv,execStatus,slot->constraint); DecrementIndentDepth(theEnv,execStatus,3); return(slist); ParseSlotError: DecrementIndentDepth(theEnv,execStatus,3); DeleteSlots(theEnv,execStatus,slist); return(NULL); }
globle void BindFunction( void *theEnv, 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(theEnv,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(theEnv,GetFirstArgument()->nextArg,returnValue); } else { StoreInMultifield(theEnv,returnValue,GetFirstArgument()->nextArg,TRUE); } /*==================================*/ /* Bind a defglobal if appropriate. */ /*==================================*/ #if DEFGLOBAL_CONSTRUCT if (theGlobal != NULL) { QSetDefglobalValue(theEnv,theGlobal,returnValue,unbindVar); return; } #endif /*===============================================*/ /* Search for the variable in the list of binds. */ /*===============================================*/ theBind = ProcedureFunctionData(theEnv)->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(theEnv,dataObject); theBind->supplementalInfo = (void *) variableName; IncrementSymbolCount(variableName); theBind->next = NULL; if (lastBind == NULL) { ProcedureFunctionData(theEnv)->BindList = theBind; } else { lastBind->next = theBind; } } else { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } } else { ValueDeinstall(theEnv,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(theEnv,returnValue); } else { if (lastBind == NULL) ProcedureFunctionData(theEnv)->BindList = theBind->next; else lastBind->next = theBind->next; DecrementSymbolCount(theEnv,(struct symbolHashNode *) theBind->supplementalInfo); rtn_struct(theEnv,dataObject,theBind); returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); } }
static void ClearBload( void *theEnv) { long i; size_t space; struct portItem *theList; /*===========================*/ /* Decrement in use counters */ /* used by the binary image. */ /*===========================*/ for (i = 0; i < DefmoduleData(theEnv)->BNumberOfDefmodules; i++) { DecrementSymbolCount(theEnv,DefmoduleData(theEnv)->DefmoduleArray[i].name); for (theList = DefmoduleData(theEnv)->DefmoduleArray[i].importList; theList != NULL; theList = theList->next) { if (theList->moduleName != NULL) DecrementSymbolCount(theEnv,theList->moduleName); if (theList->constructType != NULL) DecrementSymbolCount(theEnv,theList->constructType); if (theList->constructName != NULL) DecrementSymbolCount(theEnv,theList->constructName); } for (theList = DefmoduleData(theEnv)->DefmoduleArray[i].exportList; theList != NULL; theList = theList->next) { if (theList->moduleName != NULL) DecrementSymbolCount(theEnv,theList->moduleName); if (theList->constructType != NULL) DecrementSymbolCount(theEnv,theList->constructType); if (theList->constructName != NULL) DecrementSymbolCount(theEnv,theList->constructName); } rm(theEnv,DefmoduleData(theEnv)->DefmoduleArray[i].itemsArray,sizeof(void *) * GetNumberOfModuleItems(theEnv)); } /*================================*/ /* Deallocate the space used for */ /* the defmodule data structures. */ /*================================*/ space = DefmoduleData(theEnv)->BNumberOfDefmodules * sizeof(struct defmodule); if (space != 0) genfree(theEnv,(void *) DefmoduleData(theEnv)->DefmoduleArray,space); DefmoduleData(theEnv)->BNumberOfDefmodules = 0; /*================================*/ /* Deallocate the space used for */ /* the port item data structures. */ /*================================*/ space = DefmoduleData(theEnv)->NumberOfPortItems * sizeof(struct portItem); if (space != 0) genfree(theEnv,(void *) DefmoduleData(theEnv)->PortItemArray,space); DefmoduleData(theEnv)->NumberOfPortItems = 0; /*===========================*/ /* Reset module information. */ /*===========================*/ SetListOfDefmodules(theEnv,NULL); CreateMainModule(theEnv); DefmoduleData(theEnv)->MainModuleRedefinable = TRUE; }
static void ReturnDefmodule( void *theEnv, struct defmodule *theDefmodule, intBool environmentClear) { int i; struct moduleItem *theItem; struct portItem *theSpec, *nextSpec; /*=====================================================*/ /* Set the current module to the module being deleted. */ /*=====================================================*/ if (theDefmodule == NULL) return; if (! environmentClear) { EnvSetCurrentModule(theEnv,(void *) theDefmodule); } /*============================================*/ /* Call the free functions for the constructs */ /* belonging to this module. */ /*============================================*/ if (theDefmodule->itemsArray != NULL) { if (! environmentClear) { for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems; (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL); i++, theItem = theItem->next) { if (theItem->freeFunction != NULL) { (*theItem->freeFunction)(theEnv,theDefmodule->itemsArray[i]); } } } rm(theEnv,theDefmodule->itemsArray,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems); } /*======================================================*/ /* Decrement the symbol count for the defmodule's name. */ /*======================================================*/ if (! environmentClear) { DecrementSymbolCount(theEnv,theDefmodule->name); } /*====================================*/ /* Free the items in the import list. */ /*====================================*/ theSpec = theDefmodule->importList; while (theSpec != NULL) { nextSpec = theSpec->next; if (! environmentClear) { if (theSpec->moduleName != NULL) DecrementSymbolCount(theEnv,theSpec->moduleName); if (theSpec->constructType != NULL) DecrementSymbolCount(theEnv,theSpec->constructType); if (theSpec->constructName != NULL) DecrementSymbolCount(theEnv,theSpec->constructName); } rtn_struct(theEnv,portItem,theSpec); theSpec = nextSpec; } /*====================================*/ /* Free the items in the export list. */ /*====================================*/ theSpec = theDefmodule->exportList; while (theSpec != NULL) { nextSpec = theSpec->next; if (! environmentClear) { if (theSpec->moduleName != NULL) DecrementSymbolCount(theEnv,theSpec->moduleName); if (theSpec->constructType != NULL) DecrementSymbolCount(theEnv,theSpec->constructType); if (theSpec->constructName != NULL) DecrementSymbolCount(theEnv,theSpec->constructName); } rtn_struct(theEnv,portItem,theSpec); theSpec = nextSpec; } /*=========================================*/ /* Free the defmodule pretty print string. */ /*=========================================*/ if (theDefmodule->ppForm != NULL) { rm(theEnv,theDefmodule->ppForm, (int) sizeof(char) * (strlen(theDefmodule->ppForm) + 1)); } /*=======================*/ /* Return the user data. */ /*=======================*/ ClearUserDataList(theEnv,theDefmodule->usrData); /*======================================*/ /* Return the defmodule data structure. */ /*======================================*/ rtn_struct(theEnv,defmodule,theDefmodule); }
/*************************************************************** 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; } } }
static void StrOrSymCatFunction( void *theEnv, DATA_OBJECT_PTR returnValue, unsigned short returnType) { DATA_OBJECT theArg; int numArgs, i, total, j; char *theString; SYMBOL_HN **arrayOfStrings; SYMBOL_HN *hashPtr; char *functionName; /*============================================*/ /* Determine the calling function name. */ /* Store the null string or the symbol nil as */ /* the return value in the event of an error. */ /*============================================*/ SetpType(returnValue,returnType); if (returnType == STRING) { functionName = "str-cat"; SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); } else { functionName = "sym-cat"; SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"nil")); } /*===============================================*/ /* Determine the number of arguments as create a */ /* string array which is large enough to store */ /* the string representation of each argument. */ /*===============================================*/ numArgs = EnvRtnArgCount(theEnv); arrayOfStrings = (SYMBOL_HN **) gm1(theEnv,(int) sizeof(SYMBOL_HN *) * numArgs); for (i = 0; i < numArgs; i++) { arrayOfStrings[i] = NULL; } /*=============================================*/ /* Evaluate each argument and store its string */ /* representation in the string array. */ /*=============================================*/ total = 1; for (i = 1 ; i <= numArgs ; i++) { EnvRtnUnknown(theEnv,i,&theArg); switch(GetType(theArg)) { case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif case SYMBOL: hashPtr = (SYMBOL_HN *) GetValue(theArg); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; case FLOAT: hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,FloatToString(theEnv,ValueToDouble(GetValue(theArg)))); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; case INTEGER: hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,LongIntegerToString(theEnv,ValueToLong(GetValue(theArg)))); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; default: ExpectedTypeError1(theEnv,functionName,i,"string, instance name, symbol, float, or integer"); SetEvaluationError(theEnv,TRUE); break; } if (EvaluationData(theEnv)->EvaluationError) { for (i = 0; i < numArgs; i++) { if (arrayOfStrings[i] != NULL) { DecrementSymbolCount(theEnv,arrayOfStrings[i]); } } rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs); return; } total += (int) strlen(ValueToString(arrayOfStrings[i - 1])); } /*=========================================================*/ /* Allocate the memory to store the concatenated string or */ /* symbol, then copy the values in the string array to the */ /* memory just allocated. */ /*=========================================================*/ theString = (char *) gm2(theEnv,(sizeof(char) * total)); j = 0; for (i = 0 ; i < numArgs ; i++) { sprintf(&theString[j],"%s",ValueToString(arrayOfStrings[i])); j += (int) strlen(ValueToString(arrayOfStrings[i])); } /*=========================================*/ /* Return the concatenated value and clean */ /* up the temporary memory used. */ /*=========================================*/ SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,theString)); rm(theEnv,theString,sizeof(char) * total); for (i = 0; i < numArgs; i++) { if (arrayOfStrings[i] != NULL) { DecrementSymbolCount(theEnv,arrayOfStrings[i]); } } rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs); }
/*************************************************** NAME : DeallocateMarkedHandlers DESCRIPTION : Removes any handlers from a class that have been previously marked for deletion. INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Marked handlers are deleted NOTES : Assumes none of the handlers are currently executing or have a busy count != 0 for any reason ***************************************************/ globle void DeallocateMarkedHandlers( void *theEnv, EXEC_STATUS, DEFCLASS *cls) { short count; HANDLER *hnd,*nhnd; unsigned *arr,*narr; long i,j; for (i = 0 , count = 0 ; i < cls->handlerCount ; i++) { hnd = &cls->handlers[i]; if (hnd->mark == 1) { count++; DecrementSymbolCount(theEnv,execStatus,hnd->name); ExpressionDeinstall(theEnv,execStatus,hnd->actions); ReturnPackedExpression(theEnv,execStatus,hnd->actions); ClearUserDataList(theEnv,execStatus,hnd->usrData); if (hnd->ppForm != NULL) rm(theEnv,execStatus,(void *) hnd->ppForm, (sizeof(char) * (strlen(hnd->ppForm)+1))); } else /* ============================================ Use the busy field to count how many message-handlers are removed before this one ============================================ */ hnd->busy = count; } if (count == 0) return; if (count == cls->handlerCount) { rm(theEnv,execStatus,(void *) cls->handlers,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,execStatus,(void *) cls->handlerOrderMap,(sizeof(unsigned) * cls->handlerCount)); cls->handlers = NULL; cls->handlerOrderMap = NULL; cls->handlerCount = 0; } else { count = (short) (cls->handlerCount - count); hnd = cls->handlers; arr = cls->handlerOrderMap; nhnd = (HANDLER *) gm2(theEnv,execStatus,(sizeof(HANDLER) * count)); narr = (unsigned *) gm2(theEnv,execStatus,(sizeof(unsigned) * count)); for (i = 0 , j = 0 ; j < count ; i++) { if (hnd[arr[i]].mark == 0) { /* ============================================================== The offsets in the map need to be decremented by the number of preceding nodes which were deleted. Use the value of the busy field set in the first loop. ============================================================== */ narr[j] = arr[i] - hnd[arr[i]].busy; j++; } } for (i = 0 , j = 0 ; j < count ; i++) { if (hnd[i].mark == 0) { hnd[i].busy = 0; GenCopyMemory(HANDLER,1,&nhnd[j],&hnd[i]); j++; } } rm(theEnv,execStatus,(void *) hnd,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,execStatus,(void *) arr,(sizeof(unsigned) * cls->handlerCount)); cls->handlers = nhnd; cls->handlerOrderMap = narr; cls->handlerCount = count; } }
globle void ReturnDefrule( void *theEnv, void *vWaste) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,vWaste) #endif #if (! RUN_TIME) && (! BLOAD_ONLY) struct defrule *waste = (struct defrule *) vWaste; int first = TRUE; struct defrule *nextPtr; if (waste == NULL) return; /*======================================*/ /* If a rule is redefined, then we want */ /* to save its breakpoint status. */ /*======================================*/ #if DEBUGGING_FUNCTIONS DefruleData(theEnv)->DeletedRuleDebugFlags = 0; if (waste->afterBreakpoint) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,0); if (waste->watchActivation) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,1); if (waste->watchFiring) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,2); #endif /*================================*/ /* Clear the agenda of all the */ /* activations added by the rule. */ /*================================*/ ClearRuleFromAgenda(theEnv,waste); /*======================*/ /* Get rid of the rule. */ /*======================*/ while (waste != NULL) { /*================================================*/ /* Remove the rule's joins from the join network. */ /*================================================*/ DetachJoins(theEnv,waste,FALSE); /*=============================================*/ /* If this is the first disjunct, get rid of */ /* the dynamic salience and pretty print form. */ /*=============================================*/ if (first) { #if DYNAMIC_SALIENCE if (waste->dynamicSalience != NULL) { ExpressionDeinstall(theEnv,waste->dynamicSalience); ReturnPackedExpression(theEnv,waste->dynamicSalience); waste->dynamicSalience = NULL; } #endif if (waste->header.ppForm != NULL) { rm(theEnv,waste->header.ppForm,strlen(waste->header.ppForm) + 1); waste->header.ppForm = NULL; } first = FALSE; } /*===========================*/ /* Get rid of any user data. */ /*===========================*/ if (waste->header.usrData != NULL) { ClearUserDataList(theEnv,waste->header.usrData); } /*===========================================*/ /* Decrement the count for the defrule name. */ /*===========================================*/ DecrementSymbolCount(theEnv,waste->header.name); /*========================================*/ /* Get rid of the the rule's RHS actions. */ /*========================================*/ if (waste->actions != NULL) { ExpressionDeinstall(theEnv,waste->actions); ReturnPackedExpression(theEnv,waste->actions); } /*===============================*/ /* Move on to the next disjunct. */ /*===============================*/ nextPtr = waste->disjunct; rtn_struct(theEnv,defrule,waste); waste = nextPtr; } /*==========================*/ /* Free up partial matches. */ /*==========================*/ if (EngineData(theEnv)->ExecutingRule == NULL) FlushGarbagePartialMatches(theEnv); #endif }
globle int LoadConstructsFromLogicalName( void *theEnv, char *readSource) { int constructFlag; struct token theToken; int noErrors = TRUE; int foundConstruct; /*=========================================*/ /* Reset the halt execution and evaluation */ /* error flags in preparation for parsing. */ /*=========================================*/ if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); /*========================================================*/ /* Find the beginning of the first construct in the file. */ /*========================================================*/ EvaluationData(theEnv)->CurrentEvaluationDepth++; GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors); /*==================================================*/ /* Parse the file until the end of file is reached. */ /*==================================================*/ while ((foundConstruct == TRUE) && (GetHaltExecution(theEnv) == FALSE)) { /*===========================================================*/ /* Clear the pretty print buffer in preparation for parsing. */ /*===========================================================*/ FlushPPBuffer(theEnv); /*======================*/ /* Parse the construct. */ /*======================*/ constructFlag = ParseConstruct(theEnv,ValueToString(theToken.value),readSource); /*==============================================================*/ /* If an error occurred while parsing, then find the beginning */ /* of the next construct (but don't generate any more error */ /* messages--in effect, skip everything until another construct */ /* is found). */ /*==============================================================*/ if (constructFlag == 1) { EnvPrintRouter(theEnv,WERROR,"\nERROR:\n"); PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv)); EnvPrintRouter(theEnv,WERROR,"\n"); noErrors = FALSE; GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,TRUE,&noErrors); } /*======================================================*/ /* Otherwise, find the beginning of the next construct. */ /*======================================================*/ else { GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors); } /*=====================================================*/ /* Yield time if necessary to foreground applications. */ /*=====================================================*/ if (foundConstruct) { IncrementSymbolCount(theToken.value); } EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); YieldTime(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth++; if (foundConstruct) { DecrementSymbolCount(theEnv,(SYMBOL_HN *) theToken.value); } } EvaluationData(theEnv)->CurrentEvaluationDepth--; /*========================================================*/ /* Print a carriage return if a single character is being */ /* printed to indicate constructs are being processed. */ /*========================================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") != TRUE) && GetPrintWhileLoading(theEnv)) #else if (GetPrintWhileLoading(theEnv)) #endif { EnvPrintRouter(theEnv,WDIALOG,"\n"); } /*=============================================================*/ /* Once the load is complete, destroy the pretty print buffer. */ /* This frees up any memory that was used to create the pretty */ /* print forms for constructs during parsing. Thus calls to */ /* the mem-used function will accurately reflect the amount of */ /* memory being used after a load command. */ /*=============================================================*/ DestroyPPBuffer(theEnv); /*==========================================================*/ /* Return a boolean flag which indicates whether any errors */ /* were encountered while loading the constructs. */ /*==========================================================*/ return(noErrors); }
/************************************************************************** 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 ReturnDefrule( void *theEnv, void *vWaste) { #if (! RUN_TIME) && (! BLOAD_ONLY) struct defrule *waste = (struct defrule *) vWaste; int first = TRUE; struct defrule *nextPtr, *tmpPtr; if (waste == NULL) return; /*======================================*/ /* If a rule is redefined, then we want */ /* to save its breakpoint status. */ /*======================================*/ #if DEBUGGING_FUNCTIONS DefruleData(theEnv)->DeletedRuleDebugFlags = 0; if (waste->afterBreakpoint) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,0); if (waste->watchActivation) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,1); if (waste->watchFiring) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,2); #endif /*================================*/ /* Clear the agenda of all the */ /* activations added by the rule. */ /*================================*/ ClearRuleFromAgenda(theEnv,waste); /*======================*/ /* Get rid of the rule. */ /*======================*/ while (waste != NULL) { /*================================================*/ /* Remove the rule's joins from the join network. */ /*================================================*/ DetachJoinsDriver(theEnv,waste,FALSE); /*=============================================*/ /* If this is the first disjunct, get rid of */ /* the dynamic salience and pretty print form. */ /*=============================================*/ if (first) { if (waste->dynamicSalience != NULL) { ExpressionDeinstall(theEnv,waste->dynamicSalience); ReturnPackedExpression(theEnv,waste->dynamicSalience); waste->dynamicSalience = NULL; } #if CERTAINTY_FACTORS /* changed 03-12-96 */ if (waste->dynamicCF != NULL) { ExpressionDeinstall(theEnv,waste->dynamicCF); ReturnPackedExpression(theEnv,waste->dynamicCF); waste->dynamicCF = NULL; } #endif if (waste->header.ppForm != NULL) { rm(theEnv,(void *) waste->header.ppForm,strlen(waste->header.ppForm) + 1); waste->header.ppForm = NULL; /*=======================================================*/ /* All of the rule disjuncts share the same pretty print */ /* form, so we want to avoid deleting it again. */ /*=======================================================*/ for (tmpPtr = waste->disjunct; tmpPtr != NULL; tmpPtr = tmpPtr->disjunct) { tmpPtr->header.ppForm = NULL; } } first = FALSE; } /*===========================*/ /* Get rid of any user data. */ /*===========================*/ if (waste->header.usrData != NULL) { ClearUserDataList(theEnv,waste->header.usrData); } /*===========================================*/ /* Decrement the count for the defrule name. */ /*===========================================*/ DecrementSymbolCount(theEnv,waste->header.name); /*========================================*/ /* Get rid of the the rule's RHS actions. */ /*========================================*/ if (waste->actions != NULL) { ExpressionDeinstall(theEnv,waste->actions); ReturnPackedExpression(theEnv,waste->actions); } /*===============================*/ /* Move on to the next disjunct. */ /*===============================*/ nextPtr = waste->disjunct; #if FUZZY_DEFTEMPLATES if (waste != EngineData(theEnv)->ExecutingRule) { if (waste->numberOfFuzzySlots > 0) rm(theEnv,waste->pattern_fv_arrayPtr, sizeof(struct fzSlotLocator) * waste->numberOfFuzzySlots); } #endif rtn_struct(theEnv,defrule,waste); waste = nextPtr; } /*==========================*/ /* Free up partial matches. */ /*==========================*/ if (EngineData(theEnv)->ExecutingRule == NULL) FlushGarbagePartialMatches(theEnv); #endif }
/******************************************************* NAME : UnmarkConstructHeader DESCRIPTION : Releases any ephemerals (symbols, etc.) of a construct header for removal INPUTS : The construct header RETURNS : Nothing useful SIDE EFFECTS : Busy counts fo ephemerals decremented NOTES : None *******************************************************/ globle void UnmarkConstructHeader( struct constructHeader *theConstruct) { DecrementSymbolCount(theConstruct->name); }