// cc -c skimpds.c -I /home/gtoal/src/compilers101/new-parser/imps
// do we really need string comparisons of "FILL" in dump()?

/*
gtoal@linux:~/src/skimp/new/mark2$ fgrep \>\> skimp*.c|fgrep 28
skimpbs.c:      if ((unsigned)Nametag >> 28 == 4) {
skimpbs.c:      if ((unsigned)Nametag >> 28 >= 2) {
skimpbs.c:        if ((unsigned)Nametag >> 28 == 1) {
skimpbs.c:    } else if ((unsigned)Nametag >> 28 == 4 &&

skimpds.c:    if ((unsigned)Nametag >> 28 == 4) {
skimpds.c:      if (!((unsigned)Ptag >> 28))
skimpds.c:            if ((unsigned)Pnametag >> 28 == 4)
skimpds.c:              if ((unsigned)Ptag >> 28 == 1)
skimpds.c:                if ((unsigned)Pnametag >> 28 >= 2)
skimpds.c:                  if ((unsigned)Pnametag >> 28 == 1)

skimpes.c:          if ((unsigned)Nametag >> 28 <= 1)
skimpes.c:          else if ((unsigned)Nametag >> 28 <= 3)
skimpes.c:        if ((unsigned)Datum >> 28 == 1) {
*/

#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!
extern int _C(int x, char *name, int lower, int upper, char *filename, int line);
#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

extern int A[500 /*1:500*/];
$define A[x] A[(x)-1]
extern unsigned char Named[1024 /*1:1024*/];
$define Named[x] Named[(x)-1]
extern int Namedlink[256 /*0:255*/];
extern int Taglink[256 /*0:255*/];
extern int Tag[512 /*1:512*/];
$define Tag[x] Tag[(x)-1]
extern int Link[512 /*1:512*/];
$define Link[x] Link[(x)-1]
int Nextrad[16 /*0:15*/];
_imp_string Display[16 /*0:15*/];
extern int Tagasl;
extern int Level;
extern int Tagsopt;
extern int Nextcad;
extern int Namedp;
void Expr(int Exprp);
static int Worklist[16 /*0:15*/] = {[0 ... 15] = 0};
static int Namelist[16 /*0:15*/] = {[0 ... 15] = 0};
static int Branchlist[16 /*0:15*/] = {[0 ... 15] = 0};
static int Startlist[16 /*0:15*/] = {[0 ... 15] = 0};

// Constants only appear in the (read-only) constant table once.
#define MAX_CONST_TABLE 256  // Original 128 was too few for bigtest.imp
static int Cot[MAX_CONST_TABLE /*0:127*/];
static int Cotp;

static int Faults;
static int Params;
_imp_string Strint(int N, int P) {
  _imp_string R;
  _imp_string S;
  if (N < 0) {
    S = _imp_str_literal("-");
    N = -N;
  } else
    S = _imp_str_literal("");
  R = _imp_str_literal("");
  do {
    R = _imp_join(Tostring(N - N / 10 * 10 + '0'), R);
    N = N / 10;
  } while (N);
  R = _imp_join(S, R);
  while (*Length(R) < P) R = _imp_join(_imp_str_literal(" "), R);
  return (R);
}
_imp_string Strhex(int N) {
  static const _imp_string H[16 /*0:15*/] = {
      _imp_str_literal("0"), _imp_str_literal("1"), _imp_str_literal("2"),
      _imp_str_literal("3"), _imp_str_literal("4"), _imp_str_literal("5"),
      _imp_str_literal("6"), _imp_str_literal("7"), _imp_str_literal("8"),
      _imp_str_literal("9"), _imp_str_literal("A"), _imp_str_literal("B"),
      _imp_str_literal("C"), _imp_str_literal("D"), _imp_str_literal("E"),
      _imp_str_literal("F")};
  int I;
  _imp_string Sh;
  Sh = _imp_str_literal("");
  for (I = 1; I <= 8; I++) {
    Sh = _imp_join(H[N & 0xF], Sh);
    N = (unsigned)N >> 4;
  }
  return (Sh);
}
void Fault(_imp_string Mess) {
  Printstring(_imp_join(_imp_str_literal("*  "),
                        _imp_join(Mess, _imp_str_literal("\n\n"))));
// Would love to recover the last source line printed to the listing file as well!
fprintf(stderr, "*  %s\n\n", _imp_cstr_safe(&Mess));
  Faults++;
}
void Dump(_imp_string Opn, _imp_string Reg, _imp_string Base, int Disp) {
  Printstring(_imp_join(
      Strint(Nextcad, 5),
      _imp_join(
          _imp_str_literal("$          "),
          _imp_join(
              Opn, _imp_join(
                       _imp_str_literal(","),
                       _imp_join(
                           Reg, _imp_join(
                                    _imp_str_literal(","),
                                    _imp_join(
                                        Base,
                                        _imp_join(_imp_str_literal(","),
                                                  _imp_join(Strint(Disp, 1),
                                                            _imp_str_literal(
                                                                "\n")))))))))));
  if (_imp_strcmp(Opn, _imp_str_literal("FILL")) != 0) Nextcad++;
}
_imp_string Name(int Ident) {
  if (0 > Ident || Ident > 255 || Namedlink[Ident] == 0)
    return (_imp_str_literal(""));
  return (*String(Addr(Named[Namedlink[Ident]])));
}
int Newtag(void) {
  int I;
  if (!Tagasl) {
    Fault(_imp_str_literal("TAG SPACE FULL"));
    exit(0);
  }
  I = Tagasl;
  Tagasl = Link[Tagasl];
  return (I);
}
int Returntag(int Tagi) {
  int L;
  L = Link[Tagi];
  Link[Tagi] = Tagasl;
  Tagasl = Tagi;
  return (L);
}
int Getwork(void) {
  int *Cell;
  Cell = &Worklist[Level];
  while (*Cell) {
    if (Tag[*Cell] < 0) {
      Tag[*Cell] = -Tag[*Cell];
      return (Tag[*Cell]);
    }
    Cell = &Link[*Cell];
  }
  *Cell = Newtag();
  Tag[*Cell] = Nextrad[Level];
  Nextrad[Level] = Nextrad[Level] + 1;
  Link[*Cell] = 0;
  return (Tag[*Cell]);
}
void Returnwork(int Work) {
  int Cell;
  Cell = Worklist[Level];
  while (Cell) {
    if (Tag[Cell] == Work) {
      Tag[Cell] = -Work;
      return;
    }
    Cell = Link[Cell];
  }
}
void Clearwork(void) {
  int Cell;
  Cell = Worklist[Level];
  while (Cell) Cell = Returntag(Cell);
  Worklist[Level] = 0;
}
int Getcoti(int Const) {
  int Coti;
  if (Cotp > 0)
    for (Coti = 0; Coti <= Cotp - 1; Coti++)
      if (Cot[Coti] == Const) return (Coti);
  if (Cotp == MAX_CONST_TABLE) {
    Fault(_imp_str_literal("CONSTANT TABLE FULL"));
    exit(0);
  }
  Cot[Cotp] = Const;
  Cotp++;
  return (Cotp - 1);
}
void Pushtag(int Ident, int Form, int Type, int Dim, int Level, int Rad) {
  int Tagi;

  if ((((unsigned)Tag[Taglink[Ident]] >> 28) & 0x8) == 8) {
    // This is a procedure spec.
    Tag[Taglink[Ident]] &= ~(8<<28); // remove the spec.
    // QUICK & DIRTY HACK FOR NOW.
    return;
  }
  
  if (Taglink[Ident] != 0 &&
      ((unsigned)Tag[Taglink[Ident]] >> 16 & 0xF) == Level)
    Fault(
        _imp_join(_imp_str_literal("NAME "),
                  _imp_join(Name(Ident), _imp_str_literal(" DECLARED TWICE"))));
  Tagi = Newtag();
  Tag[Tagi] = Form << 28 | Type << 24 | Dim << 20 | Level << 16 | Rad;
  Link[Tagi] = Taglink[Ident];
  Taglink[Ident] = Tagi;
  Tagi = Newtag();
  Tag[Tagi] = Ident;
  Link[Tagi] = Namelist[Level];
  Namelist[Level] = Tagi;
}
void Poptags(void) {
  int Cell;
  int Ident;
  int Nametag;
  int Params;
  _imp_string S;
  if (Tagsopt == 1) Newline();
  Cell = Namelist[Level];
  while (Cell) {
    Ident = Tag[Cell];
    Cell = Returntag(Cell);
    Nametag = Tag[Taglink[Ident]];
    Taglink[Ident] = Returntag(Taglink[Ident]);
    if (Tagsopt == 1) {
      S = Name(Ident);
      Printstring(
          _imp_join(Strint(Ident, 3), _imp_join(_imp_str_literal("   "), S)));
      Spaces(10 - *Length(S));
      Printstring(Strhex(Nametag));
    }
    if ((((unsigned)Nametag >> 28)&7) == 4) {
      Params = (unsigned)Nametag >> 20 & 0xF;
      while (Params) {
        if (Tagsopt == 1)
          Printstring(
              _imp_join(_imp_str_literal("   "), Strhex(Tag[Taglink[Ident]])));
        Taglink[Ident] = Returntag(Taglink[Ident]);
        Params--;
      }
    }
    if (Tagsopt == 1) Newline();
    if (!Taglink[Ident]) {
      Namedp = Namedlink[Ident];
      Namedlink[Ident] = 0;
    }
  }
  if (Tagsopt == 1) Newline();
  Namelist[Level] = 0;
}
int Getlabel(int Constp) {
  int Label;
  Label = A[Constp + 1];
  if (Label > 9999) {
    Fault(
        _imp_join(_imp_str_literal("LABEL "),
                  _imp_join(Strint(Label, 1), _imp_str_literal(" TOO LARGE"))));
    return (-1);
  } else
    return (Label);
}
void Filllabel(int Label) {
  int Cell;
  if (Label < 0) return;
  Cell = Branchlist[Level];
  while (Cell) {
    if ((unsigned)Tag[Cell] >> 16 == Label) {
      if (!(Tag[Cell] & 0x8000))
        Fault(
            _imp_join(_imp_str_literal("DUPLICATE LABEL "), Strint(Label, 1)));
      else {
        Dump(_imp_str_literal("FILL"), Strint(Label, 1),
             Strint(Tag[Cell] & 0x7FFF, 1), Nextcad);
        Tag[Cell] = Label << 16 | Nextcad;
      }
      return;
    }
    Cell = Link[Cell];
  }
  Cell = Newtag();
  Link[Cell] = Branchlist[Level];
  Branchlist[Level] = Cell;
  Tag[Cell] = Label << 16 | Nextcad;
}
int Fillbranch(int Label) {
  int Cell;
  int Cad;
  if (Label < 0) return (0);
  Cell = Branchlist[Level];
  while (Cell) {
    if ((unsigned)Tag[Cell] >> 16 == Label) {
      Cad = Tag[Cell] & 0x7FFF;
      if (Tag[Cell] & 0x8000) Tag[Cell] = Label << 16 | 0x8000 | Nextcad;
      return (Cad);
    }
    Cell = Link[Cell];
  }
  Cell = Newtag();
  Link[Cell] = Branchlist[Level];
  Branchlist[Level] = Cell;
  Tag[Cell] = Label << 16 | 0x8000 | Nextcad;
  return (0);
}
void Poplabels(void) {
  int Cell;
  Cell = Branchlist[Level];
  while (Cell) {
    if (Tag[Cell] & 0x8000)
      Fault(_imp_join(
          _imp_str_literal("LABEL "),
          _imp_join(Strint((unsigned)Tag[Cell] >> 16, 1),
                    _imp_join(_imp_str_literal(" NOT SET (BRANCH LIST "),
                              _imp_join(Strint(Tag[Cell] & 0x7FFF, 1),
                                        _imp_str_literal(")"))))));
    Cell = Returntag(Cell);
  }
  Branchlist[Level] = 0;
}
int Nextplabel(void) {     // labels >= 10000 are temporary tags for forward jumps, to be filled in by FILL later.  (16 bits)
  static int Plabel = 9999;
  Plabel++;
  return (Plabel);
}
void Pushstart(int Flag, int Plab) {
  int Cell;
  Cell = Newtag();
  Tag[Cell] = (Flag << 16) | (Plab & 0xFFFF);
  Link[Cell] = Startlist[Level];
  Startlist[Level] = Cell;
}
void Popstart(int *Flag, int *Plab) {
  int Cell;
  Cell = Startlist[Level];
  if (!Cell) {
    Fault(_imp_str_literal("SPURIOUS %FINISH"));
    *Flag = 0;
    *Plab = 0;
  } else {
    *Flag = (unsigned)Tag[Cell] >> 16;
    *Plab = Tag[Cell] & 0xFFFF;
    if (*Plab == 0xFFFF) *Plab = -1;
    Startlist[Level] = Returntag(Cell);
  }
}
void Clearstart(void) {
  int Cell;
  Cell = Startlist[Level];
  while (Cell) {
    Fault(_imp_str_literal("%FINISH MISSING"));
    Cell = Returntag(Cell);
  }
  Startlist[Level] = 0;
}
int Enter(void) {
  _imp_string Base;
  int Cad;
  if (Level == 1) {
    if (Nextcad) Fault(_imp_str_literal("%BEGIN NOT FIRST STATEMENT"));
    Dump(_imp_str_literal("LDA"), _imp_str_literal("COT"), _imp_str_literal(""),
         0);
    Dump(_imp_str_literal("LDA"), _imp_str_literal("DR1"), _imp_str_literal(""),
         0);
    Base = _imp_str_literal("DR1");
  } else {
    Dump(_imp_str_literal("STR"), Display[Level], _imp_str_literal("STP"), 0);
    Dump(_imp_str_literal("LDA"), Display[Level], _imp_str_literal("STP"), 0);
    Dump(_imp_str_literal("STR"), _imp_str_literal("WK"),
         _imp_str_literal("STP"), 1);
    Base = _imp_str_literal("STP");
  }
  Cad = Nextcad;
  Dump(_imp_str_literal("LDA"), _imp_str_literal("STP"), Base, 0);
  Nextrad[Level] = 2;
  return (Cad);
}
void Dumpreturn(void) {
  Dump(_imp_str_literal("LDA"), _imp_str_literal("STP"), Display[Level], 0);
  Dump(_imp_str_literal("LOAD"), Display[Level], _imp_str_literal("STP"), 0);
  Dump(_imp_str_literal("LOAD"), _imp_str_literal("WK"),
       _imp_str_literal("STP"), 1);
  Dump(_imp_str_literal("B"), _imp_str_literal(""), _imp_str_literal("WK"), 0);
}
void Array(int Arrayp) {
  int Namep;
  int Actualp;
  int Exprp;
  int Exprsp;
  int Ident;
  int Nametag;
  Namep = A[Arrayp + 1];
  Actualp = A[Arrayp + 2];
  Ident = A[Namep + 1];
  if (A[Actualp] == 1) {
    Exprp = A[Actualp + 1];
    Exprsp = A[Actualp + 2];
    Expr(Exprp);
    Nametag = Tag[Taglink[Ident]];
    Dump(_imp_str_literal("ADD"), _imp_str_literal("ACC"),
         Display[(unsigned)Nametag >> 16 & 0xF], Nametag & 0xFFFF);
    if (A[Exprsp] == 1)
      Fault(_imp_join(
          _imp_str_literal("ARRAY "),
          _imp_join(Name(Ident), _imp_str_literal(" HAS EXTRA INDEX"))));
  } else
    Fault(_imp_join(_imp_str_literal("ARRAY "),
                    _imp_join(Name(Ident), _imp_str_literal(" HAS NO INDEX"))));
}
void Proc(int Procp) {
  _imp_string Opn;
  _imp_string Base;
  int Namep;
  int Ident;
  int Nametag;
  int Ptagl;
  int L;
  int Actualp;
  int Exprp;
  int Unaryp;
  int Operandp;
  int Npars;
  int Ptag;
  int Pnamep;
  int Pident;
  int Pnametag;
  int Pactualp;
  int Disp;
  int Exprrestp;
  int Exprsp;
  int Oldparams;
  if (Params > 2)
    Dump(_imp_str_literal("LDA"), _imp_str_literal("STP"),
         _imp_str_literal("STP"), Params);
  Oldparams = Params;
  Params = 2;
  Namep = A[Procp + 1];
  Actualp = A[Procp + 2];
  Ident = A[Namep + 1];
  L = Taglink[Ident];
  Nametag = Tag[L];
  Ptagl = Link[L];
  Npars = (unsigned)Nametag >> 20 & 0xF;
  if (!Npars) {
    if (A[Actualp] == 1) {
      Fault(_imp_join(Name(Ident), _imp_str_literal(" HAS PARAMETERS")));
      return;
    }
  } else {
    if (A[Actualp] == 2) {
      Fault(_imp_join(Name(Ident), _imp_str_literal(" MISSING PARAMETERS")));
      return;
    }
    Exprp = A[Actualp + 1];
    Exprsp = A[Actualp + 2];
    for (;;) {
      Ptag = Tag[Ptagl];
      // This didn't help:    if (!(((unsigned)Ptag >> 28)&7))
      if (!((unsigned)Ptag >> 28))
        Expr(Exprp);
      else {
        Unaryp = A[Exprp + 1];
        Operandp = A[Exprp + 2];
        Exprrestp = A[Exprp + 3];
        if (A[Unaryp] != 4 || A[Operandp] != 1 || A[Exprrestp] != 2)
          Fault(_imp_str_literal("NOT A %NAME PARAMETER"));
        else {
          Pnamep = A[Operandp + 1];
          Pactualp = A[Operandp + 2];
          Pident = A[Pnamep + 1];
          if (!Taglink[Pident])
            Fault(_imp_join(Name(Pident), _imp_str_literal(" NOT DECLARED")));
          else {
            Pnametag = Tag[Taglink[Pident]];
            //if ((((unsigned)Pnametag >> 28)&7) == 4)
            if ((unsigned)Pnametag >> 28 == 4)
              Fault(_imp_join(Name(Pident), _imp_str_literal(" NOT A %NAME")));
            else {
              Base = Display[(unsigned)Pnametag >> 16 & 0xF];
              Disp = Pnametag & 0xFFFF;
              if ((unsigned)Ptag >> 28 == 1)
                if ((((unsigned)Pnametag >> 28)&7) >= 2)
                  Array(Operandp);
                else {
                  if ((((unsigned)Pnametag >> 28)&7) == 1)
                    Opn = _imp_str_literal("LOAD");
                  else
                    Opn = _imp_str_literal("LDA");
                  Dump(Opn, _imp_str_literal("ACC"), Base, Disp);
                  if (A[Pactualp] == 1)
                    Fault(_imp_join(Name(Pident),
                                    _imp_str_literal(" DECLARED AS SCALAR")));
                }
              else {
                Dump(_imp_str_literal("LOAD"), _imp_str_literal("ACC"), Base,
                     Disp);
                if (A[Pactualp] == 1)
                  Fault(_imp_join(
                      _imp_str_literal("%ARRAYNAME "),
                      _imp_join(Name(Pident), _imp_str_literal(" HAS INDEX"))));
              }
            }
          }
        }
      }
      Dump(_imp_str_literal("STR"), _imp_str_literal("ACC"),
           _imp_str_literal("STP"), Params);
      Params++;
      Npars--;
      if (!Npars) {
        if (A[Exprsp] == 1)
          Fault(_imp_join(Name(Ident),
                          _imp_str_literal(" HAS EXTRA PARAMETERS")));
        break;
      }
      Ptagl = Link[Ptagl];
      if (A[Exprsp] == 2) {
        Fault(
            _imp_join(Name(Ident), _imp_str_literal(" IS MISSING PARAMETERS")));
        break;
      }
      Exprp = A[Exprsp + 1];
      Exprsp = A[Exprsp + 2];
    }
  }
  if (!((unsigned)Nametag >> 16 & 0xF))
    Base = _imp_str_literal("EXT");
  else
    Base = _imp_str_literal("");
  Dump(_imp_str_literal("BAL"), _imp_str_literal("WK"), Base, Nametag & 0xFFFF);  // IF WE HAVE ONLY SEEN THE %SPEC THIS NEEDS A PATCH
  Params = Oldparams;
  if (Params > 2)
    Dump(_imp_str_literal("SUB"), _imp_str_literal("STP"),
         _imp_str_literal("COT"), Getcoti(Params));
}
void Endofprog(void) {
  int I;
  Dump(_imp_str_literal("FILL"), _imp_str_literal("COT"), _imp_str_literal("0"),
       Nextcad);
  I = 0;
  while (I < Cotp) {
    Dump(_imp_str_literal("CONST"), _imp_str_literal(""), _imp_str_literal(""),
         Cot[I]);
    I++;
  }
  Dump(_imp_str_literal("FILL"), _imp_str_literal("STACK"),
       _imp_str_literal("1"), Nextcad);
  Printstring(_imp_join(_imp_str_literal("\n     $"), _imp_join(Strint(Faults, 4), _imp_str_literal(" FAULTS IN PROGRAM\n"))));
  fprintf(stderr, "%0d FAULTS IN PROGRAM\n", Faults);
  exit(Faults);
}