msgfun.c

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

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*               CLIPS Version 6.05  04/09/97          */
   /*                                                     */
   /*                  OBJECT MESSAGE FUNCTIONS           */
   /*******************************************************/

/*************************************************************/
/* Purpose:                                                  */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/
   
/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if OBJECT_SYSTEM

#include "classcom.h"
#include "classfun.h"
#include "clipsmem.h"
#include "extnfunc.h"
#include "insfun.h"
#include "prccode.h"
#include "router.h"

#define _MSGFUN_SOURCE_
#include "msgfun.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */

/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */
#if ANSI_COMPILER

#if DEBUGGING_FUNCTIONS
static HANDLER_LINK *DisplayPrimaryCore(char *,HANDLER_LINK *,int);
static VOID PrintPreviewHandler(char *,HANDLER_LINK *,int,char *);
#endif

#else

#if DEBUGGING_FUNCTIONS
static HANDLER_LINK *DisplayPrimaryCore();
static VOID PrintPreviewHandler();
#endif

#endif
      
/* =========================================
   *****************************************
      EXTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
globle SYMBOL_HN *INIT_SYMBOL = NULL,
globle           *DELETE_SYMBOL = NULL;

#if IBM_TBC
#pragma warn -ias
#endif
globle char *hndquals[] = {"around","before","primary","after"};
#if IBM_TBC
#pragma warn +ias
#endif

#if DEBUGGING_FUNCTIONS
globle int WatchHandlers = OFF;
globle int WatchMessages = OFF;
#endif

/* =========================================
   *****************************************
      INTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */
   
/********************************************************
  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()
  {
   PrintCLIPS(WERROR,"message-handler ");
   PrintHandler(WERROR,CurrentCore->hnd,CLIPS_TRUE);
  }
  
/*****************************************************************
  NAME         : PrintNoHandlerError
  DESCRIPTION  : Print "No primaries found" error message for send
  INPUTS       : The name of the message
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 *****************************************************************/
globle VOID PrintNoHandlerError(msg)
  char *msg;
  {
   PrintErrorID("MSGFUN",1,CLIPS_FALSE);
   PrintCLIPS(WERROR,"No applicable primary message-handlers found for ");
   PrintCLIPS(WERROR,msg);
   PrintCLIPS(WERROR,".\n");
  }

/***************************************************************
  NAME         : CheckHandlerArgCount
  DESCRIPTION  : Verifies that the current argument
                   list satisfies the current
                   handler's parameter count restriction
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if all OK, CLIPS_FALSE otherwise
  SIDE EFFECTS : EvaluationError set on errors
  NOTES        : Uses ProcParamArraySize and CurrentCore globals
 ***************************************************************/
globle int CheckHandlerArgCount()
  {
   HANDLER *hnd;
   
   hnd = CurrentCore->hnd;
   if ((hnd->maxParams == -1) ? (ProcParamArraySize < hnd->minParams) :
       (ProcParamArraySize != hnd->minParams))
     {
      SetEvaluationError(CLIPS_TRUE);
      PrintErrorID("MSGFUN",2,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Message-handler ");
      PrintCLIPS(WERROR,ValueToString(hnd->name));
      PrintCLIPS(WERROR," ");
      PrintCLIPS(WERROR,hndquals[hnd->type]);
      PrintCLIPS(WERROR," in class ");
      PrintCLIPS(WERROR,GetDefclassName((VOID *) hnd->cls));
      PrintCLIPS(WERROR," expected ");
      PrintCLIPS(WERROR,(hnd->maxParams == -1) ? "at least " : "exactly ");
      PrintLongInteger(WERROR,(long) (hnd->minParams-1));
      PrintCLIPS(WERROR," argument(s).\n");
      return(CLIPS_FALSE);
     }
   return(CLIPS_TRUE);
  }

/***************************************************
  NAME         : SlotAccessViolationError
  DESCRIPTION  : Prints out an error message when
                 attempt is made to set a read-only
                 or initialize-only slot improperly
  INPUTS       : 1) The slot name
                 2) A flag indicating if the source
                    is a class or an instance
                 3) A pointer to the source
                    instance/class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Error message printed
  NOTES        : None
 ***************************************************/
globle VOID SlotAccessViolationError(slotName,instanceFlag,theInstanceOrClass)
  char *slotName;
  BOOLEAN instanceFlag;
  VOID *theInstanceOrClass;
  {
   PrintErrorID("MSGFUN",3,CLIPS_FALSE);
   PrintCLIPS(WERROR,slotName);
   PrintCLIPS(WERROR," slot in ");
   if (instanceFlag)
     PrintInstanceNameAndClass(WERROR,(INSTANCE_TYPE *) theInstanceOrClass,CLIPS_FALSE);
   else
     {
      PrintCLIPS(WERROR,"class ");
      PrintClassName(WERROR,(DEFCLASS *) theInstanceOrClass,CLIPS_FALSE);
     }
   PrintCLIPS(WERROR,": write access denied.\n");
  }
  
/***************************************************
  NAME         : SlotVisibilityViolationError
  DESCRIPTION  : Prints out an error message when
                 attempt is made to access a
                 private slot improperly
  INPUTS       : 1) The slot descriptor
                 2) A pointer to the source class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Error message printed
  NOTES        : None
 ***************************************************/
globle VOID SlotVisibilityViolationError(sd,theDefclass)
  SLOT_DESC *sd;
  DEFCLASS *theDefclass;
  {
   PrintErrorID("MSGFUN",6,CLIPS_FALSE);
   PrintCLIPS(WERROR,"Private slot ");
   PrintCLIPS(WERROR,ValueToString(sd->slotName->name));
   PrintCLIPS(WERROR," of class ");
   PrintClassName(WERROR,sd->cls,CLIPS_FALSE);
   PrintCLIPS(WERROR," cannot be accessed directly\n   by handlers attached to class ");
   PrintClassName(WERROR,theDefclass,CLIPS_TRUE);
  }
  
#if ! RUN_TIME

/******************************************************************************
  NAME         : NewSystemHandler
  DESCRIPTION  : Adds a new system handler for a system class
  
                 The handler is assumed to be primary and of
                 the form:
                 
                 (defmessage-handler <class> <handler> () (<func>))
                                  
  INPUTS       : 1) Name-string of the system class
                 2) Name-string of the system handler
                 3) Name-string of the internal CLIPS function to implement
                      this handler
                 4) The number of extra arguments (past the instance itself)
                    that the handler willl accept
  RETURNS      : Nothing useful
  SIDE EFFECTS : Creates the new handler and inserts it in the system class's
                   handler array
                 On errors, generate a system error and exits.
  NOTES        : Does not check to see if handler already exists
 *******************************************************************************/
globle VOID NewSystemHandler(cname,mname,fname,extraargs)
  char *cname,*mname,*fname;
  int extraargs;
  {
   DEFCLASS *cls;
   HANDLER *hnd;
   
   cls = LookupDefclassInScope(cname);
   hnd = InsertHandlerHeader(cls,(SYMBOL_HN *) AddSymbol(mname),MPRIMARY);
   IncrementSymbolCount(hnd->name);
   hnd->system = 1;
   hnd->minParams = hnd->maxParams = extraargs + 1;
   hnd->localVarCount = 0;
   hnd->actions = get_struct(expr);
   hnd->actions->argList = NULL;
   hnd->actions->type = FCALL;
   hnd->actions->value = (VOID *) FindFunction(fname);
   hnd->actions->nextArg = NULL;
  }
  
/***************************************************
  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(cls,mname,mtype)
  DEFCLASS *cls;
  SYMBOL_HN *mname;
  int mtype;
  {
   HANDLER *nhnd,*hnd;
   unsigned *narr,*arr;
   register int i,j,ni = -1;
   
   hnd = cls->handlers;
   arr = cls->handlerOrderMap;
   nhnd = (HANDLER *) gm2((int) (sizeof(HANDLER) * (cls->handlerCount+1)));
   narr = (unsigned *) gm2((int) (sizeof(unsigned) * (cls->handlerCount+1)));
   CopyMemory(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) ? CLIPS_TRUE :
             (hnd[arr[i]].name == mname))
           {
            ni = i;
            j++;
           }
        }
      narr[j] = arr[i];
     }
   if (ni == -1)
     ni = 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 = 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;
   if (cls->handlerCount != 0)
     {
      rm((VOID *) hnd,(int) (sizeof(HANDLER) * cls->handlerCount));
      rm((VOID *) arr,(int) (sizeof(unsigned) * cls->handlerCount));
     }
   cls->handlers = nhnd;
   cls->handlerOrderMap = narr;
   cls->handlerCount++;
   return(&nhnd[cls->handlerCount-1]);
  }
  
#endif

#if (! BLOAD_ONLY) && (! RUN_TIME)

/*****************************************************
  NAME         : HandlersExecuting
  DESCRIPTION  : Determines if any message-handlers
                   for a class are currently executing
  INPUTS       : The class address
  RETURNS      : CLIPS_TRUE if any handlers are executing,