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

Merge pull request #408 from btj/trunk 

Fixes bugs in stack unwinding metadata (PR#7118,7120)
master
Damien Doligez 2016-02-12 11:20:02 +01:00
parent 21dce60dbd b16d0126da
commit 59a4fd6615
9 changed files with 159 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Changes
View File

@ -17,6 +17,9 @@ Language features:
- PR#6714: allow [@@ocaml.warning] on most structure and signature items:
values, modules, module types
(whitequark)
- PR#7118, PR#7120: Bug fixed in stack unwinding metadata generation.
Was a cause of crashes in GUI programs on OS X.
(Bart Jacobs)
- GPR#26: support for "(type a b)" as syntactic sugar for "(type a) (type b)"
(Gabriel Scherer)
- GPR#42: short functor type syntax: "S -> T" for "functor (_ : S) -> T"

7
asmcomp/amd64/emit.mlp
View File

@ -840,6 +840,13 @@ let fundecl fundecl =
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
if frame_required() then begin
let n = frame_size() - 8 - (if fp then 8 else 0) in
if n <> 0
then begin
cfi_adjust_cfa_offset (-n);
end;
end;
cfi_endproc ();
begin match system with
| S_gnu | S_linux ->

63
asmrun/amd64.S
View File

@ -67,10 +67,14 @@
#define CFI_STARTPROC .cfi_startproc
#define CFI_ENDPROC .cfi_endproc
#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
#define CFI_OFFSET(r, n) .cfi_offset r, n
#define CFI_SAME_VALUE(r) .cfi_same_value r
#else
#define CFI_STARTPROC
#define CFI_ENDPROC
#define CFI_ADJUST(n)
#define CFI_OFFSET(r, n)
#define CFI_SAME_VALUE(r)
#endif
#ifdef WITH_FRAME_POINTERS
@ -184,14 +188,14 @@
/* Win64 API: callee-save regs are rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 */
#define PUSH_CALLEE_SAVE_REGS \
pushq %rbx; CFI_ADJUST (8); \
pushq %rbp; CFI_ADJUST (8); \
pushq %rsi; CFI_ADJUST (8); \
pushq %rdi; CFI_ADJUST (8); \
pushq %r12; CFI_ADJUST (8); \
pushq %r13; CFI_ADJUST (8); \
pushq %r14; CFI_ADJUST (8); \
pushq %r15; CFI_ADJUST (8); \
pushq %rbx; CFI_ADJUST (8); CFI_OFFSET(rbx, -16); \
pushq %rbp; CFI_ADJUST (8); CFI_OFFSET(rbp, -24); /* Allows debugger to walk the stack */ \
pushq %rsi; CFI_ADJUST (8); CFI_OFFSET(rsi, -32); \
pushq %rdi; CFI_ADJUST (8); CFI_OFFSET(rdi, -40); \
pushq %r12; CFI_ADJUST (8); CFI_OFFSET(r12, -48); \
pushq %r13; CFI_ADJUST (8); CFI_OFFSET(r13, -56); \
pushq %r14; CFI_ADJUST (8); CFI_OFFSET(r14, -64); \
pushq %r15; CFI_ADJUST (8); CFI_OFFSET(r15, -72); \
subq $(8+10*16), %rsp; CFI_ADJUST (8+10*16); \
movupd %xmm6, 0*16(%rsp); \
movupd %xmm7, 1*16(%rsp); \
@ -216,36 +220,36 @@
movupd 8*16(%rsp), %xmm14; \
movupd 9*16(%rsp), %xmm15; \
addq $(8+10*16), %rsp; CFI_ADJUST (-8-10*16); \
popq %r15; CFI_ADJUST(-8); \
popq %r14; CFI_ADJUST(-8); \
popq %r13; CFI_ADJUST(-8); \
popq %r12; CFI_ADJUST(-8); \
popq %rdi; CFI_ADJUST(-8); \
popq %rsi; CFI_ADJUST(-8); \
popq %rbp; CFI_ADJUST(-8); \
popq %rbx; CFI_ADJUST(-8)
popq %r15; CFI_ADJUST(-8); CFI_SAME_VALUE(r15); \
popq %r14; CFI_ADJUST(-8); CFI_SAME_VALUE(r14); \
popq %r13; CFI_ADJUST(-8); CFI_SAME_VALUE(r13); \
popq %r12; CFI_ADJUST(-8); CFI_SAME_VALUE(r12); \
popq %rdi; CFI_ADJUST(-8); CFI_SAME_VALUE(rdi); \
popq %rsi; CFI_ADJUST(-8); CFI_SAME_VALUE(rsi); \
popq %rbp; CFI_ADJUST(-8); CFI_SAME_VALUE(rbp); \
popq %rbx; CFI_ADJUST(-8); CFI_SAME_VALUE(rbx)
#else
/* Unix API: callee-save regs are rbx, rbp, r12-r15 */
#define PUSH_CALLEE_SAVE_REGS \
pushq %rbx; CFI_ADJUST(8); \
pushq %rbp; CFI_ADJUST(8); \
pushq %r12; CFI_ADJUST(8); \
pushq %r13; CFI_ADJUST(8); \
pushq %r14; CFI_ADJUST(8); \
pushq %r15; CFI_ADJUST(8); \
pushq %rbx; CFI_ADJUST(8); CFI_OFFSET(rbx, -16); \
pushq %rbp; CFI_ADJUST(8); CFI_OFFSET(rbp, -24); \
pushq %r12; CFI_ADJUST(8); CFI_OFFSET(r12, -32); \
pushq %r13; CFI_ADJUST(8); CFI_OFFSET(r13, -40); \
pushq %r14; CFI_ADJUST(8); CFI_OFFSET(r14, -48); \
pushq %r15; CFI_ADJUST(8); CFI_OFFSET(r15, -56); \
subq $8, %rsp; CFI_ADJUST(8)
#define POP_CALLEE_SAVE_REGS \
addq $8, %rsp; CFI_ADJUST(-8); \
popq %r15; CFI_ADJUST(-8); \
popq %r14; CFI_ADJUST(-8); \
popq %r13; CFI_ADJUST(-8); \
popq %r12; CFI_ADJUST(-8); \
popq %rbp; CFI_ADJUST(-8); \
popq %rbx; CFI_ADJUST(-8);
popq %r15; CFI_ADJUST(-8); CFI_SAME_VALUE(r15); \
popq %r14; CFI_ADJUST(-8); CFI_SAME_VALUE(r14); \
popq %r13; CFI_ADJUST(-8); CFI_SAME_VALUE(r13); \
popq %r12; CFI_ADJUST(-8); CFI_SAME_VALUE(r12); \
popq %rbp; CFI_ADJUST(-8); CFI_SAME_VALUE(rbp); \
popq %rbx; CFI_ADJUST(-8); CFI_SAME_VALUE(rbx)
#endif
@ -425,6 +429,7 @@ LBL(caml_allocN):
addq $8, %rsp; CFI_ADJUST (-8) /* drop desired size */
ret
LBL(103):
CFI_ADJUST(8)
RECORD_STACK_FRAME(8)
#ifdef WITH_FRAME_POINTERS
/* Do we need 16-byte alignment here ? */
@ -486,7 +491,6 @@ LBL(caml_start_program):
lea LBL(108)(%rip), %r13
pushq %r13; CFI_ADJUST(8)
pushq %r14; CFI_ADJUST(8)
CFI_ADJUST(16)
movq %rsp, %r14
/* Call the OCaml code */
call *%r12
@ -494,7 +498,6 @@ LBL(107):
/* Pop the exception handler */
popq %r14; CFI_ADJUST(-8)
popq %r12; CFI_ADJUST(-8) /* dummy register */
CFI_ADJUST(-16)
LBL(109):
/* Update alloc ptr and exception ptr */
STORE_VAR(%r15,caml_young_ptr)

23
testsuite/tests/unwind/Makefile Normal file
View File

@ -0,0 +1,23 @@
default:
@printf " ... testing 'unwind_test':"
@if [ $(SYSTEM) = macosx ] && ! $(BYTECODE_ONLY); then \
$(MAKE) native_macosx_tests; \
else \
echo " => skipped"; \
fi
native_macosx_tests:
@$(MAKE) clean ; $(MAKE) unwind_test && \
./unwind_test >/dev/null 2>&1 && echo " => passed" || echo " => failed"
unwind_test:
@$(OCAMLOPT) -c -opaque mylib.mli
@$(OCAMLOPT) -c driver.ml
@$(OCAMLOPT) -c mylib.ml
@$(OCAMLOPT) -c stack_walker.c
@$(OCAMLOPT) -cclib -Wl,-keep_dwarf_unwind -o unwind_test mylib.cmx driver.cmx stack_walker.o
clean:
@rm -f *.cm* *.o unwind_test
include $(BASEDIR)/makefiles/Makefile.common

9
testsuite/tests/unwind/README Normal file
View File

@ -0,0 +1,9 @@
This test case is motivated by the fact that on OS X, external functions may
cause stack walks into the OCaml-generated stack frames. In particular, the
Objective-C runtime does so in function objc_addExceptionHandler. This function
is invoked from Cocoa. Errors in the stack unwinding info generated by OCaml
can cause random crashes. This test case checks that, for at least one OCaml
program, correct unwind info is generated such that the platform's unwinder
(called libunwind) correctly walks the stack up to the main function. OCaml
used to generate incorrect stack unwinding information for this program. See
PR#7118, PR#7120.

3
testsuite/tests/unwind/driver.ml Normal file
View File

@ -0,0 +1,3 @@
let () =
Mylib.foo1 Mylib.bar 1 2 3 4 5 6 7 8 9 10;
Mylib.foo2 Mylib.baz 1 2 3 4 5 6 7 8 9 10

18
testsuite/tests/unwind/mylib.ml Normal file
View File

@ -0,0 +1,18 @@
let foo1 f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 =
f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10
let foo2 f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 =
f x1 x2 x3 x4 x5 x6 x7 x8 x9 x10
external func_with_10_params: int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit = "ml_func_with_10_params_bytecode" "ml_func_with_10_params_native"
let bar x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 =
func_with_10_params x1 x2 x3 x4 x5 x6 x7 x8 x9 x10;
func_with_10_params x1 x2 x3 x4 x5 x6 x7 x8 x9 x10
external perform_stack_walk: unit -> unit = "ml_perform_stack_walk"
let baz x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 =
func_with_10_params x1 x2 x3 x4 x5 x6 x7 x8 x9 x10;
func_with_10_params x1 x2 x3 x4 x5 x6 x7 x8 x9 x10;
perform_stack_walk ()

6
testsuite/tests/unwind/mylib.mli Normal file
View File

@ -0,0 +1,6 @@
val foo1: ('a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit) -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit
val foo2: ('a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit) -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> 'a -> unit
val bar: int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit
val baz: int -> int -> int -> int -> int -> int -> int -> int -> int -> int -> unit

57
testsuite/tests/unwind/stack_walker.c Normal file
View File

@ -0,0 +1,57 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <caml/callback.h>
#include <caml/mlvalues.h>
#include <libunwind.h>
value ml_func_with_10_params_native(value x1, value x2, value x3, value x4, value x5,
value x6, value x7, value x8, value x9, value x10) {
return Val_unit;
}
void error() {
exit(1);
}
void perform_stack_walk() {
unw_context_t ctxt;
unw_getcontext(&ctxt);
unw_cursor_t cursor;
{
int result = unw_init_local(&cursor, &ctxt);
if (result != 0) error();
}
int reached_main = 0;
for (;;) {
{
char procname[256];
unw_word_t ip_offset; // IP - start_of_proc
int result = unw_get_proc_name(&cursor, procname, sizeof(procname), &ip_offset);
if (result != 0) error();
if (strcmp(procname, "main") == 0)
reached_main = 1;
//printf("%s + %lld\n", procname, (long long int)ip_offset);
}
{
int result = unw_step(&cursor);
if (result == 0) break;
if (result < 0) error();
}
}
//printf("Reached end of stack.\n");
if (!reached_main) {
//printf("Failure: Did not reach main.\n");
error();
}
}
value ml_perform_stack_walk() {
perform_stack_walk();
return Val_unit;
}