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

fix backtraces, broken since the program-bindings format change

Browse source 
* module/system/vm/frame.scm (frame-bindings): Fix for new binding
  format; actually use the bindings accessors.
  (frame-lookup-binding): Clarify.
This commit is contained in:
Andy Wingo 2008-10-16 13:56:41 +02:00
parent f580ec0f56
commit cc588f740f
1 changed files with 4 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

11
module/system/vm/frame.scm
View file

@ -172,15 +172,12 @@
;; FIXME handle #f program-bindings return ;; FIXME handle #f program-bindings return
(define (frame-bindings frame addr) (define (frame-bindings frame addr)
(do ((bs (program-bindings (frame-program frame)) (cdr bs)) (filter (lambda (b) (and (>= addr (binding:start b))
(ls '() (if (cdar bs) (cons (cdar bs) ls) (cdr ls)))) (<= addr (binding:end b))))
((or (null? bs) (> (caar bs) addr)) (program-bindings (frame-program frame))))
(apply append ls))))
(define (frame-lookup-binding frame addr sym) (define (frame-lookup-binding frame addr sym)
(do ((bs (frame-bindings frame addr) (cdr bs))) (assq sym (reverse (frame-bindings frame addr))))
((or (null? bs) (eq? sym (binding:name (car bs))))
(and (pair? bs) (car bs)))))
(define (frame-object-binding frame addr obj) (define (frame-object-binding frame addr obj)
(do ((bs (frame-bindings frame addr) (cdr bs))) (do ((bs (frame-bindings frame addr) (cdr bs)))