insmngr.c

一套美国国家宇航局人工智能中心NASA的专家系统工具源代码

                 2) A flag indicating whether to
                    install or deinstall
  RETURNS      : Nothing useful
  SIDE EFFECTS : Symbol counts incremented or decremented
  NOTES        : Slot symbol installations are handled
                   by PutSlotValue
 ********************************************************/
static VOID InstallInstance(ins,set)
  INSTANCE_TYPE *ins;
  int set;
  {
   if (set == CLIPS_TRUE) 
     {
      if (ins->installed)
        return;
#if DEBUGGING_FUNCTIONS
      if (ins->cls->traceInstances)
        PrintInstanceWatch(MAKE_TRACE,ins);
#endif
      ins->installed = 1;
      ins->depth = CurrentEvaluationDepth;
      IncrementSymbolCount(ins->name);
      IncrementDefclassBusyCount((VOID *) ins->cls);
      GlobalNumberOfInstances++;
     }
   else
     {
      if (! ins->installed)
        return;
      ins->installed = 0;
      GlobalNumberOfInstances--;
      
      /* =======================================
         Class counts is decremented by
         RemoveInstanceData() when slot data is
         truly deleted - and name count is
         deleted by CleanupInstances() or
         QuashInstance() when instance is
         truly deleted
         ======================================= */
     }
  }
  
/****************************************************************
  NAME         : BuildDefaultSlots
  DESCRIPTION  : The current instance's address is
                   in the global variable CurrentInstance.
                   This builds the slots and the default values
                   from the direct class of the instance and its
                   inheritances.
  INPUTS       : Flag indicating whether init message will be
                 called for this instance or not
  RETURNS      : Nothing useful
  SIDE EFFECTS : Allocates the slot array for
                   the current instance
  NOTES        : The current instance's address is
                 stored in a global variable
 ****************************************************************/
static VOID BuildDefaultSlots(initMessage)
  BOOLEAN initMessage;
  {
   register int i,j;
   int scnt,lscnt;
   INSTANCE_SLOT *dst,**adst;
   SLOT_DESC **src;
   
   scnt = CurrentInstance->cls->instanceSlotCount;
   lscnt = CurrentInstance->cls->localInstanceSlotCount;
   if (scnt > 0)
     {
      CurrentInstance->slotAddresses = adst =
         (INSTANCE_SLOT **) gm2((int) (sizeof(INSTANCE_SLOT *) * scnt));
      if (lscnt != 0)
        CurrentInstance->slots = dst =
           (INSTANCE_SLOT *) gm2((int) (sizeof(INSTANCE_SLOT) * lscnt));
      src = CurrentInstance->cls->instanceTemplate;
      
      /* ==================================================
         A map of slot addresses is created - shared slots
         point at values in the class, and local slots
         point at values in the instance
         
         Also - slots are always given an initial value
         (since slots cannot be unbound). If there is
         already an instance of a class with a shared slot,
         that value is left alone
         ================================================== */
      for (i = 0 , j = 0 ; i < scnt ; i++)
        {
         if (src[i]->shared)
           {
            src[i]->sharedCount++;
            adst[i] = &(src[i]->sharedValue);
           }
         else
           {
            dst[j].desc = src[i];
            dst[j].value = NULL;
            adst[i] = &dst[j++];
           }
         if (adst[i]->value == NULL)
           {
            adst[i]->valueRequired = initMessage;
            if (adst[i]->desc->multiple)
              {
               adst[i]->type = MULTIFIELD;
               adst[i]->value = CreateMultifield2(0L);
               MultifieldInstall((MULTIFIELD_PTR) adst[i]->value);
              }
            else
              {
               adst[i]->type = SYMBOL;
               adst[i]->value = AddSymbol("nil");
               AtomInstall((int) adst[i]->type,adst[i]->value);
              }
           }
         else
           adst[i]->valueRequired = CLIPS_FALSE;
         adst[i]->override = CLIPS_FALSE;
        }
     }
  }
  
/*******************************************************************
  NAME         : CoreInitializeInstance
  DESCRIPTION  : Performs the core work for initializing an instance
  INPUTS       : 1) The instance address
                 2) Slot override expressions
  RETURNS      : CLIPS_TRUE if all OK, CLIPS_FALSE otherwise
  SIDE EFFECTS : EvaluationError set on errors - slots evaluated
  NOTES        : None
 *******************************************************************/
static int CoreInitializeInstance(ins,ovrexp)
  INSTANCE_TYPE *ins;
  EXPRESSION *ovrexp;
  {
   register int svaccess;
   DATA_OBJECT temp;
   
   if (ins->installed == 0)
     {
      PrintErrorID("INSMNGR",7,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Instance ");
      PrintCLIPS(WERROR,ValueToString(ins->name));
      PrintCLIPS(WERROR," is already being initialized.\n");
      SetEvaluationError(CLIPS_TRUE);
      return(CLIPS_FALSE);
     }  
   
   /* =======================================================
      Replace all default-slot values with any slot-overrides
      ======================================================= */
   ins->busy++;
   ins->installed = 0;
   if (InsertSlotOverrides(ins,ovrexp) == CLIPS_FALSE)
      {
       ins->installed = 1;
       ins->busy--;
       return(CLIPS_FALSE);
      }
      
   /* =================================================================
      Now that all the slot expressions are established - replace them
      with their evaluation
      
      If the slots are initialized properly - the initializeInProgress
      flag will be turned off.
      ================================================================= */
   ins->initializeInProgress = 1;
   svaccess = WithinInit;
   WithinInit = CLIPS_TRUE;

   if (MkInsMsgPass)
     DirectMessage(INIT_SYMBOL,ins,&temp,NULL);
   else
     EvaluateClassDefaults(ins);
   WithinInit = svaccess;
   ins->busy--;
   ins->installed = 1;
   if (EvaluationError)
     {
      PrintErrorID("INSMNGR",8,CLIPS_FALSE);
      PrintCLIPS(WERROR,"An error occurred during the initialization of instance ");
      PrintCLIPS(WERROR,ValueToString(ins->name));
      PrintCLIPS(WERROR,".\n");
      return(CLIPS_FALSE);
     }
   return((ins->initializeInProgress == 1) ? CLIPS_FALSE : CLIPS_TRUE);
  }           

/**********************************************************
  NAME         : InsertSlotOverrides
  DESCRIPTION  : Replaces value-expression for a slot
  INPUTS       : 1) The instance address
                 2) The address of the beginning of the
                    list of slot-expressions
  RETURNS      : CLIPS_TRUE if all okay, CLIPS_FALSE otherwise
  SIDE EFFECTS : Old slot expression deallocated
  NOTES        : Assumes symbols not yet installed
                 EVALUATES the slot-name expression but
                    simply copies the slot value-expression
 **********************************************************/
static int InsertSlotOverrides(ins,slot_exp)
  INSTANCE_TYPE *ins;
  EXPRESSION *slot_exp;
  {
   INSTANCE_SLOT *slot;
   int svaccess;
   DATA_OBJECT temp,junk;
   
   EvaluationError = CLIPS_FALSE;
   svaccess = WithinInit;
   while (slot_exp != NULL)
     {
      if ((EvaluateExpression(slot_exp,&temp) == CLIPS_TRUE) ? CLIPS_TRUE :
          (GetType(temp) != SYMBOL))
        {
         PrintErrorID("INSMNGR",9,CLIPS_FALSE);
         PrintCLIPS(WERROR,"Expected a valid slot name for slot-override.\n");
         SetEvaluationError(CLIPS_TRUE);
         return(CLIPS_FALSE);
        }
      slot = FindInstanceSlot(ins,(SYMBOL_HN *) GetValue(temp));
      if (slot == NULL)
        {
         PrintErrorID("INSMNGR",13,CLIPS_FALSE);
         PrintCLIPS(WERROR,"Slot ");
         PrintCLIPS(WERROR,DOToString(temp));
         PrintCLIPS(WERROR," does not exist in instance ");
         PrintCLIPS(WERROR,ValueToString(ins->name));
         PrintCLIPS(WERROR,".\n");
         SetEvaluationError(CLIPS_TRUE);
         return(CLIPS_FALSE);
        }
      WithinInit = CLIPS_TRUE;
      if (MkInsMsgPass)
        { DirectMessage(slot->desc->overrideMessage,
                       ins,NULL,slot_exp->nextArg->argList); }
      else if (slot_exp->nextArg->argList)
        {
         if (EvaluateAndStoreInDataObject((int) slot->desc->multiple,
                               slot_exp->nextArg->argList,&temp))
             PutSlotValue(ins,slot,&temp,&junk,"function make-instance");
        }
      else
        {
         SetpDOBegin(&temp,1);
         SetpDOEnd(&temp,0);
         SetpType(&temp,MULTIFIELD);
         SetpValue(&temp,NoParamValue);
         PutSlotValue(ins,slot,&temp,&junk,"function make-instance");
        }
      WithinInit = svaccess;
      if (EvaluationError)
        return(CLIPS_FALSE);
      slot->override = CLIPS_TRUE;
      slot_exp = slot_exp->nextArg->nextArg;
     }
   return(CLIPS_TRUE);
  }
  
/*****************************************************************************
  NAME         : EvaluateClassDefaults
  DESCRIPTION  : 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        : None
 *****************************************************************************/
static VOID EvaluateClassDefaults(ins)
  INSTANCE_TYPE *ins;
  {
   INSTANCE_SLOT *slot;
   DATA_OBJECT temp,junk;
   register int i;

   if (ins->initializeInProgress == 0)
     {
      PrintErrorID("INSMNGR",15,CLIPS_FALSE);
      SetEvaluationError(CLIPS_TRUE);
      PrintCLIPS(WERROR,"init-slots not valid in this context.\n");
      return;
     }
   for (i = 0 ; i < ins->cls->instanceSlotCount ; i++)
     {
      slot = ins->slotAddresses[i];
      
      /* ===========================================================
         Slot-overrides are just a short-hand for put-slots, so they
         should be done with messages.  Defaults are from the class
         definition and can be placed directly.
         =========================================================== */
      if (!slot->override)
        {
         if (slot->desc->dynamicDefault)
           {
            if (EvaluateAndStoreInDataObject((int) slot->desc->multiple,
                                             (EXPRESSION *) slot->desc->defaultValue,
                                             &temp))
              PutSlotValue(ins,slot,&temp,&junk,"function init-slots");
           }
         else if (((slot->desc->shared == 0) || (slot->desc->sharedCount == 1)) &&
                  (slot->desc->noDefault == 0))
           DirectPutSlotValue(ins,slot,(DATA_OBJECT *) slot->desc->defaultValue,&junk);
         else if (slot->valueRequired)
           {
            PrintErrorID("INSMNGR",14,CLIPS_FALSE);
            PrintCLIPS(WERROR,"Override required for slot ");
            PrintCLIPS(WERROR,ValueToString(slot->desc->slotName->name));
            PrintCLIPS(WERROR," in instance ");
            PrintCLIPS(WERROR,ValueToString(ins->name));
            PrintCLIPS(WERROR,".\n");
            SetEvaluationError(CLIPS_TRUE);
           }
         slot->valueRequired = CLIPS_FALSE;
         if (ins->garbage == 1)
           {
            PrintCLIPS(WERROR,ValueToString(ins->name));
            PrintCLIPS(WERROR," instance deleted by slot-override evaluation.\n");
            SetEvaluationError(CLIPS_TRUE);
           }
         if (EvaluationError)
            return;
        }
      slot->override = CLIPS_FALSE;
     }
   ins->initializeInProgress = 0;
  }

#if DEBUGGING_FUNCTIONS

/***************************************************
  NAME         : PrintInstanceWatch
  DESCRIPTION  : Prints out a trace message for the
                 creation/deletion of an instance
  INPUTS       : 1) The trace string indicating if
                    this is a creation or deletion
                 2) The instance
  RETURNS      : Nothing usful
  SIDE EFFECTS : Watch message printed
  NOTES        : None
 ***************************************************/
static VOID PrintInstanceWatch(traceString,theInstance)
  char *traceString;
  INSTANCE_TYPE *theInstance;
  {
   PrintCLIPS(WTRACE,traceString);
   PrintCLIPS(WTRACE," instance ");
   PrintInstanceNameAndClass(WTRACE,theInstance,CLIPS_TRUE);
  }
  
#endif

#endif
  
/***************************************************
  NAME         : 
  DESCRIPTION  : 
  INPUTS       : 
  RETURNS      : 
  SIDE EFFECTS : 
  NOTES        : 
 ***************************************************/