static char *rcs_version = "i2c.c V$Revision: 1.79 $";

// This is a new portable back-end for Imp77 on linux, which uses GCC to
// create the object files from the imp source code.  It does this by
// outputing C rather than assembly code from the ICODE.  Note that this
// does not make it an imp to C translator - the C is neither human-readable
// nor maintainable.  It is merely a slightly higher level type of
// intermediate code.  However this will ensure that Imp code can be
// run on any linux system which has a GCC C compiler.  (which excludes
// BSD Unix - sorry Bob.  clang in gcc mode does not support gcc's nested
// function extension...)

// Unfortunately, the real GCC has to be the back-end compiler, because we need
// the non-standard GCC extension that supports textually nested procedure
// definitions, which none of the other multi-platform C compilers do.  So,
// for now, clang et al are not an option.  Although in principle the nested
// procedures can be exbedded and the code flattened, writing such a flattener
// would be major implementation project, and the resulting C code is not
// going to be as efficient as code compiled for a language that uses
// a display to access enclosing scopes.  C's mechanism for nested
// procedure handling is made complicated by the need to support
// procedure variables, which Imp (and languages like Pascal, Algol,
// etc do not need).  (I did write a prototype flattener in python,
// with the help of Claude AI, but it was extremely fragile and although
// it worked with small examples, it failed with the real programs I
// subjected it to.  I do not intend to add that code to this suite.)

// Note there is no need to perform optimisations at the source/AST
// level, because GCC will do them for us.  I did, during the early
// stages, make some attempt to keep the C output readable but as more
// tweaks had to be made to the generated C, I've had to sacrifice more
// and more readability; so by this point readability is no longer a goal.



// ****** THE PRIMARY MISSING FUNCTIONALITY NOW IS PROCEDURES AS PARAMETERS! ******
// This is the top priority, currently being worked on.  The design of imp77's
// pass1 unfortunately precludes the obvious translation of the Imp77 procedure
// parameter lists to C, and the only practical solution that has so far
// presented itself involves reordering the icode file so that certain bits
// of information are made available earlier when they are needed.  The
// development for that new code is being done first in the separate 'idec' program.

// * Procedure parameters:
//             2    %routine do(%integerfn fn(%integer p,q,r))
//     O LINE 2  OPD_STACK = 0  file=test/testprocparam.imp
//     $ DEF V_006f ID=DO a=7 b=0 c=0
//     { START (
//     $ DEF V_0070 ID=FN a=24 b=1 c=16
//     } FINISH )
//     $ DEF V_0070 ID=FN a=24 b=1 c=24
//     { START (
//     $ DEF V_0071 ID=P a=17 b=1 c=0
//     $ DEF V_0072 ID=Q a=17 b=1 c=0
//     $ DEF V_0073 ID=R a=17 b=1 c=0
//     } FINISH )



// Everything else sort of works or is at least halfway towards being implemented...



// * When doing ACCESS on something that was the result of a SELECT
//   (i.e. an array that is a record field) such as this:
//                @ PUSH #V_00ae (P)  OPD_STACK = 4
//                n SELECT field #1  OPD_STACK = 4
//                @ PUSH #V_00cf (INN)  OPD_STACK = 5
//                a ACCESS
//
//   (this example was p_tab(inn) in soap80-a.imp) the ACCESS code messes up.


// some of the following may already be fixed to some extent but not yet checked.

// * still some small issues around automatic dereferencing etc.
//   See gcc12 -O -ftrivial-auto-var-init=pattern -Wa,-adhln -g -o test/draft4 test/draft4.c perms.c > test/draft4.lis
//   for remaining examples.  Most of these ones look like they happen
//   when assigning to a %name or in an index or parameter to a
//   top-level RHS or at the top level of a comparison.
//   (i.e. one of the too-many cases which skips the checks done for BINOPs etc)

// * name variable not being automatically dereferenced.  This may be the same
//   problem as the one detected above where the top-level expression in an
//   assignment or a parameter pass is not handled the same as in a BINOP etc:

   //   4151           %ROUTINE POP(%SHORTINTEGERNAME CELL,%INTEGERNAME S1,S2)

   // void POP( short *CELL, int *S1, int *S2 )
   // {
   //   __label__ _imp_endofblock;
                                                                //   4152           %INTEGER P,Q
   // int P;
   // int Q;
                                                                //   4153           Q=ADDR(ASLIST(CELL))
   // Q = _imp_ADDR(&ASLIST[CELL]);
   //                       ^^^^
   //                       |
   //                       Should be *CELL

// (note: adding REQUIRES_AUTO_DEREF(tuple) macro to ast.h to help with this.)


// * Cache the array bounds in the dopevector at the point of
//   declaration of a dynamic array in case a variable used in the
//   bounds declaration is changed before an array member is accessed.


// * Handle Imps row or column major layout of array data.  I forget which
//   is which but I'm fairly sure Imp and C use opposite conventions.
//   But given that imp77 doesn't have the ERCC's ARRAY() map and no existing
//   code that I know of maps a 2D array over an initialised 1D declaration,
//   this is a problem that may never surface.


// * Variant record formats not yet properly supported.  The extra fields are present so the
//   sources do compile but the record fields are not overlaid over each other to save space
//   and any code that relies on two variables accessing the same storage will fail.  And that's
//   before we get into the whole C shenannigans about aliasing where the only guaranteed modern
//   way to alias a location is by using memmove() to access it :-(

// (See also the pending issues in ast.c)

// ###################################################################################################


/*
   This code converts the ICODE stack machine into a more modern AST.
   Each AST tuple also holds the type information of its object, so when an
   expression is constructed, the type information propagates upwards,
   being used for type conversion and widening as it goes.

     The type and form information is used primarily for handling
   automatic dereferencing of pointers and pointer functions - %name
   and %map in Imp terms.

     Note that the AST_* types rather grew on the fly as each statement
   type was added in turn.  It's not the carefully designed AST that you would
   create if designing a new Imp compiler from scratch, but it works well enough
   with the simplified ICODE output from pass1 - some of the translation tricks
   we use would not work in a proper "imp to c" high-level translation direct
   from Imp source code.
 */

#define _POSIX_C_SOURCE 200809L
#define _XOPEN_SOURCE 500
#include <string.h>

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

// wasn't worth a header file for one line...:
extern int pass1(char *source, char *perm, char *icode, char *list);

#include "i2c.h"
//#include "ast.h"
//#include "icode.h"

extern void COPY_FIXED_FIELDS_to_from(ASTIDX new, ASTIDX old); // move to ast.h

//int PARM_C_IO = 0;  // output standard C I/O calls like printf rather than use IMP I/O names like PRINTSTRING

// PARMs affect what ends up in the C code.
int PARM_IMP_SOURCE_LINENOS = 1;   // issue #line directives for better gdb error reporting
int PARM_UNASS = 1; // normally we want unassigned checks unless explicitly suppressed
int PARM_CHECK = 1; // other checks with high overhead

// bit of both...
int PARM_OPT = 0;   // implies UNASS=FALSE and CHECK=FALSE and IMP_SOURCE_LINENOS=FALSE - all the ones with run time overhead, plus gcc options

// opts affect how the compilation is invoked
int opt_stdout = 0;
int opt_debug = 0;
int opt_verbose = 0;
int opt_link = 1;
int opt_info = 0;

int procedure_parameters_were_used = 0;

// A couple of hacky globals to get me out of a tight spot...
static char *last_alias = NULL;
static ASTIDX last_declare_for_init = -1;
static ASTIDX last_declare_for_attaching_fields_or_parameters = -1;
static int last_was_doublesided = 0;
static int IN_START_FINISH_GROUP = 0;

// Hack for %switch left,middle,right(low:high) ...
static ASTIDX last_bounds_pair = -1;

extern short get_next_label_id(void);
extern int NEXT_AST;

//#define MAX_NESTED_BLOCKS 1024 // More than Imp ever allowed...
int /*StringpoolIDX*/ blockname[MAX_NESTED_BLOCKS];
int blocklevel = 0;

int want_extra_info = FALSE;
int in_perms = TRUE;
int suppress_icode = TRUE;

FILE *icode_file;
FILE *output_file;
FILE *source_file;

#define MAX_LINE 1024
char line[MAX_LINE + 1];

// Diagnostic check to remind me of unimplemented calls.
static int unimplemented[256];  // (Not really unimplemented, more a case of not having been
                                // seen in a test, so potentially causing a stack imbalance)



void SHOW_STACK(char *after) {
  fprintf(output_file, "[");
  for (int i = next_opd - 1; i >= 0; i--) fprintf(output_file, " @%d:%d", i, opdstack[i]);
  fprintf(output_file, "]%s", after);
}

int CHECKPOP(void) {
  if (next_opd <= 0) return 0xDEADBEEF;
  if (debug_ast) {
    fprintf(output_file, "// POP() -> %d ", opdstack[next_opd - 1]);
    SHOW_STACK("\n");
  }
  return opdstack[--next_opd];
}

int POPQ(int *ast) {
  if (next_opd <= 0) return 0;
  *ast = opdstack[--next_opd];
  if (debug_ast) {
    fprintf(output_file, "// POP() -> %d ", *ast);
    SHOW_STACK("\n");
  }
  return 1;
}

void FLUSH_ICODE_STACK(void) {
  // By the time this is called, every item on the stack is a top-level source statement, and
  // the entire stack, if popped and executed, would generate code in reverse order!

  // However because each item on the stack is a complete statement, it's actually safe for
  // us to cycle through the stack and execute each AST item in sequential order!

  if (suppress_perms && in_perms) {
    // don't.
  } else {
    fprintf(output_file, "%s", commentbuff);
  }
  cbp = commentbuff;

  for (int sp = 0; sp < next_opd; sp++) {
    ASTIDX code = opdstack[sp];
    if (OP(code) != AST_IMP_LINE) fprintf(output_file, "%s", hashline);  // #line set up by LINE ('O') opcode.
    codegen(code);
  }
  next_opd = 0;  // empty the stack!
}

int POP(void) {
  ASTIDX astidx = CHECKPOP();
  if (astidx == 0xDEADBEEF) {
    fprintf(stderr, "* STACK UNDERFLOW!\n");
    fprintf(output_file, "* STACK UNDERFLOW!\n");
    FLUSH_ICODE_STACK();
    exit(EXIT_FAILURE);
  }
  return astidx;
}

void PUSH(const ASTIDX node) {
  if (debug_ast) {
    fprintf(output_file, "// PUSH(%d) -> ", node);
  }
  opdstack[next_opd++] = node;
  if (debug_ast) SHOW_STACK("\n");
}

void PUSH_ICONST(const int iconst) {
  ASTIDX tuple = mktuple(AST_ICONST, iconst);
  if (debug_ast) {
    fprintf(output_file, "// PUSH(#%d) -> ", iconst);
  }

  BASE_TYPE(tuple) = T_INTEGER;  // BASETYPE_INTEGER;
  BASE_SIZE_BYTES(tuple) = 4;    // actually should be value-dependent
  FORM(tuple) = F_SIMPLE;

  opdstack[next_opd++] = tuple;
  if (debug_ast) SHOW_STACK("\n");
}

void PUSH_RCONST(const char *rconst) {
  ASTIDX tuple = mktuple(AST_RCONST, strtopool(rconst));
  if (debug_ast) {
    fprintf(output_file, "// PUSH(#%s) -> ", rconst);
  }

  BASE_TYPE(tuple) = T_REAL;  // BASETYPE_REAL;
  BASE_SIZE_BYTES(tuple) =
      8;  // Most imp systems work in long real internally and truncate to real on loading and saving
  FORM(tuple) = F_SIMPLE;

  opdstack[next_opd++] = tuple;
  if (debug_ast) SHOW_STACK("\n");
}

void PUSH_IMPSTRINGCONST(const char *isconst) {
  ASTIDX tuple = mktuple(AST_ISTRINGCONST, strtopool(isconst));
  if (debug_ast) {
    fprintf(output_file, "// PUSH(\"%s\") -> ", isconst);
  }

  BASE_TYPE(tuple) = T_STRING;   // BASETYPE_IMPSTRING;
  BASE_SIZE_BYTES(tuple) = 255;  // or 256?
  FORM(tuple) = F_SIMPLE;

  opdstack[next_opd++] = tuple;
  if (debug_ast) SHOW_STACK("\n");
}

int sysnprintf(char *out, int maxlen, char *command) {
  FILE *pipe;
  pipe = popen(command, "r");
  for (int i = 0; i < maxlen - 1; i++) {
    int c = fgetc(pipe);
    if (c == EOF) {
      out[i] = '\0';
      pclose(pipe);
      return i;
    }
    out[i] = c;
  }
  return 0;
}

int systemf(char *s, ...) {
  extern int system(const char *command);
  /* Size the string by vfprint'ing it to /dev/null... */
  /* then malloc an appropriate area                   */
  char *APPROPRIATE_STRING;
  va_list ap;
  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);
  }
  va_start(ap, s);
  string_length = vfprintf(nullfile, s, ap);
  va_end(ap);
  /* fclose(nullfile); */
  APPROPRIATE_STRING = malloc(string_length+1);
  va_start(ap, s);
  vsprintf(APPROPRIATE_STRING, s, ap);
  va_end(ap);
  return system(APPROPRIATE_STRING);
}

int main(int argc, char **argv) {
  //char *p1, *p2;
  int opcode, d;
  char list_filename[256], icode_filename[256], output_filename[256], source_filename[256], object_filename[512],
      base_filename[256], perm_filename[256];

  // AST[0] and StringPool[0] etc are created first so that unassigned variables defaulting to 0 are
  // more easily detected, rather than have them return some legitimate but random object.
  
  (void)strtopool(" void /* BUG caused by a pooltostr(0) call? */ ");
  
  char *PROGNAME = argv[0];
  object_filename[0] = '\0';

  sprintf(perm_filename, "perms.inc");

  while (argc >= 2 && *argv[1] == '-') {
    // options must come before the filename

    // TO DO: -h/--help
    
    // Also I am considering adding "-fsymbol-case-upper" while changing the C_NAME of all Imp declarations to lower case.
    // However this is going to have consequences, because of namespace pollution by C headers, which was being easily
    // avoided when all Imp variables were being converted to upper case in the C translation.  Whether it's something
    // that should only be done for top-level external routines is another question.

    // Note that C's equivalent of %alias is *not* something we can rely on from Imp: it's very idiosyncratic.
    // (although for aliased external specs, using asm("aliasname") may be a better solution.)
    
    // Also to add: multiple .imp files and also .o files so that the imp command can be used very similarly
    // to the cc command for building projects that are more than just one source file.

    // here is $ HELP IMP from Vax/VMS for the options used in that compiler.
    // We might copy them when we have similar requirements...
    
    /*
  The available options are listed below. Note that all options
  may be either asserted or negated in use by prefixing "NO" to
  the option. For example, the "PROFILE" option may appear as
  either "PROFILE" or "NOPROFILE". In the list below, the convention
  used is that options which are disabled by default are given in
  the assertion form, eg "PROFILE", while options which are enabled
  by default and must be explicitly disabled when required are given
  in the negated form, eg "NOWARNINGS". Option keywords may be
  abbreviated as long as they remain unique.

     PROFILE     enables the production of code to support the
                 3L profiling facility. [note: the 3L profiling
                 facility is not supported with this release of
                 3L-IMP]

     DEBUG       enables the production of code to support the
                 debugging of the compiled module under the
                 3L symbolic debugger. [note: the 3L symbolic
                 debugger is not supported with this release of
                 3L-IMP]

                 Contrast this option with the command qualifier
                 /DEBUG, which enables the generation of the
                 tables required by the VMS native symbolic
                 debugging utility.

     NOWARNINGS  prevents the compiler issuing warning messages.
                 The default is that warning messages are reported
                 to the user.

     NOASSIGN    stops the compiler including code in the object
                 program to check for the use of variables before
                 they have been assigned a value.

     NOCHARNO    disables the production of code to check that
                 the character number argument of the "CHARNO"
                 procedure is within the allowable range as
                 determined by the current size of the string
                 parameter.

     NOARRAYS    disables the production of code to check that
                 array accesses are not performed outside the
                 declared bounds of the array.

     NOSHADOWFOR disables the production of code to check that
                 %for-loop control variables are not corrupted
                 during execution of the loop. This check is
                 performed by creating a "shadow" copy of the
                 control variable and checking its value against
                 the original variable at each iteration of the
                 loop.

     NOFOR       disables the production of code to check that
                 %for-loops are guaranteed to terminate before
                 they are entered.

     NOSHIFT     disables the production of code to check that
                 the logical shift operators "<<" and ">>" are
                 not used with an illegal value of the shift
                 count, ie a value outside the range 0<=N<=32.

     NOSTROVERFLOW
                 disables the production of code to check that
                 string expressions do not overflow the maximum
                 possible size of string (255 characters).

     NOSTRCAPACITY
                 disables the production of code to check that
                 string assignments to not exceed the capacity of
                 the string variable being assigned to.

     NOSTRINGS   shorthand for (NOSTROVERFLOW, NOSTRCAPACITY).

     NOINTOVER   disables run-time checking for integer overflow.
                 This check is normally performed by the hardware
                 and is therefore extremely cheap to perform. Use
                 of the NOINTOVER option is normally resticted to
                 cases in which the program being compiled relies
                 on being able to attempt evaluation of extremely
                 large values without error. Examples of this kind
                 of program might be those involving hashing functions
                 or complex address manipulations.

     NOCHECKS    disables all run-time checks; includes the functions
                 of NOASSIGN, NOCHARNO, NOARRAYS, NOSHADOWFOR,
                 NOFOR, NOSHIFT, NOSTROVERFLOW, NOSTRCAPACITY and
                 NOINTOVER.

     NOLINES     inhibits the production of the object file tables
                 which enable the diagnostic package to discover
                 line numbers in the event of program failure.

     NOTRACE     inhibits the production of the object file tables
                 which enable the diagnostic package to discover
                 procedure names in the event of program failure.
                 Includes the effect of NOLINES.

     NORECORDS   inhibits the generation of the object file tables
                 which enable the diagnostic package to interpret
                 the contents of record variables.

     NOVARS      inhibits the production of the object file tables
                 which enable the diagnostic package to display the
                 names and values of active variables in the event
                 of program failure. This includes the effect of
                 NORECORDS.

     NODIAGS     inhibits the production of all diagnostic tables.
                 Includes the functions of NOLINES, NOTRACE,
                 NORECORDS and NOVARS.
     */
    
    if (argc >= 2 && (strcmp(argv[1], "-h") == 0 || strcmp(argv[1], "--help") == 0)) {
      fprintf(stderr, "syntax: i2c [options] file.imp\n");
      fprintf(stderr, "\n");
      fprintf(stderr, "Options:\n");
      fprintf(stderr, "    --verbose/-v       Show AST tuple generation\n");
      fprintf(stderr, "    --debug/-d         Debug icode stack usage\n");
      fprintf(stderr, "    -O                 Optimise run-time performance.  Default is full checks\n");
      fprintf(stderr, "    --icode            Decode the intermediate code to the C file as comments\n");
      fprintf(stderr, "    -c                 Compile to .o file only. Don't link.\n");
      fprintf(stderr, "    --stdout           Output the C code to stdout instead of a .c file\n");
      fprintf(stderr, "    -o binary[.o]      When generating a binary use this filename\n");
      fprintf(stderr, "    --tidy             Output C code with fewer redundant brackets\n");
      fprintf(stderr, "    --perms perm.inc   Use alternative perms.inc file\n");
      fprintf(stderr, "    --no-perms         Use the empty \"noperms.inc\" file.\n");
      fprintf(stderr, "    --show-perms       Print the translated C of the perms.inc file\n");
      fprintf(stderr, "    --[no-]gdb         Generate #line statements in the C\n");
      fprintf(stderr, "    --[no-]check       Add runtime checking.  Small runtime overhead.\n");
      fprintf(stderr, "                       (Code runs under valgrind when checks are enabled.)\n");
      fprintf(stderr, "\n");
      exit(0);
    } else if (argc >= 2 && (strcmp(argv[1], "-v") == 0 || strcmp(argv[1], "--verbose") == 0)) {
      opt_verbose = TRUE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && (strcmp(argv[1], "-d") == 0 || strcmp(argv[1], "--debug") == 0)) {
      debug_ast = opt_debug = TRUE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && strcmp(argv[1], "--info") == 0) {
      opt_info = TRUE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && strcmp(argv[1], "-c") == 0) {
      opt_link = FALSE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && strcmp(argv[1], "-O") == 0) {
      PARM_OPT = TRUE; PARM_UNASS = FALSE; PARM_CHECK = FALSE; PARM_IMP_SOURCE_LINENOS = FALSE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 3 && strcmp(argv[1], "--perms") == 0) {
      if (argv[2] == NULL || argv[2][0] == '-') {
        fprintf(stderr, "i2c: --perms option requires a filename parameter\n");
        exit(1);
      }
      strcpy(perm_filename, argv[2]);
      argc -= 2;
      argv += 2;
    } else if (argc >= 3 && strcmp(argv[1], "-o") == 0) {
      if (argv[2] == NULL || argv[2][0] == '-') {
        fprintf(stderr, "i2c: -o option requires a filename parameter\n");
        exit(1);
      }
      strcpy(object_filename, argv[2]);
      argc -= 2;
      argv += 2;
    } else if (argc >= 2 && (strcmp(argv[1], "--no-perms") == 0  || strcmp(argv[1], "--no-perm") == 0 || strcmp(argv[1], "--noperms") == 0 || strcmp(argv[1], "--noperm") == 0)) {
      strcpy(perm_filename, "noperms.inc");
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && strcmp(argv[1], "--stdout") == 0) {
      opt_stdout = TRUE; opt_link = FALSE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && (strcmp(argv[1], "-g") == 0 || strcmp(argv[1], "--line") == 0 || strcmp(argv[1], "--lines") == 0)) {
      PARM_IMP_SOURCE_LINENOS = TRUE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && (strcmp(argv[1], "--no-line") == 0 || strcmp(argv[1], "--no-lines") == 0 || strcmp(argv[1], "--noline") == 0 || strcmp(argv[1], "--nolines") == 0)) {
      PARM_IMP_SOURCE_LINENOS = FALSE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && (strcmp(argv[1], "--check") == 0 || strcmp(argv[1], "--checks") == 0)) {
      // enable runtime checks with overhead, eg unassigned checks
      // and use valgrind etc at runtime.
      PARM_OPT = FALSE; PARM_UNASS = TRUE; PARM_CHECK = TRUE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && (strcmp(argv[1], "--no-check") == 0 || strcmp(argv[1], "--no-checks") == 0)) {
      PARM_OPT = TRUE; PARM_UNASS = FALSE; PARM_CHECK = FALSE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && strcmp(argv[1], "--unass") == 0) {
      PARM_UNASS = TRUE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && strcmp(argv[1], "--no-unass") == 0) {
      PARM_UNASS = FALSE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && strcmp(argv[1], "--icode") == 0) {
      suppress_icode = FALSE;
      argc -= 1;
      argv += 1;
    } else if (argc >= 2 && argv[1][0] == '-') {
      fprintf(stderr, "i2c: unrecognised option '%s'\n", argv[1]);
      exit(EXIT_FAILURE);
    }
  }

  if (argc != 2) {
    fprintf(stderr, "syntax: i2c [options] file.imp\n");
    exit(1);
  }

  strcpy(base_filename, argv[1]);
  if (strcmp(&base_filename[strlen(base_filename) - 4], ".imp") == 0) {
    base_filename[strlen(base_filename) - 4] = '\0';
  }

  sprintf(source_filename, "%.250s.imp", base_filename);
  if (opt_stdout) {
    sprintf(output_filename, "/dev/stdout");
  } else {
    sprintf(output_filename, "%.250s.c", base_filename);
  }
  sprintf(icode_filename, "%.250s.icd", base_filename);
  sprintf(list_filename, "%.250s.lis", base_filename);
  int rc = pass1(source_filename, perm_filename, icode_filename, list_filename);
  (void)rc;

  output_file = fopen(output_filename, "w");
  if (output_file == NULL) {
    fprintf(stderr, "i2c: cannot create '%s' - %s\n", output_filename, strerror(errno));
    exit(2);
  }

  source_file = fopen(source_filename, "r");
  if (source_file == NULL) {
    fprintf(stderr, "i2c: Cannot open \"%s\" - %s\n", source_filename, strerror(errno));
    exit(3);
  } else {
    dump_comment("%s\n\n\n", "Edinburgh IMP77 Compiler - Version 8.4\n");
  }

  // SHORT TERM EXPERIMENT FOR COMPILING IMP THAT PASSES PROCEDURES AS PARAMETERS:
  if (procedure_parameters_were_used) {
    systemf("idec --i2c --recode -v %s > %s.recoded.lis; mv ICODE-OUT.icd %s", icode_filename, base_filename, icode_filename);
  }
  
  icode_file = fopen(icode_filename, "rb");
  if (icode_file == NULL) {
    fprintf(stderr, "i2c: cannot open '%s' - %s\n", icode_filename, strerror(errno));
    exit(4);
  }

  ASTIDX NULL_TUPLE = mktuple(AST_ASTCODE_WAS_ZERO);  // for catching unassigned variables...
  short NULL_LABEL = get_next_label_id();
  blockname[0] = strtopool("__LEVEL_0__");

  for (int i = 0; i < MAX_DESCRIPTORS; i++) Descriptor[i] = 0; // or would -1 be better?  Can a valid ASTIDX be 0?
  
  suppress_perms = 1; //dump_code("#ifdef USE_PERMS_INC\n");
  for (;;) {
    opcode = get_icode(icode_file);
    if (opcode == EOF) break;
    switch (opcode) {
      case '\n':
        break;  // There's a \n at the end of the icode file...
        //case '\r': break; // Shouldn't get this but there might be one in a Windows port?

      case ':': /*  Define Compiler Label(Tag); */ /* LOCATE label */
      {
        // NOTE: *USER* labels do *not* come through this path - they are placed using 'L' (Define User Label(Tag))
        int lab, labtag = getshort();

        //lab = (label_id[labtag] != 0 ? setforwardlab_from_tag(labtag) : setbackwardlab_from_tag(labtag));

        if (label_id[labtag] == 0) {
          lab = label_id[labtag] = get_next_label_id();
          dump_comment("%c %s  (labtag=%04x, lab=L_%04x)\n", opcode, icode_name[opcode], labtag, lab);
          PUSH(mktuple(AST_DEFLAB, mktuple(AST_LABEL, lab, 'L', labtag)));  // start of cycle
          label_id[labtag + 1] = get_next_label_id();
          label_id[labtag + 2] = get_next_label_id();
        } else {
          lab = label_id[labtag];
          PUSH(mktuple(AST_DEFLAB, mktuple(AST_LABEL, lab, 'L', labtag)));  // continue or exit label of cycle
          dump_comment("%c %s  (labtag=%04x, lab=L_%04x)\n", opcode, icode_name[opcode], labtag, lab);
          label_id[labtag] = 0;
        }

        // These will be freed up on the REPEAT opcode.

      } break;

      case 'B': /*  Jump Backward(Tag); */ /* REPEAT label */
      {
        int labtag = getshort();
        int forlab = label_id[labtag];
        dump_comment("%c %s  (labtag=%04x, lab=L_%04x)\n", opcode, icode_name[opcode], labtag, forlab);
        PUSH(mktuple(AST_GOTO, mktuple(AST_LABEL, forlab, 'L', labtag)));
        // After a REPEAT, that label tag will not be used again to represent
        // that same label:
        label_id[labtag] = 0;  // free it up for reuse.
      } break;

      case 'f': /*  Compile For(Tag); */ /* FOR label (label was missing from thesis description) */
      {
        /*
               The descriptors on the top of the stack are:-
         
                                  +-----+
                                  |     |
               INITIAL VALUE      | [F] |
                                  |     |
                                  |-----|
                                  |     |
               FINAL VALUE        | [L] |
                                  |     |
                                  |-----|
                                  |     |
               INCREMENT          | [I] |
                                  |     |
                                  |-----|
                                  |     |
               CONTROL VARIABLE   | [C] |
                                  |     |
                                  |-----|
                                  |     |
                                  .     .

                 */

        short int fortag;
        short int forlab;
        short int exitlab;
        short int continuelab;

        fortag = gettag();
        forlab = label_id[fortag] = get_next_label_id();
        exitlab = label_id[fortag + 1] = get_next_label_id();
        continuelab = label_id[fortag + 2] = get_next_label_id();
        (void)continuelab;

        // forlab is at the top of the loop, continuelab is just before the repeat
        // (where a %until could possibly be tested). exitlab is after the loop

        //dump_comment("// FOR tag:lab  %d:%d  %d:%d  %d:%d\n", fortag,forlab, fortag+1,exitlab, fortag+2,continuelab);
        dump_comment("%c %s (labtag=%04x, lab=L_%04x)\n", opcode, icode_name[opcode], fortag, forlab);

        ASTIDX initial = POP();
        ASTIDX final = POP();
        ASTIDX increment = POP();
        ASTIDX control = POP();

        PUSH(mktuple(AST_FOR, control, initial, increment, final, forlab, exitlab, continuelab, fortag));
      } break;

      case 'F': /*  Jump Forward(Tag, Always); */ /* GOTO label */
      {
        short int labtag;
        short int lab = getforwardlab_from_tag(&labtag);

        dump_comment("%c %s (labtag=%04x, lab=L_%04x)\n", opcode, icode_name[opcode], labtag, lab);
        PUSH(mktuple(AST_GOTO, mktuple(AST_LABEL, lab, 'L', labtag)));
      } break;

      case 'L': /*  Define User Label(Tag); */ /* LABEL label */
      {
        short int ulabtag = gettag();
        short int ulab;

        if (user_label_id[ulabtag] == 0) user_label_id[ulabtag] = get_next_user_label();
        ulab = user_label_id[ulabtag];
        // user labels are described by tags, can be stacked as params!
        dump_comment("%c %s (labtag=%04x, lab=U_%04x)\n", opcode, icode_name[opcode], ulabtag, ulab);
        PUSH(mktuple(AST_DEFLAB, mktuple(AST_LABEL, ulab, 'U', ulabtag)));
        //fprintf(stderr, "USER LABEL: LABEL U_%04x: (tag=%04x)\n", ulab, ulabtag);
      } break;

      case 'J': /*  User Jump(Tag); */ /* JUMP label */
      {
        short int ulabtag = gettag();
        short int ulab;
        ulab = user_label_id[ulabtag];
        if (ulab == 0) { user_label_id[ulabtag] = get_next_user_label(); ulab = user_label_id[ulabtag]; }
        // user labels are described by tags, can be stacked as params!
        dump_comment("%c %s (labtag=%04x, lab=U_%04x)\n", opcode, icode_name[opcode], ulabtag, ulab);
        //fprintf(stderr, "USER LABEL: JUMP U_%04x (tag=%04x)\n", ulab, ulabtag);
        PUSH(mktuple(AST_GOTO, mktuple(AST_LABEL, ulab, 'U', ulabtag)));
      } break;

      case '"': /*  Compare Double; */ /* FORWARD-JUMPIFD cond label */
      {
        // NOTE!!! 'Compare double' refers to double-sided condition,
        //  not to C's double reals
        
        /*
                        // O LINE 5  OPD_STACK = 0  file=test/dscond2.imp
                        // @ PUSH #V_0001 (A)  OPD_STACK = 2
                        // @ PUSH #V_0002 (B)  OPD_STACK = 3
                        // " JUMPIFD > L_0002
                        // @ PUSH #V_0003 (C)  OPD_STACK = 4
                        // ? JUMPIF > L_0002

               Three pushes and a jumpifd would have been so much easier :-(
               Looking at pass1 it's clear the ICODE was designed this way
               to make pass1 simpler, not pass2!

               So maybe the way to handle this is to just leave the jumpifd
               on the stack so that when the jumpif comes, it sees the two
               stacked objects and can examine SOS to determine if it was a
               single object or a jumpifd pair.
               *Or* just simply remove the jumpifd and let jumpif pull 3 variables
               instead of 2 if a new 'jumpifd_pending' flag is set.  But if that's
               the method we use, I need to check what happens with multiple tests -
               I *think* we're OK because it's not possible for an *operand* of
               a comparison to be a comparison itself (eg if ((a < b) < c) ...)
               but some testing will be needed just to be sure.
         */
        
        /* leaves tos on the stack */

        //#ifdef NEVER
        int cond = getbyte();
        short int labtag;
        short int lab = getforwardlab_from_tag(&labtag);
        dump_comment("%c %s %c (labtag=%04x, lab=L_%04x)\n", opcode, icode_name[opcode], cond, labtag, lab);

        ASTIDX tos = POP();
        ASTIDX sos = POP();
        ASTIDX comparison = mktuple(AST_COMPARE, sos, cond, tos);  // TO DO: swap order here and in ast.c

        PUSH(mktuple(AST_IFGOTO, comparison, mktuple(AST_LABEL, lab, 'L', labtag)));
        PUSH(tos);
        //#endif
        last_was_doublesided = TRUE;
      } break;

      case 'C': /*  Compare Addresses; */ /* FORWARD-JUMPIFA cond label */
        {
          // ( Interestingly, due to the way pass1 was written to handle double-sided conditions,
          //   you can't do:  %if a == b == c %then ... )
          ASTIDX comparison;
          int cond = getbyte();
          short int labtag;
          short int lab = getforwardlab_from_tag(&labtag);
          dump_comment("%c %s %c (labtag=%04x, lab=L_%04x)\n", opcode, icode_name[opcode], cond, labtag, lab);

          ASTIDX tos = POP();
          ASTIDX sos = POP();
          tos = mktuple(AST_ADDRESS_OF, tos);
          sos = mktuple(AST_ADDRESS_OF, sos);
          comparison = mktuple(AST_COMPARE, sos, cond, tos);  // TO DO: swap order here and in ast.c
          PUSH(mktuple(AST_IFGOTO, comparison, mktuple(AST_LABEL, lab, 'L', labtag)));
        } break;
        
      case '?': /*  Compare Values; */    /* FORWARD-JUMPIF cond label */
        /* if you have the JUMPIF first then the LOCATE clears it. */
        /* if you have the LOCATE first then the REPEAT clears it. */
        {
          ASTIDX comparison;
          int cond = getbyte();
          short int labtag;
          short int lab = getforwardlab_from_tag(&labtag);
          dump_comment("%c %s %c (labtag=%04x, lab=L_%04x)\n", opcode, icode_name[opcode], cond, labtag, lab);

          ASTIDX tos = POP();
          ASTIDX sos = POP();
          if (last_was_doublesided) {
            ASTIDX prev_ifgoto, prev_condition, prev_jumpdest, sos1, cond1, tos1, check_op;
            prev_ifgoto = POP();
            detuple(prev_ifgoto, &check_op, &prev_condition, &prev_jumpdest);
            detuple(prev_condition, &check_op, &sos1, &cond1, &tos1);
            comparison = mktuple(AST_COMPARE2, sos1, cond1, sos, cond, tos);  // TO DO: swap order here and in ast.c
            last_was_doublesided = FALSE;
          } else {
            comparison = mktuple(AST_COMPARE, sos, cond, tos);  // TO DO: swap order here and in ast.c
          }
          PUSH(mktuple(AST_IFGOTO, comparison, mktuple(AST_LABEL, lab, 'L', labtag)));
        }
        break;

      case 't': /*  Jump Forward(Tag, TT); */ /* BT label */
      case 'k': /*  Jump Forward(Tag, FF); */ /* BF label */
      {
        // This might be for C/Pascal booleans and not used in Imp where we
        // have short-cut evaluation of conditions,  and if so, it may need
        // a boolean to be popped off the compiler stack.
        // I.e. this implements if (cond) goto lab, and if (!cond) goto lab.

        // Oh - wait - they're also for testing the results of string resolution, and
        // also %predicate results (%true, %false).  Need to create tests for those.
        short int labtag;
        short int lab = getforwardlab_from_tag(&labtag);
        dump_comment("%c %s (labtag=%04x, lab=L_%04x)\n", opcode, icode_name[opcode], labtag, lab);
        ASTIDX condition = POP();

        // BIG BIG BIG 'TODO': this may be where the problem is coming from that was spotted in my pdp9 compiler
        // where the Z0() predicate is jumping on the negated value by accident!  More run-time tests need to
        // be added to the regression suite to catch things like this.
        // Tentative fix below: (addition of UNLESSGOTO)

        PUSH(mktuple(opcode == 't' ? AST_IFGOTO : AST_UNLESSGOTO, condition, mktuple(AST_LABEL, lab, 'L', labtag)));
      } break;

      case '$': case 'g': /*  Define Var; */ /* DEF TAG TEXT TYPE FORM SIZE SPEC PREFIX */
      {                   /*  'g' was unused opcode "Test for NIL" but now being reused as synonymous with '$' *but* not to be printed out in C code */
        char *alias = last_alias;  // now we have it, still need to do something with it...
        last_alias = NULL;

        // Instruction:  Define <tag> [id] <a> <b> <c>
        int tag;
        char *ID;
        short int a, b, cX, i;

        tag = gettag();
        ID = getname();
        assert(get_icode(icode_file) == ',');
        a = gettag() & 0xFFFF;
        assert(get_icode(icode_file) == ',');
        b = gettag() & 0xFFFF;
        assert(get_icode(icode_file) == ',');
        cX = gettag() & 0xFFFF;

        if (tag == 0) {
          tag = NEW_INTERNAL_TAG();  // Invented tag so that record fields can be looked up to handle SELECT
          // We should be able to use the extended field option in the AST to store these.
          // Record fields are numbered from 1 in SELECT.
        }
        dump_comment("%c %s %s (%c_%04x) a=%d b=%d c=%d  \n",
                      opcode, icode_name[opcode],
                            ID,
                                tag >= next_free_private_tag ? 'S' : 'V', tag,
                                         a, b, cX);

        ASTIDX decl = mktuple(AST_DECLARE, tag, opcode);
        last_declare_for_init = decl;  // use the other hacky global :-/
        if (Descriptor[tag] != 0) {
          //dump_code("/*DEBUG: Descriptor[tag] = %d (%x)*/", Descriptor[tag], Descriptor[tag]);
        }
        Descriptor[tag] = decl;        // tag_declaration;

        //
        // Currently when outputting %result == mapresult (where mapresult is a %integermap), codegen is seeing FORM=0
        // rather than FORM=9 (F_MAP) as expected.  Trying to find out why...
        //
        // $ DEF V_0071 ID=MAPRESULT a=25 b=1 c=0   <--- 25&15 == 9
        //
        BASE_TYPE(decl) = (a >> 4) & 0xF;
        FORM(decl) = a & 0xF;

        /* handle bizarre type encoding scheme: */
        SPECIAL(decl) = 0;
        if (BASE_TYPE(decl) == T_INTEGER && b == 2)
          SPECIAL(decl) = 1; /* integer-oid */
        else if (BASE_TYPE(decl) == T_INTEGER && b == 3)
          SPECIAL(decl) = 2; /* integer-oid */
        else if (BASE_TYPE(decl) == T_REAL && b == 4)
          SPECIAL(decl) = 3;

        LINKAGE(decl) = cX & 7;

        if (FORM(decl) == F_ARRAY || FORM(decl) == F_NAME_ARRAY)                                   IS_ARRAY(decl) = TRUE;
        if (FORM(decl) == F_NAME || FORM(decl) == F_NAME_ARRAY || FORM(decl) == F_NAME_ARRAY_NAME) IS_BASE_NAME(decl) = TRUE;
        if (FORM(decl) == F_ARRAY_NAME || FORM(decl) == F_NAME_ARRAY_NAME)                         IS_ARRAY_NAME(decl) = TRUE;

        if (SPECIAL(decl)) {
        } else if (BASE_TYPE(decl) == T_STRING) {
          if (b == 0) {
            STRING_CAPACITY(decl) = -1;  // '*'.  Maybe should use 0 since %string(0) fred is pretty stupid and probably caught by pass1?
                                         //       (note: -1 & 255 == 255, which we take advantage of later.
          } else {
            STRING_CAPACITY(decl) = b;
          }
        } else if (BASE_TYPE(decl) == T_INTEGER) {
          const int datasize[4] = {8, 4, 1, 2};
          BASE_SIZE_CODE(decl) = b & 3;
          BASE_SIZE_BYTES(decl) = datasize[BASE_SIZE_CODE(decl)];
        } else if (BASE_TYPE(decl) == T_REAL) {
          const int datasize[8] = {4, 4, 4, 4, 8, 4, 4, 4};
          BASE_SIZE_CODE(decl) = b & 7;  // NOTE: 8 values for reals, 4 for integers!  BE CAREFUL!
          BASE_SIZE_BYTES(decl) = datasize[BASE_SIZE_CODE(decl)];
        } else if (BASE_TYPE(decl) == T_RECORD) {
          if (b == 0) {
            RECORD_FORMAT(decl) = 0;  // %const %record(*) %name nil == 0
          } else {
            RECORD_FORMAT(decl) = Descriptor[b];
            //debug_types(decl);
          }
        }

        for (i = 0; i < sizeof(oflags) / sizeof(oflags[0]); i++) {
          if (cX & oflags[i].mask) {
            if (oflags[i].mask == 8)  IS_SPEC_ONLY(decl) = TRUE;    // { 8,  " spec" }, // S=1
            if (oflags[i].mask == 16) NO_AUTO_DEREF(decl) = TRUE;  // { 16, " {indirect-no-auto-deref, I=1}" }
            if (oflags[i].mask == 32) NO_UNASS(decl) = TRUE;       // { 32, " {NO UNASSIGNED CHECKS, U=1}" }
          }
        }

        EXTERNAL_NAME_IDX(decl) = C_NAME_IDX(decl) = IMP_NAME_IDX(decl) = strtopool(ID);
        if ((LINKAGE(decl) == X_PERM || LINKAGE(decl) == X_PRIM)) {
          char internal[512];
          sprintf(internal, "_imp_%s", ID);
          C_NAME_IDX(decl) = strtopool(internal);
        } else if (LINKAGE(decl) == X_SYSTEM) {
          char internal[512];
          sprintf(internal, "%s", ID);
          char *s = internal;
          for (;;) {
            int c = *s;
            if (c == '\0') break;
            if (isalpha(c) && isupper(c)) *s = tolower(c);
            s++;
          }
          C_NAME_IDX(decl) = strtopool(internal);
        }
        
        if (FORM(decl) == F_MAP) {
          // Needs to be marked so that if assigning to a scalar with '=', it isindirected through '*'
          // but not if assigning to a pointer with '=='
          // Test minmap.imp (minimal map test) is not yet working.
        }

        if (alias != NULL) EXTERNAL_NAME_IDX(decl) = strtopool(alias);

        // Now handle declarations which have other parameters already on the internal stack:

        if (FORM(decl) == F_SWITCH) {
          
          ASTIDX bounds = POP();
          if (OP(bounds) != AST_BOUNDSPAIR) {
            PUSH(bounds); // put back whatever was popped by accident...

            if (last_bounds_pair == -1) {
              fprintf(stderr, "Cannot determine bounds for %%switch %s\n", pooltostr(C_NAME_IDX(decl)));
              exit(1);
            } // otherwise, use remembered value from preceding switch decl as in: %SWITCH S,SW(0:3)
            BOUNDS1D(decl) = bounds = last_bounds_pair;
          } else {
            BOUNDS1D(decl) = bounds;
          }
          
          last_bounds_pair = bounds; // gets reset on next 'O' (LINE) opcode.

          // keep an array of switch indices that have been defined
          // for this switch variable, and record this switch variable on a
          // stack at the current block level.  When we reach the end of the
          // current block level, output the code to handle any undefined
          // switch labels.

          ASTIDX lowidx, highidx;
          int low, high;
          ASTIDX AST_check_op;
          detuple(bounds, &AST_check_op, &lowidx, &highidx);
          detuple(lowidx, &AST_check_op, &low);
          detuple(highidx, &AST_check_op, &high);
        
          // space to record array of flags(low:high)
          switches_set[swstack_nextfree] = (char *)calloc((high-low+1), sizeof(char));
          switch_low[swstack_nextfree] = low;
          switch_high[swstack_nextfree] = high;
          switch_tag[swstack_nextfree] = tag;
          //switch_decl[swstack_nextfree] = decl;
          swstack_nextfree += 1;

          STRING_CAPACITY(decl) = 0; // overloading an unused field to make a note
                                     // that a sw(*): default has not yet been given...
          PUSH(decl);
          break;
          
        } else if (IS_ARRAY(decl)) {
          
          // NOTE!!! Bounds for auto arrays are added afterwards in a DIM code,
          // but bounds for own or external arrays (which must be constant and
          // 1 dimensional) are below the $DEF on the stack.
          
          if (LINKAGE(decl) == X_AUTO) {
            dump_comment("                         Auto-array decl %d requires following DIM for dynamic bounds for this auto array\n", decl);
          } else {
            // Pick up 1D arraybounds and attach to decl
            ASTIDX bounds = POP();
            dump_comment("                         Attaching AST_BOUNDSPAIR %d to decl %d,  This should NOT be a dynamic bounds auto array\n", bounds, decl);
            BOUNDS1D(decl) = bounds;
          }

        } else if (IS_PROCEDURE(decl)) {  // callable?

          if (IN_START_FINISH_GROUP) {

// * Procedure parameters:
//             2    %routine do(%integerfn fn(%integer p,q,r))
//     O LINE 2  OPD_STACK = 0  file=test/testprocparam.imp
//     $ DEF V_006f ID=DO a=7 b=0 c=0
//     { START (
//     $ DEF V_0070 ID=FN a=24 b=1 c=16
//     } FINISH )
//     $ DEF V_0070 ID=FN a=24 b=1 c=24
//     { START (
//     $ DEF V_0071 ID=P a=17 b=1 c=0
//     $ DEF V_0072 ID=Q a=17 b=1 c=0
//     $ DEF V_0073 ID=R a=17 b=1 c=0
//     } FINISH )


            // I CAN NOW REWRITE ICODE TO SPECIFY PROCEDURE PARAMETERS PROPERLY.  HOWEVER THIS CODE NEEDS TO BE UPDATED TO
            // HANDLE THE NESTED PROCEDURE DEFINITION.  A fairly major rewrite might be needed in order to do so, perhaps
            // by making a recursive 'declare procedure' procedure.
            
            // So when the recoding is invoked, this is no longer true:
            // This is a procedure that is a parameter to another procedure.  It is basically just a placeholder as we don't
            // yet have the parameters to the procedure parameter itself, so mark it, so that when the full definition turns
            // up later, it will be attached to this procedure and not output as a new procedure.
            
            IS_PROC_PARAM(decl) = 1; // or could set it to 'last_declare_for_attaching_fields_or_parameters' as a back-link...?
                                     // (if that is valid, which should be checked. Also that field may be pointing to a record, not a param list)
            dump_code("/* Procedure parameter. probably no args given yet. */");            
          } else {

            // This is one of:
            //   a) A regular procedure declaration (where the procedure may or may not have already been spec'd)
            //   b) A forward declaration (spec) of a new regular procedure (possibly duplicated, or even already declared)
            //   c) A procedure parameter to another procedure.  The previous reference to this in the parameter list of
            //      that other procedure will have been incomplete.  It can now be completed.  Both the other procedure and
            //      these updated parameter details should be on the short stack of items between line ('O') directives,
            //      so we do still have an opportunity to update the parameter list to include full details of the procedure
            //      parameter before it is output.  This should be the case whether that procedure definition was a spec
            //      or the actual body.
            // We determine whether this is a procedure parameter by looking at Descriptor[tag] to check for the IS_PROC_PARAM
            // flag being set.

            //ASTIDX existing_decl = Descriptor[tag];
            
            last_declare_for_attaching_fields_or_parameters = decl;
          }

        } else if (FORM(decl) == F_RECORDFORMAT) {
          
          if (!IN_START_FINISH_GROUP) last_declare_for_attaching_fields_or_parameters = decl;

        } else {
          // MAY BE MORE TO BE HANDLED?
        }

        if (IN_START_FINISH_GROUP) {
          // This is actually a recordformat field declaration, so has to
          // be attached to the currently active recordformat.  (Not sure
          // yet about record subfields within a record format. **CHECK**

          // These declarations are pushed back on the stack and are gathered
          // up when the ALTEND code is issued, which will collect all the
          // record fields between ALTBEG and ALTEND off the stack, and then
          // attach them to the RECORDFORMAT definition which will have been
          // immediately below them on the stack.

          // NOTE: The ALT structure of a recordformat only has to be preserved
          // until we've output the declaration.  It's not actually needed when
          // accessing a field with SELECT which basically just passes the
          // field name and type info to C and which doesn't care that there
          // are other variables sharing the same space.  So - although I
          // haven't worked out the details yet - I think we'll be able to
          // get away with a relatively cheap hack.  At least I hope so because
          // I really don't have any infrastructure in place to handle
          // struct unions at this point :-(

          
          PUSH(decl);
        } else {
          PUSH(decl);

          if (IS_PROCEDURE(decl) && !IS_SPEC_ONLY(decl)) {
                  
            // Making a change to the AST handling: The decl just prints
            // the procedure heading - the start of the procedure body
            // will come from a second AST node that is a blockstart

            // Start of a rt/fn/pred/map causing a new blocklevel:
            swbase[blocklevel] = swstack_nextfree;
            int BLOCKTYPE = 0;
            if (FORM(decl) == F_ROUTINE) BLOCKTYPE = BLOCKTYPE_ROUTINE;
            else if (FORM(decl) == F_FN) BLOCKTYPE = BLOCKTYPE_FN;
            else if (FORM(decl) == F_MAP) BLOCKTYPE = BLOCKTYPE_MAP;
            else if (FORM(decl) == F_PREDICATE) BLOCKTYPE = BLOCKTYPE_PREDICATE;
            PUSH(mktuple(AST_BLOCKSTART, blocklevel+1, BLOCKTYPE, C_NAME_IDX(decl)));
          
          }

        }

        if (FORM(decl) == F_LABEL) {
          int ulabtag = tag; // I believe that a label declaration will always need a new label id.
          user_label_id[ulabtag] = get_next_user_label();
          //int ulab = user_label_id[ulabtag];
          //fprintf(stderr, "USER LABEL: DEFINE user label tag = %04x, user label = U_%04x\n", ulabtag, ulab);
        }
        
      } break;

      case '(':                               /*  Jump Forward(Tag, LE); */
      case ')':                               /*  Jump Forward(Tag, GE); */
      case '<':                               /*  Jump Forward(Tag, LT); */
      case '>':                               /*  Jump Forward(Tag, GT); */
      case '=':                               /*  Jump Forward(Tag, EQ); */
      case '#': /*  Jump Forward(Tag, NE); */ /* BNE */
        unimplemented[opcode] = TRUE;
        dump_comment("%c %s %d\n", opcode, icode_name[opcode], getshort());
        break;

      case 'W': /*  Switch Jump(Tag); */ /* SJUMP sd */
      {
        // The (constant) index of this switch jump is on the internal stack.
        int tag = gettag();
        dump_comment("%c %s V_%04x\n", opcode, icode_name[opcode], tag);
        ASTIDX index_ast = POP();
        ASTIDX sw = Descriptor[tag];
        PUSH(mktuple(AST_GOTO_SWLAB, sw, index_ast));

      } break;

      case '`':                           /* DEFSWLABEL sd - GT extension - default switch label */
      {
        int tag = gettag();
        dump_comment("%c %s %s (tag=%04x)\n", opcode, icode_name[opcode], pooltostr(C_NAME_IDX(Descriptor[tag])), tag);
        PUSH(mktuple(AST_DEF_DEFAULTSWLAB, mktuple(AST_VAR, tag)));
      } break;
        
      case '_': /*  Switch Label(Tag); */ /* SLABEL sd */
      {
        // ***NOTE*** If a sw(*) is given, pass1 generates all the missing labels.
        //            *but* if no sw(*) is present, no extra labels are generated
        //            and no explicit icode is issued either.  So when the switch
        //            label was declared, it's up to the icode handler to pre-fill
        //            the array with a label that points to code which will issue
        //            a run-time error message! (Which will have to be created)

        // ***UPDATE*** if sw(*) is given but is followed later by explicit missing
        //            switch labels, the later ones will occur twice!  It's not at
        //            all clear how those duplicated labels should be eliminated
        //            from the default switch destination without major code movement.
        
        //            If the default had been implemented by a single 'default' icode
        //            it would have been easy to output a sw_default: label, but what
        //            pass1 is actually doing is outputting multiple labels for every
        //            switch value not yet seen, even though any of those values can
        //            appear later when given explicitly!  This is a weird choice to
        //            have made in the design of icode if intended for sequential
        //            code generation without holding large parts of code in memory.
        
        // The (constant) index of this switch label is on the internal stack.
        int tag = gettag();
        ASTIDX const_switch_index_ast = POP();
        dump_comment("%c %s %s (tag=%04x)\n", opcode, icode_name[opcode], pooltostr(C_NAME_IDX(Descriptor[tag])), tag);

        PUSH(mktuple(AST_DEF_SWLAB, mktuple(AST_VAR, tag), const_switch_index_ast));

        // record the existence of this switch label to help with handling
        // defaults that are to be dumped at the end of a block.

        // locate the switch definition in the stack...
        int swstack_idx = swstack_nextfree;
        for (;;) {
          swstack_idx -= 1;
          if (swstack_idx < 0) break;
          if (switch_tag[swstack_idx] == tag) {
            int low = switch_low[swstack_idx];
            //int high = switch_high[swstack_idx];
            int switch_index = USERFIELD(const_switch_index_ast, 0);
            char *switch_flag = switches_set[swstack_idx];
            switch_flag[switch_index-low] = 1; // MARK AS USED!
            break;
          }
        }
        
      } break;

      case 'Z': /* ASSREF */ /*  Assign(EqualsEquals); */
      case 'j': /* JAM */    /*  Assign(Jam); */
      case 'S': /* ASSVAL */ /*  Assign(Equals); */
      {
        ASTIDX tos = POP();
        ASTIDX sos = POP();
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        PUSH(mktuple(AST_ASSIGN, opcode, sos, tos /*order?*/));  // and push
      } break;

      case 'q': /* SUBA */
      case 'u': /* ADDA */ /*  Aop; */
        // Occurs in VAX pass1.imp at line 915:  current char == current char++1
        // and is supported by this pass1, so it *does* need to be implemented...
        // In C we can probably safely just output "+<n>" and ignore the type checking
        // that a simple ADD should do.

        // and drop through:
        
      case '+': /* ADD */                              /*  Operation(ADDx); */
      case '-': /* SUB */                              /*  Operation(SUBx); */

      case '!': /* OR */                               /*  Operation(ORx); */
      case '%': /* XOR */                              /*  Operation(XORx); */
      case '&': /* AND */                              /*  Operation(ANDx); */
      case '.': /* CONCAT */                           /*  Operation(CONCx); */
      case '*': /* MUL */                              /*  Operation(MULx); */
      case 'Q': /* DIVIDE - real divide */             /*  Operation(RDIVx); */
      case '/': /* QUOT - integer divide */            /*  Operation(DIVx); */
      case '[': /* LSH */                              /*  Operation(LSHx); */
      case ']': /* RSH */                              /*  Operation(RSHx); */
      case 'X': /* IEXP */                             /*  Operation(EXPx); */
      case 'x': /* REXP */                             /*  Operation(REXPx); */
      {
        ASTIDX tos = POP();
        ASTIDX sos = POP();
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        PUSH(mktuple(AST_BINOP, opcode, sos, tos /*order?*/));  // and push
      } break;

      case 'v': /* MOD */ /*  Operate(ABSx, Stack, Nil); */
        // Depending on the type of the operand, call one of:
        //        double fabs(double x);
        //        float fabsf(float x);
        //        long double fabsl(long double x);

      case '\\': /* NOT */   /*  Operate(NOTx, Stack, Nil); */
      case 'U': /* NEGATE */ /*  Operate(NEGx, Stack, Nil); */
      {
        ASTIDX tos = POP();
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        PUSH(mktuple(AST_MONOP, opcode, tos));  // and push
      } break;

      case 'H': /* BEGIN */ /*  Compile Begin; */
      {
        int BLOCKTYPE;
        static int unique_blockno = 0;
        char tmpname[128];
        // nested scope.  Important if we're using imp names for variables.
        //dump_comment("%c %s  blocklevel=%d before incrementing\n", opcode, icode_name[opcode], blocklevel);
        dump_comment("%c %s\n", opcode, icode_name[opcode]);

        if (blocklevel == 0) { // a %begin at the outer level... either %begin/%endofprogram or %begin/%end/%endoffile (which is identical)
          BLOCKTYPE = BLOCKTYPE_BEGIN_ENDOFPROGRAM;
          sprintf(tmpname, "_imp_main");
        } else {
          BLOCKTYPE = BLOCKTYPE_BEGIN_END;
          sprintf(tmpname, "_BLOCK_%d_LEVEL_%d_", ++unique_blockno, blocklevel);
        }
        PUSH(mktuple(AST_BLOCKSTART, blocklevel+1, BLOCKTYPE, strtopool(tmpname))); // enter a new block level
      } break;

      case ';': /* END */ /*  End of Block; */
      {
        //dump_comment("%c %s  blocklevel=%d for the block ending now\n", opcode, icode_name[opcode], blocklevel);
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        PUSH(mktuple(AST_BLOCKEND, blocklevel)); // pass the *current* level
      } break;

      case 'Y': /* DEFAULT short */
        unimplemented[opcode] = TRUE;
        dump_comment("%c %s %d\n", opcode, icode_name[opcode], getshort());
        break;

      case 'A': /*  Init(Tag); */ /* INIT short */
                                  /*
         Effect:       <n> copies of the init-value are added to the list of
                       values  associated  with  the   init-variable.    The
                       init-value  is  either the default value (unassigned)
                       if the stack is empty, the  value  of  TOS  (possibly
                       converted  to  real)  if  TOS  is  a constant, or the
                       address  of  TOS  if  TOS   is   a   variable.    The
                       init-variable  is the last static object to have been
                       defined using Define.

         Error:        1. TOS, if it exists, is not of the same type as  the
                          init-variable.

         PLEASE NOTE: unlike EMAS imp, 2-D (and higher) arrays cannot be initialised!
                      (nor can records)
       */
        {
          int n_copies = getshort();
          ASTIDX init_val = -1;
          ASTIDX var;
          dump_comment("%c %s %d\n", opcode, icode_name[opcode], n_copies);

          if (POPQ(&var)) {
            if (OP(var) == AST_DECLARE) {
              // Scalar initialisation
              if (POPQ(&init_val)) {  //init_val = POP();
                if (OP(init_val) == AST_ICONST || OP(init_val) == AST_RCONST || OP(init_val) == AST_ISTRINGCONST) {
                  //attach. but drop for now.
                } else {
                  // same as 'not found' - so initialise to unassigned pattern!  And replace the item under the stack
                  PUSH(init_val);
                }
              } else {
                // not found - so initialise to unassigned pattern!
              }

            } else {  // if (OP(var) == AST_ICONST || OP(var) == AST_RCONST || OP(var) == AST_ISTRINGCONST) {
                      // Must be an array initialisation NO! Not true.  eg %ownreal R1 = -1.23@4 comes through here.
              init_val = var;
              var = POP();
              if (OP(var) != AST_DECLARE) {
                dump_comment("                         *** UNEXPECTED TYPE IN INIT (array) ***\n");
              }
            }
            PUSH(var);  // replace the AST_DECLARE but not the init value.
          } else {
            // stack is empty
            dump_comment("                         Did not find anything on the stack.\n");
          }

          if ((n_copies > 1) && (init_val != -1)) {
            // This is really a *very dirty* hack!  INIT n where n != 1 broke the initialisation
            // hack that relied on all the init values having been created by mktuple sequentially.
            // But it was just *so worth it* to avoid duplicating all the init values that I couldn't
            // say no to myself.  Although it was a rather heated argument and the little devil on
            // my left should did almost come to blows with the little angel on my right shoulder.
            for (int i = 1; i < n_copies; i++) {
              ASTIDX throwaway = mktuple(OP(init_val), USERFIELD(init_val, 0));  // DUP()
              COPY_FIXED_FIELDS_to_from(throwaway, init_val);
              init_val = throwaway;  // I can feel the bile rising in my throat as I write this.
              // The last item has to be the one most recently assigned to the init var
            }
            // Search ast.c for /*GASTRICREFLUX*/ to find the corresponding code.
          }

          // index into a InitValues[] array of AST indexes.
          // Let's say we have an array fred(10:12) and the
          // init values are AST tuples whose index values
          // are stored in Initvalues[34], Initvalues[35],
          // and Initvalues[36]; then INITVALUES(array)
          // would be 34 and we would assign them in the
          // declaration to fred[10], fred[11] and fred[12]
          // by extracting LB=10, UB=12 from the BOUNDS1D(array)
          // An Initvalues[n] of -1 means unassigned.
          // NOTE:
          // If I can guarantee that INIT statements are all
          // handled in order, I should be able to use the AST[] array
          // directly rather than have to duplicate the init data
          // in a separate InitValues[] array...

          // What's more, if I just assign the most recent init_val to the var
          // *and* if they are always sequential, then when printing the declaration
          // I can just work backwards from the saved index and magically find all
          // the previous inits (but in reverse order!)  So a cheap solution if it works!  Let's try it and see...

          INITVALUES(var) = init_val;
        }
        break;

      case 'p': /* ASSPAR */ /*  AssignParameter; */
      {
        // ***NOTE*** TO DO: array bound info is not yet being passed dynamically when
        // an array is passed as an arrayname parameter.  At a very minimum we must ensure
        // that it is the address of the zeroth element that is passed as the array's base
        // address so that accesses will work out correctly assuming the correct index
        // values are given within the procedure.  Other than in strings and records,
        // I don't recall that whole arrays can be passed in Imp77 by value - only by address.
        // However I do need to check that (possibly against the Vax/VMS Imp77 implementation)
        // as my memory on these things is no longer 100% trustworthy!

        // Note that arrayname parameters for both 1-D arrays and higher will require a
        // dopevector to be passed.

        ASTIDX param;
        /* Attach this parameter in TOS to the procedure descriptor in SOS */
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        param = POP();
        //debug_types(param);
        PUSH(mktuple(AST_ACTUAL_PARAMETER, param));  // leave it for the CALL to find...
      } break;

      case '@': /* PUSH tag */ /*  Stack Var(Tag); */
      {
        int tag = gettag();
        //ASTIDX decl = Descriptor[tag];
        ASTIDX var = mktuple(AST_VAR, tag);
        
        // If the var is an array, we need to reserve space for the indices that will follow:
        // MAX_DIMS == 7 ...
        if (IS_ARRAY(var) && (INDEX_LIST(var) == 0)) {
          // Reserve space so we can attach the array indices as they are later
          // presented to us...:

          // Currently I have two separate places where array info is placed - the
          // BOUNDS1D() location and the INDEX_LIST() locations.  Although this is
          // fine and there's good reasons for it being that way, I am going to
          // duplicate the final array index supplied by the ACCESS opcode in the
          // INDEX_LIST even though it is also being saved in BOUNDS1D - just in case
          // at some later point we find ourselves wanting to simplify the array
          // indexing code by conflating the two.

          INDEX_LIST(var) = mktuple(AST_INDEX_LIST,
                                    0/* count of dims assigned so far */,
                                    /* easier to just add extras: */
                                    0/*dim 1*/, 0/*dim 2*/,
                                    0/*dim 3*/, 0/*dim 4*/,
                                    0/*dim 5*/, 0/*dim 6*/,
                                    0/*dim 7*/);
              
          // The declaration should already contain the dopevector info describing
          // the number and bounds of dynamic arrays when declared.
          // (and remember, arrays with dynamic bounds had to save the actual
          //  runtime value in that dopevector at runtime. We don't know what it
          //  is at the point of the declaration, usually.  So some extra code
          //  generation needed for that in cdecl()...)
        }

        PUSH(var);
        dump_comment("%c %s %s (tag=V_%04x)  OPD_STACK = %d\n",
                     opcode, icode_name[opcode],
                            pooltostr(C_NAME_IDX(var)),
                                       tag,
                                                       next_opd);
      } break;

      case '^': /* PROC tag */ /*  Stack_Format = -Tag; */
      {
        int tag = gettag();
        unimplemented[opcode] = TRUE;  // warn.  I'ld like to see where this is used.
        // I don't think it *is* used, and for now I'm going to remove the AST_PROC
        // AST entry because I think it is confusing.  Easy enough to add back in
        // if it turns out to be needed after all...
        dump_comment("%c %s tag V_%04x (I THOUGHT THIS WAS AN UNUSED OPCODE!)\n", opcode, icode_name[opcode], tag);
      } break;

      case 'E': /* CALL */ /*  Call(0); */
      {
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        ASTIDX actual_parameters;
        //ASTIDX formal_parameters;
        ASTIDX tos;
        ASTIDX fn;
        int result;
        int param_count;
        ASTIDX params[32];

        param_count = 0;
        for (;;) {
          tos = POP();
          if (OP(tos) != AST_ACTUAL_PARAMETER) break;
          params[param_count++] = tos;
        }
        fn = tos;
        //debug_types(fn);

        // This is where we could force left-to-right evaluation of parameters in external calls to match
        // C/Unix calling conventions where the last parameter is pushed first.  We could assign each
        // parameter to a local temporary variable in left to right order, then call the procedure
        // using those pre-evaluated temporaries, so that it would not matter what order the parameters
        // were pushed in.

        // proc(a,b,c) -> " { typeof(a) tmp1 = a; typeof(b) tmp2 = b; typeof(c) tmp3 = c; proc(tmp1, tmp2, tmp3); } "
        
        actual_parameters = mktuple(AST_ACTUAL_PARAMETER_LIST, param_count);
        NEXT_AST += param_count;
        for (int i = 0; i < param_count; i++) {
          EXTRAFIELD(actual_parameters, (param_count - 1) - i) = params[i];  // reversed back to left-right order
        }
        EXTENDED_FIELD_COUNT(actual_parameters) = param_count;

        ACTUAL_PARAM_LIST(fn) = actual_parameters;
        //FORMAL_PARAM_LIST(fn) = formal_parameters; - should be in place already

        // fn is an AST_DECLARE tuple which if
        // passed to codegen would output the declaration.
        //debug_types(fn);

        result = mktuple(AST_CALL, fn);

        PUSH(result);
        break;
      }

      case 'G': /* ALIAS */ /*  Get String(Alias); */
      {
        // can get the same effect in C using __attribute__((alias("target"))) or __attribute__((weak, alias("target")))
        // although I'm not sure of the details or what the 'weak' is for.
        // ***NOTE*** This opcode *precedes* the '$'DEF and is optional, so there is no
        last_alias = getimpstring();  // Hacky but works
        dump_comment("%c %s %s\n", opcode, icode_name[opcode], last_alias);
      } break;

      case 'M': /* MAP */ /*  Return(Map); */
      {
        // %result == atom
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        // AST_ADDRESS_OF should return &location, or pointer, depending on the form of the parameter
        ASTIDX result = POP();
        dump_comment("                         /* %%map result:  */"); debug_types(result);
        ASTIDX address = mktuple(AST_ADDRESS_OF, result);
        PUSH(mktuple(AST_RESULT, address));
      } break;

      case '\'': /* Input String Value; */ /* PUSHS sconst */
      {
        char *string_value = getimpstring();  // shouldn't use C string since an IMP
            // string can potentially contain a \0 character!  But it'll do for now.
        PUSH_IMPSTRINGCONST(string_value);
        dump_comment("%c %s %s  OPD_STACK = %d\n", opcode, icode_name[opcode], string_value, next_opd);
      } break;

      case 'N': /*  Input Integer Value(0); */ /* PUSHI iconst */
      {
        int iconst = getwordconst();
        PUSH_ICONST(iconst);
        dump_comment("%c %s #%d  OPD_STACK = %d\n", opcode, icode_name[opcode], iconst, next_opd);
      } break;

      case 'D': /*  Input Real Value; */ /* PUSHR rconst */
      {
        int i, c, byte, len;

        char comment[1024];
        char realstr[1024];
        char *cp = &comment[0];
        char *rp = realstr;

        byte = get_icode(icode_file);
        assert(byte != EOF);
        len = get_icode(icode_file);
        assert(len != EOF);
        cp += sprintf(comment, "%c %s code=%d len=%d \"", opcode, icode_name[opcode], byte, len);
        c = get_icode(icode_file);
        assert(c != EOF);
        for (i = 1; i <= len; i++) {
          c = get_icode(icode_file);
          assert(c != EOF);
          if (c == '@') break;
          cp += sprintf(cp, "%c", c);
          rp += sprintf(rp, "%c", c);
        }
        if (c == '@') {
          signed short int exponent = getshort();
          cp += sprintf(cp, " @ (signed short)0x%04x\"  OPD_STACK = %d\n", exponent, next_opd);
          rp += sprintf(rp, "E%hd", exponent);
        } else {
          cp += sprintf(cp, "\"  OPD_STACK = %d\n", next_opd);
        }
        PUSH_RCONST(realstr);
        dump_comment(comment);
      } break;

      case 'O': /*  Update Line(Tag); */ /* LINE decimal */
      {
        // LINE is only called when there is nothing on the stack, so may be used
        // as a suitable place to output C code.

        // LINE will not occur in the middle of a multi-line statement, or between
        // lines which generate no ICODEs, including comments and %constinteger declarations.

        // Note that this code relies on unix file system semantics, where it is possible
        // to have two separate input streams open on the same file at the same time.
        // I don't know if Windows now supports this - in the early days when I first
        // did some C coding for Windows, only one input stream could be opened on a
        // file at a time.  So if the listing is messed up should this program ever be
        // run on Windows, that'll be why.  It can be worked around but it'll be ugly.
        
        FLUSH_ICODE_STACK(); last_bounds_pair = -1; /* (NB Also a reasonably safe place to reset this state) */
        
        if (in_perms) {
          // This should be moved to ast.c too... but first I need a better way of suppressing the translated perms...

          suppress_perms = 0;
          //dump_code("\n#else\n\n");
          //dump_code("#include \"perms.h\"\n\n");
          dump_code("#include <perms.h>\n\n");
          //dump_code("#endif // USE_PERMS_INC\n\n");
          if (PARM_OPT) { // I think this might be possible to be removed now?
            dump_code("#define PARM_OPT 1\n");
          }
          if (!PARM_UNASS) {
            dump_code("#ifdef _U // Don't do unassigned checks...\n");
            dump_code("#undef _U\n");
            dump_code("#define _U(x) (x)\n");
            dump_code("#endif\n");
          }
        }
        in_perms = FALSE;

        d = getshort();                // Target line to display up to.
        char *fname = getrawstring();  // DIRTY HACK. I redefined the 'LINE' ICODE to add
        // this extra string parameter.  But since pass1 is built-in here, it's safe.
        dump_comment("%c %s %d  OPD_STACK = %d  file=%s\n", opcode, icode_name[opcode], d, next_opd, fname);
        PUSH(mktuple(AST_IMP_LINE, d, strtopool(fname)));
      } break;

      case 'P': /* PLANT */ /*  Dump Byte(Popped Value&255); */
        unimplemented[opcode] = TRUE;
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        break;

      case 'T': /* TRUE */  /*  Return(True); */
      case 'K': /* FALSE */ /*  Return(False); */
      {
        // BIG BIG BIG 'TODO': my pdp9 compiler is getting the Z0 %predicate wrong at the point of generating the jump over the start/finish block!
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        PUSH_ICONST(opcode == 'T' ? 1 : 0);
        PUSH(mktuple(AST_RESULT, POP()));
      } break;

      case 'R': /* RETURN */ /*  Return(Routine); */
      {
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        PUSH(mktuple(AST_RETURN));
      } break;

      case 'V': /* RESULT */ /*  Return(Fn); */
      {
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        PUSH(mktuple(AST_RESULT, POP()));
      } break;

      case 'I': /*  Select Input(Icode In2);  Readsymbol(Pending); */
        unimplemented[opcode] = TRUE;
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        break;

      case 'a': /* ACCESS */ /*  Array Access; */
        {
          dump_comment("%c %s\n", opcode, icode_name[opcode]);

          // A small note in case I forget:  a *dopevector* is stored as dims in a userfield but the bounds in extra fields.
          // Whereas the INDEX_LIST (the array of actual indices used to index a specific instance of an array access) is
          // stored entirely in user fields: 0 being the dimensions, then 1:n being the indices.

          // Yes, in hindsight both objects should have been stored the same way, and in fact the sensible change to make
          // would be to alter the dopevector to put all the boundspairs in the user fields following the dimension count.

          // The reason I did the other scheme initially was that I was allowing for an unbounded number of dimensions and
          // also to save space by not allocating extra fixed slots that wouldn't be used in most instances.  I realised
          // later that the extra space overhead doesn't matter a bit, and I read in a document that Imp limits the number
          // of array bounds to 7.  So at some point I'll rationalise the code and be more consistent.

          ASTIDX this_index = POP();
          ASTIDX the_array = POP();
          int dimensions = 0;
          ASTIDX static_bounds = BOUNDS1D(the_array);
          ASTIDX dopevector = DOPEVECTOR(the_array);
          if (dopevector != 0) {
            dimensions = USERFIELD(dopevector, 0);
            if (dimensions != EXTENDED_FIELD_COUNT(dopevector)) {
              dump_code("/* BUG WARNING: dimensions = %d  extended_field_count = %d */", dimensions, EXTENDED_FIELD_COUNT(dopevector));
            }
          }
          ASTIDX indexed_array;                                               // replace the_array[this_index] on the stack once applied

          debug_types(the_array); debug_types(this_index);
          
          if (IS_ARRAY_NAME(the_array)) {                                     // An array with implied lower bound of 0
            indexed_array = mktuple(AST_ARRAYACCESS, the_array, this_index);
          } else if (dopevector == 0 && static_bounds == 0) {                 // Shouldn't happen but if it does, probably same as above?
            indexed_array = mktuple(AST_ARRAYACCESS, the_array, this_index);
          } else if (static_bounds != 0) {                                    // statically bound array
            debug_types(static_bounds);
            indexed_array = mktuple(AST_ARRAYACCESS, the_array, this_index);
          } else if (dopevector != 0) {                                       // dynamically bound array
            //debug_types(dopevector); dump_code("/*dims:%d*/", dimensions);
            // INDEX_LIST is an AST tuple comtaining the number of dims and room for 7 actual indices into this array *var* (note: not array *decl*)
            ASTIDX indices = INDEX_LIST(the_array);
            if (indices == 0) {
              dump_comment("\n/* C: BUG: DON'T KNOW WHY THE ARRAY VAR DIDN'T HAVE SPACE RESERVED FOR THE INDICES. ADDING IT NOW. */\n");
              // could be because the array info was copied from the record field definition
              // but the extra info fields were not also copied?
              INDEX_LIST(the_array) = indices = mktuple(AST_INDEX_LIST,
                                    0/* count of dims assigned so far */,
                                    0/*dim 1*/, 0/*dim 2*/,
                                    0/*dim 3*/, 0/*dim 4*/,
                                    0/*dim 5*/, 0/*dim 6*/,
                                    0/*dim 7*/);
            }
            USERFIELD(indices, 0) += 1;                                       // count of assigned indices
            USERFIELD(indices, USERFIELD(indices, 0)) = this_index;           // attach this index
            debug_types(indices);
            indexed_array = mktuple(AST_DYNAMICARRAYACCESS, the_array);       // the indices and the dopevector are applied.  We now push the updated object
          } else {                                                            // Error?
            dump_comment("/* BUG: unexpected situation with the ACCESS opcode */");
          }

          PUSH(indexed_array); // now updated with all the indexes

        } break;


#ifdef NEVER
        // * When doing ACCESS on something that was the result of a SELECT
        //   (i.e. an array that is a record field) such as this:
        //                @ PUSH #V_00ae (P)  OPD_STACK = 4
        //                n SELECT field #1  OPD_STACK = 4
        //                @ PUSH #V_00cf (INN)  OPD_STACK = 5
        //                a ACCESS
        //
        //   (this example was p_tab(inn) in soap80-a.imp) the ACCESS code messes up.

        /* Add this index in TOS to the base address in SOS.
           This is for the last index of any array and currently works OK
           for 1-D arrays..  For multi-D arrays, the preceding indices are
           handle by INDEX, which is not yet implemented!
         */
        {
          // ***TO DO*** for n-D arrays, there will be <n> indices on the stack!
          // not quite sure at this point how to do this.  Obviously the way it is
          // intended to work is that the indices are added one-by-one and the
          // underlying array is pushed back on the stack as each index is added,
          // but clearly that is not currently how the opcodes are being handled.
          
          /* for:       x = threed(i, j, k) ...

                        // O LINE 8  OPD_STACK = 0  file=test/3Darray.imp
                        // @ PUSH #V_0005 (X)  OPD_STACK = 2

                        // @ PUSH #V_0001 (THREED)  OPD_STACK = 3
                        // @ PUSH #V_0002 (I)  OPD_STACK = 4
                        // i INDEX
                        // @ PUSH #V_0003 (J)  OPD_STACK = 5
                        // i INDEX
                        // @ PUSH #V_0004 (K)  OPD_STACK = 6
                        // a ACCESS

                        // S ASSVAL

             for:       x = oned(i) ...

                        // @ PUSH #V_0003 (X)  OPD_STACK = 2

                        // @ PUSH #V_0001 (ONED)  OPD_STACK = 3
                        // @ PUSH #V_0002 (I)  OPD_STACK = 4
                        // a ACCESS

                        // S ASSVAL

           */
          
          dump_comment("%c %s\n", opcode, icode_name[opcode]);

          ASTIDX this_index = POP();
          ASTIDX the_array = POP();
          ASTIDX indexed_array; // the array element after applying the indices to the array.

          if (BASE_TYPE(this_index) != T_INTEGER) {
            dump_comment("\n/* UNEXPECTED TYPE OF WHAT SHOULD BE AN ARRAY INDEX: BASE_TYPE() = %d */\n", BASE_TYPE(this_index));
            debug_types(this_index); // remember to use -v to see this
          }

          if (OP(the_array) != AST_VAR && OP(the_array != AST_FIELDSELECT)) {
            dump_comment("\n/* A: INDEX OPERATION BEING APPLIED TO SOMETHING THAT MAY NOT BE A VAR */\n");
          }

          if (!IS_ARRAY(the_array) && !IS_ARRAY_NAME(the_array)) {
            dump_comment("\n/* B: INDEX OPERATION BEING APPLIED TO SOMETHING THAT MAY NOT BE AN ARRAY VAR */\n");
          }

          if (IS_ARRAY_NAME(the_array)) {
            // We're not going to have a BOUNDS1D *or* a dopevector for an arrayname
            // so we treat it as being a 1D array with a 0 lower bound and no range checking...
            indexed_array = mktuple(AST_ARRAYACCESS, the_array, this_index);
            // to do: may need to add AST_INDIRECT_THROUGH - or not - as we want the generated
            // access to read (*NAME)[idx] ... maybe add an AST_ARRAYNAMEACCESS tuple type?
          } else if (BOUNDS1D(the_array) != 0) { // statically bound array
            
            indexed_array = mktuple(AST_ARRAYACCESS, the_array, this_index);

          } else { // dynamically bound array

                                                                    //     40        sheila(i) = i * 10

                        // @ PUSH SHEILA (tag=V_007b)  OPD_STACK = 2
// 23656: mktuple(AST_VAR, 123)
// 23686: mktuple(AST_INDEX_LIST, 0, 0, 0, 0, 0, 0, 0, 0)

                        // @ PUSH I (tag=V_0079)  OPD_STACK = 3
// 23723: mktuple(AST_VAR, 121)

                        // a ACCESS
// 23753: mktuple(AST_DYNAMICARRAYACCESS, 23656)

                        // @ PUSH I (tag=V_0079)  OPD_STACK = 3
// 23783: mktuple(AST_VAR, 121)

                        // N PUSHI #10  OPD_STACK = 4
// 23813: mktuple(AST_ICONST, 10)

                        // * MUL
// 23843: mktuple(AST_BINOP, 42, 23783, 23813)

                        // S ASSVAL
// 23875: mktuple(AST_ASSIGN, 83, 23753, 23843)


//   (*SHEILA)[0/*BUG: MISSING INDEX*/] = ((I)) * ((10));
//   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^


/* array 23656: AST_VAR 'SHEILA' -> BASE_TYPE: %integer  (1)
   FORM: %array  (11)
   BASE_SIZE_CODE: 1 BASE_SIZE_BYTES: 4
   LINKAGE:  (0)
   SPECIAL: 0
   BASE_%NAME? N  ARRAY? Y  ARRAY_NAME? N  SPEC? N
   NO_AUTO_DEREF: 0 STRLEN: 0 RECFM: 0
   FORMAL_PARAMS: 0  ACTUAL_PARAMS: 0
   BOUNDS: 23686  DOPEVECTOR: 0
   UFC=1 [ 123 ] XFC=0 [] in "ast.c":2662
 */

            ASTIDX indices = INDEX_LIST(the_array);
            if (indices == 0) {
              dump_comment("\n/* C: THE ARRAY VAR DOESN'T SEEM TO HAVE SPACE RESERVED FOR THE INDICES? */\n");
              indexed_array = mktuple(AST_ARRAYACCESS, the_array, this_index); // TO DO: this is a short term hack just to get some cases working. It is not a solution.
              // This is caused by an array as a record field.  Currently trying to trace propogation of type information.
            } else {
              USERFIELD(indices, 0) += 1; // count of assigned indices
              USERFIELD(indices, USERFIELD(indices, 0)) = this_index; // attach this index
              indexed_array = mktuple(AST_DYNAMICARRAYACCESS, the_array); // the indices and the dopevector are
            }
          }

          PUSH(indexed_array); // now updated with all the indexes

        }
        break;
#endif


      case 'n': /* SELECT tag */ /*  Select(Tag); */
      {
        int field = gettag();

        ASTIDX OLD_DECL_AST_TAG = POP();                          // the record  *** an AST_TAG ***
        debug_types(OLD_DECL_AST_TAG);
        ASTIDX RECFM_AST_TAG = RECORD_FORMAT(OLD_DECL_AST_TAG);
        ASTIDX parameterlist = FORMAL_PARAM_LIST(RECFM_AST_TAG);  // TO DO: have a RECORD_FIELD_LIST instead?
        ASTIDX subfield = EXTRAFIELD(parameterlist, field - 1);
        dump_comment("%c %s %s (field #%d)  OPD_STACK = %d\n",
                     opcode, icode_name[opcode],
                     pooltostr(C_NAME_IDX(subfield)),
                     field, next_opd);
        debug_types(subfield);
        OP(subfield) = AST_VAR;  // *VERY* HACKY!
        debug_types(subfield);

        // All the type information for 'record with field' should be set from subfield.
        PUSH(mktuple(AST_FIELDSELECT, OLD_DECL_AST_TAG, subfield));
        
      } break;

        // PLEASE NOTE!!!  'DIM' is only used for auto arrays, which cannot be initialised in Imp77.
        //                 whereas 'BOUNDS' is used for external, own, and const arrays (no matter
        //                 where they appear) (and switches) - however those must be only one-dimensional.
        //                 The 'BOUNDS' code *precedes* the $DEF but the 'DIM' code follows it.

      case 'b': /* BOUNDS */ /*  Constant Bounds; */
      {
        ASTIDX lower, upper;
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        
        upper = POP();
        lower = POP();
        PUSH(mktuple(AST_BOUNDSPAIR, lower, upper));  // When a $DEF of the appropriate type follows, it will pop the BOUNDS
      } break;

      case 'd': /* DIM short,short */ /*  D = Tag;   N = Tag;  Dimension(D, N); */
      {
        /*
         Instruction:  Dimension <n><d>

         Effect:       <d> pairs of integer values on the stack are used  to
                       define the bounds of the last <n> arrays to have been
                       defined.    Code   is  generated,  if  necessary,  to
                       allocate the arrays and the definitions are  adjusted
                       to reference the appropriate storage.

         Notes:        The  pairs  of  values  are  stacked  in order of the
                       declaration, that is, first dimension first.
                       In each pair of values the  lower  bound  is  stacked
                       before the upper bound.
                       The  last  <n>  tags  must have had consecutive index
                       values.

         Errors:       1. The stack contains less than 2*<d> items.
                       2. The last <n> definitions were not all arrays.

         Example:      integerarray A, B, C(1:2, Low:4)
                       Define A......
                       Define B......
                       Define C......
                       Byte 1;     Byte 2
                       Stack Low;  Byte 4
                       Dimension 3 2
       */
        int num_dimensions = getshort();
        assert(get_icode(icode_file) == ',');
        int num_decls = getshort();
        // $ DEF V_0070 id=27 a=1 b=256 c=4
        // $ DEF V_0071 id=27 a=1 b=256 c=4
        // $ DEF V_0072 id=27 a=1 b=256 c=4
        // N PUSHI #1  OPD_STACK = 4
        // N PUSHI #2  OPD_STACK = 5
        // @ PUSH #V_006f  OPD_STACK = 6
        // N PUSHI #4  OPD_STACK = 7
        // d DIM 3 2
        dump_comment("%c %s %d %d\n", opcode, icode_name[opcode], num_dimensions, num_decls);

        ASTIDX boundarray[num_dimensions];
        dump_comment("                         creating a %dD array dopevector\n", num_dimensions);
        for (int dim = 0; dim < num_dimensions; dim++) {
          ASTIDX high = POP();
          ASTIDX low = POP();
          // TO DO ***IMPORTANT*** don't store the actual variables that were used to declare the dymnamically-bounded array -
          //                       save their values into temporaries (eg <declname>_low[dims] and <decname>_high[dims] so that
          //                       changing those variables doesn't mess up subsequent array accesses where the lower bound is subtracted
          //                       from the index.
          // This is the point where we need to have that function to declare a new temporary...
          // The actual assignment can be done in the cdecl code in ast.c
          // e.g.
          //          %integer i = 1, j, k
          //          %integerarray threed(0:i, i:2, -i:i)
          //
          //  not clear yet if I should just invent cached indexes for all bounds including ones known to be constant, or whether
          //  to only cache bounds containing variables in the expressions.  The latter may not be as complicated as I first feared.
          //
          //          dynarray_high_1 = i; dynarray_low_2 = i; dynarray_low_3 = -i; dynarray_high_3 = i; 
          //          int dynarray[0:dynarray_high_1][dynarray_low_2:2][dynarray_low_3:dynarray_high_3];
          //
          boundarray[dim] = mktuple(AST_BOUNDSPAIR, low, high);
          dump_comment("                         Dimension %d: low %d high %d\n", dim, low, high);
        }
        int tmpdecl[num_decls];  // number of $DEF declarations on stack that these boundss should be assigned to
        for (int decls = 0; decls < num_decls; decls++) {
          ASTIDX decl = POP();
          tmpdecl[decls] = decl;

          ASTIDX dopevector = mktuple(AST_DOPEVECTOR, num_dimensions);
          NEXT_AST += num_dimensions;  // allocate extra space for bounds for each dimension
          dump_comment("                         assigning a dopevector %d to array declaration %d\n", dopevector, decl);
          for (int dim = 0; dim < num_dimensions; dim++) {
            EXTRAFIELD(dopevector, dim) = boundarray[dim];
          }
          EXTENDED_FIELD_COUNT(dopevector) = num_dimensions;
          DOPEVECTOR(decl) = dopevector;  // if non-zero, the array in the $DEF has a dopevector, otherwise use BOUNDS1D(tuple). Or add a HAS_DOPEVECTOR flag?
          debug_types(decl); // diagnose changes to declaration caused by adding dopevector
          dump_comment("                         The dopevector field in decl %d above should *NOT be 0!\n", decl);
          debug_types(dopevector); // diagnose changes to declaration caused by adding dopevector
        }

        for (int decls = num_decls - 1; decls >= 0; decls--) {
          PUSH(tmpdecl[decls]);  // restore the declarations that were on the stack... (in the same order as they were)
        }

        break;
      }

      // NOTE: these might have been replaced!
      // 'q' in pass2-arm.imp handles include files:
      // c('h'):  Special Call(Tag);                                    %continue
      // c('q'):  Process Include File;                                 %continue
      case 'h': /* ALTBEG */
      case '|': /* ALT */
        unimplemented[opcode] = TRUE;
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        break;

      case 'i': /* INDEX */ /*  Array Index; */
      {
        // This is only used with the extra dimensions of N-D arrays.
        // - 1D arrays are handled by the ACCESS opcode.
        
          /* for:       x = threed(i, j, k) ...

                        // O LINE 8  OPD_STACK = 0  file=test/3Darray.imp
                        // @ PUSH #V_0005 (X)  OPD_STACK = 2
                        // @ PUSH #V_0001 (THREED)  OPD_STACK = 3
                        // @ PUSH #V_0002 (I)  OPD_STACK = 4
                        // i INDEX
                        // @ PUSH #V_0003 (J)  OPD_STACK = 5
                        // i INDEX
                        // @ PUSH #V_0004 (K)  OPD_STACK = 6
                        // a ACCESS
                        // S ASSVAL

              NOTE: the INDEX opcode is currently not implemented!!!

             for:       x = oned(i) ...

                        // @ PUSH #V_0003 (X)  OPD_STACK = 2
                        // @ PUSH #V_0001 (ONED)  OPD_STACK = 3
                        // @ PUSH #V_0002 (I)  OPD_STACK = 4
                        // a ACCESS
                        // S ASSVAL

             So, conclusion: it's INDEX that is broken, not ACCESS.
           */
          
        dump_comment("%c %s\n", opcode, icode_name[opcode]); // ***TO DO***

        ASTIDX this_index = POP();
        ASTIDX the_array = POP();
        if (BASE_TYPE(this_index) != T_INTEGER) {
          dump_comment("\n/* UNEXPECTED TYPE OF WHAT SHOULD BE AN ARRAY INDEX */\n");
        }

        if (OP(the_array) != AST_VAR) {
          dump_comment("\n/* A: INDEX OPERATION BEING APPLIED TO SOMETHING THAT MAY NOT BE A VAR */\n");
        }

        if (!IS_ARRAY(the_array)) {
          dump_comment("\n/* B: INDEX OPERATION BEING APPLIED TO SOMETHING THAT MAY NOT BE AN ARRAY VAR */\n");
        }

        ASTIDX indices = INDEX_LIST(the_array);
        if (indices == 0) {
          dump_comment("\n/* C: THE ARRAY VAR DOESN'T SEEM TO HAVE SPACE RESERVED FOR THE INDICES? */\n");
        }

        USERFIELD(indices, 0) += 1; // count of assigned indices
        USERFIELD(indices, USERFIELD(indices, 0)) = this_index; // attach this index
        PUSH(the_array); // updated with the partially-applied indexes so far...

      } break;

      case 'm': /* MONITOR */ /*  Do(Monitor Id, Monitor Ep, 0); */
      {
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        PUSH(mktuple(AST_MONITOR, 0));
      } break;

      case 'o': /*  Event Trap(Tag); */ /* ON byte short label */
      {
        short int eventlist = getshort();
        assert(get_icode(icode_file) == ',');
        short int labtag;
        short int lab = getforwardlab_from_tag(&labtag);
        dump_comment("%c %s MASK=%04x (labtag=%04x, lab=L_%04x)\n", opcode, icode_name[opcode], eventlist, labtag, lab);
        PUSH(mktuple(AST_ONGOTO, eventlist, mktuple(AST_LABEL, lab, 'L', labtag)));
        // NOTE: %signal handling may now require us to insert some code immediately
        // before the %finish" of the %on %event <n> %start ... %finish block.
        // That position will be immediately before the <label> above is output.
      } break;

      case 'r': /* RESOLVE m */ /*  Resolve(Tag); */
      {
        /*
r flag   String Resolution.  Flag is a three bit number, the
         bits representing:
              4    - conditional resolution.
              2    - first destination present.
              1    - second destination present.

         The resolution sets the condition code to true for
         successful resolution, and false for failure.
         The various operands are on the top of the stack.

         e.g.      S -> A.(B).C        @s@a@b@c r3

                   S -> A.(B)          @s@a@b r1

                   stop if S -> (B).C  @s@b@c r5k4s:4

                 */
        // result is tested by BF or BT!
        int flags = getshort();
        dump_comment("%c %s flags=%d\n", opcode, icode_name[opcode], flags);

        int CONDITIONAL = FALSE, OPD1 = FALSE, OPD2 = FALSE;
        ASTIDX opd1 = 0, opd2 = 0, sourcestring = 0, strtomatch = 0;
        if (flags & 1) OPD2 = TRUE;
        if (flags & 2) OPD1 = TRUE;
        if (flags & 4) CONDITIONAL = TRUE;

        if (OPD2) opd2 = POP();
        strtomatch = POP();
        if (OPD1) opd1 = POP();
        sourcestring = POP();

        ASTIDX resolve = mktuple(AST_RESOLVE, strtomatch, sourcestring, OPD1, OPD2, opd1, opd2);
        if (CONDITIONAL) {
          PUSH(mktuple(AST_CONDITIONAL_RESOLVE, resolve));
        } else {
          // TO DO: replace AST_CONDITIONAL_RESOLVE and
          // AST_UNCONDITIONAL_RESOLVE
          // with more generic calls.
          PUSH(mktuple(AST_UNCONDITIONAL_RESOLVE, resolve));
        }
      } break;

      case 's': /* STOP */ /*  To Store(Tag); */
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        //dump_code("exit(0);\n");
        PUSH(mktuple(AST_STOP));
        // a call to exit(0) would be better, but
        //  1) namespace pollution and
        //  2) not sure how to construct that call :-)
        break;

      case 'c': /*  Section = 1;  Get String(Section Id); */
        unimplemented[opcode] = TRUE;
        dump_comment("%c %s\n", opcode, icode_name[opcode]);
        break;

      case 'w': /* MCODE */ /*  Machine Code;  Forget Everything; */
      {
        int i1;

        char comment[1024];
        char *cp = &comment[0];

        fprintf(stderr, "? Warning: program contains embedded machine code.\n");
        unimplemented[opcode] = TRUE;
        cp += sprintf(cp, "%c %s ", opcode, icode_name[opcode]);
        for (;;) {
          char *p1 = getmcstring(&i1);
          cp += sprintf(cp, " %s", p1);
          if (i1 == ';') break;
          int p2 = getshort();
          cp += sprintf(cp, " tag_%d", p2);
        }
        cp += sprintf(cp, "\n");
        dump_comment(comment);
      } break;

      // I think these just set internal flags for the compiler?  It's documented somewhere.
      case 'y': /* DIAG short */ /*  Set CD(Tag, Diag); */
      {
        int diag = getshort();
        dump_comment("%c %s %d\n", opcode, icode_name[opcode], diag);
        break;
        PUSH(mktuple(AST_DIAGNOSE, diag));
      } break;

      case 'z': /* CONTROL short */ /*  Set CD(Tag, Control); */
      {
        int ctrl = getshort();
        dump_comment("%c %s %d\n", opcode, icode_name[opcode], ctrl);
        break;
        PUSH(mktuple(AST_CONTROL, ctrl));
      } break;

      case 'e': /* EVENT short */ /*  Signal Event(Tag); */
      {
        int eventno = getshort();
        dump_comment("%c %s %d\n", opcode, icode_name[opcode], eventno);
        
        // first value is in the tag.  optional second and third values
        // can be stacked expressions.  So we have to heuristally guess when
        // we've found the optional second or third parameters, by checking
        // that the preceding items on the stack are data items that would
        // be acceptable as signal parameters.  This took some effort to
        // get right and relies on the IS_DATA macro and associated function
        // in mktuple.[hc]

        ASTIDX event, subevent, extra;

        event = mktuple(AST_ICONST, eventno & 15);
        if (POPQ(&subevent)) {
          if (IS_DATA(subevent)) {
            if (POPQ(&extra)) {
              if (IS_DATA(extra)) {
                ASTIDX tmp = extra;
                extra = subevent;
                subevent = tmp;
              } else {
                PUSH(extra);
                extra = mktuple(AST_ICONST, 0);
              }
            } else {
              extra = mktuple(AST_ICONST, 0);
            }
          } else {
            if (!IS_DATA(subevent)) {
              PUSH(subevent);
              subevent = mktuple(AST_ICONST, 0);
              extra = mktuple(AST_ICONST, 0);
            }
          }
        } else {
          subevent = mktuple(AST_ICONST, 0);
          extra = mktuple(AST_ICONST, 0);
        }
        PUSH(mktuple(AST_SIGNAL, event, subevent, extra));
      } break;

      case 'l': /* LANG short */ /*  Language Flags = Tag; */
                                 // We're not going to support any language other than Imp77!
        //if ((opcode == 'l') && no_perms) suppress_perms = TRUE;  // <-- now handled in 'O' (LINE)
        dump_comment("%c %s %d\n", opcode, icode_name[opcode], getshort());
        break;

        // Unfortunately START and END can be *either*
        //  A: a record format definition *or*
        //  B: a formal parameter list

      case '{': /* START */
      {
        dump_comment("%c %s %c\n", opcode, icode_name[opcode], opcode == '{' ? '(' : ')');
        PUSH(mktuple(AST_START_PARAMLIST));

        IN_START_FINISH_GROUP = TRUE;
      } break;

      case '}': /* FINISH */
      {
        IN_START_FINISH_GROUP = FALSE;

        ASTIDX params[32];
        int param_count = 0;

        dump_comment("%c %s %c\n", opcode, icode_name[opcode], opcode == '{' ? '(' : ')');
        param_count = 0;

        for (;;) {
          ASTIDX prev = POP();
          if (OP(prev) == AST_START_PARAMLIST) break;
          params[param_count++] = prev;
        }

        // formal parameters are attached to the AST_DECLARE,
        // actual parameter to the AST_CALL ...

        ASTIDX paramlist = mktuple(AST_FORMAL_PARAMETER_LIST, param_count);
        NEXT_AST += param_count;
        for (int i = 0; i < param_count; i++) {
          OP(params[i]) = AST_DECLARE_FP;
          EXTRAFIELD(paramlist, (param_count - 1) - i) = params[i];
          // (reversed back to left-right order)
        }
        EXTENDED_FIELD_COUNT(paramlist) = param_count;

        if (last_declare_for_attaching_fields_or_parameters == -1) {
          fprintf(stderr, "START/FINISH group but no 'last_declare_for_attaching_fields_or_parameters' on record?\n");
        } else {
          // TO DO: check that last_declare_for_attaching_fields_or_parameters was a procedure or a record format...
          FORMAL_PARAM_LIST(last_declare_for_attaching_fields_or_parameters) = paramlist;
          last_declare_for_attaching_fields_or_parameters = -1;
        }
      }

      break;

      case '~':  // Used in a recordformat with a variant record, much like ALT?
                 // NOTE: This may be a newer ICODE format version!
                 // Not yet handled in cdecl.
      {
        int pending = getbyte();
        if ((' ' + 1 <= pending) && (pending <= '~')) {
          if (pending == 'A') {
            dump_comment("%c%c %s\n", opcode, pending, "ALTBEG");
            //PUSH_icode('h'); /* ALTBEG */
          } else if (pending == 'B') {
            dump_comment("%c%c %s\n", opcode, pending, "ALTEND");
            //PUSH_icode('q'); /* ALTEND */
          } else if (pending == 'C') {
            dump_comment("%c%c %s\n", opcode, pending, "ALT");
            //PUSH_icode('|'); /* ALT */
          } else {
            dump_comment("%c %s pending=%d ('%c')\n", opcode, "UNKNOWN", pending, pending);
          }
        } else {
          // won't happen:
          dump_comment("%c %s pending=%d\n", opcode, icode_name[opcode], pending);
        }
      } break; /* TODO */

        // Details of codes >= 128 can be found in
        // https://history.dcs.ed.ac.uk/archive/languages/imp77-acorn-tmp/3l/COMPILERS/bend/imp/pass2
        // Since none of them are used here they've been removed from the switch statement.

      default:
        if (opcode < 0 || opcode > 255 || icode_name[opcode] == NULL) {
          dump_comment("? OPCODE %d\n", opcode);
          break;
        } else {
          dump_comment("? %s\n", icode_name[opcode]);
          break;
        }
    }

    //if (opt_verbose) { ASTIDX tos; if (POPQ(&tos)) { debug_types(tos); PUSH(tos); } }
  }

  FLUSH_ICODE_STACK();

  char *valgrind = "";
  static char now_go_compile_it[1024];

  {
    char vg[512];
    int rc = sysnprintf(vg, sizeof(vg), "which valgrind");
    if (rc && (strlen(vg) > 3)) {
      valgrind = "-DVALGRIND_AVAILABLE";
    }
  }

  if (strcmp(output_filename, "/dev/stdout") == 0) opt_stdout = TRUE;

  char *runtime_unassigned_check = " -ftrivial-auto-var-init=pattern";
  char *cc = "cc";
  {
    char ccc[512];
    int rc = sysnprintf(ccc, sizeof(ccc), "which gcc12");
    if (rc > 3) {
      cc = "gcc12"; // private hack for my own system
    } else {
      rc = sysnprintf(ccc, sizeof(ccc), "which gcc");
      if (rc > 3) {
        cc = "gcc";
        rc = sysnprintf(ccc, sizeof(ccc), "gcc -dumpversion");
        if (rc) {
          char *s = strchr(ccc, '.'); if (s) *s = '\0'; // 12.3.0 -> 12
          int vsn = atoi(ccc);
          if (vsn < 12) {
            // check gcc version is new enough to support -ftrivial-auto-var-init=pattern
            fprintf(stderr, "? Warning: gcc is version %d - to support runtime unassigned variable checking, please install version 12 or later.\n", vsn);
            runtime_unassigned_check = "";
          }
        }
      }
    }
  }

  // Can get a list of options that a program was compiled with when using -frecord-gcc-switches by:
  // readelf -p .GCC.command.line program  (preferable option)
  // ... or ...  objdump -s -j .GCC.command.line program (fallback option)

  // running under valgrind invokes /snap/bin/valgrind --track-origins=yes --leak-check=full --show-leak-kinds=all --exit-on-first-error=yes -q --error-exitcode=1
  // unless the first argument is "-nv" (no valgrind).  Later, might add --merge-recursive-frames=3

  // pipe output through? ... grep -E "^(....:.*\.imp\ \*\*\*\*|...[0-9]......[0-9A-F][0-9A-F])" test/testfor.asm|ecce - - -command "f/1:/l0k-0;m0f-/%end/mk0;%c"


  if (object_filename[0] == '\0') {
    if (opt_link) {
      sprintf(object_filename, "%s", base_filename);
    } else {
      sprintf(object_filename, "%s.o", base_filename);
    }
  }
  
  // i2c -O and cc -DPARM_OPT -O2 with no -g and running with --nv is the fastest.

  char *s = now_go_compile_it;

  s += sprintf(s, "%s", cc);
  if (*valgrind) s += sprintf(s, " %s", valgrind); // if valgrind is available and we want error checking, tell the application to use it. (perms.c)
  if (PARM_OPT) s += sprintf(s, " -DPARM_OPT"); else s += sprintf(s, " -UPARM_OPT");
  if (PARM_UNASS) s += sprintf(s, " -DPARM_UNASS"); else s += sprintf(s, " -UPARM_UNASS");
  if (PARM_CHECK) s += sprintf(s, " -DPARM_CHECK"); else s += sprintf(s, " -UPARM_CHECK");
  //  -D_FORTIFY_SOURCE=1    [123]         1 - compile time   2 - run time  3 - extra features is using gcc v12
  s += sprintf(s, " -O"); // fairly safe, needed for some error detection, especially compile-time unassigned checks
  s += sprintf(s, " -g"); // Needed for most error catching and backtracing
  // reduce size of file caused by many identical _imp_current_file = "..." strings...
  s += sprintf(s, "%s", runtime_unassigned_check);
  s += sprintf(s, " -fmerge-constants");
  s += sprintf(s, " -fno-strict-aliasing"); //  is probably required to ensure Imp-like semantics for
                                            //  Imp expressions like I = INTEGER(ADDR(realvar)) which
                                            //  cause "Undefined Behaviour" when literally translated
                                            //  into equivalent C... (needed when using -O2 and above)
  s += sprintf(s, " -Wall");
  s += sprintf(s, " -Wno-unused-but-set-variable -Wno-unused-variable -Wno-unused-label -Wno-unused-function"); // short term expendiency
  s += sprintf(s, " -Wno-maybe-uninitialized -Wno-uninitialized"); //  These *are* wanted, but we want i2c to scrape this info from GCC and insert _U() tests instead.
  //if (PARM_TIDY) s += sprintf(s, " -Wno-parentheses"); // gcc warns about lack of brackets around operands of "<<", ">>", and "&" because it doesn't trust C programmers
  s += sprintf(s, " -frecord-gcc-switches");
  s += sprintf(s, " -fsanitize=undefined");
  s += sprintf(s, " -fsanitize=float-divide-by-zero");
  s += sprintf(s, " -fsanitize-undefined-trap-on-error");
  s += sprintf(s, " -fsanitize=float-cast-overflow");
  s += sprintf(s, " -fno-sanitize-recover=all");
  // NO: causes runtime error from insufficient stack space...   s += sprintf(s, " -fsplit-stack");
  s += sprintf(s, " -fstack-protector");
  s += sprintf(s, " -Wno-frame-address"); // trying to get backtrace to work properly
  s += sprintf(s, " -fno-omit-frame-pointer"); // trying to get backtrace to work properly
  s += sprintf(s, " -Wno-return-type");
  s += sprintf(s, " -Wno-comment");
  s += sprintf(s, " -ftrapv");
  s += sprintf(s, " -ggdb3");         // extra debugging for gdb including macro definitions
  s += sprintf(s, " -gdwarf-4"); // trying to solve problem with "Dwarf Error: Can't find .debug_ranges section"
  s += sprintf(s, " -I. -I..");
  if (!opt_link) s += sprintf(s, " -c");
  s += sprintf(s, " -o %s", object_filename); 
  s += sprintf(s, " %s.c", base_filename);
  if (opt_link) s += sprintf(s, " perms.c");
  //s += sprintf(s, " -Wa,-adhln");
  s += sprintf(s, " -lm"); // must come last
  //s += sprintf(s, " > %s.lis", base_filename);


  /*
      #!/bin/sh
      # i2c was developed on a 32-bit (i686) Intel linux.

      # i2c runs on 32-bit (armv7l) ARM, but has some issues on 64-bit (aarch64) ARM - the answer is to install the 32 bit
      # compiler.  A 32-bit executable of i2c both compiles and runs fine on the 64 bit Pi if the following has been done:

      # (Note: using an older version of gcc may stop some runtime checks from being enabled.)

      sudo apt install gcc-arm-linux-gnueabihf
      sudo dpkg --add-architecture armhf
      sudo apt-get update
      sudo apt-get install libc6:armhf
      arm-linux-gnueabihf-gcc -Wall -std=c99  -g -static -o i2c i2c.c icode.c ast.c pass1-flat.c flex.c stringpool.c  impsup-signals.c
      
      # it appears that the executables generated by i2c (via calls to gcc, which still use the default compiler)
      # more-or-less run OK.  I would imagine anything that stores addresses in an integer would fail if compiled
      # with the default 64 bit gcc so I may add code to have i2c invoke arm-linux-gnueabihf-gcc if it finds itself
      # running on a 64 bit arm.
      
      # However on 64-bit (x86_64) Intel, all that is required is to add "-m32" to the gcc command line when compiling
      # i2c, and presumably the same when i2c invokes gcc to build the users executables.
  */    


  {
    int i, any = 0;
    for (i = 0; i < 128; i++)
      if (unimplemented[i]) any = 1;
    if (any) {
      // fairly sure that apart from INDEX the only ones left are from other languages
      // and a different version od icode.
      fprintf(stderr, "? WARNING: These icodes may need to be implemented to compile this program correctly:\n  ");
      for (i = 0; i < 128; i++) {
        if (unimplemented[i]) fprintf(stderr, " '%c' (%s)", i, icode_name[i]);
      }
      fprintf(stderr, "\n");
    }

    if (opt_stdout) fprintf(output_file, "// COMPILE WITH: %s\n", now_go_compile_it);
    fflush(output_file);
    fclose(output_file); // critical to flush before invoking compiler!

    if (opt_stdout || any) {
      // just print.  if --stdout was used, there was no output file generated that could be compiled.
      if (opt_info) fprintf(stderr, "# %s\n", now_go_compile_it);
    } else {
      if (opt_info) fprintf(stderr, "$ %s\n", now_go_compile_it);
      // system(now_go_compile_it);  <------------------------------------------------------------------------------------------ NOW SUPPRESSED!
    }
  }
  
  exit(0);

  return (0);
  (void)NULL_LABEL; (void)NULL_TUPLE; (void)PROGNAME;
}
