Import code from exceptions backend branch

asmcomp/amd64/emit.mlp

@@ -865,6 +865,8 @@ let emit_instr fallthrough i =
                          ConstLabel lbl))
       done;
       D.text ()
+  | Lentertrap ->
+      ()
   | Lpushtrap {lbl_handler} ->
       let load_label_addr s arg =
        (* CR mshinwell: this needs more testing *)
@@ -897,7 +899,8 @@ let emit_instr fallthrough i =
       | Cmm.Raise_notrace ->
           I.mov r14 rsp;
           I.pop r14;
-          I.ret ()
+          I.pop r11;
+          I.jmp r11
       end
 
 let rec emit_all fallthrough i =

asmcomp/arm/emit.mlp

@@ -282,6 +282,8 @@ let float_literals = ref ([] : (int64 * label) list)
 let gotrel_literals = ref ([] : (label * label) list)
 (* Pending symbol literals *)
 let symbol_literals = ref ([] : (string * label) list)
+(* Pending offset computations : (lbl, dst, src) --> lbl: .word dst-(src+N) *)
+let offset_literals = ref ([] : (label * label * label) list)
 (* Total space (in words) occupied by pending literals *)
 let size_literals = ref 0
 
@@ -312,6 +314,13 @@ let symbol_literal s =
     symbol_literals := (s, lbl) :: !symbol_literals;
     lbl
 
+(* Add an offset computation *)
+let offset_literal dst src =
+  let lbl = new_label() in
+  size_literals := !size_literals + 1;
+  offset_literals := (lbl, dst, src) :: !offset_literals;
+  lbl
+
 (* Emit all pending literals *)
 let emit_literals() =
   if !float_literals <> [] then begin
@@ -337,6 +346,17 @@ let emit_literals() =
     gotrel_literals := [];
     symbol_literals := []
   end;
+  if !offset_literals <> [] then begin
+    (* Additions using the pc register read a value 4 or 8 bytes greater than
+       the instruction's address, depending on the thumb setting *)
+    let offset = if !thumb then 4 else 8 in
+    `	.align	2\n`;
+    List.iter
+      (fun (lbl, dst, src) ->
+         `{emit_label lbl}:	.word	{emit_label dst}-({emit_label src}+{emit_int offset})\n`)
+      !offset_literals;
+    offset_literals := []
+  end;
   size_literals := 0
 
 (* Emit code to load the address of a symbol *)
@@ -406,6 +426,17 @@ let emit_profile() =
       2
   | _ -> 0
 
+
+(* Emit code to load the address of a label in the lr register *)
+let emit_load_handler_address handler =
+  (* PIC code *)
+  let lbl_src = new_label() in
+  let lbl_offset = offset_literal handler lbl_src in
+  `	ldr	lr, {emit_label lbl_offset}\n`;
+  `{emit_label lbl_src}:\n`;
+  `	add	lr, pc, lr\n`;
+  2
+
 (* Output the assembly code for an instruction *)
 
 let emit_instr i =
@@ -838,13 +869,14 @@ let emit_instr i =
           done;
           2 + Array.length jumptbl
         end
-    | Lsetuptrap lbl ->
-        `	bl	{emit_label lbl}\n`; 1
-    | Lpushtrap ->
+    | Lentertrap ->
+        0
+    | Lpushtrap { lbl_handler; } ->
+        let s = emit_load_handler_address lbl_handler in
         stack_offset := !stack_offset + 8;
         `	push	\{trap_ptr, lr}\n`;
         cfi_adjust_cfa_offset 8;
-        `	mov	trap_ptr, sp\n`; 2
+        `	mov	trap_ptr, sp\n`; s + 2
     | Lpoptrap ->
         `	pop	\{trap_ptr, lr}\n`;
         cfi_adjust_cfa_offset (-8);

asmcomp/arm64/emit.mlp

@@ -494,8 +494,8 @@ module BR = Branch_relaxation.Make (struct
         + begin match lbl1 with None -> 0 | Some _ -> 1 end
         + begin match lbl2 with None -> 0 | Some _ -> 1 end
     | Lswitch jumptbl -> 3 + Array.length jumptbl
-    | Lsetuptrap _ -> 2
-    | Lpushtrap -> 3
+    | Lentertrap -> 0
+    | Lpushtrap _ -> 4
     | Lpoptrap -> 1
     | Lraise k ->
       begin match k with
@@ -873,12 +873,10 @@ let emit_instr i =
             `	.word	{emit_label jumptbl.(j)} - {emit_label lbltbl}\n`
         done
 *)
-    | Lsetuptrap lbl ->
-        let lblnext = new_label() in
-        `	adr	{emit_reg reg_tmp1}, {emit_label lblnext}\n`;
-        `	b	{emit_label lbl}\n`;
-        `{emit_label lblnext}:\n`
-    | Lpushtrap ->
+    | Lentertrap ->
+        ()
+    | Lpushtrap { lbl_handler; } ->
+        `	adr	{emit_reg reg_tmp1}, {emit_label lbl_handler}\n`;
         stack_offset := !stack_offset + 16;
         `	str	{emit_reg reg_trap_ptr}, [sp, -16]!\n`;
         `	str	{emit_reg reg_tmp1}, [sp, #8]\n`;

asmcomp/i386/emit.mlp

@@ -880,9 +880,10 @@ let emit_instr fallthrough i =
         D.long (ConstLabel (emit_label jumptbl.(i)))
       done;
       D.text ()
-  | Lsetuptrap lbl ->
-      I.call (label lbl)
-  | Lpushtrap ->
+  | Lentertrap ->
+      ()
+  | Lpushtrap { lbl_handler; } ->
+      I.push (label lbl_handler);
       if trap_frame_size > 8 then
         I.sub (int (trap_frame_size - 8)) esp;
       I.push (sym32 "caml_exception_pointer");
@@ -904,7 +905,8 @@ let emit_instr fallthrough i =
           I.pop (sym32 "caml_exception_pointer");
           if trap_frame_size > 8 then
             I.add (int (trap_frame_size - 8)) esp;
-          I.ret ()
+          I.pop ebx;
+          I.jmp ebx
       end
 
 let rec emit_all fallthrough i =

asmcomp/linearize.ml

@@ -39,6 +39,7 @@ and instruction_desc =
   | Lcondbranch of test * label
   | Lcondbranch3 of label option * label option * label option
   | Lswitch of label array
+  | Lentertrap
   | Lpushtrap of {lbl_handler:label}
   | Lpoptrap
   | Lraise of Cmm.raise_kind
@@ -298,7 +299,9 @@ let rec linear i n =
       loop (add_branch lbl n1) !try_depth
   | Itrywith(body, handler) ->
       let (lbl_join, n1) = get_label (linear i.Mach.next n) in
-      let (lbl_handler, n2) = get_label (linear handler n1) in
+      let (lbl_handler, n2) =
+        get_label (cons_instr Lentertrap (linear handler n1))
+      in
       incr try_depth;
       assert (i.Mach.arg = [| |] || Config.spacetime);
       let n3 = cons_instr (Lpushtrap { lbl_handler })

asmcomp/linearize.mli

@@ -36,6 +36,7 @@ and instruction_desc =
   | Lcondbranch of Mach.test * label
   | Lcondbranch3 of label option * label option * label option
   | Lswitch of label array
+  | Lentertrap
   | Lpushtrap of {lbl_handler:label}
   | Lpoptrap
   | Lraise of Cmm.raise_kind

asmcomp/power/emit.mlp

@@ -502,8 +502,8 @@ module BR = Branch_relaxation.Make (struct
         + (if lbl1 = None then 0 else 1)
         + (if lbl2 = None then 0 else 1)
     | Lswitch _ -> size 7 (5 + tocload_size()) (5 + tocload_size())
-    | Lsetuptrap _ -> size 1 2 2
-    | Lpushtrap -> size 4 5 5
+    | Lentertrap -> size 0 (tocload_size()) (tocload_size())
+    | Lpushtrap _ -> size 5 (4 + tocload_size()) (4 + tocload_size())
     | Lpoptrap -> 2
     | Lraise _ -> 6
 
@@ -975,24 +975,24 @@ let emit_instr i =
           done;
           emit_string code_space
         end
-    | Lsetuptrap lbl ->
-        `	bl	{emit_label lbl}\n`;
+    | Lentertrap ->
         begin match abi with
         | ELF32 -> ()
         | ELF64v1 | ELF64v2 -> emit_reload_toc()
         end
-    | Lpushtrap ->
+    | Lpushtrap { lbl_handler; } ->
         begin match abi with
         | ELF32 ->
-          `	mflr	0\n`;
-          `	stwu    0, -16(1)\n`;
+          `	addis	11, 0, {emit_upper emit_label lbl_handler}\n`;
+          `	addi	11, 11, {emit_lower emit_label lbl_handler}\n`;
+          `	stwu    11, -16(1)\n`;
           adjust_stack_offset 16;
           `	stw	29, 4(1)\n`;
           `	mr	29, 1\n`
         | ELF64v1 | ELF64v2 ->
-          `	mflr	0\n`;
-          `	addi	1, 1, -32\n`;
-          adjust_stack_offset 32;
+          `	addi	1, 1, {emit_int (-trap_size)}\n`;
+          adjust_stack_offset trap_size;
+          emit_tocload emit_gpr 0 (TocLabel lbl_handler);
           `	std     0, {emit_int trap_handler_offset}(1)\n`;
           `	std	29, {emit_int trap_previous_offset}(1)\n`;
           `	mr	29, 1\n`

asmcomp/printlinear.ml

@@ -59,6 +59,8 @@ let instr ppf i =
        fprintf ppf "case %i: goto %a" i label lblv.(i)
       done;
       fprintf ppf "@,endswitch"
+  | Lentertrap ->
+      fprintf ppf "enter trap"
   | Lpushtrap { lbl_handler } ->
       fprintf ppf "push trap %a" label lbl_handler
   | Lpoptrap ->

asmcomp/s390x/emit.mlp

@@ -608,11 +608,12 @@ let emit_instr i =
           `	.long	{emit_label jumptbl.(i)} - {emit_label lbl}\n`
         done;
         emit_string code_space
-    | Lsetuptrap lbl ->
-        `	brasl	%r14, {emit_label lbl}\n`;
-    | Lpushtrap ->
+    | Lentertrap ->
+        ()
+    | Lpushtrap { lbl_handler; } ->
         stack_offset := !stack_offset + 16;
         emit_stack_adjust 16;
+        `	larl	%r14, {emit_label lbl_handler}\n`;
         `	stg	%r14, 0(%r15)\n`;
         `	stg	%r13, {emit_int size_addr}(%r15)\n`;
         `	lgr	%r13, %r15\n`