imp2c.e

    %{

    /*
    // After 6 days work on this program it is time to step back a little
    // and re-evaluate the overall structure.  Some shortcuts were taken
    // which may be too hard to undo if I leave it much longer.

    // The biggest problem is that the AST reflects a combination of
    // the syntax parse and to a small extend the underlying imp structure
    // but it doesn't reflect the structure of the generated C.

    // What we need is a parse -> syntactic structure phase, followed
    // by surface syntax -> underlying imp structure, with finally
    // imp structure -> C structure and output.  Somewhere in there
    // we could do some trivial optimisations, such as removing
    // generated constructs in expressions such as (!(...))

    // I did start a 'fixup' procedure to do the above but removed it
    // after a couple of days as it was making the code worse.

     */

    /*
    // I'm considering generating very imp-like code using macros and ()
    // rather than proper C name[][] style variables.  This makes the
    // translation *much* easier, but less C-like to read which may
    // be a problem.
     */

    #include <stdio.h>
    #include <stdlib.h>
    #include <string.h>
    #include <stdarg.h>
    #include <assert.h>

    #include "log.h"
    #include "taccutil.h"
    #include "sscanr.h"
    #include "debug.h"
    #include "mmalloc.h"

    int my_exit(int rc, int line, char *file)
    {
      fprintf(stderr, "Exit at %s, line %d\n", file, line);
      exit(rc);
      return rc;
    }

    #define exit(n) my_exit(n, __LINE__, __FILE__)

    /*
        This is an Imp to C translator based on an earlier program which was
        an Imp source formatter (and Imp to Imp translator which generated the
        common Imp80 subset from whatever language version input it was given)

        The program parses the source using a grammar derived from Peter Stephens
        Imp80 grammar; it generates an Abstract Syntax Tree, and does a minimal
        amount of symbol table management in order to differential between
        some context-sensitive language constructs (for example should "I"
        be implemented as "i", "*i", "i()", or "*i()"; or "A(2)" be "a[2]"
        or "a(2)"?)

        The translation is intended to be as high-level as possible, creating
        a source which looks like it could have been written natively in C
        rather than translated.  Some library help may be required.

        The input for this program must come from the "filter" program also
        in this directory.  Filter needs a little work done to it, for example
        one version of Imp77 allowed an implicit continuation after percent-or
        and percent-and; another used "-" as a continuation character.  Various
        versions of Imp treat "percent-C" at the end of a "!" comment differently.

        Limitations:
           1) no command line options at all.  No parameterisation of indents etc.
           2) {comments} are completely lost.  Only !Comments are preserved.
           3) The parser generator used here has several opportunities for
              optimisation which have never been taken advantage of so it is
              currently slow.  Addressing those optimisations will speed up
              this program simply by rebuilding.
           4) The parser generator uses huge amounts of Ram, especially when
              translating long declaration lists, which it does rather slowly.

        Design features: (you may call these bugs but they are deliberate)
           1) No formatting.  Post-process the output with 'indent'.
           2) Tries to map Imp strings to C strings to make more maintainable
              code; this is not always 100 percent possible

        Bugs:
           1) No error recovery whatsoever if a parse fails.  Assumes both that
              this code is correct and that the input file compiles correctly
              under Imp80
           2) The grammar this is built on was intended to be used with code
              to check certain combinations which the grammar allows but the
              language does not.  For instance an "Assop" can be "=", "==",
              "<-" (jam transfer), or "->" (string assignment).  However in
              the context of the result of a function, only "=" or maybe "<-"
              might be valid; in a map only "==" is valid, and "percent-result ->"
              is *never* valid.  Except that it is in this program, ie the
              language it accepts includes some invalid constructs.

        Notes:
           1) Interesting grammar feature found caused by the original using
              built-in phrases versus this one doing all parsing at the top level:
                 I = M'fred'
              was parsed as (name I) (assop =) (name M) <error>, i.e. the
              test for a name came before the test for a multi-constant, and
              caused a parse-fail because of the lack of lookahead by one token.
              This was corrected by adding a guard after <name> which checked for
              a quote and failed if present.

        TO DO:
           1) remove all tweaks from codegen, replace with an intermediate
              procedure which manipulates the tree, then do a simple walk
              when we acually generate code.
           2) remove the 'depth' junk, have an explicit flag for generating ';'
           3) create tables for binops, so we can easily reverse conditions etc
           4) major rationalisation of opcodes needed, clean up AST to
              canonical set - especially if/then/else stuff.
           5) MUST FIX BUG IN PARSER - broken character constants are a pain
              and editing the output each time is tedious
           6) string resolution
           7) printf and format strings instead of various imp output procs
           8) i += 1  =>   i++
           9) !(a == b && c == d)   =>  (a != b || c != d)
          10) priorities - think I can do it on output of binop (by induction)
          11) *** DECLARATIONS *** - need to build up a symbol table
          12) with symbol table, do proper I as i, *i, i() or *i()
          13) output procedures for strings, ints etc - convert X'ab01' to 0xab01
              at input stage (for all types)  Need \ in strings and consts
          14) map names to other names if they clash with keywords (eg switch)
          15) special handling for imp percent-alias external proc names. (does GCC
              have any hacks for this?)
          16) case labels need to be sorted.  I'm using pds's trick of
              planting simple labels and using a case statement to jump
              to them, but have to remember special handling for negative
              numbers (plus I have to actually decode things like 'a' rather
              than leaving them as ascii constants).  Might also consider
              gccs extension to use a jump table (&&lab)
          17) code assumes gccs extensions for nested procedures.  Unnesting
              them is *way* too complex (viz local stack frame access for
              recursive procedures - need to pass a context around as a
              parameter, put all vars in a struct.  Yech.)
          18) delete all the 'indent' stuff.
          19) Parser: as well as all the other stuff mentioned before,
              there's a problem with an unbalanced double-quote in comments!
     */

    /* This is the type of objects passed around as $1, $$ etc. */
    #define USERTYPE int

    #define RBRACE '}'
      /* Bug in tacc translation  - } skipped OK in strings but not int consts */
    #define SQUOTE 39
    #define DQUOTE 34
    #define BSLASH 92

    int exit_flag = FALSE;
    int printing = TRUE;
    int ilev = 0; /* nested begin/end for now.  Later use a stack */
    int delayed_ilev = 0;
    extern int _debug; /* set to true for parser diags */
    int label = FALSE;

    char *ProgName = "imp";
    extern char **argv;
    extern int argc;

    int verbose = FALSE;

    int formatf(char *s, ...)
    {
      return 0;
    }

    int sformatf(char *s, ...) // returns a stringpool index
    {
      /* Size the string by vfprint'ing it to /dev/null... */
      /* then heapmalloc an appropriate area                */
      char *APPROPRIATE_STRING;
      va_list ap;
      va_start(ap, s);

      {
        static FILE *nullfile = NULL;
        int string_length;

        if (nullfile == NULL) nullfile = fopen("/dev/null", "w");
        if (nullfile == NULL) {
          fprintf(stderr, "Major error - cannot open /dev/null\n");
          fflush(stderr);
          exit(1);
        }
        string_length = vfprintf(nullfile, s, ap);
        /* fclose(nullfile); */
        APPROPRIATE_STRING = tempheapmalloc(string_length+1);
        vsprintf(APPROPRIATE_STRING, s, ap);
      }
      va_end(ap);
      return(addstr(APPROPRIATE_STRING));
    }

    char *strlwr(char *orig)
    {
      char *s = orig;
      for (;;) {
        if (*s == '\0') break;
        if ((isalpha(*s)) && (isupper(*s))) *s = tolower(*s);
        s++;
      }
      return(orig);
    }

    /* --------------------------------- COMPILER SUPPORT --------------------------------------- */

    static int reals_long = FALSE;
    //static int scope_level = 0; /* 0 = prims, 1 = %begin/%endofprogram/%externalroutine */

    #define NONE 0
    #define HOLE 0

    /* Basic types - might upgrade this using the bitfields from imp77 compiler */

    const int REAL = 1;
    const int INTEGER = 2;
    const int STRING = 3;

    const int LONG = 4;
    const int BYTE = 8;
    const int HALF = 16;
    const int SHORT = 32;

    /* in case these are needed... */
    const int ARRAY = 64;
    const int RECORD = 128;
    const int NAME = 256;

    #define UOP_POS 1
    #define UOP_NEG 2
    /* UOP_NOT serves as both ~ (and its alias \ ) and %not - since Imp lacks */
    /* booleans in the C style, this is never ambiguous */
    #define UOP_NOT 3
    #define UOP_ABS 4

    /* The whole TYPE thing needs to be cleaned up a lot, this is currently */
    /* a hack driven by the parser.  We should use type bits as in the */
    /* various real imp compilers. */

    #define OP_AND 1
    #define OP_OR  2
    #define OP_PTRASSIGN 3
    #define OP_ASSIGN 4
    #define OP_JAMTRANSFER 5
    #define OP_STRINGRESOLVE 6
    #define OP_PTREQ 7
    #define OP_LE 8
    #define OP_GE 9
    #define OP_GT 10
    #define OP_LT 11
    #define OP_EQ 12
    #define OP_NE 13
    #define OP_TESTRESOLVE 14
    #define OP_PTRNE 15
    #define OP_IF 16
    #define OP_UNLESS 17
    #define OP_ADD 18
    #define OP_SUB 19
    #define OP_BITAND 20
    #define OP_IEXP 21
    #define OP_EXP 22
    #define OP_MUL 23
    #define OP_EOR 24
    #define OP_IOR 25
    #define OP_IDIV 26
    #define OP_RDIV 27
    #define OP_SHR 28
    #define OP_SHL 29
    #define OP_CONCAT 30

    /* AST entries */
    #define VAR_OR_FNCALL 1    /* fred */
    #define RECORD 2           /* left_right */
    #define ARRAY_OR_FNMAP 3   /* fred(parms) */
    #define CONST 4            /* <TYPE> 23, "jim", 3.14 */
    #define LETTERCHARCONST 5  /* 'fred' (aka M'fred') */
    #define MONOP 6            /* -<expr> */
    #define BINOP 7            /* NOTE: a op b op c op d HAS NO PRECEDENCE IN AST */
    #define BRACKET 8          /* "("<expr>")" - for forcing precedence */
    #define NUMERICLABEL 9     /* 99: */
    #define LINE 10            /* lineno "source line" */
    #define SPEC 11            /* blah %spec */
    #define TYPE_INTEGER 12    /* basic */
    #define TYPE_REAL    13    /* basic */
    #define TYPE_LONG    14    /* basic */
    #define TYPE_STRING  15    /* basic */
    #define TYPE_BYTEINTEGER 16    /* basic */
    #define TYPE_SHORTINTEGER 17    /* basic */
    #define TYPE_HALFINTEGER 18    /* basic */
    #define TYPE_RECORD  19    /* basic */
    #define PARAMLIST    20    /* first, rest */
    #define PROCCALL     21
    #define LABEL        22
    #define SWITCHLABEL  23
    #define MULTI        24
    #define RECORDFIELD  25
    #define ARRAYINDEX   26
    #define SEQUENCE     27
    #define SWITCHDECL   28
    #define COMMENT      29
    #define CONDITIONAL  30
    #define FINISHELSE   31
    #define FINISH       32
    #define LOOP         33
    #define ENDLOOP      34
    #define DECLARATION  35
    #define ENDPROG      36
    #define ENDFILE      37
    #define ENDPERM      38
    #define ENDLIST      39
    #define ENDBLOCKPROCFN 40
    #define PROCDEF      41
    #define OWNDEC       42
    #define INCLUDE      43
    #define BEGINBLOCK   44
    #define ONEVENT      45
    #define FINISHELSEIFSTART 46
    #define FINISHELSESTART 47
    #define ASM          48
    #define DEFAULTCASE  49
    #define WHILE        50
    #define UNTIL        51
    #define ALIAS        52
    #define FORLOOP      53
    #define TYPE_LONGREAL 54
    #define TYPE_LONGLONGREAL 55
    #define ROUTINE      56
    #define PREDICATE    57
    #define FUNCTION     58
    #define MAP          59
    #define ROUTINENAME      60
    #define PREDICATENAME    61
    #define FUNCTIONNAME     62
    #define MAPNAME          63
    #define PROCCALL_OR_ARRAY_OR_MAP 64
    #define ARRAYDECLARATION	65
    #define ARRAYFORMATDECLARATION	66
    #define BOUND_PAIR	67
    #define BREAK		68
    #define CONTINUE	69
    #define DECLARE_ARRAY	70
    #define DOUBLE_SIDED	71
    #define ELSE		72
    #define ELSEIFORUNLESS	73
    #define ELSESTART	74
    #define FORMALPARAMETER	75
    #define FUNCTION_PARAMETER	76
    #define GOTO_LABEL	77
    #define GOTO_SWITCH	78
    #define INITCONST	79
    #define INITCONSTARRAY	80
    #define MONITOR		81
    #define THENELSE	82
    #define OWNARRAYDEC	83
    #define RECORDFORMAT	84
    #define RECORDFORMATDECLARATION	85
    #define RECORDFORMATELEMENT	86
    #define RECORDFORMATSPEC	87
    #define RESULT		88
    #define RETURN		89
    #define SIGNAL		90
    #define STOP		91
    #define TYPE_ARRAYNAME	92
    #define TYPE_AUTO	93
    #define TYPE_CONST	94
    #define TYPE_DYNAMIC	95
    #define TYPE_EXTERN	96
    #define TYPE_EXTERNAL	97
    #define TYPE_FORMAT	98
    #define TYPE_GENERICNAME	99
    #define TYPE_NAME	100
    #define TYPE_OWN	101
    #define TYPE_PRIM	102
    #define TYPE_SYSTEM	103
    #define VARIANTRECORDFORMAT	104
    #define WHATEVER	105
    #define OWNSCALARDEC    106
    #define SUBSEQUENCE     107
    #define REPEATUNTIL     108
    #define RETURN_TRUE     109
    #define RETURN_FALSE    110
    #define C_IF_THEN_ELSE  111
    #define ELSEIFORUNLESSSTART 112
    #define IFORUNLESSSTART 113
    #define FINISHELSEIFORUNLESS 114
    #define FINISHELSEIFORUNLESSSTART 115
    #define VAR		116
    #define LAST_ITEM	VAR

    int Arity[] = {
    0, /* NONE             .                               */
    1, /* VAR_OR_FNCALL    .  "name"                       */
    2, /* RECORD           .  record   subfield            */
    2, /* ARRAY_OR_FNMAP   .  name     parms               */
    2, /* CONST            .  type     value               */
    1, /* LETTERCHARCONST  .  "string"                     */
    2, /* MONOP            .  op       expr                */
    3, /* BINOP            .  op       left       right    */
    1, /* BRACKET          .  expr                         */
    1, /* NUMERICLABEL     .  "99:"                        */
    2, /* LINE             .  lineno   "sourceline"        */
    1, /* SPEC             .  (hole for procedure)         */
    0, /* TYPE_INTEGER     .  basic                        */
    0, /* TYPE_REAL        .  basic                        */
    0, /* TYPE_LONG        .  basic                        */
    1, /* TYPE_STRING      .  basic                        */
    0, /* TYPE_BYTE        .  basic                        */
    0, /* TYPE_SHORT       .  basic                        */
    0, /* TYPE_HALF        .  basic                        */
    1, /* TYPE_RECORD      .  basic                        */
    2, /* PARAMLIST        .  first, rest                  */
    2, /* PROCCALL         .  name     params              */
    1, /* LABEL            .  name                         */
    2, /* SWITCHLABEL      .  name     index               */
    2, /* MULTI            .  simple   multi?              */
    2, /* RECORDFIELD      .  left     field               */
    2, /* ARRAYINDEX       .  array    index               */
    2, /* SEQUENCE         .  stmnt    following           */
    5, /* SWITCHDECL       .  name names? lower upper <more>       */
    1, /* COMMENT          .  "text"                       */
    3, /* CONDITIONAL      .  if-or-unl cond thenpart      */  /* NEEDS WORK - else buried in thenpart? */
    1, /* FINISHELSE       .  elsepart                     */  /* could be else-if, simple UI, or nothing */
    0, /* FINISH           .                               */
    0, /* LOOP             .                               */
    0, /* ENDLOOP          .                               */
    3, /* DECLARATION      .  type    name                 */
    0, /* ENDPROG          .                               */
    0, /* ENDFILE          .                               */
    0, /* ENDPERM          .                               */
    0, /* ENDLIST          .                               */
    0, /* ENDBLOCKPROCFN   .                               */
    6, /* PROCDEF          . <TODO>                        */ /* being lazy */
    3, /* OWNDEC           . xown type owndec              */
    1, /* INCLUDE          . "filename"                    */
    1, /* BEGINBLOCK       . {ENDPTR}                      */
    3, /* ONEVENT          . evno evlist {FINISHPTR}       */
    2, /* FINISHELSEIFSTART. <TODO>                        */
    0, /* FINISHELSESTART  .                               */
    1, /* ASM              . "string"                      */
    1, /* DEFAULTCASE      . name                          */
    2, /* WHILE            . cond stmnt                    */
    2, /* UNTIL            . cond stmnt                    */
    1, /* ALIAS            . "string"                      */
    5, /* FORLOOP          . body/hole var init inc final  */
    0, /* TYPE_LONGREAL    .                               */
    0, /* TYPE_LONGLONGREAL.                               */
    1, /* ROUTINE          . args                          */
    1, /* PREDICATE        . args                          */
    2, /* FUNCTION         . type args                     */
    2, /* MAP              . type args                     */
    1, /* ROUTINENAME      . args                          */
    1, /* PREDICATENAME    . args                          */
    2, /* FUNCTIONNAME     . type args                     */
    2, /* MAPNAME          . type args                     */
    /* THE FOLLOWING ITEMS NEED THEIR ARITIES TO BE CORRECTLY ENTERED */
    2, /* PROCCALL_OR_ARRAY_OR_MAP .                       */
    2, /* ARRAYDECLARATION .                               */
    2, /* ARRAYFORMATDECLARATION .                         */
    2, /* BOUND_PAIR       .                               */
    1, /* BREAK            .                               */
    1, /* CONTINUE         .                               */
    2, /* DECLARE_ARRAY    .                               */
    5, /* DOUBLE_SIDED     .                               */
    1, /* ELSE             .                               */
    3, /* ELSEIFORUNLESS   .                               */
    0, /* ELSESTART        .                               */
    3, /* FORMALPARAMETER  .                               */
    2, /* FUNCTION_PARAMETER .                             */
    1, /* GOTO_LABEL       .                               */
    2, /* GOTO_SWITCH      .                               */
    1, /* INITCONST        .                               */
    3, /* INITCONSTARRAY   .                               */
    0, /* MONITOR          .                               */
    2, /* THENELSE         .                               */
    6, /* OWNARRAYDEC      .                               */
    2, /* RECORDFORMAT     .                               */
    2, /* RECORDFORMATDECLARATION .                        */
    2, /* RECORDFORMATELEMENT .                            */
    1, /* RECORDFORMATSPEC .                               */
    2, /* RESULT           . ASSOP EXPR                              */
    0, /* RETURN           .                               */
    3, /* SIGNAL           .                               */
    0, /* STOP             .                               */
    0, /* TYPE_ARRAYNAME   .                               */
    0, /* TYPE_AUTO        .                               */
    0, /* TYPE_CONST       .                               */
    0, /* TYPE_DYNAMIC     .                               */
    0, /* TYPE_EXTERN      .                               */
    0, /* TYPE_EXTERNAL    .                               */
    0, /* TYPE_FORMAT      .                               */
    1, /* TYPE_GENERICNAME .                               */
    0, /* TYPE_NAME        .                               */
    0, /* TYPE_OWN         .                               */
    0, /* TYPE_PRIM        .                               */
    0, /* TYPE_SYSTEM      .                               */
    2, /* VARIANTRECORDFORMAT .                            */
    4, /* WHATEVER         .                               */
    3, /* OWNSCALARDEC     .               */
    2, /* SUBSEQUENCE      . inst seq      */
    1, /* REPEATUNTIL      . cond          */
    0, /* RETURN_TRUE      .               */
    0, /* RETURN_FALSE     .               */
    3, /* C_IF_THEN_ELSE   . if <cond> <thenpart> <elsepart> */
    2, /* ELSEIFORUNLESSSTART .            */
    2, /* IFORUNLESSSTART  .               */
    3, /* FINISHELSEIFORUNLESS .           */
    2, /* FINISHELSEIFORUNLESSSTART  .     */
    10, /* VAR             . blah blah blah */
    };

    char *Opname[] = {
      "NONE",
      "VAR_OR_FNCALL",
      "RECORD",
      "ARRAY_OR_FNMAP",
      "CONST",
      "LETTERCHARCONST",
      "MONOP",
      "BINOP",
      "BRACKET",
      "NUMERICLABEL",
      "LINE",
      "SPEC",
      "TYPE_INTEGER",
      "TYPE_REAL",
      "TYPE_LONG",
      "TYPE_STRING",
      "TYPE_BYTE",
      "TYPE_SHORT",
      "TYPE_HALF",
      "TYPE_RECORD",
      "PARAMLIST",
      "PROCCALL",
      "LABEL",
      "SWITCHLABEL",
      "MULTI",
      "RECORDFIELD",
      "ARRAYINDEX",
      "SEQUENCE",
      "SWITCHDECL",
      "COMMENT",
      "CONDITIONAL",
      "FINISHELSE",
      "FINISH",
      "LOOP",
      "ENDLOOP",
      "DECLARATION",
      "ENDPROG",
      "ENDFILE",
      "ENDPERM",
      "ENDLIST",
      "ENDBLOCKPROCFN",
      "PROCDEF",
      "OWNDEC",
      "INCLUDE",
      "BEGINBLOCK",
      "ONEVENT",
      "FINISHELSEIFSTART",
      "FINISHELSESTART",
      "ASM",
      "DEFAULTCASE",
      "WHILE",
      "UNTIL",
      "ALIAS",
      "FORLOOP",
      "TYPE_LONGREAL",
      "TYPE_LONGLONGREAL",
      "ROUTINE",
      "PREDICATE",
      "FUNCTION",
      "MAP",
      "ROUTINENAME",
      "PREDICATENAME",
      "FUNCTIONNAME",
      "MAPNAME",
      "PROCCALL_OR_ARRAY_OR_MAP",
      "ARRAYDECLARATION",
      "ARRAYFORMATDECLARATION",
      "BOUND_PAIR",
      "BREAK",
      "CONTINUE",
      "DECLARE_ARRAY",
      "DOUBLE_SIDED",
      "ELSE",
      "ELSEIFORUNLESS",
      "ELSESTART",
      "FORMALPARAMETER",
      "FUNCTION_PARAMETER",
      "GOTO_LABEL",
      "GOTO_SWITCH",
      "INITCONST",
      "INITCONSTARRAY",
      "MONITOR",
      "THENELSE",
      "OWNARRAYDEC",
      "RECORDFORMAT",
      "RECORDFORMATDECLARATION",
      "RECORDFORMATELEMENT",
      "RECORDFORMATSPEC",
      "RESULT",
      "RETURN",
      "SIGNAL",
      "STOP",
      "TYPE_ARRAYNAME",
      "TYPE_AUTO",
      "TYPE_CONST",
      "TYPE_DYNAMIC",
      "TYPE_EXTERN",
      "TYPE_EXTERNAL",
      "TYPE_FORMAT",
      "TYPE_GENERICNAME",
      "TYPE_NAME",
      "TYPE_OWN",
      "TYPE_PRIM",
      "TYPE_SYSTEM",
      "VARIANTRECORDFORMAT",
      "WHATEVER",
      "OWNSCALARDEC",
      "SUBSEQUENCE",
      "REPEATUNTIL",
      "RETURN_TRUE",
      "RETURN_FALSE",
      "C_IF_THEN_ELSE",
      "ELSEIFORUNLESSSTART",
      "IFORUNLESSSTART",
      "FINISHELSEIFORUNLESS",
      "FINISHELSEIFORUNLESSSTART",
      "VAR",
    };

    // a VAR node is a universal data holder for symbol table entries,
    // expressions etc.   Will contain things like base, type, scope,
    // size etc etc - maybe get some of the details from my own compilers101
    // postings.

    #define VAR_INTEGER 1
    #define VAR_REAL 2
    #define VAR_STRING 3
    #define VAR_RECORD 4

    // I think I also need a string pool, and a linked list in order to
    // do symbol table lookups.

    #define MAX_AST 0x100000
    int AST[MAX_AST];
    int ASTP = 100; /* leave room for crapping all over items at 0 */
    // at some point I need to actually check the array for droppings and
    // see if the potential bug ever actually existed...

    int nextpool = 0;
    #define MAX_POOL 0x100000
    char stringpool[MAX_POOL];
    #define MAX_STRING 0x10000
    char *strings[MAX_STRING];
    int nextfreestring = 0;

    int isstr(int astp)
    {
      return(astp >= MAX_AST);
    }

    int addstr(char *s)
    {
      int i;
      for (i = 0; i < nextfreestring; i++) {
        if (strcmp(s, strings[i]) == 0) return(MAX_AST+i);
      }
      strings[nextfreestring] = &stringpool[nextpool];
      nextpool += (strlen(s)+1);
      strcpy(strings[nextfreestring], s);
      return(MAX_AST + nextfreestring++);
    }

    char *str_(int astp, int line, char *file)
    {
      if ((astp - MAX_AST) < MAX_STRING) return(strings[astp - MAX_AST]);
      fprintf(stderr, "Warning: old-style string str(%c%s%c) at %s:%d\n", DQUOTE, (char *)astp, DQUOTE, file, line);
      return ((char *)astp);
    }
    #define str(a) str_(a, __LINE__, __FILE__)

    int entrypoint = 0; /* This is the pointer to our compiled program.
                           Linked list terminated by 0 */

    // in transitional code, these do nothing except pass on the hacky
    // pointer; as soon as all locations where this hack is used are
    // identified, we'll convert it into using a string pool instead,
    // and maybe as an interim measure use "0x40000000" as a flag bit to
    // escape the astp as a stringpool index.

    char *ccharconst(int type, char *s)
    {
      char line[1024];
      char *t;
      int c;
      t = line;
      switch (type) {
      case 'c':
        // 'x' '\n' '\'' etc
    // '\' -> '\\'

    //    c = *s++;
    //    assert(*s == '\0');
    //    if (c == SQUOTE) return(sformatf("%c%c%c%c", SQUOTE, BSLASH, SQUOTE, SQUOTE));
    //    if (c == '\n') return(sformatf("%c%c%c%c", SQUOTE, BSLASH, 'n', SQUOTE));
        return((char *)sformatf("%c%s%c", SQUOTE, s, SQUOTE));
        break;
      case 'M':
    // '\' -> '\\'
        // 'xxxx' - non-std gnu extension for multi-char constants
        *t++ = SQUOTE;
        {int i;
          for (i = 0; i < strlen(s); i++) {
            c = s[i];
            if (c == SQUOTE) { *t++ = c; *t++ = c;}
            else if (c == '\n') { *t++ = BSLASH; *t++ = 'n'; }
            else *t++ = c;
          }
        }
      case 'R':; // R'FFFF' is a long real expressed as hex, I think
      case 'X':
        // hex
        return((char *)sformatf("0x%s", s));
      case 'B':
        // binary
        return((char *)sformatf("b'%s'", s));
      case 'K':
        // octal 0777
        return((char *)sformatf("0%s", s));
      case 'H':
        // hex 0xFFFF
        return((char *)sformatf("0x%s", s));
      case 'C':
      case 'D':
        assert(0==1);
      }
    }

    void debug_ast(int t)
    {
      int arg;
      if (isstr(t) || (AST[t] > LAST_ITEM) || (AST[t] < 0)) {
        fprintf(stdout, "AST[%d] = %d *** Out of range!\n", t, AST[t]); exit(1);
      }
      fprintf(stdout, "// AST %d: ", t); fflush(stdout);
      fprintf(stdout, "%s", Opname[AST[t]]); fflush(stdout);

      if (Arity[AST[t]] > 0) {
        for (arg = 1; arg <= Arity[AST[t]]; arg++) {
          if (isstr(AST[t+arg])) {
            fprintf(stdout, " %s", str(AST[t+arg])); fflush(stdout);
          } else {
            fprintf(stdout, " %d", AST[t+arg]); fflush(stdout);
          }
        }
      }
      fprintf(stdout, "\n");
    }

    /* codegen outputs an AST either as a sequence of statements (including */
    /* semicolons after each, if needed) or as a single sttement, eg one */
    /* that could be used in "if (cond) then statement1; else statement2;" */
    /* In other words if single_statement is true and the parameter is a */
    /* sequence, it will be output as "{ statement1; statement2; }" with */
    /* no terminating ";" after it. */

    /* items which are not statements (eg expressions) are never output */
    /* with "{}" or ";"  ((though later they might be output as bracketed */
    /* comma-expressions)) */

    #define SINGLE_STATEMENT 1
    #define MULTIPLE_STATEMENTS 2
    #define SUB_EXPR 3

    int maketuple(int type, ...);

    int reverse_list(int astp)
    {
      int next, link, ap = astp, i, stmntcount = 0;
      while (AST[astp] == SEQUENCE) {
        stmntcount += 1;
        astp = AST[astp+2];
        if (astp == 0) break;
      }
      int temp[stmntcount];
      astp = ap;
      while (AST[astp] == SEQUENCE) {
        stmntcount -= 1;
        temp[stmntcount] = AST[astp+1];
        astp = AST[astp+2];
        if (astp == 0) break;
      }
      entrypoint = 0;
      astp = ap;
      while (AST[astp] == SEQUENCE) {
        if (entrypoint == 0) {
          entrypoint = maketuple(SEQUENCE, temp[stmntcount], HOLE);
          link = entrypoint+2;
        } else {
          next = maketuple(SEQUENCE, temp[stmntcount], HOLE);
          AST[link] = next;
          link = next+2;
        }
        stmntcount += 1;
        astp = AST[astp+2];
        if (astp == 0) break;
      }
      astp = entrypoint;
      for (i = 0; i < stmntcount; i++) {
        //fprintf(stdout, "@%d: STATEMENT at %d, link=%d\n", astp, AST[astp+1], AST[astp+2]);
        astp = AST[astp+2];
      }
      return entrypoint;
    }

    //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    #ifdef NEVER
        case RETURN:
          // for cleanness, hook into current proc/fn/map/begin (yes, begin)
          break;

        case RESULT:  // ignoring astp+1 which is assop :-(
          // hook into current fn/map
          //fixup(AST[astp+2], 1);
          break;

        case RETURN_TRUE:
          // hook into current predicate
          break;

        case RETURN_FALSE:
          // hook into current predicate
          break;

    #endif

    void codegen(int astp, int single_statement)
    {

    // the stack is for *lexical* (i.e. imp source-level) scope only

    #define SCOPE_BEGIN		1
    #define SCOPE_EVENT_START	2
    #define SCOPE_PROCFNMAPDEF	3
    #define SCOPE_MAIN		4
    #define SCOPE_FORLOOP		5
    #define SCOPE_WHILELOOP		6
    #define SCOPE_UNTILLOOP		7
    #define SCOPE_LOOP		8
    #define SCOPE_THENSTART		9
    #define SCOPE_ELSESTART		10

      static int scope, stackp = 0;
      static int scope_stack[1024];
      static int ast_stack[1024];
      static int extra_stack[1024];

      void push_scope(int scope, int astp, int extra)
      {
         assert(stackp < 1024);
         fprintf(stderr, "// PUSH %d\n", scope);
         ast_stack[stackp] = astp;
         scope_stack[stackp] = scope;
         extra_stack[stackp] = extra;
         stackp += 1;
      }

      int pop_scope(int *astp, int *extra)
      {
        int scope;
        assert(stackp > 0);
        stackp -= 1;
        *astp = ast_stack[stackp];
        *extra = extra_stack[stackp];
        scope = scope_stack[stackp];
        fprintf(stderr, "// POP -> %d [@%d]\n", scope, *astp);
        return(scope);
      }

    #define EVAL_RVALUE 1
    #define EVAL_LVALUE 2
      void eval(int astp, int a_or_v) // evaluate the value or the address
      {
        if (isstr(astp)) {

          fprintf(stdout, "%s/*V1*/", str(astp));

        } else if (AST[astp] == RECORDFIELD) {

        eval(AST[astp+1], EVAL_RVALUE);
    //    fprintf(stdout, "."); // Except if it is a name on the left, then use "->" ...
        fprintf(stdout, "->"); // Except if it is a name on the left, then use "->" ...
        eval(AST[astp+2], EVAL_RVALUE);

        } else if (AST[astp] == VAR_OR_FNCALL) {

        fprintf(stdout, "%s/*V2*/", str(AST[astp+1])); /* or %s() if FNCALL */

        } else if (AST[astp] == PROCCALL_OR_ARRAY_OR_MAP) {

        eval(AST[astp+1], EVAL_RVALUE);
        fprintf(stdout, "("); /* or *%s() if CALL and/or MAP */
        eval(AST[astp+2], EVAL_RVALUE);  // TODO: if it is a MULTI, use "][" between items, not ","
        fprintf(stdout, ")");

        } else if (AST[astp] == ARRAY_OR_FNMAP) {

        if ((isstr(AST[astp+1])) && (strcmp(str(AST[astp+1]), "charno") == 0)) { /*check scope of decln */
          assert(AST[AST[astp+2]] == MULTI);
          eval(AST[AST[astp+2]+1], EVAL_RVALUE);
          fprintf(stdout, "(("); /* or *%s() if FN or MAP */
          eval(AST[AST[astp+2]+2], EVAL_RVALUE);  // TODO: use "][" between items, not ","
          fprintf(stdout, ")-1)");
        } else if ((isstr(AST[astp+1])) && (strcmp(str(AST[astp+1]), "length") == 0)) { /*check scope of decln */
          fprintf(stdout, "strlen("); /* or *%s() if FN or MAP */
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, ")");
        } else if (isstr(AST[astp+1])) {
          eval(AST[astp+1], EVAL_RVALUE);
          fprintf(stdout, "("); /* or *%s() if FN or MAP */
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, ")");
        } else {
          eval(AST[astp+1], EVAL_RVALUE);
          fprintf(stdout, "("); /* or *%s() if FN or MAP */
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, ")");
        }

        } else if (AST[astp] == CONST) {

        /* CHECK TYPE FIRST! (more than the crude check below) */
        if (AST[astp+1] == STRING) putchar(34);
        fprintf(stdout, "%s", str(AST[astp+2]));
        if (AST[astp+1] == STRING) putchar(34);
        fprintf(stdout, "/*V3*/");
        } else if (AST[astp] == LETTERCHARCONST) {

        /* CHECK TYPE FIRST! (more than the crude check below) */
    //    putchar(SQUOTE); -- now stored in the string itself
        fprintf(stdout, "%s/*V4*/", str(AST[astp+1]));
    //    putchar(SQUOTE);

        } else if (AST[astp] == BRACKET) {

        fprintf(stdout, "(");
        eval(AST[astp+1], EVAL_RVALUE);
        fprintf(stdout, ")");

        } else if (AST[astp] == MULTI) {

        eval(AST[astp+1], EVAL_RVALUE);
        if (AST[astp+2] != 0) {
          fprintf(stdout, ", ");
          eval(AST[astp+2], EVAL_RVALUE);
        }

        } else if (AST[astp] == ARRAYINDEX) {

          eval(AST[astp+1], EVAL_RVALUE);
          fprintf(stdout, "("); // need to handle MULTI-dimensional bounds properly
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, ")");

        } else if (AST[astp] == PROCCALL) {

          if (AST[astp+2] != NONE) { // params?
            // look up name, if it is a routinename parameter, may need
            // special handling?
            fprintf(stdout, "%s/*V5*/(", str(AST[astp+1]));
            eval(AST[astp+2], EVAL_RVALUE);
            fprintf(stdout, ")\n");
          } else {
            fprintf(stdout, "%s/*V6*/()\n", str(AST[astp+1]));
          }

        } else if (AST[astp] == MONOP) {

        switch (AST[astp+1]) {

        case UOP_POS:
          eval(AST[astp+2], EVAL_RVALUE);
          break;

        case UOP_NEG:
    /* need a 'prio' procedure which outputs brackets IF brackets */
    /* are needed; eg following '-' it must be an atom, and no brackets */
    /* are needed, but if the expr contains a binop, then one is */
    /* needed.  I suspect that the same thing can be done with */
    /* binops, looking at the prios of the binop itself and of */
    /* the two children.  if the children bind tighter than the */
    /* parent, no extra parentheses are needed. */
          fprintf(stdout, "(-(");
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, "))");
          break;

        case UOP_NOT:
          fprintf(stdout, "(!("); /* is that correct C??? */
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, "))");
          break;

        case UOP_ABS:
          fprintf(stdout, "abs("); /* is that correct C??? */
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, ")");
          break;

        default:
          assert(FALSE);
        }

        } else if (AST[astp] == BINOP) {

        switch (AST[astp+1]) {

        case OP_AND:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " && ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_OR:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " || ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_PTRASSIGN:
          fprintf(stdout, "/* Pointer assignment */");
          //break;

        case OP_ASSIGN:  // astp:BINOP OP_ASSIGN LHS RHS
          { /* due to imp syntax this is a statement, not a SUB_EXPR */
          int lhs = AST[astp+2];

          if ((!isstr(lhs)) && (AST[lhs] == PROCCALL_OR_ARRAY_OR_MAP) && (AST[lhs+1] > MAX_AST) && (strcmp(str(AST[lhs+1]), "length") == 0)) {
            /* length(lhs) = n   =>   lhs[n] = '\0' */
            eval(AST[lhs+2], EVAL_LVALUE);
            fprintf(stdout, "(");
            eval(AST[astp+3], EVAL_RVALUE);
            fprintf(stdout, ") = %c%c0%c;", SQUOTE,BSLASH,SQUOTE);
            break;
          } else {

            {
              int rhs = AST[astp+3];

    // TO DO   s = a.b."xxx".d   =>    sprintf(s, "%s%sxxx%s", a, b, d);

              if ((!isstr(rhs)) && (AST[rhs] == CONST) && (AST[rhs+1] == STRING)) {
                /* lhs = "..."   =>   strcpy(lhs, "...") */
                fprintf(stdout, "strcpy(");
                eval(AST[astp+2], EVAL_RVALUE);
                fprintf(stdout, ", ");
                eval(AST[astp+3], EVAL_RVALUE);  /* should optimise for empty string  =>  *lhs = '\0' */
                fprintf(stdout, ");");
                break;
              }

    /* AST 10043: LINE 470 JUNK=JUNK."0"ifCHARNO(JUNK,LENGTH(JUNK))='0' */
    /* AST 10046: SEQUENCE 10040 10043 */
    /* AST 10049: VAR_OR_FNCALL junk */
    /* AST 10051: CONST 3 0 */
    /* AST 10054: rhs:BINOP OP_CONCAT 0 10051 */
    /* AST 10058: astp:BINOP 4 lhs=junk 10054 */
    /* 135156224,10054 */
    /*	       junk = concat (junk, "0"); */

              if ((isstr(lhs)) && ((!isstr(rhs)))) {
                if (AST[rhs] == BINOP) {
                  if (isstr(AST[AST[rhs+2]+1]) && isstr(lhs) &&
                      strcmp(str(AST[AST[rhs+2]+1]), str(lhs)) == 0) { /* one check short... */
                    if (AST[rhs+1] == OP_CONCAT) {
                      fprintf(stdout, "strcat(");
                      eval(AST[astp+2], EVAL_RVALUE);
                      fprintf(stdout, ", ");
                      eval(AST[rhs+3], EVAL_RVALUE);
                      fprintf(stdout, ")");
                    } else if (AST[rhs+1] == OP_ADD) {/* should be table-driven */
                      eval(AST[astp+2], EVAL_LVALUE);
                      fprintf(stdout, " += ");
                      eval(AST[rhs+3], EVAL_RVALUE);
                    } else if (AST[rhs+1] == OP_SUB) {
                      eval(AST[astp+2], EVAL_LVALUE);
                      fprintf(stdout, " -= ");
                      eval(AST[rhs+3], EVAL_RVALUE);
                    } else {
                      eval(AST[astp+2], EVAL_LVALUE);
                      fprintf(stdout, " = ");
                      eval(AST[astp+3], EVAL_RVALUE);
                    }
                    fprintf(stdout, ";\n");
                    break;
                  }
                }
              }

            }

            eval(AST[astp+2], EVAL_LVALUE);
            fprintf(stdout, " = ");
            eval(AST[astp+3], EVAL_RVALUE);
            fprintf(stdout, ";\n");
          }
          }
          break;

        case OP_JAMTRANSFER:
          // If LHS is a string, then use "strncpy()", else use appropriate conversion (such as "sh = (short int)iexp;")
        case OP_STRINGRESOLVE:
          // "(void)imp_resolve(...);" (or maybe lots of strstrs?)
          debug_ast(astp);
          break;

        case OP_LE:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " <= ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_GE:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " >= ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_GT:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " > ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_LT:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " < ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_PTREQ:
          // make sure both left and right are pointers, and output simple "=="
        case OP_EQ:
          {
            int rhs = AST[astp+3];
            if (AST[rhs] == CONST && AST[rhs+1] == STRING) {
              fprintf(stdout, "(strcmp(");
              eval(AST[astp+2], EVAL_RVALUE);
              fprintf(stdout, ", ");
              eval(AST[astp+3], EVAL_RVALUE);
              fprintf(stdout, ") == 0)");
              break;
            }
          }
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " == ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_PTRNE:
          // check types of operands
        case OP_NE:
          {
            int rhs = AST[astp+3];
            if (AST[rhs] == CONST && AST[rhs+1] == STRING) {
              fprintf(stdout, "strcmp(");
              eval(AST[astp+2], EVAL_RVALUE);
              fprintf(stdout, ", ");
              eval(AST[astp+3], EVAL_RVALUE);
              fprintf(stdout, ")");
              break;
            }
          }
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " != ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_TESTRESOLVE:

          if (AST[AST[astp+3]] == BRACKET) { /* I.e. only one param, S -> ("lit") */
            int param = AST[AST[astp+3]+1];
            if ((AST[param] == CONST) &&
                (AST[param+1] == STRING) &&
                (strlen(str(AST[param+2])) == 1)) {

    /* AST 1608: LINE 82 elseifS->("EXT") */
    /* AST 1611: SEQUENCE 1605 1608 */
    /* AST 1614: VAR_OR_FNCALL s */
    /* AST 1616: CONST 3 EXT */
    /* AST 1619: BRACKET 1616 */
    /* AST 1621: BINOP 14 1614 1619 */
    /* AST 1625: FINISHELSEIFSTART 16 1621 */
    /* AST 1628: SEQUENCE 1611 1625 */

              /* AST 6987: CONST 3  OUT */
              /* AST 6990: BRACKET 6987 */
              /* AST 6992: BINOP 14 6985 6990 */
              fprintf(stdout, "strchr(");
              eval(AST[astp+2], EVAL_RVALUE);
              fprintf(stdout, ", %c%c%c)", SQUOTE,*str(AST[param+2]),SQUOTE);
            } else {
              fprintf(stdout, "strstr(");
              eval(AST[astp+2], EVAL_RVALUE);
              fprintf(stdout, ", ");
              eval(AST[astp+3], EVAL_RVALUE);
              fprintf(stdout, ")");
            }
          } else {
            fprintf(stdout, "imp_resolve(");
            eval(AST[astp+2], EVAL_RVALUE);
            fprintf(stdout, ", ");
    //      REPLACE THE SIMPLE CODEGEN WITH MORE COMPLEX CODE WHICH
    //      BUILDS UP A FORMAT STRING, WHERE (X) -> %s and "lit" -> string
    //        eval(AST[astp+3], EVAL_RVALUE);
            fprintf(stdout, "%c... fill in later ...%c)", DQUOTE, DQUOTE);
          }
          break;

        case OP_IF:
        case OP_UNLESS:
          debug_ast(astp);
          break;

        case OP_ADD:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " + ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_SUB:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " - ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_BITAND:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " & ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_IEXP:
          fprintf(stdout, "iexp(");
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, ", ");
          eval(AST[astp+3], EVAL_RVALUE);
          fprintf(stdout, ")");
          break;
        case OP_EXP:
          fprintf(stdout, "exp(");
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, ", ");
          eval(AST[astp+3], EVAL_RVALUE);
          fprintf(stdout, ")");
          break;

        case OP_MUL:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " * ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_EOR:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " ^ ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_IOR:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " | ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_IDIV:
          fprintf(stdout, "((int)(");
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, ") / (int)(");
          eval(AST[astp+3], EVAL_RVALUE);
          fprintf(stdout, "))");
          break;

        case OP_RDIV:
          fprintf(stdout, "((float)(");
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, ") / (float)(");
          eval(AST[astp+3], EVAL_RVALUE);
          fprintf(stdout, "))");
          break;

        case OP_SHR:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " >> ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_SHL:
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, " << ");
          eval(AST[astp+3], EVAL_RVALUE);
          break;

        case OP_CONCAT: // check for str = str.rest and use strcat
          fprintf(stdout, "concat(");
          eval(AST[astp+2], EVAL_RVALUE);
          fprintf(stdout, ", ");
          eval(AST[astp+3], EVAL_RVALUE);
          fprintf(stdout, ")");
          break;

        default:
          debug_ast(astp);
        }
        } else {
          fprintf(stderr, "eval(): not MONOP or BINOP: %d\n", astp);
          exit(1);
        }
      }
    /* To do: patch up various conditionals so that they
       all call C_IF_THEN_ELSE */

      int arg;
      int /*p,*/ startp, extra;

    //fprintf(stdout, "CODEGEN: %d %d\n", astp, single_statement);

      if (astp == 0) return;

      if (isstr(astp)) {
        /* This is a hack... anything >= MAX_AST is assumed to be a name to be printed! */
        /*fprintf(stderr, "ERROR: astp = %d\n", astp); */
        /*fprintf(stderr, "              %s\n", (char *)astp); */
        fprintf(stdout, "%s/*X*/", str(astp));
        return;
      }

      if (isstr(astp) || AST[astp] > LAST_ITEM) {
        fprintf(stdout, "  *** Out of range!\n"); exit(1);
      }

    //debug_ast(astp);

      if (AST[astp] == BINOP) {
        eval(astp, EVAL_RVALUE);
        return;
      }

      switch(AST[astp]) {

      case SUBSEQUENCE:
        fprintf(stdout, "{");
        for (;;) {
          assert(AST[astp] == SUBSEQUENCE);
          codegen(AST[astp+1], SINGLE_STATEMENT);
          if (AST[astp+2] == 0 /* Link cell */) break;
          astp = AST[astp+2];
        }
        fprintf(stdout, "}");
        return;

      case SEQUENCE:
        /* SEQUENCE is always a link followed by a statement */
        /* would have been more consistent (lisp-like) to have them */
        /* the other way around.  May fix later. */

        codegen(AST[astp+1], SINGLE_STATEMENT);
        codegen(AST[astp+2], MULTIPLE_STATEMENTS);
        break;

      case INCLUDE:
        fprintf(stdout, "\n#include %c%s%c\n", DQUOTE,str(AST[AST[astp+1]+2]/*NEED CHECK*/),DQUOTE);
        break;

      case LINE:
        /*fprintf(stdout, "#line %d\n", AST[astp+1]); */
    /*    fprintf(stdout, " / * %s * /\n", str(AST[astp+2])); */
        break;
      case COMMENT:
        /*fprintf(stdout, " / * %s * /\n", str(AST[astp+1])); */
        break;

      case PROCCALL:
        eval(astp, EVAL_RVALUE);
        fprintf(stdout, ";\n");
        break;

      case GOTO_LABEL:
        fprintf(stdout, "goto %s;\n", str(AST[astp+1]));
        break;

      case GOTO_SWITCH:
        fprintf(stdout, "{_sw = ");
        eval(AST[astp+2], EVAL_RVALUE);
        fprintf(stdout, "; goto dispatch_%s;}\n", str(AST[astp+1]));
        break;

      case SWITCHLABEL:
        if (AST[astp+2] == 0) {
          /* simple label */
          fprintf(stdout, "%s:\n", str(AST[astp+1]));
        } else {
          /* switch label */
    /*      fprintf(stdout, "%s(", str(AST[astp+1])); */
    /*      codegen(AST[astp+2], depth+1); */
    /*      fprintf(stdout, "):\n"); */

          fprintf(stdout, "%s_", str(AST[astp+1]));
          /* TODO: fix L_'A' -> L_65, and negative values */
          eval(AST[astp+2], EVAL_RVALUE); /* emit const as simple int */
    // maybe something like:
    //       eval(maketuple(CONVERT_TO_LABEL, AST[astp+2]), EVAL_RVALUE); /* emit const as simple int */
          fprintf(stdout, ": /* ");
          eval(AST[astp+2], EVAL_RVALUE); /* and as symbol in comments */
          fprintf(stdout, " */\n");
        }
        break;

      case NUMERICLABEL:
        fprintf(stdout, "%s:\n", str(AST[astp+1]));
        break;

      case MONITOR:
        fprintf(stdout, "assert(_IMP_MONITOR_);");
        break;

      case STOP:
        fprintf(stdout, "exit(0);");
        break;

      case BEGINBLOCK: /* need to check level. if not 0, just emit { */
        {
          if (stackp == 0) { // outer-level %begin
            fprintf(stdout, "int main(int argc, char **argv) {\n");
            push_scope(SCOPE_MAIN, astp, 0);
          } else {
            static int unique = 0;
            unique += 1;
            fprintf(stdout, "\nauto inline void block_%0d(void) {\n", unique);
            // if we want to use patched up value AST[astp+1], we need a
            // fixup pass, *or* run codegen with output to /dev/null
            push_scope(SCOPE_BEGIN, astp, unique);
            // TODO!!!! Need to *call* the procedure on the %end
          }
        }
        break;

      case ONEVENT:
        assert(AST[astp+3] == HOLE);
        push_scope(SCOPE_EVENT_START, astp, 0);
        // matched up with finish, stored in extra arg.
        fprintf(stdout, "auto inline void signal_event(int event, int subevent, int extra) {\n" /*, AST[astp+3]*/);
        break;

    // AST 156: LINE 4 routineJIM(integerK)
    // AST 159: SEQUENCE 156 153
    // AST 162: ROUTINE 0
    // AST 164: TYPE_INTEGER
    // AST 165: MULTI k 0
    // AST 168: FORMALPARAMETER 164 0 165
    // AST 172: PARAMLIST 168 0
    // AST 175: PROCDEF 0 162 0 jim 0 172

      case PROCDEF:
        {
          int paramlist, multi, formalparam;
          int pendingcomma = 0;

          if (stackp > 0) fprintf(stdout, "auto "); // not top-level
          if (AST[astp+3] != SPEC) push_scope(SCOPE_PROCFNMAPDEF, astp, 0);

          fprintf(stdout, "void/*?*/ "); // see AST[astp+2]
          if ((AST[astp+2] != 0) && (AST[AST[astp+2]] == TYPE_NAME)) fprintf(stdout, "*"); // %name (UNTESTED)
          fprintf(stdout, "%s(", str(AST[astp+4]));
          paramlist = AST[astp+6];
          assert(paramlist == 0 || AST[paramlist] == PARAMLIST);
          for (;;) {
            if (paramlist == 0) break;
            formalparam = AST[paramlist+1];
            if (AST[formalparam] == FUNCTION_PARAMETER) {
              fprintf(stdout, "/* procedure parameter */");

    // AST 1068: LINE 37 routineREFILL(byteintegermapX(integerI,J),integerN,integernameCOUNT)
    // AST 1071: SEQUENCE 1068 1065
    // AST 1074: ROUTINE 0
    // AST 1076: TYPE_BYTE
    // AST 1077: MAP 0 1076
    // AST 1080: TYPE_INTEGER
    // AST 1081: MULTI j 0
    // AST 1084: MULTI i 1081
    // AST 1087: FORMALPARAMETER 1080 0 1084
    // AST 1091: PARAMLIST 1087 0
    // AST 1094: MULTI x 0
    // AST 1097: FUNCTION_PARAMETER 1077 1094
    // AST 1100: TYPE_INTEGER
    // AST 1101: MULTI n 0
    // AST 1104: FORMALPARAMETER 1100 0 1101
    // AST 1108: TYPE_INTEGER
    // AST 1109: TYPE_NAME
    // AST 1110: MULTI count 0
    // AST 1113: FORMALPARAMETER 1108 1109 1110
    // AST 1117: PARAMLIST 1113 0
    // AST 1120: PARAMLIST 1104 1117
    // AST 1123: PARAMLIST 1097 1120
    // AST 1126: PROCDEF 0 1074 0 refill 0 1123
    // AST 1133: SEQUENCE 1126 1071
              paramlist = AST[paramlist+2];

            } else if (AST[formalparam] == FORMALPARAMETER) {
              multi = AST[formalparam+3];
              for (;;) {
                if (multi == 0) break;
                assert(AST[multi] == MULTI);
                if (pendingcomma != 0) fprintf(stdout, ", ");
                if (AST[AST[formalparam+1]] == TYPE_INTEGER) fprintf(stdout, "int ");
                fprintf(stdout, "%s", str(AST[multi+1]));// need tweak to drop final comma
                pendingcomma = 1;
                multi = AST[multi+2];
              }
              paramlist = AST[paramlist+2];
            } else {
              fprintf(stderr, "AST[formalparam] = %d\n", AST[formalparam]);
              exit(1);
            }
          }
          fprintf(stdout, ")");

          if (AST[astp+3] == SPEC) {
            // if it is not an external and stackp>0 then output "auto" for forward
            // references to local procedures
            fprintf(stdout, ";");
          } else {
            fprintf(stdout, " {\n");
          }
        }
        break;

      case ARRAYDECLARATION:
    #ifdef NEVER
    #include <stdio.h>
    #include <stdlib.h>
    int main(int argc, char **argv)
    {
      // test of declaration of array(n:m) where n=100 and m=110
      int n = 100, m=110;
      int array_1_l=n, array_1_u=m; // freeze the values
      int array[array_1_u-array_1_l+1];
      #define array(N) array[(N)-array_1_l]

      array[2] = 44;
      fprintf(stdout, "array(102) = %d\n", array(102));
      exit(0);
      return(0);
    }
    #endif
    // AST 110: LINE 2 integerarrayFRED(0:10)
    // AST 113: SEQUENCE 110 107
    // AST 116: TYPE_INTEGER     <--- LOST???
    // AST 117: CONST 2 0
    // AST 120: CONST 2 10
    // AST 123: bound_pair: BOUND_PAIR 117 120
    // AST 126: bounds: MULTI 123 0
    // AST 129: name: MULTI fred 0
    // AST 132: declare_array: DECLARE_ARRAY 129 126
    // AST 135: each: MULTI 132 0
    // AST 138: astp: ARRAYDECLARATION 135

    // TO DEBUG:

    // AST 121: LINE 3 integerarrayP,Q,R,S(0:255,0:255)
    // AST 124: SEQUENCE 121 118
    // AST 127: TYPE_INTEGER
    // AST 128: MULTI s 0
    // AST 131: MULTI r 128
    // AST 134: MULTI q 131
    // AST 137: CONST 2 0
    // AST 140: CONST 2 255
    // AST 143: CONST 2 0
    // AST 146: CONST 2 255
    // AST 149: BOUND_PAIR 143 146
    // AST 152: MULTI 149 0
    // AST 155: BOUND_PAIR 137 140
    // AST 158: MULTI 155 152
    // AST 161: MULTI p 134
    // AST 164: DECLARE_ARRAY 161 158
    // AST 167: each 0:MULTI 164 0
    // AST 170: ARRAYDECLARATION 0/HOLE 167

        {
          int each, declare_array, name, bounds, bound_pair;
          each = AST[astp+2];  // TYPE is in AST[astp+1]
          for (;;) { // each group:  {fred(1:10)}, {jim,joe(2:5)}, {bert(1:2, 3:4, 5:6)}

    //      %integerarray fred(1:10), jim,joe(2:5), bert(1:2, 3:4, 5:6)

            assert(AST[each] == MULTI);
            declare_array = AST[each+1];
            assert(AST[declare_array] == DECLARE_ARRAY);
            name = AST[declare_array+1];
            assert(AST[name] == MULTI);
            for (;;) { // each name {jim},{joe}(2:5)
              bounds = AST[declare_array+2];
              assert(AST[bounds] == MULTI);
              if (AST[astp+1] != 0 && AST[AST[astp+1]] == TYPE_INTEGER) fprintf(stdout, "int ");
              fprintf(stdout, "%s", str(AST[name+1]));
              for (;;) { // each bound: bert({1:2}, {3:4}, {5:6})
                bound_pair = AST[bounds+1];
                assert(AST[bound_pair] == BOUND_PAIR);
                fprintf(stdout, "[");
                eval(AST[bound_pair+2], EVAL_RVALUE);
                fprintf(stdout, "-"); // should maketuple(OP_SUB, ...)
                eval(AST[bound_pair+1], EVAL_RVALUE);
                fprintf(stdout, "+1 /* hack for now */]");
                bounds = AST[bounds+2];
                if (bounds == 0) break;
                if (AST[bounds] == 0) break;
                assert(AST[bounds] == MULTI);
              }
              fprintf(stdout, ";\n");
              name = AST[name+2];
              if (name == 0) break;
            }
            each = AST[each+2];
            if (each == 0) break;
          }
        }
        break;

      case DECLARATION:
    /* type, TYPE_NAME/TYPE_ARRAYNAME/0, maketuple(MULTI, $2, $3)) */

    // AST 116: TYPE_INTEGER
    // AST 117: MULTI intvar 0
    // AST 120: DECLARATION 116 0 117

    // AST 127: LINE 3 integernamePOINTER
    // AST 130: SEQUENCE 127 124
    // AST 133: TYPE_INTEGER
    // AST 134: TYPE_NAME
    // AST 135: MULTI pointer 0
    // AST 138: DECLARATION 0 134 135
    // AST 138: DECLARATION 133 134 135

          if (AST[AST[astp+1]] == TYPE_INTEGER) {
            int multi = AST[astp+3];
            for (;;) {
              if (AST[AST[astp+1]] == TYPE_INTEGER) fprintf(stdout, "int ");
              if (AST[AST[astp+2]] == TYPE_NAME) fprintf(stdout, "*"); // %name
              fprintf(stdout, "%s;\n", str(AST[multi+1]));
              multi = AST[multi+2];
              if (multi == 0) break;
            }
            break;
          } else if (AST[AST[astp+1]] == TYPE_STRING) {
            int stringinfo = AST[astp+1];
            int stringsize = AST[AST[stringinfo+1]+2]; // *** ASSUMING CONST INT!
            int multi = AST[astp+3];
            for (;;) {
              if (AST[AST[astp+1]] == TYPE_STRING) fprintf(stdout, "char ");
              if (AST[AST[astp+2]] == TYPE_NAME) fprintf(stdout, "*"); // %name
              fprintf(stdout, "%s[", str(AST[multi+1]));//add brackets
              eval(AST[stringinfo+1], EVAL_RVALUE); // str(stringsize)
              fprintf(stdout, "+1];\n");//add brackets
              multi = AST[multi+2];
              if (multi == 0) break;
            }
            break;
          }
          debug_ast(astp);
        break;

      case OWNDEC: // badly named.  Actually just means initialised decln.

    /* AST 712: LINE 38 constintegerSUMMARY=0 */
    /* AST 715: SEQUENCE 709 712 */
    /* AST 718: TYPE_CONST */
    /* AST 719: TYPE_INTEGER */
    /* AST 720: CONST 2 0 */
    /* AST 723: INITCONST 720 */
    /* AST 725: WHATEVER summary 0 723 0 */
    /* AST 730: OWNSCALARDEC 0 0 725 */
    /* AST 734: OWNDEC 718 719 730 */
    /* AST 738: SEQUENCE 715 734 */
    // AST 110: LINE 2 ownintegerPRINT1=0,PRINT2=0
    // AST 113: SEQUENCE 110 107
    // AST 116: TYPE_OWN
    // AST 117: TYPE_INTEGER
    // AST 118: CONST 2 0
    // AST 121: INITCONST 118
    // AST 123: CONST 2 0
    // AST 126: INITCONST 123
    // AST 128: WHATEVER print2 0 126 0
    // AST 133: WHATEVER print1 0 121 128
    // AST 138: OWNSCALARDEC 0 0 133
    // AST 142: OWNDEC 116 117 138

        {
        int strsize = -1;
        if (AST[AST[astp+1]] == TYPE_CONST) {
          fprintf(stdout, "const ");
        } else if (AST[AST[astp+1]] == TYPE_OWN) {
          fprintf(stdout, "static ");
        } else if (AST[AST[astp+1]] == TYPE_EXTERN) {
          // ONLY IF A SPEC, or not at level 0: fprintf(stdout, "extern ");
        }

        if (AST[AST[astp+2]] == TYPE_INTEGER) {
          fprintf(stdout, "int ");
        } else if (AST[AST[astp+2]] == TYPE_STRING) {
          fprintf(stdout, "char "); strsize = AST[AST[AST[astp+2]+1]+2];
        }

        if (AST[AST[astp+3]] == OWNSCALARDEC) {
          int var = AST[astp+3];
          int pendingcomma = 0;
          if (AST[var+1] == 0 && AST[var+2] == 0) {
            int whatever = AST[var+3];
            for (;;) {
              if (AST[whatever+2] == 0) {
                int initconst = AST[whatever+3];
                if (pendingcomma != 0) fprintf(stdout, ", ");
                codegen(AST[whatever+1], SINGLE_STATEMENT);
                if (strsize != -1) {
                  fprintf(stdout, "[%s+1]", str(strsize));
                }
                if (AST[whatever+3] != 0) {
                  fprintf(stdout, " = ");
                  codegen(AST[initconst+1], SINGLE_STATEMENT);
                }
                pendingcomma = 1;
              }
              whatever = AST[whatever+4];
              if (whatever == 0) break;
            }
          }
        } else if (AST[AST[astp+3]] == OWNARRAYDEC) {

          int ownarray = AST[astp+3];
          int name = AST[ownarray+3];
          int bounds_multi = AST[ownarray+5];
          codegen(name, SUB_EXPR);
          for (;;) {
            int bound_pair = AST[bounds_multi+1];
                assert(AST[bound_pair] == BOUND_PAIR);
                fprintf(stdout, "[");
                eval(AST[bound_pair+2], EVAL_RVALUE);
                fprintf(stdout, "-");
                eval(AST[bound_pair+1], EVAL_RVALUE);
                fprintf(stdout, "+1 /* hack for now */]");
            bounds_multi = AST[bounds_multi+2];
            if (bounds_multi == 0) break;
          }

        }
        }
        fprintf(stdout, ";\n");
        break;
    /* AST 718: TYPE_CONST */
    /* AST 719: TYPE_INTEGER */
    /* AST 720: CONST 2 0 */
    /* AST 723: INITCONST 720 */
    /* AST 725: WHATEVER summary 0 723 0 */
    /* AST 730: OWNSCALARDEC 0 0 725 */
    /* AST 734: OWNDEC 718 719 730 */

      case LOOP:
        push_scope(SCOPE_LOOP, astp, 0);
        fprintf(stdout, "for (;;) {\n");
        break;

      case CONTINUE:
        // find enclosing cycle, hook up link to it.
        // may not be needed for translator but would be needed for compiler
        fprintf(stdout, "continue;");
        break;

      case BREAK:
        // find enclosing cycle, hook up link to it.
        // may not be needed for translator but would be needed for compiler
        fprintf(stdout, "break;");
        break;

      case FORLOOP:
        if (AST[astp+2] == HOLE) {
          push_scope(SCOPE_FORLOOP, astp, 0);
        }
        fprintf(stdout, "for (");
        eval(AST[astp+1], EVAL_RVALUE);
        fprintf(stdout, " = ");
        eval(AST[astp+3], EVAL_RVALUE);
        fprintf(stdout, "; ");
        eval(AST[astp+1], EVAL_RVALUE);
        fprintf(stdout, "<=");
        eval(AST[astp+5], EVAL_RVALUE);
        fprintf(stdout, "; ");
        eval(AST[astp+1], EVAL_RVALUE);
        fprintf(stdout, "+=");
        eval(AST[astp+4], EVAL_RVALUE);
        fprintf(stdout, ") ");
        if (AST[astp+2] == HOLE) {
          fprintf(stdout, " {\n");
        } else {
          codegen(AST[astp+2], SINGLE_STATEMENT);
        }
        break;

      case WHILE:
        if (AST[astp+2] == HOLE) {
          push_scope(SCOPE_WHILELOOP, astp, 0);
        }
        if (AST[astp+2] == HOLE) {
          fprintf(stdout, "while (");
          eval(AST[astp+1], EVAL_RVALUE);
          fprintf(stdout, ") {\n");
        } else {
          fprintf(stdout, "while (");
          eval(AST[astp+1], EVAL_RVALUE);
          fprintf(stdout, ") ");
          codegen(AST[astp+2], SINGLE_STATEMENT);
        }
        break;

      case UNTIL:
        if (AST[astp+2] == HOLE) {
          push_scope(SCOPE_UNTILLOOP, astp, 0);
        }
        fprintf(stdout, "do {");
        if (AST[astp+2] != HOLE) {
          codegen(AST[astp+2], SINGLE_STATEMENT);
          fprintf(stdout, "} while (!(");
          eval(AST[astp+1], EVAL_RVALUE);
          fprintf(stdout, "));");
        }
        break;

      case REPEATUNTIL:
        scope = pop_scope(&startp, &extra);
        assert(scope == SCOPE_WHILELOOP || scope == SCOPE_LOOP);
        fprintf(stdout, "if (");
        eval(AST[astp+1], EVAL_RVALUE);/* be careful with precedence/bracketing */
        fprintf(stdout, ") break;\n");
        fprintf(stdout, "}\n");
        break;

      case ELSE:
        // this is the body of the current else - hook it up to C_IF_THEN_ELSE node?
        /*if (AST[AST[astp+1]] == SEQUENCE) fprintf(stdout, "{"); */
        codegen(AST[astp+1], SINGLE_STATEMENT); /* {...} or xxx;  ??? */
        /*if (AST[AST[astp+1]] == SEQUENCE) fprintf(stdout, "}"); */
        break;

      case THENELSE:
        // this is the body of the current then - hook it up to C_IF_THEN_ELSE node?
        /*if (AST[AST[astp+1]] == SEQUENCE) fprintf(stdout, "{"); */
        codegen(AST[astp+1], SINGLE_STATEMENT); /* {...} or xxx;  ??? */
        /*if (AST[AST[astp+1]] == SEQUENCE) fprintf(stdout, "}"); */
        fprintf(stdout, " else ");    /* BE CAREFUL HERE - THERE ARE SEVERAL 'ELSE' PARTS POSSIBLE */
        codegen(AST[astp+2], SINGLE_STATEMENT); /* See 'ELSEquote:' */
        break;

    //TODO does this ever happen at the top level or is it only inside a then-part?
      case ELSESTART:
        // whatever follows here is a multi-statement sequence to be hooked
        // in to the else-part of current C_IF_THEN_ELSE
        push_scope(SCOPE_ELSESTART, astp, 0);
        fprintf(stdout, "{");
        break;

      case FINISHELSE:
        scope = pop_scope(&startp, &extra);
        assert(scope == SCOPE_THENSTART);
        fprintf(stdout, "} else ");
        codegen(AST[astp+1], SINGLE_STATEMENT);
        /*fprintf(stdout, ";\n"); */
    /* *OR*... */
    /*    codegen(AST[astp+1], 0); ??? */
        break;

      case FINISHELSEIFSTART:
        scope = pop_scope(&startp, &extra);
        assert(scope == SCOPE_THENSTART);
        push_scope(SCOPE_THENSTART, astp, 0);
        fprintf(stdout, "} else if (");
        if (AST[astp+1] == OP_UNLESS) fprintf(stdout, "!(");
        eval(AST[astp+2], EVAL_RVALUE);
        if (AST[astp+1] == OP_UNLESS) fprintf(stdout, ")");
        fprintf(stdout, ") {\n");
        break;

      case FINISHELSESTART:
        // finish off the then part, start the else part
        scope = pop_scope(&startp, &extra);
        assert(scope == SCOPE_THENSTART);
        push_scope(SCOPE_ELSESTART, astp, 0);
        fprintf(stdout, "} else {\n");
        break;

      case FINISHELSEIFORUNLESS:
        scope = pop_scope(&startp, &extra);
        assert(scope == SCOPE_THENSTART);
        fprintf(stdout, "\n} /* untested - check this line */"); // remove once tested

      case ELSEIFORUNLESS:
        // maketuple(ELSEIFORUNLESS, $2, cond, $5);
    //    fprintf(stdout, "else /* extra? */ ");
        assert(AST[astp+1] != 0);
        fprintf(stdout, "if (");
        if (AST[astp+1] == OP_UNLESS) fprintf(stdout, "!(");
        eval(AST[astp+2], EVAL_RVALUE);
        if (AST[astp+1] == OP_UNLESS) fprintf(stdout, ")");
        fprintf(stdout, ") ");
        codegen(AST[astp+3], SINGLE_STATEMENT);
        break;

      case FINISHELSEIFORUNLESSSTART:
        scope = pop_scope(&startp, &extra);
        assert(scope == SCOPE_THENSTART);
        fprintf(stdout, "} ");
      case ELSEIFORUNLESSSTART:
        fprintf(stdout, "else ");
      case IFORUNLESSSTART:
        push_scope(SCOPE_THENSTART, astp, 0);
        assert(AST[astp+1] != 0);
        fprintf(stdout, "if (");
        if (AST[astp+1] == OP_UNLESS) fprintf(stdout, "!(");
        eval(AST[astp+2], EVAL_RVALUE);
        if (AST[astp+1] == OP_UNLESS) fprintf(stdout, ")");
        fprintf(stdout, ") ");
        fprintf(stdout, "{\n");
        break;

      case CONDITIONAL: /* if-or-unl cond thenpart */

    // Nasty case: %if j=k %then j=j %else %if k=j %then k=k %and j=j %else %if j=k %then k=j %else %start

    // AST 170: ELSESTART
    // AST 171: THENELSE 166 170
    // AST 174: ELSEIFORUNLESS 16 160 171
    // AST 178: THENELSE 153 174
    // AST 181: ELSEIFORUNLESS 16 134 178
    // AST 185: THENELSE 126 181
    // AST 188: CONDITIONAL 16 120 185
    // AST 192: SEQUENCE 188 113

    #ifdef NEVER
          // originally used a 'fixup' procedure, and this complex code
          // was the only way to find the %start; now we recurse properly
          // while code generating, and find the %start whereever it is.
          // make this a C_IF_THEN_ELSE, insert a OP_NOT for unless
          assert(AST[astp+1] != 0);
          //fixup(AST[astp+2], 1);
          if (AST[astp+3] == HOLE) {
            push_scope(SCOPE_THENSTART, astp, 0);
          } else {
            int p = AST[astp+3];
            while (AST[p] == THENELSE) {
              p = AST[p+2];
              if (AST[p] == ELSEIFORUNLESS) {
                p = AST[p+3];
              }
            }
            if (AST[p] == ELSESTART) push_scope(SCOPE_ELSESTART, astp, 0);
          }
    #endif

        assert(AST[astp+1] != 0);
        fprintf(stdout, "if (");
        if (AST[astp+1] == OP_UNLESS) fprintf(stdout, "!(");
        eval(AST[astp+2], EVAL_RVALUE);
        if (AST[astp+1] == OP_UNLESS) fprintf(stdout, ")");
        fprintf(stdout, ") ");
        if (AST[astp+3] == HOLE) {
          push_scope(SCOPE_THENSTART, astp, 0);
          fprintf(stdout, "{\n");
        } else {
          codegen(AST[astp+3], SINGLE_STATEMENT);
          /*fprintf(stdout, ";\n"); */
        }
        break;

      case FINISH:
        scope = pop_scope(&startp, &extra);
        assert(scope == SCOPE_THENSTART ||
               scope == SCOPE_ELSESTART ||
               scope == SCOPE_EVENT_START);
        if (scope == SCOPE_EVENT_START) {
          // patch up HOLE in %on %event so that block can be
          // remembered and skipped during code generation
          assert(AST[startp] == ONEVENT);
          assert(AST[startp+3] == HOLE);
          AST[startp+3] = astp; // or = ap?
        }
        fprintf(stdout, "}\n");
        break;

      case ENDLOOP:
        scope = pop_scope(&startp, &extra);
        assert(scope == SCOPE_LOOP ||
               scope == SCOPE_FORLOOP ||
               scope == SCOPE_WHILELOOP ||
               scope == SCOPE_UNTILLOOP /* top-until */);

       if (AST[startp] == UNTIL) {
          fprintf(stdout, "} while (!(");
          eval(AST[startp+1], EVAL_RVALUE);
          fprintf(stdout, "));");
        } else {
          fprintf(stdout, "}\n");
        }
        break;

      case ENDBLOCKPROCFN:
        scope = pop_scope(&startp, &extra);
        assert(scope == SCOPE_PROCFNMAPDEF || scope == SCOPE_BEGIN || scope == SCOPE_MAIN);
        // allow for %begin %end %endoffile as well as %begin %endoprogram
        if (AST[startp] == BEGINBLOCK) { // back-patching only works if 2-pass :-(
          assert(AST[startp+1] == HOLE);
          AST[startp+1] = astp;
        } // more TODO
        fprintf(stdout, "}\n");
        if (scope == SCOPE_BEGIN) {
          // just finished compiling an anonymous block - now call it...
          fprintf(stdout, "block_%0d();\n", extra);
        }
        break;

      case ENDPROG:
        scope = pop_scope(&startp, &extra);
        assert(scope == SCOPE_MAIN);
        fprintf(stdout, "}\n");
        break;

      case ENDFILE:
        /* exit(0); */
        break;

      case RETURN:
        // WARNING: %return from within a %begin/%end block needs special handling
        // which *could* be faked by emitting "auto inline void block_%0d(void) {"
        // for the "%begin"...
        fprintf(stdout, "return;");
        /*if (depth == 0) fprintf(stdout, ";"); */
        break;

      case RESULT:  // ignoring astp+1 which is assop :-(
        fprintf(stdout, "return(");
        eval(AST[astp+2], EVAL_RVALUE);
        fprintf(stdout, ");");
        /*if (depth == 0) fprintf(stdout, ";"); */
        break;

      case RETURN_TRUE:
        fprintf(stdout, "return(0==0);");
        break;

      case RETURN_FALSE:
        fprintf(stdout, "return(0!=0);");
        break;

      case ARRAYINDEX: // *** TEMP ***
      case RECORDFIELD:
      case VAR_OR_FNCALL:
      case PROCCALL_OR_ARRAY_OR_MAP:
      case ARRAY_OR_FNMAP:  // need to distinguish type here, finally...
      case CONST:
      case LETTERCHARCONST:
      case BRACKET:
      case MULTI:
    fprintf(stderr, "Warning: case %d should not be called in codegen\n", AST[astp]);
        eval(astp, EVAL_RVALUE);
        break;

    // MONOP and BINOP should never be called
      default:
      fprintf(stdout, "// AST %d: %s", astp, Opname[AST[astp]]);
      for (arg = 1; arg <= Arity[AST[astp]]; arg++) {
        if (isstr(AST[astp+arg])) {
          fprintf(stdout, " %s", str(AST[astp+arg]));
        } else {
          fprintf(stdout, " %d", AST[astp+arg]);
        }
      }
      fprintf(stdout, "\n");
      }
    }

    int maketuple(int type, ...)
    {
      int arg, result = ASTP;
      ASTP += Arity[type]+1;
      AST[result] = type;

      va_list ap;

      va_start(ap, type);

      for (arg = 1; arg <= Arity[type]; arg++) {
        AST[result+arg] = va_arg(ap, int);
      }
      va_end(ap);

      debug_ast(result);
      return(result);
    }
    /* --------------------------------- COMPILER SUPPORT --------------------------------------- */

    %}

    /* Main cheats - it invokes the parsing routines explicitly,
       in order to reduce the size of the parse tree for a whole
       file.  Also allows recovery of errors at useful boundaries */

    main: ""
      {
        YYTYPE *subroot;
        void *stacktop;
        int i;

        if (strcmp(argv[argc-1], "-v") == 0) {
          argc -= 1;
          verbose = TRUE;
        }
        if (strcmp(argv[argc-1], "-d") == 0) {
          argc -= 1;
          _debug = TRUE;
        }
        if (strcmp(argv[argc-1], "-vd") == 0) {
          argc -= 1;
          _debug = TRUE;
          verbose = TRUE;
        }

        if (argc == 1) {
           yyin = fopen("test.ii", "r");
        } else if (argc != 2) {
           fprintf(stderr, "syntax: imp infile.ii\n");
           /* Let's just resume for now... */
           // yyin = fopen(argv[1], "r");
           exit(0);
        } else {
           if (
               (strcmp(argv[1]+strlen(argv[1])-4, ".imp") == 0) ||
               (strcmp(argv[1]+strlen(argv[1])-2, ".i") == 0)
              ) {
             char command[1024];
             sprintf(command, "/home/gtoal/public_html/athome/utils/new-gt-imp/filter < %s > /tmp/imptmp.ii", argv[1]);
             system(command);
             yyin = fopen("/tmp/imptmp.ii", "r");
           } else if (strcmp(argv[1]+strlen(argv[1])-3, ".ii") == 0) {
             yyin = fopen(argv[1], "r");
           } else {
             fprintf(stderr, "imp2c: file '%s' must end in .i or .imp (or be pre-processed in .ii)\n", argv[1]);
             exit(1);
           }
    // OOPS... cannot use popen, parser requires ability to fseek.
    //       static char filtered[512];
    //       sprintf(filtered, "/home/gtoal/public_html/src/imp2c/filter < %s", argv[1]);
    //       yyin = popen(filtered, "r"); // since no fclose called, doesn't matter this is popen
        }
        if (yyin == NULL) {
           fprintf(stderr, "imp: cannot open input\n");
           exit(EXIT_FAILURE);
        }

        fprintf(stderr, "%s: processing %s\n", argv[0], argv[1] == NULL ? "test.ii" : argv[1]);

        if (verbose) fprintf(stderr, "Starting\n");

        for (;;) {
          stacktop = stackmark();
          if (SS_parse(&subroot)) {
              execute_parsetree(subroot);
          } else {
              /* TEMP HACK: does this on failed parse */
              fprintf(stdout, "-----------------------------------------------------------------\n");
              codegen(entrypoint, MULTIPLE_STATEMENTS);
              fprintf(stderr, "imp2c parse failure, partial results generated\n");
              return(FALSE);
          }
          stackrelease(stacktop);
          if (exit_flag) return(TRUE);
          /* printf("\n"); */
          ilev += delayed_ilev; delayed_ilev = 0;
        }
      }
    ;

    OPERAND:        <NAME><APP><RECORDFIELD> {
                      /* If <APP> is present, this is an array or a map/fn call */
    		  /* If RECORDFIELD is present, <NAME><APP> is a record type (array or map) */
                      /* Plain <NAME> is either a simple variable/constant or a function call */

                      /* To work it out properly we do need to implement a symbol table */

                      int left;
    		  if (($2 == 0) && ($3 == 0)) {
                        $$ = maketuple(VAR_OR_FNCALL, $1);
                      } else {
                        if ($2 == 0) left = $1; else left = maketuple(ARRAY_OR_FNMAP, $1, $2);
                        if ($3 != 0) {
                          assert(AST[$3] == RECORDFIELD);
                          assert(AST[$3+1] == HOLE);
                          AST[$3+1] = left;
                          $$ = $3;
                        } else $$ = left;
                      }
    } |
                    <CONST> { /* Done */
                      $$=$1;
    } |
                    "\|"<EXPR>"\|" {
                      $$=maketuple(MONOP, UOP_ABS, $2); /* Added by GT for imp77 */
    } |
                    "\("<EXPR>"\)" {
                      $$=maketuple(BRACKET, $2); /* Done */
    };

    COPERAND:       <NAME> { $$=$1; /* Only if name is a constant! */ } |
                    <CONST> { $$=$1; } |
                    "\|"<CEXPR>"\|" { $$=maketuple(MONOP, UOP_ABS, $2); /* Added by GT for imp77 */} |
                    "\("<CEXPR>"\)" { $$=maketuple(BRACKET, $2); };

    /* Just a check to see if comments are allowed between procedures */

    CEXPR:          <UNARY><COPERAND><RESTOFCEXPR> {
    		  if ($3 != NONE) {
                        assert(AST[$3] == BINOP);
                        AST[$3+2] = $2;
                        if ($1 == 0) $$ = $3; else $$=maketuple(MONOP, $1, $3);
                      } else {
                        if ($1 == 0) $$ = $2; else $$=maketuple(MONOP, $1, $2);
    	          }
    };

    STAROREXPR:     <UNARY><COPERAND><RESTOFCEXPR> {
    		  if ($3 != NONE) {
                        assert(AST[$3] == BINOP);
                        assert(AST[$3+2] == HOLE);
                        AST[$3+2] = $2;
                        if ($1 == 0) $$ = $3; else $$=maketuple(MONOP, $1, $3);
    		  } else {
                        if ($1 == 0) $$ = $2; else $$=maketuple(MONOP, $1, $2);
    		  }
    } |
                    "\*" {
                      $$=0;
    };

    EXPR:           <UNARY><OPERAND><RESTOFEXPR> {
                      if ($3 != NONE) {
                        assert(AST[$3] == BINOP);
                        assert(AST[$3+2] == HOLE);
                        AST[$3+2] = $2;
                        if ($1 != NONE) {
                          $$ = maketuple(MONOP, $1, $3); /* Precedence with all of these may be wrong for monop */
                        } else $$ = $3;
    		  } else {
    		    if ($1 != NONE) {
                          $$ = maketuple(MONOP, $1, $2);
    		    } else {
                          $$ = $2;
    		    }
    		  }
    };

    RESTOFEXPR:     <OP><OPERAND><RESTOFEXPR> {
    		  if ($3 != NONE) {
                        assert(AST[$3] == BINOP);
                        assert(AST[$3+2] == HOLE);
                        AST[$3+2] = $2;
                        $$ = maketuple(BINOP, $1, /*hole*/0, $3);
    		  } else {
                        $$ = maketuple(BINOP, $1, /*hole*/0, $2);
    		  }
    } |
                    "" {
                        $$ = NONE;
    };

    RESTOFCEXPR:    <OP><COPERAND><RESTOFCEXPR> {
    		  if ($3 != NONE) {
                        assert(AST[$3] == BINOP);
                        assert(AST[$3+2] == HOLE);
                        AST[$3+2] = $2;
                        $$ = maketuple(BINOP, $1, /*hole*/0, $3);
    		  } else {
                        $$ = maketuple(BINOP, $1, /*hole*/0, $2);
    		  }
    } |
                    "" { $$=0; };

    APP:            "\("<EXPR><RESTOFAPP>"\)" {
                      if ($3 != NONE) {
                        $$ = maketuple(MULTI, $2, $3);
                      } else {
                        $$ = $2;
                      }
    } |
                    "" { $$=0; };

    RESTOFAPP:      ","<EXPR><RESTOFAPP> {
                      if ($3 != NONE) {
                        $$ = maketuple(MULTI, $2, $3);
                      } else {
                        $$ = $2;
                      }
    } |
                    "" { $$=0; };

    PercentIU:      "if" { $$ = OP_IF; } |
                    "unless" { $$ = OP_UNLESS; };

    PercentWU:      "while"<SC><RESTOFCOND> {
                      int cond;
                      if ($3) {
                        cond = $3;
                        assert(AST[cond] == BINOP);
                        assert(AST[cond+2] == HOLE);
                        AST[cond+2] = $2;
                      } else cond = $2;
                      $$ = maketuple(WHILE, cond, HOLE);
    } |
                    "until"<SC><RESTOFCOND> {
                      int cond;
                      if ($3) {
                        cond = $3;
                        assert(AST[cond] == BINOP);
                        assert(AST[cond+2] == HOLE);
                        AST[cond+2] = $2;
                      } else cond = $2;
                      $$ = maketuple(UNTIL, cond, HOLE);
    } |
                    "for"<CYCPARM> {
                      $$ = $2;
    };

    ALIASquote:     "alias"<TEXTTEXT> {
                      $$ = maketuple(ALIAS, $2);
    } |
                    "" { $$=0; };

    NLISTquote:     ","<NAME><NLISTquote> {
    		  $$ = maketuple(MULTI, $2, $3);
    } |
                    "" { $$=0; };

    TYPE:           "integer" { $$ = maketuple(TYPE_INTEGER); } |
                    "longinteger" { $$ = maketuple(TYPE_LONG); } |
                    "real" { $$ = maketuple(TYPE_REAL); } |
                    "longlongreal" { $$ = maketuple(TYPE_LONGLONGREAL); } |
                    "longreal" { $$ = maketuple(TYPE_LONGREAL); } |
                    "long" { $$ = maketuple(TYPE_LONG, $2); } |
                    "byteinteger" { $$ = maketuple(TYPE_BYTEINTEGER); } |
                    "byte" { $$ = maketuple(TYPE_BYTEINTEGER); } |
                    "string"<REPFACT> { $$ = maketuple(TYPE_STRING, $2); } |
                    "halfinteger" { $$ = maketuple(TYPE_HALFINTEGER); } |
                    "half" { $$ = maketuple(TYPE_HALFINTEGER); } |
    		"shortinteger" { $$ = maketuple(TYPE_SHORTINTEGER); } |
                    "short" { $$ = maketuple(TYPE_SHORTINTEGER); } |
                    "record\(\*\)" { $$ = maketuple(TYPE_RECORD, 0); /* added for Imp77 */ } |
                    "record\("<RFREF>"\)" { $$ = maketuple(TYPE_RECORD, $2); };

    FN:             "fn" { } | "function" { };

    RT:             "routine" { $$ = maketuple(ROUTINE, HOLE /* args */); } |
                    "predicate" { $$ = maketuple(PREDICATE, HOLE /* args */); /* Added for Imp77 */ } |
                    <TYPE><FN> { $$ = maketuple(FUNCTION, HOLE /* args */, $1, HOLE /* result */); } |
                    <TYPE>"map" { $$ = maketuple(MAP, HOLE /* args */, $1, HOLE /* result */); };

    FPDEL:          <TYPE><PercentQNAMEquote><NAME><NLISTquote> {
                                            /* use multi for (NAME, NLISTquote) */
    		  $$ = maketuple(FORMALPARAMETER, $/* basic type */1, $/*type-name or type_arrayname */2, maketuple(MULTI, $3, $4));
    } |
                    <RT><PercentNAMEquote><NAME><NLISTquote><FPP> {
                      int call;
                      call = $1;
                      assert(AST[$1] == ROUTINE || AST[$1] == PREDICATE ||
                             AST[$1] == FUNCTION || AST[$1] == MAP);
                      if ($2 != 0) {
                        if (AST[$1] == ROUTINE) AST[$1] == ROUTINENAME;
                        if (AST[$1] == PREDICATE) AST[$1] == PREDICATENAME;
                        if (AST[$1] == FUNCTION) AST[$1] == FUNCTIONNAME;
                        if (AST[$1] == MAP) AST[$1] == MAPNAME;
                      }
                      AST[call+1] = $5; /* Parameters */
                      $$ = maketuple(FUNCTION_PARAMETER, call, maketuple(MULTI, $3, $4));
                            /* Again, need to turn MULTI's inside-out ... */
    } |
                    "name"<NAME><NLISTquote> { /* Generic %name variable (untyped pointer) */
                      $$ = maketuple(TYPE_GENERICNAME, maketuple(MULTI, $2, $3));
    };

    PercentNAMEquote:    "name" { $$ = maketuple(TYPE_NAME); } |
                    "" { $$=0; };

    PercentQNAMEquote:    "arrayname" { $$ = maketuple(TYPE_ARRAYNAME); } |
                    "name" { $$ = maketuple(TYPE_NAME); } |
                    "" { $$=0; };

    FPP:            "\("<FPDEL><RESTOFFPLIST>"\)" {
                      $$ = maketuple(PARAMLIST, $2, $3);
    } |
                    "" { $$=0;
    };

    RESTOFFPLIST:   <commaquote><FPDEL><RESTOFFPLIST> {
                      if ($1 != NONE) {
                        $$ = maketuple(PARAMLIST, $2, $3);
    		  } else $$ = 0;
    } |
                    "" { $$=0;
    };

    PercentFORMATquote:    "format" { $$ = maketuple(TYPE_FORMAT); } |
                    "" { $$=0; };

    SC:             <EXPR><COMP><EXPR><RESTOFSC> {
                      if ($4 != NONE) {
                        int left = maketuple(BINOP, $2, $1, $3);
                        int right = maketuple(BINOP, AST[$4+1], $3, AST[$4+3]);
                        /* TO DO: $$ = maketuple(DOUBLE_SIDED, $1, $2, $3, AST[$4+1], AST[$4+3]); */
                        $$ = maketuple(BINOP, OP_AND, left, right);
                      } else {
                        $$ = maketuple(BINOP, $2, $1, $3);
                      }
    } |
                    <EXPR> {  /* predicate for imp77 - maybe not the best way to do this */
                      $$ = $1; /* TO DO - mark as predicate */
    } |
                    "\("<SC><RESTOFCOND>"\)" {
                      int cond = $3;
                      if (cond != 0) {
                          assert(AST[cond] == BINOP);
                          assert(AST[cond+2] == HOLE);
                          AST[cond+2]=$2;
                      } else {
                        cond = $2;
                      }
                      $$ = cond;
    } |
                    "not"<SC> { $$ = maketuple(MONOP, UOP_NOT, $2); };

    RESTOFSC:       <COMPtwo><EXPR> { $$ = maketuple(BINOP, $1, HOLE, $2); } |
                    "" { $$=0; };

    RESTOFCOND:     "and"<SC><RESTOFANDC> {
                      if ($3 != NONE) {
                        assert(AST[$3] == BINOP);
                        assert(AST[$3+2] == HOLE);
                        AST[$3+2] = $2;
                        $$ = maketuple(BINOP, OP_AND, HOLE, $3);
                      } else {
                        $$ = maketuple(BINOP, OP_AND, HOLE, $2);
                      }
    } |
                    "or"<SC><RESTOFORC> {
                      if ($3 != NONE) {
                        assert(AST[$3] == BINOP);
                        assert(AST[$3+2] == HOLE);
                        AST[$3+2] = $2;
                        $$ = maketuple(BINOP, OP_OR, HOLE, $3);
                      } else {
                        $$ = maketuple(BINOP, OP_OR, HOLE, $2);
                      }
    } |
                    "" { $$=0; };

    RESTOFANDC:     "and"<SC><RESTOFANDC> {
                      if ($3 != NONE) {
                        assert(AST[$3] == BINOP);
                        assert(AST[$3+2] == HOLE);
                        AST[$3+2] = $2;
                        $$ = maketuple(BINOP, OP_AND, HOLE, $3);
                      } else {
                        $$ = maketuple(BINOP, OP_AND, HOLE, $2);
                      }
    } |
                    "" { $$=0; };

    RESTOFORC:      "or"<SC><RESTOFORC> {
                      if ($3 != NONE) {
                        assert(AST[$3] == BINOP);
                        assert(AST[$3+2] == HOLE);
                        AST[$3+2] = $2;
                        $$ = maketuple(BINOP, OP_OR, HOLE, $3);
                      } else {
                        $$ = maketuple(BINOP, OP_OR, HOLE, $2);
                      }
    } |
                    "" { $$=0; };

    PercentSPECquote:    "spec" { $$ = SPEC; } |
                    "" { $$=NONE; };

    VSPECquote:    "spec" { $$ = SPEC; } |
                    "" { $$=NONE; };

    RESTOFBPLIST:   ","<EXPR>":"<EXPR><RESTOFBPLIST> {
                      $$ = maketuple(MULTI, maketuple(BOUND_PAIR, $2, $4), $5);
    } |
                    "" { $$=0; };

    DECLN:          <PercentQNAMEquote><NAME><NLISTquote> {
                      $$ = maketuple(DECLARATION, HOLE /* For type */, $1 /* TYPE_NAME/TYPE_ARRAYNAME/0 */, maketuple(MULTI, $2, $3));
    } |
                    "array"<PercentFORMATquote><ADECLN> {
                      if ($2 != 0) {
                        $$ = maketuple(ARRAYFORMATDECLARATION, HOLE, $2); // NEED TO ADD HOLES HERE TOO!
                      } else {
                        $$ = maketuple(ARRAYDECLARATION, HOLE, $3); // NEED TO ADD HOLES HERE TOO!
                      }
    };

    ADECLN:         <NAME><NLISTquote><BPAIR><RESTOFARLIST> {
                      $$ = maketuple(MULTI /* TO DO - FIX!!! (like SWITCHDECL) */, maketuple(DECLARE_ARRAY, maketuple(MULTI, $1, $2), $3), $4);
    };

    RESTOFARLIST:   ","<ADECLN> { $$ = $2; } |
                    "" { $$=0; };

    WHATEVER:       <NAME><ALIASquote><CONSTquote><RESTOFOWNDEC> {
                      $$ = maketuple(WHATEVER, $1, $2, $3, $4);
    };

    OWNDEC:         <PercentQNAMEquote><VSPECquote>
                      <WHATEVER><S> { /* I.e. initialised decln */
                      $$ = maketuple(OWNSCALARDEC, $1, $2, $3);  /* not good enough. assemble parts and DECLARE */
    } |
                    "array"<PercentFORMATquote><VSPECquote><NAME><ALIASquote><BPAIR><CONSTLIST> {
                      $$ = maketuple(OWNARRAYDEC, $2, $3, $4, $5, $6, $7);
    };

    RESTOFOWNDEC:   ","<WHATEVER> {
                      $$ = $2;
    } |
                    "" { $$=0; };

    XOWN:           "own" { $$ = maketuple(TYPE_OWN); } |
                    "external" { $$ = maketuple(TYPE_EXTERN); } |
                    "extrinsic" { $$ = maketuple(TYPE_EXTERN); } |
                    "constant" { $$ = maketuple(TYPE_CONST); } |
                    "const" { $$ = maketuple(TYPE_CONST); } |
                    "" { $$ = maketuple(TYPE_AUTO); /* Added initialised auto variables for Imp77 */ };

    CONSTLIST:      "="<CONSTITEMS> {
    		  $$ = $2;
    } |
                    "" { $$=0; };

    CONSTITEMS:     <READLINEquery><UNARY><COPERAND><RESTOFCEXPR><REPFACT><ROCL> {
                      int con /* need to fold const expr */, rest;
                      if ($2 != 0) con = maketuple(MONOP, $2, $3); else con = $3;
                      if ($4 != 0) {
                        assert(AST[$4] == BINOP);
                        assert(AST[$4+2] == HOLE);
                        AST[$4+2] = con; con = $4;
                      }
                      $$ = maketuple(INITCONSTARRAY, con, $5, $6); /* move 'rest' into a while loop */
    };

    ROCL:           ","<CONSTITEMS> {
    		  $$ = $2;
    } |
                    "" { $$=0; };

    REPFACT:        "\("<STAROREXPR>"\)" { $$ = $2; } |
                    "" { $$=0; };

    RESTOFELIST:    ","<CEXPR><RESTOFELIST> {
                      $$ = maketuple(MULTI, $2, $3);
    } |
                    "" { $$=0; };

    PercentEVENTquote:    "event" { $$=1; } |
                    "" { $$=0; };

    OPEXPR:         ","<EXPR> { $$ = $2; } |
                    "" { $$=0; };

    RESTOFREPEAT:   "until"<SC><RESTOFCOND> {
    		  if ($3 != NONE) {
                        assert(AST[$3] == BINOP);
                        assert(AST[$3+2] == NONE);
                        AST[$3+2] = $2;
                        $$ = maketuple(REPEATUNTIL, $3);
    		  } else {
                        $$ = maketuple(REPEATUNTIL, $2);
    		  }
    } |
                    "" { $$=0; };

    RESTOFSS:       <COLON> {
                      printf("{debug: label = TRUE}"); label = TRUE; $$ = $1;
    } |
                    <S> {
                      $$ = 0;
    } |
                    <PercentIU><SC><RESTOFCOND><S> {
    		  if ($3 != NONE) {
                        assert(AST[$3] == BINOP);
                        assert(AST[$3+2] == NONE);
                        AST[$3+2] = $1;
                        $$ = maketuple(CONDITIONAL, $1 /* IF or UNLESS */, $3, HOLE /* for body */);
    		  } else {
                        $$ = maketuple(CONDITIONAL, $1 /* IF or UNLESS */, $2, HOLE /* for body */);
    		  }
    } |
                    <PercentWU><S> {
                      $$ = $1; /* Need mechanism to hook up preceding UIs in PercentWU HOLE */
    };

    UIRESTOFSS:     <UI><PercentIU><SC><RESTOFCOND><S> {
    		  if ($4 != NONE) {
                        assert(AST[$4] == BINOP);
                        assert(AST[$4+2] == NONE);
                        AST[$4+2] = $3;
                        $$ = maketuple(CONDITIONAL, $2 /* IF or UNLESS */, $4, $1);
    		  } else {
                        $$ = maketuple(CONDITIONAL, $2 /* IF or UNLESS */, $3, $1);
    		  }
    } |
                    <UI><PercentWU><S> {
                      assert(AST[$2+2] == HOLE);
                      AST[$2+2] = $1;
                      $$ = $2;
    };

    RESTOFIU:       "start" { $$ = 0; } |
                    "thenstart" { $$ = 0; } |
                    "then"<UI><ELSEquote> { /* ELSE Needs special handling TODO */
                      if ($3 != NONE) {
                        // $3 = 0, or ELSESTART, ELSEIFORUNLESSSTART, ELSEIFORUNLESS, ELSE
    		    $$ = maketuple(THENELSE, $2, $3);
    		  } else {
                        $$ = $2;
    		  }
    };

    ELSEquote:     "elsestart" {
                     $$ = maketuple(ELSESTART);
    } |
                    "else"<PercentIU><SC><RESTOFCOND><RESTOFIU> {
                      int cond;
    		  if ($4 != NONE) {
                        assert(AST[$4] == BINOP);
                        assert(AST[$4+2] == NONE);
                        AST[$4+2] = $3;
                        cond = $4;
    		  } else {
                        cond = $3;
    		  }
                      if ($5 == 0) {
                        $$ = maketuple(ELSEIFORUNLESSSTART, $2, cond);
                      } else {
                        // $5 = tuple(THENELSE,
                        //  (ELSESTART, ELSEIFORUNLESSSTART, ELSEIFORUNLESS, ELSE))
                        assert(AST[$5] == THENELSE);//zxcv
                        $$ = maketuple(ELSEIFORUNLESS, $2, cond, $5);
                      }
    } |
                    "else"<UI> { $$ = maketuple(ELSE, $2);
    } |
                    "" { $$=0; };

    BPAIR:          "\("<EXPR>":"<EXPR><RESTOFBPLIST>"\)" {
                      $$ = maketuple(MULTI, maketuple(BOUND_PAIR, $2, $4), $5);
    };

    CONSTquote:    "="<UNARY><OPERAND><RESTOFCEXPR> {

                    int con; /* need to fold const expr */
                    if ($2 != 0) con = maketuple(MONOP, $2, $3); else con = $3;
                    if ($4 != 0) {
                      assert(AST[$4] == BINOP);
                      assert(AST[$4+2] == HOLE);
                      AST[$4+2] = con; con = $4;
                    }
                    $$ = maketuple(INITCONST, con);
    } |
                    "" { $$=0; };

    PercentSEX:     "system" { $$ = maketuple(TYPE_SYSTEM); } |
                    "external" { $$ = maketuple(TYPE_EXTERNAL); } |
                    "dynamic" { $$ = maketuple(TYPE_DYNAMIC); } |
                    "prim" { $$ = maketuple(TYPE_PRIM); /* Added for Imp77 */ } |
                    "" { $$=0; };

    CYCPARM:        <NAME>"="<EXPR>","<EXPR>","<EXPR> {
    		  $$ = maketuple(FORLOOP, $1, HOLE, $3, $5, $7);
                      /* Hole is for body of loop AND MUST BE IN AST[2] for while/until compat */
    } |
                    "" { $$=0; };

    RESTOFRFDEC:    ","<RFDEC><RESTOFRFDEC> {
                      $$ = maketuple(MULTI, $2, $3);
    } |
                    "" { $$=0; };

    RFSTMNT:        "spec"<NAME> {
                      $$ = maketuple(RECORDFORMATSPEC, $2);
    } |
                    <NAME>"\("<RFDEC><RESTOFRFDEC><ALTRFDEC>"\)" {
                      if ($5 != NONE) {
                        $$ = maketuple(VARIANTRECORDFORMAT, $1, maketuple(MULTI, $3, $4), $5);
                      } else {
                        $$ = maketuple(RECORDFORMAT, $1, maketuple(MULTI, $3, $4));
    		  }
    };

    RFREF:          <NAME> {
                      $$ = $1;
    } |
                    <RFDEC><RESTOFRFDEC><ALTRFDEC> {
                      if ($3 != NONE) {
                        $$ = maketuple(VARIANTRECORDFORMAT, $1, maketuple(MULTI, $1, $2), $3);
                      } else {
                        $$ = maketuple(RECORDFORMAT, HOLE, maketuple(MULTI, $1, $2));
    		  }
    };

    RFDEC:          <TYPE><RFELMNT> {
                      $$ = maketuple(RECORDFORMATDECLARATION, $1, $2);
    } |
                    "\("<RFDEC><RESTOFRFDEC><ALTRFDEC>"\)" {
                      if ($4 != NONE) {
                        $$ = maketuple(VARIANTRECORDFORMAT, maketuple(MULTI, $2, $3), $4);
                      } else {
                        $$ = maketuple(RECORDFORMAT /* WRONG TAG! */, NONE, maketuple(MULTI, $2, $3));
    		  }
    };

    RFELMNT:        <PercentQNAMEquote><NAME><NLISTquote> {
                      $$ = maketuple(RECORDFORMATELEMENT, $1 /* name or arrayname */, maketuple(MULTI, $2, $3));
    } |
                    "array"<ADECLN> {
                      $$ = $2; /* is this sufficient? */
    };

    ALTRFDEC:       "or"<RFDEC><RESTOFRFDEC><ALTRFDEC> {
                      if ($4 != NONE) {
                        $$ = maketuple(VARIANTRECORDFORMAT, maketuple(MULTI, $2, $3), $4);
                      } else {
                        $$ = maketuple(RECORDFORMAT /* WRONG TAG! */, NONE, maketuple(MULTI, $2, $3));
    		  }
    } |
                    "" { $$=0; };

    OPTINC:         "+"<N> { $$ = formatf("+%s", $2); } |
                    "-"<N> { $$ = formatf("-%s", $2); } |
                    "" { $$=0; };

    ATquote:       "@" { $$ = formatf("%s", @1.text); } |
                    "=" { $$ = formatf("%s", @1.text); } |
                    "" { $$=0; };

    XAPP:            "\("<EXPR><RESTOFAPP>"\)" {
                      $$ = maketuple(MULTI, $2, $3);
    };

    RECORDFIELD:    "_"<NAME><APP><RECORDFIELD> {
                      int field;
                      if ($3 != 0) {
                        field =  maketuple(ARRAYINDEX, $2, $3);
                      } else {
                        field = $2;
                      }
                      if ($4 != 0) {
                        int node = $4;
                        assert(AST[node+1] == HOLE);
                        AST[node+1] = maketuple(RECORDFIELD, HOLE, field);
                        $$ = node;
                      } else {
                        $$ = maketuple(RECORDFIELD, HOLE, field);
                      }
    } |
                    "" { $$=0; };

    XRECORDFIELD:    "_"<NAME><APP><RECORDFIELD> {
                      int field;
                      if ($3 != 0) {
                        field =  maketuple(ARRAYINDEX, $2, $3);
                      } else {
                        field = $2;
                      }
                      if ($4 != 0) {
                        int node = $4;
                        assert(AST[node+1] == HOLE);
                        AST[node+1] = maketuple(RECORDFIELD, HOLE, field);
                        $$ = node;
                      } else {
                        $$ = maketuple(RECORDFIELD, HOLE, field);
                      }
    };

    NAMEAPP:        <NAME><XAPP> { /* NOTE: MAY BE AN ARRAY ACCESS */
                      $$ = maketuple(PROCCALL_OR_ARRAY_OR_MAP, $1, $2);
    } |             <NAME> {
                      $$ = maketuple(PROCCALL, $1, 0);
    };

    BASIC:
                    <NAME><XAPP><XRECORDFIELD><ASSOP><EXPR> {
                      /* record array element with subfield assignment */
    /* TODO  fred(1)_jim = 3  may be a map to a record */
                    int lhs = maketuple(ARRAYINDEX, $1, $2);
                    assert(AST[$3+1] == HOLE);
                    AST[$3+1] = lhs;
                      $$ = maketuple(BINOP, $4, $3, $5);
    } |
                    <NAME><XRECORDFIELD><ASSOP><EXPR> {
                      /* record with subfield assignment */
                      assert(AST[$2+1] == HOLE);
                      AST[$2+1] = $1;
                      $$ = maketuple(BINOP, $3, $2, $4);
    } |
                    <NAME><XAPP><ASSOP><EXPR> {
                      /* array element assignment */
                      $$ = maketuple(BINOP, $3, maketuple(PROCCALL_OR_ARRAY_OR_MAP, $1, $2), $4);
    } |
                    <NAME><ASSOP><EXPR> {
                      /* variable or map assignment */
                      $$ = maketuple(BINOP, $2, $1, $3);
    } |
                    <NAME><APP>":" {
                      /* Switch label.  possibly regular label if APP is null??? */
    		  $$ = maketuple(SWITCHLABEL, $1, $2);
    } |
                    <NAME>":" {
    		  $$ = maketuple(LABEL, $1);
    } |
                    <NAME><XAPP> {
                      /* procedure call with params. */
    		  $$ = maketuple(PROCCALL, $1, $2);
    } |
                    <NAME> {
                      /* procedure call, no params. */
    		  $$ = maketuple(PROCCALL, $1, 0);
    };

    /* NOTE: imp80 does not allow  %if a=b %then x=y %and %start */

    AUI:            "and"<UI> {
                      $$ = $1;
    } |
                    "" { $$=0; };

    UI:             <BASIC>"and"<UI> {
                      if (AST[$3] != SUBSEQUENCE) $3 = maketuple(SUBSEQUENCE, $3, 0); // end of list
                      $$ = maketuple(SUBSEQUENCE, $1, $3);
                      /* Much worse parsing performance, easier to handle however */
    } |             <BASIC> {
    		    $$ = $1;
                        /* Much worse parsing performance, easier to handle however */
    } |
                    "->" "[1-9][0-9]*" { $$ = maketuple(GOTO_LABEL, @2.text); /* Added for Imp15 */} |
                    "->"<NAME><APP> {
                      if ($3 != NONE) {
                        $$ = maketuple(GOTO_SWITCH, $2, $3);
                      } else {
                        $$ = maketuple(GOTO_LABEL, $2);
                      }
    } |
                    "return" { $$ = maketuple(RETURN); } |
                    "true" { $$ = maketuple(RETURN_TRUE); } |
                    "false" { $$ = maketuple(RETURN_FALSE); } |
                    "result"<ASSOP><EXPR> { $$ = maketuple(RESULT, $2, $3); } |
                    "monitorstop" {
                        $$ = maketuple(SUBSEQUENCE,
                                              maketuple(MONITOR),
                                              maketuple(SUBSEQUENCE,
                                                        maketuple(STOP),
                                                        0));
    } |
                    "monitor"<AUI> {
                      if ($2 != NONE) {  /* Simple label, followed by UI. */
                        assert(AST[$2] == SUBSEQUENCE);
                        assert(AST[$2+1] == HOLE);
                        assert((AST[$2+2] == 0) || (AST[AST[$2+2]] == SUBSEQUENCE));
                        AST[$2+1] = maketuple(MONITOR);
                        $$ = $2;
    		  } else {
    		    $$ = maketuple(MONITOR);
    		  }
    } |
                    "stop" { $$ = maketuple(STOP); } |
                    "signal"<PercentEVENTquote><CEXPR><OPEXPR><OPEXPR> {
                      $$ = maketuple(SIGNAL, $3, $4, $5); /* should make into a signal bitmask */
    } |
                    "exit" { $$ = maketuple(BREAK, HOLE /* destination */); } |
                    "continue" { $$ = maketuple(CONTINUE, HOLE /* destination */); };

    SWITCHDEC:      <NAME><NLISTquote>"\("<EXPR>":"<EXPR>"\)"<RESTOFSWLIST> {
                      $$ = maketuple(SWITCHDECL, $1, $2, $4, $6, $8);
    };

    RESTOFSWLIST:   ","<SWITCHDEC> {
                      $$ = $2;
    } |
                    "" { $$=0; };

    SS:          <lookahead> { /* always fails - hack to save text of every line!*/
    } |

                 <eof> { exit_flag = TRUE;
                      /* Successful parse: generate the C code now. */
    		  entrypoint = reverse_list(entrypoint);
    		  //fixup_scopes(entrypoint, 0);
                      printf("//============================================================================\n");
    		  codegen(entrypoint, 0);
    } |
                    <UIRESTOFSS> {
                      label = FALSE;
                      $$ = entrypoint = maketuple(SEQUENCE, $1, entrypoint);
    } |
                    <UI><RESTOFSS> {
                      label = FALSE;
    		  if ($2 == NONE) {
                        $$ = entrypoint = maketuple(SEQUENCE, $1, entrypoint);
                      } else {
                        $$ = entrypoint = maketuple(SEQUENCE, maketuple(SEQUENCE, $1, $2), entrypoint);
    		  }
    } |
                    "[1-9][0-9]*:" "$" { /* Added for Imp15 */
                       label = FALSE;
                       $$ = entrypoint = maketuple(SEQUENCE, maketuple(NUMERICLABEL, (int)sformatf("%s", @1.text)), entrypoint);
    } |
                    <TEXT> "$" {

                        $$ = entrypoint = maketuple(SEQUENCE, maketuple(COMMENT, $1), entrypoint);
    } |
                    <PercentIU><SC><RESTOFCOND><RESTOFIU><S> {
                      int cond, hack;
                      if ($3 != NONE) {
                        cond = $3;
                        assert(AST[cond] == BINOP);
                        assert(AST[cond+2] == HOLE);
                        AST[cond+2] = $2;
                      } else cond = $2;
                      // if <$4/RESTOFIU> is 0, it's a "start"...
                      if ($4 == 0) {
                        $$ = entrypoint = maketuple(SEQUENCE,
                               maketuple(IFORUNLESSSTART, $1, cond), entrypoint);
                      } else {
    // PROBLEM CASE: fixed in fixup_...
    // %if j=k %then j=j %else %if k=j %then k=k %else %start
                        $$ = entrypoint = maketuple(SEQUENCE,
                               maketuple(CONDITIONAL, $1, cond, $4), entrypoint);
                      }
    } |
                    "finish"<ELSEquote><S> {
                      if ($2 != NONE) {
                        int stmnt = 0;
                        // $2 = ELSESTART, ELSEIFORUNLESSSTART, ELSEIFORUNLESS, ELSE
                        if (AST[$2] == ELSESTART) stmnt = FINISHELSESTART;
                        if (AST[$2] == ELSEIFORUNLESSSTART) stmnt = FINISHELSEIFORUNLESSSTART;
                        if (AST[$2] == ELSEIFORUNLESS) stmnt = FINISHELSEIFORUNLESS;
                        if (AST[$2] == ELSE) stmnt = FINISHELSE;
                        if (stmnt == 0) {
                          fprintf(stderr, "finish<ELSEquote><S> -> $2=%d", $2);
                          fprintf(stdout, "finish<ELSEquote><S> -> $2=%d", $2);
                          exit(1);
                        }
                        AST[$2] = stmnt;
    		    $$ = entrypoint = maketuple(SEQUENCE, $2, entrypoint);
                        /* FLOW CONTROL NEEDS TO BE PATCHED UP IN THE AST! */
                      } else {
    		    $$ = entrypoint = maketuple(SEQUENCE, maketuple(FINISH), entrypoint);
                      }

    } |
                    "cycle"<CYCPARM><S> {
                      if ($2 != NONE) {
    		    $$ = entrypoint = maketuple(SEQUENCE, $2, entrypoint); /* CYCPARM passes up FORLOOP TODO */
                      } else {
    		    $$ = entrypoint = maketuple(SEQUENCE, maketuple(LOOP), entrypoint);
                      }

    } |
                    "repeat"<RESTOFREPEAT><S> {
                      /* Should link these up with starting FORLOOP/LOOP */
                      if ($2 != NONE) {
    		    $$ = entrypoint = maketuple(SEQUENCE, $2, entrypoint); /* RESTOFREPEAT passes up REPEATUNTIL TODO */
                      } else {
    		    $$ = entrypoint = maketuple(SEQUENCE, maketuple(ENDLOOP), entrypoint);
                      }

    } |
                    <PercentWU>"cycle"<S> {
                      /* while/until/for - but not "" */
                      $$ = entrypoint = maketuple(SEQUENCE, $1, entrypoint); /* PercentWU passes up WHILELOOP, UNTILLOOP, or FORLOOP */

    } |
                    <TYPE><DECLN><S> {
                      int decln = $2;
    //                  if (AST[decln] == DECLARATION) { /* don't forget the other types */
                        assert(AST[decln+1] == HOLE); // HOLE is first param for all 3 DECLN types now
                        AST[decln+1] = $1;
    debug_ast(decln); // with plugged hole
    //                  }
                      $$ = entrypoint = maketuple(SEQUENCE, $2, entrypoint);

    } |             "realslong" <S> {
                        reals_long = TRUE;  /* probably not appropriate to put this in the parser but it works */
    } |             "realsnormal" <S> {
                        reals_long = FALSE;
    } |             "endofprogramme"<S> {
    		    $$ = entrypoint = maketuple(SEQUENCE, maketuple(ENDPROG), entrypoint);
    } |             "endofprogram"<S> {
    		    $$ = entrypoint = maketuple(SEQUENCE, maketuple(ENDPROG), entrypoint);
    } |             "endoffile"<S> {
    		    $$ = entrypoint = maketuple(SEQUENCE, maketuple(ENDFILE), entrypoint);
    } |             "endofperm"<S> {
    		    $$ = entrypoint = maketuple(SEQUENCE, maketuple(ENDPERM), entrypoint);
    } |             "endoflist"<S> {
    		    $$ = entrypoint = maketuple(SEQUENCE, maketuple(ENDLIST), entrypoint);
    } |             "end"<S> {
    		    $$ = entrypoint = maketuple(SEQUENCE, maketuple(ENDBLOCKPROCFN), entrypoint); /* end of scope for symtab */

    } |
                    "recordformat"<RFSTMNT><S> {
                      /* TODO - need symbol table... */

    } |
                    <PercentSEX><RT><PercentSPECquote><NAME><ALIASquote><FPP><S> {
                      $$ = entrypoint = maketuple(SEQUENCE, maketuple(PROCDEF, $1, $2, $3, $4, $5, $6), entrypoint);

    } |             <XOWN><TYPE><OWNDEC> {
                      $$ = entrypoint = maketuple(SEQUENCE, maketuple(OWNDEC, $1, $2, $3), entrypoint);

    } |
                    "include"<CONST> { /* No <S>? */
                      $$ = entrypoint = maketuple(SEQUENCE, maketuple(INCLUDE, $2), entrypoint);

    } |
                    "begin"<S> {
                      $$ = entrypoint = maketuple(SEQUENCE, maketuple(BEGINBLOCK, HOLE), entrypoint);

    } |
                    "on"<PercentEVENTquote><CEXPR><RESTOFELIST>"start"<S> {
                      $$ = entrypoint = maketuple(SEQUENCE, maketuple(ONEVENT, $3, $4, HOLE), entrypoint); /*NOTESTART*/

    } |
                    "switch"<SWITCHDEC><S> {
                      $$ = entrypoint = maketuple(SEQUENCE, $2, entrypoint);
    } |
                    "list"<S> {
    } |
                    "else"<S> {
                      $$ = entrypoint = maketuple(SEQUENCE, maketuple(FINISHELSESTART), entrypoint);

    } |
    		"else"<PercentIU><SC><RESTOFCOND><S> {  /* else if for imp77 */
                      int cond;
                      if ($4 != NONE) {
                        cond = $4;
                        assert(AST[cond] == BINOP);
                        AST[cond+2] = $3;
                      } else cond = $3;
                      $$ = entrypoint = maketuple(SEQUENCE, maketuple(FINISHELSEIFSTART, $2, cond), entrypoint); /* CONDITIONAL?? */
                      /* $$ = formatf("ELSE: if/unless=%d sc=%d restofcond=%d\n", $2, $3, $4); */
    } |
                    "\*"<UCI> {
                      $$ = entrypoint = maketuple(SEQUENCE, maketuple(ASM, $1), entrypoint);

    } |
                    "trustedprogram"<S> {
    } |
                    "mainep"<NAME><S> {
    } |
                    "control"<CONST><S> {
    } |
                    "diagnose"<CONST><S> {
    } |
                    <NAME>"\(\*\):" {
                      /* default case statement.  Ought to have been picked up in BASIC */
                      $$ = entrypoint = maketuple(SEQUENCE, maketuple(DEFAULTCASE, $1), entrypoint);

    } |
                    <S> { };

    ASSOP: "==" { $$=OP_PTRASSIGN; } |
           "=" { $$=OP_ASSIGN; } |
           "<-" { $$=OP_JAMTRANSFER; } |
           "->" { $$=OP_STRINGRESOLVE; };

    COLON: ":" { $$=formatf("%s", @1.text); };

    COMP: "==" { $$=OP_PTREQ; } |
          "<=" { $$=OP_LE; } |
          ">=" { $$=OP_GE; } |
          ">" { $$=OP_GT; } |
          "->" { $$=OP_TESTRESOLVE; } |
          "=" { $$=OP_EQ; } |
          <notequivcomp> { $$=$1; } | <notcomp> { $$=$1; } |
          "<" { $$=OP_LT; };

    notcomp: "#" { $$=OP_NE; } |
             "\\=" { $$=OP_NE; } |
             "<>" { $$=OP_NE; };

    notequivcomp: "##" { $$=OP_PTRNE; } |
                  "\\==" { $$=OP_PTRNE; };

    COMPtwo:
          "==" { $$=OP_PTREQ; } |
          "<=" { $$=OP_LE; } |
          ">=" { $$=OP_GE; } |
          ">" { $$=OP_GT; } |
          "->" { $$=OP_TESTRESOLVE; /* SOME OF THESE ARE INVALID IN A DOUBLE-SIDED */} |
          "=" { $$=OP_EQ; } |
          <notequivcomp> { $$=$1; } | <notcomp> { $$=$1; } |
          "<" { $$=OP_LT; };

    CONST: <realconst> { $$=maketuple(CONST, REAL, $1); } |
           <basedconst> { $$=maketuple(CONST, INTEGER, $1); } |
           <intconst> { $$=maketuple(CONST, INTEGER, $1); } |
           <stringconst> { $$=maketuple(CONST, STRING, $1); } |
           <lettercharconst> { $$=$1; };

    realconst: "[0-9][0-9]*\.[0-9][0-9]*E[0-9][0-9]*" { $$=sformatf("%s", @1.text); } |
               "[0-9][0-9]*\.[0-9][0-9]*" { $$=sformatf("%s", @1.text); } |
               "[0-9][0-9]*@[0-9][0-9]*" { $$=sformatf("%s", @1.text); };

    basedconst: "[0-9][0-9]*_[0-9A-Z][0-9A-Z]*" {
                  if (strncmp(@1.text, "16_", 3) == 0) {
                    $$=sformatf("0x%s", @1.text+3);
                  } else {
                    $$=sformatf("%s", @1.text); // needs work
                  }
    };

    intconst: "[0-9][0-9]*" { $$=sformatf("%s", @1.text); };

    stringconst: <TEXTTEXT> { $$=$1; } |
                 "E" <TEXTTEXT> { $$=sformatf("E%s", str($2)); /* EBCDIC string */ };

    lettercharconst: <squote> <schar> <squote> {                   /* These need some work for type determination */
                       $$=maketuple(LETTERCHARCONST, ccharconst('c', str($2)));
    } |
                     "[RHX]" <squote> <hexchars> <squote> {
                       $$=sformatf("%s", ccharconst(*@1.text, str($3)));
    } |
                     "B" <squote> <binchars> <squote> {
                       $$=sformatf("%s", ccharconst(*@1.text, str($3)));
    } |
                     "K" <squote> <octchars> <squote> {
                       $$=sformatf("%s", ccharconst(*@1.text, str($3)));
    } |
                     "[CMD]" <squote> <schars> <squote> {
                       /* I'm not sure what the syntax of D'...' is */
                       /* so I'll allow anything, for now           */
    // M'''' causes crash ...
                       $$=sformatf("%s", ccharconst(*@1.text, str($3)));
    };

    squote: "'" { };

    schar: <squote><squote> { $$=sformatf("%c%c", BSLASH, SQUOTE); } |
           <!squote> "." { $$=sformatf("%s", @2.text); };

    schars: <schar> <schars> { $$=sformatf("%s%s", $1, $2); } |
            "" { $$=sformatf(""); };

    hexchars: "[0-9A-Fa-f][0-9A-Fa-f]*" { $$=sformatf("%s", @1.text); };

    octchars: "[0-7][0-7]*" { $$=sformatf("%s", @1.text); };

    binchars: "[01][01]*" { $$=sformatf("%s", @1.text); };

    DOWN: "" { /* Internal routine to push a level */ };

    DUMMYSTART: "" { };

    HOLE: "" { };

    ICONST: "[0-9][0-9]*" { $$=sformatf("%s", @1.text); };

    LISTOFF: "" { };

    LISTON: "" { };

    MARK: "" { };

    NAME: "[A-Z][A-Z0-9]*" <!eitherquote> { $$=sformatf("%s", strlwr(@1.text)); };

    eitherquote: "['\"]" { /* Protects M'fred' or E"string" from being seen as
                              simple names M or E */ };

    NOTECYCLE: "" { };

    NOTEFINISH: "" { };

    NOTEREPEAT: "" { };

    NOTESTART: "" { };

    N: "[0-9][0-9]*" { /* 16-bit */ $$=sformatf("%s", @1.text); };

    Nbyte: "[0-9][0-9]*" { /* between 0 and 255 */ $$=sformatf("%s", @1.text); };

    OP: "+" { $$=OP_ADD; } |
        "-" { $$=OP_SUB; } |
        "\&" { $$=OP_BITAND; } |
        "\*\*\*\*" { $$=OP_IEXP; } |
        "\*\*" { $$=OP_EXP; } |
        "\*" { $$=OP_MUL; } |
        "!!" { $$=OP_EOR; } |
        "!" { $$=OP_IOR; } |
        "//" { $$=OP_IDIV; } |
        "/" { $$=OP_RDIV; } |
        ">>" { $$=OP_SHR; } |
        "<<" { $$=OP_SHL; } |
        "\." { $$=OP_CONCAT; } |
        "\\\\" { $$=OP_IEXP; /* WHAT IS THIS OPERATOR??? */ } |
        "\^" { $$=OP_EXP; /* Imp77-only */ } |
        "\\" { $$=OP_EXP; };

    READLINEquery: "$" { $$=formatf("%s", "\n"); } |
                   "" { $$=0; };

    SETNEM: "[A-Z][A-Z0-9]*" <optsub> { /* Set Mnemonic */ $$=formatf("%s_", @1.text); };

    optsub: "_" { $$=sformatf("%s", @1.text); } |
            "" { $$=0; };

    S: "$" { /* also ';', but we convert earlier */ } |
       ";" { };

    TEXTTEXT: <quote> <stringchars> <quote> {
                $$=sformatf("%s", str($2));
    /*            $$=sformatf("%c%s%c", DQUOTE, str($2), DQUOTE);*/
    };

    quote: "\"" { $$=1; };

    stringchars: <quote><quote> <stringchars> {
                   $$=sformatf("%c%c%s", BSLASH, DQUOTE, str($3));
    } |
                 <!quote> ".[^\"]*" <stringchars> {
                   $$=sformatf("%s%s", @2.text, str($3));
    } |
                 "$" <stringchars> {
                   $$=sformatf("%cn%s", BSLASH, str($2));
    } |
                 "" { $$=sformatf(""); };

    TEXT: "#.*" { $$=sformatf("%s", @1.text); } |
          "!.*" { $$=sformatf("%s", (@1.text)+1); } |
          "comment.*" { $$=sformatf("%s", (@1.text)+7); };

    UCI: ".*" {
               /* unparsed m/c code */
               $$=sformatf("%s", @1.text);
    };

    UCW: "" { /* word operand */ };

    UP: "" { };

    commaquote: "," { $$=1; } |
                <!rparen> "" { /* fast error recovery */ $$=0; };

    rparen: "\)" { };

    UNARY: "+" { $$=UOP_POS; } |
           "-" { $$=UOP_NEG; } |
           "\~" { $$=UOP_NOT; } |
           "\\" { $$=UOP_NOT; } |
           "" { $$=0; };

    %{

    extern int debug(const char *fmt, ...);
    extern int debug_enter(const char *fmt, ...);
    extern int debug_exit(const char *fmt, ...);

    extern FILE *yyin;

    int eof_parse(YYTYPE **p)
    {
      int c;
      c = fgetc(yyin);
      if (c == EOF) {
        return(TRUE);
      }
      ungetc(c, yyin);
      return(FALSE);
    }

    int setdebug_parse(YYTYPE **p)
    {
      _debug = TRUE;
      return(TRUE);
    }

    int candebug_parse(YYTYPE **p)
    {
      _debug = FALSE;
      return(TRUE);
    }

    int lookahead_parse(YYTYPE **p)
    {
      /* This is executed at parse time for every line in the grammar above! */
      static int lineno = 0;
      char *s;
      long __pos;
      void *__stack;
      char line[128];

      *p = NULL; /* Initialise in case of failure */
      __stack = stackmark();
      (void)note_backtrack(&__pos);
      line[0] = '\0';
      fgets(line, 127, yyin);
      s = strchr(line, '\n'); if (s != NULL) *s = '\0';
      do_backtrack(__pos);
      stackrelease(__stack);
      if (*line != '\0') entrypoint = maketuple(SEQUENCE, maketuple(LINE, ++lineno, addstr(line)), entrypoint);
      fflush(stdout);
      return(FALSE);
    }

    %}