Guile gc experiment: remove global scan variable.

This commit is contained in:
Jan Nieuwenhuizen 2016-10-24 17:49:40 +02:00
parent 8fbe7f1b32
commit 3249db47b0

View file

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