src/clipsrules/core/insfile.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*              CLIPS Version 6.24  06/05/06           */
00005    /*                                                     */
00006    /*         INSTANCE LOAD/SAVE (ASCII/BINARY) MODULE    */
00007    /*******************************************************/
00008 
00009 /*************************************************************/
00010 /* Purpose:  File load/save routines for instances           */
00011 /*                                                           */
00012 /* Principal Programmer(s):                                  */
00013 /*      Brian L. Dantes                                      */
00014 /*                                                           */
00015 /* Contributing Programmer(s):                               */
00016 /*                                                           */
00017 /* Revision History:                                         */
00018 /*                                                           */
00019 /*      6.24: Added environment parameter to GenClose.       */
00020 /*            Added environment parameter to GenOpen.        */
00021 /*                                                           */
00022 /*            Renamed BOOLEAN macro type to intBool.         */
00023 /*                                                           */
00024 /*            Corrected code to remove compiler warnings.    */
00025 /*                                                           */
00026 /*************************************************************/
00027 
00028 /* =========================================
00029    *****************************************
00030                EXTERNAL DEFINITIONS
00031    =========================================
00032    ***************************************** */
00033 
00034 #include <stdlib.h>
00035 
00036 #include "setup.h"
00037 
00038 #if OBJECT_SYSTEM
00039 
00040 #include "argacces.h"
00041 #include "classcom.h"
00042 #include "classfun.h"
00043 #include "memalloc.h"
00044 #include "extnfunc.h"
00045 #include "inscom.h"
00046 #include "insfun.h"
00047 #include "insmngr.h"
00048 #include "inspsr.h"
00049 #include "object.h"
00050 #include "router.h"
00051 #include "strngrtr.h"
00052 #include "symblbin.h"
00053 #include "sysdep.h"
00054 #include "envrnmnt.h"
00055 
00056 #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT
00057 #include "factmngr.h"
00058 #endif
00059 
00060 #define _INSFILE_SOURCE_
00061 #include "insfile.h"
00062 
00063 /* =========================================
00064    *****************************************
00065                    CONSTANTS
00066    =========================================
00067    ***************************************** */
00068 #define MAX_BLOCK_SIZE 10240
00069 
00070 /* =========================================
00071    *****************************************
00072                MACROS AND TYPES
00073    =========================================
00074    ***************************************** */
00075 struct bsaveSlotValue
00076   {
00077    long slotName;
00078    unsigned valueCount;
00079   };
00080 
00081 struct bsaveSlotValueAtom
00082   {
00083    unsigned short type;
00084    long value;
00085   };
00086 
00087 /* =========================================
00088    *****************************************
00089       INTERNALLY VISIBLE FUNCTION HEADERS
00090    =========================================
00091    ***************************************** */
00092 
00093 static long InstancesSaveCommandParser(void *,char *,long (*)(void *,char *,int,
00094                                                    EXPRESSION *,intBool));
00095 static DATA_OBJECT *ProcessSaveClassList(void *,char *,EXPRESSION *,int,intBool);
00096 static void ReturnSaveClassList(void *,DATA_OBJECT *);
00097 static long SaveOrMarkInstances(void *,void *,int,DATA_OBJECT *,intBool,intBool,
00098                                          void (*)(void *,void *,INSTANCE_TYPE *));
00099 static long SaveOrMarkInstancesOfClass(void *,void *,struct defmodule *,int,DEFCLASS *,
00100                                                 intBool,int,void (*)(void *,void *,INSTANCE_TYPE *));
00101 static void SaveSingleInstanceText(void *,void *,INSTANCE_TYPE *);
00102 static void ProcessFileErrorMessage(void *,char *,char *);
00103 #if BSAVE_INSTANCES
00104 static void WriteBinaryHeader(void *,FILE *);
00105 static void MarkSingleInstance(void *,void *,INSTANCE_TYPE *);
00106 static void MarkNeededAtom(void *,int,void *);
00107 static void SaveSingleInstanceBinary(void *,void *,INSTANCE_TYPE *);
00108 static void SaveAtomBinary(void *,unsigned short,void *,FILE *);
00109 #endif
00110 
00111 static long LoadOrRestoreInstances(void *,char *,int,int);
00112 
00113 #if BLOAD_INSTANCES
00114 static intBool VerifyBinaryHeader(void *,char *);
00115 static intBool LoadSingleBinaryInstance(void *);
00116 static void BinaryLoadInstanceError(void *,SYMBOL_HN *,DEFCLASS *);
00117 static void CreateSlotValue(void *,DATA_OBJECT *,struct bsaveSlotValueAtom *,unsigned long); 
00118 static void *GetBinaryAtomValue(void *,struct bsaveSlotValueAtom *);
00119 static void BufferedRead(void *,void *,unsigned long);
00120 static void FreeReadBuffer(void *);
00121 #endif
00122 
00123 /* =========================================
00124    *****************************************
00125           EXTERNALLY VISIBLE FUNCTIONS
00126    =========================================
00127    ***************************************** */
00128 
00129 /***************************************************
00130   NAME         : SetupInstanceFileCommands
00131   DESCRIPTION  : Defines function interfaces for
00132                  saving instances to files
00133   INPUTS       : None
00134   RETURNS      : Nothing useful
00135   SIDE EFFECTS : Functions defined to KB
00136   NOTES        : None
00137  ***************************************************/
00138 globle void SetupInstanceFileCommands(
00139   void *theEnv)
00140   {
00141 #if BLOAD_INSTANCES || BSAVE_INSTANCES
00142    AllocateEnvironmentData(theEnv,INSTANCE_FILE_DATA,sizeof(struct instanceFileData),NULL);
00143 
00144    InstanceFileData(theEnv)->InstanceBinaryPrefixID = "\5\6\7CLIPS";
00145    InstanceFileData(theEnv)->InstanceBinaryVersionID = "V6.00";
00146 #endif
00147 
00148 #if (! RUN_TIME)
00149    EnvDefineFunction2(theEnv,"save-instances",'l',PTIEF SaveInstancesCommand,
00150                    "SaveInstancesCommand","1*wk");
00151    EnvDefineFunction2(theEnv,"load-instances",'l',PTIEF LoadInstancesCommand,
00152                    "LoadInstancesCommand","11k");
00153    EnvDefineFunction2(theEnv,"restore-instances",'l',PTIEF RestoreInstancesCommand,
00154                    "RestoreInstancesCommand","11k");
00155 
00156 #if BSAVE_INSTANCES
00157    EnvDefineFunction2(theEnv,"bsave-instances",'l',PTIEF BinarySaveInstancesCommand,
00158                    "BinarySaveInstancesCommand","1*wk");
00159 #endif
00160 #if BLOAD_INSTANCES
00161    EnvDefineFunction2(theEnv,"bload-instances",'l',PTIEF BinaryLoadInstancesCommand,
00162                    "BinaryLoadInstancesCommand","11k");
00163 #endif
00164 
00165 #endif
00166   }
00167 
00168 
00169 /****************************************************************************
00170   NAME         : SaveInstancesCommand
00171   DESCRIPTION  : H/L interface for saving
00172                    current instances to a file
00173   INPUTS       : None
00174   RETURNS      : The number of instances saved
00175   SIDE EFFECTS : Instances saved to named file
00176   NOTES        : H/L Syntax :
00177                  (save-instances <file> [local|visible [[inherit] <class>+]])
00178  ****************************************************************************/
00179 globle long SaveInstancesCommand(
00180   void *theEnv)
00181   {
00182    return(InstancesSaveCommandParser(theEnv,"save-instances",EnvSaveInstances));
00183   }
00184 
00185 /******************************************************
00186   NAME         : LoadInstancesCommand
00187   DESCRIPTION  : H/L interface for loading
00188                    instances from a file
00189   INPUTS       : None
00190   RETURNS      : The number of instances loaded
00191   SIDE EFFECTS : Instances loaded from named file
00192   NOTES        : H/L Syntax : (load-instances <file>)
00193  ******************************************************/
00194 globle long LoadInstancesCommand(
00195   void *theEnv)
00196   {
00197    char *fileFound;
00198    DATA_OBJECT temp;
00199    long instanceCount;
00200 
00201    if (EnvArgTypeCheck(theEnv,"load-instances",1,SYMBOL_OR_STRING,&temp) == FALSE)
00202      return(0L);
00203 
00204    fileFound = DOToString(temp);
00205 
00206    instanceCount = EnvLoadInstances(theEnv,fileFound);
00207    if (EvaluationData(theEnv)->EvaluationError)
00208      ProcessFileErrorMessage(theEnv,"load-instances",fileFound);
00209    return(instanceCount);
00210   }
00211 
00212 /***************************************************
00213   NAME         : EnvLoadInstances
00214   DESCRIPTION  : Loads instances from named file
00215   INPUTS       : The name of the input file
00216   RETURNS      : The number of instances loaded
00217   SIDE EFFECTS : Instances loaded from file
00218   NOTES        : None
00219  ***************************************************/
00220 globle long EnvLoadInstances(
00221   void *theEnv,
00222   char *file)
00223   {
00224    return(LoadOrRestoreInstances(theEnv,file,TRUE,TRUE));
00225   }
00226 
00227 /***************************************************
00228   NAME         : EnvLoadInstancesFromString
00229   DESCRIPTION  : Loads instances from given string
00230   INPUTS       : 1) The input string
00231                  2) Index of char in string after
00232                     last valid char (-1 for all chars)
00233   RETURNS      : The number of instances loaded
00234   SIDE EFFECTS : Instances loaded from string
00235   NOTES        : Uses string routers
00236  ***************************************************/
00237 globle long EnvLoadInstancesFromString(
00238   void *theEnv,
00239   char *theString,
00240   int theMax)
00241   {
00242    long theCount;
00243    char * theStrRouter = "*** load-instances-from-string ***";
00244 
00245    if ((theMax == -1) ? (!OpenStringSource(theEnv,theStrRouter,theString,0)) :
00246                         (!OpenTextSource(theEnv,theStrRouter,theString,0,(unsigned) theMax)))
00247      return(-1L);
00248    theCount = LoadOrRestoreInstances(theEnv,theStrRouter,TRUE,FALSE);
00249    CloseStringSource(theEnv,theStrRouter);
00250    return(theCount);
00251   }
00252 
00253 /*********************************************************
00254   NAME         : RestoreInstancesCommand
00255   DESCRIPTION  : H/L interface for loading
00256                    instances from a file w/o messages
00257   INPUTS       : None
00258   RETURNS      : The number of instances restored
00259   SIDE EFFECTS : Instances loaded from named file
00260   NOTES        : H/L Syntax : (restore-instances <file>)
00261  *********************************************************/
00262 globle long RestoreInstancesCommand(
00263   void *theEnv)
00264   {
00265    char *fileFound;
00266    DATA_OBJECT temp;
00267    long instanceCount;
00268 
00269    if (EnvArgTypeCheck(theEnv,"restore-instances",1,SYMBOL_OR_STRING,&temp) == FALSE)
00270      return(0L);
00271 
00272    fileFound = DOToString(temp);
00273 
00274    instanceCount = EnvRestoreInstances(theEnv,fileFound);
00275    if (EvaluationData(theEnv)->EvaluationError)
00276      ProcessFileErrorMessage(theEnv,"restore-instances",fileFound);
00277    return(instanceCount);
00278   }
00279 
00280 /***************************************************
00281   NAME         : EnvRestoreInstances
00282   DESCRIPTION  : Restores instances from named file
00283   INPUTS       : The name of the input file
00284   RETURNS      : The number of instances restored
00285   SIDE EFFECTS : Instances restored from file
00286   NOTES        : None
00287  ***************************************************/
00288 globle long EnvRestoreInstances(
00289   void *theEnv,
00290   char *file)
00291   {
00292    return(LoadOrRestoreInstances(theEnv,file,FALSE,TRUE));
00293   }
00294 
00295 /***************************************************
00296   NAME         : EnvRestoreInstancesFromString
00297   DESCRIPTION  : Restores instances from given string
00298   INPUTS       : 1) The input string
00299                  2) Index of char in string after
00300                     last valid char (-1 for all chars)
00301   RETURNS      : The number of instances loaded
00302   SIDE EFFECTS : Instances loaded from string
00303   NOTES        : Uses string routers
00304  ***************************************************/
00305 globle long EnvRestoreInstancesFromString(
00306   void *theEnv,
00307   char *theString,
00308   int theMax)
00309   {
00310    long theCount;
00311    char * theStrRouter = "*** load-instances-from-string ***";
00312 
00313    if ((theMax == -1) ? (!OpenStringSource(theEnv,theStrRouter,theString,0)) :
00314                         (!OpenTextSource(theEnv,theStrRouter,theString,0,(unsigned) theMax)))
00315      return(-1L);
00316    theCount = LoadOrRestoreInstances(theEnv,theStrRouter,FALSE,FALSE);
00317    CloseStringSource(theEnv,theStrRouter);
00318    return(theCount);
00319   }
00320 
00321 #if BLOAD_INSTANCES
00322 
00323 /*******************************************************
00324   NAME         : BinaryLoadInstancesCommand
00325   DESCRIPTION  : H/L interface for loading
00326                    instances from a binary file
00327   INPUTS       : None
00328   RETURNS      : The number of instances loaded
00329   SIDE EFFECTS : Instances loaded from named binary file
00330   NOTES        : H/L Syntax : (bload-instances <file>)
00331  *******************************************************/
00332 globle long BinaryLoadInstancesCommand(
00333   void *theEnv)
00334   {
00335    char *fileFound;
00336    DATA_OBJECT temp;
00337    long instanceCount;
00338 
00339    if (EnvArgTypeCheck(theEnv,"bload-instances",1,SYMBOL_OR_STRING,&temp) == FALSE)
00340      return(0L);
00341 
00342    fileFound = DOToString(temp);
00343 
00344    instanceCount = EnvBinaryLoadInstances(theEnv,fileFound);
00345    if (EvaluationData(theEnv)->EvaluationError)
00346      ProcessFileErrorMessage(theEnv,"bload-instances",fileFound);
00347    return(instanceCount);
00348   }
00349 
00350 /****************************************************
00351   NAME         : EnvBinaryLoadInstances
00352   DESCRIPTION  : Loads instances quickly from a
00353                  binary file
00354   INPUTS       : The file name
00355   RETURNS      : The number of instances loaded
00356   SIDE EFFECTS : Instances loaded w/o message-passing
00357   NOTES        : None
00358  ****************************************************/
00359 globle long EnvBinaryLoadInstances(
00360   void *theEnv,
00361   char *theFile)
00362   {
00363    long i,instanceCount;
00364 
00365    if (GenOpenReadBinary(theEnv,"bload-instances",theFile) == 0)
00366      {
00367       SetEvaluationError(theEnv,TRUE);
00368       return(-1L);
00369      }
00370    if (VerifyBinaryHeader(theEnv,theFile) == FALSE)
00371      {
00372       GenCloseBinary(theEnv);
00373       SetEvaluationError(theEnv,TRUE);
00374       return(-1L);
00375      }
00376    
00377    EnvIncrementGCLocks(theEnv);
00378    ReadNeededAtomicValues(theEnv);
00379 
00380    InstanceFileData(theEnv)->BinaryInstanceFileOffset = 0L;
00381 
00382    GenReadBinary(theEnv,(void *) &InstanceFileData(theEnv)->BinaryInstanceFileSize,sizeof(unsigned long));
00383    GenReadBinary(theEnv,(void *) &instanceCount,sizeof(long));
00384 
00385    for (i = 0L ; i < instanceCount ; i++)
00386      {
00387       if (LoadSingleBinaryInstance(theEnv) == FALSE)
00388         {
00389          FreeReadBuffer(theEnv);
00390          FreeAtomicValueStorage(theEnv);
00391          GenCloseBinary(theEnv);
00392          SetEvaluationError(theEnv,TRUE);
00393          EnvDecrementGCLocks(theEnv);
00394          return(i);
00395         }
00396      }
00397 
00398    FreeReadBuffer(theEnv);
00399    FreeAtomicValueStorage(theEnv);
00400    GenCloseBinary(theEnv);
00401 
00402    EnvDecrementGCLocks(theEnv);
00403    return(instanceCount);
00404   }
00405 
00406 #endif
00407 
00408 /*******************************************************
00409   NAME         : EnvSaveInstances
00410   DESCRIPTION  : Saves current instances to named file
00411   INPUTS       : 1) The name of the output file
00412                  2) A flag indicating whether to
00413                     save local (current module only)
00414                     or visible instances
00415                     LOCAL_SAVE or VISIBLE_SAVE
00416                  3) A list of expressions containing
00417                     the names of classes for which
00418                     instances are to be saved
00419                  4) A flag indicating if the subclasses
00420                     of specified classes shoudl also
00421                     be processed
00422   RETURNS      : The number of instances saved
00423   SIDE EFFECTS : Instances saved to file
00424   NOTES        : None
00425  *******************************************************/
00426 globle long EnvSaveInstances(
00427   void *theEnv,
00428   char *file,
00429   int saveCode,
00430   EXPRESSION *classExpressionList,
00431   intBool inheritFlag)
00432   {
00433    FILE *sfile = NULL;
00434    int oldPEC,oldATS,oldIAN;
00435    DATA_OBJECT *classList;
00436    long instanceCount;
00437 
00438    classList = ProcessSaveClassList(theEnv,"save-instances",classExpressionList,
00439                                     saveCode,inheritFlag);
00440    if ((classList == NULL) && (classExpressionList != NULL))
00441      return(0L);
00442 
00443    SaveOrMarkInstances(theEnv,(void *) sfile,saveCode,classList,
00444                              inheritFlag,TRUE,NULL);
00445 
00446    if ((sfile = GenOpen(theEnv,file,"w")) == NULL)
00447      {
00448       OpenErrorMessage(theEnv,"save-instances",file);
00449       ReturnSaveClassList(theEnv,classList);
00450       SetEvaluationError(theEnv,TRUE);
00451       return(0L);
00452      }
00453 
00454    oldPEC = PrintUtilityData(theEnv)->PreserveEscapedCharacters;
00455    PrintUtilityData(theEnv)->PreserveEscapedCharacters = TRUE;
00456    oldATS = PrintUtilityData(theEnv)->AddressesToStrings;
00457    PrintUtilityData(theEnv)->AddressesToStrings = TRUE;
00458    oldIAN = PrintUtilityData(theEnv)->InstanceAddressesToNames;
00459    PrintUtilityData(theEnv)->InstanceAddressesToNames = TRUE;
00460 
00461    SetFastSave(theEnv,sfile);
00462    instanceCount = SaveOrMarkInstances(theEnv,(void *) sfile,saveCode,classList,
00463                                        inheritFlag,TRUE,SaveSingleInstanceText);
00464    GenClose(theEnv,sfile);
00465    SetFastSave(theEnv,NULL);
00466 
00467    PrintUtilityData(theEnv)->PreserveEscapedCharacters = oldPEC;
00468    PrintUtilityData(theEnv)->AddressesToStrings = oldATS;
00469    PrintUtilityData(theEnv)->InstanceAddressesToNames = oldIAN;
00470    ReturnSaveClassList(theEnv,classList);
00471    return(instanceCount);
00472   }
00473 
00474 #if BSAVE_INSTANCES
00475 
00476 /****************************************************************************
00477   NAME         : BinarySaveInstancesCommand
00478   DESCRIPTION  : H/L interface for saving
00479                    current instances to a binary file
00480   INPUTS       : None
00481   RETURNS      : The number of instances saved
00482   SIDE EFFECTS : Instances saved (in binary format) to named file
00483   NOTES        : H/L Syntax :
00484                  (bsave-instances <file> [local|visible [[inherit] <class>+]])
00485  *****************************************************************************/
00486 globle long BinarySaveInstancesCommand(
00487   void *theEnv)
00488   {
00489    return(InstancesSaveCommandParser(theEnv,"bsave-instances",EnvBinarySaveInstances));
00490   }
00491 
00492 /*******************************************************
00493   NAME         : EnvBinarySaveInstances
00494   DESCRIPTION  : Saves current instances to binary file
00495   INPUTS       : 1) The name of the output file
00496                  2) A flag indicating whether to
00497                     save local (current module only)
00498                     or visible instances
00499                     LOCAL_SAVE or VISIBLE_SAVE
00500                  3) A list of expressions containing
00501                     the names of classes for which
00502                     instances are to be saved
00503                  4) A flag indicating if the subclasses
00504                     of specified classes shoudl also
00505                     be processed
00506   RETURNS      : The number of instances saved
00507   SIDE EFFECTS : Instances saved to file
00508   NOTES        : None
00509  *******************************************************/
00510 globle long EnvBinarySaveInstances(
00511   void *theEnv,
00512   char *file,
00513   int saveCode,
00514   EXPRESSION *classExpressionList,
00515   intBool inheritFlag)
00516   {
00517    DATA_OBJECT *classList;
00518    FILE *bsaveFP;
00519    long instanceCount;
00520 
00521    classList = ProcessSaveClassList(theEnv,"bsave-instances",classExpressionList,
00522                                     saveCode,inheritFlag);
00523    if ((classList == NULL) && (classExpressionList != NULL))
00524      return(0L);
00525 
00526    InstanceFileData(theEnv)->BinaryInstanceFileSize = 0L;
00527    InitAtomicValueNeededFlags(theEnv);
00528    instanceCount = SaveOrMarkInstances(theEnv,NULL,saveCode,classList,inheritFlag,
00529                                        FALSE,MarkSingleInstance);
00530 
00531    if ((bsaveFP = GenOpen(theEnv,file,"wb")) == NULL)
00532      {
00533       OpenErrorMessage(theEnv,"bsave-instances",file);
00534       ReturnSaveClassList(theEnv,classList);
00535       SetEvaluationError(theEnv,TRUE);
00536       return(0L);
00537      }
00538    WriteBinaryHeader(theEnv,bsaveFP);
00539    WriteNeededAtomicValues(theEnv,bsaveFP);
00540 
00541    fwrite((void *) &InstanceFileData(theEnv)->BinaryInstanceFileSize,sizeof(unsigned long),1,bsaveFP);
00542    fwrite((void *) &instanceCount,sizeof(long),1,bsaveFP);
00543 
00544    SetAtomicValueIndices(theEnv,FALSE);
00545    SaveOrMarkInstances(theEnv,(void *) bsaveFP,saveCode,classList,
00546                        inheritFlag,FALSE,SaveSingleInstanceBinary);
00547    RestoreAtomicValueBuckets(theEnv);
00548    GenClose(theEnv,bsaveFP);
00549    ReturnSaveClassList(theEnv,classList);
00550    return(instanceCount);
00551   }
00552 
00553 #endif
00554 
00555 /* =========================================
00556    *****************************************
00557           INTERNALLY VISIBLE FUNCTIONS
00558    =========================================
00559    ***************************************** */
00560 
00561 /******************************************************
00562   NAME         : InstancesSaveCommandParser
00563   DESCRIPTION  : Argument parser for save-instances
00564                  and bsave-instances
00565   INPUTS       : 1) The name of the calling function
00566                  2) A pointer to the support
00567                     function to call for the save/bsave
00568   RETURNS      : The number of instances saved
00569   SIDE EFFECTS : Instances saved/bsaved
00570   NOTES        : None
00571  ******************************************************/
00572 static long InstancesSaveCommandParser(
00573   void *theEnv,
00574   char *functionName,
00575   long (*saveFunction)(void *,char *,int,EXPRESSION *,intBool))
00576   {
00577    char *fileFound;
00578    DATA_OBJECT temp;
00579    int argCount,saveCode = LOCAL_SAVE;
00580    EXPRESSION *classList = NULL;
00581    intBool inheritFlag = FALSE;
00582 
00583    if (EnvArgTypeCheck(theEnv,functionName,1,SYMBOL_OR_STRING,&temp) == FALSE)
00584      return(0L);
00585    fileFound = DOToString(temp);
00586 
00587    argCount = EnvRtnArgCount(theEnv);
00588    if (argCount > 1)
00589      {
00590       if (EnvArgTypeCheck(theEnv,functionName,2,SYMBOL,&temp) == FALSE)
00591         {
00592          ExpectedTypeError1(theEnv,functionName,2,"symbol \"local\" or \"visible\"");
00593          SetEvaluationError(theEnv,TRUE);
00594          return(0L);
00595         }
00596       if (strcmp(DOToString(temp),"local") == 0)
00597         saveCode = LOCAL_SAVE;
00598       else if (strcmp(DOToString(temp),"visible") == 0)
00599         saveCode = VISIBLE_SAVE;
00600       else
00601         {
00602          ExpectedTypeError1(theEnv,functionName,2,"symbol \"local\" or \"visible\"");
00603          SetEvaluationError(theEnv,TRUE);
00604          return(0L);
00605         }
00606       classList = GetFirstArgument()->nextArg->nextArg;
00607 
00608       /* ===========================
00609          Check for "inherit" keyword
00610          Must be at least one class
00611          name following
00612          =========================== */
00613       if ((classList != NULL) ? (classList->nextArg != NULL) : FALSE)
00614         {
00615          if ((classList->type != SYMBOL) ? FALSE :
00616              (strcmp(ValueToString(classList->value),"inherit") == 0))
00617            {
00618             inheritFlag = TRUE;
00619             classList = classList->nextArg;
00620            }
00621         }
00622      }
00623 
00624    return((*saveFunction)(theEnv,fileFound,saveCode,classList,inheritFlag));
00625   }
00626 
00627 /****************************************************
00628   NAME         : ProcessSaveClassList
00629   DESCRIPTION  : Evaluates a list of class name
00630                  expressions and stores them in a
00631                  data object list
00632   INPUTS       : 1) The name of the calling function
00633                  2) The class expression list
00634                  3) A flag indicating if only local
00635                     or all visible instances are
00636                     being saved
00637                  4) A flag indicating if inheritance
00638                     relationships should be checked
00639                     between classes
00640   RETURNS      : The evaluated class pointer data
00641                  objects - NULL on errors
00642   SIDE EFFECTS : Data objects allocated and
00643                  classes validated
00644   NOTES        : None
00645  ****************************************************/
00646 static DATA_OBJECT *ProcessSaveClassList(
00647   void *theEnv,
00648   char *functionName,
00649   EXPRESSION *classExps,
00650   int saveCode,
00651   intBool inheritFlag)
00652   {
00653    DATA_OBJECT *head = NULL,*prv,*newItem,tmp;
00654    DEFCLASS *theDefclass;
00655    struct defmodule *currentModule;
00656    int argIndex = inheritFlag ? 4 : 3;
00657 
00658    currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
00659    while (classExps != NULL)
00660      {
00661       if (EvaluateExpression(theEnv,classExps,&tmp))
00662         goto ProcessClassListError;
00663       if (tmp.type != SYMBOL)
00664         goto ProcessClassListError;
00665       if (saveCode == LOCAL_SAVE)
00666         theDefclass = LookupDefclassAnywhere(theEnv,currentModule,DOToString(tmp));
00667       else
00668         theDefclass = LookupDefclassInScope(theEnv,DOToString(tmp));
00669       if (theDefclass == NULL)
00670         goto ProcessClassListError;
00671       else if (theDefclass->abstract && (inheritFlag == FALSE))
00672         goto ProcessClassListError;
00673       prv = newItem = head;
00674       while (newItem != NULL)
00675         {
00676          if (newItem->value == (void *) theDefclass)
00677            goto ProcessClassListError;
00678          else if (inheritFlag)
00679            {
00680             if (HasSuperclass((DEFCLASS *) newItem->value,theDefclass) ||
00681                 HasSuperclass(theDefclass,(DEFCLASS *) newItem->value))
00682              goto ProcessClassListError;
00683            }
00684          prv = newItem;
00685          newItem = newItem->next;
00686         }
00687       newItem = get_struct(theEnv,dataObject);
00688       newItem->type = DEFCLASS_PTR;
00689       newItem->value = (void *) theDefclass;
00690       newItem->next = NULL;
00691       if (prv == NULL)
00692         head = newItem;
00693       else
00694         prv->next = newItem;
00695       argIndex++;
00696       classExps = classExps->nextArg;
00697      }
00698    return(head);
00699 
00700 ProcessClassListError:
00701    if (inheritFlag)
00702      ExpectedTypeError1(theEnv,functionName,argIndex,"valid class name");
00703    else
00704      ExpectedTypeError1(theEnv,functionName,argIndex,"valid concrete class name");
00705    ReturnSaveClassList(theEnv,head);
00706    SetEvaluationError(theEnv,TRUE);
00707    return(NULL);
00708   }
00709 
00710 /****************************************************
00711   NAME         : ReturnSaveClassList
00712   DESCRIPTION  : Deallocates the class data object
00713                  list created by ProcessSaveClassList
00714   INPUTS       : The class data object list
00715   RETURNS      : Nothing useful
00716   SIDE EFFECTS : Class data object returned
00717   NOTES        : None
00718  ****************************************************/
00719 static void ReturnSaveClassList(
00720   void *theEnv,
00721   DATA_OBJECT *classList)
00722   {
00723    DATA_OBJECT *tmp;
00724 
00725    while (classList != NULL)
00726      {
00727       tmp = classList;
00728       classList = classList->next;
00729       rtn_struct(theEnv,dataObject,tmp);
00730      }
00731   }
00732 
00733 /***************************************************
00734   NAME         : SaveOrMarkInstances
00735   DESCRIPTION  : Iterates through all specified
00736                  instances either marking needed
00737                  atoms or writing instances in
00738                  binary/text format
00739   INPUTS       : 1) NULL (for marking),
00740                     logical name (for text saves)
00741                     file pointer (for binary saves)
00742                  2) A cope flag indicating LOCAL
00743                     or VISIBLE saves only
00744                  3) A list of data objects
00745                     containing the names of classes
00746                     of instances to be saved
00747                  4) A flag indicating whether to
00748                     include subclasses of arg #3
00749                  5) A flag indicating if the
00750                     iteration can be interrupted
00751                     or not
00752                  6) The access function to mark
00753                     or save an instance (can be NULL
00754                     if only counting instances)
00755   RETURNS      : The number of instances saved
00756   SIDE EFFECTS : Instances amrked or saved
00757   NOTES        : None
00758  ***************************************************/
00759 static long SaveOrMarkInstances(
00760   void *theEnv,
00761   void *theOutput,
00762   int saveCode,
00763   DATA_OBJECT *classList,
00764   intBool inheritFlag,
00765   intBool interruptOK,
00766   void (*saveInstanceFunc)(void *,void *,INSTANCE_TYPE *))
00767   {
00768    struct defmodule *currentModule;
00769    int traversalID;
00770    DATA_OBJECT *tmp;
00771    INSTANCE_TYPE *ins;
00772    long instanceCount = 0L;
00773 
00774    currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
00775    if (classList != NULL)
00776      {
00777       traversalID = GetTraversalID(theEnv);
00778       if (traversalID != -1)
00779         {
00780          for (tmp = classList ;
00781               (! ((tmp == NULL) || (EvaluationData(theEnv)->HaltExecution && interruptOK))) ;
00782               tmp = tmp->next)
00783            instanceCount += SaveOrMarkInstancesOfClass(theEnv,theOutput,currentModule,saveCode,
00784                                                        (DEFCLASS *) tmp->value,inheritFlag,
00785                                                        traversalID,saveInstanceFunc);
00786          ReleaseTraversalID(theEnv);
00787         }
00788      }
00789    else
00790      {
00791       for (ins = (INSTANCE_TYPE *) GetNextInstanceInScope(theEnv,NULL) ;
00792            (ins != NULL) && (EvaluationData(theEnv)->HaltExecution != TRUE) ;
00793            ins = (INSTANCE_TYPE *) GetNextInstanceInScope(theEnv,(void *) ins))
00794         {
00795          if ((saveCode == VISIBLE_SAVE) ? TRUE :
00796              (ins->cls->header.whichModule->theModule == currentModule))
00797            {
00798             if (saveInstanceFunc != NULL)
00799               (*saveInstanceFunc)(theEnv,theOutput,ins);
00800             instanceCount++;
00801            }
00802         }
00803      }
00804    return(instanceCount);
00805   }
00806 
00807 /***************************************************
00808   NAME         : SaveOrMarkInstancesOfClass
00809   DESCRIPTION  : Saves off the direct (and indirect)
00810                  instance of the specified class
00811   INPUTS       : 1) The logical name of the output
00812                     (or file pointer for binary
00813                      output)
00814                  2) The current module
00815                  3) A flag indicating local
00816                     or visible saves
00817                  4) The defclass
00818                  5) A flag indicating whether to
00819                     save subclass instances or not
00820                  6) A traversal id for marking
00821                     visited classes
00822                  7) A pointer to the instance
00823                     manipulation function to call
00824                     (can be NULL for only counting
00825                      instances)
00826   RETURNS      : The number of instances saved
00827   SIDE EFFECTS : Appropriate instances saved
00828   NOTES        : None
00829  ***************************************************/
00830 static long SaveOrMarkInstancesOfClass(
00831   void *theEnv,
00832   void *theOutput,
00833   struct defmodule *currentModule,
00834   int saveCode,
00835   DEFCLASS *theDefclass,
00836   intBool inheritFlag,
00837   int traversalID,
00838   void (*saveInstanceFunc)(void *,void *,INSTANCE_TYPE *))
00839   {
00840    INSTANCE_TYPE *theInstance;
00841    DEFCLASS *subclass;
00842    long i;
00843    long instanceCount = 0L;
00844 
00845    if (TestTraversalID(theDefclass->traversalRecord,traversalID))
00846      return(instanceCount);
00847    SetTraversalID(theDefclass->traversalRecord,traversalID);
00848    if (((saveCode == LOCAL_SAVE) &&
00849         (theDefclass->header.whichModule->theModule == currentModule)) ||
00850        ((saveCode == VISIBLE_SAVE) &&
00851         DefclassInScope(theEnv,theDefclass,currentModule)))
00852      {
00853       for (theInstance = (INSTANCE_TYPE *)
00854              EnvGetNextInstanceInClass(theEnv,(void *) theDefclass,NULL) ;
00855            theInstance != NULL ;
00856            theInstance = (INSTANCE_TYPE *)
00857            EnvGetNextInstanceInClass(theEnv,(void *) theDefclass,(void *) theInstance))
00858         {
00859          if (saveInstanceFunc != NULL)
00860            (*saveInstanceFunc)(theEnv,theOutput,theInstance);
00861          instanceCount++;
00862         }
00863      }
00864    if (inheritFlag)
00865      {
00866       for (i = 0 ; i < theDefclass->directSubclasses.classCount ; i++)
00867         {
00868          subclass = theDefclass->directSubclasses.classArray[i];
00869            instanceCount += SaveOrMarkInstancesOfClass(theEnv,theOutput,currentModule,saveCode,
00870                                                        subclass,TRUE,traversalID,
00871                                                        saveInstanceFunc);
00872         }
00873      }
00874    return(instanceCount);
00875   }
00876 
00877 /***************************************************
00878   NAME         : SaveSingleInstanceText
00879   DESCRIPTION  : Writes given instance to file
00880   INPUTS       : 1) The logical name of the output
00881                  2) The instance to save
00882   RETURNS      : Nothing useful
00883   SIDE EFFECTS : Instance written
00884   NOTES        : None
00885  ***************************************************/
00886 static void SaveSingleInstanceText(
00887   void *theEnv,
00888   void *vLogicalName,
00889   INSTANCE_TYPE *theInstance)
00890   {
00891    long i;
00892    INSTANCE_SLOT *sp;
00893    char *logicalName = (char *) vLogicalName;
00894 
00895    EnvPrintRouter(theEnv,logicalName,"([");
00896    EnvPrintRouter(theEnv,logicalName,ValueToString(theInstance->name));
00897    EnvPrintRouter(theEnv,logicalName,"] of ");
00898    EnvPrintRouter(theEnv,logicalName,ValueToString(theInstance->cls->header.name));
00899    for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
00900      {
00901       sp = theInstance->slotAddresses[i];
00902       EnvPrintRouter(theEnv,logicalName,"\n   (");
00903       EnvPrintRouter(theEnv,logicalName,ValueToString(sp->desc->slotName->name));
00904       if (sp->type != MULTIFIELD)
00905         {
00906          EnvPrintRouter(theEnv,logicalName," ");
00907          PrintAtom(theEnv,logicalName,(int) sp->type,sp->value);
00908         }
00909       else if (GetInstanceSlotLength(sp) != 0)
00910         {
00911          EnvPrintRouter(theEnv,logicalName," ");
00912          PrintMultifield(theEnv,logicalName,(MULTIFIELD_PTR) sp->value,0,
00913                          (long) (GetInstanceSlotLength(sp) - 1),FALSE);
00914         }
00915       EnvPrintRouter(theEnv,logicalName,")");
00916      }
00917    EnvPrintRouter(theEnv,logicalName,")\n\n");
00918   }
00919 
00920 #if BSAVE_INSTANCES
00921 
00922 /***************************************************
00923   NAME         : WriteBinaryHeader
00924   DESCRIPTION  : Writes identifying string to
00925                  instance binary file to assist in
00926                  later verification
00927   INPUTS       : The binary file pointer
00928   RETURNS      : Nothing useful
00929   SIDE EFFECTS : Binary prefix headers written
00930   NOTES        : None
00931  ***************************************************/
00932 static void WriteBinaryHeader(
00933   void *theEnv,
00934   FILE *bsaveFP)
00935   {   
00936    fwrite((void *) InstanceFileData(theEnv)->InstanceBinaryPrefixID,
00937           (STD_SIZE) (strlen(InstanceFileData(theEnv)->InstanceBinaryPrefixID) + 1),1,bsaveFP);
00938    fwrite((void *) InstanceFileData(theEnv)->InstanceBinaryVersionID,
00939           (STD_SIZE) (strlen(InstanceFileData(theEnv)->InstanceBinaryVersionID) + 1),1,bsaveFP);
00940   }
00941 
00942 /***************************************************
00943   NAME         : MarkSingleInstance
00944   DESCRIPTION  : Marks all the atoms needed in
00945                  the slot values of an instance
00946   INPUTS       : 1) The output (ignored)
00947                  2) The instance
00948   RETURNS      : Nothing useful
00949   SIDE EFFECTS : Instance slot value atoms marked
00950   NOTES        : None
00951  ***************************************************/
00952 #if WIN_BTC
00953 #pragma argsused
00954 #endif
00955 static void MarkSingleInstance(
00956   void *theEnv,
00957   void *theOutput,
00958   INSTANCE_TYPE *theInstance)
00959   {
00960 #if MAC_MCW || WIN_MCW || MAC_XCD
00961 #pragma unused(theOutput)
00962 #endif
00963    INSTANCE_SLOT *sp;
00964    long i, j;
00965 
00966    InstanceFileData(theEnv)->BinaryInstanceFileSize += (unsigned long) (sizeof(long) * 2);
00967    theInstance->name->neededSymbol = TRUE;
00968    theInstance->cls->header.name->neededSymbol = TRUE;
00969    InstanceFileData(theEnv)->BinaryInstanceFileSize +=
00970        (unsigned long) ((sizeof(long) * 2) +
00971                         (sizeof(struct bsaveSlotValue) *
00972                          theInstance->cls->instanceSlotCount) +
00973                         sizeof(unsigned long) +
00974                         sizeof(unsigned));
00975    for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
00976      {
00977       sp = theInstance->slotAddresses[i];
00978       sp->desc->slotName->name->neededSymbol = TRUE;
00979       if (sp->desc->multiple)
00980         {
00981          for (j = 1 ; j <= GetInstanceSlotLength(sp) ; j++)
00982            MarkNeededAtom(theEnv,GetMFType(sp->value,j),GetMFValue(sp->value,j));
00983         }
00984       else
00985         MarkNeededAtom(theEnv,(int) sp->type,sp->value);
00986      }
00987   }
00988 
00989 /***************************************************
00990   NAME         : MarkNeededAtom
00991   DESCRIPTION  : Marks an integer/float/symbol as
00992                  being need by a set of instances
00993   INPUTS       : 1) The type of atom
00994                  2) The value of the atom
00995   RETURNS      : Nothing useful
00996   SIDE EFFECTS : Atom marked for saving
00997   NOTES        : None
00998  ***************************************************/
00999 static void MarkNeededAtom(
01000   void *theEnv,
01001   int type,
01002   void *value)
01003   {
01004    InstanceFileData(theEnv)->BinaryInstanceFileSize += (unsigned long) sizeof(struct bsaveSlotValueAtom);
01005 
01006    /* =====================================
01007       Assumes slot value atoms  can only be
01008       floats, integers, symbols, strings,
01009       instance-names, instance-addresses,
01010       fact-addresses or external-addresses
01011       ===================================== */
01012    switch (type)
01013      {
01014       case SYMBOL:
01015       case STRING:
01016       case INSTANCE_NAME:
01017          ((SYMBOL_HN *) value)->neededSymbol = TRUE;
01018          break;
01019       case FLOAT:
01020          ((FLOAT_HN *) value)->neededFloat = TRUE;
01021          break;
01022       case INTEGER:
01023          ((INTEGER_HN *) value)->neededInteger = TRUE;
01024          break;
01025       case INSTANCE_ADDRESS:
01026          GetFullInstanceName(theEnv,(INSTANCE_TYPE *) value)->neededSymbol = TRUE;
01027          break;
01028      }
01029   }
01030 
01031 /****************************************************
01032   NAME         : SaveSingleInstanceBinary
01033   DESCRIPTION  : Writes given instance to binary file
01034   INPUTS       : 1) Binary file pointer
01035                  2) The instance to save
01036   RETURNS      : Nothing useful
01037   SIDE EFFECTS : Instance written
01038   NOTES        : None
01039  ****************************************************/
01040 static void SaveSingleInstanceBinary(
01041   void *theEnv,
01042   void *vBsaveFP,
01043   INSTANCE_TYPE *theInstance)
01044   {
01045    long nameIndex;
01046    long i,j;
01047    INSTANCE_SLOT *sp;
01048    FILE *bsaveFP = (FILE *) vBsaveFP;
01049    struct bsaveSlotValue bs;
01050    long totalValueCount = 0L;
01051    long slotLen;
01052 
01053    /* ===========================
01054       Write out the instance name
01055       =========================== */
01056    nameIndex = (long) theInstance->name->bucket;
01057    fwrite((void *) &nameIndex,(int) sizeof(long),1,bsaveFP);
01058 
01059    /* ========================
01060       Write out the class name
01061       ======================== */
01062    nameIndex = (long) theInstance->cls->header.name->bucket;
01063    fwrite((void *) &nameIndex,(int) sizeof(long),1,bsaveFP);
01064 
01065    /* ======================================
01066       Write out the number of slot-overrides
01067       ====================================== */
01068    fwrite((void *) &theInstance->cls->instanceSlotCount,
01069           (int) sizeof(short),1,bsaveFP);
01070 
01071    /* =========================================
01072       Write out the slot names and value counts
01073       ========================================= */
01074    for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
01075      {
01076       sp = theInstance->slotAddresses[i];
01077 
01078       /* ===============================================
01079          Write out the number of atoms in the slot value
01080          =============================================== */
01081       bs.slotName = (long) sp->desc->slotName->name->bucket;
01082       bs.valueCount = sp->desc->multiple ? GetInstanceSlotLength(sp) : 1;
01083       fwrite((void *) &bs,(int) sizeof(struct bsaveSlotValue),1,bsaveFP);
01084       totalValueCount += (unsigned long) bs.valueCount;
01085      }
01086 
01087    /* ==================================
01088       Write out the number of slot value
01089       atoms for the whole instance
01090       ================================== */
01091    if (totalValueCount != 0L)
01092      fwrite((void *) &totalValueCount,(int) sizeof(unsigned long),1,bsaveFP);
01093 
01094    /* ==============================
01095       Write out the slot value atoms
01096       ============================== */
01097    for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
01098      {
01099       sp = theInstance->slotAddresses[i];
01100       slotLen = sp->desc->multiple ? GetInstanceSlotLength(sp) : 1;
01101 
01102       /* =========================================
01103          Write out the type and index of each atom
01104          ========================================= */
01105       if (sp->desc->multiple)
01106         {
01107          for (j = 1 ; j <= slotLen ; j++)
01108            SaveAtomBinary(theEnv,GetMFType(sp->value,j),GetMFValue(sp->value,j),bsaveFP);
01109         }
01110       else
01111         SaveAtomBinary(theEnv,(unsigned short) sp->type,sp->value,bsaveFP);
01112      }
01113   }
01114 
01115 /***************************************************
01116   NAME         : SaveAtomBinary
01117   DESCRIPTION  : Writes out an instance slot value
01118                  atom to the binary file
01119   INPUTS       : 1) The atom type
01120                  2) The atom value
01121                  3) The binary file pointer
01122   RETURNS      : Nothing useful
01123   SIDE EFFECTS : atom written
01124   NOTES        :
01125  ***************************************************/
01126 static void SaveAtomBinary(
01127   void *theEnv,
01128   unsigned short type,
01129   void *value,
01130   FILE *bsaveFP)
01131   {
01132    struct bsaveSlotValueAtom bsa;
01133 
01134    /* =====================================
01135       Assumes slot value atoms  can only be
01136       floats, integers, symbols, strings,
01137       instance-names, instance-addresses,
01138       fact-addresses or external-addresses
01139       ===================================== */
01140    bsa.type = type;
01141    switch (type)
01142      {
01143       case SYMBOL:
01144       case STRING:
01145       case INSTANCE_NAME:
01146          bsa.value = (long) ((SYMBOL_HN *) value)->bucket;
01147          break;
01148       case FLOAT:
01149          bsa.value = (long) ((FLOAT_HN *) value)->bucket;
01150          break;
01151       case INTEGER:
01152          bsa.value = (long) ((INTEGER_HN *) value)->bucket;
01153          break;
01154       case INSTANCE_ADDRESS:
01155          bsa.type = INSTANCE_NAME;
01156          bsa.value = (long) GetFullInstanceName(theEnv,(INSTANCE_TYPE *) value)->bucket;
01157          break;
01158       default:
01159          bsa.value = -1L;
01160      }
01161    fwrite((void *) &bsa,(int) sizeof(struct bsaveSlotValueAtom),1,bsaveFP);
01162   }
01163 
01164 #endif
01165 
01166 /**********************************************************************
01167   NAME         : LoadOrRestoreInstances
01168   DESCRIPTION  : Loads instances from named file
01169   INPUTS       : 1) The name of the input file
01170                  2) An integer flag indicating whether or
01171                     not to use message-passing to create
01172                     the new instances and delete old versions
01173                  3) An integer flag indicating if arg #1
01174                     is a file name or the name of a string router
01175   RETURNS      : The number of instances loaded/restored
01176   SIDE EFFECTS : Instances loaded from file
01177   NOTES        : None
01178  **********************************************************************/
01179 static long LoadOrRestoreInstances(
01180   void *theEnv,
01181   char *file,
01182   int usemsgs,
01183   int isFileName)
01184   {
01185    DATA_OBJECT temp;
01186    FILE *sfile = NULL,*svload = NULL;
01187    char *ilog;
01188    EXPRESSION *top;
01189    int svoverride;
01190    long instanceCount = 0L;
01191 
01192    if (isFileName) {
01193      if ((sfile = GenOpen(theEnv,file,"r")) == NULL)
01194        {
01195         SetEvaluationError(theEnv,TRUE);
01196         return(-1L);
01197        }
01198      svload = GetFastLoad(theEnv);
01199      ilog = (char *) sfile;
01200      SetFastLoad(theEnv,sfile);
01201    } else {
01202      ilog = file;
01203    }
01204    top = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"make-instance"));
01205    GetToken(theEnv,ilog,&DefclassData(theEnv)->ObjectParseToken);
01206    svoverride = InstanceData(theEnv)->MkInsMsgPass;
01207    InstanceData(theEnv)->MkInsMsgPass = usemsgs;
01208    while ((GetType(DefclassData(theEnv)->ObjectParseToken) != STOP) && (EvaluationData(theEnv)->HaltExecution != TRUE))
01209      {
01210       if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN)
01211         {
01212          SyntaxErrorMessage(theEnv,"instance definition");
01213          rtn_struct(theEnv,expr,top);
01214          if (isFileName) {
01215            GenClose(theEnv,sfile);
01216            SetFastLoad(theEnv,svload);
01217          }
01218          SetEvaluationError(theEnv,TRUE);
01219          InstanceData(theEnv)->MkInsMsgPass = svoverride;
01220          return(instanceCount);
01221         }
01222       if (ParseSimpleInstance(theEnv,top,ilog) == NULL)
01223         {
01224          if (isFileName) {
01225            GenClose(theEnv,sfile);
01226            SetFastLoad(theEnv,svload);
01227          }
01228          InstanceData(theEnv)->MkInsMsgPass = svoverride;
01229          SetEvaluationError(theEnv,TRUE);
01230          return(instanceCount);
01231         }
01232       ExpressionInstall(theEnv,top);
01233       EvaluateExpression(theEnv,top,&temp);
01234       ExpressionDeinstall(theEnv,top);
01235       if (! EvaluationData(theEnv)->EvaluationError)
01236         instanceCount++;
01237       ReturnExpression(theEnv,top->argList);
01238       top->argList = NULL;
01239       GetToken(theEnv,ilog,&DefclassData(theEnv)->ObjectParseToken);
01240      }
01241    rtn_struct(theEnv,expr,top);
01242    if (isFileName) {
01243      GenClose(theEnv,sfile);
01244      SetFastLoad(theEnv,svload);
01245    }
01246    InstanceData(theEnv)->MkInsMsgPass = svoverride;
01247    return(instanceCount);
01248   }
01249 
01250 /***************************************************
01251   NAME         : ProcessFileErrorMessage
01252   DESCRIPTION  : Prints an error message when a
01253                  file containing text or binary
01254                  instances cannot be processed.
01255   INPUTS       : The name of the input file and the
01256                  function which opened it.
01257   RETURNS      : No value
01258   SIDE EFFECTS : None
01259   NOTES        : None
01260  ***************************************************/
01261 static void ProcessFileErrorMessage(
01262   void *theEnv,
01263   char *functionName,
01264   char *fileName)
01265   {
01266    PrintErrorID(theEnv,"INSFILE",1,FALSE);
01267    EnvPrintRouter(theEnv,WERROR,"Function ");
01268    EnvPrintRouter(theEnv,WERROR,functionName);
01269    EnvPrintRouter(theEnv,WERROR," could not completely process file ");
01270    EnvPrintRouter(theEnv,WERROR,fileName);
01271    EnvPrintRouter(theEnv,WERROR,".\n");
01272   }
01273 
01274 #if BLOAD_INSTANCES
01275 
01276 /*******************************************************
01277   NAME         : VerifyBinaryHeader
01278   DESCRIPTION  : Reads the prefix and version headers
01279                  from a file to verify that the
01280                  input is a valid binary instances file
01281   INPUTS       : The name of the file
01282   RETURNS      : TRUE if OK, FALSE otherwise
01283   SIDE EFFECTS : Input prefix and version read
01284   NOTES        : Assumes file already open with 
01285                  GenOpenReadBinary
01286  *******************************************************/
01287 static intBool VerifyBinaryHeader(
01288   void *theEnv,
01289   char *theFile)
01290   {
01291    char buf[20];
01292 
01293    GenReadBinary(theEnv,(void *) buf,(unsigned long) (strlen(InstanceFileData(theEnv)->InstanceBinaryPrefixID) + 1));
01294    if (strcmp(buf,InstanceFileData(theEnv)->InstanceBinaryPrefixID) != 0)
01295      {
01296       PrintErrorID(theEnv,"INSFILE",2,FALSE);
01297       EnvPrintRouter(theEnv,WERROR,theFile);
01298       EnvPrintRouter(theEnv,WERROR," file is not a binary instances file.\n");
01299       return(FALSE);
01300      }
01301    GenReadBinary(theEnv,(void *) buf,(unsigned long) (strlen(InstanceFileData(theEnv)->InstanceBinaryVersionID) + 1));
01302    if (strcmp(buf,InstanceFileData(theEnv)->InstanceBinaryVersionID) != 0)
01303      {
01304       PrintErrorID(theEnv,"INSFILE",3,FALSE);
01305       EnvPrintRouter(theEnv,WERROR,theFile);
01306       EnvPrintRouter(theEnv,WERROR," file is not a compatible binary instances file.\n");
01307       return(FALSE);
01308      }
01309    return(TRUE);
01310   }
01311 
01312 /***************************************************
01313   NAME         : LoadSingleBinaryInstance
01314   DESCRIPTION  : Reads the binary data for a new
01315                  instance and its slot values and
01316                  creates/initializes the instance
01317   INPUTS       : None
01318   RETURNS      : TRUE if all OK,
01319                  FALSE otherwise
01320   SIDE EFFECTS : Binary data read and instance
01321                  created
01322   NOTES        : Uses global GenReadBinary(theEnv,)
01323  ***************************************************/
01324 static intBool LoadSingleBinaryInstance(
01325   void *theEnv)
01326   {
01327    SYMBOL_HN *instanceName,
01328              *className;
01329    short slotCount;
01330    DEFCLASS *theDefclass;
01331    INSTANCE_TYPE *newInstance;
01332    struct bsaveSlotValue *bsArray;
01333    struct bsaveSlotValueAtom *bsaArray = NULL;
01334    long nameIndex;
01335    unsigned long totalValueCount;
01336    long i, j;
01337    INSTANCE_SLOT *sp;
01338    DATA_OBJECT slotValue,junkValue;
01339 
01340    /* =====================
01341       Get the instance name
01342       ===================== */
01343    BufferedRead(theEnv,(void *) &nameIndex,(unsigned long) sizeof(long));
01344    instanceName = SymbolPointer(nameIndex);
01345 
01346    /* ==================
01347       Get the class name
01348       ================== */
01349    BufferedRead(theEnv,(void *) &nameIndex,(unsigned long) sizeof(long));
01350    className = SymbolPointer(nameIndex);
01351 
01352    /* ==================
01353       Get the slot count
01354       ================== */
01355    BufferedRead(theEnv,(void *) &slotCount,(unsigned long) sizeof(short));
01356 
01357    /* =============================
01358       Make sure the defclass exists
01359       and check the slot count
01360       ============================= */
01361    theDefclass = LookupDefclassInScope(theEnv,ValueToString(className));
01362    if (theDefclass == NULL)
01363      {
01364       ClassExistError(theEnv,"bload-instances",ValueToString(className));
01365       return(FALSE);
01366      }
01367    if (theDefclass->instanceSlotCount != slotCount)
01368      {
01369       BinaryLoadInstanceError(theEnv,instanceName,theDefclass);
01370       return(FALSE);
01371      }
01372 
01373    /* ===================================
01374       Create the new unitialized instance
01375       =================================== */
01376    newInstance = BuildInstance(theEnv,instanceName,theDefclass,FALSE);
01377    if (newInstance == NULL)
01378      {
01379       BinaryLoadInstanceError(theEnv,instanceName,theDefclass);
01380       return(FALSE);
01381      }
01382    if (slotCount == 0)
01383      return(TRUE);
01384 
01385    /* ====================================
01386       Read all slot override info and slot
01387       value atoms into big arrays
01388       ==================================== */
01389    bsArray = (struct bsaveSlotValue *) gm2(theEnv,(sizeof(struct bsaveSlotValue) * slotCount));
01390    BufferedRead(theEnv,(void *) bsArray,(unsigned long) (sizeof(struct bsaveSlotValue) * slotCount));
01391 
01392    BufferedRead(theEnv,(void *) &totalValueCount,(unsigned long) sizeof(unsigned long));
01393 
01394    if (totalValueCount != 0L)
01395      {
01396       bsaArray = (struct bsaveSlotValueAtom *)
01397                   gm3(theEnv,(long) (totalValueCount * sizeof(struct bsaveSlotValueAtom)));
01398       BufferedRead(theEnv,(void *) bsaArray,
01399                    (unsigned long) (totalValueCount * sizeof(struct bsaveSlotValueAtom)));
01400      }
01401 
01402    /* =========================
01403       Insert the values for the
01404       slot overrides
01405       ========================= */
01406    for (i = 0 , j = 0L ; i < slotCount ; i++)
01407      {
01408       /* ===========================================================
01409          Here is another check for the validity of the binary file -
01410          the order of the slots in the file should match the
01411          order in the class definition
01412          =========================================================== */
01413       sp = newInstance->slotAddresses[i];
01414       if (sp->desc->slotName->name != SymbolPointer(bsArray[i].slotName))
01415         goto LoadError;
01416       CreateSlotValue(theEnv,&slotValue,(struct bsaveSlotValueAtom *) &bsaArray[j],
01417                       bsArray[i].valueCount);
01418 
01419       if (PutSlotValue(theEnv,newInstance,sp,&slotValue,&junkValue,"bload-instances") == FALSE)
01420         goto LoadError;
01421 
01422       j += (unsigned long) bsArray[i].valueCount;
01423      }
01424 
01425    rm(theEnv,(void *) bsArray,(sizeof(struct bsaveSlotValue) * slotCount));
01426 
01427    if (totalValueCount != 0L)
01428      rm3(theEnv,(void *) bsaArray,
01429          (long) (totalValueCount * sizeof(struct bsaveSlotValueAtom)));
01430 
01431    return(TRUE);
01432 
01433 LoadError:
01434    BinaryLoadInstanceError(theEnv,instanceName,theDefclass);
01435    QuashInstance(theEnv,newInstance);
01436    rm(theEnv,(void *) bsArray,(sizeof(struct bsaveSlotValue) * slotCount));
01437    rm3(theEnv,(void *) bsaArray,
01438        (long) (totalValueCount * sizeof(struct bsaveSlotValueAtom)));
01439    return(FALSE);
01440   }
01441 
01442 /***************************************************
01443   NAME         : BinaryLoadInstanceError
01444   DESCRIPTION  : Prints out an error message when
01445                  an instance could not be
01446                  successfully loaded from a
01447                  binary file
01448   INPUTS       : 1) The instance name
01449                  2) The defclass
01450   RETURNS      : Nothing useful
01451   SIDE EFFECTS : Error message printed
01452   NOTES        : None
01453  ***************************************************/
01454 static void BinaryLoadInstanceError(
01455   void *theEnv,
01456   SYMBOL_HN *instanceName,
01457   DEFCLASS *theDefclass)
01458   {
01459    PrintErrorID(theEnv,"INSFILE",4,FALSE);
01460    EnvPrintRouter(theEnv,WERROR,"Function bload-instances unable to load instance [");
01461    EnvPrintRouter(theEnv,WERROR,ValueToString(instanceName));
01462    EnvPrintRouter(theEnv,WERROR,"] of class ");
01463    PrintClassName(theEnv,WERROR,theDefclass,TRUE);
01464   }
01465 
01466 /***************************************************
01467   NAME         : CreateSlotValue
01468   DESCRIPTION  : Creates a data object value from
01469                  the binary slot value atom data
01470   INPUTS       : 1) A data object buffer
01471                  2) The slot value atoms array
01472                  3) The number of values to put
01473                     in the data object
01474   RETURNS      : Nothing useful
01475   SIDE EFFECTS : Data object initialized
01476                  (if more than one value, a
01477                  multifield is created)
01478   NOTES        : None
01479  ***************************************************/
01480 static void CreateSlotValue(
01481   void *theEnv,
01482   DATA_OBJECT *result,
01483   struct bsaveSlotValueAtom *bsaValues,
01484   unsigned long valueCount)
01485   {
01486    register unsigned i;
01487 
01488    if (valueCount == 0)
01489      {
01490       result->type = MULTIFIELD;
01491       result->value = EnvCreateMultifield(theEnv,0L);
01492       result->begin = 0;
01493       result->end = -1;
01494      }
01495    else if (valueCount == 1)
01496      {
01497       result->type = bsaValues[0].type;
01498       result->value = GetBinaryAtomValue(theEnv,&bsaValues[0]);
01499      }
01500    else
01501      {
01502       result->type = MULTIFIELD;
01503       result->value = EnvCreateMultifield(theEnv,valueCount);
01504       result->begin = 0;
01505       SetpDOEnd(result,valueCount);
01506       for (i = 1 ; i <= valueCount ; i++)
01507         {
01508          SetMFType(result->value,i,(short) bsaValues[i-1].type);
01509          SetMFValue(result->value,i,GetBinaryAtomValue(theEnv,&bsaValues[i-1]));
01510         }
01511      }
01512   }
01513 
01514 /***************************************************
01515   NAME         : GetBinaryAtomValue
01516   DESCRIPTION  : Uses the binary index of an atom
01517                  to find the ephemeris value
01518   INPUTS       : The binary type and index
01519   RETURNS      : The symbol/etc. pointer
01520   SIDE EFFECTS : None
01521   NOTES        : None
01522  ***************************************************/
01523 static void *GetBinaryAtomValue(
01524   void *theEnv,
01525   struct bsaveSlotValueAtom *ba)
01526   {
01527    switch (ba->type)
01528      {
01529       case SYMBOL:
01530       case STRING:
01531       case INSTANCE_NAME:
01532          return((void *) SymbolPointer(ba->value));
01533       case FLOAT:
01534          return((void *) FloatPointer(ba->value));
01535       case INTEGER:
01536          return((void *) IntegerPointer(ba->value));
01537       case FACT_ADDRESS:
01538 #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT
01539          return((void *) &FactData(theEnv)->DummyFact);
01540 #else
01541          return(NULL);
01542 #endif
01543       case EXTERNAL_ADDRESS:
01544         return(NULL);
01545 
01546       default:
01547         {
01548          SystemError(theEnv,"INSFILE",1);
01549          EnvExitRouter(theEnv,EXIT_FAILURE);
01550         }
01551      }
01552    return(NULL);
01553   }
01554 
01555 /***************************************************
01556   NAME         : BufferedRead
01557   DESCRIPTION  : Reads data from binary file
01558                  (Larger blocks than requested size
01559                   may be read and buffered)
01560   INPUTS       : 1) The buffer
01561                  2) The buffer size
01562   RETURNS      : Nothing useful
01563   SIDE EFFECTS : Data stored in buffer
01564   NOTES        : None
01565  ***************************************************/
01566 static void BufferedRead(
01567   void *theEnv,
01568   void *buf,
01569   unsigned long bufsz)
01570   {
01571    unsigned long i,amountLeftToRead;
01572 
01573    if (InstanceFileData(theEnv)->CurrentReadBuffer != NULL)
01574      {
01575       amountLeftToRead = InstanceFileData(theEnv)->CurrentReadBufferSize - InstanceFileData(theEnv)->CurrentReadBufferOffset;
01576       if (bufsz <= amountLeftToRead)
01577         {
01578          for (i = 0L ; i < bufsz ; i++)
01579            ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i + InstanceFileData(theEnv)->CurrentReadBufferOffset];
01580          InstanceFileData(theEnv)->CurrentReadBufferOffset += bufsz;
01581          if (InstanceFileData(theEnv)->CurrentReadBufferOffset == InstanceFileData(theEnv)->CurrentReadBufferSize)
01582            FreeReadBuffer(theEnv);
01583         }
01584       else
01585         {
01586          if (InstanceFileData(theEnv)->CurrentReadBufferOffset < InstanceFileData(theEnv)->CurrentReadBufferSize)
01587            {
01588             for (i = 0L ; i < amountLeftToRead ; i++)
01589               ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i + InstanceFileData(theEnv)->CurrentReadBufferOffset];
01590             bufsz -= amountLeftToRead;
01591             buf = (void *) (((char *) buf) + amountLeftToRead);
01592            }
01593          FreeReadBuffer(theEnv);
01594          BufferedRead(theEnv,buf,bufsz);
01595         }
01596      }
01597    else
01598      {
01599       if (bufsz > MAX_BLOCK_SIZE)
01600         {
01601          InstanceFileData(theEnv)->CurrentReadBufferSize = bufsz;
01602          if (bufsz > (InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset))
01603            {
01604             SystemError(theEnv,"INSFILE",2);
01605             EnvExitRouter(theEnv,EXIT_FAILURE);
01606            }
01607         }
01608       else if (MAX_BLOCK_SIZE >
01609               (InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset))
01610         InstanceFileData(theEnv)->CurrentReadBufferSize = InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset;
01611       else
01612         InstanceFileData(theEnv)->CurrentReadBufferSize = (unsigned long) MAX_BLOCK_SIZE;
01613       InstanceFileData(theEnv)->CurrentReadBuffer = (char *) genalloc(theEnv,InstanceFileData(theEnv)->CurrentReadBufferSize);
01614       GenReadBinary(theEnv,(void *) InstanceFileData(theEnv)->CurrentReadBuffer,InstanceFileData(theEnv)->CurrentReadBufferSize);
01615       for (i = 0L ; i < bufsz ; i++)
01616         ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i];
01617       InstanceFileData(theEnv)->CurrentReadBufferOffset = bufsz;
01618       InstanceFileData(theEnv)->BinaryInstanceFileOffset += InstanceFileData(theEnv)->CurrentReadBufferSize;
01619      }
01620   }
01621 
01622 /*****************************************************
01623   NAME         : FreeReadBuffer
01624   DESCRIPTION  : Deallocates buffer for binary reads
01625   INPUTS       : None
01626   RETURNS      : Nothing usefu
01627   SIDE EFFECTS : Binary global read buffer deallocated
01628   NOTES        : None
01629  *****************************************************/
01630 static void FreeReadBuffer(
01631   void *theEnv)
01632   {
01633    if (InstanceFileData(theEnv)->CurrentReadBufferSize != 0L)
01634      {
01635       genfree(theEnv,(void *) InstanceFileData(theEnv)->CurrentReadBuffer,InstanceFileData(theEnv)->CurrentReadBufferSize);
01636       InstanceFileData(theEnv)->CurrentReadBuffer = NULL;
01637       InstanceFileData(theEnv)->CurrentReadBufferSize = 0L;
01638      }
01639   }
01640 
01641 #endif
01642 
01643 #endif
01644 
01645