mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-07 18:30:25 +02:00
Code Activity

source breakpoints accept user line numbers

Browse source 
* module/system/vm/trap-state.scm (add-trap-at-source-location!):
* module/system/vm/traps.scm (trap-at-source-location): Rename "line"
  argument to "user-line", indicating that the line is one-based instead
  of zero-based. Decrement the line before handing off to
  source-closures-or-procedures and source->ip-range.
This commit is contained in:
Andy Wingo 2010-10-01 18:25:44 +02:00
parent e867d563a5
commit 2c5fc8d034
2 changed files with 13 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/system/vm/trap-state.scm
View file

@ -209,16 +209,16 @@
idx #t trap
(format #f "Tracepoint at ~a" proc)))))
(define* (add-trap-at-source-location! file line
(define* (add-trap-at-source-location! file user-line
#:optional (trap-state (the-trap-state)))
(let* ((idx (next-index! trap-state))
(trap (trap-at-source-location file line
(trap (trap-at-source-location file user-line
(handler-for-index trap-state idx))))
(add-trap-wrapper!
trap-state
(make-trap-wrapper
idx #t trap
(format #f "Breakpoint at ~a:~a" file line)))))
(format #f "Breakpoint at ~a:~a" file user-line)))))
(define* (add-trap! trap name #:optional (trap-state (the-trap-state)))
(let* ((idx (next-index! trap-state)))

16
module/system/vm/traps.scm
View file

@ -249,6 +249,9 @@
(define (non-negative-integer? x)
(and (number? x) (integer? x) (exact? x) (not (negative? x))))
(define (positive-integer? x)
(and (number? x) (integer? x) (exact? x) (positive? x)))
(define (range? x)
(and (list? x)
(and-map (lambda (x)
@ -345,16 +348,17 @@
(values (source-procedures file line) #f))))
;; Building on trap-on-instructions-in-procedure, we have
;; trap-at-source-location.
;; trap-at-source-location. The parameter `user-line' is one-indexed, as
;; a user counts lines, instead of zero-indexed, as Guile counts lines.
;;
(define* (trap-at-source-location file line handler
(define* (trap-at-source-location file user-line handler
#:key current-frame (vm (the-vm)))
(arg-check file string?)
(arg-check line non-negative-integer?)
(arg-check user-line positive-integer?)
(arg-check handler procedure?)
(let ((traps #f))
(call-with-values
(lambda () (source-closures-or-procedures file line))
(lambda () (source-closures-or-procedures file (1- user-line)))
(lambda (procs closures?)
(new-enabled-trap
vm current-frame
@ -362,14 +366,14 @@
(set! traps
(map
(lambda (proc)
(let ((range (source->ip-range proc file line)))
(let ((range (source->ip-range proc file (1- user-line))))
(trap-at-procedure-ip-in-range proc range handler
#:current-frame current-frame
#:vm vm
#:closure? closures?)))
procs))
(if (null? traps)
(error "No procedures found at ~a:~a." file line)))
(error "No procedures found at ~a:~a." file user-line)))
(lambda (frame)
(for-each (lambda (trap) (trap frame)) traps)
(set! traps #f)))))))