(* *********************************************************************) (* *) (* The Compcert verified compiler *) (* *) (* Bernhard Schommer, AbsInt Angewandte Informatik GmbH *) (* *) (* AbsInt Angewandte Informatik GmbH. All rights reserved. This file *) (* is distributed under the terms of the INRIA Non-Commercial *) (* License Agreement. *) (* *) (* *********************************************************************) (* Printer for the Dwarf 2 debug information in ASM *) open DwarfTypes open DwarfUtil open Printf open PrintAsmaux open Sections (* The printer is parameterized over target specific functions and a set of dwarf type constants *) module DwarfPrinter(Target: DWARF_TARGET): sig val print_debug: out_channel -> debug_entries -> unit end = struct open Target (* Do we need verbose debug information? *) let include_comment = !Clflags.option_S || !Clflags.option_dasm (* Print comments needed for verbose debug mode *) let print_comment = if include_comment then (fun oc s -> if s <> "" then fprintf oc " %s %s" comment s) else (fun _ _ -> ()) let string_of_comment = if include_comment then (fun s -> String.concat " " ["";comment;s]) else (fun _ -> "") (* Byte value to string *) let string_of_byte value ct = sprintf " .byte %s%s\n" (if value then "0x1" else "0x0") (string_of_comment ct) (* Print a label *) let print_label oc lbl = fprintf oc "%a:\n" label lbl (* Helper functions for abbreviation printing *) let add_byte buf value ct = Buffer.add_string buf (string_of_byte value ct) let add_abbr_uleb v ct buf = Buffer.add_string buf (sprintf " .uleb128 %d%s\n" v (string_of_comment ct)) let add_abbr_entry (v1,c1,v2) buf = add_abbr_uleb v1 c1 buf; let v2,c2 = code_of_dw_form v2 in Buffer.add_string buf (sprintf " .uleb128 %d%s\n" v2 (string_of_comment c2)) let add_file_loc buf = add_abbr_entry (0x3a,"DW_AT_decl_file",DW_FORM_data4) buf; add_abbr_entry (0x3b,"DW_AT_decl_line",DW_FORM_udata) buf let add_type = add_abbr_entry (0x49,"DW_AT_type",DW_FORM_ref_addr) let add_byte_size = add_abbr_entry (0x0b,"DW_AT_byte_size",DW_FORM_data1) let add_member_size = add_abbr_entry (0x0b,"DW_AT_byte_size",DW_FORM_udata) let add_low_pc = add_abbr_entry (0x11,"DW_AT_low_pc",DW_FORM_addr) let add_declaration = add_abbr_entry (0x3c,"DW_AT_declaration",DW_FORM_flag) let add_string buf id c = function | Simple_string _ -> add_abbr_entry (id,c,DW_FORM_string) buf | Offset_string _ -> add_abbr_entry (id,c,DW_FORM_strp) buf let add_name buf = add_string buf 0x3 "DW_AT_name" let add_name_opt buf = function | None -> () | Some s -> add_name buf s let add_location loc buf = match loc with | None -> () | Some (LocRef _) -> add_abbr_entry (0x2,"DW_AT_location",DW_FORM_data4) buf | Some (LocList _ ) | Some (LocSymbol _) | Some (LocSimple _) -> add_abbr_entry (0x2,"DW_AT_location",DW_FORM_block) buf let add_range buf = function | Pc_pair _ -> add_abbr_entry (0x11,"DW_AT_low_pc",DW_FORM_addr) buf; add_abbr_entry (0x12,"DW_AT_high_pc",DW_FORM_addr) buf | Offset _ -> add_abbr_entry (0x55,"DW_AT_ranges",DW_FORM_data4) buf | Empty -> () (* Dwarf entity to string function *) let abbrev_string_of_entity entity has_sibling = let buf = Buffer.create 12 in let add_attr_some v f = match v with | None -> () | Some _ -> f buf in let prologue id c = let has_child = match entity.children with | [] -> false | _ -> true in add_abbr_uleb id c buf; add_byte buf has_child (if has_child then "DW_CHILDREN_yes" else "DW_CHILDREN_no"); if has_sibling then add_abbr_entry (0x1,"DW_AT_sibling",DW_FORM_ref4) buf; in (match entity.tag with | DW_TAG_array_type _ -> prologue 0x1 "DW_TAG_array_type"; add_type buf | DW_TAG_base_type b -> prologue 0x24 "DW_TAG_base_type"; add_byte_size buf; add_attr_some b.base_type_encoding (add_abbr_entry (0x3e,"DW_AT_encoding",DW_FORM_data1)); add_name buf b.base_type_name; | DW_TAG_compile_unit e -> prologue 0x11 "DW_TAG_compile_unit"; add_string buf 0x1b "DW_AT_comp_dir" e.compile_unit_dir; add_range buf e.compile_unit_range; add_abbr_entry (0x13,"DW_AT_language",DW_FORM_udata) buf; add_name buf e.compile_unit_name; add_string buf 0x25 "DW_AT_producer" e.compile_unit_prod_name; add_abbr_entry (0x10,"DW_AT_stmt_list",DW_FORM_data4) buf; | DW_TAG_const_type _ -> prologue 0x26 "DW_TAG_const_type"; add_type buf | DW_TAG_enumeration_type e -> prologue 0x4 "DW_TAG_enumeration_type"; add_attr_some e.enumeration_file_loc add_file_loc; add_byte_size buf; add_attr_some e.enumeration_declaration add_declaration; add_name buf e.enumeration_name | DW_TAG_enumerator e -> prologue 0x28 "DW_TAG_enumerator"; add_abbr_entry (0x1c,"DW_AT_const_value",DW_FORM_sdata) buf; add_name buf e.enumerator_name | DW_TAG_formal_parameter e -> prologue 0x5 "DW_TAG_formal_parameter"; add_attr_some e.formal_parameter_artificial (add_abbr_entry (0x34,"DW_AT_artificial",DW_FORM_flag)); add_name_opt buf e.formal_parameter_name; add_type buf; add_attr_some e.formal_parameter_variable_parameter (add_abbr_entry (0x4b,"DW_AT_variable_parameter",DW_FORM_flag)); add_location e.formal_parameter_location buf | DW_TAG_label e -> prologue 0xa "DW_TAG_label"; add_low_pc buf; add_name buf e.label_name; | DW_TAG_lexical_block a -> prologue 0xb "DW_TAG_lexical_block"; add_range buf a.lexical_block_range; | DW_TAG_member e -> prologue 0xd "DW_TAG_member"; add_attr_some e.member_byte_size add_byte_size; add_attr_some e.member_bit_offset (add_abbr_entry (0xc,"DW_AT_bit_offset",DW_FORM_data1)); add_attr_some e.member_bit_size (add_abbr_entry (0xd,"DW_AT_bit_size",DW_FORM_data1)); add_attr_some e.member_declaration add_declaration; add_name_opt buf e.member_name; add_type buf; (match e.member_data_member_location with | None -> () | Some (DataLocBlock __) -> add_abbr_entry (0x38,"DW_AT_data_member_location",DW_FORM_block) buf | Some (DataLocRef _) -> add_abbr_entry (0x38,"DW_AT_data_member_location",DW_FORM_ref4) buf) | DW_TAG_pointer_type _ -> prologue 0xf "DW_TAG_pointer_type"; add_type buf | DW_TAG_structure_type e -> prologue 0x13 "DW_TAG_structure_type"; add_attr_some e.structure_file_loc add_file_loc; add_attr_some e.structure_byte_size add_member_size; add_attr_some e.structure_declaration add_declaration; add_name_opt buf e.structure_name | DW_TAG_subprogram e -> prologue 0x2e "DW_TAG_subprogram"; add_file_loc buf; add_attr_some e.subprogram_external (add_abbr_entry (0x3f,"DW_AT_external",DW_FORM_flag)); add_range buf e.subprogram_range; add_name buf e.subprogram_name; add_abbr_entry (0x27,"DW_AT_prototyped",DW_FORM_flag) buf; add_attr_some e.subprogram_type add_type; | DW_TAG_subrange_type e -> prologue 0x21 "DW_TAG_subrange_type"; add_type buf; (match e.subrange_upper_bound with | None -> () | Some (BoundConst _) -> add_abbr_entry (0x2f,"DW_AT_upper_bound",DW_FORM_udata) buf | Some (BoundRef _) -> add_abbr_entry (0x2f,"DW_AT_upper_bound",DW_FORM_ref4) buf) | DW_TAG_subroutine_type e -> prologue 0x15 "DW_TAG_subroutine_type"; add_attr_some e.subroutine_type add_type; add_abbr_entry (0x27,"DW_AT_prototyped",DW_FORM_flag) buf | DW_TAG_typedef e -> prologue 0x16 "DW_TAG_typedef"; add_attr_some e.typedef_file_loc add_file_loc; add_name buf e.typedef_name; add_type buf | DW_TAG_union_type e -> prologue 0x17 "DW_TAG_union_type"; add_attr_some e.union_file_loc add_file_loc; add_attr_some e.union_byte_size add_member_size; add_attr_some e.union_declaration add_declaration; add_name_opt buf e.union_name | DW_TAG_unspecified_parameter e -> prologue 0x18 "DW_TAG_unspecified_parameter"; add_attr_some e.unspecified_parameter_artificial (add_abbr_entry (0x34,"DW_AT_artificial",DW_FORM_flag)) | DW_TAG_variable e -> prologue 0x34 "DW_TAG_variable"; add_file_loc buf; add_attr_some e.variable_declaration add_declaration; add_attr_some e.variable_external (add_abbr_entry (0x3f,"DW_AT_external",DW_FORM_flag)); add_location e.variable_location buf; add_name buf e.variable_name; add_type buf | DW_TAG_volatile_type _ -> prologue 0x35 "DW_TAG_volatile_type"; add_type buf); Buffer.contents buf let abbrev_start_addr = ref (-1) let curr_abbrev = ref 1 (* Function to get unique abbreviation ids *) let next_abbrev () = let abbrev = !curr_abbrev in incr curr_abbrev;abbrev (* Mapping from abbreviation string to abbreviation id *) let abbrev_mapping: (string,int) Hashtbl.t = Hashtbl.create 7 (* Mapping from abbreviation range id to label *) let range_labels : (int, int) Hashtbl.t = Hashtbl.create 7 (* Look up the id of the abbreviation and add it if it is missing *) let get_abbrev entity has_sibling = let abbrev_string = abbrev_string_of_entity entity has_sibling in (try Hashtbl.find abbrev_mapping abbrev_string with Not_found -> let id = next_abbrev () in Hashtbl.add abbrev_mapping abbrev_string id; id) (* Compute the abbreviations of an entry and its children *) let compute_abbrev entry = entry_iter_sib (fun sib entry -> let has_sib = match sib with | None -> false | Some _ -> true in ignore (get_abbrev entry has_sib)) (fun _ -> ()) entry (* Print the debug_abbrev section using the previous computed abbreviations*) let print_abbrev oc = let abbrevs = Hashtbl.fold (fun s i acc -> (s,i)::acc) abbrev_mapping [] in let abbrevs = List.sort (fun (_,a) (_,b) -> compare a b) abbrevs in section oc Section_debug_abbrev; print_label oc !abbrev_start_addr; List.iter (fun (s,id) -> fprintf oc " .uleb128 %d%a\n" id print_comment "Abbreviation Code"; output_string oc s; fprintf oc " .uleb128 0%a\n" print_comment "EOM(1)"; fprintf oc " .uleb128 0%a\n" print_comment "EOM(2)") abbrevs; fprintf oc " .sleb128 0%a\n" print_comment "EOM(3)" let debug_start_addr = ref (-1) let debug_stmt_list = ref (-1) let debug_ranges_addr = ref (-1) let entry_labels: (int,int) Hashtbl.t = Hashtbl.create 7 (* Translate the ids to address labels *) let entry_to_label id = try Hashtbl.find entry_labels id with Not_found -> let label = new_label () in Hashtbl.add entry_labels id label; label let loc_labels: (int,int) Hashtbl.t = Hashtbl.create 7 (* Translate the ids to address labels *) let loc_to_label id = try Hashtbl.find loc_labels id with Not_found -> let label = new_label () in Hashtbl.add loc_labels id label; label let print_loc_ref oc c r = let ref = loc_to_label r in fprintf oc " .4byte %a%a\n" label ref print_comment c (* Helper functions for debug printing *) let print_opt_value oc c o f = match o with | None -> () | Some o -> f oc c o let print_flag oc c b = output_string oc (string_of_byte b c) let print_string oc c = function | Simple_string s -> fprintf oc " .asciz %S%a\n" s print_comment c | Offset_string (o,s) -> let c = sprintf "%s %s" c s in print_loc_ref oc c o let print_uleb128 oc c d = fprintf oc " .uleb128 %d%a\n" d print_comment c let print_sleb128 oc c d = fprintf oc " .sleb128 %d%a\n" d print_comment c let print_byte oc c b = fprintf oc " .byte 0x%X%a\n" b print_comment c let print_2byte oc c b = fprintf oc " .2byte 0x%X%a\n" b print_comment c let print_ref oc c r = let ref = entry_to_label r in fprintf oc " .4byte %a%a\n" label ref print_comment c let print_file_loc oc = function | Some (Diab_file_loc (file,col)) -> fprintf oc " .4byte %a%a\n" label file print_comment "DW_AT_decl_file"; print_uleb128 oc "DW_AT_decl_line" col | Some (Gnu_file_loc (file,col)) -> fprintf oc " .4byte %l%a\n" file print_comment "DW_AT_decl_file"; print_uleb128 oc "DW_AT_decl_line" col | None -> () let print_loc_expr oc = function | DW_OP_bregx (a,b) -> print_byte oc "DW_OP_bregx" dw_op_bregx; print_uleb128 oc "Register number" a; print_sleb128 oc "Offset" (Int32.to_int b); | DW_OP_plus_uconst i -> print_byte oc "DW_OP_plus_uconst" dw_op_plus_uconst; print_uleb128 oc "Constant" i | DW_OP_piece i -> print_byte oc "DW_op_piece" dw_op_piece; print_uleb128 oc "Piece" i | DW_OP_reg i -> if i < 32 then print_byte oc "DW_op_reg" (dw_op_reg0 + i) else begin print_byte oc "DW_op_regx" dw_op_regx; print_uleb128 oc "Register number" i end let print_loc oc c loc = match loc with | LocSymbol s -> print_sleb128 oc c (1 + !Machine.config.Machine.sizeof_ptr); print_byte oc "" dw_op_addr; fprintf oc " %s %a\n" address symbol s | LocSimple e -> print_sleb128 oc c (size_of_loc_expr e); print_loc_expr oc e | LocList e -> let size = List.fold_left (fun acc a -> acc + size_of_loc_expr a) 0 e in print_sleb128 oc "" size; List.iter (print_loc_expr oc) e | LocRef f -> print_loc_ref oc c f let print_list_loc oc = function | LocSymbol s -> print_2byte oc "" (1 + !Machine.config.Machine.sizeof_ptr); print_byte oc "" dw_op_addr; fprintf oc " %s %a\n" address symbol s | LocSimple e -> print_2byte oc "" (size_of_loc_expr e); print_loc_expr oc e | LocList e -> let size = List.fold_left (fun acc a -> acc + size_of_loc_expr a) 0 e in print_2byte oc "" size; List.iter (print_loc_expr oc) e | LocRef f -> print_loc_ref oc "" f let print_data_location oc c dl = match dl with | DataLocBlock e -> print_sleb128 oc c (size_of_loc_expr e); print_loc_expr oc e | _ -> () let print_addr oc c a = fprintf oc " %s %a%a\n" address label a print_comment c let print_data4_addr oc c a = fprintf oc " .4byte %a%a\n" label a print_comment c let print_array_type oc at = print_ref oc "DW_AT_type" at.array_type let print_bound_value oc c = function | BoundConst bc -> print_uleb128 oc c bc | BoundRef br -> print_ref oc c br let print_base_type oc bt = print_byte oc "DW_AT_byte_size" bt.base_type_byte_size; (match bt.base_type_encoding with | Some e -> let encoding = match e with | DW_ATE_address -> 0x1 | DW_ATE_boolean -> 0x2 | DW_ATE_complex_float -> 0x3 | DW_ATE_float -> 0x4 | DW_ATE_signed -> 0x5 | DW_ATE_signed_char -> 0x6 | DW_ATE_unsigned -> 0x7 | DW_ATE_unsigned_char -> 0x8 in print_byte oc "DW_AT_encoding" encoding; | None -> ()); print_string oc "DW_AT_name" bt.base_type_name let print_range oc = function | Pc_pair (l,h) -> print_addr oc "DW_AT_low_pc" l; print_addr oc "DW_AT_high_pc" h | Offset i -> let lbl = new_label () in Hashtbl.add range_labels i lbl; fprintf oc " .4byte %a%a\n" label lbl print_comment "DW_AT_ranges" | _ -> () let print_compilation_unit oc tag = print_string oc "DW_AT_comp_dir" tag.compile_unit_dir; print_range oc tag.compile_unit_range; print_uleb128 oc "DW_AT_language" 1; print_string oc "DW_AT_name" tag.compile_unit_name; print_string oc "DW_AT_producer" tag.compile_unit_prod_name; print_data4_addr oc "DW_AT_stmt_list" !debug_stmt_list let print_const_type oc ct = print_ref oc "DW_AT_type" ct.const_type let print_enumeration_type oc et = print_file_loc oc et.enumeration_file_loc; print_uleb128 oc "DW_AT_byte_size" et.enumeration_byte_size; print_opt_value oc "DW_AT_declaration" et.enumeration_declaration print_flag; print_string oc "DW_AT_name" et.enumeration_name let print_enumerator oc en = print_sleb128 oc "DW_AT_const_value" en.enumerator_value; print_string oc "DW_AT_name" en.enumerator_name let print_formal_parameter oc fp = print_opt_value oc "DW_AT_artificial" fp.formal_parameter_artificial print_flag; print_opt_value oc "DW_AT_name" fp.formal_parameter_name print_string; print_ref oc "DW_AT_type" fp.formal_parameter_type; print_opt_value oc "DW_AT_variable_parameter" fp.formal_parameter_variable_parameter print_flag; print_opt_value oc "DW_AT_location" fp.formal_parameter_location print_loc let print_tag_label oc tl = print_ref oc "DW_AT_low_pc" tl.label_low_pc; print_string oc "DW_AT_name" tl.label_name let print_lexical_block oc lb = print_range oc lb.lexical_block_range let print_member oc mb = print_opt_value oc "DW_AT_byte_size" mb.member_byte_size print_byte; print_opt_value oc "DW_AT_bit_offset" mb.member_bit_offset print_byte; print_opt_value oc "DW_AT_bit_size" mb.member_bit_size print_byte; print_opt_value oc "DW_AT_declaration" mb.member_declaration print_flag; print_opt_value oc "DW_AT_name" mb.member_name print_string; print_ref oc "DW_AT_type" mb.member_type; print_opt_value oc "DW_AT_data_member_location" mb.member_data_member_location print_data_location let print_pointer oc pt = print_ref oc "DW_AT_type" pt.pointer_type let print_structure oc st = print_file_loc oc st.structure_file_loc; print_opt_value oc "DW_AT_byte_size" st.structure_byte_size print_uleb128; print_opt_value oc "DW_AT_declaration" st.structure_declaration print_flag; print_opt_value oc "DW_AT_name" st.structure_name print_string let print_subprogram oc sp = print_file_loc oc (Some sp.subprogram_file_loc); print_opt_value oc "DW_AT_external" sp.subprogram_external print_flag; print_range oc sp.subprogram_range; print_string oc "DW_AT_name" sp.subprogram_name; print_flag oc "DW_AT_prototyped" sp.subprogram_prototyped; print_opt_value oc "DW_AT_type" sp.subprogram_type print_ref let print_subrange oc sr = print_ref oc "DW_AT_type" sr.subrange_type; print_opt_value oc "DW_AT_upper_bound" sr.subrange_upper_bound print_bound_value let print_subroutine oc st = print_opt_value oc "DW_AT_type" st.subroutine_type print_ref; print_flag oc "DW_AT_prototyped" st.subroutine_prototyped let print_typedef oc td = print_file_loc oc td.typedef_file_loc; print_string oc "DW_AT_name" td.typedef_name; print_ref oc "DW_AT_type" td.typedef_type let print_union_type oc ut = print_file_loc oc ut.union_file_loc; print_opt_value oc "DW_AT_byte_size" ut.union_byte_size print_uleb128; print_opt_value oc "DW_AT_declaration" ut.union_declaration print_flag; print_opt_value oc "DW_AT_name" ut.union_name print_string let print_unspecified_parameter oc up = print_opt_value oc "DW_AT_artificial" up.unspecified_parameter_artificial print_flag let print_variable oc var = print_file_loc oc (Some var.variable_file_loc); print_opt_value oc "DW_AT_declaration" var.variable_declaration print_flag; print_opt_value oc "DW_AT_external" var.variable_external print_flag; print_opt_value oc "DW_AT_location" var.variable_location print_loc; print_string oc "DW_AT_name" var.variable_name; print_ref oc "DW_AT_type" var.variable_type let print_volatile_type oc vt = print_ref oc "DW_AT_type" vt.volatile_type (* Print an debug entry *) let print_entry oc entry = entry_iter_sib (fun sib entry -> print_label oc (entry_to_label entry.id); let has_sib = match sib with | None -> false | Some _ -> true in let id = get_abbrev entry has_sib in print_sleb128 oc (sprintf "Abbrev [%d] %s" id (string_of_dw_tag entry.tag)) id; (match sib with | None -> () | Some s -> let lbl = entry_to_label s in fprintf oc " .4byte %a-%a%a\n" label lbl label !debug_start_addr print_comment "DW_AT_sibling"); begin match entry.tag with | DW_TAG_array_type arr_type -> print_array_type oc arr_type | DW_TAG_compile_unit comp -> print_compilation_unit oc comp | DW_TAG_base_type bt -> print_base_type oc bt | DW_TAG_const_type ct -> print_const_type oc ct | DW_TAG_enumeration_type et -> print_enumeration_type oc et | DW_TAG_enumerator et -> print_enumerator oc et | DW_TAG_formal_parameter fp -> print_formal_parameter oc fp | DW_TAG_label lb -> print_tag_label oc lb | DW_TAG_lexical_block lb -> print_lexical_block oc lb | DW_TAG_member mb -> print_member oc mb | DW_TAG_pointer_type pt -> print_pointer oc pt | DW_TAG_structure_type st -> print_structure oc st | DW_TAG_subprogram sb -> print_subprogram oc sb | DW_TAG_subrange_type sb -> print_subrange oc sb | DW_TAG_subroutine_type st -> print_subroutine oc st | DW_TAG_typedef tp -> print_typedef oc tp | DW_TAG_union_type ut -> print_union_type oc ut | DW_TAG_unspecified_parameter up -> print_unspecified_parameter oc up | DW_TAG_variable var -> print_variable oc var | DW_TAG_volatile_type vt -> print_volatile_type oc vt end) (fun e -> if e.children <> [] then print_sleb128 oc "End Of Children Mark" 0) entry (* Print the debug info section *) let print_debug_info oc start line_start entry = Hashtbl.reset entry_labels; debug_start_addr:= start; debug_stmt_list:= line_start; print_label oc start; let debug_length_start = new_label () (* Address used for length calculation *) and debug_end = new_label () in fprintf oc " .4byte %a-%a%a\n" label debug_end label debug_length_start print_comment "Length of Unit"; print_label oc debug_length_start; fprintf oc " .2byte 0x%d%a\n" !Clflags.option_gdwarf print_comment "DWARF version number"; (* Dwarf version *) print_data4_addr oc "Offset Into Abbrev. Section" !abbrev_start_addr; (* Offset into the abbreviation *) print_byte oc "Address Size (in bytes)" !Machine.config.Machine.sizeof_ptr; (* Sizeof pointer type *) print_entry oc entry; print_sleb128 oc "" 0; print_label oc debug_end (* End of the debug section *) let print_location_entry oc needs_base c_low l = print_label oc (loc_to_label l.loc_id); (* If we have multiple ranges per compilation unit we need to specify a base address for the location *) if needs_base then begin fprintf oc " %s -1\n" address; fprintf oc " %s %a\n" address label c_low; end; List.iter (fun (b,e,loc) -> fprintf oc " %s %a-%a\n" address label b label c_low; fprintf oc " %s %a-%a\n" address label e label c_low; print_list_loc oc loc) l.loc; fprintf oc " %s 0\n" address; fprintf oc " %s 0\n" address let print_location_entry_abs oc l = print_label oc (loc_to_label l.loc_id); List.iter (fun (b,e,loc) -> fprintf oc " %s %a\n" address label b; fprintf oc " %s %a\n" address label e; print_list_loc oc loc) l.loc; fprintf oc " %s 0\n" address; fprintf oc " %s 0\n" address let print_location_list oc needs_base l = let f l = match l.loc_sec_begin with | Some s -> print_location_entry oc needs_base s l | None -> print_location_entry_abs oc l in List.iter f l let list_opt l f = match l with | [] -> () | _ -> f () let print_diab_entries oc entries = let abbrev_start = new_label () in abbrev_start_addr := abbrev_start; List.iter (fun e -> compute_abbrev e.diab_entry) entries; print_abbrev oc; List.iter (fun e -> let name = if e.section_name <> ".text" then Some e.section_name else None in section oc (Section_debug_info name); print_debug_info oc e.start_label e.line_label e.diab_entry) entries; if List.exists (fun e -> match e.diab_locs with [] -> false | _ -> true) entries then begin section oc Section_debug_loc; List.iter (fun e -> print_location_list oc false e.diab_locs) entries end let print_ranges oc r = let print_range_entry = function | AddressRange l -> List.iter (fun (b,e) -> fprintf oc " %s %a\n" address label b; fprintf oc " %s %a\n" address label e) l; | OffsetRange (start, l) -> List.iter (fun (b,e) -> fprintf oc " %s %a-%a\n" address label b label start; fprintf oc " %s %a-%a\n" address label e label start) l in section oc Section_debug_ranges; print_label oc !debug_ranges_addr; List.iter (fun (lbl,l) -> print_label oc (Hashtbl.find range_labels lbl); print_range_entry l; fprintf oc " %s 0\n" address; fprintf oc " %s 0\n" address) r let print_gnu_entries oc entries = compute_abbrev entries.gnu_entry; let line_start = new_label () and start = new_label () and abbrev_start = new_label () and range_label = new_label () in debug_ranges_addr := range_label; abbrev_start_addr := abbrev_start; section oc (Section_debug_info None); print_debug_info oc start line_start entries.gnu_entry; print_abbrev oc; list_opt entries.gnu_locs (fun () -> section oc Section_debug_loc; print_location_list oc entries.several_secs entries.gnu_locs); list_opt entries.range_table (fun () -> print_ranges oc entries.range_table); section oc (Section_debug_line None); print_label oc line_start; list_opt entries.string_table (fun () -> section oc Section_debug_str; let s = List.sort (fun (a,_) (b,_) -> compare a b) entries.string_table in List.iter (fun (id,s) -> print_label oc (loc_to_label id); fprintf oc " .asciz %S\n" s) s) (* Print the debug info and abbrev section *) let print_debug oc debug = Hashtbl.clear abbrev_mapping; Hashtbl.clear range_labels; Hashtbl.clear loc_labels; match debug with | Diab entries -> print_diab_entries oc entries | Gnu entries -> print_gnu_entries oc entries end