insmngr.c

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

      return(NULL);
     }
#endif

   CurrentInstance->name = iname;
   CurrentInstance->cls = cls;
   BuildDefaultSlots(initMessage);
           
   /* ============================================================
      Put the instance in the instance hash table and put it on its
        class's instance list
      ============================================================ */
   CurrentInstance->hashTableIndex = hashTableIndex;
   if (iprv == NULL)
     {
      CurrentInstance->nxtHash = InstanceTable[hashTableIndex];
      if (InstanceTable[hashTableIndex] != NULL)
        InstanceTable[hashTableIndex]->prvHash = CurrentInstance;
      InstanceTable[hashTableIndex] = CurrentInstance;
     }
   else
     {
      CurrentInstance->nxtHash = iprv->nxtHash;
      if (iprv->nxtHash != NULL)
        iprv->nxtHash->prvHash = CurrentInstance;
      iprv->nxtHash = CurrentInstance;
      CurrentInstance->prvHash = iprv;
     }
   
   /* ======================================
      Put instance in global and class lists
      ====================================== */
   if (CurrentInstance->cls->instanceList == NULL)
     CurrentInstance->cls->instanceList = CurrentInstance;
   else
     CurrentInstance->cls->instanceListBottom->nxtClass = CurrentInstance;
   CurrentInstance->prvClass = CurrentInstance->cls->instanceListBottom;
   CurrentInstance->cls->instanceListBottom = CurrentInstance;
   
   if (InstanceList == NULL)
     InstanceList = CurrentInstance;
   else
     InstanceListBottom->nxtList = CurrentInstance;
   CurrentInstance->prvList = InstanceListBottom;
   InstanceListBottom = CurrentInstance;
   ChangesToInstances = CLIPS_TRUE;
   
   /* ==============================================================================
      Install the instance's name and slot-value symbols (prevent them from becoming
      ephemeral) - the class name and slot names are accounted for by the class
      ============================================================================== */
   InstallInstance(CurrentInstance,CLIPS_TRUE);

   ins = CurrentInstance;
   CurrentInstance = NULL;

#if INSTANCE_PATTERN_MATCHING
   if (ins->cls->reactive)
     ObjectNetworkAction(OBJECT_ASSERT,(VOID *) ins,-1);
#endif
   
   return(ins);
  }

/*****************************************************************************
  NAME         : InitSlotsCommand
  DESCRIPTION  : Calls CLIPS Kernel Expression Evaluator EvaluateExpression
                   for each expression-value of an instance expression
                   
                 Evaluates default slots only - slots that were specified
                 by overrides (sp->override == 1) are ignored)
  INPUTS       : 1) Instance address
  RETURNS      : Nothing useful
  SIDE EFFECTS : Each DATA_OBJECT slot in the instance's slot array is replaced
                   by the evaluation (by EvaluateExpression) of the expression
                   in the slot list.  The old expression-values
                   are deleted.
  NOTES        : CLIPS Syntax: (init-slots <instance>)
 *****************************************************************************/
globle VOID InitSlotsCommand(result)
  DATA_OBJECT *result;
  {
   SetpType(result,SYMBOL);
   SetpValue(result,CLIPSFalseSymbol);
   EvaluationError = CLIPS_FALSE;
   if (CheckCurrentMessage("init-slots",CLIPS_TRUE) == CLIPS_FALSE)
     return;
   EvaluateClassDefaults(GetActiveInstance());
   if (! EvaluationError)
     {
      SetpType(result,INSTANCE_ADDRESS);
      SetpValue(result,(VOID *) GetActiveInstance());
     }
  }
  
/******************************************************
  NAME         : QuashInstance
  DESCRIPTION  : Deletes an instance if it is not in
                   use, otherwise sticks it on the
                   garbage list
  INPUTS       : The instance
  RETURNS      : 1 if successful, 0 otherwise
  SIDE EFFECTS : Instance deleted or added to garbage
  NOTES        : Even though the instance is removed
                   from the class list, hash table and
                   instance list, its links remain
                   unchanged so that outside loops
                   can still determine where the next
                   node in the list is (assuming the
                   instance was garbage collected).
 ******************************************************/
globle BOOLEAN QuashInstance(ins)
  INSTANCE_TYPE *ins;
  {
   register int iflag;
   IGARBAGE *gptr;
   
#if INSTANCE_PATTERN_MATCHING
   if (JoinOperationInProgress && ins->cls->reactive)
     {
      PrintErrorID("INSMNGR",12,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Cannot delete instances of reactive classes while\n");
      PrintCLIPS(WERROR,"  pattern-matching is in process.\n");
      SetEvaluationError(CLIPS_TRUE);
      return(0);
     }
#endif
   if (ins->garbage == 1)
     return(0);
   if (ins->installed == 0)
     {
      PrintErrorID("INSMNGR",6,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Cannot delete instance ");
      PrintCLIPS(WERROR,ValueToString(ins->name));
      PrintCLIPS(WERROR," during initialization.\n");
      SetEvaluationError(CLIPS_TRUE);
      return(0);
     }
#if DEBUGGING_FUNCTIONS
   if (ins->cls->traceInstances)
     PrintInstanceWatch(UNMAKE_TRACE,ins);
#endif

#if LOGICAL_DEPENDENCIES
   RemoveEntityDependencies((struct patternEntity *) ins);
#endif

#if INSTANCE_PATTERN_MATCHING
   if (ins->cls->reactive)
     ObjectNetworkAction(OBJECT_RETRACT,(VOID *) ins,-1);
#endif

   if (ins->prvHash != NULL)
     ins->prvHash->nxtHash = ins->nxtHash;
   else
     InstanceTable[ins->hashTableIndex] = ins->nxtHash;
   if (ins->nxtHash != NULL)
     ins->nxtHash->prvHash = ins->prvHash;

   if (ins->prvClass != NULL)
     ins->prvClass->nxtClass = ins->nxtClass;
   else
     ins->cls->instanceList = ins->nxtClass;
   if (ins->nxtClass != NULL)
     ins->nxtClass->prvClass = ins->prvClass;
   else
     ins->cls->instanceListBottom = ins->prvClass;

   if (ins->prvList != NULL)
     ins->prvList->nxtList = ins->nxtList;
   else
     InstanceList = ins->nxtList;
   if (ins->nxtList != NULL)
     ins->nxtList->prvList = ins->prvList;
   else
     InstanceListBottom = ins->prvList;
     
   iflag = ins->installed;
   InstallInstance(ins,CLIPS_FALSE);
   
   /* ==============================================
      If the instance is the basis for an executing
      rule, don't bother deleting its slots yet, for
      they may still be needed by pattern variables
      ============================================== */
   if ((iflag == 1) 
#if INSTANCE_PATTERN_MATCHING
       && (ins->header.busyCount == 0)
#endif
     )
     RemoveInstanceData(ins);

   if ((ins->busy == 0) && (ins->depth > CurrentEvaluationDepth) &&
       (MaintainGarbageInstances == CLIPS_FALSE)
#if INSTANCE_PATTERN_MATCHING
        && (ins->header.busyCount == 0)
#endif
       )
     {
      DecrementSymbolCount(ins->name);
      rtn_struct(instance,ins);
     }
   else
     {
      gptr = get_struct(igarbage);
      ins->garbage = 1;
      gptr->ins = ins;
      gptr->nxt = InstanceGarbageList;
      InstanceGarbageList = gptr;
      EphemeralItemCount += 2;
      EphemeralItemSize += InstanceSizeHeuristic(ins) + sizeof(IGARBAGE);
     }
   ChangesToInstances = CLIPS_TRUE;
   return(1);
  }
  

#if INSTANCE_PATTERN_MATCHING

/****************************************************
  NAME         : InactiveInitializeInstance
  DESCRIPTION  : Initializes an instance of a class
                 Pattern-matching is automatically
                 delayed until the instance is
                 completely initialized
  INPUTS       : The address of the result value
  RETURNS      : Nothing useful
  SIDE EFFECTS : Instance intialized
  NOTES        : CLIPS Syntax:
                 (initialize-instance <instance-name>
                    <slot-override>*)
 ****************************************************/
globle VOID InactiveInitializeInstance(result)
  DATA_OBJECT *result;
  {
   int ov;
   
   ov = SetDelayObjectPatternMatching(CLIPS_TRUE);
   InitializeInstanceCommand(result);
   SetDelayObjectPatternMatching(ov);
  }
  
/**************************************************************
  NAME         : InactiveMakeInstance
  DESCRIPTION  : Creates and initializes an instance of a class
                 Pattern-matching is automatically
                 delayed until the instance is
                 completely initialized
  INPUTS       : The address of the result value
  RETURNS      : Nothing useful
  SIDE EFFECTS : Instance intialized
  NOTES        : CLIPS Syntax:
                 (make-instance <instance-name> of <class>
                    <slot-override>*)
 **************************************************************/
globle VOID InactiveMakeInstance(result)
  DATA_OBJECT *result;
  {
   int ov;
   
   ov = SetDelayObjectPatternMatching(CLIPS_TRUE);
   MakeInstanceCommand(result);
   SetDelayObjectPatternMatching(ov);
  }
  
#endif

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */
   
/********************************************************
  NAME         : NewInstance
  DESCRIPTION  : Allocates and initializes a new instance
  INPUTS       : None
  RETURNS      : The address of the new instance
  SIDE EFFECTS : None
  NOTES        : None
 ********************************************************/
static INSTANCE_TYPE *NewInstance()
  {
   INSTANCE_TYPE *instance;
   
   instance = get_struct(instance);
#if INSTANCE_PATTERN_MATCHING || LOGICAL_DEPENDENCIES
   instance->header.theInfo = &InstanceInfo;
#if LOGICAL_DEPENDENCIES
   instance->header.dependents = NULL;
#endif
   instance->header.busyCount = 0;
   instance->header.timeTag = 0L;
#endif
#if INSTANCE_PATTERN_MATCHING
   instance->partialMatchList = NULL;
   instance->basisSlots = NULL;
   instance->reteSynchronized = CLIPS_FALSE;
#endif
   instance->busy = 0;
   instance->installed = 0;
   instance->garbage = 0;
   instance->initializeInProgress = 0;
   instance->depth = CurrentEvaluationDepth;
   instance->name = NULL;
   instance->hashTableIndex = 0;
   instance->cls = NULL;
   instance->slots = NULL;
   instance->slotAddresses = NULL;
   instance->prvClass = NULL;
   instance->nxtClass = NULL;
   instance->prvHash = NULL;
   instance->nxtHash = NULL;
   instance->prvList = NULL;
   instance->nxtList = NULL;
   return(instance);
  }

/*****************************************************************
  NAME         : InstanceLocationInfo
  DESCRIPTION  : Determines where a specified instance belongs
                   in the instance hash table
  INPUTS       : 1) The class of the new instance
                 2) The CLIPS symbol for the name of the instance
                 3) Caller's buffer for previous node address
                 4) Caller's buffer for hash value
  RETURNS      : The address of the found instance, NULL otherwise
  SIDE EFFECTS : None
  NOTES        : Instance names only have to be unique within
                 a module
 *****************************************************************/
static INSTANCE_TYPE *InstanceLocationInfo(cls,iname,prv,hashTableIndex)
  DEFCLASS *cls;
  SYMBOL_HN *iname;
  INSTANCE_TYPE **prv;
  unsigned *hashTableIndex;
  {
   INSTANCE_TYPE *ins;
   
   *hashTableIndex = HashInstance(iname);
   ins = InstanceTable[*hashTableIndex];
   
   /* ========================================
      Make sure all instances of the same name
      are grouped together regardless of what
      module their classes are in
      ======================================== */
   *prv = NULL;
   while ((ins != NULL) ? (ins->name != iname) : CLIPS_FALSE)
     {
      *prv = ins;
      ins = ins->nxtHash;
     }
   while ((ins != NULL) ? (ins->name == iname) : CLIPS_FALSE)
     {
      if (ins->cls->header.whichModule->theModule ==
          cls->header.whichModule->theModule)
        return(ins);
      *prv = ins;
      ins = ins->nxtHash;
     }
   return(NULL);
  }
  
/********************************************************
  NAME         : InstallInstance
  DESCRIPTION  : Prevent name and slot value symbols
                   from being ephemeral (all others
                   taken care of by class defn)
  INPUTS       : 1) The address of the instance