/*************************************************** NAME : DeleteMethodInfo DESCRIPTION : Deallocates all the data associated w/ a method but does not release the method structure itself INPUTS : 1) The generic function address 2) The method address RETURNS : Nothing useful SIDE EFFECTS : Nodes deallocated NOTES : None ***************************************************/ globle void DeleteMethodInfo( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *meth) { short j,k; RESTRICTION *rptr; SaveBusyCount(gfunc); ExpressionDeinstall(theEnv,meth->actions); ReturnPackedExpression(theEnv,meth->actions); ClearUserDataList(theEnv,meth->usrData); if (meth->ppForm != NULL) rm(theEnv,(void *) meth->ppForm,(sizeof(char) * (strlen(meth->ppForm)+1))); for (j = 0 ; j < meth->restrictionCount ; j++) { rptr = &meth->restrictions[j]; for (k = 0 ; k < rptr->tcnt ; k++) #if OBJECT_SYSTEM DecrementDefclassBusyCount(theEnv,rptr->types[k]); #else DecrementIntegerCount(theEnv,(INTEGER_HN *) rptr->types[k]); #endif if (rptr->types != NULL) rm(theEnv,(void *) rptr->types,(sizeof(void *) * rptr->tcnt)); ExpressionDeinstall(theEnv,rptr->query); ReturnPackedExpression(theEnv,rptr->query); } if (meth->restrictions != NULL) rm(theEnv,(void *) meth->restrictions, (sizeof(RESTRICTION) * meth->restrictionCount)); RestoreBusyCount(gfunc); }
/*************************************************** 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 ***************************************************/ void DeleteSlots( Environment *theEnv, TEMP_SLOT_LINK *slots) { TEMP_SLOT_LINK *stmp; while (slots != NULL) { stmp = slots; slots = slots->nxt; DeleteSlotName(theEnv,stmp->desc->slotName); ReleaseLexeme(theEnv,stmp->desc->overrideMessage); RemoveConstraint(theEnv,stmp->desc->constraint); if (stmp->desc->dynamicDefault == 1) { ExpressionDeinstall(theEnv,(Expression *) stmp->desc->defaultValue); ReturnPackedExpression(theEnv,(Expression *) stmp->desc->defaultValue); } else if (stmp->desc->defaultValue != NULL) { ReleaseUDFV(theEnv,(UDFValue *) stmp->desc->defaultValue); rtn_struct(theEnv,udfValue,stmp->desc->defaultValue); } rtn_struct(theEnv,slotDescriptor,stmp->desc); rtn_struct(theEnv,tempSlotLink,stmp); } }
/*************************************************** 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 : RemoveAllDeffunctions DESCRIPTION : Removes all deffunctions INPUTS : None RETURNS : TRUE if all deffunctions removed, FALSE otherwise SIDE EFFECTS : Deffunctions removed NOTES : None ***************************************************/ static intBool RemoveAllDeffunctions( void *theEnv, EXEC_STATUS) { DEFFUNCTION *dptr,*dtmp; unsigned oldbusy; intBool success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv,execStatus) == TRUE) return(FALSE); #endif dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL); while (dptr != NULL) { if (dptr->executing > 0) { DeffunctionDeleteError(theEnv,execStatus,EnvGetDeffunctionName(theEnv,execStatus,(void *) dptr)); success = FALSE; } else { oldbusy = dptr->busy; ExpressionDeinstall(theEnv,execStatus,dptr->code); dptr->busy = oldbusy; ReturnPackedExpression(theEnv,execStatus,dptr->code); dptr->code = NULL; } dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr); } dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL); while (dptr != NULL) { dtmp = dptr; dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr); if (dtmp->executing == 0) { if (dtmp->busy > 0) { PrintWarningID(theEnv,execStatus,"DFFNXFUN",1,FALSE); EnvPrintRouter(theEnv,execStatus,WWARNING,"Deffunction "); EnvPrintRouter(theEnv,execStatus,WWARNING,EnvGetDeffunctionName(theEnv,execStatus,(void *) dtmp)); EnvPrintRouter(theEnv,execStatus,WWARNING," only partially deleted due to usage by other constructs.\n"); SetDeffunctionPPForm((void *) dtmp,NULL); success = FALSE; } else { RemoveConstructFromModule(theEnv,execStatus,(struct constructHeader *) dtmp); RemoveDeffunction(theEnv,execStatus,dtmp); } } } return(success); }
globle void ExpressionDeinstall( struct expr *expression) { if (expression == NULL) return; while (expression != NULL) { AtomDeinstall(expression->type,expression->value); ExpressionDeinstall(expression->argList); expression = expression->nextArg; } }
static void DeinstallConstraintRecord( Environment *theEnv, CONSTRAINT_RECORD *constraints) { if (constraints->installed) { RemoveHashedExpression(theEnv,constraints->classList); RemoveHashedExpression(theEnv,constraints->restrictionList); RemoveHashedExpression(theEnv,constraints->maxValue); RemoveHashedExpression(theEnv,constraints->minValue); RemoveHashedExpression(theEnv,constraints->minFields); RemoveHashedExpression(theEnv,constraints->maxFields); } else { ExpressionDeinstall(theEnv,constraints->classList); ExpressionDeinstall(theEnv,constraints->restrictionList); ExpressionDeinstall(theEnv,constraints->maxValue); ExpressionDeinstall(theEnv,constraints->minValue); ExpressionDeinstall(theEnv,constraints->minFields); ExpressionDeinstall(theEnv,constraints->maxFields); } if (constraints->multifield != NULL) { DeinstallConstraintRecord(theEnv,constraints->multifield); } }
/************************************************************** 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); }
/*************************************************** 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); }
static void ReturnDeffacts( Environment *theEnv, Deffacts *theDeffacts) { #if (! BLOAD_ONLY) && (! RUN_TIME) if (theDeffacts == NULL) return; ExpressionDeinstall(theEnv,theDeffacts->assertList); ReturnPackedExpression(theEnv,theDeffacts->assertList); DeinstallConstructHeader(theEnv,&theDeffacts->header); rtn_struct(theEnv,deffacts,theDeffacts); #endif }
/*************************************************** NAME : RemoveHashedExpression DESCRIPTION : Removes a hashed expression from the hash table INPUTS : The expression RETURNS : Nothing useful SIDE EFFECTS : Hash node removed (or use count decremented). If the hash node is removed, the expression is deinstalled and deleted NOTES : If the expression is in use by others, then the use count is merely decremented ***************************************************/ globle void RemoveHashedExpression( EXPRESSION *exp) { EXPRESSION_HN *exphash,*prv; unsigned hashval; exphash = FindHashedExpression(exp,&hashval,&prv); if (exphash == NULL) return; if (--exphash->count != 0) return; if (prv == NULL) ExpressionHashTable[hashval] = exphash->nxt; else prv->nxt = exphash->nxt; ExpressionDeinstall(exphash->exp); ReturnPackedExpression(exphash->exp); rtn_struct(exprHashNode,exphash); }
static void ReturnDeffacts( void *theEnv, void *vTheDeffacts) { #if (MAC_MCW || WIN_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,vTheDeffacts) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct deffacts *theDeffacts = (struct deffacts *) vTheDeffacts; if (theDeffacts == NULL) return; ExpressionDeinstall(theEnv,theDeffacts->assertList); ReturnPackedExpression(theEnv,theDeffacts->assertList); DeinstallConstructHeader(theEnv,&theDeffacts->header); rtn_struct(theEnv,deffacts,theDeffacts); #endif }
static int DefaultCompareSwapFunction( void *theEnv, DATA_OBJECT *item1, DATA_OBJECT *item2) { DATA_OBJECT returnValue; SortFunctionData(theEnv)->SortComparisonFunction->argList = GenConstant(theEnv,item1->type,item1->value); SortFunctionData(theEnv)->SortComparisonFunction->argList->nextArg = GenConstant(theEnv,item2->type,item2->value); ExpressionInstall(theEnv,SortFunctionData(theEnv)->SortComparisonFunction); EvaluateExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction,&returnValue); ExpressionDeinstall(theEnv,SortFunctionData(theEnv)->SortComparisonFunction); ReturnExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction->argList); SortFunctionData(theEnv)->SortComparisonFunction->argList = NULL; if ((GetType(returnValue) == SYMBOL) && (GetValue(returnValue) == EnvFalseSymbol(theEnv))) { return(FALSE); } return(TRUE); }
bool RouteCommand( void *theEnv, const char *command, bool printResult) { DATA_OBJECT result; struct expr *top; const char *commandName; struct token theToken; int danglingConstructs; if (command == NULL) { return(0); } /*========================================*/ /* Open a string input source and get the */ /* first token from that source. */ /*========================================*/ OpenStringSource(theEnv,"command",command,0); GetToken(theEnv,"command",&theToken); /*=====================*/ /* Evaluate constants. */ /*=====================*/ if ((theToken.type == SYMBOL) || (theToken.type == STRING) || (theToken.type == FLOAT) || (theToken.type == INTEGER) || (theToken.type == INSTANCE_NAME)) { CloseStringSource(theEnv,"command"); if (printResult) { PrintAtom(theEnv,STDOUT,theToken.type,theToken.value); EnvPrintRouter(theEnv,STDOUT,"\n"); } return(1); } /*=====================*/ /* Evaluate variables. */ /*=====================*/ if ((theToken.type == GBL_VARIABLE) || (theToken.type == SF_VARIABLE) || (theToken.type == MF_VARIABLE)) { CloseStringSource(theEnv,"command"); top = GenConstant(theEnv,theToken.type,theToken.value); EvaluateExpression(theEnv,top,&result); rtn_struct(theEnv,expr,top); if (printResult) { PrintDataObject(theEnv,STDOUT,&result); EnvPrintRouter(theEnv,STDOUT,"\n"); } return(1); } /*========================================================*/ /* If the next token isn't the beginning left parenthesis */ /* of a command or construct, then whatever was entered */ /* cannot be evaluated at the command prompt. */ /*========================================================*/ if (theToken.type != LPAREN) { PrintErrorID(theEnv,"COMMLINE",1,false); EnvPrintRouter(theEnv,WERROR,"Expected a '(', constant, or variable\n"); CloseStringSource(theEnv,"command"); return(0); } /*===========================================================*/ /* The next token must be a function name or construct type. */ /*===========================================================*/ GetToken(theEnv,"command",&theToken); if (theToken.type != SYMBOL) { PrintErrorID(theEnv,"COMMLINE",2,false); EnvPrintRouter(theEnv,WERROR,"Expected a command.\n"); CloseStringSource(theEnv,"command"); return(0); } commandName = ValueToString(theToken.value); /*======================*/ /* Evaluate constructs. */ /*======================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) { int errorFlag; errorFlag = ParseConstruct(theEnv,commandName,"command"); if (errorFlag != -1) { CloseStringSource(theEnv,"command"); if (errorFlag == 1) { EnvPrintRouter(theEnv,WERROR,"\nERROR:\n"); PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv)); EnvPrintRouter(theEnv,WERROR,"\n"); } DestroyPPBuffer(theEnv); if (errorFlag) return 0; else return 1; } } #endif /*========================*/ /* Parse a function call. */ /*========================*/ danglingConstructs = ConstructData(theEnv)->DanglingConstructs; CommandLineData(theEnv)->ParsingTopLevelCommand = true; top = Function2Parse(theEnv,"command",commandName); CommandLineData(theEnv)->ParsingTopLevelCommand = false; ClearParsedBindNames(theEnv); /*================================*/ /* Close the string input source. */ /*================================*/ CloseStringSource(theEnv,"command"); /*=========================*/ /* Evaluate function call. */ /*=========================*/ if (top == NULL) { ConstructData(theEnv)->DanglingConstructs = danglingConstructs; return false; } ExpressionInstall(theEnv,top); CommandLineData(theEnv)->EvaluatingTopLevelCommand = true; CommandLineData(theEnv)->CurrentCommand = top; EvaluateExpression(theEnv,top,&result); CommandLineData(theEnv)->CurrentCommand = NULL; CommandLineData(theEnv)->EvaluatingTopLevelCommand = false; ExpressionDeinstall(theEnv,top); ReturnExpression(theEnv,top); ConstructData(theEnv)->DanglingConstructs = danglingConstructs; /*=================================================*/ /* Print the return value of the function/command. */ /*=================================================*/ if ((result.type != RVOID) && printResult) { PrintDataObject(theEnv,STDOUT,&result); EnvPrintRouter(theEnv,STDOUT,"\n"); } return true; }
globle int EnvEval( void *theEnv, char *theString, DATA_OBJECT_PTR returnValue) { struct expr *top; int ov; static int depth = 0; char logicalNameBuffer[20]; struct BindInfo *oldBinds; /*======================================================*/ /* Evaluate the string. Create a different logical name */ /* for use each time the eval function is called. */ /*======================================================*/ depth++; sprintf(logicalNameBuffer,"Eval-%d",depth); if (OpenStringSource(theEnv,logicalNameBuffer,theString,0) == 0) { SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); depth--; return(FALSE); } /*================================================*/ /* Save the current parsing state before routines */ /* are called to parse the eval string. */ /*================================================*/ ov = GetPPBufferStatus(theEnv); SetPPBufferStatus(theEnv,FALSE); oldBinds = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); /*========================================================*/ /* Parse the string argument passed to the eval function. */ /*========================================================*/ top = ParseAtomOrExpression(theEnv,logicalNameBuffer,NULL); /*============================*/ /* Restore the parsing state. */ /*============================*/ SetPPBufferStatus(theEnv,ov); ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBinds); /*===========================================*/ /* Return if an error occured while parsing. */ /*===========================================*/ if (top == NULL) { SetEvaluationError(theEnv,TRUE); CloseStringSource(theEnv,logicalNameBuffer); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); depth--; return(FALSE); } /*==============================================*/ /* The sequence expansion operator must be used */ /* within the argument list of a function call. */ /*==============================================*/ if ((top->type == MF_GBL_VARIABLE) || (top->type == MF_VARIABLE)) { PrintErrorID(theEnv,"MISCFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"expand$ must be used in the argument list of a function call.\n"); SetEvaluationError(theEnv,TRUE); CloseStringSource(theEnv,logicalNameBuffer); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); ReturnExpression(theEnv,top); depth--; return(FALSE); } /*=======================================*/ /* The expression to be evaluated cannot */ /* contain any local variables. */ /*=======================================*/ if (ExpressionContainsVariables(top,FALSE)) { PrintErrorID(theEnv,"STRNGFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Some variables could not be accessed by the eval function.\n"); SetEvaluationError(theEnv,TRUE); CloseStringSource(theEnv,logicalNameBuffer); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); ReturnExpression(theEnv,top); depth--; return(FALSE); } /*====================================*/ /* Evaluate the expression and return */ /* the memory used to parse it. */ /*====================================*/ ExpressionInstall(theEnv,top); EvaluateExpression(theEnv,top,returnValue); ExpressionDeinstall(theEnv,top); depth--; ReturnExpression(theEnv,top); CloseStringSource(theEnv,logicalNameBuffer); if (GetEvaluationError(theEnv)) return(FALSE); return(TRUE); }
/*************************************************** 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 struct fact *StringToFact( void *theEnv, char *str) { struct token theToken; struct fact *factPtr; unsigned numberOfFields = 0, whichField; struct expr *assertArgs, *tempPtr; int error = FALSE; DATA_OBJECT theResult; /*=========================================*/ /* Open a string router and parse the fact */ /* using the router as an input source. */ /*=========================================*/ SetEvaluationError(theEnv,FALSE); OpenStringSource(theEnv,"assert_str",str,0); assertArgs = GetRHSPattern(theEnv,"assert_str",&theToken, &error,FALSE,TRUE, TRUE,RPAREN); CloseStringSource(theEnv,"assert_str"); /*===========================================*/ /* Check for errors or the use of variables. */ /*===========================================*/ if ((assertArgs == NULL) && (! error)) { SyntaxErrorMessage(theEnv,"RHS patterns"); ReturnExpression(theEnv,assertArgs); return(NULL); } if (error) { ReturnExpression(theEnv,assertArgs); return(NULL); } if (ExpressionContainsVariables(assertArgs,FALSE)) { LocalVariableErrorMessage(theEnv,"the assert-string function"); SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,assertArgs); return(NULL); } /*=======================================================*/ /* Count the number of fields needed for the fact and */ /* create a fact data structure of the appropriate size. */ /*=======================================================*/ for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg) { numberOfFields++; } factPtr = (struct fact *) CreateFactBySize(theEnv,numberOfFields); factPtr->whichDeftemplate = (struct deftemplate *) assertArgs->value; /*=============================================*/ /* Copy the fields to the fact data structure. */ /*=============================================*/ ExpressionInstall(theEnv,assertArgs); /* DR0836 */ whichField = 0; for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg) { EvaluateExpression(theEnv,tempPtr,&theResult); factPtr->theProposition.theFields[whichField].type = theResult.type; factPtr->theProposition.theFields[whichField].value = theResult.value; whichField++; } ExpressionDeinstall(theEnv,assertArgs); /* DR0836 */ ReturnExpression(theEnv,assertArgs); /*==================*/ /* Return the fact. */ /*==================*/ return(factPtr); }
/*********************************************************************** NAME : ParseDefmessageHandler DESCRIPTION : Parses a message-handler for a class of objects INPUTS : The logical name of the input source RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Handler allocated and inserted into class NOTES : H/L Syntax: (defmessage-handler <class> <name> [<type>] [<comment>] (<params>) <action>*) <params> ::= <var>* | <var>* $?<name> ***********************************************************************/ globle int ParseDefmessageHandler( void *theEnv, char *readSource) { DEFCLASS *cls; SYMBOL_HN *cname,*mname,*wildcard; unsigned mtype = MPRIMARY; int min,max,error,lvars; EXPRESSION *hndParams,*actions; HANDLER *hnd; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defmessage-handler "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defmessage-handler"); return(TRUE); } #endif cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler", NULL,NULL,"~",TRUE,FALSE,DEFMODULE_CONSTRUCT); if (cname == NULL) return(TRUE); cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname)); if (cls == NULL) { PrintErrorID(theEnv,"MSGPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n"); return(TRUE); } if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])) { PrintErrorID(theEnv,"MSGPSR",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls)); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } if (HandlersExecuting(cls)) { PrintErrorID(theEnv,"MSGPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n"); EnvPrintRouter(theEnv,WERROR," other message-handlers for the same class.\n"); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv," "); mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SavePPBuffer(theEnv," "); if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken)); if (mtype == MERROR) return(TRUE); #if ! IMPERATIVE_MESSAGE_HANDLERS if (mtype == MAROUND) return(TRUE); #endif GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING) { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } else { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } PPBackup(theEnv); PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); hnd = FindHandlerByAddress(cls,mname,mtype); if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv)) { EnvPrintRouter(theEnv,WDIALOG," Handler "); EnvPrintRouter(theEnv,WDIALOG,ValueToString(mname)); EnvPrintRouter(theEnv,WDIALOG," "); EnvPrintRouter(theEnv,WDIALOG,MessageHandlerData(theEnv)->hndquals[mtype]); EnvPrintRouter(theEnv,WDIALOG,(char *) ((hnd == NULL) ? " defined.\n" : " redefined.\n")); } if ((hnd != NULL) ? hnd->system : FALSE) { PrintErrorID(theEnv,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n"); return(TRUE); } hndParams = GenConstant(theEnv,SYMBOL,(void *) MessageHandlerData(theEnv)->SELF_SYMBOL); hndParams = ParseProcParameters(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,hndParams, &wildcard,&min,&max,&error,IsParameterSlotReference); if (error) return(TRUE); PPCRAndIndent(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"message-handler",readSource, &DefclassData(theEnv)->ObjectParseToken,hndParams,wildcard, SlotReferenceVar,BindSlotReference,&lvars, (void *) cls); if (actions == NULL) { ReturnExpression(theEnv,hndParams); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,"defmessage-handler"); ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv,"\n"); /* =================================================== If we're only checking syntax, don't add the successfully parsed defmessage-handler to the KB. =================================================== */ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(FALSE); } if (hnd != NULL) { ExpressionDeinstall(theEnv,hnd->actions); ReturnPackedExpression(theEnv,hnd->actions); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm, (sizeof(char) * (strlen(hnd->ppForm)+1))); } else { hnd = InsertHandlerHeader(theEnv,cls,mname,(int) mtype); IncrementSymbolCount(hnd->name); } ReturnExpression(theEnv,hndParams); hnd->minParams = min; hnd->maxParams = max; hnd->localVarCount = lvars; hnd->actions = actions; ExpressionInstall(theEnv,hnd->actions); #if DEBUGGING_FUNCTIONS /* =================================================== Old handler trace status is automatically preserved =================================================== */ if (EnvGetConserveMemory(theEnv) == FALSE) hnd->ppForm = CopyPPBuffer(theEnv); else #endif hnd->ppForm = NULL; return(FALSE); }
globle void FuncallFunction( void *theEnv, DATA_OBJECT *returnValue) { int argCount, i, j; DATA_OBJECT theValue; FUNCTION_REFERENCE theReference; char *name; struct multifield *theMultifield; struct expr *lastAdd = NULL, *nextAdd, *multiAdd; /*==================================*/ /* Set up the default return value. */ /*==================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*=================================================*/ /* The funcall function has at least one argument: */ /* the name of the function being called. */ /*=================================================*/ if ((argCount = EnvArgCountCheck(theEnv,"funcall",AT_LEAST,1)) == -1) return; /*============================================*/ /* Get the name of the function to be called. */ /*============================================*/ if (EnvArgTypeCheck(theEnv,"funcall",1,SYMBOL_OR_STRING,&theValue) == FALSE) { return; } /*====================*/ /* Find the function. */ /*====================*/ name = DOToString(theValue); if (! GetFunctionReference(theEnv,name,&theReference)) { ExpectedTypeError1(theEnv,"funcall",1,"function, deffunction, or generic function name"); return; } ExpressionInstall(theEnv,&theReference); /*======================================*/ /* Add the arguments to the expression. */ /*======================================*/ for (i = 2; i <= argCount; i++) { EnvRtnUnknown(theEnv,i,&theValue); if (GetEvaluationError(theEnv)) { ExpressionDeinstall(theEnv,&theReference); return; } switch(GetType(theValue)) { case MULTIFIELD: nextAdd = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$")); if (lastAdd == NULL) { theReference.argList = nextAdd; } else { lastAdd->nextArg = nextAdd; } lastAdd = nextAdd; multiAdd = NULL; theMultifield = (struct multifield *) GetValue(theValue); for (j = GetDOBegin(theValue); j <= GetDOEnd(theValue); j++) { nextAdd = GenConstant(theEnv,GetMFType(theMultifield,j),GetMFValue(theMultifield,j)); if (multiAdd == NULL) { lastAdd->argList = nextAdd; } else { multiAdd->nextArg = nextAdd; } multiAdd = nextAdd; } ExpressionInstall(theEnv,lastAdd); break; default: nextAdd = GenConstant(theEnv,GetType(theValue),GetValue(theValue)); if (lastAdd == NULL) { theReference.argList = nextAdd; } else { lastAdd->nextArg = nextAdd; } lastAdd = nextAdd; ExpressionInstall(theEnv,lastAdd); break; } } /*===========================================================*/ /* Verify a deffunction has the correct number of arguments. */ /*===========================================================*/ #if DEFFUNCTION_CONSTRUCT if (theReference.type == PCALL) { if (CheckDeffunctionCall(theEnv,theReference.value,CountArguments(theReference.argList)) == FALSE) { PrintErrorID(theEnv,"MISCFUN",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Function funcall called with the wrong number of arguments for deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,theReference.value)); EnvPrintRouter(theEnv,WERROR,"\n"); ExpressionDeinstall(theEnv,&theReference); ReturnExpression(theEnv,theReference.argList); return; } } #endif /*======================*/ /* Call the expression. */ /*======================*/ EvaluateExpression(theEnv,&theReference,returnValue); /*========================================*/ /* Return the expression data structures. */ /*========================================*/ ExpressionDeinstall(theEnv,&theReference); ReturnExpression(theEnv,theReference.argList); }
/**************************************************** NAME : AddDeffunction DESCRIPTION : Adds a deffunction to the list of deffunctions INPUTS : 1) The symbolic name 2) The action expressions 3) The minimum number of arguments 4) The maximum number of arguments (can be -1) 5) The number of local variables 6) A flag indicating if this is a header call so that the deffunction can be recursively called RETURNS : The new deffunction (NULL on errors) SIDE EFFECTS : Deffunction structures allocated NOTES : Assumes deffunction is not executing ****************************************************/ static DEFFUNCTION *AddDeffunction( void *theEnv, SYMBOL_HN *name, EXPRESSION *actions, int min, int max, int lvars, int headerp) { DEFFUNCTION *dfuncPtr; unsigned oldbusy; #if DEBUGGING_FUNCTIONS unsigned DFHadWatch = FALSE; #endif /*===============================================================*/ /* If the deffunction doesn't exist, create a new structure to */ /* contain it and add it to the List of deffunctions. Otherwise, */ /* use the existing structure and remove the pretty print form */ /* and interpretive code. */ /*===============================================================*/ dfuncPtr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(name)); if (dfuncPtr == NULL) { dfuncPtr = get_struct(theEnv,deffunctionStruct); InitializeConstructHeader(theEnv,"deffunction",(struct constructHeader *) dfuncPtr,name); IncrementSymbolCount(name); dfuncPtr->code = NULL; dfuncPtr->minNumberOfParameters = min; dfuncPtr->maxNumberOfParameters = max; dfuncPtr->numberOfLocalVars = lvars; dfuncPtr->busy = 0; dfuncPtr->executing = 0; } else { #if DEBUGGING_FUNCTIONS DFHadWatch = EnvGetDeffunctionWatch(theEnv,(void *) dfuncPtr); #endif dfuncPtr->minNumberOfParameters = min; dfuncPtr->maxNumberOfParameters = max; dfuncPtr->numberOfLocalVars = lvars; oldbusy = dfuncPtr->busy; ExpressionDeinstall(theEnv,dfuncPtr->code); dfuncPtr->busy = oldbusy; ReturnPackedExpression(theEnv,dfuncPtr->code); dfuncPtr->code = NULL; SetDeffunctionPPForm((void *) dfuncPtr,NULL); /* ======================================= Remove the deffunction from the list so that it can be added at the end ======================================= */ RemoveConstructFromModule(theEnv,(struct constructHeader *) dfuncPtr); } AddConstructToModule((struct constructHeader *) dfuncPtr); /* ================================== Install the new interpretive code. ================================== */ if (actions != NULL) { /* =============================== If a deffunction is recursive, do not increment its busy count based on self-references =============================== */ oldbusy = dfuncPtr->busy; ExpressionInstall(theEnv,actions); dfuncPtr->busy = oldbusy; dfuncPtr->code = actions; } /* =============================================================== Install the pretty print form if memory is not being conserved. =============================================================== */ #if DEBUGGING_FUNCTIONS EnvSetDeffunctionWatch(theEnv,DFHadWatch ? TRUE : DeffunctionData(theEnv)->WatchDeffunctions,(void *) dfuncPtr); if ((EnvGetConserveMemory(theEnv) == FALSE) && (headerp == FALSE)) SetDeffunctionPPForm((void *) dfuncPtr,CopyPPBuffer(theEnv)); #endif return(dfuncPtr); }
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 struct fact *StringToFact( char *str) { struct token theToken; struct fact *factPtr; int numberOfFields = 0, whichField; struct expr *assertArgs, *tempPtr; int error = FALSE; DATA_OBJECT theResult; /*=========================================*/ /* Open a string router and parse the fact */ /* using the router as an input source. */ /*=========================================*/ OpenStringSource("assert_str",str,0); assertArgs = GetRHSPattern("assert_str",&theToken, &error,FALSE,TRUE, TRUE,RPAREN); CloseStringSource("assert_str"); #if CERTAINTY_FACTORS /* GetRHSPattern called above may have left a token in the lookahead Token (theUnToken) -- see GetRHSPattern and Scanner.c -- clear it since we are closing the string source and it should not be read when next token requested NOTE: this may not be needed now that am not unGetting STOP tokens? */ ClearTheUnToken(); #endif /*===========================================*/ /* Check for errors or the use of variables. */ /*===========================================*/ if (error) { ReturnExpression(assertArgs); return(NULL); } if (ExpressionContainsVariables(assertArgs,FALSE)) { LocalVariableErrorMessage("the assert-string function"); SetEvaluationError(TRUE); ReturnExpression(assertArgs); return(NULL); } /*=======================================================*/ /* Count the number of fields needed for the fact and */ /* create a fact data structure of the appropriate size. */ /*=======================================================*/ for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg) { numberOfFields++; } factPtr = (struct fact *) CreateFactBySize(numberOfFields); factPtr->whichDeftemplate = (struct deftemplate *) assertArgs->value; #if CERTAINTY_FACTORS /* get the CF from the argList of the DEFTEMPLATE_PTR expr struct currently pointed at be assertArgs */ if (assertArgs->argList == NULL) factPtr->factCF = 1.0; else { EvaluateExpression(assertArgs->argList,&theResult); if (theResult.type != FLOAT && theResult.type != INTEGER) { cfNonNumberError(); factPtr->factCF = 1.0; } else factPtr->factCF = (theResult.type == FLOAT) ? ValueToDouble(theResult.value) : (double)ValueToLong(theResult.value); } #endif /*=============================================*/ /* Copy the fields to the fact data structure. */ /*=============================================*/ ExpressionInstall(assertArgs); /* DR0836 */ whichField = 0; for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg) { #if FUZZY_DEFTEMPLATES /* 03-07-96 */ /* NOTE: a fuzzy fact should have been parsed to give a single constant arg of type FUZZY_VALUE */ #endif EvaluateExpression(tempPtr,&theResult); factPtr->theProposition.theFields[whichField].type = (short) theResult.type; factPtr->theProposition.theFields[whichField].value = theResult.value; whichField++; } ExpressionDeinstall(assertArgs); /* DR0836 */ ReturnExpression(assertArgs); /*==================*/ /* Return the fact. */ /*==================*/ return(factPtr); }
/******************************************************************** NAME : EvaluateSlotDefaultValue DESCRIPTION : Checks the default value against the slot constraints and evaluates static default values INPUTS : 1) The slot descriptor 2) The bitmap marking which facets were specified in the original slot definition RETURNS : True if all OK, false otherwise SIDE EFFECTS : Static default value expressions deleted and replaced with data object evaluation NOTES : On errors, slot is marked as dynamix so that DeleteSlots() will erase the slot expression ********************************************************************/ static bool EvaluateSlotDefaultValue( Environment *theEnv, SlotDescriptor *sd, const char *specbits) { UDFValue temp; bool oldce,olddcc, vPass; ConstraintViolationType vCode; /* =================================================================== Slot default value expression is marked as dynamic until now so that DeleteSlots() would erase in the event of an error. The delay was so that the evaluation of a static default value could be delayed until all the constraints were parsed. =================================================================== */ if (! TestBitMap(specbits,DEFAULT_DYNAMIC_BIT)) sd->dynamicDefault = 0; if (sd->noDefault) return true; if (sd->dynamicDefault == 0) { if (TestBitMap(specbits,DEFAULT_BIT)) { oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,true); olddcc = SetDynamicConstraintChecking(theEnv,true); vPass = EvaluateAndStoreInDataObject(theEnv,sd->multiple, (Expression *) sd->defaultValue,&temp,true); if (vPass != false) vPass = (ValidSlotValue(theEnv,&temp,sd,NULL,"the 'default' facet") == PSE_NO_ERROR); SetDynamicConstraintChecking(theEnv,olddcc); SetExecutingConstruct(theEnv,oldce); if (vPass) { ExpressionDeinstall(theEnv,(Expression *) sd->defaultValue); ReturnPackedExpression(theEnv,(Expression *) sd->defaultValue); sd->defaultValue = get_struct(theEnv,udfValue); GenCopyMemory(UDFValue,1,sd->defaultValue,&temp); RetainUDFV(theEnv,(UDFValue *) sd->defaultValue); } else { sd->dynamicDefault = 1; return false; } } else if (sd->defaultSpecified == 0) { sd->defaultValue = get_struct(theEnv,udfValue); DeriveDefaultFromConstraints(theEnv,sd->constraint, (UDFValue *) sd->defaultValue,sd->multiple,true); RetainUDFV(theEnv,(UDFValue *) sd->defaultValue); } } else { vCode = ConstraintCheckExpressionChain(theEnv,(Expression *) sd->defaultValue,sd->constraint); if (vCode != NO_VIOLATION) { PrintErrorID(theEnv,"CSTRNCHK",1,false); WriteString(theEnv,STDERR,"Expression for "); PrintSlot(theEnv,STDERR,sd,NULL,"dynamic default value"); ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0, vCode,sd->constraint,false); return false; } } return true; }
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 : EvaluateSlotDefaultValue DESCRIPTION : Checks the default value against the slot constraints and evaluates static default values INPUTS : 1) The slot descriptor 2) The bitmap marking which facets were specified in the original slot definition RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Static default value expressions deleted and replaced with data object evaluation NOTES : On errors, slot is marked as dynamix so that DeleteSlots() will erase the slot expression ********************************************************************/ static intBool EvaluateSlotDefaultValue( void *theEnv, EXEC_STATUS, SLOT_DESC *sd, char *specbits) { DATA_OBJECT temp; int oldce,olddcc,vCode; /* =================================================================== Slot default value expression is marked as dynamic until now so that DeleteSlots() would erase in the event of an error. The delay was so that the evaluation of a static default value could be delayed until all the constraints were parsed. =================================================================== */ if (TestBitMap(specbits,DEFAULT_DYNAMIC_BIT) == 0) sd->dynamicDefault = 0; if (sd->noDefault) return(TRUE); if (sd->dynamicDefault == 0) { if (TestBitMap(specbits,DEFAULT_BIT)) { oldce = ExecutingConstruct(theEnv,execStatus); SetExecutingConstruct(theEnv,execStatus,TRUE); olddcc = EnvSetDynamicConstraintChecking(theEnv,execStatus,EnvGetStaticConstraintChecking(theEnv,execStatus)); vCode = EvaluateAndStoreInDataObject(theEnv,execStatus,(int) sd->multiple, (EXPRESSION *) sd->defaultValue,&temp,TRUE); if (vCode != FALSE) vCode = ValidSlotValue(theEnv,execStatus,&temp,sd,NULL,"slot default value"); EnvSetDynamicConstraintChecking(theEnv,execStatus,olddcc); SetExecutingConstruct(theEnv,execStatus,oldce); if (vCode) { ExpressionDeinstall(theEnv,execStatus,(EXPRESSION *) sd->defaultValue); ReturnPackedExpression(theEnv,execStatus,(EXPRESSION *) sd->defaultValue); sd->defaultValue = (void *) get_struct(theEnv,execStatus,dataObject); GenCopyMemory(DATA_OBJECT,1,sd->defaultValue,&temp); ValueInstall(theEnv,execStatus,(DATA_OBJECT *) sd->defaultValue); } else { sd->dynamicDefault = 1; return(FALSE); } } else if (sd->defaultSpecified == 0) { sd->defaultValue = (void *) get_struct(theEnv,execStatus,dataObject); DeriveDefaultFromConstraints(theEnv,execStatus,sd->constraint, (DATA_OBJECT *) sd->defaultValue,(int) sd->multiple,TRUE); ValueInstall(theEnv,execStatus,(DATA_OBJECT *) sd->defaultValue); } } else if (EnvGetStaticConstraintChecking(theEnv,execStatus)) { vCode = ConstraintCheckExpressionChain(theEnv,execStatus,(EXPRESSION *) sd->defaultValue,sd->constraint); if (vCode != NO_VIOLATION) { PrintErrorID(theEnv,execStatus,"CSTRNCHK",1,FALSE); EnvPrintRouter(theEnv,execStatus,WERROR,"Expression for "); PrintSlot(theEnv,execStatus,WERROR,sd,NULL,"dynamic default value"); ConstraintViolationErrorMessage(theEnv,execStatus,NULL,NULL,0,0,NULL,0, vCode,sd->constraint,FALSE); return(FALSE); } } return(TRUE); }