56 lines
2.3 KiB
Plaintext
56 lines
2.3 KiB
Plaintext
;;;; Enough allocation that the collector actually runs, with live dyn values
|
|
;;;; held across it.
|
|
;;;;
|
|
;;;; Every other dyn program in this repository allocates a handful of objects
|
|
;;;; and stops. runtime/flan_dyn.c's trigger has a one-megabyte floor, so none
|
|
;;;; of them ever crosses it and none of them collects even once — which means
|
|
;;;; that until this file existed, a program whose root discipline was entirely
|
|
;;;; wrong printed the right answer on both backends. The dyn handoff said that
|
|
;;;; about the stub that never collected; the stub is gone and the observation
|
|
;;;; outlived it, because a heap that never fills is a collector that never
|
|
;;;; runs.
|
|
;;;;
|
|
;;;; So this one allocates well past the floor while holding values the
|
|
;;;; collector must not free: a vector that grows for the whole run, a text
|
|
;;;; allocated before the loop and read after it, and a running total. The
|
|
;;;; garbage is the per-iteration vector that nothing keeps, and there is a lot
|
|
;;;; of it.
|
|
;;;;
|
|
;;;; What a lost root looks like here is not a wrong number. It is a use of
|
|
;;;; freed memory — a crash, or a word that decodes as some other tag and traps
|
|
;;;; with a sentence about the wrong type. Either way the two backends stop
|
|
;;;; saying the same thing, which is what the sweep asks.
|
|
|
|
;;; Held in locals across every allocation the loop makes, which are the slots
|
|
;;; the entry block roots. Returned, so the vector is live to the last line.
|
|
(defn build [n dyn] dyn
|
|
(let [xs (vec-new dyn)
|
|
i 0]
|
|
(while (< i n)
|
|
;; Fresh and unreferenced: this is the garbage. Four pushes each, so the
|
|
;; items array is allocated too and the heap moves quickly.
|
|
(let [junk (vec-new dyn)]
|
|
(push junk i)
|
|
(push junk "row")
|
|
(push junk 2.5)
|
|
(push junk true))
|
|
;; Every sixteenth iteration keeps one, so the live vector grows *through*
|
|
;; the collections rather than only between them.
|
|
(if (= 0 (% i 16)) (push xs i))
|
|
(set i (+ i 1)))
|
|
xs))
|
|
|
|
(defn main [] ()
|
|
;; Allocated before the loop runs and read after it, which is the check that
|
|
;; main's own root outlived every collection build triggered.
|
|
(let [keep "kept"
|
|
xs (build 40000)]
|
|
(print (length xs))
|
|
(print "\n")
|
|
(print (at xs 0))
|
|
(print "\n")
|
|
(print (at xs (- (length xs) 1)))
|
|
(print "\n")
|
|
(print keep)
|
|
(print "\n")))
|