msgpass.c

NASA 开发使用的一个专家系统

      return;
     }
   ins = GetActiveInstance();
   sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
   if (sp == NULL)
     {
      SlotExistError(ValueToString(temp.value),"dynamic-put");
      return;
     }
   if ((sp->desc->noWrite == 0) ? CLIPS_FALSE :
       ((sp->desc->initializeOnly == 0) || (WithinInit == CLIPS_FALSE)))
     {
      SlotAccessViolationError(ValueToString(sp->desc->slotName->name),
                               CLIPS_TRUE,(VOID *) ins);
      SetEvaluationError(CLIPS_TRUE);
      return;
     }
   if ((sp->desc->publicVisibility == 0) &&
       (CurrentCore->hnd->cls != sp->desc->cls))
     {
      SlotVisibilityViolationError(sp->desc,CurrentCore->hnd->cls);
      SetEvaluationError(CLIPS_TRUE);
      return;
     }
   if (GetFirstArgument()->nextArg)
     {
      if (EvaluateAndStoreInDataObject((int) sp->desc->multiple,
                        GetFirstArgument()->nextArg,&temp) == CLIPS_FALSE)
        return;
     }
   else
     {
      SetpDOBegin(&temp,1);
      SetpDOEnd(&temp,0);
      SetpType(&temp,MULTIFIELD);
      SetpValue(&temp,NoParamValue);
     }
   PutSlotValue(ins,sp,&temp,theResult,NULL);
  }

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */
   
/*****************************************************
  NAME         : PerformMessage
  DESCRIPTION  : Calls core framework for a message
  INPUTS       : 1) Caller's result buffer
                 2) Message argument expressions
                    (including implicit object)
                 3) Message name
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any side-effects of message execution
                    and caller's result buffer set
  NOTES        : None
 *****************************************************/
static VOID PerformMessage(result,args,mname)
  DATA_OBJECT *result;
  EXPRESSION *args;
  SYMBOL_HN *mname;
  {
   int oldce;
   HANDLER_LINK *oldCore;
   DEFCLASS *cls = NULL;
   INSTANCE_TYPE *ins = NULL;
   SYMBOL_HN *oldName;
   
   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   EvaluationError = CLIPS_FALSE;
   if (HaltExecution)
     return;
   oldce = ExecutingConstruct();
   SetExecutingConstruct(CLIPS_TRUE);
   oldName = CurrentMessageName;
   CurrentMessageName = mname;
   CurrentEvaluationDepth++;
   PushProcParameters(args,CountArguments(args),
                        ValueToString(CurrentMessageName),"message",
                        UnboundHandlerErr);
   if (EvaluationError)
     {
      CurrentEvaluationDepth--;
      CurrentMessageName = oldName;
      PeriodicCleanup(CLIPS_FALSE,CLIPS_TRUE);
      SetExecutingConstruct(oldce);
      return;
     }
   if (ProcParamArray->type == INSTANCE_ADDRESS)
     {
      ins = (INSTANCE_TYPE *) ProcParamArray->value;
      if (ins->garbage == 1)
        {
         StaleInstanceAddress("send");
         SetEvaluationError(CLIPS_TRUE);
        }
      else if (DefclassInScope(ins->cls,GetCurrentModule()) == CLIPS_FALSE)
        NoInstanceError(ValueToString(ins->name),"send");
      else
        {
         cls = ins->cls;
         ins->busy++;
        }
     }
   else if (ProcParamArray->type == INSTANCE_NAME)
     {
      ins = FindInstanceBySymbol((SYMBOL_HN *) ProcParamArray->value);
      if (ins == NULL)
        {
         PrintErrorID("MSGPASS",2,CLIPS_FALSE);
         PrintCLIPS(WERROR,"No such instance ");
         PrintCLIPS(WERROR,ValueToString((SYMBOL_HN *) ProcParamArray->value));
         PrintCLIPS(WERROR," in function send.\n");
         SetEvaluationError(CLIPS_TRUE);
        }
      else
        {
         ProcParamArray->value = (VOID *) ins;
         ProcParamArray->type = INSTANCE_ADDRESS;
         cls = ins->cls;
         ins->busy++;
        }
     }
   else if ((cls = PrimitiveClassMap[ProcParamArray->type]) == NULL)
     {
      CLIPSSystemError("MSGPASS",1);
      ExitCLIPS(2);
     }
   if (EvaluationError)
     {
      PopProcParameters();
      CurrentEvaluationDepth--;
      CurrentMessageName = oldName;
      PeriodicCleanup(CLIPS_FALSE,CLIPS_TRUE);
      SetExecutingConstruct(oldce);
      return;
     }
   oldCore = TopOfCore;
   TopOfCore = FindApplicableHandlers(cls,mname);
   if (TopOfCore != NULL)
     {
      HANDLER_LINK *oldCurrent,*oldNext;

      oldCurrent = CurrentCore;
      oldNext = NextInCore;
      
#if IMPERATIVE_MESSAGE_HANDLERS

      if (TopOfCore->hnd->type == MAROUND)
        {
         CurrentCore = TopOfCore;
         NextInCore = TopOfCore->nxt;
#if DEBUGGING_FUNCTIONS
         if (WatchMessages)
           WatchMessage(WTRACE,BEGIN_TRACE);
         if (CurrentCore->hnd->trace)
           WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE);
#endif
         if (CheckHandlerArgCount())
           EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule,
                               CurrentCore->hnd->actions,
                               CurrentCore->hnd->localVarCount,
                               result,UnboundHandlerErr);
#if DEBUGGING_FUNCTIONS
         if (CurrentCore->hnd->trace)
           WatchHandler(WTRACE,CurrentCore,END_TRACE);
         if (WatchMessages)
           WatchMessage(WTRACE,END_TRACE);
#endif
        }
      else
      
#endif  /* IMPERATIVE_MESSAGE_HANDLERS */

        {
         CurrentCore = NULL;
         NextInCore = TopOfCore;
#if DEBUGGING_FUNCTIONS
         if (WatchMessages)
           WatchMessage(WTRACE,BEGIN_TRACE);
#endif
         CallHandlers(result);
#if DEBUGGING_FUNCTIONS
         if (WatchMessages)
           WatchMessage(WTRACE,END_TRACE);
#endif
        }

      DestroyHandlerLinks(TopOfCore);
      CurrentCore = oldCurrent;
      NextInCore = oldNext;
     }
   TopOfCore = oldCore;
   ReturnFlag = CLIPS_FALSE;

   if (ins != NULL)
     ins->busy--;
     
   /* ==================================
      Restore the original calling frame
      ================================== */
   PopProcParameters();
   CurrentEvaluationDepth--;
   CurrentMessageName = oldName;
   PropagateReturnValue(result);
   PeriodicCleanup(CLIPS_FALSE,CLIPS_TRUE);
   SetExecutingConstruct(oldce);
   if (EvaluationError)
     {
      result->type = SYMBOL;
      result->value = CLIPSFalseSymbol;
     }
  }

/*****************************************************************************
  NAME         : FindApplicableHandlers
  DESCRIPTION  : Given a message name, this routine forms the "core frame"
                   for the message : a list of all applicable class handlers.
                   An applicable class handler is one whose name matches
                     the message and whose class matches the instance.
                     
                   The list is in the following order :
                   
                   All around handlers (from most specific to most general)
                   All before handlers (from most specific to most general)
                   All primary handlers (from most specific to most general)
                   All after handlers (from most general to most specific)
                   
  INPUTS       : 1) The class of the instance (or primitive) for the message
                 2) The message name
  RETURNS      : NULL if no applicable handlers or errors,
                   the list of handlers otherwise
  SIDE EFFECTS : Links are allocated for the list
  NOTES        : The instance is the first thing on the ProcParamArray
                 The number of arguments is in ProcParamArraySize
 *****************************************************************************/
static HANDLER_LINK *FindApplicableHandlers(cls,mname)
  DEFCLASS *cls;
  SYMBOL_HN *mname;
  {
   register int i;
   HANDLER_LINK *tops[4],*bots[4];
   
   for (i = MAROUND ; i <= MAFTER ; i++)
     tops[i] = bots[i] = NULL;
     
   for (i = 0 ; i < cls->allSuperclasses.classCount ; i++)
     FindApplicableOfName(cls->allSuperclasses.classArray[i],tops,bots,mname);
   return(JoinHandlerLinks(tops,bots,mname));
  }
  
/***************************************************************
  NAME         : CallHandlers
  DESCRIPTION  : Moves though the current message frame
                   for a send-message as follows :

                 Call all before handlers and ignore their
                   return values.
                 Call the first primary handler and
                   ignore the rest.  The return value
                   of the handler frame is this message's value.
                 Call all after handlers and ignore their
                   return values.
  INPUTS       : Caller's buffer for the return value of
                   the message
  RETURNS      : Nothing useful
  SIDE EFFECTS : The handlers are evaluated.
  NOTES        : IMPORTANT : The global NextInCore should be
                 pointing to the first handler to be executed.
 ***************************************************************/
static VOID CallHandlers(result)
  DATA_OBJECT *result;
  {
   HANDLER_LINK *oldCurrent,*oldNext;
#if AUXILIARY_MESSAGE_HANDLERS
   DATA_OBJECT temp;
#endif
   
   if (HaltExecution)
     return;
     
#if AUXILIARY_MESSAGE_HANDLERS
   oldCurrent = CurrentCore;
   oldNext = NextInCore;

   while (NextInCore->hnd->type == MBEFORE)
     {
      CurrentCore = NextInCore;
      NextInCore = NextInCore->nxt;
#if DEBUGGING_FUNCTIONS
      if (CurrentCore->hnd->trace)
        WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE);
#endif
      if (CheckHandlerArgCount())
        EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule,
                            CurrentCore->hnd->actions,
                            CurrentCore->hnd->localVarCount,
                            &temp,UnboundHandlerErr);
#if DEBUGGING_FUNCTIONS
      if (CurrentCore->hnd->trace)
        WatchHandler(WTRACE,CurrentCore,END_TRACE);
#endif
      ReturnFlag = CLIPS_FALSE;
      if ((NextInCore == NULL) || HaltExecution)
        {
         NextInCore = oldNext;
         CurrentCore = oldCurrent;
         return;
        }
     }
   if (NextInCore->hnd->type == MPRIMARY)
     {
#endif /* AUXILIARY_MESSAGE_HANDLERS */

      CurrentCore = NextInCore;
      NextInCore = NextInCore->nxt;
#if DEBUGGING_FUNCTIONS
      if (CurrentCore->hnd->trace)
        WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE);
#endif
      if (CheckHandlerArgCount())
        EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule,
                            CurrentCore->hnd->actions,
                            CurrentCore->hnd->localVarCount,
                            result,UnboundHandlerErr);
#if DEBUGGING_FUNCTIONS
      if (CurrentCore->hnd->trace)
        WatchHandler(WTRACE,CurrentCore,END_TRACE);
#endif
      ReturnFlag = CLIPS_FALSE;

#if AUXILIARY_MESSAGE_HANDLERS
      if ((NextInCore == NULL) || HaltExecution)
        {
         NextInCore = oldNext;
         CurrentCore = oldCurrent;
         return;
        }
      while (NextInCore->hnd->type == MPRIMARY)
        {
         NextInCore = NextInCore->nxt;
         if (NextInCore == NULL)
           {
            NextInCore = oldNext;
            CurrentCore = oldCurrent;
            return;
           }
        }
     }
   while (NextInCore->hnd->type == MAFTER)
     {
      CurrentCore = NextInCore;
      NextInCore = NextInCore->nxt;
#if DEBUGGING_FUNCTIONS
      if (CurrentCore->hnd->trace)
        WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE);
#endif
      if (CheckHandlerArgCount())
        EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule,
                            CurrentCore->hnd->actions,
                            CurrentCore->hnd->localVarCount,
                            &temp,UnboundHandlerErr);
#if DEBUGGING_FUNCTIONS
      if (CurrentCore->hnd->trace)
        WatchHandler(WTRACE,CurrentCore,END_TRACE);
#endif
      ReturnFlag = CLIPS_FALSE;
      if ((NextInCore == NULL) || HaltExecution)
        {
         NextInCore = oldNext;
         CurrentCore = oldCurrent;
         return;
        }
     }
#endif /*  AUXILIARY_MESSAGE_HANDLERS */

   NextInCore = oldNext;
   CurrentCore = oldCurrent;
  }
    
  
/********************************************************
  NAME         : EarlySlotBindError
  DESCRIPTION  : Prints out an error message when
                 a message-handler from a superclass
                 which contains a static-bind
                 slot access is not valid for the
                 currently active instance (i.e.
                 the instance is not using the
                 superclass's slot)
  INPUTS       : 1) The currently active instance
                 2) The defclass holding the invalid slot
                 3) The canonical id of the slot
  RETURNS      : Nothing useful
  SIDE EFFECTS : Error message printed
  NOTES        : None
 ********************************************************/
static VOID EarlySlotBindError(theInstance,theDefclass,slotID)
  INSTANCE_TYPE *theInstance;
  DEFCLASS *theDefclass;
  unsigned slotID;
  {
   SLOT_DESC *sd;
   
   sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[slotID] - 1];
   PrintErrorID("MSGPASS",3,CLIPS_FALSE);
   PrintCLIPS(WERROR,"Static reference to slot ");
   PrintCLIPS(WERROR,ValueToString(sd->slotName->name));
   PrintCLIPS(WERROR," of class ");
   PrintClassName(WERROR,theDefclass,CLIPS_FALSE);
   PrintCLIPS(WERROR," does not apply to ");
   PrintInstanceNameAndClass(WERROR,theInstance,CLIPS_TRUE);
  }
  
#endif

/***************************************************
  NAME         : 
  DESCRIPTION  : 
  INPUTS       : 
  RETURNS      : 
  SIDE EFFECTS : 
  NOTES        : 
 ***************************************************/