summaryrefslogtreecommitdiff
path: root/asmcomp
diff options
context:
space:
mode:
Diffstat (limited to 'asmcomp')
-rw-r--r--asmcomp/amd64/emit.mlp20
-rw-r--r--asmcomp/amd64/emit_nt.mlp2
-rw-r--r--asmcomp/arm/emit.mlp3
-rw-r--r--asmcomp/arm/selection.ml10
-rw-r--r--asmcomp/asmlink.ml8
-rw-r--r--asmcomp/hppa/reload.ml22
-rw-r--r--asmcomp/hppa/selection.ml6
-rw-r--r--asmcomp/i386/emit.mlp2
-rw-r--r--asmcomp/i386/emit_nt.mlp2
-rw-r--r--asmcomp/i386/proc_nt.ml15
10 files changed, 66 insertions, 24 deletions
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index 4f2d54d172..7b5565b497 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -197,7 +197,7 @@ let emit_call_bound_error bd =
let emit_call_bound_errors () =
List.iter emit_call_bound_error !bound_error_sites;
if !bound_error_call > 0 then
- `{emit_label !bound_error_call}: jmp {emit_symbol "caml_ml_array_bound_error"}\n`
+ `{emit_label !bound_error_call}: call {emit_symbol "caml_ml_array_bound_error"}\n`
(* Names for instructions *)
@@ -549,8 +549,22 @@ let emit_instr fallthrough i =
| Lswitch jumptbl ->
let lbl = new_label() in
if !pic_code then begin
- ` leaq {emit_label lbl}(%rip), %r11\n`;
- ` jmp *(%r11, {emit_reg i.arg.(0)}, 8)\n`
+ (* 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;
diff --git a/asmcomp/amd64/emit_nt.mlp b/asmcomp/amd64/emit_nt.mlp
index 30b046e6de..71b71157b8 100644
--- a/asmcomp/amd64/emit_nt.mlp
+++ b/asmcomp/amd64/emit_nt.mlp
@@ -217,7 +217,7 @@ let emit_call_bound_error bd =
let emit_call_bound_errors () =
List.iter emit_call_bound_error !bound_error_sites;
if !bound_error_call > 0 then
- `{emit_label !bound_error_call}: jmp caml_ml_array_bound_error\n`
+ `{emit_label !bound_error_call}: call caml_ml_array_bound_error\n`
(* Names for instructions *)
diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp
index a26aaee618..586d477bd1 100644
--- a/asmcomp/arm/emit.mlp
+++ b/asmcomp/arm/emit.mlp
@@ -648,9 +648,6 @@ let begin_assembly() =
`trap_ptr .req r11\n`;
`alloc_ptr .req r8\n`;
`alloc_limit .req r9\n`;
- `sp .req r13\n`;
- `lr .req r14\n`;
- `pc .req r15\n`;
let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
` .data\n`;
` .global {emit_symbol lbl_begin}\n`;
diff --git a/asmcomp/arm/selection.ml b/asmcomp/arm/selection.ml
index 3066d785d9..e34093acbd 100644
--- a/asmcomp/arm/selection.ml
+++ b/asmcomp/arm/selection.ml
@@ -106,7 +106,7 @@ method select_operation op args =
| _ ->
(Iextcall("__modsi3", false), args)
end
- | Ccheckbound ->
+ | Ccheckbound _ ->
begin match args with
[Cop(Clsr, [arg1; Cconst_int n]); arg2]
when n > 0 && n < 32 && not(is_intconst arg2) ->
@@ -116,15 +116,15 @@ method select_operation op args =
end
| _ -> super#select_operation op args
-(* In mul rd, rm, rs, rm and rd must be different.
+(* In mul rd, rm, rs, the registers rm and rd must be different.
We deal with this by pretending that rm is also a result of the mul
operation. *)
-method insert_op op rs rd =
+method insert_op_debug op dbg rs rd =
if op = Iintop(Imul) then begin
- self#insert (Iop op) rs [| rd.(0); rs.(0) |]; rd
+ self#insert_debug (Iop op) dbg rs [| rd.(0); rs.(0) |]; rd
end else
- super#insert_op op rs rd
+ super#insert_op_debug op dbg rs rd
end
diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml
index 6727e3226c..21cb88a6d1 100644
--- a/asmcomp/asmlink.ml
+++ b/asmcomp/asmlink.ml
@@ -229,8 +229,8 @@ let call_linker file_list startup_file output_name =
else "libasmrun" ^ ext_lib in
let runtime_lib =
try
- if !Clflags.nopervasives then ""
- else find_in_path !load_path libname
+ if !Clflags.nopervasives then None
+ else Some(find_in_path !load_path libname)
with Not_found ->
raise(Error(File_not_found libname)) in
let c_lib =
@@ -251,7 +251,7 @@ let call_linker file_list startup_file output_name =
(List.map (fun dir -> if dir = "" then "" else "-L" ^ dir)
!load_path))
(Ccomp.quote_files (List.rev !Clflags.ccobjs))
- (Filename.quote runtime_lib)
+ (Ccomp.quote_optfile runtime_lib)
c_lib
else
Printf.sprintf "%s -o %s %s %s"
@@ -271,7 +271,7 @@ let call_linker file_list startup_file output_name =
(Ccomp.quote_files (List.rev file_list))
(Ccomp.quote_files
(List.rev_map Ccomp.expand_libname !Clflags.ccobjs))
- (Filename.quote runtime_lib)
+ (Ccomp.quote_optfile runtime_lib)
c_lib
(Ccomp.make_link_options !Clflags.ccopts) in
if Ccomp.command cmd <> 0 then raise(Error Linking_error);
diff --git a/asmcomp/hppa/reload.ml b/asmcomp/hppa/reload.ml
index 57a242d707..54208fcc33 100644
--- a/asmcomp/hppa/reload.ml
+++ b/asmcomp/hppa/reload.ml
@@ -14,5 +14,25 @@
(* Reloading for the HPPA *)
+
+open Cmm
+open Arch
+open Reg
+open Mach
+open Proc
+
+class reload = object (self)
+
+inherit Reloadgen.reload_generic as super
+
+method reload_operation op arg res =
+ match op with
+ Iintop(Idiv | Imod)
+ | Iintop_imm((Idiv | Imod), _) -> (arg, res)
+ | _ -> super#reload_operation op arg res
+end
+
+
+
let fundecl f =
- (new Reloadgen.reload_generic)#fundecl f
+ (new reload)#fundecl f
diff --git a/asmcomp/hppa/selection.ml b/asmcomp/hppa/selection.ml
index 24db6cd900..6a0e9fe409 100644
--- a/asmcomp/hppa/selection.ml
+++ b/asmcomp/hppa/selection.ml
@@ -92,17 +92,17 @@ method select_operation op args =
(* Deal with register constraints *)
-method insert_op op rs rd =
+method insert_op_debug op dbg rs rd =
match op with
Iintop(Idiv | Imod) -> (* handled via calls to millicode *)
let rs' = [|phys_reg 20; phys_reg 19|] (* %r26, %r25 *)
and rd' = [|phys_reg 22|] (* %r29 *) in
self#insert_moves rs rs';
- self#insert (Iop op) rs' rd';
+ self#insert_debug (Iop op) dbg rs' rd';
self#insert_moves rd' rd;
rd
| _ ->
- super#insert_op op rs rd
+ super#insert_op_debug op dbg rs rd
end
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index b50ecff27f..c009ad6fef 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -239,7 +239,7 @@ let emit_call_bound_error bd =
let emit_call_bound_errors () =
List.iter emit_call_bound_error !bound_error_sites;
if !bound_error_call > 0 then
- `{emit_label !bound_error_call}: jmp {emit_symbol "caml_ml_array_bound_error"}\n`
+ `{emit_label !bound_error_call}: call {emit_symbol "caml_ml_array_bound_error"}\n`
(* Names for instructions *)
diff --git a/asmcomp/i386/emit_nt.mlp b/asmcomp/i386/emit_nt.mlp
index bba42fe88f..e4ac9d408d 100644
--- a/asmcomp/i386/emit_nt.mlp
+++ b/asmcomp/i386/emit_nt.mlp
@@ -206,7 +206,7 @@ let emit_call_bound_error bd =
let emit_call_bound_errors () =
List.iter emit_call_bound_error !bound_error_sites;
if !bound_error_call > 0 then
- `{emit_label !bound_error_call}: jmp _caml_ml_array_bound_error\n`
+ `{emit_label !bound_error_call}: call _caml_ml_array_bound_error\n`
(* Names for instructions *)
diff --git a/asmcomp/i386/proc_nt.ml b/asmcomp/i386/proc_nt.ml
index 554b6c55b6..4c91c9acfa 100644
--- a/asmcomp/i386/proc_nt.ml
+++ b/asmcomp/i386/proc_nt.ml
@@ -88,12 +88,23 @@ let word_addressed = false
(* Calling conventions *)
+(* To supplement the processor's meagre supply of registers, we also
+ use some global memory locations to pass arguments beyond the 6th.
+ These globals are denoted by Incoming and Outgoing stack locations
+ with negative offsets, starting at -64.
+ Unlike arguments passed on stack, arguments passed in globals
+ do not prevent tail-call elimination. The caller stores arguments
+ in these globals immediately before the call, and the first thing the
+ callee does is copy them to registers or stack locations.
+ Neither GC nor thread context switches can occur between these two
+ times. *)
+
let calling_conventions first_int last_int first_float last_float make_stack
arg =
let loc = Array.create (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
- let ofs = ref 0 in
+ let ofs = ref (-64) in
for i = 0 to Array.length arg - 1 do
match arg.(i).typ with
Int | Addr as ty ->
@@ -113,7 +124,7 @@ let calling_conventions first_int last_int first_float last_float make_stack
ofs := !ofs + size_float
end
done;
- (loc, !ofs)
+ (loc, max 0 !ofs)
let incoming ofs = Incoming ofs
let outgoing ofs = Outgoing ofs
View Lorry Controller Status