JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'worktree-agent-a6b21b9d0ff2daa2e' into dev-loop

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-21 12:42:21 +07:00
commit 09b77adc38
7 changed files with 657 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
FIX.org
View File

@ -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.

77
docs/BUILT.md
View File

@ -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

137
lib/x86.ml
View File

@ -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

53
test/programs/dev-halfwrite.flan Normal file
View File

@ -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)

177
test/programs/half-write.flan Normal file
View File

@ -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)

24
test/test_acceptance.ml
View File

@ -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

122
test/test_dev.ml
View File

@ -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.