// cc -c skimpbs.c -I /home/gtoal/src/compilers101/new-parser/imps
/*
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 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]
void Expr(int Exprp);
int Cond(int Condp, int Tlabel, int Flabel);
_imp_string Strint(int N, int P);
int Getwork(void);
void Returnwork(int Work);
void Clearwork(void);
int Newtag(void);
void Pushtag(int Ident, int Form, int Type, int Dim, int Level, int Rad);
void Poptags(void);
int Getlabel(int Constp);
void Filllabel(int Label);
int Fillbranch(int Label);
void Poplabels(void);
int Nextplabel(void);
void Dump(_imp_string Opn, _imp_string Reg, _imp_string Base, int Disp);
void Fault(_imp_string Mess);
_imp_string Name(int Ident);
void Pushstart(int Flag, int Plab);
void Popstart(int *Flag, int *Plab);
void Clearstart(void);
int Enter(void);
void Dumpreturn(void);
void Proc(int Procp);
void Array(int Arrayp);
void Endofprog(void);
int Nextrad[16 /*0:15*/];
_imp_string Display[16 /*0:15*/] = {
    _imp_str_literal("DR0"),  _imp_str_literal("DR1"),
    _imp_str_literal("DR2"),  _imp_str_literal("DR3"),
    _imp_str_literal("DR4"),  _imp_str_literal("DR5"),
    _imp_str_literal("DR6"),  _imp_str_literal("DR7"),
    _imp_str_literal("DR8"),  _imp_str_literal("DR9"),
    _imp_str_literal("DR10"), _imp_str_literal("DR11"),
    _imp_str_literal("DR12"), _imp_str_literal("DR13"),
    _imp_str_literal("DR14"), _imp_str_literal("DR15")};
int Level;
int Nextcad;
static int Proctype[16 /*0:15*/];
static int Staticalloc[16 /*0:15*/];
static int Skipproc[16 /*0:15*/];
//void Statement(int Statementp) {
void SS(int Statementp) {
  auto void Instr(int Instrp);
  static int Sttype_sw;
  static void *Sttype[8 /*1:8*/] = {
      &&Sttype_1, &&Sttype_2, &&Sttype_3, &&Sttype_4,
      &&Sttype_5, &&Sttype_6, &&Sttype_7, &&Sttype_8,
  };
  int Condp;
  int Instrp;
  int Elsep;
  int Constp;
  int Arrayp;
  int Namep;
  int Namesp;
  int Expr1p;
  int Expr2p;
  int Instr2p;
  int Tlabel;
  int Flabel;
  int Label;
  int Fplabel;
  int Tplabel;
  int Work1;
  int Work2;
  int Flag;
  int Plabel;
  int Procp;
  int Specp; // ADDED GT:
  int Formalp;
  int Formp;
  int Params;
  int Procid;
  int Ident;
  int Form;
  int Paramt;
  int Paraml;
  int Dim;
  if (A[Statementp] < 1 || A[Statementp] > 8) {
    fprintf(stderr, "%%SWITCH STTYPE(%d) OUT OF BOUNDS in %s at line %d\nStatementp = %d\n\n", A[Statementp], __FILE__, __LINE__+3, Statementp);
    exit(1); // should %signal
  }
  goto *Sttype[Sttype_sw = (A[Statementp]) - 1]; // Should also be caught by -fbounds-check
Sttype_1:;
  Instr(A[Statementp + 1]);
  return;
Sttype_2:;
  Condp = A[Statementp + 1];
  Instrp = A[Statementp + 2];
  Elsep = A[Statementp + 3];
  if (A[Instrp] == 2) {
    Constp = A[Instrp + 1];
    Tlabel = Getlabel(Constp);
    if (A[Elsep] == 2)
      Filllabel(Cond(Condp, Tlabel, -1));
    else {
      Instrp = A[Elsep + 1];
      if (A[Instrp] == 2) {
        Constp = A[Instrp + 1];
        Flabel = Getlabel(Constp);
        Filllabel(Cond(Condp, Tlabel, Flabel));
        Dump(_imp_str_literal("B"), _imp_str_literal(""), _imp_str_literal(""),
             Fillbranch(Flabel));
      } else {
        Filllabel(Cond(Condp, Tlabel, -1));
        if (A[Instrp] == 3)
          Pushstart(1, -1);
        else
          Instr(Instrp);
      }
    }
  } else if (A[Elsep] == 2) {
    Fplabel = Cond(Condp, -1, -1);
    if (A[Instrp] == 3)
      Pushstart(0, Fplabel);
    else {
      Instr(Instrp);
      Filllabel(Fplabel);
    }
  } else {
    Instr2p = A[Elsep + 1];
    if (A[Instr2p] == 2) {
      Constp = A[Instr2p + 1];
      Fplabel = Cond(Condp, -1, Getlabel(Constp));
      Instr(Instrp);
    } else {
      Fplabel = Cond(Condp, -1, -1);
      Instr(Instrp);
      Tplabel = Nextplabel();
      Dump(_imp_str_literal("B"), _imp_str_literal(""), _imp_str_literal(""),
           Fillbranch(Tplabel));
      Filllabel(Fplabel);
      if (A[Instr2p] == 3)
        Pushstart(1, Tplabel);
      else {
        Instr(Instr2p);
        Filllabel(Tplabel);
      }
    }
  }
  return;
Sttype_3:;
  Constp = A[Statementp + 1];
  Statementp = A[Statementp + 2];
  Label = Getlabel(Constp);
  Filllabel(Label);
//  Statement(Statementp);
  SS(Statementp);
  return;
Sttype_4:;
  Elsep = A[Statementp + 1];
  Popstart(&Flag, &Plabel);
  if (!Flag)
    if (A[Elsep] == 1) {
      Instrp = A[Elsep + 1];
      Tplabel = Nextplabel();
      Dump(_imp_str_literal("B"), _imp_str_literal(""), _imp_str_literal(""),
           Fillbranch(Tplabel));
      Filllabel(Plabel);
      if (A[Instrp] == 3)
        Pushstart(1, Tplabel);
      else {
        Instr(Instrp);
        Filllabel(Tplabel);
      }
    } else
      Filllabel(Plabel);
  else if (A[Elsep] == 1)
    Fault(_imp_str_literal("SPURIOUS %ELSE"));
  else
    Filllabel(Plabel);
  return;
Sttype_5:;
  Arrayp = A[Statementp + 1];
  Namep = A[Arrayp + 1];
  Namesp = A[Arrayp + 2];
  if (A[Arrayp] == 1) {
    Expr1p = A[Arrayp + 3];
    Expr2p = A[Arrayp + 4];
    Expr(Expr1p);
    Work1 = Getwork();
    Dump(_imp_str_literal("STR"), _imp_str_literal("ACC"), Display[Level],
         Work1);
    Expr(Expr2p);
    Dump(_imp_str_literal("LDA"), _imp_str_literal("ACC"),
         _imp_str_literal("ACC"), 1);
    Work2 = Getwork();
    Dump(_imp_str_literal("STR"), _imp_str_literal("ACC"), Display[Level],
         Work2);
    for (;;) {
      Pushtag(A[Namep + 1], 2, 1, 1, Level, Nextrad[Level]);
      Dump(_imp_str_literal("SUB"), _imp_str_literal("STP"), Display[Level],
           Work1);
      Dump(_imp_str_literal("STR"), _imp_str_literal("STP"), Display[Level],
           Nextrad[Level]);
      Dump(_imp_str_literal("ADD"), _imp_str_literal("STP"), Display[Level],
           Work2);
      Nextrad[Level] = Nextrad[Level] + 1;
      if (A[Namesp] == 2) break;
      Namep = A[Namesp + 1];
      Namesp = A[Namesp + 2];
    }
    Returnwork(Work1);
    Returnwork(Work2);
  } else
    for (;;) {
      Pushtag(A[Namep + 1], 0, 1, 0, Level, Nextrad[Level]);
      Nextrad[Level] = Nextrad[Level] + 1;
      if (A[Namesp] == 2) break;
      Namep = A[Namesp + 1];
      Namesp = A[Namesp + 2];
    }
  return;
  
 Sttype_6:; // <proc><name><formal> changing to <proc><spec><name><formal>
  if (!Level) Fault(_imp_str_literal("PROCEDURE BEFORE %BEGIN"));
  if (Level == 15) Fault(_imp_str_literal("PROCEDURE NESTING TOO DEEP"));
  Procp = A[Statementp + 1];
  
  Specp = A[Statementp + 2];
  Specp = A[Specp]; // 1: SPEC  2: NO SPEC
  if (Specp == 1) { ///////////////////////////////////////////////// SPEC

    // This is the code to handle only the spec.
    
    Namep = A[Statementp + 3/*2*/];
    Formalp = A[Statementp + 4/*3*/];
    Procid = A[Namep + 1];
    Skipproc[Level] = Nextcad;

    // 4 is a procedure.  We could add 8 to form for use as a spec.
    // It would have to be handled both at the point of call and at
    // the body declaration, and calls would require a FILL chain to
    // insert the actual body address.

    void PushtagSpec(int Ident, int Form, int Type, int Dim, int Level, int Rad) {
      int Tagi;
      Tagi = Newtag();
      Tag[Tagi] = (Form|8) << 28 | Type << 24 | Dim << 20 | Level << 16 | Rad;
      Link[Tagi] = Taglink[Ident];
      Taglink[Ident] = Tagi;
      Tagi = Newtag();
      Tag[Tagi] = Ident;
      Link[Tagi] = -1 /*Namelist[Level]*/; //skimpds: static int Namelist[16 /*0:15*/]
      //Namelist[Level] = Tagi;
    }

    PushtagSpec(Procid, 4, A[Procp] - 1, 0, Level, Nextcad);
    // Pushtag is where NAMED DECLARED TWICE will be faulted.
    // I suspect multiple %SPECs are allowed.
    // The first spec won't be faulted but currently, the actual
    // procedure declaration will be.

    Level++;
    Proctype[Level] = A[Procp];
    Staticalloc[Level] = Nextcad;
    Nextrad[Level] = 2;
    if (A[Formalp] == 2) {
      // If we're treating it like a real declaration, calling the same code
      // here as is called at the procedure's %END will be easier than
      // cutting down the code that's done at the start of the procedure body.
      Poptags();
      Poplabels();
      Clearstart();
      Clearwork();
      Level--;
      return;
    }
    Params = 0;
    Paraml = Taglink[Procid];
    do {
      Formp = A[Formalp + 1];
      Namep = A[Formalp + 2];
      Namesp = A[Formalp + 3];
      Formalp = A[Formalp + 4];
      if (A[Formp] == 1) {
        Form = 3;
        Dim = 1;
      } else {
        if (A[Formp] == 2)
          Form = 1;
        else
          Form = 0;
        Dim = 0;
      }
      for (;;) {
        Ident = A[Namep + 1];
        // This declares the parameter variables local to the
        // scope of the procedure.  Easiest solution is to just
        // let it happen and then %END the procedure.
        Pushtag(Ident, Form, 1, Dim, Level, Nextrad[Level]);
        Nextrad[Level] = Nextrad[Level] + 1;
        Paramt = Newtag();
        Tag[Paramt] = Tag[Taglink[Ident]];
        Link[Paramt] = Link[Paraml];
        Link[Paraml] = Paramt;
        Paraml = Paramt;
        Params++;
        if (Params > 15) {
          Fault(_imp_join(Name(Procid),
                          _imp_str_literal(" HAS TOO MANY PARAMETERS")));
          exit(0);
        }
        if (A[Namesp] == 2) break;
        Namep = A[Namesp + 1];
        Namesp = A[Namesp + 2];
      }
    } while (A[Formalp] != 2);
    Tag[Taglink[Procid]] = Tag[Taglink[Procid]] | Params << 20;

    // If we're treating the spec as if it were an actual procedure
    // declaration, calling the same code here as is called at the
    // procedure's %END will be easier than a major restructuring to
    // handle SPECs properly.
  
    Poptags();
    Poplabels();
    Clearstart();
    Clearwork();
    Level--;
  
   // end of declaration of procedure spec

  } else {     ////////////////////////////////////////////////////// BODY

  Namep = A[Statementp + 3/*2*/];
  Formalp = A[Statementp + 4/*3*/];
  Procid = A[Namep + 1];
  Skipproc[Level] = Nextcad;
  Dump(_imp_str_literal("B"), _imp_str_literal(""), _imp_str_literal(""), 0);

  // Pushtag is where NAMED DECLARED TWICE will be faulted.
  // If the proc/fn has already be spec'd, we need to fill in
  // and missing details, and avoid complaining about being
  // declared twice.

  // If the previous declaration was actually a %SPEC then we
  // need to match the number and type of the parameters but
  // not the names.  The new names must be entered instead!
  
  Pushtag(Procid, 4, A[Procp] - 1, 0, Level, Nextcad);

  Level++;
  Proctype[Level] = A[Procp];
  Staticalloc[Level] = Enter();
  Nextrad[Level] = 2;
  if (A[Formalp] == 2) return;
  Params = 0;
  Paraml = Taglink[Procid];
  do {
    Formp = A[Formalp + 1];
    Namep = A[Formalp + 2];
    Namesp = A[Formalp + 3];
    Formalp = A[Formalp + 4];
    if (A[Formp] == 1) {
      Form = 3;
      Dim = 1;
    } else {
      if (A[Formp] == 2)
        Form = 1;
      else
        Form = 0;
      Dim = 0;
    }
    for (;;) {
      Ident = A[Namep + 1];
      Pushtag(Ident, Form, 1, Dim, Level, Nextrad[Level]);
      Nextrad[Level] = Nextrad[Level] + 1;
      Paramt = Newtag();
      Tag[Paramt] = Tag[Taglink[Ident]];
      Link[Paramt] = Link[Paraml];
      Link[Paraml] = Paramt;
      Paraml = Paramt;
      Params++;
      if (Params > 15) {
        Fault(_imp_join(Name(Procid),
                        _imp_str_literal(" HAS TOO MANY PARAMETERS")));
        exit(0);
      }
      if (A[Namesp] == 2) break;
      Namep = A[Namesp + 1];
      Namesp = A[Namesp + 2];
    }
  } while (A[Formalp] != 2);
  Tag[Taglink[Procid]] = Tag[Taglink[Procid]] | Params << 20;

  } // end of declaration of actual procedure
  return;
  
Sttype_7:;
  Dump(_imp_str_literal("FILL"), _imp_str_literal("ALLOC"),
       Strint(Staticalloc[Level], 1), Nextrad[Level]);
  Poptags();
  Poplabels();
  Clearstart();
  Clearwork();
  if (Proctype[Level] == 1)
    Dumpreturn();
  else
    Dump(_imp_str_literal("STOP"), _imp_str_literal(""), _imp_str_literal(""),
         0);
  Level--;
  if (A[A[Statementp + 1]] == 2) {
    if (Level <= 0) {
      Fault(_imp_str_literal("SPURIOUS %END"));
      Endofprog();
    }
    Dump(_imp_str_literal("FILL"), _imp_str_literal("SKIP"),
         Strint(Skipproc[Level], 1), Nextcad);
  } else {
    if (Level) Fault(_imp_str_literal("TOO FEW %ENDS"));
    Endofprog();
  }
  return;
Sttype_8:;
//Printstring(_imp_str_literal("ENTERING BEGIN"));
  Newline();
  if (Level)
    Fault(_imp_str_literal("SPURIOUS %BEGIN"));
  else {
    Level = 1;
    Proctype[1] = 0;
    Staticalloc[1] = Enter();
  }
//Printstring(_imp_str_literal("EXITING BEGIN"));
//Newline();
  return;
  void Instr(int Instrp) {
    static int Instype_sw;
    static void *Instype[6 /*1:6*/] = {
        &&Instype_1, &&Instype_2, &&Instype_3,
        &&Instype_4, &&Instype_5, &&Instype_6,
    };
    _imp_string Base;
    int Namep;
    int Assignp;
    int Constp;
    int Ident;
    int Actualp;
    int Exprp;
    int Nametag;
    int Disp;
    int Work;
    if (A[Instrp] < 1 || A[Instrp] > 6) {
      fprintf(stderr, "%%SWITCH INSTYPE(%d) OUT OF BOUNDS in %s at line %d\nInstrp = %d\n\n", A[Instrp], __FILE__, __LINE__+3, Instrp);
      exit(1); // should %signal
    }
    goto *Instype[Instype_sw = (A[Instrp]) - 1];
  Instype_1:; // <NAME><ACTUAL><ASSIGN>
    Namep = A[Instrp + 1];
    Actualp = A[Instrp + 2];
    Assignp = A[Instrp + 3];
    Ident = A[Namep + 1];
    if (!Taglink[Ident]) {
      Fault(_imp_join(Name(Ident), _imp_str_literal(" NOT DECLARED")));
      return;
    }
    Nametag = Tag[Taglink[Ident]];
    if (A[Assignp] == 1) {
      if ((((unsigned)Nametag >> 28)&7) == 4) {
        Fault(_imp_join(Name(Ident), _imp_str_literal(" NOT A DESTINATION")));
        return;
      }
      Exprp = A[Assignp + 1];
      if ((((unsigned)Nametag >> 28)&7) >= 2) {
        Expr(Exprp);
        Work = Getwork();
        Dump(_imp_str_literal("STR"), _imp_str_literal("ACC"), Display[Level],
             Work);
        Array(Instrp);
        Dump(_imp_str_literal("LOAD"), _imp_str_literal("WK"), Display[Level],
             Work);
        Dump(_imp_str_literal("STR"), _imp_str_literal("WK"),
             _imp_str_literal("ACC"), 0);
        Returnwork(Work);
      } else {
        Expr(Exprp);
        Base = Display[(unsigned)Nametag >> 16 & 0xF];
        Disp = Nametag & 0xFFFF;
        if ((((unsigned)Nametag >> 28)&7) == 1) {
          Dump(_imp_str_literal("LOAD"), _imp_str_literal("WK"), Base, Disp);
          Dump(_imp_str_literal("STR"), _imp_str_literal("ACC"),
               _imp_str_literal("WK"), 0);
        } else
          Dump(_imp_str_literal("STR"), _imp_str_literal("ACC"), Base, Disp);
        if (A[Actualp] == 1)
          Fault(
              _imp_join(Name(Ident), _imp_str_literal(" DECLARED AS SCALAR")));
      }
    } else if ((((unsigned)Nametag >> 28)&7) == 4 &&
               ((unsigned)Nametag >> 24 & 0xF) == 0)
      Proc(Instrp);
    else
      Fault(_imp_join(Name(Ident), _imp_str_literal(" NOT A ROUTINE NAME")));
    return;
  Instype_2:; // '->'<CONST>
    Constp = A[Instrp + 1];
    Label = Getlabel(Constp);
    Dump(_imp_str_literal("B"), _imp_str_literal(""), _imp_str_literal(""),
         Fillbranch(Label));
    return;
  Instype_3:; // "START"
    Fault(_imp_str_literal("ILLEGAL %START"));
    return;
  Instype_4:; // "RETURN"
    if (Proctype[Level] != 1) Fault(_imp_str_literal("%RETURN OUT OF CONTEXT"));
    Dumpreturn();
    return;
  Instype_5:; // "RESULT"'='<EXPR>
    if (Proctype[Level] != 2) Fault(_imp_str_literal("%RESULT OUT OF CONTEXT"));
    Expr(A[Instrp + 1]);
    Dumpreturn();
    return;
  Instype_6:; // "STOP"
    Dump(_imp_str_literal("STOP"), _imp_str_literal(""), _imp_str_literal(""),
         0);
  }
}