1    /*******************************************************/
2    /*      "C" Language Integrated Production System      */
3    /*                                                     */
4    /*               CLIPS Version 6.30  08/22/14          */
5    /*                                                     */
6    /*              MESSAGE-HANDLER PARSER FUNCTIONS       */
7    /*******************************************************/
8 
9 /*************************************************************/
10 /* Purpose:                                                  */
11 /*                                                           */
12 /* Principal Programmer(s):                                  */
13 /*      Brian L. Dantes                                      */
14 /*                                                           */
15 /* Contributing Programmer(s):                               */
16 /*                                                           */
17 /* Revision History:                                         */
18 /*                                                           */
19 /*      6.23: Changed name of variable exp to theExp         */
20 /*            because of Unix compiler warnings of shadowed  */
21 /*            definitions.                                   */
22 /*                                                           */
23 /*      6.24: Removed IMPERATIVE_MESSAGE_HANDLERS            */
24 /*                    compilation flag.                      */
25 /*                                                           */
26 /*      6.30: Renamed BOOLEAN macro type to intBool.         */
27 /*                                                           */
28 /*            GetConstructNameAndComment API change.         */
29 /*                                                           */
30 /*            Changed integer type/precision.                */
31 /*                                                           */
32 /*            Used gensprintf instead of sprintf.            */
33 /*                                                           */
34 /*            Added const qualifiers to remove C++           */
35 /*            deprecation warnings.                          */
36 /*                                                           */
37 /*            Fixed linkage issue when BLOAD_AND_SAVE        */
38 /*            compiler flag is set to 0.                     */
39 /*                                                           */
40 /*************************************************************/
41 
42 /* =========================================
43    *****************************************
44                EXTERNAL DEFINITIONS
45    =========================================
46    ***************************************** */
47 #include "setup.h"
48 
49 #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME)
50 
51 #include <string.h>
52 
53 #if BLOAD || BLOAD_AND_BSAVE
54 #include "bload.h"
55 #endif
56 
57 #include "classcom.h"
58 #include "classfun.h"
59 #include "memalloc.h"
60 #include "constrct.h"
61 #include "cstrcpsr.h"
62 #include "cstrnchk.h"
63 #include "envrnmnt.h"
64 #include "exprnpsr.h"
65 #include "insfun.h"
66 #include "msgcom.h"
67 #include "msgfun.h"
68 #include "pprint.h"
69 #include "prccode.h"
70 #include "router.h"
71 #include "scanner.h"
72 #include "strngrtr.h"
73 #include "sysdep.h"
74 
75 #define _MSGPSR_SOURCE_
76 #include "msgpsr.h"
77 
78 /* =========================================
79    *****************************************
80                    CONSTANTS
81    =========================================
82    ***************************************** */
83 #define SELF_LEN         4
84 #define SELF_SLOT_REF   ':'
85 
86 /* =========================================
87    *****************************************
88       INTERNALLY VISIBLE FUNCTION HEADERS
89    =========================================
90    ***************************************** */
91 
92 static intBool IsParameterSlotReference(void *,const char *);
93 static int SlotReferenceVar(void *,EXPRESSION *,void *);
94 static int BindSlotReference(void *,EXPRESSION *,void *);
95 static SLOT_DESC *CheckSlotReference(void *,DEFCLASS *,int,void *,intBool,EXPRESSION *);
96 static void GenHandlerSlotReference(void *,EXPRESSION *,unsigned short,SLOT_DESC *);
97 
98 /* =========================================
99    *****************************************
100           EXTERNALLY VISIBLE FUNCTIONS
101    =========================================
102    ***************************************** */
103 
104 /***********************************************************************
105   NAME         : ParseDefmessageHandler
106   DESCRIPTION  : Parses a message-handler for a class of objects
107   INPUTS       : The logical name of the input source
108   RETURNS      : FALSE if successful parse, TRUE otherwise
109   SIDE EFFECTS : Handler allocated and inserted into class
110   NOTES        : H/L Syntax:
111 
112                  (defmessage-handler <class> <name> [<type>] [<comment>]
113                     (<params>)
114                     <action>*)
115 
116                  <params> ::= <var>* | <var>* $?<name>
117  ***********************************************************************/
ParseDefmessageHandler(void * theEnv,const char * readSource)118 globle int ParseDefmessageHandler(
119   void *theEnv,
120   const char *readSource)
121   {
122    DEFCLASS *cls;
123    SYMBOL_HN *cname,*mname,*wildcard;
124    unsigned mtype = MPRIMARY;
125    int min,max,error,lvars;
126    EXPRESSION *hndParams,*actions;
127    HANDLER *hnd;
128 
129    SetPPBufferStatus(theEnv,ON);
130    FlushPPBuffer(theEnv);
131    SetIndentDepth(theEnv,3);
132    SavePPBuffer(theEnv,"(defmessage-handler ");
133 
134 #if BLOAD || BLOAD_AND_BSAVE
135    if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
136      {
137       CannotLoadWithBloadMessage(theEnv,"defmessage-handler");
138       return(TRUE);
139      }
140 #endif
141    cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler",
142                                       NULL,NULL,"~",TRUE,FALSE,TRUE,FALSE);
143    if (cname == NULL)
144      return(TRUE);
145    cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname));
146    if (cls == NULL)
147      {
148       PrintErrorID(theEnv,"MSGPSR",1,FALSE);
149       EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n");
150       return(TRUE);
151      }
152    if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) ||
153        (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) ||
154        (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0]))
155      {
156       PrintErrorID(theEnv,"MSGPSR",8,FALSE);
157       EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class ");
158       EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls));
159       EnvPrintRouter(theEnv,WERROR,".\n");
160       return(TRUE);
161      }
162    if (HandlersExecuting(cls))
163      {
164       PrintErrorID(theEnv,"MSGPSR",2,FALSE);
165       EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n");
166       EnvPrintRouter(theEnv,WERROR,"  other message-handlers for the same class.\n");
167       return(TRUE);
168      }
169    if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
170      {
171       SyntaxErrorMessage(theEnv,"defmessage-handler");
172       return(TRUE);
173      }
174    PPBackup(theEnv);
175    PPBackup(theEnv);
176    SavePPBuffer(theEnv," ");
177    SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
178    SavePPBuffer(theEnv," ");
179    mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken);
180    GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
181    if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN)
182      {
183       SavePPBuffer(theEnv," ");
184       if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING)
185         {
186          if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
187            {
188             SyntaxErrorMessage(theEnv,"defmessage-handler");
189             return(TRUE);
190            }
191          mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken));
192          if (mtype == MERROR)
193            return(TRUE);
194 
195          GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
196          if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING)
197            {
198             SavePPBuffer(theEnv," ");
199             GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
200            }
201         }
202       else
203         {
204          SavePPBuffer(theEnv," ");
205          GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
206         }
207      }
208    PPBackup(theEnv);
209    PPBackup(theEnv);
210    PPCRAndIndent(theEnv);
211    SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
212 
213    hnd = FindHandlerByAddress(cls,mname,mtype);
214    if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv))
215      {
216       EnvPrintRouter(theEnv,WDIALOG,"   Handler ");
217       EnvPrintRouter(theEnv,WDIALOG,ValueToString(mname));
218       EnvPrintRouter(theEnv,WDIALOG," ");
219       EnvPrintRouter(theEnv,WDIALOG,MessageHandlerData(theEnv)->hndquals[mtype]);
220       if (hnd == NULL)
221         EnvPrintRouter(theEnv,WDIALOG," defined.\n");
222       else
223         EnvPrintRouter(theEnv,WDIALOG," redefined.\n");
224      }
225 
226    if ((hnd != NULL) ? hnd->system : FALSE)
227      {
228       PrintErrorID(theEnv,"MSGPSR",3,FALSE);
229       EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n");
230       return(TRUE);
231      }
232 
233    hndParams = GenConstant(theEnv,SYMBOL,(void *) MessageHandlerData(theEnv)->SELF_SYMBOL);
234    hndParams = ParseProcParameters(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,hndParams,
235                                     &wildcard,&min,&max,&error,IsParameterSlotReference);
236    if (error)
237      return(TRUE);
238    PPCRAndIndent(theEnv);
239    ExpressionData(theEnv)->ReturnContext = TRUE;
240    actions = ParseProcActions(theEnv,"message-handler",readSource,
241                               &DefclassData(theEnv)->ObjectParseToken,hndParams,wildcard,
242                               SlotReferenceVar,BindSlotReference,&lvars,
243                               (void *) cls);
244    if (actions == NULL)
245      {
246       ReturnExpression(theEnv,hndParams);
247       return(TRUE);
248      }
249    if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
250      {
251       SyntaxErrorMessage(theEnv,"defmessage-handler");
252       ReturnExpression(theEnv,hndParams);
253       ReturnPackedExpression(theEnv,actions);
254       return(TRUE);
255      }
256    PPBackup(theEnv);
257    PPBackup(theEnv);
258    SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
259    SavePPBuffer(theEnv,"\n");
260 
261    /* ===================================================
262       If we're only checking syntax, don't add the
263       successfully parsed defmessage-handler to the KB.
264       =================================================== */
265 
266    if (ConstructData(theEnv)->CheckSyntaxMode)
267      {
268       ReturnExpression(theEnv,hndParams);
269       ReturnPackedExpression(theEnv,actions);
270       return(FALSE);
271      }
272 
273    if (hnd != NULL)
274      {
275       ExpressionDeinstall(theEnv,hnd->actions);
276       ReturnPackedExpression(theEnv,hnd->actions);
277       if (hnd->ppForm != NULL)
278         rm(theEnv,(void *) hnd->ppForm,
279            (sizeof(char) * (strlen(hnd->ppForm)+1)));
280      }
281    else
282      {
283       hnd = InsertHandlerHeader(theEnv,cls,mname,(int) mtype);
284       IncrementSymbolCount(hnd->name);
285      }
286    ReturnExpression(theEnv,hndParams);
287 
288    hnd->minParams = (short) min;
289    hnd->maxParams = (short) max;
290    hnd->localVarCount = (short) lvars;
291    hnd->actions = actions;
292    ExpressionInstall(theEnv,hnd->actions);
293 #if DEBUGGING_FUNCTIONS
294 
295    /* ===================================================
296       Old handler trace status is automatically preserved
297       =================================================== */
298    if (EnvGetConserveMemory(theEnv) == FALSE)
299      hnd->ppForm = CopyPPBuffer(theEnv);
300    else
301 #endif
302      hnd->ppForm = NULL;
303    return(FALSE);
304   }
305 
306 /*******************************************************************************
307   NAME         : CreateGetAndPutHandlers
308   DESCRIPTION  : Creates two message-handlers with
309                   the following syntax for the slot:
310 
311                  (defmessage-handler <class> get-<slot-name> primary ()
312                     ?self:<slot-name>)
313 
314                  For single-field slots:
315 
316                  (defmessage-handler <class> put-<slot-name> primary (?value)
317                     (bind ?self:<slot-name> ?value))
318 
319                  For multifield slots:
320 
321                  (defmessage-handler <class> put-<slot-name> primary ($?value)
322                     (bind ?self:<slot-name> ?value))
323 
324   INPUTS       : The class slot descriptor
325   RETURNS      : Nothing useful
326   SIDE EFFECTS : Message-handlers created
327   NOTES        : A put handler is not created for read-only slots
328  *******************************************************************************/
CreateGetAndPutHandlers(void * theEnv,SLOT_DESC * sd)329 globle void CreateGetAndPutHandlers(
330   void *theEnv,
331   SLOT_DESC *sd)
332   {
333    const char *className,*slotName;
334    size_t bufsz;
335    char *buf;
336    const char *handlerRouter = "*** Default Public Handlers ***";
337    int oldPWL,oldCM;
338    const char *oldRouter;
339    char *oldString;
340    long oldIndex;
341 
342    if ((sd->createReadAccessor == 0) && (sd->createWriteAccessor == 0))
343      return;
344    className = ValueToString(sd->cls->header.name);
345    slotName = ValueToString(sd->slotName->name);
346 
347    bufsz = (sizeof(char) * (strlen(className) + (strlen(slotName) * 2) + 80));
348    buf = (char *) gm2(theEnv,bufsz);
349 
350    oldPWL = GetPrintWhileLoading(theEnv);
351    SetPrintWhileLoading(theEnv,FALSE);
352    oldCM = EnvSetConserveMemory(theEnv,TRUE);
353 
354    if (sd->createReadAccessor)
355      {
356       gensprintf(buf,"%s get-%s () ?self:%s)",className,slotName,slotName);
357 
358       oldRouter = RouterData(theEnv)->FastCharGetRouter;
359       oldString = RouterData(theEnv)->FastCharGetString;
360       oldIndex = RouterData(theEnv)->FastCharGetIndex;
361 
362       RouterData(theEnv)->FastCharGetRouter = handlerRouter;
363       RouterData(theEnv)->FastCharGetIndex = 0;
364       RouterData(theEnv)->FastCharGetString = buf;
365 
366       ParseDefmessageHandler(theEnv,handlerRouter);
367       DestroyPPBuffer(theEnv);
368       /*
369       if (OpenStringSource(theEnv,handlerRouter,buf,0))
370         {
371          ParseDefmessageHandler(handlerRouter);
372          DestroyPPBuffer();
373          CloseStringSource(theEnv,handlerRouter);
374         }
375       */
376       RouterData(theEnv)->FastCharGetRouter = oldRouter;
377       RouterData(theEnv)->FastCharGetIndex = oldIndex;
378       RouterData(theEnv)->FastCharGetString = oldString;
379      }
380 
381    if (sd->createWriteAccessor)
382      {
383       gensprintf(buf,"%s put-%s ($?value) (bind ?self:%s ?value))",
384                   className,slotName,slotName);
385 
386       oldRouter = RouterData(theEnv)->FastCharGetRouter;
387       oldString = RouterData(theEnv)->FastCharGetString;
388       oldIndex = RouterData(theEnv)->FastCharGetIndex;
389 
390       RouterData(theEnv)->FastCharGetRouter = handlerRouter;
391       RouterData(theEnv)->FastCharGetIndex = 0;
392       RouterData(theEnv)->FastCharGetString = buf;
393 
394       ParseDefmessageHandler(theEnv,handlerRouter);
395       DestroyPPBuffer(theEnv);
396 
397 /*
398       if (OpenStringSource(theEnv,handlerRouter,buf,0))
399         {
400          ParseDefmessageHandler(handlerRouter);
401          DestroyPPBuffer();
402          CloseStringSource(theEnv,handlerRouter);
403         }
404 */
405       RouterData(theEnv)->FastCharGetRouter = oldRouter;
406       RouterData(theEnv)->FastCharGetIndex = oldIndex;
407       RouterData(theEnv)->FastCharGetString = oldString;
408      }
409 
410    SetPrintWhileLoading(theEnv,oldPWL);
411    EnvSetConserveMemory(theEnv,oldCM);
412 
413    rm(theEnv,(void *) buf,bufsz);
414   }
415 
416 /* =========================================
417    *****************************************
418           INTERNALLY VISIBLE FUNCTIONS
419    =========================================
420    ***************************************** */
421 
422 /*****************************************************************
423   NAME         : IsParameterSlotReference
424   DESCRIPTION  : Determines if a message-handler parameter is of
425                  the form ?self:<name>, which is not allowed since
426                  this is slot reference syntax
427   INPUTS       : The paramter name
428   RETURNS      : TRUE if the parameter is a slot reference,
429                  FALSE otherwise
430   SIDE EFFECTS : None
431   NOTES        : None
432  *****************************************************************/
IsParameterSlotReference(void * theEnv,const char * pname)433 static intBool IsParameterSlotReference(
434   void *theEnv,
435   const char *pname)
436   {
437    if ((strncmp(pname,SELF_STRING,SELF_LEN) == 0) ?
438                   (pname[SELF_LEN] == SELF_SLOT_REF) : FALSE)
439      {
440       PrintErrorID(theEnv,"MSGPSR",4,FALSE);
441       EnvPrintRouter(theEnv,WERROR,"Illegal slot reference in parameter list.\n");
442       return(TRUE);
443      }
444    return(FALSE);
445   }
446 
447 /****************************************************************************
448   NAME         : SlotReferenceVar
449   DESCRIPTION  : Replaces direct slot references in handler body
450                    with special function calls to reference active instance
451                    at run-time
452                  The slot in in the class bound at parse-time is always
453                    referenced (early binding).
454                  Slot references of the form ?self:<name> directly reference
455                    ProcParamArray[0] (the message object - ?self) to
456                    find the specified slot at run-time
457   INPUTS       : 1) Variable expression
458                  2) The class of the handler being parsed
459   RETURNS      : 0 if not recognized, 1 if so, -1 on errors
460   SIDE EFFECTS : Handler body SF_VARIABLE and MF_VARIABLE replaced with
461                    direct slot access function
462   NOTES        : Objects are allowed to directly access their own slots
463                  without sending a message to themselves.  Since the object
464                  is "within the boundary of its internals", this does not
465                  violate the encapsulation principle of OOP.
466  ****************************************************************************/
SlotReferenceVar(void * theEnv,EXPRESSION * varexp,void * userBuffer)467 static int SlotReferenceVar(
468   void *theEnv,
469   EXPRESSION *varexp,
470   void *userBuffer)
471   {
472    struct token itkn;
473    int oldpp;
474    SLOT_DESC *sd;
475 
476    if ((varexp->type != SF_VARIABLE) && (varexp->type != MF_VARIABLE))
477      return(0);
478    if ((strncmp(ValueToString(varexp->value),SELF_STRING,SELF_LEN) == 0) ?
479                (ValueToString(varexp->value)[SELF_LEN] == SELF_SLOT_REF) : FALSE)
480      {
481       OpenStringSource(theEnv,"hnd-var",ValueToString(varexp->value) + SELF_LEN + 1,0);
482       oldpp = GetPPBufferStatus(theEnv);
483       SetPPBufferStatus(theEnv,OFF);
484       GetToken(theEnv,"hnd-var",&itkn);
485       SetPPBufferStatus(theEnv,oldpp);
486       CloseStringSource(theEnv,"hnd-var");
487       if (itkn.type != STOP)
488         {
489          sd = CheckSlotReference(theEnv,(DEFCLASS *) userBuffer,itkn.type,itkn.value,
490                                  FALSE,NULL);
491          if (sd == NULL)
492            return(-1);
493          GenHandlerSlotReference(theEnv,varexp,HANDLER_GET,sd);
494          return(1);
495         }
496      }
497    return(0);
498   }
499 
500 /****************************************************************************
501   NAME         : BindSlotReference
502   DESCRIPTION  : Replaces direct slot binds in handler body with special
503                  function calls to reference active instance at run-time
504                  The slot in in the class bound at parse-time is always
505                  referenced (early binding).
506                  Slot references of the form ?self:<name> directly reference
507                    ProcParamArray[0] (the message object - ?self) to
508                    find the specified slot at run-time
509   INPUTS       : 1) Variable expression
510                  2) The class for the message-handler being parsed
511   RETURNS      : 0 if not recognized, 1 if so, -1 on errors
512   SIDE EFFECTS : Handler body "bind" call replaced with  direct slot access
513                    function
514   NOTES        : Objects are allowed to directly access their own slots
515                  without sending a message to themselves.  Since the object
516                  is "within the boundary of its internals", this does not
517                  violate the encapsulation principle of OOP.
518  ****************************************************************************/
BindSlotReference(void * theEnv,EXPRESSION * bindExp,void * userBuffer)519 static int BindSlotReference(
520   void *theEnv,
521   EXPRESSION *bindExp,
522   void *userBuffer)
523   {
524    const char *bindName;
525    struct token itkn;
526    int oldpp;
527    SLOT_DESC *sd;
528    EXPRESSION *saveExp;
529 
530    bindName = ValueToString(bindExp->argList->value);
531    if (strcmp(bindName,SELF_STRING) == 0)
532      {
533       PrintErrorID(theEnv,"MSGPSR",5,FALSE);
534       EnvPrintRouter(theEnv,WERROR,"Active instance parameter cannot be changed.\n");
535       return(-1);
536      }
537    if ((strncmp(bindName,SELF_STRING,SELF_LEN) == 0) ?
538                (bindName[SELF_LEN] == SELF_SLOT_REF) : FALSE)
539      {
540       OpenStringSource(theEnv,"hnd-var",bindName + SELF_LEN + 1,0);
541       oldpp = GetPPBufferStatus(theEnv);
542       SetPPBufferStatus(theEnv,OFF);
543       GetToken(theEnv,"hnd-var",&itkn);
544       SetPPBufferStatus(theEnv,oldpp);
545       CloseStringSource(theEnv,"hnd-var");
546       if (itkn.type != STOP)
547         {
548          saveExp = bindExp->argList->nextArg;
549          sd = CheckSlotReference(theEnv,(DEFCLASS *) userBuffer,itkn.type,itkn.value,
550                                  TRUE,saveExp);
551          if (sd == NULL)
552            return(-1);
553          GenHandlerSlotReference(theEnv,bindExp,HANDLER_PUT,sd);
554          bindExp->argList->nextArg = NULL;
555          ReturnExpression(theEnv,bindExp->argList);
556          bindExp->argList = saveExp;
557          return(1);
558         }
559      }
560    return(0);
561   }
562 
563 /*********************************************************
564   NAME         : CheckSlotReference
565   DESCRIPTION  : Examines a ?self:<slot-name> reference
566                  If the reference is a single-field or
567                  global variable, checking and evaluation
568                  is delayed until run-time.  If the
569                  reference is a symbol, this routine
570                  verifies that the slot is a legal
571                  slot for the reference (i.e., it exists
572                  in the class to which the message-handler
573                  is being attached, it is visible and it
574                  is writable for write reference)
575   INPUTS       : 1) A buffer holding the class
576                     of the handler being parsed
577                  2) The type of the slot reference
578                  3) The value of the slot reference
579                  4) A flag indicating if this is a read
580                     or write access
581                  5) Value expression for write
582   RETURNS      : Class slot on success, NULL on errors
583   SIDE EFFECTS : Messages printed on errors.
584   NOTES        : For static references, this function
585                  insures that the slot is either
586                  publicly visible or that the handler
587                  is being attached to the same class in
588                  which the private slot is defined.
589  *********************************************************/
CheckSlotReference(void * theEnv,DEFCLASS * theDefclass,int theType,void * theValue,intBool writeFlag,EXPRESSION * writeExpression)590 static SLOT_DESC *CheckSlotReference(
591   void *theEnv,
592   DEFCLASS *theDefclass,
593   int theType,
594   void *theValue,
595   intBool writeFlag,
596   EXPRESSION *writeExpression)
597   {
598    int slotIndex;
599    SLOT_DESC *sd;
600    int vCode;
601 
602    if (theType != SYMBOL)
603      {
604       PrintErrorID(theEnv,"MSGPSR",7,FALSE);
605       EnvPrintRouter(theEnv,WERROR,"Illegal value for ?self reference.\n");
606       return(NULL);
607      }
608    slotIndex = FindInstanceTemplateSlot(theEnv,theDefclass,(SYMBOL_HN *) theValue);
609    if (slotIndex == -1)
610      {
611       PrintErrorID(theEnv,"MSGPSR",6,FALSE);
612       EnvPrintRouter(theEnv,WERROR,"No such slot ");
613       EnvPrintRouter(theEnv,WERROR,ValueToString(theValue));
614       EnvPrintRouter(theEnv,WERROR," in class ");
615       EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) theDefclass));
616       EnvPrintRouter(theEnv,WERROR," for ?self reference.\n");
617       return(NULL);
618      }
619    sd = theDefclass->instanceTemplate[slotIndex];
620    if ((sd->publicVisibility == 0) && (sd->cls != theDefclass))
621      {
622       SlotVisibilityViolationError(theEnv,sd,theDefclass);
623       return(NULL);
624      }
625    if (! writeFlag)
626      return(sd);
627 
628    /* =================================================
629       If a slot is initialize-only, the WithinInit flag
630       still needs to be checked at run-time, for the
631       handler could be called out of the context of
632       an init.
633       ================================================= */
634    if (sd->noWrite && (sd->initializeOnly == 0))
635      {
636       SlotAccessViolationError(theEnv,ValueToString(theValue),
637                                FALSE,(void *) theDefclass);
638       return(NULL);
639      }
640 
641    if (EnvGetStaticConstraintChecking(theEnv))
642      {
643       vCode = ConstraintCheckExpressionChain(theEnv,writeExpression,sd->constraint);
644       if (vCode != NO_VIOLATION)
645         {
646          PrintErrorID(theEnv,"CSTRNCHK",1,FALSE);
647          EnvPrintRouter(theEnv,WERROR,"Expression for ");
648          PrintSlot(theEnv,WERROR,sd,NULL,"direct slot write");
649          ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0,
650                                          vCode,sd->constraint,FALSE);
651          return(NULL);
652         }
653      }
654    return(sd);
655   }
656 
657 /***************************************************
658   NAME         : GenHandlerSlotReference
659   DESCRIPTION  : Creates a bitmap of the class id
660                  and slot index for the get or put
661                  operation. The bitmap and operation
662                  type are stored in the given
663                  expression.
664   INPUTS       : 1) The expression
665                  2) The operation type
666                  3) The class slot
667   RETURNS      : Nothing useful
668   SIDE EFFECTS : Bitmap created and expression
669                  initialized
670   NOTES        : None
671  ***************************************************/
GenHandlerSlotReference(void * theEnv,EXPRESSION * theExp,unsigned short theType,SLOT_DESC * sd)672 static void GenHandlerSlotReference(
673   void *theEnv,
674   EXPRESSION *theExp,
675   unsigned short theType,
676   SLOT_DESC *sd)
677   {
678    HANDLER_SLOT_REFERENCE handlerReference;
679 
680    ClearBitString(&handlerReference,sizeof(HANDLER_SLOT_REFERENCE));
681    handlerReference.classID = (unsigned short) sd->cls->id;
682    handlerReference.slotID = (unsigned) sd->slotName->id;
683    theExp->type = theType;
684    theExp->value =  EnvAddBitMap(theEnv,(void *) &handlerReference,
685                            (int) sizeof(HANDLER_SLOT_REFERENCE));
686   }
687 
688 #endif
689