Degrade emitter size cache to just a flat hashtable with regular flushes (sigh) and re-introduce horrible bounce-off-spill hack for DIV, MUL, etc.

This commit is contained in:
Graydon Hoare 2010-08-05 17:44:35 -07:00
parent 9da8101cc8
commit db561b52ff
3 changed files with 73 additions and 33 deletions

View File

@ -695,7 +695,7 @@ type emitter = { mutable emit_pc: int;
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;
emit_size_cache: (size,operand) Hashtbl.t;
emit_node: node_id option;
}
@ -722,7 +722,7 @@ let new_emitter
emit_target_specific = emit_target_specific;
emit_quads = Array.create 4 badq;
emit_annotations = Hashtbl.create 0;
emit_size_cache = Stack.create ();
emit_size_cache = Hashtbl.create 0;
emit_node = node;
}
;;

View File

@ -302,11 +302,41 @@ let emit_target_specific
| 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;
let rhs_ecx = hr_like_op ecx rhs in
(* Horrible: we bounce complex mul inputs off spill slots
* to ensure non-interference between the temporaries used
* during mem-base-reg reloads and the registers we're
* preparing. *)
let next_spill_like op =
Il.Mem (Il.next_spill_slot e
(Il.ScalarTy (Il.operand_scalar_ty op)))
in
let is_mem op =
match op with
Il.Cell (Il.Mem _) -> true
| _ -> false
in
let bounce_lhs = is_mem lhs in
let bounce_rhs = is_mem rhs in
let lhs_spill = next_spill_like lhs in
let rhs_spill = next_spill_like rhs in
if bounce_lhs
then mov lhs_spill lhs;
if bounce_rhs
then mov rhs_spill rhs;
mov lhs_eax
(if bounce_lhs
then (Il.Cell lhs_spill)
else lhs);
mov rhs_ecx
(if bounce_rhs
then (Il.Cell rhs_spill)
else rhs);
put (Il.Binary
{ b with
Il.binary_lhs = (Il.Cell lhs_eax);

View File

@ -163,7 +163,6 @@ let trans_visitor
abi.Abi.abi_emit_target_specific
vregs_ok fnid
in
Stack.push (Hashtbl.create 0) e.Il.emit_size_cache;
Stack.push e emitters;
in
@ -172,16 +171,20 @@ let trans_visitor
let pop_emitter _ = ignore (Stack.pop emitters) in
let emitter _ = Stack.top emitters in
let emitter_size_cache _ = Stack.top (emitter()).Il.emit_size_cache in
let push_emitter_size_cache _ =
Stack.push
(Hashtbl.copy (emitter_size_cache()))
(emitter()).Il.emit_size_cache
let emitter_size_cache _ = (emitter()).Il.emit_size_cache in
let flush_emitter_size_cache _ =
Hashtbl.clear (emitter_size_cache())
in
let pop_emitter_size_cache _ =
ignore (Stack.pop (emitter()).Il.emit_size_cache)
let emit q =
begin
match q with
Il.Jmp _ -> flush_emitter_size_cache();
| _ -> ()
end;
Il.emit (emitter()) q
in
let emit q = Il.emit (emitter()) q in
let next_vreg _ = Il.next_vreg (emitter()) in
let next_vreg_cell t = Il.next_vreg_cell (emitter()) t in
let next_spill_cell t =
@ -190,12 +193,17 @@ let trans_visitor
let spill_ta = (spill_mem, Il.ScalarTy t) in
Il.Mem spill_ta
in
let mark _ : quad_idx = (emitter()).Il.emit_pc in
let mark _ : quad_idx =
flush_emitter_size_cache ();
(emitter()).Il.emit_pc
in
let patch_existing (jmp:quad_idx) (targ:quad_idx) : unit =
Il.patch_jump (emitter()) jmp targ
Il.patch_jump (emitter()) jmp targ;
flush_emitter_size_cache ();
in
let patch (i:quad_idx) : unit =
Il.patch_jump (emitter()) i (mark());
flush_emitter_size_cache ();
(* Insert a dead quad to ensure there's an otherwise-unused
* jump-target here.
*)
@ -583,7 +591,13 @@ let trans_visitor
(string_of_size size)));
let sub_sz = calculate_sz ty_params in
match htab_search (emitter_size_cache()) size with
Some op -> op
Some op ->
iflog (fun _ -> annotate
(Printf.sprintf "cached size %s is %s"
(string_of_size size)
(oper_str op)));
op
| _ ->
let res =
match size with
@ -674,9 +688,7 @@ let trans_visitor
(Printf.sprintf "calculated size %s is %s"
(string_of_size size)
(oper_str res)));
(* FIXME: this appears to be incorrect; investigate why.*)
(* htab_put (emitter_size_cache()) size res; *)
htab_put (emitter_size_cache()) size res;
res
@ -1926,8 +1938,8 @@ let trans_visitor
: quad_idx list =
emit (Il.cmp (Il.Cell (Il.Reg (force_to_reg lhs))) rhs);
let jmp = mark() in
emit (Il.jmp cjmp Il.CodeNone);
[ jmp ]
emit (Il.jmp cjmp Il.CodeNone);
[ jmp ]
and trans_compare
?ty_params:(ty_params=get_ty_params_of_current_frame())
@ -1946,7 +1958,6 @@ let trans_visitor
| _ -> trans_compare_simple cjmp lhs rhs
and trans_cond (invert:bool) (expr:Ast.expr) : quad_idx list =
let anno _ =
iflog
begin
@ -2078,15 +2089,14 @@ let trans_visitor
trans_atom a
and trans_block (block:Ast.block) : unit =
flush_emitter_size_cache();
trace_str cx.ctxt_sess.Session.sess_trace_block
"entering block";
push_emitter_size_cache ();
emit (Il.Enter (Hashtbl.find cx.ctxt_block_fixups block.id));
Array.iter trans_stmt block.node;
trace_str cx.ctxt_sess.Session.sess_trace_block
"exiting block";
emit Il.Leave;
pop_emitter_size_cache ();
trace_str cx.ctxt_sess.Session.sess_trace_block
"exited block";
@ -4398,11 +4408,11 @@ let trans_visitor
let back_jmp =
trans_compare_simple Il.JB (Il.Cell dptr) (Il.Cell dlim)
in
List.iter
(fun j -> patch_existing j back_jmp_targ) back_jmp;
let v = next_vreg_cell word_sty in
mov v (Il.Cell src_fill);
add_to dst_fill (Il.Cell v);
List.iter
(fun j -> patch_existing j back_jmp_targ) back_jmp;
let v = next_vreg_cell word_sty in
mov v (Il.Cell src_fill);
add_to dst_fill (Il.Cell v);
| t ->
begin
bug () "unsupported vector-append type %a" Ast.sprintf_ty t