mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

Fix constant-needs-allocation? for $values uses

Browse source 
* module/language/cps/dfg.scm (constant-needs-allocation?): Use of a
  constant in a $values expression of any arity does not cause slot
  allocation.

* module/language/cps/compile-bytecode.scm (compile-fun): Allow $values
  with a constant value to be compiled in test context.  Really we
  should fold these in a previous pass!
This commit is contained in:
Andy Wingo 2013-12-16 13:48:59 +01:00
parent d20b4a1cd2
commit 58ef5f0712
2 changed files with 12 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

12
module/language/cps/compile-bytecode.scm
View file

@ -421,7 +421,17 @@
(unless (eq? kf next-label)
(emit-br asm kf)))))
(match exp
(($ $values (sym)) (unary emit-br-if-true sym))
(($ $values (sym))
(call-with-values (lambda ()
(lookup-maybe-constant-value sym allocation))
(lambda (has-const? val)
(if has-const?
(if val
(unless (eq? kt next-label)
(emit-br asm kt))
(unless (eq? kf next-label)
(emit-br asm kf)))
(unary emit-br-if-true sym)))))
(($ $primcall 'null? (a)) (unary emit-br-if-null a))
(($ $primcall 'nil? (a)) (unary emit-br-if-nil a))
(($ $primcall 'pair? (a)) (unary emit-br-if-pair a))

2
module/language/cps/dfg.scm
View file

@ -846,7 +846,7 @@
(lambda (use)
(match (find-expression (lookup-cont use conts))
(($ $call) #f)
(($ $values (_ _ . _)) #f)
(($ $values) #f)
(($ $primcall 'free-ref (closure slot))
(not (eq? sym slot)))
(($ $primcall 'free-set! (closure slot value))