Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix backtrace for regular raise on arm64, arm 

for constant exception, a reraise was done
    instead of a raise
master
François Bobot 2016-07-28 13:46:23 +02:00
parent c3b4e9aa93
commit 7be0a81e9c
15 changed files with 40 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
asmcomp/amd64/emit.mlp
View File

@ -770,15 +770,11 @@ let emit_instr fallthrough i =
cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset - 16
| Lraise k ->
begin match !Clflags.debug, k with
| true, Lambda.Raise_regular ->
begin match k with
| Lambda.Raise_regular | Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg
| true, Lambda.Raise_reraise ->
emit_call "caml_reraise_exn";
record_frame Reg.Set.empty true i.dbg
| false, _
| true, Lambda.Raise_notrace ->
| Lambda.Raise_notrace ->
I.mov r14 rsp;
I.pop r14;
I.ret ()
@ -904,7 +900,6 @@ let begin_assembly() =
D.extrn "caml_alloc3" NEAR;
D.extrn "caml_ml_array_bound_error" NEAR;
D.extrn "caml_raise_exn" NEAR;
D.extrn "caml_reraise_exn" NEAR;
end;

7
asmcomp/arm/emit.mlp
View File

@ -791,12 +791,11 @@ let emit_instr i =
cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset - 8; 1
| Lraise k ->
begin match !Clflags.debug, k with
| true, (Lambda.Raise_regular | Lambda.Raise_reraise) ->
begin match k with
| Lambda.Raise_regular | Lambda.Raise_reraise ->
` {emit_call "caml_raise_exn"}\n`;
`{record_frame Reg.Set.empty true i.dbg}\n`; 1
| false, _
| true, Lambda.Raise_notrace ->
| Lambda.Raise_notrace ->
` mov sp, trap_ptr\n`;
` pop \{trap_ptr, pc}\n`; 2
end

7
asmcomp/arm64/emit.mlp
View File

@ -854,12 +854,11 @@ let emit_instr i =
cfi_adjust_cfa_offset (-16);
stack_offset := !stack_offset - 16
| Lraise k ->
begin match !Clflags.debug, k with
| true, (Lambda.Raise_regular | Lambda.Raise_reraise) ->
begin match k with
| Lambda.Raise_regular | Lambda.Raise_reraise ->
` bl {emit_symbol "caml_raise_exn"}\n`;
`{record_frame Reg.Set.empty true i.dbg}\n`
| false, _
| true, Lambda.Raise_notrace ->
| Lambda.Raise_notrace ->
` mov sp, {emit_reg reg_trap_ptr}\n`;
` ldr {emit_reg reg_tmp1}, [sp, #8]\n`;
` ldr {emit_reg reg_trap_ptr}, [sp], 16\n`;

27
asmcomp/cmmgen.ml
View File

@ -320,11 +320,19 @@ let validate d m p =
ucompare2 twoszp md < 0 && ucompare2 md (add2 twoszp twop1) <= 0
*)
let raise_regular dbg exc =
Csequence(
Cop(Cstore (Thirtytwo_signed, Assignment),
[(Cconst_symbol "caml_backtrace_pos"); Cconst_int 0]),
Cop(Craise (Raise_regular, dbg),[exc]))
let raise_symbol dbg symb =
raise_regular dbg (Cconst_symbol symb)
let rec div_int c1 c2 dbg =
match (c1, c2) with
(c1, Cconst_int 0) ->
Csequence(c1, Cop(Craise (Raise_regular, dbg),
[Cconst_symbol "caml_exn_Division_by_zero"]))
Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero")
| (c1, Cconst_int 1) ->
c1
| (Cconst_int 0 as c1, c2) ->
@ -367,14 +375,12 @@ let rec div_int c1 c2 dbg =
bind "divisor" c2 (fun c2 ->
Cifthenelse(c2,
Cop(Cdivi, [c1; c2]),
Cop(Craise (Raise_regular, dbg),
[Cconst_symbol "caml_exn_Division_by_zero"])))
raise_symbol dbg "caml_exn_Division_by_zero"))
let mod_int c1 c2 dbg =
match (c1, c2) with
(c1, Cconst_int 0) ->
Csequence(c1, Cop(Craise (Raise_regular, dbg),
[Cconst_symbol "caml_exn_Division_by_zero"]))
Csequence(c1, raise_symbol dbg "caml_exn_Division_by_zero")
| (c1, Cconst_int (1 | (-1))) ->
Csequence(c1, Cconst_int 0)
| (Cconst_int 0, c2) ->
@ -406,8 +412,7 @@ let mod_int c1 c2 dbg =
bind "divisor" c2 (fun c2 ->
Cifthenelse(c2,
Cop(Cmodi, [c1; c2]),
Cop(Craise (Raise_regular, dbg),
[Cconst_symbol "caml_exn_Division_by_zero"])))
raise_symbol dbg "caml_exn_Division_by_zero"))
(* Division or modulo on boxed integers. The overflow case min_int / -1
can occur, in which case we force x / -1 = -x and x mod -1 = 0. (PR#5513). *)
@ -1775,8 +1780,12 @@ and transl_prim_1 env p arg dbg =
Cop(Caddi, [transl env arg; Cconst_int (-1)])
(* always a pointer outside the heap *)
(* Exceptions *)
| Praise k ->
| Praise _ when not (!Clflags.debug) ->
Cop(Craise (Raise_notrace, dbg), [transl env arg])
| Praise ((Raise_reraise|Raise_notrace) as k) ->
Cop(Craise (k, dbg), [transl env arg])
| Praise Raise_regular ->
raise_regular dbg (transl env arg)
(* Integer operations *)
| Pnegint ->
Cop(Csubi, [Cconst_int 2; transl env arg])

11
asmcomp/i386/emit.mlp
View File

@ -875,15 +875,11 @@ let emit_instr fallthrough i =
cfi_adjust_cfa_offset (-trap_frame_size);
stack_offset := !stack_offset - trap_frame_size
| Lraise k ->
begin match !Clflags.debug, k with
| true, Lambda.Raise_regular ->
begin match k with
| Lambda.Raise_regular | Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg
| true, Lambda.Raise_reraise ->
emit_call "caml_reraise_exn";
record_frame Reg.Set.empty true i.dbg
| false, _
| true, Lambda.Raise_notrace ->
| Lambda.Raise_notrace ->
I.mov (sym32 "caml_exception_pointer") esp;
I.pop (sym32 "caml_exception_pointer");
if trap_frame_size > 8 then
@ -1031,7 +1027,6 @@ let begin_assembly() =
D.extrn "_caml_alloc3" PROC;
D.extrn "_caml_ml_array_bound_error" PROC;
D.extrn "_caml_raise_exn" PROC;
D.extrn "_caml_reraise_exn" PROC;
end;
D.data ();

11
asmcomp/power/emit.mlp
View File

@ -943,17 +943,12 @@ let emit_instr i =
` addi 1, 1, {emit_int trap_size}\n`;
adjust_stack_offset (-trap_size)
| Lraise k ->
begin match !Clflags.debug, k with
| true, Lambda.Raise_regular ->
begin match k with
| Lambda.Raise_regular | Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
record_frame Reg.Set.empty true i.dbg;
emit_call_nop()
| true, Lambda.Raise_reraise ->
emit_call "caml_reraise_exn";
record_frame Reg.Set.empty true i.dbg;
emit_call_nop()
| false, _
| true, Lambda.Raise_notrace ->
| Lambda.Raise_notrace ->
` {emit_string lg} 0, {emit_int trap_handler_offset}(29)\n`;
` mr 1, 29\n`;
` mtctr 0\n`;

11
asmcomp/s390x/emit.mlp
View File

@ -612,17 +612,12 @@ let emit_instr i =
emit_stack_adjust (-16);
stack_offset := !stack_offset - 16
| Lraise k ->
begin match !Clflags.debug, k with
| true, Lambda.Raise_regular ->
begin match k with
| Lambda.Raise_regular | Lambda.Raise_reraise ->
` brasl %r14, {emit_symbol "caml_raise_exn"}\n`;
let lbl = record_frame Reg.Set.empty true i.dbg in
`{emit_label lbl}:\n`
| true, Lambda.Raise_reraise ->
` brasl %r14, {emit_symbol "caml_reraise_exn"}\n`;
let lbl = record_frame Reg.Set.empty true i.dbg in
`{emit_label lbl}:\n`
| false, _
| true, Lambda.Raise_notrace ->
| Lambda.Raise_notrace ->
` lg %r1, 0(%r13)\n`;
` lgr %r15, %r13\n`;
` lg %r13, {emit_int size_addr}(%r15)\n`;

11
asmrun/amd64.S
View File

@ -545,8 +545,6 @@ CFI_STARTPROC
popq %r14
ret
LBL(110):
STORE_VAR32($0, caml_backtrace_pos)
LBL(111):
movq %rax, %r12 /* Save exception bucket */
movq %rax, C_ARG_1 /* arg 1: exception bucket */
#ifdef WITH_FRAME_POINTERS
@ -568,15 +566,6 @@ LBL(111):
ret
CFI_ENDPROC
FUNCTION(G(caml_reraise_exn))
CFI_STARTPROC
TESTL_VAR($1, caml_backtrace_active)
jne LBL(111)
movq %r14, %rsp
popq %r14
ret
CFI_ENDPROC
/* Raise an exception from C */
FUNCTION(G(caml_raise_exception))

11
asmrun/amd64nt.asm
View File

@ -309,8 +309,6 @@ caml_raise_exn:
pop r14 ; Recover previous exception handler
ret ; Branch to handler
L110:
mov caml_backtrace_pos, 0
L111:
mov r12, rax ; Save exception bucket in r12
mov rcx, rax ; Arg 1: exception bucket
mov rdx, [rsp] ; Arg 2: PC of raise
@ -323,15 +321,6 @@ L111:
pop r14 ; Recover previous exception handler
ret ; Branch to handler
PUBLIC caml_reraise_exn
ALIGN 16
caml_reraise_exn:
test caml_backtrace_active, 1
jne L111
mov rsp, r14 ; Cut stack
pop r14 ; Recover previous exception handler
ret ; Branch to handler
; Raise an exception from C
PUBLIC caml_raise_exception

12
asmrun/i386.S
View File

@ -334,8 +334,6 @@ FUNCTION(caml_raise_exn)
UNDO_ALIGN_STACK(8)
ret
LBL(110):
movl $0, G(caml_backtrace_pos)
LBL(111):
movl %eax, %esi /* Save exception bucket in esi */
movl G(caml_exception_pointer), %edi /* SP of handler */
movl 0(%esp), %eax /* PC of raise */
@ -353,16 +351,6 @@ LBL(111):
ret
CFI_ENDPROC
FUNCTION(caml_reraise_exn)
CFI_STARTPROC
testl $1, G(caml_backtrace_active)
jne LBL(111)
movl G(caml_exception_pointer), %esp
popl G(caml_exception_pointer); CFI_ADJUST(-4)
UNDO_ALIGN_STACK(8)
ret
CFI_ENDPROC
/* Raise an exception from C */
FUNCTION(caml_raise_exception)

11
asmrun/i386nt.asm
View File

@ -224,16 +224,7 @@ L111:
pop _caml_exception_pointer
ret
PUBLIC _caml_reraise_exn
ALIGN 4
_caml_reraise_exn:
test _caml_backtrace_active, 1
jne L111
mov esp, _caml_exception_pointer
pop _caml_exception_pointer
ret
; Raise an exception from C
; Raise an exception from C
PUBLIC _caml_raise_exception
ALIGN 4

17
asmrun/power.S
View File

@ -380,9 +380,6 @@ FUNCTION(caml_raise_exn)
/* Branch to handler */
bctr
.L111:
li 0, 0
Storeglobal32(0, caml_backtrace_pos, 11)
.L112:
mr 28, 3 /* preserve exn bucket in callee-save reg */
/* arg1: exception bucket, already in r3 */
mflr 4 /* arg2: PC of raise */
@ -398,20 +395,6 @@ FUNCTION(caml_raise_exn)
b .L110 /* raise the exn */
ENDFUNCTION(caml_raise_exn)
FUNCTION(caml_reraise_exn)
Loadglobal32(0, caml_backtrace_active, 11)
cmpwi 0, 0
bne- .L112
/* Pop trap frame */
lg 0, TRAP_HANDLER_OFFSET(29)
mr 1, 29
mtctr 0
lg 29, TRAP_PREVIOUS_OFFSET(1)
addi 1, 1, TRAP_SIZE
/* Branch to handler */
bctr
ENDFUNCTION(caml_reraise_exn)
/* Raise an exception from C */
FUNCTION(caml_raise_exception)

17
asmrun/s390x.S
View File

@ -145,9 +145,6 @@ caml_raise_exn:
/* Branch to handler */
br %r1
.L110:
lgfi %r0, 0
Storeglobal32(%r0, caml_backtrace_pos)
.L114:
ldgr %f15, %r2 /* preserve exn bucket in callee-save reg */
/* arg1: exception bucket, already in r3 */
lgr %r3,%r14 /* arg2: PC of raise */
@ -159,20 +156,6 @@ caml_raise_exn:
lgdr %r2,%f15 /* restore exn bucket */
j .L111 /* raise the exn */
.globl caml_reraise_exn
.type caml_reraise_exn, @function
caml_reraise_exn:
Loadglobal32(%r0, caml_backtrace_active)
cgfi %r0, 0
jne .L114
/* Pop trap frame */
lg %r1, 0(%r13)
lgr %r15, %r13
lg %r13, 8(%r13)
agfi %r15, 16
/* Branch to handler */
br %r1;
/* Raise an exception from C */
.globl caml_raise_exception

4
byterun/backtrace.c
View File

@ -30,8 +30,8 @@
/* The table of debug information fragments */
struct ext_table caml_debug_info;
CAMLexport int caml_backtrace_active = 0;
CAMLexport int caml_backtrace_pos = 0;
CAMLexport int32_t caml_backtrace_active = 0;
CAMLexport int32_t caml_backtrace_pos = 0;
CAMLexport backtrace_slot * caml_backtrace_buffer = NULL;
CAMLexport value caml_backtrace_last_exn = Val_unit;

2
testsuite/tests/asmcomp/soli.cmm
View File

@ -66,7 +66,7 @@
(intaset (addraref "board" i1) j1 1)
(intaset (addraref "board" i2) j2 2)
(if (app "solve" (+ m 1) int)
(raise 0a)
(raise_notrace 0a)
[])
(intaset (addraref "board" i) j 2)
(intaset (addraref "board" i1) j1 2)