m3front/src/misc/CG.m3


Copyright (C) 1994, Digital Equipment Corp.
 File: CG.m3                                                 

MODULE CG;

IMPORT Text, IntIntTbl, IntRefTbl, Fmt, Word;
IMPORT Scanner, Error, Module, Runtime, WebInfo;
IMPORT M3, M3CG, M3CG_Ops, M3CG_Check;
IMPORT Host, Target, TInt, TFloat, TWord, TargetMap, M3RT (**, RTObject **);

CONST
  Max_init_chars = 256; (* max size of a single init_chars string *)

REVEAL
  Val = BRANDED "CG.Val" REF ValRec;

TYPE
  VKind = {      (* TYPE   VALUE                 *)
    Integer,     (* Int    int                   *)
    Float,       (* Float  float                 *)
    Stacked,     (* any    S0.type               *)
    Direct,      (* any    MEM(ADR(base) + OFFS) *)
    Absolute,    (* Addr   ADR(base) + OFFS      *)
    Indirect,    (* Addr   MEM(base) + OFFS      *)
    Pointer      (* Addr   S0.A + OFFS           *)
  }; (* where OFFS == offset + MEM(bits)         *)

TYPE
  ValRec = RECORD
    kind      : VKind;        (* type of descriptor *)
    type      : Type;         (* type of the value *)
    temp_base : BOOLEAN;      (* TRUE => base is a temp. *)
    temp_bits : BOOLEAN;      (* TRUE => bits is a temp. *)
    align     : Alignment;    (* assumed alignment of base address *)
    base      : Var;          (* base address *)
    bits      : Var;          (* non-constant bit offset *)
    offset    : INTEGER;      (* constant bit offset *)
    next      : Val;          (* link for lists *)
    int       : Target.Int;   (* literal integer value *)
    float     : Target.Float; (* literal floating point value *)
  END;

TYPE
  TempWrapper = REF RECORD
    next   : TempWrapper;
    temp   : Var;
    size   : Size;
    align  : Alignment;
    type   : Type;
    in_mem : BOOLEAN;
    block  : INTEGER;
  END;

TYPE
  Node = OBJECT
    next : Node;
    (** file : String.T;**)
    (** line : INTEGER; **)
    o    : Offset;
  METHODS
    dump();
  END;

TYPE
  FloatNode   = Node OBJECT f: Target.Float OVERRIDES dump := DumpFloat END;
  CharsNode   = Node OBJECT t: TEXT  OVERRIDES dump := DumpChars END;
  ProcNode    = Node OBJECT v: Proc OVERRIDES dump := DumpProc END;
  LabelNode   = Node OBJECT v: Label OVERRIDES dump := DumpLabel END;
  VarNode     = Node OBJECT v: Var;  b: Offset OVERRIDES dump := DumpVar END;
  OffsetNode  = Node OBJECT v: Var;  OVERRIDES dump := DumpOffset END;
  CommentNode = Node OBJECT a, b, c, d: TEXT OVERRIDES dump := DumpComment END;
  IntNode     = Node OBJECT s: Size; v: Target.Int OVERRIDES dump := DumpInt END;
  FieldNode   = Node OBJECT n: Name; s: Size; t: TypeUID OVERRIDES dump := DumpField END;

VAR
  cg_wr       : M3CG.T      := NIL;
  cg_check    : M3CG.T      := NIL;
  cg          : M3CG.T      := NIL;
  last_offset : INTEGER     := -2;
  last_file   : TEXT        := NIL;
  last_line   : INTEGER     := -2;
  pending     : Node        := NIL;
  fields      : Node        := NIL;
  in_init     : BOOLEAN     := FALSE;
  init_pc     : INTEGER     := 0;
  init_bits   : Target.Int  := TInt.Zero;
  free_temps  : TempWrapper := NIL;
  busy_temps  : TempWrapper := NIL;
  free_values : Val         := NIL;
  busy_values : Val         := NIL;
  indirects   : IntIntTbl.T := NIL;
  variables   : IntRefTbl.T := NIL;
  procedures  : IntRefTbl.T := NIL;
  block_cnt   : INTEGER     := 0;
  tos         : CARDINAL    := 0;  (* top-of-stack *)
  stack       : ARRAY [0..99] OF ValRec;
---------------------------------------------------------------------------

PROCEDURE Init () =
  BEGIN
    Max_alignment := Target.Alignments [LAST (Target.Alignments)];

    cg_wr := Host.env.init_code_generator ();
    IF (cg_wr = NIL) THEN
      Error.Msg ("unable to create a code generator");
      RETURN;
    END;
    (** RTObject.PatchMethods (cg_wr); **)

    cg_check := M3CG_Check.New (cg_wr,
                                clean_jumps  := Host.clean_jumps,
                                clean_stores := Host.clean_stores,
                                nested_calls := Host.nested_calls,
                                nested_procs := Host.inline_nested_procs);
    (** RTObject.PatchMethods (cg_check); **)
    cg := cg_check;

    cg.set_error_handler (Error.Msg);

    last_offset := -2;
    last_file   := NIL;
    last_line   := -2;
    pending     := NIL;
    fields      := NIL;
    in_init     := FALSE;
    init_pc     := 0;
    init_bits   := TInt.Zero;
    free_temps  := NIL;
    busy_temps  := NIL;
    free_values := NIL;
    busy_values := NIL;
    indirects   := NIL;
    variables   := NIL;
    procedures  := NIL;
    block_cnt   := 0;
    tos         := 0;
  END Init;
----------------------------------------------------------- ID counters ---

PROCEDURE Next_label (n_labels := 1): Label =
  BEGIN
    RETURN cg.next_label (n_labels);
  END Next_label;
----------------------------------------------------- compilation units ---

PROCEDURE Begin_unit (optimize: INTEGER := 0) =
  BEGIN
    cg.begin_unit (optimize);
  END Begin_unit;

PROCEDURE End_unit () =
  BEGIN
    Free_all_values ();
    Free_all_temps ();
    cg.end_unit ();
  END End_unit;

PROCEDURE Import_unit (n: Name) =
  BEGIN
    cg.import_unit (n);
    WebInfo.Import_unit (n);
  END Import_unit;

PROCEDURE Export_unit (n: Name) =
  BEGIN
    cg.export_unit (n);
    WebInfo.Export_unit (n);
  END Export_unit;
------------------------------------------------ debugging line numbers ---

PROCEDURE Gen_location (here: INTEGER) =
  VAR file: TEXT;  save, line: INTEGER;
  BEGIN
    IF (here = last_offset) THEN RETURN END;

    save := Scanner.offset;
    Scanner.offset := here;
    Scanner.LocalHere (file, line);

    IF (last_file = NIL) OR NOT Text.Equal (last_file, file) THEN
      cg.set_source_file (file);
      last_file := file;
    END;

    IF (last_line # line) THEN
      cg.set_source_line (line);
      last_line := line;
    END;

    Scanner.offset := save;
    last_offset := here;
  END Gen_location;
------------------------------------------- debugging type declarations ---

PROCEDURE Declare_typename (t: TypeUID;  n: Name) =
  BEGIN
    cg.declare_typename (t, n);
  END Declare_typename;

PROCEDURE Declare_array (t: TypeUID;  index, elt: TypeUID;  s: Size) =
  BEGIN
    cg.declare_array (t, index, elt, s);
    WebInfo.Declare_array (t, index, elt, s);
  END Declare_array;

PROCEDURE Declare_open_array (t: TypeUID;  elt: TypeUID;  s: Size) =
  BEGIN
    cg.declare_open_array (t, elt, s);
    WebInfo.Declare_open_array (t, elt, s);
  END Declare_open_array;

PROCEDURE Declare_enum (t: TypeUID;  n_elts: INTEGER;  s: Size) =
  BEGIN
    cg.declare_enum (t, n_elts, s);
    WebInfo.Declare_enum (t, n_elts, s);
  END Declare_enum;

PROCEDURE Declare_enum_elt (n: Name) =
  BEGIN
    cg.declare_enum_elt (n);
    WebInfo.Declare_enum_elt (n);
  END Declare_enum_elt;

PROCEDURE Declare_packed (t: TypeUID;  s: Size;  base: TypeUID) =
  BEGIN
    cg.declare_packed (t, s, base);
    WebInfo.Declare_packed (t, s, base);
  END Declare_packed;

PROCEDURE Declare_record (t: TypeUID;  s: Size;  n_fields: INTEGER) =
  BEGIN
    cg.declare_record (t, s, n_fields);
    WebInfo.Declare_record (t, s, n_fields);
  END Declare_record;

PROCEDURE Declare_field (n: Name;  o: Offset;  s: Size;  t: TypeUID) =
  BEGIN
    cg.declare_field (n, o, s, t);
    WebInfo.Declare_field (n, o, s, t);
  END Declare_field;

PROCEDURE Declare_set (t, domain: TypeUID;  s: Size) =
  BEGIN
    cg.declare_set (t, domain, s);
    WebInfo.Declare_set (t, domain, s);
  END Declare_set;

PROCEDURE Declare_subrange (t, domain: TypeUID;  READONLY min, max: Target.Int;
                                                 s: Size) =
  BEGIN
    cg.declare_subrange (t, domain, min, max, s);
    WebInfo.Declare_subrange (t, domain, min, max, s);
  END Declare_subrange;

PROCEDURE Declare_pointer (t, target: TypeUID;  brand: TEXT;  traced: BOOLEAN)=
  BEGIN
    cg.declare_pointer (t, target, brand, traced);
    WebInfo.Declare_pointer (t, target, brand, traced);
  END Declare_pointer;

PROCEDURE Declare_indirect (target: TypeUID): TypeUID =
  VAR x: INTEGER;
  BEGIN
    IF (indirects = NIL) THEN indirects := NewIntTbl () END;
    IF NOT indirects.get (target, x) THEN
      x := Word.Not (target);  (* !! fingerprint HACK !! *)
      cg.declare_indirect (x, target);
      WebInfo.Declare_indirect (x, target);
      EVAL indirects.put (target, x);
    END;
    RETURN x;
  END Declare_indirect;

PROCEDURE Declare_proctype (t: TypeUID;  n_formals: INTEGER;
                            result: TypeUID;  n_raises: INTEGER;
                            cc: CallingConvention) =
  BEGIN
    cg.declare_proctype (t, n_formals, result, n_raises, cc);
    WebInfo.Declare_proctype (t, n_formals, result, n_raises);
  END Declare_proctype;

PROCEDURE Declare_formal (n: Name;  t: TypeUID) =
  BEGIN
    cg.declare_formal (n, t);
    WebInfo.Declare_formal (n, t);
  END Declare_formal;

PROCEDURE Declare_raises (n: Name) =
  BEGIN
    cg.declare_raises (n);
    WebInfo.Declare_raises (n);
  END Declare_raises;

PROCEDURE Declare_object (t, super: TypeUID;  brand: TEXT;  traced: BOOLEAN;
                           n_fields, n_methods, n_overrides: INTEGER;
                           field_size: Size) =
  BEGIN
    cg.declare_object (t, super, brand, traced,
                       n_fields, n_methods, field_size);
    WebInfo.Declare_object (t, super, brand, traced,
                            n_fields, n_methods, n_overrides, field_size);
  END Declare_object;

PROCEDURE Declare_method (n: Name;  signature: TypeUID;  dfault: M3.Expr) =
  BEGIN
    cg.declare_method (n, signature);
    WebInfo.Declare_method (n, signature, dfault);
  END Declare_method;

PROCEDURE Declare_override (n: Name;  dfault: M3.Expr) =
  BEGIN
    WebInfo.Declare_override (n, dfault);
  END Declare_override;

PROCEDURE Declare_opaque (t, super: TypeUID) =
  BEGIN
    cg.declare_opaque (t, super);
    WebInfo.Declare_opaque (t, super);
  END Declare_opaque;

PROCEDURE Reveal_opaque (lhs, rhs: TypeUID) =
  BEGIN
    cg.reveal_opaque (lhs, rhs);
    WebInfo.Reveal_opaque (lhs, rhs);
  END Reveal_opaque;

PROCEDURE Declare_global_field (n: Name;  o: Offset;  s: Size;  t: TypeUID) =
  BEGIN
    fields := NEW (FieldNode, next := fields, n := n, o := o, s := s, t := t);
  END Declare_global_field;

PROCEDURE DumpField (x: FieldNode) =
  BEGIN
    (* DumpNode (x);  -- no file & line number info *)
    cg.declare_field (x.n, x.o, x.s, x.t);
  END DumpField;

PROCEDURE Emit_global_record (s: Size) =
  VAR n := fields;  cnt := 0;  xx: REF ARRAY OF Node;
  BEGIN
    (* build a sorted array of fields *)
    WHILE (n # NIL) DO INC (cnt);  n := n.next END;
    xx := NEW (REF ARRAY OF Node, cnt);
    n := fields;  cnt := 0;
    WHILE (n # NIL) DO xx[cnt] := n;  INC (cnt);  n := n.next;  END;
    SortNodes (xx^);

    (* finally, declare the record *)
    cg.declare_record (-1, s, NUMBER (xx^));
    FOR i := 0 TO LAST (xx^) DO  xx[i].dump () END;
    fields := NIL;
  END Emit_global_record;

PROCEDURE Declare_exception (n: Name;  arg_type: TypeUID;
                           raise_proc: BOOLEAN;  base: Var;  offset: INTEGER) =
  BEGIN
    cg.declare_exception (n, arg_type, raise_proc, base, ToBytes (offset));
  END Declare_exception;
--------------------------------------------------------- runtime hooks ---

PROCEDURE Set_runtime_proc (n: Name;  p: Proc) =
  BEGIN
    cg.set_runtime_proc (n, p);
  END Set_runtime_proc;

PROCEDURE Set_runtime_hook (n: Name;  v: Var;  o: Offset) =
  BEGIN
    cg.set_runtime_hook (n, v, AsBytes (o));
  END Set_runtime_hook;

PROCEDURE Get_runtime_hook (n: Name;  VAR p: Proc;  VAR v: Var;  VAR o: Offset) =
  BEGIN
    cg.get_runtime_hook (n, p, v, o);
    o := o * Target.Byte; (* bytes back to bits... *)
  END Get_runtime_hook;
------------------------------------------------- variable declarations ---

PROCEDURE Import_global (n: Name;  s: Size;  a: Alignment;  t: Type;
                         m3t: TypeUID): Var =
  VAR ref: REFANY;  v: Var;
  BEGIN
    IF (variables = NIL) THEN variables := NewNameTbl () END;
    IF variables.get (n, ref) THEN RETURN ref END;
    v := cg.import_global (n, ToVarSize (s, a), FixAlign (a), t, m3t);
    EVAL variables.put (n, v);
    RETURN v;
  END Import_global;

PROCEDURE Declare_segment (n: Name;  m3t: TypeUID): Var =
  BEGIN
    RETURN cg.declare_segment (n, m3t);
  END Declare_segment;

PROCEDURE Bind_segment (seg: Var;  s: Size;  a: Alignment;  t: Type;
                        exported, init: BOOLEAN) =
  BEGIN
    cg.bind_segment (seg, ToVarSize (s, a), FixAlign (a), t, exported, init);
    IF (init) THEN
      Begin_init (seg);
      DumpPendingNodes ();
      End_init (seg);
    END;
  END Bind_segment;

PROCEDURE Declare_global (n: Name;  s: Size;  a: Alignment;  t: Type;
                          m3t: TypeUID;  exported, init: BOOLEAN): Var =
  BEGIN
    RETURN cg.declare_global (n, ToVarSize (s, a), FixAlign (a),
                              t, m3t, exported, init);
  END Declare_global;

PROCEDURE Declare_constant (n: Name;  s: Size;  a: Alignment;  t: Type;
                            m3t: TypeUID;  exported, init: BOOLEAN): Var =
  BEGIN
    RETURN cg.declare_constant (n, ToVarSize (s, a), FixAlign (a),
                                t, m3t, exported, init);
  END Declare_constant;

PROCEDURE Declare_local (n: Name;  s: Size;  a: Alignment;  t: Type;
                         m3t: TypeUID;  in_memory, up_level: BOOLEAN;
                         f: Frequency): Var =
  BEGIN
    RETURN cg.declare_local (n, ToVarSize (s, a), FixAlign (a),
                             t, m3t, in_memory, up_level, f);
  END Declare_local;

PROCEDURE Declare_param (n: Name;  s: Size;  a: Alignment;  t: Type;
                         m3t: TypeUID;  in_memory, up_level: BOOLEAN;
                         f: Frequency): Var =
  BEGIN
    RETURN cg.declare_param (n, ToVarSize (s, a), FixAlign (a),
                             t, m3t, in_memory, up_level, f);
  END Declare_param;
----------------------------------------------------------- temporaries ---

PROCEDURE Declare_temp (s: Size;  a: Alignment;  t: Type;
                          in_memory: BOOLEAN): Var =
  VAR w := free_temps;  last_w: TempWrapper := NIL;  tmp: Var;
  BEGIN
    LOOP
      IF (w = NIL) THEN
        (* we need to allocate a fresh one *)
        tmp := cg.declare_temp (ToVarSize (s, a), FixAlign (a), t, in_memory);
        busy_temps := NEW (TempWrapper, size := s, align := a, type := t,
                           in_mem := in_memory, temp := tmp,
                           block := block_cnt, next := busy_temps);
        RETURN tmp;
      ELSIF (w.size = s) AND (w.align = a) AND (w.type = t) AND
        (w.in_mem = in_memory) THEN
        (* we found a match *)
        IF (last_w = NIL)
          THEN free_temps := w.next;
          ELSE last_w.next := w.next;
        END;
        w.next := busy_temps;  busy_temps := w;
        RETURN w.temp;
      ELSE
        (* try the next one *)
        last_w := w;
        w := w.next;
      END;
    END;
  END Declare_temp;

PROCEDURE Free_temp (<*UNUSED*> v: Var) =
  BEGIN
  END Free_temp;

PROCEDURE Free_temps () =
  VAR w := busy_temps;
  BEGIN
    SEmpty ("Free_temps");
    IF (w # NIL) THEN
      WHILE (w.next # NIL) DO  w := w.next;  END;
      w.next := free_temps;
      free_temps := busy_temps;
      busy_temps := NIL;
    END;
  END Free_temps;
***** PROCEDURE Free_one_temp (v: Var) = VAR w := busy_temps; last_w : TempWrapper := NIL; BEGIN LOOP IF (w = NIL) THEN Error.Msg (); (* missing wrapper!
Err ("missing temp wrapper");
        cg.free_temp (v);
        RETURN;
      ELSIF (w.temp = v) THEN
        (* we found the match *)
        IF (last_w = NIL)
          THEN busy_temps := w.next;
          ELSE last_w.next := w.next;
        END;
        w.next := free_temps;  free_temps := w;
        RETURN;
      ELSE
        (* try the next one *)
        last_w := w;
        w := w.next;
      END;
    END;
  END Free_one_temp;
*********)

PROCEDURE Free_all_temps () =
  VAR w: TempWrapper;
  BEGIN
    Free_temps ();
    <*ASSERT busy_temps = NIL*>
    w := free_temps;
    WHILE (w # NIL) DO
      cg.free_temp (w.temp);
      w := w.next;
    END;
    free_temps := NIL;
  END Free_all_temps;

PROCEDURE Free_block_temps (block: INTEGER) =
  VAR w, prev_w: TempWrapper;
  BEGIN
    Free_temps ();
    <*ASSERT busy_temps = NIL*>
    w := free_temps;  prev_w := NIL;
    WHILE (w # NIL) DO
      IF (w.block = block) THEN
        cg.free_temp (w.temp);
        IF (prev_w # NIL)
          THEN  prev_w.next := w.next;
          ELSE  free_temps := w.next;
        END;
      END;
      w := w.next;
    END;
  END Free_block_temps;
--------------------------------------------- direct stack manipulation ---

PROCEDURE Pop (): Val =
  VAR z: Var;  v: Val;
  BEGIN
    (* get a free value *)
    v := free_values;
    IF (v = NIL)
      THEN v := NEW (Val);
      ELSE free_values := v.next;
    END;

    (* fill it in *)
    WITH x = stack [SCheck (1, "Pop")] DO
      v^ := x;
    END;
    SPop (1, "Pop");

    (* mark it as busy *)
    v.next := busy_values;
    busy_values := v;

    (* make sure it's not bound to the M3CG stack *)
    IF (v.kind = VKind.Stacked) THEN
      z := Declare_temp (TargetMap.CG_Size [v.type], TargetMap.CG_Align [v.type],
                         v.type, in_memory := FALSE);
      cg.store (z, 0, v.type);
      v.kind      := VKind.Direct;
      v.temp_base := TRUE;
      v.temp_bits := FALSE;
      v.align     := TargetMap.CG_Align [v.type];
      v.base      := z;
      v.bits      := NIL;
      v.offset    := 0;

    ELSIF (v.kind = VKind.Pointer) THEN
      z := Declare_temp (Target.Address.size, Target.Address.align,
                         Type.Addr, in_memory := FALSE);
      cg.store (z, 0, Type.Addr);

      v.kind      := VKind.Indirect;
      v.type      := Type.Addr;
      v.temp_base := TRUE;
      v.temp_bits := FALSE;
      v.base      := z;
      v.bits      := NIL;
    END;

    RETURN v;
  END Pop;

PROCEDURE Pop_temp (): Val =
  BEGIN
    Force ();
    RETURN Pop ();
  END Pop_temp;

PROCEDURE Push (v: Val) =
  BEGIN
    WITH x = stack [SCheck (0, "Push")] DO
      x := v^;
      x.temp_base := FALSE;
      x.temp_bits := FALSE;
      x.next      := NIL;
    END;
    INC (tos);
  END Push;

PROCEDURE Store_temp (v: Val) =
  BEGIN
    <*ASSERT v.kind = VKind.Direct  AND  v.offset = 0 *>
    Store (v.base, 0, TargetMap.CG_Size[v.type], TargetMap.CG_Align[v.type], v.type);
  END Store_temp;

PROCEDURE Free (v: Val) =
  VAR x := busy_values;  last_x: Val := NIL;
  BEGIN
    (* remove 'v' from the busy list *)
    LOOP
      IF (x = NIL) THEN
        Err ("non-busy value freed");
        EXIT;
      ELSIF (x = v) THEN
        (* we found the match *)
        IF (last_x = NIL)
          THEN busy_values := v.next;
          ELSE last_x.next := v.next;
        END;
        v.next := free_values;  free_values := v;
        EXIT;
      ELSE
        last_x := x;
        x := x.next;
      END;
    END;

    (* finally, free the temps *)
    Release_temps (v^);
  END Free;

PROCEDURE Free_all_values () =
  BEGIN
    WHILE (busy_values # NIL) DO  Free (busy_values); END;
  END Free_all_values;

PROCEDURE XForce () =
  (* force the value enough so that we can do a simple indirect load/store *)
  VAR offs: INTEGER;
  BEGIN
    WITH x = stack [SCheck (1, "XForce")] DO
      IF (x.kind = VKind.Direct) THEN
        Force ();
      ELSIF (x.kind = VKind.Indirect) THEN
        offs := x.offset;  x.offset := 0;
        Force ();
        x.offset := offs;
      END;
    END;
  END XForce;

PROCEDURE Force () =
  BEGIN
    WITH x = stack [SCheck (1, "Force")] DO

      (* force the value on the stack *)
      CASE (x.kind) OF

      | VKind.Integer =>
          cg.load_integer (x.int);
          x.type := Type.Int;

      | VKind.Float =>
          cg.load_float (x.float);
          x.type := TargetMap.Float_types [TFloat.Prec (x.float)].cg_type;

      | VKind.Stacked =>
          (* value is already on the stack *)

      | VKind.Direct =>
          Force_align (x);
          cg.load (x.base, AsBytes (x.offset), x.type);
          IF (x.bits # NIL) THEN
            Err ("attempt to force a direct bit-level address...");
          END;

      | VKind.Absolute =>
          Force_align (x);
          cg.load_address (x.base, AsBytes (x.offset));
          Force_LValue (x);

      | VKind.Indirect =>
          Force_align (x);
          cg.load  (x.base, 0, Type.Addr);
          IF (x.offset # 0) THEN cg.add_offset (AsBytes (x.offset)) END;
          Force_LValue (x);

      | VKind.Pointer =>
          Force_align (x);
          IF (x.offset # 0) THEN cg.add_offset (AsBytes (x.offset)) END;
          Force_LValue (x);

      END;

      (* free any temps that we used *)
      Release_temps (x);

      (* finish the descriptor *)
      x.kind      := VKind.Stacked;
      x.type      := TargetMap.CG_Base [x.type];
      x.offset    := 0;
      x.next      := NIL;
      (** x.align     := TargetMap.CG_Align [x.type];
        --- we're not changing the alignment of this value **)
    END;
  END Force;

PROCEDURE Force_align (VAR x: ValRec) =
  BEGIN
    x.align := LV_align (x);
    IF (x.align MOD Target.Byte) # 0 THEN
      Err ("address is not byte-aligned");
    END;
  END Force_align;

PROCEDURE Force_LValue (VAR x: ValRec) =
  BEGIN
    x.type := Type.Addr;
    IF (x.bits # NIL) THEN
      Err ("attempt to force a bit-level L-value...");
    END;
  END Force_LValue;

PROCEDURE Release_temps (VAR x: ValRec) =
  BEGIN
    IF (x.temp_base) THEN Free_temp (x.base); END;
    IF (x.temp_bits) THEN Free_temp (x.bits); END;
    x.temp_base := FALSE;
    x.temp_bits := FALSE;
    x.base      := NIL;
    x.bits      := NIL;
  END Release_temps;

PROCEDURE Force1 (tag: TEXT) =
  BEGIN
    Force ();
    SPop (1, tag);
  END Force1;

PROCEDURE Force2 (tag: TEXT;  commute: BOOLEAN): BOOLEAN =
  VAR swapped := Force_pair (commute);
  BEGIN
    SPop (2, tag);
    RETURN swapped;
  END Force2;
---------------------------------------- static variable initialization ---

PROCEDURE Begin_init (v: Var) =
  BEGIN
    cg.begin_init (v);
    in_init := TRUE;
    init_pc := 0;
    init_bits := TInt.Zero;
  END Begin_init;

PROCEDURE End_init (v: Var) =
  BEGIN
    AdvanceInit (init_pc + Target.Byte - 1); (* flush any pending bits *)
    cg.end_init (v);
    in_init := FALSE;
  END End_init;

PROCEDURE DumpPendingNodes () =
  VAR n := pending;  cnt := 0;  xx: REF ARRAY OF Node;
  BEGIN
    WHILE (n # NIL) DO INC (cnt);  n := n.next END;
    xx := NEW (REF ARRAY OF Node, cnt);
    n := pending;  cnt := 0;
    WHILE (n # NIL) DO xx[cnt] := n;  INC (cnt);  n := n.next;  END;
    SortNodes (xx^);
    FOR i := 0 TO LAST (xx^) DO  xx[i].dump () END;
    pending := NIL;
  END DumpPendingNodes;

PROCEDURE SortNodes (VAR x: ARRAY OF Node) =
  BEGIN
    QuickSort (x, 0, NUMBER (x));
    InsertionSort (x, 0, NUMBER (x));
  END SortNodes;

PROCEDURE QuickSort (VAR a: ARRAY OF Node;  lo, hi: INTEGER) =
  CONST CutOff = 9;
  VAR i, j: INTEGER;  key, tmp: Node;
  BEGIN
    WHILE (hi - lo > CutOff) DO (* sort a[lo..hi) *)

      (* use median-of-3 to select a key *)
      i := (hi + lo) DIV 2;
      IF (a[lo].o < a[i].o) THEN
        IF (a[i].o < a[hi-1].o) THEN
	  key := a[i];
        ELSIF (a[lo].o < a[hi-1].o) THEN
          key := a[hi-1];  a[hi-1] := a[i];  a[i] := key;
        ELSE
	  key := a[lo];  a[lo] := a[hi-1];  a[hi-1] := a[i];  a[i] := key;
        END;
      ELSE
        IF (a[hi-1].o < a[i].o) THEN
	  key := a[i];  tmp := a[hi-1];  a[hi-1] := a[lo];  a[lo] := tmp;
        ELSIF (a[lo].o < a[hi-1].o) THEN
	  key := a[lo];  a[lo] := a[i];  a[i] := key;
        ELSE
	  key := a[hi-1];  a[hi-1] := a[lo];  a[lo] := a[i];  a[i] := key;
        END;
      END;

      (* partition the array *)
      i := lo+1;  j := hi-2;

      (* find the first hole *)
      WHILE (a[j].o > key.o) DO DEC (j) END;
      tmp := a[j];
      DEC (j);

      LOOP
        IF (i > j) THEN EXIT END;

        WHILE (a[i].o < key.o) DO INC (i) END;
        IF (i > j) THEN EXIT END;
        a[j+1] := a[i];
        INC (i);

        WHILE (a[j].o > key.o) DO DEC (j) END;
        IF (i > j) THEN  IF (j = i-1) THEN  DEC (j)  END;  EXIT  END;
        a[i-1] := a[j];
        DEC (j);
      END;

      (* fill in the last hole *)
      a[j+1] := tmp;
      i := j+2;

      (* then, recursively sort the smaller subfile *)
      IF (i - lo < hi - i)
        THEN  QuickSort (a, lo, i-1);   lo := i;
        ELSE  QuickSort (a, i, hi);     hi := i-1;
      END;

    END; (* WHILE (hi-lo > CutOff) *)
  END QuickSort;

PROCEDURE InsertionSort (VAR a: ARRAY OF Node;  lo, hi: INTEGER) =
  VAR j: INTEGER;  key: Node;
  BEGIN
    FOR i := lo+1 TO hi-1 DO
      key := a[i];
      j := i-1;
      WHILE (j >= lo) AND (key.o < a[j].o) DO
        a[j+1] := a[j];
        DEC (j);
      END;
      a[j+1] := key;
    END;
  END InsertionSort;

PROCEDURE PushPending (n: Node) =
  BEGIN
    (** n.file := last_file; **)
    (** n.line := last_line; **)
    n.next := pending;
    pending := n;
  END PushPending;

PROCEDURE DumpNode (<*UNUSED*> n: Node) =
  BEGIN
    (******
    IF (last_file # n.file) THEN
      cg.set_source_file (n.file);
      last_file := n.file;
    END;
    IF (last_line # n.line) THEN
      cg.set_source_line (n.line);
      last_line := n.line;
    END;
    *******)
  END DumpNode;

PROCEDURE AdvanceInit (o: Offset) =
  VAR
    n_bytes := (o - init_pc) DIV Target.Byte;
    base, n_bits, tmp, new_bits: Target.Int;
    b_size: INTEGER;
    t: Type;
  BEGIN
    <*ASSERT n_bytes >= 0*>
    <*ASSERT in_init*>
    WHILE (n_bytes > 0) DO
      IF TInt.EQ (init_bits, TInt.Zero) THEN
        (* no more bits to flush *)
        n_bytes := 0;
        init_pc := (o DIV Target.Byte) * Target.Byte;
      ELSE
        (* send out some number of bytes *)
        EVAL FindInitType (n_bytes, init_pc, t);
        b_size := TargetMap.CG_Bytes[t];
        IF (b_size = Target.Integer.bytes) THEN
          cg.init_int (init_pc DIV Target.Byte, init_bits, t);
          init_bits := TInt.Zero;
        ELSIF Target.Little_endian
          AND TInt.FromInt (b_size * Target.Byte, base)
          AND TInt.FromInt (Target.Integer.size - b_size*Target.Byte, n_bits)
          AND TWord.Extract (init_bits, TInt.Zero, base, tmp)
          AND TWord.Extract (init_bits, base, n_bits, new_bits) THEN
          cg.init_int (init_pc DIV Target.Byte, tmp, t);
          init_bits := new_bits;
        ELSIF (NOT Target.Little_endian)
          AND TInt.FromInt (Target.Integer.size - b_size * Target.Byte, base)
          AND TInt.FromInt (b_size*Target.Byte, n_bits)
          AND TWord.Extract (init_bits, base, n_bits, tmp) THEN
          TWord.Shift (init_bits, n_bits, new_bits);
          cg.init_int (init_pc DIV Target.Byte, tmp, t);
          init_bits := new_bits;
        ELSE
          Err ("unable to convert or initialize bit field value??");
          <*ASSERT FALSE*>
        END;
        DEC (n_bytes, TargetMap.CG_Bytes[t]);
        INC (init_pc, TargetMap.CG_Size[t]);
      END;
    END;
  END AdvanceInit;

PROCEDURE FindInitType (n_bytes, offset: INTEGER;  VAR t: Type): BOOLEAN =
  BEGIN
    FOR i := LAST (TargetMap.Int_types) TO FIRST (TargetMap.Int_types) BY -1 DO
      IF (TargetMap.Int_types[i].bytes <= n_bytes)
        AND (offset MOD TargetMap.Int_types[i].align = 0) THEN
        t := TargetMap.Int_types[i].cg_type;
        RETURN TRUE;
      END;
    END;
    ErrI (n_bytes, "cg: unable to find suitable target machine type");
    t := Type.Void;
    RETURN FALSE;
  END FindInitType;

PROCEDURE Init_int (o: Offset;  s: Size;  READONLY value: Target.Int) =
  VAR bit_offset: INTEGER;  itype: Type;  base, n_bits, tmp: Target.Int;
  BEGIN
    IF (NOT in_init) THEN
      PushPending (NEW (IntNode, o := o, s := s, v := value));
      RETURN;
    END;

    AdvanceInit (o);
    IF Target.Little_endian
      THEN bit_offset := o - init_pc;
      ELSE bit_offset := Target.Integer.size - (o - init_pc) - s;
    END;

    IF (o = init_pc)
      AND (s >= Target.Byte)
      AND (FindInitType (s DIV Target.Byte, init_pc, itype))
      AND (TargetMap.CG_Size[itype] = s) THEN
      (* simple, aligned integer initialization *)
      cg.init_int (o DIV Target.Byte, value, itype);
    ELSIF TInt.FromInt (bit_offset, base)
      AND TInt.FromInt (s, n_bits)
      AND TWord.Insert (init_bits, value, base, n_bits, tmp) THEN
      init_bits := tmp;
    ELSE
      Err ("unable to stuff bit field value??");
      <*ASSERT FALSE*>
    END;
  END Init_int;

PROCEDURE Init_intt (o: Offset;  s: Size;  value: INTEGER) =
  VAR val: Target.Int;  b := TInt.FromInt (value, val);
  BEGIN
    IF NOT b THEN ErrI (value, "integer const not representable") END;
    Init_int (o, s, val);
  END Init_intt;

PROCEDURE DumpInt (x: IntNode) =
  BEGIN
    DumpNode (x);
    Init_int (x.o, x.s, x.v);
  END DumpInt;

PROCEDURE Init_proc (o: Offset;  value: Proc) =
  BEGIN
    IF (in_init) THEN
      AdvanceInit (o);
      <*ASSERT o = init_pc*>
      <*ASSERT o MOD Target.Address.align = 0 *>
      cg.init_proc (AsBytes (o), value);
    ELSE
      PushPending (NEW (ProcNode, o := o, v := value));
    END;
  END Init_proc;

PROCEDURE DumpProc (x: ProcNode) =
  BEGIN
    DumpNode (x);
    Init_proc (x.o, x.v);
  END DumpProc;

PROCEDURE Init_label (o: Offset;  value: Label) =
  BEGIN
    IF (in_init) THEN
      AdvanceInit (o);
      <*ASSERT o = init_pc*>
      <*ASSERT o MOD Target.Address.align = 0 *>
      cg.init_label (AsBytes (o), value);
    ELSE
      PushPending (NEW (LabelNode, o := o, v := value));
    END;
  END Init_label;

PROCEDURE DumpLabel (x: LabelNode) =
  BEGIN
    DumpNode (x);
    Init_label (x.o, x.v);
  END DumpLabel;

PROCEDURE Init_var (o: Offset;  value: Var;  bias: Offset) =
  BEGIN
    IF (in_init) THEN
      AdvanceInit (o);
      <*ASSERT o = init_pc*>
      <*ASSERT o MOD Target.Address.align = 0 *>
      <*ASSERT bias MOD Target.Byte = 0*>
      cg.init_var (AsBytes (o), value, AsBytes (bias));
    ELSE
      PushPending (NEW (VarNode, o := o, v := value, b := bias));
    END;
  END Init_var;

PROCEDURE DumpVar (x: VarNode) =
  BEGIN
    DumpNode (x);
    Init_var (x.o, x.v, x.b);
  END DumpVar;

PROCEDURE Init_offset (o: Offset;  value: Var) =
  BEGIN
    IF (in_init) THEN
      AdvanceInit (o);
      <*ASSERT o = init_pc*>
      <*ASSERT o MOD Target.Integer.align = 0 *>
      cg.init_offset (AsBytes (o), value);
    ELSE
      PushPending (NEW (OffsetNode, o := o, v := value));
    END;
  END Init_offset;

PROCEDURE DumpOffset (x: OffsetNode) =
  BEGIN
    DumpNode (x);
    Init_offset (x.o, x.v);
  END DumpOffset;

PROCEDURE Init_chars (o: Offset;  value: TEXT) =
  VAR len, start: INTEGER;
  BEGIN
    IF (in_init) THEN
      AdvanceInit (o);
      <*ASSERT o = init_pc*>
      <*ASSERT o MOD Target.Char.align = 0 *>
      start := 0;
      len := Text.Length (value);
      WHILE (len - start > Max_init_chars) DO
        cg.init_chars (AsBytes (o), Text.Sub (value, start, Max_init_chars));
        INC (o, Max_init_chars * Target.Char.size);
        INC (start, Max_init_chars);
      END;
      IF (start < len) THEN
        cg.init_chars (AsBytes (o), Text.Sub (value, start));
      END;
    ELSE
      PushPending (NEW (CharsNode, o := o, t := value));
    END;
  END Init_chars;

PROCEDURE DumpChars (x: CharsNode) =
  BEGIN
    DumpNode (x);
    Init_chars (x.o, x.t);
  END DumpChars;

PROCEDURE Init_float (o: Offset;  READONLY f: Target.Float) =
  BEGIN
    IF (in_init) THEN
      AdvanceInit (o);
      <*ASSERT o = init_pc*>
      <*ASSERT o MOD Target.Real.align = 0 *>
      cg.init_float (AsBytes (o), f);
    ELSE
      PushPending (NEW (FloatNode, o := o, f := f));
    END;
  END Init_float;

PROCEDURE DumpFloat (x: FloatNode) =
  BEGIN
    DumpNode (x);
    Init_float (x.o, x.f);
  END DumpFloat;

PROCEDURE EmitText (t: TEXT): INTEGER =
  VAR  len, size, align, offset: INTEGER;
  BEGIN
    IF (t = NIL) THEN t := "" END;
    len    := Text.Length (t) + 1;
    size   := len * Target.Char.size;
    (** align  := MAX (Target.Char.align, Target.Integer.align); **)
    align  := Target.Char.align;
    offset := Module.Allocate (size, align, "*string*");
    PushPending (NEW (CharsNode, o := offset, t := t));
    RETURN offset;
  END EmitText;
------------------------------------------------------------ procedures ---

PROCEDURE Import_procedure (n: Name;  n_params: INTEGER;  ret_type: Type;
                            cc: CallingConvention;
                            VAR(*OUT*) new: BOOLEAN): Proc =
  VAR ref: REFANY;  p: Proc;
  BEGIN
    IF (procedures = NIL) THEN procedures := NewNameTbl() END;
    IF procedures.get (n, ref) THEN new := FALSE;  RETURN ref END;
    p := cg.import_procedure (n, n_params, ret_type, cc);
    EVAL procedures.put (n, p);
    new := TRUE;
    RETURN p;
  END Import_procedure;

PROCEDURE Declare_procedure (n: Name;  n_params: INTEGER;  ret_type: Type;
                             lev: INTEGER;  cc: CallingConvention;
                             exported: BOOLEAN;  parent: Proc): Proc =
  BEGIN
    RETURN cg.declare_procedure (n, n_params, ret_type,
                                 lev, cc, exported, parent);
  END Declare_procedure;

PROCEDURE Begin_procedure (p: Proc) =
  BEGIN
    cg.begin_procedure (p);
  END Begin_procedure;

PROCEDURE End_procedure (p: Proc) =
  BEGIN
    Free_all_values ();
    Free_all_temps ();
    cg.end_procedure (p);
  END End_procedure;

PROCEDURE Begin_block () =
  BEGIN
    cg.begin_block ();
    INC (block_cnt);
  END Begin_block;

PROCEDURE End_block () =
  BEGIN
    Free_block_temps (block_cnt);
    DEC (block_cnt);
    cg.end_block ();
  END End_block;

PROCEDURE Note_procedure_origin (p: Proc) =
  BEGIN
    cg.note_procedure_origin (p);
  END Note_procedure_origin;
------------------------------------------------------------ statements ---

PROCEDURE Set_label (l: Label;  barrier: BOOLEAN := FALSE) =
  BEGIN
    cg.set_label (l, barrier);
  END Set_label;

PROCEDURE Jump (l: Label) =
  BEGIN
    cg.jump (l);
  END Jump;

PROCEDURE If_true (l: Label;  f: Frequency) =
  BEGIN
    Force1 ("If_true");
    cg.if_true (l, f);
  END If_true;

PROCEDURE If_false (l: Label;  f: Frequency) =
  BEGIN
    Force1 ("If_false");
    cg.if_false (l, f);
  END If_false;

PROCEDURE If_eq (l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    EVAL Force2 ("If_eq", commute := TRUE);
    cg.if_eq (l, t, f);
  END If_eq;

PROCEDURE If_ne (l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    EVAL Force2 ("If_ne", commute := TRUE);
    cg.if_ne (l, t, f);
  END If_ne;

PROCEDURE If_gt (l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    IF Force2 ("If_gt", commute := TRUE)
      THEN cg.if_lt (l, t, f);
      ELSE cg.if_gt (l, t, f);
    END;
  END If_gt;

PROCEDURE If_ge (l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    IF Force2 ("If_ge", commute := TRUE)
      THEN cg.if_le (l, t, f);
      ELSE cg.if_ge (l, t, f);
    END;
  END If_ge;

PROCEDURE If_lt (l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    IF Force2 ("If_lt", commute := TRUE)
      THEN cg.if_gt (l, t, f);
      ELSE cg.if_lt (l, t, f);
    END;
  END If_lt;

PROCEDURE If_le (l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    IF Force2 ("If_le", commute := TRUE)
      THEN cg.if_ge (l, t, f);
      ELSE cg.if_le (l, t, f);
    END;
  END If_le;

PROCEDURE Case_jump (READONLY labels: ARRAY OF Label) =
  BEGIN
    Force1 ("Case_jump");
    cg.case_jump (labels);
  END Case_jump;

PROCEDURE Exit_proc (t: Type) =
  BEGIN
    IF (t # Type.Void) THEN  Force1 ("Exit_proc");  END;
    cg.exit_proc (t);
  END Exit_proc;
------------------------------------------------------------ load/store ---

PROCEDURE Load (v: Var;  o: Offset;  s: Size;  a: Alignment;  t: Type) =
  VAR
    size  := TargetMap.CG_Size [t];
    align := TargetMap.CG_Align [t];
    best_align : Alignment;
    best_size  : Size;
    best_type  : MType;
  BEGIN
    IF (size = s) AND ((a+o) MOD align) = 0 THEN
      (* a simple aligned load *)
      SimpleLoad (v, o, t);

    ELSIF (size < s) THEN
      Err ("load size too large");
      SimpleLoad (v, o, t);
      Force ();  (* to connect the error message to the bad code *)

    ELSIF (t = Type.Word) OR (t = Type.Int) THEN
      best_type  := FindIntType (t, s, o, a);
      best_size  := TargetMap.CG_Size [best_type];
      best_align := TargetMap.CG_Align [best_type];
      align := (a+o) MOD best_align;
      IF (s = best_size) AND (align = 0) THEN
        (* this is a simple partial word load *)
        SimpleLoad (v, o, best_type);
      ELSE
        (* unaligned, partial load *)
        cg.load (v, AsBytes (o - align), best_type);
        IF Target.Little_endian
          THEN cg.extract_mn (t = Type.Int, align, s);
          ELSE cg.extract_mn (t = Type.Int, best_size - align - s, s);
        END;
        SPush (t);
      END;
    ELSE
      (* unaligned non-integer value *)
      Err ("unaligned load  type="& Fmt.Int (ORD (t))
          & "  s/o/a=" & Fmt.Int (s) & "/" & Fmt.Int (o) & "/" & Fmt.Int (a));
      SimpleLoad (v, o, t);
      Force ();  (* to connect the error message to the bad code *)
    END;
  END Load;

PROCEDURE SimpleLoad (v: Var;  o: Offset;  t: Type) =
  BEGIN
    WITH x = stack [SCheck (0, "SimpleLoad")] DO
      x.kind      := VKind.Direct;
      x.type      := t;
      x.temp_base := FALSE;
      x.temp_bits := FALSE;
      x.align     := Target.Byte;
      x.base      := v;
      x.bits      := NIL;
      x.offset    := o;
      x.next      := NIL;
    END;
    INC (tos);
  END SimpleLoad;

PROCEDURE Load_addr_of (v: Var;  o: Offset;  a: Alignment) =
  BEGIN
    WITH x = stack [SCheck (0, "Load_addr_of")] DO
      x.kind      := VKind.Absolute;
      x.type      := Type.Addr;
      x.temp_base := FALSE;
      x.temp_bits := FALSE;
      x.align     := FixAlign (a) * Target.Byte;
      x.base      := v;
      x.bits      := NIL;
      x.offset    := o;
      x.next      := NIL;
    END;
    INC (tos);
  END Load_addr_of;

PROCEDURE Load_addr_of_temp (v: Var;  o: Offset;  a: Alignment) =
  BEGIN
    Load_addr_of (v, o, a);
    stack[tos-1].temp_base := TRUE;
  END Load_addr_of_temp;

PROCEDURE Load_int (v: Var;  o: Offset := 0) =
  BEGIN
    SimpleLoad (v, o, Type.Int);
  END Load_int;

PROCEDURE Load_int_temp (v: Var;  o: Offset := 0) =
  BEGIN
    SimpleLoad (v, o, Type.Int);
    stack [tos-1].temp_base := TRUE;
  END Load_int_temp;

PROCEDURE Load_addr (v: Var;  o: Offset) =
  BEGIN
    SimpleLoad (v, o, Type.Addr);
  END Load_addr;

PROCEDURE Load_indirect (t: Type;  o: Offset;  s: Size) =
  VAR
    size  := TargetMap.CG_Size [t];
    align := TargetMap.CG_Align [t];
    best_align : Alignment;
    best_size  : Size;
    best_type  : MType;
    a: INTEGER;
    base_align : INTEGER;
    bit_offset : INTEGER;
    save_bits  : Var;
    save_temp  : BOOLEAN;
    const_bits : INTEGER;
  BEGIN
    WITH x = stack [SCheck (1, "Load_indirect")] DO
      IF (x.kind = VKind.Direct) THEN
        (* there's no lazy form of MEM(x) *)
        Force ();
      ELSIF (x.kind = VKind.Indirect) THEN
        (* there's no lazy form of MEM(x) *)
        INC (o, x.offset);  x.offset := 0;
        Force ();
      END;

      IF (x.kind = VKind.Stacked) THEN
        <*ASSERT x.offset = 0*>
        <*ASSERT x.bits = NIL*>
        x.kind := VKind.Pointer;
      END;

      <*ASSERT x.kind = VKind.Pointer
            OR x.kind = VKind.Absolute *>

      INC (x.offset, o);
      a := LV_align (x);

      IF (size = s) AND (a MOD align) = 0 THEN
        (* a simple aligned load *)
        SimpleIndirectLoad (x, t);

      ELSIF (size < s) THEN
        Err ("load_indirect size too large");
        Force (); (* to connect the error message with the code *)
        SimpleIndirectLoad (x, t);

      ELSIF (t = Type.Word) OR (t = Type.Int) THEN
        base_align := Base_align (x);
        best_type  := FindIntType (t, s, x.offset, base_align);
        best_size  := TargetMap.CG_Size [best_type];
        best_align := TargetMap.CG_Align [best_type];
        bit_offset := x.offset MOD best_align;
        IF (bit_offset = 0) AND (x.bits = NIL) THEN
          (* this is a simple partial word load *)
          SimpleIndirectLoad (x, best_type);
          (** x.type := TargetMap.CG_Base [best_type]; -- nope **)
          IF (s # best_size) THEN
            Force ();
            IF Target.Little_endian
              THEN cg.extract_mn (t = Type.Int, 0, s);
              ELSE cg.extract_mn (t = Type.Int, best_size - s, s);
            END;
          END;
        ELSIF (x.bits = NIL) THEN
          (* partial load with unaligned constant offset *)
          x.offset := x.offset - bit_offset;
          SimpleIndirectLoad (x, best_type);
          Force ();
          IF Target.Little_endian
            THEN cg.extract_mn (t = Type.Int, bit_offset, s);
            ELSE cg.extract_mn (t = Type.Int, best_size - bit_offset - s, s);
          END;
        ELSE
          (* unaligned, partial load with variable offset *)
          IF (best_align > x.align) THEN Err ("unaligned base variable"); END;

          (* hide the bit offset *)
          save_bits := x.bits;       x.bits := NIL;
          save_temp := x.temp_bits;  x.temp_bits := FALSE;

          (* generate the aligned load *)
          const_bits := x.offset MOD best_align;
          DEC (x.offset, const_bits);
          SimpleIndirectLoad (x, best_type);
          Force ();

          (* compute the full bit offset *)
          IF Target.Little_endian THEN
            cg.load (save_bits, 0, Type.Int);
            IF (const_bits # 0) THEN
              Push_int (const_bits);
              cg.add (Type.Int);
            END;
          ELSE (* big endian *)
            Push_int (best_size - const_bits - s);
            cg.load (save_bits, 0, Type.Int);
            cg.subtract (Type.Int);
          END;

          (* extract the needed bits *)
          cg.extract_n (t = Type.Int, s);

          (* restore the hidden bit offset *)
          x.bits := save_bits;
          x.temp_bits := save_temp;
        END;
      ELSE
        (* unaligned non-integer value *)
        Err ("unaligned load_indirect  type="& Fmt.Int (ORD (t))
            & "  s/a=" & Fmt.Int (s) & "/" & Fmt.Int (a));
        Force ();  (* to connect the error message *)
        SimpleIndirectLoad (x, t);
        Force ();
      END;

    END;
  END Load_indirect;

PROCEDURE SimpleIndirectLoad (VAR x: ValRec;  t: Type) =
  VAR offs: INTEGER;
  BEGIN
    IF (x.kind = VKind.Absolute) THEN
      x.kind := VKind.Direct;
      x.type := t;
    ELSIF (x.kind = VKind.Pointer) OR (x.kind = VKind.Stacked) THEN
      offs := x.offset;  x.offset := 0;
      Force ();
      cg.load_indirect (AsBytes (offs), t);
      x.type  := t;
      x.align := Target.Byte;
      x.kind  := VKind.Stacked;
    ELSE (* ?? *)
      ErrI (ORD (x.kind), "bad mode in SimpleIndirectLoad");
      Force ();
      cg.load_indirect (AsBytes (x.offset), t);
      x.type  := t;
      x.align := Target.Byte;
      x.kind  := VKind.Stacked;
    END;
  END SimpleIndirectLoad;

PROCEDURE Store (v: Var;  o: Offset;  s: Size;  a: Alignment;  t: Type) =
  VAR
    size  := TargetMap.CG_Size [t];
    align := TargetMap.CG_Align [t];
    best_align : Alignment;
    best_size  : Size;
    best_type  : MType;
  BEGIN
    Force ();  (* materialize the value to be stored *)

    IF (size = s) AND ((a+o) MOD align) = 0 THEN
      (* a simple aligned store *)
      cg.store (v, AsBytes (o), t);
    ELSIF (size < s) THEN
      Err ("store size too large");
      cg.store (v, AsBytes (o), t);
    ELSIF (t = Type.Word) OR (t = Type.Int) THEN
      best_type  := FindIntType (t, s, o, a);
      best_size  := TargetMap.CG_Size [best_type];
      best_align := TargetMap.CG_Align [best_type];
      align := (a+o) MOD best_align;
      IF (s = best_size) AND (align = 0) THEN
        (* this is a simple partial word store *)
        cg.store (v, AsBytes (o), best_type);
      ELSE
        (* unaligned, partial store *)
        cg.load (v, AsBytes (o - align), best_type);
        cg.swap (t, t);
        IF Target.Little_endian
          THEN cg.insert_mn (align, s);
          ELSE cg.insert_mn (best_size - align - s, s);
        END;
        cg.store (v, AsBytes (o - align), best_type);
      END;
    ELSE
      (* unaligned non-integer value *)
      Err ("unaligned store  type="& Fmt.Int (ORD (t))
            & "  s/o/a=" & Fmt.Int (s) & "/" & Fmt.Int (o) & "/" & Fmt.Int(a));
      cg.store (v, ToBytes (o), t);
    END;
    SPop (1, "Store");
  END Store;

PROCEDURE Store_ref (v: Var;  o: Offset := 0) =
  BEGIN
    Store (v, o, Target.Address.size, Target.Address.align, Type.Addr);
  END Store_ref;

PROCEDURE Store_int (v: Var;  o: Offset := 0) =
  BEGIN
    Store (v, o, Target.Integer.size, Target.Integer.align, Type.Int);
  END Store_int;

PROCEDURE Store_addr (v: Var;  o: Offset := 0) =
  BEGIN
    Store (v, o, Target.Address.size, Target.Address.align, Type.Addr);
  END Store_addr;

PROCEDURE Store_ref_indirect (o: Offset;  <*UNUSED*>var: BOOLEAN) =
  BEGIN
    Store_indirect (Type.Addr, o, Target.Address.size);
  END Store_ref_indirect;

PROCEDURE Store_indirect (t: Type;  o: Offset;  s: Size) =
  VAR
    size  := TargetMap.CG_Size [t];
    align := TargetMap.CG_Align [t];
    best_align : Alignment;
    best_size  : Size;
    best_type  : MType;
    a: INTEGER;
    tmp: Val;
    base_align: INTEGER;
    save_bits : Var     := NIL;
    save_temp : BOOLEAN := FALSE;
    const_bits: INTEGER := 0;
  BEGIN
    Force (); (* materialize the value to be stored *)

    WITH x = stack [SCheck (2, "Store_indirect-x")],
         y = stack [SCheck (1, "Store_indirect-y")] DO

      (* normalize the address and the value *)
      IF (x.kind = VKind.Stacked) THEN
        <*ASSERT x.offset = 0*>
        <*ASSERT x.bits = NIL*>
        const_bits := o MOD x.align;
        x.offset := o - const_bits;
        x.kind := VKind.Pointer;

        Force (); (* the rhs *)

      ELSIF (x.kind = VKind.Pointer) THEN
        (* save the bit offset *)
        save_bits := x.bits;  x.bits := NIL;
        save_temp := x.temp_bits;  x.temp_bits := FALSE;
        const_bits := (x.offset + o) MOD x.align;
        x.offset := x.offset + o - const_bits;

        Force (); (* the rhs *)

      ELSIF (x.kind = VKind.Direct) THEN
        EVAL Force_pair (commute := FALSE);  (* force both sides *)

        const_bits := o MOD x.align;
        x.offset := o - const_bits;
        x.kind := VKind.Pointer;

      ELSIF (x.kind = VKind.Absolute) THEN
        INC (x.offset, o);
        Force (); (* the rhs *)

      ELSIF (x.kind = VKind.Indirect) THEN
        (* save the bit offset *)
        save_bits := x.bits;  x.bits := NIL;
        save_temp := x.temp_bits;  x.temp_bits := FALSE;
        const_bits := (x.offset + o) MOD x.align;
        x.offset := x.offset + o - const_bits;

        EVAL Force_pair (commute := FALSE); (* both sides *)
        x.kind := VKind.Pointer;
      END;

      <*ASSERT x.kind = VKind.Pointer
            OR x.kind = VKind.Absolute *>

      (* restore the bit offset *)
      x.bits := save_bits;
      x.temp_bits := save_temp;
      INC (x.offset, const_bits);

      a := LV_align (x);

      IF (size = s) AND (a MOD align) = 0 THEN
        (* a simple aligned store *)
        SimpleIndirectStore (x, t);
      ELSIF (size < s) THEN
        Err ("store_indirect size too large");
        SimpleIndirectStore (x, t);
      ELSIF (t = Type.Word) OR (t = Type.Int) THEN
        base_align := Base_align (x);
        best_type  := FindIntType (t, s, x.offset, base_align);
        best_size  := TargetMap.CG_Size [best_type];
        best_align := TargetMap.CG_Align [best_type];
        const_bits := x.offset MOD best_align;
        IF (const_bits = 0) AND (s = best_size) AND (x.bits = NIL) THEN
          (* this is a simple partial word store *)
          SimpleIndirectStore (x, best_type);
        ELSIF (const_bits = 0) AND (x.bits = NIL) THEN
          (* this is an aligned, partial word store *)
          Swap ();
          tmp := Pop ();
          Push (tmp);  XForce ();
          SimpleIndirectLoad (stack [SCheck (1,"Store_indirect-3")],best_type);
          Swap ();
          EVAL Force_pair (commute := FALSE);
          IF Target.Little_endian
            THEN cg.insert_mn (0, s);
            ELSE cg.insert_mn (best_size - s, s);
          END;
          SPop (1, "Store_indirect #1");
          Push (tmp);  XForce ();
          Swap ();
          SimpleIndirectStore (x, best_type);
          Free (tmp);
        ELSIF (x.bits = NIL) THEN
          (* partial store with unaligned constant offset *)
          x.offset := x.offset DIV best_align * best_align;
          Swap ();
          tmp := Pop ();
          Push (tmp);  XForce ();
          SimpleIndirectLoad (stack [SCheck (1, "Store_indirect-4")], best_type);
          Swap ();
          EVAL Force_pair (commute := FALSE);
          IF Target.Little_endian
            THEN cg.insert_mn (const_bits, s);
            ELSE cg.insert_mn (best_size - const_bits - s, s);
          END;
          SPop (1, "Store_indirect #2");
          Push (tmp);  XForce ();
          Swap ();
          SimpleIndirectStore (x, best_type);
          Free (tmp);
        ELSE
          (* unaligned, partial store with variable offset *)
          IF (best_align > x.align) THEN
            Err ("unaligned base variable in store");
          END;

          (* hide the bit offset *)
          save_bits := x.bits;       x.bits := NIL;
          save_temp := x.temp_bits;  x.temp_bits := FALSE;

          (* generate the aligned load *)
          const_bits := x.offset MOD best_align;
          DEC (x.offset, const_bits);
          Swap ();
          tmp := Pop ();
          Push (tmp);  Force ();
          SimpleIndirectLoad (y, best_type);
          Force ();

          (* stuff the bits *)
          Swap ();
          IF Target.Little_endian THEN
            cg.load (save_bits, 0, Type.Int);
            IF (const_bits # 0) THEN
              Push_int (const_bits);
              cg.add (Type.Int);
            END;
          ELSE (* big endian *)
            Push_int (best_size - const_bits - s);
            cg.load (save_bits, 0, Type.Int);
            cg.subtract (Type.Int);
          END;
          cg.insert_n (s);
          SPop (1, "Store_indirect #3");

          (* finally, store the result *)
          Push (tmp);  Force ();
          Swap ();
          SimpleIndirectStore (x, best_type);

          Free (tmp);
        END;
      ELSE
        (* unaligned non-integer value *)
        Err ("unaligned store_indirect  type="& Fmt.Int (ORD (t))
            & "  s/a=" & Fmt.Int (s) & "/" & Fmt.Int (a));
        SimpleIndirectStore (x, t);
      END;

    END;
    SPop (2, "Store_indirect");
  END Store_indirect;

PROCEDURE SimpleIndirectStore (READONLY x: ValRec;  t: MType)=
  BEGIN
    IF (x.kind = VKind.Absolute) THEN
      cg.store (x.base, AsBytes (x.offset), t);
    ELSIF (x.kind = VKind.Pointer) OR (x.kind = VKind.Stacked) THEN
      cg.store_indirect (AsBytes (x.offset), t);
    ELSE (* ?? *)
      ErrI (ORD (x.kind), "bad mode in SimpleIndirectStore");
      cg.store_indirect (AsBytes (x.offset), t);
    END;
  END SimpleIndirectStore;
-------------------------------------------------------------- literals ---

PROCEDURE Load_nil () =
  BEGIN
    SPush (Type.Addr);
    cg.load_nil ();
    stack [tos-1].align := Target.Address.align;
  END Load_nil;

PROCEDURE Load_byte_address (x: INTEGER) =
  BEGIN
    SPush (Type.Addr);
    cg.load_nil ();
    cg.add_offset (x);
    stack [tos-1].align := Target.Byte;
  END Load_byte_address;

PROCEDURE Load_intt (i: INTEGER) =
  VAR val: Target.Int;  b := TInt.FromInt (i, val);
  BEGIN
    IF NOT b THEN ErrI (i, "integer not representable") END;
    Load_integer (val);
  END Load_intt;

PROCEDURE Load_integer (READONLY i: Target.Int) =
  BEGIN
    SPush (Type.Int);
    WITH x = stack[tos-1] DO
      x.kind := VKind.Integer;
      x.int  := i;
    END;
  END Load_integer;

PROCEDURE Load_float (READONLY f: Target.Float) =
  VAR t := TargetMap.Float_types [TFloat.Prec (f)].cg_type;
  BEGIN
    SPush (t);
    WITH x = stack[tos-1] DO
      x.kind  := VKind.Float;
      x.float := f;
    END;
  END Load_float;
------------------------------------------------------------ arithmetic ---

PROCEDURE Eq (t: ZType) =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    cg.eq (t);
    SPop (2, "Eq");
    SPush (Type.Int);
  END Eq;

PROCEDURE Ne (t: ZType) =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    cg.ne (t);
    SPop (2, "Ne");
    SPush (Type.Int);
  END Ne;

PROCEDURE Gt (t: ZType) =
  BEGIN
    IF Force_pair (commute := TRUE)
      THEN cg.lt (t);
      ELSE cg.gt (t);
    END;
    SPop (2, "Gt");
    SPush (Type.Int);
  END Gt;

PROCEDURE Ge (t: ZType) =
  BEGIN
    IF Force_pair (commute := TRUE)
      THEN cg.le (t);
      ELSE cg.ge (t);
    END;
    SPop (2, "Ge");
    SPush (Type.Int);
  END Ge;

PROCEDURE Lt (t: ZType) =
  BEGIN
    IF Force_pair (commute := TRUE)
      THEN cg.gt (t);
      ELSE cg.lt (t);
    END;
    SPop (2, "Lt");
    SPush (Type.Int);
  END Lt;

PROCEDURE Le (t: ZType) =
  BEGIN
    IF Force_pair (commute := TRUE)
      THEN cg.ge (t);
      ELSE cg.le (t);
    END;
    SPop (2, "Le");
    SPush (Type.Int);
  END Le;

PROCEDURE Add (t: AType) =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    cg.add (t);
    SPop (2, "Add");
    SPush (t);
  END Add;

PROCEDURE Subtract (t: AType) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.subtract (t);
    SPop (2, "Subtract");
    SPush (t);
  END Subtract;

PROCEDURE Multiply (t: AType) =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    cg.multiply (t);
    SPop (2, "Multiply");
    SPush (t);
  END Multiply;

PROCEDURE Divide (t: RType) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.divide (t);
    SPop (2, "Divide");
    SPush (t);
  END Divide;

PROCEDURE Negate (t: AType) =
  BEGIN
    Force ();
    cg.negate (t);
    SPop (1, "Negate");
    SPush (t);
  END Negate;

PROCEDURE Abs (t: AType) =
  BEGIN
    Force ();
    cg.abs (t);
    SPop (1, "Abs");
    SPush (t);
  END Abs;

PROCEDURE Max (t: ZType) =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    cg.max (t);
    SPop (2, "Max");
    SPush (t);
  END Max;

PROCEDURE Min (t: ZType) =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    cg.min (t);
    SPop (2, "Min");
    SPush (t);
  END Min;

PROCEDURE Round (t: RType) =
  BEGIN
    Force ();
    cg.round (t);
    SPop (1, "Round");
    SPush (Type.Int);
  END Round;

PROCEDURE Trunc (t: RType) =
  BEGIN
    Force ();
    cg.trunc (t);
    SPop (1, "Trunc");
    SPush (Type.Int);
  END Trunc;

PROCEDURE Floor (t: RType) =
  BEGIN
    Force ();
    cg.floor (t);
    SPop (1, "Floor");
    SPush (Type.Int);
  END Floor;

PROCEDURE Ceiling (t: RType) =
  BEGIN
    Force ();
    cg.ceiling (t);
    SPop (1, "Ceiling");
    SPush (Type.Int);
  END Ceiling;

PROCEDURE Cvt_float (t: AType;  u: RType) =
  BEGIN
    Force ();
    cg.cvt_float (t, u);
    SPop (1, "Cvt_float");
    SPush (u);
  END Cvt_float;

PROCEDURE Div (t: IType;  a, b: Sign) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.div (t, a, b);
    SPop (2, "Div");
    SPush (t);
  END Div;

PROCEDURE Mod (t: IType;  a, b: Sign) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.mod (t, a, b);
    SPop (2, "Mod");
    SPush (t);
  END Mod;
------------------------------------------------------------------ sets ---

PROCEDURE Set_union (s: Size) =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    IF (s <= Target.Integer.size) THEN
      cg.or ();
      SPop (1, "Set_union");
    ELSE
      cg.set_union (AsBytes (s));
      SPop (3, "Set_union");
    END;
  END Set_union;

PROCEDURE Set_difference (s: Size) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    IF (s <= Target.Integer.size) THEN
      cg.not ();
      cg.and ();
      SPop (1, "Set_diff");
    ELSE
      cg.set_difference (AsBytes (s));
      SPop (3, "Set_diff");
    END;
  END Set_difference;

PROCEDURE Set_intersection (s: Size) =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    IF (s <= Target.Integer.size) THEN
      cg.and ();
      SPop (1, "Set_inter");
    ELSE
      cg.set_intersection (AsBytes (s));
      SPop (3, "Set_inter");
    END;
  END Set_intersection;

PROCEDURE Set_sym_difference (s: Size) =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    IF (s <= Target.Integer.size) THEN
      cg.xor ();
      SPop (1, "Set_symd");
    ELSE
      cg.set_sym_difference (AsBytes (s));
      SPop (3, "Set_symd");
    END;
  END Set_sym_difference;

PROCEDURE Set_member (s: Size) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    IF (s <= Target.Integer.size) THEN
      cg.load_integer (TInt.One);
      cg.swap (Type.Int, Type.Int);
      cg.shift_left ();
      cg.and ();
      cg.load_integer (TInt.Zero);
      cg.ne (Type.Word);
    ELSE
      cg.set_member (AsBytes (s));
    END;
    SPop (2, "Set_member");
    SPush (Type.Int);
  END Set_member;

PROCEDURE Set_eq (s: Size) =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    IF (s <= Target.Integer.size) THEN
      cg.eq (Type.Word);
    ELSE
      cg.set_eq (AsBytes (s));
    END;
    SPop (2, "Set_eq");
    SPush (Type.Int);
  END Set_eq;

PROCEDURE Set_ne (s: Size) =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    IF (s <= Target.Integer.size) THEN
      cg.ne (Type.Word);
    ELSE
      cg.set_ne (AsBytes (s));
    END;
    SPop (2, "Set_ne");
    SPush (Type.Int);
  END Set_ne;

PROCEDURE Set_lt (s: Size) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    IF (s <= Target.Integer.size) THEN
      <*ASSERT FALSE*>
    ELSE
      cg.set_lt (AsBytes (s));
    END;
    SPop (2, "Set_lt");
    SPush (Type.Int);
  END Set_lt;

PROCEDURE Set_le (s: Size) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    IF (s <= Target.Integer.size) THEN
      cg.not ();
      cg.and ();
      cg.load_integer (TInt.Zero);
      cg.eq (Type.Word);
    ELSE
      cg.set_le (AsBytes (s));
    END;
    SPop (2, "Set_le");
    SPush (Type.Int);
  END Set_le;

PROCEDURE Set_gt (s: Size) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    IF (s <= Target.Integer.size) THEN
      <*ASSERT FALSE*>
    ELSE
      cg.set_gt (AsBytes (s));
    END;
    SPop (2, "Set_gt");
    SPush (Type.Int);
  END Set_gt;

PROCEDURE Set_ge (s: Size) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    IF (s <= Target.Integer.size) THEN
      cg.swap (Type.Word, Type.Word);
      cg.not ();
      cg.and ();
      cg.load_integer (TInt.Zero);
      cg.eq (Type.Word);
    ELSE
      cg.set_ge (AsBytes (s));
    END;
    SPop (2, "Set_ge");
    SPush (Type.Int);
  END Set_ge;

PROCEDURE Set_range (s: Size) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    IF (s <= Target.Integer.size) THEN
      (* given x, a, b:  compute  x || {a..b} *)

      cg.load_integer (TInt.MOne);      (* -1 = 16_ffffff = {0..N} *)
      cg.swap (Type.Int, Type.Int);
      Push_int (Target.Integer.size-1);
      cg.swap (Type.Int, Type.Int);
      cg.subtract (Type.Int);
      cg.shift_right ();                (*  x, a, {0..b} *)

      cg.swap (Type.Int, Type.Int);     (*  x, {0..b}, a *)

      cg.load_integer (TInt.MOne);
      cg.swap (Type.Int, Type.Int);
      cg.shift_left ();                 (*  x, {0..b}, {a..N} *)

      cg.and ();                        (*  x, {a..b} *)
      cg.or ();                         (*  x || {a..b} *)
      SPop (3, "Set_range-a");
      SPush (Type.Int);
    ELSE
      cg.set_range (AsBytes (s));
      SPop (3, "Set_range-b");
    END;
  END Set_range;

PROCEDURE Set_singleton (s: Size) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    IF (s <= Target.Integer.size) THEN
      cg.load_integer (TInt.One);
      cg.swap (Type.Int, Type.Int);
      cg.shift_left ();
      cg.or ();
      SPop (2, "Set_single-b");
      SPush (Type.Int);
    ELSE
      cg.set_singleton (AsBytes (s));
      SPop (2, "Set_single-b");
    END;
  END Set_singleton;
------------------------------------------------- Word.T bit operations ---

PROCEDURE Not () =
  BEGIN
    Force ();
    cg.not ();
    SPop (1, "Not");
    SPush (Type.Int);
  END Not;

PROCEDURE And () =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    cg.and ();
    SPop (2, "And");
    SPush (Type.Int);
  END And;

PROCEDURE Or () =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    cg.or ();
    SPop (2, "Or");
    SPush (Type.Int);
  END Or;

PROCEDURE Xor () =
  BEGIN
    EVAL Force_pair (commute := TRUE);
    cg.xor ();
    SPop (2, "Xor");
    SPush (Type.Int);
  END Xor;

PROCEDURE Shift () =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.shift ();
    SPop (2, "Shift");
    SPush (Type.Int);
  END Shift;

PROCEDURE Shift_left () =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.shift_left ();
    SPop (2, "Shift_left");
    SPush (Type.Int);
  END Shift_left;

PROCEDURE Shift_right () =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.shift_right ();
    SPop (2, "Shift_right");
    SPush (Type.Int);
  END Shift_right;

PROCEDURE Rotate () =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.rotate ();
    SPop (2, "Rotate");
    SPush (Type.Int);
  END Rotate;

PROCEDURE Rotate_left () =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.rotate_left ();
    SPop (2, "Rotate_left");
    SPush (Type.Int);
  END Rotate_left;

PROCEDURE Rotate_right () =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.rotate_right ();
    SPop (2, "Rotate_right");
    SPush (Type.Int);
  END Rotate_right;

PROCEDURE Extract (sign: BOOLEAN) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.extract (sign);
    SPop (3, "Extract");
    SPush (Type.Int);
  END Extract;

PROCEDURE Extract_n (sign: BOOLEAN;  n: INTEGER) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.extract_n (sign, n);
    SPop (2, "Extract_n");
    SPush (Type.Int);
  END Extract_n;

PROCEDURE Extract_mn (sign: BOOLEAN;  m, n: INTEGER) =
  BEGIN
    Force ();
    cg.extract_mn (sign, m, n);
    SPop (1, "Extract_mn");
    SPush (Type.Int);
  END Extract_mn;

PROCEDURE Insert () =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.insert ();
    SPop (4, "Insert");
    SPush (Type.Int);
  END Insert;

PROCEDURE Insert_n (n: INTEGER) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.insert_n (n);
    SPop (3, "Insert_n");
    SPush (Type.Int);
  END Insert_n;

PROCEDURE Insert_mn (m, n: INTEGER) =
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.insert_mn (m, n);
    SPop (2, "Insert_mn");
    SPush (Type.Int);
  END Insert_mn;
------------------------------------------------ misc. stack/memory ops ---

PROCEDURE Swap () =
  VAR tmp: ValRec;
  BEGIN
    WITH xa = stack [SCheck (2, "Swap-a")],
         xb = stack [SCheck (1, "Swap-b")] DO

      (* exchange the underlying values *)
      IF ((xa.kind = VKind.Stacked) OR (xa.kind = VKind.Pointer))
        AND ((xb.kind = VKind.Stacked) OR (xb.kind = VKind.Pointer)) THEN
        (* both values are on the stack => must swap *)
        cg.swap (xa.type, xb.type);
      END;

      (* exchnage the local copies *)
      tmp := xa;  xa := xb;  xb := tmp;
    END;
  END Swap;

PROCEDURE Discard (t: Type) =
  BEGIN
    SPop (1, "Discard");
    WITH x = stack [SCheck (0, "Pop")] DO
      IF (x.kind = VKind.Stacked) OR (x.kind = VKind.Pointer) THEN
        cg.pop (t);
      END;
      Release_temps (x);
    END;
  END Discard;

PROCEDURE Copy_n (s: Size;  overlap: BOOLEAN) =
  VAR t: MType;  z: Size;  a := MIN (SLV_align (2), SLV_align (3));
  BEGIN
    EVAL Force_pair (commute := FALSE);
    IF (a < Target.Byte) THEN ErrI (a, "unaligned copy_n") END;

    (* convert the count into a multiple of a machine type's size *)
    IF (s = Target.Byte) THEN
      t := AlignedType (s, Target.Byte);
      z := TargetMap.CG_Size [t];
      <*ASSERT z = Target.Byte*>
    ELSIF (s < Target.Byte) THEN
      IF (Target.Byte MOD s) # 0 THEN ErrI (s, "impossible copy_n size") END;
      t := AlignedType (s, Target.Byte);
      z := TargetMap.CG_Size [t];
      <*ASSERT z = Target.Byte*>
      Push_int (Target.Byte DIV s);
      cg.div (Type.Int, Sign.Positive, Sign.Positive);
    ELSE (* s > Target.Byte *)
      IF (s MOD Target.Byte) # 0 THEN ErrI (s, "impossible copy_n size") END;
      t := AlignedType (s, a);
      z := TargetMap.CG_Size [t];
      IF (z < s) THEN
        IF (s MOD z) # 0 THEN ErrI (s, "impossible copy_n size") END;
        Push_int (s DIV z);
        cg.multiply (Type.Int);
      END;
    END;

    cg.copy_n (t, overlap);
    SPop (3, "Copy_n");
  END Copy_n;

PROCEDURE Copy (s: Size;  overlap: BOOLEAN) =
  VAR
    a := MIN (SLV_align (2), SLV_align (1));
    t := AlignedType (s, a);
    z := TargetMap.CG_Size [t];
  BEGIN
    EVAL Force_pair (commute := FALSE);
    IF (s MOD z) # 0 THEN ErrI (s, "impossible copy size") END;
    cg.copy (s DIV z, t, overlap);
    SPop (2, "Copy");
  END Copy;

PROCEDURE Zero (s: Size) =
  VAR
    a := SLV_align (1);
    t := AlignedType (s, a);
    z := TargetMap.CG_Size [t];
  BEGIN
    Force ();
    IF (s MOD z) # 0 THEN ErrI (s, "impossible zero size") END;
    cg.zero (s DIV z, t);
    SPop (1, "Zero");
  END Zero;
----------------------------------------------------------- conversions ---

PROCEDURE Loophole (from, two: Type) =
  BEGIN
    Force ();
    cg.loophole (from, two);
    SPop (1, "Loophole");
    SPush (two);
  END Loophole;
------------------------------------------------ traps & runtime checks ---

PROCEDURE Assert_fault () =
  BEGIN
    EVAL Runtime.LookUpProc (Runtime.Hook.AssertFault);
    cg.assert_fault ();
  END Assert_fault;

PROCEDURE Narrow_fault () =
  BEGIN
    EVAL Runtime.LookUpProc (Runtime.Hook.NarrowFault);
    cg.narrow_fault ();
  END Narrow_fault;

PROCEDURE Return_fault () =
  BEGIN
    EVAL Runtime.LookUpProc (Runtime.Hook.ReturnFault);
    cg.return_fault ();
  END Return_fault;

PROCEDURE Case_fault () =
  BEGIN
    EVAL Runtime.LookUpProc (Runtime.Hook.CaseFault);
    cg.case_fault ();
  END Case_fault;

PROCEDURE Typecase_fault () =
  BEGIN
    EVAL Runtime.LookUpProc (Runtime.Hook.TypecaseFault);
    cg.typecase_fault ();
  END Typecase_fault;

PROCEDURE Check_nil () =
  BEGIN
    EVAL Runtime.LookUpProc (Runtime.Hook.NilFault);
    Force ();
    cg.check_nil ();
  END Check_nil;

PROCEDURE Check_lo (READONLY i: Target.Int) =
  BEGIN
    EVAL Runtime.LookUpProc (Runtime.Hook.RangeFault);
    Force ();
    cg.check_lo (i);
  END Check_lo;

PROCEDURE Check_hi (READONLY i: Target.Int) =
  BEGIN
    EVAL Runtime.LookUpProc (Runtime.Hook.RangeFault);
    Force ();
    cg.check_hi (i);
  END Check_hi;

PROCEDURE Check_range (READONLY a, b: Target.Int) =
  BEGIN
    EVAL Runtime.LookUpProc (Runtime.Hook.RangeFault);
    Force ();
    cg.check_range (a, b);
  END Check_range;

PROCEDURE Check_index () =
  BEGIN
    EVAL Runtime.LookUpProc (Runtime.Hook.SubscriptFault);
    EVAL Force_pair (commute := FALSE);
    cg.check_index ();
    SPop (1, "Check_index");
  END Check_index;

PROCEDURE Check_eq () =
  BEGIN
    EVAL Runtime.LookUpProc (Runtime.Hook.ShapeFault);
    EVAL Force_pair (commute := TRUE);
    cg.check_eq ();
    SPop (2, "Check_eq");
  END Check_eq;

PROCEDURE Check_byte_aligned () =
  VAR extra_bits: Var;  extra_is_temp: BOOLEAN;
  BEGIN
    WITH x = stack [SCheck (1, "Check_byte_aligned")] DO
      IF (x.align MOD Target.Byte) # 0 THEN
        Err ("unaligned base variable");
      ELSIF (x.offset MOD Target.Byte) # 0 THEN
        Err ("address's offset is not byte aligned");
      ELSIF (x.bits # NIL) THEN
        extra_bits := x.bits;   extra_is_temp := x.temp_bits;
        x.bits := NIL;          x.temp_bits := FALSE;
        EVAL Runtime.LookUpProc (Runtime.Hook.ShapeFault);
        cg.load (extra_bits, 0, Type.Int);
        Push_int (Target.Byte - 1);  (*** Push_int (Target.Byte); ***)
        cg.and ();  (*** cg.mod (Type.Int, Sign.Unknown, Sign.Positive); ***)
        cg.load_integer (TInt.Zero);
        cg.check_eq ();
        Boost_alignment (Target.Byte);
        Force ();
        cg.load (extra_bits, 0, Type.Int);
        Push_int (Target.Byte);
        cg.div (Type.Int, Sign.Unknown, Sign.Positive);
        cg.index_address (1);
        IF (extra_is_temp) THEN Free_temp (extra_bits); END;
      END;
    END;
  END Check_byte_aligned;
---------------------------------------------------- address arithmetic ---

PROCEDURE Add_offset (i: INTEGER) =
  BEGIN
    WITH x = stack [SCheck (1, "Add_offset")] DO
      IF (x.type # Type.Addr) THEN
        Err ("add_offset on non-address");
        Force ();
      ELSIF (x.kind = VKind.Stacked) THEN
        x.kind := VKind.Pointer;
        x.offset := i;
      ELSIF (x.kind = VKind.Direct) THEN
        Force ();
        x.kind   := VKind.Pointer;
        x.offset := i;
      ELSIF (x.kind = VKind.Absolute) THEN
        INC (x.offset, i);
      ELSIF (x.kind = VKind.Indirect) THEN
        INC (x.offset, i);
      ELSIF (x.kind = VKind.Pointer) THEN
        INC (x.offset, i);
      ELSE
        Err ("add_offset on non-address form");
        Force ();
      END;
    END;
  END Add_offset;

PROCEDURE Index_bytes (size: INTEGER) =
  VAR align := SLV_align (2);
  BEGIN
    EVAL Force_pair (commute := FALSE);
    cg.index_address (AsBytes (size));
    SPop (2, "Index_bytes");
    SPush (Type.Addr);
    stack [SCheck (1, "Index_bytes")].align := GCD (align, size);
  END Index_bytes;

PROCEDURE Index_bits () =
  VAR index := Pop_temp ();
  BEGIN
    WITH x = stack [SCheck (1, "Index_address")] DO
      IF (x.bits # NIL) THEN  Err ("index_bits applied twice");  END;
      IF (x.kind = VKind.Stacked) THEN x.kind := VKind.Pointer; END;
      x.bits := index.base;
      x.temp_bits := TRUE;
    END;
    (*** SPop (1, "Index_address"); ***)
  END Index_bits;

PROCEDURE Boost_alignment (a: Alignment) =
  BEGIN
    WITH x = stack [SCheck (1, "Boost_alignment")] DO
      x.align := MAX (x.align, a);
    END;
  END Boost_alignment;
------------------------------------------------------- procedure calls ---

PROCEDURE Start_call_direct (proc: Proc;  lev: INTEGER;  t: Type) =
  BEGIN
    SEmpty ("Start_call_direct");
    cg.start_call_direct (proc, lev, t);
  END Start_call_direct;

PROCEDURE Call_direct (p: Proc;  t: Type) =
  BEGIN
    SEmpty ("Call_direct");
    cg.call_direct (p, t);
    PushResult (t);
  END Call_direct;

PROCEDURE Start_call_indirect (t: Type;  cc: CallingConvention) =
  BEGIN
    SEmpty ("Start_call_indirect");
    cg.start_call_indirect (t, cc);
  END Start_call_indirect;

PROCEDURE Call_indirect (t: Type;  cc: CallingConvention) =
  BEGIN
    Force ();
    cg.call_indirect (t, cc);
    SPop (1, "Call_indirect");
    SEmpty ("Call_indirect");
    PushResult (t);
  END Call_indirect;

PROCEDURE PushResult (t: Type) =
  BEGIN
    IF (t # Type.Void) THEN  SPush (t)  END;
  END PushResult;

PROCEDURE Pop_param (t: Type) =
  BEGIN
    Force ();
    cg.pop_param (t);
    SPop (1, "Pop_param");
    SEmpty ("Pop_param");
  END Pop_param;

PROCEDURE Pop_struct (s: Size;  a: Alignment) =
  BEGIN
    Force ();
    cg.pop_struct (ToBytes (s), FixAlign (a));
    SPop (1, "Pop_struct");
    SEmpty ("Pop_struct");
  END Pop_struct;

PROCEDURE Pop_static_link () =
  BEGIN
    Force ();
    cg.pop_static_link ();
    SPop (1, "Pop_static_link");
  END Pop_static_link;
------------------------------------------- procedure and closure types ---

PROCEDURE Load_procedure (p: Proc) =
  BEGIN
    cg.load_procedure (p);
    SPush (Type.Addr);
  END Load_procedure;

PROCEDURE Load_static_link (p: Proc) =
  BEGIN
    cg.load_static_link (p);
    SPush (Type.Addr);
  END Load_static_link;
------------------------------------------------ builtin type operations --

PROCEDURE Ref_to_typecode () =
  VAR base: INTEGER;
  BEGIN
    Boost_alignment (Target.Address.align);
    Load_indirect (Type.Int, -Target.Address.pack, Target.Address.size);
    Force ();
    IF Target.Little_endian THEN
      base := M3RT.RH_typecode_offset;
    ELSE
      base := Target.Integer.size
                  - M3RT.RH_typecode_offset
                  - M3RT.RH_typecode_size;
    END;
    cg.extract_mn (FALSE, base, M3RT.RH_typecode_size);
  END Ref_to_typecode;
------------------------------------------------------------ open arrays --

PROCEDURE Open_elt_ptr (a: Alignment) =
  BEGIN
    Boost_alignment (Target.Address.align);
    Load_indirect (Type.Addr, M3RT.OA_elt_ptr, Target.Address.size);
    (*** Boost_alignment (a); ***)
    WITH x = stack [SCheck (1, "Open_elt_ptr")] DO
      x.align := a;
    END;
  END Open_elt_ptr;

PROCEDURE Open_size (n: INTEGER) =
  BEGIN
    Boost_alignment (Target.Address.align);
    Load_indirect (Type.Int, M3RT.OA_sizes + n * Target.Integer.pack,
                   Target.Integer.size);
  END Open_size;
------------------------------------------- procedure and closure types ---

PROCEDURE If_closure (proc: Val;  true, false: Label;  freq: Frequency) =
  VAR skip := Next_label ();
  BEGIN
    IF NOT Target.Aligned_procedures THEN
      Push (proc);
      Force ();
      cg.loophole (Type.Addr, Type.Int);
      Push_int (3);
      cg.and ();
      IF (false # No_label)
        THEN cg.if_true (false, Always - freq);
        ELSE cg.if_true (skip,  Always - freq);
      END;
      SPop (1, "If_closure-unaligned");
    END;
    Push (proc);
    Boost_alignment (Target.Address.align);
    Force ();
    cg.load_nil ();
    IF (false # No_label)
      THEN cg.if_eq (false, Type.Addr, Always - freq);
      ELSE cg.if_eq (skip, Type.Addr, Always - freq);
    END;
    Push (proc);
    Boost_alignment (Target.Integer.align);
    Load_indirect (Type.Int, M3RT.CL_marker, Target.Integer.size);
    Push_int (M3RT.CL_marker_value);
    IF (true # No_label)
      THEN cg.if_eq (true, Type.Int, freq);
      ELSE cg.if_ne (false, Type.Int, freq);
    END;
    Set_label (skip);
    SPop (2, "If_closure");
  END If_closure;

PROCEDURE Closure_proc () =
  BEGIN
    Boost_alignment (Target.Address.align);
    Load_indirect (Type.Addr, M3RT.CL_proc, Target.Address.size);
  END Closure_proc;

PROCEDURE Closure_frame () =
  BEGIN
    Boost_alignment (Target.Address.align);
    Load_indirect (Type.Addr, M3RT.CL_frame, Target.Address.size);
  END Closure_frame;
----------------------------------------------------------------- misc. ---

PROCEDURE Comment (o: INTEGER;  a, b, c, d: TEXT := NIL) =
  BEGIN
    IF (o < 0) THEN
      cg.comment (a, b, c, d);
    ELSE
      PushPending (NEW (CommentNode, o := o-1, a:=a, b:=b, c:=c, d:=d));
    END;
  END Comment;

PROCEDURE DumpComment (x: CommentNode) =
  BEGIN
    DumpNode (x);
    cg.comment (x.a, x.b, x.c, x.d);
  END DumpComment;
-------------------------------------------------------------- internal ---

PROCEDURE FixAlign (a: Alignment): Alignment =
  BEGIN
    RETURN MAX (a, Target.Byte) DIV Target.Byte;
  END FixAlign;

PROCEDURE AlignedType (s: Size;  a: Alignment): MType =
  BEGIN
    IF IsAlignedMultiple (s, a, Target.Integer) THEN RETURN Type.Int;   END;
    IF IsAlignedMultiple (s, a, Target.Int_D)   THEN RETURN Type.Int_D; END;
    IF IsAlignedMultiple (s, a, Target.Int_C)   THEN RETURN Type.Int_C; END;
    IF IsAlignedMultiple (s, a, Target.Int_B)   THEN RETURN Type.Int_B; END;
    IF IsAlignedMultiple (s, a, Target.Int_A)   THEN RETURN Type.Int_A; END;
    Err ("unaligned copy or zero:  s/a=" & Fmt.Int (s) & "/" & Fmt.Int (a));
    RETURN Type.Int_A;
  END AlignedType;

PROCEDURE IsAlignedMultiple (s: Size;  a: Alignment;
                             READONLY t: Target.Int_type): BOOLEAN =
  BEGIN
    RETURN (s MOD t.size = 0)
       AND ((a = t.align) OR (a MOD t.align = 0));
  END IsAlignedMultiple;

PROCEDURE ToVarSize (n: INTEGER;  a: Alignment): INTEGER =
  VAR n_bytes := (n + Target.Byte - 1) DIV Target.Byte;
      align   := FixAlign (a);
  BEGIN
    RETURN (n_bytes + align - 1) DIV align * align;
  END ToVarSize;

PROCEDURE ToBytes (n: INTEGER): INTEGER =
  BEGIN
    RETURN  (n + Target.Byte - 1) DIV Target.Byte;
  END ToBytes;

PROCEDURE AsBytes (n: INTEGER): INTEGER =
  VAR x := n DIV Target.Byte;
  BEGIN
    IF (x * Target.Byte # n) THEN ErrI (n, "unaligned offset") END;
    RETURN  x;
  END AsBytes;

PROCEDURE Push_int (i: INTEGER) =
  VAR val: Target.Int;  b := TInt.FromInt (i, val);
  BEGIN
    IF NOT b THEN ErrI (i, "integer not representable") END;
    cg.load_integer (val);
  END Push_int;

PROCEDURE Force_pair (commute: BOOLEAN): BOOLEAN =
  (* Returns TRUE if the items are stacked in the wrong order *)
  VAR s1 := stack [SCheck (1, "Force_pair")].kind = VKind.Stacked;
  VAR s2 := stack [SCheck (2, "Force_pair")].kind = VKind.Stacked;
  BEGIN
    IF s1 AND s2 THEN
      (* both elements are already stacked *)
      RETURN FALSE;
    ELSIF s2 THEN
      (* bottom element is already stacked *)
      Force ();
      RETURN FALSE;
    ELSIF s1 THEN
      Swap ();
      Force ();
      IF commute THEN RETURN TRUE END;
      Swap ();
      RETURN FALSE;
    ELSE (* neither element is stacked *)
      Swap ();
      Force ();
      Swap ();
      Force ();
      RETURN FALSE;
    END;
  END Force_pair;

PROCEDURE SLV_align (n: INTEGER): INTEGER =
  BEGIN
    RETURN LV_align (stack [SCheck (n, "SLV_align")]);
  END SLV_align;

PROCEDURE LV_align (READONLY x: ValRec): INTEGER =
  VAR align := x.align;
  BEGIN
    IF (x.offset # 0) THEN align := GCD (align, x.offset) END;
    IF (x.bits # NIL) THEN align := 1  END;
    RETURN align;
  END LV_align;

PROCEDURE Base_align (READONLY x: ValRec): INTEGER =
  (* like LV_align, but ignore the constant offset *)
  BEGIN
    RETURN x.align;
    (***********
    IF (x.bits = NIL)
      THEN RETURN x.align;
      ELSE RETURN 1;
    END;
    ************)
  END Base_align;

PROCEDURE GCD (a, b: INTEGER): INTEGER =
  VAR c: INTEGER;
  BEGIN
    IF (a < 0) THEN a := -a END;
    IF (b < 0) THEN b := -b END;
    IF (b = 0) THEN RETURN a END;
    LOOP
      c := a MOD b;
      IF (c = 0) THEN RETURN b END;
      a := b; b := c;
    END;
  END GCD;

PROCEDURE FindIntType (t: Type;  s: Size;  o: Offset;  a: Alignment): MType =
  VAR j := -1;
    best_s := TargetMap.CG_Size [t] + 1;
    best_a := TargetMap.CG_Align [t] + 1;
    size   : Size;
    align  : Alignment;
  BEGIN
    FOR i := FIRST (TargetMap.Int_types) TO LAST (TargetMap.Int_types) DO
      size  := TargetMap.Int_types[i].size;
      align := TargetMap.Int_types[i].align;
      IF (TargetMap.CG_Base [TargetMap.Int_types[i].cg_type] = t)
        AND (s <= size) AND (size < best_s)
        AND (align <= best_a)
        AND (a MOD align = 0)
        AND (s + (o MOD align) <= size) THEN
         (* remember this type *)
        j := i;
        best_s := size;
        best_a := align;
      END;
    END;
    IF (j # -1) THEN RETURN TargetMap.Int_types[j].cg_type END;
    Err ("unable to find integer type?  type="& Fmt.Int (ORD (t))
          & "  s/o/a=" & Fmt.Int (s) & "/" & Fmt.Int (o) & "/" & Fmt.Int (a));
    RETURN t;
  END FindIntType;

PROCEDURE SPush (t: Type) =
  BEGIN
    WITH x = stack[tos] DO
      x.kind      := VKind.Stacked;
      x.type      := t;
      x.temp_base := FALSE;
      x.temp_bits := FALSE;
      x.align     := Target.Byte;
      x.base      := NIL;
      x.bits      := NIL;
      x.offset    := 0;
      x.int       := TInt.Zero;
      x.float     := TFloat.ZeroR;
      x.next      := NIL;
    END;
    INC (tos);
  END SPush;

PROCEDURE SPop (n: INTEGER;  tag: TEXT) =
  BEGIN
    IF (tos < n)
      THEN ErrI (n, "SPop: stack underflow in " & tag);  tos := 0;
      ELSE DEC (tos, n);
    END;
  END SPop;

PROCEDURE SCheck (n: INTEGER;  tag: TEXT): INTEGER =
  BEGIN
    IF (tos < n)
      THEN ErrI (n, "SCheck: stack underflow in " & tag); RETURN 0;
      ELSE RETURN tos - n;
    END;
  END SCheck;

PROCEDURE Err (msg: TEXT) =
  BEGIN
    msg := "** INTERNAL CG ERROR *** " & msg;
    Error.Msg (msg);
    cg.comment (msg);
  END Err;

PROCEDURE ErrI (n: INTEGER;  msg: TEXT) =
  BEGIN
    msg := "** INTERNAL CG ERROR *** " & msg;
    Error.Int (n, msg);
    cg.comment (msg, ": ", Fmt.Int (n));
  END ErrI;

PROCEDURE NewIntTbl (): IntIntTbl.T =
  BEGIN
    RETURN NEW (IntIntTbl.Default).init ();
  END NewIntTbl;

PROCEDURE NewNameTbl (): IntRefTbl.T =
  BEGIN
    RETURN NEW (IntRefTbl.Default).init ();
  END NewNameTbl;
------------------------------------------------------------- debugging --- ********* *********

CONST
  Bool = ARRAY BOOLEAN OF TEXT { "F ", "T "};
CONST
  TypeName = ARRAY Type OF TEXT {
    "Addr   ", "Word   ", "Int    ",
    "Reel   ", "LReel  ", "XReel  ",
    "Int_A  ", "Int_B  ", "Int_C  ", "Int_D  ",
    "Word_A ", "Word_B ", "Word_C ", "Word_D ",
    "Struct ", "Void   "
  };
CONST
  VName = ARRAY VKind OF TEXT {
    "Integer  ",
    "Float    ",
    "Stacked  ",
    "Direct   ",
    "Absolute ",
    "Indirect ",
    "Pointer  "
  };

PROCEDURE SDump (tag: TEXT) =
  VAR msg: TEXT;
  BEGIN
    cg.comment (tag);
    cg.comment ("------------ begin stack dump ------------");
    FOR i := tos-1 TO 0 BY -1 DO
      WITH x = stack[i] DO
        msg := VName [x.kind];
        msg := msg & TypeName [x.type];
        msg := msg & Bool [x.temp_base];
        msg := msg & Bool [x.temp_bits];
        msg := msg & Fmt.Int (x.align) & " ";
        msg := msg & Fmt.Int (x.offset);
        cg.comment (msg);
      END;
    END;
    cg.comment ("------------- end stack dump -------------");
  END SDump;

PROCEDURE SEmpty (tag: TEXT) =
  BEGIN
    IF (tos > 0) THEN
      Force ();
      ErrI (tos, "stack not empty, depth");
      SDump (tag);
    END;
  END SEmpty;

BEGIN
END CG.