// cc -c skimpas.c -I /home/gtoal/src/compilers101/new-parser/imps

/*
   Had to increase size of constant table.

   Did a nasty hack to add %SPEC which is not yet complete but sort of
   worls for now.  Added 8<<28 to Form as a %spec bit.  Still to check
   that body matches spec.  Probably won't work if procedure body
   parameter names differ from the spec.

   <RARRAY> removed from array declarations to match the code.

   See https://gtoal.com/history.dcs.ed.ac.uk/archive/languages/skimp/skimp_ii.html
   for original phrase structure.

   Note we use \= instead of # but may change to accept both.

   Document DJR's sneaky hack with Form > 2 for Unary ops, where '+' is
   considered the same as a null option!


   Examine the difference between bigtest.imp and xtest.imp and work
   out why the unedited bigtest.imp gives these errors:
       *  NAME HAS PARAMETERS
       *  NAME NOT A DESTINATION
       *  NAME HAS PARAMETERS
       *  NAME NOT A DESTINATION
    4 FAULTS IN PROGRAM

   I suspect either a scope problem or a bug with my %spec hacks.
   Maybe it's not safe to remove that top bit for other types of
   object, for example.

 */

#include <perms.h>

#ifndef NDEBUG
// Although gcc supports array bounds checking for arrays based at 0, it
// does not handle arrays with non-zero lower bounds.  Indeed neither does C,
// so the non-stanard macro processor below is a hack to add Imp-style lower
// and upper bounds to C arrays.  With bounds checking!
int _C(int x, char *name, int lower, int upper, char *filename, int line) {
  if ((x < lower) || (x > upper)) {
    fprintf(stderr, "* Array bounds exceeded in %s at line %d: %s[%d] is outside %s[%d:%d]\n",
                                                filename,  line,
                                                                name, x,          name, lower, upper);
    exit(4);
  }
//fprintf(stderr, "\"%s\", Line %d: %s[%d]\n", filename, line, name, x);
  return x;
}
#define _C(x, name, lower, upper) _C((x), name, (lower), (upper), __FILE__, __LINE__)
#else
// No array bound checking
#define _C(x, name, lower, upper) (x)
#endif

// #define DECLARE(type, name, lower, upper) type name[(upper)-(lower)+1]\n$define name[x] name[_C(x,name,lower,upper)]
// DECLARE(unsigned char, Named, 1, 1024)

#define _imp_join2(a,b) _imp_joinpp(&(a),&(b))

int A[500 /*1:500*/];
$define A[x] A[_C(x,"A",1,500)-1]

unsigned char Named[1024 /*1:1024*/]
$define Named[x] Named[_C(x,"Named",1,1024)-1]
                                     = {10,  'R', 'E', 'A', 'D', 'S', 'Y', 'M', 'B', 'O', 'L',
                                        10,  'N', 'E', 'X', 'T', 'S', 'Y', 'M', 'B', 'O', 'L',
                                        10,  'S', 'K', 'I', 'P', 'S', 'Y', 'M', 'B', 'O', 'L',
                                        11,  'P', 'R', 'I', 'N', 'T', 'S', 'Y', 'M', 'B', 'O', 'L',
                                        5,   'S', 'P', 'A', 'C', 'E',
                                        6,   'S', 'P', 'A', 'C', 'E', 'S',
                                        7,   'N', 'E', 'W', 'L', 'I', 'N', 'E',
                                        8,   'N', 'E', 'W', 'L', 'I', 'N', 'E', 'S',
                                        7,   'N', 'E', 'W', 'P', 'A', 'G', 'E',
                                        4,   'R', 'E', 'A', 'D',
                                        5,   'W', 'R', 'I', 'T', 'E',
                                        [94 ... 1023] = 0};
                                     // These perm routines are handled by the skimpais interpreter.
int Namedlink[256 /*0:255*/]
$define Namedlink[x] Namedlink[_C(x,"Namedlink",0,255)]
                              = {0,
                                76,
                                [2 ... 13] = 0,
                                89,
                                [15 ... 68] = 0,
                                84,
                                [70 ... 187] = 0,
                                52,
                                [189 ... 199] = 0,
                                1,
                                12,
                                23,
                                34,
                                [204 ... 207] = 0,
                                67,
                                [209 ... 231] = 0,
                                46,
                                [233 ... 237] = 0,
                                59,
                                [239 ... 255] = 0};
int Taglink[256 /*0:255*/]
$define Taglink[x] Taglink[_C(x,"Taglink",0,255)]
                            = {0,
                              13,
                              [2 ... 13] = 0,
                              16,
                              [15 ... 68] = 0,
                              14,
                              [70 ... 187] = 0,
                              8,
                              [189 ... 199] = 0,
                              1,
                              3,
                              4,
                              5,
                              [204 ... 207] = 0,
                              11,
                              [209 ... 231] = 0,
                              7,
                              [233 ... 237] = 0,
                              10,
                              [239 ... 255] = 0};
int Tag[512 /*1:512*/] = {0x40100001, 0x01010002, 0x41000002,      0x40000003,
                          0x40100004, 0x01010002, 0x40000005,      0x40100006,
                          0x01010002, 0x40000007, 0x40100008,      0x01010002,
                          0x40000009, 0x4010000A, 0x11010002,      0x4020000B,
                          0x01010002, 0x01010003, [18 ... 511] = 0};
$define Tag[x] Tag[_C(x,"Tag",1,512)-1]
int Link[512 /*1:512*/] = {
    2, 0, 0, 0, 6, 0, 0, 9, 0, 0, 12, 0, 0, 15, 0, 17, 18, 0, [18 ... 511] = 0};
$define Link[x] Link[_C(x,"Link",1,512)-1]
int Namedp = 95;
int Tagasl = 19;
int Expropt = 0;
int Condopt = 0;
int Tagsopt = 0;
extern void SS(int Statementp);
//void Statement(int Statementp);
_imp_string Strint(int N, int P);
void Fault(_imp_string Mess);
void Dump(_imp_string Opn, _imp_string Reg, _imp_string Base, int Disp);
_imp_string Name(int Ident);
void Skimp(_imp_string S) {
  auto void Readps(void);
  auto void Readstatement(void);
  auto void Rpsym(int *L);
  auto int Findk(_imp_string * K);
  auto int Compare(int P);
  //
  // There was no need to use an %RECORD here.  Parallel arrays would have worked just fine.
  //
  typedef struct Kdf {
    unsigned char L;
    unsigned char N;
    unsigned char A;
    unsigned char B;
  } Kdf;
  Kdf Kd[255 /*1:255*/];
$define Kd[x] Kd[_C(x,"Kd",1,255)-1]
  _imp_string Pn[64 /*256:319*/];
$define Pn[x] Pn[_C(x,"Pn",256,319)-256]
  int Pp[64 /*256:319*/];
$define Pp[x] Pp[_C(x,"Pp",256,319)-256]
  int Ps[512 /*1:512*/];
$define Ps[x] Ps[_C(x,"Ps",1,512)-1]
  int T[256 /*1:256*/];
$define T[x] T[_C(x,"T",1,256)-1]
  int Tt[256 /*1:256*/];
$define Tt[x] Tt[_C(x,"Tt",1,256)-1]
  int Tp;
  int Ap;
  int Ttp;
  int Ttpp;
  int I;
  int J;
  int Psflag;
  _imp_string File;
  _imp_string Object;
  _imp_string Options;
  _imp_string Option;
  _imp_string As;
  static int Lexopt = 0;
  static int Analopt = 0;
  _imp_string X;
  _imp_string Xoption;
  _imp_string Xoptions;
  if (_imp_resolve(S, &X, _imp_str_literal("/"), &Xoptions) &&
      *Length(X)==0) {                                     // BUG!!! comparing against empty string with _imp_strcmp and _imp_str_literal("") gives wrong answer!!!
//fprintf(stderr, "Taking option branch\n");
    Options = Xoptions;
    if (_imp_resolve(Options, &Xoptions, _imp_str_literal(" "), &File)) {
      Options = Xoptions;
//fprintf(stderr, "A: FILE TO BE OPENED IS: \"%s\"\n", File.cstr.s);
    } else {
      File = _imp_str_literal("");
    }
    do {
      if (_imp_resolve(Options, &Xoption, _imp_str_literal("/"), &Xoptions)) {
        Option = Xoption;
        Options = Xoptions;
      } else {
        Option = Options;
        Options = _imp_str_literal("");
      }
      if (_imp_resolve(Option, &X, _imp_str_literal("NO"), &Xoption) &&
          *Length(X) == 0) {
        Option = Xoption;
        I = 0;
      } else
        I = 1;
      if (_imp_strcmp(Option, _imp_str_literal("LEX")) == 0)
        Lexopt = I;
      else if (_imp_strcmp(Option, _imp_str_literal("ANAL")) == 0)
        Analopt = I;
      else if (_imp_strcmp(Option, _imp_str_literal("EXPR")) == 0)
        Expropt = I;
      else if (_imp_strcmp(Option, _imp_str_literal("COND")) == 0)
        Condopt = I;
      else if (_imp_strcmp(Option, _imp_str_literal("TAGS")) == 0)
        Tagsopt = I;
      else {
//fprintf(stderr, "Failed option was: \"%s\"\n", Option.cstr.s);
        Printstring(_imp_join(_imp_str_literal("OPTION \""),
                              _imp_join2(Option, _imp_str_literal("\"?\n"))));
        exit(0);
      }
    } while (*Length(Options) != 0);
  } else {
//fprintf(stderr, "Taking NO-option branch\n");
    File = S;
//fprintf(stderr, "B: FILE TO BE OPENED IS: \"%s\"\n", File.cstr.s);
  }
  Readps();
  if (*Length(File) == 0)
    Openoutput(1, _imp_str_literal("/dev/stdout"));
  else
    Openoutput(1, _imp_join2(File, _imp_str_literal(".lis")));
  Selectoutput(1);
  Printstring(_imp_join(
      _imp_str_literal("\n\n                   SKIMP COMPILER MKII\n\nFILE: "),
      _imp_join2(File, _imp_str_literal("\nOPTIONS: "))));
  if (Lexopt == 1) Printstring(_imp_str_literal("LEX "));
  if (Analopt == 1) Printstring(_imp_str_literal("ANAL "));
  if (Expropt == 1) Printstring(_imp_str_literal("EXPR "));
  if (Condopt == 1) Printstring(_imp_str_literal("COND "));
  if (Tagsopt == 1) Printstring(_imp_str_literal("TAGS "));
  Newline();
  if (Psflag) {
    Fault(_imp_str_literal("PHRASE STRUCTURE FAULTY"));
    exit(0);
  }
  if (*Length(File) == 0)
    Openinput(1, _imp_str_literal("/dev/stdin"));
  else
    Openinput(1, _imp_join2(File, _imp_str_literal(".imp")));
  Selectinput(1);
  for (I = Tagasl; I <= 511; I++) Link[I] = I + 1;
  if (_imp_on_event(9)) {
    Fault(_imp_str_literal("%ENDOFPROGRAM MISSING"));
    exit(1);
  }
  for (;;) {
    Readstatement();
    Ttp = Tp - 1;
    Tp = 1;
    Ap = 1;
    int Syntax = Compare(258);
    if (Syntax == 0 || Tp != Ttp)
      if (!Syntax)
        Fault(_imp_str_literal("SYNTAX ?  compare(258) returned 0."));
      else if (Tp != Ttp)
        Fault(_imp_join(
            _imp_str_literal("SYNTAX ?  Incomplete statement? tp="),
            _imp_join(Strint(Tp, 0),
                      _imp_join(_imp_str_literal(" ttp="), Strint(Ttp, 0)))));
      else
        Fault(_imp_str_literal("SYNTAX ?"));
    else {
      if (Analopt == 1) {
        Newline();
        J = 0;
        for (I = 1; I <= Ap - 1; I++) {
          if (A[I] < 0) {
            As = (_imp_join(
                _imp_str_literal("  ("),
                _imp_join(Strint(I, 1),
                          _imp_join(_imp_str_literal("/"),
                                    _imp_join2(Pn[(unsigned)A[I] << 1 >> 17],
                                              _imp_str_literal(")"))))));
            A[I] = A[I] & 0xFFFF;
          }
          Write(A[I], 4);
          J += 5;
          if (J > 60) {
            Newline();
            J = 0;
          }
        }
        Newlines(2);
      } else {
        for (I = 1; I <= Ap - 1; I++) {
          if (A[I] < 0) A[I] = A[I] & 0xFFFF;
        }
      }
// COMPILATION REMOVED:      Statement(1);
      SS(1);
    }
  }
  void Readps(void) {
    _imp_string Ka[128 /*1:128*/];
    $define Ka[x] Ka[_C(x,"Ka",1,128)-1]
    int Kna[128 /*1:128*/];
    $define Kna[x] Kna[_C(x,"Kna",1,128)-1]
    _imp_string K;
    int Kap;
    int Kdasl;
    int Kn;
    int I;
    int L;
    int Psp;
    int Pnp;
    int Alt;
    int *Np;
    auto void Insert(_imp_string K);
    auto void Extract(int I, _imp_string K);
    auto void Assign(int I);
    auto int Newkd(void);
    auto void Returnkd(int I);
    auto void Returnlist(int I);
    auto int Phrase(void);
    auto void Literal(void);
    auto void Keyword(void);
    Openinput(2, _imp_str_literal("skimpps.txt"));
    Selectinput(2);
//fprintf(stderr, "Ready to read skimpps.txt\n");
    Openoutput(2, _imp_str_literal("skimpps.lis"));
    Selectoutput(2);
    Printstring(_imp_str_literal("\n\nPHRASE STRUCTURE\n\n"));
    Kap = 1;
    for (;;) {
      Rpsym(&L);
      if (L == '$') {
//fprintf(stderr, "Pass 1: got the '$' at the end of skimpps.txt\n");
        break;
      }
      if (L == '"') {
        K = _imp_str_literal("");
        for (;;) {
          Rpsym(&L);
          if (L == '"') break;
          if ('A' <= L && L <= 'Z') {
            //_imp_string tmp;
            //*_imp_length(tmp)=1;
            //*_imp_charno(tmp, 1) = L;
            //K = _imp_join(K, tmp);
            K = _imp_join(K, Tostring(L));
          }
        }
//fprintf(stderr, "Setting Ka[Kap=%d] to \"%s\"\n", Kap, K.cstr.s);
        Ka[Kap] = K;
        Kap++;
      }
    }
Kd[255].B = 0;
    for (I = 1; I <= 26 /*255*/; I++) Kd[I] = (Kdf){0};
    for (I = 27; I <= 254; I++) {
      Kd[I].B = I + 1;
//fprintf(stderr, "Kdasl = %d  I=%d  Ka[I].B=%d  Kap=%d  $define Ka[n] Ka[(n)-1]\n", Kdasl, I, Kd[I].B, Kap);
    }
    Kdasl = 27;
    I = 1;
    do {
//fprintf(stderr, "Kdasl = %d  I=%d  Ka[I]=\"%s\", Kap=%d  $define Ka[n] Ka[(n)-1]\n", Kdasl, I, _imp_cstr_safe(&Ka[I]), Kap);
      Insert(Ka[I]);
      I++;
    } while (I != Kap);
    Kn = 128;
    for (I = 1; I <= 26; I++)
      if (Kd[I].L) Assign(I);
    Kap = 1;
    for (I = 1; I <= 26; I++)
      if (Kd[I].L) Extract(I, _imp_str_literal(""));
    Printstring(_imp_str_literal("\n\nKEYWORDS\n\n"));
    for (I = 1; I <= Kap - 1; I++)
      Printstring(
          _imp_join(Strint(Kna[I], 3),
                    _imp_join(_imp_str_literal("  "),
                              _imp_join(Ka[I], _imp_str_literal("\n")))));
//fprintf(stderr, "resetting skimpps.txt\n");
    Resetinput();
    Pn[256] = _imp_str_literal("NAME");
    Pp[256] = 0;
    Pn[257] = _imp_str_literal("CONST");
    Pp[257] = 0;
    Pnp = 258;
    Psp = 1;
    for (;;) {
      Readsymbol(&L);
//Rpsym(&L);
      if (L == '$') {
//fprintf(stderr, "Pass 2: got the '$' at the end of skimpps.txt\n");
        break;
      }
      if (L == '<') {
        Pp[Phrase()] = Psp;
        for (;;) {
          Alt = Psp;
          Np = &Ps[Psp + 1];
          *Np = 0;
          Psp += 2;
          for (;;) {
            Readsymbol(&L);
//Rpsym(&L);
            if (L == '<') {
              Ps[Psp] = Phrase();
              Psp++;
              *Np = *Np + 1;
            }
            if (L == '\'') Literal();
            if (L == '"') Keyword();
            if (L == ',' || L == ';') break;
          }
          Ps[Alt] = Psp;
          if (L == ';') break;
        }
        Ps[Psp] = 0;
        Psp++;
      }
    }
//fprintf(stderr, "Should no longer be reading from skimpps.txt\n");
    Psflag = 0;
    for (I = 258; I <= Pnp - 1; I++)
      if (!Pp[I]) {
        Fault(_imp_join(_imp_str_literal("<"),
                        _imp_join(Pn[I], _imp_str_literal("> NOT DEFINED"))));
        Psflag = 1;
      }
    Printstring(_imp_str_literal("\n\nPHRASES\n\n"));
    for (I = 256; I <= Pnp - 1; I++)
      Printstring(_imp_join(
          Strint(I, 3),
          _imp_join(Strint(Pp[I], 6),
                    _imp_join(_imp_str_literal("   "),
                              _imp_join(Pn[I], _imp_str_literal("\n"))))));
    Printstring(_imp_str_literal("\n\nREDUCED PHRASE STRUCTURE\n\n"));
    for (I = 1; I <= Psp - 1; I++) {
      if (!((I - 1) & 15))
        Printstring(
            _imp_join(_imp_str_literal("\n"),
                      _imp_join(Strint(I, 3), _imp_str_literal("   "))));
Printstring( _imp_str_literal(" ")); // Write(X,3) is not placing a ' ' before the number!  TEMPORARY fix via this hack
      Write(Ps[I], 3);
    }
    Newlines(2);
    return;
    void Insert(_imp_string K) {      // GT: This is the most likely area to cause current run-time error
      int I;
      int J;
      int L;
      _imp_string X, Xk;
      L = *Charno(K, 1);
      if (_imp_resolve(K, &X, Tostring(L), &Xk) && *Length(X)==0) K = Xk;
      I = L - 'A' + 1;
//if (I < 0) fprintf(stderr, "I=%d  L=%d\n", I, L);
      if (Kd[I].L) {
      Search:if (*Length(K) == 0) {   // if (_imp_strcmp(K, _imp_str_literal("")) == 0) {
          if (Kd[I].A) {
            Extract(Kd[I].A, _imp_str_literal(""));
            Returnlist(Kd[I].A);
            Kd[I].A = 0;
          }
          return;
        }
        if (!Kd[I].A) {
          Insert(K);
          return;
        }
        L = *Charno(K, 1);
        if (_imp_resolve(K, &X, Tostring(L), &Xk) && *Length(X)==0) K = Xk;
        //if (_imp_resolve(K, &X, Tostring(L), &Xk) && _imp_strcmp(X,_imp_str_literal(""))==0) K = Xk;
        I = Kd[I].A;
        for (;;) {
          if (Kd[I].L == L) goto Search;
          if (!Kd[I].B) break;
          I = Kd[I].B;
        }
        J = I;
        I = Newkd();
        Kd[J].B = I;
      }
      for (;;) {
        Kd[I].L = L;
        // IMP: %if k="" %then %return
        if (*Length(K) == 0) return;
        L = *Charno(K, 1);
        // IMP: k->(tostring(l)).k
        if (_imp_resolve(K, &X, Tostring(L), &Xk) && *Length(X)==0) K = Xk;
        //{int i; for (i = 1; i <= K.length; i++) K.charno[i]=K.charno[i+1]; K.length -= 1; }
        J = I;
        I = Newkd();
        Kd[J].A = I;
      }
    }
    void Extract(int I, _imp_string K) {
      _imp_string Kk;
//_imp_string tmp;
      if (!I) return;
//tmp=                    Tostring(Kd[I].L);
//      Kk = _imp_join(K, tmp);
      Kk = _imp_join(K, Tostring(Kd[I].L));
//fprintf(stderr, "Kk = _imp_join(K=\"%s\", Tostring(Kd[I].L='%c')=\"%s\") = \"%s\"\n", K.cstr.s, L, tmp.cstr.s, Kk.cstr.s);
      if (!Kd[I].A) {
        Ka[Kap] = Kk; // copy entire struct containing string.
//fprintf(stderr, "Ka[Kap=%d] = \"%s\" = \"%s\"\n", Kap, Ka[Kap].cstr.s, Kk.cstr.s);
        Kna[Kap] = Kd[I].N;
        Kap++;
      } else
        Extract(Kd[I].A, Kk);
      Extract(Kd[I].B, K);
    }
    void Assign(int I) {
      if (!I) return;
      if (!Kd[I].A) {
        Kd[I].N = Kn;
        Kn++;
      } else
        Assign(Kd[I].A);
      Assign(Kd[I].B);
    }
    int Newkd(void) {
      int I;
      if (!Kdasl) {
        Fault(_imp_str_literal("KD ASL EMPTY"));
        exit(0);
      }
      I = Kdasl;
if (Kd[I].B) {
      Kdasl = Kd[I].B;
//fprintf(stderr, "1: Kdasl set to Kd[%d].B=%d at line %d\n", I, Kd[I].B,__LINE__);
} else {
  fprintf(stderr, "? Warning: Kdasl set to Kd[%d].B=%d at line %d\n", I, Kd[I].B,__LINE__-5);
}
      Kd[I] = (Kdf){0};
      return (I);
    }
    void Returnkd(int I) {
      Kd[I].B = Kdasl;
//fprintf(stderr, "Kd[%d].B = Kdasl (%d)  at line %d\n", I, Kdasl, __LINE__);
      Kdasl = I;
//fprintf(stderr, "2: Kdasl set to %d (I) at line %d\n", I, __LINE__);
    }
    void Returnlist(int I) {
      if (!I) return;
      Returnlist(Kd[I].A);
      Returnlist(Kd[I].B);
      Returnkd(I);
    }
    int Phrase(void) {
      _imp_string P;
      int I;
      int L;
      P = _imp_str_literal("");
      for (;;) {
        Readsymbol(&L);
//Rpsym(&L);
        if (L == '>')
          break;
        else
          P = _imp_join(P, Tostring(L));
      }
      for (I = 256; I <= Pnp - 1; I++)
        if (_imp_strcmp(Pn[I], P) == 0) return (I);
      Pn[Pnp] = P;
      Pp[Pnp] = 0;
      Pnp++;
      return (Pnp - 1);
    }
    void Literal(void) {
      int L;
      for (;;) {
        Readsymbol(&L);
//Rpsym(&L);
        if (L == '\'')
          return;
        else {
          Ps[Psp] = L;
          Psp++;
        }
      }
    }
    void Keyword(void) {
      _imp_string K;
      int L;
      K = _imp_str_literal("");
      for (;;) {
        Readsymbol(&L);
//Rpsym(&L);
        if (L == '"') break;
        if ('A' <= L && L <= 'Z') K = _imp_join(K, Tostring(L));
      }
//fprintf(stderr, "Keyword: K=\"%s\"\n", K.cstr.s);
      do {
        Ps[Psp] = Findk(&K);
if (Ps[Psp] == 0) {fprintf(stderr, "Ps[Psp] = Findk(&K=\"%s\") = 0\n", K.cstr.s);}
        Psp++;
if (Psp >= 512) {fprintf(stderr, "Psp = %d (>= 512)\n", Psp);}
      //} while (_imp_strcmp(K, _imp_str_literal("")) != 0);
      } while (*Length(K) != 0);
    }
  }
  void Readstatement(void) {
    auto void Store(int L);
    auto void Keyword(void);
    auto void Name(void);
    auto void Const(void);
    int I;
    int L;
    int Ksh;
    Newlines(3);
    Ttp = 1;
    Ksh = 0;
    for (;;) {
      Rpsym(&L);
//fprintf(stderr, "%c", L);
      if (L == '%')
        Ksh = 128;
      else {
        if ('A' > L || L > 'Z') Ksh = 0;
        if (L != ' ') {
          if (L == '!' && Ttp == 1) {
            do {
              Rpsym(&L);
//fprintf(stderr, "%c", L);
            } while (L != ';' && L != Nl);
          } else {
            Store(L);
            if (L == '\'') {
              do {
                Rpsym(&L);
//fprintf(stderr, "%c", L);
                Store(L);
              } while (L != '\'');
            } else if (L == ';' || L == Nl) {
              if (Ttp == 2) {
                Ttp = 1;
              } else {
                if (L == ';') {
                  Newline();
                  break;
                }
                if (Tt[Ttp - 2] == 'C' + 128) {
                  Ttp -= 2;
                } else {
                  break;
                }
              }
            }
          }
        }
      }
    }
    Tp = 1;
    Ttpp = 1;
    do {
      I = Tt[Ttpp];
      if (I >= 128)
        Keyword();
      else if (I == 'M' && Tt[Ttpp+1] == '\'')                     // ADDED GT:  M'ABCD' style constants
        Const();                                                   // ADDED GT:
      else if ('A' <= I && I <= 'Z')
        Name();
      else if (('0' <= I && I <= '9') || I == '\'')
        Const();
      else {
        T[Tp] = I;
        Tp++;
        Ttpp++;
      }
    } while (Ttpp != Ttp);
    if (Lexopt == 1) {
      Newline();
      for (Ttpp = 1; Ttpp <= Tp - 2; Ttpp++) {
        Write(T[Ttpp], 4);
        if (!(Ttpp & 0xF)) Newline();
      }
      Newline();
    }
    return;
    void Store(int L) {
      if (Ttp > 256) {
        Fault(_imp_str_literal("STATEMENT TOO LONG"));
        exit(0);
      }
      Tt[Ttp] = L + Ksh;
      Ttp++;
    }
    void Keyword(void) {
      _imp_string K;
      int I;
      K = _imp_str_literal("");
      while (Tt[Ttpp] > 128) {
        K = _imp_join(K, Tostring(Tt[Ttpp] - 128));
        Ttpp++;
      }
      do {
        I = Findk(&K);
        T[Tp] = I;
        Tp++;
      } while (*Length(K) != 0 && I != 0);
    }
    void Name(void) {
      _imp_string *Sname;
      int I;
      int L;
      int Hash;
      Sname = String(Addr(Named[Namedp]));        // THIS MAY NOT BE CONVERTABLE TO C ?
      Hash = 0;
      *Sname = _imp_str_literal("");
      L = Tt[Ttpp];
      do {
        if (Namedp + *Length(*Sname) >= 1022) {
          Fault(_imp_str_literal("NAME DICTIONARY FULL"));
          exit(0);
        }
        if (*Length(*Sname) == 255) {
          Fault(_imp_str_literal("NAME TOO LONG"));
          exit(0);
        }
        *Sname = _imp_join(*Sname, Tostring(L));
//        Hash = Hash << 8 | L;   // With *all* gcc run-time checks enabled, this gives an overflow error!
        Hash = (Hash&0xffffff) << 8 | L;
        Ttpp++;
        L = Tt[Ttpp];
      } while (L >= '0' && ('9' >= L || L >= 'A') && L <= 'Z');
      Hash -= Hash / 251 * 251;
      I = Hash;
      for (;;) {
        if (!Namedlink[I]) {
          Namedlink[I] = Namedp;
          Namedp = Namedp + *Length(*Sname) + 1;
          break;
        }
        if (_imp_strcmp(*Sname, *String(Addr(Named[Namedlink[I]]))) == 0) break;
        I = (I + 1) & 255;
        if (I == Hash) {
          Fault(_imp_str_literal("NAME DICTIONARY FULL"));
          exit(0);
        }
      }
      T[Tp] = 256;
      T[Tp + 1] = I;
      Tp += 2;
    }
    void Const(void) {
      int L;
      int Value;
      int Flag;
      int Count;
      int Maxby10;
      int Maxld;
      Value = 0;
      Flag = 0;
      if ((Tt[Ttpp] == 'M') && (Tt[Ttpp+1] == '\'')) Ttpp += 1; // Old syntax was M'ABCD', this code looked for 'ABCD' with no 'M'   // ADDED GT:
      if (Tt[Ttpp] == '\'') {
        Count = 0;
        for (;;) {
          Ttpp++;
          if (Tt[Ttpp] == '\'') {
            Ttpp++;
            if (Tt[Ttpp] != '\'') break;
          }
          Value = Value << 8 | Tt[Ttpp];
          Count++;
        }
        if (1 > Count || Count > 4) Flag = 1;
      } else {
        Maxby10 = 0x7FFFFFFF / 10;
        Maxld = 0x7FFFFFFF - Maxby10 * 10;
        L = Tt[Ttpp];
        do {
          if (Value > Maxby10 || (Value == Maxby10 && L > Maxld))
            Flag = 1;
          else
            Value = Value * 10 + L - '0';
          Ttpp++;
          L = Tt[Ttpp];
        } while (L >= '0' && L <= '9');
      }
      T[Tp] = 257;
      if (Flag) {
        Fault(_imp_str_literal("CONSTANT INVALID"));
        Value = 0;
      }
      T[Tp + 1] = Value;
      Tp += 2;
    }
  }
  void Rpsym(int *L) {
    Readsymbol(L);
    Printsymbol(*L);
    if ('a' <= *L && *L <= 'z') *L = *L - 'a' + 'A';
  }
  int Findk(_imp_string * K) {
    int I;
    int L;
    _imp_string Xk;
    L = *Charno(*K, 1);
    if (_imp_resolve(*K, NULL, Tostring(L), &Xk)) *K = Xk;
    I = L - 'A' + 1;
    if (!Kd[I].L) return (0);
  Search:
    if (*Length(*K) == 0 || Kd[I].A == 0) return (Kd[I].N);
    L = *Charno(*K, 1);
    if (_imp_resolve(*K, NULL, Tostring(L), &Xk)) *K = Xk;
    I = Kd[I].A;
    for (;;) {
      if (Kd[I].L == L) goto Search;
      if (!Kd[I].B) return (0);
      I = Kd[I].B;
    }
  }
  int Compare(int P) {
    int App;
    int Tpp;
    int Alt;
    int Altend;
    int Psp;
    int Psi;
    A[Ap] = (P << 16) | 0x80000001;
    if (P <= 257) {
      if (P == T[Tp]) {
        A[Ap + 1] = T[Tp + 1];
        Ap += 2;
        Tp += 2;
        return (1);
      } else {
        return (0);
      }
    }
    Tpp = Tp;
    App = Ap;
    Psp = Pp[P];
    for (;;) {
      Alt = Ap + 1;
      Altend = Ps[Psp];
      Ap = Alt + Ps[Psp + 1];
      if (Ap > 255) {
        Fault(_imp_str_literal("ANALYSIS RECORD TOO LONG"));
        exit(0);
      }
      Psp += 2;
      for (;;) {
        if (Psp == Altend) return (1);
        Psi = Ps[Psp];
        if (Psi >= 256) {
          A[Alt] = Ap;
          if (!Compare(Psi)) break;
          Alt++;
        } else {
          if (Psi != T[Tp]) break;
          Tp++;
        }
        Psp++;
      }
      if (!Ps[Altend]) return (0);
      Psp = Altend;
      Tp = Tpp;
      Ap = App;
      A[Ap] = A[Ap] + 1;
    }
  }
}