From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: Matt Wette Newsgroups: gmane.lisp.guile.user Subject: Re: Interactive Debugging Date: Sat, 19 Oct 2019 07:42:50 -0700 Message-ID: <7ac2ca4c-31b4-3cdf-7745-28839c23d304@gmail.com> References: <1571373554.24401.4.camel@librehacker.com> <8736fppx4d.fsf@netris.org> Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="107808"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:60.0) Gecko/20100101 Thunderbird/60.9.0 To: guile-user@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Sat Oct 19 16:43:20 2019 Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1iLpwt-000Rxr-BY for guile-user@m.gmane.org; Sat, 19 Oct 2019 16:43:19 +0200 Original-Received: from localhost ([::1]:56012 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iLpws-0003oo-6j for guile-user@m.gmane.org; Sat, 19 Oct 2019 10:43:18 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:43886) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iLpwX-0003oi-As for guile-user@gnu.org; Sat, 19 Oct 2019 10:42:58 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iLpwV-0003uL-MC for guile-user@gnu.org; Sat, 19 Oct 2019 10:42:57 -0400 Original-Received: from mail-pl1-x634.google.com ([2607:f8b0:4864:20::634]:44453) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iLpwV-0003sN-Db for guile-user@gnu.org; Sat, 19 Oct 2019 10:42:55 -0400 Original-Received: by mail-pl1-x634.google.com with SMTP id q15so4284299pll.11 for ; Sat, 19 Oct 2019 07:42:54 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=subject:to:references:from:message-id:date:user-agent:mime-version :in-reply-to:content-transfer-encoding:content-language; bh=S3VzrhwDo6XaIvZCG44u1y66JISD5+s0xOQpYMic7zE=; b=W5mqEFrwt+TGhODoLDcwGDRCZ6vMB8ppzHTLgXqsXXbqHe1bLSEopLI0fRXGld1xMW 1PfwaI26ctmHfvSfvHNJ7v/g9tkFsGyiy86YYJF7jBEY6HntL51OHYVLHvO40CtRN8M8 R089+X4wo+eE6RnSWRgLwtP1xCG4JNTo1ez16//Z5WWMZZHT/QLRDou1kcB3VC9otUrK kUxGECPEqHg0HLvqr+AxEnPNguckeFcEcb5AO4KDNRY+zcJ831fGG/yaRhtNjpdasJQe 03j6ulxpVMXZngxCltSywiQXeV4WCdgSyNw6jKeg1QwTO8avImaMPiIJXyz/17oYeJuj DLZw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:subject:to:references:from:message-id:date :user-agent:mime-version:in-reply-to:content-transfer-encoding :content-language; bh=S3VzrhwDo6XaIvZCG44u1y66JISD5+s0xOQpYMic7zE=; b=A8ODbevijyvkg/qKZU4oInVTMSB7RTmU45hlsDK+zwt9bU+sddg7ANLltTys4m/DeA 1XihquzOIocmMClQb0VkMxVQRorxoQzY1gweFh7yA9FE2p6QmUd0v4+l88BMx+RTCnBn U2rdEDdCFGzRfyojbgToxRgG5uSSQQpGYamT9QlPZoVKxgq57YAeGPMOuG+xSJpbxX0/ zd3nKoAECfe64Th+02wfe765IFMcChvXGOuj4buREwBd0aP9MFbM8Jg3i/qev/RwAoGM ihKwEU94WnFnMYQx9IFzcUcWDjj35YUNSUahjL0sFMmD6yimdMlRebq5uprhaJcTxiYk tCtA== X-Gm-Message-State: APjAAAVJZiNDsO6XV/ZmkGc/j5S1EWOLaRDTDABlxjCBZ0SLdBtM4IPc 5R7omYsxPFbDko3lVyYo3PlfHK3V X-Google-Smtp-Source: APXvYqxAa7mW9C7umQBePeWK7pAeLwRA2mbYdBldHn4KPi9zrLXACRodsUTvPuFTsaQSLehXhZGe7Q== X-Received: by 2002:a17:902:74c7:: with SMTP id f7mr1797133plt.91.1571496172925; Sat, 19 Oct 2019 07:42:52 -0700 (PDT) Original-Received: from [192.168.2.183] (216-165-237-5.championbroadband.com. [216.165.237.5]) by smtp.gmail.com with ESMTPSA id m13sm9783912pgi.22.2019.10.19.07.42.51 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Sat, 19 Oct 2019 07:42:52 -0700 (PDT) In-Reply-To: <8736fppx4d.fsf@netris.org> Content-Language: en-US X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2607:f8b0:4864:20::634 X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Original-Sender: "guile-user" Xref: news.gmane.org gmane.lisp.guile.user:15771 Archived-At: Below is something I played with years ago. I'm not sure kill-opt is up to date. Try with > (load "jtd.scm") > (foo) [1]> ,loc ;; potluck/jtd - jump to debugger, detour to debugger ;;(define-module (potluck jtd) #:export (kill-opt trap-here foo)) (use-modules (system repl repl)) (use-modules (system repl debug)) (use-modules (system repl common)) (use-modules (system repl command)) (use-modules (system vm frame)) (use-modules (system vm vm)) (use-modules (ice-9 control)) (use-modules (ice-9 rdelim)) (use-modules (ice-9 pretty-print)) ;; kill optimization (define (kill-opt) (set! (@@ (language tree-il optimize) tree-il-default-optimization-options) (lambda () '())) (set! (@@ (language cps optimize) cps-default-optimization-options) (lambda () '()))) ;; notes ;; 1) needs new set of commands: ;; C-d loops and enters again, i.e., continues => disable ;; debug needs ,continue -- aka ,c -- HAS it, see ",quit" ;; need ,quit -- aka ,q ;; 2) for non-interactive use probably need to call guile with "--debug" ;; 3) need to determine if repl is running (pair? (fluid-ref *repl-stack*)) ;; and start one if not ;; 4) maybe set hook on next instrucrtion (trap-here-2) ;; 5) see debug-trap-handler in system/repl/error-handling.scm to see how ;; a debug session is spontaneously started. See also near line 124. ;; 6) another strategy might be to have a procedure and set a trap in there ;; 7) use prompts (delineated continuations) ;; 8) trap handlers take one argument: a frame ;; 9) possible frame goodies: ;; (frame-lookup-binging frame var) ;; (frame-next-source frame) ;; NO MORE :( ;; (frame-source frame) ;; given frame ;; (frame-procedure frame) => procedure ;; (procedure-source procedure) => source ??? ;; (source-properties ) => '((filename . "foo.scm") (line . 2) ...) ;; Here is what the debugger step command does: ;; (add-ephemeral-stepping-trap! cur (repl-next-resumer msg) ;; #:into? #t #:instruction? #f) ;; (throw 'quit))) ;;(simple-format #t "~S\n" (provided? 'debug-extensions)) ;;(simple-format #t "repl:~S\n" (fluid-ref *repl-stack*)) ;;(define repl-next-resumer (@@ (system repl command) repl-next-resumer)) ;;(simple-format #t "vm-engine: ~S\n" (vm-engine)) ;; get a few lines from file (define (get-lines filename lineno) (let ((port (open-input-file filename))) (let iter ((prev #f) (curr #f) (offs lineno)) (case offs ((1) (iter (cons " " (read-line port)) curr (1- offs))) ((0) (iter prev (cons "*" (read-line port)) (1- offs))) ((-1) (list prev curr (cons " " (read-line port)))) (else (read-line port) (iter prev curr (1- offs))))))) (define (show-src-loc locn) (let* ((line (assq-ref locn 'line)) (column (assq-ref locn 'column)) (filename (assq-ref locn 'filename))) (for-each (lambda (pair) (if pair (simple-format #t "~A ~A\n" (car pair) (cdr pair)))) (get-lines filename line)))) (define here-repl #f) ;; @deffn make-debug frames index err-msg for-trap? ;; Generate a data structure used for the repl. ;; @table @var ;; @item frames ;; TBD ;; @item index ;; I think this is the current frame from the deepest ;; @item err-msg ;; TBD ;; @item for-trap? ;; TBD ;; @end table ;; make-stack : in manual, generates a list of frames ;; stack->vector : convert list to vector ;; in commands, cur is (vector-ref (debug-frames debug) (debug-index debug)) ;; or the current frame ;; The first thing we do is kill off optimization (kill-opt) (define give-warning (let ((warned? #f)) (lambda () (unless warned? (simple-format (current-error-port) "trap requires --debug\n") (set! warned? #t))))) (define-syntax-rule (jump-to-debugger) (if (eqv? 'regular (vm-engine)) (give-warning) (start-repl #:debug (make-debug (stack->vector (make-stack #t)) 0 "trap!" #t)))) (define-syntax-rule (trap-here-0) (start-repl #:debug (make-debug (stack->vector (make-stack #t)) 0 "trap!" #t))) #;(define-syntax-rule (trap-here-2) (let ((loc (current-source-location)) ) #t )) ;; step: ;; (add-ephemeral-stepping-trap! cur (repl-next-resumer msg) ;; #:into? #t #:instruction? #f) ;; (throw 'quit))) ;; quit: ;; (throw 'quit) (define (my-repl-welcome repl) (display "Enter `,help' for help.\n")) (set! (@ (system repl common) repl-welcome) my-repl-welcome) ;; copy from system/repl/command.scm ;; this returns a continuation (define (repl-next-resumer msg) ;; Capture the dynamic environment with this prompt thing. The ;; result is a procedure that takes a frame. (% (let ((stack (abort (lambda (k) ;; Call frame->stack-vector before reinstating the ;; continuation, so that we catch the %stacks fluid ;; at the time of capture. (lambda (frame) (k (frame->stack-vector frame))))))) (format #t "~a~%" msg) ((module-ref (resolve-interface '(system repl repl)) 'start-repl) #:debug (make-debug stack 0 msg #t))))) #;(define-meta-command (resume repl) "resume" (let ((debug (repl-debug repl))) (if debug (let ((msg (simple-format #f "resume ...")) (cur (vector-ref (debug-frames debug) (debug-index debug)))) (add-ephemeral-stepping-trap! cur (repl-next-resumer msg) #:into? #t #:instruction? #f) )))) ;; This allows user to just get the hell out of guile. ;;(define-meta-command ((quit-guile extra) repl) (define-meta-command ((qq extra) repl) "quit-guile Quit the guile session." (primitive-exit 1)) (define-meta-command ((loc extra) repl) "loc Show where in source." (let* ((debug (repl-debug repl)) (indx (debug-index debug)) (frms (debug-frames debug)) (frm (vector-ref frms (1+ indx))) (src (and frm (frame-source frm))) (loc `((column . ,(car src)) (filename . ,(cadr src)) (line . ,(caddr src)))) ) (show-src-loc loc) )) (define (foo) (let ((a 1) (b 2) (c 3)) (set! b 22) ;;(show-src-loc (current-source-location)) (let iter ((sum 0) (vals '(1 2 3 5 8 2))) (if (zero? sum) (jump-to-debugger)) (cond ((null? vals) sum) (else (simple-format #t "~S\n" sum) (iter (+ sum (car vals)) (cdr vals))))))) ;;(simple-format #t "~S\n" (foo)) ;;; --- last line ---