src/clipsrules/core/defins.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*             CLIPS Version 6.24  06/02/06            */
00005    /*                                                     */
00006    /*                  DEFINSTANCES MODULE                */
00007    /*******************************************************/
00008 
00009 /*************************************************************/
00010 /* Purpose: Kernel definstances interface commands           */
00011 /*              and routines                                 */
00012 /*                                                           */
00013 /* Principal Programmer(s):                                  */
00014 /*      Brian L. Dantes                                      */
00015 /*                                                           */
00016 /* Contributing Programmer(s):                               */
00017 /*                                                           */
00018 /*                                                           */
00019 /* Revision History:                                         */
00020 /*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
00021 /*                                                           */
00022 /*            Corrected compilation errors for files         */
00023 /*            generated by constructs-to-c. DR0861           */
00024 /*                                                           */
00025 /*            Changed name of variable exp to theExp         */
00026 /*            because of Unix compiler warnings of shadowed  */
00027 /*            definitions.                                   */
00028 /*                                                           */
00029 /*      6.24: Converted INSTANCE_PATTERN_MATCHING to         */
00030 /*            DEFRULE_CONSTRUCT.                             */
00031 /*                                                           */
00032 /*            Renamed BOOLEAN macro type to intBool.         */
00033 /*                                                           */
00034 /*************************************************************/
00035 
00036 /* =========================================
00037    *****************************************
00038                EXTERNAL DEFINITIONS
00039    =========================================
00040    ***************************************** */
00041 #include "setup.h"
00042 
00043 #if DEFINSTANCES_CONSTRUCT
00044 
00045 #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
00046 #include "bload.h"
00047 #include "dfinsbin.h"
00048 #endif
00049 
00050 #if CONSTRUCT_COMPILER && (! RUN_TIME)
00051 #include "dfinscmp.h"
00052 #endif
00053 
00054 #include "argacces.h"
00055 #include "classcom.h"
00056 #include "classfun.h"
00057 #include "cstrccom.h"
00058 #include "cstrcpsr.h"
00059 #include "constant.h"
00060 #include "constrct.h"
00061 #include "envrnmnt.h"
00062 #include "evaluatn.h"
00063 #include "extnfunc.h"
00064 #include "insfun.h"
00065 #include "inspsr.h"
00066 #include "memalloc.h"
00067 #include "modulpsr.h"
00068 #include "router.h"
00069 #include "scanner.h"
00070 #include "symbol.h"
00071 #include "utility.h"
00072 
00073 #define _DEFINS_SOURCE_
00074 #include "defins.h"
00075 
00076 /* =========================================
00077    *****************************************
00078                    CONSTANTS
00079    =========================================
00080    ***************************************** */
00081 #define ACTIVE_RLN "active"
00082 
00083 /* =========================================
00084    *****************************************
00085       INTERNALLY VISIBLE FUNCTION HEADERS
00086    =========================================
00087    ***************************************** */
00088 
00089 #if (! BLOAD_ONLY) && (! RUN_TIME)
00090 static int ParseDefinstances(void *,char *);
00091 static SYMBOL_HN *ParseDefinstancesName(void *,char *,int *);
00092 static void RemoveDefinstances(void *,void *);
00093 static void SaveDefinstances(void *,void *,char *);
00094 static intBool RemoveAllDefinstances(void *);
00095 static void DefinstancesDeleteError(void *,char *);
00096 
00097 #if DEFRULE_CONSTRUCT
00098 static void CreateInitialDefinstances(void *);
00099 #endif
00100 #endif
00101 
00102 #if ! RUN_TIME
00103 static void *AllocateModule(void *);
00104 static void  ReturnModule(void *,void *);
00105 static intBool ClearDefinstancesReady(void *);
00106 static void CheckDefinstancesBusy(void *,struct constructHeader *,void *);
00107 static void DestroyDefinstancesAction(void *,struct constructHeader *,void *);
00108 #endif
00109 
00110 static void ResetDefinstances(void *);
00111 static void ResetDefinstancesAction(void *,struct constructHeader *,void *);
00112 static void DeallocateDefinstancesData(void *);
00113 
00114 /* =========================================
00115    *****************************************
00116           EXTERNALLY VISIBLE FUNCTIONS
00117    =========================================
00118    ***************************************** */
00119 
00120 /***************************************************
00121   NAME         : SetupDefinstances
00122   DESCRIPTION  : Adds the definstance support routines
00123                    to the Kernel
00124   INPUTS       : None
00125   RETURNS      : Nothing useful
00126   SIDE EFFECTS : Appropriate function lists modified
00127   NOTES        : None
00128  ***************************************************/
00129 globle void SetupDefinstances(
00130   void *theEnv)
00131   {
00132    AllocateEnvironmentData(theEnv,DEFINSTANCES_DATA,sizeof(struct definstancesData),DeallocateDefinstancesData);
00133 
00134    DefinstancesData(theEnv)->DefinstancesModuleIndex =
00135                 RegisterModuleItem(theEnv,"definstances",
00136 #if (! RUN_TIME)
00137                                     AllocateModule,ReturnModule,
00138 #else
00139                                     NULL,NULL,
00140 #endif
00141 #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
00142                                     BloadDefinstancesModuleRef,
00143 #else
00144                                     NULL,
00145 #endif
00146 #if CONSTRUCT_COMPILER && (! RUN_TIME)
00147                                     DefinstancesCModuleReference,
00148 #else
00149                                     NULL,
00150 #endif
00151                                     EnvFindDefinstances);
00152 
00153    DefinstancesData(theEnv)->DefinstancesConstruct =
00154       AddConstruct(theEnv,"definstances","definstances",
00155 #if (! BLOAD_ONLY) && (! RUN_TIME)
00156                    ParseDefinstances,
00157 #else
00158                    NULL,
00159 #endif
00160                    EnvFindDefinstances,
00161                    GetConstructNamePointer,GetConstructPPForm,
00162                    GetConstructModuleItem,EnvGetNextDefinstances,SetNextConstruct,
00163                    EnvIsDefinstancesDeletable,EnvUndefinstances,
00164 #if (! BLOAD_ONLY) && (! RUN_TIME)
00165                    RemoveDefinstances
00166 #else
00167                    NULL
00168 #endif
00169                    );
00170 
00171 #if ! RUN_TIME
00172    AddClearReadyFunction(theEnv,"definstances",ClearDefinstancesReady,0);
00173 
00174 #if ! BLOAD_ONLY
00175    EnvDefineFunction2(theEnv,"undefinstances",'v',PTIEF UndefinstancesCommand,"UndefinstancesCommand","11w");
00176    AddSaveFunction(theEnv,"definstances",SaveDefinstances,0);
00177 
00178 #if DEFRULE_CONSTRUCT
00179    EnvAddClearFunction(theEnv,"definstances",CreateInitialDefinstances,-1000);
00180 #endif
00181 
00182 #endif
00183 
00184 #if DEBUGGING_FUNCTIONS
00185    EnvDefineFunction2(theEnv,"ppdefinstances",'v',PTIEF PPDefinstancesCommand ,"PPDefinstancesCommand","11w");
00186    EnvDefineFunction2(theEnv,"list-definstances",'v',PTIEF ListDefinstancesCommand,"ListDefinstancesCommand","01");
00187 #endif
00188 
00189    EnvDefineFunction2(theEnv,"get-definstances-list",'m',PTIEF GetDefinstancesListFunction,
00190                    "GetDefinstancesListFunction","01");
00191    EnvDefineFunction2(theEnv,"definstances-module",'w',PTIEF GetDefinstancesModuleCommand,
00192                    "GetDefinstancesModuleCommand","11w");
00193 
00194 #endif
00195    EnvAddResetFunction(theEnv,"definstances",(void (*)(void *)) ResetDefinstances,0);
00196 
00197 #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
00198    SetupDefinstancesBload(theEnv);
00199 #endif
00200 
00201 #if CONSTRUCT_COMPILER && (! RUN_TIME)
00202    SetupDefinstancesCompiler(theEnv);
00203 #endif
00204   }
00205   
00206 /*******************************************************/
00207 /* DeallocateDefinstancesData: Deallocates environment */
00208 /*    data for the definstances construct.             */
00209 /*******************************************************/
00210 static void DeallocateDefinstancesData(
00211   void *theEnv)
00212   {
00213 #if ! RUN_TIME
00214    struct definstancesModule *theModuleItem;
00215    void *theModule;
00216    
00217 #if BLOAD || BLOAD_AND_BSAVE
00218    if (Bloaded(theEnv)) return;
00219 #endif
00220    
00221    DoForAllConstructs(theEnv,DestroyDefinstancesAction,DefinstancesData(theEnv)->DefinstancesModuleIndex,FALSE,NULL); 
00222    
00223    for (theModule = EnvGetNextDefmodule(theEnv,NULL);
00224         theModule != NULL;
00225         theModule = EnvGetNextDefmodule(theEnv,theModule))
00226      {
00227       theModuleItem = (struct definstancesModule *)
00228                       GetModuleItem(theEnv,(struct defmodule *) theModule,
00229                                     DefinstancesData(theEnv)->DefinstancesModuleIndex);
00230       rtn_struct(theEnv,definstancesModule,theModuleItem);
00231      }
00232 #else
00233 #if MAC_MCW || WIN_MCW || MAC_XCD
00234 #pragma unused(theEnv)
00235 #endif
00236 #endif
00237   }
00238 
00239 #if ! RUN_TIME  
00240 /*****************************************************/
00241 /* DestroyDefinstancesAction: Action used to remove  */
00242 /*   definstances as a result of DestroyEnvironment. */
00243 /*****************************************************/
00244 #if WIN_BTC
00245 #pragma argsused
00246 #endif
00247 static void DestroyDefinstancesAction(
00248   void *theEnv,
00249   struct constructHeader *theConstruct,
00250   void *buffer)
00251   {
00252 #if MAC_MCW || WIN_MCW || MAC_XCD
00253 #pragma unused(buffer)
00254 #endif
00255 #if (! BLOAD_ONLY) && (! RUN_TIME)
00256    struct definstances *theDefinstances = (struct definstances *) theConstruct;
00257    
00258    if (theDefinstances == NULL) return;
00259    
00260    ReturnPackedExpression(theEnv,theDefinstances->mkinstance);
00261    
00262    DestroyConstructHeader(theEnv,&theDefinstances->header);
00263 
00264    rtn_struct(theEnv,definstances,theDefinstances);
00265 #else
00266 #if MAC_MCW || WIN_MCW || MAC_XCD
00267 #pragma unused(theConstruct,theEnv)
00268 #endif
00269 #endif
00270   }
00271 #endif
00272 
00273 /***********************************************************
00274   NAME         : EnvGetNextDefinstances
00275   DESCRIPTION  : Finds first or next definstances
00276   INPUTS       : The address of the current definstances
00277   RETURNS      : The address of the next definstances
00278                    (NULL if none)
00279   SIDE EFFECTS : None
00280   NOTES        : If ptr == NULL, the first definstances
00281                     is returned.
00282  ***********************************************************/
00283 globle void *EnvGetNextDefinstances(
00284   void *theEnv,
00285   void *ptr)
00286   {
00287    return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr,
00288                                         DefinstancesData(theEnv)->DefinstancesModuleIndex));
00289   }
00290 
00291 /***************************************************
00292   NAME         : EnvFindDefinstances
00293   DESCRIPTION  : Looks up a definstance construct
00294                    by name-string
00295   INPUTS       : The symbolic name
00296   RETURNS      : The definstance address, or NULL
00297                     if not found
00298   SIDE EFFECTS : None
00299   NOTES        : None
00300  ***************************************************/
00301 globle void *EnvFindDefinstances(
00302   void *theEnv,
00303   char *name)
00304   {
00305    return(FindNamedConstruct(theEnv,name,DefinstancesData(theEnv)->DefinstancesConstruct));
00306   }
00307 
00308 /***************************************************
00309   NAME         : EnvIsDefinstancesDeletable
00310   DESCRIPTION  : Determines if a definstances
00311                    can be deleted
00312   INPUTS       : Address of the definstances
00313   RETURNS      : TRUE if deletable, FALSE otherwise
00314   SIDE EFFECTS : None
00315   NOTES        : None
00316  ***************************************************/
00317 globle int EnvIsDefinstancesDeletable(
00318   void *theEnv,
00319   void *ptr)
00320   {
00321    if (! ConstructsDeletable(theEnv))
00322      { return FALSE; }
00323 
00324    return((((DEFINSTANCES *) ptr)->busy == 0) ? TRUE : FALSE);
00325   }
00326 
00327 /***********************************************************
00328   NAME         : UndefinstancesCommand
00329   DESCRIPTION  : Removes a definstance
00330   INPUTS       : None
00331   RETURNS      : Nothing useful
00332   SIDE EFFECTS : Definstance deallocated
00333   NOTES        : H/L Syntax : (undefinstances <name> | *)
00334  ***********************************************************/
00335 globle void UndefinstancesCommand(
00336   void *theEnv)
00337   {
00338    UndefconstructCommand(theEnv,"undefinstances",DefinstancesData(theEnv)->DefinstancesConstruct);
00339   }
00340 
00341 /*****************************************************************
00342   NAME         : GetDefinstancesModuleCommand
00343   DESCRIPTION  : Determines to which module a definstances belongs
00344   INPUTS       : None
00345   RETURNS      : The symbolic name of the module
00346   SIDE EFFECTS : None
00347   NOTES        : H/L Syntax: (definstances-module <defins-name>)
00348  *****************************************************************/
00349 globle void *GetDefinstancesModuleCommand(
00350   void *theEnv)
00351   {
00352    return(GetConstructModuleCommand(theEnv,"definstances-module",DefinstancesData(theEnv)->DefinstancesConstruct));
00353   }
00354 
00355 /***********************************************************
00356   NAME         : EnvUndefinstances
00357   DESCRIPTION  : Removes a definstance
00358   INPUTS       : Address of definstances to remove
00359   RETURNS      : TRUE if successful,
00360                  FALSE otherwise
00361   SIDE EFFECTS : Definstance deallocated
00362   NOTES        : None
00363  ***********************************************************/
00364 globle intBool EnvUndefinstances(
00365   void *theEnv,
00366   void *vptr)
00367   {
00368 #if RUN_TIME || BLOAD_ONLY
00369 #if MAC_MCW || WIN_MCW || MAC_XCD
00370 #pragma unused(theEnv,vptr)
00371 #endif
00372    return(FALSE);
00373 #else
00374    DEFINSTANCES *dptr;
00375 
00376    dptr = (DEFINSTANCES *) vptr;
00377 
00378 #if BLOAD || BLOAD_AND_BSAVE
00379    if (Bloaded(theEnv))
00380      return(FALSE);
00381 #endif
00382    if (dptr == NULL)
00383      return(RemoveAllDefinstances(theEnv));
00384    if (EnvIsDefinstancesDeletable(theEnv,vptr) == FALSE)
00385      return(FALSE);
00386    RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr);
00387    RemoveDefinstances(theEnv,(void *) dptr);
00388    return(TRUE);
00389 #endif
00390   }
00391 
00392 #if DEBUGGING_FUNCTIONS
00393 
00394 /***************************************************************
00395   NAME         : PPDefinstancesCommand
00396   DESCRIPTION  : Prints out the pretty-print form of a definstance
00397   INPUTS       : None
00398   RETURNS      : Nothing useful
00399   SIDE EFFECTS : None
00400   NOTES        : H/L Syntax : (ppdefinstances <name>)
00401  ***************************************************************/
00402 globle void PPDefinstancesCommand(
00403   void *theEnv)
00404   {
00405    PPConstructCommand(theEnv,"ppdefinstances",DefinstancesData(theEnv)->DefinstancesConstruct);
00406   }
00407 
00408 /***************************************************
00409   NAME         : ListDefinstancesCommand
00410   DESCRIPTION  : Displays all definstances names
00411   INPUTS       : None
00412   RETURNS      : Nothing useful
00413   SIDE EFFECTS : Definstances name sprinted
00414   NOTES        : H/L Interface
00415  ***************************************************/
00416 globle void ListDefinstancesCommand(
00417   void *theEnv)
00418   {
00419    ListConstructCommand(theEnv,"list-definstances",DefinstancesData(theEnv)->DefinstancesConstruct);
00420   }
00421 
00422 /***************************************************
00423   NAME         : EnvListDefinstances
00424   DESCRIPTION  : Displays all definstances names
00425   INPUTS       : 1) The logical name of the output
00426                  2) The module
00427   RETURNS      : Nothing useful
00428   SIDE EFFECTS : Definstances names printed
00429   NOTES        : C Interface
00430  ***************************************************/
00431 globle void EnvListDefinstances(
00432   void *theEnv,
00433   char *logicalName,
00434   struct defmodule *theModule)
00435   {
00436    ListConstruct(theEnv,DefinstancesData(theEnv)->DefinstancesConstruct,logicalName,theModule);
00437   }
00438 
00439 #endif
00440 
00441 /****************************************************************
00442   NAME         : GetDefinstancesListFunction
00443   DESCRIPTION  : Groups all definstances names into
00444                  a multifield list
00445   INPUTS       : A data object buffer to hold
00446                  the multifield result
00447   RETURNS      : Nothing useful
00448   SIDE EFFECTS : Multifield allocated and filled
00449   NOTES        : H/L Syntax: (get-definstances-list [<module>])
00450  ****************************************************************/
00451 globle void GetDefinstancesListFunction(
00452   void *theEnv,
00453   DATA_OBJECT*returnValue)
00454   {
00455    GetConstructListFunction(theEnv,"get-definstances-list",returnValue,DefinstancesData(theEnv)->DefinstancesConstruct);
00456   }
00457 
00458 /***************************************************************
00459   NAME         : EnvGetDefinstancesList
00460   DESCRIPTION  : Groups all definstances names into
00461                  a multifield list
00462   INPUTS       : 1) A data object buffer to hold
00463                     the multifield result
00464                  2) The module from which to obtain definstances
00465   RETURNS      : Nothing useful
00466   SIDE EFFECTS : Multifield allocated and filled
00467   NOTES        : External C access
00468  ***************************************************************/
00469 globle void EnvGetDefinstancesList(
00470   void *theEnv,
00471   DATA_OBJECT *returnValue,
00472   struct defmodule *theModule)
00473   {
00474    GetConstructList(theEnv,returnValue,DefinstancesData(theEnv)->DefinstancesConstruct,theModule);
00475   }
00476 
00477 /* =========================================
00478    *****************************************
00479           INTERNALLY VISIBLE FUNCTIONS
00480    =========================================
00481    ***************************************** */
00482 
00483 #if (! BLOAD_ONLY) && (! RUN_TIME)
00484 
00485 /*********************************************************************
00486   NAME         : ParseDefinstances
00487   DESCRIPTION  : Parses and allocates a definstances construct
00488   INPUTS       : The logical name of the input source
00489   RETURNS      : FALSE if no errors, TRUE otherwise
00490   SIDE EFFECTS : Definstances parsed and created
00491   NOTES        : H/L Syntax :
00492 
00493                  (definstances  <name> [active] [<comment>]
00494                     <instance-definition>+)
00495 
00496                  <instance-definition> ::=
00497                     (<instance-name> of <class-name> <slot-override>*)
00498 
00499                  <slot-override> ::= (<slot-name> <value-expression>*)
00500  *********************************************************************/
00501 static int ParseDefinstances(
00502   void *theEnv,
00503   char *readSource)
00504   {
00505    SYMBOL_HN *dname;
00506    void *mkinsfcall;
00507    EXPRESSION *mkinstance,*mkbot = NULL;
00508    DEFINSTANCES *dobj;
00509    int active;
00510 
00511    SetPPBufferStatus(theEnv,ON);
00512    FlushPPBuffer(theEnv);
00513    SetIndentDepth(theEnv,3);
00514    SavePPBuffer(theEnv,"(definstances ");
00515 
00516 #if BLOAD || BLOAD_AND_BSAVE
00517    if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
00518      {
00519       CannotLoadWithBloadMessage(theEnv,"definstances");
00520       return(TRUE);
00521      }
00522 #endif
00523    dname = ParseDefinstancesName(theEnv,readSource,&active);
00524    if (dname == NULL)
00525      return(TRUE);
00526 
00527    dobj = get_struct(theEnv,definstances);
00528    InitializeConstructHeader(theEnv,"definstances",(struct constructHeader *) dobj,dname);
00529    dobj->busy = 0;
00530    dobj->mkinstance = NULL;
00531 #if DEFRULE_CONSTRUCT
00532    if (active)
00533      mkinsfcall = (void *) FindFunction(theEnv,"active-make-instance");
00534    else
00535      mkinsfcall = (void *) FindFunction(theEnv,"make-instance");
00536 #else
00537    mkinsfcall = (void *) FindFunction(theEnv,"make-instance");
00538 #endif
00539    while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN)
00540      {
00541       mkinstance = GenConstant(theEnv,UNKNOWN_VALUE,mkinsfcall);
00542       mkinstance = ParseInitializeInstance(theEnv,mkinstance,readSource);
00543       if (mkinstance == NULL)
00544         {
00545          ReturnExpression(theEnv,dobj->mkinstance);
00546          rtn_struct(theEnv,definstances,dobj);
00547          return(TRUE);
00548         }
00549       if (ExpressionContainsVariables(mkinstance,FALSE) == TRUE)
00550         {
00551          LocalVariableErrorMessage(theEnv,"definstances");
00552          ReturnExpression(theEnv,mkinstance);
00553          ReturnExpression(theEnv,dobj->mkinstance);
00554          rtn_struct(theEnv,definstances,dobj);
00555          return(TRUE);
00556         }
00557       if (mkbot == NULL)
00558         dobj->mkinstance = mkinstance;
00559       else
00560         GetNextArgument(mkbot) = mkinstance;
00561       mkbot = mkinstance;
00562       GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
00563       PPBackup(theEnv);
00564       PPCRAndIndent(theEnv);
00565       SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
00566      }
00567 
00568    if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
00569      {
00570       ReturnExpression(theEnv,dobj->mkinstance);
00571       rtn_struct(theEnv,definstances,dobj);
00572       SyntaxErrorMessage(theEnv,"definstances");
00573       return(TRUE);
00574      }
00575    else
00576      {
00577       if (ConstructData(theEnv)->CheckSyntaxMode)
00578         {
00579          ReturnExpression(theEnv,dobj->mkinstance);
00580          rtn_struct(theEnv,definstances,dobj);
00581          return(FALSE);
00582         }
00583 #if DEBUGGING_FUNCTIONS
00584       if (EnvGetConserveMemory(theEnv) == FALSE)
00585         {
00586          if (dobj->mkinstance != NULL)
00587            PPBackup(theEnv);
00588          PPBackup(theEnv);
00589          SavePPBuffer(theEnv,")\n");
00590          SetDefinstancesPPForm((void *) dobj,CopyPPBuffer(theEnv));
00591         }
00592 #endif
00593       mkinstance = dobj->mkinstance;
00594       dobj->mkinstance = PackExpression(theEnv,mkinstance);
00595       ReturnExpression(theEnv,mkinstance);
00596       IncrementSymbolCount(GetDefinstancesNamePointer((void *) dobj));
00597       ExpressionInstall(theEnv,dobj->mkinstance);
00598      }
00599 
00600    AddConstructToModule((struct constructHeader *) dobj);
00601    return(FALSE);
00602   }
00603 
00604 /*************************************************************
00605   NAME         : ParseDefinstancesName
00606   DESCRIPTION  : Parses definstance name and optional comment
00607                  and optional "active" keyword
00608   INPUTS       : 1) The logical name of the input source
00609                  2) Buffer to hold flag indicating if
00610                     definstances should cause pattern-matching
00611                     to occur during slot-overrides
00612   RETURNS      : Address of name symbol, or
00613                    NULL if there was an error
00614   SIDE EFFECTS : Token after name or comment is scanned
00615   NOTES        : Assumes "(definstances" has already
00616                    been scanned.
00617  *************************************************************/
00618 static SYMBOL_HN *ParseDefinstancesName(
00619   void *theEnv,
00620   char *readSource,
00621   int *active)
00622   {
00623    SYMBOL_HN *dname;
00624 
00625    *active = FALSE;
00626    dname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"definstances",
00627                                       EnvFindDefinstances,EnvUndefinstances,"@",
00628                                       TRUE,FALSE,TRUE);
00629    if (dname == NULL)
00630      return(NULL);
00631 
00632 #if DEFRULE_CONSTRUCT
00633    if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? FALSE :
00634        (strcmp(ValueToString(GetValue(DefclassData(theEnv)->ObjectParseToken)),ACTIVE_RLN) == 0))
00635      {
00636       PPBackup(theEnv);
00637       PPBackup(theEnv);
00638       SavePPBuffer(theEnv," ");
00639       SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
00640       PPCRAndIndent(theEnv);
00641       GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
00642       *active = TRUE;
00643      }
00644 #endif
00645    if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING)
00646      {
00647       PPBackup(theEnv);
00648       PPBackup(theEnv);
00649       SavePPBuffer(theEnv," ");
00650       SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
00651       PPCRAndIndent(theEnv);
00652       GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
00653      }
00654    return(dname);
00655   }
00656 
00657 /**************************************************************
00658   NAME         : RemoveDefinstances
00659   DESCRIPTION  : Deallocates and removes a definstance construct
00660   INPUTS       : The definstance address
00661   RETURNS      : Nothing useful
00662   SIDE EFFECTS : Existing definstance construct deleted
00663   NOTES        : Assumes busy count of definstance is 0
00664  **************************************************************/
00665 static void RemoveDefinstances(
00666   void *theEnv,
00667   void *vdptr)
00668   {
00669    DEFINSTANCES *dptr = (DEFINSTANCES *) vdptr;
00670 
00671    DecrementSymbolCount(theEnv,GetDefinstancesNamePointer((void *) dptr));
00672    ExpressionDeinstall(theEnv,dptr->mkinstance);
00673    ReturnPackedExpression(theEnv,dptr->mkinstance);
00674    SetDefinstancesPPForm((void *) dptr,NULL);
00675    ClearUserDataList(theEnv,dptr->header.usrData);
00676    rtn_struct(theEnv,definstances,dptr);
00677   }
00678 
00679 /***************************************************
00680   NAME         : SaveDefinstances
00681   DESCRIPTION  : Prints pretty print form of
00682                    definstances to specified output
00683   INPUTS       : The logical name of the output
00684   RETURNS      : Nothing useful
00685   SIDE EFFECTS : None
00686   NOTES        : None
00687  ***************************************************/
00688 static void SaveDefinstances(
00689   void *theEnv,
00690   void *theModule,
00691   char *logName)
00692   {
00693    SaveConstruct(theEnv,theModule,logName,DefinstancesData(theEnv)->DefinstancesConstruct);
00694   }
00695 
00696 /***************************************************
00697   NAME         : RemoveAllDefinstances
00698   DESCRIPTION  : Removes all definstances constructs
00699   INPUTS       : None
00700   RETURNS      : TRUE if successful,
00701                  FALSE otherwise
00702   SIDE EFFECTS : All definstances deallocated
00703   NOTES        : None
00704  ***************************************************/
00705 static intBool RemoveAllDefinstances(
00706   void *theEnv)
00707   {
00708    DEFINSTANCES *dptr,*dhead;
00709    int success = TRUE;
00710 
00711 #if BLOAD || BLOAD_AND_BSAVE
00712 
00713    if (Bloaded(theEnv))
00714      return(FALSE);
00715 #endif
00716   dhead = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,NULL);
00717   while (dhead != NULL)
00718     {
00719      dptr = dhead;
00720      dhead = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,(void *) dhead);
00721      if (EnvIsDefinstancesDeletable(theEnv,(void *) dptr))
00722        {
00723         RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
00724         RemoveDefinstances(theEnv,(void *) dptr);
00725        }
00726      else
00727        {
00728         DefinstancesDeleteError(theEnv,EnvGetDefinstancesName(theEnv,(void *) dptr));
00729         success = FALSE;
00730        }
00731     }
00732    return(success);
00733   }
00734 
00735 /***************************************************
00736   NAME         : DefinstancesDeleteError
00737   DESCRIPTION  : Prints an error message for
00738                  unsuccessful definstances
00739                  deletion attempts
00740   INPUTS       : The name of the definstances
00741   RETURNS      : Nothing useful
00742   SIDE EFFECTS : Error message printed
00743   NOTES        : None
00744  ***************************************************/
00745 static void DefinstancesDeleteError(
00746   void *theEnv,
00747   char *dname)
00748   {
00749    CantDeleteItemErrorMessage(theEnv,"definstances",dname);
00750   }
00751 
00752 #if DEFRULE_CONSTRUCT
00753 
00754 /********************************************************
00755   NAME         : CreateInitialDefinstances
00756   DESCRIPTION  : Makes the initial-object definstances
00757                  structure for creating an initial-object
00758                  which will match default object patterns
00759                  in defrules
00760   INPUTS       : None
00761   RETURNS      : Nothing useful
00762   SIDE EFFECTS : initial-object definstances created
00763   NOTES        : None
00764  ********************************************************/
00765 static void CreateInitialDefinstances(
00766   void *theEnv)
00767   {
00768    EXPRESSION *tmp;
00769    DEFINSTANCES *theDefinstances;
00770 
00771    theDefinstances = get_struct(theEnv,definstances);
00772    InitializeConstructHeader(theEnv,"definstances",(struct constructHeader *) theDefinstances,
00773                              DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
00774    theDefinstances->busy = 0;
00775    tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"make-instance"));
00776    tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
00777    tmp->argList->nextArg =
00778        GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME));
00779    theDefinstances->mkinstance = PackExpression(theEnv,tmp);
00780    ReturnExpression(theEnv,tmp);
00781    IncrementSymbolCount(GetDefinstancesNamePointer((void *) theDefinstances));
00782    ExpressionInstall(theEnv,theDefinstances->mkinstance);
00783    AddConstructToModule((struct constructHeader *) theDefinstances);
00784   }
00785 
00786 #endif
00787 
00788 #endif
00789 
00790 #if ! RUN_TIME
00791 
00792 /*****************************************************
00793   NAME         : AllocateModule
00794   DESCRIPTION  : Creates and initializes a
00795                  list of definstances for a new module
00796   INPUTS       : None
00797   RETURNS      : The new definstances module
00798   SIDE EFFECTS : Definstances module created
00799   NOTES        : None
00800  *****************************************************/
00801 static void *AllocateModule(
00802   void *theEnv)
00803   {
00804    return((void *) get_struct(theEnv,definstancesModule));
00805   }
00806 
00807 /***************************************************
00808   NAME         : ReturnModule
00809   DESCRIPTION  : Removes a definstances module and
00810                  all associated definstances
00811   INPUTS       : The definstances module
00812   RETURNS      : Nothing useful
00813   SIDE EFFECTS : Module and definstances deleted
00814   NOTES        : None
00815  ***************************************************/
00816 static void ReturnModule(
00817   void *theEnv,
00818   void *theItem)
00819   {
00820 #if (! BLOAD_ONLY)
00821    FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefinstancesData(theEnv)->DefinstancesConstruct);
00822 #endif
00823    rtn_struct(theEnv,definstancesModule,theItem);
00824   }
00825 
00826 /***************************************************
00827   NAME         : ClearDefinstancesReady
00828   DESCRIPTION  : Determines if it is safe to
00829                  remove all definstances
00830                  Assumes *all* constructs will be
00831                  deleted
00832   INPUTS       : None
00833   RETURNS      : TRUE if all definstances can
00834                  be deleted, FALSE otherwise
00835   SIDE EFFECTS : None
00836   NOTES        : Used by (clear) and (bload)
00837  ***************************************************/
00838 static intBool ClearDefinstancesReady(
00839   void *theEnv)
00840   {
00841    int flagBuffer = TRUE;
00842 
00843    DoForAllConstructs(theEnv,CheckDefinstancesBusy,DefinstancesData(theEnv)->DefinstancesModuleIndex,
00844                       FALSE,(void *) &flagBuffer);
00845    return(flagBuffer);
00846   }
00847 
00848 /***************************************************
00849   NAME         : CheckDefinstancesBusy
00850   DESCRIPTION  : Determines if a definstances is
00851                  in use or not
00852   INPUTS       : 1) The definstances
00853                  2) A buffer to set to 0 if the
00854                     the definstances is busy
00855   RETURNS      : Nothing useful
00856   SIDE EFFECTS : Buffer set to 0 if definstances
00857                  busy
00858   NOTES        : The flag buffer is not modified
00859                  if definstances is not busy
00860                  (assumed to be initialized to 1)
00861  ***************************************************/
00862 #if WIN_BTC
00863 #pragma argsused
00864 #endif
00865 static void CheckDefinstancesBusy(
00866   void *theEnv,
00867   struct constructHeader *theDefinstances,
00868   void *userBuffer)
00869   {
00870 #if MAC_MCW || WIN_MCW || MAC_XCD
00871 #pragma unused(theEnv)
00872 #endif
00873 
00874    if (((DEFINSTANCES *) theDefinstances)->busy > 0)
00875      * (int *) userBuffer = FALSE;
00876   }
00877 
00878 #endif
00879 
00880 /***************************************************
00881   NAME         : ResetDefinstances
00882   DESCRIPTION  : Calls EvaluateExpression for each of
00883                    the make-instance calls in all
00884                    of the definstances constructs
00885   INPUTS       : None
00886   RETURNS      : Nothing useful
00887   SIDE EFFECTS : All instances in the definstances
00888                    are evaluated (and created if
00889                    there are no errors)
00890                  Any previously existing instances
00891                  are deleted first.
00892   NOTES        : None
00893  ***************************************************/
00894 static void ResetDefinstances(
00895   void *theEnv)
00896   {
00897    DoForAllConstructs(theEnv,ResetDefinstancesAction,DefinstancesData(theEnv)->DefinstancesModuleIndex,TRUE,NULL);
00898   }
00899 
00900 /***************************************************
00901   NAME         : ResetDefinstancesAction
00902   DESCRIPTION  : Performs all the make-instance
00903                  calls in a definstances
00904   INPUTS       : 1) The definstances
00905                  2) User data buffer (ignored)
00906   RETURNS      : Nothing useful
00907   SIDE EFFECTS : Instances created
00908   NOTES        : None
00909  ***************************************************/
00910 #if WIN_BTC
00911 #pragma argsused
00912 #endif
00913 static void ResetDefinstancesAction(
00914   void *theEnv,
00915   struct constructHeader *vDefinstances,
00916   void *userBuffer)
00917   {
00918 #if MAC_MCW || WIN_MCW || MAC_XCD
00919 #pragma unused(userBuffer)
00920 #endif
00921    DEFINSTANCES *theDefinstances = (DEFINSTANCES *) vDefinstances;
00922    EXPRESSION *theExp;
00923    DATA_OBJECT temp;
00924 
00925    SaveCurrentModule(theEnv);
00926    EnvSetCurrentModule(theEnv,(void *) vDefinstances->whichModule->theModule);
00927    theDefinstances->busy++;
00928    for (theExp = theDefinstances->mkinstance ;
00929         theExp != NULL ;
00930         theExp = GetNextArgument(theExp))
00931      {
00932       EvaluateExpression(theEnv,theExp,&temp);
00933       if (EvaluationData(theEnv)->HaltExecution ||
00934           ((GetType(temp) == SYMBOL) &&
00935            (GetValue(temp) == EnvFalseSymbol(theEnv))))
00936         {
00937          RestoreCurrentModule(theEnv);
00938          theDefinstances->busy--;
00939          return;
00940         }
00941      }
00942    theDefinstances->busy--;
00943    RestoreCurrentModule(theEnv);
00944   }
00945 
00946 #endif
00947 
00948