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

Merge: a parked program answers an expression on the thread that is already asleep

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-19 02:18:44 +07:00
commit d5c969d58b
5 changed files with 525 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
FIX.org
View File

@ -192,6 +192,37 @@ than the merged one, and a test pins it.
Re-run on x86 needs the merged daemon to accept --x86 first. Separate work.
** C-x C-e answers against a parked program
The complaint: (+ 1 1) at the top of a buffer was refused with "an expression
is evaluated at a frame boundary, and a parked program reaches none". True, and
about the wrong thing — the expression needs nothing from the program, and the
ones that do need globals the parked process is still holding.
The fix adds a second place a thunk can run rather than loosening what a place
has to be. [flan_merged_park] now waits on two flags: [program_asked] leaves
the park and runs main, and [program_poll] — set by [Program.wake], which
[eval_expr] calls after the delivery — drains the agent's ring and waits again.
The thread stays PROGRAM_PARKED throughout, so [:parked t] rides on the reply
that carries the value.
Why this is safe without a new concurrency model: while parked there is no
concurrency at all. The program's thread is asleep on a condvar, no frame is
executing, no global is being written — which is precisely what a frame
boundary provides. The break loop is the precedent, a thread servicing the same
ring while it is not running frames. Common Lisp answers the same question by
giving evaluation a thread of its own (SWANK's [thread-for-evaluation]) and
documents the resulting race as the programmer's problem; there is no race here
to document.
Merged-build only, and for the reason re-run is: [liveness_of] maps a finished
child to Gone under --two-process, so there is no parked thread to wake.
What became answerable with it: a thunk can now stop in the break loop on the
parked thread, so backtrace, break, restart, restart-at, abort, locals/inspect
and globals stop refusing on the state alone and refuse on [parked_break]
instead — a paused expression against the park would otherwise be unresumable.
Refused still, because their cause is not the park: nothing else.
** The headline complaint is verified fixed on sand.flan
Window opened, closed, the daemon reported parked, (:op "rerun") returned ok,
and xdotool found a live window from the second run.

400
lib/dev.ml
View File

@ -376,13 +376,21 @@ let bound_slots t ~frame =
to say when [alive] was false — is now wrong about the commonest case there
is, somebody closing a window.
[Parked] is not a shade of [Gone] and not a shade of [Live]. Nearly
everything an editor asks needs the program to reach a frame boundary, and a
parked thread reaches none; but the session is whole, the globals are
readable storage, and the next thing the person wants is to run it again.
Answering either of the old two states would send them to the wrong place —
[Gone] to a restart they do not need, [Live] to a five-second wait and "is
it calling (agent/poll)?", which is a true sentence about the wrong cause. *)
[Parked] is not a shade of [Gone] and not a shade of [Live]. The session is
whole, the globals are readable storage, and the next thing the person wants
is usually to run it again. Answering either of the old two states would
send them to the wrong place — [Gone] to a restart they do not need, [Live]
to a five-second wait and "is it calling (agent/poll)?", which is a true
sentence about the wrong cause.
What it is *not* is a state in which nothing can be asked of the program.
That is how it started, and the refusals were written on the assumption that
the only place a thunk could run was the game thread's frame-boundary poll.
The park services the agent's ring now — see [eval_expr] and
[flan_merged_park] — so an expression runs on the parked thread itself,
which is safe for the reason the frame boundary is: while parked there is no
concurrency to be unsafe against. Every op that still refuses [Parked]
refuses it for a reason of its own, and each says which. *)
type liveness =
| Live (* running: the program is between frames *)
| Parked (* finished, and can be run again *)
@ -567,6 +575,24 @@ let parked_msg why =
let parked why = error (parked_msg why)
(* Parked and stopped at the same time, which is a pair of states that could
not both hold until the park learned to run a thunk.
An expression evaluated against a parked program runs on the parked thread,
and a thunk can error or reach a [(pause)] exactly as one run at a frame
boundary can — so the thread is then in the break loop, holding a condition
with restarts on offer, with [liveness] still answering [Parked] because no
run has started. Every op below that refused [Parked] outright would refuse
the break as well, and the restart ops among them are the way out of it: a
thunk nobody can resume is a parked program nobody can evaluate against
twice. So those ops ask this instead of the state alone.
[state t] is the discriminator and is a reliable one. The agent's listener
answers "running" for a parked program with no break engaged — it knows
nothing about runs, only about whether its own break loop is entered — so
[Stopped] here means a break and can mean nothing else. *)
let parked_break t = match state t with Stopped _ -> true | _ -> false
let contains hay needle =
let n = String.length needle and h = String.length hay in
let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
@ -579,11 +605,17 @@ let contains hay needle =
agent/poll", which is the right cause for a program that is running and the
wrong one for a program that has finished. A parked process is not failing
to poll: it has no game thread left to poll with, it is waiting in the park
for somebody to run it again, and nothing drains the ring until then — so
the sixty-fifth module queued since it parked is refused for the very
behaviour [eval] below promises it — that a body redefined while parked
installs when the program is run again. A reader told to check their
[agent/poll] calls would go looking at a loop that is not running.
for somebody to give it something to do — so the sixty-fifth module queued
since it parked is refused for the very behaviour [eval] below promises it,
that a body redefined while parked installs by the time the program runs
again. A reader told to check their [agent/poll] calls would go looking at a
loop that is not running.
The park does drain the ring now, and that does not soften this: it drains
when it is asked to, by an evaluation or by a re-run, and a run of
redefinitions with neither in it fills the ring exactly as before. What
changed is only that there is a second way out, and the sentence names the
one anybody in this position wants.
The agent cannot say this itself. Parking is the merged shim's state and the
agent is vendored beside it knowing nothing about runs; what knows is this
@ -595,17 +627,18 @@ let contains hay needle =
let refusal ~parked reply =
if parked && contains reply "reload queue full" then
"the program refused the module: its reload ring is full, and a parked \
program drains none of it — every module queued since it finished is \
still waiting for a frame boundary, and M-x flan-rerun is what gives them \
one; this one was not taken, so send it again after that run"
program drains it only when it is asked to — every module queued since it \
finished is still waiting, and M-x flan-rerun is what runs them all; this \
one was not taken, so send it again after that run"
else "the program refused the module: " ^ reply
(* [pause], when given, is the position of the form to stop at — §9. It rides
beside the code rather than in it, and the reply echoes it back so an editor
marks the buffer only for a mark the session actually applied.
The one op a parked program accepts, and the reason is the shape of the
verb rather than a favour done to it: this checks, builds and hands the
Accepted by a parked program, and it was for a while the only op that was —
the reason being the shape of the verb rather than a favour done to it: this
checks, builds and hands the
module to the agent, which queues it. It does not wait for anything. The
game thread picks a delivery up at its next frame boundary, and a parked
program's next frame boundary is the first call of its next run — so a body
@ -694,9 +727,11 @@ let eval t ~code ~origin ~pause =
@ (if parked_now then
[ ":note "
^ Wire.quote
"queued; the program is parked, so this installs \
when it is run again rather than at its next frame \
boundary" ]
"queued; the program is parked, so this installs no \
later than its next run rather than at its next \
frame boundary — an expression evaluated in the \
meantime takes it first, because the poll that runs \
a thunk installs whatever is queued ahead of it" ]
else []))
| reply -> refused (refusal ~parked:parked_now reply)
| exception Unix.Unix_error (e, _, _) ->
@ -717,20 +752,43 @@ let eval t ~code ~origin ~pause =
(* Redefining a name installs a body; evaluating an expression has no name to
install into, so the module carries a thunk the agent runs once. The value
comes back through the runtime rather than through this reply, because the
frame boundary it runs at is the program's to choose. *)
frame boundary it runs at is the program's to choose.
── AND A PARKED PROGRAM RUNS ONE TOO ─────────────────────────────────
It did not, and the refusal it gave was the complaint this arm answers:
somebody typed [(+ 1 1)] at the top of a buffer and was told that an
expression is evaluated at a frame boundary and a parked program reaches
none. Every word of that was true and none of it was the point. [(+ 1 1)]
needs nothing from the program at all, and the expression that does — one
reading a global the finished run left — needs storage the parked process is
still holding. What was actually missing was somewhere for the thunk to run,
and the answer was to make a second such place rather than to relax what a
place has to be.
THE PARK IS ONE, and the reason is that a parked process has no concurrency
in it: the program's thread is asleep on a condition variable, no frame is
executing, and nothing is mutating a global. Those are precisely the
conditions a frame boundary provides, which is what the boundary discipline
was ever for — so the park loop services the ring the way it already
services a re-run, on the program's own thread, and the break loop is the
precedent it follows. [Program.wake] is the nudge; [flan_merged_park] is
where it lands.
The state does not move. A thunk is not a run: the program is [Parked]
before, during and after, [:parked t] rides on this very reply, [rerun]
still works, and the globals are as the finished run left them plus whatever
the expression did to them on purpose.
Common Lisp's answer to the same question was not copied and would not have
fitted. SWANK spawns a worker thread per evaluation and SBCL has no parked
state to spawn it beside; the price is that eval races the application and
the race is documented as the programmer's problem. There is no race to
document here, because there is nothing running to race. *)
let eval_expr t ~code ~origin ~pause =
match liveness t with
| Gone -> error gone
(* Unlike [eval], which queues and returns: this waits for the value, and
the thunk that produces it runs at a frame boundary the parked thread
will not reach until somebody asks for a run. Accepting would be five
seconds of polling and then "is it calling (agent/poll)?" — a true
sentence about the wrong cause, which is worse than a refusal. *)
| Parked ->
parked
"an expression is evaluated at a frame boundary, and a parked program \
reaches none"
| Live ->
| Live | Parked ->
(* The same rollback [eval] takes, for the same reason and a smaller
cargo. A thunk is not a declaration and never joins the session, but the
generic instances the expression forced *are* kept — [Session.eval_expr]
@ -749,6 +807,14 @@ let eval_expr t ~code ~origin ~pause =
| _ ->
(match deliver t out with
| "ok" ->
(* Strictly after the delivery, and that ordering is the whole of
it: the sleeper is woken to look at a ring, so waking it before
the module is in one buys an empty poll and a five-second wait.
Nothing here checks whether there was a parked thread to wake —
a running program polls its own ring at the next frame boundary,
and a process whose program is elsewhere has no ring of ours to
drain, so both refusals mean somebody else has it in hand. *)
Program.wake ();
(* Three-way, and the middle case exists only because of [:pause].
A thunk that stopped in the break loop produces no value and
never will until someone resumes it — which is exactly what a
@ -812,12 +878,17 @@ let eval_expr t ~code ~origin ~pause =
| _ when ms <= 0 -> `Timeout
| _ ->
ignore (Unix.select [] [] [] 0.005);
(* [Live], not "not [Gone]": the thunk runs at a frame
boundary, so a program that parked while this was waiting
is a program that will not produce a value, and spinning
out the rest of the five seconds says nothing more than
stopping now does. *)
if liveness t = Live then wait (ms - 5) else `Timeout
(* Not [Gone], where it used to be exactly [Live]. The old test
was right while the park ran nothing: a program that parked
mid-wait would never produce a value, so spinning out the
rest of the five seconds said nothing more than stopping
now did. A park that drains the ring makes it false in both
directions — a thunk delivered to a parked program is
waiting on this very wait, and a run that finishes while a
thunk is in flight parks and then polls it. What is left as
a reason to stop early is the process being gone, which is
the one state no amount of waiting recovers from. *)
if liveness t <> Gone then wait (ms - 5) else `Timeout
in
(match wait 5000 with
| `Value v -> ok [ ":value " ^ Wire.quote v ]
@ -827,20 +898,31 @@ let eval_expr t ~code ~origin ~pause =
puts it there — so the editor already has what it needs, and
the note says which of the two silences this is. *)
| `Stopped -> ok [ ":note " ^ Wire.quote "stopped at (pause)" ]
(* Two sentences, because there are two causes and the running
one is nonsense about a parked program — it is the sentence
this verb's old refusal quoted, which is exactly the thing not
to relocate here. A parked thread is woken for the ring and
nothing else can be holding it up, so what has gone wrong is
the thunk itself: it stopped on something and is sitting in the
break loop waiting to be told what to do. That is a state the
editor can act on, and [:stopped] on this reply names it. *)
| `Timeout ->
error
"the program did not reach a frame boundary; is it calling \
(agent/poll)?")
if liveness t = Parked then
error
"the expression produced no value in five seconds. The \
program is parked, so nothing is competing with it: the \
thunk is most likely stopped on a condition inside the \
break loop, which restart or abort answers"
else
error
"the program did not reach a frame boundary; is it calling \
(agent/poll)?")
(* A module that was taken is the program's from here on, whatever
the wait then says: a timeout is a frame boundary not reached
yet, not a module refused, so the instances in it stay in the
session. Only the two arms below, where nothing was accepted,
put the session back.
No [refusal] either, and that is not an omission: this verb
refuses a parked program before it compiles anything, so the one
reply whose cause that rewrites cannot arrive here. *)
| reply -> refused ("the program refused the module: " ^ reply)
put the session back. *)
| reply -> refused (refusal ~parked:(liveness t = Parked) reply)
| exception Unix.Unix_error (e, _, _) ->
refused ("cannot reach the program: " ^ Unix.error_message e))
| exception Failure m -> refused m)
@ -1079,11 +1161,15 @@ let break t =
parked and no break is engaged, so [status] answers "running" — and
"the program is running" is exactly the wrong thing to tell somebody
whose program has finished. *)
| Parked ->
| Parked when not (parked_break t) ->
parked
"a parked program has not stopped on anything, so there are no restarts \
to offer"
| Live ->
(* And when it has, which is a thunk evaluated against the park that erred or
paused. The restarts are that thunk's and the ones its call reached; the
answer is the same shape and the same walk, because it is the same break
loop on the same thread. *)
| Live | Parked ->
match state t with
| Running -> ok []
| Unreachable m -> error ("cannot ask the program whether it stopped: " ^ m)
@ -1131,11 +1217,16 @@ let backtrace_op t =
pushed are allocas in stack the next run will write over — but answering
with no frames would read as "your program is nowhere", when what is true
is that it is between runs. *)
| Parked ->
| Parked when not (parked_break t) ->
parked
"a backtrace is the frames of a stopped program, and a parked one has \
no frames at all"
| Live ->
(* Unless a thunk it is running stopped, and then the chain is that thunk's:
the park cleared what the finished run pushed, so every frame here is an
eval frame and the listing says so in the third field. That is a shorter
backtrace than a break in a running program gives and it is the whole
truth about where this one is. *)
| Live | Parked ->
match state t with
| Running ->
error
@ -1244,18 +1335,36 @@ let run_render_thunk ?(stopped_only = false) t ~tag ~(c : Session.change)
match resumed () with
| Some why -> Error why
| None ->
(* Two sentences for the same silence, because there are two
causes and each names a different thing to go and look at.
The frame-boundary one is about a game loop that is not
polling; said about a parked program it would be the sentence
this whole verb's parked refusal used to be, which is the one
thing not to say here. A parked thread has nothing competing
with it, so what it is doing is holding a break — the thunk
asked for a stopped stack and the stop has been let go of. *)
let gave_up =
Error
"the program did not reach a frame boundary; is it calling \
(agent/poll)?"
if liveness t = Parked then
Error
"the inspection produced nothing in five seconds. The \
program is parked, so nothing is competing with the thunk: \
the break it was built against has most likely been \
resumed since, and a stopped-only job is dropped rather \
than run against a resumed program"
else
Error
"the program did not reach a frame boundary; is it calling \
(agent/poll)?"
in
if ms <= 0 then gave_up
else begin
ignore (Unix.select [] [] [] 0.005);
(* [Live] for the reason [eval_expr]'s own wait gives: a thunk
needs a frame boundary, and neither a gone program nor a
parked one is going to reach one. *)
if liveness t = Live then wait (ms - 5) else gave_up
(* Not [Gone], for the reason [eval_expr]'s own wait now gives:
a park that services the ring reaches the equivalent of a
frame boundary, and a render job asked for at a break the
park is holding is running in that break's own poll. Gone is
the only state no amount of waiting recovers from. *)
if liveness t <> Gone then wait (ms - 5) else gave_up
end
in
wait 5000
@ -1273,14 +1382,22 @@ let run_render_thunk ?(stopped_only = false) t ~tag ~(c : Session.change)
let stopped_frame t ~frame ~what : (string * Tast.fn, string) result =
match liveness t with
| Gone -> Error gone
| Parked ->
| Parked when not (parked_break t) ->
Error
(parked_msg
(Printf.sprintf
"%s is read from a stopped frame, and a parked program's frames \
went with the run that pushed them"
what))
| Live ->
(* Except where a thunk evaluated against the park stopped, and then there
are frames again and they are worth reading. The thunk's own are refused
below, by name, the way they are at any other break — but a program
function the thunk *called* pushed an ordinary frame with ordinary slots,
and its locals are as readable here as anywhere. Which is the whole
argument for routing this through the same check rather than a second one:
a parked break and a running one differ in how the thread got there, not
in what is on its stack. *)
| Live | Parked ->
match state t with
| Running ->
Error
@ -1700,11 +1817,18 @@ let inspect_addr t ~addr ~want_type =
the trap. Rendering what is at the address means building a thunk and
having the program run it, and a parked program runs nothing; the answer
would be a five-second wait. *)
| Parked ->
| Parked when not (parked_break t) ->
parked
"an address is rendered by a thunk the program runs, and a parked \
program runs nothing"
| Live ->
"whether an address is still live is read from a stopped program, and \
a parked one has not stopped on anything"
(* The thunk this builds is delivered stopped-only, and a park with a
stopped thunk in it satisfies that check exactly as a running program's
break does: the agent asks its own [depth], which the break loop raised,
and knows nothing about runs. So this needs no special case beyond being
allowed through — and it wants one, because the registry outlived the
run and an address out of a leak report from the last run is a thing
somebody has in their hand precisely while the program is parked. *)
| Live | Parked ->
match state t with
| Running ->
error
@ -1932,11 +2056,17 @@ let globals_op t =
here, delivered, and run by the program at a frame boundary, the same as
[locals] and [inspect]; the stack that decides which globals to show went
with the run as well. *)
| Parked ->
| Parked when not (parked_break t) ->
parked
"a globals section is rendered by a thunk the program runs against the \
stopped stack, and a parked program has neither"
| Live ->
"a globals section is the globals a stopped stack reaches, and a parked \
program's stack went with the run that built it"
(* When a thunk evaluated against the park has stopped there is a stack, and
this answers against it. Mostly that is a short section and sometimes an
empty one — a thunk's own frames are eval frames and contribute nothing
but a line in [:skipped] — which is the honest answer rather than a poor
one: what the union is built from is what the stack reaches, and this
stack reaches what the expression called. *)
| Live | Parked ->
match state t with
| Running ->
error
@ -2100,11 +2230,17 @@ let globals_op t =
let choose_at t ~index ~name =
match liveness t with
| Gone -> error gone
| Parked ->
| Parked when not (parked_break t) ->
parked
"a restart is taken on a stopped program's stack, and a parked one has \
no stack to resume into"
| Live ->
(* A thunk evaluated against the park can stop, and then this is not a
convenience but the way out: the thread is in the break loop and stays
there until a restart is taken or an abort ends the process, and a re-run
asked for meanwhile waits on the same resume. Refusing here for the state
rather than for the stack would have made the first paused expression
against a parked program the last thing that session did. *)
| Live | Parked ->
if
match name with
| Some n -> String.exists (fun c -> Char.code c < 32 || Char.code c = 127) n
@ -2130,11 +2266,11 @@ let choose_at t ~index ~name =
let choose t ~name =
match liveness t with
| Gone -> error gone
| Parked ->
| Parked when not (parked_break t) ->
parked
"a restart is taken on a stopped program's stack, and a parked one has \
no stack to resume into"
| Live ->
| Live | Parked ->
if String.exists (fun c -> Char.code c < 32 || Char.code c = 127) name then
(* The agent's contract is one line per request. A name carrying a newline
would be a second request smuggled into the first, and the guarantee is
@ -2163,11 +2299,16 @@ let abort t =
stopped somewhere it cannot continue from; a parked program has already
ended, of its own accord, and the process it would have taken with it is
the session. *)
| Parked ->
| Parked when not (parked_break t) ->
parked
"the program has already finished, so there is nothing to abort and \
nothing that would end by aborting it but this session"
| Live ->
(* The one exception, and it is the same exception the restarts are: a thunk
stopped in the break loop on the parked thread is something to abort, and
for a condition with no restart worth taking it is the only thing that
ends it. What it costs is unchanged and is what the reply has always said
— the process goes, and the session with it. *)
| Live | Parked ->
match ask t "abort" with
| reply when String.trim reply = "ok" ->
ok [ ":note " ^ Wire.quote "the program is exiting; flan dev ends with it" ]
@ -2204,12 +2345,24 @@ let rerun t =
| Live | Parked ->
(match Program.rerun () with
| Ok () ->
ok
[ ":note "
^ Wire.quote
"running main again; the globals are as the last run left \
them, and anything delivered while it was parked installs at \
the first frame boundary" ]
(* Taken is not always started, and the one case where it is not needs
saying rather than a mechanism. A thunk evaluated against the park
can stop in the break loop, and the parked thread is then inside that
loop rather than in the wait that reads this request — so the flag is
set, the park sees it the moment the poll returns, and the run begins
when the break is resumed or aborted. Queueing it is exactly right
here, unlike the running case the C refuses: there is no second main
about to start, only one waiting for the thread to be free. *)
let note =
if liveness t = Parked && parked_break t then
"accepted; an expression evaluated against the park is stopped in \
the break loop, so main starts once that is resumed or aborted"
else
"running main again; the globals are as the last run left them, and \
anything delivered while it was parked installs at the first frame \
boundary"
in
ok [ ":note " ^ Wire.quote note ]
| Error m -> error m)
(* ── Disassembly ───────────────────────────────────────────────────── *)
@ -2441,8 +2594,10 @@ let basis t name =
| Running when liveness t = Parked ->
Printf.sprintf
"%s — the last module delivered for this name, accepted for install; \
the program has finished and is parked, so it installs at the first \
frame boundary of the next run rather than now"
the program has finished and is parked, so it installs no later \
than the first frame boundary of the next run — sooner if an \
expression is evaluated first, since the poll that runs a thunk \
takes everything queued ahead of it"
m
| Running ->
Printf.sprintf
@ -3254,6 +3409,13 @@ extern void (*flan_exit_hook)(int32_t status);
extern void flan_condition_stacks_reset(void);
extern void flan_dev_frames_reset(void) __attribute__((weak));
/* The agent's ring, drained on whatever thread calls this. Weak for the reason
* the reset above is weak, and it is the same class of fact: a merged binary
* links the agent by construction, which is exactly the kind of guarantee that
* stops holding quietly. A build without one parks with no way to service a
* thunk, which is the behaviour this file had before the park learned to. */
extern int32_t flan_agent_poll(void) __attribute__((weak));
/* ── The program's thread, between runs ────────────────────────────── */
/* A Flan main that finishes leaves this thread with nothing to do and the
@ -3291,6 +3453,7 @@ static pthread_mutex_t program_lock = PTHREAD_MUTEX_INITIALIZER;
static pthread_cond_t program_wake = PTHREAD_COND_INITIALIZER;
static int program_state = PROGRAM_RUNNING;
static int program_asked = 0; /* a re-run has been requested */
static int program_poll = 0; /* something is waiting in the ring */
static int32_t program_status; /* what the last run ended with */
static jmp_buf program_return; /* main()'s frame, from anywhere */
@ -3356,7 +3519,41 @@ static void flan_merged_exit(int32_t status) {
* visible cost is that two re-runs arriving in that window are both answered
* "ok" for a single run. That race existed before and was a microsecond wide;
* it is now as wide as a flush, which is the right trade against a refusal
* that was simply false. */
* that was simply false.
*
* ── THE SECOND THING THE PARK SERVICES ───────────────────────────────
*
* A re-run was the only request this wait knew about, and that made the park
* a state in which nothing at all could be asked of the program — so C-x C-e
* on [(+ 1 1)] was refused with a sentence about frame boundaries, for an
* expression that needs nothing from the program, in a process that is holding
* every global the run left. The answer is not a second thread and not a
* looser rule about where a thunk may run. It is that WHILE PARKED THERE IS NO
* CONCURRENCY: this thread is asleep on a condition variable, no frame is
* executing, nothing is mutating a global. Running the agent's ring here is
* therefore exactly as safe as running it at a frame boundary, which is the
* property the frame-boundary discipline exists to buy — and the break loop is
* the precedent, a thread that is not running frames servicing the same ring
* from the same poll.
*
* So the wait has two flags and not one, and the difference between them is
* what the thread does next. [program_asked] leaves the park; [program_poll]
* drains the ring and waits again. The program stays PROGRAM_PARKED across the
* whole of the second — a thunk is not a run, and an editor that saw [:parked
* nil] for the duration of a C-x C-e would show the program as live for a
* moment that has no frames in it.
*
* A re-run is tested first, so a stream of evaluations cannot starve one. The
* poll flag is cleared BEFORE the lock is dropped, which is what makes a
* delivery landing during the poll set it again rather than be swallowed by a
* clear on the way back; the cost is one empty poll, and the alternative is a
* thunk that waits out the five seconds for no reason anyone can see.
*
* And the poll runs with the lock DROPPED, which is not an optimisation. It
* dlopens, it runs Flan code, and that code may error into the break loop and
* stay there until somebody resumes it — all of it while the compiler thread
* is asking [flan_merged_program_state] on every reply it writes. Holding the
* lock across any of that would deadlock the daemon against its own program. */
static void flan_merged_park(void) {
flan_condition_stacks_reset();
if (flan_dev_frames_reset) flan_dev_frames_reset();
@ -3370,7 +3567,20 @@ static void flan_merged_park(void) {
(int)program_status);
fflush(stderr);
pthread_mutex_lock(&program_lock);
while (!program_asked) pthread_cond_wait(&program_wake, &program_lock);
for (;;) {
while (!program_asked && !program_poll)
pthread_cond_wait(&program_wake, &program_lock);
if (program_asked) break;
program_poll = 0;
pthread_mutex_unlock(&program_lock);
if (flan_agent_poll) flan_agent_poll();
/* The thunk's output is the reason anyone evaluated anything, and the
* compiler thread puts it on the reply it is about to write. A run flushes
* at its own pace and the park flushes once on the way in; neither covers
* a thunk that printed after both. */
fflush(NULL);
pthread_mutex_lock(&program_lock);
}
program_asked = 0;
program_state = PROGRAM_RUNNING;
pthread_mutex_unlock(&program_lock);
@ -3405,6 +3615,30 @@ int flan_merged_rerun(void) {
return rc;
}
/* Tell a parked thread that its ring is not empty.
*
* The sibling of [flan_merged_rerun] and deliberately the smaller one: it sets
* the other flag, so the thread wakes, drains the ring and waits again without
* ever leaving the park. Nothing here decides what is in the ring or waits for
* a result — that is the compiler thread's business, and a lock held across
* either would be the one thing the note above [flan_merged_rerun] forbids.
*
* A running program is refused rather than woken, because there is nothing to
* wake: its game thread reaches a frame boundary on its own and polls there.
* The caller treats that as "no wake was needed", not as a failure. */
int flan_merged_wake(void) {
int rc;
pthread_mutex_lock(&program_lock);
if (program_state != PROGRAM_PARKED) rc = 1;
else {
program_poll = 1;
pthread_cond_signal(&program_wake);
rc = 0;
}
pthread_mutex_unlock(&program_lock);
return rc;
}
int flan_merged_program_state(void) {
int s;
pthread_mutex_lock(&program_lock);

11
lib/dynload_stubs.c
View File

@ -191,6 +191,7 @@ extern void flan_agent_request_free(char *p) __attribute__((weak));
* holds for longer than that — releasing and re-acquiring OCaml's lock would
* cost more than the call. */
extern int flan_merged_rerun(void) __attribute__((weak));
extern int flan_merged_wake(void) __attribute__((weak));
extern int flan_merged_program_state(void) __attribute__((weak));
/* 0 running, 1 parked, 2 no program thread in this process. */
@ -207,6 +208,16 @@ CAMLprim value flan_program_rerun(value unit) {
return Val_int(flan_merged_rerun() == 0 ? 0 : 1);
}
/* 0 woken, 1 nothing to wake because the program is running, 2 no program
* thread. The third question the compiler has about that thread, and the one
* that makes a parked program answer a C-x C-e: the module is in the agent's
* ring already, and this is what gets the sleeper to look at it. */
CAMLprim value flan_program_wake(value unit) {
(void)unit;
if (flan_merged_wake == NULL) return Val_int(2);
return Val_int(flan_merged_wake() == 0 ? 0 : 1);
}
CAMLprim value flan_agent_direct(value line) {
CAMLparam1(line);
CAMLlocal2(s, r);

26
lib/program.ml
View File

@ -30,10 +30,36 @@ type state =
external raw_state : unit -> int = "flan_program_state"
external raw_rerun : unit -> int = "flan_program_rerun"
external raw_wake : unit -> int = "flan_program_wake"
let state () =
match raw_state () with 0 -> Running | 1 -> Parked | _ -> Absent
(* Ask a parked thread to drain the agent's ring, and keep it parked.
The second thing a park can service, and the one that makes an expression
evaluable against a finished program. A thunk is already in the ring by the
time this is called — it got there the way every module does — and what was
missing was anybody to pick it up: a parked thread reaches no frame boundary
and there was nothing else to wake it for.
Running it *there* is the whole design, and it is smaller than it sounds.
While parked the process has no concurrency at all — the program's thread is
asleep, no frame is executing, no global is being written — so the ring is
drained under exactly the conditions a frame boundary provides, on the
thread the program's own storage belongs to, with no second stack and no new
rule about where Flan code may run. Common Lisp answers the same question by
giving evaluation a thread of its own and calling the resulting race the
programmer's problem; this needs neither the thread nor the race.
[unit] and not a result, because there is nothing here for a caller to do
about either refusal. A running program polls its own ring at the next frame
boundary and a process with no program thread has no ring to drain; in both
the request has been satisfied by somebody else or was never this end's to
make. What a caller waits on is the value, which comes back the same way it
does from a frame boundary. *)
let wake () = ignore (raw_wake ())
(* Run [main] again, on the thread that ran it before.
The thread is not negotiable and is why there is no [Thread.create] here: a

146
test/test_dev.ml
View File

@ -561,8 +561,129 @@ let () =
else if not (contains_sub refused "parked" && contains_sub refused "flan-rerun")
then fail "a parked backtrace is refused as: %s" refused;
(* [eval] is the one op a parked program takes, because it queues and
waits for nothing: the module sits in the agent's ring until the game
(* ── C-x C-e against the park ─────────────────────────────────── *)
(* The complaint: somebody typed [(+ 1 1)] at the top of a buffer and was
told that an expression is evaluated at a frame boundary and a parked
program reaches none. True, and about the wrong thing — [(+ 1 1)]
needs nothing from the program at all. What it needed was somewhere to
run, and the park is one: the thread is asleep on a condition
variable, no frame is executing and no global is being written, which
is exactly what a frame boundary offers. So the park drains the
agent's ring when it is woken for it, and this is the proof. *)
let r = request c "(:op \"eval-expr\" :code \"(+ 1 1)\" :file \"/tmp/buf.flan\")" in
if Wire.string_field r "value" <> Some "2" then
fail "C-x C-e against a parked program: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"));
(* On this very reply and not on a later [describe]: a thunk is not a
run, so the state the editor reads beside the value has to still be
the parked one. Reading it afterwards would not tell the two apart
from a program that went live and parked again. *)
(match Wire.field r "parked" with
| Some { Form.v = Form.Sym "t"; _ } -> ()
| _ -> fail "an expression against the park reported the program live");
(* And the half that needs the process rather than only the compiler.
[extra] is a global this session introduced and the first run left at
105 — the third reload's [step] does not touch it — so this is the
finished run's storage, read by a thunk the finished run's thread ran.
Nothing is reset between runs and nothing is reset for an evaluation
either. *)
let r = request c "(:op \"eval-expr\" :code \"extra\" :file \"/tmp/buf.flan\")" in
if Wire.string_field r "value" <> Some "105" then
fail "a global the finished run left: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"));
(* What the thunk *printed*, which needs one more thing than the value
does. In the merged build fd 1 is a fully buffered pipe into the
daemon, and a run flushes at its own pace while the park flushes once
on the way in — neither covers a thunk that printed after both, so
without a flush beside the poll this line would sit in the FILE buffer
until the next park, which is to say until after the next run. The
value arriving and the output not is exactly the shape that would go
unnoticed, so it is asked for by name. *)
let before = Buffer.length output in
let r =
request c
"(:op \"eval-expr\" :code \"(do (println \\\"pk\\\") 9)\" :file \"/tmp/buf.flan\")"
in
if Wire.string_field r "value" <> Some "9" then
fail "a printing expression against the park: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"));
if not (contains_sub (Buffer.sub output before (Buffer.length output - before)) "pk")
then fail "a parked thunk's output never reached the daemon";
(* ── And a thunk that stops, on a thread with no run under it ──── *)
(* Parked and stopped at once, which is a pair of states that could not
both hold until this. The thunk runs on the parked thread, so a
[(pause)] in it puts *that* thread in the break loop — and every op
that refused [Parked] outright would have refused the break with it,
including the restart that is the only way out. A first paused
expression against a parked program would have been the last thing
that session could do. *)
let r =
request c
"(:op \"eval-expr\" :code \"(+ 20 3)\" :file \"/tmp/buf.flan\" :pause t)"
in
if Wire.string_field r "condition" <> Some "Pause" then
fail "a paused expression against the park stopped on %s"
(Option.value ~default:(status r) (Wire.string_field r "condition"));
(* Both flags on one reply, which is the state the daemon had no way to
describe before: no run is in progress and the program is nevertheless
stopped on something. *)
(match Wire.field r "parked" with
| Some { Form.v = Form.Sym "t"; _ } -> ()
| _ -> fail "a thunk stopped in the park reported the program live");
(* The frames are the thunk's, and they are there to be walked — the
refusal above was about a park with nothing in it, not about the
state. *)
let r = request c "(:op \"backtrace\")" in
if status r <> "ok" then
fail "a backtrace of a thunk stopped in the park: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"));
(* And the section that walks that stack, which is the one op here whose
answer is *empty* and has to arrive anyway. Every frame a paused thunk
has is an eval frame, so nothing is attributed and everything lands in
[:skipped] — but a render thunk is still built, delivered and run, and
"ok with nothing in it" is a different reply from the five-second
timeout that a job nobody polled would give. That is what this
distinguishes. *)
let r = request c "(:op \"globals\")" in
if status r <> "ok" then
fail "the globals of a thunk stopped in the park: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"));
(* The way out, and the reason the restart ops had to stop refusing the
state: nothing else resumes this, and a re-run asked for meanwhile
would be taken and then wait on the same resume. *)
let r = request c "(:op \"restart\" :name \"continue\")" in
if status r <> "ok" then
fail "continue at a breakpoint inside the park: %s"
(Option.value ~default:"" (Wire.string_field r "message"));
if not (await (fun () ->
match Wire.field (request c "(:op \"describe\")") "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> false
| _ -> true))
then fail "the thunk never resumed from its breakpoint in the park";
(* Still parked, and with nothing of the thunk left behind. A backtrace
is the cheap proof of the second: the chain the park cleared is still
cleared, so the thunk pushed frames and popped them, and the refusal
is the same one it gave before any of this ran. *)
let r = request c "(:op \"backtrace\")" in
let refused = Option.value ~default:(status r) (Wire.string_field r "message") in
if status r <> "error" then
fail "a parked program answered a backtrace after running a thunk"
else if not (contains_sub refused "parked") then
fail "a parked backtrace after a thunk is refused as: %s" refused;
if not (await parked) then
fail "the program did not stay parked across an evaluation";
(* [eval] is the one op a parked program took before this, because it
queues and waits for nothing: the module sits in the ring until the game
thread next reaches a frame boundary, and the next frame boundary a
parked program reaches is in its next run. Having to run the program
before being allowed to fix the thing you closed it over is the loop
@ -577,6 +698,9 @@ let () =
else
(match Wire.string_field r "note" with
| Some n when contains_sub n "parked" -> ()
(* Reworded when the park learned to run a thunk: a poll that runs one
installs everything queued ahead of it, so "when it is run again"
stopped being the whole truth and became an upper bound. *)
| _ ->
fail
"a delivery to a parked program still promised the next frame \
@ -593,8 +717,12 @@ let () =
106 rather than 1, because [extra] is a global of a process that never
died and the second run reads what the first left in it. Nothing is
zeroed between runs, deliberately: a clean slate is one evaluation
away, and cannot be had back once a re-run has wiped something. *)
if not (settle 6) then fail "the program did not run again";
away, and cannot be had back once a re-run has wiped something.
Seven and not six, because [settle] counts every line the daemon has
handed over and the printing expression above contributed one that no
run printed. Six would be satisfied by the first of these two. *)
if not (settle 7) then fail "the program did not run again";
(* And a re-run while it is running is refused rather than queued: two
mains in one process would be writing the same globals at once. *)
@ -623,10 +751,16 @@ let () =
again, from the body the first run ended with, and 106 from the one
delivered while it was parked. 106 and not 1 is the line that says
the globals are the finished run's — the process never died, so
[extra] is where the first run left it. *)
[extra] is where the first run left it.
And [pk] between the two, which is a line no run printed: it is the
thunk evaluated against the park, on the parked thread, flushed there
rather than waiting for a run to flush it. Its position in the
transcript is the claim — after everything the first run printed and
before anything the second did. *)
ignore (Unix.waitpid [] pid);
let text = Buffer.contents output in
let wanted = "1\n5\n105\n777\n777\n106\n" in
let wanted = "1\n5\n105\n777\npk\n777\n106\n" in
if text <> wanted then
fail "program transcript\n got: %S\n wanted: %S" text wanted
end;