[PATCH V2] dwarf.exp: Allow generating a stub .debug_line section

[Petr Machata <pmachata at redhat dot com>]

Hello,

this is half ping, half V2 of the patch that I sent last week.  I fixed
a bug in generating the header since V1.

This is what I wrote last week, and it all still holds:

like GDB itself, dwgrep uses dwarf.exp to fabricate Dwarfs for its test
cases.  For one test case, I need to create a stub .debug_line section
and reference files defined therein from DW_AT_decl_file.  Hence this
patch, which implements generating barest minimum of .debug_line.

I suspect this could be useful for GDB as well, git grep showed me some
.exp's creating .debug_line by hand, but I didn't really take a close
look.

There were no regressions on x86_64.

Example of use:

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

	    cu {is_64 0 version 4 addr_size 8} {
		DW_TAG_compile_unit {
		    {MACRO_AT_stmt_list {
			{include "foo"}
			{file_name "foo.c" 1}
		    }}
		} {
		    DW_TAG_subprogram {
			# We can now reference the source file.
			{DW_AT_decl_file 1 DW_FORM_data1}
		    }
		}
	    }
	}

I do not have commit rights, so if this patch is acceptable, I will need
someone to commit this for me.

Let me know what you think.

Thanks,

--8<------------------------------------------------------------------

Signed-off-by: Petr Machata <pmachata@redhat.com>
---
 gdb/testsuite/ChangeLog     |   6 +++
 gdb/testsuite/lib/dwarf.exp | 112 +++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 117 insertions(+), 1 deletion(-)

diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 1e36b45..47fc450 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2015-02-17  Petr Machata  <pmachata@redhat.com>
+
+	* lib/dwarf.exp (Dwarf::_handle_DW_FORM): Handle DW_FORM_sec_offset.
+	(Dwarf::_handle_macro_at_stmt_list): New function.
+	(Dwarf::_handle_DW_TAG): Handle new macro MACRO_AT_stmt_list.
+
 2015-02-17  Jose E. Marchesi  <jose.marchesi@oracle.com>
 
 	* lib/dtrace.exp: New file.
diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp
index 8ea7a0f..bfcccbc 100644
--- a/gdb/testsuite/lib/dwarf.exp
+++ b/gdb/testsuite/lib/dwarf.exp
@@ -205,6 +205,19 @@ proc function_range { func src } {
 #  - MACRO_AT_func { FUNC FILE }
 #  It is substituted by DW_AT_name with FUNC and MACRO_AT_range.
 #
+#  - MACRO_AT_stmt_list { LIST_OF_DIRECTIVES }
+#  It is substituted by DW_AT_stmt_list with value referencing a
+#  newly-created .debug_line section with data as described by the
+#  directives.  Individual directives can be:
+#
+#    - {include NAME}
+#      defines a new include directory
+#
+#    - {file_name NAME DIRIDX}
+#      defines a new file with NAME, defined in the directory
+#      specified by DIRIDX-th include directive (numbered from 1, with
+#      0 meaning current directory, as specified in Dwarf standard).
+#
 # 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
@@ -422,6 +435,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 {
@@ -494,7 +512,6 @@ namespace eval Dwarf {
 
 	    DW_FORM_ref2 -
 	    DW_FORM_indirect -
-	    DW_FORM_sec_offset -
 	    DW_FORM_exprloc -
 
 	    DW_FORM_GNU_addr_index -
@@ -586,6 +603,97 @@ namespace eval Dwarf {
 	_handle_macro_at_range $attr_value
     }
 
+    # Handle macro attribute MACRO_AT_stmt_list.
+
+    proc _handle_macro_at_stmt_list { attr_value } {
+	variable _cu_count
+
+	set dirlist [list ""]
+	set filelist {}
+	proc include { dirname } {
+	    upvar 1 dirlist dirlist
+	    lappend dirlist $dirname
+	}
+	proc file_name { filename diridx } {
+	    upvar 1 dirlist dirlist
+	    if {![expr $diridx >= 0 && $diridx < [llength $dirlist]]} {
+		error [concat "Directory index out of bounds: $diridx." \
+		       "Use \"include\" to define directories."]
+	    }
+
+	    upvar 1 filelist filelist
+	    lappend filelist [list $filename $diridx 0 0]
+	}
+
+	foreach cmd $attr_value {
+	    {*}$cmd
+	}
+
+	set unit_label [_compute_label "line${_cu_count}"]
+	set unit_len_label [_compute_label "line${_cu_count}_start"]
+	set unit_end_label [_compute_label "line${_cu_count}_end"]
+	set header_len_label [_compute_label "line${_cu_count}_header_start"]
+	set header_end_label [_compute_label "line${_cu_count}_header_end"]
+
+	_defer_output ".debug_line" {
+	    define_label $unit_label
+	    _op .4byte "$unit_end_label - $unit_len_label" "unit_length"
+	    define_label $unit_len_label
+	    _op .2byte 0x2 version
+	    _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.
+	}
+
+	# Ignore the first dummy entry in DIRLIST when emitting.
+	foreach dirname [lrange $dirlist 1 end] {
+	    _defer_output ".debug_line" {
+		_op .ascii [_quote $dirname] "include"
+	    }
+	}
+
+	_defer_output ".debug_line" {
+	    _op .byte 0 "Terminator."
+	}
+
+	foreach entry $filelist {
+	    set fn [lindex $entry 0]
+	    set diridx [lindex $entry 1]
+	    set mtime [lindex $entry 2]
+	    set length [lindex $entry 3]
+
+	    set dir [lindex $dirlist $diridx]
+	    set full_fn [file join $dir $fn]
+
+	    _defer_output ".debug_line" {
+		_op .ascii [_quote $fn] $full_fn
+		_op .sleb128 $diridx
+		_op .sleb128 $mtime
+		_op .sleb128 $length
+	    }
+	}
+
+	variable _cu_version
+	if {[expr $_cu_version > 3]} {
+	    set form DW_FORM_sec_offset
+	} else {
+	    set form DW_FORM_data4
+	}
+	_handle_attribute DW_AT_stmt_list "$unit_label" $form
+
+	_defer_output ".debug_line" {
+	    _op .byte 0 "Terminator."
+	    define_label $header_end_label
+	    define_label $unit_end_label
+	}
+    }
+
     proc _handle_DW_TAG {tag_name {attrs {}} {children {}}} {
 	variable _abbrev_section
 	variable _abbrev_num
@@ -612,6 +720,8 @@ namespace eval Dwarf {
 		_handle_macro_at_func $attr_value
 	    } elseif { [string equal "MACRO_AT_range" $attr_name] } {
 		_handle_macro_at_range $attr_value
+	    } elseif { [string equal "MACRO_AT_stmt_list" $attr_name] } {
+		_handle_macro_at_stmt_list $attr_value
 	    } else {
 		if {[llength $attr] > 2} {
 		    set attr_form [lindex $attr 2]
-- 
2.1.0