mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 01:30:27 +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

17
test-suite/tests/rtl.test
View file

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