globle DATA_OBJECT_PTR EnvRtnUnknown( void *theEnv, int argumentPosition, DATA_OBJECT_PTR returnValue) { int count = 1; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnUnknown", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); } /*=======================================*/ /* Return the value of the nth argument. */ /*=======================================*/ EvaluateExpression(theEnv,argPtr,returnValue); return(returnValue); }
static void OutputUserFunctionsInfo( void *theEnv) { struct FunctionDefinition *theFunction; int i; for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { OutputProfileInfo(theEnv,ValueToString(theFunction->callFunctionName), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID, theFunction->usrData), NULL,NULL,NULL,NULL); } for (i = 0; i < MAXIMUM_PRIMITIVES; i++) { if (EvaluationData(theEnv)->PrimitivesArray[i] != NULL) { OutputProfileInfo(theEnv,EvaluationData(theEnv)->PrimitivesArray[i]->name, (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID, EvaluationData(theEnv)->PrimitivesArray[i]->usrData), NULL,NULL,NULL,NULL); } } }
static void DeallocateEvaluationData( void *theEnv) { int i; for (i = 0; i < EvaluationData(theEnv)->numberOfAddressTypes; i++) { rtn_struct(theEnv,externalAddressType,EvaluationData(theEnv)->ExternalAddressTypes[i]); } }
globle void SetEvaluationError( void *theEnv, int value) { EvaluationData(theEnv)->EvaluationError = value; if (value == TRUE) { EvaluationData(theEnv)->HaltExecution = TRUE; } }
void ClearBloadedExpressions( Environment *theEnv) { unsigned long i; size_t space; /*===============================================*/ /* Update the busy counts of atomic data values. */ /*===============================================*/ for (i = 0; i < ExpressionData(theEnv)->NumberOfExpressions; i++) { switch (ExpressionData(theEnv)->ExpressionArray[i].type) { case SYMBOL_TYPE : case STRING_TYPE : case INSTANCE_NAME_TYPE : case GBL_VARIABLE : ReleaseLexeme(theEnv,ExpressionData(theEnv)->ExpressionArray[i].lexemeValue); break; case FLOAT_TYPE : ReleaseFloat(theEnv,ExpressionData(theEnv)->ExpressionArray[i].floatValue); break; case INTEGER_TYPE : ReleaseInteger(theEnv,ExpressionData(theEnv)->ExpressionArray[i].integerValue); break; #if DEFTEMPLATE_CONSTRUCT case FACT_ADDRESS_TYPE : ReleaseFact((Fact *) ExpressionData(theEnv)->ExpressionArray[i].value); break; #endif #if OBJECT_SYSTEM case INSTANCE_ADDRESS_TYPE : ReleaseInstance((Instance *) ExpressionData(theEnv)->ExpressionArray[i].value); break; #endif case VOID_TYPE: break; default: if (EvaluationData(theEnv)->PrimitivesArray[ExpressionData(theEnv)->ExpressionArray[i].type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[ExpressionData(theEnv)->ExpressionArray[i].type]->bitMap) { DecrementBitMapReferenceCount(theEnv,(CLIPSBitMap *) ExpressionData(theEnv)->ExpressionArray[i].value); } break; } } /*===================================*/ /* Free the binary expression array. */ /*===================================*/ space = ExpressionData(theEnv)->NumberOfExpressions * sizeof(struct expr); if (space != 0) genfree(theEnv,ExpressionData(theEnv)->ExpressionArray,space); ExpressionData(theEnv)->ExpressionArray = 0; }
globle int ParseConstruct( void *theEnv, char *name, char *logicalName) { struct construct *currentPtr; int rv, ov; /*=================================*/ /* Look for a valid construct name */ /* (e.g. defrule, deffacts). */ /*=================================*/ currentPtr = FindConstruct(theEnv,name); if (currentPtr == NULL) return(-1); /*==================================*/ /* Prepare the parsing environment. */ /*==================================*/ ov = GetHaltExecution(theEnv); SetEvaluationError(theEnv,FALSE); SetHaltExecution(theEnv,FALSE); ClearParsedBindNames(theEnv); PushRtnBrkContexts(theEnv); ExpressionData(theEnv)->ReturnContext = FALSE; ExpressionData(theEnv)->BreakContext = FALSE; EvaluationData(theEnv)->CurrentEvaluationDepth++; /*=======================================*/ /* Call the construct's parsing routine. */ /*=======================================*/ ConstructData(theEnv)->ParsingConstruct = TRUE; rv = (*currentPtr->parseFunction)(theEnv,logicalName); ConstructData(theEnv)->ParsingConstruct = FALSE; /*===============================*/ /* Restore environment settings. */ /*===============================*/ EvaluationData(theEnv)->CurrentEvaluationDepth--; PopRtnBrkContexts(theEnv); ClearParsedBindNames(theEnv); SetPPBufferStatus(theEnv,OFF); SetHaltExecution(theEnv,ov); /*==============================*/ /* Return the status of parsing */ /* the construct. */ /*==============================*/ return(rv); }
globle char *EnvRtnLexeme( void *theEnv, int argumentPosition) { int count = 1; DATA_OBJECT result; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnLexeme", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); } /*============================================*/ /* Return the value of the nth argument if it */ /* is a symbol, string, or instance name. */ /*============================================*/ EvaluateExpression(theEnv,argPtr,&result); if ((result.type == SYMBOL) || #if OBJECT_SYSTEM (result.type == INSTANCE_NAME) || #endif (result.type == STRING)) { return(ValueToString(result.value));} /*======================================================*/ /* Generate an error if the argument is the wrong type. */ /*======================================================*/ ExpectedTypeError3(theEnv,"RtnLexeme", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition,"symbol, string, or instance name"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); }
globle void InstallPrimitive( void *theEnv, struct entityRecord *thePrimitive, int whichPosition) { if (EvaluationData(theEnv)->PrimitivesArray[whichPosition] != NULL) { SystemError(theEnv,"EVALUATN",5); EnvExitRouter(theEnv,EXIT_FAILURE); } EvaluationData(theEnv)->PrimitivesArray[whichPosition] = thePrimitive; }
/**************************************************** NAME : InstancesPurge DESCRIPTION : Removes all instances INPUTS : None RETURNS : TRUE if all instances deleted, FALSE otherwise SIDE EFFECTS : The instance hash table is cleared NOTES : None ****************************************************/ globle intBool InstancesPurge( void *theEnv) { int svdepth; DestroyAllInstances(theEnv); svdepth = EvaluationData(theEnv)->CurrentEvaluationDepth; if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) EvaluationData(theEnv)->CurrentEvaluationDepth = -1; CleanupInstances(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth = svdepth; return((InstanceData(theEnv)->InstanceList != NULL) ? FALSE : TRUE); }
globle long EnvRtnLong( void *theEnv, int argumentPosition) { int count = 1; DATA_OBJECT result; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnLong", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1L); } /*======================================*/ /* Return the value of the nth argument */ /* if it is a float or integer. */ /*======================================*/ EvaluateExpression(theEnv,argPtr,&result); if (result.type == FLOAT) { return((long) ValueToDouble(result.value)); } else if (result.type == INTEGER) { return(ValueToLong(result.value)); } /*======================================================*/ /* Generate an error if the argument is the wrong type. */ /*======================================================*/ ExpectedTypeError3(theEnv,"RtnLong", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition,"number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1L); }
/***************************************************************** NAME : TestForFirstFactInTemplate DESCRIPTION : Processes all facts in a template INPUTS : 1) Visitation traversal id 2) The template 3) The current template restriction chain 4) The index of the current restriction RETURNS : TRUE if query succeeds, FALSE otherwise SIDE EFFECTS : Fact variable values set NOTES : None *****************************************************************/ static int TestForFirstFactInTemplate( void *theEnv, struct deftemplate *templatePtr, QUERY_TEMPLATE *qchain, int indx) { struct fact *theFact; DATA_OBJECT temp; theFact = templatePtr->factList; while (theFact != NULL) { FactQueryData(theEnv)->QueryCore->solns[indx] = theFact; if (qchain->nxt != NULL) { theFact->factHeader.busyCount++; if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == TRUE) { theFact->factHeader.busyCount--; break; } theFact->factHeader.busyCount--; if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) break; } else { theFact->factHeader.busyCount++; EvaluationData(theEnv)->CurrentEvaluationDepth++; EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp); EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); theFact->factHeader.busyCount--; if (EvaluationData(theEnv)->HaltExecution == TRUE) break; if ((temp.type != SYMBOL) ? TRUE : (temp.value != EnvFalseSymbol(theEnv))) break; } theFact = theFact->nextTemplateFact; while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE) theFact = theFact->nextTemplateFact; } if (theFact != NULL) return(((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) ? FALSE : TRUE); return(FALSE); }
globle void PrintDataObject( void *theEnv, const char *fileid, DATA_OBJECT_PTR argPtr) { switch(argPtr->type) { case RVOID: case SYMBOL: case STRING: case INTEGER: case FLOAT: case EXTERNAL_ADDRESS: case DATA_OBJECT_ARRAY: // TBD Remove with AddPrimitive case FACT_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif PrintAtom(theEnv,fileid,argPtr->type,argPtr->value); break; case MULTIFIELD: PrintMultifield(theEnv,fileid,(struct multifield *) argPtr->value, argPtr->begin,argPtr->end,TRUE); break; default: if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type] != NULL) { if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->longPrintFunction) { (*EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->longPrintFunction)(theEnv,fileid,argPtr->value); break; } else if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->shortPrintFunction) { (*EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->shortPrintFunction)(theEnv,fileid,argPtr->value); break; } } EnvPrintRouter(theEnv,fileid,"<UnknownPrintType"); PrintLongInteger(theEnv,fileid,(long int) argPtr->type); EnvPrintRouter(theEnv,fileid,">"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); break; } }
/****************************************************************************** NAME : DelayedQueryDoForAllFacts DESCRIPTION : Finds all sets of facts which satisfy the query and and exceutes a user-action for each set This function differs from QueryDoForAllFacts() in that it forms the complete list of query satisfactions BEFORE executing any actions. INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated once for every fact set. The action is executed for evry query satisfaction. Caller's result buffer holds result of last action executed. NOTES : H/L Syntax : See FactParseQueryNoAction() ******************************************************************************/ globle void DelayedQueryDoForAllFacts( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; register unsigned i; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg, "delayed-do-for-all-facts",&rcnt); if (qtemplates == NULL) return; PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); FactQueryData(theEnv)->QueryCore->action = NULL; FactQueryData(theEnv)->QueryCore->soln_set = NULL; FactQueryData(theEnv)->QueryCore->soln_size = rcnt; FactQueryData(theEnv)->QueryCore->soln_cnt = 0; TestEntireChain(theEnv,qtemplates,0); FactQueryData(theEnv)->AbortQuery = FALSE; FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; while (FactQueryData(theEnv)->QueryCore->soln_set != NULL) { for (i = 0 ; i < rcnt ; i++) FactQueryData(theEnv)->QueryCore->solns[i] = FactQueryData(theEnv)->QueryCore->soln_set->soln[i]; PopQuerySoln(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth++; EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result); EvaluationData(theEnv)->CurrentEvaluationDepth--; if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { PropagateReturnValue(theEnv,result); } PeriodicCleanup(theEnv,FALSE,TRUE); if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { while (FactQueryData(theEnv)->QueryCore->soln_set != NULL) PopQuerySoln(theEnv); break; } } ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); }
globle void MarkNeededItems( void *theEnv, EXEC_STATUS, struct expr *testPtr) { while (testPtr != NULL) { switch (testPtr->type) { case SYMBOL: case STRING: case GBL_VARIABLE: case INSTANCE_NAME: ((SYMBOL_HN *) testPtr->value)->neededSymbol = TRUE; break; case FLOAT: ((FLOAT_HN *) testPtr->value)->neededFloat = TRUE; break; case INTEGER: ((INTEGER_HN *) testPtr->value)->neededInteger = TRUE; break; case FCALL: ((struct FunctionDefinition *) testPtr->value)->bsaveIndex = TRUE; break; case RVOID: break; default: if (EvaluationData(theEnv,execStatus)->PrimitivesArray[testPtr->type] == NULL) break; if (EvaluationData(theEnv,execStatus)->PrimitivesArray[testPtr->type]->bitMap) { ((BITMAP_HN *) testPtr->value)->neededBitMap = TRUE; } break; } if (testPtr->argList != NULL) { MarkNeededItems(theEnv,execStatus,testPtr->argList); } testPtr = testPtr->nextArg; } }
/********************************************************************** NAME : WatchMethod DESCRIPTION : Prints out a trace of the beginning or end of the execution of a generic function method INPUTS : A string to indicate beginning or end of execution RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Uses the globals CurrentGeneric, CurrentMethod, ProcParamArraySize and ProcParamArray for other trace info **********************************************************************/ static void WatchMethod( Environment *theEnv, const char *tstring) { if (ConstructData(theEnv)->ClearReadyInProgress || ConstructData(theEnv)->ClearInProgress) { return; } WriteString(theEnv,STDOUT,"MTH "); WriteString(theEnv,STDOUT,tstring); WriteString(theEnv,STDOUT," "); if (DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule != GetCurrentModule(theEnv)) { WriteString(theEnv,STDOUT,DefgenericModule(DefgenericData(theEnv)->CurrentGeneric)); WriteString(theEnv,STDOUT,"::"); } WriteString(theEnv,STDOUT,DefgenericData(theEnv)->CurrentGeneric->header.name->contents); WriteString(theEnv,STDOUT,":#"); if (DefgenericData(theEnv)->CurrentMethod->system) WriteString(theEnv,STDOUT,"SYS"); PrintUnsignedInteger(theEnv,STDOUT,DefgenericData(theEnv)->CurrentMethod->index); WriteString(theEnv,STDOUT," "); WriteString(theEnv,STDOUT," ED:"); WriteInteger(theEnv,STDOUT,EvaluationData(theEnv)->CurrentEvaluationDepth); PrintProcParamArray(theEnv,STDOUT); }
globle intBool EvaluateSecondaryNetworkTest( void *theEnv, struct partialMatch *leftMatch, struct joinNode *joinPtr) { int joinExpr; struct partialMatch *oldLHSBinds; struct partialMatch *oldRHSBinds; struct joinNode *oldJoin; if (joinPtr->secondaryNetworkTest == NULL) { return(TRUE); } #if DEVELOPER EngineData(theEnv)->rightToLeftComparisons++; #endif oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds; oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds; oldJoin = EngineData(theEnv)->GlobalJoin; EngineData(theEnv)->GlobalLHSBinds = leftMatch; EngineData(theEnv)->GlobalRHSBinds = NULL; EngineData(theEnv)->GlobalJoin = joinPtr; joinExpr = EvaluateJoinExpression(theEnv,joinPtr->secondaryNetworkTest,joinPtr); EvaluationData(theEnv)->EvaluationError = FALSE; EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; return(joinExpr); }
static void ResetDefinstancesAction( void *theEnv, struct constructHeader *vDefinstances, void *userBuffer) { #if MAC_MCW || WIN_MCW || MAC_XCD #pragma unused(userBuffer) #endif DEFINSTANCES *theDefinstances = (DEFINSTANCES *) vDefinstances; EXPRESSION *theExp; DATA_OBJECT temp; SaveCurrentModule(theEnv); EnvSetCurrentModule(theEnv,(void *) vDefinstances->whichModule->theModule); theDefinstances->busy++; for (theExp = theDefinstances->mkinstance ; theExp != NULL ; theExp = GetNextArgument(theExp)) { EvaluateExpression(theEnv,theExp,&temp); if (EvaluationData(theEnv)->HaltExecution || ((GetType(temp) == SYMBOL) && (GetValue(temp) == EnvFalseSymbol(theEnv)))) { RestoreCurrentModule(theEnv); theDefinstances->busy--; return; } } theDefinstances->busy--; RestoreCurrentModule(theEnv); }
/************************************************************ NAME : TestForFirstInChain DESCRIPTION : Processes all classes in a restriction chain until success or done INPUTS : 1) The current chain 2) The index of the chain restriction (e.g. the 4th query-variable) RETURNS : TRUE if query succeeds, FALSE otherwise SIDE EFFECTS : Sets current restriction class Instance variable values set NOTES : None ************************************************************/ static int TestForFirstInChain( void *theEnv, QUERY_CLASS *qchain, int indx) { QUERY_CLASS *qptr; int id; InstanceQueryData(theEnv)->AbortQuery = TRUE; for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain) { InstanceQueryData(theEnv)->AbortQuery = FALSE; if ((id = GetTraversalID(theEnv)) == -1) return(FALSE); if (TestForFirstInstanceInClass(theEnv,qptr->theModule,id,qptr->cls,qchain,indx)) { ReleaseTraversalID(theEnv); return(TRUE); } ReleaseTraversalID(theEnv); if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) return(FALSE); } return(FALSE); }
/*********************************************************** NAME : EvaluateAndStoreInDataObject DESCRIPTION : Evaluates slot-value expressions and stores the result in a Kernel data object INPUTS : 1) Flag indicating if multifields are OK 2) The value-expression 3) The data object structure 4) Flag indicating if a multifield value should be placed on the garbage list. RETURNS : FALSE on errors, TRUE otherwise SIDE EFFECTS : Segment allocated for storing multifield values NOTES : None ***********************************************************/ globle int EvaluateAndStoreInDataObject( void *theEnv, int mfp, EXPRESSION *theExp, DATA_OBJECT *val, int garbageSegment) { val->type = MULTIFIELD; val->begin = 0; val->end = -1; if (theExp == NULL) { if (garbageSegment) val->value = EnvCreateMultifield(theEnv,0L); else val->value = CreateMultifield2(theEnv,0L); return(TRUE); } if ((mfp == 0) && (theExp->nextArg == NULL)) EvaluateExpression(theEnv,theExp,val); else StoreInMultifield(theEnv,val,theExp,garbageSegment); return(EvaluationData(theEnv)->EvaluationError ? FALSE : TRUE); }
globle void *EnvCreateMultifield( void *theEnv, unsigned long size) { struct multifield *theSegment; unsigned long newSize; if (size <= 0) newSize = 1; else newSize = size; theSegment = get_var_struct2(theEnv,multifield,(long) sizeof(struct field) * (newSize - 1L)); theSegment->multifieldLength = size; theSegment->depth = (short) EvaluationData(theEnv)->CurrentEvaluationDepth; theSegment->busyCount = 0; theSegment->next = NULL; theSegment->next = MultifieldData(theEnv)->ListOfMultifields; MultifieldData(theEnv)->ListOfMultifields = theSegment; UtilityData(theEnv)->EphemeralItemCount++; UtilityData(theEnv)->EphemeralItemSize += sizeof(struct multifield) + (sizeof(struct field) * newSize); return((void *) theSegment); }
globle void FlushMultifields( void *theEnv) { struct multifield *theSegment, *nextPtr, *lastPtr = NULL; unsigned long newSize; theSegment = MultifieldData(theEnv)->ListOfMultifields; while (theSegment != NULL) { nextPtr = theSegment->next; if ((theSegment->depth > EvaluationData(theEnv)->CurrentEvaluationDepth) && (theSegment->busyCount == 0)) { UtilityData(theEnv)->EphemeralItemCount--; UtilityData(theEnv)->EphemeralItemSize -= sizeof(struct multifield) + (sizeof(struct field) * theSegment->multifieldLength); if (theSegment->multifieldLength == 0) newSize = 1; else newSize = theSegment->multifieldLength; rtn_var_struct2(theEnv,multifield,sizeof(struct field) * (newSize - 1),theSegment); if (lastPtr == NULL) MultifieldData(theEnv)->ListOfMultifields = nextPtr; else lastPtr->next = nextPtr; } else { lastPtr = theSegment; } theSegment = nextPtr; } }
globle void PrognFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { struct expr *argPtr; argPtr = EvaluationData(theEnv)->CurrentExpression->argList; if (argPtr == NULL) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } while ((argPtr != NULL) && (GetHaltExecution(theEnv) != TRUE)) { EvaluateExpression(theEnv,argPtr,returnValue); if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) break; argPtr = argPtr->nextArg; } if (GetHaltExecution(theEnv) == TRUE) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } return; }
/************************************************************* NAME : PreviewGeneric DESCRIPTION : Allows the user to see a printout of all the applicable methods for a particular generic function call INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments and evaluating query-functions to determine the set of applicable methods NOTES : H/L Syntax: (preview-generic <func> <args>) *************************************************************/ globle void PreviewGeneric( void *theEnv) { DEFGENERIC *gfunc; DEFGENERIC *previousGeneric; int oldce; DATA_OBJECT temp; EvaluationData(theEnv)->EvaluationError = FALSE; if (EnvArgTypeCheck(theEnv,(char*)"preview-generic",1,SYMBOL,&temp) == FALSE) return; gfunc = LookupDefgenericByMdlOrScope(theEnv,DOToString(temp)); if (gfunc == NULL) { PrintErrorID(theEnv,(char*)"GENRCFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"Unable to find generic function "); EnvPrintRouter(theEnv,WERROR,DOToString(temp)); EnvPrintRouter(theEnv,WERROR,(char*)" in function preview-generic.\n"); return; } oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); previousGeneric = DefgenericData(theEnv)->CurrentGeneric; DefgenericData(theEnv)->CurrentGeneric = gfunc; EvaluationData(theEnv)->CurrentEvaluationDepth++; PushProcParameters(theEnv,GetFirstArgument()->nextArg, CountArguments(GetFirstArgument()->nextArg), EnvGetDefgenericName(theEnv,(void *) gfunc),(char*)"generic function", UnboundMethodErr); if (EvaluationData(theEnv)->EvaluationError) { PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; EvaluationData(theEnv)->CurrentEvaluationDepth--; SetExecutingConstruct(theEnv,oldce); return; } gfunc->busy++; DisplayGenericCore(theEnv,gfunc); gfunc->busy--; PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; EvaluationData(theEnv)->CurrentEvaluationDepth--; SetExecutingConstruct(theEnv,oldce); }
globle void AtomInstall( 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 IncrementSymbolCount(vPtr); break; case FLOAT: IncrementFloatCount(vPtr); break; case INTEGER: IncrementIntegerCount(vPtr); break; case EXTERNAL_ADDRESS: IncrementExternalAddressCount(vPtr); break; case MULTIFIELD: MultifieldInstall(theEnv,(struct multifield *) vPtr); break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[type]->bitMap) IncrementBitMapCount(vPtr); else if (EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount) { (*EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount)(theEnv,vPtr); } break; } }
bool UDFFirstArgument( UDFContext *context, unsigned expectedType, CLIPSValue *returnValue) { context->lastArg = EvaluationData(context->environment)->CurrentExpression->argList; context->lastPosition = 1; return UDFNextArgument(context,expectedType,returnValue); }
globle void SwitchFunction( void *theEnv, DATA_OBJECT_PTR result) { DATA_OBJECT switch_val,case_val; EXPRESSION *theExp; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); /* ========================== Get the value to switch on ========================== */ EvaluateExpression(theEnv,GetFirstArgument(),&switch_val); if (EvaluationData(theEnv)->EvaluationError) return; for (theExp = GetFirstArgument()->nextArg ; theExp != NULL ; theExp = theExp->nextArg->nextArg) { /* ================================================= RVOID is the default case (if any) for the switch ================================================= */ if (theExp->type == RVOID) { EvaluateExpression(theEnv,theExp->nextArg,result); return; } /* ==================================================== If the case matches, evaluate the actions and return ==================================================== */ EvaluateExpression(theEnv,theExp,&case_val); if (EvaluationData(theEnv)->EvaluationError) return; if (switch_val.type == case_val.type) { if ((case_val.type == MULTIFIELD) ? MultifieldDOsEqual(&switch_val,&case_val) : (switch_val.value == case_val.value)) { EvaluateExpression(theEnv,theExp->nextArg,result); return; } } } }
static struct factPatternNode *GetNextFactPatternNode( void *theEnv, int finishedMatching, struct factPatternNode *thePattern) { EvaluationData(theEnv)->EvaluationError = FALSE; /*===================================================*/ /* If pattern matching was successful at the current */ /* node in the tree and it's possible to go deeper */ /* into the tree, then move down to the next level. */ /*===================================================*/ if (finishedMatching == FALSE) { if (thePattern->nextLevel != NULL) return(thePattern->nextLevel); } /*================================================*/ /* Keep backing up toward the root of the pattern */ /* network until a side branch can be taken. */ /*================================================*/ while (thePattern->rightNode == NULL) { /*========================================*/ /* Back up to check the next side branch. */ /*========================================*/ thePattern = thePattern->lastLevel; /*======================================*/ /* If we branched up from the root, the */ /* entire tree has been traversed. */ /*======================================*/ if (thePattern == NULL) return(NULL); /*===================================================*/ /* If we branched up to a multifield node, then stop */ /* since these nodes are handled recursively. The */ /* previous call to the pattern matching algorithm */ /* on the stack will handle backing up to the nodes */ /* above the multifield node in the pattern network. */ /*===================================================*/ if (thePattern->header.multifieldNode) return(NULL); } /*==================================*/ /* Move on to the next side branch. */ /*==================================*/ return(thePattern->rightNode); }
globle int InstallExternalAddressType( void *theEnv, struct externalAddressType *theAddressType) { struct externalAddressType *copyEAT; int rv = EvaluationData(theEnv)->numberOfAddressTypes; if (EvaluationData(theEnv)->numberOfAddressTypes == MAXIMUM_EXTERNAL_ADDRESS_TYPES) { SystemError(theEnv,"EVALUATN",6); EnvExitRouter(theEnv,EXIT_FAILURE); } copyEAT = (struct externalAddressType *) genalloc(theEnv,sizeof(struct externalAddressType)); memcpy(copyEAT,theAddressType,sizeof(struct externalAddressType)); EvaluationData(theEnv)->ExternalAddressTypes[EvaluationData(theEnv)->numberOfAddressTypes++] = copyEAT; return rv; }
globle void AddToMultifieldList( void *theEnv, struct multifield *theSegment) { theSegment->depth = (short) EvaluationData(theEnv)->CurrentEvaluationDepth; theSegment->next = MultifieldData(theEnv)->ListOfMultifields; MultifieldData(theEnv)->ListOfMultifields = theSegment; UtilityData(theEnv)->EphemeralItemCount++; UtilityData(theEnv)->EphemeralItemSize += sizeof(struct multifield) + (sizeof(struct field) * theSegment->multifieldLength); }
globle int EnvRtnArgCount( void *theEnv) { int count = 0; struct expr *argPtr; for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; argPtr != NULL; argPtr = argPtr->nextArg) { count++; } return(count); }