123-gc-symbol-roots.scm (833B)
1 ; Symbol names and global bindings are explicit collector roots. 2 3 (define alpha-long-lived (cons 'alpha-name 17)) 4 (define beta-long-lived (bytevector 4 5 6)) 5 6 (define (intern-and-drop n) 7 (if (= n 0) 8 #t 9 (begin 10 ; Parsing this program interns all of these identifiers before eval; 11 ; allocation pressure still exercises symbol-root tracing repeatedly. 12 (cons 'temporary-name (make-bytevector 32 n)) 13 (intern-and-drop (- n 1))))) 14 15 (intern-and-drop 160) 16 (collect-garbage) 17 (collect-garbage) 18 19 (if (eq? (car alpha-long-lived) 'alpha-name) 0 (sys-exit 1)) 20 (if (= (cdr alpha-long-lived) 17) 0 (sys-exit 2)) 21 (if (= (bytevector-u8-ref beta-long-lived 1) 5) 0 (sys-exit 3)) 22 (set! alpha-long-lived (cons 'alpha-name 42)) 23 (collect-garbage) 24 (if (= (cdr alpha-long-lived) 42) 0 (sys-exit 4)) 25 26 (sys-exit 42)