m3middle/src/M3CG_Clean.m3


Copyright (C) 1994, Digital Equipment Corp.

MODULE M3CG_Clean;

IMPORT Target, TInt, TFloat, TargetMap, M3CG, M3CG_Ops;

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

TYPE
  Op = {
    load_clean_tmp,
    set_source_file,
    set_source_line,
    free_temp,
    set_label,
    jump,
    if_true,
    if_false,
    if_eq,
    if_ne,
    if_gt,
    if_ge,
    if_lt,
    if_le,
    load,
    store,
    store_ref,
    load_address,
    load_indirect,
    store_indirect,
    store_ref_indirect,
    load_nil,
    load_integer,
    load_float,
    eq,
    ne,
    gt,
    ge,
    lt,
    le,
    add,
    subtract,
    multiply,
    divide,
    div,
    mod,
    negate,
    abs,
    max,
    min,
    round,
    trunc,
    floor,
    ceiling,
    cvt_float,
    set_union,
    set_difference,
    set_intersection,
    set_sym_difference,
    set_member,
    set_eq,
    set_ne,
    set_gt,
    set_ge,
    set_lt,
    set_le,
    set_range,
    set_singleton,
    not,
    and,
    or,
    xor,
    shift,
    shift_left,
    shift_right,
    rotate,
    rotate_left,
    rotate_right,
    extract,
    extract_n,
    extract_mn,
    insert,
    insert_n,
    insert_mn,
    swap,
    pop,
    copy_n,
    copy,
    zero_n,
    zero,
    loophole,
    check_nil,
    check_lo,
    check_hi,
    check_range,
    check_index,
    check_eq,
    add_offset,
    index_address,
    start_call_direct,
    start_call_indirect,
    pop_param,
    pop_struct,
    pop_static_link,
    pcall_direct,
    fcall_direct,
    pcall_indirect,
    fcall_indirect,
    load_procedure,
    load_static_link,
    comment
  };

CONST
  OpType = ARRAY Op OF Type {
    Type.Void, (* load_clean_tmp *)
    Type.Void, (* set_source_file *)
    Type.Void, (* set_source_line *)
    Type.Void, (* free_temp *)
    Type.Void, (* set_label *)
    Type.Void, (* jump *)
    Type.Void, (* if_true *)
    Type.Void, (* if_false *)
    Type.Void, (* if_eq *)
    Type.Void, (* if_ne *)
    Type.Void, (* if_gt *)
    Type.Void, (* if_ge *)
    Type.Void, (* if_lt *)
    Type.Void, (* if_le *)
    Type.Void, (* load *)
    Type.Void, (* store *)
    Type.Void, (* store_ref *)
    Type.Addr, (* load_address *)
    Type.Void, (* load_indirect *)
    Type.Void, (* store_indirect *)
    Type.Void, (* store_ref_indirect *)
    Type.Addr, (* load_nil *)
    Type.Int,  (* load_integer *)
    Type.Void, (* load_float *)
    Type.Int,  (* eq *)
    Type.Int,  (* ne *)
    Type.Int,  (* gt *)
    Type.Int,  (* ge *)
    Type.Int,  (* lt *)
    Type.Int,  (* le *)
    Type.Void, (* add *)
    Type.Void, (* subtract *)
    Type.Void, (* multiply *)
    Type.Void, (* divide *)
    Type.Int,  (* div *)
    Type.Int,  (* mod *)
    Type.Void, (* negate *)
    Type.Void, (* abs *)
    Type.Void, (* max *)
    Type.Void, (* min *)
    Type.Int,  (* round *)
    Type.Int,  (* trunc *)
    Type.Int,  (* floor *)
    Type.Int,  (* ceiling *)
    Type.Void, (* cvt_float *)
    Type.Void, (* set_union *)
    Type.Void, (* set_difference *)
    Type.Void, (* set_intersection *)
    Type.Void, (* set_sym_difference *)
    Type.Int,  (* set_member *)
    Type.Int,  (* set_eq *)
    Type.Int,  (* set_ne *)
    Type.Int,  (* set_gt *)
    Type.Int,  (* set_ge *)
    Type.Int,  (* set_lt *)
    Type.Int,  (* set_le *)
    Type.Void, (* set_range *)
    Type.Void, (* set_singleton *)
    Type.Int,  (* not *)
    Type.Int,  (* and *)
    Type.Int,  (* or *)
    Type.Int,  (* xor *)
    Type.Int,  (* shift *)
    Type.Int,  (* shift_left *)
    Type.Int,  (* shift_right *)
    Type.Int,  (* rotate *)
    Type.Int,  (* rotate_left *)
    Type.Int,  (* rotate_right *)
    Type.Int,  (* extract *)
    Type.Int,  (* extract_n *)
    Type.Int,  (* extract_mn *)
    Type.Int,  (* insert *)
    Type.Int,  (* insert_n *)
    Type.Int,  (* insert_mn *)
    Type.Void, (* swap *)
    Type.Void, (* pop *)
    Type.Void, (* copy_n *)
    Type.Void, (* copy *)
    Type.Void, (* zero_n *)
    Type.Void, (* zero *)
    Type.Void, (* loophole *)
    Type.Addr, (* check_nil *)
    Type.Int,  (* check_lo *)
    Type.Int,  (* check_hi *)
    Type.Int,  (* check_range *)
    Type.Int,  (* check_index *)
    Type.Void, (* check_eq *)
    Type.Addr, (* add_offset *)
    Type.Addr, (* index_address *)
    Type.Void, (* start_call_direct *)
    Type.Void, (* start_call_indirect *)
    Type.Void, (* pop_param *)
    Type.Void, (* pop_struct *)
    Type.Void, (* pop_static_link *)
    Type.Void, (* pcall_direct *)
    Type.Void, (* fcall_direct *)
    Type.Void, (* pcall_indirect *)
    Type.Void, (* fcall_indirect *)
    Type.Addr, (* load_procedure *)
    Type.Addr, (* load_static_link *)
    Type.Void  (* comment *)
  };

CONST
  Pushes = ARRAY Op OF INTEGER {
    1, (* load_clean_tmp *)
    0, (* set_source_file *)
    0, (* set_source_line *)
    0, (* free_temp *)
    0, (* set_label *)
    0, (* jump *)
   -1, (* if_true *)
   -1, (* if_false *)
   -2, (* if_eq *)
   -2, (* if_ne *)
   -2, (* if_gt *)
   -2, (* if_ge *)
   -2, (* if_lt *)
   -2, (* if_le *)
    1, (* load *)
   -1, (* store *)
   -1, (* store_ref *)
    1, (* load_address *)
    0, (* load_indirect *)
   -2, (* store_indirect *)
   -2, (* store_ref_indirect *)
    1, (* load_nil *)
    1, (* load_integer *)
    1, (* load_float *)
   -1, (* eq *)
   -1, (* ne *)
   -1, (* gt *)
   -1, (* ge *)
   -1, (* lt *)
   -1, (* le *)
   -1, (* add *)
   -1, (* subtract *)
   -1, (* multiply *)
   -1, (* divide *)
   -1, (* div *)
   -1, (* mod *)
    0, (* negate *)
    0, (* abs *)
   -1, (* max *)
   -1, (* min *)
    0, (* round *)
    0, (* trunc *)
    0, (* floor *)
    0, (* ceiling *)
    0, (* cvt_float *)
   -3, (* set_union *)
   -3, (* set_difference *)
   -3, (* set_intersection *)
   -3, (* set_sym_difference *)
   -1, (* set_member *)
   -1, (* set_eq *)
   -1, (* set_ne *)
   -1, (* set_gt *)
   -1, (* set_ge *)
   -1, (* set_lt *)
   -1, (* set_le *)
   -3, (* set_range *)
   -2, (* set_singleton *)
    0, (* not *)
   -1, (* and *)
   -1, (* or *)
   -1, (* xor *)
   -1, (* shift *)
   -1, (* shift_left *)
   -1, (* shift_right *)
   -1, (* rotate *)
   -1, (* rotate_left *)
   -1, (* rotate_right *)
   -2, (* extract *)
   -1, (* extract_n *)
    0, (* extract_mn *)
   -3, (* insert *)
   -2, (* insert_n *)
   -1, (* insert_mn *)
    0, (* swap *)
   -1, (* pop *)
   -3, (* copy_n *)
   -2, (* copy *)
   -2, (* zero_n *)
   -1, (* zero *)
    0, (* loophole *)
    0, (* check_nil *)
    0, (* check_lo *)
    0, (* check_hi *)
    0, (* check_range *)
   -1, (* check_index *)
   -2, (* check_eq *)
    0, (* add_offset *)
   -1, (* index_address *)
    0, (* start_call_direct *)
    0, (* start_call_indirect *)
   -1, (* pop_param *)
   -1, (* pop_struct *)
   -1, (* pop_static_link *)
    0, (* pcall_direct *)
    1, (* fcall_direct *)
    0, (* pcall_indirect *)
    1, (* fcall_indirect *)
    1, (* load_procedure *)
    1, (* load_static_link *)
    0  (* comment *)
  };

TYPE
  OpInfo = RECORD
    op    : Op;
    depth : INTEGER;
    result: Type;
    txt   : TEXT;
    int   : INTEGER;
    int2  : INTEGER;
    var   : Var;
    bool  : BOOLEAN;
    lab   : Label;
    type  : Type;
    type2 : Type;
    tint  : Target.Int;
    tint2 : Target.Int;
    flt   : Target.Float;
    sign1 : Sign;
    sign2 : Sign;
    proc  : Proc;
    cconv : Target.CallingConvention;
  END;

TYPE OpBuffer = REF ARRAY OF OpInfo;

TYPE
  U = M3CG.T OBJECT
        clean_jumps  : BOOLEAN  := FALSE;
        clean_stores : BOOLEAN  := FALSE;
        buffer       : OpBuffer := NIL;
        next_buf     : INTEGER  := 0;
        stack_depth  : INTEGER := 0;
      METHODS
        make_clean (depth: INTEGER) := Make_clean;
        flush_buffer () := Flush_buffer;

        stuff (op: Op;
               int : INTEGER := 0;
               type: Type    := Type.Void) := Stuff;

        stuffX (op: Op;
               txt : TEXT    := NIL;
               int : INTEGER := 0;
               int2: INTEGER := 0;
               var : Var     := NIL;
               bool: BOOLEAN := FALSE;
               lab : Label   := 0;
               type: Type    := Type.Void;
               type2: Type   := Type.Void;
               READONLY tint: Target.Int := TInt.Zero;
               READONLY tint2: Target.Int := TInt.Zero;
               READONLY flt: Target.Float := TFloat.ZeroR;
               sign1: Sign := Sign.Positive;
               sign2: Sign := Sign.Positive;
               proc: Proc := NIL;
               cconv: CallingConvention := NIL
              ) := StuffX;

      OVERRIDES
        end_unit   := end_unit;
        set_source_file := set_source_file;
        set_source_line := set_source_line;
        free_temp := free_temp;
        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;
--------------------------------------------------- buffer manipulation ---

PROCEDURE Make_clean (self: U;  depth: INTEGER) =
  VAR s: INTEGER;
  BEGIN
    s := DoClean (self, self.next_buf-1, self.stack_depth - depth);
    DoFlush (self, s, self.next_buf);
    self.next_buf := MAX (0, self.stack_depth - depth);
    self.stack_depth := self.next_buf;
  END Make_clean;

PROCEDURE DoClean (self: U;  end, hgt: INTEGER): INTEGER =
  VAR start: INTEGER;  t: Type;  tmp: Var;
  BEGIN
    (* find the tail segment [start..end] that's at least 'hgt' deep *)
    LOOP
      IF (end < 0) THEN EXIT END;
      WITH x = self.buffer[end] DO
        IF (x.depth <= hgt) AND (x.result # Type.Void) THEN EXIT END;
      END;
      DEC (end);
    END;

    IF (end < 0) THEN
      RETURN 0;

    ELSIF (hgt <= 0) THEN
      DoFlush (self, 0, end+1);

    ELSE
      start := DoClean (self, end-1, hgt-1);
      IF (start # end) OR (start # hgt-1)
        OR (self.buffer[end].op # Op.load_clean_tmp) THEN
        DoFlush (self, start, end+1);
        t := self.buffer[end].result;
        tmp := self.child.declare_temp (TargetMap.CG_Bytes[t],
                                        TargetMap.CG_Align[t],
                                        TargetMap.CG_Base[t],
                                        in_memory := FALSE);
        self.child.store (tmp, 0, t);
        WITH x = self.buffer[hgt-1] DO
          x.op     := Op.load_clean_tmp;
          x.var    := tmp;
          x.depth  := hgt;
          x.result := t;
        END;
      END;
    END;

    RETURN end + 1;
  END DoClean;

PROCEDURE Flush_buffer (self: U) =
  BEGIN
    DoFlush (self, 0, self.next_buf);
    self.next_buf := 0;
    self.stack_depth := 0;
  END Flush_buffer;

PROCEDURE DoFlush (self: U;  a, b: INTEGER) =
  VAR ch := self.child;
  BEGIN
    FOR i := a TO b-1 DO
      WITH x = self.buffer [i] DO
        CASE x.op OF
        | Op.load_clean_tmp =>
              ch.load (x.var, 0, x.type);
              ch.free_temp (x.var);
        | Op.set_source_file => ch.set_source_file (x.txt);
        | Op.set_source_line => ch.set_source_line (x.int);
        | Op.free_temp => ch.free_temp (x.var);
        | Op.set_label => ch.set_label (x.lab, x.bool);
        | Op.jump => ch.jump (x.lab);
        | Op.if_true => ch.if_true (x.lab, x.int);
        | Op.if_false => ch.if_false (x.lab, x.int);
        | Op.if_eq => ch.if_eq (x.lab, x.type, x.int);
        | Op.if_ne => ch.if_ne (x.lab, x.type, x.int);
        | Op.if_gt => ch.if_gt (x.lab, x.type, x.int);
        | Op.if_ge => ch.if_ge (x.lab, x.type, x.int);
        | Op.if_lt => ch.if_lt (x.lab, x.type, x.int);
        | Op.if_le => ch.if_le (x.lab, x.type, x.int);
        | Op.load => ch.load (x.var, x.int, x.type);
        | Op.store => ch.store (x.var, x.int, x.type);
        | Op.store_ref => ch.store_ref (x.var, x.int);
        | Op.load_address => ch.load_address (x.var, x.int);
        | Op.load_indirect => ch.load_indirect (x.int, x.type);
        | Op.store_indirect => ch.store_indirect (x.int, x.type);
        | Op.store_ref_indirect => ch.store_ref_indirect (x.int, x.bool);
        | Op.load_nil => ch.load_nil ();
        | Op.load_integer => ch.load_integer (x.tint);
        | Op.load_float => ch.load_float (x.flt);
        | Op.eq => ch.eq (x.type);
        | Op.ne => ch.ne (x.type);
        | Op.gt => ch.gt (x.type);
        | Op.ge => ch.ge (x.type);
        | Op.lt => ch.lt (x.type);
        | Op.le => ch.le (x.type);
        | Op.add => ch.add (x.type);
        | Op.subtract => ch.subtract (x.type);
        | Op.multiply => ch.multiply (x.type);
        | Op.divide => ch.divide (x.type);
        | Op.div => ch.div (x.type, x.sign1, x.sign2);
        | Op.mod => ch.mod (x.type, x.sign1, x.sign2);
        | Op.negate => ch.negate (x.type);
        | Op.abs => ch.abs (x.type);
        | Op.max => ch.max (x.type);
        | Op.min => ch.min (x.type);
        | Op.round => ch.round (x.type);
        | Op.trunc => ch.trunc (x.type);
        | Op.floor => ch.floor (x.type);
        | Op.ceiling => ch.ceiling (x.type);
        | Op.cvt_float => ch.cvt_float (x.type2, x.type);
        | Op.set_union => ch.set_union (x.int);
        | Op.set_difference => ch.set_difference (x.int);
        | Op.set_intersection => ch.set_intersection (x.int);
        | Op.set_sym_difference => ch.set_sym_difference (x.int);
        | Op.set_member => ch.set_member (x.int);
        | Op.set_eq => ch.set_eq (x.int);
        | Op.set_ne => ch.set_ne (x.int);
        | Op.set_gt => ch.set_gt (x.int);
        | Op.set_ge => ch.set_ge (x.int);
        | Op.set_lt => ch.set_lt (x.int);
        | Op.set_le => ch.set_le (x.int);
        | Op.set_range => ch.set_range (x.int);
        | Op.set_singleton => ch.set_singleton (x.int);
        | Op.not => ch.not ();
        | Op.and => ch.and ();
        | Op.or => ch.or ();
        | Op.xor => ch.xor ();
        | Op.shift => ch.shift ();
        | Op.shift_left => ch.shift_left ();
        | Op.shift_right => ch.shift_right ();
        | Op.rotate => ch.rotate ();
        | Op.rotate_left => ch.rotate_left ();
        | Op.rotate_right => ch.rotate_right ();
        | Op.extract => ch.extract (x.bool);
        | Op.extract_n => ch.extract_n (x.bool, x.int);
        | Op.extract_mn => ch.extract_mn (x.bool, x.int, x.int2);
        | Op.insert => ch.insert ();
        | Op.insert_n => ch.insert_n (x.int);
        | Op.insert_mn => ch.insert_mn (x.int, x.int2);
        | Op.swap => ch.swap (x.type, x.type2);
        | Op.pop => ch.pop (x.type);
        | Op.copy_n => ch.copy_n (x.type, x.bool);
        | Op.copy => ch.copy (x.int, x.type, x.bool);
        | Op.zero_n => ch.zero_n (x.type);
        | Op.zero => ch.zero (x.int, x.type);
        | Op.loophole => ch.loophole (x.type2, x.type);
        | Op.check_nil => ch.check_nil ();
        | Op.check_lo => ch.check_lo (x.tint);
        | Op.check_hi => ch.check_hi (x.tint);
        | Op.check_range => ch.check_range (x.tint, x.tint2);
        | Op.check_index => ch.check_index ();
        | Op.check_eq => ch.check_eq ();
        | Op.add_offset => ch.add_offset (x.int);
        | Op.index_address => ch.index_address (x.int);
        | Op.start_call_direct => ch.start_call_direct (x.proc, x.int, x.type);
        | Op.start_call_indirect => ch.start_call_indirect (x.type, x.cconv);
        | Op.pop_param => ch.pop_param (x.type);
        | Op.pop_struct => ch.pop_struct (x.int, x.int2);
        | Op.pop_static_link => ch.pop_static_link ();
        | Op.pcall_direct => ch.call_direct (x.proc, Type.Void);
        | Op.fcall_direct => ch.call_direct (x.proc, x.type);
        | Op.pcall_indirect => ch.call_indirect (Type.Void, x.cconv);
        | Op.fcall_indirect => ch.call_indirect (x.type, x.cconv);
        | Op.load_procedure => ch.load_procedure (x.proc);
        | Op.load_static_link => ch.load_static_link (x.proc);
        | Op.comment => ch.comment (x.txt);
        END;
      END;
    END;
  END DoFlush;

PROCEDURE Stuff (self: U;  op: Op;  int: INTEGER;  type: Type) =
  BEGIN
    IF (self.next_buf >= NUMBER (self.buffer^)) THEN ExpandBuffer (self) END;
    WITH x = self.buffer[self.next_buf] DO
      INC (self.stack_depth, Pushes[op]);
      x.depth  := self.stack_depth;
      x.op     := op;
      x.int    := int;
      x.type   := type;
      IF (OpType[op] = Type.Void)
        THEN x.result := type;
        ELSE x.result := OpType[op];
      END;
    END;
    IF (self.stack_depth = 0) THEN Flush_buffer (self) END;
  END Stuff;

PROCEDURE StuffX (self: U;
               op: Op;
               txt : TEXT    := NIL;
               int : INTEGER := 0;
               int2: INTEGER := 0;
               var : Var     := NIL;
               bool: BOOLEAN := FALSE;
               lab : Label   := 0;
               type: Type    := Type.Void;
               type2: Type   := Type.Void;
               READONLY tint: Target.Int := TInt.Zero;
               READONLY tint2: Target.Int := TInt.Zero;
               READONLY flt: Target.Float := TFloat.ZeroR;
               sign1: Sign := Sign.Positive;
               sign2: Sign := Sign.Positive;
               proc: Proc := NIL;
               cconv: CallingConvention := NIL
              ) =
  BEGIN
    IF (self.next_buf >= NUMBER (self.buffer^)) THEN ExpandBuffer (self) END;
    WITH x = self.buffer[self.next_buf] DO
      INC (self.stack_depth, Pushes[op]);
      x.depth  := self.stack_depth;
      x.op     := op;
      x.txt    := txt;
      x.int    := int;
      x.int2   := int2;
      x.var    := var;
      x.bool   := bool;
      x.lab    := lab;
      x.type   := type;
      x.type2  := type2;
      x.tint   := tint;
      x.tint2  := tint2;
      x.flt    := flt;
      x.sign1  := sign1;
      x.sign2  := sign2;
      x.proc   := proc;
      x.cconv  := cconv;
      IF (OpType[op] = Type.Void)
        THEN x.result := type;
        ELSE x.result := OpType[op];
      END;
    END;
    IF (self.stack_depth = 0) THEN Flush_buffer (self) END;
  END StuffX;

PROCEDURE ExpandBuffer (self: U) =
  VAR n := NUMBER (self.buffer^);  new := NEW (OpBuffer, 2 * n);
  BEGIN
    SUBARRAY (new^, 0, n) := self.buffer^;
    self.buffer := new;
  END ExpandBuffer;
---------------------------------------------------------------------------

PROCEDURE New (child: M3CG.T;  jumps, stores: BOOLEAN): M3CG.T =
  BEGIN
    RETURN NEW (U,
                child  := child,
                buffer := NEW (OpBuffer, 100),
                clean_jumps  := jumps,
                clean_stores := stores
               );
  END New;
----------------------------------------------------- compilation units ---

PROCEDURE end_unit (self: U) =
  BEGIN
    self.flush_buffer ();
    self.child.end_unit ();
  END end_unit;
------------------------------------------------ debugging line numbers ---

PROCEDURE set_source_file (self: U; file: TEXT) =
  BEGIN
    self.stuffX (Op.set_source_file, txt := file);
  END set_source_file;

PROCEDURE set_source_line (self: U; line: INTEGER) =
  BEGIN
    self.stuff (Op.set_source_line, int := line);
  END set_source_line;
------------------------------------------------- variable declarations ---

PROCEDURE free_temp (self: U;  v: Var) =
  BEGIN
    self.stuffX (Op.free_temp, var := v);
  END free_temp;
------------------------------------------------------------ procedures ---

PROCEDURE end_procedure (self: U;  p: Proc) =
  BEGIN
    self.flush_buffer ();
    self.child.end_procedure (p);
  END end_procedure;

PROCEDURE begin_block (self: U) =
  BEGIN
    self.make_clean (0);
    self.child.begin_block ();
  END begin_block;

PROCEDURE end_block (self: U) =
  BEGIN
    self.make_clean (0);
    self.child.end_block ();
  END end_block;

PROCEDURE note_procedure_origin (self: U;  p: Proc) =
  BEGIN
    self.make_clean (0);
    self.child.note_procedure_origin (p);
  END note_procedure_origin;
------------------------------------------------------------ statements ---

PROCEDURE set_label (self: U;  l: Label;  barrier: BOOLEAN) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (0);
      self.child.set_label (l, barrier);
    ELSE
      self.stuffX (Op.set_label, lab := l, bool := barrier);
    END;
  END set_label;

PROCEDURE jump (self: U; l: Label) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (0);
      self.child.jump (l);
    ELSE
      self.stuffX (Op.jump, lab := l);
    END;
  END jump;

PROCEDURE if_true  (self: U; l: Label;  f: Frequency) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (1);
      self.child.if_true (l, f);
    ELSE
      self.stuffX (Op.if_true, lab := l, int := f);
    END;
  END if_true;

PROCEDURE if_false (self: U; l: Label;  f: Frequency) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (1);
      self.child.if_false (l, f);
    ELSE
      self.stuffX (Op.if_false, lab := l, int := f);
    END;
  END if_false;

PROCEDURE if_eq (self: U;  l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (2);
      self.child.if_eq (l, t, f);
    ELSE
      self.stuffX (Op.if_eq, lab := l, type := t, int := f);
    END;
  END if_eq;

PROCEDURE if_ne (self: U;  l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (2);
      self.child.if_ne (l, t, f);
    ELSE
      self.stuffX (Op.if_ne, lab := l, type := t, int := f);
    END;
  END if_ne;

PROCEDURE if_gt (self: U;  l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (2);
      self.child.if_gt (l, t, f);
    ELSE
      self.stuffX (Op.if_gt, lab := l, type := t, int := f);
    END;
  END if_gt;

PROCEDURE if_ge (self: U;  l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (2);
      self.child.if_ge (l, t, f);
    ELSE
      self.stuffX (Op.if_ge, lab := l, type := t, int := f);
    END;
  END if_ge;

PROCEDURE if_lt (self: U;  l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (2);
      self.child.if_lt (l, t, f);
    ELSE
      self.stuffX (Op.if_lt, lab := l, type := t, int := f);
    END;
  END if_lt;

PROCEDURE if_le (self: U;  l: Label;  t: ZType;  f: Frequency) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (2);
      self.child.if_le (l, t, f);
    ELSE
      self.stuffX (Op.if_le, lab := l, type := t, int := f);
    END;
  END if_le;

PROCEDURE case_jump (self: U; READONLY labels: ARRAY OF Label) =
  BEGIN
    self.flush_buffer ();
    self.child.case_jump (labels);
  END case_jump;

PROCEDURE exit_proc (self: U; t: Type) =
  BEGIN
    self.flush_buffer ();
    self.child.exit_proc (t);
  END exit_proc;
------------------------------------------------------------ load/store ---

PROCEDURE load  (self: U;  v: Var;  o: ByteOffset;  t: MType) =
  BEGIN
    self.stuffX (Op.load, var := v, int := o, type := t);
  END load;

PROCEDURE store  (self: U;  v: Var;  o: ByteOffset;  t: MType) =
  BEGIN
    IF (self.clean_stores) THEN
      self.make_clean (1);
      self.child.store (v, o, t);
    ELSE
      self.stuffX (Op.store, var := v, int := o, type := t);
    END;
  END store;

PROCEDURE store_ref (self: U;  v: Var;  o: ByteOffset) =
  BEGIN
    IF (self.clean_stores) THEN
      self.make_clean (1);
      self.child.store_ref (v, o);
    ELSE
      self.stuffX (Op.store_ref, var := v, int := o);
    END;
  END store_ref;

PROCEDURE load_address (self: U;  v: Var;  o: ByteOffset) =
  BEGIN
    self.stuffX (Op.load_address, var := v, int := o);
  END load_address;

PROCEDURE load_indirect (self: U;  o: ByteOffset;  t: MType) =
  BEGIN
    self.stuff (Op.load_indirect, int := o, type := t);
  END load_indirect;

PROCEDURE store_indirect (self: U;  o: ByteOffset;  t: MType) =
  BEGIN
    IF (self.clean_stores) THEN
      self.make_clean (2);
      self.child.store_indirect (o, t);
    ELSE
      self.stuff (Op.store_indirect, int := o, type := t);
    END;
  END store_indirect;

PROCEDURE store_ref_indirect (self: U;  o: ByteOffset;  var: BOOLEAN) =
  BEGIN
    IF (self.clean_stores) THEN
      self.make_clean (2);
      self.child.store_ref_indirect (o, var);
    ELSE
      self.stuffX (Op.store_ref_indirect, int := o, bool := var);
    END;
  END store_ref_indirect;
-------------------------------------------------------------- literals ---

PROCEDURE load_nil (self: U) =
  BEGIN
    self.stuff (Op.load_nil);
  END load_nil;

PROCEDURE load_integer (self: U;  READONLY i: Target.Int) =
  BEGIN
    self.stuffX (Op.load_integer, tint := i);
  END load_integer;

PROCEDURE load_float (self: U;  READONLY f: Target.Float) =
  CONST FType = ARRAY Target.Precision OF Type
                { Type.Reel, Type.LReel, Type.XReel };
  BEGIN
    self.stuffX (Op.load_float, flt := f, type := FType [f.pre]);
  END load_float;
------------------------------------------------------------ arithmetic ---

PROCEDURE eq (self: U;  t: ZType) =
  BEGIN
    self.stuff (Op.eq, type := t);
  END eq;

PROCEDURE ne (self: U;  t: ZType) =
  BEGIN
    self.stuff (Op.ne, type := t);
  END ne;

PROCEDURE gt (self: U;  t: ZType) =
  BEGIN
    self.stuff (Op.gt, type := t);
  END gt;

PROCEDURE ge (self: U;  t: ZType) =
  BEGIN
    self.stuff (Op.ge, type := t);
  END ge;

PROCEDURE lt (self: U;  t: ZType) =
  BEGIN
    self.stuff (Op.lt, type := t);
  END lt;

PROCEDURE le (self: U;  t: ZType) =
  BEGIN
    self.stuff (Op.le, type := t);
  END le;

PROCEDURE add (self: U;  t: AType) =
  BEGIN
    self.stuff (Op.add, type := t);
  END add;

PROCEDURE subtract (self: U;  t: AType) =
  BEGIN
    self.stuff (Op.subtract, type := t);
  END subtract;

PROCEDURE multiply (self: U;  t: AType) =
  BEGIN
    self.stuff (Op.multiply, type := t);
  END multiply;

PROCEDURE divide (self: U;  t: RType) =
  BEGIN
    self.stuff (Op.divide, type := t);
  END divide;

PROCEDURE div (self: U;  t: IType;  a, b: Sign) =
  BEGIN
    self.stuffX (Op.div, type := t, sign1 := a, sign2 := b);
  END div;

PROCEDURE mod (self: U;  t: IType;  a, b: Sign) =
  BEGIN
    self.stuffX (Op.mod, type := t, sign1 := a, sign2 := b);
  END mod;

PROCEDURE negate (self: U;  t: AType) =
  BEGIN
    self.stuff (Op.negate, type := t);
  END negate;

PROCEDURE abs (self: U;  t: AType) =
  BEGIN
    self.stuff (Op.abs, type := t);
  END abs;

PROCEDURE max (self: U;  t: ZType) =
  BEGIN
    self.stuff (Op.max, type := t);
  END max;

PROCEDURE min (self: U;  t: ZType) =
  BEGIN
    self.stuff (Op.min, type := t);
  END min;

PROCEDURE round (self: U;  t: RType) =
  BEGIN
    self.stuff (Op.round, type := t);
  END round;

PROCEDURE trunc (self: U;  t: RType) =
  BEGIN
    self.stuff (Op.trunc, type := t);
  END trunc;

PROCEDURE floor (self: U;  t: RType) =
  BEGIN
    self.stuff (Op.floor, type := t);
  END floor;

PROCEDURE ceiling  (self: U;  t: RType) =
  BEGIN
    self.stuff (Op.ceiling, type := t);
  END ceiling;

PROCEDURE cvt_float (self: U;  t: AType;  u: RType) =
  BEGIN
    self.stuffX (Op.cvt_float, type := u,  type2 := t);
  END cvt_float;
------------------------------------------------------------------ sets ---

PROCEDURE set_union (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_union, int := s);
  END set_union;

PROCEDURE set_difference (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_difference, int := s);
  END set_difference;

PROCEDURE set_intersection (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_intersection, int := s);
  END set_intersection;

PROCEDURE set_sym_difference (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_sym_difference, int := s);
  END set_sym_difference;

PROCEDURE set_member (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_member, int := s);
  END set_member;

PROCEDURE set_eq (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_eq, int := s);
  END set_eq;

PROCEDURE set_ne (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_ne, int := s);
  END set_ne;

PROCEDURE set_gt (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_gt, int := s);
  END set_gt;

PROCEDURE set_ge (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_ge, int := s);
  END set_ge;

PROCEDURE set_lt (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_lt, int := s);
  END set_lt;

PROCEDURE set_le (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_le, int := s);
  END set_le;

PROCEDURE set_range (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_range, int := s);
  END set_range;

PROCEDURE set_singleton (self: U;  s: ByteSize) =
  BEGIN
    self.stuff (Op.set_singleton, int := s);
  END set_singleton;
------------------------------------------------- Word.T bit operations ---

PROCEDURE not (self: U) =
  BEGIN
    self.stuff (Op.not);
  END not;

PROCEDURE and (self: U) =
  BEGIN
    self.stuff (Op.and);
  END and;

PROCEDURE or (self: U) =
  BEGIN
    self.stuff (Op.or);
  END or;

PROCEDURE xor (self: U) =
  BEGIN
    self.stuff (Op.xor);
  END xor;

PROCEDURE shift (self: U) =
  BEGIN
    self.stuff (Op.shift);
  END shift;

PROCEDURE shift_left (self: U) =
  BEGIN
    self.stuff (Op.shift_left);
  END shift_left;

PROCEDURE shift_right  (self: U) =
  BEGIN
    self.stuff (Op.shift_right);
  END shift_right;

PROCEDURE rotate (self: U) =
  BEGIN
    self.stuff (Op.rotate);
  END rotate;

PROCEDURE rotate_left  (self: U) =
  BEGIN
    self.stuff (Op.rotate_left);
  END rotate_left;

PROCEDURE rotate_right (self: U) =
  BEGIN
    self.stuff (Op.rotate_right);
  END rotate_right;

PROCEDURE extract (self: U;  sign: BOOLEAN) =
  BEGIN
    self.stuffX (Op.extract, bool := sign);
  END extract;

PROCEDURE extract_n (self: U;  sign: BOOLEAN;  n: INTEGER) =
  BEGIN
    self.stuffX (Op.extract_n, bool := sign,  int := n);
  END extract_n;

PROCEDURE extract_mn (self: U;  sign: BOOLEAN;  m, n: INTEGER) =
  BEGIN
    self.stuffX (Op.extract_mn, bool := sign, int := m, int2 := n);
  END extract_mn;

PROCEDURE insert  (self: U) =
  BEGIN
    self.stuff (Op.insert);
  END insert;

PROCEDURE insert_n  (self: U;  n: INTEGER) =
  BEGIN
    self.stuff (Op.insert_n, int := n);
  END insert_n;

PROCEDURE insert_mn  (self: U;  m, n: INTEGER) =
  BEGIN
    self.stuffX (Op.insert_mn, int := m, int2 := n);
  END insert_mn;
------------------------------------------------ misc. stack/memory ops ---

PROCEDURE swap (self: U;  a, b: Type) =
  BEGIN
    self.stuffX (Op.swap, type := a, type2 := b);
  END swap;

PROCEDURE pop  (self: U;  t: Type) =
  BEGIN
    self.stuff (Op.pop, type := t);
  END pop;

PROCEDURE copy_n (self: U;  t: MType;  overlap: BOOLEAN) =
  BEGIN
    self.stuffX (Op.copy_n, type := t, bool := overlap);
  END copy_n;

PROCEDURE copy (self: U;  n: INTEGER;  t: MType;  overlap: BOOLEAN) =
  BEGIN
    self.stuffX (Op.copy, int := n, type := t, bool := overlap);
  END copy;

PROCEDURE zero_n (self: U;  t: MType) =
  BEGIN
    self.stuff (Op.zero_n, type := t);
  END zero_n;

PROCEDURE zero (self: U;  n: INTEGER;  t: MType) =
  BEGIN
    self.stuff (Op.zero, int := n, type := t);
  END zero;
----------------------------------------------------------- conversions ---

PROCEDURE loophole (self: U;  from, two: ZType) =
  BEGIN
    self.stuffX (Op.loophole, type := two, type2 := from);
  END loophole;
------------------------------------------------ traps & runtime checks ---

PROCEDURE assert_fault (self: U) =
  BEGIN
    self.flush_buffer ();
    self.child.assert_fault ();
  END assert_fault;

PROCEDURE narrow_fault (self: U) =
  BEGIN
    self.flush_buffer ();
    self.child.narrow_fault ();
  END narrow_fault;

PROCEDURE return_fault (self: U) =
  BEGIN
    self.flush_buffer ();
    self.child.return_fault ();
  END return_fault;

PROCEDURE case_fault (self: U) =
  BEGIN
    self.flush_buffer ();
    self.child.case_fault ();
  END case_fault;

PROCEDURE typecase_fault (self: U) =
  (* Abort *)
  BEGIN
    self.flush_buffer ();
    self.child.typecase_fault ();
  END typecase_fault;

PROCEDURE check_nil (self: U) =
  BEGIN
    self.stuff (Op.check_nil);
  END check_nil;

PROCEDURE check_lo (self: U;  READONLY i: Target.Int) =
  BEGIN
    self.stuffX (Op.check_lo, tint := i);
  END check_lo;

PROCEDURE check_hi (self: U;  READONLY i: Target.Int) =
  BEGIN
    self.stuffX (Op.check_hi, tint := i);
  END check_hi;

PROCEDURE check_range (self: U;  READONLY a, b: Target.Int) =
  BEGIN
    self.stuffX (Op.check_range, tint := a, tint2 := b);
  END check_range;

PROCEDURE check_index (self: U) =
  BEGIN
    self.stuff (Op.check_index);
  END check_index;

PROCEDURE check_eq (self: U) =
  BEGIN
    self.stuff (Op.check_eq);
  END check_eq;
---------------------------------------------------- address arithmetic ---

PROCEDURE add_offset (self: U; i: INTEGER) =
  BEGIN
    self.stuff (Op.add_offset, int := i);
  END add_offset;

PROCEDURE index_address (self: U;  size: INTEGER) =
  BEGIN
    self.stuff (Op.index_address, int := size);
  END index_address;
------------------------------------------------------- procedure calls ---

PROCEDURE start_call_direct (self: U;  p: Proc;  lev: INTEGER;  t: Type) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (0);
      self.child.start_call_direct (p, lev, t);
    ELSE
      self.stuffX (Op.start_call_direct, proc := p, int := lev, type := t);
    END;
  END start_call_direct;

PROCEDURE start_call_indirect (self: U;  t: Type;  cc: CallingConvention) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (0);
      self.child.start_call_indirect (t, cc);
    ELSE
      self.stuffX (Op.start_call_indirect, type := t, cconv := cc);
    END;
  END start_call_indirect;

PROCEDURE pop_param (self: U;  t: MType) =
  BEGIN
    IF (self.clean_stores) THEN
      self.make_clean (1);
      self.child.pop_param (t);
    ELSE
      self.stuff (Op.pop_param, type := t);
    END;
  END pop_param;

PROCEDURE pop_struct (self: U;  s: ByteSize;  a: Alignment) =
  BEGIN
    IF (self.clean_stores) THEN
      self.make_clean (1);
      self.child.pop_struct (s, a);
    ELSE
      self.stuffX (Op.pop_struct, int := s, int2 := a);
    END;
  END pop_struct;

PROCEDURE pop_static_link (self: U) =
  BEGIN
    IF (self.clean_stores) THEN
      self.make_clean (1);
      self.child.pop_static_link ();
    ELSE
      self.stuff (Op.pop_static_link);
    END;
  END pop_static_link;

PROCEDURE call_direct (self: U; p: Proc;  t: Type) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (0);
      self.child.call_direct (p, t);
    ELSIF (t = Type.Void) THEN
      self.stuffX (Op.pcall_direct, proc := p);
    ELSE
      self.stuffX (Op.fcall_direct, proc := p, type := t);
    END;
  END call_direct;

PROCEDURE call_indirect (self: U; t: Type;  cc: CallingConvention) =
  BEGIN
    IF (self.clean_jumps) THEN
      self.make_clean (0);
      self.child.call_indirect (t, cc);
    ELSIF (t = Type.Void) THEN
      self.stuffX (Op.pcall_indirect, cconv := cc);
    ELSE
      self.stuffX (Op.fcall_indirect, type := t, cconv := cc);
    END;
  END call_indirect;
------------------------------------------- procedure and closure types ---

PROCEDURE load_procedure (self: U;  p: Proc) =
  BEGIN
    self.stuffX (Op.load_procedure,  proc := p);
  END load_procedure;

PROCEDURE load_static_link (self: U;  p: Proc) =
  BEGIN
    self.stuffX (Op.load_static_link,  proc := p);
  END load_static_link;
----------------------------------------------------------------- misc. ---

PROCEDURE comment (self: U;  a, b, c, d: TEXT := NIL) =
  VAR x: TEXT := "";
  BEGIN
    IF (a # NIL) THEN x := x & a END;
    IF (b # NIL) THEN x := x & b END;
    IF (c # NIL) THEN x := x & c END;
    IF (d # NIL) THEN x := x & d END;
    self.stuffX (Op.comment, txt := x);
  END comment;

BEGIN
END M3CG_Clean.