summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.depend21
-rw-r--r--Changes1
-rw-r--r--Makefile1
-rw-r--r--Makefile.nt1
-rw-r--r--asmcomp/amd64/emit.mlp28
-rw-r--r--asmcomp/amd64/emit_nt.mlp6
-rw-r--r--asmcomp/amd64/proc.ml54
-rw-r--r--asmcomp/arm/proc.ml3
-rw-r--r--asmcomp/asmgen.ml1
-rw-r--r--asmcomp/emitaux.ml3
-rw-r--r--asmcomp/i386/proc.ml3
-rw-r--r--asmcomp/power/proc.ml2
-rw-r--r--asmcomp/proc.mli3
-rw-r--r--asmcomp/sparc/proc.ml2
-rw-r--r--asmrun/amd64.S45
-rw-r--r--asmrun/amd64nt.asm4
-rwxr-xr-xconfigure16
-rw-r--r--utils/clflags.ml3
-rw-r--r--utils/config.mli2
-rw-r--r--utils/config.mlp2
20 files changed, 158 insertions, 43 deletions
diff --git a/.depend b/.depend
index cc07e3870..115bb0cb9 100644
--- a/.depend
+++ b/.depend
@@ -270,18 +270,20 @@ typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \
typing/types.cmi typing/typedtree.cmi typing/typedecl.cmi \
typing/typecore.cmi typing/subst.cmi typing/stypes.cmi \
typing/printtyp.cmi typing/predef.cmi typing/path.cmi \
- parsing/parsetree.cmi typing/parmatch.cmi parsing/longident.cmi \
- parsing/location.cmi typing/includeclass.cmi typing/ident.cmi \
- typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi utils/clflags.cmi \
- typing/btype.cmi parsing/asttypes.cmi typing/typeclass.cmi
+ parsing/parsetree.cmi typing/parmatch.cmi utils/misc.cmi \
+ parsing/longident.cmi parsing/location.cmi typing/includeclass.cmi \
+ typing/ident.cmi typing/env.cmi typing/ctype.cmi typing/cmt_format.cmi \
+ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
+ typing/typeclass.cmi
typing/typeclass.cmx : utils/warnings.cmx typing/typetexp.cmx \
typing/types.cmx typing/typedtree.cmx typing/typedecl.cmx \
typing/typecore.cmx typing/subst.cmx typing/stypes.cmx \
typing/printtyp.cmx typing/predef.cmx typing/path.cmx \
- parsing/parsetree.cmi typing/parmatch.cmx parsing/longident.cmx \
- parsing/location.cmx typing/includeclass.cmx typing/ident.cmx \
- typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx utils/clflags.cmx \
- typing/btype.cmx parsing/asttypes.cmi typing/typeclass.cmi
+ parsing/parsetree.cmi typing/parmatch.cmx utils/misc.cmx \
+ parsing/longident.cmx parsing/location.cmx typing/includeclass.cmx \
+ typing/ident.cmx typing/env.cmx typing/ctype.cmx typing/cmt_format.cmx \
+ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
+ typing/typeclass.cmi
typing/typecore.cmo : utils/warnings.cmi typing/typetexp.cmi \
typing/types.cmi typing/typedtree.cmi typing/subst.cmi typing/stypes.cmi \
typing/printtyp.cmi typing/primitive.cmi typing/predef.cmi \
@@ -382,7 +384,8 @@ bytecomp/printlambda.cmi : bytecomp/lambda.cmi
bytecomp/runtimedef.cmi :
bytecomp/simplif.cmi : bytecomp/lambda.cmi
bytecomp/switch.cmi :
-bytecomp/symtable.cmi : typing/ident.cmi bytecomp/cmo_format.cmi
+bytecomp/symtable.cmi : utils/misc.cmi typing/ident.cmi \
+ bytecomp/cmo_format.cmi
bytecomp/translclass.cmi : typing/typedtree.cmi parsing/location.cmi \
bytecomp/lambda.cmi typing/ident.cmi parsing/asttypes.cmi
bytecomp/translcore.cmi : typing/typedtree.cmi typing/primitive.cmi \
diff --git a/Changes b/Changes
index 42a8786cf..25b314902 100644
--- a/Changes
+++ b/Changes
@@ -133,6 +133,7 @@ Internals:
Feature wishes:
- PR#5597: add instruction trace option 't' to OCAMLRUNPARAM
+- PR#5721: configure -with-frame-pointers for Linux perf profiling
- PR#5762: Add primitives for fast access to bigarray dimensions
- PR#5795: Generate sqrtsd opcode instead of external call to sqrt on amd64
- PR#5769: Allow propagation of Sys.big_endian in native code
diff --git a/Makefile b/Makefile
index 8f6c913e6..f0ff364fb 100644
--- a/Makefile
+++ b/Makefile
@@ -420,6 +420,7 @@ utils/config.ml: utils/config.mlp config/Makefile
-e 's|%%SYSTHREAD_SUPPORT%%|$(SYSTHREAD_SUPPORT)|' \
-e 's|%%ASM%%|$(ASM)|' \
-e 's|%%ASM_CFI_SUPPORTED%%|$(ASM_CFI_SUPPORTED)|' \
+ -e 's|%%WITH_FRAME_POINTERS%%|$(WITH_FRAME_POINTERS)|' \
-e 's|%%MKDLL%%|$(MKDLL)|' \
-e 's|%%MKEXE%%|$(MKEXE)|' \
-e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \
diff --git a/Makefile.nt b/Makefile.nt
index 4b25461a9..6c8141355 100644
--- a/Makefile.nt
+++ b/Makefile.nt
@@ -357,6 +357,7 @@ utils/config.ml: utils/config.mlp config/Makefile
-e "s|%%SYSTHREAD_SUPPORT%%|true|" \
-e 's|%%ASM%%|$(ASM)|' \
-e 's|%%ASM_CFI_SUPPORTED%%|false|' \
+ -e 's|%%WITH_FRAME_POINTERS%%|false|' \
-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 447f63d6e..8dad2206a 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -23,6 +23,8 @@ open Emitaux
let macosx = (Config.system = "macosx")
let mingw64 = (Config.system = "mingw64")
+let fp = Config.with_frame_pointers
+
(* Tradeoff between code size and code speed *)
let fastcode_flag = ref true
@@ -32,12 +34,13 @@ let stack_offset = ref 0
(* Layout of the stack frame *)
let frame_required () =
- !contains_calls || num_stack_slots.(0) > 0 || num_stack_slots.(1) > 0
+ fp || !contains_calls || num_stack_slots.(0) > 0 || num_stack_slots.(1) > 0
let frame_size () = (* includes return address *)
if frame_required() then begin
let sz =
- (!stack_offset + 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + 8)
+ (!stack_offset + 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + 8
+ + (if fp then 8 else 0) )
in Misc.align sz 16
end else
!stack_offset + 8
@@ -107,13 +110,13 @@ let emit_reg = function
let reg_low_8_name =
[| "%al"; "%bl"; "%dil"; "%sil"; "%dl"; "%cl"; "%r8b"; "%r9b";
- "%r12b"; "%r13b"; "%bpl"; "%r10b"; "%r11b" |]
+ "%r12b"; "%r13b"; "%r10b"; "%r11b"; "%bpl" |]
let reg_low_16_name =
[| "%ax"; "%bx"; "%di"; "%si"; "%dx"; "%cx"; "%r8w"; "%r9w";
- "%r12w"; "%r13w"; "%bp"; "%r10w"; "%r11w" |]
+ "%r12w"; "%r13w"; "%r10w"; "%r11w"; "%bp" |]
let reg_low_32_name =
[| "%eax"; "%ebx"; "%edi"; "%esi"; "%edx"; "%ecx"; "%r8d"; "%r9d";
- "%r12d"; "%r13d"; "%ebp"; "%r10d"; "%r11d" |]
+ "%r12d"; "%r13d"; "%r10d"; "%r11d"; "%ebp" |]
let emit_subreg tbl r =
match r.loc with
@@ -316,9 +319,12 @@ let emit_float_test cmp neg arg lbl =
let output_epilogue f =
if frame_required() then begin
- let n = frame_size() - 8 in
+ let n = frame_size() - 8 - (if fp then 8 else 0) in
` addq ${emit_int n}, %rsp\n`;
cfi_adjust_cfa_offset (-n);
+ if fp then begin
+ ` popq %rbp\n`
+ end;
f ();
(* reset CFA back cause function body may continue *)
cfi_adjust_cfa_offset n
@@ -696,7 +702,8 @@ let emit_profile () =
need to preserve other regs. We do need to initialize rbp
like mcount expects it, though. *)
` pushq %r10\n`;
- ` movq %rsp, %rbp\n`;
+ if not fp then
+ ` movq %rsp, %rbp\n`;
` {emit_call "mcount"}\n`;
` popq %r10\n`
| _ ->
@@ -724,9 +731,14 @@ let fundecl fundecl =
`{emit_symbol fundecl.fun_name}:\n`;
emit_debug_info fundecl.fun_dbg;
cfi_startproc ();
+ if fp then begin
+ ` pushq %rbp\n`;
+ cfi_adjust_cfa_offset 8;
+ ` movq %rsp, %rbp\n`;
+ end;
if !Clflags.gprofile then emit_profile();
if frame_required() then begin
- let n = frame_size() - 8 in
+ let n = frame_size() - 8 - (if fp then 8 else 0) in
` subq ${emit_int n}, %rsp\n`;
cfi_adjust_cfa_offset n;
end;
diff --git a/asmcomp/amd64/emit_nt.mlp b/asmcomp/amd64/emit_nt.mlp
index b56afe3dd..c38c21f2c 100644
--- a/asmcomp/amd64/emit_nt.mlp
+++ b/asmcomp/amd64/emit_nt.mlp
@@ -108,13 +108,13 @@ let emit_reg = function
let reg_low_8_name =
[| "al"; "bl"; "dil"; "sil"; "dl"; "cl"; "r8b"; "r9b";
- "r12b"; "r13b"; "bpl"; "r10b"; "r11b" |]
+ "r12b"; "r13b"; "r10b"; "r11b"; "bpl" |]
let reg_low_16_name =
[| "ax"; "bx"; "di"; "si"; "dx"; "cx"; "r8w"; "r9w";
- "r12w"; "r13w"; "bp"; "r10w"; "r11w" |]
+ "r12w"; "r13w"; "r10w"; "r11w"; "bp" |]
let reg_low_32_name =
[| "eax"; "ebx"; "edi"; "esi"; "edx"; "ecx"; "r8d"; "r9d";
- "r12d"; "r13d"; "ebp"; "r10d"; "r11d" |]
+ "r12d"; "r13d"; "r10d"; "r11d"; "ebp" |]
let emit_subreg tbl pref r =
match r.loc with
diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml
index 351770b28..8774a0da9 100644
--- a/asmcomp/amd64/proc.ml
+++ b/asmcomp/amd64/proc.ml
@@ -18,6 +18,8 @@ open Cmm
open Reg
open Mach
+let fp = Config.with_frame_pointers
+
(* Which ABI to use *)
let win64 =
@@ -45,9 +47,9 @@ let masm =
r9 7
r12 8
r13 9
- rbp 10
- r10 11
- r11 12
+ r10 10
+ r11 11
+ rbp 12
r14 trap pointer
r15 allocation pointer
@@ -77,10 +79,10 @@ let int_reg_name =
match Config.ccomp_type with
| "msvc" ->
[| "rax"; "rbx"; "rdi"; "rsi"; "rdx"; "rcx"; "r8"; "r9";
- "r12"; "r13"; "rbp"; "r10"; "r11" |]
+ "r12"; "r13"; "r10"; "r11"; "rbp" |]
| _ ->
[| "%rax"; "%rbx"; "%rdi"; "%rsi"; "%rdx"; "%rcx"; "%r8"; "%r9";
- "%r12"; "%r13"; "%rbp"; "%r10"; "%r11" |]
+ "%r12"; "%r13"; "%r10"; "%r11"; "%rbp" |]
let float_reg_name =
match Config.ccomp_type with
@@ -133,6 +135,7 @@ let phys_reg n =
let rax = phys_reg 0
let rcx = phys_reg 5
let rdx = phys_reg 4
+let rbp = phys_reg 12
let rxmm15 = phys_reg 115
let stack_slot slot ty =
@@ -242,12 +245,12 @@ let destroyed_at_c_call =
if win64 then
(* Win64: rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 preserved *)
Array.of_list(List.map phys_reg
- [0;4;5;6;7;11;12;
+ [0;4;5;6;7;10;11;
100;101;102;103;104;105])
else
(* Unix: rbp, rbx, r12-r15 preserved *)
Array.of_list(List.map phys_reg
- [0;2;3;4;5;6;7;11;12;
+ [0;2;3;4;5;6;7;10;11;
100;101;102;103;104;105;106;107;
108;109;110;111;112;113;114;115])
@@ -259,23 +262,36 @@ let destroyed_at_oper = function
| Iop(Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _))
-> [| rax |]
| Iswitch(_, _) -> [| rax; rdx |]
- | _ -> [||]
+ | _ ->
+ if fp then
+(* prevent any use of the frame pointer ! *)
+ [| rbp |]
+ else
+ [||]
+
let destroyed_at_raise = all_phys_regs
(* Maximal register pressure *)
+
let safe_register_pressure = function
- Iextcall(_,_) -> if win64 then 8 else 0
- | _ -> 11
+ Iextcall(_,_) -> if win64 then if fp then 7 else 8 else 0
+ | _ -> if fp then 10 else 11
let max_register_pressure = function
- Iextcall(_, _) -> if win64 then [| 8; 10 |] else [| 4; 0 |]
- | Iintop(Idiv | Imod) -> [| 11; 16 |]
- | Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _)
- -> [| 12; 16 |]
- | Istore(Single, _) -> [| 13; 15 |]
- | _ -> [| 13; 16 |]
+ Iextcall(_, _) ->
+ if win64 then
+ if fp then [| 7; 10 |] else [| 8; 10 |]
+ else
+ if fp then [| 3; 0 |] else [| 4; 0 |]
+ | Iintop(Idiv | Imod) ->
+ if fp then [| 10; 16 |] else [| 11; 16 |]
+ | Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _) ->
+ if fp then [| 11; 16 |] else [| 12; 16 |]
+ | Istore(Single, _) ->
+ if fp then [| 12; 15 |] else [| 13; 15 |]
+ | _ -> if fp then [| 12; 16 |] else [| 13; 16 |]
(* Layout of the stack frame *)
@@ -292,3 +308,9 @@ let assemble_file infile outfile =
else
Ccomp.command (Config.asm ^ " -o " ^
Filename.quote outfile ^ " " ^ Filename.quote infile)
+
+let init () =
+ if fp then begin
+ num_available_registers.(0) <- 12
+ end else
+ num_available_registers.(0) <- 13
diff --git a/asmcomp/arm/proc.ml b/asmcomp/arm/proc.ml
index b8ff779b6..dbb13173a 100644
--- a/asmcomp/arm/proc.ml
+++ b/asmcomp/arm/proc.ml
@@ -233,3 +233,6 @@ let contains_calls = ref false
let assemble_file infile outfile =
Ccomp.command (Config.asm ^ " -o " ^
Filename.quote outfile ^ " " ^ Filename.quote infile)
+
+
+let init () = ()
diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
index 448980740..40f7dafbd 100644
--- a/asmcomp/asmgen.ml
+++ b/asmcomp/asmgen.ml
@@ -57,6 +57,7 @@ let rec regalloc ppf round fd =
let (++) x f = f x
let compile_fundecl (ppf : formatter) fd_cmm =
+ Proc.init ();
Reg.reset();
fd_cmm
++ Selection.fundecl
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
index c3f888851..3ad467cbf 100644
--- a/asmcomp/emitaux.ml
+++ b/asmcomp/emitaux.ml
@@ -220,7 +220,8 @@ let reset_debug_info () =
display .loc for every instruction. *)
let emit_debug_info dbg =
if is_cfi_enabled () &&
- !Clflags.debug && not (Debuginfo.is_none dbg) then begin
+ (!Clflags.debug || Config.with_frame_pointers)
+ && not (Debuginfo.is_none dbg) then begin
let line = dbg.Debuginfo.dinfo_line in
assert (line <> 0); (* clang errors out on zero line numbers *)
let file_name = dbg.Debuginfo.dinfo_file in
diff --git a/asmcomp/i386/proc.ml b/asmcomp/i386/proc.ml
index bb510bbf4..4cecb2d44 100644
--- a/asmcomp/i386/proc.ml
+++ b/asmcomp/i386/proc.ml
@@ -198,3 +198,6 @@ let assemble_file infile outfile =
else
Ccomp.command (Config.asm ^ " -o " ^
Filename.quote outfile ^ " " ^ Filename.quote infile)
+
+let init () = ()
+
diff --git a/asmcomp/power/proc.ml b/asmcomp/power/proc.ml
index feb38f253..38adadc05 100644
--- a/asmcomp/power/proc.ml
+++ b/asmcomp/power/proc.ml
@@ -237,3 +237,5 @@ let assemble_file infile outfile =
open Clflags;;
open Config;;
+
+let init () = ()
diff --git a/asmcomp/proc.mli b/asmcomp/proc.mli
index 91a480b09..6cc6aedc9 100644
--- a/asmcomp/proc.mli
+++ b/asmcomp/proc.mli
@@ -46,3 +46,6 @@ val contains_calls: bool ref
(* Calling the assembler *)
val assemble_file: string -> string -> int
+
+(* Called before translating a fundecl. *)
+val init : unit -> unit
diff --git a/asmcomp/sparc/proc.ml b/asmcomp/sparc/proc.ml
index b88d5aaae..ed107a82a 100644
--- a/asmcomp/sparc/proc.ml
+++ b/asmcomp/sparc/proc.ml
@@ -211,3 +211,5 @@ let assemble_file infile outfile =
end in
Ccomp.command (Config.asm ^ asflags ^
Filename.quote outfile ^ " " ^ Filename.quote infile)
+
+let init () = ()
diff --git a/asmrun/amd64.S b/asmrun/amd64.S
index dd03c75d1..ce28f0d42 100644
--- a/asmrun/amd64.S
+++ b/asmrun/amd64.S
@@ -73,6 +73,17 @@
#define CFI_ADJUST(n)
#endif
+#ifdef WITH_FRAME_POINTERS
+#define ENTER_FUNCTION \
+ pushq %rbp; CFI_ADJUST(8); \
+ movq %rsp, %rbp
+#define LEAVE_FUNCTION \
+ popq %rbp; CFI_ADJUST(-8);
+#else
+#define ENTER_FUNCTION ;
+#define LEAVE_FUNCTION ;
+#endif
+
#if defined(__PIC__) && !defined(SYS_mingw64)
/* Position-independent operations on global variables. */
@@ -215,7 +226,7 @@
popq %r13; CFI_ADJUST(-8); \
popq %r12; CFI_ADJUST(-8); \
popq %rbp; CFI_ADJUST(-8); \
- popq %rbx; CFI_ADJUST(-8)
+ popq %rbx; CFI_ADJUST(-8);
#endif
@@ -232,6 +243,8 @@
.globl G(caml_system__code_begin)
G(caml_system__code_begin):
+ ret /* just one instruction, so that debuggers don't display
+ caml_system__code_begin instead of caml_call_gc */
/* Allocation */
@@ -247,9 +260,13 @@ LBL(caml_call_gc):
addq $32768, %rsp
#endif
/* Build array of registers, save it into caml_gc_regs */
+#ifdef WITH_FRAME_POINTERS
+ ENTER_FUNCTION ;
+#else
+ pushq %rbp; CFI_ADJUST(8);
+#endif
pushq %r11; CFI_ADJUST (8);
pushq %r10; CFI_ADJUST (8);
- pushq %rbp; CFI_ADJUST (8);
pushq %r13; CFI_ADJUST (8);
pushq %r12; CFI_ADJUST (8);
pushq %r9; CFI_ADJUST (8);
@@ -317,9 +334,13 @@ LBL(caml_call_gc):
popq %r9; CFI_ADJUST(-8)
popq %r12; CFI_ADJUST(-8)
popq %r13; CFI_ADJUST(-8)
- popq %rbp; CFI_ADJUST(-8)
popq %r10; CFI_ADJUST(-8)
popq %r11; CFI_ADJUST(-8)
+#ifdef WITH_FRAME_POINTERS
+ LEAVE_FUNCTION
+#else
+ popq %rbp; CFI_ADJUST(-8);
+#endif
/* Return to caller */
ret
CFI_ENDPROC
@@ -333,9 +354,11 @@ LBL(caml_alloc1):
ret
LBL(100):
RECORD_STACK_FRAME(0)
+ ENTER_FUNCTION
subq $8, %rsp; CFI_ADJUST (8);
call LBL(caml_call_gc)
addq $8, %rsp; CFI_ADJUST (-8);
+ LEAVE_FUNCTION
jmp LBL(caml_alloc1)
CFI_ENDPROC
@@ -348,9 +371,11 @@ LBL(caml_alloc2):
ret
LBL(101):
RECORD_STACK_FRAME(0)
+ ENTER_FUNCTION
subq $8, %rsp; CFI_ADJUST (8);
call LBL(caml_call_gc)
addq $8, %rsp; CFI_ADJUST (-8);
+ LEAVE_FUNCTION
jmp LBL(caml_alloc2)
CFI_ENDPROC
@@ -363,9 +388,11 @@ LBL(caml_alloc3):
ret
LBL(102):
RECORD_STACK_FRAME(0)
+ ENTER_FUNCTION
subq $8, %rsp; CFI_ADJUST (8)
call LBL(caml_call_gc)
addq $8, %rsp; CFI_ADJUST (-8)
+ LEAVE_FUNCTION
jmp LBL(caml_alloc3)
CFI_ENDPROC
@@ -380,8 +407,10 @@ LBL(caml_allocN):
ret
LBL(103):
RECORD_STACK_FRAME(8)
+ ENTER_FUNCTION
call LBL(caml_call_gc)
popq %rax; CFI_ADJUST(-8) /* recover desired size */
+ LEAVE_FUNCTION
jmp LBL(caml_allocN)
CFI_ENDPROC
@@ -486,12 +515,19 @@ CFI_STARTPROC
popq %r14
ret
LBL(110):
+ ENTER_FUNCTION
movq %rax, %r12 /* Save exception bucket */
movq %rax, C_ARG_1 /* arg 1: exception bucket */
+#ifdef WITH_FRAME_POINTERS
+ movq 8(%rsp), C_ARG_2 /* arg 2: pc of raise */
+ leaq 16(%rsp), C_ARG_3 /* arg 3: sp at raise */
+#else
popq C_ARG_2 /* arg 2: pc of raise */
movq %rsp, C_ARG_3 /* arg 3: sp at raise */
+#endif
movq %r14, C_ARG_4 /* arg 4: sp of handler */
/* PR#5700: thanks to popq above, stack is now 16-aligned */
+ /* Thanks to ENTER_FUNCTION, stack is now 16-aligned */
PREPARE_FOR_C_CALL /* no need to cleanup after */
call GCALL(caml_stash_backtrace)
movq %r12, %rax /* Recover exception bucket */
@@ -512,12 +548,15 @@ CFI_STARTPROC
LOAD_VAR(caml_young_ptr, %r15) /* Reload alloc ptr */
ret
LBL(111):
+ ENTER_FUNCTION ;
movq C_ARG_1, %r12 /* Save exception bucket */
/* arg 1: exception bucket */
LOAD_VAR(caml_last_return_address,C_ARG_2) /* arg 2: pc of raise */
LOAD_VAR(caml_bottom_of_stack,C_ARG_3) /* arg 3: sp of raise */
LOAD_VAR(caml_exception_pointer,C_ARG_4) /* arg 4: sp of handler */
+#ifndef WITH_FRAME_POINTERS
subq $8, %rsp /* PR#5700: maintain stack alignment */
+#endif
PREPARE_FOR_C_CALL /* no need to cleanup after */
call GCALL(caml_stash_backtrace)
movq %r12, %rax /* Recover exception bucket */
diff --git a/asmrun/amd64nt.asm b/asmrun/amd64nt.asm
index 07b6a9b88..e86ee72ce 100644
--- a/asmrun/amd64nt.asm
+++ b/asmrun/amd64nt.asm
@@ -49,9 +49,9 @@ L105:
mov caml_young_ptr, r15
mov caml_exception_pointer, r14
; Build array of registers, save it into caml_gc_regs
+ push rbp
push r11
push r10
- push rbp
push r13
push r12
push r9
@@ -113,9 +113,9 @@ L105:
pop r9
pop r12
pop r13
- pop rbp
pop r10
pop r11
+ pop rbp
; Restore caml_young_ptr, caml_exception_pointer
mov r15, caml_young_ptr
mov r14, caml_exception_pointer
diff --git a/configure b/configure
index e89076d69..599d855ad 100755
--- a/configure
+++ b/configure
@@ -43,6 +43,7 @@ withsharedlibs=yes
gcc_warnings="-Wall"
partialld="ld -r"
withcamlp4=camlp4
+with_frame_pointers=false
# Try to turn internationalization off, can cause config.guess to malfunction!
unset LANG
@@ -115,6 +116,8 @@ while : ; do
debugruntime=runtimed;;
-no-camlp4|--no-camlp4)
withcamlp4="";;
+ -with-frame-pointers|--with-frame-pointers)
+ with_frame_pointers=true;;
*) echo "Unknown option \"$1\"." 1>&2; exit 2;;
esac
shift
@@ -1577,6 +1580,13 @@ else
echo "Assembler does not support CFI"
fi
+if test "$with_frame_pointers" = "true"; then
+ nativecccompopts="$nativecccompopts -g"
+ nativecclinkopts="$nativecclinkopts -g"
+ echo "#define WITH_FRAME_POINTERS" >> m.h
+fi
+
+
# Final twiddling of compiler options to work around known bugs
nativeccprofopts="$nativecccompopts"
@@ -1650,6 +1660,7 @@ echo "MKMAINDLL=$mkmaindll" >> Makefile
echo "RUNTIMED=${debugruntime}" >>Makefile
echo "CAMLP4=${withcamlp4}" >>Makefile
echo "ASM_CFI_SUPPORTED=$asm_cfi_supported" >> Makefile
+echo "WITH_FRAME_POINTERS=$with_frame_pointers" >> Makefile
if [ "$ostype" = Cygwin ]; then
echo "DIFF=diff -q --strip-trailing-cr" >>Makefile
fi
@@ -1703,6 +1714,11 @@ else
else
echo " assembler supports CFI ... no"
fi
+ if test "$with_frame_pointers" = "true"; then
+ echo " with frame pointers....... yes"
+ else
+ echo " with frame pointers....... no"
+ fi
echo " native dynlink ........... $natdynlink"
if test "$profiling" = "prof"; then
echo " profiling with gprof ..... supported"
diff --git a/utils/clflags.ml b/utils/clflags.ml
index dd914cdbb..bdb9feb71 100644
--- a/utils/clflags.ml
+++ b/utils/clflags.ml
@@ -99,4 +99,5 @@ let std_include_dir () =
let shared = ref false (* -shared *)
let dlcode = ref true (* not -nodynlink *)
-let runtime_variant = ref "";; (* -runtime-variant *)
+let runtime_variant = ref "";; (* -runtime-variant *)
+
diff --git a/utils/config.mli b/utils/config.mli
index 7829b9ee1..d8c02006b 100644
--- a/utils/config.mli
+++ b/utils/config.mli
@@ -101,6 +101,8 @@ val asm: string
val asm_cfi_supported: bool
(* Whether assembler understands CFI directives *)
+val with_frame_pointers : bool
+ (* Whether assembler should maintain frame pointers *)
val ext_obj: string
(* Extension for object files, e.g. [.o] under Unix. *)
diff --git a/utils/config.mlp b/utils/config.mlp
index 398d3cc0d..f555ef581 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -78,6 +78,7 @@ let system = "%%SYSTEM%%"
let asm = "%%ASM%%"
let asm_cfi_supported = %%ASM_CFI_SUPPORTED%%
+let with_frame_pointers = %%WITH_FRAME_POINTERS%%
let ext_obj = "%%EXT_OBJ%%"
let ext_asm = "%%EXT_ASM%%"
@@ -112,6 +113,7 @@ let print_config oc =
p "system" system;
p "asm" asm;
p_bool "asm_cfi_supported" asm_cfi_supported;
+ p_bool "with_frame_pointers" with_frame_pointers;
p "ext_obj" ext_obj;
p "ext_asm" ext_asm;
p "ext_lib" ext_lib;
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-24 16:30:32 +0000