(system vm frame): frame-return-values

* module/system/vm/frame.scm (frame-return-values): New exported
  function, gives the return values for a frame.
* module/system/vm/trace.scm: Remove frame-return-values from here.

diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index c94b802..ffa66d5 100644 (file)
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -28,7 +28,8 @@
             frame-binding-ref frame-binding-set!
             frame-source frame-call-representation
             frame-environment
-            frame-object-binding frame-object-name))
+            frame-object-binding frame-object-name
+            frame-return-values))
 
 (define (frame-bindings frame)
   (program-bindings-for-ip (frame-procedure frame)
@@ -149,3 +150,12 @@
 (define (frame-object-name frame obj)
   (cond ((frame-object-binding frame obj) => binding:name)
        (else #f)))
+
+;; Nota bene, only if frame is in a return context (i.e. in a
+;; pop-continuation hook dispatch).
+(define (frame-return-values frame)
+  (let* ((len (frame-num-locals frame))
+         (nvalues (frame-local-ref frame (1- len))))
+    (map (lambda (i)
+           (frame-local-ref frame (+ (- len nvalues) i)))
+         (iota nvalues))))

diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm
index 0c878e3..138d364 100644 (file)
--- a/module/system/vm/trace.scm
+++ b/module/system/vm/trace.scm
@@ -36,13 +36,6 @@
 ;; FIXME: this constant needs to go in system vm objcode
 (define *objcode-header-len* 8)
 
-(define (frame-return-values frame)
-  (let* ((len (frame-num-locals frame))
-         (nvalues (frame-local-ref frame (1- len))))
-    (map (lambda (i)
-           (frame-local-ref frame (+ (- len nvalues) i)))
-         (iota nvalues))))
-  
 (define (print-application frame depth width prefix)
   (format (current-error-port) "~a~a~v:@y\n"
           prefix (make-string depth #\|)