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

/*******************************************************  NAME         : PutClassInTable  DESCRIPTION  : Inserts a class in the class hash table  INPUTS       : The class  RETURNS      : Nothing useful  SIDE EFFECTS : Class inserted  NOTES        : None *******************************************************/globle void PutClassInTable(  void *theEnv,  DEFCLASS *cls)  {   cls->hashTableIndex = HashClass(GetDefclassNamePointer((void *) cls));   cls->nxtHash = DefclassData(theEnv)->ClassTable[cls->hashTableIndex];   DefclassData(theEnv)->ClassTable[cls->hashTableIndex] = cls;  }

globle unsigned short EnvSetClassDefaultsMode(  void *theEnv,  unsigned short value)  {   unsigned short ov;   ov = DefclassData(theEnv)->ClassDefaultsMode;   DefclassData(theEnv)->ClassDefaultsMode = value;   return(ov);  }

globle unsigned short EnvSetClassDefaultsMode(  void *theEnv,  EXEC_STATUS,  unsigned short value)  {   unsigned short ov;   ov = DefclassData(theEnv,execStatus)->ClassDefaultsMode;   DefclassData(theEnv,execStatus)->ClassDefaultsMode = value;   return(ov);  }

/***********************************************************************  NAME         : DefclassWatchPrint  DESCRIPTION  : Parses a list of class names passed by                 AddWatchItem() and displays the traces accordingly  INPUTS       : 1) The logical name of the output                 2) A code indicating which trace flag is to be examined                    0 - Watch instance creation/deletion                    1 - Watch slot changes to instances                 3) A list of expressions containing the names                    of the classes for which to examine traces  RETURNS      : TRUE if all OK, FALSE otherwise  SIDE EFFECTS : Watch flags displayed for specified classes  NOTES        : Accessory function for AddWatchItem() ***********************************************************************/globle unsigned DefclassWatchPrint(  void *theEnv,  const char *logName,  int code,  EXPRESSION *argExprs)  {   if (code)     return(ConstructPrintWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,logName,argExprs,                                      EnvGetDefclassWatchSlots,EnvSetDefclassWatchSlots));   else     return(ConstructPrintWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,logName,argExprs,                                      EnvGetDefclassWatchInstances,EnvSetDefclassWatchInstances));  }

/***************************************************  NAME         : InitializeClasses  DESCRIPTION  : Allocates class hash table                 Initializes class hash table                   to all NULL addresses                 Creates system classes  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : Hash table initialized  NOTES        : None ***************************************************/globle void InitializeClasses(  void *theEnv)  {   register int i;   DefclassData(theEnv)->ClassTable =      (DEFCLASS **) gm2(theEnv,(int) (sizeof(DEFCLASS *) * CLASS_TABLE_HASH_SIZE));   for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++)     DefclassData(theEnv)->ClassTable[i] = NULL;   DefclassData(theEnv)->SlotNameTable =      (SLOT_NAME **) gm2(theEnv,(int) (sizeof(SLOT_NAME *) * SLOT_NAME_TABLE_HASH_SIZE));   for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++)     DefclassData(theEnv)->SlotNameTable[i] = NULL;  }

/*********************************************************  NAME         : GetDefclassListFunction  DESCRIPTION  : Groups names of all defclasses into                   a multifield variable  INPUTS       : A data object buffer  RETURNS      : Nothing useful  SIDE EFFECTS : Multifield set to list of classes  NOTES        : None *********************************************************/globle void GetDefclassListFunction(  void *theEnv,  EXEC_STATUS,  DATA_OBJECT_PTR returnValue)  {   GetConstructListFunction(theEnv,execStatus,"get-defclass-list",returnValue,DefclassData(theEnv,execStatus)->DefclassConstruct);  }

/***************************************************  NAME         : UpdateDefclassesScope  DESCRIPTION  : This function updates the scope                 bitmaps for existing classes when                 a new module is defined  INPUTS       : None  RETURNS      : Nothing  SIDE EFFECTS : Class scope bitmaps are updated  NOTES        : None ***************************************************/static void UpdateDefclassesScope(    void *theEnv){    register unsigned i;    DEFCLASS *theDefclass;    int newModuleID,count;    char *newScopeMap;    unsigned newScopeMapSize;    char *className;    struct defmodule *matchModule;    newModuleID = (int) ((struct defmodule *) EnvGetCurrentModule(theEnv))->bsaveID;    newScopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1));    newScopeMap = (char *) gm2(theEnv,newScopeMapSize);    for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++)        for (theDefclass = DefclassData(theEnv)->ClassTable[i] ;                theDefclass != NULL ;                theDefclass = theDefclass->nxtHash)        {            matchModule = theDefclass->header.whichModule->theModule;            className = ValueToString(theDefclass->header.name);            ClearBitString((void *) newScopeMap,newScopeMapSize);            GenCopyMemory(char,theDefclass->scopeMap->size,                          newScopeMap,ValueToBitMap(theDefclass->scopeMap));            DecrementBitMapCount(theEnv,theDefclass->scopeMap);            if (theDefclass->system)                SetBitMap(newScopeMap,newModuleID);            else if (FindImportedConstruct(theEnv,(char*)"defclass",matchModule,                                           className,&count,TRUE,NULL) != NULL)                SetBitMap(newScopeMap,newModuleID);            theDefclass->scopeMap = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) newScopeMap,newScopeMapSize);            IncrementBitMapCount(theDefclass->scopeMap);        }    rm(theEnv,(void *) newScopeMap,newScopeMapSize);}

static EXPRESSION *GenTypeExpression(  void *theEnv,  EXPRESSION *top,  int nonCOOLCode,  int primitiveCode,  char *COOLName)  {#if OBJECT_SYSTEM#if MAC_MCW || IBM_MCW#pragma unused(nonCOOLCode)#endif#endif   EXPRESSION *tmp;#if OBJECT_SYSTEM   if (primitiveCode != -1)     tmp = GenConstant(theEnv,0,(void *) DefclassData(theEnv)->PrimitiveClassMap[primitiveCode]);   else     tmp = GenConstant(theEnv,0,(void *) LookupDefclassByMdlOrScope(theEnv,COOLName));#else   tmp = GenConstant(theEnv,0,EnvAddLong(theEnv,(long) nonCOOLCode));#endif   tmp->nextArg = top;   return(tmp);  }

/*******************************************************************  NAME         : EnvFindDefclass  DESCRIPTION  : Looks up a specified class in the class hash table                 (Only looks in current or specified module)  INPUTS       : The name-string of the class (including module)  RETURNS      : The address of the found class, NULL otherwise  SIDE EFFECTS : None  NOTES        : None ******************************************************************/globle void *EnvFindDefclass( // TBD Needs to look in imported  void *theEnv,  const char *classAndModuleName)  {   SYMBOL_HN *classSymbol = NULL;   DEFCLASS *cls;   struct defmodule *theModule = NULL;   const char *className;   SaveCurrentModule(theEnv);   className = ExtractModuleAndConstructName(theEnv,classAndModuleName);   if (className != NULL)     {      classSymbol = FindSymbolHN(theEnv,ExtractModuleAndConstructName(theEnv,classAndModuleName));      theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));     }   RestoreCurrentModule(theEnv);   if (classSymbol == NULL)     return(NULL);   cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];   while (cls != NULL)     {      if (cls->header.name == classSymbol)        {         if (cls->system || (cls->header.whichModule->theModule == theModule))           return(cls->installed ? (void *) cls : NULL);        }      cls = cls->nxtHash;     }   return(NULL);  }

/***************************************************  NAME         : DetermineRestrictionClass  DESCRIPTION  : Finds the class of an argument in                   the ProcParamArray  INPUTS       : The argument data object  RETURNS      : The class address, NULL if error  SIDE EFFECTS : EvaluationError set on errors  NOTES        : None ***************************************************/static Defclass *DetermineRestrictionClass(  Environment *theEnv,  UDFValue *dobj)  {   Instance *ins;   Defclass *cls;   if (dobj->header->type == INSTANCE_NAME_TYPE)     {      ins = FindInstanceBySymbol(theEnv,dobj->lexemeValue);      cls = (ins != NULL) ? ins->cls : NULL;     }   else if (dobj->header->type == INSTANCE_ADDRESS_TYPE)     {      ins = dobj->instanceValue;      cls = (ins->garbage == 0) ? ins->cls : NULL;     }   else     return(DefclassData(theEnv)->PrimitiveClassMap[dobj->header->type]);   if (cls == NULL)     {      SetEvaluationError(theEnv,true);      PrintErrorID(theEnv,"GENRCEXE",3,false);      WriteString(theEnv,STDERR,"Unable to determine class of ");      WriteUDFValue(theEnv,STDERR,dobj);      WriteString(theEnv,STDERR," in generic function '");      WriteString(theEnv,STDERR,DefgenericName(DefgenericData(theEnv)->CurrentGeneric));      WriteString(theEnv,STDERR,"'./n");     }   return(cls);  }

/***************************************************  NAME         : LookupDefclassByMdlOrScope  DESCRIPTION  : Finds a class anywhere (if module                 is specified) or in current or                 imported modules  INPUTS       : The class name  RETURNS      : The class (NULL if not found)  SIDE EFFECTS : Error message printed on                  ambiguous references  NOTES        : Assumes no two classes of the same                 name are ever in the same scope ***************************************************/globle DEFCLASS *LookupDefclassByMdlOrScope(  void *theEnv,  const char *classAndModuleName)  {   DEFCLASS *cls;   const char *className;   SYMBOL_HN *classSymbol;   struct defmodule *theModule;   if (FindModuleSeparator(classAndModuleName) == FALSE)     return(LookupDefclassInScope(theEnv,classAndModuleName));   SaveCurrentModule(theEnv);   className = ExtractModuleAndConstructName(theEnv,classAndModuleName);   theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));   RestoreCurrentModule(theEnv);   if(className == NULL)     return(NULL);   if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL)     return(NULL);   cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];   while (cls != NULL)     {      if ((cls->header.name == classSymbol) &&          (cls->header.whichModule->theModule == theModule))        return(cls->installed ? cls : NULL);      cls = cls->nxtHash;     }   return(NULL);  }

/***************************************************  NAME         : DetermineRestrictionClass  DESCRIPTION  : Finds the class of an argument in                   the ProcParamArray  INPUTS       : The argument data object  RETURNS      : The class address, NULL if error  SIDE EFFECTS : EvaluationError set on errors  NOTES        : None ***************************************************/static DEFCLASS *DetermineRestrictionClass(  void *theEnv,  DATA_OBJECT *dobj)  {   INSTANCE_TYPE *ins;   DEFCLASS *cls;   if (dobj->type == INSTANCE_NAME)     {      ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) dobj->value);      cls = (ins != NULL) ? ins->cls : NULL;     }   else if (dobj->type == INSTANCE_ADDRESS)     {      ins = (INSTANCE_TYPE *) dobj->value;      cls = (ins->garbage == 0) ? ins->cls : NULL;     }   else     return(DefclassData(theEnv)->PrimitiveClassMap[dobj->type]);   if (cls == NULL)     {      EnvSetEvaluationError(theEnv,true);      PrintErrorID(theEnv,"GENRCEXE",3,false);      EnvPrintRouter(theEnv,WERROR,"Unable to determine class of ");      PrintDataObject(theEnv,WERROR,dobj);      EnvPrintRouter(theEnv,WERROR," in generic function ");      EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric));      EnvPrintRouter(theEnv,WERROR,"./n");     }   return(cls);  }

/************************************************************  NAME         : GetDefclassModuleCommand  DESCRIPTION  : Determines to which module a class belongs  INPUTS       : None  RETURNS      : The symbolic name of the module  SIDE EFFECTS : None  NOTES        : H/L Syntax: (defclass-module <class-name>) ************************************************************/void GetDefclassModuleCommand(  Environment *theEnv,  UDFContext *context,  UDFValue *returnValue)  {   returnValue->value = GetConstructModuleCommand(context,"defclass-module",DefclassData(theEnv)->DefclassConstruct);  }

/***************************************************************  NAME         : EnvGetDefclassList  DESCRIPTION  : Groups all defclass names into                 a multifield list  INPUTS       : 1) A data object buffer to hold                    the multifield result                 2) The module from which to obtain defclasses  RETURNS      : Nothing useful  SIDE EFFECTS : Multifield allocated and filled  NOTES        : External C access ***************************************************************/globle void EnvGetDefclassList(  void *theEnv,  DATA_OBJECT *returnValue,  struct defmodule *theModule)  {   GetConstructList(theEnv,returnValue,DefclassData(theEnv)->DefclassConstruct,theModule);  }

/***************************************************  NAME         : EnvListDefclasses  DESCRIPTION  : Displays all defclass names  INPUTS       : 1) The logical name of the output                 2) The module  RETURNS      : Nothing useful  SIDE EFFECTS : Defclass names printed  NOTES        : C Interface ***************************************************/globle void EnvListDefclasses(  void *theEnv,  const char *logicalName,  struct defmodule *theModule)  {   ListConstruct(theEnv,DefclassData(theEnv)->DefclassConstruct,logicalName,theModule);  }

/********************************************************************************  NAME         : ParseSlotOverrides  DESCRIPTION  : Forms expressions for slot-overrides  INPUTS       : 1) The logical name of the input                 2) Caller's buffer for error flkag  RETURNS      : Address override expressions, NULL                   if none or error.  SIDE EFFECTS : Slot-expression built                 Caller's error flag set  NOTES        : <slot-override> ::= (<slot-name> <value>*)*                 goes to                 <slot-name> --> <dummy-node> --> <slot-name> --> <dummy-node>...                                       |                                       V                               <value-expression> --> <value-expression> --> ...                 Assumes first token has already been scanned ********************************************************************************/globle EXPRESSION *ParseSlotOverrides(  void *theEnv,  const char *readSource,  int *error)  {   EXPRESSION *top = NULL,*bot = NULL,*theExp;   EXPRESSION *theExpNext;   while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN)     {      *error = FALSE;      theExp = ArgumentParse(theEnv,readSource,error);      if (*error == TRUE)        {         ReturnExpression(theEnv,top);         return(NULL);        }      else if (theExp == NULL)        {         SyntaxErrorMessage(theEnv,"slot-override");         *error = TRUE;         ReturnExpression(theEnv,top);         SetEvaluationError(theEnv,TRUE);         return(NULL);        }      theExpNext = GenConstant(theEnv,SYMBOL,EnvTrueSymbol(theEnv));      if (CollectArguments(theEnv,theExpNext,readSource) == NULL)        {         *error = TRUE;         ReturnExpression(theEnv,top);         ReturnExpression(theEnv,theExp);         return(NULL);        }      theExp->nextArg = theExpNext;      if (top == NULL)        top = theExp;      else        bot->nextArg = theExp;      bot = theExp->nextArg;      PPCRAndIndent(theEnv);      GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);     }   PPBackup(theEnv);   PPBackup(theEnv);   SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);   return(top);  }

/***************************************************************  NAME         : EnvGetDefclassList  DESCRIPTION  : Groups all defclass names into                 a multifield list  INPUTS       : 1) A data object buffer to hold                    the multifield result                 2) The module from which to obtain defclasses  RETURNS      : Nothing useful  SIDE EFFECTS : Multifield allocated and filled  NOTES        : External C access ***************************************************************/globle void EnvGetDefclassList(  void *theEnv,  EXEC_STATUS,  DATA_OBJECT *returnValue,  struct defmodule *theModule)  {   GetConstructList(theEnv,execStatus,returnValue,DefclassData(theEnv,execStatus)->DefclassConstruct,theModule);  }

/***************************************************  NAME         : EnvListDefclasses  DESCRIPTION  : Displays all defclass names  INPUTS       : 1) The logical name of the output                 2) The module  RETURNS      : Nothing useful  SIDE EFFECTS : Defclass names printed  NOTES        : C Interface ***************************************************/globle void EnvListDefclasses(  void *theEnv,  EXEC_STATUS,  char *logicalName,  struct defmodule *theModule)  {   ListConstruct(theEnv,execStatus,DefclassData(theEnv,execStatus)->DefclassConstruct,logicalName,theModule);  }

/***************************************************  NAME         : ReturnModule  DESCRIPTION  : Removes a deffunction module and                 all associated deffunctions  INPUTS       : The deffunction module  RETURNS      : Nothing useful  SIDE EFFECTS : Module and deffunctions deleted  NOTES        : None ***************************************************/static void ReturnModule(    void *theEnv,    void *theItem){    FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefclassData(theEnv)->DefclassConstruct);    DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,ISA_ID));    DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,NAME_ID));    rtn_struct(theEnv,defclassModule,theItem);}

/*********************************************************  NAME         : RemoveClassFromTable  DESCRIPTION  : Removes a class from the class hash table  INPUTS       : The class  RETURNS      : Nothing useful  SIDE EFFECTS : Class removed  NOTES        : None *********************************************************/globle void RemoveClassFromTable(  void *theEnv,  DEFCLASS *cls)  {   DEFCLASS *prvhsh,*hshptr;   prvhsh = NULL;   hshptr = DefclassData(theEnv)->ClassTable[cls->hashTableIndex];   while (hshptr != cls)     {      prvhsh = hshptr;      hshptr = hshptr->nxtHash;     }   if (prvhsh == NULL)     DefclassData(theEnv)->ClassTable[cls->hashTableIndex] = cls->nxtHash;   else     prvhsh->nxtHash = cls->nxtHash;  }

/*********************************************************  NAME         : AddSystemClass  DESCRIPTION  : Performs all necessary allocations                   for adding a system class  INPUTS       : 1) The name-string of the system class                 2) The address of the parent class                    (NULL if none)  RETURNS      : The address of the new system class  SIDE EFFECTS : Allocations performed  NOTES        : Assumes system-class name is unique                 Also assumes SINGLE INHERITANCE for                   system classes to simplify precedence                   list determination                 Adds classes to has table but NOT to                  class list (this is responsibility                  of caller) *********************************************************/static DEFCLASS *AddSystemClass(    void *theEnv,    char *name,    DEFCLASS *parent){    DEFCLASS *sys;    long i;    char defaultScopeMap[1];    sys = NewClass(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,name));    sys->abstract = 1;#if DEFRULE_CONSTRUCT    sys->reactive = 0;#endif    IncrementSymbolCount(sys->header.name);    sys->installed = 1;    sys->system = 1;    sys->hashTableIndex = HashClass(sys->header.name);    AddClassLink(theEnv,&sys->allSuperclasses,sys,-1);    if (parent != NULL)    {        AddClassLink(theEnv,&sys->directSuperclasses,parent,-1);        AddClassLink(theEnv,&parent->directSubclasses,sys,-1);        AddClassLink(theEnv,&sys->allSuperclasses,parent,-1);        for (i = 1 ; i < parent->allSuperclasses.classCount ; i++)            AddClassLink(theEnv,&sys->allSuperclasses,parent->allSuperclasses.classArray[i],-1);    }    sys->nxtHash = DefclassData(theEnv)->ClassTable[sys->hashTableIndex];    DefclassData(theEnv)->ClassTable[sys->hashTableIndex] = sys;    /* =========================================       Add default scope maps for a system class       There is only one module (MAIN) so far -       which has an id of 0       ========================================= */    ClearBitString((void *) defaultScopeMap,(int) sizeof(char));    SetBitMap(defaultScopeMap,0);#if DEFMODULE_CONSTRUCT    sys->scopeMap = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) defaultScopeMap,(int) sizeof(char));    IncrementBitMapCount(sys->scopeMap);#endif    return(sys);}

/********************************************************  NAME         : CreateInitialDefinstances  DESCRIPTION  : Makes the initial-object definstances                 structure for creating an initial-object                 which will match default object patterns                 in defrules  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : initial-object definstances created  NOTES        : None ********************************************************/static void CreateInitialDefinstances(  void *theEnv)  {   EXPRESSION *tmp;   DEFINSTANCES *theDefinstances;   theDefinstances = get_struct(theEnv,definstances);   InitializeConstructHeader(theEnv,(char*)"definstances",(struct constructHeader *) theDefinstances,                             DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);   theDefinstances->busy = 0;   tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,(char*)"make-instance"));   tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);   tmp->argList->nextArg =       GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME));   theDefinstances->mkinstance = PackExpression(theEnv,tmp);   ReturnExpression(theEnv,tmp);   IncrementSymbolCount(GetDefinstancesNamePointer((void *) theDefinstances));   ExpressionInstall(theEnv,theDefinstances->mkinstance);   AddConstructToModule((struct constructHeader *) theDefinstances);  }

/**********************************************************  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         : SaveDefclasses  DESCRIPTION  : Prints pretty print form of                   defclasses to specified output  INPUTS       : The  logical name of the output  RETURNS      : Nothing useful  SIDE EFFECTS : None  NOTES        : None ***************************************************/globle void SaveDefclasses(  void *theEnv,  void *theModule,  const char *logName)  {#if DEBUGGING_FUNCTIONS   DoForAllConstructsInModule(theEnv,theModule,SaveDefclass,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) logName);#else#if MAC_XCD#pragma unused(theEnv,theModule,logName)#endif#endif  }

globle void SaveDefclasses(  void *theEnv,  EXEC_STATUS,  void *theModule,  char *logName)  {#if DEBUGGING_FUNCTIONS   DoForAllConstructsInModule(theEnv,execStatus,theModule,SaveDefclass,DefclassData(theEnv,execStatus)->DefclassModuleIndex,FALSE,(void *) logName);#else#if MAC_MCW || WIN_MCW || MAC_XCD#pragma unused(theEnv,execStatus,theModule,logName)#endif#endif  }

/****************************************************  NAME         : LookupDefclassInScope  DESCRIPTION  : Finds a class in current or imported                   modules (module specifier                   is not allowed)  INPUTS       : The class name  RETURNS      : The class (NULL if not found)  SIDE EFFECTS : Error message printed on                  ambiguous references  NOTES        : Assumes no two classes of the same                 name are ever in the same scope ****************************************************/globle DEFCLASS *LookupDefclassInScope(  void *theEnv,  const char *className)  {   DEFCLASS *cls;   SYMBOL_HN *classSymbol;   if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL)     return(NULL);   cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];   while (cls != NULL)     {      if ((cls->header.name == classSymbol) && DefclassInScope(theEnv,cls,NULL))        return(cls->installed ? cls : NULL);      cls = cls->nxtHash;     }   return(NULL);  }

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

/******************************************************  NAME         : LookupDefclassAnywhere  DESCRIPTION  : Finds a class in specified                 (or any) module  INPUTS       : 1) The module (NULL if don't care)                 2) The class name (module specifier                    in name not allowed)  RETURNS      : The class (NULL if not found)  SIDE EFFECTS : None  NOTES        : Does *not* generate an error if                 multiple classes of the same name                 exist as do the other lookup functions ******************************************************/globle DEFCLASS *LookupDefclassAnywhere(  void *theEnv,  struct defmodule *theModule,  const char *className)  {   DEFCLASS *cls;   SYMBOL_HN *classSymbol;   if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL)     return(NULL);   cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];   while (cls != NULL)     {      if ((cls->header.name == classSymbol) &&          ((theModule == NULL) ||           (cls->header.whichModule->theModule == theModule)))        return(cls->installed ? cls : NULL);      cls = cls->nxtHash;     }   return(NULL);  }

/*************************************************************  NAME         : ParseDefinstancesName  DESCRIPTION  : Parses definstance name and optional comment                 and optional "active" keyword  INPUTS       : 1) The logical name of the input source                 2) Buffer to hold flag indicating if                    definstances should cause pattern-matching                    to occur during slot-overrides  RETURNS      : Address of name symbol, or                   NULL if there was an error  SIDE EFFECTS : Token after name or comment is scanned  NOTES        : Assumes "(definstances" has already                   been scanned. *************************************************************/static SYMBOL_HN *ParseDefinstancesName(  void *theEnv,  char *readSource,  int *active)  {   SYMBOL_HN *dname;   *active = FALSE;   dname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,(char*)"definstances",                                      EnvFindDefinstances,EnvUndefinstances,(char*)"@",                                      TRUE,FALSE,TRUE);   if (dname == NULL)     return(NULL);#if DEFRULE_CONSTRUCT   if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? FALSE :       (strcmp(ValueToString(GetValue(DefclassData(theEnv)->ObjectParseToken)),ACTIVE_RLN) == 0))     {      PPBackup(theEnv);      PPBackup(theEnv);      SavePPBuffer(theEnv,(char*)" ");      SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);      PPCRAndIndent(theEnv);      GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);      *active = TRUE;     }#endif   if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING)     {      PPBackup(theEnv);      PPBackup(theEnv);      SavePPBuffer(theEnv,(char*)" ");      SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);      PPCRAndIndent(theEnv);      GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);     }   return(dname);  }