src/clipsrules/core/classpsr.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*               CLIPS Version 6.30  03/04/08          */
00005    /*                                                     */
00006    /*                  CLASS PARSER MODULE                */
00007    /*******************************************************/
00008 
00009 /**************************************************************/
00010 /* Purpose: Parsing Routines for Defclass Construct           */
00011 /*                                                            */
00012 /* Principal Programmer(s):                                   */
00013 /*      Brian L. Dantes                                       */
00014 /*                                                            */
00015 /* Contributing Programmer(s):                                */
00016 /*                                                            */
00017 /* Revision History:                                          */
00018 /*      6.24: Added allowed-classes slot facet.               */
00019 /*                                                            */
00020 /*            Converted INSTANCE_PATTERN_MATCHING to          */
00021 /*            DEFRULE_CONSTRUCT.                              */
00022 /*                                                            */
00023 /*            Renamed BOOLEAN macro type to intBool.          */
00024 /*                                                            */
00025 /*      6.30: Added support to allow CreateClassScopeMap to   */
00026 /*            be used by other functions.                     */
00027 /*                                                            */
00028 /**************************************************************/
00029 
00030 /* =========================================
00031    *****************************************
00032                EXTERNAL DEFINITIONS
00033    =========================================
00034    ***************************************** */
00035 #include "setup.h"
00036 
00037 #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME)
00038 
00039 #if BLOAD || BLOAD_AND_BSAVE
00040 #include "bload.h"
00041 #endif
00042 
00043 #include "classcom.h"
00044 #include "classfun.h"
00045 #include "clsltpsr.h"
00046 #include "cstrcpsr.h"
00047 #include "envrnmnt.h"
00048 #include "inherpsr.h"
00049 #include "memalloc.h"
00050 #include "modulpsr.h"
00051 #include "modulutl.h"
00052 #include "msgpsr.h"
00053 #include "router.h"
00054 #include "scanner.h"
00055 
00056 #define _CLASSPSR_SOURCE_
00057 #include "classpsr.h"
00058 
00059 /* =========================================
00060    *****************************************
00061                    CONSTANTS
00062    =========================================
00063    ***************************************** */
00064 #define ROLE_RLN             "role"
00065 #define ABSTRACT_RLN         "abstract"
00066 #define CONCRETE_RLN         "concrete"
00067 
00068 #define HANDLER_DECL         "message-handler"
00069 
00070 #define SLOT_RLN             "slot"
00071 #define SGL_SLOT_RLN         "single-slot"
00072 #define MLT_SLOT_RLN         "multislot"
00073 
00074 #define DIRECT               0
00075 #define INHERIT              1
00076 
00077 /* =========================================
00078    *****************************************
00079       INTERNALLY VISIBLE FUNCTION HEADERS
00080    =========================================
00081    ***************************************** */
00082 
00083 static intBool ValidClassName(void *,char *,DEFCLASS **);
00084 static intBool ParseSimpleQualifier(void *,char *,char *,char *,char *,intBool *,intBool *);
00085 static intBool ReadUntilClosingParen(void *,char *,struct token *);
00086 static void AddClass(void *,DEFCLASS *);
00087 static void BuildSubclassLinks(void *,DEFCLASS *);
00088 static void FormInstanceTemplate(void *,DEFCLASS *);
00089 static void FormSlotNameMap(void *,DEFCLASS *);
00090 static TEMP_SLOT_LINK *MergeSlots(void *,TEMP_SLOT_LINK *,DEFCLASS *,short *,int);
00091 static void PackSlots(void *,DEFCLASS *,TEMP_SLOT_LINK *);
00092 static void CreatePublicSlotMessageHandlers(void *,DEFCLASS *);
00093 
00094 /* =========================================
00095    *****************************************
00096           EXTERNALLY VISIBLE FUNCTIONS
00097    =========================================
00098    ***************************************** */
00099 
00100 /***************************************************************************************
00101   NAME         : ParseDefclass
00102   DESCRIPTION  : (defclass ...) is a construct (as
00103                  opposed to a function), thus no variables
00104                  may be used.  This means classes may only
00105                  be STATICALLY defined (like rules).
00106   INPUTS       : The logical name of the router
00107                     for the parser input
00108   RETURNS      : FALSE if successful parse, TRUE otherwise
00109   SIDE EFFECTS : Inserts valid class definition into
00110                  Class Table.
00111   NOTES        : H/L Syntax :
00112                  (defclass <name> [<comment>]
00113                     (is-a <superclass-name>+)
00114                     <class-descriptor>*)
00115 
00116                  <class-descriptor> :== (slot <name> <slot-descriptor>*) |
00117                                         (role abstract|concrete) |
00118                                         (pattern-match reactive|non-reactive)
00119 
00120                                         These are for documentation only:
00121                                         (message-handler <name> [<type>])
00122 
00123                  <slot-descriptor>  :== (default <default-expression>) |
00124                                         (default-dynamic <default-expression>) |
00125                                         (storage shared|local) |
00126                                         (access read-only|read-write|initialize-only) |
00127                                         (propagation no-inherit|inherit) |
00128                                         (source composite|exclusive)
00129                                         (pattern-match reactive|non-reactive)
00130                                         (visibility public|private)
00131                                         (override-message <message-name>)
00132                                         (type ...) |
00133                                         (cardinality ...) |
00134                                         (allowed-symbols ...) |
00135                                         (allowed-strings ...) |
00136                                         (allowed-numbers ...) |
00137                                         (allowed-integers ...) |
00138                                         (allowed-floats ...) |
00139                                         (allowed-values ...) |
00140                                         (allowed-instance-names ...) |
00141                                         (allowed-classes ...) |
00142                                         (range ...)
00143 
00144                <default-expression> ::= ?NONE | ?VARIABLE | <expression>*
00145   ***************************************************************************************/
00146 globle int ParseDefclass(
00147   void *theEnv,
00148   char *readSource)
00149   {
00150    SYMBOL_HN *cname;
00151    DEFCLASS *cls;
00152    PACKED_CLASS_LINKS *sclasses,*preclist;
00153    TEMP_SLOT_LINK *slots = NULL;
00154    int roleSpecified = FALSE,
00155        abstract = FALSE,
00156        parseError;
00157 #if DEFRULE_CONSTRUCT
00158    int patternMatchSpecified = FALSE,
00159        reactive = TRUE;
00160 #endif
00161 
00162    SetPPBufferStatus(theEnv,ON);
00163    FlushPPBuffer(theEnv);
00164    SetIndentDepth(theEnv,3);
00165    SavePPBuffer(theEnv,"(defclass ");
00166 
00167 #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
00168    if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
00169      {
00170       CannotLoadWithBloadMessage(theEnv,"defclass");
00171       return(TRUE);
00172      }
00173 #endif
00174 
00175    cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defclass",
00176                                       EnvFindDefclass,NULL,"#",TRUE,
00177                                       TRUE,TRUE);
00178    if (cname == NULL)
00179      return(TRUE);
00180 
00181    if (ValidClassName(theEnv,ValueToString(cname),&cls) == FALSE)
00182      return(TRUE);
00183 
00184    sclasses = ParseSuperclasses(theEnv,readSource,cname);
00185    if (sclasses == NULL)
00186      return(TRUE);
00187    preclist = FindPrecedenceList(theEnv,cls,sclasses);
00188    if (preclist == NULL)
00189      {
00190       DeletePackedClassLinks(theEnv,sclasses,TRUE);
00191       return(TRUE);
00192      }
00193    parseError = FALSE;
00194    GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
00195    while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
00196      {
00197       if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN)
00198         {
00199          SyntaxErrorMessage(theEnv,"defclass");
00200          parseError = TRUE;
00201          break;
00202         }
00203       PPBackup(theEnv);
00204       PPCRAndIndent(theEnv);
00205       SavePPBuffer(theEnv,"(");
00206       GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
00207       if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
00208         {
00209          SyntaxErrorMessage(theEnv,"defclass");
00210          parseError = TRUE;
00211          break;
00212         }
00213       if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),ROLE_RLN) == 0)
00214         {
00215          if (ParseSimpleQualifier(theEnv,readSource,ROLE_RLN,CONCRETE_RLN,ABSTRACT_RLN,
00216                                   &roleSpecified,&abstract) == FALSE)
00217            {
00218             parseError = TRUE;
00219             break;
00220            }
00221         }
00222 #if DEFRULE_CONSTRUCT
00223       else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MATCH_RLN) == 0)
00224         {
00225          if (ParseSimpleQualifier(theEnv,readSource,MATCH_RLN,NONREACTIVE_RLN,REACTIVE_RLN,
00226                                   &patternMatchSpecified,&reactive) == FALSE)
00227            {
00228             parseError = TRUE;
00229             break;
00230            }
00231         }
00232 #endif
00233       else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SLOT_RLN) == 0)
00234         {
00235          slots = ParseSlot(theEnv,readSource,slots,preclist,FALSE,FALSE);
00236          if (slots == NULL)
00237            {
00238             parseError = TRUE;
00239             break;
00240            }
00241         }
00242       else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SGL_SLOT_RLN) == 0)
00243         {
00244          slots = ParseSlot(theEnv,readSource,slots,preclist,FALSE,TRUE);
00245          if (slots == NULL)
00246            {
00247             parseError = TRUE;
00248             break;
00249            }
00250         }
00251       else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MLT_SLOT_RLN) == 0)
00252         {
00253          slots = ParseSlot(theEnv,readSource,slots,preclist,TRUE,TRUE);
00254          if (slots == NULL)
00255            {
00256             parseError = TRUE;
00257             break;
00258            }
00259         }
00260       else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),HANDLER_DECL) == 0)
00261         {
00262          if (ReadUntilClosingParen(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken) == FALSE)
00263            {
00264             parseError = TRUE;
00265             break;
00266            }
00267         }
00268       else
00269         {
00270          SyntaxErrorMessage(theEnv,"defclass");
00271          parseError = TRUE;
00272          break;
00273         }
00274       GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
00275      }
00276 
00277    if ((GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) || (parseError == TRUE))
00278      {
00279       DeletePackedClassLinks(theEnv,sclasses,TRUE);
00280       DeletePackedClassLinks(theEnv,preclist,TRUE);
00281       DeleteSlots(theEnv,slots);
00282       return(TRUE);
00283      }
00284    SavePPBuffer(theEnv,"\n");
00285 
00286    /* =========================================================================
00287       The abstract/reactive qualities of a class are inherited if not specified
00288       ========================================================================= */
00289    if (roleSpecified == FALSE)
00290      {
00291       if (preclist->classArray[1]->system &&                             /* Change to cause         */ 
00292           (DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE)) /* default role of         */
00293         { abstract = FALSE; }                                            /* classes to be concrete. */
00294       else
00295         { abstract = preclist->classArray[1]->abstract; }
00296      }
00297 #if DEFRULE_CONSTRUCT
00298    if (patternMatchSpecified == FALSE)
00299      {
00300       if ((preclist->classArray[1]->system) &&                           /* Change to cause       */
00301           (! abstract) &&                                                /* default pattern-match */ 
00302           (DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE)) /* of classes to be      */
00303         { reactive = TRUE; }                                             /* reactive.             */
00304       else
00305         { reactive = preclist->classArray[1]->reactive; }
00306      }
00307 
00308    /* ================================================================
00309       An abstract class cannot have direct instances, thus it makes no
00310       sense for it to be reactive since it will have no objects to
00311       respond to pattern-matching
00312       ================================================================ */
00313    if (abstract && reactive)
00314      {
00315       PrintErrorID(theEnv,"CLASSPSR",1,FALSE);
00316       EnvPrintRouter(theEnv,WERROR,"An abstract class cannot be reactive.\n");
00317       DeletePackedClassLinks(theEnv,sclasses,TRUE);
00318       DeletePackedClassLinks(theEnv,preclist,TRUE);
00319       DeleteSlots(theEnv,slots);
00320       return(TRUE);
00321      }
00322 
00323 #endif
00324 
00325    /* =======================================================
00326       If we're only checking syntax, don't add the
00327       successfully parsed defclass to the KB.
00328       ======================================================= */
00329 
00330    if (ConstructData(theEnv)->CheckSyntaxMode)
00331      {
00332       DeletePackedClassLinks(theEnv,sclasses,TRUE);
00333       DeletePackedClassLinks(theEnv,preclist,TRUE);
00334       DeleteSlots(theEnv,slots);
00335       return(FALSE);
00336      }
00337 
00338    cls = NewClass(theEnv,cname);
00339    cls->abstract = abstract;
00340 #if DEFRULE_CONSTRUCT
00341    cls->reactive = reactive;
00342 #endif
00343    cls->directSuperclasses.classCount = sclasses->classCount;
00344    cls->directSuperclasses.classArray = sclasses->classArray;
00345 
00346    /* =======================================================
00347       This is a hack to let functions which need to iterate
00348       over a class AND its superclasses to conveniently do so
00349 
00350       The real precedence list starts in position 1
00351       ======================================================= */
00352    preclist->classArray[0] = cls;
00353    cls->allSuperclasses.classCount = preclist->classCount;
00354    cls->allSuperclasses.classArray = preclist->classArray;
00355    rtn_struct(theEnv,packedClassLinks,sclasses);
00356    rtn_struct(theEnv,packedClassLinks,preclist);
00357 
00358    /* =================================
00359       Shove slots into contiguous array
00360       ================================= */
00361    if (slots != NULL)
00362      PackSlots(theEnv,cls,slots);
00363    AddClass(theEnv,cls);
00364 
00365    return(FALSE);
00366   }
00367 
00368 /* =========================================
00369    *****************************************
00370           INTERNALLY VISIBLE FUNCTIONS
00371    =========================================
00372    ***************************************** */
00373 
00374 /***********************************************************
00375   NAME         : ValidClassName
00376   DESCRIPTION  : Determines if a new class of the given
00377                  name can be defined in the current module
00378   INPUTS       : 1) The new class name
00379                  2) Buffer to hold class address
00380   RETURNS      : TRUE if OK, FALSE otherwise
00381   SIDE EFFECTS : Error message printed if not OK
00382   NOTES        : GetConstructNameAndComment() (called before
00383                  this function) ensures that the defclass
00384                  name does not conflict with one from
00385                  another module
00386  ***********************************************************/
00387 static intBool ValidClassName(
00388   void *theEnv,
00389   char *theClassName,
00390   DEFCLASS **theDefclass)
00391   {
00392    *theDefclass = (DEFCLASS *) EnvFindDefclass(theEnv,theClassName);
00393    if (*theDefclass != NULL)
00394      {
00395       /* ===================================
00396          System classes (which are visible
00397          in all modules) cannot be redefined
00398          =================================== */
00399       if ((*theDefclass)->system)
00400         {
00401          PrintErrorID(theEnv,"CLASSPSR",2,FALSE);
00402          EnvPrintRouter(theEnv,WERROR,"Cannot redefine a predefined system class.\n");
00403          return(FALSE);
00404         }
00405 
00406       /* ===============================================
00407          A class in the current module can only be
00408          redefined if it is not in use, e.g., instances,
00409          generic function method restrictions, etc.
00410          =============================================== */
00411       if ((EnvIsDefclassDeletable(theEnv,(void *) *theDefclass) == FALSE) &&
00412           (! ConstructData(theEnv)->CheckSyntaxMode))
00413         {
00414          PrintErrorID(theEnv,"CLASSPSR",3,FALSE);
00415          EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) *theDefclass));
00416          EnvPrintRouter(theEnv,WERROR," class cannot be redefined while\n");
00417          EnvPrintRouter(theEnv,WERROR,"    outstanding references to it still exist.\n");
00418          return(FALSE);
00419         }
00420      }
00421    return(TRUE);
00422   }
00423 
00424 /***************************************************************
00425   NAME         : ParseSimpleQualifier
00426   DESCRIPTION  : Parses abstract/concrete role and
00427                  pattern-matching reactivity for class
00428   INPUTS       : 1) The input logical name
00429                  2) The name of the qualifier being parsed
00430                  3) The qualifier value indicating that the
00431                     qualifier should be false
00432                  4) The qualifier value indicating that the
00433                     qualifier should be TRUE
00434                  5) A pointer to a bitmap indicating
00435                     if the qualifier has already been parsed
00436                  6) A buffer to store the value of the qualifier
00437   RETURNS      : TRUE if all OK, FALSE otherwise
00438   SIDE EFFECTS : Bitmap and qualifier buffers set
00439                  Messages printed on errors
00440   NOTES        : None
00441  ***************************************************************/
00442 static intBool ParseSimpleQualifier(
00443   void *theEnv,
00444   char *readSource,
00445   char *classQualifier,
00446   char *clearRelation,
00447   char *setRelation,
00448   intBool *alreadyTestedFlag,
00449   intBool *binaryFlag)
00450   {
00451    if (*alreadyTestedFlag)
00452      {
00453       PrintErrorID(theEnv,"CLASSPSR",4,FALSE);
00454       EnvPrintRouter(theEnv,WERROR,"Class ");
00455       EnvPrintRouter(theEnv,WERROR,classQualifier);
00456       EnvPrintRouter(theEnv,WERROR," already declared.\n");
00457       return(FALSE);
00458      }
00459    SavePPBuffer(theEnv," ");
00460    GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
00461    if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
00462      goto ParseSimpleQualifierError;
00463    if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),setRelation) == 0)
00464      *binaryFlag = TRUE;
00465    else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),clearRelation) == 0)
00466      *binaryFlag = FALSE;
00467    else
00468      goto ParseSimpleQualifierError;
00469    GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
00470    if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
00471      goto ParseSimpleQualifierError;
00472    *alreadyTestedFlag = TRUE;
00473    return(TRUE);
00474 
00475 ParseSimpleQualifierError:
00476    SyntaxErrorMessage(theEnv,"defclass");
00477    return(FALSE);
00478   }
00479 
00480 /***************************************************
00481   NAME         : ReadUntilClosingParen
00482   DESCRIPTION  : Skips over tokens until a ')' is
00483                  encountered.
00484   INPUTS       : 1) The logical input source
00485                  2) A buffer for scanned tokens
00486   RETURNS      : TRUE if ')' read, FALSE
00487                  otherwise
00488   SIDE EFFECTS : Tokens read
00489   NOTES        : Expects first token after opening
00490                  paren has already been scanned
00491  ***************************************************/
00492 static intBool ReadUntilClosingParen(
00493   void *theEnv,
00494   char *readSource,
00495   struct token *inputToken)
00496   {
00497    int cnt = 1,lparen_read = FALSE;
00498 
00499    do
00500      {
00501       if (lparen_read == FALSE)
00502         SavePPBuffer(theEnv," ");
00503       GetToken(theEnv,readSource,inputToken);
00504       if (inputToken->type == STOP)
00505         {
00506          SyntaxErrorMessage(theEnv,"message-handler declaration");
00507          return(FALSE);
00508         }
00509       else if (inputToken->type == LPAREN)
00510         {
00511          lparen_read = TRUE;
00512          cnt++;
00513         }
00514       else if (inputToken->type == RPAREN)
00515         {
00516          cnt--;
00517          if (lparen_read == FALSE)
00518            {
00519             PPBackup(theEnv);
00520             PPBackup(theEnv);
00521             SavePPBuffer(theEnv,")");
00522            }
00523          lparen_read = FALSE;
00524         }
00525       else
00526         lparen_read = FALSE;
00527      }
00528    while (cnt > 0);
00529 
00530    return(TRUE);
00531   }
00532 
00533 /*****************************************************************************
00534   NAME         : AddClass
00535   DESCRIPTION  : Determines the precedence list of the new class.
00536                  If it is valid, the routine checks to see if the class
00537                  already exists.  If it does not, all the subclass
00538                  links are made from the class's direct superclasses,
00539                  and the class is inserted in the hash table.  If it
00540                  does, all sublclasses are deleted. An error will occur
00541                  if any instances of the class (direct or indirect) exist.
00542                  If all checks out, the old definition is replaced by the new.
00543   INPUTS       : The new class description
00544   RETURNS      : Nothing useful
00545   SIDE EFFECTS : The class is deleted if there is an error.
00546   NOTES        : No change in the class graph state will occur
00547                  if there were any errors.
00548                  Assumes class is not busy!!!
00549  *****************************************************************************/
00550 static void AddClass(
00551   void *theEnv,
00552   DEFCLASS *cls)
00553   {
00554    DEFCLASS *ctmp;
00555 #if DEBUGGING_FUNCTIONS
00556    int oldTraceInstances = FALSE,
00557        oldTraceSlots = FALSE;
00558 #endif
00559 
00560    /* ===============================================
00561       If class does not already exist, insert and
00562       form progeny links with all direct superclasses
00563       =============================================== */
00564    cls->hashTableIndex = HashClass(GetDefclassNamePointer((void *) cls));
00565    ctmp = (DEFCLASS *) EnvFindDefclass(theEnv,EnvGetDefclassName(theEnv,(void *) cls));
00566 
00567    if (ctmp != NULL)
00568      {
00569 #if DEBUGGING_FUNCTIONS
00570       oldTraceInstances = ctmp->traceInstances;
00571       oldTraceSlots = ctmp->traceSlots;
00572 #endif
00573       DeleteClassUAG(theEnv,ctmp);
00574      }
00575    PutClassInTable(theEnv,cls);
00576 
00577    BuildSubclassLinks(theEnv,cls);
00578    InstallClass(theEnv,cls,TRUE);
00579    AddConstructToModule((struct constructHeader *) cls);
00580 
00581    FormInstanceTemplate(theEnv,cls);
00582    FormSlotNameMap(theEnv,cls);
00583 
00584    AssignClassID(theEnv,cls);
00585 
00586 #if DEBUGGING_FUNCTIONS
00587    if (cls->abstract)
00588      {
00589       cls->traceInstances = FALSE;
00590       cls->traceSlots = FALSE;
00591      }
00592    else
00593      {
00594       if (oldTraceInstances)
00595         cls->traceInstances = TRUE;
00596       if (oldTraceSlots)
00597         cls->traceSlots = TRUE;
00598      }
00599 #endif
00600 
00601 #if DEBUGGING_FUNCTIONS
00602    if (EnvGetConserveMemory(theEnv) == FALSE)
00603      SetDefclassPPForm((void *) cls,CopyPPBuffer(theEnv));
00604 #endif
00605 
00606 #if DEFMODULE_CONSTRUCT
00607 
00608    /* =========================================
00609       Create a bitmap indicating whether this
00610       class is in scope or not for every module
00611       ========================================= */
00612    cls->scopeMap = (BITMAP_HN *) CreateClassScopeMap(theEnv,cls);
00613 
00614 #endif
00615 
00616    /* ==============================================
00617       Define get- and put- handlers for public slots
00618       ============================================== */
00619    CreatePublicSlotMessageHandlers(theEnv,cls);
00620   }
00621 
00622 /*******************************************************
00623   NAME         : BuildSubclassLinks
00624   DESCRIPTION  : Follows the list of superclasses
00625                  for a class and puts the class in
00626                  each of the superclasses' subclass
00627                  list.
00628   INPUTS       : The address of the class
00629   RETURNS      : Nothing useful
00630   SIDE EFFECTS : The subclass lists for every superclass
00631                  are modified.
00632   NOTES        : Assumes the superclass list is formed.
00633  *******************************************************/
00634 static void BuildSubclassLinks(
00635   void *theEnv,
00636   DEFCLASS *cls)
00637   {
00638    long i;
00639 
00640    for (i = 0 ; i < cls->directSuperclasses.classCount ; i++)
00641      AddClassLink(theEnv,&cls->directSuperclasses.classArray[i]->directSubclasses,cls,-1);
00642   }
00643 
00644 /**********************************************************
00645   NAME         : FormInstanceTemplate
00646   DESCRIPTION  : Forms a contiguous array of instance
00647                   slots for use in creating instances later
00648                  Also used in determining instance slot
00649                   indices a priori during handler defns
00650   INPUTS       : The class
00651   RETURNS      : Nothing useful
00652   SIDE EFFECTS : Contiguous array of instance slots formed
00653   NOTES        : None
00654  **********************************************************/
00655 static void FormInstanceTemplate(
00656   void *theEnv,
00657   DEFCLASS *cls)
00658   {
00659    TEMP_SLOT_LINK *islots = NULL,*stmp;
00660    short scnt = 0;
00661    long i;
00662 
00663    /* ========================
00664       Get direct class's slots
00665       ======================== */
00666    islots = MergeSlots(theEnv,islots,cls,&scnt,DIRECT);
00667 
00668    /* ===================================================================
00669       Get all inherited slots - a more specific slot takes precedence
00670       over more general, i.e. the first class in the precedence list with
00671       a particular slot gets to specify its default value
00672       =================================================================== */
00673    for (i = 1 ; i < cls->allSuperclasses.classCount ; i++)
00674      islots = MergeSlots(theEnv,islots,cls->allSuperclasses.classArray[i],&scnt,INHERIT);
00675 
00676    /* ===================================================
00677       Allocate a contiguous array to store all the slots.
00678       =================================================== */
00679    cls->instanceSlotCount = scnt;
00680    cls->localInstanceSlotCount = 0;
00681    if (scnt > 0)
00682      cls->instanceTemplate = (SLOT_DESC **) gm2(theEnv,(scnt * sizeof(SLOT_DESC *)));
00683    for (i = 0 ; i < scnt ; i++)
00684      {
00685       stmp = islots;
00686       islots = islots->nxt;
00687       cls->instanceTemplate[i] = stmp->desc;
00688       if (stmp->desc->shared == 0)
00689         cls->localInstanceSlotCount++;
00690       rtn_struct(theEnv,tempSlotLink,stmp);
00691      }
00692   }
00693 
00694 /**********************************************************
00695   NAME         : FormSlotNameMap
00696   DESCRIPTION  : Forms a mapping of the slot name ids into
00697                  the instance template.  Given the slot
00698                  name id, this map provides a much faster
00699                  lookup of a slot.  The id is stored
00700                  statically in object patterns and can
00701                  be looked up via a hash table at runtime
00702                  as well.
00703   INPUTS       : The class
00704   RETURNS      : Nothing useful
00705   SIDE EFFECTS : Contiguous array of integers formed
00706                  The position in the array corresponding
00707                  to a slot name id holds an the index
00708                  into the instance template array holding
00709                  the slot
00710                  The max slot name id for the class is
00711                  also stored to make deletion of the slots
00712                  easier
00713   NOTES        : Assumes the instance template has already
00714                  been formed
00715  **********************************************************/
00716 static void FormSlotNameMap(
00717   void *theEnv,
00718   DEFCLASS *cls)
00719   {
00720    long i;
00721 
00722    cls->maxSlotNameID = 0;
00723    cls->slotNameMap = NULL;
00724    if (cls->instanceSlotCount == 0)
00725      return;
00726    for (i = 0 ; i < cls->instanceSlotCount ; i++)
00727      if (cls->instanceTemplate[i]->slotName->id > cls->maxSlotNameID)
00728        cls->maxSlotNameID = cls->instanceTemplate[i]->slotName->id;
00729    cls->slotNameMap = (unsigned *) gm2(theEnv,(sizeof(unsigned) * (cls->maxSlotNameID + 1)));
00730    for (i = 0 ; i <= cls->maxSlotNameID ; i++)
00731      cls->slotNameMap[i] = 0;
00732    for (i = 0 ; i < cls->instanceSlotCount ; i++)
00733      cls->slotNameMap[cls->instanceTemplate[i]->slotName->id] = i + 1;
00734   }
00735 
00736 /********************************************************************
00737   NAME         : MergeSlots
00738   DESCRIPTION  : Adds non-duplicate slots to list and increments
00739                    slot count for the class instance template
00740   INPUTS       : 1) The old slot list
00741                  2) The address of class containing new slots
00742                  3) Caller's buffer for # of slots
00743                  4) A flag indicating whether the new list of slots
00744                     is from the direct parent-class or not.
00745   RETURNS      : The address of the new expanded list, or NULL
00746                    for an empty list
00747   SIDE EFFECTS : The list is expanded
00748                  Caller's slot count is adjusted.
00749   NOTES        : Lists are assumed to contain no duplicates
00750  *******************************************************************/
00751 static TEMP_SLOT_LINK *MergeSlots(
00752   void *theEnv,
00753   TEMP_SLOT_LINK *old,
00754   DEFCLASS *cls,
00755   short *scnt,
00756   int src)
00757   {
00758    TEMP_SLOT_LINK *cur,*tmp;
00759    register int i;
00760    SLOT_DESC *newSlot;
00761 
00762    /* ======================================
00763       Process the slots in reverse order
00764       since we are pushing them onto a stack
00765       ====================================== */
00766    for (i = (int) (cls->slotCount - 1) ; i >= 0 ; i--)
00767      {
00768       newSlot = &cls->slots[i];
00769 
00770       /* ==========================================
00771          A class can prevent it slots from being
00772          propagated to all but its direct instances
00773          ========================================== */
00774       if ((newSlot->noInherit == 0) ? TRUE : (src == DIRECT))
00775         {
00776          cur = old;
00777          while ((cur != NULL) ? (newSlot->slotName != cur->desc->slotName) : FALSE)
00778            cur = cur->nxt;
00779          if (cur == NULL)
00780            {
00781             tmp = get_struct(theEnv,tempSlotLink);
00782             tmp->desc = newSlot;
00783             tmp->nxt = old;
00784             old = tmp;
00785             (*scnt)++;
00786            }
00787         }
00788      }
00789    return(old);
00790   }
00791 
00792 /***********************************************************************
00793   NAME         : PackSlots
00794   DESCRIPTION  : Groups class-slots into a contiguous array
00795                   "slots" field points to array
00796                   "slotCount" field set
00797   INPUTS       : 1) The class
00798                  2) The list of slots
00799   RETURNS      : Nothing useful
00800   SIDE EFFECTS : Temporary list deallocated, contiguous array allocated,
00801                    and nxt pointers linked
00802                  Class pointer set for slots
00803   NOTES        : Assumes class->slotCount == 0 && class->slots == NULL
00804  ***********************************************************************/
00805 static void PackSlots(
00806   void *theEnv,
00807   DEFCLASS *cls,
00808   TEMP_SLOT_LINK *slots)
00809   {
00810    TEMP_SLOT_LINK *stmp,*sprv;
00811    long i;
00812 
00813    stmp = slots;
00814    while  (stmp != NULL)
00815      {
00816       stmp->desc->cls = cls;
00817       cls->slotCount++;
00818       stmp = stmp->nxt;
00819      }
00820    cls->slots = (SLOT_DESC *) gm2(theEnv,(sizeof(SLOT_DESC) * cls->slotCount));
00821    stmp = slots;
00822    for (i = 0 ; i < cls->slotCount ; i++)
00823      {
00824       sprv = stmp;
00825       stmp = stmp->nxt;
00826       GenCopyMemory(SLOT_DESC,1,&(cls->slots[i]),sprv->desc);
00827       cls->slots[i].sharedValue.desc = &(cls->slots[i]);
00828       cls->slots[i].sharedValue.value = NULL;
00829       rtn_struct(theEnv,slotDescriptor,sprv->desc);
00830       rtn_struct(theEnv,tempSlotLink,sprv);
00831      }
00832   }
00833 
00834 #if DEFMODULE_CONSTRUCT
00835 
00836 /********************************************************
00837   NAME         : CreateClassScopeMap
00838   DESCRIPTION  : Creates a bitmap where each bit position
00839                  corresponds to a module id. If the bit
00840                  is set, the class is in scope for that
00841                  module, otherwise it is not.
00842   INPUTS       : The class
00843   RETURNS      : Nothing useful
00844   SIDE EFFECTS : Scope bitmap created and attached
00845   NOTES        : Uses FindImportedConstruct()
00846  ********************************************************/
00847 globle void *CreateClassScopeMap(
00848   void *theEnv,
00849   DEFCLASS *theDefclass)
00850   {
00851    unsigned scopeMapSize;
00852    char *scopeMap;
00853    char *className;
00854    struct defmodule *matchModule,
00855                     *theModule;
00856    int moduleID,count;
00857    void *theBitMap;
00858 
00859    className = ValueToString(theDefclass->header.name);
00860    matchModule = theDefclass->header.whichModule->theModule;
00861 
00862    scopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1));
00863    scopeMap = (char *) gm2(theEnv,scopeMapSize);
00864 
00865    ClearBitString((void *) scopeMap,scopeMapSize);
00866    SaveCurrentModule(theEnv);
00867    for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL) ;
00868         theModule != NULL ;
00869         theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule))
00870      {
00871       EnvSetCurrentModule(theEnv,(void *) theModule);
00872       moduleID = (int) theModule->bsaveID;
00873       if (FindImportedConstruct(theEnv,"defclass",matchModule,
00874                                 className,&count,TRUE,NULL) != NULL)
00875         SetBitMap(scopeMap,moduleID);
00876      }
00877    RestoreCurrentModule(theEnv);
00878    theBitMap = (BITMAP_HN *) EnvAddBitMap(theEnv,scopeMap,scopeMapSize);
00879    IncrementBitMapCount(theBitMap);
00880    rm(theEnv,(void *) scopeMap,scopeMapSize);
00881    return(theBitMap);
00882   }
00883 
00884 #endif
00885 
00886 /*****************************************************************************
00887   NAME         : CreatePublicSlotMessageHandlers
00888   DESCRIPTION  : Creates a get-<slot-name> and
00889                  put-<slot-name> handler for every
00890                  public slot in a class.
00891 
00892                  The syntax of the message-handlers
00893                  created are:
00894 
00895                  (defmessage-handler <class> get-<slot-name> primary ()
00896                     ?self:<slot-name>)
00897 
00898                  For single-field slots:
00899 
00900                  (defmessage-handler <class> put-<slot-name> primary (?value)
00901                     (bind ?self:<slot-name> ?value))
00902 
00903                  For multifield slots:
00904 
00905                  (defmessage-handler <class> put-<slot-name> primary ($?value)
00906                     (bind ?self:<slot-name> ?value))
00907   INPUTS       : The defclass
00908   RETURNS      : Nothing useful
00909   SIDE EFFECTS : Message-handlers created
00910   NOTES        : None
00911  ******************************************************************************/
00912 static void CreatePublicSlotMessageHandlers(
00913   void *theEnv,
00914   DEFCLASS *theDefclass)
00915   {
00916    long i;
00917    register SLOT_DESC *sd;
00918 
00919    for (i = 0 ; i < theDefclass->slotCount ; i++)
00920      {
00921       sd = &theDefclass->slots[i];
00922         CreateGetAndPutHandlers(theEnv,sd);
00923      }
00924    for (i = 0 ; i < theDefclass->handlerCount ; i++)
00925      theDefclass->handlers[i].system = TRUE;
00926   }
00927 
00928 #endif
00929