diff options
-rw-r--r-- | doc/ref/api-debug.texi | 32 | ||||
-rw-r--r-- | doc/ref/vm.texi | 37 | ||||
-rw-r--r-- | module/system/repl/debug.scm | 2 | ||||
-rw-r--r-- | 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 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) |