mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00
Code Activity

All arities serialize a "closure" binding

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2015-11-26 16:47:17 +01:00
parent 02fc5a772b
commit e5d7c0f13b
4 changed files with 31 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

24
module/system/vm/debug.scm
View file

@ -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)))

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

@ -277,9 +277,7 @@
(if n
(match (vector-ref defs n)
(#(name def-offset slot representation)
;; Binding 0 is the closure, and is not present
;; in arity-definitions.
(cons (make-binding (1+ n) name slot representation)
(cons (make-binding n name slot representation)
(lp (1+ n)))))
'()))))
(lp (1+ n) (- offset (vector-ref parsed n)))))))