diff options
| -rw-r--r-- | debug/DwarfTypes.ml | 12 | ||||
| -rw-r--r-- | powerpc/PrintDiab.ml | 88 |
2 files changed, 87 insertions, 13 deletions
diff --git a/debug/DwarfTypes.ml b/debug/DwarfTypes.ml index 70d31ef8..65e819de 100644 --- a/debug/DwarfTypes.ml +++ b/debug/DwarfTypes.ml @@ -78,16 +78,16 @@ type bound_value = type dw_tag_array_type = { - dw_at_decl_file: constant option; - dw_at_decl_line: constant option; - dw_at_type: reference; + array_type_file: constant option; + array_type_line: constant option; + array_type: reference; } type dw_tag_base_type = { - dw_at_byte_size: constant; - dw_at_encoding: encoding; - dw_at_name: string; + base_type_size: constant; + base_type_encoding: encoding; + base_type_name: string; } type dw_tag_compile_unit = diff --git a/powerpc/PrintDiab.ml b/powerpc/PrintDiab.ml index 2f4da2ee..6e1f1331 100644 --- a/powerpc/PrintDiab.ml +++ b/powerpc/PrintDiab.ml @@ -14,12 +14,11 @@ open Printf open Datatypes +open DwarfTypes open Camlcoq open Sections open Asm open PrintUtil - - module Diab_System = (struct @@ -39,7 +38,7 @@ module Diab_System = symbol_fragment oc s n "@sdax@l" | Csymbol_rel_high(s, n) -> symbol_fragment oc s n "@sdarx@ha" - + let ireg oc r = output_char oc 'r'; output_string oc (int_reg_name r) @@ -62,7 +61,7 @@ module Diab_System = | Section_jumptable -> ".text" | Section_user(s, wr, ex) -> sprintf ".section \"%s\",,%c" - s + s (match wr, ex with | true, true -> 'm' (* text+data *) | true, false -> 'd' (* data *) @@ -80,7 +79,7 @@ module Diab_System = fprintf oc " .d1line %s\n" line end - (* Emit .cfi directives *) + (* Emit .cfi directives *) let cfi_startproc oc = () let cfi_endproc oc = () @@ -89,10 +88,85 @@ module Diab_System = let cfi_rel_offset oc reg ofs = () - let print_prologue oc = fprintf oc " .xopt align-fill-text=0x60000000\n"; if !Clflags.option_g then fprintf oc " .xopt asm-debug-on\n" - + + let curr_abbrv = ref 0 + + let next_abbrv = + let abbrv = !curr_abbrv in + incr curr_abbrv;abbrv + + let abbrvs: string list ref = ref [] + + let abbrv_mapping: (string,int) Hashtbl.t = Hashtbl.create 7 + + let add_byte buf value = + let s = + if value then + " .byte 0x1\n" + else + + " .byte 0x0\n" + in + Buffer.add_string buf s + + let add_abbr_uleb buf v = + Buffer.add_string buf " .uleb128 "; + Buffer.add_string buf v; + Buffer.add_string buf "\n" + + let add_sibling buf = + add_abbr_uleb buf "1"; + add_abbr_uleb buf "19" + + let add_decl_file buf = + add_abbr_uleb buf "58"; + add_abbr_uleb buf "6" + + let add_decl_line buf = + add_abbr_uleb buf "59"; + add_abbr_uleb buf "15" + + let add_type buf = + add_abbr_uleb buf "73"; + add_abbr_uleb buf "16" + + let add_array_type buf a_typ = + (match a_typ.array_type_file with + | None -> () + | Some _ -> add_decl_file buf); + (match a_typ.array_type_line with + | None -> () + | Some _ -> add_decl_line buf); + add_type buf + + let add_name buf = + add_abbr_uleb buf "3"; + add_abbr_uleb buf "8" + + let abbrv_string_of_entity entity has_sibling = + let buf = Buffer.create 12 in + let has_child = (match entity.children with [] -> false | _ -> true) in + (match entity.tag with + | DW_TAG_array_type e -> + (add_abbr_uleb buf "1"; + add_byte buf has_child; + if has_sibling then add_sibling buf; + add_array_type buf e) + | _ -> ()); + Buffer.contents buf + + let get_abbrv entity has_sibling = + let abbrv_string = abbrv_string_of_entity entity has_sibling in + (try + Hashtbl.find abbrv_mapping abbrv_string + with Not_found -> + abbrvs:=abbrv_string::!abbrvs; + let id = next_abbrv in + Hashtbl.add abbrv_mapping abbrv_string id; + id) + end:SYSTEM) |