Ejemplo n.º 1
0
/***************************************************
  NAME         : Send
  DESCRIPTION  : C Interface for sending messages to
                  instances
  INPUTS       : 1) The data object of the instance
                 2) The message name-string
                 3) The message arguments string
                    (Constants only)
                 4) Caller's buffer for result
  RETURNS      : Nothing useful
  SIDE EFFECTS : Executes message and stores result
                   caller's buffer
  NOTES        : None
 ***************************************************/
globle void Send(
  DATA_OBJECT *idata,
  char *msg,
  char *args,
  DATA_OBJECT *result)
  {
   int error;
   EXPRESSION *iexp;
   SYMBOL_HN *msym;

   SetEvaluationError(FALSE);
   result->type = SYMBOL;
   result->value = FalseSymbol;
   msym = FindSymbol(msg);
   if (msym == NULL)
     {
      PrintNoHandlerError(msg);
      SetEvaluationError(TRUE);
      return;
     }
   iexp = GenConstant(idata->type,idata->value);
   iexp->nextArg = ParseConstantArguments(args,&error);
   if (error == TRUE)
     {
      ReturnExpression(iexp);
      SetEvaluationError(TRUE);
      return;
     }
   PerformMessage(result,iexp,msym);
   ReturnExpression(iexp);

   if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
       (CurrentExpression == NULL))
     { PeriodicCleanup(TRUE,FALSE); }
  }
Ejemplo n.º 2
0
globle int FunctionCall2(
  FUNCTION_REFERENCE *theReference,
  char *args,
  DATA_OBJECT *result)
  {
   EXPRESSION *argexps;
   int error = FALSE;

   /*=============================================*/
   /* Force periodic cleanup if the function call */
   /* was executed from an embedded application.  */
   /*=============================================*/

   if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
       (CurrentExpression == NULL))
     { PeriodicCleanup(TRUE,FALSE); }

   /*========================*/
   /* Reset the error state. */
   /*========================*/

   if (CurrentEvaluationDepth == 0) SetHaltExecution(FALSE);
   EvaluationError = FALSE;

   /*======================================*/
   /* Initialize the default return value. */
   /*======================================*/

   result->type = SYMBOL;
   result->value = FalseSymbol;

   /*============================*/
   /* Parse the argument string. */
   /*============================*/

   argexps = ParseConstantArguments(args,&error);
   if (error == TRUE) return(TRUE);

   /*====================*/
   /* Call the function. */
   /*====================*/

   theReference->argList = argexps;
   error = EvaluateExpression(theReference,result);

   /*========================*/
   /* Return the expression. */
   /*========================*/

   ReturnExpression(argexps);
   theReference->argList = NULL;

   /*==========================*/
   /* Return the error status. */
   /*==========================*/

   return(error);
  }
Ejemplo n.º 3
0
globle void WhileFunction(
  DATA_OBJECT_PTR returnValue)
  {
   DATA_OBJECT theResult;

   /*====================================================*/
   /* Evaluate the body of the while loop as long as the */
   /* while condition evaluates to a non-FALSE value.    */
   /*====================================================*/

   CurrentEvaluationDepth++;
   RtnUnknown(1,&theResult);
   while (((theResult.value != FalseSymbol) ||
           (theResult.type != SYMBOL)) &&
           (HaltExecution != TRUE))
     {
      if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
        break;
      RtnUnknown(2,&theResult);
      CurrentEvaluationDepth--;
      if (ReturnFlag == TRUE)
        { PropagateReturnValue(&theResult); }
      PeriodicCleanup(FALSE,TRUE);
      CurrentEvaluationDepth++;
      if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
        break;
      RtnUnknown(1,&theResult);
     }
   CurrentEvaluationDepth--;

   /*=====================================================*/
   /* Reset the break flag. The return flag is not reset  */
   /* because the while loop is probably contained within */
   /* a deffunction or RHS of a rule which needs to be    */
   /* returned from as well.                              */
   /*=====================================================*/

   BreakFlag = FALSE;

   /*====================================================*/
   /* If the return command was issued, then return that */
   /* value, otherwise return the symbol FALSE.          */
   /*====================================================*/

   if (ReturnFlag == TRUE)
     {
      returnValue->type = theResult.type;
      returnValue->value = theResult.value;
      returnValue->begin = theResult.begin;
      returnValue->end = theResult.end;
     }
   else
     {
      returnValue->type = SYMBOL;
      returnValue->value = FalseSymbol;
     }
  }
Ejemplo n.º 4
0
globle void CommandLoop(
  void *theEnv)
  {
   int inchar;

   EnvPrintRouter(theEnv,WPROMPT,CommandLineData(theEnv)->BannerString);
   SetHaltExecution(theEnv,FALSE);
   SetEvaluationError(theEnv,FALSE);
   PeriodicCleanup(theEnv,TRUE,FALSE);
   PrintPrompt(theEnv);
   RouterData(theEnv)->CommandBufferInputCount = 0;

   while (TRUE)
     {
      /*===================================================*/
      /* If a batch file is active, grab the command input */
      /* directly from the batch file, otherwise call the  */
      /* event function.                                   */
      /*===================================================*/

      if (BatchActive(theEnv) == TRUE)
        {
         inchar = LLGetcBatch(theEnv,"stdin",TRUE);
         if (inchar == EOF)
           { (*CommandLineData(theEnv)->EventFunction)(theEnv); }
         else
           { ExpandCommandString(theEnv,(char) inchar); }
        }
      else
        { (*CommandLineData(theEnv)->EventFunction)(theEnv); }

      /*=================================================*/
      /* If execution was halted, then remove everything */
      /* from the command buffer.                        */
      /*=================================================*/

      if (GetHaltExecution(theEnv) == TRUE)
        {
         SetHaltExecution(theEnv,FALSE);
         SetEvaluationError(theEnv,FALSE);
         FlushCommandString(theEnv);
#if ! WINDOW_INTERFACE
         fflush(stdin);
#endif
         EnvPrintRouter(theEnv,WPROMPT,"\n");
         PrintPrompt(theEnv);
        }

      /*=========================================*/
      /* If a complete command is in the command */
      /* buffer, then execute it.                */
      /*=========================================*/

      ExecuteIfCommandComplete(theEnv);
     }
  }
Ejemplo n.º 5
0
globle void CommandLoopBatch(
  void *theEnv)
  {
   SetHaltExecution(theEnv,FALSE);
   SetEvaluationError(theEnv,FALSE);
   PeriodicCleanup(theEnv,TRUE,FALSE);
   PrintPrompt(theEnv);
   RouterData(theEnv)->CommandBufferInputCount = 0;

   CommandLoopBatchDriver(theEnv);
  }
Ejemplo n.º 6
0
/******************************************************************************
  NAME         : DelayedQueryDoForAllInstances
  DESCRIPTION  : Finds all sets of instances which satisfy the query and
                   and exceutes a user-action for each set

                 This function differs from QueryDoForAllInstances() in
                   that it forms the complete list of query satisfactions
                   BEFORE executing any actions.
  INPUTS       : Caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : The query class-expressions are evaluated once,
                   and the query boolean-expression is evaluated
                   once for every instance set.  The action is executed
                   for evry query satisfaction.
                 Caller's result buffer holds result of last action executed.
  NOTES        : H/L Syntax : See ParseQueryNoAction()
 ******************************************************************************/
globle void DelayedQueryDoForAllInstances(
  void *theEnv,
  EXEC_STATUS,
  DATA_OBJECT *result)
  {
   QUERY_CLASS *qclasses;
   unsigned rcnt;
   register unsigned i;

   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv,execStatus);
   qclasses = DetermineQueryClasses(theEnv,execStatus,GetFirstArgument()->nextArg->nextArg,
                                      "delayed-do-for-all-instances",&rcnt);
   if (qclasses == NULL)
     return;
   PushQueryCore(theEnv,execStatus);
   InstanceQueryData(theEnv,execStatus)->QueryCore = get_struct(theEnv,execStatus,query_core);
   InstanceQueryData(theEnv,execStatus)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,execStatus,(sizeof(INSTANCE_TYPE *) * rcnt));
   InstanceQueryData(theEnv,execStatus)->QueryCore->query = GetFirstArgument();
   InstanceQueryData(theEnv,execStatus)->QueryCore->action = NULL;
   InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set = NULL;
   InstanceQueryData(theEnv,execStatus)->QueryCore->soln_size = rcnt;
   InstanceQueryData(theEnv,execStatus)->QueryCore->soln_cnt = 0;
   TestEntireChain(theEnv,execStatus,qclasses,0);
   InstanceQueryData(theEnv,execStatus)->AbortQuery = FALSE;
   InstanceQueryData(theEnv,execStatus)->QueryCore->action = GetFirstArgument()->nextArg;
   while (InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set != NULL)
     {
      for (i = 0 ; i < rcnt ; i++)
        InstanceQueryData(theEnv,execStatus)->QueryCore->solns[i] = InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set->soln[i];
      PopQuerySoln(theEnv,execStatus);
      execStatus->CurrentEvaluationDepth++;
      EvaluateExpression(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->action,result);
      execStatus->CurrentEvaluationDepth--;
      if (ProcedureFunctionData(theEnv,execStatus)->ReturnFlag == TRUE)
        { PropagateReturnValue(theEnv,execStatus,result); }
      PeriodicCleanup(theEnv,execStatus,FALSE,TRUE);
      if (execStatus->HaltExecution || ProcedureFunctionData(theEnv,execStatus)->BreakFlag || ProcedureFunctionData(theEnv,execStatus)->ReturnFlag)
        {
         while (InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set != NULL)
           PopQuerySoln(theEnv,execStatus);
         break;
        }
     }
   ProcedureFunctionData(theEnv,execStatus)->BreakFlag = FALSE;
   rm(theEnv,execStatus,(void *) InstanceQueryData(theEnv,execStatus)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt));
   rtn_struct(theEnv,execStatus,query_core,InstanceQueryData(theEnv,execStatus)->QueryCore);
   PopQueryCore(theEnv,execStatus);
   DeleteQueryClasses(theEnv,execStatus,qclasses);
  }
Ejemplo n.º 7
0
/*****************************************************************
  NAME         : TestForFirstFactInTemplate
  DESCRIPTION  : Processes all facts in a template
  INPUTS       : 1) Visitation traversal id
                 2) The template
                 3) The current template restriction chain
                 4) The index of the current restriction
  RETURNS      : TRUE if query succeeds, FALSE otherwise
  SIDE EFFECTS : Fact variable values set
  NOTES        : None
 *****************************************************************/
static int TestForFirstFactInTemplate(
  void *theEnv,
  struct deftemplate *templatePtr,
  QUERY_TEMPLATE *qchain,
  int indx)
  {
   struct fact *theFact;
   DATA_OBJECT temp;

   theFact = templatePtr->factList;
   while (theFact != NULL)
     {
      FactQueryData(theEnv)->QueryCore->solns[indx] = theFact;
      if (qchain->nxt != NULL)
        {
         theFact->factHeader.busyCount++;
         if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == TRUE)
           {
            theFact->factHeader.busyCount--;
            break;
           }
         theFact->factHeader.busyCount--;
         if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
           break;
        }
      else
        {
         theFact->factHeader.busyCount++;
         EvaluationData(theEnv)->CurrentEvaluationDepth++;
         EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp);
         EvaluationData(theEnv)->CurrentEvaluationDepth--;
         PeriodicCleanup(theEnv,FALSE,TRUE);
         theFact->factHeader.busyCount--;
         if (EvaluationData(theEnv)->HaltExecution == TRUE)
           break;
         if ((temp.type != SYMBOL) ? TRUE :
             (temp.value != EnvFalseSymbol(theEnv)))
           break;
        }
      theFact = theFact->nextTemplateFact;
      while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE)
        theFact = theFact->nextTemplateFact;
     }

   if (theFact != NULL)
     return(((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
             ? FALSE : TRUE);

   return(FALSE);
  }
Ejemplo n.º 8
0
/******************************************************************************
  NAME         : DelayedQueryDoForAllFacts
  DESCRIPTION  : Finds all sets of facts which satisfy the query and
                   and exceutes a user-action for each set

                 This function differs from QueryDoForAllFacts() in
                   that it forms the complete list of query satisfactions
                   BEFORE executing any actions.
  INPUTS       : Caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : The query template-expressions are evaluated once,
                   and the query boolean-expression is evaluated
                   once for every fact set.  The action is executed
                   for evry query satisfaction.
                 Caller's result buffer holds result of last action executed.
  NOTES        : H/L Syntax : See FactParseQueryNoAction()
 ******************************************************************************/
globle void DelayedQueryDoForAllFacts(
  void *theEnv,
  DATA_OBJECT *result)
  {
   QUERY_TEMPLATE *qtemplates;
   unsigned rcnt;
   register unsigned i;

   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv);
   qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
                                      "delayed-do-for-all-facts",&rcnt);
   if (qtemplates == NULL)
     return;
   PushQueryCore(theEnv);
   FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
   FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
   FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
   FactQueryData(theEnv)->QueryCore->action = NULL;
   FactQueryData(theEnv)->QueryCore->soln_set = NULL;
   FactQueryData(theEnv)->QueryCore->soln_size = rcnt;
   FactQueryData(theEnv)->QueryCore->soln_cnt = 0;
   TestEntireChain(theEnv,qtemplates,0);
   FactQueryData(theEnv)->AbortQuery = FALSE;
   FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
   while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
     {
      for (i = 0 ; i < rcnt ; i++)
        FactQueryData(theEnv)->QueryCore->solns[i] = FactQueryData(theEnv)->QueryCore->soln_set->soln[i];
      PopQuerySoln(theEnv);
      EvaluationData(theEnv)->CurrentEvaluationDepth++;
      EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result);
      EvaluationData(theEnv)->CurrentEvaluationDepth--;
      if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)
        { PropagateReturnValue(theEnv,result); }
      PeriodicCleanup(theEnv,FALSE,TRUE);
      if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
        {
         while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
           PopQuerySoln(theEnv);
         break;
        }
     }
   ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
   rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
   rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
   PopQueryCore(theEnv);
   DeleteQueryTemplates(theEnv,qtemplates);
  }
Ejemplo n.º 9
0
/******************************************************************************
  NAME         : DelayedQueryDoForAllInstances
  DESCRIPTION  : Finds all sets of instances which satisfy the query and
                   and exceutes a user-action for each set

                 This function differs from QueryDoForAllInstances() in
                   that it forms the complete list of query satisfactions
                   BEFORE executing any actions.
  INPUTS       : Caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : The query class-expressions are evaluated once,
                   and the query boolean-expression is evaluated
                   once for every instance set.  The action is executed
                   for evry query satisfaction.
                 Caller's result buffer holds result of last action executed.
  NOTES        : H/L Syntax : See ParseQueryNoAction()
 ******************************************************************************/
globle void DelayedQueryDoForAllInstances(
  DATA_OBJECT *result)
  {
   QUERY_CLASS *qclasses;
   int rcnt;
   register int i;

   result->type = SYMBOL;
   result->value = FalseSymbol;
   qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg->nextArg,
                                      "delayed-do-for-all-instances",&rcnt);
   if (qclasses == NULL)
     return;
   PushQueryCore();
   QueryCore = get_struct(query_core);
   QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
   QueryCore->query = GetFirstArgument();
   QueryCore->action = NULL;
   QueryCore->soln_set = NULL;
   QueryCore->soln_size = rcnt;
   QueryCore->soln_cnt = 0;
   TestEntireChain(qclasses,0);
   AbortQuery = FALSE;
   QueryCore->action = GetFirstArgument()->nextArg;
   while (QueryCore->soln_set != NULL)
     {
      for (i = 0 ; i < rcnt ; i++)
        QueryCore->solns[i] = QueryCore->soln_set->soln[i];
      PopQuerySoln();
      CurrentEvaluationDepth++;
      EvaluateExpression(QueryCore->action,result);
      CurrentEvaluationDepth--;
      if (ReturnFlag == TRUE)
        { PropagateReturnValue(result); }
      PeriodicCleanup(FALSE,TRUE);
      if (HaltExecution || BreakFlag || ReturnFlag)
        {
         while (QueryCore->soln_set != NULL)
           PopQuerySoln();
         break;
        }
     }
   BreakFlag = FALSE;
   rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
   rtn_struct(query_core,QueryCore);
   PopQueryCore();
   DeleteQueryClasses(qclasses);
  }
Ejemplo n.º 10
0
globle intBool ExecuteIfCommandComplete(
  void *theEnv)
  {
   if ((CompleteCommand(CommandLineData(theEnv)->CommandString) == 0) || 
       (RouterData(theEnv)->CommandBufferInputCount <= 0))
     { return FALSE; }
      
   FlushPPBuffer(theEnv);
   SetPPBufferStatus(theEnv,OFF);
   RouterData(theEnv)->CommandBufferInputCount = -1;
   RouteCommand(theEnv,CommandLineData(theEnv)->CommandString,TRUE);
   FlushPPBuffer(theEnv);
   SetHaltExecution(theEnv,FALSE);
   SetEvaluationError(theEnv,FALSE);
   FlushCommandString(theEnv);
   FlushBindList(theEnv);
   PeriodicCleanup(theEnv,TRUE,FALSE);
   PrintPrompt(theEnv);
         
   return TRUE;
  }
Ejemplo n.º 11
0
/*****************************************************************
  NAME         : TestForFirstInstanceInClass
  DESCRIPTION  : Processes all instances in a class and then
                   all subclasses of a class until success or done
  INPUTS       : 1) The module for which classes tested must be
                    in scope
                 2) Visitation traversal id
                 3) The class
                 4) The current class restriction chain
                 5) The index of the current restriction
  RETURNS      : TRUE if query succeeds, FALSE otherwise
  SIDE EFFECTS : Instance variable values set
  NOTES        : None
 *****************************************************************/
static int TestForFirstInstanceInClass(
  void *theEnv,
  EXEC_STATUS,
  struct defmodule *theModule,
  int id,
  DEFCLASS *cls,
  QUERY_CLASS *qchain,
  int indx)
  {
   long i;
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;

   if (TestTraversalID(cls->traversalRecord,id))
     return(FALSE);
   SetTraversalID(cls->traversalRecord,id);
   if (DefclassInScope(theEnv,execStatus,cls,theModule) == FALSE)
     return(FALSE);
   ins = cls->instanceList;
   while (ins != NULL)
     {
      InstanceQueryData(theEnv,execStatus)->QueryCore->solns[indx] = ins;
      if (qchain->nxt != NULL)
        {
         ins->busy++;
         if (TestForFirstInChain(theEnv,execStatus,qchain->nxt,indx+1) == TRUE)
           {
            ins->busy--;
            break;
           }
         ins->busy--;
         if ((execStatus->HaltExecution == TRUE) || (InstanceQueryData(theEnv,execStatus)->AbortQuery == TRUE))
           break;
        }
      else
        {
         ins->busy++;
         execStatus->CurrentEvaluationDepth++;
         EvaluateExpression(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->query,&temp);
         execStatus->CurrentEvaluationDepth--;
         PeriodicCleanup(theEnv,execStatus,FALSE,TRUE);
         ins->busy--;
         if (execStatus->HaltExecution == TRUE)
           break;
         if ((temp.type != SYMBOL) ? TRUE :
             (temp.value != EnvFalseSymbol(theEnv,execStatus)))
           break;
        }
      ins = ins->nxtClass;
      while ((ins != NULL) ? (ins->garbage == 1) : FALSE)
        ins = ins->nxtClass;
     }
   if (ins != NULL)
     return(((execStatus->HaltExecution == TRUE) || (InstanceQueryData(theEnv,execStatus)->AbortQuery == TRUE))
             ? FALSE : TRUE);
   for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
     {
      if (TestForFirstInstanceInClass(theEnv,execStatus,theModule,id,cls->directSubclasses.classArray[i],
                                      qchain,indx))
        return(TRUE);
      if ((execStatus->HaltExecution == TRUE) || (InstanceQueryData(theEnv,execStatus)->AbortQuery == TRUE))
        return(FALSE);
     }
   return(FALSE);
  }
Ejemplo n.º 12
0
static int ConstructsToC(
  char *fileName,
  int theImageID,
  int max)
  {
   char fname[FSIZE];
   int fileVersion;
   struct CodeGeneratorItem *cgPtr;

   /*===============================================*/
   /* Set the global MaxIndices variable indicating */
   /* the maximum number of data structures to save */
   /* in each file.                                 */
   /*===============================================*/

   MaxIndices = max;

   /*==================================*/
   /* Call the list of functions to be */
   /* executed before generating code. */
   /*==================================*/

   for (cgPtr = ListOfCodeGeneratorItems;
        cgPtr != NULL;
        cgPtr = cgPtr->next)
     { if (cgPtr->beforeFunction != NULL) (*cgPtr->beforeFunction)(); }

   /*=================================================*/
   /* Do a periodic cleanup without using heuristics  */
   /* to get rid of as much garbage as possible so    */
   /* that it isn't written out as C data structures. */
   /*=================================================*/

   PeriodicCleanup(FALSE,FALSE);

   /*=====================================*/
   /* Initialize some global information. */
   /*=====================================*/

   FilePrefix = fileName;
   ImageID = theImageID;
   ExpressionFP = NULL;
   ExpressionVersion = 1;
   ExpressionHeader = TRUE;
   ExpressionCount = 0;

   /*=====================================================*/
   /* Open a header file for dumping general information. */
   /*=====================================================*/

   sprintf(fname,"%s.h",fileName);
   if ((HeaderFP = fopen(fname,"w")) == NULL)
     {
      OpenErrorMessage("constructs-to-c",fname);
      return(0);
     }

   fprintf(HeaderFP,"#ifndef _CONSTRUCT_COMPILER_HEADER_\n");
   fprintf(HeaderFP,"#define _CONSTRUCT_COMPILER_HEADER_\n\n");

   fprintf(HeaderFP,"#include <stdio.h>\n");
   fprintf(HeaderFP,"#include \"setup.h\"\n");
   fprintf(HeaderFP,"#include \"expressn.h\"\n");
   fprintf(HeaderFP,"#include \"extnfunc.h\"\n");
   fprintf(HeaderFP,"#include \"%s\"\n",API_HEADER);
   fprintf(HeaderFP,"\n#define VS (void *)\n");
   fprintf(HeaderFP,"\n");

   /*=========================================================*/
   /* Give extern declarations for user and system functions. */
   /*=========================================================*/

   WriteFunctionExternDeclarations(HeaderFP);

   fprintf(HeaderFP,"\n#endif\n\n");
   fprintf(HeaderFP,"/****************************/\n");
   fprintf(HeaderFP,"/* EXTERN ARRAY DEFINITIONS */\n");
   fprintf(HeaderFP,"/****************************/\n\n");

   /*==================================*/
   /* Generate code for atomic values, */
   /* function definitions, hashed     */
   /* expressions, and constructs.     */
   /*==================================*/

   AtomicValuesToCode(fileName);

   FunctionsToCode(fileName);

   HashedExpressionsToCode();

   ConstraintsToCode(fileName,4,HeaderFP,ImageID,MaxIndices);

   /*===============================*/
   /* Call each code generator item */
   /* for the various constructs.   */
   /*===============================*/

   fileVersion = 5;
   for (cgPtr = ListOfCodeGeneratorItems;
        cgPtr != NULL;
        cgPtr = cgPtr->next)
     {
      if (cgPtr->generateFunction != NULL)
        {
         (*cgPtr->generateFunction)(fileName,fileVersion,HeaderFP,ImageID,MaxIndices);
         fileVersion++;
        }
     }

   /*=========================================*/
   /* Restore the atomic data bucket values   */
   /* (which were set to an index reference). */
   /*=========================================*/

   RestoreAtomicValueBuckets();

   /*============================*/
   /* Close the expression file. */
   /*============================*/

   if (ExpressionFP != NULL)
     {
      fprintf(ExpressionFP,"};\n");
      fclose(ExpressionFP);
     }

   /*====================================*/
   /* Write the initialization function. */
   /*====================================*/

   WriteInitializationFunction(fileName);

   /*========================*/
   /* Close the header file. */
   /*========================*/

   fclose(HeaderFP);

   /*==================================================*/
   /* Return TRUE to indicate that the constructs-to-c */
   /* command was successfully executed.               */
   /*==================================================*/

   return(TRUE);
  }
Ejemplo n.º 13
0
globle long int EnvRun(
  void *theEnv,
  long int runLimit)
  {
   long int rulesFired = 0;
   DATA_OBJECT result;
   struct callFunctionItem *theRunFunction;
#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
   double endTime, startTime = 0.0;
   unsigned long tempValue;
#endif
   unsigned int i;
   struct patternEntity *theMatchingItem;
   struct partialMatch *theBasis;
   ACTIVATION *theActivation;
   char *ruleFiring;
#if PROFILING_FUNCTIONS
   struct profileFrameInfo profileFrame;
#endif

   /*=====================================================*/
   /* Make sure the run command is not already executing. */
   /*=====================================================*/

   if (EngineData(theEnv)->AlreadyRunning) return(0);
   EngineData(theEnv)->AlreadyRunning = TRUE;

   /*================================*/
   /* 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;
      startTime = gentime();
     }
#endif

   /*=============================*/
   /* Set up execution variables. */
   /*=============================*/

   if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE);
   EngineData(theEnv)->HaltRules = FALSE;

   /*=====================================================*/
   /* 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))
     {
      /*===========================================*/
      /* Detach the activation from the agenda and */
      /* determine which rule is firing.           */
      /*===========================================*/

      DetachActivation(theEnv,theActivation);
      ruleFiring = EnvGetActivationName(theEnv,theActivation);
      theBasis = (struct partialMatch *) GetActivationBasis(theActivation);
      EngineData(theEnv)->ExecutingRule = (struct defrule *) GetActivationRule(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];

         sprintf(printSpace,"FIRE %4ld ",rulesFired);
         EnvPrintRouter(theEnv,WTRACE,printSpace);
         EnvPrintRouter(theEnv,WTRACE,ruleFiring);
         EnvPrintRouter(theEnv,WTRACE,": ");
         PrintPartialMatch(theEnv,WTRACE,theBasis);
         EnvPrintRouter(theEnv,WTRACE,"\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->binds[theBasis->bcount].gm.theValue = 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++)
        {
         theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem;
         if (theMatchingItem != NULL)
           { (*theMatchingItem->theInfo->incrementBasisCount)(theEnv,theMatchingItem); }
        }

      /*====================================================*/
      /* Execute the rule's right hand side actions. 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;
      EvaluationData(theEnv)->CurrentEvaluationDepth++;
      SetEvaluationError(theEnv,FALSE);
      EngineData(theEnv)->ExecutingRule->executing = TRUE;

#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,
                          &result,NULL);

#if PROFILING_FUNCTIONS
      EndProfile(theEnv,&profileFrame);
#endif

      EngineData(theEnv)->ExecutingRule->executing = FALSE;
      SetEvaluationError(theEnv,FALSE);
      EvaluationData(theEnv)->CurrentEvaluationDepth--;
      EngineData(theEnv)->TheLogicalJoin = 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

        {
         PrintErrorID(theEnv,"PRCCODE",4,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Execution halted during the actions of defrule ");
         EnvPrintRouter(theEnv,WERROR,ruleFiring);
         EnvPrintRouter(theEnv,WERROR,".\n");
        }

      /*===================================================================*/
      /* Decrement the count for each of the facts/objects associated with */
      /* the rule activation. If the last match for the activation         */
      /* is from a not CE, then we need to make sure that the last         */
      /* match is an actual match for the CE and not a counter.            */
      /*===================================================================*/

      theBasis->busy = FALSE;

      for (i = 0; i < (theBasis->bcount - 1); i++)
        {
         theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem;
         if (theMatchingItem != NULL)
           { (*theMatchingItem->theInfo->decrementBasisCount)(theEnv,theMatchingItem); }
        }

      i = (unsigned) (theBasis->bcount - 1);
      if (theBasis->counterf == FALSE)
        {
         theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem;
         if (theMatchingItem != NULL)
           { (*theMatchingItem->theInfo->decrementBasisCount)(theEnv,theMatchingItem); }
        }

      /*========================================*/
      /* Return the agenda node to free memory. */
      /*========================================*/

      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.  */
      /*==================================*/

      PeriodicCleanup(theEnv,FALSE,TRUE);

      /*==========================*/
      /* 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 (EnvGetSalienceEvaluation(theEnv) == EVERY_CYCLE) EnvRefreshAgenda(theEnv,NULL);

      /*========================================*/
      /* Execute the list of functions that are */
      /* to be called after each rule firing.   */
      /*========================================*/

      for (theRunFunction = EngineData(theEnv)->ListOfRunFunctions;
           theRunFunction != NULL;
           theRunFunction = theRunFunction->next)
        { 
         if (theRunFunction->environmentAware)
           { (*theRunFunction->func)(theEnv); }
         else            
           { ((void (*)(void))(*theRunFunction->func))(); }
        }

      /*========================================*/
      /* 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 (((struct defrule *) GetActivationRule(theActivation))->afterBreakpoint)
           {
            EngineData(theEnv)->HaltRules = TRUE;
            EnvPrintRouter(theEnv,WDIALOG,"Breaking on rule ");
            EnvPrintRouter(theEnv,WDIALOG,EnvGetActivationName(theEnv,theActivation));
            EnvPrintRouter(theEnv,WDIALOG,".\n");
           }
        }
     }

   /*=====================================================*/
   /* Make sure run functions are executed at least once. */
   /*=====================================================*/

   if (rulesFired == 0)
     {
      for (theRunFunction = EngineData(theEnv)->ListOfRunFunctions;
           theRunFunction != NULL;
           theRunFunction = theRunFunction->next)
        { 
         if (theRunFunction->environmentAware)
           { (*theRunFunction->func)(theEnv); }
         else            
           { ((void (*)(void))(*theRunFunction->func))(); }
        }
     }

   /*======================================================*/
   /* If rule execution was halted because the rule firing */
   /* limit was reached, then print a message.             */
   /*======================================================*/

   if (runLimit == rulesFired)
     { EnvPrintRouter(theEnv,WDIALOG,"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)
     {
      char printSpace[60];

      endTime = gentime();

      PrintLongInteger(theEnv,WDIALOG,rulesFired);
      EnvPrintRouter(theEnv,WDIALOG," rules fired");

#if (! GENERIC)
      if (startTime != endTime)
        {
         EnvPrintRouter(theEnv,WDIALOG,"        Run time is ");
         PrintFloat(theEnv,WDIALOG,endTime - startTime);
         EnvPrintRouter(theEnv,WDIALOG," seconds.\n");
         PrintFloat(theEnv,WDIALOG,(double) rulesFired / (endTime - startTime));
         EnvPrintRouter(theEnv,WDIALOG," rules per second.\n");
        }
      else
        { EnvPrintRouter(theEnv,WDIALOG,"\n"); }
#endif

#if DEFTEMPLATE_CONSTRUCT
      sprintf(printSpace,"%ld mean number of facts (%ld maximum).\n",
                          (long) (((double) sumFacts / (rulesFired + 1)) + 0.5),
                          maxFacts);
      EnvPrintRouter(theEnv,WDIALOG,printSpace);
#endif

#if OBJECT_SYSTEM
      sprintf(printSpace,"%ld mean number of instances (%ld maximum).\n",
                          (long) (((double) sumInstances / (rulesFired + 1)) + 0.5),
                          maxInstances);
      EnvPrintRouter(theEnv,WDIALOG,printSpace);
#endif

      sprintf(printSpace,"%ld mean number of activations (%ld maximum).\n",
                          (long) (((double) sumActivations / (rulesFired + 1)) + 0.5),
                          maxActivations);
      EnvPrintRouter(theEnv,WDIALOG,printSpace);
     }
#endif

   /*==========================================*/
   /* The current module should be the current */
   /* focus when the run finishes.             */
   /*==========================================*/

   if (EngineData(theEnv)->CurrentFocus != NULL)
     {
      if (EngineData(theEnv)->CurrentFocus->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
        { EnvSetCurrentModule(theEnv,(void *) EngineData(theEnv)->CurrentFocus->theModule); }
     }

   /*===================================*/
   /* Return the number of rules fired. */
   /*===================================*/

   EngineData(theEnv)->AlreadyRunning = FALSE;
   return(rulesFired);
  }
Ejemplo n.º 14
0
globle BOOLEAN EnvClear_PY(
  void *theEnv)
  {
   struct callFunctionItem *theFunction;

   /*==========================================*/
   /* Activate the watch router which captures */
   /* trace output so that it is not displayed */
   /* during a clear.                          */
   /*==========================================*/

#if DEBUGGING_FUNCTIONS
   EnvActivateRouter(theEnv,WTRACE);
#endif

   /*===================================*/
   /* Determine if a clear is possible. */
   /*===================================*/

   ConstructData(theEnv)->ClearReadyInProgress = TRUE;
   if (ClearReady(theEnv) == FALSE)
     {
      PrintErrorID(theEnv,"CONSTRCT",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Some constructs are still in use. Clear cannot continue.\n");
#if DEBUGGING_FUNCTIONS
      EnvDeactivateRouter(theEnv,WTRACE);
#endif
      ConstructData(theEnv)->ClearReadyInProgress = FALSE;
      return FALSE;
     }
   ConstructData(theEnv)->ClearReadyInProgress = FALSE;

   /*===========================*/
   /* Call all clear functions. */
   /*===========================*/

   ConstructData(theEnv)->ClearInProgress = TRUE;

   for (theFunction = ConstructData(theEnv)->ListOfClearFunctions;
        theFunction != NULL;
        theFunction = theFunction->next)
     {
      if (theFunction->environmentAware)
        { (*theFunction->func)(theEnv); }
      else
        { (* (void (*)(void)) theFunction->func)(); }
     }

   /*=============================*/
   /* Deactivate the watch router */
   /* for capturing output.       */
   /*=============================*/

#if DEBUGGING_FUNCTIONS
   EnvDeactivateRouter(theEnv,WTRACE);
#endif

   /*===========================================*/
   /* Perform periodic cleanup if the clear was */
   /* issued from an embedded controller.       */
   /*===========================================*/

   if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
       (EvaluationData(theEnv)->CurrentExpression == NULL))
     { PeriodicCleanup(theEnv,TRUE,FALSE); }

   /*===========================*/
   /* Clear has been completed. */
   /*===========================*/

   ConstructData(theEnv)->ClearInProgress = FALSE;
   return TRUE;
  }
Ejemplo n.º 15
0
globle void *Assert(
  void *vTheFact)
  {
   int hashValue;
   int length, i;
   struct field *theField;
   struct fact *theFact = (struct fact *) vTheFact;

   /*==========================================*/
   /* A fact can not be asserted while another */
   /* fact is being asserted or retracted.     */
   /*==========================================*/

   if (JoinOperationInProgress)
     {
      ReturnFact(theFact);
      PrintErrorID("FACTMNGR",2,TRUE);
      PrintRouter(WERROR,"Facts may not be asserted during pattern-matching\n");
      return(NULL);
     }

   /*=============================================================*/
   /* Replace invalid data types in the fact with the symbol nil. */
   /*=============================================================*/

   length = theFact->theProposition.multifieldLength;
   theField = theFact->theProposition.theFields;

   for (i = 0; i < length; i++)
     {
      if (theField[i].type == RVOID)
        {
         theField[i].type = SYMBOL;
         theField[i].value = (void *) AddSymbol("nil");
        }
     }

   /*========================================================*/
   /* If fact assertions are being checked for duplications, */
   /* then search the fact list for a duplicate fact.        */
   /*========================================================*/

   hashValue = HandleFactDuplication(theFact);
   if (hashValue < 0) return(NULL);

   /*==========================================================*/
   /* If necessary, add logical dependency links between the   */
   /* fact and the partial match which is its logical support. */
   /*==========================================================*/

#if LOGICAL_DEPENDENCIES
   if (AddLogicalDependencies((struct patternEntity *) theFact,FALSE) == FALSE)
     {
      ReturnFact(theFact);
      return(NULL);
     }
#endif

   /*======================================*/
   /* Add the fact to the fact hash table. */
   /*======================================*/

   AddHashedFact(theFact,hashValue);

   /*================================*/
   /* Add the fact to the fact list. */
   /*================================*/

   theFact->nextFact = NULL;
   theFact->list = NULL;
   theFact->previousFact = LastFact;
   if (LastFact == NULL)
     { FactList = theFact; }
   else
     { LastFact->nextFact = theFact; }
   LastFact = theFact;

   /*==================================*/
   /* Set the fact index and time tag. */
   /*==================================*/

   theFact->factIndex = NextFactIndex++;
   theFact->factHeader.timeTag = CurrentEntityTimeTag++;

   /*=====================*/
   /* Update busy counts. */
   /*=====================*/

   FactInstall(theFact);

   /*==========================*/
   /* Print assert output if   */
   /* facts are being watched. */
   /*==========================*/

#if DEBUGGING_FUNCTIONS
   if (theFact->whichDeftemplate->watch)
     {
      PrintRouter(WTRACE,"==> ");
      PrintFactWithIdentifier(WTRACE,theFact);
      PrintRouter(WTRACE,"\n");
     }
#endif

   /*==================================*/
   /* Set the change flag to indicate  */
   /* the fact-list has been modified. */
   /*==================================*/

   ChangeToFactList = TRUE;

   /*==========================================*/
   /* Check for constraint errors in the fact. */
   /*==========================================*/

   CheckTemplateFact(theFact);

   /*===================================================*/
   /* Reset the evaluation error flag since expressions */
   /* will be evaluated as part of the assert .         */
   /*===================================================*/

   SetEvaluationError(FALSE);

   /*=============================================*/
   /* Pattern match the fact using the associated */
   /* deftemplate's pattern network.              */
   /*=============================================*/

   JoinOperationInProgress = TRUE;
   FactPatternMatch(theFact,theFact->whichDeftemplate->patternNetwork,0,NULL,NULL);
   JoinOperationInProgress = FALSE;

   /*===================================================*/
   /* Retract other facts that were logically dependent */
   /* on the non-existence of the fact just asserted.   */
   /*===================================================*/

#if LOGICAL_DEPENDENCIES
   ForceLogicalRetractions();
#endif

   /*=========================================*/
   /* Free partial matches that were released */
   /* by the assertion of the fact.           */
   /*=========================================*/

   if (ExecutingRule == NULL) FlushGarbagePartialMatches();

   /*==========================================*/
   /* Force periodic cleanup if the assert was */
   /* executed from an embedded application.   */
   /*==========================================*/

   if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
       (CurrentExpression == NULL))
     { PeriodicCleanup(TRUE,FALSE); }

   /*===============================*/
   /* Return a pointer to the fact. */
   /*===============================*/

   return((void *) theFact);
  }
Ejemplo n.º 16
0
globle void LoopForCountFunction(
  DATA_OBJECT_PTR loopResult)
  {
   DATA_OBJECT arg_ptr;
   long iterationEnd;
   LOOP_COUNTER_STACK *tmpCounter;

   tmpCounter = get_struct(loopCounterStack);
   tmpCounter->loopCounter = 0L;
   tmpCounter->nxt = LoopCounterStack;
   LoopCounterStack = tmpCounter;
   if (ArgTypeCheck("loop-for-count",1,INTEGER,&arg_ptr) == FALSE)
     {
      loopResult->type = SYMBOL;
      loopResult->value = FalseSymbol;
      LoopCounterStack = tmpCounter->nxt;
      rtn_struct(loopCounterStack,tmpCounter);
      return;
     }
   tmpCounter->loopCounter = DOToLong(arg_ptr);
   if (ArgTypeCheck("loop-for-count",2,INTEGER,&arg_ptr) == FALSE)
     {
      loopResult->type = SYMBOL;
      loopResult->value = FalseSymbol;
      LoopCounterStack = tmpCounter->nxt;
      rtn_struct(loopCounterStack,tmpCounter);
      return;
     }
   iterationEnd = DOToLong(arg_ptr);
   while ((tmpCounter->loopCounter <= iterationEnd) &&
          (HaltExecution != TRUE))
     {
      if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
        break;
      CurrentEvaluationDepth++;
      RtnUnknown(3,&arg_ptr);
      CurrentEvaluationDepth--;
      if (ReturnFlag == TRUE)
        { PropagateReturnValue(&arg_ptr); }
      PeriodicCleanup(FALSE,TRUE);
      if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
        break;
      tmpCounter->loopCounter++;
     }

   BreakFlag = FALSE;
   if (ReturnFlag == TRUE)
     {
      loopResult->type = arg_ptr.type;
      loopResult->value = arg_ptr.value;
      loopResult->begin = arg_ptr.begin;
      loopResult->end = arg_ptr.end;
     }
   else
     {
      loopResult->type = SYMBOL;
      loopResult->value = FalseSymbol;
     }
   LoopCounterStack = tmpCounter->nxt;
   rtn_struct(loopCounterStack,tmpCounter);
  }
Ejemplo n.º 17
0
globle void QSetDefglobalValue(
  void *theEnv,
  struct defglobal *theGlobal,
  DATA_OBJECT_PTR vPtr,
  int resetVar)
  {
   /*====================================================*/
   /* If the new value passed for the defglobal is NULL, */
   /* then reset the defglobal to the initial value it   */
   /* had when it was defined.                           */
   /*====================================================*/

   if (resetVar)
     {
      EvaluateExpression(theEnv,theGlobal->initial,vPtr);
      if (EvaluationData(theEnv)->EvaluationError)
        {
         vPtr->type = SYMBOL;
         vPtr->value = EnvFalseSymbol(theEnv);
        }
     }

   /*==========================================*/
   /* If globals are being watch, then display */
   /* the change to the global variable.       */
   /*==========================================*/

#if DEBUGGING_FUNCTIONS
   if (theGlobal->watch)
     {
      EnvPrintRouter(theEnv,WTRACE,":== ?*");
      EnvPrintRouter(theEnv,WTRACE,ValueToString(theGlobal->header.name));
      EnvPrintRouter(theEnv,WTRACE,"* ==> ");
      PrintDataObject(theEnv,WTRACE,vPtr);
      EnvPrintRouter(theEnv,WTRACE," <== ");
      PrintDataObject(theEnv,WTRACE,&theGlobal->current);
      EnvPrintRouter(theEnv,WTRACE,"\n");
     }
#endif

   /*==============================================*/
   /* Remove the old value of the global variable. */
   /*==============================================*/

   ValueDeinstall(theEnv,&theGlobal->current);
   if (theGlobal->current.type == MULTIFIELD)
     { ReturnMultifield(theEnv,(struct multifield *) theGlobal->current.value); }

   /*===========================================*/
   /* Set the new value of the global variable. */
   /*===========================================*/

   theGlobal->current.type = vPtr->type;
   if (vPtr->type != MULTIFIELD) theGlobal->current.value = vPtr->value;
   else DuplicateMultifield(theEnv,&theGlobal->current,vPtr);
   ValueInstall(theEnv,&theGlobal->current);

   /*===========================================*/
   /* Set the variable indicating that a change */
   /* has been made to a global variable.       */
   /*===========================================*/

   DefglobalData(theEnv)->ChangeToGlobals = TRUE;

   if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
       (EvaluationData(theEnv)->CurrentExpression == NULL))
     { PeriodicCleanup(theEnv,TRUE,FALSE); }
  }
Ejemplo n.º 18
0
globle void Reset()
  {
   struct callFunctionItem *resetPtr;

   /*=====================================*/
   /* The reset command can't be executed */
   /* while a reset is in progress.       */
   /*=====================================*/

   if (ResetInProgress) return;

   ResetInProgress = TRUE;
   ResetReadyInProgress = TRUE;

   /*================================================*/
   /* If the reset is performed from the top level   */
   /* command prompt, reset the halt execution flag. */
   /*================================================*/

   if (CurrentEvaluationDepth == 0) SetHaltExecution(FALSE);

   /*=======================================================*/
   /* Call the before reset function to determine if the    */
   /* reset should continue. [Used by the some of the       */
   /* windowed interfaces to query the user whether a       */
   /* reset should proceed with activations on the agenda.] */
   /*=======================================================*/

   if ((BeforeResetFunction != NULL) ? ((*BeforeResetFunction)() == FALSE) :
                                       FALSE)
     {
      ResetReadyInProgress = FALSE;
      ResetInProgress = FALSE;
      return;
     }
   ResetReadyInProgress = FALSE;

   /*===========================*/
   /* Call each reset function. */
   /*===========================*/

   for (resetPtr = ListOfResetFunctions;
        (resetPtr != NULL) && (GetHaltExecution() == FALSE);
        resetPtr = resetPtr->next)
     { (*resetPtr->func)(); }

   /*============================================*/
   /* Set the current module to the MAIN module. */
   /*============================================*/

   SetCurrentModule((void *) FindDefmodule("MAIN"));

   /*===========================================*/
   /* Perform periodic cleanup if the reset was */
   /* issued from an embedded controller.       */
   /*===========================================*/

   if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
       (CurrentExpression == NULL))
     { PeriodicCleanup(TRUE,FALSE); }

   /*===================================*/
   /* A reset is no longer in progress. */
   /*===================================*/

   ResetInProgress = FALSE;
  }
Ejemplo n.º 19
0
globle void EnvReset(
  void *theEnv,
  EXEC_STATUS)
  {
   struct callFunctionItem *resetPtr;

   /*=====================================*/
   /* The reset command can't be executed */
   /* while a reset is in progress.       */
   /*=====================================*/

   if (ConstructData(theEnv,execStatus)->ResetInProgress) return;

   ConstructData(theEnv,execStatus)->ResetInProgress = TRUE;
   ConstructData(theEnv,execStatus)->ResetReadyInProgress = TRUE;

   /*================================================*/
   /* If the reset is performed from the top level   */
   /* command prompt, reset the halt execution flag. */
   /*================================================*/

   if (execStatus->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,execStatus,FALSE);

   /*=======================================================*/
   /* Call the before reset function to determine if the    */
   /* reset should continue. [Used by the some of the       */
   /* windowed interfaces to query the user whether a       */
   /* reset should proceed with activations on the agenda.] */
   /*=======================================================*/

   if ((ConstructData(theEnv,execStatus)->BeforeResetFunction != NULL) ? 
       ((*ConstructData(theEnv,execStatus)->BeforeResetFunction)(theEnv,execStatus) == FALSE) :
                                       FALSE)
     {
      ConstructData(theEnv,execStatus)->ResetReadyInProgress = FALSE;
      ConstructData(theEnv,execStatus)->ResetInProgress = FALSE;
      return;
     }
   ConstructData(theEnv,execStatus)->ResetReadyInProgress = FALSE;

   /*===========================*/
   /* Call each reset function. */
   /*===========================*/

   for (resetPtr = ConstructData(theEnv,execStatus)->ListOfResetFunctions;
        (resetPtr != NULL) && (GetHaltExecution(theEnv,execStatus) == FALSE);
        resetPtr = resetPtr->next)
     { 
      if (resetPtr->environmentAware)
        { (*resetPtr->func)(theEnv,execStatus); }
      else            
        { (* (void (*)(void)) resetPtr->func)(); }
     }

   /*============================================*/
   /* Set the current module to the MAIN module. */
   /*============================================*/

   EnvSetCurrentModule(theEnv,execStatus,(void *) EnvFindDefmodule(theEnv,execStatus,"MAIN"));

   /*===========================================*/
   /* Perform periodic cleanup if the reset was */
   /* issued from an embedded controller.       */
   /*===========================================*/

   if ((execStatus->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv,execStatus)->EvaluatingTopLevelCommand) &&
       (execStatus->CurrentExpression == NULL))
     { PeriodicCleanup(theEnv,execStatus,TRUE,FALSE); }

   /*===================================*/
   /* A reset is no longer in progress. */
   /*===================================*/

   ConstructData(theEnv,execStatus)->ResetInProgress = FALSE;
  }
Ejemplo n.º 20
0
globle void Clear()
  {
   struct callFunctionItem *theFunction;

   /*==========================================*/
   /* Activate the watch router which captures */
   /* trace output so that it is not displayed */
   /* during a clear.                          */
   /*==========================================*/

#if DEBUGGING_FUNCTIONS
   ActivateRouter(WTRACE);
#endif

   /*===================================*/
   /* Determine if a clear is possible. */
   /*===================================*/

   ClearReadyInProgress = TRUE;
   if (ClearReady() == FALSE)
     {
      PrintErrorID("CONSTRCT",1,FALSE);
      PrintRouter(WERROR,"Some constructs are still in use. Clear cannot continue.\n");
#if DEBUGGING_FUNCTIONS
      DeactivateRouter(WTRACE);
#endif
      ClearReadyInProgress = FALSE;
      return;
     }
   ClearReadyInProgress = FALSE;

   /*===========================*/
   /* Call all clear functions. */
   /*===========================*/

   ClearInProgress = TRUE;

   for (theFunction = ListOfClearFunctions;
        theFunction != NULL;
        theFunction = theFunction->next)
     { (*theFunction->func)(); }

   /*=============================*/
   /* Deactivate the watch router */
   /* for capturing output.       */
   /*=============================*/

#if DEBUGGING_FUNCTIONS
   DeactivateRouter(WTRACE);
#endif

   /*===========================================*/
   /* Perform periodic cleanup if the clear was */
   /* issued from an embedded controller.       */
   /*===========================================*/

   if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
       (CurrentExpression == NULL))
     { PeriodicCleanup(TRUE,FALSE); }

   /*===========================*/
   /* Clear has been completed. */
   /*===========================*/

   ClearInProgress = FALSE;
  }
Ejemplo n.º 21
0
/*****************************************************
  NAME         : PerformMessage
  DESCRIPTION  : Calls core framework for a message
  INPUTS       : 1) Caller's result buffer
                 2) Message argument expressions
                    (including implicit object)
                 3) Message name
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any side-effects of message execution
                    and caller's result buffer set
  NOTES        : None
 *****************************************************/
static void PerformMessage(
  DATA_OBJECT *result,
  EXPRESSION *args,
  SYMBOL_HN *mname)
  {
   int oldce;
   HANDLER_LINK *oldCore;
   DEFCLASS *cls = NULL;
   INSTANCE_TYPE *ins = NULL;
   SYMBOL_HN *oldName;
#if PROFILING_FUNCTIONS
   struct profileFrameInfo profileFrame;
#endif

   result->type = SYMBOL;
   result->value = FalseSymbol;
   EvaluationError = FALSE;
   if (HaltExecution)
     return;
   oldce = ExecutingConstruct();
   SetExecutingConstruct(TRUE);
   oldName = CurrentMessageName;
   CurrentMessageName = mname;
   CurrentEvaluationDepth++;
   PushProcParameters(args,CountArguments(args),
                        ValueToString(CurrentMessageName),"message",
                        UnboundHandlerErr);

   if (EvaluationError)
     {
      CurrentEvaluationDepth--;
      CurrentMessageName = oldName;
      PeriodicCleanup(FALSE,TRUE);
      SetExecutingConstruct(oldce);
      return;
     }

   if (ProcParamArray->type == INSTANCE_ADDRESS)
     {
      ins = (INSTANCE_TYPE *) ProcParamArray->value;
      if (ins->garbage == 1)
        {
         StaleInstanceAddress("send",0);
         SetEvaluationError(TRUE);
        }
      else if (DefclassInScope(ins->cls,(struct defmodule *) GetCurrentModule()) == FALSE)
        NoInstanceError(ValueToString(ins->name),"send");
      else
        {
         cls = ins->cls;
         ins->busy++;
        }
     }
   else if (ProcParamArray->type == INSTANCE_NAME)
     {
      ins = FindInstanceBySymbol((SYMBOL_HN *) ProcParamArray->value);
      if (ins == NULL)
        {
         PrintErrorID("MSGPASS",2,FALSE);
         PrintRouter(WERROR,"No such instance ");
         PrintRouter(WERROR,ValueToString((SYMBOL_HN *) ProcParamArray->value));
         PrintRouter(WERROR," in function send.\n");
         SetEvaluationError(TRUE);
        }
      else
        {
         ProcParamArray->value = (void *) ins;
         ProcParamArray->type = INSTANCE_ADDRESS;
         cls = ins->cls;
         ins->busy++;
        }
     }
   else if ((cls = PrimitiveClassMap[ProcParamArray->type]) == NULL)
     {
      SystemError("MSGPASS",1);
      ExitRouter(EXIT_FAILURE);
     }
   if (EvaluationError)
     {
      PopProcParameters();
      CurrentEvaluationDepth--;
      CurrentMessageName = oldName;
      PeriodicCleanup(FALSE,TRUE);
      SetExecutingConstruct(oldce);
      return;
     }

   oldCore = TopOfCore;
   TopOfCore = FindApplicableHandlers(cls,mname);

   if (TopOfCore != NULL)
     {
      HANDLER_LINK *oldCurrent,*oldNext;

      oldCurrent = CurrentCore;
      oldNext = NextInCore;

#if IMPERATIVE_MESSAGE_HANDLERS

      if (TopOfCore->hnd->type == MAROUND)
        {
         CurrentCore = TopOfCore;
         NextInCore = TopOfCore->nxt;
#if DEBUGGING_FUNCTIONS
         if (WatchMessages)
           WatchMessage(WTRACE,BEGIN_TRACE);
         if (CurrentCore->hnd->trace)
           WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE);
#endif
         if (CheckHandlerArgCount())
           {
#if PROFILING_FUNCTIONS
            StartProfile(&profileFrame,
                         &CurrentCore->hnd->usrData,
                         ProfileConstructs);
#endif


           EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule,
                               CurrentCore->hnd->actions,
                               CurrentCore->hnd->localVarCount,
                               result,UnboundHandlerErr);


#if PROFILING_FUNCTIONS
            EndProfile(&profileFrame);
#endif
           }

#if DEBUGGING_FUNCTIONS
         if (CurrentCore->hnd->trace)
           WatchHandler(WTRACE,CurrentCore,END_TRACE);
         if (WatchMessages)
           WatchMessage(WTRACE,END_TRACE);
#endif
        }
      else

#endif  /* IMPERATIVE_MESSAGE_HANDLERS */

        {
         CurrentCore = NULL;
         NextInCore = TopOfCore;
#if DEBUGGING_FUNCTIONS
         if (WatchMessages)
           WatchMessage(WTRACE,BEGIN_TRACE);
#endif
         CallHandlers(result);
#if DEBUGGING_FUNCTIONS
         if (WatchMessages)
           WatchMessage(WTRACE,END_TRACE);
#endif
        }

      DestroyHandlerLinks(TopOfCore);
      CurrentCore = oldCurrent;
      NextInCore = oldNext;
     }

   TopOfCore = oldCore;
   ReturnFlag = FALSE;

   if (ins != NULL)
     ins->busy--;

   /* ==================================
      Restore the original calling frame
      ================================== */
   PopProcParameters();
   CurrentEvaluationDepth--;
   CurrentMessageName = oldName;
   PropagateReturnValue(result);
   PeriodicCleanup(FALSE,TRUE);
   SetExecutingConstruct(oldce);
   if (EvaluationError)
     {
      result->type = SYMBOL;
      result->value = FalseSymbol;
     }
  }
Ejemplo n.º 22
0
globle int LoadConstructsFromLogicalName(
  void *theEnv,
  char *readSource)
  {
   int constructFlag;
   struct token theToken;
   int noErrors = TRUE;
   int foundConstruct;

   /*=========================================*/
   /* Reset the halt execution and evaluation */
   /* error flags in preparation for parsing. */
   /*=========================================*/

   if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE);
   SetEvaluationError(theEnv,FALSE);

   /*========================================================*/
   /* Find the beginning of the first construct in the file. */
   /*========================================================*/

   EvaluationData(theEnv)->CurrentEvaluationDepth++;
   GetToken(theEnv,readSource,&theToken);
   foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors);

   /*==================================================*/
   /* Parse the file until the end of file is reached. */
   /*==================================================*/

   while ((foundConstruct == TRUE) && (GetHaltExecution(theEnv) == FALSE))
     {
      /*===========================================================*/
      /* Clear the pretty print buffer in preparation for parsing. */
      /*===========================================================*/

      FlushPPBuffer(theEnv);

      /*======================*/
      /* Parse the construct. */
      /*======================*/

      constructFlag = ParseConstruct(theEnv,ValueToString(theToken.value),readSource);

      /*==============================================================*/
      /* If an error occurred while parsing, then find the beginning  */
      /* of the next construct (but don't generate any more error     */
      /* messages--in effect, skip everything until another construct */
      /* is found).                                                   */
      /*==============================================================*/

      if (constructFlag == 1)
        {
         EnvPrintRouter(theEnv,WERROR,"\nERROR:\n");
         PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv));
         EnvPrintRouter(theEnv,WERROR,"\n");
         noErrors = FALSE;
         GetToken(theEnv,readSource,&theToken);
         foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,TRUE,&noErrors);
        }

      /*======================================================*/
      /* Otherwise, find the beginning of the next construct. */
      /*======================================================*/

      else
        {
         GetToken(theEnv,readSource,&theToken);
         foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors);
        }

      /*=====================================================*/
      /* Yield time if necessary to foreground applications. */
      /*=====================================================*/

       if (foundConstruct)
         { IncrementSymbolCount(theToken.value); }
       EvaluationData(theEnv)->CurrentEvaluationDepth--;
       PeriodicCleanup(theEnv,FALSE,TRUE);
       YieldTime(theEnv);
       EvaluationData(theEnv)->CurrentEvaluationDepth++;
       if (foundConstruct)
         { DecrementSymbolCount(theEnv,(SYMBOL_HN *) theToken.value); }
     }

   EvaluationData(theEnv)->CurrentEvaluationDepth--;

   /*========================================================*/
   /* Print a carriage return if a single character is being */
   /* printed to indicate constructs are being processed.    */
   /*========================================================*/

#if DEBUGGING_FUNCTIONS
   if ((EnvGetWatchItem(theEnv,"compilations") != TRUE) && GetPrintWhileLoading(theEnv))
#else
   if (GetPrintWhileLoading(theEnv))
#endif
     { EnvPrintRouter(theEnv,WDIALOG,"\n"); }

   /*=============================================================*/
   /* Once the load is complete, destroy the pretty print buffer. */
   /* This frees up any memory that was used to create the pretty */
   /* print forms for constructs during parsing. Thus calls to    */
   /* the mem-used function will accurately reflect the amount of */
   /* memory being used after a load command.                     */
   /*=============================================================*/

   DestroyPPBuffer(theEnv);

   /*==========================================================*/
   /* Return a boolean flag which indicates whether any errors */
   /* were encountered while loading the constructs.           */
   /*==========================================================*/

   return(noErrors);
  }
Ejemplo n.º 23
0
globle BOOLEAN Retract(
  void *vTheFact)
  {
   struct fact *theFact = (struct fact *) vTheFact;

   /*===========================================*/
   /* A fact can not be retracted while another */
   /* fact is being asserted or retracted.      */
   /*===========================================*/

   if (JoinOperationInProgress)
     {
      PrintErrorID("FACTMNGR",1,TRUE);
      PrintRouter(WERROR,"Facts may not be retracted during pattern-matching\n");
      return(FALSE);
     }

   /*====================================*/
   /* A NULL fact pointer indicates that */
   /* all facts should be retracted.     */
   /*====================================*/

   if (theFact == NULL)
     {
      RemoveAllFacts();
      return(TRUE);
     }

   /*======================================================*/
   /* Check to see if the fact has already been retracted. */
   /*======================================================*/

   if (theFact->garbage) return(FALSE);

   /*============================*/
   /* Print retraction output if */
   /* facts are being watched.   */
   /*============================*/

#if DEBUGGING_FUNCTIONS
   if (theFact->whichDeftemplate->watch)
     {
      PrintRouter(WTRACE,"<== ");
      PrintFactWithIdentifier(WTRACE,theFact);
      PrintRouter(WTRACE,"\n");
     }
#endif

   /*==================================*/
   /* Set the change flag to indicate  */
   /* the fact-list has been modified. */
   /*==================================*/

   ChangeToFactList = TRUE;

   /*===============================================*/
   /* Remove any links between the fact and partial */
   /* matches in the join network. These links are  */
   /* used to keep track of logical dependencies.   */
   /*===============================================*/

#if LOGICAL_DEPENDENCIES
   RemoveEntityDependencies((struct patternEntity *) theFact);
#endif

   /*===========================================*/
   /* Remove the fact from the fact hash table. */
   /*===========================================*/

   RemoveHashedFact(theFact);

   /*=====================================*/
   /* Remove the fact from the fact list. */
   /*=====================================*/

   if (theFact == LastFact)
     { LastFact = theFact->previousFact; }

   if (theFact->previousFact == NULL)
     {
      FactList = FactList->nextFact;
      if (FactList != NULL)
        { FactList->previousFact = NULL; }
     }
   else
     {
      theFact->previousFact->nextFact = theFact->nextFact;
      if (theFact->nextFact != NULL)
        { theFact->nextFact->previousFact = theFact->previousFact; }
     }

   /*==================================*/
   /* Update busy counts and ephemeral */
   /* garbage information.             */
   /*==================================*/

   FactDeinstall(theFact);
   EphemeralItemCount++;
   EphemeralItemSize += sizeof(struct fact) + (sizeof(struct field) * theFact->theProposition.multifieldLength);

   /*========================================*/
   /* Add the fact to the fact garbage list. */
   /*========================================*/

   theFact->nextFact = GarbageFacts;
   GarbageFacts = theFact;
   theFact->garbage = TRUE;

   /*===================================================*/
   /* Reset the evaluation error flag since expressions */
   /* will be evaluated as part of the retract.         */
   /*===================================================*/

   SetEvaluationError(FALSE);

   /*===========================================*/
   /* Loop through the list of all the patterns */
   /* that matched the fact and process the     */
   /* retract operation for each one.           */
   /*===========================================*/

   JoinOperationInProgress = TRUE;
   NetworkRetract((struct patternMatch *) theFact->list);
   JoinOperationInProgress = FALSE;

   /*=========================================*/
   /* Free partial matches that were released */
   /* by the retraction of the fact.          */
   /*=========================================*/

   if (ExecutingRule == NULL)
     { FlushGarbagePartialMatches(); }

   /*=========================================*/
   /* Retract other facts that were logically */
   /* dependent on the fact just retracted.   */
   /*=========================================*/

#if LOGICAL_DEPENDENCIES
   ForceLogicalRetractions();
#endif

   /*===========================================*/
   /* Force periodic cleanup if the retract was */
   /* executed from an embedded application.    */
   /*===========================================*/

   if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
       (CurrentExpression == NULL))
     { PeriodicCleanup(TRUE,FALSE); }

   /*==================================*/
   /* Return TRUE to indicate the fact */
   /* was successfully retracted.      */
   /*==================================*/

   return(TRUE);
  }
Ejemplo n.º 24
0
/*****************************************************************
  NAME         : TestEntireTemplate
  DESCRIPTION  : Processes all facts in a template
  INPUTS       : 1) The module for which templates tested must be
                    in scope
                 3) The template
                 4) The current template restriction chain
                 5) The index of the current restriction
  RETURNS      : Nothing useful
  SIDE EFFECTS : Instance variable values set
                 Solution sets stored in global list
  NOTES        : None
 *****************************************************************/
static void TestEntireTemplate(
  void *theEnv,
  struct deftemplate *templatePtr,
  QUERY_TEMPLATE *qchain,
  int indx)
  {
   struct fact *theFact;
   DATA_OBJECT temp;

   theFact = templatePtr->factList;
   while (theFact != NULL)
     {
      FactQueryData(theEnv)->QueryCore->solns[indx] = theFact;
      if (qchain->nxt != NULL)
        {
         theFact->factHeader.busyCount++;
         TestEntireChain(theEnv,qchain->nxt,indx+1);
         theFact->factHeader.busyCount--;
         if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
           break;
        }
      else
        { 
         theFact->factHeader.busyCount++;
         EvaluationData(theEnv)->CurrentEvaluationDepth++;
         EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp);
         EvaluationData(theEnv)->CurrentEvaluationDepth--;
         PeriodicCleanup(theEnv,FALSE,TRUE);
         theFact->factHeader.busyCount--;
         if (EvaluationData(theEnv)->HaltExecution == TRUE)
           break;
         if ((temp.type != SYMBOL) ? TRUE :
             (temp.value != EnvFalseSymbol(theEnv)))
           {
            if (FactQueryData(theEnv)->QueryCore->action != NULL)
              {
               theFact->factHeader.busyCount++;
               EvaluationData(theEnv)->CurrentEvaluationDepth++;
               ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
               EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,FactQueryData(theEnv)->QueryCore->result);
               ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
               EvaluationData(theEnv)->CurrentEvaluationDepth--;
               PeriodicCleanup(theEnv,FALSE,TRUE);
               theFact->factHeader.busyCount--;
               if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
                 {
                  FactQueryData(theEnv)->AbortQuery = TRUE;
                  break;
                 }
               if (EvaluationData(theEnv)->HaltExecution == TRUE)
                 break;
              }
            else
              AddSolution(theEnv);
           }
        }
        
      theFact = theFact->nextTemplateFact;
      while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE)
        theFact = theFact->nextTemplateFact;
     }
  }
Ejemplo n.º 25
0
/*****************************************************************
  NAME         : TestEntireClass
  DESCRIPTION  : Processes all instances in a class and then
                   all subclasses of a class until done
  INPUTS       : 1) The module for which classes tested must be
                    in scope
                 2) Visitation traversal id
                 3) The class
                 4) The current class restriction chain
                 5) The index of the current restriction
  RETURNS      : Nothing useful
  SIDE EFFECTS : Instance variable values set
                 Solution sets stored in global list
  NOTES        : None
 *****************************************************************/
static void TestEntireClass(
  struct defmodule *theModule,
  int id,
  DEFCLASS *cls,
  QUERY_CLASS *qchain,
  int indx)
  {
   register unsigned i;
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;

   if (TestTraversalID(cls->traversalRecord,id))
     return;
   SetTraversalID(cls->traversalRecord,id);
   if (DefclassInScope(cls,theModule) == FALSE)
     return;
   ins = cls->instanceList;
   while (ins != NULL)
     {
      QueryCore->solns[indx] = ins;
      if (qchain->nxt != NULL)
        {
         ins->busy++;
         TestEntireChain(qchain->nxt,indx+1);
         ins->busy--;
         if ((HaltExecution == TRUE) || (AbortQuery == TRUE))
           break;
        }
      else
        {
         ins->busy++;
         CurrentEvaluationDepth++;
         EvaluateExpression(QueryCore->query,&temp);
         CurrentEvaluationDepth--;
         PeriodicCleanup(FALSE,TRUE);
         ins->busy--;
         if (HaltExecution == TRUE)
           break;
         if ((temp.type != SYMBOL) ? TRUE :
             (temp.value != FalseSymbol))
           {
            if (QueryCore->action != NULL)
              {
               ins->busy++;
               CurrentEvaluationDepth++;
               ValueDeinstall(QueryCore->result);
               EvaluateExpression(QueryCore->action,QueryCore->result);
               ValueInstall(QueryCore->result);
               CurrentEvaluationDepth--;
               PeriodicCleanup(FALSE,TRUE);
               ins->busy--;
               if (BreakFlag || ReturnFlag)
                 {
                  AbortQuery = TRUE;
                  break;
                 }
               if (HaltExecution == TRUE)
                 break;
              }
            else
              AddSolution();
           }
        }
      ins = ins->nxtClass;
      while ((ins != NULL) ? (ins->garbage == 1) : FALSE)
        ins = ins->nxtClass;
     }
   if (ins != NULL)
     return;
   for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
     {
      TestEntireClass(theModule,id,cls->directSubclasses.classArray[i],qchain,indx);
      if ((HaltExecution == TRUE) || (AbortQuery == TRUE))
        return;
     }
  }