clipsruby 0.0.2

data/ext/clipsruby/engine.c

@@ -0,0 +1,1568 @@
+   /*******************************************************/
+   /*      "C" Language Integrated Production System      */
+   /*                                                     */
+   /*            CLIPS Version 6.41  12/04/22             */
+   /*                                                     */
+   /*                    ENGINE MODULE                    */
+   /*******************************************************/
+
+/*************************************************************/
+/* Purpose: Provides functionality primarily associated with */
+/*   the run and focus commands.                             */
+/*                                                           */
+/* Principal Programmer(s):                                  */
+/*      Gary D. Riley                                        */
+/*                                                           */
+/* Contributing Programmer(s):                               */
+/*      Bebe Ly                                              */
+/*      Brian L. Dantes                                      */
+/*                                                           */
+/* Revision History:                                         */
+/*                                                           */
+/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
+/*                                                           */
+/*            Corrected compilation errors for files         */
+/*            generated by constructs-to-c. DR0861           */
+/*                                                           */
+/*      6.24: Removed DYNAMIC_SALIENCE, INCREMENTAL_RESET,   */
+/*            and LOGICAL_DEPENDENCIES compilation flags.    */
+/*                                                           */
+/*            Renamed BOOLEAN macro type to intBool.         */
+/*                                                           */
+/*            Added access functions to the HaltRules flag.  */
+/*                                                           */
+/*            Added EnvGetNextFocus, EnvGetFocusChanged, and */
+/*            EnvSetFocusChanged functions.                  */
+/*                                                           */
+/*      6.30: Added additional developer statistics to help  */
+/*            analyze join network performance.              */
+/*                                                           */
+/*            Removed pseudo-facts used in not CEs.          */
+/*                                                           */
+/*            Added context information for run functions.   */
+/*                                                           */
+/*            Added before rule firing callback function.    */
+/*                                                           */
+/*            Changed garbage collection algorithm.          */
+/*                                                           */
+/*            Changed integer type/precision.                */
+/*                                                           */
+/*            Added EnvHalt function.                        */
+/*                                                           */
+/*            Used gensprintf instead of sprintf.            */
+/*                                                           */
+/*            Removed conditional code for unsupported       */
+/*            compilers/operating systems (IBM_MCW,          */
+/*            MAC_MCW, and IBM_TBC).                         */
+/*            Added const qualifiers to remove C++           */
+/*            deprecation warnings.                          */
+/*                                                           */
+/*            Converted API macros to function calls.        */
+/*                                                           */
+/*      6.31: Fixed dangling construct issue.                */
+/*                                                           */
+/*      6.40: Added Env prefix to GetEvaluationError and     */
+/*            SetEvaluationError functions.                  */
+/*                                                           */
+/*            Added Env prefix to GetHaltExecution and       */
+/*            SetHaltExecution functions.                    */
+/*                                                           */
+/*            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. */
+/*                                                           */
+/*            Callbacks must be environment aware.           */
+/*                                                           */
+/*            Incremental reset is always enabled.           */
+/*                                                           */
+/*            UDF redesign.                                  */
+/*                                                           */
+/*            Added GCBlockStart and GCBlockEnd functions    */
+/*            for garbage collection blocks.                 */
+/*                                                           */
+/*      6.41: Used gensnprintf in place of gensprintf and.   */
+/*            sprintf.                                       */
+/*                                                           */
+/*************************************************************/
+
+#include <stdio.h>
+#include <string.h>
+
+#include "setup.h"
+
+#if DEFRULE_CONSTRUCT
+
+#include "agenda.h"
+#include "argacces.h"
+#include "commline.h"
+#include "constant.h"
+#include "envrnmnt.h"
+#include "factmngr.h"
+#include "inscom.h"
+#include "memalloc.h"
+#include "modulutl.h"
+#include "prccode.h"
+#include "prcdrfun.h"
+#include "prntutil.h"
+#include "proflfun.h"
+#include "reteutil.h"
+#include "retract.h"
+#include "router.h"
+#include "ruledlt.h"
+#include "sysdep.h"
+#include "utility.h"
+#include "watch.h"
+
+#include "engine.h"
+
+/***************************************/
+/* LOCAL INTERNAL FUNCTION DEFINITIONS */
+/***************************************/
+
+   static Defmodule              *RemoveFocus(Environment *,Defmodule *);
+   static void                    DeallocateEngineData(Environment *);
+
+/*****************************************************************************/
+/* InitializeEngine: Initializes the activations and statistics watch items. */
+/*****************************************************************************/
+void InitializeEngine(
+  Environment *theEnv)
+  {
+   AllocateEnvironmentData(theEnv,ENGINE_DATA,sizeof(struct engineData),DeallocateEngineData);
+
+#if DEBUGGING_FUNCTIONS
+   AddWatchItem(theEnv,"statistics",0,&EngineData(theEnv)->WatchStatistics,20,NULL,NULL);
+   AddWatchItem(theEnv,"focus",0,&EngineData(theEnv)->WatchFocus,0,NULL,NULL);
+#endif
+  }
+
+/*************************************************/
+/* DeallocateEngineData: Deallocates environment */
+/*    data for engine functionality.             */
+/*************************************************/
+static void DeallocateEngineData(
+  Environment *theEnv)
+  {
+   FocalModule *tmpPtr, *nextPtr;
+
+   DeallocateRuleFiredCallList(theEnv,EngineData(theEnv)->ListOfAfterRuleFiresFunctions);
+   DeallocateRuleFiredCallList(theEnv,EngineData(theEnv)->ListOfBeforeRuleFiresFunctions);
+
+   tmpPtr = EngineData(theEnv)->CurrentFocus;
+   while (tmpPtr != NULL)
+     {
+      nextPtr = tmpPtr->next;
+      rtn_struct(theEnv,focalModule,tmpPtr);
+      tmpPtr = nextPtr;
+     }
+  }
+
+/**********************************************/
+/* Run: C access routine for the run command. */
+/**********************************************/
+long long Run(
+  Environment *theEnv,
+  long long runLimit)
+  {
+   long long rulesFired = 0;
+   UDFValue returnValue;
+   RuleFiredFunctionItem *ruleFiresFunction;
+#if DEBUGGING_FUNCTIONS
+   unsigned long maxActivations = 0, sumActivations = 0;
+#if DEFTEMPLATE_CONSTRUCT
+   unsigned long maxFacts = 0, sumFacts = 0;
+#endif
+#if OBJECT_SYSTEM
+   unsigned long maxInstances = 0, sumInstances = 0;
+#endif
+#if (! GENERIC)
+   double endTime, startTime = 0.0;
+#endif
+   unsigned long tempValue;
+#endif
+   unsigned short i;
+   struct patternEntity *theMatchingItem;
+   struct partialMatch *theBasis = NULL;
+   Activation *theActivation;
+   const char *ruleFiring;
+#if PROFILING_FUNCTIONS
+   struct profileFrameInfo profileFrame;
+#endif
+   struct trackedMemory *theTM;
+   int danglingConstructs;
+   GCBlock gcb;
+   bool error = false;
+
+   /*=====================================================*/
+   /* Make sure the run command is not already executing. */
+   /*=====================================================*/
+
+   if (EngineData(theEnv)->AlreadyRunning)
+     { return 0; }
+   EngineData(theEnv)->AlreadyRunning = true;
+
+   /*========================================*/
+   /* Set up the frame for tracking garbage. */
+   /*========================================*/
+
+   GCBlockStart(theEnv,&gcb);
+
+   /*================================*/
+   /* Set up statistics information. */
+   /*================================*/
+
+#if DEBUGGING_FUNCTIONS
+   if (EngineData(theEnv)->WatchStatistics)
+     {
+#if DEFTEMPLATE_CONSTRUCT
+      maxFacts = GetNumberOfFacts(theEnv);
+      sumFacts = maxFacts;
+#endif
+#if OBJECT_SYSTEM
+      maxInstances = GetGlobalNumberOfInstances(theEnv);
+      sumInstances = maxInstances;
+#endif
+      maxActivations = GetNumberOfActivations(theEnv);
+      sumActivations = maxActivations;
+#if (! GENERIC)
+      startTime = gentime();
+#endif
+     }
+#endif
+
+   /*=====================================*/
+   /* If embedded, clear the error flags. */
+   /*=====================================*/
+   
+   if (EvaluationData(theEnv)->CurrentExpression == NULL)
+     { ResetErrorFlags(theEnv); }
+
+   /*=============================*/
+   /* Set up execution variables. */
+   /*=============================*/
+
+   EngineData(theEnv)->HaltRules = false;
+
+#if DEVELOPER
+   EngineData(theEnv)->leftToRightComparisons = 0;
+   EngineData(theEnv)->rightToLeftComparisons = 0;
+   EngineData(theEnv)->leftToRightSucceeds = 0;
+   EngineData(theEnv)->rightToLeftSucceeds = 0;
+   EngineData(theEnv)->leftToRightLoops = 0;
+   EngineData(theEnv)->rightToLeftLoops = 0;
+   EngineData(theEnv)->findNextConflictingComparisons = 0;
+   EngineData(theEnv)->betaHashListSkips = 0;
+   EngineData(theEnv)->betaHashHTSkips = 0;
+   EngineData(theEnv)->unneededMarkerCompare = 0;
+#endif
+
+   /*=====================================================*/
+   /* Fire rules until the agenda is empty, the run limit */
+   /* has been reached, or a rule execution error occurs. */
+   /*=====================================================*/
+
+   theActivation = NextActivationToFire(theEnv);
+   while ((theActivation != NULL) &&
+          (runLimit != 0) &&
+          (EvaluationData(theEnv)->HaltExecution == false) &&
+          (EngineData(theEnv)->HaltRules == false))
+     {
+      /*========================================*/
+      /* Execute the list of functions that are */
+      /* to be called before each rule firing.  */
+      /*========================================*/
+
+      for (ruleFiresFunction = EngineData(theEnv)->ListOfBeforeRuleFiresFunctions;
+           ruleFiresFunction != NULL;
+           ruleFiresFunction = ruleFiresFunction->next)
+        {
+         (*ruleFiresFunction->func)(theEnv,theActivation,ruleFiresFunction->context);
+        }
+
+      /*===========================================*/
+      /* Detach the activation from the agenda and */
+      /* determine which rule is firing.           */
+      /*===========================================*/
+
+      DetachActivation(theEnv,theActivation);
+      theTM = AddTrackedMemory(theEnv,theActivation,sizeof(struct activation));
+      ruleFiring = ActivationRuleName(theActivation);
+      theBasis = (struct partialMatch *) GetActivationBasis(theEnv,theActivation);
+      EngineData(theEnv)->ExecutingRule = GetActivationRule(theEnv,theActivation);
+
+      /*=============================================*/
+      /* Update the number of rules that have fired. */
+      /*=============================================*/
+
+      rulesFired++;
+      if (runLimit > 0) { runLimit--; }
+
+      /*==================================*/
+      /* If rules are being watched, then */
+      /* print an information message.    */
+      /*==================================*/
+
+#if DEBUGGING_FUNCTIONS
+      if (EngineData(theEnv)->ExecutingRule->watchFiring)
+        {
+         char printSpace[60];
+
+         gensnprintf(printSpace,sizeof(printSpace),"FIRE %4lld ",rulesFired);
+         WriteString(theEnv,STDOUT,printSpace);
+         WriteString(theEnv,STDOUT,ruleFiring);
+         WriteString(theEnv,STDOUT,": ");
+         PrintPartialMatch(theEnv,STDOUT,theBasis);
+         WriteString(theEnv,STDOUT,"\n");
+        }
+#endif
+
+      /*=================================================*/
+      /* Remove the link between the activation and the  */
+      /* completed match for the rule. Set the busy flag */
+      /* for the completed match to true (so the match   */
+      /* upon which our RHS variables are dependent is   */
+      /* not deleted while our rule is firing). Set up   */
+      /* the global pointers to the completed match for  */
+      /* routines which do variable extractions.         */
+      /*=================================================*/
+
+      theBasis->marker = NULL;
+      theBasis->busy = true;
+
+      EngineData(theEnv)->GlobalLHSBinds = theBasis;
+      EngineData(theEnv)->GlobalRHSBinds = NULL;
+
+      /*===================================================================*/
+      /* Increment the count for each of the facts/objects associated with */
+      /* the rule activation so that the facts/objects cannot be deleted   */
+      /* by garbage collection while the rule is executing.                */
+      /*===================================================================*/
+
+      for (i = 0; i < theBasis->bcount; i++)
+        {
+         if (theBasis->binds[i].gm.theMatch == NULL) continue;
+         theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem;
+         if (theMatchingItem != NULL)
+           { (*theMatchingItem->theInfo->incrementBasisCount)(theEnv,theMatchingItem); }
+        }
+
+      /*====================================================*/
+      /* If the rule has logical CEs, set up the pointer to */
+      /* the rules logical join so the assert command will  */
+      /* attach the appropriate dependencies to the facts.  */
+      /*====================================================*/
+
+      EngineData(theEnv)->TheLogicalJoin = EngineData(theEnv)->ExecutingRule->logicalJoin;
+
+      if (EngineData(theEnv)->TheLogicalJoin != NULL)
+        {
+         EngineData(theEnv)->TheLogicalBind = FindLogicalBind(EngineData(theEnv)->TheLogicalJoin,EngineData(theEnv)->GlobalLHSBinds);
+         EngineData(theEnv)->TheLogicalBind->busy = true;
+        }
+      else
+        { EngineData(theEnv)->TheLogicalBind = NULL; }
+
+      /*=============================================*/
+      /* Execute the rule's right hand side actions. */
+      /*=============================================*/
+
+      EvaluationData(theEnv)->CurrentEvaluationDepth++;
+      SetEvaluationError(theEnv,false);
+      EngineData(theEnv)->ExecutingRule->executing = true;
+      danglingConstructs = ConstructData(theEnv)->DanglingConstructs;
+
+#if PROFILING_FUNCTIONS
+      StartProfile(theEnv,&profileFrame,
+                   &EngineData(theEnv)->ExecutingRule->header.usrData,
+                   ProfileFunctionData(theEnv)->ProfileConstructs);
+#endif
+
+      EvaluateProcActions(theEnv,EngineData(theEnv)->ExecutingRule->header.whichModule->theModule,
+                          EngineData(theEnv)->ExecutingRule->actions,EngineData(theEnv)->ExecutingRule->localVarCnt,
+                          &returnValue,NULL);
+
+#if PROFILING_FUNCTIONS
+      EndProfile(theEnv,&profileFrame);
+#endif
+
+      error = GetEvaluationError(theEnv);
+      EngineData(theEnv)->ExecutingRule->executing = false;
+      SetEvaluationError(theEnv,false);
+      EvaluationData(theEnv)->CurrentEvaluationDepth--;
+      if (EvaluationData(theEnv)->CurrentExpression == NULL)
+        { ConstructData(theEnv)->DanglingConstructs = danglingConstructs; }
+        
+      /*========================================*/
+      /* Execute the list of functions that are */
+      /* to be called after each rule firing.   */
+      /*========================================*/
+
+      for (ruleFiresFunction = EngineData(theEnv)->ListOfAfterRuleFiresFunctions;
+           ruleFiresFunction != NULL;
+           ruleFiresFunction = ruleFiresFunction->next)
+        { (*ruleFiresFunction->func)(theEnv,theActivation,ruleFiresFunction->context); }
+
+      /*=====================================*/
+      /* Remove information for logical CEs. */
+      /*=====================================*/
+
+      EngineData(theEnv)->TheLogicalJoin = NULL;
+
+      if (EngineData(theEnv)->TheLogicalBind != NULL)
+        {
+         EngineData(theEnv)->TheLogicalBind->busy = false;
+         EngineData(theEnv)->TheLogicalBind = NULL;
+        }
+
+      /*=====================================================*/
+      /* If rule execution was halted, then print a message. */
+      /*=====================================================*/
+
+#if DEBUGGING_FUNCTIONS
+      if ((EvaluationData(theEnv)->HaltExecution) || (EngineData(theEnv)->HaltRules && EngineData(theEnv)->ExecutingRule->watchFiring))
+#else
+      if ((EvaluationData(theEnv)->HaltExecution) || (EngineData(theEnv)->HaltRules))
+#endif
+
+        {
+         const char *logName;
+
+         if (error)
+           {
+            PrintErrorID(theEnv,"PRCCODE",4,false);
+            logName = STDERR;
+           }
+         else
+           {
+            PrintWarningID(theEnv,"PRCCODE",4,false);
+            logName = STDWRN;
+           }
+
+         WriteString(theEnv,logName,"Execution halted during the actions of defrule '");
+         WriteString(theEnv,logName,ruleFiring);
+         WriteString(theEnv,logName,"'.\n");
+        }
+
+      /*===================================================*/
+      /* Decrement the count for each of the facts/objects */
+      /* associated with the rule activation.              */
+      /*===================================================*/
+
+      theBasis->busy = false;
+
+      for (i = 0; i < (theBasis->bcount); i++)
+        {
+         if (theBasis->binds[i].gm.theMatch == NULL) continue;
+         theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem;
+         if (theMatchingItem != NULL)
+           { (*theMatchingItem->theInfo->decrementBasisCount)(theEnv,theMatchingItem); }
+        }
+
+      /*========================================*/
+      /* Return the agenda node to free memory. */
+      /*========================================*/
+
+      RemoveTrackedMemory(theEnv,theTM);
+      RemoveActivation(theEnv,theActivation,false,false);
+
+      /*======================================*/
+      /* Get rid of partial matches discarded */
+      /* while executing the rule's RHS.      */
+      /*======================================*/
+
+      FlushGarbagePartialMatches(theEnv);
+
+      /*==================================*/
+      /* Get rid of other garbage created */
+      /* while executing the rule's RHS.  */
+      /*==================================*/
+
+      CleanCurrentGarbageFrame(theEnv,NULL);
+      CallPeriodicTasks(theEnv);
+
+      /*==========================*/
+      /* Keep up with statistics. */
+      /*==========================*/
+
+#if DEBUGGING_FUNCTIONS
+      if (EngineData(theEnv)->WatchStatistics)
+        {
+#if DEFTEMPLATE_CONSTRUCT
+         tempValue = GetNumberOfFacts(theEnv);
+         if (tempValue > maxFacts) maxFacts = tempValue;
+         sumFacts += tempValue;
+#endif
+#if OBJECT_SYSTEM
+         tempValue = GetGlobalNumberOfInstances(theEnv);
+         if (tempValue > maxInstances) maxInstances = tempValue;
+         sumInstances += tempValue;
+#endif
+         tempValue = GetNumberOfActivations(theEnv);
+         if (tempValue > maxActivations) maxActivations = tempValue;
+         sumActivations += tempValue;
+        }
+#endif
+
+      /*==================================*/
+      /* Update saliences if appropriate. */
+      /*==================================*/
+
+      if (GetSalienceEvaluation(theEnv) == EVERY_CYCLE)
+        { RefreshAllAgendas(theEnv); }
+
+      /*========================================*/
+      /* If a return was issued on the RHS of a */
+      /* rule, then remove *that* rule's module */
+      /* from the focus stack                   */
+      /*========================================*/
+
+      if (ProcedureFunctionData(theEnv)->ReturnFlag == true)
+        { RemoveFocus(theEnv,EngineData(theEnv)->ExecutingRule->header.whichModule->theModule); }
+      ProcedureFunctionData(theEnv)->ReturnFlag = false;
+
+      /*========================================*/
+      /* Determine the next activation to fire. */
+      /*========================================*/
+
+      theActivation = (struct activation *) NextActivationToFire(theEnv);
+
+      /*==============================*/
+      /* Check for a rule breakpoint. */
+      /*==============================*/
+
+      if (theActivation != NULL)
+        {
+         if (GetActivationRule(theEnv,theActivation)->afterBreakpoint)
+           {
+            EngineData(theEnv)->HaltRules = true;
+            WriteString(theEnv,STDOUT,"Breaking on rule ");
+            WriteString(theEnv,STDOUT,ActivationRuleName(theActivation));
+            WriteString(theEnv,STDOUT,".\n");
+           }
+        }
+     }
+
+   /*=====================================================*/
+   /* Make sure run functions are executed at least once. */
+   /*=====================================================*/
+
+   if (rulesFired == 0)
+     {
+      for (ruleFiresFunction = EngineData(theEnv)->ListOfAfterRuleFiresFunctions;
+           ruleFiresFunction != NULL;
+           ruleFiresFunction = ruleFiresFunction->next)
+        { (*ruleFiresFunction->func)(theEnv,NULL,ruleFiresFunction->context); }
+     }
+
+   /*======================================================*/
+   /* If rule execution was halted because the rule firing */
+   /* limit was reached, then print a message.             */
+   /*======================================================*/
+
+   if (runLimit == rulesFired)
+     { WriteString(theEnv,STDOUT,"rule firing limit reached\n"); }
+
+   /*==============================*/
+   /* Restore execution variables. */
+   /*==============================*/
+
+   EngineData(theEnv)->ExecutingRule = NULL;
+   EngineData(theEnv)->HaltRules = false;
+
+   /*=================================================*/
+   /* Print out statistics if they are being watched. */
+   /*=================================================*/
+
+#if DEBUGGING_FUNCTIONS
+   if (EngineData(theEnv)->WatchStatistics)
+     {
+#if DEFTEMPLATE_CONSTRUCT || OBJECT_SYSTEM || DEVELOPER
+      char printSpace[60];
+#endif
+#if (! GENERIC)
+      endTime = gentime();
+#endif
+
+      WriteInteger(theEnv,STDOUT,rulesFired);
+      WriteString(theEnv,STDOUT," rules fired");
+
+#if (! GENERIC)
+      if (startTime != endTime)
+        {
+         WriteString(theEnv,STDOUT,"        Run time is ");
+         WriteFloat(theEnv,STDOUT,endTime - startTime);
+         WriteString(theEnv,STDOUT," seconds.\n");
+         WriteFloat(theEnv,STDOUT,(double) rulesFired / (endTime - startTime));
+         WriteString(theEnv,STDOUT," rules per second.\n");
+        }
+      else
+        { WriteString(theEnv,STDOUT,"\n"); }
+#else
+      WriteString(theEnv,STDOUT,"\n");
+#endif
+
+#if DEFTEMPLATE_CONSTRUCT
+      gensnprintf(printSpace,sizeof(printSpace),"%ld mean number of facts (%ld maximum).\n",
+                          (long) (((double) sumFacts / (rulesFired + 1)) + 0.5),
+                          maxFacts);
+      WriteString(theEnv,STDOUT,printSpace);
+#endif
+
+#if OBJECT_SYSTEM
+      gensnprintf(printSpace,sizeof(printSpace),"%ld mean number of instances (%ld maximum).\n",
+                          (long) (((double) sumInstances / (rulesFired + 1)) + 0.5),
+                          maxInstances);
+      WriteString(theEnv,STDOUT,printSpace);
+#endif
+
+      gensnprintf(printSpace,sizeof(printSpace),"%ld mean number of activations (%ld maximum).\n",
+                          (long) (((double) sumActivations / (rulesFired + 1)) + 0.5),
+                          maxActivations);
+      WriteString(theEnv,STDOUT,printSpace);
+
+#if DEVELOPER
+      gensnprintf(printSpace,sizeof(printSpace),"%9ld left to right comparisons.\n",
+                          EngineData(theEnv)->leftToRightComparisons);
+      WriteString(theEnv,STDOUT,printSpace);
+
+      gensnprintf(printSpace,sizeof(printSpace),"%9ld left to right succeeds.\n",
+                          EngineData(theEnv)->leftToRightSucceeds);
+      WriteString(theEnv,STDOUT,printSpace);
+
+      gensnprintf(printSpace,sizeof(printSpace),"%9ld left to right loops.\n",
+                          EngineData(theEnv)->leftToRightLoops);
+      WriteString(theEnv,STDOUT,printSpace);
+
+      gensnprintf(printSpace,sizeof(printSpace),"%9ld right to left comparisons.\n",
+                          EngineData(theEnv)->rightToLeftComparisons);
+      WriteString(theEnv,STDOUT,printSpace);
+
+      gensnprintf(printSpace,sizeof(printSpace),"%9ld right to left succeeds.\n",
+                          EngineData(theEnv)->rightToLeftSucceeds);
+      WriteString(theEnv,STDOUT,printSpace);
+
+      gensnprintf(printSpace,sizeof(printSpace),"%9ld right to left loops.\n",
+                          EngineData(theEnv)->rightToLeftLoops);
+      WriteString(theEnv,STDOUT,printSpace);
+
+      gensnprintf(printSpace,sizeof(printSpace),"%9ld find next conflicting comparisons.\n",
+                          EngineData(theEnv)->findNextConflictingComparisons);
+      WriteString(theEnv,STDOUT,printSpace);
+
+      gensnprintf(printSpace,sizeof(printSpace),"%9ld beta hash list skips.\n",
+                          EngineData(theEnv)->betaHashListSkips);
+      WriteString(theEnv,STDOUT,printSpace);
+
+      gensnprintf(printSpace,sizeof(printSpace),"%9ld beta hash hash table skips.\n",
+                          EngineData(theEnv)->betaHashHTSkips);
+      WriteString(theEnv,STDOUT,printSpace);
+
+      gensnprintf(printSpace,sizeof(printSpace),"%9ld unneeded marker compare.\n",
+                          EngineData(theEnv)->unneededMarkerCompare);
+      WriteString(theEnv,STDOUT,printSpace);
+
+#endif
+     }
+#endif
+
+   /*==========================================*/
+   /* The current module should be the current */
+   /* focus when the run finishes.             */
+   /*==========================================*/
+
+   if (EngineData(theEnv)->CurrentFocus != NULL)
+     {
+      if (EngineData(theEnv)->CurrentFocus->theModule != GetCurrentModule(theEnv))
+        { SetCurrentModule(theEnv,EngineData(theEnv)->CurrentFocus->theModule); }
+     }
+
+   /*================================*/
+   /* Restore the old garbage frame. */
+   /*================================*/
+
+   GCBlockEnd(theEnv,&gcb);
+   CallPeriodicTasks(theEnv);
+
+   /*===================================*/
+   /* Return the number of rules fired. */
+   /*===================================*/
+
+   EngineData(theEnv)->AlreadyRunning = false;
+   return rulesFired;
+  }
+
+/***********************************************************/
+/* NextActivationToFire: Returns the next activation which */
+/*   should be executed based on the current focus.        */
+/***********************************************************/
+Activation *NextActivationToFire(
+  Environment *theEnv)
+  {
+   struct activation *theActivation;
+   Defmodule *theModule;
+
+   /*====================================*/
+   /* If there is no current focus, then */
+   /* focus on the MAIN module.          */
+   /*====================================*/
+
+   if (EngineData(theEnv)->CurrentFocus == NULL)
+     {
+      theModule = FindDefmodule(theEnv,"MAIN");
+      Focus(theModule);
+     }
+
+   /*===========================================================*/
+   /* Determine the top activation on the agenda of the current */
+   /* focus. If the current focus has no activations on its     */
+   /* agenda, then pop the focus off the focus stack until      */
+   /* a focus that has an activation on its agenda is found.    */
+   /*===========================================================*/
+
+   theActivation = EngineData(theEnv)->CurrentFocus->theDefruleModule->agenda;
+   while ((theActivation == NULL) && (EngineData(theEnv)->CurrentFocus != NULL))
+     {
+      if (EngineData(theEnv)->CurrentFocus != NULL) PopFocus(theEnv);
+      if (EngineData(theEnv)->CurrentFocus != NULL) theActivation = EngineData(theEnv)->CurrentFocus->theDefruleModule->agenda;
+     }
+
+   /*=========================================*/
+   /* Return the next activation to be fired. */
+   /*=========================================*/
+
+   return(theActivation);
+  }
+
+/***************************************************/
+/* RemoveFocus: Removes the first occurence of the */
+/*   specified module from the focus stack.        */
+/***************************************************/
+static Defmodule *RemoveFocus(
+  Environment *theEnv,
+  Defmodule *theModule)
+  {
+   FocalModule *tempFocus,*prevFocus, *nextFocus;
+   bool found = false;
+   bool currentFocusRemoved = false;
+
+   /*====================================*/
+   /* Return NULL if there is nothing on */
+   /* the focus stack to remove.         */
+   /*====================================*/
+
+   if (EngineData(theEnv)->CurrentFocus == NULL) return NULL;
+
+   /*=============================================*/
+   /* Remove the first occurence of the specified */
+   /* module from the focus stack.                */
+   /*=============================================*/
+
+   prevFocus = NULL;
+   tempFocus = EngineData(theEnv)->CurrentFocus;
+   while ((tempFocus != NULL) && (! found))
+     {
+      if (tempFocus->theModule == theModule)
+        {
+         found = true;
+
+         nextFocus = tempFocus->next;
+         rtn_struct(theEnv,focalModule,tempFocus);
+         tempFocus = nextFocus;
+
+         if (prevFocus == NULL)
+           {
+            currentFocusRemoved = true;
+            EngineData(theEnv)->CurrentFocus = tempFocus;
+           }
+         else
+           { prevFocus->next = tempFocus; }
+        }
+      else
+        {
+         prevFocus = tempFocus;
+         tempFocus = tempFocus->next;
+        }
+     }
+
+   /*=========================================*/
+   /* If the given module is not in the focus */
+   /* stack, simply return the current focus  */
+   /*=========================================*/
+
+   if (! found) return EngineData(theEnv)->CurrentFocus->theModule;
+
+   /*========================================*/
+   /* If the current focus is being watched, */
+   /* then print an informational message.   */
+   /*========================================*/
+
+#if DEBUGGING_FUNCTIONS
+   if (EngineData(theEnv)->WatchFocus &&
+       (! ConstructData(theEnv)->ClearReadyInProgress) &&
+       (! ConstructData(theEnv)->ClearInProgress))
+     {
+      WriteString(theEnv,STDOUT,"<== Focus ");
+      WriteString(theEnv,STDOUT,theModule->header.name->contents);
+
+      if ((EngineData(theEnv)->CurrentFocus != NULL) && currentFocusRemoved)
+        {
+         WriteString(theEnv,STDOUT," to ");
+         WriteString(theEnv,STDOUT,EngineData(theEnv)->CurrentFocus->theModule->header.name->contents);
+        }
+
+      WriteString(theEnv,STDOUT,"\n");
+     }
+#endif
+
+   /*======================================================*/
+   /* Set the current module to the module associated with */
+   /* the current focus (if it changed) and set a boolean  */
+   /* flag indicating that the focus has changed.          */
+   /*======================================================*/
+
+   if ((EngineData(theEnv)->CurrentFocus != NULL) && currentFocusRemoved)
+     { SetCurrentModule(theEnv,EngineData(theEnv)->CurrentFocus->theModule); }
+   EngineData(theEnv)->FocusChanged = true;
+
+   /*====================================*/
+   /* Return the module that was removed */
+   /* from the focus stack.              */
+   /*====================================*/
+
+   return(theModule);
+  }
+
+/**********************************************************/
+/* PopFocus: C access routine for the pop-focus function. */
+/**********************************************************/
+Defmodule *PopFocus(
+  Environment *theEnv)
+  {
+   if (EngineData(theEnv)->CurrentFocus == NULL) return NULL;
+   return RemoveFocus(theEnv,EngineData(theEnv)->CurrentFocus->theModule);
+  }
+
+/************************************************************/
+/* GetNextFocus: Returns the next focus on the focus stack. */
+/************************************************************/
+FocalModule *GetNextFocus(
+  Environment *theEnv,
+  FocalModule *theFocus)
+  {
+   /*==================================================*/
+   /* If NULL is passed as an argument, return the top */
+   /* focus on the focus stack (the current focus).    */
+   /*==================================================*/
+
+   if (theFocus == NULL) return EngineData(theEnv)->CurrentFocus;
+
+   /*=======================================*/
+   /* Otherwise, return the focus following */
+   /* the focus passed as an argument.      */
+   /*=======================================*/
+
+   return theFocus->next;
+  }
+
+/*********************************************************/
+/* FocalModuleName: Returns the name of the FocalModule. */
+/*********************************************************/
+const char *FocalModuleName(
+  FocalModule *theFocus)
+  {
+   return theFocus->theModule->header.name->contents;
+  }
+
+/****************************************************************/
+/* FocalModuleModule: Returns the Defmodule of the FocalModule. */
+/****************************************************************/
+Defmodule *FocalModuleModule(
+  FocalModule *theFocus)
+  {
+   return theFocus->theModule;
+  }
+
+/***************************************************/
+/* Focus: C access routine for the focus function. */
+/***************************************************/
+void Focus(
+  Defmodule *theModule)
+  {
+   FocalModule *tempFocus;
+   Environment *theEnv;
+   
+   if (theModule == NULL) return;
+    
+   theEnv = theModule->header.env;
+
+   /*==================================================*/
+   /* Make the specified module be the current module. */
+   /* If the specified module is the current focus,    */
+   /* then no further action is needed.                */
+   /*==================================================*/
+
+   SetCurrentModule(theEnv,theModule);
+   if (EngineData(theEnv)->CurrentFocus != NULL)
+     { if (EngineData(theEnv)->CurrentFocus->theModule == theModule) return; }
+
+   /*=====================================*/
+   /* If the focus is being watched, then */
+   /* print an information message.       */
+   /*=====================================*/
+
+#if DEBUGGING_FUNCTIONS
+   if (EngineData(theEnv)->WatchFocus &&
+       (! ConstructData(theEnv)->ClearReadyInProgress) &&
+       (! ConstructData(theEnv)->ClearInProgress))
+     {
+      WriteString(theEnv,STDOUT,"==> Focus ");
+      WriteString(theEnv,STDOUT,theModule->header.name->contents);
+      if (EngineData(theEnv)->CurrentFocus != NULL)
+        {
+         WriteString(theEnv,STDOUT," from ");
+         WriteString(theEnv,STDOUT,EngineData(theEnv)->CurrentFocus->theModule->header.name->contents);
+        }
+      WriteString(theEnv,STDOUT,"\n");
+     }
+#endif
+
+   /*=======================================*/
+   /* Add the new focus to the focus stack. */
+   /*=======================================*/
+
+   tempFocus = get_struct(theEnv,focalModule);
+   tempFocus->theModule = theModule;
+   tempFocus->theDefruleModule = GetDefruleModuleItem(theEnv,theModule);
+   tempFocus->next = EngineData(theEnv)->CurrentFocus;
+   EngineData(theEnv)->CurrentFocus = tempFocus;
+   EngineData(theEnv)->FocusChanged = true;
+  }
+
+/************************************************/
+/* ClearFocusStackCommand: H/L access routine   */
+/*   for the clear-focus-stack command.         */
+/************************************************/
+void ClearFocusStackCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   ClearFocusStack(theEnv);
+  }
+
+/****************************************/
+/* ClearFocusStack: C access routine    */
+/*   for the clear-focus-stack command. */
+/****************************************/
+void ClearFocusStack(
+  Environment *theEnv)
+  {
+   while (EngineData(theEnv)->CurrentFocus != NULL) PopFocus(theEnv);
+
+   EngineData(theEnv)->FocusChanged = true;
+  }
+
+/**********************************************/
+/* AddAfterRuleFiresFunction: Adds a function */
+/*   to the ListOfAfterRuleFiresFunctions.    */
+/**********************************************/
+bool AddAfterRuleFiresFunction(
+  Environment *theEnv,
+  const char *name,
+  RuleFiredFunction *functionPtr,
+  int priority,
+  void *context)
+  {
+   EngineData(theEnv)->ListOfAfterRuleFiresFunctions =
+      AddRuleFiredFunctionToCallList(theEnv,name,priority,functionPtr,
+                                     EngineData(theEnv)->ListOfAfterRuleFiresFunctions,context);
+   return true;
+  }
+
+/***********************************************/
+/* AddBeforeRuleFiresFunction: Adds a function */
+/*   to the ListOfBeforeRuleFiresFunctions.    */
+/***********************************************/
+bool AddBeforeRuleFiresFunction(
+  Environment *theEnv,
+  const char *name,
+  RuleFiredFunction *functionPtr,
+  int priority,
+  void *context)
+  {
+   EngineData(theEnv)->ListOfBeforeRuleFiresFunctions =
+      AddRuleFiredFunctionToCallList(theEnv,name,priority,functionPtr,
+                                     EngineData(theEnv)->ListOfBeforeRuleFiresFunctions,context);
+   return true;
+  }
+
+/****************************************************/
+/* RemoveAfterRuleFiresFunction: Removes a function */
+/*   from the ListOfAfterRuleFiresFunctions.        */
+/****************************************************/
+bool RemoveAfterRuleFiresFunction(
+  Environment *theEnv,
+  const char *name)
+  {
+   bool found;
+
+   EngineData(theEnv)->ListOfAfterRuleFiresFunctions =
+      RemoveRuleFiredFunctionFromCallList(theEnv,name,EngineData(theEnv)->ListOfAfterRuleFiresFunctions,&found);
+
+   return found;
+  }
+
+/*****************************************************/
+/* RemoveBeforeRuleFiresFunction: Removes a function */
+/*   from the ListOfBeforeRuleFiresFunctions.        */
+/*****************************************************/
+bool RemoveBeforeRuleFiresFunction(
+  Environment *theEnv,
+  const char *name)
+  {
+   bool found;
+
+   EngineData(theEnv)->ListOfBeforeRuleFiresFunctions =
+      RemoveRuleFiredFunctionFromCallList(theEnv,name,EngineData(theEnv)->ListOfBeforeRuleFiresFunctions,&found);
+
+   return found;
+  }
+
+/***************************************************/
+/* AddRuleFiredFunctionToCallList: Adds a function */
+/*   to a rule fired function list.                */
+/***************************************************/
+RuleFiredFunctionItem *AddRuleFiredFunctionToCallList(
+  Environment *theEnv,
+  const char *name,
+  int priority,
+  RuleFiredFunction *func,
+  RuleFiredFunctionItem *head,
+  void *context)
+  {
+   RuleFiredFunctionItem *newPtr, *currentPtr, *lastPtr = NULL;
+   char  *nameCopy;
+
+   newPtr = get_struct(theEnv,ruleFiredFunctionItem);
+
+   nameCopy = (char *) genalloc(theEnv,strlen(name) + 1);
+   genstrcpy(nameCopy,name);
+   newPtr->name = nameCopy;
+
+   newPtr->func = func;
+   newPtr->priority = priority;
+   newPtr->context = context;
+
+   if (head == NULL)
+     {
+      newPtr->next = NULL;
+      return newPtr;
+     }
+
+   currentPtr = head;
+   while ((currentPtr != NULL) ? (priority < currentPtr->priority) : false)
+     {
+      lastPtr = currentPtr;
+      currentPtr = currentPtr->next;
+     }
+
+   if (lastPtr == NULL)
+     {
+      newPtr->next = head;
+      head = newPtr;
+     }
+   else
+     {
+      newPtr->next = currentPtr;
+      lastPtr->next = newPtr;
+     }
+
+   return head;
+  }
+
+/***********************************************************/
+/* RemoveRuleFiredFunctionFromCallList: Removes a function */
+/*   from a rule fired function list.                      */
+/***********************************************************/
+RuleFiredFunctionItem *RemoveRuleFiredFunctionFromCallList(
+  Environment *theEnv,
+  const char *name,
+  RuleFiredFunctionItem *head,
+  bool *found)
+  {
+   RuleFiredFunctionItem *currentPtr, *lastPtr;
+
+   *found = false;
+   lastPtr = NULL;
+   currentPtr = head;
+
+   while (currentPtr != NULL)
+     {
+      if (strcmp(name,currentPtr->name) == 0)
+        {
+         *found = true;
+         if (lastPtr == NULL)
+           { head = currentPtr->next; }
+         else
+           { lastPtr->next = currentPtr->next; }
+
+         genfree(theEnv,(void *) currentPtr->name,strlen(currentPtr->name) + 1);
+         rtn_struct(theEnv,voidCallFunctionItem,currentPtr);
+         return head;
+        }
+
+      lastPtr = currentPtr;
+      currentPtr = currentPtr->next;
+     }
+
+   return head;
+  }
+
+/******************************************************/
+/* DeallocateRuleFiredCallList: Removes all functions */
+/*   from a list of rule fired functions.             */
+/******************************************************/
+void DeallocateRuleFiredCallList(
+  Environment *theEnv,
+  RuleFiredFunctionItem *theList)
+  {
+   RuleFiredFunctionItem *tmpPtr, *nextPtr;
+
+   tmpPtr = theList;
+   while (tmpPtr != NULL)
+     {
+      nextPtr = tmpPtr->next;
+      genfree(theEnv,(void *) tmpPtr->name,strlen(tmpPtr->name) + 1);
+      rtn_struct(theEnv,ruleFiredFunctionItem,tmpPtr);
+      tmpPtr = nextPtr;
+     }
+  }
+
+/*******************************************************/
+/* RunCommand: H/L access routine for the run command. */
+/*******************************************************/
+void RunCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   unsigned int numArgs;
+   long long runLimit = -1LL;
+   UDFValue theArg;
+
+   numArgs = UDFArgumentCount(context);
+   if (numArgs == 0)
+     { runLimit = -1LL; }
+   else if (numArgs == 1)
+     {
+      if (! UDFFirstArgument(context,INTEGER_BIT,&theArg)) return;
+      runLimit = theArg.integerValue->contents;
+     }
+
+   Run(theEnv,runLimit);
+  }
+
+/***********************************************/
+/* HaltCommand: Causes rule execution to halt. */
+/***********************************************/
+void HaltCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   Halt(theEnv);
+  }
+
+/***************************/
+/* Halt: C access routine  */
+/*   for the halt command. */
+/***************************/
+void Halt(
+  Environment *theEnv)
+  {
+   EngineData(theEnv)->HaltRules = true;
+  }
+
+#if DEBUGGING_FUNCTIONS
+
+/********************************/
+/* SetBreak: C access routine   */
+/*   for the set-break command. */
+/********************************/
+void SetBreak(
+  Defrule *theRule)
+  {
+   Defrule *thePtr;
+
+   for (thePtr = theRule;
+        thePtr != NULL;
+        thePtr = thePtr->disjunct)
+     { thePtr->afterBreakpoint = 1; }
+  }
+
+/***********************************/
+/* RemoveBreak: C access routine   */
+/*   for the remove-break command. */
+/***********************************/
+bool RemoveBreak(
+  Defrule *theRule)
+  {
+   Defrule *thePtr;
+   bool rv = false;
+
+   for (thePtr = theRule;
+        thePtr != NULL;
+        thePtr = thePtr->disjunct)
+     {
+      if (thePtr->afterBreakpoint == 1)
+        {
+         thePtr->afterBreakpoint = 0;
+         rv = true;
+        }
+     }
+
+   return rv;
+  }
+
+/**************************************************/
+/* RemoveAllBreakpoints: Removes all breakpoints. */
+/**************************************************/
+void RemoveAllBreakpoints(
+  Environment *theEnv)
+  {
+   Defrule *theRule;
+   Defmodule *theDefmodule = NULL;
+
+   while ((theDefmodule = GetNextDefmodule(theEnv,theDefmodule)) != NULL)
+     {
+      theRule = NULL;
+      while ((theRule = GetNextDefrule(theEnv,theRule)) != NULL)
+        { RemoveBreak(theRule); }
+     }
+  }
+
+/**********************************/
+/* ShowBreaks: C access routine   */
+/*   for the show-breaks command. */
+/**********************************/
+void ShowBreaks(
+  Environment *theEnv,
+  const char *logicalName,
+  Defmodule *theModule)
+  {
+   ListItemsDriver(theEnv,logicalName,theModule,
+                   NULL,NULL,
+                   (GetNextItemFunction *) GetNextDefrule,
+                   (const char *(*)(void *)) GetConstructNameString,
+                   NULL,
+                   (bool (*)(void *)) DefruleHasBreakpoint);
+   }
+
+/***********************************************/
+/* DefruleHasBreakpoint: Indicates whether the */
+/*   specified rule has a breakpoint set.      */
+/***********************************************/
+bool DefruleHasBreakpoint(
+  Defrule *theRule)
+  {
+   return theRule->afterBreakpoint;
+  }
+
+/*****************************************/
+/* SetBreakCommand: H/L access routine   */
+/*   for the set-break command.          */
+/*****************************************/
+void SetBreakCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UDFValue theArg;
+   const char *argument;
+   Defrule *defrulePtr;
+
+   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) return;
+
+   argument = theArg.lexemeValue->contents;
+
+   if ((defrulePtr = FindDefrule(theEnv,argument)) == NULL)
+     {
+      CantFindItemErrorMessage(theEnv,"defrule",argument,true);
+      return;
+     }
+
+   SetBreak(defrulePtr);
+  }
+
+/********************************************/
+/* RemoveBreakCommand: H/L access routine   */
+/*   for the remove-break command.          */
+/********************************************/
+void RemoveBreakCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UDFValue theArg;
+   const char *argument;
+   Defrule *defrulePtr;
+
+   if (UDFArgumentCount(context) == 0)
+     {
+      RemoveAllBreakpoints(theEnv);
+      return;
+     }
+
+   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) return;
+
+   argument = theArg.lexemeValue->contents;
+
+   if ((defrulePtr = FindDefrule(theEnv,argument)) == NULL)
+     {
+      CantFindItemErrorMessage(theEnv,"defrule",argument,true);
+      return;
+     }
+
+   if (RemoveBreak(defrulePtr) == false)
+     {
+      WriteString(theEnv,STDERR,"Rule ");
+      WriteString(theEnv,STDERR,argument);
+      WriteString(theEnv,STDERR," does not have a breakpoint set.\n");
+     }
+  }
+
+/*******************************************/
+/* ShowBreaksCommand: H/L access routine   */
+/*   for the show-breaks command.          */
+/*******************************************/
+void ShowBreaksCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   unsigned int numArgs;
+   bool error;
+   Defmodule *theModule;
+
+   numArgs = UDFArgumentCount(context);
+
+   if (numArgs == 1)
+     {
+      theModule = GetModuleName(context,1,&error);
+      if (error) return;
+     }
+   else
+     { theModule = GetCurrentModule(theEnv); }
+
+   ShowBreaks(theEnv,STDOUT,theModule);
+  }
+
+/***********************************************/
+/* ListFocusStackCommand: H/L access routine   */
+/*   for the list-focus-stack command.         */
+/***********************************************/
+void ListFocusStackCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   ListFocusStack(theEnv,STDOUT);
+  }
+
+/***************************************/
+/* ListFocusStack: C access routine    */
+/*   for the list-focus-stack command. */
+/***************************************/
+void ListFocusStack(
+  Environment *theEnv,
+  const char *logicalName)
+  {
+   FocalModule *theFocus;
+
+   for (theFocus = EngineData(theEnv)->CurrentFocus;
+        theFocus != NULL;
+        theFocus = theFocus->next)
+     {
+      WriteString(theEnv,logicalName,DefmoduleName(theFocus->theModule));
+      WriteString(theEnv,logicalName,"\n");
+     }
+  }
+
+#endif /* DEBUGGING_FUNCTIONS */
+
+/***********************************************/
+/* GetFocusStackFunction: H/L access routine   */
+/*   for the get-focus-stack function.         */
+/***********************************************/
+void GetFocusStackFunction(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   CLIPSValue result;
+   
+   GetFocusStack(theEnv,&result);
+   CLIPSToUDFValue(&result,returnValue);
+  }
+
+/***************************************/
+/* GetFocusStack: C access routine     */
+/*   for the get-focus-stack function. */
+/***************************************/
+void GetFocusStack(
+  Environment *theEnv,
+  CLIPSValue *returnValue)
+  {
+   FocalModule *theFocus;
+   Multifield *theList;
+   unsigned long count = 0;
+
+   /*===========================================*/
+   /* If there is no current focus, then return */
+   /* a multifield value of length zero.        */
+   /*===========================================*/
+
+   if (EngineData(theEnv)->CurrentFocus == NULL)
+     {
+      returnValue->value = CreateMultifield(theEnv,0L);
+      return;
+     }
+
+   /*=====================================================*/
+   /* Determine the number of modules on the focus stack. */
+   /*=====================================================*/
+
+   for (theFocus = EngineData(theEnv)->CurrentFocus; theFocus != NULL; theFocus = theFocus->next)
+     { count++; }
+
+   /*=============================================*/
+   /* Create a multifield of the appropriate size */
+   /* in which to store the module names.         */
+   /*=============================================*/
+
+   theList = CreateMultifield(theEnv,count);
+   returnValue->multifieldValue = theList;
+
+   /*=================================================*/
+   /* Store the module names in the multifield value. */
+   /*=================================================*/
+
+   for (theFocus = EngineData(theEnv)->CurrentFocus, count = 0;
+        theFocus != NULL;
+        theFocus = theFocus->next, count++)
+     {
+      theList->contents[count].value = theFocus->theModule->header.name;
+     }
+  }
+
+/******************************************/
+/* PopFocusFunction: H/L access routine   */
+/*   for the pop-focus function.          */
+/******************************************/
+void PopFocusFunction(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   Defmodule *theModule;
+
+   theModule = PopFocus(theEnv);
+   if (theModule == NULL)
+     {
+      returnValue->lexemeValue = FalseSymbol(theEnv);
+      return;
+     }
+
+   returnValue->value = theModule->header.name;
+  }
+
+/**************************************/
+/* FocusCommand: H/L access routine   */
+/*   for the focus function.          */
+/**************************************/
+void FocusCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UDFValue theArg;
+   const char *argument;
+   Defmodule *theModule;
+   unsigned int argCount, i;
+
+   /*===========================================*/
+   /* Focus on the specified defrule module(s). */
+   /*===========================================*/
+
+   argCount = UDFArgumentCount(context);
+
+   for (i = argCount; i > 0; i--)
+     {
+      if (! UDFNthArgument(context,i,SYMBOL_BIT,&theArg))
+        { return; }
+
+      argument = theArg.lexemeValue->contents;
+      theModule = FindDefmodule(theEnv,argument);
+
+      if (theModule == NULL)
+        {
+         CantFindItemErrorMessage(theEnv,"defmodule",argument,true);
+         returnValue->lexemeValue = FalseSymbol(theEnv);
+         return;
+        }
+
+      Focus(theModule);
+     }
+
+   /*===================================================*/
+   /* Return true to indicate success of focus command. */
+   /*===================================================*/
+
+   returnValue->lexemeValue = TrueSymbol(theEnv);
+  }
+
+/********************************************************************/
+/* GetFocusChanged: Returns the value of the variable FocusChanged. */
+/********************************************************************/
+bool GetFocusChanged(
+  Environment *theEnv)
+  {
+   return EngineData(theEnv)->FocusChanged;
+  }
+
+/*****************************************************************/
+/* SetFocusChanged: Sets the value of the variable FocusChanged. */
+/*****************************************************************/
+void SetFocusChanged(
+  Environment *theEnv,
+  bool value)
+  {
+   EngineData(theEnv)->FocusChanged = value;
+  }
+
+/******************************************/
+/* SetHaltRules: Sets the HaltRules flag. */
+/******************************************/
+void SetHaltRules(
+  Environment *theEnv,
+  bool value)
+  {
+   EngineData(theEnv)->HaltRules = value;
+  }
+
+/*************************************************/
+/* GetHaltRules: Returns the HaltExecution flag. */
+/*************************************************/
+bool GetHaltRules(
+  Environment *theEnv)
+  {
+   return(EngineData(theEnv)->HaltRules);
+  }
+
+#endif /* DEFRULE_CONSTRUCT */
+