diff options
author | Andy Wingo <wingo@pobox.com> | 2015-11-26 16:47:17 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2015-12-01 10:57:20 +0100 |
commit | e5d7c0f13b51b47115d98874c3a3cd51900ba8a3 (patch) | |
tree | d58040505b0aed46afc871eaaa507def3166f5ee /module/system/vm/debug.scm | |
parent | 02fc5a772bc95bbd70a81b8589bf261a3822f9bd (diff) | |
download | guile-e5d7c0f13b51b47115d98874c3a3cd51900ba8a3.tar.gz |
All arities serialize a "closure" binding
* module/language/cps/compile-bytecode.scm (compile-function): Always
define a 'closure binding in slot 0.
* module/system/vm/frame.scm (available-bindings): No need to futz
around not having a closure binding.
* module/system/vm/debug.scm (arity-arguments-alist): Expect a closure
binding.
* test-suite/tests/rtl.test: Emit definitions for the closure.
Diffstat (limited to 'module/system/vm/debug.scm')
-rw-r--r-- | module/system/vm/debug.scm | 24 |
1 files changed, 13 insertions, 11 deletions
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm index 814472b7a..4d9a047fe 100644 --- a/module/system/vm/debug.scm +++ b/module/system/vm/debug.scm @@ -468,19 +468,21 @@ section of the ELF image. Returns an ELF symbol, or @code{#f}." (flags (arity-flags* bv header)) (nreq (arity-nreq* bv header)) (nopt (arity-nopt* bv header)) - (nargs (+ nreq nopt (if (has-rest? flags) 1 0)))) + (nargs (+ nreq nopt (if (has-rest? flags) 1 0))) + (nargs+closure (1+ nargs))) (when (is-case-lambda? flags) (error "invalid request for locals of case-lambda wrapper arity")) - (let ((args (arity-locals arity nargs))) - (call-with-values (lambda () (split-at args nreq)) - (lambda (req args) - (call-with-values (lambda () (split-at args nopt)) - (lambda (opt args) - `((required . ,req) - (optional . ,opt) - (keyword . ,(arity-keyword-args arity)) - (allow-other-keys? . ,(allow-other-keys? flags)) - (rest . ,(and (has-rest? flags) (car args))))))))))) + (match (arity-locals arity nargs+closure) + ((closure . args) + (call-with-values (lambda () (split-at args nreq)) + (lambda (req args) + (call-with-values (lambda () (split-at args nopt)) + (lambda (opt args) + `((required . ,req) + (optional . ,opt) + (keyword . ,(arity-keyword-args arity)) + (allow-other-keys? . ,(allow-other-keys? flags)) + (rest . ,(and (has-rest? flags) (car args)))))))))))) (define (find-first-arity context base addr) (let* ((bv (elf-bytes (debug-context-elf context))) |