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


1.15
date	2022.02.19.02.49.23;	author gtoal;	state Exp;
branches;
next	1.14;

1.14
date	2022.02.18.19.30.11;	author gtoal;	state Exp;
branches;
next	1.13;

1.13
date	2022.02.17.21.15.56;	author gtoal;	state Exp;
branches;
next	1.12;

1.12
date	2022.02.15.22.28.41;	author gtoal;	state Exp;
branches;
next	1.11;

1.11
date	2022.02.15.03.56.01;	author gtoal;	state Exp;
branches;
next	1.10;

1.10
date	2022.02.15.00.47.36;	author gtoal;	state Exp;
branches;
next	1.9;

1.9
date	2022.02.13.07.49.17;	author gtoal;	state Exp;
branches;
next	1.8;

1.8
date	2022.02.09.20.13.05;	author gtoal;	state Exp;
branches;
next	1.7;

1.7
date	2022.02.08.18.07.40;	author gtoal;	state Exp;
branches;
next	1.6;

1.6
date	2022.02.08.17.22.08;	author gtoal;	state Exp;
branches;
next	1.5;

1.5
date	2022.02.08.02.02.53;	author gtoal;	state Exp;
branches;
next	1.4;

1.4
date	2022.02.07.20.00.08;	author gtoal;	state Exp;
branches;
next	1.3;

1.3
date	2022.02.07.07.20.38;	author gtoal;	state Exp;
branches;
next	1.2;

1.2
date	2022.02.07.07.16.21;	author gtoal;	state Exp;
branches;
next	1.1;

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


desc
@parser
@


1.15
log
@*** empty log message ***
@
text
@#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <errno.h>
#include <stdarg.h>
#include <ctype.h>

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

int debug_phases = FALSE; // short messages to show which high-level step we're on
int debug_ast    = FALSE; // print the AST tree
int debug_errors = FALSE; // extra info for programmer on a syntax error

#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;   // executable of compiler
char *cur_source; // file being compiled

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

#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.

// 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

#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 mktuple(int op, int alt, int count, int T[]);
#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

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) ...

// On error reporting: compilers built with this parser must report the first
// error that occurs, but need not try to report subsequent failures.

// Errors will be reported in a form that Emacs supports so that you can
// compile from within Emacs with a single keystroke, and have emacs immediately
// take you to the line and column of the error.

// 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)

// Note that Imp80 explicitly forbids {} comments within a token (though Imp77 doesn't
// seem to mind) - this may become an issue when/if we move to using regular expressions
// to match source text against grammar rules.

  // 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 that would let us compare strings just with
  // an integer tag comparison, if we ever wanted to.

static void *makespace_ (void *c, int nextfree, int *arraysize, int objsize, char *arrayname) {
#define MINSIZE 1
  
  // *arraysize is the upper bound index of the array, i.e. 1 less than the actual number of elements.  
  if (c == NULL) {
    if ((c = calloc (MINSIZE, objsize)) == NULL) {
      fprintf (stderr, "makespace: calloc(%d, %d)=NULL - %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);
  }

  // we do seem to have a problem where we sometimes realloc the exact same size as it was before!
  
  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)=NULL - %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)

static char *debug_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) {
        stringpool_nextfree += strlen (s) + 1;       /* Not found, add it */
      }
      return tag;               /* found, one way or another */
    }
  }
  /* NOT REACHED */
}

/* C[] is the source character token stream of sourceinfo items*/
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;

#include LEX_H

int ONDEMAND(int x, char *name, int line) {
  // combination of 'makespace' and line_reconstruction!

  if (x < 0) {
    fprintf(stderr, "* Negative array index at line %d: %s[%d]\n", line, name, x);
    exit(4);
  }

  while ((x >= c_nextfree) && ((c_nextfree == 0) || c[c_nextfree-1].t != B_EOF)) {
    if (x >= c_arraysize) {
      fprintf(stderr, "* Array bounds exceeded at line %d: %s[%d] is outside %s[%d] *AND MAKESPACE SHOULD HAVE MADE ROOM ALREADY*\n",
              line, name, x, name, c_arraysize);
      exit(4);
    }
    line_reconstruction(); // SHOULD update c_nextfree ...
    if (x < c_nextfree) break;
  }

  if (x >= c_arraysize) {
    fprintf(stderr, "* Array bounds exceeded at line %d: %s[%d] is outside %s[%d] *AND MAKESPACE SHOULD HAVE MADE ROOM ALREADY*\n",
            line, name, x, name, c_arraysize);
    exit(4);
  }

  return x;
}

#define CFLEX(x,l) c[ONDEMAND(x,"c",l)] // ONDEMAND must *NOT* call Makespace. base of c has already been evaluated.
                                        // Could recode this so that ONDEMAND is outside c[] but will only work on RHS
                                        // Unless we return the (possibly updated) *address* of the c element, and
                                        // have the c() macro perform the indirection.  Which, having spelled it out
                                        // does seem like a rather attractive solution! Would simplify line_reconstruction()
#define c(x) CFLEX(x, __LINE__)

#include "regexp-lexer.c"

/* A() is the Analysis record.
     Contents point to a C[] structure element 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' */
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;
  for (parm = 0; parm < count; parm++) {
    AST(AST_nextfree++) = T[parm+1];
  }

  return trip;
}

int debug_escapech(char *dest, int ch, int quotetype) {
  const char *hexdigit = "0123456789ABCDEF";
  // This is *only* for display in debugging output.
  // Although it may look a bit like C's escapes, it is *not* suitable for use with any specific language.
    /*
      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';  // Note. \xFF, *not* \0xFF !
    *t++ = hexdigit[(ch>>4)&15];
    *t++ = hexdigit[ch&15];
  } else {
    *t++ = ch;
  }
  *t = '\0';
  return t-dest;
}

static char *debug_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 is 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 += debug_escapech(t, *s++, quotetype);
      if (t-escaped >= 510) {
        break; // avoid code duplication
      }
    }
  }
  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), issue an error message
    // for that line, and continue parsing from there after backing up to an appropriate value of 'cp'...
    exit(1);
  }
  return escaped;
}

// THIS DOES *NOT* PARSE A BIP!  It converts a BIP from the A-record to the AST.
// This assumes that the next item in the c[] array is the BIP data and makes it into an AST entry.
// I could have called this mkbip or bip2ast perhaps...
int bip(int B, int aptr)
{
  int data[3];
  data[1] = B;
  data[2] = aptr;
  return mktuple(B, 1, 2, data);
}


int lit(int AST_op, int ch, int ap)
{
  int data[3];
  data[1] =  ch; // actual character
  data[2] =  ap;
  return mktuple(AST_op, 1, 2, data);
}

// User's grammar file has to supply a kw() appropriate to the
// keyword style - whether reserved words or some style of stropping

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

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

// This is not a flex array but it *does* need array bounds checking
// Reason being that eventually the source file may be store-mapped
// rather than loaded using C's I/O.

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

// Creating pointers to each line can help with attaching error messages
// to the source, especially if the error is discovered in the AST after
// the whole program has been parsed.
static int *source_line;
static int source_line_arraysize = 0;
#define source_line(x) FLEX(source_line, x, __LINE__)
static int source_lines = 0;

void find_lines(void) {
  int line = 0;
  int i, p = 0;
  int lastch = '\n';

  if (debug_phases) fprintf(stderr, "Locate line starts:\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;
}

// sets globals 'source_address', 'source_length', 'source_lines' and pointer array 'source_line[]'
void memory_map_file(char *filename) {
  // for now, just read the file in.
  // However option remains to connect the file in virtual memory...
  FILE *f = fopen(filename, "rb");
  int i;
  long length;
  char *buffer;
  if (debug_phases) fprintf(stderr, "Load source:\n");

  i = fseek(f, 0L, SEEK_END);
  length = ftell(f);
  i = fseek(f, 0L, SEEK_SET);
  buffer = malloc(length+2);
  if (buffer == NULL) {
    fprintf(stderr, "* Failure: buffer = malloc(%ld)=NULL\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
  makespace (c, source_length+2); // overkill, because more chars than tokens.

  find_lines();
}

int startline = TRUE; // startline is true before hitting the first non-whitespace character in a line.
                      // In C used mainly for # commands immediately after a newline.
                      // need to distinguish 'start statement' which can follow a ';' as well as the newline
                      // which will be needed for comments in Imp...
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

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

  // VERY BAD if c is extended on the fly by makespace if stores() is being called
  // from inside line_reconstruction() which in turn has been called on the fly
  // from ONDEMAND in order to pull in more source code!
  // But see the note next to declaration of 'c' for a possible fix.

  // Otherwise it would be easy to call "makespace (c, c_nextfree+1);" here.

  c[c_nextfree].sIndex = tag; // index of string in stringpool - NOT a pointer to a 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;

  whitespace_lineno = nextch_lineno;
  whitespace_col = nextch_col; // ready for next token.
  whitespace_pos = nextch_pos;

  // NOT SAFE TO CALL HERE ANY MORE! "makespace(c, c_nextfree+2);"
  
  c_nextfree++;
}

void storec (int ch, int toklineno, int tokcol, int tokpos, int type, char *fname, int line) { // STORE CHARACTER
  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__)

#include LEX_C

/* 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 (also known as an "analysis
    record" or "AREC") 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 both the <lang>.c source file
    and in the 'compile()' procedure in the compile-<lang>.c file.
 */

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

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

// cp used to be pre-built by running line_reconstruct() on the entire
// source file.  Now it reads the source file on demand as it is parsed
// and converts text to tokens only when needed.  This allows the
// line reconstruction to be modified by the parser - perhaps an
// unclean mixing of levels, but as any compiler writer will know,
// it can also be damned helpful!



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 <lang>.c */
  int saved_cp, saved_ap, i, gp, alts, match, where=0;
  int optional = pp&OPTIONAL_PHRASE, negated = pp&NEGATED_PHRASE;

  // 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.  I have
  // already restructured the data here to avoid or at least minimise this problem in future.

  // this could be converted to a flex array:
#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.  The two main test languages - Imp and C - both seem to
  // be working OK with the same whitespace option.
  
  if (pp == WHITESPACE) {
    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)) {
    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);

  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); // grab plenty of extra space rather than make lots of small calls.

    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);

    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 (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);
        }
        
        if (cp > bestparse) strcpy(looking_for, s);
        bestparse = cp;
        bestparse_depth = depth;
#undef s
      }

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

        makespace(c, cp+1);
        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'.


#ifdef STROPPED_KEYWORDS
        // 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);
            makespace(c, cp+1);
            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 // whole keywords.
        makespace(c, cp+1);
        if ((c(cp).sIndex == -1) || (strcmp (keyword(phrase - 256), String(cp)) != 0)) {
          match = FALSE;
        } else {
          // enter keywords into the A record for source reconstruction
          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'.

        makespace(c, cp+1);

        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) {
        makespace(c, cp+1);
        while ((c(cp).t == B_char) && (String(cp) != NULL) && (isspace(*String(cp)))) {
          cp += 1;
          makespace(c, cp+1);
        }
        match = TRUE;

      } else if (phrase < SEMANTIC) {   // REGULAR PHRASE
        /* 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'.

        // 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.
        makespace(c, cp+1);
        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 (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 {
          match = FALSE;
        }

      } else {        // SEMANTIC PHRASE
        // we shouldn't need to store anything for a successful parse,
        // and just use it to accept or reject an alternative, *BUT* we
        // *do* need to store an empty match because the source reconstruction
        // got all messed up otherwise. It may be fixable there but at the
        // cost of more complex code.  Doing it here once is simpler.

        // I'll initialise these before we know if it succeeded or not,
        // because that way the semantic code could poke values in here
        // if it wanted to and not have them immediately overwritten!
        A(ap  ) = phrase;
        A(ap+1) = 0; // alt
        A(ap+2) = 0; // count
        A(ap+3) = 0; // unused (this is where matched text would go)
        A(saved_ap + 3 + phrase_count++) = where;     // Record BIP
        if (semantic(phrase-SEMANTIC)) {
          match = TRUE;
          ap += 4;
        } else {
          match = FALSE;
        }
      }

      if (!match) break;
    }

    gp += phrases;              // move over all phrases, to next alt
    // gp now points to first element (length) of next alt, or start of next phrase

    if (match) break;
  }

  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  ( this is why the Makefile says -Wno-div-by-zero )
  }
  
  switch (phrase) {

#include INCLUDE  // I really should rename this as GRAMMAR so that Makefile says -DGRAMMAR=...

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

// *ALL* stdout printing happens here.  This is what outputs the terminals in the default compile()
static void RECONSTITUTE(int idx, FILE *out) {
  int i;
  makespace(c, idx+1);
  for (i = c(idx).start_sp; i < c(idx).end_tok; i++) fputc(source_address(i), out);
  fflush(out);
}

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

#ifdef COMPILE
#include COMPILE  // This is the file I've referred to as <lang>.c at times...
#else
void compile(int astp) {
  fprintf(stderr, "Compile phase missing. Enable by compiling with -DCOMPILE=...\n");
}
#endif

#ifdef INCLUDE_AST_DEBUG // Can be defined in <lang>.c
#include INCLUDE_AST_DEBUG
#endif

int main (int argc, char **argv) {
  int errors, lines;
  int program;
  char *s;
  int SS;
  
  /* Get clean version of executable name.  This worked on the variety of
     systems we used to use many years ago.  Now it's just M$ and Linux :-( */
  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';                  // VMS 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
      // Add -d parse and -d lex later.
      // Earlier code for those was removed - if adding it back
      // in, use an include file and do it more neatly than before.
      if (strcmp(debug_type, "phases") == 0) {
        debug_phases=TRUE;
      } else if (strcmp(debug_type, "ast") == 0) {
        debug_ast=TRUE;
      } else if (strcmp(debug_type, "errors") == 0) {
        debug_errors=TRUE;
      } else {
        fprintf(stderr, "%s: debug option '%s' not recognised\n", progname, debug_type);
        fprintf(stderr, "        currently supported -d types are: phases ast errors\n");
        exit(1);
      }
    } else {
      // plain -d gets everything.  May add a '-d all' later.
      debug_phases=TRUE; debug_errors=TRUE; debug_ast=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);
  } else fclose(sourcefile); // quick existence check.
  
  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]);
  cur_source = argv[1]; // this needs better management for when we handle include files...
  
  nextch_pos = 0;

  errors = 0;

  // for (;;) {
  
    // It's possible to parse a single statement at a time in a loop rather than parsing the
    // entire program.  This saves memory and a lot of slow backtracking when there's a failure
    // at the end of a large block.  However since even the largest program parses in less
    // than a minute, and the simplification that comes from parsing whole blocks is huge,
    // I'm going to stick with whole-program parsing for now.

    //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 (debug_phases) fprintf(stderr, "Parse:\n");
    if ((SS = parse (P_SS, 0, 1, 0)) == 0) errors += 1; else {
      int i;
    
      if (debug_phases) fprintf(stderr, "Build AST:\n");
      program = build_ast(/*SS*/0, 0);
#ifdef INCLUDE_AST_DEBUG
      if (debug_ast) print_ast(program, 0);
#endif

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

      fprintf(stderr, "%d Lines compiled.\n", source_lines-1); // Line numbering starts at 1.
      // now do something with it :-)
      if (debug_phases) fprintf(stderr, "Compile: (Walk AST)\n");
      compile(program);
      exit (0);
    
    }

  // } end of 'statement at a time' for-loop, if we're parsing that way.

  /* Attempt to print a sensible error if the parse failed */
  if (bestparse == c_nextfree) {
    makespace(c, bestparse+1);
    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.
    makespace(c, bestparse+1);
    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);

    if (debug_errors) {
      makespace (bestparse_stack, bestparse_depth+1);
      for (i = 0; i <= bestparse_depth; i++) {
        if (bestparse_stack(i)) {
          fprintf(stderr, "  %s\n", bestparse_stack(i));
        }
      }
    }
  }
  
  exit (1);
  return (1);
}
@


1.14
log
@adding ability to lex both C+Imp without specific hacks in the parser
@
text
@a0 22
// On error reporting: compilers built with this parser must report the first
// error that occurs, but need not try to report subsequent failures.

// Errors will be reported in a form that Emacs supports so that you can
// compile from within Emacs with a single keystroke, and have emacs immediately
// take you to the line and column of the error.

// current bug: a single " in a comment throws everything off... see lisps.imp
// - should be fixed soon now that line reconstruction has been redesigned.

// The recent restructuring was primarily to support adding regexes on top of the
// keyword mechanism.  Don't forget to actually add it!  The code is in
//  REGEX/regexp-notchar.c ...

// 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)

// Note that Imp80 explicitly forbids {} comments within a token (though Imp77 doesn't
// seem to mind) - this may become an issue when/if we move to using regular expressions
// to match source text against grammar rules.

a7 2
// Need to know what kind of line reconstruction we will be doing.

d13 4
a38 7
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

a51 12
#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


d74 11
a84 2
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...
d102 15
d121 2
a122 2
  // to describe strings.  (Also we can compare strings just with
  // an integer tag comparison, if we ever want to)
d125 1
a125 3
#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 ...
d128 3
a130 6
  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));
a140 1
    if (debug_flex) fprintf(stderr, "makespace: %s increased to %d entries\n", arrayname, *arraysize);
a141 1
  // *arraysize = ((*arraysize) * 2);
a144 1
  if (debug_flex) fprintf (stderr, "makespace: %s = realloc(%d * %d)\n", arrayname, (*arraysize), objsize);
d148 1
a148 1
    fprintf (stderr, "\nEXIT: makespace: realloc(%d * %d)=NULL - %s\n", (*arraysize), objsize, strerror (errno));
d159 1
d161 1
a161 1
#define String(i) &stringpool(c(i).sIndex)
a162 1
char *escape(char *s, int ch);
a171 2
        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));
a172 4
      } 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));
d180 1
a180 2
  /* C[] is the source character token stream */

d220 1
a220 1
  //fprintf(stderr, "line reconstruction - before loop. nextfree = %d. asked for %d\n", c_nextfree, x);
a221 2
    //fprintf(stderr, "line reconstruction. nextfree = %d. asked for %d\n", c_nextfree, x);
    //generic_demandload_ch(x);
d230 1
a230 1
  //fprintf(stderr, "line reconstruction - loop exited. nextfree = %d. asked for %d\n", c_nextfree, x);
d236 1
d241 4
d250 1
a250 1
     Contents point to a C[] structure when the item is a BIP,
d252 1
a252 2
     for example, if A(25) contained 10, that would mean that the
     token for A(25) was stored in C[10].]
d256 1
a256 1
int *A = NULL;           /* Flex array, expanded using 'makespace' below */
d264 1
d268 1
a268 2
  /*  Create a tuple for an n-ary operator.  Pre-generated code
      currently just mirrors the Analysis record. */
a271 1

a278 1
  if (debug_ast) fprintf(stderr, "mktuple(%d, %d, %d, [", op, alt, count);
a279 1
    if (debug_ast) fprintf(stderr, " %d", T[parm+1]);
a281 1
  if (debug_ast) fprintf(stderr, " ]) = %d\n", trip);
d286 1
a286 1
int escapech(char *dest, int ch, int quotetype) {
d288 2
a289 3
  // This is only for display in debugging info.
  // It is not appropriate for the language being
  // compiled as these use C conventions.
d320 1
a320 1
    *t++ = '\\'; *t++ = 'x';  // Wait! is is \xFF or \0xFF ???
d330 3
a332 2
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.
d341 1
a341 1
      t += escapech(t, *s++, quotetype);
d343 1
a343 3
        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);
d349 2
a350 1
    // ideally we should truncate at the first \n (if there is one) and continue parsing from there...
d356 1
a356 1
// THIS DOES *NOT* PARSE A BIP!
d358 1
d361 4
a364 24
  int astidx, data[3];

  switch (B) {
#ifdef C_PARSER
  default:      
    fprintf(stderr, "*** Warning: Unhandled BIP %d\n", B);
#endif
#ifdef IMP_PARSER
  case B_stropped:
#endif
  case B_sqstring:
  case B_dqstring:
  case B_EOF:
  case B_char:
  case B_NL:
    data[1] = B;
    data[2] = aptr;
    astidx = mktuple(B, 1, 2, data);
    return astidx;
    break;
//  default:      
//  fprintf(stderr, "*** ERROR: Unhandled BIP %d\n", B);
    exit(EXIT_FAILURE);
  }
a366 13
//#ifdef C_PARSER
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);
}
//#endif
a372 1
  if (listing) fprintf(stderr, "%c", data[1]);
d376 3
d385 3
d393 3
a400 1
//void find_lines(char *source_address, int source_length) {
d405 2
a417 12
  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;
      }
    }
  }
d428 2
d435 1
a435 1
    fprintf(stderr, "* buffer = malloc(%ld) failed\n", length+1);
a442 1
  //fprintf(stderr, "****************************** file length = %ld\n", length);
a445 3
  //printf("/* Mapped file: */\n");
  //for (i = 0; i < length; i++) putchar(buffer[i]);
  //printf("/* End of mapped file. */\n");
d466 1
a466 1
void stores (char *s,
d475 1
d477 1
a477 1
  // makespace (c, c_nextfree+1);
d479 1
a479 1
  c[c_nextfree].sIndex = tag; // pointer to index of string in stringpool - NOT string because stringpool can be reallocked.
a496 15
  if (debug_line_reconstruction) {
    char message[1024];
    char *mess = message;
    mess += sprintf(mess, "[%d:'%s'|'", c_nextfree, 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");
  }
  
d501 2
a502 18
  // NOT SAFE TO CALL HERE ANY MORE!
  // makespace(c, c_nextfree+2);
  if (debug_flex) {
    fprintf(stderr, "Setting c[%d]: lineno=%d col=%d f=\"%s\" t=%d ",
                     c_nextfree,
                     c[c_nextfree].lineno_tok,
                     c[c_nextfree].col_tok,
                     c[c_nextfree].f,
                     c[c_nextfree].t);
    fprintf(stderr, "s=\"%%s\" (at %%p) Line %d\n",
                     //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));*/
  }
d505 2
a506 1
void storec (int ch, int toklineno, int tokcol, int tokpos, int type, char *fname, int line) {
d522 4
a525 3
    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.
d530 2
a531 2
    You'll find the grammar embedded in the 'compile()' procedure
    in the following section.
d537 3
a539 1
// Parsing inputs line-reconstructed text from the c[] array rather than reading text directly.
d542 8
a549 35
char *lookahead_rest_of_line(int cp) {
  static char line[32768];
  int ic = 0;
  for (;;) {
    if (cp == c_nextfree) { // end of pre-scanned text
      // Now we look at text in the input file stream...
      int chpos = nextch_pos;
      ic += sprintf(line+ic, "' '");
      for (;;) {
        int ch;
        if (chpos >= source_length) break;
        ch = source_address(chpos);
        if (ch == '\n') break;
        line[ic++] = ch;
        chpos += 1;
      }
      break;
    }
    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;
}
d554 1
a554 1
     being generated from the grammar rules embedded in cexpr.c */
d556 1
d560 4
a563 2
  // like a malloc failure would be, and all we see is a SIGSEGV signal being thrown.
  
d573 2
a574 1
  // no spaces allowed between them.
a576 1
    int optional = pp&OPTIONAL_PHRASE, negated = pp&NEGATED_PHRASE;
a582 1
    int optional = pp&OPTIONAL_PHRASE, negated = pp&NEGATED_PHRASE;
a594 10
  /* 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);
  }
  
d607 3
a609 3
    if (ap + 3 > next_free_a)
      next_free_a = ap + 3;
    makespace (A, next_free_a+32);
d616 1
a616 2
    // separate table

d623 1
a623 1
    // is where the first subphrase will be stored.
d625 1
d627 1
d629 1
a629 1
    // successfully parsed phrases are stored in A(saved_ap+3+n)
a630 2
    if (saved_ap + 3 + gap > next_free_a)
      next_free_a = saved_ap + 3 + gap;
a632 35
    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);
    }

d637 1
d639 1
a642 11
      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, " ", lookahead_rest_of_line(cp));
#endif
      }

d646 1
d648 1
d650 1
a681 3
      if (debug_parser)
        indent (depth, stderr);

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

a699 2
        if (debug_parser)
          fprintf (stderr, "\"%s\"/%d", keyword(phrase - 256), phrase - 256);
d727 1
a727 1
#else
a729 2
          //^^^^^^^^^^^^^^^^^^
          // loses something in the translation... check...
d732 1
a732 1
          // an earlier version did not enter keywords into the A record.
d741 1
d744 1
a744 2
        if (debug_parser)
          fprintf (stderr, "{%s/BIP%d}", phrasename(phrase - PHRASES_START), BIP(phrase - PHRASES_START));
a745 1
        makespace(c, cp+1);
d755 1
a756 3
        if (debug_parser) {
          fprintf (stderr, "Skip whitespace");
        }
d758 1
a758 2
        while ((c(cp).t == B_char) && (String(cp) != NULL) && (*String(cp) == ' ')) {
          //                                                   ^^^^^^^^^^^^^^^^^^^   CHECK.  Also, tabs??? folded during line reconstruction???
a760 3
          if (debug_parser) {
            fprintf (stderr, ".");
          }
d763 2
a764 1
      } else if (phrase < SEMANTIC) {
a768 4
        if (debug_parser) {
          fprintf (stderr, "Try next alt: <%s%s/%d>", optional?"?":negated?"!":"", phrasename(phrase - PHRASES_START), phrase);
        }

a774 4
          if (debug_parser) {
            indent(depth, stderr);
            fprintf (stderr, "Alt <%s%s/%d> succeeded", optional?"?":negated?"!":"", phrasename(phrase - PHRASES_START), phrase);
          }
a791 4
          if (debug_parser) {
            indent(depth, stderr);
            fprintf (stderr, "Alt <%s%s/%d> failed", optional?"?":negated?"!":"", phrasename(phrase - PHRASES_START), phrase);
          }
d795 15
a809 3
      } else {
        // SEMANTIC PHRASE
        // we don't store anything for a successful parse, we just use it to accept or reject an alternative
a810 4
          if (debug_parser) {
            indent(depth, stderr);
            fprintf (stderr, "Alt <%d:%s> succeeded", phrase, semantic_code[phrase-SEMANTIC]);
          }
d812 1
a813 4
          if (debug_parser) {
            indent(depth, stderr);
            fprintf (stderr, "Alt <%d:%s> failed", phrase, semantic_code[phrase-SEMANTIC]);
          }
d818 2
a819 6
      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);
      }
a820 4
      if (!match)
        break;

    }
a821 7

    if (match)
      break;
    else if (debug_parser) {
      indent (depth, stderr);
      fprintf (stderr, "** Alternative %d FAILED.\n", i + 1);
    }
d824 1
a827 1

d850 1
a850 1
    saved_ap = saved_ap/0; // force backtrace
d855 2
a856 1
#include INCLUDE
d863 1
a863 168
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 // conditional stuff for specific languages to be removed as soon as possible!
    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_sqstring: // 3
    //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_dqstring: // 5
    //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_NL: // 12
      fprintf(stderr, "\n");
      break;
    case B_EOF: // 13
      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_sqstring: // 3
    //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_dqstring: // 5
    //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_NL: // 12
      fprintf(stderr, "\n");
      break;
    case B_EOF: // 12
      return;
#endif
#ifdef IMP_PARSER
    case B_stropped:
      fprintf(stdout, "/* print keyword %d */ ", astop);
      break;
#endif
    default:
      fprintf(stdout, "/* print terminal %d */ ", astop);
    }
  }
}

a870 260
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_sqstring: // 3
    //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_dqstring: // 5
    //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_NL: // 12
      fprintf(stderr, "\n");
      break;
    case B_EOF: // 12
      return;
#endif
#ifdef IMP_PARSER
    case B_stropped:
      fprintf(out, "/* print keyword with whitespace: %d %d %d */\n", astop, data0, A[data1+3]);
      break;
#endif
    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);
        }
      }
    }
  }
}

d883 2
a884 2
#ifdef COMPILE // Expanded compile procedure.  Initially auto-generated
#include COMPILE
d887 2
a888 14
  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) {
#ifdef STROPPED_KEYWORDS
  case AST_stropped:
a889 15
  case AST_char:
  case AST_sqstring:
  case AST_dqstring:
  case AST_NL:
  case AST__LIT:
    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;
d891 2
a892 4
  default:
    for (i = 1; i <= count; i++) compile(AST[astp+3+i]);
  }
}
d901 2
a902 1
  /* Get clean version of executable name.  Should work on most existing systems (2006) */
d907 1
a907 1
  if ((s = strrchr (progname, ';')) != NULL)  *s = '\0';                  // Version no's
a911 1

d913 3
d917 9
a925 20
      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);
        }
d927 3
a929 7
          // 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;
d931 4
d946 1
a946 2
  }
  fclose(sourcefile);
a968 3
  line_reconstruction ();       // Effectively, lexing.

  /* Call the parser */
a970 1
  //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.
d972 20
a991 5
  //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;
d993 2
a994 6
    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;
d996 5
a1000 49
        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.
a1001 9
    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);
d1004 1
a1004 3
  } else {
    errors += 1;
  }
d1006 5
a1010 6
  // } 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);
d1012 1
a1012 7
    /* Attempt to print a sensible error if the parse failed */
    if (bestparse == c_nextfree) {
      makespace(c, bestparse+1);
      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;
d1014 8
a1021 8
      // 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.
      makespace(c, bestparse+1);
      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);
d1023 5
a1027 5
      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);
d1029 1
a1029 1
//#ifdef NEVER // maybe attach this to a debug_? flag.
a1035 1
//#endif
a1036 1
    exit (1);
d1038 2
a1039 1
  exit (0);
@


1.13
log
@avoid pre-fetching c[] tokens simply for a diagnostic message
@
text
@a30 2
#define IMP_PARSER 1
//#define C_PARSER 1
d241 1
a241 1
#include "line_reconstruction-imp80.h"
d396 5
a400 1
  case B_EOF:
d402 1
d405 1
d413 2
a414 2
  default:      
    fprintf(stderr, "*** ERROR: Unhandled BIP %d\n", B);
d419 1
d431 1
d615 1
a615 1
#include "line_reconstruction-imp80.c"
a634 12
#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

d882 1
a882 1
#ifdef IMP_PARSER
d1091 1
a1091 1
#ifdef C_PARSER
d1103 2
a1104 1
    case B_character_constant: // 3
d1112 2
a1113 1
    case B_string: // 5
d1135 4
a1138 1
    case B_EOF: // 12
d1194 2
a1195 1
    case B_character_constant: // 3
d1202 2
a1203 1
    case B_string: // 5
d1224 3
d1230 1
d1234 1
d1285 2
a1286 1
    case B_character_constant: // 3
d1294 2
a1295 1
    case B_string: // 5
d1346 3
d1352 1
d1356 1
d1536 1
d1538 1
@


1.12
log
@small changes. B_alphanumeric removed, and startofline support added.
first bestparse error message noted rather than last.
@
text
@a75 13
#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

// variables used in line_reconstruction() moved here so they are available to semantic code in grammar.
int at_startofstatement = TRUE;
int at_startofline_____ = TRUE; // not using this yet so giving it a name I won't use by accident by confusing it with at_startofstatement
int in_keyword = FALSE;
int in_alphanumeric = FALSE;

d644 1
a644 1
char *canonical_rest_of_line(int cp) {
d648 17
a664 4
    makespace(c, cp+1);
    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++] = '"';
d666 2
a667 2
    if ((c(cp).t == B_sqstring)) line[ic++] = '\'';
    if ((c(cp).t == B_dqstring)) line[ic++] = '"';
d821 1
a821 1
                 "%-*sInput token stream = '%s'\n", depth*3, " ", canonical_rest_of_line(cp));
@


1.11
log
@added regexp code via include
@
text
@d85 1
d186 1
a186 1
    fprintf (stderr, "makespace: realloc(%d * %d) - %s\n", (*arraysize), objsize, strerror (errno));
a412 2
  case B_alphanumeric:
  case B_digit:
a419 1
    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);
d576 1
a576 1
    mess += sprintf(mess, "['%s'|'", escape(s, '\''));
d855 1
a855 1
        strcpy(looking_for, s);
a1527 1
  case AST_digit:
a1528 1
  case AST_alphanumeric:
@


1.10
log
@modified to handle new line reconstruction method
@
text
@d288 2
@


1.9
log
@added support for external compile procedure (autogenerated from grammar)
@
text
@d1 7
d9 1
d12 2
a13 1
// keyword mechanism.  Don't forget to actually add it!
d19 4
d55 2
a56 1
char *progname;
d254 33
a286 1
#define c(x) FLEX(c, x, __LINE__)
a464 29
// 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");
}

d495 23
a517 1
int startline = TRUE; // startline is true before hitting the first non-whitespace character in a line.  In C used mainly for # commands.
d519 10
a542 40
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

d549 3
a551 1
  makespace (c, c_nextfree+1);
d553 1
a553 1
  c(c_nextfree).sIndex = tag; // pointer to index of string in stringpool - NOT string because stringpool can be reallocked.
d555 1
a555 3
  c(c_nextfree).lineno_sp = whitespace_lineno;
  c(c_nextfree).col_sp = whitespace_col;
  c(c_nextfree).start_sp = whitespace_pos;
d557 3
a559 3
  c(c_nextfree).lineno_tok = toklineno;
  c(c_nextfree).col_tok = tokcol;
  c(c_nextfree).start_tok = tokpos;
d561 6
a566 2
  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
d570 2
a571 2
  c(c_nextfree).f = fname;
  c(c_nextfree).t = type;
d591 3
a593 1
  
d595 10
a604 4
    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);
d622 1
a622 337
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)
  at_startofstatement = TRUE;
  in_keyword = FALSE;
  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 == '%') {
      if (in_keyword) continue; // unfortunately this is allowed:  %%FINISH
      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) || peek == '%'; // half-assed - won't get %%%if ...
      // 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.  For example, in the pdp15 compiler:
      // C(39): !BEGEND: ENDOFPRIM(1), ENDOFPERM(2), BEGIN(111),
      //        ! END(260), ENDOFPROGRAM(261)
      //      %IF X = 1 %THEN %START
      //          TBASE = TMAX %IF TBASE = 0
      //      %FINISH
      // the comma in the comment which has a label in front of it causes a continuation
      // (because it is a parsed comment, not a skipped comment) but the line following
      //  which is a skipped comment is skipped, so the line after that (a %IF statement)
      // ends up as part of the first comment!  YUCK.
      // So I *REALLY* need to come up with something better...
      // Current idea... a parse-time statement in the grammar after all labels,
      // which resets the 'at start of line' flag... :-(
      // - NOPE! can't work, the line reconstruction happens *before* parse time.
      // Can we delay it so it is done on demand while parsing, perhaps?
      
      // 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));
    }
  }

}
d661 1
d871 1
d897 1
d914 2
a915 1
#else  
d935 1
d949 1
d953 1
d970 1
d1237 1
d1627 2
a1628 1
  memory_map_file(argv[1]); find_lines();
d1631 1
a1631 1
  line_reconstruction (sourcefile, argv[1]);       // Effectively, lexing.
d1725 1
d1734 1
@


1.8
log
@currently has a problem with lisps.imp but otherwise quite robust
@
text
@d69 5
d76 2
a77 2
//#define WANT_SEMANTIC_CODE 1
//#define WANT_SEMANTIC_TABLE 1
d637 3
a639 3
  int at_startofstatement = TRUE;
  int in_keyword = FALSE;
  int in_alphanumeric = FALSE;
d741 1
d746 1
a746 1
      in_keyword = isalpha(peek);
d806 15
a820 1
      // but even then a %comment ending in a ',' is a pain.
d1813 3
d1852 1
@


1.7
log
@fixed \\ and \'
@
text
@d1 2
d52 1
d74 1
a74 1
#include "parser.h"              // GENERATED GRAMMAR FROM takeon
d85 14
d125 1
a125 1
char *looking_for = "<UNKNOWN>";        // 'while looking for <PHRASENAME>' (or literal) ...
d140 1
a140 1
  if (debug_flex) fprintf(stderr, "makespace: %s needs space for %d entries (currently %d)\n", arrayname, nextfree, *arraysize);
d154 1
a154 1
  while ((*arraysize) <= nextfree) {
d159 3
d176 1
d178 1
a178 1
#define String(i) &stringpool[c(i).sIndex]
d186 1
a186 1
  strcpy (&stringpool[stringpool_nextfree], s);  /* Create a backstop for when not found */
d188 1
a188 1
    if (strcmp (&stringpool[tag], s) == 0) {
d191 1
a191 1
                                         stringpool_nextfree, escape(&stringpool[stringpool_nextfree], '"'), (long)(stringpool_nextfree + strlen (s) + 1));
d194 1
a194 1
        if (debug_flex) fprintf(stderr, "found in existing stringpool: %d: \"%s\"\n", tag, escape(&stringpool[tag], '"'));
d196 1
a196 1
                                        stringpool_nextfree, escape(&stringpool[stringpool_nextfree], '"'), (long)(stringpool_nextfree+strlen (s) + 1));
a248 9
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;
}

d337 1
d344 1
d403 2
d407 1
d416 1
a416 1
void memory_map_file(char *filename, char **source_address, int *source_length) {
d424 5
a428 1
  buffer = malloc(length+1);
d431 7
a437 2
  *source_address = buffer;
  *source_length = length;
d443 2
a444 1
void find_lines(char *source_address, int source_length) {
d449 1
a449 1
  source_line[line++] = -1; // lines start at 1.
d453 1
a453 1
      source_line[line++] = p;
d456 1
a456 1
    lastch = source_address[p++];
d462 1
a462 1
      p = source_line[i];
d465 1
a465 1
        int c = source_address[p++];
d491 2
a492 2
  if (nextch_pos == source_length) return EOF;
  ch = source_address[nextch_pos++];
d496 2
a497 2
  peek = source_address[nextch_pos];
  //fprintf(stderr, "{%c}", ch);
d512 2
a513 2
      p = source_line[nextch_lineno];
      while (source_address[p] != '\n') {
d521 1
a521 1
  ch = source_address[nextch_pos-1];//+1
d525 1
a525 1
  if (nextch_pos == source_length) peek = EOF; else peek = source_address[nextch_pos];//+1
d531 1
a531 1
             int type, char *fname) {
d556 1
a556 1
    char message[512];
d562 4
d575 1
a575 1
    fprintf(stderr, "Setting c[%d]: lineno=%d col=%d f=\"%s\" t=%d s=\"%s\" (at %p)\n",
d578 2
a579 2
                            escape(String(c_nextfree), '"'), String(c_nextfree));
    fprintf(stderr, "CHECK c[%d]: lineno=%d col=%d f=\"%s\" t=%d s=\"%s\" (at %p)\n",
d582 1
a582 1
                            escape(String(0), '"'), String(0));
d586 1
a586 2

void storec (int ch, int toklineno, int tokcol, int tokpos, int type, char *fname) {
d591 1
a591 1
          type, fname);
d593 2
d612 1
a612 1
void em_char_in_stmnt(void) {
d614 1
a614 1
  fprintf(stderr, "EM CHAR IN STMNT - DISASTER\n"); // stop-gap measure - needs a lomgjump to end of compile code to clean up
d617 1
d650 11
d664 1
d666 1
a666 1
        ch = xfgetc (sourcefile); if (ch == EOF) em_char_in_stmnt();
d668 18
d689 1
a689 1
    if (ch == '\'' || ch == '"') {
d691 5
d699 11
a709 1
        ch = xfgetc (sourcefile); if (ch == EOF) em_char_in_stmnt();
d712 1
a712 1
          ch = xfgetc (sourcefile); if (ch == EOF) em_char_in_stmnt();
d714 1
a714 1
        // should warn if there is a newline in the string or if it is longer than 255 characters.
d716 11
d789 1
a789 1
        ch = xfgetc (sourcefile); if (ch == EOF) em_char_in_stmnt();
d795 10
d812 1
d818 1
d826 1
d833 10
d846 1
d852 14
d873 1
d875 5
a879 1
if (ch == '\n') fprintf(stderr, "******* THIS COULD NOT POSSIBLY EVER HAPPEN!\n");
d891 1
a891 3

  makespace (c, c_nextfree+1);

d904 1
a906 1
  
d908 9
d953 1
a953 1
  static char line[512];
d965 6
d974 1
a974 1
int parse (int pp, int depth)   // depth is only for indentation in diags
d979 5
d985 1
a985 1
  char saved_desc[(MAX_DESC*3)/2];
d1120 1
a1120 1
        static char s[1024];           // off heap instead? - binary size
d1129 8
a1136 1
          sprintf (s, "<%s%s> {%s}", optional?"?":negated?"!":"", phrasename(pp - PHRASES_START), phrasename(phrase - PHRASES_START));
d1144 6
a1149 1
        looking_for = s;
d1152 1
d1190 1
a1190 1
            if (!((c[cp].t == B_stropped) && (c[cp].sIndex >= 0) && (stringpool[c[cp].sIndex] == *key))) {
d1240 1
a1240 1
          //                                                               ^^^^^^^^^^^^^^^^   CHECK.  Also, tabs??? folded during line reconstruction???
d1258 1
a1258 1
        match = parse (phrase, depth + 1); // options have been removed from recursive call. COULD USE 'match' HERE!
d1524 1
a1524 1
  for (i = c[idx].start_sp; i < c[idx].end_tok; i++) fputc(source_address[i], out);
d1580 1
a1580 1
      cp = A[data1+3];
d1644 6
d1799 6
a1805 2
    break;

d1909 2
a1910 2
  memory_map_file(argv[1], &source_address, &source_length);
  find_lines(source_address, source_length);
a1913 9
  if (debug_parser) {
    int i;                        // DEBUG ONLY
    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));
    }
  }

d1922 1
a1922 1
  if ((SS = parse (P_SS, 0)) != 0) {
a1923 7
    if (debug_tokens) {
      fflush(stderr); fflush(stdout);
      fprintf(stderr, "Tokens (line reconstruction and BIPs):\n");
      for (i = 0; i <= c_nextfree; i++) {
        fprintf(stderr, "c(%d).s = \"%s\" (at %p) t=%d\n", i, escape(String(i), '"'), String(i), c(i).t);
      }
    }
d1979 3
d2017 1
a2017 1
      while (c(i).lineno_tok == c(bestparse).lineno_tok) RECONSTITUTE(i++, stderr);
d2019 1
d2025 1
a2025 1
#ifdef NEVER // maybe attach this to a debug_? flag.
d2032 1
a2032 1
#endif
@


1.6
log
@Added various stupid Imp77 line continuation mechanisms...
  =
  ,
  %and
  %or
@
text
@d659 1
a659 1
        storec (ch,
@


1.5
log
@ok
@
text
@d180 1
d344 1
a344 1
  // case B_stropped: handled by 'keyword()'
d391 4
a394 1
int source_line[10000]; // make this a flex array once debugged.  And get rid of 'xline'
d417 1
a417 1
void find_lines(char *source_address, int source_length, int source_line[10000]) {
d421 1
d424 4
a427 1
    if (lastch == '\n') source_line[line++] = p;
a461 5
//static int xi = 0, xcur_line = 1;
//static char *xline = NULL;
//static int xline_arraysize = 0;
//#define xline(x) FLEX(xline, x, __LINE__)

d622 1
a622 1
      } while (ch != '\n');  // In Imp, does a ';' end a '!' comments and/or a %comment ???  grep old sources and adjust later...
d664 1
a664 1
        storec (ch,
d693 2
d707 22
a728 2
      // if last non-skipped,non-whitespace character in c[] was %or then remove it and the newline.
      // if last non-skipped,non-whitespace character in c[] was %and then remove it and the newline.
d730 6
a745 2
    // Skip white space
    if (isspace(ch)) continue;
d798 1
d808 1
d813 16
d959 1
d963 4
a1633 2
    fprintf(stdout, "AST_stropped "); // already converted to AST__KW
    break;
a1634 3
    fprintf(stdout, "AST_char "); // already converted to AST__LIT
    break;

d1737 1
a1737 1
  find_lines(source_address, source_length, source_line);
a1860 1

@


1.4
log
@Looking good!
@
text
@d2 1
a2 1
// keywork mechanism.  Don't forget to actually add it!
d4 1
a4 1
// for examples such as imp variables with spaces in them - the stored token in the stringpool
d41 3
a43 2
static char outname[256];
FILE *outfile;
d59 1
d64 1
d169 2
a170 2
        if (debug_flex) fprintf(stderr, "adding pre-positioned stringpool: %d: \"%s\" (extends to %d)\n",
                                  stringpool_nextfree, escape(&stringpool[stringpool_nextfree], '"'), stringpool_nextfree + strlen (s) + 1);
d174 2
a175 2
        if (debug_flex) fprintf(stderr, "pre-positioned stringpool ignored: %d: \"%s\" (extended to %d)\n",
                                  stringpool_nextfree, escape(&stringpool[stringpool_nextfree], '"'), stringpool_nextfree+strlen (s) + 1);
d323 1
a323 1
        fprintf(stderr, "WARNING! Escaped string is too large! (over %d chars): \"%s\"...\n", t-escaped, escaped);
d329 1
a329 1
    fprintf(stderr, "WARNING! Escaped string is too large! (over %d chars): \"%s\"...\n", t-escaped, escaped);
d351 1
a351 1
    data[2] = A[aptr];
d353 1
a353 1
    if (B == B_alphanumeric) fprintf(stderr, "mktuple(%d, 1, 2, [B_%d A(%d)]) = %d\n", B, data[1], data[2], astidx);
d365 1
a365 1
  int i, cptr;
d368 1
a368 1
  cptr = data[2] = A[ap+3];
d377 1
a377 1
  data[1] =  ch;
d471 2
d497 1
d822 1
a822 1
    fprintf (outfile, "\n%-*sPhrase %s%s/%d (%d alternatives) = ",
d826 1
a826 1
    fflush (outfile);
d871 1
a871 1
      fprintf (outfile, "\n%-*s", depth*3, " ");
d873 1
a873 1
        fprintf (outfile, "Alternative %d: (NULL phrase) ", i + 1);
d875 1
a875 1
        fprintf (outfile, "Alternative %d: (%d phrases) ", i + 1, phrases);
d895 1
a895 1
      fprintf (outfile, "%s\n", saved_desc);
d900 1
a900 1
      fflush (outfile);
d912 1
a912 1
        fprintf (outfile,
d941 1
a941 1
        indent (depth, outfile);
d948 1
a948 1
          fprintf (outfile, "'%c'", phrase);
d964 1
a964 1
          fprintf (outfile, "\"%s\"/%d", keyword(phrase - 256), phrase - 256);
d1009 1
a1009 1
          fprintf (outfile, "{%s/BIP%d}", phrasename(phrase - PHRASES_START), BIP(phrase - PHRASES_START));
d1022 1
a1022 1
          fprintf (outfile, "Skip whitespace");
d1028 1
a1028 1
            fprintf (outfile, ".");
d1038 1
a1038 1
          fprintf (outfile, "Try next alt: <%s%s/%d>", optional?"?":negated?"!":"", phrasename(phrase - PHRASES_START), phrase);
d1047 2
a1048 2
            indent(depth, outfile);
            fprintf (outfile, "Alt <%s%s/%d> succeeded", optional?"?":negated?"!":"", phrasename(phrase - PHRASES_START), phrase);
d1068 2
a1069 2
            indent(depth, outfile);
            fprintf (outfile, "Alt <%s%s/%d> failed", optional?"?":negated?"!":"", phrasename(phrase - PHRASES_START), phrase);
d1079 2
a1080 2
            indent(depth, outfile);
            fprintf (outfile, "Alt <%d:%s> succeeded", phrase, semantic_code[phrase-SEMANTIC]);
d1085 2
a1086 2
            indent(depth, outfile);
            fprintf (outfile, "Alt <%d:%s> failed", phrase, semantic_code[phrase-SEMANTIC]);
d1093 4
a1096 4
        fprintf (outfile, "\n");
        indent (depth, outfile);
        fprintf (outfile, "Tried phrase %d of %s - result was %s\n", each + 1, saved_desc, (match ? "TRUE" : "FALSE"));
        fflush (outfile);
d1108 2
a1109 2
      indent (depth, outfile);
      fprintf (outfile, "** Alternative %d FAILED.\n", i + 1);
d1314 1
a1314 1
  int i, spare, astop, alt, count, data0, data1;
a1450 24
void print_prog(int astp, int depth, FILE *out) {
  // IMPORTANT!!!! This works on AST, not AREC.
  // At the moment, the ast-building code is generated automatically, and
  // the AST is extremely similar to the concrete parse tree.  However
  // once the AST is built more appropriately by hand, that correlation
  // may be less obvious, and less likely to include keywords and literals.
  int i, count;
  count = AST(astp+3);
  for (i = astp+4; i < astp+4+count; i++) {
    int subphrase_addr = AST(i);
    int astop = AST(subphrase_addr+1);
    if ((subphrase_addr >= 0) && (astop >= PHRASES_START+MAX_BIP)) {
      if (astop == AST__KW) {
        fprintf(out, "<Keyword!>");
      } else if (astop == AST__LIT) {
        fprintf(out, "<Literal!>"); // generally literals are surface syntax which doesn't make it into the AST.
                                    // For example the '=' symbol in an assignment statement.
      } else {
        print_prog(subphrase_addr, depth+1, out);
      }
    } else print_terminal_with_whitespace(subphrase_addr, out);
  }
}

d1560 12
d1573 1
a1573 1
  int i, aptr; // aptr is a pointer intio A[], not AST[]...
a1578 2
  case AST_EOF:
    //exit(0); // or return;
d1580 1
d1587 1
d1594 1
a1594 4
    //fprintf(stdout, "AST_alphanumeric ");
    //fprintf(stdout, "(%d) kw=%d cidx=%d len=%d ", count, arg[0], arg[1], arg[2]);
    aptr = arg[1];
    RECONSTITUTE(A[aptr+3], stdout);
d1602 1
d1618 6
a1623 14
  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';
d1627 1
a1627 2
  if (argc >= 2) {
    if (strcmp(argv[1], "-d") == 0) {
d1646 1
d1650 1
a1650 1
          // plain -d gets everything.
a1657 1
    }
a1685 1
  outfile = stderr;
d1698 2
a1699 1
      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));
d1707 1
a1707 1
  
d1784 1
a1785 12
      // It's not really expected to always be able to recreate a source
      // from the AST.  It may be possible during the early stages of
      // implementation of a language, while the AST strongly reflects
      // the original Concrete syntax tree.
      
      //fprintf(stderr, "Regenerate source from AST: %d\n", program);
      //fflush(stderr); fflush(stdout);
      //print_prog(program, 0, stderr);
      //RECONSTITUTE(c_nextfree, stderr);// force out whitespace before EOF
      //fprintf(stderr, "\n----\n");
      //fflush(stderr); fflush(stdout);
    }
d1790 2
a1794 2
    //print_prog(program, 0, stdout); // for now...
    //RECONSTITUTE(c_nextfree, stdout);// force out whitespace before EOF
d1803 4
d1808 1
a1808 8
        if (c(i).lineno_tok == c(bestparse).lineno_tok) {
          break;
        }
      }

      while (c(i).lineno_tok == c(bestparse).lineno_tok) {
        RECONSTITUTE(i, stderr);
        i++;
d1810 1
d1813 1
a1813 1
      fputc('^', stderr); // fprintf(stderr, " [%d]", c(bestparse).col_tok);
@


1.3
log
@ready for compile() once values are printed
@
text
@d1 2
a2 1
// whitespace_* should be set immediately after reading a token and then never touched again!
d6 1
a6 1
// for with embedded whitespace (not to be confused with leading whitespace)
d15 1
d17 1
d28 9
d48 1
a48 2

int listing = 1;
a51 2
//#define WANT_SEMANTIC_CODE 1
//#define WANT_SEMANTIC_TABLE 1
d57 2
d63 5
d183 2
a184 1
  //char *s;
d265 3
d336 1
a336 1
  int rc, data[3];
d349 3
a351 3
    rc = mktuple(B, 1, 2, data);
    fprintf(stderr, "mktuple(%d, 1, 2, [B_%d A(%d)]) = %d\n", B, data[1], data[2], rc);
    return rc;
d1579 1
a1579 1
  int i;
d1583 1
a1583 1

d1586 1
a1586 1
    exit(0); // or return;
d1589 1
a1589 1
    fprintf(stdout, "AST_stropped ");
d1591 2
a1592 5
  case AST_alphanumeric:
    fprintf(stdout, "AST_alphanumeric ");
    break;
  case AST_digit:
    fprintf(stdout, "AST_digit ");
a1594 2
    fprintf(stdout, "AST_sqstring ");
    break;
a1595 5
    fprintf(stdout, "AST_dqstring ");
    break;
  case AST_char:
    fprintf(stdout, "AST_char ");
    break;
d1597 1
a1597 3
    fprintf(stdout, "\n");
    break;

d1599 5
a1603 1
    fprintf(stdout, "AST__LIT ");
a1604 1
    
d1606 5
a1610 1
    fprintf(stdout, "AST__KW ");
d1833 1
a1833 7
          while (ic < c(i).col_tok) {
            fprintf (stderr, " ");
            ic += 1;
          }
          //fprintf (stderr, "%s{%d}", c(i).s, c(i).col_tok);
          fprintf (stderr, "%s ", String(i));  // when MINSIZE in makespace is too low, this string is corrupted...
          ic += strlen(String(i));
d1836 1
a1836 1
      fprintf (stderr, " ***ERROR*** ");
d1838 1
a1838 6
        while (ic < c(i).col_tok) {
          fprintf (stderr, " ");
          ic += 1;
        }
        fprintf (stderr, "%s ", String(i));
        ic += strlen(String(i));
d1841 4
d1846 3
a1848 1
               argv[1], c(bestparse).lineno_tok, c(bestparse).col_tok + 1, looking_for);
d1855 1
@


1.2
log
@wip
@
text
@a1563 1
  fprintf(stdout, "%d: op=%d alt=%d count=%d ", astop, astp, alt, count);
a1569 2
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");
a1572 2
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");
a1575 2
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");
a1578 2
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");
a1581 2
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");
a1584 2
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");
a1587 1
    fprintf(stdout, "\n");
a1588 28
  case AST_S:
    fprintf(stdout, "AST_S ");
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");

    if (alt == 0)        {
      //T[1] = lit(AST__LIT, ';', A[ap+0]);
      compile(AST[astp+4]);
    } else               {
      //T[1] = bip(AST_NL, ap+0);
      compile(AST[astp+4]);
    }
    
    break;
  case AST_NUMBER:
    fprintf(stdout, "AST_NUMBER ");
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");

    //T[1] = bip(AST_digit, ap+0);
    //T[2] = build_ast(A[ap+1], depth+1); // <rest-of-number>
    compile(AST[astp+4]);
    compile(AST[astp+4+1]);
    break;
  case AST_rest_of_number :
    fprintf(stdout, "AST_rest_of_number ");
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");
a1589 104
    if (alt == 0)        {
      //T[1] = build_ast(A[ap+0], depth+1); // <NUMBER>
      compile(AST[astp+4]);
    }
    break;
  case AST_NAME:
    fprintf(stdout, "AST_NAME ");
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");

    //T[1] = bip(AST_alphanumeric, ap+0);
    //T[2] = build_ast(A[ap+1], depth+1); // <rest-of-name>
    compile(AST[astp+4]);
    compile(AST[astp+4+1]);
    break;
  case AST_rest_of_name:
    fprintf(stdout, "AST_rest_of_name ");
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");

    if (alt == 0)        {
      //T[1] = build_ast(A[ap+0], depth+1); // <NAME>
      compile(AST[astp+4]);
    }
    break;
  case AST_SS:
    fprintf(stdout, "AST_SS ");
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");

    if (alt == 0)        {
      //T[1] = build_ast(A[ap+0], depth+1); // <STATEMENT>
      //T[2] = build_ast(A[ap+1], depth+1); // <SS>
      compile(AST[astp+4]);
      compile(AST[astp+4+1]);
    }
    break;
  case AST_STATEMENT:
    fprintf(stdout, "AST_STATEMENT ");
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");

    if (alt == 0)        { //\\    <NAME> '=' <NAME> <S>,
      //T[1] = build_ast(A[ap+0], depth+1); // <NAME>
      compile(AST[astp+4]);
      //T[2] = lit(AST__LIT, '=', A[ap+1]);
      compile(AST[astp+4+1]);
      //T[3] = build_ast(A[ap+2], depth+1); // <NAME>
      compile(AST[astp+4+2]);
      //T[4] = build_ast(A[ap+3], depth+1); // <S> 
      compile(AST[astp+4+3]);
    } else if (alt == 1) { //\\    <NAME> '=' <NUMBER> <S>,
      //T[1] = build_ast(A[ap+0], depth+1); // <NAME>
      compile(AST[astp+4]);
      //T[2] = lit(AST__LIT, '=', A[ap+1]);
      compile(AST[astp+4+1]);
      //T[3] = build_ast(A[ap+2], depth+1); // <NUMBER>
      compile(AST[astp+4+2]);
      //T[4] = build_ast(A[ap+3], depth+1); // <S>
      compile(AST[astp+4+3]);
    } else if (alt == 2) { //\\    <NAME> '=' <sqstring> <S>,
      //T[1] = build_ast(A[ap+0], depth+1); // <NAME>
      compile(AST[astp+4]);
      //T[2] = lit(AST__LIT, '=', A[ap+1]);
      compile(AST[astp+4+1]);
      //T[3] = bip(AST_sqstring, ap+2);
      compile(AST[astp+4+2]);
      //T[4] = build_ast(A[ap+3], depth+1); // <S>
      compile(AST[astp+4+3]);
    } else if (alt == 3) { //\\    <NAME> '=' <dqstring> <S>,
      //T[1] = build_ast(A[ap+0], depth+1); // <NAME>
      compile(AST[astp+4]);
      //T[2] = lit(AST__LIT, '=', A[ap+1]);
      compile(AST[astp+4+1]);
      //T[3] = bip(AST_dqstring, ap+2);
      compile(AST[astp+4+2]);
      //T[4] = build_ast(A[ap+3], depth+1); // <S>
      compile(AST[astp+4+3]);
    } else if (alt == 4) { //\\    "begin" <S>,
      //T[1] = kw(AST__KW, 0 /* begin */, A[ap+0]);
      compile(AST[astp+4]);
      //T[2] = build_ast(A[ap+1], depth+1); // <S>
      compile(AST[astp+4+1]);
    } else if (alt == 5) { //\\    "integer" <NAME> <S>,
      //T[1] = kw(AST__KW, 1 /* integer */, A[ap+0]);
      compile(AST[astp+4]);
      //T[2] = build_ast(A[ap+1], depth+1); // <NAME>
      compile(AST[astp+4+1]);
      //T[3] = build_ast(A[ap+2], depth+1); // <S>
      compile(AST[astp+4+2]);
    } else if (alt == 6) { //\\    "end" "of" "program" <S>,
      //T[1] = kw(AST__KW, 2 /* end */, A[ap+0]);
      compile(AST[astp+4]);
      //T[2] = kw(AST__KW, 3 /* of */, A[ap+1]);
      compile(AST[astp+4+1]);
      //T[3] = kw(AST__KW, 4 /* program */, A[ap+2]);
      compile(AST[astp+4+2]);
      //T[4] = build_ast(A[ap+3], depth+1); // <S>
      compile(AST[astp+4+3]);
    } else               { //\\    <S>;
      //T[1] = build_ast(A[ap+0], depth+1); // <S>
      compile(AST[astp+4]);
    }
        break;
a1591 3
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");

d1593 1
d1596 1
a1596 2
    for (i = 1; i <= count; i++) fprintf(stdout, "T[%d]=%d ", i, AST[astp+3+i]);
    fprintf(stdout, "\n");
a1597 1
    break;
@


1.1
log
@Initial revision
@
text
@d14 2
d37 1
a37 1
int listing = 0;
d41 2
a42 2
#define WANT_SEMANTIC_CODE 1
#define WANT_SEMANTIC_TABLE 1
d56 1
a56 1
//#define SEMANTIC (MAX_PHRASE+512+MAX_BIP+1)
d138 1
a138 1
#define C_s(i) stringpool[c(i).sIndex]
d236 1
d238 1
d241 2
d246 1
a246 2
char *escape(char *s, int ch) { // assert we NEVER call escape on a genuinely empty string - if s[0] == '\0' then it is a '\0' character
  // \0 only supported in character constants, not in strings.
a247 7
  static char escaped[512];
  char *t = escaped;
  *t = '\0';
  if (s == NULL) return escaped;
  if ((*s == '\0') && (ch == '\'')) {
    *t++ = '\\'; *t++ = '0'; s++; *t = '\0';
  } else {
d266 31
d298 4
a301 17
      if (*s == '\n') {
        *t++ = '\\'; *t++ = 'n'; s++;
      } else if (*s == '\t') {
        *t++ = '\\'; *t++ = 't'; s++;
      } else if (*s == '\r') {
        *t++ = '\\'; *t++ = 'r'; s++;
      } else if (*s == '\\') {
        *t++ = '\\'; *t++ = '\\'; s++;
      } else if (*s == ch) {
        *t++ = '\\'; *t++ = ch; s++;
      } else if ( ((int)((*s)&255) < 32) || ((int)((*s)&255) > 126) ) {
        *t++ = '\\'; *t++ = '0'; *t++ = 'x';  // Wait! is is \xFF or \0xFF ???
        *t++ = hexdigit[((*s)>>4)&15];
        *t++ = hexdigit[(*s)&15];
        s++;
      } else {
        if (t-escaped < 510) *t++ = *s++; else *t = '\0';
d303 1
a303 2
    } 
    *t = *s;
d305 1
a305 1
  if (t-escaped == 510) {
d312 2
a313 43
#ifdef C_PARSER
int identifier(int ap)
{
  int data[2];
  data[1] =  A(A(ap)+3);
  if (listing) fprintf(stderr, " %s ", &C_s(data[1]));
  return mktuple(B_internal_identifier, 1, 1, data);
}

int string(int ap)
{
  int data[2];
  data[1] =  A(A(ap)+3);
  if (listing) fprintf(stderr, "\"%s\"", escape(&C_s(data[1]), '"'));
  return mktuple(B_string, 1, 1, data);
}

int floating_constant(int ap)
{
  int data[2];
  data[1] =  A(A(ap)+3);
  if (listing) fprintf(stderr, "%s", &C_s(data[1]));
  return mktuple(B_floating_constant, 1, 1, data);
}

int integer_constant(int ap)
{
  int data[2];
  data[1] =  A(A(ap)+3);
  if (listing) fprintf(stderr, "%s", &C_s(data[1]));
  return mktuple(B_integer_constant, 1, 1, data);
}

int character_constant(int ap)
{
  int data[2];
  data[1] =  A(A(ap)+3);
  if (listing) fprintf(stderr, "'%s'", escape(&C_s(data[1]), '\'')); // might be better one day to store as escaped string, not underlying byte
  return mktuple(B_character_constant, 1, 1, data);
}
#endif

// TO DO: make these elements in the c() array as well.  It'll simplify debugging the A() tree and later, the AST...
d316 1
a316 10
#ifdef C_PARSER
  int data[3];
  
  if (listing) {
    if (B == B_pp) fprintf(stderr, " ++ ");
    if (B == B_mm) fprintf(stderr, " -- ");
    if (B == B_andand) fprintf(stderr, " && ");
    if (B == B_oror) fprintf(stderr, " || ");
    if (B == B_eqeq) fprintf(stderr, " == ");
  }
d319 8
a326 5
  case B_pp:
  case B_mm:
  case B_andand:
  case B_oror:
  case B_eqeq:
d329 7
a335 9
    return mktuple(B, 1, 2, data);
    
  case B_internal_identifier:         return identifier(aptr);
  case B_character_constant: return character_constant(aptr);
  case B_floating_constant:  return floating_constant(aptr);
  case B_integer_constant:   return integer_constant(aptr);
  case B_string:             return string(aptr);
  case B_EOF:                return mktuple(B_EOF, 1, 1, data);
  default: break;
a336 4

  fprintf(stderr, "*** WARNING: Unhandled BIP %d\n", B);
  return mktuple(B, 1, 1, data);
#endif
d339 1
a339 1
int kw(int idx, int ap)
d341 3
a343 1
  int data[3];
d345 4
a348 5
  data[2] =  ap;
#ifdef C_PARSER
  if (listing) fprintf(stderr, " %s ", keyword(data[1]));
  return mktuple(B_keyword, 1, 2, data);
#endif
d351 1
a351 1
int lit(int ch, int ap)
d356 2
a357 7
#ifdef C_PARSER
  if (listing) {
    fprintf(stderr, "%c", data[1]);
    if (ch == ';' || ch == '{') fprintf(stderr, "\n");
  }
  return mktuple(B_char, 1, 2, data);
#endif
d445 1
a445 1
  return ch;
d470 1
a470 1
  peek = source_address[nextch_pos];//+1
d500 8
a507 5
    fprintf(stderr, "[%s|", s);
    for (i = whitespace_pos; i < token_pos; i++) fprintf(stderr, "%c", source_address[i]);
    fprintf(stderr, "|");
    for (i = token_pos; i < nextch_pos; i++) fprintf(stderr, "%c", source_address[i]);
    fprintf(stderr, "]");
d518 1
a518 1
                            escape(&C_s(c_nextfree), '"'), &C_s(c_nextfree));
d522 1
a522 1
                            escape(&C_s(0), '"'), &C_s(0));
d551 6
d564 11
d582 5
a586 23
    token_pos = nextch_pos;
    
    if ((ch = xfgetc (sourcefile)) == EOF)
      break;

    ch &= 255;                  // int, positive.

#ifdef C_PARSER
    if ((ch == '+' || ch == '-' || ch == '&' || ch == '|' || ch == '=') && (peek == ch)) {
      startline = FALSE;
      /* ++, --, &&, || */
      // only a very small number of compound graphemes need to be converted to lexical tokens (BIPs) to avoid parsing ambiguities
      makespace (token, token_nextfree+4);
      token(token_nextfree++) = ch;
      token(token_nextfree++) = ch;
      token(token_nextfree++) = '\0';
      ch = xfgetc (sourcefile); // eat 'peek' ch.
      stores (token,
              token_lineno, startcol, token_pos,
              (ch=='+'?B_pp:ch=='-'?B_mm:ch=='&'?B_andand:ch=='='?B_eqeq:B_oror), curfile);
    } else if (isalpha (ch) || (ch == '_')) {
      startline = FALSE;
      /* token or keyword */
d588 13
d602 7
a608 6
        makespace (token, token_nextfree+1);
        if (isalpha (ch) || isdigit (ch) || (ch == '_')) {
          // digits allowed after 1st char.
          token(token_nextfree++) = ch;
        } else break;
        ch = xfgetc (sourcefile);
d610 1
a610 2
      xungetc (ch, sourcefile);
      token(token_nextfree++) = '\0';
d612 21
a632 114
              token_lineno, startcol, token_pos,
              B_internal_identifier, curfile);

    } else if (((ch == '.') && isdigit(peek)) || (isdigit (ch))) {  // -->0B.110101100P12L
//fprintf(stderr, "Going down the right path...\n");
      startline = FALSE;
      /* Number */
      acceptable_range = &is_decimal;
      if (ch == '0') { // must be binary, octal, or hex.
        // Store as a string...

        makespace (token, token_nextfree+3);
        if (peek == 'b' || peek == 'B' || (peek == 'x') || (peek == 'X')) {
          token(token_nextfree++) = ch; // '0'
          acceptable_range = (peek == 'b' || peek == 'B' ? &is_binary : &is_hex);
          ch = xfgetc (sourcefile); // get the B
          token(token_nextfree++) = ch; // b
          if (peek == '.') {
            goto READ_DECIMAL;
          }
        } else if (peek == '.') {
          token(token_nextfree++) = ch; // '0'
          // started with a 0 so octal unless it is 0.19 etc...
          acceptable_range = &is_decimal;
          goto READ_DECIMAL;
        } else {
          acceptable_range = &is_octal; // the 0 has been read.  If nothing acceptable follows, don't read any more chars
          token(token_nextfree++) = ch; // digit
        }
      } else if (ch == '.') {  //   .nnn or 0.nnn
//fprintf(stderr, "It's a decimal... ch='%c' peek='%c'\n", ch, peek);
        acceptable_range = &is_decimal;
        xungetc (ch, sourcefile); // peek is now '.'
//fprintf(stderr, "ungetc: ch='%c' peek='%c'\n", ch, peek);
        goto READ_DECIMAL;
      } else if (isdigit(ch)) {
        acceptable_range = &is_decimal;
        token(token_nextfree++) = ch; // digit
      }

      // rest of number comes through here for all formats
      while (acceptable_range(peek)) {  // 0B-->.110101100P12L
        ch = xfgetc (sourcefile); // what was peek is now ch
        makespace (token, token_nextfree+2);
        token(token_nextfree++) = ch; // 0
      }
    READ_DECIMAL:
//token(token_nextfree) = '\0'; fprintf(stderr, "So read decimal... '%s'\n", token);
//fprintf(stderr, "ch='%c' peek='%c'\n", ch, peek);
      if (peek == 'p' || peek == 'P') {
//fprintf(stderr, "Got a P...\n");
//fprintf(stderr, "ch='%c' peek='%c'\n", ch, peek);
        goto BINARY_POWER;
      } else if (peek == '.' || peek == 'e' || peek == 'E') { 
//fprintf(stderr, "Got that . again...\n");
//fprintf(stderr, "ch='%c' peek='%c'\n", ch, peek);
        if (peek == '.') {
//fprintf(stderr, "So... reading...\n");
//fprintf(stderr, "ch='%c' peek='%c'\n", ch, peek);
          ch = xfgetc (sourcefile);
          token(token_nextfree++) = ch;
          while (acceptable_range(peek)) {
            ch = xfgetc (sourcefile); // what was peek is now ch
            makespace (token, token_nextfree+2);
            token(token_nextfree++) = ch; // 0
          }
//fprintf(stderr, "And read...\n");
//fprintf(stderr, "ch='%c' peek='%c'\n", ch, peek);
        }
        if ((peek == 'f') || (peek == 'F') || (peek == 'l') || (peek == 'L')) {
//fprintf(stderr, "Got an F...\n");
//fprintf(stderr, "ch='%c' peek='%c'\n", ch, peek);
          ch = xfgetc (sourcefile);
          token(token_nextfree++) = ch;
        } else if (((acceptable_range == is_decimal) && (peek == 'e' || peek == 'E'))
            || ((acceptable_range != is_decimal) && (peek == 'p' || peek == 'P'))) {
//fprintf(stderr, "Got an E or P...\n");
//fprintf(stderr, "ch='%c' peek='%c'\n", ch, peek);
        BINARY_POWER:
//fprintf(stderr, "Binary power?\n");
//fprintf(stderr, "ch='%c' peek='%c'\n", ch, peek);
          ch = xfgetc (sourcefile);
          token(token_nextfree++) = ch; // P
          acceptable_range = &is_decimal; // P+nnn nnn is decimal
          if ((peek == '+') || (peek == '-')) {
            ch = xfgetc (sourcefile);
            token(token_nextfree++) = ch;
          }
          if (!acceptable_range(peek)) {
            token(token_nextfree) = '\0';
            fprintf(stderr, "Warning: bad floating point literal '%s'\n", token);
          }
          while (acceptable_range(peek)) { // SHOULD pick up P12L etc
            makespace (token, token_nextfree+2);
            ch = xfgetc (sourcefile); // what was peek is now ch
            token(token_nextfree++) = ch; // 0
          }
          if ((peek == 'f') || (peek == 'F') || (peek == 'l') || (peek == 'L')) {
            ch = xfgetc (sourcefile);
            token(token_nextfree++) = ch;
          }
        }
      } else if ((peek == 'u') || (peek == 'U')) {
//fprintf(stderr, "Peek U...\n");
        ch = xfgetc (sourcefile);
        token(token_nextfree++) = ch;
      } else if ((peek == 'l') || (peek == 'L')) {
//fprintf(stderr, "Peek L...\n");
        ch = xfgetc (sourcefile);
        token(token_nextfree++) = ch;
        if (ch == peek) { // 'll' or 'LL' allowed but not 'lL' or 'Ll'
          ch = xfgetc (sourcefile);
          token(token_nextfree++) = ch;
        }
d634 5
a638 1
//fprintf(stderr, "No ELSE...\n");
d640 15
a654 8
//token(token_nextfree) = '\0';fprintf(stderr, "STORE!... token='%s'\n", token);
      makespace (token, token_nextfree+1);
      token(token_nextfree++) = '\0';
      if (strchr(token, '.') == NULL) {
//fprintf(stderr, "STORE integer const!... '%s'\n", token);
        stores (token,
                token_lineno, startcol, token_pos,
                B_integer_constant, curfile); // changed from col to startcol
d656 5
a660 4
//fprintf(stderr, "STORE floating const!... '%s'\n", token);
        stores (token,
                token_lineno, startcol, token_pos,
                B_floating_constant, curfile); // changed from col to startcol
d662 9
a670 153
    } else {
      switch (ch) {

      case '\'':               // Handle 'c' char const
      case '"':                // Handle "string"
        /* literals */
        startline = FALSE;
        {
          int string_nextfree = 0, string_arraysize = 0, quotech = ch;
          char *string = NULL;

          for (;;) {
            ch = xfgetc (sourcefile);   // Newlines are allowed
            makespace (string, string_nextfree+3);
            if (ch == '\\') {
              ch = xfgetc (sourcefile);
              if (ch == '\\') {
                string[string_nextfree++] = ch;
              } else if (ch == '\'') {
                string[string_nextfree++] = '\'';
              } else if (ch == '"') {
                string[string_nextfree++] = '"';
              } else if (ch == 'n') {
                string[string_nextfree++] = '\n';
              } else if (ch == 'r') {
                string[string_nextfree++] = '\r';
              } else if (ch == 't') {
                string[string_nextfree++] = '\t';
              } else if (ch == '0') {
                string[string_nextfree++] = '\0';
              } else {
                // Warn of unknown (to me) \x escape.  Probably an error.
                string[string_nextfree++] = '\\';
                string[string_nextfree++] = ch;
                fprintf(stderr, "Warning: un-handled escape '\\%c'\n", ch);
              }
            } else if (ch != quotech) {
              string[string_nextfree++] = ch;
            } else {
              string[string_nextfree] = '\0';
              break;
            }
          }

          if (quotech == '\'') {
            int stringlen = 0;
            char *s;
            stores (string,
                    token_lineno, token_col, token_pos,
                    B_character_constant, curfile);
            s = string;
            while (*s != '\0') {
              if (*s == '\\') s += 2; else s += 1;
              stringlen += 1;
            }
            if (stringlen == 1) {
              // good char const
            } else if (stringlen <= 4) {
              // Warn that 'xx' as a 32-bit int is a non-standard extension
              fprintf(stderr, "Warning: multi-byte characters constants such as \'%s\' are not well supported.\n", string); // don't escape - already escaped
            } else {
              // Warn that this is probably a string with the wrong type of quote.
              fprintf(stderr, "Warning: wrong kind of string quote used? - \'%s\'.\n", string); // don't escape - already escaped
            }
          } else stores (string,
                         token_lineno, token_col, token_pos,
                         B_string, curfile);
          free (string);
        }
        break;

      case '/':
        /* COMMENTS (or just a divide symbol) */

        startline = FALSE;
        if (peek == '/') { // comment to end of line
          //  '//' comments are part of whitespace - skip over them, but whitespace_start must not be updated
          do {
            ch = xfgetc (sourcefile);
          } while (ch != '\n');

        } else if (peek == '*') { /* Handle potential multi-line comment */
          ch = xfgetc (sourcefile);     //  '/* ... */' comments are part of whitespace - skip over them, but whitespace_start must not be updated
          for (;;) {
            ch = xfgetc (sourcefile);
            if ((ch == '*') && (peek == '/')) {
              ch = xfgetc (sourcefile); // get the '/' too.
              break;
            }
          }
        } else {
          // a divide symbol, not a comment
          storec (ch,
                  token_lineno, token_col-1, token_pos,
                  B_char, curfile); 
        }
        break;

        // WHITESPACE
      case '\n':
      case '\r':
        startline = TRUE;
        break;

      case '\t':
      case ' ':
        // white space does not affect startline.
        break;

        // DIRECTIVES
      case '#':
        // should allow '#' as a directive if startline is true. (and not in a comment of course)
        // for now we'll just copy # directives straight through to the output
        if (startline) {
          int i = 0, lastch = -1;
          static char CPP_directive[256]; // small for now. Will make flex once tested.
          for (;;) {
            ch = xfgetc (sourcefile);
            if (ch == EOF) exit(1);// fix
            ch &= 255;
            if ((ch == '\n') && (lastch != '\\')) { // e.g. #define X  some multiline text with '\' at the end of all lines except the last
              break;
            }
            CPP_directive[i++] = ch;
            lastch = ch;
            if (i == 255) {
              // skip any more text for now.
              for (;;) {
                ch = xfgetc (sourcefile);
                if (ch == EOF) exit(1);// fix
                ch &= 255;
                if (ch == '\n' && lastch != '\\') {
                  break;
                }
                lastch = ch;
              }
              break;
            }
          }
          CPP_directive[i] = '\0';
          fprintf(stderr, "Warning: pre-processor directive skipped: #%s\n", CPP_directive);
          ch = '\n';
          startcol = nextch_col;
          startline = TRUE;
          break;
        }
        // Drop through

      default:
        storec (ch,
                token_lineno, token_col, token_pos,
                B_char, curfile);
        startline = FALSE;
d672 1
d674 27
a700 1
#endif
d782 1
a782 1
            optional?"?":negated?"!":"", phrasename((pp&DROP_SPECIAL_BITS) - 512));
d787 1
a787 1
  parse_stack(depth) = phrasename(pp - 512);
d790 1
a790 1
  gp = phrase_start(pp - 512 - MAX_BIP);
d798 1
a798 1
             optional?"?":negated?"!":"", phrasename((pp&DROP_SPECIAL_BITS) - 512),
d827 1
a827 1
      if (((gram(gp + each)&DROP_SPECIAL_BITS) >= 512) && ((gram(gp + each)&DROP_SPECIAL_BITS) < SEMANTIC))
d858 1
a858 1
        } else if (phrase < 512) {
d860 2
a861 2
        } else if (phrase < 512+MAX_BIP) {
          saved_descp += sprintf (saved_descp, " {%s/BIP%d}", phrasename(phrase - 512), BIP(phrase - 512)); // or a BIP
d863 1
a863 1
          saved_descp += sprintf (saved_descp, " <%s%s/%d>", optional?"?":negated?"!":"", phrase==WHITESPACE ? "sp" : phrasename(phrase - 512), phrase);
d888 1
a888 1
                 (cp < c_nextfree ? &C_s(cp) : "EOF"), (cp + 1 < c_nextfree ? &C_s(cp + 1) : "EOF"), (cp + 2 < c_nextfree ? &C_s(cp + 2): "EOF"));
d897 5
a901 5
          sprintf (s, "<%s%s> '%c'", optional?"?":negated?"!":"", phrasename(pp - 512), phrase);
        } else if (phrase < 512) {
          sprintf (s, "<%s%s> \"%s\"", optional?"?":negated?"!":"", phrasename(pp - 512), keyword(phrase - 256));
        } else if (phrase < 512+MAX_BIP) {
          sprintf (s, "<%s%s> {%s}", optional?"?":negated?"!":"", phrasename(pp - 512), phrasename(phrase - 512));
d903 1
a903 1
          sprintf (s, "<%s%s> <%s>", optional?"?":negated?"!":"", phrasename(pp - 512), phrase==WHITESPACE ? "sp" : phrasename(phrase - 512));
d906 1
a906 1
          sprintf (s, "<%s%s> {%s}", optional?"?":negated?"!":"", phrasename(pp - 512), semantic_code[phrase-SEMANTIC]);
d924 1
a924 1
        if ((c(cp).t != B_char) || (*&C_s(cp) != phrase)) {
d934 1
a934 1
      } else if (phrase < 512) {  /* Keyword */
d940 27
a966 1
        if ((c(cp).sIndex == -1) || (strcmp (keyword(phrase - 256), &C_s(cp)) != 0)) {
d978 2
a979 1
      } else if (phrase < (512+MAX_BIP)) {  /* Built-in phrase */
d983 1
a983 1
          fprintf (outfile, "{%s/BIP%d}", phrasename(phrase - 512), BIP(phrase - 512));
d985 1
a985 1
        if (c(cp).t != BIP(phrase - 512)) {
d998 1
a998 1
        while ((c(cp).t == B_char) && (&C_s(cp) != NULL) && (*&C_s(cp) == ' ')) {
d1012 1
a1012 1
          fprintf (outfile, "Try next alt: <%s%s/%d>", optional?"?":negated?"!":"", phrasename(phrase - 512), phrase);
d1022 1
a1022 1
            fprintf (outfile, "Alt <%s%s/%d> succeeded", optional?"?":negated?"!":"", phrasename(phrase - 512), phrase);
d1043 1
a1043 1
            fprintf (outfile, "Alt <%s%s/%d> failed", optional?"?":negated?"!":"", phrasename(phrase - 512), phrase);
d1109 1
a1109 1
  if ((phrase < 512) || (phrase > MAX_PHRASE+512)) {
a1117 34
// This grammar is loosely based on the grammar from:

//   https://cs.wmich.edu/~gupta/teaching/cs4850/sumII06/The%20syntax%20of%20C%20in%20Backus-Naur%20form.htm

// - unfortunately when you get down to using it, there are several errors and omissions in that grammar
// which had to be fixed.  Also, that grammar is written assuming a left-recursive style of parsing, whereas
// our parser has to be right-recursive or it will get into infinite loops.

// A few constructs (especially concerning lvalues vs rvalues) which were handled totally by
// semantic rules if using the grammar above have been handled using a slightly rewritten
// syntax in my modification of the grammar.

// Some of the ambiguities of that grammar were also fixed using the information in:

//   https://en.cppreference.com/w/c/language/operator_precedence

// The grammar is extracted from the comments in c-gram.c using grep, and is converted
// into a set of tables using the program "takeon.c".

// The code to take the parse tree and construct an AST from it was generated from the
// grammar, using the utility "create_parser.c".  The first iteration of the parse tree
// is really a "Concrete Syntax Tree" rather than an Abstract Syntax Tree, i.e. the
// generated code below initially builds an AST which reflects the raw text that was
// matched by the parser.  Eventually this code will be modified to produce a more
// realistic AST where the "A" truly does stand for "Abstract".

// At some point once the C code in extended-grammar-format.c is modified, it will
// no longer make sense to rebuild it from the compiled grammar.

// Some work may be needed to re-order tree branches to ensure left-to-right and
// right-to-left order of precedence for some of the operations.

// And here is the entire grammar.  The entry point is phrase "SS" (Source Statement).

d1148 2
a1149 2
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>512?phrasename(astop-512):phrasename(astop));
      fprintf(stderr, "%s> ", &C_s(data0));
d1152 2
a1153 2
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>512?phrasename(astop-512):phrasename(astop));
      fprintf(stderr, "%s> ", &C_s(data0));
d1156 2
a1157 2
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>512?phrasename(astop-512):phrasename(astop));
      fprintf(stderr, "'%s'> ", &C_s(data0));
d1160 2
a1161 2
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>512?phrasename(astop-512):phrasename(astop));
      fprintf(stderr, "%s> ", &C_s(data0));
d1164 2
a1165 2
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>512?phrasename(astop-512):phrasename(astop));
      fprintf(stderr, "\"%s\"> ", &C_s(data0));
d1186 1
a1186 1
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>512?phrasename(astop-512):phrasename(astop));
d1190 1
d1192 2
a1193 3
      fprintf(stderr, "<%s%s=", optional?"?":negated?"!":"", astop>512?phrasename(astop-512):phrasename(astop));
      fprintf(stderr, "{? %d ?} > ", astop);
#endif
d1196 11
a1206 2
    //fprintf(stderr, "<phrase %d> ", astop);
    fprintf(stderr, " <%s%s> ", optional?"?":negated?"!":"", astop>512?phrasename(astop-512):phrasename(astop));
d1236 1
a1236 1
      fprintf(stdout, " %s ", &C_s(data0));
d1239 1
a1239 1
      fprintf(stdout, " %s ", &C_s(data0));
d1242 1
a1242 1
      fprintf(stdout, "'%s'", escape(&C_s(data0), '\'')); // \\ in input needs special handling.
d1246 1
a1246 1
      fprintf(stdout, " %s ", &C_s(data0));
d1249 1
a1249 1
      fprintf(stdout, "\"%s\"", escape(&C_s(data0), '"'));
d1271 4
d1276 1
a1276 2
      fprintf(stdout, "/* %d */ ", astop);
#endif
d1301 1
a1301 1
  // C_s(i) is  stringpool[c(i).sIndex]
d1326 1
a1326 1
      //fprintf(stdout, "'%s'", escape(&C_s(data0), '\'')); // \\ in input needs special handling.
d1334 1
a1334 1
      //fprintf(stdout, "\"%s\"", escape(&C_s(data0), '"'));
d1385 4
d1390 2
a1391 2
      fprintf(out, "/* BUG: %d */ ", astop);
#endif
d1419 3
a1421 1
    if ((AST(i)>=0) && (AST(AST(i)+1)>=MAX_BIP)) print_ast(AST(i), depth+1);  // MAX_BIP? Not 512+MAX_BIP?  CHECK!!!
d1425 6
a1430 1
void print_prog(int astp, int depth, FILE *out) {  // IMPORTANT!!!! This works on AST, not AREC.
d1435 10
a1444 2
    if ((subphrase_addr >= 0) && (AST(subphrase_addr+1)>=512+MAX_BIP)) {
      print_prog(subphrase_addr, depth+1, out);
d1484 2
a1485 2
    fprintf(stderr, "A(%d)=%d char '%s'\n", i, A(i), &C_s(A(i+3)));
  } else if (phrase < 512) {
d1487 2
a1488 2
    fprintf(stderr, "A(%d)=%d keyword \"%s\"\n", i, A(i), &C_s(A(i+3)));
  } else if (phrase < 512+MAX_BIP) {
d1490 1
a1490 1
    fprintf(stderr, "A(%d)=%d B<%s%s>, ", i, A(i), optional?"?":negated?"!":"", phrasename(A(i)-512));
d1492 1
a1492 1
      fprintf(stderr, "choice %d: '%s'\n", A(i+1), &C_s(A(i+3)));
d1498 1
a1498 1
    fprintf(stderr, "A(%d)=%d P<%s%s>, ", i, phrase, optional?"?":negated?"!":"", phrase==WHITESPACE ? "sp" : phrasename(phrase-512));
d1502 3
a1504 1
        fprintf(stderr, "A(%d)=%d [X] ", p, A(p));
d1540 5
a1544 5
    if (negated == 0 && optional == 0) RECONSTITUTE(A(i+3), stderr); // fprintf(stderr, "'%s'", &C_s(A(i+3)));
  } else if (phrase < 512) {
    if (negated == 0 && optional == 0) RECONSTITUTE(A(i+3), stderr); // fprintf(stderr, "<%s>", &C_s(A(i+3)));
  } else if (phrase < 512+MAX_BIP) {
    if (negated == 0 && optional == 0) RECONSTITUTE(A(i+3), stderr); // fprintf(stderr, "[%s]", &C_s(A(i+3)));
d1558 195
d1851 1
a1851 1
      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(&C_s(i),'"'), &C_s(i));
d1860 2
a1861 2
    //if (cp == c_nextfree) break; // End of file?
    ap = 0; // reset analysis record on each line. We're not parsing the entire program here.
d1863 7
a1869 9
    if ((SS = parse (P_SS, 0)) != 0) {
      int i;
 
      if (debug_tokens) {
        fflush(stderr); fflush(stdout);
        fprintf(stderr, "Tokens (line reconstruction and BIPs):\n");
        for (i = 0; i <= c_nextfree; i++) {
          fprintf(stderr, "c(%d).s = \"%s\" t=%d\n", i, escape(&C_s(i), '"'), c(i).t);
        }
d1871 8
d1880 21
a1900 32
      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), &C_s(A(i+3)));
            i = i + 3 + phrases;
          } else if (phrase < 512) {
            fprintf(stderr, "A(%3d)=%3d keyword \"%s\"\n", i, A(i), &C_s(A(i+3)));
            i = i + 3 + phrases;
          } else if (phrase < 512+MAX_BIP) {
            fprintf(stderr, "A(%3d)=%3d B<%s%s>, ", i, A(i), optional?"?":negated?"!":"", phrasename(A(i)-512));
            if (phrases) {
              fprintf(stderr, "choice %d: '%s'\n", A(i+1), &C_s(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-512));
            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;
d1902 1
a1902 2
            // SEMANTIC PHRASE
            fprintf(stderr, "@@@@@@ i=%d A(i)=%d @@@@@@\n", i, A(i));
d1904 4
d1909 11
a1919 1
        fflush(stderr); fflush(stdout);
d1921 5
a1925 8
        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);
      }
d1927 14
a1940 3
      if ( debug_ast) {
        fprintf(stderr, "Build ast:\n");
      }
d1942 6
a1947 21
      program = build_ast(/*SS*/0, 0);

      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);

        fprintf(stderr, "Regenerate source from AST: %d\n", program);
        fflush(stderr); fflush(stdout);
        print_prog(program, 0, stderr);
        RECONSTITUTE(c_nextfree, stderr);// force out whitespace before EOF
        fprintf(stderr, "\n\n");
        fflush(stderr); fflush(stdout);
      }
    } else {
      errors += 1;
d1949 3
d1956 3
a1958 2
    print_prog(program, 0, stdout); // for now...
    RECONSTITUTE(c_nextfree, stdout);// force out whitespace before EOF
d1973 2
a1974 2
          fprintf (stderr, "%s ", &C_s(i));  // when MINSIZE in makespace is too low, this string is corrupted...
          ic += strlen(&C_s(i));
d1983 2
a1984 2
        fprintf (stderr, "%s ", &C_s(i));
        ic += strlen(&C_s(i));
@
