mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

fix values miscompilation in push context with RA

Browse source 
* module/language/tree-il/compile-glil.scm (flatten-lambda-case): Fix
  miscompilation of `values' in a push context with RA.
* test-suite/tests/tree-il.test: Add low-level test for this
  miscompilation.
This commit is contained in:
Andy Wingo 2012-01-25 10:37:25 +01:00
parent 2b264d7e4f
commit c3d5344a92
2 changed files with 22 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,6 +1,6 @@
;;; TREE-IL -> GLIL compiler
;; Copyright (C) 2001,2008,2009,2010,2011 Free Software Foundation, Inc.
;; Copyright (C) 2001,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -341,13 +341,12 @@
(comp-push proc)
(emit-code src (make-glil-call 'call 0))
(maybe-emit-return))
((1)
(comp-push (car args)))
(else
;; Taking advantage of unspecified order of evaluation of
;; arguments.
(for-each comp-drop (cdr args))
(comp-push (car args)))))
(comp-push (car args))
(maybe-emit-return))))
((vals)
(for-each comp-push args)
(emit-code #f (make-glil-const (length args)))

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

@ -1,7 +1,7 @@
;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*-
;;;; Andy Wingo <wingo@pobox.com> --- May 2009
;;;;
;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -549,7 +549,24 @@
(apply (primitive +)
(apply (primitive values) (const 1) (const 2)))
(program () (std-prelude 0 0 #f) (label _)
(const 1) (call return 1))))
(const 1) (call return 1)))
;; Testing `(values foo)' in push context with RA.
(assert-tree-il->glil without-partial-evaluation
(apply (primitive cdr)
(letrec (lp) (#{lp ~V9KrhVD4PFEL6oCTrLg3A}#)
((lambda ((name . lp))
(lambda-case ((() #f #f #f () ())
(apply (toplevel values) (const (one two)))))))
(apply (lexical lp #{lp ~V9KrhVD4PFEL6oCTrLg3A}#))))
(program () (std-prelude 0 0 #f) (label _)
(branch br _) ;; entering the fix, jump to :2
;; :1 body of lp, jump to :3
(label _) (bind) (const (one two)) (branch br _) (unbind)
;; :2 initial call of lp, jump to :1
(label _) (bind) (branch br _) (label _) (unbind)
;; :3 the push continuation
(call cdr 1) (call return 1))))
;; FIXME: binding info for or-hacked locals might bork the disassembler,
;; and could be tightened in any case