src/clipsrules/core/insmngr.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*              CLIPS Version 6.24  05/17/06           */
00005    /*                                                     */
00006    /*            INSTANCE PRIMITIVE SUPPORT MODULE        */
00007    /*******************************************************/
00008 
00009 /*************************************************************/
00010 /* Purpose:  Creation and Deletion of Instances Routines     */
00011 /*                                                           */
00012 /* Principal Programmer(s):                                  */
00013 /*      Brian L. Dantes                                      */
00014 /*                                                           */
00015 /* Contributing Programmer(s):                               */
00016 /*                                                           */
00017 /*                                                           */
00018 /* Revision History:                                         */
00019 /*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
00020 /*                                                           */
00021 /*      6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */
00022 /*                                                           */
00023 /*            Converted INSTANCE_PATTERN_MATCHING to         */
00024 /*            DEFRULE_CONSTRUCT.                             */
00025 /*                                                           */
00026 /*            Renamed BOOLEAN macro type to intBool.         */
00027 /*                                                           */
00028 /*************************************************************/
00029 
00030 /* =========================================
00031    *****************************************
00032                EXTERNAL DEFINITIONS
00033    =========================================
00034    ***************************************** */
00035 #include "setup.h"
00036 
00037 #if OBJECT_SYSTEM
00038 
00039 #if DEFRULE_CONSTRUCT
00040 #include "network.h"
00041 #include "drive.h"
00042 #include "objrtmch.h"
00043 #include "lgcldpnd.h"
00044 #endif
00045 
00046 #include "classcom.h"
00047 #include "classfun.h"
00048 #include "engine.h"
00049 #include "envrnmnt.h"
00050 #include "memalloc.h"
00051 #include "extnfunc.h"
00052 #include "insfun.h"
00053 #include "modulutl.h"
00054 #include "msgcom.h"
00055 #include "msgfun.h"
00056 #include "prccode.h"
00057 #include "router.h"
00058 #include "sysdep.h"
00059 #include "utility.h"
00060 
00061 #define _INSMNGR_SOURCE_
00062 #include "insmngr.h"
00063 
00064 #include "inscom.h"
00065 #include "watch.h"
00066 
00067 /* =========================================
00068    *****************************************
00069                    CONSTANTS
00070    =========================================
00071    ***************************************** */
00072 #define MAKE_TRACE   "==>"
00073 #define UNMAKE_TRACE "<=="
00074 
00075 /* =========================================
00076    *****************************************
00077       INTERNALLY VISIBLE FUNCTION HEADERS
00078    =========================================
00079    ***************************************** */
00080 
00081 static INSTANCE_TYPE *NewInstance(void *);
00082 static INSTANCE_TYPE *InstanceLocationInfo(void *,DEFCLASS *,SYMBOL_HN *,INSTANCE_TYPE **,
00083                                            unsigned *);
00084 static void InstallInstance(void *,INSTANCE_TYPE *,int);
00085 static void BuildDefaultSlots(void *,intBool);
00086 static int CoreInitializeInstance(void *,INSTANCE_TYPE *,EXPRESSION *);
00087 static int InsertSlotOverrides(void *,INSTANCE_TYPE *,EXPRESSION *);
00088 static void EvaluateClassDefaults(void *,INSTANCE_TYPE *);
00089 
00090 #if DEBUGGING_FUNCTIONS
00091 static void PrintInstanceWatch(void *,char *,INSTANCE_TYPE *);
00092 #endif
00093 
00094 /* =========================================
00095    *****************************************
00096           EXTERNALLY VISIBLE FUNCTIONS
00097    =========================================
00098    ***************************************** */
00099 
00100 /***********************************************************
00101   NAME         : InitializeInstanceCommand
00102   DESCRIPTION  : Initializes an instance of a class
00103   INPUTS       : The address of the result value
00104   RETURNS      : Nothing useful
00105   SIDE EFFECTS : Instance intialized
00106   NOTES        : H/L Syntax:
00107                  (active-initialize-instance <instance-name>
00108                     <slot-override>*)
00109  ***********************************************************/
00110 globle void InitializeInstanceCommand(
00111   void *theEnv,
00112   DATA_OBJECT *result)
00113   {
00114    INSTANCE_TYPE *ins;
00115 
00116    SetpType(result,SYMBOL);
00117    SetpValue(result,EnvFalseSymbol(theEnv));
00118    ins = CheckInstance(theEnv,"initialize-instance");
00119    if (ins == NULL)
00120      return;
00121    if (CoreInitializeInstance(theEnv,ins,GetFirstArgument()->nextArg) == TRUE)
00122      {
00123       SetpType(result,INSTANCE_NAME);
00124       SetpValue(result,(void *) ins->name);
00125      }
00126   }
00127 
00128 /****************************************************************
00129   NAME         : MakeInstanceCommand
00130   DESCRIPTION  : Creates and initializes an instance of a class
00131   INPUTS       : The address of the result value
00132   RETURNS      : Nothing useful
00133   SIDE EFFECTS : Instance intialized
00134   NOTES        : H/L Syntax:
00135                  (active-make-instance <instance-name> of <class>
00136                     <slot-override>*)
00137  ****************************************************************/
00138 globle void MakeInstanceCommand(
00139   void *theEnv,
00140   DATA_OBJECT *result)
00141   {
00142    SYMBOL_HN *iname;
00143    INSTANCE_TYPE *ins;
00144    DATA_OBJECT temp;
00145    DEFCLASS *cls;
00146 
00147    SetpType(result,SYMBOL);
00148    SetpValue(result,EnvFalseSymbol(theEnv));
00149    EvaluateExpression(theEnv,GetFirstArgument(),&temp);
00150    if ((GetType(temp) != SYMBOL) &&
00151        (GetType(temp) != INSTANCE_NAME))
00152      {
00153       PrintErrorID(theEnv,"INSMNGR",1,FALSE);
00154       EnvPrintRouter(theEnv,WERROR,"Expected a valid name for new instance.\n");
00155       SetEvaluationError(theEnv,TRUE);
00156       return;
00157      }
00158    iname = (SYMBOL_HN *) GetValue(temp);
00159 
00160    if (GetFirstArgument()->nextArg->type == DEFCLASS_PTR)
00161      cls = (DEFCLASS *) GetFirstArgument()->nextArg->value;
00162    else
00163      {
00164       EvaluateExpression(theEnv,GetFirstArgument()->nextArg,&temp);
00165       if (GetType(temp) != SYMBOL)
00166         {
00167          PrintErrorID(theEnv,"INSMNGR",2,FALSE);
00168          EnvPrintRouter(theEnv,WERROR,"Expected a valid class name for new instance.\n");
00169          SetEvaluationError(theEnv,TRUE);
00170          return;
00171         }
00172       cls = LookupDefclassInScope(theEnv,DOToString(temp));
00173       if (cls == NULL)
00174         {
00175          ClassExistError(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
00176                          DOToString(temp));
00177          SetEvaluationError(theEnv,TRUE);
00178          return;
00179         }
00180      }
00181 
00182    ins = BuildInstance(theEnv,iname,cls,TRUE);
00183    if (ins == NULL)
00184      return;
00185      
00186    if (CoreInitializeInstance(theEnv,ins,GetFirstArgument()->nextArg->nextArg) == TRUE)
00187      {
00188       result->type = INSTANCE_NAME;
00189       result->value = (void *) GetFullInstanceName(theEnv,ins);
00190      }
00191    else
00192      QuashInstance(theEnv,ins);
00193   }
00194 
00195 /***************************************************
00196   NAME         : GetFullInstanceName
00197   DESCRIPTION  : If this function is called while
00198                  the current module is other than
00199                  the one in which the instance
00200                  resides, then the module name is
00201                  prepended to the instance name.
00202                  Otherwise - the base name only is
00203                  returned.
00204   INPUTS       : The instance
00205   RETURNS      : The instance name symbol (with
00206                  module name and :: prepended)
00207   SIDE EFFECTS : Temporary buffer allocated possibly
00208                  and new symbol created
00209   NOTES        : Used to differentiate between
00210                  instances of the same name in
00211                  different modules
00212  ***************************************************/
00213 globle SYMBOL_HN *GetFullInstanceName(
00214   void *theEnv,
00215   INSTANCE_TYPE *ins)
00216   {
00217    char *moduleName,*buffer;
00218    size_t bufsz;
00219    SYMBOL_HN *iname;
00220 
00221    if (ins == &InstanceData(theEnv)->DummyInstance)
00222      return((SYMBOL_HN *) EnvAddSymbol(theEnv,"Dummy Instance"));
00223    if (ins->garbage)
00224      return(ins->name);
00225    if (ins->cls->header.whichModule->theModule == ((struct defmodule *) EnvGetCurrentModule(theEnv)))
00226      return(ins->name);
00227    moduleName = EnvGetDefmoduleName(theEnv,(void *) ins->cls->header.whichModule->theModule);
00228    bufsz = (sizeof(char) * (strlen(moduleName) +
00229                                   strlen(ValueToString(ins->name)) + 3));
00230    buffer = (char *) gm2(theEnv,bufsz);
00231    gensprintf(buffer,"%s::%s",moduleName,ValueToString(ins->name));
00232    iname = (SYMBOL_HN *) EnvAddSymbol(theEnv,buffer);
00233    rm(theEnv,(void *) buffer,bufsz);
00234    return(iname);
00235   }
00236 
00237 /***************************************************
00238   NAME         : BuildInstance
00239   DESCRIPTION  : Creates an uninitialized instance
00240   INPUTS       : 1) Name of the instance
00241                  2) Class pointer
00242                  3) Flag indicating whether init
00243                     message will be called for
00244                     this instance or not
00245   RETURNS      : The address of the new instance,
00246                    NULL on errors (or when a
00247                    a logical basis in a rule was
00248                    deleted int the same RHS in
00249                    which the instance creation
00250                    occurred)
00251   SIDE EFFECTS : Old definition (if any) is deleted
00252   NOTES        : None
00253  ***************************************************/
00254 globle INSTANCE_TYPE *BuildInstance(
00255   void *theEnv,
00256   SYMBOL_HN *iname,
00257   DEFCLASS *cls,
00258   intBool initMessage)
00259   {
00260    INSTANCE_TYPE *ins,*iprv;
00261    unsigned hashTableIndex;
00262    unsigned modulePosition;
00263    SYMBOL_HN *moduleName;
00264    DATA_OBJECT temp;
00265 
00266 #if DEFRULE_CONSTRUCT
00267    if (EngineData(theEnv)->JoinOperationInProgress && cls->reactive)
00268      {
00269       PrintErrorID(theEnv,"INSMNGR",10,FALSE);
00270       EnvPrintRouter(theEnv,WERROR,"Cannot create instances of reactive classes while\n");
00271       EnvPrintRouter(theEnv,WERROR,"  pattern-matching is in process.\n");
00272       SetEvaluationError(theEnv,TRUE);
00273       return(NULL);
00274      }
00275 #endif
00276    if (cls->abstract)
00277      {
00278       PrintErrorID(theEnv,"INSMNGR",3,FALSE);
00279       EnvPrintRouter(theEnv,WERROR,"Cannot create instances of abstract class ");
00280       EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls));
00281       EnvPrintRouter(theEnv,WERROR,".\n");
00282       SetEvaluationError(theEnv,TRUE);
00283       return(NULL);
00284      }
00285    modulePosition = FindModuleSeparator(ValueToString(iname));
00286    if (modulePosition)
00287      {
00288       moduleName = ExtractModuleName(theEnv,modulePosition,ValueToString(iname));
00289       if ((moduleName == NULL) ||
00290           (moduleName != cls->header.whichModule->theModule->name))
00291         {
00292          PrintErrorID(theEnv,"INSMNGR",11,TRUE);
00293          EnvPrintRouter(theEnv,WERROR,"Invalid module specifier in new instance name.\n");
00294          SetEvaluationError(theEnv,TRUE);
00295          return(NULL);
00296         }
00297       iname = ExtractConstructName(theEnv,modulePosition,ValueToString(iname));
00298      }
00299    ins = InstanceLocationInfo(theEnv,cls,iname,&iprv,&hashTableIndex);
00300    if (ins != NULL)
00301      {
00302       if (ins->installed == 0)
00303         {
00304          PrintErrorID(theEnv,"INSMNGR",4,FALSE);
00305          EnvPrintRouter(theEnv,WERROR,"The instance ");
00306          EnvPrintRouter(theEnv,WERROR,ValueToString(iname));
00307          EnvPrintRouter(theEnv,WERROR," has a slot-value which depends on the instance definition.\n");
00308          SetEvaluationError(theEnv,TRUE);
00309          return(NULL);
00310         }
00311       ins->busy++;
00312       IncrementSymbolCount(iname);
00313       if (ins->garbage == 0)
00314         {
00315          if (InstanceData(theEnv)->MkInsMsgPass)
00316            DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL);
00317          else
00318            QuashInstance(theEnv,ins);
00319         }
00320       ins->busy--;
00321       DecrementSymbolCount(theEnv,iname);
00322       if (ins->garbage == 0)
00323         {
00324          PrintErrorID(theEnv,"INSMNGR",5,FALSE);
00325          EnvPrintRouter(theEnv,WERROR,"Unable to delete old instance ");
00326          EnvPrintRouter(theEnv,WERROR,ValueToString(iname));
00327          EnvPrintRouter(theEnv,WERROR,".\n");
00328          SetEvaluationError(theEnv,TRUE);
00329          return(NULL);
00330         }
00331      }
00332 
00333    /* =============================================================
00334       Create the base instance from the defaults of the inheritance
00335       precedence list
00336       ============================================================= */
00337    InstanceData(theEnv)->CurrentInstance = NewInstance(theEnv);
00338 
00339 #if DEFRULE_CONSTRUCT
00340    /* ==============================================
00341       Add this new instance as a dependent to
00342       any currently active basis - if the partial
00343       match was deleted, abort the instance creation
00344       ============================================== */
00345    if (AddLogicalDependencies(theEnv,(struct patternEntity *) InstanceData(theEnv)->CurrentInstance,FALSE)
00346         == FALSE)
00347      {
00348       rtn_struct(theEnv,instance,InstanceData(theEnv)->CurrentInstance);
00349       InstanceData(theEnv)->CurrentInstance = NULL;
00350       return(NULL);
00351      }
00352 #endif
00353 
00354    InstanceData(theEnv)->CurrentInstance->name = iname;
00355    InstanceData(theEnv)->CurrentInstance->cls = cls;
00356    BuildDefaultSlots(theEnv,initMessage);
00357 
00358    /* ============================================================
00359       Put the instance in the instance hash table and put it on its
00360         class's instance list
00361       ============================================================ */
00362    InstanceData(theEnv)->CurrentInstance->hashTableIndex = hashTableIndex;
00363    if (iprv == NULL)
00364      {
00365       InstanceData(theEnv)->CurrentInstance->nxtHash = InstanceData(theEnv)->InstanceTable[hashTableIndex];
00366       if (InstanceData(theEnv)->InstanceTable[hashTableIndex] != NULL)
00367         InstanceData(theEnv)->InstanceTable[hashTableIndex]->prvHash = InstanceData(theEnv)->CurrentInstance;
00368       InstanceData(theEnv)->InstanceTable[hashTableIndex] = InstanceData(theEnv)->CurrentInstance;
00369      }
00370    else
00371      {
00372       InstanceData(theEnv)->CurrentInstance->nxtHash = iprv->nxtHash;
00373       if (iprv->nxtHash != NULL)
00374         iprv->nxtHash->prvHash = InstanceData(theEnv)->CurrentInstance;
00375       iprv->nxtHash = InstanceData(theEnv)->CurrentInstance;
00376       InstanceData(theEnv)->CurrentInstance->prvHash = iprv;
00377      }
00378 
00379    /* ======================================
00380       Put instance in global and class lists
00381       ====================================== */
00382    if (InstanceData(theEnv)->CurrentInstance->cls->instanceList == NULL)
00383      InstanceData(theEnv)->CurrentInstance->cls->instanceList = InstanceData(theEnv)->CurrentInstance;
00384    else
00385      InstanceData(theEnv)->CurrentInstance->cls->instanceListBottom->nxtClass = InstanceData(theEnv)->CurrentInstance;
00386    InstanceData(theEnv)->CurrentInstance->prvClass = InstanceData(theEnv)->CurrentInstance->cls->instanceListBottom;
00387    InstanceData(theEnv)->CurrentInstance->cls->instanceListBottom = InstanceData(theEnv)->CurrentInstance;
00388 
00389    if (InstanceData(theEnv)->InstanceList == NULL)
00390      InstanceData(theEnv)->InstanceList = InstanceData(theEnv)->CurrentInstance;
00391    else
00392      InstanceData(theEnv)->InstanceListBottom->nxtList = InstanceData(theEnv)->CurrentInstance;
00393    InstanceData(theEnv)->CurrentInstance->prvList = InstanceData(theEnv)->InstanceListBottom;
00394    InstanceData(theEnv)->InstanceListBottom = InstanceData(theEnv)->CurrentInstance;
00395    InstanceData(theEnv)->ChangesToInstances = TRUE;
00396 
00397    /* ==============================================================================
00398       Install the instance's name and slot-value symbols (prevent them from becoming
00399       ephemeral) - the class name and slot names are accounted for by the class
00400       ============================================================================== */
00401    InstallInstance(theEnv,InstanceData(theEnv)->CurrentInstance,TRUE);
00402 
00403    ins = InstanceData(theEnv)->CurrentInstance;
00404    InstanceData(theEnv)->CurrentInstance = NULL;
00405 
00406    if (InstanceData(theEnv)->MkInsMsgPass)
00407      { DirectMessage(theEnv,MessageHandlerData(theEnv)->CREATE_SYMBOL,ins,&temp,NULL); }
00408 
00409 #if DEFRULE_CONSTRUCT
00410    if (ins->cls->reactive)
00411      ObjectNetworkAction(theEnv,OBJECT_ASSERT,(INSTANCE_TYPE *) ins,-1);
00412 #endif
00413 
00414    return(ins);
00415   }
00416 
00417 /*****************************************************************************
00418   NAME         : InitSlotsCommand
00419   DESCRIPTION  : Calls Kernel Expression Evaluator EvaluateExpression
00420                    for each expression-value of an instance expression
00421 
00422                  Evaluates default slots only - slots that were specified
00423                  by overrides (sp->override == 1) are ignored)
00424   INPUTS       : 1) Instance address
00425   RETURNS      : Nothing useful
00426   SIDE EFFECTS : Each DATA_OBJECT slot in the instance's slot array is replaced
00427                    by the evaluation (by EvaluateExpression) of the expression
00428                    in the slot list.  The old expression-values
00429                    are deleted.
00430   NOTES        : H/L Syntax: (init-slots <instance>)
00431  *****************************************************************************/
00432 globle void InitSlotsCommand(
00433   void *theEnv,
00434   DATA_OBJECT *result)
00435   {
00436    SetpType(result,SYMBOL);
00437    SetpValue(result,EnvFalseSymbol(theEnv));
00438    EvaluationData(theEnv)->EvaluationError = FALSE;
00439    if (CheckCurrentMessage(theEnv,"init-slots",TRUE) == FALSE)
00440      return;
00441    EvaluateClassDefaults(theEnv,GetActiveInstance(theEnv));
00442    if (! EvaluationData(theEnv)->EvaluationError)
00443      {
00444       SetpType(result,INSTANCE_ADDRESS);
00445       SetpValue(result,(void *) GetActiveInstance(theEnv));
00446      }
00447   }
00448 
00449 /******************************************************
00450   NAME         : QuashInstance
00451   DESCRIPTION  : Deletes an instance if it is not in
00452                    use, otherwise sticks it on the
00453                    garbage list
00454   INPUTS       : The instance
00455   RETURNS      : 1 if successful, 0 otherwise
00456   SIDE EFFECTS : Instance deleted or added to garbage
00457   NOTES        : Even though the instance is removed
00458                    from the class list, hash table and
00459                    instance list, its links remain
00460                    unchanged so that outside loops
00461                    can still determine where the next
00462                    node in the list is (assuming the
00463                    instance was garbage collected).
00464  ******************************************************/
00465 globle intBool QuashInstance(
00466   void *theEnv,
00467   INSTANCE_TYPE *ins)
00468   {
00469    register int iflag;
00470    IGARBAGE *gptr;
00471 
00472 #if DEFRULE_CONSTRUCT
00473    if (EngineData(theEnv)->JoinOperationInProgress && ins->cls->reactive)
00474      {
00475       PrintErrorID(theEnv,"INSMNGR",12,FALSE);
00476       EnvPrintRouter(theEnv,WERROR,"Cannot delete instances of reactive classes while\n");
00477       EnvPrintRouter(theEnv,WERROR,"  pattern-matching is in process.\n");
00478       SetEvaluationError(theEnv,TRUE);
00479       return(0);
00480      }
00481 #endif
00482    if (ins->garbage == 1)
00483      return(0);
00484    if (ins->installed == 0)
00485      {
00486       PrintErrorID(theEnv,"INSMNGR",6,FALSE);
00487       EnvPrintRouter(theEnv,WERROR,"Cannot delete instance ");
00488       EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
00489       EnvPrintRouter(theEnv,WERROR," during initialization.\n");
00490       SetEvaluationError(theEnv,TRUE);
00491       return(0);
00492      }
00493 #if DEBUGGING_FUNCTIONS
00494    if (ins->cls->traceInstances)
00495      PrintInstanceWatch(theEnv,UNMAKE_TRACE,ins);
00496 #endif
00497 
00498 #if DEFRULE_CONSTRUCT
00499    RemoveEntityDependencies(theEnv,(struct patternEntity *) ins);
00500 
00501    if (ins->cls->reactive)
00502      ObjectNetworkAction(theEnv,OBJECT_RETRACT,(INSTANCE_TYPE *) ins,-1);
00503 #endif
00504 
00505    if (ins->prvHash != NULL)
00506      ins->prvHash->nxtHash = ins->nxtHash;
00507    else
00508      InstanceData(theEnv)->InstanceTable[ins->hashTableIndex] = ins->nxtHash;
00509    if (ins->nxtHash != NULL)
00510      ins->nxtHash->prvHash = ins->prvHash;
00511 
00512    if (ins->prvClass != NULL)
00513      ins->prvClass->nxtClass = ins->nxtClass;
00514    else
00515      ins->cls->instanceList = ins->nxtClass;
00516    if (ins->nxtClass != NULL)
00517      ins->nxtClass->prvClass = ins->prvClass;
00518    else
00519      ins->cls->instanceListBottom = ins->prvClass;
00520 
00521    if (ins->prvList != NULL)
00522      ins->prvList->nxtList = ins->nxtList;
00523    else
00524      InstanceData(theEnv)->InstanceList = ins->nxtList;
00525    if (ins->nxtList != NULL)
00526      ins->nxtList->prvList = ins->prvList;
00527    else
00528      InstanceData(theEnv)->InstanceListBottom = ins->prvList;
00529 
00530    iflag = ins->installed;
00531    InstallInstance(theEnv,ins,FALSE);
00532 
00533    /* ==============================================
00534       If the instance is the basis for an executing
00535       rule, don't bother deleting its slots yet, for
00536       they may still be needed by pattern variables
00537       ============================================== */
00538    if ((iflag == 1)
00539 #if DEFRULE_CONSTRUCT
00540        && (ins->header.busyCount == 0)
00541 #endif
00542      )
00543      RemoveInstanceData(theEnv,ins);
00544 
00545    if ((ins->busy == 0) && (ins->depth > EvaluationData(theEnv)->CurrentEvaluationDepth) &&
00546        (InstanceData(theEnv)->MaintainGarbageInstances == FALSE)
00547 #if DEFRULE_CONSTRUCT
00548         && (ins->header.busyCount == 0)
00549 #endif
00550        )
00551      {
00552       DecrementSymbolCount(theEnv,ins->name);
00553       rtn_struct(theEnv,instance,ins);
00554      }
00555    else
00556      {
00557       gptr = get_struct(theEnv,igarbage);
00558       ins->garbage = 1;
00559       gptr->ins = ins;
00560       gptr->nxt = InstanceData(theEnv)->InstanceGarbageList;
00561       InstanceData(theEnv)->InstanceGarbageList = gptr;
00562       UtilityData(theEnv)->EphemeralItemCount += 2;
00563       UtilityData(theEnv)->EphemeralItemSize += InstanceSizeHeuristic(ins) + sizeof(IGARBAGE);
00564      }
00565    InstanceData(theEnv)->ChangesToInstances = TRUE;
00566    return(1);
00567   }
00568 
00569 
00570 #if DEFRULE_CONSTRUCT
00571 
00572 /****************************************************
00573   NAME         : InactiveInitializeInstance
00574   DESCRIPTION  : Initializes an instance of a class
00575                  Pattern-matching is automatically
00576                  delayed until the instance is
00577                  completely initialized
00578   INPUTS       : The address of the result value
00579   RETURNS      : Nothing useful
00580   SIDE EFFECTS : Instance intialized
00581   NOTES        : H/L Syntax:
00582                  (initialize-instance <instance-name>
00583                     <slot-override>*)
00584  ****************************************************/
00585 globle void InactiveInitializeInstance(
00586   void *theEnv,
00587   DATA_OBJECT *result)
00588   {
00589    int ov;
00590 
00591    ov = SetDelayObjectPatternMatching(theEnv,TRUE);
00592    InitializeInstanceCommand(theEnv,result);
00593    SetDelayObjectPatternMatching(theEnv,ov);
00594   }
00595 
00596 /**************************************************************
00597   NAME         : InactiveMakeInstance
00598   DESCRIPTION  : Creates and initializes an instance of a class
00599                  Pattern-matching is automatically
00600                  delayed until the instance is
00601                  completely initialized
00602   INPUTS       : The address of the result value
00603   RETURNS      : Nothing useful
00604   SIDE EFFECTS : Instance intialized
00605   NOTES        : H/L Syntax:
00606                  (make-instance <instance-name> of <class>
00607                     <slot-override>*)
00608  **************************************************************/
00609 globle void InactiveMakeInstance(
00610   void *theEnv,
00611   DATA_OBJECT *result)
00612   {
00613    int ov;
00614 
00615    ov = SetDelayObjectPatternMatching(theEnv,TRUE);
00616    MakeInstanceCommand(theEnv,result);
00617    SetDelayObjectPatternMatching(theEnv,ov);
00618   }
00619 
00620 #endif
00621 
00622 /* =========================================
00623    *****************************************
00624           INTERNALLY VISIBLE FUNCTIONS
00625    =========================================
00626    ***************************************** */
00627 
00628 /********************************************************
00629   NAME         : NewInstance
00630   DESCRIPTION  : Allocates and initializes a new instance
00631   INPUTS       : None
00632   RETURNS      : The address of the new instance
00633   SIDE EFFECTS : None
00634   NOTES        : None
00635  ********************************************************/
00636 static INSTANCE_TYPE *NewInstance(
00637   void *theEnv)
00638   {
00639    INSTANCE_TYPE *instance;
00640 
00641    instance = get_struct(theEnv,instance);
00642 #if DEFRULE_CONSTRUCT
00643    instance->header.theInfo = &InstanceData(theEnv)->InstanceInfo;
00644 
00645    instance->header.dependents = NULL;
00646    instance->header.busyCount = 0;
00647    instance->header.timeTag = 0L;
00648 
00649    instance->partialMatchList = NULL;
00650    instance->basisSlots = NULL;
00651    instance->reteSynchronized = FALSE;
00652 #endif
00653    instance->busy = 0;
00654    instance->installed = 0;
00655    instance->garbage = 0;
00656    instance->initSlotsCalled = 0;
00657    instance->initializeInProgress = 0;
00658    instance->depth = EvaluationData(theEnv)->CurrentEvaluationDepth;
00659    instance->name = NULL;
00660    instance->hashTableIndex = 0;
00661    instance->cls = NULL;
00662    instance->slots = NULL;
00663    instance->slotAddresses = NULL;
00664    instance->prvClass = NULL;
00665    instance->nxtClass = NULL;
00666    instance->prvHash = NULL;
00667    instance->nxtHash = NULL;
00668    instance->prvList = NULL;
00669    instance->nxtList = NULL;
00670    return(instance);
00671   }
00672 
00673 /*****************************************************************
00674   NAME         : InstanceLocationInfo
00675   DESCRIPTION  : Determines where a specified instance belongs
00676                    in the instance hash table
00677   INPUTS       : 1) The class of the new instance
00678                  2) The symbol for the name of the instance
00679                  3) Caller's buffer for previous node address
00680                  4) Caller's buffer for hash value
00681   RETURNS      : The address of the found instance, NULL otherwise
00682   SIDE EFFECTS : None
00683   NOTES        : Instance names only have to be unique within
00684                  a module
00685  *****************************************************************/
00686 static INSTANCE_TYPE *InstanceLocationInfo(
00687   void *theEnv,
00688   DEFCLASS *cls,
00689   SYMBOL_HN *iname,
00690   INSTANCE_TYPE **prv,
00691   unsigned *hashTableIndex)
00692   {
00693    INSTANCE_TYPE *ins;
00694 
00695    *hashTableIndex = HashInstance(iname);
00696    ins = InstanceData(theEnv)->InstanceTable[*hashTableIndex];
00697 
00698    /* ========================================
00699       Make sure all instances of the same name
00700       are grouped together regardless of what
00701       module their classes are in
00702       ======================================== */
00703    *prv = NULL;
00704    while ((ins != NULL) ? (ins->name != iname) : FALSE)
00705      {
00706       *prv = ins;
00707       ins = ins->nxtHash;
00708      }
00709    while ((ins != NULL) ? (ins->name == iname) : FALSE)
00710      {
00711       if (ins->cls->header.whichModule->theModule ==
00712           cls->header.whichModule->theModule)
00713         return(ins);
00714       *prv = ins;
00715       ins = ins->nxtHash;
00716      }
00717    return(NULL);
00718   }
00719 
00720 /********************************************************
00721   NAME         : InstallInstance
00722   DESCRIPTION  : Prevent name and slot value symbols
00723                    from being ephemeral (all others
00724                    taken care of by class defn)
00725   INPUTS       : 1) The address of the instance
00726                  2) A flag indicating whether to
00727                     install or deinstall
00728   RETURNS      : Nothing useful
00729   SIDE EFFECTS : Symbol counts incremented or decremented
00730   NOTES        : Slot symbol installations are handled
00731                    by PutSlotValue
00732  ********************************************************/
00733 static void InstallInstance(
00734   void *theEnv,
00735   INSTANCE_TYPE *ins,
00736   int set)
00737   {
00738    if (set == TRUE)
00739      {
00740       if (ins->installed)
00741         return;
00742 #if DEBUGGING_FUNCTIONS
00743       if (ins->cls->traceInstances)
00744         PrintInstanceWatch(theEnv,MAKE_TRACE,ins);
00745 #endif
00746       ins->installed = 1;
00747       ins->depth = EvaluationData(theEnv)->CurrentEvaluationDepth;
00748       IncrementSymbolCount(ins->name);
00749       IncrementDefclassBusyCount(theEnv,(void *) ins->cls);
00750       InstanceData(theEnv)->GlobalNumberOfInstances++;
00751      }
00752    else
00753      {
00754       if (! ins->installed)
00755         return;
00756       ins->installed = 0;
00757       InstanceData(theEnv)->GlobalNumberOfInstances--;
00758 
00759       /* =======================================
00760          Class counts is decremented by
00761          RemoveInstanceData() when slot data is
00762          truly deleted - and name count is
00763          deleted by CleanupInstances() or
00764          QuashInstance() when instance is
00765          truly deleted
00766          ======================================= */
00767      }
00768   }
00769 
00770 /****************************************************************
00771   NAME         : BuildDefaultSlots
00772   DESCRIPTION  : The current instance's address is
00773                    in the global variable CurrentInstance.
00774                    This builds the slots and the default values
00775                    from the direct class of the instance and its
00776                    inheritances.
00777   INPUTS       : Flag indicating whether init message will be
00778                  called for this instance or not
00779   RETURNS      : Nothing useful
00780   SIDE EFFECTS : Allocates the slot array for
00781                    the current instance
00782   NOTES        : The current instance's address is
00783                  stored in a global variable
00784  ****************************************************************/
00785 static void BuildDefaultSlots(
00786   void *theEnv,
00787   intBool initMessage)
00788   {
00789    register unsigned i,j;
00790    unsigned scnt;
00791    unsigned lscnt;
00792    INSTANCE_SLOT *dst = NULL,**adst;
00793    SLOT_DESC **src;
00794 
00795    scnt = InstanceData(theEnv)->CurrentInstance->cls->instanceSlotCount;
00796    lscnt = InstanceData(theEnv)->CurrentInstance->cls->localInstanceSlotCount;
00797    if (scnt > 0)
00798      {
00799       InstanceData(theEnv)->CurrentInstance->slotAddresses = adst =
00800          (INSTANCE_SLOT **) gm2(theEnv,(sizeof(INSTANCE_SLOT *) * scnt));
00801       if (lscnt != 0)
00802         InstanceData(theEnv)->CurrentInstance->slots = dst =
00803            (INSTANCE_SLOT *) gm2(theEnv,(sizeof(INSTANCE_SLOT) * lscnt));
00804       src = InstanceData(theEnv)->CurrentInstance->cls->instanceTemplate;
00805 
00806       /* ==================================================
00807          A map of slot addresses is created - shared slots
00808          point at values in the class, and local slots
00809          point at values in the instance
00810 
00811          Also - slots are always given an initial value
00812          (since slots cannot be unbound). If there is
00813          already an instance of a class with a shared slot,
00814          that value is left alone
00815          ================================================== */
00816       for (i = 0 , j = 0 ; i < scnt ; i++)
00817         {
00818          if (src[i]->shared)
00819            {
00820             src[i]->sharedCount++;
00821             adst[i] = &(src[i]->sharedValue);
00822            }
00823          else
00824            {
00825             dst[j].desc = src[i];
00826             dst[j].value = NULL;
00827             adst[i] = &dst[j++];
00828            }
00829          if (adst[i]->value == NULL)
00830            {
00831             adst[i]->valueRequired = initMessage;
00832             if (adst[i]->desc->multiple)
00833               {
00834                adst[i]->type = MULTIFIELD;
00835                adst[i]->value = CreateMultifield2(theEnv,0L);
00836                MultifieldInstall(theEnv,(MULTIFIELD_PTR) adst[i]->value);
00837               }
00838             else
00839               {
00840                adst[i]->type = SYMBOL;
00841                adst[i]->value = EnvAddSymbol(theEnv,"nil");
00842                AtomInstall(theEnv,(int) adst[i]->type,adst[i]->value);
00843               }
00844            }
00845          else
00846            adst[i]->valueRequired = FALSE;
00847          adst[i]->override = FALSE;
00848         }
00849      }
00850   }
00851 
00852 /*******************************************************************
00853   NAME         : CoreInitializeInstance
00854   DESCRIPTION  : Performs the core work for initializing an instance
00855   INPUTS       : 1) The instance address
00856                  2) Slot override expressions
00857   RETURNS      : TRUE if all OK, FALSE otherwise
00858   SIDE EFFECTS : EvaluationError set on errors - slots evaluated
00859   NOTES        : None
00860  *******************************************************************/
00861 static int CoreInitializeInstance(
00862   void *theEnv,
00863   INSTANCE_TYPE *ins,
00864   EXPRESSION *ovrexp)
00865   {
00866    DATA_OBJECT temp;
00867 
00868    if (ins->installed == 0)
00869      {
00870       PrintErrorID(theEnv,"INSMNGR",7,FALSE);
00871       EnvPrintRouter(theEnv,WERROR,"Instance ");
00872       EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
00873       EnvPrintRouter(theEnv,WERROR," is already being initialized.\n");
00874       SetEvaluationError(theEnv,TRUE);
00875       return(FALSE);
00876      }
00877 
00878    /* =======================================================
00879       Replace all default-slot values with any slot-overrides
00880       ======================================================= */
00881    ins->busy++;
00882    ins->installed = 0;
00883 
00884    /* =================================================================
00885       If the slots are initialized properly - the initializeInProgress
00886       flag will be turned off.
00887       ================================================================= */
00888    ins->initializeInProgress = 1;
00889    ins->initSlotsCalled = 0;
00890 
00891    if (InsertSlotOverrides(theEnv,ins,ovrexp) == FALSE)
00892       {
00893        ins->installed = 1;
00894        ins->busy--;
00895        return(FALSE);
00896       }
00897 
00898    /* =================================================================
00899       Now that all the slot expressions are established - replace them
00900       with their evaluation
00901       ================================================================= */
00902 
00903    if (InstanceData(theEnv)->MkInsMsgPass)
00904      DirectMessage(theEnv,MessageHandlerData(theEnv)->INIT_SYMBOL,ins,&temp,NULL);
00905    else
00906      EvaluateClassDefaults(theEnv,ins);
00907 
00908    ins->busy--;
00909    ins->installed = 1;
00910    if (EvaluationData(theEnv)->EvaluationError)
00911      {
00912       PrintErrorID(theEnv,"INSMNGR",8,FALSE);
00913       EnvPrintRouter(theEnv,WERROR,"An error occurred during the initialization of instance ");
00914       EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
00915       EnvPrintRouter(theEnv,WERROR,".\n");
00916       return(FALSE);
00917      }
00918      
00919    ins->initializeInProgress = 0;
00920    return((ins->initSlotsCalled == 0) ? FALSE : TRUE);
00921   }
00922 
00923 /**********************************************************
00924   NAME         : InsertSlotOverrides
00925   DESCRIPTION  : Replaces value-expression for a slot
00926   INPUTS       : 1) The instance address
00927                  2) The address of the beginning of the
00928                     list of slot-expressions
00929   RETURNS      : TRUE if all okay, FALSE otherwise
00930   SIDE EFFECTS : Old slot expression deallocated
00931   NOTES        : Assumes symbols not yet installed
00932                  EVALUATES the slot-name expression but
00933                     simply copies the slot value-expression
00934  **********************************************************/
00935 static int InsertSlotOverrides(
00936   void *theEnv,
00937   INSTANCE_TYPE *ins,
00938   EXPRESSION *slot_exp)
00939   {
00940    INSTANCE_SLOT *slot;
00941    DATA_OBJECT temp,junk;
00942 
00943    EvaluationData(theEnv)->EvaluationError = FALSE;
00944    while (slot_exp != NULL)
00945      {
00946       if ((EvaluateExpression(theEnv,slot_exp,&temp) == TRUE) ? TRUE :
00947           (GetType(temp) != SYMBOL))
00948         {
00949          PrintErrorID(theEnv,"INSMNGR",9,FALSE);
00950          EnvPrintRouter(theEnv,WERROR,"Expected a valid slot name for slot-override.\n");
00951          SetEvaluationError(theEnv,TRUE);
00952          return(FALSE);
00953         }
00954       slot = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) GetValue(temp));
00955       if (slot == NULL)
00956         {
00957          PrintErrorID(theEnv,"INSMNGR",13,FALSE);
00958          EnvPrintRouter(theEnv,WERROR,"Slot ");
00959          EnvPrintRouter(theEnv,WERROR,DOToString(temp));
00960          EnvPrintRouter(theEnv,WERROR," does not exist in instance ");
00961          EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
00962          EnvPrintRouter(theEnv,WERROR,".\n");
00963          SetEvaluationError(theEnv,TRUE);
00964          return(FALSE);
00965         }
00966 
00967       if (InstanceData(theEnv)->MkInsMsgPass)
00968         { DirectMessage(theEnv,slot->desc->overrideMessage,
00969                        ins,NULL,slot_exp->nextArg->argList); }
00970       else if (slot_exp->nextArg->argList)
00971         {
00972          if (EvaluateAndStoreInDataObject(theEnv,(int) slot->desc->multiple,
00973                                slot_exp->nextArg->argList,&temp,TRUE))
00974              PutSlotValue(theEnv,ins,slot,&temp,&junk,"function make-instance");
00975         }
00976       else
00977         {
00978          SetpDOBegin(&temp,1);
00979          SetpDOEnd(&temp,0);
00980          SetpType(&temp,MULTIFIELD);
00981          SetpValue(&temp,ProceduralPrimitiveData(theEnv)->NoParamValue);
00982          PutSlotValue(theEnv,ins,slot,&temp,&junk,"function make-instance");
00983         }
00984 
00985       if (EvaluationData(theEnv)->EvaluationError)
00986         return(FALSE);
00987       slot->override = TRUE;
00988       slot_exp = slot_exp->nextArg->nextArg;
00989      }
00990    return(TRUE);
00991   }
00992 
00993 /*****************************************************************************
00994   NAME         : EvaluateClassDefaults
00995   DESCRIPTION  : Evaluates default slots only - slots that were specified
00996                  by overrides (sp->override == 1) are ignored)
00997   INPUTS       : 1) Instance address
00998   RETURNS      : Nothing useful
00999   SIDE EFFECTS : Each DATA_OBJECT slot in the instance's slot array is replaced
01000                    by the evaluation (by EvaluateExpression) of the expression
01001                    in the slot list.  The old expression-values
01002                    are deleted.
01003   NOTES        : None
01004  *****************************************************************************/
01005 static void EvaluateClassDefaults(
01006   void *theEnv,
01007   INSTANCE_TYPE *ins)
01008   {
01009    INSTANCE_SLOT *slot;
01010    DATA_OBJECT temp,junk;
01011    long i;
01012 
01013    if (ins->initializeInProgress == 0)
01014      {
01015       PrintErrorID(theEnv,"INSMNGR",15,FALSE);
01016       SetEvaluationError(theEnv,TRUE);
01017       EnvPrintRouter(theEnv,WERROR,"init-slots not valid in this context.\n");
01018       return;
01019      }
01020    for (i = 0 ; i < ins->cls->instanceSlotCount ; i++)
01021      {
01022       slot = ins->slotAddresses[i];
01023 
01024       /* ===========================================================
01025          Slot-overrides are just a short-hand for put-slots, so they
01026          should be done with messages.  Defaults are from the class
01027          definition and can be placed directly.
01028          =========================================================== */
01029       if (!slot->override)
01030         {
01031          if (slot->desc->dynamicDefault)
01032            {
01033             if (EvaluateAndStoreInDataObject(theEnv,(int) slot->desc->multiple,
01034                                              (EXPRESSION *) slot->desc->defaultValue,
01035                                              &temp,TRUE))
01036               PutSlotValue(theEnv,ins,slot,&temp,&junk,"function init-slots");
01037            }
01038          else if (((slot->desc->shared == 0) || (slot->desc->sharedCount == 1)) &&
01039                   (slot->desc->noDefault == 0))
01040            DirectPutSlotValue(theEnv,ins,slot,(DATA_OBJECT *) slot->desc->defaultValue,&junk);
01041          else if (slot->valueRequired)
01042            {
01043             PrintErrorID(theEnv,"INSMNGR",14,FALSE);
01044             EnvPrintRouter(theEnv,WERROR,"Override required for slot ");
01045             EnvPrintRouter(theEnv,WERROR,ValueToString(slot->desc->slotName->name));
01046             EnvPrintRouter(theEnv,WERROR," in instance ");
01047             EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
01048             EnvPrintRouter(theEnv,WERROR,".\n");
01049             SetEvaluationError(theEnv,TRUE);
01050            }
01051          slot->valueRequired = FALSE;
01052          if (ins->garbage == 1)
01053            {
01054             EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
01055             EnvPrintRouter(theEnv,WERROR," instance deleted by slot-override evaluation.\n");
01056             SetEvaluationError(theEnv,TRUE);
01057            }
01058          if (EvaluationData(theEnv)->EvaluationError)
01059             return;
01060         }
01061       slot->override = FALSE;
01062      }
01063    ins->initSlotsCalled = 1;
01064   }
01065 
01066 #if DEBUGGING_FUNCTIONS
01067 
01068 /***************************************************
01069   NAME         : PrintInstanceWatch
01070   DESCRIPTION  : Prints out a trace message for the
01071                  creation/deletion of an instance
01072   INPUTS       : 1) The trace string indicating if
01073                     this is a creation or deletion
01074                  2) The instance
01075   RETURNS      : Nothing usful
01076   SIDE EFFECTS : Watch message printed
01077   NOTES        : None
01078  ***************************************************/
01079 static void PrintInstanceWatch(
01080   void *theEnv,
01081   char *traceString,
01082   INSTANCE_TYPE *theInstance)
01083   {
01084    EnvPrintRouter(theEnv,WTRACE,traceString);
01085    EnvPrintRouter(theEnv,WTRACE," instance ");
01086    PrintInstanceNameAndClass(theEnv,WTRACE,theInstance,TRUE);
01087   }
01088 
01089 #endif
01090 
01091 #endif
01092 
01093 
01094