classfun.c

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

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*             CLIPS Version 6.05  04/09/97            */
   /*                                                     */
   /*                CLASS FUNCTIONS MODULE               */
   /*******************************************************/

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

#if OBJECT_SYSTEM

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
#include "bload.h"
#endif

#include "classcom.h"
#include "classini.h"
#include "clipsmem.h"
#include "constant.h"
#include "constrct.h"
#include "cstrccom.h"
#include "cstrcpsr.h"
#include "evaluatn.h"
#include "inscom.h"
#include "insfun.h"
#include "insmngr.h"
#include "modulutl.h"
#include "msgfun.h"
#include "router.h"
#include "scanner.h"
#include "utility.h"

#define _CLASSFUN_SOURCE_
#include "classfun.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */
#define BIG_PRIME          11329

#define CLASS_ID_MAP_CHUNK 30

#define PUT_PREFIX         "put-"
#define PUT_PREFIX_LENGTH  4

/* =========================================
   *****************************************
               MACROS AND TYPES
   =========================================
   ***************************************** */

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

static unsigned HashSlotName(SYMBOL_HN *);

#if (! RUN_TIME)
static unsigned NewSlotNameID(void);
static VOID DeassignClassID(unsigned);
#endif

#else

static unsigned HashSlotName();

#if (! RUN_TIME)
static unsigned NewSlotNameID();
static VOID DeassignClassID();
#endif

#endif

/* =========================================
   *****************************************
      EXTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
globle DEFCLASS **ClassIDMap = NULL;
globle DEFCLASS **ClassTable = NULL;
globle unsigned short MaxClassID = 0;
globle SLOT_NAME **SlotNameTable = NULL;
globle SYMBOL_HN *ISA_SYMBOL,
globle           *NAME_SYMBOL;

#if INSTANCE_PATTERN_MATCHING
globle SYMBOL_HN *INITIAL_OBJECT_SYMBOL;
#endif

#if DEBUGGING_FUNCTIONS
globle int WatchInstances = OFF,
globle     WatchSlots = OFF;
#endif

#if IBM_TBC
#pragma warn -ias
#endif
globle DEFCLASS *PrimitiveClassMap[] = { NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL };
#if IBM_TBC
#pragma warn +ias
#endif

/* =========================================
   *****************************************
      INTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
static unsigned char CTID = 0;

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/***************************************************
  NAME         : IncrementDefclassBusyCount
  DESCRIPTION  : Increments use count of defclass
  INPUTS       : The class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Busy count incremented
  NOTES        : None
 ***************************************************/
globle VOID IncrementDefclassBusyCount(theDefclass)
  VOID *theDefclass;
  {
   ((DEFCLASS *) theDefclass)->busy++;
  }
  
/***************************************************
  NAME         : DecrementDefclassBusyCount
  DESCRIPTION  : Decrements use count of defclass
  INPUTS       : The class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Busy count decremented
  NOTES        : Since use counts are ignored on
                 a clear and defclasses might be
                 deleted already anyway, this is
                 a no-op on a clear
 ***************************************************/
globle VOID DecrementDefclassBusyCount(theDefclass)
  VOID *theDefclass;
  {
   if (! ClearInProgress)
     ((DEFCLASS *) theDefclass)->busy--;
  }
  
/****************************************************
  NAME         : InstancesPurge
  DESCRIPTION  : Removes all instances
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if all instances deleted,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : The instance hash table is cleared
  NOTES        : None
 ****************************************************/
globle BOOLEAN InstancesPurge()
  {
   int svdepth;

   DestroyAllInstances();
   svdepth = CurrentEvaluationDepth;
   if (CurrentEvaluationDepth == 0)
     CurrentEvaluationDepth = -1;
   CleanupInstances();
   CurrentEvaluationDepth = svdepth;
   return((InstanceList != NULL) ? CLIPS_FALSE : CLIPS_TRUE);
  }

#if ! RUN_TIME

/***************************************************
  NAME         : InitializeClasses
  DESCRIPTION  : Allocates class hash table
                 Initializes class hash table
                   to all NULL addresses
                 Creates system classes
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Hash table initialized
  NOTES        : None
 ***************************************************/
globle VOID InitializeClasses()
  {
   register int i;
   
   ClassTable = 
      (DEFCLASS **) gm2((int) (sizeof(DEFCLASS *) * CLASS_TABLE_HASH_SIZE));
   for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++)
     ClassTable[i] = NULL;
   SlotNameTable = 
      (SLOT_NAME **) gm2((int) (sizeof(SLOT_NAME *) * SLOT_NAME_TABLE_HASH_SIZE));
   for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++)
     SlotNameTable[i] = NULL;
  }

#endif

/********************************************************
  NAME         : FindClassSlot
  DESCRIPTION  : Searches for a named slot in a class
  INPUTS       : 1) The class address
                 2) The symbolic slot name
  RETURNS      : Address of slot if found, NULL otherwise
  SIDE EFFECTS : None
  NOTES        : Only looks in class defn, does not
                   examine inheritance paths
 ********************************************************/
globle SLOT_DESC *FindClassSlot(cls,sname)
  DEFCLASS *cls;
  SYMBOL_HN *sname;
  {
   register int i;
   
   for (i = 0 ; i < cls->slotCount ; i++)
     {
      if (cls->slots[i].slotName->name == sname)
        return(&cls->slots[i]);
     }
   return(NULL);
  }

/***************************************************************
  NAME         : ClassExistError
  DESCRIPTION  : Prints out error message for non-existent class
  INPUTS       : 1) Name of function having the error
                 2) The name of the non-existent class
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************************/
globle VOID ClassExistError(func,cname)
  char *func,*cname;
  {
   PrintErrorID("CLASSFUN",1,CLIPS_FALSE);
   PrintCLIPS(WERROR,"Unable to find class ");
   PrintCLIPS(WERROR,cname);
   PrintCLIPS(WERROR," in function ");
   PrintCLIPS(WERROR,func);
   PrintCLIPS(WERROR,".\n");
   SetEvaluationError(CLIPS_TRUE);
  }
  
/*********************************************
  NAME         : DeleteClassLinks
  DESCRIPTION  : Deallocates a class link list
  INPUTS       : The address of the list
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 *********************************************/
globle VOID DeleteClassLinks(clink)
  CLASS_LINK *clink;
  {
   CLASS_LINK *ctmp;

   for (ctmp = clink ; ctmp != NULL ; ctmp = clink)
     {
      clink = clink->nxt;
      rtn_struct(classLink,ctmp);
     }
  }
  
/******************************************************
  NAME         : PrintClassName
  DESCRIPTION  : Displays a class's name
  INPUTS       : 1) Logical name of output
                 2) The class
                 3) Flag indicating whether to
                    print carriage-return at end
  RETURNS      : Nothing useful
  SIDE EFFECTS : Class name printed (and module name
                 too if class is not in current module)
  NOTES        : None
 ******************************************************/
globle VOID PrintClassName(logicalName,theDefclass,linefeedFlag)
  char *logicalName;
  DEFCLASS *theDefclass;
  BOOLEAN linefeedFlag;
  {
   if ((theDefclass->header.whichModule->theModule != ((struct defmodule *) GetCurrentModule())) &&
       (theDefclass->system == 0))
     {
      PrintCLIPS(logicalName,
                 GetDefmoduleName(theDefclass->header.whichModule->theModule));
      PrintCLIPS(logicalName,"::");
     }
   PrintCLIPS(logicalName,ValueToString(theDefclass->header.name));
   if (linefeedFlag)
     PrintCLIPS(logicalName,"\n");
  }

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

/***************************************************
  NAME         : PrintPackedClassLinks
  DESCRIPTION  : Displays the names of classes in
                 a list with a title
  INPUTS       : 1) The logical name of the output
                 2) Title string
                 3) List of class links
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle VOID PrintPackedClassLinks(logicalName,title,plinks)
  char *logicalName,*title;
  PACKED_CLASS_LINKS *plinks;
  {
   register unsigned i;
   
   PrintCLIPS(logicalName,title);
   for (i = 0 ; i < plinks->classCount ; i++)
     {
      PrintCLIPS(logicalName," ");
      PrintClassName(logicalName,plinks->classArray[i],CLIPS_FALSE);
     }
   PrintCLIPS(logicalName,"\n");
  }

#endif

#if ! RUN_TIME

/*******************************************************
  NAME         : PutClassInTable
  DESCRIPTION  : Inserts a class in the class hash table
  INPUTS       : The class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Class inserted
  NOTES        : None
 *******************************************************/
globle VOID PutClassInTable(cls)
  DEFCLASS *cls;
  {
   cls->hashTableIndex = HashClass(GetDefclassNamePointer((VOID *) cls));
   cls->nxtHash = ClassTable[cls->hashTableIndex];
   ClassTable[cls->hashTableIndex] = cls;
  }
  
/*********************************************************
  NAME         : RemoveClassFromTable
  DESCRIPTION  : Removes a class from the class hash table
  INPUTS       : The class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Class removed
  NOTES        : None
 *********************************************************/
globle VOID RemoveClassFromTable(cls)
  DEFCLASS *cls;
  {
   DEFCLASS *prvhsh,*hshptr;
   
   prvhsh = NULL;
   hshptr = ClassTable[cls->hashTableIndex];
   while (hshptr != cls)
     {
      prvhsh = hshptr;
      hshptr = hshptr->nxtHash;
     }
   if (prvhsh == NULL)
     ClassTable[cls->hashTableIndex] = cls->nxtHash;
   else
     prvhsh->nxtHash = cls->nxtHash;
  }
  
/***************************************************
  NAME         : AddClassLink
  DESCRIPTION  : Adds a class link from one class to
                  another
  INPUTS       : 1) The packed links in which to
                    insert the new class
                 2) The subclass pointer
                 3) Index of where to place the
                    class (-1 to append)
  RETURNS      : Nothing useful
  SIDE EFFECTS : Link created and attached
  NOTES        : Assumes the pack structure belongs
                 to a class and does not need to