dwarf.exp: Allow generating a stub .debug_line section
authorPetr Machata <pmachata@redhat.com>
Mon, 23 Feb 2015 14:41:52 +0000 (15:41 +0100)
committerPetr Machata <pmachata@redhat.com>
Tue, 31 Mar 2015 14:25:07 +0000 (16:25 +0200)
Example of use:

Dwarf::assemble "foo.s" {
    build_id 0102030405060708

    declare_labels L;
    cu {is_64 0 version 4 addr_size 8} {
DW_TAG_compile_unit {
    {DW_AT_stmt_list $L DW_FORM_sec_offset}
} {
    DW_TAG_subprogram {
# We can now reference the source file.
{DW_AT_decl_file 1 DW_FORM_data1}
    }
}
    }

    lines {is_64 0 version 2 addr_size 8} L {
include_dir "foo"
include_dir "bar"
file_name "foo.c" 1
file_name "bar.c" 1
file_name "baz.c" 2
    }
}

Signed-off-by: Petr Machata <pmachata@redhat.com>
gdb/testsuite/ChangeLog
gdb/testsuite/lib/dwarf.exp

index 31f01a07968db6cad17a3babc8ca3a0d77b34c5c..73796aee20f6136b64af4cc88b9055137084f117 100644 (file)
@@ -1,3 +1,10 @@
+2015-03-27  Petr Machata  <pmachata@redhat.com>
+
+       * lib/dwarf.exp (Dwarf::_handle_DW_FORM): Handle DW_FORM_sec_offset.
+       (Dwarf::_line_count, Dwarf::_line_saw_file): New variables.
+       (Dwarf::assemble): Initialize them.
+       (Dwarf::lines): New function.
+
 2015-03-26  Jon Turney  <jon.turney@dronecode.org.uk>
 
        * lib/gdb.exp (gdb_target_symbol_prefix_flags): Don't set
index 19963c4371e7a8aae4e3203aef5ba3a339f672d9..515334e5c9c905ad8fd721ded1e5c46c9440b456 100644 (file)
@@ -297,6 +297,12 @@ namespace eval Dwarf {
     # 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
+
     proc _process_one_constant {name value} {
        variable _constants
        variable _AT
@@ -427,6 +433,11 @@ namespace eval Dwarf {
                _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 {
@@ -499,7 +510,6 @@ namespace eval Dwarf {
 
            DW_FORM_ref2 -
            DW_FORM_indirect -
-           DW_FORM_sec_offset -
            DW_FORM_exprloc -
 
            DW_FORM_GNU_addr_index -
@@ -1099,6 +1109,133 @@ namespace eval Dwarf {
        define_label $end_label
     }
 
+    # 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
+
+       # 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 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 "$header_end_label - $header_len_label" "header_length"
+       } else {
+           _op .4byte "$header_end_label - $header_len_label" "header_length"
+       }
+
+       define_label $header_len_label
+
+       _op .byte 1 "minimum_instruction_length"
+       _op .byte 0 "default_is_stmt"
+       _op .byte 1 "line_base"
+       _op .byte 1 "line_range"
+       _op .byte 1 "opcode_base"
+       # Since we emit opcode_base==1, we skip
+       # standard_opcode_length table altogether.
+
+       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"
+       }
+
+       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.
+       _op .byte 0 "Terminator."
+
+       define_label $header_end_label
+       define_label $unit_end_label
+    }
+
     proc _empty_array {name} {
        upvar $name the_array
 
@@ -1178,6 +1315,8 @@ namespace eval Dwarf {
        variable _label_num
        variable _strings
        variable _cu_count
+       variable _line_count
+       variable _line_saw_file
 
        if {!$_initialized} {
            _read_constants
@@ -1191,6 +1330,9 @@ namespace eval Dwarf {
        set _label_num 0
        _empty_array _strings
 
+       set _line_count 0
+       set _line_saw_file 0
+
        # 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.