flan/test/programs/dyn-held-operand.flan

105 lines
3.2 KiB
Plaintext

;;;; A dyn value read out of a place, held while a sibling operand runs.
;;;;
;;;; Every line below reads the vector in [other] into an operand position —
;;;; a call's argument, a struct literal's field, an array literal's element,
;;;; a runtime call's argument, a function value's argument, the array an
;;;; index is taken of — and then runs a
;;;; sibling that overwrites [other] and allocates enough to collect. Once
;;;; [other] is overwritten, the only reference to the vector is the operand
;;;; being held, so unless that operand has a root of its own the collection
;;;; frees it and the line prints whatever the freed block holds next.
;;;;
;;;; [churn] ends in an explicit collection, so each line is tested against a
;;;; collection that certainly ran and not against the trigger's timing.
(defstruct T [d dyn n i64])
(defstruct W [t T k i64])
(defstruct A2 [xs [2 dyn]])
(declare gc-collect [] () "flan_gc_collect")
(defonce other T)
(defonce dst T)
(defonce pair [2 dyn])
(defonce w W)
(defn churn [] i64
(let [i 0]
(while (< i 2000)
(let [v (vec-new dyn)] (push v i) (push v "junk"))
(set i (+ i 1)))
(gc-collect)
7))
(defn kept [] dyn
(let [v (vec-new dyn)] (push v "kept") (push v 42) v))
;;; A fresh vector in [other], old enough that it is no longer among the
;;; collector's most recent allocations.
(defn fill [] () (set (.d other) (kept)) (churn))
;;; Overwrite [other], then allocate and collect.
(defn clobber [] i64 (set other (T {.n 0})) (churn))
(defn clobber-dyn [] dyn (clobber) (vec-new dyn))
(defn clobber-idx [] i32 (clobber) 0)
(defn pick [x dyn n i64] dyn x)
(defn pick-t [t T n i64] dyn (.d t))
(defn show [label str v dyn] ()
(churn)
(println label (at v 0) (at v 1)))
(defn main [] ()
;; A call's argument.
(fill)
(set (.d dst) (pick (.d other) (clobber)))
(show "call:" (.d dst))
;; A struct literal's field.
(fill)
(set dst (T {.d (.d other) .n (clobber)}))
(show "struct:" (.d dst))
;; An array literal's element.
(fill)
(set pair [(.d other) (clobber-dyn)])
(show "array:" (at pair 0))
;; A runtime call's argument: dyn equality is a call into the runtime, and
;; its first operand is held while the second is computed.
(fill)
(println "runtime:" (= (.d other) (do (clobber) (kept))))
;; A local, overwritten by the sibling rather than a global.
(fill)
(let [x (.d other)]
(set (.d dst) (pick x (do (set x 0) (clobber))))
(show "local:" (.d dst)))
;; A whole struct with a dyn field in it, passed by value.
(fill)
(set (.d dst) (pick-t other (clobber)))
(show "aggregate:" (.d dst))
;; The same struct as a field of a struct literal.
(fill)
(set w (W {.t other .k (clobber)}))
(show "nested:" (.d (.t w)))
;; Through a function value.
(fill)
(let [g pick]
(set (.d dst) (g (.d other) (clobber)))
(show "fn value:" (.d dst)))
;; An array literal indexed while the index runs: the array is a temporary
;; taken by address, and the temporary is what is held.
(fill)
(set (.d dst) (at [(.d other) (.d other)] (clobber-idx)))
(show "index:" (.d dst))
;; The same through a field of a struct literal.
(fill)
(set (.d dst) (at (.xs (A2 {.xs [(.d other) (.d other)]})) (clobber-idx)))
(show "field index:" (.d dst)))