C++ ValueToString函数代码示例

static intBool GetVariableDefinition(
  void *theEnv,
  char *readSource,
  int *defglobalError,
  int tokenRead,
  struct token *theToken)
  {
   SYMBOL_HN *variableName;
   struct expr *assignPtr;
   DATA_OBJECT assignValue;

   /*========================================*/
   /* Get next token, which should either be */
   /* a closing parenthesis or a variable.   */
   /*========================================*/

   if (! tokenRead) GetToken(theEnv,readSource,theToken);
   if (theToken->type == RPAREN) return(FALSE);

   if (theToken->type == SF_VARIABLE)
     {
      SyntaxErrorMessage(theEnv,(char*)"defglobal");
      *defglobalError = TRUE;
      return(FALSE);
     }
   else if (theToken->type != GBL_VARIABLE)
     {
      SyntaxErrorMessage(theEnv,(char*)"defglobal");
      *defglobalError = TRUE;
      return(FALSE);
     }

   variableName = (SYMBOL_HN *) theToken->value;

   SavePPBuffer(theEnv,(char*)" ");

   /*================================*/
   /* Print out compilation message. */
   /*================================*/

#if DEBUGGING_FUNCTIONS
   if ((EnvGetWatchItem(theEnv,(char*)"compilations") == ON) && GetPrintWhileLoading(theEnv))
     {
      if (QFindDefglobal(theEnv,variableName) != NULL) 
        {
         PrintWarningID(theEnv,(char*)"CSTRCPSR",1,TRUE);
         EnvPrintRouter(theEnv,WDIALOG,(char*)"Redefining defglobal: ");
        }
      else EnvPrintRouter(theEnv,WDIALOG,(char*)"Defining defglobal: ");
      EnvPrintRouter(theEnv,WDIALOG,ValueToString(variableName));
      EnvPrintRouter(theEnv,WDIALOG,(char*)"\n");
     }
   else
#endif
     { if (GetPrintWhileLoading(theEnv)) EnvPrintRouter(theEnv,WDIALOG,(char*)":"); }

   /*==================================================================*/
   /* Check for import/export conflicts from the construct definition. */
   /*==================================================================*/

#if DEFMODULE_CONSTRUCT
   if (FindImportExportConflict(theEnv,(char*)"defglobal",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(variableName)))
     {
      ImportExportConflictMessage(theEnv,(char*)"defglobal",ValueToString(variableName),NULL,NULL);
      *defglobalError = TRUE;
      return(FALSE);
     }
#endif

   /*==============================*/
   /* The next token must be an =. */
   /*==============================*/

   GetToken(theEnv,readSource,theToken);
   if (strcmp(theToken->printForm,"=") != 0)
     {
      SyntaxErrorMessage(theEnv,(char*)"defglobal");
      *defglobalError = TRUE;
      return(FALSE);
     }

   SavePPBuffer(theEnv,(char*)" ");

   /*======================================================*/
   /* Parse the expression to be assigned to the variable. */
   /*======================================================*/

   assignPtr = ParseAtomOrExpression(theEnv,readSource,NULL);
   if (assignPtr == NULL)
     {
      *defglobalError = TRUE;
      return(FALSE);
     }

   /*==========================*/
   /* Evaluate the expression. */
   /*==========================*/

   if (! ConstructData(theEnv)->CheckSyntaxMode)
     {
//.........这里部分代码省略.........

globle unsigned long HashMultifield(
  struct multifield *theSegment,
  unsigned long theRange)
  {
   unsigned long length, i;
   unsigned long tvalue;
   unsigned long count;
   struct field *fieldPtr;
   union
     {
      double fv;
      void *vv;
      unsigned long liv;
     } fis;
     
   /*================================================*/
   /* Initialize variables for computing hash value. */
   /*================================================*/

   count = 0;
   length = theSegment->multifieldLength;
   fieldPtr = theSegment->theFields;

   /*====================================================*/
   /* Loop through each value in the multifield, compute */
   /* its hash value, and add it to the running total.   */
   /*====================================================*/

   for (i = 0;
        i < length;
        i++)
     {
      switch(fieldPtr[i].type)
         {
          case MULTIFIELD:
            count += HashMultifield((struct multifield *) fieldPtr[i].value,theRange);
            break;

          case FLOAT:
            fis.liv = 0;
            fis.fv = ValueToDouble(fieldPtr[i].value);
            count += (fis.liv * (i + 29))  +
                     (unsigned long) ValueToDouble(fieldPtr[i].value);
            break;

          case INTEGER:
            count += (((unsigned long) ValueToLong(fieldPtr[i].value)) * (i + 29)) +
                      ((unsigned long) ValueToLong(fieldPtr[i].value));
            break;

          case FACT_ADDRESS:
#if OBJECT_SYSTEM
          case INSTANCE_ADDRESS:
#endif
            fis.liv = 0;
            fis.vv = fieldPtr[i].value;
            count += (unsigned long) (fis.liv * (i + 29));
            break;

          case EXTERNAL_ADDRESS:
            fis.liv = 0;
            fis.vv = ValueToExternalAddress(fieldPtr[i].value);
            count += (unsigned long) (fis.liv * (i + 29));
            break;

          case SYMBOL:
          case STRING:
#if OBJECT_SYSTEM
          case INSTANCE_NAME:
#endif
            tvalue = (unsigned long) HashSymbol(ValueToString(fieldPtr[i].value),theRange);
            count += (unsigned long) (tvalue * (i + 29));
            break;
         }
     }

   /*========================*/
   /* Return the hash value. */
   /*========================*/

   return(count);
  }

void *GetFactOrInstanceArgument(
  void *theEnv,
  int thePosition,
  DATA_OBJECT *item,
  char *functionName)
  {
   void *ptr;

   /*==============================*/
   /* Retrieve the first argument. */
   /*==============================*/

   EnvRtnUnknown(theEnv,thePosition,item);

   /*==================================================*/
   /* Fact and instance addresses are valid arguments. */
   /*==================================================*/

   if ((GetpType(item) == FACT_ADDRESS) ||
       (GetpType(item) == INSTANCE_ADDRESS))
     { return(GetpValue(item)); }

   /*==================================================*/
   /* An integer is a valid argument if it corresponds */
   /* to the fact index of an existing fact.           */
   /*==================================================*/

#if DEFTEMPLATE_CONSTRUCT
   else if (GetpType(item) == INTEGER)
     {
      if ((ptr = (void *) FindIndexedFact(theEnv,DOPToLong(item))) == NULL)
        {
         char tempBuffer[20];
         sprintf(tempBuffer,"f-%ld",DOPToLong(item));
         CantFindItemErrorMessage(theEnv,"fact",tempBuffer);
        }
      return(ptr);
     }
#endif

   /*================================================*/
   /* Instance names and symbols are valid arguments */
   /* if they correspond to an existing instance.    */
   /*================================================*/

#if OBJECT_SYSTEM
   else if ((GetpType(item) == INSTANCE_NAME) || (GetpType(item) == SYMBOL))
     {
      if ((ptr = (void *) FindInstanceBySymbol(theEnv,(SYMBOL_HN *) GetpValue(item))) == NULL)
        {
         CantFindItemErrorMessage(theEnv,"instance",ValueToString(GetpValue(item)));
        }
      return(ptr);
     }
#endif

   /*========================================*/
   /* Any other type is an invalid argument. */
   /*========================================*/

   ExpectedTypeError2(theEnv,functionName,thePosition);
   return(NULL);
  }

FString FAIDataProviderValue::ToString() const
{
	return IsDynamic() ? DataBinding->ToString(DataField) : ValueToString();
}

static int FindConstructBeginning(
  void *theEnv,
  char *readSource,
  struct token *theToken,
  int errorCorrection,
  int *noErrors)
  {
   int leftParenthesisFound = FALSE;
   int firstAttempt = TRUE;

   /*===================================================*/
   /* Process tokens until the beginning of a construct */
   /* is found or there are no more tokens.             */
   /*===================================================*/

   while (theToken->type != STOP)
     {
      /*=====================================================*/
      /* Constructs begin with a left parenthesis. Make note */
      /* that the opening parenthesis has been found.        */
      /*=====================================================*/

      if (theToken->type == LPAREN)
        { leftParenthesisFound = TRUE; }

      /*=================================================================*/
      /* The name of the construct follows the opening left parenthesis. */
      /* If it is the name of a valid construct, then return TRUE.       */
      /* Otherwise, reset the flags to look for the beginning of a       */
      /* construct. If error correction is being performed (i.e. the     */
      /* last construct parsed had an error in it), then don't bother to */
      /* print an error message, otherwise, print an error message.      */
      /*=================================================================*/

      else if ((theToken->type == SYMBOL) && (leftParenthesisFound == TRUE))
        {
         /*===========================================================*/
         /* Is this a valid construct name (e.g., defrule, deffacts). */
         /*===========================================================*/

         if (FindConstruct(theEnv,ValueToString(theToken->value)) != NULL) return(TRUE);

         /*===============================================*/
         /* The construct name is invalid. Print an error */
         /* message if one hasn't already been printed.   */
         /*===============================================*/

         if (firstAttempt && (! errorCorrection))
           {
            errorCorrection = TRUE;
            *noErrors = FALSE;
            PrintErrorID(theEnv,"CSTRCPSR",1,TRUE);
            EnvPrintRouter(theEnv,WERROR,"Expected the beginning of a construct.\n");
           }

         /*======================================================*/
         /* Indicate that an error has been found and that we're */
         /* looking for a left parenthesis again.                */
         /*======================================================*/

         firstAttempt = FALSE;
         leftParenthesisFound = FALSE;
        }

      /*====================================================================*/
      /* Any token encountered other than a left parenthesis or a construct */
      /* name following a left parenthesis is illegal. Again, if error      */
      /* correction is in progress, no error message is printed, otherwise, */
      /*  an error message is printed.                                      */
      /*====================================================================*/

      else
        {
         if (firstAttempt && (! errorCorrection))
           {
            errorCorrection = TRUE;
            *noErrors = FALSE;
            PrintErrorID(theEnv,"CSTRCPSR",1,TRUE);
            EnvPrintRouter(theEnv,WERROR,"Expected the beginning of a construct.\n");
           }

         firstAttempt = FALSE;
         leftParenthesisFound = FALSE;
        }

      /*============================================*/
      /* Move on to the next token to be processed. */
      /*============================================*/

      GetToken(theEnv,readSource,theToken);
     }

   /*===================================================================*/
   /* Couldn't find the beginning of a construct, so FALSE is returned. */
   /*===================================================================*/

   return(FALSE);
  }

/****************************************************
  NAME         : AddDeffunction
  DESCRIPTION  : Adds a deffunction to the list of
                 deffunctions
  INPUTS       : 1) The symbolic name
                 2) The action expressions
                 3) The minimum number of arguments
                 4) The maximum number of arguments
                    (can be -1)
                 5) The number of local variables
                 6) A flag indicating if this is
                    a header call so that the
                    deffunction can be recursively
                    called
  RETURNS      : The new deffunction (NULL on errors)
  SIDE EFFECTS : Deffunction structures allocated
  NOTES        : Assumes deffunction is not executing
 ****************************************************/
static DEFFUNCTION *AddDeffunction(
    void *theEnv,
    SYMBOL_HN *name,
    EXPRESSION *actions,
    int min,
    int max,
    int lvars,
    int headerp)
{
    DEFFUNCTION *dfuncPtr;
    unsigned oldbusy;
#if DEBUGGING_FUNCTIONS
    unsigned DFHadWatch = FALSE;
#else
#if MAC_XCD
#pragma unused(headerp)
#endif
#endif

    /*===============================================================*/
    /* If the deffunction doesn't exist, create a new structure to   */
    /* contain it and add it to the List of deffunctions. Otherwise, */
    /* use the existing structure and remove the pretty print form   */
    /* and interpretive code.                                        */
    /*===============================================================*/
    dfuncPtr = (DEFFUNCTION *) EnvFindDeffunctionInModule(theEnv,ValueToString(name));
    if (dfuncPtr == NULL)
    {
        dfuncPtr = get_struct(theEnv,deffunctionStruct);
        InitializeConstructHeader(theEnv,"deffunction",(struct constructHeader *) dfuncPtr,name);
        IncrementSymbolCount(name);
        dfuncPtr->code = NULL;
        dfuncPtr->minNumberOfParameters = min;
        dfuncPtr->maxNumberOfParameters = max;
        dfuncPtr->numberOfLocalVars = lvars;
        dfuncPtr->busy = 0;
        dfuncPtr->executing = 0;
    }
    else
    {
#if DEBUGGING_FUNCTIONS
        DFHadWatch = EnvGetDeffunctionWatch(theEnv,(void *) dfuncPtr);
#endif
        dfuncPtr->minNumberOfParameters = min;
        dfuncPtr->maxNumberOfParameters = max;
        dfuncPtr->numberOfLocalVars = lvars;
        oldbusy = dfuncPtr->busy;
        ExpressionDeinstall(theEnv,dfuncPtr->code);
        dfuncPtr->busy = oldbusy;
        ReturnPackedExpression(theEnv,dfuncPtr->code);
        dfuncPtr->code = NULL;
        EnvSetDeffunctionPPForm(theEnv,(void *) dfuncPtr,NULL);

        /* =======================================
           Remove the deffunction from the list so
           that it can be added at the end
           ======================================= */
        RemoveConstructFromModule(theEnv,(struct constructHeader *) dfuncPtr);
    }

    AddConstructToModule((struct constructHeader *) dfuncPtr);

    /* ==================================
       Install the new interpretive code.
       ================================== */

    if (actions != NULL)
    {
        /* ===============================
           If a deffunction is recursive,
           do not increment its busy count
           based on self-references
           =============================== */
        oldbusy = dfuncPtr->busy;
        ExpressionInstall(theEnv,actions);
        dfuncPtr->busy = oldbusy;
        dfuncPtr->code = actions;
    }

    /* ===============================================================
       Install the pretty print form if memory is not being conserved.
       =============================================================== */
//.........这里部分代码省略.........

// DECL: static Scene* load(const char* filePath);
value hx_Scene_static_load(value filePath)
{
    const char *_filePath = ValueToString(filePath);
    return ReferenceToValue(Scene::load(_filePath));
}

static struct templateSlot *ParseSlot(
  void *theEnv,
  char *readSource,
  struct token *inputToken,
  struct templateSlot *slotList)
  {
   int parsingMultislot;
   SYMBOL_HN *slotName;
   struct templateSlot *newSlot;
   int rv;

   /*=====================================================*/
   /* Slots must  begin with keyword field or multifield. */
   /*=====================================================*/

   if ((strcmp(ValueToString(inputToken->value),(char*)"field") != 0) &&
       (strcmp(ValueToString(inputToken->value),(char*)"multifield") != 0) &&
       (strcmp(ValueToString(inputToken->value),(char*)"slot") != 0) &&
       (strcmp(ValueToString(inputToken->value),(char*)"multislot") != 0))
     {
      SyntaxErrorMessage(theEnv,(char*)"deftemplate");
      DeftemplateData(theEnv)->DeftemplateError = TRUE;
      return(NULL);
     }

   /*===============================================*/
   /* Determine if multifield slot is being parsed. */
   /*===============================================*/

   if ((strcmp(ValueToString(inputToken->value),(char*)"multifield") == 0) ||
       (strcmp(ValueToString(inputToken->value),(char*)"multislot") == 0))
     { parsingMultislot = TRUE; }
   else
     { parsingMultislot = FALSE; }

   /*========================================*/
   /* The name of the slot must be a symbol. */
   /*========================================*/

   SavePPBuffer(theEnv,(char*)" ");
   GetToken(theEnv,readSource,inputToken);
   if (inputToken->type != SYMBOL)
     {
      SyntaxErrorMessage(theEnv,(char*)"deftemplate");
      DeftemplateData(theEnv)->DeftemplateError = TRUE;
      return(NULL);
     }

   slotName = (SYMBOL_HN *) inputToken->value;

   /*================================================*/
   /* Determine if the slot has already been parsed. */
   /*================================================*/

   while (slotList != NULL)
     {
      if (slotList->slotName == slotName)
        {
         AlreadyParsedErrorMessage(theEnv,(char*)"slot ",ValueToString(slotList->slotName));
         DeftemplateData(theEnv)->DeftemplateError = TRUE;
         return(NULL);
        }

      slotList = slotList->next;
     }

   /*===================================*/
   /* Parse the attributes of the slot. */
   /*===================================*/

   newSlot = DefinedSlots(theEnv,readSource,slotName,parsingMultislot,inputToken);
   if (newSlot == NULL)
     {
      DeftemplateData(theEnv)->DeftemplateError = TRUE;
      return(NULL);
     }

   /*=================================*/
   /* Check for slot conflict errors. */
   /*=================================*/

   if (CheckConstraintParseConflicts(theEnv,newSlot->constraints) == FALSE)
     {
      ReturnSlots(theEnv,newSlot);
      DeftemplateData(theEnv)->DeftemplateError = TRUE;
      return(NULL);
     }

   if ((newSlot->defaultPresent) || (newSlot->defaultDynamic))
     { rv = ConstraintCheckExpressionChain(theEnv,newSlot->defaultList,newSlot->constraints); }
   else
     { rv = NO_VIOLATION; }

   if ((rv != NO_VIOLATION) && EnvGetStaticConstraintChecking(theEnv))
     {
      char *temp;
      if (newSlot->defaultDynamic) temp = (char*)"the default-dynamic attribute";
      else temp = (char*)"the default attribute";
      ConstraintViolationErrorMessage(theEnv,(char*)"An expression",temp,FALSE,0,
                                      newSlot->slotName,0,rv,newSlot->constraints,TRUE);
//.........这里部分代码省略.........

static struct templateSlot *DefinedSlots(
  void *theEnv,
  char *readSource,
  SYMBOL_HN *slotName,
  int multifieldSlot,
  struct token *inputToken)
  {
   struct templateSlot *newSlot;
   struct expr *defaultList;
   int defaultFound = FALSE;
   int noneSpecified, deriveSpecified;
   CONSTRAINT_PARSE_RECORD parsedConstraints;

   /*===========================*/
   /* Build the slot container. */
   /*===========================*/

   newSlot = get_struct(theEnv,templateSlot);
   newSlot->slotName = slotName;
   newSlot->defaultList = NULL;
   newSlot->facetList = NULL;
   newSlot->constraints = GetConstraintRecord(theEnv);
   if (multifieldSlot)
     { newSlot->constraints->multifieldsAllowed = TRUE; }
   newSlot->multislot = multifieldSlot;
   newSlot->noDefault = FALSE;
   newSlot->defaultPresent = FALSE;
   newSlot->defaultDynamic = FALSE;
   newSlot->next = NULL;

   /*========================================*/
   /* Parse the primitive slot if it exists. */
   /*========================================*/

   InitializeConstraintParseRecord(&parsedConstraints);
   GetToken(theEnv,readSource,inputToken);

   while (inputToken->type != RPAREN)
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv,(char*)" ");
      SavePPBuffer(theEnv,inputToken->printForm);

      /*================================================*/
      /* Slot attributes begin with a left parenthesis. */
      /*================================================*/

      if (inputToken->type != LPAREN)
        {
         SyntaxErrorMessage(theEnv,(char*)"deftemplate");
         ReturnSlots(theEnv,newSlot);
         DeftemplateData(theEnv)->DeftemplateError = TRUE;
         return(NULL);
        }

      /*=============================================*/
      /* The name of the attribute must be a symbol. */
      /*=============================================*/

      GetToken(theEnv,readSource,inputToken);
      if (inputToken->type != SYMBOL)
        {
         SyntaxErrorMessage(theEnv,(char*)"deftemplate");
         ReturnSlots(theEnv,newSlot);
         DeftemplateData(theEnv)->DeftemplateError = TRUE;
         return(NULL);
        }

      /*================================================================*/
      /* Determine if the attribute is one of the standard constraints. */
      /*================================================================*/

      if (StandardConstraint(ValueToString(inputToken->value)))
        {
         if (ParseStandardConstraint(theEnv,readSource,(ValueToString(inputToken->value)),
                                     newSlot->constraints,&parsedConstraints,
                                     multifieldSlot) == FALSE)
           {
            DeftemplateData(theEnv)->DeftemplateError = TRUE;
            ReturnSlots(theEnv,newSlot);
            return(NULL);
           }
        }

      /*=================================================*/
      /* else if the attribute is the default attribute, */
      /* then get the default list for this slot.        */
      /*=================================================*/

      else if ((strcmp(ValueToString(inputToken->value),"default") == 0) ||
               (strcmp(ValueToString(inputToken->value),"default-dynamic") == 0))
        {
         /*======================================================*/
         /* Check to see if the default has already been parsed. */
         /*======================================================*/

         if (defaultFound)
           {
            AlreadyParsedErrorMessage(theEnv,(char*)"default attribute",NULL);
            DeftemplateData(theEnv)->DeftemplateError = TRUE;
//.........这里部分代码省略.........

/*****************************************************
  NAME         : PerformMessage
  DESCRIPTION  : Calls core framework for a message
  INPUTS       : 1) Caller's result buffer
                 2) Message argument expressions
                    (including implicit object)
                 3) Message name
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any side-effects of message execution
                    and caller's result buffer set
  NOTES        : None
 *****************************************************/
static void PerformMessage(
  DATA_OBJECT *result,
  EXPRESSION *args,
  SYMBOL_HN *mname)
  {
   int oldce;
   HANDLER_LINK *oldCore;
   DEFCLASS *cls = NULL;
   INSTANCE_TYPE *ins = NULL;
   SYMBOL_HN *oldName;
#if PROFILING_FUNCTIONS
   struct profileFrameInfo profileFrame;
#endif

   result->type = SYMBOL;
   result->value = FalseSymbol;
   EvaluationError = FALSE;
   if (HaltExecution)
     return;
   oldce = ExecutingConstruct();
   SetExecutingConstruct(TRUE);
   oldName = CurrentMessageName;
   CurrentMessageName = mname;
   CurrentEvaluationDepth++;
   PushProcParameters(args,CountArguments(args),
                        ValueToString(CurrentMessageName),"message",
                        UnboundHandlerErr);

   if (EvaluationError)
     {
      CurrentEvaluationDepth--;
      CurrentMessageName = oldName;
      PeriodicCleanup(FALSE,TRUE);
      SetExecutingConstruct(oldce);
      return;
     }

   if (ProcParamArray->type == INSTANCE_ADDRESS)
     {
      ins = (INSTANCE_TYPE *) ProcParamArray->value;
      if (ins->garbage == 1)
        {
         StaleInstanceAddress("send",0);
         SetEvaluationError(TRUE);
        }
      else if (DefclassInScope(ins->cls,(struct defmodule *) GetCurrentModule()) == FALSE)
        NoInstanceError(ValueToString(ins->name),"send");
      else
        {
         cls = ins->cls;
         ins->busy++;
        }
     }
   else if (ProcParamArray->type == INSTANCE_NAME)
     {
      ins = FindInstanceBySymbol((SYMBOL_HN *) ProcParamArray->value);
      if (ins == NULL)
        {
         PrintErrorID("MSGPASS",2,FALSE);
         PrintRouter(WERROR,"No such instance ");
         PrintRouter(WERROR,ValueToString((SYMBOL_HN *) ProcParamArray->value));
         PrintRouter(WERROR," in function send.\n");
         SetEvaluationError(TRUE);
        }
      else
        {
         ProcParamArray->value = (void *) ins;
         ProcParamArray->type = INSTANCE_ADDRESS;
         cls = ins->cls;
         ins->busy++;
        }
     }
   else if ((cls = PrimitiveClassMap[ProcParamArray->type]) == NULL)
     {
      SystemError("MSGPASS",1);
      ExitRouter(EXIT_FAILURE);
     }
   if (EvaluationError)
     {
      PopProcParameters();
      CurrentEvaluationDepth--;
      CurrentMessageName = oldName;
      PeriodicCleanup(FALSE,TRUE);
      SetExecutingConstruct(oldce);
      return;
     }

   oldCore = TopOfCore;
//.........这里部分代码省略.........

globle void PrintAtom(
  void *theEnv,
  char *logicalName,
  int type,
  void *value)
  {
   char buffer[20];

   switch (type)
     {
      case FLOAT:
        PrintFloat(theEnv,logicalName,ValueToDouble(value));
        break;
      case INTEGER:
        PrintLongInteger(theEnv,logicalName,ValueToLong(value));
        break;
      case SYMBOL:
        EnvPrintRouter(theEnv,logicalName,ValueToString(value));
        break;
      case STRING:
        if (PrintUtilityData(theEnv)->PreserveEscapedCharacters)
          { EnvPrintRouter(theEnv,logicalName,StringPrintForm(theEnv,ValueToString(value))); }
        else
          {
           EnvPrintRouter(theEnv,logicalName,"\"");
           EnvPrintRouter(theEnv,logicalName,ValueToString(value));
           EnvPrintRouter(theEnv,logicalName,"\"");
          }
        break;

      case EXTERNAL_ADDRESS:
        if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\"");
        EnvPrintRouter(theEnv,logicalName,"<Pointer-");
        sprintf(buffer,"%p",value);
        EnvPrintRouter(theEnv,logicalName,buffer);
        EnvPrintRouter(theEnv,logicalName,">");
        if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\"");
        break;

#if OBJECT_SYSTEM
      case INSTANCE_NAME:
        EnvPrintRouter(theEnv,logicalName,"[");
        EnvPrintRouter(theEnv,logicalName,ValueToString(value));
        EnvPrintRouter(theEnv,logicalName,"]");
        break;
#endif

      case RVOID:
        break;

      default:
        if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break;
        if (EvaluationData(theEnv)->PrimitivesArray[type]->longPrintFunction == NULL)
          {
           EnvPrintRouter(theEnv,logicalName,"<unknown atom type>");
           break;
          }
        (*EvaluationData(theEnv)->PrimitivesArray[type]->longPrintFunction)(theEnv,logicalName,value);
        break;
     }
  }

/***************************************************
  NAME         : HandlerSlotPutFunction
  DESCRIPTION  : Access function for handling the
                 statically-bound direct slot
                 bindings in message-handlers
  INPUTS       : 1) The bitmap expression
                 2) A data object buffer
  RETURNS      : TRUE if OK, FALSE
                 on errors
  SIDE EFFECTS : Data object buffer gets symbol
                 TRUE and slot is set. On errors,
                 buffer gets symbol FALSE,
                 EvaluationError is set and error
                 messages are printed
  NOTES        : It is possible for a handler
                 (attached to a superclass of
                  the currently active instance)
                 containing these static references
                 to be called for an instance
                 which does not contain the slots
                 (e.g., an instance of a subclass
                  where the original slot was
                  no-inherit or the subclass
                  overrode the original slot)
 ***************************************************/
globle BOOLEAN HandlerSlotPutFunction(
  void *theValue,
  DATA_OBJECT *theResult)
  {
   HANDLER_SLOT_REFERENCE *theReference;
   DEFCLASS *theDefclass;
   INSTANCE_TYPE *theInstance;
   INSTANCE_SLOT *sp;
   unsigned instanceSlotIndex;
   DATA_OBJECT theSetVal;

   theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
   theInstance = (INSTANCE_TYPE *) ProcParamArray[0].value;
   theDefclass = ClassIDMap[theReference->classID];

   if (theInstance->garbage)
     {
      StaleInstanceAddress("for slot put",0);
      theResult->type = SYMBOL;
      theResult->value = FalseSymbol;
      SetEvaluationError(TRUE);
      return(FALSE);
     }

   if (theInstance->cls == theDefclass)
     {
      instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
      sp = theInstance->slotAddresses[instanceSlotIndex - 1];
     }
   else
     {
      if (theReference->slotID > theInstance->cls->maxSlotNameID)
        goto HandlerPutError;
      instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
      if (instanceSlotIndex == 0)
        goto HandlerPutError;
      instanceSlotIndex--;
      sp = theInstance->slotAddresses[instanceSlotIndex];
      if (sp->desc->cls != theDefclass)
        goto HandlerPutError;
     }

   /* =======================================================
      The slot has already been verified not to be read-only.
      However, if it is initialize-only, we need to make sure
      that we are initializing the instance (something we
      could not verify at parse-time)
      ======================================================= */
   if (sp->desc->initializeOnly && (!theInstance->initializeInProgress))
     {
      SlotAccessViolationError(ValueToString(sp->desc->slotName->name),
                               TRUE,(void *) theInstance);
      goto HandlerPutError2;
     }

   /* ======================================
      No arguments means to use the
      special NoParamValue to reset the slot
      to its default value
      ====================================== */
   if (GetFirstArgument())
     {
      if (EvaluateAndStoreInDataObject((int) sp->desc->multiple,
                                       GetFirstArgument(),&theSetVal) == FALSE)
         goto HandlerPutError2;
     }
   else
     {
      SetDOBegin(theSetVal,1);
      SetDOEnd(theSetVal,0);
      SetType(theSetVal,MULTIFIELD);
      SetValue(theSetVal,NoParamValue);
     }
   if (PutSlotValue(theInstance,sp,&theSetVal,theResult,NULL) == FALSE)
      goto HandlerPutError2;
//.........这里部分代码省略.........

/********************************************************
  NAME         : CallNextHandler
  DESCRIPTION  : This function allows around-handlers
                   to execute the rest of the core frame.
                 It also allows primary handlers
                   to execute shadowed primaries.

                 The original handler arguments are
                   left intact.
  INPUTS       : The caller's result-value buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : The core frame is called and any
                   appropriate changes are made when
                   used in an around handler
                   See CallHandlers()
                 But when call-next-handler is called
                   from a primary, the same shadowed
                   primary is called over and over
                   again for repeated calls to
                   call-next-handler.
  NOTES        : H/L Syntax: (call-next-handler) OR
                    (override-next-handler <arg> ...)
 ********************************************************/
globle void CallNextHandler(
  DATA_OBJECT *result)
  {
   EXPRESSION args;
   int overridep;
   HANDLER_LINK *oldNext,*oldCurrent;
#if PROFILING_FUNCTIONS
   struct profileFrameInfo profileFrame;
#endif


   SetpType(result,SYMBOL);
   SetpValue(result,FalseSymbol);
   EvaluationError = FALSE;
   if (HaltExecution)
     return;
   if (NextHandlerAvailable() == FALSE)
     {
      PrintErrorID("MSGPASS",1,FALSE);
      PrintRouter(WERROR,"Shadowed message-handlers not applicable in current context.\n");
      SetEvaluationError(TRUE);
      return;
     }
   if (CurrentExpression->value == (void *) FindFunction("override-next-handler"))
     {
      overridep = 1;
      args.type = (short) ProcParamArray[0].type;
      if (args.type != MULTIFIELD)
        args.value = (void *) ProcParamArray[0].value;
      else
        args.value = (void *) &ProcParamArray[0];
      args.nextArg = GetFirstArgument();
      args.argList = NULL;
      PushProcParameters(&args,CountArguments(&args),
                          ValueToString(CurrentMessageName),"message",
                          UnboundHandlerErr);
      if (EvaluationError)
        {
         ReturnFlag = FALSE;
         return;
        }
     }
   else
     overridep = 0;
   oldNext = NextInCore;
   oldCurrent = CurrentCore;
   if (CurrentCore->hnd->type == MAROUND)
     {
      if (NextInCore->hnd->type == MAROUND)
        {
         CurrentCore = NextInCore;
         NextInCore = NextInCore->nxt;
#if DEBUGGING_FUNCTIONS
         if (CurrentCore->hnd->trace)
           WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE);
#endif
         if (CheckHandlerArgCount())
           {
#if PROFILING_FUNCTIONS
            StartProfile(&profileFrame,
                         &CurrentCore->hnd->usrData,
                         ProfileConstructs);
#endif

            EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule,
                               CurrentCore->hnd->actions,
                               CurrentCore->hnd->localVarCount,
                               result,UnboundHandlerErr);
#if PROFILING_FUNCTIONS
            EndProfile(&profileFrame);
#endif
           }
#if DEBUGGING_FUNCTIONS
         if (CurrentCore->hnd->trace)
           WatchHandler(WTRACE,CurrentCore,END_TRACE);
#endif
        }
//.........这里部分代码省略.........

globle intBool ParseDefglobal(
  void *theEnv,
  char *readSource)
  {
   int defglobalError = FALSE;
#if (MAC_MCW || WIN_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,readSource)
#endif

#if (! RUN_TIME) && (! BLOAD_ONLY)

   struct token theToken;
   int tokenRead = TRUE;
   struct defmodule *theModule;

   /*=====================================*/
   /* Pretty print buffer initialization. */
   /*=====================================*/

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,(char*)"(defglobal ");

   /*=================================================*/
   /* Individual defglobal constructs can't be parsed */
   /* while a binary load is in effect.               */
   /*=================================================*/

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,(char*)"defglobal");
      return(TRUE);
     }
#endif

   /*===========================*/
   /* Look for the module name. */
   /*===========================*/

   GetToken(theEnv,readSource,&theToken);
   if (theToken.type == SYMBOL)
     {
      /*=================================================*/
      /* The optional module name can't contain a module */
      /* separator like other constructs. For example,   */
      /* (defrule X::foo is OK for rules, but the right  */
      /* syntax for defglobals is (defglobal X ?*foo*.   */
      /*=================================================*/

      tokenRead = FALSE;
      if (FindModuleSeparator(ValueToString(theToken.value)))
        {
         SyntaxErrorMessage(theEnv,(char*)"defglobal");
         return(TRUE);
        }

      /*=================================*/
      /* Determine if the module exists. */
      /*=================================*/

      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken.value));
      if (theModule == NULL)
        {
         CantFindItemErrorMessage(theEnv,(char*)"defmodule",ValueToString(theToken.value));
         return(TRUE);
        }

      /*=========================================*/
      /* If the module name was OK, then set the */
      /* current module to the specified module. */
      /*=========================================*/

      SavePPBuffer(theEnv,(char*)" ");
      EnvSetCurrentModule(theEnv,(void *) theModule);
     }

   /*===========================================*/
   /* If the module name wasn't specified, then */
   /* use the current module's name in the      */
   /* defglobal's pretty print representation.  */
   /*===========================================*/

   else
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv))));
      SavePPBuffer(theEnv,(char*)" ");
      SavePPBuffer(theEnv,theToken.printForm);
     }

   /*======================*/
   /* Parse the variables. */
   /*======================*/

   while (GetVariableDefinition(theEnv,readSource,&defglobalError,tokenRead,&theToken))
     {
      tokenRead = FALSE;

//.........这里部分代码省略.........

/***********************************************************************
  NAME         : ParseDefmessageHandler
  DESCRIPTION  : Parses a message-handler for a class of objects
  INPUTS       : The logical name of the input source
  RETURNS      : FALSE if successful parse, TRUE otherwise
  SIDE EFFECTS : Handler allocated and inserted into class
  NOTES        : H/L Syntax:

                 (defmessage-handler <class> <name> [<type>] [<comment>]
                    (<params>)
                    <action>*)

                 <params> ::= <var>* | <var>* $?<name>
 ***********************************************************************/
globle int ParseDefmessageHandler(
  void *theEnv,
  char *readSource)
  {
   DEFCLASS *cls;
   SYMBOL_HN *cname,*mname,*wildcard;
   unsigned mtype = MPRIMARY;
   int min,max,error,lvars;
   EXPRESSION *hndParams,*actions;
   HANDLER *hnd;

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,"(defmessage-handler ");

#if BLOAD || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"defmessage-handler");
      return(TRUE);
     }
#endif
   cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler",
                                      NULL,NULL,"~",TRUE,FALSE,DEFMODULE_CONSTRUCT);
   if (cname == NULL)
     return(TRUE);
   cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname));
   if (cls == NULL)
     {
      PrintErrorID(theEnv,"MSGPSR",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n");
      return(TRUE);
     }
   if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) ||
       (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) ||
       (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0]))
     {
      PrintErrorID(theEnv,"MSGPSR",8,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class ");
      EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls));
      EnvPrintRouter(theEnv,WERROR,".\n");
      return(TRUE);
     }
   if (HandlersExecuting(cls))
     {
      PrintErrorID(theEnv,"MSGPSR",2,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n");
      EnvPrintRouter(theEnv,WERROR,"  other message-handlers for the same class.\n");
      return(TRUE);
     }
   if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
     {
      SyntaxErrorMessage(theEnv,"defmessage-handler");
      return(TRUE);
     }
   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv," ");
   SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
   SavePPBuffer(theEnv," ");
   mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken);
   GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
   if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN)
     {
      SavePPBuffer(theEnv," ");
      if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING)
        {
         if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
           {
            SyntaxErrorMessage(theEnv,"defmessage-handler");
            return(TRUE);
           }
         mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken));
         if (mtype == MERROR)
           return(TRUE);
#if ! IMPERATIVE_MESSAGE_HANDLERS
         if (mtype == MAROUND)
           return(TRUE);
#endif
         GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
         if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING)
           {
            SavePPBuffer(theEnv," ");
            GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
           }
//.........这里部分代码省略.........