PR#5181: Merge common floating point constants in ocamlopt.
Instead of generating a unique quadword constant for each and every floating point constant use within a function, we now collect the floating point constants on a per-module basis, and generate only one quadword per floating point constant. This affects only the amd64 and i386 ports (both Unix/Linux/OS X and Windows). git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13149 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
Benedikt Meurer
parent
030e9d8f10
commit
6fad047cc0
|
|
@ -326,6 +326,23 @@ let output_epilogue f =
|
|||
else
|
||||
f ()
|
||||
|
||||
(* Floating-point constants *)
|
||||
|
||||
let float_constants = ref ([] : (string * int) list)
|
||||
|
||||
let add_float_constant cst =
|
||||
try
|
||||
List.assoc cst !float_constants
|
||||
with
|
||||
Not_found ->
|
||||
let lbl = new_label() in
|
||||
float_constants := (cst, lbl) :: !float_constants;
|
||||
lbl
|
||||
|
||||
let emit_float_constant (cst, lbl) =
|
||||
`{emit_label lbl}:`;
|
||||
emit_float64_directive ".quad" cst
|
||||
|
||||
(* Output the assembly code for an instruction *)
|
||||
|
||||
(* Name of current function *)
|
||||
|
|
@ -333,8 +350,6 @@ let function_name = ref ""
|
|||
(* Entry point for tail recursive calls *)
|
||||
let tailrec_entry_point = ref 0
|
||||
|
||||
let float_constants = ref ([] : (int * string) list)
|
||||
|
||||
(* Emit an instruction *)
|
||||
let emit_instr fallthrough i =
|
||||
emit_debug_info i.dbg;
|
||||
|
|
@ -365,8 +380,7 @@ let emit_instr fallthrough i =
|
|||
| 0x0000_0000_0000_0000L -> (* +0.0 *)
|
||||
` xorpd {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
|
||||
| _ ->
|
||||
let lbl = new_label() in
|
||||
float_constants := (lbl, s) :: !float_constants;
|
||||
let lbl = add_float_constant s in
|
||||
` movsd {emit_label lbl}(%rip), {emit_reg i.res.(0)}\n`
|
||||
end
|
||||
| Lop(Iconst_symbol s) ->
|
||||
|
|
@ -671,12 +685,6 @@ let rec emit_all fallthrough i =
|
|||
emit_instr fallthrough i;
|
||||
emit_all (Linearize.has_fallthrough i.desc) i.next
|
||||
|
||||
(* Emission of the floating-point constants *)
|
||||
|
||||
let emit_float_constant (lbl, cst) =
|
||||
`{emit_label lbl}:`;
|
||||
emit_float64_directive ".quad" cst
|
||||
|
||||
(* Emission of the profiling prelude *)
|
||||
|
||||
let emit_profile () =
|
||||
|
|
@ -701,7 +709,6 @@ let fundecl fundecl =
|
|||
fastcode_flag := fundecl.fun_fast;
|
||||
tailrec_entry_point := new_label();
|
||||
stack_offset := 0;
|
||||
float_constants := [];
|
||||
call_gc_sites := [];
|
||||
bound_error_sites := [];
|
||||
bound_error_call := 0;
|
||||
|
|
@ -733,15 +740,6 @@ let fundecl fundecl =
|
|||
` .type {emit_symbol fundecl.fun_name},@function\n`;
|
||||
` .size {emit_symbol fundecl.fun_name},.-{emit_symbol fundecl.fun_name}\n`
|
||||
| _ -> ()
|
||||
end;
|
||||
if !float_constants <> [] then begin
|
||||
if macosx then
|
||||
` .literal8\n`
|
||||
else if mingw64 then
|
||||
` .section .rdata,\"dr\"\n`
|
||||
else
|
||||
` .section .rodata.cst8,\"a\",@progbits\n`;
|
||||
List.iter emit_float_constant !float_constants
|
||||
end
|
||||
|
||||
(* Emission of data *)
|
||||
|
|
@ -784,6 +782,7 @@ let data l =
|
|||
|
||||
let begin_assembly() =
|
||||
reset_debug_info(); (* PR#5603 *)
|
||||
float_constants := [];
|
||||
if !Clflags.dlcode then begin
|
||||
(* from amd64.S; could emit these constants on demand *)
|
||||
if macosx then
|
||||
|
|
@ -808,6 +807,15 @@ let begin_assembly() =
|
|||
if macosx then ` nop\n` (* PR#4690 *)
|
||||
|
||||
let end_assembly() =
|
||||
if !float_constants <> [] then begin
|
||||
if macosx then
|
||||
` .literal8\n`
|
||||
else if mingw64 then
|
||||
` .section .rdata,\"dr\"\n`
|
||||
else
|
||||
` .section .rodata.cst8,\"a\",@progbits\n`;
|
||||
List.iter emit_float_constant !float_constants
|
||||
end;
|
||||
let lbl_end = Compilenv.make_symbol (Some "code_end") in
|
||||
` .text\n`;
|
||||
if macosx then ` nop\n`; (* suppress "ld warning: atom sorting error" *)
|
||||
|
|
|
|||
|
|
@ -318,6 +318,39 @@ let output_epilogue () =
|
|||
` add rsp, {emit_int n}\n`
|
||||
end
|
||||
|
||||
(* Floating-point constants *)
|
||||
|
||||
let float_constants = ref ([] : (string * int) list)
|
||||
|
||||
let add_float_constant cst =
|
||||
try
|
||||
List.assoc cst !float_constants
|
||||
with
|
||||
Not_found ->
|
||||
let lbl = new_label() in
|
||||
float_constants := (cst, lbl) :: !float_constants;
|
||||
lbl
|
||||
|
||||
let emit_float s =
|
||||
(* MASM doesn't like floating-point constants such as 2e9.
|
||||
Turn them into 2.0e9. *)
|
||||
let pos_e = ref (-1) and pos_dot = ref (-1) in
|
||||
for i = 0 to String.length s - 1 do
|
||||
match s.[i] with
|
||||
'e'|'E' -> pos_e := i
|
||||
| '.' -> pos_dot := i
|
||||
| _ -> ()
|
||||
done;
|
||||
if !pos_dot < 0 && !pos_e >= 0 then begin
|
||||
emit_string (String.sub s 0 !pos_e);
|
||||
emit_string ".0";
|
||||
emit_string (String.sub s !pos_e (String.length s - !pos_e))
|
||||
end else
|
||||
emit_string s
|
||||
|
||||
let emit_float_constant (cst, lbl) =
|
||||
`{emit_label lbl} REAL8 {emit_float cst}\n`
|
||||
|
||||
(* Output the assembly code for an instruction *)
|
||||
|
||||
(* Name of current function *)
|
||||
|
|
@ -325,8 +358,6 @@ let function_name = ref ""
|
|||
(* Entry point for tail recursive calls *)
|
||||
let tailrec_entry_point = ref 0
|
||||
|
||||
let float_constants = ref ([] : (int * string) list)
|
||||
|
||||
let emit_instr fallthrough i =
|
||||
match i.desc with
|
||||
Lend -> ()
|
||||
|
|
@ -359,8 +390,7 @@ let emit_instr fallthrough i =
|
|||
| 0x0000_0000_0000_0000L -> (* +0.0 *)
|
||||
` xorpd {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
|
||||
| _ ->
|
||||
let lbl = new_label() in
|
||||
float_constants := (lbl, s) :: !float_constants;
|
||||
let lbl = add_float_constant s in
|
||||
` movsd {emit_reg i.res.(0)}, {emit_label lbl}\n`
|
||||
end
|
||||
| Lop(Iconst_symbol s) ->
|
||||
|
|
@ -653,28 +683,6 @@ let rec emit_all fallthrough i =
|
|||
emit_instr fallthrough i;
|
||||
emit_all (Linearize.has_fallthrough i.desc) i.next
|
||||
|
||||
(* Emission of the floating-point constants *)
|
||||
|
||||
let emit_float s =
|
||||
(* MASM doesn't like floating-point constants such as 2e9.
|
||||
Turn them into 2.0e9. *)
|
||||
let pos_e = ref (-1) and pos_dot = ref (-1) in
|
||||
for i = 0 to String.length s - 1 do
|
||||
match s.[i] with
|
||||
'e'|'E' -> pos_e := i
|
||||
| '.' -> pos_dot := i
|
||||
| _ -> ()
|
||||
done;
|
||||
if !pos_dot < 0 && !pos_e >= 0 then begin
|
||||
emit_string (String.sub s 0 !pos_e);
|
||||
emit_string ".0";
|
||||
emit_string (String.sub s !pos_e (String.length s - !pos_e))
|
||||
end else
|
||||
emit_string s
|
||||
|
||||
let emit_float_constant (lbl, cst) =
|
||||
`{emit_label lbl} REAL8 {emit_float cst}\n`
|
||||
|
||||
(* Emission of a function declaration *)
|
||||
|
||||
let fundecl fundecl =
|
||||
|
|
@ -682,7 +690,6 @@ let fundecl fundecl =
|
|||
fastcode_flag := fundecl.fun_fast;
|
||||
tailrec_entry_point := new_label();
|
||||
stack_offset := 0;
|
||||
float_constants := [];
|
||||
call_gc_sites := [];
|
||||
bound_error_sites := [];
|
||||
bound_error_call := 0;
|
||||
|
|
@ -698,11 +705,7 @@ let fundecl fundecl =
|
|||
`{emit_label !tailrec_entry_point}:\n`;
|
||||
emit_all true fundecl.fun_body;
|
||||
List.iter emit_call_gc !call_gc_sites;
|
||||
emit_call_bound_errors();
|
||||
if !float_constants <> [] then begin
|
||||
` .DATA\n`;
|
||||
List.iter emit_float_constant !float_constants
|
||||
end
|
||||
emit_call_bound_errors()
|
||||
|
||||
(* Emission of data *)
|
||||
|
||||
|
|
@ -745,6 +748,7 @@ let data l =
|
|||
(* Beginning / end of an assembly file *)
|
||||
|
||||
let begin_assembly() =
|
||||
float_constants := [];
|
||||
` EXTRN caml_young_ptr: QWORD\n`;
|
||||
` EXTRN caml_young_limit: QWORD\n`;
|
||||
` EXTRN caml_exception_pointer: QWORD\n`;
|
||||
|
|
@ -770,6 +774,10 @@ let begin_assembly() =
|
|||
`{emit_symbol lbl_begin} LABEL QWORD\n`
|
||||
|
||||
let end_assembly() =
|
||||
if !float_constants <> [] then begin
|
||||
` .DATA\n`;
|
||||
List.iter emit_float_constant !float_constants
|
||||
end;
|
||||
let lbl_end = Compilenv.make_symbol (Some "code_end") in
|
||||
add_def_symbol lbl_end;
|
||||
` .CODE\n`;
|
||||
|
|
|
|||
|
|
@ -409,6 +409,23 @@ let emit_floatspecial = function
|
|||
| "tan" -> ` fptan; fstp %st(0)\n`
|
||||
| _ -> assert false
|
||||
|
||||
(* Floating-point constants *)
|
||||
|
||||
let float_constants = ref ([] : (string * int) list)
|
||||
|
||||
let add_float_constant cst =
|
||||
try
|
||||
List.assoc cst !float_constants
|
||||
with
|
||||
Not_found ->
|
||||
let lbl = new_label() in
|
||||
float_constants := (cst, lbl) :: !float_constants;
|
||||
lbl
|
||||
|
||||
let emit_float_constant (cst, lbl) =
|
||||
`{emit_label lbl}:`;
|
||||
emit_float64_split_directive ".long" cst
|
||||
|
||||
(* Output the assembly code for an instruction *)
|
||||
|
||||
(* Name of current function *)
|
||||
|
|
@ -417,8 +434,6 @@ let function_name = ref ""
|
|||
let tailrec_entry_point = ref 0
|
||||
(* Label of trap for out-of-range accesses *)
|
||||
let range_check_trap = ref 0
|
||||
(* Record float literals to be emitted later *)
|
||||
let float_constants = ref ([] : (int * string) list)
|
||||
(* Record references to external C functions (for MacOSX) *)
|
||||
let external_symbols_direct = ref StringSet.empty
|
||||
let external_symbols_indirect = ref StringSet.empty
|
||||
|
|
@ -460,8 +475,7 @@ let emit_instr fallthrough i =
|
|||
| 0xBFF0_0000_0000_0000L -> (* -1.0 *)
|
||||
` fld1\n fchs\n`
|
||||
| _ ->
|
||||
let lbl = new_label() in
|
||||
float_constants := (lbl, s) :: !float_constants;
|
||||
let lbl = add_float_constant s in
|
||||
` fldl {emit_label lbl}\n`
|
||||
end
|
||||
| Lop(Iconst_symbol s) ->
|
||||
|
|
@ -836,13 +850,6 @@ let rec emit_all fallthrough i =
|
|||
(Linearize.has_fallthrough i.desc)
|
||||
i.next
|
||||
|
||||
(* Emission of the floating-point constants *)
|
||||
|
||||
let emit_float_constant (lbl, cst) =
|
||||
` .data\n`;
|
||||
`{emit_label lbl}:`;
|
||||
emit_float64_split_directive ".long" cst
|
||||
|
||||
(* Emission of external symbol references (for MacOSX) *)
|
||||
|
||||
let emit_external_symbol_direct s =
|
||||
|
|
@ -908,7 +915,6 @@ let fundecl fundecl =
|
|||
fastcode_flag := fundecl.fun_fast;
|
||||
tailrec_entry_point := new_label();
|
||||
stack_offset := 0;
|
||||
float_constants := [];
|
||||
call_gc_sites := [];
|
||||
bound_error_sites := [];
|
||||
bound_error_call := 0;
|
||||
|
|
@ -940,8 +946,7 @@ let fundecl fundecl =
|
|||
"linux_elf" | "bsd_elf" | "gnu" ->
|
||||
` .type {emit_symbol fundecl.fun_name},@function\n`;
|
||||
` .size {emit_symbol fundecl.fun_name},.-{emit_symbol fundecl.fun_name}\n`
|
||||
| _ -> () end;
|
||||
List.iter emit_float_constant !float_constants
|
||||
| _ -> () end
|
||||
|
||||
|
||||
(* Emission of data *)
|
||||
|
|
@ -986,6 +991,7 @@ let data l =
|
|||
|
||||
let begin_assembly() =
|
||||
reset_debug_info(); (* PR#5603 *)
|
||||
float_constants := [];
|
||||
let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
|
||||
` .data\n`;
|
||||
` .globl {emit_symbol lbl_begin}\n`;
|
||||
|
|
@ -997,6 +1003,10 @@ let begin_assembly() =
|
|||
if macosx then ` nop\n` (* PR#4690 *)
|
||||
|
||||
let end_assembly() =
|
||||
if !float_constants <> [] then begin
|
||||
` .data\n`;
|
||||
List.iter emit_float_constant !float_constants
|
||||
end;
|
||||
let lbl_end = Compilenv.make_symbol (Some "code_end") in
|
||||
` .text\n`;
|
||||
if macosx then ` nop\n`; (* suppress "ld warning: atom sorting error" *)
|
||||
|
|
|
|||
|
|
@ -359,6 +359,39 @@ let emit_floatspecial = function
|
|||
| "tan" -> ` fptan\n\tfstp st(0)\n`
|
||||
| _ -> assert false
|
||||
|
||||
(* Floating-point constants *)
|
||||
|
||||
let float_constants = ref ([] : (string * int) list)
|
||||
|
||||
let add_float_constant cst =
|
||||
try
|
||||
List.assoc cst !float_constants
|
||||
with
|
||||
Not_found ->
|
||||
let lbl = new_label() in
|
||||
float_constants := (cst, lbl) :: !float_constants;
|
||||
lbl
|
||||
|
||||
let emit_float s =
|
||||
(* MASM doesn't like floating-point constants such as 2e9.
|
||||
Turn them into 2.0e9. *)
|
||||
let pos_e = ref (-1) and pos_dot = ref (-1) in
|
||||
for i = 0 to String.length s - 1 do
|
||||
match s.[i] with
|
||||
'e'|'E' -> pos_e := i
|
||||
| '.' -> pos_dot := i
|
||||
| _ -> ()
|
||||
done;
|
||||
if !pos_dot < 0 && !pos_e >= 0 then begin
|
||||
emit_string (String.sub s 0 !pos_e);
|
||||
emit_string ".0";
|
||||
emit_string (String.sub s !pos_e (String.length s - !pos_e))
|
||||
end else
|
||||
emit_string s
|
||||
|
||||
let emit_float_constant (cst, lbl) =
|
||||
`{emit_label lbl} REAL8 {emit_float cst}\n`
|
||||
|
||||
(* Output the assembly code for an instruction *)
|
||||
|
||||
(* Name of current function *)
|
||||
|
|
@ -368,8 +401,6 @@ let tailrec_entry_point = ref 0
|
|||
(* Label of trap for out-of-range accesses *)
|
||||
let range_check_trap = ref 0
|
||||
|
||||
let float_constants = ref ([] : (int * string) list)
|
||||
|
||||
let emit_instr i =
|
||||
match i.desc with
|
||||
Lend -> ()
|
||||
|
|
@ -406,8 +437,7 @@ let emit_instr i =
|
|||
| 0xBFF0_0000_0000_0000L -> (* -1.0 *)
|
||||
` fld1\n fchs\n`
|
||||
| _ ->
|
||||
let lbl = new_label() in
|
||||
float_constants := (lbl, s) :: !float_constants;
|
||||
let lbl = add_float_constant s in
|
||||
` fld {emit_label lbl}\n`
|
||||
end
|
||||
| Lop(Iconst_symbol s) ->
|
||||
|
|
@ -752,28 +782,6 @@ let emit_instr i =
|
|||
let rec emit_all i =
|
||||
match i.desc with Lend -> () | _ -> emit_instr i; emit_all i.next
|
||||
|
||||
(* Emission of the floating-point constants *)
|
||||
|
||||
let emit_float s =
|
||||
(* MASM doesn't like floating-point constants such as 2e9.
|
||||
Turn them into 2.0e9. *)
|
||||
let pos_e = ref (-1) and pos_dot = ref (-1) in
|
||||
for i = 0 to String.length s - 1 do
|
||||
match s.[i] with
|
||||
'e'|'E' -> pos_e := i
|
||||
| '.' -> pos_dot := i
|
||||
| _ -> ()
|
||||
done;
|
||||
if !pos_dot < 0 && !pos_e >= 0 then begin
|
||||
emit_string (String.sub s 0 !pos_e);
|
||||
emit_string ".0";
|
||||
emit_string (String.sub s !pos_e (String.length s - !pos_e))
|
||||
end else
|
||||
emit_string s
|
||||
|
||||
let emit_float_constant (lbl, cst) =
|
||||
`{emit_label lbl} REAL8 {emit_float cst}\n`
|
||||
|
||||
(* Emission of a function declaration *)
|
||||
|
||||
let fundecl fundecl =
|
||||
|
|
@ -781,7 +789,6 @@ let fundecl fundecl =
|
|||
fastcode_flag := fundecl.fun_fast;
|
||||
tailrec_entry_point := new_label();
|
||||
stack_offset := 0;
|
||||
float_constants := [];
|
||||
call_gc_sites := [];
|
||||
bound_error_sites := [];
|
||||
bound_error_call := 0;
|
||||
|
|
@ -796,14 +803,7 @@ let fundecl fundecl =
|
|||
`{emit_label !tailrec_entry_point}:\n`;
|
||||
emit_all fundecl.fun_body;
|
||||
List.iter emit_call_gc !call_gc_sites;
|
||||
emit_call_bound_errors ();
|
||||
begin match !float_constants with
|
||||
[] -> ()
|
||||
| _ ->
|
||||
` .DATA\n`;
|
||||
List.iter emit_float_constant !float_constants;
|
||||
float_constants := []
|
||||
end
|
||||
emit_call_bound_errors ()
|
||||
|
||||
(* Emission of data *)
|
||||
|
||||
|
|
@ -846,6 +846,7 @@ let data l =
|
|||
(* Beginning / end of an assembly file *)
|
||||
|
||||
let begin_assembly() =
|
||||
float_constants := [];
|
||||
`.386\n`;
|
||||
` .MODEL FLAT\n\n`;
|
||||
` EXTERN _caml_young_ptr: DWORD\n`;
|
||||
|
|
@ -872,6 +873,10 @@ let begin_assembly() =
|
|||
`{emit_symbol lbl_begin} LABEL DWORD\n`
|
||||
|
||||
let end_assembly() =
|
||||
if !float_constants <> [] then begin
|
||||
` .DATA\n`;
|
||||
List.iter emit_float_constant !float_constants;
|
||||
end;
|
||||
` .CODE\n`;
|
||||
let lbl_end = Compilenv.make_symbol (Some "code_end") in
|
||||
add_def_symbol lbl_end;
|
||||
|
|
|
|||
Loading…
Reference in New Issue