[Guile-commits] 07/10: Frame <binding> objects capture frame, can ref value directly

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit cd0b61a04e5fa7db62c8795d3bdbee1bc831199a
Author: Andy Wingo <address@hidden>
Date:   Sun Jan 31 11:15:58 2016 +0100

    Frame <binding> objects capture frame, can ref value directly
    
    * module/system/repl/debug.scm (print-locals): Adapt to
      frame-binding-ref change.
    
    * module/system/vm/frame.scm (<binding>): Add `frame' field.
      (available-bindings): Capture the frame.
      (binding-ref, binding-set!): New functions, accessing a local variable
      value directly from a frame.
      (frame-binding-ref, frame-binding-set!): Remove.  As these are very
      low-level debugging interfaces introduced in 2.0, never documented,
      and quite tied to the VM, we feel comfortable making this change.
      (frame-call-representation): Adapt to available-bindings change.
      (frame-environment, frame-object-binding): Adapt to binding-ref
      interface change.
    
    * doc/ref/vm.texi (Stack Layout): Mention that slots can be re-used.
      Update disassembly in example.
    
    * doc/ref/api-debug.texi (Frames): Remove documentation for
      frame-local-ref, frame-local-set!, and frame-num-locals.  Replace with
      documentation for frame-bindings, binding accessors, and binding-ref /
      binding-set!.
---
 doc/ref/api-debug.texi       |   32 +++++++++++++++++------
 doc/ref/vm.texi              |   37 +++++++++++++++++----------
 module/system/repl/debug.scm |    2 +-
 module/system/vm/frame.scm   |   57 ++++++++++++++++++++---------------------
 4 files changed, 76 insertions(+), 52 deletions(-)

diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index 459371f..a6cfd7b 100644
--- a/doc/ref/api-debug.texi
+++ b/doc/ref/api-debug.texi
@@ -201,16 +201,32 @@ respectively. @xref{VM Concepts}, for more information.
 @deffnx {Scheme Procedure} frame-mv-return-address frame
 Accessors for the three saved VM registers in a frame: the previous
 frame pointer, the single-value return address, and the multiple-value
-return address. @xref{Stack Layout}, for more information.
+return address.  @xref{Stack Layout}, for more information.
 @end deffn
 
address@hidden {Scheme Procedure} frame-num-locals frame
address@hidden {Scheme Procedure} frame-local-ref frame i
address@hidden {Scheme Procedure} frame-local-set! frame i val
-Accessors for the temporary values corresponding to @var{frame}'s
-procedure application. The first local is the first argument given to
-the procedure. After the arguments, there are the local variables, and
-after that temporary values. @xref{Stack Layout}, for more information.
address@hidden {Scheme Procedure} frame-bindings frame
+Return a list of binding records indicating the local variables that are
+live in a frame.
address@hidden deffn
+
address@hidden {Scheme Procedure} frame-lookup-binding frame var
+Fetch the bindings in @var{frame}, and return the first one whose name
+is @var{var}, or @code{#f} otherwise.
address@hidden deffn
+
address@hidden {Scheme Procedure} binding-index binding
address@hidden {Scheme Procedure} binding-name binding
address@hidden {Scheme Procedure} binding-slot binding
address@hidden {Scheme Procedure} binding-representation binding
+Accessors for the various fields in a binding.  The implicit ``callee''
+argument is index 0, the first argument is index 1, and so on to the end
+of the arguments.  After that are temporary variables.  Note that if a
+variable is dead, it might not be available.
address@hidden deffn
+
address@hidden {Scheme Procedure} binding-ref binding
address@hidden {Scheme Procedure} binding-set! binding val
+Accessors for the values of local variables in a frame.
 @end deffn
 
 @deffn {Scheme Procedure} display-application frame [port [indent]]
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index f97a009..097fb8b 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -160,10 +160,18 @@ The structure of the top stack frame is as follows:
    \------------------/ <- sp
 @end example
 
-In the above drawing, the stack grows downward.  Usually the procedure
-being applied is in local 0, followed by the arguments from local 1.
-After that are enough slots to store the various lexically-bound and
-temporary values that are needed in the function's application.
+In the above drawing, the stack grows downward.  At the beginning of a
+function call, the procedure being applied is in local 0, followed by
+the arguments from local 1.  After the procedure checks that it is being
+passed a compatible set of arguments, the procedure allocates some
+additional space in the frame to hold variables local to the function.
+
+Note that once a value in a local variable slot is no longer needed,
+Guile is free to re-use that slot.  This applies to the slots that were
+initially used for the callee and arguments, too.  For this reason,
+backtraces in Guile aren't always able to show all of the arguments: it
+could be that the slot corresponding to that argument was re-used by
+some other variable.
 
 The @dfn{return address} is the @code{ip} that was in effect before this
 program was applied.  When we return from this activation frame, we will
@@ -274,25 +282,26 @@ We can see how these concepts tie together by 
disassembling the
 @smallexample
 scheme@@(guile-user)> (define (foo a) (lambda (b) (list foo a b)))
 scheme@@(guile-user)> ,x foo
-Disassembly of #<procedure foo (a)> at #xddb824:
+Disassembly of #<procedure foo (a)> at #xea4ce4:
 
-   0    (assert-nargs-ee/locals 2 0)    ;; 2 slots (1 arg)   at (unknown 
file):1:0
-   1    (make-closure 1 6 1)            ;; anonymous procedure at #xddb840 (1 
free var)
+   0    (assert-nargs-ee/locals 2 0)    ;; 2 slots (1 arg)    at (unknown 
file):1:0
+   1    (make-closure 1 7 1)            ;; anonymous procedure at #xea4d04 (1 
free var)
    4    (free-set! 1 0 0)               ;; free var 0
-   6    (return 1)                      
+   6    (mov 0 1)
+   7    (return-values 2)               ;; 1 value
 
 ----------------------------------------
-Disassembly of anonymous procedure at #xddb840:
+Disassembly of anonymous procedure at #xea4d04:
 
-   0    (assert-nargs-ee/locals 2 2)    ;; 4 slots (1 arg)   at (unknown 
file):1:16
-   1    (toplevel-box 1 73 57 67 #t)    ;; `foo'
+   0    (assert-nargs-ee/locals 2 2)    ;; 4 slots (1 arg)    at (unknown 
file):1:16
+   1    (toplevel-box 1 74 58 68 #t)    ;; `foo'
    6    (box-ref 1 1)                   
    7    (make-short-immediate 0 772)    ;; ()                 at (unknown 
file):1:28
    8    (cons 2 2 0)                    
    9    (free-ref 3 3 0)                ;; free var 0
-  11    (cons 3 3 2)                    
-  12    (cons 3 1 3)                    
-  13    (return 3)                      
+  11    (cons 3 3 2)
+  12    (cons 2 1 3)
+  13    (return-values 2)               ;; 1 value
 @end smallexample
 
 First there's some prelude, where @code{foo} checks that it was called
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 4bd9e27..274ebdd 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -115,7 +115,7 @@
       (format port "~aLocal variables:~%" per-line-prefix)
       (for-each
        (lambda (binding)
-         (let ((v (frame-binding-ref frame binding)))
+         (let ((v (binding-ref binding)))
            (display per-line-prefix port)
            (run-hook before-print-hook v)
            (format port "~a = ~v:@y\n" (binding-name binding) width v)))
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 15e745d..565177e 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -33,10 +33,11 @@
             binding-slot
             binding-representation
 
-            frame-instruction-pointer-or-primitive-procedure-name
             frame-bindings
             frame-lookup-binding
-            frame-binding-ref frame-binding-set!
+            binding-ref binding-set!
+
+            frame-instruction-pointer-or-primitive-procedure-name
             frame-call-representation
             frame-environment
             frame-object-binding frame-object-name))
@@ -46,8 +47,9 @@
                   "scm_init_frames_builtins"))
 
 (define-record-type <binding>
-  (make-binding idx name slot representation)
+  (make-binding frame idx name slot representation)
   binding?
+  (frame binding-frame)
   (idx binding-index)
   (name binding-name)
   (slot binding-slot)
@@ -206,7 +208,7 @@
         (lp (1+ n) (+ pos (vector-ref parsed n)))))
     killv))
 
-(define (available-bindings arity ip top-frame?)
+(define (available-bindings frame arity ip top-frame?)
   (let* ((defs (list->vector (arity-definitions arity)))
          (code (arity-code arity))
          (parsed (parse-code code))
@@ -282,7 +284,7 @@
                 (if n
                     (match (vector-ref defs n)
                       (#(name def-offset slot representation)
-                       (cons (make-binding n name slot representation)
+                       (cons (make-binding frame n name slot representation)
                              (lp (1+ n)))))
                     '()))))
           (lp (1+ n) (- offset (vector-ref parsed n)))))))
@@ -292,7 +294,7 @@
     (cond
      ((find-program-arity ip)
       => (lambda (arity)
-           (available-bindings arity ip top-frame?)))
+           (available-bindings frame arity ip top-frame?)))
      (else '()))))
 
 (define (frame-lookup-binding frame var)
@@ -304,22 +306,18 @@
           (else
            (lp (cdr bindings))))))
 
-(define (frame-binding-set! frame var val)
-  (let ((binding (if (binding? var)
-                     var
-                     (or (frame-lookup-binding frame var)
-                         (error "variable not bound in frame" var frame)))))
-    (frame-local-set! frame (binding-slot binding) val
-                      (binding-representation binding))))
-
-(define (frame-binding-ref frame var)
-  (let ((binding (if (binding? var)
-                     var
-                     (or (frame-lookup-binding frame var)
-                         (error "variable not bound in frame" var frame)))))
-    (frame-local-ref frame (binding-slot binding)
-                     (binding-representation binding))))
+(define (binding-ref binding)
+  (frame-local-ref (or (binding-frame binding)
+                       (error "binding has no frame" binding))
+                   (binding-slot binding)
+                   (binding-representation binding)))
 
+(define (binding-set! binding val)
+  (frame-local-set! (or (binding-frame binding)
+                        (error "binding has no frame" binding))
+                    (binding-slot binding)
+                    val
+                    (binding-representation binding)))
 
 (define* (frame-procedure-name frame #:key
                                (info (find-program-debug-info
@@ -443,12 +441,13 @@
        => (lambda (arity)
             (if (and top-frame? (eqv? ip (arity-low-pc arity)))
                 (application-arguments)
-                (reconstruct-arguments (available-bindings arity ip top-frame?)
-                                       (arity-nreq arity)
-                                       (arity-nopt arity)
-                                       (arity-keyword-args arity)
-                                       (arity-has-rest? arity)
-                                       1))))
+                (reconstruct-arguments
+                 (available-bindings frame arity ip top-frame?)
+                 (arity-nreq arity)
+                 (arity-nopt arity)
+                 (arity-keyword-args arity)
+                 (arity-has-rest? arity)
+                 1))))
       ((and (primitive-code? ip)
             (program-arguments-alist (frame-local-ref frame 0 'scm) ip))
        => (lambda (args)
@@ -470,12 +469,12 @@
 
 (define (frame-environment frame)
   (map (lambda (binding)
-        (cons (binding-name binding) (frame-binding-ref frame binding)))
+        (cons (binding-name binding) (binding-ref binding)))
        (frame-bindings frame)))
 
 (define (frame-object-binding frame obj)
   (do ((bs (frame-bindings frame) (cdr bs)))
-      ((or (null? bs) (eq? obj (frame-binding-ref frame (car bs))))
+      ((or (null? bs) (eq? obj (binding-ref (car bs))))
        (and (pair? bs) (car bs)))))
 
 (define (frame-object-name frame obj)