summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/ref/api-debug.texi32
-rw-r--r--doc/ref/vm.texi37
-rw-r--r--module/system/repl/debug.scm2
-rw-r--r--module/system/vm/frame.scm57
4 files changed, 76 insertions, 52 deletions
diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index 459371fa7..a6cfd7b03 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
-@deffn {Scheme Procedure} frame-num-locals frame
-@deffnx {Scheme Procedure} frame-local-ref frame i
-@deffnx {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.
+@deffn {Scheme Procedure} frame-bindings frame
+Return a list of binding records indicating the local variables that are
+live in a frame.
+@end deffn
+
+@deffn {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.
+@end deffn
+
+@deffn {Scheme Procedure} binding-index binding
+@deffnx {Scheme Procedure} binding-name binding
+@deffnx {Scheme Procedure} binding-slot binding
+@deffnx {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.
+@end deffn
+
+@deffn {Scheme Procedure} binding-ref binding
+@deffnx {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 f97a009b5..097fb8b75 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 4bd9e2758..274ebdd00 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 15e745d18..565177e4c 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)