[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 05/41: All arities serialize a "closure" binding
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 05/41: All arities serialize a "closure" binding |
|
Date: |
Wed, 02 Dec 2015 08:06:45 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit e5d7c0f13b51b47115d98874c3a3cd51900ba8a3
Author: Andy Wingo <address@hidden>
Date: Thu Nov 26 16:47:17 2015 +0100
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.
---
module/language/cps/compile-bytecode.scm | 4 +++-
module/system/vm/debug.scm | 24 +++++++++++++-----------
module/system/vm/frame.scm | 4 +---
test-suite/tests/rtl.test | 17 ++++++++++++++---
4 files changed, 31 insertions(+), 18 deletions(-)
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index 1c7b99b..7fa5a00 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -472,7 +472,9 @@
(emit-label asm label)
(set! frame-size (lookup-nlocals label allocation))
(emit-begin-kw-arity asm req opt rest kw-indices allow-other-keys?
- frame-size alt)))
+ frame-size alt)
+ ;; All arities define a closure binding in slot 0.
+ (emit-definition asm 'closure 0 'scm)))
(($ $kargs names vars ($ $continue k src exp))
(emit-label asm label)
(for-each (lambda (name var)
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
index 814472b..4d9a047 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)))
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 6e45279..38850b6 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -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)))))))
diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test
index bae7682..57047a2 100644
--- a/test-suite/tests/rtl.test
+++ b/test-suite/tests/rtl.test
@@ -104,12 +104,13 @@ a procedure."
'((begin-program countdown
((name . countdown)))
(begin-standard-arity (x) 4 #f)
+ (definition closure 0 scm)
(definition x 1 scm)
(br fix-body)
(label loop-head)
(br-if-= 1 2 #f out)
(add 0 1 0)
- (add1 1 1)
+ (add/immediate 1 1 1)
(br loop-head)
(label fix-body)
(load-constant 1 0)
@@ -143,6 +144,7 @@ a procedure."
(begin-program accum
((name . accum)))
(begin-standard-arity (x) 4 #f)
+ (definition closure 0 scm)
(definition x 1 scm)
(free-ref 1 3 0)
(box-ref 0 1)
@@ -164,6 +166,7 @@ a procedure."
'((begin-program call
((name . call)))
(begin-standard-arity (f) 7 #f)
+ (definition closure 0 scm)
(definition f 1 scm)
(mov 1 5)
(call 5 1)
@@ -179,6 +182,7 @@ a procedure."
'((begin-program call-with-3
((name . call-with-3)))
(begin-standard-arity (f) 7 #f)
+ (definition closure 0 scm)
(definition f 1 scm)
(mov 1 5)
(load-constant 0 3)
@@ -196,6 +200,7 @@ a procedure."
'((begin-program call
((name . call)))
(begin-standard-arity (f) 2 #f)
+ (definition closure 0 scm)
(definition f 1 scm)
(mov 1 0)
(tail-call 1)
@@ -209,6 +214,7 @@ a procedure."
'((begin-program call-with-3
((name . call-with-3)))
(begin-standard-arity (f) 2 #f)
+ (definition closure 0 scm)
(definition f 1 scm)
(mov 1 0) ;; R0 <- R1
(load-constant 0 3) ;; R1 <- 3
@@ -234,6 +240,7 @@ a procedure."
(begin-program sqrt-trampoline
((name . sqrt-trampoline)))
(begin-standard-arity (x) 3 #f)
+ (definition closure 0 scm)
(definition x 1 scm)
(cached-toplevel-box 0 sqrt-scope sqrt #t)
(box-ref 2 0)
@@ -264,7 +271,7 @@ a procedure."
(begin-standard-arity () 3 #f)
(cached-toplevel-box 1 top-incrementor *top-val*
#t)
(box-ref 0 1)
- (add1 0 0)
+ (add/immediate 0 0 1)
(box-set! 1 0)
(return-values 1)
(end-arity)
@@ -287,6 +294,7 @@ a procedure."
(begin-program sqrt-trampoline
((name . sqrt-trampoline)))
(begin-standard-arity (x) 3 #f)
+ (definition closure 0 scm)
(definition x 1 scm)
(cached-module-box 0 (guile) sqrt #t #t)
(box-ref 2 0)
@@ -313,7 +321,7 @@ a procedure."
(begin-standard-arity () 3 #f)
(cached-module-box 1 (tests bytecode) *top-val* #f
#t)
(box-ref 0 1)
- (add1 0 0)
+ (add/immediate 0 0 1)
(box-set! 1 0)
(mov 1 0)
(return-values 2)
@@ -359,6 +367,7 @@ a procedure."
(assemble-program
'((begin-program foo ((name . foo)))
(begin-standard-arity () 2 #f)
+ (definition closure 0 scm)
(load-constant 0 42)
(return-values 2)
(end-arity)
@@ -368,6 +377,7 @@ a procedure."
(assemble-program
'((begin-program foo ((name . foo)))
(begin-standard-arity (x y) 3 #f)
+ (definition closure 0 scm)
(definition x 1 scm)
(definition y 2 scm)
(load-constant 1 42)
@@ -380,6 +390,7 @@ a procedure."
(assemble-program
'((begin-program foo ((name . foo)))
(begin-opt-arity (x) (y) z 4 #f)
+ (definition closure 0 scm)
(definition x 1 scm)
(definition y 2 scm)
(definition z 3 scm)
- [Guile-commits] branch master updated (13edcf5 -> 2468871), Andy Wingo, 2015/12/02
- [Guile-commits] 03/41: Remove br-if-equal opcode, Andy Wingo, 2015/12/02
- [Guile-commits] 02/41: Don't compile equal? to br-if-equal, Andy Wingo, 2015/12/02
- [Guile-commits] 04/41: Identify boot continuations by code, not closure, Andy Wingo, 2015/12/02
- [Guile-commits] 01/41: Fix miscompilation of closures allocated as vectors, Andy Wingo, 2015/12/02
- [Guile-commits] 08/41: Add frame-procedure-name, Andy Wingo, 2015/12/02
- [Guile-commits] 06/41: Apply of non-programs has IP that is not from prev frame, Andy Wingo, 2015/12/02
- [Guile-commits] 07/41: Remove primitive?, add primitive-code?, Andy Wingo, 2015/12/02
- [Guile-commits] 10/41: More robust low-level frame printer, Andy Wingo, 2015/12/02
- [Guile-commits] 05/41: All arities serialize a "closure" binding,
Andy Wingo <=
- [Guile-commits] 12/41: ,registers doesn't use frame-procedure, Andy Wingo, 2015/12/02
- [Guile-commits] 11/41: Better frame-call-representation printing of GC clobbers, Andy Wingo, 2015/12/02
- [Guile-commits] 09/41: frame-call-representation avoids frame-procedure., Andy Wingo, 2015/12/02
- [Guile-commits] 15/41: Remove frame-procedure, Andy Wingo, 2015/12/02
- [Guile-commits] 13/41: Remove `procedure' repl command, Andy Wingo, 2015/12/02
- [Guile-commits] 14/41: VM traps don't match on value of slot 0, Andy Wingo, 2015/12/02
- [Guile-commits] 17/41: Remove frame->module, Andy Wingo, 2015/12/02
- [Guile-commits] 19/41: Add bv-length instruction, Andy Wingo, 2015/12/02
- [Guile-commits] 18/41: Range inference over the full U64+S64 range, Andy Wingo, 2015/12/02
- [Guile-commits] 20/41: bv-f{32, 64}-{ref, set!} take unboxed u64 index, Andy Wingo, 2015/12/02