/*
 * PDPATH.C - grammar driven parser for variable specifications
 *
 * Source Version: 2.0
 * Software Release #92-0043
 *
 */

#include "cpyright.h"

#include "pdb.h"

/* The fundamental operations are:
 *        GOTO    - goto the place in memory or on disk implied by the
 *                  locator on the top of the stack
 *        INDEX   - compute the hyper-space shape implied by the
 *                  dimensions on the top of the stack this implies
 *                  an offset from the current location and a
 *                  number of items (max) from the offset
 *                  the current location is changed by offset from
 *                  the previous location
 *        MEMBER  - item on the top of the stack is a member name
 *                  and implies an offset from the current location
 *                  the current location is changed by offset from
 *                  the previous location
 *        DEREF   - assuming the current location is a pointer in
 *                  memory or an itag on disk dereference so that
 *                  the current location is at the pointee
 *        DIGRESS - begin a subroutine which will result with a
 *                - new integer value on the stack upon completion
 *        CAST    - specify an output type that overrides the
 *                - file type
 */

#define MAXPARSEDEPTH 150
#define LASTTOK        42
#define STATEFLAG   -1000

#define GOTO_C    1
#define MEMBER_C  2
#define INDEX_C   3
#define CAST_C    4
#define DEREF_C   5
#define RESULT_C  6

#define ERRCODE      256
#define OPEN_PAREN   257
#define CLOSE_PAREN  258
#define STAR         259
#define DOT          260
#define ARROW        261
#define IDENTIFIER   262
#define COMMA        263
#define COLON        264
#define INTEGER      265

#define input()                                                              \
   FRAME(lex_bf)[FRAME(index)++]

#define unput(c)                                                             \
   (FRAME(index) = (--FRAME(index) < 0) ? 0 : FRAME(index),                  \
    FRAME(lex_bf)[FRAME(index)] = c)

#define GOT_TOKEN(tok)                                                       \
    {if (FRAME(index) == start+1)                                            \
        return(tok);                                                         \
     else                                                                    \
        {unput(c);                                                           \
	 return(_PD_next_token(start));};}

#define FRAME(x)   frames[frame_n].x
#define CURRENT(x) FRAME(stack)[FRAME(n)].x

typedef struct s_locator locator;
typedef struct s_parse_frame parse_frame;

struct s_locator
   {char intype[MAXLINE];
    int cmmnd;
    int indirect;
    SC_address ad;
    long number;
    dimdes *dims;
    symblock *blocks;
    int disposable;
    long n_struct_ptr;
    long n_array_items;
    symindir indir_info;};

struct s_parse_frame
   {locator *stack;
    long n;
    long nx;
    long diskaddr;
    char path[MAXLINE];
    int flag;
    char *lex_bf;
    char *lval;
    char *val;
    char *v[MAXPARSEDEPTH];           	/* parser value stack */
    char **pv;		                /* top of parser value stack */
    int current_token;			/* current input token number */
    int error;		                /* error recovery flag */
    int n_error;			/* number of errors */
    int state;		         	/* current state */
    int tmp;	            		/* extra var (lasts between blocks) */
    int s[MAXPARSEDEPTH];		/* parser state stack */
    int *ps;		                /* top of parser state stack */
    int index;};

static parse_frame
 *frames = NULL;

static int
 colon,
 frame_n,
 frame_nx;

static PDBfile
 *file_s;

static char
 outtype[MAXLINE],
 msg[MAXLINE],
 text[MAXLINE];

static long
 num_val;

static int
 SC_DECLARE(_PD_is_member, 
            (char *name, memdes *desc, HASHTAB *tab, long *pns)),
 SC_DECLARE(_PD_lex, ()),
 SC_DECLARE(_PD_next_token, (int start));

static long
 SC_DECLARE(_PD_reduce, (byte)),
 SC_DECLARE(_PD_do_digress, (char *expr)),
 SC_DECLARE(_PD_deref_addr, (int n)),
 SC_DECLARE(_PD_index_deref, 
            (int n, dimdes **pdims, long *pnumb)),
 SC_DECLARE(_PD_member_deref, (int n));

static char
 *SC_DECLARE(_PD_get_type_member, 
             (PDBfile *file, char *path_name, char *name,
              memdes *desc, defstr **pdp));

static void
 SC_DECLARE(_PD_rl_frames, (byte)),
 SC_DECLARE(_PD_save_stack, (byte)),
 SC_DECLARE(_PD_restore_stack, (byte)),
 SC_DECLARE(_PD_parse, (byte)),
 SC_DECLARE(_PD_disp_rules, (int rule, char **pvt)),
 SC_DECLARE(_PD_shift, 
            (char *name, char *type, dimdes *dims, symblock *blocks,
             long numb, long addr, int indr, int cmmnd)),
 SC_DECLARE(_PD_do_goto, (char *name)),
 SC_DECLARE(_PD_do_member, (char *name, int deref_flag)),
 SC_DECLARE(_PD_do_deref, (byte)),
 SC_DECLARE(_PD_do_index, (char *expr)),
 SC_DECLARE(_PD_do_cast, (char *type));

/*---------------------------------------------------------------------------*/

#ifdef DEBUG

/*--------------------------------------------------------------------------*/

/* DPSTACK - print the locator stack for debug purposes */

static void dpstack(n)
   int n;
   {int i;
    char cmmnds[MAXLINE];

    PRINT(stdout, "\n%16s %8s %4s %8s %3s %3s  %s  %s\n",
          "Type", "Dims", "N", "Address", "#A", "#S", "ILoc", "Command");
    for (i = 1; i <= n; i++)
        {switch (FRAME(stack)[i].cmmnd)
            {case GOTO_C :
                  strcpy(cmmnds, "GOTO");
                  break;
             case MEMBER_C :
                  strcpy(cmmnds, "MEMBER");
                  break;
             case INDEX_C :
                  strcpy(cmmnds, "INDEX");
                  break;
             case DEREF_C :
                  strcpy(cmmnds, "DEREF");
                  break;
             case CAST_C :
                  strcpy(cmmnds, "CAST");
                  break;
             case RESULT_C :
                  strcpy(cmmnds, "RESULT");
                  break;
             default :
                  strcpy(cmmnds, "UNKNOWN");
                  break;};

        PRINT(stdout, "%16s %8lx %4ld ",
              FRAME(stack)[i].intype,
              FRAME(stack)[i].dims,
              FRAME(stack)[i].number);

	if (file_s->virtual_internal)
	   PRINT(stdout, "%8lx ",
		 FRAME(stack)[i].ad.memaddr);
        else
	   PRINT(stdout, "%8ld ",
		 FRAME(stack)[i].ad.diskaddr);

        PRINT(stdout, "%3ld %3ld %5ld   %s\n",
              FRAME(stack)[i].n_array_items,
              FRAME(stack)[i].n_struct_ptr,
              FRAME(stack)[i].indir_info.addr,
              cmmnds);};

    PRINT(stdout, "\n");

    return;}

/*---------------------------------------------------------------------------*/

#endif

/*---------------------------------------------------------------------------*/

/* _PD_RL_FRAME_BLOCKS - release blocks on the locator stack between
 *                     - NMN and NMX except for NE
 */

static void _PD_rl_frame_blocks(nmn, nmx, ne)
   int nmn, nmx;
   long ne;
   {int i;
    symblock *tsp;
    
    for (i = nmn; i <= nmx; i++)
        {if (i == ne)
            continue;

	 tsp = FRAME(stack)[i].blocks;
	 if ((tsp != NULL) && FRAME(stack)[i].disposable)
	    SFREE(tsp);};

    return;}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_EFFECTIVE_EP - look up the symbol table entry for the named quantity
 *                  - return an effective symbol table entry which contains
 *                  - the type and dimensions of the entire variable(!) and
 *                  - the disk address and number of items referred to by the
 *                  - hyper-index expression, if any
 *                  - if name contains such a specification
 *                  - the returned syment will be newly allocated
 *                  - return NULL iff there is an error
 *
 */

syment *_PD_effective_ep(file, name, flag, fullname)
   PDBfile *file;
   char *name;
   int flag;
   char *fullname;
   {int alloc_frames;
    dimdes *dims;
    char *s, *type, *lname, bf[MAXLINE];
    long numb, addr;
    symindir indr;
    symblock *sp;
    syment *ep;

/*  to improve performance and to accomodate certain unusual variable names
 *  such as domain names, see if the variable name is literally in the file
 */
    ep = PD_inquire_entry(file, name, flag, fullname);
    if (ep != NULL)
       return(PD_copy_syment(ep));

    strcpy(bf, name);
    lname = SC_firsttok(bf, ".([");
    s = SC_strstr(lname, "->");
    if (s != NULL)
       lname[s - lname] = '\0';
	
    if (PD_inquire_entry(file, lname, flag, fullname) == NULL)
       return(NULL);

    alloc_frames = FALSE;
    if (frames == NULL)
       {alloc_frames = TRUE;

	frame_n  = 0;
        frame_nx = 4;
        frames   = FMAKE_N(parse_frame, frame_nx, "_PD_EFFECTIVE_EP:frames");
        FRAME(stack) = NULL;
        FRAME(nx) = 0;};

    FRAME(lex_bf) = SC_strsavef(name, "char*:_PD_EFFECTIVE_EP:lex_bf");
    FRAME(index) = 0;

    FRAME(n) = 0L;
    if (FRAME(stack) == NULL)
       {FRAME(nx) += 10;
	FRAME(stack) = FMAKE_N(locator, 10, "_PD_EFFECTIVE_EP:loc_stack");};

    switch (setjmp(_PD_trace_err))
       {case ABORT :
	     if ((fullname != NULL) && flag)
	        strcpy(fullname, name);
	     if (alloc_frames)
	        _PD_rl_frames();
             return(NULL);

        case ERR_FREE :
	     if (alloc_frames)
	        _PD_rl_frames();
             return(NULL);

        default :
	     memset(PD_err, 0, MAXLINE);
	     break;};

/* copy these arguments into global (file static) variables) */
    file_s      = file;
    FRAME(flag) = flag;

    _PD_parse();

    _PD_reduce();

    dims = CURRENT(dims);
    type = CURRENT(intype);
    numb = CURRENT(number);
    indr = CURRENT(indir_info);
    addr = CURRENT(ad).diskaddr;
    sp   = CURRENT(blocks);

/*    dpstack(FRAME(n)); */

    ep = _PD_mk_syment(type, numb, addr, &indr, dims);

    if ((file->virtual_internal == FALSE) && (sp != NULL))
       {SFREE(PD_entry_blocks(ep));
	PD_entry_blocks(ep) = sp;
        SC_mark(sp, 1);};

    if (fullname != NULL)
       strcpy(fullname, FRAME(path));

    if (alloc_frames)
       _PD_rl_frames();

    return(ep);}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_RL_FRAMES - free the set parse frames */

static void _PD_rl_frames()
   {

    SFREE(FRAME(stack));
    SFREE(FRAME(lex_bf));
    SFREE(frames);

    return;}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_SHIFT - perform a SHIFT operation */

static void _PD_shift(name, type, dims, blocks, numb, addr, indr, cmmnd)
   char *name, *type;
   dimdes *dims;
   symblock *blocks;
   long numb, addr;
   int indr, cmmnd;
   {

    if (type[0] == '\0')
       PD_error("NO TYPE SPECIFIED - _PD_SHIFT", PD_TRACE);

    if (frames == NULL)
       {frame_n  = 0;
        frame_nx = 2;
        frames   = FMAKE_N(parse_frame, frame_nx, "_PD_EFFECTIVE_EP:frames");};

    FRAME(n)++;
    if (FRAME(n) >= FRAME(nx))
       {FRAME(nx) += 10;
        REMAKE_N(FRAME(stack), locator, FRAME(nx));};

    memset(FRAME(stack)+FRAME(n), 0, sizeof(locator));

    strcpy(CURRENT(intype), type);

    CURRENT(number)      = numb;
    CURRENT(ad.diskaddr) = addr;
    CURRENT(indirect)    = indr;
    CURRENT(dims)        = dims;
    CURRENT(blocks)      = blocks;
    CURRENT(cmmnd)       = cmmnd;

    return;}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_REDUCE - reduce the parse tree
 *            - this means looping over the locator stack thru the
 *            - latest GOTO command and determining a new locator
 *            - whose intype, dimensions, number, and address can
 *            - be used to create an valid effective symbol table entry
 *            - or an actual one
 *            - if there is an intermediate expression on the stack
 *            - it will be read and the value (which can only be an
 *            - index) returned
 */

static long _PD_reduce()
   {int i, nmn, nmx, cmnd;
    long addr, val, numb;
    char *type;
    dimdes *dims;
    symblock *sp;
    symindir iloc;

    val = 0L;
    nmx = FRAME(n);

    type = CURRENT(intype);
    numb = CURRENT(number);
    dims = CURRENT(dims);

/* find the most recent GOTO commmand */
    for (i = nmx; i > 0; i--)
        {cmnd = FRAME(stack)[i].cmmnd;
         if (cmnd == GOTO_C)
            break;};

    nmn  = max(i, 1);
    addr = 0L;

    iloc.addr       = 0L;
    iloc.n_ind_type = 0L;
    iloc.arr_offs   = 0L;

/* find the actual address of the specified object */
    if (file_s->virtual_internal)
       addr = FRAME(stack)[nmx].ad.diskaddr;

    else
       {for (i = nmn; i <= nmx; i++)
	    {cmnd = FRAME(stack)[i].cmmnd;
	     FRAME(stack)[i].disposable = FALSE;
	     if (cmnd == DEREF_C)
	        addr = _PD_deref_addr(i);
	     else if (cmnd == INDEX_C)
	        {addr = _PD_index_deref(i, &dims, &numb);
		 iloc = FRAME(stack)[i].indir_info;}
	     else if (cmnd == MEMBER_C)
	        {addr = _PD_member_deref(i);
		 numb = FRAME(stack)[i].number;}
	     else if (cmnd != CAST_C)
	        {addr += FRAME(stack)[i].ad.diskaddr;
		 FRAME(stack)[i].ad.diskaddr = addr;};};};

/* this must be taken now because the address reduction may have
 * changed the original
 */
    sp = CURRENT(blocks);

    _PD_rl_frame_blocks(nmn, nmx, FRAME(n));

    FRAME(n) = nmn;

/* if we are not at the bottom of the locator stack we have
 * and intermediate expression which must by read in via _PD_rd_syment
 */
    if (nmn != 1)
       {syment *ep;

        if (numb != 1L)
           PD_error("INTERMEDIATE MUST BE SCALAR INTEGER - _PD_REDUCE",
                    PD_TRACE);

        ep = _PD_mk_syment(CURRENT(intype), 1L, addr, NULL, NULL);
        _PD_rd_syment(file_s, ep, "long", &val);
        _PD_rl_syment(ep);

        FRAME(n)--;}

/* otherwise we are at the end of the locator stack and the necessary
 * information to build an effective syment must be filled in the
 * bottom most locator
 */
    else
       {/* dpstack(nmx); */

        strcpy(CURRENT(intype), type);

        CURRENT(number)      = numb;
        CURRENT(ad.diskaddr) = addr;
        CURRENT(blocks)      = sp;
	CURRENT(dims)        = dims;
	CURRENT(indir_info)  = iloc;
        CURRENT(cmmnd)       = RESULT_C;};

    return(val);}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_DO_GOTO - carry out a GOTO command
 *             - this should be starting out with something which is
 *             - in the symbol table (it is an error if not)
 */

static void _PD_do_goto(name)
   char *name;
   {char *type;
    int indr;
    long numb, addr;
    dimdes *dims;
    symblock *sp;
    syment *ep;
    defstr *dp;

    ep = PD_inquire_entry(file_s, name, FRAME(flag), FRAME(path));
    if (ep == NULL)
       PD_error("NON-EXISTENT ENTRY - _PD_DO_GOTO", PD_TRACE);

/* shift the starting point information onto the locator stack */
    numb = PD_entry_number(ep);
    addr = PD_entry_address(ep);
    type = PD_entry_type(ep);
    dims = PD_entry_dimensions(ep);
    sp   = PD_entry_blocks(ep);

    dp = _PD_lookup_type(type, file_s->chart);
    if (dp == NULL)
       PD_error("UNDEFINED TYPE - _PD_DO_GOTO", PD_TRACE);
    if (dp->size_bits && (addr > 0))
       addr *= -SC_BITS_BYTE;

/* indirect does NOT mean that the type is indirect but that the
 * entry in the symbol table refers to a dynamically allocated
 * quantity, hence indirect means no dimensions
 * 
 */
    indr = (dims == NULL);

    _PD_shift(name, type, dims, sp, numb, addr, indr, GOTO_C);

    return;}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_DO_MEMBER - carry out a MEMBER command */

static void _PD_do_member(name, deref_flag)
   char *name;
   int deref_flag;
   {char *type, t[MAXLINE];
    int indr;
    long addr, numb, nsitems;
    dimdes *dims;
    defstr *dp;
    memdes *desc, *nxt;
    HASHTAB *tab;

    if (file_s->virtual_internal)
       tab = file_s->host_chart;
    else
       tab = file_s->chart;

/* if we came here with the "->" syntax we will need to shift
 * a derefence onto the locator stack ahead of the member shift
 * also update the path while we're at it
 */
    if (deref_flag)
       {_PD_do_deref();
        sprintf(t, "%s->%s", FRAME(path), name);}
    else
       sprintf(t, "%s.%s", FRAME(path), name);

    strcpy(FRAME(path), t);

/* NOTE: we had better be properly dereferenced at this point!!!!!!!
 * DO NOT IMAGINE THAT ANYTHING DIFFERENT CAN BE DONE!!!!!!
 */
    type = CURRENT(intype);
    if (_PD_indirection(type))
       PD_error("IMPROPERLY DEREFERENCED EXPRESSION - _PD_DO_MEMBER",
                PD_TRACE);

/* find the defstr whose members are to be searched */
    dp = PD_inquire_table_type(tab, type);
    if (dp == NULL)
       PD_error("UNKNOWN TYPE - _PD_DO_MEMBER", PD_TRACE);

/* loop over the members accumulating offset to the new address
 * and the number of indirect members which will have to
 * be skipped over
 */
    addr    = 0L;
    nsitems = 0L;
    for (desc = dp->members; desc != NULL; desc = nxt)
        {nxt = desc->next;
         if (_PD_is_member(name, desc, tab, &nsitems))
            {type = _PD_get_type_member(file_s, FRAME(path), name,
                                        desc, &dp);

	     addr = desc->member_offs;
             dims = desc->dimensions;
             numb = _PD_comp_num(dims);
             indr = _PD_indirection(type);

	     if (file_s->virtual_internal)
	        {SC_address ad;

		 ad   = FRAME(stack)[FRAME(n)].ad;
		 addr = ad.diskaddr + desc->member_offs;};

/* shift the member onto the locator stack */
             _PD_shift(name, type, dims, NULL,
		       numb, addr, indr, MEMBER_C);
             CURRENT(n_struct_ptr) = nsitems;

             return;};};

    PD_error("UNKNOWN MEMBER - _PD_DO_MEMBER", PD_TRACE);

    return;}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_DO_DEREF - carry out a DEREF command */

static void _PD_do_deref()
   {long addr;
    char t[MAXLINE];

    strcpy(t, CURRENT(intype));

    if (file_s->virtual_internal)
       {SC_address ad;

        ad         = FRAME(stack)[FRAME(n)].ad;
	ad.memaddr = *(char **) ad.memaddr;
	addr       = ad.diskaddr;}

    else
       addr = 0L;

    _PD_shift("", t, NULL, NULL, -1L, addr, 0, DEREF_C);

/* since the shift added a new one this will dereference the current locator */
    PD_dereference(CURRENT(intype));

    return;}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_DO_INDEX - carry out a INDEX command
 *              - this must always set the current location
 *              - to point to the first element indexed
 *              - if more than one element is referenced then that
 *              - information must be put into the locator for future
 *              - action
 */

static void _PD_do_index(expr)
   char *expr;
   {int indr;
    long bpi, start, stop, step, numb, doff, addr;
    char t[MAXLINE], s[MAXLINE];
    char *type, *tok, *pt;
    dimdes *dims;
    symblock *sp;

/* update the path */
    sprintf(t, "%s[%s]", FRAME(path), expr);
    strcpy(FRAME(path), t);

    dims = CURRENT(dims);
    type = CURRENT(intype);
    doff = PD_get_offset(file_s);

    if (dims != NULL)
       {strcpy(t, type);
        PD_dereference(t);
        numb = _PD_hyper_number(file_s, expr, 1L, dims, &start);
        indr = FALSE;}

    else if (_PD_indirection(type))
       {_PD_do_deref();

/* find the offset which will be the first part of the index expression
 * find the number of items requested */
	strcpy(t, expr);
	tok = SC_firsttok(t, ",");

#if 0

/* GOTCHA: this should be made to work (it crashed the test suite)
 *         and will have to work if PDBLib is to handle the
 *         extended index expression syntax when the parse routine
 *         is regenerated
 */
        numb = _PD_parse_index_expr(tok, dims, &start, &stop, &step);
	if (numb < 1)
	   PD_error("BAD INDEX EXPRESSION - _PD_DO_INDEX", PD_TRACE);
	start -= doff;

#else

	strcpy(s, tok);
	tok = SC_strtok(s, ":", pt);
	if (tok == NULL)
	   PD_error("BAD INDEX EXPRESSION - _PD_DO_INDEX", PD_TRACE);

	start = SC_stoi(tok) - doff;

        tok = SC_strtok(NULL, ":", pt);
        if (tok == NULL)
           stop = start;
        else
           stop = SC_stoi(tok) - doff;

        step = SC_stoi(SC_strtok(NULL, ":", pt));
        if (step == 0L)
           step = 1L;

        numb = (stop - start)/step + 1;

#endif

        strcpy(t, CURRENT(intype));
        indr = TRUE;}

    else
       PD_error("CAN'T INDEX OBJECT - _PD_DO_INDEX", PD_TRACE);

    bpi = _PD_lookup_size(t, file_s->chart);

    if (file_s->virtual_internal)
       {SC_address ad;

        ad   = FRAME(stack)[FRAME(n)].ad;
	addr = ad.diskaddr;}

    else
       addr = 0L;

    addr += start*bpi;

    sp = CURRENT(blocks);

    _PD_shift(expr, t, dims, sp, numb, addr, indr, INDEX_C);

    CURRENT(n_array_items) = start;

    return;}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_DO_CAST - carry out a CAST command */

static void _PD_do_cast(type)
   char *type;
   {int in;
    long n, da;
    char t[MAXLINE], s[MAXLINE];
    symblock *sp;
    dimdes *dm;

/* update the path */
    sprintf(t, "(%s) %s", type, FRAME(path));
    strcpy(FRAME(path), t);

    da = CURRENT(ad.diskaddr);
    in = CURRENT(indirect);
    n  = CURRENT(number);
    sp = CURRENT(blocks);
    dm = CURRENT(dims);

    strcpy(s, CURRENT(intype));

    _PD_shift("", s, dm, sp, n, da, in, CAST_C);

    strcpy(outtype, type);

    return;}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_DO_DIGRESS - carry out a DIGRESS command */

static long _PD_do_digress(expr)
   char *expr;
   {long val;
    char t[MAXLINE];

/* save the path
 * NOTE: this doesn't support more than one level of recursion!!
 */
    strcpy(t, FRAME(path));

    val = _PD_reduce();    

/* restore the path */
    strcpy(FRAME(path), t);

    return(val);}

/*---------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_IS_MEMBER - determine whether or not the given member is the
 *               - named member and return TRUE iff it is
 *               - also return the updated number of
 *               - struct indirections to track via the arg list
 */

static int _PD_is_member(name, desc, tab, pns)
   char *name;
   memdes *desc;
   HASHTAB *tab;
   long *pns;
   {

/* if this is the member say so */
    if (strcmp(desc->name, name) == 0)
       return(TRUE);

/* count up the number of indirects in the structure which will be skipped */
    else
       {if (_PD_indirection(desc->type))
           *pns += _PD_member_items(desc->member);

        return(FALSE);};}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_GET_TYPE_MEMBER - get the true type of the member
 *                     - handle any casts
 */

static char *_PD_get_type_member(file, path_name, name, desc, pdp)
   PDBfile *file;
   char *path_name, *name;
   memdes *desc;
   defstr **pdp;
   {char *mtype;
    HASHTAB *tab;

    if (file->virtual_internal)
       tab = file->host_chart;
    else
       tab = file->chart;

    *pdp = PD_inquire_table_type(tab, desc->base_type);
    if (*pdp == NULL)
       PD_error("UNDEFINED TYPE - _PD_GET_TYPE_MEMBER", PD_TRACE);

    if (desc->cast_offs < 0L)
       mtype = desc->type;
    else
       {if (file->virtual_internal)
           {SC_address ad;

            ad    = FRAME(stack)[FRAME(n)].ad;
	    mtype = DEREF(ad.memaddr + desc->cast_offs);
	    if (mtype == NULL)
               {if (DEREF(ad.memaddr + desc->member_offs) == NULL)
		   mtype = desc->type;
		else
		   PD_error("NULL CAST TO NON-NULL MEMBER - _PD_GET_TYPE_MEMBER",
			    PD_TRACE);};}

        else
           {char s[MAXLINE], c;
            int i;

/* build the path of the member which points to the real type */
	    strcpy(s, path_name);
            for (i = strlen(s) - 1; i >= 0; i--)
	        {c = s[i];
		 if ((c == '>') || (c == '.'))
		    break;}
	    s[i+1] = '\0';
	    strcat(s, desc->cast_memb);

            _PD_save_stack();

/* read the real type in */
            PD_read(file, s, &mtype);
	    if (mtype == NULL)
	       mtype = desc->type;

            _PD_restore_stack();};};

    return(mtype);}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_SAVE_STACK - save the state of the current parse */

static void _PD_save_stack()
   {

    frame_n++;
    if (frame_n >= frame_nx)
       {frame_nx += 2;
        REMAKE_N(frames, parse_frame, frame_nx);};

    memset(&frames[frame_n], 0, sizeof(parse_frame));

    return;}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_RESTORE_STACK - restore the state of the previous parse */

static void _PD_restore_stack()
   {

    SFREE(FRAME(stack));
    SFREE(FRAME(lex_bf));
    frame_n--;

    return;}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_DEREF_ADDR - dereference a pointer and return the correct address
 *                - of the pointee
 *                - the entire parse tree is available to provide all
 *                - necessary context
 */

static long _PD_deref_addr(n)
   int n;
   {long addr, numb, bpi;
    char *type;
    HASHTAB *tab;
    FILE *fp;
    dimdes *dims;
    symblock *sp;

    tab  = file_s->chart;
    type = FRAME(stack)[n-1].intype;
    bpi  = _PD_lookup_size(type, tab);

/* handle the case of in memory pointers */
    if (file_s->virtual_internal)
       {addr = FRAME(stack)[n].ad.diskaddr;
        numb = FRAME(stack)[n].number;}

/* handle the case of file pointers */
    else
       {PD_itag itag;

        addr = FRAME(stack)[n-1].ad.diskaddr;
	numb = FRAME(stack)[n-1].number;

/* get past the level that contains the dereference
 * NOTE: PDB declines to write top level pointers which are
 *       useless numbers, it starts in with the pointees and
 *       hence the start of such objects are the itags of the
 *       pointees
 */
	if (!_PD_indirection(type))
	   addr += numb*bpi;

	fp = file_s->stream;
	if (io_seek(fp, addr, SEEK_SET))
	   PD_error("FSEEK FAILED TO FIND DATA - _PD_DEREF_ADDR",
		    PD_TRACE);

	_PD_rd_itag(file_s, &itag);

	addr = io_tell(fp);
        numb = itag.nitems;

	if (!_PD_indirection(FRAME(stack)[n].intype))
	   {sp = FMAKE(symblock, "_PD_DEREF_ADDR:sp");
	    sp->number   = numb;
	    sp->diskaddr = addr;

	    if ((n + 1) == FRAME(n))
	       dims = _PD_mk_dimensions(file_s->default_offset, numb);
	    else
	       dims = NULL;

	    FRAME(stack)[n].blocks = sp;
	    FRAME(stack)[n].dims   = dims;

	    if (n < FRAME(n))
	       {if (FRAME(stack)[n+1].cmmnd == INDEX_C)
		   {FRAME(stack)[n+1].blocks = sp;
		    FRAME(stack)[n+1].dims   = dims;};};};};

    FRAME(stack)[n].number      = numb;
    FRAME(stack)[n].ad.diskaddr = addr;

    return(addr);}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_INDEX_DEREF - handle indexing where a pointered type was just
 *                 - dereferenced this will mean skipping over itags
 *                 - and other pointees
 */

static long _PD_index_deref(n, pdims, pnumb)
   int n;
   dimdes **pdims;
   long *pnumb;
   {long indx, addr, numb, naitems, bpi;
    char *type, *typc, *typp;
    symblock *nsp;
    symindir iloc;
    FILE *fp;
    HASHTAB *tab;

    nsp = NULL;

    iloc.addr       = 0L;
    iloc.n_ind_type = 0L;
    iloc.arr_offs   = 0L;

/* handle in memory indexing */
    if (file_s->virtual_internal)
       addr = FRAME(stack)[n].ad.diskaddr;

/* handle file indexing */
    else

/* start at the address before the latest DEREF */
       {typp = FRAME(stack)[n-1].intype;
	type = FRAME(stack)[n].intype;
	typc = FRAME(stack)[n+1].intype;
	indx = FRAME(stack)[n].n_array_items;

        fp  = file_s->stream;
        tab = file_s->chart;

	iloc.n_ind_type = _PD_num_indirects(type, tab);
	iloc.arr_offs   = indx;

/* in order to know where to go you have to know whether the
 * next thing on the locator stack dereferences a pointer
 */
	if (((n < FRAME(n)) && _PD_indirection(typc)) ||
	    _PD_indirection(typp))
	   {numb = FRAME(stack)[n-1].number;
	    if ((indx < 0) || (numb < indx))
	       PD_error("INDEX OUT OF BOUNDS - _PD_INDEX_DEREF", PD_TRACE);

/* handle GOTO, DEREF, INDEX */
	    if (FRAME(stack)[n-1].cmmnd == DEREF_C)
	       {addr = FRAME(stack)[n-2].ad.diskaddr;
		if (io_seek(fp, addr, SEEK_SET))
		   PD_error("FSEEK FAILED TO FIND DATA - _PD_INDEX_DEREF",
			    PD_TRACE);

/* skip over the thing that was DEREF'd to where its pointees begin */
		addr = _PD_skip_over(file_s, 1L, TRUE);

/* skip over all items before the indexed one */
		numb    = _PD_num_indirects(type, tab);
		naitems = indx*max(1, numb);
		addr    = _PD_skip_over(file_s, naitems, FALSE);}

/* handle GOTO, INDEX */
	    else
	      {addr = FRAME(stack)[n-1].ad.diskaddr;

	       if (!_PD_indirection(typp))
		  {bpi   = _PD_lookup_size(typp, tab);
		   addr += numb*bpi;
		   if (io_seek(fp, addr, SEEK_SET))
		     PD_error("FSEEK FAILED TO FIND DATA - _PD_INDEX_DEREF",
			      PD_TRACE);

/* skip over all items before the indexed one */
		   numb    = _PD_num_indirects(typp, tab);
		   naitems = indx*max(1, numb);
		   addr    = _PD_skip_over(file_s, naitems, FALSE);}

/* NOTE: if we get here, then we have an array of pointers (the
 *       data for which is not written by PDB - the pointers are
 *       meaningless numbers) consequently we are staring at the
 *       ITAG of the first pointee
 */
	       else
		  {PD_itag itag;

/* be sure that we are at the first ITAG */
		   if (io_seek(fp, addr, SEEK_SET))
		     PD_error("FSEEK FAILED - _PD_INDEX_DEREF",
			      PD_TRACE);

		   *pdims = NULL;

/* skip over to the indexed element */
		   numb    = _PD_num_indirects(typp, tab);
		   naitems = indx*max(1, numb);
		   addr    = _PD_skip_over(file_s, naitems, FALSE);

		   _PD_rd_itag(file_s, &itag);
		   if (!itag.flag)
		      {if (io_seek(fp, addr, SEEK_SET))
			  PD_error("FSEEK FAILED - _PD_INDEX_DEREF",
				   PD_TRACE);
		       _PD_rd_itag(file_s, &itag);};

		   numb   = itag.nitems;
		   *pnumb = numb;
		   FRAME(stack)[n].number   = numb;

/* after doing one index the next thing has to be contiguous */
		   FRAME(stack)[n+1].blocks = NULL;

                   addr   = io_tell(fp);};};}

/* handle direct types simply */
	else

/* GOTCHA: it is a temporary measure to pass the old dimensions up the stack
 *         the correct thing to do is to distinguish between the dimensions
 *         of the source and the effective dimension of the target.  This
 *         will never be right until then
 */
	   {symblock *sp;
            long nbl, nib, nbb;

	    if (*pdims == NULL)
	       *pdims = FRAME(stack)[n].dims;

	    FRAME(stack)[n].dims = FRAME(stack)[n-1].dims;
	    addr  = FRAME(stack)[n-1].ad.diskaddr;

            sp    = FRAME(stack)[n].blocks;
            numb  = FRAME(stack)[n].ad.diskaddr;
	    bpi   = _PD_lookup_size(type, tab);

	    nbl       = FRAME(stack)[n-1].number;
	    iloc.addr = addr + nbl*bpi;

/* deal with multiblock entries */
	    nsp = NULL;

/* NOTE: it is not the most general thing to assume that bitstreams
 *       (indicated by negative addresses) must be contiguous although
 *       all current examples are
 */
            if ((sp != NULL) && (addr >= 0))
	       {nbl = SC_arrlen(sp)/sizeof(symblock);

/* find out which block we got into */
		while (TRUE)
		   {nib = sp->number;
		    nbb  = nib*bpi;
		    addr = sp->diskaddr;
		    if (numb < nbb)
		       break;

		    iloc.arr_offs -= nib;
		    numb -= nbb;
		    sp++;
		    nbl--;};

		iloc.addr = addr + nbb;

/* make a copy of the remaining blocks for the effective entry */
		if (nbl > 0)
		   {int i;

		    FRAME(stack)[n].disposable = TRUE;
		    nsp = FMAKE_N(symblock, nbl, "_PD_INDEX_DEREF:nsp");
		    for (i = 0; i < nbl; i++)
		        nsp[i] = *sp++;};

/* adjust the first block to be consistent with the rest of the locator */
		nsp[0].number   -= numb/bpi;
		nsp[0].diskaddr  = addr + numb;};

	    if (addr < 0)
	       {defstr *dp;

		dp = PD_inquire_table_type(tab, type);
		addr -= (numb/bpi)*dp->size_bits;}

	    else
	       {*pnumb = FRAME(stack)[n].number;
		addr += numb;};};};

    if (FRAME(stack)[n-1].cmmnd == DEREF_C)
       SFREE(FRAME(stack)[n].blocks);
    FRAME(stack)[n].blocks      = nsp;
    FRAME(stack)[n].ad.diskaddr = addr;
    FRAME(stack)[n].indir_info  = iloc;

    return(addr);}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_MEMBER_DEREF - find the member where a pointered type was just
 *                  - dereferenced this will mean skipping over itags
 *                  - and other pointees
 */

static long _PD_member_deref(n)
   int n;
   {long addr, nsitems;
    char *type;

/* handle in memory members */
    if (file_s->virtual_internal)
       addr = FRAME(stack)[n].ad.diskaddr;

/* handle file members */
    else
       {int indir, cmmnd;
        long bpi, numb;

	cmmnd = FRAME(stack)[n-1].cmmnd;
	indir = _PD_indirection(FRAME(stack)[n].intype);
	if ((cmmnd == GOTO_C) && indir)
	   {addr = FRAME(stack)[n-1].ad.diskaddr;
	    type = FRAME(stack)[n-1].intype;
	    numb = FRAME(stack)[n-1].number;
            bpi  = _PD_lookup_size(type, file_s->chart);

	    addr += bpi*numb;

	    if (io_seek(file_s->stream, addr, SEEK_SET))
	       PD_error("FSEEK FAILED TO FIND DATA - _PD_MEMBER_DEREF",
			PD_TRACE);}

        else if ((cmmnd != INDEX_C) && indir)
	   {addr = FRAME(stack)[n-2].ad.diskaddr;

	    if (io_seek(file_s->stream, addr, SEEK_SET))
	       PD_error("FSEEK FAILED TO FIND DATA - _PD_MEMBER_DEREF",
			PD_TRACE);

/* skip over the thing that was DEREF'd to where its pointees begin */
	    addr = _PD_skip_over(file_s, 1L, TRUE);}

/* start at the address in the previous locator */
        else
	   addr = FRAME(stack)[n-1].ad.diskaddr;

/* handle indirect types differently from direct ones */
        type = FRAME(stack)[n].intype;
	if (_PD_indirection(type))
	   {nsitems = FRAME(stack)[n].n_struct_ptr;

	    if (io_seek(file_s->stream, addr, SEEK_SET))
	       PD_error("FSEEK FAILED TO FIND DATA - _PD_MEMBER_DEREF",
			PD_TRACE);

/* skip over all items before the specified member */
	    addr = _PD_skip_over(file_s, nsitems, FALSE);}

/* handle direct types simply */
	else
	   addr += FRAME(stack)[n].ad.diskaddr;};

    FRAME(stack)[n].ad.diskaddr = addr;

    return(addr);}

/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/

/* _PD_SKIP_OVER - given a number of units, skip over that many units
 *               - including subunits referenced by the top level units
 *               - if noind is TRUE don't pick up the additional indirects
 */

long _PD_skip_over(file, skip, noind)
   PDBfile *file;
   long skip;
   int noind;
   {long bytepitem, addr;
    int indir;
    FILE *fp;
    HASHTAB *tab;
    PD_itag itag;

    fp  = file->stream;
    tab = file->chart;

    while (skip-- > 0L)
       {_PD_rd_itag(file, &itag);

/* note whether this is an indirection */
        indir = _PD_indirection(itag.type);

/* if noind is TRUE don't pick up the indirects */
        if (noind == FALSE)

/* if it is an indirection we have more to skip over */
           {if (indir)
               skip += itag.nitems;
            else
/* NOTE:  This else clause was added to handle the case of correctly */
/*        picking up the indirections with a struct ** where the     */
/*        struct also contains indirections.                         */
/* if it is a structure with indirections we have more to skip over */
               skip += itag.nitems*_PD_num_indirects(itag.type, tab);};

/* if it was not a NULL pointer find it */
        if ((itag.addr != -1L) && (itag.nitems != 0L))
           {if (!itag.flag && (skip == -1))
               {if (io_seek(fp, itag.addr, SEEK_SET))
                   PD_error("CAN'T FIND REAL DATA - _PD_SKIP_OVER",
                               PD_TRACE);
                _PD_rd_itag(file, &itag);};

/* layered indirects have no "data" bytes written out to be skipped over */
            if (!indir)
               {bytepitem = _PD_lookup_size(itag.type, tab);
                if (bytepitem == -1)
                   PD_error("CAN'T FIND NUMBER OF BYTES - _PD_SKIP_OVER",
                            PD_TRACE);}
            else
               bytepitem = 0;

/* if its here, step over the data */
            if (itag.flag && (skip > -1))
               {addr = bytepitem*itag.nitems;
                if (!indir)
                   if (io_seek(fp, addr, SEEK_CUR))
                      PD_error("CAN'T SKIP TO ADDRESS - _PD_SKIP_OVER",
                               PD_TRACE);};};};

    addr = io_tell(fp);

    return(addr);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_NUM_INDIRECTS - count up the number of members of the given
 *                   - structure with indirect references
 *                   - includes the indirections of children too
 */

long _PD_num_indirects(type, tab)
   char *type;
   HASHTAB *tab;
   {char *mtype;
    defstr *dp;

    mtype = _PD_member_base_type(type);
    dp    = PD_inquire_table_type(tab, mtype);
    SFREE(mtype);

    if (dp == NULL)
       PD_error("CAN'T FIND TYPE - _PD_NUM_INDIRECTS", PD_TRACE);

    return(dp->n_indirects);}

/*--------------------------------------------------------------------------*/

/*                          LEXICAL SCANNER ROUTINES                        */

/*--------------------------------------------------------------------------*/

/* _PD_LEX - lexical scanner called by the generated parser
 *         - return the value of the lexical token if successful
 *         - return 0 if at the end of the input string
 *         - text of identifiers is put in the global variable TEXT
 *         - the numerical value of an INTEGER token is put in the global
 *         - variable NUM_VAL
 *         - legal token values are:
 *         -     
 *         -     OPEN_PAREN       ( or [
 *         -     CLOSE_PAREN      ) or ]
 *         -     DOT              .
 *         -     COMMA            ,
 *         -     COLON            :
 *         -     STAR             *
 *         -     ARROW            ->
 *         -     INTEGER          octal, decimal, or hexidecimal integer
 *         -     IDENTIFIER       just about anything else (no white space)
 */

static int _PD_lex()
   {int c, d, start;

    start = FRAME(index);
    while (TRUE)
       {c = input();
	switch (c)
	   {case '\0' :
	         if (FRAME(index) == start+1)
		    {unput(c);
		     return(0);}
		 else
		    {unput(c);
		     return(_PD_next_token(start));};

	    case '(' :
	    case '[' :
	         GOT_TOKEN(OPEN_PAREN);

	    case ')' :
	    case ']' :
	         GOT_TOKEN(CLOSE_PAREN);

	    case '.' :
	         GOT_TOKEN(DOT);

	    case ',' :
	         GOT_TOKEN(COMMA);

	    case ':' :
	         GOT_TOKEN(COLON);

	    case '*' :
	        GOT_TOKEN(STAR);

	    case '-' :
	         d = input();
                 if (d == '>')
		    {if (FRAME(index) == start+2)
                        return(ARROW);
		     else
		        {unput(d);
			 unput(c);
			 return(_PD_next_token(start));};};

	    default :
	         break;};};}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_NEXT_TOKEN - figure out whether the specified token is an
 *                - IDENTIFIER or an INTEGER
 *                - and take the apropriate action
 */

static int _PD_next_token(start)
   int start;
   {int nc;
    char *end, s[MAXLINE], *tok, *t;

    nc = FRAME(index) - start;
    strncpy(s, FRAME(lex_bf)+start, nc);
    s[nc] = '\0';

/* eliminate whitespace from either end of the token
 * NOTE: things like "a b" are illegal anyway
 */
    tok = SC_strtok(s, " \t\f\n\r", t);
    strcpy(text, tok);

    num_val = _SC_strtol(text, &end, 0);
    tok     = text + strlen(text);
    if (tok == end)
       return(INTEGER);
    else
       return(IDENTIFIER);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_PARSE_INDEX_EXPR - decipher things of the form
 *                      -   [n][:[n][:[n]]]
 *                      - and return a start, stop, step triple
 */

long _PD_parse_index_expr(expr, dim, pstart, pstop, pstep)
   char *expr;
   dimdes *dim;
   long *pstart, *pstop, *pstep;
   {int i, j, tv, colons;
    long tr[3];

    if (strlen(expr) == 0)
       return(0L);

    frame_n  = 0;
    frame_nx = 2;
    frames   = FMAKE_N(parse_frame, frame_nx, "_PD_PARSE_INDEX_EXPR:frames");

    FRAME(lex_bf) = SC_strsavef(expr, "char*:_PD_PARSE_INDEX_EXPR:lex_bf");
    FRAME(index)  = 0;
   
    colons = 0;
    tr[2] = 1;

    for (j = 0, i = 0; i < 5; i++)
        {tv = _PD_lex();
	 if (tv == COLON)
            {colons += 1;
	     if (j == 0)
	        {if (dim != NULL)
		    tr[j++] = dim->index_min;
		 else
		    return(0L);}
	     else if (j == 1)
	        {if (colons == 2)
		    {if (dim != NULL)
		        tr[j++] = dim->index_max;
		     else
		        return(0L);};};}
	 else if (tv == INTEGER) 
	    tr[j++] = num_val;
         else
	    break;};

    if (j == 1)
       {if (colons == 0)
	   tr[1] = tr[0];
        else if (colons == 1)
	   {if (dim != NULL)
	       tr[1] = dim->index_max;
	    else
	       return(0L);}
	else
	   return(0L);};

    *pstart = tr[0];
    *pstop  = tr[1];
    *pstep  = tr[2];

    _PD_rl_frames();

    return((tr[1] - tr[0])/tr[2] + 1);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_PARSE - parse an expression which is in the lexical buffer of
 *           - the current parse frame
 *           - return TRUE if there are no syntax errors
 *           - return FALSE otherwise
 */

static void _PD_parse()
   {char **pvt;
    register char **lpv;   	/* top of value stack */
    register int *lps;	        /* top of state stack */
    register int lstate;	/* current state */
    register int  n;	        /* internal state number info */
    register int len;

    static int
      exca[] = {-1, 1, 0, -1, -2, 0,},
      act[]  = { 3, 29,  5, 26, 24,  7,  7,  9, 19, 25,
                 3, 18,  5, 10, 17,  7, 11, 12, 14, 15,
                20,  1, 16,  4,  6,  8, 13,  2,  0,  0,
                 0,  0,  0,  0,  0, 23, 21, 22, 28,  0,
                27, 30},
      pact[] = { -247, -1000, -1000,  -255,  -244,  -247,
                -1000, -1000,  -240, -1000,
                 -257,  -256,  -256, -1000,  -247, -1000,
                 -254, -1000,  -261, -1000,
                -1000, -1000, -1000, -1000, -1000,  -257,
                 -257, -1000,  -263,  -257, -1000},
      pgo[] = {0, 20, 27, 25, 23, 24, 22, 14, 11},
      r1[]  = {0, 1, 1, 1, 3, 3, 2, 2, 4, 4,
               4, 4, 6, 6, 7, 7, 7, 8, 8, 5},
      r2[]  = {0, 2, 9, 1, 3, 5,  2, 5, 3, 9,
               7, 7, 2, 7, 2, 7, 11, 3, 3, 3},
      chk[] = {-1000,  -1,  -2, 257,  -4, 259,  -5, 262,  -3, 262,
                 257, 260, 261,  -1, 258, 259,  -6,  -7,  -8, 265,
                  -1,  -5,  -5,  -1, 258, 263, 264,  -7,  -8, 264, -8},
      def[] = { 3, -2,  1, 0, 6, 3, 8, 19,  0,  4,
                3,  0,  0, 7, 3, 5, 0, 12, 14, 17,
               18, 10, 11, 2, 9, 3, 3, 13, 15,  3, 16};

/* initialize externals - _PD_parse may be called more than once */
    FRAME(pv) = &FRAME(v)[-1];
    FRAME(ps) = &FRAME(s)[-1];

    FRAME(state)         = 0;
    FRAME(tmp)           = 0;
    FRAME(n_error)       = 0;
    FRAME(error)         = 0;
    FRAME(current_token) = -1;

    lpv    = FRAME(pv);
    lps    = FRAME(ps);
    lstate = FRAME(state);

    colon = FALSE;

/* loop as expressions are pushed onto the stack */
    for (;;)

/* put a state and value onto the stacks */
        {if (++lps >= &FRAME(s)[MAXPARSEDEPTH])
	    PD_error("STACK OVERFLOW - _PD_PARSE", PD_TRACE);

	 *lps   = lstate;
	 *++lpv = FRAME(val);

/* we have a new state - find out what to do */
	 n = pact[lstate];
	 if (n > STATEFLAG)
	    {if ((FRAME(current_token) < 0) &&
		 ((FRAME(current_token) = _PD_lex()) < 0))
	        FRAME(current_token) = 0;

/* valid shift */
	     n += FRAME(current_token);
	     if ((n >= 0) && (n < LASTTOK))
	        {n = act[n];
		 if (chk[n] == FRAME(current_token))
		    {FRAME(current_token) = -1;
		     FRAME(val) = FRAME(lval);

		     lstate = n;
		     if (FRAME(error) > 0)
		        FRAME(error)--;
		     continue;};};};

	 n = def[lstate];
	 if (n == -2)
	    {int *xi;

	     if ((FRAME(current_token) < 0) &&
		 ((FRAME(current_token) = _PD_lex()) < 0))
	        FRAME(current_token) = 0;

/* look through exception table */
	     xi = exca;

	     while ((*xi != -1) || (xi[1] != lstate))
	        {xi += 2;};

	     while ((*(xi += 2) >= 0) && (*xi != FRAME(current_token)));

	     n = xi[1];
	     if (n < 0)
	        return;};

/* check for syntax error */
	 if (n == 0)
	    {if (FRAME(error) > 0)
	       PD_error("SYNTAX ERROR - _PD_PARSE", PD_TRACE);};

/* reduction by production n */
	 FRAME(tmp) = n;		/* value to switch over */
	 pvt = lpv;			/* top of value stack */

/* look in goto table for next state
 * if r2[n] doesn't have the low order bit set
 * then there is no action to be done for this reduction
 * and no saving/unsaving of registers done
 */
	 len = r2[n];
	 if (!(len & 01))
	    {len >>= 1;
	     lpv -= len;
	     FRAME(val) = lpv[1];

	     n = r1[n];
	     lps -= len;
	     lstate = pgo[n] + *lps + 1;
	     if ((lstate >= LASTTOK) ||
		 (chk[lstate = act[lstate]] != -n))
	        {lstate = act[pgo[n]];};

	     continue;};

	 len >>= 1;
	 lpv -= len;
	 FRAME(val) = lpv[1];

	 n   = r1[n];
	 lps -= len;
	 lstate = pgo[n] + *lps + 1;
	 
	 if ((lstate >= LASTTOK) ||
	     (chk[lstate = act[lstate]] != -n))
	    {lstate = act[pgo[n]];};

/* save until reenter driver code */
	 FRAME(state) = lstate;
	 FRAME(ps)    = lps;
	 FRAME(pv)    = lpv;

	 _PD_disp_rules(FRAME(tmp), pvt);

	 lpv    = FRAME(pv);
	 lps    = FRAME(ps);
	 lstate = FRAME(state);};}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_DISP_RULES - dispatch on the specified rule */

static void _PD_disp_rules(rule, pvt)
   int rule;
   char **pvt;
   {

    switch (rule)

/* variable_expression :
 *      unary_expression
 *    | OPEN_PAREN type CLOSE_PAREN variable_expression
 */
       {case 2:
	     _PD_do_cast(pvt[-2]);
	     break;

/*    | */
	case 3:
/*	     PD_error("EMPTY UNARY EXPRESSION - _PD_DISP_RULES", PD_TRACE); */
	     break;

/* type :
 *      IDENTIFIER
 */
	case 4:
	     FRAME(val) = text;
	     break;

/*    | type STAR */
	case 5:
	     sprintf(msg, "%s *", pvt[-1]);
	     FRAME(val) = msg;
	     break;

/* unary_expression :
 *      postfix_expression
 *    | STAR variable_expression
 */
	case 7:
	     _PD_do_deref();
	     break;

/* postfix_expression :
 *      primary_expression
 */
	case 8:
	     _PD_do_goto(pvt[-0]);
	     break;

/*    | postfix_expression OPEN_PAREN index_expression CLOSE_PAREN */
	case 9:
	     _PD_do_index(pvt[-1]);
	     SFREE(pvt[-1]);
	     break;

/*    | postfix_expression DOT primary_expression */
	case 10:
	     _PD_do_member(pvt[-0], FALSE);
	     break;

/*    | postfix_expression ARROW primary_expression */
	case 11:
	     _PD_do_member(pvt[-0], TRUE);
	     break;

/* index_expression :
 *         range
 *       | index_expression COMMA range
 */
	case 13:
	     sprintf(msg, "%s,%s", pvt[-2], pvt[-0]);
	     SFREE(pvt[-2]);
	     SFREE(pvt[-0]);
	     FRAME(val) = SC_strsavef(msg, "char*:PARSE:COMMA");
	     break;

/* range : index
 *       | index COLON index
 */
	case 15:
	     if (strcmp(pvt[-2], pvt[-0]) != 0)
	        colon = TRUE;
	     sprintf(msg, "%s:%s", pvt[-2], pvt[-0]);
	     SFREE(pvt[-2]);
	     SFREE(pvt[-0]);
	     FRAME(val) = SC_strsavef(msg, "char*:PARSE:COLON");
	     break;

/*       | index COLON index COLON index */
	case 16:
	     if (strcmp(pvt[-4], pvt[-2]) != 0)
	        colon = TRUE;
	     sprintf(msg, "%s:%s:%s", pvt[-4], pvt[-2], pvt[-0]);
	     SFREE(pvt[-4]);
	     SFREE(pvt[-2]);
	     SFREE(pvt[-0]);
	     FRAME(val) = SC_strsavef(msg, "char*:PARSE:COLON:COLON");
	     break;

/* index : INTEGER */
	case 17:
	     sprintf(msg, "%ld", num_val);
	     FRAME(val) = SC_strsavef(msg, "char*:PARSE:INTEGER");
	     break;

/*       | variable_expression */
	case 18:
	     sprintf(msg, "%ld", _PD_do_digress(pvt[-0]));
	     FRAME(val) = SC_strsavef(msg, "char*:PARSE:VARIABLE_EXPRESSION");
	     break;

/* primary_expression : IDENTIFIER */
	case 19:
	     if (colon)
	        PD_error("HYPERINDEX ON NON-TERMINAL NODE - _PD_DISP_RULES",
			 PD_TRACE);
	     FRAME(val) = text;
	     break;};

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/