From b43e81dc6085f250a3520b69b6445dbc0896850c Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Thu, 3 Oct 2013 22:48:17 +0200
Subject: [PATCH] anonymous RTl functions print with source info

* module/system/vm/debug.scm (find-program-sources): If there is no
  source location before the low-pc of the procedure we're grovelling
  for, we were skipping the source loc info.  Fix that.

* module/system/vm/program.scm (write-program): Get source info for
  anonymous RTL functions.
  (program-sources, program-sources-pre-retire): Provide program
  counters relative to the beginning of the procedure.
---
 module/system/vm/debug.scm   | 6 ++++--
 module/system/vm/program.scm | 6 +++---
 2 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
index 0531188e4..6142f3d1b 100644
--- a/module/system/vm/debug.scm
+++ b/module/system/vm/debug.scm
@@ -506,9 +506,11 @@ section of the ELF image.  Returns an ELF symbol, or @code{#f}."
                              (line-prog (ctx-die (die-ctx die))))))))
        (cond
         ((and low-pc high-pc prog)
-         (line-prog-scan-to-pc prog (1- low-pc))
          (let lp ((sources '()))
-           (call-with-values (lambda () (line-prog-advance prog))
+           (call-with-values (lambda ()
+                               (if (null? sources)
+                                   (line-prog-scan-to-pc prog low-pc)
+                                   (line-prog-advance prog)))
              (lambda (pc file line col)
                (if (and pc (< pc high-pc))
                    (lp (cons (make-source/dwarf (+ pc base) file line col)
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index 5dd4f0a08..fb87d970a 100644
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -123,7 +123,7 @@
   (cond
    ((rtl-program? proc)
     (map (lambda (source)
-           (cons* (source-post-pc source)
+           (cons* (- (source-post-pc source) (rtl-program-code proc))
                   (source-file source)
                   (source-line source)
                   (source-column source)))
@@ -154,7 +154,7 @@
   (cond
    ((rtl-program? proc)
     (map (lambda (source)
-           (cons* (source-pre-pc source)
+           (cons* (- (source-pre-pc source) (rtl-program-code proc))
                   (source-file source)
                   (source-line source)
                   (source-column source)))
@@ -331,7 +331,7 @@
 (define (write-program prog port)
   (define (program-identity-string)
     (or (procedure-name prog)
-        (and=> (and (program? prog) (program-source prog 0))
+        (and=> (program-source prog 0)
                (lambda (s)
                  (format #f "~a at ~a:~a:~a"
                          (number->string (object-address prog) 16)