Exemple #1
0
static void DeallocateMessageHandlerData(
  void *theEnv)
  {
   HANDLER_LINK *tmp, *mhead, *chead;
    
   mhead = MessageHandlerData(theEnv)->TopOfCore;
   while (mhead != NULL)
     { 
      tmp = mhead;
      mhead = mhead->nxt;
      rtn_struct(theEnv,messageHandlerLink,tmp);
     }
     
   chead = MessageHandlerData(theEnv)->OldCore;
   while (chead != NULL)
     { 
      mhead = chead;
      chead = chead->nxtInStack;
      
      while (mhead != NULL)
        {
         tmp = mhead;
         mhead = mhead->nxt;
         rtn_struct(theEnv,messageHandlerLink,tmp);
        }
     }
  }
Exemple #2
0
/*****************************************************************
  NAME         : CheckCurrentMessage
  DESCRIPTION  : Makes sure that a message is available
                   and active for an internal message function
  INPUTS       : 1) The name of the function checking the message
                 2) A flag indicating whether the object must be
                      a class instance or not (it could be a
                      primitive type)
  RETURNS      : TRUE if all OK, FALSE otherwise
  SIDE EFFECTS : EvaluationError set on errors
  NOTES        : None
 *****************************************************************/
globle int CheckCurrentMessage(
  void *theEnv,
  EXEC_STATUS,
  char *func,
  int ins_reqd)
  {
   register DATA_OBJECT *activeMsgArg;

   if (!MessageHandlerData(theEnv,execStatus)->CurrentCore || (MessageHandlerData(theEnv,execStatus)->CurrentCore->hnd->actions != ProceduralPrimitiveData(theEnv,execStatus)->CurrentProcActions))
     {
      PrintErrorID(theEnv,execStatus,"MSGFUN",4,FALSE);
      EnvPrintRouter(theEnv,execStatus,WERROR,func);
      EnvPrintRouter(theEnv,execStatus,WERROR," may only be called from within message-handlers.\n");
      SetEvaluationError(theEnv,execStatus,TRUE);
      return(FALSE);
     }
   activeMsgArg = GetNthMessageArgument(theEnv,execStatus,0);
   if ((ins_reqd == TRUE) ? (activeMsgArg->type != INSTANCE_ADDRESS) : FALSE)
     {
      PrintErrorID(theEnv,execStatus,"MSGFUN",5,FALSE);
      EnvPrintRouter(theEnv,execStatus,WERROR,func);
      EnvPrintRouter(theEnv,execStatus,WERROR," operates only on instances.\n");
      SetEvaluationError(theEnv,execStatus,TRUE);
      return(FALSE);
     }
   if ((activeMsgArg->type == INSTANCE_ADDRESS) ?
       (((INSTANCE_TYPE *) activeMsgArg->value)->garbage == 1) : FALSE)
     {
      StaleInstanceAddress(theEnv,execStatus,func,0);
      SetEvaluationError(theEnv,execStatus,TRUE);
      return(FALSE);
     }
   return(TRUE);
  }
Exemple #3
0
/***************************************************************
  NAME         : CheckHandlerArgCount
  DESCRIPTION  : Verifies that the current argument
                   list satisfies the current
                   handler's parameter count restriction
  INPUTS       : None
  RETURNS      : TRUE if all OK, FALSE otherwise
  SIDE EFFECTS : EvaluationError set on errors
  NOTES        : Uses ProcParamArraySize and CurrentCore globals
 ***************************************************************/
globle int CheckHandlerArgCount(
  void *theEnv,
  EXEC_STATUS)
  {
   HANDLER *hnd;

   hnd = MessageHandlerData(theEnv,execStatus)->CurrentCore->hnd;
   if ((hnd->maxParams == -1) ? (ProceduralPrimitiveData(theEnv,execStatus)->ProcParamArraySize < hnd->minParams) :
       (ProceduralPrimitiveData(theEnv,execStatus)->ProcParamArraySize != hnd->minParams))
     {
      SetEvaluationError(theEnv,execStatus,TRUE);
      PrintErrorID(theEnv,execStatus,"MSGFUN",2,FALSE);
      EnvPrintRouter(theEnv,execStatus,WERROR,"Message-handler ");
      EnvPrintRouter(theEnv,execStatus,WERROR,ValueToString(hnd->name));
      EnvPrintRouter(theEnv,execStatus,WERROR," ");
      EnvPrintRouter(theEnv,execStatus,WERROR,MessageHandlerData(theEnv,execStatus)->hndquals[hnd->type]);
      EnvPrintRouter(theEnv,execStatus,WERROR," in class ");
      EnvPrintRouter(theEnv,execStatus,WERROR,EnvGetDefclassName(theEnv,execStatus,(void *) hnd->cls));
      EnvPrintRouter(theEnv,execStatus,WERROR," expected ");
      if (hnd->maxParams == -1)
        EnvPrintRouter(theEnv,execStatus,WERROR,"at least ");
      else
        EnvPrintRouter(theEnv,execStatus,WERROR,"exactly ");
      PrintLongInteger(theEnv,execStatus,WERROR,(long long) (hnd->minParams-1));
      EnvPrintRouter(theEnv,execStatus,WERROR," argument(s).\n");
      return(FALSE);
     }
   return(TRUE);
  }
Exemple #4
0
/*****************************************************
  NAME         : EnvGetDefmessageHandlerType
  DESCRIPTION  : Gets the type of a message-handler
  INPUTS       : 1) Pointer to a class
                 2) Array index of handler in class's
                    message-handler array (+1)
  RETURNS      : Type-string of message-handler
  SIDE EFFECTS : None
  NOTES        : None
 *****************************************************/
globle const char *EnvGetDefmessageHandlerType(
  void *theEnv,
  void *ptr,
  int theIndex)
  {
   return(MessageHandlerData(theEnv)->hndquals[((DEFCLASS *) ptr)->handlers[theIndex-1].type]);
  }
Exemple #5
0
/********************************************************
  NAME         : UnboundHandlerErr
  DESCRIPTION  : Print out a synopis of the currently
                   executing handler for unbound variable
                   errors
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Error synopsis printed to WERROR
  NOTES        : None
 ********************************************************/
globle void UnboundHandlerErr(
  void *theEnv,
  EXEC_STATUS)
  {
   EnvPrintRouter(theEnv,execStatus,WERROR,"message-handler ");
   PrintHandler(theEnv,execStatus,WERROR,MessageHandlerData(theEnv,execStatus)->CurrentCore->hnd,TRUE);
  }
Exemple #6
0
/***************************************************
  NAME         : InsertHandlerHeader
  DESCRIPTION  : Allocates a new handler header and
                   inserts it in the proper (sorted)
                   position in the class hnd array
  INPUTS       : 1) The class
                 2) The handler name
                 3) The handler type
  RETURNS      : The address of the new handler
                   header, NULL on errors
  SIDE EFFECTS : Class handler array reallocated
                   and resorted
  NOTES        : Assumes handler does not exist
 ***************************************************/
globle HANDLER *InsertHandlerHeader(
  void *theEnv,
  EXEC_STATUS,
  DEFCLASS *cls,
  SYMBOL_HN *mname,
  int mtype)
  {
   HANDLER *nhnd,*hnd;
   unsigned *narr,*arr;
   long i;
   long j,ni = -1;

   hnd = cls->handlers;
   arr = cls->handlerOrderMap;
   nhnd = (HANDLER *) gm2(theEnv,execStatus,(sizeof(HANDLER) * (cls->handlerCount+1)));
   narr = (unsigned *) gm2(theEnv,execStatus,(sizeof(unsigned) * (cls->handlerCount+1)));
   GenCopyMemory(HANDLER,cls->handlerCount,nhnd,hnd);
   for (i = 0 , j = 0 ; i < cls->handlerCount ; i++ , j++)
     {
      if (ni == -1)
        {
         if ((hnd[arr[i]].name->bucket > mname->bucket) ? TRUE :
             (hnd[arr[i]].name == mname))
           {
            ni = i;
            j++;
           }
        }
      narr[j] = arr[i];
     }
   if (ni == -1)
     ni = (int) cls->handlerCount;
   narr[ni] = cls->handlerCount;
   nhnd[cls->handlerCount].system = 0;
   nhnd[cls->handlerCount].type = mtype;
   nhnd[cls->handlerCount].busy = 0;
   nhnd[cls->handlerCount].mark = 0;
#if DEBUGGING_FUNCTIONS
   nhnd[cls->handlerCount].trace = MessageHandlerData(theEnv,execStatus)->WatchHandlers;
#endif
   nhnd[cls->handlerCount].name = mname;
   nhnd[cls->handlerCount].cls = cls;
   nhnd[cls->handlerCount].minParams = 0;
   nhnd[cls->handlerCount].maxParams = 0;
   nhnd[cls->handlerCount].localVarCount = 0;
   nhnd[cls->handlerCount].actions = NULL;
   nhnd[cls->handlerCount].ppForm = NULL;
   nhnd[cls->handlerCount].usrData = NULL;
   if (cls->handlerCount != 0)
     {
      rm(theEnv,execStatus,(void *) hnd,(sizeof(HANDLER) * cls->handlerCount));
      rm(theEnv,execStatus,(void *) arr,(sizeof(unsigned) * cls->handlerCount));
     }
   cls->handlers = nhnd;
   cls->handlerOrderMap = narr;
   cls->handlerCount++;
   return(&nhnd[cls->handlerCount-1]);
  }
Exemple #7
0
/***************************************************
  NAME         : PrintHandler
  DESCRIPTION  : Displays a handler synopsis
  INPUTS       : 1) Logical name of output
                 2) The handler
                 5) Flag indicating whether to
                    printout a terminating newline
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle void PrintHandler(
  void *theEnv,
  EXEC_STATUS,
  char *logName,
  HANDLER *theHandler,
  int crtn)
  {
   EnvPrintRouter(theEnv,execStatus,logName,ValueToString(theHandler->name));
   EnvPrintRouter(theEnv,execStatus,logName," ");
   EnvPrintRouter(theEnv,execStatus,logName,MessageHandlerData(theEnv,execStatus)->hndquals[theHandler->type]);
   EnvPrintRouter(theEnv,execStatus,logName," in class ");
   PrintClassName(theEnv,execStatus,logName,theHandler->cls,crtn);
  }
Exemple #8
0
/***********************************************************
  NAME         : WatchMessage
  DESCRIPTION  : Prints a condensed description of a
                   message and its arguments
  INPUTS       : 1) The output logical name
                 2) BEGIN_TRACE or END_TRACE string
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : Uses the global variables ProcParamArray
                   and CurrentMessageName
 ***********************************************************/
globle void WatchMessage(
  void *theEnv,
  EXEC_STATUS,
  char *logName,
  char *tstring)
  {
   EnvPrintRouter(theEnv,execStatus,logName,"MSG ");
   EnvPrintRouter(theEnv,execStatus,logName,tstring);
   EnvPrintRouter(theEnv,execStatus,logName," ");
   EnvPrintRouter(theEnv,execStatus,logName,ValueToString(MessageHandlerData(theEnv,execStatus)->CurrentMessageName));
   EnvPrintRouter(theEnv,execStatus,logName," ED:");
   PrintLongInteger(theEnv,execStatus,logName,(long long) execStatus->CurrentEvaluationDepth);
   PrintProcParamArray(theEnv,execStatus,logName);
  }
Exemple #9
0
/*******************************************************************************
  NAME         : PPDefmessageHandlerCommand
  DESCRIPTION  : Displays the pretty-print form (if any) for a handler
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : H/L Syntax: (ppdefmessage-handler <class> <message> [<type>])
 *******************************************************************************/
globle void PPDefmessageHandlerCommand(
  void *theEnv)
  {
   DATA_OBJECT temp;
   SYMBOL_HN *csym,*msym;
   const char *tname;
   DEFCLASS *cls = NULL;
   unsigned mtype;
   HANDLER *hnd;

   if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",1,SYMBOL,&temp) == FALSE)
     return;
   csym = FindSymbolHN(theEnv,DOToString(temp));
   if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",2,SYMBOL,&temp) == FALSE)
     return;
   msym = FindSymbolHN(theEnv,DOToString(temp));
   if (EnvRtnArgCount(theEnv) == 3)
     {
      if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",3,SYMBOL,&temp) == FALSE)
        return;
      tname = DOToString(temp);
     }
   else
     tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY];
   mtype = HandlerType(theEnv,"ppdefmessage-handler",tname);
   if (mtype == MERROR)
     {
      EnvSetEvaluationError(theEnv,TRUE);
      return;
     }
   if (csym != NULL)
     cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(csym));
   if (((cls == NULL) || (msym == NULL)) ? TRUE :
       ((hnd = FindHandlerByAddress(cls,msym,(unsigned) mtype)) == NULL))
     {
      PrintErrorID(theEnv,"MSGCOM",2,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Unable to find message-handler ");
      EnvPrintRouter(theEnv,WERROR,ValueToString(msym));
      EnvPrintRouter(theEnv,WERROR," ");
      EnvPrintRouter(theEnv,WERROR,tname);
      EnvPrintRouter(theEnv,WERROR," for class ");
      EnvPrintRouter(theEnv,WERROR,ValueToString(csym));
      EnvPrintRouter(theEnv,WERROR," in function ppdefmessage-handler.\n");
      EnvSetEvaluationError(theEnv,TRUE);
      return;
     }
   if (hnd->ppForm != NULL)
     PrintInChunks(theEnv,WDISPLAY,hnd->ppForm);
  }
Exemple #10
0
/******************************************************************************
  NAME         : UndefmessageHandlerCommand
  DESCRIPTION  : Deletes a handler from a class
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Handler deleted if possible
  NOTES        : H/L Syntax: (undefmessage-handler <class> <handler> [<type>])
 ******************************************************************************/
globle void UndefmessageHandlerCommand(
  void *theEnv)
  {
#if RUN_TIME || BLOAD_ONLY
   PrintErrorID(theEnv,"MSGCOM",3,FALSE);
   EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n");
#else
   SYMBOL_HN *mname;
   const char *tname;
   DATA_OBJECT tmp;
   DEFCLASS *cls;

#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded(theEnv))
     {
      PrintErrorID(theEnv,"MSGCOM",3,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n");
      return;
     }
#endif
   if (EnvArgTypeCheck(theEnv,"undefmessage-handler",1,SYMBOL,&tmp) == FALSE)
     return;
   cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp));
   if ((cls == NULL) ? (strcmp(DOToString(tmp),"*") != 0) : FALSE)
     {
      ClassExistError(theEnv,"undefmessage-handler",DOToString(tmp));
      return;
     }
   if (EnvArgTypeCheck(theEnv,"undefmessage-handler",2,SYMBOL,&tmp) == FALSE)
     return;
   mname = (SYMBOL_HN *) tmp.value;
   if (EnvRtnArgCount(theEnv) == 3)
     {
      if (EnvArgTypeCheck(theEnv,"undefmessage-handler",3,SYMBOL,&tmp) == FALSE)
        return;
      tname = DOToString(tmp);
      if (strcmp(tname,"*") == 0)
        tname = NULL;
     }
   else
     tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY];
   WildDeleteHandler(theEnv,cls,mname,tname);
#endif
  }
Exemple #11
0
/*****************************************************
  NAME         : HandlerType
  DESCRIPTION  : Determines type of message-handler
  INPUTS       : 1) Calling function string
                 2) String representing type
  RETURNS      : MAROUND  (0) for "around"
                 MBEFORE  (1) for "before"
                 MPRIMARY (2) for "primary"
                 MAFTER   (3) for "after"
                 MERROR   (4) on errors
  SIDE EFFECTS : None
  NOTES        : None
 *****************************************************/
globle unsigned HandlerType(
  void *theEnv,
  EXEC_STATUS,
  char *func,
  char *str)
  {
   register unsigned i;

   for (i = MAROUND ; i <= MAFTER ; i++)
     if (strcmp(str,MessageHandlerData(theEnv,execStatus)->hndquals[i]) == 0)
       {
        return(i);
       }

   PrintErrorID(theEnv,execStatus,"MSGFUN",7,FALSE);
   EnvPrintRouter(theEnv,execStatus,"werror","Unrecognized message-handler type in ");
   EnvPrintRouter(theEnv,execStatus,"werror",func);
   EnvPrintRouter(theEnv,execStatus,"werror",".\n");
   return(MERROR);
  }
Exemple #12
0
/***************************************************
  NAME         : SetupMessageHandlers
  DESCRIPTION  : Sets up internal symbols and
                 fucntion definitions pertaining to
                 message-handlers.  Also creates
                 system handlers
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Functions and data structures
                 initialized
  NOTES        : Should be called before
                 SetupInstanceModDupCommands() in
                 INSMODDP.C
 ***************************************************/
globle void SetupMessageHandlers(
  void *theEnv)
  {
   ENTITY_RECORD handlerGetInfo = { "HANDLER_GET", HANDLER_GET,0,1,1,
                                        PrintHandlerSlotGetFunction,
                                        PrintHandlerSlotGetFunction,NULL,
                                        HandlerSlotGetFunction,
                                        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL },

                 handlerPutInfo = { "HANDLER_PUT", HANDLER_PUT,0,1,1,
                                        PrintHandlerSlotPutFunction,
                                        PrintHandlerSlotPutFunction,NULL,
                                        HandlerSlotPutFunction,
                                        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL };

   AllocateEnvironmentData(theEnv,MESSAGE_HANDLER_DATA,sizeof(struct messageHandlerData),DeallocateMessageHandlerData);
   memcpy(&MessageHandlerData(theEnv)->HandlerGetInfo,&handlerGetInfo,sizeof(struct entityRecord));   
   memcpy(&MessageHandlerData(theEnv)->HandlerPutInfo,&handlerPutInfo,sizeof(struct entityRecord));   

   MessageHandlerData(theEnv)->hndquals[0] = "around";
   MessageHandlerData(theEnv)->hndquals[1] = "before";
   MessageHandlerData(theEnv)->hndquals[2] = "primary";
   MessageHandlerData(theEnv)->hndquals[3] = "after";

   InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerGetInfo,HANDLER_GET);
   InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerPutInfo,HANDLER_PUT);

#if ! RUN_TIME
   MessageHandlerData(theEnv)->INIT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INIT_STRING);
   IncrementSymbolCount(MessageHandlerData(theEnv)->INIT_SYMBOL);

   MessageHandlerData(theEnv)->DELETE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,DELETE_STRING);
   IncrementSymbolCount(MessageHandlerData(theEnv)->DELETE_SYMBOL);
   
   MessageHandlerData(theEnv)->CREATE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,CREATE_STRING);
   IncrementSymbolCount(MessageHandlerData(theEnv)->CREATE_SYMBOL);
   
   EnvAddClearFunction(theEnv,"defclass",CreateSystemHandlers,-100);

#if ! BLOAD_ONLY
   MessageHandlerData(theEnv)->SELF_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SELF_STRING);
   IncrementSymbolCount(MessageHandlerData(theEnv)->SELF_SYMBOL);

   AddConstruct(theEnv,"defmessage-handler","defmessage-handlers",
                ParseDefmessageHandler,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
   EnvDefineFunction2(theEnv,"undefmessage-handler",'v',PTIEF UndefmessageHandlerCommand,
                  "UndefmessageHandlerCommand","23w");

#endif

   EnvDefineFunction2(theEnv,"send",'u',PTIEF SendCommand,"SendCommand","2*uuw");

#if DEBUGGING_FUNCTIONS
   EnvDefineFunction2(theEnv,"preview-send",'v',PTIEF PreviewSendCommand,"PreviewSendCommand","22w");

   EnvDefineFunction2(theEnv,"ppdefmessage-handler",'v',PTIEF PPDefmessageHandlerCommand,
                  "PPDefmessageHandlerCommand","23w");
   EnvDefineFunction2(theEnv,"list-defmessage-handlers",'v',PTIEF ListDefmessageHandlersCommand,
                  "ListDefmessageHandlersCommand","02w");
#endif

   EnvDefineFunction2(theEnv,"next-handlerp",'b',PTIEF NextHandlerAvailable,"NextHandlerAvailable","00");
   FuncSeqOvlFlags(theEnv,"next-handlerp",TRUE,FALSE);
   EnvDefineFunction2(theEnv,"call-next-handler",'u',
                  PTIEF CallNextHandler,"CallNextHandler","00");
   FuncSeqOvlFlags(theEnv,"call-next-handler",TRUE,FALSE);
   EnvDefineFunction2(theEnv,"override-next-handler",'u',
                  PTIEF CallNextHandler,"CallNextHandler",NULL);
   FuncSeqOvlFlags(theEnv,"override-next-handler",TRUE,FALSE);

   EnvDefineFunction2(theEnv,"dynamic-get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w");
   EnvDefineFunction2(theEnv,"dynamic-put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w");
   EnvDefineFunction2(theEnv,"get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w");
   EnvDefineFunction2(theEnv,"put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w");
#endif

#if DEBUGGING_FUNCTIONS
   AddWatchItem(theEnv,"messages",0,&MessageHandlerData(theEnv)->WatchMessages,36,NULL,NULL);
   AddWatchItem(theEnv,"message-handlers",0,&MessageHandlerData(theEnv)->WatchHandlers,35,
                DefmessageHandlerWatchAccess,DefmessageHandlerWatchPrint);
#endif
  }
Exemple #13
0
/***************************************************
  NAME         : ObjectsRunTimeInitialize
  DESCRIPTION  : Initializes objects system lists
                   in a run-time module
  INPUTS       : 1) Pointer to new class hash table
                 2) Pointer to new slot name table
  RETURNS      : Nothing useful
  SIDE EFFECTS : Global pointers set
  NOTES        : None
 ***************************************************/
globle void ObjectsRunTimeInitialize(
    void *theEnv,
    DEFCLASS *ctable[],
    SLOT_NAME *sntable[],
    DEFCLASS **cidmap,
    unsigned mid)
{
    DEFCLASS *cls;
    void *tmpexp;
    register unsigned int i,j;

    if (DefclassData(theEnv)->ClassTable != NULL)
    {
        for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
            for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
            {
                for (i = 0 ; i < cls->slotCount ; i++)
                {
                    /* =====================================================================
                       For static default values, the data object value needs to deinstalled
                       and deallocated, and the expression needs to be restored (which was
                       temporarily stored in the supplementalInfo field of the data object)
                       ===================================================================== */
                    if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
                    {
                        tmpexp = ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo;
                        ValueDeinstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
                        rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue);
                        cls->slots[i].defaultValue = tmpexp;
                    }
                }
            }
    }

    InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING);
    MessageHandlerData(theEnv)->INIT_SYMBOL = FindSymbolHN(theEnv,INIT_STRING);
    MessageHandlerData(theEnv)->DELETE_SYMBOL = FindSymbolHN(theEnv,DELETE_STRING);
    MessageHandlerData(theEnv)->CREATE_SYMBOL = FindSymbolHN(theEnv,CREATE_STRING);
    DefclassData(theEnv)->ISA_SYMBOL = FindSymbolHN(theEnv,SUPERCLASS_RLN);
    DefclassData(theEnv)->NAME_SYMBOL = FindSymbolHN(theEnv,NAME_RLN);
#if DEFRULE_CONSTRUCT
    DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = FindSymbolHN(theEnv,INITIAL_OBJECT_NAME);
#endif

    DefclassData(theEnv)->ClassTable = (DEFCLASS **) ctable;
    DefclassData(theEnv)->SlotNameTable = (SLOT_NAME **) sntable;
    DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) cidmap;
    DefclassData(theEnv)->MaxClassID = (unsigned short) mid;
    DefclassData(theEnv)->PrimitiveClassMap[FLOAT] =
        LookupDefclassByMdlOrScope(theEnv,FLOAT_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[INTEGER] =
        LookupDefclassByMdlOrScope(theEnv,INTEGER_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[STRING] =
        LookupDefclassByMdlOrScope(theEnv,STRING_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[SYMBOL] =
        LookupDefclassByMdlOrScope(theEnv,SYMBOL_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD] =
        LookupDefclassByMdlOrScope(theEnv,MULTIFIELD_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS] =
        LookupDefclassByMdlOrScope(theEnv,EXTERNAL_ADDRESS_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS] =
        LookupDefclassByMdlOrScope(theEnv,FACT_ADDRESS_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME] =
        LookupDefclassByMdlOrScope(theEnv,INSTANCE_NAME_TYPE_NAME);
    DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS] =
        LookupDefclassByMdlOrScope(theEnv,INSTANCE_ADDRESS_TYPE_NAME);

    for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
        for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
        {
            for (i = 0 ; i < cls->slotCount ; i++)
            {
                if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
                {
                    tmpexp = cls->slots[i].defaultValue;
                    cls->slots[i].defaultValue = (void *) get_struct(theEnv,dataObject);
                    EvaluateAndStoreInDataObject(theEnv,(int) cls->slots[i].multiple,(EXPRESSION *) tmpexp,
                                                 (DATA_OBJECT *) cls->slots[i].defaultValue,TRUE);
                    ValueInstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
                    ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo = tmpexp;
                }
            }
        }

    SearchForHashedPatternNodes(theEnv,ObjectReteData(theEnv)->ObjectPatternNetworkPointer);
}
Exemple #14
0
/************************************************************************
  NAME         : EnvGetDefmessageHandlerList
  DESCRIPTION  : Groups handler info for a class into a multifield value
                   for dynamic perusal
  INPUTS       : 1) Generic pointer to class (NULL to get handlers for
                    all classes)
                 2) Data object buffer to hold the handlers of the class
                 3) Include (1) or exclude (0) inherited handlers
  RETURNS      : Nothing useful
  SIDE EFFECTS : Creates a multifield storing the names and types of
                    the message-handlers of the class
  NOTES        : None
 ************************************************************************/
globle void EnvGetDefmessageHandlerList(
  void *theEnv,
  void *clsptr,
  DATA_OBJECT *result,
  int inhp)
  {
   DEFCLASS *cls,*svcls,*svnxt,*supcls;
   long j;
   register int classi,classiLimit;
   unsigned long i, sublen, len;

   if (clsptr == NULL)
     {
      inhp = 0;
      cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL);
      svnxt = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls);
     }
   else
     {
      cls = (DEFCLASS *) clsptr;
      svnxt = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls);
      SetNextDefclass((void *) cls,NULL);
     }
   for (svcls = cls , i = 0 ;
        cls != NULL ;
        cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls))
     {
      classiLimit = inhp ? cls->allSuperclasses.classCount : 1;
      for (classi = 0 ; classi < classiLimit ; classi++)
        i += cls->allSuperclasses.classArray[classi]->handlerCount;
     }
   len = i * 3;
   result->type = MULTIFIELD;
   SetpDOBegin(result,1);
   SetpDOEnd(result,len);
   result->value = (void *) EnvCreateMultifield(theEnv,len);
   for (cls = svcls , sublen = 0 ;
        cls != NULL ;
        cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls))
     {
      classiLimit = inhp ? cls->allSuperclasses.classCount : 1;
      for (classi = 0 ; classi < classiLimit ; classi++)
        {
         supcls = cls->allSuperclasses.classArray[classi];
         if (inhp == 0)
           i = sublen + 1;
         else
           i = len - (supcls->handlerCount * 3) - sublen + 1;
         for (j = 0 ; j < supcls->handlerCount ; j++)
           {
            SetMFType(result->value,i,SYMBOL);
            SetMFValue(result->value,i++,GetDefclassNamePointer((void *) supcls));
            SetMFType(result->value,i,SYMBOL);
            SetMFValue(result->value,i++,supcls->handlers[j].name);
            SetMFType(result->value,i,SYMBOL);
            SetMFValue(result->value,i++,EnvAddSymbol(theEnv,MessageHandlerData(theEnv)->hndquals[supcls->handlers[j].type]));
           }
         sublen += supcls->handlerCount * 3;
        }
     }
   if (svcls != NULL)
     SetNextDefclass((void *) svcls,(void *) svnxt);
  }
Exemple #15
0
/***********************************************************************
  NAME         : ParseDefmessageHandler
  DESCRIPTION  : Parses a message-handler for a class of objects
  INPUTS       : The logical name of the input source
  RETURNS      : FALSE if successful parse, TRUE otherwise
  SIDE EFFECTS : Handler allocated and inserted into class
  NOTES        : H/L Syntax:

                 (defmessage-handler <class> <name> [<type>] [<comment>]
                    (<params>)
                    <action>*)

                 <params> ::= <var>* | <var>* $?<name>
 ***********************************************************************/
globle int ParseDefmessageHandler(
  void *theEnv,
  char *readSource)
  {
   DEFCLASS *cls;
   SYMBOL_HN *cname,*mname,*wildcard;
   unsigned mtype = MPRIMARY;
   int min,max,error,lvars;
   EXPRESSION *hndParams,*actions;
   HANDLER *hnd;

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,"(defmessage-handler ");

#if BLOAD || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"defmessage-handler");
      return(TRUE);
     }
#endif
   cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler",
                                      NULL,NULL,"~",TRUE,FALSE,DEFMODULE_CONSTRUCT);
   if (cname == NULL)
     return(TRUE);
   cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname));
   if (cls == NULL)
     {
      PrintErrorID(theEnv,"MSGPSR",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n");
      return(TRUE);
     }
   if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) ||
       (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) ||
       (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0]))
     {
      PrintErrorID(theEnv,"MSGPSR",8,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class ");
      EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls));
      EnvPrintRouter(theEnv,WERROR,".\n");
      return(TRUE);
     }
   if (HandlersExecuting(cls))
     {
      PrintErrorID(theEnv,"MSGPSR",2,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n");
      EnvPrintRouter(theEnv,WERROR,"  other message-handlers for the same class.\n");
      return(TRUE);
     }
   if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
     {
      SyntaxErrorMessage(theEnv,"defmessage-handler");
      return(TRUE);
     }
   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv," ");
   SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
   SavePPBuffer(theEnv," ");
   mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken);
   GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
   if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN)
     {
      SavePPBuffer(theEnv," ");
      if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING)
        {
         if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
           {
            SyntaxErrorMessage(theEnv,"defmessage-handler");
            return(TRUE);
           }
         mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken));
         if (mtype == MERROR)
           return(TRUE);
#if ! IMPERATIVE_MESSAGE_HANDLERS
         if (mtype == MAROUND)
           return(TRUE);
#endif
         GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
         if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING)
           {
            SavePPBuffer(theEnv," ");
            GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
           }
        }
      else
        {
         SavePPBuffer(theEnv," ");
         GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
        }
     }
   PPBackup(theEnv);
   PPBackup(theEnv);
   PPCRAndIndent(theEnv);
   SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);

   hnd = FindHandlerByAddress(cls,mname,mtype);
   if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv))
     {
      EnvPrintRouter(theEnv,WDIALOG,"   Handler ");
      EnvPrintRouter(theEnv,WDIALOG,ValueToString(mname));
      EnvPrintRouter(theEnv,WDIALOG," ");
      EnvPrintRouter(theEnv,WDIALOG,MessageHandlerData(theEnv)->hndquals[mtype]);
      EnvPrintRouter(theEnv,WDIALOG,(char *) ((hnd == NULL) ? " defined.\n" : " redefined.\n"));
     }

   if ((hnd != NULL) ? hnd->system : FALSE)
     {
      PrintErrorID(theEnv,"MSGPSR",3,FALSE);
      EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n");
      return(TRUE);
     }

   hndParams = GenConstant(theEnv,SYMBOL,(void *) MessageHandlerData(theEnv)->SELF_SYMBOL);
   hndParams = ParseProcParameters(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,hndParams,
                                    &wildcard,&min,&max,&error,IsParameterSlotReference);
   if (error)
     return(TRUE);
   PPCRAndIndent(theEnv);
   ExpressionData(theEnv)->ReturnContext = TRUE;
   actions = ParseProcActions(theEnv,"message-handler",readSource,
                              &DefclassData(theEnv)->ObjectParseToken,hndParams,wildcard,
                              SlotReferenceVar,BindSlotReference,&lvars,
                              (void *) cls);
   if (actions == NULL)
     {
      ReturnExpression(theEnv,hndParams);
      return(TRUE);
     }
   if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
     {
      SyntaxErrorMessage(theEnv,"defmessage-handler");
      ReturnExpression(theEnv,hndParams);
      ReturnPackedExpression(theEnv,actions);
      return(TRUE);
     }
   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
   SavePPBuffer(theEnv,"\n");

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

   if (ConstructData(theEnv)->CheckSyntaxMode)
     {
      ReturnExpression(theEnv,hndParams);
      ReturnPackedExpression(theEnv,actions);
      return(FALSE);
     }

   if (hnd != NULL)
     {
      ExpressionDeinstall(theEnv,hnd->actions);
      ReturnPackedExpression(theEnv,hnd->actions);
      if (hnd->ppForm != NULL)
        rm(theEnv,(void *) hnd->ppForm,
           (sizeof(char) * (strlen(hnd->ppForm)+1)));
     }
   else
     {
      hnd = InsertHandlerHeader(theEnv,cls,mname,(int) mtype);
      IncrementSymbolCount(hnd->name);
     }
   ReturnExpression(theEnv,hndParams);

   hnd->minParams = min;
   hnd->maxParams = max;
   hnd->localVarCount = lvars;
   hnd->actions = actions;
   ExpressionInstall(theEnv,hnd->actions);
#if DEBUGGING_FUNCTIONS

   /* ===================================================
      Old handler trace status is automatically preserved
      =================================================== */
   if (EnvGetConserveMemory(theEnv) == FALSE)
     hnd->ppForm = CopyPPBuffer(theEnv);
   else
#endif
     hnd->ppForm = NULL;
   return(FALSE);
  }