flan/test/programs/fn-vec-stale.flan

41 lines
1.4 KiB
Plaintext

;; A Vec header is copied by value, so a copy goes stale when another copy's
;; push moves the block, and the old block is freed — large enough here that
;; malloc hands it back to the system. The collector marks through every
;; header it can see, the stale copy included, and must read only a block it
;; knows to be live: a Vec of closures, and a Vec of Vecs of closures, whose
;; freed elements would otherwise be read as headers.
(declare gc-collect [] () "flan_gc_collect")
(defn make-adder [n i64] (Fn [i64] i64) (fn [x] (+ x n)))
(defn counter [v (Vec (Fn [i64] i64))] (Fn [] i64) (fn [] (i64 (length v))))
(defn flat [] ()
(let [fs (vec-new (Fn [i64] i64))]
(dotimes [i 20000] (push fs (make-adder i)))
(let [c (counter fs)
old fs]
(dotimes [i 200000] (push fs (make-adder i)))
(gc-collect)
(println (c) (length old) (length fs) ((at fs 219999) 1)))))
(defn nested [] ()
(let [a (arena-new 67108864)
outer (vec-new (Vec (Fn [i64] i64)) a)]
(dotimes [i 20000]
(let [inner (vec-new (Fn [i64] i64) a)]
(push inner (make-adder i))
(push outer inner)))
(let [old outer]
(dotimes [i 200000]
(let [inner (vec-new (Fn [i64] i64) a)]
(push inner (make-adder i))
(push outer inner)))
(gc-collect)
(println (length old) (length outer) ((at (at outer 219999) 0) 1)))))
(defn main [] i32
(flat)
(nested)
0)