* [PATCH] debugger: Initial GUD integration support v2
@ 2014-09-02 21:20 Jan Nieuwenhuizen
0 siblings, 0 replies; only message in thread
From: Jan Nieuwenhuizen @ 2014-09-02 21:20 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 227 bytes --]
Hi,
Find attached the second version of the frienlier debug prompt patch
that enables Emacs GUD integration.
* Thinko in examples/gud-break.scm
* Do not print absolute file name for relative file names
Greetings, Jan
[-- Attachment #2: 0001-Initial-GUD-integration-support.patch --]
[-- Type: text/x-diff, Size: 8727 bytes --]
From b9631f41f2621f787fca5b36eb3ee20cc601a3e8 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Tue, 5 Aug 2014 12:34:09 +0200
Subject: [PATCH] Initial GUD integration support.
* examples/gud-break.scm: New example; showing initial GUD
integration.
* module/system/repl/debug.scm (debug-prompt): New procedure;
gdb-like debug prompt. Experimental!
* module/system/repl/error-handling.scm (call-with-error-handling):
* module/system/repl/command.scm (step, step-instruction, next)
(next-instruction): Use it.
---
examples/gud-break.scm | 56 +++++++++++++++++++++++++++++++++++
module/system/repl/command.scm | 8 ++---
module/system/repl/debug.scm | 54 +++++++++++++++++++++++++++++++++
module/system/repl/error-handling.scm | 3 +-
4 files changed, 116 insertions(+), 5 deletions(-)
create mode 100644 examples/gud-break.scm
diff --git a/examples/gud-break.scm b/examples/gud-break.scm
new file mode 100644
index 0000000..dbef6f3
--- /dev/null
+++ b/examples/gud-break.scm
@@ -0,0 +1,56 @@
+#! /bin/sh
+# -*-scheme-*-
+exec guile -e main -s "$0" "$@"
+!#
+;; Experimental GUD support for Guile REPL
+;; Find a gud.el that you want to patch, e.g.
+;; zcat /usr/share/emacs/24.3/lisp/progmodes/gud.el.gz > ~/.emacs.d/gud.el
+;; or
+;; M-x find-function gdb RET
+;; C-x C-w ~/.emacs.d/gud.el RET
+;; Patch it
+;; patch ~/.emacs.d/gud.el < 0001-Initial-Guile-REPL-guiler-debugger-support-for-GUD.patch
+;; M-x load-library ~/.emacs.d/gud.el RET
+;; M-x guiler RET
+;; ,m gud-break
+;; ,br main
+;; (main)
+;; ,n
+;; ,n # no easy RET shortcut yet
+;;
+;; And see |> marker in Emac's left margin track the program's execution.
+
+(read-set! keywords 'prefix)
+
+(define (main . args)
+ (eval '(main (command-line)) (resolve-module '(gud-break))))
+
+(define-module (gud-break)
+ :export (main))
+
+(define (stderr fmt . args)
+ (apply format (cons (current-error-port) (cons* fmt args)))
+ (force-output (current-error-port)))
+
+(define (main . args)
+ (stderr "~a:hello world\n" (current-source-location))
+ (let
+ ((a #f)
+ (b #f))
+ (set! a 1)
+ (stderr "set: a=~a\n" a)
+ (set! b 2)
+ (stderr "set: b=~a\n" b)
+ (let
+ ((c #f)
+ (d #f))
+ (set! c 3)
+ (stderr "set: c=~a\n" c)
+ (set! d 4)
+ (stderr "set: d=~a\n" d))
+ (stderr "~a:leaving...\n" (current-source-location)))
+ (stderr "~a:goodbye world\n" (current-source-location)))
+
+
+
+
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 62bc297..3999c5e 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -740,7 +740,7 @@ Resume execution, breaking when the current frame finishes."
Step until control reaches a different source location.
Step until control reaches a different source location."
- (let ((msg (format #f "Step into ~a" cur)))
+ (let ((msg (debug-prompt cur)))
(add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
#:into? #t #:instruction? #f)
(throw 'quit)))
@@ -750,7 +750,7 @@ Step until control reaches a different source location."
Step until control reaches a different instruction.
Step until control reaches a different VM instruction."
- (let ((msg (format #f "Step into ~a" cur)))
+ (let ((msg (debug-prompt cur)))
(add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
#:into? #t #:instruction? #t)
(throw 'quit)))
@@ -760,7 +760,7 @@ Step until control reaches a different VM instruction."
Step until control reaches a different source location in the current frame.
Step until control reaches a different source location in the current frame."
- (let ((msg (format #f "Step into ~a" cur)))
+ (let ((msg (debug-prompt cur)))
(add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
#:into? #f #:instruction? #f)
(throw 'quit)))
@@ -770,7 +770,7 @@ Step until control reaches a different source location in the current frame."
Step until control reaches a different instruction in the current frame.
Step until control reaches a different VM instruction in the current frame."
- (let ((msg (format #f "Step into ~a" cur)))
+ (let ((msg (debug-prompt cur)))
(add-ephemeral-stepping-trap! cur (repl-next-resumer msg)
#:into? #f #:instruction? #t)
(throw 'quit)))
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 300145d..b27c900 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -24,6 +24,7 @@
#:use-module (system base language)
#:use-module (system vm vm)
#:use-module (system vm frame)
+ #:use-module (ice-9 and-let-star)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 pretty-print)
#:use-module (ice-9 format)
@@ -32,6 +33,7 @@
#:export (<debug>
make-debug debug?
debug-frames debug-index debug-error-message
+ debug-prompt
terminal-width
print-registers print-locals print-frame print-frames frame->module
stack->vector narrow-stack->vector
@@ -160,6 +162,58 @@
(lp (+ i inc)
(frame-source frame)))))))
+(define *source-alist* '())
+(define (source-add file-name source)
+ (set! *source-alist* (assoc-set! *source-alist* file-name source))
+ source)
+
+(define (read-source-file file-name)
+ (or (assoc-ref *source-alist* file-name)
+ (and-let* ((source (with-input-from-file file-name read-string))
+ (lines (string-split source #\newline)))
+ (source-add file-name lines))))
+
+(define (fs-find-file file-name)
+ (if (file-exists? file-name)
+ file-name
+ (%search-load-path file-name)))
+
+(define (relative-file-name file-name)
+ (let ((cwd (getcwd)))
+ (if (and file-name (string-prefix? cwd file-name))
+ (string-drop file-name (1+ (string-length cwd)))
+ file-name)))
+
+(define (source-code file-name line-number)
+ (or (and-let* ((file-name file-name)
+ (line-number line-number)
+ (lines (read-source-file file-name)))
+ (list-ref lines line-number))
+ ""))
+
+(define *last-source* #f)
+(define* (debug-prompt frame #:optional (last-source *last-source*) (message ""))
+ "A gdb,pydb-like debug prompt."
+ (define (source:pretty-file source)
+ (if source
+ (or (source:file source) "current input")
+ "unknown file"))
+ (let* ((source (frame-source frame))
+ (file (source:pretty-file source))
+ (file-name (relative-file-name (fs-find-file file)))
+ (line (and=> source source:line))
+ (col (and=> source source:column))
+ (code (source-code file-name line))
+ (line-column (format #f "~a~a" (if line (1+ line) "")
+ (if col (format #f ":~a" col) ""))))
+ (set! *last-source* source)
+ (string-append
+ (if (and file (not (equal? file (source:pretty-file last-source))))
+ (format #f "~&~a:~a:~a~&" file-name line-column message) ;;GNU standard!
+ ;;(format #f "~&In ~a:~a~&" file-name message) ;;or awkward Guile convention?
+ "")
+ (format #f "~&~10a~a" line-column code))))
+
;; Ideally here we would have something much more syntactic, in that a set! to a
;; local var that is not settable would raise an error, and export etc forms
;; would modify the module in question: but alack, this is what we have now.
diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm
index 94a9f2a..1777854 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -80,7 +80,8 @@
(begin
(format #t "~a~%" error-msg)
(format #t "Entering a new prompt. ")
- (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")))
+ (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")
+ (format #t "~a~&" (debug-prompt frame #f))))
((@ (system repl repl) start-repl) #:debug debug)))))
(define (null-trap-handler frame trap-idx trap-name)
--
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.nl
[-- Attachment #3: Type: text/plain, Size: 154 bytes --]
--
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.nl
^ permalink raw reply related [flat|nested] only message in thread
only message in thread, other threads:[~2014-09-02 21:20 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2014-09-02 21:20 [PATCH] debugger: Initial GUD integration support v2 Jan Nieuwenhuizen
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).