aboutsummaryrefslogtreecommitdiffstats
path: root/backend
diff options
context:
space:
mode:
Diffstat (limited to 'backend')
-rw-r--r--backend/PrintAnnot.ml15
-rw-r--r--backend/PrintAsm.ml54
-rw-r--r--backend/PrintAsm.mli4
-rw-r--r--backend/PrintAsmaux.ml8
4 files changed, 69 insertions, 12 deletions
diff --git a/backend/PrintAnnot.ml b/backend/PrintAnnot.ml
index 0176224d..995f22dd 100644
--- a/backend/PrintAnnot.ml
+++ b/backend/PrintAnnot.ml
@@ -21,6 +21,13 @@ open AST
open Memdata
open Asm
+(** All files used in the debug entries *)
+module StringSet = Set.Make(String)
+let all_files : StringSet.t ref = ref StringSet.empty
+let add_file file =
+ all_files := StringSet.add file !all_files
+
+
(** Line number annotations *)
let filename_info : (string, int * Printlines.filebuf option) Hashtbl.t
@@ -66,10 +73,10 @@ let print_file_line oc pref file line =
| Some fb -> Printlines.copy oc pref fb line line
end
-(* Add file and line debug location, using DWARF1 directives in the style
+(* Add file and line debug location, using DWARF2 directives in the style
of Diab C 5 *)
-let print_file_line_d1 oc pref file line =
+let print_file_line_d2 oc pref file line =
if !Clflags.option_g && file <> "" then begin
let (_, filebuf) =
try
@@ -77,10 +84,10 @@ let print_file_line_d1 oc pref file line =
with Not_found ->
enter_filename file in
if file <> !last_file then begin
- fprintf oc " .d1file %S\n" file;
+ fprintf oc " .d2file %S\n" file;
last_file := file
end;
- fprintf oc " .d1line %d\n" line;
+ fprintf oc " .d2line %d\n" line;
match filebuf with
| None -> ()
| Some fb -> Printlines.copy oc pref fb line line
diff --git a/backend/PrintAsm.ml b/backend/PrintAsm.ml
index a6883339..11854ace 100644
--- a/backend/PrintAsm.ml
+++ b/backend/PrintAsm.ml
@@ -15,6 +15,7 @@ open AST
open Asm
open Camlcoq
open Datatypes
+open DwarfPrinter
open PrintAsmaux
open Printf
open Sections
@@ -23,6 +24,22 @@ open TargetPrinter
module Printer(Target:TARGET) =
struct
+ let addr_mapping: (string, (int * int)) Hashtbl.t = Hashtbl.create 7
+
+ let get_fun_addr name =
+ let name = extern_atom name in
+ let start_addr = new_label ()
+ and end_addr = new_label () in
+ Hashtbl.add addr_mapping name (start_addr,end_addr);
+ start_addr,end_addr
+
+ let print_debug_label oc l =
+ if !Clflags.option_g && Configuration.advanced_debug then
+ fprintf oc "%a:\n" Target.label l
+ else
+ ()
+
+
let print_location oc loc =
if loc <> Cutil.no_loc then Target.print_file_line oc (fst loc) (snd loc)
@@ -37,16 +54,21 @@ module Printer(Target:TARGET) =
if not (C2C.atom_is_static name) then
fprintf oc " .globl %a\n" Target.symbol name;
Target.print_optional_fun_info oc;
+ let s,e = if !Clflags.option_g && Configuration.advanced_debug then
+ get_fun_addr name
+ else
+ -1,-1 in
+ print_debug_label oc s;
fprintf oc "%a:\n" Target.symbol name;
print_location oc (C2C.atom_location name);
Target.cfi_startproc oc;
Target.print_instructions oc fn;
Target.cfi_endproc oc;
+ print_debug_label oc e;
Target.print_fun_info oc name;
Target.emit_constants oc lit;
Target.print_jumptable oc jmptbl
-
-
+
let print_init_data oc name id =
if Str.string_match PrintCsyntax.re_string_literal (extern_atom name) 0
&& List.for_all (function Init_int8 _ -> true | _ -> false) id
@@ -87,10 +109,25 @@ module Printer(Target:TARGET) =
| Gfun (Internal code) -> print_function oc name code
| Gfun (External ef) -> ()
| Gvar v -> print_var oc name v
-
+
+ module DwarfTarget: DwarfTypes.DWARF_TARGET =
+ struct
+ let label = Target.label
+ let name_of_section = Target.name_of_section
+ let print_file_loc = Target.print_file_loc
+ let get_start_addr = Target.get_start_addr
+ let get_end_addr = Target.get_end_addr
+ let get_stmt_list_addr = Target.get_stmt_list_addr
+ let name_of_section = Target.name_of_section
+ let get_fun_addr s = Hashtbl.find addr_mapping s
+ end
+
+ module DebugPrinter = DwarfPrinter (DwarfTarget) (Target.DwarfAbbrevs)
+
+
end
-let print_program oc p =
+let print_program oc p db =
let module Target = (val (sel_target ()):TARGET) in
let module Printer = Printer(Target) in
PrintAnnot.reset_filenames ();
@@ -98,4 +135,11 @@ let print_program oc p =
Target.print_prologue oc;
List.iter (Printer.print_globdef oc) p.prog_defs;
Target.print_epilogue oc;
- PrintAnnot.close_filenames ()
+ PrintAnnot.close_filenames ();
+ if !Clflags.option_g && Configuration.advanced_debug then
+ begin
+ match db with
+ | None -> ()
+ | Some db ->
+ Printer.DebugPrinter.print_debug oc db
+ end
diff --git a/backend/PrintAsm.mli b/backend/PrintAsm.mli
index eb63f1be..0b2869b0 100644
--- a/backend/PrintAsm.mli
+++ b/backend/PrintAsm.mli
@@ -11,6 +11,4 @@
(* *)
(* *********************************************************************)
-open PrintAsmaux
-
-val print_program: out_channel -> Asm.program -> unit
+val print_program: out_channel -> Asm.program -> DwarfTypes.dw_entry option -> unit
diff --git a/backend/PrintAsmaux.ml b/backend/PrintAsmaux.ml
index 64db2cb0..8bc961ef 100644
--- a/backend/PrintAsmaux.ml
+++ b/backend/PrintAsmaux.ml
@@ -14,6 +14,7 @@
open AST
open Asm
open Camlcoq
+open DwarfTypes
open Datatypes
open Printf
open Sections
@@ -43,6 +44,13 @@ module type TARGET =
val comment: string
val symbol: out_channel -> P.t -> unit
val default_falignment: int
+ val get_start_addr: unit -> int
+ val get_end_addr: unit -> int
+ val get_stmt_list_addr: unit -> int
+ val new_label: unit -> int
+ val label: out_channel -> int -> unit
+ val print_file_loc: out_channel -> file_loc -> unit
+ module DwarfAbbrevs: DWARF_ABBREVS
end
(* On-the-fly label renaming *)