clips-sys 0.4.0

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*            CLIPS Version 6.40  04/03/19             */
   /*                                                     */
   /*               CLASS INITIALIZATION MODULE           */
   /*******************************************************/

/**************************************************************/
/* Purpose: Defclass Initialization Routines                  */
/*                                                            */
/* Principal Programmer(s):                                   */
/*      Brian L. Dantes                                       */
/*                                                            */
/* Contributing Programmer(s):                                */
/*                                                            */
/* Revision History:                                          */
/*                                                            */
/*      6.23: Corrected compilation errors for files          */
/*            generated by constructs-to-c. DR0861            */
/*                                                            */
/*      6.24: Added allowed-classes slot facet.               */
/*                                                            */
/*            Converted INSTANCE_PATTERN_MATCHING to          */
/*            DEFRULE_CONSTRUCT.                              */
/*                                                            */
/*            Corrected code to remove run-time program       */
/*            compiler warning.                               */
/*                                                            */
/*      6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior  */
/*            (MAC_MCW, IBM_MCW) are no longer supported.     */
/*                                                            */
/*            Changed integer type/precision.                 */
/*                                                            */
/*            Support for hashed alpha memories.              */
/*                                                            */
/*            Added const qualifiers to remove C++            */
/*            deprecation warnings.                           */
/*                                                            */
/*            Changed find construct functionality so that    */
/*            imported modules are search when locating a     */
/*            named construct.                                */
/*                                                            */
/*      6.31: Optimization of slot ID creation previously    */
/*            provided by NewSlotNameID function.            */
/*                                                           */
/*            Changed allocation of multifield slot default  */
/*            from ephemeral to explicit deallocation.       */
/*                                                           */
/*      6.40: Pragma once and other inclusion changes.        */
/*                                                            */
/*            Added support for booleans with <stdbool.h>.   */
/*                                                           */
/*            Removed use of void pointers for specific      */
/*            data structures.                               */
/*                                                           */
/*            UDF redesign.                                  */
/*                                                           */
/*            Removed initial-object support.                 */
/*                                                            */
/*            Pretty print functions accept optional logical */
/*            name argument.                                 */
/*                                                           */
/**************************************************************/

/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if OBJECT_SYSTEM

#include <stdio.h>

#include "classcom.h"
#include "classexm.h"
#include "classfun.h"
#include "classinf.h"
#include "classpsr.h"
#include "cstrccom.h"
#include "cstrcpsr.h"
#include "envrnmnt.h"
#include "extnfunc.h"
#include "inscom.h"
#include "memalloc.h"
#include "modulpsr.h"
#include "modulutl.h"
#include "msgcom.h"
#include "watch.h"

#if DEFINSTANCES_CONSTRUCT
#include "defins.h"
#endif

#if INSTANCE_SET_QUERIES
#include "insquery.h"
#endif

#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
#include "bload.h"
#include "objbin.h"
#endif

#if CONSTRUCT_COMPILER && (! RUN_TIME)
#include "objcmp.h"
#endif

#if DEFRULE_CONSTRUCT
#include "objrtbld.h"
#include "objrtfnx.h"
#include "objrtmch.h"
#endif

#if RUN_TIME
#include "insfun.h"
#include "msgfun.h"
#include "pattern.h"
#endif

#include "classini.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */
#define SUPERCLASS_RLN       "is-a"
#define NAME_RLN             "name"

/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */

   static void                    SetupDefclasses(Environment *);
   static void                    DeallocateDefclassData(Environment *);

#if (! RUN_TIME)
   static void                    DestroyDefclassAction(Environment *,ConstructHeader *,void *);
   static Defclass               *AddSystemClass(Environment *,const char *,Defclass *);
   static void                   *AllocateModule(Environment *);
   static void                    ReturnModule(Environment *,void *);
#else
   static void                    SearchForHashedPatternNodes(Environment *,OBJECT_PATTERN_NODE *);
#endif

#if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT
   static void                    UpdateDefclassesScope(Environment *,void *);
#endif

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/**********************************************************
  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
 **********************************************************/
void SetupObjectSystem(
  Environment *theEnv)
  {
   EntityRecord defclassEntityRecord = { "DEFCLASS_PTR", DEFCLASS_PTR,1,0,0,
                                              NULL,NULL,NULL,NULL,NULL,
                                              (EntityBusyCountFunction *) DecrementDefclassBusyCount,
                                              (EntityBusyCountFunction *) IncrementDefclassBusyCount,
                                              NULL,NULL,NULL,NULL,NULL };

   AllocateEnvironmentData(theEnv,DEFCLASS_DATA,sizeof(struct defclassData),NULL);
   AddEnvironmentCleanupFunction(theEnv,"defclasses",DeallocateDefclassData,-500);

   memcpy(&DefclassData(theEnv)->DefclassEntityRecord,&defclassEntityRecord,sizeof(struct entityRecord));

   DefclassData(theEnv)->newSlotID = 2; // IS_A and NAME assigned 0 and 1

#if ! RUN_TIME
   DefclassData(theEnv)->ClassDefaultsModeValue = CONVENIENCE_MODE;
   DefclassData(theEnv)->ISA_SYMBOL = CreateSymbol(theEnv,SUPERCLASS_RLN);
   IncrementLexemeCount(DefclassData(theEnv)->ISA_SYMBOL);
   DefclassData(theEnv)->NAME_SYMBOL = CreateSymbol(theEnv,NAME_RLN);
   IncrementLexemeCount(DefclassData(theEnv)->NAME_SYMBOL);
#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
  }

/***************************************************/
/* DeallocateDefclassData: Deallocates environment */
/*    data for the defclass construct.             */
/***************************************************/
static void DeallocateDefclassData(
  Environment *theEnv)
  {
#if ! RUN_TIME
   SLOT_NAME *tmpSNPPtr, *nextSNPPtr;
   int i;
   struct defclassModule *theModuleItem;
   Defmodule *theModule;
   bool bloaded = false;

#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded(theEnv)) bloaded = true;
#endif

   /*=============================*/
   /* Destroy all the defclasses. */
   /*=============================*/

   if (! bloaded)
     {
      DoForAllConstructs(theEnv,DestroyDefclassAction,DefclassData(theEnv)->DefclassModuleIndex,false,NULL);

      for (theModule = GetNextDefmodule(theEnv,NULL);
           theModule != NULL;
           theModule = GetNextDefmodule(theEnv,theModule))
        {
         theModuleItem = (struct defclassModule *)
                         GetModuleItem(theEnv,theModule,
                                       DefclassData(theEnv)->DefclassModuleIndex);
         rtn_struct(theEnv,defclassModule,theModuleItem);
        }
     }

   /*==========================*/
   /* Remove the class tables. */
   /*==========================*/

   if (! bloaded)
     {
      if (DefclassData(theEnv)->ClassIDMap != NULL)
        {
         genfree(theEnv,DefclassData(theEnv)->ClassIDMap,DefclassData(theEnv)->AvailClassID * sizeof(Defclass *));
        }
     }

   if (DefclassData(theEnv)->ClassTable != NULL)
     {
      genfree(theEnv,DefclassData(theEnv)->ClassTable,sizeof(Defclass *) * CLASS_TABLE_HASH_SIZE);
     }

   /*==============================*/
   /* Free up the slot name table. */
   /*==============================*/

   if (! bloaded)
     {
      for (i = 0; i < SLOT_NAME_TABLE_HASH_SIZE; i++)
        {
         tmpSNPPtr = DefclassData(theEnv)->SlotNameTable[i];

         while (tmpSNPPtr != NULL)
           {
            nextSNPPtr = tmpSNPPtr->nxt;
            rtn_struct(theEnv,slotName,tmpSNPPtr);
            tmpSNPPtr = nextSNPPtr;
           }
        }
     }

   if (DefclassData(theEnv)->SlotNameTable != NULL)
     {
      genfree(theEnv,DefclassData(theEnv)->SlotNameTable,sizeof(SLOT_NAME *) * SLOT_NAME_TABLE_HASH_SIZE);
     }
#else
   Defclass *cls;
   void *tmpexp;
   unsigned int i;
   int j;

   if (DefclassData(theEnv)->ClassTable != NULL)
     {
      for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
        for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
          {
           for (i = 0 ; i < cls->slotCount ; i++)
             {
              if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
                {
                 UDFValue *theValue = (UDFValue *) cls->slots[i].defaultValue;
                 tmpexp = theValue->supplementalInfo;
                 if (theValue->header->type == MULTIFIELD_TYPE)
                   { ReturnMultifield(theEnv,theValue->multifieldValue); }
                 rtn_struct(theEnv,udfValue,cls->slots[i].defaultValue);
                 cls->slots[i].defaultValue = tmpexp;
                }
             }
          }
     }
#endif
  }

#if ! RUN_TIME
/*********************************************************/
/* DestroyDefclassAction: Action used to remove defclass */
/*   as a result of DestroyEnvironment.                  */
/*********************************************************/
static void DestroyDefclassAction(
  Environment *theEnv,
  ConstructHeader *theConstruct,
  void *buffer)
  {
#if MAC_XCD
#pragma unused(buffer)
#endif
   Defclass *theDefclass = (Defclass *) theConstruct;

   if (theDefclass == NULL) return;

#if (! BLOAD_ONLY)
   DestroyDefclass(theEnv,theDefclass);
#else
#if MAC_XCD
#pragma unused(theEnv)
#endif
#endif
  }
#endif

#if RUN_TIME

/***************************************************
  NAME         : ObjectsRunTimeInitialize
  DESCRIPTION  : Initializes objects system lists
                   in a run-time module
  INPUTS       : 1) Pointer to new class hash table
                 2) Pointer to new slot name table
  RETURNS      : Nothing useful
  SIDE EFFECTS : Global pointers set
  NOTES        : None
 ***************************************************/
void ObjectsRunTimeInitialize(
  Environment *theEnv,
  Defclass *ctable[],
  SLOT_NAME *sntable[],
  Defclass **cidmap,
  unsigned short mid)
  {
   Defclass *cls;
   void *tmpexp;
   unsigned int i,j;

   if (DefclassData(theEnv)->ClassTable != NULL)
     {
      for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
        for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
          {
           for (i = 0 ; i < cls->slotCount ; i++)
             {
              /* =====================================================================
                 For static default values, the data object value needs to deinstalled
                 and deallocated, and the expression needs to be restored (which was
                 temporarily stored in the supplementalInfo field of the data object)
                 ===================================================================== */
              if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
                {
                 UDFValue *theValue = (UDFValue *) cls->slots[i].defaultValue;
                 tmpexp = theValue->supplementalInfo;
                 ReleaseUDFV(theEnv,theValue);
                 if (theValue->header->type == MULTIFIELD_TYPE)
                   { ReturnMultifield(theEnv,theValue->multifieldValue); }
                 rtn_struct(theEnv,udfValue,cls->slots[i].defaultValue);
                 cls->slots[i].defaultValue = tmpexp;
                }
             }
          }
     }

   InstanceQueryData(theEnv)->QUERY_DELIMITER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMITER_STRING,SYMBOL_BIT);
   MessageHandlerData(theEnv)->INIT_SYMBOL = FindSymbolHN(theEnv,INIT_STRING,SYMBOL_BIT);
   MessageHandlerData(theEnv)->DELETE_SYMBOL = FindSymbolHN(theEnv,DELETE_STRING,SYMBOL_BIT);
   MessageHandlerData(theEnv)->CREATE_SYMBOL = FindSymbolHN(theEnv,CREATE_STRING,SYMBOL_BIT);
   DefclassData(theEnv)->ISA_SYMBOL = FindSymbolHN(theEnv,SUPERCLASS_RLN,SYMBOL_BIT);
   DefclassData(theEnv)->NAME_SYMBOL = FindSymbolHN(theEnv,NAME_RLN,SYMBOL_BIT);

   DefclassData(theEnv)->ClassTable = (Defclass **) ctable;
   DefclassData(theEnv)->SlotNameTable = (SLOT_NAME **) sntable;
   DefclassData(theEnv)->ClassIDMap = (Defclass **) cidmap;
   DefclassData(theEnv)->MaxClassID = mid;
   DefclassData(theEnv)->PrimitiveClassMap[FLOAT_TYPE] =
     LookupDefclassByMdlOrScope(theEnv,FLOAT_TYPE_NAME);
   DefclassData(theEnv)->PrimitiveClassMap[INTEGER_TYPE] =
     LookupDefclassByMdlOrScope(theEnv,INTEGER_TYPE_NAME);
   DefclassData(theEnv)->PrimitiveClassMap[STRING_TYPE] =
     LookupDefclassByMdlOrScope(theEnv,STRING_TYPE_NAME);
   DefclassData(theEnv)->PrimitiveClassMap[SYMBOL_TYPE] =
     LookupDefclassByMdlOrScope(theEnv,SYMBOL_TYPE_NAME);
   DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD_TYPE] =
     LookupDefclassByMdlOrScope(theEnv,MULTIFIELD_TYPE_NAME);
   DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS_TYPE] =
     LookupDefclassByMdlOrScope(theEnv,EXTERNAL_ADDRESS_TYPE_NAME);
   DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS_TYPE] =
     LookupDefclassByMdlOrScope(theEnv,FACT_ADDRESS_TYPE_NAME);
   DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME_TYPE] =
     LookupDefclassByMdlOrScope(theEnv,INSTANCE_NAME_TYPE_NAME);
   DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS_TYPE] =
     LookupDefclassByMdlOrScope(theEnv,INSTANCE_ADDRESS_TYPE_NAME);

   for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
     for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
     {
      cls->header.env = theEnv;
         
      for (i = 0; i < cls->handlerCount; i++)
        { cls->handlers[i].header.env = theEnv; }

      for (i = 0 ; i < cls->slotCount ; i++)
        {
         if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
           {
            tmpexp = cls->slots[i].defaultValue;
            cls->slots[i].defaultValue = get_struct(theEnv,udfValue);
            EvaluateAndStoreInDataObject(theEnv,cls->slots[i].multiple,(Expression *) tmpexp,
                                         (UDFValue *) cls->slots[i].defaultValue,false);
            RetainUDFV(theEnv,(UDFValue *) cls->slots[i].defaultValue);
            ((UDFValue *) cls->slots[i].defaultValue)->supplementalInfo = tmpexp;
           }
        }
     }

   SearchForHashedPatternNodes(theEnv,ObjectReteData(theEnv)->ObjectPatternNetworkPointer);
  }

/********************************/
/* SearchForHashedPatternNodes: */
/********************************/
static void SearchForHashedPatternNodes(
   Environment *theEnv,
   OBJECT_PATTERN_NODE *theNode)
   {
    while (theNode != NULL)
      {
       if ((theNode->lastLevel != NULL) && (theNode->lastLevel->selector))
        { AddHashedPatternNode(theEnv,theNode->lastLevel,theNode,theNode->networkTest->type,theNode->networkTest->value); }

       SearchForHashedPatternNodes(theEnv,theNode->nextLevel);

       theNode = theNode->rightNode;
      }
   }

#else

/***************************************************************
  NAME         : CreateSystemClasses
  DESCRIPTION  : Creates the built-in system classes
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : System classes inserted in the
                   class hash table
  NOTES        : The binary/load save indices for the primitive
                   types (integer, float, symbol and string,
                   multifield, external-address and fact-address)
                   are very important.  Need to be able to refer
                   to types with the same index regardless of
                   whether the object system is installed or
                   not.  Thus, the bsave/blaod indices of these
                   classes match their integer codes.
                WARNING!!: Assumes no classes exist yet!
 ***************************************************************/
void CreateSystemClasses(
  Environment *theEnv,
  void *context)
  {
   Defclass *user,*any,*primitive,*number,*lexeme,*address,*instance;

   /* ===================================
      Add canonical slot name entries for
      the is-a and name fields - used for
      object patterns
      =================================== */
   AddSlotName(theEnv,DefclassData(theEnv)->ISA_SYMBOL,ISA_ID,true);
   AddSlotName(theEnv,DefclassData(theEnv)->NAME_SYMBOL,NAME_ID,true);
   
   DefclassData(theEnv)->newSlotID = 2; // IS_A and NAME assigned 0 and 1

   /* =========================================================
      Bsave Indices for non-primitive classes start at 9
               Object is 9, Primitive is 10, Number is 11,
               Lexeme is 12, Address is 13, and Instance is 14.
      because: float = 0, integer = 1, symbol = 2, string = 3,
               multifield = 4, and external-address = 5 and
               fact-address = 6, instance-adress = 7 and
               instance-name = 8.
      ========================================================= */
   any = AddSystemClass(theEnv,OBJECT_TYPE_NAME,NULL);
   primitive = AddSystemClass(theEnv,PRIMITIVE_TYPE_NAME,any);
   user = AddSystemClass(theEnv,USER_TYPE_NAME,any);

   number = AddSystemClass(theEnv,NUMBER_TYPE_NAME,primitive);
   DefclassData(theEnv)->PrimitiveClassMap[INTEGER_TYPE] = AddSystemClass(theEnv,INTEGER_TYPE_NAME,number);
   DefclassData(theEnv)->PrimitiveClassMap[FLOAT_TYPE] = AddSystemClass(theEnv,FLOAT_TYPE_NAME,number);
   lexeme = AddSystemClass(theEnv,LEXEME_TYPE_NAME,primitive);
   DefclassData(theEnv)->PrimitiveClassMap[SYMBOL_TYPE] = AddSystemClass(theEnv,SYMBOL_TYPE_NAME,lexeme);
   DefclassData(theEnv)->PrimitiveClassMap[STRING_TYPE] = AddSystemClass(theEnv,STRING_TYPE_NAME,lexeme);
   DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD_TYPE] = AddSystemClass(theEnv,MULTIFIELD_TYPE_NAME,primitive);
   address = AddSystemClass(theEnv,ADDRESS_TYPE_NAME,primitive);
   DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS_TYPE] = AddSystemClass(theEnv,EXTERNAL_ADDRESS_TYPE_NAME,address);
   DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS_TYPE] = AddSystemClass(theEnv,FACT_ADDRESS_TYPE_NAME,address);
   instance = AddSystemClass(theEnv,INSTANCE_TYPE_NAME,primitive);
   DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS_TYPE] = AddSystemClass(theEnv,INSTANCE_ADDRESS_TYPE_NAME,instance);
   DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME_TYPE] = AddSystemClass(theEnv,INSTANCE_NAME_TYPE_NAME,instance);

   /* ================================================================================
       INSTANCE-ADDRESS is-a INSTANCE and ADDRESS.  The links between INSTANCE-ADDRESS
       and ADDRESS still need to be made.
       =============================================================================== */
   AddClassLink(theEnv,&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS_TYPE]->directSuperclasses,address,true,0);
   AddClassLink(theEnv,&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS_TYPE]->allSuperclasses,address,false,2);
   AddClassLink(theEnv,&address->directSubclasses,DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS_TYPE],true,0);

   /* =======================================================================
      The order of the class in the list MUST correspond to their type codes!
      See CONSTANT.H
      ======================================================================= */
   AddConstructToModule(&DefclassData(theEnv)->PrimitiveClassMap[FLOAT_TYPE]->header);
   AddConstructToModule(&DefclassData(theEnv)->PrimitiveClassMap[INTEGER_TYPE]->header);
   AddConstructToModule(&DefclassData(theEnv)->PrimitiveClassMap[SYMBOL_TYPE]->header);
   AddConstructToModule(&DefclassData(theEnv)->PrimitiveClassMap[STRING_TYPE]->header);
   AddConstructToModule(&DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD_TYPE]->header);
   AddConstructToModule(&DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS_TYPE]->header);
   AddConstructToModule(&DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS_TYPE]->header);
   AddConstructToModule(&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS_TYPE]->header);
   AddConstructToModule(&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME_TYPE]->header);
   AddConstructToModule(&any->header);
   AddConstructToModule(&primitive->header);
   AddConstructToModule(&number->header);
   AddConstructToModule(&lexeme->header);
   AddConstructToModule(&address->header);
   AddConstructToModule(&instance->header);
   AddConstructToModule(&user->header);

   for (any = GetNextDefclass(theEnv,NULL) ;
        any != NULL ;
        any = GetNextDefclass(theEnv,any))
     AssignClassID(theEnv,any);
  }

#endif

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/*********************************************************
  NAME         : SetupDefclasses
  DESCRIPTION  : Initializes Class Hash Table,
                   Function Parsers, and Data Structures
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS :
  NOTES        : None
 *********************************************************/
static void SetupDefclasses(
  Environment *theEnv)
  {
   InstallPrimitive(theEnv,&DefclassData(theEnv)->DefclassEntityRecord,DEFCLASS_PTR);

   DefclassData(theEnv)->DefclassModuleIndex =
                RegisterModuleItem(theEnv,"defclass",
#if (! RUN_TIME)
                                    AllocateModule,
                                    ReturnModule,
#else
                                    NULL,NULL,
#endif
#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
                                    BloadDefclassModuleReference,
#else
                                    NULL,
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
                                    DefclassCModuleReference,
#else
                                    NULL,
#endif
                                    (FindConstructFunction *) FindDefclassInModule);

   DefclassData(theEnv)->DefclassConstruct =  AddConstruct(theEnv,"defclass","defclasses",
#if (! BLOAD_ONLY) && (! RUN_TIME)
                                     ParseDefclass,
#else
                                     NULL,
#endif
                                     (FindConstructFunction *) FindDefclass,
                                     GetConstructNamePointer,GetConstructPPForm,
                                     GetConstructModuleItem,
                                     (GetNextConstructFunction *) GetNextDefclass,
                                     SetNextConstruct,
                                     (IsConstructDeletableFunction *) DefclassIsDeletable,
                                     (DeleteConstructFunction *) Undefclass,
#if (! RUN_TIME)
                                     (FreeConstructFunction *) RemoveDefclass
#else
                                     NULL
#endif
                                     );

   AddClearReadyFunction(theEnv,"defclass",InstancesPurge,0,NULL);

#if ! RUN_TIME
   AddClearFunction(theEnv,"defclass",CreateSystemClasses,0,NULL);
   InitializeClasses(theEnv);

#if ! BLOAD_ONLY
#if DEFMODULE_CONSTRUCT
   AddPortConstructItem(theEnv,"defclass",SYMBOL_TOKEN);
   AddAfterModuleDefinedFunction(theEnv,"defclass",UpdateDefclassesScope,0,NULL);
#endif
   AddUDF(theEnv,"undefclass","v",1,1,"y",UndefclassCommand,"UndefclassCommand",NULL);

   AddSaveFunction(theEnv,"defclass",SaveDefclasses,10,NULL);
#endif

#if DEBUGGING_FUNCTIONS
   AddUDF(theEnv,"list-defclasses","v",0,1,"y",ListDefclassesCommand,"ListDefclassesCommand",NULL);
   AddUDF(theEnv,"ppdefclass","vs",1,2,";y;ldsyn",PPDefclassCommand,"PPDefclassCommand",NULL);
   AddUDF(theEnv,"describe-class","v",1,1,"y",DescribeClassCommand,"DescribeClassCommand",NULL);
   AddUDF(theEnv,"browse-classes","v",0,1,"y",BrowseClassesCommand,"BrowseClassesCommand",NULL);
#endif

   AddUDF(theEnv,"get-defclass-list","m",0,1,"y",GetDefclassListFunction,"GetDefclassListFunction",NULL);
   AddUDF(theEnv,"superclassp","b",2,2,"y",SuperclassPCommand,"SuperclassPCommand",NULL);
   AddUDF(theEnv,"subclassp","b",2,2,"y",SubclassPCommand,"SubclassPCommand",NULL);
   AddUDF(theEnv,"class-existp","b", 1,1,"y",ClassExistPCommand,"ClassExistPCommand",NULL);
   AddUDF(theEnv,"message-handler-existp","b",2,3,"y",MessageHandlerExistPCommand,"MessageHandlerExistPCommand",NULL);
   AddUDF(theEnv,"class-abstractp","b",1,1,"y",ClassAbstractPCommand,"ClassAbstractPCommand",NULL);
#if DEFRULE_CONSTRUCT
   AddUDF(theEnv,"class-reactivep","b",1,1,"y",ClassReactivePCommand,"ClassReactivePCommand",NULL);
#endif
   AddUDF(theEnv,"class-slots","m",1,2,"y",ClassSlotsCommand,"ClassSlotsCommand",NULL);
   AddUDF(theEnv,"class-superclasses","m",1,2,"y",ClassSuperclassesCommand,"ClassSuperclassesCommand",NULL);
   AddUDF(theEnv,"class-subclasses","m",1,2,"y",ClassSubclassesCommand,"ClassSubclassesCommand",NULL);
   AddUDF(theEnv,"get-defmessage-handler-list","m",0,2,"y",GetDefmessageHandlersListCmd,"GetDefmessageHandlersListCmd",NULL);
   AddUDF(theEnv,"slot-existp","b",2,3,"y",SlotExistPCommand,"SlotExistPCommand",NULL);
   AddUDF(theEnv,"slot-facets","m",2,2,"y",SlotFacetsCommand,"SlotFacetsCommand",NULL);
   AddUDF(theEnv,"slot-sources","m",2,2,"y",SlotSourcesCommand,"SlotSourcesCommand",NULL);
   AddUDF(theEnv,"slot-types","m",2,2,"y",SlotTypesCommand,"SlotTypesCommand",NULL);
   AddUDF(theEnv,"slot-allowed-values","m",2,2,"y",SlotAllowedValuesCommand,"SlotAllowedValuesCommand",NULL);
   AddUDF(theEnv,"slot-allowed-classes","m",2,2,"y",SlotAllowedClassesCommand,"SlotAllowedClassesCommand",NULL);
   AddUDF(theEnv,"slot-range","m",2,2,"y",SlotRangeCommand,"SlotRangeCommand",NULL);
   AddUDF(theEnv,"slot-cardinality","m",2,2,"y",SlotCardinalityCommand,"SlotCardinalityCommand",NULL);
   AddUDF(theEnv,"slot-writablep","b",2,2,"y",SlotWritablePCommand,"SlotWritablePCommand",NULL);
   AddUDF(theEnv,"slot-initablep","b",2,2,"y",SlotInitablePCommand,"SlotInitablePCommand",NULL);
   AddUDF(theEnv,"slot-publicp","b",2,2,"y",SlotPublicPCommand,"SlotPublicPCommand",NULL);
   AddUDF(theEnv,"slot-direct-accessp","b",2,2,"y",SlotDirectAccessPCommand,"SlotDirectAccessPCommand",NULL);
   AddUDF(theEnv,"slot-default-value","*",2,2,"y",SlotDefaultValueCommand,"SlotDefaultValueCommand",NULL);
   AddUDF(theEnv,"defclass-module","y",1,1,"y",GetDefclassModuleCommand,"GetDefclassModuleCommand",NULL);
   AddUDF(theEnv,"get-class-defaults-mode","y",0,0,NULL,GetClassDefaultsModeCommand,"GetClassDefaultsModeCommand",NULL);
   AddUDF(theEnv,"set-class-defaults-mode","y",1,1,"y",SetClassDefaultsModeCommand,"SetClassDefaultsModeCommand",NULL);
#endif

#if DEBUGGING_FUNCTIONS
   AddWatchItem(theEnv,"instances",0,&DefclassData(theEnv)->WatchInstances,75,DefclassWatchAccess,DefclassWatchPrint);
   AddWatchItem(theEnv,"slots",1,&DefclassData(theEnv)->WatchSlots,74,DefclassWatchAccess,DefclassWatchPrint);
#endif
  }

#if (! RUN_TIME)

/*********************************************************
  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(
  Environment *theEnv,
  const char *name,
  Defclass *parent)
  {
   Defclass *sys;
   unsigned long i;
   char defaultScopeMap[1];

   sys = NewClass(theEnv,CreateSymbol(theEnv,name));
   sys->abstract = 1;
#if DEFRULE_CONSTRUCT
   sys->reactive = 0;
#endif
   IncrementLexemeCount(sys->header.name);
   sys->installed = 1;
   sys->system = 1;
   sys->hashTableIndex = HashClass(sys->header.name);

   AddClassLink(theEnv,&sys->allSuperclasses,sys,true,0);
   if (parent != NULL)
     {
      AddClassLink(theEnv,&sys->directSuperclasses,parent,true,0);
      AddClassLink(theEnv,&parent->directSubclasses,sys,true,0);
      AddClassLink(theEnv,&sys->allSuperclasses,parent,true,0);
      for (i = 1 ; i < parent->allSuperclasses.classCount ; i++)
        AddClassLink(theEnv,&sys->allSuperclasses,parent->allSuperclasses.classArray[i],true,0);
     }
   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(defaultScopeMap,sizeof(char));
   SetBitMap(defaultScopeMap,0);
#if DEFMODULE_CONSTRUCT
   sys->scopeMap = (CLIPSBitMap *) AddBitMap(theEnv,defaultScopeMap,sizeof(char));
   IncrementBitMapCount(sys->scopeMap);
#endif
   return(sys);
  }

/*****************************************************
  NAME         : AllocateModule
  DESCRIPTION  : Creates and initializes a
                 list of defclasses for a new module
  INPUTS       : None
  RETURNS      : The new defclass module
  SIDE EFFECTS : Defclass module created
  NOTES        : None
 *****************************************************/
static void *AllocateModule(
  Environment *theEnv)
  {
   return (void *) get_struct(theEnv,defclassModule);
  }

/***************************************************
  NAME         : ReturnModule
  DESCRIPTION  : Removes a defclass module and
                 all associated defclasses
  INPUTS       : The defclass module
  RETURNS      : Nothing useful
  SIDE EFFECTS : Module and defclasses deleted
  NOTES        : None
 ***************************************************/
static void ReturnModule(
  Environment *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);
  }

#endif

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

/***************************************************
  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(
  Environment *theEnv,
  void *context)
  {
   unsigned i;
   Defclass *theDefclass;
   unsigned long newModuleID;
   unsigned int count;
   char *newScopeMap;
   unsigned short newScopeMapSize;
   const char *className;
   Defmodule *matchModule;

   newModuleID = GetCurrentModule(theEnv)->header.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 = theDefclass->header.name->contents;
        ClearBitString(newScopeMap,newScopeMapSize);
        GenCopyMemory(char,theDefclass->scopeMap->size,
                   newScopeMap,theDefclass->scopeMap->contents);
        DecrementBitMapReferenceCount(theEnv,theDefclass->scopeMap);
        if (theDefclass->system)
          SetBitMap(newScopeMap,newModuleID);
        else if (FindImportedConstruct(theEnv,"defclass",matchModule,
                                       className,&count,true,NULL) != NULL)
          SetBitMap(newScopeMap,newModuleID);
        theDefclass->scopeMap = (CLIPSBitMap *) AddBitMap(theEnv,newScopeMap,newScopeMapSize);
        IncrementBitMapCount(theDefclass->scopeMap);
       }
   rm(theEnv,newScopeMap,newScopeMapSize);
  }

#endif

#endif