summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-03-14 23:06:58 +0100
committerAndy Wingo <wingo@pobox.com>2010-03-14 23:06:58 +0100
commit42ee0d00ba61e51a5b4a9f2d59e6f95b52e49dbf (patch)
tree50569310ed4451957dcc065a5a31289650bda374 /module
parent42cb9b03111ccddb4abcf25004c4bd8bd069390f (diff)
downloadguile-42ee0d00ba61e51a5b4a9f2d59e6f95b52e49dbf.tar.gz
(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.
Diffstat (limited to 'module')
-rw-r--r--module/ice-9/boot-9.scm2
-rw-r--r--module/system/vm/debug.scm23
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"))))