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

globle void StringToFieldFunction(  void *theEnv,  DATA_OBJECT *returnValue)  {   DATA_OBJECT theArg;   /*========================================================*/   /* Function string-to-field expects exactly one argument. */   /*========================================================*/   if (EnvArgCountCheck(theEnv,"string-to-field",EXACTLY,1) == -1)     {      returnValue->type = STRING;      returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***");      return;     }   /*==================================================*/   /* The argument should be of type symbol or string. */   /*==================================================*/   if (EnvArgTypeCheck(theEnv,"string-to-field",1,SYMBOL_OR_STRING,&theArg) == FALSE)     {      returnValue->type = STRING;      returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***");      return;     }   /*================================*/   /* Convert the string to an atom. */   /*================================*/   StringToField(theEnv,DOToString(theArg),returnValue);  }

globle char *GetLogicalName(  void *theEnv,  int whichArgument,  char *defaultLogicalName)  {   char *logicalName;   DATA_OBJECT result;   EnvRtnUnknown(theEnv,whichArgument,&result);   if ((GetType(result) == SYMBOL) ||       (GetType(result) == STRING) ||       (GetType(result) == INSTANCE_NAME))     {      logicalName = ValueToString(result.value);      if ((strcmp(logicalName,"t") == 0) || (strcmp(logicalName,"T") == 0))        { logicalName = defaultLogicalName; }     }   else if (GetType(result) == FLOAT)     {      logicalName = ValueToString(EnvAddSymbol(theEnv,FloatToString(theEnv,DOToDouble(result))));     }   else if (GetType(result) == INTEGER)     {      logicalName = ValueToString(EnvAddSymbol(theEnv,LongIntegerToString(theEnv,DOToLong(result))));     }   else     { logicalName = NULL; }   return(logicalName);  }

void* GetMouseAction(void* theEnv) {    unsigned state;    AdventureEngine::AdventureEngineEngine* engine = PullOutEngine(theEnv);    Common::EventManager* _eventMan = engine->getEventManager();    Common::Point pos = _eventMan->getMousePos();    state = _eventMan->getButtonState();    if(state == engine->previousMouseCommand()) {        state = 0;    } else {        engine->setPreviousMouseCommand(state);    }    switch(state)    {    case 0:        return EnvAddSymbol(theEnv, (char*)"no-click");    case 1:        return EnvAddSymbol(theEnv, (char*)"mouse1");    case 2:        return EnvAddSymbol(theEnv, (char*)"mouse2");    case 3:        return EnvAddSymbol(theEnv, (char*)"mouse3");    default:        return EnvAddSymbol(theEnv, (char*)"unknown");    }}

static void SetErrorCaptureValues(  void *theEnv,  DATA_OBJECT_PTR returnValue)  {   struct multifield *theMultifield;   theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,2L);   if (ParseFunctionData(theEnv)->ErrorString != NULL)     {      SetMFType(theMultifield,1,STRING);      SetMFValue(theMultifield,1,EnvAddSymbol(theEnv,ParseFunctionData(theEnv)->ErrorString));     }   else     {      SetMFType(theMultifield,1,SYMBOL);      SetMFValue(theMultifield,1,EnvFalseSymbol(theEnv));     }   if (ParseFunctionData(theEnv)->WarningString != NULL)     {      SetMFType(theMultifield,2,STRING);      SetMFValue(theMultifield,2,EnvAddSymbol(theEnv,ParseFunctionData(theEnv)->WarningString));     }   else     {      SetMFType(theMultifield,2,SYMBOL);      SetMFValue(theMultifield,2,EnvFalseSymbol(theEnv));     }   SetpType(returnValue,MULTIFIELD);   SetpDOBegin(returnValue,1);   SetpDOEnd(returnValue,2);   SetpValue(returnValue,(void *) theMultifield);  }

globle const char *FloatToString(  void *theEnv,  double number)  {   char floatString[40];   int i;   char x;   void *thePtr;   gensprintf(floatString,"%.15g",number);   for (i = 0; (x = floatString[i]) != '/0'; i++)     {      if ((x == '.') || (x == 'e'))        {         thePtr = EnvAddSymbol(theEnv,floatString);         return(ValueToString(thePtr));        }     }   genstrcat(floatString,".0");   thePtr = EnvAddSymbol(theEnv,floatString);   return(ValueToString(thePtr));  }

globle void *SetSalienceEvaluationCommand(    void *theEnv){    DATA_OBJECT argPtr;    char *argument, *oldValue;    /*==================================================*/    /* Get the current setting for salience evaluation. */    /*==================================================*/    oldValue = SalienceEvaluationName(EnvGetSalienceEvaluation(theEnv));    /*=========================================*/    /* This function expects a single argument */    /* which must be a symbol.                 */    /*=========================================*/    if (EnvArgCountCheck(theEnv,(char*)"set-salience-evaluation",EXACTLY,1) == -1)    {        return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));    }    if (EnvArgTypeCheck(theEnv,(char*)"set-salience-evaluation",1,SYMBOL,&argPtr) == FALSE)    {        return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));    }    /*=============================================================*/    /* The allowed symbols to pass as an argument to this function */    /* are when-defined, when-activated, and every-cycle.          */    /*=============================================================*/    argument = DOToString(argPtr);    if (strcmp(argument,(char*)"when-defined") == 0)    {        EnvSetSalienceEvaluation(theEnv,WHEN_DEFINED);    }    else if (strcmp(argument,(char*)"when-activated") == 0)    {        EnvSetSalienceEvaluation(theEnv,WHEN_ACTIVATED);    }    else if (strcmp(argument,(char*)"every-cycle") == 0)    {        EnvSetSalienceEvaluation(theEnv,EVERY_CYCLE);    }    else    {        ExpectedTypeError1(theEnv,(char*)"set-salience-evaluation",1,                           (char*)"symbol with value when-defined, when-activated, or every-cycle");        return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));    }    /*=================================================*/    /* Return the old setting for salience evaluation. */    /*=================================================*/    return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));}

globle void LowcaseFunction(  void *theEnv,  DATA_OBJECT_PTR returnValue)  {   DATA_OBJECT theArg;   unsigned i;   size_t slen;   char *osptr, *nsptr;   /*================================================*/   /* Function lowcase expects exactly one argument. */   /*================================================*/   if (EnvArgCountCheck(theEnv,"lowcase",EXACTLY,1) == -1)     {      SetpType(returnValue,STRING);      SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));      return;     }   /*==================================================*/   /* The argument should be of type symbol or string. */   /*==================================================*/   if (EnvArgTypeCheck(theEnv,"lowcase",1,SYMBOL_OR_STRING,&theArg) == FALSE)     {      SetpType(returnValue,STRING);      SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));      return;     }   /*======================================================*/   /* Allocate temporary memory and then copy the original */   /* string or symbol to that memory, while lowercasing   */   /* upper case alphabetic characters.                    */   /*======================================================*/   osptr = DOToString(theArg);   slen = strlen(osptr) + 1;   nsptr = (char *) gm2(theEnv,slen);   for (i = 0  ; i < slen ; i++)     {      if (isupper(osptr[i]))        { nsptr[i] = (char) tolower(osptr[i]); }      else        { nsptr[i] = osptr[i]; }     }   /*========================================*/   /* Return the lowercased string and clean */   /* up the temporary memory used.          */   /*========================================*/   SetpType(returnValue,GetType(theArg));   SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,nsptr));   rm(theEnv,nsptr,slen);  }

globle void *SetStrategyCommand(  void *theEnv)  {   DATA_OBJECT argPtr;   char *argument;   int oldStrategy;   oldStrategy = AgendaData(theEnv)->Strategy;   /*=====================================================*/   /* Check for the correct number and type of arguments. */   /*=====================================================*/   if (EnvArgCountCheck(theEnv,"set-strategy",EXACTLY,1) == -1)     { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); }   if (EnvArgTypeCheck(theEnv,"set-strategy",1,SYMBOL,&argPtr) == FALSE)     { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); }   argument = DOToString(argPtr);   /*=============================================*/   /* Set the strategy to the specified strategy. */   /*=============================================*/   if (strcmp(argument,"depth") == 0)     { EnvSetStrategy(theEnv,DEPTH_STRATEGY); }   else if (strcmp(argument,"breadth") == 0)     { EnvSetStrategy(theEnv,BREADTH_STRATEGY); }   else if (strcmp(argument,"lex") == 0)     { EnvSetStrategy(theEnv,LEX_STRATEGY); }   else if (strcmp(argument,"mea") == 0)     { EnvSetStrategy(theEnv,MEA_STRATEGY); }   else if (strcmp(argument,"complexity") == 0)     { EnvSetStrategy(theEnv,COMPLEXITY_STRATEGY); }   else if (strcmp(argument,"simplicity") == 0)     { EnvSetStrategy(theEnv,SIMPLICITY_STRATEGY); }   else if (strcmp(argument,"random") == 0)     { EnvSetStrategy(theEnv,RANDOM_STRATEGY); }   else     {      ExpectedTypeError1(theEnv,"set-strategy",1,      "symbol with value depth, breadth, lex, mea, complexity, simplicity, or random");      return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv))));     }   /*=======================================*/   /* Return the old value of the strategy. */   /*=======================================*/   return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(oldStrategy)));  }

/**********************************************************  NAME         : SetupObjectSystem  DESCRIPTION  : Initializes all COOL constructs, functions,                   and data structures  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : COOL initialized  NOTES        : Order of setup calls is important **********************************************************/globle void SetupObjectSystem(    void *theEnv){    ENTITY_RECORD defclassEntityRecord = { (char*)"DEFCLASS_PTR", DEFCLASS_PTR,1,0,0,                                           NULL,NULL,NULL,NULL,NULL,                                           DecrementDefclassBusyCount,                                           IncrementDefclassBusyCount,                                           NULL,NULL,NULL,NULL,NULL                                         };    AllocateEnvironmentData(theEnv,DEFCLASS_DATA,sizeof(struct defclassData),NULL);    AddEnvironmentCleanupFunction(theEnv,(char*)"defclasses",DeallocateDefclassData,-500);    memcpy(&DefclassData(theEnv)->DefclassEntityRecord,&defclassEntityRecord,sizeof(struct entityRecord));#if ! RUN_TIME    DefclassData(theEnv)->ClassDefaultsMode = CONVENIENCE_MODE;    DefclassData(theEnv)->ISA_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SUPERCLASS_RLN);    IncrementSymbolCount(DefclassData(theEnv)->ISA_SYMBOL);    DefclassData(theEnv)->NAME_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,NAME_RLN);    IncrementSymbolCount(DefclassData(theEnv)->NAME_SYMBOL);#if DEFRULE_CONSTRUCT    DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INITIAL_OBJECT_NAME);    IncrementSymbolCount(DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);#endif#endif    SetupDefclasses(theEnv);    SetupInstances(theEnv);    SetupMessageHandlers(theEnv);#if DEFINSTANCES_CONSTRUCT    SetupDefinstances(theEnv);#endif#if INSTANCE_SET_QUERIES    SetupQuery(theEnv);#endif#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY    SetupObjectsBload(theEnv);#endif#if CONSTRUCT_COMPILER && (! RUN_TIME)    SetupObjectsCompiler(theEnv);#endif#if DEFRULE_CONSTRUCT    SetupObjectPatternStuff(theEnv);#endif}

/************************************************************  NAME         : WildDeleteHandler  DESCRIPTION  : Deletes a handler from a class  INPUTS       : 1) Class address (Can be NULL)                 2) Message Handler Name (Can be NULL)                 3) Type name ("primary", etc.)  RETURNS      : 1 if successful, 0 otherwise  SIDE EFFECTS : Handler deleted if possible  NOTES        : None ************************************************************/static int WildDeleteHandler(  void *theEnv,  DEFCLASS *cls,  SYMBOL_HN *msym,  const char *tname)  {   int mtype;   if (msym == NULL)     msym = (SYMBOL_HN *) EnvAddSymbol(theEnv,"*");   if (tname != NULL)     {      mtype = (int) HandlerType(theEnv,"undefmessage-handler",tname);      if (mtype == MERROR)        return(0);     }   else     mtype = -1;   if (cls == NULL)     {      int success = 1;      for (cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ;           cls != NULL ;           cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls))        if (DeleteHandler(theEnv,cls,msym,mtype,FALSE) == 0)          success = 0;      return(success);     }   return(DeleteHandler(theEnv,cls,msym,mtype,TRUE));  }

globle void *GetClassDefaultsModeCommand(  void *theEnv)  {   EnvArgCountCheck(theEnv,"get-class-defaults-mode",EXACTLY,0);   return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv))));  }

globle char *StringPrintForm(  void *theEnv,  char *str)  {   int i = 0, pos = 0;   unsigned max = 0;   char *theString = NULL;   void *thePtr;   theString = ExpandStringWithChar(theEnv,'"',theString,&pos,&max,max+80);   while (str[i] != EOS)     {      if ((str[i] == '"') || (str[i] == '//'))        {         theString = ExpandStringWithChar(theEnv,'//',theString,&pos,&max,max+80);         theString = ExpandStringWithChar(theEnv,str[i],theString,&pos,&max,max+80);        }      else        { theString = ExpandStringWithChar(theEnv,str[i],theString,&pos,&max,max+80); }      i++;     }   theString = ExpandStringWithChar(theEnv,'"',theString,&pos,&max,max+80);   thePtr = EnvAddSymbol(theEnv,theString);   rm(theEnv,theString,max);   return(ValueToString(thePtr));  }

globle void *GensymStar(    void *theEnv){    char genstring[15];    /*=======================================================*/    /* Create a symbol using the current gensym index as the */    /* postfix. If the symbol is already present in the      */    /* symbol table, then continue generating symbols until  */    /* a unique symbol is found.                             */    /*=======================================================*/    do    {        sprintf(genstring,"gen%ld",MiscFunctionData(theEnv)->GensymNumber);        MiscFunctionData(theEnv)->GensymNumber++;    }    while (FindSymbolHN(theEnv,genstring) != NULL);    /*====================*/    /* Return the symbol. */    /*====================*/    return(EnvAddSymbol(theEnv,genstring));}

globle void *GensymFunction(    void *theEnv){    char genstring[15];    /*===========================================*/    /* The gensym function accepts no arguments. */    /*===========================================*/    EnvArgCountCheck(theEnv,"gensym",EXACTLY,0);    /*================================================*/    /* Create a symbol using the current gensym index */    /* as the postfix.                                */    /*================================================*/    sprintf(genstring,"gen%ld",MiscFunctionData(theEnv)->GensymNumber);    MiscFunctionData(theEnv)->GensymNumber++;    /*====================*/    /* Return the symbol. */    /*====================*/    return(EnvAddSymbol(theEnv,genstring));}

/*********************************************************  NAME         : SlotDefaultValue  DESCRIPTION  : Determines the default value for                 the specified slot of the specified class  INPUTS       : 1) The class                 2) The slot name  RETURNS      : TRUE if slot default value is set,                 FALSE otherwise  SIDE EFFECTS : Slot default value evaluated - dynamic                 defaults will cause any side effects  NOTES        : None *********************************************************/globle intBool EnvSlotDefaultValue(  void *theEnv,  void *theDefclass,  char *slotName,  DATA_OBJECT_PTR theValue)  {   SLOT_DESC *sd;   SetpType(theValue,SYMBOL);   SetpValue(theValue,EnvFalseSymbol(theEnv));   if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,TRUE)) == NULL)     return(FALSE);      if (sd->noDefault)     {      SetpType(theValue,SYMBOL);      SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE"));      return(TRUE);      }        if (sd->dynamicDefault)     return(EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple,                                         (EXPRESSION *) sd->defaultValue,                                         theValue,TRUE));   GenCopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue);   return(TRUE);  }

	dataObject * value_to_data_object( const Environment& env, const Value & value )	{    void *p;		dataObject* clipsdo = new dataObject;    SetpType(clipsdo, value.type() );    switch ( value.type() ) {      case TYPE_SYMBOL:      case TYPE_STRING:      case TYPE_INSTANCE_NAME:        p = EnvAddSymbol( env.cobj(),                          const_cast<char*>( value.as_string().c_str())                        );        SetpValue(clipsdo, p);        return clipsdo;      case TYPE_INTEGER:        p = EnvAddLong( env.cobj(), value.as_integer() );        SetpValue(clipsdo, p);        return clipsdo;      case TYPE_FLOAT:        p = EnvAddDouble( env.cobj(), value.as_float() );        SetpValue(clipsdo, p);        return clipsdo;      case TYPE_EXTERNAL_ADDRESS:        p = EnvAddExternalAddress( env.cobj(), value.as_address(), EXTERNAL_ADDRESS );        SetpValue(clipsdo, p);        return clipsdo;      default:        throw std::logic_error( "clipsmm::value_to_data_object: Unhandled data object type" );    }		return NULL;	}

globle void *GetSalienceEvaluationCommand(    void *theEnv){    EnvArgCountCheck(theEnv,(char*)"get-salience-evaluation",EXACTLY,0);    return((SYMBOL_HN *) EnvAddSymbol(theEnv,SalienceEvaluationName(EnvGetSalienceEvaluation(theEnv))));}

/**********************************************************************  NAME         : SlotDefaultValueCommand  DESCRIPTION  : Determines the default avlue for the specified slot                 of the specified class  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : None  NOTES        : H/L Syntax : (slot-default-value <class> <slot>) **********************************************************************/globle void SlotDefaultValueCommand(  void *theEnv,  DATA_OBJECT_PTR theValue)  {   DEFCLASS *theDefclass;   SLOT_DESC *sd;   SetpType(theValue,SYMBOL);   SetpValue(theValue,EnvFalseSymbol(theEnv));   sd = CheckSlotExists(theEnv,"slot-default-value",&theDefclass,TRUE,TRUE);   if (sd == NULL)     return;      if (sd->noDefault)     {      SetpType(theValue,SYMBOL);      SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE"));      return;      }        if (sd->dynamicDefault)     EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple,                                  (EXPRESSION *) sd->defaultValue,                                  theValue,TRUE);   else     GenCopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue);  }

globle void *GetStrategyCommand(  void *theEnv)  {   EnvArgCountCheck(theEnv,"get-strategy",EXACTLY,0);   return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv))));  }

globle void EnvFactSlotNames(  void *theEnv,  void *vTheFact,  DATA_OBJECT *returnValue)  {   struct fact *theFact = (struct fact *) vTheFact;   struct multifield *theList;   struct templateSlot *theSlot;   unsigned long count;   /*===============================================*/   /* If we're dealing with an implied deftemplate, */   /* then the only slot names is "implied."        */   /*===============================================*/   if (theFact->whichDeftemplate->implied)     {      SetpType(returnValue,MULTIFIELD);      SetpDOBegin(returnValue,1);      SetpDOEnd(returnValue,1);      theList = (struct multifield *) EnvCreateMultifield(theEnv,(int) 1);      SetMFType(theList,1,SYMBOL);      SetMFValue(theList,1,EnvAddSymbol(theEnv,"implied"));      SetpValue(returnValue,(void *) theList);      return;     }   /*=================================*/   /* Count the number of slot names. */   /*=================================*/   for (count = 0, theSlot = theFact->whichDeftemplate->slotList;        theSlot != NULL;        count++, theSlot = theSlot->next)     { /* Do Nothing */ }   /*=============================================================*/   /* Create a multifield value in which to store the slot names. */   /*=============================================================*/   SetpType(returnValue,MULTIFIELD);   SetpDOBegin(returnValue,1);   SetpDOEnd(returnValue,(long) count);   theList = (struct multifield *) EnvCreateMultifield(theEnv,count);   SetpValue(returnValue,(void *) theList);   /*===============================================*/   /* Store the slot names in the multifield value. */   /*===============================================*/   for (count = 1, theSlot = theFact->whichDeftemplate->slotList;        theSlot != NULL;        count++, theSlot = theSlot->next)     {      SetMFType(theList,count,SYMBOL);      SetMFValue(theList,count,theSlot->slotName);     }  }

globle struct lhsParseNode *CreateInitialFactPattern(  void *theEnv)  {   struct lhsParseNode *topNode;   struct deftemplate *theDeftemplate;   int count;      /*==================================*/   /* If the initial-fact deftemplate  */   /* doesn't exist, then create it.   */   /*==================================*/   theDeftemplate = (struct deftemplate *)                    FindImportedConstruct(theEnv,"deftemplate",NULL,"initial-fact",                                          &count,TRUE,NULL);   if (theDeftemplate == NULL)     {      PrintWarningID(theEnv,"FACTLHS",1,FALSE);      EnvPrintRouter(theEnv,WWARNING,"Creating implied initial-fact deftemplate in module ");      EnvPrintRouter(theEnv,WWARNING,EnvGetDefmoduleName(theEnv,EnvGetCurrentModule(theEnv)));      EnvPrintRouter(theEnv,WWARNING,"./n");      EnvPrintRouter(theEnv,WWARNING,"  You probably want to import this deftemplate from the MAIN module./n");      CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE);     }   /*====================================*/   /* Create the (initial-fact) pattern. */   /*====================================*/   topNode = GetLHSParseNode(theEnv);   topNode->type = SF_WILDCARD;   topNode->index = 0;   topNode->slotNumber = 1;   topNode->bottom = GetLHSParseNode(theEnv);   topNode->bottom->type = SYMBOL;   topNode->bottom->value = (void *) EnvAddSymbol(theEnv,"initial-fact");   /*=====================*/   /* Return the pattern. */   /*=====================*/   return(topNode);  }

globle void *SetClassDefaultsModeCommand(  void *theEnv,	EXEC_STATUS)  {   DATA_OBJECT argPtr;   char *argument;   unsigned short oldMode;      oldMode = DefclassData(theEnv,execStatus)->ClassDefaultsMode;   /*=====================================================*/   /* Check for the correct number and type of arguments. */   /*=====================================================*/   if (EnvArgCountCheck(theEnv,execStatus,"set-class-defaults-mode",EXACTLY,1) == -1)     { return((SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv,execStatus)))); }   if (EnvArgTypeCheck(theEnv,execStatus,"set-class-defaults-mode",1,SYMBOL,&argPtr) == FALSE)     { return((SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv,execStatus)))); }   argument = DOToString(argPtr);   /*=============================================*/   /* Set the strategy to the specified strategy. */   /*=============================================*/   if (strcmp(argument,"conservation") == 0)     { EnvSetClassDefaultsMode(theEnv,execStatus,CONSERVATION_MODE); }   else if (strcmp(argument,"convenience") == 0)     { EnvSetClassDefaultsMode(theEnv,execStatus,CONVENIENCE_MODE); }   else     {      ExpectedTypeError1(theEnv,execStatus,"set-class-defaults-mode",1,      "symbol with value conservation or convenience");      return((SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv,execStatus))));     }   /*===================================*/   /* Return the old value of the mode. */   /*===================================*/   return((SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,GetClassDefaultsModeName(oldMode)));  }

globle void StringToField(  void *theEnv,  char *theString,  DATA_OBJECT *returnValue)  {   struct token theToken;   /*====================================*/   /* Open the string as an input source */   /* and retrieve the first value.      */   /*====================================*/   OpenStringSource(theEnv,"string-to-field-str",theString,0);   GetToken(theEnv,"string-to-field-str",&theToken);   CloseStringSource(theEnv,"string-to-field-str");   /*====================================================*/   /* Copy the token to the return value data structure. */   /*====================================================*/   returnValue->type = theToken.type;   if ((theToken.type == FLOAT) || (theToken.type == STRING) ||#if OBJECT_SYSTEM       (theToken.type == INSTANCE_NAME) ||#endif       (theToken.type == SYMBOL) || (theToken.type == INTEGER))     { returnValue->value = theToken.value; }   else if (theToken.type == STOP)     {      returnValue->type = SYMBOL;      returnValue->value = (void *) EnvAddSymbol(theEnv,"EOF");     }   else if (theToken.type == UNKNOWN_VALUE)     {      returnValue->type = STRING;      returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***");     }   else     {      returnValue->type = STRING;      returnValue->value = (void *) EnvAddSymbol(theEnv,theToken.printForm);     }  }

/********************************************************************  NAME         : GetFunctionRestrictions  DESCRIPTION  : Gets DefineFunction2() restriction list for function  INPUTS       : None  RETURNS      : A string containing the function restriction codes  SIDE EFFECTS : EvaluationError set on errors  NOTES        : None ********************************************************************/globle void *GetFunctionRestrictions(    void *theEnv){    DATA_OBJECT temp;    struct FunctionDefinition *fptr;    if (EnvArgTypeCheck(theEnv,"get-function-restrictions",1,SYMBOL,&temp) == FALSE)        return((SYMBOL_HN *) EnvAddSymbol(theEnv,""));    fptr = FindFunction(theEnv,DOToString(temp));    if (fptr == NULL)    {        CantFindItemErrorMessage(theEnv,"function",DOToString(temp));        SetEvaluationError(theEnv,TRUE);        return((SYMBOL_HN *) EnvAddSymbol(theEnv,""));    }    if (fptr->restrictions == NULL)        return((SYMBOL_HN *) EnvAddSymbol(theEnv,"0**"));    return((SYMBOL_HN *) EnvAddSymbol(theEnv,fptr->restrictions));}

globle SYMBOL_HN *ExtractModuleName(  void *theEnv,  EXEC_STATUS,  unsigned thePosition,  char *theString)  {   char *newString;   SYMBOL_HN *returnValue;   /*=============================================*/   /* Return NULL if the :: is in a position such */   /* that a module name can't be extracted.      */   /*=============================================*/   if (thePosition <= 1) return(NULL);   /*==========================================*/   /* Allocate storage for a temporary string. */   /*==========================================*/   newString = (char *) gm2(theEnv,execStatus,thePosition);   /*======================================================*/   /* Copy the entire module/construct name to the string. */   /*======================================================*/   genstrncpy(newString,theString,           (STD_SIZE) thePosition - 1);   /*========================================================*/   /* Place an end of string marker where the :: is located. */   /*========================================================*/   newString[thePosition-1] = EOS;   /*=====================================================*/   /* Add the module name (the truncated module/construct */   /* name) to the symbol table.                          */   /*=====================================================*/   returnValue = (SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,newString);   /*=============================================*/   /* Return the storage of the temporary string. */   /*=============================================*/   rm(theEnv,execStatus,newString,thePosition);   /*=============================================*/   /* Return a pointer to the module name symbol. */   /*=============================================*/   return(returnValue);  }

static void ClearBload(  void *theEnv)  {   size_t space;   int i;   /*=============================================*/   /* Decrement in use counters for atomic values */   /* contained in the construct headers.         */   /*=============================================*/   for (i = 0; i < DeftemplateBinaryData(theEnv)->NumberOfDeftemplates; i++)     { UnmarkConstructHeader(theEnv,&DeftemplateBinaryData(theEnv)->DeftemplateArray[i].header); }   /*=======================================*/   /* Decrement in use counters for symbols */   /* used as slot names.                   */   /*=======================================*/   for (i = 0; i < DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots; i++)     { DecrementSymbolCount(theEnv,DeftemplateBinaryData(theEnv)->SlotArray[i].slotName); }   /*======================================================================*/   /* Deallocate the space used for the deftemplateModule data structures. */   /*======================================================================*/   space =  DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct deftemplateModule);   if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->ModuleArray,space);   DeftemplateBinaryData(theEnv)->NumberOfTemplateModules = 0;      /*================================================================*/   /* Deallocate the space used for the deftemplate data structures. */   /*================================================================*/   space = DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(struct deftemplate);   if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->DeftemplateArray,space);   DeftemplateBinaryData(theEnv)->NumberOfDeftemplates = 0;      /*=================================================================*/   /* Deallocate the space used for the templateSlot data structures. */   /*=================================================================*/   space =  DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct templateSlot);   if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->SlotArray,space);   DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots = 0;      /*======================================*/   /* Create the initial-fact deftemplate. */   /*======================================*/#if (! BLOAD_ONLY)   CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE);#endif  }

static void ClearDeftemplates(  void *theEnv)  {#if (! RUN_TIME) && (! BLOAD_ONLY)   CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,(char*)"initial-fact"),FALSE);#else#if MAC_MCW || WIN_MCW || MAC_XCD#pragma unused(theEnv)#endif#endif  }

globle void *GetCurrentModuleCommand(  void *theEnv)  {   struct defmodule *theModule;   EnvArgCountCheck(theEnv,"get-current-module",EXACTLY,0);   theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);   if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv));   return((SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(theModule->name)));  }

globle void OldGetConstructList(  void *theEnv,  EXEC_STATUS,  DATA_OBJECT_PTR returnValue,  void *(*nextFunction)(void *,EXEC_STATUS,void *),  char *(*nameFunction)(void *,EXEC_STATUS,void *))  {   void *theConstruct;   unsigned long count = 0;   struct multifield *theList;   /*====================================*/   /* Determine the number of constructs */   /* of the specified type.             */   /*====================================*/   for (theConstruct = (*nextFunction)(theEnv,execStatus,NULL);        theConstruct != NULL;        theConstruct = (*nextFunction)(theEnv,execStatus,theConstruct))     { count++; }   /*===========================*/   /* Create a multifield large */   /* enough to store the list. */   /*===========================*/   SetpType(returnValue,MULTIFIELD);   SetpDOBegin(returnValue,1);   SetpDOEnd(returnValue,(long) count);   theList = (struct multifield *) EnvCreateMultifield(theEnv,execStatus,count);   SetpValue(returnValue,(void *) theList);   /*====================================*/   /* Store the names in the multifield. */   /*====================================*/   for (theConstruct = (*nextFunction)(theEnv,execStatus,NULL), count = 1;        theConstruct != NULL;        theConstruct = (*nextFunction)(theEnv,execStatus,theConstruct), count++)     {      if (execStatus->HaltExecution == TRUE)        {         EnvSetMultifieldErrorValue(theEnv,execStatus,returnValue);         return;        }      SetMFType(theList,count,SYMBOL);      SetMFValue(theList,count,EnvAddSymbol(theEnv,execStatus,(*nameFunction)(theEnv,execStatus,theConstruct)));     }  }