Hi!
I'm looking at the debugger again and have found a number of things*)
that I would like to fix. My first attempt is for GOOPS support: I want
,break-at-source FILE LINE to also support breaking if LINE happens to
be in a define-method.
The attached patch tries to add this support, but there's still a
problem: the trap doesn't work. I'll keep on looking but some help
would be much appreciated; e.g., I'm doubt if using (oop goops) in
(system ...) modules is OK.
Before this patch:
scheme@(break-at-source)> ,break-at-source "break-at-source.scm" 21
While executing meta-command:
No procedures found at ~a:~a. "break-at-source.scm" 21
with only (system xref) patched:
scheme@(break-at-source)> ,break-at-source "break-at-source.scm" 21
;;; WARNING (no instructions found for break-at-source.scm : 21)
Trap 0: Breakpoint at break-at-source.scm:21.
Using this patch there is no warning anymore and the trap is reported to
be set... Here's what happens
--8<---------------cut here---------------start------------->8---
$ meta/build-env guile-tools compile -o break-at-source.go break-at-source.scm
wrote `break-at-source.go'
13:28:59 janneke@dundal:~/src/guile/build [env]
$ meta/build-env guile -L . -C .
GNU Guile 2.2.4.14-8b75b
Copyright (C) 1995-2017 Free Software Foundation, Inc.
Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.
Enter `,help' for help.
scheme@(guile-user)> ,m (break-at-source)
scheme@(break-at-source)> ,break-at-source "break-at-source.scm" 21
Trap 0: Breakpoint at break-at-source.scm:21.
scheme@(break-at-source)> (main)
main1
main2
test1
test2
test3
main3
scheme@(break-at-source)> ,break-at-source "break-at-source.scm" 16
Trap 1: Breakpoint at break-at-source.scm:16.
scheme@(break-at-source)> (main)
main1
main2
Trap 1: Breakpoint at break-at-source.scm:16
Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue.
scheme@(break-at-source) [1]>
--8<---------------cut here---------------end--------------->8---
Where should I look next, what could i do next?
janneke
*) Other debugger things I would like to look at
- also find source locations in files that were compiled using
(compile-file ... 'absolute)
- have ,frame and ,backtrace use GNU style error messages (I worked
on this long ago but only have an ugly solution)
- have procedure parameters show up in ,locals
- get Emacs GUD integration working ootb
>From 13516b7fbee7baee20d6255619b57e3934800465 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <jann...@gnu.org>
Date: Wed, 12 Sep 2018 11:58:43 +0200
Subject: [PATCH] debugger: Support generics. WIP.
Before this patch:
scheme@(break-at-source)> ,break-at-source "break-at-source.scm" 21
While executing meta-command:
No procedures found at ~a:~a. "break-at-source.scm" 21
with only (system xref) patched:
scheme@(break-at-source)> ,break-at-source "break-at-source.scm" 21
;;; WARNING (no instructions found for break-at-source.scm : 21)
Trap 0: Breakpoint at break-at-source.scm:21.
but the breakpoint does not work, execution continues right through trap.
With also (system vm traps) patched:
scheme@(break-at-source)> ,break-at-source "break-at-source.scm" 21
Trap 0: Breakpoint at break-at-source.scm:21.
Yay!...but alas, the breakpoint still does not work, execution continues
right through trap.
* module/system/vm/traps.scm (generic-sources-by-line): New procedure.
(program-sources-by-line): Use it to support generics.
* module/system/xref.scm (generic-callee-rev-vars): New procedure.
(procedure-callee-rev-vars): Use it to support generics.
(generic-sources): New procedure.
(procedure-sources): Use it to support generics.
* examples/break-at-source.scm: New file.
---
examples/break-at-source.scm | 22 ++++++++++++++++++++++
module/system/vm/traps.scm | 9 +++++++++
module/system/xref.scm | 14 ++++++++++++++
3 files changed, 45 insertions(+)
create mode 100644 examples/break-at-source.scm
diff --git a/examples/break-at-source.scm b/examples/break-at-source.scm
new file mode 100644
index 000000000..88d905bd1
--- /dev/null
+++ b/examples/break-at-source.scm
@@ -0,0 +1,22 @@
+#!
+cp ../examples/break-at-source.scm .
+meta/build-env guile-tools compile -o break-at-source.go break-at-source.scm
+meta/build-env guile -L examples -C examples
+,m (break-at-source)
+,break-at-source "break-at-source.scm" 21
+(main)
+!#
+
+(define-module (break-at-source)
+ #:use-module (oop goops))
+
+(define (main . args)
+ (display "main1\n")
+ (display "main2\n")
+ (test args) ; 16
+ (display "main3\n"))
+
+(define-method (test (o <top>))
+ (display "test1\n")
+ (display "test2\n") ; 20
+ (display "test3\n"))
diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm
index 8bee10355..3b75d3826 100644
--- a/module/system/vm/traps.scm
+++ b/module/system/vm/traps.scm
@@ -62,6 +62,9 @@
#:use-module (system vm program)
#:use-module (system xref)
#:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (oop goops)
#:export (trap-at-procedure-call
trap-in-procedure
trap-instructions-in-procedure
@@ -335,8 +338,14 @@
out)
(sort! alist (lambda (x y) (< (car x) (car y))))
alist)))))
+ ((is-a? proc <generic>) (generic-sources-by-line proc file))
(else '())))
+(define (generic-sources-by-line generic file)
+ (let* ((methods (generic-function-methods generic))
+ (procedures (map (cut slot-ref <> 'procedure) methods)))
+ (append-map (cut program-sources-by-line <> file) procedures)))
+
(define (source->ip-range proc file line)
(or (or-map (lambda (line-and-ranges)
(cond
diff --git a/module/system/xref.scm b/module/system/xref.scm
index 2b943fdd9..8663af5be 100644
--- a/module/system/xref.scm
+++ b/module/system/xref.scm
@@ -22,6 +22,8 @@
#:use-module (system vm disassembler)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (oop goops)
#:export (*xref-ignored-modules*
procedure-callees
procedure-callers
@@ -80,8 +82,14 @@
(define (procedure-callee-rev-vars proc)
(cond
((program? proc) (program-callee-rev-vars proc))
+ ((is-a? proc <generic>) (generic-callee-rev-vars proc))
(else '())))
+(define (generic-callee-rev-vars generic)
+ (let* ((methods (generic-function-methods generic))
+ (procedures (map (cut slot-ref <> 'procedure) methods)))
+ (append-map procedure-callee-rev-vars procedures)))
+
(define (procedure-callees prog)
"Evaluates to a list of the given program callees."
(let lp ((in (procedure-callee-rev-vars prog)) (out '()))
@@ -202,8 +210,14 @@ pair of the form (module-name . variable-name), "
(define (procedure-sources proc)
(cond
((program? proc) (program-sources proc))
+ ((is-a? proc <generic>) (generic-sources proc))
(else '())))
+(define (generic-sources generic)
+ (let* ((methods (generic-function-methods generic))
+ (procedures (map (cut slot-ref <> 'procedure) methods)))
+ (append-map procedure-sources procedures)))
+
;; file -> line -> (proc ...)
(define *closure-sources-db* #f)
;; file -> line -> (proc ...)
--
2.18.0
