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-0dff7051ff02
master
Xavier Leroy 1996-01-09 18:18:11 +00:00
parent 0bbb307c67
commit b79f609a22
3 changed files with 72 additions and 36 deletions

View File

@ -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

View File

@ -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

View File

@ -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 ->