/*******************************************************/ /* "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 . */ /* */ /* 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 [] (is-a +) *) :== (slot *) | (role abstract|concrete) | (pattern-match reactive|non-reactive) These are for documentation only: (message-handler []) :== (default ) | (default-dynamic ) | (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 ) (type ...) | (cardinality ...) | (allowed-symbols ...) | (allowed-strings ...) | (allowed-numbers ...) | (allowed-integers ...) | (allowed-floats ...) | (allowed-values ...) | (allowed-instance-names ...) | (allowed-classes ...) | (range ...) ::= ?NONE | ?VARIABLE | * ***************************************************************************************/ 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- and put- handler for every public slot in a class. The syntax of the message-handlers created are: (defmessage-handler get- primary () ?self:) For single-field slots: (defmessage-handler put- primary (?value) (bind ?self: ?value)) For multifield slots: (defmessage-handler put- primary ($?value) (bind ?self: ?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