1    /*******************************************************/
2    /*      "C" Language Integrated Production System      */
3    /*                                                     */
4    /*              CLIPS Version 6.30  02/04/15           */
5    /*                                                     */
6    /*         INSTANCE LOAD/SAVE (ASCII/BINARY) MODULE    */
7    /*******************************************************/
8 
9 /*************************************************************/
10 /* Purpose:  File load/save routines for instances           */
11 /*                                                           */
12 /* Principal Programmer(s):                                  */
13 /*      Brian L. Dantes                                      */
14 /*                                                           */
15 /* Contributing Programmer(s):                               */
16 /*                                                           */
17 /* Revision History:                                         */
18 /*                                                           */
19 /*      6.24: Added environment parameter to GenClose.       */
20 /*            Added environment parameter to GenOpen.        */
21 /*                                                           */
22 /*            Renamed BOOLEAN macro type to intBool.         */
23 /*                                                           */
24 /*            Corrected code to remove compiler warnings.    */
25 /*                                                           */
26 /*      6.30: Removed conditional code for unsupported       */
27 /*            compilers/operating systems (IBM_MCW,          */
28 /*            MAC_MCW, and IBM_TBC).                         */
29 /*                                                           */
30 /*            Changed integer type/precision.                */
31 /*                                                           */
32 /*            Added const qualifiers to remove C++           */
33 /*            deprecation warnings.                          */
34 /*                                                           */
35 /*            Converted API macros to function calls.        */
36 /*                                                           */
37 /*            For save-instances, bsave-instances, and       */
38 /*            bload-instances, the class name does not       */
39 /*            have to be in scope if the module name is      */
40 /*            specified.                                     */
41 /*                                                           */
42 /*************************************************************/
43 
44 /* =========================================
45    *****************************************
46                EXTERNAL DEFINITIONS
47    =========================================
48    ***************************************** */
49 
50 #include <stdlib.h>
51 
52 #include "setup.h"
53 
54 #if OBJECT_SYSTEM
55 
56 #include "argacces.h"
57 #include "classcom.h"
58 #include "classfun.h"
59 #include "memalloc.h"
60 #include "extnfunc.h"
61 #include "inscom.h"
62 #include "insfun.h"
63 #include "insmngr.h"
64 #include "inspsr.h"
65 #include "object.h"
66 #include "router.h"
67 #include "strngrtr.h"
68 #include "symblbin.h"
69 #include "sysdep.h"
70 #include "envrnmnt.h"
71 
72 #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT
73 #include "factmngr.h"
74 #endif
75 
76 #define _INSFILE_SOURCE_
77 #include "insfile.h"
78 
79 /* =========================================
80    *****************************************
81                    CONSTANTS
82    =========================================
83    ***************************************** */
84 #define MAX_BLOCK_SIZE 10240
85 
86 /* =========================================
87    *****************************************
88                MACROS AND TYPES
89    =========================================
90    ***************************************** */
91 struct bsaveSlotValue
92   {
93    long slotName;
94    unsigned valueCount;
95   };
96 
97 struct bsaveSlotValueAtom
98   {
99    unsigned short type;
100    long value;
101   };
102 
103 /* =========================================
104    *****************************************
105       INTERNALLY VISIBLE FUNCTION HEADERS
106    =========================================
107    ***************************************** */
108 
109 static long InstancesSaveCommandParser(void *,const char *,long (*)(void *,const char *,int,
110                                                    EXPRESSION *,intBool));
111 static DATA_OBJECT *ProcessSaveClassList(void *,const char *,EXPRESSION *,int,intBool);
112 static void ReturnSaveClassList(void *,DATA_OBJECT *);
113 static long SaveOrMarkInstances(void *,void *,int,DATA_OBJECT *,intBool,intBool,
114                                          void (*)(void *,void *,INSTANCE_TYPE *));
115 static long SaveOrMarkInstancesOfClass(void *,void *,struct defmodule *,int,DEFCLASS *,
116                                                 intBool,int,void (*)(void *,void *,INSTANCE_TYPE *));
117 static void SaveSingleInstanceText(void *,void *,INSTANCE_TYPE *);
118 static void ProcessFileErrorMessage(void *,const char *,const char *);
119 #if BSAVE_INSTANCES
120 static void WriteBinaryHeader(void *,FILE *);
121 static void MarkSingleInstance(void *,void *,INSTANCE_TYPE *);
122 static void MarkNeededAtom(void *,int,void *);
123 static void SaveSingleInstanceBinary(void *,void *,INSTANCE_TYPE *);
124 static void SaveAtomBinary(void *,unsigned short,void *,FILE *);
125 #endif
126 
127 static long LoadOrRestoreInstances(void *,const char *,int,int);
128 
129 #if BLOAD_INSTANCES
130 static intBool VerifyBinaryHeader(void *,const char *);
131 static intBool LoadSingleBinaryInstance(void *);
132 static void BinaryLoadInstanceError(void *,SYMBOL_HN *,DEFCLASS *);
133 static void CreateSlotValue(void *,DATA_OBJECT *,struct bsaveSlotValueAtom *,unsigned long);
134 static void *GetBinaryAtomValue(void *,struct bsaveSlotValueAtom *);
135 static void BufferedRead(void *,void *,unsigned long);
136 static void FreeReadBuffer(void *);
137 #endif
138 
139 /* =========================================
140    *****************************************
141           EXTERNALLY VISIBLE FUNCTIONS
142    =========================================
143    ***************************************** */
144 
145 /***************************************************
146   NAME         : SetupInstanceFileCommands
147   DESCRIPTION  : Defines function interfaces for
148                  saving instances to files
149   INPUTS       : None
150   RETURNS      : Nothing useful
151   SIDE EFFECTS : Functions defined to KB
152   NOTES        : None
153  ***************************************************/
SetupInstanceFileCommands(void * theEnv)154 globle void SetupInstanceFileCommands(
155   void *theEnv)
156   {
157 #if BLOAD_INSTANCES || BSAVE_INSTANCES
158    AllocateEnvironmentData(theEnv,INSTANCE_FILE_DATA,sizeof(struct instanceFileData),NULL);
159 
160    InstanceFileData(theEnv)->InstanceBinaryPrefixID = "\5\6\7CLIPS";
161    InstanceFileData(theEnv)->InstanceBinaryVersionID = "V6.00";
162 #endif
163 
164 #if (! RUN_TIME)
165    EnvDefineFunction2(theEnv,"save-instances",'l',PTIEF SaveInstancesCommand,
166                    "SaveInstancesCommand","1*wk");
167    EnvDefineFunction2(theEnv,"load-instances",'l',PTIEF LoadInstancesCommand,
168                    "LoadInstancesCommand","11k");
169    EnvDefineFunction2(theEnv,"restore-instances",'l',PTIEF RestoreInstancesCommand,
170                    "RestoreInstancesCommand","11k");
171 
172 #if BSAVE_INSTANCES
173    EnvDefineFunction2(theEnv,"bsave-instances",'l',PTIEF BinarySaveInstancesCommand,
174                    "BinarySaveInstancesCommand","1*wk");
175 #endif
176 #if BLOAD_INSTANCES
177    EnvDefineFunction2(theEnv,"bload-instances",'l',PTIEF BinaryLoadInstancesCommand,
178                    "BinaryLoadInstancesCommand","11k");
179 #endif
180 
181 #endif
182   }
183 
184 
185 /****************************************************************************
186   NAME         : SaveInstancesCommand
187   DESCRIPTION  : H/L interface for saving
188                    current instances to a file
189   INPUTS       : None
190   RETURNS      : The number of instances saved
191   SIDE EFFECTS : Instances saved to named file
192   NOTES        : H/L Syntax :
193                  (save-instances <file> [local|visible [[inherit] <class>+]])
194  ****************************************************************************/
SaveInstancesCommand(void * theEnv)195 globle long SaveInstancesCommand(
196   void *theEnv)
197   {
198    return(InstancesSaveCommandParser(theEnv,"save-instances",EnvSaveInstancesDriver));
199   }
200 
201 /******************************************************
202   NAME         : LoadInstancesCommand
203   DESCRIPTION  : H/L interface for loading
204                    instances from a file
205   INPUTS       : None
206   RETURNS      : The number of instances loaded
207   SIDE EFFECTS : Instances loaded from named file
208   NOTES        : H/L Syntax : (load-instances <file>)
209  ******************************************************/
LoadInstancesCommand(void * theEnv)210 globle long LoadInstancesCommand(
211   void *theEnv)
212   {
213    const char *fileFound;
214    DATA_OBJECT temp;
215    long instanceCount;
216 
217    if (EnvArgTypeCheck(theEnv,"load-instances",1,SYMBOL_OR_STRING,&temp) == FALSE)
218      return(0L);
219 
220    fileFound = DOToString(temp);
221 
222    instanceCount = EnvLoadInstances(theEnv,fileFound);
223    if (EvaluationData(theEnv)->EvaluationError)
224      ProcessFileErrorMessage(theEnv,"load-instances",fileFound);
225    return(instanceCount);
226   }
227 
228 /***************************************************
229   NAME         : EnvLoadInstances
230   DESCRIPTION  : Loads instances from named file
231   INPUTS       : The name of the input file
232   RETURNS      : The number of instances loaded
233   SIDE EFFECTS : Instances loaded from file
234   NOTES        : None
235  ***************************************************/
EnvLoadInstances(void * theEnv,const char * file)236 globle long EnvLoadInstances(
237   void *theEnv,
238   const char *file)
239   {
240    return(LoadOrRestoreInstances(theEnv,file,TRUE,TRUE));
241   }
242 
243 /***************************************************
244   NAME         : EnvLoadInstancesFromString
245   DESCRIPTION  : Loads instances from given string
246   INPUTS       : 1) The input string
247                  2) Index of char in string after
248                     last valid char (-1 for all chars)
249   RETURNS      : The number of instances loaded
250   SIDE EFFECTS : Instances loaded from string
251   NOTES        : Uses string routers
252  ***************************************************/
EnvLoadInstancesFromString(void * theEnv,const char * theString,int theMax)253 globle long EnvLoadInstancesFromString(
254   void *theEnv,
255   const char *theString,
256   int theMax)
257   {
258    long theCount;
259    const char * theStrRouter = "*** load-instances-from-string ***";
260 
261    if ((theMax == -1) ? (!OpenStringSource(theEnv,theStrRouter,theString,0)) :
262                         (!OpenTextSource(theEnv,theStrRouter,theString,0,(unsigned) theMax)))
263      return(-1L);
264    theCount = LoadOrRestoreInstances(theEnv,theStrRouter,TRUE,FALSE);
265    CloseStringSource(theEnv,theStrRouter);
266    return(theCount);
267   }
268 
269 /*********************************************************
270   NAME         : RestoreInstancesCommand
271   DESCRIPTION  : H/L interface for loading
272                    instances from a file w/o messages
273   INPUTS       : None
274   RETURNS      : The number of instances restored
275   SIDE EFFECTS : Instances loaded from named file
276   NOTES        : H/L Syntax : (restore-instances <file>)
277  *********************************************************/
RestoreInstancesCommand(void * theEnv)278 globle long RestoreInstancesCommand(
279   void *theEnv)
280   {
281    const char *fileFound;
282    DATA_OBJECT temp;
283    long instanceCount;
284 
285    if (EnvArgTypeCheck(theEnv,"restore-instances",1,SYMBOL_OR_STRING,&temp) == FALSE)
286      return(0L);
287 
288    fileFound = DOToString(temp);
289 
290    instanceCount = EnvRestoreInstances(theEnv,fileFound);
291    if (EvaluationData(theEnv)->EvaluationError)
292      ProcessFileErrorMessage(theEnv,"restore-instances",fileFound);
293    return(instanceCount);
294   }
295 
296 /***************************************************
297   NAME         : EnvRestoreInstances
298   DESCRIPTION  : Restores instances from named file
299   INPUTS       : The name of the input file
300   RETURNS      : The number of instances restored
301   SIDE EFFECTS : Instances restored from file
302   NOTES        : None
303  ***************************************************/
EnvRestoreInstances(void * theEnv,const char * file)304 globle long EnvRestoreInstances(
305   void *theEnv,
306   const char *file)
307   {
308    return(LoadOrRestoreInstances(theEnv,file,FALSE,TRUE));
309   }
310 
311 /***************************************************
312   NAME         : EnvRestoreInstancesFromString
313   DESCRIPTION  : Restores instances from given string
314   INPUTS       : 1) The input string
315                  2) Index of char in string after
316                     last valid char (-1 for all chars)
317   RETURNS      : The number of instances loaded
318   SIDE EFFECTS : Instances loaded from string
319   NOTES        : Uses string routers
320  ***************************************************/
EnvRestoreInstancesFromString(void * theEnv,const char * theString,int theMax)321 globle long EnvRestoreInstancesFromString(
322   void *theEnv,
323   const char *theString,
324   int theMax)
325   {
326    long theCount;
327    const char *theStrRouter = "*** load-instances-from-string ***";
328 
329    if ((theMax == -1) ? (!OpenStringSource(theEnv,theStrRouter,theString,0)) :
330                         (!OpenTextSource(theEnv,theStrRouter,theString,0,(unsigned) theMax)))
331      return(-1L);
332    theCount = LoadOrRestoreInstances(theEnv,theStrRouter,FALSE,FALSE);
333    CloseStringSource(theEnv,theStrRouter);
334    return(theCount);
335   }
336 
337 #if BLOAD_INSTANCES
338 
339 /*******************************************************
340   NAME         : BinaryLoadInstancesCommand
341   DESCRIPTION  : H/L interface for loading
342                    instances from a binary file
343   INPUTS       : None
344   RETURNS      : The number of instances loaded
345   SIDE EFFECTS : Instances loaded from named binary file
346   NOTES        : H/L Syntax : (bload-instances <file>)
347  *******************************************************/
BinaryLoadInstancesCommand(void * theEnv)348 globle long BinaryLoadInstancesCommand(
349   void *theEnv)
350   {
351    const char *fileFound;
352    DATA_OBJECT temp;
353    long instanceCount;
354 
355    if (EnvArgTypeCheck(theEnv,"bload-instances",1,SYMBOL_OR_STRING,&temp) == FALSE)
356      return(0L);
357 
358    fileFound = DOToString(temp);
359 
360    instanceCount = EnvBinaryLoadInstances(theEnv,fileFound);
361    if (EvaluationData(theEnv)->EvaluationError)
362      ProcessFileErrorMessage(theEnv,"bload-instances",fileFound);
363    return(instanceCount);
364   }
365 
366 /****************************************************
367   NAME         : EnvBinaryLoadInstances
368   DESCRIPTION  : Loads instances quickly from a
369                  binary file
370   INPUTS       : The file name
371   RETURNS      : The number of instances loaded
372   SIDE EFFECTS : Instances loaded w/o message-passing
373   NOTES        : None
374  ****************************************************/
EnvBinaryLoadInstances(void * theEnv,const char * theFile)375 globle long EnvBinaryLoadInstances(
376   void *theEnv,
377   const char *theFile)
378   {
379    long i,instanceCount;
380 
381    if (GenOpenReadBinary(theEnv,"bload-instances",theFile) == 0)
382      {
383       SetEvaluationError(theEnv,TRUE);
384       return(-1L);
385      }
386    if (VerifyBinaryHeader(theEnv,theFile) == FALSE)
387      {
388       GenCloseBinary(theEnv);
389       SetEvaluationError(theEnv,TRUE);
390       return(-1L);
391      }
392 
393    EnvIncrementGCLocks(theEnv);
394    ReadNeededAtomicValues(theEnv);
395 
396    InstanceFileData(theEnv)->BinaryInstanceFileOffset = 0L;
397 
398    GenReadBinary(theEnv,(void *) &InstanceFileData(theEnv)->BinaryInstanceFileSize,sizeof(unsigned long));
399    GenReadBinary(theEnv,(void *) &instanceCount,sizeof(long));
400 
401    for (i = 0L ; i < instanceCount ; i++)
402      {
403       if (LoadSingleBinaryInstance(theEnv) == FALSE)
404         {
405          FreeReadBuffer(theEnv);
406          FreeAtomicValueStorage(theEnv);
407          GenCloseBinary(theEnv);
408          SetEvaluationError(theEnv,TRUE);
409          EnvDecrementGCLocks(theEnv);
410          return(i);
411         }
412      }
413 
414    FreeReadBuffer(theEnv);
415    FreeAtomicValueStorage(theEnv);
416    GenCloseBinary(theEnv);
417 
418    EnvDecrementGCLocks(theEnv);
419    return(instanceCount);
420   }
421 
422 #endif
423 
424 /*******************************************************
425   NAME         : EnvSaveInstances
426   DESCRIPTION  : Saves current instances to named file
427   INPUTS       : 1) The name of the output file
428                  2) A flag indicating whether to
429                     save local (current module only)
430                     or visible instances
431                     LOCAL_SAVE or VISIBLE_SAVE
432                  3) A list of expressions containing
433                     the names of classes for which
434                     instances are to be saved
435                  4) A flag indicating if the subclasses
436                     of specified classes shoudl also
437                     be processed
438   RETURNS      : The number of instances saved
439   SIDE EFFECTS : Instances saved to file
440   NOTES        : None
441  *******************************************************/
EnvSaveInstances(void * theEnv,const char * file,int saveCode)442 globle long EnvSaveInstances(
443   void *theEnv,
444   const char *file,
445   int saveCode)
446   {
447    return EnvSaveInstancesDriver(theEnv,file,saveCode,NULL,TRUE);
448   }
449 
450 /*******************************************************
451   NAME         : EnvSaveInstancesDriver
452   DESCRIPTION  : Saves current instances to named file
453   INPUTS       : 1) The name of the output file
454                  2) A flag indicating whether to
455                     save local (current module only)
456                     or visible instances
457                     LOCAL_SAVE or VISIBLE_SAVE
458                  3) A list of expressions containing
459                     the names of classes for which
460                     instances are to be saved
461                  4) A flag indicating if the subclasses
462                     of specified classes shoudl also
463                     be processed
464   RETURNS      : The number of instances saved
465   SIDE EFFECTS : Instances saved to file
466   NOTES        : None
467  *******************************************************/
EnvSaveInstancesDriver(void * theEnv,const char * file,int saveCode,EXPRESSION * classExpressionList,intBool inheritFlag)468 globle long EnvSaveInstancesDriver(
469   void *theEnv,
470   const char *file,
471   int saveCode,
472   EXPRESSION *classExpressionList,
473   intBool inheritFlag)
474   {
475    FILE *sfile = NULL;
476    int oldPEC,oldATS,oldIAN;
477    DATA_OBJECT *classList;
478    long instanceCount;
479 
480    classList = ProcessSaveClassList(theEnv,"save-instances",classExpressionList,
481                                     saveCode,inheritFlag);
482    if ((classList == NULL) && (classExpressionList != NULL))
483      return(0L);
484 
485    SaveOrMarkInstances(theEnv,(void *) sfile,saveCode,classList,
486                              inheritFlag,TRUE,NULL);
487 
488    if ((sfile = GenOpen(theEnv,file,"w")) == NULL)
489      {
490       OpenErrorMessage(theEnv,"save-instances",file);
491       ReturnSaveClassList(theEnv,classList);
492       SetEvaluationError(theEnv,TRUE);
493       return(0L);
494      }
495 
496    oldPEC = PrintUtilityData(theEnv)->PreserveEscapedCharacters;
497    PrintUtilityData(theEnv)->PreserveEscapedCharacters = TRUE;
498    oldATS = PrintUtilityData(theEnv)->AddressesToStrings;
499    PrintUtilityData(theEnv)->AddressesToStrings = TRUE;
500    oldIAN = PrintUtilityData(theEnv)->InstanceAddressesToNames;
501    PrintUtilityData(theEnv)->InstanceAddressesToNames = TRUE;
502 
503    SetFastSave(theEnv,sfile);
504    instanceCount = SaveOrMarkInstances(theEnv,(void *) sfile,saveCode,classList,
505                                        inheritFlag,TRUE,SaveSingleInstanceText);
506    GenClose(theEnv,sfile);
507    SetFastSave(theEnv,NULL);
508 
509    PrintUtilityData(theEnv)->PreserveEscapedCharacters = oldPEC;
510    PrintUtilityData(theEnv)->AddressesToStrings = oldATS;
511    PrintUtilityData(theEnv)->InstanceAddressesToNames = oldIAN;
512    ReturnSaveClassList(theEnv,classList);
513    return(instanceCount);
514   }
515 
516 #if BSAVE_INSTANCES
517 
518 /****************************************************************************
519   NAME         : BinarySaveInstancesCommand
520   DESCRIPTION  : H/L interface for saving
521                    current instances to a binary file
522   INPUTS       : None
523   RETURNS      : The number of instances saved
524   SIDE EFFECTS : Instances saved (in binary format) to named file
525   NOTES        : H/L Syntax :
526                  (bsave-instances <file> [local|visible [[inherit] <class>+]])
527  *****************************************************************************/
BinarySaveInstancesCommand(void * theEnv)528 globle long BinarySaveInstancesCommand(
529   void *theEnv)
530   {
531    return(InstancesSaveCommandParser(theEnv,"bsave-instances",EnvBinarySaveInstancesDriver));
532   }
533 
534 /*******************************************************
535   NAME         : EnvBinarySaveInstances
536   DESCRIPTION  : Saves current instances to binary file
537   INPUTS       : 1) The name of the output file
538                  2) A flag indicating whether to
539                     save local (current module only)
540                     or visible instances
541                     LOCAL_SAVE or VISIBLE_SAVE
542   RETURNS      : The number of instances saved
543   SIDE EFFECTS : Instances saved to file
544   NOTES        : None
545  *******************************************************/
EnvBinarySaveInstances(void * theEnv,const char * file,int saveCode)546 globle long EnvBinarySaveInstances(
547   void *theEnv,
548   const char *file,
549   int saveCode)
550   {
551    return EnvBinarySaveInstancesDriver(theEnv,file,saveCode,NULL,TRUE);
552   }
553 
554 /*******************************************************
555   NAME         : EnvBinarySaveInstancesDriver
556   DESCRIPTION  : Saves current instances to binary file
557   INPUTS       : 1) The name of the output file
558                  2) A flag indicating whether to
559                     save local (current module only)
560                     or visible instances
561                     LOCAL_SAVE or VISIBLE_SAVE
562                  3) A list of expressions containing
563                     the names of classes for which
564                     instances are to be saved
565                  4) A flag indicating if the subclasses
566                     of specified classes shoudl also
567                     be processed
568   RETURNS      : The number of instances saved
569   SIDE EFFECTS : Instances saved to file
570   NOTES        : None
571  *******************************************************/
EnvBinarySaveInstancesDriver(void * theEnv,const char * file,int saveCode,EXPRESSION * classExpressionList,intBool inheritFlag)572 globle long EnvBinarySaveInstancesDriver(
573   void *theEnv,
574   const char *file,
575   int saveCode,
576   EXPRESSION *classExpressionList,
577   intBool inheritFlag)
578   {
579    DATA_OBJECT *classList;
580    FILE *bsaveFP;
581    long instanceCount;
582 
583    classList = ProcessSaveClassList(theEnv,"bsave-instances",classExpressionList,
584                                     saveCode,inheritFlag);
585    if ((classList == NULL) && (classExpressionList != NULL))
586      return(0L);
587 
588    InstanceFileData(theEnv)->BinaryInstanceFileSize = 0L;
589    InitAtomicValueNeededFlags(theEnv);
590    instanceCount = SaveOrMarkInstances(theEnv,NULL,saveCode,classList,inheritFlag,
591                                        FALSE,MarkSingleInstance);
592 
593    if ((bsaveFP = GenOpen(theEnv,file,"wb")) == NULL)
594      {
595       OpenErrorMessage(theEnv,"bsave-instances",file);
596       ReturnSaveClassList(theEnv,classList);
597       SetEvaluationError(theEnv,TRUE);
598       return(0L);
599      }
600    WriteBinaryHeader(theEnv,bsaveFP);
601    WriteNeededAtomicValues(theEnv,bsaveFP);
602 
603    fwrite((void *) &InstanceFileData(theEnv)->BinaryInstanceFileSize,sizeof(unsigned long),1,bsaveFP);
604    fwrite((void *) &instanceCount,sizeof(long),1,bsaveFP);
605 
606    SetAtomicValueIndices(theEnv,FALSE);
607    SaveOrMarkInstances(theEnv,(void *) bsaveFP,saveCode,classList,
608                        inheritFlag,FALSE,SaveSingleInstanceBinary);
609    RestoreAtomicValueBuckets(theEnv);
610    GenClose(theEnv,bsaveFP);
611    ReturnSaveClassList(theEnv,classList);
612    return(instanceCount);
613   }
614 
615 #endif
616 
617 /* =========================================
618    *****************************************
619           INTERNALLY VISIBLE FUNCTIONS
620    =========================================
621    ***************************************** */
622 
623 /******************************************************
624   NAME         : InstancesSaveCommandParser
625   DESCRIPTION  : Argument parser for save-instances
626                  and bsave-instances
627   INPUTS       : 1) The name of the calling function
628                  2) A pointer to the support
629                     function to call for the save/bsave
630   RETURNS      : The number of instances saved
631   SIDE EFFECTS : Instances saved/bsaved
632   NOTES        : None
633  ******************************************************/
InstancesSaveCommandParser(void * theEnv,const char * functionName,long (* saveFunction)(void *,const char *,int,EXPRESSION *,intBool))634 static long InstancesSaveCommandParser(
635   void *theEnv,
636   const char *functionName,
637   long (*saveFunction)(void *,const char *,int,EXPRESSION *,intBool))
638   {
639    const char *fileFound;
640    DATA_OBJECT temp;
641    int argCount,saveCode = LOCAL_SAVE;
642    EXPRESSION *classList = NULL;
643    intBool inheritFlag = FALSE;
644 
645    if (EnvArgTypeCheck(theEnv,functionName,1,SYMBOL_OR_STRING,&temp) == FALSE)
646      return(0L);
647    fileFound = DOToString(temp);
648 
649    argCount = EnvRtnArgCount(theEnv);
650    if (argCount > 1)
651      {
652       if (EnvArgTypeCheck(theEnv,functionName,2,SYMBOL,&temp) == FALSE)
653         {
654          ExpectedTypeError1(theEnv,functionName,2,"symbol \"local\" or \"visible\"");
655          SetEvaluationError(theEnv,TRUE);
656          return(0L);
657         }
658       if (strcmp(DOToString(temp),"local") == 0)
659         saveCode = LOCAL_SAVE;
660       else if (strcmp(DOToString(temp),"visible") == 0)
661         saveCode = VISIBLE_SAVE;
662       else
663         {
664          ExpectedTypeError1(theEnv,functionName,2,"symbol \"local\" or \"visible\"");
665          SetEvaluationError(theEnv,TRUE);
666          return(0L);
667         }
668       classList = GetFirstArgument()->nextArg->nextArg;
669 
670       /* ===========================
671          Check for "inherit" keyword
672          Must be at least one class
673          name following
674          =========================== */
675       if ((classList != NULL) ? (classList->nextArg != NULL) : FALSE)
676         {
677          if ((classList->type != SYMBOL) ? FALSE :
678              (strcmp(ValueToString(classList->value),"inherit") == 0))
679            {
680             inheritFlag = TRUE;
681             classList = classList->nextArg;
682            }
683         }
684      }
685 
686    return((*saveFunction)(theEnv,fileFound,saveCode,classList,inheritFlag));
687   }
688 
689 /****************************************************
690   NAME         : ProcessSaveClassList
691   DESCRIPTION  : Evaluates a list of class name
692                  expressions and stores them in a
693                  data object list
694   INPUTS       : 1) The name of the calling function
695                  2) The class expression list
696                  3) A flag indicating if only local
697                     or all visible instances are
698                     being saved
699                  4) A flag indicating if inheritance
700                     relationships should be checked
701                     between classes
702   RETURNS      : The evaluated class pointer data
703                  objects - NULL on errors
704   SIDE EFFECTS : Data objects allocated and
705                  classes validated
706   NOTES        : None
707  ****************************************************/
ProcessSaveClassList(void * theEnv,const char * functionName,EXPRESSION * classExps,int saveCode,intBool inheritFlag)708 static DATA_OBJECT *ProcessSaveClassList(
709   void *theEnv,
710   const char *functionName,
711   EXPRESSION *classExps,
712   int saveCode,
713   intBool inheritFlag)
714   {
715    DATA_OBJECT *head = NULL,*prv,*newItem,tmp;
716    DEFCLASS *theDefclass;
717    struct defmodule *currentModule;
718    int argIndex = inheritFlag ? 4 : 3;
719 
720    currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
721    while (classExps != NULL)
722      {
723       if (EvaluateExpression(theEnv,classExps,&tmp))
724         goto ProcessClassListError;
725       if (tmp.type != SYMBOL)
726         goto ProcessClassListError;
727       if (saveCode == LOCAL_SAVE)
728         theDefclass = LookupDefclassAnywhere(theEnv,currentModule,DOToString(tmp));
729       else
730         //theDefclass = LookupDefclassInScope(theEnv,DOToString(tmp));
731         { theDefclass = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); }
732 
733       if (theDefclass == NULL)
734         goto ProcessClassListError;
735       else if (theDefclass->abstract && (inheritFlag == FALSE))
736         goto ProcessClassListError;
737       prv = newItem = head;
738       while (newItem != NULL)
739         {
740          if (newItem->value == (void *) theDefclass)
741            goto ProcessClassListError;
742          else if (inheritFlag)
743            {
744             if (HasSuperclass((DEFCLASS *) newItem->value,theDefclass) ||
745                 HasSuperclass(theDefclass,(DEFCLASS *) newItem->value))
746              goto ProcessClassListError;
747            }
748          prv = newItem;
749          newItem = newItem->next;
750         }
751       newItem = get_struct(theEnv,dataObject);
752       newItem->type = DEFCLASS_PTR;
753       newItem->value = (void *) theDefclass;
754       newItem->next = NULL;
755       if (prv == NULL)
756         head = newItem;
757       else
758         prv->next = newItem;
759       argIndex++;
760       classExps = classExps->nextArg;
761      }
762    return(head);
763 
764 ProcessClassListError:
765    if (inheritFlag)
766      ExpectedTypeError1(theEnv,functionName,argIndex,"valid class name");
767    else
768      ExpectedTypeError1(theEnv,functionName,argIndex,"valid concrete class name");
769    ReturnSaveClassList(theEnv,head);
770    SetEvaluationError(theEnv,TRUE);
771    return(NULL);
772   }
773 
774 /****************************************************
775   NAME         : ReturnSaveClassList
776   DESCRIPTION  : Deallocates the class data object
777                  list created by ProcessSaveClassList
778   INPUTS       : The class data object list
779   RETURNS      : Nothing useful
780   SIDE EFFECTS : Class data object returned
781   NOTES        : None
782  ****************************************************/
ReturnSaveClassList(void * theEnv,DATA_OBJECT * classList)783 static void ReturnSaveClassList(
784   void *theEnv,
785   DATA_OBJECT *classList)
786   {
787    DATA_OBJECT *tmp;
788 
789    while (classList != NULL)
790      {
791       tmp = classList;
792       classList = classList->next;
793       rtn_struct(theEnv,dataObject,tmp);
794      }
795   }
796 
797 /***************************************************
798   NAME         : SaveOrMarkInstances
799   DESCRIPTION  : Iterates through all specified
800                  instances either marking needed
801                  atoms or writing instances in
802                  binary/text format
803   INPUTS       : 1) NULL (for marking),
804                     logical name (for text saves)
805                     file pointer (for binary saves)
806                  2) A cope flag indicating LOCAL
807                     or VISIBLE saves only
808                  3) A list of data objects
809                     containing the names of classes
810                     of instances to be saved
811                  4) A flag indicating whether to
812                     include subclasses of arg #3
813                  5) A flag indicating if the
814                     iteration can be interrupted
815                     or not
816                  6) The access function to mark
817                     or save an instance (can be NULL
818                     if only counting instances)
819   RETURNS      : The number of instances saved
820   SIDE EFFECTS : Instances amrked or saved
821   NOTES        : None
822  ***************************************************/
SaveOrMarkInstances(void * theEnv,void * theOutput,int saveCode,DATA_OBJECT * classList,intBool inheritFlag,intBool interruptOK,void (* saveInstanceFunc)(void *,void *,INSTANCE_TYPE *))823 static long SaveOrMarkInstances(
824   void *theEnv,
825   void *theOutput,
826   int saveCode,
827   DATA_OBJECT *classList,
828   intBool inheritFlag,
829   intBool interruptOK,
830   void (*saveInstanceFunc)(void *,void *,INSTANCE_TYPE *))
831   {
832    struct defmodule *currentModule;
833    int traversalID;
834    DATA_OBJECT *tmp;
835    INSTANCE_TYPE *ins;
836    long instanceCount = 0L;
837 
838    currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
839    if (classList != NULL)
840      {
841       traversalID = GetTraversalID(theEnv);
842       if (traversalID != -1)
843         {
844          for (tmp = classList ;
845               (! ((tmp == NULL) || (EvaluationData(theEnv)->HaltExecution && interruptOK))) ;
846               tmp = tmp->next)
847            instanceCount += SaveOrMarkInstancesOfClass(theEnv,theOutput,currentModule,saveCode,
848                                                        (DEFCLASS *) tmp->value,inheritFlag,
849                                                        traversalID,saveInstanceFunc);
850          ReleaseTraversalID(theEnv);
851         }
852      }
853    else
854      {
855       for (ins = (INSTANCE_TYPE *) GetNextInstanceInScope(theEnv,NULL) ;
856            (ins != NULL) && (EvaluationData(theEnv)->HaltExecution != TRUE) ;
857            ins = (INSTANCE_TYPE *) GetNextInstanceInScope(theEnv,(void *) ins))
858         {
859          if ((saveCode == VISIBLE_SAVE) ? TRUE :
860              (ins->cls->header.whichModule->theModule == currentModule))
861            {
862             if (saveInstanceFunc != NULL)
863               (*saveInstanceFunc)(theEnv,theOutput,ins);
864             instanceCount++;
865            }
866         }
867      }
868    return(instanceCount);
869   }
870 
871 /***************************************************
872   NAME         : SaveOrMarkInstancesOfClass
873   DESCRIPTION  : Saves off the direct (and indirect)
874                  instance of the specified class
875   INPUTS       : 1) The logical name of the output
876                     (or file pointer for binary
877                      output)
878                  2) The current module
879                  3) A flag indicating local
880                     or visible saves
881                  4) The defclass
882                  5) A flag indicating whether to
883                     save subclass instances or not
884                  6) A traversal id for marking
885                     visited classes
886                  7) A pointer to the instance
887                     manipulation function to call
888                     (can be NULL for only counting
889                      instances)
890   RETURNS      : The number of instances saved
891   SIDE EFFECTS : Appropriate instances saved
892   NOTES        : None
893  ***************************************************/
SaveOrMarkInstancesOfClass(void * theEnv,void * theOutput,struct defmodule * currentModule,int saveCode,DEFCLASS * theDefclass,intBool inheritFlag,int traversalID,void (* saveInstanceFunc)(void *,void *,INSTANCE_TYPE *))894 static long SaveOrMarkInstancesOfClass(
895   void *theEnv,
896   void *theOutput,
897   struct defmodule *currentModule,
898   int saveCode,
899   DEFCLASS *theDefclass,
900   intBool inheritFlag,
901   int traversalID,
902   void (*saveInstanceFunc)(void *,void *,INSTANCE_TYPE *))
903   {
904    INSTANCE_TYPE *theInstance;
905    DEFCLASS *subclass;
906    long i;
907    long instanceCount = 0L;
908 
909    if (TestTraversalID(theDefclass->traversalRecord,traversalID))
910      return(instanceCount);
911    SetTraversalID(theDefclass->traversalRecord,traversalID);
912    if (((saveCode == LOCAL_SAVE) &&
913         (theDefclass->header.whichModule->theModule == currentModule)) ||
914        ((saveCode == VISIBLE_SAVE) &&
915         DefclassInScope(theEnv,theDefclass,currentModule)))
916      {
917       for (theInstance = (INSTANCE_TYPE *)
918              EnvGetNextInstanceInClass(theEnv,(void *) theDefclass,NULL) ;
919            theInstance != NULL ;
920            theInstance = (INSTANCE_TYPE *)
921            EnvGetNextInstanceInClass(theEnv,(void *) theDefclass,(void *) theInstance))
922         {
923          if (saveInstanceFunc != NULL)
924            (*saveInstanceFunc)(theEnv,theOutput,theInstance);
925          instanceCount++;
926         }
927      }
928    if (inheritFlag)
929      {
930       for (i = 0 ; i < theDefclass->directSubclasses.classCount ; i++)
931         {
932          subclass = theDefclass->directSubclasses.classArray[i];
933            instanceCount += SaveOrMarkInstancesOfClass(theEnv,theOutput,currentModule,saveCode,
934                                                        subclass,TRUE,traversalID,
935                                                        saveInstanceFunc);
936         }
937      }
938    return(instanceCount);
939   }
940 
941 /***************************************************
942   NAME         : SaveSingleInstanceText
943   DESCRIPTION  : Writes given instance to file
944   INPUTS       : 1) The logical name of the output
945                  2) The instance to save
946   RETURNS      : Nothing useful
947   SIDE EFFECTS : Instance written
948   NOTES        : None
949  ***************************************************/
SaveSingleInstanceText(void * theEnv,void * vLogicalName,INSTANCE_TYPE * theInstance)950 static void SaveSingleInstanceText(
951   void *theEnv,
952   void *vLogicalName,
953   INSTANCE_TYPE *theInstance)
954   {
955    long i;
956    INSTANCE_SLOT *sp;
957    const char *logicalName = (const char *) vLogicalName;
958 
959    EnvPrintRouter(theEnv,logicalName,"([");
960    EnvPrintRouter(theEnv,logicalName,ValueToString(theInstance->name));
961    EnvPrintRouter(theEnv,logicalName,"] of ");
962    EnvPrintRouter(theEnv,logicalName,ValueToString(theInstance->cls->header.name));
963    for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
964      {
965       sp = theInstance->slotAddresses[i];
966       EnvPrintRouter(theEnv,logicalName,"\n   (");
967       EnvPrintRouter(theEnv,logicalName,ValueToString(sp->desc->slotName->name));
968       if (sp->type != MULTIFIELD)
969         {
970          EnvPrintRouter(theEnv,logicalName," ");
971          PrintAtom(theEnv,logicalName,(int) sp->type,sp->value);
972         }
973       else if (GetInstanceSlotLength(sp) != 0)
974         {
975          EnvPrintRouter(theEnv,logicalName," ");
976          PrintMultifield(theEnv,logicalName,(MULTIFIELD_PTR) sp->value,0,
977                          (long) (GetInstanceSlotLength(sp) - 1),FALSE);
978         }
979       EnvPrintRouter(theEnv,logicalName,")");
980      }
981    EnvPrintRouter(theEnv,logicalName,")\n\n");
982   }
983 
984 #if BSAVE_INSTANCES
985 
986 /***************************************************
987   NAME         : WriteBinaryHeader
988   DESCRIPTION  : Writes identifying string to
989                  instance binary file to assist in
990                  later verification
991   INPUTS       : The binary file pointer
992   RETURNS      : Nothing useful
993   SIDE EFFECTS : Binary prefix headers written
994   NOTES        : None
995  ***************************************************/
WriteBinaryHeader(void * theEnv,FILE * bsaveFP)996 static void WriteBinaryHeader(
997   void *theEnv,
998   FILE *bsaveFP)
999   {
1000    fwrite((void *) InstanceFileData(theEnv)->InstanceBinaryPrefixID,
1001           (STD_SIZE) (strlen(InstanceFileData(theEnv)->InstanceBinaryPrefixID) + 1),1,bsaveFP);
1002    fwrite((void *) InstanceFileData(theEnv)->InstanceBinaryVersionID,
1003           (STD_SIZE) (strlen(InstanceFileData(theEnv)->InstanceBinaryVersionID) + 1),1,bsaveFP);
1004   }
1005 
1006 /***************************************************
1007   NAME         : MarkSingleInstance
1008   DESCRIPTION  : Marks all the atoms needed in
1009                  the slot values of an instance
1010   INPUTS       : 1) The output (ignored)
1011                  2) The instance
1012   RETURNS      : Nothing useful
1013   SIDE EFFECTS : Instance slot value atoms marked
1014   NOTES        : None
1015  ***************************************************/
MarkSingleInstance(void * theEnv,void * theOutput,INSTANCE_TYPE * theInstance)1016 static void MarkSingleInstance(
1017   void *theEnv,
1018   void *theOutput,
1019   INSTANCE_TYPE *theInstance)
1020   {
1021 #if MAC_XCD
1022 #pragma unused(theOutput)
1023 #endif
1024    INSTANCE_SLOT *sp;
1025    long i, j;
1026 
1027    InstanceFileData(theEnv)->BinaryInstanceFileSize += (unsigned long) (sizeof(long) * 2);
1028    theInstance->name->neededSymbol = TRUE;
1029    theInstance->cls->header.name->neededSymbol = TRUE;
1030    InstanceFileData(theEnv)->BinaryInstanceFileSize +=
1031        (unsigned long) ((sizeof(long) * 2) +
1032                         (sizeof(struct bsaveSlotValue) *
1033                          theInstance->cls->instanceSlotCount) +
1034                         sizeof(unsigned long) +
1035                         sizeof(unsigned));
1036    for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
1037      {
1038       sp = theInstance->slotAddresses[i];
1039       sp->desc->slotName->name->neededSymbol = TRUE;
1040       if (sp->desc->multiple)
1041         {
1042          for (j = 1 ; j <= GetInstanceSlotLength(sp) ; j++)
1043            MarkNeededAtom(theEnv,GetMFType(sp->value,j),GetMFValue(sp->value,j));
1044         }
1045       else
1046         MarkNeededAtom(theEnv,(int) sp->type,sp->value);
1047      }
1048   }
1049 
1050 /***************************************************
1051   NAME         : MarkNeededAtom
1052   DESCRIPTION  : Marks an integer/float/symbol as
1053                  being need by a set of instances
1054   INPUTS       : 1) The type of atom
1055                  2) The value of the atom
1056   RETURNS      : Nothing useful
1057   SIDE EFFECTS : Atom marked for saving
1058   NOTES        : None
1059  ***************************************************/
MarkNeededAtom(void * theEnv,int type,void * value)1060 static void MarkNeededAtom(
1061   void *theEnv,
1062   int type,
1063   void *value)
1064   {
1065    InstanceFileData(theEnv)->BinaryInstanceFileSize += (unsigned long) sizeof(struct bsaveSlotValueAtom);
1066 
1067    /* =====================================
1068       Assumes slot value atoms  can only be
1069       floats, integers, symbols, strings,
1070       instance-names, instance-addresses,
1071       fact-addresses or external-addresses
1072       ===================================== */
1073    switch (type)
1074      {
1075       case SYMBOL:
1076       case STRING:
1077       case INSTANCE_NAME:
1078          ((SYMBOL_HN *) value)->neededSymbol = TRUE;
1079          break;
1080       case FLOAT:
1081          ((FLOAT_HN *) value)->neededFloat = TRUE;
1082          break;
1083       case INTEGER:
1084          ((INTEGER_HN *) value)->neededInteger = TRUE;
1085          break;
1086       case INSTANCE_ADDRESS:
1087          GetFullInstanceName(theEnv,(INSTANCE_TYPE *) value)->neededSymbol = TRUE;
1088          break;
1089      }
1090   }
1091 
1092 /****************************************************
1093   NAME         : SaveSingleInstanceBinary
1094   DESCRIPTION  : Writes given instance to binary file
1095   INPUTS       : 1) Binary file pointer
1096                  2) The instance to save
1097   RETURNS      : Nothing useful
1098   SIDE EFFECTS : Instance written
1099   NOTES        : None
1100  ****************************************************/
SaveSingleInstanceBinary(void * theEnv,void * vBsaveFP,INSTANCE_TYPE * theInstance)1101 static void SaveSingleInstanceBinary(
1102   void *theEnv,
1103   void *vBsaveFP,
1104   INSTANCE_TYPE *theInstance)
1105   {
1106    long nameIndex;
1107    long i,j;
1108    INSTANCE_SLOT *sp;
1109    FILE *bsaveFP = (FILE *) vBsaveFP;
1110    struct bsaveSlotValue bs;
1111    long totalValueCount = 0L;
1112    long slotLen;
1113 
1114    /* ===========================
1115       Write out the instance name
1116       =========================== */
1117    nameIndex = (long) theInstance->name->bucket;
1118    fwrite((void *) &nameIndex,(int) sizeof(long),1,bsaveFP);
1119 
1120    /* ========================
1121       Write out the class name
1122       ======================== */
1123    nameIndex = (long) theInstance->cls->header.name->bucket;
1124    fwrite((void *) &nameIndex,(int) sizeof(long),1,bsaveFP);
1125 
1126    /* ======================================
1127       Write out the number of slot-overrides
1128       ====================================== */
1129    fwrite((void *) &theInstance->cls->instanceSlotCount,
1130           (int) sizeof(short),1,bsaveFP);
1131 
1132    /* =========================================
1133       Write out the slot names and value counts
1134       ========================================= */
1135    for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
1136      {
1137       sp = theInstance->slotAddresses[i];
1138 
1139       /* ===============================================
1140          Write out the number of atoms in the slot value
1141          =============================================== */
1142       bs.slotName = (long) sp->desc->slotName->name->bucket;
1143       bs.valueCount = sp->desc->multiple ? GetInstanceSlotLength(sp) : 1;
1144       fwrite((void *) &bs,(int) sizeof(struct bsaveSlotValue),1,bsaveFP);
1145       totalValueCount += (unsigned long) bs.valueCount;
1146      }
1147 
1148    /* ==================================
1149       Write out the number of slot value
1150       atoms for the whole instance
1151       ================================== */
1152    if (theInstance->cls->instanceSlotCount != 0) // (totalValueCount != 0L) : Bug fix if any slots, write out count
1153      fwrite((void *) &totalValueCount,(int) sizeof(unsigned long),1,bsaveFP);
1154 
1155    /* ==============================
1156       Write out the slot value atoms
1157       ============================== */
1158    for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
1159      {
1160       sp = theInstance->slotAddresses[i];
1161       slotLen = sp->desc->multiple ? GetInstanceSlotLength(sp) : 1;
1162 
1163       /* =========================================
1164          Write out the type and index of each atom
1165          ========================================= */
1166       if (sp->desc->multiple)
1167         {
1168          for (j = 1 ; j <= slotLen ; j++)
1169            SaveAtomBinary(theEnv,GetMFType(sp->value,j),GetMFValue(sp->value,j),bsaveFP);
1170         }
1171       else
1172         SaveAtomBinary(theEnv,(unsigned short) sp->type,sp->value,bsaveFP);
1173      }
1174   }
1175 
1176 /***************************************************
1177   NAME         : SaveAtomBinary
1178   DESCRIPTION  : Writes out an instance slot value
1179                  atom to the binary file
1180   INPUTS       : 1) The atom type
1181                  2) The atom value
1182                  3) The binary file pointer
1183   RETURNS      : Nothing useful
1184   SIDE EFFECTS : atom written
1185   NOTES        :
1186  ***************************************************/
SaveAtomBinary(void * theEnv,unsigned short type,void * value,FILE * bsaveFP)1187 static void SaveAtomBinary(
1188   void *theEnv,
1189   unsigned short type,
1190   void *value,
1191   FILE *bsaveFP)
1192   {
1193    struct bsaveSlotValueAtom bsa;
1194 
1195    /* =====================================
1196       Assumes slot value atoms  can only be
1197       floats, integers, symbols, strings,
1198       instance-names, instance-addresses,
1199       fact-addresses or external-addresses
1200       ===================================== */
1201    bsa.type = type;
1202    switch (type)
1203      {
1204       case SYMBOL:
1205       case STRING:
1206       case INSTANCE_NAME:
1207          bsa.value = (long) ((SYMBOL_HN *) value)->bucket;
1208          break;
1209       case FLOAT:
1210          bsa.value = (long) ((FLOAT_HN *) value)->bucket;
1211          break;
1212       case INTEGER:
1213          bsa.value = (long) ((INTEGER_HN *) value)->bucket;
1214          break;
1215       case INSTANCE_ADDRESS:
1216          bsa.type = INSTANCE_NAME;
1217          bsa.value = (long) GetFullInstanceName(theEnv,(INSTANCE_TYPE *) value)->bucket;
1218          break;
1219       default:
1220          bsa.value = -1L;
1221      }
1222    fwrite((void *) &bsa,(int) sizeof(struct bsaveSlotValueAtom),1,bsaveFP);
1223   }
1224 
1225 #endif
1226 
1227 /**********************************************************************
1228   NAME         : LoadOrRestoreInstances
1229   DESCRIPTION  : Loads instances from named file
1230   INPUTS       : 1) The name of the input file
1231                  2) An integer flag indicating whether or
1232                     not to use message-passing to create
1233                     the new instances and delete old versions
1234                  3) An integer flag indicating if arg #1
1235                     is a file name or the name of a string router
1236   RETURNS      : The number of instances loaded/restored
1237   SIDE EFFECTS : Instances loaded from file
1238   NOTES        : None
1239  **********************************************************************/
LoadOrRestoreInstances(void * theEnv,const char * file,int usemsgs,int isFileName)1240 static long LoadOrRestoreInstances(
1241   void *theEnv,
1242   const char *file,
1243   int usemsgs,
1244   int isFileName)
1245   {
1246    DATA_OBJECT temp;
1247    FILE *sfile = NULL,*svload = NULL;
1248    const char *ilog;
1249    EXPRESSION *top;
1250    int svoverride;
1251    long instanceCount = 0L;
1252 
1253    if (isFileName) {
1254      if ((sfile = GenOpen(theEnv,file,"r")) == NULL)
1255        {
1256         SetEvaluationError(theEnv,TRUE);
1257         return(-1L);
1258        }
1259      svload = GetFastLoad(theEnv);
1260      ilog = (char *) sfile;
1261      SetFastLoad(theEnv,sfile);
1262    } else {
1263      ilog = file;
1264    }
1265    top = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"make-instance"));
1266    GetToken(theEnv,ilog,&DefclassData(theEnv)->ObjectParseToken);
1267    svoverride = InstanceData(theEnv)->MkInsMsgPass;
1268    InstanceData(theEnv)->MkInsMsgPass = usemsgs;
1269    while ((GetType(DefclassData(theEnv)->ObjectParseToken) != STOP) && (EvaluationData(theEnv)->HaltExecution != TRUE))
1270      {
1271       if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN)
1272         {
1273          SyntaxErrorMessage(theEnv,"instance definition");
1274          rtn_struct(theEnv,expr,top);
1275          if (isFileName) {
1276            GenClose(theEnv,sfile);
1277            SetFastLoad(theEnv,svload);
1278          }
1279          SetEvaluationError(theEnv,TRUE);
1280          InstanceData(theEnv)->MkInsMsgPass = svoverride;
1281          return(instanceCount);
1282         }
1283       if (ParseSimpleInstance(theEnv,top,ilog) == NULL)
1284         {
1285          if (isFileName) {
1286            GenClose(theEnv,sfile);
1287            SetFastLoad(theEnv,svload);
1288          }
1289          InstanceData(theEnv)->MkInsMsgPass = svoverride;
1290          SetEvaluationError(theEnv,TRUE);
1291          return(instanceCount);
1292         }
1293       ExpressionInstall(theEnv,top);
1294       EvaluateExpression(theEnv,top,&temp);
1295       ExpressionDeinstall(theEnv,top);
1296       if (! EvaluationData(theEnv)->EvaluationError)
1297         instanceCount++;
1298       ReturnExpression(theEnv,top->argList);
1299       top->argList = NULL;
1300       GetToken(theEnv,ilog,&DefclassData(theEnv)->ObjectParseToken);
1301      }
1302    rtn_struct(theEnv,expr,top);
1303    if (isFileName) {
1304      GenClose(theEnv,sfile);
1305      SetFastLoad(theEnv,svload);
1306    }
1307    InstanceData(theEnv)->MkInsMsgPass = svoverride;
1308    return(instanceCount);
1309   }
1310 
1311 /***************************************************
1312   NAME         : ProcessFileErrorMessage
1313   DESCRIPTION  : Prints an error message when a
1314                  file containing text or binary
1315                  instances cannot be processed.
1316   INPUTS       : The name of the input file and the
1317                  function which opened it.
1318   RETURNS      : No value
1319   SIDE EFFECTS : None
1320   NOTES        : None
1321  ***************************************************/
ProcessFileErrorMessage(void * theEnv,const char * functionName,const char * fileName)1322 static void ProcessFileErrorMessage(
1323   void *theEnv,
1324   const char *functionName,
1325   const char *fileName)
1326   {
1327    PrintErrorID(theEnv,"INSFILE",1,FALSE);
1328    EnvPrintRouter(theEnv,WERROR,"Function ");
1329    EnvPrintRouter(theEnv,WERROR,functionName);
1330    EnvPrintRouter(theEnv,WERROR," could not completely process file ");
1331    EnvPrintRouter(theEnv,WERROR,fileName);
1332    EnvPrintRouter(theEnv,WERROR,".\n");
1333   }
1334 
1335 #if BLOAD_INSTANCES
1336 
1337 /*******************************************************
1338   NAME         : VerifyBinaryHeader
1339   DESCRIPTION  : Reads the prefix and version headers
1340                  from a file to verify that the
1341                  input is a valid binary instances file
1342   INPUTS       : The name of the file
1343   RETURNS      : TRUE if OK, FALSE otherwise
1344   SIDE EFFECTS : Input prefix and version read
1345   NOTES        : Assumes file already open with
1346                  GenOpenReadBinary
1347  *******************************************************/
VerifyBinaryHeader(void * theEnv,const char * theFile)1348 static intBool VerifyBinaryHeader(
1349   void *theEnv,
1350   const char *theFile)
1351   {
1352    char buf[20];
1353 
1354    GenReadBinary(theEnv,(void *) buf,(unsigned long) (strlen(InstanceFileData(theEnv)->InstanceBinaryPrefixID) + 1));
1355    if (strcmp(buf,InstanceFileData(theEnv)->InstanceBinaryPrefixID) != 0)
1356      {
1357       PrintErrorID(theEnv,"INSFILE",2,FALSE);
1358       EnvPrintRouter(theEnv,WERROR,theFile);
1359       EnvPrintRouter(theEnv,WERROR," file is not a binary instances file.\n");
1360       return(FALSE);
1361      }
1362    GenReadBinary(theEnv,(void *) buf,(unsigned long) (strlen(InstanceFileData(theEnv)->InstanceBinaryVersionID) + 1));
1363    if (strcmp(buf,InstanceFileData(theEnv)->InstanceBinaryVersionID) != 0)
1364      {
1365       PrintErrorID(theEnv,"INSFILE",3,FALSE);
1366       EnvPrintRouter(theEnv,WERROR,theFile);
1367       EnvPrintRouter(theEnv,WERROR," file is not a compatible binary instances file.\n");
1368       return(FALSE);
1369      }
1370    return(TRUE);
1371   }
1372 
1373 /***************************************************
1374   NAME         : LoadSingleBinaryInstance
1375   DESCRIPTION  : Reads the binary data for a new
1376                  instance and its slot values and
1377                  creates/initializes the instance
1378   INPUTS       : None
1379   RETURNS      : TRUE if all OK,
1380                  FALSE otherwise
1381   SIDE EFFECTS : Binary data read and instance
1382                  created
1383   NOTES        : Uses global GenReadBinary(theEnv,)
1384  ***************************************************/
LoadSingleBinaryInstance(void * theEnv)1385 static intBool LoadSingleBinaryInstance(
1386   void *theEnv)
1387   {
1388    SYMBOL_HN *instanceName,
1389              *className;
1390    short slotCount;
1391    DEFCLASS *theDefclass;
1392    INSTANCE_TYPE *newInstance;
1393    struct bsaveSlotValue *bsArray;
1394    struct bsaveSlotValueAtom *bsaArray = NULL;
1395    long nameIndex;
1396    unsigned long totalValueCount;
1397    long i, j;
1398    INSTANCE_SLOT *sp;
1399    DATA_OBJECT slotValue,junkValue;
1400 
1401    /* =====================
1402       Get the instance name
1403       ===================== */
1404    BufferedRead(theEnv,(void *) &nameIndex,(unsigned long) sizeof(long));
1405    instanceName = SymbolPointer(nameIndex);
1406 
1407    /* ==================
1408       Get the class name
1409       ================== */
1410    BufferedRead(theEnv,(void *) &nameIndex,(unsigned long) sizeof(long));
1411    className = SymbolPointer(nameIndex);
1412 
1413    /* ==================
1414       Get the slot count
1415       ================== */
1416    BufferedRead(theEnv,(void *) &slotCount,(unsigned long) sizeof(short));
1417 
1418    /* =============================
1419       Make sure the defclass exists
1420       and check the slot count
1421       ============================= */
1422    //theDefclass = LookupDefclassInScope(theEnv,ValueToString(className));
1423    theDefclass = LookupDefclassByMdlOrScope(theEnv,ValueToString(className));
1424    if (theDefclass == NULL)
1425      {
1426       ClassExistError(theEnv,"bload-instances",ValueToString(className));
1427       return(FALSE);
1428      }
1429    if (theDefclass->instanceSlotCount != slotCount)
1430      {
1431       BinaryLoadInstanceError(theEnv,instanceName,theDefclass);
1432       return(FALSE);
1433      }
1434 
1435    /* ===================================
1436       Create the new unitialized instance
1437       =================================== */
1438    newInstance = BuildInstance(theEnv,instanceName,theDefclass,FALSE);
1439    if (newInstance == NULL)
1440      {
1441       BinaryLoadInstanceError(theEnv,instanceName,theDefclass);
1442       return(FALSE);
1443      }
1444    if (slotCount == 0)
1445      return(TRUE);
1446 
1447    /* ====================================
1448       Read all slot override info and slot
1449       value atoms into big arrays
1450       ==================================== */
1451    bsArray = (struct bsaveSlotValue *) gm2(theEnv,(sizeof(struct bsaveSlotValue) * slotCount));
1452    BufferedRead(theEnv,(void *) bsArray,(unsigned long) (sizeof(struct bsaveSlotValue) * slotCount));
1453 
1454    BufferedRead(theEnv,(void *) &totalValueCount,(unsigned long) sizeof(unsigned long));
1455 
1456    if (totalValueCount != 0L)
1457      {
1458       bsaArray = (struct bsaveSlotValueAtom *)
1459                   gm3(theEnv,(long) (totalValueCount * sizeof(struct bsaveSlotValueAtom)));
1460       BufferedRead(theEnv,(void *) bsaArray,
1461                    (unsigned long) (totalValueCount * sizeof(struct bsaveSlotValueAtom)));
1462      }
1463 
1464    /* =========================
1465       Insert the values for the
1466       slot overrides
1467       ========================= */
1468    for (i = 0 , j = 0L ; i < slotCount ; i++)
1469      {
1470       /* ===========================================================
1471          Here is another check for the validity of the binary file -
1472          the order of the slots in the file should match the
1473          order in the class definition
1474          =========================================================== */
1475       sp = newInstance->slotAddresses[i];
1476       if (sp->desc->slotName->name != SymbolPointer(bsArray[i].slotName))
1477         goto LoadError;
1478       CreateSlotValue(theEnv,&slotValue,(struct bsaveSlotValueAtom *) &bsaArray[j],
1479                       bsArray[i].valueCount);
1480 
1481       if (PutSlotValue(theEnv,newInstance,sp,&slotValue,&junkValue,"bload-instances") == FALSE)
1482         goto LoadError;
1483 
1484       j += (unsigned long) bsArray[i].valueCount;
1485      }
1486 
1487    rm(theEnv,(void *) bsArray,(sizeof(struct bsaveSlotValue) * slotCount));
1488 
1489    if (totalValueCount != 0L)
1490      rm3(theEnv,(void *) bsaArray,
1491          (long) (totalValueCount * sizeof(struct bsaveSlotValueAtom)));
1492 
1493    return(TRUE);
1494 
1495 LoadError:
1496    BinaryLoadInstanceError(theEnv,instanceName,theDefclass);
1497    QuashInstance(theEnv,newInstance);
1498    rm(theEnv,(void *) bsArray,(sizeof(struct bsaveSlotValue) * slotCount));
1499    rm3(theEnv,(void *) bsaArray,
1500        (long) (totalValueCount * sizeof(struct bsaveSlotValueAtom)));
1501    return(FALSE);
1502   }
1503 
1504 /***************************************************
1505   NAME         : BinaryLoadInstanceError
1506   DESCRIPTION  : Prints out an error message when
1507                  an instance could not be
1508                  successfully loaded from a
1509                  binary file
1510   INPUTS       : 1) The instance name
1511                  2) The defclass
1512   RETURNS      : Nothing useful
1513   SIDE EFFECTS : Error message printed
1514   NOTES        : None
1515  ***************************************************/
BinaryLoadInstanceError(void * theEnv,SYMBOL_HN * instanceName,DEFCLASS * theDefclass)1516 static void BinaryLoadInstanceError(
1517   void *theEnv,
1518   SYMBOL_HN *instanceName,
1519   DEFCLASS *theDefclass)
1520   {
1521    PrintErrorID(theEnv,"INSFILE",4,FALSE);
1522    EnvPrintRouter(theEnv,WERROR,"Function bload-instances unable to load instance [");
1523    EnvPrintRouter(theEnv,WERROR,ValueToString(instanceName));
1524    EnvPrintRouter(theEnv,WERROR,"] of class ");
1525    PrintClassName(theEnv,WERROR,theDefclass,TRUE);
1526   }
1527 
1528 /***************************************************
1529   NAME         : CreateSlotValue
1530   DESCRIPTION  : Creates a data object value from
1531                  the binary slot value atom data
1532   INPUTS       : 1) A data object buffer
1533                  2) The slot value atoms array
1534                  3) The number of values to put
1535                     in the data object
1536   RETURNS      : Nothing useful
1537   SIDE EFFECTS : Data object initialized
1538                  (if more than one value, a
1539                  multifield is created)
1540   NOTES        : None
1541  ***************************************************/
CreateSlotValue(void * theEnv,DATA_OBJECT * result,struct bsaveSlotValueAtom * bsaValues,unsigned long valueCount)1542 static void CreateSlotValue(
1543   void *theEnv,
1544   DATA_OBJECT *result,
1545   struct bsaveSlotValueAtom *bsaValues,
1546   unsigned long valueCount)
1547   {
1548    register unsigned i;
1549 
1550    if (valueCount == 0)
1551      {
1552       result->type = MULTIFIELD;
1553       result->value = EnvCreateMultifield(theEnv,0L);
1554       result->begin = 0;
1555       result->end = -1;
1556      }
1557    else if (valueCount == 1)
1558      {
1559       result->type = bsaValues[0].type;
1560       result->value = GetBinaryAtomValue(theEnv,&bsaValues[0]);
1561      }
1562    else
1563      {
1564       result->type = MULTIFIELD;
1565       result->value = EnvCreateMultifield(theEnv,valueCount);
1566       result->begin = 0;
1567       SetpDOEnd(result,valueCount);
1568       for (i = 1 ; i <= valueCount ; i++)
1569         {
1570          SetMFType(result->value,i,(short) bsaValues[i-1].type);
1571          SetMFValue(result->value,i,GetBinaryAtomValue(theEnv,&bsaValues[i-1]));
1572         }
1573      }
1574   }
1575 
1576 /***************************************************
1577   NAME         : GetBinaryAtomValue
1578   DESCRIPTION  : Uses the binary index of an atom
1579                  to find the ephemeris value
1580   INPUTS       : The binary type and index
1581   RETURNS      : The symbol/etc. pointer
1582   SIDE EFFECTS : None
1583   NOTES        : None
1584  ***************************************************/
GetBinaryAtomValue(void * theEnv,struct bsaveSlotValueAtom * ba)1585 static void *GetBinaryAtomValue(
1586   void *theEnv,
1587   struct bsaveSlotValueAtom *ba)
1588   {
1589    switch (ba->type)
1590      {
1591       case SYMBOL:
1592       case STRING:
1593       case INSTANCE_NAME:
1594          return((void *) SymbolPointer(ba->value));
1595       case FLOAT:
1596          return((void *) FloatPointer(ba->value));
1597       case INTEGER:
1598          return((void *) IntegerPointer(ba->value));
1599       case FACT_ADDRESS:
1600 #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT
1601          return((void *) &FactData(theEnv)->DummyFact);
1602 #else
1603          return(NULL);
1604 #endif
1605       case EXTERNAL_ADDRESS:
1606         return(NULL);
1607 
1608       default:
1609         {
1610          SystemError(theEnv,"INSFILE",1);
1611          EnvExitRouter(theEnv,EXIT_FAILURE);
1612         }
1613      }
1614    return(NULL);
1615   }
1616 
1617 /***************************************************
1618   NAME         : BufferedRead
1619   DESCRIPTION  : Reads data from binary file
1620                  (Larger blocks than requested size
1621                   may be read and buffered)
1622   INPUTS       : 1) The buffer
1623                  2) The buffer size
1624   RETURNS      : Nothing useful
1625   SIDE EFFECTS : Data stored in buffer
1626   NOTES        : None
1627  ***************************************************/
BufferedRead(void * theEnv,void * buf,unsigned long bufsz)1628 static void BufferedRead(
1629   void *theEnv,
1630   void *buf,
1631   unsigned long bufsz)
1632   {
1633    unsigned long i,amountLeftToRead;
1634 
1635    if (InstanceFileData(theEnv)->CurrentReadBuffer != NULL)
1636      {
1637       amountLeftToRead = InstanceFileData(theEnv)->CurrentReadBufferSize - InstanceFileData(theEnv)->CurrentReadBufferOffset;
1638       if (bufsz <= amountLeftToRead)
1639         {
1640          for (i = 0L ; i < bufsz ; i++)
1641            ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i + InstanceFileData(theEnv)->CurrentReadBufferOffset];
1642          InstanceFileData(theEnv)->CurrentReadBufferOffset += bufsz;
1643          if (InstanceFileData(theEnv)->CurrentReadBufferOffset == InstanceFileData(theEnv)->CurrentReadBufferSize)
1644            FreeReadBuffer(theEnv);
1645         }
1646       else
1647         {
1648          if (InstanceFileData(theEnv)->CurrentReadBufferOffset < InstanceFileData(theEnv)->CurrentReadBufferSize)
1649            {
1650             for (i = 0L ; i < amountLeftToRead ; i++)
1651               ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i + InstanceFileData(theEnv)->CurrentReadBufferOffset];
1652             bufsz -= amountLeftToRead;
1653             buf = (void *) (((char *) buf) + amountLeftToRead);
1654            }
1655          FreeReadBuffer(theEnv);
1656          BufferedRead(theEnv,buf,bufsz);
1657         }
1658      }
1659    else
1660      {
1661       if (bufsz > MAX_BLOCK_SIZE)
1662         {
1663          InstanceFileData(theEnv)->CurrentReadBufferSize = bufsz;
1664          if (bufsz > (InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset))
1665            {
1666             SystemError(theEnv,"INSFILE",2);
1667             EnvExitRouter(theEnv,EXIT_FAILURE);
1668            }
1669         }
1670       else if (MAX_BLOCK_SIZE >
1671               (InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset))
1672         InstanceFileData(theEnv)->CurrentReadBufferSize = InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset;
1673       else
1674         InstanceFileData(theEnv)->CurrentReadBufferSize = (unsigned long) MAX_BLOCK_SIZE;
1675       InstanceFileData(theEnv)->CurrentReadBuffer = (char *) genalloc(theEnv,InstanceFileData(theEnv)->CurrentReadBufferSize);
1676       GenReadBinary(theEnv,(void *) InstanceFileData(theEnv)->CurrentReadBuffer,InstanceFileData(theEnv)->CurrentReadBufferSize);
1677       for (i = 0L ; i < bufsz ; i++)
1678         ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i];
1679       InstanceFileData(theEnv)->CurrentReadBufferOffset = bufsz;
1680       InstanceFileData(theEnv)->BinaryInstanceFileOffset += InstanceFileData(theEnv)->CurrentReadBufferSize;
1681      }
1682   }
1683 
1684 /*****************************************************
1685   NAME         : FreeReadBuffer
1686   DESCRIPTION  : Deallocates buffer for binary reads
1687   INPUTS       : None
1688   RETURNS      : Nothing usefu
1689   SIDE EFFECTS : Binary global read buffer deallocated
1690   NOTES        : None
1691  *****************************************************/
FreeReadBuffer(void * theEnv)1692 static void FreeReadBuffer(
1693   void *theEnv)
1694   {
1695    if (InstanceFileData(theEnv)->CurrentReadBufferSize != 0L)
1696      {
1697       genfree(theEnv,(void *) InstanceFileData(theEnv)->CurrentReadBuffer,InstanceFileData(theEnv)->CurrentReadBufferSize);
1698       InstanceFileData(theEnv)->CurrentReadBuffer = NULL;
1699       InstanceFileData(theEnv)->CurrentReadBufferSize = 0L;
1700      }
1701   }
1702 
1703 #endif /* BLOAD_INSTANCES */
1704 
1705 /*#####################################*/
1706 /* ALLOW_ENVIRONMENT_GLOBALS Functions */
1707 /*#####################################*/
1708 
1709 #if ALLOW_ENVIRONMENT_GLOBALS
1710 
1711 #if BLOAD_INSTANCES
BinaryLoadInstances(const char * theFile)1712 globle long BinaryLoadInstances(
1713   const char *theFile)
1714   {
1715    return EnvBinaryLoadInstances(GetCurrentEnvironment(),theFile);
1716   }
1717 #endif
1718 
1719 #if BSAVE_INSTANCES
BinarySaveInstances(const char * file,int saveCode)1720 globle long BinarySaveInstances(
1721   const char *file,
1722   int saveCode)
1723   {
1724    return EnvBinarySaveInstances(GetCurrentEnvironment(),file,saveCode);
1725   }
1726 #endif
1727 
LoadInstances(const char * file)1728 globle long LoadInstances(
1729   const char *file)
1730   {
1731    return EnvLoadInstances(GetCurrentEnvironment(),file);
1732   }
1733 
LoadInstancesFromString(const char * theString,int theMax)1734 globle long LoadInstancesFromString(
1735   const char *theString,
1736   int theMax)
1737   {
1738    return EnvLoadInstancesFromString(GetCurrentEnvironment(),theString,theMax);
1739   }
1740 
RestoreInstances(const char * file)1741 globle long RestoreInstances(
1742   const char *file)
1743   {
1744    return EnvRestoreInstances(GetCurrentEnvironment(),file);
1745   }
1746 
RestoreInstancesFromString(const char * theString,int theMax)1747 globle long RestoreInstancesFromString(
1748   const char *theString,
1749   int theMax)
1750   {
1751    return EnvRestoreInstancesFromString(GetCurrentEnvironment(),theString,theMax);
1752   }
1753 
SaveInstances(const char * file,int saveCode)1754 globle long SaveInstances(
1755   const char *file,
1756   int saveCode)
1757   {
1758    return EnvSaveInstances(GetCurrentEnvironment(),file,saveCode);
1759   }
1760 
1761 #endif /* ALLOW_ENVIRONMENT_GLOBALS */
1762 
1763 
1764 #endif /* OBJECT_SYSTEM */
1765 
1766 
1767