insmngr.c

clips源代码

                   by PutSlotValue
 ********************************************************/
static void InstallInstance(
  void *theEnv,
  INSTANCE_TYPE *ins,
  int set)
  {
   if (set == TRUE)
     {
      if (ins->installed)
        return;
#if DEBUGGING_FUNCTIONS
      if (ins->cls->traceInstances)
        PrintInstanceWatch(theEnv,MAKE_TRACE,ins);
#endif
      ins->installed = 1;
      ins->depth = EvaluationData(theEnv)->CurrentEvaluationDepth;
      IncrementSymbolCount(ins->name);
      IncrementDefclassBusyCount(theEnv,(void *) ins->cls);
      InstanceData(theEnv)->GlobalNumberOfInstances++;
     }
   else
     {
      if (! ins->installed)
        return;
      ins->installed = 0;
      InstanceData(theEnv)->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(
  void *theEnv,
  intBool initMessage)
  {
   register unsigned i,j;
   unsigned scnt;
   unsigned lscnt;
   INSTANCE_SLOT *dst = NULL,**adst;
   SLOT_DESC **src;

   scnt = InstanceData(theEnv)->CurrentInstance->cls->instanceSlotCount;
   lscnt = InstanceData(theEnv)->CurrentInstance->cls->localInstanceSlotCount;
   if (scnt > 0)
     {
      InstanceData(theEnv)->CurrentInstance->slotAddresses = adst =
         (INSTANCE_SLOT **) gm2(theEnv,(sizeof(INSTANCE_SLOT *) * scnt));
      if (lscnt != 0)
        InstanceData(theEnv)->CurrentInstance->slots = dst =
           (INSTANCE_SLOT *) gm2(theEnv,(sizeof(INSTANCE_SLOT) * lscnt));
      src = InstanceData(theEnv)->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(theEnv,0L);
               MultifieldInstall(theEnv,(MULTIFIELD_PTR) adst[i]->value);
              }
            else
              {
               adst[i]->type = SYMBOL;
               adst[i]->value = EnvAddSymbol(theEnv,"nil");
               AtomInstall(theEnv,(int) adst[i]->type,adst[i]->value);
              }
           }
         else
           adst[i]->valueRequired = FALSE;
         adst[i]->override = FALSE;
        }
     }
  }

/*******************************************************************
  NAME         : CoreInitializeInstance
  DESCRIPTION  : Performs the core work for initializing an instance
  INPUTS       : 1) The instance address
                 2) Slot override expressions
  RETURNS      : TRUE if all OK, FALSE otherwise
  SIDE EFFECTS : EvaluationError set on errors - slots evaluated
  NOTES        : None
 *******************************************************************/
static int CoreInitializeInstance(
  void *theEnv,
  INSTANCE_TYPE *ins,
  EXPRESSION *ovrexp)
  {
   DATA_OBJECT temp;

   if (ins->installed == 0)
     {
      PrintErrorID(theEnv,"INSMNGR",7,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Instance ");
      EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
      EnvPrintRouter(theEnv,WERROR," is already being initialized.\n");
      SetEvaluationError(theEnv,TRUE);
      return(FALSE);
     }

   /* =======================================================
      Replace all default-slot values with any slot-overrides
      ======================================================= */
   ins->busy++;
   ins->installed = 0;

   /* =================================================================
      If the slots are initialized properly - the initializeInProgress
      flag will be turned off.
      ================================================================= */
   ins->initializeInProgress = 1;
   ins->initSlotsCalled = 0;

   if (InsertSlotOverrides(theEnv,ins,ovrexp) == FALSE)
      {
       ins->installed = 1;
       ins->busy--;
       return(FALSE);
      }

   /* =================================================================
      Now that all the slot expressions are established - replace them
      with their evaluation
      ================================================================= */

   if (InstanceData(theEnv)->MkInsMsgPass)
     DirectMessage(theEnv,MessageHandlerData(theEnv)->INIT_SYMBOL,ins,&temp,NULL);
   else
     EvaluateClassDefaults(theEnv,ins);

   ins->busy--;
   ins->installed = 1;
   if (EvaluationData(theEnv)->EvaluationError)
     {
      PrintErrorID(theEnv,"INSMNGR",8,FALSE);
      EnvPrintRouter(theEnv,WERROR,"An error occurred during the initialization of instance ");
      EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
      EnvPrintRouter(theEnv,WERROR,".\n");
      return(FALSE);
     }
     
   ins->initializeInProgress = 0;
   return((ins->initSlotsCalled == 0) ? FALSE : 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      : TRUE if all okay, 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(
  void *theEnv,
  INSTANCE_TYPE *ins,
  EXPRESSION *slot_exp)
  {
   INSTANCE_SLOT *slot;
   DATA_OBJECT temp,junk;

   EvaluationData(theEnv)->EvaluationError = FALSE;
   while (slot_exp != NULL)
     {
      if ((EvaluateExpression(theEnv,slot_exp,&temp) == TRUE) ? TRUE :
          (GetType(temp) != SYMBOL))
        {
         PrintErrorID(theEnv,"INSMNGR",9,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Expected a valid slot name for slot-override.\n");
         SetEvaluationError(theEnv,TRUE);
         return(FALSE);
        }
      slot = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) GetValue(temp));
      if (slot == NULL)
        {
         PrintErrorID(theEnv,"INSMNGR",13,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Slot ");
         EnvPrintRouter(theEnv,WERROR,DOToString(temp));
         EnvPrintRouter(theEnv,WERROR," does not exist in instance ");
         EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
         EnvPrintRouter(theEnv,WERROR,".\n");
         SetEvaluationError(theEnv,TRUE);
         return(FALSE);
        }

      if (InstanceData(theEnv)->MkInsMsgPass)
        { DirectMessage(theEnv,slot->desc->overrideMessage,
                       ins,NULL,slot_exp->nextArg->argList); }
      else if (slot_exp->nextArg->argList)
        {
         if (EvaluateAndStoreInDataObject(theEnv,(int) slot->desc->multiple,
                               slot_exp->nextArg->argList,&temp,TRUE))
             PutSlotValue(theEnv,ins,slot,&temp,&junk,"function make-instance");
        }
      else
        {
         SetpDOBegin(&temp,1);
         SetpDOEnd(&temp,0);
         SetpType(&temp,MULTIFIELD);
         SetpValue(&temp,ProceduralPrimitiveData(theEnv)->NoParamValue);
         PutSlotValue(theEnv,ins,slot,&temp,&junk,"function make-instance");
        }

      if (EvaluationData(theEnv)->EvaluationError)
        return(FALSE);
      slot->override = TRUE;
      slot_exp = slot_exp->nextArg->nextArg;
     }
   return(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(
  void *theEnv,
  INSTANCE_TYPE *ins)
  {
   INSTANCE_SLOT *slot;
   DATA_OBJECT temp,junk;
   long i;

   if (ins->initializeInProgress == 0)
     {
      PrintErrorID(theEnv,"INSMNGR",15,FALSE);
      SetEvaluationError(theEnv,TRUE);
      EnvPrintRouter(theEnv,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(theEnv,(int) slot->desc->multiple,
                                             (EXPRESSION *) slot->desc->defaultValue,
                                             &temp,TRUE))
              PutSlotValue(theEnv,ins,slot,&temp,&junk,"function init-slots");
           }
         else if (((slot->desc->shared == 0) || (slot->desc->sharedCount == 1)) &&
                  (slot->desc->noDefault == 0))
           DirectPutSlotValue(theEnv,ins,slot,(DATA_OBJECT *) slot->desc->defaultValue,&junk);
         else if (slot->valueRequired)
           {
            PrintErrorID(theEnv,"INSMNGR",14,FALSE);
            EnvPrintRouter(theEnv,WERROR,"Override required for slot ");
            EnvPrintRouter(theEnv,WERROR,ValueToString(slot->desc->slotName->name));
            EnvPrintRouter(theEnv,WERROR," in instance ");
            EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
            EnvPrintRouter(theEnv,WERROR,".\n");
            SetEvaluationError(theEnv,TRUE);
           }
         slot->valueRequired = FALSE;
         if (ins->garbage == 1)
           {
            EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
            EnvPrintRouter(theEnv,WERROR," instance deleted by slot-override evaluation.\n");
            SetEvaluationError(theEnv,TRUE);
           }
         if (EvaluationData(theEnv)->EvaluationError)
            return;
        }
      slot->override = FALSE;
     }
   ins->initSlotsCalled = 1;
  }

#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(
  void *theEnv,
  char *traceString,
  INSTANCE_TYPE *theInstance)
  {
   EnvPrintRouter(theEnv,WTRACE,traceString);
   EnvPrintRouter(theEnv,WTRACE," instance ");
   PrintInstanceNameAndClass(theEnv,WTRACE,theInstance,TRUE);
  }

#endif

#endif