diff options
Diffstat (limited to 'gdb/testsuite/lib/dwarf.exp')
| -rw-r--r-- | gdb/testsuite/lib/dwarf.exp | 229 |
1 files changed, 224 insertions, 5 deletions
diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp index 356451b..3d833e5 100644 --- a/gdb/testsuite/lib/dwarf.exp +++ b/gdb/testsuite/lib/dwarf.exp @@ -2925,9 +2925,215 @@ namespace eval Dwarf { } } + # Emit a DWARF .debug_names section. + # + # OPTIONS is a list with an even number of elements containing + # option-name and option-value pairs. + # Current options are: + # is_64 0|1 - boolean indicating if the section contains 64-bit DWARF. + # default = 0 (32-bit) + # version n - section version. + # default = 5. + # + # BODY is Tcl code that emits the parts which make up the body of + # the .debug_names section. It is evaluated in the caller's context. + # The following commands are available for the BODY section: + # + # cu <cu-label> + # -- add a CU. + # + # name <name> <tag> <cu> <hash> + # -- add a name. + + proc debug_names { options body } { + parse_options { + { is_64 0 } + { version 5 } + } + + variable _debug_names_offset_size + if { $is_64 == 1 } { + set _debug_names_offset_size 8 + } else { + set _debug_names_offset_size 4 + } + + # Section start. + set section ".debug_names" + _section $section + + # Header - initial length. + declare_labels debug_names_start debug_names_end + set length "$debug_names_end - $debug_names_start" + set comment "Initial_length" + if { $is_64 } { + _op .4byte 0xffffffff + _op .8byte $length $comment + } else { + _op .4byte $length $comment + } + + # Header - start label. + debug_names_start: + + # Header - version + padding. + _op .2byte $version "Version" + _op .2byte 0 "Padding" + + # Parse the body. + variable _debug_names_cus + set _debug_names_cus [] + proc _debug_names_cu { cu } { + variable _debug_names_cus + lappend _debug_names_cus $cu + } + variable _debug_names + set _debug_names [] + proc _debug_names_name { name tag cu hash } { + variable _debug_names + declare_labels entry_pool_offset + lappend _debug_names [list $name $tag $cu $hash $entry_pool_offset] + } + with_override Dwarf::cu Dwarf::_debug_names_cu { + with_override Dwarf::name Dwarf::_debug_names_name { + uplevel $body + }} + + # Header - CU / TU / foreign TU count. + _op .4byte [llength $_debug_names_cus] "Comp_unit_count" + _op .4byte 0 "Local_type_unit_count" + _op .4byte 0 "Foreign_type_unit_count" + + # Header - bucket count. + _op .4byte 1 "Bucket_count" + + # Header - name count. + _op .4byte [llength $_debug_names] "Name_count" + + # Header - abbreviation table size. + declare_labels debug_names_abbrev_table_start \ + debug_names_abbrev_table_end + set abbrev_table_size \ + "$debug_names_abbrev_table_end - $debug_names_abbrev_table_start" + _op .4byte $abbrev_table_size "Abbrev_table_size" + + # Header - augmentation string. + _op .4byte 4 "Augmentation_string_size" + _op .ascii [_quote GDB] "Augmentation_string" + + # List of CUs. + set comment "CU offset" + foreach cu $_debug_names_cus { + upvar $cu tmp + if { $is_64 } { + _op .8byte $tmp $comment + } else { + _op .4byte $tmp $comment + } + } + + # List of Local TUs. + # + + # List of Foreign TUs. + # + + # Hash Lookup Table - array of buckets. + _op .4byte 1 "bucket: hash array index 1" + + # Hash Lookup Table - array of hashes. + foreach idx $_debug_names { + set name [lindex $idx 0] + set hash [lindex $idx 3] + _op .4byte $hash "hash: $name" + } + + # Name Table - array of string offsets. + foreach idx $_debug_names { + set name [lindex $idx 0] + + variable _strings + if {![info exists _strings($name)]} { + set _strings($name) [new_label strp] + _defer_output .debug_str { + define_label $_strings($name) + _op .ascii [_quote $name] + } + } + + _op_offset $_debug_names_offset_size $_strings($name) "name: $name" + } + + # Name Table - array of entry offsets. + set base_label "" + foreach idx $_debug_names { + set name [lindex $idx 0] + set label [lindex $idx 4] + if { [string equal $base_label ""]} { + set base_label $label + } + _op_offset $_debug_names_offset_size "$label - $base_label" \ + "entry pool offset: $name" + } + + # Abbreviations Table. + debug_names_abbrev_table_start: + set abbrev 1 + variable _constants + foreach idx $_debug_names { + set name [lindex $idx 0] + set tag [lindex $idx 1] + _op .byte $abbrev "abbrev $abbrev" + _op .uleb128 $_constants(DW_TAG_$tag) "DW_TAG_$tag" + _op .byte 1 "DW_IDX_compile_unit (attribute)" + _op .byte 0x0f "DW_FORM_udata (form)" + _op .byte 0 "abbrev terminator (attribute)" + _op .byte 0 "abbrev terminator (form)" + incr abbrev + } + _op .byte 0 "Abbreviations Table terminator" + debug_names_abbrev_table_end: + + # Entry Pool + set abbrev 1 + foreach idx $_debug_names { + set name [lindex $idx 0] + set cu [lindex $idx 2] + set label [lindex $idx 4] + + set cu_index 0 + foreach idx2 $_debug_names_cus { + if { $idx2 == $cu } { + break + } + incr cu_index + } + + define_label $label + _op .byte $abbrev "$name: abbrev" + _op .uleb128 $cu_index "$name: CU index" + _op .byte 0 "$name: terminator" + incr abbrev + } + + # Section end. + debug_names_end: + } + # The top-level interface to the DWARF assembler. - # FILENAME is the name of the file where the generated assembly - # code is written. + # OPTIONS is a list with an even number of elements containing + # option-name and option-value pairs. + # Current options are: + # filename <string> + # - the name of the file where the generated assembly + # code is written. + # default = "". + # add_dummy_cus <0|1> + # - Whether to add dummy CUs before and after the CUs + # added in the BODY. + # default = 1. + # As a special case, if OPTIONS is a list of length 1, it's + # interpreted as specifing the filename. # BODY is Tcl code to emit the assembly. It is evaluated via # "eval" -- not uplevel as you might expect, because it is # important to run the body in the Dwarf namespace. @@ -2943,7 +3149,7 @@ namespace eval Dwarf { # ... # } # } - proc assemble {filename body} { + proc assemble {options body} { variable _initialized variable _output_file variable _deferred_output @@ -2956,6 +3162,15 @@ namespace eval Dwarf { variable _debug_ranges_64_bit variable _debug_addr_index + if { [llength $options] == 1 } { + set options [list filename [lindex $options 0]] + } + + parse_options { + { filename "" } + { add_dummy_cus 1 } + } + if {!$_initialized} { _read_constants set _initialized 1 @@ -2975,7 +3190,9 @@ namespace eval Dwarf { # Dummy CU at the start to ensure that the first CU in $body is not # the first in .debug_info. - dummy_cu + if { $add_dummy_cus } { + dummy_cu + } with_shared_gdb { # Not "uplevel" here, because we want to evaluate in this @@ -2986,7 +3203,9 @@ namespace eval Dwarf { # Dummy CU at the end to ensure that the last CU in $body is not # the last in .debug_info. - dummy_cu + if { $add_dummy_cus } { + dummy_cu + } _write_deferred_output |