mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-22 04:30:19 +02:00
Code Activity

use anonymous mv-bind in compile-glil.scm; fix abort compilation bug

Browse source 
* module/language/tree-il/compile-glil.scm (flatten): Change to use the
  anonymous <glil-mv-bind> form when truncating to 0 or 1 values. In
  those cases, remove the <glil-unbind> statements. As a side effect,
  fixes compilation of abort in a "values" context.

  Thanks to Tristan Colgate for the bug report.

* test-suite/tests/tree-il.test: Update to expect anonymous mv-bind.
This commit is contained in:
Andy Wingo 2010-03-03 20:57:18 +01:00
parent a5c96cb99d
commit 05c51bcff5
2 changed files with 6 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

8
module/language/tree-il/compile-glil.scm
View file

@ -496,8 +496,7 @@
(emit-code #f (make-glil-call 'drop 1))
(emit-branch #f 'br (or RA POST))
(emit-label MV)
(emit-code #f (make-glil-mv-bind '() #f))
(emit-code #f (make-glil-unbind))
(emit-code #f (make-glil-mv-bind 0 #f))
(if RA
(emit-branch #f 'br RA)
(emit-label POST)))))))))
@ -1124,12 +1123,11 @@
(emit-code #f (make-glil-call 'return/nvalues 1)))
((drop)
;; Drop all values and goto RA, or otherwise fall through.
(emit-code #f (make-glil-mv-bind '() #f))
(emit-code #f (make-glil-unbind))
(emit-code #f (make-glil-mv-bind 0 #f))
(if RA (emit-branch #f 'br RA)))
((push)
;; Truncate to one value.
(emit-code #f (make-glil-mv-bind '(val) #f)))
(emit-code #f (make-glil-mv-bind 1 #f)))
((vals)
;; Go to MVRA.
(emit-branch #f 'br MVRA)))))))

6
test-suite/tests/tree-il.test
View file

@ -74,7 +74,7 @@
(begin (apply (toplevel foo) (const 1)) (void))
(program () (std-prelude 0 0 #f) (label _) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1)
(call drop 1) (branch br ,l2)
(label ,l3) (mv-bind () #f) (unbind)
(label ,l3) (mv-bind 0 #f)
(label ,l4)
(void) (call return 1))
(and (eq? l1 l3) (eq? l2 l4)))
@ -461,7 +461,7 @@
(begin (apply (primitive @apply) (toplevel foo) (toplevel bar)) (void))
(program () (std-prelude 0 0 #f) (label _)
(call new-frame 0) (toplevel ref apply) (toplevel ref foo) (toplevel ref bar) (mv-call 2 ,l1)
(call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
(call drop 1) (branch br ,l2) (label ,l3) (mv-bind 0 #f)
(label ,l4)
(void) (call return 1))
(and (eq? l1 l3) (eq? l2 l4)))
@ -480,7 +480,7 @@
(begin (apply (primitive @call-with-current-continuation) (toplevel foo)) (void))
(program () (std-prelude 0 0 #f) (label _)
(call new-frame 0) (toplevel ref call-with-current-continuation) (toplevel ref foo) (mv-call 1 ,l1)
(call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
(call drop 1) (branch br ,l2) (label ,l3) (mv-bind 0 #f)
(label ,l4)
(void) (call return 1))
(and (eq? l1 l3) (eq? l2 l4)))