dwarf.exp: Allow generating a stub .debug_line section

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

@@ -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

gdb/testsuite/lib/dwarf.exp

@@ -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.