From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jan Nieuwenhuizen Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] debugger: Initial GUD integration support v2 Date: Tue, 02 Sep 2014 23:20:12 +0200 Organization: AvatarAcademy.nl Message-ID: <87iol5vhwz.fsf@drakenvlieg.flower> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1409692842 5211 80.91.229.3 (2 Sep 2014 21:20:42 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 2 Sep 2014 21:20:42 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Sep 02 23:20:37 2014 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XOvVD-0003vJ-GF for guile-devel@m.gmane.org; Tue, 02 Sep 2014 23:20:35 +0200 Original-Received: from localhost ([::1]:40251 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XOvVC-0006G5-W2 for guile-devel@m.gmane.org; Tue, 02 Sep 2014 17:20:34 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:54559) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XOvV2-0006Fy-Q7 for guile-devel@gnu.org; Tue, 02 Sep 2014 17:20:29 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XOvUx-00053m-FV for guile-devel@gnu.org; Tue, 02 Sep 2014 17:20:24 -0400 Original-Received: from smtp-vbr8.xs4all.nl ([194.109.24.28]:3406) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XOvUx-00053H-2Q for guile-devel@gnu.org; Tue, 02 Sep 2014 17:20:19 -0400 Original-Received: from drakenvlieg.flower.peder.onsbrabantnet.nl (static.kpn.net [92.70.116.82] (may be forged)) (authenticated bits=0) by smtp-vbr8.xs4all.nl (8.13.8/8.13.8) with ESMTP id s82LKDuY094208 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES128-SHA bits=128 verify=NO); Tue, 2 Sep 2014 23:20:15 +0200 (CEST) (envelope-from janneke@gnu.org) X-Url: http://AvatarAcademy.nl User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) X-Virus-Scanned: by XS4ALL Virus Scanner X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 194.109.24.28 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:17391 Archived-At: --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=0001-Initial-GUD-integration-support.patch Content-Transfer-Encoding: quoted-printable >From b9631f41f2621f787fca5b36eb3ee20cc601a3e8 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen 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/gu= d.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-s= upport-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)=20 + (stderr "~a:hello world\n" (current-source-location)) + (let + ((a #f) + (b #f)) + (set! a 1) + (stderr "set: a=3D~a\n" a) + (set! b 2) + (stderr "set: b=3D~a\n" b) + (let + ((c #f) + (d #f)) + (set! c 3) + (stderr "set: c=3D~a\n" c) + (set! d 4) + (stderr "set: d=3D~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 finis= hes." Step until control reaches a different source location. =20 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. =20 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 fram= e. =20 Step until control reaches a different source location in the current fram= e." - (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. =20 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 ( make-debug debug? debug-frames debug-index debug-error-message + debug-prompt terminal-width print-registers print-locals print-frame print-frames frame->m= odule stack->vector narrow-stack->vector @@ -160,6 +162,58 @@ (lp (+ i inc) (frame-source frame))))))) =20 +(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)=20 + 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*) (messa= ge "")) + "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=3D> source source:line)) + (col (and=3D> source source:column)) + (code (source-code file-name line)) + (line-column (format #f "~a~a" (if line (1+ line) "")=20 + (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 st= andard! + ;;(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 for= ms ;; would modify the module in question: but alack, this is what we have no= w. diff --git a/module/system/repl/error-handling.scm b/module/system/repl/err= or-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 continu= e.\n"))) + (format #t "Type `,bt' for a backtrace or `,q' to continu= e.\n") + (format #t "~a~&" (debug-prompt frame #f)))) ((@ (system repl repl) start-repl) #:debug debug))))) =20 (define (null-trap-handler frame trap-idx trap-name) --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.nl= =20=20 --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.nl= =20=20 --=-=-=--