clipsruby 0.0.2

data/ext/clipsruby/defins.c

@@ -0,0 +1,971 @@
+   /*******************************************************/
+   /*      "C" Language Integrated Production System      */
+   /*                                                     */
+   /*            CLIPS Version 6.40  07/02/18             */
+   /*                                                     */
+   /*                  DEFINSTANCES MODULE                */
+   /*******************************************************/
+
+/*************************************************************/
+/* Purpose: Kernel definstances interface commands           */
+/*              and routines                                 */
+/*                                                           */
+/* Principal Programmer(s):                                  */
+/*      Brian L. Dantes                                      */
+/*                                                           */
+/* Contributing Programmer(s):                               */
+/*                                                           */
+/*                                                           */
+/* Revision History:                                         */
+/*                                                           */
+/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
+/*                                                           */
+/*            Corrected compilation errors for files         */
+/*            generated by constructs-to-c. DR0861           */
+/*                                                           */
+/*            Changed name of variable exp to theExp         */
+/*            because of Unix compiler warnings of shadowed  */
+/*            definitions.                                   */
+/*                                                           */
+/*      6.24: Converted INSTANCE_PATTERN_MATCHING to         */
+/*            DEFRULE_CONSTRUCT.                             */
+/*                                                           */
+/*            Renamed BOOLEAN macro type to intBool.         */
+/*                                                           */
+/*      6.30: Removed conditional code for unsupported       */
+/*            compilers/operating systems (IBM_MCW,          */
+/*            MAC_MCW, and IBM_TBC).                         */
+/*                                                           */
+/*            GetConstructNameAndComment API change.         */
+/*                                                           */
+/*            Added const qualifiers to remove C++           */
+/*            deprecation warnings.                          */
+/*                                                           */
+/*            Converted API macros to function calls.        */
+/*                                                           */
+/*            Changed find construct functionality so that   */
+/*            imported modules are search when locating a    */
+/*            named construct.                               */
+/*                                                           */
+/*      6.40: 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.                                  */
+/*                                                           */
+/*            Removed initial-object support.                */
+/*                                                           */
+/*            Pretty print functions accept optional logical */
+/*            name argument.                                 */
+/*                                                           */
+/*************************************************************/
+
+/* =========================================
+   *****************************************
+               EXTERNAL DEFINITIONS
+   =========================================
+   ***************************************** */
+#include "setup.h"
+
+#if DEFINSTANCES_CONSTRUCT
+
+#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
+#include "bload.h"
+#include "dfinsbin.h"
+#endif
+
+#if CONSTRUCT_COMPILER && (! RUN_TIME)
+#include "dfinscmp.h"
+#endif
+
+#include "argacces.h"
+#include "classcom.h"
+#include "classfun.h"
+#include "cstrccom.h"
+#include "cstrcpsr.h"
+#include "constant.h"
+#include "constrct.h"
+#include "envrnmnt.h"
+#include "evaluatn.h"
+#include "extnfunc.h"
+#include "insfun.h"
+#include "inspsr.h"
+#include "memalloc.h"
+#include "modulpsr.h"
+#include "modulutl.h"
+#include "pprint.h"
+#include "prntutil.h"
+#include "router.h"
+#include "scanner.h"
+#include "symbol.h"
+#include "utility.h"
+
+#include "defins.h"
+
+/* =========================================
+   *****************************************
+                   CONSTANTS
+   =========================================
+   ***************************************** */
+#define ACTIVE_RLN "active"
+
+/* =========================================
+   *****************************************
+      INTERNALLY VISIBLE FUNCTION HEADERS
+   =========================================
+   ***************************************** */
+
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+   static bool                    ParseDefinstances(Environment *,const char *);
+   static CLIPSLexeme            *ParseDefinstancesName(Environment *,const char *,bool *);
+   static void                    RemoveDefinstances(Environment *,Definstances *);
+   static void                    SaveDefinstances(Environment *,Defmodule *,const char *,void *);
+#endif
+
+#if ! RUN_TIME
+   static void                   *AllocateModule(Environment *);
+   static void                    ReturnModule(Environment *,void *);
+   static bool                    ClearDefinstancesReady(Environment *,void *);
+   static void                    CheckDefinstancesBusy(Environment *,ConstructHeader *,void *);
+   static void                    DestroyDefinstancesAction(Environment *,ConstructHeader *,void *);
+#else
+   static void                    RuntimeDefinstancesAction(Environment *,ConstructHeader *,void *);
+#endif
+
+   static void                    ResetDefinstances(Environment *,void *);
+   static void                    ResetDefinstancesAction(Environment *,ConstructHeader *,void *);
+   static void                    DeallocateDefinstancesData(Environment *);
+
+/* =========================================
+   *****************************************
+          EXTERNALLY VISIBLE FUNCTIONS
+   =========================================
+   ***************************************** */
+
+/***************************************************
+  NAME         : SetupDefinstances
+  DESCRIPTION  : Adds the definstance support routines
+                   to the Kernel
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Appropriate function lists modified
+  NOTES        : None
+ ***************************************************/
+void SetupDefinstances(
+  Environment *theEnv)
+  {
+   AllocateEnvironmentData(theEnv,DEFINSTANCES_DATA,sizeof(struct definstancesData),DeallocateDefinstancesData);
+
+   DefinstancesData(theEnv)->DefinstancesModuleIndex =
+                RegisterModuleItem(theEnv,"definstances",
+#if (! RUN_TIME)
+                                    AllocateModule,
+                                    ReturnModule,
+#else
+                                    NULL,NULL,
+#endif
+#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
+                                    BloadDefinstancesModuleRef,
+#else
+                                    NULL,
+#endif
+#if CONSTRUCT_COMPILER && (! RUN_TIME)
+                                    DefinstancesCModuleReference,
+#else
+                                    NULL,
+#endif
+                                    (FindConstructFunction *) FindDefinstancesInModule);
+
+   DefinstancesData(theEnv)->DefinstancesConstruct =
+      AddConstruct(theEnv,"definstances","definstances",
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+                   ParseDefinstances,
+#else
+                   NULL,
+#endif
+                   (FindConstructFunction *) FindDefinstances,
+                   GetConstructNamePointer,GetConstructPPForm,
+                   GetConstructModuleItem,
+                   (GetNextConstructFunction *) GetNextDefinstances,
+                   SetNextConstruct,
+                   (IsConstructDeletableFunction *) DefinstancesIsDeletable,
+                   (DeleteConstructFunction *) Undefinstances,
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+                   (FreeConstructFunction *) RemoveDefinstances
+#else
+                   NULL
+#endif
+                   );
+
+#if ! RUN_TIME
+   AddClearReadyFunction(theEnv,"definstances",ClearDefinstancesReady,0,NULL);
+
+#if ! BLOAD_ONLY
+   AddUDF(theEnv,"undefinstances","v",1,1,"y",UndefinstancesCommand,"UndefinstancesCommand",NULL);
+   AddSaveFunction(theEnv,"definstances",SaveDefinstances,0,NULL);
+#endif
+
+#if DEBUGGING_FUNCTIONS
+   AddUDF(theEnv,"ppdefinstances","vs",1,2,";y;ldsyn",PPDefinstancesCommand,"PPDefinstancesCommand",NULL);
+   AddUDF(theEnv,"list-definstances","v",0,1,"y",ListDefinstancesCommand,"ListDefinstancesCommand",NULL);
+#endif
+
+   AddUDF(theEnv,"get-definstances-list","m",0,1,"y",GetDefinstancesListFunction,"GetDefinstancesListFunction",NULL);
+   AddUDF(theEnv,"definstances-module","y",1,1,"y",GetDefinstancesModuleCommand,"GetDefinstancesModuleCommand",NULL);
+
+#endif
+   AddResetFunction(theEnv,"definstances",ResetDefinstances,0,NULL);
+
+#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
+   SetupDefinstancesBload(theEnv);
+#endif
+
+#if CONSTRUCT_COMPILER && (! RUN_TIME)
+   SetupDefinstancesCompiler(theEnv);
+#endif
+  }
+
+/*******************************************************/
+/* DeallocateDefinstancesData: Deallocates environment */
+/*    data for the definstances construct.             */
+/*******************************************************/
+static void DeallocateDefinstancesData(
+  Environment *theEnv)
+  {
+#if ! RUN_TIME
+   struct definstancesModule *theModuleItem;
+   Defmodule *theModule;
+
+#if BLOAD || BLOAD_AND_BSAVE
+   if (Bloaded(theEnv)) return;
+#endif
+
+   DoForAllConstructs(theEnv,DestroyDefinstancesAction,DefinstancesData(theEnv)->DefinstancesModuleIndex,false,NULL);
+
+   for (theModule = GetNextDefmodule(theEnv,NULL);
+        theModule != NULL;
+        theModule = GetNextDefmodule(theEnv,theModule))
+     {
+      theModuleItem = (struct definstancesModule *)
+                      GetModuleItem(theEnv,theModule,
+                                    DefinstancesData(theEnv)->DefinstancesModuleIndex);
+      rtn_struct(theEnv,definstancesModule,theModuleItem);
+     }
+#else
+#if MAC_XCD
+#pragma unused(theEnv)
+#endif
+#endif
+  }
+
+#if ! RUN_TIME
+/*****************************************************/
+/* DestroyDefinstancesAction: Action used to remove  */
+/*   definstances as a result of DestroyEnvironment. */
+/*****************************************************/
+static void DestroyDefinstancesAction(
+  Environment *theEnv,
+  ConstructHeader *theConstruct,
+  void *buffer)
+  {
+#if MAC_XCD
+#pragma unused(buffer)
+#endif
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+   struct definstances *theDefinstances = (struct definstances *) theConstruct;
+
+   if (theDefinstances == NULL) return;
+
+   ReturnPackedExpression(theEnv,theDefinstances->mkinstance);
+
+   DestroyConstructHeader(theEnv,&theDefinstances->header);
+
+   rtn_struct(theEnv,definstances,theDefinstances);
+#else
+#if MAC_XCD
+#pragma unused(theConstruct,theEnv)
+#endif
+#endif
+  }
+#endif
+
+#if RUN_TIME
+
+/***************************************************/
+/* RuntimeDefinstancesAction: Action to be applied */
+/*   to each definstances construct when a runtime */
+/*   initialization occurs.                        */
+/***************************************************/
+static void RuntimeDefinstancesAction(
+  Environment *theEnv,
+  ConstructHeader *theConstruct,
+  void *buffer)
+  {
+#if MAC_XCD
+#pragma unused(buffer)
+#endif
+   Definstances *theDefinstances = (Definstances *) theConstruct;
+   
+   theDefinstances->header.env = theEnv;
+  }
+
+/**********************************/
+/* DefinstancesRunTimeInitialize: */
+/**********************************/
+void DefinstancesRunTimeInitialize(
+  Environment *theEnv)
+  {
+   DoForAllConstructs(theEnv,RuntimeDefinstancesAction,DefinstancesData(theEnv)->DefinstancesModuleIndex,true,NULL);
+  }
+
+#endif
+
+/***********************************************************
+  NAME         : GetNextDefinstances
+  DESCRIPTION  : Finds first or next definstances
+  INPUTS       : The address of the current definstances
+  RETURNS      : The address of the next definstances
+                   (NULL if none)
+  SIDE EFFECTS : None
+  NOTES        : If ptr == NULL, the first definstances
+                    is returned.
+ ***********************************************************/
+Definstances *GetNextDefinstances(
+  Environment *theEnv,
+  Definstances *theDefinstances)
+  {
+   return (Definstances *) GetNextConstructItem(theEnv,&theDefinstances->header,
+                                                DefinstancesData(theEnv)->DefinstancesModuleIndex);
+  }
+
+/***************************************************
+  NAME         : FindDefinstances
+  DESCRIPTION  : Looks up a definstance construct
+                   by name-string
+  INPUTS       : The symbolic name
+  RETURNS      : The definstance address, or NULL
+                    if not found
+  SIDE EFFECTS : None
+  NOTES        : None
+ ***************************************************/
+Definstances *FindDefinstances(
+  Environment *theEnv,
+  const char *name)
+  {
+   return (Definstances *) FindNamedConstructInModuleOrImports(theEnv,name,DefinstancesData(theEnv)->DefinstancesConstruct);
+  }
+
+/***************************************************
+  NAME         : FindDefinstancesInModule
+  DESCRIPTION  : Looks up a definstance construct
+                   by name-string
+  INPUTS       : The symbolic name
+  RETURNS      : The definstance address, or NULL
+                    if not found
+  SIDE EFFECTS : None
+  NOTES        : None
+ ***************************************************/
+Definstances *FindDefinstancesInModule(
+  Environment *theEnv,
+  const char *name)
+  {
+   return (Definstances *) FindNamedConstructInModule(theEnv,name,DefinstancesData(theEnv)->DefinstancesConstruct);
+  }
+
+/***************************************************
+  NAME         : DefinstancesIsDeletable
+  DESCRIPTION  : Determines if a definstances
+                   can be deleted
+  INPUTS       : Address of the definstances
+  RETURNS      : True if deletable, false otherwise
+  SIDE EFFECTS : None
+  NOTES        : None
+ ***************************************************/
+bool DefinstancesIsDeletable(
+  Definstances *theDefinstances)
+  {
+   Environment *theEnv = theDefinstances->header.env;
+   
+   if (! ConstructsDeletable(theEnv))
+     { return false; }
+
+   return (theDefinstances->busy == 0) ? true : false;
+  }
+
+/***********************************************************
+  NAME         : UndefinstancesCommand
+  DESCRIPTION  : Removes a definstance
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Definstance deallocated
+  NOTES        : H/L Syntax : (undefinstances <name> | *)
+ ***********************************************************/
+void UndefinstancesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UndefconstructCommand(context,"undefinstances",DefinstancesData(theEnv)->DefinstancesConstruct);
+  }
+
+/*****************************************************************
+  NAME         : GetDefinstancesModuleCommand
+  DESCRIPTION  : Determines to which module a definstances belongs
+  INPUTS       : None
+  RETURNS      : The symbolic name of the module
+  SIDE EFFECTS : None
+  NOTES        : H/L Syntax: (definstances-module <defins-name>)
+ *****************************************************************/
+void GetDefinstancesModuleCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   returnValue->value = GetConstructModuleCommand(context,"definstances-module",DefinstancesData(theEnv)->DefinstancesConstruct);
+  }
+
+/***********************************************************
+  NAME         : Undefinstances
+  DESCRIPTION  : Removes a definstance
+  INPUTS       : Address of definstances to remove
+  RETURNS      : True if successful,
+                 false otherwise
+  SIDE EFFECTS : Definstance deallocated
+  NOTES        : None
+ ***********************************************************/
+bool Undefinstances(
+  Definstances *theDefinstances,
+  Environment *allEnv)
+  {
+   Environment *theEnv;
+   
+   if (theDefinstances == NULL)
+     {
+      theEnv = allEnv;
+      return Undefconstruct(theEnv,NULL,DefinstancesData(theEnv)->DefinstancesConstruct);
+     }
+   else
+     {
+      theEnv = theDefinstances->header.env;
+      return Undefconstruct(theEnv,&theDefinstances->header,DefinstancesData(theEnv)->DefinstancesConstruct);
+     }
+  }
+
+#if DEBUGGING_FUNCTIONS
+
+/***************************************************************
+  NAME         : PPDefinstancesCommand
+  DESCRIPTION  : Prints out the pretty-print form of a definstance
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : None
+  NOTES        : H/L Syntax : (ppdefinstances <name>)
+ ***************************************************************/
+void PPDefinstancesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   PPConstructCommand(context,"ppdefinstances",DefinstancesData(theEnv)->DefinstancesConstruct,returnValue);
+  }
+
+/***************************************************
+  NAME         : ListDefinstancesCommand
+  DESCRIPTION  : Displays all definstances names
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Definstances name sprinted
+  NOTES        : H/L Interface
+ ***************************************************/
+void ListDefinstancesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   ListConstructCommand(context,DefinstancesData(theEnv)->DefinstancesConstruct);
+  }
+
+/***************************************************
+  NAME         : ListDefinstances
+  DESCRIPTION  : Displays all definstances names
+  INPUTS       : 1) The logical name of the output
+                 2) The module
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Definstances names printed
+  NOTES        : C Interface
+ ***************************************************/
+void ListDefinstances(
+  Environment *theEnv,
+  const char *logicalName,
+  Defmodule *theModule)
+  {
+   ListConstruct(theEnv,DefinstancesData(theEnv)->DefinstancesConstruct,logicalName,theModule);
+  }
+
+#endif
+
+/****************************************************************
+  NAME         : GetDefinstancesListFunction
+  DESCRIPTION  : Groups all definstances names into
+                 a multifield list
+  INPUTS       : A data object buffer to hold
+                 the multifield result
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Multifield allocated and filled
+  NOTES        : H/L Syntax: (get-definstances-list [<module>])
+ ****************************************************************/
+void GetDefinstancesListFunction(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   GetConstructListFunction(context,returnValue,DefinstancesData(theEnv)->DefinstancesConstruct);
+  }
+
+/***************************************************************
+  NAME         : GetDefinstancesList
+  DESCRIPTION  : Groups all definstances names into
+                 a multifield list
+  INPUTS       : 1) A data object buffer to hold
+                    the multifield result
+                 2) The module from which to obtain definstances
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Multifield allocated and filled
+  NOTES        : External C access
+ ***************************************************************/
+void GetDefinstancesList(
+  Environment *theEnv,
+  CLIPSValue *returnValue,
+  Defmodule *theModule)
+  {
+   UDFValue result;
+   
+   GetConstructList(theEnv,&result,DefinstancesData(theEnv)->DefinstancesConstruct,theModule);
+   NormalizeMultifield(theEnv,&result);
+   returnValue->value = result.value;
+  }
+
+/* =========================================
+   *****************************************
+          INTERNALLY VISIBLE FUNCTIONS
+   =========================================
+   ***************************************** */
+
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+
+/*********************************************************************
+  NAME         : ParseDefinstances
+  DESCRIPTION  : Parses and allocates a definstances construct
+  INPUTS       : The logical name of the input source
+  RETURNS      : False if no errors, true otherwise
+  SIDE EFFECTS : Definstances parsed and created
+  NOTES        : H/L Syntax :
+
+                 (definstances  <name> [active] [<comment>]
+                    <instance-definition>+)
+
+                 <instance-definition> ::=
+                    (<instance-name> of <class-name> <slot-override>*)
+
+                 <slot-override> ::= (<slot-name> <value-expression>*)
+ *********************************************************************/
+static bool ParseDefinstances(
+  Environment *theEnv,
+  const char *readSource)
+  {
+   CLIPSLexeme *dname;
+   struct functionDefinition *mkinsfcall;
+   Expression *mkinstance,*mkbot = NULL;
+   Definstances *dobj;
+   bool active;
+
+   SetPPBufferStatus(theEnv,true);
+   FlushPPBuffer(theEnv);
+   SetIndentDepth(theEnv,3);
+   SavePPBuffer(theEnv,"(definstances ");
+
+#if BLOAD || BLOAD_AND_BSAVE
+   if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
+     {
+      CannotLoadWithBloadMessage(theEnv,"definstances");
+      return true;
+     }
+#endif
+   dname = ParseDefinstancesName(theEnv,readSource,&active);
+   if (dname == NULL)
+     return true;
+
+   dobj = get_struct(theEnv,definstances);
+   InitializeConstructHeader(theEnv,"definstances",DEFINSTANCES,&dobj->header,dname);
+   dobj->busy = 0;
+   dobj->mkinstance = NULL;
+#if DEFRULE_CONSTRUCT
+   if (active)
+     mkinsfcall = FindFunction(theEnv,"active-make-instance");
+   else
+     mkinsfcall = FindFunction(theEnv,"make-instance");
+#else
+   mkinsfcall = FindFunction(theEnv,"make-instance");
+#endif
+   while (DefclassData(theEnv)->ObjectParseToken.tknType == LEFT_PARENTHESIS_TOKEN)
+     {
+      mkinstance = GenConstant(theEnv,UNKNOWN_VALUE,mkinsfcall);
+      mkinstance = ParseInitializeInstance(theEnv,mkinstance,readSource);
+      if (mkinstance == NULL)
+        {
+         ReturnExpression(theEnv,dobj->mkinstance);
+         rtn_struct(theEnv,definstances,dobj);
+         return true;
+        }
+      if (ExpressionContainsVariables(mkinstance,false) == true)
+        {
+         LocalVariableErrorMessage(theEnv,"definstances");
+         ReturnExpression(theEnv,mkinstance);
+         ReturnExpression(theEnv,dobj->mkinstance);
+         rtn_struct(theEnv,definstances,dobj);
+         return true;
+        }
+      if (mkbot == NULL)
+        dobj->mkinstance = mkinstance;
+      else
+        GetNextArgument(mkbot) = mkinstance;
+      mkbot = mkinstance;
+      GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
+      PPBackup(theEnv);
+      PPCRAndIndent(theEnv);
+      SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
+     }
+
+   if (DefclassData(theEnv)->ObjectParseToken.tknType != RIGHT_PARENTHESIS_TOKEN)
+     {
+      ReturnExpression(theEnv,dobj->mkinstance);
+      rtn_struct(theEnv,definstances,dobj);
+      SyntaxErrorMessage(theEnv,"definstances");
+      return true;
+     }
+   else
+     {
+      if (ConstructData(theEnv)->CheckSyntaxMode)
+        {
+         ReturnExpression(theEnv,dobj->mkinstance);
+         rtn_struct(theEnv,definstances,dobj);
+         return false;
+        }
+#if DEBUGGING_FUNCTIONS
+      if (GetConserveMemory(theEnv) == false)
+        {
+         if (dobj->mkinstance != NULL)
+           PPBackup(theEnv);
+         PPBackup(theEnv);
+         SavePPBuffer(theEnv,")\n");
+         SetDefinstancesPPForm(theEnv,dobj,CopyPPBuffer(theEnv));
+        }
+#endif
+      mkinstance = dobj->mkinstance;
+      dobj->mkinstance = PackExpression(theEnv,mkinstance);
+      ReturnExpression(theEnv,mkinstance);
+      IncrementLexemeCount(GetDefinstancesNamePointer(theEnv,dobj));
+      ExpressionInstall(theEnv,dobj->mkinstance);
+     }
+
+   AddConstructToModule(&dobj->header);
+   return false;
+  }
+
+/*************************************************************
+  NAME         : ParseDefinstancesName
+  DESCRIPTION  : Parses definstance name and optional comment
+                 and optional "active" keyword
+  INPUTS       : 1) The logical name of the input source
+                 2) Buffer to hold flag indicating if
+                    definstances should cause pattern-matching
+                    to occur during slot-overrides
+  RETURNS      : Address of name symbol, or
+                   NULL if there was an error
+  SIDE EFFECTS : Token after name or comment is scanned
+  NOTES        : Assumes "(definstances" has already
+                   been scanned.
+ *************************************************************/
+static CLIPSLexeme *ParseDefinstancesName(
+  Environment *theEnv,
+  const char *readSource,
+  bool *active)
+  {
+   CLIPSLexeme *dname;
+
+   *active = false;
+   dname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"definstances",
+                                      (FindConstructFunction *) FindDefinstancesInModule,
+                                      (DeleteConstructFunction *) Undefinstances,"@",
+                                      true,false,true,false);
+   if (dname == NULL)
+     return NULL;
+
+#if DEFRULE_CONSTRUCT
+   if ((DefclassData(theEnv)->ObjectParseToken.tknType != SYMBOL_TOKEN) ? false :
+       (strcmp(DefclassData(theEnv)->ObjectParseToken.lexemeValue->contents,ACTIVE_RLN) == 0))
+     {
+      PPBackup(theEnv);
+      PPBackup(theEnv);
+      SavePPBuffer(theEnv," ");
+      SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
+      PPCRAndIndent(theEnv);
+      GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
+      *active = true;
+     }
+#endif
+   if (DefclassData(theEnv)->ObjectParseToken.tknType == STRING_TOKEN)
+     {
+      PPBackup(theEnv);
+      PPBackup(theEnv);
+      SavePPBuffer(theEnv," ");
+      SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
+      PPCRAndIndent(theEnv);
+      GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
+     }
+   return(dname);
+  }
+
+/**************************************************************
+  NAME         : RemoveDefinstances
+  DESCRIPTION  : Deallocates and removes a definstance construct
+  INPUTS       : The definstance address
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Existing definstance construct deleted
+  NOTES        : Assumes busy count of definstance is 0
+ **************************************************************/
+static void RemoveDefinstances(
+  Environment *theEnv,
+  Definstances *theDefinstances)
+  {
+   ReleaseLexeme(theEnv,theDefinstances->header.name);
+   ExpressionDeinstall(theEnv,theDefinstances->mkinstance);
+   ReturnPackedExpression(theEnv,theDefinstances->mkinstance);
+   SetDefinstancesPPForm(theEnv,theDefinstances,NULL);
+   ClearUserDataList(theEnv,theDefinstances->header.usrData);
+   rtn_struct(theEnv,definstances,theDefinstances);
+  }
+
+/***************************************************
+  NAME         : SaveDefinstances
+  DESCRIPTION  : Prints pretty print form of
+                   definstances to specified output
+  INPUTS       : The logical name of the output
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : None
+  NOTES        : None
+ ***************************************************/
+static void SaveDefinstances(
+  Environment *theEnv,
+  Defmodule *theModule,
+  const char *logName,
+  void *context)
+  {
+   SaveConstruct(theEnv,theModule,logName,DefinstancesData(theEnv)->DefinstancesConstruct);
+  }
+
+#endif
+
+#if ! RUN_TIME
+
+/*****************************************************
+  NAME         : AllocateModule
+  DESCRIPTION  : Creates and initializes a
+                 list of definstances for a new module
+  INPUTS       : None
+  RETURNS      : The new definstances module
+  SIDE EFFECTS : Definstances module created
+  NOTES        : None
+ *****************************************************/
+static void *AllocateModule(
+  Environment *theEnv)
+  {
+   return (void *) get_struct(theEnv,definstancesModule);
+  }
+
+/***************************************************
+  NAME         : ReturnModule
+  DESCRIPTION  : Removes a definstances module and
+                 all associated definstances
+  INPUTS       : The definstances module
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Module and definstances deleted
+  NOTES        : None
+ ***************************************************/
+static void ReturnModule(
+  Environment *theEnv,
+  void *theItem)
+  {
+#if (! BLOAD_ONLY)
+   FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefinstancesData(theEnv)->DefinstancesConstruct);
+#endif
+   rtn_struct(theEnv,definstancesModule,theItem);
+  }
+
+/***************************************************
+  NAME         : ClearDefinstancesReady
+  DESCRIPTION  : Determines if it is safe to
+                 remove all definstances
+                 Assumes *all* constructs will be
+                 deleted
+  INPUTS       : None
+  RETURNS      : True if all definstances can
+                 be deleted, false otherwise
+  SIDE EFFECTS : None
+  NOTES        : Used by (clear) and (bload)
+ ***************************************************/
+static bool ClearDefinstancesReady(
+  Environment *theEnv,
+  void *context)
+  {
+   bool flagBuffer = true;
+
+   DoForAllConstructs(theEnv,CheckDefinstancesBusy,DefinstancesData(theEnv)->DefinstancesModuleIndex,
+                      false,&flagBuffer);
+   return(flagBuffer);
+  }
+
+/***************************************************
+  NAME         : CheckDefinstancesBusy
+  DESCRIPTION  : Determines if a definstances is
+                 in use or not
+  INPUTS       : 1) The definstances
+                 2) A buffer to set to 0 if the
+                    the definstances is busy
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Buffer set to 0 if definstances
+                 busy
+  NOTES        : The flag buffer is not modified
+                 if definstances is not busy
+                 (assumed to be initialized to 1)
+ ***************************************************/
+static void CheckDefinstancesBusy(
+  Environment *theEnv,
+  ConstructHeader *theDefinstances,
+  void *userBuffer)
+  {
+#if MAC_XCD
+#pragma unused(theEnv)
+#endif
+
+   if (((Definstances *) theDefinstances)->busy > 0)
+     { *((bool *) userBuffer) = false; }
+  }
+
+#endif
+
+/***************************************************
+  NAME         : ResetDefinstances
+  DESCRIPTION  : Calls EvaluateExpression for each of
+                   the make-instance calls in all
+                   of the definstances constructs
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : All instances in the definstances
+                   are evaluated (and created if
+                   there are no errors)
+                 Any previously existing instances
+                 are deleted first.
+  NOTES        : None
+ ***************************************************/
+static void ResetDefinstances(
+  Environment *theEnv,
+  void *context)
+  {
+   DoForAllConstructs(theEnv,ResetDefinstancesAction,DefinstancesData(theEnv)->DefinstancesModuleIndex,true,NULL);
+  }
+
+/***************************************************
+  NAME         : ResetDefinstancesAction
+  DESCRIPTION  : Performs all the make-instance
+                 calls in a definstances
+  INPUTS       : 1) The definstances
+                 2) User data buffer (ignored)
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Instances created
+  NOTES        : None
+ ***************************************************/
+static void ResetDefinstancesAction(
+  Environment *theEnv,
+  ConstructHeader *vDefinstances,
+  void *userBuffer)
+  {
+#if MAC_XCD
+#pragma unused(userBuffer)
+#endif
+   Definstances *theDefinstances = (Definstances *) vDefinstances;
+   Expression *theExp;
+   UDFValue temp;
+
+   SaveCurrentModule(theEnv);
+   SetCurrentModule(theEnv,vDefinstances->whichModule->theModule);
+   theDefinstances->busy++;
+   for (theExp = theDefinstances->mkinstance ;
+        theExp != NULL ;
+        theExp = GetNextArgument(theExp))
+     {
+      EvaluateExpression(theEnv,theExp,&temp);
+      if (EvaluationData(theEnv)->HaltExecution ||
+          (temp.value == FalseSymbol(theEnv)))
+        {
+         RestoreCurrentModule(theEnv);
+         theDefinstances->busy--;
+         return;
+        }
+     }
+   theDefinstances->busy--;
+   RestoreCurrentModule(theEnv);
+  }
+
+/*##################################*/
+/* Additional Environment Functions */
+/*##################################*/
+
+const char *DefinstancesName(
+  Definstances *theDefinstances)
+  {
+   return GetConstructNameString(&theDefinstances->header);
+  }
+
+const char *DefinstancesPPForm(
+  Definstances *theDefinstances)
+  {
+   return GetConstructPPForm(&theDefinstances->header);
+  }
+
+void SetDefinstancesPPForm(
+  Environment *theEnv,
+  Definstances *theDefinstances,
+  const char *thePPForm)
+  {
+   SetConstructPPForm(theEnv,&theDefinstances->header,thePPForm);
+  }
+
+const char *DefinstancesModule(
+  Definstances *theDefinstances)
+  {
+   return GetConstructModuleName(&theDefinstances->header);
+  }
+
+CLIPSLexeme *GetDefinstancesNamePointer(
+  Environment *theEnv,
+  Definstances *theDefinstances)
+  {
+   return GetConstructNamePointer(&theDefinstances->header);
+  }
+
+const char *DefinstancesModuleName(
+  Environment *theEnv,
+  Definstances *theDefinstances)
+  {
+   return GetConstructModuleName(&theDefinstances->header);
+  }
+
+#endif
+
+