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