Utilisation de l'algo d'Ershov pour reduire les besoins en pile flottante.
Detection des debordements. Ajout des instructions soustraction inversee / division inversee. git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@607 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
0bbb307c67
commit
b79f609a22
|
@ -25,6 +25,7 @@ type specific_operation =
|
|||
| Istore_int of int * addressing_mode (* Store an integer constant *)
|
||||
| Istore_symbol of string * addressing_mode (* Store a symbol *)
|
||||
| Ioffset_loc of int * addressing_mode (* Add a constant to a location *)
|
||||
| Isubfrev | Idivfrev (* Reversed float sub and div *)
|
||||
| Ifloatarithmem of float_operation * addressing_mode (* float arith w/mem *)
|
||||
|
||||
and float_operation =
|
||||
|
@ -93,6 +94,10 @@ let print_specific_operation printreg op arg =
|
|||
| Ioffset_loc(n, addr) ->
|
||||
print_string "["; print_addressing printreg addr arg;
|
||||
print_string "] +:= "; print_int n
|
||||
| Isubfrev ->
|
||||
printreg arg.(0); print_string " -f(rev) "; printreg arg.(1)
|
||||
| Idivfrev ->
|
||||
printreg arg.(0); print_string " /f(rev) "; printreg arg.(1)
|
||||
| Ifloatarithmem(op, addr) ->
|
||||
printreg arg.(0);
|
||||
begin match op with
|
||||
|
|
|
@ -27,7 +27,6 @@ open Emitaux
|
|||
let fastcode_flag = ref true
|
||||
|
||||
let stack_offset = ref 0
|
||||
let fp_offset = ref 0
|
||||
|
||||
(* Layout of the stack frame *)
|
||||
|
||||
|
@ -72,6 +71,17 @@ let emit_align =
|
|||
"linux_elf" -> (fun n -> ` .align {emit_int n}\n`)
|
||||
| _ -> (fun n -> ` .align {emit_int(Misc.log2 n)}\n`)
|
||||
|
||||
(* Track the position of the floating-point stack *)
|
||||
|
||||
let fp_offset = ref 0
|
||||
|
||||
let push_fp () =
|
||||
incr fp_offset;
|
||||
if !fp_offset > 4 then fatal_error "Emit: float expression too complex"
|
||||
|
||||
let pop_fp () =
|
||||
decr fp_offset
|
||||
|
||||
(* Output a pseudo-register *)
|
||||
|
||||
let emit_reg = function
|
||||
|
@ -208,6 +218,8 @@ let instr_for_floatop = function
|
|||
| Isubf -> "fsub"
|
||||
| Imulf -> "fmul"
|
||||
| Idivf -> "fdiv"
|
||||
| Ispecific Isubfrev -> "fsubr"
|
||||
| Ispecific Idivfrev -> "fdivr"
|
||||
| _ -> fatal_error "Emit_i386: instr_for_floatop"
|
||||
|
||||
let instr_for_floatop_reversed = function
|
||||
|
@ -215,14 +227,18 @@ let instr_for_floatop_reversed = function
|
|||
| Isubf -> "fsubr"
|
||||
| Imulf -> "fmul"
|
||||
| Idivf -> "fdivr"
|
||||
| _ -> fatal_error "Emit_i386: instr_for_floatop"
|
||||
| Ispecific Isubfrev -> "fsub"
|
||||
| Ispecific Idivfrev -> "fdiv"
|
||||
| _ -> fatal_error "Emit_i386: instr_for_floatop_reversed"
|
||||
|
||||
let instr_for_floatop_pop = function
|
||||
Iaddf -> "faddp"
|
||||
| Isubf -> "fsubp"
|
||||
| Imulf -> "fmulp"
|
||||
| Idivf -> "fdivp"
|
||||
| _ -> fatal_error "Emit_i386: instr_for_floatop"
|
||||
| Ispecific Isubfrev -> "fsubrp"
|
||||
| Ispecific Idivfrev -> "fdivrp"
|
||||
| _ -> fatal_error "Emit_i386: instr_for_floatop_pop"
|
||||
|
||||
let instr_for_floatarithmem = function
|
||||
Ifloatadd -> "faddl"
|
||||
|
@ -278,14 +294,14 @@ let emit_instr i =
|
|||
begin match i.arg.(0).loc with
|
||||
Reg 100 -> (* top of FP stack *)
|
||||
` fstpl {emit_reg i.res.(0)}\n`;
|
||||
decr fp_offset
|
||||
pop_fp()
|
||||
| Reg 101 when !fp_offset = 0 -> (* %st(0) *)
|
||||
` fstl {emit_reg i.res.(0)}\n`
|
||||
| _ ->
|
||||
` fldl {emit_reg i.arg.(0)}\n`;
|
||||
incr fp_offset;
|
||||
push_fp();
|
||||
` fstpl {emit_reg i.res.(0)}\n`;
|
||||
decr fp_offset
|
||||
pop_fp()
|
||||
end
|
||||
end
|
||||
| Lop(Iconst_int 0) ->
|
||||
|
@ -306,7 +322,7 @@ let emit_instr i =
|
|||
float_constants := (lbl, s) :: !float_constants;
|
||||
` fldl {emit_label lbl}\n`
|
||||
end;
|
||||
incr fp_offset
|
||||
push_fp()
|
||||
| Lop(Iconst_symbol s) ->
|
||||
` movl ${emit_symbol s}, {emit_reg i.res.(0)}\n`
|
||||
| Lop(Icall_ind) ->
|
||||
|
@ -368,7 +384,7 @@ let emit_instr i =
|
|||
end
|
||||
| Float ->
|
||||
` fldl {emit_addressing addr i.arg 0}\n`;
|
||||
incr fp_offset
|
||||
push_fp()
|
||||
end
|
||||
| Lop(Istore(Word, addr)) ->
|
||||
begin match i.arg.(0).typ with
|
||||
|
@ -378,7 +394,7 @@ let emit_instr i =
|
|||
begin match i.arg.(0).loc with
|
||||
Reg 100 -> (* top of FP stack *)
|
||||
` fstpl {emit_addressing addr i.arg 1}\n`;
|
||||
decr fp_offset
|
||||
pop_fp()
|
||||
| Reg 101 when !fp_offset = 0 -> (* %st(0) *)
|
||||
` fstl {emit_addressing addr i.arg 1}\n`
|
||||
| _ ->
|
||||
|
@ -466,18 +482,19 @@ let emit_instr i =
|
|||
| Lop(Iintop_imm(op, n)) ->
|
||||
(* We have i.arg.(0) = i.res.(0) *)
|
||||
` {emit_string(instr_for_intop op)} ${emit_int n}, {emit_reg i.res.(0)}\n`
|
||||
| Lop(Iaddf | Isubf | Imulf | Idivf as floatop) ->
|
||||
| Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific(Isubfrev | Idivfrev)
|
||||
as floatop) ->
|
||||
begin match (i.arg.(0).loc, i.arg.(1).loc) with
|
||||
(Reg 100, Reg 100) -> (* both operands on top of FP stack *)
|
||||
` {emit_string(instr_for_floatop_pop floatop)} %st(0), %st(1)\n`;
|
||||
decr fp_offset
|
||||
pop_fp()
|
||||
| (Reg 100, _) -> (* first operand on stack *)
|
||||
` {emit_string(instr_for_floatop floatop)}{emit_float_operand i.arg.(1)}\n`
|
||||
| (_, Reg 100) -> (* second operand on stack *)
|
||||
` {emit_string(instr_for_floatop_reversed floatop)}{emit_float_operand i.arg.(0)}\n`
|
||||
| (_, _) -> (* both in regs or on stack *)
|
||||
` fldl {emit_reg i.arg.(0)}\n`;
|
||||
incr fp_offset;
|
||||
push_fp();
|
||||
` {emit_string(instr_for_floatop floatop)}{emit_float_operand i.arg.(1)}\n`
|
||||
end
|
||||
| Lop(Ifloatofint) ->
|
||||
|
@ -489,11 +506,11 @@ let emit_instr i =
|
|||
` fildl (%esp)\n`;
|
||||
` addl $4, %esp\n`
|
||||
end;
|
||||
incr fp_offset
|
||||
push_fp()
|
||||
| Lop(Iintoffloat) ->
|
||||
if i.arg.(0).loc <> Reg 100 then begin
|
||||
` fldl {emit_reg i.arg.(0)}\n`;
|
||||
incr fp_offset
|
||||
push_fp()
|
||||
end;
|
||||
stack_offset := !stack_offset - 8;
|
||||
` subl $8, %esp\n`;
|
||||
|
@ -509,7 +526,7 @@ let emit_instr i =
|
|||
` fistpl (%esp)\n`;
|
||||
` movl (%esp), {emit_reg i.res.(0)}\n`
|
||||
end;
|
||||
decr fp_offset;
|
||||
pop_fp();
|
||||
` fldcw 4(%esp)\n`;
|
||||
` addl $8, %esp\n`;
|
||||
stack_offset := !stack_offset + 8
|
||||
|
@ -524,7 +541,7 @@ let emit_instr i =
|
|||
| Lop(Ispecific(Ifloatarithmem(op, addr))) ->
|
||||
if i.arg.(0).loc <> Reg 100 then begin
|
||||
` fldl {emit_reg i.arg.(0)}\n`;
|
||||
incr fp_offset
|
||||
push_fp()
|
||||
end;
|
||||
` {emit_string(instr_for_floatarithmem op)} {emit_addressing addr i.arg 1}\n`
|
||||
| Lreloadretaddr ->
|
||||
|
@ -570,17 +587,17 @@ let emit_instr i =
|
|||
cmp
|
||||
| (Reg 100, _) -> (* first arg on top of FP stack *)
|
||||
` {emit_string instr}p{emit_float_operand i.arg.(1)}\n`;
|
||||
decr fp_offset;
|
||||
pop_fp();
|
||||
cmp
|
||||
| (_, Reg 100) -> (* second arg on top of FP stack *)
|
||||
` {emit_string instr}p{emit_float_operand i.arg.(0)}\n`;
|
||||
decr fp_offset;
|
||||
pop_fp();
|
||||
Cmm.swap_comparison cmp
|
||||
| (_, _) ->
|
||||
` fldl {emit_reg i.arg.(0)}\n`;
|
||||
incr fp_offset;
|
||||
push_fp();
|
||||
` {emit_string instr}p{emit_float_operand i.arg.(1)}\n`;
|
||||
decr fp_offset;
|
||||
pop_fp();
|
||||
cmp in
|
||||
` fnstsw %ax\n`;
|
||||
begin match actual_cmp with
|
||||
|
|
|
@ -162,16 +162,22 @@ let select_addressing exp =
|
|||
| (Ascaledadd(e1, e2, scale), d) ->
|
||||
(Iindexed2scaled(scale, d), Ctuple[e1; e2])
|
||||
|
||||
(* Make float operations associate to the right as much as possible. *)
|
||||
(* Estimate number of float temporaries needed to evaluate expression
|
||||
(Ershov's algorithm) *)
|
||||
|
||||
let rec reassociate oldop newop = function
|
||||
[Cop(op, [arg1; arg2]); arg3] when op = oldop ->
|
||||
reassociate oldop newop [arg1; Cop(newop, [arg2; arg3])]
|
||||
| args -> args
|
||||
let rec float_needs = function
|
||||
Cop((Caddf | Csubf | Cmulf | Cdivf), [arg1; arg2]) ->
|
||||
let n1 = float_needs arg1 in
|
||||
let n2 = float_needs arg2 in
|
||||
if n1 = n2 then 1 + n1 else max n1 n2
|
||||
| Cop(Cfloatofint, [arg]) ->
|
||||
float_needs arg
|
||||
| _ ->
|
||||
1
|
||||
|
||||
(* Recognize float arithmetic with mem *)
|
||||
|
||||
let select_floatarith regular_op mem_op mem_rev_op args =
|
||||
let select_floatarith regular_op reversed_op mem_op mem_rev_op args =
|
||||
match args with
|
||||
[arg1; Cop(Cload _, [loc2])] ->
|
||||
let (addr, arg2) = select_addressing loc2 in
|
||||
|
@ -179,8 +185,15 @@ let select_floatarith regular_op mem_op mem_rev_op args =
|
|||
| [Cop(Cload _, [loc1]); arg2] ->
|
||||
let (addr, arg1) = select_addressing loc1 in
|
||||
(Ispecific(Ifloatarithmem(mem_rev_op, addr)), [arg2; arg1])
|
||||
| [arg1; arg2] ->
|
||||
(* Evaluate bigger subexpression first to minimize stack usage.
|
||||
Because of right-to-left evaluation, rightmost arg is evaluated
|
||||
first *)
|
||||
if float_needs arg1 <= float_needs arg2
|
||||
then (regular_op, [arg1; arg2])
|
||||
else (reversed_op, [arg2; arg1])
|
||||
| _ ->
|
||||
(regular_op, args)
|
||||
fatal_error "Proc_i386: select_floatarith"
|
||||
|
||||
(* Main instruction selection functions *)
|
||||
|
||||
|
@ -209,14 +222,15 @@ let select_oper op args =
|
|||
| _ -> (Iintop Imod, args)
|
||||
end
|
||||
(* Recognize float arithmetic with memory.
|
||||
In passing, change associativity of some float operations *)
|
||||
| Caddf -> select_floatarith Iaddf Ifloatadd Ifloatadd
|
||||
(reassociate Caddf Caddf args)
|
||||
| Csubf -> select_floatarith Isubf Ifloatsub Ifloatsubrev
|
||||
(reassociate Csubf Caddf args)
|
||||
| Cmulf -> select_floatarith Imulf Ifloatmul Ifloatmul
|
||||
(reassociate Cmulf Cmulf args)
|
||||
| Cdivf -> select_floatarith Idivf Ifloatdiv Ifloatdivrev args
|
||||
In passing, apply Ershov's algorithm to reduce stack usage *)
|
||||
| Caddf ->
|
||||
select_floatarith Iaddf Iaddf Ifloatadd Ifloatadd args
|
||||
| Csubf ->
|
||||
select_floatarith Isubf (Ispecific Isubfrev) Ifloatsub Ifloatsubrev args
|
||||
| Cmulf ->
|
||||
select_floatarith Imulf Imulf Ifloatmul Ifloatmul args
|
||||
| Cdivf ->
|
||||
select_floatarith Idivf (Ispecific Idivfrev) Ifloatdiv Ifloatdivrev args
|
||||
(* Recognize store instructions *)
|
||||
| Cstore ->
|
||||
begin match args with
|
||||
|
@ -270,7 +284,7 @@ let pseudoregs_for_operation op arg res =
|
|||
(* For floating-point operations, the result is always left at the
|
||||
top of the floating-point stack *)
|
||||
| Iconst_float _ | Iaddf | Isubf | Imulf | Idivf | Ifloatofint |
|
||||
Ispecific(Ifloatarithmem(_, _)) ->
|
||||
Ispecific(Isubfrev | Idivfrev | Ifloatarithmem(_, _)) ->
|
||||
(arg, [| tos |], false) (* don't move it immediately *)
|
||||
(* Same for a floating-point load *)
|
||||
| Iload(Word, addr) when res.(0).typ = Float ->
|
||||
|
|
Loading…
Reference in New Issue