head	1.1;
access;
symbols;
locks
	gtoal:1.1; strict;
comment	@ * @;


1.1
date	2022.02.11.21.40.31;	author gtoal;	state Exp;
branches;
next	;


desc
@generic parser
@


1.1
log
@Initial revision
@
text
@// current bug: a single " in a comment throws everything off... see lisps.imp

// The recent restructuring was primarily to support adding regexes on top of the
// keyword mechanism.  Don't forget to actually add it!

// for examples such as Imp variables with spaces in them - the stored token in the stringpool
// is the canonical form, but the text between token_start and token_end markers is the literal
// form with embedded whitespace (not to be confused with leading whitespace)

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <errno.h>
#include <stdarg.h>
#include <ctype.h>

// Need to know what kind of line reconstruction we will be doing.
#define IMP_PARSER 1
//#define C_PARSER 1

#ifndef FALSE
#define FALSE (0!=0)
#define TRUE (0==0)
#endif

#define NEGATED_PHRASE (1<<29)
#define OPTIONAL_PHRASE (1<<30)
#define DROP_SPECIAL_BITS (~(NEGATED_PHRASE|OPTIONAL_PHRASE))

// The style inherited from the Edinburgh parsers packs different styles of
// object into sequential ranges in the grammar items.  It might be a better
// organisation to make those all into separate spaces all based at 0, with
// the space being defined by a (high position) tag bit.  For example keywords
// might be under 1<<28, literals under 1<<27, and regexps under 1<<26 etc.

// This wasn't feasible in the old compilers where ints had to fit in 16 bits
// but with 32 bit ints we would have plenty of space for flag bits.

#define MAX_PHRASES 1024
#define WHITESPACE (MAX_PHRASES-1)

char *progname;

//static char outname[256];
//FILE *outfile;

static int debug_tokens = FALSE; // debug line reconstruction
static int debug_arec   = FALSE;
static int debug_ast    = FALSE;
static int debug_line_reconstruction = FALSE;
static int listing = 0; // produce a source listing
static int cur_listing = 0; // only used by takeon for guard phrases to suppress listing of optional items when recreating source

#define EXTENDED_ERROR_REPORTING 1 // applies to parser.h ...
#define WANT_COMMENT 1

// this area needs review:
extern int *A;
extern int cp;                     // code pointer.  Has to be global state.
extern int ap;                     // Analysis record pointer.

#ifdef UNUSED_FOR_NOW
// some semantic routine assistance:
int typedef_table[123];// for now
int push(int val, int *table);
int check(int Aval, int *table);
#endif

// These turn on extra features in the grammar .h file if present.
// Unfortunately if not present, turning these on here will cause errors.
//#define WANT_SEMANTIC_CODE 1
//#define WANT_SEMANTIC_TABLE 1

#include TABLE // "parser.h"              // GENERATED GRAMMAR FROM takeon

#ifndef SEMANTIC_NAME
#define SEMANTIC MAX_PHRASES
//#define SEMANTIC (MAX_PHRASE+PHRASES_START+MAX_BIP+1)
char *semantic_code[1];
int semantic(int phrase) {
  return FALSE;
}
#endif


#ifdef CHECK_INDEXES
int CHECKIDX(int x, int arraysize, char *name, int line) {
  if ((x < 0) || (x >= arraysize)) {
    fprintf(stderr, "* Array bounds exceeded at line %d: %s[%d] is outside %s[%d]\n",
            line, name, x, name, arraysize);
    exit(4);
  }
  return x;
}
#else
#define CHECKIDX(x, arraysize, name, line) (x)
#endif

#define FLEX(array,x,l) array[CHECKIDX(x,array##_arraysize,#array,l)]
#define BOUNDS(array,x,lim,l) array[CHECKIDX(x,lim,#array,l)]

#define gram(x) BOUNDS(gram, x, MAX_GRAMMAR, __LINE__)
#define keyword(x) BOUNDS(keyword, x, MAX_KEYWORD, __LINE__)
#define BIP(x) BOUNDS(BIP, x, MAX_BIP, __LINE__)
#define phrasename(x) BOUNDS(phrasename, x, MAX_PHRASE, __LINE__)
#define phrase_start(x) BOUNDS(phrase_start, x, MAX_PHRASE-MAX_BIP, __LINE__)

int debug_parser = FALSE; // use -d option
int debug_flex = FALSE; // excessive debugging that I needed when finding the problem with using string addresses rather than stringpool offsets...

void indent (int n, FILE * f) {
  fprintf (f, "%-*s", n*3, " ");
}

int bestparse = -1;             // for error reporting.
char **parse_stack = NULL;
int parse_stack_arraysize = 0;
#define parse_stack(x) FLEX(parse_stack, x, __LINE__)

char **bestparse_stack = NULL;
int bestparse_stack_arraysize = 0;
#define bestparse_stack(x) FLEX(bestparse_stack, x, __LINE__)
int bestparse_depth = -1;

char looking_for[1024] = { '\0' };        // 'while looking for <PHRASENAME>' (or literal) ...

  // We use a stringpool, and strings are indexes into this pool.  This
  // is useful for the same reasons that the AST is an array indexed
  // by integers rather than a struct with pointers.  It may also
  // save space by reusing common strings.  And we get a free tag
  // to describe strings.  (Also we can compare strings just with
  // an integer tag comparison, if we ever want to)

static void *makespace_ (void *c, int nextfree, int *arraysize, int objsize, char *arrayname) {
#define MINSIZE 1    // 64 causes an error, so we are not being clean somewhere...
                     // However, whatever the error is, it probably isn't an array bounds error,
                     // as we're checking for those with CHECKIDX ...
  
  // *arraysize is the upper bound index of the array, i.e. 1 less than the actual number of elements.  
  if (debug_flex && (*arraysize) < nextfree) fprintf(stderr, "makespace: %s needs space for %d entries (currently %d)\n", arrayname, nextfree, *arraysize);
  if (c == NULL) {    // TOO MANY TESTS! Need to pick the right one!
    if (debug_flex) fprintf (stderr, "makespace: %s = calloc(%d, %d)\n", arrayname, MINSIZE, objsize);
    c = calloc (MINSIZE, objsize);
    if (c == NULL) {
      fprintf (stderr, "makespace: calloc(%d, %d) - %s\n", MINSIZE, objsize, strerror (errno));
      exit (errno);
    }
    *arraysize = MINSIZE - 1;
  }
  if ((*arraysize) > nextfree) return c;
  // *arraysize is the space allocated, nextfree is the space that will used soon.
  // so we want to make sure that *arraysize >= nextfree
  *arraysize += 1; // convert from high index to actual size
  while ((*arraysize) <= nextfree) { // probably should be '<' but doing so allows an array size of 0 which crashes. come back to this.
    *arraysize = ((*arraysize) * 2);
    if (debug_flex) fprintf(stderr, "makespace: %s increased to %d entries\n", arrayname, *arraysize);
  }
  // *arraysize = ((*arraysize) * 2);

  // we do seem to have a problem where we sometimes realloc the exact same size as it was before!
  
  if (debug_flex) fprintf (stderr, "makespace: %s = realloc(%d * %d)\n", arrayname, (*arraysize), objsize);
  c = (void *) realloc (c, (*arraysize) * objsize);       // 0:arraysize, inclusive. eg 0:15, 0:127 etc
  *arraysize -= 1; // restore size back down to upper bound index
  if (c == NULL) {
    fprintf (stderr, "makespace: realloc(%d * %d) - %s\n", (*arraysize), objsize, strerror (errno));
    exit (errno);
  }
  return c;
}
#define makespace(c, nextfree) c = (typeof(c))makespace_(c, nextfree, &c##_arraysize, sizeof(c[0]), #c)

char *stringpool;
int stringpool_arraysize = 0;
int stringpool_nextfree = 0;
#define stringpool(x) FLEX(stringpool, x, __LINE__)

#define String(i) &stringpool(c(i).sIndex)

char *escape(char *s, int ch);
int str_to_pool (char *s) {
  int tag;
  // assert(stringpool_nextfree <= stringpool_arraysize);
  makespace(stringpool, stringpool_nextfree+strlen(s)+2);

  strcpy (&stringpool(stringpool_nextfree), s);  /* Create a backstop for when not found */
  for (tag = 0; tag <= stringpool_nextfree; tag++) {
    if (strcmp (&stringpool(tag), s) == 0) {
      if (tag == stringpool_nextfree) {
        if (debug_flex) fprintf(stderr, "adding pre-positioned stringpool: %d: \"%s\" (extends to %ld)\n",
                                stringpool_nextfree, escape(&stringpool(stringpool_nextfree), '"'), (long)(stringpool_nextfree + strlen (s) + 1));
        stringpool_nextfree += strlen (s) + 1;       /* Not found, add it */
      } else {
        if (debug_flex) fprintf(stderr, "found in existing stringpool: %d: \"%s\"\n", tag, escape(&stringpool(tag), '"'));
        if (debug_flex) fprintf(stderr, "pre-positioned stringpool ignored: %d: \"%s\" (extended to %ld)\n",
                                stringpool_nextfree, escape(&stringpool(stringpool_nextfree), '"'), (long)(stringpool_nextfree+strlen (s) + 1));
      }
      return tag;               /* found, one way or another */
    }
  }
  /* NOT REACHED */
}

  /* C[] is the source character token stream */

typedef struct sourceinfo {     // ATOMS for processed input stream

  //char *s; // The canonical representation of this source object
             // is a string, which has now been moved to the stringpool:
  int sIndex;                   // string contents
  int start_sp, lineno_sp, col_sp;
  int start_tok, lineno_tok, col_tok;
  int end_tok, endcol_tok;  // trailing white space must be viewed as leading white space before EOF token.

  // starting 2 ptrs are inclusive, end ptr is exclusive.

  // The obscure case where there is whitespace at the end of an include file followed
  // by whitespace before a token in the file above will be handled by a sourceinfo
  // record where start_sp != start_tok, but start_tok == endcol_tok, ie ""

  // If tok is multi-line eg a string with embedded newlines, lineno_tok is the line
  // number of the start of the token.

  // Single tokens formed by token pasting are problematic and I think for now
  // will be dealt with by the grammar explicitly constructing a string from its parts

  // Pre-processor issues are a whole 'nother kettle of fish...
  
  int t;                        // type - tag, "string", 'charconst', or char, so far
  char *f;                      // source or includefile name
} sourceinfo;

static sourceinfo *c = NULL;
int c_nextfree = 0, c_arraysize = 0;
#define c(x) FLEX(c, x, __LINE__)

/* A() is the Analysis record.
     Contents point to a C[] structure when the item is a BIP,
     otherwise the format is [phraseno] [altno] [no-of-subphrases] [subphrases and/or BIPs...]
     for example, if A(25) contained 10, that would mean that the
     token for A(25) was stored in C[10].]
     (And the C string would be at &stringpool[c(A(25))]?)
   */

int *A = NULL;           /* Flex array, expanded using 'makespace' below */
int next_free_a = 0, A_arraysize = 0;
#define A(x) FLEX(A, x, __LINE__)

int *AST;
int AST_arraysize;
int AST_nextfree = 0;
#define AST(x) FLEX(AST, x, __LINE__)
////////////////////////////////////////////////////////////////////////////

int mktuple(int op, int alt, int count, int T[]) {
  /*  Create a tuple for an n-ary operator.  Pre-generated code
      currently just mirrors the Analysis record. */
  int trip = -1;
  int parm;


  makespace (AST, AST_nextfree+4+count+1);

  trip = AST_nextfree;
  AST(AST_nextfree++) = 0;  // reserved field
  AST(AST_nextfree++) = op;
  AST(AST_nextfree++) = alt;
  AST(AST_nextfree++) = count;
  if (debug_ast) fprintf(stderr, "mktuple(%d, %d, %d, [", op, alt, count);
  for (parm = 0; parm < count; parm++) {
    if (debug_ast) fprintf(stderr, " %d", T[parm+1]);
    AST(AST_nextfree++) = T[parm+1];
  }
  if (debug_ast) fprintf(stderr, " ]) = %d\n", trip);

  return trip;
}

int escapech(char *dest, int ch, int quotetype) {
  const char *hexdigit = "0123456789ABCDEF";
  // This is only for display in debugging info.
  // It is not appropriate for the language being
  // compiled as these use C conventions.
    /*
      TO DO:

      Character Meaning
      '\a'      alert (BEL)
      '\b'      backspace
      '\f'      form feed
      '\n'      newline
      '\t'      horizontal tab
      '\r'      carriage return
      '\v'      vertical tab
      '\\'      backslash
      '\''      single quote
      '\"'      double quote
      '\?'      Question mark

     Also ??? sequences in strings.
     */
  char *t = dest;
  if (ch == '\n') {
    *t++ = '\\'; *t++ = 'n';
  } else if (ch == '\t') {
    *t++ = '\\'; *t++ = 't';
  } else if (ch == '\r') {
    *t++ = '\\'; *t++ = 'r';
  } else if (ch == '\\') {
    *t++ = '\\'; *t++ = '\\';
  } else if (ch == quotetype) {
    *t++ = '\\'; *t++ = quotetype;
  } else if ( ((int)(ch&255) < 32) || ((int)(ch&255) > 126) ) {
    *t++ = '\\'; *t++ = 'x';  // Wait! is is \xFF or \0xFF ???
    *t++ = hexdigit[(ch>>4)&15];
    *t++ = hexdigit[ch&15];
  } else {
    *t++ = ch;
  }
  *t = '\0';
  return t-dest;
}

char *escape(char *s, int quotetype) { // assert we NEVER call escape on a genuinely empty string - if s[0] == '\0' then it is a '\0' character
  // \0 only supported in the single character constant '\0', not in strings.
  static char escaped[512];
  char *t = escaped;
  *t = '\0';
  if (s == NULL) return escaped;
  if ((*s == '\0') && (quotetype == '\'')) {
    *t++ = '\\'; *t++ = '0'; s++; *t = '\0';
  } else {
    while (*s != '\0') {
      t += escapech(t, *s++, quotetype);
      if (t-escaped >= 510) {
        fprintf(stderr, "WARNING! Escaped string is too large! (over %ld chars): \"%s\"...\n", (long)(t-escaped), escaped);
        // ideally we should truncate at the first \n (if there is one) and continue parsing from there...
        exit(1);
      }
    }
  }
  if (t-escaped >= 510) {
    fprintf(stderr, "WARNING! Escaped string is too large! (over %ld chars): \"%s\"...\n", (long)(t-escaped), escaped);
    // ideally we should truncate at the first \n (if there is one) and continue parsing from there...
    exit(1);
  }
  return escaped;
}

// THIS DOES *NOT* PARSE A BIP!
// This assumes that the next item in the c[] array is the BIP data and makes it into an AST entry.
int bip(int B, int aptr)
{
  int astidx, data[3];

  switch (B) {
  case B_EOF:
  case B_stropped:
  case B_alphanumeric:
  case B_digit:
  case B_sqstring:
  case B_dqstring:
  case B_char:
  case B_NL:
    data[1] = B;
    data[2] = aptr;
    astidx = mktuple(B, 1, 2, data);
    if (debug_ast) if (B == B_alphanumeric) fprintf(stderr, "mktuple(%d, 1, 2, [B_%d A(%d)]) = %d\n", B, data[1], data[2], astidx);
    return astidx;
    break;
  default:      
    fprintf(stderr, "*** ERROR: Unhandled BIP %d\n", B);
    exit(EXIT_FAILURE);
  }
}

int kw(int AST_op, int idx, int ap)
{
  int data[4];
  int i;
  char *k = keyword(idx);
  data[1] =  idx;
  data[2] = A[ap+3]; // index of c[] array element
  data[3] = strlen(k);
  if (listing) fprintf(stderr, "%s", k);
  return mktuple(AST_op, 1, 3, data);
}

int lit(int AST_op, int ch, int ap)
{
  int data[3];
  data[1] =  ch; // actual character
  data[2] =  ap;
  if (listing) fprintf(stderr, "%c", data[1]);
  return mktuple(AST_op, 1, 2, data);
}

////////////////////////////////////////////////////////////////////////////

/* variables used by line-reconstruction (lexer) */
FILE *sourcefile;
char *curfile;


char *source_address = NULL;
int source_length = 0;
#define source_address(x) BOUNDS(source_address, x, source_length+1, __LINE__)

static int *source_line;
static int source_line_arraysize = 0;
#define source_line(x) FLEX(source_line, x, __LINE__)
static int source_lines = 0;

// for now, just read the file in.
// However option remains to connect the file in virtual memory...
void memory_map_file(char *filename) {
  FILE *f = fopen(filename, "rb");
  int i;
  long length;
  char *buffer;
  i = fseek(f, 0L, SEEK_END);
  length = ftell(f);
  i = fseek(f, 0L, SEEK_SET);
  buffer = malloc(length+2);
  if (buffer == NULL) {
    fprintf(stderr, "* buffer = malloc(%ld) failed\n", length+1);
    exit(EXIT_FAILURE);
  }
  for (i = 0; i < length; i++) buffer[i] = fgetc(f);
  buffer[length] = '\0';
  buffer[length+1] = '\0';
  source_address = buffer;
  source_length = length; // an extra one for 'peek' lookahead
  //fprintf(stderr, "****************************** file length = %ld\n", length);
  makespace (c, source_length+2); // overkill, because more chars than tokens.


  //printf("/* Mapped file: */\n");
  //for (i = 0; i < length; i++) putchar(buffer[i]);
  //printf("/* End of mapped file. */\n");
}

//void find_lines(char *source_address, int source_length) {
void find_lines(void) {
  int line = 0;
  int i, p = 0;
  int lastch = '\n';
  makespace (source_line, line+1);
  source_line(line++) = -1; // lines start at 1.
  for (;;) {
    if (lastch == '\n') {
      makespace (source_line, line+1);
      source_line(line++) = p;
    }
    if (p == source_length) break;
    lastch = source_address(p++);
  }
  source_lines = line-1;
  if (debug_line_reconstruction) {
    fprintf(stderr, " **** %d lines\n\n", source_lines-1); // line 1 not included
    for (i = 1; i < source_lines; i++) {
      p = source_line(i);
      fprintf(stderr, "%4d: ", i);
      while (p < source_length) {
        int c = source_address(p++);
        fputc(c, stderr);
        if (c == '\n') break;
      }
    }
  }
}

int startline = TRUE; // startline is true before hitting the first non-whitespace character in a line.  In C used mainly for # commands.

int whitespace_lineno = 1;
int whitespace_col = 0;
int whitespace_pos = 0;

int token_lineno = 1;
int token_col = 0;
int token_pos = 0;

int nextch_lineno = 1;  // under development.  sorting out the problem with xfgetc/xungetc
int nextch_col = 0;
int nextch_pos = 0;

int ch, peek; // peek is always the *immediate* next char, no skipping of spaces

static int xfgetc (FILE * f) {
  int ch;
  if (nextch_pos >= source_length) return EOF;
  ch = source_address(nextch_pos);
  if (ch == '\n') {
    nextch_lineno += 1; nextch_col = 0;
  } else nextch_col += 1;
  if (debug_line_reconstruction) fprintf(stderr, "Ch %d of %d: {%c}\n", nextch_pos, source_length, ch);
  peek = source_address(++nextch_pos);
  return ch&255;
}

#ifdef C_PARSER
// Imp line reconstruction doesn't need ungetc, but C does
static void xungetc (int c, FILE * f) { // for a xfgetc char, not for peek.
  // rather than subtracting 1 from postions it may be better to save all
  // the positions in xfgetc and unwind them, thus avoiding the issue of
  // whether we're ungetting a token or whitespace.  Or supply two xungetc's...
  if (nextch_pos > 0) {
    nextch_pos -= 1;
    if (nextch_col == 0) {
      int p;
      nextch_lineno -= 1;
      p = source_line(nextch_lineno);
      while (source_address(p) != '\n') {
        if (p == source_length) break;
        nextch_col += 1; p += 1;
      }
    } else nextch_col -= 1;
  } else {
    // invalid ungetc. nothing to unget at start of file.
  }
  ch = source_address(nextch_pos-1);//+1
  //  if (c == '\n') {
  //    nextch_lineno += 1; nextch_col = 0;
  //  } else nextch_col += 1;
  if (nextch_pos == source_length) peek = EOF; else peek = source_address(nextch_pos);//+1
}
#endif

void stores (char *s,
             int toklineno, int tokcol, int tokpos,
             int type, char *fname, int line) {
  int i, tag;
  tag = str_to_pool (s);

  makespace (c, c_nextfree+1);

  c(c_nextfree).sIndex = tag; // pointer to index of string in stringpool - NOT string because stringpool can be reallocked.

  c(c_nextfree).lineno_sp = whitespace_lineno;
  c(c_nextfree).col_sp = whitespace_col;
  c(c_nextfree).start_sp = whitespace_pos;

  c(c_nextfree).lineno_tok = toklineno;
  c(c_nextfree).col_tok = tokcol;
  c(c_nextfree).start_tok = tokpos;

  c(c_nextfree).endcol_tok = nextch_col;
  c(c_nextfree).end_tok = nextch_pos;    // may need to pass these in if already stepped past the end of the token
  // but for now we'll rely on xungetc to have stepped back appropriately so that the next character to be read
  // is the first character immediately following this token

  c(c_nextfree).f = fname;
  c(c_nextfree).t = type;

  if (debug_line_reconstruction) {
    char message[1024];
    char *mess = message;
    mess += sprintf(mess, "['%s'|'", escape(s, '\''));
    for (i = whitespace_pos; i < token_pos; i++) mess += escapech(mess, source_address[i], '\'');
    mess += sprintf(mess, "'|'");
    for (i = token_pos; i < nextch_pos; i++) mess += escapech(mess, source_address[i], '\'');
    if (strlen(message) >= 1023) {
      fprintf(stderr, "* String capacity exceeded - message[] in stores\n");
      exit(EXIT_FAILURE);
    }
    fprintf(stderr, "%s']", message);
    if (s[strlen(s)-1] == '\n') fprintf(stderr, "\n");
  }
  
  whitespace_lineno = nextch_lineno;
  whitespace_col = nextch_col; // ready for next token.
  whitespace_pos = nextch_pos;
  
  if (debug_flex) {
    fprintf(stderr, "Setting c[%d]: lineno=%d col=%d f=\"%s\" t=%d s=\"%s\" (at %p) Line %d\n",
                     c_nextfree, c(c_nextfree).lineno_tok,
                     c(c_nextfree).col_tok, c(c_nextfree).f, c(c_nextfree).t,
            escape(String(c_nextfree), '"'), String(c_nextfree), line);
    /*fprintf(stderr, "CHECK c[%d]: lineno=%d col=%d f=\"%s\" t=%d s=\"%s\" (at %p)\n",
                     0, c(0).lineno_tok,
                     c(0).col_tok, c(0).f, c(0).t,
                     escape(String(0), '"'), String(0));*/
  }
  c_nextfree++;
}
void storec (int ch, int toklineno, int tokcol, int tokpos, int type, char *fname, int line) {
  char str[2];
  str[0] = ch&255; str[1] = '\0';        // convert char to 1-char string before saving.
  stores (str,
          toklineno, tokcol, tokpos,
          type, fname, line);
}
#define stores(s, toklineno, tokcol, tokpos, type, fname) stores(s, toklineno, tokcol, tokpos, type, fname, __LINE__)
#define storec(ch, toklineno, tokcol, tokpos, type, fname) storec(ch, toklineno, tokcol, tokpos, type, fname, __LINE__)

int is_binary(int ch) {
  return ((ch|1) == '1');
}

int is_octal(int ch) {
  return ('0' <= ch) && (ch <= '7'); // or...  (ch|7) =='7'
}

int is_decimal(int ch) {
  return ('0' <= ch) && (ch <= '9');
}

int is_hex(int ch) {
  return (('0' <= ch) && (ch <= '9')) || (('a' <= ch) && (ch <= 'f')) || (('A' <= ch) && (ch <= 'F'));
}

void em_char_in_stmnt(int line) {
  // (a little nod to the past...)
  fprintf(stderr, "EM CHAR IN STMNT - DISASTER (detected at parser line %d)\n", line); // stop-gap measure - needs a longjump to end of compile code to clean up
  exit(EXIT_FAILURE);
}
#define em_char_in_stmnt() em_char_in_stmnt(__LINE__)

void line_reconstruction (FILE *sourcefile, char *filename) {
  int (*acceptable_range)(int ch);
  int token_nextfree, startcol;
  static int token_arraysize = 0;
  static char *token = NULL;
#define token(x) FLEX(token, x, __LINE__)

  // Recognise keywords, variable names, single and double-quoted strings
  // while removing comments and handling line continuation.
  // The c[] array gets the canonicalised version of the text, BUT retains
  // pointers to the original text including whitespace, which comes in
  // handy for any source-to-source transformations such as SOAP (pretty printing)
  // or transpiling to another language (eg imp to c)
  int at_startofstatement = TRUE;
  int in_keyword = FALSE;
  int in_alphanumeric = FALSE;
  makespace(token,1024); // quick hack only for test.imp fix as soon as lexer is written.

  /* Pre-process input ready for parsing.  Tokens are stored in array C[] */
  // go over this again and make sure 'col' is updated correctly at all places where chars are read.
  for (;;) {
    startcol = nextch_col;
    token_nextfree = 0;
    token_lineno = nextch_lineno;
    token_col = nextch_col;
    token_pos = nextch_pos; // actual text of token may start here but whitespace goes back to end of previous token.
 
    if ((ch = xfgetc (sourcefile)) == EOF) {
      break; // The code after this loop saves an EOF record in the c[] array
    }

    if (ch == 127) {
      fprintf(stderr, "? Warning: stray character 127 in source.\n");
      continue;
    }
    
    // The test below does not catch   Label: !comment or swlab(n): !comment
    // The problem we have to handle is a ! comment that contains a single " which starts a multi-line string
    // because that comment is not recognised until parse-time, but the " is handled at line reconstruction time...
    // We *could* have a hack that treated ':' as ';' but ':' can also occur in array bounds...
    // and '!' can occur in integer expressions, so marking everything that follows a '!' as B_char won't work either.
    // (and would mess up a final %c in a comment)
    if (at_startofstatement && (ch == '!')) {
      // For the moment we'll treat '!' comments as whitespace, though in Imp they're parsed statements in the grammar.
      // Whether this will hold up when we hit %comment comments as well is a matter for debate!

      do {
        ch = xfgetc (sourcefile); if (ch == EOF) em_char_in_stmnt(); // comment that ends in <EOF>???
      } while (ch != '\n');  // In Imp, does a ';' end a '!' comment and/or a %comment ???  grep old sources and adjust later...

      // There's also a nasty case of continuation that has to be handled here:
      // %const %integer %array reltag(0:6) =
      //             0,                         ;! no relocation
      //                            IF DATA,    ;! dataseg offset code word

      // The code for removing ';'s after '=' has to be applied here too :-(
      if ((c_nextfree > 1) && (c(c_nextfree-2).t == B_char) && strcmp(String(c_nextfree-2), ",")==0) {
        if ((c_nextfree > 0) && (c(c_nextfree-1).t == B_char) && strcmp(String(c_nextfree-1), ";")==0) {
          c_nextfree -= 1;
          // Remove the ; but leave it in the whitespace.  This is sneaky:
          whitespace_lineno =  c(c_nextfree).lineno_sp;
          whitespace_col = c(c_nextfree).col_sp;
          whitespace_pos = c(c_nextfree).start_sp;
          at_startofstatement = TRUE; // NOT REALLY START OF STATEMENT BUT ! comments NEED TO THINK IT IS
          continue;
        }
      }
      // drop through because we still want the newline to have significance
      // (not sure about continuations in this kind of comment)
    }
    if (ch == '\'' || ch == '"') { // start of string. Stored as typed string data without quotes or escaping.
      int quotech = ch;
      int backtrack_token = token_nextfree;
      int backtrack_pos = token_pos;
      int backtrack_lineno = token_lineno;
      int backtrack_col = token_col;
      int stringlength = 0;
      at_startofstatement = FALSE;
      // probably a char constant but can be other things, eg M'HECK' is a 32-bit int.
      for (;;) {
        ch = xfgetc (sourcefile);
        if (ch == EOF) {
          // backtrack and warn if EOF found in string - almost certainly an unterminated string
          token_nextfree = backtrack_token;
          token_pos = backtrack_pos;
          token_lineno = backtrack_lineno;
          token_col = backtrack_col;
          ch = quotech;
          storec (ch, token_lineno, token_col, token_pos, B_char, curfile); // leave it for the parser to cause a syntax error.
          continue;
        }
        if (ch == quotech) { // quotech in string is represented by doubling.  No C-like escape characters.
          if (peek != quotech) break;
          ch = xfgetc (sourcefile); if (ch == EOF) em_char_in_stmnt();  // \<EOF> ?!!!!
        }
        makespace(token,token_nextfree+1);
        token(token_nextfree++) = ch;
        stringlength += 1;
        if (stringlength == 256) {
          // backtrack and warn if string is longer than 255 characters - almost certainly an unterminated string
          token_nextfree = backtrack_token;
          token_pos = backtrack_pos;
          token_lineno = backtrack_lineno;
          token_col = backtrack_col;
          ch = quotech;
          storec (ch, token_lineno, token_col, token_pos, B_char, curfile); // leave it for the parser to cause a syntax error.
          continue;
        }
      }
      token(token_nextfree) = '\0';
      stores (token,
              token_lineno, token_col, token_pos,
              quotech == '"' ? B_dqstring : B_sqstring,
              curfile);
      continue;
    }
    if (ch == '%') {
      at_startofstatement = FALSE;
      // start of case-stropping.  This might get tricky...
      // we only store single stropped characters as a lowercase 'char' but have to handle %c etc later
      // Alphas in names are stored in uppercase (although the original case is accessible too)
      in_keyword = isalpha(peek);
      // I'm not sure if a % not followed by a letter disappears or is passed through.  Will pass through for now.
      if (in_keyword) continue; // so don't save it.
    }
    if (isalpha(ch)) {
      at_startofstatement = FALSE;
      if (in_keyword) {
        // store a keyword character under B_stropped
        storec (tolower(ch),
                token_lineno, token_col/*-1*/, token_pos,
            B_stropped, curfile); 
      } else {
        // store a name character under B_alphanumeric
        storec (toupper(ch),
                token_lineno, token_col/*-1*/, token_pos,
            B_alphanumeric, curfile); 
        in_alphanumeric = TRUE;
      }
      continue;
    }
    in_keyword = FALSE;
    if (isdigit(ch)) {
      at_startofstatement = FALSE;
      if (in_alphanumeric) {
        // store a name character under B_alphanumeric
        // leading and internal spaces and comments are preserved
        // The parser will build up complete names from the individual alphanumerics
        // Note: Not yet handling any non-alphanumeric characters allowed in variable names
        // (e.g. '$' in Vax code, though that particular case is handled using %alias ...
        //  - maybe underline in C code is a better example.)
        storec (ch,
                token_lineno, token_col/*-1*/, token_pos,
            B_alphanumeric, curfile); 
      } else {
        // store digit under B_digit
        // We only store individual digits, allowing the parser to build up digit sequences
        storec (ch,
                token_lineno, token_col/*-1*/, token_pos,
            B_digit, curfile);
      }
      continue;
    }
    // Skip white space
    if ((ch != '\n') && isspace(ch)) continue;
    in_alphanumeric = FALSE;
    if (ch == '{') {
      // Skip comments but they will be attached to the following token.
      // skip to '}' or end of line.
      for (;;) {
        ch = xfgetc (sourcefile); if (ch == EOF) em_char_in_stmnt(); //  { ... <EOF>?
        if (ch == '}' || ch == '\n') break;
      }
      if (ch == '}') continue;
    }
    if (ch == '\n') {

      // This continuation stuff gets REALLY ugly when you finally remember that none of it
      // is allowed in a comment :-(

      // It is almost enough to make you add '!' comments to the line reconstruction...
      // but even then a %comment ending in a ',' is a pain.
      
      // Note that in a %comment ending in a %c, the %c really is a continuation symbol,
      // even for the stupid case of:  %comment Note that the routine above is %dynamic
      
      // if last non-skipped,non-whitespace character in c[] was %c then remove it and the newline.
      if ((c_nextfree > 0) && (c(c_nextfree-1).t == B_stropped) && strcmp(String(c_nextfree-1), "c")==0) {
        c_nextfree -= 1;
        // Remove the %c but leave it in the whitespace.  This is sneaky:
        whitespace_lineno =  c(c_nextfree).lineno_sp;
        whitespace_col = c(c_nextfree).col_sp;
        whitespace_pos = c(c_nextfree).start_sp;
        at_startofstatement = TRUE; // NOT REALLY START OF STATEMENT BUT ! comments NEED TO THINK IT IS
        continue;
      }
      // if last non-skipped,non-whitespace character in c[] was %or then remove the newline.
      if ((c_nextfree > 1) && (c(c_nextfree-2).t == B_stropped) && strcmp(String(c_nextfree-2), "o")==0) {
        if ((c(c_nextfree-1).t == B_stropped) && strcmp(String(c_nextfree-1), "r")==0) {
          at_startofstatement = TRUE; // NOT REALLY START OF STATEMENT BUT ! comments NEED TO THINK IT IS
          continue;
        }
      }
      // if last non-skipped,non-whitespace character in c[] was %and then remove the newline.
      if ((c_nextfree > 2) && (c(c_nextfree-3).t == B_stropped) && strcmp(String(c_nextfree-3), "a")==0) {
        if ((c(c_nextfree-2).t == B_stropped) && strcmp(String(c_nextfree-2), "n")==0) {
          if ((c(c_nextfree-1).t == B_stropped) && strcmp(String(c_nextfree-1), "d")==0) {
            at_startofstatement = TRUE; // NOT REALLY START OF STATEMENT BUT ! comments NEED TO THINK IT IS
            continue;
          }
        }
      }
      // if last non-skipped,non-whitespace character in c[] was '=' or ',' then skip the newline.
      if ((c_nextfree > 0) && (c(c_nextfree-1).t == B_char) && strcmp(String(c_nextfree-1), "=")==0) {
        at_startofstatement = TRUE; // NOT REALLY START OF STATEMENT BUT ! comments NEED TO THINK IT IS
        continue;
      }
      // if last non-skipped,non-whitespace character in c[] was '-' then skip it and the newline.
      if ((c_nextfree > 0) && (c(c_nextfree-1).t == B_char) && strcmp(String(c_nextfree-1), "-")==0) {
        c_nextfree -= 1;
        whitespace_lineno =  c(c_nextfree).lineno_sp;
        whitespace_col = c(c_nextfree).col_sp;
        whitespace_pos = c(c_nextfree).start_sp;
        at_startofstatement = TRUE; // NOT REALLY START OF STATEMENT BUT ! comments NEED TO THINK IT IS
        continue;
      }
      if ((c_nextfree > 0) && (c(c_nextfree-1).t == B_char) && strcmp(String(c_nextfree-1), ",")==0) {
        at_startofstatement = TRUE; // NOT REALLY START OF STATEMENT BUT ! comments NEED TO THINK IT IS
        continue;
      }
      // I believe it should also keep skipping until a non-space character but that's pathological
      // and I'm not going to implement that unless I have to.
      // store a newline (for phrase S) under B_NL

      // Finally a nasty one, should never have been allowed...
      // %OWNBYTEINTEGERARRAY char(0:133) = ;
      if ((c_nextfree > 1) && (c(c_nextfree-2).t == B_char) && strcmp(String(c_nextfree-2), "=")==0) {
        if ((c_nextfree > 0) && (c(c_nextfree-1).t == B_char) && strcmp(String(c_nextfree-1), ";")==0) {
          c_nextfree -= 1;
          // Remove the ; but leave it in the whitespace.  This is sneaky:
          whitespace_lineno =  c(c_nextfree).lineno_sp;
          whitespace_col = c(c_nextfree).col_sp;
          whitespace_pos = c(c_nextfree).start_sp;
          at_startofstatement = TRUE; // NOT REALLY START OF STATEMENT BUT ! comments NEED TO THINK IT IS
          continue;
        }
      }
      at_startofstatement = TRUE; // allow !-style comment to follow
      storec (ch,
            token_lineno, token_col, token_pos,
            B_NL, curfile);
      in_keyword = FALSE; // should already be false
      continue;
    }

    // store the character under B_char
    if (ch == '\n') fprintf(stderr, "******* THIS COULD NOT POSSIBLY EVER HAPPEN!\n");
    if (!isprint(ch)) {
      fprintf(stderr, "? Warning: stray character %d in program\n", ch);
      continue; // treat it as white space.
    }
    storec (ch,
            token_lineno, token_col/*-1*/, token_pos,
            B_char, curfile);
    if (ch == ';') { // not in quote or comment so must be end of statement.
      at_startofstatement = TRUE; // allow !-style comment to follow
    }
    continue;
    
  }
  // set up a dummy at the end because we sometimes look ahead by 1
  // in the parsing code and don't want to hit uninitialised data.
  //fprintf(stderr, "Setting EOF at c_nextfree=%d {tokens}  (source_length=%d {chars}) &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&\n", c_nextfree, source_length);
  c(c_nextfree).sIndex = str_to_pool("<EOF>");
  c(c_nextfree).t = B_EOF;

  c(c_nextfree).lineno_sp = whitespace_lineno;
  c(c_nextfree).col_sp = whitespace_col;
  c(c_nextfree).start_sp = whitespace_pos;

  c(c_nextfree).lineno_tok = nextch_lineno;
  c(c_nextfree).col_tok = nextch_col;
  c(c_nextfree).start_tok = nextch_pos;

  c(c_nextfree).end_tok = nextch_pos;
  c_nextfree++;
  
  // NOTE: we are not yet handling include files...
  // token will still be on the heap at exit.
  if (debug_tokens || debug_line_reconstruction) {
    int i;
    fprintf (stderr, "\nLexical token stream:\n\n");
    for (i = 0; i < c_nextfree; i++) {
      fprintf (stderr, "C[%d].f=\"%s\", .lineno=%d, .col=%d, .type=%0d, .s=\"%s\" (at %p)\n",
                       i, c(i).f, c(i).lineno_tok, c(i).col_tok, c(i).t, escape(String(i),'"'), String(i));
    }
  }

}

/* Parsing.  (Table driven top-down recursive-descent parser) */

/*  The parser used here is based on a design by Tony Brooker which was
    originally used in Atlas Autocode and the "Compiler Compiler".
    It generates a concrete syntax tree rather than the abstract
    syntax tree more popular in modern compilers.  A later phase
    converts from concrete to abstract.

    Note that the parsing procedure here is just a piece of code
    to walk a pre-built table.  There is nothing in this section
    which reflects the grammar, if that is what you are looking for.
    You'll find the grammar embedded in the 'compile()' procedure
    in the following section.
 */

int cp = 0;                     // code pointer.  Has to be global state.
int ap = 0;                     // Analysis record pointer.

#ifdef UNUSED_FOR_NOW
int push(int val, int *table) {
}

int check(int Aval, int *table) { // quick hack while testing...
  static int seq = 0;
  fprintf(stderr, "******************************** SEQ=%d ******************************* Temporary Hack\n", seq);
  if (seq++ == 0) return FALSE;
  return TRUE;
}
#endif

// Parsing inputs line-reconstructed text from the c[] array rather than reading text directly.
// 'cp' is the pointer to the current position in the c[] array.

char *canonical_rest_of_line(int cp) {
  static char line[32768];
  int ic = 0;
  for (;;) {
    if ((c(cp).t == B_NL) || (c(cp).t == B_EOF)) break;
    if ((c(cp).t == B_sqstring)) line[ic++] = '\'';
    if ((c(cp).t == B_dqstring)) line[ic++] = '"';
    ic += sprintf(&line[ic], "%s", String(cp));
    if ((c(cp).t == B_sqstring)) line[ic++] = '\'';
    if ((c(cp).t == B_dqstring)) line[ic++] = '"';
    cp++;
  }
  line[ic] = '\0';
  if (ic >= 32767) {
    fprintf(stderr, "* Array bounds exceeded - line[] in canonical_rest_of_line\n");
    for (ic = 0; ic < 32767; ic++) fputc(line[ic], stderr);
    fputc('\n', stderr);
    exit(EXIT_FAILURE);
  }
  return line;
}

int parse (int pp, int cpx, int linenox, int depth)   // depth is only for indentation in diags
{
  /* Main parsing procedure.  This is a table-driven parser, with the tables
     being generated from the grammar rules embedded in cexpr.c */
  int saved_cp, saved_ap, i, gp, alts, match, where=0;

  // WARNING: large stack objects in this procedure may cause the program to run out of RAM
  // when given a large source file to compile.  Unfortunately this is not easily detectable
  // like a malloc failure would be, and all we see is a SIGSEGV signal being thrown.
  
#define MAX_DESC 1024
  static char saved_desc[(MAX_DESC*3)/2]; // had better not be on the stack!

  // There is some code in here to handle three styles of parsing; one where whitespace is removed
  // during line reconstruction, and another where it is parsed explicity - with a third option
  // being that <sp> phrases are inserted automatically by the 'takeon' program before each
  // token.  (<sp> being a rule to skip spaces)  The choice of method depends entirely on
  // the language being parsed and whether there are places where spaces are not allowed between
  // specific tokens - for instance a label "fred:" which is an identifier followed by ':' with
  // no spaces allowed between them.
  
  if (pp == WHITESPACE) {
    int optional = pp&OPTIONAL_PHRASE, negated = pp&NEGATED_PHRASE;
    fprintf(stderr, "Should never get here. Trying to parse <%ssp> as an actual phrase rule.\n",
            optional?"?":negated?"!":"");
    exit(1);
  }

  if (pp & (OPTIONAL_PHRASE|NEGATED_PHRASE)) {
    int optional = pp&OPTIONAL_PHRASE, negated = pp&NEGATED_PHRASE;
    fprintf(stderr, "Should never get here. Trying to parse <%s%s> as an actual phrase rule.\n",
            optional?"?":negated?"!":"", phrasename((pp&DROP_SPECIAL_BITS) - PHRASES_START));
    exit(4);
  }
  
  makespace (parse_stack, depth+1);
  parse_stack(depth) = phrasename(pp - PHRASES_START);
  
  /* Initialisation */
  gp = phrase_start(pp - PHRASES_START - MAX_BIP);
  alts = gram(gp);

  /* Debugging */
  if (debug_parser) {
    int optional = pp&OPTIONAL_PHRASE, negated = pp&NEGATED_PHRASE;
    fprintf (stderr, "\n%-*sPhrase %s%s/%d (%d alternatives) = ",
             depth*3, " ",
             optional?"?":negated?"!":"", phrasename((pp&DROP_SPECIAL_BITS) - PHRASES_START),
             pp&DROP_SPECIAL_BITS, alts);
    fflush (stderr);
  }
  
  gp++;                         // gp now points to first element (length) of first alt

  saved_cp = cp; // save current input pointer for backtracking if an alt fails
  saved_ap = ap;

  for (i = 0; i < alts; i++) {
    /* Starting with the root phrase, recursively examine each alternative */
    int each, phrases = gram(gp++), phrase_count, gap = 0;

    cp = saved_cp; // backtrack to where input pointer was when we started parsing the previous alt.
    ap = saved_ap;

    if (ap + 3 > next_free_a)
      next_free_a = ap + 3;
    makespace (A, next_free_a+32);

    A(ap++) = pp;               // record which phrase (could be done outside loop)
    A(ap++) = i;                // and which alt.

    // Count slots needed.  *Could* be precalculated and stored
    // in the grammar, either embedded (after the ALT) or as a
    // separate table

    for (each = 0; each < phrases; each++)
      if (((gram(gp + each)&DROP_SPECIAL_BITS) >= PHRASES_START) && ((gram(gp + each)&DROP_SPECIAL_BITS) < SEMANTIC))
        gap++;

    A(ap++) = gap;              // Count of alts (gap)
    // ap+gap now points to the slot after the space required, which
    // is where the first subphrase will be stored.
    ap = ap + gap;              // recursive subphrases are stored after this phrase.
    // ap is left updated if successful.

    // successfully parsed phrases are stored in A(saved_ap+3+n)

    if (saved_ap + 3 + gap > next_free_a)
      next_free_a = saved_ap + 3 + gap;
    makespace (A, next_free_a+32);

    if (debug_parser) {    // this loop is only for diagnostics
      char *saved_descp;

      fprintf (stderr, "\n%-*s", depth*3, " ");
      if (phrases == 0) {
        fprintf (stderr, "Alternative %d: (NULL phrase) ", i + 1);
      } else {
        fprintf (stderr, "Alternative %d: (%d phrases) ", i + 1, phrases);
      }
      saved_descp = saved_desc;
      *saved_descp = '\0';
      for (each = 0; each < phrases; each++) {
        int phrase = gram(gp + each)&DROP_SPECIAL_BITS, negated = gram(gp + each)&NEGATED_PHRASE, optional = gram(gp + each)&OPTIONAL_PHRASE;
        
        if (phrase < 256) {
          saved_descp += sprintf (saved_descp, " '%c'", phrase); // to handle white space, we want to check for it before a *sequence* of chars
        } else if (phrase < PHRASES_START) {
          saved_descp += sprintf (saved_descp, " \"%s\"/%d", keyword(phrase - 256), phrase - 256); // or a string
        } else if (phrase < PHRASES_START+MAX_BIP) {
          saved_descp += sprintf (saved_descp, " {%s/BIP%d}", phrasename(phrase - PHRASES_START), BIP(phrase - PHRASES_START)); // or a BIP
        } else if ((phrase) < SEMANTIC) {
          saved_descp += sprintf (saved_descp, " <%s%s/%d>", optional?"?":negated?"!":"", phrase==WHITESPACE ? "sp" : phrasename(phrase - PHRASES_START), phrase);
        } else {
          // SEMANTIC PHRASE
          saved_descp += sprintf (saved_descp, " <%s%s/%d>", optional?"?":negated?"!":"", semantic_code[phrase-SEMANTIC], phrase);
        }
      }
      fprintf (stderr, "%s\n", saved_desc);
      if (strlen(saved_desc) > MAX_DESC) {
        fprintf(stderr, "length of saved_desc is getting excessive.  Recode it to use makespace() (and free())\n");
        exit(3);
      }
      fflush (stderr);
    }

    match = TRUE;               // stays true if all subphrases match
    phrase_count = 0;           // only phrases which make it into the A record,
                                // i.e. excluding literals and keywords
                                // (but does include guards and negated phrases)
    for (each = 0; each < phrases; each++) {
      /* Within a single grammar rule (alternative), ensure that each subphrase is present */
      int phrase = gram(gp + each)&DROP_SPECIAL_BITS, negated = gram(gp + each)&NEGATED_PHRASE, optional = gram(gp + each)&OPTIONAL_PHRASE;

      if (debug_parser) {
#ifdef NEVER
        fprintf (stderr,
                 "%-*sInput token stream = '%s' '%s' '%s' ...\n", depth*3, " ",
                 (cp < c_nextfree ? String(cp) : "EOF"), (cp + 1 < c_nextfree ? String(cp + 1) : "EOF"), (cp + 2 < c_nextfree ? String(cp + 2): "EOF"));
#else
        fprintf (stderr,
                 "%-*sInput token stream = '%s'\n", depth*3, " ", canonical_rest_of_line(cp));
#endif
      }

      if (cp >= bestparse) {
        static char s[256];
        int i;
        makespace (bestparse_stack, depth+2);
        for (i = 0; i <= depth; i++) bestparse_stack(i) = parse_stack(i);
        if (phrase < 256) {
          sprintf (s, "<%s%s> '%c'", optional?"?":negated?"!":"", phrasename(pp - PHRASES_START), phrase);
        } else if (phrase < PHRASES_START) {
          sprintf (s, "<%s%s> \"%s\"", optional?"?":negated?"!":"", phrasename(pp - PHRASES_START), keyword(phrase - 256));
        } else if (phrase < PHRASES_START+MAX_BIP) {
          char *s1 = optional?"?":negated?"!":"";
          char *s2 = phrasename(pp - PHRASES_START);
          char *s3 = phrasename(phrase - PHRASES_START);
          if (strlen(s1)+strlen(s2)+strlen(s3)+6 >= 255) {
            fprintf(stderr, "* String 's' too long in parse()\n");
            exit(EXIT_FAILURE);
          }
          sprintf (s, "<%s%s> {%s}", s1, s2, s3);//   <------------------
        } else if ((phrase) < SEMANTIC) {
          sprintf (s, "<%s%s> <%s>", optional?"?":negated?"!":"", phrasename(pp - PHRASES_START), phrase==WHITESPACE ? "sp" : phrasename(phrase - PHRASES_START));
        } else {
          // SEMANTIC PHRASE
          sprintf (s, "<%s%s> {%s}", optional?"?":negated?"!":"", phrasename(pp - PHRASES_START), semantic_code[phrase-SEMANTIC]);
        }

        if (strlen(s) >= 255) {
          fprintf(stderr, "* String 's' too long in parse()\n");
          exit(EXIT_FAILURE);
        }
        
        strcpy(looking_for, s);
        bestparse = cp;
        bestparse_depth = depth;
#undef s
      }

      if (debug_parser)
        indent (depth, stderr);

      if (phrase < 256) {
        where = ap;               // next phrase to be parsed will be stored at current 'ap'.
        /* Literal */

        if (debug_parser)
          fprintf (stderr, "'%c'", phrase);

        if ((c(cp).t != B_char) || (*String(cp) != phrase)) {
          match = FALSE;
        } else {
          // an earlier version did not enter literals into the A record.
          A(ap++) = phrase;
          A(ap++) = 1;
          A(ap++) = 1;
          A(ap++) = cp++;
          A(saved_ap + 3 + phrase_count++) = where;     // Record literal
        }
      } else if (phrase < PHRASES_START) {  /* Keyword */
        where = ap;               // next phrase to be parsed will be stored at current 'ap'.

        if (debug_parser)
          fprintf (stderr, "\"%s\"/%d", keyword(phrase - 256), phrase - 256);

#ifdef IMP_PARSER
        // instead of saving whole keywords, the imp line reconstruction has
        // saved the individual characters of keywords as type B_stropped.
        {
          int saved_cp = cp;
          char *key = keyword(phrase - 256);
          match = TRUE;
          while (*key != '\0') {
            //fprintf(stderr, "\nKeyword: %c vs %c @@ %d (t=%d == %d)\n", *key, stringpool[c[cp].sIndex], c[cp].sIndex, c[cp].t, B_stropped);
            if (!((c(cp).t == B_stropped) && (c(cp).sIndex >= 0) && (stringpool(c(cp).sIndex) == *key))) {
              match = FALSE;
              break;
            }
            cp += 1; key += 1;
          }
          if (match) {
            A(ap++) = phrase;
            A(ap++) = 1;
            A(ap++) = 1;
            A(ap++) = saved_cp; // char, not string, so this will need tweaking...
            A(saved_ap + 3 + phrase_count++) = where;     // Record keyword
          } else {
            cp = saved_cp;
          }
        }
#else  
        if ((c(cp).sIndex == -1) || (strcmp (keyword(phrase - 256), String(cp)) != 0)) {
          //^^^^^^^^^^^^^^^^^^
          // loses something in the translation... check...
          match = FALSE;
        } else {
          // an earlier version did not enter keywords into the A record.
          A(ap++) = phrase;
          A(ap++) = 1;
          A(ap++) = 1;
          A(ap++) = cp++;
          A(saved_ap + 3 + phrase_count++) = where;     // Record keyword
        }
#endif
      } else if (phrase < (PHRASES_START+MAX_BIP)) {  /* Built-in phrase */
        where = ap;               // next phrase to be parsed will be stored at current 'ap'.

        if (debug_parser)
          fprintf (stderr, "{%s/BIP%d}", phrasename(phrase - PHRASES_START), BIP(phrase - PHRASES_START));

        if (c(cp).t != BIP(phrase - PHRASES_START)) {
          match = FALSE;
        } else {
          A(ap++) = phrase;
          A(ap++) = 1;
          A(ap++) = 1;
          A(ap++) = cp++;
          A(saved_ap + 3 + phrase_count++) = where;     // Record BIP
        }
      } else if (phrase==WHITESPACE) {
        if (debug_parser) {
          fprintf (stderr, "Skip whitespace");
        }
        while ((c(cp).t == B_char) && (String(cp) != NULL) && (*String(cp) == ' ')) {
          //                                                   ^^^^^^^^^^^^^^^^^^^   CHECK.  Also, tabs??? folded during line reconstruction???
          cp += 1;
          if (debug_parser) {
            fprintf (stderr, ".");
          }
        }
        match = TRUE;
      } else if (phrase < SEMANTIC) {
        /* Recursive call to parser for a subphrase */
        int here = cp; // we don't advance cp if an optional alt.
        where = ap;               // next phrase to be parsed will be stored at current 'ap'.

        if (debug_parser) {
          fprintf (stderr, "Try next alt: <%s%s/%d>", optional?"?":negated?"!":"", phrasename(phrase - PHRASES_START), phrase);
        }

        // for now we only apply ? or ! to full P<phrases> ... in principle keywords and BIPs could also
        // take ? or !, but if we add that, need to find *all* the places the change would affect.
        match = parse (phrase, cp, c(cp).lineno_sp, depth + 1); // options have been removed from recursive call. COULD USE 'match' HERE! <--------------------------
        if (negated) match = !match;
        if (match) {
          if (debug_parser) {
            indent(depth, stderr);
            fprintf (stderr, "Alt <%s%s/%d> succeeded", optional?"?":negated?"!":"", phrasename(phrase - PHRASES_START), phrase);
          }
          if (negated) { // there was no subparse data
            ap = where; // backtrack over anything that might have been added by negated phrase
            // let's create a dummy analysis record entry for the unsuccessful parse
            A(ap++) = phrase|negated;
            A(ap++) = 0; // selected alternative - there was none
            A(ap++) = 0; // number of terms in successful alternative
        //  A(ap++) = 0; // this is usually cp++ for the matched text. There can be no matched text so pointer is meaningless.
                         // but should the slot be filled in with a dummy anyway, just to make things appear at compatible offsets?
            A(saved_ap + 3 + phrase_count++) = where;     // Record BIP   (not sure if phrase_count is correct here?)
          } else {
            if (optional) A(where) |= OPTIONAL_PHRASE;
            // should there be an assignment here of phrase/altno/#terms/cp ???
            A(saved_ap + 3 + phrase_count++) = where; // we want the result even if it is a guard phrase.
          }
          if (negated || optional) cp = here; // don't advance text pointer for guard phrase.  However we do store the parse data.
          match = TRUE;
        } else {
          if (debug_parser) {
            indent(depth, stderr);
            fprintf (stderr, "Alt <%s%s/%d> failed", optional?"?":negated?"!":"", phrasename(phrase - PHRASES_START), phrase);
          }
          match = FALSE;
        }

      } else {
        // SEMANTIC PHRASE
        // we don't store anything for a successful parse, we just use it to accept or reject an alternative
        if (semantic(phrase-SEMANTIC)) {
          if (debug_parser) {
            indent(depth, stderr);
            fprintf (stderr, "Alt <%d:%s> succeeded", phrase, semantic_code[phrase-SEMANTIC]);
          }
          match = TRUE;
        } else {
          if (debug_parser) {
            indent(depth, stderr);
            fprintf (stderr, "Alt <%d:%s> failed", phrase, semantic_code[phrase-SEMANTIC]);
          }
          match = FALSE;
        }
      }

      if (debug_parser) {
        fprintf (stderr, "\n");
        indent (depth, stderr);
        fprintf (stderr, "Tried phrase %d of %s - result was %s\n", each + 1, saved_desc, (match ? "TRUE" : "FALSE"));
        fflush (stderr);
      }

      if (!match)
        break;

    }
    gp += phrases;              // move over all phrases, to next alt

    if (match)
      break;
    else if (debug_parser) {
      indent (depth, stderr);
      fprintf (stderr, "** Alternative %d FAILED.\n", i + 1);
    }
    // gp now points to first element (length) of next alt, or start of next phrase

  }

  return (match);

}

int build_ast_inner(int ap, int depth, int caller)
{
#define build_ast(ap, depth) build_ast_inner(ap, depth, __LINE__)
  int T[100];

  int saved_ap;
  int phrase;  // A(ap) is the phrase number. A(ap+1) is the alt.
  int alt;     // For consistency, in BIPs, the Alt should always be 1
               // although that may not be the case at the moment :-(
  int phrases; // defined subphrases

  saved_ap = ap;
  phrase = A(ap++) & DROP_SPECIAL_BITS;
  alt = A(ap++);
  phrases = A(ap++);

  if ((phrase < PHRASES_START) || (phrase > MAX_PHRASE+PHRASES_START)) {
    fprintf(stderr, "* Internal error: build_ast(%d) called from line %d - phrase = %d\n",
            ap, caller, phrase);
    //exit(1);
    saved_ap = saved_ap/0; // force backtrace
  }
  
  switch (phrase) {

#include INCLUDE
  default:
    fprintf(stderr, "*** UNHANDLED GRAMMAR PHRASE %d\n", phrase);
    exit(EXIT_FAILURE);
  }
}

void print_astop_name(int astp) {
  int i, spare, astop, alt, count, data0, data1, optional, negated;

  if (astp < 0) {
    return; // -phrase denotes an optional item we don't want to print when reconstituting the source
            // Not an idea mechanism. May change it later to add optional bits to 'op' field.
  }
  spare = AST(astp);
  astop = AST(astp+1)&DROP_SPECIAL_BITS;
  optional = AST(astp+1)&OPTIONAL_PHRASE;
  negated = AST(astp+1)&NEGATED_PHRASE;
  alt = AST(astp+2);
  count = AST(astp+3);
  data0 = AST(astp+4);
  data1 = AST(astp+5);
  
  if (astop < MAX_BIP) {
    switch (astop) {
#ifdef C_PARSER
    case B_char: // 0
      if (data0) fprintf(stderr, "'%c' ", data0); else fprintf(stderr, "'\\0' ");
      break;
    case B_internal_identifier: // 1
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>PHRASES_START?phrasename(astop-PHRASES_START):phrasename(astop));
      fprintf(stderr, "%s> ", String(data0));
      break;
    case B_integer_constant: // 2
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>PHRASES_START?phrasename(astop-PHRASES_START):phrasename(astop));
      fprintf(stderr, "%s> ", String(data0));
      break;
    case B_character_constant: // 3
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>PHRASES_START?phrasename(astop-PHRASES_START):phrasename(astop));
      fprintf(stderr, "'%s'> ", String(data0));
      break;
    case B_floating_constant: // 4
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>PHRASES_START?phrasename(astop-PHRASES_START):phrasename(astop));
      fprintf(stderr, "%s> ", String(data0));
      break;
    case B_string: // 5
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>PHRASES_START?phrasename(astop-PHRASES_START):phrasename(astop));
      fprintf(stderr, "\"%s\"> ", String(data0));
      break;
    case B_keyword: // 6
      fprintf(stderr, "\"%s\" ", keyword(data0));
      break;
    case B_pp: // 7
      fprintf(stderr, " ++ ");
      break;
    case B_mm: // 8
      fprintf(stderr, " -- ");
      break;
    case B_andand: // 9
      fprintf(stderr, " && ");
      break;
    case B_oror: // 10
      fprintf(stderr, " || ");
      break;
    case B_eqeq: // 11
      fprintf(stderr, " == ");
      break;
    case B_EOF: // 12
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>PHRASES_START?phrasename(astop-PHRASES_START):phrasename(astop));
      fprintf(stderr, "EOF> ");
      return;
      break;
#endif
    default:
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>PHRASES_START?phrasename(astop-PHRASES_START):phrasename(astop));
      fprintf(stderr, "%d> ", astop);
    }
  } else {
    if (astop == AST__LIT) {
      fprintf(stderr, " <Literal> ");
    } else if (astop == AST__KW) {
      fprintf(stderr, " <Keyword> ");
    } else if (astop-PHRASES_START > MAX_PHRASE) {
      fprintf(stderr, " <PHRASE %d> ", astop-PHRASES_START); // I don't think it shouldever get here ...
    } else if (astop > MAX_PHRASE) {
      fprintf(stderr, " <Phrase %d> ", astop);               // or here ...
    } else {
      fprintf(stderr, " <%s%s> ", optional?"?":negated?"!":"", astop>PHRASES_START?phrasename(astop-PHRASES_START):phrasename(astop));
    }
  }
}

void print_terminal(int astp) {
  int i, spare, astop, alt, count, data0, data1;

  if (astp < 0) {
    return; // -phrase denotes an optional item we don't want to print when reconstituting the source
  }
  
  spare = AST(astp);
  astop = AST(astp+1);  // &DROP_SPECIAL_BITS???
  alt = AST(astp+2);
  count = AST(astp+3);
  data0 = AST(astp+4);
  data1 = AST(astp+5);
  
  if (astop < MAX_BIP) {
    switch (astop) {
#ifdef C_PARSER
    case B_char: // 0
      // this is for printing the source again.
      // unfortunately nested literal arrays not formatted very well by gnu indent :-/
      if ((data0 == '{') || (data0 == '}')) fprintf(stdout, "\n");
      fprintf(stdout, "%c", data0);
      if (data0 == '=' || data0 == '-' || data0 == '+' || data0 == '|' || data0 == '&' || data0 == '<' || data0 == '>') fprintf(stdout, " ");
      if ((data0 == ';') || (data0 == '{') || (data0 == '}')) fprintf(stdout, "\n");
      break;
    case B_internal_identifier: // 1
      fprintf(stdout, " %s ", String(data0));
      break;
    case B_integer_constant: // 2
      fprintf(stdout, " %s ", String(data0));
      break;
    case B_character_constant: // 3
      fprintf(stdout, "'%s'", escape(String(data0), '\'')); // \\ in input needs special handling.
                                                          // might be better one day to store as escaped string, not underlying byte
      break;
    case B_floating_constant: // 4
      fprintf(stdout, " %s ", String(data0));
      break;
    case B_string: // 5
      fprintf(stdout, "\"%s\"", escape(String(data0), '"'));
      break;
    case B_keyword: // 6
      fprintf(stdout, " %s ", keyword(data0));
      break;
    case B_pp: // 7
      fprintf(stdout, " ++ ");
      break;
    case B_mm: // 8
      fprintf(stdout, " -- ");
      break;
    case B_andand: // 9
      fprintf(stdout, " && ");
      break;
    case B_oror: // 10
      fprintf(stdout, " || ");
      break;
    case B_eqeq: // 11
      fprintf(stdout, " == ");
      break;
    case B_EOF: // 12
      return;
#endif
    case B_stropped:
      fprintf(stdout, "/* print keyword %d */ ", astop);
      break;
    default:
      fprintf(stdout, "/* print terminal %d */ ", astop);
    }
  }
}

static void RECONSTITUTE(int idx, FILE *out) {
  int i;
  for (i = c(idx).start_sp; i < c(idx).end_tok; i++) fputc(source_address(i), out);
  fflush(out);
}

void print_terminal_with_whitespace(int astp, FILE *out) {
  int i, astop, alt, count, data0, data1, spare;

  if (astp < 0) {
    return; // -phrase denotes an optional item we don't want to print when reconstituting the source
  }
  
  spare = AST(astp);
  astop = AST(astp+1);  // &DROP_SPECIAL_BITS???
  alt = AST(astp+2);
  count = AST(astp+3);
  data0 = AST(astp+4);
  data1 = AST(astp+5);

  // String(i) is  &stringpool[c(i).sIndex]
  
  if (astop < MAX_BIP) {
    switch (astop) {
#ifdef C_PARSER
    case B_char: // 0
      // this is for printing the source again.
      // unfortunately nested literal arrays not formatted very well by gnu indent :-/

      {int cp;
      // data1 should be a pointer into A
      cp = A[data1+3];
      RECONSTITUTE(cp, out);
      }
      //fprintf(stdout, "%c", data0);

      break;
    case B_internal_identifier: // 1
      RECONSTITUTE(data0, out);
      break;
    case B_integer_constant: // 2
      RECONSTITUTE(data0, out);
      break;
    case B_character_constant: // 3
      RECONSTITUTE(data0, out);
      //fprintf(stdout, "'%s'", escape(String(data0), '\'')); // \\ in input needs special handling.
                                                          // might be better one day to store as escaped string, not underlying byte
      break;
    case B_floating_constant: // 4
      RECONSTITUTE(data0, out);
      break;
    case B_string: // 5
      RECONSTITUTE(data0, out);
      //fprintf(stdout, "\"%s\"", escape(String(data0), '"'));
      break;
    case B_keyword: // 6
      {int cp;
      // data1 should be a pointer into A
      cp = A(data1+3);
      RECONSTITUTE(cp, out);
      }
      break;
    case B_pp: // 7
      {int cp;
      // data1 should be a pointer into A
      cp = A[data1+3];
      RECONSTITUTE(cp, out);
      }
      //fprintf(stdout, "++");
      break;
    case B_mm: // 8
      {int cp;
      // data1 should be a pointer into A
      cp = A[data1+3];
      RECONSTITUTE(cp, out);
      }
      //fprintf(stdout, "--");
      break;
    case B_andand: // 9
      {int cp;
      // data1 should be a pointer into A
      cp = A[data1+3];
      RECONSTITUTE(cp, out);
      }
      //fprintf(stdout, "&&");
      break;
    case B_oror: // 10
      {int cp;
      // data1 should be a pointer into A
      cp = A[data1+3];
      RECONSTITUTE(cp, out);
      }
      //fprintf(stdout, "||");
      break;
    case B_eqeq: // 11
      {int cp;
      // data1 should be a pointer into A
      cp = A[data1+3];
      RECONSTITUTE(cp, out);
      }
      //fprintf(stdout, "==");
      break;
    case B_EOF: // 12
      return;
#endif
    case B_stropped:
      fprintf(out, "/* print keyword with whitespace: %d %d %d */\n", astop, data0, A[data1+3]);
      break;
    default:
      if (astop != 0) fprintf(out, "%s", String(A[data1+3]));
      else fprintf(out, "/* print terminal with whitespace: %d %d %d */\n", astop, data0, A[data1+3]);
    }
  }
}

// NOTE: a variation of the code below could output graphviz/dot format for
// printing parse trees graphically...
void print_ast(int astp, int depth) {
  // Although currently the AST looks a lot like the AREC, this will not always be
  // the case, as the AST is simplified...
  int i, astop, alt, count, subphrase;
  // p is the return from mktuple() for proper phrases.

  if (astp < 0) {
    return; // -phrase denotes an optional item we don't want to print when reconstituting the source
            // Not an idea mechanism. May change it later to add optional bits to 'op' field.
  }

  astop  = AST(astp+1);
  if (astop < MAX_BIP) {
    print_astop_name(astp);
    fprintf(stderr, "\n");
    return;
  }
  alt = AST(astp+2);
  count = AST(astp+3);
  indent(depth, stderr);
  print_astop_name(astp);
  fprintf(stderr, " ::= ");
  for (i = astp+4; i < astp+4+count; i++) {
    if (i >= astp+4) print_astop_name(AST(i));
  }
  fprintf(stderr, ";\n");
  for (i = astp+4; i < astp+4+count; i++) {
    if ((AST(i)>=0) && (AST(AST(i)+1)>=MAX_BIP)) {
      if ((AST(AST(i)+1) != AST__KW) && (AST(AST(i)+1) != AST__LIT)) print_ast(AST(i), depth+1);  // MAX_BIP? Not PHRASES_START+MAX_BIP?  CHECK!!!
    }
  }
}

void dump_concrete_tree(int p, int depth) {
  int i, phrase, alt, phrases, negated, optional;

  static int hack = 0;
  hack++;
  if (((hack > 1) && (p == 0)) || (p == -1)) {
    fprintf(stderr, "!!!!!!!!!!! Hack was needed :-(\n");
    exit(5);
    return;
  }

  i = p;
  phrase = A(p)&DROP_SPECIAL_BITS;
  alt = A(p+1);
  phrases = A(p+2);
  negated = A(p)&NEGATED_PHRASE;
  optional = A(p)&OPTIONAL_PHRASE;

/* A() is the Analysis record.
     Contents point to a C[] structure when the item is a BIP,
     otherwise the format is [phraseno] [altno] [no-of-subphrases] [subphrases and/or BIPs...]
     for example, if A(25) contained 10, that would mean that the
     token for A(25) was stored in C[10].]
     (And the C string would be at &stringpool[c(A(25))]?)

          A(ap++) = phrase;
          A(ap++) = 1; // altno
          A(ap++) = 1; // #subphrases
          A(ap++) = cp++;
          A(saved_ap + 3 + phrase_count++) = where;     // Record BIP

   */

  if (phrase < 256) {
    indent(depth, stderr);
    fprintf(stderr, "A(%d)=%d char '%s'\n", i, A(i), String(A(i+3)));
  } else if (phrase < PHRASES_START) {
    indent(depth, stderr);
    fprintf(stderr, "A(%d)=%d keyword \"%s\"\n", i, A(i), keyword[A(i)-256]);
  } else if (phrase < PHRASES_START+MAX_BIP) {
    indent(depth, stderr);
    fprintf(stderr, "A(%d)=%d B<%s%s>, ", i, A(i), optional?"?":negated?"!":"", phrasename(A(i)-PHRASES_START));
    if (phrases) {
      fprintf(stderr, "choice %d: '%s'\n", A(i+1), escape(String(A(i+3)), '\''));
    } else {
      fprintf(stderr, "Null\n");
    }
  } else if (phrase < SEMANTIC) {
    indent(depth, stderr);
    fprintf(stderr, "A(%d)=%d P<%s%s>, ", i, phrase, optional?"?":negated?"!":"", phrase==WHITESPACE ? "sp" : phrasename(phrase-PHRASES_START));
    if (phrases) {
      fprintf(stderr, "choice %d: ", A(i+1));
      for (p = i+3; p < i+3+phrases; p++) {
        int xphrase = A(p)&DROP_SPECIAL_BITS;
        fprintf(stderr, "A(%d)=%d ", p, A(p));
        //fprintf(stderr, "A(%d)=%d [%d: %s%s] ", p, A(p), phrase, optional?"?":negated?"!":"", xphrase==WHITESPACE ? "sp" : phrasename(xphrase-PHRASES_START));
      }
      fprintf(stderr, "\n");
      for (p = i+3; p < i+3+phrases; p++) {
        if (A(p) == -1) {
          fprintf(stderr, "/* NOTBUG 0 */");
        } else if (A(p) == P_SS) {
          fprintf(stderr, "/* BUG 1 */");
        } else {
          // do something here with special bits
          if (A(p)&OPTIONAL_PHRASE) fprintf(stderr, "/* BUG 2 */");
          if (A(p)&NEGATED_PHRASE) fprintf(stderr, "/* BUG 3 */");
          if (negated == 0) {
            dump_concrete_tree(A(p)&DROP_SPECIAL_BITS, depth+1);
          }
        }
      }
    } else {
      fprintf(stderr, "Null\n");
    }
  } else {
    // SEMANTIC PHRASE
  }
}

void dump_source_from_concrete_tree(int p, int depth) {
  int i, phrase, alt, phrases, negated, optional;

  i = p;
  phrase = A(p)&DROP_SPECIAL_BITS;
  alt = A(p+1);
  phrases = A(p+2);
  negated = A(p)&NEGATED_PHRASE;
  optional = A(p)&OPTIONAL_PHRASE;

  if (phrase < 256) {
    if (negated == 0 && optional == 0) RECONSTITUTE(A(i+3), stderr); // fprintf(stderr, "'%s'", String(A(i+3)));
  } else if (phrase < PHRASES_START) {
    if (negated == 0 && optional == 0) {/*RECONSTITUTE(A(i+3), stderr);*/ fprintf(stderr, "%%%s", keyword[A(i)-256]);} // Temp...
  } else if (phrase < PHRASES_START+MAX_BIP) {
    if (negated == 0 && optional == 0) RECONSTITUTE(A(i+3), stderr); // fprintf(stderr, "[%s]", String(A(i+3)));
  } else if (phrase < SEMANTIC) {
    if (phrases) {
      for (p = i+3; p < i+3+phrases; p++) {
        if (A(p) == -1) {
        } else if (A(p) == P_SS) {
        } else if (negated == 0 && optional == 0) {
          dump_source_from_concrete_tree(A(p)&DROP_SPECIAL_BITS, depth+1);
        }
      }
    }
  }
}

// Current version of compile just regurgitates the source file.
// You could however output a translated version of the program
// here, in a different language.  Or clean up the indentation
// in the style of SOAP...  Or actually generate code.

// The ast-building code that is created by default as a template
// using update_astcode just creates an AST that looks exceedingly
// like the concrete syntax tree in A[]... however the expectation
// is that for any real application, the Abstract Syntax Tree will
// be a simplification of the actual parse tree in a form that
// is more useful to compiler writers...

void compile(int astp) {
  int i;
  int astop = AST[astp+1];
  int alt = AST[astp+2];
  int count = AST[astp+3];
  int *arg = &AST[astp+4];

  if (astp < 0) {
    return; // -phrase denotes an optional item we don't want to print when reconstituting the source
            // Not an idea mechanism. May change it later to add optional bits to 'op' field.
  }
  
  switch (astop) {
  case AST_stropped:
  case AST_char:
  case AST_sqstring:
  case AST_dqstring:
  case AST_NL:
  case AST_digit:
  case AST__LIT:
  case AST_alphanumeric:
    RECONSTITUTE(A[arg[1]+3], stdout);
    break;
  case AST__KW:
    //fprintf(stdout, "AST__KW (%d) kw=%d cidx=%d len=%d ", count, arg[0], arg[1], arg[2]);
    for (i = arg[1]; i < arg[1]+arg[2]; i++) {
      //fprintf(stdout, "%s", String(i));
      RECONSTITUTE(i, stdout);
    }
  case AST_EOF:
    break;

  default:
    for (i = 1; i <= count; i++) compile(AST[astp+3+i]);
  }
}

int main (int argc, char **argv) {
  int errors, lines;
  int program;
  char *s;
  int SS;
  
  /* Get clean version of executable name.  Should work on most existing systems (2006) */
  progname = strdup (argv[0]);
  if ((s = strrchr (progname, '/')) != NULL)  progname = s + 1;           // Unix
  if ((s = strrchr (progname, '\\')) != NULL) progname = s + 1;           // M$
  if ((s = strrchr (progname, ']')) != NULL)  progname = s + 1;           // Dec
  if ((s = strrchr (progname, ';')) != NULL)  *s = '\0';                  // Version no's
  if (((s = strrchr (progname, '.')) != NULL) && (strcasecmp (s, ".exe") == 0)) *s = '\0';
  if (((s = strrchr (progname, '.')) != NULL) && (strcasecmp (s, ".com") == 0)) *s = '\0';

  /* Handle program arguments */

  while ((argc >= 2) && (strcmp(argv[1], "-d") == 0)) {
      argc -= 1; argv += 1; // shift
      if ((argc > 2) && (argv[1][0] != '-')) {
        char *debug_type = argv[1];
        argc -= 1; argv += 1; // shift
        if (strcmp(debug_type, "parser") == 0) {
          debug_parser=TRUE;
        } else if (strcmp(debug_type, "flex") == 0) {
          debug_flex=TRUE;
        } else if (strcmp(debug_type, "ast") == 0) {
          debug_ast=TRUE;
        } else if (strcmp(debug_type, "arec") == 0) {
          debug_arec=TRUE;
        } else if (strcmp(debug_type, "tokens") == 0) {
          debug_tokens=TRUE;
        } else if (strcmp(debug_type, "line") == 0) {
          debug_line_reconstruction=TRUE;
        } else {
          fprintf(stderr, "%s: debug option '%s' not recognised\n", progname, debug_type);
          fprintf(stderr, "        currently supported -d types are: flex ast arec tokens line\n");
          exit(1);
        }
      } else {
          // plain -d gets everything.  May add a '-d all' later.
          debug_parser = TRUE;
          debug_flex=TRUE;
          debug_ast=TRUE;
          debug_arec=TRUE;
          debug_tokens=TRUE;
          debug_line_reconstruction=TRUE;
      }
  }

  // should I add a -l for listing file?
  if (argc != 2) {
    fprintf (stderr, "syntax: %s [-d {type}] filename\n", progname);
    exit (1);
  }

  if ((sourcefile = fopen (argv[1], "r")) == NULL) {
    fprintf (stderr, "%s: %s - %s\n", progname, strerror (errno), argv[1]);
    exit (errno);
  }
  fclose(sourcefile);
  
  stringpool = NULL;
  stringpool_arraysize = 0;
  stringpool_nextfree = 0;

  AST = NULL;
  AST_arraysize = 0;
  AST_nextfree = 0;

  parse_stack = NULL;
  parse_stack_arraysize = 0;

  bestparse_stack = NULL;
  bestparse_stack_arraysize = 0;
  
  curfile = argv[1];
  startline = TRUE;

  memory_map_file(argv[1]); find_lines();
  
  nextch_pos = 0;
  line_reconstruction (sourcefile, argv[1]);       // Effectively, lexing.

  /* Call the parser */

  errors = 0;
  //for (;;) {   // Use this loop if we are only parsing a basic statement at a time. Don't, if you want to parse the entire file.

  //if (cp == c_nextfree) break; // End of file?
  ap = 0; // reset analysis record on each line. We're not parsing the entire program here.

  if ((SS = parse (P_SS, 0, 1, 0)) != 0) {
    int i;

    if (debug_arec) {
      fflush(stderr); fflush(stdout);
      fprintf(stderr, "A-record (flat): ap = %d\n", ap&DROP_SPECIAL_BITS);
      i = 0;
      while (i < (ap&DROP_SPECIAL_BITS)) {
        int p, phrase = A(i)&DROP_SPECIAL_BITS, phrases = A(i+2), negated = A(i)&NEGATED_PHRASE, optional = A(i)&OPTIONAL_PHRASE;

        if (phrase < 256) {
          fprintf(stderr, "A(%3d)=%3d char '%s'\n", i, A(i), String(A(i+3)));
          i = i + 3 + phrases;
        } else if (phrase < PHRASES_START) {
          fprintf(stderr, "A(%3d)=%3d keyword \"%s\"\n", i, A(i), keyword[A(i)-256] /*String(A(i+3))*/);
          i = i + 3 + phrases;
        } else if (phrase < PHRASES_START+MAX_BIP) {
          fprintf(stderr, "A(%3d)=%3d B<%s%s>, ", i, A(i), optional?"?":negated?"!":"", phrasename(A(i)-PHRASES_START));
          if (phrases) {
            fprintf(stderr, "choice %d: '%s'\n", A(i+1), escape(String(A(i+3)), '\''));
          } else {
            fprintf(stderr, "Null\n");
          }
          i = i + 3 + phrases;
        } else if (phrase < SEMANTIC) {
          fprintf(stderr, "A(%3d)=%3d P<%s%s>, ", i, phrase, optional?"?":negated?"!":"", phrase==WHITESPACE ? "sp" : phrasename(phrase-PHRASES_START));
          if (phrases) {
            fprintf(stderr, "choice %d: ", A(i+1));
            //fprintf(stderr, "A(%d)=Phrases %d ", i+2, phrases);
            for (p = i+3; p < i+3+phrases; p++) fprintf(stderr, "A(%d)=%d ", p, A(p));
            fprintf(stderr, "\n");
          } else {
            fprintf(stderr, "Null\n");
          }
          i = i + 3 + phrases;
        } else {
          // SEMANTIC PHRASE
          fprintf(stderr, "@@@@@@ i=%d A(i)=%d @@@@@@\n", i, A(i));
        }
      }
      fflush(stderr); fflush(stdout);

      fprintf(stderr, "Concrete tree:\n");
      dump_concrete_tree(0, 0);
      fprintf(stderr, "\n\n");
      fprintf(stderr, "Source from Concrete tree:\n");
      dump_source_from_concrete_tree(0, 0);
      RECONSTITUTE(c_nextfree, stderr);
      fflush(stderr); fflush(stdout);
    }

    if ( debug_ast) {
      fprintf(stderr, "Build ast:\n");
    }
    
    program = build_ast(/*SS*/0, 0);

    // At this point the A[] array could be freed and the space reclaimed for use in compiling from the AST
    // As long as the flex bounds were adjusted accordingly it would be safe.
    
    if (debug_ast) {
      fprintf(stderr, "\n\n");
      fflush(stderr); fflush(stdout);

      fprintf(stderr, "Print AST: %d\n", program);
      fflush(stderr); fflush(stdout);
      print_ast(program, 0);
      fprintf(stderr, "\n\n");
      fflush(stderr); fflush(stdout);
    }

  } else {
    errors += 1;
  }

  // } end of for loop, if compiling a statement at a time...
  
  if (errors == 0) {
    fprintf(stderr, "%d Lines compiled.\n", source_lines-1); // Line numbering starts at 1.
    // now do something with it :-)
    compile(program);
  } else {
    /* Attempt to print a sensible error if the parse failed */
    if (bestparse == c_nextfree) {
      fprintf (stderr, "\"%s\", Line %d, Col %d: Premature end of file while looking for %s\n",
               argv[1], c(bestparse).lineno_tok, c(bestparse).col_tok + 1, looking_for);
    } else {
      int i, ic = 0;
      
      // Scan down the file looking for the current line.
      // We could just note the C[] index at the start of each line in the parser,
      // or we could use the array of line starts that I think I added at some point.
      for (i = 0; i < bestparse; i++) {
        if (c(i).lineno_tok == c(bestparse).lineno_tok) break;
      }
      while ((c(i).lineno_tok == c(bestparse).lineno_tok) && (c(i).t != B_NL)) RECONSTITUTE(i++, stderr);

      fputc('\n', stderr);
      for (ic = 0; ic < c(bestparse).col_tok; ic++) fputc(' ', stderr);
      fputc('^', stderr);
      fprintf (stderr, "\n\"%s\", Line %d, Col %d: Syntax error while looking for %s\n",
               c(bestparse).f, c(bestparse).lineno_tok, c(bestparse).col_tok, looking_for);

//#ifdef NEVER // maybe attach this to a debug_? flag.
      makespace (bestparse_stack, bestparse_depth+1);
      for (i = 0; i <= bestparse_depth; i++) {
        if (bestparse_stack(i)) {
          fprintf(stderr, "  %s\n", bestparse_stack(i));
        }
      }
//#endif
    }
    exit (1);
  }
  exit (0);
  return (1);
}
@
