From 7953376e4e9167e59c5870948cc89813cc50d6fe Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 06:10:11 +0700 Subject: [PATCH] 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");