remove heap links in VM frames, incorporate vm frames into normal backtraces

[bpt/guile.git] / module / system / vm / frame.scm

diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 70b82f8..85a223e 100644 (file)
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -23,7 +23,15 @@
   #:use-module (system vm program)
   #:use-module (system vm instruction)
   #:use-module ((srfi srfi-1) #:select (fold))
-  #:export (frame-number frame-address
+  #:export (vm-frame?
+            vm-frame-program
+            vm-frame-local-ref vm-frame-local-set!
+            vm-frame-return-address vm-frame-mv-return-address
+            vm-frame-dynamic-link vm-frame-external-link
+            vm-frame-stack
+
+
+            vm-frame-number vm-frame-address
            make-frame-chain
            print-frame print-frame-chain-as-backtrace
            frame-arguments frame-local-variables frame-external-variables
@@ -41,8 +49,8 @@
 ;;; Frame chain
 ;;;
 
-(define frame-number (make-object-property))
-(define frame-address (make-object-property))
+(define vm-frame-number (make-object-property))
+(define vm-frame-address (make-object-property))
 
 (define (bootstrap-frame? frame)
   (let ((code (program-bytecode (frame-program frame))))
@@ -172,15 +180,12 @@
 
 ;; FIXME handle #f program-bindings return
 (define (frame-bindings frame addr)
-  (do ((bs (program-bindings (frame-program frame)) (cdr bs))
-       (ls '() (if (cdar bs) (cons (cdar bs) ls) (cdr ls))))
-      ((or (null? bs) (> (caar bs) addr))
-       (apply append ls))))
+  (filter (lambda (b) (and (>= addr (binding:start b))
+                           (<= addr (binding:end b))))
+          (program-bindings (frame-program frame))))
 
 (define (frame-lookup-binding frame addr sym)
-  (do ((bs (frame-bindings frame addr) (cdr bs)))
-      ((or (null? bs) (eq? sym (binding:name (car bs))))
-       (and (pair? bs) (car bs)))))
+  (assq sym (reverse (frame-bindings frame addr))))
 
 (define (frame-object-binding frame addr obj)
   (do ((bs (frame-bindings frame addr) (cdr bs)))