guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-6-gfb135e1


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-6-gfb135e1
Date: Wed, 09 Nov 2011 22:46:06 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=fb135e12a473fd9a1612a59f904cfb90877fe775

The branch, stable-2.0 has been updated
       via  fb135e12a473fd9a1612a59f904cfb90877fe775 (commit)
      from  acdf4fcc059df325f66698090359b3455725c865 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit fb135e12a473fd9a1612a59f904cfb90877fe775
Author: Andy Wingo <address@hidden>
Date:   Wed Nov 9 23:45:53 2011 +0100

    when leaving a non-tail let, allow bound vals to be collected
    
    * module/language/tree-il/compile-glil.scm (flatten-lambda-case): Clear
      lexical stack slots at the end of a non-tail let, letrec, or fix.
      Fixes http://debbugs.gnu.org/9900.
    
    * test-suite/tests/gc.test ("gc"): Add test.

-----------------------------------------------------------------------

Summary of changes:
 module/language/tree-il/compile-glil.scm |   22 ++++++++++++++++++++++
 test-suite/tests/gc.test                 |   28 +++++++++++++++++++---------
 2 files changed, 41 insertions(+), 9 deletions(-)

diff --git a/module/language/tree-il/compile-glil.scm 
b/module/language/tree-il/compile-glil.scm
index 3daac7f..de55026 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -237,6 +237,24 @@
           (if (eq? context 'tail)
               (emit-code #f (make-glil-call 'return 1)))))
     
+    ;; After lexical binding forms in non-tail context, call this
+    ;; function to clear stack slots, allowing their previous values to
+    ;; be collected.
+    (define (clear-stack-slots context syms)
+      (case context
+        ((push drop)
+         (for-each (lambda (v)
+                     (and=>
+                      ;; Can be #f if the var is labels-allocated.
+                      (hashq-ref allocation v)
+                      (lambda (h)
+                        (pmatch (hashq-ref h self)
+                          ((#t _ . ,n)
+                           (emit-code #f (make-glil-void))
+                           (emit-code #f (make-glil-lexical #t #f 'set n)))
+                          (,loc (error "bad let var allocation" x loc))))))
+                   syms))))
+
     (record-case x
       ((<void>)
        (case context
@@ -802,6 +820,7 @@
                      (,loc (error "bad let var allocation" x loc))))
                  (reverse gensyms))
        (comp-tail body)
+       (clear-stack-slots context gensyms)
        (emit-code #f (make-glil-unbind)))
 
       ((<letrec> src in-order? names gensyms vals body)
@@ -834,6 +853,7 @@
                        (,loc (error "bad letrec var allocation" x loc))))
                    (reverse gensyms))))
        (comp-tail body)
+       (clear-stack-slots context gensyms)
        (emit-code #f (make-glil-unbind)))
 
       ((<fix> src names gensyms vals body)
@@ -922,6 +942,7 @@
          (comp-tail body)
          (if new-RA
              (emit-label new-RA))
+         (clear-stack-slots context gensyms)
          (emit-code #f (make-glil-unbind))))
 
       ((<let-values> src exp body)
@@ -947,6 +968,7 @@
                           (,loc (error "bad let-values var allocation" x 
loc))))
                       (reverse gensyms))
             (comp-tail body)
+            (clear-stack-slots context gensyms)
             (emit-code #f (make-glil-unbind))))))
 
       ;; much trickier than i thought this would be, at first, due to the need
diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test
index 57643e8..25dc577 100644
--- a/test-suite/tests/gc.test
+++ b/test-suite/tests/gc.test
@@ -16,8 +16,10 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
 
-(use-modules (ice-9 documentation)
-            (test-suite lib))
+(define-module (test-suite tests gc)
+  #:use-module (ice-9 documentation)
+  #:use-module (test-suite lib)
+  #:use-module ((system base compile) #:select (compile)))
 
 
 ;;;
@@ -62,10 +64,8 @@
       (add-hook! after-gc-hook thunk)
       (gc)
       (remove-hook! after-gc-hook thunk)
-      foo)))
+      foo))
 
-
-(with-test-prefix "gc"
   (pass-if "Unused modules are removed"
     (let* ((guard (make-guardian))
            (total 1000))
@@ -76,12 +76,22 @@
       (stack-cleanup 20)
 
       (gc)
-      (gc) ;; twice: have to kill the weak vectors.
-      (gc) ;; thrice: because the test doesn't succeed with only
-           ;; one gc round. not sure why.
+      (gc)   ;; twice: have to kill the weak vectors.
+      (gc)   ;; thrice: because the test doesn't succeed with only
+      ;; one gc round. not sure why.
 
       (= (let lp ((i 0))
            (if (guard)
                (lp (1+ i))
                i))
-         total))))
+         total)))
+
+  (pass-if "Lexical vars are collectable"
+    (procedure?
+     (compile
+      '(begin
+         (define guardian (make-guardian))
+         (let ((f (lambda () (display "test\n"))))
+           (guardian f))
+         (gc)(gc)(gc)
+         (guardian))))))


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]