mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 20:00:19 +02:00
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.
This commit is contained in:
parent
7c54029740
commit
b43e81dc60
2 changed files with 7 additions and 5 deletions
|
@ -506,9 +506,11 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}."
|
||||||
(line-prog (ctx-die (die-ctx die))))))))
|
(line-prog (ctx-die (die-ctx die))))))))
|
||||||
(cond
|
(cond
|
||||||
((and low-pc high-pc prog)
|
((and low-pc high-pc prog)
|
||||||
(line-prog-scan-to-pc prog (1- low-pc))
|
|
||||||
(let lp ((sources '()))
|
(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)
|
(lambda (pc file line col)
|
||||||
(if (and pc (< pc high-pc))
|
(if (and pc (< pc high-pc))
|
||||||
(lp (cons (make-source/dwarf (+ pc base) file line col)
|
(lp (cons (make-source/dwarf (+ pc base) file line col)
|
||||||
|
|
|
@ -123,7 +123,7 @@
|
||||||
(cond
|
(cond
|
||||||
((rtl-program? proc)
|
((rtl-program? proc)
|
||||||
(map (lambda (source)
|
(map (lambda (source)
|
||||||
(cons* (source-post-pc source)
|
(cons* (- (source-post-pc source) (rtl-program-code proc))
|
||||||
(source-file source)
|
(source-file source)
|
||||||
(source-line source)
|
(source-line source)
|
||||||
(source-column source)))
|
(source-column source)))
|
||||||
|
@ -154,7 +154,7 @@
|
||||||
(cond
|
(cond
|
||||||
((rtl-program? proc)
|
((rtl-program? proc)
|
||||||
(map (lambda (source)
|
(map (lambda (source)
|
||||||
(cons* (source-pre-pc source)
|
(cons* (- (source-pre-pc source) (rtl-program-code proc))
|
||||||
(source-file source)
|
(source-file source)
|
||||||
(source-line source)
|
(source-line source)
|
||||||
(source-column source)))
|
(source-column source)))
|
||||||
|
@ -331,7 +331,7 @@
|
||||||
(define (write-program prog port)
|
(define (write-program prog port)
|
||||||
(define (program-identity-string)
|
(define (program-identity-string)
|
||||||
(or (procedure-name prog)
|
(or (procedure-name prog)
|
||||||
(and=> (and (program? prog) (program-source prog 0))
|
(and=> (program-source prog 0)
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
(format #f "~a at ~a:~a:~a"
|
(format #f "~a at ~a:~a:~a"
|
||||||
(number->string (object-address prog) 16)
|
(number->string (object-address prog) 16)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue