335 lines
11 KiB
Plaintext
335 lines
11 KiB
Plaintext
;;;; Any typed container crosses into dyn as a view: every element type and
|
|
;;;; any storage. Mode 0 is the survey; the others are one trap each, since a
|
|
;;;; trap ends the process. test_acceptance.ml runs it on both backends, and
|
|
;;;; the stale-view modes under --dev only: a release build keeps no record of
|
|
;;;; frames or blocks, so it neither checks nor promises anything there.
|
|
|
|
;; Unannotated parameters and returns are dyn: every call below boxes its
|
|
;; typed argument into a view at the call.
|
|
(defn show [label d] ()
|
|
(print label)
|
|
(print " ")
|
|
(println d))
|
|
|
|
(defn bump-all [d] ()
|
|
(dotimes [i (length d)]
|
|
(set (at d i) (+ (at d i) 1))))
|
|
|
|
(defn keep [d] dyn d)
|
|
|
|
;; Field offsets only C's layout rule gets right: a u8, then an i64 aligned
|
|
;; to 8, an f32, a bool, three u16 at 2, an i32 at 4.
|
|
(defstruct Mix [a u8 b i64 c f32 d bool e [3 u16] f i32])
|
|
(defstruct Point [x f32 y i32])
|
|
(defstruct Named [name str id u32])
|
|
(defstruct Wide [a u64 b i64])
|
|
(defstruct Small [x i8 z bool])
|
|
|
|
(declare gc-collect [] () "flan_gc_collect")
|
|
(declare gc-live-bytes [] i64 "flan_gc_live_bytes")
|
|
(defonce g3 [3 i64])
|
|
(defn first-of [d] dyn (at d 0))
|
|
|
|
(defn make-point [] Point (Point {.x 1.5 .y 2}))
|
|
|
|
(defn param-array [xs [4 i32]] i32
|
|
;; A parameter array is this frame's copy.
|
|
(bump-all xs)
|
|
(at xs 3))
|
|
|
|
(defn param-slice [xs [i64]] ()
|
|
(bump-all xs))
|
|
|
|
(defonce held dyn nil)
|
|
|
|
;; A view of a local, kept past the call that owns the local.
|
|
(defn leak-local [] ()
|
|
(let [a [1 2 3]]
|
|
(set held (keep a))))
|
|
|
|
(defn stash [d] () (set held d))
|
|
|
|
;; A slice of a local, crossing where the compiler cannot tie it to a frame:
|
|
;; bound to a local first, and passed through a slice parameter.
|
|
(defn leak-slice-local [] ()
|
|
(let [a [(i64 5) 6 7]
|
|
s (slice a 0 3)]
|
|
(stash s)))
|
|
(defn via-slice [xs [i64]] () (stash xs))
|
|
(defn leak-slice-param [] ()
|
|
(let [a [(i64 5) 6 7]]
|
|
(via-slice (slice a 0 3))))
|
|
|
|
(defn doubled [n i32] dyn
|
|
(let [v (the dyn [1 2])]
|
|
(dotimes [i n] (set v (the dyn [v v])))
|
|
v))
|
|
|
|
(defn clobber [] i64
|
|
(let [b [(i64 7) 8 9 10 11 12]]
|
|
(+ (at b 0) (at b 5))))
|
|
|
|
(defn main [args [str]] i32
|
|
(let [n (i32 (bytes->i64 (bytes-view (at args 1))))]
|
|
(cond
|
|
(= n 0)
|
|
(do
|
|
;; Every integer width, a local array each: read widens, write stores.
|
|
(let [a [(i8 -1) -2 -3]
|
|
b [(u8 250) 251 252]
|
|
c [(i16 -300) 300]
|
|
d [(u16 60000) 1]
|
|
e [(i32 -70000) 70000]
|
|
f [(u32 4000000000) 1]
|
|
g [(i64 -5) 5]
|
|
h [(u64 9000000000000000000) 1]]
|
|
(bump-all a) (bump-all b) (bump-all c) (bump-all d)
|
|
(bump-all e) (bump-all f) (bump-all g) (bump-all h)
|
|
(show "i8" a) (show "u8" b) (show "i16" c) (show "u16" d)
|
|
(show "i32" e) (show "u32" f) (show "i64" g) (show "u64" h)
|
|
(println (at b 2)))
|
|
;; f32: read widens, write narrows, and an int goes in when the f32
|
|
;; holds it exactly.
|
|
(let [fs [(f32 0.5) 1.25]
|
|
dv (keep fs)]
|
|
(set (at dv 0) 2.75)
|
|
(set (at dv 1) 3.1)
|
|
(show "f32" dv)
|
|
(set (at dv 0) 4)
|
|
(println (at fs 0)))
|
|
;; bool, through a slice cut from a local array.
|
|
(let [bs [true false true]]
|
|
(let [dv (keep (slice bs 0 3))]
|
|
(set (at dv 1) true)
|
|
(show "bool" dv)
|
|
(println (at bs 1))))
|
|
;; The author's case: a [u8] from bytes, sorted in place by dyn code.
|
|
(let [text (bytes "INSERTIONSORT")]
|
|
(let [d (keep text)]
|
|
(dotimes [i (length d)]
|
|
(let [j i]
|
|
(while (and (> j 0) (< (at d j) (at d (- j 1))))
|
|
(let [t (at d j)]
|
|
(set (at d j) (at d (- j 1)))
|
|
(set (at d (- j 1)) t))
|
|
(set j (- j 1))))))
|
|
(println (str text)))
|
|
;; A struct: a map-like view, written through get and put.
|
|
(let [p (Point {.x 0.5 .y 3})
|
|
dp (keep p)]
|
|
(show "point" dp)
|
|
(set (get dp :y) 40)
|
|
(put dp :x 9.5)
|
|
(println (.y p))
|
|
(println (.x p))
|
|
(println (get dp :x))
|
|
(println (length dp))
|
|
(println (has-key? dp :y)))
|
|
;; Every field of a padded struct reads back.
|
|
(let [m (Mix {.a 7 .b -9000000000 .c 2.5 .d true .e [1 2 3] .f -4})]
|
|
(show "mix" (keep m))
|
|
(set (at (get (keep m) :e) 2) 65535)
|
|
(println (at (.e m) 2)))
|
|
;; A str field reads as text.
|
|
(let [nm (Named {.name "ada" .id 7})]
|
|
(show "named" (keep nm)))
|
|
;; Nested arrays: a view of a view.
|
|
(let [grid [[(i32 1) 2 3] [4 5 6]]
|
|
dg (keep grid)]
|
|
(set (at (at dg 1) 2) 60)
|
|
(show "grid" dg)
|
|
(println (at (at grid 1) 2)))
|
|
;; An array of structs.
|
|
(let [ps [(Point {.x 1.0 .y 1}) (Point {.x 2.0 .y 2})]
|
|
dp (keep ps)]
|
|
(set (get (at dp 1) :y) 20)
|
|
(show "points" dp)
|
|
(println (.y (at ps 1))))
|
|
;; A Vec in a local: a push through the view grows the typed Vec.
|
|
(let [v (vec-new i32)]
|
|
(push v 1)
|
|
(let [dv (keep v)]
|
|
(push dv 2)
|
|
(push dv 3)
|
|
(show "vec" dv))
|
|
(println (length v)))
|
|
;; A Vec of structs.
|
|
(let [v (vec-new Point)]
|
|
(push v (Point {.x 0.0 .y 5}))
|
|
(let [dv (keep v)]
|
|
(set (get (at dv 0) :y) 6))
|
|
(println (.y (at v 0))))
|
|
;; Parameters: an array parameter is the callee's copy; a slice
|
|
;; parameter sees the caller's elements.
|
|
(let [xs [(i32 1) 2 3 4]]
|
|
(println (param-array xs))
|
|
(println (at xs 3)))
|
|
(let [ys [(i64 1) 2]]
|
|
(param-slice (slice ys 0 2))
|
|
(println (at ys 1)))
|
|
;; A temporary: a struct returned by a call.
|
|
(show "temp" (keep (make-point)))
|
|
;; A heap slice, and an arena's Vec.
|
|
(let [c (clone (slice [(i64 1) 2 3] 0 3))]
|
|
(bump-all c)
|
|
(println (at c 2)))
|
|
(let [ar (arena-new 4096)]
|
|
(with-allocator ar
|
|
(let [v (vec-new i16)]
|
|
(push v 1)
|
|
(push v 2)
|
|
(bump-all v)
|
|
(println (at v 1))))
|
|
(arena-destroy ar))
|
|
;; Two views of equal structs are equal.
|
|
(let [p (Point {.x 1.0 .y 2})
|
|
q (Point {.x 1.0 .y 2})]
|
|
(println (= (keep p) (keep q))))
|
|
;; .field and [:k] on a struct's view: a read is get, a set is put,
|
|
;; and the typed struct sees every write.
|
|
(let [p (Point {.x 1.0 .y 2})
|
|
m (Mix {.a 1 .b 2 .c 0.5 .d false .e [1 2 3] .f 4})
|
|
dp (keep p)
|
|
dm (keep m)]
|
|
(set (.y dp) 5)
|
|
(update (.y dp) + 10)
|
|
(set (at dp :x) 2.5)
|
|
(set (.d dm) true)
|
|
(set (at (.e dm) 1) 20)
|
|
(println (.y dp) (at dp :x) (.a dm) (.d dm) (at (.e dm) 1))
|
|
(println (.y p) (.x p) (.d m) (at (.e m) 1)))
|
|
0)
|
|
;; A value an element's width cannot hold.
|
|
(= n 1)
|
|
(let [b [(u8 1) 2]]
|
|
(set (at (keep b) 0) 300)
|
|
0)
|
|
;; A u64 above the largest dyn int.
|
|
(= n 2)
|
|
(let [h [(u64 18000000000000000000)]]
|
|
(println (at (keep h) 0))
|
|
0)
|
|
;; A field a struct does not have.
|
|
(= n 3)
|
|
(let [p (Point {.x 1.0 .y 2})]
|
|
(println (get (keep p) :z))
|
|
0)
|
|
;; A view of a local, used after its call returned: stale in a dev build.
|
|
(= n 4)
|
|
(do (leak-local)
|
|
(println (clobber))
|
|
(println (at held 0))
|
|
0)
|
|
;; A slice of a Vec's block, used after the Vec grew and moved.
|
|
(= n 5)
|
|
(let [v (vec-new i64)]
|
|
(push v 1)
|
|
(let [d (keep (slice v))]
|
|
(dotimes [i 100] (push v i))
|
|
(println (at d 0)))
|
|
0)
|
|
;; A heap slice used after it was freed.
|
|
(= n 6)
|
|
(let [c (clone (slice [(i64 1) 2 3] 0 3))
|
|
d (keep c)]
|
|
(free c)
|
|
(println (at d 0))
|
|
0)
|
|
;; An arena's storage used after free-all.
|
|
(= n 7)
|
|
(let [ar (arena-new 4096)
|
|
v (with-allocator ar (clone (slice [(i32 4) 5] 0 2)))
|
|
d (keep v)]
|
|
(free-all ar)
|
|
(println (at d 1))
|
|
0)
|
|
;; A str element is read-only through a view.
|
|
(= n 8)
|
|
(let [nm (Named {.name "ada" .id 7})]
|
|
(put (keep nm) :name "bob")
|
|
0)
|
|
;; An int an f32 does not hold exactly: 2^24 + 1.
|
|
(= n 9)
|
|
(let [fs [(f32 0.5)]]
|
|
(set (at (keep fs) 0) 16777217)
|
|
0)
|
|
;; A field a struct does not have, through .field.
|
|
(= n 10)
|
|
(let [p (Point {.x 1.0 .y 2})]
|
|
(set (.z (keep p)) 3)
|
|
0)
|
|
;; A million views made and dropped: the collector takes back every
|
|
;; byte it charged for them.
|
|
(= n 11)
|
|
(let [s (i64 0)]
|
|
(set (at g3 0) 1)
|
|
(dotimes [i 300000] (set s (+ s (i64 (first-of g3)))))
|
|
(gc-collect)
|
|
(println s (< (gc-live-bytes) 1000000))
|
|
0)
|
|
;; Stale through a slice bound to a local, and through a slice parameter.
|
|
(= n 12)
|
|
(do (leak-slice-local) (println (clobber)) (println (at held 0)) 0)
|
|
(= n 13)
|
|
(do (leak-slice-param) (println (clobber)) (println (at held 0)) 0)
|
|
;; A field given a value of the wrong type, or nil, or out of range.
|
|
(= n 14)
|
|
(let [p (Small {.x 1 .z true})] (set (.x (keep p)) 1.5) 0)
|
|
(= n 15)
|
|
(let [p (Small {.x 1 .z true})] (set (.z (keep p)) nil) 0)
|
|
(= n 16)
|
|
(let [p (Small {.x 1 .z true})] (set (.x (keep p)) 200) 0)
|
|
;; A stale view printed, measured and asked for a key, at their sites.
|
|
(= n 17)
|
|
(do (leak-local) (println (clobber)) (println held) 0)
|
|
(= n 18)
|
|
(do (leak-local) (println (clobber)) (println (length held)) 0)
|
|
;; A u64 above the dyn int range prints, and reading it traps here.
|
|
(= n 19)
|
|
(let [w (Wide {.a 18000000000000000000 .b 1})
|
|
d (keep w)]
|
|
(println d)
|
|
(println (.a d))
|
|
0)
|
|
;; An element's range, with its article.
|
|
(= n 20)
|
|
(let [a [(i8 1)]] (set (at (keep a) 0) 200) 0)
|
|
;; More live blocks than the registry's first size, then a free: the
|
|
;; registry grows rather than dropping notes, so the check still holds.
|
|
(= n 21)
|
|
(let [hold (vec-new [i64])]
|
|
(dotimes [i 6000] (push hold (clone (slice [(i64 i) 1] 0 2))))
|
|
(let [c (at hold 5999)
|
|
d (keep c)]
|
|
(println (at d 0))
|
|
(free c)
|
|
(println (at d 0)))
|
|
0)
|
|
;; A container holding a stale view, compared with itself.
|
|
(= n 22)
|
|
(do (leak-local)
|
|
(println (clobber))
|
|
(let [box (the dyn [held 1])]
|
|
(println (= box box)))
|
|
0)
|
|
;; has-key? on a value that is not a map, at its site.
|
|
(= n 23)
|
|
(do (println (has-key? (keep 5) :x)) 0)
|
|
;; A container compared with itself, once a view exists: shared thirty
|
|
;; levels deep, and holding itself. Each must answer at once.
|
|
(= n 24)
|
|
(let [a [(i64 1)]
|
|
k (keep a)
|
|
v (doubled 30)]
|
|
(println (= v v))
|
|
0)
|
|
(= n 25)
|
|
(let [a [(i64 1)]
|
|
k (keep a)
|
|
c (the dyn [1])]
|
|
(push c c)
|
|
(push c c)
|
|
(println (= c c))
|
|
0)
|
|
:else (do (println "?") 1))))
|