clipsruby 0.0.2

data/ext/clipsruby/insfile.c

@@ -0,0 +1,1764 @@
+   /*******************************************************/
+   /*      "C" Language Integrated Production System      */
+   /*                                                     */
+   /*            CLIPS Version 6.40  10/03/19             */
+   /*                                                     */
+   /*         INSTANCE LOAD/SAVE (ASCII/BINARY) MODULE    */
+   /*******************************************************/
+
+/*************************************************************/
+/* Purpose:  File load/save routines for instances           */
+/*                                                           */
+/* Principal Programmer(s):                                  */
+/*      Brian L. Dantes                                      */
+/*                                                           */
+/* Contributing Programmer(s):                               */
+/*                                                           */
+/* Revision History:                                         */
+/*                                                           */
+/*      6.24: Added environment parameter to GenClose.       */
+/*            Added environment parameter to GenOpen.        */
+/*                                                           */
+/*            Renamed BOOLEAN macro type to intBool.         */
+/*                                                           */
+/*            Corrected code to remove compiler warnings.    */
+/*                                                           */
+/*      6.30: Removed conditional code for unsupported       */
+/*            compilers/operating systems (IBM_MCW,          */
+/*            MAC_MCW, and IBM_TBC).                         */
+/*                                                           */
+/*            Changed integer type/precision.                */
+/*                                                           */
+/*            Added const qualifiers to remove C++           */
+/*            deprecation warnings.                          */
+/*                                                           */
+/*            Converted API macros to function calls.        */
+/*                                                           */
+/*            For save-instances, bsave-instances, and       */
+/*            bload-instances, the class name does not       */
+/*            have to be in scope if the module name is      */
+/*            specified.                                     */
+/*                                                           */
+/*      6.31: Prior error flags are cleared before           */
+/*            EnvLoadInstances, EnvRestoreInstances,         */
+/*            EnvLoadInstancesFromString, and                */
+/*            EnvRestoreInstancesFromString are processed.   */
+/*                                                           */
+/*            Added code to keep track of pointers to        */
+/*            constructs that are contained externally to    */
+/*            to constructs, DanglingConstructs.             */
+/*                                                           */
+/*            If embedded, LoadInstances and                 */
+/*            RestoreInstances clean the current garbage     */
+/*            frame.                                         */
+/*                                                           */
+/*            Fixed external address issue with binary       */
+/*            instance files.                                */
+/*                                                           */
+/*      6.40: Added Env prefix to GetEvaluationError and     */
+/*            SetEvaluationError functions.                  */
+/*                                                           */
+/*            Refactored code to reduce header dependencies  */
+/*            in sysdep.c.                                   */
+/*                                                           */
+/*            Pragma once and other inclusion changes.       */
+/*                                                           */
+/*            Added support for booleans with <stdbool.h>.   */
+/*                                                           */
+/*            Removed use of void pointers for specific      */
+/*            data structures.                               */
+/*                                                           */
+/*            ALLOW_ENVIRONMENT_GLOBALS no longer supported. */
+/*                                                           */
+/*            UDF redesign.                                  */
+/*                                                           */
+/*            Moved BufferedRead and FreeReadBuffer from     */
+/*            insfile.c to utility.c                         */
+/*                                                           */
+/*            SaveInstances and BinarySaveInstances now      */
+/*            return -1 instead of 0 if an error occurs.     */
+/*                                                           */
+/*************************************************************/
+
+/* =========================================
+   *****************************************
+               EXTERNAL DEFINITIONS
+   =========================================
+   ***************************************** */
+
+#include <stdlib.h>
+
+#include "setup.h"
+
+#if OBJECT_SYSTEM
+
+#include "argacces.h"
+#include "classcom.h"
+#include "classfun.h"
+#include "memalloc.h"
+#include "envrnmnt.h"
+#include "extnfunc.h"
+#if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT
+#include "factmngr.h"
+#endif
+#include "inscom.h"
+#include "insfun.h"
+#include "insmngr.h"
+#include "inspsr.h"
+#include "object.h"
+#include "prntutil.h"
+#include "router.h"
+#include "strngrtr.h"
+#include "symblbin.h"
+#include "sysdep.h"
+#include "utility.h"
+
+#include "insfile.h"
+
+/* =========================================
+   *****************************************
+                   CONSTANTS
+   =========================================
+   ***************************************** */
+
+/* =========================================
+   *****************************************
+               MACROS AND TYPES
+   =========================================
+   ***************************************** */
+struct bsaveSlotValue
+  {
+   unsigned long slotName;
+   unsigned long valueCount;
+  };
+
+struct bsaveSlotValueAtom
+  {
+   unsigned short type;
+   unsigned long value;
+  };
+
+struct classItem
+  {
+   Defclass *classPtr;
+   struct classItem *next;
+  };
+
+/***************************************/
+/* LOCAL INTERNAL FUNCTION DEFINITIONS */
+/***************************************/
+
+   static long                    InstancesSaveCommandParser(UDFContext *,
+                                                             long (*)(Environment *,const char *,
+                                                                      SaveScope,Expression *,bool));
+   static struct classItem       *ProcessSaveClassList(Environment *,const char *,Expression *,SaveScope,bool);
+   static void                    ReturnSaveClassList(Environment *,struct classItem *);
+   static long                    SaveOrMarkInstances(Environment *,FILE *,SaveScope,struct classItem *,bool,bool,
+                                                      void (*)(Environment *,FILE *,Instance *));
+   static long                    SaveOrMarkInstancesOfClass(Environment *,FILE *,Defmodule *,SaveScope,Defclass *,
+                                                             bool,int,void (*)(Environment *,FILE *,Instance *));
+   static void                    SaveSingleInstanceText(Environment *,FILE *,Instance *);
+   static void                    ProcessFileErrorMessage(Environment *,const char *,const char *);
+#if BSAVE_INSTANCES
+   static void                    WriteBinaryHeader(Environment *,FILE *);
+   static void                    MarkSingleInstance(Environment *,FILE *,Instance *);
+   static void                    MarkNeededAtom(Environment *,unsigned short,void *);
+   static void                    SaveSingleInstanceBinary(Environment *,FILE *,Instance *);
+   static void                    SaveAtomBinary(Environment *,unsigned short,void *,FILE *);
+#endif
+
+   static long                    LoadOrRestoreInstances(Environment *,const char *,bool,bool);
+
+#if BLOAD_INSTANCES
+   static bool                    VerifyBinaryHeader(Environment *,const char *);
+   static bool                    LoadSingleBinaryInstance(Environment *);
+   static void                    BinaryLoadInstanceError(Environment *,CLIPSLexeme *,Defclass *);
+   static void                    CreateSlotValue(Environment *,UDFValue *,struct bsaveSlotValueAtom *,unsigned long);
+   static void                   *GetBinaryAtomValue(Environment *,struct bsaveSlotValueAtom *);
+#endif
+
+/* =========================================
+   *****************************************
+          EXTERNALLY VISIBLE FUNCTIONS
+   =========================================
+   ***************************************** */
+
+/***************************************************
+  NAME         : SetupInstanceFileCommands
+  DESCRIPTION  : Defines function interfaces for
+                 saving instances to files
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Functions defined to KB
+  NOTES        : None
+ ***************************************************/
+void SetupInstanceFileCommands(
+  Environment *theEnv)
+  {
+#if BLOAD_INSTANCES || BSAVE_INSTANCES
+   AllocateEnvironmentData(theEnv,INSTANCE_FILE_DATA,sizeof(struct instanceFileData),NULL);
+
+   InstanceFileData(theEnv)->InstanceBinaryPrefixID = "\5\6\7CLIPS";
+   InstanceFileData(theEnv)->InstanceBinaryVersionID = "V6.00";
+#endif
+
+#if (! RUN_TIME)
+   AddUDF(theEnv,"save-instances","l",1,UNBOUNDED,"y;sy",SaveInstancesCommand,"SaveInstancesCommand",NULL);
+   AddUDF(theEnv,"load-instances","l",1,1,"sy",LoadInstancesCommand,"LoadInstancesCommand",NULL);
+   AddUDF(theEnv,"restore-instances","l",1,1,"sy",RestoreInstancesCommand,"RestoreInstancesCommand",NULL);
+
+#if BSAVE_INSTANCES
+   AddUDF(theEnv,"bsave-instances","l",1,UNBOUNDED,"y;sy",BinarySaveInstancesCommand,"BinarySaveInstancesCommand",NULL);
+#endif
+#if BLOAD_INSTANCES
+   AddUDF(theEnv,"bload-instances","l",1,1,"sy",BinaryLoadInstancesCommand,"BinaryLoadInstancesCommand",NULL);
+#endif
+
+#endif
+  }
+
+
+/****************************************************************************
+  NAME         : SaveInstancesCommand
+  DESCRIPTION  : H/L interface for saving
+                   current instances to a file
+  INPUTS       : None
+  RETURNS      : The number of instances saved
+  SIDE EFFECTS : Instances saved to named file
+  NOTES        : H/L Syntax :
+                 (save-instances <file> [local|visible [[inherit] <class>+]])
+ ****************************************************************************/
+void SaveInstancesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   returnValue->integerValue = CreateInteger(theEnv,InstancesSaveCommandParser(context,SaveInstancesDriver));
+  }
+
+/******************************************************
+  NAME         : LoadInstancesCommand
+  DESCRIPTION  : H/L interface for loading
+                   instances from a file
+  INPUTS       : None
+  RETURNS      : The number of instances loaded
+  SIDE EFFECTS : Instances loaded from named file
+  NOTES        : H/L Syntax : (load-instances <file>)
+ ******************************************************/
+void LoadInstancesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   const char *fileFound;
+   UDFValue theArg;
+   long instanceCount;
+
+   if (! UDFFirstArgument(context,LEXEME_BITS,&theArg))
+     { return; }
+
+   fileFound = theArg.lexemeValue->contents;
+
+   instanceCount = LoadInstances(theEnv,fileFound);
+   if (EvaluationData(theEnv)->EvaluationError)
+     { ProcessFileErrorMessage(theEnv,"load-instances",fileFound); }
+
+   returnValue->integerValue = CreateInteger(theEnv,instanceCount);
+  }
+
+/***************************************************
+  NAME         : LoadInstances
+  DESCRIPTION  : Loads instances from named file
+  INPUTS       : The name of the input file
+  RETURNS      : The number of instances loaded
+  SIDE EFFECTS : Instances loaded from file
+  NOTES        : None
+ ***************************************************/
+long LoadInstances(
+  Environment *theEnv,
+  const char *file)
+  {
+   return(LoadOrRestoreInstances(theEnv,file,true,true));
+  }
+
+/***************************************************
+  NAME         : LoadInstancesFromString
+  DESCRIPTION  : Loads instances from given string
+  INPUTS       : 1) The input string
+                 2) Index of char in string after
+                    last valid char (-1 for all chars)
+  RETURNS      : The number of instances loaded
+  SIDE EFFECTS : Instances loaded from string
+  NOTES        : Uses string routers
+ ***************************************************/
+long LoadInstancesFromString(
+  Environment *theEnv,
+  const char *theString,
+  size_t theMax)
+  {
+   long theCount;
+   const char * theStrRouter = "*** load-instances-from-string ***";
+
+   if ((theMax == SIZE_MAX) ? (! OpenStringSource(theEnv,theStrRouter,theString,0)) :
+                              (! OpenTextSource(theEnv,theStrRouter,theString,0,theMax)))
+     { return -1; }
+
+   theCount = LoadOrRestoreInstances(theEnv,theStrRouter,true,false);
+
+   CloseStringSource(theEnv,theStrRouter);
+
+   return theCount;
+  }
+
+/*********************************************************
+  NAME         : RestoreInstancesCommand
+  DESCRIPTION  : H/L interface for loading
+                   instances from a file w/o messages
+  INPUTS       : None
+  RETURNS      : The number of instances restored
+  SIDE EFFECTS : Instances loaded from named file
+  NOTES        : H/L Syntax : (restore-instances <file>)
+ *********************************************************/
+void RestoreInstancesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   const char *fileFound;
+   UDFValue theArg;
+   long instanceCount;
+
+   if (! UDFFirstArgument(context,LEXEME_BITS,&theArg))
+     { return; }
+
+   fileFound = theArg.lexemeValue->contents;
+
+   instanceCount = RestoreInstances(theEnv,fileFound);
+   if (EvaluationData(theEnv)->EvaluationError)
+     { ProcessFileErrorMessage(theEnv,"restore-instances",fileFound); }
+
+   returnValue->integerValue = CreateInteger(theEnv,instanceCount);
+  }
+
+/***************************************************
+  NAME         : RestoreInstances
+  DESCRIPTION  : Restores instances from named file
+  INPUTS       : The name of the input file
+  RETURNS      : The number of instances restored
+  SIDE EFFECTS : Instances restored from file
+  NOTES        : None
+ ***************************************************/
+long RestoreInstances(
+  Environment *theEnv,
+  const char *file)
+  {
+   return(LoadOrRestoreInstances(theEnv,file,false,true));
+  }
+
+/***************************************************
+  NAME         : RestoreInstancesFromString
+  DESCRIPTION  : Restores instances from given string
+  INPUTS       : 1) The input string
+                 2) Index of char in string after
+                    last valid char (-1 for all chars)
+  RETURNS      : The number of instances loaded
+  SIDE EFFECTS : Instances loaded from string
+  NOTES        : Uses string routers
+ ***************************************************/
+long RestoreInstancesFromString(
+  Environment *theEnv,
+  const char *theString,
+  size_t theMax)
+  {
+   long theCount;
+   const char *theStrRouter = "*** load-instances-from-string ***";
+
+   if ((theMax == SIZE_MAX) ? (! OpenStringSource(theEnv,theStrRouter,theString,0)) :
+                              (! OpenTextSource(theEnv,theStrRouter,theString,0,theMax)))
+     { return(-1); }
+
+   theCount = LoadOrRestoreInstances(theEnv,theStrRouter,false,false);
+
+   CloseStringSource(theEnv,theStrRouter);
+
+   return(theCount);
+  }
+
+#if BLOAD_INSTANCES
+
+/*******************************************************
+  NAME         : BinaryLoadInstancesCommand
+  DESCRIPTION  : H/L interface for loading
+                   instances from a binary file
+  INPUTS       : None
+  RETURNS      : The number of instances loaded
+  SIDE EFFECTS : Instances loaded from named binary file
+  NOTES        : H/L Syntax : (bload-instances <file>)
+ *******************************************************/
+void BinaryLoadInstancesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   const char *fileFound;
+   UDFValue theArg;
+   long instanceCount;
+
+   if (! UDFFirstArgument(context,LEXEME_BITS,&theArg))
+     { return; }
+
+   fileFound = theArg.lexemeValue->contents;
+
+   instanceCount = BinaryLoadInstances(theEnv,fileFound);
+   if (EvaluationData(theEnv)->EvaluationError)
+     { ProcessFileErrorMessage(theEnv,"bload-instances",fileFound); }
+   returnValue->integerValue = CreateInteger(theEnv,instanceCount);
+  }
+
+/****************************************************
+  NAME         : BinaryLoadInstances
+  DESCRIPTION  : Loads instances quickly from a
+                 binary file
+  INPUTS       : The file name
+  RETURNS      : The number of instances loaded
+  SIDE EFFECTS : Instances loaded w/o message-passing
+  NOTES        : None
+ ****************************************************/
+long BinaryLoadInstances(
+  Environment *theEnv,
+  const char *theFile)
+  {
+   long i,instanceCount;
+   GCBlock gcb;
+   
+   /*=====================================*/
+   /* If embedded, clear the error flags. */
+   /*=====================================*/
+   
+   if (EvaluationData(theEnv)->CurrentExpression == NULL)
+     { ResetErrorFlags(theEnv); }
+
+   if (GenOpenReadBinary(theEnv,"bload-instances",theFile) == false)
+     {
+      OpenErrorMessage(theEnv,"bload-instances",theFile);
+      SetEvaluationError(theEnv,true);
+      return -1L;
+     }
+   if (VerifyBinaryHeader(theEnv,theFile) == false)
+     {
+      GenCloseBinary(theEnv);
+      SetEvaluationError(theEnv,true);
+      return -1L;
+     }
+
+   GCBlockStart(theEnv,&gcb);
+   ReadNeededAtomicValues(theEnv);
+
+   UtilityData(theEnv)->BinaryFileOffset = 0L;
+
+   GenReadBinary(theEnv,&UtilityData(theEnv)->BinaryFileSize,sizeof(size_t));
+   GenReadBinary(theEnv,&instanceCount,sizeof(long));
+
+   for (i = 0L ; i < instanceCount ; i++)
+     {
+      if (LoadSingleBinaryInstance(theEnv) == false)
+        {
+         FreeReadBuffer(theEnv);
+         FreeAtomicValueStorage(theEnv);
+         GenCloseBinary(theEnv);
+         SetEvaluationError(theEnv,true);
+         GCBlockEnd(theEnv,&gcb);
+         return i;
+        }
+     }
+
+   FreeReadBuffer(theEnv);
+   FreeAtomicValueStorage(theEnv);
+   GenCloseBinary(theEnv);
+
+   GCBlockEnd(theEnv,&gcb);
+   return instanceCount;
+  }
+
+#endif
+
+/*******************************************************
+  NAME         : SaveInstances
+  DESCRIPTION  : Saves current instances to named file
+  INPUTS       : 1) The name of the output file
+                 2) A flag indicating whether to
+                    save local (current module only)
+                    or visible instances
+                    LOCAL_SAVE or VISIBLE_SAVE
+                 3) A list of expressions containing
+                    the names of classes for which
+                    instances are to be saved
+                 4) A flag indicating if the subclasses
+                    of specified classes shoudl also
+                    be processed
+  RETURNS      : The number of instances saved
+  SIDE EFFECTS : Instances saved to file
+  NOTES        : None
+ *******************************************************/
+long SaveInstances(
+  Environment *theEnv,
+  const char *file,
+  SaveScope saveCode)
+  {
+   return SaveInstancesDriver(theEnv,file,saveCode,NULL,true);
+  }
+
+/*******************************************************
+  NAME         : SaveInstancesDriver
+  DESCRIPTION  : Saves current instances to named file
+  INPUTS       : 1) The name of the output file
+                 2) A flag indicating whether to
+                    save local (current module only)
+                    or visible instances
+                    LOCAL_SAVE or VISIBLE_SAVE
+                 3) A list of expressions containing
+                    the names of classes for which
+                    instances are to be saved
+                 4) A flag indicating if the subclasses
+                    of specified classes shoudl also
+                    be processed
+  RETURNS      : The number of instances saved
+  SIDE EFFECTS : Instances saved to file
+  NOTES        : None
+ *******************************************************/
+long SaveInstancesDriver(
+  Environment *theEnv,
+  const char *file,
+  SaveScope saveCode,
+  Expression *classExpressionList,
+  bool inheritFlag)
+  {
+   FILE *sfile = NULL;
+   bool oldPEC, oldATS, oldIAN;
+   struct classItem *classList;
+   long instanceCount;
+   
+   /*=====================================*/
+   /* If embedded, clear the error flags. */
+   /*=====================================*/
+
+   if (EvaluationData(theEnv)->CurrentExpression == NULL)
+     { ResetErrorFlags(theEnv); }
+
+   classList = ProcessSaveClassList(theEnv,"save-instances",classExpressionList,
+                                    saveCode,inheritFlag);
+   if ((classList == NULL) && (classExpressionList != NULL))
+     return -1L;
+
+   SaveOrMarkInstances(theEnv,sfile,saveCode,classList,
+                             inheritFlag,true,NULL);
+
+   if ((sfile = GenOpen(theEnv,file,"w")) == NULL)
+     {
+      OpenErrorMessage(theEnv,"save-instances",file);
+      ReturnSaveClassList(theEnv,classList);
+      SetEvaluationError(theEnv,true);
+      return -1L;
+     }
+
+   oldPEC = PrintUtilityData(theEnv)->PreserveEscapedCharacters;
+   PrintUtilityData(theEnv)->PreserveEscapedCharacters = true;
+   oldATS = PrintUtilityData(theEnv)->AddressesToStrings;
+   PrintUtilityData(theEnv)->AddressesToStrings = true;
+   oldIAN = PrintUtilityData(theEnv)->InstanceAddressesToNames;
+   PrintUtilityData(theEnv)->InstanceAddressesToNames = true;
+
+   SetFastSave(theEnv,sfile);
+   instanceCount = SaveOrMarkInstances(theEnv,sfile,saveCode,classList,
+                                       inheritFlag,true,SaveSingleInstanceText);
+   GenClose(theEnv,sfile);
+   SetFastSave(theEnv,NULL);
+
+   PrintUtilityData(theEnv)->PreserveEscapedCharacters = oldPEC;
+   PrintUtilityData(theEnv)->AddressesToStrings = oldATS;
+   PrintUtilityData(theEnv)->InstanceAddressesToNames = oldIAN;
+   ReturnSaveClassList(theEnv,classList);
+   return(instanceCount);
+  }
+
+#if BSAVE_INSTANCES
+
+/****************************************************************************
+  NAME         : BinarySaveInstancesCommand
+  DESCRIPTION  : H/L interface for saving
+                   current instances to a binary file
+  INPUTS       : None
+  RETURNS      : The number of instances saved
+  SIDE EFFECTS : Instances saved (in binary format) to named file
+  NOTES        : H/L Syntax :
+                 (bsave-instances <file> [local|visible [[inherit] <class>+]])
+ *****************************************************************************/
+void BinarySaveInstancesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   returnValue->integerValue = CreateInteger(theEnv,InstancesSaveCommandParser(context,BinarySaveInstancesDriver));
+  }
+
+/*******************************************************
+  NAME         : BinarySaveInstances
+  DESCRIPTION  : Saves current instances to binary file
+  INPUTS       : 1) The name of the output file
+                 2) A flag indicating whether to
+                    save local (current module only)
+                    or visible instances
+                    LOCAL_SAVE or VISIBLE_SAVE
+  RETURNS      : The number of instances saved
+  SIDE EFFECTS : Instances saved to file
+  NOTES        : None
+ *******************************************************/
+long BinarySaveInstances(
+  Environment *theEnv,
+  const char *file,
+  SaveScope saveCode)
+  {
+   return BinarySaveInstancesDriver(theEnv,file,saveCode,NULL,true);
+  }
+
+/*******************************************************
+  NAME         : BinarySaveInstancesDriver
+  DESCRIPTION  : Saves current instances to binary file
+  INPUTS       : 1) The name of the output file
+                 2) A flag indicating whether to
+                    save local (current module only)
+                    or visible instances
+                    LOCAL_SAVE or VISIBLE_SAVE
+                 3) A list of expressions containing
+                    the names of classes for which
+                    instances are to be saved
+                 4) A flag indicating if the subclasses
+                    of specified classes shoudl also
+                    be processed
+  RETURNS      : The number of instances saved
+  SIDE EFFECTS : Instances saved to file
+  NOTES        : None
+ *******************************************************/
+long BinarySaveInstancesDriver(
+  Environment *theEnv,
+  const char *file,
+  SaveScope saveCode,
+  Expression *classExpressionList,
+  bool inheritFlag)
+  {
+   struct classItem *classList;
+   FILE *bsaveFP;
+   long instanceCount;
+   
+   /*=====================================*/
+   /* If embedded, clear the error flags. */
+   /*=====================================*/
+
+   if (EvaluationData(theEnv)->CurrentExpression == NULL)
+     { ResetErrorFlags(theEnv); }
+
+   classList = ProcessSaveClassList(theEnv,"bsave-instances",classExpressionList,
+                                    saveCode,inheritFlag);
+   if ((classList == NULL) && (classExpressionList != NULL))
+     return -1L;
+
+   UtilityData(theEnv)->BinaryFileSize = 0L;
+   InitAtomicValueNeededFlags(theEnv);
+   instanceCount = SaveOrMarkInstances(theEnv,NULL,saveCode,classList,inheritFlag,
+                                       false,MarkSingleInstance);
+
+   if ((bsaveFP = GenOpen(theEnv,file,"wb")) == NULL)
+     {
+      OpenErrorMessage(theEnv,"bsave-instances",file);
+      ReturnSaveClassList(theEnv,classList);
+      SetEvaluationError(theEnv,true);
+      return -1L;
+     }
+   WriteBinaryHeader(theEnv,bsaveFP);
+   WriteNeededAtomicValues(theEnv,bsaveFP);
+
+   fwrite(&UtilityData(theEnv)->BinaryFileSize,sizeof(size_t),1,bsaveFP);
+   fwrite(&instanceCount,sizeof(long),1,bsaveFP);
+
+   SetAtomicValueIndices(theEnv,false);
+   SaveOrMarkInstances(theEnv,bsaveFP,saveCode,classList,
+                       inheritFlag,false,SaveSingleInstanceBinary);
+   RestoreAtomicValueBuckets(theEnv);
+   GenClose(theEnv,bsaveFP);
+   ReturnSaveClassList(theEnv,classList);
+   return(instanceCount);
+  }
+
+#endif
+
+/* =========================================
+   *****************************************
+          INTERNALLY VISIBLE FUNCTIONS
+   =========================================
+   ***************************************** */
+
+/******************************************************
+  NAME         : InstancesSaveCommandParser
+  DESCRIPTION  : Argument parser for save-instances
+                 and bsave-instances
+  INPUTS       : 1) The name of the calling function
+                 2) A pointer to the support
+                    function to call for the save/bsave
+  RETURNS      : The number of instances saved
+  SIDE EFFECTS : Instances saved/bsaved
+  NOTES        : None
+ ******************************************************/
+static long InstancesSaveCommandParser(
+  UDFContext *context,
+  long (*saveFunction)(Environment *,const char *,SaveScope,Expression *,bool))
+  {
+   const char *fileFound;
+   UDFValue temp;
+   unsigned int argCount;
+   SaveScope saveCode = LOCAL_SAVE;
+   Expression *classList = NULL;
+   bool inheritFlag = false;
+   Environment *theEnv = context->environment;
+
+   if (! UDFFirstArgument(context,LEXEME_BITS,&temp))
+     { return 0L; }
+   fileFound = temp.lexemeValue->contents;
+
+   argCount = UDFArgumentCount(context);
+   if (argCount > 1)
+     {
+      if (! UDFNextArgument(context,SYMBOL_BIT,&temp))
+        { return 0L; }
+
+      if (strcmp(temp.lexemeValue->contents,"local") == 0)
+        saveCode = LOCAL_SAVE;
+      else if (strcmp(temp.lexemeValue->contents,"visible") == 0)
+        saveCode = VISIBLE_SAVE;
+      else
+        {
+         UDFInvalidArgumentMessage(context,"symbol \"local\" or \"visible\"");
+         SetEvaluationError(theEnv,true);
+         return(0L);
+        }
+      classList = GetFirstArgument()->nextArg->nextArg;
+
+      /* ===========================
+         Check for "inherit" keyword
+         Must be at least one class
+         name following
+         =========================== */
+      if ((classList != NULL) ? (classList->nextArg != NULL) : false)
+        {
+         if ((classList->type != SYMBOL_TYPE) ? false :
+             (strcmp(classList->lexemeValue->contents,"inherit") == 0))
+           {
+            inheritFlag = true;
+            classList = classList->nextArg;
+           }
+        }
+     }
+
+   return((*saveFunction)(theEnv,fileFound,saveCode,classList,inheritFlag));
+  }
+
+/****************************************************
+  NAME         : ProcessSaveClassList
+  DESCRIPTION  : Evaluates a list of class name
+                 expressions and stores them in a
+                 data object list
+  INPUTS       : 1) The name of the calling function
+                 2) The class expression list
+                 3) A flag indicating if only local
+                    or all visible instances are
+                    being saved
+                 4) A flag indicating if inheritance
+                    relationships should be checked
+                    between classes
+  RETURNS      : The evaluated class pointer data
+                 objects - NULL on errors
+  SIDE EFFECTS : Data objects allocated and
+                 classes validated
+  NOTES        : None
+ ****************************************************/
+static struct classItem *ProcessSaveClassList(
+  Environment *theEnv,
+  const char *functionName,
+  Expression *classExps,
+  SaveScope saveCode,
+  bool inheritFlag)
+  {
+   struct classItem *head = NULL, *prv, *newItem;
+   UDFValue tmp;
+   Defclass *theDefclass;
+   Defmodule *currentModule;
+   unsigned int argIndex = inheritFlag ? 4 : 3;
+
+   currentModule = GetCurrentModule(theEnv);
+   while (classExps != NULL)
+     {
+      if (EvaluateExpression(theEnv,classExps,&tmp))
+        goto ProcessClassListError;
+
+      if (tmp.header->type != SYMBOL_TYPE)
+        goto ProcessClassListError;
+        
+      if (saveCode == LOCAL_SAVE)
+        { theDefclass = LookupDefclassAnywhere(theEnv,currentModule,tmp.lexemeValue->contents); }
+      else
+        { theDefclass = LookupDefclassByMdlOrScope(theEnv,tmp.lexemeValue->contents); }
+
+      if (theDefclass == NULL)
+        goto ProcessClassListError;
+      else if (theDefclass->abstract && (inheritFlag == false))
+        goto ProcessClassListError;
+        
+      prv = newItem = head;
+      while (newItem != NULL)
+        {
+         if (newItem->classPtr == theDefclass)
+           goto ProcessClassListError;
+         else if (inheritFlag)
+           {
+            if (HasSuperclass(newItem->classPtr,theDefclass) ||
+                HasSuperclass(theDefclass,newItem->classPtr))
+             goto ProcessClassListError;
+           }
+         prv = newItem;
+         newItem = newItem->next;
+        }
+        
+      newItem = get_struct(theEnv,classItem);
+      newItem->classPtr = theDefclass;
+      newItem->next = NULL;
+      
+      if (prv == NULL)
+        head = newItem;
+      else
+        prv->next = newItem;
+        
+      argIndex++;
+      classExps = classExps->nextArg;
+     }
+   return head;
+
+ProcessClassListError:
+   if (inheritFlag)
+     ExpectedTypeError1(theEnv,functionName,argIndex,"'valid class name'");
+   else
+     ExpectedTypeError1(theEnv,functionName,argIndex,"'valid concrete class name'");
+   
+   ReturnSaveClassList(theEnv,head);
+   
+   SetEvaluationError(theEnv,true);
+   return NULL;
+  }
+
+/****************************************************
+  NAME         : ReturnSaveClassList
+  DESCRIPTION  : Deallocates the class data object
+                 list created by ProcessSaveClassList
+  INPUTS       : The class data object list
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Class data object returned
+  NOTES        : None
+ ****************************************************/
+static void ReturnSaveClassList(
+  Environment *theEnv,
+  struct classItem *classList)
+  {
+   struct classItem *tmp;
+
+   while (classList != NULL)
+     {
+      tmp = classList;
+      classList = classList->next;
+      rtn_struct(theEnv,classItem,tmp);
+     }
+  }
+
+/***************************************************
+  NAME         : SaveOrMarkInstances
+  DESCRIPTION  : Iterates through all specified
+                 instances either marking needed
+                 atoms or writing instances in
+                 binary/text format
+  INPUTS       : 1) NULL (for marking) or
+                    file pointer (for text/binary saves)
+                 2) A cope flag indicating LOCAL
+                    or VISIBLE saves only
+                 3) A list of data objects
+                    containing the names of classes
+                    of instances to be saved
+                 4) A flag indicating whether to
+                    include subclasses of arg #3
+                 5) A flag indicating if the
+                    iteration can be interrupted
+                    or not
+                 6) The access function to mark
+                    or save an instance (can be NULL
+                    if only counting instances)
+  RETURNS      : The number of instances saved
+  SIDE EFFECTS : Instances amrked or saved
+  NOTES        : None
+ ***************************************************/
+static long SaveOrMarkInstances(
+  Environment *theEnv,
+  FILE *theOutput,
+  SaveScope saveCode,
+  struct classItem *classList,
+  bool inheritFlag,
+  bool interruptOK,
+  void (*saveInstanceFunc)(Environment *,FILE *,Instance *))
+  {
+   Defmodule *currentModule;
+   int traversalID;
+   struct classItem *tmp;
+   Instance *ins;
+   long instanceCount = 0L;
+
+   currentModule = GetCurrentModule(theEnv);
+   if (classList != NULL)
+     {
+      traversalID = GetTraversalID(theEnv);
+      if (traversalID != -1)
+        {
+         for (tmp = classList ;
+              (! ((tmp == NULL) || (EvaluationData(theEnv)->HaltExecution && interruptOK))) ;
+              tmp = tmp->next)
+           instanceCount += SaveOrMarkInstancesOfClass(theEnv,theOutput,currentModule,saveCode,
+                                                       tmp->classPtr,inheritFlag,
+                                                       traversalID,saveInstanceFunc);
+         ReleaseTraversalID(theEnv);
+        }
+     }
+   else
+     {
+      for (ins = GetNextInstanceInScope(theEnv,NULL) ;
+           (ins != NULL) && (EvaluationData(theEnv)->HaltExecution != true) ;
+           ins = GetNextInstanceInScope(theEnv,ins))
+        {
+         if ((saveCode == VISIBLE_SAVE) ? true :
+             (ins->cls->header.whichModule->theModule == currentModule))
+           {
+            if (saveInstanceFunc != NULL)
+              (*saveInstanceFunc)(theEnv,theOutput,ins);
+            instanceCount++;
+           }
+        }
+     }
+   return(instanceCount);
+  }
+
+/***************************************************
+  NAME         : SaveOrMarkInstancesOfClass
+  DESCRIPTION  : Saves off the direct (and indirect)
+                 instance of the specified class
+  INPUTS       : 1) The logical name of the output
+                    (or file pointer for binary
+                     output)
+                 2) The current module
+                 3) A flag indicating local
+                    or visible saves
+                 4) The defclass
+                 5) A flag indicating whether to
+                    save subclass instances or not
+                 6) A traversal id for marking
+                    visited classes
+                 7) A pointer to the instance
+                    manipulation function to call
+                    (can be NULL for only counting
+                     instances)
+  RETURNS      : The number of instances saved
+  SIDE EFFECTS : Appropriate instances saved
+  NOTES        : None
+ ***************************************************/
+static long SaveOrMarkInstancesOfClass(
+  Environment *theEnv,
+  FILE *theOutput,
+  Defmodule *currentModule,
+  SaveScope saveCode,
+  Defclass *theDefclass,
+  bool inheritFlag,
+  int traversalID,
+  void (*saveInstanceFunc)(Environment *,FILE *,Instance *))
+  {
+   Instance *theInstance;
+   Defclass *subclass;
+   unsigned long i;
+   long instanceCount = 0L;
+
+   if (TestTraversalID(theDefclass->traversalRecord,traversalID))
+     return(instanceCount);
+   SetTraversalID(theDefclass->traversalRecord,traversalID);
+   if (((saveCode == LOCAL_SAVE) &&
+        (theDefclass->header.whichModule->theModule == currentModule)) ||
+       ((saveCode == VISIBLE_SAVE) &&
+        DefclassInScope(theEnv,theDefclass,currentModule)))
+     {
+      for (theInstance = GetNextInstanceInClass(theDefclass,NULL);
+           theInstance != NULL;
+           theInstance = GetNextInstanceInClass(theDefclass,theInstance))
+        {
+         if (saveInstanceFunc != NULL)
+           (*saveInstanceFunc)(theEnv,theOutput,theInstance);
+         instanceCount++;
+        }
+     }
+   if (inheritFlag)
+     {
+      for (i = 0 ; i < theDefclass->directSubclasses.classCount ; i++)
+        {
+         subclass = theDefclass->directSubclasses.classArray[i];
+           instanceCount += SaveOrMarkInstancesOfClass(theEnv,theOutput,currentModule,saveCode,
+                                                       subclass,true,traversalID,
+                                                       saveInstanceFunc);
+        }
+     }
+   return(instanceCount);
+  }
+
+/***************************************************
+  NAME         : SaveSingleInstanceText
+  DESCRIPTION  : Writes given instance to file
+  INPUTS       : 1) The logical name of the output
+                 2) The instance to save
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Instance written
+  NOTES        : None
+ ***************************************************/
+static void SaveSingleInstanceText(
+  Environment *theEnv,
+  FILE *fastSaveFile,
+  Instance *theInstance)
+  {
+   long i;
+   InstanceSlot *sp;
+   const char *logicalName = (const char *) fastSaveFile;
+
+   WriteString(theEnv,logicalName,"([");
+   WriteString(theEnv,logicalName,theInstance->name->contents);
+   WriteString(theEnv,logicalName,"] of ");
+   WriteString(theEnv,logicalName,theInstance->cls->header.name->contents);
+   for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
+     {
+      sp = theInstance->slotAddresses[i];
+      WriteString(theEnv,logicalName,"\n   (");
+      WriteString(theEnv,logicalName,sp->desc->slotName->name->contents);
+      if (sp->type != MULTIFIELD_TYPE)
+        {
+         WriteString(theEnv,logicalName," ");
+         PrintAtom(theEnv,logicalName,sp->type,sp->value);
+        }
+      else if (sp->multifieldValue->length != 0)
+        {
+         WriteString(theEnv,logicalName," ");
+         PrintMultifieldDriver(theEnv,logicalName,sp->multifieldValue,0,
+                               sp->multifieldValue->length,false);
+        }
+      WriteString(theEnv,logicalName,")");
+     }
+   WriteString(theEnv,logicalName,")\n\n");
+  }
+
+#if BSAVE_INSTANCES
+
+/***************************************************
+  NAME         : WriteBinaryHeader
+  DESCRIPTION  : Writes identifying string to
+                 instance binary file to assist in
+                 later verification
+  INPUTS       : The binary file pointer
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Binary prefix headers written
+  NOTES        : None
+ ***************************************************/
+static void WriteBinaryHeader(
+  Environment *theEnv,
+  FILE *bsaveFP)
+  {
+   fwrite(InstanceFileData(theEnv)->InstanceBinaryPrefixID,
+          (STD_SIZE) (strlen(InstanceFileData(theEnv)->InstanceBinaryPrefixID) + 1),1,bsaveFP);
+   fwrite(InstanceFileData(theEnv)->InstanceBinaryVersionID,
+          (STD_SIZE) (strlen(InstanceFileData(theEnv)->InstanceBinaryVersionID) + 1),1,bsaveFP);
+  }
+
+/***************************************************
+  NAME         : MarkSingleInstance
+  DESCRIPTION  : Marks all the atoms needed in
+                 the slot values of an instance
+  INPUTS       : 1) The output (ignored)
+                 2) The instance
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Instance slot value atoms marked
+  NOTES        : None
+ ***************************************************/
+static void MarkSingleInstance(
+  Environment *theEnv,
+  FILE *theOutput,
+  Instance *theInstance)
+  {
+#if MAC_XCD
+#pragma unused(theOutput)
+#endif
+   InstanceSlot *sp;
+   unsigned int i;
+   size_t j;
+
+   UtilityData(theEnv)->BinaryFileSize += (sizeof(unsigned long) * 2);
+   theInstance->name->neededSymbol = true;
+   theInstance->cls->header.name->neededSymbol = true;
+   
+   UtilityData(theEnv)->BinaryFileSize +=
+                       (sizeof(unsigned short) +
+                        (sizeof(struct bsaveSlotValue) *
+                         theInstance->cls->instanceSlotCount) +
+                        sizeof(unsigned long));
+
+   for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
+     {
+      sp = theInstance->slotAddresses[i];
+      sp->desc->slotName->name->neededSymbol = true;
+      if (sp->desc->multiple)
+        {
+         for (j = 0 ; j < sp->multifieldValue->length ; j++)
+           MarkNeededAtom(theEnv,sp->multifieldValue->contents[j].header->type,
+                                 sp->multifieldValue->contents[j].value);
+        }
+      else
+        MarkNeededAtom(theEnv,sp->type,sp->value);
+     }
+  }
+
+/***************************************************
+  NAME         : MarkNeededAtom
+  DESCRIPTION  : Marks an integer/float/symbol as
+                 being need by a set of instances
+  INPUTS       : 1) The type of atom
+                 2) The value of the atom
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Atom marked for saving
+  NOTES        : None
+ ***************************************************/
+static void MarkNeededAtom(
+  Environment *theEnv,
+  unsigned short type,
+  void *value)
+  {
+   UtilityData(theEnv)->BinaryFileSize += sizeof(struct bsaveSlotValueAtom);
+
+   /* =====================================
+      Assumes slot value atoms  can only be
+      floats, integers, symbols, strings,
+      instance-names, instance-addresses,
+      fact-addresses or external-addresses
+      ===================================== */
+   switch (type)
+     {
+      case SYMBOL_TYPE:
+      case STRING_TYPE:
+      case INSTANCE_NAME_TYPE:
+         ((CLIPSLexeme *) value)->neededSymbol = true;
+         break;
+      case FLOAT_TYPE:
+         ((CLIPSFloat *) value)->neededFloat = true;
+         break;
+      case INTEGER_TYPE:
+         ((CLIPSInteger *) value)->neededInteger = true;
+         break;
+      case INSTANCE_ADDRESS_TYPE:
+         GetFullInstanceName(theEnv,(Instance *) value)->neededSymbol = true;
+         break;
+     }
+  }
+
+/****************************************************
+  NAME         : SaveSingleInstanceBinary
+  DESCRIPTION  : Writes given instance to binary file
+  INPUTS       : 1) Binary file pointer
+                 2) The instance to save
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Instance written
+  NOTES        : None
+ ****************************************************/
+static void SaveSingleInstanceBinary(
+  Environment *theEnv,
+  FILE *bsaveFP,
+  Instance *theInstance)
+  {
+   unsigned long nameIndex;
+   unsigned long i;
+   size_t j;
+   InstanceSlot *sp;
+   struct bsaveSlotValue bs;
+   unsigned long totalValueCount = 0;
+   size_t slotLen;
+
+   /*==============================*/
+   /* Write out the instance name. */
+   /*==============================*/
+   
+   nameIndex = theInstance->name->bucket;
+   fwrite(&nameIndex,sizeof(unsigned long),1,bsaveFP);
+
+   /*===========================*/
+   /* Write out the class name. */
+   /*===========================*/
+   
+   nameIndex = theInstance->cls->header.name->bucket;
+   fwrite(&nameIndex,sizeof(unsigned long),1,bsaveFP);
+
+   /*=========================================*/
+   /* Write out the number of slot-overrides. */
+   /*=========================================*/
+   
+   fwrite(&theInstance->cls->instanceSlotCount,
+          sizeof(unsigned short),1,bsaveFP);
+
+   /*============================================*/
+   /* Write out the slot names and value counts. */
+   /*============================================*/
+   
+   for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
+     {
+      sp = theInstance->slotAddresses[i];
+
+      /* ===============================================
+         Write out the number of atoms in the slot value
+         =============================================== */
+      bs.slotName = sp->desc->slotName->name->bucket;
+      bs.valueCount = (unsigned long) (sp->desc->multiple ? sp->multifieldValue->length : 1);
+      fwrite(&bs,sizeof(struct bsaveSlotValue),1,bsaveFP);
+      totalValueCount += bs.valueCount;
+     }
+
+   /* ==================================
+      Write out the number of slot value
+      atoms for the whole instance
+      ================================== */
+   if (theInstance->cls->instanceSlotCount != 0) // (totalValueCount != 0L) : Bug fix if any slots, write out count
+     fwrite(&totalValueCount,sizeof(unsigned long),1,bsaveFP);
+
+   /* ==============================
+      Write out the slot value atoms
+      ============================== */
+   for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++)
+     {
+      sp = theInstance->slotAddresses[i];
+      slotLen = sp->desc->multiple ? sp->multifieldValue->length : 1;
+
+      /* =========================================
+         Write out the type and index of each atom
+         ========================================= */
+      if (sp->desc->multiple)
+        {
+         for (j = 0 ; j < slotLen ; j++)
+           SaveAtomBinary(theEnv,sp->multifieldValue->contents[j].header->type,
+                                 sp->multifieldValue->contents[j].value,bsaveFP);
+        }
+      else
+        SaveAtomBinary(theEnv,sp->type,sp->value,bsaveFP);
+     }
+  }
+
+/***************************************************
+  NAME         : SaveAtomBinary
+  DESCRIPTION  : Writes out an instance slot value
+                 atom to the binary file
+  INPUTS       : 1) The atom type
+                 2) The atom value
+                 3) The binary file pointer
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : atom written
+  NOTES        :
+ ***************************************************/
+static void SaveAtomBinary(
+  Environment *theEnv,
+  unsigned short type,
+  void *value,
+  FILE *bsaveFP)
+  {
+   struct bsaveSlotValueAtom bsa;
+
+   /* =====================================
+      Assumes slot value atoms  can only be
+      floats, integers, symbols, strings,
+      instance-names, instance-addresses,
+      fact-addresses or external-addresses
+      ===================================== */
+   bsa.type = type;
+   switch (type)
+     {
+      case SYMBOL_TYPE:
+      case STRING_TYPE:
+      case INSTANCE_NAME_TYPE:
+         bsa.value = ((CLIPSLexeme *) value)->bucket;
+         break;
+      case FLOAT_TYPE:
+         bsa.value = ((CLIPSFloat *) value)->bucket;
+         break;
+      case INTEGER_TYPE:
+         bsa.value = ((CLIPSInteger *) value)->bucket;
+         break;
+      case INSTANCE_ADDRESS_TYPE:
+         bsa.type = INSTANCE_NAME_TYPE;
+         bsa.value = GetFullInstanceName(theEnv,(Instance *) value)->bucket;
+         break;
+      default:
+         bsa.value = ULONG_MAX;
+     }
+     
+   fwrite(&bsa,sizeof(struct bsaveSlotValueAtom),1,bsaveFP);
+  }
+
+#endif
+
+/**********************************************************************
+  NAME         : LoadOrRestoreInstances
+  DESCRIPTION  : Loads instances from named file
+  INPUTS       : 1) The name of the input file
+                 2) An integer flag indicating whether or
+                    not to use message-passing to create
+                    the new instances and delete old versions
+                 3) An integer flag indicating if arg #1
+                    is a file name or the name of a string router
+  RETURNS      : The number of instances loaded/restored
+  SIDE EFFECTS : Instances loaded from file
+  NOTES        : None
+ **********************************************************************/
+static long LoadOrRestoreInstances(
+  Environment *theEnv,
+  const char *file,
+  bool usemsgs,
+  bool isFileName)
+  {
+   UDFValue temp;
+   FILE *sfile = NULL,*svload = NULL;
+   const char *ilog;
+   Expression *top;
+   bool svoverride;
+   long instanceCount = 0L;
+   int danglingConstructs;
+   GCBlock gcb;
+
+   /*=====================================*/
+   /* If embedded, clear the error flags. */
+   /*=====================================*/
+
+   if (EvaluationData(theEnv)->CurrentExpression == NULL)
+     { ResetErrorFlags(theEnv); }
+
+   if (isFileName)
+     {
+      if ((sfile = GenOpen(theEnv,file,"r")) == NULL)
+        {
+         SetEvaluationError(theEnv,true);
+         return -1L;
+        }
+      svload = GetFastLoad(theEnv);
+      ilog = (char *) sfile;
+      SetFastLoad(theEnv,sfile);
+     }
+   else
+     { ilog = file; }
+     
+   top = GenConstant(theEnv,FCALL,FindFunction(theEnv,"make-instance"));
+   GetToken(theEnv,ilog,&DefclassData(theEnv)->ObjectParseToken);
+   svoverride = InstanceData(theEnv)->MkInsMsgPass;
+   InstanceData(theEnv)->MkInsMsgPass = usemsgs;
+   
+   danglingConstructs = ConstructData(theEnv)->DanglingConstructs;
+
+   /*========================================*/
+   /* Set up the frame for tracking garbage. */
+   /*========================================*/
+   
+   GCBlockStart(theEnv,&gcb);
+
+   while ((DefclassData(theEnv)->ObjectParseToken.tknType != STOP_TOKEN) && (EvaluationData(theEnv)->HaltExecution != true))
+     {
+      if (DefclassData(theEnv)->ObjectParseToken.tknType != LEFT_PARENTHESIS_TOKEN)
+        {
+         SyntaxErrorMessage(theEnv,"instance definition");
+         rtn_struct(theEnv,expr,top);
+         if (isFileName)
+           {
+            GenClose(theEnv,sfile);
+            SetFastLoad(theEnv,svload);
+           }
+         SetEvaluationError(theEnv,true);
+         InstanceData(theEnv)->MkInsMsgPass = svoverride;
+
+         GCBlockEnd(theEnv,&gcb);
+
+         if (EvaluationData(theEnv)->CurrentExpression == NULL)
+           {
+            ConstructData(theEnv)->DanglingConstructs = danglingConstructs;
+            CleanCurrentGarbageFrame(theEnv,NULL);
+           }
+
+         return instanceCount;
+        }
+        
+      if (ParseSimpleInstance(theEnv,top,ilog) == NULL)
+        {
+         if (isFileName)
+           {
+            GenClose(theEnv,sfile);
+            SetFastLoad(theEnv,svload);
+           }
+         InstanceData(theEnv)->MkInsMsgPass = svoverride;
+         SetEvaluationError(theEnv,true);
+
+         GCBlockEnd(theEnv,&gcb);
+
+         if (EvaluationData(theEnv)->CurrentExpression == NULL)
+           {
+            ConstructData(theEnv)->DanglingConstructs = danglingConstructs;
+            CleanCurrentGarbageFrame(theEnv,NULL);
+           }
+
+         return instanceCount;
+        }
+      ExpressionInstall(theEnv,top);
+      EvaluateExpression(theEnv,top,&temp);
+      ExpressionDeinstall(theEnv,top);
+      if (! EvaluationData(theEnv)->EvaluationError)
+        { instanceCount++; }
+      ReturnExpression(theEnv,top->argList);
+      top->argList = NULL;
+      GetToken(theEnv,ilog,&DefclassData(theEnv)->ObjectParseToken);
+     }
+     
+   /*================================*/
+   /* Restore the old garbage frame. */
+   /*================================*/
+   
+   GCBlockEnd(theEnv,&gcb);
+   
+   /*===============================================*/
+   /* If embedded, clean the topmost garbage frame. */
+   /*===============================================*/
+
+   if (EvaluationData(theEnv)->CurrentExpression == NULL)
+     {
+      ConstructData(theEnv)->DanglingConstructs = danglingConstructs;
+      CleanCurrentGarbageFrame(theEnv,NULL);
+     }
+
+   rtn_struct(theEnv,expr,top);
+   if (isFileName)
+     {
+      GenClose(theEnv,sfile);
+      SetFastLoad(theEnv,svload);
+     }
+   InstanceData(theEnv)->MkInsMsgPass = svoverride;
+   return instanceCount;
+  }
+
+/***************************************************
+  NAME         : ProcessFileErrorMessage
+  DESCRIPTION  : Prints an error message when a
+                 file containing text or binary
+                 instances cannot be processed.
+  INPUTS       : The name of the input file and the
+                 function which opened it.
+  RETURNS      : No value
+  SIDE EFFECTS : None
+  NOTES        : None
+ ***************************************************/
+static void ProcessFileErrorMessage(
+  Environment *theEnv,
+  const char *functionName,
+  const char *fileName)
+  {
+   PrintErrorID(theEnv,"INSFILE",1,false);
+   WriteString(theEnv,STDERR,"Function '");
+   WriteString(theEnv,STDERR,functionName);
+   WriteString(theEnv,STDERR,"' could not completely process file '");
+   WriteString(theEnv,STDERR,fileName);
+   WriteString(theEnv,STDERR,"'.\n");
+  }
+
+#if BLOAD_INSTANCES
+
+/*******************************************************
+  NAME         : VerifyBinaryHeader
+  DESCRIPTION  : Reads the prefix and version headers
+                 from a file to verify that the
+                 input is a valid binary instances file
+  INPUTS       : The name of the file
+  RETURNS      : True if OK, false otherwise
+  SIDE EFFECTS : Input prefix and version read
+  NOTES        : Assumes file already open with
+                 GenOpenReadBinary
+ *******************************************************/
+static bool VerifyBinaryHeader(
+  Environment *theEnv,
+  const char *theFile)
+  {
+   char buf[20];
+
+   GenReadBinary(theEnv,buf,(strlen(InstanceFileData(theEnv)->InstanceBinaryPrefixID) + 1));
+   if (strcmp(buf,InstanceFileData(theEnv)->InstanceBinaryPrefixID) != 0)
+     {
+      PrintErrorID(theEnv,"INSFILE",2,false);
+      WriteString(theEnv,STDERR,"File '");
+      WriteString(theEnv,STDERR,theFile);
+      WriteString(theEnv,STDERR,"' is not a binary instances file.\n");
+      return false;
+     }
+   GenReadBinary(theEnv,buf,(strlen(InstanceFileData(theEnv)->InstanceBinaryVersionID) + 1));
+   if (strcmp(buf,InstanceFileData(theEnv)->InstanceBinaryVersionID) != 0)
+     {
+      PrintErrorID(theEnv,"INSFILE",3,false);
+      WriteString(theEnv,STDERR,"File '");
+      WriteString(theEnv,STDERR,theFile);
+      WriteString(theEnv,STDERR,"' is not a compatible binary instances file.\n");
+      return false;
+     }
+   return true;
+  }
+
+/***************************************************
+  NAME         : LoadSingleBinaryInstance
+  DESCRIPTION  : Reads the binary data for a new
+                 instance and its slot values and
+                 creates/initializes the instance
+  INPUTS       : None
+  RETURNS      : True if all OK,
+                 false otherwise
+  SIDE EFFECTS : Binary data read and instance
+                 created
+  NOTES        : Uses global GenReadBinary(theEnv,)
+ ***************************************************/
+static bool LoadSingleBinaryInstance(
+  Environment *theEnv)
+  {
+   CLIPSLexeme *instanceName,
+             *className;
+   unsigned short slotCount;
+   Defclass *theDefclass;
+   Instance *newInstance;
+   struct bsaveSlotValue *bsArray;
+   struct bsaveSlotValueAtom *bsaArray = NULL;
+   long nameIndex;
+   unsigned long totalValueCount;
+   long i, j;
+   InstanceSlot *sp;
+   UDFValue slotValue, junkValue;
+
+   /* =====================
+      Get the instance name
+      ===================== */
+   BufferedRead(theEnv,&nameIndex,sizeof(long));
+   instanceName = SymbolPointer(nameIndex);
+
+   /* ==================
+      Get the class name
+      ================== */
+   BufferedRead(theEnv,&nameIndex,sizeof(long));
+   className = SymbolPointer(nameIndex);
+
+   /* ==================
+      Get the slot count
+      ================== */
+   BufferedRead(theEnv,&slotCount,sizeof(unsigned short));
+
+   /* =============================
+      Make sure the defclass exists
+      and check the slot count
+      ============================= */
+   theDefclass = LookupDefclassByMdlOrScope(theEnv,className->contents);
+   if (theDefclass == NULL)
+     {
+      ClassExistError(theEnv,"bload-instances",className->contents);
+      return false;
+     }
+   if (theDefclass->instanceSlotCount != slotCount)
+     {
+      BinaryLoadInstanceError(theEnv,instanceName,theDefclass);
+      return false;
+     }
+
+   /* ===================================
+      Create the new unitialized instance
+      =================================== */
+   newInstance = BuildInstance(theEnv,instanceName,theDefclass,false);
+   if (newInstance == NULL)
+     {
+      BinaryLoadInstanceError(theEnv,instanceName,theDefclass);
+      return false;
+     }
+   if (slotCount == 0)
+     return true;
+
+   /* ====================================
+      Read all slot override info and slot
+      value atoms into big arrays
+      ==================================== */
+   bsArray = (struct bsaveSlotValue *) gm2(theEnv,(sizeof(struct bsaveSlotValue) * slotCount));
+   BufferedRead(theEnv,bsArray,(sizeof(struct bsaveSlotValue) * slotCount));
+
+   BufferedRead(theEnv,&totalValueCount,sizeof(unsigned long));
+
+   if (totalValueCount != 0L)
+     {
+      bsaArray = (struct bsaveSlotValueAtom *)
+                  gm2(theEnv,(totalValueCount * sizeof(struct bsaveSlotValueAtom)));
+      BufferedRead(theEnv,bsaArray,(totalValueCount * sizeof(struct bsaveSlotValueAtom)));
+     }
+
+   /* =========================
+      Insert the values for the
+      slot overrides
+      ========================= */
+   for (i = 0 , j = 0L ; i < slotCount ; i++)
+     {
+      /* ===========================================================
+         Here is another check for the validity of the binary file -
+         the order of the slots in the file should match the
+         order in the class definition
+         =========================================================== */
+      sp = newInstance->slotAddresses[i];
+      if (sp->desc->slotName->name != SymbolPointer(bsArray[i].slotName))
+        goto LoadError;
+      CreateSlotValue(theEnv,&slotValue,(struct bsaveSlotValueAtom *) &bsaArray[j],
+                      bsArray[i].valueCount);
+
+      if (PutSlotValue(theEnv,newInstance,sp,&slotValue,&junkValue,"bload-instances") != PSE_NO_ERROR)
+        goto LoadError;
+
+      j += (unsigned long) bsArray[i].valueCount;
+     }
+
+   rm(theEnv,bsArray,(sizeof(struct bsaveSlotValue) * slotCount));
+
+   if (totalValueCount != 0L)
+     rm(theEnv,bsaArray,(totalValueCount * sizeof(struct bsaveSlotValueAtom)));
+
+   return true;
+
+LoadError:
+   BinaryLoadInstanceError(theEnv,instanceName,theDefclass);
+   QuashInstance(theEnv,newInstance);
+   rm(theEnv,bsArray,(sizeof(struct bsaveSlotValue) * slotCount));
+   rm(theEnv,bsaArray,(totalValueCount * sizeof(struct bsaveSlotValueAtom)));
+   return false;
+  }
+
+/***************************************************
+  NAME         : BinaryLoadInstanceError
+  DESCRIPTION  : Prints out an error message when
+                 an instance could not be
+                 successfully loaded from a
+                 binary file
+  INPUTS       : 1) The instance name
+                 2) The defclass
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Error message printed
+  NOTES        : None
+ ***************************************************/
+static void BinaryLoadInstanceError(
+  Environment *theEnv,
+  CLIPSLexeme *instanceName,
+  Defclass *theDefclass)
+  {
+   PrintErrorID(theEnv,"INSFILE",4,false);
+   WriteString(theEnv,STDERR,"Function 'bload-instances' is unable to load instance [");
+   WriteString(theEnv,STDERR,instanceName->contents);
+   WriteString(theEnv,STDERR,"] of class ");
+   PrintClassName(theEnv,STDERR,theDefclass,true,true);
+  }
+
+/***************************************************
+  NAME         : CreateSlotValue
+  DESCRIPTION  : Creates a data object value from
+                 the binary slot value atom data
+  INPUTS       : 1) A data object buffer
+                 2) The slot value atoms array
+                 3) The number of values to put
+                    in the data object
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Data object initialized
+                 (if more than one value, a
+                 multifield is created)
+  NOTES        : None
+ ***************************************************/
+static void CreateSlotValue(
+  Environment *theEnv,
+  UDFValue *returnValue,
+  struct bsaveSlotValueAtom *bsaValues,
+  unsigned long valueCount)
+  {
+   unsigned i;
+
+   if (valueCount == 0)
+     {
+      returnValue->value = CreateMultifield(theEnv,0L);
+      returnValue->begin = 0;
+      returnValue->range = 0;
+     }
+   else if (valueCount == 1)
+     {
+      returnValue->value = GetBinaryAtomValue(theEnv,&bsaValues[0]);
+     }
+   else
+     {
+      returnValue->value = CreateMultifield(theEnv,valueCount);
+      returnValue->begin = 0;
+      returnValue->range = valueCount;
+      for (i = 0 ; i < valueCount ; i++)
+        {
+         returnValue->multifieldValue->contents[i].value = GetBinaryAtomValue(theEnv,&bsaValues[i]);
+        }
+     }
+  }
+
+/***************************************************
+  NAME         : GetBinaryAtomValue
+  DESCRIPTION  : Uses the binary index of an atom
+                 to find the ephemeris value
+  INPUTS       : The binary type and index
+  RETURNS      : The symbol/etc. pointer
+  SIDE EFFECTS : None
+  NOTES        : None
+ ***************************************************/
+static void *GetBinaryAtomValue(
+  Environment *theEnv,
+  struct bsaveSlotValueAtom *ba)
+  {
+   switch (ba->type)
+     {
+      case SYMBOL_TYPE:
+      case STRING_TYPE:
+      case INSTANCE_NAME_TYPE:
+         return((void *) SymbolPointer(ba->value));
+         
+      case FLOAT_TYPE:
+         return((void *) FloatPointer(ba->value));
+         
+      case INTEGER_TYPE:
+         return((void *) IntegerPointer(ba->value));
+         
+      case FACT_ADDRESS_TYPE:
+#if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT
+         return((void *) &FactData(theEnv)->DummyFact);
+#else
+         return NULL;
+#endif
+
+      case EXTERNAL_ADDRESS_TYPE:
+        return CreateExternalAddress(theEnv,NULL,0);
+
+      default:
+        {
+         SystemError(theEnv,"INSFILE",1);
+         ExitRouter(theEnv,EXIT_FAILURE);
+        }
+     }
+   return NULL;
+  }
+
+#endif /* BLOAD_INSTANCES */
+
+#endif /* OBJECT_SYSTEM */