# included in imp80.g



# TO DO: a line reconstruction that just works from the current location to <nl> or ';'
# which can be called after <COLON> if a guard tells us a '!' or "comment" follows.

# One solution I only just now thought of... make line reconstruction an explicit
# parse-time grammar call (C<...>) but instead of processing up to the end of line,
# stop on a ':' as well.  And then insert another call in the grammar after every
# colon *except* the one at the RHS of a label, where an alternative line reconstruction
# could be applied that preserves the spaces and case within comments for re-outputting
# in C ...


# The majority of phrases cause code execution only after the entire program
# has been parsed and built up into a concrete syntax tree or an abstract
# syntax tree. (We support both).  These rules are introduced by P<...>

# NOTE that the returned value from a child phrase is a tuple returned by P_mktuple().
# By default, these will be P_* phrases that exactly mirror the phrase structure,
# however a programmer can construct any kind of tuple they like and return a
# private phrase number which merely has to be outside the range used by the
# parser generator.  This enables the creation of 'proper' AST objects that
# reflect the actual structure of the program being compiled.  To avoid clashing
# tag numbers, I recommend naming tags as AST_* with the index of first tag
# set to NUM_GRAMMAR+1, as in:

{

#define compile(P,d) compile_inner(P,d,__FILE__,__LINE__)
int compile_inner(int Ph, int depth, const char *file, const int line);

  typedef enum AST_CODE {
    AST_LVALUE = NUM_GRAMMAR+1,        // VarDeclIDX - variable, name, map call
    AST_RVALUE,                        // VarDeclIDX - variable, fn call, etc
    AST_EXPRESSION,                    // EXPR - replacement for P<EXPR> after applying precedence
    AST_TYPE_INFORMATION,              // TypeDeclIDX inferred type of expressions, constructed bottom-up by inference (eg int * real => real)
    AST_USER_PARENS,                   // EXPR  -- for generating C source with included user brackets.
    AST_BINARY_ARITHMETIC_OPERATION,   // OP, LEFT, RIGHT
    AST_UNARY_ARITHMETIC_OPERATION,    // OP, ARG
    AST_ASSIGN,                        // OP, LEFT, RIGHT
    AST_PROC_CALL,                     // PROC, FPP_LIST, APP_LIST
    AST_ARRAYACCESS,                   // ARRAY, DIM_LIST, APP_LIST
    AST_BINOP,                         // OP (str), OP (code)
    AST_MONOP,                         // OP (str), OP (code)
    AST_ASSOP,                         // OP (str), OP (code)
    AST_LAST_OP // Do NOT add any after this item.
  } AST_CODE;

  // /home/gtoal/src/compilers101/new-parser/imps/tests/progs/imp80pass2.i
  //%const %byte %integer %array PRECEDENCE(0:20)=0,3,3,4,5,5,4,3,3,4,4,5,5,3,5,5,
  //                                              0(3),3,5
  
  //%const %byte %integer %array OPVAL(0:20)=0,ADD,SUB,ANDL,IEXP,REXP,MULT,NONEQ,
  //                  ORL,INTDIV,REALDIV,RSHIFT,LSHIFT,ADD,IEXP,REXP,0(3),LNEG,NOTL
                                
  typedef enum Oper {
    OP_NONE=0,
    OP_ADD,
    OP_SUB,
    OP_AND,
    OP_IEXP,
    OP_REXP,
    OP_MULT,
    OP_EOR,
    OP_OR,
    OP_INTDIV,
    OP_REALDIV,
    OP_RSHIFT,
    OP_LSHIFT,
    OP_CONCAT,
    OP_NEG,
    OP_NOT,
    OP_POS,
    OP_LPAREN,
    OP_RPAREN,

    // not added to table.  May not need to as we are not handling assignments using TORP.
    OP_ASSIGN_ADDR,
    OP_ASSIGN_VALUE,
    OP_JAM_TRANSFER,
    OP_UNCOND_STR_RESOL,

    // Not even thinking about handling conditionals with TORP at this point.
    OP_BOOLAND,
    OP_BOOLOR,
    OP_BOOLNOT,
  } Oper;
  
  typedef enum Assoc {
    Left=1, Right
  } Assoc;
  
  typedef struct Torpedo {
    Oper Op;
    int Prec;
    int Assoc;
    int Arity;
    char *C_left, *C_mid, *C_right;
    int C_prec;
    wchar_t *Sym; // Debugging info only
  } Torpedo;

  // atoms should get C_prec of either 11 or 0. I'm not sure which yet.
  // C precedences taken from https://en.cppreference.com/w/c/language/operator_precedence
  // Note I carelessly numbered IMP precedences as 0 -> lowest and 6 -> highest,
  // but C precedences as 11 -> lowest and 0 -> highest!  Needs to be fixed.  Fortunately
  // they're handled separately so the mistake never manifests.

  #define ATOMPRIO 0

  const Torpedo OpDetails [] = {
    { OP_NONE,     0,   Left, 0, "", "*BADOP*", "",       ATOMPRIO, L"*ERROR*"    }, // (I always prefer to keep 0 free to catch unassigned errors)
    { OP_ADD,      3,   Left, 2, "", " + ", "",                  4, L"OP_ADD"     }, // "+"
    { OP_SUB,      3,   Left, 2, "", " - ", "",                  4, L"OP_SUB"     }, // "-"
    { OP_AND,      4,   Left, 2, "", " & ", "",                  8, L"OP_AND"     }, // "&"
    { OP_IEXP,     5,  Right, 2, "IEXP(", ", ", ")",      ATOMPRIO, L"OP_IEXP"    }, // "****" or "\\".  \\ is the Imp77 preferred operator.  Right associative.
    { OP_REXP,     5,  Right, 2, "REXP(", ", ", ")",      ATOMPRIO, L"OP_REXP"    }, // "**" or "\"      \  in Imp77
    { OP_MULT,     4,   Left, 2, "", " * ", "",                  3, L"OP_MULT"    }, // "*"
    { OP_EOR,      3,   Left, 2, "", " ^ ", "",                  9, L"OP_EOR"     }, // "!!"
    { OP_OR,       3,   Left, 2, "", " | ", "",                 10, L"OP_OR"      }, // "!" or "|"  (suprisingly '|' is also allowed for comments! ))
    { OP_INTDIV,   4,   Left, 2, "", " / ", "",                  3, L"OP_INTDIV"  }, // "//"
    { OP_REALDIV,  4,   Left, 2, "", " / ", "",                  3, L"OP_REALDIV" }, // "/"
    { OP_RSHIFT,   5,   Left, 2, /*"(unsigned)"*/"", " >> ", "", 5, L"OP_RSHIFT"  }, // ">>"    // UNSIGNED needs a size - char/short/int/long/long long
    { OP_LSHIFT,   5,   Left, 2, "", " << ", "",                 5, L"OP_LSHIFT"  }, // "<<"
    { OP_CONCAT,   5,   Left, 2, "", ".", "",                    1, L"OP_CONCAT"  }, // "."  // The only string operator.  All others are invalid. So prio is irrelevant.
    { OP_NEG,      3,   Left, 1, "", "-", "",                    2, L"OP_NEG"     }, // "-"  // Precedence of '-' is surprisingly low, and responsible for the -1>>1 inanity.
    { OP_NOT,      6,   Left, 1, "", "~", "",                    2, L"OP_NOT"     }, // "\" or "~"
    { OP_POS,      6,   Left, 1, "", "+", "",                    2, L"OP_POS"     }, // "+"
    { OP_LPAREN,   0,   Left, 0, "(", "", "",             ATOMPRIO, L"OP_LPAREN"  }, // "("  // '(' and ')' do not survive as far as an ExPop() call.
    { OP_RPAREN,   0,  Right, 0, ")", "", "",             ATOMPRIO, L"OP_RPAREN"  }, // ")"
    // Note: Imp Modulus (really Absolute value) (originally !expr! and later |expr| ) is not supported in Imp80, and replaced by MOD() or IMOD().
    // The C operator '%' (Modulo) is a perm call in Imp77: REM(a,b).
  };
  
  typedef struct Op_or_Data {
    char type; // 'O' or 'D' (we'll distinguish between 'C' or 'V' later - constant or variable)
    int idx;   // Torpedo or AST index depending on type above.
  } Op_or_Data;
  
  
  typedef struct ast_lvalue                        {
    int atom; // variable, map, name
  } ast_lvalue;
  
  typedef struct ast_rvalue                        {
    int atom; // variable, fn, proc, const etc - effectively an operand. but not an expr.
  } ast_rvalue;
  
  typedef struct ast_expression                    {
    int whatever;
  } ast_expression;
  
  typedef struct ast_type_information              {
    int blah;
  } ast_type_information;
  
  typedef struct ast_user_parens                   {
    int Expr;
  } ast_user_parens;
  
  typedef struct ast_binary_arithmetic_operation   {
    Oper binop;
    int left, right;
  } ast_binary_arithmetic_operation;
  
  typedef struct ast_unary_arithmetic_operation    {
    Oper monop;
    int arg;
  } ast_unary_arithmetic_operation;

  typedef struct ast_assign   {
    Oper assop;
    int LHS, RHS;
  } ast_assign;
  
  typedef struct ast_proc_call   {
    int Proc, Types, Args;
  } ast_proc_call;
  
  typedef struct ast_array_access   {
    int Array, Dims, Indices;
  } ast_array_access;
  
  typedef struct ast_binop   {
    int OpStr;
    Oper OpCode;
  } ast_binop;
  
  typedef struct ast_monop   {
    int OpStr;
    Oper OpCode;
  } ast_monop;
  
  typedef struct ast_assop   {
    int OpStr;
    Oper OpCode;
  } ast_assop;
  
  // Rough draft
  // Although the AST is a simple array of ints, it's cleaner if we overlay a struct over the ints
  // when accessing tuples, so that we don't have to remember offsets into the AST fields, which
  // from previous experience with the last imptoc was the cause of several coding errors.
  typedef struct AST_struct {
    AST_CODE                            ast_code;  // reserved field
    int                                 op;
    int                                 alt;
    int                                 phrases;
    int                                 Hidden_fields[TUPLE_RESULT_FIELDS];
    union {                             // (anonymous unions are a gcc extension)
      ast_lvalue                        lvalue;
      ast_rvalue                        rvalue;
      ast_expression                    expression;
      ast_type_information              type_information;
      ast_user_parens                   user_parens;
      ast_binary_arithmetic_operation   binary_arithmetic_operation;
      ast_unary_arithmetic_operation    unary_arithmetic_operation;
      ast_assign                        assign;
      ast_proc_call                     proc_call;
      ast_array_access                  array_access;
    };
  } AST_struct;

  // rather than have an awkward new syntax such as %prim (23) %routine BLAH, I'll use a parallel list of names
  // as a lookup table to an index, and enums to index a switch table
  static const char *prim[] = {
    "**BADPRIM**",
    "SELECTINPUT",
    "SELECTOUTPUT",
    "NEWLINE",
    "SPACE",
    "SKIPSYMBOL",
    "READSTRING",
    "NEWLINES",
    "SPACES",
    "NEXTSYMBOL",
    "PRINTSYMBOL",
    "READSYMBOL",
    "READ",
    "WRITE",
    "NEWPAGE",
    "ADDR",
    "ARCSIN",
    "INT",
    "INTPT",
    "FRACPT",
    "PRINT",
    "PRINTFL",
    "REAL",
    "INTEGER",
    "MOD",
    "ARCCOS",
    "SQRT",
    "LOG",
    "SIN",
    "COS",
    "TAN",
    "EXP",
    "CLOSESTREAM",
    "BYTEINTEGER",
    "EVENTINF",
    "RADIUS",
    "ARCTAN",
    "LENGTH",
    "PRINTSTRING",
    "NL",
    "LONGREAL",
    "PRINTCH",
    "READCH",
    "STRING",
    "READITEM",
    "NEXTITEM",
    "CHARNO",
    "TOSTRING",
    "SUBSTRING",
    "RECORD",
    "ARRAY",
    "SIZEOF",
    "IMOD",
    "PI",
    "EVENTLINE",
    "LONGINTEGER",
    "LONGLONGREAL",
    "LENGTHENI",
    "LENGTHENR",
    "SHORTENI",
    "SHORTENR",
    "NEXTCH",
    "HALFINTEGER",
    "PPROFILE",
    "FLOAT",
    "LINT",
    "LINTPT",
    "SHORTINTEGER",
    "TRUNC",
  };

  typedef enum IMP_PRIM {
    PRIM_SELECTINPUT = 1,
    PRIM_SELECTOUTPUT,
    PRIM_NEWLINE,
    PRIM_SPACE,
    PRIM_SKIPSYMBOL,
    PRIM_READSTRING,
    PRIM_NEWLINES,
    PRIM_SPACES,
    PRIM_NEXTSYMBOL,
    PRIM_PRINTSYMBOL,
    PRIM_READSYMBOL,
    PRIM_READ,
    PRIM_WRITE,
    PRIM_NEWPAGE,
    PRIM_ADDR,
    PRIM_ARCSIN,
    PRIM_INT,
    PRIM_INTPT,
    PRIM_FRACPT,
    PRIM_PRINT,
    PRIM_PRINTFL,
    PRIM_REAL,
    PRIM_INTEGER,
    PRIM_MOD,
    PRIM_ARCCOS,
    PRIM_SQRT,
    PRIM_LOG,
    PRIM_SIN,
    PRIM_COS,
    PRIM_TAN,
    PRIM_EXP,
    PRIM_CLOSESTREAM,
    PRIM_BYTEINTEGER,
    PRIM_EVENTINF,
    PRIM_RADIUS,
    PRIM_ARCTAN,
    PRIM_LENGTH,
    PRIM_PRINTSTRING,
    PRIM_NL,
    PRIM_LONGREAL,
    PRIM_PRINTCH,
    PRIM_READCH,
    PRIM_STRING,
    PRIM_READITEM,
    PRIM_NEXTITEM,
    PRIM_CHARNO,
    PRIM_TOSTRING,
    PRIM_SUBSTRING,
    PRIM_RECORD,
    PRIM_ARRAY,
    PRIM_SIZEOF,
    PRIM_IMOD,
    PRIM_PI,
    PRIM_EVENTLINE,
    PRIM_LONGINTEGER,
    PRIM_LONGLONGREAL,
    PRIM_LENGTHENI,
    PRIM_LENGTHENR,
    PRIM_SHORTENI,
    PRIM_SHORTENR,
    PRIM_NEXTCH,
    PRIM_HALFINTEGER,
    PRIM_PPROFILE,
    PRIM_FLOAT,
    PRIM_LINT,
    PRIM_LINTPT,
    PRIM_SHORTINTEGER,
    PRIM_TRUNC,
  } IMP_PRIM;

  // By the way, the EMAS3 "IOPT" Imp80 compiler is at http://www.gtoal.com/history.dcs.ed.ac.uk/archive/os/emas/emas2/compilers/imputils/trimp
  // (see https://history.dcs.ed.ac.uk/archive/os/emas/emas3/docs/ioptnotes.html for differences from EMAS2 Imp80
  // and also https://www.ancientgeek.org.uk/EMAS/ERCC_User_Notes/ERCC_User_Note_058.pdf )
  // Although this code is mostly following Peter Stephens Imp to C code which is based on the same EMAS2 Imp80
  // that Bob Eager's Imp80 implements.
  
  // In the ERCC compiler, these built-in procedures are all implemented by the compiler itself rather than as externals.
  // It will be easier to just parse them in source form than to pre-build a data structure with the declaration info.

  static const char *Prims[69 /*0:68*/] = {
    "**BADPRIM**",
    "%prim %routine %spec SELECT INPUT(%integer STREAM)",
    "%prim %routine %spec SELECT OUTPUT(%integer STREAM)",
    "%prim %routine %spec NEWLINE",
    "%prim %routine %spec SPACE",
    "%prim %routine %spec SKIP SYMBOL",
    "%prim %routine %spec READ STRING(%string %name S)",
    "%prim %routine %spec NEWLINES(%integer N)",
    "%prim %routine %spec SPACES(%integer N)",
    "%prim %integer %fn %spec NEXT SYMBOL",
    "%prim %routine %spec PRINT SYMBOL(%integer SYMBOL)",
    "%prim %routine %spec READ SYMBOL(%name SYMBOL)",
    "%prim %routine %spec READ(%name NUMBER)",
    "%prim %routine %spec WRITE(%integer VALUE,PLACES)",
    "%prim %routine %spec NEWPAGE",
    "%prim %integer %fn %spec ADDR(%name VARIABLE)",
    "%prim %long %real %fn %spec ARCSIN(%long %real X)",
    "%prim %integer %fn %spec INT(%long %real X)",
    "%prim %integer %fn %spec INTPT(%long %real X)",
    "%prim %long %real %fn %spec FRACPT(%long %real X)",
    "%prim %routine %spec PRINT(%long %real NUMBER,%integer BEFORE,AFTER)",
    "%prim %routine %spec PRINTFL(%long %real NUMBER,%integer PLACES)",
    "%prim %real %map %spec REAL(%integer VAR ADDR)",
    "%prim %integer %map %spec INTEGER(%integer VAR ADDR)",
    "%prim %long %real %fn %spec MOD(%long %real X)",
    "%prim %long %real %fn %spec ARCCOS(%long %real X)",
    "%prim %long %real %fn %spec SQRT(%long %real X)",
    "%prim %long %real %fn %spec LOG(%long %real X)",
    "%prim %long %real %fn %spec SIN(%long %real X)",
    "%prim %long %real %fn %spec COS(%long %real X)",
    "%prim %long %real %fn %spec TAN(%long %real X)",
    "%prim %long %real %fn %spec EXP(%long %real X)",
    "%prim %routine %spec CLOSE STREAM(%integer STREAM)",
    "%prim %byte %integer %map %spec BYTE INTEGER(%integer VAR ADDR)",
    "%prim %integer %fn %spec EVENTINF",
    "%prim %long %real %fn %spec RADIUS(%long %real X,Y)",
    "%prim %long %real %fn %spec ARCTAN(%long %real X,Y)",
    "%prim %byte %integer %map %spec LENGTH(%string %name  S)",
    "%prim %routine %spec PRINT STRING(%string(255) STR)",
    "%prim %integer %fn %spec NL",
    "%prim %long %real %map %spec LONG REAL(%integer VAR ADDR)",
    "%prim %routine %spec PRINT CH(%integer CHARACTER)",
    "%prim %routine %spec READ CH(%name CHARACTER)",
    "%prim %string %map %spec STRING(%integer VAR ADDR)",
    "%prim %routine %spec READ ITEM(%string %name ITEM)",
    "%prim %string (1) %fn %spec NEXT ITEM",
    "%prim %byte %integer %map %spec CHARNO(%string %name STR,%integer CHAR REQD)",
    "%prim %string (1) %fn %spec TO STRING(%integer ch)",
    "%prim %string (255) %fn %spec SUB STRING(%string(255) STR, %integer FIRST, LAST)",
    "%prim %record (*) %map %spec RECORD(%integer REC ADDR)",
    "%prim %array %map %spec ARRAY(%integer A1ADDR,%array %name FORMAT)",
    "%prim %integer %fn %spec SIZEOF(%name X)",
    "%prim %integer %fn %spec IMOD(%integer VALUE)",
    "%prim %long %real %fn %spec PI",
    "%prim %integer %fn %spec EVENTLINE",
    "%prim %long %integer %map %spec LONGINTEGER(%integer ADR)",
    "%prim %long %long %real %map %spec LONGLONGREAL(%integer ADR)",
    "%prim %long %integer %fn %spec LENGTHENI(%integer VAL)",
    "%prim %long %long %real %fn %spec LENGTHENR(%long %real VAL)",
    "%prim %integer %fn %spec SHORTENI(%long %integer VAL)",
    "%prim %long %real %fn %spec SHORTENR(%long %long %real VAL)",
    "%prim %integer %fn %spec NEXTCH",
    "%prim %half %integer %map %spec HALFINTEGER(%integer ADDR)",
    "%prim %routine %spec PPROFILE",
    "%prim %long %real %fn %spec FLOAT(%integer VALUE)",
    "%prim %long %integer %fn %spec LINT(%long %long %real X)",
    "%prim %long %integer %fn %spec LINTPT(%long %long %real X)",
    "%prim %short %integer %map %spec SHORTINTEGER(%integer N)",
    "%prim %integer %fn %spec TRUNC(%long %real X)",
  };

  // For diagnostics:
  static char *TypeName[32] = {
    // CST
    "*ERROR(0)*", "CST:BIP_TYPE", "CST:PHRASE_TYPE", "CST:SEMANTIC_TYPE", "CST:KEYWORD_TYPE",
    "CST:CHAR_TYPE", "CST:UTF32CHAR_TYPE", "CST:STRING_TYPE", "CST:UTF32STRING_TYPE",
    "CST:REGEXP_TYPE", "CST:OPTION_TYPE", "CST:COUNT_OF_ALTS", "CST:COUNT_OF_PHRASES",
    "CST:ALT_NUMBER", "*ERROR(14)*", "*ERROR(15)*",
    // AST
    "AST:BIP", "AST:PHRASE", "AST:LITERAL", "*ERROR(19)*",
    "*ERROR(20)*", "*ERROR(21)*", "*ERROR(22)*", "*ERROR(23)*",
    "*ERROR(24)*", "*ERROR(25)*", "*ERROR(26)*", "*ERROR(27)*",
    "*ERROR(28)*", "*ERROR(29)*", "*ERROR(30)*", "*ERROR(31)*",
  };


  // TO DO: WE NEED A PROPER DECODE PROCEDURE THAT WORKS OUT ALL TYPES OF PHRASE
  
  wchar_t *Decode(int Ph) {
    static wchar_t tmp[512];
    swprintf(tmp, 511, L"%s", TypeName[(Ph>>AST_type_shift)&AST_type_mask]);
    return tmp;
  }

  // Stringpool helpers

  STRING wstrtopool(wchar_t *wstr) {
    STRING result = Stringpool_nextfree;
    for (;;) {
      wchar_t wch = *wstr++;
      _Stringpool(Stringpool_nextfree++) = wch;
      if (wch == '\0') break;
    }
    return (STRING_TYPE << GRAMMAR_TYPE_SHIFT) | result; // or CHAR_TYPE?
  }

  wchar_t *pooltowstr(STRING p) {
    if (P_AST_type(p) != 0 && P_AST_type(p) != STRING_TYPE && P_AST_type(p) != AST_LITERAL) {
      fprintf(stderr, "* Error: bad string access: %ls\n", Decode(p));
    }
    p = p & AST_idx_mask;
    return &Stringpool(p);
  }
  
  void PrintTag(int Literal) {
    int i;
    int P_      = Literal&INDEX_MASK;
    unsigned int type    = Literal>>AST_type_shift;
    if ((Literal!=P_) && ((type<<AST_type_shift) != AST_LITERAL)) {
      fprintf(stderr, "* Internal error: Expected a Tag (stored as a literal - type 3) but got type %d.  Tag was:", type);
      for (i = atom(Literal).start; i < atom(Literal).end; i++)
        fprintf(stderr, "%lc", source(i).ch);
    }
    for (i = atom(Literal).start; i < atom(Literal).end; i++)
      fprintf(stdout, "%lc", source(i).ch);
  }

  // Tag2Str is a short term expedient.  Most of the places where it is used
  // so far should be extracting the canonical "C" variable name corresponding
  // to the Imp variable, which may have leading spaces and perhaps even
  // embedded spaces or {} comments!  For now just a quick hack to remove
  // spaces.
  char *Tag2Str(int Literal) {
    int i, idx, len;
    char c;
    int P_      = Literal&INDEX_MASK;
    unsigned int type    = PhraseType(Literal);
    len = atom(P_).end-atom(P_).start;
    //fprintf(stderr, "{len=%d}", len);
    char Str[len+1];

    idx = 0; i = atom(P_).start;
    for (;;) {
      if (i-atom(P_).start == len) break;
      c = (char)(source(i).ch & 255); // temp hack, not unicode.
      if (c != ' ') {
        Str[idx] = c; Str[idx+1] = '\0';
        idx += 1;
      }
      i++;
    }

    if ((Literal!=P_) && ((type<<AST_type_shift) != AST_LITERAL)) {
      fprintf(stderr, "* Internal error: Expected a Tag (stored as a literal - type 3) but got type %d.  Tag was \"%s\"\n", type, Str);
    }
    return strdup(Str); // :-@
  }
  wchar_t *Tag2WStr(int Literal) {
    int i, idx, len;
    int P_      = Literal&INDEX_MASK;
    unsigned int type    = PhraseType(Literal);
    //fprintf(stderr, "{0: type    = PhraseType(Literal) = %08x}", type);
    len = atom(P_).end-atom(P_).start;
    //fprintf(stderr, "{A: wchar_t WStr[len=%d+1]}", len);
    wchar_t wc, WStr[len+1];
    idx = 0; i = atom(P_).start;
    for (;;) {
      if (i-atom(P_).start == len) break;
      //fprintf(stderr, "{WStr[idx=%d] = source(i=%d).ch = %d ('%lc')}", idx, i, source(i).ch, source(i).ch);
      wc = source(i).ch;
      if (wc != L' ') {
        WStr[idx] = wc; WStr[idx] = '\0';
        idx += 1;
      }
      i++;
    }
    //fprintf(stderr, "{B:WStr[len=%d] = '\\0'}", len);
    //fprintf(stderr, "{C: done.}");
    if ((Literal!=P_) && ((type<<AST_type_shift) != AST_LITERAL)) {
      //                   ^^^^^^^^^^^^^^^^^^^^ can cause overflow if type is not unsigned!  There may be more like this to be found.
      fprintf(stderr, "* Internal error: Expected a Tag (stored as a literal - type 3) but got type %d.  Tag was \"%ls\"\n", type, WStr);
    }
    //fprintf(stderr, "{D: wchar_t *rslt = wcsdup(WStr)}");
    //fprintf(stderr, "{E: WStr=\"%ls\"}", WStr);
    wchar_t *rslt = wcsdup(WStr); // :-@
    if (rslt == NULL) {
      //fprintf(stderr, "{F1: return NULL}");
    } else {
      //fprintf(stderr, "{F2: return \"%ls\"}", rslt);
    }
    return rslt;
  }
  STRING Str2Pool(char *s) {
    int p = Stringpool_nextfree;
    for (;;) {
      char c = *s++;
      _Stringpool(Stringpool_nextfree++) = c;
      if (c == '\0') break;
    }
    return p;
  }


  // SCOPE MANAGEMENT:


  #include "symtab.h"

  static int DOWN_flag = 0;

  typedef enum CTRL_STACK_ENUM {
    FINISHELSE = 0,
    FINISH,
    END,
    ENDOFPROGRAM,
    ELSE,
    REPEAT,
    REPEATUNTIL
  } CTRL_STACK_ENUM;

  const char *ctrl_debug[] = {"FINISHELSE", "FINISH", "END", "ENDOFPROGRAM", "ELSE", "REPEAT", "REPEATUNTIL", "bug"};

  // These are set in <init>
  static int debug_ctrl_stack = 0;
  static int debug_compiler = 0;
  static int debug_declarations = 0;

  DECLARE(CTRL_STACK, CTRL_STACK_ENUM, 32);
  int CTRL_STACK_nextfree = 0;
  $define _CTRL_STACK[x] WRITE(x, CTRL_STACK, CTRL_STACK_ENUM)
  $define  CTRL_STACK[x]  READ(x, CTRL_STACK, CTRL_STACK_ENUM)

  int ctrl_depth(void) {
    if (debug_ctrl_stack) {
      int i = CTRL_STACK_nextfree;
      fprintf(stderr, "Control stack: "); while (--i >= 0) fprintf(stderr, " %s", ctrl_debug[CTRL_STACK[i]]); fprintf(stderr, "\n");
    }
    return CTRL_STACK_nextfree;
  }
  
  void push_ctrl(int Code) {
    if (debug_ctrl_stack) {
      int i = CTRL_STACK_nextfree;
      fprintf(stderr, "Control stack before push: "); while (--i >= 0) fprintf(stderr, " %s", ctrl_debug[CTRL_STACK[i]]); fprintf(stderr, "\n");
    }
    _CTRL_STACK[CTRL_STACK_nextfree++] = Code;
    if (debug_ctrl_stack) {
      int i = CTRL_STACK_nextfree;
      fprintf(stderr, "Control stack after push: "); while (--i >= 0) fprintf(stderr, " %s", ctrl_debug[CTRL_STACK[i]]); fprintf(stderr, "\n");
    }
  }

  #define  pop_ctrl()  pop_ctrl_inner(__LINE__,__FILE__)
  int pop_ctrl_inner(int line, char *file) {
    if (CTRL_STACK_nextfree == 0) {
      fprintf(stderr, "* Control stack empty.  Internal coding error. (detected at %s:%d)\n", file,line);
      exit(1);
    }
    if (debug_ctrl_stack) {
      int i = CTRL_STACK_nextfree;
      fprintf(stderr, "Control stack before pop: "); while (--i >= 0) fprintf(stderr, " %s", ctrl_debug[CTRL_STACK[i]]); fprintf(stderr, "\n");
    }
    if (debug_ctrl_stack) {
      int i = CTRL_STACK_nextfree-1;
      fprintf(stderr, "Control stack after pop: "); while (--i >= 0) fprintf(stderr, " %s", ctrl_debug[CTRL_STACK[i]]); fprintf(stderr, "\n");
    }
    return CTRL_STACK[--CTRL_STACK_nextfree];
  }


  // NAME TABLES

  // formal parameters, and record formats (maybe array formats too) need to suppress current <NAME> handling.
  // Otherwise, declarations are looking pretty good!


  // Inline sections like this are copied through to the global declarations in the main program.
  // If you want to *execute* code at startup, put it in the <init> phrase at the start of P<SS>
  typedef enum OBJECT {
    UNINIT_OBJECT=0, CODE, VAR, RECORDFORMAT, ARRAYFORMAT, SWITCHDEFN, LABELDEFN
  } OBJECT;
  const char *Object_name[] = {"**BADOBJ**", "CODE", "VAR", "RECORDFORMAT", "ARRAYFORMAT", "SWITCHDEFN", "LABELDEFN"};
  OBJECT Object;

  typedef enum BASETYPE {
    UNINIT_BASETYPE=0, INTEGER, FLOAT, STRINGTYPE, RECORD, PROCADDR, GENERIC /*%name*/, SWITCHLABEL, JUMPLABEL
  } BASETYPE;
  const char *Basetype_name[] = {"**BADTYPE**", "INTEGER", "FLOAT", "STRINGTYPE", "RECORD", "PROCADDR", "GENERIC", "SWITCHLABEL", "JUMPLABEL"};
  BASETYPE Basetype;

  typedef enum SIGNEDNESS {
    UNINIT_SIGNEDNESS=0, SIGNED, UNSIGNED
  } SIGNEDNESS;
  const char *Signedness_name[] = {"**BADSIGN**", "SIGNED", "UNSIGNED"};
  SIGNEDNESS Signedness;

  typedef enum PRECISION {
    UNINIT_PRECISION=0, COMPOUND, BYTE, SHORT, WORD, LONGWORD, QUADWORD, ADDR
  } PRECISION;
  const char *Precision_name[] = {"**BADPREC**", "COMPOUND", "BYTE", "SHORT", "WORD", "LONGWORD", "QUADWORD", "ADDR"};
  PRECISION Precision;

  typedef enum PROC {
    UNINIT_PROC=0, NONE, ROUTINE, FN, MAP
  } PROC;
  const char *Proc_name[] = {"**BADPROC**", "NONE", "ROUTINE", "FN", "MAP"};
  PROC Proc;

  typedef enum AN_N {
    UNINIT_AN_N=0, NO_NAME, ARRAYNAME, OBJECTNAME
  } AN_N;
  const char *NameInfo_name[] = {"**BADNAME**", "NO_NAME", "ARRAYNAME", "OBJECTNAME"};
  AN_N NameInfo;
  
  //typedef enum ISFORMAT {
  //  UNINIT_ISFORMAT=0, NO_FORMAT, IS_FORMAT
   //} ISFORMAT;
  //const char *IsFormat_name[] = {"**BADFORM**", "NO_FORMAT", "IS_FORMAT"};
  //ISFORMAT IsFormat;

  typedef enum SPECQ {
    UNINIT_SPEC=0, NO_SPEC, SPEC
  } SPECQ;
  const char *Spec_name[] = {"**BADSPEC**", "NO_SPEC", "SPEC"};
  SPECQ Spec;

  typedef enum ISARRAY {
    UNINIT_ISARRAY=0, SCALAR, ARRAY
  } ISARRAY;
  const char *IsArray_name[] = {"**BADARRAY**", "SCALAR", "ARRAY"};
  ISARRAY IsArray;
  
  typedef enum AREA {
    UNINIT_AREA=0, OWN, EXTDATA, CONSTANT, STACK, PARAMETER  // extrinsic is an implied %spec
  } AREA;
  const char *Area_name[] = {"**BADAREA**", "OWN", "EXTDATA", "CONSTANT", "STACK", "PARAMETER"};
  AREA Area;

  typedef enum LINKAGE {
    UNINIT_LINKAGE=0, EXTPROC, SYSTEM, DYNAMIC, PRIM, PERM, AUTO
  } LINKAGE;
  const char *Linkage_name[] = {"**BADLINK**", "EXTPROC", "SYSTEM", "DYNAMIC", "PRIM", "PERM", "AUTO"};
  LINKAGE Linkage;



  // See previous attempt for imp77 at ~/src/compilers101/new-parser/imps/datatypes.h



  // structures are never used directly.  Where you would normally embed a struct,
  // you must put a structIDX which is an integer into a flex array of structs.
  // Using indices rather than pointers is essential to having efficient flex arrays.

  // In structs with flexible numbers of fields, the flex field must come last.
  // None of these objects may contain pointers as the flex.h package is liable
  // to realloc the data on the fly: indexes will always be valid but pointers would not be.
  
  typedef int TypeDeclIDX;      // type information - everything needed to declare and use anything
  typedef int VarDeclIDX;       // A tag and its type information - entered into a scoped symbol table
  
  typedef int BoundIDX;         // one bound (lower or upper)
  typedef int BoundsPairIDX;    // lower and upper bound
  typedef int BoundsIDX;        // array of bounds pairs, one for each dimension

                                // extra info for records, arrays, strings:
  typedef int RecordFormatIDX;
  typedef int ArrayFormatIDX;
  typedef int StringFormatIDX;
  
  typedef int ParamFormatIDX;   // list of parameters to a procedure
  
  typedef int ASTidx;


$ifdef TypeDecl
$undef TypeDecl
$endif

  // OK, here's my next problem: as well as handling declarations on the fly, I want to return the
  // declaration parameters via an AST tuple.  This is fine for most of the items in the struct
  // below, but we may have a problem with the IDX items which point into other arrays.  Those
  // will also have to be managed by AST tuples and added to and removed from in the same order
  // as during parsing.  Right now, generating C on the fly from the CST is looking like the
  // more tempting option, despite some limitations.

  typedef struct TypeDecl {
    OBJECT     Object;
    BASETYPE   Basetype;
    SIGNEDNESS Signedness;
    PRECISION  Precision;
    PROC       Proc;
    AN_N       NameInfo;
    SPECQ      Spec;
    ISARRAY    IsArray;
    AREA       Area;
    LINKAGE    Linkage;
    // for arrays
    ArrayFormatIDX  arrfm;
    // for Rt/Fn/Map parameters:
    ParamFormatIDX  parms;
    // for records, strings, and fn/maps returning same:
    RecordFormatIDX recfm;
    StringFormatIDX strfm;
  } TypeDecl;

  // Note that DECLARE(x) creates x.next_free_index
  // which we could use instead of adding a separate x_nextfree
  // but I would need to add that to the NO_FLEX path as well.
  
  DECLARE(TypeDeclRA, TypeDecl, 10000);
  int TypeDecl_nextfree = 0;
  $define _TypeDecl[x] WRITE(x, TypeDeclRA, TypeDecl)
  $define  TypeDecl[x]  READ(x, TypeDeclRA, TypeDecl)


  typedef struct VarDecl {
    STRING         varname;    // Object name
    STRING         aliasname;  // %alias name or -1
    STRING         c_name;     // mangled for use when outputting C code
    TypeDeclIDX    type;       // or -1
    ArrayFormatIDX aform;      // or -1  // Not sure why I wanted an Array Format field when the TypeDecl has 'arrfm' as well.  Ignoring this one for now.
                                         // Possibly it was: there is a distinction between a declaration of an array format for use with the ARRAY() map,
                                         // and a description of the format of an actual array declaration.  The VarDecl 'aform' is likely for the former,
                                         // and the TypeDecl 'arrfm' for the latter.
  } VarDecl;

  DECLARE(VarDeclRA, VarDecl, 10000);
  int VarDecl_nextfree = 0;
  $define _VarDecl[x] WRITE(x, VarDeclRA, VarDecl)
  $define  VarDecl[x]  READ(x, VarDeclRA, VarDecl)


  typedef enum BOUNDTYPE {
    UNDEFINED_BOUND, CONSTANT_BOUND, VARIABLE_BOUND
  } BOUNDTYPE;

  DECLARE(BoundTypeRA, BOUNDTYPE, 10000);
  int BoundType_nextfree = 0;
  $define _BoundType[x] WRITE(x, BoundTypeRA, BoundType)
  $define  BoundType[x]  READ(x, BoundTypeRA, BoundType)


  typedef struct Bound {
    int type;            // lower or upper or both bounds of one dimension of an array may be
                         // constant, or taken from a variable at the point of declaration,
                         // or unknown. (unknown is an extension for later, for Hamish's 68K Imp)
                         // Some types of array (e.g. in a %record) must have all constant bounds.
                         // Arrays with variable bounds need a dopevector where the initial
                         // bounds can be stored at the point where space for the array is
                         // allocated (most likely using alloca() to mimic Imp's stack)
    ASTidx value;        // Index into the AST where the bound is expressed.
    VarDeclIDX indexvar; // variable used to index the array declaration.  (May not be needed?)
  } Bound;

  DECLARE(BoundRA, BOUNDTYPE, 10000);
  int Bound_nextfree = 0;
  $define _Bound[x] WRITE(x, BoundRA, Bound)
  $define  Bound[x]  READ(x, BoundRA, Bound)


  typedef struct BoundsPairTYPE {
    BoundIDX Lower, Upper;
  } BoundsPairTYPE;

  DECLARE(BoundsPairRA, BoundsPairTYPE, 10000);
  int BoundsPair_nextfree = 0;
  $define _BoundsPair[x] WRITE(x, BoundsPairRA, BoundsPair)
  $define  BoundsPair[x]  READ(x, BoundsPairRA, BoundsPair)


  typedef struct BoundsTYPE {
    int           dimensions;
    BoundsPairIDX Dimension[];
  } BoundsTYPE;

  DECLARE(BoundsRA, BoundsTYPE, 10000);
  int Bounds_nextfree = 0;
  $define _Bounds[x] WRITE(x, BoundsRA, Bounds)
  $define  Bounds[x]  READ(x, BoundsRA, Bounds)


  typedef struct recfmTYPE {
    STRING formatname;   // Record format name
    STRING c_formatname; // Record format name mangled for use when outputting C code
    int fields;          // count of fields
    VarDeclIDX field[];  // (extensible)
  } recfmTYPE;

  DECLARE(recfmRA, recfmTYPE, 10000);
  int recfm_nextfree = 0;
  $define _recfm[x] WRITE(x, recfmRA, recfm)
  $define  recfm[x]  READ(x, recfmRA, recfm)

  
  typedef struct arrfmTYPE {
    STRING formatname;      // Array format name, may be -1 for none
    VarDeclIDX field;       // Base element
    int dims;               // array dimensions
    BoundsPairIDX dim[];    // each dimension or each parameter (extensible)
  } arrfmTYPE;

  DECLARE(arrfmRA, arrfmTYPE, 10000);
  int arrfm_nextfree = 0;
  $define _arrfm[x] WRITE(x, arrfmRA, arrfm)
  $define  arrfm[x]  READ(x, arrfmRA, arrfm)


  // May later extend but until there are languages changes, no need.
  // (changes such as allowing C-style strings as opposed to Imp strings,
  //  or maybe significantly increasing string length, or allowing Unicode)
  typedef struct strfmTYPE {
    int maxlen;             // maximum string length
  } strfmTYPE;

  DECLARE(strfmRA, strfmTYPE, 10000);
  int strfm_nextfree = 0;
  $define _strfm[x] WRITE(x, strfmRA, strfm)
  $define  strfm[x]  READ(x, strfmRA, strfm)

  // Maybe this (and a record definition) ought to use the same data structure as a scoped name table?
  typedef struct paramTYPE {
    int            numparams;
    VarDeclIDX     param[];    // extensible
  } paramTYPE;
  DECLARE(ParamRA, paramTYPE, 10000);
  int Param_nextfree = 0;
  $define _Param[x] WRITE(x, ParamRA, ParamList)
  $define  Param[x]  READ(x, ParamRA, ParamList)  


  void DebugVarIDX(int VarIDX) {
    int VTag = VarDecl[VarIDX].varname;
    int TypeIDX = VarDecl[VarIDX].type;
    char *s = Tag2Str(VTag);
    fprintf(stderr, "Debug VAR: VarIDX %d is %s\n", VarIDX, s);

    fprintf(stderr, "VarDecl[%d].varname   = %d\n", VarIDX, VarDecl[VarIDX].varname);
    fprintf(stderr, "VarDecl[%d].aliasname = %d\n", VarIDX, VarDecl[VarIDX].aliasname);
    fprintf(stderr, "VarDecl[%d].c_name    = %d\n", VarIDX, VarDecl[VarIDX].c_name);
    fprintf(stderr, "VarDecl[%d].type      = %d\n", VarIDX, VarDecl[VarIDX].type);
    fprintf(stderr, "VarDecl[%d].aform     = %d\n", VarIDX, VarDecl[VarIDX].aform);
    fprintf(stderr, "TypeDecl[%d].Object     = %d\n", TypeIDX, TypeDecl[TypeIDX].Object);
    fprintf(stderr, "TypeDecl[%d].Basetype   = %d\n", TypeIDX, TypeDecl[TypeIDX].Basetype);
    fprintf(stderr, "TypeDecl[%d].Signedness = %d\n", TypeIDX, TypeDecl[TypeIDX].Signedness);
    fprintf(stderr, "TypeDecl[%d].Precision  = %d\n", TypeIDX, TypeDecl[TypeIDX].Precision);
    fprintf(stderr, "TypeDecl[%d].Proc       = %d\n", TypeIDX, TypeDecl[TypeIDX].Proc);
    fprintf(stderr, "TypeDecl[%d].NameInfo   = %d\n", TypeIDX, TypeDecl[TypeIDX].NameInfo);
    fprintf(stderr, "TypeDecl[%d].Spec       = %d\n", TypeIDX, TypeDecl[TypeIDX].Spec);
    fprintf(stderr, "TypeDecl[%d].IsArray    = %d\n", TypeIDX, TypeDecl[TypeIDX].IsArray);
    fprintf(stderr, "TypeDecl[%d].Area       = %d\n", TypeIDX, TypeDecl[TypeIDX].Area);
    fprintf(stderr, "TypeDecl[%d].Linkage    = %d\n", TypeIDX, TypeDecl[TypeIDX].Linkage);
    fprintf(stderr, "TypeDecl[%d].arrfm      = %d\n", TypeIDX, TypeDecl[TypeIDX].arrfm);
    fprintf(stderr, "TypeDecl[%d].parms      = %d\n", TypeIDX, TypeDecl[TypeIDX].parms);
    fprintf(stderr, "TypeDecl[%d].recfm      = %d\n", TypeIDX, TypeDecl[TypeIDX].recfm);
    fprintf(stderr, "TypeDecl[%d].strfm      = %d\n", TypeIDX, TypeDecl[TypeIDX].strfm);
  }

#define _textof(x) #x
#define textof(x) _textof(x)
#define Diagnose(IDX) Diagnose_inner(IDX, _textof(IDX), __FILE__, __LINE__)
  void Diagnose_inner(int IDX, char *info, char *file, int line) {
    if (IDX == 0) {
      fprintf(stderr, "Diagnose(0x%08x, \"%s\", \"%s\", %d); // Usually 0 means an implicitly unassigned variable somewhere\n", IDX, info, file, line);
      return;
    } else if (IDX == -1) {
      fprintf(stderr, "Diagnose(0x%08x, \"%s\", \"%s\", %d); // Usually -1 means an explicitly unassigned variable somewhere\n", IDX, info, file, line);
      return;
    } else if (IDX == 0x80808080) {
      fprintf(stderr, "Diagnose(0x%08x, \"%s\", \"%s\", %d); // 0x80808080 means a monitored but unassigned variable\n", IDX, info, file, line);
      return;
    }

    fprintf(stderr, "Diagnose(0x%08x, \"%s\", \"%s\", %d): ", IDX, info, file, line);
    switch (P_AST_type(IDX)) {
    case AST_BIP:
      fprintf(stderr, "AST_BIP"); break;
    case AST_PHRASE:
      {
      fprintf(stderr, "AST_PHRASE stored at AST(%d),", IDX&AST_idx_mask);
      int op = AST((IDX&AST_idx_mask)+1);
      switch (op) {
      case AST_LVALUE: fprintf(stderr, " AST_LVALUE"); break;
      case AST_RVALUE: fprintf(stderr, " AST_RVALUE"); break;
      case AST_EXPRESSION: fprintf(stderr, " AST_EXPRESSION"); break;
      case AST_TYPE_INFORMATION: fprintf(stderr, " AST_TYPE_INFORMATION"); break;
      case AST_USER_PARENS: fprintf(stderr, " AST_USER_PARENS"); break;
      case AST_BINARY_ARITHMETIC_OPERATION: fprintf(stderr, " AST_BINARY_ARITHMETIC_OPERATION"); break;
      case AST_UNARY_ARITHMETIC_OPERATION: fprintf(stderr, " AST_UNARY_ARITHMETIC_OPERATION"); break;
      case AST_ASSIGN: fprintf(stderr, " AST_ASSIGN"); break;
      case AST_PROC_CALL: fprintf(stderr, " AST_PROC_CALL"); break;
      case AST_ARRAYACCESS: fprintf(stderr, " AST_ARRAYACCESS"); break;
      case AST_BINOP: fprintf(stderr, " AST_BINOP"); break;
      case AST_MONOP: fprintf(stderr, " AST_MONOP"); break;
      case AST_ASSOP: fprintf(stderr, " AST_ASSOP"); break;
      default: fprintf(stderr, " Unknown op=%d", op); break;
      }
      fprintf(stderr, "\n");
      }
      break;
    case AST_LITERAL:
      fprintf(stderr, "AST_LITERAL"); break;
    case BIP_TYPE:
      fprintf(stderr, "BIP_TYPE"); break;
    case PHRASE_TYPE:
      {
      extern wchar_t *PHRASE_inner(int G_PhraseStart, char *file, int line);
      int op = P_op(IDX);
      fprintf(stderr, "PHRASE_TYPE:  Phrase@AST(%d)%s%s%s",
              P_AST_index(IDX),
              IDX&NEGATED_PHRASE     ? " Negated":"",
              IDX&GUARD_PHRASE       ? " Guard":"",
              IDX&WHITESPACE_ALLOWED ? " Whitesp":"");
      fprintf(stderr, " Op=%d", op);
      fprintf(stderr, " (G_%ls)", PHRASE_inner(op, file, line));
      fprintf(stderr, "\n");
      }
      return;
    case SEMANTIC_TYPE:
      fprintf(stderr, "SEMANTIC_TYPE"); break;
    case KEYWORD_TYPE:
      fprintf(stderr, "KEYWORD_TYPE"); break;
    case CHAR_TYPE:
      fprintf(stderr, "CHAR_TYPE"); break;
    case UTF32CHAR_TYPE:
      fprintf(stderr, "UTF32CHAR_TYPE"); break;
    case STRING_TYPE:
      fprintf(stderr, "STRING_TYPE"); break;
    case UTF32STRING_TYPE:
      fprintf(stderr, "UTF32STRING_TYPE"); break;
    case REGEXP_TYPE:
      fprintf(stderr, "REGEXP_TYPE"); break;
    case OPTION_TYPE:
      fprintf(stderr, "OPTION_TYPE"); break;
    case COUNT_OF_ALTS:
      fprintf(stderr, "COUNT_OF_ALTS"); break;
    case COUNT_OF_PHRASES:
      fprintf(stderr, "COUNT_OF_PHRASES"); break;
    case ALT_NUMBER:
      fprintf(stderr, "ALT_NUMBER"); break;

    default:
      fprintf(stderr, "Unknown object tag %02x (%s)", ((unsigned)IDX)>>27U, TypeName[(((unsigned)IDX)>>AST_type_shift)&31]); break;
      return;
    }
    
    fprintf(stderr, " Index=%d\n", P_AST_index(IDX));
  } // End of Diagnose()

  // shunting yard algorithm for opperator precedence.  In my previous imptoc
  // I used a precedence grammar.  I'm trying a flat grammar this time with
  // the precedence being added afterwards via Dijkstra's shunting yard algorithm
  // just for the experience (and because that's how the ERCC's grammar was written)

  // The corresponding code in the ERCC compilers is in TORP() in their pass2.
  // I'ld like to say that I learned from their example but it was easier just
  // to write it from first principles (using the description in Wikipedia as
  // a crib).
  
  static int debug_torp = 0;

#define MAX_TORP 1024

  DECLARE(OperStack, Oper, MAX_TORP); // enum acts as an index into the struct array
  #define _OperStack(x)  WRITE(x,OperStack,Oper)
  #define  OperStack(x)   READ(x,OperStack,Oper)
  static int OperStack_nextfree = 0;
  static int OperStack_bottom = 0;
  
  DECLARE(DataStack, Op_or_Data, MAX_TORP);  // a.k.a 'Output' in the description below.
  #define _DataStack(x)  WRITE(x,DataStack,Op_or_Data)
  #define  DataStack(x)   READ(x,DataStack,Op_or_Data)
  static int DataStack_nextfree = 0;
  static int DataStack_bottom = 0;

  static void ShowRP(char *message) {
    int i;
    if (debug_torp == 0) return;
    i = OperStack_nextfree;
    fprintf(stderr, "\n%s\n  OperStack:\n", message);
    if (i == 0) fprintf(stderr, "    <empty>\n"); else
    while (i > 0) {
          Oper y;
          y = OperStack(--i);
          fprintf(stderr, "    %ls\n", OpDetails[y].Sym);
          if (i && i == OperStack_bottom) fprintf(stderr, "    ------------- false bottom\n");
    }
    fprintf(stderr, "  DataStack:\n");
    i = DataStack_nextfree;
    if (i == 0) fprintf(stderr, "    <empty>\n"); else
    while (i > 0) {
          Op_or_Data Item;
          Item = DataStack(--i);
          if (Item.type == 'O') {
            fprintf(stderr, "    %ls\n", OpDetails[Item.idx].Sym);
          } else {
            fprintf(stderr, "    %ls\n", Decode(Item.idx));
          }
          if (i && i == DataStack_bottom) fprintf(stderr, "    ------------- false bottom\n");
    }
    fprintf(stderr, "\n");
  }

  void PushParen(wchar_t *Op) {
    if (debug_torp) fprintf(stderr, "PushParen(%ls)\n", Op);
    // only '(' and ')' for now!
    Oper OPER;
    if (wcscmp(Op, L"(")==0) {
      OPER = OP_LPAREN;
    } else if (wcscmp(Op, L")")==0) {
      OPER = OP_RPAREN;
    } else {
      OPER = OP_NONE; fprintf(stderr, "* Error: PushParen(\"%ls\") unknown\n", Op);
    }
  
    if (OPER == OP_LPAREN) { // 1.3
      /*
        - a left parenthesis (i.e. "("):
            push it onto the operator stack
       */
      _OperStack(OperStack_nextfree++) = OPER;
    } else if (OPER == OP_RPAREN) { // 1.4
      /*
        - a right parenthesis (i.e. ")"):
            while the operator at the top of the operator stack is not a left parenthesis:
                pop the operator from the operator stack into the output queue
            {assert there is a left parenthesis at the top of the operator stack}
            pop the left parenthesis from the operator stack and discard it
       */
      for (;;) {
        OPER = OperStack(--OperStack_nextfree);
        if (OPER == OP_LPAREN) break; // 1.4.2
        _DataStack(DataStack_nextfree++) = (Op_or_Data){'O',OPER}; // 1.4.1
      }
    }
    ShowRP("PushParen:\n");
  }

  void PushMonOp(int P) {
    Oper OPER;
    wchar_t *Ops;
    Ops = pooltowstr(P_P(P,1));

#ifdef NEVER
    if (debug_torp) fprintf(stderr, "PushMonOp(%ls)\n", Decode(P));
    
    if (debug_torp) fprintf(stderr, "PushMonOp: Ops = \"%ls\"\n", Ops);

    if (         wcscmp(Ops, L"\\")==0  ||  wcscmp(Ops, L"~")==0         ) {
      OPER = OP_NOT;
    } else if (wcscmp(Ops, L"-")==0) {
      OPER = OP_NEG;
    } else {
      OPER = OP_NONE;
      fprintf(stderr, "* Error: PushMonOp(\"%ls\") unknown\n", Ops);
    }
#else
    // if (debug_torp) Diagnose(P);
    OPER = P_P(P,2);
#endif

    for (;;) {
      if (OperStack_nextfree == OperStack_bottom) break;
      Oper O2 = OperStack(OperStack_nextfree-1);
      if (O2 == OP_LPAREN) break;
      
      // Not 100% sure this is all valid for monops. Works well for binops.
      // Also somewhat dubious about the precedence levels copied from the ERCC Imp compiler.
      
      if (   (OpDetails[O2].Prec > OpDetails[OPER].Prec)
          || (OpDetails[OPER].Assoc == Left && (OpDetails[O2].Prec == OpDetails[OPER].Prec))) {
          O2 = OperStack(--OperStack_nextfree);
          if (debug_torp) fprintf(stderr, "A: Transferring %ls to DataStack\n", OpDetails[O2].Sym);
          _DataStack(DataStack_nextfree++) = (Op_or_Data){'O',O2};
      } else break;
    }
    _OperStack(OperStack_nextfree++) = OPER;  // <-- runtime error, don't know why. OperStack_nextfree is 0
    ShowRP("PushMonOp:\n");

  }


  void PushBinOp(int P) {
    // 1.2
    Oper OPER;
    wchar_t *Ops;
    Ops = pooltowstr(P_P(P,1));

#ifdef NEVER
    if (debug_torp) fprintf(stderr, "PushBinOp(%ls)\n", Decode(P));
    
    // P came from a 'wlit()' call and should be a STRING pointer to \ or ~
    // only '\' or '~', and '-' for now!
    
    if (debug_torp) fprintf(stderr, "PushBinOp: Ops = \"%ls\"\n", Ops);

    if (wcscmp(Ops, L"+")==0) {
      OPER = OP_ADD;
    } else if (wcscmp(Ops, L"-")==0) {
      OPER = OP_SUB;
    } else if (wcscmp(Ops, L"&")==0) {
      OPER = OP_AND;
    } else if (wcscmp(Ops, L"****")==0) { // or \\ ...
      OPER = OP_IEXP;
    } else if (wcscmp(Ops, L"**")==0) { // or \ ...
      OPER = OP_REXP;
    } else if (wcscmp(Ops, L"^^")==0) {
      OPER = OP_IEXP;
    } else if (wcscmp(Ops, L"^")==0) {
      OPER = OP_REXP;
    } else if (wcscmp(Ops, L"*")==0) {
      OPER = OP_MULT;
    } else if (wcscmp(Ops, L"!!")==0) {
      OPER = OP_EOR;
    } else if (wcscmp(Ops, L"!")==0) {
      OPER = OP_OR;
    } else if (Ops[0] == L'/' && Ops[1] == L'/' && Ops[2] == L'\0') { // avoid bug in takeon where a '//' in a string is handled as if it were a C comment.
      OPER = OP_INTDIV;
    } else if (wcscmp(Ops, L"/")==0) {
      OPER = OP_REALDIV;
    } else if (wcscmp(Ops, L">>")==0) {
      OPER = OP_RSHIFT;
    } else if (wcscmp(Ops, L"<<")==0) {
      OPER = OP_LSHIFT;
    } else if (wcscmp(Ops, L".")==0) {
      OPER = OP_CONCAT;
    } else {
      fprintf(stderr, "Error: PushBinOp(\"%ls\") unknown\n", Ops);
      OPER = OP_NONE;
    }
#else
    // if (debug_torp) Diagnose(P);
    OPER = P_P(P,2);
#endif

    /*

        if the token is:
        - an operator o1:
            while (
                there is an operator o2 at the top of the operator stack which is not a left parenthesis,
                and (o2 has greater precedence than o1 or (o1 and o2 have the same precedence and o1 is left-associative))
            ):
                pop o2 from the operator stack into the output queue
            push o1 onto the operator stack
     */
    // 1.2.1
    for (;;) {
      if (OperStack_nextfree == OperStack_bottom) break;
      Oper O2 = OperStack(OperStack_nextfree-1);
      if (O2 == OP_LPAREN) break;
      if (   (OpDetails[O2].Prec > OpDetails[OPER].Prec)
          || (OpDetails[OPER].Assoc == Left && (OpDetails[O2].Prec == OpDetails[OPER].Prec))) {
          O2 = OperStack(--OperStack_nextfree);
          if (debug_torp) fprintf(stderr, "A: Transferring %ls to DataStack\n", OpDetails[O2].Sym);
          _DataStack(DataStack_nextfree++) = (Op_or_Data){'O',O2};
      } else break;
    }
    _OperStack(OperStack_nextfree++) = OPER;  // <-- runtime error, don't know why. OperStack_nextfree is 0
    ShowRP("PushBinOp:\n");
  }

  void PushConst(int P) {
    /*
        - a number:
            put it into the output queue
     */
    if (debug_torp) fprintf(stderr, "PushConst(%ls)\n", Decode(P));
    // 1.5 either literal constant or symbolic constant
    _DataStack(DataStack_nextfree++) = (Op_or_Data){'D',P};
    ShowRP("PushConst:\n");
  }
  
  void PushVar(int P) {
    /*
        - a number:
            put it into the output queue
     */
    if (debug_torp) fprintf(stderr, "PushVar(%ls)\n", Decode(P));
    // 1.5 either literal constant or symbolic constant
    _DataStack(DataStack_nextfree++) = (Op_or_Data){'D',P};
    ShowRP("PushVar:\n");
  }

  int Stack_to_Tree(void) {
    Oper op;
    int t[4];
    int Left, Right;
    if (DataStack_nextfree == DataStack_bottom) {
      fprintf(stderr, "* Error: expression stack ran out of data\n");
      return -1;
    }
    Op_or_Data TOS = DataStack(--DataStack_nextfree);
    if (TOS.type == 'O') {
      if (OpDetails[TOS.idx].Arity == 1) {
        t[1] = TOS.idx;
        t[2] = Left = Stack_to_Tree();
        return P_mktuple(AST_UNARY_ARITHMETIC_OPERATION, 0, 2, t);
      } else if (OpDetails[TOS.idx].Arity == 2) {
        t[1] = TOS.idx;
        t[2] = Right = Stack_to_Tree();
        t[3] = Left  = Stack_to_Tree();
        return P_mktuple(AST_BINARY_ARITHMETIC_OPERATION, 0, 3, t);
      } else {
        fprintf(stderr, "* Error: bad operator on stack\n");
      }
    } else if (TOS.type == 'D') {
      return TOS.idx;
    } else {
      fprintf(stderr, "* Error: bad data type on stack\n");
    }
    return -1;
  }

  void PushExpr(int P) {
    /*
        This should ne an 'AST_USER_PARENS' object which is treated as an atom and always output with '()' around it.
            put it into the output queue
     */
    if (debug_torp) fprintf(stderr, "PushExpr(%ls)\n", Decode(P));
    _DataStack(DataStack_nextfree++) = (Op_or_Data){'D',P};
    ShowRP("PushExpr:\n");
  }

  int ExPop(void) {
  
    // At one point this did not handle user brackets if there was valid code on the stack below it, eg for "a + (b + c)"
    // it was not possible to evaluate "(b + c)" without also picking up "a +" when the "b c +" was popped off the stack,
    // which at that time consists of a b c + +.

    // THIS WAS FIXED USING HAMISH'S FALSE BOTTOM TECHNIQUE (as seen in EMAS Pop2) where instead of testing the bottom of
    // the stack at index 0, we compare against DataStack_bottom instead.  Then at the point of evaluating an <EXPR> that
    // is within explicit parentheses, we save the old stack bottom, evaluate the expr as if in a virgin empty stack, then
    // we restore the previous stack bottom.  All of which costs zero overhead in this code.  Very elegant, Hamish.

    if (debug_torp) fprintf(stderr, "\nExPop()  Oper Stack contains %d items\n", OperStack_nextfree);
    ShowRP("Expop before final transfers:");
    // 2. Pop any remaining operator tokens from the stack to the output
    while (OperStack_nextfree > OperStack_bottom) {
          Oper y;
          y = OperStack(--OperStack_nextfree);
          if (debug_torp) fprintf(stderr, "B: Transferring %ls to DataStack\n", OpDetails[y].Sym);
          _DataStack(DataStack_nextfree++) = (Op_or_Data){'O',y};
    }
    // TO DO: Construct AST tree here...
    ShowRP("Expop before converting to AST:");
    int Expr = Stack_to_Tree();
    if (DataStack_nextfree > DataStack_bottom) {
      fprintf(stderr, "? Warning: TORP stack is not empty (%d items remaining) after extracting an <EXPR> as an AST tree.\n", DataStack_nextfree);
      DataStack_nextfree = 0; OperStack_nextfree = 0; // forcibly empty for now.  only during initial development.
    }
    return Expr;
  }
  
  DECLARE(DeclStack, int, 1024);
  $define _DeclStack(x)  WRITE(x,DeclStack,int)
  $define  DeclStack(x)   READ(x,DeclStack,int)
  static int DeclStack_nextfree = 0;

  static void PushDecl(int i) {
    _DeclStack[DeclStack_nextfree++] = i;
  };
  static int PopDecl(void) {
    int i = DeclStack[--DeclStack_nextfree];
    return i;
  };


  int ArrayDims = 0;
  DECLARE(LowBound, int, 16); // is there something such as 'PHRASE' I could use instead of 'int'?
  DECLARE(HighBound, int, 16);
  $define _LowBound[n]  WRITE(n, LowBound,  int)
  $define  LowBound[n]   READ(n, LowBound,  int)
  $define _HighBound[n] WRITE(n, HighBound, int)
  $define  HighBound[n]  READ(n, HighBound, int)
  void AddDims(int Low, int High) { _LowBound[ArrayDims] = Low; _HighBound[ArrayDims] = High; ArrayDims += 1; }

  // NOT ONLY OUTPUT THE DECLARATION IN C CODE, BUT ALSO ADD DECLARATION TO SCOPED NAME TABLES.

  int ParentVarIDX = -1, ParentTypeIDX = -1;       // VarDeclIDX for procedure to which parameters are being attached.
  int Tag = -1, VTag = -1, ATag = -1;              // Tag for declarations, VTag for use. ATag for an alias.   GLOBALS.
  char *STag = NULL, *SVTag = NULL, *SATag = NULL; // STag, VTag and ATag converted to a char *.  

  extern int generate_c(int P, int depth); // forward ref.  generate_c is intended to *only* output its parameter in C form,
                                           //               it should *not* attempt to compile anything.  Its parameter should
                                           //               already have been compiled and be ready to use. (Although the lines
                                           //               may be a little blurred during the development phase)
  
  int Declaration(int depth, int More) { // returns VarDeclIDX of new declaration
                                         // if (More) just print the tag, not the whole declaration.
                                         // i.e. for "int A, B;" rather than "int A; int B;".
                              
  // <DECLARE> collects all the pieces that preceded it which were set up during the walk
  // of the CST and uses them to modify the scoped name tables.  It also outputs the
  // declarations on the fly rather than during a subsequent walk of the generated AST.

  // It may be preferable to have this code only create the data structure and add it to the
  // scope tables, leaving the generation of the corresponding C code for the declaration up
  // to a call to 'generate_c' with this data structure as a parameter (eg an AST_DECLARE tuple)

  // One reason for doing so would be to handle initialised declarations better.

  // However it may be essential to create the name tables on the fly as the state of declarations
  // may be needed to steer the parser, though at the moment it is not looking like that is necessary.
  // If it were and if we were to try to postpone the C code generation until the CST was fully
  // converted to an AST, we would have to regenerate the name tables during that tree walk.

  // Until I see a definite need to do otherwise, I'm going to assume that we can postpone the
  // creation of the name tables until the AST is walked.  Note that the reason for these issues
  // is that the ERCC compilers handled a statement at a time but this parser is (currently)
  // parsing the entire program before the AST is interpreted.


  // TO DO: when declaring a %record, create a new scope which is just for that record.
  //        then when accessing a record field, look within the scope that it attached
  //        to the parent object for the field name, which will point to the details for
  //        that field.  This will align normal declarations and fields more consistently

  // When handling things like record formats and procedure parameters, rather than resetting
  // the state variables for declarations - push them on a stack instead and *then* clear
  // them down.  So that the parameters or fields can be parsed like any other declaration
  // and then attached to the parent - pop the stack on the end of the record format or
  // formal parameter list so that anything which follows at the parent level will preserve
  // whatever context was active.


  // DESCRIBE:
  if (debug_declarations) {
    if (Object == LABELDEFN) {
    } else if (Object == VAR && Basetype == GENERIC) {
      fprintf(stdout, "  /* ");
      PrintTag(Tag); // Tag is a global containing the <NAME> that immediately preceded the <DECLARE>
      fprintf(stdout, ": TypeDecl=%d VarDecl=%d Object=%s Basetype=%s ", TypeDecl_nextfree, VarDecl_nextfree, Object_name[Object], Basetype_name[Basetype]);
      fprintf(stdout, "*/");
    } else {
      fprintf(stdout, "  /* ");
      PrintTag(Tag); // Tag is a global containing the <NAME> that immediately preceded the <DECLARE>
      fprintf(stdout, ": TypeDecl=%d VarDecl=%d Object=%s ", TypeDecl_nextfree, VarDecl_nextfree, Object_name[Object]);
      if (Object == CODE) {
        fprintf(stdout, "Proc=%s ", Proc_name[Proc]);
        fprintf(stdout, "Linkage=%s ", Linkage_name[Linkage]);
      } else if (Object == VAR) {
        fprintf(stdout, "Area=%s ", Area_name[Area]);
      }
      if (Object == VAR || (Object == CODE && Proc != ROUTINE) || Object == ARRAYFORMAT) {
        if (Basetype != RECORD && Precision != COMPOUND) fprintf(stdout, "Sign=%s ", Signedness_name[Signedness]);
        fprintf(stdout, "Prec=%s ", Precision_name[Precision]);
        fprintf(stdout, "Type=%s ", Basetype_name[Basetype]);
        fprintf(stdout, "NameInfo=%s ", NameInfo_name[NameInfo]);
      }
      if (Object == VAR) {
        if (Proc != UNINIT_PROC) fprintf(stdout, "Proc=%s ", Proc_name[Proc]);
        //fprintf(stdout, "format=%s ", IsFormat_name[IsFormat]);
        fprintf(stdout, "IsArray=%s ", IsArray_name[IsArray]);
      }
      fprintf(stdout, "Spec=%s ", Spec_name[Spec]);
      fprintf(stdout, "*/");
    }
  }
  // GENERATE CODE:

  switch (Object) {
  
    // ##################################### VARIABLES ####################################

  case VAR:

    // ####################################### AREA #######################################

    if (Area == OWN) fprintf(stdout, "static ");
    else if (Area == EXTDATA) {
      // I don't believe that these external data declarations have to come at the top level *unless* they're initialised.
      fprintf(stdout, "extern ");
        /*
              In ISO C, 'extern' does not mean 'not defined in this file', it means
              'visible outside this file'. For instance,

              extern int x(void) { return 1; }
              extern int i3 = 3;

              are both valid ISO C, although they're unusual and the compiler warns
              about the second one.
         */
    } else if (Area == CONSTANT) fprintf(stdout, "const ");

    // ##################################### BASETYPE #####################################
    
    if (Basetype == RECORD) {

      // If the type was given as a format name then let's use the typedef otherwise
      // we'll need to put the struct definition inline.  And remember when defining
      // a record format, if it refers to itself as a %name field eg to link to a next
      // item, you need to predefine it as "typedef recfm recfm" before you actually
      // typedef the contents of recfm!
      
      fprintf(stdout, "/*pending name*/recfm  ");
    } else if (Basetype == STRINGTYPE) {
      fprintf(stdout, "Imp_String ");
    } else if (Basetype == INTEGER) {
      if (Signedness == UNSIGNED) fprintf(stdout, "unsigned ");
      if (Precision == BYTE) fprintf(stdout, "char ");
      else if (Precision == SHORT) fprintf(stdout, "short int ");
      else if (Precision == WORD) fprintf(stdout, "int ");
      else if (Precision == LONGWORD) fprintf(stdout, "long int ");
      else if (Precision == QUADWORD) fprintf(stdout, "long long int ");
      else if (Precision == ADDR) fprintf(stdout, "void *");
    } else if (Basetype == FLOAT) {
      if (Precision == WORD) fprintf(stdout, "float ");
      else if (Precision == LONGWORD) fprintf(stdout, "double "); 
      else if (Precision == QUADWORD) fprintf(stdout, "long double "); 
      else if (Precision == ADDR) fprintf(stdout, "void *");
    } else if (Basetype == GENERIC) {
      fprintf(stdout, "void *"); // %name parameter
    }

    // ##################################### NAMEINFO #####################################

    if (NameInfo == OBJECTNAME) fprintf(stdout, "*");
    else if (NameInfo == ARRAYNAME) fprintf(stdout, "**");

    // ####################################### TAG ########################################

    PrintTag(Tag);

    // ###################################### ISARRAY #####################################

    if (IsArray == ARRAY) { // May need bounds
      int D;
      
      // TO DO: This prints out the declaration but does not YET add it to the name/scope tables
      // When we do, there is already an array BoundsRA for storing the data.  Note that LowBound
      // and HighBound are just temporary communication variables, not part of the long term
      // name tables.  We *could* go straight to the BoundsRA array but if/when I make that
      // decision, I need to have done a lot more validation and testing.

      // done elsewhere PrintTag(Tag);
      for (D = 0; D < ArrayDims; D++) {
        int Low = LowBound[D];
        int High = HighBound[D];

        // TO DO: if Low is not constant, create a variable that is initialised to the value
        // of the lower bound at the point where the array is declared, and use that when
        // accessing array elements via the $define macro, to protect against the value of
        // the expression representing the lower bound changing when some variable in that
        // expression is assigned to later.

        // Also, we'll need those for each dimension, maybe saved in an array of arrayname_low[ArrayDims]

        // Note that the $define to access an array element can also be used to perform
        // array bound checking on array indices (although the overhead may be significant,
        // but the error reporting should be better than what you would get from using
        // valgrind or the gcc extensions that can perform checks)

        // These macro expansions are ugly in the generated C.  It would be nicer to modify
        // the indices in the compiler which would allow the tree representing the index expression
        // to be output with fewer brackets and maybe with constants having been folded.
        // The compromise (when using imp80 to C to translate an Imp source with a view to
        // maintaining the C source in future) is to maintain the source with the embedded
        // $define directives from gtcpp rather than the cleaner pure C source that is
        // output by gtcpp.
        
        fprintf(stdout, "[(");
        generate_c(High, depth+1);
        fprintf(stdout, ")-(");
        generate_c(Low, depth+1);
        fprintf(stdout, ")+1]");
      }
      fprintf(stdout, ";\n");
      
      fprintf(stdout, "\n$define "); PrintTag(Tag);
      for (D = 0; D < ArrayDims; D++) {
        fprintf(stdout, "[N%0d]", D);
      }
      fprintf(stdout, " "); PrintTag(Tag);
      for (D = 0; D < ArrayDims; D++) {
        fprintf(stdout, "[(N%0d)-(", D);
        int Low = LowBound[D];
        generate_c(Low, depth+1);
        fprintf(stdout, ")]");
      }
      fprintf(stdout, "\n");
    }
    
    // ####################################### END ########################################

    //if (Area == PARAMETER) {
      // comma handled elsewhere
    //} else {
      //fprintf(stdout, "; "); // CANNOT OUTPUT ';' HERE IF THIS IS AN INITIALISED DECLARATION!
      // this should be handled elsewhere too...
    //}
    break;

    // ################################### PROCEDURES ####################################

  case CODE:

    // ##################################### LINKAGE #####################################

    if (Linkage == EXTPROC) {
      if (Spec == SPEC) {
        fprintf(stdout, "extern ");
      } else {
        // The body of an Imp %externalroutine does not require "extern" in C.
        // An external *spec* does *NOT* have to be at the top level although
        // an external body does.
        /*
              In ISO C, 'extern' does not mean 'not defined in this file', it means
              'visible outside this file'. For instance,

              extern int x(void) { return 1; }
              extern int i3 = 3;

              are both valid ISO C, although they are unusual and the compiler warns
              about the second one.
         */
        // declaration of an externalroutine or function etc *but* only valid if at the top level.  So check.  (TO DO)
      }
    } else if (ctrl_depth() == 0) {
      fprintf(stdout, "static ");
    } else {
      if (Spec == SPEC) fprintf(stdout, "auto "); // GCC requires "auto" for forward references to nested procedures, but not for the procedures themselves.
    }

    // ##################################### BASETYPE #####################################

    if (Proc == ROUTINE) {
      fprintf(stdout, "void ");
    } else if (Basetype == RECORD) {
      fprintf(stdout, "/*pending name*/recfm  ");
    } else if (Basetype == STRINGTYPE) {
      fprintf(stdout, "Imp_String ");
    } else {
      if (Basetype == INTEGER) {
        if (Signedness == UNSIGNED) fprintf(stdout, "unsigned ");
        if (Precision == BYTE) fprintf(stdout, "char ");
        else if (Precision == SHORT) fprintf(stdout, "short int ");
        else if (Precision == WORD) fprintf(stdout, "int ");
        else if (Precision == LONGWORD) fprintf(stdout, "long int ");
        else if (Precision == QUADWORD) fprintf(stdout, "long long int ");
        else if (Precision == ADDR) fprintf(stdout, "void *");
      } else if (Basetype == FLOAT) {
        if (Precision == WORD) fprintf(stdout, "float ");
        else if (Precision == LONGWORD) fprintf(stdout, "double "); 
        else if (Precision == QUADWORD) fprintf(stdout, "long double "); 
        else if (Precision == ADDR) fprintf(stdout, "void *");
      }
    }
    if (NameInfo == OBJECTNAME) fprintf(stdout, "*");
    if (Proc == MAP) fprintf(stdout, "*");
    PrintTag(Tag);
    
    // Moving these to point of call:
    //fprintf(stdout, "(/*to do*/)");
    //if (Spec == SPEC) fprintf(stdout, ";"); else fprintf(stdout, " {\n"); // the %end will come much later
    break;

  case RECORDFORMAT:
    fprintf(stdout, "/* TO DO: %%RECORDFORMAT DECLARATION */\n");
    break;
  case ARRAYFORMAT:
    fprintf(stdout, "/* TO DO: %%ARRAYFORMAT DECLARATION */\n");
    break;
  case SWITCHDEFN:
    fprintf(stdout, "/* TO DO: %%SWITCH DECLARATION */\n");
    break;
  case LABELDEFN:
    fprintf(stdout, "/* TO DO: %%LABEL DECLARATION */\n");
    break;
  case UNINIT_OBJECT:
    break;
  }

    _TypeDecl[TypeDecl_nextfree].Object     =  Object     ;
    _TypeDecl[TypeDecl_nextfree].Basetype   =  Basetype   ;
    _TypeDecl[TypeDecl_nextfree].Signedness =  Signedness ;
    _TypeDecl[TypeDecl_nextfree].Precision  =  Precision  ;
    _TypeDecl[TypeDecl_nextfree].Proc       =  Proc       ;
    _TypeDecl[TypeDecl_nextfree].NameInfo   =  NameInfo   ;
    _TypeDecl[TypeDecl_nextfree].Spec       =  Spec       ;
    _TypeDecl[TypeDecl_nextfree].IsArray    =  IsArray    ;
    _TypeDecl[TypeDecl_nextfree].Area       =  Area       ;
    _TypeDecl[TypeDecl_nextfree].Linkage    =  Linkage    ;
    // TO DO:
    _TypeDecl[TypeDecl_nextfree].arrfm      =  -1         ;
    _TypeDecl[TypeDecl_nextfree].parms      =  -1         ;
    _TypeDecl[TypeDecl_nextfree].recfm      =  -1         ;
    _TypeDecl[TypeDecl_nextfree].strfm      =  -1         ;
    
    _VarDecl[VarDecl_nextfree].varname      = Tag;
    _VarDecl[VarDecl_nextfree].aliasname    = -1;
    _VarDecl[VarDecl_nextfree].c_name       = Tag;
    _VarDecl[VarDecl_nextfree].type         = TypeDecl_nextfree;
    _VarDecl[VarDecl_nextfree].aform        = -1;

//fprintf(stdout, "      /* VarDecl[%d] = {varname=%s tag=%d ", VarDecl_nextfree, Tag2Str(Tag), Tag);
//fprintf(stdout, "Object=%d Basetype=%d Signedness=%d Precision=%d Proc=%d NameInfo=%d Spec=%d IsArray=%d Area=%d Linkage=%d} */\n",
//                        Object,     Basetype,     Signedness,  Precision,  Proc,   NameInfo,  Spec,   IsArray,   Area,   Linkage);


    // If this declaration is a formal parameter, attach it to the 'parms' list of the parent procedure.
    // Parameters are going to be in reverse order for now but that may not be a problem since C calls parameters in the wrong order anyway ;-)
    // But seriously, this is just the first draft.  I'll reverse the list later.
    if (Area == PARAMETER) {
      //TypeDecl[TypeDecl_nextfree].parms = TypeDecl[ParentTypeIDX].parms; // linked list (albeit reversed)
      //TypeDecl[ParentTypeIDX].parms = TypeDecl_nextfree;

      int last_link = ParentTypeIDX;
      for (;;) {
        if (TypeDecl[last_link].parms == -1) break;
        last_link = TypeDecl[last_link].parms;
      }
      TypeDecl[last_link].parms = TypeDecl_nextfree; // append to end of parameter list
    }
    
    TypeDecl_nextfree += 1;
    VarDecl_nextfree += 1;

    add_entry("decl", Tag2Str(Tag), VarDecl_nextfree-1);
    return VarDecl_nextfree-1;
  } // end of Declaration()



  int Mk_AST_procedure_call(int PVar, int depth) {
    int Var = -1;
    
    // Parameters have not yet been compile()'d
    // if <VAR> is not a procedure call, report an error
    // (remember that it might be a procedure parameter that is being called)

    Var = compile(PVar, depth+1);  // Code to evaluate P<VAR> should return a P_mktuple(AST_PROC_CALL, 0, 3, t) if appropriate
                                   // This procedure is only here to perform the various checks.

    if (P_op(Var) != AST_PROC_CALL) {
      fprintf(stderr, "* ERROR: Not a procedure\n"); // exit(1);
      return -1;
    }
    return Var;
  }






  int Compile_Var(int Parent, int PVarname, int POpt_app, int POpt_field, int depth) {

    // P<VAR> = <VARNAME><APP><Opt_Record_Field>
    // P<Opt_Record_Field> = '_'<VARNAME><APP><Opt_Record_Field>, ''

    int Varname = -1, APP = -1, Field = -1, Var = -1;
    
    if (Parent == -1) {
      // build top level
      Varname = compile(PVarname, depth+1);
      APP     = compile(POpt_app, depth+1);
      Field   = compile(POpt_field, depth+1);
      // BIG TODO GOES HERE  <-- ************************************************************ CURRENT WORK-IN-PROGRESS  Get starter code from <XXCall_or_Assign_AUI>
      Var = Varname; // = Appify(Varname, APP);
    } else {
      // modify parent with these (do it longhand, not via another proc)
      // Var = Modify_Var(Var, PVarname, POpt_app, POpt_field, depth+1);
    }
    if (Field == -1 || P_alt(Field) != 0) return Var;   // *** IN PROGRESS ***

    // '_'<VARNAME><APP><Opt_Record_Field>
    // keep (tail) recursing if <Opt_Record_Field> is not empty
    
    return Compile_Var(Var, P_P(Field, 2), P_P(Field, 3), P_P(Field, 4), depth+1);

  } // end of Compile_Var()

  int Mk_AST_assignment(int Var, int Assop, int Expr, int depth) {
    int t[LARGEST_ALT];
    
    // work out the vagaries of assigning to a name or %map, and whether
    // it is a '=' (or <-) versus a '=='
    // Do all the error reporting here - by the time the AST_ASSIGN is executed
    // by generate_c, success is assumed.

    t[1] = Assop; // OP
    t[2] = Var;   // LHS  *** THIS IS AN RVALUE TUPLE *** which is not correct but will do short-term at this stage of restructuring ...
    t[3] = Expr;  // RHS
    int Ass = P_mktuple(AST_ASSIGN, 0, 3, t);
    //Diagnose(Ass);
    return Ass;
  }





}

# Now unused code that may be cribbed from, to implement Mk_AST_assignment
# and Mk_AST_procedure_call above.
P<XXCall_or_Assign_AUI>   = <VARNAME><APP><Opt_Record_Field><Optional_Assignment> {
  {

    int Ass = compile(P(4), depth+1); // P<Optional_Assignment> = <ASSOP><EXPR>, ''
    
    if (P_alt(Ass) == 0) { // Alt=0 ASSIGNMENT

      // TO DO: under development
      int LHS = compile(P(1), depth+1);
      int VarIDX = P_P(LHS,1);
      if (VarIDX == -1) {
        fprintf(stderr, "* NAME NOT SET: %s\n", SVTag); // exit(1);
      }
      int TypeIDX = VarDecl[VarIDX].type;

      if (TypeDecl[TypeIDX].Proc == MAP) {
        // If the LHS is a %map,
        //   If <Opt_Record_Field> is present,
        //     access the field via LHS(APP)->field
        //   otherwise
        //     Indirect through the LHS to assign the value, i.e.  *LHS(APP) = RHS
        fprintf(stdout, "/*LHS is %%map*/");
      } else if (TypeDecl[TypeIDX].IsArray == ARRAY) {
        int IsName = TypeDecl[TypeIDX].NameInfo == ARRAYNAME;
        int IsRecord = TypeDecl[TypeIDX].Basetype == RECORD;
        // Similarly, if the LHS is an array:
        //  If the LHS is a recordarray, then <Opt_Record_Field> may be applied.
        //    (with "." vs "->" depending on %name)
        //  otherwise
        //    <Opt_Record_Field> must be empty
        //    VARNAME(APP) is evaluated as an LHS destination.
        //    If the LHS destination is a %name
        //      If the assignment operator is '=='
        //        then "LHS = ..."
        //      otherwise
        //        "*LHS = ..."
        //    otherwise
        //      "LHS = ..."
        if (IsName && IsRecord) {
          fprintf(stdout, "/*LHS is %%recordname array*/");
        } else if (IsName) {
          fprintf(stdout, "/*LHS is some atom %%name array*/");
        } else if (IsRecord) {
          fprintf(stdout, "/*LHS is %%record array*/");
        } else {
          //fprintf(stdout, "/*LHS is some atom array*/");
          t[1] = VarIDX;
          t[2] = -1; // DIM info for each dimension - for adjusting base offset when indexing. Not being used due to $define[][] macros.
                     // We also want to know number of dims in order to check the number of indices given. Skipping for now.  TO DO.
          t[3] = P(2); // <APP>
          LHS = P_mktuple(AST_ARRAYACCESS, 0, 3, t); // Simple array access
        }
      } else if (/* IS <APP> PRESENT? */0) {
        fprintf(stderr, "* ERROR: %s(...) DOES NOT TAKE PARAMETERS?\n", SVTag);
      }

      // Now assign RHS to LHS:
      
      // Some of this code might want to be factored out to support P<VAR> which will
      // duplicate much of what is being described here.

      // Tests for invalid type combinations will be needed as well as type casts
      // where allowed (and esp. for "<-" jam transfers)

      // LHS = <VARNAME><APP><Opt_Record_Field>;
      // Using the struct here would reduce the risk of putting a value in the wrong field!
      t[1] = P_P(Ass,1); // ASSOP
      t[2] = LHS;        // LHS
      t[3] = P_P(Ass,2); // RHS
      generate_c(P_mktuple(AST_ASSIGN, 0, 3, t), depth+1);
      
    } else { // Alt=1 PROCEDURE CALL

      // simple procedure call.  This is probably the easiest one to implement so I'll
      // tackle it first.  The only 'fancy' feature needed here is pairing off the
      // actual parameters with the formal parameters, type checking them, casting
      // if necessary, and causing an error if there are too many or too few actual
      // parameters.
      
      // extern int handle_ast_phrase(int Ph, int depth);
      // (void)handle_ast_phrase(compile(P(1), depth+1), depth+1); // <VARNAME> returns AST_RVALUE


      int RValue = compile(P(1), depth+1); // A P_mktuple(AST_RVALUE, {VarIDX})
      int VarIDX = P_P(RValue, 1);
      int VTag = VarDecl[VarIDX].varname;
      char *s = Tag2Str(VTag);
      //fprintf(stderr, "Debug VAR: VarIDX returned was %d for %s\n", VarIDX, s);
      PushVar(RValue);
      int TypeIDX = VarDecl[VarIDX].type;
      //DebugVarIDX(VarIDX);

      int param = TypeDecl[TypeIDX].parms;
      if (param == -1) {
        // fprintf(stderr, "** NO PARAMETERS\n");
      } else {
        for (;;) {
          // fprintf(stderr, "** PARAMETER is %d\n", param);
          param = TypeDecl[param].parms;
          if (param == -1) break;
        }
      }

      
      // Now we have a linked list of parameters and P(2) which is P<APP> = '('<EXPR><RESTOFAPP>')', ''
      //                                                      with P<RESTOFAPP> = ','<READLINEP><EXPR><RESTOFAPP>, ''
      // so (TO DO) evaluate each parameter in turn, with <EXPR> in the context of the parameter type.

#ifdef NEVER
      fprintf(stdout, "%s(", s);
      generate_c(compile(P(2), depth+1), depth+1);
      fprintf(stdout, ")");
#else
      t[1] = VarIDX;
      t[2] = param;
      t[3] = P(2);
      int ProcCall = P_mktuple(AST_PROC_CALL, 0, 3, t);   // This could be preferred if it worked. Which at the moment it seems not to.
      generate_c(ProcCall, depth+1);
#endif
    }
    return -1;
  }
};



C<init> = {
#ifdef IN_PARSER // regen etc use this too but don't need a lot of what uparse.c needs.
  // perform any initialisation required by the parse-time semantic routines.
  // Note that for now, we have no way of declaring data outside of
  // those procedures.  Obviously this will have to change.

  // LINE RECONSTRUCTION *might* GO HERE.  But probably not.
  
  // initially default scope is at the level appropriate for perms
  
  debug_scope = 0;
  debug_ast = 0;
  debug_ctrl_stack = 0;
  debug_compiler = 0;
  debug_declarations = 0;
  debug_torp = 0;

  //push_scope_level();
  // Declare perms, prims here
  //add_entry("decls", "NEWLINE", 42); // param can be anything. Usually index into an array of records of the appropriate type.  During initial code creation, we'll just use random tags.
  // initial top-level file-level scope, eg for %externalroutines
  //push_scope_level();
  // ready for externals

  //fprintf(stdout, "\n// Relies on using gtcpp to preprocess before cleaning up with clang-format");
  fprintf(stdout, "\n$define unless(cond) if (!(cond)) \n$define until(cond) while(!(cond))\n");
  
#endif
  return TRUE;
};

C<terminate> = {
#ifdef IN_PARSER
  // perform any final tidy-up required by the parse-time semantic routines.

  //pop_scope_level(); // from externals back to perms
  //pop_scope_level(); // from perms to none.
#endif
  return TRUE;
};

C<whitespace> = {
#ifdef IN_PARSER
  while (source(TP).ch==' ' || source(TP).ch=='\t' || source(TP).ch=='\f') {
    TP += 1;
  }
#endif
  return TRUE;
};

C<Imp77_stropping> = {
#ifdef IN_PARSER
  int debug_stropping = 0;

  // The source file has already been read trivially into source().
  
  // We will copy from source() into temp(), then perform line reconstruction
  // on temp(), writing back to source().  The parser will then parse source()
  // into atoms according to the grammar.  Initially it will only store the
  // reconstructed characters into the atoms, but once it is working, I will
  // modify it to also store the unreconsructed source for use in source-to-source
  // translations, where whitespace, embedded comments, and indentation is
  // desired in the translation, in order to mirror the original file.

  // Because unfortunately underlining in Unicode is done by a *following*
  // underline joiner character (818) rather than being a single unicode
  // code point, it is difficult to use a single-character encoding of a
  // stropped keyword letter - what the old Imp compilers would represent
  // by adding 128 to the character.  However there *is* an alternive
  // source of upper case and lower case letters in the mathematics area!

  // A:Z could be encoded as 1D400:1D419 and a:z as 1D41A:1D433 :-)
  // but for now I'm encoding keywords in lower case and variables in
  // upper case.
  
  // The 1D400+ encoding looks more or less like ordinary text if it happens
  // to be displayed (e.g. during debugging) although there should never be
  // any need to display internally-coded keywords to users of the
  // compilers built with this parser.

  // All arrays are flex and the upper bound is a limit, not a minimum.
  DECLARE(SYM, reconstructed, 128000000/*600000*/);
#define _SYM(x) WRITE(x,SYM,reconstructed)
#define  SYM(x)  READ(x,SYM,reconstructed)

  int LASTP, P = 0;
  while (source(P).ch != 0 /* WEOF */) {
    _SYM(P).ch = source(P).ch;
    _SYM(P).start = P; _SYM(P).end = P+1;
    P += 1;
  }
  _SYM(P).ch = 0 /* WEOF */;
  _SYM(P).start = P; _SYM(P).end = P; // no chars for EOF
  LASTP = P;
  
  if (debug_stropping) {
    int I;
    fprintf(stderr, "source() moved to SYM(0:%d) = \"", LASTP);
    for (I = 0; I < LASTP; I++) {
      /*if (SYM(I).ch != 0)*/ fprintf(stderr, "%lc", SYM(I).ch);
    }
    if (SYM(LASTP).ch != 0) fprintf(stderr, "[%d]", SYM(LASTP).ch);
    fprintf(stderr, "\";\n");
  };

  int FP = 0, PP = 0; // Fetch Pointer, Put Pointer.

#define DONE() \
        do {                                                                      \
            FP -= 1; /* the terminating 0*/                                       \
            _source(PP).ch = 0;                                                   \
            _source(PP).end = SYM(FP).end;                                        \
            if (debug_stropping) {                                                \
              int I;                                                              \
              fprintf(stderr, "SYM(0:%d) moved to source(0:%d) = \"", FP, PP);    \
              for (I = 0; I < PP; I++) {                                          \
                if (source(I).ch != 0) fprintf(stderr, "%lc", source(I).ch);      \
              }                                                                   \
              if (source(PP).ch != 0) fprintf(stderr, "[%d]", source(PP).ch);     \
              fprintf(stderr, "\";\n");                                           \
            }                                                                     \
            return TRUE;                                                          \
        } while (0)

  wint_t WC;

  // NOTE THAT WITH THIS IMP77 GRAMMAR, '\n' IS NOT WHITESPACE.  LINE ENDINGS ARE EXPLICITLY
  // ENTERED IN THE GRAMMAR.  (See the phrases <T>, and <NL_opt>.
  
  // uparse.c has been modified so that its implicit whitespace skipping no longer skips '\n'.
  // (The algol60 parser in contrast treats all \n's the same as spaces)
  
  // HOW TO HANDLE ' IN A PARSED COMMENT?
  //
  // %COMMENT A ' MESSES UP!
  //
  // because it keeps scanning until a closing quote.  However if you don't scan between quotes,
  // line reconstruction will lose spaces within strings!
  //
  // You can't just end a quoted string at a newline because embedded newlines are allowed.
  // And I checked Imp77 - it allows a single quote ch in a comment.

  // If line reconstruction were being done on the fly then it could be modified if we knew we were
  // in a comment, but since we're doing it all in advance, the only option to handle this appears
  // to be that whenever we're in a comment, we throw away all the following line reconstruction and
  // re-do it, with that comment handled differently.

  // Or bite the bullet and work out how to do line reconstruction on the fly (which my previous
  // imptoc did eventually manage using the 'demandload' call. So *every* fetch via TP would have
  // to be recoded as a procedure call, with on-the-fly line reconstruction, and either a way to
  // undo it if backtracking or simply never doing it any farther past TP and undoing it on backtracking.

  // What a can of worms just to handle badly designed comments.  TO DO.

#define CHECK_EOF(x) do if ((x) == 0) DONE(); else { _source(PP).end = SYM(FP-1).end; } while (0)

  // PP is the 'current' slot we are writing into.
  _source(PP).start = SYM(FP).start;

  for (;;) {

    _source(PP).end = SYM(FP).end; // Keep updated.
    WC = SYM(FP++).ch; CHECK_EOF(WC);

    if (WC == '%') { // We found a keyword.  It will always be read up to the last character of the keyword.

      for (;;) {
        WC = SYM(FP++).ch; CHECK_EOF(WC);
        if (WC == '%') {

        } else if (!isalpha(WC)) {
          // It's possible to have a bunch of '%' signs and *no* keyword characters.
          --FP; // point FP back to the non-keyword character, not as currently, the one past that.
          break;    
        } else { // isalpha(WC)
          if (isupper(WC)) WC = tolower(WC);
          _source(PP).end = SYM(FP-1).end;
          _source(PP++).ch = WC; // | 128
          _source(PP).start = SYM(FP).start;
        }
      }
      continue;
    }

    else if (WC == '{') {

      for (;;) {
        WC = SYM(FP++).ch; CHECK_EOF(WC);

        if (WC == '\n') {
          --FP; /* re-read the \n as a significant character */
          // _source(PP).end = SYM(FP-1).end; // point FP back to the newline
          break;
        }
        if (WC == '}') {  // Not sure if \n should be gobbled for {this style
          break; // but still looking.
        }
      }
      continue;
    }

    else if (WC == '\'') {
      _source(PP++).ch = WC;
      for (;;) {
        WC = SYM(FP++).ch; CHECK_EOF(WC);
        if (WC == '\'') {
          // peek ahead:
          int Peek = SYM(FP).ch; CHECK_EOF(Peek);
          if (Peek == '\'') { // doubled 's
            _source(PP++).ch = WC;
            _source(PP++).ch = Peek;
            FP++;
          } else {
            _source(PP).ch = WC;
            _source(PP).end = SYM(FP-1).end; // Leave Peek for later.
            PP++;
            break;
          }
        } else {
          _source(PP++).ch = WC;
        }
      }
      continue;
    }

    else if (WC == '"') { // TO DO: Update ' and " items in imp77 as well
      _source(PP++).ch = WC;
      for (;;) {
        WC = SYM(FP++).ch; CHECK_EOF(WC);
        if (WC == '"') {
          // peek ahead:
          int Peek = SYM(FP).ch; CHECK_EOF(Peek);
          if (Peek == '"') { // doubled "s
            _source(PP++).ch = WC;
            _source(PP++).ch = Peek;
            FP++;
          } else {
            _source(PP).ch = WC;
            _source(PP).end = SYM(FP-1).end; // Leave Peek for later.
            PP++;
            break;
          }
        } else {
          _source(PP++).ch = WC;
        }
      }
      continue;
    }

    else if (WC == ' ' || WC == '\t' || WC == '\f') {  // use iswblank(WC) instead?

      continue;
    }




    else {
      // everything else just returns one significant non-space character. This includes '\n'.

      if ((WC == '\n') && ((PP>1) && (source(PP-1).ch == 'c'))) {  // BEWARE WHEN CHANGING STROPPING ENCODING: Looking for a preceding '%C' ...
        if (PP>0) _source(PP-1).ch = ' '; // remove the '%c'
        _source(PP++).ch = ' '; // remove the newline

        // This is the only place where we gobble spaces *after* a token rather than before.
        // It may be cleaner to set a 'continuation' flag and gobble them before the next
        // symbol fetch rather than do it here in a lookahead.  Esp. wrt to reconstituting source
        // from the array for the listing file etc etc.
        // BUT FOR NOW, %C IS HANDLED BY THS HACK:

        int Lookahead = FP;
        while (SYM(Lookahead).ch == '\n' || SYM(Lookahead).ch == ' ' || SYM(Lookahead).ch == '\t' || SYM(Lookahead).ch == '\f') { // Use iswblank()?
          // No worries about  '{...}' - this behaviour seems to be identical to Imp77's
          _SYM(Lookahead).ch = ' ';   // gobble following newlines and whitespace before next significant character.
          Lookahead++;
        }
        continue;
      }

      if (iswalpha(WC) && iswlower(WC)) {
        WC = towupper(WC);  // ALSO TEMPORARY
      }
      _source(PP++).ch = WC;
      continue;
    }


    // Still skipping whitespace ...

  }

  DONE();
  P = 0;
  while (source(P).ch != 0) {
    if (debug_stropping) fprintf(stderr, "%d: ch='%lc'  start=%d:end=%d\n", P, source(P).ch, source(P).start, source(P).end);
    P++;
  }

#undef DONE
#endif
  return TRUE;
};

# INITDECS clears the declaration state down completely. PUSHDECS and POPDECS saves the state and restores it.
P<PUSHDECS>            = <INITDECS> {
  PushDecl(42);
  PushDecl(Object);
  PushDecl(Basetype);
  PushDecl(Signedness);
  PushDecl(Precision);
  PushDecl(Proc);
  PushDecl(NameInfo);
  PushDecl(Spec);
  PushDecl(IsArray);
  PushDecl(Area);
  PushDecl(Linkage);
  return -1;
};

P<POPDECS>             = '' {
  Linkage = PopDecl();
  Area = PopDecl();
  IsArray = PopDecl();
  Spec = PopDecl();
  NameInfo = PopDecl();
  Proc = PopDecl();
  Precision = PopDecl();
  Signedness = PopDecl();
  Basetype = PopDecl();
  Object = PopDecl();
  {int check = PopDecl(); if (check != 42) fprintf(stderr, "* Error: Unbalanced Decl stack\n"); }
  return -1;
};

#P<USE>                 = {
#};


P<INITDECS>            = '' {
  Object     = UNINIT_OBJECT;
  Basetype   = UNINIT_BASETYPE;
  Signedness = UNINIT_SIGNEDNESS;
  Precision  = UNINIT_PRECISION;
  Proc       = UNINIT_PROC;
  NameInfo   = NO_NAME;           // UNINIT_AN_N
  //IsFormat   = NO_FORMAT;       // UNINIT_ISFORMAT
  Spec       = NO_SPEC;           // UNINIT_SPEC
  IsArray    = SCALAR;            // UNINIT_ISARRAY
  // TO DO: Do I need an "IS_INITIALISED" tag as well?  So far, only reason for
  //        having one would be to suppress the keyword "extern" in declarations
  //        such as "%externalinteger fred = 1" which would otherwise be declared
  //        in C as "extern int fred = 1;" rather than "int fred = 1;" (at least
  //        if declared at the top level.  Placing that declaration within
  //        a nested routine is a separate issue and may be a problem. Exbedding
  //        that declaration to the top level may not be possible due to scoping rules.)
  // NOTE: A data declaration (e.g. %integer I) at the top level of a file of externals
  // or before the begin/endofprogram block is an error in Imp77 and I'm guessing in Imp80.
  Area       = (ctrl_depth() == 0 ? EXTDATA : STACK);  // UNINIT_AREA
  // However a %routine at the same level (as opposed to an %externalroutine) appears to be accepted.
  Linkage    = UNINIT_LINKAGE;    // Ditto? Check with ERCC compiler. Or ask Bob.
  return -1;
};

B<eof>=0;
B<ch>=1;
B<nl>=2;


# Parse-time code is introduced by C<...>:

{
//#endif
  int ColonFlag = 0;
//#ifdef INITCODE
}

C<COLON>       = {
  // Noting that we have just seen a label at parse time allows us
  // to handle an immediately-following comment differently, i.e.
  // by avoiding the line reconstruction (if doing so on the fly)
  // and thus preserving the text of the comment for output by a
  // source-to-source translator.
  //ColonFlag = 1; // Note that <COLON> occurs last in its list of alternatives so if it is
                 // executed at all, the parse is going to be successful.
                 // We should then reset ColonFlag at the point where it is tested (for the comments)
  return TRUE;
};                                    # BIP(1019) COLON (for label)

C<INCLUDE>     = {
  // We almost certainly need to handle include files at parse time (with a stack of
  // input files, as I'm doing in takeon.c)
  return TRUE;
};    # BIP(1038) INCLUDE (include file)

C<LISTON>      = {
  // listing control has to be done at parse time
  // (unless there is a *major* restructuring)
  return TRUE;
};    # BIP(1017) LISTON (turn on listing)

C<LISTOFF>     = {
  return TRUE;
};    # BIP(1018) LISTOFF (turn off listing)


P<nls>              = <nl> <nls>, ''; # multiple blank lines allowed, not just one.
P<READLINEP>        = <nls>, '';      # Used when there is an optional line break, eg after '=' or ',' in array initialisations.

P<S>                = <nl>, ';' {
  if (alt == 0) fprintf(stdout, "\n"); 
};                                    # required statement separator

# Note that the code associated with a grammar rule will be called in three
# contexts: 1) when parsing the concrete syntax
#           2) when converting the concrete syntax tree to an abstract syntax tree
#           3) when walking the abstract syntax tree to perform the main function
#              of the program, whether actually compiling, or converting source to
#              source, or just re-outputting the source (possibly reindented).

# to support all these options without having to invent a lot of new syntax, the
# code part of each rule can restrict when it is executed by testing various
# internally-predefined ifdef's.  X_CST is the test for use in CST to AST conversion,
# and X_AST is the test for the actual application.  Currently the C code is *not*
# being written to the *-ast.h file by regen.c so that's one less test to clutter up
# this file with.

# Scope rules:

P<DOWN> = '' {
  // unconditionally set in a %begin.  Could just put the 'push_scope_level()' in
  // the code for <begin_block> but for now I'll follow the structure of the
  // ERCC compilers and grammar.
  push_scope_level();
};

P<UP> = '' {
  // called on %end and %endofprogram
  pop_scope_level();
};