| Anonymous | Login | Signup for a new account | 2018-11-19 10:37 CET |  |
| Main | My View | View Issues | Change Log | Roadmap |
| View Issue Details [ Jump to Notes ] | [ Issue History ] [ Print ] | |||||||
| ID | Project | Category | View Status | Date Submitted | Last Update | |||
| 0005314 | OCaml | ~DO NOT USE (was: OCaml general) | public | 2011-07-10 13:01 | 2013-08-31 12:48 | |||
| Reporter | ygrek | |||||||
| Assigned To | shinwell | |||||||
| Priority | normal | Severity | feature | Reproducibility | always | |||
| Status | closed | Resolution | fixed | |||||
| Platform | OS | OS Version | ||||||
| Product Version | 3.12.0 | |||||||
| Target Version | Fixed in Version | 3.13.0+dev | ||||||
| Summary | 0005314: add CFI directives for reliable stack unwinding | |||||||
| Description | Currently in many cases stack of ocaml programs cannot be unwinded because there is no usual frame pointer and generic debuggers and profilers (e.g. gdb,oprofile) are often confused. But using DWARF2 CFI directives it is possible to add static information for frame address calculation. These directives are understood by GNU assembler and stored in .debug_frame or .eh_frame sections, which can be later used by debugging tools. Patch attached for x86 and amd64 code emitters. Here are some examples : $ cat test.ml let really_crash () = print_endline (Obj.magic 0 : string); print_endline "oops" let rec crash_here1 = function | 0 -> really_crash (); 0 | n -> crash_here2 (n - 1) + 1 and crash_here2 = function | 0 -> (try really_crash (); 0 with _ -> 0) | n -> crash_here1 (n - 1) + 1 let () = let n = crash_here1 5 in exit n On x86 - original ocaml 3.12.1 : $ /opt/ocaml-3.12.1/bin/ocamlopt.opt -g -inline 0 -S test.ml -o test $ gdb -batch -ex 'set pagination 0' -ex 'set interactive-mode off' -ex 'r' -ex 'bt' -ex 'q' --args ./test Program received signal SIGSEGV, Segmentation fault. 0x0804a370 in camlPervasives__output_string_1191 () #0 0x0804a370 in camlPervasives__output_string_1191 () #1 0x0804a76c in camlPervasives__print_endline_1274 () #2 0x08049a3a in camlTest__really_crash_1030 () 0000003 0x08049a96 in camlTest__crash_here2_1032 () 0000004 0xbffff1c8 in ?? () 0000005 0x0804aebc in main () After the patch : $ /opt/ocaml-3.12.1-cfi/bin/ocamlopt.opt -g -inline 0 -S test.ml -o test $ gdb -batch -ex 'set pagination 0' -ex 'set interactive-mode off' -ex 'r' -ex 'bt' -ex 'q' --args ./test Program received signal SIGSEGV, Segmentation fault. 0x0804a370 in camlPervasives__output_string_1191 () #0 0x0804a370 in camlPervasives__output_string_1191 () #1 0x0804a76c in camlPervasives__print_endline_1274 () #2 0x08049a3a in camlTest__really_crash_1030 () 0000003 0x08049a96 in camlTest__crash_here2_1032 () 0000004 0x08049abd in camlTest__crash_here1_1031 () 0000005 0x08049a5d in camlTest__crash_here2_1032 () 0000006 0x08049abd in camlTest__crash_here1_1031 () 0000007 0x08049a5d in camlTest__crash_here2_1032 () 0000008 0x08049abd in camlTest__crash_here1_1031 () 0000009 0x08049b06 in camlTest__entry () 0000010 0x08049791 in caml_program () 0000011 0x08057a72 in caml_start_program () 0000012 0x00000000 in ?? () On amd64 situation is better (stack seems to be always fully unwinded), but frames are still not detected correctly and backtrace contains some garbage : $ cat test.ml let func2 x = if x * x mod 111 = 0 then raise Not_found let func1 x y = for i = x to y do try func2 i with exn -> print_endline "exn" done let () = func1 100 200 $ /opt/ocaml-3.12.1/bin/ocamlopt.opt -g -inline 0 -S test.ml -o test $ gdb -batch -ex 'set interactive-mode off' -ex 'b camlTest__func2_1030' -ex 'r' -ex 'bt' -ex 'kill' -ex 'q' --args ./test Breakpoint 1 at 0x403550 Breakpoint 1, 0x0000000000403550 in camlTest__func2_1030 () #0 0x0000000000403550 in camlTest__func2_1030 () #1 0x00000000004035f2 in camlTest__func1_1032 () #2 0x00007fffffffe570 in ?? () 0000003 0x00000000004035d7 in camlTest__func1_1032 () 0000004 0x00000000000000c9 in ?? () 0000005 0x0000000000000191 in ?? () 0000006 0x0000000000411b75 in caml_start_program () 0000007 0x000000000040365a in camlTest__entry () 0000008 0x00000000000003e8 in ?? () 0000009 0x0000000000403219 in caml_program () 0000010 0x0000000000029011 in ?? () 0000011 0x0000000000411b3e in caml_start_program () 0000012 0x0000000000000000 in ?? () After the patch : $ /opt/ocaml-3.12.1-cfi/bin/ocamlopt.opt -g -inline 0 -S test.ml -o test $ gdb -batch -ex 'set interactive-mode off' -ex 'b camlTest__func2_1030' -ex 'r' -ex 'bt' -ex 'kill' -ex 'q' --args ./test Breakpoint 1 at 0x403550 Breakpoint 1, 0x0000000000403550 in camlTest__func2_1030 () #0 0x0000000000403550 in camlTest__func2_1030 () #1 0x00000000004035f2 in camlTest__func1_1032 () #2 0x000000000040365a in camlTest__entry () 0000003 0x0000000000403219 in caml_program () 0000004 0x0000000000411b3e in caml_start_program () 0000005 0x0000000000000000 in ?? () | |||||||
| Additional Information | BTW, looking at asmcomp/i386/emit.mlp I am a bit puzzled : line 650, in branch Lop(Iintoffloat) : stack is growing, but stack_offset is decremented - is this correct? (I couldn't trigger storing the result to stack so maybe it doesn't matter in practice). | |||||||
| Tags | No tags attached. | |||||||
| Attached Files |  ocaml-3.12.1-cfi.patch [^] (8,492 bytes) 2011-07-10 13:01 [Show Content] [Hide Content]From ceb5edef45715343a36082e1a286868617e97af6 Mon Sep 17 00:00:00 2001
From: ygrek <ygrek@autistici.org>
Date: Sat, 9 Jul 2011 17:51:12 +0300
Subject: [PATCH 1/2] emit CFI directives (amd64)
---
asmcomp/amd64/emit.mlp | 12 ++++++++++--
asmcomp/emitaux.ml | 22 ++++++++++++++++++++++
asmcomp/emitaux.mli | 4 ++++
3 files changed, 36 insertions(+), 2 deletions(-)
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index 94e9cb2..afeb6a5 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -320,7 +320,8 @@ let emit_float_test cmp neg arg lbl =
let output_epilogue () =
if frame_required() then begin
let n = frame_size() - 8 in
- ` addq ${emit_int n}, %rsp\n`
+ ` addq ${emit_int n}, %rsp\n`;
+ cfi_adjust_cfa_offset (-n);
end
(* Output the assembly code for an instruction *)
@@ -394,6 +395,7 @@ let emit_instr fallthrough i =
if n < 0
then ` addq ${emit_int(-n)}, %rsp\n`
else ` subq ${emit_int(n)}, %rsp\n`;
+ cfi_adjust_cfa_offset n;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
@@ -614,11 +616,14 @@ let emit_instr fallthrough i =
` call {emit_label lbl}\n`
| Lpushtrap ->
` pushq %r14\n`;
+ cfi_adjust_cfa_offset 16;
` movq %rsp, %r14\n`;
stack_offset := !stack_offset + 16
| Lpoptrap ->
` popq %r14\n`;
+ cfi_adjust_cfa_offset (-8);
` addq $8, %rsp\n`;
+ cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset - 16
| Lraise ->
if !Clflags.debug then begin
@@ -682,15 +687,18 @@ let fundecl fundecl =
else
` .globl {emit_symbol fundecl.fun_name}\n`;
`{emit_symbol fundecl.fun_name}:\n`;
+ cfi_startproc ();
if !Clflags.gprofile then emit_profile();
if frame_required() then begin
let n = frame_size() - 8 in
- ` subq ${emit_int n}, %rsp\n`
+ ` subq ${emit_int n}, %rsp\n`;
+ cfi_adjust_cfa_offset n;
end;
`{emit_label !tailrec_entry_point}:\n`;
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
+ cfi_endproc ();
begin match Config.system with
"linux" | "gnu" ->
` .type {emit_symbol fundecl.fun_name},@function\n`;
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
index 522977a..0074d42 100644
--- a/asmcomp/emitaux.ml
+++ b/asmcomp/emitaux.ml
@@ -189,3 +189,25 @@ let is_generic_function name =
List.exists
(fun p -> isprefix p name)
["caml_apply"; "caml_curry"; "caml_send"; "caml_tuplify"]
+
+(* CFI directives *)
+
+let is_cfi_enabled () =
+ match !Clflags.debug, Config.system with
+ | true, ("linux" | "gnu") -> true
+ | _ -> false
+
+let cfi_startproc () =
+ if is_cfi_enabled () then
+ emit_string " .cfi_startproc\n"
+
+let cfi_endproc () =
+ if is_cfi_enabled () then
+ emit_string " .cfi_endproc\n"
+
+let cfi_adjust_cfa_offset n =
+ if is_cfi_enabled () then
+ begin
+ emit_string " .cfi_adjust_cfa_offset "; emit_int n; emit_string "\n";
+ end
+
diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli
index c253d6f..9b3275c 100644
--- a/asmcomp/emitaux.mli
+++ b/asmcomp/emitaux.mli
@@ -50,3 +50,7 @@ type emit_frame_actions =
val emit_frames: emit_frame_actions -> unit
val is_generic_function: string -> bool
+
+val cfi_startproc : unit -> unit
+val cfi_endproc : unit -> unit
+val cfi_adjust_cfa_offset : int -> unit
--
1.7.5.4
From a111f9f5cdf7ced8c16c7755fc59172ad51f7c5f Mon Sep 17 00:00:00 2001
From: ygrek <ygrek@autistici.org>
Date: Sat, 9 Jul 2011 22:50:10 +0300
Subject: [PATCH 2/2] emit CFI directives (i386)
---
asmcomp/emitaux.ml | 2 +-
asmcomp/i386/emit.mlp | 23 ++++++++++++++++++++++-
2 files changed, 23 insertions(+), 2 deletions(-)
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
index 0074d42..b2aa55d 100644
--- a/asmcomp/emitaux.ml
+++ b/asmcomp/emitaux.ml
@@ -194,7 +194,7 @@ let is_generic_function name =
let is_cfi_enabled () =
match !Clflags.debug, Config.system with
- | true, ("linux" | "gnu") -> true
+ | true, ("linux" | "linux_elf" | "gnu") -> true
| _ -> false
let cfi_startproc () =
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index 16a4da4..86176e6 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -311,7 +311,11 @@ let output_test_zero arg =
let output_epilogue () =
let n = frame_size() - 4 in
- if n > 0 then ` addl ${emit_int n}, %esp\n`
+ if n > 0 then
+ begin
+ ` addl ${emit_int n}, %esp\n`;
+ cfi_adjust_cfa_offset (-n);
+ end
(* Determine if the given register is the top of the floating-point stack *)
@@ -496,6 +500,7 @@ let emit_instr fallthrough i =
if n < 0
then ` addl ${emit_int(-n)}, %esp\n`
else ` subl ${emit_int(n)}, %esp\n`;
+ cfi_adjust_cfa_offset n;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
@@ -649,6 +654,7 @@ let emit_instr fallthrough i =
` fldl {emit_reg i.arg.(0)}\n`;
stack_offset := !stack_offset - 8;
` subl $8, %esp\n`;
+ cfi_adjust_cfa_offset 8;
` fnstcw 4(%esp)\n`;
` movw 4(%esp), %ax\n`;
` movb $12, %ah\n`;
@@ -663,6 +669,7 @@ let emit_instr fallthrough i =
end;
` fldcw 4(%esp)\n`;
` addl $8, %esp\n`;
+ cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset + 8
| Lop(Ispecific(Ilea addr)) ->
` lea {emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n`
@@ -679,29 +686,36 @@ let emit_instr fallthrough i =
match r with
{loc = Reg _; typ = Float} ->
` subl $8, %esp\n`;
+ cfi_adjust_cfa_offset 8;
` fstpl 0(%esp)\n`;
stack_offset := !stack_offset + 8
| {loc = Stack sl; typ = Float} ->
let ofs = slot_offset sl 1 in
` pushl {emit_int(ofs + 4)}(%esp)\n`;
` pushl {emit_int(ofs + 4)}(%esp)\n`;
+ cfi_adjust_cfa_offset 8;
stack_offset := !stack_offset + 8
| _ ->
` pushl {emit_reg r}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
done
| Lop(Ispecific(Ipush_int n)) ->
` pushl ${emit_nativeint n}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_symbol s)) ->
` pushl ${emit_symbol s}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_load addr)) ->
` pushl {emit_addressing addr i.arg 0}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_load_float addr)) ->
` pushl {emit_addressing (offset_addressing addr 4) i.arg 0}\n`;
` pushl {emit_addressing addr i.arg 0}\n`;
+ cfi_adjust_cfa_offset 8;
stack_offset := !stack_offset + 8
| Lop(Ispecific(Ifloatarithmem(double, op, addr))) ->
if not (is_tos i.arg.(0)) then
@@ -784,11 +798,13 @@ let emit_instr fallthrough i =
if trap_frame_size > 8 then
` subl ${emit_int (trap_frame_size - 8)}, %esp\n`;
` pushl {emit_symbol "caml_exception_pointer"}\n`;
+ cfi_adjust_cfa_offset trap_frame_size;
` movl %esp, {emit_symbol "caml_exception_pointer"}\n`;
stack_offset := !stack_offset + trap_frame_size
| Lpoptrap ->
` popl {emit_symbol "caml_exception_pointer"}\n`;
` addl ${emit_int (trap_frame_size - 4)}, %esp\n`;
+ cfi_adjust_cfa_offset (-trap_frame_size);
stack_offset := !stack_offset - trap_frame_size
| Lraise ->
if !Clflags.debug then begin
@@ -897,14 +913,19 @@ let fundecl fundecl =
else
` .globl {emit_symbol fundecl.fun_name}\n`;
`{emit_symbol fundecl.fun_name}:\n`;
+ cfi_startproc ();
if !Clflags.gprofile then emit_profile();
let n = frame_size() - 4 in
if n > 0 then
+ begin
` subl ${emit_int n}, %esp\n`;
+ cfi_adjust_cfa_offset n;
+ end;
`{emit_label !tailrec_entry_point}:\n`;
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
+ cfi_endproc ();
begin match Config.system with
"linux_elf" | "bsd_elf" | "gnu" ->
` .type {emit_symbol fundecl.fun_name},@function\n`;
--
1.7.5.4
ocaml-3.12.1-cfi2.patch [^] (19,528 bytes) 2011-07-13 19:03 [Show Content] [Hide Content]diff --git a/Makefile b/Makefile
index 7b777da..37c5a3e 100644
--- a/Makefile
+++ b/Makefile
@@ -392,6 +392,7 @@ utils/config.ml: utils/config.mlp config/Makefile
-e 's|%%EXT_DLL%%|.so|' \
-e 's|%%SYSTHREAD_SUPPORT%%|$(SYSTHREAD_SUPPORT)|' \
-e 's|%%ASM%%|$(ASM)|' \
+ -e 's|%%ASM_CFI_SUPPORTED%%|$(ASM_CFI_SUPPORTED)|' \
-e 's|%%MKDLL%%|$(MKDLL)|' \
-e 's|%%MKEXE%%|$(MKEXE)|' \
-e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index 94e9cb2..7d793f2 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -317,11 +317,17 @@ let emit_float_test cmp neg arg lbl =
(* Deallocate the stack frame before a return or tail call *)
-let output_epilogue () =
+let output_epilogue f =
if frame_required() then begin
let n = frame_size() - 8 in
- ` addq ${emit_int n}, %rsp\n`
+ ` addq ${emit_int n}, %rsp\n`;
+ cfi_adjust_cfa_offset (-n);
+ f ();
+ (* reset CFA back cause function body may continue *)
+ cfi_adjust_cfa_offset n
end
+ else
+ f ()
(* Output the assembly code for an instruction *)
@@ -373,14 +379,16 @@ let emit_instr fallthrough i =
` {emit_call s}\n`;
record_frame i.live i.dbg
| Lop(Itailcall_ind) ->
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp *{emit_reg i.arg.(0)}\n`
+ end
| Lop(Itailcall_imm s) ->
if s = !function_name then
` jmp {emit_label !tailrec_entry_point}\n`
else begin
- output_epilogue();
+ output_epilogue begin fun () ->
` {emit_jump s}\n`
+ end
end
| Lop(Iextcall(s, alloc)) ->
if alloc then begin
@@ -394,6 +402,7 @@ let emit_instr fallthrough i =
if n < 0
then ` addq ${emit_int(-n)}, %rsp\n`
else ` subq ${emit_int(n)}, %rsp\n`;
+ cfi_adjust_cfa_offset n;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
@@ -536,8 +545,9 @@ let emit_instr fallthrough i =
| Lreloadretaddr ->
()
| Lreturn ->
- output_epilogue();
+ output_epilogue begin fun () ->
` ret\n`
+ end
| Llabel lbl ->
`{emit_Llabel fallthrough lbl}:\n`
| Lbranch lbl ->
@@ -613,12 +623,16 @@ let emit_instr fallthrough i =
| Lsetuptrap lbl ->
` call {emit_label lbl}\n`
| Lpushtrap ->
+ cfi_adjust_cfa_offset 8;
` pushq %r14\n`;
+ cfi_adjust_cfa_offset 8;
` movq %rsp, %r14\n`;
stack_offset := !stack_offset + 16
| Lpoptrap ->
` popq %r14\n`;
+ cfi_adjust_cfa_offset (-8);
` addq $8, %rsp\n`;
+ cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset - 16
| Lraise ->
if !Clflags.debug then begin
@@ -682,15 +696,18 @@ let fundecl fundecl =
else
` .globl {emit_symbol fundecl.fun_name}\n`;
`{emit_symbol fundecl.fun_name}:\n`;
+ cfi_startproc ();
if !Clflags.gprofile then emit_profile();
if frame_required() then begin
let n = frame_size() - 8 in
- ` subq ${emit_int n}, %rsp\n`
+ ` subq ${emit_int n}, %rsp\n`;
+ cfi_adjust_cfa_offset n;
end;
`{emit_label !tailrec_entry_point}:\n`;
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
+ cfi_endproc ();
begin match Config.system with
"linux" | "gnu" ->
` .type {emit_symbol fundecl.fun_name},@function\n`;
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
index 522977a..32f0dc2 100644
--- a/asmcomp/emitaux.ml
+++ b/asmcomp/emitaux.ml
@@ -189,3 +189,23 @@ let is_generic_function name =
List.exists
(fun p -> isprefix p name)
["caml_apply"; "caml_curry"; "caml_send"; "caml_tuplify"]
+
+(* CFI directives *)
+
+let is_cfi_enabled () =
+ !Clflags.debug && Config.asm_cfi_supported
+
+let cfi_startproc () =
+ if is_cfi_enabled () then
+ emit_string " .cfi_startproc\n"
+
+let cfi_endproc () =
+ if is_cfi_enabled () then
+ emit_string " .cfi_endproc\n"
+
+let cfi_adjust_cfa_offset n =
+ if is_cfi_enabled () then
+ begin
+ emit_string " .cfi_adjust_cfa_offset "; emit_int n; emit_string "\n";
+ end
+
diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli
index c253d6f..9b3275c 100644
--- a/asmcomp/emitaux.mli
+++ b/asmcomp/emitaux.mli
@@ -50,3 +50,7 @@ type emit_frame_actions =
val emit_frames: emit_frame_actions -> unit
val is_generic_function: string -> bool
+
+val cfi_startproc : unit -> unit
+val cfi_endproc : unit -> unit
+val cfi_adjust_cfa_offset : int -> unit
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index 16a4da4..ecb8c86 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -309,9 +309,18 @@ let output_test_zero arg =
(* Deallocate the stack frame before a return or tail call *)
-let output_epilogue () =
+let output_epilogue f =
let n = frame_size() - 4 in
- if n > 0 then ` addl ${emit_int n}, %esp\n`
+ if n > 0 then
+ begin
+ ` addl ${emit_int n}, %esp\n`;
+ cfi_adjust_cfa_offset (-n);
+ f ();
+ (* reset CFA back cause function body may continue *)
+ cfi_adjust_cfa_offset n
+ end
+ else
+ f ()
(* Determine if the given register is the top of the floating-point stack *)
@@ -463,14 +472,16 @@ let emit_instr fallthrough i =
` call {emit_symbol s}\n`;
record_frame i.live i.dbg
| Lop(Itailcall_ind) ->
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp *{emit_reg i.arg.(0)}\n`
+ end
| Lop(Itailcall_imm s) ->
if s = !function_name then
` jmp {emit_label !tailrec_entry_point}\n`
else begin
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp {emit_symbol s}\n`
+ end
end
| Lop(Iextcall(s, alloc)) ->
if alloc then begin
@@ -496,6 +507,7 @@ let emit_instr fallthrough i =
if n < 0
then ` addl ${emit_int(-n)}, %esp\n`
else ` subl ${emit_int(n)}, %esp\n`;
+ cfi_adjust_cfa_offset n;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
@@ -649,6 +661,7 @@ let emit_instr fallthrough i =
` fldl {emit_reg i.arg.(0)}\n`;
stack_offset := !stack_offset - 8;
` subl $8, %esp\n`;
+ cfi_adjust_cfa_offset 8;
` fnstcw 4(%esp)\n`;
` movw 4(%esp), %ax\n`;
` movb $12, %ah\n`;
@@ -663,6 +676,7 @@ let emit_instr fallthrough i =
end;
` fldcw 4(%esp)\n`;
` addl $8, %esp\n`;
+ cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset + 8
| Lop(Ispecific(Ilea addr)) ->
` lea {emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n`
@@ -679,29 +693,36 @@ let emit_instr fallthrough i =
match r with
{loc = Reg _; typ = Float} ->
` subl $8, %esp\n`;
+ cfi_adjust_cfa_offset 8;
` fstpl 0(%esp)\n`;
stack_offset := !stack_offset + 8
| {loc = Stack sl; typ = Float} ->
let ofs = slot_offset sl 1 in
` pushl {emit_int(ofs + 4)}(%esp)\n`;
` pushl {emit_int(ofs + 4)}(%esp)\n`;
+ cfi_adjust_cfa_offset 8;
stack_offset := !stack_offset + 8
| _ ->
` pushl {emit_reg r}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
done
| Lop(Ispecific(Ipush_int n)) ->
` pushl ${emit_nativeint n}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_symbol s)) ->
` pushl ${emit_symbol s}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_load addr)) ->
` pushl {emit_addressing addr i.arg 0}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_load_float addr)) ->
` pushl {emit_addressing (offset_addressing addr 4) i.arg 0}\n`;
` pushl {emit_addressing addr i.arg 0}\n`;
+ cfi_adjust_cfa_offset 8;
stack_offset := !stack_offset + 8
| Lop(Ispecific(Ifloatarithmem(double, op, addr))) ->
if not (is_tos i.arg.(0)) then
@@ -719,8 +740,9 @@ let emit_instr fallthrough i =
| Lreloadretaddr ->
()
| Lreturn ->
- output_epilogue();
+ output_epilogue begin fun () ->
` ret\n`
+ end
| Llabel lbl ->
`{emit_Llabel fallthrough lbl}:\n`
| Lbranch lbl ->
@@ -784,11 +806,13 @@ let emit_instr fallthrough i =
if trap_frame_size > 8 then
` subl ${emit_int (trap_frame_size - 8)}, %esp\n`;
` pushl {emit_symbol "caml_exception_pointer"}\n`;
+ cfi_adjust_cfa_offset trap_frame_size;
` movl %esp, {emit_symbol "caml_exception_pointer"}\n`;
stack_offset := !stack_offset + trap_frame_size
| Lpoptrap ->
` popl {emit_symbol "caml_exception_pointer"}\n`;
` addl ${emit_int (trap_frame_size - 4)}, %esp\n`;
+ cfi_adjust_cfa_offset (-trap_frame_size);
stack_offset := !stack_offset - trap_frame_size
| Lraise ->
if !Clflags.debug then begin
@@ -897,14 +921,19 @@ let fundecl fundecl =
else
` .globl {emit_symbol fundecl.fun_name}\n`;
`{emit_symbol fundecl.fun_name}:\n`;
+ cfi_startproc ();
if !Clflags.gprofile then emit_profile();
let n = frame_size() - 4 in
if n > 0 then
+ begin
` subl ${emit_int n}, %esp\n`;
+ cfi_adjust_cfa_offset n;
+ end;
`{emit_label !tailrec_entry_point}:\n`;
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
+ cfi_endproc ();
begin match Config.system with
"linux_elf" | "bsd_elf" | "gnu" ->
` .type {emit_symbol fundecl.fun_name},@function\n`;
diff --git a/asmrun/amd64.S b/asmrun/amd64.S
index 090610a..f1d4a30 100644
--- a/asmrun/amd64.S
+++ b/asmrun/amd64.S
@@ -18,6 +18,8 @@
/* PIC mode support based on contribution by Paul Stravers (see PR#4795) */
+#include "../config/m.h"
+
#ifdef SYS_macosx
#define G(r) _##r
@@ -47,6 +49,16 @@
#endif
+#ifdef ASM_CFI_SUPPORTED
+#define CFI_STARTPROC .cfi_startproc
+#define CFI_ENDPROC .cfi_endproc
+#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#endif
+
#ifdef __PIC__
/* Position-independent operations on global variables. */
@@ -125,6 +137,7 @@
/* Allocation */
FUNCTION(G(caml_call_gc))
+ CFI_STARTPROC
RECORD_STACK_FRAME(0)
.Lcaml_call_gc:
/* Build array of registers, save it into caml_gc_regs */
@@ -147,6 +160,7 @@ FUNCTION(G(caml_call_gc))
STORE_VAR(%r14, caml_exception_pointer)
/* Save floating-point registers */
subq $(16*8), %rsp
+ CFI_ADJUST(232)
movsd %xmm0, 0*8(%rsp)
movsd %xmm1, 1*8(%rsp)
movsd %xmm2, 2*8(%rsp)
@@ -199,8 +213,10 @@ FUNCTION(G(caml_call_gc))
popq %rbp
popq %r12
popq %r13
+ CFI_ADJUST(-232)
/* Return to caller */
ret
+ CFI_ENDPROC
FUNCTION(G(caml_alloc1))
.Lcaml_alloc1:
@@ -258,9 +274,11 @@ FUNCTION(G(caml_allocN))
/* Call a C function from Caml */
FUNCTION(G(caml_c_call))
+ CFI_STARTPROC
.Lcaml_c_call:
/* Record lowest stack address and return address */
popq %r12
+ CFI_ADJUST(-8)
STORE_VAR(%r12, caml_last_return_address)
STORE_VAR(%rsp, caml_bottom_of_stack)
/* Make the exception handler and alloc ptr available to the C code */
@@ -272,11 +290,14 @@ FUNCTION(G(caml_c_call))
LOAD_VAR(caml_young_ptr, %r15)
/* Return to caller */
pushq %r12
+ CFI_ADJUST(8)
ret
+ CFI_ENDPROC
/* Start the Caml program */
FUNCTION(G(caml_start_program))
+ CFI_STARTPROC
/* Save callee-save registers */
pushq %rbx
pushq %rbp
@@ -285,6 +306,7 @@ FUNCTION(G(caml_start_program))
pushq %r14
pushq %r15
subq $8, %rsp /* stack 16-aligned */
+ CFI_ADJUST(56)
/* Initial entry point is G(caml_program) */
leaq GCALL(caml_program)(%rip), %r12
/* Common code for caml_start_program and caml_callback* */
@@ -294,6 +316,7 @@ FUNCTION(G(caml_start_program))
PUSH_VAR(caml_gc_regs)
PUSH_VAR(caml_last_return_address)
PUSH_VAR(caml_bottom_of_stack)
+ CFI_ADJUST(32)
/* Setup alloc ptr and exception ptr */
LOAD_VAR(caml_young_ptr, %r15)
LOAD_VAR(caml_exception_pointer, %r14)
@@ -301,6 +324,7 @@ FUNCTION(G(caml_start_program))
lea .L108(%rip), %r13
pushq %r13
pushq %r14
+ CFI_ADJUST(16)
movq %rsp, %r14
/* Call the Caml code */
call *%r12
@@ -308,6 +332,7 @@ FUNCTION(G(caml_start_program))
/* Pop the exception handler */
popq %r14
popq %r12 /* dummy register */
+ CFI_ADJUST(-16)
.L109:
/* Update alloc ptr and exception ptr */
STORE_VAR(%r15,caml_young_ptr)
@@ -332,6 +357,7 @@ FUNCTION(G(caml_start_program))
/* Mark the bucket as an exception result and return it */
orq $2, %rax
jmp .L109
+ CFI_ENDPROC
/* Raise an exception from Caml */
diff --git a/asmrun/i386.S b/asmrun/i386.S
index 95198e0..568b69d 100644
--- a/asmrun/i386.S
+++ b/asmrun/i386.S
@@ -16,6 +16,8 @@
/* Asm part of the runtime system, Intel 386 processor */
/* Must be preprocessed by cpp */
+#include "../config/m.h"
+
/* Linux/BSD with ELF binaries and Solaris do not prefix identifiers with _.
Linux/BSD with a.out binaries and NextStep do. */
@@ -42,6 +44,16 @@
#define FUNCTION_ALIGN 2
#endif
+#ifdef ASM_CFI_SUPPORTED
+#define CFI_STARTPROC .cfi_startproc
+#define CFI_ENDPROC .cfi_endproc
+#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#endif
+
#if defined(PROFILING)
#if defined(SYS_linux_elf) || defined(SYS_gnu)
#define PROFILE_CAML \
@@ -89,6 +101,7 @@
.align FUNCTION_ALIGN
G(caml_call_gc):
+ CFI_STARTPROC
PROFILE_CAML
/* Record lowest stack address and return address */
movl 0(%esp), %eax
@@ -104,6 +117,7 @@ LBL(105):
pushl %ecx
pushl %ebx
pushl %eax
+ CFI_ADJUST(28)
movl %esp, G(caml_gc_regs)
/* MacOSX note: 16-alignment of stack preserved at this point */
/* Call the garbage collector */
@@ -116,8 +130,10 @@ LBL(105):
popl %esi
popl %edi
popl %ebp
+ CFI_ADJUST(-28)
/* Return to caller */
ret
+ CFI_ENDPROC
.align FUNCTION_ALIGN
G(caml_alloc1):
@@ -219,12 +235,14 @@ G(caml_c_call):
.globl G(caml_start_program)
.align FUNCTION_ALIGN
G(caml_start_program):
+ CFI_STARTPROC
PROFILE_C
/* Save callee-save registers */
pushl %ebx
pushl %esi
pushl %edi
pushl %ebp
+ CFI_ADJUST(16)
/* Initial entry point is caml_program */
movl $ G(caml_program), %esi
/* Common code for caml_start_program and caml_callback* */
@@ -238,6 +256,7 @@ LBL(106):
pushl $ LBL(108)
ALIGN_STACK(8)
pushl G(caml_exception_pointer)
+ CFI_ADJUST(20)
movl %esp, G(caml_exception_pointer)
/* Call the Caml code */
call *%esi
@@ -249,6 +268,7 @@ LBL(107):
#else
addl $4, %esp
#endif
+ CFI_ADJUST(-8)
LBL(109):
/* Pop the callback link, restoring the global variables */
popl G(caml_bottom_of_stack)
@@ -266,6 +286,7 @@ LBL(108):
/* Mark the bucket as an exception result and return it */
orl $2, %eax
jmp LBL(109)
+ CFI_ENDPROC
/* Raise an exception from Caml */
diff --git a/config/auto-aux/cfi.S b/config/auto-aux/cfi.S
new file mode 100644
index 0000000..e055423
--- /dev/null
+++ b/config/auto-aux/cfi.S
@@ -0,0 +1,3 @@
+.cfi_startproc
+.cfi_adjust_cfa_offset 8
+.cfi_endproc
diff --git a/config/auto-aux/tryassemble b/config/auto-aux/tryassemble
new file mode 100755
index 0000000..feffbed
--- /dev/null
+++ b/config/auto-aux/tryassemble
@@ -0,0 +1,7 @@
+#!/bin/sh
+if test "$verbose" = yes; then
+echo "tryassemble: $aspp -o tst $*" >&2
+$aspp -o tst $* || exit 100
+else
+$aspp -o tst $* 2> /dev/null || exit 100
+fi
diff --git a/configure b/configure
index 9be5199..9c6453d 100755
--- a/configure
+++ b/configure
@@ -1591,6 +1591,17 @@ else
echo "LIBBFD_LINK=" >> Makefile
fi
+# Check whether assembler supports CFI directives
+
+asm_cfi_supported=false
+
+export aspp
+
+if sh ./tryassemble cfi.S; then
+ echo "#define ASM_CFI_SUPPORTED" >> m.h
+ asm_cfi_supported=true
+fi
+
# Final twiddling of compiler options to work around known bugs
nativeccprofopts="$nativecccompopts"
@@ -1660,6 +1671,7 @@ echo "CMXS=$cmxs" >> Makefile
echo "MKEXE=$mkexe" >> Makefile
echo "MKDLL=$mksharedlib" >> Makefile
echo "MKMAINDLL=$mkmaindll" >> Makefile
+echo "ASM_CFI_SUPPORTED=$asm_cfi_supported" >> Makefile
rm -f tst hasgot.c
rm -f ../m.h ../s.h ../Makefile
@@ -1704,6 +1716,11 @@ else
echo " options for linking....... $nativecclinkopts $cclibs"
echo " assembler ................ $as"
echo " preprocessed assembler ... $aspp"
+ if test "$asm_cfi_supported" = "true"; then
+ echo " assembler supports CFI ... yes"
+ else
+ echo " assembler supports CFI ... no"
+ fi
echo " native dynlink ........... $natdynlink"
if test "$profiling" = "prof"; then
echo " profiling with gprof ..... supported"
diff --git a/utils/config.mlbuild b/utils/config.mlbuild
index 478d599..48b1118 100644
--- a/utils/config.mlbuild
+++ b/utils/config.mlbuild
@@ -88,6 +88,7 @@ let model = C.model
let system = C.system
let asm = C.asm
+let asm_cfi_supported = C.asm_cfi_supported
let ext_obj = C.ext_obj
let ext_asm = C.ext_asm
@@ -121,6 +122,7 @@ let print_config oc =
p "model" model;
p "system" system;
p "asm" asm;
+ p_bool "asm_cfi_supported" asm_cfi_supported;
p "ext_obj" ext_obj;
p "ext_asm" ext_asm;
p "ext_lib" ext_lib;
diff --git a/utils/config.mli b/utils/config.mli
index 4c66eb0..061fea3 100644
--- a/utils/config.mli
+++ b/utils/config.mli
@@ -98,6 +98,9 @@ val asm: string
(* The assembler (and flags) to use for assembling
ocamlopt-generated code. *)
+val asm_cfi_supported: bool
+ (* Whether assembler understands CFI directives *)
+
val ext_obj: string
(* Extension for object files, e.g. [.o] under Unix. *)
val ext_asm: string
diff --git a/utils/config.mlp b/utils/config.mlp
index 9694868..5486827 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -77,6 +77,7 @@ let model = "%%MODEL%%"
let system = "%%SYSTEM%%"
let asm = "%%ASM%%"
+let asm_cfi_supported = %%ASM_CFI_SUPPORTED%%
let ext_obj = "%%EXT_OBJ%%"
let ext_asm = "%%EXT_ASM%%"
@@ -110,6 +111,7 @@ let print_config oc =
p "model" model;
p "system" system;
p "asm" asm;
+ p_bool "asm_cfi_supported" asm_cfi_supported;
p "ext_obj" ext_obj;
p "ext_asm" ext_asm;
p "ext_lib" ext_lib;
ocaml-3.11.2-cfi.patch [^] (19,603 bytes) 2011-07-13 19:03 [Show Content] [Hide Content]diff --git a/Makefile b/Makefile
index 80c6824..d7cec36 100644
--- a/Makefile
+++ b/Makefile
@@ -387,6 +387,7 @@ utils/config.ml: utils/config.mlp config/Makefile
-e 's|%%EXT_DLL%%|.so|' \
-e 's|%%SYSTHREAD_SUPPORT%%|$(SYSTHREAD_SUPPORT)|' \
-e 's|%%ASM%%|$(ASM)|' \
+ -e 's|%%ASM_CFI_SUPPORTED%%|$(ASM_CFI_SUPPORTED)|' \
-e 's|%%MKDLL%%|$(MKDLL)|' \
-e 's|%%MKEXE%%|$(MKEXE)|' \
-e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index 4a3f844..ff85ec0 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -308,11 +308,17 @@ let emit_float_test cmp neg arg lbl =
(* Deallocate the stack frame before a return or tail call *)
-let output_epilogue () =
+let output_epilogue f =
if frame_required() then begin
let n = frame_size() - 8 in
- ` addq ${emit_int n}, %rsp\n`
+ ` addq ${emit_int n}, %rsp\n`;
+ cfi_adjust_cfa_offset (-n);
+ f ();
+ (* reset CFA back cause function body may continue *)
+ cfi_adjust_cfa_offset n
end
+ else
+ f ()
(* Output the assembly code for an instruction *)
@@ -361,14 +367,16 @@ let emit_instr fallthrough i =
` {emit_call s}\n`;
record_frame i.live i.dbg
| Lop(Itailcall_ind) ->
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp *{emit_reg i.arg.(0)}\n`
+ end
| Lop(Itailcall_imm s) ->
if s = !function_name then
` jmp {emit_label !tailrec_entry_point}\n`
else begin
- output_epilogue();
+ output_epilogue begin fun () ->
` {emit_jump s}\n`
+ end
end
| Lop(Iextcall(s, alloc)) ->
if alloc then begin
@@ -382,6 +390,7 @@ let emit_instr fallthrough i =
if n < 0
then ` addq ${emit_int(-n)}, %rsp\n`
else ` subq ${emit_int(n)}, %rsp\n`;
+ cfi_adjust_cfa_offset n;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
@@ -524,8 +533,9 @@ let emit_instr fallthrough i =
| Lreloadretaddr ->
()
| Lreturn ->
- output_epilogue();
+ output_epilogue begin fun () ->
` ret\n`
+ end
| Llabel lbl ->
`{emit_Llabel fallthrough lbl}:\n`
| Lbranch lbl ->
@@ -601,12 +611,16 @@ let emit_instr fallthrough i =
| Lsetuptrap lbl ->
` call {emit_label lbl}\n`
| Lpushtrap ->
+ cfi_adjust_cfa_offset 8;
` pushq %r14\n`;
+ cfi_adjust_cfa_offset 8;
` movq %rsp, %r14\n`;
stack_offset := !stack_offset + 16
| Lpoptrap ->
` popq %r14\n`;
+ cfi_adjust_cfa_offset (-8);
` addq $8, %rsp\n`;
+ cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset - 16
| Lraise ->
if !Clflags.debug then begin
@@ -670,15 +684,18 @@ let fundecl fundecl =
else
` .globl {emit_symbol fundecl.fun_name}\n`;
`{emit_symbol fundecl.fun_name}:\n`;
+ cfi_startproc ();
if !Clflags.gprofile then emit_profile();
if frame_required() then begin
let n = frame_size() - 8 in
- ` subq ${emit_int n}, %rsp\n`
+ ` subq ${emit_int n}, %rsp\n`;
+ cfi_adjust_cfa_offset n;
end;
`{emit_label !tailrec_entry_point}:\n`;
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
+ cfi_endproc ();
if !float_constants <> [] then begin
if macosx
then ` .literal8\n`
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
index 0cae6dd..381c1be 100644
--- a/asmcomp/emitaux.ml
+++ b/asmcomp/emitaux.ml
@@ -190,3 +190,21 @@ let is_generic_function name =
(fun p -> isprefix p name)
["caml_apply"; "caml_curry"; "caml_send"; "caml_tuplify"]
+(* CFI directives *)
+
+let is_cfi_enabled () =
+ !Clflags.debug && Config.asm_cfi_supported
+
+let cfi_startproc () =
+ if is_cfi_enabled () then
+ emit_string " .cfi_startproc\n"
+
+let cfi_endproc () =
+ if is_cfi_enabled () then
+ emit_string " .cfi_endproc\n"
+
+let cfi_adjust_cfa_offset n =
+ if is_cfi_enabled () then
+ begin
+ emit_string " .cfi_adjust_cfa_offset "; emit_int n; emit_string "\n";
+ end
diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli
index 88eac2f..41dbac5 100644
--- a/asmcomp/emitaux.mli
+++ b/asmcomp/emitaux.mli
@@ -50,3 +50,7 @@ type emit_frame_actions =
val emit_frames: emit_frame_actions -> unit
val is_generic_function: string -> bool
+
+val cfi_startproc : unit -> unit
+val cfi_endproc : unit -> unit
+val cfi_adjust_cfa_offset : int -> unit
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index 2992f29..0a9fcd5 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -309,9 +309,18 @@ let output_test_zero arg =
(* Deallocate the stack frame before a return or tail call *)
-let output_epilogue () =
+let output_epilogue f =
let n = frame_size() - 4 in
- if n > 0 then ` addl ${emit_int n}, %esp\n`
+ if n > 0 then
+ begin
+ ` addl ${emit_int n}, %esp\n`;
+ cfi_adjust_cfa_offset (-n);
+ f ();
+ (* reset CFA back cause function body may continue *)
+ cfi_adjust_cfa_offset n
+ end
+ else
+ f ()
(* Determine if the given register is the top of the floating-point stack *)
@@ -463,14 +472,16 @@ let emit_instr fallthrough i =
` call {emit_symbol s}\n`;
record_frame i.live i.dbg
| Lop(Itailcall_ind) ->
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp *{emit_reg i.arg.(0)}\n`
+ end
| Lop(Itailcall_imm s) ->
if s = !function_name then
` jmp {emit_label !tailrec_entry_point}\n`
else begin
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp {emit_symbol s}\n`
+ end
end
| Lop(Iextcall(s, alloc)) ->
if alloc then begin
@@ -496,6 +507,7 @@ let emit_instr fallthrough i =
if n < 0
then ` addl ${emit_int(-n)}, %esp\n`
else ` subl ${emit_int(n)}, %esp\n`;
+ cfi_adjust_cfa_offset n;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
@@ -649,6 +661,7 @@ let emit_instr fallthrough i =
` fldl {emit_reg i.arg.(0)}\n`;
stack_offset := !stack_offset - 8;
` subl $8, %esp\n`;
+ cfi_adjust_cfa_offset 8;
` fnstcw 4(%esp)\n`;
` movw 4(%esp), %ax\n`;
` movb $12, %ah\n`;
@@ -663,6 +676,7 @@ let emit_instr fallthrough i =
end;
` fldcw 4(%esp)\n`;
` addl $8, %esp\n`;
+ cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset + 8
| Lop(Ispecific(Ilea addr)) ->
` lea {emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n`
@@ -679,29 +693,36 @@ let emit_instr fallthrough i =
match r with
{loc = Reg _; typ = Float} ->
` subl $8, %esp\n`;
+ cfi_adjust_cfa_offset 8;
` fstpl 0(%esp)\n`;
stack_offset := !stack_offset + 8
| {loc = Stack sl; typ = Float} ->
let ofs = slot_offset sl 1 in
` pushl {emit_int(ofs + 4)}(%esp)\n`;
` pushl {emit_int(ofs + 4)}(%esp)\n`;
+ cfi_adjust_cfa_offset 8;
stack_offset := !stack_offset + 8
| _ ->
` pushl {emit_reg r}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
done
| Lop(Ispecific(Ipush_int n)) ->
` pushl ${emit_nativeint n}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_symbol s)) ->
` pushl ${emit_symbol s}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_load addr)) ->
` pushl {emit_addressing addr i.arg 0}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_load_float addr)) ->
` pushl {emit_addressing (offset_addressing addr 4) i.arg 0}\n`;
` pushl {emit_addressing addr i.arg 0}\n`;
+ cfi_adjust_cfa_offset 8;
stack_offset := !stack_offset + 8
| Lop(Ispecific(Ifloatarithmem(double, op, addr))) ->
if not (is_tos i.arg.(0)) then
@@ -719,8 +740,9 @@ let emit_instr fallthrough i =
| Lreloadretaddr ->
()
| Lreturn ->
- output_epilogue();
+ output_epilogue begin fun () ->
` ret\n`
+ end
| Llabel lbl ->
`{emit_Llabel fallthrough lbl}:\n`
| Lbranch lbl ->
@@ -784,11 +806,13 @@ let emit_instr fallthrough i =
if trap_frame_size > 8 then
` subl ${emit_int (trap_frame_size - 8)}, %esp\n`;
` pushl {emit_symbol "caml_exception_pointer"}\n`;
+ cfi_adjust_cfa_offset trap_frame_size;
` movl %esp, {emit_symbol "caml_exception_pointer"}\n`;
stack_offset := !stack_offset + trap_frame_size
| Lpoptrap ->
` popl {emit_symbol "caml_exception_pointer"}\n`;
` addl ${emit_int (trap_frame_size - 4)}, %esp\n`;
+ cfi_adjust_cfa_offset (-trap_frame_size);
stack_offset := !stack_offset - trap_frame_size
| Lraise ->
if !Clflags.debug then begin
@@ -897,14 +921,19 @@ let fundecl fundecl =
else
` .globl {emit_symbol fundecl.fun_name}\n`;
`{emit_symbol fundecl.fun_name}:\n`;
+ cfi_startproc ();
if !Clflags.gprofile then emit_profile();
let n = frame_size() - 4 in
if n > 0 then
+ begin
` subl ${emit_int n}, %esp\n`;
+ cfi_adjust_cfa_offset n;
+ end;
`{emit_label !tailrec_entry_point}:\n`;
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
+ cfi_endproc ();
List.iter emit_float_constant !float_constants;
match Config.system with
"linux_elf" | "bsd_elf" | "gnu" ->
diff --git a/asmrun/amd64.S b/asmrun/amd64.S
index fe96110..50130a3 100644
--- a/asmrun/amd64.S
+++ b/asmrun/amd64.S
@@ -16,6 +16,8 @@
/* Asm part of the runtime system, AMD64 processor */
/* Must be preprocessed by cpp */
+#include "../config/m.h"
+
#ifdef SYS_macosx
#define G(r) _##r
@@ -41,12 +43,23 @@
#endif
+#ifdef ASM_CFI_SUPPORTED
+#define CFI_STARTPROC .cfi_startproc
+#define CFI_ENDPROC .cfi_endproc
+#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#endif
+
.text
/* Allocation */
FUNCTION(G(caml_call_gc))
+ CFI_STARTPROC
/* Record lowest stack address and return address */
movq 0(%rsp), %rax
movq %rax, G(caml_last_return_address)(%rip)
@@ -73,6 +86,7 @@ FUNCTION(G(caml_call_gc))
movq %rsp, G(caml_gc_regs)(%rip)
/* Save floating-point registers */
subq $(16*8), %rsp
+ CFI_ADJUST(232)
movlpd %xmm0, 0*8(%rsp)
movlpd %xmm1, 1*8(%rsp)
movlpd %xmm2, 2*8(%rsp)
@@ -122,11 +136,13 @@ FUNCTION(G(caml_call_gc))
popq %rbp
popq %r12
popq %r13
+ CFI_ADJUST(-232)
/* Restore caml_young_ptr, caml_exception_pointer */
movq G(caml_young_ptr)(%rip), %r15
movq G(caml_exception_pointer)(%rip), %r14
/* Return to caller */
ret
+ CFI_ENDPROC
FUNCTION(G(caml_alloc1))
subq $16, %r15
@@ -191,8 +207,10 @@ FUNCTION(G(caml_allocN))
/* Call a C function from Caml */
FUNCTION(G(caml_c_call))
+ CFI_STARTPROC
/* Record lowest stack address and return address */
popq %r12
+ CFI_ADJUST(-8)
movq %r12, G(caml_last_return_address)(%rip)
movq %rsp, G(caml_bottom_of_stack)(%rip)
/* Make the exception handler and alloc ptr available to the C code */
@@ -204,11 +222,14 @@ FUNCTION(G(caml_c_call))
movq G(caml_young_ptr)(%rip), %r15
/* Return to caller */
pushq %r12
+ CFI_ADJUST(8)
ret
+ CFI_ENDPROC
/* Start the Caml program */
FUNCTION(G(caml_start_program))
+ CFI_STARTPROC
/* Save callee-save registers */
pushq %rbx
pushq %rbp
@@ -217,6 +238,7 @@ FUNCTION(G(caml_start_program))
pushq %r14
pushq %r15
subq $8, %rsp /* stack 16-aligned */
+ CFI_ADJUST(56)
/* Initial entry point is G(caml_program) */
leaq G(caml_program)(%rip), %r12
/* Common code for caml_start_program and caml_callback* */
@@ -226,6 +248,7 @@ FUNCTION(G(caml_start_program))
pushq G(caml_gc_regs)(%rip)
pushq G(caml_last_return_address)(%rip)
pushq G(caml_bottom_of_stack)(%rip)
+ CFI_ADJUST(32)
/* Setup alloc ptr and exception ptr */
movq G(caml_young_ptr)(%rip), %r15
movq G(caml_exception_pointer)(%rip), %r14
@@ -233,6 +256,7 @@ FUNCTION(G(caml_start_program))
lea .L108(%rip), %r13
pushq %r13
pushq %r14
+ CFI_ADJUST(16)
movq %rsp, %r14
/* Call the Caml code */
call *%r12
@@ -240,6 +264,7 @@ FUNCTION(G(caml_start_program))
/* Pop the exception handler */
popq %r14
popq %r12 /* dummy register */
+ CFI_ADJUST(-16)
.L109:
/* Update alloc ptr and exception ptr */
movq %r15, G(caml_young_ptr)(%rip)
@@ -264,6 +289,7 @@ FUNCTION(G(caml_start_program))
/* Mark the bucket as an exception result and return it */
orq $2, %rax
jmp .L109
+ CFI_ENDPROC
/* Raise an exception from Caml */
diff --git a/asmrun/i386.S b/asmrun/i386.S
index 95198e0..568b69d 100644
--- a/asmrun/i386.S
+++ b/asmrun/i386.S
@@ -16,6 +16,8 @@
/* Asm part of the runtime system, Intel 386 processor */
/* Must be preprocessed by cpp */
+#include "../config/m.h"
+
/* Linux/BSD with ELF binaries and Solaris do not prefix identifiers with _.
Linux/BSD with a.out binaries and NextStep do. */
@@ -42,6 +44,16 @@
#define FUNCTION_ALIGN 2
#endif
+#ifdef ASM_CFI_SUPPORTED
+#define CFI_STARTPROC .cfi_startproc
+#define CFI_ENDPROC .cfi_endproc
+#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#endif
+
#if defined(PROFILING)
#if defined(SYS_linux_elf) || defined(SYS_gnu)
#define PROFILE_CAML \
@@ -89,6 +101,7 @@
.align FUNCTION_ALIGN
G(caml_call_gc):
+ CFI_STARTPROC
PROFILE_CAML
/* Record lowest stack address and return address */
movl 0(%esp), %eax
@@ -104,6 +117,7 @@ LBL(105):
pushl %ecx
pushl %ebx
pushl %eax
+ CFI_ADJUST(28)
movl %esp, G(caml_gc_regs)
/* MacOSX note: 16-alignment of stack preserved at this point */
/* Call the garbage collector */
@@ -116,8 +130,10 @@ LBL(105):
popl %esi
popl %edi
popl %ebp
+ CFI_ADJUST(-28)
/* Return to caller */
ret
+ CFI_ENDPROC
.align FUNCTION_ALIGN
G(caml_alloc1):
@@ -219,12 +235,14 @@ G(caml_c_call):
.globl G(caml_start_program)
.align FUNCTION_ALIGN
G(caml_start_program):
+ CFI_STARTPROC
PROFILE_C
/* Save callee-save registers */
pushl %ebx
pushl %esi
pushl %edi
pushl %ebp
+ CFI_ADJUST(16)
/* Initial entry point is caml_program */
movl $ G(caml_program), %esi
/* Common code for caml_start_program and caml_callback* */
@@ -238,6 +256,7 @@ LBL(106):
pushl $ LBL(108)
ALIGN_STACK(8)
pushl G(caml_exception_pointer)
+ CFI_ADJUST(20)
movl %esp, G(caml_exception_pointer)
/* Call the Caml code */
call *%esi
@@ -249,6 +268,7 @@ LBL(107):
#else
addl $4, %esp
#endif
+ CFI_ADJUST(-8)
LBL(109):
/* Pop the callback link, restoring the global variables */
popl G(caml_bottom_of_stack)
@@ -266,6 +286,7 @@ LBL(108):
/* Mark the bucket as an exception result and return it */
orl $2, %eax
jmp LBL(109)
+ CFI_ENDPROC
/* Raise an exception from Caml */
diff --git a/config/auto-aux/cfi.S b/config/auto-aux/cfi.S
new file mode 100644
index 0000000..e055423
--- /dev/null
+++ b/config/auto-aux/cfi.S
@@ -0,0 +1,3 @@
+.cfi_startproc
+.cfi_adjust_cfa_offset 8
+.cfi_endproc
diff --git a/config/auto-aux/tryassemble b/config/auto-aux/tryassemble
new file mode 100644
index 0000000..feffbed
--- /dev/null
+++ b/config/auto-aux/tryassemble
@@ -0,0 +1,7 @@
+#!/bin/sh
+if test "$verbose" = yes; then
+echo "tryassemble: $aspp -o tst $*" >&2
+$aspp -o tst $* || exit 100
+else
+$aspp -o tst $* 2> /dev/null || exit 100
+fi
diff --git a/configure b/configure
index 1797b0c..dc02da5 100755
--- a/configure
+++ b/configure
@@ -1518,6 +1518,17 @@ else
echo "TK_LINK=" >> Makefile
fi
+# Check whether assembler supports CFI directives
+
+asm_cfi_supported=false
+
+export aspp
+
+if sh ./tryassemble cfi.S; then
+ echo "#define ASM_CFI_SUPPORTED" >> m.h
+ asm_cfi_supported=true
+fi
+
# Final twiddling of compiler options to work around known bugs
nativeccprofopts="$nativecccompopts"
@@ -1585,6 +1596,7 @@ echo "CMXS=$cmxs" >> Makefile
echo "MKEXE=$mkexe" >> Makefile
echo "MKDLL=$mksharedlib" >> Makefile
echo "MKMAINDLL=$mkmaindll" >> Makefile
+echo "ASM_CFI_SUPPORTED=$asm_cfi_supported" >> Makefile
rm -f tst hasgot.c
rm -f ../m.h ../s.h ../Makefile
@@ -1629,6 +1641,11 @@ else
echo " options for linking....... $nativecclinkopts $cclibs"
echo " assembler ................ $as"
echo " preprocessed assembler ... $aspp"
+ if test "$asm_cfi_supported" = "true"; then
+ echo " assembler supports CFI ... yes"
+ else
+ echo " assembler supports CFI ... no"
+ fi
if test "$profiling" = "prof"; then
echo " profiling with gprof ..... supported"
else
diff --git a/utils/config.mlbuild b/utils/config.mlbuild
index d49ff62..ab1caec 100644
--- a/utils/config.mlbuild
+++ b/utils/config.mlbuild
@@ -87,6 +87,7 @@ let model = C.model
let system = C.system
let asm = C.asm
+let asm_cfi_supported = C.asm_cfi_supported
let ext_obj = C.ext_obj
let ext_asm = C.ext_asm
@@ -120,6 +121,7 @@ let print_config oc =
p "model" model;
p "system" system;
p "asm" asm;
+ p_bool "asm_cfi_supported" asm_cfi_supported;
p "ext_obj" ext_obj;
p "ext_asm" ext_asm;
p "ext_lib" ext_lib;
diff --git a/utils/config.mli b/utils/config.mli
index 92894b6..4f01fe8 100644
--- a/utils/config.mli
+++ b/utils/config.mli
@@ -96,6 +96,9 @@ val asm: string
(* The assembler (and flags) to use for assembling
ocamlopt-generated code. *)
+val asm_cfi_supported: bool
+ (* Whether assembler understands CFI directives *)
+
val ext_obj: string
(* Extension for object files, e.g. [.o] under Unix. *)
val ext_asm: string
diff --git a/utils/config.mlp b/utils/config.mlp
index 3f6d14e..9634d64 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -76,6 +76,7 @@ let model = "%%MODEL%%"
let system = "%%SYSTEM%%"
let asm = "%%ASM%%"
+let asm_cfi_supported = %%ASM_CFI_SUPPORTED%%
let ext_obj = "%%EXT_OBJ%%"
let ext_asm = "%%EXT_ASM%%"
@@ -109,6 +110,7 @@ let print_config oc =
p "model" model;
p "system" system;
p "asm" asm;
+ p_bool "asm_cfi_supported" asm_cfi_supported;
p "ext_obj" ext_obj;
p "ext_asm" ext_asm;
p "ext_lib" ext_lib;
ocaml-3.11-cfi.patch [^] (19,053 bytes) 2011-08-26 09:36 [Show Content] [Hide Content]diff --git a/Makefile b/Makefile
index 7da5ed2..abee977 100644
--- a/Makefile
+++ b/Makefile
@@ -387,6 +387,7 @@ utils/config.ml: utils/config.mlp config/Makefile
-e 's|%%EXT_DLL%%|.so|' \
-e 's|%%SYSTHREAD_SUPPORT%%|$(SYSTHREAD_SUPPORT)|' \
-e 's|%%ASM%%|$(ASM)|' \
+ -e 's|%%ASM_CFI_SUPPORTED%%|$(ASM_CFI_SUPPORTED)|' \
-e 's|%%MKDLL%%|$(MKDLL)|' \
-e 's|%%MKEXE%%|$(MKEXE)|' \
-e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index 0874579..0a328b7 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -308,11 +308,17 @@ let emit_float_test cmp neg arg lbl =
(* Deallocate the stack frame before a return or tail call *)
-let output_epilogue () =
+let output_epilogue f =
if frame_required() then begin
let n = frame_size() - 8 in
- ` addq ${emit_int n}, %rsp\n`
+ ` addq ${emit_int n}, %rsp\n`;
+ cfi_adjust_cfa_offset (-n);
+ f ();
+ (* reset CFA back cause function body may continue *)
+ cfi_adjust_cfa_offset n
end
+ else
+ f ()
(* Output the assembly code for an instruction *)
@@ -361,14 +367,16 @@ let emit_instr fallthrough i =
` {emit_call s}\n`;
record_frame i.live i.dbg
| Lop(Itailcall_ind) ->
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp *{emit_reg i.arg.(0)}\n`
+ end
| Lop(Itailcall_imm s) ->
if s = !function_name then
` jmp {emit_label !tailrec_entry_point}\n`
else begin
- output_epilogue();
+ output_epilogue begin fun () ->
` {emit_jump s}\n`
+ end
end
| Lop(Iextcall(s, alloc)) ->
if alloc then begin
@@ -382,6 +390,7 @@ let emit_instr fallthrough i =
if n < 0
then ` addq ${emit_int(-n)}, %rsp\n`
else ` subq ${emit_int(n)}, %rsp\n`;
+ cfi_adjust_cfa_offset n;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
@@ -524,8 +533,9 @@ let emit_instr fallthrough i =
| Lreloadretaddr ->
()
| Lreturn ->
- output_epilogue();
+ output_epilogue begin fun () ->
` ret\n`
+ end
| Llabel lbl ->
`{emit_Llabel fallthrough lbl}:\n`
| Lbranch lbl ->
@@ -601,12 +611,16 @@ let emit_instr fallthrough i =
| Lsetuptrap lbl ->
` call {emit_label lbl}\n`
| Lpushtrap ->
+ cfi_adjust_cfa_offset 8;
` pushq %r14\n`;
+ cfi_adjust_cfa_offset 8;
` movq %rsp, %r14\n`;
stack_offset := !stack_offset + 16
| Lpoptrap ->
` popq %r14\n`;
+ cfi_adjust_cfa_offset (-8);
` addq $8, %rsp\n`;
+ cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset - 16
| Lraise ->
if !Clflags.debug then begin
@@ -670,15 +684,18 @@ let fundecl fundecl =
else
` .globl {emit_symbol fundecl.fun_name}\n`;
`{emit_symbol fundecl.fun_name}:\n`;
+ cfi_startproc ();
if !Clflags.gprofile then emit_profile();
if frame_required() then begin
let n = frame_size() - 8 in
- ` subq ${emit_int n}, %rsp\n`
+ ` subq ${emit_int n}, %rsp\n`;
+ cfi_adjust_cfa_offset n;
end;
`{emit_label !tailrec_entry_point}:\n`;
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
+ cfi_endproc ();
if !float_constants <> [] then begin
if macosx
then ` .literal8\n`
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
index 35338ee..a565783 100644
--- a/asmcomp/emitaux.ml
+++ b/asmcomp/emitaux.ml
@@ -190,3 +190,21 @@ let is_generic_function name =
(fun p -> isprefix p name)
["caml_apply"; "caml_curry"; "caml_send"; "caml_tuplify"]
+(* CFI directives *)
+
+let is_cfi_enabled () =
+ !Clflags.debug && Config.asm_cfi_supported
+
+let cfi_startproc () =
+ if is_cfi_enabled () then
+ emit_string " .cfi_startproc\n"
+
+let cfi_endproc () =
+ if is_cfi_enabled () then
+ emit_string " .cfi_endproc\n"
+
+let cfi_adjust_cfa_offset n =
+ if is_cfi_enabled () then
+ begin
+ emit_string " .cfi_adjust_cfa_offset "; emit_int n; emit_string "\n";
+ end
diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli
index 4f666be..4c7703b 100644
--- a/asmcomp/emitaux.mli
+++ b/asmcomp/emitaux.mli
@@ -50,3 +50,7 @@ type emit_frame_actions =
val emit_frames: emit_frame_actions -> unit
val is_generic_function: string -> bool
+
+val cfi_startproc : unit -> unit
+val cfi_endproc : unit -> unit
+val cfi_adjust_cfa_offset : int -> unit
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index 7588120..4c1c646 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -309,9 +309,18 @@ let output_test_zero arg =
(* Deallocate the stack frame before a return or tail call *)
-let output_epilogue () =
+let output_epilogue f =
let n = frame_size() - 4 in
- if n > 0 then ` addl ${emit_int n}, %esp\n`
+ if n > 0 then
+ begin
+ ` addl ${emit_int n}, %esp\n`;
+ cfi_adjust_cfa_offset (-n);
+ f ();
+ (* reset CFA back cause function body may continue *)
+ cfi_adjust_cfa_offset n
+ end
+ else
+ f ()
(* Determine if the given register is the top of the floating-point stack *)
@@ -463,14 +472,16 @@ let emit_instr fallthrough i =
` call {emit_symbol s}\n`;
record_frame i.live i.dbg
| Lop(Itailcall_ind) ->
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp *{emit_reg i.arg.(0)}\n`
+ end
| Lop(Itailcall_imm s) ->
if s = !function_name then
` jmp {emit_label !tailrec_entry_point}\n`
else begin
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp {emit_symbol s}\n`
+ end
end
| Lop(Iextcall(s, alloc)) ->
if alloc then begin
@@ -496,6 +507,7 @@ let emit_instr fallthrough i =
if n < 0
then ` addl ${emit_int(-n)}, %esp\n`
else ` subl ${emit_int(n)}, %esp\n`;
+ cfi_adjust_cfa_offset n;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
@@ -649,6 +661,7 @@ let emit_instr fallthrough i =
` fldl {emit_reg i.arg.(0)}\n`;
stack_offset := !stack_offset - 8;
` subl $8, %esp\n`;
+ cfi_adjust_cfa_offset 8;
` fnstcw 4(%esp)\n`;
` movw 4(%esp), %ax\n`;
` movb $12, %ah\n`;
@@ -663,6 +676,7 @@ let emit_instr fallthrough i =
end;
` fldcw 4(%esp)\n`;
` addl $8, %esp\n`;
+ cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset + 8
| Lop(Ispecific(Ilea addr)) ->
` lea {emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n`
@@ -679,29 +693,36 @@ let emit_instr fallthrough i =
match r with
{loc = Reg _; typ = Float} ->
` subl $8, %esp\n`;
+ cfi_adjust_cfa_offset 8;
` fstpl 0(%esp)\n`;
stack_offset := !stack_offset + 8
| {loc = Stack sl; typ = Float} ->
let ofs = slot_offset sl 1 in
` pushl {emit_int(ofs + 4)}(%esp)\n`;
` pushl {emit_int(ofs + 4)}(%esp)\n`;
+ cfi_adjust_cfa_offset 8;
stack_offset := !stack_offset + 8
| _ ->
` pushl {emit_reg r}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
done
| Lop(Ispecific(Ipush_int n)) ->
` pushl ${emit_nativeint n}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_symbol s)) ->
` pushl ${emit_symbol s}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_load addr)) ->
` pushl {emit_addressing addr i.arg 0}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_load_float addr)) ->
` pushl {emit_addressing (offset_addressing addr 4) i.arg 0}\n`;
` pushl {emit_addressing addr i.arg 0}\n`;
+ cfi_adjust_cfa_offset 8;
stack_offset := !stack_offset + 8
| Lop(Ispecific(Ifloatarithmem(double, op, addr))) ->
if not (is_tos i.arg.(0)) then
@@ -719,8 +740,9 @@ let emit_instr fallthrough i =
| Lreloadretaddr ->
()
| Lreturn ->
- output_epilogue();
+ output_epilogue begin fun () ->
` ret\n`
+ end
| Llabel lbl ->
`{emit_Llabel fallthrough lbl}:\n`
| Lbranch lbl ->
@@ -784,11 +806,13 @@ let emit_instr fallthrough i =
if trap_frame_size > 8 then
` subl ${emit_int (trap_frame_size - 8)}, %esp\n`;
` pushl {emit_symbol "caml_exception_pointer"}\n`;
+ cfi_adjust_cfa_offset trap_frame_size;
` movl %esp, {emit_symbol "caml_exception_pointer"}\n`;
stack_offset := !stack_offset + trap_frame_size
| Lpoptrap ->
` popl {emit_symbol "caml_exception_pointer"}\n`;
` addl ${emit_int (trap_frame_size - 4)}, %esp\n`;
+ cfi_adjust_cfa_offset (-trap_frame_size);
stack_offset := !stack_offset - trap_frame_size
| Lraise ->
if !Clflags.debug then begin
@@ -897,14 +921,19 @@ let fundecl fundecl =
else
` .globl {emit_symbol fundecl.fun_name}\n`;
`{emit_symbol fundecl.fun_name}:\n`;
+ cfi_startproc ();
if !Clflags.gprofile then emit_profile();
let n = frame_size() - 4 in
if n > 0 then
+ begin
` subl ${emit_int n}, %esp\n`;
+ cfi_adjust_cfa_offset n;
+ end;
`{emit_label !tailrec_entry_point}:\n`;
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
+ cfi_endproc ();
List.iter emit_float_constant !float_constants;
match Config.system with
"linux_elf" | "bsd_elf" | "gnu" ->
diff --git a/asmrun/amd64.S b/asmrun/amd64.S
index e1bec27..2404a3b 100644
--- a/asmrun/amd64.S
+++ b/asmrun/amd64.S
@@ -16,6 +16,8 @@
/* Asm part of the runtime system, AMD64 processor */
/* Must be preprocessed by cpp */
+#include "../config/m.h"
+
#ifdef SYS_macosx
#define G(r) _##r
@@ -41,12 +43,23 @@
#endif
+#ifdef ASM_CFI_SUPPORTED
+#define CFI_STARTPROC .cfi_startproc
+#define CFI_ENDPROC .cfi_endproc
+#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#endif
+
.text
/* Allocation */
FUNCTION(G(caml_call_gc))
+ CFI_STARTPROC
/* Record lowest stack address and return address */
movq 0(%rsp), %rax
movq %rax, G(caml_last_return_address)(%rip)
@@ -73,6 +86,7 @@ FUNCTION(G(caml_call_gc))
movq %rsp, G(caml_gc_regs)(%rip)
/* Save floating-point registers */
subq $(16*8), %rsp
+ CFI_ADJUST(232)
movlpd %xmm0, 0*8(%rsp)
movlpd %xmm1, 1*8(%rsp)
movlpd %xmm2, 2*8(%rsp)
@@ -122,11 +136,13 @@ FUNCTION(G(caml_call_gc))
popq %rbp
popq %r12
popq %r13
+ CFI_ADJUST(-232)
/* Restore caml_young_ptr, caml_exception_pointer */
movq G(caml_young_ptr)(%rip), %r15
movq G(caml_exception_pointer)(%rip), %r14
/* Return to caller */
ret
+ CFI_ENDPROC
FUNCTION(G(caml_alloc1))
subq $16, %r15
@@ -209,6 +225,7 @@ FUNCTION(G(caml_c_call))
/* Start the Caml program */
FUNCTION(G(caml_start_program))
+ CFI_STARTPROC
/* Save callee-save registers */
pushq %rbx
pushq %rbp
@@ -217,6 +234,7 @@ FUNCTION(G(caml_start_program))
pushq %r14
pushq %r15
subq $8, %rsp /* stack 16-aligned */
+ CFI_ADJUST(56)
/* Initial entry point is G(caml_program) */
leaq G(caml_program)(%rip), %r12
/* Common code for caml_start_program and caml_callback* */
@@ -226,6 +244,7 @@ FUNCTION(G(caml_start_program))
pushq G(caml_gc_regs)(%rip)
pushq G(caml_last_return_address)(%rip)
pushq G(caml_bottom_of_stack)(%rip)
+ CFI_ADJUST(32)
/* Setup alloc ptr and exception ptr */
movq G(caml_young_ptr)(%rip), %r15
movq G(caml_exception_pointer)(%rip), %r14
@@ -233,6 +252,7 @@ FUNCTION(G(caml_start_program))
lea .L108(%rip), %r13
pushq %r13
pushq %r14
+ CFI_ADJUST(16)
movq %rsp, %r14
/* Call the Caml code */
call *%r12
@@ -240,6 +260,7 @@ FUNCTION(G(caml_start_program))
/* Pop the exception handler */
popq %r14
popq %r12 /* dummy register */
+ CFI_ADJUST(-16)
.L109:
/* Update alloc ptr and exception ptr */
movq %r15, G(caml_young_ptr)(%rip)
@@ -264,6 +285,7 @@ FUNCTION(G(caml_start_program))
/* Mark the bucket as an exception result and return it */
orq $2, %rax
jmp .L109
+ CFI_ENDPROC
/* Raise an exception from Caml */
diff --git a/asmrun/i386.S b/asmrun/i386.S
index 73ac467..25eadd2 100644
--- a/asmrun/i386.S
+++ b/asmrun/i386.S
@@ -16,6 +16,8 @@
/* Asm part of the runtime system, Intel 386 processor */
/* Must be preprocessed by cpp */
+#include "../config/m.h"
+
/* Linux/BSD with ELF binaries and Solaris do not prefix identifiers with _.
Linux/BSD with a.out binaries and NextStep do. */
@@ -42,6 +44,16 @@
#define FUNCTION_ALIGN 2
#endif
+#ifdef ASM_CFI_SUPPORTED
+#define CFI_STARTPROC .cfi_startproc
+#define CFI_ENDPROC .cfi_endproc
+#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#endif
+
#if defined(PROFILING)
#if defined(SYS_linux_elf) || defined(SYS_gnu)
#define PROFILE_CAML \
@@ -89,6 +101,7 @@
.align FUNCTION_ALIGN
G(caml_call_gc):
+ CFI_STARTPROC
PROFILE_CAML
/* Record lowest stack address and return address */
movl 0(%esp), %eax
@@ -104,6 +117,7 @@ LBL(105):
pushl %ecx
pushl %ebx
pushl %eax
+ CFI_ADJUST(28)
movl %esp, G(caml_gc_regs)
/* MacOSX note: 16-alignment of stack preserved at this point */
/* Call the garbage collector */
@@ -116,8 +130,10 @@ LBL(105):
popl %esi
popl %edi
popl %ebp
+ CFI_ADJUST(-28)
/* Return to caller */
ret
+ CFI_ENDPROC
.align FUNCTION_ALIGN
G(caml_alloc1):
@@ -219,12 +235,14 @@ G(caml_c_call):
.globl G(caml_start_program)
.align FUNCTION_ALIGN
G(caml_start_program):
+ CFI_STARTPROC
PROFILE_C
/* Save callee-save registers */
pushl %ebx
pushl %esi
pushl %edi
pushl %ebp
+ CFI_ADJUST(16)
/* Initial entry point is caml_program */
movl $ G(caml_program), %esi
/* Common code for caml_start_program and caml_callback* */
@@ -238,6 +256,7 @@ LBL(106):
pushl $ LBL(108)
ALIGN_STACK(8)
pushl G(caml_exception_pointer)
+ CFI_ADJUST(20)
movl %esp, G(caml_exception_pointer)
/* Call the Caml code */
call *%esi
@@ -249,6 +268,7 @@ LBL(107):
#else
addl $4, %esp
#endif
+ CFI_ADJUST(-8)
LBL(109):
/* Pop the callback link, restoring the global variables */
popl G(caml_bottom_of_stack)
@@ -266,6 +286,7 @@ LBL(108):
/* Mark the bucket as an exception result and return it */
orl $2, %eax
jmp LBL(109)
+ CFI_ENDPROC
/* Raise an exception from Caml */
diff --git a/config/auto-aux/cfi.S b/config/auto-aux/cfi.S
new file mode 100644
index 0000000..e055423
--- /dev/null
+++ b/config/auto-aux/cfi.S
@@ -0,0 +1,3 @@
+.cfi_startproc
+.cfi_adjust_cfa_offset 8
+.cfi_endproc
diff --git a/config/auto-aux/tryassemble b/config/auto-aux/tryassemble
new file mode 100644
index 0000000..feffbed
--- /dev/null
+++ b/config/auto-aux/tryassemble
@@ -0,0 +1,7 @@
+#!/bin/sh
+if test "$verbose" = yes; then
+echo "tryassemble: $aspp -o tst $*" >&2
+$aspp -o tst $* || exit 100
+else
+$aspp -o tst $* 2> /dev/null || exit 100
+fi
diff --git a/configure b/configure
index a59b801..cab256e 100755
--- a/configure
+++ b/configure
@@ -1518,6 +1518,17 @@ else
echo "TK_LINK=" >> Makefile
fi
+# Check whether assembler supports CFI directives
+
+asm_cfi_supported=false
+
+export aspp
+
+if sh ./tryassemble cfi.S; then
+ echo "#define ASM_CFI_SUPPORTED" >> m.h
+ asm_cfi_supported=true
+fi
+
# Final twiddling of compiler options to work around known bugs
nativeccprofopts="$nativecccompopts"
@@ -1585,6 +1596,7 @@ echo "CMXS=$cmxs" >> Makefile
echo "MKEXE=$mkexe" >> Makefile
echo "MKDLL=$mksharedlib" >> Makefile
echo "MKMAINDLL=$mkmaindll" >> Makefile
+echo "ASM_CFI_SUPPORTED=$asm_cfi_supported" >> Makefile
rm -f tst hasgot.c
rm -f ../m.h ../s.h ../Makefile
@@ -1629,6 +1641,11 @@ else
echo " options for linking....... $nativecclinkopts $cclibs"
echo " assembler ................ $as"
echo " preprocessed assembler ... $aspp"
+ if test "$asm_cfi_supported" = "true"; then
+ echo " assembler supports CFI ... yes"
+ else
+ echo " assembler supports CFI ... no"
+ fi
if test "$profiling" = "prof"; then
echo " profiling with gprof ..... supported"
else
diff --git a/utils/config.mlbuild b/utils/config.mlbuild
index ea10032..e233545 100644
--- a/utils/config.mlbuild
+++ b/utils/config.mlbuild
@@ -87,6 +87,7 @@ let model = C.model
let system = C.system
let asm = C.asm
+let asm_cfi_supported = C.asm_cfi_supported
let ext_obj = C.ext_obj
let ext_asm = C.ext_asm
@@ -120,6 +121,7 @@ let print_config oc =
p "model" model;
p "system" system;
p "asm" asm;
+ p_bool "asm_cfi_supported" asm_cfi_supported;
p "ext_obj" ext_obj;
p "ext_asm" ext_asm;
p "ext_lib" ext_lib;
diff --git a/utils/config.mli b/utils/config.mli
index ef46b25..e72ebca 100644
--- a/utils/config.mli
+++ b/utils/config.mli
@@ -96,6 +96,9 @@ val asm: string
(* The assembler (and flags) to use for assembling
ocamlopt-generated code. *)
+val asm_cfi_supported: bool
+ (* Whether assembler understands CFI directives *)
+
val ext_obj: string
(* Extension for object files, e.g. [.o] under Unix. *)
val ext_asm: string
diff --git a/utils/config.mlp b/utils/config.mlp
index c30254b..dd61744 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -76,6 +76,7 @@ let model = "%%MODEL%%"
let system = "%%SYSTEM%%"
let asm = "%%ASM%%"
+let asm_cfi_supported = %%ASM_CFI_SUPPORTED%%
let ext_obj = "%%EXT_OBJ%%"
let ext_asm = "%%EXT_ASM%%"
@@ -109,6 +110,7 @@ let print_config oc =
p "model" model;
p "system" system;
p "asm" asm;
+ p_bool "asm_cfi_supported" asm_cfi_supported;
p "ext_obj" ext_obj;
p "ext_asm" ext_asm;
p "ext_lib" ext_lib;
ocaml-3.12-cfi.patch [^] (18,978 bytes) 2011-08-26 09:36 [Show Content] [Hide Content]diff --git a/Makefile b/Makefile
index ba24578..21bb3b3 100644
--- a/Makefile
+++ b/Makefile
@@ -392,6 +392,7 @@ utils/config.ml: utils/config.mlp config/Makefile
-e 's|%%EXT_DLL%%|.so|' \
-e 's|%%SYSTHREAD_SUPPORT%%|$(SYSTHREAD_SUPPORT)|' \
-e 's|%%ASM%%|$(ASM)|' \
+ -e 's|%%ASM_CFI_SUPPORTED%%|$(ASM_CFI_SUPPORTED)|' \
-e 's|%%MKDLL%%|$(MKDLL)|' \
-e 's|%%MKEXE%%|$(MKEXE)|' \
-e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index a33a0fa..0fcdd71 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -317,11 +317,17 @@ let emit_float_test cmp neg arg lbl =
(* Deallocate the stack frame before a return or tail call *)
-let output_epilogue () =
+let output_epilogue f =
if frame_required() then begin
let n = frame_size() - 8 in
- ` addq ${emit_int n}, %rsp\n`
+ ` addq ${emit_int n}, %rsp\n`;
+ cfi_adjust_cfa_offset (-n);
+ f ();
+ (* reset CFA back cause function body may continue *)
+ cfi_adjust_cfa_offset n
end
+ else
+ f ()
(* Output the assembly code for an instruction *)
@@ -373,14 +379,16 @@ let emit_instr fallthrough i =
` {emit_call s}\n`;
record_frame i.live i.dbg
| Lop(Itailcall_ind) ->
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp *{emit_reg i.arg.(0)}\n`
+ end
| Lop(Itailcall_imm s) ->
if s = !function_name then
` jmp {emit_label !tailrec_entry_point}\n`
else begin
- output_epilogue();
+ output_epilogue begin fun () ->
` {emit_jump s}\n`
+ end
end
| Lop(Iextcall(s, alloc)) ->
if alloc then begin
@@ -394,6 +402,7 @@ let emit_instr fallthrough i =
if n < 0
then ` addq ${emit_int(-n)}, %rsp\n`
else ` subq ${emit_int(n)}, %rsp\n`;
+ cfi_adjust_cfa_offset n;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
@@ -536,8 +545,9 @@ let emit_instr fallthrough i =
| Lreloadretaddr ->
()
| Lreturn ->
- output_epilogue();
+ output_epilogue begin fun () ->
` ret\n`
+ end
| Llabel lbl ->
`{emit_Llabel fallthrough lbl}:\n`
| Lbranch lbl ->
@@ -613,12 +623,16 @@ let emit_instr fallthrough i =
| Lsetuptrap lbl ->
` call {emit_label lbl}\n`
| Lpushtrap ->
+ cfi_adjust_cfa_offset 8;
` pushq %r14\n`;
+ cfi_adjust_cfa_offset 8;
` movq %rsp, %r14\n`;
stack_offset := !stack_offset + 16
| Lpoptrap ->
` popq %r14\n`;
+ cfi_adjust_cfa_offset (-8);
` addq $8, %rsp\n`;
+ cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset - 16
| Lraise ->
if !Clflags.debug then begin
@@ -682,15 +696,18 @@ let fundecl fundecl =
else
` .globl {emit_symbol fundecl.fun_name}\n`;
`{emit_symbol fundecl.fun_name}:\n`;
+ cfi_startproc ();
if !Clflags.gprofile then emit_profile();
if frame_required() then begin
let n = frame_size() - 8 in
- ` subq ${emit_int n}, %rsp\n`
+ ` subq ${emit_int n}, %rsp\n`;
+ cfi_adjust_cfa_offset n;
end;
`{emit_label !tailrec_entry_point}:\n`;
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
+ cfi_endproc ();
begin match Config.system with
"linux" | "gnu" ->
` .type {emit_symbol fundecl.fun_name},@function\n`;
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
index d4db78a..a0ef586 100644
--- a/asmcomp/emitaux.ml
+++ b/asmcomp/emitaux.ml
@@ -189,3 +189,23 @@ let is_generic_function name =
List.exists
(fun p -> isprefix p name)
["caml_apply"; "caml_curry"; "caml_send"; "caml_tuplify"]
+
+(* CFI directives *)
+
+let is_cfi_enabled () =
+ !Clflags.debug && Config.asm_cfi_supported
+
+let cfi_startproc () =
+ if is_cfi_enabled () then
+ emit_string " .cfi_startproc\n"
+
+let cfi_endproc () =
+ if is_cfi_enabled () then
+ emit_string " .cfi_endproc\n"
+
+let cfi_adjust_cfa_offset n =
+ if is_cfi_enabled () then
+ begin
+ emit_string " .cfi_adjust_cfa_offset "; emit_int n; emit_string "\n";
+ end
+
diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli
index 4f666be..4c7703b 100644
--- a/asmcomp/emitaux.mli
+++ b/asmcomp/emitaux.mli
@@ -50,3 +50,7 @@ type emit_frame_actions =
val emit_frames: emit_frame_actions -> unit
val is_generic_function: string -> bool
+
+val cfi_startproc : unit -> unit
+val cfi_endproc : unit -> unit
+val cfi_adjust_cfa_offset : int -> unit
diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp
index 881a936..167a3d6 100644
--- a/asmcomp/i386/emit.mlp
+++ b/asmcomp/i386/emit.mlp
@@ -309,9 +309,18 @@ let output_test_zero arg =
(* Deallocate the stack frame before a return or tail call *)
-let output_epilogue () =
+let output_epilogue f =
let n = frame_size() - 4 in
- if n > 0 then ` addl ${emit_int n}, %esp\n`
+ if n > 0 then
+ begin
+ ` addl ${emit_int n}, %esp\n`;
+ cfi_adjust_cfa_offset (-n);
+ f ();
+ (* reset CFA back cause function body may continue *)
+ cfi_adjust_cfa_offset n
+ end
+ else
+ f ()
(* Determine if the given register is the top of the floating-point stack *)
@@ -463,14 +472,16 @@ let emit_instr fallthrough i =
` call {emit_symbol s}\n`;
record_frame i.live i.dbg
| Lop(Itailcall_ind) ->
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp *{emit_reg i.arg.(0)}\n`
+ end
| Lop(Itailcall_imm s) ->
if s = !function_name then
` jmp {emit_label !tailrec_entry_point}\n`
else begin
- output_epilogue();
+ output_epilogue begin fun () ->
` jmp {emit_symbol s}\n`
+ end
end
| Lop(Iextcall(s, alloc)) ->
if alloc then begin
@@ -496,6 +507,7 @@ let emit_instr fallthrough i =
if n < 0
then ` addl ${emit_int(-n)}, %esp\n`
else ` subl ${emit_int(n)}, %esp\n`;
+ cfi_adjust_cfa_offset n;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
@@ -649,6 +661,7 @@ let emit_instr fallthrough i =
` fldl {emit_reg i.arg.(0)}\n`;
stack_offset := !stack_offset - 8;
` subl $8, %esp\n`;
+ cfi_adjust_cfa_offset 8;
` fnstcw 4(%esp)\n`;
` movw 4(%esp), %ax\n`;
` movb $12, %ah\n`;
@@ -663,6 +676,7 @@ let emit_instr fallthrough i =
end;
` fldcw 4(%esp)\n`;
` addl $8, %esp\n`;
+ cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset + 8
| Lop(Ispecific(Ilea addr)) ->
` lea {emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n`
@@ -679,29 +693,36 @@ let emit_instr fallthrough i =
match r with
{loc = Reg _; typ = Float} ->
` subl $8, %esp\n`;
+ cfi_adjust_cfa_offset 8;
` fstpl 0(%esp)\n`;
stack_offset := !stack_offset + 8
| {loc = Stack sl; typ = Float} ->
let ofs = slot_offset sl 1 in
` pushl {emit_int(ofs + 4)}(%esp)\n`;
` pushl {emit_int(ofs + 4)}(%esp)\n`;
+ cfi_adjust_cfa_offset 8;
stack_offset := !stack_offset + 8
| _ ->
` pushl {emit_reg r}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
done
| Lop(Ispecific(Ipush_int n)) ->
` pushl ${emit_nativeint n}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_symbol s)) ->
` pushl ${emit_symbol s}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_load addr)) ->
` pushl {emit_addressing addr i.arg 0}\n`;
+ cfi_adjust_cfa_offset 4;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_load_float addr)) ->
` pushl {emit_addressing (offset_addressing addr 4) i.arg 0}\n`;
` pushl {emit_addressing addr i.arg 0}\n`;
+ cfi_adjust_cfa_offset 8;
stack_offset := !stack_offset + 8
| Lop(Ispecific(Ifloatarithmem(double, op, addr))) ->
if not (is_tos i.arg.(0)) then
@@ -719,8 +740,9 @@ let emit_instr fallthrough i =
| Lreloadretaddr ->
()
| Lreturn ->
- output_epilogue();
+ output_epilogue begin fun () ->
` ret\n`
+ end
| Llabel lbl ->
`{emit_Llabel fallthrough lbl}:\n`
| Lbranch lbl ->
@@ -784,11 +806,13 @@ let emit_instr fallthrough i =
if trap_frame_size > 8 then
` subl ${emit_int (trap_frame_size - 8)}, %esp\n`;
` pushl {emit_symbol "caml_exception_pointer"}\n`;
+ cfi_adjust_cfa_offset trap_frame_size;
` movl %esp, {emit_symbol "caml_exception_pointer"}\n`;
stack_offset := !stack_offset + trap_frame_size
| Lpoptrap ->
` popl {emit_symbol "caml_exception_pointer"}\n`;
` addl ${emit_int (trap_frame_size - 4)}, %esp\n`;
+ cfi_adjust_cfa_offset (-trap_frame_size);
stack_offset := !stack_offset - trap_frame_size
| Lraise ->
if !Clflags.debug then begin
@@ -897,14 +921,19 @@ let fundecl fundecl =
else
` .globl {emit_symbol fundecl.fun_name}\n`;
`{emit_symbol fundecl.fun_name}:\n`;
+ cfi_startproc ();
if !Clflags.gprofile then emit_profile();
let n = frame_size() - 4 in
if n > 0 then
+ begin
` subl ${emit_int n}, %esp\n`;
+ cfi_adjust_cfa_offset n;
+ end;
`{emit_label !tailrec_entry_point}:\n`;
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
+ cfi_endproc ();
begin match Config.system with
"linux_elf" | "bsd_elf" | "gnu" ->
` .type {emit_symbol fundecl.fun_name},@function\n`;
diff --git a/asmrun/amd64.S b/asmrun/amd64.S
index 645c2e6..589d72c 100644
--- a/asmrun/amd64.S
+++ b/asmrun/amd64.S
@@ -18,6 +18,8 @@
/* PIC mode support based on contribution by Paul Stravers (see PR#4795) */
+#include "../config/m.h"
+
#ifdef SYS_macosx
#define G(r) _##r
@@ -47,6 +49,16 @@
#endif
+#ifdef ASM_CFI_SUPPORTED
+#define CFI_STARTPROC .cfi_startproc
+#define CFI_ENDPROC .cfi_endproc
+#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#endif
+
#ifdef __PIC__
/* Position-independent operations on global variables. */
@@ -125,6 +137,7 @@
/* Allocation */
FUNCTION(G(caml_call_gc))
+ CFI_STARTPROC
RECORD_STACK_FRAME(0)
.Lcaml_call_gc:
/* Build array of registers, save it into caml_gc_regs */
@@ -147,6 +160,7 @@ FUNCTION(G(caml_call_gc))
STORE_VAR(%r14, caml_exception_pointer)
/* Save floating-point registers */
subq $(16*8), %rsp
+ CFI_ADJUST(232)
movsd %xmm0, 0*8(%rsp)
movsd %xmm1, 1*8(%rsp)
movsd %xmm2, 2*8(%rsp)
@@ -199,8 +213,10 @@ FUNCTION(G(caml_call_gc))
popq %rbp
popq %r12
popq %r13
+ CFI_ADJUST(-232)
/* Return to caller */
ret
+ CFI_ENDPROC
FUNCTION(G(caml_alloc1))
.Lcaml_alloc1:
@@ -277,6 +293,7 @@ FUNCTION(G(caml_c_call))
/* Start the Caml program */
FUNCTION(G(caml_start_program))
+ CFI_STARTPROC
/* Save callee-save registers */
pushq %rbx
pushq %rbp
@@ -285,6 +302,7 @@ FUNCTION(G(caml_start_program))
pushq %r14
pushq %r15
subq $8, %rsp /* stack 16-aligned */
+ CFI_ADJUST(56)
/* Initial entry point is G(caml_program) */
leaq GCALL(caml_program)(%rip), %r12
/* Common code for caml_start_program and caml_callback* */
@@ -294,6 +312,7 @@ FUNCTION(G(caml_start_program))
PUSH_VAR(caml_gc_regs)
PUSH_VAR(caml_last_return_address)
PUSH_VAR(caml_bottom_of_stack)
+ CFI_ADJUST(32)
/* Setup alloc ptr and exception ptr */
LOAD_VAR(caml_young_ptr, %r15)
LOAD_VAR(caml_exception_pointer, %r14)
@@ -301,6 +320,7 @@ FUNCTION(G(caml_start_program))
lea .L108(%rip), %r13
pushq %r13
pushq %r14
+ CFI_ADJUST(16)
movq %rsp, %r14
/* Call the Caml code */
call *%r12
@@ -308,6 +328,7 @@ FUNCTION(G(caml_start_program))
/* Pop the exception handler */
popq %r14
popq %r12 /* dummy register */
+ CFI_ADJUST(-16)
.L109:
/* Update alloc ptr and exception ptr */
STORE_VAR(%r15,caml_young_ptr)
@@ -332,6 +353,7 @@ FUNCTION(G(caml_start_program))
/* Mark the bucket as an exception result and return it */
orq $2, %rax
jmp .L109
+ CFI_ENDPROC
/* Raise an exception from Caml */
diff --git a/asmrun/i386.S b/asmrun/i386.S
index 73ac467..25eadd2 100644
--- a/asmrun/i386.S
+++ b/asmrun/i386.S
@@ -16,6 +16,8 @@
/* Asm part of the runtime system, Intel 386 processor */
/* Must be preprocessed by cpp */
+#include "../config/m.h"
+
/* Linux/BSD with ELF binaries and Solaris do not prefix identifiers with _.
Linux/BSD with a.out binaries and NextStep do. */
@@ -42,6 +44,16 @@
#define FUNCTION_ALIGN 2
#endif
+#ifdef ASM_CFI_SUPPORTED
+#define CFI_STARTPROC .cfi_startproc
+#define CFI_ENDPROC .cfi_endproc
+#define CFI_ADJUST(n) .cfi_adjust_cfa_offset n
+#else
+#define CFI_STARTPROC
+#define CFI_ENDPROC
+#define CFI_ADJUST(n)
+#endif
+
#if defined(PROFILING)
#if defined(SYS_linux_elf) || defined(SYS_gnu)
#define PROFILE_CAML \
@@ -89,6 +101,7 @@
.align FUNCTION_ALIGN
G(caml_call_gc):
+ CFI_STARTPROC
PROFILE_CAML
/* Record lowest stack address and return address */
movl 0(%esp), %eax
@@ -104,6 +117,7 @@ LBL(105):
pushl %ecx
pushl %ebx
pushl %eax
+ CFI_ADJUST(28)
movl %esp, G(caml_gc_regs)
/* MacOSX note: 16-alignment of stack preserved at this point */
/* Call the garbage collector */
@@ -116,8 +130,10 @@ LBL(105):
popl %esi
popl %edi
popl %ebp
+ CFI_ADJUST(-28)
/* Return to caller */
ret
+ CFI_ENDPROC
.align FUNCTION_ALIGN
G(caml_alloc1):
@@ -219,12 +235,14 @@ G(caml_c_call):
.globl G(caml_start_program)
.align FUNCTION_ALIGN
G(caml_start_program):
+ CFI_STARTPROC
PROFILE_C
/* Save callee-save registers */
pushl %ebx
pushl %esi
pushl %edi
pushl %ebp
+ CFI_ADJUST(16)
/* Initial entry point is caml_program */
movl $ G(caml_program), %esi
/* Common code for caml_start_program and caml_callback* */
@@ -238,6 +256,7 @@ LBL(106):
pushl $ LBL(108)
ALIGN_STACK(8)
pushl G(caml_exception_pointer)
+ CFI_ADJUST(20)
movl %esp, G(caml_exception_pointer)
/* Call the Caml code */
call *%esi
@@ -249,6 +268,7 @@ LBL(107):
#else
addl $4, %esp
#endif
+ CFI_ADJUST(-8)
LBL(109):
/* Pop the callback link, restoring the global variables */
popl G(caml_bottom_of_stack)
@@ -266,6 +286,7 @@ LBL(108):
/* Mark the bucket as an exception result and return it */
orl $2, %eax
jmp LBL(109)
+ CFI_ENDPROC
/* Raise an exception from Caml */
diff --git a/config/auto-aux/cfi.S b/config/auto-aux/cfi.S
new file mode 100644
index 0000000..e055423
--- /dev/null
+++ b/config/auto-aux/cfi.S
@@ -0,0 +1,3 @@
+.cfi_startproc
+.cfi_adjust_cfa_offset 8
+.cfi_endproc
diff --git a/config/auto-aux/tryassemble b/config/auto-aux/tryassemble
new file mode 100755
index 0000000..feffbed
--- /dev/null
+++ b/config/auto-aux/tryassemble
@@ -0,0 +1,7 @@
+#!/bin/sh
+if test "$verbose" = yes; then
+echo "tryassemble: $aspp -o tst $*" >&2
+$aspp -o tst $* || exit 100
+else
+$aspp -o tst $* 2> /dev/null || exit 100
+fi
diff --git a/configure b/configure
index e7c07df..465d5a3 100755
--- a/configure
+++ b/configure
@@ -1585,6 +1585,17 @@ else
echo "LIBBFD_LINK=" >> Makefile
fi
+# Check whether assembler supports CFI directives
+
+asm_cfi_supported=false
+
+export aspp
+
+if sh ./tryassemble cfi.S; then
+ echo "#define ASM_CFI_SUPPORTED" >> m.h
+ asm_cfi_supported=true
+fi
+
# Final twiddling of compiler options to work around known bugs
nativeccprofopts="$nativecccompopts"
@@ -1654,6 +1665,7 @@ echo "CMXS=$cmxs" >> Makefile
echo "MKEXE=$mkexe" >> Makefile
echo "MKDLL=$mksharedlib" >> Makefile
echo "MKMAINDLL=$mkmaindll" >> Makefile
+echo "ASM_CFI_SUPPORTED=$asm_cfi_supported" >> Makefile
rm -f tst hasgot.c
rm -f ../m.h ../s.h ../Makefile
@@ -1698,6 +1710,11 @@ else
echo " options for linking....... $nativecclinkopts $cclibs"
echo " assembler ................ $as"
echo " preprocessed assembler ... $aspp"
+ if test "$asm_cfi_supported" = "true"; then
+ echo " assembler supports CFI ... yes"
+ else
+ echo " assembler supports CFI ... no"
+ fi
echo " native dynlink ........... $natdynlink"
if test "$profiling" = "prof"; then
echo " profiling with gprof ..... supported"
diff --git a/utils/config.mlbuild b/utils/config.mlbuild
index 68a7c85..b01082f 100644
--- a/utils/config.mlbuild
+++ b/utils/config.mlbuild
@@ -88,6 +88,7 @@ let model = C.model
let system = C.system
let asm = C.asm
+let asm_cfi_supported = C.asm_cfi_supported
let ext_obj = C.ext_obj
let ext_asm = C.ext_asm
@@ -121,6 +122,7 @@ let print_config oc =
p "model" model;
p "system" system;
p "asm" asm;
+ p_bool "asm_cfi_supported" asm_cfi_supported;
p "ext_obj" ext_obj;
p "ext_asm" ext_asm;
p "ext_lib" ext_lib;
diff --git a/utils/config.mli b/utils/config.mli
index da39808..52152a8 100644
--- a/utils/config.mli
+++ b/utils/config.mli
@@ -98,6 +98,9 @@ val asm: string
(* The assembler (and flags) to use for assembling
ocamlopt-generated code. *)
+val asm_cfi_supported: bool
+ (* Whether assembler understands CFI directives *)
+
val ext_obj: string
(* Extension for object files, e.g. [.o] under Unix. *)
val ext_asm: string
diff --git a/utils/config.mlp b/utils/config.mlp
index 4cabf90..565de17 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -77,6 +77,7 @@ let model = "%%MODEL%%"
let system = "%%SYSTEM%%"
let asm = "%%ASM%%"
+let asm_cfi_supported = %%ASM_CFI_SUPPORTED%%
let ext_obj = "%%EXT_OBJ%%"
let ext_asm = "%%EXT_ASM%%"
@@ -110,6 +111,7 @@ let print_config oc =
p "model" model;
p "system" system;
p "asm" asm;
+ p_bool "asm_cfi_supported" asm_cfi_supported;
p "ext_obj" ext_obj;
p "ext_asm" ext_asm;
p "ext_lib" ext_lib;
| |||||||
 Relationships |
||||||
|
||||||
 Relationships |
|
Notes |
|
|
(0006044) ygrek (reporter) 2011-07-13 19:03 |
Patch updated : * configure test whether assembler accepts CFI directives * annotate important runtime functions (now it is possible to see where caml_call_gc comes from) * correct CFA for exception handlers |
|
(0006045) ygrek (reporter) 2011-07-13 19:04 |
Same patch for 3.11.2 (for testing - easy to apply on top of debian package) |
|
(0006105) ygrek (reporter) 2011-08-26 09:38 |
Patches updated: * caml_c_call annotation was wrong, reverted |
|
(0006199) ygrek (reporter) 2011-11-09 22:48 |
Documentation for CFI directives : http://sourceware.org/binutils/docs/as/CFI-directives.html [^] Useful example at http://www.logix.cz/michal/devel/gas-cfi/ [^] The patch is being used for quite some time already and seems to work pretty well. Note that implementation depends on the way ocamlopt emits code, so it shortcuts some calculations (e.g. for exceptions). Probably an important missing piece is ARM support but I do not know ARM assembly at all. |
|
(0006321) tgazagna (reporter) 2011-12-16 11:10 |
I've tested the patch as well and it works pretty well. An other missing piece is OSX support, but as on this architecture, the shipped version of as is very old (1.*), it doesn't support CFI directives. I guess generating directly .eh_sections and .debug_section is too much a pain ... |
|
(0006326) thelema (reporter) 2011-12-16 16:27 |
I've been using this final patch on a couple systems and it greatly increases the information available to me from stack traces. It makes the technique of poor man's profiling (http://poormansprofiler.org/ [^]) usable, instead of looking at just a few functions on the stack. |
|
(0006955) ygrek (reporter) 2012-02-22 11:52 |
see PR#5487 |
|
Notes |
|
Issue History |
|||
| Date Modified | Username | Field | Change |
| 2011-07-10 13:01 | ygrek | New Issue | |
| 2011-07-10 13:01 | ygrek | File Added: ocaml-3.12.1-cfi.patch | |
| 2011-07-13 19:03 | ygrek | File Added: ocaml-3.12.1-cfi2.patch | |
| 2011-07-13 19:03 | ygrek | Note Added: 0006044 | |
| 2011-07-13 19:03 | ygrek | File Added: ocaml-3.11.2-cfi.patch | |
| 2011-07-13 19:04 | ygrek | Note Added: 0006045 | |
| 2011-08-26 09:36 | ygrek | File Added: ocaml-3.11-cfi.patch | |
| 2011-08-26 09:36 | ygrek | File Added: ocaml-3.12-cfi.patch | |
| 2011-08-26 09:38 | ygrek | Note Added: 0006105 | |
| 2011-10-03 14:35 | xleroy | Relationship added | related to 0005334 |
| 2011-11-09 22:48 | ygrek | Note Added: 0006199 | |
| 2011-11-21 12:56 | shinwell | Status | new => assigned |
| 2011-11-21 12:56 | shinwell | Assigned To | => shinwell |
| 2011-12-16 11:10 | tgazagna | Note Added: 0006321 | |
| 2011-12-16 16:27 | thelema | Note Added: 0006326 | |
| 2012-02-22 11:52 | ygrek | Note Added: 0006955 | |
| 2012-02-24 11:14 | xleroy | Status | assigned => resolved |
| 2012-02-24 11:14 | xleroy | Resolution | open => fixed |
| 2012-02-24 11:14 | xleroy | Fixed in Version | => 3.13.0+dev |
| 2013-08-31 12:48 | xleroy | Status | resolved => closed |
| 2017-02-23 16:36 | doligez | Category | OCaml general => -OCaml general |
| 2017-03-03 17:55 | doligez | Category | -OCaml general => -(deprecated) general |
| 2017-03-03 18:01 | doligez | Category | -(deprecated) general => ~deprecated (was: OCaml general) |
| 2017-03-06 17:04 | doligez | Category | ~deprecated (was: OCaml general) => ~DO NOT USE (was: OCaml general) |
|
Issue History |
| Copyright © 2000 - 2011 MantisBT Group |
 |