M2compiler-V1/SymTab.mod

IMPLEMENTATION MODULE SymTab;

IMPORT FileIO;

CONST
  MaxTypes  = 256;
  MaxFields = 512;
  MaxPend   = 64;
  MaxMarks  = 16;
  ResDepth  = 64;
  MaxProcs  = 64;
  MaxParams = 256;
  MaxPDepth = 16;
  NoSlot    = -1000;

  (* descriptor forms *)
  FNone = 0; FAlias = 1; FSub = 2; FEnum = 3; FArray = 4;
  FRecord = 5; FSet = 6; FPtr = 7; FStr = 8;
  FInt = 9; FReal = 10; FChar = 11; FBool = 12;

TYPE
  Symbol = RECORD
    name : Name;
    kind : INTEGER;
    typ  : TypeIndex;
    lev  : CARDINAL;
    slot : INTEGER;    (* frame slot (params >= 3, locals negative) *)
    pdep : CARDINAL;   (* proc depth at declaration *)
    pnum : INTEGER;    (* proc number (0 = not a procedure) *)
  END;
  Field = RECORD
    name  : Name;
    typ   : TypeIndex;
    owner : TypeIndex;
    next  : INTEGER;  (* index of next field of same owner, -1 = end *)
    off   : INTEGER;  (* slot offset within record, -1 = not yet fixed *)
  END;
  ProcRec = RECORD
    ret     : TypeIndex;  (* InvalidType = proper procedure *)
    fret    : TypeIndex;  (* forward heading return type *)
    fwd     : BOOLEAN;    (* body still pending *)
    everFwd : BOOLEAN;    (* had a forward heading *)
    fHead   : INTEGER;    (* forward param list *)
    fTail   : INTEGER;
    dHead   : INTEGER;    (* define param list *)
    dTail   : INTEGER;
  END;
  ParamRec = RECORD
    typ   : TypeIndex;
    isVar : BOOLEAN;
    next  : INTEGER;
  END;

VAR
  syms : ARRAY [0 .. MaxSyms - 1] OF Symbol;
  nSyms : CARDINAL;
  curLev : CARDINAL;
  marks : ARRAY [0 .. MaxMarks - 1] OF CARDINAL;
  mtop : CARDINAL;
  pend : ARRAY [0 .. MaxPend - 1] OF CARDINAL;
  nPend : CARDINAL;
  pendF : ARRAY [0 .. MaxPend - 1] OF CARDINAL;
  nPendF : CARDINAL;
  tform : ARRAY [0 .. MaxTypes - 1] OF INTEGER;
  tref : ARRAY [0 .. MaxTypes - 1] OF TypeIndex;
  tLo : ARRAY [0 .. MaxTypes - 1] OF INTEGER;
  tHi : ARRAY [0 .. MaxTypes - 1] OF INTEGER;
  tNext : ARRAY [0 .. MaxTypes - 1] OF CARDINAL;
  tOpen : ARRAY [0 .. MaxTypes - 1] OF BOOLEAN;
  nTypes : CARDINAL;
  fields : ARRAY [0 .. MaxFields - 1] OF Field;
  nFields : CARDINAL;
  dInt, dCard, dReal, dChar, dBool : TypeIndex;
  procs : ARRAY [1 .. MaxProcs] OF ProcRec;
  nProcs : CARDINAL;
  params : ARRAY [0 .. MaxParams - 1] OF ParamRec;
  nParams : CARDINAL;
  pdep : CARDINAL;
  curProc : INTEGER;
  procSt : ARRAY [0 .. MaxPDepth] OF INTEGER;
  locCnt : ARRAY [0 .. MaxPDepth] OF CARDINAL;
  parCnt : ARRAY [0 .. MaxPDepth] OF CARDINAL;
  retSt : ARRAY [0 .. MaxPDepth] OF TypeIndex;
  modNames : ARRAY [0 .. 7] OF Name;
  modTop : CARDINAL;
  modLevs : ARRAY [0 .. 7] OF CARDINAL;
  modExps : ARRAY [0 .. 7] OF ARRAY [0 .. 31] OF Name;
  modNExps : ARRAY [0 .. 7] OF CARDINAL;
  expMod : ARRAY [0 .. 127] OF Name;
  expName : ARRAY [0 .. 127] OF Name;
  expKindA : ARRAY [0 .. 127] OF INTEGER;
  expTypeA : ARRAY [0 .. 127] OF TypeIndex;
  expProcA : ARRAY [0 .. 127] OF INTEGER;
  nExps : CARDINAL;
  defNames : ARRAY [0 .. 7] OF Name;
  defNSyms : ARRAY [0 .. 7] OF CARDINAL;
  defSyms : ARRAY [0 .. 7] OF ARRAY [0 .. 31] OF Name;
  defKinds : ARRAY [0 .. 7] OF ARRAY [0 .. 31] OF INTEGER;
  defTypes : ARRAY [0 .. 7] OF ARRAY [0 .. 31] OF TypeIndex;
  defPnums : ARRAY [0 .. 7] OF ARRAY [0 .. 31] OF INTEGER;
  defProcLo : ARRAY [0 .. 7] OF CARDINAL;
  defProcHi : ARRAY [0 .. 7] OF CARDINAL;
  nDefs : CARDINAL;
  defMark : CARDINAL;
  curDef : INTEGER;
  impNames : ARRAY [0 .. 63] OF Name;
  impQuals : ARRAY [0 .. 63] OF Name;
  nImps : CARDINAL;
  progDone : BOOLEAN;

(* ---------------- strings ---------------- *)

PROCEDURE Assign (VAR dest: ARRAY OF CHAR; src: ARRAY OF CHAR);
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE (i < HIGH(dest)) & (src[i] # 0C) DO
      dest[i] := src[i]; INC(i)
    END;
    dest[i] := 0C
  END Assign;

PROCEDURE Equal (a, b: ARRAY OF CHAR): BOOLEAN;
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    LOOP
      IF a[i] # b[i] THEN RETURN FALSE END;
      IF a[i] = 0C THEN RETURN TRUE END;
      INC(i)
    END
  END Equal;

PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE (i < HIGH(s)) & (s[i] # 0C) DO INC(i) END;
    RETURN i
  END StrLen;

(* ---------------- symbols and scopes ---------------- *)

PROCEDURE Find (name: ARRAY OF CHAR): INTEGER;
(* innermost visible index or -1 *)
  VAR i : CARDINAL;
  BEGIN
    i := nSyms;
    WHILE i > 0 DO
      DEC(i);
      IF Equal(syms[i].name, name) THEN RETURN VAL(INTEGER, i) END
    END;
    RETURN -1
  END Find;

PROCEDURE RawEnter (name: ARRAY OF CHAR; kind: INTEGER): INTEGER;
(* index or -1 when full *)
  BEGIN
    IF nSyms >= MaxSyms THEN RETURN -1 END;
    Assign(syms[nSyms].name, name);
    syms[nSyms].kind := kind;
    syms[nSyms].typ := InvalidType;
    syms[nSyms].lev := curLev;
    syms[nSyms].slot := NoSlot;
    syms[nSyms].pdep := pdep;
    syms[nSyms].pnum := 0;
    IF (kind = KindVar) & (pdep > 0) THEN
      syms[nSyms].slot := -(1 + VAL(INTEGER, locCnt[pdep]));
      INC(locCnt[pdep])
    END;
    INC(nSyms);
    RETURN VAL(INTEGER, nSyms - 1)
  END RawEnter;

PROCEDURE DupInLevel (name: ARRAY OF CHAR): BOOLEAN;
  VAR i : CARDINAL;
  BEGIN
    i := nSyms;
    WHILE (i > 0) & (syms[i - 1].lev = curLev) DO
      DEC(i);
      IF Equal(syms[i].name, name) THEN RETURN TRUE END
    END;
    RETURN FALSE
  END DupInLevel;

PROCEDURE Enter (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
  BEGIN
    IF DupInLevel(name) THEN RETURN FALSE END;
    RETURN RawEnter(name, kind) # -1
  END Enter;

PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
  VAR idx : INTEGER;
  BEGIN
    IF DupInLevel(name) THEN RETURN FALSE END;
    idx := RawEnter(name, kind);
    IF (idx # -1) & (nPend < MaxPend) THEN
      pend[nPend] := VAL(CARDINAL, idx); INC(nPend)
    END;
    RETURN idx # -1
  END EnterPending;

PROCEDURE SlotsDepth (t: TypeIndex; d: CARDINAL): CARDINAL;
(* Size in slots (words); 0 = unsized/needs error, 1 = scalar/placeholder.
   Records use precomputed tNext; arrays use len*elem. Incomplete
   aliases return 1 to suppress cascades. *)
  VAR r : TypeIndex;
    n : CARDINAL;
    e, len : CARDINAL;
    lo, hi, span : INTEGER;
  BEGIN
    IF d > ResDepth THEN RETURN 0 END;
    IF t = InvalidType THEN RETURN 1 END;
    IF (t < 0) OR (t >= VAL(INTEGER, nTypes)) THEN RETURN 1 END;
    r := t; n := 0;
    WHILE (n < ResDepth) & (r >= 0) & (r < VAL(INTEGER, nTypes))
          & (tform[r] = FAlias) DO
      r := tref[r]; INC(n);
      IF r = InvalidType THEN RETURN 1 END
    END;
    IF (r < 0) OR (r >= VAL(INTEGER, nTypes)) THEN RETURN 1 END;
    CASE tform[r] OF
      FInt, FReal, FChar, FBool, FEnum, FSub, FSet, FPtr, FStr :
        RETURN 1
    | FArray :
        lo := tLo[r]; hi := tHi[r];
        IF hi < lo THEN RETURN 0 END;
        span := hi - lo + 1;
        IF span <= 0 THEN RETURN 0 END;
        len := VAL(CARDINAL, span);
        e := SlotsDepth(tref[r], d + 1);
        IF e = 0 THEN RETURN 0 END;
        IF (len > 1024) OR (e > 1024) THEN RETURN 0 END;
        IF len * e > 1024 THEN RETURN 0 END;
        IF len * e = 0 THEN RETURN 0 END;
        RETURN len * e
    | FRecord :
        RETURN tNext[r]
    ELSE RETURN 1
    END
  END SlotsDepth;

PROCEDURE FixPending (t: TypeIndex);
  VAR i, k : CARDINAL;
    s : CARDINAL;
    L0 : CARDINAL;
    isLoc : BOOLEAN;
  BEGIN
    s := SlotsDepth(t, 0);
    IF s = 0 THEN s := 1 END;
    isLoc := FALSE;
    IF nPend > 0 THEN
      k := 0;
      WHILE k < nPend DO
        IF syms[pend[k]].pdep > 0 THEN isLoc := TRUE END;
        INC(k)
      END
    END;
    IF isLoc THEN
      L0 := 0;
      IF locCnt[pdep] >= nPend THEN
        L0 := locCnt[pdep] - nPend
      END;
      i := 0;
      WHILE i < nPend DO
        syms[pend[i]].typ := t;
        syms[pend[i]].slot := -(VAL(INTEGER, L0) + VAL(INTEGER, s)
                                 * (VAL(INTEGER, i) + 1));
        INC(i)
      END;
      locCnt[pdep] := L0 + nPend * s
    ELSE
      i := 0;
      WHILE i < nPend DO
        syms[pend[i]].typ := t; INC(i)
      END
    END;
    nPend := 0
  END FixPending;

PROCEDURE PendCount (): CARDINAL;
  BEGIN
    RETURN nPend
  END PendCount;

PROCEDURE PendName (i: CARDINAL; VAR n: Name);
  BEGIN
    IF i < nPend THEN Assign(n, syms[pend[i]].name)
    ELSE n[0] := 0C
    END
  END PendName;

PROCEDURE FindField (rec: TypeIndex; name: ARRAY OF CHAR): INTEGER;
  VAR i : INTEGER;
  BEGIN
    IF (rec < 0) OR (rec >= VAL(INTEGER, nTypes)) THEN RETURN -1 END;
    IF tform[rec] # FRecord THEN RETURN -1 END;
    i := tref[rec];
    WHILE i # -1 DO
      IF Equal(fields[i].name, name) THEN RETURN i END;
      i := fields[i].next
    END;
    RETURN -1
  END FindField;

PROCEDURE FieldPending (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
  BEGIN
    IF FindField(rec, name) # -1 THEN RETURN FALSE END;
    IF nFields >= MaxFields THEN RETURN FALSE END;
    Assign(fields[nFields].name, name);
    fields[nFields].typ := InvalidType;
    fields[nFields].owner := rec;
    fields[nFields].next := tref[rec];
    fields[nFields].off := -1;
    tref[rec] := VAL(INTEGER, nFields);
    IF nPendF < MaxPend THEN
      pendF[nPendF] := nFields; INC(nPendF)
    END;
    INC(nFields);
    RETURN TRUE
  END FieldPending;

PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
  VAR i, j : CARDINAL;
    s : CARDINAL;
    rr : TypeIndex;
  BEGIN
    s := SlotsDepth(t, 0);
    IF s = 0 THEN s := 1 END;
    rr := rec;
    IF (rr >= 0) & (rr < VAL(INTEGER, nTypes)) & (tform[rr] = FAlias) THEN
      rr := tref[rr]
    END;
    i := 0;
    WHILE i < nPendF DO
      IF fields[pendF[i]].owner = rec THEN
        fields[pendF[i]].typ := t;
        IF (rr >= 0) & (rr < VAL(INTEGER, nTypes))
           & (tform[rr] = FRecord) THEN
          fields[pendF[i]].off := VAL(INTEGER, tNext[rr]);
          tNext[rr] := tNext[rr] + s
        ELSE
          fields[pendF[i]].off := 0
        END;
        (* remove by swap with last *)
        j := nPendF - 1;
        pendF[i] := pendF[j];
        DEC(nPendF)
      ELSE
        INC(i)
      END
    END
  END FixPendingF;

PROCEDURE Lookup (name: ARRAY OF CHAR): BOOLEAN;
  BEGIN
    RETURN Find(name) # -1
  END Lookup;

PROCEDURE SymType (name: ARRAY OF CHAR): TypeIndex;
  VAR idx : INTEGER;
  BEGIN
    idx := Find(name);
    IF idx = -1 THEN RETURN InvalidType END;
    RETURN syms[idx].typ
  END SymType;

PROCEDURE SetSymType (name: ARRAY OF CHAR; t: TypeIndex);
  VAR idx : INTEGER;
  BEGIN
    idx := Find(name);
    IF idx # -1 THEN syms[idx].typ := t END
  END SetSymType;

PROCEDURE SymKind (name: ARRAY OF CHAR): INTEGER;
  VAR idx : INTEGER;
  BEGIN
    idx := Find(name);
    IF idx = -1 THEN RETURN -1 END;
    RETURN syms[idx].kind
  END SymKind;

PROCEDURE PushScope;
  BEGIN
    IF mtop < MaxMarks THEN marks[mtop] := nSyms; INC(mtop) END;
    INC(curLev)
  END PushScope;

PROCEDURE PopScope;
  BEGIN
    IF mtop > 0 THEN DEC(mtop); nSyms := marks[mtop] END;
    IF curLev > 0 THEN DEC(curLev) END
  END PopScope;

PROCEDURE SymLev (name: ARRAY OF CHAR): INTEGER;
  VAR idx : INTEGER;
  BEGIN
    idx := Find(name);
    IF idx = -1 THEN RETURN -1 END;
    RETURN VAL(INTEGER, syms[idx].lev)
  END SymLev;

(* ---------------- local modules ---------------- *)

PROCEDURE EnterModule (name: ARRAY OF CHAR): BOOLEAN;
  BEGIN
    IF DupInLevel(name) THEN RETURN FALSE END;
    IF RawEnter(name, KindModule) = -1 THEN RETURN FALSE END;
    IF modTop > 7 THEN RETURN TRUE END;
    Assign(modNames[modTop], name);
    modNExps[modTop] := 0;
    INC(modTop);
    PushScope;
    modLevs[modTop - 1] := curLev;
    defMark := nProcs;
    RETURN TRUE
  END EnterModule;

PROCEDURE ModuleAddExp (name: ARRAY OF CHAR): BOOLEAN;
  VAR i : CARDINAL;
  BEGIN
    IF modTop = 0 THEN RETURN FALSE END;
    i := 0;
    WHILE i < modNExps[modTop - 1] DO
      IF Equal(modExps[modTop - 1][i], name) THEN RETURN FALSE END;
      INC(i)
    END;
    IF modNExps[modTop - 1] > 31 THEN RETURN FALSE END;
    Assign(modExps[modTop - 1][modNExps[modTop - 1]], name);
    INC(modNExps[modTop - 1]);
    RETURN TRUE
  END ModuleAddExp;

PROCEDURE ExitModule(): BOOLEAN;
  VAR mi, k : CARDINAL;
    idx : INTEGER;
    en : Name;
    ok : BOOLEAN;
  BEGIN
    IF modTop = 0 THEN RETURN TRUE END;
    mi := modTop - 1;
    ok := TRUE;
    k := 0;
    WHILE k < modNExps[mi] DO
      Assign(en, modExps[mi][k]);
      idx := Find(en);
      IF idx = -1 THEN ok := FALSE
      ELSIF nExps <= 127 THEN
        Assign(expMod[nExps], modNames[mi]);
        Assign(expName[nExps], en);
        expKindA[nExps] := syms[idx].kind;
        expTypeA[nExps] := syms[idx].typ;
        IF syms[idx].kind = KindProc THEN
          expProcA[nExps] := syms[idx].pnum
        ELSE
          expProcA[nExps] := -1
        END;
        INC(nExps)
      END;
      INC(k)
    END;
    PopScope;
    DEC(modTop);
    RETURN ok
  END ExitModule;

PROCEDURE InModule (): BOOLEAN;
  BEGIN RETURN modTop > 0 END InModule;

PROCEDURE CurModName (VAR m: Name);
  BEGIN
    IF modTop = 0 THEN m[0] := 0C
    ELSE Assign(m, modNames[modTop - 1])
    END
  END CurModName;

PROCEDURE ExpFind (mod, exp: ARRAY OF CHAR): INTEGER;
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE i < nExps DO
      IF Equal(expMod[i], mod) & Equal(expName[i], exp) THEN
        RETURN VAL(INTEGER, i)
      END;
      INC(i)
    END;
    RETURN -1
  END ExpFind;

PROCEDURE ExpKind (mod, exp: ARRAY OF CHAR): INTEGER;
  VAR i : INTEGER;
  BEGIN
    i := ExpFind(mod, exp);
    IF i = -1 THEN RETURN -1 END;
    RETURN expKindA[i]
  END ExpKind;

PROCEDURE ExpType (mod, exp: ARRAY OF CHAR): TypeIndex;
  VAR i : INTEGER;
  BEGIN
    i := ExpFind(mod, exp);
    IF i = -1 THEN RETURN InvalidType END;
    RETURN expTypeA[i]
  END ExpType;

PROCEDURE ExpProc (mod, exp: ARRAY OF CHAR): INTEGER;
  VAR i : INTEGER;
  BEGIN
    i := ExpFind(mod, exp);
    IF i = -1 THEN RETURN -1 END;
    RETURN expProcA[i]
  END ExpProc;

PROCEDURE ExpQual (mod, exp: ARRAY OF CHAR; VAR qual: Name);
  VAR i, j, k : CARDINAL;
  BEGIN
    i := ExpFind(mod, exp);
    IF i = -1 THEN qual[0] := 0C; RETURN END;
    IF (expKindA[i] # KindVar) & (expKindA[i] # KindConst) THEN
      qual[0] := 0C; RETURN
    END;
    k := 0; j := 0;
    WHILE (k < HIGH(qual)) & (mod[j] # 0C) DO
      qual[k] := mod[j]; INC(k); INC(j)
    END;
    IF k <= HIGH(qual) THEN qual[k] := "."; INC(k) END;
    j := 0;
    WHILE (k < HIGH(qual)) & (exp[j] # 0C) DO
      qual[k] := exp[j]; INC(k); INC(j)
    END;
    IF k <= HIGH(qual) THEN qual[k] := 0C END
  END ExpQual;

PROCEDURE SelfKind (mod, exp: ARRAY OF CHAR): INTEGER;
(* Kind of exp as a self-qualified M.exp reference from inside module
   M itself (the export table only fills at END, so the live body
   scope is consulted). -1 when not inside M or not at body level. *)
  VAR idx : INTEGER;
  BEGIN
    IF modTop = 0 THEN RETURN -1 END;
    IF ~Equal(modNames[modTop - 1], mod) THEN RETURN -1 END;
    idx := Find(exp);
    IF idx = -1 THEN RETURN -1 END;
    IF syms[idx].lev # modLevs[modTop - 1] THEN RETURN -1 END;
    RETURN syms[idx].kind
  END SelfKind;

PROCEDURE SelfQual (exp: ARRAY OF CHAR; VAR qual: Name);
(* CurMod.exp for a self reference (call only when SelfKind # -1). *)
  VAR m : Name;
    j, k : CARDINAL;
  BEGIN
    CurModName(m);
    k := 0; j := 0;
    WHILE (k < HIGH(qual)) & (m[j] # 0C) DO
      qual[k] := m[j]; INC(k); INC(j)
    END;
    IF k <= HIGH(qual) THEN qual[k] := "."; INC(k) END;
    j := 0;
    WHILE (k < HIGH(qual)) & (exp[j] # 0C) DO
      qual[k] := exp[j]; INC(k); INC(j)
    END;
    IF k <= HIGH(qual) THEN qual[k] := 0C END
  END SelfQual;

(* ---------------- separate compilation units ---------------- *)

PROCEDURE DefFind (name: ARRAY OF CHAR): INTEGER;
(* Recorded-definition index or -1. *)
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE i < nDefs DO
      IF Equal(defNames[i], name) THEN RETURN VAL(INTEGER, i) END;
      INC(i)
    END;
    RETURN -1
  END DefFind;

PROCEDURE ExitDefinition (): BOOLEAN;
(* Publishes every interface name of the current module scope into
   the export tables, records the interface side table, pops scope
   + module context. The level-0 module symbol survives for L.x
   heads and IsDefMod checks. FALSE on phase-cap overflow. *)
  VAR mi : CARDINAL;
    i, n : CARDINAL;
    k : INTEGER;
    ok : BOOLEAN;
  BEGIN
    IF modTop = 0 THEN RETURN FALSE END;
    mi := modTop - 1;
    ok := TRUE;
    IF mtop = 0 THEN RETURN FALSE END;
    i := marks[mtop - 1];
    WHILE i < nSyms DO
      k := syms[i].kind;
      IF (k = KindConst) OR (k = KindType) OR (k = KindVar)
         OR (k = KindProc) THEN
        IF nExps > 127 THEN ok := FALSE
        ELSE
          Assign(expMod[nExps], modNames[mi]);
          Assign(expName[nExps], syms[i].name);
          expKindA[nExps] := k;
          expTypeA[nExps] := syms[i].typ;
          IF k = KindProc THEN expProcA[nExps] := syms[i].pnum
          ELSE expProcA[nExps] := -1
          END;
          INC(nExps)
        END
      END;
      INC(i)
    END;
    IF nDefs > 7 THEN ok := FALSE END;
    n := 0;
    IF ok THEN
      Assign(defNames[nDefs], modNames[mi]);
      defProcLo[nDefs] := defMark + 1;
      defProcHi[nDefs] := nProcs;
      i := marks[mtop - 1];
      WHILE i < nSyms DO
        k := syms[i].kind;
        IF (k = KindConst) OR (k = KindType) OR (k = KindVar)
           OR (k = KindProc) THEN
          IF n > 31 THEN ok := FALSE
          ELSE
            Assign(defSyms[nDefs][n], syms[i].name);
            defKinds[nDefs][n] := k;
            defTypes[nDefs][n] := syms[i].typ;
            defPnums[nDefs][n] := syms[i].pnum;
            INC(n)
          END
        END;
        INC(i)
      END;
      defNSyms[nDefs] := n;
      IF ok THEN INC(nDefs) END
    END;
    PopScope;
    DEC(modTop);
    RETURN ok
  END ExitDefinition;

PROCEDURE OpenImplementation (name: ARRAY OF CHAR): BOOLEAN;
(* Re-enters a recorded interface into a fresh module scope:
   constants/types/variables as plain symbols (MGen slots were
   allocated once at definition and resolve via the module
   context), procedures as forward-pending aliases so headings
   match through the ReuseProc/VerifyProc path. *)
  VAR d : INTEGER;
    i : CARDINAL;
    idx : INTEGER;
  BEGIN
    d := DefFind(name);
    IF d < 0 THEN RETURN FALSE END;
    IF modTop > 7 THEN RETURN FALSE END;
    Assign(modNames[modTop], name);
    modNExps[modTop] := 0;
    INC(modTop);
    PushScope;
    modLevs[modTop - 1] := curLev;
    i := 0;
    WHILE i < defNSyms[d] DO
      idx := RawEnter(defSyms[d][i], defKinds[d][i]);
      IF idx = -1 THEN
        PopScope; DEC(modTop); RETURN FALSE
      END;
      syms[idx].typ := defTypes[d][i];
      IF defKinds[d][i] = KindProc THEN
        syms[idx].pnum := defPnums[d][i];
        curProc := defPnums[d][i];
        IF (curProc >= 1) & (curProc <= VAL(INTEGER, nProcs)) THEN
          procs[curProc].fwd := TRUE;
          procs[curProc].dHead := -1;
          procs[curProc].dTail := -1
        END
      END;
      INC(i)
    END;
    curProc := 0;
    curDef := d;
    RETURN TRUE
  END OpenImplementation;

PROCEDURE CloseImplementation (): BOOLEAN;
(* Every definition procedure must have its body by now (231
   otherwise). Scope + context pop either way. *)
  VAR d : INTEGER;
    k : CARDINAL;
    ok : BOOLEAN;
  BEGIN
    d := curDef;
    ok := TRUE;
    IF (d >= 0) & (d < 8) THEN
      k := defProcLo[d];
      WHILE k <= defProcHi[d] DO
        IF (k >= 1) & (k <= VAL(CARDINAL, nProcs)) THEN
          IF procs[k].fwd THEN ok := FALSE END
        END;
        INC(k)
      END
    END;
    IF modTop > 0 THEN
      PopScope;
      DEC(modTop)
    END;
    curDef := -1;
    curProc := 0;
    RETURN ok
  END CloseImplementation;

PROCEDURE IsDefMod (name: ARRAY OF CHAR): BOOLEAN;
  VAR idx : INTEGER;
  BEGIN
    idx := Find(name);
    IF idx = -1 THEN RETURN FALSE END;
    IF syms[idx].kind # KindModule THEN RETURN FALSE END;
    RETURN DefFind(name) # -1
  END IsDefMod;

PROCEDURE ImpBind (mod, exp: ARRAY OF CHAR): BOOLEAN;
(* Records unqualified exp -> "mod.exp" for GlobAlias. The caller
   validates the kind through ExpKind and materializes the alias
   symbol (ImpUnbind on failure). *)
  VAR i : CARDINAL;
    j, k : CARDINAL;
  BEGIN
    IF ExpFind(mod, exp) = -1 THEN RETURN FALSE END;
    i := 0;
    WHILE i < nImps DO
      IF Equal(impNames[i], exp) THEN
        j := 0; k := 0;
        WHILE (k < HIGH(impQuals[i])) & (mod[j] # 0C) DO
          impQuals[i][k] := mod[j]; INC(k); INC(j)
        END;
        IF k <= HIGH(impQuals[i]) THEN impQuals[i][k] := "."; INC(k) END;
        j := 0;
        WHILE (k < HIGH(impQuals[i])) & (exp[j] # 0C) DO
          impQuals[i][k] := exp[j]; INC(k); INC(j)
        END;
        IF k <= HIGH(impQuals[i]) THEN impQuals[i][k] := 0C END;
        RETURN TRUE
      END;
      INC(i)
    END;
    IF nImps > 63 THEN RETURN FALSE END;
    Assign(impNames[nImps], exp);
    j := 0; k := 0;
    WHILE (k < HIGH(impQuals[nImps])) & (mod[j] # 0C) DO
      impQuals[nImps][k] := mod[j]; INC(k); INC(j)
    END;
    IF k <= HIGH(impQuals[nImps]) THEN
      impQuals[nImps][k] := "."; INC(k)
    END;
    j := 0;
    WHILE (k < HIGH(impQuals[nImps])) & (exp[j] # 0C) DO
      impQuals[nImps][k] := exp[j]; INC(k); INC(j)
    END;
    IF k <= HIGH(impQuals[nImps]) THEN impQuals[nImps][k] := 0C END;
    INC(nImps);
    RETURN TRUE
  END ImpBind;

PROCEDURE ImpUnbind (name: ARRAY OF CHAR);
  VAR i, j : CARDINAL;
  BEGIN
    i := 0;
    WHILE i < nImps DO
      IF Equal(impNames[i], name) THEN
        j := i;
        WHILE j + 1 < nImps DO
          Assign(impNames[j], impNames[j + 1]);
          Assign(impQuals[j], impQuals[j + 1]);
          INC(j)
        END;
        DEC(nImps);
        RETURN
      END;
      INC(i)
    END
  END ImpUnbind;

PROCEDURE EnterImpProc (name: ARRAY OF CHAR; pnum: INTEGER): BOOLEAN;
  VAR idx : INTEGER;
  BEGIN
    IF DupInLevel(name) THEN RETURN FALSE END;
    IF (pnum < 1) OR (pnum > VAL(INTEGER, nProcs)) THEN RETURN FALSE END;
    idx := RawEnter(name, KindProc);
    IF idx = -1 THEN RETURN FALSE END;
    syms[idx].pnum := pnum;
    syms[idx].typ := procs[pnum].ret;
    RETURN TRUE
  END EnterImpProc;

PROCEDURE GlobAlias (name: ARRAY OF CHAR; VAR q: Name): BOOLEAN;
  VAR i : CARDINAL;
  BEGIN
    i := 0;
    WHILE i < nImps DO
      IF Equal(impNames[i], name) THEN
        Assign(q, impQuals[i]);
        RETURN TRUE
      END;
      INC(i)
    END;
    RETURN FALSE
  END GlobAlias;

PROCEDURE NoteProgram (): BOOLEAN;
  BEGIN
    IF progDone THEN RETURN FALSE END;
    progDone := TRUE;
    RETURN TRUE
  END NoteProgram;

(* ---------------- type descriptors ---------------- *)

PROCEDURE NewDesc (form: INTEGER; ref: TypeIndex): TypeIndex;
  BEGIN
    IF nTypes >= MaxTypes THEN RETURN InvalidType END;
    tform[nTypes] := form;
    tref[nTypes] := ref;
    tLo[nTypes] := 0;
    tHi[nTypes] := -1;
    tNext[nTypes] := 0;
    tOpen[nTypes] := FALSE;
    INC(nTypes);
    RETURN VAL(INTEGER, nTypes - 1)
  END NewDesc;

PROCEDURE NewAlias (): TypeIndex;
  BEGIN
    RETURN NewDesc(FAlias, InvalidType)
  END NewAlias;

PROCEDURE NewSub (base: TypeIndex): TypeIndex;
  BEGIN
    RETURN NewDesc(FSub, base)
  END NewSub;

PROCEDURE NewSubB (base: TypeIndex; lo, hi: INTEGER): TypeIndex;
  VAR t : TypeIndex;
  BEGIN
    t := NewDesc(FSub, base);
    IF t # InvalidType THEN
      tLo[t] := lo; tHi[t] := hi
    END;
    RETURN t
  END NewSubB;

PROCEDURE NewEnum (): TypeIndex;
  VAR t : TypeIndex;
  BEGIN
    t := NewDesc(FEnum, InvalidType);
    IF t # InvalidType THEN
      tLo[t] := 0; tHi[t] := -1
    END;
    RETURN t
  END NewEnum;

PROCEDURE EnumAdd (t: TypeIndex);
  VAR r : TypeIndex;
  BEGIN
    r := t;
    IF (r >= 0) & (r < VAL(INTEGER, nTypes)) & (tform[r] = FAlias) THEN
      r := tref[r]
    END;
    IF (r < 0) OR (r >= VAL(INTEGER, nTypes)) THEN RETURN END;
    IF tform[r] # FEnum THEN RETURN END;
    tHi[r] := tHi[r] + 1
  END EnumAdd;

PROCEDURE NewArray (elem: TypeIndex): TypeIndex;
  BEGIN
    RETURN NewDesc(FArray, elem)
  END NewArray;

PROCEDURE NewArrayB (elem: TypeIndex; lo, hi: INTEGER): TypeIndex;
  VAR t : TypeIndex;
  BEGIN
    t := NewDesc(FArray, elem);
    IF t # InvalidType THEN
      tLo[t] := lo; tHi[t] := hi
    END;
    RETURN t
  END NewArrayB;

PROCEDURE NewOpen (elem: TypeIndex): TypeIndex;
  VAR t : TypeIndex;
  BEGIN
    t := NewDesc(FArray, elem);
    IF t # InvalidType THEN
      tLo[t] := 0; tHi[t] := -1; tOpen[t] := TRUE
    END;
    RETURN t
  END NewOpen;

PROCEDURE IsOpen (t: TypeIndex): BOOLEAN;
  VAR r : TypeIndex;
  BEGIN
    r := t;
    IF (r >= 0) & (r < VAL(INTEGER, nTypes)) & (tform[r] = FAlias) THEN
      r := tref[r]
    END;
    IF (r = InvalidType) OR (r < 0) OR (r >= VAL(INTEGER, nTypes)) THEN
      RETURN FALSE
    END;
    IF tform[r] # FArray THEN RETURN FALSE END;
    RETURN tOpen[r]
  END IsOpen;

PROCEDURE NewRecord (): TypeIndex;
  BEGIN
    RETURN NewDesc(FRecord, -1)
  END NewRecord;

PROCEDURE NewSet (base: TypeIndex): TypeIndex;
  BEGIN
    RETURN NewDesc(FSet, base)
  END NewSet;

PROCEDURE NewPtr (base: TypeIndex): TypeIndex;
  BEGIN
    RETURN NewDesc(FPtr, base)
  END NewPtr;

PROCEDURE NewStr (): TypeIndex;
  BEGIN
    RETURN NewDesc(FStr, InvalidType)
  END NewStr;

PROCEDURE SetTarget (t, base: TypeIndex);
  BEGIN
    IF (t >= 0) & (t < VAL(INTEGER, nTypes)) & (tform[t] = FAlias) THEN
      tref[t] := base
    END
  END SetTarget;

PROCEDURE Resolve (t: TypeIndex): TypeIndex;
  VAR n : CARDINAL;
  BEGIN
    n := 0;
    WHILE (n < ResDepth) & (t >= 0) & (t < VAL(INTEGER, nTypes))
          & (tform[t] = FAlias) DO
      t := tref[t]; INC(n)
    END;
    IF (t < 0) OR (t >= VAL(INTEGER, nTypes)) THEN
      RETURN InvalidType
    END;
    RETURN t
  END Resolve;

PROCEDURE IntType (): TypeIndex;
  BEGIN RETURN dInt END IntType;
PROCEDURE RealType (): TypeIndex;
  BEGIN RETURN dReal END RealType;
PROCEDURE CharType (): TypeIndex;
  BEGIN RETURN dChar END CharType;
PROCEDURE BoolType (): TypeIndex;
  BEGIN RETURN dBool END BoolType;

PROCEDURE ClassOf (t: TypeIndex): INTEGER;
  VAR r : TypeIndex;
  BEGIN
    r := Resolve(t);
    IF r = InvalidType THEN RETURN ClInvalid END;
    CASE tform[r] OF
      FInt : RETURN ClInt
    | FReal : RETURN ClReal
    | FChar : RETURN ClChar
    | FBool : RETURN ClBool
    | FEnum : RETURN ClEnum
    | FArray : RETURN ClArray
    | FRecord : RETURN ClRecord
    | FSet : RETURN ClSet
    | FPtr : RETURN ClPtr
    | FStr : RETURN ClStr
    | FSub : RETURN ClassOf(tref[r])
    ELSE RETURN ClInvalid
    END
  END ClassOf;

PROCEDURE IsIntFamily (t: TypeIndex): BOOLEAN;
  BEGIN
    RETURN ClassOf(t) = ClInt
  END IsIntFamily;

PROCEDURE SameType (a, b: TypeIndex): BOOLEAN;
  BEGIN
    IF (a = InvalidType) OR (b = InvalidType) THEN RETURN TRUE END;
    RETURN Resolve(a) = Resolve(b)
  END SameType;

PROCEDURE FieldExists (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
  BEGIN
    RETURN FindField(Resolve(rec), name) # -1
  END FieldExists;

PROCEDURE FieldType (rec: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
  VAR i : INTEGER;
  BEGIN
    i := FindField(Resolve(rec), name);
    IF i = -1 THEN RETURN InvalidType END;
    RETURN fields[i].typ
  END FieldType;

PROCEDURE ArrayElem (t: TypeIndex): TypeIndex;
  VAR r : TypeIndex;
  BEGIN
    r := Resolve(t);
    IF (r = InvalidType) OR (tform[r] # FArray) THEN
      RETURN InvalidType
    END;
    RETURN tref[r]
  END ArrayElem;

PROCEDURE PtrBase (t: TypeIndex): TypeIndex;
  VAR r : TypeIndex;
  BEGIN
    r := Resolve(t);
    IF (r = InvalidType) OR (tform[r] # FPtr) THEN
      RETURN InvalidType
    END;
    RETURN tref[r]
  END PtrBase;

PROCEDURE TypeSlots (t: TypeIndex): CARDINAL;
  BEGIN
    RETURN SlotsDepth(t, 0)
  END TypeSlots;

PROCEDURE OrdBounds (t: TypeIndex; VAR lo, hi: INTEGER): BOOLEAN;
(* Bounds for ordinal types; FALSE if unsized/invalid (no cascade if Invalid). *)
  VAR r : TypeIndex;
  BEGIN
    IF t = InvalidType THEN lo := 0; hi := 0; RETURN TRUE END;
    r := Resolve(t);
    IF r = InvalidType THEN lo := 0; hi := 0; RETURN TRUE END;
    CASE tform[r] OF
      FInt : lo := 0; hi := -1; RETURN FALSE
    | FChar : lo := 0; hi := 255; RETURN TRUE
    | FBool : lo := 0; hi := 1; RETURN TRUE
    | FEnum :
        IF tHi[r] < tLo[r] THEN lo := 0; hi := -1; RETURN FALSE END;
        lo := tLo[r]; hi := tHi[r]; RETURN TRUE
    | FSub :
        IF tHi[r] < tLo[r] THEN
          IF tref[r] = InvalidType THEN lo := 0; hi := 0; RETURN TRUE END;
          lo := 0; hi := -1; RETURN FALSE
        END;
        lo := tLo[r]; hi := tHi[r]; RETURN TRUE
    ELSE lo := 0; hi := -1; RETURN FALSE
    END
  END OrdBounds;

PROCEDURE TypeLo (t: TypeIndex): INTEGER;
  VAR lo, hi: INTEGER;
  BEGIN
    IF OrdBounds(t, lo, hi) THEN RETURN lo END;
    RETURN 0
  END TypeLo;

PROCEDURE TypeHi (t: TypeIndex): INTEGER;
  VAR lo, hi: INTEGER;
  BEGIN
    IF OrdBounds(t, lo, hi) THEN RETURN hi END;
    RETURN -1
  END TypeHi;

PROCEDURE TypeLen (t: TypeIndex): CARDINAL;
  VAR lo, hi: INTEGER;
    span: INTEGER;
  BEGIN
    IF t = InvalidType THEN RETURN 1 END;
    IF OrdBounds(t, lo, hi) THEN
      IF hi < lo THEN RETURN 0 END;
      span := hi - lo + 1;
      IF span <= 0 THEN RETURN 0 END;
      RETURN VAL(CARDINAL, span)
    END;
    RETURN 0
  END TypeLen;

PROCEDURE ArrayLo (t: TypeIndex): INTEGER;
  VAR r: TypeIndex;
  BEGIN
    r := Resolve(t);
    IF (r = InvalidType) OR (tform[r] # FArray) THEN RETURN 0 END;
    RETURN tLo[r]
  END ArrayLo;

PROCEDURE ArrayHi (t: TypeIndex): INTEGER;
  VAR r: TypeIndex;
  BEGIN
    r := Resolve(t);
    IF (r = InvalidType) OR (tform[r] # FArray) THEN RETURN -1 END;
    RETURN tHi[r]
  END ArrayHi;

PROCEDURE ArrayLen (t: TypeIndex): CARDINAL;
  VAR r: TypeIndex;
    span: INTEGER;
  BEGIN
    r := Resolve(t);
    IF (r = InvalidType) OR (tform[r] # FArray) THEN RETURN 0 END;
    IF tHi[r] < tLo[r] THEN RETURN 0 END;
    span := tHi[r] - tLo[r] + 1;
    IF span <= 0 THEN RETURN 0 END;
    RETURN VAL(CARDINAL, span)
  END ArrayLen;

PROCEDURE FieldOffset (rec: TypeIndex; name: ARRAY OF CHAR): INTEGER;
  VAR i: INTEGER;
  BEGIN
    i := FindField(Resolve(rec), name);
    IF i = -1 THEN RETURN -1 END;
    RETURN fields[i].off
  END FieldOffset;

PROCEDURE PushRecord (t: TypeIndex): BOOLEAN;
(* Pushes a scope with t's fields; caller must PopScope afterwards. *)
  VAR r, i : INTEGER;
  BEGIN
    r := Resolve(t);
    IF (r < 0) OR (tform[r] # FRecord) THEN RETURN FALSE END;
    PushScope;
    i := tref[r];
    WHILE i # -1 DO
      IF Enter(fields[i].name, KindField) THEN
        SetSymType(fields[i].name, fields[i].typ)
      END;
      i := fields[i].next
    END;
    RETURN TRUE
  END PushRecord;

(* ---------------- predicates ---------------- *)

PROCEDURE SetBasesOk (a, b: TypeIndex): BOOLEAN;
(* base compatibility for two SET types *)
  BEGIN
    IF SameType(a, b) THEN RETURN TRUE END;
    IF IsIntFamily(a) & IsIntFamily(b) THEN RETURN TRUE END;
    IF (ClassOf(a) = ClChar) & (ClassOf(b) = ClChar) THEN
      RETURN TRUE
    END;
    RETURN FALSE
  END SetBasesOk;

PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
  VAR rs, rd : TypeIndex;
  BEGIN
    IF (src = InvalidType) OR (dst = InvalidType) THEN RETURN TRUE END;
    rs := Resolve(src); rd := Resolve(dst);
    IF rs = rd THEN RETURN TRUE END;
    IF (rs = InvalidType) OR (rd = InvalidType) THEN RETURN TRUE END;
    IF (tform[rs] = FSet) & (tform[rd] = FSet) THEN
      RETURN SetBasesOk(tref[rs], tref[rd])
    END;
    IF (tform[rs] = FPtr) & (tform[rd] = FPtr) THEN
      RETURN SameType(tref[rs], tref[rd])
    END;
    IF (ClassOf(src) = ClInt) & (ClassOf(dst) = ClInt) THEN
      RETURN TRUE
    END;
    IF (ClassOf(src) = ClInt) & (ClassOf(dst) = ClReal) THEN
      RETURN TRUE
    END;
    IF (ClassOf(src) = ClStr) & (ClassOf(dst) = ClArray) THEN
      RETURN TRUE
    END;
    RETURN FALSE
  END Assignable;

PROCEDURE ArithCheck (l, r: TypeIndex; divmod: BOOLEAN;
                      VAR res: TypeIndex): BOOLEAN;
  BEGIN
    res := InvalidType;
    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
    IF IsIntFamily(l) & IsIntFamily(r) THEN
      res := dInt; RETURN TRUE
    END;
    IF ~divmod & (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
      res := dReal; RETURN TRUE
    END;
    RETURN FALSE
  END ArithCheck;

PROCEDURE UnaryCheck (t: TypeIndex; VAR res: TypeIndex): BOOLEAN;
  BEGIN
    res := InvalidType;
    IF t = InvalidType THEN RETURN TRUE END;
    IF IsIntFamily(t) THEN res := dInt; RETURN TRUE END;
    IF ClassOf(t) = ClReal THEN res := dReal; RETURN TRUE END;
    RETURN FALSE
  END UnaryCheck;

PROCEDURE BoolCheck (t: TypeIndex): BOOLEAN;
  BEGIN
    IF t = InvalidType THEN RETURN TRUE END;
    RETURN ClassOf(t) = ClBool
  END BoolCheck;

PROCEDURE EqCheck (l, r: TypeIndex): BOOLEAN;
  VAR rl, rr : TypeIndex;
  BEGIN
    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
    IF SameType(l, r) THEN RETURN TRUE END;
    IF IsIntFamily(l) & IsIntFamily(r) THEN RETURN TRUE END;
    IF (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
      RETURN TRUE
    END;
    IF (ClassOf(l) = ClChar) & (ClassOf(r) = ClChar) THEN
      RETURN TRUE
    END;
    IF (ClassOf(l) = ClBool) & (ClassOf(r) = ClBool) THEN
      RETURN TRUE
    END;
    IF (ClassOf(l) = ClStr) & (ClassOf(r) = ClStr) THEN
      RETURN TRUE
    END;
    rl := Resolve(l); rr := Resolve(r);
    IF (rl = InvalidType) OR (rr = InvalidType) THEN RETURN TRUE END;
    IF (tform[rl] = FSet) & (tform[rr] = FSet) THEN
      RETURN SetBasesOk(tref[rl], tref[rr])
    END;
    RETURN FALSE
  END EqCheck;

PROCEDURE OrdCheck (l, r: TypeIndex): BOOLEAN;
  BEGIN
    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
    IF IsIntFamily(l) & IsIntFamily(r) THEN RETURN TRUE END;
    IF (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
      RETURN TRUE
    END;
    IF (ClassOf(l) = ClChar) & (ClassOf(r) = ClChar) THEN
      RETURN TRUE
    END;
    IF (ClassOf(l) = ClEnum) & SameType(l, r) THEN RETURN TRUE END;
    RETURN FALSE
  END OrdCheck;

PROCEDURE InCheck (l, set: TypeIndex): BOOLEAN;
  VAR rs, b : TypeIndex;
  BEGIN
    IF (l = InvalidType) OR (set = InvalidType) THEN RETURN TRUE END;
    rs := Resolve(set);
    IF (rs = InvalidType) OR (tform[rs] # FSet) THEN RETURN FALSE END;
    b := tref[rs];
    IF SameType(l, b) THEN RETURN TRUE END;
    IF IsIntFamily(l) & IsIntFamily(b) THEN RETURN TRUE END;
    IF (ClassOf(l) = ClChar) & (ClassOf(b) = ClChar) THEN
      RETURN TRUE
    END;
    RETURN FALSE
  END InCheck;

PROCEDURE RelCheck (l, r: TypeIndex; op: INTEGER): BOOLEAN;
  BEGIN
    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
    IF op = OpIn THEN RETURN InCheck(l, r) END;
    IF (op = OpEq) OR (op = OpNeq1) OR (op = OpNeq2) THEN
      RETURN EqCheck(l, r)
    END;
    RETURN OrdCheck(l, r)
  END RelCheck;

PROCEDURE SetElemCheck (first, elem: TypeIndex): BOOLEAN;
  BEGIN
    IF (first = InvalidType) OR (elem = InvalidType) THEN
      RETURN TRUE
    END;
    IF SameType(first, elem) THEN RETURN TRUE END;
    IF IsIntFamily(first) & IsIntFamily(elem) THEN RETURN TRUE END;
    RETURN FALSE
  END SetElemCheck;

PROCEDURE SetFor (elem: TypeIndex): TypeIndex;
  VAR e : TypeIndex;
  BEGIN
    e := Resolve(elem);
    IF e = InvalidType THEN e := dInt END;
    RETURN NewSet(e)
  END SetFor;

(* ---------------- procedures ---------------- *)

PROCEDURE NewParamRec (typ: TypeIndex; isVar: BOOLEAN): INTEGER;
  BEGIN
    IF nParams >= MaxParams THEN RETURN -1 END;
    params[nParams].typ := typ;
    params[nParams].isVar := isVar;
    params[nParams].next := -1;
    INC(nParams);
    RETURN VAL(INTEGER, nParams - 1)
  END NewParamRec;

PROCEDURE AppParam (p: INTEGER; fwd: BOOLEAN);
(* Appends param record p to the current proc's forward/define list. *)
  VAR tail : INTEGER;
  BEGIN
    IF (curProc < 1) OR (curProc > VAL(INTEGER, nProcs)) THEN RETURN END;
    IF fwd THEN
      IF procs[curProc].fHead = -1 THEN procs[curProc].fHead := p
      ELSE
        tail := procs[curProc].fHead;
        WHILE params[tail].next # -1 DO tail := params[tail].next END;
        params[tail].next := p
      END;
      procs[curProc].fTail := p
    ELSE
      IF procs[curProc].dHead = -1 THEN procs[curProc].dHead := p
      ELSE
        tail := procs[curProc].dHead;
        WHILE params[tail].next # -1 DO tail := params[tail].next END;
        params[tail].next := p
      END;
      procs[curProc].dTail := p
    END
  END AppParam;

PROCEDURE EnterProc (name: ARRAY OF CHAR): BOOLEAN;
  VAR idx : INTEGER;
  BEGIN
    IF DupInLevel(name) THEN RETURN FALSE END;
    IF nProcs >= MaxProcs THEN RETURN FALSE END;
    idx := RawEnter(name, KindProc);
    IF idx = -1 THEN RETURN FALSE END;
    INC(nProcs);
    syms[idx].pnum := VAL(INTEGER, nProcs);
    procs[nProcs].ret := InvalidType;
    procs[nProcs].fret := InvalidType;
    procs[nProcs].fwd := FALSE;
    procs[nProcs].everFwd := FALSE;
    procs[nProcs].fHead := -1;
    procs[nProcs].fTail := -1;
    procs[nProcs].dHead := -1;
    procs[nProcs].dTail := -1;
    curProc := VAL(INTEGER, nProcs);
    RETURN TRUE
  END EnterProc;

PROCEDURE AllocInitNum (): INTEGER;
(* Reserves the next proc number for a module BEGIN init body.
   Shares the nProcs pool with EnterProc (same parse-order
   monotonic counter), so init bodies and procedure bodies can
   never own the same table slot regardless of emission order.
   The procs[] entry is initialized like a parameterless proper
   procedure so 1..nProcs sweeps (e.g. AnyForward) stay clean. *)
  BEGIN
    IF nProcs >= MaxProcs THEN RETURN -1 END;
    INC(nProcs);
    procs[nProcs].ret := InvalidType;
    procs[nProcs].fret := InvalidType;
    procs[nProcs].fwd := FALSE;
    procs[nProcs].everFwd := FALSE;
    procs[nProcs].fHead := -1;
    procs[nProcs].fTail := -1;
    procs[nProcs].dHead := -1;
    procs[nProcs].dTail := -1;
    RETURN VAL(INTEGER, nProcs)
  END AllocInitNum;

PROCEDURE IsForward (name: ARRAY OF CHAR): BOOLEAN;
  VAR idx : INTEGER;
  BEGIN
    idx := Find(name);
    IF idx = -1 THEN RETURN FALSE END;
    IF syms[idx].kind # KindProc THEN RETURN FALSE END;
    IF syms[idx].pnum < 1 THEN RETURN FALSE END;
    RETURN procs[syms[idx].pnum].fwd
  END IsForward;

PROCEDURE ReuseProc (name: ARRAY OF CHAR);
  VAR idx : INTEGER;
  BEGIN
    idx := Find(name);
    IF idx = -1 THEN RETURN END;
    curProc := syms[idx].pnum;
    IF (curProc >= 1) & (curProc <= VAL(INTEGER, nProcs)) THEN
      procs[curProc].fwd := FALSE;
      procs[curProc].dHead := -1;
      procs[curProc].dTail := -1
    END
  END ReuseProc;

PROCEDURE OpenProcScope;
  BEGIN
    IF pdep < MaxPDepth THEN INC(pdep) END;
    PushScope;
    locCnt[pdep] := 0;
    parCnt[pdep] := 0;
    procSt[pdep] := curProc;
    retSt[pdep] := InvalidType
  END OpenProcScope;

PROCEDURE CloseProc;
  BEGIN
    PopScope;
    IF pdep > 0 THEN DEC(pdep) END;
    curProc := procSt[pdep]
  END CloseProc;

PROCEDURE EnterParam (name: ARRAY OF CHAR; isVar: BOOLEAN;
                      t: TypeIndex): BOOLEAN;
  VAR idx, pi : INTEGER;
  BEGIN
    IF DupInLevel(name) THEN RETURN FALSE END;
    IF isVar THEN idx := RawEnter(name, KindVarPar)
    ELSE idx := RawEnter(name, KindParam)
    END;
    IF idx = -1 THEN RETURN FALSE END;
    SetSymType(name, t);
    syms[idx].slot := 3 + VAL(INTEGER, parCnt[pdep]);
    IF IsOpen(t) THEN
      INC(parCnt[pdep], 2)
    ELSE
      INC(parCnt[pdep])
    END;
    pi := NewParamRec(t, isVar);
    IF pi # -1 THEN AppParam(pi, FALSE) END;
    RETURN TRUE
  END EnterParam;

PROCEDURE SetProcRet (t: TypeIndex): BOOLEAN;
  BEGIN
    IF (curProc < 1) OR (curProc > VAL(INTEGER, nProcs)) THEN
      RETURN TRUE
    END;
    IF procs[curProc].everFwd
       & ~SameType(t, procs[curProc].fret) THEN
      RETURN FALSE
    END;
    procs[curProc].ret := t;
    IF pdep > 0 THEN retSt[pdep] := t END;
    RETURN TRUE
  END SetProcRet;

PROCEDURE VerifyProc (): BOOLEAN;
  VAR fi, di : INTEGER;
  BEGIN
    IF (curProc < 1) OR (curProc > VAL(INTEGER, nProcs)) THEN
      RETURN TRUE
    END;
    IF ~procs[curProc].everFwd THEN RETURN TRUE END;
    fi := procs[curProc].fHead; di := procs[curProc].dHead;
    WHILE (fi # -1) & (di # -1) DO
      IF (params[fi].isVar # params[di].isVar)
         OR ~SameType(params[fi].typ, params[di].typ) THEN
        RETURN FALSE
      END;
      fi := params[fi].next; di := params[di].next
    END;
    RETURN (fi = -1) & (di = -1)
  END VerifyProc;

PROCEDURE SetForward;
  BEGIN
    IF (curProc < 1) OR (curProc > VAL(INTEGER, nProcs)) THEN RETURN END;
    procs[curProc].fwd := TRUE;
    procs[curProc].everFwd := TRUE;
    procs[curProc].fret := procs[curProc].ret;
    procs[curProc].fHead := procs[curProc].dHead;
    procs[curProc].fTail := procs[curProc].dTail;
    procs[curProc].dHead := -1;
    procs[curProc].dTail := -1
  END SetForward;

PROCEDURE AnyForward (): BOOLEAN;
  VAR i : CARDINAL;
  BEGIN
    i := 1;
    WHILE i <= nProcs DO
      IF procs[i].fwd THEN RETURN TRUE END;
      INC(i)
    END;
    RETURN FALSE
  END AnyForward;

PROCEDURE ProcNum (name: ARRAY OF CHAR): INTEGER;
  VAR idx : INTEGER;
  BEGIN
    idx := Find(name);
    IF idx = -1 THEN RETURN -1 END;
    IF syms[idx].kind # KindProc THEN RETURN -1 END;
    RETURN syms[idx].pnum
  END ProcNum;

PROCEDURE SigHead (name: ARRAY OF CHAR): INTEGER;
(* Param list head: define list if present, else forward list. *)
  VAR n : INTEGER;
  BEGIN
    n := ProcNum(name);
    IF n < 1 THEN RETURN -1 END;
    IF procs[n].dHead # -1 THEN RETURN procs[n].dHead END;
    RETURN procs[n].fHead
  END SigHead;

PROCEDURE ProcRet (name: ARRAY OF CHAR): TypeIndex;
  VAR n : INTEGER;
  BEGIN
    n := ProcNum(name);
    IF n < 1 THEN RETURN InvalidType END;
    RETURN procs[n].ret
  END ProcRet;

PROCEDURE ProcNPar (name: ARRAY OF CHAR): CARDINAL;
  VAR h : INTEGER;
    c : CARDINAL;
  BEGIN
    h := SigHead(name); c := 0;
    WHILE h # -1 DO INC(c); h := params[h].next END;
    RETURN c
  END ProcNPar;

PROCEDURE ParamType (name: ARRAY OF CHAR; i: CARDINAL): TypeIndex;
  VAR h : INTEGER;
  BEGIN
    h := SigHead(name);
    WHILE (h # -1) & (i > 0) DO h := params[h].next; DEC(i) END;
    IF h = -1 THEN RETURN InvalidType END;
    RETURN params[h].typ
  END ParamType;

PROCEDURE ParamIsVar (name: ARRAY OF CHAR; i: CARDINAL): BOOLEAN;
  VAR h : INTEGER;
  BEGIN
    h := SigHead(name);
    WHILE (h # -1) & (i > 0) DO h := params[h].next; DEC(i) END;
    IF h = -1 THEN RETURN FALSE END;
    RETURN params[h].isVar
  END ParamIsVar;

PROCEDURE NumHead (num: INTEGER): INTEGER;
(* Param list head by number: define list if present, else forward. *)
  BEGIN
    IF (num < 1) OR (num > VAL(INTEGER, nProcs)) THEN RETURN -1 END;
    IF procs[num].dHead # -1 THEN RETURN procs[num].dHead END;
    RETURN procs[num].fHead
  END NumHead;

PROCEDURE ProcValid (num: INTEGER): BOOLEAN;
  BEGIN
    RETURN (num >= 1) & (num <= VAL(INTEGER, nProcs))
  END ProcValid;

PROCEDURE ProcNParByNum (num: INTEGER): CARDINAL;
  VAR h : INTEGER;
    c : CARDINAL;
  BEGIN
    h := NumHead(num); c := 0;
    WHILE h # -1 DO INC(c); h := params[h].next END;
    RETURN c
  END ProcNParByNum;

PROCEDURE ParamTypeByNum (num: INTEGER; i: CARDINAL): TypeIndex;
  VAR h : INTEGER;
  BEGIN
    h := NumHead(num);
    WHILE (h # -1) & (i > 0) DO h := params[h].next; DEC(i) END;
    IF h = -1 THEN RETURN InvalidType END;
    RETURN params[h].typ
  END ParamTypeByNum;

PROCEDURE ParamIsVarByNum (num: INTEGER; i: CARDINAL): BOOLEAN;
  VAR h : INTEGER;
  BEGIN
    h := NumHead(num);
    WHILE (h # -1) & (i > 0) DO h := params[h].next; DEC(i) END;
    IF h = -1 THEN RETURN FALSE END;
    RETURN params[h].isVar
  END ParamIsVarByNum;

PROCEDURE ProcRetByNum (num: INTEGER): TypeIndex;
  BEGIN
    IF ~ProcValid(num) THEN RETURN InvalidType END;
    RETURN procs[num].ret
  END ProcRetByNum;

PROCEDURE SymSlot (name: ARRAY OF CHAR): INTEGER;
  VAR idx : INTEGER;
  BEGIN
    idx := Find(name);
    IF idx = -1 THEN RETURN NoSlot END;
    RETURN syms[idx].slot
  END SymSlot;

PROCEDURE SymDepth (name: ARRAY OF CHAR): INTEGER;
  VAR idx : INTEGER;
  BEGIN
    idx := Find(name);
    IF idx = -1 THEN RETURN 0 END;
    RETURN VAL(INTEGER, syms[idx].pdep)
  END SymDepth;

PROCEDURE CurDepth (): INTEGER;
  BEGIN
    RETURN VAL(INTEGER, pdep)
  END CurDepth;

PROCEDURE CurProc (): INTEGER;
  BEGIN
    RETURN curProc
  END CurProc;

PROCEDURE CurNPar (): CARDINAL;
  BEGIN
    RETURN parCnt[pdep]
  END CurNPar;

PROCEDURE CurRet (): TypeIndex;
  BEGIN
    IF pdep = 0 THEN RETURN InvalidType END;
    RETURN retSt[pdep]
  END CurRet;

PROCEDURE InProc (): BOOLEAN;
  BEGIN
    RETURN pdep > 0
  END InProc;

PROCEDURE InFunction (): BOOLEAN;
  BEGIN
    RETURN (pdep > 0) & (retSt[pdep] # InvalidType)
  END InFunction;

PROCEDURE ProcNLocals (): CARDINAL;
  BEGIN
    IF pdep = 0 THEN RETURN 0 END;
    RETURN locCnt[pdep]
  END ProcNLocals;

(* ---------------- init ---------------- *)

PROCEDURE Predef (name: ARRAY OF CHAR; kind: INTEGER; t: TypeIndex);
  BEGIN
    IF Enter(name, kind) THEN SetSymType(name, t) END
  END Predef;

PROCEDURE Init;
  BEGIN
    nSyms := 0; curLev := 0; mtop := 0;
    nPend := 0; nPendF := 0;
    nTypes := 0; nFields := 0;
    nProcs := 0; nParams := 0;
    pdep := 0; curProc := 0;
    modTop := 0; nExps := 0;
    nDefs := 0; defMark := 0; curDef := -1;
    nImps := 0; progDone := FALSE;
    procSt[0] := 0; locCnt[0] := 0; parCnt[0] := 0;
    retSt[0] := InvalidType;
    dInt := NewDesc(FInt, InvalidType);
    dCard := NewDesc(FInt, InvalidType);
    dReal := NewDesc(FReal, InvalidType);
    dChar := NewDesc(FChar, InvalidType);
    dBool := NewDesc(FBool, InvalidType);
    tLo[dChar] := 0; tHi[dChar] := 255;
    tLo[dBool] := 0; tHi[dBool] := 1;
    Predef("INTEGER", KindPredef, dInt);
    Predef("CARDINAL", KindPredef, dCard);
    Predef("SHORTINT", KindPredef, dInt);
    Predef("LONGINT", KindPredef, dInt);
    Predef("REAL", KindPredef, dReal);
    Predef("LONGREAL", KindPredef, dReal);
    Predef("CHAR", KindPredef, dChar);
    Predef("BOOLEAN", KindPredef, dBool);
    Predef("TRUE", KindConst, dBool);
    Predef("FALSE", KindConst, dBool);
    Predef("NIL", KindConst, InvalidType)
  END Init;

(* ---------------- listing ---------------- *)

PROCEDURE WriteKind (kind: INTEGER);
  BEGIN
    CASE kind OF
      KindConst  : FileIO.WriteString(FileIO.StdOut, "CONST")
    | KindType   : FileIO.WriteString(FileIO.StdOut, "TYPE")
    | KindVar    : FileIO.WriteString(FileIO.StdOut, "VAR")
    | KindImport : FileIO.WriteString(FileIO.StdOut, "IMPORT")
    | KindModule : FileIO.WriteString(FileIO.StdOut, "MODULE")
    | KindPredef : FileIO.WriteString(FileIO.StdOut, "PREDEF")
    | KindField  : FileIO.WriteString(FileIO.StdOut, "FIELD")
    ELSE FileIO.WriteString(FileIO.StdOut, "???")
    END
  END WriteKind;

PROCEDURE PrintTable;
  VAR i : CARDINAL;
  BEGIN
    FileIO.WriteLn(FileIO.StdOut);
    FileIO.WriteString(FileIO.StdOut, "--- Symbol table ---");
    FileIO.WriteLn(FileIO.StdOut);
    i := 0;
    WHILE i < nSyms DO
      FileIO.WriteString(FileIO.StdOut, "  ");
      FileIO.WriteString(FileIO.StdOut, syms[i].name);
      FileIO.WriteString(FileIO.StdOut, " : ");
      WriteKind(syms[i].kind);
      FileIO.WriteString(FileIO.StdOut, " #");
      FileIO.WriteInt(FileIO.StdOut, syms[i].typ, 1);
      FileIO.WriteLn(FileIO.StdOut);
      INC(i)
    END
  END PrintTable;

BEGIN
  Init
END SymTab.