(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.

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index eca7163588724ac4313bad9ff33c44d54f9adfe4..2b50ff23b2b8533af348703f5123ad242e0122ae 100644 (file)
--- 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 4c99469e4c92c15bf73475bdc2237992d60ec6a7..51cdedffded85163c48d974780384ac7045bcf32 100644 (file)
--- 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))
 
 \f
 (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"))))