| Attached Files |  ocamlopt-amd64+i386-merge-common-float-constants.patch [^] (6,240 bytes) 2010-11-27 19:52 [Show Content] [Hide Content]diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index e342090..641111f 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -323,6 +323,16 @@ let output_epilogue () =
` addq ${emit_int n}, %rsp\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
+
(* Output the assembly code for an instruction *)
(* Name of current function *)
@@ -330,8 +340,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 -> ()
@@ -360,8 +368,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) ->
@@ -639,7 +646,7 @@ let rec emit_all fallthrough i =
(* Emission of the floating-point constants *)
-let emit_float_constant (lbl, cst) =
+let emit_float_constant (cst, lbl) =
`{emit_label lbl}:`;
emit_float64_directive ".quad" cst
diff --git a/asmcomp/amd64/emit_nt.mlp b/asmcomp/amd64/emit_nt.mlp
index 724d6ee..813d7b7 100644
--- a/asmcomp/amd64/emit_nt.mlp
+++ b/asmcomp/amd64/emit_nt.mlp
@@ -317,6 +317,16 @@ 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
+
(* Output the assembly code for an instruction *)
(* Name of current function *)
@@ -324,8 +334,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 -> ()
@@ -358,8 +366,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) ->
@@ -650,7 +657,7 @@ let emit_float s =
end else
emit_string s
-let emit_float_constant (lbl, cst) =
+let emit_float_constant (cst, lbl) =
`{emit_label lbl} REAL8 {emit_float cst}\n`
(* Emission of a function declaration *)
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index 5d4802f..d57f880 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -400,6 +400,16 @@ 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
+
(* Output the assembly code for an instruction *)
(* Name of current function *)
@@ -408,8 +418,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
@@ -450,8 +458,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) ->
@@ -813,7 +820,7 @@ let rec emit_all fallthrough i =
(* Emission of the floating-point constants *)
-let emit_float_constant (lbl, cst) =
+let emit_float_constant (cst, lbl) =
` .data\n`;
`{emit_label lbl}:`;
emit_float64_split_directive ".long" cst
diff --git a/asmcomp/i386/emit_nt.mlp b/asmcomp/i386/emit_nt.mlp
index da1606e..172fd36 100644
--- a/asmcomp/i386/emit_nt.mlp
+++ b/asmcomp/i386/emit_nt.mlp
@@ -358,6 +358,16 @@ 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
+
(* Output the assembly code for an instruction *)
(* Name of current function *)
@@ -367,8 +377,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 -> ()
@@ -405,8 +413,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) ->
@@ -770,7 +777,7 @@ let emit_float s =
end else
emit_string s
-let emit_float_constant (lbl, cst) =
+let emit_float_constant (cst, lbl) =
`{emit_label lbl} REAL8 {emit_float cst}\n`
(* Emission of a function declaration *)
merge-floating-point-constants.patch [^] (14,245 bytes) 2010-12-10 00:25 [Show Content] [Hide Content]diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index e342090..48d23fd 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -323,6 +323,23 @@ let output_epilogue () =
` addq ${emit_int n}, %rsp\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_constant (cst, lbl) =
+ `{emit_label lbl}:`;
+ emit_float64_directive ".quad" cst
+
(* Output the assembly code for an instruction *)
(* Name of current function *)
@@ -330,8 +347,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 -> ()
@@ -360,8 +375,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) ->
@@ -637,12 +651,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 () =
@@ -668,7 +676,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;
@@ -691,12 +698,6 @@ let fundecl fundecl =
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
- if !float_constants <> [] then begin
- if macosx
- then ` .literal8\n`
- else ` .section .rodata.cst8,\"a\",@progbits\n`;
- List.iter emit_float_constant !float_constants
- end;
match Config.system with
"linux" | "gnu" ->
` .type {emit_symbol fundecl.fun_name},@function\n`;
@@ -742,6 +743,7 @@ let data l =
(* Beginning / end of an assembly file *)
let begin_assembly() =
+ float_constants := [];
if !Clflags.dlcode then begin
(* from amd64.S; could emit these constants on demand *)
if macosx then
@@ -764,6 +766,12 @@ let begin_assembly() =
if macosx then ` nop\n` (* PR#4690 *)
let end_assembly() =
+ if !float_constants <> [] then begin
+ if macosx
+ then ` .literal8\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" *)
diff --git a/asmcomp/amd64/emit_nt.mlp b/asmcomp/amd64/emit_nt.mlp
index 724d6ee..ad8fbaf 100644
--- a/asmcomp/amd64/emit_nt.mlp
+++ b/asmcomp/amd64/emit_nt.mlp
@@ -317,6 +317,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 *)
@@ -324,8 +357,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 -> ()
@@ -358,8 +389,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) ->
@@ -631,28 +661,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 =
@@ -660,7 +668,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;
@@ -676,11 +683,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 *)
@@ -723,6 +726,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`;
@@ -748,6 +752,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`;
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index 5d4802f..4d20fd3 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -400,6 +400,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 (lbl, cst) =
+ `{emit_label lbl}:`;
+ emit_float64_split_directive ".long" cst
+
(* Output the assembly code for an instruction *)
(* Name of current function *)
@@ -408,8 +425,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
@@ -450,8 +465,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) ->
@@ -811,13 +825,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 =
@@ -883,7 +890,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;
@@ -905,7 +911,6 @@ let fundecl fundecl =
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
- List.iter emit_float_constant !float_constants;
match Config.system with
"linux_elf" | "bsd_elf" | "gnu" ->
` .type {emit_symbol fundecl.fun_name},@function\n`;
@@ -954,6 +959,7 @@ let data l =
(* Beginning / end of an assembly file *)
let begin_assembly() =
+ float_constants := [];
let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
` .data\n`;
` .globl {emit_symbol lbl_begin}\n`;
@@ -965,6 +971,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" *)
diff --git a/asmcomp/i386/emit_nt.mlp b/asmcomp/i386/emit_nt.mlp
index da1606e..546a61a 100644
--- a/asmcomp/i386/emit_nt.mlp
+++ b/asmcomp/i386/emit_nt.mlp
@@ -358,6 +358,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 (lbl, cst) =
+ `{emit_label lbl} REAL8 {emit_float cst}\n`
+
(* Output the assembly code for an instruction *)
(* Name of current function *)
@@ -367,8 +400,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 -> ()
@@ -405,8 +436,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) ->
@@ -751,28 +781,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 =
@@ -780,7 +788,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;
@@ -795,14 +802,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 *)
@@ -845,6 +845,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`;
@@ -871,6 +872,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;
|
Relationships 
Relationships 