1;;;; symbolgc-tests.scm 2 3(import (chicken gc) (chicken format) (chicken keyword)) 4 5;; Ensure counts are defined before creating the disposable symbols. 6;; This way, this program can also be run in interpreted mode. 7(define *count-before* #f) 8(define *count-after* #f) 9 10;; Force major GC to ensure there are no collectible symbols left 11;; before we start, otherwise the GC might clean these up and we'd end 12;; up with less symbols than we started with! 13(gc #t) 14 15(set! *count-before* (vector-ref (##sys#symbol-table-info) 2)) 16 17(print "starting with " *count-before* " symbols") 18 19(print "interning 10000 symbols ...") 20 21(do ((i 10000 (sub1 i))) 22 ((zero? i)) 23 (string->symbol (sprintf "%%%~a%%%" i))) 24 25(print "recovering ...") 26 27;; Force major GC, which should reclaim every last symbol we just 28;; created, as well as "i", the loop counter. 29(gc #t) 30 31;; Don't use LET, which would introduce a fresh identifier, which is a 32;; new symbol (at least, in interpreted mode) 33(set! *count-after* (vector-ref (##sys#symbol-table-info) 2)) 34(print (- *count-after* *count-before*) " newly interned symbols left") 35(unless (= *count-after* *count-before*) 36 (error "unable to reclaim all symbols")) 37 38(print "interning 10000 keywords ...") 39 40(do ((i 10000 (sub1 i))) 41 ((zero? i)) 42 (string->keyword (sprintf "kw-%%%~a%%%" i))) 43 44(print "recovering ...") 45(gc #t) 46(set! *count-after* (vector-ref (##sys#symbol-table-info) 2)) 47(print* (- *count-after* *count-before*) " newly interned leywords left") 48(unless (= *count-after* *count-before*) 49 (error "unable to reclaim all keywords")) 50 51(print "\ndone.") 52