clipsruby 0.0.2

data/ext/clipsruby/insquery.c

@@ -0,0 +1,1278 @@
+   /*******************************************************/
+   /*      "C" Language Integrated Production System      */
+   /*                                                     */
+   /*            CLIPS Version 6.40  07/14/20             */
+   /*                                                     */
+   /*                                                     */
+   /*******************************************************/
+
+/*************************************************************/
+/* Purpose: Query Functions for Objects                      */
+/*                                                           */
+/* Principal Programmer(s):                                  */
+/*      Brian L. Dantes                                      */
+/*                                                           */
+/* Contributing Programmer(s):                               */
+/*      Gary D. Riley                                        */
+/*                                                           */
+/* Revision History:                                         */
+/*                                                           */
+/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
+/*                                                           */
+/*            Corrected compilation errors for files         */
+/*            generated by constructs-to-c. DR0861           */
+/*                                                           */
+/*      6.24: Renamed BOOLEAN macro type to intBool.         */
+/*                                                           */
+/*      6.30: Changed integer type/precision.                */
+/*                                                           */
+/*            Changed garbage collection algorithm.          */
+/*                                                           */
+/*            Added const qualifiers to remove C++           */
+/*            deprecation warnings.                          */
+/*                                                           */
+/*      6.31: Retrieval for instance query slot function     */
+/*            generates an error if the instance has been    */
+/*            deleted.                                       */
+/*                                                           */
+/*            Functions delayed-do-for-all-instances and     */
+/*            do-for-instance increment the busy count of    */
+/*            matching instance sets so that actions can     */
+/*            detect deleted instances.                      */
+/*                                                           */
+/*            Matching instance sets containing deleted      */
+/*            instances are pruned.                          */
+/*                                                           */
+/*      6.32: Fixed garbage collection issue with return     */
+/*            value of delayed-do-for-all-instances.         */
+/*                                                           */
+/*      6.40: Added Env prefix to GetEvaluationError and     */
+/*            SetEvaluationError functions.                  */
+/*                                                           */
+/*            Pragma once and other inclusion changes.       */
+/*                                                           */
+/*            Added support for booleans with <stdbool.h>.   */
+/*                                                           */
+/*            Removed use of void pointers for specific      */
+/*            data structures.                               */
+/*                                                           */
+/*            UDF redesign.                                  */
+/*                                                           */
+/*            Added GCBlockStart and GCBlockEnd functions    */
+/*            for garbage collection blocks.                 */
+/*                                                           */
+/*            Eval support for run time and bload only.      */
+/*                                                           */
+/*************************************************************/
+
+/* =========================================
+   *****************************************
+               EXTERNAL DEFINITIONS
+   =========================================
+   ***************************************** */
+#include "setup.h"
+
+#if INSTANCE_SET_QUERIES
+
+#include "argacces.h"
+#include "classcom.h"
+#include "classfun.h"
+#include "envrnmnt.h"
+#include "exprnpsr.h"
+#include "insfun.h"
+#include "insmngr.h"
+#include "insqypsr.h"
+#include "memalloc.h"
+#include "prcdrfun.h"
+#include "prntutil.h"
+#include "router.h"
+#include "utility.h"
+
+#include "insquery.h"
+
+/***************************************/
+/* LOCAL INTERNAL FUNCTION DEFINITIONS */
+/***************************************/
+
+   static void                    PushQueryCore(Environment *);
+   static void                    PopQueryCore(Environment *);
+   static QUERY_CORE             *FindQueryCore(Environment *,long long);
+   static QUERY_CLASS            *DetermineQueryClasses(Environment *,Expression *,const char *,unsigned *);
+   static QUERY_CLASS            *FormChain(Environment *,const char *,Defclass *,UDFValue *);
+   static void                    DeleteQueryClasses(Environment *,QUERY_CLASS *);
+   static bool                    TestForFirstInChain(Environment *,QUERY_CLASS *,unsigned);
+   static bool                    TestForFirstInstanceInClass(Environment *,Defmodule *,int,Defclass *,QUERY_CLASS *,unsigned);
+   static void                    TestEntireChain(Environment *,QUERY_CLASS *,unsigned);
+   static void                    TestEntireClass(Environment *,Defmodule *,int,Defclass *,QUERY_CLASS *,unsigned);
+   static void                    AddSolution(Environment *);
+   static void                    PopQuerySoln(Environment *);
+
+/****************************************************
+  NAME         : SetupQuery
+  DESCRIPTION  : Initializes instance query H/L
+                   functions and parsers
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Sets up kernel functions and parsers
+  NOTES        : None
+ ****************************************************/
+void SetupQuery(
+  Environment *theEnv)
+  {
+   AllocateEnvironmentData(theEnv,INSTANCE_QUERY_DATA,sizeof(struct instanceQueryData),NULL);
+
+#if ! RUN_TIME
+   InstanceQueryData(theEnv)->QUERY_DELIMITER_SYMBOL = CreateSymbol(theEnv,QUERY_DELIMITER_STRING);
+   IncrementLexemeCount(InstanceQueryData(theEnv)->QUERY_DELIMITER_SYMBOL);
+
+   AddUDF(theEnv,"(query-instance)","n",0,UNBOUNDED,NULL,GetQueryInstance,"GetQueryInstance",NULL);
+
+   AddUDF(theEnv,"(query-instance-slot)","*",0,UNBOUNDED,NULL,GetQueryInstanceSlot,"GetQueryInstanceSlot",NULL);
+
+   AddUDF(theEnv,"any-instancep","b",0,UNBOUNDED,NULL,AnyInstances,"AnyInstances",NULL);
+
+   AddUDF(theEnv,"find-instance","m",0,UNBOUNDED,NULL,QueryFindInstance,"QueryFindInstance",NULL);
+
+   AddUDF(theEnv,"find-all-instances","m",0,UNBOUNDED,NULL,QueryFindAllInstances,"QueryFindAllInstances",NULL);
+
+   AddUDF(theEnv,"do-for-instance","*",0,UNBOUNDED,NULL,QueryDoForInstance,"QueryDoForInstance",NULL);
+
+   AddUDF(theEnv,"do-for-all-instances","*",0,UNBOUNDED,NULL,QueryDoForAllInstances,"QueryDoForAllInstances",NULL);
+
+   AddUDF(theEnv,"delayed-do-for-all-instances","*",0,UNBOUNDED,NULL,DelayedQueryDoForAllInstances,"DelayedQueryDoForAllInstances",NULL);
+#endif
+
+   AddFunctionParser(theEnv,"any-instancep",ParseQueryNoAction);
+   AddFunctionParser(theEnv,"find-instance",ParseQueryNoAction);
+   AddFunctionParser(theEnv,"find-all-instances",ParseQueryNoAction);
+   AddFunctionParser(theEnv,"do-for-instance",ParseQueryAction);
+   AddFunctionParser(theEnv,"do-for-all-instances",ParseQueryAction);
+   AddFunctionParser(theEnv,"delayed-do-for-all-instances",ParseQueryAction);
+  }
+
+/*************************************************************
+  NAME         : GetQueryInstance
+  DESCRIPTION  : Internal function for referring to instance
+                    array on instance-queries
+  INPUTS       : None
+  RETURNS      : The name of the specified instance-set member
+  SIDE EFFECTS : None
+  NOTES        : H/L Syntax : ((query-instance) <index>)
+ *************************************************************/
+void GetQueryInstance(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   QUERY_CORE *core;
+
+   core = FindQueryCore(theEnv,GetFirstArgument()->integerValue->contents);
+   returnValue->value = GetFullInstanceName(theEnv,core->solns[GetFirstArgument()->nextArg->integerValue->contents]);
+  }
+
+/***************************************************************************
+  NAME         : GetQueryInstanceSlot
+  DESCRIPTION  : Internal function for referring to slots of instances in
+                    instance array on instance-queries
+  INPUTS       : The caller's result buffer
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Caller's result buffer set appropriately
+  NOTES        : H/L Syntax : ((query-instance-slot) <index> <slot-name>)
+ **************************************************************************/
+void GetQueryInstanceSlot(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   Instance *ins;
+   InstanceSlot *sp;
+   UDFValue temp;
+   QUERY_CORE *core;
+   const char *varSlot;
+
+   returnValue->lexemeValue = FalseSymbol(theEnv);
+
+   core = FindQueryCore(theEnv,GetFirstArgument()->integerValue->contents);
+   ins = core->solns[GetFirstArgument()->nextArg->integerValue->contents];
+   varSlot = GetFirstArgument()->nextArg->nextArg->nextArg->lexemeValue->contents;
+
+   /*=======================================*/
+   /* Accessing the slot value of a deleted */
+   /* instance generates an error.          */
+   /*=======================================*/
+
+   if (ins->garbage)
+     {
+      InstanceVarSlotErrorMessage1(theEnv,ins,varSlot);
+      SetEvaluationError(theEnv,true);
+      return;
+     }
+   
+   EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp);
+   if (temp.header->type != SYMBOL_TYPE)
+     {
+      InvalidVarSlotErrorMessage(theEnv,varSlot);
+      SetEvaluationError(theEnv,true);
+      return;
+     }
+   sp = FindInstanceSlot(theEnv,ins,temp.lexemeValue);
+   if (sp == NULL)
+     {
+      InstanceVarSlotErrorMessage2(theEnv,ins,varSlot);
+      SetEvaluationError(theEnv,true);
+      return;
+     }
+   returnValue->value = sp->value;
+   if (sp->type == MULTIFIELD_TYPE)
+     {
+      returnValue->begin = 0;
+      returnValue->range = sp->multifieldValue->length;
+     }
+  }
+
+/* =============================================================================
+   =============================================================================
+   Following are the instance query functions :
+
+     any-instancep         : Determines if any instances satisfy the query
+     find-instance         : Finds first (set of) instance(s) which satisfies
+                               the query and stores it in a multi-field
+     find-all-instances    : Finds all (sets of) instances which satisfy the
+                               the query and stores them in a multi-field
+     do-for-instance       : Executes a given action for the first (set of)
+                               instance(s) which satisfy the query
+     do-for-all-instances  : Executes an action for all instances which satisfy
+                               the query as they are found
+     delayed-do-for-all-instances : Same as above - except that the list of instances
+                               which satisfy the query is formed before any
+                               actions are executed
+
+     Instance candidate search algorithm :
+
+     All permutations of first restriction class instances with other
+       restriction class instances (Rightmost are varied first)
+     All permutations of first restriction class's subclasses' instances with
+       other restriction class instances.
+     And  so on...
+
+     For any one class, instances are examined in the order they were defined
+
+     Example :
+     (defclass a (is-a standard-user))
+     (defclass b (is-a standard-user))
+     (defclass c (is-a standard-user))
+     (defclass d (is-a a b))
+     (make-instance a1 of a)
+     (make-instance a2 of a)
+     (make-instance b1 of b)
+     (make-instance b2 of b)
+     (make-instance c1 of c)
+     (make-instance c2 of c)
+     (make-instance d1 of d)
+     (make-instance d2 of d)
+
+     (any-instancep ((?a a b) (?b c)) <query>)
+
+     The permutations (?a ?b) would be examined in the following order :
+
+     (a1 c1),(a1 c2),(a2 c1),(a2 c2),(d1 c1),(d1 c2),(d2 c1),(d2 c2),
+     (b1 c1),(b1 c2),(b2 c1),(b2 c2),(d1 c1),(d1 c2),(d2 c1),(d2 c2)
+
+     Notice the duplication because d is a subclass of both and a and b.
+   =============================================================================
+   ============================================================================= */
+
+/******************************************************************************
+  NAME         : AnyInstances
+  DESCRIPTION  : Determines if there any existing instances which satisfy
+                   the query
+  INPUTS       : None
+  RETURNS      : True if the query is satisfied, false otherwise
+  SIDE EFFECTS : The query class-expressions are evaluated once,
+                   and the query boolean-expression is evaluated
+                   zero or more times (depending on instance restrictions
+                   and how early the expression evaulates to true - if at all).
+  NOTES        : H/L Syntax : See ParseQueryNoAction()
+ ******************************************************************************/
+void AnyInstances(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   QUERY_CLASS *qclasses;
+   unsigned rcnt;
+   bool testResult;
+
+   qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg,
+                                      "any-instancep",&rcnt);
+   if (qclasses == NULL)
+     {
+      returnValue->lexemeValue = FalseSymbol(theEnv);
+      return;
+     }
+
+   PushQueryCore(theEnv);
+   InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
+   InstanceQueryData(theEnv)->QueryCore->solns = (Instance **) gm2(theEnv,(sizeof(Instance *) * rcnt));
+   InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument();
+   testResult = TestForFirstInChain(theEnv,qclasses,0);
+   InstanceQueryData(theEnv)->AbortQuery = false;
+   rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt));
+   rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore);
+   PopQueryCore(theEnv);
+   DeleteQueryClasses(theEnv,qclasses);
+
+   returnValue->lexemeValue = CreateBoolean(theEnv,testResult);
+  }
+
+/******************************************************************************
+  NAME         : QueryFindInstance
+  DESCRIPTION  : Finds the first set of instances which satisfy the query and
+                   stores their names in the user's multi-field variable
+  INPUTS       : Caller's result buffer
+  RETURNS      : True if the query is satisfied, false otherwise
+  SIDE EFFECTS : The query class-expressions are evaluated once,
+                   and the query boolean-expression is evaluated
+                   zero or more times (depending on instance restrictions
+                   and how early the expression evaulates to true - if at all).
+  NOTES        : H/L Syntax : See ParseQueryNoAction()
+ ******************************************************************************/
+void QueryFindInstance(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   QUERY_CLASS *qclasses;
+   unsigned rcnt,i;
+
+   returnValue->begin = 0;
+   returnValue->range = 0;
+   qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg,
+                                      "find-instance",&rcnt);
+   if (qclasses == NULL)
+     {
+      returnValue->value = CreateMultifield(theEnv,0L);
+      return;
+     }
+   PushQueryCore(theEnv);
+   InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
+   InstanceQueryData(theEnv)->QueryCore->solns = (Instance **)
+                      gm2(theEnv,(sizeof(Instance *) * rcnt));
+   InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument();
+   if (TestForFirstInChain(theEnv,qclasses,0) == true)
+     {
+      returnValue->value = CreateMultifield(theEnv,rcnt);
+      returnValue->range = rcnt;
+      for (i = 0 ; i < rcnt ; i++)
+        {
+         returnValue->multifieldValue->contents[i].lexemeValue =
+            GetFullInstanceName(theEnv,InstanceQueryData(theEnv)->QueryCore->solns[i]);
+        }
+     }
+   else
+      returnValue->value = CreateMultifield(theEnv,0L);
+   InstanceQueryData(theEnv)->AbortQuery = false;
+   rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt));
+   rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore);
+   PopQueryCore(theEnv);
+   DeleteQueryClasses(theEnv,qclasses);
+  }
+
+/******************************************************************************
+  NAME         : QueryFindAllInstances
+  DESCRIPTION  : Finds all sets of instances which satisfy the query and
+                   stores their names in the user's multi-field variable
+
+                 The sets are stored sequentially :
+
+                   Number of sets = (Multi-field length) / (Set length)
+
+                 The first set is if the first (set length) atoms of the
+                   multi-field variable, and so on.
+  INPUTS       : Caller's result buffer
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : The query class-expressions are evaluated once,
+                   and the query boolean-expression is evaluated
+                   once for every instance set.
+  NOTES        : H/L Syntax : See ParseQueryNoAction()
+ ******************************************************************************/
+void QueryFindAllInstances(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   QUERY_CLASS *qclasses;
+   unsigned rcnt;
+   size_t i, j;
+
+   returnValue->begin = 0;
+   returnValue->range = 0;
+   qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg,
+                                      "find-all-instances",&rcnt);
+   if (qclasses == NULL)
+     {
+      returnValue->value = CreateMultifield(theEnv,0L);
+      return;
+     }
+   PushQueryCore(theEnv);
+   InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
+   InstanceQueryData(theEnv)->QueryCore->solns = (Instance **) gm2(theEnv,(sizeof(Instance *) * rcnt));
+   InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument();
+   InstanceQueryData(theEnv)->QueryCore->action = NULL;
+   InstanceQueryData(theEnv)->QueryCore->soln_set = NULL;
+   InstanceQueryData(theEnv)->QueryCore->soln_size = rcnt;
+   InstanceQueryData(theEnv)->QueryCore->soln_cnt = 0;
+   TestEntireChain(theEnv,qclasses,0);
+   InstanceQueryData(theEnv)->AbortQuery = false;
+   returnValue->value = CreateMultifield(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_cnt * rcnt);
+   while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL)
+     {
+      for (i = 0 , j = returnValue->range ; i < rcnt ; i++ , j++)
+        {
+         returnValue->multifieldValue->contents[j].lexemeValue =
+            GetFullInstanceName(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_set->soln[i]);
+        }
+      returnValue->range = j;
+      PopQuerySoln(theEnv);
+     }
+   rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt));
+   rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore);
+   PopQueryCore(theEnv);
+   DeleteQueryClasses(theEnv,qclasses);
+  }
+
+/******************************************************************************
+  NAME         : QueryDoForInstance
+  DESCRIPTION  : Finds the first set of instances which satisfy the query and
+                   executes a user-action with that set
+  INPUTS       : None
+  RETURNS      : Caller's result buffer
+  SIDE EFFECTS : The query class-expressions are evaluated once,
+                   and the query boolean-expression is evaluated
+                   zero or more times (depending on instance restrictions
+                   and how early the expression evaulates to true - if at all).
+                   Also the action expression is executed zero or once.
+                 Caller's result buffer holds result of user-action
+  NOTES        : H/L Syntax : See ParseQueryAction()
+ ******************************************************************************/
+void QueryDoForInstance(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   QUERY_CLASS *qclasses;
+   unsigned i, rcnt;
+
+   returnValue->lexemeValue = FalseSymbol(theEnv);
+   qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg,
+                                      "do-for-instance",&rcnt);
+   if (qclasses == NULL)
+     return;
+   PushQueryCore(theEnv);
+   InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
+   InstanceQueryData(theEnv)->QueryCore->solns = (Instance **) gm2(theEnv,(sizeof(Instance *) * rcnt));
+   InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument();
+   InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
+   
+   if (TestForFirstInChain(theEnv,qclasses,0) == true)
+     {
+      for (i = 0; i < rcnt; i++)
+        { InstanceQueryData(theEnv)->QueryCore->solns[i]->busy++; }
+
+      EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,returnValue);
+      
+      for (i = 0; i < rcnt; i++)
+        { InstanceQueryData(theEnv)->QueryCore->solns[i]->busy--; }
+     }
+     
+   InstanceQueryData(theEnv)->AbortQuery = false;
+   ProcedureFunctionData(theEnv)->BreakFlag = false;
+   rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt));
+   rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore);
+   PopQueryCore(theEnv);
+   DeleteQueryClasses(theEnv,qclasses);
+  }
+
+/******************************************************************************
+  NAME         : QueryDoForAllInstances
+  DESCRIPTION  : Finds all sets of instances which satisfy the query and
+                   executes a user-function for each set as it is found
+  INPUTS       : Caller's result buffer
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : The query class-expressions are evaluated once,
+                   and the query boolean-expression is evaluated
+                   once for every instance set.  Also, the action is
+                   executed for every instance set.
+                 Caller's result buffer holds result of last action executed.
+  NOTES        : H/L Syntax : See ParseQueryAction()
+ ******************************************************************************/
+void QueryDoForAllInstances(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   QUERY_CLASS *qclasses;
+   unsigned rcnt;
+
+   returnValue->lexemeValue = FalseSymbol(theEnv);
+   qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg,
+                                      "do-for-all-instances",&rcnt);
+   if (qclasses == NULL)
+     return;
+
+   PushQueryCore(theEnv);
+   InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
+   InstanceQueryData(theEnv)->QueryCore->solns = (Instance **) gm2(theEnv,(sizeof(Instance *) * rcnt));
+   InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument();
+   InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
+   InstanceQueryData(theEnv)->QueryCore->result = returnValue;
+   RetainUDFV(theEnv,InstanceQueryData(theEnv)->QueryCore->result);
+   TestEntireChain(theEnv,qclasses,0);
+   ReleaseUDFV(theEnv,InstanceQueryData(theEnv)->QueryCore->result);
+
+   InstanceQueryData(theEnv)->AbortQuery = false;
+   ProcedureFunctionData(theEnv)->BreakFlag = false;
+   rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt));
+   rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore);
+   PopQueryCore(theEnv);
+   DeleteQueryClasses(theEnv,qclasses);
+  }
+
+/******************************************************************************
+  NAME         : DelayedQueryDoForAllInstances
+  DESCRIPTION  : Finds all sets of instances which satisfy the query and
+                   and exceutes a user-action for each set
+
+                 This function differs from QueryDoForAllInstances() in
+                   that it forms the complete list of query satisfactions
+                   BEFORE executing any actions.
+  INPUTS       : Caller's result buffer
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : The query class-expressions are evaluated once,
+                   and the query boolean-expression is evaluated
+                   once for every instance set.  The action is executed
+                   for evry query satisfaction.
+                 Caller's result buffer holds result of last action executed.
+  NOTES        : H/L Syntax : See ParseQueryNoAction()
+ ******************************************************************************/
+void DelayedQueryDoForAllInstances(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   QUERY_CLASS *qclasses;
+   unsigned rcnt;
+   unsigned i;
+   GCBlock gcb;
+   QUERY_SOLN *theSet;
+
+   returnValue->lexemeValue = FalseSymbol(theEnv);
+   qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg,
+                                      "delayed-do-for-all-instances",&rcnt);
+   if (qclasses == NULL)
+     return;
+
+   PushQueryCore(theEnv);
+   InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
+   InstanceQueryData(theEnv)->QueryCore->solns = (Instance **) gm2(theEnv,(sizeof(Instance *) * rcnt));
+   InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument();
+   InstanceQueryData(theEnv)->QueryCore->action = NULL;
+   InstanceQueryData(theEnv)->QueryCore->soln_set = NULL;
+   InstanceQueryData(theEnv)->QueryCore->soln_size = rcnt;
+   InstanceQueryData(theEnv)->QueryCore->soln_cnt = 0;
+   TestEntireChain(theEnv,qclasses,0);
+   InstanceQueryData(theEnv)->AbortQuery = false;
+   InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
+
+   /*==================================================================*/
+   /* Increment the busy count for all instances in the solution sets. */
+   /*==================================================================*/
+
+   GCBlockStart(theEnv,&gcb);
+
+   for (theSet = InstanceQueryData(theEnv)->QueryCore->soln_set;
+        theSet != NULL;
+        theSet = theSet->nxt)
+     {
+      for (i = 0; i < rcnt; i++)
+        { theSet->soln[i]->busy++; }
+     }
+
+   /*=====================*/
+   /* Perform the action. */
+   /*=====================*/
+   
+   for (theSet = InstanceQueryData(theEnv)->QueryCore->soln_set;
+        theSet != NULL; )
+     {
+      for (i = 0 ; i < rcnt ; i++)
+        {
+         if (theSet->soln[i]->garbage)
+           { goto nextSet; }
+         InstanceQueryData(theEnv)->QueryCore->solns[i] = theSet->soln[i];
+        }
+
+      EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,returnValue);
+
+      if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
+        { break; }
+
+      CleanCurrentGarbageFrame(theEnv,returnValue);
+      CallPeriodicTasks(theEnv);
+      
+      nextSet: theSet = theSet->nxt;
+     }
+   
+   /*==================================================================*/
+   /* Decrement the busy count for all instances in the solution sets. */
+   /*==================================================================*/
+
+   for (theSet = InstanceQueryData(theEnv)->QueryCore->soln_set;
+        theSet != NULL;
+        theSet = theSet->nxt)
+     {
+      for (i = 0; i < rcnt; i++)
+        { theSet->soln[i]->busy--; }
+     }
+
+   GCBlockEndUDF(theEnv,&gcb,returnValue);
+   CallPeriodicTasks(theEnv);
+
+   /*==================================*/
+   /* Deallocate the query structures. */
+   /*==================================*/
+   
+   while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL)
+     { PopQuerySoln(theEnv); }
+
+   ProcedureFunctionData(theEnv)->BreakFlag = false;
+   rm(theEnv,InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(Instance *) * rcnt));
+   rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore);
+   PopQueryCore(theEnv);
+   DeleteQueryClasses(theEnv,qclasses);
+  }
+
+/* =========================================
+   *****************************************
+          INTERNALLY VISIBLE FUNCTIONS
+   =========================================
+   ***************************************** */
+
+/*******************************************************
+  NAME         : PushQueryCore
+  DESCRIPTION  : Pushes the current QueryCore onto stack
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Allocates new stack node and changes
+                   QueryCoreStack
+  NOTES        : None
+ *******************************************************/
+static void PushQueryCore(
+  Environment *theEnv)
+  {
+   QUERY_STACK *qptr;
+
+   qptr = get_struct(theEnv,query_stack);
+   qptr->core = InstanceQueryData(theEnv)->QueryCore;
+   qptr->nxt = InstanceQueryData(theEnv)->QueryCoreStack;
+   InstanceQueryData(theEnv)->QueryCoreStack = qptr;
+  }
+
+/******************************************************
+  NAME         : PopQueryCore
+  DESCRIPTION  : Pops top of QueryCore stack and
+                   restores QueryCore to this core
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Stack node deallocated, QueryCoreStack
+                   changed and QueryCore reset
+  NOTES        : Assumes stack is not empty
+ ******************************************************/
+static void PopQueryCore(
+  Environment *theEnv)
+  {
+   QUERY_STACK *qptr;
+
+   InstanceQueryData(theEnv)->QueryCore = InstanceQueryData(theEnv)->QueryCoreStack->core;
+   qptr = InstanceQueryData(theEnv)->QueryCoreStack;
+   InstanceQueryData(theEnv)->QueryCoreStack = InstanceQueryData(theEnv)->QueryCoreStack->nxt;
+   rtn_struct(theEnv,query_stack,qptr);
+  }
+
+/***************************************************
+  NAME         : FindQueryCore
+  DESCRIPTION  : Looks up a QueryCore Stack Frame
+                    Depth 0 is current frame
+                    1 is next deepest, etc.
+  INPUTS       : Depth
+  RETURNS      : Address of query core stack frame
+  SIDE EFFECTS : None
+  NOTES        : None
+ ***************************************************/
+static QUERY_CORE *FindQueryCore(
+  Environment *theEnv,
+  long long depth)
+  {
+   QUERY_STACK *qptr;
+
+   if (depth == 0)
+     return InstanceQueryData(theEnv)->QueryCore;
+   qptr = InstanceQueryData(theEnv)->QueryCoreStack;
+   while (depth > 1)
+     {
+      qptr = qptr->nxt;
+      depth--;
+     }
+   return qptr->core;
+  }
+
+/**********************************************************
+  NAME         : DetermineQueryClasses
+  DESCRIPTION  : Builds a list of classes to be used in
+                   instance queries - uses parse form.
+  INPUTS       : 1) The parse class expression chain
+                 2) The name of the function being executed
+                 3) Caller's buffer for restriction count
+                    (# of separate lists)
+  RETURNS      : The query list, or NULL on errors
+  SIDE EFFECTS : Memory allocated for list
+                 Busy count incremented for all classes
+  NOTES        : Each restriction is linked by nxt pointer,
+                   multiple classes in a restriction are
+                   linked by the chain pointer.
+                 Rcnt caller's buffer is set to reflect the
+                   total number of chains
+                 Assumes classExp is not NULL and that each
+                   restriction chain is terminated with
+                   the QUERY_DELIMITER_SYMBOL "(QDS)"
+ **********************************************************/
+static QUERY_CLASS *DetermineQueryClasses(
+  Environment *theEnv,
+  Expression *classExp,
+  const char *func,
+  unsigned *rcnt)
+  {
+   QUERY_CLASS *clist = NULL,*cnxt = NULL,*cchain = NULL,*tmp;
+   bool new_list = false;
+   UDFValue temp;
+   Defclass *theClass;
+
+   *rcnt = 0;
+   while (classExp != NULL)
+     {
+      theClass = NULL;
+      
+      if (classExp->type == DEFCLASS_PTR)
+        {
+         theClass = (Defclass *) classExp->value;
+        }
+      else if (EvaluateExpression(theEnv,classExp,&temp))
+        {
+         DeleteQueryClasses(theEnv,clist);
+         return NULL;
+        }
+        
+      if ((theClass == NULL) &&
+          (temp.value == (void *) InstanceQueryData(theEnv)->QUERY_DELIMITER_SYMBOL))
+        {
+         new_list = true;
+         (*rcnt)++;
+        }
+      else if ((tmp = FormChain(theEnv,func,theClass,&temp)) != NULL)
+        {
+         if (clist == NULL)
+           clist = cnxt = cchain = tmp;
+         else if (new_list == true)
+           {
+            new_list = false;
+            cnxt->nxt = tmp;
+            cnxt = cchain = tmp;
+           }
+         else
+           cchain->chain = tmp;
+         while (cchain->chain != NULL)
+           cchain = cchain->chain;
+        }
+      else
+        {
+         SyntaxErrorMessage(theEnv,"instance-set query class restrictions");
+         DeleteQueryClasses(theEnv,clist);
+         SetEvaluationError(theEnv,true);
+         return NULL;
+        }
+      classExp = classExp->nextArg;
+     }
+   return(clist);
+  }
+
+/*************************************************************
+  NAME         : FormChain
+  DESCRIPTION  : Builds a list of classes to be used in
+                   instance queries - uses parse form.
+  INPUTS       : 1) Name of calling function for error msgs
+                 2) Data object - must be a symbol or a
+                      multifield value containing all symbols
+                 The symbols must be names of existing classes
+  RETURNS      : The query chain, or NULL on errors
+  SIDE EFFECTS : Memory allocated for chain
+                 Busy count incremented for all classes
+  NOTES        : None
+ *************************************************************/
+static QUERY_CLASS *FormChain(
+  Environment *theEnv,
+  const char *func,
+  Defclass *theClass,
+  UDFValue *val)
+  {
+   Defclass *cls;
+   QUERY_CLASS *head,*bot,*tmp;
+   size_t i;
+   const char *className;
+   Defmodule *currentModule;
+
+   currentModule = GetCurrentModule(theEnv);
+   if (theClass != NULL)
+     {
+      IncrementDefclassBusyCount(theEnv,theClass);
+      head = get_struct(theEnv,query_class);
+      head->cls = theClass;
+      if (DefclassInScope(theEnv,head->cls,currentModule))
+        head->theModule = currentModule;
+      else
+        head->theModule = head->cls->header.whichModule->theModule;
+      head->chain = NULL;
+      head->nxt = NULL;
+      return(head);
+     }
+
+   if (val->header->type == SYMBOL_TYPE)
+     {
+      /* ===============================================
+         Allow instance-set query restrictions to have a
+         module specifier as part of the class name,
+         but search imported defclasses too if a
+         module specifier is not given
+         =============================================== */
+      cls = LookupDefclassByMdlOrScope(theEnv,val->lexemeValue->contents);
+      if (cls == NULL)
+        {
+         ClassExistError(theEnv,func,val->lexemeValue->contents);
+         return NULL;
+        }
+      IncrementDefclassBusyCount(theEnv,(Defclass *) cls);
+      head = get_struct(theEnv,query_class);
+      head->cls = cls;
+      if (DefclassInScope(theEnv,head->cls,currentModule))
+        head->theModule = currentModule;
+      else
+        head->theModule = head->cls->header.whichModule->theModule;
+      head->chain = NULL;
+      head->nxt = NULL;
+      return(head);
+     }
+
+   if (val->header->type == MULTIFIELD_TYPE)
+     {
+      head = bot = NULL;
+      for (i = val->begin ; i < (val->begin + val->range) ; i++)
+        {
+         if (val->multifieldValue->contents[i].header->type == SYMBOL_TYPE)
+           {
+            className = val->multifieldValue->contents[i].lexemeValue->contents;
+            cls = LookupDefclassByMdlOrScope(theEnv,className);
+            if (cls == NULL)
+              {
+               ClassExistError(theEnv,func,className);
+               DeleteQueryClasses(theEnv,head);
+               return NULL;
+              }
+           }
+         else
+           {
+            DeleteQueryClasses(theEnv,head);
+            return NULL;
+           }
+         IncrementDefclassBusyCount(theEnv,(Defclass *) cls);
+         tmp = get_struct(theEnv,query_class);
+         tmp->cls = cls;
+         if (DefclassInScope(theEnv,tmp->cls,currentModule))
+           tmp->theModule = currentModule;
+         else
+           tmp->theModule = tmp->cls->header.whichModule->theModule;
+         tmp->chain = NULL;
+         tmp->nxt = NULL;
+         if (head == NULL)
+           head = tmp;
+         else
+           bot->chain = tmp;
+         bot = tmp;
+        }
+      return(head);
+     }
+   return NULL;
+  }
+
+/******************************************************
+  NAME         : DeleteQueryClasses
+  DESCRIPTION  : Deletes a query class-list
+  INPUTS       : The query list address
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Nodes deallocated
+                 Busy count decremented for all classes
+  NOTES        : None
+ ******************************************************/
+static void DeleteQueryClasses(
+  Environment *theEnv,
+  QUERY_CLASS *qlist)
+  {
+   QUERY_CLASS *tmp;
+
+   while (qlist != NULL)
+     {
+      while (qlist->chain != NULL)
+        {
+         tmp = qlist->chain;
+         qlist->chain = qlist->chain->chain;
+         DecrementDefclassBusyCount(theEnv,(Defclass *) tmp->cls);
+         rtn_struct(theEnv,query_class,tmp);
+        }
+      tmp = qlist;
+      qlist = qlist->nxt;
+      DecrementDefclassBusyCount(theEnv,(Defclass *) tmp->cls);
+      rtn_struct(theEnv,query_class,tmp);
+     }
+  }
+
+/************************************************************
+  NAME         : TestForFirstInChain
+  DESCRIPTION  : Processes all classes in a restriction chain
+                   until success or done
+  INPUTS       : 1) The current chain
+                 2) The index of the chain restriction
+                     (e.g. the 4th query-variable)
+  RETURNS      : True if query succeeds, false otherwise
+  SIDE EFFECTS : Sets current restriction class
+                 Instance variable values set
+  NOTES        : None
+ ************************************************************/
+static bool TestForFirstInChain(
+  Environment *theEnv,
+  QUERY_CLASS *qchain,
+  unsigned indx)
+  {
+   QUERY_CLASS *qptr;
+   int id;
+
+   InstanceQueryData(theEnv)->AbortQuery = true;
+   for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain)
+     {
+      InstanceQueryData(theEnv)->AbortQuery = false;
+      if ((id = GetTraversalID(theEnv)) == -1)
+        return false;
+      if (TestForFirstInstanceInClass(theEnv,qptr->theModule,id,qptr->cls,qchain,indx))
+        {
+         ReleaseTraversalID(theEnv);
+         return true;
+        }
+      ReleaseTraversalID(theEnv);
+      if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true))
+        return false;
+     }
+   return false;
+  }
+
+/*****************************************************************
+  NAME         : TestForFirstInstanceInClass
+  DESCRIPTION  : Processes all instances in a class and then
+                   all subclasses of a class until success or done
+  INPUTS       : 1) The module for which classes tested must be
+                    in scope
+                 2) Visitation traversal id
+                 3) The class
+                 4) The current class restriction chain
+                 5) The index of the current restriction
+  RETURNS      : True if query succeeds, false otherwise
+  SIDE EFFECTS : Instance variable values set
+  NOTES        : None
+ *****************************************************************/
+static bool TestForFirstInstanceInClass(
+  Environment *theEnv,
+  Defmodule *theModule,
+  int id,
+  Defclass *cls,
+  QUERY_CLASS *qchain,
+  unsigned indx)
+  {
+   unsigned long i;
+   Instance *ins;
+   UDFValue temp;
+   GCBlock gcb;
+   unsigned j;
+
+   if (TestTraversalID(cls->traversalRecord,id))
+     return false;
+   SetTraversalID(cls->traversalRecord,id);
+   if (DefclassInScope(theEnv,cls,theModule) == false)
+     return false;
+
+   GCBlockStart(theEnv,&gcb);
+
+   ins = cls->instanceList;
+   while (ins != NULL)
+     {
+      InstanceQueryData(theEnv)->QueryCore->solns[indx] = ins;
+      if (qchain->nxt != NULL)
+        {
+         ins->busy++;
+         if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == true)
+           {
+            ins->busy--;
+            break;
+           }
+         ins->busy--;
+         if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true))
+           break;
+        }
+      else
+        {
+         for (j = 0; j < indx; j++)
+           {
+            if (InstanceQueryData(theEnv)->QueryCore->solns[j]->garbage)
+              {
+               ins = NULL;
+               goto endTest;
+              }
+           }
+           
+         ins->busy++;
+         EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->query,&temp);
+         ins->busy--;
+         if (EvaluationData(theEnv)->HaltExecution == true)
+           break;
+         if (temp.value != FalseSymbol(theEnv))
+           break;
+        }
+
+      CleanCurrentGarbageFrame(theEnv,NULL);
+      CallPeriodicTasks(theEnv);
+
+      ins = ins->nxtClass;
+      while ((ins != NULL) ? (ins->garbage == 1) : false)
+        ins = ins->nxtClass;
+     }
+     
+   endTest:
+
+   GCBlockEnd(theEnv,&gcb);
+   CallPeriodicTasks(theEnv);
+
+   if (ins != NULL)
+     return(((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true))
+             ? false : true);
+   for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
+     {
+      if (TestForFirstInstanceInClass(theEnv,theModule,id,cls->directSubclasses.classArray[i],
+                                      qchain,indx))
+        return true;
+      if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true))
+        return false;
+     }
+   return false;
+  }
+
+/************************************************************
+  NAME         : TestEntireChain
+  DESCRIPTION  : Processes all classes in a restriction chain
+                   until done
+  INPUTS       : 1) The current chain
+                 2) The index of the chain restriction
+                     (i.e. the 4th query-variable)
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Sets current restriction class
+                 Query instance variables set
+                 Solution sets stored in global list
+  NOTES        : None
+ ************************************************************/
+static void TestEntireChain(
+  Environment *theEnv,
+  QUERY_CLASS *qchain,
+  unsigned indx)
+  {
+   QUERY_CLASS *qptr;
+   int id;
+
+   InstanceQueryData(theEnv)->AbortQuery = true;
+   for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain)
+     {
+      InstanceQueryData(theEnv)->AbortQuery = false;
+      if ((id = GetTraversalID(theEnv)) == -1)
+        return;
+      TestEntireClass(theEnv,qptr->theModule,id,qptr->cls,qchain,indx);
+      ReleaseTraversalID(theEnv);
+      if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true))
+        return;
+     }
+  }
+
+/*****************************************************************
+  NAME         : TestEntireClass
+  DESCRIPTION  : Processes all instances in a class and then
+                   all subclasses of a class until done
+  INPUTS       : 1) The module for which classes tested must be
+                    in scope
+                 2) Visitation traversal id
+                 3) The class
+                 4) The current class restriction chain
+                 5) The index of the current restriction
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Instance variable values set
+                 Solution sets stored in global list
+  NOTES        : None
+ *****************************************************************/
+static void TestEntireClass(
+  Environment *theEnv,
+  Defmodule *theModule,
+  int id,
+  Defclass *cls,
+  QUERY_CLASS *qchain,
+  unsigned indx)
+  {
+   unsigned long i;
+   Instance *ins;
+   UDFValue temp;
+   GCBlock gcb;
+   unsigned j;
+   
+   if (TestTraversalID(cls->traversalRecord,id))
+     return;
+   SetTraversalID(cls->traversalRecord,id);
+   if (DefclassInScope(theEnv,cls,theModule) == false)
+     return;
+
+   GCBlockStart(theEnv,&gcb);
+
+   ins = cls->instanceList;
+   while (ins != NULL)
+     {
+      InstanceQueryData(theEnv)->QueryCore->solns[indx] = ins;
+      if (qchain->nxt != NULL)
+        {
+         ins->busy++;
+         TestEntireChain(theEnv,qchain->nxt,indx+1);
+         ins->busy--;
+         if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true))
+           break;
+        }
+      else
+        {
+         for (j = 0; j < indx; j++)
+           {
+            if (InstanceQueryData(theEnv)->QueryCore->solns[j]->garbage)
+              { goto endTest; }
+           }
+
+         ins->busy++;
+
+         EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->query,&temp);
+
+         ins->busy--;
+         if (EvaluationData(theEnv)->HaltExecution == true)
+           break;
+         if (temp.value != FalseSymbol(theEnv))
+           {
+            if (InstanceQueryData(theEnv)->QueryCore->action != NULL)
+              {
+               ins->busy++;
+
+               ReleaseUDFV(theEnv,InstanceQueryData(theEnv)->QueryCore->result);
+               EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,InstanceQueryData(theEnv)->QueryCore->result);
+               RetainUDFV(theEnv,InstanceQueryData(theEnv)->QueryCore->result);
+
+               ins->busy--;
+               if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
+                 {
+                  InstanceQueryData(theEnv)->AbortQuery = true;
+                  break;
+                 }
+               if (EvaluationData(theEnv)->HaltExecution == true)
+                 break;
+              }
+            else
+              AddSolution(theEnv);
+           }
+        }
+
+      ins = ins->nxtClass;
+      while ((ins != NULL) ? (ins->garbage == 1) : false)
+        ins = ins->nxtClass;
+
+      CleanCurrentGarbageFrame(theEnv,NULL);
+      CallPeriodicTasks(theEnv);
+     }
+     
+   endTest:
+   
+   GCBlockEnd(theEnv,&gcb);
+   CallPeriodicTasks(theEnv);
+
+   if (ins != NULL)
+     return;
+   for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
+     {
+      TestEntireClass(theEnv,theModule,id,cls->directSubclasses.classArray[i],qchain,indx);
+      if ((EvaluationData(theEnv)->HaltExecution == true) || (InstanceQueryData(theEnv)->AbortQuery == true))
+        return;
+     }
+  }
+
+/***************************************************************************
+  NAME         : AddSolution
+  DESCRIPTION  : Adds the current instance set to a global list of
+                   solutions
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Global list and count updated
+  NOTES        : Solutions are stored as sequential arrays of Instance *
+ ***************************************************************************/
+static void AddSolution(
+  Environment *theEnv)
+  {
+   QUERY_SOLN *new_soln;
+   unsigned i;
+
+   new_soln = (QUERY_SOLN *) gm2(theEnv,sizeof(QUERY_SOLN));
+   new_soln->soln = (Instance **)
+                    gm2(theEnv,(sizeof(Instance *) * (InstanceQueryData(theEnv)->QueryCore->soln_size)));
+   for (i = 0 ; i < InstanceQueryData(theEnv)->QueryCore->soln_size ; i++)
+     new_soln->soln[i] = InstanceQueryData(theEnv)->QueryCore->solns[i];
+   new_soln->nxt = NULL;
+   if (InstanceQueryData(theEnv)->QueryCore->soln_set == NULL)
+     InstanceQueryData(theEnv)->QueryCore->soln_set = new_soln;
+   else
+     InstanceQueryData(theEnv)->QueryCore->soln_bottom->nxt = new_soln;
+   InstanceQueryData(theEnv)->QueryCore->soln_bottom = new_soln;
+   InstanceQueryData(theEnv)->QueryCore->soln_cnt++;
+  }
+
+/***************************************************
+  NAME         : PopQuerySoln
+  DESCRIPTION  : Deallocates the topmost solution
+                   set for an instance-set query
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Solution set deallocated
+  NOTES        : Assumes QueryCore->soln_set != 0
+ ***************************************************/
+static void PopQuerySoln(
+  Environment *theEnv)
+  {
+   InstanceQueryData(theEnv)->QueryCore->soln_bottom = InstanceQueryData(theEnv)->QueryCore->soln_set;
+   InstanceQueryData(theEnv)->QueryCore->soln_set = InstanceQueryData(theEnv)->QueryCore->soln_set->nxt;
+   rm(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_bottom->soln,
+      (sizeof(Instance *) * InstanceQueryData(theEnv)->QueryCore->soln_size));
+   rm(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_bottom,sizeof(QUERY_SOLN));
+  }
+
+#endif
+
+