LilyPond-Ruby 0.0.2.1 → 0.1.2

data/share/guile/2.2/system/vm/dwarf.scm

@@ -0,0 +1,1852 @@
+;;; Guile DWARF reader and writer
+
+;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+
+;; Parts of this file were derived from sysdeps/generic/dwarf2.h, from
+;; the GNU C Library.  That file is available under the LGPL version 2
+;; or later, and is copyright:
+;;
+;; Copyright (C) 1992, 1993, 1995, 1996, 1997, 2000, 2011
+;; 	Free Software Foundation, Inc.
+;; Contributed by Gary Funck (gary@intrepid.com).  Derived from the
+;; DWARF 1 implementation written by Ron Guilmette (rfg@monkeys.com).
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Commentary:
+;;
+;; DWARF is a flexible format for describing compiled programs.  It is
+;; used by Guile to record source positions, describe local variables,
+;; function arities, and other function metadata.
+;;
+;; Structurally, DWARF describes a tree of data.  Each node in the tree
+;; is a debugging information entry ("DIE").  Each DIE has a "tag",
+;; possible a set of attributes, and possibly some child DIE nodes.
+;; That's basically it!
+;;
+;; The DIE nodes are contained in the .debug_info section of an ELF
+;; file.  Attributes within the DIE nodes link them to mapped ranges of
+;; the ELF file (.rtl-text, .data, etc.).
+;;
+;; A .debug_info section logically contains a series of debugging
+;; "contributions", one for each compilation unit.  Each contribution is
+;; prefixed by a header and contains a single DIE element whose tag is
+;; "compilation-unit".  That node usually contains child nodes, for
+;; example of type "subprogram".
+;;
+;; Since usually one will end up producing many DIE nodes with the same
+;; tag and attribute types, DIE nodes are defined by referencing a known
+;; shape, and then filling in the values.  The shapes are defined in the
+;; form of "abbrev" entries, which specify a specific combination of a
+;; tag and an ordered set of attributes, with corresponding attribute
+;; representations ("forms").  Abbrevs are written out to a separate
+;; section, .debug_abbrev.  Abbrev nodes also specify whether the
+;; corresponding DIE node has children or not.  When a DIE is written
+;; into the .debug_info section, it references one of the abbrevs in
+;; .debug_abbrev.  You need the abbrev in order to parse the DIE.
+;;
+;; For completeness, the other sections that DWARF uses are .debug_str,
+;; .debug_loc, .debug_pubnames, .debug_aranges, .debug_frame, and
+;; .debug_line.  These are described in section 6 of the DWARF 3.0
+;; specification, at http://dwarfstd.org/.
+;;
+;; This DWARF module is currently capable of parsing all of DWARF 2.0
+;; and parts of DWARF 3.0.  For Guile's purposes, we also use DWARF as
+;; the format for our own debugging information.  The DWARF generator is
+;; fairly minimal, and is not intended to be complete.
+;;
+;;; Code:
+
+(define-module (system vm dwarf)
+  #:use-module (rnrs bytevectors)
+  #:use-module (system foreign)
+  #:use-module (system base target)
+  #:use-module (system vm elf)
+  #:use-module ((srfi srfi-1) #:select (fold))
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-11)
+  #:export (elf->dwarf-context
+            read-die-roots
+            fold-pubnames fold-aranges
+
+            access-name->code
+            address-name->code
+            attribute-name->code
+            call-frame-address-name->code
+            children-name->code
+            convention-name->code
+            discriminant-name->code
+            form-name->code
+            inline-name->code
+            language-name->code
+            macro-name->code
+            ordering-name->code
+            sensitivity-name->code
+            tag-name->code
+            virtuality-name->code
+            visibility-name->code
+
+            abbrev? abbrev-code
+            abbrev-tag abbrev-has-children? abbrev-attrs abbrev-forms
+
+            die? die-ctx die-offset die-abbrev die-vals die-children
+            die-tag die-attrs die-forms die-ref
+            die-name die-specification die-qname die-low-pc die-high-pc
+
+            ctx-parent ctx-die ctx-start ctx-end ctx-children ctx-language
+
+            die-line-prog line-prog-advance line-prog-scan-to-pc
+
+            find-die-context find-die-by-offset find-die find-die-by-pc
+            read-die fold-die-list
+
+            fold-die-children die->tree))
+
+;;;
+;;; First, define a number of constants.  The figures numbers refer to
+;;; the DWARF 2.0 draft specification available on http://dwarfstd.org/.
+;;; Extra codes not defined in that document are taken from the dwarf2
+;;; header in glibc.
+;;;
+
+(define-syntax-rule (define-enumeration code->name name->code
+                      (tag value) ...)
+  (begin
+    (define code->name
+      (let ((table (make-hash-table)))
+        (hashv-set! table value 'tag)
+        ...
+        (lambda (v)
+          (hashv-ref table v v))))
+    (define name->code
+      (let ((table (make-hash-table)))
+        (hashv-set! table 'tag value)
+        ...
+        (lambda (v)
+          (hashv-ref table v v))))))
+
+;; Figures 14 and 15: Tag names and codes.
+;;
+(define-enumeration tag-code->name tag-name->code
+  (padding #x00)
+  (array-type #x01)
+  (class-type #x02)
+  (entry-point #x03)
+  (enumeration-type #x04)
+  (formal-parameter #x05)
+  (imported-declaration #x08)
+  (label #x0a)
+  (lexical-block #x0b)
+  (member #x0d)
+  (pointer-type #x0f)
+  (reference-type #x10)
+  (compile-unit #x11)
+  (string-type #x12)
+  (structure-type #x13)
+  (subroutine-type #x15)
+  (typedef #x16)
+  (union-type #x17)
+  (unspecified-parameters #x18)
+  (variant #x19)
+  (common-block #x1a)
+  (common-inclusion #x1b)
+  (inheritance #x1c)
+  (inlined-subroutine #x1d)
+  (module #x1e)
+  (ptr-to-member-type #x1f)
+  (set-type #x20)
+  (subrange-type #x21)
+  (with-stmt #x22)
+  (access-declaration #x23)
+  (base-type #x24)
+  (catch-block #x25)
+  (const-type #x26)
+  (constant #x27)
+  (enumerator #x28)
+  (file-type #x29)
+  (friend #x2a)
+  (namelist #x2b)
+  (namelist-item #x2c)
+  (packed-type #x2d)
+  (subprogram #x2e)
+  (template-type-param #x2f)
+  (template-value-param #x30)
+  (thrown-type #x31)
+  (try-block #x32)
+  (variant-part #x33)
+  (variable #x34)
+  (volatile-type #x35)
+  ;; DWARF 3.
+  (dwarf-procedure #x36)
+  (restrict-type #x37)
+  (interface-type #x38)
+  (namespace #x39)
+  (imported-module #x3a)
+  (unspecified-type #x3b)
+  (partial-unit #x3c)
+  (imported-unit #x3d)
+  (condition #x3f)
+  (shared-type #x40)
+  ;; Extensions.
+  (format-label #x4101)
+  (function-template #x4102)
+  (class-template #x4103)
+  (GNU-BINCL #x4104)
+  (GNU-EINCL #x4105)
+  (lo-user #x4080)
+  (hi-user #xffff))
+
+;; Figure 16: Flag that tells whether entry has a child or not.
+;;
+(define-enumeration children-code->name children-name->code
+  (no 0)
+  (yes 1))
+
+;; Figures 17 and 18: Attribute names and codes.
+;;
+(define-enumeration attribute-code->name attribute-name->code
+  (sibling #x01)
+  (location #x02)
+  (name #x03)
+  (ordering #x09)
+  (subscr-data #x0a)
+  (byte-size #x0b)
+  (bit-offset #x0c)
+  (bit-size #x0d)
+  (element-list #x0f)
+  (stmt-list #x10)
+  (low-pc #x11)
+  (high-pc #x12)
+  (language #x13)
+  (member #x14)
+  (discr #x15)
+  (discr-value #x16)
+  (visibility #x17)
+  (import #x18)
+  (string-length #x19)
+  (common-reference #x1a)
+  (comp-dir #x1b)
+  (const-value #x1c)
+  (containing-type #x1d)
+  (default-value #x1e)
+  (inline #x20)
+  (is-optional #x21)
+  (lower-bound #x22)
+  (producer #x25)
+  (prototyped #x27)
+  (return-addr #x2a)
+  (start-scope #x2c)
+  (stride-size #x2e)
+  (upper-bound #x2f)
+  (abstract-origin #x31)
+  (accessibility #x32)
+  (address-class #x33)
+  (artificial #x34)
+  (base-types #x35)
+  (calling-convention #x36)
+  (count #x37)
+  (data-member-location #x38)
+  (decl-column #x39)
+  (decl-file #x3a)
+  (decl-line #x3b)
+  (declaration #x3c)
+  (discr-list #x3d)
+  (encoding #x3e)
+  (external #x3f)
+  (frame-base #x40)
+  (friend #x41)
+  (identifier-case #x42)
+  (macro-info #x43)
+  (namelist-items #x44)
+  (priority #x45)
+  (segment #x46)
+  (specification #x47)
+  (static-link #x48)
+  (type #x49)
+  (use-location #x4a)
+  (variable-parameter #x4b)
+  (virtuality #x4c)
+  (vtable-elem-location #x4d)
+  ;; DWARF 3.
+  (associated #x4f)
+  (data-location #x50)
+  (byte-stride #x51)
+  (entry-pc #x52)
+  (use-UTF8 #x53)
+  (extension #x54)
+  (ranges #x55)
+  (trampoline #x56)
+  (call-column #x57)
+  (call-file #x58)
+  (call-line #x59)
+  (description #x5a)
+  (binary-scale #x5b)
+  (decimal-scale #x5c)
+  (small #x5d)
+  (decimal-sign #x5e)
+  (digit-count #x5f)
+  (picture-string #x60)
+  (mutable #x61)
+  (threads-scaled #x62)
+  (explicit #x63)
+  (object-pointer #x64)
+  (endianity #x65)
+  (elemental #x66)
+  (pure #x67)
+  (recursive #x68)
+  ;; Extensions.
+  (linkage-name #x2007)
+  (sf-names #x2101)
+  (src-info #x2102)
+  (mac-info #x2103)
+  (src-coords #x2104)
+  (body-begin #x2105)
+  (body-end #x2106)
+  (lo-user #x2000)
+  (hi-user #x3fff))
+
+;; Figure 19: Form names and codes.
+;;
+(define-enumeration form-code->name form-name->code
+  (addr #x01)
+  (block2 #x03)
+  (block4 #x04)
+  (data2 #x05)
+  (data4 #x06)
+  (data8 #x07)
+  (string #x08)
+  (block #x09)
+  (block1 #x0a)
+  (data1 #x0b)
+  (flag #x0c)
+  (sdata #x0d)
+  (strp #x0e)
+  (udata #x0f)
+  (ref-addr #x10)
+  (ref1 #x11)
+  (ref2 #x12)
+  (ref4 #x13)
+  (ref8 #x14)
+  (ref-udata #x15)
+  (indirect #x16)
+  (sec-offset #x17)
+  (exprloc #x18)
+  (flag-present #x19)
+  (ref-sig8 #x20))
+
+;; Figures 22 and 23: Location atom names and codes.
+;;
+(define-enumeration location-op->name location-name->op
+  (addr #x03)
+  (deref #x06)
+  (const1u #x08)
+  (const1s #x09)
+  (const2u #x0a)
+  (const2s #x0b)
+  (const4u #x0c)
+  (const4s #x0d)
+  (const8u #x0e)
+  (const8s #x0f)
+  (constu #x10)
+  (consts #x11)
+  (dup #x12)
+  (drop #x13)
+  (over #x14)
+  (pick #x15)
+  (swap #x16)
+  (rot #x17)
+  (xderef #x18)
+  (abs #x19)
+  (and #x1a)
+  (div #x1b)
+  (minus #x1c)
+  (mod #x1d)
+  (mul #x1e)
+  (neg #x1f)
+  (not #x20)
+  (or #x21)
+  (plus #x22)
+  (plus-uconst #x23)
+  (shl #x24)
+  (shr #x25)
+  (shra #x26)
+  (xor #x27)
+  (bra #x28)
+  (eq #x29)
+  (ge #x2a)
+  (gt #x2b)
+  (le #x2c)
+  (lt #x2d)
+  (ne #x2e)
+  (skip #x2f)
+  (lit0 #x30)
+  (lit1 #x31)
+  (lit2 #x32)
+  (lit3 #x33)
+  (lit4 #x34)
+  (lit5 #x35)
+  (lit6 #x36)
+  (lit7 #x37)
+  (lit8 #x38)
+  (lit9 #x39)
+  (lit10 #x3a)
+  (lit11 #x3b)
+  (lit12 #x3c)
+  (lit13 #x3d)
+  (lit14 #x3e)
+  (lit15 #x3f)
+  (lit16 #x40)
+  (lit17 #x41)
+  (lit18 #x42)
+  (lit19 #x43)
+  (lit20 #x44)
+  (lit21 #x45)
+  (lit22 #x46)
+  (lit23 #x47)
+  (lit24 #x48)
+  (lit25 #x49)
+  (lit26 #x4a)
+  (lit27 #x4b)
+  (lit28 #x4c)
+  (lit29 #x4d)
+  (lit30 #x4e)
+  (lit31 #x4f)
+  (reg0 #x50)
+  (reg1 #x51)
+  (reg2 #x52)
+  (reg3 #x53)
+  (reg4 #x54)
+  (reg5 #x55)
+  (reg6 #x56)
+  (reg7 #x57)
+  (reg8 #x58)
+  (reg9 #x59)
+  (reg10 #x5a)
+  (reg11 #x5b)
+  (reg12 #x5c)
+  (reg13 #x5d)
+  (reg14 #x5e)
+  (reg15 #x5f)
+  (reg16 #x60)
+  (reg17 #x61)
+  (reg18 #x62)
+  (reg19 #x63)
+  (reg20 #x64)
+  (reg21 #x65)
+  (reg22 #x66)
+  (reg23 #x67)
+  (reg24 #x68)
+  (reg25 #x69)
+  (reg26 #x6a)
+  (reg27 #x6b)
+  (reg28 #x6c)
+  (reg29 #x6d)
+  (reg30 #x6e)
+  (reg31 #x6f)
+  (breg0 #x70)
+  (breg1 #x71)
+  (breg2 #x72)
+  (breg3 #x73)
+  (breg4 #x74)
+  (breg5 #x75)
+  (breg6 #x76)
+  (breg7 #x77)
+  (breg8 #x78)
+  (breg9 #x79)
+  (breg10 #x7a)
+  (breg11 #x7b)
+  (breg12 #x7c)
+  (breg13 #x7d)
+  (breg14 #x7e)
+  (breg15 #x7f)
+  (breg16 #x80)
+  (breg17 #x81)
+  (breg18 #x82)
+  (breg19 #x83)
+  (breg20 #x84)
+  (breg21 #x85)
+  (breg22 #x86)
+  (breg23 #x87)
+  (breg24 #x88)
+  (breg25 #x89)
+  (breg26 #x8a)
+  (breg27 #x8b)
+  (breg28 #x8c)
+  (breg29 #x8d)
+  (breg30 #x8e)
+  (breg31 #x8f)
+  (regx #x90)
+  (fbreg #x91)
+  (bregx #x92)
+  (piece #x93)
+  (deref-size #x94)
+  (xderef-size #x95)
+  (nop #x96)
+  ;; DWARF 3.
+  (push-object-address #x97)
+  (call2 #x98)
+  (call4 #x99)
+  (call-ref #x9a)
+  (form-tls-address #x9b)
+  (call-frame-cfa #x9c)
+  (bit-piece #x9d)
+  (lo-user #x80)
+  (hi-user #xff))
+
+;; Figure 24: Type encodings.
+;;
+(define-enumeration type-encoding->name type-name->encoding
+  (void #x0)
+  (address #x1)
+  (boolean #x2)
+  (complex-float #x3)
+  (float #x4)
+  (signed #x5)
+  (signed-char #x6)
+  (unsigned #x7)
+  (unsigned-char #x8)
+  ;; DWARF 3.
+  (imaginary-float #x09)
+  (packed-decimal #x0a)
+  (numeric-string #x0b)
+  (edited #x0c)
+  (signed-fixed #x0d)
+  (unsigned-fixed #x0e)
+  (decimal-float #x0f)
+  (lo-user #x80)
+  (hi-user #xff))
+
+;; Figure 25: Access attribute.
+;;
+(define-enumeration access-code->name access-name->code
+  (public 1)
+  (protected 2)
+  (private 3))
+
+;; Figure 26: Visibility.
+;;
+(define-enumeration visibility-code->name visibility-name->code
+  (local 1)
+  (exported 2)
+  (qualified 3))
+
+;; Figure 27: Virtuality.
+;;
+(define-enumeration virtuality-code->name virtuality-name->code
+  (none 0)
+  (virtual 1)
+  (pure-virtual 2))
+
+;; Figure 28: Source language names and codes.
+;;
+(define-enumeration language-code->name language-name->code
+  (c89 #x0001)
+  (c #x0002)
+  (ada83 #x0003)
+  (c++ #x0004)
+  (cobol74 #x0005)
+  (cobol85 #x0006)
+  (fortran77 #x0007)
+  (fortran90 #x0008)
+  (pascal83 #x0009)
+  (modula2 #x000a)
+  (java #x000b)
+  (c99 #x000c)
+  (ada95 #x000d)
+  (fortran95 #x000e)
+  (pli #x000f)
+  (objc #x0010)
+  (objc++ #x0011)
+  (upc #x0012)
+  (d #x0013)
+  (python #x0014)
+  (mips-assembler #x8001)
+
+  (lo-user #x8000)
+
+  ;; FIXME: Ask for proper codes for these.
+  (scheme #xaf33)
+  (emacs-lisp #xaf34)
+  (ecmascript #xaf35)
+  (lua #xaf36)
+  (brainfuck #xaf37)
+
+  (hi-user #xffff))
+
+;; Figure 29: Case sensitivity.
+;;
+(define-enumeration case-sensitivity-code->name case-sensitivity-name->code
+  (case-sensitive 0)
+  (up-case 1)
+  (down-case 2)
+  (case-insensitive 3))
+
+;; Figure 30: Calling convention.
+;;
+(define-enumeration calling-convention-code->name calling-convention-name->code
+  (normal #x1)
+  (program #x2)
+  (nocall #x3)
+  (lo-user #x40)
+  (hi-user #xff))
+
+;; Figure 31: Inline attribute.
+;;
+(define-enumeration inline-code->name inline-name->code
+  (not-inlined 0)
+  (inlined 1)
+  (declared-not-inlined 2)
+  (declared-inlined 3))
+
+;; Figure 32: Array ordering names and codes.
+(define-enumeration ordering-code->name ordering-name->code
+  (row-major 0)
+  (col-major 1))
+
+;; Figure 33: Discriminant lists.
+;;
+(define-enumeration discriminant-code->name discriminant-name->code
+  (label 0)
+  (range 1))
+
+;; Figure 34: "Standard" line number opcodes.
+;;
+(define-enumeration standard-line-opcode->name standard-line-name->opcode
+  (extended-op 0)
+  (copy 1)
+  (advance-pc 2)
+  (advance-line 3)
+  (set-file 4)
+  (set-column 5)
+  (negate-stmt 6)
+  (set-basic-block 7)
+  (const-add-pc 8)
+  (fixed-advance-pc 9)
+  ;; DWARF 3.
+  (set-prologue-end #x0a)
+  (set-epilogue-begin #x0b)
+  (set-isa #x0c))
+
+;; Figure 35: "Extended" line number opcodes.
+;;
+(define-enumeration extended-line-opcode->name extended-line-name->opcode
+  (end-sequence 1)
+  (set-address 2)
+  (define-file 3)
+  ;; DWARF 3.
+  (lo-user #x80)
+  (hi-user #xff))
+
+;; Figure 36: Names and codes for macro information.
+;;
+(define-enumeration macro-code->name macro-name->code
+  (define 1)
+  (undef 2)
+  (start-file 3)
+  (end-file 4)
+  (vendor-ext 255))
+
+;; Figure 37: Call frame information.
+;;
+(define-enumeration call-frame-address-code->name call-frame-address-code->name
+  (advance-loc #x40)
+  (offset #x80)
+  (restore #xc0)
+  (nop #x00)
+  (set-loc #x01)
+  (advance-loc1 #x02)
+  (advance-loc2 #x03)
+  (advance-loc4 #x04)
+  (offset-extended #x05)
+  (restore-extended #x06)
+  (undefined #x07)
+  (same-value #x08)
+  (register #x09)
+  (remember-state #x0a)
+  (restore-state #x0b)
+  (def-cfa #x0c)
+  (def-cfa-register #x0d)
+  (def-cfa-offset #x0e)
+  ;; DWARF 3.
+  (def-cfa-expression #x0f)
+  (expression #x10)
+  (offset-extended-sf #x11)
+  (def-cfa-sf #x12)
+  (def-cfa-offset-sf #x13)
+  (val-offset #x14)
+  (val-offset-sf #x15)
+  (val-expression #x16)
+  (GNU-window-save #x2d)
+  (GNU-args-size #x2e)
+  (GNU-negative-offset-extended #x2f)
+
+  (extended 0)
+  (low-user #x1c)
+  (high-user #x3f))
+
+;(define CIE-ID #xffffffff)
+;(define CIE-VERSION 1)
+;(define ADDR-none 0)
+
+
+;;;
+;;; A general configuration object.
+;;;
+
+(define-record-type <dwarf-meta>
+  (make-dwarf-meta addr-size
+                   vaddr memsz
+                   path lib-path
+                   info-start info-end
+                   abbrevs-start abbrevs-end
+                   strtab-start strtab-end
+                   loc-start loc-end
+                   line-start line-end
+                   pubnames-start pubnames-end
+                   aranges-start aranges-end)
+  dwarf-meta?
+  (addr-size meta-addr-size)
+  (vaddr meta-vaddr)
+  (memsz meta-memsz)
+  (path meta-path)
+  (lib-path meta-lib-path)
+  (info-start meta-info-start)
+  (info-end meta-info-end)
+  (abbrevs-start meta-abbrevs-start)
+  (abbrevs-end meta-abbrevs-end)
+  (strtab-start meta-strtab-start)
+  (strtab-end meta-strtab-end)
+  (loc-start meta-loc-start)
+  (loc-end meta-loc-end)
+  (line-start meta-line-start)
+  (line-end meta-line-end)
+  (pubnames-start meta-pubnames-start)
+  (pubnames-end meta-pubnames-end)
+  (aranges-start meta-aranges-start)
+  (aranges-end meta-aranges-end))
+
+;; A context represents a namespace.  The root context is the
+;; compilation unit.  DIE nodes of type class-type, structure-type, or
+;; namespace may form child contexts.
+;;
+(define-record-type <dwarf-context>
+  (make-dwarf-context bv offset-size endianness meta
+                      abbrevs
+                      parent die start end children)
+  dwarf-context?
+  (bv ctx-bv)
+  (offset-size ctx-offset-size)
+  (endianness ctx-endianness)
+  (meta ctx-meta)
+  (abbrevs ctx-abbrevs)
+  (parent ctx-parent)
+  (die ctx-die)
+  (start ctx-start)
+  (end ctx-end)
+  (children ctx-children set-children!))
+
+
+(set-record-type-printer! <dwarf-context>
+                          (lambda (x port)
+                            (format port "<dwarf-context ~a>"
+                                    (number->string (object-address x) 16))))
+
+(define-inlinable (ctx-addr-size ctx)
+  (meta-addr-size (ctx-meta ctx)))
+
+;;;
+;;; Procedures for reading DWARF data.
+;;;
+
+(define (read-u8 ctx pos)
+  (values (bytevector-u8-ref (ctx-bv ctx) pos)
+          (1+ pos)))
+(define (read-s8 ctx pos)
+  (values (bytevector-s8-ref (ctx-bv ctx) pos)
+          (1+ pos)))
+(define (skip-8 ctx pos)
+  (+ pos 1))
+
+(define (read-u16 ctx pos)
+  (values (bytevector-u16-ref (ctx-bv ctx) pos (ctx-endianness ctx))
+          (+ pos 2)))
+(define (skip-16 ctx pos)
+  (+ pos 2))
+
+(define (read-u32 ctx pos)
+  (values (bytevector-u32-ref (ctx-bv ctx) pos (ctx-endianness ctx))
+          (+ pos 4)))
+(define (skip-32 ctx pos)
+  (+ pos 4))
+
+(define (read-u64 ctx pos)
+  (values (bytevector-u64-ref (ctx-bv ctx) pos (ctx-endianness ctx))
+          (+ pos 8)))
+(define (skip-64 ctx pos)
+  (+ pos 8))
+
+(define (read-addr ctx pos)
+  (case (ctx-addr-size ctx)
+    ((4) (read-u32 ctx pos))
+    ((8) (read-u64 ctx pos))
+    (else (error "unsupported word size" ctx))))
+(define (skip-addr ctx pos)
+  (+ pos (ctx-addr-size ctx)))
+
+(define (%read-uleb128 bv pos)
+  ;; Unrolled by one.
+  (let ((b (bytevector-u8-ref bv pos)))
+    (if (zero? (logand b #x80))
+        (values b
+                (1+ pos))
+        (let lp ((n (logxor #x80 b)) (pos (1+ pos)) (shift 7))
+          (let ((b (bytevector-u8-ref bv pos)))
+            (if (zero? (logand b #x80))
+                (values (logior (ash b shift) n)
+                        (1+ pos))
+                (lp (logior (ash (logxor #x80 b) shift) n)
+                    (1+ pos)
+                    (+ shift 7))))))))
+
+(define (%read-sleb128 bv pos)
+  (let lp ((n 0) (pos pos) (shift 0))
+    (let ((b (bytevector-u8-ref bv pos)))
+      (if (zero? (logand b #x80))
+          (values (logior (ash b shift) n
+                          (if (zero? (logand #x40 b))
+                              0
+                              (- (ash 1 (+ shift 7)))))
+                  (1+ pos))
+          (lp (logior (ash (logxor #x80 b) shift) n)
+              (1+ pos)
+              (+ shift 7))))))
+
+(define (read-uleb128 ctx pos)
+  (%read-uleb128 (ctx-bv ctx) pos))
+
+(define (read-sleb128 ctx pos)
+  (%read-sleb128 (ctx-bv ctx) pos))
+
+(define (skip-leb128 ctx pos)
+  (let ((bv (ctx-bv ctx)))
+    (let lp ((pos pos))
+      (let ((b (bytevector-u8-ref bv pos)))
+        (if (zero? (logand b #x80))
+            (1+ pos)
+            (lp (1+ pos)))))))
+
+(define (read-initial-length ctx pos)
+  (let ((len (bytevector-u32-ref (ctx-bv ctx) pos (ctx-endianness ctx))))
+    (cond
+     ((= len #xffffffff)
+      (values (bytevector-u32-ref (ctx-bv ctx) (+ pos 4) (ctx-endianness ctx))
+              (+ pos 12)
+              8))
+     ((>= len #xfffffff0)
+      (error "bad initial length value" len))
+     (else
+      (values len
+              (+ pos 4)
+              4)))))
+
+(define* (read-offset ctx pos #:optional (offset-size (ctx-offset-size ctx)))
+  (case offset-size
+    ((4) (values (read-u32 ctx pos) (+ pos 4)))
+    ((8) (values (read-u64 ctx pos) (+ pos 8)))
+    (else (error "bad word size" offset-size))))
+
+(define* (skip-offset ctx pos #:optional (offset-size (ctx-offset-size ctx)))
+  (+ pos offset-size))
+
+(define (read-block ctx pos len)
+  (let ((bv (make-bytevector len)))
+    (bytevector-copy! (ctx-bv ctx) pos bv 0 len)
+    (values bv
+            (+ pos len))))
+
+(define (read-string ctx pos)
+  (let ((bv (ctx-bv ctx)))
+    (let lp ((end pos))
+      (if (zero? (bytevector-u8-ref bv end))
+          (let ((out (make-bytevector (- end pos))))
+            (bytevector-copy! bv pos out 0 (- end pos))
+            (values (utf8->string out)
+                    (1+ end)))
+          (lp (1+ end))))))
+
+(define (skip-string ctx pos)
+  (let ((bv (ctx-bv ctx)))
+    (let lp ((end pos))
+      (if (zero? (bytevector-u8-ref bv end))
+          (1+ end)
+          (lp (1+ end))))))
+
+(define (read-string-seq ctx pos)
+  (let ((bv (ctx-bv ctx)))
+    (let lp ((pos pos) (strs '()))
+      (if (zero? (bytevector-u8-ref bv pos))
+          (values (list->vector (reverse strs)) (1+ pos))
+          (let-values (((str pos) (read-string ctx pos)))
+            (lp pos (cons str strs)))))))
+
+(define-record-type <abbrev>
+  (make-abbrev code tag has-children? attrs forms)
+  abbrev?
+  (code abbrev-code)
+  (tag abbrev-tag)
+  (has-children? abbrev-has-children?)
+  (attrs abbrev-attrs)
+  (forms abbrev-forms))
+
+(define (read-abbrev ctx pos)
+  (let*-values (((code pos) (read-uleb128 ctx pos))
+                ((tag pos) (read-uleb128 ctx pos))
+                ((children pos) (read-u8 ctx pos)))
+    (let lp ((attrs '()) (forms '()) (pos pos))
+      (let*-values (((attr pos) (read-uleb128 ctx pos))
+                    ((form pos) (read-uleb128 ctx pos)))
+        (if (and (zero? attr) (zero? form))
+            (values (make-abbrev code
+                                 (tag-code->name tag)
+                                 (eq? (children-code->name children) 'yes)
+                                 (reverse attrs)
+                                 (reverse forms))
+                    pos)
+            (lp (cons (attribute-code->name attr) attrs)
+                (cons (form-code->name form) forms)
+                pos))))))
+
+(define* (read-abbrevs ctx pos
+                       #:optional (start (meta-abbrevs-start
+                                          (ctx-meta ctx)))
+                       (end (meta-abbrevs-end
+                             (ctx-meta ctx))))
+  (let lp ((abbrevs '()) (pos (+ start pos)) (max-code -1))
+    (if (zero? (read-u8 ctx pos))
+        (if (< pos end)
+            (let ((av (make-vector (1+ max-code) #f)))
+              (for-each (lambda (a)
+                          (vector-set! av (abbrev-code a) a))
+                        abbrevs)
+              av)
+            (error "Unexpected length" abbrevs pos start end))
+        (let-values (((abbrev pos) (read-abbrev ctx pos)))
+          (lp (cons abbrev abbrevs)
+              pos
+              (max (abbrev-code abbrev) max-code))))))
+
+(define (ctx-compile-unit-start ctx)
+  (if (ctx-die ctx)
+      (ctx-compile-unit-start (ctx-parent ctx))
+      (ctx-start ctx)))
+
+;; Values.
+;;
+(define *readers* (make-hash-table))
+(define *scanners* (make-hash-table))
+(define-syntax define-value-reader
+  (syntax-rules ()
+    ((_ form reader scanner)
+     (begin
+       (hashq-set! *readers* 'form reader)
+       (hashq-set! *scanners* 'form scanner)))))
+
+(define-value-reader addr read-addr skip-addr)
+
+(define-value-reader block
+  (lambda (ctx pos)
+    (let-values (((len pos) (read-uleb128 ctx pos)))
+      (read-block ctx pos len)))
+  (lambda (ctx pos)
+    (let-values (((len pos) (read-uleb128 ctx pos)))
+      (+ pos len))))
+
+(define-value-reader block1
+  (lambda (ctx pos)
+    (let-values (((len pos) (read-u8 ctx pos)))
+      (read-block ctx pos len)))
+  (lambda (ctx pos)
+    (+ pos 1 (bytevector-u8-ref (ctx-bv ctx) pos))))
+
+(define-value-reader block2
+  (lambda (ctx pos)
+    (let-values (((len pos) (read-u16 ctx pos)))
+      (read-block ctx pos len)))
+  (lambda (ctx pos)
+    (+ pos 2 (bytevector-u16-ref (ctx-bv ctx) pos (ctx-endianness ctx)))))
+
+(define-value-reader block4
+  (lambda (ctx pos)
+    (let-values (((len pos) (read-u32 ctx pos)))
+      (read-block ctx pos len)))
+  (lambda (ctx pos)
+    (+ pos 4 (bytevector-u32-ref (ctx-bv ctx) pos (ctx-endianness ctx)))))
+
+(define-value-reader data1 read-u8 skip-8)
+(define-value-reader data2 read-u16 skip-16)
+(define-value-reader data4 read-u32 skip-32)
+(define-value-reader data8 read-u64 skip-64)
+(define-value-reader udata read-uleb128 skip-leb128)
+(define-value-reader sdata read-sleb128 skip-leb128)
+
+(define-value-reader flag
+  (lambda (ctx pos)
+    (values (not (zero? (bytevector-u8-ref (ctx-bv ctx) pos)))
+            (1+ pos)))
+  skip-8)
+
+(define-value-reader string
+  read-string
+  skip-string)
+
+(define-value-reader strp
+  (lambda (ctx pos)
+    (let ((strtab (meta-strtab-start (ctx-meta ctx))))
+      (unless strtab
+        (error "expected a string table" ctx))
+      (let-values (((offset pos) (read-offset ctx pos)))
+        (values (read-string ctx (+ strtab offset))
+                pos))))
+  skip-32)
+
+(define-value-reader ref-addr
+  (lambda (ctx pos)
+    (let-values (((addr pos) (read-addr ctx pos)))
+      (values (+ addr (meta-info-start (ctx-meta ctx)))
+              pos)))
+  skip-addr)
+
+(define-value-reader ref1
+  (lambda (ctx pos)
+    (let-values (((addr pos) (read-u8 ctx pos)))
+      (values (+ addr (ctx-compile-unit-start ctx))
+              pos)))
+  skip-8)
+
+(define-value-reader ref2
+  (lambda (ctx pos)
+    (let-values (((addr pos) (read-u16 ctx pos)))
+      (values (+ addr (ctx-compile-unit-start ctx))
+              pos)))
+  skip-16)
+
+(define-value-reader ref4
+  (lambda (ctx pos)
+    (let-values (((addr pos) (read-u32 ctx pos)))
+      (values (+ addr (ctx-compile-unit-start ctx))
+              pos)))
+  skip-32)
+
+(define-value-reader ref8
+  (lambda (ctx pos)
+    (let-values (((addr pos) (read-u64 ctx pos)))
+      (values (+ addr (ctx-compile-unit-start ctx))
+              pos)))
+  skip-64)
+
+(define-value-reader ref
+  (lambda (udata ctx pos)
+    (let-values (((addr pos) (read-uleb128 ctx pos)))
+      (values (+ addr (ctx-compile-unit-start ctx))
+              pos)))
+  skip-leb128)
+
+(define-value-reader indirect
+  (lambda (ctx pos)
+    (let*-values (((form pos) (read-uleb128 ctx pos))
+                  ((val pos) (read-value ctx pos (form-code->name form))))
+      (values (cons form val)
+              pos)))
+  (lambda (ctx pos)
+    (let*-values (((form pos) (read-uleb128 ctx pos)))
+      (skip-value ctx pos (form-code->name form)))))
+
+(define-value-reader sec-offset
+  read-offset
+  skip-offset)
+
+(define-value-reader exprloc
+  (lambda (ctx pos)
+    (let-values (((len pos) (read-uleb128 ctx pos)))
+      (read-block ctx pos len)))
+  (lambda (ctx pos)
+    (let-values (((len pos) (read-uleb128 ctx pos)))
+      (+ pos len))))
+
+(define-value-reader flag-present
+  (lambda (ctx pos)
+    (values #t pos))
+  (lambda (ctx pos)
+    pos))
+
+(define-value-reader ref-sig8
+  read-u64
+  skip-64)
+
+(define (read-value ctx pos form)
+  ((or (hashq-ref *readers* form)
+       (error "unrecognized form" form))
+   ctx pos))
+
+(define (skip-value ctx pos form)
+  ((or (hashq-ref *scanners* form)
+       (error "unrecognized form" form))
+   ctx pos))
+
+;; Parsers for particular attributes.
+;;
+(define (parse-location-list ctx offset)
+  (let lp ((pos (+ (meta-loc-start (ctx-meta ctx)) offset))
+           (out '()))
+    (let*-values (((start pos) (read-addr ctx pos))
+                  ((end pos) (read-addr ctx pos)))
+      (if (and (zero? start) (zero? end))
+          (reverse out)
+          (let*-values (((len pos) (read-u16 ctx pos))
+                        ((block pos) (read-block ctx pos len)))
+            (lp pos
+                (cons (list start end (parse-location ctx block)) out)))))))
+
+(define (parse-location ctx loc)
+  (cond
+   ((bytevector? loc)
+    (let ((len (bytevector-length loc))
+          (addr-size (ctx-addr-size ctx))
+          (endianness (ctx-endianness ctx)))
+      (define (u8-ref pos) (bytevector-u8-ref loc pos))
+      (define (s8-ref pos) (bytevector-s8-ref loc pos))
+      (define (u16-ref pos) (bytevector-u16-ref loc pos endianness))
+      (define (s16-ref pos) (bytevector-s16-ref loc pos endianness))
+      (define (u32-ref pos) (bytevector-u32-ref loc pos endianness))
+      (define (s32-ref pos) (bytevector-s32-ref loc pos endianness))
+      (define (u64-ref pos) (bytevector-u64-ref loc pos endianness))
+      (define (s64-ref pos) (bytevector-s64-ref loc pos endianness))
+      (let lp ((pos 0) (out '()))
+        (if (= pos len)
+            (reverse out)
+            (let ((op (location-op->name (u8-ref pos))))
+              (case op
+                ((addr)
+                 (case addr-size
+                   ((4) (lp (+ pos 5) (cons (list op (u32-ref (1+ pos))) out)))
+                   ((8) (lp (+ pos 9) (cons (list op (u64-ref (1+ pos))) out)))
+                   (else (error "what!"))))
+                ((call-ref)
+                 (case addr-size
+                   ((4) (lp (+ pos 5)
+                            (cons (list op (+ (meta-info-start (ctx-meta ctx))
+                                              (u32-ref (1+ pos))))
+                                  out)))
+                   ((8) (lp (+ pos 9)
+                            (cons (list op (+ (meta-info-start (ctx-meta ctx))
+                                              (u64-ref (1+ pos))))
+                                  out)))
+                   (else (error "what!"))))
+                ((const1u pick deref-size xderef-size)
+                 (lp (+ pos 2) (cons (list op (u8-ref (1+ pos))) out)))
+                ((const1s)
+                 (lp (+ pos 2) (cons (list op (s8-ref (1+ pos))) out)))
+                ((const2u)
+                 (lp (+ pos 3) (cons (list op (u16-ref (1+ pos))) out)))
+                ((call2)
+                 (lp (+ pos 3) (cons (list op (+ (ctx-compile-unit-start ctx)
+                                                 (u16-ref (1+ pos))))
+                                     out)))
+                ((const2s skip bra)
+                 (lp (+ pos 3) (cons (list op (s16-ref (1+ pos))) out)))
+                ((const4u)
+                 (lp (+ pos 5) (cons (list op (u32-ref (1+ pos))) out)))
+                ((call4)
+                 (lp (+ pos 5) (cons (list op (+ (ctx-compile-unit-start ctx)
+                                                 (u32-ref (1+ pos))))
+                                     out)))
+                ((const4s)
+                 (lp (+ pos 5) (cons (list op (s32-ref (1+ pos))) out)))
+                ((const8u)
+                 (lp (+ pos 9) (cons (list op (u64-ref (1+ pos))) out)))
+                ((const8s)
+                 (lp (+ pos 9) (cons (list op (s64-ref (1+ pos))) out)))
+                ((plus-uconst regx piece)
+                 (let-values (((val pos) (%read-uleb128 loc (1+ pos))))
+                   (lp pos (cons (list op val) out))))
+                ((bit-piece)
+                 (let*-values (((bit-len pos) (%read-uleb128 loc (1+ pos)))
+                               ((bit-offset pos) (%read-uleb128 loc pos)))
+                   (lp pos (cons (list op bit-len bit-offset) out))))
+                ((breg0 breg1 breg2 breg3 breg4 breg5 breg6 breg7 breg8 breg9
+                        breg10 breg11 breg12 breg13 breg14 breg15 breg16 breg17
+                        breg18 breg19 breg20 breg21 breg22 breg23 breg24 breg25
+                        breg26 breg27 breg28 breg29 breg30 breg31 fbreg)
+                 (let-values (((val pos) (%read-sleb128 loc (1+ pos))))
+                   (lp pos (cons (list op val) out))))
+                (else
+                 (if (number? op)
+                     ;; We failed to parse this opcode; we have to give
+                     ;; up
+                     loc
+                     (lp (1+ pos) (cons (list op) out))))))))))
+   (else
+    (parse-location-list ctx loc))))
+
+;; Statement programs.
+(define-record-type <lregs>
+  (make-lregs pos pc file line column)
+  lregs?
+  (pos lregs-pos set-lregs-pos!)
+  (pc lregs-pc set-lregs-pc!)
+  (file lregs-file set-lregs-file!)
+  (line lregs-line set-lregs-line!)
+  (column lregs-column set-lregs-column!))
+
+(define-record-type <line-prog>
+  (%make-line-prog ctx version
+                   header-offset program-offset end
+                   min-insn-length max-insn-ops default-stmt?
+                   line-base line-range opcode-base
+                   standard-opcode-lengths
+                   include-directories file-names
+                   regs)
+  line-prog?
+  (ctx line-prog-ctx)
+  (version line-prog-version)
+  (header-offset line-prog-header-offset)
+  (program-offset line-prog-program-offset)
+  (end line-prog-end)
+  (min-insn-length line-prog-min-insn-length)
+  (max-insn-ops line-prog-max-insn-ops)
+  (default-stmt? line-prog-default-stmt?)
+  (line-base line-prog-line-base)
+  (line-range line-prog-line-range)
+  (opcode-base line-prog-opcode-base)
+  (standard-opcode-lengths line-prog-standard-opcode-lengths)
+  (include-directories line-prog-include-directories)
+  (file-names line-prog-file-names)
+  (regs line-prog-regs))
+
+(define (make-line-prog ctx header-pos end)
+  (unless (> end (+ header-pos 12))
+    (error "statement program header too short"))
+  (let-values (((len pos offset-size) (read-initial-length ctx header-pos)))
+    (unless (<= (+ pos len) end)
+      (error (".debug_line too short")))
+    (let*-values (((version pos) (read-u16 ctx pos))
+                  ((prologue-len prologue-pos) (read-u32 ctx pos))
+                  ((min-insn-len pos) (read-u8 ctx prologue-pos))
+                  ;; The maximum_operations_per_instruction field is
+                  ;; only present in DWARFv4.
+                  ((max-insn-ops pos) (if (< version 4)
+                                          (values 1 pos)
+                                          (read-u8 ctx pos)))
+                  ((default-stmt pos) (read-u8 ctx pos))
+                  ((line-base pos) (read-s8 ctx pos))
+                  ((line-range pos) (read-u8 ctx pos))
+                  ((opcode-base pos) (read-u8 ctx pos))
+                  ((opcode-lens pos) (read-block ctx pos (1- opcode-base)))
+                  ((include-directories pos) (read-string-seq ctx pos))
+                  ((file-names pos)
+                   (let lp ((pos pos) (strs '()))
+                     (if (zero? (bytevector-u8-ref (ctx-bv ctx) pos))
+                         (values (reverse strs) (1+ pos))
+                         (let-values (((str pos) (read-string ctx pos)))
+                           (let* ((pos (skip-leb128 ctx pos)) ; skip dir
+                                  (pos (skip-leb128 ctx pos)) ; skip mtime
+                                  (pos (skip-leb128 ctx pos))) ; skip len
+                             (lp pos (cons str strs))))))))
+      (unless (= pos (+ prologue-pos prologue-len))
+        (error "unexpected prologue length"))
+      (%make-line-prog ctx version header-pos pos end
+                       min-insn-len max-insn-ops (not (zero? default-stmt))
+                       line-base line-range opcode-base opcode-lens
+                       include-directories file-names
+                       ;; Initial state: file=1, line=1, col=0
+                       (make-lregs pos 0 1 1 0)))))
+
+(define (line-prog-next-row prog pos pc file line col)
+  (let ((ctx (line-prog-ctx prog))
+        (end (line-prog-end prog))
+        (min-insn-len (line-prog-min-insn-length prog))
+        (line-base (line-prog-line-base prog))
+        (line-range (line-prog-line-range prog))
+        (opcode-base (line-prog-opcode-base prog))
+        (opcode-lens (line-prog-standard-opcode-lengths prog)))
+
+    (let lp ((pos pos) (pc pc) (file file) (line line) (col col))
+      (cond
+       ((>= pos end)
+        (values #f #f #f #f #f))
+       (else
+        (let-values (((op pos) (read-u8 ctx pos)))
+          (cond
+           ((zero? op)                  ; extended opcodes
+            (let*-values (((len pos*) (read-uleb128 ctx pos))
+                          ((op pos) (read-u8 ctx pos*)))
+              (case op
+                ((1)                    ; end-sequence
+                 (values pos pc file line col))
+                ((2)                    ; set-address
+                 (let-values (((addr pos) (read-addr ctx pos)))
+                   (unless (>= addr pc)
+                     (error "pc not advancing"))
+                   (lp pos addr file line col)))
+                ((3)                    ; define-file
+                 (warn "define-file unimplemented")
+                 (lp (+ pos* len) pc file line col))
+                ((4)                    ; set-discriminator; ignore.
+                 (lp (+ pos* len) pc file line col))
+                (else
+                 (warn "unknown extended op" op)
+                 (lp (+ pos* len) pc file line col)))))
+
+           ((< op opcode-base)          ; standard opcodes
+            (case op
+              ((1)                      ; copy
+               (values pos pc file line col))
+              ((2)                      ; advance-pc
+               (let-values (((advance pos) (read-uleb128 ctx pos)))
+                 (lp pos (+ pc (* advance min-insn-len)) file line col)))
+              ((3)                      ; advance-line
+               (let-values (((diff pos) (read-sleb128 ctx pos)))
+                 (lp pos pc file (+ line diff) col)))
+              ((4)                      ; set-file
+               (let-values (((file pos) (read-uleb128 ctx pos)))
+                 (lp pos pc file line col)))
+              ((5)                      ; set-column
+               (let-values (((col pos) (read-uleb128 ctx pos)))
+                 (lp pos pc file line col)))
+              ((6)                      ; negate-line
+               (lp pos pc file line col))
+              ((7)                      ; set-basic-block
+               (lp pos pc file line col))
+              ((8)                      ; const-add-pc
+               (let ((advance (floor/ (- 255 opcode-base) line-range)))
+                 (lp pos (+ pc (* advance min-insn-len)) file line col)))
+              ((9)                      ; fixed-advance-pc
+               (let-values (((advance pos) (read-u16 ctx pos)))
+                 (lp pos (+ pc (* advance min-insn-len)) file line col)))
+              (else
+               ;; fixme: read args and move on
+               (error "unknown extended op" op))))
+           (else                        ; special opcodes
+            (let-values (((quo rem) (floor/ (- op opcode-base) line-range)))
+              (values pos (+ pc (* quo min-insn-len))
+                      file (+ line (+ rem line-base)) col))))))))))
+
+(define (line-prog-advance prog)
+  (let ((regs (line-prog-regs prog)))
+    (call-with-values (lambda ()
+                        (line-prog-next-row prog
+                                            (lregs-pos regs)
+                                            (lregs-pc regs)
+                                            (lregs-file regs)
+                                            (lregs-line regs)
+                                            (lregs-column regs)))
+      (lambda (pos pc file line col)
+        (cond
+         ((not pos)
+          (values #f #f #f #f))
+         (else
+          (set-lregs-pos! regs pos)
+          (set-lregs-pc! regs pc)
+          (set-lregs-file! regs file)
+          (set-lregs-line! regs line)
+          (set-lregs-column! regs col)
+          ;; Return DWARF-numbered lines and columns (1-based).
+          (values pc
+                  (if (zero? file)
+                      #f
+                      (list-ref (line-prog-file-names prog) (1- file)))
+                  (if (zero? line) #f line)
+                  (if (zero? col) #f col))))))))
+
+(define (line-prog-scan-to-pc prog target-pc)
+  (let ((regs (line-prog-regs prog)))
+    (define (finish pos pc file line col)
+      (set-lregs-pos! regs pos)
+      (set-lregs-pc! regs pc)
+      (set-lregs-file! regs file)
+      (set-lregs-line! regs line)
+      (set-lregs-column! regs col)
+      ;; Return DWARF-numbered lines and columns (1-based).
+      (values pc
+              (if (zero? file)
+                  #f
+                  (list-ref (line-prog-file-names prog) (1- file)))
+              (if (zero? line) #f line)
+              (if (zero? col) #f col)))
+    (define (scan pos pc file line col)
+      (call-with-values (lambda ()
+                          (line-prog-next-row prog pos pc file line col))
+        (lambda (pos* pc* file* line* col*)
+          (cond
+           ((not pos*)
+            (values #f #f #f #f))
+           ((< pc* target-pc)
+            (scan pos* pc* file* line* col*))
+           ((= pc* target-pc)
+            (finish pos* pc* file* line* col*))
+           ((zero? pc)
+            ;; We scanned from the beginning didn't find any info.
+            (values #f #f #f #f))
+           (else
+            (finish pos pc file line col))))))
+    (let ((pos (lregs-pos regs))
+          (pc (lregs-pc regs))
+          (file (lregs-file regs))
+          (line (lregs-line regs))
+          (col (lregs-column regs)))
+      (if (< pc target-pc)
+          (scan pos pc file line col)
+          (scan (line-prog-program-offset prog) 0 1 1 0)))))
+
+(define-syntax-rule (define-attribute-parsers parse (name parser) ...)
+  (define parse
+    (let ((parsers (make-hash-table)))
+      (hashq-set! parsers 'name parser)
+      ...
+      (lambda (ctx attr val)
+        (cond
+         ((hashq-ref parsers attr) => (lambda (p) (p ctx val)))
+         (else val))))))
+
+(define-attribute-parsers parse-attribute
+  (encoding (lambda (ctx val) (type-encoding->name val)))
+  (accessibility (lambda (ctx val) (access-code->name val)))
+  (visibility (lambda (ctx val) (visibility-code->name val)))
+  (virtuality (lambda (ctx val) (virtuality-code->name val)))
+  (language (lambda (ctx val) (language-code->name val)))
+  (location parse-location)
+  (data-member-location parse-location)
+  (case-sensitive (lambda (ctx val) (case-sensitivity-code->name val)))
+  (calling-convention (lambda (ctx val) (calling-convention-code->name val)))
+  (inline (lambda (ctx val) (inline-code->name val)))
+  (ordering (lambda (ctx val) (ordering-code->name val)))
+  (discr-value (lambda (ctx val) (discriminant-code->name val))))
+
+;; "Debugging Information Entries": DIEs.
+;;
+(define-record-type <die>
+  (make-die ctx offset abbrev vals)
+  die?
+  (ctx die-ctx)
+  (offset die-offset)
+  (abbrev die-abbrev)
+  (vals %die-vals %set-die-vals!))
+
+(define (die-tag die)
+  (abbrev-tag (die-abbrev die)))
+
+(define (die-attrs die)
+  (abbrev-attrs (die-abbrev die)))
+
+(define (die-forms die)
+  (abbrev-forms (die-abbrev die)))
+
+(define (die-vals die)
+  (let ((vals (%die-vals die)))
+    (or vals
+        (begin
+          (%set-die-vals! die (read-values (die-ctx die) (skip-leb128 (die-ctx die) (die-offset die)) (die-abbrev die)))
+          (die-vals die)))))
+
+(define* (die-next-offset die #:optional offset-vals)
+  (let ((ctx (die-ctx die)))
+    (skip-values ctx (or offset-vals (skip-leb128 ctx (die-offset die)))
+                 (die-abbrev die))))
+
+(define* (die-ref die attr #:optional default)
+  (cond
+   ((list-index (die-attrs die) attr)
+    => (lambda (n) (list-ref (die-vals die) n)))
+   (else default)))
+
+(define (die-specification die)
+  (and=> (die-ref die 'specification)
+         (lambda (offset) (find-die-by-offset (die-ctx die) offset))))
+
+(define (die-name die)
+  (or (die-ref die 'name)
+      (and=> (die-specification die) die-name)))
+
+(define (die-qname die)
+  (cond
+   ((eq? (die-tag die) 'compile-unit) "")
+   ((die-ref die 'name)
+    => (lambda (name)
+         (if (eq? (die-tag (ctx-die (die-ctx die))) 'compile-unit)
+             name ; short cut
+             (string-append (die-qname (ctx-die (die-ctx die))) "::" name))))
+   ((die-specification die)
+    => die-qname)
+   (else #f)))
+
+(define (die-line-prog die)
+  (let ((stmt-list (die-ref die 'stmt-list)))
+    (and stmt-list
+         (let* ((ctx (die-ctx die))
+                (meta (ctx-meta ctx)))
+           (make-line-prog ctx
+                           (+ (meta-line-start meta) stmt-list)
+                           (meta-line-end meta))))))
+
+(define (read-values ctx offset abbrev)
+  (let lp ((attrs (abbrev-attrs abbrev))
+           (forms (abbrev-forms abbrev))
+           (vals '())
+           (pos offset))
+    (if (null? forms)
+        (values (reverse vals) pos)
+        (let-values (((val pos) (read-value ctx pos (car forms))))
+          (lp (cdr attrs) (cdr forms)
+              (cons (parse-attribute ctx (car attrs) val) vals)
+              pos)))))
+
+(define (skip-values ctx offset abbrev)
+  (let lp ((forms (abbrev-forms abbrev))
+           (pos offset))
+    (if (null? forms)
+        pos
+        (lp (cdr forms) (skip-value ctx pos (car forms))))))
+
+(define (read-die-abbrev ctx offset)
+  (let*-values (((code pos) (read-uleb128 ctx offset)))
+    (values (cond ((zero? code) #f)
+                  ((vector-ref (ctx-abbrevs ctx) code))
+                  (else (error "unknown abbrev" ctx code)))
+            pos)))
+
+(define (read-die ctx offset)
+  (let*-values (((abbrev pos) (read-die-abbrev ctx offset)))
+    (if abbrev
+        (values (make-die ctx offset abbrev #f)
+                (skip-values ctx pos abbrev))
+        (values #f pos))))
+
+(define* (die-sibling ctx abbrev offset #:optional offset-vals offset-end)
+  (cond
+   ((not (abbrev-has-children? abbrev))
+    (or offset-end
+        (skip-values ctx
+                     (or offset-vals (skip-leb128 ctx offset))
+                     abbrev)))
+   ((memq 'sibling (abbrev-attrs abbrev))
+    (let lp ((offset (or offset-vals (skip-leb128 ctx offset)))
+             (attrs (abbrev-attrs abbrev))
+             (forms (abbrev-forms abbrev)))
+      (if (eq? (car attrs) 'sibling)
+          (read-value ctx offset (car forms))
+          (lp (skip-value ctx offset (car forms))
+              (cdr attrs) (cdr forms)))))
+   (else
+    (call-with-values
+        (lambda ()
+          (fold-die-list ctx
+                         (or offset-end
+                             (skip-values ctx
+                                          (or offset-vals
+                                              (skip-leb128 ctx offset))
+                                          abbrev))
+                         (lambda (ctx offset abbrev) #t)
+                         error
+                         #f))
+      (lambda (seed pos)
+        pos)))))
+
+(define (find-die-context ctx offset)
+  (define (not-found)
+    (error "failed to find DIE by context" offset))
+  (define (in-context? ctx)
+    (and (<= (ctx-start ctx) offset)
+         (< offset (ctx-end ctx))))
+  (define (find-root ctx)
+    (if (in-context? ctx)
+        ctx
+        (find-root (or (ctx-parent ctx) (not-found)))))
+  (define (find-leaf ctx)
+    (let lp ((kids (ctx-children ctx)))
+      (if (null? kids)
+          ctx
+          (if (in-context? (car kids))
+              (find-leaf (car kids))
+              (lp (cdr kids))))))
+  (find-leaf (find-root ctx)))
+
+(define (find-die-by-offset ctx offset)
+  (or (read-die (find-die-context ctx offset) offset)
+      (error "Failed to read DIE at offset" offset)))
+
+(define-syntax-rule (let/ec k e e* ...)
+  (let ((tag (make-prompt-tag)))
+    (call-with-prompt
+     tag
+     (lambda ()
+       (let ((k (lambda args (apply abort-to-prompt tag args))))
+         e e* ...))
+     (lambda (_ res) res))))
+
+(define* (find-die roots pred #:key
+                   (skip? (lambda (ctx offset abbrev) #f))
+                   (recurse? (lambda (die) #t)))
+  (let/ec k
+    (define (visit-die die)
+      (cond
+       ((pred die)
+        (k die))
+       ((recurse? die)
+        (fold-die-children die (lambda (die seed) (visit-die die)) #f
+                           #:skip? skip?))
+       (else #f)))
+    (for-each visit-die roots)
+    #f))
+
+(define (die-low-pc die)
+  (die-ref die 'low-pc))
+(define (die-high-pc die)
+  (let ((val (die-ref die 'high-pc)))
+    (and val
+         (let ((idx (list-index (die-attrs die) 'high-pc)))
+           (case (list-ref (die-forms die) idx)
+             ((addr) val)
+             (else (+ val (die-low-pc die))))))))
+
+(define (find-die-by-pc roots pc)
+  ;; The result will be a subprogram.
+  (define (skip? ctx offset abbrev)
+    (case (abbrev-tag abbrev)
+      ((subprogram compile-unit) #f)
+      (else #t)))
+  (define (recurse? die)
+    (case (die-tag die)
+      ((compile-unit)
+       (not (or (and=> (die-low-pc die)
+                       (lambda (low) (< pc low)))
+                (and=> (die-high-pc die)
+                       (lambda (high) (<= high pc))))))
+      (else #f)))
+  (find-die roots
+            (lambda (die)
+              (and (eq? (die-tag die) 'subprogram)
+                   (equal? (die-low-pc die) pc)))
+            #:skip? skip? #:recurse? recurse?))
+
+(define (fold-die-list ctx offset skip? proc seed)
+  (let ((ctx (find-die-context ctx offset)))
+    (let lp ((offset offset) (seed seed))
+      (let-values (((abbrev pos) (read-die-abbrev ctx offset)))
+        (cond
+         ((not abbrev) (values seed pos))
+         ((skip? ctx offset abbrev)
+          (lp (die-sibling ctx abbrev offset pos) seed))
+         (else
+          (let-values (((vals pos) (read-values ctx pos abbrev)))
+            (let* ((die (make-die ctx offset abbrev vals))
+                   (seed (proc die seed)))
+              (lp (die-sibling ctx abbrev offset #f pos) seed)))))))))
+
+(define* (fold-die-children die proc seed #:key
+                            (skip? (lambda (ctx offset abbrev) #f)))
+  (if (abbrev-has-children? (die-abbrev die))
+      (values (fold-die-list (die-ctx die) (die-next-offset die)
+                             skip? proc seed))
+      seed))
+
+(define (die-children die)
+  (reverse (fold-die-children die cons '())))
+
+(define (add-to-parent! ctx)
+  (let ((parent (ctx-parent ctx)))
+    (set-children! parent
+                   (append (ctx-children parent) (list ctx)))
+    ctx))
+
+(define (make-compilation-unit-context ctx offset-size addr-size
+                                       abbrevs start len)
+  (unless (= addr-size (ctx-addr-size ctx))
+    (error "ELF word size not equal to compilation unit addrsize"))
+  (add-to-parent!
+   (make-dwarf-context (ctx-bv ctx)
+                       offset-size (ctx-endianness ctx)
+                       (ctx-meta ctx)
+                       abbrevs ctx #f start (+ start 4 len) '())))
+
+(define (make-child-context die)
+  (let ((ctx (die-ctx die)))
+    (add-to-parent!
+     (make-dwarf-context (ctx-bv ctx)
+                         (ctx-offset-size ctx) (ctx-endianness ctx)
+                         (ctx-meta ctx)
+                         (ctx-abbrevs ctx)
+                         ctx die
+                         (die-next-offset die)
+                         (die-sibling ctx (die-abbrev die) (die-offset die))
+                         '()))))
+
+(define (ctx-language ctx)
+  (or (and=> (ctx-die ctx) (lambda (x) (die-ref x 'language)))
+      (and=> (ctx-parent ctx) ctx-language)))
+
+(define (populate-context-tree! die)
+  (define (skip? ctx offset abbrev)
+    (case (abbrev-tag abbrev)
+      ((class-type structure-type namespace) #f)
+      (else #t)))
+  (case (die-tag die)
+    ((compile-unit class-type structure-type namespace)
+     (let ((ctx (make-child-context die)))
+       ;; For C++, descend into classes and structures so that we
+       ;; populate the context tree.  Note that for compile-unit, we
+       ;; still need to call `make-child-context' for its side effect of
+       ;; adding to the context tree.
+       (when (eq? (ctx-language ctx) 'c++)
+         (fold-die-children die
+                            (lambda (die seed) (populate-context-tree! die))
+                            #f
+                            #:skip? skip?))))))
+
+(define (read-compilation-unit ctx pos)
+  (let*-values (((start) pos)
+                ((len pos offset-size) (read-initial-length ctx pos))
+                ((version pos) (read-u16 ctx pos))
+                ((abbrevs-offset pos) (read-offset ctx pos offset-size))
+                ((av) (read-abbrevs ctx abbrevs-offset))
+                ((addrsize pos) (read-u8 ctx pos))
+                ((ctx) (make-compilation-unit-context ctx offset-size addrsize
+                                                      av start len))
+                ((die pos) (read-die ctx pos)))
+    (populate-context-tree! die)
+    (values die (ctx-end ctx))))
+
+(define (read-die-roots ctx)
+  (let lp ((dies '()) (pos (meta-info-start (ctx-meta ctx))))
+    (if (< pos (meta-info-end (ctx-meta ctx)))
+        (let-values (((die pos) (read-compilation-unit ctx pos)))
+          (if die
+              (lp (cons die dies) pos)
+              (reverse dies)))
+        (reverse dies))))
+
+(define (fold-pubname-set ctx pos folder seed)
+  (let*-values (((len pos offset-size) (read-initial-length ctx pos))
+                ((version pos) (read-u16 ctx pos))
+                ((info-offset pos) (read-offset ctx pos offset-size))
+                ((info-offset) (+ info-offset
+                                  (meta-info-start (ctx-meta ctx))))
+                ((info-len pos) (read-offset ctx pos offset-size)))
+    (let lp ((pos pos) (seed seed))
+      (let-values (((offset pos) (read-offset ctx pos offset-size)))
+        (if (zero? offset)
+            (values seed pos)
+            (let-values (((str pos) (read-string ctx pos)))
+              (lp pos
+                  (folder str (+ offset info-offset) seed))))))))
+
+(define (fold-pubnames ctx folder seed)
+  (let ((end (meta-pubnames-end (ctx-meta ctx))))
+    (if end
+        (let lp ((pos (meta-pubnames-start (ctx-meta ctx))) (seed seed))
+          (if (< pos end)
+              (let-values (((seed pos) (fold-pubname-set ctx pos folder seed)))
+                (lp pos seed))
+              seed))
+        seed)))
+
+(define (align address alignment)
+  (+ address
+     (modulo (- alignment (modulo address alignment)) alignment)))
+
+(define (fold-arange-set ctx pos folder seed)
+  (let*-values (((len pos offset-size) (read-initial-length ctx pos))
+                ((version pos) (read-u16 ctx pos))
+                ((info-offset pos) (read-offset ctx pos offset-size))
+                ((info-offset) (+ info-offset
+                                  (meta-info-start (ctx-meta ctx))))
+                ((addr-size pos) (read-u8 ctx pos))
+                ((segment-size pos) (read-u8 ctx pos)))
+    (let lp ((pos (align pos (* 2 (ctx-addr-size ctx)))) (seed seed))
+      (let*-values (((addr pos) (read-addr ctx pos))
+                    ((len pos) (read-addr ctx pos)))
+        (if (and (zero? addr) (zero? len))
+            (values seed pos)
+            (lp pos
+                (folder info-offset addr len seed)))))))
+
+(define (fold-aranges ctx folder seed)
+  (let ((end (meta-aranges-end (ctx-meta ctx))))
+    (if end
+        (let lp ((pos (meta-aranges-start (ctx-meta ctx))) (seed seed))
+          (if (< pos end)
+              (let-values (((seed pos) (fold-arange-set ctx pos folder seed)))
+                (lp pos seed))
+              seed))
+        seed)))
+
+(define* (elf->dwarf-context elf #:key (vaddr 0) (memsz 0)
+                             (path #f) (lib-path path))
+  (let* ((sections (elf-sections-by-name elf))
+         (info (assoc-ref sections ".debug_info"))
+         (abbrevs (assoc-ref sections ".debug_abbrev"))
+         (strtab (assoc-ref sections ".debug_str"))
+         (loc (assoc-ref sections ".debug_loc"))
+         (line (assoc-ref sections ".debug_line"))
+         (pubnames (assoc-ref sections ".debug_pubnames"))
+         (aranges (assoc-ref sections ".debug_aranges")))
+    (make-dwarf-context (elf-bytes elf)
+                        4 ;; initial offset size
+                        (elf-byte-order elf)
+                        (make-dwarf-meta
+                         (elf-word-size elf)
+                         vaddr memsz
+                         path lib-path
+                         (elf-section-offset info)
+                         (+ (elf-section-offset info)
+                            (elf-section-size info))
+                         (elf-section-offset abbrevs)
+                         (+ (elf-section-offset abbrevs)
+                            (elf-section-size abbrevs))
+                         (elf-section-offset strtab)
+                         (+ (elf-section-offset strtab)
+                            (elf-section-size strtab))
+                         (elf-section-offset loc)
+                         (+ (elf-section-offset loc)
+                            (elf-section-size loc))
+                         (and line
+                              (elf-section-offset line))
+                         (and line
+                              (+ (elf-section-offset line)
+                                 (elf-section-size line)))
+                         (and pubnames
+                              (elf-section-offset pubnames))
+                         (and pubnames
+                              (+ (elf-section-offset pubnames)
+                                 (elf-section-size pubnames)))
+                         (and aranges
+                              (elf-section-offset aranges))
+                         (and aranges
+                              (+ (elf-section-offset aranges)
+                                 (elf-section-size aranges))))
+                        #() #f #f
+                        (elf-section-offset info)
+                        (+ (elf-section-offset info)
+                           (elf-section-size info))
+                        '())))
+
+(define (die->tree die)
+  (cons* (die-tag die)
+         (cons 'offset (die-offset die))
+         (reverse! (fold-die-children
+                    die
+                    (lambda (die seed)
+                      (cons (die->tree die) seed))
+                    (fold acons '() (die-attrs die) (die-vals die))))))