clips-sys 0.4.0

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*            CLIPS Version 6.40  02/19/20             */
   /*                                                     */
   /*                    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.                 */
/*                                                           */
/*************************************************************/

#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];

         gensprintf(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
      gensprintf(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
      gensprintf(printSpace,"%ld mean number of instances (%ld maximum).\n",
                          (long) (((double) sumInstances / (rulesFired + 1)) + 0.5),
                          maxInstances);
      WriteString(theEnv,STDOUT,printSpace);
#endif

      gensprintf(printSpace,"%ld mean number of activations (%ld maximum).\n",
                          (long) (((double) sumActivations / (rulesFired + 1)) + 0.5),
                          maxActivations);
      WriteString(theEnv,STDOUT,printSpace);

#if DEVELOPER
      gensprintf(printSpace,"%9ld left to right comparisons.\n",
                          EngineData(theEnv)->leftToRightComparisons);
      WriteString(theEnv,STDOUT,printSpace);

      gensprintf(printSpace,"%9ld left to right succeeds.\n",
                          EngineData(theEnv)->leftToRightSucceeds);
      WriteString(theEnv,STDOUT,printSpace);

      gensprintf(printSpace,"%9ld left to right loops.\n",
                          EngineData(theEnv)->leftToRightLoops);
      WriteString(theEnv,STDOUT,printSpace);

      gensprintf(printSpace,"%9ld right to left comparisons.\n",
                          EngineData(theEnv)->rightToLeftComparisons);
      WriteString(theEnv,STDOUT,printSpace);

      gensprintf(printSpace,"%9ld right to left succeeds.\n",
                          EngineData(theEnv)->rightToLeftSucceeds);
      WriteString(theEnv,STDOUT,printSpace);

      gensprintf(printSpace,"%9ld right to left loops.\n",
                          EngineData(theEnv)->rightToLeftLoops);
      WriteString(theEnv,STDOUT,printSpace);

      gensprintf(printSpace,"%9ld find next conflicting comparisons.\n",
                          EngineData(theEnv)->findNextConflictingComparisons);
      WriteString(theEnv,STDOUT,printSpace);

      gensprintf(printSpace,"%9ld beta hash list skips.\n",
                          EngineData(theEnv)->betaHashListSkips);
      WriteString(theEnv,STDOUT,printSpace);

      gensprintf(printSpace,"%9ld beta hash hash table skips.\n",
                          EngineData(theEnv)->betaHashHTSkips);
      WriteString(theEnv,STDOUT,printSpace);

      gensprintf(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 */