mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Frame <binding> objects capture frame, can ref value directly

Browse source 
* 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!.
This commit is contained in:
Andy Wingo 2016-01-31 11:15:58 +01:00
parent 67e8aa85e8
commit cd0b61a04e
4 changed files with 76 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

32
doc/ref/api-debug.texi
View file

@ -201,16 +201,32 @@ respectively. @xref{VM Concepts}, for more information.
@deffnx {Scheme Procedure} frame-mv-return-address frame @deffnx {Scheme Procedure} frame-mv-return-address frame
Accessors for the three saved VM registers in a frame: the previous Accessors for the three saved VM registers in a frame: the previous
frame pointer, the single-value return address, and the multiple-value 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 @end deffn
@deffn {Scheme Procedure} frame-num-locals frame @deffn {Scheme Procedure} frame-bindings frame
@deffnx {Scheme Procedure} frame-local-ref frame i Return a list of binding records indicating the local variables that are
@deffnx {Scheme Procedure} frame-local-set! frame i val live in a frame.
Accessors for the temporary values corresponding to @var{frame}'s @end deffn
procedure application. The first local is the first argument given to
the procedure. After the arguments, there are the local variables, and @deffn {Scheme Procedure} frame-lookup-binding frame var
after that temporary values. @xref{Stack Layout}, for more information. 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 @end deffn
@deffn {Scheme Procedure} display-application frame [port [indent]] @deffn {Scheme Procedure} display-application frame [port [indent]]

37
doc/ref/vm.texi
View file

@ -160,10 +160,18 @@ The structure of the top stack frame is as follows:
\------------------/ <- sp \------------------/ <- sp
@end example @end example
In the above drawing, the stack grows downward. Usually the procedure In the above drawing, the stack grows downward. At the beginning of a
being applied is in local 0, followed by the arguments from local 1. function call, the procedure being applied is in local 0, followed by
After that are enough slots to store the various lexically-bound and the arguments from local 1. After the procedure checks that it is being
temporary values that are needed in the function's application. 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 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 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 @smallexample
scheme@@(guile-user)> (define (foo a) (lambda (b) (list foo a b))) scheme@@(guile-user)> (define (foo a) (lambda (b) (list foo a b)))
scheme@@(guile-user)> ,x foo 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 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) 1 (make-closure 1 7 1) ;; anonymous procedure at #xea4d04 (1 free var)
4 (free-set! 1 0 0) ;; free var 0 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 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' 1 (toplevel-box 1 74 58 68 #t) ;; `foo'
6 (box-ref 1 1) 6 (box-ref 1 1)
7 (make-short-immediate 0 772) ;; () at (unknown file):1:28 7 (make-short-immediate 0 772) ;; () at (unknown file):1:28
8 (cons 2 2 0) 8 (cons 2 2 0)
9 (free-ref 3 3 0) ;; free var 0 9 (free-ref 3 3 0) ;; free var 0
11 (cons 3 3 2) 11 (cons 3 3 2)
12 (cons 3 1 3) 12 (cons 2 1 3)
13 (return 3) 13 (return-values 2) ;; 1 value
@end smallexample @end smallexample
First there's some prelude, where @code{foo} checks that it was called First there's some prelude, where @code{foo} checks that it was called

2
module/system/repl/debug.scm
View file

@ -115,7 +115,7 @@
(format port "~aLocal variables:~%" per-line-prefix) (format port "~aLocal variables:~%" per-line-prefix)
(for-each (for-each
(lambda (binding) (lambda (binding)
(let ((v (frame-binding-ref frame binding))) (let ((v (binding-ref binding)))
(display per-line-prefix port) (display per-line-prefix port)
(run-hook before-print-hook v) (run-hook before-print-hook v)
(format port "~a = ~v:@y\n" (binding-name binding) width v))) (format port "~a = ~v:@y\n" (binding-name binding) width v)))

57
module/system/vm/frame.scm
View file

@ -33,10 +33,11 @@
binding-slot binding-slot
binding-representation binding-representation
frame-instruction-pointer-or-primitive-procedure-name
frame-bindings frame-bindings
frame-lookup-binding frame-lookup-binding
frame-binding-ref frame-binding-set! binding-ref binding-set!
frame-instruction-pointer-or-primitive-procedure-name
frame-call-representation frame-call-representation
frame-environment frame-environment
frame-object-binding frame-object-name)) frame-object-binding frame-object-name))
@ -46,8 +47,9 @@
"scm_init_frames_builtins")) "scm_init_frames_builtins"))
(define-record-type <binding> (define-record-type <binding>
(make-binding idx name slot representation) (make-binding frame idx name slot representation)
binding? binding?
(frame binding-frame)
(idx binding-index) (idx binding-index)
(name binding-name) (name binding-name)
(slot binding-slot) (slot binding-slot)
@ -206,7 +208,7 @@
(lp (1+ n) (+ pos (vector-ref parsed n))))) (lp (1+ n) (+ pos (vector-ref parsed n)))))
killv)) killv))
(define (available-bindings arity ip top-frame?) (define (available-bindings frame arity ip top-frame?)
(let* ((defs (list->vector (arity-definitions arity))) (let* ((defs (list->vector (arity-definitions arity)))
(code (arity-code arity)) (code (arity-code arity))
(parsed (parse-code code)) (parsed (parse-code code))
@ -282,7 +284,7 @@
(if n (if n
(match (vector-ref defs n) (match (vector-ref defs n)
(#(name def-offset slot representation) (#(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)))))
'())))) '()))))
(lp (1+ n) (- offset (vector-ref parsed n))))))) (lp (1+ n) (- offset (vector-ref parsed n)))))))
@ -292,7 +294,7 @@
(cond (cond
((find-program-arity ip) ((find-program-arity ip)
=> (lambda (arity) => (lambda (arity)
(available-bindings arity ip top-frame?))) (available-bindings frame arity ip top-frame?)))
(else '())))) (else '()))))
(define (frame-lookup-binding frame var) (define (frame-lookup-binding frame var)
@ -304,22 +306,18 @@
(else (else
(lp (cdr bindings)))))) (lp (cdr bindings))))))
(define (frame-binding-set! frame var val) (define (binding-ref binding)
(let ((binding (if (binding? var) (frame-local-ref (or (binding-frame binding)
var (error "binding has no frame" binding))
(or (frame-lookup-binding frame var) (binding-slot binding)
(error "variable not bound in frame" var frame))))) (binding-representation binding)))
(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-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 (define* (frame-procedure-name frame #:key
(info (find-program-debug-info (info (find-program-debug-info
@ -443,12 +441,13 @@
=> (lambda (arity) => (lambda (arity)
(if (and top-frame? (eqv? ip (arity-low-pc arity))) (if (and top-frame? (eqv? ip (arity-low-pc arity)))
(application-arguments) (application-arguments)
(reconstruct-arguments (available-bindings arity ip top-frame?) (reconstruct-arguments
(arity-nreq arity) (available-bindings frame arity ip top-frame?)
(arity-nopt arity) (arity-nreq arity)
(arity-keyword-args arity) (arity-nopt arity)
(arity-has-rest? arity) (arity-keyword-args arity)
1)))) (arity-has-rest? arity)
1))))
((and (primitive-code? ip) ((and (primitive-code? ip)
(program-arguments-alist (frame-local-ref frame 0 'scm) ip)) (program-arguments-alist (frame-local-ref frame 0 'scm) ip))
=> (lambda (args) => (lambda (args)
@ -470,12 +469,12 @@
(define (frame-environment frame) (define (frame-environment frame)
(map (lambda (binding) (map (lambda (binding)
(cons (binding-name binding) (frame-binding-ref frame binding))) (cons (binding-name binding) (binding-ref binding)))
(frame-bindings frame))) (frame-bindings frame)))
(define (frame-object-binding frame obj) (define (frame-object-binding frame obj)
(do ((bs (frame-bindings frame) (cdr bs))) (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))))) (and (pair? bs) (car bs)))))
(define (frame-object-name frame obj) (define (frame-object-name frame obj)