Kill the preallocator, install a sane replacement. Closes #131. And probably a lot of others.

This commit is contained in:
Graydon Hoare 2010-08-04 00:27:36 -07:00
parent 22c0776247
commit 7595aca5e3
5 changed files with 123 additions and 263 deletions

View File

@ -107,14 +107,13 @@ type abi =
abi_word_bits: Il.bits;
abi_word_ty: Common.ty_mach;
abi_is_2addr_machine: bool;
abi_has_pcrel_data: bool;
abi_has_pcrel_code: bool;
abi_n_hardregs: int;
abi_str_of_hardreg: (int -> string);
abi_prealloc_quad: (Il.quad' -> Il.quad');
abi_emit_target_specific: (Il.emitter -> Il.quad -> unit);
abi_constrain_vregs: (Il.quad -> Bits.t array -> unit);
abi_emit_fn_prologue: (Il.emitter

View File

@ -692,8 +692,7 @@ let string_of_quad (f:hreg_formatter) (q:quad) : string =
type emitter = { mutable emit_pc: int;
mutable emit_next_vreg: int option;
mutable emit_next_spill: int;
emit_preallocator: (quad' -> quad');
emit_is_2addr: bool;
emit_target_specific: (emitter -> quad -> unit);
mutable emit_quads: quads;
emit_annotations: (int,string) Hashtbl.t;
emit_size_cache: ((size,operand) Hashtbl.t) Stack.t;
@ -712,8 +711,7 @@ let deadq = { quad_fixup = None;
let new_emitter
(preallocator:quad' -> quad')
(is_2addr:bool)
(emit_target_specific:emitter -> quad -> unit)
(vregs_ok:bool)
(node:node_id option)
: emitter =
@ -721,8 +719,7 @@ let new_emitter
emit_pc = 0;
emit_next_vreg = (if vregs_ok then Some 0 else None);
emit_next_spill = 0;
emit_preallocator = preallocator;
emit_is_2addr = is_2addr;
emit_target_specific = emit_target_specific;
emit_quads = Array.create 4 badq;
emit_annotations = Hashtbl.create 0;
emit_size_cache = Stack.create ();
@ -837,218 +834,30 @@ let append_quad
e.emit_pc <- e.emit_pc + 1
;;
let default_mov q' =
match q' with
Binary b ->
begin
match b.binary_op with
IDIV | IMUL | IMOD -> IMOV
| _ -> UMOV
end
| Unary u ->
begin
match u.unary_op with
IMOV -> IMOV
| _ -> UMOV
end
| _ -> UMOV
;;
let emit_full
(e:emitter)
(fix:fixup option)
(q':quad')
: unit =
let fixup = ref fix in
let emit_quad_bottom q' =
append_quad e { quad_body = q';
quad_fixup = (!fixup) };
fixup := None;
in
let emit_quad (q':quad') : unit =
(* re-decay any freshly generated mem-mem movs. *)
match q' with
Unary { unary_dst = Mem (dst_mem, ScalarTy src_st);
unary_src = Cell (Mem (src_mem, ScalarTy dst_st));
unary_op = op }
when is_mov op ->
let v = next_vreg_cell e dst_st in
emit_quad_bottom
(unary op v (Cell (Mem (src_mem, ScalarTy src_st))));
emit_quad_bottom
(unary op (Mem (dst_mem, ScalarTy dst_st)) (Cell v))
| _ -> emit_quad_bottom q'
in
let default_mov =
match q' with
Binary b ->
begin
match b.binary_op with
IDIV | IMUL | IMOD -> IMOV
| _ -> UMOV
end
| Unary u ->
begin
match u.unary_op with
IMOV -> IMOV
| _ -> UMOV
end
| _ -> UMOV
in
let emit_mov (dst:cell) (src:operand) : unit =
emit_quad (unary default_mov dst src)
in
let mov_if_operands_differ
(old_op:operand) (new_op:operand)
: unit =
if (new_op <> old_op)
then
match new_op with
(Cell new_cell) ->
emit_mov new_cell old_op
| _ -> ()
in
let mov_if_two_operands_differ
(old_lhs_op:operand) (new_lhs_op:operand)
(old_rhs_op:operand) (new_rhs_op:operand)
: unit =
(*
* This is sufficiently obscure that it deserves an explanation.
*
* The main idea here is to do two "mov_if_operands_differ" calls,
* such as one might have when setting up a binary quad.
*
* The problem comes when you happen to hit a case like X86 div,
* which preallocates *both* operands. Preallocating both means we
* have to potentially issue two movs into the preallocated regs,
* and the second of those movs might be a problem. Specifically:
* the second mov-to-prealloc might make be moving from a
* register-indirect mem cell based on a vreg, and that vreg may
* wind up being assigned to an hreg that we just loaded with the
* first mov. In other words, the second mov may retask the
* preallocated hreg we set up in the first mov.
*
* You laugh, but of course this actually happens.
*
* So here we do a conservative thing and check to see if either
* operand is memory-indirect at all. If either is, then for either
* of the 'old' operands we're *about* to mov into a prealloc reg,
* we first bounce them off a spill slot. Spill slots, thankfully,
* we can always count on being able to address irrespective of the
* opinions of the RA, as they are all just fp-relative.
*
* A slightly more aggressive version of this would only bounce
* cases that are not fp-relative already, though doing so would
* require threading the notion of what fp *is* through to
* here. Possibly tighten this up in the future (or just
* ... destroy this backend ASAP).
*
*)
let has_reg_indirect op =
match op with
Cell (Mem _) -> true
| _ -> false
in
let either_old_op_has_reg_indirect =
(has_reg_indirect old_lhs_op) || (has_reg_indirect old_rhs_op)
in
let old_lhs_op =
if either_old_op_has_reg_indirect && (new_lhs_op <> old_lhs_op)
then
let tmp =
Mem (next_spill_slot e
(ScalarTy (operand_scalar_ty old_lhs_op)))
in
emit_mov tmp old_lhs_op;
Cell tmp
else
old_lhs_op
in
let old_rhs_op =
if either_old_op_has_reg_indirect && (new_rhs_op <> old_rhs_op)
then
let tmp =
Mem (next_spill_slot e
(ScalarTy (operand_scalar_ty old_rhs_op)))
in
emit_mov tmp old_rhs_op;
Cell tmp
else
old_rhs_op
in
mov_if_operands_differ old_lhs_op new_lhs_op;
mov_if_operands_differ old_rhs_op new_rhs_op;
in
let mov_if_cells_differ (old_cell:cell) (new_cell:cell) : unit =
if not (new_cell = old_cell)
then
emit_mov old_cell (Cell new_cell)
in
let emit_decayed_quad q' =
match (q', e.emit_preallocator q') with
(Binary b, Binary b') ->
begin
mov_if_two_operands_differ
b.binary_lhs b'.binary_lhs
b.binary_rhs b'.binary_rhs;
if e.emit_is_2addr &&
(not (b'.binary_lhs = (Cell b'.binary_dst)))
then
begin
emit_mov b'.binary_dst b'.binary_lhs;
emit_quad (Binary { b' with
binary_lhs = (Cell b'.binary_dst) })
end
else
emit_quad (Binary b');
mov_if_cells_differ b.binary_dst b'.binary_dst
end
| (Unary u, Unary u') ->
mov_if_operands_differ u.unary_src u'.unary_src;
(* Assume '2addr' means '1addr' for unary ops. *)
if e.emit_is_2addr &&
(u'.unary_op = NEG || u'.unary_op = NOT) &&
(not (u'.unary_src = (Cell u'.unary_dst)))
then
begin
emit_mov u'.unary_dst u'.unary_src;
emit_quad (Unary { u' with unary_src = (Cell u'.unary_dst) })
end
else
emit_quad (Unary u');
mov_if_cells_differ u.unary_dst u'.unary_dst
| (Cmp c, Cmp c') ->
mov_if_two_operands_differ
c.cmp_lhs c'.cmp_lhs
c.cmp_rhs c'.cmp_rhs;
emit_quad (Cmp c');
| (Push op, Push op') ->
mov_if_operands_differ op op';
emit_quad (Push op');
| (Pop c, Pop c') ->
emit_quad (Pop c');
mov_if_cells_differ c c'
| (Call c, Call c') ->
emit_quad (Call c');
mov_if_cells_differ c.call_dst c'.call_dst
| (Lea lea, Lea lea') ->
emit_quad (Lea lea');
mov_if_cells_differ lea.lea_dst lea'.lea_dst
| (x, y) ->
assert (x = y);
emit_quad x
in
(* pre-decay mem-mem movs. *)
match q' with
Unary { unary_dst = Mem (dst_mem, ScalarTy src_st);
unary_src = Cell (Mem (src_mem, ScalarTy dst_st));
unary_op = op }
when is_mov op ->
let v = next_vreg_cell e dst_st in
emit_decayed_quad
(unary op v (Cell (Mem (src_mem, ScalarTy src_st))));
emit_decayed_quad
(unary op (Mem (dst_mem, ScalarTy dst_st)) (Cell v))
| _ -> emit_decayed_quad q'
e.emit_target_specific e { quad_body = q';
quad_fixup = fix }
;;
let emit (e:emitter) (q':quad') : unit =

View File

@ -256,63 +256,111 @@ let is_rm8 (c:Il.cell) : bool =
| _ -> is_r8 c
;;
let prealloc_quad (quad':Il.quad') : Il.quad' =
let target_cell reg c =
Il.Reg (Il.Hreg reg, Il.cell_scalar_ty c)
let emit_target_specific
(e:Il.emitter)
(q:Il.quad)
: unit =
let fixup = ref q.Il.quad_fixup in
let put q' =
Il.append_quad e { Il.quad_body = q';
Il.quad_fixup = (!fixup) };
fixup := None;
in
let target_operand reg op =
Il.Cell (Il.Reg (Il.Hreg reg, Il.operand_scalar_ty op))
let op_vreg op =
Il.next_vreg_cell e (Il.operand_scalar_ty op)
in
let cell_vreg cell = op_vreg (Il.Cell cell) in
let mem_vreg mem = cell_vreg (Il.Mem mem) in
let movop = Il.default_mov q.Il.quad_body in
let mov dst src =
(* Decay mem-mem moves to use a vreg. *)
match dst, src with
Il.Mem dm, Il.Cell (Il.Mem _) ->
let v = mem_vreg dm in
put (Il.unary movop v src);
put (Il.unary movop dst (Il.Cell v))
| _ -> put (Il.unary movop dst src)
in
let target_bin_to_hreg bin dst src =
{ bin with
Il.binary_rhs = target_operand src bin.Il.binary_rhs;
Il.binary_lhs = target_operand dst bin.Il.binary_lhs;
Il.binary_dst = target_cell dst bin.Il.binary_dst }
let hr_like_op hr op =
Il.Reg (Il.Hreg hr, Il.operand_scalar_ty op)
in
let hr_like_cell hr c = hr_like_op hr (Il.Cell c) in
let q = q.Il.quad_body in
let target_cmp cmp =
match cmp.Il.cmp_lhs with
(* Immediate LHS we force to eax. *)
Il.Imm _ ->
{ cmp with
Il.cmp_lhs = target_operand eax cmp.Il.cmp_lhs }
| _ -> cmp
in
match quad' with
Il.Binary bin ->
match q with
Il.Binary ({ Il.binary_op = op;
Il.binary_dst = dst;
Il.binary_lhs = lhs;
Il.binary_rhs = rhs; } as b) ->
begin
Il.Binary
begin
match bin.Il.binary_op with
Il.IMUL | Il.UMUL
| Il.IDIV | Il.UDIV -> target_bin_to_hreg bin eax ecx
| Il.IMOD | Il.UMOD -> target_bin_to_hreg bin eax ecx
| _ -> bin
end
match op with
Il.IMUL | Il.UMUL
| Il.IDIV | Il.UDIV
| Il.IMOD | Il.UMOD ->
let dst_eax = hr_like_cell eax dst in
let lhs_eax = hr_like_op eax lhs in
let rhs_ecx = hr_like_op ecx lhs in
if lhs <> (Il.Cell lhs_eax)
then mov lhs_eax lhs;
if rhs <> (Il.Cell rhs_ecx)
then mov rhs_ecx rhs;
put (Il.Binary
{ b with
Il.binary_lhs = (Il.Cell lhs_eax);
Il.binary_rhs = (Il.Cell rhs_ecx);
Il.binary_dst = dst_eax; });
if dst <> dst_eax
then mov dst (Il.Cell dst_eax);
| _ when (Il.Cell dst) <> lhs ->
mov dst lhs;
put (Il.Binary
{ b with Il.binary_lhs = Il.Cell dst })
| _ -> put q
end
| Il.Cmp cmp -> Il.Cmp (target_cmp cmp)
| Il.Unary ({ Il.unary_op = op;
Il.unary_dst = dst;
Il.unary_src = src; } as u) ->
begin
match op with
Il.UMOV | Il.IMOV ->
mov dst src
(* x86 can only NEG or NOT in-place. *)
| Il.NEG | Il.NOT when (Il.Cell dst) <> src ->
mov dst src;
put (Il.Unary { u with Il.unary_src = Il.Cell dst })
| _ -> put q
end
| Il.Call c ->
let ty = Il.cell_scalar_ty c.Il.call_dst in
Il.Call { c with
Il.call_dst = Il.Reg ((Il.Hreg eax), ty) }
let dst_eax = hr_like_cell eax c.Il.call_dst in
put (Il.Call { c with Il.call_dst = dst_eax });
if c.Il.call_dst <> dst_eax
then mov c.Il.call_dst (Il.Cell dst_eax)
| Il.Lea le ->
begin
match (le.Il.lea_dst, le.Il.lea_src) with
(Il.Reg (_, dst_ty), Il.ImmPtr _)
when is_ty32 dst_ty ->
Il.Lea { le with
Il.lea_dst = Il.Reg (Il.Hreg eax, dst_ty) }
| _ -> quad'
end
(*
* For the get-next-pc thunk hack to work, we need to lea an immptr
* to eax, always.
*)
| Il.Lea ({ Il.lea_dst = dst;
Il.lea_src = Il.ImmPtr _ } as lea) ->
let eax_dst = hr_like_cell eax dst in
put (Il.Lea { lea with Il.lea_dst = eax_dst });
if dst <> eax_dst
then mov dst (Il.Cell eax_dst);
| x -> x
| q -> put q
;;
let constrain_vregs (q:Il.quad) (hregs:Bits.t array) : unit =
let involves_8bit_cell =
@ -1640,13 +1688,12 @@ let (abi:Abi.abi) =
Abi.abi_word_bits = word_bits;
Abi.abi_word_ty = word_ty;
Abi.abi_is_2addr_machine = true;
Abi.abi_has_pcrel_data = false;
Abi.abi_has_pcrel_code = true;
Abi.abi_n_hardregs = n_hardregs;
Abi.abi_str_of_hardreg = reg_str;
Abi.abi_prealloc_quad = prealloc_quad;
Abi.abi_emit_target_specific = emit_target_specific;
Abi.abi_constrain_vregs = constrain_vregs;
Abi.abi_emit_fn_prologue = fn_prologue;
@ -2291,8 +2338,7 @@ let select_insn (q:Il.quad) : Asm.frag =
let new_emitter_without_vregs _ : Il.emitter =
Il.new_emitter
abi.Abi.abi_prealloc_quad
abi.Abi.abi_is_2addr_machine
abi.Abi.abi_emit_target_specific
false None
;;

View File

@ -160,8 +160,7 @@ let trans_visitor
let emitters = Stack.create () in
let push_new_emitter (vregs_ok:bool) (fnid:node_id option) =
let e = Il.new_emitter
abi.Abi.abi_prealloc_quad
abi.Abi.abi_is_2addr_machine
abi.Abi.abi_emit_target_specific
vregs_ok fnid
in
Stack.push (Hashtbl.create 0) e.Il.emit_size_cache;

View File

@ -0,0 +1,7 @@
// Testcase for issue #131.
fn main() -> () {
let int a = 10;
log a;
check (a * (a - 1) == 90);
}