mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

(debug) at the repl invokes the vm debugger

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2010-03-14 23:06:58 +01:00
parent 42cb9b0311
commit 42ee0d00ba
2 changed files with 16 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/ice-9/boot-9.scm
View file

@ -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

23
module/system/vm/debug.scm
View file

@ -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"))))