mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-20 02:30:23 +02:00
Code Activity

implement breakpoints in the repl

Browse source 
* module/system/vm/trap-state.scm: New file, tracks a VM-specific set of
  traps.
* module/Makefile.am: Add trap-state.scm.

* module/system/repl/error-handling.scm: While in a with-error-handling
  block, bind a default trap handler that invokes a recursive prompt.

* module/system/repl/command.scm: Add a `break' repl meta-command.
This commit is contained in:
Andy Wingo 2010-09-19 11:16:32 +02:00
parent c939b1275b
commit b9badc35ab
4 changed files with 226 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

32
module/system/repl/command.scm
View file

@ -27,6 +27,7 @@
#:use-module (system repl debug)
#:use-module (system vm objcode)
#:use-module (system vm program)
#:use-module (system vm trap-state)
#:use-module (system vm vm)
#:autoload (system base language) (lookup-language language-reader)
#:autoload (system vm trace) (vm-trace)
@ -55,7 +56,8 @@
(disassemble x) (disassemble-file xx))
(profile (time t) (profile pr) (trace tr))
(debug (backtrace bt) (up) (down) (frame fr)
(procedure proc) (locals) (error-message error))
(procedure proc) (locals) (error-message error)
(break br))
(inspect (inspect i) (pretty-print pp))
(system (gc) (statistics stat) (option o)
(quit q continue cont))))
@ -476,14 +478,6 @@ Trace execution."
body body* ...)
(format #t "Nothing to debug.~%"))))))))
(define-stack-command (error-message repl)
"error-message
Show error message.
Display the message associated with the error that started the current
debugging REPL."
(format #t "~a~%" (if (string? message) message "No error message")))
(define-stack-command (backtrace repl #:optional count
#:key (width 72) full?)
"backtrace [COUNT] [#:width W] [#:full? F]
@ -566,6 +560,26 @@ Show local variables.
Show locally-bound variables in the selected frame."
(print-locals cur))
(define-stack-command (error-message repl)
"error-message
Show error message.
Display the message associated with the error that started the current
debugging REPL."
(format #t "~a~%" (if (string? message) message "No error message")))
(define-meta-command (break repl (form))
"break PROCEDURE
Break on calls to PROCEDURE.
Starts a recursive prompt when PROCEDURE is called."
(let ((proc (repl-eval repl (repl-parse repl form))))
(if (not (procedure? proc))
(error "Not a procedure: ~a" proc)
(let ((idx (add-trap-at-procedure-call! proc)))
(format #t "Added breakpoint ~a at ~a.~%" idx proc)))))
;;;
;;; Inspection commands