-# Copyright 2010-2014 Free Software Foundation, Inc.
+# Copyright 2010-2016 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
return 0
}
+# Return a list of expressions about function FUNC's address and length.
+# The first expression is the address of function FUNC, and the second
+# one is FUNC's length. SRC is the source file having function FUNC.
+# An internal label ${func}_label must be defined inside FUNC:
+#
+# int main (void)
+# {
+# asm ("main_label: .globl main_label");
+# return 0;
+# }
+#
+# This label is needed to compute the start address of function FUNC.
+# If the compiler is gcc, we can do the following to get function start
+# and end address too:
+#
+# asm ("func_start: .globl func_start");
+# static void func (void) {}
+# asm ("func_end: .globl func_end");
+#
+# however, this isn't portable, because other compilers, such as clang,
+# may not guarantee the order of global asms and function. The code
+# becomes:
+#
+# asm ("func_start: .globl func_start");
+# asm ("func_end: .globl func_end");
+# static void func (void) {}
+#
+
+proc function_range { func src } {
+ global decimal gdb_prompt
+
+ set exe [standard_temp_file func_addr[pid].x]
+
+ gdb_compile $src $exe executable {debug}
+
+ gdb_exit
+ gdb_start
+ gdb_load "$exe"
+
+ # Compute the label offset, and we can get the function start address
+ # by "${func}_label - $func_label_offset".
+ set func_label_offset ""
+ set test "p ${func}_label - ${func}"
+ gdb_test_multiple $test $test {
+ -re ".* = ($decimal)\r\n$gdb_prompt $" {
+ set func_label_offset $expect_out(1,string)
+ }
+ }
+
+ # Compute the function length.
+ global hex
+ set func_length ""
+ set test "disassemble $func"
+ gdb_test_multiple $test $test {
+ -re ".*$hex <\\+($decimal)>:\[^\r\n\]+\r\nEnd of assembler dump\.\r\n$gdb_prompt $" {
+ set func_length $expect_out(1,string)
+ }
+ }
+
+ # Compute the size of the last instruction.
+ if { $func_length == 0 } then {
+ set func_pattern "$func"
+ } else {
+ set func_pattern "$func\\+$func_length"
+ }
+ set test "x/2i $func+$func_length"
+ gdb_test_multiple $test $test {
+ -re ".*($hex) <$func_pattern>:\[^\r\n\]+\r\n\[ \]+($hex).*\.\r\n$gdb_prompt $" {
+ set start $expect_out(1,string)
+ set end $expect_out(2,string)
+
+ set func_length [expr $func_length + $end - $start]
+ }
+ }
+
+ return [list "${func}_label - $func_label_offset" $func_length]
+}
+
# A DWARF assembler.
#
# All the variables in this namespace are private to the
# This can either be the full name, like 'DW_AT_name', or a shortened
# name, like 'name'. These are fully equivalent.
#
+# Besides DWARF standard attributes, assembler supports 'macro' attribute
+# which will be substituted by one or more standard or macro attributes.
+# supported macro attributes are:
+#
+# - MACRO_AT_range { FUNC FILE }
+# It is substituted by DW_AT_low_pc and DW_AT_high_pc with the start and
+# end address of function FUNC in file FILE.
+#
+# - MACRO_AT_func { FUNC FILE }
+# It is substituted by DW_AT_name with FUNC and MACRO_AT_range.
+#
# If FORM is given, it should name a DW_FORM_ constant.
# This can either be the short form, like 'DW_FORM_addr', or a
# shortened version, like 'addr'. If the form is given, VALUE
# reference. The rest of VALUE is taken to be the name of a label,
# and DW_FORM_ref4 is used. See 'new_label' and 'define_label'.
# * Otherwise, VALUE is taken to be a string and DW_FORM_string is
-# used.
+# used. In order to prevent bugs where a numeric value is given but
+# no form is specified, it is an error if the value looks like a number
+# (using Tcl's "string is integer") and no form is provided.
# More form-guessing functionality may be added.
#
# CHILDREN is just Tcl code that can be used to define child DIEs. It
# value is the label for that string.
variable _strings
+ # Current .debug_line unit count.
+ variable _line_count
+
+ # Whether a file_name entry was seen.
+ variable _line_saw_file
+
+ # Whether a line table program has been seen.
+ variable _line_saw_program
+
+ # A Label for line table header generation.
+ variable _line_header_end_label
+
+ # The address size for debug ranges section.
+ variable _debug_ranges_64_bit
+
proc _process_one_constant {name value} {
variable _constants
variable _AT
_op .${size}byte $value
}
+ DW_FORM_sec_offset {
+ variable _cu_offset_size
+ _op .${_cu_offset_size}byte $value
+ }
+
DW_FORM_ref1 -
DW_FORM_flag -
DW_FORM_data1 {
DW_FORM_ref2 -
DW_FORM_indirect -
- DW_FORM_sec_offset -
DW_FORM_exprloc -
DW_FORM_GNU_addr_index -
}
}
+ # Handle macro attribute MACRO_AT_range.
+
+ proc _handle_macro_at_range { attr_value } {
+ if {[llength $attr_value] != 2} {
+ error "usage: MACRO_AT_range { func file }"
+ }
+
+ set func [lindex $attr_value 0]
+ set src [lindex $attr_value 1]
+ set result [function_range $func $src]
+
+ _handle_attribute DW_AT_low_pc [lindex $result 0] \
+ DW_FORM_addr
+ _handle_attribute DW_AT_high_pc \
+ "[lindex $result 0] + [lindex $result 1]" DW_FORM_addr
+ }
+
+ # Handle macro attribute MACRO_AT_func.
+
+ proc _handle_macro_at_func { attr_value } {
+ if {[llength $attr_value] != 2} {
+ error "usage: MACRO_AT_func { func file }"
+ }
+ _handle_attribute DW_AT_name [lindex $attr_value 0] DW_FORM_string
+ _handle_macro_at_range $attr_value
+ }
+
proc _handle_DW_TAG {tag_name {attrs {}} {children {}}} {
variable _abbrev_section
variable _abbrev_num
foreach attr $attrs {
set attr_name [_map_name [lindex $attr 0] _AT]
- set attr_value [uplevel 2 [list subst [lindex $attr 1]]]
+
+ # When the length of ATTR is greater than 2, the last
+ # element of the list must be a form. The second through
+ # the penultimate elements are joined together and
+ # evaluated using subst. This allows constructs such as
+ # [gdb_target_symbol foo] to be used.
+
if {[llength $attr] > 2} {
- set attr_form [lindex $attr 2]
+ set attr_value [uplevel 2 [list subst [join [lrange $attr 1 end-1]]]]
} else {
- set attr_form [_guess_form $attr_value attr_value]
+ set attr_value [uplevel 2 [list subst [lindex $attr 1]]]
}
- set attr_form [_map_name $attr_form _FORM]
- _handle_attribute $attr_name $attr_value $attr_form
+ if { [string equal "MACRO_AT_func" $attr_name] } {
+ _handle_macro_at_func $attr_value
+ } elseif { [string equal "MACRO_AT_range" $attr_name] } {
+ _handle_macro_at_range $attr_value
+ } else {
+ if {[llength $attr] > 2} {
+ set attr_form [lindex $attr end]
+ } else {
+ # If the value looks like an integer, a form is required.
+ if [string is integer $attr_value] {
+ error "Integer value requires a form"
+ }
+ set attr_form [_guess_form $attr_value attr_value]
+ }
+ set attr_form [_map_name $attr_form _FORM]
+
+ _handle_attribute $attr_name $attr_value $attr_form
+ }
}
_defer_output $_abbrev_section {
variable _cu_offset_size
foreach line [split $body \n] {
- if {[lindex $line 0] == ""} {
+ # Ignore blank lines, and allow embedded comments.
+ if {[lindex $line 0] == "" || [regexp -- {^[ \t]*#} $line]} {
continue
}
set opcode [_map_name [lindex $line 0] _OP]
_op .${_cu_addr_size}byte [lindex $line 1]
}
+ DW_OP_regx {
+ _op .uleb128 [lindex $line 1]
+ }
+
+ DW_OP_pick -
DW_OP_const1u -
DW_OP_const1s {
_op .byte [lindex $line 1]
_op .uleb128 [lindex $line 2]
}
+ DW_OP_skip -
+ DW_OP_bra {
+ _op .2byte [lindex $line 1]
+ }
+
DW_OP_GNU_implicit_pointer {
if {[llength $line] != 3} {
error "usage: DW_OP_GNU_implicit_pointer LABEL OFFSET"
_op .byte [lindex $line 1]
}
+ DW_OP_bregx {
+ _op .uleb128 [lindex $line 1]
+ _op .sleb128 [lindex $line 2]
+ }
+
default {
if {[llength $line] > 1} {
error "Unimplemented: operands in location for $opcode"
set _cu_label [_compute_label "cu${cu_num}_begin"]
set start_label [_compute_label "cu${cu_num}_start"]
set end_label [_compute_label "cu${cu_num}_end"]
-
+
define_label $_cu_label
if {$is_64} {
_op .4byte 0xffffffff
}
define_label $start_label
_op .2byte $_cu_version Version
- _op .4byte $my_abbrevs Abbrevs
+ _op .${_cu_offset_size}byte $my_abbrevs Abbrevs
_op .byte $_cu_addr_size "Pointer size"
_defer_output $_abbrev_section {
}
define_label $start_label
_op .2byte $_cu_version Version
- _op .4byte $my_abbrevs Abbrevs
+ _op .${_cu_offset_size}byte $my_abbrevs Abbrevs
_op .byte $_cu_addr_size "Pointer size"
_op .8byte $signature Signature
if { $type_label != "" } {
define_label $end_label
}
+ # Emit a DWARF .debug_ranges unit.
+ # 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 you want to emit 64-bit DWARF
+ # default = 0 (32-bit)
+ #
+ # BODY is Tcl code that emits the content of the .debug_ranges
+ # unit, it is evaluated in the caller's context.
+ proc ranges {options body} {
+ variable _debug_ranges_64_bit
+
+ foreach { name value } $options {
+ switch -exact -- $name {
+ is_64 { set _debug_ranges_64_bit [subst $value] }
+ default { error "unknown option $name" }
+ }
+ }
+
+ set section ".debug_ranges"
+ _section $section
+
+ proc sequence {{ranges {}}} {
+ variable _debug_ranges_64_bit
+
+ # Emit the sequence of addresses.
+ set base ""
+ foreach range $ranges {
+ set range [uplevel 1 "subst \"$range\""]
+ set type [lindex $range 0]
+ switch -exact -- $type {
+ base {
+ set base [lrange $range 1 end]
+
+ if { $_debug_ranges_64_bit } then {
+ _op .8byte 0xffffffffffffffff "Base Marker"
+ _op .8byte $base "Base Address"
+ } else {
+ _op .4byte 0xffffffff "Base Marker"
+ _op .4byte $base "Base Address"
+ }
+ }
+ range {
+ set start [lindex $range 1]
+ set end [lrange $range 2 end]
+
+ if { $_debug_ranges_64_bit } then {
+ _op .8byte $start "Start Address"
+ _op .8byte $end "End Address"
+ } else {
+ _op .4byte $start "Start Address"
+ _op .4byte $end "End Address"
+ }
+ }
+ default { error "unknown range type: $type " }
+ }
+ }
+
+ # End of the sequence.
+ if { $_debug_ranges_64_bit } then {
+ _op .8byte 0x0 "End of Sequence Marker (Part 1)"
+ _op .8byte 0x0 "End of Sequence Marker (Part 2)"
+ } else {
+ _op .4byte 0x0 "End of Sequence Marker (Part 1)"
+ _op .4byte 0x0 "End of Sequence Marker (Part 2)"
+ }
+ }
+
+ uplevel $body
+ }
+
+
+ # Emit a DWARF .debug_line unit.
+ # 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 you want to emit 64-bit DWARF
+ # default = 0 (32-bit)
+ # version n - DWARF version number to emit
+ # default = 4
+ # addr_size n - the size of addresses, 32, 64, or default
+ # default = default
+ #
+ # LABEL is the label of the current unit (which is probably
+ # referenced by a DW_AT_stmt_list), or "" if there is no such
+ # label.
+ #
+ # BODY is Tcl code that emits the parts which make up the body of
+ # the line unit. It is evaluated in the caller's context. The
+ # following commands are available for the BODY section:
+ #
+ # include_dir "dirname" -- adds a new include directory
+ #
+ # file_name "file.c" idx -- adds a new file name. IDX is a
+ # 1-based index referencing an include directory or 0 for
+ # current directory.
+
+ proc lines {options label body} {
+ variable _line_count
+ variable _line_saw_file
+ variable _line_saw_program
+ variable _line_header_end_label
+
+ # Establish the defaults.
+ set is_64 0
+ set _unit_version 4
+ set _unit_addr_size default
+
+ foreach { name value } $options {
+ switch -exact -- $name {
+ is_64 { set is_64 $value }
+ version { set _unit_version $value }
+ addr_size { set _unit_addr_size $value }
+ default { error "unknown option $name" }
+ }
+ }
+ if {$_unit_addr_size == "default"} {
+ if {[is_64_target]} {
+ set _unit_addr_size 8
+ } else {
+ set _unit_addr_size 4
+ }
+ }
+
+ set unit_num [incr _line_count]
+
+ set section ".debug_line"
+ _section $section
+
+ if { "$label" != "" } {
+ # Define the user-provided label at this point.
+ $label:
+ }
+
+ set unit_len_label [_compute_label "line${_line_count}_start"]
+ set unit_end_label [_compute_label "line${_line_count}_end"]
+ set header_len_label [_compute_label "line${_line_count}_header_start"]
+ set _line_header_end_label [_compute_label "line${_line_count}_header_end"]
+
+ if {$is_64} {
+ _op .4byte 0xffffffff
+ _op .8byte "$unit_end_label - $unit_len_label" "unit_length"
+ } else {
+ _op .4byte "$unit_end_label - $unit_len_label" "unit_length"
+ }
+
+ define_label $unit_len_label
+
+ _op .2byte $_unit_version version
+
+ if {$is_64} {
+ _op .8byte "$_line_header_end_label - $header_len_label" "header_length"
+ } else {
+ _op .4byte "$_line_header_end_label - $header_len_label" "header_length"
+ }
+
+ define_label $header_len_label
+
+ _op .byte 1 "minimum_instruction_length"
+ _op .byte 1 "default_is_stmt"
+ _op .byte 1 "line_base"
+ _op .byte 1 "line_range"
+ _op .byte 10 "opcode_base"
+
+ # The standard_opcode_lengths table. The number of arguments
+ # for each of the standard opcodes. Generating 9 entries here
+ # matches the use of 10 in the opcode_base above. These 9
+ # entries match the 9 standard opcodes for DWARF2, making use
+ # of only 9 should be fine, even if we are generating DWARF3
+ # or DWARF4.
+ _op .byte 0 "standard opcode 1"
+ _op .byte 1 "standard opcode 2"
+ _op .byte 1 "standard opcode 3"
+ _op .byte 1 "standard opcode 4"
+ _op .byte 1 "standard opcode 5"
+ _op .byte 0 "standard opcode 6"
+ _op .byte 0 "standard opcode 7"
+ _op .byte 0 "standard opcode 8"
+ _op .byte 1 "standard opcode 9"
+
+ proc include_dir {dirname} {
+ _op .ascii [_quote $dirname]
+ }
+
+ proc file_name {filename diridx} {
+ variable _line_saw_file
+ if "! $_line_saw_file" {
+ # Terminate the dir list.
+ _op .byte 0 "Terminator."
+ set _line_saw_file 1
+ }
+
+ _op .ascii [_quote $filename]
+ _op .sleb128 $diridx
+ _op .sleb128 0 "mtime"
+ _op .sleb128 0 "length"
+ }
+
+ proc program {statements} {
+ variable _line_saw_program
+ variable _line_header_end_label
+
+ if "! $_line_saw_program" {
+ # Terminate the file list.
+ _op .byte 0 "Terminator."
+ define_label $_line_header_end_label
+ set _line_saw_program 1
+ }
+
+ proc DW_LNE_set_address {addr} {
+ _op .byte 0
+ set start [new_label "set_address_start"]
+ set end [new_label "set_address_end"]
+ _op .uleb128 "${end} - ${start}"
+ define_label ${start}
+ _op .byte 2
+ if {[is_64_target]} {
+ _op .8byte ${addr}
+ } else {
+ _op .4byte ${addr}
+ }
+ define_label ${end}
+ }
+
+ proc DW_LNE_end_sequence {} {
+ _op .byte 0
+ _op .uleb128 1
+ _op .byte 1
+ }
+
+ proc DW_LNS_copy {} {
+ _op .byte 1
+ }
+
+ proc DW_LNS_advance_pc {offset} {
+ _op .byte 2
+ _op .uleb128 ${offset}
+ }
+
+ proc DW_LNS_advance_line {offset} {
+ _op .byte 3
+ _op .sleb128 ${offset}
+ }
+
+ foreach statement $statements {
+ uplevel 1 $statement
+ }
+ }
+
+ uplevel $body
+
+ rename include_dir ""
+ rename file_name ""
+
+ # Terminate dir list if we saw no files.
+ if "! $_line_saw_file" {
+ _op .byte 0 "Terminator."
+ }
+
+ # Terminate the file list.
+ if "! $_line_saw_program" {
+ _op .byte 0 "Terminator."
+ define_label $_line_header_end_label
+ }
+
+ define_label $unit_end_label
+ }
+
proc _empty_array {name} {
upvar $name the_array
_op .ascii [_quote $name]
# Alignment.
set align 2
- set total [expr {($namelen + (1 << $align) - 1) & (-1 << $align)}]
+ set total [expr {($namelen + (1 << $align) - 1) & -(1 << $align)}]
for {set i $namelen} {$i < $total} {incr i} {
_op .byte 0
}
variable _label_num
variable _strings
variable _cu_count
+ variable _line_count
+ variable _line_saw_file
+ variable _line_saw_program
+ variable _line_header_end_label
+ variable _debug_ranges_64_bit
if {!$_initialized} {
_read_constants
set _label_num 0
_empty_array _strings
+ set _line_count 0
+ set _line_saw_file 0
+ set _line_saw_program 0
+ set _debug_ranges_64_bit [is_64_target]
+
# Not "uplevel" here, because we want to evaluate in this
# namespace. This is somewhat bad because it means we can't
# readily refer to outer variables.
projects / deliverable / binutils-gdb.git / blobdiff