Merge master
This commit is contained in:
commit
b5380b4750
21
TODO.org
21
TODO.org
@ -20,10 +20,13 @@ Dyn text stays immutable, with chars and text converting to and from a dyn
|
||||
vector of characters; length and indexing count characters on dyn text and bytes on
|
||||
str. Waits on the dyn-unless-annotated design.
|
||||
|
||||
** NEXT Any typed container crosses into dyn as a view
|
||||
Decided 2026-09-25: every element type (all numbers, chars, structs, nested arrays)
|
||||
and any storage; a dev build checks a view against its frame or allocation and traps
|
||||
when stale, a release build does not. Waits on the dyn-unless-annotated design.
|
||||
** DONE Any typed container crosses into dyn as a view
|
||||
CLOSED: [2026-09-26]
|
||||
A str element reads as a copy and is never written, an aggregate element is written
|
||||
through its own view, a float element takes an int only when it holds it exactly (a
|
||||
class's float slot's rule), and a u64 above the largest i64 traps when read. A view of
|
||||
storage its own dyn global's initialiser built is refused. Rules out copying at the
|
||||
crossing, a dyn big int for u64, and any check in a release build.
|
||||
|
||||
** NEXT Dyn unless annotated
|
||||
Decided 2026-09-26, replacing the plain rule: number, bool and char literals are typed,
|
||||
@ -913,13 +916,11 @@ Already fixed by 3672da2, which blames the arm that is not a compiler temp; the
|
||||
caret is on the last operand and =test/test_flan.ml= asserts its column. Rules
|
||||
out relabelling the else arm, a bool sentinel, and inverting the condition.
|
||||
|
||||
** DONE A typed container crosses into dyn as a view, and only from permanent storage
|
||||
** DONE A typed container crosses into dyn as a view
|
||||
CLOSED: [2026-09-20]
|
||||
The descriptor is pointer, length and element type — a slice plus the piece a
|
||||
slice is missing. A =Vec= view holds the address of the =Vec='s own header and
|
||||
reads pointer and length live, so a reallocating push cannot go stale. Elements
|
||||
are =i64=, =f64= and =bool= only. Rules out a heap-held header and anything behind
|
||||
a =(Ptr T)=.
|
||||
A =Vec= view holds the address of the =Vec='s own header and reads pointer and
|
||||
length live, so a reallocating push cannot go stale. Rules out snapshotting a
|
||||
=Vec='s pointer at the crossing.
|
||||
|
||||
** DONE A view of a Vec goes stale at the push, and the warning is at the push
|
||||
CLOSED: [2026-09-21]
|
||||
|
||||
@ -3068,6 +3068,36 @@ the result means — a `Vec` can only be borrowed, a fixed array or a string can
|
||||
chooses between the two — so the second name expressed no choice a reader could make. One name, `slice`, over
|
||||
everything that has elements; the warning is where it bites.
|
||||
|
||||
### A dyn view's dev check: which frame, which block
|
||||
|
||||
A typed container crosses into dyn as a view of its storage wherever that storage is, and a `--dev` build traps
|
||||
(`DynStale`) the first time a view is used after its storage went away. Five files share the protocol:
|
||||
|
||||
- `check.ml`'s `frame_root` says when the storage is the calling function's own frame — a local, a parameter, a
|
||||
field or array element of one, a slice cut straight from a local array, or a temporary `box` bound to a slot of its
|
||||
own — and passes that as the view's `here` flag.
|
||||
- `emit.ml` and `x86.ml` zero a `serial` word in every shadow frame at the push, and store the frame's address
|
||||
(`llvm.frameaddress`, or `rbp`).
|
||||
- `flan_dyn.c`'s `view_make` claims a serial for the frame at the crossing (`flan_dev_frame_claim`, which numbers a
|
||||
frame once) and keeps the frame's address, its serial and the function's name. Without `here` it first asks
|
||||
`flan_dev_frame_owner` whether the address is on the stack: every local of a frame lies below that frame's address
|
||||
and above everything its callees push, so the owner is the innermost frame whose address is above it. That is how a
|
||||
slice of a local, or a slice parameter over a caller's array, is tied to the right activation. Otherwise it asks
|
||||
the allocation registry, through its address index (64 KiB chunks to the bases that overlap them), for the
|
||||
smallest live block holding the address and keeps that block's base and note sequence.
|
||||
- Every read or write checks first. A frame is alive when it is still on the chain from `flan_frame_head` *and* has
|
||||
the same serial: the walk is needed because dead stack keeps its old bytes, serial included, and the serial is
|
||||
needed because the next call at the same depth lands at the same address. A block is alive when the registry probe
|
||||
on its base finds the same sequence not yet dead, which a free, a free-all, an arena's destroy and a `Vec`'s growth
|
||||
(for the block it left) all end.
|
||||
|
||||
A view's aggregate element inherits its parent's record, except inside a `Vec` (checked against the `Vec`'s block,
|
||||
since growth moves it) and through a slice (looked up afresh). What neither table knows is not checked: a global,
|
||||
rodata, C memory. Nor is a local's scope inside a live frame: a view of a `let` that has ended, whose slot a later
|
||||
`let` in the same call reuses, reads the new value. A release build records nothing and
|
||||
checks nothing; a stale view there reads whatever the memory holds now. One case is refused at compile time instead:
|
||||
a dyn global's initialiser taking a view of what it built, which is gone before anything can read it.
|
||||
|
||||
### Three amendments to a frozen spec, and one addition
|
||||
|
||||
**1. `free-all` is retain-capacity, and `arena-destroy` is the operation that hands pages back.** The spec's table has
|
||||
|
||||
335
lib/check.ml
335
lib/check.ml
@ -354,7 +354,23 @@ type env = {
|
||||
mutable guard_next : bool;
|
||||
}
|
||||
|
||||
let new_env () = {
|
||||
(* The struct table [box] describes a struct from when it was handed no
|
||||
[ctx]: the newest program's, set by [new_env]. Every caller that has a
|
||||
[ctx] passes it, so its own program's table is the one read. *)
|
||||
let view_structs : (string, Tast.structure) Hashtbl.t ref = ref (Hashtbl.create 1)
|
||||
|
||||
(* The global whose initialiser is being checked, and its form. A view taken
|
||||
there of storage the initialiser itself built is gone the moment the
|
||||
initialiser returns, so it is refused rather than left to the dev check:
|
||||
nothing could ever read it. *)
|
||||
let view_global_init : (string * Ast.reinit) option ref = ref None
|
||||
|
||||
let rec new_env () =
|
||||
let env = new_env_record () in
|
||||
view_structs := env.structs;
|
||||
env
|
||||
|
||||
and new_env_record () = {
|
||||
structs = Hashtbl.create 16;
|
||||
datas = Hashtbl.create 16;
|
||||
unions = Hashtbl.create 16;
|
||||
@ -3612,28 +3628,48 @@ let no_dyn_yet loc ~into t extra =
|
||||
"%s does not cross into %s yet%s"
|
||||
(tyname loc t) (if into then "dyn" else "a written type") extra
|
||||
|
||||
(* M2 item 3: a typed container crossing into dyn as a view. The element set
|
||||
is exactly the unboxable scalars — i64, f64, bool — and that is not a smaller
|
||||
version of the same cut for the same reason: every other element type
|
||||
would need [box] to run on IT too, and a string element's dyn form is a
|
||||
pointer into the collector's heap, while a typed container's storage is
|
||||
arena or stack memory the collector never scans. Writing that pointer
|
||||
into memory nobody roots is a live reference the collector could free out
|
||||
from under — the hazard runtime/flan_dyn.h's view section states at
|
||||
length — and i64/f64/bool carry no pointer, so a view restricted to them
|
||||
cannot manufacture it. It is a compile-time refusal here rather than a
|
||||
run-time one because the element type is exactly what the checker already
|
||||
knows at the crossing. The FLAN_VIEW_* constants are runtime/flan_dyn.h's;
|
||||
this is the compiler's one copy of the same table. *)
|
||||
let view_elem (t : Types.t) : int64 option =
|
||||
match t with
|
||||
| Types.Int Types.I64 -> Some 0L (* FLAN_VIEW_I64 *)
|
||||
| Types.Float Types.F64 -> Some 1L (* FLAN_VIEW_F64 *)
|
||||
| Types.Bool -> Some 2L (* FLAN_VIEW_BOOL *)
|
||||
| _ -> None
|
||||
|
||||
let view_elem_lit loc (k : int64) =
|
||||
mk loc (Types.Int Types.I32) (Tast.Int (k, Types.I32))
|
||||
(* A typed container crossing into dyn is a view, and the runtime needs to
|
||||
know what one element is: its descriptor, a prefix code runtime/flan_dyn.c
|
||||
documents beside [desc_lay] and reads offsets out of by C's layout rule.
|
||||
Every number, bool, str, struct of those, and fixed array, slice or Vec of
|
||||
those can be described. [Error t] names the first type inside that cannot:
|
||||
a dyn, a pointer, a function, an Option, a map, an enum or a data type.
|
||||
None of those is refused for want of a descriptor letter — each is one a
|
||||
dyn value cannot be read out of or written into without a meaning
|
||||
nobody has decided. A str is read as a copy and never written, since a
|
||||
dyn text is a collector pointer and typed storage is never scanned; a
|
||||
[const] slice is refused because a dyn view can be written through. *)
|
||||
let rec view_desc structs (t : Types.t) : (string, Types.t) result =
|
||||
let ( let* ) = Result.bind in
|
||||
match t with
|
||||
| Types.Int k ->
|
||||
Ok (match k with
|
||||
| Types.I8 -> "b" | Types.U8 -> "B" | Types.I16 -> "h" | Types.U16 -> "H"
|
||||
| Types.I32 -> "i" | Types.U32 -> "I" | Types.I64 -> "l" | Types.U64 -> "L")
|
||||
| Types.Float Types.F32 -> Ok "f"
|
||||
| Types.Float Types.F64 -> Ok "d"
|
||||
| Types.Bool -> Ok "?"
|
||||
| Types.String -> Ok "t"
|
||||
| Types.Array (n, e) ->
|
||||
let* d = view_desc structs e in
|
||||
Ok (Printf.sprintf "a%Ld;%s" n d)
|
||||
| Types.Slice (Types.Mut, e) -> let* d = view_desc structs e in Ok ("s" ^ d)
|
||||
| Types.Vec e -> let* d = view_desc structs e in Ok ("v" ^ d)
|
||||
| Types.Named n ->
|
||||
(match Hashtbl.find_opt structs n with
|
||||
| None -> Error t
|
||||
| Some st ->
|
||||
let* fs =
|
||||
List.fold_left
|
||||
(fun acc (fl : Tast.field) ->
|
||||
let* acc = acc in
|
||||
let* d = view_desc structs fl.Tast.fty in
|
||||
Ok ((fl.Tast.fname ^ ";" ^ d) :: acc))
|
||||
(Ok []) st.Tast.fields
|
||||
in
|
||||
Ok ("{" ^ n ^ ";" ^ String.concat "" (List.rev fs) ^ "}"))
|
||||
| _ -> Error t
|
||||
|
||||
(* A fix is spelled in the syntax of the file the mistake is in: the checker
|
||||
sees one AST for both, so the location's file is the only thing left that
|
||||
@ -3711,99 +3747,47 @@ let view_refusal kind loc (e : Tast.expr) reason =
|
||||
Loc.failk kind loc "%s, and a dyn value is wanted here. %s. %s" subject
|
||||
reason fix
|
||||
|
||||
let view_not_yet loc (e : Tast.expr) (elem : Types.t) =
|
||||
let view_not_yet loc (e : Tast.expr) (inner : Types.t) =
|
||||
view_refusal "check/dyn-not-yet" loc e
|
||||
(Printf.sprintf
|
||||
"A dyn value can see into a typed container only when its elements \
|
||||
are i64, f64 or bool, and these are %s"
|
||||
(tyname loc elem))
|
||||
"A dyn value sees into numbers, bools, str and structs, and arrays, \
|
||||
slices and Vecs of those; a %s is none of these"
|
||||
(tyname loc inner))
|
||||
|
||||
(* M2 item 3's second guard, added on review: a view's descriptor holds an
|
||||
address into the container's own storage, chased fresh on every
|
||||
operation, which is what makes a Vec's growth safe — but it is also what
|
||||
makes a *dangling* container's storage a live hazard nothing catches
|
||||
until somebody reads through the view. A view returned from the function
|
||||
whose frame the Vec lived in, stashed in a global and read after that
|
||||
frame is gone, or left behind when a condition transfer unwinds it, are
|
||||
all stack-use-after-return once box stopped refusing containers outright
|
||||
— reachable now for the first time, not a pre-existing hole this lane
|
||||
merely inherited.
|
||||
|
||||
On the dynamic side Flan aims where Clojure and Common Lisp are: holding
|
||||
a value should not hand you garbage. Treating a view as a bare pointer and
|
||||
calling the lifetime the programmer's problem is the Odin answer, and
|
||||
neither Odin nor C stops it — this guard is the trade going the other way,
|
||||
refused rather than merely documented.
|
||||
|
||||
What it is NOT is a proof. runtime/flan_dyn.h states the actual property:
|
||||
the view is exactly as stale-safe as the thing it is a view of, no more
|
||||
and no less. This guard narrows what a view can be taken of; it does not
|
||||
make the underlying storage outlive anything. A global [[T]] slice whose
|
||||
data was cut from a frame that has since returned still passes here, and
|
||||
reading through the view then reads a dead frame. So this is a guard that
|
||||
closes the routes the checker can see, not a guarantee that a dyn value
|
||||
never dangles.
|
||||
|
||||
[permanent_root] asks whether an expression's own address — the one a
|
||||
view's pointer will chase — is guaranteed to outlive every frame, which is
|
||||
true of exactly one thing at this milestone: a global. A field of a
|
||||
permanent value is permanent at the same fixed offset from it, and so is
|
||||
an element of a permanent *array* — both are still inside the permanent
|
||||
value's own storage. An element of a permanent *slice* is not: a slice is
|
||||
ptr+len, so a global [[T]] holds only the two words, and the storage they
|
||||
point at can be a frame that has already gone. The [At] arm below is where
|
||||
that distinction is made, and it is made per index rather than once: an
|
||||
[(at g i j)] is a single node carrying the whole index list, so the arm
|
||||
steps the list the way [indexed] does and an array level at every step is
|
||||
what it demands. Reading only the target's type would settle level zero
|
||||
and let a slice at any later level through — which it did, and the
|
||||
accepted program printed a returned frame's contents. A slice built directly from
|
||||
[(slice T lo hi)] inherits the
|
||||
permanence of the [T] it was cut from — unwrapped here because that is
|
||||
the one shape still carrying the trace back to it; once a slice has been
|
||||
bound to a name the trace is gone and it is refused; the spelling that
|
||||
keeps it is to view the slice expression directly, the way this file's
|
||||
own survey program does.
|
||||
|
||||
Everything else — a local, a parameter, a temporary, anything reached
|
||||
through a [Ptr] — answers false. A [Ptr] is refused rather than trusted
|
||||
because a heap-allocated block and a frame slot are the same type: a
|
||||
[(Ptr (Vec i64))] taken from a heap allocation would be sound to view, but
|
||||
the same type is what [(addr some-local)] answers too, and the checker
|
||||
cannot tell the two apart. Admitting one admits the other, which is the
|
||||
whole hazard this guard exists to close — so until a Flan type exists
|
||||
that says "durably heap-owned" and a [Ptr] does not, a container reached
|
||||
through one is refused rather than guessed at. An arena-held container is
|
||||
not a separate case: an arena changes where a Vec's *elements* live, never
|
||||
where its own header — the value a name is bound to — lives, so a Vec
|
||||
grown from an arena is exactly as permanent as the binding that holds it,
|
||||
already covered by the cases above. *)
|
||||
let rec permanent_root (e : Tast.expr) : bool =
|
||||
(* Whether a view's storage is the current function's own frame, which is
|
||||
what the runtime's dev check needs to be told: it then records this
|
||||
activation and traps if the view is used after the call returns. A local,
|
||||
a parameter (copied into the frame, an array parameter too), a field or
|
||||
an array element of one, a slice cut directly from a local array, and a
|
||||
temporary [box] has bound to a slot of its own are all the frame's. For
|
||||
anything else — a slice's data, a [Ptr]'s target, a global — the dev
|
||||
runtime finds the frame that owns a stack address by the address itself,
|
||||
or else the registry block that holds it. *)
|
||||
let rec frame_root (e : Tast.expr) : bool =
|
||||
let rec all_array ty = function
|
||||
| [] -> true
|
||||
| _ :: rest ->
|
||||
(match ty with Types.Array (_, elem) -> all_array elem rest | _ -> false)
|
||||
in
|
||||
match e.Tast.e with
|
||||
| Tast.Global _ -> true
|
||||
| Tast.Field (target, _) -> permanent_root target
|
||||
| Tast.Local _ -> (match e.Tast.ty with Types.Slice _ -> false | _ -> true)
|
||||
| Tast.Field (target, _) ->
|
||||
(match target.Tast.ty with Types.Named _ -> frame_root target | _ -> false)
|
||||
| Tast.Prim (Tast.At, target :: idx) ->
|
||||
(* [(at g i j)] is ONE node carrying every index, so the target's own type
|
||||
is only level zero and asking about it alone misses a slice reached at
|
||||
any later level. Step the list the way [indexed] does — that walk is
|
||||
the definition of which levels exist — and require every level stepped
|
||||
to be an array. *)
|
||||
let rec all_array ty = function
|
||||
| [] -> true
|
||||
| _ :: rest ->
|
||||
(match ty with
|
||||
| Types.Array (_, elem) -> all_array elem rest
|
||||
| _ -> false)
|
||||
in
|
||||
all_array target.Tast.ty idx && permanent_root target
|
||||
| Tast.Prim (Tast.Slice, [ target; _; _ ]) -> permanent_root target
|
||||
all_array target.Tast.ty idx && frame_root target
|
||||
| Tast.Prim (Tast.Slice, [ target; _; _ ]) ->
|
||||
(match target.Tast.ty with Types.Array _ -> frame_root target | _ -> false)
|
||||
| _ -> false
|
||||
|
||||
let view_not_permanent loc (e : Tast.expr) =
|
||||
view_refusal "check/dyn-view-lifetime" loc e
|
||||
"A dyn value can see into a typed container only when it is a global: a \
|
||||
local, a parameter or a temporary can be gone while the dyn value still \
|
||||
points at it"
|
||||
(* Whether [e] names storage that already has an address, so a view can
|
||||
point at it; anything else is a temporary [box] binds to a slot first. *)
|
||||
let rec view_place (e : Tast.expr) : bool =
|
||||
match e.Tast.e with
|
||||
| Tast.Local _ | Tast.Global _ | Tast.Deref _ -> true
|
||||
| Tast.Field (target, _) ->
|
||||
(match target.Tast.ty with Types.Named _ -> view_place target | _ -> true)
|
||||
| Tast.Prim (Tast.At, _ :: _ :: _) -> true
|
||||
| _ -> false
|
||||
|
||||
(* A value handed out of [f] that points into [f]'s own frame: returned (the
|
||||
last form's tails, or a [return]), or stored into a global or a field or
|
||||
@ -4062,8 +4046,11 @@ let refuse_frame_escapes (f : Tast.fn) =
|
||||
if returns then
|
||||
match List.rev f.Tast.body with x :: _ -> tails x | [] -> ()
|
||||
|
||||
let box loc (e : Tast.expr) : Tast.expr =
|
||||
let box ?ctx loc (e : Tast.expr) : Tast.expr =
|
||||
let dyn sym args = rt loc Types.Dyn sym args in
|
||||
let structs =
|
||||
match ctx with Some c -> c.env.structs | None -> !view_structs
|
||||
in
|
||||
match e.Tast.ty with
|
||||
| Types.Dyn -> e
|
||||
| Types.Int _ -> dyn "flan_dyn_from_i64" [ widen loc dyn_i64 e ]
|
||||
@ -4084,28 +4071,70 @@ let box loc (e : Tast.expr) : Tast.expr =
|
||||
Loc.failk "check/dyn-unit" loc
|
||||
"() does not box into dyn. The absent dyn value is nil — write nil"
|
||||
| Types.Never -> e
|
||||
(* A view, not a copy: the box holds one word naming where the elements
|
||||
live and what one of them is, and every read or write goes straight
|
||||
through to the container's own storage — see runtime/flan_dyn.h's
|
||||
view section for the whole of the argument, including why the
|
||||
descriptor points AT the container (a Vec's own header address)
|
||||
rather than snapshotting its ptr+len. That is what makes a push
|
||||
through the view safe even though a Vec can grow and move: there is
|
||||
no snapshot for the growth to invalidate. A slice and a fixed array
|
||||
cannot grow, so a snapshot taken once at the crossing is sound for
|
||||
both, and they share [flan_dyn_view_flat]. *)
|
||||
(* The element check runs before the lifetime one in all three arms, and
|
||||
the order is load-bearing rather than incidental: the lifetime message
|
||||
says a global can be seen into, and for an element type no view can
|
||||
carry — a string, an i32 — a global is refused too, so the wrong order
|
||||
hands the programmer a reason that is false for their case. Whichever
|
||||
refusal is unconditional wins. *)
|
||||
| Types.Vec elem ->
|
||||
(match view_elem elem with
|
||||
| None -> view_not_yet loc e elem
|
||||
| Some k ->
|
||||
if not (permanent_root e) then view_not_permanent loc e
|
||||
else dyn "flan_dyn_view_vec" [ e; view_elem_lit loc k ])
|
||||
(* A view, not a copy: the box holds a small record naming where the
|
||||
storage is and what one element is (its descriptor, [view_desc]), and
|
||||
every read or write goes straight through to the container's own
|
||||
storage — see runtime/flan_dyn.h's view section. A Vec's view points AT
|
||||
the Vec's header and reads its pointer and length live, so a push
|
||||
through the view cannot go stale; a slice and a fixed array cannot grow,
|
||||
so a snapshot taken at the crossing is sound for both. A struct's view
|
||||
is a map-like value: (get p :x), (set (get p :x) v), (put p :x v).
|
||||
|
||||
A container, array or struct is handed over by address. One that is not
|
||||
a place already — a call's result — is bound to a slot of its own
|
||||
first, so the view points at storage that lives as long as the frame
|
||||
rather than at a temporary the next statement reuses. [frame_root] then
|
||||
says whether the storage is this frame's, for the runtime's dev check. *)
|
||||
| Types.Vec _ | Types.Array _ | Types.Named _ | Types.Slice (Types.Mut, _)
|
||||
when (match e.Tast.ty with
|
||||
| Types.Named n -> Hashtbl.mem structs n
|
||||
| _ -> true) ->
|
||||
let desc_of t =
|
||||
match view_desc structs t with
|
||||
| Ok d -> mk loc Types.String (Tast.Str d)
|
||||
| Error inner -> view_not_yet loc e inner
|
||||
in
|
||||
let i32 n = mk loc (Types.Int Types.I32) (Tast.Int (n, Types.I32)) in
|
||||
let i64 n = mk loc dyn_i64 (Tast.Int (n, Types.I64)) in
|
||||
let bind, e =
|
||||
match ctx, e.Tast.ty with
|
||||
| Some ctx, (Types.Vec _ | Types.Array _ | Types.Named _)
|
||||
when not (view_place e) ->
|
||||
let sl = fresh_slot ctx e.Tast.ty in
|
||||
Some (sl, e), mk loc e.Tast.ty (Tast.Local sl)
|
||||
| _ -> None, e
|
||||
in
|
||||
(match !view_global_init with
|
||||
| Some (g, kind) when frame_root e ->
|
||||
let fln = fln_source loc in
|
||||
let ty = tyname loc e.Tast.ty in
|
||||
Loc.failk "check/dyn-view-lifetime" loc
|
||||
"%s is a dyn global, and its initialiser builds a %s that is gone \
|
||||
once the initialiser returns, so a dyn view of it would outlive \
|
||||
it. Give %s its type, as in %s"
|
||||
g ty g
|
||||
(let form =
|
||||
match kind with Ast.Every -> "def" | Ast.Once -> "defonce" in
|
||||
if fln then
|
||||
Printf.sprintf "%s %s: %s = ..."
|
||||
(match kind with Ast.Every -> "def" | Ast.Once -> "once") g ty
|
||||
else Printf.sprintf "(%s %s %s ...)" form g ty)
|
||||
| _ -> ());
|
||||
let here = i32 (if frame_root e then 1L else 0L) in
|
||||
let view =
|
||||
match e.Tast.ty with
|
||||
| Types.Slice (_, elem) ->
|
||||
dyn "flan_dyn_view_slice" [ e; desc_of elem; here ]
|
||||
| Types.Vec elem ->
|
||||
dyn "flan_dyn_view_at" [ addr_of loc e; i64 0L; desc_of elem; i32 1L; here ]
|
||||
| Types.Array (n, elem) ->
|
||||
dyn "flan_dyn_view_at" [ addr_of loc e; i64 n; desc_of elem; i32 0L; here ]
|
||||
| t ->
|
||||
dyn "flan_dyn_view_at" [ addr_of loc e; i64 0L; desc_of t; i32 2L; here ]
|
||||
in
|
||||
(match bind with
|
||||
| None -> view
|
||||
| Some b -> mk loc Types.Dyn (Tast.Let ([ b ], [ view ])))
|
||||
(* A dyn view is written through by (set (at d i) x), and nothing on the
|
||||
dyn side can tell a read-only one apart, so a [[const T]] does not
|
||||
cross. *)
|
||||
@ -4115,20 +4144,6 @@ let box loc (e : Tast.expr) : Tast.expr =
|
||||
[const %s] can only be read. A dyn view is taken of the writable \
|
||||
storage it came from"
|
||||
(tyname loc e.Tast.ty) (tyname loc elem)
|
||||
| Types.Slice (Types.Mut, elem) ->
|
||||
(match view_elem elem with
|
||||
| None -> view_not_yet loc e elem
|
||||
| Some k ->
|
||||
if not (permanent_root e) then view_not_permanent loc e
|
||||
else dyn "flan_dyn_view_flat" [ e; view_elem_lit loc k ])
|
||||
| Types.Array (n, elem) ->
|
||||
(match view_elem elem with
|
||||
| None -> view_not_yet loc e elem
|
||||
| Some k ->
|
||||
if not (permanent_root e) then view_not_permanent loc e
|
||||
else
|
||||
dyn "flan_dyn_view_flat"
|
||||
[ e; mk loc dyn_i64 (Tast.Int (n, Types.I64)); view_elem_lit loc k ])
|
||||
(* No view for a map yet, and the suggestion is the *literal* rather than a
|
||||
constructor call: there is no [(map-new dyn)] — [map_new_types] wants a
|
||||
key and a value, and [map_type] refuses dyn as a key — so naming one
|
||||
@ -4144,7 +4159,7 @@ let box loc (e : Tast.expr) : Tast.expr =
|
||||
mis-lowering. *)
|
||||
| Types.Named _ | Types.Enum _ | Types.Option _ | Types.Ptr _
|
||||
| Types.Alloc | Types.Fn _ | Types.CFn _ | Types.Var _ | Types.Len _
|
||||
| Types.LArray _ ->
|
||||
| Types.LArray _ | Types.Vec _ | Types.Array _ | Types.Slice _ ->
|
||||
no_dyn_yet loc ~into:true e.Tast.ty ""
|
||||
|
||||
(* Every dyn an expectation opened ([expect]'s dyn arm), by the node that
|
||||
@ -4312,7 +4327,7 @@ let box_option ctx loc (t : Types.t) (got : Tast.expr) : Tast.expr =
|
||||
run time and the conversion is free on both backends. *)
|
||||
match got.Tast.e with
|
||||
| Tast.None_ -> rt loc Types.Dyn "flan_dyn_nil" []
|
||||
| Tast.Some_ x -> if Types.equal t Types.Dyn then x else box loc x
|
||||
| Tast.Some_ x -> if Types.equal t Types.Dyn then x else box ~ctx loc x
|
||||
| _ ->
|
||||
let s = fresh_slot ctx (Types.Option t) in
|
||||
let sv = mk loc (Types.Option t) (Tast.Local s) in
|
||||
@ -4323,7 +4338,7 @@ let box_option ctx loc (t : Types.t) (got : Tast.expr) : Tast.expr =
|
||||
[ tag; mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))
|
||||
in
|
||||
let payload = mk loc t (Tast.Field (sv, 1)) in
|
||||
let some_dyn = if Types.equal t Types.Dyn then payload else box loc payload in
|
||||
let some_dyn = if Types.equal t Types.Dyn then payload else box ~ctx loc payload in
|
||||
let none_dyn = rt loc Types.Dyn "flan_dyn_nil" [] in
|
||||
mk loc Types.Dyn
|
||||
(Tast.Let ([ (s, got) ],
|
||||
@ -4332,7 +4347,8 @@ let box_option ctx loc (t : Types.t) (got : Tast.expr) : Tast.expr =
|
||||
(* [=] over a dyn pair, answering a bool. Shared by the [=] builtin and a
|
||||
literal [match] over a dyn, which is (= t lit) by definition. *)
|
||||
let dyn_eq loc u v =
|
||||
unbox loc Types.Bool (rt loc Types.Dyn "flan_dyn_eq" [ box loc u; box loc v ])
|
||||
unbox loc Types.Bool
|
||||
(rt loc Types.Dyn "flan_dyn_eq_at" [ box loc u; box loc v; here loc ])
|
||||
|
||||
let unbox_option ctx loc (t : Types.t) (got : Tast.expr) : Tast.expr =
|
||||
let oty = Types.Option t in
|
||||
@ -4549,7 +4565,7 @@ let expect ctx loc ~want (got : Tast.expr) =
|
||||
match w, got.Tast.ty with
|
||||
| Types.Dyn, Types.Dyn -> got
|
||||
| Types.Dyn, Types.Option t -> box_option ctx loc t got
|
||||
| Types.Dyn, _ -> box loc got
|
||||
| Types.Dyn, _ -> box ~ctx loc got
|
||||
| Types.Option t, Types.Dyn when not (is_nil_lit got) ->
|
||||
let opened = unbox_option ctx loc t got in
|
||||
Opened.replace opened_by_want opened got;
|
||||
@ -10892,7 +10908,8 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
| "<" -> "flan_dyn_lt" | "<=" -> "flan_dyn_le"
|
||||
| ">" -> "flan_dyn_gt" | _ -> "flan_dyn_ge"
|
||||
in
|
||||
(* [eq] never traps and takes no site; the four orderings do, and get
|
||||
(* [eq] traps only on a view whose storage is gone, and [dyn_eq] gives
|
||||
it the site for that; the four orderings trap on a mismatch, and get
|
||||
one, for the reason [dyn_fold] gives. Every pair of a chain gets the
|
||||
same site — the whole comparison is written at one place, and a trap
|
||||
from any of its pairs happened there. *)
|
||||
@ -12089,8 +12106,8 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
if target.Tast.ty = Types.Dyn then
|
||||
expect ctx loc ~want
|
||||
(unbox loc Types.Bool
|
||||
(rt loc Types.Dyn "flan_dyn_map_contains"
|
||||
[ target; check ctx ~want:Types.Dyn k ]))
|
||||
(rt loc Types.Dyn "flan_dyn_map_contains_at"
|
||||
[ target; check ctx ~want:Types.Dyn k; here loc ]))
|
||||
else begin
|
||||
let kt, vt = map_kv loc "has-key?" target.Tast.ty in
|
||||
let k = check ctx ~want:kt k in
|
||||
@ -12416,7 +12433,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
pair of allocations per iteration. The runtime answers a dyn; it is unboxed at
|
||||
once and narrowed the way the Vec's i64 above is. *)
|
||||
| Types.Dyn ->
|
||||
let n = unbox loc (Types.Int Types.I64) (rt loc Types.Dyn "flan_dyn_len" [ a ]) in
|
||||
let n = unbox loc (Types.Int Types.I64) (rt loc Types.Dyn "flan_dyn_len_at" [ a; here loc ]) in
|
||||
expect ctx loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ])))
|
||||
| other ->
|
||||
fail loc
|
||||
@ -12941,7 +12958,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
ei64 = (fun x -> write (conv Tast.I64ToBytes x));
|
||||
eu64 = (fun x -> write (conv Tast.U64ToBytes x));
|
||||
ef64 = (fun x -> write (conv Tast.F64ToBytes x));
|
||||
edyn = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_print", [ x ]))) }
|
||||
edyn = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_print_at", [ x; here loc ]))) }
|
||||
in
|
||||
let rc = render_ctx ctx emitter in
|
||||
let render_one a =
|
||||
@ -16510,7 +16527,11 @@ let check_global env (d : Ast.decl) : Tast.global option =
|
||||
{ Tast.e = Tast.Uninit ty; ty; loc = d.Ast.dloc }
|
||||
| Ast.Init v ->
|
||||
let c = ctx () in
|
||||
let v = check c ~want:ty v in
|
||||
let v =
|
||||
view_global_init := Some (n, kind);
|
||||
Fun.protect ~finally:(fun () -> view_global_init := None)
|
||||
(fun () -> check c ~want:ty v)
|
||||
in
|
||||
if Tast.const_init v && not lift_always then v
|
||||
else lift_ginit c d.Ast.dloc n ty v
|
||||
(* [settle_defvars] turned every one of these into a [Zeroed] or an
|
||||
@ -17820,7 +17841,7 @@ let memory_class (sym : string) (args : Tast.expr list) =
|
||||
| "flan_dyn_map_new_class" ->
|
||||
gc "allocates: a class instance is a dyn map on the collector's heap, \
|
||||
with the class's name in its header"
|
||||
| "flan_dyn_view_vec" | "flan_dyn_view_flat" ->
|
||||
| "flan_dyn_view_slice" | "flan_dyn_view_at" ->
|
||||
gc "allocates: a typed container crossing into dyn takes a view record \
|
||||
on the collector's heap — the elements are not copied, the record is"
|
||||
| "flan_dyn_from_i64" when (match args with [ x ] -> int_may_spill x | _ -> true) ->
|
||||
|
||||
39
lib/emit.ml
39
lib/emit.ml
@ -250,7 +250,8 @@ module Rt = struct
|
||||
before the call. Null until the first. *)
|
||||
let flanframe =
|
||||
{ sname = "flanframe";
|
||||
fields = [ "prev", Ptr; "info", Ptr; "slots", Ptr; "at", Ptr ] }
|
||||
fields = [ "prev", Ptr; "info", Ptr; "slots", Ptr; "at", Ptr;
|
||||
"serial", I64; "fp", Ptr ] }
|
||||
|
||||
let align_up n a = (n + a - 1) / a * a
|
||||
|
||||
@ -4045,14 +4046,9 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
|
||||
Passing the header by value here would hand the runtime a
|
||||
copy to grow and leave the caller's untouched. *)
|
||||
| Types.Vec _ | Types.Map _ -> [ "ptr " ^ addr f a ]
|
||||
(* A fixed array crossing into a dyn view (M2 item 3) needs its
|
||||
address for the same reason a Vec or a Map does here — the
|
||||
view reads through it live, and passing the value would hand
|
||||
the runtime a copy nothing writes back through. Every other
|
||||
[Rt] caller of an array argument is [flan_dyn_view_flat],
|
||||
which takes the address and never mutates the array's shape,
|
||||
so this is not the move-only argument Vec/Map's comment is
|
||||
about — it is simply the only way to view rather than copy. *)
|
||||
(* A fixed array crosses by address, as a Vec or a Map does: a
|
||||
runtime entry point that takes one reads it in place. (A dyn
|
||||
view is handed an explicit [addr_of] by check.ml's [box].) *)
|
||||
| Types.Array _ -> [ "ptr " ^ addr f a ]
|
||||
| t -> [ ll t ^ " " ^ value f a ])
|
||||
args)
|
||||
@ -4478,6 +4474,22 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
|
||||
"%%frame.a = getelementptr inbounds %%flanframe, ptr %%frame, i32 0, i32 %d"
|
||||
(Rt.index Rt.flanframe "at");
|
||||
"store ptr null, ptr %frame.a";
|
||||
(* Zeroed at every push: a dyn view of a local claims a number here
|
||||
(runtime/flan_dev.c, [flan_dev_frame_claim]), and the next call
|
||||
to land at this address must not inherit it. *)
|
||||
Printf.sprintf
|
||||
"%%frame.n = getelementptr inbounds %%flanframe, ptr %%frame, i32 0, i32 %d"
|
||||
(Rt.index Rt.flanframe "serial");
|
||||
"store i64 0, ptr %frame.n";
|
||||
(* The frame address: every local lies below it, so the dev runtime
|
||||
can tell which frame a stack address belongs to
|
||||
([flan_dev_frame_owner]). Asking for it keeps this function's
|
||||
frame pointer, which only a dev build pays. *)
|
||||
"%frame.fpv = call ptr @llvm.frameaddress.p0(i32 0)";
|
||||
Printf.sprintf
|
||||
"%%frame.f = getelementptr inbounds %%flanframe, ptr %%frame, i32 0, i32 %d"
|
||||
(Rt.index Rt.flanframe "fp");
|
||||
"store ptr %frame.fpv, ptr %frame.f";
|
||||
"store ptr %frame, ptr @flan_frame_head" ];
|
||||
f.frame <- Some prev;
|
||||
(* The parameters are bound before the body starts, so they are recorded
|
||||
@ -4919,6 +4931,7 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher
|
||||
|
||||
declare void @llvm.memset.p0.i64(ptr nocapture writeonly, i8, i64, i1 immarg)
|
||||
declare i32 @llvm.bswap.i32(i32)
|
||||
declare ptr @llvm.frameaddress.p0(i32 immarg)
|
||||
declare void @flan_rt_init(i32, ptr)
|
||||
declare void @flan_argv(ptr)
|
||||
declare void @flan_write_stdout(ptr, i64)
|
||||
@ -5010,6 +5023,7 @@ declare i64 @flan_dyn_map_get(i64, i64)
|
||||
declare i64 @flan_dyn_get(i64, i64, ptr, i64)
|
||||
declare void @flan_dyn_map_set(i64, i64, i64)
|
||||
declare i64 @flan_dyn_map_contains(i64, i64)
|
||||
declare i64 @flan_dyn_map_contains_at(i64, i64, ptr, i64)
|
||||
; The ones that trap carry the site as ptr+len, the way the bounds and
|
||||
; arithmetic traps do: a dyn type error IS the type error in a dynamic
|
||||
; program, and it used to print with no file and no line. [eq] never traps,
|
||||
@ -5026,11 +5040,14 @@ declare i64 @flan_dyn_gt(i64, i64, ptr, i64)
|
||||
declare i64 @flan_dyn_ge(i64, i64, ptr, i64)
|
||||
declare i64 @flan_dyn_eq(i64, i64)
|
||||
declare i64 @flan_dyn_len(i64)
|
||||
declare i64 @flan_dyn_eq_at(i64, i64, ptr, i64)
|
||||
declare i64 @flan_dyn_len_at(i64, ptr, i64)
|
||||
declare i64 @flan_dyn_at(i64, i64, ptr, i64)
|
||||
declare i64 @flan_dyn_slice(i64, i64, i64, ptr, i64)
|
||||
declare void @flan_dyn_set_at(i64, i64, i64, ptr, i64)
|
||||
declare void @flan_dyn_push(i64, i64, ptr, i64)
|
||||
declare void @flan_dyn_print(i64)
|
||||
declare void @flan_dyn_print_at(i64, ptr, i64)
|
||||
declare void @flan_dyn_emit_dev(i64)
|
||||
declare void @flan_dyn_emit_watch(i64)
|
||||
; The watch table, which (watch "name" v) renders into. flan_dev.c is linked
|
||||
@ -5060,8 +5077,8 @@ declare i32 @flan_dyn_cast_kind(i64, ptr, i64, ptr, i64, i32)
|
||||
declare i32 @flan_dyn_is_nil(i64)
|
||||
declare i64 @flan_dyn_need_not_nil(i64)
|
||||
declare i32 @flan_dyn_truthy(i64)
|
||||
declare i64 @flan_dyn_view_vec(ptr, i32)
|
||||
declare i64 @flan_dyn_view_flat(ptr, i64, i32)
|
||||
declare i64 @flan_dyn_view_slice(ptr, i64, ptr, i64, i32)
|
||||
declare i64 @flan_dyn_view_at(ptr, i64, ptr, i64, i32, i32)
|
||||
declare void @flan_dyn_root_push(ptr)
|
||||
declare void @flan_dyn_root_push_desc(ptr, ptr)
|
||||
declare ptr @flan_dyn_env_new(i64, ptr)
|
||||
|
||||
19
lib/x86.ml
19
lib/x86.ml
@ -1602,12 +1602,9 @@ let classify_c (l : loc) (t : Types.t) =
|
||||
| Types.String | Types.Slice _ -> [ Aint (l, Types.Ptr (Types.Mut, Types.Unit)); Alen l ]
|
||||
| Types.Unit | Types.Never -> []
|
||||
| Types.Vec _ | Types.Map _ -> [ Aptr l ]
|
||||
(* A fixed array crossing into a dyn view (M2 item 3) needs its address for
|
||||
the same reason: the view reads through it live and a copy would leave
|
||||
the caller's own array unseen by later writes through the view. Every
|
||||
[Rt] call that takes an array argument is [flan_dyn_view_flat], which
|
||||
never mutates the array's shape, so this is not the move-only case
|
||||
Vec/Map is. *)
|
||||
(* A fixed array crosses by address, as a Vec or a Map does: a runtime
|
||||
entry point that takes one reads it in place. (A dyn view is handed an
|
||||
explicit [addr_of] by check.ml's [box].) *)
|
||||
| Types.Array _ -> [ Aptr l ]
|
||||
| _ when is_agg t ->
|
||||
unsupported "aggregate %s across the C boundary" (Types.to_string t)
|
||||
@ -4216,6 +4213,16 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
|
||||
store_int f.b
|
||||
~src:rax ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "at"))
|
||||
~size:8;
|
||||
(* Zeroed at every push, as emit.ml's is: a dyn view of a local claims a
|
||||
number here, and the next call to land at this address must not
|
||||
inherit it. *)
|
||||
store_int f.b
|
||||
~src:rax ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "serial"))
|
||||
~size:8;
|
||||
(* The frame address, as emit.ml stores it: every local lies below it. *)
|
||||
store_int f.b
|
||||
~src:rbp ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "fp"))
|
||||
~size:8;
|
||||
lea f.b ~dst:rax ~mm:(Frame fr);
|
||||
store_int f.b ~src:rax ~mm:(lmem f head ~scratch:r11) ~size:8;
|
||||
(* The parameters are bound before the body starts, so they are recorded
|
||||
|
||||
@ -1111,6 +1111,16 @@ typedef struct flan_frame {
|
||||
* from that call since — which is why [flan_dev_frame_at_loc] is read for
|
||||
* the outer frames only. */
|
||||
const char *at;
|
||||
/* Zero at the push, and given a number from [flan_dev_frame_claim] the
|
||||
* first time a dyn view is taken of this frame's storage. It is what tells
|
||||
* this activation from the next call to land at the same address, which a
|
||||
* view kept past the return would otherwise take for its own. */
|
||||
uint64_t serial;
|
||||
/* The function's frame address (its rbp), stored at the push. Every local
|
||||
* of the function lies below it and above everything its callees push, so
|
||||
* a stack address belongs to the innermost frame whose [fp] is above it
|
||||
* ([flan_dev_frame_owner]). */
|
||||
const void *fp;
|
||||
} flan_frame;
|
||||
|
||||
/* The compiler names this symbol directly. A redefinition module reaches it
|
||||
@ -1134,6 +1144,52 @@ void flan_dev_frames_reset(void) { flan_frame_head = NULL; }
|
||||
void *flan_dev_frames_mark(void) { return flan_frame_head; }
|
||||
void flan_dev_frames_restore(void *head) { flan_frame_head = (flan_frame *)head; }
|
||||
|
||||
/* A dyn view of a local (flan_dyn.c, [view_make]): the frame's serial, made
|
||||
* on first use, and the function's name for the sentence a stale view prints
|
||||
* — copied out now, because by then the frame is dead stack. */
|
||||
static uint64_t flan_frame_serials;
|
||||
|
||||
uint64_t flan_dev_frame_claim(void *frame, const char **name,
|
||||
int64_t *namelen) {
|
||||
flan_frame *f = frame;
|
||||
*name = "?";
|
||||
*namelen = 1;
|
||||
if (f == NULL) return 0;
|
||||
if (f->info != NULL) {
|
||||
*name = f->info->name;
|
||||
*namelen = f->info->namelen;
|
||||
}
|
||||
if (f->serial == 0) f->serial = ++flan_frame_serials;
|
||||
return f->serial;
|
||||
}
|
||||
|
||||
/* Still on the chain, and still the same activation. The walk is from the
|
||||
* innermost frame out and is the depth of the stack at worst; dead stack
|
||||
* keeps its old bytes, so the serial alone cannot say the frame is gone. */
|
||||
int32_t flan_dev_frame_alive(const void *frame, uint64_t serial) {
|
||||
const flan_frame *f;
|
||||
for (f = flan_frame_head; f != NULL; f = f->prev)
|
||||
if (f == frame) return f->serial == serial;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* The frame whose storage holds the stack address [p], for a view the
|
||||
* compiler could not tie to its own frame: a slice of a local, or a slice
|
||||
* parameter over a caller's. The stack grows down, so [p] is on it only when
|
||||
* it is above this function's own frame, and it is the innermost Flan frame
|
||||
* whose frame address is above it that owns it. NULL for anything else — the
|
||||
* heap, a global, or stack above every Flan frame. */
|
||||
void *flan_dev_frame_owner(const void *p) {
|
||||
uintptr_t a = (uintptr_t)p;
|
||||
flan_frame *f;
|
||||
if (flan_frame_head == NULL
|
||||
|| a <= (uintptr_t)__builtin_frame_address(0))
|
||||
return NULL;
|
||||
for (f = flan_frame_head; f != NULL; f = f->prev)
|
||||
if (f->fp != NULL && (uintptr_t)f->fp > a) return f;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* [i] counts from the innermost. NULL past the end, which is how a caller
|
||||
* learns the depth without a second walk. */
|
||||
void *flan_dev_frame_at(int32_t i) {
|
||||
@ -1522,6 +1578,122 @@ static size_t flan_reg_slot(uintptr_t a) {
|
||||
& (FLAN_REG_CAP - 1);
|
||||
}
|
||||
|
||||
/* ── The registry by address ──────────────────────────────────────────
|
||||
*
|
||||
* The table above answers "which block starts here"; a dyn view crossing
|
||||
* asks "which live block holds this address", once per crossing, and a scan
|
||||
* of every slot for that cost microseconds a crossing. So each live block's
|
||||
* base is also filed under every 64 KiB chunk it overlaps, and the question
|
||||
* reads one chunk's short list. A block wider than FLAN_IX_WIDE chunks goes
|
||||
* on one list of its own, read every time; there are few such blocks. Only
|
||||
* the game thread reads or writes it.
|
||||
*
|
||||
* A base is filed when its note is written and taken out when the block dies.
|
||||
* An entry here is a hint, not a fact: the list names bases, and the answer
|
||||
* is always the table's entry for that base, checked live and containing. */
|
||||
#define FLAN_IX_SHIFT 16
|
||||
#define FLAN_IX_WIDE 64
|
||||
|
||||
typedef struct {
|
||||
uintptr_t key; /* chunk + 1; 0 for an empty bucket */
|
||||
int32_t n, cap;
|
||||
uintptr_t *bases;
|
||||
} flan_ix_bucket;
|
||||
|
||||
static flan_ix_bucket *flan_ix;
|
||||
static size_t flan_ix_cap, flan_ix_used;
|
||||
static uintptr_t *flan_ix_wide;
|
||||
static int32_t flan_ix_widen, flan_ix_widecap;
|
||||
|
||||
static size_t flan_ix_hash(uintptr_t key) {
|
||||
return (size_t)((key * 11400714819323198485ULL) >> 20);
|
||||
}
|
||||
|
||||
static flan_ix_bucket *flan_ix_find(uintptr_t chunk, int make) {
|
||||
uintptr_t key = chunk + 1;
|
||||
size_t i, mask;
|
||||
if (flan_ix_cap == 0) {
|
||||
if (!make) return NULL;
|
||||
flan_ix = (flan_ix_bucket *)calloc(1024, sizeof *flan_ix);
|
||||
if (flan_ix == NULL) return NULL;
|
||||
flan_ix_cap = 1024;
|
||||
}
|
||||
if (make && (flan_ix_used + 1) * 2 > flan_ix_cap) {
|
||||
size_t ncap = flan_ix_cap * 2, j;
|
||||
flan_ix_bucket *n = (flan_ix_bucket *)calloc(ncap, sizeof *n);
|
||||
if (n == NULL) return NULL;
|
||||
for (j = 0; j < flan_ix_cap; j++) {
|
||||
size_t k;
|
||||
if (flan_ix[j].key == 0) continue;
|
||||
for (k = flan_ix_hash(flan_ix[j].key) & (ncap - 1); n[k].key != 0;
|
||||
k = (k + 1) & (ncap - 1)) {}
|
||||
n[k] = flan_ix[j];
|
||||
}
|
||||
free(flan_ix);
|
||||
flan_ix = n;
|
||||
flan_ix_cap = ncap;
|
||||
}
|
||||
mask = flan_ix_cap - 1;
|
||||
for (i = flan_ix_hash(key) & mask;; i = (i + 1) & mask) {
|
||||
if (flan_ix[i].key == key) return &flan_ix[i];
|
||||
if (flan_ix[i].key == 0) {
|
||||
if (!make) return NULL;
|
||||
flan_ix[i].key = key;
|
||||
flan_ix_used++;
|
||||
return &flan_ix[i];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static void flan_ix_list_add(uintptr_t **v, int32_t *n, int32_t *cap,
|
||||
uintptr_t base) {
|
||||
int32_t i;
|
||||
for (i = 0; i < *n; i++) if ((*v)[i] == base) return;
|
||||
if (*n == *cap) {
|
||||
int32_t ncap = *cap ? *cap * 2 : 4;
|
||||
uintptr_t *nv = (uintptr_t *)realloc(*v, (size_t)ncap * sizeof **v);
|
||||
if (nv == NULL) return;
|
||||
*v = nv;
|
||||
*cap = ncap;
|
||||
}
|
||||
(*v)[(*n)++] = base;
|
||||
}
|
||||
|
||||
static void flan_ix_list_del(uintptr_t *v, int32_t *n, uintptr_t base) {
|
||||
int32_t i;
|
||||
for (i = 0; i < *n; i++)
|
||||
if (v[i] == base) { v[i] = v[--*n]; return; }
|
||||
}
|
||||
|
||||
static void flan_ix_file(uintptr_t base, int64_t bytes, int add) {
|
||||
uintptr_t c, lo = base >> FLAN_IX_SHIFT,
|
||||
hi = (base + (uintptr_t)bytes - 1) >> FLAN_IX_SHIFT;
|
||||
if (bytes <= 0) return;
|
||||
if (hi - lo >= FLAN_IX_WIDE) {
|
||||
if (add) flan_ix_list_add(&flan_ix_wide, &flan_ix_widen, &flan_ix_widecap, base);
|
||||
else flan_ix_list_del(flan_ix_wide, &flan_ix_widen, base);
|
||||
return;
|
||||
}
|
||||
for (c = lo; c <= hi; c++) {
|
||||
flan_ix_bucket *b = flan_ix_find(c, add);
|
||||
if (b == NULL) continue;
|
||||
if (add) flan_ix_list_add(&b->bases, &b->n, &b->cap, base);
|
||||
else flan_ix_list_del(b->bases, &b->n, base);
|
||||
}
|
||||
}
|
||||
|
||||
/* The live entry for [base], by the probe a free takes. */
|
||||
static flan_reg_entry *flan_reg_live_at(uintptr_t base) {
|
||||
size_t s = flan_reg_slot(base);
|
||||
int64_t probe;
|
||||
for (probe = 0; probe < FLAN_REG_CAP; probe++) {
|
||||
size_t j = (s + (size_t)probe) & (FLAN_REG_CAP - 1);
|
||||
if (flan_reg[j].base == 0) return NULL;
|
||||
if (flan_reg[j].base == base && flan_reg[j].died == 0) return &flan_reg[j];
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Drop every dead entry and re-insert the live ones. Called when the table is
|
||||
* filling *and* there is a worthwhile number of dead in it: in a long-running
|
||||
* program the dead are the bulk of it, and losing them is much cheaper than
|
||||
@ -1644,6 +1816,7 @@ static void flan_reg_note_full(void *base, int64_t bytes, int64_t elem,
|
||||
flan_reg[j].owner = owner;
|
||||
flan_reg[j].sliced = sliced;
|
||||
flan_reg_end(&flan_reg[j]);
|
||||
flan_ix_file(a, bytes, 1);
|
||||
return;
|
||||
}
|
||||
/* Every slot in use, and the compaction above declined to run because what
|
||||
@ -1736,6 +1909,7 @@ void flan_dev_reg_dead(void *base) {
|
||||
flan_reg[j].died = ++flan_reg_seq;
|
||||
flan_reg_end(&flan_reg[j]);
|
||||
flan_reg_dead++;
|
||||
flan_ix_file(a, flan_reg[j].bytes, 0);
|
||||
}
|
||||
return;
|
||||
}
|
||||
@ -1760,6 +1934,7 @@ void flan_dev_reg_dead_range(void *base, int64_t bytes) {
|
||||
e->died = now;
|
||||
flan_reg_end(e);
|
||||
flan_reg_dead++;
|
||||
flan_ix_file(e->base, e->bytes, 0);
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -1775,6 +1950,57 @@ int32_t flan_dev_reg_live(const void *p) {
|
||||
return (int32_t)(e != NULL && e->died == 0 ? 1 : 0);
|
||||
}
|
||||
|
||||
/* A dyn view's storage (flan_dyn.c, [view_make]): the smallest live block
|
||||
* holding [p], by base and sequence, so the view can ask later whether that
|
||||
* same note is still alive. The smallest, because an arena's own region can
|
||||
* be a block too, and it outlives the allocation inside it that a free-all
|
||||
* ends. 0 when no live block holds [p] — a global, a frame, C memory — and
|
||||
* always in a release build. Read through the address index above. */
|
||||
int32_t flan_dev_reg_claim(const void *p, uintptr_t *base, int64_t *seq,
|
||||
const char **type, int64_t *typelen) {
|
||||
uintptr_t a = (uintptr_t)p;
|
||||
flan_reg_entry *best = NULL;
|
||||
flan_ix_bucket *b;
|
||||
int32_t i, pass;
|
||||
if (!flan_reg_on || a == 0) return 0;
|
||||
b = flan_ix_find(a >> FLAN_IX_SHIFT, 0);
|
||||
for (pass = 0; pass < 2; pass++) {
|
||||
uintptr_t *v = pass == 0 ? (b ? b->bases : NULL) : flan_ix_wide;
|
||||
int32_t n = pass == 0 ? (b ? b->n : 0) : flan_ix_widen;
|
||||
for (i = 0; i < n; i++) {
|
||||
flan_reg_entry *e;
|
||||
if (a < v[i]) continue;
|
||||
e = flan_reg_live_at(v[i]);
|
||||
if (e == NULL || a >= e->base + (uintptr_t)e->bytes) continue;
|
||||
if (best == NULL || e->bytes < best->bytes) best = e;
|
||||
}
|
||||
}
|
||||
if (best == NULL) return 0;
|
||||
*base = best->base;
|
||||
*seq = best->seq;
|
||||
*type = best->type;
|
||||
*typelen = best->typelen;
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Is the note [flan_dev_reg_claim] found still there and alive? The probe a
|
||||
* free takes, keyed on the base: an entry is dropped only when its address is
|
||||
* handed out again, and the new note has a new sequence. A compaction moves
|
||||
* entries but keeps both. */
|
||||
int32_t flan_dev_reg_alive(uintptr_t base, int64_t seq) {
|
||||
size_t s;
|
||||
int64_t probe;
|
||||
if (!flan_reg_on || base == 0) return 1;
|
||||
s = flan_reg_slot(base);
|
||||
for (probe = 0; probe < FLAN_REG_CAP; probe++) {
|
||||
size_t j = (s + (size_t)probe) & (FLAN_REG_CAP - 1);
|
||||
if (flan_reg[j].base == 0) return 0;
|
||||
if (flan_reg[j].base != base || flan_reg[j].seq != seq) continue;
|
||||
return flan_reg[j].died == 0;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* What was at this address, in words, for the branch that may not follow it.
|
||||
* Emitted straight into the result buffer rather than returned: the caller is
|
||||
* a render thunk, which has no allocator, and every other piece of a rendering
|
||||
|
||||
1067
runtime/flan_dyn.c
1067
runtime/flan_dyn.c
File diff suppressed because it is too large
Load Diff
@ -302,56 +302,40 @@ flan_dyn flan_dyn_need_not_nil(flan_dyn v);
|
||||
* "", an empty vec, an empty map, and any keyword. Never traps. */
|
||||
uint8_t flan_dyn_truthy(flan_dyn v);
|
||||
|
||||
/* ── Typed containers as views — M2 item 3 ─────────────────────────────
|
||||
/* ── Typed containers as views ────────────────────────────────────────
|
||||
*
|
||||
* A [(Vec T)], a [T] slice, or a fixed [n T] array crossing into dyn is a
|
||||
* VIEW, not a copy: the box holds a small heap record naming where the
|
||||
* elements live and what one of them is, and every read or write goes
|
||||
* straight through to the container's own storage. [flan_dyn_at] boxes an
|
||||
* element on the way out; [flan_dyn_set_at] tag-checks the dyn value it is
|
||||
* given against the element type on the way in and traps, by [flan_trap],
|
||||
* on a mismatch — never a silent coercion.
|
||||
* A [(Vec T)], a [T] slice, a fixed [n T] array or a struct crossing into
|
||||
* dyn is a VIEW, not a copy: the box holds a small heap record naming where
|
||||
* the storage is and a descriptor of one element (flan_dyn.c documents the
|
||||
* code beside [desc_lay]), and every read or write goes straight through to
|
||||
* the container's own storage. A read boxes the element — every number
|
||||
* widens, an aggregate element answers a view of its own, a str is copied
|
||||
* into a text — and a write tag-checks and range-checks the dyn value
|
||||
* against the element type and traps, by [flan_trap], rather than coerce.
|
||||
* A struct's view answers the map tag: [get], [put] and (set (get p :k) v)
|
||||
* reach its fields.
|
||||
*
|
||||
* T is restricted to i64, f64 and bool — exactly the set [flan_dyn_need_i64]
|
||||
* and friends already treat as crossing the typed boundary both ways. That
|
||||
* is not an arbitrary cut: the excluded case that matters is a string
|
||||
* element, whose dyn form is a pointer into this collector's heap, while a
|
||||
* typed container's storage is arena or stack memory the collector never
|
||||
* scans. Writing such a pointer into that memory would be a live reference
|
||||
* nothing ever traces — a use-after-free the collector cannot see coming,
|
||||
* not a bug in this file but a hazard the type admits. i64, f64 and bool
|
||||
* carry no such pointer, so a view restricted to them cannot manufacture
|
||||
* it. [box] in lib/check.ml keeps the "does not cross into dyn yet" refusal
|
||||
* for every other element type, and this paragraph is why.
|
||||
* No collector pointer is ever written into typed storage, which the
|
||||
* collector never scans: that is why a str element is read-only from dyn and
|
||||
* an aggregate element is written through its own view, never replaced.
|
||||
*
|
||||
* Two kinds, because the containers split exactly here: a [(Vec T)] can grow
|
||||
* and move (a push may reallocate), a slice and a fixed array cannot.
|
||||
* [flan_dyn_view_at] with shape 1 takes the address of a Vec's own header —
|
||||
* the struct [flan_vec] in flan_rt.c, restated in flan_dyn.c under the same
|
||||
* "if either table changes, change both" rule — and every operation re-reads
|
||||
* its [ptr] and [len], so a push that grows and moves the Vec is never seen
|
||||
* as stale. A slice (flan_dyn_view_slice) and a fixed array (shape 0) are
|
||||
* snapshotted at the crossing, sound because neither moves; a struct is
|
||||
* shape 2.
|
||||
*
|
||||
* [flan_dyn_view_vec] takes the address of the Vec's own header — the
|
||||
* struct [flan_vec] in flan_rt.c, restated in flan_dyn.c under the same
|
||||
* "if either table changes, change both" rule this whole boundary already
|
||||
* lives under. That address is the Vec's home, fixed for as long as the Vec
|
||||
* exists — but "as long as the Vec exists" is the whole of the guarantee,
|
||||
* which is why [permanent_root] in lib/check.ml admits only storage that
|
||||
* outlives every frame: a global, a field or an array element of one, or a
|
||||
* slice cut from one at the crossing. A local's slot is a home too, and it
|
||||
* is precisely the one that is refused. Every operation re-reads that
|
||||
* header's [ptr] and [len] fresh, so a push that grows and moves the Vec is
|
||||
* never seen as stale — [flan_vec_grow] overwrites the SAME header's [ptr]
|
||||
* field in place, and there is no snapshot anywhere to go stale. That is
|
||||
* what makes the failure the open design question worried about
|
||||
* (a push through dyn holding a dangling pointer) impossible rather than
|
||||
* merely unlikely: there is nothing captured at the crossing for a later
|
||||
* push to invalidate.
|
||||
* The storage may be anywhere. [here] is the compiler's word that it is the
|
||||
* calling function's own frame; a dev build then records that activation
|
||||
* (runtime/flan_dev.c's shadow frame and its serial), and otherwise looks
|
||||
* the address up in its allocation registry, and every later operation
|
||||
* traps with DynStale when the frame has returned or the block has been
|
||||
* released. A release build records and checks nothing.
|
||||
*
|
||||
* [flan_dyn_view_flat] takes a data address and a length captured once, at
|
||||
* the crossing — sound for a slice and for a fixed array because neither
|
||||
* ever moves or grows. Note the asymmetry is not an oversight: pointing
|
||||
* *this* case at the value's own slot instead would be worse than a
|
||||
* snapshot, because a slot's lifetime is not the slice's, and a slice taken
|
||||
* from a Vec is already one push away from dangling on its own account
|
||||
* (flan_vec_grow's own comment says so) — the view is exactly as
|
||||
* stale-safe as the thing it is a view of, no more and no less.
|
||||
* The FLAN_VIEW_* entry points below are the first ABI, kept for
|
||||
* test/dyn_ops.c; the compiler calls the two after them.
|
||||
*/
|
||||
#define FLAN_VIEW_I64 0
|
||||
#define FLAN_VIEW_F64 1
|
||||
@ -359,6 +343,10 @@ uint8_t flan_dyn_truthy(flan_dyn v);
|
||||
|
||||
flan_dyn flan_dyn_view_vec(void *hdr, int32_t elem);
|
||||
flan_dyn flan_dyn_view_flat(void *data, int64_t len, int32_t elem);
|
||||
flan_dyn flan_dyn_view_slice(void *data, int64_t len, const uint8_t *desc,
|
||||
int64_t desclen, int32_t here);
|
||||
flan_dyn flan_dyn_view_at(void *addr, int64_t len, const uint8_t *desc,
|
||||
int64_t desclen, int32_t shape, int32_t here);
|
||||
|
||||
/* ── The collector ─────────────────────────────────────────────────────
|
||||
*
|
||||
|
||||
@ -539,7 +539,16 @@ static void refuse_view(const char *what) {
|
||||
} else if (strcmp(what, "wrongfloat") == 0) {
|
||||
static double ff[1];
|
||||
v = flan_dyn_view_flat(ff, 1, FLAN_VIEW_F64);
|
||||
FDYN_set_at(v, flan_dyn_from_i64(0), text("nope"));
|
||||
} else if (strcmp(what, "inexactfloat") == 0) {
|
||||
/* An int goes into a float element only when the float holds it
|
||||
exactly; 2^53 + 1 is the first an f64 does not. */
|
||||
static double ff[1];
|
||||
v = flan_dyn_view_flat(ff, 1, FLAN_VIEW_F64);
|
||||
FDYN_set_at(v, flan_dyn_from_i64(0), flan_dyn_from_i64(1));
|
||||
if (ff[0] != 1.0) { printf("an exact int did not land: %g\n", ff[0]); exit(1); }
|
||||
FDYN_set_at(v, flan_dyn_from_i64(0),
|
||||
flan_dyn_from_i64(((int64_t)1 << 53) + 1));
|
||||
} else if (strcmp(what, "flatpush") == 0) {
|
||||
v = flan_dyn_view_flat(buf, 2, FLAN_VIEW_I64);
|
||||
FDYN_push(v, flan_dyn_from_i64(9));
|
||||
|
||||
292
test/programs/dyn-view-any.flan
Normal file
292
test/programs/dyn-view-any.flan
Normal file
@ -0,0 +1,292 @@
|
||||
;;;; 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 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)
|
||||
:else (do (println "?") 1))))
|
||||
@ -5,24 +5,8 @@
|
||||
;;;; caller's own value, which is what makes [dv] below the SAME storage [v]
|
||||
;;;; is and not a copy of it.
|
||||
;;;;
|
||||
;;;; Every container viewed below is a GLOBAL, and that is not incidental to
|
||||
;;;; this program — it is the lifetime guard review added after the first
|
||||
;;;; landing: a view's descriptor chases the container's own address on every
|
||||
;;;; operation, which is what makes a Vec's growth safe, but it is also what
|
||||
;;;; makes a DANGLING container's address a live hazard. box refuses a Vec, a
|
||||
;;;; slice or a fixed array whose storage is not known to outlive the view —
|
||||
;;;; a local's, a parameter's, a temporary's — and a global's is the one
|
||||
;;;; storage this milestone can prove permanent: fixed in .data for the
|
||||
;;;; process — as is a field of one, and an ELEMENT of one when the global
|
||||
;;;; is an array, whose elements sit inside its own storage. An element of a
|
||||
;;;; global SLICE is not: the slice is ptr+len and says nothing about where
|
||||
;;;; the data is — and that holds at every index of a multi-index (at g i j),
|
||||
;;;; not just the first, so one slice level anywhere in the walk refuses.
|
||||
;;;; test_flan.ml's checker tests carry the refusal side of this (a local
|
||||
;;;; Vec, a Vec parameter, a Vec behind a Ptr, a slice rebound to a local, an
|
||||
;;;; element of a global slice, and an element reached through a slice at a
|
||||
;;;; later index level); this program is the acceptance side, over storage
|
||||
;;;; the guard allows.
|
||||
;;;; Every container viewed below is a global; dyn-view-any.flan covers
|
||||
;;;; the other storage and element types.
|
||||
;;;;
|
||||
;;;; Mode 0 is the survey: a read through the view boxes the element
|
||||
;;;; correctly, a write through either side is seen through the other, and a
|
||||
|
||||
@ -5903,6 +5903,104 @@ level "1"
|
||||
dyn_view ~opt:"-O0" ();
|
||||
dyn_view ~x86:true ();
|
||||
|
||||
(* ── Any typed container crosses as a view ─────────────────────────
|
||||
programs/dyn-view-any.flan: every integer width, f32, bool, str, a
|
||||
struct and a padded one, nested arrays, arrays and Vecs of structs,
|
||||
over locals, parameters, a temporary, a heap slice and an arena's Vec
|
||||
(mode 0); then one trap per mode. The traps a release build cannot
|
||||
see — a view kept past its frame, a slice kept past its Vec's growth,
|
||||
past a free, past a free-all — run under --dev only, on both
|
||||
backends. The survey's text was captured from the running program and
|
||||
is the same in all five builds. *)
|
||||
let any_out =
|
||||
"i8 [0 -1 -2]\nu8 [251 252 253]\ni16 [-299 301]\nu16 [60001 2]\n\
|
||||
i32 [-69999 70001]\nu32 [4000000001 2]\ni64 [-4 6]\n\
|
||||
u64 [9000000000000000001 2]\n253\n\
|
||||
f32 [2.75 3.1]\n4\n\
|
||||
bool [true true true]\ntrue\n\
|
||||
EIINNOORRSSTT\n\
|
||||
point #Point{:x 0.5 :y 3}\n40\n9.5\n9.5\n2\ntrue\n\
|
||||
mix #Mix{:a 7 :b -9000000000 :c 2.5 :d true :e [1 2 3] :f -4}\n65535\n\
|
||||
named #Named{:name \"ada\" :id 7}\n\
|
||||
grid [[1 2 3] [4 5 60]]\n60\n\
|
||||
points [#Point{:x 1 :y 1} #Point{:x 2 :y 20}]\n20\n\
|
||||
vec [1 2 3]\n3\n6\n5\n4\n3\n\
|
||||
temp #Point{:x 1.5 :y 2}\n4\n3\ntrue\n\
|
||||
15 2.5 1 true 20\n15 2.5 true 20\n"
|
||||
in
|
||||
let any_traps =
|
||||
[ ("1", "300 does not fit a u8 element, which holds 0 to 255");
|
||||
("2", "this u64 element is 18000000000000000000, above the largest \
|
||||
dyn int");
|
||||
("3", "a Point has no field :z. Its fields are :x :y");
|
||||
("8", "field :name of a Named is a str, which is read-only through \
|
||||
a dyn view");
|
||||
("9", "16777217 has no exact f32");
|
||||
("10", "dyn put: a Point has no field :z. Its fields are :x :y");
|
||||
("14", "dyn-view-any.flan:272:39: dyn put: field :x of a Small is an \
|
||||
i8, and 1.5 is a float — (put #Small{:x 1 :z true} :x 1.5)");
|
||||
("15", "dyn put: field :z of a Small is a bool, and the value is nil \
|
||||
— (put #Small{:x 1 :z true} :z nil)");
|
||||
("16", "dyn put: field :x of a Small is an i8, which holds -128 to \
|
||||
127, and 200 does not fit");
|
||||
("19", "#Wide{:a 18000000000000000000 :b 1}\n");
|
||||
("19", "dyn-view-any.flan:287:18: dyn get: this u64 element is \
|
||||
18000000000000000000");
|
||||
("20", "200 does not fit an i8 element, which holds -128 to 127") ]
|
||||
and any_stale =
|
||||
[ ("4", "this view points into a local of leak-local, and that call \
|
||||
has returned");
|
||||
("5", "this view's storage, a block of i64, has been released");
|
||||
("6", "this view's storage, a block of i64, has been released");
|
||||
("7", "this view's storage, a block of i32, has been released");
|
||||
("12", "this view points into a local of leak-slice-local, and that \
|
||||
call has returned");
|
||||
("13", "this view points into a local of leak-slice-param, and that \
|
||||
call has returned");
|
||||
("17", "dyn-view-any.flan:279:44: dyn print: this view points into a \
|
||||
local of leak-local");
|
||||
("18", "dyn-view-any.flan:281:53: dyn length: this view points into \
|
||||
a local of leak-local") ]
|
||||
in
|
||||
let dyn_view_any ?opt ?(x86 = false) ?(dev = false) () =
|
||||
let exe = compile ?opt ~x86 ~dev "programs/dyn-view-any.flan" in
|
||||
let name what =
|
||||
"dyn: any container's view" ^ what
|
||||
^ (match opt with Some o -> ", " ^ o | None -> "")
|
||||
^ (if x86 then ", --x86" else "") ^ (if dev then ", --dev" else "")
|
||||
in
|
||||
let code, text = run exe (Some "0") in
|
||||
if code <> 0 || text <> any_out then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL %s\n got: %S (exit %d)\n wanted: %S\n"
|
||||
(name "") text code any_out
|
||||
end;
|
||||
List.iter
|
||||
(fun (mode, needle) ->
|
||||
let code, text = run exe (Some mode) in
|
||||
if code <> 134 || not (contains text needle) then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL %s\n got: %S (exit %d)\n wanted a trap \
|
||||
saying %S\n" (name (", mode " ^ mode)) text code needle
|
||||
end)
|
||||
(any_traps @ if dev then any_stale else []);
|
||||
(* The collector takes back what it charged for a view: a leak here
|
||||
once doubled the heap's trigger forever. *)
|
||||
let code, text = run exe (Some "11") in
|
||||
if code <> 0 || text <> "300000 true\n" then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL %s\n got: %S (exit %d)\n"
|
||||
(name ", views are collected") text code
|
||||
end;
|
||||
(try Sys.remove exe with Sys_error _ -> ())
|
||||
in
|
||||
dyn_view_any ();
|
||||
dyn_view_any ~opt:"-O0" ();
|
||||
dyn_view_any ~x86:true ();
|
||||
dyn_view_any ~dev:true ();
|
||||
dyn_view_any ~dev:true ~x86:true ();
|
||||
|
||||
(* The root count, which is the part of this feature the runs above cannot
|
||||
check — and the reason has outlived the stub it was first written
|
||||
about. flan_dyn.c's trigger has a one-megabyte floor, and not one
|
||||
|
||||
@ -258,6 +258,7 @@ let () =
|
||||
("wrongwrite", "this view's elements are int");
|
||||
("wrongbool", "this view's elements are bool");
|
||||
("wrongfloat", "this view's elements are float");
|
||||
("inexactfloat", "9007199254740993 has no exact f64");
|
||||
("flatpush", "this view is a slice or an array and cannot grow");
|
||||
(* And the operator's own name in that sentence. [flan_dyn_len] hands
|
||||
a string down twice — once to its type trap and once to the view
|
||||
|
||||
@ -1525,105 +1525,80 @@ let () =
|
||||
"(defonce v (Vec f64) (vec-new f64))\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take v))";
|
||||
(* The element restriction is still refused, and by name: a string element
|
||||
would need a dyn string's own boxing, whose payload is a pointer into
|
||||
the collector's heap, planted where nothing will ever trace it. *)
|
||||
rejects_check "a Vec of strings does not view into dyn yet"
|
||||
(* Every element a view can describe crosses: every number, bool, str,
|
||||
struct, and arrays, slices and Vecs of those. What cannot be described
|
||||
is refused by name — a pointer, an Option, a function, a map, an enum
|
||||
or a data type inside the container. *)
|
||||
accepts "a Vec of strings views into dyn, read-only"
|
||||
"(defonce v (Vec str) (vec-new str))\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take v))"
|
||||
~needle:"only when its elements are i64, f64 or bool";
|
||||
rejects_check "an i32 element is not one of the view's three"
|
||||
(defn main [] i32 (take v))";
|
||||
accepts "an i32 element views into dyn"
|
||||
"(defonce v (Vec i32) (vec-new i32))\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take v))";
|
||||
rejects_check "a Vec of pointers does not view into dyn"
|
||||
"(defonce v (Vec (Ptr i64)) (vec-new (Ptr i64)))\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take v))"
|
||||
~needle:"only when its elements are i64, f64 or bool";
|
||||
~needle:"a (Ptr i64) is none of these";
|
||||
rejects_check "a struct with an Option field names the field's type"
|
||||
"(defstruct Maybe [x (Option i64)])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (Maybe {.x None})))"
|
||||
~needle:"a (Option i64) is none of these";
|
||||
(* A typed (Map K V) is unrelated to item 3 and keeps its own refusal. *)
|
||||
rejects_check "a typed Map still refuses into dyn"
|
||||
"(defonce m (Map i64 i64) (map-new i64 i64))\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take m))"
|
||||
~needle:"does not cross into dyn yet";
|
||||
(* Which of the two refusals wins when both apply. A LOCAL (Vec string)
|
||||
fails the lifetime guard and the element check both, and the element
|
||||
one has to be the one that speaks: the lifetime message names
|
||||
(defonce g ...) as the spelling that works, and for a string element
|
||||
the global spelling is refused too, so the other order would hand back
|
||||
advice that fails when taken. *)
|
||||
rejects_check "a local Vec of strings gets the element refusal, not the \
|
||||
lifetime one"
|
||||
(* Any storage: a local, a parameter, a temporary, a slice bound to a
|
||||
local, an element of a global slice, and a container behind a pointer.
|
||||
A dev build checks each against its frame or its block at run time
|
||||
(test_acceptance.ml, dyn-view-any.flan); nothing is refused here. *)
|
||||
accepts "a local Vec views into dyn"
|
||||
"(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (let [v (vec-new str)] (take v)))"
|
||||
~needle:"only when its elements are i64, f64 or bool";
|
||||
(* ── The lifetime guard, added on review ─────────────────────────
|
||||
A local, a parameter and a temporary all answer false to
|
||||
[permanent_root], and each gets the same message rather than "cannot be
|
||||
indexed" or some other accident of which path noticed. *)
|
||||
rejects_check "a local Vec does not view into dyn — its frame ends"
|
||||
"(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (let [v (vec-new i64)] (take v)))"
|
||||
~needle:"only when it is a global";
|
||||
rejects_check "a Vec parameter does not view into dyn"
|
||||
(defn main [] i32 (let [v (vec-new i64)] (take v)))";
|
||||
accepts "a Vec parameter views into dyn"
|
||||
"(defn take [d dyn] i32 1)\n\
|
||||
(defn give [v (Vec i64)] i32 (take v))\n\
|
||||
(defn main [] i32 0)"
|
||||
~needle:"only when it is a global";
|
||||
rejects_check "a fixed array local does not view into dyn"
|
||||
(defn main [] i32 0)";
|
||||
accepts "a fixed array local views into dyn"
|
||||
"(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (let [a (array 4 i64)] (take a)))"
|
||||
~needle:"only when it is a global";
|
||||
(* A slice cut from a global is permanent; the same slice expression
|
||||
rebound to a local first loses the trace back to it and is refused —
|
||||
conservative rather than wrong, and the message says what does work. *)
|
||||
accepts "a slice cut from a global inline is still permanent"
|
||||
(defn main [] i32 (let [a (array 4 i64)] (take a)))";
|
||||
accepts "a slice cut from a global inline views into dyn"
|
||||
"(defonce xs [3 i64])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (slice xs 0 3)))";
|
||||
rejects_check "a slice rebound to a local loses the trace and is refused"
|
||||
accepts "a slice bound to a local views into dyn"
|
||||
"(defonce xs [3 i64])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (let [s (slice xs 0 3)] (take s)))"
|
||||
~needle:"only when it is a global";
|
||||
(* An element of a global is permanent only when the global is an ARRAY.
|
||||
An array's elements are inside the global's own storage; a slice's are
|
||||
not — a global [[T]] holds ptr+len and nothing more, and what they
|
||||
point at may be a frame that has already returned. The refusal row
|
||||
below is one word different from the acceptance row above it, which is
|
||||
the point: it is the [At] arm's demand for an array at the level being
|
||||
indexed and nothing else deciding. Before that guard the refusal row
|
||||
compiled and segfaulted with no diagnostic at all. *)
|
||||
accepts "an element of a global array is permanent"
|
||||
(defn main [] i32 (let [s (slice xs 0 3)] (take s)))";
|
||||
accepts "an element of a global array views into dyn"
|
||||
"(defonce rows [2 (Vec i64)])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (at rows 0)))";
|
||||
rejects_check "an element of a global slice is not permanent"
|
||||
accepts "an element of a global slice views into dyn"
|
||||
"(defonce sv [(Vec i64)])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (at sv 0)))"
|
||||
~needle:"only when it is a global";
|
||||
(* [(at g i j)] is ONE typed node holding both indices, not two nested
|
||||
ones, so a guard that reads the target's type alone sees level zero and
|
||||
nothing after it. These two rows pin the multi-index spelling on both
|
||||
sides: every level an array is permanent, and a slice at ANY level is
|
||||
not — including the second, which the one-level guard accepted and
|
||||
which then printed a dead frame's contents with exit 0. *)
|
||||
accepts "an element of a global array of arrays is permanent"
|
||||
(defn main [] i32 (take (at sv 0)))";
|
||||
accepts "an element of a global array of arrays views into dyn"
|
||||
"(defonce rows [2 [3 (Vec i64)]])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (at rows 0 1)))";
|
||||
rejects_check "an element reached through a slice level is not permanent"
|
||||
accepts "an element reached through a slice level views into dyn"
|
||||
"(defonce g [2 [[3 i64]]])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (take (at g 0 1)))"
|
||||
~needle:"only when it is a global";
|
||||
(* A Vec behind a Ptr is refused even though some Ptrs really are
|
||||
heap-durable — the checker cannot tell this one from a Ptr taken off a
|
||||
local, and admitting one admits the other. *)
|
||||
rejects_check "a Vec behind a Ptr does not view into dyn"
|
||||
(defn main [] i32 (take (at g 0 1)))";
|
||||
accepts "a Vec behind a Ptr views into dyn"
|
||||
"(defn take [d dyn] i32 1)\n\
|
||||
(defn use [p (Ptr (Vec i64))] i32 (take (deref p)))\n\
|
||||
(defn main [] i32 0)"
|
||||
~needle:"only when it is a global";
|
||||
(defn main [] i32 0)";
|
||||
accepts "a struct views into dyn"
|
||||
"(defstruct P [x f32 y u8])\n\
|
||||
(defn take [d dyn] i32 1)\n\
|
||||
(defn main [] i32 (let [p (P {.x 1.0 .y 2})] (take p)))";
|
||||
(* A bracket *literal* is not a typed container yet, and where a dyn is
|
||||
wanted it builds the runtime's own vec instead — the lowering the map
|
||||
literal's values ride on, and what makes {:xs [1 2]} mean what it
|
||||
@ -3706,12 +3681,10 @@ let () =
|
||||
|
||||
The three-element spelling does not mean this, and could not. A defonce
|
||||
whose third element is not a type is a *dyn* global by the 2026-09-20
|
||||
rule, and a typed fixed array crosses into dyn only as a view of storage
|
||||
that outlives the view. A freshly built array is a temporary, so the view
|
||||
lifetime guard refuses it — and where the elements are an array rather
|
||||
than one of the three scalar widths a view carries, the element refusal
|
||||
gets there first. Both refusals are the ones any other temporary gets;
|
||||
neither was written for this form. *)
|
||||
rule, and a typed fixed array crosses into dyn as a view of its
|
||||
storage. A freshly built array is the initialiser's temporary, gone when
|
||||
the initialiser returns, so a view of it is refused there by name with
|
||||
the typed spelling as the fix. *)
|
||||
defvar_reading "a typed array-fill global is computed, not zeroed"
|
||||
"(defconst rows 2) (defconst cols 3)\n\
|
||||
(defonce grid [rows [cols u8]] (array-fill [rows cols] 255))\n\
|
||||
@ -3719,10 +3692,11 @@ let () =
|
||||
"grid" ~ty:"[2 [3 u8]]" ~zeroed:false;
|
||||
rejects_check "a three-element array-fill defonce is the dyn reading"
|
||||
"(defonce xs (array-fill [3] (i64 1))) (defn f [] ())"
|
||||
~needle:"only when it is a global";
|
||||
rejects_check "and its element type is asked about first"
|
||||
~needle:"xs is a dyn global, and its initialiser builds a [3 i64] that is \
|
||||
gone once the initialiser returns";
|
||||
rejects_check "and the fix it names is the typed spelling"
|
||||
"(defonce grid (array-fill [2 3] 255)) (defn f [] ())"
|
||||
~needle:"only when its elements are i64, f64 or bool";
|
||||
~needle:"as in (defonce grid [2 [3 i32]] ...)";
|
||||
(* A defconst is not a second path to it: its value is what the linker
|
||||
writes into the image, and a fill is a loop. *)
|
||||
rejects_check "array-fill is not a constant's value"
|
||||
@ -7670,14 +7644,18 @@ let () =
|
||||
infers "the names the element type of a mixed literal" "(the [dyn] [1 2.5])" "[2 dyn]";
|
||||
infers "the with a slice type gives the literal's array type"
|
||||
"(the [f32] [1 2.5])" "[2 f32]";
|
||||
(match checked "(defstruct P [x i32]) (defn main [] i32 (let [a [(P 1) 2]] 0))" with
|
||||
| _ -> check "a struct beside a number is refused" false
|
||||
(* A struct crosses into dyn as a view, so a struct beside a number is a dyn
|
||||
vector; a pointer has no dyn form, so it is refused against the first. *)
|
||||
accepts "a struct beside a number is a dyn vector"
|
||||
"(defstruct P [x i32]) (defn main [] i32 (let [a [(P 1) 2]] (println a) 0))";
|
||||
(match checked "(defn main [] i32 (let [x 1 a [(addr x) 2]] 0))" with
|
||||
| _ -> check "a pointer beside a number is refused" false
|
||||
| exception Loc.Error d ->
|
||||
check "elements that cannot become a dyn are refused against the first"
|
||||
(contains d.Loc.dmsg "expected P, found the integer literal 2"
|
||||
(contains d.Loc.dmsg "expected (Ptr i32), found the integer literal 2"
|
||||
&& List.exists
|
||||
(fun (n : Loc.note) ->
|
||||
contains n.Loc.nmsg "this array's first element is P")
|
||||
contains n.Loc.nmsg "this array's first element is (Ptr i32)")
|
||||
d.Loc.notes));
|
||||
(match checked "(defn g [x $t] i32 (let [a [x 1]] 0))" with
|
||||
| _ -> check "a type variable beside a literal is refused" false
|
||||
|
||||
@ -262,6 +262,10 @@ let corpus =
|
||||
view that grows and moves the Vec leaves anything for ASan's
|
||||
use-after-free detection to find. *)
|
||||
"programs/dyn-view.flan", [ "0" ];
|
||||
(* Views of every element type over locals, parameters, a temporary, a
|
||||
heap slice and an arena's Vec: the offsets the runtime computes from
|
||||
a descriptor, read and written under ASan. *)
|
||||
"programs/dyn-view-any.flan", [ "0" ];
|
||||
"programs/x86-p13-dyn-collect.flan", [];
|
||||
"programs/sand-headless.flan", [];
|
||||
"programs/signedness.flan", [];
|
||||
|
||||
@ -1226,46 +1226,54 @@ let checks name text =
|
||||
let () =
|
||||
let poke_fln = "fn poke(coll) -> dyn\n coll[0] = 99\n coll\n\n" in
|
||||
let poke_flan = "(defn poke [coll] dyn (set (at coll 0) 99) coll)\n" in
|
||||
(* A typed local is not a global, so no dyn value may see into it. *)
|
||||
(* A container of pointers has no dyn view, and the refusal's subject and
|
||||
fix follow what the container is: a local, a temporary, a parameter. *)
|
||||
refused "view-local.fln"
|
||||
(poke_fln ^ "fn main() -> ()\n let a: [4 i64] = [6 2 4 9]\n poke(a)\n")
|
||||
[ "a is a [4 i64], and a dyn value is wanted here";
|
||||
"a local, a parameter or a temporary";
|
||||
(poke_fln ^ "fn main() -> ()\n let a = vec-new(Ptr(i64))\n poke(a)\n")
|
||||
[ "a is a Vec(Ptr(i64)), and a dyn value is wanted here";
|
||||
"a Ptr(i64) is none of these";
|
||||
"as in let a: dyn = [...]" ];
|
||||
refused "view-local.flan"
|
||||
(poke_flan ^ "(defn main [] () (let [a (array 4 i64)] (poke a)))\n")
|
||||
[ "a is a [4 i64]"; "as in (let [a (the dyn [...])] ...)" ];
|
||||
(poke_flan ^ "(defn main [] () (let [a (vec-new (Ptr i64))] (poke a)))\n")
|
||||
[ "a is a (Vec (Ptr i64))"; "as in (let [a (the dyn [...])] ...)" ];
|
||||
refused "view-temp.flan"
|
||||
(poke_flan ^ "(defn main [] () (poke (array 4 i64)))\n")
|
||||
[ "This is a [4 i64]"; "as in (the dyn [...])" ];
|
||||
(* An unannotated literal is [4 i32], whose elements no view carries. *)
|
||||
refused "view-elem.fln"
|
||||
(poke_fln ^ "fn main() -> ()\n let d = [6 2 4 9]\n poke(d)\n")
|
||||
[ "d is a [4 i32]"; "only when its elements are i64, f64 or bool, and these are i32";
|
||||
"as in let d: dyn = [...]" ];
|
||||
(poke_flan ^ "(defn main [] () (poke (vec-new (Ptr i64))))\n")
|
||||
[ "This is a (Vec (Ptr i64))"; "as in (the dyn [...])" ];
|
||||
(* Any storage and any number crosses: a local [4 i32] is a view. *)
|
||||
checks "view-elem.fln"
|
||||
(poke_fln ^ "fn main() -> ()\n let d = [6 2 4 9]\n poke(d)\n");
|
||||
(* A parameter is made by the caller, so its fix is its declaration. *)
|
||||
refused "view-param.fln"
|
||||
"fn take(d) -> i32 = 1\n\nfn give(n: i32, v: [4 i64]) -> i32\n take(v)\n\n\
|
||||
"fn take(d) -> i32 = 1\n\nfn give(n: i32, v: [Ptr(i64)]) -> i32\n take(v)\n\n\
|
||||
fn main() -> i32 = 0\n"
|
||||
[ "v is a [4 i64] parameter"; "Declare v as dyn in give's parameters: v: dyn" ];
|
||||
[ "v is a [Ptr(i64)] parameter"; "Declare v as dyn in give's parameters: v: dyn" ];
|
||||
refused "view-param.flan"
|
||||
"(defn take [d dyn] i32 1)\n(defn give [n i32 v (Vec i64)] i32 (take v))\n\
|
||||
"(defn take [d dyn] i32 1)\n(defn give [n i32 v (Vec (Ptr i64))] i32 (take v))\n\
|
||||
(defn main [] i32 0)\n"
|
||||
[ "v is a (Vec i64) parameter"; "Declare v as dyn in give's parameters: v dyn" ];
|
||||
[ "v is a (Vec (Ptr i64)) parameter"; "Declare v as dyn in give's parameters: v dyn" ];
|
||||
checks "view-param-fix.fln"
|
||||
"fn take(d) -> i32 = 1\n\nfn give(n: i32, v: dyn) -> i32\n take(v)\n\n\
|
||||
fn main() -> i32 = 0\n";
|
||||
(* A global's fix redefines it, in the form it was defined with. *)
|
||||
let show_flan = "(defn show [d dyn] i32 1)\n" in
|
||||
refused "view-global.flan"
|
||||
("(defonce gs [2 i32] [1 2])\n" ^ show_flan ^ "(defn main [] i32 (show gs))\n")
|
||||
[ "gs is a [2 i32]"; "as in (defonce gs dyn [...])" ];
|
||||
("(defonce gs (Vec (Ptr i32)) (vec-new (Ptr i32)))\n" ^ show_flan
|
||||
^ "(defn main [] i32 (show gs))\n")
|
||||
[ "gs is a (Vec (Ptr i32))"; "as in (defonce gs dyn [...])" ];
|
||||
refused "view-global-def.flan"
|
||||
("(def gs [2 i32] [1 2])\n" ^ show_flan ^ "(defn main [] i32 (show gs))\n")
|
||||
("(def gs (Vec (Ptr i32)) (vec-new (Ptr i32)))\n" ^ show_flan
|
||||
^ "(defn main [] i32 (show gs))\n")
|
||||
[ "as in (def gs dyn [...])" ];
|
||||
refused "view-global.fln"
|
||||
"once gs: [2 i32] = [1 2]\n\nfn show(d) -> i32 = 1\n\nfn main() -> i32 = show(gs)\n"
|
||||
[ "gs is a [2 i32]"; "as in once gs: dyn = [...]" ];
|
||||
"once gs: Vec(Ptr(i32)) = vec-new(Ptr(i32))\n\nfn show(d) -> i32 = 1\n\n\
|
||||
fn main() -> i32 = show(gs)\n"
|
||||
[ "gs is a Vec(Ptr(i32))"; "as in once gs: dyn = [...]" ];
|
||||
checks "view-global-typed.flan"
|
||||
("(defonce gs [2 i32] [1 2])\n" ^ show_flan ^ "(defn main [] i32 (show gs))\n");
|
||||
(* A dyn global's initialiser cannot view what it builds itself. *)
|
||||
refused "view-global-init.fln"
|
||||
"once xs = array-fill([3], i64(1))\n\nfn main() -> i32 = 0\n"
|
||||
[ "xs is a dyn global"; "as in once xs: [3 i64] = ..." ];
|
||||
checks "view-global-fix.flan"
|
||||
("(defonce gs dyn [1 2])\n(def hs dyn [1 2])\n" ^ show_flan
|
||||
^ "(defn main [] i32 (show gs) (show hs))\n");
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user