diff options
-rw-r--r-- | Makefile | 2 | ||||
-rw-r--r-- | Makefile.extr | 2 | ||||
-rw-r--r-- | backend/PrintAnnot.ml | 8 | ||||
-rw-r--r-- | common/Sections.ml | 2 | ||||
-rw-r--r-- | common/Sections.mli | 2 | ||||
-rw-r--r-- | debug/DwarfDiab.ml | 55 | ||||
-rw-r--r-- | debug/DwarfPrinter.ml | 356 | ||||
-rw-r--r-- | debug/DwarfTypes.ml | 248 | ||||
-rw-r--r-- | debug/DwarfUtil.ml | 88 | ||||
-rw-r--r-- | driver/Driver.ml | 2 |
10 files changed, 758 insertions, 7 deletions
@@ -15,7 +15,7 @@ include Makefile.config -DIRS=lib common $(ARCH) backend cfrontend driver \ +DIRS=lib common $(ARCH) backend cfrontend driver debug\ flocq/Core flocq/Prop flocq/Calc flocq/Appli exportclight \ cparser cparser/validator diff --git a/Makefile.extr b/Makefile.extr index fed2d78f..4e17e904 100644 --- a/Makefile.extr +++ b/Makefile.extr @@ -21,7 +21,7 @@ include Makefile.config DIRS=extraction \ lib common $(ARCH) backend cfrontend cparser driver \ - exportclight + exportclight debug # Directories containing Caml code that must be preprocessed by Camlp4 diff --git a/backend/PrintAnnot.ml b/backend/PrintAnnot.ml index 54174b9f..26f96370 100644 --- a/backend/PrintAnnot.ml +++ b/backend/PrintAnnot.ml @@ -66,10 +66,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 +77,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/common/Sections.ml b/common/Sections.ml index c6d4c4c2..086c860e 100644 --- a/common/Sections.ml +++ b/common/Sections.ml @@ -27,6 +27,8 @@ type section_name = | Section_literal | Section_jumptable | Section_user of string * bool (*writable*) * bool (*executable*) + | Section_debug + | Section_debug_abbrev type access_mode = | Access_default diff --git a/common/Sections.mli b/common/Sections.mli index 38b99db0..be716e48 100644 --- a/common/Sections.mli +++ b/common/Sections.mli @@ -26,6 +26,8 @@ type section_name = | Section_literal | Section_jumptable | Section_user of string * bool (*writable*) * bool (*executable*) + | Section_debug + | Section_debug_abbrev type access_mode = | Access_default diff --git a/debug/DwarfDiab.ml b/debug/DwarfDiab.ml new file mode 100644 index 00000000..a852053f --- /dev/null +++ b/debug/DwarfDiab.ml @@ -0,0 +1,55 @@ +(* *********************************************************************) +(* *) +(* 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. *) +(* *) +(* *********************************************************************) + +open Printf +open DwarfPrinter +open DwarfTypes +open DwarfUtil + +module AbbrvPrinter = DwarfPrinter(struct + let string_of_byte value = + Printf.sprintf " .byte %s\n" (if value then "0x1" else "0x2") + + let string_of_abbrv_entry v = + Printf.sprintf " .uleb128 %d\n" v + + let sibling_type_abbr = dw_form_ref4 + let decl_file_type_abbr = dw_form_data4 + let decl_line_type_abbr = dw_form_udata + let type_abbr = dw_form_ref_addr + let name_type_abbr = dw_form_string + let encoding_type_abbr = dw_form_data1 + let byte_size_type_abbr = dw_form_data1 + let high_pc_type_abbr = dw_form_addr + let low_pc_type_abbr = dw_form_addr + let stmt_list_type_abbr = dw_form_data4 + let declaration_type_abbr = dw_form_flag + let external_type_abbr = dw_form_flag + let prototyped_type_abbr = dw_form_flag + let bit_offset_type_abbr = dw_form_data1 + let comp_dir_type_abbr = dw_form_string + let language_type_abbr = dw_form_udata + let producer_type_abbr = dw_form_string + let value_type_abbr = dw_form_sdata + let artificial_type_abbr = dw_form_flag + let variable_parameter_type_abbr = dw_form_flag + let bit_size_type_abbr = dw_form_data1 + let location_const_type_abbr = dw_form_data4 + let location_block_type_abbr = dw_form_block + let data_location_block_type_abbr = dw_form_block + let data_location_ref_type_abbr = dw_form_ref4 + let bound_const_type_abbr = dw_form_udata + let bound_ref_type_abbr=dw_form_ref4 + + + +end) diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml new file mode 100644 index 00000000..81f36a24 --- /dev/null +++ b/debug/DwarfPrinter.ml @@ -0,0 +1,356 @@ +(* *********************************************************************) +(* *) +(* 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. *) +(* *) +(* *********************************************************************) + + +open DwarfTypes +open DwarfUtil + +module type DWARF_DEFS = + sig + (* Functions used for the printing of the dwarf abbreviations *) + val string_of_byte: bool -> string + val string_of_abbrv_entry: int -> string + val get_abbrv_start_addr: unit -> int + (* The form constants of the types *) + val sibling_type_abbr: int + val decl_file_type_abbr: int + val decl_line_type_abbr: int + val type_abbr: int + val name_type_abbr: int + val encoding_type_abbr: int + val byte_size_type_abbr: int + val high_pc_type_abbr: int + val low_pc_type_abbr: int + val stmt_list_type_abbr: int + val declaration_type_abbr: int + val external_type_abbr: int + val prototyped_type_abbr: int + val bit_offset_type_abbr: int + val comp_dir_type_abbr: int + val language_type_abbr: int + val producer_type_abbr: int + val value_type_abbr: int + val artificial_type_abbr: int + val variable_parameter_type_abbr: int + val bit_size_type_abbr: int + val location_const_type_abbr: int + val location_block_type_abbr: int + val data_location_block_type_abbr: int + val data_location_ref_type_abbr: int + val bound_const_type_abbr: int + val bound_ref_type_abbr: int + end + +module DwarfPrinter(Defs:DWARF_DEFS) : + sig + val print_debug: out_channel -> dw_entry -> unit + val get_abbrv: dw_entry -> bool -> int + val get_abbrv_start_addr: unit -> int + end = + (struct + + let curr_abbrv = ref 0 + + let next_abbrv = + let abbrv = !curr_abbrv in + incr curr_abbrv;abbrv + + let abbrvs: (string * int) list ref = ref [] + + let abbrv_mapping: (string,int) Hashtbl.t = Hashtbl.create 7 + + let add_byte buf value = + Buffer.add_string buf (Defs.string_of_byte value) + + let add_abbr_uleb v buf = + Buffer.add_string buf (Defs.string_of_abbrv_entry v) + + let add_abbr_entry (v1,v2) buf = + add_abbr_uleb v1 buf; + add_abbr_uleb v2 buf + + let add_sibling = add_abbr_entry (0x1,Defs.sibling_type_abbr) + + let add_decl_file = add_abbr_entry (0x3a,Defs.decl_file_type_abbr) + + let add_decl_line = add_abbr_entry (0x3b,Defs.decl_line_type_abbr) + + let add_type = add_abbr_entry (0x49,Defs.type_abbr) + + let add_name = add_abbr_entry (0x3,Defs.name_type_abbr) + + let add_encoding = add_abbr_entry (0x3e,Defs.encoding_type_abbr) + + let add_byte_size = add_abbr_entry (0xb,Defs.byte_size_type_abbr) + + let add_high_pc = add_abbr_entry (0x12,Defs.high_pc_type_abbr) + + let add_low_pc = add_abbr_entry (0x11,Defs.low_pc_type_abbr) + + let add_stmt_list = add_abbr_entry (0x10,Defs.stmt_list_type_abbr) + + let add_declaration = add_abbr_entry (0x3c,Defs.declaration_type_abbr) + + let add_external = add_abbr_entry (0x3f,Defs.external_type_abbr) + + let add_prototyped = add_abbr_entry (0x27,Defs.prototyped_type_abbr) + + let add_bit_offset = add_abbr_entry (0xd,Defs.bit_offset_type_abbr) + + let add_comp_dir = add_abbr_entry (0x1b,Defs.comp_dir_type_abbr) + + let add_language = add_abbr_entry (0x13,Defs.language_type_abbr) + + let add_producer = add_abbr_entry (0x25,Defs.producer_type_abbr) + + let add_value = add_abbr_entry (0x1c,Defs.value_type_abbr) + + let add_artificial = add_abbr_entry (0x34,Defs.artificial_type_abbr) + + let add_variable_parameter = add_abbr_entry (0x4b,Defs.variable_parameter_type_abbr) + + let add_bit_size = add_abbr_entry (0xc,Defs.bit_size_type_abbr) + + let add_location loc buf = + match loc with + | None -> () + | Some (LocConst _) -> add_abbr_entry (0x2,Defs.location_const_type_abbr) buf + | Some (LocBlock _) -> add_abbr_entry (0x2,Defs.location_block_type_abbr) buf + + let add_data_location loc buf = + match loc with + | None -> () + | Some (DataLocBlock __) -> add_abbr_entry (0x38,Defs.data_location_block_type_abbr) buf + | Some (DataLocRef _) -> add_abbr_entry (0x38,Defs.data_location_ref_type_abbr) buf + + let add_bound_value bound = + match bound with + | BoundConst _ -> add_abbr_entry (0x2f,Defs.bound_const_type_abbr) + | BoundRef _ -> add_abbr_entry (0x2f,Defs.bound_ref_type_abbr) + + let abbrv_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 = + let has_child = match entity.children with + | [] -> false + | _ -> true in + add_abbr_uleb id buf; + add_byte buf has_child; + if has_sibling then add_sibling buf; + in + (match entity.tag with + | DW_TAG_array_type e -> + prologue 0x1; + add_attr_some e.array_type_decl_file add_decl_file; + add_attr_some e.array_type_decl_line add_decl_line; + add_type buf + | DW_TAG_base_type _ -> + prologue 0x24; + add_encoding buf; + add_byte_size buf; + add_name buf + | DW_TAG_compile_unit e -> + prologue 0x11; + add_comp_dir buf; + add_high_pc buf; + add_low_pc buf; + add_language buf; + add_name buf; + add_producer buf; + add_attr_some e.compile_unit_stmt_list add_stmt_list + | DW_TAG_const_type _ -> + prologue 0x26; + add_type buf + | DW_TAG_enumeration_type e -> + prologue 0x4; + add_attr_some e.enumeration_decl_file add_decl_file; + add_attr_some e.enumeration_decl_line add_decl_line; + add_byte_size buf; + add_name buf; + add_attr_some e.enumeration_declaration add_declaration + | DW_TAG_enumerator e -> + prologue 0x28; + add_attr_some e.enumerator_decl_file add_decl_file; + add_attr_some e.enumerator_decl_line add_decl_line; + add_value buf; + add_name buf + | DW_TAG_formal_parameter e -> + prologue 0x34; + add_attr_some e.formal_parameter_decl_file add_decl_file; + add_attr_some e.formal_parameter_decl_line add_decl_line; + add_attr_some e.formal_parameter_artificial add_artificial; + add_location e.formal_parameter_location buf; + add_name buf; + add_location e.formal_parameter_segment buf; + add_type buf; + add_attr_some e.formal_parameter_variable_parameter add_variable_parameter + | DW_TAG_label _ -> + prologue 0xa; + add_low_pc buf; + add_name buf; + | DW_TAG_lexical_block _ -> + prologue 0xb; + add_high_pc buf; + add_low_pc buf + | DW_TAG_member e -> + prologue 0xd; + add_attr_some e.member_decl_file add_decl_file; + add_attr_some e.member_decl_line add_decl_line; + add_attr_some e.member_byte_size add_byte_size; + add_attr_some e.member_bit_offset add_bit_offset; + add_attr_some e.member_bit_size add_bit_size; + add_data_location e.member_data_member_location buf; + add_attr_some e.member_declaration add_declaration; + add_name buf; + add_type buf + | DW_TAG_pointer_type _ -> + prologue 0xf; + add_type buf + | DW_TAG_structure_type e -> + prologue 0x13; + add_attr_some e.structure_decl_file add_decl_file; + add_attr_some e.structure_decl_line add_decl_line; + add_byte_size buf; + add_attr_some e.structure_declaration add_declaration; + add_name buf + | DW_TAG_subprogram e -> + prologue 0x2e; + add_attr_some e.subprogram_decl_file add_decl_file; + add_attr_some e.subprogram_decl_line add_decl_line; + add_attr_some e.subprogram_external add_external; + add_high_pc buf; + add_low_pc buf; + add_name buf; + add_prototyped buf; + add_type buf + | DW_TAG_subrange_type e -> + prologue 0x21; + add_attr_some e.subrange_type add_type; + add_bound_value e.subrange_upper_bound buf + | DW_TAG_subroutine_type _ -> + prologue 0x15; + add_prototyped buf + | DW_TAG_typedef e -> + prologue 0x16; + add_attr_some e.typedef_decl_file add_decl_file; + add_attr_some e.typedef_decl_line add_decl_line; + add_name buf; + add_type buf + | DW_TAG_union_type e -> + prologue 0x17; + add_attr_some e.union_decl_file add_decl_file; + add_attr_some e.union_decl_line add_decl_line; + add_byte_size buf; + add_name buf + | DW_TAG_unspecified_parameter e -> + prologue 0x18; + add_attr_some e.unspecified_parameter_decl_file add_decl_file; + add_attr_some e.unspecified_parameter_decl_line add_decl_line; + add_attr_some e.unspecified_parameter_artificial add_artificial + | DW_TAG_variable e -> + prologue 0x34; + add_attr_some e.variable_decl_file add_decl_file; + add_attr_some e.variable_decl_line add_decl_line; + add_attr_some e.variable_declaration add_declaration; + add_attr_some e.variable_external add_external; + add_location e.variable_location buf; + add_name buf; + add_location e.variable_segment buf; + add_type buf + | DW_TAG_volatile_type _ -> + prologue 0x35; + add_type buf); + 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 -> + let id = next_abbrv in + abbrvs:=(abbrv_string,id)::!abbrvs; + Hashtbl.add abbrv_mapping abbrv_string id; + id) + + let compute_abbrv entry = + entry_iter_sib (fun sib entry -> + let has_sib = match sib with + | None -> false + | Some _ -> true in + ignore (get_abbrv entry has_sib)) entry + + let abbrv_section_start oc = + fprintf oc " .section .debug_abbrev,,n\n"(* ; *) + (* let lbl = new_label () in *) + (* abbrv_start_addr := lbl; *) + (* fprintf oc "%a:\n" label lbl *) + + let abbrv_section_end oc = + fprintf oc " .section .debug_abbrev,,n\n"; + fprintf oc " .sleb128 0\n" + + let abbrv_prologue oc id = + fprintf oc " .section .debug_abbrev,,n\n"; + fprintf oc " .uleb128 %d\n" id + + let abbrv_epilogue oc = + fprintf oc " .uleb128 0\n"; + fprintf oc " .uleb128 0\n" + + + let print_abbrv oc = + let abbrvs = List.sort (fun (_,a) (_,b) -> Pervasives.compare a b) !abbrvs in + Defs.abbrv_section_start oc; + List.iter (fun (s,id) -> + Defs.abbrv_prologue oc id; + output_string oc s; + Defs.abbrv_epilogue oc) abbrvs; + Defs.abbrv_section_end oc + + + let rec print_entry oc entry has_sibling = + () + + let print_debug_abbrv oc entry = + compute_abbrv entry; + print_abbrv oc + + let print_debug_info oc entry = + print_debug_abbrv oc entry; + let abbrv_start = DwarfDiab.AbbrvPrinter.get_abbrv_start_addr () in + let debug_start = new_label () in + let print_info () = + fprintf oc" .section .debug_info,,n\n" in + print_info (); + fprintf oc "%a\n" label debug_start; + let debug_length_start = new_label () in (* Address used for length calculation *) + let debug_end = new_label () in + fprintf oc " .4byte %a-%a\n" label debug_end label debug_length_start; + fprintf oc "%a\n" label debug_length_start; + fprintf oc " .2byte 0x2\n"; (* Dwarf version *) + fprintf oc " .4byte %a\n" label abbrv_start; (* Offset into the abbreviation *) + fprintf oc " .byte %X\n" !Machine.config.Machine.sizeof_ptr; (* Sizeof pointer type *) + print_entry oc entry false; + fprintf oc "%a\n" label debug_end; (* End of the debug section *) + fprintf oc " .sleb128 0\n" + + + let abbrv_start_addr = ref (-1) + + let get_abbrv_start_addr () = !abbrv_start_addr + + + end) diff --git a/debug/DwarfTypes.ml b/debug/DwarfTypes.ml new file mode 100644 index 00000000..5a832bdf --- /dev/null +++ b/debug/DwarfTypes.ml @@ -0,0 +1,248 @@ +(* *********************************************************************) +(* *) +(* 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. *) +(* *) +(* *********************************************************************) + +(* Types used for writing dwarf debug information *) + +(* Basic types for the value of attributes *) + +type constant = int + +type flag = bool + +type reference = int + +type encoding = + | DW_ATE_address + | DW_ATE_boolean + | DW_ATE_complex_float + | DW_ATE_float + | DW_ATE_signed + | DW_ATE_signed_char + | DW_ATE_unsigned + | DW_ATE_unsigned_char + +type address = int + +type language = + | DW_LANG_C + | DW_LANG_C89 + +type block = string + +type location_value = + | LocConst of constant + | LocBlock of block + +type data_location_value = + | DataLocBlock of block + | DataLocRef of reference + +type bound_value = + | BoundConst of constant + | BoundRef of reference + +(* Types representing the attribute information per tag value *) + +type dw_tag_array_type = + { + array_type_decl_file: string option; + array_type_decl_line: constant option; + array_type: reference; + } + +type dw_tag_base_type = + { + base_type_byte_size: constant; + base_type_encoding: encoding; + base_type_name: string; + } + +type dw_tag_compile_unit = + { + compile_unit_comp_dir: string; + compile_unit_high_pc: address; + compile_unit_low_pc: address; + compile_unit_language: language; + compile_unit_name: string; + compile_unit_producer: string; + compile_unit_stmt_list: constant option; + } + +type dw_tag_const_type = + { + const_type: reference; + } + +type dw_tag_enumeration_type = + { + enumeration_decl_file: string option; + enumeration_decl_line: constant option; + enumeration_byte_size: constant; + enumeration_declaration: flag option; + enumeration_name: string; + } + +type dw_tag_enumerator = + { + enumerator_decl_file: string option; + enumerator_decl_line: constant option; + enumerator_value: constant; + enumerator_name: string; + } + +type dw_tag_formal_parameter = + { + formal_parameter_decl_file: string option; + formal_parameter_decl_line: constant option; + formal_parameter_artificial: flag option; + formal_parameter_location: location_value option; + formal_parameter_name: string; + formal_parameter_segment: location_value option; + formal_parameter_type: reference; + formal_parameter_variable_parameter: flag option; + } + +type dw_tag_label = + { + label_low_pc: address; + label_name: string; + } + +type dw_tag_lexical_block = + { + lexical_block__high_pc: address; + lexical_block_low_pc: address; + } + +type dw_tag_member = + { + member_decl_file: string option; + member_decl_line: constant option; + member_byte_size: constant option; + member_bit_offset: constant option; + member_bit_size: constant option; + member_data_member_location: data_location_value option; + member_declaration: flag option; + member_name: string; + member_type: reference; + } + +type dw_tag_pointer_type = + { + pointer_type: reference; + } + +type dw_tag_structure_type = + { + structure_decl_file: string option; + structure_decl_line: constant option; + structure_byte_size: constant; + structure_declaration: flag option; + structure_name: string; + } + +type dw_tag_subprogram = + { + subprogram_decl_file: string option; + subprogram_decl_line: constant option; + subprogram_external: flag option; + subprogram_frame_base: location_value option; + subprogram_high_pc: address; + subprogram_low_pc: address; + subprogram_name: string; + subprogram_prototyped: flag; + subprogram_type: reference; + } + +type dw_tag_subrange_type = + { + subrange_type: reference option; + subrange_upper_bound: bound_value; + } + +type dw_tag_subroutine_type = + { + subroutine_prototyped: flag; + } + +type dw_tag_typedef = + { + typedef_decl_file: string option; + typedef_decl_line: constant option; + typedef_name: string; + typedef_type: reference; + } + +type dw_tag_union_type = + { + union_decl_file: string option; + union_decl_line: constant option; + union_byte_size: constant; + union_name: string; + } + +type dw_tag_unspecified_parameter = + { + unspecified_parameter_decl_file: string option; + unspecified_parameter_decl_line: constant option; + unspecified_parameter_artificial: flag option; + } + +type dw_tag_variable = + { + variable_decl_file: string option; + variable_decl_line: constant option; + variable_declaration: flag option; + variable_external: flag option; + variable_location: location_value option; + variable_name: string; + variable_segment: location_value option; + variable_type: reference; + } + +type dw_tag_volatile_type = + { + volatile_type: reference; + } + +type dw_tag = + | DW_TAG_array_type of dw_tag_array_type + | DW_TAG_base_type of dw_tag_base_type + | DW_TAG_compile_unit of dw_tag_compile_unit + | DW_TAG_const_type of dw_tag_const_type + | DW_TAG_enumeration_type of dw_tag_enumeration_type + | DW_TAG_enumerator of dw_tag_enumerator + | DW_TAG_formal_parameter of dw_tag_formal_parameter + | DW_TAG_label of dw_tag_label + | DW_TAG_lexical_block of dw_tag_lexical_block + | DW_TAG_member of dw_tag_member + | DW_TAG_pointer_type of dw_tag_pointer_type + | DW_TAG_structure_type of dw_tag_structure_type + | DW_TAG_subprogram of dw_tag_subprogram + | DW_TAG_subrange_type of dw_tag_subrange_type + | DW_TAG_subroutine_type of dw_tag_subroutine_type + | DW_TAG_typedef of dw_tag_typedef + | DW_TAG_union_type of dw_tag_union_type + | DW_TAG_unspecified_parameter of dw_tag_unspecified_parameter + | DW_TAG_variable of dw_tag_variable + | DW_TAG_volatile_type of dw_tag_volatile_type + +(* The type of the entries. *) + +type dw_entry = + { + tag: dw_tag; + children: dw_entry list; + id: reference; + } + + diff --git a/debug/DwarfUtil.ml b/debug/DwarfUtil.ml new file mode 100644 index 00000000..79516e65 --- /dev/null +++ b/debug/DwarfUtil.ml @@ -0,0 +1,88 @@ +(* *********************************************************************) +(* *) +(* 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. *) +(* *) +(* *********************************************************************) + +(* Utility functions for the dwarf debuging type *) + +open DwarfTypes + +let id = ref 0 + +let next_id () = + let nid = !id in + incr id; nid + +let reset_id () = + id := 0 + +(* Hashtable to from type name to entry id *) +let type_table: (string, int) Hashtbl.t = Hashtbl.create 7 + +(* Clear the type map *) +let reset_type_table () = + Hashtbl.clear type_table + +(* Generate a new entry from a given tag *) +let new_entry tag = + let id = next_id () in + { + tag = tag; + children = []; + id = id; + } + +(* Add an entry as child to another entry *) +let add_children entry child = + {entry with children = child::entry.children;} + + +let list_iter_with_next f list = + let rec aux = (function + | [] -> () + | [a] -> f None a + | a::b::rest -> f (Some b.id) a; aux (b::rest)) in + aux list + +(* Iter over the tree and pass the sibling id *) +let entry_iter_sib f entry = + let rec aux sib entry = + f sib entry; + list_iter_with_next aux entry.children in + aux None entry + + +(* Fold over the tree in prefix order *) +let rec entry_fold f acc entry = + let acc = f acc entry.tag in + List.fold_left (entry_fold f) acc entry.children + +(* Attribute form encoding *) +let dw_form_addr = 0x01 +let dw_form_block2 = 0x03 +let dw_form_block4 = 0x04 +let dw_form_data2 = 0x05 +let dw_form_data4 = 0x06 +let dw_form_data8 = 0x07 +let dw_form_string = 0x08 +let dw_form_block = 0x09 +let dw_form_block1 = 0x0a +let dw_form_data1 = 0x0b +let dw_form_flag = 0x0c +let dw_form_sdata = 0x0d +let dw_form_strp = 0x0e +let dw_form_udata = 0x0f +let dw_form_ref_addr = 0x10 +let dw_form_ref1 = 0x11 +let dw_form_ref2 = 0x12 +let dw_form_ref4 = 0x13 +let dw_form_ref8 = 0x14 +let dw_ref_udata = 0x15 +let dw_ref_indirect = 0x16 diff --git a/driver/Driver.ml b/driver/Driver.ml index d22dd77c..d8b28285 100644 --- a/driver/Driver.ml +++ b/driver/Driver.ml @@ -509,7 +509,7 @@ let cmdline_actions = Exact "-fall", Self (fun _ -> set_all language_support_options); Exact "-fnone", Self (fun _ -> unset_all language_support_options); (* Debugging options *) - Exact "-g", Self (fun s -> option_g := true; push_linker_arg s); + Exact "-g", Self (fun s -> option_g := true); (* Code generation options -- more below *) Exact "-O0", Self (fun _ -> unset_all optimization_options); Exact "-O", Self (fun _ -> set_all optimization_options); |