inscom.c

clips源代码

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*              CLIPS Version 6.24  05/17/06           */
   /*                                                     */
   /*                INSTANCE COMMAND MODULE              */
   /*******************************************************/

/*************************************************************/
/* Purpose:  Kernel Interface Commands for Instances         */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
/*                                                           */
/*            Corrected compilation errors for files         */
/*            generated by constructs-to-c. DR0861           */
/*                                                           */
/*      6.24: Loading a binary instance file from a run-time */
/*            program caused a bus error. DR0866             */
/*                                                           */
/*            Removed LOGICAL_DEPENDENCIES compilation flag. */
/*                                                           */
/*            Converted INSTANCE_PATTERN_MATCHING to         */
/*            DEFRULE_CONSTRUCT.                             */
/*                                                           */
/*            Renamed BOOLEAN macro type to intBool.         */
/*                                                           */
/*************************************************************/

/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if OBJECT_SYSTEM

#include "argacces.h"
#include "classcom.h"
#include "classfun.h"
#include "classinf.h"
#include "envrnmnt.h"
#include "exprnpsr.h"
#include "evaluatn.h"
#include "insfile.h"
#include "insfun.h"
#include "insmngr.h"
#include "insmoddp.h"
#include "insmult.h"
#include "inspsr.h"
#include "lgcldpnd.h"
#include "memalloc.h"
#include "msgcom.h"
#include "msgfun.h"
#include "router.h"
#include "strngrtr.h"
#include "sysdep.h"
#include "utility.h"
#include "commline.h"

#define _INSCOM_SOURCE_
#include "inscom.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */
#define ALL_QUALIFIER      "inherit"

/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */

#if DEBUGGING_FUNCTIONS
static long ListInstancesInModule(void *,int,char *,char *,intBool,intBool);
static long TabulateInstances(void *,int,char *,DEFCLASS *,intBool,intBool);
#endif

static void PrintInstance(void *,char *,INSTANCE_TYPE *,char *);
static INSTANCE_SLOT *FindISlotByName(void *,INSTANCE_TYPE *,char *);
static void DeallocateInstanceData(void *);

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

/*********************************************************
  NAME         : SetupInstances
  DESCRIPTION  : Initializes instance Hash Table,
                   Function Parsers, and Data Structures
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 *********************************************************/
globle void SetupInstances(
  void *theEnv)
  {
   struct patternEntityRecord instanceInfo = { { "INSTANCE_ADDRESS",
                                                     INSTANCE_ADDRESS,0,0,0,
                                                     PrintInstanceName,
                                                     PrintInstanceLongForm,
                                                     EnvUnmakeInstance,
                                                     NULL,
                                                     EnvGetNextInstance,
                                                     EnvDecrementInstanceCount,
                                                     EnvIncrementInstanceCount,
                                                     NULL,NULL,NULL,NULL,NULL
                                                   },
#if DEFRULE_CONSTRUCT && OBJECT_SYSTEM
                                                  DecrementObjectBasisCount,
                                                  IncrementObjectBasisCount,
                                                  MatchObjectFunction,
                                                  NetworkSynchronized
#else
                                                  NULL,NULL,NULL,NULL
#endif
                                                };
                                                
   INSTANCE_TYPE dummyInstance = { { NULL, NULL, 0, 0L }, 
                                   NULL, NULL, 0, 1, 0, 0, 0, 
                                   NULL,  0, 0, 0, NULL, NULL, NULL, NULL,
                                   NULL, NULL, NULL, NULL, NULL };

   AllocateEnvironmentData(theEnv,INSTANCE_DATA,sizeof(struct instanceData),DeallocateInstanceData);
   
   InstanceData(theEnv)->MkInsMsgPass = TRUE;
   memcpy(&InstanceData(theEnv)->InstanceInfo,&instanceInfo,sizeof(struct patternEntityRecord)); 
   dummyInstance.header.theInfo = &InstanceData(theEnv)->InstanceInfo;    
   memcpy(&InstanceData(theEnv)->DummyInstance,&dummyInstance,sizeof(INSTANCE_TYPE));  

   InitializeInstanceTable(theEnv);
   InstallPrimitive(theEnv,(struct entityRecord *) &InstanceData(theEnv)->InstanceInfo,INSTANCE_ADDRESS);

#if ! RUN_TIME

#if DEFRULE_CONSTRUCT && OBJECT_SYSTEM
   EnvDefineFunction2(theEnv,"initialize-instance",'u',
                  PTIEF InactiveInitializeInstance,"InactiveInitializeInstance",NULL);
   EnvDefineFunction2(theEnv,"active-initialize-instance",'u',
                  PTIEF InitializeInstanceCommand,"InitializeInstanceCommand",NULL);
   AddFunctionParser(theEnv,"active-initialize-instance",ParseInitializeInstance);

   EnvDefineFunction2(theEnv,"make-instance",'u',PTIEF InactiveMakeInstance,"InactiveMakeInstance",NULL);
   EnvDefineFunction2(theEnv,"active-make-instance",'u',PTIEF MakeInstanceCommand,"MakeInstanceCommand",NULL);
   AddFunctionParser(theEnv,"active-make-instance",ParseInitializeInstance);

#else
   EnvDefineFunction2(theEnv,"initialize-instance",'u',
                  PTIEF InitializeInstanceCommand,"InitializeInstanceCommand",NULL);
   EnvDefineFunction2(theEnv,"make-instance",'u',PTIEF MakeInstanceCommand,"MakeInstanceCommand",NULL);
#endif
   AddFunctionParser(theEnv,"initialize-instance",ParseInitializeInstance);
   AddFunctionParser(theEnv,"make-instance",ParseInitializeInstance);

   EnvDefineFunction2(theEnv,"init-slots",'u',PTIEF InitSlotsCommand,"InitSlotsCommand","00");

   EnvDefineFunction2(theEnv,"delete-instance",'b',PTIEF DeleteInstanceCommand,
                   "DeleteInstanceCommand","00");
   EnvDefineFunction2(theEnv,"(create-instance)",'b',PTIEF CreateInstanceHandler,
                   "CreateInstanceHandler","00");
   EnvDefineFunction2(theEnv,"unmake-instance",'b',PTIEF UnmakeInstanceCommand,
                   "UnmakeInstanceCommand","1*e");

#if DEBUGGING_FUNCTIONS
   EnvDefineFunction2(theEnv,"instances",'v',PTIEF InstancesCommand,"InstancesCommand","*3w");
   EnvDefineFunction2(theEnv,"ppinstance",'v',PTIEF PPInstanceCommand,"PPInstanceCommand","00");
#endif

   EnvDefineFunction2(theEnv,"symbol-to-instance-name",'u',
                  PTIEF SymbolToInstanceName,"SymbolToInstanceName","11w");
   EnvDefineFunction2(theEnv,"instance-name-to-symbol",'w',
                  PTIEF InstanceNameToSymbol,"InstanceNameToSymbol","11p");
   EnvDefineFunction2(theEnv,"instance-address",'u',PTIEF InstanceAddressCommand,
                   "InstanceAddressCommand","12eep");
   EnvDefineFunction2(theEnv,"instance-addressp",'b',PTIEF InstanceAddressPCommand,
                   "InstanceAddressPCommand","11");
   EnvDefineFunction2(theEnv,"instance-namep",'b',PTIEF InstanceNamePCommand,
                   "InstanceNamePCommand","11");
   EnvDefineFunction2(theEnv,"instance-name",'u',PTIEF InstanceNameCommand,
                   "InstanceNameCommand","11e");
   EnvDefineFunction2(theEnv,"instancep",'b',PTIEF InstancePCommand,"InstancePCommand","11");
   EnvDefineFunction2(theEnv,"instance-existp",'b',PTIEF InstanceExistPCommand,
                   "InstanceExistPCommand","11e");
   EnvDefineFunction2(theEnv,"class",'u',PTIEF ClassCommand,"ClassCommand","11");

   SetupInstanceModDupCommands(theEnv);
   /* SetupInstanceFileCommands(theEnv); DR0866 */
   SetupInstanceMultifieldCommands(theEnv);

#endif

   SetupInstanceFileCommands(theEnv); /* DR0866 */

   AddCleanupFunction(theEnv,"instances",CleanupInstances,0);
   EnvAddResetFunction(theEnv,"instances",DestroyAllInstances,60);
  }
  
/***************************************/
/* DeallocateInstanceData: Deallocates */
/*    environment data for instances.  */
/***************************************/
static void DeallocateInstanceData(
  void *theEnv)
  {
   INSTANCE_TYPE *tmpIPtr, *nextIPtr;
   long i;
   INSTANCE_SLOT *sp;
   IGARBAGE *tmpGPtr, *nextGPtr;
   struct patternMatch *theMatch, *tmpMatch;
   
   /*=================================*/
   /* Remove the instance hash table. */
   /*=================================*/
   
   rm(theEnv,InstanceData(theEnv)->InstanceTable,
      (int) (sizeof(INSTANCE_TYPE *) * INSTANCE_TABLE_HASH_SIZE));
      
   /*=======================*/
   /* Return all instances. */
   /*=======================*/
   
   tmpIPtr = InstanceData(theEnv)->InstanceList;
   while (tmpIPtr != NULL)
     {
      nextIPtr = tmpIPtr->nxtList;
      
      theMatch = (struct patternMatch *) tmpIPtr->partialMatchList;        
      while (theMatch != NULL)
        {
         tmpMatch = theMatch->next;
         rtn_struct(theEnv,patternMatch,theMatch);
         theMatch = tmpMatch;
        }

#if DEFRULE_CONSTRUCT
      ReturnEntityDependencies(theEnv,(struct patternEntity *) tmpIPtr);
#endif

      for (i = 0 ; i < tmpIPtr->cls->instanceSlotCount ; i++)
        {
         sp = tmpIPtr->slotAddresses[i];
         if ((sp == &sp->desc->sharedValue) ?
             (--sp->desc->sharedCount == 0) : TRUE)
           {
            if (sp->desc->multiple)
              { ReturnMultifield(theEnv,(MULTIFIELD_PTR) sp->value); }
           }
        }
     
      if (tmpIPtr->cls->instanceSlotCount != 0)
        {
         rm(theEnv,(void *) tmpIPtr->slotAddresses,
            (tmpIPtr->cls->instanceSlotCount * sizeof(INSTANCE_SLOT *)));
         if (tmpIPtr->cls->localInstanceSlotCount != 0)
           {
            rm(theEnv,(void *) tmpIPtr->slots,
               (tmpIPtr->cls->localInstanceSlotCount * sizeof(INSTANCE_SLOT)));
           }
        }
  
      rtn_struct(theEnv,instance,tmpIPtr);

      tmpIPtr = nextIPtr;
     }
     
   /*===============================*/
   /* Get rid of garbage instances. */
   /*===============================*/
   
   tmpGPtr = InstanceData(theEnv)->InstanceGarbageList;
   while (tmpGPtr != NULL)
     {
      nextGPtr = tmpGPtr->nxt;
      rtn_struct(theEnv,instance,tmpGPtr->ins);
      rtn_struct(theEnv,igarbage,tmpGPtr);
      tmpGPtr = nextGPtr;
     }
  }

/*******************************************************************
  NAME         : EnvDeleteInstance
  DESCRIPTION  : DIRECTLY removes a named instance from the
                   hash table and its class's
                   instance list
  INPUTS       : The instance address (NULL to delete all instances)
  RETURNS      : 1 if successful, 0 otherwise
  SIDE EFFECTS : Instance is deallocated
  NOTES        : C interface for deleting instances
 *******************************************************************/
globle intBool EnvDeleteInstance(
  void *theEnv,
  void *iptr)
  {
   INSTANCE_TYPE *ins,*itmp;
   int success = 1;

   if (iptr != NULL)
     return(QuashInstance(theEnv,(INSTANCE_TYPE *) iptr));
   ins = InstanceData(theEnv)->InstanceList;
   while (ins != NULL)
     {
      itmp = ins;
      ins = ins->nxtList;
      if (QuashInstance(theEnv,(INSTANCE_TYPE *) itmp) == 0)
        success = 0;
     }

   if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
       (EvaluationData(theEnv)->CurrentExpression == NULL))
     { PeriodicCleanup(theEnv,TRUE,FALSE); }

   return(success);
  }

/*******************************************************************
  NAME         : EnvUnmakeInstance
  DESCRIPTION  : Removes a named instance via message-passing
  INPUTS       : The instance address (NULL to delete all instances)
  RETURNS      : 1 if successful, 0 otherwise
  SIDE EFFECTS : Instance is deallocated
  NOTES        : C interface for deleting instances
 *******************************************************************/
globle intBool EnvUnmakeInstance(
  void *theEnv,
  void *iptr)
  {
   INSTANCE_TYPE *ins;
   int success = 1,svmaintain;

   svmaintain = InstanceData(theEnv)->MaintainGarbageInstances;
   InstanceData(theEnv)->MaintainGarbageInstances = TRUE;
   ins = (INSTANCE_TYPE *) iptr;
   if (ins != NULL)
     {
      if (ins->garbage)
        success = 0;
      else
        {
         DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL);
         if (ins->garbage == 0)
           success = 0;
        }
     }
   else
     {
      ins = InstanceData(theEnv)->InstanceList;
      while (ins != NULL)
        {
         DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL);
         if (ins->garbage == 0)
           success = 0;
         ins = ins->nxtList;
         while ((ins != NULL) ? ins->garbage : FALSE)
           ins = ins->nxtList;
        }
     }
   InstanceData(theEnv)->MaintainGarbageInstances = svmaintain;
   CleanupInstances(theEnv);

   if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
       (EvaluationData(theEnv)->CurrentExpression == NULL))
     { PeriodicCleanup(theEnv,TRUE,FALSE); }

   return(success);
  }

#if DEBUGGING_FUNCTIONS

/*******************************************************************
  NAME         : InstancesCommand
  DESCRIPTION  : Lists all instances associated
                   with a particular class
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : H/L Syntax : (instances [<class-name> [inherit]])
 *******************************************************************/
globle void InstancesCommand(
  void *theEnv)
  {
   int argno, inheritFlag = FALSE;
   void *theDefmodule;
   char *className = NULL;
   DATA_OBJECT temp;

   theDefmodule = (void *) EnvGetCurrentModule(theEnv);

   argno = EnvRtnArgCount(theEnv);