static struct expr *GenPNConstant(
  void *theEnv,
  struct lhsParseNode *theField)
  {
   struct expr *top;

   /*===============================================*/
   /* If the pattern parser is capable of creating  */
   /* a specialized test, then call the function to */
   /* generate the pattern network test and return  */
   /* the expression generated.                     */
   /*===============================================*/

   if (theField->patternType->genPNConstantFunction != NULL)
     { return (*theField->patternType->genPNConstantFunction)(theEnv,theField); }

   /*===================================================*/
   /* Otherwise, generate a test which uses the eq/neq  */
   /* function to compare the pattern field/slot to the */
   /* constant and then return the expression.          */
   /*===================================================*/

   if (theField->negated)
     { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); }
   else
     { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); }

   top->argList = (*theField->patternType->genGetPNValueFunction)(theEnv,theField);
   top->argList->nextArg = GenConstant(theEnv,theField->type,theField->value);

   return(top);
  }

/******************************************************
  NAME         : BsaveMethodRestrictions
  DESCRIPTION  : Bsaves defgeneric methods' retrictions
  INPUTS       : 1) The defgeneric
                 2) Output data file pointer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Defgeneric methods' restrictions saved
  NOTES        : None
 ******************************************************/
static void BsaveMethodRestrictions(
  void *theEnv,
  struct constructHeader *theDefgeneric,
  void *userBuffer)
  {
   DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric;
   BSAVE_RESTRICTION dummy_restriction;
   RESTRICTION *rptr;
   short i,j;

   for (i = 0 ; i < gfunc->mcnt ; i++)
     {
      for (j = 0 ; j < gfunc->methods[i].restrictionCount ; j++)
        {
         rptr = &gfunc->methods[i].restrictions[j];
         dummy_restriction.tcnt = rptr->tcnt;
         if (rptr->types != NULL)
           {
            dummy_restriction.types = DefgenericBinaryData(theEnv)->TypeCount;
            DefgenericBinaryData(theEnv)->TypeCount += rptr->tcnt;
           }
         else
           dummy_restriction.types = -1L;
         if (rptr->query != NULL)
           {
            dummy_restriction.query = ExpressionData(theEnv)->ExpressionCount;
            ExpressionData(theEnv)->ExpressionCount += ExpressionSize(rptr->query);
           }
         else
           dummy_restriction.query = -1L;
         GenWrite((void *) &dummy_restriction,
                  sizeof(BSAVE_RESTRICTION),(FILE *) userBuffer);
        }
     }
  }

static void MarkDefgenericItems(
  void *theEnv,
  struct constructHeader *theDefgeneric,
  void *userBuffer)
  {
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(userBuffer)
#endif
   DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric;
   long i,j;
   DEFMETHOD *meth;
   RESTRICTION *rptr;

   MarkConstructHeaderNeededItems(&gfunc->header,DefgenericBinaryData(theEnv)->GenericCount++);
   DefgenericBinaryData(theEnv)->MethodCount += (long) gfunc->mcnt;
   for (i = 0 ; i < gfunc->mcnt ; i++)
     {
      meth = &gfunc->methods[i];
      ExpressionData(theEnv)->ExpressionCount += ExpressionSize(meth->actions);
      MarkNeededItems(theEnv,meth->actions);
      DefgenericBinaryData(theEnv)->RestrictionCount += meth->restrictionCount;
      for (j = 0 ; j < meth->restrictionCount ; j++)
        {
         rptr = &meth->restrictions[j];
         ExpressionData(theEnv)->ExpressionCount += ExpressionSize(rptr->query);
         MarkNeededItems(theEnv,rptr->query);
         DefgenericBinaryData(theEnv)->TypeCount += rptr->tcnt;
        }
     }
  }

static struct expr *GenPNEq(
  void *theEnv,
  struct lhsParseNode *theField)
  {
   struct expr *top, *conversion;

   /*==================================================*/
   /* Replace variables with function calls to extract */
   /* the appropriate value from the data entity.      */
   /*==================================================*/

   conversion = GetfieldReplace(theEnv,theField->expression);

   /*============================================================*/
   /* If the return value constraint is negated by a ~, then use */
   /* the neq function to compare the value of the field to the  */
   /* value returned by the function call. Otherwise, use eq to  */
   /* compare the two values.                                    */
   /*============================================================*/

   if (theField->negated)
     { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); }
   else
     { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); }

   top->argList = (*theField->patternType->genGetPNValueFunction)(theEnv,theField);
   top->argList->nextArg = conversion;

   return(top);
  }

void RefreshExpressions(
  Environment *theEnv)
  {
   if (ExpressionData(theEnv)->ExpressionArray == NULL) return;

   BloadandRefresh(theEnv,ExpressionData(theEnv)->NumberOfExpressions,
                   sizeof(BSAVE_EXPRESSION),UpdateExpression);
  }

globle intBool EnvSetSequenceOperatorRecognition(
  void *theEnv,
  int value)
  {
   int ov;

   ov = ExpressionData(theEnv)->SequenceOpMode;
   ExpressionData(theEnv)->SequenceOpMode = value;
   return(ov);
  }

globle int ParseConstruct(
  void *theEnv,
  char *name,
  char *logicalName)
  {
   struct construct *currentPtr;
   int rv, ov;

   /*=================================*/
   /* Look for a valid construct name */
   /* (e.g. defrule, deffacts).       */
   /*=================================*/

   currentPtr = FindConstruct(theEnv,name);
   if (currentPtr == NULL) return(-1);

   /*==================================*/
   /* Prepare the parsing environment. */
   /*==================================*/

   ov = GetHaltExecution(theEnv);
   SetEvaluationError(theEnv,FALSE);
   SetHaltExecution(theEnv,FALSE);
   ClearParsedBindNames(theEnv);
   PushRtnBrkContexts(theEnv);
   ExpressionData(theEnv)->ReturnContext = FALSE;
   ExpressionData(theEnv)->BreakContext = FALSE;
   EvaluationData(theEnv)->CurrentEvaluationDepth++;

   /*=======================================*/
   /* Call the construct's parsing routine. */
   /*=======================================*/

   ConstructData(theEnv)->ParsingConstruct = TRUE;
   rv = (*currentPtr->parseFunction)(theEnv,logicalName);
   ConstructData(theEnv)->ParsingConstruct = FALSE;

   /*===============================*/
   /* Restore environment settings. */
   /*===============================*/

   EvaluationData(theEnv)->CurrentEvaluationDepth--;
   PopRtnBrkContexts(theEnv);

   ClearParsedBindNames(theEnv);
   SetPPBufferStatus(theEnv,OFF);
   SetHaltExecution(theEnv,ov);

   /*==============================*/
   /* Return the status of parsing */
   /* the construct.               */
   /*==============================*/

   return(rv);
  }

globle void PushRtnBrkContexts(
  void *theEnv)
  {
   SAVED_CONTEXTS *svtmp;

   svtmp = get_struct(theEnv,saved_contexts);
   svtmp->rtn = ExpressionData(theEnv)->ReturnContext;
   svtmp->brk = ExpressionData(theEnv)->BreakContext;
   svtmp->nxt = ExpressionData(theEnv)->svContexts;
   ExpressionData(theEnv)->svContexts = svtmp;
  }

/****************************************************************
  NAME         : SetSORCommand
  DESCRIPTION  : Toggles SequenceOpMode - if TRUE, multifield
                   references are replaced with sequence
                   expansion operators
  INPUTS       : None
  RETURNS      : The old value of SequenceOpMode
  SIDE EFFECTS : SequenceOpMode toggled
  NOTES        : None
 ****************************************************************/
globle BOOLEAN SetSORCommand(
    void *theEnv)
{
#if (! RUN_TIME) && (! BLOAD_ONLY)
    DATA_OBJECT arg;

    if (EnvArgTypeCheck(theEnv,"set-sequence-operator-recognition",1,SYMBOL,&arg) == FALSE)
        return(ExpressionData(theEnv)->SequenceOpMode);
    return(EnvSetSequenceOperatorRecognition(theEnv,(arg.value == EnvFalseSymbol(theEnv)) ?
            FALSE : TRUE));
#else
    return(ExpressionData(theEnv)->SequenceOpMode);
#endif
}

void AllocateExpressions(
  Environment *theEnv)
  {
   size_t space;

   GenReadBinary(theEnv,&ExpressionData(theEnv)->NumberOfExpressions,sizeof(long));
   if (ExpressionData(theEnv)->NumberOfExpressions == 0L)
     ExpressionData(theEnv)->ExpressionArray = NULL;
   else
     {
      space = ExpressionData(theEnv)->NumberOfExpressions * sizeof(struct expr);
      ExpressionData(theEnv)->ExpressionArray = (struct expr *) genalloc(theEnv,space);
     }
  }

/***************************************************
  NAME         : FindHashedExpressions
  DESCRIPTION  : Sets the bsave expression array
                 indices for hashed expression nodes
                 and marks the items needed by
                 these expressions
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Atoms marked and ids set
  NOTES        : None
 ***************************************************/
void FindHashedExpressions(
  Environment *theEnv)
  {
   unsigned i;
   EXPRESSION_HN *exphash;

   for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++)
     for (exphash = ExpressionData(theEnv)->ExpressionHashTable[i] ; exphash != NULL ; exphash = exphash->next)
       {
        MarkNeededItems(theEnv,exphash->exp);
        exphash->bsaveID = ExpressionData(theEnv)->ExpressionCount;
        ExpressionData(theEnv)->ExpressionCount += ExpressionSize(exphash->exp);
       }
  }

static struct expr *ReturnParse(
  void *theEnv,
  struct expr *top,
  char *infile)
  {
   int error_flag = FALSE;
   struct token theToken;

   if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
     ExpressionData(theEnv)->ReturnContext = TRUE;
   if (ExpressionData(theEnv)->ReturnContext == FALSE)
     {
      PrintErrorID(theEnv,"PRCDRPSR",2,TRUE);
      EnvPrintRouter(theEnv,WERROR,"The return function is not valid in this context.\n");
      ReturnExpression(theEnv,top);
      return(NULL);
     }
   ExpressionData(theEnv)->ReturnContext = FALSE;

   SavePPBuffer(theEnv," ");

   top->argList = ArgumentParse(theEnv,infile,&error_flag);
   if (error_flag)
     {
      ReturnExpression(theEnv,top);
      return(NULL);
     }
   else if (top->argList == NULL)
     {
      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv,")");
     }
   else
     {
      SavePPBuffer(theEnv," ");
      GetToken(theEnv,infile,&theToken);
      if (theToken.type != RPAREN)
        {
         SyntaxErrorMessage(theEnv,"return function");
         ReturnExpression(theEnv,top);
         return(NULL);
        }
      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv,")");
     }
   return(top);
  }

static struct expr *BreakParse(
  void *theEnv,
  struct expr *top,
  char *infile)
  {
   struct token theToken;

   if (ExpressionData(theEnv)->svContexts->brk == FALSE)
     {
      PrintErrorID(theEnv,"PRCDRPSR",2,TRUE);
      EnvPrintRouter(theEnv,WERROR,"The break function not valid in this context.\n");
      ReturnExpression(theEnv,top);
      return(NULL);
     }

   SavePPBuffer(theEnv," ");
   GetToken(theEnv,infile,&theToken);
   if (theToken.type != RPAREN)
     {
      SyntaxErrorMessage(theEnv,"break function");
      ReturnExpression(theEnv,top);
      return(NULL);
     }
   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv,")");
   return(top);
  }

/***********************************************************************
  NAME         : ReplaceSequenceExpansionOps
  DESCRIPTION  : Replaces function calls which have multifield
                   references as arguments into a call to a
                   special function which expands the multifield
                   into single arguments at run-time.
                 Multifield references which are not function
                   arguments are errors
  INPUTS       : 1) The expression
                 2) The current function call
                 3) The address of the internal H/L function
                    (expansion-call)
                 4) The address of the H/L function expand$
  RETURNS      : FALSE if OK, TRUE on errors
  SIDE EFFECTS : Function call expressions modified, if necessary
  NOTES        : Function calls which truly want a multifield
                   to be passed need use only a single-field
                   refernce (i.e. ? instead of $? - the $ is
                   being treated as a special expansion operator)
 **********************************************************************/
globle intBool ReplaceSequenceExpansionOps(
  void *theEnv,
  EXPRESSION *actions,
  EXPRESSION *fcallexp,
  void *expcall,
  void *expmult)
  {
   EXPRESSION *theExp;

   while (actions != NULL)
     {
      if ((ExpressionData(theEnv)->SequenceOpMode == FALSE) && (actions->type == MF_VARIABLE))
        actions->type = SF_VARIABLE;
      if ((actions->type == MF_VARIABLE) || (actions->type == MF_GBL_VARIABLE) ||
          (actions->value == expmult))
        {
         if ((fcallexp->type != FCALL) ? FALSE :
             (((struct FunctionDefinition *) fcallexp->value)->sequenceuseok == FALSE))
           {
            PrintErrorID(theEnv,"EXPRNPSR",4,FALSE);
            EnvPrintRouter(theEnv,WERROR,"$ Sequence operator not a valid argument for ");
            EnvPrintRouter(theEnv,WERROR,ValueToString(((struct FunctionDefinition *)
                              fcallexp->value)->callFunctionName));
            EnvPrintRouter(theEnv,WERROR,".\n");
            return(TRUE);
           }
         if (fcallexp->value != expcall)
           {
            theExp = GenConstant(theEnv,fcallexp->type,fcallexp->value);
            theExp->argList = fcallexp->argList;
            theExp->nextArg = NULL;
            fcallexp->type = FCALL;
            fcallexp->value = expcall;
            fcallexp->argList = theExp;
           }
         if (actions->value != expmult)
           {
            theExp = GenConstant(theEnv,SF_VARIABLE,actions->value);
            if (actions->type == MF_GBL_VARIABLE)
              theExp->type = GBL_VARIABLE;
            actions->argList = theExp;
            actions->type = FCALL;
            actions->value = expmult;
           }
        }
      if (actions->argList != NULL)
        {
         if ((actions->type == GCALL) ||
             (actions->type == PCALL) ||
             (actions->type == FCALL))
           theExp = actions;
         else
           theExp = fcallexp;
         if (ReplaceSequenceExpansionOps(theEnv,actions->argList,theExp,expcall,expmult))
           return(TRUE);
        }
      actions = actions->nextArg;
     }
   return(FALSE);
  }

static struct expr *GenJNVariableComparison(
  void *theEnv,
  EXEC_STATUS,
  struct lhsParseNode *selfNode,
  struct lhsParseNode *referringNode,
  int isNand)
  {
   struct expr *top;

   /*========================================================*/
   /* If either pattern is missing a function for generating */
   /* the appropriate test, then no test is generated.       */
   /*========================================================*/

   if ((selfNode->patternType->genCompareJNValuesFunction == NULL) ||
       (referringNode->patternType->genCompareJNValuesFunction == NULL))
     { return(NULL); }

   /*=====================================================*/
   /* If both patterns are of the same type, then use the */
   /* special function for generating the join test.      */
   /*=====================================================*/

   if (selfNode->patternType->genCompareJNValuesFunction ==
       referringNode->patternType->genCompareJNValuesFunction)

     {
      return (*selfNode->patternType->genCompareJNValuesFunction)(theEnv,execStatus,selfNode,
                                                                  referringNode,isNand);
     }

   /*===========================================================*/
   /* If the patterns are of different types, then generate a   */
   /* join test by using the eq/neq function with its arguments */
   /* being function calls to retrieve the appropriate values   */
   /* from the patterns.                                        */
   /*===========================================================*/

   if (selfNode->negated) top = GenConstant(theEnv,execStatus,FCALL,ExpressionData(theEnv,execStatus)->PTR_NEQ);
   else top = GenConstant(theEnv,execStatus,FCALL,ExpressionData(theEnv,execStatus)->PTR_EQ);

   top->argList = (*selfNode->patternType->genGetJNValueFunction)(theEnv,execStatus,selfNode,RHS);
   top->argList->nextArg = (*referringNode->patternType->genGetJNValueFunction)(theEnv,execStatus,referringNode,LHS);

   return(top);
  }

/***************************************************
  NAME         : BsaveDefinstances
  DESCRIPTION  : Bsaves a definstances
  INPUTS       : 1) The definstances
                 2) Output data file pointer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Definstances saved
  NOTES        : None
 ***************************************************/
static void BsaveDefinstances(
  void *theEnv,
  struct constructHeader *theDefinstances,
  void *userBuffer)
  {
   DEFINSTANCES *dptr = (DEFINSTANCES *) theDefinstances;
   BSAVE_DEFINSTANCES dummy_df;

   AssignBsaveConstructHeaderVals(&dummy_df.header,&dptr->header);
  if (dptr->mkinstance != NULL)
     {
      dummy_df.mkinstance = ExpressionData(theEnv)->ExpressionCount;
      ExpressionData(theEnv)->ExpressionCount += ExpressionSize(dptr->mkinstance);
     }
   else
    dummy_df.mkinstance = -1L;
   GenWrite((void *) &dummy_df,(unsigned long) sizeof(BSAVE_DEFINSTANCES),(FILE *) userBuffer);
  }

globle void InitExpressionData(
  void *theEnv)
  {
#if ! RUN_TIME
   register unsigned i;
#endif

   AllocateEnvironmentData(theEnv,EXPRESSION_DATA,sizeof(struct expressionData),DeallocateExpressionData);

#if ! RUN_TIME
   InitExpressionPointers(theEnv);

   ExpressionData(theEnv)->ExpressionHashTable = (EXPRESSION_HN **)
     gm2(theEnv,(int) (sizeof(EXPRESSION_HN *) * EXPRESSION_HASH_SIZE));
   for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++)
     ExpressionData(theEnv)->ExpressionHashTable[i] = NULL;
#endif
  }

globle void InitExpressionPointers(
  void *theEnv)
  {
   ExpressionData(theEnv)->PTR_AND = (void *) FindFunction(theEnv,(char*)"and");
   ExpressionData(theEnv)->PTR_OR = (void *) FindFunction(theEnv,(char*)"or");
   ExpressionData(theEnv)->PTR_EQ = (void *) FindFunction(theEnv,(char*)"eq");
   ExpressionData(theEnv)->PTR_NEQ = (void *) FindFunction(theEnv,(char*)"neq");
   ExpressionData(theEnv)->PTR_NOT = (void *) FindFunction(theEnv,(char*)"not");

   if ((ExpressionData(theEnv)->PTR_AND == NULL) || (ExpressionData(theEnv)->PTR_OR == NULL) ||
       (ExpressionData(theEnv)->PTR_EQ == NULL) || (ExpressionData(theEnv)->PTR_NEQ == NULL) || (ExpressionData(theEnv)->PTR_NOT == NULL))
     {
      SystemError(theEnv,(char*)"EXPRESSN",1);
      EnvExitRouter(theEnv,EXIT_FAILURE);
     }
  }

/***************************************************
  NAME         : BsaveHashedExpressions
  DESCRIPTION  : Writes out hashed expressions
  INPUTS       : Bsave file stream pointer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Expressions written
  NOTES        : None
 ***************************************************/
void BsaveHashedExpressions(
  Environment *theEnv,
  FILE *fp)
  {
   unsigned i;
   EXPRESSION_HN *exphash;

   for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++)
     for (exphash = ExpressionData(theEnv)->ExpressionHashTable[i] ; exphash != NULL ; exphash = exphash->next)
       BsaveExpression(theEnv,exphash->exp,fp);
  }

static struct expr *PrognParse(
  void *theEnv,
  struct expr *top,
  char *infile)
  {
   struct token tkn;
   struct expr *tmp;

   ReturnExpression(theEnv,top);
   ExpressionData(theEnv)->BreakContext = ExpressionData(theEnv)->svContexts->brk;
   ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn;
   IncrementIndentDepth(theEnv,3);
   PPCRAndIndent(theEnv);
   tmp = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE);
   DecrementIndentDepth(theEnv,3);
   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv,tkn.printForm);
   return(tmp);
  }