text:    /*******************************************************/
     /*      "C" Language Integrated Production System      */
     /*                                                     */
     /*              CLIPS Version 6.24  05/17/06           */
     /*                                                     */
     /*                INSTANCE FUNCTIONS MODULE            */
     /*******************************************************/
  
  /*************************************************************/
  /* Purpose:  Internal instance manipulation routines         */
  /*                                                           */
  /* Principal Programmer(s):                                  */
  /*      Brian L. Dantes                                      */
  /*                                                           */
  /* Contributing Programmer(s):                               */
  /*                                                           */
  /*                                                           */
  /* Revision History:                                         */
  /*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
  /*                                                           */
  /*            Changed name of variable log to logName        */
  /*            because of Unix compiler warnings of shadowed  */
  /*            definitions.                                   */
  /*                                                           */
  /*            Changed name of variable exp to theExp         */
  /*            because of Unix compiler warnings of shadowed  */
  /*            definitions.                                   */
  /*                                                           */
  /*      6.24: Link error occurs for the SlotExistError       */
  /*            function when OBJECT_SYSTEM is set to 0 in     */
  /*            setup.h. DR0865                                */
  /*                                                           */
  /*            Converted INSTANCE_PATTERN_MATCHING to         */
  /*            DEFRULE_CONSTRUCT.                             */
  /*                                                           */
  /*            Renamed BOOLEAN macro type to intBool.         */
  /*                                                           */
  /*            Moved EvaluateAndStoreInDataObject to          */
  /*            evaluatn.c                                     */
  /*                                                           */
  /*************************************************************/
  
  /* =========================================
     *****************************************
                 EXTERNAL DEFINITIONS
     =========================================
     ***************************************** */
  
  #include <stdlib.h>
  
  #include "setup.h"
  
  #if OBJECT_SYSTEM
  
  #include "argacces.h"
  #include "classcom.h"
  #include "classfun.h"
  #include "cstrnchk.h"
  #include "engine.h"
  #include "envrnmnt.h"
  #include "inscom.h"
  #include "insmngr.h"
  #include "memalloc.h"
  #include "modulutl.h"
  #include "msgcom.h"
  #include "msgfun.h"
  #include "prccode.h"
  #include "router.h"
  #include "utility.h"
  
  #if DEFRULE_CONSTRUCT
  #include "drive.h"
  #include "objrtmch.h"
  #endif
  
  #define _INSFUN_SOURCE_
  #include "insfun.h"
  
  /* =========================================
     *****************************************
                     CONSTANTS
     =========================================
     ***************************************** */
  #define BIG_PRIME    11329
  
  /* =========================================
     *****************************************
        INTERNALLY VISIBLE FUNCTION HEADERS
     =========================================
     ***************************************** */
  
  static INSTANCE_TYPE *FindImportedInstance(void *,struct defmodule *,struct defmodule *,INSTANCE_TYPE *);
  
  #if DEFRULE_CONSTRUCT
  static void NetworkModifyForSharedSlot(void *,int,DEFCLASS *,SLOT_DESC *);
  #endif
  
  /* =========================================
     *****************************************
            EXTERNALLY VISIBLE FUNCTIONS
     =========================================
     ***************************************** */
  
  /***************************************************
    NAME         : EnvIncrementInstanceCount
    DESCRIPTION  : Increments instance busy count -
                     prevents it from being deleted
    INPUTS       : The address of the instance
    RETURNS      : Nothing useful
    SIDE EFFECTS : Count set
    NOTES        : None
   ***************************************************/
  globle void EnvIncrementInstanceCount(
    void *theEnv,
    void *vptr)
    {
  
     ((INSTANCE_TYPE *) vptr)->busy++;
    }
  
  /***************************************************
    NAME         : EnvDecrementInstanceCount
    DESCRIPTION  : Decrements instance busy count -
                     might allow it to be deleted
    INPUTS       : The address of the instance
    RETURNS      : Nothing useful
    SIDE EFFECTS : Count set
    NOTES        : None
   ***************************************************/
  globle void EnvDecrementInstanceCount(
    void *theEnv,
    void *vptr)
    {
  
     ((INSTANCE_TYPE *) vptr)->busy--;
    }
  
  /***************************************************
    NAME         : InitializeInstanceTable
    DESCRIPTION  : Initializes instance hash table
                    to all NULL addresses
    INPUTS       : None
    RETURNS      : Nothing useful
    SIDE EFFECTS : Hash table initialized
    NOTES        : None
   ***************************************************/
  globle void InitializeInstanceTable(
    void *theEnv)
    {
     register int i;
  
     InstanceData(theEnv)->InstanceTable = (INSTANCE_TYPE **)
                      gm2(theEnv,(int) (sizeof(INSTANCE_TYPE *) * INSTANCE_TABLE_HASH_SIZE));
     for (i = 0 ; i < INSTANCE_TABLE_HASH_SIZE ; i++)
       InstanceData(theEnv)->InstanceTable[i] = NULL;
    }
  
  /*******************************************************
    NAME         : CleanupInstances
    DESCRIPTION  : Iterates through instance garbage
                     list looking for nodes that
                     have become unused - and purges
                     them
    INPUTS       : None
    RETURNS      : Nothing useful
    SIDE EFFECTS : Non-busy instance garbage nodes deleted
    NOTES        : None
   *******************************************************/
  globle void CleanupInstances(
    void *theEnv)
    {
     IGARBAGE *gprv,*gtmp,*dump;
  
     if (InstanceData(theEnv)->MaintainGarbageInstances)
       return;
     gprv = NULL;
     gtmp = InstanceData(theEnv)->InstanceGarbageList;
     while (gtmp != NULL)
       {
        if ((gtmp->ins->busy == 0) && (gtmp->ins->depth > EvaluationData(theEnv)->CurrentEvaluationDepth)
  #if DEFRULE_CONSTRUCT
            && (gtmp->ins->header.busyCount == 0)
  #endif
           )
          {
           UtilityData(theEnv)->EphemeralItemCount -= 2;
           UtilityData(theEnv)->EphemeralItemSize -= InstanceSizeHeuristic(gtmp->ins) + sizeof(IGARBAGE);
           DecrementSymbolCount(theEnv,gtmp->ins->name);
           rtn_struct(theEnv,instance,gtmp->ins);
           if (gprv == NULL)
             InstanceData(theEnv)->InstanceGarbageList = gtmp->nxt;
           else
             gprv->nxt = gtmp->nxt;
           dump = gtmp;
           gtmp = gtmp->nxt;
           rtn_struct(theEnv,igarbage,dump);
          }
        else
          {
           gprv = gtmp;
           gtmp = gtmp->nxt;
          }
       }
    }
  
  /*******************************************************
    NAME         : HashInstance
    DESCRIPTION  : Generates a hash index for a given
                   instance name
    INPUTS       : The address of the instance name SYMBOL_HN
    RETURNS      : The hash index value
    SIDE EFFECTS : None
    NOTES        : Counts on the fact that the symbol
                   has already been hashed into the
                   symbol table - uses that hash value
                   multiplied by a prime for a new hash
   *******************************************************/
  globle unsigned HashInstance(
    SYMBOL_HN *cname)
    {
     unsigned long tally;
  
     tally = ((unsigned long) cname->bucket) * BIG_PRIME;
     return((unsigned) (tally % INSTANCE_TABLE_HASH_SIZE));
    }
  
  /***************************************************
    NAME         : DestroyAllInstances
    DESCRIPTION  : Deallocates all instances,
                    reinitializes hash table and
                    resets class instance pointers
    INPUTS       : None
    RETURNS      : Nothing useful
    SIDE EFFECTS : All instances deallocated
    NOTES        : None
   ***************************************************/
  globle void DestroyAllInstances(
    void *theEnv)
    {
     INSTANCE_TYPE *iptr;
     int svmaintain;
  
     SaveCurrentModule(theEnv);
     svmaintain = InstanceData(theEnv)->MaintainGarbageInstances;
     InstanceData(theEnv)->MaintainGarbageInstances = TRUE;
     iptr = InstanceData(theEnv)->InstanceList;
     while (iptr != NULL)
       {
        EnvSetCurrentModule(theEnv,(void *) iptr->cls->header.whichModule->theModule);
        DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,iptr,NULL,NULL);
        iptr = iptr->nxtList;
        while ((iptr != NULL) ? iptr->garbage : FALSE)
          iptr = iptr->nxtList;
       }
     InstanceData(theEnv)->MaintainGarbageInstances = svmaintain;
     RestoreCurrentModule(theEnv);
    }
  
  /******************************************************
    NAME         : RemoveInstanceData
    DESCRIPTION  : Deallocates all the data objects
                   in instance slots and then dealloactes
                   the slots themeselves
    INPUTS       : The instance
    RETURNS      : Nothing useful
    SIDE EFFECTS : Instance slots removed
    NOTES        : An instance made with CopyInstanceData
                   will have shared values removed
                   in all cases because they are not
                   "real" instances.
                   Instance class busy count decremented
   ******************************************************/
  globle void RemoveInstanceData(
    void *theEnv,
    INSTANCE_TYPE *ins)
    {
     long i;
     INSTANCE_SLOT *sp;
  
     DecrementDefclassBusyCount(theEnv,(void *) ins->cls);
     for (i = 0 ; i < ins->cls->instanceSlotCount ; i++)
       {
        sp = ins->slotAddresses[i];
        if ((sp == &sp->desc->sharedValue) ?
            (--sp->desc->sharedCount == 0) : TRUE)
          {
           if (sp->desc->multiple)
             {
              MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) sp->value);
              AddToMultifieldList(theEnv,(MULTIFIELD_PTR) sp->value);
             }
           else
             AtomDeinstall(theEnv,(int) sp->type,sp->value);
           sp->value = NULL;
          }
       }
     if (ins->cls->instanceSlotCount != 0)
       {
        rm(theEnv,(void *) ins->slotAddresses,
           (ins->cls->instanceSlotCount * sizeof(INSTANCE_SLOT *)));
        if (ins->cls->localInstanceSlotCount != 0)
          rm(theEnv,(void *) ins->slots,
             (ins->cls->localInstanceSlotCount * sizeof(INSTANCE_SLOT)));
       }
     ins->slots = NULL;
     ins->slotAddresses = NULL;
    }
  
  /***************************************************************************
    NAME         : FindInstanceBySymbol
    DESCRIPTION  : Looks up a specified instance in the instance hash table
    INPUTS       : The symbol for the name of the instance
    RETURNS      : The address of the found instance, NULL otherwise
    SIDE EFFECTS : None
    NOTES        : An instance is searched for by name first in the
                   current module - then in imported modules according
                   to the order given in the current module's definition
   ***************************************************************************/
  globle INSTANCE_TYPE *FindInstanceBySymbol(
    void *theEnv,
    SYMBOL_HN *moduleAndInstanceName)
    {
     unsigned modulePosition,searchImports;
     SYMBOL_HN *moduleName,*instanceName;
     struct defmodule *currentModule,*theModule;
  
     currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
  
     /* =======================================
        Instance names of the form [<name>] are
        searched for only in the current module
        ======================================= */
     modulePosition = FindModuleSeparator(ValueToString(moduleAndInstanceName));
     if (modulePosition == FALSE)
       {
        theModule = currentModule;
        instanceName = moduleAndInstanceName;
        searchImports = FALSE;
       }
  
     /* =========================================
        Instance names of the form [::<name>] are
        searched for in the current module and
        imported modules in the definition order
        ========================================= */
     else if (modulePosition == 1)
       {
        theModule = currentModule;
        instanceName = ExtractConstructName(theEnv,modulePosition,ValueToString(moduleAndInstanceName));
        searchImports = TRUE;
       }
  
     /* =============================================
        Instance names of the form [<module>::<name>]
        are searched for in the specified module
        ============================================= */
     else
       {
        moduleName = ExtractModuleName(theEnv,modulePosition,ValueToString(moduleAndInstanceName));
        theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName));
        instanceName = ExtractConstructName(theEnv,modulePosition,ValueToString(moduleAndInstanceName));
        if (theModule == NULL)
          return(NULL);
        searchImports = FALSE;
       }
     return(FindInstanceInModule(theEnv,instanceName,theModule,currentModule,searchImports));
    }
  
  /***************************************************
    NAME         : FindInstanceInModule
    DESCRIPTION  : Finds an instance of the given name
                   in the given module in scope of
                   the given current module
                   (will also search imported modules
                    if specified)
    INPUTS       : 1) The instance name (no module)
                   2) The module to search
                   3) The currently active module
                   4) A flag indicating whether
                      to search imported modules of
                      given module as well
    RETURNS      : The instance (NULL if none found)
    SIDE EFFECTS : None
    NOTES        : None
   ***************************************************/
  globle INSTANCE_TYPE *FindInstanceInModule(
    void *theEnv,
    SYMBOL_HN *instanceName,
    struct defmodule *theModule,
    struct defmodule *currentModule,
    unsigned searchImports)
    {
     INSTANCE_TYPE *startInstance,*ins;
  
     /* ===============================
        Find the first instance of the
        correct name in the hash chain
        =============================== */
     startInstance = InstanceData(theEnv)->InstanceTable[HashInstance(instanceName)];
     while (startInstance != NULL)
       {
        if (startInstance->name == instanceName)
          break;
        startInstance = startInstance->nxtHash;
       }
  
     if (startInstance == NULL)
       return(NULL);
  
     /* ===========================================
        Look for the instance in the specified
        module - if the class of the found instance
        is in scope of the current module, we have
        found the instance
        =========================================== */
     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);
  
     /* ================================
        For ::<name> formats, we need to
        search imported modules too
        ================================ */
     if (searchImports == FALSE)
       return(NULL);
     MarkModulesAsUnvisited(theEnv);
     return(FindImportedInstance(theEnv,theModule,currentModule,startInstance));
    }
  
  /********************************************************************
    NAME         : FindInstanceSlot
    DESCRIPTION  : Finds an instance slot by name
    INPUTS       : 1) The address of the instance
                   2) The symbolic name of the slot
    RETURNS      : The address of the slot, NULL if not found
    SIDE EFFECTS : None
    NOTES        : None
   ********************************************************************/
  globle INSTANCE_SLOT *FindInstanceSlot(
    void *theEnv,
    INSTANCE_TYPE *ins,
    SYMBOL_HN *sname)
    {
     register int i;
  
     i = FindInstanceTemplateSlot(theEnv,ins->cls,sname);
     return((i != -1) ? ins->slotAddresses[i] : NULL);
    }
  
  /********************************************************************
    NAME         : FindInstanceTemplateSlot
    DESCRIPTION  : Performs a search on an class's instance
                     template slot array to find a slot by name
    INPUTS       : 1) The address of the class
                   2) The symbolic name of the slot
    RETURNS      : The index of the slot, -1 if not found
    SIDE EFFECTS : None
    NOTES        : The slot's unique id is used as index into
                   the slot map array.
   ********************************************************************/
  globle int FindInstanceTemplateSlot(
    void *theEnv,
    DEFCLASS *cls,
    SYMBOL_HN *sname)
    {
     int sid;
  
     sid = FindSlotNameID(theEnv,sname);
     if (sid == -1)
       return(-1);
     if (sid > (int) cls->maxSlotNameID)
       return(-1);
     return((int) cls->slotNameMap[sid] - 1);
    }
  
  /*******************************************************
    NAME         : PutSlotValue
    DESCRIPTION  : Evaluates new slot-expression and
                     stores it as a multifield
                     variable for the slot.
    INPUTS       : 1) The address of the instance
                      (NULL if no trace-messages desired)
                   2) The address of the slot
                   3) The address of the value
                   4) DATA_OBJECT_PTR to store the
                      set value
                   5) The command doing the put-
    RETURNS      : FALSE on errors, or TRUE
    SIDE EFFECTS : Old value deleted and new one allocated
                   Old value symbols deinstalled
                   New value symbols installed
    NOTES        : None
   *******************************************************/
  globle int PutSlotValue(
    void *theEnv,
    INSTANCE_TYPE *ins,
    INSTANCE_SLOT *sp,
    DATA_OBJECT *val,
    DATA_OBJECT *setVal,
    char *theCommand)
    {
     if (ValidSlotValue(theEnv,val,sp->desc,ins,theCommand) == FALSE)
       {
        SetpType(setVal,SYMBOL);
        SetpValue(setVal,EnvFalseSymbol(theEnv));
        return(FALSE);
       }
     return(DirectPutSlotValue(theEnv,ins,sp,val,setVal));
    }
  
  /*******************************************************
    NAME         : DirectPutSlotValue
    DESCRIPTION  : Evaluates new slot-expression and
                     stores it as a multifield
                     variable for the slot.
    INPUTS       : 1) The address of the instance
                      (NULL if no trace-messages desired)
                   2) The address of the slot
                   3) The address of the value
                   4) DATA_OBJECT_PTR to store the
                      set value
    RETURNS      : FALSE on errors, or TRUE
    SIDE EFFECTS : Old value deleted and new one allocated
                   Old value symbols deinstalled
                   New value symbols installed
    NOTES        : None
   *******************************************************/
  globle int DirectPutSlotValue(
    void *theEnv,
    INSTANCE_TYPE *ins,
    INSTANCE_SLOT *sp,
    DATA_OBJECT *val,
    DATA_OBJECT *setVal)
    {
     register long i,j; /* 6.04 Bug Fix */
  #if DEFRULE_CONSTRUCT
     int sharedTraversalID;
     INSTANCE_SLOT *bsp,**spaddr;
  #endif
     DATA_OBJECT tmpVal;
  
     SetpType(setVal,SYMBOL);
     SetpValue(setVal,EnvFalseSymbol(theEnv));
     if (val == NULL)
       {
        SystemError(theEnv,(char*)"INSFUN",1);
        EnvExitRouter(theEnv,EXIT_FAILURE);
       }
     else if (GetpValue(val) == ProceduralPrimitiveData(theEnv)->NoParamValue)
       {
        if (sp->desc->dynamicDefault)
          {
           val = &tmpVal;
           if (!EvaluateAndStoreInDataObject(theEnv,sp->desc->multiple,
                                             (EXPRESSION *) sp->desc->defaultValue,val,TRUE))
             return(FALSE);
          }
        else
          val = (DATA_OBJECT *) sp->desc->defaultValue;
       }
  #if DEFRULE_CONSTRUCT
     if (EngineData(theEnv)->JoinOperationInProgress && sp->desc->reactive &&
         (ins->cls->reactive || sp->desc->shared))
       {
        PrintErrorID(theEnv,(char*)"INSFUN",5,FALSE);
        EnvPrintRouter(theEnv,WERROR,(char*)"Cannot modify reactive instance slots while\n");
        EnvPrintRouter(theEnv,WERROR,(char*)"  pattern-matching is in process.\n");
        SetEvaluationError(theEnv,TRUE);
        return(FALSE);
       }
  
     /* =============================================
        If we are about to change a slot of an object
        which is a basis for a firing rule, we need
        to make sure that slot is copied first
        ============================================= */
     if (ins->basisSlots != NULL)
       {
        spaddr = &ins->slotAddresses[ins->cls->slotNameMap[sp->desc->slotName->id] - 1];
        bsp = ins->basisSlots + (spaddr - ins->slotAddresses);
        if (bsp->value == NULL)
          {
           bsp->type = sp->type;
           bsp->value = sp->value;
           if (sp->desc->multiple)
             MultifieldInstall(theEnv,(MULTIFIELD_PTR) bsp->value);
           else
             AtomInstall(theEnv,(int) bsp->type,bsp->value);
          }
       }
  
  #endif
     if (sp->desc->multiple == 0)
       {
        AtomDeinstall(theEnv,(int) sp->type,sp->value);
  
        /* ======================================
           Assumed that multfield already checked
           to be of cardinality 1
           ====================================== */
        if (GetpType(val) == MULTIFIELD)
          {
           sp->type = GetMFType(GetpValue(val),GetpDOBegin(val));
           sp->value = GetMFValue(GetpValue(val),GetpDOBegin(val));
          }
        else
          {
           sp->type = val->type;
           sp->value = val->value;
          }
        AtomInstall(theEnv,(int) sp->type,sp->value);
        SetpType(setVal,sp->type);
        SetpValue(setVal,sp->value);
       }
     else
       {
        MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) sp->value);
        AddToMultifieldList(theEnv,(MULTIFIELD_PTR) sp->value);
        sp->type = MULTIFIELD;
        if (val->type == MULTIFIELD)
          {
           sp->value = CreateMultifield2(theEnv,(unsigned long) GetpDOLength(val));
           for (i = 1 , j = GetpDOBegin(val) ; i <= GetpDOLength(val) ; i++ , j++)
             {
              SetMFType(sp->value,i,GetMFType(val->value,j));
              SetMFValue(sp->value,i,GetMFValue(val->value,j));
             }
          }
        else
          {
           sp->value = CreateMultifield2(theEnv,1L);
           SetMFType(sp->value,1,(short) val->type);
           SetMFValue(sp->value,1,val->value);
          }
        MultifieldInstall(theEnv,(struct multifield *) sp->value);
        SetpType(setVal,MULTIFIELD);
        SetpValue(setVal,sp->value);
        SetpDOBegin(setVal,1);
        SetpDOEnd(setVal,GetMFLength(sp->value));
       }
     /* ==================================================
        6.05 Bug fix - any slot set directly or indirectly
        by a slot override or other side-effect during an
        instance initialization should not have its
        default value set
        ================================================== */
  
     sp->override = ins->initializeInProgress;
  
  #if DEBUGGING_FUNCTIONS
     if (ins->cls->traceSlots)
       {
        if (sp->desc->shared)
          EnvPrintRouter(theEnv,WTRACE,(char*)"::= shared slot ");
        else
          EnvPrintRouter(theEnv,WTRACE,(char*)"::= local slot ");
        EnvPrintRouter(theEnv,WTRACE,ValueToString(sp->desc->slotName->name));
        EnvPrintRouter(theEnv,WTRACE,(char*)" in instance ");
        EnvPrintRouter(theEnv,WTRACE,ValueToString(ins->name));
        EnvPrintRouter(theEnv,WTRACE,(char*)" <- ");
        if (sp->type != MULTIFIELD)
          PrintAtom(theEnv,WTRACE,(int) sp->type,sp->value);
        else
          PrintMultifield(theEnv,WTRACE,(MULTIFIELD_PTR) sp->value,0,
                          (long) (GetInstanceSlotLength(sp) - 1),TRUE);
        EnvPrintRouter(theEnv,WTRACE,(char*)"\n");
       }
  #endif
     InstanceData(theEnv)->ChangesToInstances = TRUE;
  
  #if DEFRULE_CONSTRUCT
     if (ins->cls->reactive && sp->desc->reactive)
       {
        /* ============================================
           If we have changed a shared slot, we need to
           perform a Rete update for every instance
           which contains this slot
           ============================================ */
        if (sp->desc->shared)
          {
           sharedTraversalID = GetTraversalID(theEnv);
           if (sharedTraversalID != -1)
             {
              NetworkModifyForSharedSlot(theEnv,sharedTraversalID,sp->desc->cls,sp->desc);
              ReleaseTraversalID(theEnv);
             }
           else
             {
              PrintErrorID(theEnv,(char*)"INSFUN",6,FALSE);
              EnvPrintRouter(theEnv,WERROR,(char*)"Unable to pattern-match on shared slot ");
              EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name));
              EnvPrintRouter(theEnv,WERROR,(char*)" in class ");
              EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) sp->desc->cls));
              EnvPrintRouter(theEnv,WERROR,(char*)".\n");
             }
          }
        else
          ObjectNetworkAction(theEnv,OBJECT_MODIFY,(INSTANCE_TYPE *) ins,(int) sp->desc->slotName->id);
       }
  #endif
  
     return(TRUE);
    }
  
  /*******************************************************************
    NAME         : ValidSlotValue
    DESCRIPTION  : Determines if a value is appropriate
                     for a slot-value
    INPUTS       : 1) The value buffer
                   2) Slot descriptor
                   3) Instance for which slot is being checked
                      (can be NULL)
                   4) Buffer holding printout of the offending command
                      (if NULL assumes message-handler is executing
                       and calls PrintHandler for CurrentCore instead)
    RETURNS      : TRUE if value is OK, FALSE otherwise
    SIDE EFFECTS : Sets EvaluationError if slot is not OK
    NOTES        : Examines all fields of a multi-field
   *******************************************************************/
  globle int ValidSlotValue(
    void *theEnv,
    DATA_OBJECT *val,
    SLOT_DESC *sd,
    INSTANCE_TYPE *ins,
    char *theCommand)
    {
     register int violationCode;
  
     /* ===================================
        Special NoParamValue means to reset
        slot to default value
        =================================== */
     if (GetpValue(val) == ProceduralPrimitiveData(theEnv)->NoParamValue)
       return(TRUE);
     if ((sd->multiple == 0) && (val->type == MULTIFIELD) &&
                                (GetpDOLength(val) != 1))
       {
        PrintErrorID(theEnv,(char*)"INSFUN",7,FALSE);
        PrintDataObject(theEnv,WERROR,val);
        EnvPrintRouter(theEnv,WERROR,(char*)" illegal for single-field ");
        PrintSlot(theEnv,WERROR,sd,ins,theCommand);
        EnvPrintRouter(theEnv,WERROR,(char*)".\n");
        SetEvaluationError(theEnv,TRUE);
        return(FALSE);
       }
     if (val->type == RVOID)
       {
        PrintErrorID(theEnv,(char*)"INSFUN",8,FALSE);
        EnvPrintRouter(theEnv,WERROR,(char*)"Void function illegal value for ");
        PrintSlot(theEnv,WERROR,sd,ins,theCommand);
        EnvPrintRouter(theEnv,WERROR,(char*)".\n");
        SetEvaluationError(theEnv,TRUE);
        return(FALSE);
       }
     if (EnvGetDynamicConstraintChecking(theEnv))
       {
        violationCode = ConstraintCheckDataObject(theEnv,val,sd->constraint);
        if (violationCode != NO_VIOLATION)
          {
           PrintErrorID(theEnv,(char*)"CSTRNCHK",1,FALSE);
           if ((GetpType(val) == MULTIFIELD) && (sd->multiple == 0))
             PrintAtom(theEnv,WERROR,GetMFType(GetpValue(val),GetpDOBegin(val)),
                              GetMFValue(GetpValue(val),GetpDOEnd(val)));
           else
             PrintDataObject(theEnv,WERROR,val);
           EnvPrintRouter(theEnv,WERROR,(char*)" for ");
           PrintSlot(theEnv,WERROR,sd,ins,theCommand);
           ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0,
                                           violationCode,sd->constraint,FALSE);
           SetEvaluationError(theEnv,TRUE);
           return(FALSE);
          }
       }
     return(TRUE);
    }
  
  /********************************************************
    NAME         : CheckInstance
    DESCRIPTION  : Checks to see if the first argument to
                   a function is a valid instance
    INPUTS       : Name of the calling function
    RETURNS      : The address of the instance
    SIDE EFFECTS : EvaluationError set and messages printed
                   on errors
    NOTES        : Used by Initialize and ModifyInstance
   ********************************************************/
  globle INSTANCE_TYPE *CheckInstance(
    void *theEnv,
    char *func)
    {
     INSTANCE_TYPE *ins;
     DATA_OBJECT temp;
  
     EvaluateExpression(theEnv,GetFirstArgument(),&temp);
     if (temp.type == INSTANCE_ADDRESS)
       {
        ins = (INSTANCE_TYPE *) temp.value;
        if (ins->garbage == 1)
          {
           StaleInstanceAddress(theEnv,func,0);
           SetEvaluationError(theEnv,TRUE);
           return(NULL);
          }
       }
     else if ((temp.type == INSTANCE_NAME) ||
              (temp.type == SYMBOL))
       {
        ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value);
        if (ins == NULL)
          {
           NoInstanceError(theEnv,ValueToString(temp.value),func);
           return(NULL);
          }
       }
     else
       {
        PrintErrorID(theEnv,(char*)"INSFUN",1,FALSE);
        EnvPrintRouter(theEnv,WERROR,(char*)"Expected a valid instance in function ");
        EnvPrintRouter(theEnv,WERROR,func);
        EnvPrintRouter(theEnv,WERROR,(char*)".\n");
        SetEvaluationError(theEnv,TRUE);
        return(NULL);
       }
     return(ins);
    }
  
  /***************************************************
    NAME         : NoInstanceError
    DESCRIPTION  : Prints out an appropriate error
                    message when an instance cannot be
                    found for a function
    INPUTS       : 1) The instance name
                   2) The function name
    RETURNS      : Nothing useful
    SIDE EFFECTS : None
    NOTES        : None
   ***************************************************/
  globle void NoInstanceError(
    void *theEnv,
    char *iname,
    char *func)
    {
     PrintErrorID(theEnv,(char*)"INSFUN",2,FALSE);
     EnvPrintRouter(theEnv,WERROR,(char*)"No such instance ");
     EnvPrintRouter(theEnv,WERROR,iname);
     EnvPrintRouter(theEnv,WERROR,(char*)" in function ");
     EnvPrintRouter(theEnv,WERROR,func);
     EnvPrintRouter(theEnv,WERROR,(char*)".\n");
     SetEvaluationError(theEnv,TRUE);
    }
  
  /***************************************************
    NAME         : StaleInstanceAddress
    DESCRIPTION  : Prints out an appropriate error
                    message when an instance address
                    is no longer valid
    INPUTS       : The function name
    RETURNS      : Nothing useful
    SIDE EFFECTS : None
    NOTES        : None
   ***************************************************/
  globle void StaleInstanceAddress(
    void *theEnv,
    char *func,
    int whichArg)
    {
     PrintErrorID(theEnv,(char*)"INSFUN",4,FALSE);
     EnvPrintRouter(theEnv,WERROR,(char*)"Invalid instance-address in function ");
     EnvPrintRouter(theEnv,WERROR,func);
     if (whichArg > 0)
       {
        EnvPrintRouter(theEnv,WERROR,(char*)", argument #");
        PrintLongInteger(theEnv,WERROR,(long long) whichArg);
       }
     EnvPrintRouter(theEnv,WERROR,(char*)".\n");
    }
  
  /**********************************************************************
    NAME         : EnvGetInstancesChanged
    DESCRIPTION  : Returns whether instances have changed
                     (any were added/deleted or slot values were changed)
                     since last time flag was set to FALSE
    INPUTS       : None
    RETURNS      : The instances-changed flag
    SIDE EFFECTS : None
    NOTES        : Used by interfaces to update instance windows
   **********************************************************************/
  globle int EnvGetInstancesChanged(
    void *theEnv)
    {
     return(InstanceData(theEnv)->ChangesToInstances);
    }
  
  /*******************************************************
    NAME         : EnvSetInstancesChanged
    DESCRIPTION  : Sets instances-changed flag (see above)
    INPUTS       : The value (TRUE or FALSE)
    RETURNS      : Nothing useful
    SIDE EFFECTS : The flag is set
    NOTES        : None
   *******************************************************/
  globle void EnvSetInstancesChanged(
    void *theEnv,
    int changed)
    {
     InstanceData(theEnv)->ChangesToInstances = changed;
    }
  
  /*******************************************************************
    NAME         : PrintSlot
    DESCRIPTION  : Displays the name and origin of a slot
    INPUTS       : 1) The logical output name
                   2) The slot descriptor
                   3) The instance source (can be NULL)
                   4) Buffer holding printout of the offending command
                      (if NULL assumes message-handler is executing
                       and calls PrintHandler for CurrentCore instead)
    RETURNS      : Nothing useful
    SIDE EFFECTS : Message printed
    NOTES        : None
   *******************************************************************/
  globle void PrintSlot(
    void *theEnv,
    char *logName,
    SLOT_DESC *sd,
    INSTANCE_TYPE *ins,
    char *theCommand)
    {
     EnvPrintRouter(theEnv,logName,(char*)"slot ");
     EnvPrintRouter(theEnv,logName,ValueToString(sd->slotName->name));
     if (ins != NULL)
       {
        EnvPrintRouter(theEnv,logName,(char*)" of instance [");
        EnvPrintRouter(theEnv,logName,ValueToString(ins->name));
        EnvPrintRouter(theEnv,logName,(char*)"]");
       }
     else if (sd->cls != NULL)
       {
        EnvPrintRouter(theEnv,logName,(char*)" of class ");
        EnvPrintRouter(theEnv,logName,EnvGetDefclassName(theEnv,(void *) sd->cls));
       }
     EnvPrintRouter(theEnv,logName,(char*)" found in ");
     if (theCommand != NULL)
       EnvPrintRouter(theEnv,logName,theCommand);
     else
       PrintHandler(theEnv,logName,MessageHandlerData(theEnv)->CurrentCore->hnd,FALSE);
    }
  
  /*****************************************************
    NAME         : PrintInstanceNameAndClass
    DESCRIPTION  : Displays an instance's name and class
    INPUTS       : 1) Logical name of output
                   2) The instance
                   3) Flag indicating whether to
                      print carriage-return at end
    RETURNS      : Nothing useful
    SIDE EFFECTS : Instnace name and class printed
    NOTES        : None
   *****************************************************/
  globle void PrintInstanceNameAndClass(
    void *theEnv,
    char *logicalName,
    INSTANCE_TYPE *theInstance,
    intBool linefeedFlag)
    {
     EnvPrintRouter(theEnv,logicalName,(char*)"[");
     EnvPrintRouter(theEnv,logicalName,EnvGetInstanceName(theEnv,(void *) theInstance));
     EnvPrintRouter(theEnv,logicalName,(char*)"] of ");
     PrintClassName(theEnv,logicalName,theInstance->cls,linefeedFlag);
    }
    
  /***************************************************
    NAME         : PrintInstanceName
    DESCRIPTION  : Used by the rule system commands
                   such as (matches) and (agenda)
                   to print out the name of an instance
    INPUTS       : 1) The logical output name
                   2) A pointer to the instance
    RETURNS      : Nothing useful
    SIDE EFFECTS : Name of instance printed
    NOTES        : None
   ***************************************************/
  globle void PrintInstanceName(
    void *theEnv,
    char *logName,
    void *vins)
    {
     INSTANCE_TYPE *ins;
  
     ins = (INSTANCE_TYPE *) vins;
     if (ins->garbage)
       {
        EnvPrintRouter(theEnv,logName,(char*)"<stale instance [");
        EnvPrintRouter(theEnv,logName,ValueToString(ins->name));
        EnvPrintRouter(theEnv,logName,(char*)"]>");
       }
     else
       {
        EnvPrintRouter(theEnv,logName,(char*)"[");
        EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins)));
        EnvPrintRouter(theEnv,logName,(char*)"]");
       }
    }
    
  /***************************************************
    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,(char*)"\"<Dummy Instance>\"");
        else
          {
           EnvPrintRouter(theEnv,logName,(char*)"[");
           EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins)));
           EnvPrintRouter(theEnv,logName,(char*)"]");
          }
       }
     else
       {
        if (PrintUtilityData(theEnv)->AddressesToStrings)
          EnvPrintRouter(theEnv,logName,(char*)"\"");
        if (ins == &InstanceData(theEnv)->DummyInstance)
          EnvPrintRouter(theEnv,logName,(char*)"<Dummy Instance>");
        else if (ins->garbage)
          {
           EnvPrintRouter(theEnv,logName,(char*)"<Stale Instance-");
           EnvPrintRouter(theEnv,logName,ValueToString(ins->name));
           EnvPrintRouter(theEnv,logName,(char*)">");
          }
        else
          {
           EnvPrintRouter(theEnv,logName,(char*)"<Instance-");
           EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins)));
           EnvPrintRouter(theEnv,logName,(char*)">");
          }
        if (PrintUtilityData(theEnv)->AddressesToStrings)
          EnvPrintRouter(theEnv,logName,(char*)"\"");
       }
    }
  
  #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
   ***************************************************/
  globle intBool NetworkSynchronized(
    void *theEnv,
    void *vins)
    {
  
     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
  
  
  