diff --git a/FIX.org b/FIX.org index e905151..d0b9333 100644 --- a/FIX.org +++ b/FIX.org @@ -5997,3 +5997,85 @@ It cannot make a global hold a wrong value or an install go missing. Those run through the by-name table ([flan_dev_cell]) and the install path, which the program touches from one thread and which share no state with the allocation table. Three flakes, three causes; one of them is fixed here. + +* An assignment could be left half-written under --x86, 2026-09-21 +Found by a reviewer reading a live dev session, not by the suite: a global +of four numbers, assigned from a literal whose third element signalled, came +back part old and part new at the break loop — and all zeros once the frame +was abandoned. The LLVM build of the same program left it untouched. The rule +is that x86 tracks LLVM, so this was two bugs in lib/x86.ml and not a +difference to write down. + +Localized headlessly, both shapes on both backends, in +test/programs/half-write.flan and test/programs/dev-halfwrite.flan. + +** The half-write +Nothing in the x86 backend holds a value in a register across a statement, so +an aggregate was built *in its destination* — element by element, field by +field, as each one was computed. A condition signalled part-way through left +the destination part-way through. Every destination: a global, a local, a +struct field, an array element, a place behind a pointer. A union case was the +worst, since its destination is zeroed before the fields are written, so +building one in place wiped the variable before it damaged it. + +Fixed by building into a frame temporary and copying the finished value over, +which is the shape emit.ml already had. The copy is paid for only where it +buys something: X86.settles answers whether lowering an expression is bound to +reach the end of it, and a right-hand side that settles — a literal, a read, +unchecked arithmetic, an aggregate of those — is still built in place. A let +pays only inside a loop, because a slot reached once per frame is recorded as +bound after the value lands and reads as unbound until then. + +** The wipe +Not the same bug, and the all-zeros case is why it was worth chasing after the +first one was fixed. An aggregate result is written through a hidden pointer +the caller supplies; at (set g (f)) that pointer is g. The transfer exit — +where a signal leaves a function that offered no restart-case — zeroed the +return value on the correct reasoning that the caller never reads it. For a +scalar that zeroes a slot of the frame that is leaving; for an aggregate it +zeroed the caller. It zeroes scalars only now. + +The report said "after abandon-evaluation" and that is exactly right: the +restart the agent establishes around every thunk (fe6744a) unwinds past the +store, and it unwinds through the aggregate-returning frame, which is where +the zeroing happened. The first attempt at this entry said that restart did +not exist. It was written against a branch cut before fe6744a landed, and is +a reminder that "I cannot find it" is not "it is not there". + +There is no test pinning the wipe on its own, and there cannot easily be one: +with the assignment fixed, the pointer a result is written through at an +assignment is the temporary, so zeroing it is invisible and the whole suite +passes with this half reverted. It is defence in depth. What would make it +visible again is a destination that outlives the statement and is handed +straight to a call — which is what the first half exists to prevent. + +** Scalars were never affected +On either backend. A scalar store is one instruction and it happens after the +check for a transfer, so a call that signalled never reaches it. + +** Two follow-up lanes this one found and did not take +Neither is about transfers, so neither is fixed by the temporary above. + +*** An aggregate built in place can read its own destination +Lowering asks whether it can *transfer*. It does not ask whether it can +*alias*, and in-place construction needs both: + + (defstruct P [a i32 b i32]) + (defonce p P (P {.a 1 .b 2})) + (set p (P {.a (.b p) .b (.a p)})) + +LLVM answers 2 1; --x86 answers 2 2, because the first field is written into +p before the second one reads it. The .s header claims an aggregate is copied +and never aliased, and this is where that stops being true. Pre-existing, on +both this branch and the merged one, and found by the review of this lane. + +The fix has a shape already: the same temporary, chosen by an aliasing +question rather than a transfer one. Whether the two questions become one +predicate or two is the lane to decide. + +*** The temporary is an unrooted buffer while it is being filled +The aggregate under construction now lives in a frame temporary that no root +table names. Harmless today only because check.ml refuses a dyn field in a +struct — the stopgap item 2 of the M2 queue lifts. Whoever lifts it has to +root this buffer, or a collection that runs inside the construction will not +see what has been built so far. diff --git a/docs/BUILT.md b/docs/BUILT.md index e3d623f..56c2365 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -5454,6 +5454,62 @@ having a second bullet added beside them, and the same reasoning went into `spec section that already enumerates what a transfer does and does not do: it runs `defer`s, it skips `errdefer`s, and it does not undo. No numbered case changed meaning, so the freeze holds. +## An assignment is whole or it never happened + +The section above is about work an abandoned frame really did and the program has to undo. This is the other edge of +the same knife: work it did **not** do. If a condition is signalled from inside the value being assigned — the third +element of an array literal, one field of a struct, the call the whole right-hand side is — and a handler answers by +abandoning the frame, the destination has to read exactly what it read before. A variable that is half its old value +and half its new one is not a state the program was ever in, so no snapshot taken from it is worth anything and no +restart written against it can be trusted. + +That is free on the LLVM backend, which builds an aggregate as one SSA value and stores it once. It is not free on the +x86-64 one, which has no register wide enough to hold a struct and therefore built each aggregate **in its +destination**, element by element, as the elements were computed. Two separate failures came out of that, and both +were measured rather than reasoned about — `test/programs/half-write.flan` is the measurement, and every row in it +used to disagree between the backends: + +- **The half-write.** `(set colors [1 1 (blow) 1])` on a global of four numbers stored the first two and then + signalled, leaving `[1 1 9 9]` where LLVM left `[9 9 9 9]`. The same for a struct literal, a union case, a field, an + array element, a place behind a pointer, and a local rebound inside a loop. A union case was the worst of them: its + payload is wider than any one case, so the destination is zeroed before the fields are written, and building one in + place wiped the variable before it damaged it. +- **The wipe.** `(set colors (wreck))` came back **all zeros**, which the shape above does not explain. An aggregate + result is written through a hidden pointer the caller supplies, and the caller supplied the global. The transfer + exit — the path a signal takes out of a function that offered no `restart-case` — zeroed the return value on its way + past, on the correct reasoning that the caller's guard never reads it. For a scalar that zeroes a slot of the frame + that is leaving. For an aggregate it zeroed the caller's variable. + +Both are fixed in `lib/x86.ml`. The transfer exit zeroes scalars only. An assignment whose right-hand side might leave +part-way builds into a frame temporary and copies the finished value across in one block move, so the destination is +either wholly the old value or wholly the new one. + +**The copy is paid for only where it buys something.** `X86.settles` answers whether lowering an expression is bound +to reach the end of it, and a right-hand side that settles is still built straight into the destination: literals, +`Zero`, reads of a local or a global or a field, unchecked arithmetic, and aggregate construction over those. So +`(set grid [1 2 3 4])` costs nothing it did not cost before. Anything else — a call, a signal, an index, a division, +an `(some x)` that returns early, and any node the list has not heard of — pays one frame temporary and one +`rep movsb`. Being wrong in that direction costs a copy; being wrong in the other costs a corrupted variable. + +**A conversion is the one place it is worth being exact.** Only a float narrowed to an integer is checked — the +instruction answers a fixed number rather than an answer for a value out of range, so the range is tested first and +the failure signals. Every other conversion is a move, a widen or one SSE instruction and can go nowhere. Refusing +all of them would have been simpler and would have made the most ordinary aggregate literal in the language pay for +a copy, since an array of `u32` is written `[(u32 1) (u32 2)]` and not `[1 2]`. `half-write.flan` has a row for the +checked direction, so the distinction is pinned rather than asserted. + +**A `let` pays only inside a loop.** A binding reached once per frame writes into storage nothing has read: the slot +is recorded as bound *after* the value lands, so a break taken half-way through building one reports the name as not +bound yet — which is the truth, and what the LLVM backend reports too. A `let` inside a loop is the case that +differs, because the slot still holds the previous turn's value, and that difference is visible: the same program +stopped at the same break answered `[ 2 2 5 1]` under `--x86` and `[ 1 1 5 1]` under `--llvm` when the inspector was +asked for the local. `test/programs/dev-halfwrite.flan` is that program and `test_dev.ml` asks both backends, since a +backend the break loop can tell apart is a backend the break loop cannot be trusted on. + +Scalars were never affected, on either backend, and `half-write.flan`'s last row is there to keep the two claims from +being read as one: a scalar's store is a single instruction and it happens after the check for a transfer, so a call +that signalled never reaches it. + ## Ghost text finds its anchor in the buffer, not in the table `M-x flan-watch-ghost-mode` paints each watched value inline, after the line holding the call that wrote it, as an @@ -6490,18 +6546,17 @@ next evaluation of the same name stores like any other. The editor's reply to th then, saying "queued", so the failure arrives as a stop, which is how every other condition in a running program arrives. -**What survives that is the scalar case on both backends, and the aggregate case on LLVM only.** A scalar initialiser -returns in a register and is stored after the transfer guard, so a signal jumps past the store and the global keeps -its old value; LLVM does the same for an aggregate, because it calls into a temporary and then stores once. The x86 -backend has no `Set` arm of its own — it lowers a value straight into its place (`x86.ml`'s `Set`), and a call -returning an aggregate is given the destination as its sret pointer — so `(def colors [4 u32] [9 9 (wreck) 9])` -writes into the live global element by element. At the break `colors[0]` is already `9` with the tail still old, and -after `abandon-evaluation` all four elements are zero. +**What survives that is the global's old value, whole, on both backends.** A scalar initialiser returns in a register +and is stored after the transfer guard, so a signal jumps past the store; an aggregate is built in a temporary and +copied over in one move, so the global is either wholly its old value or wholly its new one. -This is **pre-existing and not about `def`**: a plain `C-x C-e` of `(set colors (wreck))` does the same on x86, and -the runtime already says so in the restart's own note — "anything the expression changed before it stopped is still -changed". What is new is that every `def` edit now goes through that path, which is why it is written down here. -Routing an x86 aggregate `Set (Pglobal, Call)` through a temporary, and chasing the zeroing, is a lane of its own. +That second half was true of LLVM from the start and was not true of x86, where `(def colors [4 u32] [9 9 (wreck) 9])` +used to write into the live global element by element: at the break `colors[0]` was already `9` with the tail still +old, and after `abandon-evaluation` all four elements were zero. Both are fixed — see "An assignment is whole or it +never happened" above for the two bugs that were, and for what the temporary costs and when it is skipped. The +restart's own note still says "anything the expression changed before it stopped is still changed", and still means +it: an assignment that *completed* before the signal stands, and rolling those back is the program's business (see "A +restart is not a transaction"). What no longer happens is a single assignment left halfway. **A `def` whose type changed** is refused before anything is stored, by `Session.compatible`, which already said the right sentence for this path: *`speed` changes type, from `i64` to `string`; the running program already laid that diff --git a/lib/x86.ml b/lib/x86.ml index 911ee6d..2bc86f3 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -1565,6 +1565,89 @@ let emit_args f (args : arg list) = point is that the store has somewhere legal to go. *) let sink = Lf 0 +(* Whether lowering this expression into a destination is bound to reach the + end of it. + + Nothing in this backend holds a value in a register across a statement, so + an aggregate is built *in the destination*: field by field, element by + element, each one stored as it is computed. That is the cheapest thing that + works, and it works right up until the middle of the construction leaves. + A condition signalled while the third of four elements is being computed + transfers out of the assignment with two elements written and two not, and + what is left behind is a variable that is half its old value and half its + new one. The LLVM backend cannot have that shape — it builds the whole + aggregate as one value and stores it once — and where the two disagree, + this one is the one that is wrong. + + So an assignment whose right-hand side might leave part-way builds into a + frame temporary and copies the finished value over in a single block move. + The copy is not free, which is what this question is for: it buys nothing + for [(set grid [1 2 3 4])], where nothing between the first store and the + last can go anywhere at all. + + The answer is yes only for shapes spelled out below, none of which can + reach a call, a signal, a bounds or arithmetic check, or a return. Anything + else answers no and pays for the copy — a node added to the IR later + included, since being wrong this way costs a block copy and being wrong the + other way costs a corrupted variable. *) +let settled_prim (p : Tast.prim) = + match p with + (* Arithmetic that cannot fail. Division and remainder are absent on + purpose: both are checked, and a check signals. *) + | Tast.Add | Tast.Sub | Tast.Mul + | Tast.Eq | Tast.Ne | Tast.Lt | Tast.Le | Tast.Gt | Tast.Ge | Tast.Not + | Tast.BitAnd | Tast.BitOr | Tast.BitXor | Tast.Shl | Tast.Shr + (* Questions about a value's shape, answered from the layout tables. *) + | Tast.Len | Tast.SizeOf _ | Tast.AlignOf _ | Tast.AddrOf -> true + (* Everything else reaches C, signals, or both: an index and a slice are + bounds-checked and [Rt] is a call by definition. [Cast] is not here + because it is only sometimes checked; see [cast_checks]. *) + | _ -> false + +(* Which conversions can signal, and it is one of them. [cvttsd2si] answers a + fixed "integer indefinite" for a value out of range, which is a number + rather than an answer, so a float narrowed to an integer is tested against + the destination's range first and the failure signals ArithError — see + [cast], which is where the test is emitted. Every other conversion is a + move, a widen or one SSE instruction, and cannot go anywhere. That matters + here because an array of the language's own literals is usually written + [(u32 1)] and not [1], and refusing every cast would have made the most + ordinary aggregate literal there is pay for a copy. *) +let cast_checks (src : Types.t) (target : Types.t) = + let concrete (t : Types.t) = + match t with Types.Enum _ -> Types.Int Types.I32 | t -> t + in + match concrete src, concrete target with + | Types.Float _, Types.Int _ -> true + | _ -> false + +let rec settles (e : Tast.expr) = + match e.Tast.e with + (* Values with no code in them to leave from. *) + | Tast.Int _ | Tast.Float _ | Tast.Bool _ | Tast.Str _ | Tast.Unit + | Tast.Zero _ | Tast.Uninit _ | Tast.Local _ | Tast.Global _ | Tast.None_ + | Tast.FnAddr _ -> true + (* Building an aggregate, and running a sequence: as settled as the parts. *) + | Tast.Make (_, es) | Tast.MakeCase (_, _, es) | Tast.Arr es | Tast.Do es -> + List.for_all settles es + | Tast.Some_ x | Tast.Field (x, _) | Tast.CaseField (x, _, _) + | Tast.Deref x -> settles x + | Tast.If (c, a, b) -> settles c && settles a && settles b + | Tast.Addr p -> settles_place p + | Tast.Prim (Tast.Cast target, [ a ]) -> + (not (cast_checks a.Tast.ty target)) && settles a + | Tast.Prim (p, es) -> settled_prim p && List.for_all settles es + (* A call, a signal, an invoke, an unwrap that returns early, a loop, a + [return], a [break] — and anything this list has not heard of. *) + | _ -> false + +and settles_place (p : Tast.place) = + match p with + | Tast.Plocal _ | Tast.Pglobal _ -> true + | Tast.Pfield (x, _) | Tast.Pderef x -> settles x + (* An index is bounds-checked, and the check signals. *) + | Tast.Pindex _ -> false + let rec lower f (e : Tast.expr) (dst : loc) : unit = (* The one hook the line table needs, and it is here rather than at statement granularity on purpose: the same recursion that lowers a nested @@ -1675,7 +1758,20 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit = | Tast.Let (bs, body) -> List.iter (fun (slot, (v : Tast.expr)) -> - scoped f (fun () -> lower f v (Lf f.slots.(slot))); + (* The same care an assignment gets, but only where a slot can + already hold something. A [let] reached once per frame writes into + storage no one has read and no one may read: the slot is recorded + as bound *after* the value lands (see [bind_slot]), so a break + taken half-way through building one reports the name as not bound + yet, which is the truth and is what the LLVM backend reports too. + A [let] inside a loop is the case that differs — the slot still + holds the previous turn's value, and building the next one in + place makes the break loop show a variable that is half one turn + and half the next. So the copy is paid for inside a loop and + nowhere else. *) + scoped f (fun () -> + let d = Lf f.slots.(slot) in + if f.loops = [] then lower f v d else assign f ~dst:d v); bind_slot f slot) bs; block f body dst t @@ -1720,7 +1816,7 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit = | None -> unsupported "continue %d outside a loop" n) | Tast.Set (p, v) -> let l = place f p in - scoped f (fun () -> lower f v l) + scoped f (fun () -> assign f ~dst:l v) | Tast.Make (sn, xs) -> let offs = field_offsets f sn in List.iteri @@ -2226,6 +2322,25 @@ and block f body dst t = in go body +(* Writing a value into a place that already holds one, which is the case + [settles] exists for. See its comment for why: an aggregate right-hand side + that can leave part-way is built in a temporary and moved over afterwards, + so the place is either wholly its old value or wholly its new one and never + a seam between the two. A scalar needs none of this — its store is a single + instruction and it happens after the transfer guard, so a call that + signalled never reaches it. + + [dst] is worked out by the caller and outlives this: [scoped] reclaims the + temporary, not the destination. *) +and assign f ~(dst : loc) (v : Tast.expr) : unit = + let t = v.Tast.ty in + if (not (is_agg t)) || settles v then lower f v dst + else begin + let o = Lf (tmp f t) in + lower f v o; + copy_loc f ~dst ~src:o (sizeof f.md t) + end + (* The address of something that denotes a location. Nothing is copied. *) and lvalue f (e : Tast.expr) : loc = match e.Tast.e with @@ -3735,9 +3850,23 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false) Emitted here, *before* the prologue buffer is made, because [frame_bytes] is read when the prologue is built and everything below allocates - temporaries and makes calls that move the high-water mark. *) + temporaries and makes calls that move the high-water mark. + + Scalars only, and that is the whole of the bug this line used to be. A + scalar result lives in a slot of *this* frame, so zeroing it costs one + store into memory nobody else can see. An aggregate result does not: it + is written through the hidden [sret] pointer the caller handed over, so + [ret_loc] here names the caller's storage — and for [(set some-global + (f))] that storage is the global itself. Zeroing it on the way out of a + transfer therefore did not blank a meaningless return value, it blanked + the caller's variable: a global of four numbers came back all zeros after + a condition was signalled part-way through building it. The value is + meaningless either way — the caller's guard sees the channel set and + never reads it — so the honest thing is to leave the caller's bytes + alone. *) let zero_return () = - if not (is_void fn.Tast.ret) then zero_value f (ret_loc f) fn.Tast.ret + if (not (is_void fn.Tast.ret)) && not (is_agg fn.Tast.ret) then + zero_value f (ret_loc f) fn.Tast.ret in if f.unwound then begin (* The body falls through to the epilogue, so it has to be sent there diff --git a/test/programs/dev-halfwrite.flan b/test/programs/dev-halfwrite.flan new file mode 100644 index 0000000..6fc0546 --- /dev/null +++ b/test/programs/dev-halfwrite.flan @@ -0,0 +1,53 @@ +;;;; What a variable reads as while an assignment to it is stopped part-way. +;;;; +;;;; half-write.flan asks the same question from inside the program, after the +;;;; frame has been abandoned. This one asks it from outside, at the break — +;;;; which is where it was first noticed, and where a local can be looked at +;;;; at all: a half-built local is invisible to the program (its name is not +;;;; in scope until the value lands) and perfectly visible to an editor +;;;; reading the frame. +;;;; +;;;; Three turns of one loop and two stops, so a single session answers both +;;;; halves. Nothing here handles the condition, so each stop lands in the +;;;; break loop with the program's own `continue` on offer. +;;;; +;;;; turn 0 — both the local and the global are built whole: 1 1 5 1. +;;;; turn 1 — signalled while the *local* is being built. At the stop the +;;;; slot still belongs to turn 0 and has to read 1 1 5 1 whole, +;;;; not 2 2 . 1 with the first half of turn 2 in it. +;;;; turn 2 — resumed, the local is rebuilt, and then the signal comes from +;;;; inside the *global's* assignment. At the stop the global has +;;;; to read turn 0's 1 1 5 1, not 3 3 5 1. +(import agent "vendor:agent") + +(defstruct Boom [why i32]) + +(defonce colors [4 u32] [9 9 9 9]) +(defonce spare [4 u32] [9 9 9 9]) +(defonce skipped i64) + +(defn blow [] u32 + (error (Boom {.why 1})) + 0) + +;;; One element of each literal, arranged so that each turn stops in at most +;;; one place and the two stops are in different ones. +(defn in-local [n i32] u32 (if (= n 1) (blow) (u32 5))) +(defn in-global [n i32] u32 (if (= n 2) (blow) (u32 5))) + +(defn work [] () + (dotimes [i 3] + (restart-case + (do + (let [v [(u32 (+ i 1)) (u32 (+ i 1)) (in-local i) (u32 (+ i 1))]] + (set spare v)) + (set colors + [(u32 (+ i 1)) (u32 (+ i 1)) (in-global i) (u32 (+ i 1))])) + (continue [] (set skipped (+ skipped 1)))))) + +(defn main [] i32 + (agent/start "/tmp/flan-dev-halfwrite-fallback.sock") + (work) + (dotimes [i 4000] + (agent/wait 5)) + 0) diff --git a/test/programs/half-write.flan b/test/programs/half-write.flan new file mode 100644 index 0000000..d866e9a --- /dev/null +++ b/test/programs/half-write.flan @@ -0,0 +1,177 @@ +;;;; An assignment is all of the new value or none of it, never a seam. +;;;; +;;;; A condition can be signalled from inside the value being assigned — the +;;;; third element of an array literal, one field of a struct, the call whose +;;;; result the whole thing is. If a handler answers that by abandoning the +;;;; frame, the assignment never finishes, and the question this file asks is +;;;; what the variable holds afterwards. The answer has to be: exactly what it +;;;; held before. A variable that is half its old value and half its new one +;;;; is not a state any program can be written against. +;;;; +;;;; That is easy on a backend that builds a whole struct as one value and +;;;; stores it once, and it is not free on one that has no registers to hold a +;;;; struct in: there, the obvious lowering writes each element straight into +;;;; the destination as it is computed, and the destination is the variable. +;;;; So this file is here for the x86-64 backend, where every row below used +;;;; to come back wrong, and it runs on both so that the two keep answering +;;;; the same thing. +;;;; +;;;; Every row is a different *destination* — a global, a local, a field, an +;;;; array element, a place behind a pointer — crossed with a different +;;;; right-hand side: an array literal, a struct literal, a union case, a call +;;;; that returns the aggregate. The last row is the scalar, which was never +;;;; broken and is here so that a regression in one is not read as the other. + +(defstruct Boom [why i32]) + +(defstruct Pair [a u32 b u32]) +(defstruct Box [tag u32 inner [4 u32]]) +(defdata Shape [Nothing (Circle [r u32 fill u32])]) + +;;; Old values, distinct from every new one, so a survivor is recognisable +;;; and a seam is too. +(defonce colors [4 u32] [9 9 9 9]) +(defonce pair Pair (Pair {.a 8 .b 8})) +(defonce box Box (Box {.tag 8 .inner [8 8 8 8]})) +(defonce shape Shape (Shape.Circle {.r 8 .fill 8})) +(defonce rows [2 [4 u32]] [[9 9 9 9] [9 9 9 9]]) +(defonce scalar u32 7) + +(defonce skipped i64) +;;; Larger than any u32, so converting it signals rather than answering. +(defonce huge f64 1e30) + +;;; The signal, and nothing else. It is a function so that it can stand in the +;;; middle of a literal, which is where the damage used to happen. +(defn blow [] u32 + (error (Boom {.why 1})) + 0) + +;;; The same value, returned rather than written: an aggregate comes back +;;; through a pointer the caller supplies, and that pointer used to be the +;;; destination itself. +(defn wreck [] [4 u32] + [(u32 1) (u32 1) (blow) (u32 1)]) + +(defn show-arr [xs [4 u32]] () + (print (at xs 0)) (print " ") + (print (at xs 1)) (print " ") + (print (at xs 2)) (print " ") + (print (at xs 3)) (println "")) + +;;; One frame per row, each offering `continue` — sand.flan's shape, and the +;;; one a game uses: abandon this frame, keep the program. +(defn global-literal [] () + (restart-case + (set colors [(u32 1) (u32 1) (blow) (u32 1)]) + (continue [] (set skipped (+ skipped 1))))) + +(defn global-call [] () + (restart-case + (set colors (wreck)) + (continue [] (set skipped (+ skipped 1))))) + +;;; The other way an assignment stops part-way, and the one the backend's cast +;;; rule is about. A float narrowed to an integer is range-checked, because the +;;; instruction answers a fixed number rather than an answer for a value out of +;;; range — so that conversion signals and the assignment has to be built aside +;;; first. Every other conversion is a move or a widen and can go nowhere, +;;; which is what keeps `[(u32 1) (u32 2)]` — how an array of this language's +;;; literals is usually spelled — costing nothing. +(defn cast-literal [] () + (restart-case + (set colors [(u32 1) (u32 1) (u32 huge) (u32 1)]) + (continue [] (set skipped (+ skipped 1))))) + +(defn global-struct [] () + (restart-case + (set pair (Pair {.a 1 .b (blow)})) + (continue [] (set skipped (+ skipped 1))))) + +;;; A union case is the sharpest of the lot: the payload is wider than any one +;;; case, so the destination is zeroed before the fields are written. Building +;;; one in place therefore wiped the variable before it damaged it. +(defn global-case [] () + (restart-case + (set shape (Shape.Circle {.r 1 .fill (blow)})) + (continue [] (set skipped (+ skipped 1))))) + +;;; A field of a struct, and an element of an array of arrays: two ways to +;;; name a destination that is not a whole variable. +(defn field-place [] () + (restart-case + (set (.inner box) (wreck)) + (continue [] (set skipped (+ skipped 1))))) + +(defn index-place [] () + (restart-case + (set (at rows 1) [(u32 1) (u32 1) (blow) (u32 1)]) + (continue [] (set skipped (+ skipped 1))))) + +;;; A place behind a pointer, which is how a callee writes into a caller's +;;; storage and how sand.flan reaches a grid it was handed. +(defn through-ptr [p (Ptr [4 u32])] () + (restart-case + (set (deref p) (wreck)) + (continue [] (set skipped (+ skipped 1))))) + +;;; A local, and a local inside a loop. +;;; +;;; The loop is the case a running program cannot see for itself: the second +;;; turn's slot still holds the first turn's value, and a seam between them is +;;; only visible to something reading the frame from outside — which is the +;;; break loop, so that half is asserted in test_dev.ml and not here. What +;;; this row is worth is the other direction: the loop still prints the whole +;;; first-turn value, so the copy the second turn now pays for has not broken +;;; the ordinary path. +(defn local-place [] () + (let [v [(u32 1) (u32 1) (u32 1) (u32 1)]] + (restart-case + (set v (wreck)) + (continue [] (set skipped (+ skipped 1)))) + (show-arr v))) + +(defn local-loop [] () + (restart-case + (dotimes [i 2] + (let [v [(u32 (+ i 1)) (u32 (+ i 1)) (if (= i 0) (u32 5) (blow)) + (u32 (+ i 1))]] + (show-arr v))) + (continue [] (set skipped (+ skipped 1))))) + +;;; The control. A scalar has always been whole, because its store is one +;;; instruction and it happens after the check for a transfer. +(defn scalar-place [] () + (restart-case + (set scalar (blow)) + (continue [] (set skipped (+ skipped 1))))) + +(defn main [] i32 + (let [spare [(u32 1) (u32 1) (u32 1) (u32 1)]] + (handler-bind + [(Boom [_c] (invoke-restart 'continue)) + (ArithError [_c] (invoke-restart 'continue))] + + (global-literal) (show-arr colors) + (global-call) (show-arr colors) + (cast-literal) (show-arr colors) + + (global-struct) + (print (.a pair)) (print " ") (print (.b pair)) (println "") + + (global-case) + (match shape + (Circle r fill) (do (print r) (print " ") (print fill) (println "")) + Nothing (println "nothing")) + + (field-place) (show-arr (.inner box)) + (index-place) (show-arr (at rows 1)) + (through-ptr (addr spare)) (show-arr spare) + + (local-place) + (local-loop) + + (scalar-place) (print scalar) (println ""))) + + (print "skipped ") (print skipped) (println "") + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 42173eb..e6e5b39 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2688,6 +2688,30 @@ let () = outputs ~dev:true "an abandoned frame rolls back, dev" "programs/frame-rollback.flan" rollback_out; + (* Rollback is the programmer's job; *not* leaving a variable half-written + is the compiler's, and the two are easy to confuse. frame-rollback.flan + is about work an abandoned frame legitimately did and the program has + to undo. This is about work it did not do: an assignment signalled + through part-way has to leave the destination exactly as it was, so + that the snapshot the program restores is a whole value and not a seam. + + Both backends, because that is the whole claim. The x86-64 one builds + an aggregate in its destination — it has no register wide enough to + hold one — so every row here used to come back a mixture of the old + value and the new, and two of them came back all zeros: the transfer + exit blanked the hidden result pointer, which for [(set g (f))] is [g] + itself. LLVM never could, and where they disagree x86 is the one that + is wrong (docs/BUILT.md, "x86 tracks LLVM"). *) + let half_write_out = + "9 9 9 9\n9 9 9 9\n9 9 9 9\n8 8\n8 8\n8 8 8 8\n9 9 9 9\n1 1 1 1\n\ + 1 1 1 1\n1 1 5 1\n7\nskipped 11\n" + in + outputs "an assignment signalled through leaves the old value" + "programs/half-write.flan" half_write_out; + outputs ~x86:true + "an assignment signalled through leaves the old value, --x86" + "programs/half-write.flan" half_write_out; + (* ── Packages: the link follows the program ──────────────────────── A package's C and linker arguments used to come with the import, whatever [main] did — which is what made sand's two halves two files diff --git a/test/test_dev.ml b/test/test_dev.ml index a25cc2f..8626993 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -5486,6 +5486,128 @@ let () = end; List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ isock; iout ]; + (* ── What a half-finished assignment looks like from the break ────── *) + + (* A condition signalled from inside the value being assigned stops the + program in the middle of an assignment, and the break loop is then + looking at a variable nothing has finished writing. What it has to show + is the old value, whole: a listing that is half one value and half + another is worse than no listing, because there is no way to tell from + reading it that it is not a state the program was ever in. + + Both backends, asked the same two questions of the same program, for + the reason the inspector block above gives — a backend the break loop + can tell apart is a backend the break loop cannot be trusted on. It was + tellable apart: x86-64 builds an aggregate in its destination, so this + daemon used to answer [ 2 2 5 1] for the local and [ 3 3 5 1] for the + global where the LLVM one answered [ 1 1 5 1] for both. + + The local is the half that can only be asked here. A half-built local + is invisible to the running program — the name is not in scope until + the value has landed — and completely visible to an editor reading the + frame, so programs/half-write.flan cannot make this claim and this can. + The second stop, reached by taking the program's own [continue], is the + global, which is the shape the divergence was first noticed in. *) + let half_written flag = + let hsock = tmp ("halfwrite" ^ flag ^ ".sock") + and hout = tmp ("halfwrite" ^ flag ^ ".out") in + (try Sys.remove hsock with Sys_error _ -> ()); + let hfd = + Unix.openfile hout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let hpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-halfwrite.flan"; "-s"; hsock; flag |] + Unix.stdin hfd Unix.stderr + in + Unix.close hfd; + if not (listening ~pid:hpid hsock) then begin + fail "the %s half-write daemon %s (%S)" flag !listen_why + (In_channel.with_open_bin hout In_channel.input_all); + (try Unix.kill hpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect hsock in + let said r = Option.value ~default:"" (Wire.string_field r "message") in + let triples r key = + match Wire.field r key with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (e : Form.t) -> + match e.Form.v with + | Form.List ({ Form.v = Form.Str a; _ } + :: { Form.v = Form.Str b; _ } + :: { Form.v = Form.Str v; _ } :: _) -> + Some (a, b, v) + | _ -> None) + l + | _ -> [] + in + (* Which of the two stops this is, by the function under the signal. + [stopped] alone cannot tell them apart, and the window between them + is a moment where it is false. *) + let inside () = + match Wire.field (request c "(:op \"backtrace\")") "frames" with + | Some { Form.v = Form.List (_ :: { Form.v = Form.List + ({ Form.v = Form.Str n; _ } :: _); _ } + :: _); _ } -> n + | _ -> "" + in + if not (await (fun () -> inside () = "in-local")) then + fail "%s: the program never stopped inside the local's assignment" flag + else begin + let r = request c "(:op \"locals\" :frame 2)" in + if status r <> "ok" then fail "%s half-write locals: %s" flag (said r) + else + (match List.filter (fun (n, _, _) -> n = "v") (triples r "locals") with + | [ ("v", "[4 u32]", "[ 1 1 5 1]") ] -> () + | got -> + fail + "%s: a local caught mid-assignment reads %s, not its whole \ + previous value" + flag + (String.concat ", " + (List.map (fun (n, ty, v) -> n ^ " " ^ ty ^ " = " ^ v) got))); + (* On to the second stop, through the program's own restart. *) + let r = request c "(:op \"restart\" :name \"continue\")" in + if status r <> "ok" then + fail "%s: continuing from the first stop: %s" flag (said r) + else if not (await (fun () -> inside () = "in-global")) then + fail "%s: the program never stopped inside the global's assignment" + flag + else begin + let r = request c "(:op \"globals\")" in + if status r <> "ok" then fail "%s half-write globals: %s" flag (said r) + else + match + List.filter (fun (n, _, _) -> n = "colors") (triples r "globals") + with + | [ ("colors", "[4 u32]", "[ 1 1 5 1]") ] -> () + | got -> + fail + "%s: a global caught mid-assignment reads %s, not its whole \ + previous value" + flag + (String.concat ", " + (List.map (fun (n, ty, v) -> n ^ " " ^ ty ^ " = " ^ v) got)) + end + end; + (* No [close]: the program is stopped with nothing left to resume into, + so the way out is the abort, and the daemon follows the program. An + abort is refused by a program that is *running*, which is what a + failure above would leave behind — and this fixture then polls for + twenty seconds and parks, so the wait below would be a hang rather + than a report. The signal is for that case only. *) + if status (request c "(:op \"abort\")") <> "ok" then + (try Unix.kill hpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try Unix.close c with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] hpid) with Unix.Unix_error _ -> ()) + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ hsock; hout ] + in + half_written "--x86"; + half_written "--llvm"; + (* And the *merged* daemon on this backend, which used to be refused by name and is the case the refusal was standing in for.