From 7953376e4e9167e59c5870948cc89813cc50d6fe Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 06:10:11 +0700 Subject: [PATCH 1/7] Any typed container of numbers, bools, str, structs, arrays, slices or Vecs crosses into dyn as a view from any storage, and a dev build traps on a view whose frame returned or whose block was released. --- lib/check.ml | 315 +++++++------ lib/emit.ml | 25 +- lib/x86.ml | 15 +- runtime/flan_dev.c | 78 ++++ runtime/flan_dyn.c | 770 +++++++++++++++++++++++++++----- runtime/flan_dyn.h | 78 ++-- test/programs/dyn-view-any.flan | 211 +++++++++ test/programs/dyn-view.flan | 20 +- test/test_acceptance.ml | 68 +++ test/test_flan.ml | 138 +++--- test/test_sanitize.ml | 4 + test/test_syntax.ml | 52 ++- 12 files changed, 1319 insertions(+), 455 deletions(-) create mode 100644 test/programs/dyn-view-any.flan diff --git a/lib/check.ml b/lib/check.ml index db1fd732..6ca2fdd4 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] reads a struct's fields from when it describes one + for a view: [box] is called from places that hold no [ctx], and there is + one table per program. Set by [new_env]. *) +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 (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 e in + Ok (Printf.sprintf "a%Ld;%s" n d) + | Types.Slice (Types.Mut, e) -> let* d = view_desc e in Ok ("s" ^ d) + | Types.Vec e -> let* d = view_desc e in Ok ("v" ^ d) + | Types.Named n -> + (match Hashtbl.find_opt !view_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 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,48 @@ 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. A + slice's data, and anything reached through a [Ptr] or a global, is not: + there the runtime looks the address up in the allocation registry instead, + and storage the registry does not know — a global, or a caller's local + seen through a slice parameter — is not checked. *) +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,7 +4047,7 @@ 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 match e.Tast.ty with | Types.Dyn -> e @@ -4084,28 +4069,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 !view_structs n + | _ -> true) -> + let desc_of t = + match view_desc 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 +4142,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 +4157,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 @@ -4549,7 +4562,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; @@ -16458,7 +16471,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 @@ -17768,7 +17785,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 2f848442..ef173b09 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 ] } 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,13 @@ 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"; "store ptr %frame, ptr @flan_frame_head" ]; f.frame <- Some prev; (* The parameters are bound before the body starts, so they are recorded @@ -5059,8 +5062,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..c199f545 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,12 @@ 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; 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..0ea2ed37 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -1111,6 +1111,11 @@ 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; } flan_frame; /* The compiler names this symbol directly. A redefinition module reaches it @@ -1134,6 +1139,35 @@ 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; +} + /* [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) { @@ -1775,6 +1809,50 @@ 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. A scan, once per crossing, in a dev build. */ +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; + int64_t i; + if (!flan_reg_on || a == 0) return 0; + for (i = 0; i < FLAN_REG_CAP; i++) { + flan_reg_entry *e = &flan_reg[i]; + if (e->base == 0 || e->died != 0) continue; + if (a < e->base || 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 ace75dbc..0e7823d8 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. */ @@ -520,7 +522,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 +635,11 @@ 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); +/* 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); /* forward: needed by [dyn_equal] below, defined alongside the view helpers * further down — a length and an element reader that answer correctly @@ -687,6 +693,24 @@ 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, " "); + 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 +730,11 @@ 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); + render(w, vecish_at(o, i), depth + 1, 1); } emit(w, "]"); return; @@ -802,6 +820,27 @@ 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, " "); + 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 +866,12 @@ 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); + say_render(s, vecish_at(o, i), depth + 1); } say_puts(s, i == n ? "]" : i > 0 ? " ...]" : "...]"); return; @@ -2810,6 +2842,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 @@ -2860,14 +2909,273 @@ 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 release build keeps neither table, so a view there records nothing and + * checks nothing. Storage neither table knows — a global, rodata, C memory, + * a caller's local reached through a slice parameter — is not checked. */ +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; + +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); +extern void *flan_frame_head; + +#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; } + +static void guard_block(view_guard *g, const void *p) { + g->rbase = 0; + if (p != NULL) + 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 @@ -2875,17 +3183,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) { @@ -2902,104 +3201,300 @@ 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_block(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_block(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 is not a float here: it is refused, not + * converted, as every write through a view has been. A float into an f32 + * narrows, as (f32 x) does. [v] is the view and [x] the value, for the + * sentence. */ +static void view_write(const uint8_t *loc, int64_t loclen, const char *op, + flan_dyn v, const uint8_t *d, flan_dyn x, uint8_t *p) { + char ty[128]; + int64_t lo, hi; + if (int_range(*d, &lo, &hi)) { + 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); + if (n < lo || n > hi) { + desc_spell(d, ty, sizeof ty); + 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 a %s element, which holds %lld " + "to %lld", op, (long long)n, 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_FLOAT) + trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are float", v, x); + f = dyn_num_value(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) + trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are bool", v, x); + *p = dyn_payload(x) ? 1 : 0; + return; + case 't': + trap2(loc, loclen, TYPE_TRAP, op, + "a str element is read-only through a dyn view", v, x); + default: { + char sx[SAY_MAX]; + desc_spell(d, ty, sizeof ty); + say(sx, SAY_MAX, x); + flan_say(loc, loclen, + "dyn %s: this element is a %s, and a dyn view does not replace " + "it whole — write into its own elements or fields instead of " + "storing %s", + op, 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; } 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(NULL, 0, "print", 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 looks the address up + * in the allocation registry. */ +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_block(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(NULL, 0, "print", 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(NULL, 0, "print", o, fty, (uint8_t *)o->u.view.base + foff); +} + +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); +} + +/* 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) { @@ -3009,6 +3504,10 @@ flan_dyn flan_dyn_len(flan_dyn v) { reason [get] is. */ if (is_map(v)) { flan_obj *o = dyn_obj(v); + if (o->kind == OBJ_VIEW) { + view_guard_check(NULL, 0, "length", o); + return flan_dyn_from_i64(view_nfields(o)); + } class_sync(o); return flan_dyn_from_i64(o->len); } @@ -3044,8 +3543,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]); @@ -3092,10 +3590,8 @@ 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, 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); @@ -3111,20 +3607,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, 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; } @@ -3187,12 +3687,22 @@ 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]; } flan_dyn flan_dyn_map_contains(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(NULL, 0, "has-key?", 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); } @@ -3294,6 +3804,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, fty, v, p); + return; + } if (!is_map(m) || dyn_obj(m)->u.v.klass == NULL) { char sm[SAY_MAX]; say(sm, SAY_MAX, m); @@ -3335,6 +3851,12 @@ void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc, class_entry *e; if (!is_map(m)) trap2(NULL, 0, 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, fty, v, p); + return; + } e = class_sync(o); /* A map with no class, and a class with no typed slot, stop at the test. */ if (e != NULL && e->typed) v = check_slot(loc, loclen, BY_PUT, o, e, m, k, v); diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 39d6173e..fb40211f 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -301,56 +301,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 @@ -358,6 +342,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/programs/dyn-view-any.flan b/test/programs/dyn-view-any.flan new file mode 100644 index 00000000..da4852f1 --- /dev/null +++ b/test/programs/dyn-view-any.flan @@ -0,0 +1,211 @@ +;;;; 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]) + +(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 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. + (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) + (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)))) + 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) + :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 6d83f46c..adfc472f 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5838,6 +5838,74 @@ 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]\n2.75\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" + 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", "a str element is read-only through a dyn view") ] + 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") ] + 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 []); + (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_flan.ml b/test/test_flan.ml index 1f3d72cb..ffcb80dc 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 @@ -3700,12 +3675,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\ @@ -3713,10 +3686,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" @@ -7664,14 +7638,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 1b3843a1..398309ac 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -930,46 +930,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"); From 8291e62d7ab72d96910ef8dcffafce4e4023861a Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 06:10:51 +0700 Subject: [PATCH 2/7] TODO.org records the view decisions: str read-only, aggregates written through their own view, no int into a float element, and no check in a release build. --- TODO.org | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/TODO.org b/TODO.org index fc6f92ea..32ca5d86 100644 --- a/TODO.org +++ b/TODO.org @@ -20,10 +20,12 @@ 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, and an int is refused by a float element. A view of storage its +own dyn global's initialiser built is refused. Rules out copying at the crossing, and +any check in a release build. ** NEXT Dyn unless annotated Decided 2026-09-25: in both syntaxes an unannotated value is dyn — [6 2 4 9] is a dyn @@ -943,13 +945,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] From d5d9dc15381a1b46c8f7e6b96a8b5d7b88536559 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 06:17:59 +0700 Subject: [PATCH 3/7] A view describes a struct from its own program's table, and an Option's payload is bound to a slot before it is viewed. --- lib/check.ml | 29 ++++++++++++++++------------- runtime/flan_dyn.c | 3 ++- 2 files changed, 18 insertions(+), 14 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 6ca2fdd4..52ffac86 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -354,9 +354,9 @@ type env = { mutable guard_next : bool; } -(* The struct table [box] reads a struct's fields from when it describes one - for a view: [box] is called from places that hold no [ctx], and there is - one table per program. Set by [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 @@ -3640,7 +3640,7 @@ let no_dyn_yet loc ~into t extra = 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 (t : Types.t) : (string, Types.t) result = +let rec view_desc structs (t : Types.t) : (string, Types.t) result = let ( let* ) = Result.bind in match t with | Types.Int k -> @@ -3652,19 +3652,19 @@ let rec view_desc (t : Types.t) : (string, Types.t) result = | Types.Bool -> Ok "?" | Types.String -> Ok "t" | Types.Array (n, e) -> - let* d = view_desc e in + let* d = view_desc structs e in Ok (Printf.sprintf "a%Ld;%s" n d) - | Types.Slice (Types.Mut, e) -> let* d = view_desc e in Ok ("s" ^ d) - | Types.Vec e -> let* d = view_desc e in Ok ("v" ^ 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 !view_structs n with + (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 fl.Tast.fty in + let* d = view_desc structs fl.Tast.fty in Ok ((fl.Tast.fname ^ ";" ^ d) :: acc)) (Ok []) st.Tast.fields in @@ -4049,6 +4049,9 @@ let refuse_frame_escapes (f : Tast.fn) = 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 ] @@ -4085,10 +4088,10 @@ let box ?ctx loc (e : Tast.expr) : Tast.expr = 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 !view_structs n + | Types.Named n -> Hashtbl.mem structs n | _ -> true) -> let desc_of t = - match view_desc t with + match view_desc structs t with | Ok d -> mk loc Types.String (Tast.Str d) | Error inner -> view_not_yet loc e inner in @@ -4325,7 +4328,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 @@ -4336,7 +4339,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) ], diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 0e7823d8..5c69d5fb 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -3127,7 +3127,8 @@ 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); -extern void *flan_frame_head; +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 */ From 26fc9d82a637007f0e6d890964b992106a583c3c Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 06:17:59 +0700 Subject: [PATCH 4/7] docs/BUILT.md states how a dev build decides a dyn view is stale. --- docs/BUILT.md | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/docs/BUILT.md b/docs/BUILT.md index c1cf78c2..f2ea2a5a 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -3068,6 +3068,31 @@ 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. +- `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. Otherwise it asks the allocation + registry 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, and a caller's local reached through a slice parameter. That last one is deliberate — stamping it +with the callee's frame would trap on a live array after the callee returns. 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 From 749b4aeb8469edfb656ee6db953b42ce8cb66e63 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 06:22:26 +0700 Subject: [PATCH 5/7] A float element of a dyn view takes an int it holds exactly and traps on one it does not. --- TODO.org | 7 ++++--- runtime/flan_dyn.c | 27 +++++++++++++++++++++------ test/dyn_ops.c | 9 +++++++++ test/programs/dyn-view-any.flan | 9 ++++++++- test/test_acceptance.ml | 5 +++-- test/test_dyn.ml | 1 + 6 files changed, 46 insertions(+), 12 deletions(-) diff --git a/TODO.org b/TODO.org index 21cc3f01..eae50d2f 100644 --- a/TODO.org +++ b/TODO.org @@ -23,9 +23,10 @@ str. 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, and an int is refused by a float element. A view of storage its -own dyn global's initialiser built is refused. Rules out copying at the crossing, and -any check in a release build. +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, diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 5c69d5fb..8ef51d16 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -3306,10 +3306,10 @@ static int int_range(uint8_t c, int64_t *lo, int64_t *hi) { /* 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 is not a float here: it is refused, not - * converted, as every write through a view has been. A float into an f32 - * narrows, as (f32 x) does. [v] is the view and [x] the value, for the - * sentence. */ + * 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. */ static void view_write(const uint8_t *loc, int64_t loclen, const char *op, flan_dyn v, const uint8_t *d, flan_dyn x, uint8_t *p) { char ty[128]; @@ -3341,9 +3341,24 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op, switch (*d) { case 'f': case 'd': { double f; - if (flan_dyn_tag(x) != FLAN_DYN_TAG_FLOAT) + 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) { + desc_spell(d, ty, sizeof ty); + 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 trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are float", v, x); - f = dyn_num_value(x); if (*d == 'f') { float g = (float)f; memcpy(p, &g, 4); } else memcpy(p, &f, 8); return; 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 index da4852f1..e533bdf1 100644 --- a/test/programs/dyn-view-any.flan +++ b/test/programs/dyn-view-any.flan @@ -63,12 +63,14 @@ (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. + ;; 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]] @@ -208,4 +210,9 @@ (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) :else (do (println "?") 1)))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 2797653c..25aaefb5 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5851,7 +5851,7 @@ level "1" "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]\n2.75\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\ @@ -5867,7 +5867,8 @@ level "1" ("2", "this u64 element is 18000000000000000000, above the largest \ dyn int"); ("3", "a Point has no field :z. Its fields are :x :y"); - ("8", "a str element is read-only through a dyn view") ] + ("8", "a str element is read-only through a dyn view"); + ("9", "16777217 has no exact f32") ] and any_stale = [ ("4", "this view points into a local of leak-local, and that call \ has returned"); diff --git a/test/test_dyn.ml b/test/test_dyn.ml index 96875fce..a7d4f7ac 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 From 7991e00e760258e244ee018a7606ed58ebad1473 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 09:32:49 +0700 Subject: [PATCH 6/7] A struct's dyn view takes .field and [:k], read and assigned, and a get on it traps at its own site. --- runtime/flan_dyn.c | 6 ++++++ test/programs/dyn-view-any.flan | 18 ++++++++++++++++++ test/test_acceptance.ml | 6 ++++-- 3 files changed, 28 insertions(+), 2 deletions(-) diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 9208a601..41899587 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -3733,6 +3733,12 @@ 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); diff --git a/test/programs/dyn-view-any.flan b/test/programs/dyn-view-any.flan index e533bdf1..a05512b0 100644 --- a/test/programs/dyn-view-any.flan +++ b/test/programs/dyn-view-any.flan @@ -160,6 +160,19 @@ (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) @@ -215,4 +228,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) :else (do (println "?") 1)))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index ea8e0e58..7071fdab 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5925,7 +5925,8 @@ level "1" 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" + 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"); @@ -5933,7 +5934,8 @@ level "1" dyn int"); ("3", "a Point has no field :z. Its fields are :x :y"); ("8", "a str element is read-only through a dyn view"); - ("9", "16777217 has no exact f32") ] + ("9", "16777217 has no exact f32"); + ("10", "dyn put: a Point has no field :z. Its fields are :x :y") ] and any_stale = [ ("4", "this view points into a local of leak-local, and that call \ has returned"); From 497c9f470fe90d13a8c9a38636ce992b7e9424e4 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 09:54:45 +0700 Subject: [PATCH 7/7] A dyn view's record is collected with it, a dev build ties a view of a stack address to its owning frame and finds a heap block through an address index, and a view's traps name the field, the operation and the site. --- docs/BUILT.md | 15 +- lib/check.ml | 23 +- lib/emit.ml | 16 +- lib/x86.ml | 4 + runtime/flan_dev.c | 162 +++++++++++++- runtime/flan_dyn.c | 375 +++++++++++++++++++++++++++----- test/programs/dyn-view-any.flan | 56 +++++ test/test_acceptance.ml | 33 ++- 8 files changed, 599 insertions(+), 85 deletions(-) diff --git a/docs/BUILT.md b/docs/BUILT.md index f2ea2a5a..e9f3ef4f 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -3076,10 +3076,15 @@ A typed container crosses into dyn as a view of its storage wherever that storag - `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. +- `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. Otherwise it asks the allocation - registry for the smallest live block holding the address and keeps that block's base and note sequence. + 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 @@ -3088,8 +3093,8 @@ A typed container crosses into dyn as a view of its storage wherever that storag 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, and a caller's local reached through a slice parameter. That last one is deliberate — stamping it -with the callee's frame would trap on a live array after the callee returns. A release build records nothing and +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. diff --git a/lib/check.ml b/lib/check.ml index 0de974a6..aa7423a1 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -3759,11 +3759,10 @@ let view_not_yet loc (e : Tast.expr) (inner : Types.t) = 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. A - slice's data, and anything reached through a [Ptr] or a global, is not: - there the runtime looks the address up in the allocation registry instead, - and storage the registry does not know — a global, or a caller's local - seen through a slice parameter — is not checked. *) + 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 @@ -4348,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 @@ -10908,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. *) @@ -12105,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 @@ -12432,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 @@ -12957,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 = diff --git a/lib/emit.ml b/lib/emit.ml index 3bef9108..97240c6e 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -251,7 +251,7 @@ module Rt = struct let flanframe = { sname = "flanframe"; fields = [ "prev", Ptr; "info", Ptr; "slots", Ptr; "at", Ptr; - "serial", I64 ] } + "serial", I64; "fp", Ptr ] } let align_up n a = (n + a - 1) / a * a @@ -4481,6 +4481,15 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = "%%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 @@ -4922,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) @@ -5013,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, @@ -5029,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 diff --git a/lib/x86.ml b/lib/x86.ml index c199f545..8a512401 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -4219,6 +4219,10 @@ 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 "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 0ea2ed37..d4ed83fc 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -1116,6 +1116,11 @@ typedef struct flan_frame { * 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 @@ -1168,6 +1173,23 @@ int32_t flan_dev_frame_alive(const void *frame, uint64_t 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) { @@ -1556,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 @@ -1678,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 @@ -1770,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; } @@ -1794,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); } } } @@ -1814,18 +1955,25 @@ int32_t flan_dev_reg_live(const void *p) { * 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. A scan, once per crossing, in a dev build. */ + * 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; - int64_t i; + flan_ix_bucket *b; + int32_t i, pass; if (!flan_reg_on || a == 0) return 0; - for (i = 0; i < FLAN_REG_CAP; i++) { - flan_reg_entry *e = &flan_reg[i]; - if (e->base == 0 || e->died != 0) continue; - if (a < e->base || a >= e->base + (uintptr_t)e->bytes) continue; - if (best == NULL || e->bytes < best->bytes) best = e; + 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; diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 41899587..8c2a24e6 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -392,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; @@ -635,11 +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_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 @@ -647,6 +668,26 @@ static void view_struct_name(flan_obj *o, const char **name, int64_t *len); 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); @@ -706,7 +747,12 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) { if (i > 0) emit(w, " "); render(w, view_field_key(o, i), depth + 1, 1); emit(w, " "); - render(w, view_field_val(o, i), depth + 1, 1); + 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; @@ -734,7 +780,12 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) { emit(w, "["); for (i = 0; i < n; i++) { if (i > 0) emit(w, " "); - render(w, vecish_at(o, 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; @@ -742,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 @@ -836,7 +899,13 @@ static void say_render(sayer *s, flan_dyn v, int depth) { if (i > 0) say_puts(s, " "); say_render(s, view_field_key(o, i), depth + 1); say_puts(s, " "); - say_render(s, view_field_val(o, i), depth + 1); + 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; @@ -871,7 +940,13 @@ static void say_render(sayer *s, flan_dyn v, int depth) { say_puts(s, "["); for (i = 0; i < n && s->n < s->cap - 8; i++) { if (i > 0) say_puts(s, " "); - say_render(s, vecish_at(o, 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; @@ -1466,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; @@ -2896,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)); } @@ -3107,19 +3191,12 @@ static void desc_spell(const uint8_t *d, char *buf, size_t cap) { * which a free, a free-all, an arena's destroy and a Vec's * growth (for the block it left) all end. * - * A release build keeps neither table, so a view there records nothing and - * checks nothing. Storage neither table knows — a global, rodata, C memory, - * a caller's local reached through a slice parameter — is not checked. */ -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; + * 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); @@ -3136,12 +3213,26 @@ extern struct flan_frame *flan_frame_head; /* runtime/flan_dev.c */ 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; } -static void guard_block(view_guard *g, const void *p) { +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) - flan_dev_reg_claim(p, &g->rbase, &g->rseq, &g->rtype, &g->rtypelen); + 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) { @@ -3232,7 +3323,7 @@ static flan_dyn view_child(flan_obj *parent, const uint8_t *d, uint8_t *p) { memcpy(&data, p, 8); memcpy(&n, p + 8, 8); c = view_new(data, n, d + 1, VIEW_FLAT); - guard_block(view_g(c), data); + guard_storage(view_g(c), data); return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)c); } case 'a': { @@ -3244,7 +3335,7 @@ static flan_dyn view_child(flan_obj *parent, const uint8_t *d, uint8_t *p) { 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_block(view_g(c), p); + 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); } @@ -3309,25 +3400,103 @@ static int int_range(uint8_t c, int64_t *lo, int64_t *hi) { * 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, const uint8_t *d, flan_dyn x, uint8_t *p) { - char ty[128]; + 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 (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) { - desc_spell(d, ty, sizeof ty); + 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 a %s element, which holds %lld " - "to %lld", op, (long long)n, ty, (long long)lo, (long long)hi); + "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) { @@ -3347,7 +3516,12 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op, f = *d == 'f' ? (double)(float)n : (double)n; if (!(f >= -9223372036854775808.0 && f < 9223372036854775808.0) || (int64_t)f != n) { - desc_spell(d, ty, sizeof ty); + 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", @@ -3356,29 +3530,45 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op, } } else if (flan_dyn_tag(x) == FLAN_DYN_TAG_FLOAT) f = dyn_num_value(x); - else + 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 (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]; - desc_spell(d, ty, sizeof ty); + 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 a %s, and a dyn view does not replace " + "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, ty, sx); + op, an(ty), ty, sx); flan_trap((const uint8_t *)"DynType", 7); } } @@ -3394,12 +3584,13 @@ static uint8_t *view_elem_at(flan_obj *o, int64_t i) { * 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_read(NULL, 0, "print", o, o->u.view.desc, view_elem_at(o, i)); + 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]; } @@ -3433,8 +3624,8 @@ static uint8_t *view_field(const uint8_t *loc, int64_t loclen, const char *op, * 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 looks the address up - * in the allocation registry. */ + * 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); @@ -3446,7 +3637,7 @@ static flan_dyn view_make(void *base, int64_t len, const uint8_t *desc, flan_dev_frame_claim(flan_frame_head, &g->fname, &g->fnamelen); } } else - guard_block(g, base); + guard_storage(g, base); return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); } @@ -3464,7 +3655,7 @@ flan_dyn flan_dyn_view_at(void *addr, int64_t len, const uint8_t *desc, /* A struct view's fields by position, for the printers and equality. */ static int64_t view_nfields(flan_obj *o) { - view_guard_check(NULL, 0, "print", o); + view_guard_check(walk_loc, walk_len, walk_op, o); return desc_nfields(o->u.view.desc); } @@ -3488,7 +3679,28 @@ 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(NULL, 0, "print", o, fty, (uint8_t *)o->u.view.base + foff); + 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) { @@ -3498,6 +3710,54 @@ static void view_struct_name(flan_obj *o, const char **name, int64_t *len) { *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" @@ -3512,23 +3772,21 @@ flan_dyn flan_dyn_view_flat(void *data, int64_t len, int32_t elem) { 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) { - view_guard_check(NULL, 0, "length", o); - return flan_dyn_from_i64(view_nfields(o)); - } + 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); @@ -3616,7 +3874,8 @@ void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc, if (o->kind == OBJ_VIEW) { int64_t len = view_len(loc, loclen, "set-at", o); if (k < 0 || k >= len) trap_range(loc, loclen, "set-at", v, k, len); - view_write(loc, loclen, "set-at", v, o->u.view.desc, x, view_elem_at(o, k)); + 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); @@ -3648,7 +3907,7 @@ void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen) { /* 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, o->u.view.desc, x, 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; @@ -3745,11 +4004,11 @@ flan_dyn flan_dyn_get(flan_dyn m, flan_dyn k, const uint8_t *loc, 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(NULL, 0, "has-key?", o); + 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); @@ -3878,7 +4137,7 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v, 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, fty, v, p); + view_write(loc, loclen, "set", m, k, fty, v, p); return; } if (!is_map(m) || dyn_obj(m)->u.v.klass == NULL) { @@ -3909,7 +4168,7 @@ static void map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc, 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, fty, v, p); + view_write(loc, loclen, "put", m, k, fty, v, p); return; } e = class_sync(o); diff --git a/test/programs/dyn-view-any.flan b/test/programs/dyn-view-any.flan index a05512b0..8525c420 100644 --- a/test/programs/dyn-view-any.flan +++ b/test/programs/dyn-view-any.flan @@ -22,6 +22,13 @@ (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})) @@ -40,6 +47,19 @@ (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)))) @@ -233,4 +253,40 @@ (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/test_acceptance.ml b/test/test_acceptance.ml index 7071fdab..ff0185a4 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5933,15 +5933,34 @@ level "1" ("2", "this u64 element is 18000000000000000000, above the largest \ dyn int"); ("3", "a Point has no field :z. Its fields are :x :y"); - ("8", "a str element is read-only through a dyn view"); + ("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") ] + ("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") ] + ("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 @@ -5966,6 +5985,14 @@ level "1" 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 ();