clips-sys 0.4.0

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*            CLIPS Version 6.40  05/16/18             */
   /*                                                     */
   /*                  CLASS PARSER MODULE                */
   /*******************************************************/

/**************************************************************/
/* Purpose: Parsing Routines for Defclass Construct           */
/*                                                            */
/* Principal Programmer(s):                                   */
/*      Brian L. Dantes                                       */
/*                                                            */
/* Contributing Programmer(s):                                */
/*                                                            */
/* Revision History:                                          */
/*                                                            */
/*      6.24: Added allowed-classes slot facet.               */
/*                                                            */
/*            Converted INSTANCE_PATTERN_MATCHING to          */
/*            DEFRULE_CONSTRUCT.                              */
/*                                                            */
/*            Renamed BOOLEAN macro type to intBool.          */
/*                                                            */
/*      6.30: Added support to allow CreateClassScopeMap to   */
/*            be used by other functions.                     */
/*                                                            */
/*            Changed integer type/precision.                 */
/*                                                            */
/*            GetConstructNameAndComment API change.          */
/*                                                            */
/*            Added const qualifiers to remove C++            */
/*            deprecation warnings.                           */
/*                                                            */
/*            Converted API macros to function calls.         */
/*                                                            */
/*            Changed find construct functionality so that    */
/*            imported modules are search when locating a     */
/*            named construct.                                */
/*                                                            */
/*      6.40: Pragma once and other inclusion changes.        */
/*                                                            */
/*            Added support for booleans with <stdbool.h>.    */
/*                                                            */
/*            Removed use of void pointers for specific       */
/*            data structures.                                */
/*                                                            */
/*            Eval support for run time and bload only.       */
/*                                                            */
/*            Removed use of single-slot in class             */
/*            definitions.                                    */
/*                                                            */
/**************************************************************/

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

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

#include "classcom.h"
#include "classfun.h"
#include "clsltpsr.h"
#include "cstrcpsr.h"
#include "envrnmnt.h"
#include "inherpsr.h"
#include "memalloc.h"
#include "modulpsr.h"
#include "modulutl.h"
#include "msgpsr.h"
#include "pprint.h"
#include "prntutil.h"
#include "router.h"
#include "scanner.h"

#include "classpsr.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */
#define ROLE_RLN             "role"
#define ABSTRACT_RLN         "abstract"
#define CONCRETE_RLN         "concrete"

#define HANDLER_DECL         "message-handler"

#define SLOT_RLN             "slot"
#define MLT_SLOT_RLN         "multislot"

#define DIRECT               0
#define INHERIT              1

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

/***************************************/
/* LOCAL INTERNAL FUNCTION DEFINITIONS */
/***************************************/

   static bool                    ValidClassName(Environment *,const char *,Defclass **);
   static bool                    ParseSimpleQualifier(Environment *,const char *,const char *,const char *,const char *,bool *,bool *);
   static bool                    ReadUntilClosingParen(Environment *,const char *,struct token *);
   static void                    AddClass(Environment *,Defclass *);
   static void                    BuildSubclassLinks(Environment *,Defclass *);
   static void                    FormInstanceTemplate(Environment *,Defclass *);
   static void                    FormSlotNameMap(Environment *,Defclass *);
   static TEMP_SLOT_LINK         *MergeSlots(Environment *,TEMP_SLOT_LINK *,Defclass *,unsigned short *,unsigned short);
   static void                    PackSlots(Environment *,Defclass *,TEMP_SLOT_LINK *);
   static void                    CreatePublicSlotMessageHandlers(Environment *,Defclass *);


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

/***************************************************************************************
  NAME         : ParseDefclass
  DESCRIPTION  : (defclass ...) is a construct (as
                 opposed to a function), thus no variables
                 may be used.  This means classes may only
                 be STATICALLY defined (like rules).
  INPUTS       : The logical name of the router
                    for the parser input
  RETURNS      : False if successful parse, true otherwise
  SIDE EFFECTS : Inserts valid class definition into
                 Class Table.
  NOTES        : H/L Syntax :
                 (defclass <name> [<comment>]
                    (is-a <superclass-name>+)
                    <class-descriptor>*)

                 <class-descriptor> :== (slot <name> <slot-descriptor>*) |
                                        (role abstract|concrete) |
                                        (pattern-match reactive|non-reactive)

                                        These are for documentation only:
                                        (message-handler <name> [<type>])

                 <slot-descriptor>  :== (default <default-expression>) |
                                        (default-dynamic <default-expression>) |
                                        (storage shared|local) |
                                        (access read-only|read-write|initialize-only) |
                                        (propagation no-inherit|inherit) |
                                        (source composite|exclusive)
                                        (pattern-match reactive|non-reactive)
                                        (visibility public|private)
                                        (override-message <message-name>)
                                        (type ...) |
                                        (cardinality ...) |
                                        (allowed-symbols ...) |
                                        (allowed-strings ...) |
                                        (allowed-numbers ...) |
                                        (allowed-integers ...) |
                                        (allowed-floats ...) |
                                        (allowed-values ...) |
                                        (allowed-instance-names ...) |
                                        (allowed-classes ...) |
                                        (range ...)

               <default-expression> ::= ?NONE | ?VARIABLE | <expression>*
  ***************************************************************************************/
bool ParseDefclass(
  Environment *theEnv,
  const char *readSource)
  {
   CLIPSLexeme *cname;
   Defclass *cls;
   PACKED_CLASS_LINKS *sclasses,*preclist;
   TEMP_SLOT_LINK *slots = NULL;
   bool parseError;
   bool roleSpecified = false, abstract = false;
#if DEFRULE_CONSTRUCT
   bool patternMatchSpecified = false;
   bool reactive = true;
#endif

   SetPPBufferStatus(theEnv,true);
   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,"(defclass ");

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"defclass");
      return true;
     }
#endif

   cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defclass",
                                      (FindConstructFunction *) FindDefclassInModule,NULL,"#",true,
                                      true,true,false);
   if (cname == NULL)
     return true;

   if (ValidClassName(theEnv,cname->contents,&cls) == false)
     return true;

   sclasses = ParseSuperclasses(theEnv,readSource,cname);
   if (sclasses == NULL)
     return true;
   preclist = FindPrecedenceList(theEnv,cls,sclasses);
   if (preclist == NULL)
     {
      DeletePackedClassLinks(theEnv,sclasses,true);
      return true;
     }
   parseError = false;
   GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
   while (DefclassData(theEnv)->ObjectParseToken.tknType != RIGHT_PARENTHESIS_TOKEN)
     {
      if (DefclassData(theEnv)->ObjectParseToken.tknType != LEFT_PARENTHESIS_TOKEN)
        {
         SyntaxErrorMessage(theEnv,"defclass");
         parseError = true;
         break;
        }
      PPBackup(theEnv);
      PPCRAndIndent(theEnv);
      SavePPBuffer(theEnv,"(");
      GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
      if (DefclassData(theEnv)->ObjectParseToken.tknType != SYMBOL_TOKEN)
        {
         SyntaxErrorMessage(theEnv,"defclass");
         parseError = true;
         break;
        }
      if (strcmp(DefclassData(theEnv)->ObjectParseToken.lexemeValue->contents,ROLE_RLN) == 0)
        {
         if (ParseSimpleQualifier(theEnv,readSource,ROLE_RLN,CONCRETE_RLN,ABSTRACT_RLN,
                                  &roleSpecified,&abstract) == false)
           {
            parseError = true;
            break;
           }
        }
#if DEFRULE_CONSTRUCT
      else if (strcmp(DefclassData(theEnv)->ObjectParseToken.lexemeValue->contents,MATCH_RLN) == 0)
        {
         if (ParseSimpleQualifier(theEnv,readSource,MATCH_RLN,NONREACTIVE_RLN,REACTIVE_RLN,
                                  &patternMatchSpecified,&reactive) == false)
           {
            parseError = true;
            break;
           }
        }
#endif
      else if (strcmp(DefclassData(theEnv)->ObjectParseToken.lexemeValue->contents,SLOT_RLN) == 0)
        {
         slots = ParseSlot(theEnv,readSource,cname->contents,slots,preclist,false);
         if (slots == NULL)
           {
            parseError = true;
            break;
           }
        }
      else if (strcmp(DefclassData(theEnv)->ObjectParseToken.lexemeValue->contents,MLT_SLOT_RLN) == 0)
        {
         slots = ParseSlot(theEnv,readSource,cname->contents,slots,preclist,true);
         if (slots == NULL)
           {
            parseError = true;
            break;
           }
        }
      else if (strcmp(DefclassData(theEnv)->ObjectParseToken.lexemeValue->contents,HANDLER_DECL) == 0)
        {
         if (ReadUntilClosingParen(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken) == false)
           {
            parseError = true;
            break;
           }
        }
      else
        {
         SyntaxErrorMessage(theEnv,"defclass");
         parseError = true;
         break;
        }
      GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
     }

   if ((DefclassData(theEnv)->ObjectParseToken.tknType != RIGHT_PARENTHESIS_TOKEN) ||
       (parseError == true))
     {
      DeletePackedClassLinks(theEnv,sclasses,true);
      DeletePackedClassLinks(theEnv,preclist,true);
      DeleteSlots(theEnv,slots);
      return true;
     }
   SavePPBuffer(theEnv,"\n");

   /* =========================================================================
      The abstract/reactive qualities of a class are inherited if not specified
      ========================================================================= */
   if (roleSpecified == false)
     {
      if (preclist->classArray[1]->system &&                             /* Change to cause         */
          (DefclassData(theEnv)->ClassDefaultsModeValue == CONVENIENCE_MODE)) /* default role of         */
        { abstract = false; }                                            /* classes to be concrete. */
      else
        { abstract = preclist->classArray[1]->abstract; }
     }
#if DEFRULE_CONSTRUCT
   if (patternMatchSpecified == false)
     {
      if ((preclist->classArray[1]->system) &&                           /* Change to cause       */
          (! abstract) &&                                                /* default pattern-match */
          (DefclassData(theEnv)->ClassDefaultsModeValue == CONVENIENCE_MODE)) /* of classes to be      */
        { reactive = true; }                                             /* reactive.             */
      else
        { reactive = preclist->classArray[1]->reactive; }
     }

   /* ================================================================
      An abstract class cannot have direct instances, thus it makes no
      sense for it to be reactive since it will have no objects to
      respond to pattern-matching
      ================================================================ */
   if (abstract && reactive)
     {
      PrintErrorID(theEnv,"CLASSPSR",1,false);
      WriteString(theEnv,STDERR,"An abstract class cannot be reactive.\n");
      DeletePackedClassLinks(theEnv,sclasses,true);
      DeletePackedClassLinks(theEnv,preclist,true);
      DeleteSlots(theEnv,slots);
      return true;
     }

#endif

   /* =======================================================
      If we're only checking syntax, don't add the
      successfully parsed defclass to the KB.
      ======================================================= */

   if (ConstructData(theEnv)->CheckSyntaxMode)
     {
      DeletePackedClassLinks(theEnv,sclasses,true);
      DeletePackedClassLinks(theEnv,preclist,true);
      DeleteSlots(theEnv,slots);
      return false;
     }

   cls = NewClass(theEnv,cname);
   cls->abstract = abstract;
#if DEFRULE_CONSTRUCT
   cls->reactive = reactive;
#endif
   cls->directSuperclasses.classCount = sclasses->classCount;
   cls->directSuperclasses.classArray = sclasses->classArray;

   /* =======================================================
      This is a hack to let functions which need to iterate
      over a class AND its superclasses to conveniently do so

      The real precedence list starts in position 1
      ======================================================= */
   preclist->classArray[0] = cls;
   cls->allSuperclasses.classCount = preclist->classCount;
   cls->allSuperclasses.classArray = preclist->classArray;
   rtn_struct(theEnv,packedClassLinks,sclasses);
   rtn_struct(theEnv,packedClassLinks,preclist);

   /* =================================
      Shove slots into contiguous array
      ================================= */
   if (slots != NULL)
     PackSlots(theEnv,cls,slots);
   AddClass(theEnv,cls);

   return false;
  }

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

/***********************************************************
  NAME         : ValidClassName
  DESCRIPTION  : Determines if a new class of the given
                 name can be defined in the current module
  INPUTS       : 1) The new class name
                 2) Buffer to hold class address
  RETURNS      : True if OK, false otherwise
  SIDE EFFECTS : Error message printed if not OK
  NOTES        : GetConstructNameAndComment() (called before
                 this function) ensures that the defclass
                 name does not conflict with one from
                 another module
 ***********************************************************/
static bool ValidClassName(
  Environment *theEnv,
  const char *theClassName,
  Defclass **theDefclass)
  {
   *theDefclass = FindDefclassInModule(theEnv,theClassName);
   if (*theDefclass != NULL)
     {
      /* ===================================
         System classes (which are visible
         in all modules) cannot be redefined
         =================================== */
      if ((*theDefclass)->system)
        {
         PrintErrorID(theEnv,"CLASSPSR",2,false);
         WriteString(theEnv,STDERR,"Cannot redefine a predefined system class.\n");
         return false;
        }

      /* ===============================================
         A class in the current module can only be
         redefined if it is not in use, e.g., instances,
         generic function method restrictions, etc.
         =============================================== */
      if ((DefclassIsDeletable(*theDefclass) == false) &&
          (! ConstructData(theEnv)->CheckSyntaxMode))
        {
         PrintErrorID(theEnv,"CLASSPSR",3,false);
         WriteString(theEnv,STDERR,"Class '");
         WriteString(theEnv,STDERR,DefclassName(*theDefclass));
         WriteString(theEnv,STDERR,"' cannot be redefined while ");
         WriteString(theEnv,STDERR,"outstanding references to it still exist.\n");
         return false;
        }
     }
   return true;
  }

/***************************************************************
  NAME         : ParseSimpleQualifier
  DESCRIPTION  : Parses abstract/concrete role and
                 pattern-matching reactivity for class
  INPUTS       : 1) The input logical name
                 2) The name of the qualifier being parsed
                 3) The qualifier value indicating that the
                    qualifier should be false
                 4) The qualifier value indicating that the
                    qualifier should be true
                 5) A pointer to a bitmap indicating
                    if the qualifier has already been parsed
                 6) A buffer to store the value of the qualifier
  RETURNS      : True if all OK, false otherwise
  SIDE EFFECTS : Bitmap and qualifier buffers set
                 Messages printed on errors
  NOTES        : None
 ***************************************************************/
static bool ParseSimpleQualifier(
  Environment *theEnv,
  const char *readSource,
  const char *classQualifier,
  const char *clearRelation,
  const char *setRelation,
  bool *alreadyTestedFlag,
  bool *binaryFlag)
  {
   if (*alreadyTestedFlag)
     {
      PrintErrorID(theEnv,"CLASSPSR",4,false);
      WriteString(theEnv,STDERR,"The '");
      WriteString(theEnv,STDERR,classQualifier);
      WriteString(theEnv,STDERR,"' class attribute is already specified.\n");
      return false;
     }
   SavePPBuffer(theEnv," ");
   GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
   if (DefclassData(theEnv)->ObjectParseToken.tknType != SYMBOL_TOKEN)
     goto ParseSimpleQualifierError;
   if (strcmp(DefclassData(theEnv)->ObjectParseToken.lexemeValue->contents,setRelation) == 0)
     *binaryFlag = true;
   else if (strcmp(DefclassData(theEnv)->ObjectParseToken.lexemeValue->contents,clearRelation) == 0)
     *binaryFlag = false;
   else
     goto ParseSimpleQualifierError;
   GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
   if (DefclassData(theEnv)->ObjectParseToken.tknType != RIGHT_PARENTHESIS_TOKEN)
     goto ParseSimpleQualifierError;
   *alreadyTestedFlag = true;
   return true;

ParseSimpleQualifierError:
   SyntaxErrorMessage(theEnv,"defclass");
   return false;
  }

/***************************************************
  NAME         : ReadUntilClosingParen
  DESCRIPTION  : Skips over tokens until a ')' is
                 encountered.
  INPUTS       : 1) The logical input source
                 2) A buffer for scanned tokens
  RETURNS      : True if ')' read, otherwise false
                 otherwise
  SIDE EFFECTS : Tokens read
  NOTES        : Expects first token after opening
                 paren has already been scanned
 ***************************************************/
static bool ReadUntilClosingParen(
  Environment *theEnv,
  const char *readSource,
  struct token *inputToken)
  {
   int cnt = 1;
   bool lparen_read = false;

   do
     {
      if (lparen_read == false)
        SavePPBuffer(theEnv," ");
      GetToken(theEnv,readSource,inputToken);
      if (inputToken->tknType == STOP_TOKEN)
        {
         SyntaxErrorMessage(theEnv,"message-handler declaration");
         return false;
        }
      else if (inputToken->tknType == LEFT_PARENTHESIS_TOKEN)
        {
         lparen_read = true;
         cnt++;
        }
      else if (inputToken->tknType == RIGHT_PARENTHESIS_TOKEN)
        {
         cnt--;
         if (lparen_read == false)
           {
            PPBackup(theEnv);
            PPBackup(theEnv);
            SavePPBuffer(theEnv,")");
           }
         lparen_read = false;
        }
      else
        lparen_read = false;
     }
   while (cnt > 0);

   return true;
  }

/*****************************************************************************
  NAME         : AddClass
  DESCRIPTION  : Determines the precedence list of the new class.
                 If it is valid, the routine checks to see if the class
                 already exists.  If it does not, all the subclass
                 links are made from the class's direct superclasses,
                 and the class is inserted in the hash table.  If it
                 does, all sublclasses are deleted. An error will occur
                 if any instances of the class (direct or indirect) exist.
                 If all checks out, the old definition is replaced by the new.
  INPUTS       : The new class description
  RETURNS      : Nothing useful
  SIDE EFFECTS : The class is deleted if there is an error.
  NOTES        : No change in the class graph state will occur
                 if there were any errors.
                 Assumes class is not busy!!!
 *****************************************************************************/
static void AddClass(
  Environment *theEnv,
  Defclass *cls)
  {
   Defclass *ctmp;
#if DEBUGGING_FUNCTIONS
   bool oldTraceInstances = false,
       oldTraceSlots = false;
#endif

   /* ===============================================
      If class does not already exist, insert and
      form progeny links with all direct superclasses
      =============================================== */
   cls->hashTableIndex = HashClass(GetDefclassNamePointer(cls));
   ctmp = FindDefclassInModule(theEnv,DefclassName(cls));

   if (ctmp != NULL)
     {
#if DEBUGGING_FUNCTIONS
      oldTraceInstances = ctmp->traceInstances;
      oldTraceSlots = ctmp->traceSlots;
#endif
      DeleteClassUAG(theEnv,ctmp);
     }
   PutClassInTable(theEnv,cls);

   BuildSubclassLinks(theEnv,cls);
   InstallClass(theEnv,cls,true);
   AddConstructToModule(&cls->header);

   FormInstanceTemplate(theEnv,cls);
   FormSlotNameMap(theEnv,cls);

   AssignClassID(theEnv,cls);

#if DEBUGGING_FUNCTIONS
   if (cls->abstract)
     {
      cls->traceInstances = false;
      cls->traceSlots = false;
     }
   else
     {
      if (oldTraceInstances)
        cls->traceInstances = true;
      if (oldTraceSlots)
        cls->traceSlots = true;
     }
#endif

#if DEBUGGING_FUNCTIONS
   if (GetConserveMemory(theEnv) == false)
     SetDefclassPPForm(theEnv,cls,CopyPPBuffer(theEnv));
#endif

#if DEFMODULE_CONSTRUCT

   /* =========================================
      Create a bitmap indicating whether this
      class is in scope or not for every module
      ========================================= */
   cls->scopeMap = (CLIPSBitMap *) CreateClassScopeMap(theEnv,cls);

#endif

   /* ==============================================
      Define get- and put- handlers for public slots
      ============================================== */
   CreatePublicSlotMessageHandlers(theEnv,cls);
  }

/*******************************************************
  NAME         : BuildSubclassLinks
  DESCRIPTION  : Follows the list of superclasses
                 for a class and puts the class in
                 each of the superclasses' subclass
                 list.
  INPUTS       : The address of the class
  RETURNS      : Nothing useful
  SIDE EFFECTS : The subclass lists for every superclass
                 are modified.
  NOTES        : Assumes the superclass list is formed.
 *******************************************************/
static void BuildSubclassLinks(
  Environment *theEnv,
  Defclass *cls)
  {
   unsigned long i;

   for (i = 0 ; i < cls->directSuperclasses.classCount ; i++)
     AddClassLink(theEnv,&cls->directSuperclasses.classArray[i]->directSubclasses,cls,true,0);
  }

/**********************************************************
  NAME         : FormInstanceTemplate
  DESCRIPTION  : Forms a contiguous array of instance
                  slots for use in creating instances later
                 Also used in determining instance slot
                  indices a priori during handler defns
  INPUTS       : The class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Contiguous array of instance slots formed
  NOTES        : None
 **********************************************************/
static void FormInstanceTemplate(
  Environment *theEnv,
  Defclass *cls)
  {
   TEMP_SLOT_LINK *islots = NULL,*stmp;
   unsigned short scnt = 0;
   unsigned long i;

   /* ========================
      Get direct class's slots
      ======================== */
   islots = MergeSlots(theEnv,islots,cls,&scnt,DIRECT);

   /* ===================================================================
      Get all inherited slots - a more specific slot takes precedence
      over more general, i.e. the first class in the precedence list with
      a particular slot gets to specify its default value
      =================================================================== */
   for (i = 1 ; i < cls->allSuperclasses.classCount ; i++)
     islots = MergeSlots(theEnv,islots,cls->allSuperclasses.classArray[i],&scnt,INHERIT);

   /* ===================================================
      Allocate a contiguous array to store all the slots.
      =================================================== */
   cls->instanceSlotCount = scnt;
   cls->localInstanceSlotCount = 0;
   if (scnt > 0)
     cls->instanceTemplate = (SlotDescriptor **) gm2(theEnv,(scnt * sizeof(SlotDescriptor *)));
   for (i = 0 ; i < scnt ; i++)
     {
      stmp = islots;
      islots = islots->nxt;
      cls->instanceTemplate[i] = stmp->desc;
      if (stmp->desc->shared == 0)
        cls->localInstanceSlotCount++;
      rtn_struct(theEnv,tempSlotLink,stmp);
     }
  }

/**********************************************************
  NAME         : FormSlotNameMap
  DESCRIPTION  : Forms a mapping of the slot name ids into
                 the instance template.  Given the slot
                 name id, this map provides a much faster
                 lookup of a slot.  The id is stored
                 statically in object patterns and can
                 be looked up via a hash table at runtime
                 as well.
  INPUTS       : The class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Contiguous array of integers formed
                 The position in the array corresponding
                 to a slot name id holds an the index
                 into the instance template array holding
                 the slot
                 The max slot name id for the class is
                 also stored to make deletion of the slots
                 easier
  NOTES        : Assumes the instance template has already
                 been formed
 **********************************************************/
static void FormSlotNameMap(
  Environment *theEnv,
  Defclass *cls)
  {
   unsigned i;

   cls->maxSlotNameID = 0;
   cls->slotNameMap = NULL;
   if (cls->instanceSlotCount == 0)
     return;
   for (i = 0 ; i < cls->instanceSlotCount ; i++)
     if (cls->instanceTemplate[i]->slotName->id > cls->maxSlotNameID)
       cls->maxSlotNameID = cls->instanceTemplate[i]->slotName->id;
   cls->slotNameMap = (unsigned *) gm2(theEnv,(sizeof(unsigned) * (cls->maxSlotNameID + 1)));
   for (i = 0 ; i <= cls->maxSlotNameID ; i++)
     cls->slotNameMap[i] = 0;
   for (i = 0 ; i < cls->instanceSlotCount ; i++)
     cls->slotNameMap[cls->instanceTemplate[i]->slotName->id] = i + 1;
  }

/********************************************************************
  NAME         : MergeSlots
  DESCRIPTION  : Adds non-duplicate slots to list and increments
                   slot count for the class instance template
  INPUTS       : 1) The old slot list
                 2) The address of class containing new slots
                 3) Caller's buffer for # of slots
                 4) A flag indicating whether the new list of slots
                    is from the direct parent-class or not.
  RETURNS      : The address of the new expanded list, or NULL
                   for an empty list
  SIDE EFFECTS : The list is expanded
                 Caller's slot count is adjusted.
  NOTES        : Lists are assumed to contain no duplicates
 *******************************************************************/
static TEMP_SLOT_LINK *MergeSlots(
  Environment *theEnv,
  TEMP_SLOT_LINK *old,
  Defclass *cls,
  unsigned short *scnt,
  unsigned short src)
  {
   TEMP_SLOT_LINK *cur,*tmp;
   unsigned int i;
   SlotDescriptor *newSlot;
   
   /*=========================================*/
   /* Process the slots in reverse order      */
   /* since we are pushing them onto a stack. */
   /*=========================================*/
      
   for (i = cls->slotCount; i > 0 ; i--)
     {
      newSlot = &cls->slots[i-1];

      /*=============================================*/
      /* A class can prevent it slots from being     */
      /* propagated to all but its direct instances. */
      /*=============================================*/
      
      if ((newSlot->noInherit == 0) ? true : (src == DIRECT))
        {
         cur = old;
         while ((cur != NULL) ? (newSlot->slotName != cur->desc->slotName) : false)
           cur = cur->nxt;
         if (cur == NULL)
           {
            tmp = get_struct(theEnv,tempSlotLink);
            tmp->desc = newSlot;
            tmp->nxt = old;
            old = tmp;
            (*scnt)++;
           }
        }
     }
     
   return old;
  }

/***********************************************************************
  NAME         : PackSlots
  DESCRIPTION  : Groups class-slots into a contiguous array
                  "slots" field points to array
                  "slotCount" field set
  INPUTS       : 1) The class
                 2) The list of slots
  RETURNS      : Nothing useful
  SIDE EFFECTS : Temporary list deallocated, contiguous array allocated,
                   and nxt pointers linked
                 Class pointer set for slots
  NOTES        : Assumes class->slotCount == 0 && class->slots == NULL
 ***********************************************************************/
static void PackSlots(
  Environment *theEnv,
  Defclass *cls,
  TEMP_SLOT_LINK *slots)
  {
   TEMP_SLOT_LINK *stmp,*sprv;
   long i;

   stmp = slots;
   while  (stmp != NULL)
     {
      stmp->desc->cls = cls;
      cls->slotCount++;
      stmp = stmp->nxt;
     }
   cls->slots = (SlotDescriptor *) gm2(theEnv,(sizeof(SlotDescriptor) * cls->slotCount));
   stmp = slots;
   for (i = 0 ; i < cls->slotCount ; i++)
     {
      sprv = stmp;
      stmp = stmp->nxt;
      GenCopyMemory(SlotDescriptor,1,&(cls->slots[i]),sprv->desc);
      cls->slots[i].sharedValue.desc = &(cls->slots[i]);
      cls->slots[i].sharedValue.value = NULL;
      rtn_struct(theEnv,slotDescriptor,sprv->desc);
      rtn_struct(theEnv,tempSlotLink,sprv);
     }
  }

/*****************************************************************************
  NAME         : CreatePublicSlotMessageHandlers
  DESCRIPTION  : Creates a get-<slot-name> and
                 put-<slot-name> handler for every
                 public slot in a class.

                 The syntax of the message-handlers
                 created are:

                 (defmessage-handler <class> get-<slot-name> primary ()
                    ?self:<slot-name>)

                 For single-field slots:

                 (defmessage-handler <class> put-<slot-name> primary (?value)
                    (bind ?self:<slot-name> ?value))

                 For multifield slots:

                 (defmessage-handler <class> put-<slot-name> primary ($?value)
                    (bind ?self:<slot-name> ?value))
  INPUTS       : The defclass
  RETURNS      : Nothing useful
  SIDE EFFECTS : Message-handlers created
  NOTES        : None
 ******************************************************************************/
static void CreatePublicSlotMessageHandlers(
  Environment *theEnv,
  Defclass *theDefclass)
  {
   long i;
   SlotDescriptor *sd;

   for (i = 0 ; i < theDefclass->slotCount ; i++)
     {
      sd = &theDefclass->slots[i];
        CreateGetAndPutHandlers(theEnv,sd);
     }
   for (i = 0 ; i < theDefclass->handlerCount ; i++)
     theDefclass->handlers[i].system = true;
  }

#endif

#if DEFMODULE_CONSTRUCT && OBJECT_SYSTEM

/********************************************************
  NAME         : CreateClassScopeMap
  DESCRIPTION  : Creates a bitmap where each bit position
                 corresponds to a module id. If the bit
                 is set, the class is in scope for that
                 module, otherwise it is not.
  INPUTS       : The class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Scope bitmap created and attached
  NOTES        : Uses FindImportedConstruct()
 ********************************************************/
void *CreateClassScopeMap(
  Environment *theEnv,
  Defclass *theDefclass)
  {
   unsigned short scopeMapSize;
   char *scopeMap;
   const char *className;
   Defmodule *matchModule, *theModule;
   unsigned long moduleID;
   unsigned int count;
   void *theBitMap;

   className = theDefclass->header.name->contents;
   matchModule = theDefclass->header.whichModule->theModule;

   scopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1));
   scopeMap = (char *) gm2(theEnv,scopeMapSize);

   ClearBitString(scopeMap,scopeMapSize);
   SaveCurrentModule(theEnv);
   for (theModule = GetNextDefmodule(theEnv,NULL) ;
        theModule != NULL ;
        theModule = GetNextDefmodule(theEnv,theModule))
     {
      SetCurrentModule(theEnv,theModule);
      moduleID = theModule->header.bsaveID;
      if (FindImportedConstruct(theEnv,"defclass",matchModule,
                                className,&count,true,NULL) != NULL)
        SetBitMap(scopeMap,moduleID);
     }
   RestoreCurrentModule(theEnv);
   theBitMap = (CLIPSBitMap *) AddBitMap(theEnv,scopeMap,scopeMapSize);
   IncrementBitMapCount(theBitMap);
   rm(theEnv,scopeMap,scopeMapSize);
   return(theBitMap);
  }

#endif