From 6197b32b507b6e66baea1a15c8306df807466352 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 18 Sep 2026 07:31:25 +0700 Subject: [PATCH 1/5] A program that prints is not a program that stopped polling The merged build's stdout is a 64K pipe back into the daemon's own process, and the accept loop is the only thing reading it -- which it is not doing while serve is answering a request. The two five-second waits for a frame boundary now drain the pipe on every tick, so a program stopped inside fwrite is one the daemon lets go rather than one it waits out and then accuses of not calling agent/poll. drain and not take: the text stays in the buffer until with_output puts it on the reply, which is where the output an evaluation caused belongs. And the drain sits beside the sleep rather than inside the select, because a readable pipe would make the tick free and count the timeout out in a fraction of it. dev-chatty.flan prints 4K a frame, which is the only fixture here that fills the pipe at all; without the drain it fails in 5.1s with the old sentence. --- lib/dev.ml | 47 +++++++++++++++++- test/programs/dev-chatty.flan | 41 ++++++++++++++++ test/test_dev.ml | 91 +++++++++++++++++++++++++++++++++++ 3 files changed, 178 insertions(+), 1 deletion(-) create mode 100644 test/programs/dev-chatty.flan diff --git a/lib/dev.ml b/lib/dev.ml index c671d76..b13b8e1 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -57,7 +57,14 @@ type t = { (* The program's stdout is a pipe into this process, so that an editor can see it. That makes draining it a *liveness* requirement and not a nicety: a pipe nobody reads fills at 64K and the next write blocks the program forever. So - it is read from the accept loop's select, not only when someone asks. *) + it is read from the accept loop's select, not only when someone asks. + + The accept loop is not enough on its own, and that is the other half of the + same requirement: it is not running while [serve] is handling a request, and + two of the things [serve] does are five-second waits for the game thread to + reach a frame boundary. A thread blocked in [fwrite] reaches none. So + [drain] is called from those waits as well — see [eval_expr], which carries + the argument. *) let capacity = 256 * 1024 let drain t = @@ -657,6 +664,35 @@ let eval_expr t ~code ~origin ~pause = pause && (match state t with Stopped "Pause" -> true | _ -> false) in let rec wait ms = + (* The pipe is drained on every tick, and that is what makes this + a wait rather than a deadlock. + + In the merged build fd 1 is a 64K pipe back into this process, + and its only other reader is the select in [accept_loop] — + which is not running, because it is further up this very call + stack, inside [serve]. A program that prints as it goes (and a + game loop prints as it goes; sand.flan does) fills those 64K + while the module below was being built, and the game thread is + then stopped inside [flan_write_stdout], in an [fwrite] that + will not return until somebody reads. It never reaches the + frame boundary the thunk needs. Five seconds later this + answered "is it calling (agent/poll)?" — a true sentence about + a program that is calling it and cannot get there, which is the + worst kind of diagnostic there is. + + [drain] and not [take]: the text belongs in [t.out] until + [with_output] puts it on this reply on the way out of [serve]. + Taking it here would empty the buffer into nothing and lose + exactly the output the evaluation itself caused. + + And the drain goes *beside* the sleep rather than into it. + Putting [t.stdout] in the select's read set is the obvious + shape and is wrong: a readable pipe returns from select + immediately, so a tick stops costing 5ms and [ms - 5] counts + the whole five seconds out in a fraction of one — the same + wrong sentence, arrived at faster. The timeout is a clock, so + the sleep has to stay a sleep. *) + drain t; match result t with | Some (g, v) when Int64.compare g before > 0 -> `Value v | _ when stopped () -> `Stopped @@ -1023,6 +1059,15 @@ let run_render_thunk t ~tag ~(c : Session.change) : (string, string) result = Error ("cannot reach the program: " ^ Unix.error_message e) | "ok" -> let rec wait ms = + (* Drained every tick for the reason [eval_expr]'s own wait spells + out: this loop is inside [serve], so the accept loop's select is + not reading the program's pipe, and a program that has filled it is + a program stopped in [fwrite] rather than one that is ignoring + [agent/poll]. A render thunk is asked for while the program is + *stopped* at a break, which is the state in which the last thing + printed matters most — so losing it to [take] would be worse here + than anywhere. *) + drain t; match result t with | Some (g, v) when Int64.compare g before > 0 -> Some v | _ when ms <= 0 -> None diff --git a/test/programs/dev-chatty.flan b/test/programs/dev-chatty.flan new file mode 100644 index 0000000..d82764c --- /dev/null +++ b/test/programs/dev-chatty.flan @@ -0,0 +1,41 @@ +;;;; A program that prints far more than a pipe holds, for the one failure a +;;;; quiet fixture cannot reach. +;;;; +;;;; In a merged `flan dev' the program's stdout is a 64K pipe back into the +;;;; same process, and the only thing reading it is the daemon's accept loop — +;;;; which is not running while the daemon is answering a request. Every other +;;;; fixture here prints a line or two per frame, so the pipe never fills and +;;;; the arrangement looks sound. This one prints 4K per frame, which fills 64K +;;;; in sixteen frames: less time than a module takes to build. By the time an +;;;; evaluation is delivered the game thread is stopped inside fwrite, and it +;;;; stays there until somebody reads — so a daemon that waits for a frame +;;;; boundary without draining waits for one that cannot arrive, and then says +;;;; the program is not calling (agent/poll). +;;;; +;;;; It is calling it. See lib/dev.ml's [eval_expr], which drains every tick. +(import agent "vendor:agent") + +;;; Counted so that an evaluation has something of the program's own to read, +;;; and so a transcript can be checked for progress rather than only for text. +(defvar frames i64) + +(defn chatter [] i64 + ;; Sixty-four lines of sixty-three characters and a newline: 4096 bytes a + ;; frame, written through the line buffer flan_rt.c asks for, so each line + ;; is its own write and the block happens in the middle of a frame rather + ;; than at a flush somewhere else. + (dotimes [i 64] + (println "...............................................................")) + (set frames (+ frames 1)) + frames) + +(defn main [] i32 + (agent/start "/tmp/flan-dev-chatty-fallback.sock") + ;; 24000 for dev-repl.flan's reason: the test closes the connection when it + ;; is done and the daemon takes the program with it, so the count only has + ;; to outlast the checks. A program that reached its last frame mid-test + ;; would fail honestly and for the wrong reason. + (dotimes [i 24000] + (chatter) + (agent/wait 1)) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index 32c67df..6416766 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -2293,6 +2293,97 @@ let () = end; List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ ssock; sout ]; + (* ── A program that prints more than the pipe holds ─────────────── *) + + (* The one thing every other fixture in this file is too quiet to reach. + + In a merged build the program's stdout is a 64K pipe back into the + daemon's own process, and the only reader is the select in + [Dev.accept_loop] — which is not running while [serve] is answering a + request. [programs/dev-chatty.flan] prints 4K a frame, so those 64K are + full within sixteen frames, which is far less than a module takes to + build. The game thread is then stopped inside [fwrite] and reaches no + frame boundary at all; the thunk this evaluation delivers has nowhere to + run. + + What that used to produce was five seconds of polling and then "the + program did not reach a frame boundary; is it calling (agent/poll)?" — + about a program whose every frame calls it. A diagnostic that names the + wrong cause is worse than none, because it is believed. + + Three claims, and the third is not decoration. The value comes back, so + the thunk ran. The reply is not the frame-boundary sentence, so the + timeout is not being reached by some other route. And the program's text + rides on the reply as [:output] — which is the claim that the drain went + through [Dev.drain] and not [Dev.take]: a wait that took the buffer and + threw it away would satisfy the first two and silently delete the output + the evaluation itself caused, which is the output anyone wants to see. *) + let csock = tmp "chatty.sock" and cout = tmp "chatty.out" in + (try Sys.remove csock with Sys_error _ -> ()); + let cfd = Unix.openfile cout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let cpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-chatty.flan"; "-s"; csock |] + Unix.stdin cfd Unix.stderr + in + Unix.close cfd; + if not (listening ~pid:cpid csock) then begin + fail "the chatty daemon %s" !listen_why; + (try Unix.kill cpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect csock in + (* Long enough for the program to have run the sixteen frames that fill + the pipe before anything is asked of the daemon. It prints at 4K a + frame with a 1ms wait between them, so this is an order of magnitude + more than it needs — the point is only that the pipe is full when the + request lands, not how full. *) + ignore (Unix.select [] [] [] 0.3); + let started = Unix.gettimeofday () in + let r = + request c "(:op \"eval-expr\" :code \"(+ 20 22)\" :file \"/tmp/chatty.flan\")" + in + let took = Unix.gettimeofday () -. started in + let said = Option.value ~default:"" (Wire.string_field r "message") in + if status r <> "ok" then + fail "evaluating against a program that is printing: %s" said + else if Wire.string_field r "value" <> Some "42" then + fail "the value from a printing program is %s" + (Option.value ~default:"none" (Wire.string_field r "value")); + if contains_sub said "agent/poll" then + fail + "a printing program was diagnosed as one that is not polling, which \ + is the defect and not the symptom"; + (* The wait is five seconds, so anything near it is the timeout being + reached rather than a slow machine. Two is the compromise: a cold + [llc] under dune's own parallelism is comfortably inside it, and a + run that blocked is comfortably outside. *) + if took > 2.0 then + fail "evaluating against a printing program took %.1fs" took; + (* And the program's own text came back on the reply rather than being + drained into nothing. *) + (match Wire.string_field r "output" with + | Some o when contains_sub o "......" -> () + | Some _ -> fail "the reply carried output, but not the program's" + | None -> + fail + "the evaluation drained the program's pipe and kept none of it, so \ + the output it caused is gone"); + ignore (request c "(:op \"close\")"); + (try Unix.close c with Unix.Unix_error _ -> ()); + if not + (await ~ms:5000 (fun () -> + match Unix.waitpid [ Unix.WNOHANG ] cpid with + | 0, _ -> false + | _ -> true + | exception Unix.Unix_error _ -> true)) + then begin + (try Unix.kill cpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] cpid) with Unix.Unix_error _ -> ()) + end + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ csock; cout ]; + (* --debug, and the half the IR cannot show. [test_session.ml] asserts that a debug session *emits* the metadata, From c1ccc318f7ebbb187ea1f096e860ced348d86eb6 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 18 Sep 2026 07:33:39 +0700 Subject: [PATCH 2/5] The park says the program is over before it waits for a reader Closing the window of a printing program left the pipe full, and the flushes on the way out blocked on a compiler thread that was busy answering the very request asking to run it again. program_state still said RUNNING, so rerun refused a finished program as "the program is already running". Two flushes moved. flan_exit no longer flushes before the hook -- exit(3) flushes for itself, so that call only ever ran on the merged path, and there it was the first thing to block. flan_merged_park flips the state under the lock first and flushes after, because a state flip is two stores and cannot wait on anything. What widens is the window in which the program is parked and not yet on the condvar. Nothing is lost there: program_asked is the fact and a signal delivered to nobody is discarded. Two re-runs in that window are both answered ok for one run, which is the trade against a refusal that was false. --- lib/dev.ml | 46 ++++++++++++++++++++++++++++++++++++++-------- runtime/flan_rt.c | 14 ++++++++++++-- 2 files changed, 50 insertions(+), 10 deletions(-) diff --git a/lib/dev.ml b/lib/dev.ml index b13b8e1..d920262 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -3040,9 +3040,13 @@ static jmp_buf program_return; /* main()'s frame, from anywhere */ * instant after closing it (POSIX hands out the lowest free descriptor, so the * compiler thread's next socket would have become this process's stdout, and * the next llc would have inherited it) goes away with the close that caused - * it: fd 1 is never free. */ + * it: fd 1 is never free. + * + * Nothing is flushed here either, and that is the same decision the park makes + * one function down: a flush of a pipe nobody is reading is an unbounded wait, + * and every line of it would be a line the compiler spends still believing the + * program is running. [flan_merged_park] flushes once it has said otherwise. */ static void flan_merged_exit(int32_t status) { - fflush(NULL); program_status = status; longjmp(program_return, 1); } @@ -3055,10 +3059,35 @@ static void flan_merged_exit(int32_t status) { * * [while], not [if]: a condition variable may wake a waiter that nobody * signalled, and [program_asked] is the fact — the wakeup is only a hint that - * it is worth looking again. */ + * it is worth looking again. + * + * THE STATE IS FLIPPED BEFORE ANYTHING IS FLUSHED, and the order is the whole + * of a fix. stdout is a 64K pipe into this process, drained by the compiler + * thread, which stops draining for as long as it is answering a request. A + * program that printed as it ran leaves that pipe full when it finishes, so + * the flush below can wait for a reader that is busy — and every moment it + * waits is a moment [flan_merged_program_state] still answers RUNNING about a + * program that is over. Close a window, press the key that runs it again, and + * the answer was "the program is already running": the request itself was what + * kept the reader from draining. The state flip is two stores under a lock and + * cannot block on anything, so it goes first and the truth is available + * immediately; the flush and the notice follow, and they are courtesies. + * + * What that widens is the window in which the program is PARKED and not yet + * waiting. Nothing is lost in it: [flan_merged_rerun] sets [program_asked] and + * signals under the same lock, a signal delivered to nobody is discarded, and + * the [while] below reads the flag rather than the wakeup — so a request that + * lands in the window is taken and the wait falls straight through. The one + * 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. */ static void flan_merged_park(void) { flan_condition_stacks_reset(); if (flan_dev_frames_reset) flan_dev_frames_reset(); + pthread_mutex_lock(&program_lock); + program_state = PROGRAM_PARKED; + pthread_mutex_unlock(&program_lock); fflush(NULL); fprintf(stderr, "flan dev: the program finished with %d; the process is parked and " @@ -3066,7 +3095,6 @@ static void flan_merged_park(void) { (int)program_status); fflush(stderr); pthread_mutex_lock(&program_lock); - program_state = PROGRAM_PARKED; while (!program_asked) pthread_cond_wait(&program_wake, &program_lock); program_asked = 0; program_state = PROGRAM_RUNNING; @@ -3081,10 +3109,12 @@ static void flan_merged_park(void) { * * [flan_merged_rerun] refuses a program that is already running rather than * remembering the request, and that refusal is the only one there can be: the - * test and the signal are under the same lock, so a request that arrives in - * the microsecond between the finished run's longjmp and the park is either - * seen as running (refused, and the program parks a moment later) or seen as - * parked (taken). Queueing it instead would mean a second main starting the + * test and the signal are under the same lock, so a request that arrives + * between the finished run's longjmp and the park is either seen as running + * (refused, and the program parks a moment later) or seen as parked (taken). + * The park flips the state before it flushes, so the second is now the usual + * answer rather than the lucky one, and what that widens is written out + * there. Queueing it instead would mean a second main starting the * instant the first finished, which is never what somebody pressing a key * meant. */ int flan_merged_rerun(void) { diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 3105bad..60e274b 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -199,11 +199,21 @@ void flan_write_stdout(const uint8_t *p, int64_t n) { * That is fine when the program is its own process and wrong when the compiler * is in the same one — [exit] would take the session down with the program. * The merged entry point installs a hook that flushes, tells the compiler the - * program is done, and parks instead. See lib/dev.ml. */ + * program is done, and parks instead. See lib/dev.ml. + * + * There is no fflush before the hook, and its absence is the fix to a hang + * rather than a saving. [exit] flushes every stream itself, so the call was + * doing nothing at all for a program that is its own process; the only path it + * ever ran on was the hook's. And on that path stdout is a 64K pipe into the + * compiler thread, which is not reading it while it is answering a request — + * so this flush was the first thing to block when a printing program finished, + * and it blocked *before* the hook could say the program had. The compiler + * then answered "the program is already running" to the one key the person + * had just pressed to run it again. The hook flushes after it has said so; + * see flan_merged_park in lib/dev.ml, which carries the rest of the argument. */ void (*flan_exit_hook)(int32_t status) = 0; void flan_exit(int32_t status) { - fflush(stdout); if (flan_exit_hook) flan_exit_hook(status); /* does not return */ exit((int)status); } From 0c0eadb4243c5442afcbb57ef300d38294958299 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 18 Sep 2026 07:35:56 +0700 Subject: [PATCH 3/5] A trap dies where it stands, and does not wait for a reader first rt_die began with fflush(stdout) and ended with exit(134), and under a merged flan dev both could hang. The flush waits on a 64K pipe whose reader is busy; exit runs the atexit chain and the ELF destructors, which want the loader lock a dlopening listener thread may be holding, and in that build the chain also holds OCaml's shutdown. A bounds failure that hangs is worse than one that kills the process, because nothing is printed and nothing exits. So the flush every trap does first goes through rt_flush_out, which puts fd 1 into non-blocking mode and accepts a truncated tail, and rt_die takes _exit and unlinks FLAN_DEV_SOCK by hand -- the same shape as die_now in flan_agent.c, which argued all of this first and is quoted rather than diverged from. On a terminal, a file, or a pipe with room, O_NONBLOCK changes nothing, and the acceptance corpus diffs that output. One consequence worth knowing: _exit skips ASan's exit-time leak report, so a trapping program under @sanitize no longer reports leaks. --- lib/dev.ml | 12 ++++-- runtime/flan_rt.c | 93 +++++++++++++++++++++++++++++++++++++---------- 2 files changed, 83 insertions(+), 22 deletions(-) diff --git a/lib/dev.ml b/lib/dev.ml index d920262..addaabe 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -3146,9 +3146,15 @@ int flan_merged_program_state(void) { * message has already sent two investigations in this repository to the wrong * place. Gone is the honest state, and the client already has words for it. * - * [atexit] covers exit(3), which is what flan_rt.c's rt_die uses. _exit and - * abort skip it by design, so the places that take those routes unlink for - * themselves; see die_now in flan_agent.c. */ + * [atexit] covers exit(3), which is the compiler thread's own way out and the + * way out of a program that somehow returns from main. It does NOT cover the + * two places a program dies where it stands: rt_die in flan_rt.c and die_now + * in flan_agent.c both take _exit, because the atexit chain and the ELF + * destructors want the loader lock a dlopening listener thread may be holding + * — and in this build that chain also holds OCaml's shutdown. Both of them + * therefore unlink this path by hand, which is why this function's body is + * written out three times in the tree rather than shared: it is four lines, and + * the alternative is a runtime that has to link against the daemon. */ static void flan_merged_unlink_sock(void) { const char *s = getenv("FLAN_DEV_SOCK"); if (s != NULL && *s != '\0') unlink(s); diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 60e274b..a1190f5 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -158,8 +158,11 @@ void flan_rt_init(int32_t argc, char **argv) { } /* Defined below with the rest of the non-local exits, and forward-declared - * here because the argument vector is built long before them. */ + * here because the argument vector is built long before them. [rt_flush_out] + * is the flush every one of those paths does first; its own note says why it + * is not [fflush(stdout)]. */ static _Noreturn void rt_die(void); +static void rt_flush_out(void); /* The one malloc in this file that is not an allocator's, because the argument * vector belongs to the process rather than to any region a Flan program named. @@ -172,7 +175,7 @@ void flan_argv(flan_slice *out) { if (rt_args == NULL && rt_argc > 0) { rt_args = (flan_slice *)malloc(sizeof(flan_slice) * (size_t)rt_argc); if (rt_args == NULL) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "flan: out of memory building the argument vector for %d " "arguments\n", @@ -391,15 +394,67 @@ void flan_escape_bytes(const uint8_t *p, int64_t n, flan_slice *out) { * redirected stdout is not, so without this the error appears above the output * that led to it. */ +#include +#include + +/* That flush, made incapable of waiting. + * + * Under a merged `flan dev' stdout is a 64K pipe into the compiler thread, + * which is not reading it while it is answering a request. A trap taken by a + * program that had filled that pipe therefore began by blocking in the flush + * meant to order its own last words — and a bounds failure that hangs instead + * of dying is the worst shape a trap can take, because the person watching has + * no message and no exit status and no reason to think anything happened. + * + * So fd 1 is put into non-blocking mode first and the flush is best-effort. + * What that costs is a truncated tail: whatever no longer fits in the pipe is + * dropped rather than waited for. What it buys is that the trap always reaches + * its message and its exit. On a terminal, a file, or a pipe with room — + * which is every run that is not this one pathological case — O_NONBLOCK + * changes nothing at all, and the acceptance corpus diffs this output. + * + * The return value is ignored deliberately, twice over: a failed fcntl leaves + * the old blocking behaviour, which is what this code did before, and a flush + * that reports EAGAIN has done as much as it is going to. There is nothing a + * dying process can do about either. */ +static void rt_flush_out(void) { + int flags = fcntl(1, F_GETFL, 0); + if (flags >= 0) (void)fcntl(1, F_SETFL, flags | O_NONBLOCK); + (void)fflush(stdout); +} + +/* [_exit] and not [exit], for the reason die_now gives in + * vendor/agent/flan_agent.c and gives at length: this runs on the game thread, + * the dev agent's listener thread may be inside [dlopen] holding the loader + * lock, and [exit] runs the atexit chain and the ELF destructors, which want + * that same lock. In a merged build that chain also holds OCaml's shutdown, + * and it would be run from a thread that is not OCaml's. A trap that deadlocks + * in the runtime's teardown is the same failure as a trap that hangs on a full + * pipe, reached a few instructions later. + * + * What [_exit] skips is the atexit handler that removes the editor's socket — + * so, exactly as die_now does, this removes it by hand. A socket file left on + * disk with nothing accepting on it answers the next client with + * ECONNREFUSED, which reads like a daemon that is there and refusing rather + * than one that died; that message has already sent two investigations in this + * repository to the wrong place. FLAN_DEV_SOCK is unset in an ordinary run and + * then this does nothing. + * + * The two functions are kept saying the same thing on purpose. They are the + * two ways a Flan program dies where it stands, and a difference between them + * would be a difference nobody could predict from the outside. */ static _Noreturn void rt_die(void) { - fflush(stdout); + const char *sock; + rt_flush_out(); fflush(stderr); - exit(134); + sock = getenv("FLAN_DEV_SOCK"); + if (sock != NULL && *sock != '\0') unlink(sock); + _exit(134); } _Noreturn void flan_bounds_fail(const uint8_t *loc, int64_t loclen, int64_t idx, int64_t len) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: index %lld is out of bounds for length %lld\n", (int)loclen, (const char *)loc, (long long)idx, (long long)len); rt_die(); @@ -458,7 +513,7 @@ void flan_error(uint32_t type_id, void *condition, void *xfer, flan_break_hook(name, namelen, condition, xfer); if (*(void **)xfer != NULL) return; } - fflush(stdout); + rt_flush_out(); fprintf(stderr, "unhandled %.*s\n", (int)namelen, (const char *)name); rt_die(); } @@ -468,7 +523,7 @@ void flan_error(uint32_t type_id, void *condition, void *xfer, * there is nowhere to resume, so there is nothing else to do. */ _Noreturn void flan_restart_fail(const uint8_t *loc, int64_t loclen, const uint8_t *name, int64_t namelen) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: no restart named %.*s is active\n", (int)loclen, (const char *)loc, (int)namelen, (const char *)name); rt_die(); @@ -483,7 +538,7 @@ _Noreturn void flan_restart_args_fail(const uint8_t *loc, int64_t loclen, const uint8_t *name, int64_t namelen, const uint8_t *want, int64_t wantlen, const uint8_t *got, int64_t gotlen) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: restart %.*s takes %.*s, given %.*s\n", (int)loclen, (const char *)loc, (int)namelen, (const char *)name, (int)wantlen, (const char *)want, (int)gotlen, (const char *)got); @@ -498,7 +553,7 @@ _Noreturn void flan_restart_args_fail(const uint8_t *loc, int64_t loclen, _Noreturn void flan_restart_unarmed(const uint8_t *loc, int64_t loclen, const uint8_t *name, int64_t namelen, const uint8_t *want, int64_t wantlen) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: restart %.*s takes %.*s, and whatever took it supplied no " "arguments — a restart with parameters cannot be taken from the " @@ -514,7 +569,7 @@ _Noreturn void flan_restart_unarmed(const uint8_t *loc, int64_t loclen, * lexical case is refused by the checker; this is the one that reaches a * function through a call, where nothing static could see it. */ _Noreturn void flan_transfer_fail(const uint8_t *loc, int64_t loclen) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: a defer invoked a restart, which a defer may not do — it is " "the cleanup a transfer runs on its way out\n", @@ -524,7 +579,7 @@ _Noreturn void flan_transfer_fail(const uint8_t *loc, int64_t loclen) { _Noreturn void flan_slice_fail(const uint8_t *loc, int64_t loclen, int64_t lo, int64_t hi, int64_t len) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: slice [%lld %lld) is out of bounds for length %lld\n", (int)loclen, (const char *)loc, (long long)lo, (long long)hi, (long long)len); @@ -632,7 +687,7 @@ void flan_slice_error(const uint8_t *loc, int64_t loclen, int64_t lo, * testing high <= length would wave the failure through. */ _Noreturn void flan_slice_promise_fail(const uint8_t *loc, int64_t loclen, int64_t n) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: slice-from-ptr was promised %lld elements behind the pointer, " "and a count of elements is never negative\n", @@ -706,7 +761,7 @@ static const uint8_t flan_arith_name[] = "ArithError"; * formatting is the unhandled path's job, and this is the unhandled path. */ static void flan_arith_fail(const uint8_t *loc, int64_t loclen, int32_t op, int64_t lhs, int64_t rhs) { - fflush(stdout); + rt_flush_out(); switch (op) { case FLAN_ARITH_DIV_ZERO: fprintf(stderr, "%.*s: divide by zero: (/ %lld 0)\n", (int)loclen, @@ -1206,7 +1261,7 @@ void flan_alloc_free_all(flan_allocator *a, const uint8_t *loc, int64_t loclen) } _Noreturn void flan_null_alloc_fail(const uint8_t *loc, int64_t loclen) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: this allocator is null — a zeroed Allocator was never given " "one\n", @@ -1215,7 +1270,7 @@ _Noreturn void flan_null_alloc_fail(const uint8_t *loc, int64_t loclen) { } _Noreturn void flan_free_all_fail(const uint8_t *loc, int64_t loclen) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: this allocator does not offer free-all — it has no region to " "release, and releasing nothing is not the same as releasing " @@ -1271,7 +1326,7 @@ void flan_alloc_region_only(flan_allocator *a, const uint8_t *loc, } _Noreturn void flan_region_only_fail(const uint8_t *loc, int64_t loclen) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: this container's elements own storage, and this allocator can " "free one block — so a free here would release the slots and leak " @@ -1349,7 +1404,7 @@ int64_t flan_alloc_id(flan_allocator *a) { return (int64_t)(intptr_t)a; } _Noreturn void flan_vec_stale_fail(const uint8_t *loc, int64_t loclen, int64_t was, int64_t now) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: this container's allocator was released — it was made at " "epoch %lld and the allocator is at %lld now\n", @@ -1359,7 +1414,7 @@ _Noreturn void flan_vec_stale_fail(const uint8_t *loc, int64_t loclen, _Noreturn void flan_vec_bounds_fail(const uint8_t *loc, int64_t loclen, int64_t i, int64_t len) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%.*s: index %lld is out of bounds for length %lld\n", (int)loclen, (const char *)loc, (long long)i, (long long)len); rt_die(); @@ -2852,7 +2907,7 @@ int64_t flan_file_fail_reason(void) { return flan_file_fail; } * so this traps naming the declare-c that was called, the way an out-of-bounds * index traps naming its site. See lib/shim.ml, which emits the call. */ _Noreturn void flan_shim_nul_fail(const char *site) { - fflush(stdout); + rt_flush_out(); fprintf(stderr, "%s: a string passed to C contains a NUL byte — C reads to the " "first one, so the value this function would act on is a prefix of " From 95058502f5a5d87773592305330426327f6c7386 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 18 Sep 2026 07:40:55 +0700 Subject: [PATCH 4/5] The timing check only has to sit under the timeout Two seconds was measured on one warm machine and has no margin against the 6.8s cold build listening already records. The status and the absence of the frame-boundary sentence are what discriminate; this bound exists only so a timeout cannot be read as an answer, so it moves to 4.5 and says so. --- test/test_dev.ml | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/test/test_dev.ml b/test/test_dev.ml index 6416766..f9f9117 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -2354,11 +2354,16 @@ let () = fail "a printing program was diagnosed as one that is not polling, which \ is the defect and not the symptom"; - (* The wait is five seconds, so anything near it is the timeout being - reached rather than a slow machine. Two is the compromise: a cold - [llc] under dune's own parallelism is comfortably inside it, and a - run that blocked is comfortably outside. *) - if took > 2.0 then + (* The only job this number has is to sit under the daemon's own + five-second wait, so that "it answered" and "it gave up" cannot be + confused. It is not a measurement of how fast a module builds, and it + is deliberately not tightened into one: [listening] above records 6.8s + for a cold build under dune's parallelism, and a suite that goes red + on a loaded machine teaches whoever is running it to skim past red. + The two assertions that actually discriminate are the status and the + absence of the frame-boundary sentence; this one only rules out a + timeout that somehow reported success. *) + if took > 4.5 then fail "evaluating against a printing program took %.1fs" took; (* And the program's own text came back on the reply rather than being drained into nothing. *) From 8e5fcf54cc513993939282005cd5d1d62cedf4eb Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 18 Sep 2026 08:00:57 +0700 Subject: [PATCH 5/5] The two sweeps do not race a printing fixture against a clock dev-chatty.flan outlives the surveys' twenty seconds by design, and unlike dev-repl it prints while it does -- so the two backends stop at different lines and the diff reports on scheduling rather than on lowering. It joins dev-loop and dev-watch in the excluded-by-name list in both sweeps, with the distinction written down. rt_flush_out is guarded on __wasm__: the pipe it is careful about belongs to a merged flan dev, which is only ever a native host, and wasm32 need not answer for a descriptor mode its runtime may model differently. And three comments that went false with the _exit: the atexit registration in the merged entry point is no longer there for rt_die, which unlinks the socket for itself now, so both places that said so say what it is actually left covering. --- lib/dev.ml | 28 ++++++++++++++++------------ runtime/flan_rt.c | 16 +++++++++++++++- spike/js/survey.sh | 8 +++++--- spike/x86/survey.sh | 13 +++++++++++-- 4 files changed, 47 insertions(+), 18 deletions(-) diff --git a/lib/dev.ml b/lib/dev.ml index addaabe..21ebc54 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -3146,15 +3146,19 @@ int flan_merged_program_state(void) { * message has already sent two investigations in this repository to the wrong * place. Gone is the honest state, and the client already has words for it. * - * [atexit] covers exit(3), which is the compiler thread's own way out and the - * way out of a program that somehow returns from main. It does NOT cover the - * two places a program dies where it stands: rt_die in flan_rt.c and die_now - * in flan_agent.c both take _exit, because the atexit chain and the ELF - * destructors want the loader lock a dlopening listener thread may be holding - * — and in this build that chain also holds OCaml's shutdown. Both of them - * therefore unlink this path by hand, which is why this function's body is - * written out three times in the tree rather than shared: it is four lines, and - * the alternative is a runtime that has to link against the daemon. */ + * [atexit] covers exit(3), and what is left taking exit(3) here is narrower + * than it was: the two places a program dies where it stands — rt_die in + * flan_rt.c and die_now in flan_agent.c — both take _exit, because the atexit + * chain and the ELF destructors want the loader lock a dlopening listener + * thread may be holding, and in this build that chain also holds OCaml's + * shutdown. Both therefore unlink this path by hand, so the same four lines + * exist in three places rather than one — sharing them would mean a runtime + * that links against the daemon, which is a worse trade than the repetition. + * + * What is left for this one is every exit(3) nobody planned — an OCaml fatal + * on the compiler thread most of all, since [Stdlib.exit] ends in the C one. + * Four lines on a path nobody means to take is the right price for a socket + * that never sits on disk refusing connects. */ static void flan_merged_unlink_sock(void) { const char *s = getenv("FLAN_DEV_SOCK"); if (s != NULL && *s != '\0') unlink(s); @@ -3234,9 +3238,9 @@ int main(int argc, char **argv) { * own shutdown to that chain. The hand-written [flan_merged_unlink_sock] that * used to sit under this function's _exit went with it for the same reason — * there is no way out of here any more to unlink on. The [atexit] - * registration above stays, because it is not for this path: it is for - * exit(3), which is what flan_rt.c's rt_die takes, and a merged daemon that - * dies through a trap must not leave a socket refusing connects behind it. */ + * registration above stays, and no longer because of the trap: rt_die takes + * _exit now and unlinks for itself, exactly as die_now does. What is left + * for it is written at [flan_merged_unlink_sock]. */ for (;;) { if (setjmp(program_return) == 0) { rc = flan_program_main(argc, argv); diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index a1190f5..75ac84d 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -394,7 +394,9 @@ void flan_escape_bytes(const uint8_t *p, int64_t n, flan_slice *out) { * redirected stdout is not, so without this the error appears above the output * that led to it. */ +#if !defined(__wasm__) #include +#endif #include /* That flush, made incapable of waiting. @@ -416,12 +418,24 @@ void flan_escape_bytes(const uint8_t *p, int64_t n, flan_slice *out) { * The return value is ignored deliberately, twice over: a failed fcntl leaves * the old blocking behaviour, which is what this code did before, and a flush * that reports EAGAIN has done as much as it is going to. There is nothing a - * dying process can do about either. */ + * dying process can do about either. + * + * Guarded on __wasm__, which this file otherwise does only for the valgrind + * client request below. The hazard is a pipe whose reader is + * the compiler thread of a merged `flan dev', which is a native host and only + * ever a native host — a wasm32 module has no compiler beside it and no such + * pipe. So the guard is not a portability apology: it says where the problem + * can exist, and keeps wasm32 from having to answer for a descriptor mode its + * runtime may model differently. */ +#if defined(__wasm__) +static void rt_flush_out(void) { (void)fflush(stdout); } +#else static void rt_flush_out(void) { int flags = fcntl(1, F_GETFL, 0); if (flags >= 0) (void)fcntl(1, F_SETFL, flags | O_NONBLOCK); (void)fflush(stdout); } +#endif /* [_exit] and not [exit], for the reason die_now gives in * vendor/agent/flan_agent.c and gives at length: this runs on the game thread, diff --git a/spike/js/survey.sh b/spike/js/survey.sh index b1b79b9..646c7fa 100755 --- a/spike/js/survey.sh +++ b/spike/js/survey.sh @@ -59,9 +59,11 @@ fi corpus=${SURVEY_CORPUS:-$root} out=$(mktemp -d); trap 'rm -rf "$out"' EXIT -# The two that run until something stops them, excluded by name for the reason -# the x86 sweep excludes them: a timeout cannot tell them from a hang. -forever="dev-loop dev-watch" +# The ones that run until something stops them, excluded by name for the reason +# the x86 sweep excludes them: a timeout cannot tell them from a hang -- and in +# dev-chatty's case cannot even give the two sides the same truncation, since +# it prints 4K a frame for as long as it is allowed to. +forever="dev-loop dev-watch dev-chatty" TIMEOUT=${TIMEOUT:-20} diff --git a/spike/x86/survey.sh b/spike/x86/survey.sh index d3affb0..9f2a0b8 100755 --- a/spike/x86/survey.sh +++ b/spike/x86/survey.sh @@ -61,10 +61,19 @@ corpus=${SURVEY_CORPUS:-$root} out=$(mktemp -d); trap 'rm -rf "$out"' EXIT -# The two that run until something stops them. Not a failure and not a match; +# The ones that run until something stops them. Not a failure and not a match; # they are excluded by name because a timeout cannot tell them apart from a # backend that hung. -forever="dev-loop dev-watch" +# +# dev-chatty is the third and is here for a sharper reason than the other two. +# It also outlives the timeout -- it is sized to outlast test_dev's checks and +# is killed with the connection -- but what makes it unusable here is that it +# *prints* while it does, 4K a frame. Two backends stopped by a clock stop at +# different lines, so the diff is a report about scheduling rather than about +# lowering, and it fails the alias every run. dev-repl outlives the timeout in +# the same way and is not listed, because it prints nothing and the two +# truncations are both empty. +forever="dev-loop dev-watch dev-chatty" TIMEOUT=${TIMEOUT:-20}