093-gc-reclaim.scm (973B)
1 ; Manual collection reclaims unreachable managed blocks and heap-usage 2 ; reports physical bytes, including allocation headers. 3 4 (define (make-garbage n) 5 (let loop ((i n) (xs '())) 6 (if (= i 0) 7 #f 8 (loop (- i 1) 9 (cons (make-bytevector (+ 8 (remainder i 31)) i) xs))))) 10 11 (collect-garbage) 12 (define baseline (heap-usage)) 13 (make-garbage 240) 14 (define peak (heap-usage)) 15 (collect-garbage) 16 (define reclaimed (heap-usage)) 17 18 (if (> peak baseline) 0 (sys-exit 1)) 19 (if (< reclaimed peak) 0 (sys-exit 2)) 20 21 ; A second differently-sized allocation wave exercises first-fit splitting. 22 ; After collection it must return to roughly the same live set rather than 23 ; growing monotonically as a bump arena would. 24 (make-garbage 180) 25 (define peak2 (heap-usage)) 26 (collect-garbage) 27 (define reclaimed2 (heap-usage)) 28 (if (> peak2 reclaimed) 0 (sys-exit 3)) 29 (if (< reclaimed2 peak2) 0 (sys-exit 4)) 30 (if (< reclaimed2 (+ reclaimed 4096)) 0 (sys-exit 5)) 31 32 (sys-exit 42)