src/msgpass.c

   1    /*******************************************************/
   2    /*      "C" Language Integrated Production System      */
   3    /*                                                     */
   4    /*               CLIPS Version 6.30  01/13/15          */
   5    /*                                                     */
   6    /*              OBJECT MESSAGE DISPATCH CODE           */
   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: Correction for FalseSymbol/TrueSymbol. DR0859  */
  20 /*                                                           */
  21 /*      6.24: Removed IMPERATIVE_MESSAGE_HANDLERS and        */
  22 /*            AUXILIARY_MESSAGE_HANDLERS compilation flags.  */
  23 /*                                                           */
  24 /*            Renamed BOOLEAN macro type to intBool.         */
  25 /*                                                           */
  26 /*      6.30: The return value of DirectMessage indicates    */
  27 /*            whether an execution error has occurred.       */
  28 /*                                                           */
  29 /*            Removed conditional code for unsupported       */
  30 /*            compilers/operating systems (IBM_MCW,          */
  31 /*            MAC_MCW, and IBM_TBC).                         */
  32 /*                                                           */
  33 /*            Changed garbage collection algorithm.          */
  34 /*                                                           */
  35 /*            Added const qualifiers to remove C++           */
  36 /*            deprecation warnings.                          */
  37 /*                                                           */
  38 /*            Converted API macros to function calls.        */
  39 /*                                                           */
  40 /*            It's no longer necessary for a defclass to be  */
  41 /*            in scope in order to sent a message to an      */
  42 /*            instance of that class.                        */
  43 /*                                                           */
  44 /*************************************************************/
  45
  46 /* =========================================
  47    *****************************************
  48                EXTERNAL DEFINITIONS
  49    =========================================
  50    ***************************************** */
  51 #include "setup.h"
  52
  53 #if OBJECT_SYSTEM
  54
  55 #ifndef _STDIO_INCLUDED_
  56 #include <stdio.h>
  57 #define _STDIO_INCLUDED_
  58 #endif
  59 #include <stdlib.h>
  60
  61 #include "argacces.h"
  62 #include "classcom.h"
  63 #include "classfun.h"
  64 #include "memalloc.h"
  65 #include "constrct.h"
  66 #include "envrnmnt.h"
  67 #include "exprnpsr.h"
  68 #include "insfun.h"
  69 #include "msgcom.h"
  70 #include "msgfun.h"
  71 #include "multifld.h"
  72 #include "prcdrfun.h"
  73 #include "prccode.h"
  74 #include "proflfun.h"
  75 #include "router.h"
  76 #include "strngfun.h"
  77 #include "utility.h"
  78 #include "commline.h"
  79
  80 #define _MSGPASS_SOURCE_
  81 #include "msgpass.h"
  82
  83 #include "inscom.h"
  84
  85 /* =========================================
  86    *****************************************
  87       INTERNALLY VISIBLE FUNCTION HEADERS
  88    =========================================
  89    ***************************************** */
  90
  91 static intBool PerformMessage(void *,DATA_OBJECT *,EXPRESSION *,SYMBOL_HN *);
  92 static HANDLER_LINK *FindApplicableHandlers(void *,DEFCLASS *,SYMBOL_HN *);
  93 static void CallHandlers(void *,DATA_OBJECT *);
  94 static void EarlySlotBindError(void *,INSTANCE_TYPE *,DEFCLASS *,unsigned);
  95
  96 /* =========================================
  97    *****************************************
  98           EXTERNALLY VISIBLE FUNCTIONS
  99    =========================================
 100    ***************************************** */
 101
 102 /*****************************************************
 103   NAME         : DirectMessage
 104   DESCRIPTION  : Plugs in given instance and
 105                   performs specified message
 106   INPUTS       : 1) Message symbolic name
 107                  2) The instance address
 108                  3) Address of DATA_OBJECT buffer
 109                     (NULL if don't care)
 110                  4) Message argument expressions
 111   RETURNS      : Returns FALSE is an execution error occurred
 112                  or execution is halted, otherwise TRUE
 113   SIDE EFFECTS : Side effects of message execution
 114   NOTES        : None
 115  *****************************************************/
 116 globle intBool DirectMessage(
 117   void *theEnv,
 118   SYMBOL_HN *msg,
 119   INSTANCE_TYPE *ins,
 120   DATA_OBJECT *resultbuf,
 121   EXPRESSION *remargs)
 122   {
 123    EXPRESSION args;
 124    DATA_OBJECT temp;
 125
 126    if (resultbuf == NULL)
 127      resultbuf = &temp;
 128    args.nextArg = remargs;
 129    args.argList = NULL;
 130    args.type = INSTANCE_ADDRESS;
 131    args.value = (void *) ins;
 132    return PerformMessage(theEnv,resultbuf,&args,msg);
 133   }
 134
 135 /***************************************************
 136   NAME         : EnvSend
 137   DESCRIPTION  : C Interface for sending messages to
 138                   instances
 139   INPUTS       : 1) The data object of the instance
 140                  2) The message name-string
 141                  3) The message arguments string
 142                     (Constants only)
 143                  4) Caller's buffer for result
 144   RETURNS      : Nothing useful
 145   SIDE EFFECTS : Executes message and stores result
 146                    caller's buffer
 147   NOTES        : None
 148  ***************************************************/
 149 globle void EnvSend(
 150   void *theEnv,
 151   DATA_OBJECT *idata,
 152   const char *msg,
 153   const char *args,
 154   DATA_OBJECT *result)
 155   {
 156    int error;
 157    EXPRESSION *iexp;
 158    SYMBOL_HN *msym;
 159
 160    if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
 161        (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0))
 162      {
 163       CleanCurrentGarbageFrame(theEnv,NULL);
 164       CallPeriodicTasks(theEnv);
 165      }
 166
 167    SetEvaluationError(theEnv,FALSE);
 168    result->type = SYMBOL;
 169    result->value = EnvFalseSymbol(theEnv);
 170    msym = FindSymbolHN(theEnv,msg);
 171    if (msym == NULL)
 172      {
 173       PrintNoHandlerError(theEnv,msg);
 174       SetEvaluationError(theEnv,TRUE);
 175       return;
 176      }
 177    iexp = GenConstant(theEnv,idata->type,idata->value);
 178    iexp->nextArg = ParseConstantArguments(theEnv,args,&error);
 179    if (error == TRUE)
 180      {
 181       ReturnExpression(theEnv,iexp);
 182       SetEvaluationError(theEnv,TRUE);
 183       return;
 184      }
 185    PerformMessage(theEnv,result,iexp,msym);
 186    ReturnExpression(theEnv,iexp);
 187   }
 188
 189 /*****************************************************
 190   NAME         : DestroyHandlerLinks
 191   DESCRIPTION  : Iteratively deallocates handler-links
 192   INPUTS       : The handler-link list
 193   RETURNS      : Nothing useful
 194   SIDE EFFECTS : Deallocation of links
 195   NOTES        : None
 196  *****************************************************/
 197 globle void DestroyHandlerLinks(
 198   void *theEnv,
 199   HANDLER_LINK *mhead)
 200   {
 201    HANDLER_LINK *tmp;
 202
 203    while (mhead != NULL)
 204      {
 205       tmp = mhead;
 206       mhead = mhead->nxt;
 207       tmp->hnd->busy--;
 208       DecrementDefclassBusyCount(theEnv,(void *) tmp->hnd->cls);
 209       rtn_struct(theEnv,messageHandlerLink,tmp);
 210      }
 211   }
 212
 213 /***********************************************************************
 214   NAME         : SendCommand
 215   DESCRIPTION  : Determines the applicable handler(s) and sets up the
 216                    core calling frame.  Then calls the core frame.
 217   INPUTS       : Caller's space for storing the result of the handler(s)
 218   RETURNS      : Nothing useful
 219   SIDE EFFECTS : Any side-effects caused by the execution of handlers in
 220                    the core framework
 221   NOTES        : H/L Syntax : (send <instance> <hnd> <args>*)
 222  ***********************************************************************/
 223 globle void SendCommand(
 224   void *theEnv,
 225   DATA_OBJECT *result)
 226   {
 227    EXPRESSION args;
 228    SYMBOL_HN *msg;
 229    DATA_OBJECT temp;
 230
 231    result->type = SYMBOL;
 232    result->value = EnvFalseSymbol(theEnv);
 233    if (EnvArgTypeCheck(theEnv,"send",2,SYMBOL,&temp) == FALSE)
 234      return;
 235    msg = (SYMBOL_HN *) temp.value;
 236
 237    /* =============================================
 238       Get the instance or primitive for the message
 239       ============================================= */
 240    args.type = GetFirstArgument()->type;
 241    args.value = GetFirstArgument()->value;
 242    args.argList = GetFirstArgument()->argList;
 243    args.nextArg = GetFirstArgument()->nextArg->nextArg;
 244
 245    PerformMessage(theEnv,result,&args,msg);
 246   }
 247
 248 /***************************************************
 249   NAME         : GetNthMessageArgument
 250   DESCRIPTION  : Returns the address of the nth
 251                  (starting at 1) which is an
 252                  argument of the current message
 253                  dispatch
 254   INPUTS       : None
 255   RETURNS      : The message argument
 256   SIDE EFFECTS : None
 257   NOTES        : The active instance is always
 258                  stored as the first argument (0) in
 259                  the call frame of the message
 260  ***************************************************/
 261 globle DATA_OBJECT *GetNthMessageArgument(
 262   void *theEnv,
 263   int n)
 264   {
 265    return(&ProceduralPrimitiveData(theEnv)->ProcParamArray[n]);
 266   }
 267
 268 /*****************************************************
 269   NAME         : NextHandlerAvailable
 270   DESCRIPTION  : Determines if there the currently
 271                    executing handler can call a
 272                    shadowed handler
 273                  Used before calling call-next-handler
 274   INPUTS       : None
 275   RETURNS      : TRUE if shadow ready, FALSE otherwise
 276   SIDE EFFECTS : None
 277   NOTES        : H/L Syntax: (next-handlerp)
 278  *****************************************************/
 279 globle int NextHandlerAvailable(
 280   void *theEnv)
 281   {
 282    if (MessageHandlerData(theEnv)->CurrentCore == NULL)
 283      return(FALSE);
 284    if (MessageHandlerData(theEnv)->CurrentCore->hnd->type == MAROUND)
 285      return((MessageHandlerData(theEnv)->NextInCore != NULL) ? TRUE : FALSE);
 286    if ((MessageHandlerData(theEnv)->CurrentCore->hnd->type == MPRIMARY) && (MessageHandlerData(theEnv)->NextInCore != NULL))
 287      return((MessageHandlerData(theEnv)->NextInCore->hnd->type == MPRIMARY) ? TRUE : FALSE);
 288    return(FALSE);
 289   }
 290
 291 /********************************************************
 292   NAME         : CallNextHandler
 293   DESCRIPTION  : This function allows around-handlers
 294                    to execute the rest of the core frame.
 295                  It also allows primary handlers
 296                    to execute shadowed primaries.
 297
 298                  The original handler arguments are
 299                    left intact.
 300   INPUTS       : The caller's result-value buffer
 301   RETURNS      : Nothing useful
 302   SIDE EFFECTS : The core frame is called and any
 303                    appropriate changes are made when
 304                    used in an around handler
 305                    See CallHandlers()
 306                  But when call-next-handler is called
 307                    from a primary, the same shadowed
 308                    primary is called over and over
 309                    again for repeated calls to
 310                    call-next-handler.
 311   NOTES        : H/L Syntax: (call-next-handler) OR
 312                     (override-next-handler <arg> ...)
 313  ********************************************************/
 314 globle void CallNextHandler(
 315   void *theEnv,
 316   DATA_OBJECT *result)
 317   {
 318    EXPRESSION args;
 319    int overridep;
 320    HANDLER_LINK *oldNext,*oldCurrent;
 321 #if PROFILING_FUNCTIONS
 322    struct profileFrameInfo profileFrame;
 323 #endif
 324
 325    SetpType(result,SYMBOL);
 326    SetpValue(result,EnvFalseSymbol(theEnv));
 327    EvaluationData(theEnv)->EvaluationError = FALSE;
 328    if (EvaluationData(theEnv)->HaltExecution)
 329      return;
 330    if (NextHandlerAvailable(theEnv) == FALSE)
 331      {
 332       PrintErrorID(theEnv,"MSGPASS",1,FALSE);
 333       EnvPrintRouter(theEnv,WERROR,"Shadowed message-handlers not applicable in current context.\n");
 334       SetEvaluationError(theEnv,TRUE);
 335       return;
 336      }
 337    if (EvaluationData(theEnv)->CurrentExpression->value == (void *) FindFunction(theEnv,"override-next-handler"))
 338      {
 339       overridep = 1;
 340       args.type = ProceduralPrimitiveData(theEnv)->ProcParamArray[0].type;
 341       if (args.type != MULTIFIELD)
 342         args.value = (void *) ProceduralPrimitiveData(theEnv)->ProcParamArray[0].value;
 343       else
 344         args.value = (void *) &ProceduralPrimitiveData(theEnv)->ProcParamArray[0];
 345       args.nextArg = GetFirstArgument();
 346       args.argList = NULL;
 347       PushProcParameters(theEnv,&args,CountArguments(&args),
 348                           ValueToString(MessageHandlerData(theEnv)->CurrentMessageName),"message",
 349                           UnboundHandlerErr);
 350       if (EvaluationData(theEnv)->EvaluationError)
 351         {
 352          ProcedureFunctionData(theEnv)->ReturnFlag = FALSE;
 353          return;
 354         }
 355      }
 356    else
 357      overridep = 0;
 358    oldNext = MessageHandlerData(theEnv)->NextInCore;
 359    oldCurrent = MessageHandlerData(theEnv)->CurrentCore;
 360    if (MessageHandlerData(theEnv)->CurrentCore->hnd->type == MAROUND)
 361      {
 362       if (MessageHandlerData(theEnv)->NextInCore->hnd->type == MAROUND)
 363         {
 364          MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore;
 365          MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt;
 366 #if DEBUGGING_FUNCTIONS
 367          if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
 368            WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE);
 369 #endif
 370          if (CheckHandlerArgCount(theEnv))
 371            {
 372 #if PROFILING_FUNCTIONS
 373             StartProfile(theEnv,&profileFrame,
 374                          &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData,
 375                          ProfileFunctionData(theEnv)->ProfileConstructs);
 376 #endif
 377
 378             EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule,
 379                                MessageHandlerData(theEnv)->CurrentCore->hnd->actions,
 380                                MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount,
 381                                result,UnboundHandlerErr);
 382 #if PROFILING_FUNCTIONS
 383             EndProfile(theEnv,&profileFrame);
 384 #endif
 385            }
 386 #if DEBUGGING_FUNCTIONS
 387          if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
 388            WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE);
 389 #endif
 390         }
 391       else
 392         CallHandlers(theEnv,result);
 393      }
 394    else
 395      {
 396       MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore;
 397       MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt;
 398 #if DEBUGGING_FUNCTIONS
 399       if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
 400         WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE);
 401 #endif
 402       if (CheckHandlerArgCount(theEnv))
 403         {
 404 #if PROFILING_FUNCTIONS
 405         StartProfile(theEnv,&profileFrame,
 406                      &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData,
 407                      ProfileFunctionData(theEnv)->ProfileConstructs);
 408 #endif
 409
 410         EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule,
 411                             MessageHandlerData(theEnv)->CurrentCore->hnd->actions,
 412                             MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount,
 413                             result,UnboundHandlerErr);
 414 #if PROFILING_FUNCTIONS
 415          EndProfile(theEnv,&profileFrame);
 416 #endif
 417         }
 418
 419 #if DEBUGGING_FUNCTIONS
 420       if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
 421         WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE);
 422 #endif
 423      }
 424    MessageHandlerData(theEnv)->NextInCore = oldNext;
 425    MessageHandlerData(theEnv)->CurrentCore = oldCurrent;
 426    if (overridep)
 427      PopProcParameters(theEnv);
 428    ProcedureFunctionData(theEnv)->ReturnFlag = FALSE;
 429   }
 430
 431 /*************************************************************************
 432   NAME         : FindApplicableOfName
 433   DESCRIPTION  : Groups all handlers of all types of the specified
 434                    class of the specified name into the applicable handler
 435                    list
 436   INPUTS       : 1) The class address
 437                  2-3) The tops and bottoms of the four handler type lists:
 438                       around, before, primary and after
 439                  4) The message name symbol
 440   RETURNS      : Nothing useful
 441   SIDE EFFECTS : Modifies the handler lists to include applicable handlers
 442   NOTES        : None
 443  *************************************************************************/
 444 globle void FindApplicableOfName(
 445   void *theEnv,
 446   DEFCLASS *cls,
 447   HANDLER_LINK *tops[4],
 448   HANDLER_LINK *bots[4],
 449   SYMBOL_HN *mname)
 450   {
 451    register int i;
 452    register int e;
 453    HANDLER *hnd;
 454    unsigned *arr;
 455    HANDLER_LINK *tmp;
 456
 457    i = FindHandlerNameGroup(cls,mname);
 458    if (i == -1)
 459      return;
 460    e = ((int) cls->handlerCount) - 1;
 461    hnd = cls->handlers;
 462    arr = cls->handlerOrderMap;
 463    for ( ; i <= e ; i++)
 464      {
 465       if (hnd[arr[i]].name != mname)
 466         break;
 467
 468       tmp = get_struct(theEnv,messageHandlerLink);
 469       hnd[arr[i]].busy++;
 470       IncrementDefclassBusyCount(theEnv,(void *) hnd[arr[i]].cls);
 471       tmp->hnd = &hnd[arr[i]];
 472       if (tops[tmp->hnd->type] == NULL)
 473         {
 474          tmp->nxt = NULL;
 475          tops[tmp->hnd->type] = bots[tmp->hnd->type] = tmp;
 476         }
 477
 478       else if (tmp->hnd->type == MAFTER)
 479         {
 480          tmp->nxt = tops[tmp->hnd->type];
 481          tops[tmp->hnd->type] = tmp;
 482         }
 483
 484       else
 485         {
 486          bots[tmp->hnd->type]->nxt = tmp;
 487          bots[tmp->hnd->type] = tmp;
 488          tmp->nxt = NULL;
 489         }
 490      }
 491   }
 492
 493 /*************************************************************************
 494   NAME         : JoinHandlerLinks
 495   DESCRIPTION  : Joins the queues of different handlers together
 496   INPUTS       : 1-2) The tops and bottoms of the four handler type lists:
 497                       around, before, primary and after
 498                  3) The message name symbol
 499   RETURNS      : The top of the joined lists, NULL on errors
 500   SIDE EFFECTS : Links all the handler type lists together, or all the
 501                    lists are destroyed if there are no primary handlers
 502   NOTES        : None
 503  *************************************************************************/
 504 globle HANDLER_LINK *JoinHandlerLinks(
 505   void *theEnv,
 506   HANDLER_LINK *tops[4],
 507   HANDLER_LINK *bots[4],
 508   SYMBOL_HN *mname)
 509   {
 510    register int i;
 511    HANDLER_LINK *mlink;
 512
 513    if (tops[MPRIMARY] == NULL)
 514     {
 515      PrintNoHandlerError(theEnv,ValueToString(mname));
 516      for (i = MAROUND ; i <= MAFTER ; i++)
 517        DestroyHandlerLinks(theEnv,tops[i]);
 518      SetEvaluationError(theEnv,TRUE);
 519      return(NULL);
 520     }
 521
 522    mlink = tops[MPRIMARY];
 523
 524    if (tops[MBEFORE] != NULL)
 525      {
 526       bots[MBEFORE]->nxt = mlink;
 527       mlink = tops[MBEFORE];
 528      }
 529
 530    if (tops[MAROUND] != NULL)
 531      {
 532       bots[MAROUND]->nxt = mlink;
 533       mlink = tops[MAROUND];
 534      }
 535
 536    bots[MPRIMARY]->nxt = tops[MAFTER];
 537
 538    return(mlink);
 539   }
 540
 541 /***************************************************
 542   NAME         : PrintHandlerSlotGetFunction
 543   DESCRIPTION  : Developer access function for
 544                  printing direct slot references
 545                  in message-handlers
 546   INPUTS       : 1) The logical name of the output
 547                  2) The bitmap expression
 548   RETURNS      : Nothing useful
 549   SIDE EFFECTS : Expression printed
 550   NOTES        : None
 551  ***************************************************/
 552 globle void PrintHandlerSlotGetFunction(
 553   void *theEnv,
 554   const char *logicalName,
 555   void *theValue)
 556   {
 557 #if DEVELOPER
 558    HANDLER_SLOT_REFERENCE *theReference;
 559    DEFCLASS *theDefclass;
 560    SLOT_DESC *sd;
 561
 562    theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
 563    EnvPrintRouter(theEnv,logicalName,"?self:[");
 564    theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID];
 565    EnvPrintRouter(theEnv,logicalName,ValueToString(theDefclass->header.name));
 566    EnvPrintRouter(theEnv,logicalName,"]");
 567    sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[theReference->slotID] - 1];
 568    EnvPrintRouter(theEnv,logicalName,ValueToString(sd->slotName->name));
 569 #else
 570 #if MAC_XCD
 571 #pragma unused(theEnv)
 572 #pragma unused(logicalName)
 573 #pragma unused(theValue)
 574 #endif
 575 #endif
 576   }
 577
 578 /***************************************************
 579   NAME         : HandlerSlotGetFunction
 580   DESCRIPTION  : Access function for handling the
 581                  statically-bound direct slot
 582                  references in message-handlers
 583   INPUTS       : 1) The bitmap expression
 584                  2) A data object buffer
 585   RETURNS      : TRUE if OK, FALSE
 586                  on errors
 587   SIDE EFFECTS : Data object buffer gets value of
 588                  slot. On errors, buffer gets
 589                  symbol FALSE, EvaluationError
 590                  is set and error messages are
 591                  printed
 592   NOTES        : It is possible for a handler
 593                  (attached to a superclass of
 594                   the currently active instance)
 595                  containing these static references
 596                  to be called for an instance
 597                  which does not contain the slots
 598                  (e.g., an instance of a subclass
 599                   where the original slot was
 600                   no-inherit or the subclass
 601                   overrode the original slot)
 602  ***************************************************/
 603 globle intBool HandlerSlotGetFunction(
 604   void *theEnv,
 605   void *theValue,
 606   DATA_OBJECT *theResult)
 607   {
 608    HANDLER_SLOT_REFERENCE *theReference;
 609    DEFCLASS *theDefclass;
 610    INSTANCE_TYPE *theInstance;
 611    INSTANCE_SLOT *sp;
 612    unsigned instanceSlotIndex;
 613
 614    theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
 615    theInstance = (INSTANCE_TYPE *) ProceduralPrimitiveData(theEnv)->ProcParamArray[0].value;
 616    theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID];
 617
 618    if (theInstance->garbage)
 619      {
 620       StaleInstanceAddress(theEnv,"for slot get",0);
 621       theResult->type = SYMBOL;
 622       theResult->value = EnvFalseSymbol(theEnv);
 623       SetEvaluationError(theEnv,TRUE);
 624       return(FALSE);
 625      }
 626
 627    if (theInstance->cls == theDefclass)
 628      {
 629       instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
 630       sp = theInstance->slotAddresses[instanceSlotIndex - 1];
 631      }
 632    else
 633      {
 634       if (theReference->slotID > theInstance->cls->maxSlotNameID)
 635         goto HandlerGetError;
 636       instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
 637       if (instanceSlotIndex == 0)
 638         goto HandlerGetError;
 639       instanceSlotIndex--;
 640       sp = theInstance->slotAddresses[instanceSlotIndex];
 641       if (sp->desc->cls != theDefclass)
 642         goto HandlerGetError;
 643      }
 644    theResult->type = (unsigned short) sp->type;
 645    theResult->value = sp->value;
 646    if (sp->type == MULTIFIELD)
 647      {
 648       theResult->begin = 0;
 649       SetpDOEnd(theResult,GetInstanceSlotLength(sp));
 650      }
 651    return(TRUE);
 652
 653 HandlerGetError:
 654    EarlySlotBindError(theEnv,theInstance,theDefclass,theReference->slotID);
 655    theResult->type = SYMBOL;
 656    theResult->value = EnvFalseSymbol(theEnv);
 657    SetEvaluationError(theEnv,TRUE);
 658    return(FALSE);
 659   }
 660
 661 /***************************************************
 662   NAME         : PrintHandlerSlotPutFunction
 663   DESCRIPTION  : Developer access function for
 664                  printing direct slot bindings
 665                  in message-handlers
 666   INPUTS       : 1) The logical name of the output
 667                  2) The bitmap expression
 668   RETURNS      : Nothing useful
 669   SIDE EFFECTS : Expression printed
 670   NOTES        : None
 671  ***************************************************/
 672 globle void PrintHandlerSlotPutFunction(
 673   void *theEnv,
 674   const char *logicalName,
 675   void *theValue)
 676   {
 677 #if DEVELOPER
 678    HANDLER_SLOT_REFERENCE *theReference;
 679    DEFCLASS *theDefclass;
 680    SLOT_DESC *sd;
 681
 682    theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
 683    EnvPrintRouter(theEnv,logicalName,"(bind ?self:[");
 684    theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID];
 685    EnvPrintRouter(theEnv,logicalName,ValueToString(theDefclass->header.name));
 686    EnvPrintRouter(theEnv,logicalName,"]");
 687    sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[theReference->slotID] - 1];
 688    EnvPrintRouter(theEnv,logicalName,ValueToString(sd->slotName->name));
 689    if (GetFirstArgument() != NULL)
 690      {
 691       EnvPrintRouter(theEnv,logicalName," ");
 692       PrintExpression(theEnv,logicalName,GetFirstArgument());
 693      }
 694    EnvPrintRouter(theEnv,logicalName,")");
 695 #else
 696 #if MAC_XCD
 697 #pragma unused(theEnv)
 698 #pragma unused(logicalName)
 699 #pragma unused(theValue)
 700 #endif
 701 #endif
 702   }
 703
 704 /***************************************************
 705   NAME         : HandlerSlotPutFunction
 706   DESCRIPTION  : Access function for handling the
 707                  statically-bound direct slot
 708                  bindings in message-handlers
 709   INPUTS       : 1) The bitmap expression
 710                  2) A data object buffer
 711   RETURNS      : TRUE if OK, FALSE
 712                  on errors
 713   SIDE EFFECTS : Data object buffer gets symbol
 714                  TRUE and slot is set. On errors,
 715                  buffer gets symbol FALSE,
 716                  EvaluationError is set and error
 717                  messages are printed
 718   NOTES        : It is possible for a handler
 719                  (attached to a superclass of
 720                   the currently active instance)
 721                  containing these static references
 722                  to be called for an instance
 723                  which does not contain the slots
 724                  (e.g., an instance of a subclass
 725                   where the original slot was
 726                   no-inherit or the subclass
 727                   overrode the original slot)
 728  ***************************************************/
 729 globle intBool HandlerSlotPutFunction(
 730   void *theEnv,
 731   void *theValue,
 732   DATA_OBJECT *theResult)
 733   {
 734    HANDLER_SLOT_REFERENCE *theReference;
 735    DEFCLASS *theDefclass;
 736    INSTANCE_TYPE *theInstance;
 737    INSTANCE_SLOT *sp;
 738    unsigned instanceSlotIndex;
 739    DATA_OBJECT theSetVal;
 740
 741    theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
 742    theInstance = (INSTANCE_TYPE *) ProceduralPrimitiveData(theEnv)->ProcParamArray[0].value;
 743    theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID];
 744
 745    if (theInstance->garbage)
 746      {
 747       StaleInstanceAddress(theEnv,"for slot put",0);
 748       theResult->type = SYMBOL;
 749       theResult->value = EnvFalseSymbol(theEnv);
 750       SetEvaluationError(theEnv,TRUE);
 751       return(FALSE);
 752      }
 753
 754    if (theInstance->cls == theDefclass)
 755      {
 756       instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
 757       sp = theInstance->slotAddresses[instanceSlotIndex - 1];
 758      }
 759    else
 760      {
 761       if (theReference->slotID > theInstance->cls->maxSlotNameID)
 762         goto HandlerPutError;
 763       instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
 764       if (instanceSlotIndex == 0)
 765         goto HandlerPutError;
 766       instanceSlotIndex--;
 767       sp = theInstance->slotAddresses[instanceSlotIndex];
 768       if (sp->desc->cls != theDefclass)
 769         goto HandlerPutError;
 770      }
 771
 772    /* =======================================================
 773       The slot has already been verified not to be read-only.
 774       However, if it is initialize-only, we need to make sure
 775       that we are initializing the instance (something we
 776       could not verify at parse-time)
 777       ======================================================= */
 778    if (sp->desc->initializeOnly && (!theInstance->initializeInProgress))
 779      {
 780       SlotAccessViolationError(theEnv,ValueToString(sp->desc->slotName->name),
 781                                TRUE,(void *) theInstance);
 782       goto HandlerPutError2;
 783      }
 784
 785    /* ======================================
 786       No arguments means to use the
 787       special NoParamValue to reset the slot
 788       to its default value
 789       ====================================== */
 790    if (GetFirstArgument())
 791      {
 792       if (EvaluateAndStoreInDataObject(theEnv,(int) sp->desc->multiple,
 793                                        GetFirstArgument(),&theSetVal,TRUE) == FALSE)
 794          goto HandlerPutError2;
 795      }
 796    else
 797      {
 798       SetDOBegin(theSetVal,1);
 799       SetDOEnd(theSetVal,0);
 800       SetType(theSetVal,MULTIFIELD);
 801       SetValue(theSetVal,ProceduralPrimitiveData(theEnv)->NoParamValue);
 802      }
 803    if (PutSlotValue(theEnv,theInstance,sp,&theSetVal,theResult,NULL) == FALSE)
 804       goto HandlerPutError2;
 805    return(TRUE);
 806
 807 HandlerPutError:
 808    EarlySlotBindError(theEnv,theInstance,theDefclass,theReference->slotID);
 809
 810 HandlerPutError2:
 811    theResult->type = SYMBOL;
 812    theResult->value = EnvFalseSymbol(theEnv);
 813    SetEvaluationError(theEnv,TRUE);
 814
 815    return(FALSE);
 816   }
 817
 818 /*****************************************************
 819   NAME         : DynamicHandlerGetSlot
 820   DESCRIPTION  : Directly references a slot's value
 821                  (uses dynamic binding to lookup slot)
 822   INPUTS       : The caller's result buffer
 823   RETURNS      : Nothing useful
 824   SIDE EFFECTS : Caller's result buffer set
 825   NOTES        : H/L Syntax: (get <slot>)
 826  *****************************************************/
 827 globle void DynamicHandlerGetSlot(
 828   void *theEnv,
 829   DATA_OBJECT *result)
 830   {
 831    INSTANCE_SLOT *sp;
 832    INSTANCE_TYPE *ins;
 833    DATA_OBJECT temp;
 834
 835    result->type = SYMBOL;
 836    result->value = EnvFalseSymbol(theEnv);
 837    if (CheckCurrentMessage(theEnv,"dynamic-get",TRUE) == FALSE)
 838      return;
 839    EvaluateExpression(theEnv,GetFirstArgument(),&temp);
 840    if (temp.type != SYMBOL)
 841      {
 842       ExpectedTypeError1(theEnv,"dynamic-get",1,"symbol");
 843       SetEvaluationError(theEnv,TRUE);
 844       return;
 845      }
 846    ins = GetActiveInstance(theEnv);
 847    sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value);
 848    if (sp == NULL)
 849      {
 850       SlotExistError(theEnv,ValueToString(temp.value),"dynamic-get");
 851       return;
 852      }
 853    if ((sp->desc->publicVisibility == 0) &&
 854        (MessageHandlerData(theEnv)->CurrentCore->hnd->cls != sp->desc->cls))
 855      {
 856       SlotVisibilityViolationError(theEnv,sp->desc,MessageHandlerData(theEnv)->CurrentCore->hnd->cls);
 857       SetEvaluationError(theEnv,TRUE);
 858       return;
 859      }
 860    result->type = (unsigned short) sp->type;
 861    result->value = sp->value;
 862    if (sp->type == MULTIFIELD)
 863      {
 864       result->begin = 0;
 865       SetpDOEnd(result,GetInstanceSlotLength(sp));
 866      }
 867   }
 868
 869 /***********************************************************
 870   NAME         : DynamicHandlerPutSlot
 871   DESCRIPTION  : Directly puts a slot's value
 872                  (uses dynamic binding to lookup slot)
 873   INPUTS       : Data obejct buffer for holding slot value
 874   RETURNS      : Nothing useful
 875   SIDE EFFECTS : Slot modified - and caller's buffer set
 876                  to value (or symbol FALSE on errors)
 877   NOTES        : H/L Syntax: (put <slot> <value>*)
 878  ***********************************************************/
 879 globle void DynamicHandlerPutSlot(
 880   void *theEnv,
 881   DATA_OBJECT *theResult)
 882   {
 883    INSTANCE_SLOT *sp;
 884    INSTANCE_TYPE *ins;
 885    DATA_OBJECT temp;
 886
 887    theResult->type = SYMBOL;
 888    theResult->value = EnvFalseSymbol(theEnv);
 889    if (CheckCurrentMessage(theEnv,"dynamic-put",TRUE) == FALSE)
 890      return;
 891    EvaluateExpression(theEnv,GetFirstArgument(),&temp);
 892    if (temp.type != SYMBOL)
 893      {
 894       ExpectedTypeError1(theEnv,"dynamic-put",1,"symbol");
 895       SetEvaluationError(theEnv,TRUE);
 896       return;
 897      }
 898    ins = GetActiveInstance(theEnv);
 899    sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value);
 900    if (sp == NULL)
 901      {
 902       SlotExistError(theEnv,ValueToString(temp.value),"dynamic-put");
 903       return;
 904      }
 905    if ((sp->desc->noWrite == 0) ? FALSE :
 906        ((sp->desc->initializeOnly == 0) || (!ins->initializeInProgress)))
 907      {
 908       SlotAccessViolationError(theEnv,ValueToString(sp->desc->slotName->name),
 909                                TRUE,(void *) ins);
 910       SetEvaluationError(theEnv,TRUE);
 911       return;
 912      }
 913    if ((sp->desc->publicVisibility == 0) &&
 914        (MessageHandlerData(theEnv)->CurrentCore->hnd->cls != sp->desc->cls))
 915      {
 916       SlotVisibilityViolationError(theEnv,sp->desc,MessageHandlerData(theEnv)->CurrentCore->hnd->cls);
 917       SetEvaluationError(theEnv,TRUE);
 918       return;
 919      }
 920    if (GetFirstArgument()->nextArg)
 921      {
 922       if (EvaluateAndStoreInDataObject(theEnv,(int) sp->desc->multiple,
 923                         GetFirstArgument()->nextArg,&temp,TRUE) == FALSE)
 924         return;
 925      }
 926    else
 927      {
 928       SetpDOBegin(&temp,1);
 929       SetpDOEnd(&temp,0);
 930       SetpType(&temp,MULTIFIELD);
 931       SetpValue(&temp,ProceduralPrimitiveData(theEnv)->NoParamValue);
 932      }
 933    PutSlotValue(theEnv,ins,sp,&temp,theResult,NULL);
 934   }
 935
 936 /* =========================================
 937    *****************************************
 938           INTERNALLY VISIBLE FUNCTIONS
 939    =========================================
 940    ***************************************** */
 941
 942 /*****************************************************
 943   NAME         : PerformMessage
 944   DESCRIPTION  : Calls core framework for a message
 945   INPUTS       : 1) Caller's result buffer
 946                  2) Message argument expressions
 947                     (including implicit object)
 948                  3) Message name
 949   RETURNS      : Returns FALSE is an execution error occurred
 950                  or execution is halted, otherwise TRUE
 951   SIDE EFFECTS : Any side-effects of message execution
 952                     and caller's result buffer set
 953   NOTES        : It's no longer necessary for a defclass
 954                  to be in scope in order to sent a message
 955                  to an instance of that class.
 956  *****************************************************/
 957 static intBool PerformMessage(
 958   void *theEnv,
 959   DATA_OBJECT *result,
 960   EXPRESSION *args,
 961   SYMBOL_HN *mname)
 962   {
 963    int oldce;
 964    /* HANDLER_LINK *oldCore; */
 965    DEFCLASS *cls = NULL;
 966    INSTANCE_TYPE *ins = NULL;
 967    SYMBOL_HN *oldName;
 968 #if PROFILING_FUNCTIONS
 969    struct profileFrameInfo profileFrame;
 970 #endif
 971    struct garbageFrame newGarbageFrame;
 972    struct garbageFrame *oldGarbageFrame;
 973
 974    result->type = SYMBOL;
 975    result->value = EnvFalseSymbol(theEnv);
 976    EvaluationData(theEnv)->EvaluationError = FALSE;
 977    if (EvaluationData(theEnv)->HaltExecution)
 978      return FALSE;
 979
 980    oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame;
 981    memset(&newGarbageFrame,0,sizeof(struct garbageFrame));
 982    UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame;
 983
 984    oldce = ExecutingConstruct(theEnv);
 985    SetExecutingConstruct(theEnv,TRUE);
 986    oldName = MessageHandlerData(theEnv)->CurrentMessageName;
 987    MessageHandlerData(theEnv)->CurrentMessageName = mname;
 988    EvaluationData(theEnv)->CurrentEvaluationDepth++;
 989
 990    PushProcParameters(theEnv,args,CountArguments(args),
 991                         ValueToString(MessageHandlerData(theEnv)->CurrentMessageName),"message",
 992                         UnboundHandlerErr);
 993
 994
 995    if (EvaluationData(theEnv)->EvaluationError)
 996      {
 997       EvaluationData(theEnv)->CurrentEvaluationDepth--;
 998       MessageHandlerData(theEnv)->CurrentMessageName = oldName;
 999
1000       RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result);
1001       CallPeriodicTasks(theEnv);
1002
1003       SetExecutingConstruct(theEnv,oldce);
1004       return FALSE;
1005      }
1006
1007    if (ProceduralPrimitiveData(theEnv)->ProcParamArray->type == INSTANCE_ADDRESS)
1008      {
1009       ins = (INSTANCE_TYPE *) ProceduralPrimitiveData(theEnv)->ProcParamArray->value;
1010       if (ins->garbage == 1)
1011         {
1012          StaleInstanceAddress(theEnv,"send",0);
1013          SetEvaluationError(theEnv,TRUE);
1014         }
1015       //else if (DefclassInScope(theEnv,ins->cls,(struct defmodule *) EnvGetCurrentModule(theEnv)) == FALSE)
1016       //  NoInstanceError(theEnv,ValueToString(ins->name),"send");
1017       else
1018         {
1019          cls = ins->cls;
1020          ins->busy++;
1021         }
1022      }
1023    else if (ProceduralPrimitiveData(theEnv)->ProcParamArray->type == INSTANCE_NAME)
1024      {
1025       ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) ProceduralPrimitiveData(theEnv)->ProcParamArray->value);
1026       if (ins == NULL)
1027         {
1028          PrintErrorID(theEnv,"MSGPASS",2,FALSE);
1029          EnvPrintRouter(theEnv,WERROR,"No such instance ");
1030          EnvPrintRouter(theEnv,WERROR,ValueToString((SYMBOL_HN *) ProceduralPrimitiveData(theEnv)->ProcParamArray->value));
1031          EnvPrintRouter(theEnv,WERROR," in function send.\n");
1032          SetEvaluationError(theEnv,TRUE);
1033         }
1034       else
1035         {
1036          ProceduralPrimitiveData(theEnv)->ProcParamArray->value = (void *) ins;
1037          ProceduralPrimitiveData(theEnv)->ProcParamArray->type = INSTANCE_ADDRESS;
1038          cls = ins->cls;
1039          ins->busy++;
1040         }
1041      }
1042    else if ((cls = DefclassData(theEnv)->PrimitiveClassMap[ProceduralPrimitiveData(theEnv)->ProcParamArray->type]) == NULL)
1043      {
1044       SystemError(theEnv,"MSGPASS",1);
1045       EnvExitRouter(theEnv,EXIT_FAILURE);
1046      }
1047    if (EvaluationData(theEnv)->EvaluationError)
1048      {
1049       PopProcParameters(theEnv);
1050       EvaluationData(theEnv)->CurrentEvaluationDepth--;
1051       MessageHandlerData(theEnv)->CurrentMessageName = oldName;
1052
1053       RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result);
1054       CallPeriodicTasks(theEnv);
1055
1056       SetExecutingConstruct(theEnv,oldce);
1057       return FALSE;
1058      }
1059
1060    /* oldCore = MessageHandlerData(theEnv)->TopOfCore; */
1061
1062    if (MessageHandlerData(theEnv)->TopOfCore != NULL)
1063      { MessageHandlerData(theEnv)->TopOfCore->nxtInStack = MessageHandlerData(theEnv)->OldCore; }
1064    MessageHandlerData(theEnv)->OldCore = MessageHandlerData(theEnv)->TopOfCore;
1065
1066    MessageHandlerData(theEnv)->TopOfCore = FindApplicableHandlers(theEnv,cls,mname);
1067
1068    if (MessageHandlerData(theEnv)->TopOfCore != NULL)
1069      {
1070       HANDLER_LINK *oldCurrent,*oldNext;
1071
1072       oldCurrent = MessageHandlerData(theEnv)->CurrentCore;
1073       oldNext = MessageHandlerData(theEnv)->NextInCore;
1074
1075       if (MessageHandlerData(theEnv)->TopOfCore->hnd->type == MAROUND)
1076         {
1077          MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->TopOfCore;
1078          MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->TopOfCore->nxt;
1079 #if DEBUGGING_FUNCTIONS
1080          if (MessageHandlerData(theEnv)->WatchMessages)
1081            WatchMessage(theEnv,WTRACE,BEGIN_TRACE);
1082          if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
1083            WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE);
1084 #endif
1085          if (CheckHandlerArgCount(theEnv))
1086            {
1087 #if PROFILING_FUNCTIONS
1088             StartProfile(theEnv,&profileFrame,
1089                          &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData,
1090                          ProfileFunctionData(theEnv)->ProfileConstructs);
1091 #endif
1092
1093
1094            EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule,
1095                                MessageHandlerData(theEnv)->CurrentCore->hnd->actions,
1096                                MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount,
1097                                result,UnboundHandlerErr);
1098
1099
1100 #if PROFILING_FUNCTIONS
1101             EndProfile(theEnv,&profileFrame);
1102 #endif
1103            }
1104
1105 #if DEBUGGING_FUNCTIONS
1106          if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
1107            WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE);
1108          if (MessageHandlerData(theEnv)->WatchMessages)
1109            WatchMessage(theEnv,WTRACE,END_TRACE);
1110 #endif
1111         }
1112       else
1113         {
1114          MessageHandlerData(theEnv)->CurrentCore = NULL;
1115          MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->TopOfCore;
1116 #if DEBUGGING_FUNCTIONS
1117          if (MessageHandlerData(theEnv)->WatchMessages)
1118            WatchMessage(theEnv,WTRACE,BEGIN_TRACE);
1119 #endif
1120          CallHandlers(theEnv,result);
1121 #if DEBUGGING_FUNCTIONS
1122          if (MessageHandlerData(theEnv)->WatchMessages)
1123            WatchMessage(theEnv,WTRACE,END_TRACE);
1124 #endif
1125         }
1126
1127       DestroyHandlerLinks(theEnv,MessageHandlerData(theEnv)->TopOfCore);
1128       MessageHandlerData(theEnv)->CurrentCore = oldCurrent;
1129       MessageHandlerData(theEnv)->NextInCore = oldNext;
1130      }
1131
1132    /* MessageHandlerData(theEnv)->TopOfCore = oldCore; */
1133    MessageHandlerData(theEnv)->TopOfCore = MessageHandlerData(theEnv)->OldCore;
1134    if (MessageHandlerData(theEnv)->OldCore != NULL)
1135      { MessageHandlerData(theEnv)->OldCore = MessageHandlerData(theEnv)->OldCore->nxtInStack; }
1136
1137    ProcedureFunctionData(theEnv)->ReturnFlag = FALSE;
1138
1139    if (ins != NULL)
1140      ins->busy--;
1141
1142    /* ==================================
1143       Restore the original calling frame
1144       ================================== */
1145    PopProcParameters(theEnv);
1146    EvaluationData(theEnv)->CurrentEvaluationDepth--;
1147    MessageHandlerData(theEnv)->CurrentMessageName = oldName;
1148
1149    RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result);
1150    CallPeriodicTasks(theEnv);
1151
1152    SetExecutingConstruct(theEnv,oldce);
1153
1154    if (EvaluationData(theEnv)->EvaluationError)
1155      {
1156       result->type = SYMBOL;
1157       result->value = EnvFalseSymbol(theEnv);
1158       return FALSE;
1159      }
1160
1161    return TRUE;
1162   }
1163
1164 /*****************************************************************************
1165   NAME         : FindApplicableHandlers
1166   DESCRIPTION  : Given a message name, this routine forms the "core frame"
1167                    for the message : a list of all applicable class handlers.
1168                    An applicable class handler is one whose name matches
1169                      the message and whose class matches the instance.
1170
1171                    The list is in the following order :
1172
1173                    All around handlers (from most specific to most general)
1174                    All before handlers (from most specific to most general)
1175                    All primary handlers (from most specific to most general)
1176                    All after handlers (from most general to most specific)
1177
1178   INPUTS       : 1) The class of the instance (or primitive) for the message
1179                  2) The message name
1180   RETURNS      : NULL if no applicable handlers or errors,
1181                    the list of handlers otherwise
1182   SIDE EFFECTS : Links are allocated for the list
1183   NOTES        : The instance is the first thing on the ProcParamArray
1184                  The number of arguments is in ProcParamArraySize
1185  *****************************************************************************/
1186 static HANDLER_LINK *FindApplicableHandlers(
1187   void *theEnv,
1188   DEFCLASS *cls,
1189   SYMBOL_HN *mname)
1190   {
1191    register int i;
1192    HANDLER_LINK *tops[4],*bots[4];
1193
1194    for (i = MAROUND ; i <= MAFTER ; i++)
1195      tops[i] = bots[i] = NULL;
1196
1197    for (i = 0 ; i < cls->allSuperclasses.classCount ; i++)
1198      FindApplicableOfName(theEnv,cls->allSuperclasses.classArray[i],tops,bots,mname);
1199    return(JoinHandlerLinks(theEnv,tops,bots,mname));
1200   }
1201
1202 /***************************************************************
1203   NAME         : CallHandlers
1204   DESCRIPTION  : Moves though the current message frame
1205                    for a send-message as follows :
1206
1207                  Call all before handlers and ignore their
1208                    return values.
1209                  Call the first primary handler and
1210                    ignore the rest.  The return value
1211                    of the handler frame is this message's value.
1212                  Call all after handlers and ignore their
1213                    return values.
1214   INPUTS       : Caller's buffer for the return value of
1215                    the message
1216   RETURNS      : Nothing useful
1217   SIDE EFFECTS : The handlers are evaluated.
1218   NOTES        : IMPORTANT : The global NextInCore should be
1219                  pointing to the first handler to be executed.
1220  ***************************************************************/
1221 static void CallHandlers(
1222   void *theEnv,
1223   DATA_OBJECT *result)
1224   {
1225    HANDLER_LINK *oldCurrent = NULL,*oldNext = NULL;  /* prevents warning */
1226    DATA_OBJECT temp;
1227 #if PROFILING_FUNCTIONS
1228    struct profileFrameInfo profileFrame;
1229 #endif
1230
1231    if (EvaluationData(theEnv)->HaltExecution)
1232      return;
1233
1234    oldCurrent = MessageHandlerData(theEnv)->CurrentCore;
1235    oldNext = MessageHandlerData(theEnv)->NextInCore;
1236
1237    while (MessageHandlerData(theEnv)->NextInCore->hnd->type == MBEFORE)
1238      {
1239       MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore;
1240       MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt;
1241 #if DEBUGGING_FUNCTIONS
1242       if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
1243         WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE);
1244 #endif
1245       if (CheckHandlerArgCount(theEnv))
1246         {
1247 #if PROFILING_FUNCTIONS
1248          StartProfile(theEnv,&profileFrame,
1249                       &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData,
1250                       ProfileFunctionData(theEnv)->ProfileConstructs);
1251 #endif
1252
1253          EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule,
1254                             MessageHandlerData(theEnv)->CurrentCore->hnd->actions,
1255                             MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount,
1256                             &temp,UnboundHandlerErr);
1257
1258
1259 #if PROFILING_FUNCTIONS
1260          EndProfile(theEnv,&profileFrame);
1261 #endif
1262         }
1263
1264 #if DEBUGGING_FUNCTIONS
1265       if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
1266         WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE);
1267 #endif
1268       ProcedureFunctionData(theEnv)->ReturnFlag = FALSE;
1269       if ((MessageHandlerData(theEnv)->NextInCore == NULL) || EvaluationData(theEnv)->HaltExecution)
1270         {
1271          MessageHandlerData(theEnv)->NextInCore = oldNext;
1272          MessageHandlerData(theEnv)->CurrentCore = oldCurrent;
1273          return;
1274         }
1275      }
1276    if (MessageHandlerData(theEnv)->NextInCore->hnd->type == MPRIMARY)
1277      {
1278       MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore;
1279       MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt;
1280 #if DEBUGGING_FUNCTIONS
1281       if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
1282         WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE);
1283 #endif
1284       if (CheckHandlerArgCount(theEnv))
1285         {
1286 #if PROFILING_FUNCTIONS
1287          StartProfile(theEnv,&profileFrame,
1288                       &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData,
1289                       ProfileFunctionData(theEnv)->ProfileConstructs);
1290 #endif
1291
1292
1293         EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule,
1294                             MessageHandlerData(theEnv)->CurrentCore->hnd->actions,
1295                             MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount,
1296                             result,UnboundHandlerErr);
1297
1298 #if PROFILING_FUNCTIONS
1299          EndProfile(theEnv,&profileFrame);
1300 #endif
1301         }
1302
1303
1304 #if DEBUGGING_FUNCTIONS
1305       if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
1306         WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE);
1307 #endif
1308       ProcedureFunctionData(theEnv)->ReturnFlag = FALSE;
1309
1310       if ((MessageHandlerData(theEnv)->NextInCore == NULL) || EvaluationData(theEnv)->HaltExecution)
1311         {
1312          MessageHandlerData(theEnv)->NextInCore = oldNext;
1313          MessageHandlerData(theEnv)->CurrentCore = oldCurrent;
1314          return;
1315         }
1316       while (MessageHandlerData(theEnv)->NextInCore->hnd->type == MPRIMARY)
1317         {
1318          MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt;
1319          if (MessageHandlerData(theEnv)->NextInCore == NULL)
1320            {
1321             MessageHandlerData(theEnv)->NextInCore = oldNext;
1322             MessageHandlerData(theEnv)->CurrentCore = oldCurrent;
1323             return;
1324            }
1325         }
1326      }
1327    while (MessageHandlerData(theEnv)->NextInCore->hnd->type == MAFTER)
1328      {
1329       MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore;
1330       MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt;
1331 #if DEBUGGING_FUNCTIONS
1332       if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
1333         WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE);
1334 #endif
1335       if (CheckHandlerArgCount(theEnv))
1336         {
1337 #if PROFILING_FUNCTIONS
1338          StartProfile(theEnv,&profileFrame,
1339                       &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData,
1340                       ProfileFunctionData(theEnv)->ProfileConstructs);
1341 #endif
1342
1343
1344          EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule,
1345                             MessageHandlerData(theEnv)->CurrentCore->hnd->actions,
1346                             MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount,
1347                             &temp,UnboundHandlerErr);
1348
1349 #if PROFILING_FUNCTIONS
1350          EndProfile(theEnv,&profileFrame);
1351 #endif
1352         }
1353
1354
1355 #if DEBUGGING_FUNCTIONS
1356       if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace)
1357         WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE);
1358 #endif
1359       ProcedureFunctionData(theEnv)->ReturnFlag = FALSE;
1360       if ((MessageHandlerData(theEnv)->NextInCore == NULL) || EvaluationData(theEnv)->HaltExecution)
1361         {
1362          MessageHandlerData(theEnv)->NextInCore = oldNext;
1363          MessageHandlerData(theEnv)->CurrentCore = oldCurrent;
1364          return;
1365         }
1366      }
1367
1368    MessageHandlerData(theEnv)->NextInCore = oldNext;
1369    MessageHandlerData(theEnv)->CurrentCore = oldCurrent;
1370   }
1371
1372
1373 /********************************************************
1374   NAME         : EarlySlotBindError
1375   DESCRIPTION  : Prints out an error message when
1376                  a message-handler from a superclass
1377                  which contains a static-bind
1378                  slot access is not valid for the
1379                  currently active instance (i.e.
1380                  the instance is not using the
1381                  superclass's slot)
1382   INPUTS       : 1) The currently active instance
1383                  2) The defclass holding the invalid slot
1384                  3) The canonical id of the slot
1385   RETURNS      : Nothing useful
1386   SIDE EFFECTS : Error message printed
1387   NOTES        : None
1388  ********************************************************/
1389 static void EarlySlotBindError(
1390   void *theEnv,
1391   INSTANCE_TYPE *theInstance,
1392   DEFCLASS *theDefclass,
1393   unsigned slotID)
1394   {
1395    SLOT_DESC *sd;
1396
1397    sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[slotID] - 1];
1398    PrintErrorID(theEnv,"MSGPASS",3,FALSE);
1399    EnvPrintRouter(theEnv,WERROR,"Static reference to slot ");
1400    EnvPrintRouter(theEnv,WERROR,ValueToString(sd->slotName->name));
1401    EnvPrintRouter(theEnv,WERROR," of class ");
1402    PrintClassName(theEnv,WERROR,theDefclass,FALSE);
1403    EnvPrintRouter(theEnv,WERROR," does not apply to ");
1404    PrintInstanceNameAndClass(theEnv,WERROR,theInstance,TRUE);
1405   }
1406
1407 /*#####################################*/
1408 /* ALLOW_ENVIRONMENT_GLOBALS Functions */
1409 /*#####################################*/
1410
1411 #if ALLOW_ENVIRONMENT_GLOBALS
1412
1413 globle void Send(
1414   DATA_OBJECT *idata,
1415   const char *msg,
1416   const char *args,
1417   DATA_OBJECT *result)
1418   {
1419    EnvSend(GetCurrentEnvironment(),idata,msg,args,result);
1420   }
1421
1422 #endif /* ALLOW_ENVIRONMENT_GLOBALS */
1423
1424 #endif /* OBJECT_SYSTEM */
1425