(* Copyright (C) 1993, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Mon Jan  6 13:00:00 1997 by collin@vlsi.polymtl.ca       *)
(*      under a new license:                                                 *)
(*                                                                           *)
(*      Copyright (C) 1997 Jerome Collin                                     *)
(*                                                                           *)
(*      This is a free software; you can redistribute it and/or modify       *)
(*      it under the terms of the GNU General Public License as published    *)
(*      by the Free Software Foundation; either version 2, or                *)
(*      (at your option) any later version.                                  *)
(*                                                                           *)
(*      This software is distributed in the hope that it will be useful,     *)
(*      but WITHOUT ANY WARRANTY; without even the implied warranty of       *)
(*      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the        *)
(*      GNU General Public License for more details.                         *)
(*                                                                           *)
(* modified on Tue May 23 15:11:59 PDT 1995 by kalsow                        *)
(* modified on Wed Nov 23 13:57:47 PST 1994 by isard                         *)

MODULE M3x86 EXPORTS M3x86, M3x86Rep;
 
IMPORT Wr, Text, Fmt, IntRefTbl, Word, Convert;
IMPORT M3CG, M3ID, M3CG_Ops, Target, TInt AS TargetInt, TFloat AS TargetFloat;
IMPORT M3ObjFile, TargetMap;

FROM TargetMap IMPORT CG_Bytes;

FROM M3CG IMPORT Name, ByteOffset, TypeUID, CallingConvention;
FROM M3CG IMPORT BitSize, ByteSize, Alignment, Frequency;
FROM M3CG IMPORT Var, Proc, Label, Sign, BitOffset;
FROM M3CG IMPORT Type, ZType, AType, RType, IType, MType;

FROM M3CG_Ops IMPORT ErrorHandler;

FROM M3ObjFile IMPORT Seg, R_386_32, R_386_GOTPC, R_386_GOTOFF;

IMPORT Wrx86, Stackx86, Codex86;

FROM Stackx86 IMPORT MaxMin;
FROM Codex86 IMPORT Cond, Op, FOp, FIm, unscond, revcond, BASE_FOR_PIC;

TYPE
  RuntimeHook = REF RECORD
    name   : Name;
    proc   : Proc;
    var    : Var;
    offset : ByteOffset;
  END;

REVEAL
  U = Public BRANDED "M3x86.U" OBJECT
        rawwr           : Wr.T := NIL;
        wr              : Wrx86.T := NIL;
        cg              : Codex86.T := NIL;
        vstack          : Stackx86.T := NIL;
        obj             : M3ObjFile.T := NIL;
        debug           := FALSE;
        pic             := FALSE;
        Err             : ErrorHandler := NIL;
        runtime         : IntRefTbl.T := NIL;  (* Name -> RuntimeHook *)
        textsym         : INTEGER;
	datasym		: INTEGER;
        bsssym          : INTEGER;
        GOTsym          : INTEGER;
        init_varstore   : x86Var := NIL;
        init_count      : INTEGER;
        init_offs	: INTEGER;
        call_param_size := ARRAY [0 .. 1] OF INTEGER { 0, 0 };
        in_proc_call    := 0;
        static_link     := ARRAY [0 .. 1] OF x86Var { NIL, NIL };
        current_proc    : x86Proc := NIL;
        param_proc      : x86Proc := NIL;
        in_proc         : BOOLEAN;
        procframe_ptr   : ByteOffset;
        exit_proclabel  : Label := -1;
        last_exitbranch := -1;
        n_params        : INTEGER;
        next_var        := 1;
        next_proc       := 1;
        next_scope      := 1;
        set_procs       : ARRAY SetProc OF IntProc;
        memmoveproc     : IntProc;
        memcpyproc      : IntProc;
        memsetproc      : IntProc;
        global_var      : x86Var := NIL;
        rfault_name     : Name;
	reportsymbol    : INTEGER;
        lineno          : INTEGER;
        source_file     : TEXT := NIL;
        reportlabel     : Label;
        reportID        : M3ID.T;
        usedfault       := FALSE;
      OVERRIDES
        NewVar := NewVar;
        next_label := next_label;
        set_error_handler := set_error_handler;
        begin_unit := begin_unit;
        end_unit   := end_unit;
        import_unit := import_unit;
        export_unit := export_unit;
        set_source_file := set_source_file;
        set_source_line := set_source_line;
        declare_typename := declare_typename;
        declare_array := declare_array;
        declare_open_array := declare_open_array;
        declare_enum := declare_enum;
        declare_enum_elt := declare_enum_elt;
        declare_packed  := declare_packed;
        declare_record := declare_record;
        declare_field := declare_field;
        declare_set := declare_set;
        declare_subrange := declare_subrange;
        declare_pointer := declare_pointer;
        declare_indirect := declare_indirect;
        declare_proctype := declare_proctype;
        declare_formal := declare_formal;
        declare_raises := declare_raises;
        declare_object := declare_object;
        declare_method := declare_method;
        declare_opaque := declare_opaque;
        reveal_opaque := reveal_opaque;
        set_runtime_proc := set_runtime_proc;
        set_runtime_hook := set_runtime_hook;
        get_runtime_hook := get_runtime_hook;
        import_global  := import_global;
        declare_segment := declare_segment;
        bind_segment := bind_segment;
        declare_global := declare_global;
        declare_constant := declare_constant;
        declare_local  := declare_local;
        declare_param  := declare_param;
        declare_temp   := declare_temp;
        free_temp := free_temp;
        declare_exception := declare_exception;
        begin_init := begin_init;
        end_init := end_init;
        init_int := init_int;
        init_proc := init_proc;
        init_label := init_label;
        init_var := init_var;
        init_offset := init_offset;
        init_chars := init_chars;
        init_float := init_float;
        import_procedure := import_procedure;
        declare_procedure := declare_procedure;
        begin_procedure := begin_procedure;
        end_procedure := end_procedure;
        begin_block := begin_block;
        end_block := end_block;
        note_procedure_origin := note_procedure_origin;
        set_label := set_label;
        jump := jump;
        if_true  := if_true;
        if_false := if_false;
        if_eq := if_eq;
        if_ne := if_ne;
        if_gt := if_gt;
        if_ge := if_ge;
        if_lt := if_lt;
        if_le := if_le;
        case_jump := case_jump;
        exit_proc := exit_proc;
        load  := load;
        store := store;
        store_ref := store_ref;
        load_address := load_address;
        load_indirect := load_indirect;
        store_indirect := store_indirect;
        store_ref_indirect := store_ref_indirect;
        load_nil      := load_nil;
        load_integer  := load_integer;
        load_float    := load_float;
        eq       := eq;
        ne       := ne;
        gt       := gt;
        ge       := ge;
        lt       := lt;
        le       := le;
        add      := add;
        subtract := subtract;
        multiply := multiply;
        divide   := divide;
        div      := div;
        mod      := mod;
        negate   := negate;
        abs      := abs;
        max      := max;
        min      := min;
        round    := round;
        trunc    := trunc;
        floor    := floor;
        ceiling  := ceiling;
        cvt_float := cvt_float;
        set_union          := set_union;
        set_difference     := set_difference;
        set_intersection   := set_intersection;
        set_sym_difference := set_sym_difference;
        set_member         := set_member;
        set_eq       := set_eq;
        set_ne       := set_ne;
        set_gt       := set_gt;
        set_ge       := set_ge;
        set_lt       := set_lt;
        set_le       := set_le;
        set_range    := set_range;
        set_singleton := set_singleton;
        not := not;
        and := and;
        or  := or;
        xor := xor;
        shift        := shift;
        shift_left   := shift_left;
        shift_right  := shift_right;
        rotate       := rotate;
        rotate_left  := rotate_left;
        rotate_right := rotate_right;
        extract := extract;
        extract_n := extract_n;
        extract_mn := extract_mn;
        insert  := insert;
        insert_n  := insert_n;
        insert_mn  := insert_mn;
        swap := swap;
        pop  := pop;
        copy := copy;
        copy_n := copy_n;
        zero := zero;
        zero_n := zero_n;
        loophole := loophole;
        assert_fault := assert_fault;
        narrow_fault := narrow_fault;
        return_fault := return_fault;
        case_fault := case_fault;
        typecase_fault := typecase_fault;
        check_nil := check_nil;
        check_lo := check_lo;
        check_hi := check_hi;
        check_range := check_range;
        check_index := check_index;
        check_eq := check_eq;
        add_offset := add_offset;
        index_address := index_address;
        start_call_direct := start_call_direct;
        call_direct := call_direct;
        start_call_indirect := start_call_indirect;
        call_indirect := call_indirect;
        pop_param := pop_param;
        pop_struct := pop_struct;
        pop_static_link := pop_static_link;
        load_procedure := load_procedure;
        load_static_link := load_static_link;
        comment := comment;
        END;

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

CONST Alignmask = ARRAY [1 .. 4] OF INTEGER
  { 16_FFFFFFFF, 16_FFFFFFFE, 0, 16_FFFFFFFC };

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

PROCEDURE New (logfile: Wr.T; obj: M3ObjFile.T; READONLY options  : 
						ARRAY OF TEXT): M3CG.T =
  VAR u := NEW (U,
                obj := obj,
                runtime := NEW (IntRefTbl.Default).init (20));
  BEGIN
    IF logfile # NIL THEN
      u.debug := TRUE;
      u.wr := Wrx86.New (logfile);
    ELSE
      u.wr := NIL;
    END;

    FOR i := 0 TO LAST (options) DO
      ProcessArg (u, options[i]);
    END;

    u.cg := Codex86.New(u, u.wr, u.pic);
    u.vstack := Stackx86.New(u, u.cg, u.debug, u.pic);

    u.set_procs := ARRAY SetProc OF IntProc {
      IntProc { FALSE, NIL, "set_union", 4, Type.Void, "C" },
      IntProc { FALSE, NIL, "set_difference", 4, Type.Void, "C" },
      IntProc { FALSE, NIL, "set_intersection", 4, Type.Void, "C" },
      IntProc { FALSE, NIL, "set_sym_difference", 4, Type.Void, "C" },
      IntProc { FALSE, NIL, "set_range", 3, Type.Void, "C" },
      IntProc { FALSE, NIL, "set_eq", 3, Type.Int, "C" },
      IntProc { FALSE, NIL, "set_ne", 3, Type.Int, "C" },
      IntProc { FALSE, NIL, "set_lt", 3, Type.Int, "C" },
      IntProc { FALSE, NIL, "set_le", 3, Type.Int, "C" },
      IntProc { FALSE, NIL, "set_gt", 3, Type.Int, "C" },
      IntProc { FALSE, NIL, "set_ge", 3, Type.Int, "C" },
      IntProc { FALSE, NIL, "set_member", 2, Type.Int, "C" },
      IntProc { FALSE, NIL, "set_singleton", 2, Type.Void, "C" } };

    u.memmoveproc := IntProc { FALSE, NIL, "memmove", 3, Type.Addr, "C" };
    u.memcpyproc := IntProc { FALSE, NIL, "memcpy", 3, Type.Addr, "C" };
    u.memsetproc := IntProc { FALSE, NIL, "memset", 3, Type.Addr, "C" };

    RETURN u;
  END New;

PROCEDURE ProcessArg (u: U; READONLY t: TEXT) =
  VAR key: TEXT;
  BEGIN
    <* ASSERT t # NIL *>

    key := Text.Sub (t, 0, 2);

    IF (Text.Equal (t, "-fPIC")) THEN
      u.pic:= TRUE;
    ELSIF (Text.Equal (key, "-g")) THEN
      u.obj.set_debugging();
    ELSIF (Text.Equal (key, "-O")) THEN
      (* IGNORE optimisation *)
    ELSE
      (* IGNORE other options *)
    END;
  END ProcessArg;

(*----------------------------------------------------------- ID counters ---*)

PROCEDURE next_label (u: U;  n: INTEGER := 1): Label =
  BEGIN
    RETURN u.cg.reserve_labels(n);
  END next_label;

(*------------------------------------------------ READONLY configuration ---*)

PROCEDURE set_error_handler (u: U; p: ErrorHandler) =
  BEGIN
    u.Err := p;
    u.cg.set_error_handler(p);
    u.vstack.set_error_handler(p);
  END set_error_handler;

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

PROCEDURE begin_unit (u: U;  optimize : INTEGER) =
  (* called before any other method to initialize the compilation unit *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd ("begin_unit");
      u.wr.Int (optimize);
      u.wr.NL  ();
    END;

    u.cg.set_obj(u.obj);

    u.cg.init();
    u.vstack.init();
    u.obj.begin_unit();

    u.next_var := 1;
    u.next_proc := 1;
    u.next_scope := 1;
    u.global_var := NIL;

    u.in_proc_call := 0;

    u.reportlabel := u.cg.reserve_labels(1);
    u.usedfault := FALSE;

    FOR i := FIRST(SetProc) TO LAST(SetProc) DO
      u.set_procs[i].used := FALSE;
    END;

    u.memmoveproc.used := FALSE;
    u.memcpyproc.used := FALSE;
    u.memsetproc.used := FALSE;

    u.rfault_name := 0;

    u.textsym := u.obj.define_sect_sym(Seg.Text);
    u.datasym := u.obj.define_sect_sym(Seg.Data);
    u.cg.set_symbol(u.textsym, u.datasym);

    u.bsssym := u.obj.define_sect_sym(Seg.Bss);

    IF u.pic THEN
      u.GOTsym := u.obj.import_symbol ( M3ID.Add ("_GLOBAL_OFFSET_TABLE_") );
    END;
  END begin_unit;

PROCEDURE end_unit   (u: U) =
  (* called after all other methods to finalize the unit and write the
     resulting object *)
  BEGIN
    IF u.usedfault THEN
      makereportproc(u);
    END;

    IF u.debug THEN
      u.wr.Cmd ("end_unit");
      u.wr.NL  ();
      u.wr.Flush ();
    END;
    u.obj.end_unit();
    u.vstack.end();
    u.cg.end();
  END end_unit;

PROCEDURE import_unit (u: U;  n: Name) =
  (* note that the current compilation unit imports the interface 'n' *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("import_unit");
      u.wr.ZName (n);
      u.wr.NL    ();
    END;
  END import_unit;

PROCEDURE export_unit (u: U;  n: Name) =
  (* note that the current compilation unit exports the interface 'n' *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("export_unit");
      u.wr.ZName (n);
      u.wr.NL    ();
    END;

    u.obj.export_unit(n);

  END export_unit;

(*------------------------------------------------ debugging line numbers ---*)

PROCEDURE set_source_file (u: U; file: TEXT) =
  (* Sets the current source file name.  Subsequent statements
     and expressions are associated with this source location. *)
  BEGIN
    IF u.debug THEN
      u.wr.OutT ("\t\t\t\t\t-----FILE ");
      u.wr.OutT (file);
      u.wr.OutT ("  -----");
      u.wr.NL ();
    END;

    u.source_file := file;

    u.obj.set_source_file(file);
  END set_source_file;

PROCEDURE set_source_line (u: U; line: INTEGER) =
  (* Sets the current source line number.  Subsequent statements
   and expressions are associated with this source location. *)
  BEGIN
    IF u.debug THEN
      u.wr.OutT ("\t\t\t\t\t-----LINE");
      u.wr.Int  (line);
      u.wr.OutT ("  -----");
      u.wr.NL ();
    END;

    u.lineno := line;
    u.obj.set_source_line(line);
  END set_source_line;


(*------------------------------------------- debugging type declarations ---*)

PROCEDURE declare_typename (u: U;  t: TypeUID;  n: Name) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("declare_typename");
      u.wr.Tipe  (t);
      u.wr.ZName (n);
      u.wr.NL    ();
    END;
    u.obj.declare_typename (t, n);
  END declare_typename;

PROCEDURE declare_array (u: U;  t, index, elt: TypeUID;  s: BitSize) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd  ("declare_array");
      u.wr.Tipe (t);
      u.wr.Tipe (index);
      u.wr.Tipe (elt);
      u.wr.BInt (s);
      u.wr.NL   ();
    END;
    u.obj.declare_array (t, index, elt, s);
  END declare_array;

PROCEDURE declare_open_array (u: U;  t, elt: TypeUID;  s: BitSize) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd  ("declare_open_array");
      u.wr.Tipe (t);
      u.wr.Tipe (elt);
      u.wr.BInt (s);
      u.wr.NL   ();
    END;
    u.obj.declare_open_array (t, elt, s);
  END declare_open_array;

PROCEDURE declare_enum (u: U;  t: TypeUID;  n_elts: INTEGER;  s: BitSize) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd  ("declare_enum");
      u.wr.Tipe (t); 
      u.wr.Int  (n_elts);
      u.wr.BInt (s);
      u.wr.NL   ();
    END;
    u.obj.declare_enum (t, n_elts, s);
  END declare_enum;

PROCEDURE declare_enum_elt (u: U;  n: Name) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("declare_enum_elt");
      u.wr.ZName (n);
      u.wr.NL    ();
    END;
    u.obj.declare_enum_elt (n);
  END declare_enum_elt;

PROCEDURE declare_packed (u: U;  t: TypeUID;  s: BitSize;  base: TypeUID) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd  ("declare_packed");
      u.wr.Tipe (t);
      u.wr.BInt (s);
      u.wr.Tipe (base);
      u.wr.NL   ();
    END;
    u.obj.declare_packed (t, s, base);
  END declare_packed;

PROCEDURE declare_record (u: U; t: TypeUID;  s: BitSize;
                          n_fields: INTEGER)=
  BEGIN
    IF u.debug THEN
      u.wr.Cmd  ("declare_record");
      u.wr.Tipe (t);
      u.wr.BInt (s);
      u.wr.Int  (n_fields);
      u.wr.NL   ();
    END;
    u.obj.declare_record (t, s, n_fields);
  END declare_record;

PROCEDURE declare_field (u: U;  n: Name;  o: BitOffset;  s: BitSize;
                         t: TypeUID)=
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("declare_field");
      u.wr.ZName (n);
      u.wr.BInt  (o);
      u.wr.BInt  (s);
      u.wr.Tipe  (t);
      u.wr.NL    ();
    END;
    u.obj.declare_field (n, o, s, t);
  END declare_field;

PROCEDURE declare_set (u: U;  t, domain: TypeUID;  s: BitSize) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd  ("declare_set");
      u.wr.Tipe (t);
      u.wr.Tipe (domain);
      u.wr.BInt (s);
      u.wr.NL    ();
    END;
    u.obj.declare_set (t, domain, s);
  END declare_set;

PROCEDURE declare_subrange (u: U; t, domain: TypeUID;
                            READONLY min, max: Target.Int;
                            s: BitSize) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd  ("declare_subrange");
      u.wr.Tipe (t);
      u.wr.Tipe (domain);
      u.wr.TInt (min);
      u.wr.TInt (max); 
      u.wr.BInt (s);
      u.wr.NL   ();
    END;
    u.obj.declare_subrange (t, domain, min, max, s);
  END declare_subrange;

PROCEDURE declare_pointer (u: U;  t, target: TypeUID;  brand: TEXT;
                           traced: BOOLEAN) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd  ("declare_pointer");
      u.wr.Tipe (t);
      u.wr.Tipe (target);
      u.wr.Txt  (brand);
      u.wr.Bool (traced);
      u.wr.NL   ();
    END;
    u.obj.declare_pointer (t, target, brand, traced);
  END declare_pointer;

PROCEDURE declare_indirect (u: U;  t, target: TypeUID) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd  ("declare_indirect");
      u.wr.Tipe (t);
      u.wr.Tipe (target);
      u.wr.NL   ();
    END;
    u.obj.declare_indirect (t, target);
  END declare_indirect;

PROCEDURE declare_proctype (u: U;  t: TypeUID;  n_formals: INTEGER;
                            result: TypeUID;  n_raises: INTEGER;
                            cc: CallingConvention) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd  ("declare_proctype");
      u.wr.Tipe (t);
      u.wr.Int  (n_formals);
      u.wr.Tipe (result);
      u.wr.Int  (n_raises);
      u.wr.Txt  (cc.name);
      u.wr.NL   ();
    END;
    u.obj.declare_proctype (t, n_formals, result, n_raises);
  END declare_proctype;

PROCEDURE declare_formal (u: U;  n: Name;  t: TypeUID) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("declare_formal");
      u.wr.ZName (n);
      u.wr.Tipe  (t);
      u.wr.NL    ();
    END;
    u.obj.declare_formal (n, t);
  END declare_formal;

PROCEDURE declare_raises (u: U;  n: Name) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("declare_raises");
      u.wr.ZName (n);
      u.wr.NL    ();
    END;
    u.obj.declare_raises (n);
  END declare_raises;

PROCEDURE declare_object (u: U;  t, super: TypeUID;
                          brand: TEXT;  traced: BOOLEAN;
                          n_fields, n_methods: INTEGER;
                          field_size: BitSize) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd  ("declare_object");
      u.wr.Tipe (t);
      u.wr.Tipe (super);
      u.wr.Txt  (brand);
      u.wr.Bool (traced);
      u.wr.Int  (n_fields);  
      u.wr.Int  (n_methods);
      u.wr.BInt (field_size);
      u.wr.NL   ();
    END;
    u.obj.declare_object (t, super, brand, traced, 
                          n_fields, n_methods, field_size);
  END declare_object;

PROCEDURE declare_method (u: U;  n: Name;  signature: TypeUID) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("declare_method");
      u.wr.ZName (n);
      u.wr.Tipe  (signature);
      u.wr.NL    ();
    END;
    u.obj.declare_method (n, signature);
  END declare_method;

PROCEDURE declare_opaque (u: U;  t, super: TypeUID) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("declare_opaque");
      u.wr.Tipe  (t);
      u.wr.Tipe  (super);
      u.wr.NL    ();
    END;
    u.obj.declare_opaque (t, super);
  END declare_opaque;

PROCEDURE reveal_opaque (u: U;  lhs, rhs: TypeUID) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("reveal_opaque");
      u.wr.Tipe  (lhs);
      u.wr.Tipe  (rhs);
      u.wr.NL    ();
    END;
    u.obj.reveal_opaque (lhs, rhs);
  END reveal_opaque;

PROCEDURE declare_exception (u: U;  n: Name;  arg_type: TypeUID;
                           raise_proc: BOOLEAN;  base: Var;  offset: INTEGER) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("declare_exception");
      u.wr.ZName (n);
      u.wr.Tipe  (arg_type);
      u.wr.Bool  (raise_proc);
      u.wr.VName (base);
      u.wr.Int   (offset);
      u.wr.NL    ();
    END;
    u.obj.declare_exception (n, arg_type, raise_proc);
  END declare_exception;

(*--------------------------------------------------------- runtime hooks ---*)

PROCEDURE GetRuntimeHook (u: U;  n: Name): RuntimeHook =
  VAR ref: REFANY;  e: RuntimeHook;
  BEGIN
    IF u.runtime.get (n, ref) THEN
      e := ref;
    ELSE
      e := NEW (RuntimeHook, name := n, proc := NIL, var := NIL, offset := 0);
      EVAL u.runtime.put (n, e);
    END;
    RETURN e;
  END GetRuntimeHook;

PROCEDURE set_runtime_proc (u: U;  n: Name;  p: Proc) =
  VAR e := GetRuntimeHook (u, n);
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_runtime_proc");
      u.wr.ZName (n);
      u.wr.PName (p);
      u.wr.NL    ();
    END;

    e.proc := p;

    IF Text.Equal(M3ID.ToText(n), "ReportFault") THEN
      u.rfault_name := n;
      IF u.debug THEN
        u.wr.OutT("Setting report fault");
        u.wr.NL();
      END
    END
  END set_runtime_proc;

PROCEDURE set_runtime_hook (u: U;  n: Name;  v: Var;  o: ByteOffset) =
  VAR e := GetRuntimeHook (u, n);
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_runtime_hook");
      u.wr.ZName (n);
      u.wr.VName (v);
      u.wr.Int   (o);
      u.wr.NL    ();
    END;

    e.var := v;
    e.offset := o;

    IF Text.Equal(M3ID.ToText(n), "ReportFault") THEN
      u.rfault_name := n;
      IF u.debug THEN
        u.wr.OutT("Setting report fault");
        u.wr.NL();
      END
    END
  END set_runtime_hook;

PROCEDURE get_runtime_hook (u: U;  n: Name; VAR p: Proc;  VAR v: Var; VAR o: ByteOffset) =
  VAR e := GetRuntimeHook (u, n);
  BEGIN
    p := e.proc;
    v := e.var;
    o := e.offset;
  END get_runtime_hook;

(*------------------------------------------------- variable declarations ---*)

PROCEDURE NewVar (u: U; t: Type; uid: TypeUID; s: ByteSize; a: Alignment;
                  name: Name := M3ID.NoID): x86Var =
  VAR v := NEW (x86Var, tag := u.next_var, type := t, s := s,
                a := a);
  BEGIN
    IF name = M3ID.NoID THEN
      v.name := M3ID.Add("T$" & Fmt.Int(v.tag));
    ELSIF uid = -1 THEN
      v.name := M3ID.Add("M" & M3ID.ToText(name));
    ELSE
      v.name := M3ID.Add(M3ID.ToText(name));
    END;

    INC (u.next_var);
    RETURN v;
  END NewVar;

PROCEDURE import_global (u: U;  n: Name;  s: ByteSize;  a: Alignment;
                         t: Type;  m3t: TypeUID): Var =
  VAR v := NewVar(u, t, m3t, s, a, n);
  BEGIN
    v.symbol := u.obj.import_symbol(v.name);
    v.imported := TRUE;
    v.offset := 0;
    v.loc := VLoc.global;

    IF u.debug THEN
      u.wr.Cmd   ("import_global");
      u.wr.ZName (n);
      u.wr.Int   (s);
      u.wr.Int   (a);
      u.wr.TName (t);
      u.wr.Tipe  (m3t);
      u.wr.VName (v);
      u.wr.NL    ();
    END;

    RETURN v;
  END import_global;

PROCEDURE declare_segment (u: U;  n: Name;  m3t: TypeUID): Var =
  VAR v := NewVar(u, Type.Void, m3t, 0, 4, n);
  BEGIN
    IF u.global_var = NIL THEN
      u.global_var := v;
      IF u.debug THEN
        u.wr.OutT("Chosen this declare segment as GLOBALVAR");
        u.wr.NL();
      END
    END;

    v.symbol := u.obj.define_symbol(v.name, Seg.Data, 0);
    v.offset := 0;
    v.loc := VLoc.global;
    v.imported := TRUE;

    IF u.debug THEN
      u.wr.Cmd   ("declare_segment");
      u.wr.ZName (n);
      u.wr.Tipe  (m3t);
      u.wr.VName (v);
      u.wr.NL    ();
    END;

    u.obj.declare_segment(n);

    RETURN v;
  END declare_segment;

PROCEDURE bind_segment (u: U;  v: Var;  s: ByteSize;  a: Alignment;
                        t: Type;  exported, inited: BOOLEAN) =
  VAR realvar := NARROW(v, x86Var);
  BEGIN
    <* ASSERT inited *>

    realvar.type := t;
    realvar.s := s;
    realvar.a := a;

    u.obj.add_symbol_size(realvar.symbol, s);
    IF exported THEN
      u.obj.export_symbol(realvar.symbol);
    END;

    IF u.debug THEN
      u.wr.Cmd   ("bind_segment");
      u.wr.VName (v);
      u.wr.Int   (s);
      u.wr.Int   (a);
      u.wr.TName (t);
      u.wr.Bool  (exported);
      u.wr.Bool  (inited);
      u.wr.NL    ();
    END;

    u.obj.declare_global(realvar.name, s, FALSE);

  END bind_segment;

PROCEDURE declare_global (u: U;  n: Name;  s: ByteSize;  a: Alignment;
                     t: Type;  m3t: TypeUID;  exported, inited: BOOLEAN): Var =
  VAR v := NewVar(u, t, m3t, s, a, n);
  BEGIN
    IF inited THEN
      v.symbol := u.obj.define_symbol(v.name, Seg.Data, 0);
    ELSE
      v.symbol:= u.obj.define_bss_symbol(v.name, s, a);
      u.obj.declare_global(v.name, s, TRUE);
    END;

    v.loc    := VLoc.global;

    IF exported THEN
      u.obj.export_symbol(v.symbol);
    END;

    IF u.debug THEN
      u.wr.Cmd   ("declare_global");
      u.wr.ZName (n);
      u.wr.Int   (s);
      u.wr.Int   (a);
      u.wr.TName (t);
      u.wr.Tipe  (m3t);
      u.wr.Bool  (exported);
      u.wr.Bool  (inited);
      u.wr.VName (v);
      u.wr.NL    ();
    END;

    RETURN v;
  END declare_global;

PROCEDURE declare_constant (u: U;  n: Name;  s: ByteSize;  a: Alignment;
                     t: Type;  m3t: TypeUID;  exported, inited: BOOLEAN): Var =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("declare_constant");
      u.wr.ZName (n);
      u.wr.Int   (s);  
      u.wr.Int   (a);  
      u.wr.TName (t);
      u.wr.Tipe  (m3t);
      u.wr.Bool  (exported);
      u.wr.Bool  (inited);
      u.wr.NL    ();
    END;

    RETURN declare_global(u, n, s, a, t, m3t, exported, inited);
  END declare_constant;

PROCEDURE declare_local (u: U;  n: Name;  s: ByteSize;  a: Alignment;
                         t: Type;  m3t: TypeUID;  in_memory, up_level: BOOLEAN;
                         f: Frequency): Var =
  VAR v: x86Var;
  BEGIN
    IF u.in_proc THEN
      v := get_temp_var (u, t, s, a, n);
    ELSE
      v := create_temp_var (u, t, s, a, n);
    END;

    IF u.debug THEN
      u.wr.Cmd   ("declare_local");
      u.wr.ZName (n);
      u.wr.Int   (s);  
      u.wr.Int   (a);  
      u.wr.TName (t);
      u.wr.Tipe  (m3t);
      u.wr.Bool  (in_memory);
      u.wr.Bool  (up_level);
      u.wr.Int   (f);
      u.wr.VName (v);
      u.wr.Int   (v.offset);
      u.wr.NL    ();
    END;

    u.obj.declare_local (n, s, v.offset, m3t, t);

    RETURN v;
  END declare_local;

PROCEDURE mangle_procname (base: M3ID.T; arg_size: INTEGER;
                           std_call: BOOLEAN): M3ID.T =
  <*FATAL Convert.Failed*>
  VAR buf: ARRAY [0..99] OF CHAR;
      txt: TEXT;
      len: INTEGER;
  BEGIN
    txt := M3ID.ToText(base);
    len := Text.Length(txt);
    IF len < (NUMBER(buf)+10) THEN
      Text.SetChars(buf, txt);
      IF std_call THEN
        buf [len] := '@'; INC(len);
        INC (len, Convert.FromInt(SUBARRAY(buf, len, NUMBER(buf)-len),
                                   arg_size));
      END;
      RETURN M3ID.FromStr(buf, len);
    ELSE
      IF std_call THEN
        RETURN M3ID.Add(Fmt.F ("%s@%s", txt, Fmt.Int (arg_size)));
      ELSE
        RETURN M3ID.Add(Fmt.F ("%s", txt));
      END
    END;
  END mangle_procname;

PROCEDURE declare_param (u: U;  n: Name;  s: ByteSize;  a: Alignment;
                         t: Type;  m3t: TypeUID;  in_memory, up_level: BOOLEAN;
                         f: Frequency): Var =
  VAR v := NewVar(u, t, m3t, s, 4, n);
  BEGIN
    (* Assume a = 4 and ESP is dword aligned... *)

    s := (s + 3) DIV 4 * 4;

    v.offset := u.param_proc.paramsize;
    v.loc := VLoc.temp;

    v.parent := u.param_proc;

    INC(u.param_proc.paramsize, s);

    <* ASSERT u.n_params > 0 *>
    DEC(u.n_params);

    IF u.n_params = 0 AND u.param_proc.stdcall THEN
      (* callee cleans & mangled name *)
      u.param_proc.name := mangle_procname(u.param_proc.name,
                                           u.param_proc.paramsize - 8,
                                           std_call := TRUE);

      IF u.param_proc.import THEN
        u.param_proc.symbol := u.obj.import_symbol(u.param_proc.name);
      ELSE
        u.param_proc.symbol := u.obj.define_symbol(u.param_proc.name,
                                                   Seg.Text, 0);
      END;

      IF u.param_proc.exported THEN
        u.obj.export_symbol(u.param_proc.symbol);
      END
    END;

    IF u.debug THEN
      u.wr.Cmd   ("declare_param");
      u.wr.ZName (n);
      u.wr.Int   (s);  
      u.wr.Int   (a);  
      u.wr.TName (t);
      u.wr.Tipe  (m3t);
      u.wr.Bool  (in_memory);
      u.wr.Bool  (up_level);
      u.wr.Int   (f);
      u.wr.VName (v);
      u.wr.Int   (v.offset);
      u.wr.NL    ();
    END;

    u.obj.declare_param (n, s, v.offset, m3t, t);

    RETURN v;
  END declare_param;

PROCEDURE declare_temp   (u: U;  s: ByteSize;  a: Alignment;  t: Type;
                          in_memory:BOOLEAN): Var =
  VAR v: x86Var;
  BEGIN
    <* ASSERT u.in_proc *>

    v := get_temp_var(u, t, s, a);

    IF u.debug THEN
      u.wr.Cmd   ("declare_temp");
      u.wr.Int   (s);  
      u.wr.Int   (a);
      u.wr.TName (t);
      u.wr.Bool  (in_memory);
      u.wr.VName (v);
      u.wr.Int   (v.offset);
      u.wr.NL    ();
    END;

    RETURN v;
  END declare_temp;

PROCEDURE get_temp_var (u: U; t: Type; s: ByteSize; a: Alignment;
                        n: Name := M3ID.NoID): x86Var =
  BEGIN
    IF s < 4 THEN
      s := 4;
    END;

    IF a < 4 THEN
      a := 4;
    END;

    FOR i := 0 TO u.current_proc.tempsize - 1 DO
      WITH temp = u.current_proc.temparr[i] DO
        IF temp.free AND temp.var.s = s AND temp.var.a >= a THEN
          temp.free := FALSE;
          temp.var.type := t;
          temp.var.stack_temp := FALSE;
          temp.var.scope := u.next_scope - 1;
          RETURN temp.var;
        END
      END
    END;

    IF u.current_proc.tempsize = u.current_proc.templimit THEN
      expand_temp(u);
    END;

    WITH temp = u.current_proc.temparr[u.current_proc.tempsize] DO
      temp.var := create_temp_var(u, t, s, a, n);
      temp.free := FALSE;
      temp.var.scope := u.next_scope - 1;
    END;

    INC(u.current_proc.tempsize);

    RETURN u.current_proc.temparr[u.current_proc.tempsize - 1].var;
  END get_temp_var;

PROCEDURE expand_temp (u: U) =
  VAR newarr := NEW(REF ARRAY OF Temp, u.current_proc.templimit * 2);
  BEGIN
    FOR i := 0 TO (u.current_proc.templimit - 1) DO
      newarr[i] := u.current_proc.temparr[i];
    END;

    u.current_proc.templimit := u.current_proc.templimit * 2;
    u.current_proc.temparr := newarr;
  END expand_temp;

PROCEDURE create_temp_var (u: U; t: Type; s: ByteSize; a: Alignment;
                           n: Name): x86Var =
  VAR v := NewVar(u, t, 0, s, a, n);
  BEGIN
    v.loc := VLoc.temp;
    v.parent := u.current_proc;

    u.current_proc.framesize := Word.And(u.current_proc.framesize + a - 1,
                                         Alignmask[a]);

    INC(u.current_proc.framesize, s);

    v.offset := -u.current_proc.framesize;

    RETURN v;
  END create_temp_var;

PROCEDURE free_temp (u: U;  v: Var) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("free_temp");
      u.wr.VName (v);
      u.wr.NL    ();
    END;

    FOR i := 0 TO u.current_proc.tempsize - 1 DO
      IF (NOT u.current_proc.temparr[i].free) AND
         u.current_proc.temparr[i].var = v THEN
        u.current_proc.temparr[i].free := TRUE;
        RETURN;
      END
    END;

    u.Err("Couldn't find var to free in 'free_temp'");
  END free_temp;

(*---------------------------------------- static variable initialization ---*)

PROCEDURE begin_init (u: U;  v: Var) =
  VAR realvar := NARROW(v, x86Var);
      offs, pad: INTEGER;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("begin_init");
      u.wr.VName (v);
      u.wr.NL    ();
    END;

    <* ASSERT u.init_varstore = NIL *>

    u.init_varstore := v;

    offs := u.obj.cursor(Seg.Data);

    IF Word.And(offs, realvar.a - 1) # 0 THEN
      pad := realvar.a - Word.And(offs, realvar.a - 1);
      INC(offs, pad);
      IF Word.And(pad, 3) # 0 THEN
        u.obj.append(Seg.Data, 0, Word.And(pad, 3));
        pad := Word.And(pad, 16_FFFFFFFC);
      END;

      pad := pad DIV 4;
      FOR i := 1 TO pad DO
        u.obj.append(Seg.Data, 0, 4);
      END
    END;

    u.obj.move_symbol(realvar.symbol, offs);
    u.init_offs := offs;  (* important for PIC - JC *)

    u.init_count := 0;
  END begin_init;

PROCEDURE end_init (u: U;  v: Var) =
  VAR realvar := NARROW(v, x86Var);
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("end_init");
      u.wr.VName (v);
      u.wr.NL    ();
    END;

    <* ASSERT v = u.init_varstore *>

    pad_init(u, realvar.s);
    u.init_varstore := NIL;
  END end_init;

PROCEDURE init_int (u: U;  o: ByteOffset;  READONLY value: Target.Int;
                    t: Type) =
  VAR int: INTEGER;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("init_int");
      u.wr.Int   (o);
      u.wr.TInt  (value);
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    pad_init(u, o);

    EVAL TargetInt.ToInt(value, int);
    u.obj.append(Seg.Data, int, CG_Bytes[t]);
    INC(u.init_count, CG_Bytes[t]);
  END init_int;

PROCEDURE init_proc (u: U;  o: ByteOffset;  value: Proc) =
  VAR realproc := NARROW(value, x86Proc);
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("init_proc");
      u.wr.Int   (o);
      u.wr.PName (value);
      u.wr.NL    ();
    END;

    pad_init(u, o);

    (* The addend is not zero anymore - JC - sept 6, 95 *)
    u.obj.append(Seg.Data, realproc.offset, 4); 
    INC(u.init_count, 4);

    (* modified for PIC *)
    u.obj.relocate(u.init_varstore.symbol, u.init_offs + o, u.textsym,
					 		R_386_32);

  END init_proc;

PROCEDURE init_label (u: U;  o: ByteOffset;  value: Label) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("init_label");
      u.wr.Int   (o);
      u.wr.Lab   (value);
      u.wr.NL    ();
    END;

    pad_init(u, o);

    u.cg.log_label_init(u.init_varstore, o, value);

    INC(u.init_count, 4);
  END init_label;

PROCEDURE init_var (u: U;  o: ByteOffset;  value: Var;  bias: ByteOffset) =
  VAR realvar := NARROW(value, x86Var);
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("init_var");
      u.wr.Int   (o);
      u.wr.VName (value);
      u.wr.Int   (bias);
      u.wr.NL    ();
    END;

    <* ASSERT realvar.loc = VLoc.global *>

    pad_init(u, o);
    u.obj.append(Seg.Data, bias, 4);
    INC(u.init_count, 4);
    (* modified for PIC *)
    u.obj.relocate(u.init_varstore.symbol, u.init_offs + o, realvar.symbol,
								 R_386_32);
     
  END init_var;

PROCEDURE init_offset (u: U;  o: ByteOffset;  value: Var) =
  VAR realvar := NARROW(value, x86Var);
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("init_offset");
      u.wr.Int   (o);
      u.wr.VName (value);
      u.wr.NL    ();
    END;

    <* ASSERT realvar.loc = VLoc.temp *>

    pad_init(u, o);

    u.obj.append(Seg.Data, realvar.offset, 4);
    INC(u.init_count, 4);
  END init_offset;

PROCEDURE init_chars (u: U;  o: ByteOffset;  value: TEXT) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("init_chars");
      u.wr.Int   (o);
      u.wr.Txt   (value);
      u.wr.NL    ();
    END;

    pad_init(u, o);

    WITH len = Text.Length(value) DO
      FOR i := 0 TO len - 1 DO
        u.obj.append(Seg.Data, ORD(Text.GetChar(value, i)), 1);
      END;

      INC(u.init_count, len);
    END
  END init_chars;

PROCEDURE init_float (u: U;  o: ByteOffset;  READONLY f: Target.Float) =
  VAR flarr: ARRAY [0 .. 1] OF INTEGER;
      size: INTEGER;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("init_float");
      u.wr.Int   (o);
      u.wr.Flt   (f);
      u.wr.NL    ();
    END;

    size := TargetFloat.ToInts(f, flarr);

    <* ASSERT size = 1 OR size = 2 *>

    pad_init(u, o);

    u.obj.append(Seg.Data, flarr[0], 4);
    INC(u.init_count, 4);
    IF size = 2 THEN
      u.obj.append(Seg.Data, flarr[1], 4);
      INC(u.init_count, 4);
    END
  END init_float;

PROCEDURE pad_init (u: U; o: ByteOffset) =
  BEGIN
    <* ASSERT u.init_count <= o *>
    <* ASSERT o <= u.init_varstore.s *>

    FOR i := u.init_count TO o - 1 DO
      u.obj.append(Seg.Data, 0, 1);
    END;

    u.init_count := o;
  END pad_init;

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

PROCEDURE NewProc (u: U; n: Name; n_params: INTEGER;
                   ret_type: Type;  cc: CallingConvention): x86Proc =
  VAR p := NEW (x86Proc, tag := u.next_proc, n_params := n_params,
                type := ret_type, stdcall := (cc.m3cg_id = 1));
  BEGIN
    IF n = M3ID.NoID
      THEN p.name := M3ID.Add("P$" & Fmt.Int(p.tag));
      ELSE p.name := n;
    END;

    p.templimit := 16;
    p.temparr := NEW(REF ARRAY OF Temp, p.templimit);

    INC (u.next_proc);
    RETURN p;
  END NewProc;

PROCEDURE import_procedure (u: U;  n: Name;  n_params: INTEGER;
                            ret_type: Type;  cc: CallingConvention): Proc =
  VAR p := NewProc (u, n, n_params, ret_type, cc);
  BEGIN
    p.import := TRUE;

    u.n_params := n_params;

    IF n_params = 0 OR NOT p.stdcall THEN
      p.name := mangle_procname(p.name, 0, p.stdcall);
      p.symbol := u.obj.import_symbol(p.name);
    END;

    u.param_proc := p;

    IF u.debug THEN
      u.wr.Cmd   ("import_procedure");
      u.wr.ZName (n);
      u.wr.Int   (n_params);
      u.wr.TName (ret_type);
      u.wr.Txt   (cc.name);
      u.wr.PName (p);
      u.wr.NL    ();
    END;

    RETURN p;
  END import_procedure;

PROCEDURE declare_procedure (u: U;  n: Name;  n_params: INTEGER;
                             return_type: Type;  lev: INTEGER;
                             cc: CallingConvention;
                             exported: BOOLEAN;  parent: Proc): Proc =
  VAR p := NewProc (u, n, n_params, return_type, cc);
  BEGIN
    p.exported := exported;

    p.lev := lev;
    p.parent := parent;

    IF p.lev # 0 THEN
      INC(p.framesize, 4);
    END;

    u.n_params := n_params;

    IF n_params = 0 OR NOT p.stdcall THEN
      p.name   := mangle_procname(p.name, 0, p.stdcall);
      p.symbol := u.obj.define_symbol(p.name, Seg.Text, 0);
      IF exported THEN u.obj.export_symbol(p.symbol); END
    END;

    u.param_proc := p;

    IF NOT u.in_proc THEN u.current_proc := p; END;

    IF u.debug THEN
      u.wr.Cmd   ("declare_procedure");
      u.wr.ZName (n);
      u.wr.Int   (n_params);
      u.wr.TName (return_type);
      u.wr.Int   (lev);
      u.wr.Txt   (cc.name);
      u.wr.Bool  (exported);
      u.wr.PName (parent);
      u.wr.PName (p);
      u.wr.NL    ();
    END;

    IF lev > 0 THEN 
      u.obj.declare_procedure (p.name, p.parent.name,
			       return_type, exported, p.symbol);
    ELSE
      u.obj.declare_procedure (p.name, M3ID.NoID,
			       return_type, exported, p.symbol);
    END;

    RETURN p;
  END declare_procedure;

PROCEDURE begin_procedure (u: U;  p: Proc) =
  VAR realproc := NARROW(p, x86Proc);
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("begin_procedure");
      u.wr.PName (p);
      u.wr.NL    ();

      u.wr.Flush();
    END;

    u.vstack.clearall ();

    <* ASSERT NOT u.in_proc *>
    u.in_proc := TRUE;

    u.current_proc := p;
    u.cg.set_current_proc(p);
    u.vstack.set_current_proc(p);
    u.last_exitbranch := -1;
    u.exit_proclabel := -1;

    realproc.offset := u.obj.cursor(Seg.Text);
    realproc.bound := TRUE;

    WHILE realproc.usage # NIL DO
      u.obj.patch(Seg.Text, realproc.usage.loc, realproc.offset -
                  (realproc.usage.loc + 4), 4);
      realproc.usage := realproc.usage.link;
    END;

    u.obj.move_symbol(realproc.symbol, realproc.offset);

    u.obj.begin_procedure(realproc.symbol, realproc.offset);

    u.cg.pushOp(u.cg.reg[Codex86.EBP]);
    u.cg.movOp(u.cg.reg[Codex86.EBP], u.cg.reg[Codex86.ESP]);

    u.cg.immOp(Op.oSUB, u.cg.reg[Codex86.ESP], 16_FFFF);
    u.procframe_ptr := u.obj.cursor(Seg.Text) - 4;

    u.cg.pushOp(u.cg.reg[Codex86.EBX]);
    u.cg.pushOp(u.cg.reg[Codex86.ESI]);
    u.cg.pushOp(u.cg.reg[Codex86.EDI]);

    IF u.pic THEN
      u.cg.relCall(0);
      u.cg.popOp(u.cg.reg[Codex86.EBX]);
      u.cg.immOp(Op.oADD, u.cg.reg[Codex86.EBX], 16_FFFF);
      u.obj.patch(Seg.Text, u.obj.cursor(Seg.Text) - 4, 3, 4);
      u.obj.relocate(u.textsym, u.obj.cursor(Seg.Text) - 4,
		      u.GOTsym, R_386_GOTPC);
    END;

    IF u.current_proc.lev # 0 THEN
      u.cg.store_ind(u.cg.reg[Codex86.ECX], u.cg.reg[Codex86.EBP],
                     -4, Type.Addr);
    END;

    u.current_proc.tempsize := 0;

    <* ASSERT u.next_scope = 1 *>

    begin_block(u);
  END begin_procedure;

PROCEDURE end_procedure (u: U;  p: Proc) =
  VAR realproc := NARROW(p, x86Proc);
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("end_procedure");
      u.wr.PName (p);
      u.wr.NL    ();
    END;

    procedure_epilogue(u);

    <* ASSERT u.in_proc *>
    <* ASSERT u.current_proc = p *>

    u.current_proc.framesize := Word.And(u.current_proc.framesize + 3,
                                         16_FFFFFFFC);

    u.obj.patch(Seg.Text, u.procframe_ptr, u.current_proc.framesize, 4);

    u.in_proc := FALSE;

    u.obj.end_procedure(realproc.symbol);

  END end_procedure;

PROCEDURE begin_block (u: U) =
  (* marks the beginning of a nested anonymous block *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("begin_block");
      u.wr.NL    ();
    END;

    INC(u.next_scope);

    u.obj.begin_block();
  END begin_block;

PROCEDURE end_block (u: U) =
  (* marks the ending of a nested anonymous block *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("end_block");
      u.wr.NL    ();
    END;

    <* ASSERT u.next_scope > 1 *>
    DEC(u.next_scope);

    free_locals(u, u.next_scope);

    u.obj.end_block();
  END end_block;

PROCEDURE free_locals (u: U; scope: INTEGER) =
  BEGIN
    FOR i := 0 TO u.current_proc.tempsize - 1 DO
      IF (NOT u.current_proc.temparr[i].free) AND
         u.current_proc.temparr[i].var.scope = scope THEN
        u.current_proc.temparr[i].free := TRUE;
      END
    END
  END free_locals;

PROCEDURE note_procedure_origin (u: U;  p: Proc) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("note_procedure_origin");
      u.wr.PName (p);
      u.wr.NL    ();
    END
  END note_procedure_origin;

(*------------------------------------------------------------ statements ---*)

PROCEDURE set_label (u: U;  l: Label;  <*UNUSED*> barrier: BOOLEAN) =
  (* define 'l' to be at the current pc *)
  BEGIN
    IF u.debug THEN
      u.wr.OutT  (".");
      u.wr.Lab   (l);
      u.wr.NL    ();
    END;

    u.cg.set_label(l);

    u.vstack.clearall();
  END set_label;

PROCEDURE jump (u: U; l: Label) =
  (* GOTO l *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("jump");
      u.wr.Lab   (l);
      u.wr.NL    ();
    END;

    u.cg.brOp(Cond.Always, l);
  END jump;

PROCEDURE if_true  (u: U; l: Label; <*UNUSED*> f: Frequency) =
  (* IF (s0.I # 0) GOTO l ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("if_true");
      u.wr.Lab   (l);
      u.wr.NL    ();
    END;

    condbranch(u, l, Cond.NZ, Type.Int);
  END if_true;

PROCEDURE if_false (u: U; l: Label; <*UNUSED*> f: Frequency) =
  (* IF (s0.I = 0) GOTO l ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("if_false");
      u.wr.Lab   (l);
      u.wr.NL    ();
    END;

    condbranch(u, l, Cond.Z, Type.Int);
  END if_false;

PROCEDURE if_eq (u: U;  l: Label;  t: ZType; <*UNUSED*> f: Frequency) =
  (* IF (s1.t = s0.t) GOTO l ; pop(2) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("if_eq");
      u.wr.Lab   (l);
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condbranch(u, l, Cond.E, t);
  END if_eq;

PROCEDURE if_ne (u: U;  l: Label;  t: ZType; <*UNUSED*> f: Frequency) =
  (* IF (s1.t # s0.t) GOTO l ; pop(2) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("if_ne");
      u.wr.Lab   (l);
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condbranch(u, l, Cond.NE, t);
  END if_ne;

PROCEDURE if_gt (u: U;  l: Label;  t: ZType; <*UNUSED*> f: Frequency) =
  (* IF (s1.t > s0.t) GOTO l ; pop(2) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("if_gt");
      u.wr.Lab   (l);
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condbranch(u, l, Cond.G, t);
  END if_gt;

PROCEDURE if_ge (u: U;  l: Label;  t: ZType; <*UNUSED*> f: Frequency) =
  (* IF (s1.t >= s0.t) GOTO l ; pop(2) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("if_ge");
      u.wr.Lab   (l);
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condbranch(u, l, Cond.GE, t);
  END if_ge;

PROCEDURE if_lt (u: U;  l: Label;  t: ZType; <*UNUSED*> f: Frequency) =
  (* IF (s1.t < s0.t) GOTO l ; pop(2) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("if_lt");
      u.wr.Lab   (l);
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condbranch(u, l, Cond.L, t);
  END if_lt;

PROCEDURE if_le (u: U;  l: Label;  t: ZType; <*UNUSED*> f: Frequency) =
  (* IF (s1.t <= s0.t) GOTO l ; pop(2) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("if_le");
      u.wr.Lab   (l);
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condbranch(u, l, Cond.LE, t);
  END if_le;

PROCEDURE case_jump (u: U; READONLY labels: ARRAY OF Label) =
  (* "GOTO labels[s0.I] ; pop" with no range checking on s0.I *)
  VAR stack0, stack1: INTEGER;
      indexreg, indreg: Operand;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("case_jump");
      u.wr.Int   (NUMBER(labels));

      FOR i := FIRST (labels) TO LAST (labels) DO  u.wr.Lab (labels [i]);  END;
      u.wr.NL    ();
    END;

    IF u.pic THEN
      u.vstack.unlock();
      u.vstack.pushnew( Type.Addr, Force.anyreg );

      stack0 := u.vstack.pos(0, "case_jump");
      stack1 := u.vstack.pos(1, "case_jump");
      u.vstack.find(stack1, Force.anyreg);

      indexreg := u.vstack.op( u.vstack.pos(1, "case_jump"));
      indreg   := u.vstack.op( u.vstack.pos(0, "case_jump"));

      (* Intel for: leal Ox{.data offset}(%ebx),%{indreg.reg} *)
      u.obj.append (Seg.Text, 16_8D, 1);  
      u.obj.append (Seg.Text, 16_83 + indreg.reg * 8, 1);  
      u.obj.append (Seg.Text, u.obj.cursor(Seg.Data), 4);
      u.obj.relocate (u.textsym, u.obj.cursor(Seg.Text) - 4, u.datasym, 
		      R_386_GOTOFF);

      u.obj.declare_case_jump(NUMBER(labels) - 1, indexreg.reg, TRUE);
      u.cg.case_jump (indexreg, labels, indreg);

      u.vstack.discard(2);
    ELSE
      stack0 := u.vstack.pos(0, "case_jump");
      u.vstack.unlock();
      u.vstack.find(stack0, Force.anyreg);
      indexreg := u.vstack.op( u.vstack.pos(0, "case_jump"));

      u.obj.declare_case_jump(NUMBER(labels) - 1, indexreg.reg, FALSE);
      u.cg.case_jump(indexreg, labels, indreg);

      u.vstack.discard(1);
    END;
  END case_jump;

PROCEDURE exit_proc (u: U; t: Type) =
  (* Returns s0.t if t is not Void, otherwise returns no value. *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("exit_proc");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    IF t # Type.Void THEN
      u.vstack.unlock();

      WITH stack0 = u.vstack.pos(0, "exit_proc") DO
        IF t >= Type.Reel AND t <= Type.XReel THEN
	  u.vstack.load_fstacktop();
          u.cg.f_exitproc();
        ELSE
          u.vstack.find(stack0, Force.regset, RegSet { Codex86.EAX });
        END
      END;

      u.vstack.discard(1);
    END;

    IF u.exit_proclabel = -1 THEN
      u.exit_proclabel := u.cg.reserve_labels(1, FALSE);
    END;

    u.last_exitbranch := u.obj.cursor(Seg.Text);

    u.cg.brOp(Cond.Always, u.exit_proclabel);
  END exit_proc;

PROCEDURE procedure_epilogue (u: U) =
  VAR callee_cleans := u.current_proc.stdcall;
  BEGIN
    IF u.exit_proclabel = -1 THEN
      end_block(u);
      RETURN;
      (* Strange as it may seem, some procedures have no exit points... *)
    END;

    IF u.last_exitbranch = u.obj.cursor(Seg.Text) - 5 THEN
      (* Don't generate a branch to the epilogue at the last exit
         point of the procedure *)

      <* ASSERT u.next_scope > 1 *> (* It's end_bloc but with an offset *)
      DEC(u.next_scope);
      free_locals(u, u.next_scope);
      u.obj.end_block(-5);

      u.cg.set_label(u.exit_proclabel, offset := -5);

      u.obj.patch(Seg.Text, u.obj.cursor(Seg.Text) - 5,
                  16_C95B5E5F, 4);
      (* Intel for POP EDI, POP ESI, POP EBX, LEAVE *)

      IF callee_cleans THEN
        u.obj.patch(Seg.Text, u.obj.cursor(Seg.Text) - 1, 16_C2, 1);
        (* Intel for RET imm16 *)
        u.obj.append(Seg.Text, u.current_proc.paramsize - 8, 2);
        (* And the argument *)
      ELSE
        u.obj.patch(Seg.Text, u.obj.cursor(Seg.Text) - 1, 16_C3, 1);
        (* Intel for RET *)
      END;
    ELSE

      end_block(u);

      u.cg.set_label(u.exit_proclabel);

      u.cg.popOp(u.cg.reg[Codex86.EDI]);
      u.cg.popOp(u.cg.reg[Codex86.ESI]);
      u.cg.popOp(u.cg.reg[Codex86.EBX]);
      u.cg.noargOp(Op.oLEAVE);
      IF callee_cleans THEN
        u.cg.cleanretOp(u.current_proc.paramsize - 8);
      ELSE
        u.cg.noargOp(Op.oRET);
      END;
    END;
  END procedure_epilogue;

(*------------------------------------------------------------ load/store ---*)

PROCEDURE load  (u: U;  v: Var;  o: ByteOffset;  t: MType) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("load");
      u.wr.VName (v);
      u.wr.Int   (o);  
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.push(MVar {var := v, o := o, t := t});
  END load;

PROCEDURE store (u: U;  v: Var;  o: ByteOffset;  t: MType) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("store");
      u.wr.VName (v);
      u.wr.Int   (o);  
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.pop(MVar {var := v, o := o, t := t});
  END store;

PROCEDURE store_ref (u: U;  v: Var;  o: ByteOffset) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("store_ref");
      u.wr.VName (v);
      u.wr.Int   (o);
      u.wr.NL    ();
    END;

    store(u, v, o, Type.Addr);
  END store_ref;

PROCEDURE load_address (u: U;  v: Var;  o: ByteOffset) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("load_address");
      u.wr.VName (v);
      u.wr.Int   (o);
      u.wr.NL    ();
    END;

    u.vstack.doloadaddress(v, o);
  END load_address;

PROCEDURE load_indirect (u: U;  o: ByteOffset;  t: MType) =
  VAR newreg: Regno;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("load_indirect");
      u.wr.Int   (o);  
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "load_indirect") DO
      u.vstack.find(stack0, Force.anyreg, RegSet {}, TRUE);
      IF t >= Type.Reel AND t <= Type.XReel THEN
	u.vstack.prepare_fstack(FOp.fLD, TRUE);
        u.cg.f_loadind(u.vstack.op(stack0), o, t);
        u.vstack.dealloc_reg(stack0);
        u.vstack.set_fstack(stack0);
      ELSE
        IF CG_Bytes[t] = 1 THEN
          newreg := u.vstack.freereg(RegSet { Codex86.EAX, Codex86.EBX,
                                              Codex86.ECX, Codex86.EDX } );
        ELSE
          newreg := u.vstack.freereg();
        END;

        u.cg.load_ind(newreg, u.vstack.op(stack0), o, t);
        u.vstack.dealloc_reg(stack0);
        u.vstack.set_reg(stack0, newreg);
      END
    END
  END load_indirect;

PROCEDURE store_indirect (u: U;  o: ByteOffset;  t: MType) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("store_indirect");
      u.wr.Int   (o);  
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.unlock();
    WITH (* stack0 = u.vstack.pos(0, "store_indirect"), *)
         stack1 = u.vstack.pos(1, "store_indirect") DO
      IF t >= Type.Reel AND t <= Type.XReel THEN
        u.vstack.find(stack1, Force.anyreg, RegSet {}, TRUE);
	u.vstack.load_fstacktop();
        u.cg.f_storeind(u.vstack.op(stack1), o, t);
        u.vstack.discard(2);
      ELSE
        u.vstack.dostoreind(o, t);
      END
    END
  END store_indirect;

PROCEDURE store_ref_indirect (u: U;  o: ByteOffset;  var: BOOLEAN) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("store_ref_indirect");
      u.wr.Int   (o);
      u.wr.Bool  (var);
      u.wr.NL    ();
    END;

    store_indirect(u, o, Type.Addr);
  END store_ref_indirect;


(*-------------------------------------------------------------- literals ---*)

PROCEDURE load_nil (u: U) =
  (* push ; s0.A := a *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("load_nil");
      u.wr.NL    ();
    END;

    u.vstack.pushimm(0);
  END load_nil;

PROCEDURE load_integer  (u: U;  READONLY i: Target.Int) =
  (* push ; s0.I := i *)
  VAR int: INTEGER;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("load_integer");
      u.wr.TInt  (i);
      u.wr.NL    ();
    END;

    IF NOT TargetInt.ToInt(i, int) THEN
      u.Err("Failed to convert target integer in load_integer");
    END;
    u.vstack.unlock();
    u.vstack.pushimm(int);
  END load_integer;

PROCEDURE load_float    (u: U;  READONLY f: Target.Float) =
  (* push ; s0.t := f *)
  VAR flarr: ARRAY [0 .. 1] OF INTEGER;
      size: INTEGER;
      type: MType;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("load_float");
      u.wr.Flt   (f);
      u.wr.NL    ();
    END;

    CASE f.pre OF
      Target.Precision.Short => type := Type.Reel;
    | Target.Precision.Long => type := Type.LReel;
    | Target.Precision.Extended => type := Type.XReel;
    END;

    u.vstack.pushnew(type, Force.any);
    size := TargetFloat.ToInts(f, flarr);
    IF (size * 4) # CG_Bytes[type] THEN
      u.Err("Floating size mismatch in load_float");
    END;

    u.vstack.load_fstacktop();
    u.cg.f_loadlit(flarr, type);
  END load_float;

(*------------------------------------------------------------ arithmetic ---*)

PROCEDURE eq (u: U;  t: ZType) =
  (* s1.I := (s1.t = s0.t)  ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("eq");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condset(u, Cond.E, t);
  END eq;

PROCEDURE ne (u: U;  t: ZType) =
  (* s1.I := (s1.t # s0.t)  ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("ne");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condset(u, Cond.NE, t);
  END ne;

PROCEDURE gt (u: U;  t: ZType) =
  (* s1.I := (s1.t > s0.t)  ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("gt");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condset(u, Cond.G, t);
  END gt;

PROCEDURE ge (u: U;  t: ZType) =
  (* s1.I := (s1.t >= s0.t) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("ge");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condset(u, Cond.GE, t);
  END ge;

PROCEDURE lt (u: U;  t: ZType) =
  (* s1.I := (s1.t < s0.t)  ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("lt");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condset(u, Cond.L, t);
  END lt;

PROCEDURE le (u: U;  t: ZType) =
  (* s1.I := (s1.t <= s0.t) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("le");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    condset(u, Cond.LE, t);
  END le;

PROCEDURE add (u: U;  t: AType) =
  (* s1.t := s1.t + s0.t ; pop *)
  VAR indreg:= BASE_FOR_PIC;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("add");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    IF t >= Type.Reel AND t <= Type.XReel THEN
      u.vstack.prepare_fstack(FOp.fADDP, FALSE);
      u.vstack.get_addr_in_GOT(Operand{loc := OLoc.fstack,
				       mvar:= u.cg.ftop_mem}, indreg);
      u.cg.binFOp(FOp.fADDP, 1, indreg);
      u.vstack.discard_indreg(indreg);
      u.vstack.discard(1);
    ELSE
      EVAL u.vstack.dobin(Op.oADD, TRUE, TRUE);
    END
  END add;

PROCEDURE subtract (u: U;  t: AType) =
  (* s1.t := s1.t - s0.t ; pop *)
  VAR indreg:= BASE_FOR_PIC;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("subtract");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    IF t >= Type.Reel AND t <= Type.XReel THEN
      u.vstack.prepare_fstack(FOp.fSUBP, FALSE);
      u.vstack.get_addr_in_GOT(Operand{loc := OLoc.fstack,
				       mvar:= u.cg.ftop_mem}, indreg);
      u.cg.binFOp(FOp.fSUBP, 1, indreg);
      u.vstack.discard_indreg(indreg);
      u.vstack.discard(1);
    ELSE
      EVAL u.vstack.dobin(Op.oSUB, FALSE, TRUE);
    END
  END subtract;

PROCEDURE multiply (u: U;  t: AType) =
  (* s1.t := s1.t * s0.t ; pop *)
  VAR indreg:= BASE_FOR_PIC;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("multiply");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    IF t >= Type.Reel AND t <= Type.XReel THEN
      u.vstack.prepare_fstack(FOp.fMUL, FALSE);
      u.vstack.get_addr_in_GOT(Operand{loc := OLoc.fstack,
				       mvar:= u.cg.ftop_mem}, indreg);
      u.cg.binFOp(FOp.fMUL, 1, indreg);
      u.vstack.discard_indreg(indreg);
      u.vstack.discard(1);
    ELSE
      IF t = Type.Int THEN
        u.vstack.doimul();
      ELSE
        u.vstack.doumul();
      END
    END;
  END multiply;

PROCEDURE divide (u: U;  t: RType) =
  (* s1.t := s1.t / s0.t ; pop *)
  VAR indreg:= BASE_FOR_PIC;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("divide");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.prepare_fstack(FOp.fDIV, FALSE);
    u.vstack.get_addr_in_GOT(Operand{loc := OLoc.fstack,
				       mvar:= u.cg.ftop_mem}, indreg);
    u.cg.binFOp(FOp.fDIV, 1, indreg);
    u.vstack.discard_indreg(indreg);
    u.vstack.discard(1);
  END divide;

CONST SignName = ARRAY Sign OF TEXT { " P", " N", " X" };

PROCEDURE div (u: U;  t: IType;  a, b: Sign) =
  (* s1.t := s1.t DIV s0.t ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("div");
      u.wr.TName (t);
      u.wr.OutT  (SignName [a]);
      u.wr.OutT  (SignName [b]);
      u.wr.NL    ();
    END;

    IF t = Type.Word THEN
      a := Sign.Positive;
      b := Sign.Positive;
    END;

    u.vstack.dodiv(a, b);
  END div;

PROCEDURE mod (u: U;  t: IType;  a, b: Sign) =
  (* s1.t := s1.t MOD s0.t ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("mod");
      u.wr.TName (t);
      u.wr.OutT  (SignName [a]);
      u.wr.OutT  (SignName [b]);
      u.wr.NL    ();
    END;

    IF t = Type.Word THEN
      a := Sign.Positive;
      b := Sign.Positive;
    END;

    u.vstack.domod(a, b);
  END mod;

PROCEDURE negate (u: U;  t: AType) =
  (* s0.t := - s0.t *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("negate");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    IF t >= Type.Reel AND t <= Type.XReel THEN
      u.vstack.prepare_fstack(FOp.fCHS, FALSE);
      u.cg.noargFOp(FOp.fCHS);
    ELSE
      u.vstack.doneg();
    END
  END negate;

PROCEDURE abs      (u: U;  t: AType) =
  (* s0.t := ABS (s0.t) (noop on Words) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("abs");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    CASE t OF
      Type.Word =>
    | Type.Int => u.vstack.doabs();
    ELSE
      u.vstack.prepare_fstack(FOp.fABS, FALSE);
      u.cg.noargFOp(FOp.fABS);
    END
  END abs;

PROCEDURE max      (u: U;  t: ZType) =
  (* s1.t := MAX (s1.t, s0.t) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("max");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.domaxmin(t, MaxMin.Max);
  END max;

PROCEDURE min      (u: U;  t: ZType) =
  (* s1.t := MIN (s1.t, s0.t) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("min");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.domaxmin(t, MaxMin.Min);
  END min;

PROCEDURE round    (u: U;  t: RType) =
  (* s0.I := ROUND (s0.t) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("round");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.fltoint(FlToInt.Round);
  END round;

PROCEDURE trunc    (u: U;  t: RType) =
  (* s0.I := TRUNC (s0.t) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("trunc");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.fltoint(FlToInt.Truncate);
  END trunc;

PROCEDURE floor    (u: U;  t: RType) =
  (* s0.I := FLOOR (s0.t) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("floor");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.fltoint(FlToInt.Floor);
  END floor;

PROCEDURE ceiling  (u: U;  t: RType) =
  (* s0.I := CEILING (s0.t) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("ceiling");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.fltoint(FlToInt.Ceiling);
  END ceiling;

PROCEDURE cvt_float (u: U;  t: AType;  x: RType) =
  (* s0.x := FLOAT (s0.t, x) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("cvt_float");
      u.wr.TName (t);
      u.wr.TName (x);
      u.wr.NL    ();
    END;

    IF t >= Type.Reel THEN
      RETURN;
    END;

    u.vstack.inttoflt();
  END cvt_float;

(*------------------------------------------------------------------ sets ---*)

TYPE SetProc =
  {  union, difference, intersection, sym_difference,
     range,
     eq, ne, lt, le, gt, ge,
     member,
     singleton  };

(* union .. sym_difference -> (n_bits, *c, *b, *a): Void
   range                   -> (b, a, *s): Void
   eq .. ge                -> (n_bits, *b, *a): Int
   member                  -> (elt, *set): Int
   singleton               -> (a, *s): Void *)

PROCEDURE set_proc (u: U; s: ByteSize; proc: SetProc) =
  BEGIN
    start_int_proc(u, u.set_procs[proc]);

    CASE proc OF
      SetProc.union .. SetProc.sym_difference =>
        load_stack_param(u, Type.Addr, 2);
        load_stack_param(u, Type.Addr, 1);
        pop_param(u, Type.Addr);
        u.vstack.discard(2);
    | SetProc.range =>
        load_stack_param(u, Type.Addr, 2);
        load_stack_param(u, Type.Int, 1);
        pop_param(u, Type.Int);
        u.vstack.discard(2);
    | SetProc.eq .. SetProc.ge =>
        u.vstack.swap();
        pop_param(u, Type.Addr);
        pop_param(u, Type.Addr);
    | SetProc.member .. SetProc.singleton =>
        u.vstack.swap();
        pop_param(u, Type.Int);
        pop_param(u, Type.Int);
    END;

    IF proc <= SetProc.ge AND proc # SetProc.range THEN
      u.vstack.pushimm(s * 8);
      pop_param(u, Type.Int);
    END;

    call_direct(u, u.set_procs[proc].proc, u.set_procs[proc].ret_type);
  END set_proc;

PROCEDURE set_union (u: U;  s: ByteSize) =
  (* s1.B := s1.B + s0.B ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_union");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.union);
  END set_union;

PROCEDURE set_difference (u: U;  s: ByteSize) =
  (* s1.B := s1.B - s0.B ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_difference");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.difference);
  END set_difference;

PROCEDURE set_intersection (u: U;  s: ByteSize) =
  (* s1.B := s1.B * s0.B ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_intersection");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.intersection);
  END set_intersection;

PROCEDURE set_sym_difference (u: U;  s: ByteSize) =
  (* s1.B := s1.B / s0.B ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_sym_difference");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.sym_difference);
  END set_sym_difference;

PROCEDURE set_member       (u: U;  s: ByteSize) =
  (* s1.I := (s0.I IN s1.B) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_member");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.member);
  END set_member;

PROCEDURE set_eq       (u: U;  s: ByteSize) =
  (* s1.I := (s1.B = s0.B)  ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_eq");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.eq);
  END set_eq;

PROCEDURE set_ne (u: U;  s: ByteSize) =
  (* s1.I := (s1.B # s0.B)  ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_ne");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.ne);
  END set_ne;

PROCEDURE set_gt (u: U;  s: ByteSize) =
  (* s1.I := (s1.B > s0.B)  ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_gt");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.gt);
  END set_gt;

PROCEDURE set_ge (u: U;  s: ByteSize) =
  (* s1.I := (s1.B >= s0.B) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_ge");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.ge);
  END set_ge;

PROCEDURE set_lt (u: U;  s: ByteSize) =
  (* s1.I := (s1.B < s0.B)  ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_lt");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.lt);
  END set_lt;

PROCEDURE set_le (u: U;  s: ByteSize) =
  (* s1.I := (s1.B <= s0.B) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_le");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.le);
  END set_le;

PROCEDURE set_range (u: U;  s: ByteSize) =
  (* s2.A [s1.I .. s0.I] := 1's; pop(3)*)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_range");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.range);
  END set_range;

PROCEDURE set_singleton (u: U;  s: ByteSize) =
  (* s1.A [s0.I] := 1; pop(2) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("set_singleton");
      u.wr.Int   (s);
      u.wr.NL    ();
    END;

    set_proc(u, s, SetProc.singleton);
  END set_singleton;

(*------------------------------------------------- Word.T bit operations ---*)

PROCEDURE not (u: U) =
  (* s0.I := Word.Not (s0.I) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("not");
      u.wr.TName (Type.Int);
      u.wr.NL    ();
    END;

    WITH stack0 = u.vstack.pos(0, "not") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        u.vstack.set_imm(stack0, Word.Not (u.vstack.op(stack0).imm));
      ELSE
        u.vstack.unlock();
        u.vstack.find(stack0, Force.anytemp);
        u.cg.unOp(Op.oNOT, u.vstack.op(stack0));
        u.vstack.newdest(u.vstack.op(stack0));
      END
    END
  END not;

PROCEDURE and (u: U) =
  (* s1.I := Word.And (s1.I, s0.I) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("and");
      u.wr.TName (Type.Int);
      u.wr.NL    ();
    END;

    EVAL u.vstack.dobin(Op.oAND, TRUE, TRUE);
  END and;

PROCEDURE or  (u: U) =
  (* s1.I := Word.Or  (s1.I, s0.I) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("or");
      u.wr.TName (Type.Int);
      u.wr.NL    ();
    END;

    EVAL u.vstack.dobin(Op.oOR, TRUE, TRUE);
  END or;

PROCEDURE xor (u: U) =
  (* s1.I := Word.Xor (s1.I, s0.I) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("xor");
      u.wr.TName (Type.Int);
      u.wr.NL    ();
    END;

    EVAL u.vstack.dobin(Op.oXOR, TRUE, TRUE);
  END xor;

PROCEDURE shift        (u: U) =
  (* s1.I := Word.Shift  (s1.I, s0.I) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("shift");
      u.wr.TName (Type.Int);
      u.wr.NL    ();
    END;

    u.vstack.doshift();
  END shift;

PROCEDURE shift_left   (u: U) =
  (* s1.I := Word.Shift  (s1.I, s0.I) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("shift_left");
      u.wr.TName (Type.Int);
      u.wr.NL    ();
    END;

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "shift_left"),
         stack1 = u.vstack.pos(1, "shift_left") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        IF u.vstack.loc(stack1) = OLoc.imm THEN
          u.vstack.set_imm(stack1, Word.Shift(u.vstack.op(stack1).imm,
                                              u.vstack.op(stack0).imm));
        ELSE
          u.vstack.find(stack1, Force.anytemp);
          u.vstack.set_imm(stack0, Word.And(u.vstack.op(stack0).imm, 16_1F));
          u.cg.immOp(Op.oSAL, u.vstack.op(stack1), u.vstack.op(stack0).imm);
          u.vstack.newdest(u.vstack.op(stack1));
        END
      ELSE
        u.vstack.find(stack0, Force.regset, RegSet {Codex86.ECX});
        u.vstack.find(stack1, Force.anytemp);

        IF u.vstack.loc(stack1) = OLoc.imm THEN
          u.vstack.find(stack1, Force.anyreg);
        END;

        u.cg.unOp(Op.oSAL, u.vstack.op(stack1));
        u.vstack.newdest(u.vstack.op(stack1));
      END;

      u.vstack.discard(1);
    END
  END shift_left;

PROCEDURE shift_right  (u: U) =
  (* s1.I := Word.Shift  (s1.I, -s0.I) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("shift_right");
      u.wr.TName (Type.Int);
      u.wr.NL    ();
    END;

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "shift_right"),
         stack1 = u.vstack.pos(1, "shift_right") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        IF u.vstack.loc(stack1) = OLoc.imm THEN
          u.vstack.set_imm(stack1, Word.Shift(u.vstack.op(stack1).imm,
                                              -u.vstack.op(stack0).imm));
        ELSE
          u.vstack.find(stack1, Force.anytemp);
          u.vstack.set_imm(stack0, Word.And(u.vstack.op(stack0).imm, 16_1F));
          u.cg.immOp(Op.oSHR, u.vstack.op(stack1), u.vstack.op(stack0).imm);
          u.vstack.newdest(u.vstack.op(stack1));
        END
      ELSE
        u.vstack.find(stack0, Force.regset, RegSet {Codex86.ECX});
        u.vstack.find(stack1, Force.anytemp);

        IF u.vstack.loc(stack1) = OLoc.imm THEN
          u.vstack.find(stack1, Force.anyreg);
        END;

        u.cg.unOp(Op.oSHR, u.vstack.op(stack1));
        u.vstack.newdest(u.vstack.op(stack1));
      END;

      u.vstack.discard(1);
    END
  END shift_right;

PROCEDURE rotate       (u: U) =
  (* s1.I := Word.Rotate (s1.I, s0.I) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("rotate");
      u.wr.TName (Type.Int);
      u.wr.NL    ();
    END;

    u.vstack.dorotate();
  END rotate;

PROCEDURE rotate_left  (u: U) =
  (* s1.I := Word.Rotate (s1.I, s0.I) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("rotate_left");
      u.wr.TName (Type.Int);
      u.wr.NL    ();
    END;

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "rotate_left"),
         stack1 = u.vstack.pos(1, "rotate_left") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        IF u.vstack.loc(stack1) = OLoc.imm THEN
          u.vstack.set_imm(stack1, Word.Rotate(u.vstack.op(stack1).imm,
                                               u.vstack.op(stack0).imm));
        ELSE
          u.vstack.find(stack1, Force.anytemp);
          u.vstack.set_imm(stack0, Word.And(u.vstack.op(stack0).imm, 16_1F));
          u.cg.immOp(Op.oROL, u.vstack.op(stack1), u.vstack.op(stack0).imm);
          u.vstack.newdest(u.vstack.op(stack1));
        END
      ELSE
        u.vstack.find(stack0, Force.regset, RegSet {Codex86.ECX});
        u.vstack.find(stack1, Force.anytemp);

        IF u.vstack.loc(stack1) = OLoc.imm THEN
          u.vstack.find(stack1, Force.anyreg);
        END;

        u.cg.unOp(Op.oROL, u.vstack.op(stack1));
        u.vstack.newdest(u.vstack.op(stack1));
      END;

      u.vstack.discard(1);
    END
  END rotate_left;

PROCEDURE rotate_right (u: U) =
  (* s1.I := Word.Rotate (s1.I, -s0.I) ; pop *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("rotate_right");
      u.wr.TName (Type.Int);
      u.wr.NL    ();
    END;

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "rotate_right"),
         stack1 = u.vstack.pos(1, "rotate_right") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        IF u.vstack.loc(stack1) = OLoc.imm THEN
          u.vstack.set_imm(stack1, Word.Rotate(u.vstack.op(stack1).imm,
                                               -u.vstack.op(stack0).imm));
        ELSE
          u.vstack.find(stack1, Force.anytemp);
          u.vstack.set_imm(stack0, Word.And(u.vstack.op(stack0).imm, 16_1F));
          u.cg.immOp(Op.oROR, u.vstack.op(stack1), u.vstack.op(stack0).imm);
          u.vstack.newdest(u.vstack.op(stack1));
        END
      ELSE
        u.vstack.find(stack0, Force.regset, RegSet {Codex86.ECX});
        u.vstack.find(stack1, Force.anytemp);

        IF u.vstack.loc(stack1) = OLoc.imm THEN
          u.vstack.find(stack1, Force.anyreg);
        END;

        u.cg.unOp(Op.oROR, u.vstack.op(stack1));
        u.vstack.newdest(u.vstack.op(stack1));
      END;

      u.vstack.discard(1);
    END
  END rotate_right;

PROCEDURE extract (u: U;  sign: BOOLEAN) =
  (* s2.I := Word.Extract(s2.I, s1.I, s0.I);
     IF sign THEN SignExtend s2 END; pop(2) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("extract");
      u.wr.Bool  (sign);
      u.wr.NL    ();
    END;

    u.vstack.doextract(sign);
  END extract;

PROCEDURE extract_n (u: U;  sign: BOOLEAN;  n: INTEGER) =
  (* s1.I := Word.Extract(s1.I, s0.I, n);
     IF sign THEN SignExtend s1 END; pop(1) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("extract_n");
      u.wr.Bool  (sign);
      u.wr.Int   (n);
      u.wr.NL    ();
    END;

    u.vstack.doextract_n(sign, n);
  END extract_n;

PROCEDURE extract_mn (u: U;  sign: BOOLEAN;  m, n: INTEGER) =
  (* s0.I := Word.Extract(s0.I, m, n);
     IF sign THEN SignExtend s0 END; *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("extract_mn");
      u.wr.Bool  (sign);
      u.wr.Int   (m); 
      u.wr.Int   (n);
      u.wr.NL    ();
    END;

    u.vstack.doextract_mn(sign, m, n);
  END extract_mn;

PROCEDURE insert  (u: U) =
  (* s3.I := Word.Insert (s3.I, s2.I, s1.I, s0.I) ; pop(3) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("insert");
      u.wr.NL    ();
    END;

    u.vstack.doinsert();
  END insert;

PROCEDURE insert_n  (u: U;  n: INTEGER) =
  (* s2.I := Word.Insert (s2.I, s1.I, s0.I, n) ; pop(2) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("insert_n");
      u.wr.Int   (n);
      u.wr.NL    ();
    END;

    u.vstack.doinsert_n(n);
  END insert_n;

PROCEDURE insert_mn  (u: U;  m, n: INTEGER) =
  (* s1.I := Word.Insert (s1.I, s0.I, m, n) ; pop(2) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("insert_mn");
      u.wr.Int   (m); 
      u.wr.Int   (n);
      u.wr.NL    ();
    END;

    u.vstack.doinsert_mn(m, n);
  END insert_mn;

(*------------------------------------------------ misc. stack/memory ops ---*)

PROCEDURE swap (u: U;  a, b: Type) =
  (* tmp := s1 ; s1 := s0 ; s0 := tmp *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("swap");
      u.wr.TName (a);
      u.wr.TName (b);
      u.wr.NL    ();
    END;

    u.vstack.swap();
  END swap;

PROCEDURE pop (u: U;  t: Type) =
  (* pop(1) (i.e. discard s0) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("pop");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    u.vstack.unlock();
    IF t >= Type.Reel AND t <= Type.XReel THEN
      WITH stack0 = u.vstack.pos(0, "pop") DO
        <* ASSERT u.vstack.loc(stack0) = OLoc.fstack *>
        u.cg.fstack_discard();
      END
    END;

    u.vstack.discard(1);
  END pop;

PROCEDURE copy_n (u: U;  t: MType;  overlap: BOOLEAN) =
  (* Mem[s2.A:s0.I] := Mem[s1.A:s0.I]; pop(3)*)
  VAR shift, n: INTEGER;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("copy_n");
      u.wr.TName (t);
      u.wr.Bool  (overlap);
      u.wr.NL    ();
    END;

    WITH stack0 = u.vstack.pos(0, "copy_n") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        n := u.vstack.op(stack0).imm;
        u.vstack.discard(1);
        copy(u, n, t, overlap);
        RETURN;
      END
    END;

    IF CG_Bytes[t] # 1 THEN
      WITH stack0 = u.vstack.pos(0, "copy_n") DO
        u.vstack.unlock();

        CASE CG_Bytes[t] OF
          2 => shift := 1;
        | 4 => shift := 2;
        | 8 => shift := 3;
        ELSE
          u.Err("Unknown MType size in copy_n");
        END;

        u.vstack.find(stack0, Force.anyreg);

        u.cg.immOp(Op.oSAL, u.vstack.op(stack0), shift);
      END
    END;

    IF overlap THEN
      start_int_proc(u, u.memmoveproc);
    ELSE
      start_int_proc(u, u.memcpyproc);
    END;

    pop_param(u, Type.Int);
    pop_param(u, Type.Addr);
    pop_param(u, Type.Addr);

    IF overlap THEN
      call_direct(u, u.memmoveproc.proc, Type.Addr);
    ELSE
      call_direct(u, u.memcpyproc.proc, Type.Addr);
    END;

    u.vstack.discard(1);
  END copy_n;

CONST MAXINLINECOPY = 8;

CONST faketype = ARRAY [1 .. 4] OF MType
  { Type.Word_A, Type.Word_B, Type.Word, Type.Word };

PROCEDURE inline_copy (u: U; n, size: INTEGER; forward: BOOLEAN) =
  VAR start, end, step: INTEGER;
      movereg: Regno;
  BEGIN
    IF forward THEN
      start := 0; end := n - 1; step := 1;
    ELSE
      start := n - 1; end := 0; step := -1;
    END;

    movereg := u.vstack.freereg();

    WITH stop0 = u.vstack.op(u.vstack.pos(0, "inline_copy")),
         stop1 = u.vstack.op(u.vstack.pos(1, "inline_copy")) DO
      FOR i := start TO end BY step DO
        u.cg.fast_load_ind(movereg, stop0, i * size, size);
        u.cg.store_ind(u.cg.reg[movereg], stop1, i * size, faketype[size]);
      END
    END
  END inline_copy;

PROCEDURE string_copy (u: U; n, size: INTEGER; forward: BOOLEAN) =
  BEGIN
    u.vstack.corrupt(Codex86.ECX);
    u.cg.movImm(u.cg.reg[Codex86.ECX], n);

    IF forward THEN
      u.cg.noargOp(Op.oCLD);
    ELSE
      u.cg.immOp(Op.oADD, u.cg.reg[Codex86.ESI], (n - 1) * size);
      u.cg.immOp(Op.oADD, u.cg.reg[Codex86.EDI], (n - 1) * size);
      u.cg.noargOp(Op.oSTD);
    END;

    u.cg.noargOp(Op.oREP);
    CASE size OF
      1 => u.cg.noargOp(Op.oMOVSB);
    | 2 => u.cg.MOVSWOp();
    | 4 => u.cg.noargOp(Op.oMOVSD);
    ELSE
      u.Err("Illegal size in copy");
    END;

    IF NOT forward THEN
      u.cg.noargOp(Op.oCLD);
    END
  END string_copy;

PROCEDURE copy (u: U;  n: INTEGER;  t: MType;  overlap: BOOLEAN) =
  (* Mem[s1.A:sz] := Mem[s0.A:sz]; pop(2)*)
  VAR size := CG_Bytes[t];
      forward, end: Label;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("copy");
      u.wr.Int   (n);
      u.wr.TName (t);
      u.wr.Bool  (overlap);
      u.wr.NL    ();
    END;

    IF size = 1 AND Word.And(n, 3) = 0 THEN
      n := Word.Shift(n, -2);
      size := 4;
    END;

    IF size = 2 AND Word.And(n, 1) = 0 THEN
      n := Word.Shift(n, -1);
      size := 4;
    END;

    IF size = 8 THEN
      n := Word.Shift(n, 1);
      size := 4;
    END;

    u.vstack.unlock();

    WITH stack0 = u.vstack.pos(0, "copy"), stack1 = u.vstack.pos(1, "copy") DO
      IF n > MAXINLINECOPY THEN
        u.vstack.find(stack0, Force.regset, RegSet { Codex86.ESI } );
        u.vstack.find(stack1, Force.regset, RegSet { Codex86.EDI } );
      ELSE
        u.vstack.find(stack0, Force.anyreg, RegSet {}, TRUE);
        u.vstack.find(stack1, Force.anyreg, RegSet {}, TRUE);
      END
    END;

    IF overlap AND n > 1 THEN
      forward := u.cg.reserve_labels(1, TRUE);
      end := u.cg.reserve_labels(1, TRUE);
      u.cg.binOp(Op.oCMP, u.cg.reg[Codex86.ESI], u.cg.reg[Codex86.EDI]);
      u.cg.brOp(Cond.GE, forward);

      IF n <= MAXINLINECOPY THEN
        inline_copy(u, n, size, FALSE);
      ELSE
        string_copy(u, n, size, FALSE);
      END;

      u.cg.brOp(Cond.Always, end);
      u.cg.set_label(forward);
    END;

    IF n <= MAXINLINECOPY THEN
      inline_copy(u, n, size, TRUE);
    ELSE
      string_copy(u, n, size, TRUE);
    END;

    IF overlap AND n > 1 THEN
      u.cg.set_label(end);
    END;

    IF n > MAXINLINECOPY THEN
      u.vstack.newdest(u.cg.reg[Codex86.ESI]);
      u.vstack.newdest(u.cg.reg[Codex86.EDI]);
    END;

    u.vstack.discard(2);
  END copy;

PROCEDURE zero_n (u: U;  t: MType) =
  (* Mem[s1.A:s0.I] := 0; pop(2) *)
  VAR shift, n: INTEGER;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("zero_n");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    WITH stack0 = u.vstack.pos(0, "zero_n") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        n := u.vstack.op(stack0).imm;
        u.vstack.discard(1);
        zero(u, n, t);
        RETURN;
      END
    END;

    IF CG_Bytes[t] # 1 THEN
      WITH stack0 = u.vstack.pos(0, "zero_n") DO
        u.vstack.unlock();
        u.vstack.find(stack0, Force.anyreg);

        CASE CG_Bytes[t] OF
          2 => shift := 1;
        | 4 => shift := 2;
        | 8 => shift := 3;
        ELSE
          u.Err("Unknown MType size in zero_n");
        END;

        u.cg.immOp(Op.oSAL, u.vstack.op(stack0), shift);
      END
    END;

    start_int_proc(u, u.memsetproc);

    pop_param(u, Type.Int);

    u.vstack.pushimm(0);
    pop_param(u, Type.Int);

    pop_param(u, Type.Addr);

    call_direct(u, u.memsetproc.proc, Type.Addr);

    u.vstack.discard(1);
  END zero_n;

PROCEDURE zero (u: U;  n: INTEGER;  t: MType) =
  (* Mem[s0.A:sz] := 0; pop(1) *)
  VAR size := CG_Bytes[t];
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("zero");
      u.wr.Int   (n);
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    IF size = 1 AND Word.And(n, 3) = 0 THEN
      n := Word.Shift(n, -2);
      size := 4;
    END;

    IF size = 2 AND Word.And(n, 1) = 0 THEN
      n := Word.Shift(n, -1);
      size := 4;
    END;

    IF size = 8 THEN
      n := Word.Shift(n, 1);
      size := 4;
    END;

    u.vstack.unlock();

    IF n > MAXINLINECOPY THEN
      u.vstack.find(u.vstack.pos(0, "zero"), Force.regset,
                    RegSet { Codex86.EDI } );
      u.vstack.corrupt(Codex86.EAX);
      u.vstack.corrupt(Codex86.ECX);

      u.cg.binOp(Op.oXOR, u.cg.reg[Codex86.EAX], u.cg.reg[Codex86.EAX]);
      u.cg.movImm(u.cg.reg[Codex86.ECX], n);

      u.cg.noargOp(Op.oCLD);
      u.cg.noargOp(Op.oREP);
      CASE size OF
        1 => u.cg.noargOp(Op.oSTOSB);
      | 2 => u.cg.STOSWOp();
      | 4 => u.cg.noargOp(Op.oSTOSD);
      ELSE
             u.Err("Illegal size in zero");
      END;
      u.vstack.newdest(u.cg.reg[Codex86.EDI]);

    ELSE
      WITH stack0 = u.vstack.pos(0, "zero"), stop0 = u.vstack.op(stack0) DO
        u.vstack.find(stack0, Force.anyreg, RegSet {}, TRUE);
        FOR i := 0 TO n - 1 DO
          u.cg.store_ind(Operand { loc := OLoc.imm, imm := 0 },
                         stop0, i * size, faketype[size]);
        END
      END
    END;

    u.vstack.discard(1);
  END zero;

PROCEDURE start_int_proc(u: U; VAR internal: IntProc) =
  BEGIN
    IF NOT internal.used THEN
      internal.proc := import_procedure(u, M3ID.Add(internal.name),
                                        internal.n_params,
                                        internal.ret_type,
                                        Target.FindConvention (internal.lang));
      FOR i := 1 TO internal.n_params DO
        EVAL declare_param(u, M3ID.NoID, 4, 4, Type.Addr, 0, FALSE, FALSE,
                           100);
      END;

      internal.used := TRUE;
    END;

    start_call_direct(u, internal.proc, 0, internal.ret_type);
  END start_int_proc;

TYPE IntProc = RECORD
  used: BOOLEAN;
  proc: x86Proc;
  name: TEXT;
  n_params: INTEGER;
  ret_type: Type;
  lang: TEXT;
END;

(*----------------------------------------------------------- conversions ---*)

PROCEDURE loophole (u: U;  from, two: ZType) =
  (* s0.to := LOOPHOLE(s0.from, to) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("loophole");
      u.wr.TName (from);
      u.wr.TName (two);
      u.wr.NL    ();
    END;

    u.vstack.doloophole(from, two);

  END loophole;

(*------------------------------------------------ traps & runtime checks ---*)

PROCEDURE assert_fault (u: U) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("assert_fault");
      u.wr.NL    ();
    END;

    reportfault(u, 0);
  END assert_fault;

PROCEDURE narrow_fault (u: U) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("narrow_fault");
      u.wr.NL    ();
    END;

    reportfault(u, 5);
  END narrow_fault;

PROCEDURE return_fault (u: U) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("return_fault");
      u.wr.NL    ();
    END;

    reportfault(u, 6);
  END return_fault;

PROCEDURE case_fault (u: U) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("case_fault");
      u.wr.NL    ();
    END;

    reportfault(u, 7);
  END case_fault;

PROCEDURE typecase_fault (u: U) =
  (* Abort *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("typecase_fault");
      u.wr.NL    ();
    END;

    reportfault(u, 8);
  END typecase_fault;

PROCEDURE reportfault (u: U; info: INTEGER) =
  VAR labelname    : TEXT;
  BEGIN
    IF NOT u.usedfault THEN
      labelname  := M3ID.ToText (u.global_var.name) & "_CRASH";
      u.reportID := M3ID.Add(labelname);
      u.reportsymbol := u.obj.define_symbol(u.reportID, Seg.Text, 0);
      u.usedfault := TRUE;
    END;

    info := info + u.lineno * 16;
    u.cg.movImm(u.cg.reg[Codex86.EAX], info);

    IF u.pic THEN
      u.cg.picCall(u.reportsymbol);
    ELSE
      u.cg.intCall(u.reportlabel);
    END;

  END reportfault;

PROCEDURE makereportproc (u: U) =
  VAR
    repproc  : Proc;
    repfault :  Var;
    repfoff  :  ByteOffset;
    indreg   := BASE_FOR_PIC;
    op 	     :  Operand;
  BEGIN
    <* ASSERT u.rfault_name # 0 *>

    get_runtime_hook(u, u.rfault_name, repproc, repfault, repfoff);

    u.cg.set_label(u.reportlabel);

    u.obj.move_symbol(u.reportsymbol, u.obj.cursor(Seg.Text));

    u.obj.declare_procedure(u.reportID, M3ID.NoID, Type.Void, FALSE,
							      u.reportsymbol);
    u.obj.declare_param(M3ID.Add("arg"), Target.Integer.size, 8, 16_195C2A74,
		        Type.Word);   (* INTEGER TypeUID *)

    u.obj.begin_procedure(u.reportsymbol, u.obj.cursor(Seg.Text));

    u.cg.pushOp(u.cg.reg[Codex86.EBP]);
    u.cg.movOp(u.cg.reg[Codex86.EBP], u.cg.reg[Codex86.ESP]);

    IF u.pic THEN
      u.cg.relCall(0);
      u.cg.popOp(u.cg.reg[Codex86.EBX]);
      u.cg.immOp(Op.oADD, u.cg.reg[Codex86.EBX], 16_FFFF);
      u.obj.patch(Seg.Text, u.obj.cursor(Seg.Text) - 4, 3, 4);
      u.obj.relocate(u.textsym, u.obj.cursor(Seg.Text) - 4,
		      u.GOTsym, R_386_GOTPC);
    END;

    u.obj.begin_block();

    u.cg.pushOp(u.cg.reg[Codex86.EAX]);

    IF (repfault # NIL) THEN
      load_address(u, u.global_var, 0);
      INC(u.in_proc_call);
      pop_param(u, Type.Addr);
      DEC(u.in_proc_call);
      load(u, repfault, repfoff, Type.Addr);
      op := u.vstack.op(u.vstack.pos(0, "makereportproc"));
      u.vstack.get_addr_in_GOT(op, indreg);
      u.cg.rmCall(op, indreg);
      u.vstack.discard_indreg(indreg);
      u.vstack.discard(1);
    ELSIF (repproc # NIL) THEN
      start_call_direct(u, repproc, 0, Type.Void);
      INC(u.call_param_size[u.in_proc_call-1], 4); (* remember error code *)
      load_address(u, u.global_var, 0);
      pop_param(u, Type.Addr);
      call_direct(u, repproc, Type.Void);
    ELSE
      u.Err ("cannot locate the runtime procedure to report errors!")
    END;

    u.obj.end_block();
    u.obj.end_procedure(u.reportsymbol);
  END makereportproc;

PROCEDURE check_nil (u: U) =
  (* IF (s0.A = NIL) THEN Abort *)
  VAR safelab: Label;
      indreg := BASE_FOR_PIC;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("check_nil");
      u.wr.NL    ();
    END;

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "check_nil") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        IF u.vstack.op(stack0).imm = 0 THEN
          reportfault(u, 4);
        END
      ELSE
        u.vstack.find(stack0, Force.any, RegSet {}, TRUE);

        IF NOT u.vstack.non_nil(u.vstack.reg(stack0)) THEN
          u.vstack.get_addr_in_GOT(u.vstack.op(stack0), indreg);  
          u.cg.immOp(Op.oCMP, u.vstack.op(stack0), 0, indreg);
          u.vstack.discard_indreg(indreg);
          safelab := u.cg.reserve_labels(1, TRUE);
          u.cg.brOp(Cond.NE, safelab);
          reportfault(u, 4);
          u.cg.set_label(safelab);
        END;

        u.vstack.set_non_nil(u.vstack.reg(stack0));
      END
    END
  END check_nil;

PROCEDURE check_lo (u: U;  READONLY i: Target.Int) =
  (* IF (s0.I < i) THEN Abort *)
  VAR int: INTEGER;  safelab: Label;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("check_lo");
      u.wr.TInt (i);
      u.wr.NL    ();
    END;

    EVAL TargetInt.ToInt(i, int);

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "check_lo") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        IF u.vstack.op(stack0).imm < int THEN
          reportfault(u, 1);
        END
      ELSE
        u.vstack.find(stack0, Force.anyreg);
        IF u.vstack.lower(u.vstack.reg(stack0)) >= int THEN
          (* ok *)
        ELSIF u.vstack.upper(u.vstack.reg(stack0)) < int THEN
          reportfault(u, 1);
        ELSE
          u.cg.immOp(Op.oCMP, u.vstack.op(stack0), int);
          safelab := u.cg.reserve_labels(1, TRUE);
          u.cg.brOp(Cond.GE, safelab);
          reportfault(u, 1);
          u.cg.set_label(safelab);
          u.vstack.set_lower(u.vstack.reg(stack0), int);
        END
      END
    END
  END check_lo;

PROCEDURE check_hi (u: U;  READONLY i: Target.Int) =
  (* IF (i < s0.I) THEN Abort *)
  VAR int: INTEGER;
      safelab: Label;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("check_hi");
      u.wr.TInt (i);
      u.wr.NL    ();
    END;

    EVAL TargetInt.ToInt(i, int);

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "check_hi") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        IF int < u.vstack.op(stack0).imm THEN
          reportfault(u, 1);
        END
      ELSE
        u.vstack.find(stack0, Force.anyreg);
        IF u.vstack.upper(u.vstack.reg(stack0)) <= int THEN
          (* ok *)
        ELSIF u.vstack.lower(u.vstack.reg(stack0)) > int THEN
          reportfault(u, 1);
        ELSE
          u.cg.immOp(Op.oCMP, u.vstack.op(stack0), int);
          safelab := u.cg.reserve_labels(1, TRUE);
          u.cg.brOp(Cond.LE, safelab);
          reportfault(u, 1);
          u.cg.set_label(safelab);
          u.vstack.set_upper(u.vstack.reg(stack0), int);
        END
      END
    END
  END check_hi;

PROCEDURE check_range (u: U;  READONLY a, b: Target.Int) =
  (* IF (s0.I < a) OR (b < s0.I) THEN Abort *)
  VAR inta, intb, lo, hi: INTEGER;   safelab, outrange: Label;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("check_range");
      u.wr.TInt (a);
      u.wr.TInt (b);
      u.wr.NL    ();
    END;

    EVAL TargetInt.ToInt(a, inta);
    EVAL TargetInt.ToInt(b, intb);

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "check_range") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        lo := u.vstack.op(stack0).imm;
        IF (lo < inta) OR (intb < lo) THEN
          reportfault(u, 1);
        END;
        RETURN;
      END;

      u.vstack.find(stack0, Force.anyreg);
      WITH reg = u.vstack.reg(stack0) DO
        lo := u.vstack.lower(reg);
        hi := u.vstack.upper(reg);
        IF (inta <= lo) AND (hi <= intb) THEN
          (* ok *)
        ELSIF (hi < inta) OR (intb < lo) THEN
          reportfault(u, 1);
        ELSIF (hi <= intb) THEN
          check_lo(u, a);
        ELSIF (lo >= inta) THEN
          check_hi(u, b);
        ELSIF (inta = 0) THEN
          (* 0 <= x <= b  ==>   UNSIGNED(x) <= b *)
          safelab := u.cg.reserve_labels(1, TRUE);
          u.cg.immOp(Op.oCMP, u.vstack.op(stack0), intb);
          u.cg.brOp(unscond [Cond.LE], safelab);
          reportfault(u, 1);
          u.cg.set_label(safelab);
          u.vstack.set_upper(reg, intb);
          u.vstack.set_lower(reg, inta);
        ELSE
          safelab := u.cg.reserve_labels(1, TRUE);
          outrange := u.cg.reserve_labels(1, TRUE);
          u.cg.immOp(Op.oCMP, u.vstack.op(stack0), inta);
          u.cg.brOp(Cond.L, outrange);
          u.cg.immOp(Op.oCMP, u.vstack.op(stack0), intb);
          u.cg.brOp(Cond.LE, safelab);
          u.cg.set_label(outrange);
          reportfault(u, 1);
          u.cg.set_label(safelab);
          u.vstack.set_upper(reg, intb);
          u.vstack.set_lower(reg, inta);
        END;
      END
    END
  END check_range;

PROCEDURE check_index (u: U) =
  (* IF (s0.W <= s1.W) THEN Abort *)
  VAR safelab: Label;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("check_index");
      u.wr.NL    ();
    END;


    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "check_index"),
         stack1 = u.vstack.pos(1, "check_index") DO
      IF u.vstack.loc(stack0) = OLoc.imm AND
         u.vstack.loc(stack1) = OLoc.imm THEN
        IF Word.LE(u.vstack.op(stack0).imm, u.vstack.op(stack1).imm) THEN
          reportfault(u, 2);
        END
      ELSE

        u.vstack.find(stack0, Force.any);
        u.vstack.find(stack1, Force.anyregimm);
        IF u.vstack.loc(stack0) = OLoc.mem THEN
          u.vstack.find(stack0, Force.anyregimm);
        END;

        safelab := u.cg.reserve_labels(1, TRUE);

        IF u.vstack.loc(stack0) = OLoc.imm THEN
          u.cg.binOp(Op.oCMP, u.vstack.op(stack1), u.vstack.op(stack0));
          u.cg.brOp(Cond.B, safelab);
        ELSE
          u.cg.binOp(Op.oCMP, u.vstack.op(stack0), u.vstack.op(stack1));
          u.cg.brOp(Cond.A, safelab);
        END;

        reportfault(u, 2);
        u.cg.set_label(safelab);
      END;
    END;

    u.vstack.discard(1);
  END check_index;

PROCEDURE check_eq (u: U) =
  (* IF (s0.I # s1.I) THEN Abort;  Pop (2) *)
  VAR safelab: Label;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("check_eq");
      u.wr.NL    ();
    END;

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "check_index"),
         stack1 = u.vstack.pos(1, "check_index") DO
      u.vstack.find(stack0, Force.any);
      u.vstack.find(stack1, Force.anyregimm);
      IF u.vstack.loc(stack0) = OLoc.mem THEN
        u.vstack.find(stack0, Force.anyregimm);
      END;

      IF u.vstack.loc(stack0) = OLoc.imm THEN
        u.cg.binOp(Op.oCMP, u.vstack.op(stack1), u.vstack.op(stack0));
      ELSE
        u.cg.binOp(Op.oCMP, u.vstack.op(stack0), u.vstack.op(stack1));
      END;

      safelab := u.cg.reserve_labels(1, TRUE);
      u.cg.brOp(Cond.E, safelab);
      reportfault(u, 3);
      u.cg.set_label(safelab);
    END;

    u.vstack.discard(2);
  END check_eq;

(*---------------------------------------------------- address arithmetic ---*)

PROCEDURE add_offset (u: U; i: INTEGER) =
  (* s0.A := s0.A + i *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("add_offset");
      u.wr.Int   (i);
      u.wr.NL    ();
    END;

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "add_offset") DO
      IF u.vstack.loc(stack0) = OLoc.imm THEN
        u.vstack.set_imm(stack0, u.vstack.op(stack0).imm + i);
      ELSE
        u.vstack.find(stack0, Force.anytemp, RegSet {}, TRUE);

        u.cg.immOp(Op.oADD, u.vstack.op(stack0), i);

        u.vstack.newdest(u.vstack.op(stack0));
      END
    END
  END add_offset;

PROCEDURE log2 (int: INTEGER): INTEGER =
(* Return log2(int) if int is a power of 2, -1 if it is 0, otherwise -2 *)
  BEGIN
    IF Word.And(int, int-1) # 0 THEN
      RETURN -2;
    END;

    IF int = 0 THEN
      RETURN -1;
    END;

    FOR i := 0 TO 31 DO
      int := Word.Shift(int, -1);
      IF int = 0 THEN
        RETURN i;
      END;
    END;

    RETURN -1;
  END log2;

PROCEDURE index_address (u: U;  size: INTEGER) =
  (* s1.A := s1.A + s0.I * size ; pop *)
  VAR shift: INTEGER;
      neg := FALSE;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("index_address");
      u.wr.Int   (size);
      u.wr.NL    ();
    END;

    IF size = 0 THEN
      u.Err("size = 0 in index_address");
    END;

    IF size < 0 THEN
      size := -size;
      neg := TRUE;
    END;

    shift := log2(size);

    u.vstack.doindex_address(shift, size, neg);
  END index_address;

(*------------------------------------------------------- procedure calls ---*)

PROCEDURE start_call_direct (u: U;  p: Proc;  lev: INTEGER;  t: Type) =
  (* begin a procedure call to a procedure at static level 'lev'. *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("start_call_direct");
      u.wr.PName (p);
      u.wr.Int   (lev);  
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    <* ASSERT u.in_proc_call < 2 *>

    u.static_link[u.in_proc_call] := NIL;
    u.call_param_size[u.in_proc_call] := 0;
    INC(u.in_proc_call);
  END start_call_direct;

PROCEDURE start_call_indirect (u: U;  t: Type;  cc: CallingConvention) =
  (* begin a procedure call to a procedure at static level 'lev'. *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("start_call_indirect");
      u.wr.TName (t);
      u.wr.Txt   (cc.name);
      u.wr.NL    ();
    END;

    <* ASSERT u.in_proc_call < 2 *>

    u.static_link[u.in_proc_call] := NIL;
    u.call_param_size[u.in_proc_call] := 0;
    INC(u.in_proc_call);
  END start_call_indirect;

PROCEDURE pop_param (u: U;  t: MType) =
  (* pop s0 and make it the "next" parameter in the current call *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("pop_param");
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    <* ASSERT u.in_proc_call > 0 *>

    u.vstack.unlock();
    WITH stack0 = u.vstack.pos(0, "pop_param") DO
      IF t >= Type.Reel AND t <= Type.XReel THEN
        IF t = Type.Reel THEN
          u.cg.immOp(Op.oSUB, u.cg.reg[Codex86.ESP], 4);
        ELSE
          u.cg.immOp(Op.oSUB, u.cg.reg[Codex86.ESP], 8);
        END;
	u.vstack.load_fstacktop();
        u.cg.f_storeind(u.cg.reg[Codex86.ESP], 0, t);
      ELSE

        u.vstack.find(stack0, Force.anyregimm);
        u.cg.pushOp(u.vstack.op(stack0));
      END
    END;

    u.vstack.discard(1);

    IF CG_Bytes[t] <= 4 THEN
      INC(u.call_param_size[u.in_proc_call-1], 4);
    ELSE
      <* ASSERT CG_Bytes[t] = 8 *>
      INC(u.call_param_size[u.in_proc_call-1], 8);
    END
  END pop_param;

PROCEDURE load_stack_param (u: U; t: ZType; depth: INTEGER) =
  BEGIN
    u.vstack.unlock();

    <* ASSERT u.in_proc_call > 0 *>

    WITH stack = u.vstack.pos(depth, "load_stack_param") DO
      <* ASSERT t < Type.Reel *>

      u.vstack.find(stack, Force.anyregimm);
      u.cg.pushOp(u.vstack.op(stack));
    END;

    INC(u.call_param_size[u.in_proc_call-1], 4);
  END load_stack_param;

PROCEDURE pop_struct (u: U;  s: ByteSize;  a: Alignment) =
  (* pop s0 and make it the "next" parameter in the current call *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("pop_struct");
      u.wr.Int   (s);
      u.wr.Int   (a);
      u.wr.NL    ();
    END;

    <* ASSERT u.in_proc_call > 0 *>

    <* ASSERT a <= 4 *>

    s := Word.And(s + 3, 16_FFFFFFFC);

    u.vstack.unlock();

    WITH stack0 = u.vstack.pos(0, "pop_struct") DO

      IF s > 32 THEN
        u.cg.immOp(Op.oSUB, u.cg.reg[Codex86.ESP], s);

        u.vstack.find(stack0, Force.regset, RegSet { Codex86.ESI });
        u.vstack.corrupt(Codex86.EDI);
        u.vstack.corrupt(Codex86.ECX);

        u.cg.movOp(u.cg.reg[Codex86.EDI], u.cg.reg[Codex86.ESP]);
        u.cg.movImm(u.cg.reg[Codex86.ECX], s DIV 4);

        u.cg.noargOp(Op.oCLD);
        u.cg.noargOp(Op.oREP);
        u.cg.noargOp(Op.oMOVSD);

        u.vstack.newdest(u.cg.reg[Codex86.ESI]);
      ELSE
        u.vstack.find(stack0, Force.anyreg, RegSet {}, TRUE);

        WITH temp = u.vstack.freereg() DO
          FOR i := 1 TO (s DIV 4) DO
            u.cg.load_ind(temp, u.vstack.op(stack0), s - (i * 4), Type.Int);
            u.cg.pushOp(u.cg.reg[temp]);
          END
        END
      END
    END;

    u.vstack.discard(1);

    INC(u.call_param_size[u.in_proc_call-1], s);
  END pop_struct;

PROCEDURE pop_static_link (u: U) =
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("pop_static_link");
      u.wr.NL    ();
    END;

    <* ASSERT u.in_proc_call > 0 *>

    u.static_link[u.in_proc_call-1] := declare_temp(u, 4, 4, Type.Addr, FALSE);

    u.vstack.pop(MVar {var := u.static_link[u.in_proc_call-1],
                       o := 0, t := Type.Addr} );
  END pop_static_link;

PROCEDURE call_direct (u: U; p: Proc;  t: Type) =
  VAR realproc := NARROW(p, x86Proc);
  (* call the procedure identified by block b.  The procedure
     returns a value of type t. *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("call_direct");
      u.wr.PName (p);
      u.wr.TName (t);
      u.wr.NL    ();
    END;

    <* ASSERT u.in_proc_call > 0 *>

    IF realproc.lev # 0 THEN
      load_static_link_toC(u, p);
    END;

    u.vstack.unlock();

    u.vstack.corrupt_all();

    IF u.pic THEN
      u.cg.picCall(realproc.symbol);  (* modif pic *)
    ELSE
      IF realproc.import THEN
        u.cg.absCall(p);
      ELSE
        IF realproc.bound THEN
          u.cg.relCall(realproc.offset - (u.obj.cursor(Seg.Text) + 5));
        ELSE
          u.cg.relCall(0);
          realproc.usage := NEW(ProcList, loc := u.obj.cursor(Seg.Text) - 4,
                                link := realproc.usage);
        END
      END;
    END;

    IF (NOT realproc.stdcall) (* => caller cleans *)
       AND u.call_param_size[u.in_proc_call-1] > 0 THEN
        u.cg.immOp(Op.oADD, u.cg.reg[Codex86.ESP],
                   u.call_param_size[u.in_proc_call-1]);
    END;

    IF t = Type.Struct THEN
      t := Type.Addr;
    END;

    IF t # Type.Void THEN
      IF t >= Type.Reel AND t <= Type.XReel THEN
        u.vstack.pushnew(t, Force.any);
        u.cg.f_pushnew();
      ELSE
        u.vstack.pushnew(t, Force.regset, RegSet { Codex86.EAX });
      END
    END;

    DEC(u.in_proc_call);
  END call_direct;

PROCEDURE call_indirect (u: U; t: Type;  cc: CallingConvention) =
  (* call the procedure whose address is in s0.A and pop s0.  The
     procedure returns a value of type t. *)
  VAR indreg := BASE_FOR_PIC;
      op     :  Operand;
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("call_indirect");
      u.wr.TName (t);
      u.wr.Txt   (cc.name);
      u.wr.NL    ();
    END;

    <* ASSERT u.in_proc_call > 0 *>

    u.vstack.unlock();

    u.vstack.corrupt_all();

    IF u.static_link[u.in_proc_call-1] # NIL THEN
      u.cg.movOp(u.cg.reg[Codex86.ECX],
                 Operand { loc := OLoc.mem,
                           mvar :=
                             MVar { var := u.static_link[u.in_proc_call-1],
                                    o := 0,
                                    t := Type.Addr } } );
      free_temp(u, u.static_link[u.in_proc_call-1]);
      u.static_link[u.in_proc_call-1] := NIL;
    END;

    op := u.vstack.op(u.vstack.pos(0, "call_indirect"));
    u.vstack.get_addr_in_GOT(op, indreg);
    u.cg.rmCall(op, indreg);
    u.vstack.discard_indreg(indreg);
    u.vstack.discard(1);

    IF (cc.m3cg_id = 0)
      AND u.call_param_size[u.in_proc_call-1] > 0 THEN
      (* caller-cleans calling convention *)
      u.cg.immOp(Op.oADD, u.cg.reg[Codex86.ESP],
                 u.call_param_size[u.in_proc_call-1]);
    END;

    IF t = Type.Struct THEN
      t := Type.Addr;
    END;

    IF t # Type.Void THEN
      IF t >= Type.Reel AND t <= Type.XReel THEN
        u.vstack.pushnew(t, Force.any);
        u.cg.f_pushnew();
      ELSE
        u.vstack.pushnew(t, Force.regset, RegSet { Codex86.EAX });
      END
    END;

    DEC(u.in_proc_call);
  END call_indirect;

(*------------------------------------------- procedure and closure types ---*)

PROCEDURE load_procedure (u: U;  p: Proc) =
  VAR realproc := NARROW(p, x86Proc);
  (* push; s0.A := ADDR (p's body) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("load_procedure");
      u.wr.PName (p);
      u.wr.NL    ();
    END;

    u.vstack.unlock();
    u.vstack.pushnew(Type.Addr, Force.anyreg);
    WITH stack0 = u.vstack.pos(0, "load_procedure") DO
      u.cg.movDummyReloc(u.vstack.op(stack0), realproc.symbol);
    END
  END load_procedure;

PROCEDURE load_static_link (u: U;  p: Proc) =
  VAR realproc := NARROW(p, x86Proc);
  (* push; s0.A := (static link needed to call p, NIL for top-level procs) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("load_static_link");
      u.wr.PName (p);
      u.wr.NL    ();
    END;

    IF realproc.lev = 0 THEN
      u.vstack.pushimm(0);
    ELSE
      u.vstack.unlock();
      u.vstack.pushnew(Type.Addr, Force.anyreg);
      u.cg.get_frame(u.vstack.op(u.vstack.pos(0, "load_static_link")).reg,
                     realproc.parent, u.current_proc);
    END
  END load_static_link;

PROCEDURE load_static_link_toC (u: U;  p: Proc) =
  VAR realproc := NARROW(p, x86Proc);
  (* push; s0.A := (static link needed to call p, NIL for top-level procs) *)
  BEGIN
    IF u.debug THEN
      u.wr.Cmd   ("load_static_link_toC");
      u.wr.PName (p);
      u.wr.NL    ();
    END;

    IF realproc.lev = 0 THEN
      u.cg.movImm(u.cg.reg[Codex86.ECX], 0);
    ELSE
      u.vstack.unlock();
      u.vstack.corrupt(Codex86.ECX);
      u.cg.get_frame(Codex86.ECX, realproc.parent, u.current_proc);
    END
  END load_static_link_toC;

(*---------------------------------------------------------- produce code ---*)

PROCEDURE intregcmp (u: U; tozero: BOOLEAN): BOOLEAN =
  BEGIN
    IF tozero THEN
      u.vstack.doimm(Op.oCMP, 0, FALSE);
      RETURN FALSE;
    ELSE
      RETURN u.vstack.dobin(Op.oCMP, TRUE, FALSE);
    END
  END intregcmp;

PROCEDURE fltregcmp (u: U; tozero: BOOLEAN): BOOLEAN =
  VAR reversed := FALSE;
      indreg:= BASE_FOR_PIC;
  BEGIN
    IF tozero THEN
      u.vstack.prepare_fstack(FOp.fCOMP, TRUE);
      u.cg.immFOp(FOp.fCOMP, FIm.Z);
      u.vstack.discard(1);
    ELSE
      IF u.cg.ftop_inmem THEN

        u.vstack.prepare_fstack(FOp.fCOMP, FALSE);
        u.vstack.get_addr_in_GOT(Operand{loc := OLoc.fstack,
				         mvar:= u.cg.ftop_mem}, indreg);
        u.cg.binFOp(FOp.fCOMP, 1, indreg);
	u.vstack.discard_indreg(indreg);
      ELSE
        u.vstack.prepare_fstack(FOp.fCOMPP, FALSE);
	(* both operands are in F.P. registers *)
        u.cg.binFOp(FOp.fCOMPP, 1, indreg);
        reversed := TRUE;
      END;
      u.vstack.discard(2);
    END;

    u.vstack.unlock();
    u.vstack.corrupt(Codex86.EAX);
    u.vstack.prepare_fstack(FOp.fNSTSWAX, FALSE);
    u.cg.noargFOp(FOp.fNSTSWAX);
    u.cg.noargOp(Op.oSAHF);

    RETURN reversed;
  END fltregcmp;

PROCEDURE condbranch (u: U; l: Label; cond: Cond; t: ZType) =
  VAR reversed := FALSE;
  BEGIN
    IF t < Type.Reel THEN
      reversed := intregcmp(u, cond < Cond.E);
      IF reversed THEN
        cond := revcond[cond];
      END;
      IF t # Type.Int THEN
        cond := unscond[cond];
      END
    ELSE
      reversed := fltregcmp(u, cond < Cond.E);
      IF reversed THEN
        cond := revcond[cond];
      END;
      cond := unscond[cond]; (* FCOM sets the unsigned compare flags *)
    END;
    u.cg.brOp(cond, l);
  END condbranch;

PROCEDURE condset (u: U; cond: Cond; t: ZType) =
  VAR reversed := FALSE;
  BEGIN
    IF t < Type.Reel THEN
      reversed := intregcmp(u, cond < Cond.E);
      IF reversed THEN
        cond := revcond[cond];
      END;
      IF t # Type.Int THEN
        cond := unscond[cond];
      END
    ELSE
      reversed := fltregcmp(u, cond < Cond.E);
      IF reversed THEN
        cond := revcond[cond];
      END;
      cond := unscond[cond]; (* FCOM sets the unsigned compare flags *)
    END;
    u.vstack.unlock();
    u.vstack.pushnew(Type.Word_A, Force.mem);
    WITH stop0 = u.vstack.op(u.vstack.pos(0, "condset")) DO
      stop0.mvar.var.stack_temp := FALSE;
      u.cg.setccOp(stop0, cond);
    END
  END condset;

(*----------------------------------------------------------------- misc. ---*)

PROCEDURE comment (u: U;  a, b, c, d: TEXT := NIL) =
  VAR i: INTEGER := -1;
  BEGIN
    Cmt (u, a, i);
    Cmt (u, b, i);
    Cmt (u, c, i);
    Cmt (u, d, i);
    Cmt (u, "\n", i);
  END comment;

PROCEDURE Cmt (u: U;  t: TEXT;  VAR width: INTEGER) =
  VAR ch: CHAR;
  BEGIN
    IF (NOT u.debug OR t = NIL) THEN RETURN END;
    FOR i := 0 TO Text.Length (t) - 1 DO
      ch := Text.GetChar (t, i);
      IF (width = -1) THEN u.wr.OutT ("\t# "); width := 0; END;
      IF (ch = '\n') THEN
        u.wr.NL ();
        width := -1;
      ELSE
        u.wr.OutC (ch);
      END
    END;
  END Cmt;

BEGIN
END M3x86.
