msgpass.c

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

        continue;
#endif
      tmp = get_struct(messageHandlerLink);
      hnd[arr[i]].busy++;
      IncrementDefclassBusyCount((VOID *) hnd[arr[i]].cls);
      tmp->hnd = &hnd[arr[i]];
      if (tops[tmp->hnd->type] == NULL)
        {
         tmp->nxt = NULL;
         tops[tmp->hnd->type] = bots[tmp->hnd->type] = tmp;
        }
#if AUXILIARY_MESSAGE_HANDLERS
      else if (tmp->hnd->type == MAFTER)
        {
         tmp->nxt = tops[tmp->hnd->type];
         tops[tmp->hnd->type] = tmp;
        }
#endif
      else
        {
         bots[tmp->hnd->type]->nxt = tmp;
         bots[tmp->hnd->type] = tmp;
         tmp->nxt = NULL;
        }
     }
  }
    
/*************************************************************************
  NAME         : JoinHandlerLinks
  DESCRIPTION  : Joins the queues of different handlers together
  INPUTS       : 1-2) The tops and bottoms of the four handler type lists:
                      around, before, primary and after
                 3) The message name symbol
  RETURNS      : The top of the joined lists, NULL on errors
  SIDE EFFECTS : Links all the handler type lists together, or all the
                   lists are destroyed if there are no primary handlers
  NOTES        : None
 *************************************************************************/
globle HANDLER_LINK *JoinHandlerLinks(tops,bots,mname)
  HANDLER_LINK *tops[4],*bots[4];
  SYMBOL_HN *mname;
  {
   register int i;
   HANDLER_LINK *mlink;
   
   if (tops[MPRIMARY] == NULL)
    {
     PrintNoHandlerError(ValueToString(mname));
     for (i = MAROUND ; i <= MAFTER ; i++)
       DestroyHandlerLinks(tops[i]);
     SetEvaluationError(CLIPS_TRUE);
     return(NULL);
    }
   
   mlink = tops[MPRIMARY];
   
#if AUXILIARY_MESSAGE_HANDLERS
   if (tops[MBEFORE] != NULL)
     {
      bots[MBEFORE]->nxt = mlink;
      mlink = tops[MBEFORE];
     }
#endif

#if IMPERATIVE_MESSAGE_HANDLERS
   if (tops[MAROUND] != NULL)
     {
      bots[MAROUND]->nxt = mlink;
      mlink = tops[MAROUND];
     }
#endif

#if AUXILIARY_MESSAGE_HANDLERS
   bots[MPRIMARY]->nxt = tops[MAFTER];
#endif

   return(mlink);
  }
  
/***************************************************
  NAME         : PrintHandlerSlotGetFunction
  DESCRIPTION  : Developer access function for
                 printing direct slot references
                 in message-handlers
  INPUTS       : 1) The logical name of the output
                 2) The bitmap expression
  RETURNS      : Nothing useful
  SIDE EFFECTS : Expression printed
  NOTES        : None
 ***************************************************/
#if IBM_TBC && (! DEVELOPER)
#pragma argsused
#endif
globle VOID PrintHandlerSlotGetFunction(logicalName,theValue)
  char *logicalName;
  VOID *theValue;
  {
#if DEVELOPER
   HANDLER_SLOT_REFERENCE *theReference;
   DEFCLASS *theDefclass;
   SLOT_DESC *sd;
   
   theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
   PrintCLIPS(logicalName,"?self:[");
   theDefclass = ClassIDMap[theReference->classID];
   PrintCLIPS(logicalName,ValueToString(theDefclass->header.name));
   PrintCLIPS(logicalName,"]");
   sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[theReference->slotID]];
   PrintCLIPS(logicalName,ValueToString(sd->slotName->name));
#else
#if MAC_MPW || MAC_MCW
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif   
  }
  
/***************************************************
  NAME         : HandlerSlotGetFunction
  DESCRIPTION  : Access function for handling the
                 statically-bound direct slot
                 references in message-handlers
  INPUTS       : 1) The bitmap expression
                 2) A data object buffer
  RETURNS      : CLIPS_TRUE if OK, CLIPS_FALSE
                 on errors
  SIDE EFFECTS : Data object buffer gets value of
                 slot. On errors, buffer gets
                 symbol FALSE, EvaluationError
                 is set and error messages are
                 printed
  NOTES        : It is possible for a handler
                 (attached to a superclass of
                  the currently active instance)
                 containing these static references
                 to be called for an instance
                 which does not contain the slots
                 (e.g., an instance of a subclass
                  where the original slot was
                  no-inherit or the subclass
                  overrode the original slot)
 ***************************************************/
globle BOOLEAN HandlerSlotGetFunction(theValue,theResult)
  VOID *theValue;
  DATA_OBJECT *theResult;
  {
   HANDLER_SLOT_REFERENCE *theReference;
   DEFCLASS *theDefclass;
   INSTANCE_TYPE *theInstance;
   INSTANCE_SLOT *sp;
   unsigned instanceSlotIndex;
   
   theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
   theInstance = (INSTANCE_TYPE *) ProcParamArray[0].value;
   theDefclass = ClassIDMap[theReference->classID];
   if (theInstance->garbage)
     {
      StaleInstanceAddress("for slot get");
      theResult->type = SYMBOL;
      theResult->value = CLIPSFalseSymbol;
      SetEvaluationError(CLIPS_TRUE);
      return(CLIPS_FALSE);
     }

   if (theInstance->cls == theDefclass)
     {
      instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
      sp = theInstance->slotAddresses[instanceSlotIndex - 1];
     }
   else
     {
      if (theReference->slotID > theInstance->cls->maxSlotNameID)
        goto HandlerGetError;
      instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
      if (instanceSlotIndex == 0)
        goto HandlerGetError;
      instanceSlotIndex--;
      sp = theInstance->slotAddresses[instanceSlotIndex];
      if (sp->desc->cls != theDefclass)
        goto HandlerGetError;
     }
   theResult->type = sp->type;
   theResult->value = sp->value;
   if (sp->type == MULTIFIELD)
     {
      theResult->begin = 0;
      theResult->end = GetInstanceSlotLength(sp) - 1;
     }
   return(CLIPS_TRUE);
   
HandlerGetError:
   EarlySlotBindError(theInstance,theDefclass,theReference->slotID);
   theResult->type = SYMBOL;
   theResult->value = CLIPSFalseSymbol;
   SetEvaluationError(CLIPS_TRUE);
   return(CLIPS_FALSE);
  }
  
/***************************************************
  NAME         : PrintHandlerSlotPutFunction
  DESCRIPTION  : Developer access function for
                 printing direct slot bindings
                 in message-handlers
  INPUTS       : 1) The logical name of the output
                 2) The bitmap expression
  RETURNS      : Nothing useful
  SIDE EFFECTS : Expression printed
  NOTES        : None
 ***************************************************/
#if IBM_TBC && (! DEVELOPER)
#pragma argsused
#endif
globle VOID PrintHandlerSlotPutFunction(logicalName,theValue)
  char *logicalName;
  VOID *theValue;
  {
#if DEVELOPER
   HANDLER_SLOT_REFERENCE *theReference;
   DEFCLASS *theDefclass;
   SLOT_DESC *sd;
   
   theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
   PrintCLIPS(logicalName,"(bind ?self:[");
   theDefclass = ClassIDMap[theReference->classID];
   PrintCLIPS(logicalName,ValueToString(theDefclass->header.name));
   PrintCLIPS(logicalName,"]");
   sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[theReference->slotID]];
   PrintCLIPS(logicalName,ValueToString(sd->slotName->name));
   if (GetFirstArgument() != NULL)
     {
      PrintCLIPS(logicalName," ");
      PrintExpression(logicalName,GetFirstArgument());
     }
   PrintCLIPS(logicalName,")");
#else
#if MAC_MPW || MAC_MCW
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif   
  }
  
/***************************************************
  NAME         : HandlerSlotPutFunction
  DESCRIPTION  : Access function for handling the
                 statically-bound direct slot
                 bindings in message-handlers
  INPUTS       : 1) The bitmap expression
                 2) A data object buffer
  RETURNS      : CLIPS_TRUE if OK, CLIPS_FALSE
                 on errors
  SIDE EFFECTS : Data object buffer gets symbol
                 TRUE and slot is set. On errors,
                 buffer gets symbol FALSE,
                 EvaluationError is set and error
                 messages are printed
  NOTES        : It is possible for a handler
                 (attached to a superclass of
                  the currently active instance)
                 containing these static references
                 to be called for an instance
                 which does not contain the slots
                 (e.g., an instance of a subclass
                  where the original slot was
                  no-inherit or the subclass
                  overrode the original slot)
 ***************************************************/
globle BOOLEAN HandlerSlotPutFunction(theValue,theResult)
  VOID *theValue;
  DATA_OBJECT *theResult;
  {
   HANDLER_SLOT_REFERENCE *theReference;
   DEFCLASS *theDefclass;
   INSTANCE_TYPE *theInstance;
   INSTANCE_SLOT *sp;
   unsigned instanceSlotIndex;
   DATA_OBJECT theSetVal;
   
   theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
   theInstance = (INSTANCE_TYPE *) ProcParamArray[0].value;
   theDefclass = ClassIDMap[theReference->classID];
   if (theInstance->garbage)
     {
      StaleInstanceAddress("for slot put");
      theResult->type = SYMBOL;
      theResult->value = CLIPSFalseSymbol;
      SetEvaluationError(CLIPS_TRUE);
      return(CLIPS_FALSE);
     }

   if (theInstance->cls == theDefclass)
     {
      instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
      sp = theInstance->slotAddresses[instanceSlotIndex - 1];
     }
   else
     {
      if (theReference->slotID > theInstance->cls->maxSlotNameID)
        goto HandlerPutError;
      instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
      if (instanceSlotIndex == 0)
        goto HandlerPutError;
      instanceSlotIndex--;
      sp = theInstance->slotAddresses[instanceSlotIndex];
      if (sp->desc->cls != theDefclass)
        goto HandlerPutError;
     }
     
   /* =======================================================
      The slot has already been verified not to be read-only.
      However, if it is initialize-only, we need to make sure
      that we are initializing the instance (something we
      could not verify at parse-time)
      ======================================================= */
   if (sp->desc->initializeOnly && (WithinInit == CLIPS_FALSE))
     {
      SlotAccessViolationError(ValueToString(sp->desc->slotName->name),
                               CLIPS_TRUE,(VOID *) theInstance);
      goto HandlerPutError2;
     }
     
   /* ======================================
      No arguments means to use the
      special NoParamValue to reset the slot
      to its default value
      ====================================== */
   if (GetFirstArgument())
     {
      if (EvaluateAndStoreInDataObject((int) sp->desc->multiple,
                                       GetFirstArgument(),&theSetVal) == CLIPS_FALSE)
         goto HandlerPutError2;
     }
   else
     {
      SetDOBegin(theSetVal,1);
      SetDOEnd(theSetVal,0);
      SetType(theSetVal,MULTIFIELD);
      SetValue(theSetVal,NoParamValue);
     }
   if (PutSlotValue(theInstance,sp,&theSetVal,theResult,NULL) == CLIPS_FALSE)
      goto HandlerPutError2;
   return(CLIPS_TRUE);
   
HandlerPutError:
   EarlySlotBindError(theInstance,theDefclass,theReference->slotID);

HandlerPutError2:
   theResult->type = SYMBOL;
   theResult->value = CLIPSFalseSymbol;
   SetEvaluationError(CLIPS_TRUE);
   return(CLIPS_FALSE);
  }

/*****************************************************
  NAME         : DynamicHandlerGetSlot
  DESCRIPTION  : Directly references a slot's value
                 (uses dynamic binding to lookup slot)
  INPUTS       : The caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Caller's result buffer set
  NOTES        : CLIPS Syntax: (get <slot>)
 *****************************************************/
globle VOID DynamicHandlerGetSlot(result)
  DATA_OBJECT *result;
  {
   INSTANCE_SLOT *sp;
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;
   
   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   if (CheckCurrentMessage("dynamic-get",CLIPS_TRUE) == CLIPS_FALSE)
     return;
   EvaluateExpression(GetFirstArgument(),&temp);
   if (temp.type != SYMBOL)
     {
      ExpectedTypeError1("dynamic-get",1,"symbol");
      SetEvaluationError(CLIPS_TRUE);
      return;
     }
   ins = GetActiveInstance();
   sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
   if (sp == NULL)
     {
      SlotExistError(ValueToString(temp.value),"dynamic-get");
      return;
     }
   if ((sp->desc->publicVisibility == 0) &&
       (CurrentCore->hnd->cls != sp->desc->cls))
     {
      SlotVisibilityViolationError(sp->desc,CurrentCore->hnd->cls);
      SetEvaluationError(CLIPS_TRUE);
      return;
     }
   result->type = sp->type;
   result->value = sp->value;
   if (sp->type == MULTIFIELD)
     {
      result->begin = 0;
      result->end = GetInstanceSlotLength(sp) - 1;
     }
  }
  
/***********************************************************
  NAME         : DynamicHandlerPutSlot
  DESCRIPTION  : Directly puts a slot's value
                 (uses dynamic binding to lookup slot)
  INPUTS       : Data obejct buffer for holding slot value
  RETURNS      : Nothing useful
  SIDE EFFECTS : Slot modified - and caller's buffer set
                 to value (or symbol FALSE on errors)
  NOTES        : CLIPS Syntax: (put <slot> <value>*)
 ***********************************************************/
globle VOID DynamicHandlerPutSlot(theResult)
  DATA_OBJECT *theResult;
  {
   INSTANCE_SLOT *sp;
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;
   
   theResult->type = SYMBOL;
   theResult->value = CLIPSFalseSymbol;
   if (CheckCurrentMessage("dynamic-put",CLIPS_TRUE) == CLIPS_FALSE)
     return;
   EvaluateExpression(GetFirstArgument(),&temp);
   if (temp.type != SYMBOL)
     {
      ExpectedTypeError1("dynamic-put",1,"symbol");
      SetEvaluationError(CLIPS_TRUE);