diff --git a/FIX.org b/FIX.org index 04522de..bfb4cdb 100644 --- a/FIX.org +++ b/FIX.org @@ -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. diff --git a/lib/dev.ml b/lib/dev.ml index 09d62b6..77c2816 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -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); diff --git a/lib/dynload_stubs.c b/lib/dynload_stubs.c index 515a53e..cdb9113 100644 --- a/lib/dynload_stubs.c +++ b/lib/dynload_stubs.c @@ -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); diff --git a/lib/program.ml b/lib/program.ml index 1d17c15..b3c59b8 100644 --- a/lib/program.ml +++ b/lib/program.ml @@ -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 diff --git a/test/test_dev.ml b/test/test_dev.ml index 6e27c1d..77dfaf2 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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;