diff --git a/TODO.org b/TODO.org index 97a1ca8a..63e2e893 100644 --- a/TODO.org +++ b/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] diff --git a/docs/BUILT.md b/docs/BUILT.md index c1cf78c2..e9f3ef4f 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -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 diff --git a/lib/check.ml b/lib/check.ml index f441af37..aa7423a1 100644 --- a/lib/check.ml +++ b/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) -> diff --git a/lib/emit.ml b/lib/emit.ml index 51ace083..97240c6e 100644 --- a/lib/emit.ml +++ b/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) diff --git a/lib/x86.ml b/lib/x86.ml index cd6f993e..8a512401 100644 --- a/lib/x86.ml +++ b/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 diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index 3825e777..d4ed83fc 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -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 diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 250f8f37..8c2a24e6 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -355,15 +355,17 @@ typedef struct flan_obj { entries and [cap] counting entries too. Sharing the arm is what lets the marker and the sweep treat the two kinds with one load and a doubled count rather than a second field to keep in step. */ - /* OBJ_VIEW: a typed container's elements, native words this file did not - allocate and does not own. [is_vec] set means [base] is a - [flan_dyn_vec_hdr *] and [len] here is unused — the live length is - read from the header on every operation, which is the whole of why a - Vec growing through the view cannot go stale. [is_vec] clear means - [base] is the first element's address and [len] is the snapshot taken - at the crossing, for a slice or a fixed array, neither of which moves. - [elem] is one of FLAN_VIEW_I64/F64/BOOL. */ - struct { void *base; int64_t len; int32_t elem; int32_t is_vec; } view; + /* OBJ_VIEW: typed storage this file did not allocate and does not own. + The shape is in the header's [gen], which only a class instance + otherwise uses: VIEW_VEC means [base] is a [flan_dyn_vec_hdr *] whose + length is read live, which is why a Vec growing through the view + cannot go stale; VIEW_FLAT means [base] is the first element and the + header's [len] the count taken at the crossing, for a slice or a fixed + array; VIEW_STRUCT means [base] is one struct. [desc] is the element's + descriptor, or the struct's. [nul] is always NULL and sits where a + map's [klass] does, so a struct view answers "no class" to every class + question without a branch. A [view_guard] trails the header. */ + struct { void *base; const uint8_t *desc; void *nul; } view; /* OBJ_ENV: the descriptor the environment's bytes are marked through, or NULL when it holds nothing the collector follows. [len] is the byte count, and the bytes trail the header as a text's do. */ @@ -390,6 +392,20 @@ static inline int64_t obj_words(flan_obj *o) { static inline uint8_t *obj_text_bytes(flan_obj *o) { return (uint8_t *)(o + 1); } +/* What trails an OBJ_VIEW's header: the dev check's record of its storage, + * explained with the view helpers below. Allocated with every view, and + * charged to the heap and taken back by the sweep with it. */ +typedef struct view_guard { + const void *frame; /* NULL when no frame is checked */ + uint64_t serial; + const char *fname; /* whose frame, for the sentence */ + int64_t fnamelen; + uintptr_t rbase; /* 0 when no block is checked */ + int64_t rseq; + const char *rtype; + int64_t rtypelen; +} view_guard; + static flan_obj *gc_all; /* the sweep list */ static int64_t gc_bytes; /* what the live objects hold, headers included */ static int64_t gc_count; @@ -520,7 +536,9 @@ int32_t flan_dyn_tag(flan_dyn v) { side there is nothing to tell them apart by, which is the point of a view being indistinguishable rather than a fourth kind of vec. */ case OBJ_VEC: return FLAN_DYN_TAG_VEC; - case OBJ_VIEW: return FLAN_DYN_TAG_VEC; + /* ...and a struct's view answers a map's, [gen] being its shape + (VIEW_STRUCT, below). */ + case OBJ_VIEW: return o->gen == 2 ? FLAN_DYN_TAG_MAP : FLAN_DYN_TAG_VEC; case OBJ_MAP: return FLAN_DYN_TAG_MAP; default: return FLAN_DYN_TAG_INT; } @@ -631,9 +649,18 @@ static double dyn_num_value(flan_dyn v); * they are defined, alongside the container operations below */ static int64_t view_len(const uint8_t *loc, int64_t loclen, const char *op, flan_obj *o); -static void *view_base(flan_obj *o); -static flan_dyn view_box(int32_t elem, const uint8_t *p); -static int64_t view_elem_size(int32_t elem); +static void view_guard_check(const uint8_t *loc, int64_t loclen, + const char *op, flan_obj *o); +/* A struct view's fields, for the map arms of the printers. */ +static int64_t view_nfields(flan_obj *o); +static flan_dyn view_field_key(flan_obj *o, int64_t i); +static flan_dyn view_field_val(flan_obj *o, int64_t i); +static void view_struct_name(flan_obj *o, const char **name, int64_t *len); +/* 1 when element (or, with [field], field) [i] of view [o] is a u64 above + * the largest dyn int: it has no dyn value, and the printers write its + * digits instead of reading it. */ +static int view_big_u64(flan_obj *o, int64_t i, int field, + unsigned long long *out); /* forward: needed by [dyn_equal] below, defined alongside the view helpers * further down — a length and an element reader that answer correctly @@ -641,6 +668,26 @@ static int64_t view_elem_size(int32_t elem); static int64_t vecish_len(flan_obj *o); static flan_dyn vecish_at(flan_obj *o, int64_t i); +/* The site and operation a walk over a view reports a trap at — a print, an + * equality, a length — set by the entry point that has them and read by the + * element readers the walk calls. NULL when the entry point has no site. */ +static const uint8_t *walk_loc; +static int64_t walk_len; +static const char *walk_op = "print"; + +typedef struct { const uint8_t *loc; int64_t len; const char *op; } walk_site; + +static walk_site walk_enter(const uint8_t *loc, int64_t len, const char *op) { + walk_site was; + was.loc = walk_loc; was.len = walk_len; was.op = walk_op; + walk_loc = loc; walk_len = loc != NULL ? len : 0; walk_op = op; + return was; +} + +static void walk_leave(walk_site was) { + walk_loc = was.loc; walk_len = was.len; walk_op = was.op; +} + static void render(dyn_sink w, flan_dyn v, int depth, int nested) { char buf[64]; int32_t t = flan_dyn_tag(v); @@ -687,6 +734,29 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) { case FLAN_DYN_TAG_MAP: { flan_obj *o = dyn_obj(v); int64_t i; + /* A struct's view prints as the class instance it most resembles: its + * type's name as the shape tag, then its fields in declaration order. */ + if (o->kind == OBJ_VIEW) { + const char *nm; + int64_t nl, n = view_nfields(o); + view_struct_name(o, &nm, &nl); + emit(w, "#"); + emit_n(w, (const uint8_t *)nm, nl); + emit(w, "{"); + for (i = 0; i < n; i++) { + if (i > 0) emit(w, " "); + render(w, view_field_key(o, i), depth + 1, 1); + emit(w, " "); + unsigned long long big; + if (view_big_u64(o, i, 1, &big)) { + snprintf(buf, sizeof buf, "%llu", big); + emit(w, buf); + } else + render(w, view_field_val(o, i), depth + 1, 1); + } + emit(w, "}"); + return; + } /* A class instance prints its shape tag in front, Clojure's own spelling * for a record: #point{:x 1 :y 2}. The tag is not an entry, so it is * written here or it is not written at all. */ @@ -706,17 +776,16 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) { } default: { flan_obj *o = dyn_obj(v); - int64_t i, n = o->kind == OBJ_VIEW ? view_len(NULL, 0, "print", o) : o->len; + int64_t i, n = vecish_len(o); emit(w, "["); for (i = 0; i < n; i++) { if (i > 0) emit(w, " "); - if (o->kind == OBJ_VIEW) - render(w, view_box(o->u.view.elem, - (const uint8_t *)view_base(o) - + i * view_elem_size(o->u.view.elem)), - depth + 1, 1); - else - render(w, o->u.v.items[i], depth + 1, 1); + unsigned long long big; + if (o->kind == OBJ_VIEW && view_big_u64(o, i, 0, &big)) { + snprintf(buf, sizeof buf, "%llu", big); + emit(w, buf); + } else + render(w, vecish_at(o, i), depth + 1, 1); } emit(w, "]"); return; @@ -724,19 +793,31 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) { } } -void flan_dyn_print(flan_dyn v) { render(flan_write_stdout, v, 0, 0); } +static void print_walk(flan_dyn v) { render(flan_write_stdout, v, 0, 0); } /* The same rendering into an evaluated expression's value, and into the watch * slot [flan_dev_watch_begin] opened. lib/render.ml's dyn arm calls these on * the inspecting side and [flan_dyn_print] on [println]'s. A text is quoted * even at the top, because the typed side's renderer quotes a string there: * the value "5" and the value 5 must not read alike. */ -void flan_dyn_emit_dev(flan_dyn v) { render(flan_dev_emit, v, 0, 1); } -void flan_dyn_emit_watch(flan_dyn v) { render(flan_dev_watch_emit, v, 0, 1); } +void flan_dyn_emit_dev(flan_dyn v) { + walk_site was = walk_enter(NULL, 0, "print"); + render(flan_dev_emit, v, 0, 1); + walk_leave(was); +} +void flan_dyn_emit_watch(flan_dyn v) { + walk_site was = walk_enter(NULL, 0, "print"); + render(flan_dev_watch_emit, v, 0, 1); + walk_leave(was); +} /* And into a condition's message, which flan_rt.c's sink bounds. */ void flan_msg_emit(const uint8_t *p, int64_t n); -void flan_dyn_emit_msg(flan_dyn v) { render(flan_msg_emit, v, 0, 1); } +void flan_dyn_emit_msg(flan_dyn v) { + walk_site was = walk_enter(NULL, 0, "print"); + render(flan_msg_emit, v, 0, 1); + walk_leave(was); +} /* The same walk into a buffer, for a trap's sentence. Bounded and truncated * rather than allocating: a trap is the one moment when allocating would be a @@ -802,6 +883,33 @@ static void say_render(sayer *s, flan_dyn v, int depth) { flan_obj *o = dyn_obj(v); int64_t i; if (depth >= 2) { say_puts(s, "{...}"); return; } + if (o->kind == OBJ_VIEW) { + const char *nm; + int64_t nl, n = view_nfields(o), j; + view_struct_name(o, &nm, &nl); + say_puts(s, "#"); + for (j = 0; j < nl && s->n < s->cap - 8; j++) { + char c[2]; + c[0] = nm[j]; + c[1] = '\0'; + say_puts(s, c); + } + say_puts(s, "{"); + for (i = 0; i < n && s->n < s->cap - 8; i++) { + if (i > 0) say_puts(s, " "); + say_render(s, view_field_key(o, i), depth + 1); + say_puts(s, " "); + unsigned long long big; + if (view_big_u64(o, i, 1, &big)) { + char nb[32]; + snprintf(nb, sizeof nb, "%llu", big); + say_puts(s, nb); + } else + say_render(s, view_field_val(o, i), depth + 1); + } + say_puts(s, i == n ? "}" : i > 0 ? " ...}" : "...}"); + return; + } /* The same tag [render] writes, so a trap sentence naming an instance * says which class it was. Truncated with the rest when the buffer is * short: [say] is a 96-byte sentence, not a printer. */ @@ -827,19 +935,18 @@ static void say_render(sayer *s, flan_dyn v, int depth) { } default: { flan_obj *o = dyn_obj(v); - int64_t i, n = o->kind == OBJ_VIEW ? view_len(NULL, 0, "print", o) : o->len; + int64_t i, n = vecish_len(o); if (depth >= 2) { say_puts(s, "[...]"); return; } say_puts(s, "["); for (i = 0; i < n && s->n < s->cap - 8; i++) { if (i > 0) say_puts(s, " "); - if (o->kind == OBJ_VIEW) - say_render(s, - view_box(o->u.view.elem, - (const uint8_t *)view_base(o) - + i * view_elem_size(o->u.view.elem)), - depth + 1); - else - say_render(s, o->u.v.items[i], depth + 1); + unsigned long long big; + if (o->kind == OBJ_VIEW && view_big_u64(o, i, 0, &big)) { + char nb[32]; + snprintf(nb, sizeof nb, "%llu", big); + say_puts(s, nb); + } else + say_render(s, vecish_at(o, i), depth + 1); } say_puts(s, i == n ? "]" : i > 0 ? " ...]" : "...]"); return; @@ -1434,6 +1541,7 @@ static void gc_sweep(void) { } else { int64_t held = (int64_t)sizeof(flan_obj); if (o->kind == OBJ_TEXT || o->kind == OBJ_ENV) held += o->len; + if (o->kind == OBJ_VIEW) held += (int64_t)sizeof(view_guard); if (o->kind == OBJ_ENV) envset_del((uintptr_t)(o + 1)); if (o->kind == OBJ_VEC || o->kind == OBJ_MAP) { int64_t per = o->kind == OBJ_MAP ? 2 : 1; @@ -2809,6 +2917,23 @@ static int dyn_equal(flan_dyn a, flan_dyn b, int depth) { int64_t i, j; if (x == y) return 1; if (depth >= EQ_DEPTH) return 0; + /* A struct's view is equal to another view of the same struct type with + equal fields, and to nothing else — the answer an instance gets beside + a plain map, for the same reason: the type's name is its shape tag. */ + if (x->kind == OBJ_VIEW || y->kind == OBJ_VIEW) { + const char *xn, *yn; + int64_t xl, yl, n; + if (x->kind != OBJ_VIEW || y->kind != OBJ_VIEW) return 0; + view_struct_name(x, &xn, &xl); + view_struct_name(y, &yn, &yl); + if (xl != yl || memcmp(xn, yn, (size_t)xl) != 0) return 0; + n = view_nfields(x); + if (n != view_nfields(y)) return 0; + for (i = 0; i < n; i++) + if (!dyn_equal(view_field_val(x, i), view_field_val(y, i), depth + 1)) + return 0; + return 1; + } /* Two instances of one class built either side of a redefinition hold different key sets, and comparing those key sets would answer "not equal" about a difference the class no longer has. So both are brought @@ -2847,7 +2972,15 @@ static int dyn_equal(flan_dyn a, flan_dyn b, int depth) { return 0; } -flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b) { +static flan_dyn eq_walk(flan_dyn a, flan_dyn b) { + /* A view is checked before the identity shortcut, so a gone one traps + even compared with itself. */ + if (dyn_boxed(a) && dyn_box(a) == BOX_OBJ && dyn_obj(a) != NULL + && dyn_obj(a)->kind == OBJ_VIEW) + view_guard_check(walk_loc, walk_len, walk_op, dyn_obj(a)); + if (dyn_boxed(b) && dyn_box(b) == BOX_OBJ && dyn_obj(b) != NULL + && dyn_obj(b)->kind == OBJ_VIEW) + view_guard_check(walk_loc, walk_len, walk_op, dyn_obj(b)); return flan_dyn_from_bool((uint8_t)dyn_equal(a, b, 0)); } @@ -2859,14 +2992,281 @@ static inline int is_map(flan_dyn v) { /* ── Typed containers as views ───────────────────────────────────────── * - * Every entry point below already dispatches on [flan_dyn_tag], which does - * not distinguish a view from a heap vec — see [flan_dyn_tag]'s switch — so - * [flan_dyn_len], [flan_dyn_at], [flan_dyn_set_at], [flan_dyn_push] and the - * printer each add one branch for [OBJ_VIEW] beside the existing [OBJ_VEC] - * one. What follows is that branch's machinery. */ + * Every entry point below already dispatches on [flan_dyn_tag]. A view over + * a Vec, a slice or a fixed array answers the vec tag and a view over a + * struct answers the map tag, so [flan_dyn_len], [flan_dyn_at], + * [flan_dyn_set_at], [flan_dyn_push], the map operations and the printers + * each add one branch for [OBJ_VIEW]. What follows is that branch's + * machinery. + * + * What one element is comes from a descriptor the compiler writes into + * read-only data (lib/check.ml, [view_desc]), a prefix code: + * + * b B h H i I l L i8 u8 i16 u16 i32 u32 i64 u64 + * f d ? f32 f64 bool + * t str (read as a copy; never written from here) + * a;T a fixed [n T] + * sT a slice [T] + * vT a (Vec T) + * {Name;f1;T1f2;T2} a struct, its fields in declaration order + * + * Offsets are computed here by C's rule, the one Emit.lay spells: every + * scalar aligned to its size, a struct to its strictest field and padded to + * it, an array adding no padding of its own. test/programs/dyn-view-any.flan + * reads back a struct whose fields sit at offsets only that rule gets right, + * on both backends. + * + * A view never stores a collector pointer into typed storage: a read boxes + * (or copies, for a str), and a write unboxes a number or a bool. That is + * why a str element is read-only from here, and why an aggregate element is + * written through its own view rather than replaced whole. */ -static int64_t view_elem_size(int32_t elem) { - return elem == FLAN_VIEW_BOOL ? 1 : 8; +static int64_t desc_int(const uint8_t **p) { + int64_t n = 0; + while (**p >= '0' && **p <= '9') { n = n * 10 + (**p - '0'); (*p)++; } + if (**p == ';') (*p)++; + return n; +} + +/* Past a name and its ';'. */ +static const uint8_t *desc_name_end(const uint8_t *d) { + while (*d != ';') d++; + return d + 1; +} + +static const uint8_t *desc_skip(const uint8_t *d) { + switch (*d) { + case 'a': d++; desc_int(&d); return desc_skip(d); + case 's': case 'v': return desc_skip(d + 1); + case '{': + d = desc_name_end(d + 1); + while (*d != '}') d = desc_skip(desc_name_end(d)); + return d + 1; + default: return d + 1; + } +} + +static int64_t align_to(int64_t n, int64_t a) { return (n + a - 1) / a * a; } + +static void desc_lay(const uint8_t *d, int64_t *size, int64_t *align) { + switch (*d) { + case 'b': case 'B': case '?': *size = 1; *align = 1; return; + case 'h': case 'H': *size = 2; *align = 2; return; + case 'i': case 'I': case 'f': *size = 4; *align = 4; return; + case 't': case 's': *size = 16; *align = 8; return; + case 'v': *size = 40; *align = 8; return; + case 'a': { + int64_t n, s, a; + d++; + n = desc_int(&d); + desc_lay(d, &s, &a); + *size = n * s; + *align = a; + return; + } + case '{': { + int64_t off = 0, al = 1, s, a; + d = desc_name_end(d + 1); + while (*d != '}') { + d = desc_name_end(d); + desc_lay(d, &s, &a); + if (a < 1) a = 1; + off = align_to(off, a) + s; + if (a > al) al = a; + d = desc_skip(d); + } + *size = align_to(off, al); + *align = al; + return; + } + default: *size = 8; *align = 8; return; + } +} + +static int64_t desc_size(const uint8_t *d) { + int64_t s, a; + desc_lay(d, &s, &a); + return s; +} + +/* A struct descriptor's fields, one at a time: [desc_fields] answers where + * the first one starts, and each [desc_next] answers a field's name, offset + * and type and steps past it, 0 at the closing brace. [*off] is the running + * offset. */ +static const uint8_t *desc_fields(const uint8_t *d, int64_t *off) { + *off = 0; + return desc_name_end(d + 1); +} + +static int desc_next(const uint8_t **at, int64_t *off, const uint8_t **name, + int64_t *namelen, int64_t *foff, const uint8_t **fty) { + const uint8_t *d = *at; + int64_t s, a; + if (*d == '}') return 0; + *name = d; + while (*d != ';') d++; + *namelen = (int64_t)(d - *name); + d++; + desc_lay(d, &s, &a); + if (a < 1) a = 1; + *foff = align_to(*off, a); + *off = *foff + s; + *fty = d; + *at = desc_skip(d); + return 1; +} + +/* The field keyword [k] names, or NULL. */ +static const uint8_t *desc_field(const uint8_t *d, flan_dyn k, int64_t *foff) { + const uint8_t *at, *name, *fty; + int64_t off, namelen; + kw_entry *kw; + if (flan_dyn_tag(k) != FLAN_DYN_TAG_KEYWORD) return NULL; + kw = dyn_kw(k); + at = desc_fields(d, &off); + while (desc_next(&at, &off, &name, &namelen, foff, &fty)) + if (namelen == kw->len && memcmp(name, kw_bytes(kw), (size_t)namelen) == 0) + return fty; + return NULL; +} + +static int64_t desc_nfields(const uint8_t *d) { + const uint8_t *at, *name, *fty; + int64_t off, namelen, foff, n = 0; + at = desc_fields(d, &off); + while (desc_next(&at, &off, &name, &namelen, &foff, &fty)) n++; + return n; +} + +/* The Flan spelling of a descriptor's type, for a sentence. */ +static void desc_spell(const uint8_t *d, char *buf, size_t cap) { + static const char scalars[] = "bBhHiIlLfd?t"; + static const char *const words[] = { "i8", "u8", "i16", "u16", "i32", "u32", + "i64", "u64", "f32", "f64", "bool", + "str" }; + const char *w; + char inner[96]; + if (cap == 0) return; + buf[0] = '\0'; + if (*d != '\0' && (w = strchr(scalars, *d)) != NULL) { + snprintf(buf, cap, "%s", words[w - scalars]); + return; + } + switch (*d) { + case 'a': { + int64_t n; + d++; + n = desc_int(&d); + desc_spell(d, inner, sizeof inner); + snprintf(buf, cap, "[%lld %s]", (long long)n, inner); + return; + } + case 's': + desc_spell(d + 1, inner, sizeof inner); + snprintf(buf, cap, "[%s]", inner); + return; + case 'v': + desc_spell(d + 1, inner, sizeof inner); + snprintf(buf, cap, "(Vec %s)", inner); + return; + case '{': { + const uint8_t *e = desc_name_end(d + 1); + snprintf(buf, cap, "%.*s", (int)(e - d - 2), (const char *)d + 1); + return; + } + default: snprintf(buf, cap, "?"); return; + } +} + +/* What a dev build remembers of a view's storage at the crossing, and checks + * before every read or write through it (runtime/flan_dev.c keeps both + * tables): + * + * a frame the shadow frame the storage belongs to and the serial that + * activation was given. Live while that frame is still on the + * chain with the same serial: a later call landing at the same + * address gets a different one. + * a block the registry entry of the heap or arena block holding the + * storage, by base and note sequence. Live while the entry is, + * which a free, a free-all, an arena's destroy and a Vec's + * growth (for the block it left) all end. + * + * A frame is found by the compiler's word ([here]) or, for a stack address + * it could not tie to the calling frame, by address (flan_dev.c, + * [flan_dev_frame_owner]). A release build keeps neither table, so a view + * there records nothing and checks nothing. Storage neither table knows — a + * global, rodata, C memory — is not checked. */ +/* [view_guard] is defined beside [flan_obj], since the sweep charges it. */ + +uint64_t flan_dev_frame_claim(void *frame, const char **name, int64_t *namelen); +int32_t flan_dev_frame_alive(const void *frame, uint64_t serial); +int32_t flan_dev_reg_claim(const void *p, uintptr_t *base, int64_t *seq, + const char **type, int64_t *typelen); +int32_t flan_dev_reg_alive(uintptr_t base, int64_t seq); +struct flan_frame; +extern struct flan_frame *flan_frame_head; /* runtime/flan_dev.c */ + +#define VIEW_FLAT 0 /* [base] is the first element, [o->len] the count */ +#define VIEW_VEC 1 /* [base] is a Vec's header, read live */ +#define VIEW_STRUCT 2 /* [base] is the struct, [desc] the struct's own */ + +static inline view_guard *view_g(flan_obj *o) { return (view_guard *)(o + 1); } +static inline int view_shape(flan_obj *o) { return (int)o->gen; } + +void *flan_dev_frame_owner(const void *p); + +/* What a dev build records of storage the compiler could not tie to the + * calling frame: the frame that owns it when it is on the stack (a slice of + * a local, a slice parameter over a caller's), else the registry block that + * holds it. Neither, and nothing is checked. */ +static void guard_storage(view_guard *g, const void *p) { + void *f; + g->frame = NULL; + g->rbase = 0; + if (p == NULL) return; + if ((f = flan_dev_frame_owner(p)) != NULL) { + g->frame = f; + g->serial = flan_dev_frame_claim(f, &g->fname, &g->fnamelen); + return; + } + flan_dev_reg_claim(p, &g->rbase, &g->rseq, &g->rtype, &g->rtypelen); +} + + +/* A new view record, its guard empty. */ +static flan_obj *view_new(void *base, int64_t len, const uint8_t *desc, + int shape) { + flan_obj *o = gc_alloc(OBJ_VIEW, (int64_t)sizeof(view_guard)); + o->u.view.base = base; + o->u.view.desc = desc; + o->u.view.nul = NULL; + o->gen = (uint32_t)shape; + o->len = len; + memset(view_g(o), 0, sizeof(view_guard)); + return o; +} + +/* The stale-storage check. The sentence never renders the view: it has just + * been found to point at storage that is gone, and rendering reads it. */ +static void view_guard_check(const uint8_t *loc, int64_t loclen, + const char *op, flan_obj *o) { + view_guard *g = view_g(o); + if (g->frame != NULL && !flan_dev_frame_alive(g->frame, g->serial)) { + flan_say(loc, loclen, + "dyn %s: this view points into a local of %.*s, and that call " + "has returned. A view of a local lasts as long as the call that " + "made it", + op, (int)g->fnamelen, g->fname); + flan_trap((const uint8_t *)"DynStale", 8); + } + if (g->rbase != 0 && !flan_dev_reg_alive(g->rbase, g->rseq)) { + flan_say(loc, loclen, + "dyn %s: this view's storage, a block of %.*s, has been " + "released — freed, cleared by free-all, or left behind when a " + "Vec grew. Take the view again after the change", + op, (int)g->rtypelen, g->rtype); + flan_trap((const uint8_t *)"DynStale", 8); + } } /* The stale-container check flan_rt.c's [flan_vec_check] runs for a typed @@ -2874,17 +3274,8 @@ static int64_t view_elem_size(int32_t elem) { * doctrine's dyn side gets its own spelling (docs/SPIKE-DUPLICITY.md), and a * dyn program that hits this wants the same park-and-inspect [flan_trap] * gives every other dyn mistake, not the typed side's [rt_die]. A Vec with - * no allocator yet — one nobody has pushed to — has nothing to check. - * - * The message never renders the view it just declared unsafe to read — - * review's second finding, and it was not a decoration this dropped for - * safety's sake, it was a real infinite recursion: [say] on a view calls - * [say_render]'s view branch, which calls [view_len], which calls back in - * here, unconditionally, because the epoch is still stale. Every render of - * this same view would hit the same check and take the same branch, so - * nothing about depth or a visited set closes it — the fix is that a - * stale-container check must never read the container it has just refused - * to trust, not even to describe it in the sentence explaining why. */ + * no allocator yet — one nobody has pushed to — has nothing to check. Like + * the guard's, the sentence never renders the view. */ static void view_vec_check(const uint8_t *loc, int64_t loclen, const char *op, flan_dyn_vec_hdr *h) { if (h->alloc) { @@ -2901,119 +3292,501 @@ static void view_vec_check(const uint8_t *loc, int64_t loclen, const char *op, /* [len] and [base], read live for a Vec view (so a push that grows and * moves the underlying Vec is seen the very next operation) and read from - * the snapshot for a flat one. */ + * the snapshot for a flat one. [view_len] checks the guard first. */ static int64_t view_len(const uint8_t *loc, int64_t loclen, const char *op, flan_obj *o) { - if (o->u.view.is_vec) { + view_guard_check(loc, loclen, op, o); + if (view_shape(o) == VIEW_VEC) { flan_dyn_vec_hdr *h = (flan_dyn_vec_hdr *)o->u.view.base; view_vec_check(loc, loclen, op, h); return h->len; } - return o->u.view.len; + return o->len; } static void *view_base(flan_obj *o) { - if (o->u.view.is_vec) return ((flan_dyn_vec_hdr *)o->u.view.base)->ptr; + if (view_shape(o) == VIEW_VEC) return ((flan_dyn_vec_hdr *)o->u.view.base)->ptr; return o->u.view.base; } -/* Reads box the element on the way out — the runtime already knows how to - * box an i64, an f64 or a bool, so this is that, from raw bytes rather than - * from a C value already in hand. */ -static flan_dyn view_box(int32_t elem, const uint8_t *p) { - switch (elem) { - case FLAN_VIEW_I64: { int64_t x; memcpy(&x, p, 8); return flan_dyn_from_i64(x); } - case FLAN_VIEW_F64: { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); } - default: { uint8_t b = *p; return flan_dyn_from_bool(b); } +/* A view of the aggregate element at [p], inside [parent]'s storage. An + * element of a Vec is checked against the Vec's block, since the Vec's + * growth is what would leave it behind; any other inline element shares its + * parent's guard. A slice element's data is somewhere else, so it is looked + * up afresh. */ +static flan_dyn view_child(flan_obj *parent, const uint8_t *d, uint8_t *p) { + flan_obj *c; + switch (*d) { + case 's': { + void *data; + int64_t n; + memcpy(&data, p, 8); + memcpy(&n, p + 8, 8); + c = view_new(data, n, d + 1, VIEW_FLAT); + guard_storage(view_g(c), data); + return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)c); } + case 'a': { + const uint8_t *e = d + 1; + int64_t n = desc_int(&e); + c = view_new(p, n, e, VIEW_FLAT); + break; + } + case 'v': c = view_new(p, 0, d + 1, VIEW_VEC); break; + default: c = view_new(p, 0, d, VIEW_STRUCT); break; + } + if (view_shape(parent) == VIEW_VEC) guard_storage(view_g(c), p); + else *view_g(c) = *view_g(parent); + return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)c); +} + +/* One element, boxed on the way out. A number widens to a dyn int or float, + * except a u64 above the largest i64, which has no dyn int to become. */ +static flan_dyn view_read(const uint8_t *loc, int64_t loclen, const char *op, + flan_obj *parent, const uint8_t *d, uint8_t *p) { + switch (*d) { + case 'b': { int8_t x; memcpy(&x, p, 1); return flan_dyn_from_i64(x); } + case 'B': { uint8_t x; memcpy(&x, p, 1); return flan_dyn_from_i64(x); } + case 'h': { int16_t x; memcpy(&x, p, 2); return flan_dyn_from_i64(x); } + case 'H': { uint16_t x; memcpy(&x, p, 2); return flan_dyn_from_i64(x); } + case 'i': { int32_t x; memcpy(&x, p, 4); return flan_dyn_from_i64(x); } + case 'I': { uint32_t x; memcpy(&x, p, 4); return flan_dyn_from_i64(x); } + case 'l': { int64_t x; memcpy(&x, p, 8); return flan_dyn_from_i64(x); } + case 'L': { + uint64_t x; + memcpy(&x, p, 8); + if (x > (uint64_t)INT64_MAX) { + flan_say(loc, loclen, + "dyn %s: this u64 element is %llu, above the largest dyn int " + "(9223372036854775807), so it has no dyn value", + op, (unsigned long long)x); + flan_trap((const uint8_t *)"DynRange", 8); + } + return flan_dyn_from_i64((int64_t)x); + } + case 'f': { float x; memcpy(&x, p, 4); return flan_dyn_from_f64((double)x); } + case 'd': { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); } + case '?': return flan_dyn_from_bool(*p ? 1 : 0); + case 't': { + const uint8_t *s; + int64_t n; + memcpy(&s, p, 8); + memcpy(&n, p + 8, 8); + return flan_dyn_from_bytes(s, n); + } + default: return view_child(parent, d, p); + } +} + +/* The range each integer element holds. */ +static int int_range(uint8_t c, int64_t *lo, int64_t *hi) { + switch (c) { + case 'b': *lo = INT8_MIN; *hi = INT8_MAX; return 1; + case 'B': *lo = 0; *hi = UINT8_MAX; return 1; + case 'h': *lo = INT16_MIN; *hi = INT16_MAX; return 1; + case 'H': *lo = 0; *hi = UINT16_MAX; return 1; + case 'i': *lo = INT32_MIN; *hi = INT32_MAX; return 1; + case 'I': *lo = 0; *hi = UINT32_MAX; return 1; + case 'l': *lo = INT64_MIN; *hi = INT64_MAX; return 1; + case 'L': *lo = 0; *hi = INT64_MAX; return 1; + default: return 0; + } +} + +/* One element, unboxed on the way in. The dyn value's tag must be the one + * the element's type wants, or this traps by name and never coerces a + * mismatched value into the slot; an int the element's width cannot hold + * traps too, naming both. An int goes into a float element when the float + * holds it exactly, the rule a class's typed float slot follows, and traps + * when it does not. A float into an f32 narrows, as (f32 x) does. [v] is the + * view and [x] the value, for the sentence. */ +/* "an" before a word said with a vowel sound: an i8, an f32, an Item; a + * u8, a bool, a [3 i32]. */ +static const char *an(const char *w) { + if (w[0] == 'u' && w[1] >= '0' && w[1] <= '9') return "a"; + if (w[0] != '\0' && strchr("aeiouAEIOU", w[0]) != NULL) return "an"; + if (w[0] == 'f' && w[1] >= '0' && w[1] <= '9') return "an"; + return "a"; +} + +/* A write into a struct field that the field refuses: the field by name, its + * type, what was wrong, and the call with the key in it. [why] finishes the + * sentence after the field's type. */ +static _Noreturn void field_refuse(const uint8_t *loc, int64_t loclen, + const char *op, flan_dyn v, flan_dyn key, + const uint8_t *d, flan_dyn x, + const char *trap, const char *why) { + char ty[128], sn[96], sv[SAY_MAX], sx[SAY_MAX]; + const char *nm; + int64_t nl; + kw_entry *k = dyn_kw(key); + desc_spell(d, ty, sizeof ty); + view_struct_name(dyn_obj(v), &nm, &nl); + snprintf(sn, sizeof sn, "%.*s", (int)nl, nm); + say(sv, SAY_MAX, v); + say(sx, SAY_MAX, x); + said_len = 0; + said_add("dyn %s: field :%.*s of %s %s is %s %s%s — ", op, (int)k->len, + (const char *)kw_bytes(k), an(sn), sn, an(ty), ty, why); + if (strcmp(op, "set") == 0) + said_add("(set (get %s :%.*s) %s)", sv, (int)k->len, + (const char *)kw_bytes(k), sx); + else + said_add("(put %s :%.*s %s)", sv, (int)k->len, (const char *)kw_bytes(k), + sx); + flan_say(loc, loclen, "%s", said_buf); + flan_trap((const uint8_t *)trap, (int64_t)strlen(trap)); +} + +/* ", and 1.5 is a float": what the refused value is, for a field's sentence. */ +static void value_is(char *buf, size_t cap, flan_dyn x) { + char sx[SAY_MAX]; + const char *t = tag_of(x); + if (flan_dyn_tag(x) == FLAN_DYN_TAG_NIL) { + snprintf(buf, cap, ", and the value is nil"); + return; + } + say(sx, SAY_MAX, x); + snprintf(buf, cap, ", and %s is %s %s", sx, an(t), t); +} + +/* One element or field, unboxed on the way in. The dyn value's tag must be + * the one the element's type wants, or this traps by name and never coerces a + * mismatched value into the slot; an int the element's width cannot hold + * traps too, naming both. An int goes into a float element when the float + * holds it exactly, the rule a class's typed float slot follows, and traps + * when it does not. A float into an f32 narrows, as (f32 x) does. [v] is the + * view and [x] the value, for the sentence; [key] is the field's keyword + * when [v] is a struct's view and nil for an element, and a field's refusal + * names the field. */ +static void view_write(const uint8_t *loc, int64_t loclen, const char *op, + flan_dyn v, flan_dyn key, const uint8_t *d, flan_dyn x, + uint8_t *p) { + char ty[128], why[160]; + int64_t lo, hi; + int field = flan_dyn_tag(key) == FLAN_DYN_TAG_KEYWORD; + desc_spell(d, ty, sizeof ty); + if (int_range(*d, &lo, &hi)) { + int64_t n; + if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) { + if (field) { + value_is(why, sizeof why, x); + field_refuse(loc, loclen, op, v, key, d, x, "DynType", why); + } + trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are int", v, x); + } + n = dyn_int_value(x); + if (n < lo || n > hi) { + if (field) { + if (*d == 'L') + snprintf(why, sizeof why, + ", which holds no negative number, and %lld does not fit", + (long long)n); + else + snprintf(why, sizeof why, + ", which holds %lld to %lld, and %lld does not fit", + (long long)lo, (long long)hi, (long long)n); + field_refuse(loc, loclen, op, v, key, d, x, "DynRange", why); + } + if (*d == 'L') + flan_say(loc, loclen, + "dyn %s: %lld does not fit a u64 element, which holds no " + "negative number", op, (long long)n); + else + flan_say(loc, loclen, + "dyn %s: %lld does not fit %s %s element, which holds %lld " + "to %lld", op, (long long)n, an(ty), ty, (long long)lo, + (long long)hi); + flan_trap((const uint8_t *)"DynRange", 8); + } + switch (*d) { + case 'b': case 'B': { uint8_t b = (uint8_t)n; memcpy(p, &b, 1); return; } + case 'h': case 'H': { uint16_t h = (uint16_t)n; memcpy(p, &h, 2); return; } + case 'i': case 'I': { uint32_t w = (uint32_t)n; memcpy(p, &w, 4); return; } + default: memcpy(p, &n, 8); return; + } + } + switch (*d) { + case 'f': case 'd': { + double f; + if (flan_dyn_tag(x) == FLAN_DYN_TAG_INT) { + /* [slot_admit]'s rule for a class's float slot: exact is a round + trip, and the range test keeps the cast back defined. */ + int64_t n = dyn_int_value(x); + f = *d == 'f' ? (double)(float)n : (double)n; + if (!(f >= -9223372036854775808.0 && f < 9223372036854775808.0) + || (int64_t)f != n) { + if (field) { + snprintf(why, sizeof why, + ", and %lld has no exact %s. Write it as a float, as in " + "%lld.0", (long long)n, ty, (long long)n); + field_refuse(loc, loclen, op, v, key, d, x, "DynRange", why); + } + flan_say(loc, loclen, + "dyn %s: %lld has no exact %s, so it does not go into this " + "element. Write it as a float, as in %lld.0", + op, (long long)n, ty, (long long)n); + flan_trap((const uint8_t *)"DynRange", 8); + } + } else if (flan_dyn_tag(x) == FLAN_DYN_TAG_FLOAT) + f = dyn_num_value(x); + else { + if (field) { + value_is(why, sizeof why, x); + field_refuse(loc, loclen, op, v, key, d, x, "DynType", why); + } + trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are float", v, x); + } + if (*d == 'f') { float g = (float)f; memcpy(p, &g, 4); } + else memcpy(p, &f, 8); + return; + } + case '?': + if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL) { + if (field) { + value_is(why, sizeof why, x); + field_refuse(loc, loclen, op, v, key, d, x, "DynType", why); + } + trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are bool", v, x); + } + *p = dyn_payload(x) ? 1 : 0; + return; + case 't': + if (field) + field_refuse(loc, loclen, op, v, key, d, x, "DynType", + ", which is read-only through a dyn view"); + trap2(loc, loclen, TYPE_TRAP, op, + "a str element is read-only through a dyn view", v, x); + default: { + char sx[SAY_MAX]; + if (field) + field_refuse(loc, loclen, op, v, key, d, x, "DynType", + ", which a dyn view does not replace whole. Write into " + "its own elements or fields instead"); + say(sx, SAY_MAX, x); + flan_say(loc, loclen, + "dyn %s: this element is %s %s, and a dyn view does not replace " + "it whole — write into its own elements or fields instead of " + "storing %s", + op, an(ty), ty, sx); + flan_trap((const uint8_t *)"DynType", 7); + } + } +} + +/* Element [i] of a vec-shaped view. The caller has checked the bounds. */ +static uint8_t *view_elem_at(flan_obj *o, int64_t i) { + return (uint8_t *)view_base(o) + i * desc_size(o->u.view.desc); } /* A length and an element reader that answer correctly whether [o] is an * ordinary heap vec (OBJ_VEC, elements are dyn words) or a view over a - * typed container (OBJ_VIEW, elements are native bytes boxed on the way - * out) — the pair [dyn_equal]'s VEC arm needs so that a view compares - * correctly against another view and against an ordinary vec alike. Reading - * [o->len]/[o->u.v.items] directly, the way that arm used to, answers 0 and - * garbage for a view: nothing sets [len] for OBJ_VIEW, and its elements - * alias [u.view.base] reinterpreted as dyn words rather than the native - * bytes they are. */ + * typed container (OBJ_VIEW, native bytes boxed on the way out) — the pair + * [dyn_equal]'s VEC arm and the printers need. */ static int64_t vecish_len(flan_obj *o) { - return o->kind == OBJ_VIEW ? view_len(NULL, 0, "=", o) : o->len; + return o->kind == OBJ_VIEW ? view_len(walk_loc, walk_len, walk_op, o) : o->len; } static flan_dyn vecish_at(flan_obj *o, int64_t i) { if (o->kind == OBJ_VIEW) - return view_box(o->u.view.elem, - (const uint8_t *)view_base(o) - + i * view_elem_size(o->u.view.elem)); + return view_read(walk_loc, walk_len, walk_op, o, o->u.view.desc, + view_elem_at(o, i)); return o->u.v.items[i]; } -/* Writes tag-check on the way in: the dyn value's tag must be the one this - * view's element type wants, or this traps by name and never coerces or - * truncates a mismatched value into the slot. [v] is the view, for the - * sentence's container half; [x] is the value that was refused. */ -static void view_unbox(const uint8_t *loc, int64_t loclen, const char *op, - flan_dyn v, int32_t elem, flan_dyn x, uint8_t *p) { - switch (elem) { - case FLAN_VIEW_I64: { - int64_t n; - if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) - trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are int", v, x); - n = dyn_int_value(x); - memcpy(p, &n, 8); - return; - } - case FLAN_VIEW_F64: { - double d; - if (flan_dyn_tag(x) != FLAN_DYN_TAG_FLOAT) - trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are float", v, x); - d = dyn_num_value(x); - memcpy(p, &d, 8); - return; - } - default: { - uint8_t b; - if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL) - trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are bool", v, x); - b = dyn_payload(x) ? 1 : 0; - *p = b; - return; +/* A struct view's field [k], or a trap naming the fields there are: a + * struct's shape is fixed, so a key it does not have is a mistake rather + * than an absence. */ +static uint8_t *view_field(const uint8_t *loc, int64_t loclen, const char *op, + flan_obj *o, flan_dyn k, const uint8_t **fty) { + int64_t off; + const uint8_t *d = o->u.view.desc; + view_guard_check(loc, loclen, op, o); + *fty = desc_field(d, k, &off); + if (*fty == NULL) { + char sk[SAY_MAX], nm[96]; + const uint8_t *at, *name, *t; + int64_t o2, namelen, foff; + say(sk, SAY_MAX, k); + desc_spell(d, nm, sizeof nm); + said_len = 0; + said_add("dyn %s: a %s has no field %s. Its fields are", op, nm, sk); + at = desc_fields(d, &o2); + while (desc_next(&at, &o2, &name, &namelen, &foff, &t)) + said_add(" :%.*s", (int)namelen, (const char *)name); + flan_say(loc, loclen, "%s", said_buf); + flan_trap((const uint8_t *)"DynType", 7); } + return (uint8_t *)o->u.view.base + off; +} + +/* The crossing. [base] is the container's address (a Vec's header, the + * array's or the struct's first byte) or a slice's data, [len] a flat + * view's element count, [desc] the element's descriptor (the struct's own, + * for a struct view). [here] is the checker's word that the storage is the + * calling function's own frame; otherwise a dev build finds the frame that + * owns a stack address, or the registry block that holds a heap one. */ +static flan_dyn view_make(void *base, int64_t len, const uint8_t *desc, + int shape, int32_t here) { + flan_obj *o = view_new(base, len, desc, shape); + view_guard *g = view_g(o); + if (here) { + if (flan_frame_head != NULL) { + g->frame = flan_frame_head; + g->serial = + flan_dev_frame_claim(flan_frame_head, &g->fname, &g->fnamelen); + } + } else + guard_storage(g, base); + return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); +} + +flan_dyn flan_dyn_view_slice(void *data, int64_t len, const uint8_t *desc, + int64_t desclen, int32_t here) { + (void)desclen; + return view_make(data, len, desc, VIEW_FLAT, 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) { + (void)desclen; + return view_make(addr, len, desc, shape, here); +} + +/* A struct view's fields by position, for the printers and equality. */ +static int64_t view_nfields(flan_obj *o) { + view_guard_check(walk_loc, walk_len, walk_op, o); + return desc_nfields(o->u.view.desc); +} + +static int view_nth(flan_obj *o, int64_t i, const uint8_t **name, + int64_t *namelen, int64_t *foff, const uint8_t **fty) { + int64_t off; + const uint8_t *at = desc_fields(o->u.view.desc, &off); + while (desc_next(&at, &off, name, namelen, foff, fty)) + if (i-- == 0) return 1; + return 0; +} + +static flan_dyn view_field_key(flan_obj *o, int64_t i) { + const uint8_t *name, *fty; + int64_t namelen, foff; + if (!view_nth(o, i, &name, &namelen, &foff, &fty)) return flan_dyn_nil(); + return flan_dyn_kw(name, namelen); +} + +static flan_dyn view_field_val(flan_obj *o, int64_t i) { + const uint8_t *name, *fty; + int64_t namelen, foff; + if (!view_nth(o, i, &name, &namelen, &foff, &fty)) return flan_dyn_nil(); + return view_read(walk_loc, walk_len, walk_op, o, fty, + (uint8_t *)o->u.view.base + foff); +} + +static int view_big_u64(flan_obj *o, int64_t i, int field, + unsigned long long *out) { + const uint8_t *d, *p; + uint64_t x; + if (field) { + const uint8_t *name; + int64_t namelen, foff; + if (!view_nth(o, i, &name, &namelen, &foff, &d)) return 0; + p = (const uint8_t *)o->u.view.base + foff; + } else { + d = o->u.view.desc; + p = view_elem_at(o, i); } + if (*d != 'L') return 0; + memcpy(&x, p, 8); + if (x <= (uint64_t)INT64_MAX) return 0; + *out = (unsigned long long)x; + return 1; +} + +static void view_struct_name(flan_obj *o, const char **name, int64_t *len) { + const uint8_t *d = o->u.view.desc; + const uint8_t *e = desc_name_end(d + 1); + *name = (const char *)d + 1; + *len = (int64_t)(e - d - 2); +} + +/* print, =, length and has-key? with the site they were written at, so a + * view that traps inside one — gone, or a u64 too wide to compare — says + * where, and names the operation. The compiler calls these; the site-less + * ones stay for test/dyn_ops.c and the runtime's own callers. */ +static flan_dyn len_walk(flan_dyn v); +static flan_dyn contains_walk(flan_dyn m, flan_dyn k); + +void flan_dyn_print_at(flan_dyn v, const uint8_t *loc, int64_t loclen) { + walk_site was = walk_enter(loc, loclen, "print"); + print_walk(v); + walk_leave(was); +} + +void flan_dyn_print(flan_dyn v) { flan_dyn_print_at(v, NULL, 0); } + +flan_dyn flan_dyn_eq_at(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + walk_site was = walk_enter(loc, loclen, "="); + flan_dyn r = eq_walk(a, b); + walk_leave(was); + return r; +} + +flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b) { + return flan_dyn_eq_at(a, b, NULL, 0); +} + +flan_dyn flan_dyn_len_at(flan_dyn v, const uint8_t *loc, int64_t loclen) { + walk_site was = walk_enter(loc, loclen, "length"); + flan_dyn r = len_walk(v); + walk_leave(was); + return r; +} + +flan_dyn flan_dyn_len(flan_dyn v) { return flan_dyn_len_at(v, NULL, 0); } + +flan_dyn flan_dyn_map_contains_at(flan_dyn m, flan_dyn k, const uint8_t *loc, + int64_t loclen) { + walk_site was = walk_enter(loc, loclen, "has-key?"); + flan_dyn r = contains_walk(m, k); + walk_leave(was); + return r; +} + +flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k) { + return flan_dyn_map_contains_at(m, k, NULL, 0); +} + +/* The first ABI, kept for test/dyn_ops.c: FLAN_VIEW_I64/F64/BOOL. */ +static const uint8_t *old_elem_desc(int32_t elem) { + return (const uint8_t *)(elem == FLAN_VIEW_I64 ? "l" + : elem == FLAN_VIEW_F64 ? "d" : "?"); } flan_dyn flan_dyn_view_vec(void *hdr, int32_t elem) { - flan_obj *o = gc_alloc(OBJ_VIEW, 0); - o->u.view.base = hdr; - o->u.view.len = 0; - o->u.view.elem = elem; - o->u.view.is_vec = 1; - return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); + return view_make(hdr, 0, old_elem_desc(elem), VIEW_VEC, 0); } flan_dyn flan_dyn_view_flat(void *data, int64_t len, int32_t elem) { - flan_obj *o = gc_alloc(OBJ_VIEW, 0); - o->u.view.base = data; - o->u.view.len = len; - o->u.view.elem = elem; - o->u.view.is_vec = 0; - return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); + return view_make(data, len, old_elem_desc(elem), VIEW_FLAT, 0); } -flan_dyn flan_dyn_len(flan_dyn v) { +static flan_dyn len_walk(flan_dyn v) { if (is_text(v)) return flan_dyn_from_i64(dyn_obj(v)->len); /* A map's length is its slot count, so a stale instance would answer the count of a definition that no longer exists. Migrated first for the same reason [get] is. */ if (is_map(v)) { flan_obj *o = dyn_obj(v); + if (o->kind == OBJ_VIEW) return flan_dyn_from_i64(view_nfields(o)); class_sync(o); return flan_dyn_from_i64(o->len); } if (is_vec(v)) { flan_obj *o = dyn_obj(v); - if (o->kind == OBJ_VIEW) return flan_dyn_from_i64(view_len(NULL, 0, "length", o)); + if (o->kind == OBJ_VIEW) + return flan_dyn_from_i64(view_len(walk_loc, walk_len, walk_op, o)); return flan_dyn_from_i64(o->len); } trap1(NULL, 0, TYPE_TRAP, "length", "only a text, a vec or a map has one", v); @@ -3047,8 +3820,7 @@ flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc, if (o->kind == OBJ_VIEW) { int64_t len = view_len(loc, loclen, "at", o); if (k < 0 || k >= len) trap_range(loc, loclen, "at", v, k, len); - return view_box(o->u.view.elem, - (const uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem)); + return view_read(loc, loclen, "at", o, o->u.view.desc, view_elem_at(o, k)); } if (k < 0 || k >= o->len) trap_range(loc, loclen, "at", v, k, o->len); if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]); @@ -3101,10 +3873,9 @@ void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc, o = dyn_obj(v); if (o->kind == OBJ_VIEW) { int64_t len = view_len(loc, loclen, "set-at", o); - uint8_t *p; if (k < 0 || k >= len) trap_range(loc, loclen, "set-at", v, k, len); - p = (uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem); - view_unbox(loc, loclen, "set-at", v, o->u.view.elem, x, p); + view_write(loc, loclen, "set-at", v, flan_dyn_nil(), o->u.view.desc, x, + view_elem_at(o, k)); return; } if (k < 0 || k >= o->len) trap_range(loc, loclen, "set-at", v, k, o->len); @@ -3120,20 +3891,24 @@ void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen) { } o = dyn_obj(v); if (o->kind == OBJ_VIEW) { - uint8_t buf[8]; + uint8_t buf[16]; /* The typed Vec's own traps print a site too, and without one from the * caller the best this can name is the operation. */ static const uint8_t push_loc[] = "(dyn push)"; const uint8_t *site = loc != NULL && loclen > 0 ? loc : push_loc; int64_t sitelen = loc != NULL && loclen > 0 ? loclen : (int64_t)sizeof(push_loc) - 1; - int64_t size; - if (!o->u.view.is_vec) + int64_t size, align; + if (view_shape(o) != VIEW_VEC) trap2(loc, loclen, TYPE_TRAP, "push", "this view is a slice or an array and cannot grow", v, x); - size = view_elem_size(o->u.view.elem); - view_unbox(loc, loclen, "push", v, o->u.view.elem, x, buf); - if (!flan_vec_push(o->u.view.base, buf, size, size, site, sitelen)) + view_len(loc, loclen, "push", o); + desc_lay(o->u.view.desc, &size, &align); + /* Only a number or a bool is ever written, and [view_write] refuses the + rest before a byte of [buf] is used. */ + memset(buf, 0, sizeof buf); + view_write(loc, loclen, "push", v, flan_dyn_nil(), o->u.view.desc, x, buf); + if (!flan_vec_push(o->u.view.base, buf, size, align, site, sitelen)) trap_oom(loc, loclen, size); return; } @@ -3196,6 +3971,11 @@ static flan_obj *want_map(const char *op, flan_dyn m, flan_dyn k) { flan_dyn flan_dyn_map_get(flan_dyn m, flan_dyn k) { flan_obj *o = want_map("get", m, k); + if (o->kind == OBJ_VIEW) { + const uint8_t *fty; + uint8_t *p = view_field(NULL, 0, "get", o, k, &fty); + return view_read(NULL, 0, "get", o, fty, p); + } int64_t i = map_find(o, k); return i < 0 ? flan_dyn_nil() : o->u.v.items[i * 2 + 1]; } @@ -3212,14 +3992,25 @@ flan_dyn flan_dyn_get(flan_dyn m, flan_dyn k, const uint8_t *loc, int64_t loclen) { class_entry *e; if (!is_map(m)) trap2(loc, loclen, TYPE_TRAP, "get", "only a map answers it", m, k); + /* A struct's view: its field, or a trap at this site naming the fields. */ + if (dyn_obj(m)->kind == OBJ_VIEW) { + const uint8_t *fty; + uint8_t *p = view_field(loc, loclen, "get", dyn_obj(m), k, &fty); + return view_read(loc, loclen, "get", dyn_obj(m), fty, p); + } e = class_sync(dyn_obj(m)); if (e != NULL && class_slot(e, k) < 0) trap_no_slot(loc, loclen, "get", dyn_obj(m), e, k); return flan_dyn_map_get(m, k); } -flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k) { +static flan_dyn contains_walk(flan_dyn m, flan_dyn k) { flan_obj *o = want_map("has-key?", m, k); + if (o->kind == OBJ_VIEW) { + int64_t off; + view_guard_check(walk_loc, walk_len, walk_op, o); + return flan_dyn_from_bool(desc_field(o->u.view.desc, k, &off) != NULL); + } return flan_dyn_from_bool(map_find(o, k) >= 0); } @@ -3343,6 +4134,12 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v, class_entry *e; int64_t j; flan_dyn out; + if (is_map(m) && dyn_obj(m)->kind == OBJ_VIEW) { + const uint8_t *fty; + uint8_t *p = view_field(loc, loclen, "set", dyn_obj(m), k, &fty); + view_write(loc, loclen, "set", m, k, fty, v, p); + return; + } if (!is_map(m) || dyn_obj(m)->u.v.klass == NULL) { char sm[SAY_MAX]; say(sm, SAY_MAX, m); @@ -3368,6 +4165,12 @@ static void map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc, class_entry *e; if (!is_map(m)) trap2(loc, loclen, TYPE_TRAP, "put", "only a map answers it", m, k); o = dyn_obj(m); + if (o->kind == OBJ_VIEW) { + const uint8_t *fty; + uint8_t *p = view_field(loc, loclen, "put", o, k, &fty); + view_write(loc, loclen, "put", m, k, fty, v, p); + return; + } e = class_sync(o); if (!any_key && e != NULL && class_slot(e, k) < 0) trap_no_slot(loc, loclen, "put", o, e, k); diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 2a5b1bd5..5e6a118b 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -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 ───────────────────────────────────────────────────── * diff --git a/test/dyn_ops.c b/test/dyn_ops.c index efea69bf..692725cf 100644 --- a/test/dyn_ops.c +++ b/test/dyn_ops.c @@ -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)); diff --git a/test/programs/dyn-view-any.flan b/test/programs/dyn-view-any.flan new file mode 100644 index 00000000..8525c420 --- /dev/null +++ b/test/programs/dyn-view-any.flan @@ -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)))) diff --git a/test/programs/dyn-view.flan b/test/programs/dyn-view.flan index f3b57cbf..195d3b13 100644 --- a/test/programs/dyn-view.flan +++ b/test/programs/dyn-view.flan @@ -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 diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 84df81db..ff0185a4 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -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 diff --git a/test/test_dyn.ml b/test/test_dyn.ml index 7ab4675d..263bdc94 100644 --- a/test/test_dyn.ml +++ b/test/test_dyn.ml @@ -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 diff --git a/test/test_flan.ml b/test/test_flan.ml index 7bd14bb5..6b853e5f 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -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 diff --git a/test/test_sanitize.ml b/test/test_sanitize.ml index 8f32618c..5f9bb778 100644 --- a/test/test_sanitize.ml +++ b/test/test_sanitize.ml @@ -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", []; diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 801a7940..aaa4be35 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -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");