[PATCH] debugger: Support generics. WIP.

[Jan Nieuwenhuizen]

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 address@hidden:~/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 <address@hidden>
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