From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jan Nieuwenhuizen Newsgroups: gmane.emacs.devel,gmane.lisp.guile.devel Subject: [PATCH] Initial GUD integration support. Date: Tue, 5 Aug 2014 15:21:45 +0200 Message-ID: <1407244906-12754-2-git-send-email-janneke@gnu.org> References: <1407244906-12754-1-git-send-email-janneke@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable X-Trace: ger.gmane.org 1407245097 9072 80.91.229.3 (5 Aug 2014 13:24:57 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 5 Aug 2014 13:24:57 +0000 (UTC) To: guile-devel , emacs-devel Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Aug 05 15:24:52 2014 Return-path: Envelope-to: ged-emacs-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 1XEejU-0000iI-6x for ged-emacs-devel@m.gmane.org; Tue, 05 Aug 2014 15:24:52 +0200 Original-Received: from localhost ([::1]:59448 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XEejT-0001z2-K0 for ged-emacs-devel@m.gmane.org; Tue, 05 Aug 2014 09:24:51 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:58329) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XEejK-0001ps-Aj for emacs-devel@gnu.org; Tue, 05 Aug 2014 09:24:47 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XEejF-0007wZ-Bs for emacs-devel@gnu.org; Tue, 05 Aug 2014 09:24:42 -0400 Original-Received: from smtp-vbr7.xs4all.nl ([194.109.24.27]:3657) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XEejE-0007wE-Ve; Tue, 05 Aug 2014 09:24:37 -0400 Original-Received: from drakenvlieg.flower (static.kpn.net [92.70.116.82] (may be forged)) (authenticated bits=0) by smtp-vbr7.xs4all.nl (8.13.8/8.13.8) with ESMTP id s75DMTE9092629 (version=TLSv1/SSLv3 cipher=AES128-SHA bits=128 verify=NO); Tue, 5 Aug 2014 15:24:19 +0200 (CEST) (envelope-from janneke@gnu.org) X-Mailer: git-send-email 1.9.1 In-Reply-To: <1407244906-12754-1-git-send-email-janneke@gnu.org> X-Virus-Scanned: by XS4ALL Virus Scanner X-MIME-Autoconverted: from 8bit to quoted-printable by smtp-vbr7.xs4all.nl id s75DMTE9092629 X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 194.109.24.27 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:173435 gmane.lisp.guile.devel:17305 Archived-At: * 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 | 62 +++++++++++++++++++++++++++++= ++++++ module/system/repl/error-handling.scm | 3 +- 4 files changed, 124 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..8378a0c --- /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 +;; ,r +;; ,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 fin= ishes." 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 locatio= n." 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 fr= ame. =20 Step until control reaches a different source location in the current fr= ame." - (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 locatio= n 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 fra= me." - (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..5e47d19 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-= >module stack->vector narrow-stack->vector @@ -160,6 +162,66 @@ (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* (gulp-port #:optional (port current-input-port))=20 + (or (and-let* ((result (read-delimited "" port)) + ((string? result))) + result) + "")) + +(define (gulp-file file-name) + (gulp-port (open-input-file (format #f "~a" file-name)))) + +(define (read-source-file file-name) + (or (assoc-ref *source-alist* file-name) + (and-let* ((source (gulp-file file-name)) + (lines (string-split source #\newline))) + (source-add file-name lines)))) + +(define (fs-find-file file-name) + (let loop ((path (cons "." %load-path ))) + (if (null? path) + #f + (let* ((dir (car path))=20 + (fs-file-name (string-join (list dir file-name) "/"))) + (if (file-exists? fs-file-name) + fs-file-name + (loop (cdr path))))))) + +(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*) (mes= sage "")) + "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 (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 = standard! + ;;(format #f "~&In ~a:~a~&" file-name message) ;;or awkward Gui= le convention? + "") + (format #f "~&~10a~a" line-column code)))) + ;; Ideally here we would have something much more syntactic, in that a s= et! to a ;; local var that is not settable would raise an error, and export etc f= orms ;; 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/e= rror-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 conti= nue.\n"))) + (format #t "Type `,bt' for a backtrace or `,q' to conti= nue.\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