mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
better RTL debugging
* libguile/frames.c (scm_frame_source, scm_frame_instruction_pointer): Fix to work with RTL programs. * module/system/vm/debug.scm (find-debug-context): Allow for the possibility of there being no ELF image. (find-program-debug-info, find-program-arities) (program-minimum-arity, find-program-docstring) (find-program-properties, find-source-for-addr) (find-program-die, find-program-sources): Don't bail if we couldn't get the debug context. * module/system/vm/frame.scm (frame-next-source) (frame-call-representation): Allow RTL programs. * module/system/vm/program.scm (program-arguments-alist): Placeholder implementation for RTL programs. (program-arguments-alists): Don't bail if we couldn't get the arities.
This commit is contained in:
Andy Wingo
parent
fea115c33f
commit
f8fb13ef8c
4 changed files with 70 additions and 50 deletions
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public License
|
||||
|
|
@ -110,7 +110,7 @@ SCM_DEFINE (scm_frame_source, "frame-source", 1, 0, 0,
|
|||
|
||||
proc = scm_frame_procedure (frame);
|
||||
|
||||
if (SCM_PROGRAM_P (proc))
|
||||
if (SCM_PROGRAM_P (proc) || SCM_RTL_PROGRAM_P (proc))
|
||||
return scm_program_source (scm_frame_procedure (frame),
|
||||
scm_frame_instruction_pointer (frame),
|
||||
SCM_UNDEFINED);
|
||||
|
|
@ -260,6 +260,10 @@ SCM_DEFINE (scm_frame_instruction_pointer, "frame-instruction-pointer", 1, 0, 0,
|
|||
SCM_VALIDATE_VM_FRAME (1, frame);
|
||||
program = scm_frame_procedure (frame);
|
||||
|
||||
if (SCM_RTL_PROGRAM_P (program))
|
||||
return scm_from_ptrdiff_t (SCM_VM_FRAME_IP (frame) -
|
||||
(scm_t_uint8 *) SCM_RTL_PROGRAM_CODE (program));
|
||||
|
||||
if (!SCM_PROGRAM_P (program))
|
||||
return SCM_INUM0;
|
||||
|
||||
|
|
|
|||
|
|
@ -155,8 +155,11 @@ offset from the beginning of the ELF image in 32-bit units."
|
|||
|
||||
(define (find-debug-context addr)
|
||||
"Find and return the debugging context corresponding to the ELF image
|
||||
containing the address @var{addr}. @var{addr} is an integer."
|
||||
(debug-context-from-image (find-mapped-elf-image addr)))
|
||||
containing the address @var{addr}. @var{addr} is an integer. If no ELF
|
||||
image is found, return @code{#f}. It's possible for an RTL program not
|
||||
to have an ELF image if the program was defined in as a stub in C."
|
||||
(and=> (find-mapped-elf-image addr)
|
||||
debug-context-from-image))
|
||||
|
||||
(define (find-elf-symbol elf text-offset)
|
||||
"Search the symbol table of @var{elf} for the ELF symbol containing
|
||||
|
|
@ -189,10 +192,11 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}."
|
|||
"Find and return the @code{<program-debug-info>} containing
|
||||
@var{addr}, or @code{#f}."
|
||||
(cond
|
||||
((find-elf-symbol (debug-context-elf context)
|
||||
(- addr
|
||||
(debug-context-base context)
|
||||
(debug-context-text-base context)))
|
||||
((and context
|
||||
(find-elf-symbol (debug-context-elf context)
|
||||
(- addr
|
||||
(debug-context-base context)
|
||||
(debug-context-text-base context))))
|
||||
=> (lambda (sym)
|
||||
(make-program-debug-info context
|
||||
(and=> (elf-symbol-name sym)
|
||||
|
|
@ -343,7 +347,8 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}."
|
|||
(define* (find-program-arities addr #:optional
|
||||
(context (find-debug-context addr)))
|
||||
(and=>
|
||||
(elf-section-by-name (debug-context-elf context) ".guile.arities")
|
||||
(and context
|
||||
(elf-section-by-name (debug-context-elf context) ".guile.arities"))
|
||||
(lambda (sec)
|
||||
(let* ((base (elf-section-offset sec))
|
||||
(first (find-first-arity context base addr)))
|
||||
|
|
@ -357,7 +362,8 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}."
|
|||
(define* (program-minimum-arity addr #:optional
|
||||
(context (find-debug-context addr)))
|
||||
(and=>
|
||||
(elf-section-by-name (debug-context-elf context) ".guile.arities")
|
||||
(and context
|
||||
(elf-section-by-name (debug-context-elf context) ".guile.arities"))
|
||||
(lambda (sec)
|
||||
(let* ((base (elf-section-offset sec))
|
||||
(first (find-first-arity context base addr)))
|
||||
|
|
@ -370,7 +376,8 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}."
|
|||
(define* (find-program-docstring addr #:optional
|
||||
(context (find-debug-context addr)))
|
||||
(and=>
|
||||
(elf-section-by-name (debug-context-elf context) ".guile.docstrs")
|
||||
(and context
|
||||
(elf-section-by-name (debug-context-elf context) ".guile.docstrs"))
|
||||
(lambda (sec)
|
||||
;; struct docstr {
|
||||
;; uint32_t pc;
|
||||
|
|
@ -409,7 +416,8 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}."
|
|||
(maybe-acons 'documentation docstring props))))
|
||||
(add-name-and-docstring
|
||||
(cond
|
||||
((elf-section-by-name (debug-context-elf context) ".guile.procprops")
|
||||
((and context
|
||||
(elf-section-by-name (debug-context-elf context) ".guile.procprops"))
|
||||
=> (lambda (sec)
|
||||
;; struct procprop {
|
||||
;; uint32_t pc;
|
||||
|
|
@ -466,12 +474,13 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}."
|
|||
(define* (find-source-for-addr addr #:optional
|
||||
(context (find-debug-context addr))
|
||||
#:key exact?)
|
||||
(let* ((base (debug-context-base context))
|
||||
(pc (- addr base)))
|
||||
(and=>
|
||||
(false-if-exception
|
||||
(elf->dwarf-context (debug-context-elf context)))
|
||||
(lambda (dwarf-ctx)
|
||||
(and=>
|
||||
(and context
|
||||
(false-if-exception
|
||||
(elf->dwarf-context (debug-context-elf context))))
|
||||
(lambda (dwarf-ctx)
|
||||
(let* ((base (debug-context-base context))
|
||||
(pc (- addr base)))
|
||||
(or-map (lambda (die)
|
||||
(and=>
|
||||
(die-line-prog die)
|
||||
|
|
@ -486,34 +495,36 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}."
|
|||
|
||||
(define* (find-program-die addr #:optional
|
||||
(context (find-debug-context addr)))
|
||||
(and=> (false-if-exception
|
||||
(elf->dwarf-context (debug-context-elf context)))
|
||||
(and=> (and context
|
||||
(false-if-exception
|
||||
(elf->dwarf-context (debug-context-elf context))))
|
||||
(lambda (dwarf-ctx)
|
||||
(find-die-by-pc (read-die-roots dwarf-ctx)
|
||||
(- addr (debug-context-base context))))))
|
||||
|
||||
(define* (find-program-sources addr #:optional
|
||||
(context (find-debug-context addr)))
|
||||
(and=>
|
||||
(find-program-die addr context)
|
||||
(lambda (die)
|
||||
(let* ((base (debug-context-base context))
|
||||
(low-pc (die-ref die 'low-pc))
|
||||
(high-pc (die-high-pc die))
|
||||
(prog (let line-prog ((die die))
|
||||
(and die
|
||||
(or (die-line-prog die)
|
||||
(line-prog (ctx-die (die-ctx die))))))))
|
||||
(cond
|
||||
((and low-pc high-pc prog)
|
||||
(let lp ((sources '()))
|
||||
(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)
|
||||
sources))
|
||||
(reverse sources))))))
|
||||
(else '()))))))
|
||||
(cond
|
||||
((find-program-die addr context)
|
||||
=> (lambda (die)
|
||||
(let* ((base (debug-context-base context))
|
||||
(low-pc (die-ref die 'low-pc))
|
||||
(high-pc (die-high-pc die))
|
||||
(prog (let line-prog ((die die))
|
||||
(and die
|
||||
(or (die-line-prog die)
|
||||
(line-prog (ctx-die (die-ctx die))))))))
|
||||
(cond
|
||||
((and low-pc high-pc prog)
|
||||
(let lp ((sources '()))
|
||||
(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)
|
||||
sources))
|
||||
(reverse sources))))))
|
||||
(else '())))))
|
||||
(else '())))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Guile VM frame functions
|
||||
|
||||
;;; Copyright (C) 2001, 2005, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
|
||||
;;; Copyright (C) 2001, 2005, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This library is free software; you can redistribute it and/or
|
||||
;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
|
@ -73,7 +73,7 @@
|
|||
|
||||
(define (frame-next-source frame)
|
||||
(let ((proc (frame-procedure frame)))
|
||||
(if (program? proc)
|
||||
(if (or (program? proc) (rtl-program? proc))
|
||||
(program-source proc
|
||||
(frame-instruction-pointer frame)
|
||||
(program-sources-pre-retire proc))
|
||||
|
|
@ -100,7 +100,7 @@
|
|||
(cons
|
||||
(or (false-if-exception (procedure-name p)) p)
|
||||
(cond
|
||||
((and (program? p)
|
||||
((and (or (program? p) (rtl-program? p))
|
||||
(program-arguments-alist p (frame-instruction-pointer frame)))
|
||||
;; case 1
|
||||
=> (lambda (arguments)
|
||||
|
|
|
|||
|
|
@ -291,9 +291,14 @@
|
|||
;; the name "program-arguments" is taken by features.c...
|
||||
(define* (program-arguments-alist prog #:optional ip)
|
||||
"Returns the signature of the given procedure in the form of an association list."
|
||||
(let ((arity (program-arity prog ip)))
|
||||
(and arity
|
||||
(arity->arguments-alist prog arity))))
|
||||
(if (rtl-program? prog)
|
||||
(or-map (lambda (arity)
|
||||
(and #t
|
||||
(arity-arguments-alist arity)))
|
||||
(or (find-program-arities (rtl-program-code prog)) '()))
|
||||
(let ((arity (program-arity prog ip)))
|
||||
(and arity
|
||||
(arity->arguments-alist prog arity)))))
|
||||
|
||||
(define* (program-lambda-list prog #:optional ip)
|
||||
"Returns the signature of the given procedure in the form of an argument list."
|
||||
|
|
@ -322,7 +327,7 @@
|
|||
(cond
|
||||
((rtl-program? prog)
|
||||
(map arity-arguments-alist
|
||||
(find-program-arities (rtl-program-code prog))))
|
||||
(or (find-program-arities (rtl-program-code prog)) '())))
|
||||
((program? prog)
|
||||
(map (lambda (arity) (arity->arguments-alist prog arity))
|
||||
(or (program-arities prog) '())))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue