#if defined(OS390)
#pragma nomargins
#pragma nosequence
#endif

/***********************************************************************
*
* Parse - SLR(1) parser
*
* This routine interprets the parse tables, generated by CHAT, to
* perform the SLR(1) parsing actions.
* Based on Aho and Ullman's parser in "Principles of Compiler Design".
* A lexical scanner is also included to present the input expression
* to the parser as a stream of tokens.
*
* External routines supplied by the user:
*   Parse_Error (error, state);
*
* Files included into the parser:
*   psemant.h     - From CHAT, *.sem
*   ptables.h     - From CHAT, *.ptb
*   perrors.h     - From CHAT, *.err
*   ptokens.h     - From CHAT, *.tok
*
*   errors.h      - User produced
*   scanner.h     - User produced
*   stables.h     - User produced
*
* External State machine tables:
*   parsetable    - From CHAT, ptables.h
*   gototable     - From CHAT, ptables.h
*   chartable     - User produced, stables.h
*   scantable     - User produced, stables.h
*
* This program is free software; you can redistribute it and/or modify it
* under the terms of the GNU General Public License as published by the
* Free Software Foundation; either version 2, or (at your option) any
* later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*
***********************************************************************/
 
/* System includes */
 
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include <math.h>
 
#ifndef TRUE
#define TRUE 1
#endif
 
#ifndef FALSE
#define FALSE 0
#endif
 
 
/* Scanner actions */
 
#define NULL_ACTION     0x00
#define ERROR_ACTION    0x01
#define BACK_ACTION     0x02
#define MOVE_ACTION     0x04
#define EAT_ACTION      0x08
#define BUILD_ACTION    0x10
 
/* Parser actions */
 
#define SHIFT_ACTION    0
#define REDUCE_ACTION   1
 
/* Local types */
 
#include "parser.h"
#define Parse_Error error
 
#include "errors.h"
 
/* Stack element */
 
typedef struct selement {
   struct selement *link;
   pstate   state;
   tokval   svalue;
   char     cvalue[SYMLEN];
} selement_t ;
 
/* Parser tables */
 
#include "ptables.h"
 
/* Scanner tables */
 
#include "stables.h"
 
/* Local static variables */
 
static selement_t *stack;
static selement_t *frees = { NULL };
 
/* External variables */
 
#if defined(OS390)
#define err_flag ERRFLAG
#endif
extern int err_flag;
extern int fpe_stop;

extern char upcase (char);

extern void error (int, int);
extern void symboltable (char *, tokval *, int, int);
 
 
/***********************************************************************
*
* POP - POP parser stack
* This routine pops parse states and token values from the parse stack
* when a reduction is recognized. Put pop'd elements onto a free stack
* for speed.
*
***********************************************************************/

static void
Pop (int h)
{
   selement_t *stemp;
   int i;
 
#ifdef DEBUG_PARSE
   printf ("Pop: h = %d\n", h);
#endif

   for (i = 0; i < h; i++)
   {
      if (stack == NULL)
         break;
      else
      {
         stemp = stack->link;
         stack->link = frees;
         frees = stack;
         stack = stemp;
      }
   } /* of for */
 
} /* Pop */
 
/***********************************************************************
*
* PUSH - Push parser stack
* This routine pushes a parse state and token value onto the parse
* stack. Allocate new elements if free stack is empty.
*
***********************************************************************/

static void
Push (pstate s, tokval v, char *cv)
{
   selement_t *stemp;
 
#ifdef DEBUG_PARSE
   printf ("Push: state = %d, tokval = %f, toksym = '%s'\n",
	   s, v, cv ? cv : "null");
#endif

   if (frees == NULL)
   {
      stemp = (selement_t *)malloc (sizeof(selement_t));
      if (stemp == NULL)
      {
         Parse_Error (MEM_OVERFLOW, STACK_OVERFLOW);
         return;
      }
   }
   else
   {
      stemp = frees;
      frees = stemp->link;
   }
 
   stemp->state = s;
   stemp->svalue = v;
   if (cv != NULL)
      strcpy (stemp->cvalue, cv);
   stemp->link  = stack;
   stack = stemp;
 
} /* Push */
 
/***********************************************************************
*
* Stkval - Get stack value
* This routine returns the value of a stack element given its position.
*
***********************************************************************/

static tokval
Stkval (int depth)
{
   selement_t *stemp;
   int i;
 
#ifdef DEBUG_INTERP
   printf ("Stkval: depth = %d\n", depth);
#endif

   stemp = stack; /* Find stack element */
   for (i = 2; i <= depth; i++)
   {
      stemp = stemp->link;
      if (stemp == NULL)
         return (0.0);
   }
#ifdef DEBUG_INTERP
   printf ("   value = %f\n", stemp->svalue);
#endif
   return (stemp->svalue);
 
} /* Stkval */
 
/***********************************************************************
*
* CStkval - Get char stack value
* This routine returns a pointer to the character value of a stack
* element given its position.
*
***********************************************************************/

static char *
CStkval (int depth)
{
   selement_t *stemp;
   int i;
 
#ifdef DEBUG_INTERP
   printf ("CStkval: depth = %d\n", depth);
#endif

   stemp = stack; /* Find stack element */
   for (i = 2; i <= depth; i++)
   {
      stemp = stemp->link;
      if (stemp == NULL)
         return (NULL);
   }
#ifdef DEBUG_INTERP
   printf ("   value = '%s'\n", stemp->cvalue);
#endif
   return (stemp->cvalue);
 
} /* CStkval */
 
/***********************************************************************
*
* TOP - Get current parse state
* This routine return the parse state from the top element of the
* parse stack.
*
***********************************************************************/

static pstate
Top (void)
{
   return (stack->state);
}
 
/***********************************************************************
*
* Interpret - Interpret syntactical reduction
* This routine adds the semantic interpretation to the recognition of
* syntactical reductions.
*
***********************************************************************/

static tokval
Interpret (pstate r)
{
   tokval value;
   int k;
   char symbol[SYMLEN];
 
#ifdef DEBUG_INTERP
   printf ("Interpret: red = %d\n", r);
#endif
 
   value = 0.0;
   symbol[0] = '\0';
   switch (r)
   {
 
   /* Get the generated semantic actions */
#include "psemant.h"
 
   default:
      value = Stkval(1);
   }
 
   return (value);
 
} /* Interp */
 
/***********************************************************************
*
* Scanner - Lexical scanner
* This routine is a table driven scanner used to lexically analyze
* source input. Scanner is called whenever the parser needs the next
* token in the input stream. The scanner is implemented as a finite
* state machine.
*
***********************************************************************/

static toktyp
Scanner (char expr[], int *ndx, tokval *svalue, char *toksym)
{
   tokval sexp, sfrc, dignum, expsgn, value;
   int    i, sdx;
   word   sa, *pt;
   toktyp token;
   byte   chr, next, action;
   byte   select;
   byte   current_state; /* Scanner current state */
   char   lachar, latran; /* Look ahead character */
   char   symbol[SYMLEN]; /* Collected symbol */
 
#ifdef DEBUG_SCAN
   printf ("Scanner entered:\n");
#endif
 
   value = 0.0; /* Initialization */
   sexp = 0.0;
   sfrc = 0.1;
   expsgn = 1.0;
   sdx = 0;
   token = 0;
   symbol[sdx] = '\0';
 
   current_state = 1; /* Initialize current state */
 
   do
   {
 
      lachar = expr[*ndx]; /* Get current input char */
      latran = chartable[lachar]; /* Classify the character */
 
#ifdef DEBUG_SCAN
      printf (" cs = %d, lachar = %02x, latran = %d\n",
	      current_state, lachar, latran);
#endif
 
      dignum = 0.0;
      if (isdigit(lachar)) /* Convert digit to real number */
         dignum = (lachar - '0');
 
      /* Find state transition given current state and input character */
 
      pt = (word *)scantable[current_state-1];
 
      for (i = 0 ;; i++)
      {
 
         sa = *pt++;
         action = sa & 31;
         next = (sa >> 5) & 63;
         chr = (sa >> 11) & 31;
 
#ifdef DEBUG_SCAN
         printf (" Si = %d, a = %02x, n = %d, c = %d\n", i, action, next, chr);
#endif
 
         if ((chr == latran) || (chr == 31)) /* State transition fnd. */
	 {
 
            /* Perform the scan action for this transition */
 
            if (ERROR_ACTION & action) /* Error, terminate scan */
	    {
#ifdef DEBUG_SCAN
               printf ("   ERROR: \n");
#endif
               Parse_Error (SCAN_ERROR, current_state);
               return (0);
            }
 
            if (BACK_ACTION & action) /* Back up in input stream */
	    {
#ifdef DEBUG_SCAN
               printf ("   BACK:\n");
#endif
               *ndx = *ndx - 1;
            }
 
            if (EAT_ACTION & action) /* Eat (ignore) character */
	    {
#ifdef DEBUG_SCAN
               printf ("   EAT:\n");
#endif
               *ndx = *ndx + 1;
            }
 
            if (MOVE_ACTION & action) /* Move to symbol */
	    {
#ifdef DEBUG_SCAN
               printf ("   MOVE: \n");
#endif
               if (sdx < SYMLEN)
	       {
                  symbol[sdx] = upcase(lachar);
                  sdx ++;
                  symbol[sdx] = '\0';
               }
            }
 
            if (BUILD_ACTION & action) /* Token found process it */
	    {
               if (next == 0) select = current_state;
               else           select = next;
#ifdef DEBUG_SCAN
               printf ("   BUILD: select = %d\n", select);
#endif
               switch (select)
	       {
 
               /* Get the scanner actions */
#include "scanner.h"
 
               }
            }
 
            current_state = next;      /* Goto new scan state */
            break;
 
         }
      }
 
   } while (current_state != 0);
 
#ifdef DEBUG_SCAN
   printf (" token = %d, val = %10.4f\n", token, value);
#endif
 
   *svalue = value;
   strcpy (toksym, symbol);
 
   return (token);
 
} /* Scanner */
 
/***********************************************************************
*
* Parser - SLR(1) parser
* This routine interprets the parse tables to perform the SLR(1)
* parsing actions.
*
***********************************************************************/

tokval
Parser (char *expr)
{
   word   *pt, *gp;
   tokval value, rvalue;
   int    i, j, index;
   word   pa, tok, act;
   toktyp token;
   pstate current_state, c_s;
   pstate next, crnt;
   pstate sr;
   char   toksym[SYMLEN];
 
#ifdef DEBUG_PARSE
   printf ("Parse Entered:\n");
#endif
 
   index = 0;
   current_state = 1;
   stack = NULL;
   err_flag = FALSE;
   toksym[0] = '\0';
   value = 0.0;
   rvalue = 0.0;
 
   Push (current_state, 0.0, NULL);

   /* Get look ahead input token */
   token = Scanner (expr, &index, &value, toksym);
 
   do
   {
 
      /* Get action entry for current state, look ahead token */
 
      pt = (word *)parsetable[current_state-1];
 
      for (i = 0 ;; i++)
      {
 
         pa = *pt++;
         tok = pa & 127;
         act = (pa >> 7) & 1;
         sr = (pa >> 8) & 255;
 
#ifdef DEBUG_PARSE
         printf (" Pi = %d, t = %d, a = %d, sr = %d\n", i, tok, act, sr);
#endif
 
         if ((tok == 127) || (tok == token))
	 {
 
            /* State action found - do error, shift or reduce action */
 
            if ((sr == 255) || err_flag)
	    {
               if (! err_flag) /* Error processor - user defined */
                  Parse_Error (PARSE_ERROR, current_state);
               Pop (1000);
               return (value);
            }
 
            if (act == SHIFT_ACTION)
	    {
 
#ifdef DEBUG_PARSE
               printf (" Shift, value = %10.4f\n", value);
#endif
 
               Push (sr, value, toksym);
               token = Scanner (expr, &index, &value, toksym);
            }
 
            else /* REDUCE_ACTION */
	    {
               rvalue = Interpret (sr);
	       if (fpe_stop)
	       {
		  Pop (1000);
		  return (value);
	       }
 
#ifdef DEBUG_PARSE
               printf (" Reduce, sr = %d, rvalue = %10.4f\n", sr, rvalue);
               printf (" Handle = %d\n", gototable[sr-1].handle);
#endif
 
               Pop (gototable[sr-1].handle);
               c_s = Top();
 
#ifdef DEBUG_PARSE
               printf (" TOP-state = %d\n", c_s);
#endif
 
               /* Use goto tables to get next state */
 
               gp = (word *) gototable[sr-1].go;
 
               for (j = 0 ;; j++)
	       {
 
                  pa = *gp++;
                  crnt = pa & 255;
                  next = (pa >> 8) & 255;
 
#ifdef DEBUG_PARSE
                  printf (" j = %d, crnt = %d, next = %d\n", j, crnt, next);
#endif
 
                  if ((crnt == c_s) || (crnt == 255))
		  {
                     Push (next, rvalue, NULL);
                     break;
                  }
 
               } /* for j */
 
            }
            break;
         }
 
      } /* for i */
 
      current_state = Top();
 
#ifdef DEBUG_PARSE
      printf (" Cursta = %d\n", current_state);
#endif
 
   } while (current_state != 0); /* Until input is accepted */
 
   Pop (50); /* Purge stack of possible leftovers */
 
   return (rvalue);
 
} /* Parser */