src/clipsrules/core/classini.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*               CLIPS Version 6.24  06/02/06          */
00005    /*                                                     */
00006    /*               CLASS INITIALIZATION MODULE           */
00007    /*******************************************************/
00008 
00009 /**************************************************************/
00010 /* Purpose: Defclass Initialization Routines                  */
00011 /*                                                            */
00012 /* Principal Programmer(s):                                   */
00013 /*      Brian L. Dantes                                       */
00014 /*                                                            */
00015 /* Contributing Programmer(s):                                */
00016 /*                                                            */
00017 /* Revision History:                                          */
00018 /*      6.23: Corrected compilation errors for files          */
00019 /*            generated by constructs-to-c. DR0861            */
00020 /*                                                            */
00021 /*      6.24: Added allowed-classes slot facet.               */
00022 /*                                                            */
00023 /*            Converted INSTANCE_PATTERN_MATCHING to          */
00024 /*            DEFRULE_CONSTRUCT.                              */
00025 /*                                                            */
00026 /*            Corrected code to remove run-time program       */
00027 /*            compiler warning.                               */
00028 /*                                                            */
00029 /**************************************************************/
00030 
00031 /* =========================================
00032    *****************************************
00033                EXTERNAL DEFINITIONS
00034    =========================================
00035    ***************************************** */
00036 #include "setup.h"
00037 
00038 #if OBJECT_SYSTEM
00039 
00040 #ifndef _STDIO_INCLUDED_
00041 #define _STDIO_INCLUDED_
00042 #include <stdio.h>
00043 #endif
00044 
00045 #include "classcom.h"
00046 #include "classexm.h"
00047 #include "classfun.h"
00048 #include "classinf.h"
00049 #include "classpsr.h"
00050 #include "cstrccom.h"
00051 #include "cstrcpsr.h"
00052 #include "envrnmnt.h"
00053 #include "extnfunc.h"
00054 #include "inscom.h"
00055 #include "memalloc.h"
00056 #include "modulpsr.h"
00057 #include "modulutl.h"
00058 #include "msgcom.h"
00059 #include "watch.h"
00060 
00061 #if DEFINSTANCES_CONSTRUCT
00062 #include "defins.h"
00063 #endif
00064 
00065 #if INSTANCE_SET_QUERIES
00066 #include "insquery.h"
00067 #endif
00068 
00069 #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
00070 #include "bload.h"
00071 #include "objbin.h"
00072 #endif
00073 
00074 #if CONSTRUCT_COMPILER && (! RUN_TIME)
00075 #include "objcmp.h"
00076 #endif
00077 
00078 #if DEFRULE_CONSTRUCT
00079 #include "objrtbld.h"
00080 #include "objrtfnx.h"
00081 #include "objrtmch.h"
00082 #endif
00083 
00084 #if RUN_TIME
00085 #include "insfun.h"
00086 #include "msgfun.h"
00087 #endif
00088 
00089 #include "classini.h"
00090 
00091 /* =========================================
00092    *****************************************
00093                    CONSTANTS
00094    =========================================
00095    ***************************************** */
00096 #define SUPERCLASS_RLN       "is-a"
00097 #define NAME_RLN             "name"
00098 #define INITIAL_OBJECT_NAME  "initial-object"
00099 
00100 /* =========================================
00101    *****************************************
00102       INTERNALLY VISIBLE FUNCTION HEADERS
00103    =========================================
00104    ***************************************** */
00105 
00106 static void SetupDefclasses(void *);
00107 static void DeallocateDefclassData(void *);
00108 
00109 #if (! RUN_TIME)
00110 static void DestroyDefclassAction(void *,struct constructHeader *,void *);
00111 static DEFCLASS *AddSystemClass(void *,char *,DEFCLASS *);
00112 static void *AllocateModule(void *);
00113 static void  ReturnModule(void *,void *);
00114 #else
00115 static void SearchForHashedPatternNodes(void *,OBJECT_PATTERN_NODE *);
00116 #endif
00117 
00118 #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT
00119 static void UpdateDefclassesScope(void *);
00120 #endif
00121 
00122 /* =========================================
00123    *****************************************
00124           EXTERNALLY VISIBLE FUNCTIONS
00125    =========================================
00126    ***************************************** */
00127 
00128 /**********************************************************
00129   NAME         : SetupObjectSystem
00130   DESCRIPTION  : Initializes all COOL constructs, functions,
00131                    and data structures
00132   INPUTS       : None
00133   RETURNS      : Nothing useful
00134   SIDE EFFECTS : COOL initialized
00135   NOTES        : Order of setup calls is important
00136  **********************************************************/
00137 globle void SetupObjectSystem(
00138   void *theEnv)
00139   {   
00140    ENTITY_RECORD defclassEntityRecord = { "DEFCLASS_PTR", DEFCLASS_PTR,1,0,0,
00141                                               NULL,NULL,NULL,NULL,NULL,
00142                                               DecrementDefclassBusyCount,
00143                                               IncrementDefclassBusyCount,
00144                                               NULL,NULL,NULL,NULL,NULL };
00145 
00146    AllocateEnvironmentData(theEnv,DEFCLASS_DATA,sizeof(struct defclassData),NULL);
00147    AddEnvironmentCleanupFunction(theEnv,"defclasses",DeallocateDefclassData,-500);
00148 
00149    memcpy(&DefclassData(theEnv)->DefclassEntityRecord,&defclassEntityRecord,sizeof(struct entityRecord));   
00150 
00151 #if ! RUN_TIME
00152    DefclassData(theEnv)->ClassDefaultsMode = CONVENIENCE_MODE;
00153    DefclassData(theEnv)->ISA_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SUPERCLASS_RLN);
00154    IncrementSymbolCount(DefclassData(theEnv)->ISA_SYMBOL);
00155    DefclassData(theEnv)->NAME_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,NAME_RLN);
00156    IncrementSymbolCount(DefclassData(theEnv)->NAME_SYMBOL);
00157 #if DEFRULE_CONSTRUCT
00158    DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INITIAL_OBJECT_NAME);
00159    IncrementSymbolCount(DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
00160 #endif
00161 #endif
00162 
00163    SetupDefclasses(theEnv);
00164    SetupInstances(theEnv);
00165    SetupMessageHandlers(theEnv);
00166 
00167 #if DEFINSTANCES_CONSTRUCT
00168    SetupDefinstances(theEnv);
00169 #endif
00170 
00171 #if INSTANCE_SET_QUERIES
00172    SetupQuery(theEnv);
00173 #endif
00174 
00175 #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
00176    SetupObjectsBload(theEnv);
00177 #endif
00178 
00179 #if CONSTRUCT_COMPILER && (! RUN_TIME)
00180    SetupObjectsCompiler(theEnv);
00181 #endif
00182 
00183 #if DEFRULE_CONSTRUCT
00184    SetupObjectPatternStuff(theEnv);
00185 #endif
00186   }
00187   
00188 /***************************************************/
00189 /* DeallocateDefclassData: Deallocates environment */
00190 /*    data for the defclass construct.             */
00191 /***************************************************/
00192 static void DeallocateDefclassData(
00193   void *theEnv)
00194   {
00195 #if ! RUN_TIME   
00196    SLOT_NAME *tmpSNPPtr, *nextSNPPtr;
00197    int i;
00198    struct defclassModule *theModuleItem;
00199    void *theModule;
00200    int bloaded = FALSE;
00201    
00202 #if BLOAD || BLOAD_AND_BSAVE
00203    if (Bloaded(theEnv)) bloaded = TRUE;
00204 #endif
00205 
00206    /*=============================*/
00207    /* Destroy all the defclasses. */
00208    /*=============================*/
00209    
00210    if (! bloaded)
00211      {
00212       DoForAllConstructs(theEnv,DestroyDefclassAction,DefclassData(theEnv)->DefclassModuleIndex,FALSE,NULL); 
00213 
00214       for (theModule = EnvGetNextDefmodule(theEnv,NULL);
00215            theModule != NULL;
00216            theModule = EnvGetNextDefmodule(theEnv,theModule))
00217         {
00218          theModuleItem = (struct defclassModule *)
00219                          GetModuleItem(theEnv,(struct defmodule *) theModule,
00220                                        DefclassData(theEnv)->DefclassModuleIndex);
00221          rtn_struct(theEnv,defclassModule,theModuleItem);
00222         }
00223      }
00224 
00225    /*==========================*/
00226    /* Remove the class tables. */
00227    /*==========================*/
00228    
00229    if (! bloaded)
00230      {
00231       if (DefclassData(theEnv)->ClassIDMap != NULL)
00232         {
00233          genfree(theEnv,DefclassData(theEnv)->ClassIDMap,DefclassData(theEnv)->AvailClassID * sizeof(DEFCLASS *));
00234         }
00235      }
00236      
00237    if (DefclassData(theEnv)->ClassTable != NULL)
00238      {
00239       genfree(theEnv,DefclassData(theEnv)->ClassTable,sizeof(DEFCLASS *) * CLASS_TABLE_HASH_SIZE);
00240      }
00241 
00242    /*==============================*/
00243    /* Free up the slot name table. */
00244    /*==============================*/
00245 
00246    if (! bloaded)
00247      {
00248       for (i = 0; i < SLOT_NAME_TABLE_HASH_SIZE; i++)
00249         {
00250          tmpSNPPtr = DefclassData(theEnv)->SlotNameTable[i];
00251       
00252          while (tmpSNPPtr != NULL)
00253            {
00254             nextSNPPtr = tmpSNPPtr->nxt;
00255             rtn_struct(theEnv,slotName,tmpSNPPtr);
00256             tmpSNPPtr = nextSNPPtr;
00257            }
00258         }
00259      }
00260           
00261    if (DefclassData(theEnv)->SlotNameTable != NULL)
00262      {
00263       genfree(theEnv,DefclassData(theEnv)->SlotNameTable,sizeof(SLOT_NAME *) * SLOT_NAME_TABLE_HASH_SIZE);
00264      }
00265 #else
00266    DEFCLASS *cls;
00267    void *tmpexp;
00268    register unsigned int i;
00269    register int j;
00270    
00271    if (DefclassData(theEnv)->ClassTable != NULL)
00272      {
00273       for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
00274         for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
00275           {
00276            for (i = 0 ; i < cls->slotCount ; i++)
00277              {
00278               if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
00279                 {
00280                  tmpexp = ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo;
00281                  rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue);
00282                  cls->slots[i].defaultValue = tmpexp;
00283                 }
00284              }
00285           }
00286      }
00287 #endif
00288   }
00289   
00290 #if ! RUN_TIME
00291 /*********************************************************/
00292 /* DestroyDefclassAction: Action used to remove defclass */
00293 /*   as a result of DestroyEnvironment.                  */
00294 /*********************************************************/
00295 #if WIN_BTC
00296 #pragma argsused
00297 #endif
00298 static void DestroyDefclassAction(
00299   void *theEnv,
00300   struct constructHeader *theConstruct,
00301   void *buffer)
00302   {
00303 #if MAC_MCW || WIN_MCW || MAC_XCD
00304 #pragma unused(buffer)
00305 #endif
00306    struct defclass *theDefclass = (struct defclass *) theConstruct;
00307 
00308    if (theDefclass == NULL) return;
00309 
00310 #if (! BLOAD_ONLY) 
00311    DestroyDefclass(theEnv,theDefclass);
00312 #else
00313 #if MAC_MCW || WIN_MCW || MAC_XCD
00314 #pragma unused(theEnv)
00315 #endif
00316 #endif
00317   }
00318 #endif
00319 
00320 #if RUN_TIME
00321 
00322 /***************************************************
00323   NAME         : ObjectsRunTimeInitialize
00324   DESCRIPTION  : Initializes objects system lists
00325                    in a run-time module
00326   INPUTS       : 1) Pointer to new class hash table
00327                  2) Pointer to new slot name table
00328   RETURNS      : Nothing useful
00329   SIDE EFFECTS : Global pointers set
00330   NOTES        : None
00331  ***************************************************/
00332 globle void ObjectsRunTimeInitialize(
00333   void *theEnv,
00334   DEFCLASS *ctable[],
00335   SLOT_NAME *sntable[],
00336   DEFCLASS **cidmap,
00337   unsigned mid)
00338   {
00339    DEFCLASS *cls;
00340    void *tmpexp;
00341    register unsigned int i,j;
00342 
00343    if (DefclassData(theEnv)->ClassTable != NULL)
00344      {
00345       for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
00346         for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
00347           {
00348            for (i = 0 ; i < cls->slotCount ; i++)
00349              {
00350               /* =====================================================================
00351                  For static default values, the data object value needs to deinstalled
00352                  and deallocated, and the expression needs to be restored (which was
00353                  temporarily stored in the supplementalInfo field of the data object)
00354                  ===================================================================== */
00355               if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
00356                 {
00357                  tmpexp = ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo;
00358                  ValueDeinstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
00359                  rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue);
00360                  cls->slots[i].defaultValue = tmpexp;
00361                 }
00362              }
00363           }
00364      }
00365 
00366    InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING);
00367    MessageHandlerData(theEnv)->INIT_SYMBOL = FindSymbolHN(theEnv,INIT_STRING);
00368    MessageHandlerData(theEnv)->DELETE_SYMBOL = FindSymbolHN(theEnv,DELETE_STRING);
00369    MessageHandlerData(theEnv)->CREATE_SYMBOL = FindSymbolHN(theEnv,CREATE_STRING);
00370    DefclassData(theEnv)->ISA_SYMBOL = FindSymbolHN(theEnv,SUPERCLASS_RLN);
00371    DefclassData(theEnv)->NAME_SYMBOL = FindSymbolHN(theEnv,NAME_RLN);
00372 #if DEFRULE_CONSTRUCT
00373    DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = FindSymbolHN(theEnv,INITIAL_OBJECT_NAME);
00374 #endif
00375 
00376    DefclassData(theEnv)->ClassTable = (DEFCLASS **) ctable;
00377    DefclassData(theEnv)->SlotNameTable = (SLOT_NAME **) sntable;
00378    DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) cidmap;
00379    DefclassData(theEnv)->MaxClassID = (unsigned short) mid;
00380    DefclassData(theEnv)->PrimitiveClassMap[FLOAT] =
00381      LookupDefclassByMdlOrScope(theEnv,FLOAT_TYPE_NAME);
00382    DefclassData(theEnv)->PrimitiveClassMap[INTEGER] =
00383      LookupDefclassByMdlOrScope(theEnv,INTEGER_TYPE_NAME);
00384    DefclassData(theEnv)->PrimitiveClassMap[STRING] =
00385      LookupDefclassByMdlOrScope(theEnv,STRING_TYPE_NAME);
00386    DefclassData(theEnv)->PrimitiveClassMap[SYMBOL] =
00387      LookupDefclassByMdlOrScope(theEnv,SYMBOL_TYPE_NAME);
00388    DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD] =
00389      LookupDefclassByMdlOrScope(theEnv,MULTIFIELD_TYPE_NAME);
00390    DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS] =
00391      LookupDefclassByMdlOrScope(theEnv,EXTERNAL_ADDRESS_TYPE_NAME);
00392    DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS] =
00393      LookupDefclassByMdlOrScope(theEnv,FACT_ADDRESS_TYPE_NAME);
00394    DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME] =
00395      LookupDefclassByMdlOrScope(theEnv,INSTANCE_NAME_TYPE_NAME);
00396    DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS] =
00397      LookupDefclassByMdlOrScope(theEnv,INSTANCE_ADDRESS_TYPE_NAME);
00398 
00399    for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
00400      for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
00401      {
00402       for (i = 0 ; i < cls->slotCount ; i++)
00403         {
00404          if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
00405            {
00406             tmpexp = cls->slots[i].defaultValue;
00407             cls->slots[i].defaultValue = (void *) get_struct(theEnv,dataObject);
00408             EvaluateAndStoreInDataObject(theEnv,(int) cls->slots[i].multiple,(EXPRESSION *) tmpexp,
00409                                          (DATA_OBJECT *) cls->slots[i].defaultValue,TRUE);
00410             ValueInstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
00411             ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo = tmpexp;
00412            }
00413         }
00414      }
00415      
00416    SearchForHashedPatternNodes(theEnv,ObjectReteData(theEnv)->ObjectPatternNetworkPointer);
00417   }
00418   
00419 /*******************************************************************/
00420 /* SearchForHashedPatternNodes:    */
00421 /*******************************************************************/
00422 static void SearchForHashedPatternNodes(
00423    void *theEnv,
00424    OBJECT_PATTERN_NODE *theNode)
00425    {
00426     while (theNode != NULL)
00427       {
00428        if ((theNode->lastLevel != NULL) && (theNode->lastLevel->selector))
00429         { AddHashedPatternNode(theEnv,theNode->lastLevel,theNode,theNode->networkTest->type,theNode->networkTest->value); }
00430 
00431        SearchForHashedPatternNodes(theEnv,theNode->nextLevel);
00432       
00433        theNode = theNode->rightNode;
00434       }
00435    }
00436 
00437 #else
00438 
00439 /***************************************************************
00440   NAME         : CreateSystemClasses
00441   DESCRIPTION  : Creates the built-in system classes
00442   INPUTS       : None
00443   RETURNS      : Nothing useful
00444   SIDE EFFECTS : System classes inserted in the
00445                    class hash table
00446   NOTES        : The binary/load save indices for the primitive
00447                    types (integer, float, symbol and string,
00448                    multifield, external-address and fact-address)
00449                    are very important.  Need to be able to refer
00450                    to types with the same index regardless of
00451                    whether the object system is installed or
00452                    not.  Thus, the bsave/blaod indices of these
00453                    classes match their integer codes.
00454                 WARNING!!: Assumes no classes exist yet!
00455  ***************************************************************/
00456 globle void CreateSystemClasses(
00457   void *theEnv)
00458   {
00459    DEFCLASS *user,*any,*primitive,*number,*lexeme,*address,*instance;
00460 #if DEFRULE_CONSTRUCT
00461    DEFCLASS *initialObject;
00462 #endif
00463    
00464    /* ===================================
00465       Add canonical slot name entries for
00466       the is-a and name fields - used for
00467       object patterns
00468       =================================== */
00469    AddSlotName(theEnv,DefclassData(theEnv)->ISA_SYMBOL,ISA_ID,TRUE);
00470    AddSlotName(theEnv,DefclassData(theEnv)->NAME_SYMBOL,NAME_ID,TRUE);
00471 
00472    /* =========================================================
00473       Bsave Indices for non-primitive classes start at 9
00474                Object is 9, Primitive is 10, Number is 11,
00475                Lexeme is 12, Address is 13, and Instance is 14.
00476       because: float = 0, integer = 1, symbol = 2, string = 3,
00477                multifield = 4, and external-address = 5 and
00478                fact-address = 6, instance-adress = 7 and
00479                instance-name = 8.
00480       ========================================================= */
00481    any = AddSystemClass(theEnv,OBJECT_TYPE_NAME,NULL);
00482    primitive = AddSystemClass(theEnv,PRIMITIVE_TYPE_NAME,any);
00483    user = AddSystemClass(theEnv,USER_TYPE_NAME,any);
00484 
00485    number = AddSystemClass(theEnv,NUMBER_TYPE_NAME,primitive);
00486    DefclassData(theEnv)->PrimitiveClassMap[INTEGER] = AddSystemClass(theEnv,INTEGER_TYPE_NAME,number);
00487    DefclassData(theEnv)->PrimitiveClassMap[FLOAT] = AddSystemClass(theEnv,FLOAT_TYPE_NAME,number);
00488    lexeme = AddSystemClass(theEnv,LEXEME_TYPE_NAME,primitive);
00489    DefclassData(theEnv)->PrimitiveClassMap[SYMBOL] = AddSystemClass(theEnv,SYMBOL_TYPE_NAME,lexeme);
00490    DefclassData(theEnv)->PrimitiveClassMap[STRING] = AddSystemClass(theEnv,STRING_TYPE_NAME,lexeme);
00491    DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD] = AddSystemClass(theEnv,MULTIFIELD_TYPE_NAME,primitive);
00492    address = AddSystemClass(theEnv,ADDRESS_TYPE_NAME,primitive);
00493    DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS] = AddSystemClass(theEnv,EXTERNAL_ADDRESS_TYPE_NAME,address);
00494    DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS] = AddSystemClass(theEnv,FACT_ADDRESS_TYPE_NAME,address);
00495    instance = AddSystemClass(theEnv,INSTANCE_TYPE_NAME,primitive);
00496    DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS] = AddSystemClass(theEnv,INSTANCE_ADDRESS_TYPE_NAME,instance);
00497    DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME] = AddSystemClass(theEnv,INSTANCE_NAME_TYPE_NAME,instance);
00498 #if DEFRULE_CONSTRUCT
00499    initialObject = AddSystemClass(theEnv,INITIAL_OBJECT_CLASS_NAME,user);
00500    initialObject->abstract = 0;
00501    initialObject->reactive = 1;
00502 #endif
00503 
00504    /* ================================================================================
00505        INSTANCE-ADDRESS is-a INSTANCE and ADDRESS.  The links between INSTANCE-ADDRESS
00506        and ADDRESS still need to be made.
00507        =============================================================================== */
00508    AddClassLink(theEnv,&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]->directSuperclasses,address,-1);
00509    AddClassLink(theEnv,&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]->allSuperclasses,address,2);
00510    AddClassLink(theEnv,&address->directSubclasses,DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS],-1);
00511 
00512    /* =======================================================================
00513       The order of the class in the list MUST correspond to their type codes!
00514       See CONSTANT.H
00515       ======================================================================= */
00516    AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[FLOAT]);
00517    AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INTEGER]);
00518    AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[SYMBOL]);
00519    AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[STRING]);
00520    AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD]);
00521    AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS]);
00522    AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS]);
00523    AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]);
00524    AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]);
00525    AddConstructToModule((struct constructHeader *) any);
00526    AddConstructToModule((struct constructHeader *) primitive);
00527    AddConstructToModule((struct constructHeader *) number);
00528    AddConstructToModule((struct constructHeader *) lexeme);
00529    AddConstructToModule((struct constructHeader *) address);
00530    AddConstructToModule((struct constructHeader *) instance);
00531    AddConstructToModule((struct constructHeader *) user);
00532 #if DEFRULE_CONSTRUCT
00533    AddConstructToModule((struct constructHeader *) initialObject);
00534 #endif
00535    for (any = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ;
00536         any != NULL ;
00537         any = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) any))
00538      AssignClassID(theEnv,any);
00539   }
00540 
00541 #endif
00542 
00543 /* =========================================
00544    *****************************************
00545           INTERNALLY VISIBLE FUNCTIONS
00546    =========================================
00547    ***************************************** */
00548 
00549 /*********************************************************
00550   NAME         : SetupDefclasses
00551   DESCRIPTION  : Initializes Class Hash Table,
00552                    Function Parsers, and Data Structures
00553   INPUTS       : None
00554   RETURNS      : Nothing useful
00555   SIDE EFFECTS :
00556   NOTES        : None
00557  *********************************************************/
00558 static void SetupDefclasses(
00559   void *theEnv)
00560   {
00561    InstallPrimitive(theEnv,&DefclassData(theEnv)->DefclassEntityRecord,DEFCLASS_PTR);
00562 
00563    DefclassData(theEnv)->DefclassModuleIndex =
00564                 RegisterModuleItem(theEnv,"defclass",
00565 #if (! RUN_TIME)
00566                                     AllocateModule,ReturnModule,
00567 #else
00568                                     NULL,NULL,
00569 #endif
00570 #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
00571                                     BloadDefclassModuleReference,
00572 #else
00573                                     NULL,
00574 #endif
00575 #if CONSTRUCT_COMPILER && (! RUN_TIME)
00576                                     DefclassCModuleReference,
00577 #else
00578                                     NULL,
00579 #endif
00580                                     EnvFindDefclass);
00581 
00582    DefclassData(theEnv)->DefclassConstruct =  AddConstruct(theEnv,"defclass","defclasses",
00583 #if (! BLOAD_ONLY) && (! RUN_TIME)
00584                                      ParseDefclass,
00585 #else
00586                                      NULL,
00587 #endif
00588                                      EnvFindDefclass,
00589                                      GetConstructNamePointer,GetConstructPPForm,
00590                                      GetConstructModuleItem,EnvGetNextDefclass,
00591                                      SetNextConstruct,EnvIsDefclassDeletable,
00592                                      EnvUndefclass,
00593 #if (! RUN_TIME)
00594                                      RemoveDefclass
00595 #else
00596                                      NULL
00597 #endif
00598                                      );
00599 
00600    AddClearReadyFunction(theEnv,"defclass",InstancesPurge,0);
00601 
00602 #if ! RUN_TIME
00603    EnvAddClearFunction(theEnv,"defclass",CreateSystemClasses,0);
00604    InitializeClasses(theEnv);
00605 
00606 #if ! BLOAD_ONLY
00607 #if DEFMODULE_CONSTRUCT
00608    AddPortConstructItem(theEnv,"defclass",SYMBOL);
00609    AddAfterModuleDefinedFunction(theEnv,"defclass",UpdateDefclassesScope,0);
00610 #endif
00611    EnvDefineFunction2(theEnv,"undefclass",'v',PTIEF UndefclassCommand,"UndefclassCommand","11w");
00612 
00613    AddSaveFunction(theEnv,"defclass",SaveDefclasses,10);
00614 #endif
00615 
00616 #if DEBUGGING_FUNCTIONS
00617    EnvDefineFunction2(theEnv,"list-defclasses",'v',PTIEF ListDefclassesCommand,"ListDefclassesCommand","01");
00618    EnvDefineFunction2(theEnv,"ppdefclass",'v',PTIEF PPDefclassCommand,"PPDefclassCommand","11w");
00619    EnvDefineFunction2(theEnv,"describe-class",'v',PTIEF DescribeClassCommand,"DescribeClassCommand","11w");
00620    EnvDefineFunction2(theEnv,"browse-classes",'v',PTIEF BrowseClassesCommand,"BrowseClassesCommand","01w");
00621 #endif
00622 
00623    EnvDefineFunction2(theEnv,"get-defclass-list",'m',PTIEF GetDefclassListFunction,
00624                    "GetDefclassListFunction","01");
00625    EnvDefineFunction2(theEnv,"superclassp",'b',PTIEF SuperclassPCommand,"SuperclassPCommand","22w");
00626    EnvDefineFunction2(theEnv,"subclassp",'b',PTIEF SubclassPCommand,"SubclassPCommand","22w");
00627    EnvDefineFunction2(theEnv,"class-existp",'b',PTIEF ClassExistPCommand,"ClassExistPCommand","11w");
00628    EnvDefineFunction2(theEnv,"message-handler-existp",'b',
00629                    PTIEF MessageHandlerExistPCommand,"MessageHandlerExistPCommand","23w");
00630    EnvDefineFunction2(theEnv,"class-abstractp",'b',PTIEF ClassAbstractPCommand,"ClassAbstractPCommand","11w");
00631 #if DEFRULE_CONSTRUCT
00632    EnvDefineFunction2(theEnv,"class-reactivep",'b',PTIEF ClassReactivePCommand,"ClassReactivePCommand","11w");
00633 #endif
00634    EnvDefineFunction2(theEnv,"class-slots",'m',PTIEF ClassSlotsCommand,"ClassSlotsCommand","12w");
00635    EnvDefineFunction2(theEnv,"class-superclasses",'m',
00636                    PTIEF ClassSuperclassesCommand,"ClassSuperclassesCommand","12w");
00637    EnvDefineFunction2(theEnv,"class-subclasses",'m',
00638                    PTIEF ClassSubclassesCommand,"ClassSubclassesCommand","12w");
00639    EnvDefineFunction2(theEnv,"get-defmessage-handler-list",'m',
00640                    PTIEF GetDefmessageHandlersListCmd,"GetDefmessageHandlersListCmd","02w");
00641    EnvDefineFunction2(theEnv,"slot-existp",'b',PTIEF SlotExistPCommand,"SlotExistPCommand","23w");
00642    EnvDefineFunction2(theEnv,"slot-facets",'m',PTIEF SlotFacetsCommand,"SlotFacetsCommand","22w");
00643    EnvDefineFunction2(theEnv,"slot-sources",'m',PTIEF SlotSourcesCommand,"SlotSourcesCommand","22w");
00644    EnvDefineFunction2(theEnv,"slot-types",'m',PTIEF SlotTypesCommand,"SlotTypesCommand","22w");
00645    EnvDefineFunction2(theEnv,"slot-allowed-values",'m',PTIEF SlotAllowedValuesCommand,"SlotAllowedValuesCommand","22w");
00646    EnvDefineFunction2(theEnv,"slot-allowed-classes",'m',PTIEF SlotAllowedClassesCommand,"SlotAllowedClassesCommand","22w");
00647    EnvDefineFunction2(theEnv,"slot-range",'m',PTIEF SlotRangeCommand,"SlotRangeCommand","22w");
00648    EnvDefineFunction2(theEnv,"slot-cardinality",'m',PTIEF SlotCardinalityCommand,"SlotCardinalityCommand","22w");
00649    EnvDefineFunction2(theEnv,"slot-writablep",'b',PTIEF SlotWritablePCommand,"SlotWritablePCommand","22w");
00650    EnvDefineFunction2(theEnv,"slot-initablep",'b',PTIEF SlotInitablePCommand,"SlotInitablePCommand","22w");
00651    EnvDefineFunction2(theEnv,"slot-publicp",'b',PTIEF SlotPublicPCommand,"SlotPublicPCommand","22w");
00652    EnvDefineFunction2(theEnv,"slot-direct-accessp",'b',PTIEF SlotDirectAccessPCommand,
00653                    "SlotDirectAccessPCommand","22w");
00654    EnvDefineFunction2(theEnv,"slot-default-value",'u',PTIEF SlotDefaultValueCommand,
00655                    "SlotDefaultValueCommand","22w");
00656    EnvDefineFunction2(theEnv,"defclass-module",'w',PTIEF GetDefclassModuleCommand,
00657                    "GetDefclassModuleCommand","11w");
00658    EnvDefineFunction2(theEnv,"get-class-defaults-mode", 'w', PTIEF GetClassDefaultsModeCommand,  "GetClassDefaultsModeCommand", "00");
00659    EnvDefineFunction2(theEnv,"set-class-defaults-mode", 'w', PTIEF SetClassDefaultsModeCommand,  "SetClassDefaultsModeCommand", "11w");
00660 #endif
00661 
00662 #if DEBUGGING_FUNCTIONS
00663    AddWatchItem(theEnv,"instances",0,&DefclassData(theEnv)->WatchInstances,75,DefclassWatchAccess,DefclassWatchPrint);
00664    AddWatchItem(theEnv,"slots",1,&DefclassData(theEnv)->WatchSlots,74,DefclassWatchAccess,DefclassWatchPrint);
00665 #endif
00666   }
00667 
00668 #if (! RUN_TIME)
00669 
00670 /*********************************************************
00671   NAME         : AddSystemClass
00672   DESCRIPTION  : Performs all necessary allocations
00673                    for adding a system class
00674   INPUTS       : 1) The name-string of the system class
00675                  2) The address of the parent class
00676                     (NULL if none)
00677   RETURNS      : The address of the new system class
00678   SIDE EFFECTS : Allocations performed
00679   NOTES        : Assumes system-class name is unique
00680                  Also assumes SINGLE INHERITANCE for
00681                    system classes to simplify precedence
00682                    list determination
00683                  Adds classes to has table but NOT to
00684                   class list (this is responsibility
00685                   of caller)
00686  *********************************************************/
00687 static DEFCLASS *AddSystemClass(
00688   void *theEnv,
00689   char *name,
00690   DEFCLASS *parent)
00691   {
00692    DEFCLASS *sys;
00693    long i;
00694    char defaultScopeMap[1];
00695 
00696    sys = NewClass(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,name));
00697    sys->abstract = 1;
00698 #if DEFRULE_CONSTRUCT
00699    sys->reactive = 0;
00700 #endif
00701    IncrementSymbolCount(sys->header.name);
00702    sys->installed = 1;
00703    sys->system = 1;
00704    sys->hashTableIndex = HashClass(sys->header.name);
00705 
00706    AddClassLink(theEnv,&sys->allSuperclasses,sys,-1);
00707    if (parent != NULL)
00708      {
00709       AddClassLink(theEnv,&sys->directSuperclasses,parent,-1);
00710       AddClassLink(theEnv,&parent->directSubclasses,sys,-1);
00711       AddClassLink(theEnv,&sys->allSuperclasses,parent,-1);
00712       for (i = 1 ; i < parent->allSuperclasses.classCount ; i++)
00713         AddClassLink(theEnv,&sys->allSuperclasses,parent->allSuperclasses.classArray[i],-1);
00714      }
00715    sys->nxtHash = DefclassData(theEnv)->ClassTable[sys->hashTableIndex];
00716    DefclassData(theEnv)->ClassTable[sys->hashTableIndex] = sys;
00717 
00718    /* =========================================
00719       Add default scope maps for a system class
00720       There is only one module (MAIN) so far -
00721       which has an id of 0
00722       ========================================= */
00723    ClearBitString((void *) defaultScopeMap,(int) sizeof(char));
00724    SetBitMap(defaultScopeMap,0);
00725 #if DEFMODULE_CONSTRUCT
00726    sys->scopeMap = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) defaultScopeMap,(int) sizeof(char));
00727    IncrementBitMapCount(sys->scopeMap);
00728 #endif
00729    return(sys);
00730   }
00731 
00732 /*****************************************************
00733   NAME         : AllocateModule
00734   DESCRIPTION  : Creates and initializes a
00735                  list of deffunctions for a new module
00736   INPUTS       : None
00737   RETURNS      : The new deffunction module
00738   SIDE EFFECTS : Deffunction module created
00739   NOTES        : None
00740  *****************************************************/
00741 static void *AllocateModule(
00742   void *theEnv)
00743   {
00744    return((void *) get_struct(theEnv,defclassModule));
00745   }
00746 
00747 /***************************************************
00748   NAME         : ReturnModule
00749   DESCRIPTION  : Removes a deffunction module and
00750                  all associated deffunctions
00751   INPUTS       : The deffunction module
00752   RETURNS      : Nothing useful
00753   SIDE EFFECTS : Module and deffunctions deleted
00754   NOTES        : None
00755  ***************************************************/
00756 static void ReturnModule(
00757   void *theEnv,
00758   void *theItem)
00759   {
00760    FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefclassData(theEnv)->DefclassConstruct);
00761    DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,ISA_ID));
00762    DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,NAME_ID));
00763    rtn_struct(theEnv,defclassModule,theItem);
00764   }
00765 
00766 #endif
00767 
00768 #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT
00769 
00770 /***************************************************
00771   NAME         : UpdateDefclassesScope
00772   DESCRIPTION  : This function updates the scope
00773                  bitmaps for existing classes when
00774                  a new module is defined
00775   INPUTS       : None
00776   RETURNS      : Nothing
00777   SIDE EFFECTS : Class scope bitmaps are updated
00778   NOTES        : None
00779  ***************************************************/
00780 static void UpdateDefclassesScope(
00781   void *theEnv)
00782   {
00783    register unsigned i;
00784    DEFCLASS *theDefclass;
00785    int newModuleID,count;
00786    char *newScopeMap;
00787    unsigned newScopeMapSize;
00788    char *className;
00789    struct defmodule *matchModule;
00790 
00791    newModuleID = (int) ((struct defmodule *) EnvGetCurrentModule(theEnv))->bsaveID;
00792    newScopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1));
00793    newScopeMap = (char *) gm2(theEnv,newScopeMapSize);
00794    for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++)
00795      for (theDefclass = DefclassData(theEnv)->ClassTable[i] ;
00796           theDefclass != NULL ;
00797           theDefclass = theDefclass->nxtHash)
00798        {
00799         matchModule = theDefclass->header.whichModule->theModule;
00800         className = ValueToString(theDefclass->header.name);
00801         ClearBitString((void *) newScopeMap,newScopeMapSize);
00802         GenCopyMemory(char,theDefclass->scopeMap->size,
00803                    newScopeMap,ValueToBitMap(theDefclass->scopeMap));
00804         DecrementBitMapCount(theEnv,theDefclass->scopeMap);
00805         if (theDefclass->system)
00806           SetBitMap(newScopeMap,newModuleID);
00807         else if (FindImportedConstruct(theEnv,"defclass",matchModule,
00808                                        className,&count,TRUE,NULL) != NULL)
00809           SetBitMap(newScopeMap,newModuleID);
00810         theDefclass->scopeMap = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) newScopeMap,newScopeMapSize);
00811         IncrementBitMapCount(theDefclass->scopeMap);
00812        }
00813    rm(theEnv,(void *) newScopeMap,newScopeMapSize);
00814   }
00815 
00816 #endif
00817 
00818 #endif