自学教程：C++ EvaluationData函数代码示例

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);  }