Guile gc experiment: remove global scan variable.
authorJan Nieuwenhuizen <janneke@gnu.org>
Mon, 24 Oct 2016 15:49:40 +0000 (17:49 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Mon, 12 Dec 2016 19:33:48 +0000 (20:33 +0100)
guile/gc.scm

index 12a6ae954869052103b8e7dd90c40da1b661357b..c2505909aadd31692048637e9eab0fb6de6a66e2 100644 (file)
@@ -93,8 +93,8 @@
   (filter gc-pair? (module-map (lambda (x y) (variable-ref y)) (current-module)))
   list1234)
 
-(define new-cars (make-vector (+ gc-size root-size) '(* . *)))
-(define new-cdrs (make-vector (+ gc-size root-size) '(* . *)))
+(define new-cars (make-vector gc-size '(* . *)))
+(define new-cdrs (make-vector gc-size '(* . *)))
 
 #!
      begin-garbage-collection
 
 !#
 
-(define scan 0)
-
 (define (gc)
   (let ((root (gc-root)))
     (display "gc root=") (display root) (newline)
     (set! gc-free 0)
-    (set! scan 0)
-    (gc-loop (gc-relocate root))))
+    (gc-relocate root)
+    (gc-loop 0)))
 
-(define (gc-loop new)
+(define (gc-loop scan)
   (gc-show)
   (gc-show-new)
-  (display "gc-loop new=") (display new) (newline)
   (display "gc-loop scan=") (display scan) (newline)
   (display "gc-loop free=") (display gc-free) (newline)
 
   (if (eq? scan gc-free) (gc-flip)
       (let ((old (vector-ref new-cars scan)))
         (let ((new (gc-relocate old)))
-          (let ((old (gc-update-car new))) 
+          (let ((old (gc-update-car scan new))) 
             (let ((new (gc-relocate old)))
-              (gc-update-cdr new)
-              (gc-loop new)))))))
+              (let ((scan (gc-update-cdr scan new)))
+                (gc-loop scan))))))))
 
-(define (gc-update-car new) ; -> old
+(define (gc-update-car scan new) ; -> old
   (vector-set! new-cars scan new)
   (vector-ref new-cdrs scan))
 
-(define (gc-update-cdr new)
+(define (gc-update-cdr scan new)
   (vector-set! new-cdrs scan new)
-  (set! scan (+ 1 scan)))
+  (+ 1 scan))
 
 (define (broken-heart? c) (eq? (car c) '<))
 (define gc-broken-heart '(< . 3))
 (display "sicp-lst:") (gc-display list1234) (newline)
 (gc-show)
 
+(display "\n**** trigger gc ****\n")
 (define next (gc-list (make-symbol 'N) (make-symbol 'X)))
 (set! list1234 '(p . 0))
 (display "sicp-lst:") (gc-display list1234) (newline)