Add -with-frame-pointers to ./configurewith-frame-pointers

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/with-frame-pointers@13729 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

2 files changed, 57 insertions, 24 deletions

diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index 447f63d6e3..2b598dbea9 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 Config.with_frame_pointers 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/proc.ml b/asmcomp/amd64/proc.ml
index 351770b281..3d065bc0bf 100644
--- a/asmcomp/amd64/proc.ml
+++ b/asmcomp/amd64/proc.ml
@@ -45,9 +45,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 +77,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 +133,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 +243,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 +260,37 @@ let destroyed_at_oper = function
   | Iop(Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _))
         -> [| rax |]
   | Iswitch(_, _) -> [| rax; rdx |]
-  | _ -> [||]
+  | _ ->
+    if Config.with_frame_pointers then
+(* prevent any use of the frame pointer ! *)
+      [| rbp |]
+    else
+      [||]
+
 
 let destroyed_at_raise = all_phys_regs
 
 (* Maximal register pressure *)
 
+let fp() = Config.with_frame_pointers
+
 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 +307,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