genrcfun.c

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

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

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

#if DEFGENERIC_CONSTRUCT

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

#if OBJECT_SYSTEM
#include "classcom.h"
#include "classfun.h"
#endif

#include "argacces.h"
#include "clipsmem.h"
#include "constrct.h"
#include "cstrcpsr.h"
#include "genrccom.h"
#include "genrcexe.h"
#include "prccode.h"
#include "router.h"

#define _GENRCFUN_SOURCE_
#include "genrcfun.h"

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

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

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

#if DEBUGGING_FUNCTIONS
static VOID DisplayGenericCore(DEFGENERIC *);
#endif

#else

#if DEBUGGING_FUNCTIONS
static VOID DisplayGenericCore();
#endif

#endif
      

/* =========================================
   *****************************************
      EXTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
globle DEFGENERIC *CurrentGeneric = NULL;
globle DEFMETHOD *CurrentMethod = NULL;
globle DATA_OBJECT *GenericCurrentArgument = NULL;

#if DEBUGGING_FUNCTIONS
globle int WatchGenerics = OFF;
globle int WatchMethods = OFF;
#endif

#if (! RUN_TIME) && (! BLOAD_ONLY)
globle int OldGenericBusySave;
#endif

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

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */
  
#if ! RUN_TIME

/***************************************************
  NAME         : ClearDefgenericsReady
  DESCRIPTION  : Determines if it is safe to
                 remove all defgenerics
                 Assumes *all* constructs will be
                 deleted - only checks to see if
                 any methods are currently
                 executing
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if no methods are
                 executing, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : Used by (clear) and (bload)
 ***************************************************/
globle BOOLEAN ClearDefgenericsReady()
  {
   return((CurrentGeneric != NULL) ? CLIPS_FALSE : CLIPS_TRUE);
  }

/*****************************************************
  NAME         : AllocateDefgenericModule
  DESCRIPTION  : Creates and initializes a
                 list of defgenerics for a new module
  INPUTS       : None
  RETURNS      : The new deffunction module
  SIDE EFFECTS : Deffunction module created
  NOTES        : None
 *****************************************************/
globle VOID *AllocateDefgenericModule()
  {
   return((VOID *) get_struct(defgenericModule));
  } 

/***************************************************
  NAME         : FreeDefgenericModule
  DESCRIPTION  : Removes a deffunction module and
                 all associated deffunctions
  INPUTS       : The deffunction module
  RETURNS      : Nothing useful
  SIDE EFFECTS : Module and deffunctions deleted
  NOTES        : None
 ***************************************************/
globle VOID FreeDefgenericModule(theItem)
  VOID *theItem;
  {
#if (! BLOAD_ONLY)
   FreeConstructHeaderModule((struct defmoduleItemHeader *) theItem,DefgenericConstruct);
#endif
   rtn_struct(defgenericModule,theItem);
  } 

#endif

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

/************************************************************
  NAME         : ClearDefmethods
  DESCRIPTION  : Deletes all defmethods - generic headers
                   are left intact
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if all methods deleted, CLIPS_FALSE otherwise
  SIDE EFFECTS : Defmethods deleted
  NOTES        : Clearing generic functions is done in
                   two stages
                   
                 1) Delete all methods (to clear any
                    references to other constructs)
                 2) Delete all generic headers
                 
                 This allows other constructs which
                   mutually refer to generic functions
                   to be cleared
 ************************************************************/
globle int ClearDefmethods()
  {
   register DEFGENERIC *gfunc;
   int success = CLIPS_TRUE;
   
#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded() == CLIPS_TRUE) return(CLIPS_FALSE);
#endif

   gfunc = (DEFGENERIC *) GetNextDefgeneric(NULL);
   while (gfunc != NULL)
     {
      if (RemoveAllExplicitMethods(gfunc) == CLIPS_FALSE)
        success = CLIPS_FALSE;
      gfunc = (DEFGENERIC *) GetNextDefgeneric((VOID *) gfunc);
     }
   return(success);
  }

/*****************************************************************
  NAME         : RemoveAllExplicitMethods
  DESCRIPTION  : Deletes all explicit defmethods - generic headers
                   are left intact (as well as a method for an
                   overloaded system function)
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if all methods deleted, CLIPS_FALSE otherwise
  SIDE EFFECTS : Explicit defmethods deleted
  NOTES        : None
 *****************************************************************/
globle int RemoveAllExplicitMethods(gfunc)
  DEFGENERIC *gfunc;
  {
   register int i,j;
   unsigned systemMethodCount = 0;
   DEFMETHOD *narr;
   
   if (MethodsExecuting(gfunc) == CLIPS_FALSE)
     {
      for (i = 0 ; i < gfunc->mcnt ; i++)
        {
         if (gfunc->methods[i].system)
           systemMethodCount++;
         else
           DeleteMethodInfo(gfunc,&gfunc->methods[i]);
        }
      if (systemMethodCount != 0)
        {
         narr = (DEFMETHOD *) gm2((int) (systemMethodCount * sizeof(DEFMETHOD)));
         i = 0;
         j = 0;
         while (i < gfunc->mcnt)
           {
            if (gfunc->methods[i].system)
              CopyMemory(DEFMETHOD,1,&narr[j++],&gfunc->methods[i]);
            i++;
           }
         rm((VOID *) gfunc->methods,(int) (sizeof(DEFMETHOD) * gfunc->mcnt));
         gfunc->mcnt = systemMethodCount;
         gfunc->methods = narr;
        }
      else
        {
         if (gfunc->mcnt != 0)
           rm((VOID *) gfunc->methods,(int) (sizeof(DEFMETHOD) * gfunc->mcnt));
         gfunc->mcnt = 0;
         gfunc->methods = NULL;
        }
      return(CLIPS_TRUE);
     }
   return(CLIPS_FALSE);
  }
  
/**************************************************
  NAME         : RemoveDefgeneric
  DESCRIPTION  : Removes a generic function node
                   from the generic list along with
                   all its methods
  INPUTS       : The generic function
  RETURNS      : Nothing useful
  SIDE EFFECTS : List adjusted
                 Nodes deallocated
  NOTES        : Assumes generic is not in use!!!
 **************************************************/
globle VOID RemoveDefgeneric(vgfunc)
  VOID *vgfunc;
  {
   DEFGENERIC *gfunc = (DEFGENERIC *) vgfunc;
   register int i;
   
   for (i = 0 ; i < gfunc->mcnt ; i++)
     DeleteMethodInfo(gfunc,&gfunc->methods[i]);
   
   if (gfunc->mcnt != 0)
     rm((VOID *) gfunc->methods,(int) (sizeof(DEFMETHOD) * gfunc->mcnt));
   DecrementSymbolCount(GetDefgenericNamePointer((VOID *) gfunc));
   SetDefgenericPPForm((VOID *) gfunc,NULL);
   rtn_struct(defgeneric,gfunc);
  }
  
/****************************************************************
  NAME         : ClearDefgenerics
  DESCRIPTION  : Deletes all generic headers
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if all methods deleted, CLIPS_FALSE otherwise
  SIDE EFFECTS : Generic headers deleted (and any implicit system
                  function methods)
  NOTES        : None
 ****************************************************************/
globle int ClearDefgenerics()
  {
   register DEFGENERIC *gfunc,*gtmp;
   int success = CLIPS_TRUE;
   
#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded() == CLIPS_TRUE) return(CLIPS_FALSE);
#endif

   gfunc = (DEFGENERIC *) GetNextDefgeneric(NULL);
   while (gfunc != NULL)
     {
      gtmp = gfunc;
      gfunc = (DEFGENERIC *) GetNextDefgeneric((VOID *) gfunc);
      if (RemoveAllExplicitMethods(gtmp) == CLIPS_FALSE)
        {
         CantDeleteItemErrorMessage("generic function",GetDefgenericName(gtmp));
         success = CLIPS_FALSE;
        }
      else
        {
         RemoveConstructFromModule((struct constructHeader *) gtmp);
         RemoveDefgeneric((VOID *) gtmp);
        }
     }
   return(success);
  }
  
/********************************************************
  NAME         : MethodAlterError
  DESCRIPTION  : Prints out an error message reflecting
                   that a generic function's methods
                   cannot be altered while any of them
                   are executing
  INPUTS       : The generic function
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ********************************************************/
globle VOID MethodAlterError(gfunc)
  DEFGENERIC *gfunc;
  {
   PrintErrorID("GENRCFUN",1,CLIPS_FALSE);
   PrintCLIPS(WERROR,"Defgeneric ");
   PrintCLIPS(WERROR,GetDefgenericName((VOID *) gfunc));
   PrintCLIPS(WERROR," cannot be modified while one of its methods is executing.\n");
  }
  
/***************************************************
  NAME         : DeleteMethodInfo
  DESCRIPTION  : Deallocates all the data associated
                  w/ a method but does not release
                  the method structure itself
  INPUTS       : 1) The generic function address
                 2) The method address
  RETURNS      : Nothing useful
  SIDE EFFECTS : Nodes deallocated
  NOTES        : None
 ***************************************************/
globle VOID DeleteMethodInfo(gfunc,meth)
  DEFGENERIC *gfunc;
  DEFMETHOD *meth;
  {
   register int j,k;
   register RESTRICTION *rptr;
   
   SaveBusyCount(gfunc);
   ExpressionDeinstall(meth->actions);
   ReturnPackedExpression(meth->actions);
   if (meth->ppForm != NULL)
     rm((VOID *) meth->ppForm,(int) (sizeof(char) * (strlen(meth->ppForm)+1)));
   for (j = 0 ; j < meth->restrictionCount ; j++)
     {
      rptr = &meth->restrictions[j];
      
      for (k = 0 ; k < rptr->tcnt ; k++)
#if OBJECT_SYSTEM
        DecrementDefclassBusyCount(rptr->types[k]);
#else
        DecrementIntegerCount((INTEGER_HN *) rptr->types[k]);
#endif

      if (rptr->types != NULL)
        rm((VOID *) rptr->types,(int) (sizeof(VOID *) * rptr->tcnt));
      ExpressionDeinstall(rptr->query);
      ReturnPackedExpression(rptr->query);
     }
   if (meth->restrictions != NULL)
     rm((VOID *) meth->restrictions,
        (int) (sizeof(RESTRICTION) * meth->restrictionCount));
   RestoreBusyCount(gfunc);
  }
  
/***************************************************
  NAME         : MethodsExecuting
  DESCRIPTION  : Determines if any of the methods of
                   a generic function are currently
                   executing
  INPUTS       : The generic function address