summaryrefslogtreecommitdiff
path: root/asmcomp
diff options
context:
space:
mode:
Diffstat (limited to 'asmcomp')
-rw-r--r--asmcomp/alpha/emit.mlp4
-rw-r--r--asmcomp/amd64/emit.mlp48
-rw-r--r--asmcomp/amd64/proc.ml3
-rw-r--r--asmcomp/arm/emit.mlp3
-rw-r--r--asmcomp/asmlink.ml1
-rw-r--r--asmcomp/emitaux.ml21
-rw-r--r--asmcomp/emitaux.mli3
-rw-r--r--asmcomp/hppa/emit.mlp8
-rw-r--r--asmcomp/i386/emit.mlp11
-rw-r--r--asmcomp/ia64/emit.mlp4
-rw-r--r--asmcomp/mips/emit.mlp5
-rw-r--r--asmcomp/power/emit.mlp15
-rw-r--r--asmcomp/sparc/emit.mlp7
13 files changed, 84 insertions, 49 deletions
diff --git a/asmcomp/alpha/emit.mlp b/asmcomp/alpha/emit.mlp
index b3890a4482..3c04b7a47a 100644
--- a/asmcomp/alpha/emit.mlp
+++ b/asmcomp/alpha/emit.mlp
@@ -793,9 +793,9 @@ let emit_item = function
long decimal constants *)
` .quad 0x{emit_string(Nativeint.format "%x" n)}\n`
| Csingle f ->
- ` .float {emit_string f}\n`
+ emit_float32_directive ".long" f
| Cdouble f ->
- ` .double {emit_string f}\n`
+ emit_float64_directive ".quad" f
| Csymbol_address s ->
` .quad {emit_symbol s}\n`
| Clabel_address lbl ->
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index 11bf78224b..950748d6e2 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -575,33 +575,26 @@ let emit_instr fallthrough i =
end
| Lswitch jumptbl ->
let lbl = new_label() in
- if !pic_code || !Clflags.dlcode then begin
- (* PR#4424: r11 is known to be clobbered by the Lswitch,
- meaning that no variable that is live across the Lswitch
- is assigned to r11. However, the argument to Lswitch
- can still be assigned to r11, so we need to special-case
- this situation. *)
- if i.arg.(0).loc = Reg 9 (* ie r11, cf amd64/proc.ml *) then begin
- ` salq $3, %r11\n`;
- ` pushq %r11\n`;
- ` leaq {emit_label lbl}(%rip), %r11\n`;
- ` addq 0(%rsp), %r11\n`;
- ` addq $8, %rsp\n`;
- ` jmp *(%r11)\n`
- end else begin
- ` leaq {emit_label lbl}(%rip), %r11\n`;
- ` jmp *(%r11, {emit_reg i.arg.(0)}, 8)\n`
- end
- end else begin
- ` jmp *{emit_label lbl}(, {emit_reg i.arg.(0)}, 8)\n`
- end;
+ (* rax and rdx are clobbered by the Lswitch,
+ meaning that no variable that is live across the Lswitch
+ is assigned to rax or rdx. However, the argument to Lswitch
+ can still be assigned to one of these two registers, so
+ we must be careful not to clobber it before use. *)
+ let (tmp1, tmp2) =
+ if i.arg.(0).loc = Reg 0 (* rax *)
+ then (phys_reg 4 (*rdx*), phys_reg 0 (*rax*))
+ else (phys_reg 0 (*rax*), phys_reg 4 (*rdx*)) in
+ ` leaq {emit_label lbl}(%rip), {emit_reg tmp1}\n`;
+ ` movslq ({emit_reg tmp1}, {emit_reg i.arg.(0)}, 4), {emit_reg tmp2}\n`;
+ ` addq {emit_reg tmp2}, {emit_reg tmp1}\n`;
+ ` jmp *{emit_reg tmp1}\n`;
if macosx
then ` .const\n`
else ` .section .rodata\n`;
- emit_align 8;
+ emit_align 4;
`{emit_label lbl}:`;
for i = 0 to Array.length jumptbl - 1 do
- ` .quad {emit_label jumptbl.(i)}\n`
+ ` .long {emit_label jumptbl.(i)} - {emit_label lbl}\n`
done;
` .text\n`
| Lsetuptrap lbl ->
@@ -634,7 +627,8 @@ let rec emit_all fallthrough i =
(* Emission of the floating-point constants *)
let emit_float_constant (lbl, cst) =
- `{emit_label lbl}: .double {emit_string cst}\n`
+ `{emit_label lbl}:`;
+ emit_float64_directive ".quad" cst
(* Emission of the profiling prelude *)
@@ -667,7 +661,9 @@ let fundecl fundecl =
bound_error_call := 0;
` .text\n`;
emit_align 16;
- if macosx && is_generic_function fundecl.fun_name
+ if macosx
+ && not !Clflags.output_c_object
+ && is_generic_function fundecl.fun_name
then (* PR#4690 *)
` .private_extern {emit_symbol fundecl.fun_name}\n`
else
@@ -712,9 +708,9 @@ let emit_item = function
| Cint n ->
` .quad {emit_nativeint n}\n`
| Csingle f ->
- ` .float {emit_string f}\n`
+ emit_float32_directive ".long" f
| Cdouble f ->
- ` .double {emit_string f}\n`
+ emit_float64_directive ".quad" f
| Csymbol_address s ->
` .quad {emit_symbol s}\n`
| Clabel_address lbl ->
diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml
index da2f886bbc..c0807b88d4 100644
--- a/asmcomp/amd64/proc.ml
+++ b/asmcomp/amd64/proc.ml
@@ -92,7 +92,6 @@ let phys_reg n =
let rax = phys_reg 0
let rcx = phys_reg 5
let rdx = phys_reg 4
-let r11 = phys_reg 9
let rxmm15 = phys_reg 115
let stack_slot slot ty =
@@ -170,7 +169,7 @@ let destroyed_at_oper = function
| Iop(Istore(Single, _)) -> [| rxmm15 |]
| Iop(Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _))
-> [| rax |]
- | Iswitch(_, _) when !pic_code || !Clflags.dlcode -> [| r11 |]
+ | Iswitch(_, _) -> [| rax; rdx |]
| _ -> [||]
let destroyed_at_raise = all_phys_regs
diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp
index 5d9e5cf7cc..a2a6b4dad3 100644
--- a/asmcomp/arm/emit.mlp
+++ b/asmcomp/arm/emit.mlp
@@ -585,6 +585,9 @@ let emit_item = function
| Csingle f ->
` .float {emit_string f}\n`
| Cdouble f ->
+ (* FIXME: this version of the ARM port is mixed-endian, so we
+ use .double instead of emit_float64_directive. The next
+ version is little-endian, so we'll use emit_float64 then. *)
` .align 0\n`;
` .double {emit_string f}\n`
| Csymbol_address s ->
diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml
index c7b9ec87ea..c1b03106a0 100644
--- a/asmcomp/asmlink.ml
+++ b/asmcomp/asmlink.ml
@@ -259,6 +259,7 @@ let link_shared ppf objfiles output_name =
(fun (info, file_name, crc) -> check_consistency file_name info crc)
units_tolink;
Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs;
+ Clflags.ccopts := !lib_ccopts @ !Clflags.ccopts;
let objfiles = List.rev (List.map object_file_name objfiles) @
!Clflags.ccobjs in
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
index e851c8187d..35338eed9b 100644
--- a/asmcomp/emitaux.ml
+++ b/asmcomp/emitaux.ml
@@ -93,6 +93,27 @@ let emit_bytes_directive directive s =
done;
if !pos > 0 then emit_char '\n'
+(* PR#4813: assemblers do strange things with float literals indeed,
+ so we convert to IEEE representation ourselves and emit float
+ literals as 32- or 64-bit integers. *)
+
+let emit_float64_directive directive f =
+ let x = Int64.bits_of_float (float_of_string f) in
+ emit_printf "\t%s\t0x%Lx\n" directive x
+
+let emit_float64_split_directive directive f =
+ let x = Int64.bits_of_float (float_of_string f) in
+ let lo = Int64.logand x 0xFFFF_FFFFL
+ and hi = Int64.shift_right_logical x 32 in
+ emit_printf "\t%s\t0x%Lx, 0x%Lx\n"
+ directive
+ (if Arch.big_endian then hi else lo)
+ (if Arch.big_endian then lo else hi)
+
+let emit_float32_directive directive f =
+ let x = Int32.bits_of_float (float_of_string f) in
+ emit_printf "\t%s\t0x%lx\n" directive x
+
(* Record live pointers at call points *)
type frame_descr =
diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli
index 112e276a12..4f666be736 100644
--- a/asmcomp/emitaux.mli
+++ b/asmcomp/emitaux.mli
@@ -25,6 +25,9 @@ val emit_char: char -> unit
val emit_string_literal: string -> unit
val emit_string_directive: string -> string -> unit
val emit_bytes_directive: string -> string -> unit
+val emit_float64_directive: string -> string -> unit
+val emit_float64_split_directive: string -> string -> unit
+val emit_float32_directive: string -> string -> unit
type frame_descr =
{ fd_lbl: int; (* Return address *)
diff --git a/asmcomp/hppa/emit.mlp b/asmcomp/hppa/emit.mlp
index b8880fc4fd..2c81b78925 100644
--- a/asmcomp/hppa/emit.mlp
+++ b/asmcomp/hppa/emit.mlp
@@ -299,7 +299,9 @@ let emit_float_constants () =
` .text\n`;
emit_align 8;
List.iter
- (fun (lbl, cst) -> `{emit_label lbl}: .double {emit_string cst}\n`)
+ (fun (lbl, cst) ->
+ `{emit_label lbl}:`;
+ emit_float64_split_directive ".long" cst)
!float_constants;
float_constants := []
@@ -972,9 +974,9 @@ let emit_item = function
| Cint n ->
` .long {emit_nativeint n}\n`
| Csingle f ->
- ` .float {emit_string f}\n`
+ emit_float32_directive ".long" f
| Cdouble f ->
- ` .double {emit_string f}\n`
+ emit_float64_split_directive ".long" f
| Csymbol_address s ->
use_symbol s;
` .long {emit_symbol s}\n`
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index 9f43155613..5d4802faa3 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -815,7 +815,8 @@ let rec emit_all fallthrough i =
let emit_float_constant (lbl, cst) =
` .data\n`;
- `{emit_label lbl}: .double {emit_string cst}\n`
+ `{emit_label lbl}:`;
+ emit_float64_split_directive ".long" cst
(* Emission of external symbol references (for MacOSX) *)
@@ -888,7 +889,9 @@ let fundecl fundecl =
bound_error_call := 0;
` .text\n`;
emit_align 16;
- if macosx && is_generic_function fundecl.fun_name
+ if macosx
+ && not !Clflags.output_c_object
+ && is_generic_function fundecl.fun_name
then (* PR#4690 *)
` .private_extern {emit_symbol fundecl.fun_name}\n`
else
@@ -928,9 +931,9 @@ let emit_item = function
| Cint n ->
` .long {emit_nativeint n}\n`
| Csingle f ->
- ` .float {emit_string f}\n`
+ emit_float32_directive ".long" f
| Cdouble f ->
- ` .double {emit_string f}\n`
+ emit_float64_split_directive ".long" f
| Csymbol_address s ->
` .long {emit_symbol s}\n`
| Clabel_address lbl ->
diff --git a/asmcomp/ia64/emit.mlp b/asmcomp/ia64/emit.mlp
index e59f711bc5..fb84e9e08c 100644
--- a/asmcomp/ia64/emit.mlp
+++ b/asmcomp/ia64/emit.mlp
@@ -1287,9 +1287,9 @@ let emit_item = function
| Cint n ->
` data8 {emit_nativeint n}\n`
| Csingle f ->
- ` real4 {emit_string f}\n`
+ emit_float32_directive "data4" f
| Cdouble f ->
- ` real8 {emit_string f}\n`
+ emit_float64_directive "data8" f
| Csymbol_address s ->
` data8 {emit_symbol s}#\n`
| Clabel_address lbl ->
diff --git a/asmcomp/mips/emit.mlp b/asmcomp/mips/emit.mlp
index 198f6265d7..6908ccfd48 100644
--- a/asmcomp/mips/emit.mlp
+++ b/asmcomp/mips/emit.mlp
@@ -527,10 +527,9 @@ let emit_item = function
| Cint n ->
` .word {emit_nativeint n}\n`
| Csingle f ->
- ` .float {emit_string f}\n`
+ emit_float32_directive ".word" f
| Cdouble f ->
- ` .align 0\n`; (* Prevent alignment on 8-byte boundary *)
- ` .double {emit_string f}\n`
+ emit_float64_split_directive ".word" f
| Csymbol_address s ->
` .word {emit_symbol s}\n`
| Clabel_address lbl ->
diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp
index baab697ae0..ec3abbde47 100644
--- a/asmcomp/power/emit.mlp
+++ b/asmcomp/power/emit.mlp
@@ -835,7 +835,9 @@ let fundecl fundecl =
call_gc_label := 0;
float_literals := [];
int_literals := [];
- if Config.system = "rhapsody" && is_generic_function fundecl.fun_name
+ if Config.system = "rhapsody"
+ && not !Clflags.output_c_object
+ && is_generic_function fundecl.fun_name
then (* PR#4690 *)
` .private_extern {emit_symbol fundecl.fun_name}\n`
else
@@ -871,7 +873,10 @@ let fundecl fundecl =
` .align 3\n`;
List.iter
(fun (f, lbl) ->
- `{emit_label lbl}: .double 0d{emit_string f}\n`)
+ `{emit_label lbl}:`;
+ if ppc64
+ then emit_float64_directive ".quad" f
+ else emit_float64_split_directive ".long" f)
!float_literals;
List.iter
(fun (n, lbl) ->
@@ -902,9 +907,11 @@ let emit_item = function
| Cint n ->
` {emit_string datag} {emit_nativeint n}\n`
| Csingle f ->
- ` .float 0d{emit_string f}\n`
+ emit_float32_directive ".long" f
| Cdouble f ->
- ` .double 0d{emit_string f}\n`
+ if ppc64
+ then emit_float64_directive ".quad" f
+ else emit_float64_split_directive ".long" f
| Csymbol_address s ->
` {emit_string datag} {emit_symbol s}\n`
| Clabel_address lbl ->
diff --git a/asmcomp/sparc/emit.mlp b/asmcomp/sparc/emit.mlp
index 7393d9084e..f44f813e53 100644
--- a/asmcomp/sparc/emit.mlp
+++ b/asmcomp/sparc/emit.mlp
@@ -195,7 +195,8 @@ let float_constants = ref ([] : (int * string) list)
let emit_float_constant (lbl, cst) =
rodata ();
` .align 8\n`;
- `{emit_label lbl}: .double 0r{emit_string cst}\n`
+ `{emit_label lbl}:`;
+ emit_float64_split_directive ".word" cst
(* Emission of the profiling prelude *)
let emit_profile () =
@@ -723,9 +724,9 @@ let emit_item = function
| Cint n ->
` .word {emit_nativeint n}\n`
| Csingle f ->
- ` .single 0r{emit_string f}\n`
+ emit_float32_directive ".word" f
| Cdouble f ->
- ` .double 0r{emit_string f}\n`
+ emit_float64_split_directive ".word" f
| Csymbol_address s ->
` .word {emit_symbol s}\n`
| Clabel_address lbl ->
View Lorry Controller Status