Adding upstream version 0.15.upstream/0.15upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

6 files changed, 2127 insertions, 0 deletions

diff --git a/testsuite/lib/dwarf-lib.exp b/testsuite/lib/dwarf-lib.exp
new file mode 100644
index 0000000..aca710e
--- /dev/null
+++ b/testsuite/lib/dwarf-lib.exp
@@ -0,0 +1,28 @@
+# Copyright 2019 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
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# Auxiliary stuff to make the dwarf assembler in dwarf.exp work outside of the
+# gdb testsuite context.  We don't add this to dwarf.exp to keep differences
+# between dwz's dwarf.exp and gdb's dwarf.exp minimal.
+
+proc is_64_target {} {
+    if { $::env(POINTER_SIZE) == 8 } {
+	return 1
+    } elseif { $::env(POINTER_SIZE) == 4 } {
+	return 0
+    } else {
+	error "POINTER_SIZE not defined in env"
+    }
+}
diff --git a/testsuite/lib/dwarf.exp b/testsuite/lib/dwarf.exp
new file mode 100644
index 0000000..4dbbc6c
--- /dev/null
+++ b/testsuite/lib/dwarf.exp
@@ -0,0 +1,1674 @@
+# Copyright 2010-2020 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
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# This was copied from the git://sourceware.org/git/binutils-gdb.git
+# repository, file gdb/testsuite/lib/dwarf.exp
+
+# Return true if the target supports DWARF-2 and uses gas.
+# For now pick a sampling of likely targets.
+proc dwarf2_support {} {
+    if {[istarget *-*-linux*]
+	|| [istarget *-*-gnu*]
+	|| [istarget *-*-elf*]
+	|| [istarget *-*-openbsd*]
+	|| [istarget arm*-*-eabi*]
+	|| [istarget arm*-*-symbianelf*]
+	|| [istarget powerpc-*-eabi*]} {
+	return 1
+    }
+
+    return 0
+}
+
+# Build an executable from a fission-based .S file.
+# This handles the extra work of splitting the .o into non-dwo and dwo
+# pieces, making sure the .dwo is available if we're using cc-with-tweaks.sh
+# to build a .dwp file.
+# The arguments and results are the same as for build_executable.
+#
+# Current restrictions:
+# - only supports one source file
+# - cannot be run on remote hosts
+
+proc build_executable_from_fission_assembler { testname executable sources options } {
+    verbose -log "build_executable_from_fission_assembler $testname $executable $sources $options"
+    if { [llength $sources] != 1 } {
+	error "Only one source file supported."
+    }
+    if [is_remote host] {
+	error "Remote hosts are not supported."
+    }
+
+    global srcdir subdir
+    set source_file ${srcdir}/${subdir}/${sources}
+    set root_name [file rootname [file tail $source_file]]
+    set output_base [standard_output_file $root_name]
+    set object_file ${output_base}.o
+    set dwo_file ${output_base}.dwo
+    set object_options "object $options"
+    set objcopy [gdb_find_objcopy]
+
+    set result [gdb_compile $source_file $object_file object $options]
+    if { "$result" != "" } {
+	return -1
+    }
+
+    set command "$objcopy --extract-dwo $object_file $dwo_file"
+    verbose -log "Executing $command"
+    set result [catch "exec $command" output]
+    verbose -log "objcopy --extract-dwo output: $output"
+    if { $result == 1 } {
+	return -1
+    }
+
+    set command "$objcopy --strip-dwo $object_file"
+    verbose -log "Executing $command"
+    set result [catch "exec $command" output]
+    verbose -log "objcopy --strip-dwo output: $output"
+    if { $result == 1 } {
+	return -1
+    }
+
+    set result [gdb_compile $object_file $executable executable $options]
+    if { "$result" != "" } {
+	return -1
+    }
+
+    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 {options {debug}} } {
+    global decimal gdb_prompt
+
+    set exe [standard_temp_file func_addr[pid].x]
+
+    gdb_compile $src $exe executable $options
+
+    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]
+}
+
+# Extract the start, length, and end for function called NAME and
+# create suitable variables in the callers scope.
+proc get_func_info { name {options {debug}} } {
+    global srcdir subdir srcfile
+
+    upvar 1 "${name}_start" func_start
+    upvar 1 "${name}_len" func_len
+    upvar 1 "${name}_end" func_end
+
+    lassign [function_range ${name} \
+		 [list ${srcdir}/${subdir}/$srcfile] \
+		 ${options}]  \
+	func_start func_len
+    set func_end "$func_start + $func_len"
+}
+
+# A DWARF assembler.
+#
+# All the variables in this namespace are private to the
+# implementation.  Also, any procedure whose name starts with "_" is
+# private as well.  Do not use these.
+#
+# Exported functions are documented at their definition.
+#
+# In addition to the hand-written functions documented below, this
+# module automatically generates a function for each DWARF tag.  For
+# most tags, two forms are made: a full name, and one with the
+# "DW_TAG_" prefix stripped.  For example, you can use either
+# 'DW_TAG_compile_unit' or 'compile_unit' interchangeably.
+#
+# There are two exceptions to this rule: DW_TAG_variable and
+# DW_TAG_namespace.  For these, the full name must always be used,
+# as the short name conflicts with Tcl builtins.  (Should future
+# versions of Tcl or DWARF add more conflicts, this list will grow.
+# If you want to be safe you should always use the full names.)
+#
+# Each tag procedure is defined like:
+#
+# proc DW_TAG_mumble {{attrs {}} {children {}}} { ... }
+#
+# ATTRS is an optional list of attributes.
+# It is run through 'subst' in the caller's context before processing.
+#
+# Each attribute in the list has one of two forms:
+#   1. { NAME VALUE }
+#   2. { NAME VALUE FORM }
+#
+# In each case, NAME is the attribute's name.
+# 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 }
+#  It is substituted by DW_AT_low_pc and DW_AT_high_pc with the start and
+#  end address of function FUNC in file $srcdir/$subdir/$srcfile.
+#
+#  - MACRO_AT_func { FUNC }
+#  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
+# is its value; see below.  In some cases, additional processing
+# is done; for example, DW_FORM_strp manages the .debug_str
+# section automatically.
+#
+# If FORM is 'SPECIAL_expr', then VALUE is treated as a location
+# expression.  The effective form is then DW_FORM_block or DW_FORM_exprloc
+# for DWARF version >= 4, and VALUE is passed to the (internal)
+# '_location' proc to be translated.
+# This proc implements a miniature DW_OP_ assembler.
+#
+# If FORM is not given, it is guessed:
+# * If VALUE starts with the "@" character, the rest of VALUE is
+#   looked up as a DWARF constant, and DW_FORM_sdata is used.  For
+#   example, '@DW_LANG_c89' could be used.
+# * If VALUE starts with the ":" character, then it is a label
+#   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'.
+# * If VALUE starts with the "%" character, then it is a label
+#   reference too, but DW_FORM_ref_addr is used.
+# * Otherwise, if the attribute name has a default form (f.i. DW_FORM_addr for
+#   DW_AT_low_pc), then that one is used.
+# * Otherwise, an error is reported.  Either specify a form explicitly, or
+#   add a default for the the attribute name in _default_form.
+#
+# CHILDREN is just Tcl code that can be used to define child DIEs.  It
+# is evaluated in the caller's context.
+#
+# Currently this code is missing nice support for CFA handling, and
+# probably other things as well.
+
+namespace eval Dwarf {
+    # True if the module has been initialized.
+    variable _initialized 0
+
+    # Constants from dwarf2.h.
+    variable _constants
+    # DW_AT short names.
+    variable _AT
+    # DW_FORM short names.
+    variable _FORM
+    # DW_OP short names.
+    variable _OP
+
+    # The current output file.
+    variable _output_file
+
+    # Note: The _cu_ values here also apply to type units (TUs).
+    # Think of a TU as a special kind of CU.
+
+    # Current CU count.
+    variable _cu_count
+
+    # The current CU's base label.
+    variable _cu_label
+
+    # The current CU's version.
+    variable _cu_version
+
+    # The current CU's address size.
+    variable _cu_addr_size
+    # The current CU's offset size.
+    variable _cu_offset_size
+
+    # Label generation number.
+    variable _label_num
+
+    # The deferred output array.  The index is the section name; the
+    # contents hold the data for that section.
+    variable _deferred_output
+
+    # If empty, we should write directly to the output file.
+    # Otherwise, this is the name of a section to write to.
+    variable _defer
+
+    # The abbrev section.  Typically .debug_abbrev but can be .debug_abbrev.dwo
+    # for Fission.
+    variable _abbrev_section
+
+    # The next available abbrev number in the current CU's abbrev
+    # table.
+    variable _abbrev_num
+
+    # The string table for this assembly.  The key is the string; the
+    # 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
+	variable _FORM
+	variable _OP
+
+	set _constants($name) $value
+
+	if {![regexp "^DW_(\[A-Z\]+)_(\[A-Za-z0-9_\]+)$" $name \
+		  ignore prefix name2]} {
+	    error "non-matching name: $name"
+	}
+
+	if {$name2 == "lo_user" || $name2 == "hi_user"} {
+	    return
+	}
+
+	# We only try to shorten some very common things.
+	# FIXME: CFA?
+	switch -exact -- $prefix {
+	    TAG {
+		# Create two procedures for the tag.  These call
+		# _handle_DW_TAG with the full tag name baked in; this
+		# does all the actual work.
+		proc $name {{attrs {}} {children {}}} \
+		    "_handle_DW_TAG $name \$attrs \$children"
+
+		# Filter out ones that are known to clash.
+		if {$name2 == "variable" || $name2 == "namespace"} {
+		    set name2 "tag_$name2"
+		}
+
+		if {[info commands $name2] != {}} {
+		    error "duplicate proc name: from $name"
+		}
+
+		proc $name2 {{attrs {}} {children {}}} \
+		    "_handle_DW_TAG $name \$attrs \$children"
+	    }
+
+	    AT {
+		set _AT($name2) $name
+	    }
+
+	    FORM {
+		set _FORM($name2) $name
+	    }
+
+	    OP {
+		set _OP($name2) $name
+	    }
+
+	    default {
+		return
+	    }
+	}
+    }
+
+    proc _read_constants {} {
+	global srcdir hex decimal
+
+	# DWARF name-matching regexp.
+	set dwrx "DW_\[a-zA-Z0-9_\]+"
+	# Whitespace regexp.
+	set ws "\[ \t\]+"
+
+	set fd [open [file join $srcdir .. dwarf2.h]]
+	while {![eof $fd]} {
+	    set line [gets $fd]
+	    if {[regexp -- "^${ws}($dwrx)${ws}=${ws}($hex|$decimal),?$" \
+		     $line ignore name value ignore2]} {
+		_process_one_constant $name $value
+	    }
+	}
+	close $fd
+
+	set fd [open [file join $srcdir .. dwarf2.def]]
+	while {![eof $fd]} {
+	    set line [gets $fd]
+	    if {[regexp -- \
+		     "^DW_\[A-Z_\]+${ws}\\(($dwrx),${ws}($hex|$decimal)\\)$" \
+		     $line ignore name value ignore2]} {
+		_process_one_constant $name $value
+	    }
+	}
+	close $fd
+    }
+
+    proc _quote {string} {
+	# FIXME
+	return "\"${string}\\0\""
+    }
+
+    proc _nz_quote {string} {
+	# For now, no quoting is done.
+	return "\"${string}\""
+    }
+
+    proc _handle_DW_FORM {form value} {
+	switch -exact -- $form {
+	    DW_FORM_string  {
+		_op .ascii [_quote $value]
+	    }
+
+	    DW_FORM_flag_present {
+		# We don't need to emit anything.
+	    }
+
+	    DW_FORM_data4 -
+	    DW_FORM_ref4 {
+		_op .4byte $value
+	    }
+
+	    DW_FORM_ref_addr {
+		variable _cu_offset_size
+		variable _cu_version
+		variable _cu_addr_size
+
+		if {$_cu_version == 2} {
+		    set size $_cu_addr_size
+		} else {
+		    set size $_cu_offset_size
+		}
+
+		_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 {
+		_op .byte $value
+	    }
+
+	    DW_FORM_sdata {
+		_op .sleb128 $value
+	    }
+
+	    DW_FORM_ref_udata -
+	    DW_FORM_udata {
+		_op .uleb128 $value
+	    }
+
+	    DW_FORM_addr {
+		variable _cu_addr_size
+
+		_op .${_cu_addr_size}byte $value
+	    }
+
+	    DW_FORM_data2 -
+	    DW_FORM_ref2 {
+		_op .2byte $value
+	    }
+
+	    DW_FORM_data8 -
+	    DW_FORM_ref8 -
+	    DW_FORM_ref_sig8 {
+		_op .8byte $value
+	    }
+
+	    DW_FORM_data16 {
+		_op .8byte $value
+	    }
+
+	    DW_FORM_strp {
+		variable _strings
+		variable _cu_offset_size
+
+		if {![info exists _strings($value)]} {
+		    set _strings($value) [new_label strp]
+		    _defer_output .debug_string {
+			define_label $_strings($value)
+			_op .ascii [_quote $value]
+		    }
+		}
+
+		_op .${_cu_offset_size}byte $_strings($value) "strp: $value"
+	    }
+
+	    SPECIAL_expr {
+		set l1 [new_label "expr_start"]
+		set l2 [new_label "expr_end"]
+		_op .uleb128 "$l2 - $l1" "expression"
+		define_label $l1
+		_location $value
+		define_label $l2
+	    }
+
+	    DW_FORM_block1 {
+		set len [string length $value]
+		if {$len > 255} {
+		    error "DW_FORM_block1 length too long"
+		}
+		_op .byte $len
+		_op .ascii [_nz_quote $value]
+	    }
+
+	    DW_FORM_block2 -
+	    DW_FORM_block4 -
+
+	    DW_FORM_block -
+
+	    DW_FORM_ref2 -
+	    DW_FORM_indirect -
+	    DW_FORM_exprloc -
+
+	    DW_FORM_strx -
+	    DW_FORM_strx1 -
+	    DW_FORM_strx2 -
+	    DW_FORM_strx3 -
+	    DW_FORM_strx4 -
+
+	    DW_FORM_GNU_addr_index -
+	    DW_FORM_GNU_str_index -
+	    DW_FORM_GNU_ref_alt -
+	    DW_FORM_GNU_strp_alt -
+
+	    default {
+		error "unhandled form $form"
+	    }
+	}
+    }
+
+    proc _guess_form {value varname} {
+	upvar $varname new_value
+
+	switch -exact -- [string range $value 0 0] {
+	    @ {
+		# Constant reference.
+		variable _constants
+
+		set new_value $_constants([string range $value 1 end])
+		# Just the simplest.
+		return DW_FORM_sdata
+	    }
+
+	    : {
+		# Label reference.
+		variable _cu_label
+
+		set new_value "[string range $value 1 end] - $_cu_label"
+
+		return DW_FORM_ref4
+	    }
+
+	    % {
+		# Label reference, an offset from .debug_info.
+		set new_value "[string range $value 1 end]"
+
+		return DW_FORM_ref_addr
+	    }
+
+	    default {
+		return ""
+	    }
+	}
+    }
+
+    proc _default_form { attr } {
+	switch -exact -- $attr {
+	    DW_AT_low_pc  {
+		return DW_FORM_addr
+	    }
+	    DW_AT_producer -
+	    DW_AT_comp_dir -
+	    DW_AT_linkage_name -
+	    DW_AT_MIPS_linkage_name -
+	    DW_AT_name {
+		return DW_FORM_string
+	    }
+	}
+	return ""
+    }
+
+    # Map NAME to its canonical form.
+    proc _map_name {name ary} {
+	variable $ary
+
+	if {[info exists ${ary}($name)]} {
+	    set name [set ${ary}($name)]
+	}
+
+	return $name
+    }
+
+    proc _handle_attribute { attr_name attr_value attr_form } {
+	variable _abbrev_section
+	variable _constants
+	variable _cu_version
+
+	_handle_DW_FORM $attr_form $attr_value
+
+	_defer_output $_abbrev_section {
+	    if { $attr_form eq "SPECIAL_expr" } {
+		if { $_cu_version < 4 } {
+		    set attr_form_comment "DW_FORM_block"
+		} else {
+		    set attr_form_comment "DW_FORM_exprloc"
+		}
+	    } else {
+		set attr_form_comment $attr_form
+	    }
+	    _op .uleb128 $_constants($attr_name) $attr_name
+	    _op .uleb128 $_constants($attr_form) $attr_form_comment
+	}
+    }
+
+    # Handle macro attribute MACRO_AT_range.
+
+    proc _handle_macro_at_range { attr_value } {
+	if {[llength $attr_value] != 1} {
+	    error "usage: MACRO_AT_range { func }"
+	}
+
+	set func [lindex $attr_value 0]
+	global srcdir subdir srcfile
+	set src ${srcdir}/${subdir}/${srcfile}
+	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] != 1} {
+	    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
+	variable _constants
+
+	set has_children [expr {[string length $children] > 0}]
+	set my_abbrev [incr _abbrev_num]
+
+	# We somewhat wastefully emit a new abbrev entry for each tag.
+	# There's no reason for this other than laziness.
+	_defer_output $_abbrev_section {
+	    _op .uleb128 $my_abbrev "Abbrev start"
+	    _op .uleb128 $_constants($tag_name) $tag_name
+	    _op .byte $has_children "has_children"
+	}
+
+	_op .uleb128 $my_abbrev "Abbrev ($tag_name)"
+
+	foreach attr $attrs {
+	    set attr_name [_map_name [lindex $attr 0] _AT]
+
+	    # 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_value [uplevel 2 [list subst [join [lrange $attr 1 end-1]]]]
+	    } else {
+	        set attr_value [uplevel 2 [list subst [lindex $attr 1]]]
+	    }
+
+	    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 [uplevel 2 [list subst [lindex $attr end]]]
+
+		    if { [string index $attr_value 0] == ":" } {
+			# It is a label, get its value.
+			_guess_form $attr_value attr_value
+		    }
+		} else {
+		    set attr_form [_guess_form $attr_value attr_value]
+		    if { $attr_form eq "" } {
+			set attr_form [_default_form $attr_name]
+		    }
+		    if { $attr_form eq "" } {
+			error "No form for $attr_name $attr_value"
+		    }
+		}
+		set attr_form [_map_name $attr_form _FORM]
+
+		_handle_attribute $attr_name $attr_value $attr_form
+	    }
+	}
+
+	_defer_output $_abbrev_section {
+	    # Terminator.
+	    _op .byte 0x0 "DW_AT - Terminator"
+	    _op .byte 0x0 "DW_FORM - Terminator"
+	}
+
+	if {$has_children} {
+	    uplevel 2 $children
+
+	    # Terminate children.
+	    _op .byte 0x0 "Terminate children"
+	}
+    }
+
+    proc _emit {string} {
+	variable _output_file
+	variable _defer
+	variable _deferred_output
+
+	if {$_defer == ""} {
+	    puts $_output_file $string
+	} else {
+	    append _deferred_output($_defer) ${string}\n
+	}
+    }
+
+    proc _section {name {flags ""} {type ""}} {
+	if {$flags == "" && $type == ""} {
+	    _emit "        .section $name"
+	} elseif {$type == ""} {
+	    _emit "        .section $name, \"$flags\""
+	} else {
+	    _emit "        .section $name, \"$flags\", %$type"
+	}
+    }
+
+    # SECTION_SPEC is a list of arguments to _section.
+    proc _defer_output {section_spec body} {
+	variable _defer
+	variable _deferred_output
+
+	set old_defer $_defer
+	set _defer [lindex $section_spec 0]
+
+	if {![info exists _deferred_output($_defer)]} {
+	    set _deferred_output($_defer) ""
+	    eval _section $section_spec
+	}
+
+	uplevel $body
+
+	set _defer $old_defer
+    }
+
+    proc _defer_to_string {body} {
+	variable _defer
+	variable _deferred_output
+
+	set old_defer $_defer
+	set _defer temp
+
+	set _deferred_output($_defer) ""
+
+	uplevel $body
+
+	set result $_deferred_output($_defer)
+	unset _deferred_output($_defer)
+
+	set _defer $old_defer
+	return $result
+    }
+
+    proc _write_deferred_output {} {
+	variable _output_file
+	variable _deferred_output
+
+	foreach section [array names _deferred_output] {
+	    # The data already has a newline.
+	    puts -nonewline $_output_file $_deferred_output($section)
+	}
+
+	# Save some memory.
+	unset _deferred_output
+    }
+
+    proc _op {name value {comment ""}} {
+	set text "        ${name}        ${value}"
+	if {$comment != ""} {
+	    # Try to make stuff line up nicely.
+	    while {[string length $text] < 40} {
+		append text " "
+	    }
+	    append text "/* ${comment} */"
+	}
+	_emit $text
+    }
+
+    proc _compute_label {name} {
+	return ".L${name}"
+    }
+
+    # Return a name suitable for use as a label.  If BASE_NAME is
+    # specified, it is incorporated into the label name; this is to
+    # make debugging the generated assembler easier.  If BASE_NAME is
+    # not specified a generic default is used.  This proc does not
+    # define the label; see 'define_label'.  'new_label' attempts to
+    # ensure that label names are unique.
+    proc new_label {{base_name label}} {
+	variable _label_num
+
+	return [_compute_label ${base_name}[incr _label_num]]
+    }
+
+    # Define a label named NAME.  Ordinarily, NAME comes from a call
+    # to 'new_label', but this is not required.
+    proc define_label {name} {
+	_emit "${name}:"
+    }
+
+    # A higher-level interface to label handling.
+    #
+    # ARGS is a list of label descriptors.  Each one is either a
+    # single element, or a list of two elements -- a name and some
+    # text.  For each descriptor, 'new_label' is invoked.  If the list
+    # form is used, the second element in the list is passed as an
+    # argument.  The label name is used to define a variable in the
+    # enclosing scope; this can be used to refer to the label later.
+    # The label name is also used to define a new proc whose name is
+    # the label name plus a trailing ":".  This proc takes a body as
+    # an argument and can be used to define the label at that point;
+    # then the body, if any, is evaluated in the caller's context.
+    #
+    # For example:
+    #
+    # declare_labels int_label
+    # something { ... $int_label }   ;# refer to the label
+    # int_label: constant { ... }    ;# define the label
+    proc declare_labels {args} {
+	foreach arg $args {
+	    set name [lindex $arg 0]
+	    set text [lindex $arg 1]
+
+	    if { $text == "" } {
+		set text $name
+	    }
+
+	    upvar $name label_var
+	    set label_var [new_label $text]
+
+	    proc ${name}: {args} [format {
+		define_label %s
+		uplevel $args
+	    } $label_var]
+	}
+    }
+
+    # This is a miniature assembler for location expressions.  It is
+    # suitable for use in the attributes to a DIE.  Its output is
+    # prefixed with "=" to make it automatically use DW_FORM_block.
+    # BODY is split by lines, and each line is taken to be a list.
+    # (FIXME should use 'info complete' here.)
+    # Each list's first element is the opcode, either short or long
+    # forms are accepted.
+    # FIXME argument handling
+    # FIXME move docs
+    proc _location {body} {
+	variable _constants
+	variable _cu_label
+	variable _cu_version
+	variable _cu_addr_size
+	variable _cu_offset_size
+
+	foreach line [split $body \n] {
+	    # Ignore blank lines, and allow embedded comments.
+	    if {[lindex $line 0] == "" || [regexp -- {^[ \t]*#} $line]} {
+		continue
+	    }
+	    set opcode [_map_name [lindex $line 0] _OP]
+	    _op .byte $_constants($opcode) $opcode
+
+	    switch -exact -- $opcode {
+		DW_OP_addr {
+		    _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]
+		}
+
+		DW_OP_const2u -
+		DW_OP_const2s {
+		    _op .2byte [lindex $line 1]
+		}
+
+		DW_OP_const4u -
+		DW_OP_const4s {
+		    _op .4byte [lindex $line 1]
+		}
+
+		DW_OP_const8u -
+		DW_OP_const8s {
+		    _op .8byte [lindex $line 1]
+		}
+
+		DW_OP_constu {
+		    _op .uleb128 [lindex $line 1]
+		}
+		DW_OP_consts {
+		    _op .sleb128 [lindex $line 1]
+		}
+
+		DW_OP_plus_uconst {
+		    _op .uleb128 [lindex $line 1]
+		}
+
+		DW_OP_piece {
+		    _op .uleb128 [lindex $line 1]
+		}
+
+		DW_OP_bit_piece {
+		    _op .uleb128 [lindex $line 1]
+		    _op .uleb128 [lindex $line 2]
+		}
+
+		DW_OP_skip -
+		DW_OP_bra {
+		    _op .2byte [lindex $line 1]
+		}
+
+		DW_OP_implicit_value {
+		    set l1 [new_label "value_start"]
+		    set l2 [new_label "value_end"]
+		    _op .uleb128 "$l2 - $l1"
+		    define_label $l1
+		    foreach value [lrange $line 1 end] {
+			switch -regexp -- $value {
+			    {^0x[[:xdigit:]]{1,2}$} {_op .byte $value}
+			    {^0x[[:xdigit:]]{4}$} {_op .2byte $value}
+			    {^0x[[:xdigit:]]{8}$} {_op .4byte $value}
+			    {^0x[[:xdigit:]]{16}$} {_op .8byte $value}
+			    default {
+				error "bad value '$value' in DW_OP_implicit_value"
+			    }
+			}
+		    }
+		    define_label $l2
+		}
+
+		DW_OP_implicit_pointer -
+		DW_OP_GNU_implicit_pointer {
+		    if {[llength $line] != 3} {
+			error "usage: $opcode LABEL OFFSET"
+		    }
+
+		    # Here label is a section offset.
+		    set label [lindex $line 1]
+		    if { $_cu_version == 2 } {
+			_op .${_cu_addr_size}byte $label
+		    } else {
+			_op .${_cu_offset_size}byte $label
+		    }
+		    _op .sleb128 [lindex $line 2]
+		}
+
+		DW_OP_GNU_variable_value {
+		    if {[llength $line] != 2} {
+			error "usage: $opcode LABEL"
+		    }
+
+		    # Here label is a section offset.
+		    set label [lindex $line 1]
+		    if { $_cu_version == 2 } {
+			_op .${_cu_addr_size}byte $label
+		    } else {
+			_op .${_cu_offset_size}byte $label
+		    }
+		}
+
+		DW_OP_deref_size {
+		    if {[llength $line] != 2} {
+			error "usage: DW_OP_deref_size SIZE"
+		    }
+
+		    _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"
+		    }
+		}
+	    }
+	}
+    }
+
+    # Emit a DWARF CU.
+    # 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 in bytes: 4, 8, or default
+    #                default = default
+    # fission 0|1  - boolean indicating if generating Fission debug info
+    #                default = 0
+    # BODY is Tcl code that emits the DIEs which make up the body of
+    # the CU.  It is evaluated in the caller's context.
+    proc cu {options body} {
+	variable _constants
+	variable _cu_count
+	variable _abbrev_section
+	variable _abbrev_num
+	variable _cu_label
+	variable _cu_version
+	variable _cu_addr_size
+	variable _cu_offset_size
+
+	# Establish the defaults.
+	set is_64 0
+	set _cu_version 4
+	set _cu_addr_size default
+	set fission 0
+	set section ".debug_info"
+	set _abbrev_section ".debug_abbrev"
+
+	foreach { name value } $options {
+	    set value [uplevel 1 "subst \"$value\""]
+	    switch -exact -- $name {
+		is_64 { set is_64 $value }
+		version { set _cu_version $value }
+		addr_size { set _cu_addr_size $value }
+		fission { set fission $value }
+		default { error "unknown option $name" }
+	    }
+	}
+	if {$_cu_addr_size == "default"} {
+	    if {[is_64_target]} {
+		set _cu_addr_size 8
+	    } else {
+		set _cu_addr_size 4
+	    }
+	}
+	set _cu_offset_size [expr { $is_64 ? 8 : 4 }]
+	if { $fission } {
+	    set section ".debug_info.dwo"
+	    set _abbrev_section ".debug_abbrev.dwo"
+	}
+
+	if {$_cu_version < 4} {
+	    set _constants(SPECIAL_expr) $_constants(DW_FORM_block)
+	} else {
+	    set _constants(SPECIAL_expr) $_constants(DW_FORM_exprloc)
+	}
+
+	_section $section
+
+	set cu_num [incr _cu_count]
+	set my_abbrevs [_compute_label "abbrev${cu_num}_begin"]
+	set _abbrev_num 1
+
+	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
+	    _op .8byte "$end_label - $start_label"
+	} else {
+	    _op .4byte "$end_label - $start_label"
+	}
+	define_label $start_label
+	_op .2byte $_cu_version Version
+	_op .${_cu_offset_size}byte $my_abbrevs Abbrevs
+	_op .byte $_cu_addr_size "Pointer size"
+
+	_defer_output $_abbrev_section {
+	    define_label $my_abbrevs
+	}
+
+	uplevel $body
+
+	_defer_output $_abbrev_section {
+	    # Emit the terminator.
+	    _op .byte 0x0 "Abbrev end - Terminator"
+	}
+
+	define_label $end_label
+    }
+
+    # Emit a DWARF TU.
+    # 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 in bytes: 4, 8, or default
+    #                default = default
+    # fission 0|1  - boolean indicating if generating Fission debug info
+    #                default = 0
+    # SIGNATURE is the 64-bit signature of the type.
+    # TYPE_LABEL is the label of the type defined by this TU,
+    # or "" if there is no type (i.e., type stubs in Fission).
+    # BODY is Tcl code that emits the DIEs which make up the body of
+    # the TU.  It is evaluated in the caller's context.
+    proc tu {options signature type_label body} {
+	variable _cu_count
+	variable _abbrev_section
+	variable _abbrev_num
+	variable _cu_label
+	variable _cu_version
+	variable _cu_addr_size
+	variable _cu_offset_size
+
+	# Establish the defaults.
+	set is_64 0
+	set _cu_version 4
+	set _cu_addr_size default
+	set fission 0
+	set section ".debug_types"
+	set _abbrev_section ".debug_abbrev"
+
+	foreach { name value } $options {
+	    switch -exact -- $name {
+		is_64 { set is_64 $value }
+		version { set _cu_version $value }
+		addr_size { set _cu_addr_size $value }
+		fission { set fission $value }
+		default { error "unknown option $name" }
+	    }
+	}
+	if {$_cu_addr_size == "default"} {
+	    if {[is_64_target]} {
+		set _cu_addr_size 8
+	    } else {
+		set _cu_addr_size 4
+	    }
+	}
+	set _cu_offset_size [expr { $is_64 ? 8 : 4 }]
+	if { $fission } {
+	    set section ".debug_types.dwo"
+	    set _abbrev_section ".debug_abbrev.dwo"
+	}
+
+	_section $section
+
+	set cu_num [incr _cu_count]
+	set my_abbrevs [_compute_label "abbrev${cu_num}_begin"]
+	set _abbrev_num 1
+
+	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
+	    _op .8byte "$end_label - $start_label"
+	} else {
+	    _op .4byte "$end_label - $start_label"
+	}
+	define_label $start_label
+	_op .2byte $_cu_version Version
+	_op .${_cu_offset_size}byte $my_abbrevs Abbrevs
+	_op .byte $_cu_addr_size "Pointer size"
+	_op .8byte $signature Signature
+	if { $type_label != "" } {
+	    uplevel declare_labels $type_label
+	    upvar $type_label my_type_label
+	    if {$is_64} {
+		_op .8byte "$my_type_label - $_cu_label"
+	    } else {
+		_op .4byte "$my_type_label - $_cu_label"
+	    }
+	} else {
+	    if {$is_64} {
+		_op .8byte 0
+	    } else {
+		_op .4byte 0
+	    }
+	}
+
+	_defer_output $_abbrev_section {
+	    define_label $my_abbrevs
+	}
+
+	uplevel $body
+
+	_defer_output $_abbrev_section {
+	    # Emit the terminator.
+	    _op .byte 0x0 "Abbrev end - Terminator"
+	}
+
+	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 { body } {
+	    variable _debug_ranges_64_bit
+
+	    # Emit the sequence of addresses.
+
+	    proc base { addr } {
+		variable _debug_ranges_64_bit
+
+		if { $_debug_ranges_64_bit } then {
+		    _op .8byte 0xffffffffffffffff "Base Marker"
+		    _op .8byte $addr "Base Address"
+		} else {
+		    _op .4byte 0xffffffff "Base Marker"
+		    _op .4byte $addr "Base Address"
+		}
+	    }
+
+	    proc range { start end } {
+		variable _debug_ranges_64_bit
+
+		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"
+		}
+	    }
+
+	    uplevel $body
+
+	    # 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 in bytes: 4, 8, 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
+	set _line_saw_program 0
+	set _line_saw_file 0
+	set _default_is_stmt 1
+
+	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_is_stmt { set _default_is_stmt $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 $_default_is_stmt "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
+	    variable _line
+
+	    set _line 1
+
+	    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 {} {
+		variable _line
+		_op .byte 0
+		_op .uleb128 1
+		_op .byte 1
+		set _line 1
+	    }
+
+	    proc DW_LNE_user { len opcode } {
+		set DW_LNE_lo_usr 0x80
+		set DW_LNE_hi_usr 0xff
+		if { $DW_LNE_lo_usr <= $opcode
+		     && $opcode <= $DW_LNE_hi_usr } {
+		    _op .byte 0
+		    _op .uleb128 $len
+		    _op .byte $opcode
+		    for {set i 1} {$i < $len} {incr i} {
+			_op .byte 0
+		    }
+		} else {
+		    error "unknown vendor specific extended opcode: $opcode"
+		}
+	    }
+
+	    proc DW_LNS_copy {} {
+		_op .byte 1
+	    }
+
+	    proc DW_LNS_negate_stmt {} {
+		_op .byte 6
+	    }
+
+	    proc DW_LNS_advance_pc {offset} {
+		_op .byte 2
+		_op .uleb128 ${offset}
+	    }
+
+	    proc DW_LNS_advance_line {offset} {
+		variable _line
+		_op .byte 3
+		_op .sleb128 ${offset}
+		set _line [expr $_line + $offset]
+	    }
+
+	    # A pseudo line number program instruction, that can be used instead
+	    # of DW_LNS_advance_line.  Rather than writing:
+	    #   {DW_LNS_advance_line [expr $line1 - 1]}
+	    #   {DW_LNS_advance_line [expr $line2 - $line1]}
+	    #   {DW_LNS_advance_line [expr $line3 - $line2]}
+	    # we can just write:
+	    #   {line $line1}
+	    #   {line $line2}
+	    #   {line $line3}
+	    proc line {line} {
+		variable _line
+		set offset [expr $line - $_line]
+		DW_LNS_advance_line $offset
+	    }
+
+	    proc DW_LNS_set_file {num} {
+		_op .byte 4
+		_op .sleb128 ${num}
+	    }
+
+	    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
+
+	catch {unset the_array}
+	set the_array(_) {}
+	unset the_array(_)
+    }
+
+    # Emit a .gnu_debugaltlink section with the given file name and
+    # build-id.  The buildid should be represented as a hexadecimal
+    # string, like "ffeeddcc".
+    proc gnu_debugaltlink {filename buildid} {
+	_defer_output .gnu_debugaltlink {
+	    _op .ascii [_quote $filename]
+	    foreach {a b} [split $buildid {}] {
+		_op .byte 0x$a$b
+	    }
+	}
+    }
+
+    proc _note {type name hexdata} {
+	set namelen [expr [string length $name] + 1]
+
+	# Name size.
+	_op .4byte $namelen
+	# Data size.
+	_op .4byte [expr [string length $hexdata] / 2]
+	# Type.
+	_op .4byte $type
+	# The name.
+	_op .ascii [_quote $name]
+	# Alignment.
+	set align 2
+	set total [expr {($namelen + (1 << $align) - 1) & -(1 << $align)}]
+	for {set i $namelen} {$i < $total} {incr i} {
+	    _op .byte 0
+	}
+	# The data.
+	foreach {a b} [split $hexdata {}] {
+	    _op .byte 0x$a$b
+	}
+    }
+
+    # Emit a note section holding the given build-id.
+    proc build_id {buildid} {
+	_defer_output {.note.gnu.build-id a note} {
+	    # From elf/common.h.
+	    set NT_GNU_BUILD_ID 3
+
+	    _note $NT_GNU_BUILD_ID GNU $buildid
+	}
+    }
+
+    # The top-level interface to the DWARF assembler.
+    # FILENAME is the name of the file where the generated assembly
+    # code is written.
+    # 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.
+    #
+    # A typical invocation is something like:
+    #    Dwarf::assemble $file {
+    #        cu 0 2 8 {
+    #            compile_unit {
+    #            ...
+    #            }
+    #        }
+    #        cu 0 2 8 {
+    #        ...
+    #        }
+    #    }
+    proc assemble {filename body} {
+	variable _initialized
+	variable _output_file
+	variable _deferred_output
+	variable _defer
+	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 _initialized 1
+	}
+
+	set _output_file [open $filename w]
+	set _cu_count 0
+	_empty_array _deferred_output
+	set _defer ""
+	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.
+	eval $body
+
+	_write_deferred_output
+
+	_section .note.GNU-stack "" progbits
+
+	catch {close $_output_file}
+	set _output_file {}
+    }
+}
diff --git a/testsuite/lib/dwz.exp b/testsuite/lib/dwz.exp
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/testsuite/lib/dwz.exp
diff --git a/testsuite/lib/invalid-dw-at-stmt-list-encoding.exp b/testsuite/lib/invalid-dw-at-stmt-list-encoding.exp
new file mode 100644
index 0000000..490fca4
--- /dev/null
+++ b/testsuite/lib/invalid-dw-at-stmt-list-encoding.exp
@@ -0,0 +1,21 @@
+load_lib dwarf-lib.exp
+load_lib dwarf.exp
+
+set asm_file invalid-dw-at-stmt-list-encoding-dw.S
+
+Dwarf::assemble $asm_file {
+    cu {} {
+	DW_TAG_compile_unit {
+	    {DW_AT_language @DW_LANG_C}
+	    {DW_AT_name     foo.c}
+	    {DW_AT_comp_dir /bar}
+            {stmt_list 0 DW_FORM_addr}
+	} {
+	    DW_TAG_base_type {
+		{DW_AT_byte_size 4 DW_FORM_data1}
+		{DW_AT_name integer}
+	    }
+	}
+    }
+
+}
diff --git a/testsuite/lib/no-multifile-prop.exp b/testsuite/lib/no-multifile-prop.exp
new file mode 100644
index 0000000..bcd9669
--- /dev/null
+++ b/testsuite/lib/no-multifile-prop.exp
@@ -0,0 +1,132 @@
+# Copyright 2019 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
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+load_lib dwarf-lib.exp
+load_lib dwarf.exp
+
+set asm_file no-multifile-prop-dw.S
+
+Dwarf::assemble $asm_file {
+
+    # CU 1
+    cu {} {
+	DW_TAG_compile_unit {
+	    {DW_AT_language @DW_LANG_C_plus_plus}
+	    {DW_AT_name     1.c}
+	    {DW_AT_comp_dir /tmp}
+	} {
+	    declare_labels integer_label var_label
+
+	    integer_label: DW_TAG_base_type {
+		{DW_AT_byte_size 4 DW_FORM_data1}
+		{DW_AT_encoding  @DW_ATE_signed}
+		{DW_AT_name      integer}
+	    }
+
+	    var_label: DW_TAG_variable {
+		{DW_AT_name foo1}
+		{DW_AT_type :$integer_label}
+		{external 1 flag}
+	    }
+
+	    DW_TAG_variable {
+		{DW_AT_name foo2}
+		{DW_AT_type :$integer_label}
+		{DW_AT_location {
+		    DW_OP_GNU_implicit_pointer $var_label 0
+		} SPECIAL_expr}
+		{external 1 flag}
+	    }
+	}
+    }
+
+    # CU 2
+    cu {} {
+	DW_TAG_compile_unit {
+	    {DW_AT_language @DW_LANG_C_plus_plus}
+	    {DW_AT_name     2.c}
+	    {DW_AT_comp_dir /tmp}
+	} {
+	    declare_labels integer_label var_label
+
+	    integer_label: DW_TAG_base_type {
+		{DW_AT_byte_size 4 DW_FORM_data1}
+		{DW_AT_encoding  @DW_ATE_signed}
+		{DW_AT_name      integer}
+	    }
+
+	    var_label: DW_TAG_variable {
+		{DW_AT_name foo1}
+		{DW_AT_type :$integer_label}
+		{external 1 flag}
+	    }
+
+	    DW_TAG_imported_declaration {
+		{DW_AT_import :$var_label}
+	    }
+	}
+    }
+
+    # CU 3
+    cu {} {
+	DW_TAG_compile_unit {
+	    {DW_AT_language @DW_LANG_C_plus_plus}
+	    {DW_AT_name     3.c}
+	    {DW_AT_comp_dir /tmp}
+	} {
+	    declare_labels integer_label
+
+	    integer_label: DW_TAG_base_type {
+		{DW_AT_byte_size 4 DW_FORM_data1}
+		{DW_AT_encoding  @DW_ATE_signed}
+		{DW_AT_name      integer}
+	    }
+
+	    DW_TAG_variable {
+		{DW_AT_name foo1}
+		{DW_AT_type :$integer_label}
+		{external 1 flag}
+	    }
+
+	}
+    }
+
+    # CU 4
+    cu {} {
+	DW_TAG_compile_unit {
+	    {DW_AT_language @DW_LANG_C_plus_plus}
+	    {DW_AT_name     4.c}
+	    {DW_AT_comp_dir /tmp}
+	} {
+	    declare_labels integer_label var_label
+
+	    integer_label: DW_TAG_base_type {
+		{DW_AT_byte_size 4 DW_FORM_data1}
+		{DW_AT_encoding  @DW_ATE_signed}
+		{DW_AT_name      integer}
+	    }
+
+	    var_label: DW_TAG_variable {
+		{DW_AT_name foo1}
+		{DW_AT_type :$integer_label}
+		{external 1 flag}
+	    }
+
+	    DW_TAG_imported_declaration {
+		{DW_AT_import :$var_label}
+	    }
+	}
+    }
+}
diff --git a/testsuite/lib/unavailable-dwarf-piece.exp b/testsuite/lib/unavailable-dwarf-piece.exp
new file mode 100644
index 0000000..0fa1df9
--- /dev/null
+++ b/testsuite/lib/unavailable-dwarf-piece.exp
@@ -0,0 +1,272 @@
+# Copyright (C) 2013-2021 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
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+load_lib dwarf-lib.exp
+load_lib dwarf.exp
+
+set asm_file unavailable-dwarf-piece-dw.S
+
+Dwarf::assemble $asm_file {
+    declare_labels uchar_label struct_s_label foo_label struct_t_label bar_label
+
+    cu {} {
+	compile_unit {{language @DW_LANG_C}} {
+	    uchar_label: DW_TAG_base_type {
+		{name "unsigned char"}
+		{byte_size 1 DW_FORM_sdata}
+		{encoding @DW_ATE_unsigned_char}
+	    }
+
+	    struct_s_label: DW_TAG_structure_type {
+		{name s}
+		{byte_size 3 DW_FORM_sdata}
+		{decl_file 0 DW_FORM_udata}
+		{decl_line 1 DW_FORM_sdata}
+	    } {
+		DW_TAG_member {
+		    {name a}
+		    {type :$uchar_label}
+		    {data_member_location {
+			DW_OP_plus_uconst 0
+		    } SPECIAL_expr}
+		}
+		DW_TAG_member {
+		    {name b}
+		    {type :$uchar_label}
+		    {data_member_location {
+			DW_OP_plus_uconst 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_member {
+		    {name c}
+		    {type :$uchar_label}
+		    {data_member_location {
+			DW_OP_plus_uconst 2
+		    } SPECIAL_expr}
+		}
+	    }
+
+	    struct_t_label: DW_TAG_structure_type {
+		{name t}
+		{byte_size 3 DW_FORM_sdata}
+		{decl_file 0 DW_FORM_udata}
+		{decl_line 1 DW_FORM_sdata}
+	    } {
+		DW_TAG_member {
+		    {name a}
+		    {type :$uchar_label}
+		    {data_member_location {
+			DW_OP_plus_uconst 0
+		    } SPECIAL_expr}
+		}
+		DW_TAG_member {
+		    {name b}
+		    {type :$uchar_label}
+		    {byte_size 1 DW_FORM_sdata}
+		    {bit_size 1 DW_FORM_sdata}
+		    {bit_offset 7 DW_FORM_sdata}
+		    {data_member_location {
+			DW_OP_plus_uconst 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_member {
+		    {name c}
+		    {type :$uchar_label}
+		    {byte_size 1 DW_FORM_sdata}
+		    {bit_size 1 DW_FORM_sdata}
+		    {bit_offset 6 DW_FORM_sdata}
+		    {data_member_location {
+			DW_OP_plus_uconst 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_member {
+		    {name d}
+		    {type :$uchar_label}
+		    {byte_size 1 DW_FORM_sdata}
+		    {bit_size 1 DW_FORM_sdata}
+		    {bit_offset 5 DW_FORM_sdata}
+		    {data_member_location {
+			DW_OP_plus_uconst 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_member {
+		    {name e}
+		    {type :$uchar_label}
+		    {byte_size 1 DW_FORM_sdata}
+		    {bit_size 1 DW_FORM_sdata}
+		    {bit_offset 4 DW_FORM_sdata}
+		    {data_member_location {
+			DW_OP_plus_uconst 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_member {
+		    {name f}
+		    {type :$uchar_label}
+		    {byte_size 1 DW_FORM_sdata}
+		    {bit_size 1 DW_FORM_sdata}
+		    {bit_offset 3 DW_FORM_sdata}
+		    {data_member_location {
+			DW_OP_plus_uconst 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_member {
+		    {name g}
+		    {type :$uchar_label}
+		    {byte_size 1 DW_FORM_sdata}
+		    {bit_size 1 DW_FORM_sdata}
+		    {bit_offset 2 DW_FORM_sdata}
+		    {data_member_location {
+			DW_OP_plus_uconst 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_member {
+		    {name h}
+		    {type :$uchar_label}
+		    {byte_size 1 DW_FORM_sdata}
+		    {bit_size 1 DW_FORM_sdata}
+		    {bit_offset 1 DW_FORM_sdata}
+		    {data_member_location {
+			DW_OP_plus_uconst 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_member {
+		    {name i}
+		    {type :$uchar_label}
+		    {byte_size 1 DW_FORM_sdata}
+		    {bit_size 1 DW_FORM_sdata}
+		    {bit_offset 0 DW_FORM_sdata}
+		    {data_member_location {
+			DW_OP_plus_uconst 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_member {
+		    {name j}
+		    {type :$uchar_label}
+		    {data_member_location {
+			DW_OP_plus_uconst 2
+		    } SPECIAL_expr}
+		}
+	    }
+
+	    DW_TAG_subprogram {
+		{name foo}
+		{decl_file 0 udata}
+		{low_pc foo_start_lbl addr}
+		{high_pc foo_end_lbl addr}
+	    } {
+		DW_TAG_formal_parameter {
+		    {type :$struct_s_label}
+		    {name x}
+		    {location {
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_piece 2
+			DW_OP_reg0
+			DW_OP_piece 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_formal_parameter {
+		    {type :$struct_s_label}
+		    {name y}
+		    {location {
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_piece 1
+			DW_OP_reg0
+			DW_OP_piece 1
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_piece 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_formal_parameter {
+		    {type :$struct_s_label}
+		    {name z}
+		    {location {
+			DW_OP_reg0
+			DW_OP_piece 1
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_piece 2
+		    } SPECIAL_expr}
+		}
+	    }
+
+
+	    DW_TAG_subprogram {
+		{name bar}
+		{decl_file 0 udata}
+		{low_pc bar_start_lbl addr}
+		{high_pc bar_end_lbl addr}
+	    } {
+		DW_TAG_formal_parameter {
+		    {type :$struct_t_label}
+		    {name x}
+		    {location {
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_piece 1
+			DW_OP_reg0
+			DW_OP_bit_piece 1 0
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_bit_piece 7 0
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_piece 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_formal_parameter {
+		    {type :$struct_t_label}
+		    {name y}
+		    {location {
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_piece 1
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_bit_piece 3 0
+			DW_OP_reg0
+			DW_OP_bit_piece 1 0
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_bit_piece 4 0
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_piece 1
+		    } SPECIAL_expr}
+		}
+		DW_TAG_formal_parameter {
+		    {type :$struct_t_label}
+		    {name z}
+		    {location {
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_piece 1
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_bit_piece 7 0
+			DW_OP_reg0
+			DW_OP_bit_piece 1 0
+			DW_OP_lit0
+			DW_OP_stack_value
+			DW_OP_piece 1
+		    } SPECIAL_expr}
+		}
+	    }
+
+	}
+    }
+}