insfun.c

来自「clips源代码」· C语言 代码 · 共 1,328 行 · 第 1/4 页

 ***************************************************/
globle void PrintInstanceName(
  void *theEnv,
  char *logName,
  void *vins)
  {
   INSTANCE_TYPE *ins;

   ins = (INSTANCE_TYPE *) vins;
   if (ins->garbage)
     {
      EnvPrintRouter(theEnv,logName,"<stale instance [");
      EnvPrintRouter(theEnv,logName,ValueToString(ins->name));
      EnvPrintRouter(theEnv,logName,"]>");
     }
   else
     {
      EnvPrintRouter(theEnv,logName,"[");
      EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins)));
      EnvPrintRouter(theEnv,logName,"]");
     }
  }
  
/***************************************************
  NAME         : PrintInstanceLongForm
  DESCRIPTION  : Used by kernel to print
                 instance addresses
  INPUTS       : 1) The logical output name
                 2) A pointer to the instance
  RETURNS      : Nothing useful
  SIDE EFFECTS : Address of instance printed
  NOTES        : None
 ***************************************************/
globle void PrintInstanceLongForm(
  void *theEnv,
  char *logName,
  void *vins)
  {
   INSTANCE_TYPE *ins = (INSTANCE_TYPE *) vins;

   if (PrintUtilityData(theEnv)->InstanceAddressesToNames)
     {
      if (ins == &InstanceData(theEnv)->DummyInstance)
        EnvPrintRouter(theEnv,logName,"\"<Dummy Instance>\"");
      else
        {
         EnvPrintRouter(theEnv,logName,"[");
         EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins)));
         EnvPrintRouter(theEnv,logName,"]");
        }
     }
   else
     {
      if (PrintUtilityData(theEnv)->AddressesToStrings)
        EnvPrintRouter(theEnv,logName,"\"");
      if (ins == &InstanceData(theEnv)->DummyInstance)
        EnvPrintRouter(theEnv,logName,"<Dummy Instance>");
      else if (ins->garbage)
        {
         EnvPrintRouter(theEnv,logName,"<Stale Instance-");
         EnvPrintRouter(theEnv,logName,ValueToString(ins->name));
         EnvPrintRouter(theEnv,logName,">");
        }
      else
        {
         EnvPrintRouter(theEnv,logName,"<Instance-");
         EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins)));
         EnvPrintRouter(theEnv,logName,">");
        }
      if (PrintUtilityData(theEnv)->AddressesToStrings)
        EnvPrintRouter(theEnv,logName,"\"");
     }
  }

#if DEFRULE_CONSTRUCT

/***************************************************
  NAME         : DecrementObjectBasisCount
  DESCRIPTION  : Decrements the basis count of an
                 object indicating that it is in
                 use by the partial match of the
                 currently executing rule
  INPUTS       : The instance address
  RETURNS      : Nothing useful
  SIDE EFFECTS : Basis count decremented and
                 basis copy (possibly) deleted
  NOTES        : When the count goes to zero, the
                 basis copy of the object (if any)
                 is deleted.
 ***************************************************/
globle void DecrementObjectBasisCount(
  void *theEnv,
  void *vins)
  {
   INSTANCE_TYPE *ins;
   long i;

   ins = (INSTANCE_TYPE *) vins;
   ins->header.busyCount--;
   if (ins->header.busyCount == 0)
     {
      if (ins->garbage)
        RemoveInstanceData(theEnv,ins);
      if (ins->cls->instanceSlotCount != 0)
        {
         for (i = 0 ; i < ins->cls->instanceSlotCount ; i++)
           if (ins->basisSlots[i].value != NULL)
             {
              if (ins->basisSlots[i].desc->multiple)
                MultifieldDeinstall(theEnv,(struct multifield *) ins->basisSlots[i].value);
              else
                AtomDeinstall(theEnv,(int) ins->basisSlots[i].type,
                              ins->basisSlots[i].value);
             }
         rm(theEnv,(void *) ins->basisSlots,
            (ins->cls->instanceSlotCount * sizeof(INSTANCE_SLOT)));
         ins->basisSlots = NULL;
        }
     }
  }

/***************************************************
  NAME         : IncrementObjectBasisCount
  DESCRIPTION  : Increments the basis count of an
                 object indicating that it is in
                 use by the partial match of the
                 currently executing rule

                 If this the count was zero,
                 allocate an array of extra
                 instance slots for use by
                 slot variables
  INPUTS       : The instance address
  RETURNS      : Nothing useful
  SIDE EFFECTS : Basis count incremented
  NOTES        : None
 ***************************************************/
globle void IncrementObjectBasisCount(
  void *theEnv,
  void *vins)
  {
   INSTANCE_TYPE *ins;
   long i;

   ins = (INSTANCE_TYPE *) vins;
   if (ins->header.busyCount == 0)
     {
      if (ins->cls->instanceSlotCount != 0)
        {
         ins->basisSlots = (INSTANCE_SLOT *)
                            gm2(theEnv,(sizeof(INSTANCE_SLOT) * ins->cls->instanceSlotCount));
         for (i = 0 ; i < ins->cls->instanceSlotCount ; i++)
           {
            ins->basisSlots[i].desc = ins->slotAddresses[i]->desc;
            ins->basisSlots[i].value = NULL;
           }
        }
     }
   ins->header.busyCount++;
  }

/***************************************************
  NAME         : MatchObjectFunction
  DESCRIPTION  : Filters an instance through the
                 object pattern network
                 Used for incremental resets in
                 binary loads and run-time modules
  INPUTS       : The instance
  RETURNS      : Nothing useful
  SIDE EFFECTS : Instance pattern-matched
  NOTES        : None
 ***************************************************/
globle void MatchObjectFunction(
  void *theEnv,
  void *vins)
  {
   ObjectNetworkAction(theEnv,OBJECT_ASSERT,(INSTANCE_TYPE *) vins,-1);
  }

/***************************************************
  NAME         : NetworkSynchronized
  DESCRIPTION  : Determines if state of instance is
                 consistent with last push through
                 pattern-matching network
  INPUTS       : The instance
  RETURNS      : TRUE if instance has not
                 changed since last push through the
                 Rete network, FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
#if IBM_TBC
#pragma argsused
#endif
globle intBool NetworkSynchronized(
  void *theEnv,
  void *vins)
  {
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#endif

   return(((INSTANCE_TYPE *) vins)->reteSynchronized);
  }
#endif

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/*****************************************************
  NAME         : FindImportedInstance
  DESCRIPTION  : Searches imported modules for an
                 instance of the correct name
                 The imports are searched recursively
                 in the order of the module definition
  INPUTS       : 1) The module for which to
                    search imported modules
                 2) The currently active module
                 3) The first instance of the
                    correct name (cannot be NULL)
  RETURNS      : An instance of the correct name
                 imported from another module which
                 is in scope of the current module
  SIDE EFFECTS : None
  NOTES        : None
 *****************************************************/
static INSTANCE_TYPE *FindImportedInstance(
  void *theEnv,
  struct defmodule *theModule,
  struct defmodule *currentModule,
  INSTANCE_TYPE *startInstance)
  {
   struct portItem *importList;
   INSTANCE_TYPE *ins;

   if (theModule->visitedFlag)
     return(NULL);
   theModule->visitedFlag = TRUE;
   importList = theModule->importList;
   while (importList != NULL)
     {
      theModule = (struct defmodule *)
                  EnvFindDefmodule(theEnv,ValueToString(importList->moduleName));
      for (ins = startInstance ;
           (ins != NULL) ? (ins->name == startInstance->name) : FALSE ;
           ins = ins->nxtHash)
        if ((ins->cls->header.whichModule->theModule == theModule) &&
             DefclassInScope(theEnv,ins->cls,currentModule))
          return(ins);
      ins = FindImportedInstance(theEnv,theModule,currentModule,startInstance);
      if (ins != NULL)
        return(ins);
      importList = importList->next;
     }

   /* ========================================================
      Make sure instances of system classes are always visible
      ======================================================== */
   for (ins = startInstance ;
        (ins != NULL) ? (ins->name == startInstance->name) : FALSE ;
        ins = ins->nxtHash)
     if (ins->cls->system)
       return(ins);

   return(NULL);
  }

#if DEFRULE_CONSTRUCT

/*****************************************************
  NAME         : NetworkModifyForSharedSlot
  DESCRIPTION  : Performs a Rete network modify for
                 all instances which contain a
                 specific shared slot
  INPUTS       : 1) The traversal id to use when
                    recursively entering subclasses
                    to prevent duplicate examinations
                    of a class
                 2) The class
                 3) The descriptor for the shared slot
  RETURNS      : Nothing useful
  SIDE EFFECTS : Instances which contain the shared
                 slot are filtered through the
                 Rete network via a retract/assert
  NOTES        : Assumes traversal id has been
                 established
 *****************************************************/
static void NetworkModifyForSharedSlot(
  void *theEnv,
  int sharedTraversalID,
  DEFCLASS *cls,
  SLOT_DESC *sd)
  {
   INSTANCE_TYPE *ins;
   long i;

   /* ================================================
      Make sure we haven't already examined this class
      ================================================ */
   if (TestTraversalID(cls->traversalRecord,sharedTraversalID))
     return;
   SetTraversalID(cls->traversalRecord,sharedTraversalID);

   /* ===========================================
      If the instances of this class contain the
      shared slot, send update events to the Rete
      network for all of its instances
      =========================================== */
   if ((sd->slotName->id > cls->maxSlotNameID) ? FALSE :
       ((cls->slotNameMap[sd->slotName->id] == 0) ? FALSE :
        (cls->instanceTemplate[cls->slotNameMap[sd->slotName->id] - 1] == sd)))
     {
      for (ins = cls->instanceList ; ins != NULL ; ins = ins->nxtClass)
        ObjectNetworkAction(theEnv,OBJECT_MODIFY,(INSTANCE_TYPE *) ins,(int) sd->slotName->id);
     }

   /* ==================================
      Check the subclasses of this class
      ================================== */
   for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
     NetworkModifyForSharedSlot(theEnv,sharedTraversalID,cls->directSubclasses.classArray[i],sd);
  }

#endif

#endif