[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-221-gf8fb13e
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-221-gf8fb13e |
|
Date: |
Fri, 04 Oct 2013 17:56:47 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=f8fb13ef8c3c491983a90bfcfac1257e93a8186d
The branch, master has been updated
via f8fb13ef8c3c491983a90bfcfac1257e93a8186d (commit)
from fea115c33f35b95c89ebb9142faaa06a43d83036 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit f8fb13ef8c3c491983a90bfcfac1257e93a8186d
Author: Andy Wingo <address@hidden>
Date: Fri Oct 4 19:55:12 2013 +0200
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.
-----------------------------------------------------------------------
Summary of changes:
libguile/frames.c | 8 +++-
module/system/vm/debug.scm | 93 +++++++++++++++++++++++------------------
module/system/vm/frame.scm | 6 +-
module/system/vm/program.scm | 13 ++++--
4 files changed, 70 insertions(+), 50 deletions(-)
diff --git a/libguile/frames.c b/libguile/frames.c
index 8ce5aa0..448a0cb 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -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;
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
index 6142f3d..f7adb20 100644
--- a/module/system/vm/debug.scm
+++ b/module/system/vm/debug.scm
@@ -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 '())))
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index b8077db..ea2faaf 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -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)
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index fb87d97..86db411 100644
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -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) '())))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-221-gf8fb13e,
Andy Wingo <=