(* Copyright (C) 1992, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* File: Type.m3                                               *)
(* Last Modified On Tue Sep 15 15:04:35 PDT 1992 by rustan     *)
(*      Modified On Tue May 12 08:06:26 PDT 1992 by kalsow     *)
(*      Modified On Fri Feb  8 02:12:46 1991 by muller         *)
 
UNSAFE MODULE Type EXPORTS Type, TypeRep;

IMPORT Error, Token, Scanner, NamedType, Void, Frame, Word, FPrint;
IMPORT ArrayType, PackedType, EnumType, ObjectType, RefType, Addr, Host;
IMPORT ProcType, UserProc, RecordType, SetType, SubrangeType, OpaqueType;
IMPORT Value, String, Scope, Emit, Field, Expr, Temp, MBuf, Module, Reff;
IMPORT TrOffsets, ParamCode;

REVEAL
  Assumption = UNTRACED BRANDED "Type.Assumption" REF AssumptionRec;

TYPE
  AssumptionRec = RECORD
    prev : Assumption;
    a, b : T;
  END;

TYPE Map = BRANDED "Type.Map" REF ARRAY OF MapCell;
TYPE MapCell = REF RECORD next: MapCell;  type: T;  value: INTEGER END;

TYPE
  Header = REF RECORD
    next    : Header;
    type    : T;
    fp_data : INTEGER;
  END;

VAR nTypes       : INTEGER := 0;
VAR all_types    : T := NIL;
VAR first_header : Header := NIL;
VAR last_header  : Header := NIL;
VAR next_fp_data : INTEGER := 0;
VAR imports      : Map := NIL;
VAR compiled     : Map := NIL;

(************************************************************************)

PROCEDURE Initialize () =
  BEGIN
    UserProc.Initialize ();
  END Initialize;

PROCEDURE Reset () =
  VAR t: T;
  BEGIN
    recursionDepth := 0;
    next_fp_data := 0;
    imports := NIL;
    compiled := NIL;
    first_header := NIL;
    last_header := NIL;
    t := all_types;
    WHILE (t # NIL) DO
      t.imported := NOT Host.emitBuiltins;  (*HACK!*)
      t.errored  := FALSE;
      t := t.next;
    END;
  END Reset;

(************************************************************************)

PROCEDURE Parse (READONLY fail: Token.Set): T =
  TYPE TK = Token.T;
  VAR t: T;
  BEGIN
    CASE Scanner.cur.token OF
    | TK.tIDENT     => t := NamedType.Parse (fail);
    | TK.tARRAY     => t := ArrayType.Parse (fail);
    | TK.tBITS      => t := PackedType.Parse (fail);
    | TK.tBRANDED   => t := RefType.Parse (fail);
    | TK.tLBRACE    => t := EnumType.Parse (fail);
    | TK.tUNTRACED  => t := RefType.Parse (fail);
    | TK.tOBJECT    => t := ObjectType.Parse (NIL, TRUE, NIL, fail);
    | TK.tPROCEDURE => t := ProcType.Parse (fail);
    | TK.tRECORD    => t := RecordType.Parse (fail);
    | TK.tREF       => t := RefType.Parse (fail);
    | TK.tSET       => t := SetType.Parse (fail);
    | TK.tLBRACKET  => t := SubrangeType.Parse (fail);
    | TK.tLPAREN =>
        Scanner.GetToken (); (* ( *)
        t := Parse (fail + Token.Set {TK.tRPAREN});
        Scanner.Match1 (TK.tRPAREN, fail);
        IF (Scanner.cur.token = TK.tBRANDED) THEN
          t := ObjectType.Parse (t, FALSE, RefType.ParseBrand (fail), fail);
        ELSIF (Scanner.cur.token = TK.tOBJECT) THEN
          t := ObjectType.Parse (t, FALSE, NIL, fail);
        END;
    ELSE
        Scanner.Fail ("bad type expression", fail);
	t := NIL;
    END;
    RETURN t;
  END Parse;

PROCEDURE NoteDeclaration (t: T;  decl: Value.T) =
  BEGIN
    IF (t = NIL) THEN RETURN  END;
    IF (t.declared = NIL) THEN t.declared := decl END;
  END NoteDeclaration;

PROCEDURE Init (t: T) =
  BEGIN
    <* ASSERT t # NIL *>
    t.origin      := Scanner.offset;
    t.declared    := NIL;
    t.hash        := 0;
    t.fp          := 0;
    t.checked     := FALSE;
    t.isTraced    := FALSE;
    t.hasUntraced := FALSE;
    t.isLocalOnly := FALSE;
    t.inCheck     := FALSE;
    t.inSize      := FALSE;
    t.inMinSize   := FALSE;
    t.inAlignment := FALSE;
    t.inIsEmpty   := FALSE;
    t.inNumber    := FALSE;
    t.inGetBounds := FALSE;
    t.errored     := FALSE;
    t.imported    := (Module.depth # 1);
    t.next        := all_types;   all_types := t;
    INC (nTypes);
  END Init;

(************************************************************************)

PROCEDURE Check (t: T) =
  VAR save: INTEGER;  old: BOOLEAN;
  BEGIN
    IF (t = NIL) THEN RETURN END;
    IF (t.checked) THEN RETURN END;
    (** IF (t.inCheck) THEN IllegalRecursion (t); RETURN END; **)
    save := Scanner.offset;
    Scanner.offset := t.origin;
    old := t.inCheck;
    t.inCheck := TRUE;
    t.check ();
    t.inCheck := old (*FALSE*);
    t.checked := TRUE;
    Scanner.offset := save;
  END Check;

PROCEDURE Strip (t: T): T =
  VAR u: T;
  BEGIN
    IF (t = NIL) THEN RETURN NIL END;
    IF (t.inStrip) THEN
      IllegalRecursion (t);
      RETURN t;
    END;
    t.inStrip := TRUE;
    u := t.stripper ();
    t.inStrip := FALSE;
    RETURN u;
  END Strip;

PROCEDURE Base (t: T): T =
  VAR u: T;
  BEGIN
    IF (t = NIL) THEN RETURN NIL END;
    IF (t.inStrip) THEN  IllegalRecursion (t); RETURN t;  END;
    t.inStrip := TRUE;
    u := t.base ();
    t.inStrip := FALSE;
    RETURN u;
  END Base;

PROCEDURE Size (t: T): INTEGER =
  VAR u: INTEGER;
  BEGIN
    IF (t = NIL) THEN RETURN 0 END;
    IF (t.inSize) THEN  IllegalRecursion (t); RETURN 0;  END;
    t.inSize := TRUE;
    u := t.size ();
    t.inSize := FALSE;
    RETURN u;
  END Size;

PROCEDURE MinSize (t: T): INTEGER =
  VAR u: INTEGER;
  BEGIN
    IF (t = NIL) THEN RETURN 0 END;
    IF (t.inMinSize) THEN  IllegalRecursion (t); RETURN 0;  END;
    t.inMinSize := TRUE;
    u := t.minSize ();
    t.inMinSize := FALSE;
    RETURN u;
  END MinSize;

PROCEDURE Alignment (t: T): INTEGER =
  VAR u: INTEGER;
  BEGIN
    IF (t = NIL) THEN RETURN 1 END;
    IF (t.inAlignment) THEN  IllegalRecursion (t); RETURN 1;  END;
    t.inAlignment := TRUE;
    u := t.alignment ();
    t.inAlignment := FALSE;
    RETURN u;
  END Alignment;

PROCEDURE IsEmpty (t: T): BOOLEAN =
  VAR u: BOOLEAN;
  BEGIN
    IF (t = NIL) THEN RETURN TRUE END;
    IF (t.inIsEmpty) THEN  IllegalRecursion (t); RETURN TRUE;  END;
    t.inIsEmpty := TRUE;
    u := t.isEmpty ();
    t.inIsEmpty := FALSE;
    RETURN u;
  END IsEmpty;

PROCEDURE DependsOn (a, b: T): BOOLEAN =
  VAR x: BOOLEAN;
  BEGIN
    IF (a = NIL) OR (b = NIL) THEN RETURN FALSE END;
    a := Strip (a);
    b := Strip (b);
    <* ASSERT a.checked AND b.checked *>
    IF a.inDependsOn THEN RETURN FALSE END;
    IF IsEqual (a, b, NIL) THEN RETURN TRUE END;
    a.inDependsOn := TRUE;
    x := a.dependsOn (b);
    a.inDependsOn := FALSE;
    RETURN x;
  END DependsOn;

PROCEDURE Number (t: T): INTEGER =
  VAR u: INTEGER;
  BEGIN
    IF (t = NIL) THEN RETURN 0 END;
    IF (t.inNumber) THEN  IllegalRecursion (t); RETURN 0;  END;
    t.inNumber := TRUE;
    u := t.count ();
    t.inNumber := FALSE;
    RETURN u;
  END Number;

PROCEDURE GetBounds (t: T;  VAR min, max: INTEGER): BOOLEAN =
  VAR u: BOOLEAN;
  BEGIN
    IF (t = NIL) THEN RETURN FALSE; END;
    IF (t.inGetBounds) THEN  IllegalRecursion (t); RETURN FALSE;  END;
    t.inGetBounds := TRUE;
    u := t.bounds (min, max);
    t.inGetBounds := FALSE;
    RETURN u;
  END GetBounds;

PROCEDURE IsTraced (t: T): BOOLEAN =
  BEGIN
    IF (t = NIL) THEN RETURN FALSE END;
    t := Strip (t);
    IF (t.checked) THEN
      RETURN t.isTraced;
    ELSIF (t.inCheck) THEN
      Check (t);  (* maybe the recursion is legal... *)
      RETURN t.isTraced;
      (********
      IllegalRecursion (t);
      RETURN FALSE;
      **********)
    ELSE
      <* ASSERT FALSE *>
      (* RETURN FALSE; *)
    END;
  END IsTraced;

PROCEDURE HasUntraced (t: T): BOOLEAN =
  BEGIN
    IF (t = NIL) THEN RETURN FALSE END;
    t := Strip (t);
    IF (t.checked) THEN
      RETURN t.hasUntraced;
    ELSIF (t.inCheck) THEN
      Check (t);  (* maybe the recursion is legal... *)
      RETURN t.hasUntraced;
      (********
      IllegalRecursion (t);
      RETURN FALSE;
      **********)
    ELSE
      <* ASSERT FALSE *>
      (* RETURN FALSE; *)
    END;
  END HasUntraced;

PROCEDURE IsLocalOnly (t: T): BOOLEAN =
  BEGIN
    IF (t = NIL) THEN RETURN FALSE END;
    t := Strip (t);
    IF (t.checked) THEN
      RETURN t.isLocalOnly;
    ELSIF (t.inCheck) THEN
      Check (t);  (* maybe the recursion is legal... *)
      RETURN t.isLocalOnly;
      (********
      IllegalRecursion (t);
      RETURN FALSE;
      **********)
    ELSE
      <* ASSERT FALSE *>
      (* RETURN FALSE; *)
    END;
  END IsLocalOnly;

PROCEDURE ParamEncoding (t: T): TEXT =
  BEGIN
    IF t = NIL THEN RETURN ParamCode.None END;
    Check( t );
    RETURN t.paramEncoding()
  END ParamEncoding;

PROCEDURE IllegalRecursion (t: T) =
  VAR name: String.QID;  v: Value.T;
  BEGIN
    IF (t.errored) THEN
      (* don't emit multiple errors *)
    ELSIF (t.declared # NIL) THEN
      Value.IllegalRecursion (t.declared);
    ELSIF NamedType.SplitV (t, v) THEN
      Value.IllegalRecursion (v);
    ELSIF NamedType.Split (t, name) THEN
      Error.QID (name, "illegal recursive type declaration");
    ELSE
      Error.Msg ("illegal recursive type declaration");
    END;
    t.errored := TRUE;
  END IllegalRecursion;

(************************************************************************)

PROCEDURE IsEqual (a, b: T;  x: Assumption): BOOLEAN =
  VAR assume: AssumptionRec;  y: Assumption;
  BEGIN
    IF (a = b) THEN RETURN TRUE END;
    IF (a = NIL) THEN a := Void.T END;
    IF (b = NIL) THEN b := Void.T END;
    a := Strip (a);
    b := Strip (b);
    IF (a = b) THEN RETURN TRUE END;
    <* ASSERT a.checked *>
    <* ASSERT b.checked *>

    IF (a.hash # b.hash) THEN RETURN FALSE; END;
    IF (a.fp # 0) AND (a.fp = b.fp) THEN RETURN TRUE END;

    (* search the existing list of assumptions *)
    y := x;
    WHILE (y # NIL) DO
      IF (y.a = a) THEN
        IF (y.b = b) THEN RETURN TRUE END;
      ELSIF (y.a = b) THEN
        IF (y.b = a) THEN RETURN TRUE END;
      END;
      y := y.prev;
    END;

    (* add a new assumption *)
    assume.prev := x;
    assume.a := a;
    assume.b := b;
    y := ADR (assume);

    RETURN a.isEqual (b, y);
  END IsEqual;

(************************************************************************)

PROCEDURE Name (t: T): INTEGER =
  VAR wr: MBuf.T;  fp: FPrint.T;  u: T;
  BEGIN
    IF (t = NIL) THEN t := Void.T END;
    IF (t.fp = 0) THEN
      u := Strip (t);
      <* ASSERT u.checked *>
      IF (u.fp = 0) THEN
        wr := MBuf.New ();
        Fingerprint (u, NIL, wr);
        fp := MBuf.ToFPrint (wr);
        u.fp := Word.Xor (fp[0], fp[1]);
      END;
      IF (t # u) THEN t.fp := u.fp END;
    END;
    RETURN t.fp;
  END Name;

PROCEDURE IsSubtype (a, b: T): BOOLEAN =
  BEGIN
    IF (a = b) THEN RETURN TRUE END;
    IF (a = NIL) THEN a := Void.T END;
    IF (b = NIL) THEN b := Void.T END;
    a := Strip (a);
    b := Strip (b);
    <* ASSERT a.checked AND b.checked *>
    a := PackedType.Strip (a);
    b := PackedType.Strip (b);
    <* ASSERT a.checked AND b.checked *>
    RETURN IsEqual (a, b, NIL)
        OR a.isSubtype (b)
        OR OpaqueType.IsSubtype (a, b);
  END IsSubtype;

PROCEDURE IsNetworkType (t: T): BOOLEAN =
  BEGIN
    IF t = NIL THEN RETURN FALSE END;
    t := Strip( t );
    RETURN t.isNetworkType()
  END IsNetworkType;

PROCEDURE IsAssignable (a, b: T): BOOLEAN =
  VAR i, e: T;
  BEGIN
    IF (a = b) THEN RETURN TRUE END;
    IF (a = NIL) THEN a := Void.T END;
    IF (b = NIL) THEN b := Void.T END;
    a := Strip (a);
    b := Strip (b);
    <* ASSERT a.checked AND b.checked *>

    IF IsEqual (a, b, NIL) OR IsSubtype (b, a) THEN
      RETURN TRUE;
    ELSIF (Number (a) >= 0) THEN
      (* ordinal types:  OK if there is a common supertype *)
      RETURN IsSubtype (b, Base (a));
    ELSIF IsSubtype (a, b) THEN
      (* may be ok, but must narrow rhs before doing the assignment *)
      RETURN IsSubtype (b, Reff.T)
          OR ArrayType.Split (b, i, e)
          OR (IsSubtype (b, Addr.T)
              AND (NOT Module.IsSafe() OR NOT IsEqual (b, Addr.T, NIL)));
    ELSE
      RETURN FALSE;
    END;
  END IsAssignable;

PROCEDURE Compile (t: T) =
  VAR save: INTEGER;  stream: Emit.Stream;
  BEGIN
    IF (t = NIL) THEN t := Void.T END;
    <* ASSERT t.checked *>
    IF (compiled = NIL) THEN compiled := NewMap () END;
    IF NOT MapGet (compiled, t, save) THEN
      stream := Emit.Switch (Emit.Stream.TypeDecls);
      save := Scanner.offset;
      Scanner.offset := t.origin;
      t.compile ();
      Scanner.offset := save;
      EVAL Emit.Switch (stream);
      EVAL MapPut (compiled, t, 1);
    END;
  END Compile;

PROCEDURE IsCompiled (t: T): BOOLEAN =
  VAR i: INTEGER;
  BEGIN
    RETURN MapGet (compiled, t, i);
  END IsCompiled;

PROCEDURE MarkCompiled (t: T) =
  BEGIN
    EVAL MapPut (compiled, t, 1);
  END MarkCompiled;

PROCEDURE InitCost (t: T;  ifZeroed: BOOLEAN): INTEGER =
  BEGIN
    IF (t = NIL) THEN t := Void.T END;
    <* ASSERT t.checked *>
    RETURN t.initCost (ifZeroed);
  END InitCost;

PROCEDURE GenInitialValue (t: T) =
  BEGIN
    IF (t = NIL) THEN t := Void.T END;
    <* ASSERT t.checked *>
    t.initValue ();
  END GenInitialValue;

PROCEDURE TracedOffsets (t: T;  offset: CARDINAL := 0): TrOffsets.T =
  BEGIN
    IF t = NIL THEN t := Void.T END;
    <* ASSERT t.checked *>
    RETURN t.tracedOffs (offset)
  END TracedOffsets;

PROCEDURE GenMap (t: T;  VAR prefix: String.Stack) =
  BEGIN
    IF (t = NIL) THEN t := Void.T END;
    <* ASSERT t.checked *>
    t.mapper (prefix);
  END GenMap;

PROCEDURE ExternalDecl (t: T): Value.T =
  VAR v: Value.T;
  BEGIN
    IF (t = NIL) THEN RETURN NIL END;
    <* ASSERT t.checked *>
    v := t.declared;
    IF Value.IsImported (v) THEN RETURN v END;
    RETURN NIL;
  END ExternalDecl;

PROCEDURE BuildImportMap () =
  VAR t := all_types;
  BEGIN
    imports := NewMap ();
    WHILE (t # NIL) DO
      IF (t.imported) AND (t.checked) THEN EVAL MapPut (imports, t, 1) END;
      t := t.next;
    END;
  END BuildImportMap;

PROCEDURE StartLinkInfo (t: T): BOOLEAN =
  CONST fmt = ARRAY BOOLEAN OF TEXT { "\n\nu@", "\n\nt@" };
  VAR
    wr: MBuf.T;
    fp: FPrint.T;
    map: FPMap;
    info: Header;
    local: BOOLEAN;
    junk: INTEGER;
  BEGIN
    <* ASSERT t.checked *>

    IF (imports = NIL) THEN BuildImportMap () END;
    local := (NOT t.imported) AND (NOT MapGet (imports, t, junk));

    IF (local) THEN
      (* generate the link info for the C file *)
      info := NEW (Header);
      IF (first_header = NIL)
        THEN first_header := info;
        ELSE last_header.next := info;
      END;
      last_header := info;
      info.next    := NIL;
      info.type    := t;
      info.fp_data := next_fp_data;
      IF NOT OpaqueType.Is (t) THEN
        EVAL Emit.Switch (Emit.Stream.TypeFPs);
(********************************* KRML
        IF (next_fp_data = 0) THEN
          Emit.Op ("_PRIVATE int _fp_data[] = {\n");
        END;
******************************* KRML *)
        wr := MBuf.New ();
        map := NEW (FPMap, deep := FALSE, cnt := 0, list := NEW (TypeVec, 20));
        t.fprint (map, wr);
        fp := MBuf.ToFPrint (wr);
(********************************* KRML
        Emit.OpHH ("  0x@, 0x@,", fp[0], fp[1]);
        EndLine (t, TRUE);
        FOR i := 0 TO map.cnt-1 DO
          IF (i MOD 10) = 0 THEN
            IF (i # 0) THEN Emit.Op ("\n") END;
            Emit.Op ("   ");
          END;
          Emit.OpH (" 0x@,", Name (map.list[i]));
        END;
        IF (map.cnt # 0) THEN Emit.Op ("\n") END;
******************************* KRML *)
        INC (next_fp_data, 2 + map.cnt);
      END;
    END;

    (* write the linker info *)
    EVAL Emit.Switch (Emit.Stream.LinkerTypes);
    Emit.OpF (fmt [local], t);
    Emit.OpI (" @\n", ORD (t.class()));
    IF (t.declared # NIL) THEN
      Emit.Op ("N");
      Scope.GenName (t.declared, dots := TRUE);
      Emit.Op ("\n");
    END;

    RETURN NOT local;
  END StartLinkInfo;

PROCEDURE GenLinkerInfo () =
  (******************** KRML
  VAR x: Header; save: Emit.Stream;  c: Class;  t: T;
      xx, n: INTEGER;
  ****************** KRML *)
  BEGIN
(********************************** KRML
    save := Emit.Switch (Emit.Stream.TypeFPs);

    IF (next_fp_data = 0)
      THEN Emit.Op ("\003#define _fp_data 0\n");
      ELSE Emit.Op ("  0\n};\n");
    END;

    EVAL Emit.Switch (Emit.Stream.LinkTables);

    IF (first_header = NIL) THEN
      Emit.Op ("\003#define _type_info 0\n");
    ELSE
      Emit.Op ("_PRIVATE _TYPE_INFO _type_info [] = {\n");
      x := first_header;
      WHILE (x # NIL) DO
        t := x.type;
        c := t.class ();
        Emit.OpH ("  { 0x@, 0, 0, ", Name (t));
        IF (x.next = NIL) THEN xx :=next_fp_data ELSE xx := x.next.fp_data END;
        IF (c = Class.Opaque)
          THEN Emit.OpF  ("(int* )&@_TC, 0, ", t);
          ELSE Emit.OpII ("_fp_data + @, @, ", x.fp_data, xx - x.fp_data);
        END;
        Emit.OpI ("0, @ },", ORD (c));
        EndLine (t);
        x := x.next;
      END;
      Emit.Op ("  { 0, 0, 0, 0, 0, 0, 0 }\n};\n");
    END;

    x := first_header;  n := 0;
    WHILE (x # NIL) DO
      t := x.type;
      c := t.class ();
      IF (c = Class.Ref) OR (c = Class.Object) THEN
        IF (n = 0) THEN Emit.Op ("_PRIVATE _TYPE* _type_cells [] = {\n") END;
        Emit.OpF ("  &@_tc,", t);
        EndLine (t);
        INC (n);
      END;
      x := x.next;
    END;
    IF (n = 0)
      THEN
           Emit.Op ("\003#define _type_cells 0\n");
      ELSE Emit.Op ("  0\n};\n");
    END;

    EVAL Emit.Switch (save);
********************************* KRML *)
  END GenLinkerInfo;

(********************************** KRML
PROCEDURE EndLine (t: T;  withUID := FALSE) =
  BEGIN
    Emit.Op (" \t/* ");
    IF (withUID) THEN Emit.OpF ("@ ", t) END;
    IF (t.declared # NIL) THEN Scope.GenName (t.declared, dots := TRUE) END;
    Emit.Op  (" */\n");
  END EndLine;
******************************** KRML *)

(************************* fingerprints **********************************)

TYPE TypeVec = REF ARRAY OF T;
REVEAL
  FPMap = BRANDED REF RECORD
    deep : BOOLEAN;
    cnt  : INTEGER;
    elts : Map;
    list : TypeVec;
  END;

PROCEDURE Fingerprint (t: T;  map: FPMap;  wr: MBuf.T) =
  VAR x: INTEGER;
  BEGIN
    IF (map = NIL) THEN
      map := NEW (FPMap, deep := TRUE, cnt := 0, elts := NewMap ());
    END;
    IF (map.deep) THEN
      IF (t = NIL) THEN MBuf.PutText (wr, "()"); RETURN  END;
      <* ASSERT t.checked *>
      t := Strip (t);
      IF MapGet (map.elts, t, x) THEN
        MBuf.PutText (wr, "(t");
        MBuf.PutInt  (wr, x);
        MBuf.PutText (wr, ")");
      ELSE
        INC (map.cnt);
        EVAL MapPut (map.elts, t, map.cnt);
        MBuf.PutText (wr, "(t");
        MBuf.PutInt  (wr, map.cnt);
        MBuf.PutText (wr, " ");
        t.fprint (map, wr);
        MBuf.PutText (wr, ")");
      END;
    ELSE (* NOT deep *)
      IF (t = NIL) THEN RETURN END;
      <* ASSERT t.checked *>
      t := Strip (t);
      IF (map.cnt >= NUMBER (map.list^)) THEN ExpandList (map) END;
      map.list[map.cnt] := t;
      INC (map.cnt);
      MBuf.PutText (wr, "*");
    END;
  END Fingerprint;

PROCEDURE ExpandList (map: FPMap) =
  VAR new := NEW (TypeVec, 2 * NUMBER (map.list^));
  BEGIN
    FOR i := 0 TO LAST (map.list^) DO new[i] := map.list[i] END;
    map.list := new;
  END ExpandList;

(************************* type maps *************************************)

PROCEDURE NewMap (): Map =
  VAR m: Map;  n := 17;
  BEGIN
    WHILE (2*n < nTypes) DO n := n * 3 END;
    m := NEW (Map, n);
    RETURN m;
  END NewMap;

PROCEDURE MapGet (m: Map;  t: T;  VAR v: INTEGER): BOOLEAN =
  VAR x: INTEGER;  l: MapCell;
  BEGIN
    IF (t = NIL) THEN RETURN FALSE END;
    <* ASSERT t.checked *>
    t := Strip (t);
    x := t.hash MOD NUMBER (m^);
    l := m[x];
    WHILE (l # NIL) DO
      IF IsEqual (l.type, t, NIL) THEN  v := l.value; RETURN TRUE  END;
      l := l.next;
    END;
    RETURN FALSE;
  END MapGet;

PROCEDURE MapPut (m: Map;  t: T;  v: INTEGER): BOOLEAN =
  VAR x: INTEGER;  l: MapCell;
  BEGIN
    IF (t = NIL) THEN RETURN FALSE END;
    <* ASSERT t.checked *>
    t := Strip (t);
    x := t.hash MOD NUMBER (m^);
    l := m[x];
    WHILE (l # NIL) DO
      IF IsEqual (l.type, t, NIL) THEN  l.value := v; RETURN TRUE  END;
      l := l.next;
    END;
    m[x] := NEW (MapCell, next := m[x], type := t, value := v);
    RETURN FALSE;
  END MapPut;

(********************** variable initialization **************************)

PROCEDURE InitVariable (t: T;  zeroed: BOOLEAN;   VAR prefix: String.Stack) =
  BEGIN
    IF (t = NIL) THEN RETURN END;
    <* ASSERT t.checked *>
    InitVar (t, zeroed, prefix);
    Temp.KillValues ();
  END InitVariable;

PROCEDURE InitVar (tt: T;  zeroed: BOOLEAN;  VAR ss: String.Stack) =
  VAR index, element: T;  fields: Scope.T;  c1, c2: INTEGER;
  BEGIN
    tt := Strip (tt);
    c1 := InitCost (tt, FALSE);
    c2 := InitCost (tt, TRUE);
    IF (c1 = 0) THEN
      (* no initialization is required *)
    ELSIF (zeroed) AND (c2 = 0) THEN
      (* no more initialization is required *)
    ELSIF (NOT zeroed) AND ((c2 = 0) OR ((c1 - c2) >= 5)) THEN
      (* we should zero the variable *)
      ZeroVar (tt, ss);
      InitVar (tt, TRUE, ss);
    ELSIF RecordType.Split (tt, fields) THEN
      InitRecord (tt, fields, zeroed, ss);
    ELSIF ArrayType.Split (tt, index, element) THEN
      InitArray (index, element, zeroed, ss);
    ELSE (* must be a scalar type *)
      Emit.OpZ ("@ = ", ss);
      tt.initValue ();
      Emit.Op (";\n");
    END;
  END InitVar;

PROCEDURE InitRecord (tt: T;  fields: Scope.T;
                      zeroed: BOOLEAN;   VAR ss: String.Stack) =
  VAR
    j, n: INTEGER;
    flist: Scope.ValueList;
    field: Value.T;
    e: Expr.T;
    t: Temp.T;
  BEGIN
    ss.stk[ss.top] := String.Add (".");
    INC (ss.top, 2);
    Scope.ToList (fields, flist, n);
    FOR i := 0 TO n - 1 DO
      field := flist[i];
      ss.stk[ss.top - 1] := Value.CName (field);
      e := Field.GetDefault (field);
      IF e = NIL THEN
        Field.SplitX (field, j, tt);
        InitVar (tt, zeroed, ss);
      ELSE
        t := Expr.Compile (e);
        Emit.OpZ ("@ = ", ss);
        Emit.OpT ("@;\n;", t);
        Temp.Free (t);
      END;
    END;
    DEC (ss.top, 2);
  END InitRecord;

PROCEDURE InitArray (index, element: T;
                     zeroed: BOOLEAN; VAR ss: String.Stack) =
  VAR loopVar: String.T;  block: INTEGER;
  BEGIN
    IF index # NIL THEN
      loopVar := String.Unique (String.Add ("_init"));
      ss.stk[ss.top] := String.Add (".elts[");  INC (ss.top);
      ss.stk[ss.top] := loopVar;                INC (ss.top);
      ss.stk[ss.top] := String.Add ("]");       INC (ss.top);
      Frame.PushBlock (block, 1);
      Emit.OpS ("register int @;\n", loopVar);
      Emit.OpS ("for (@ = 0; ", loopVar);
      Emit.OpSI ("@ < @; ", loopVar, Number (index));
      Emit.OpS ("@ ++) {\001\n", loopVar);
      InitVar (element, zeroed, ss);
      Emit.Op ("\002}\n");
      Frame.PopBlock (block);
      DEC (ss.top, 3);
    END;
  END InitArray;

PROCEDURE ZeroVar (tt: T;  READONLY ss: String.Stack) =
  BEGIN
    Emit.Zero (tt, ss);
  END ZeroVar;

(************************** default methods *******************************)

PROCEDURE MissingCheck (<*UNUSED*> t: TT) =
 BEGIN <* ASSERT FALSE *> END MissingCheck;

PROCEDURE MissingEqCheck (<*UNUSED*> a, b: TT;
 <*UNUSED*> x: Assumption): BOOLEAN =
 BEGIN <* ASSERT FALSE *> END MissingEqCheck;

PROCEDURE MissingSize (<*UNUSED*> t: TT): INTEGER =
 BEGIN <* ASSERT FALSE *> END MissingSize;

PROCEDURE MissingEmpty (<*UNUSED*> t: TT): BOOLEAN =
 BEGIN <* ASSERT FALSE *> END MissingEmpty;

PROCEDURE MissingDepends (<*UNUSED*> a, b: TT): BOOLEAN =
 BEGIN <* ASSERT FALSE *> END MissingDepends;

PROCEDURE MissingCompile (<*UNUSED*> t: TT) =
 BEGIN <* ASSERT FALSE *> END MissingCompile;

PROCEDURE MissingInitCost (<*UNUSED*> t: TT;
 <*UNUSED*> zeroed: BOOLEAN): INTEGER =
 BEGIN <* ASSERT FALSE *> END MissingInitCost;

PROCEDURE MissingInitValue (<*UNUSED*> t: TT) =
 BEGIN <* ASSERT FALSE *> END MissingInitValue;

PROCEDURE MissingFPrint (<*UNUSED*> t: TT;  <*UNUSED*> map: FPMap;
 <*UNUSED*> wr: MBuf.T) =
 BEGIN <* ASSERT FALSE *> END MissingFPrint;

PROCEDURE MissingClass (<*UNUSED*> t: TT): Class =
 BEGIN <* ASSERT FALSE *> END MissingClass;

PROCEDURE SelfBase (t: T): T =
  BEGIN
    (* the type is it's own base type *)
    RETURN t;
  END SelfBase;

PROCEDURE NeverEqual (a, b: TT;  <*UNUSED*> x: Assumption): BOOLEAN =
  BEGIN
    <* ASSERT a # b *>
    RETURN FALSE;
  END NeverEqual;

PROCEDURE NoSubtypes (<*UNUSED*> a, b: T): BOOLEAN =
  BEGIN
    (* a is not a subtype of any type b *)
    RETURN FALSE;
  END NoSubtypes;

PROCEDURE NotNetworkType (<*UNUSED*> t: TT): BOOLEAN =
  BEGIN
    RETURN FALSE
  END NotNetworkType;

PROCEDURE DependsOnNone (<*UNUSED*> a, b: TT): BOOLEAN =
  BEGIN
    (* b doesn't need to be compiled before a *)
    RETURN FALSE;
  END DependsOnNone;

PROCEDURE NotOrdinal (<*UNUSED*> t: T): INTEGER =
  BEGIN
    (* t is not an ordinal type => has no number of elements *)
    RETURN  -1;
  END NotOrdinal;

PROCEDURE IsAlways (<*UNUSED*> t: T): BOOLEAN =
  BEGIN
    RETURN TRUE;
  END IsAlways;

PROCEDURE IsNever (<*UNUSED*> t: T): BOOLEAN =
  BEGIN
    RETURN FALSE;
  END IsNever;

PROCEDURE NotBounded (<*UNUSED*> t: T; VAR min, max: INTEGER): BOOLEAN =
  BEGIN
    min := 0; max := -1;
    RETURN FALSE;
  END NotBounded;

PROCEDURE NoMapper (<*UNUSED*> t: T;  <*UNUSED*> VAR prefix: String.Stack) =
  BEGIN
  END NoMapper;

PROCEDURE NotTraced (<*UNUSED*>t: TT;  <*UNUSED*> offset: CARDINAL)
    : TrOffsets.T =
  BEGIN
    RETURN NIL
  END NotTraced;

PROCEDURE WordEncoding (<*UNUSED*>t: TT): TEXT =
  BEGIN
    RETURN ParamCode.Word
  END WordEncoding;

PROCEDURE ParamEncUndefined (<*UNUSED*>t: TT): TEXT =
  BEGIN
    <* ASSERT FALSE *>
  END ParamEncUndefined;

PROCEDURE GenRefMap (t: T;  VAR prefix: String.Stack) =
  CONST Traced = ARRAY BOOLEAN OF TEXT{"UNTRACED", "TRACED"};
  VAR traced := Traced[t.isTraced];
  BEGIN
    Emit.OpX ("if (_MASK_@ (_mask)) ", traced);
    Emit.OpZ ("_p (_arg, &(@), ", prefix);
    Emit.OpX ("_r, _VAL_@);\n", traced);
  END GenRefMap;

BEGIN
END Type.