From 42ee0d00ba61e51a5b4a9f2d59e6f95b52e49dbf Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 14 Mar 2010 23:06:58 +0100 Subject: [PATCH] (debug) at the repl invokes the vm debugger * module/ice-9/boot-9.scm (top-repl): Map (debug) at the repl to (system vm debug). * module/system/vm/debug.scm (run-debugger, debugger-repl): Don't take the index as an arg, for now anyway. (debug): New wrapper. --- module/ice-9/boot-9.scm | 2 +- module/system/vm/debug.scm | 23 +++++++++++++++-------- 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index eca716358..2b50ff23b 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -3644,7 +3644,7 @@ module '(ice-9 q) '(make-q q-length))}." '(((ice-9 threads))) '()))) ;; load debugger on demand - (module-autoload! guile-user-module '(ice-9 debugger) '(debug)) + (module-autoload! guile-user-module '(system vm debug) '(debug)) ;; Note: SIGFPE, SIGSEGV and SIGBUS are actually "query-only" (see ;; scmsigs.c scm_sigaction_for_thread), so the handlers setup here have diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm index 4c99469e4..51cdedffd 100644 --- a/module/system/vm/debug.scm +++ b/module/system/vm/debug.scm @@ -28,7 +28,7 @@ #:use-module (ice-9 format) #:use-module ((system vm inspect) #:select ((inspect . %inspect))) #:use-module (system vm program) - #:export (run-debugger debug-pre-unwind-handler)) + #:export (debug run-debugger debug-pre-unwind-handler)) (define (reverse-hashq h) @@ -144,19 +144,20 @@ (set! (prop vm) debugger) debugger))))) -(define* (run-debugger stack frames i #:optional (vm (the-vm))) +(define* (run-debugger stack frames #:optional (vm (the-vm))) (let* ((db (vm-debugger vm)) (level (debugger-level db))) (dynamic-wind (lambda () (set! (debugger-level db) (1+ level))) - (lambda () (debugger-repl db stack frames i)) + (lambda () (debugger-repl db stack frames)) (lambda () (set! (debugger-level db) level))))) -(define (debugger-repl db stack frames index) - (let ((top (vector-ref frames 0)) - (cur (vector-ref frames index)) - (level (debugger-level db)) - (last #f)) +(define (debugger-repl db stack frames) + (let* ((index 0) + (top (vector-ref frames index)) + (cur top) + (level (debugger-level db)) + (last #f)) (define (frame-at-index idx) (and (< idx (vector-length frames)) (vector-ref frames idx))) @@ -402,3 +403,9 @@ With an argument, select a frame by index, then show it." 0)))) (save-stack debug-pre-unwind-handler) (apply throw key args)) + +(define (debug) + (let ((stack (fluid-ref the-last-stack))) + (if stack + (run-debugger stack (stack->vector stack)) + (display "Nothing to debug.\n"))))