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

bugfixen in source breakpoints and in-procedure traps

Browse source 
* module/system/vm/traps.scm (trap-in-procedure): If we are
  (re-)entering the procedure from a return, call the enter-proc with
  the returnee, not the returner.
  (in-range?): Tighten up a bit.
  (program-sources-before-retire): New helper, like program-sources but
  indexed before instructions are retired instead of after.
  (program-sources-by-line): Use program-sources-before-retire so that
  we can break on instructions by source line *before* those
  instructions are executed.
This commit is contained in:
Andy Wingo 2010-10-03 11:12:36 +02:00
parent 1905db2b48
commit 262ce91157
1 changed files with 59 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -60,6 +60,7 @@
#:use-module (system vm frame)
#:use-module (system vm program)
#:use-module (system vm objcode)
#:use-module (system vm instruction)
#:use-module (system xref)
#:use-module (rnrs bytevectors)
#:export (trap-at-procedure-call
@ -186,7 +187,7 @@
(if in-proc?
(exit-proc frame))
(if (our-frame? (frame-previous frame))
(enter-proc frame)))
(enter-proc (frame-previous frame))))
(define (abort-hook frame)
(if in-proc?
@ -262,7 +263,8 @@
(define (in-range? range i)
(or-map (lambda (bounds)
(<= (car bounds) i (cdr bounds)))
(and (<= (car bounds) i)
(< i (cdr bounds))))
range))
;; Building on trap-instructions-in-procedure, we have
@ -290,14 +292,68 @@
#:current-frame current-frame #:vm vm
#:our-frame? our-frame?)))
;; FIXME: pull this definition from elsewhere.
(define *bytecode-header-len* 8)
;; FIXME: define this in objcode somehow. We are reffing the first
;; uint32 in the objcode, which is the length of the program (without
;; the meta).
(define (program-last-ip prog)
(bytevector-u32-native-ref (objcode->bytecode (program-objcode prog)) 0))
;; We could decompile the program to get this, but that seems like a
;; waste.
(define (bytecode-instruction-length bytecode ip)
(let* ((idx (+ ip *bytecode-header-len*))
(inst (opcode->instruction (bytevector-u8-ref bytecode idx))))
;; 1+ for the instruction itself.
(1+ (cond
((eq? inst 'load-program)
(+ (bytevector-u32-native-ref bytecode (+ idx 1))
(bytevector-u32-native-ref bytecode (+ idx 5))))
((< (instruction-length inst) 0)
;; variable length instruction -- the length is encoded in the
;; instruction stream.
(+ (ash (bytevector-u8-ref bytecode (+ idx 1)) 16)
(ash (bytevector-u8-ref bytecode (+ idx 2)) 8)
(bytevector-u8-ref bytecode (+ idx 3))))
(else
;; fixed length
(instruction-length inst))))))
;; Source information could in theory be correlated with the ip of the
;; instruction, or the ip just after the instruction is retired. Guile
;; does the latter, to make backtraces easy -- an error produced while
;; running an opcode always happens after it has retired its arguments.
;;
;; But for breakpoints and such, we need the ip before the instruction
;; is retired -- before it has had a chance to do anything. So here we
;; change from the post-retire addresses given by program-sources to
;; pre-retire addresses.
;;
(define (program-sources-before-retire proc)
(let ((bv (objcode->bytecode (program-objcode proc))))
(let lp ((in (program-sources proc))
(out '())
(ip 0))
(cond
((null? in)
(reverse out))
(else
(pmatch (car in)
((,post-ip . ,source)
(let lp2 ((ip ip)
(next ip))
(if (< next post-ip)
(lp2 next (+ next (bytecode-instruction-length bv next)))
(lp (cdr in)
(acons ip source out)
next))))
(else
(error "unexpected"))))))))
(define (program-sources-by-line proc file)
(let lp ((sources (program-sources proc))
(let lp ((sources (program-sources-before-retire proc))
(out '()))
(if (pair? sources)
(lp (cdr sources)