diff --git a/docs/BUILT.md b/docs/BUILT.md index 70f538a..3b1cbed 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -1288,6 +1288,8 @@ newlines. An nREPL front end can sit on the same `Session` later; it should not ``` (:op "describe") → (:status "ok" :fns (…) :globals (…) :alive t) +(:op "rerun") → (:status "ok" :note "running main again; …") + → (:status "error" :message "the program is already running; …") (:op "eval" :code "…" :file "/buf.flan") → (:status "ok" :names (…) :fns (…) :ms 19.0) → (:status "error" :message "…" :loc "/buf.flan:1:19") (:op "defs") → (:status "ok" :defs ((name kind signature loc) …)) @@ -1359,8 +1361,52 @@ the arenas" stops being true. A Flan `main` does not return — `Emit` ends it with `flan_exit` and an `unreachable` — so in one process that call would take the compiler down with a program that merely *finished*. `flan_rt.c` has a hook, null in every other build, that -the merged entry point uses to flush, close stdout and park. The compiler learns the program is done the way the daemon -did: the pipe reads EOF. +the merged entry point uses to flush and park. + +#### The program is re-runnable — `rerun` + +The park used to be `for (;;) pause()`, and that was a dead end with the process still standing: you ran a program, it +opened a window, you closed the window, `main` returned, and the only way to get another window was +`flan-dev-restart-program` — a new build, a new session, every global gone. Common Lisp and Clojure do not have that +problem because the image outlives `main` and you call it again. The process here already outlived `main`; nothing +could wake it. + +So `main()` is a loop. The hook records the status and `longjmp`s back into a `setjmp` in `main()` — there is no return +available, since `flan_exit` is reached from wherever the program happened to be — and the thread then waits on a +condition variable. `(:op "rerun")` reaches `flan_merged_rerun` through a weak symbol in `lib/dynload_stubs.c`, the same +way `flan_agent_request` is reached, and signals it. **The main thread is the one that runs `main` again**: a window +belongs to the thread that opened it, and on macOS to the first thread of the process, so running the second `main` +anywhere else would draw nothing. + +A `longjmp` pops no frame, so the park first empties the handler stack, the restart stack and the shadow frame chain +(`flan_condition_stacks_reset`, `flan_dev_frames_reset`). Each was a chain of allocas in stack the next run is about to +write over; a backtrace taken across that would name whatever the new run had put there. + +**Nothing else is reset.** The second run sees the globals exactly as the first left them — that is the CL and Clojure +semantics and it is what was asked for. A clean slate is one evaluation away; a zeroed one cannot be had back. + +**A re-run while the program is running is refused, not queued.** The test and the signal are under one mutex, so the +window between them does not exist, and two `main`s writing the same globals at once never starts. + +`close`ing stdout went with this change, and it had to. That was how the compiler learned the program was done — the +pipe read EOF, exactly as the two-process daemon learns it from a dead child — but a pipe delivers EOF *once*, so the +signal and the program's output were the same resource: spending it left the second run with nowhere to print. The +descriptor hazard that came with it (POSIX hands out the lowest free fd, so the compiler thread's next socket became +this process's stdout, and the next `llc` inherited it) goes away with the close that caused it. Liveness is asked for +instead, through `Program.state`, which is a question with an answer rather than an event with one delivery. + +That makes liveness **three states**, not two. `Dev.liveness` is `Live`, `Parked` or `Gone`, and every guard in +`lib/dev.ml` branches on it *before* consulting `Dev.state` — the agent's listener is alive while the program is parked +and answers `status` with "running", so the old order would have told someone whose program had finished that it was +running. Only `eval` accepts `Parked`: it queues a module and waits for nothing, and the queued module installs at the +first frame boundary of the next run, so a body can be fixed while the program is parked and the re-run executes it. +Everything else needs a frame boundary or a stopped stack, has neither, and says so by name — including `globals`, +whose storage is perfectly readable but whose *renderer* is a thunk the program has to run. + +`:parked` rides on every reply beside `:stopped`, for the same reason `:stopped` does: a program finishes without +announcing it, and the commonest way to finish is somebody closing a window with the mouse. `:alive` keeps its old +meaning — is there still a session — so a parked program is `:alive t :parked t`. In Emacs that is `flan:parked` in the +modeline and `C-c C-M-x` (`flan-rerun`) to get the program back. #### The internal socket is gone — the transport, measured diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index da3335c..8536121 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -15,6 +15,13 @@ ;; The protocol is one s-expression per message, length framed. That is why ;; there is no parser here: `prin1' writes a request and `read' reads a reply. ;; +;; C-c C-M-x runs the program's `main' again without rebuilding anything. A +;; program that finishes no longer ends its process: the main thread parks, +;; holding the compiler, the session and every global the run left, so closing +;; a window costs nothing and getting another one is one key. Nothing is +;; reset between runs — it is what calling (main) at a Common Lisp or Clojure +;; prompt does, and the modeline says `flan:parked' while it waits. +;; ;; C-x C-e evaluates the expression before point *in the running program* and ;; shows its value. That is a different primitive from redefining a name: ;; there is nothing to install a body into, so the expression is wrapped in a @@ -72,6 +79,13 @@ that quietly did nothing, which is why it is on." Set from every reply the daemon sends, which is how a stop that nothing asked about is noticed at all.") +(defvar flan-dev--parked nil + "Non-nil when the program has finished and its process is waiting to re-run. +Set from every reply, as `flan-dev--stopped' is and for the same reason: a +program finishes without announcing it, and the commonest way to finish is +closing its window with the mouse. Nothing about the session has gone — +`flan-rerun' runs `main' again, with the globals as the last run left them.") + (defvar flan-dev--busy nil "Non-nil while a request is waiting for its reply. `flan-dev--read-reply' runs `accept-process-output', which runs timers, so @@ -254,6 +268,18 @@ than at each call site because `flan-dev--report' signals on a rejection — state attached to a reply that turns out to be an error would be thrown away with it, and a rejected evaluation is a likely moment to *become* stopped." (flan-dev--append-output (plist-get reply :output)) + ;; The same edge treatment `flan-dev--stopped' gets below, and the message is + ;; the reason: a program that finished is a program somebody is about to want + ;; back, and the name of the command that does it is the whole of what they + ;; need. Once, on the edge — the poll runs every second, and a line in the + ;; echo area every second is a line nobody reads. + (let ((was flan-dev--parked) + (now (and (plist-get reply :parked) t))) + (setq flan-dev--parked now) + (unless (eq was now) + (force-mode-line-update t) + (when now + (message "flan: the program finished; C-c C-M-x runs it again")))) (let ((was flan-dev--stopped) (now (and (plist-get reply :stopped) (or (plist-get reply :condition) "a condition")))) @@ -367,6 +393,7 @@ Set to nil to leave the program's state to whatever replies happen to say." :coding 'binary :noquery t)) (setq flan-dev--socket socket)) (setq flan-dev--stopped nil) + (setq flan-dev--parked nil) (flan-dev--start-polling) (force-mode-line-update t) flan-dev--connection) @@ -709,12 +736,18 @@ running — `flan-dev' then starts it again, on the same program." :group 'flan-dev) (defun flan-dev-state () - "Whether a program is connected: `stopped', `live', `lost', or `off'. + "Whether a program is connected: `stopped', `parked', `live', `lost', or `off'. `lost' means there was one and the daemon is gone — a restart away, not a mistake, so it is distinguished from never having connected. `stopped' is a live program sitting in the break loop on an unhandled condition, which is -every bit as connected and nothing like running." +every bit as connected and nothing like running. `parked' is a program that +has *finished*: the process and every global in it are still there, and +`flan-rerun' starts `main' again. + +`stopped' wins over `parked' where both are somehow set, because a break is +the state with something to answer in it." (cond ((and (process-live-p flan-dev--connection) flan-dev--stopped) 'stopped) + ((and (process-live-p flan-dev--connection) flan-dev--parked) 'parked) ((process-live-p flan-dev--connection) 'live) (flan-dev--socket 'lost) (t 'off))) @@ -730,6 +763,14 @@ every bit as connected and nothing like running." 'face 'flan-dev-stopped-face 'help-echo "Stopped on an unhandled condition; C-c C-b to choose a restart")) + ;; Before `live', and shown as its own word rather than as a shade of + ;; it: from anywhere else in Emacs a finished program looks exactly like + ;; a running one, and it is the indicator's job to be the thing that + ;; notices. `stopped''s face is reused — both mean "connected, and not + ;; going anywhere until you say so", which is what the colour is for. + ('parked (propertize " flan:parked" 'face 'flan-dev-stopped-face + 'help-echo + "The program finished; C-c C-M-x runs it again, globals and all")) ('live (propertize " flan:live" 'face 'flan-dev-live-face 'help-echo (format "Connected to %s" flan-dev--socket))) ('lost (propertize " flan:lost" 'face 'flan-dev-lost-face @@ -816,6 +857,38 @@ here for a name known in advance." (or (plist-get r :note) "accepted"))) (user-error "flan: %s" (or (plist-get r :message) "refused"))))) +;;;###autoload +(defun flan-rerun () + "Run the program's `main' again, in the process that is already there. + +For the ordinary end of a session that is not the end of anything: the +program opened a window, you closed it, `main' returned. The process did +not go anywhere — it holds the compiler, the session and every global the +run left — so this sends it round `main' once more and you get another +window. It is what calling `(main)' at a Common Lisp or Clojure prompt does, +and it is the cheap counterpart of `flan-dev-restart-program', which throws +away the build and the state to get a new process. + +NOTHING IS RESET. The second run reads whatever the first left in the +globals: a counter goes on counting, an arena is as full as it was. That is +the point rather than an omission — a clean slate is one evaluation away and +cannot be had back once this has zeroed something you wanted. + +Refused while the program is running, by the daemon, because two `main's in +one process would be writing the same globals at once." + (interactive) + (let ((r (flan-dev--request '(:op "rerun")))) + (if (equal (plist-get r :status) "ok") + (progn + ;; Cleared here rather than waited for, exactly as a restart clears + ;; `flan-dev--stopped': the reply is written by the compiler thread + ;; the instant it signals, and the modeline would otherwise say + ;; `parked' until the poll after the one that agreed. + (setq flan-dev--parked nil) + (force-mode-line-update t) + (message "flan: %s" (or (plist-get r :note) "running again"))) + (user-error "flan: %s" (or (plist-get r :message) "refused"))))) + (defun flan-dev-abort () "Let the stopped program die where it stopped. This ends `flan dev' too: the daemon owns the program's lifetime and has @@ -875,8 +948,15 @@ than being told so." "Report what the running program currently defines." (interactive) (let ((r (flan-dev--request '(:op "describe")))) + ;; Three states and not two. `:alive' says whether there is still a + ;; session; `:parked' says the program inside it has finished, which is a + ;; thing "exited" used to be told and was wrong about — nothing exited, + ;; and saying so sent people to `flan-dev-restart-program' for something + ;; `flan-rerun' does without losing the build. (message "flan dev: %s, %d functions, %d globals" - (if (plist-get r :alive) "running" "exited") + (cond ((plist-get r :parked) "parked") + ((plist-get r :alive) "running") + (t "exited")) (length (plist-get r :fns)) (length (plist-get r :globals))))) ;;; Where an error is diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 17a2bb4..69adbe9 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -71,6 +71,10 @@ (autoload 'flan-dev "flan-dev" nil t) (autoload 'flan-dev-quit "flan-dev" nil t) (autoload 'flan-dev-restart-program "flan-dev" nil t) +;; And the cheap counterpart, which needs an autoload for the reason above and +;; more than most: it is the command someone reaches for the moment a window +;; closes, which can be the first thing they ever ask the client to do. +(autoload 'flan-rerun "flan-dev" nil t) ;; Bound below, like the rest, and it was the one missing an autoload. (autoload 'flan-disassemble "flan-dev" nil t) ;; The other question about the same function, and the reason it is a second @@ -213,6 +217,13 @@ line is off screen." (define-key map (kbd "C-c C-m") #'flan-macroexpand) ;; The way out when a reload is refused: rebuild, relaunch, reconnect. (define-key map (kbd "C-c C-x") #'flan-dev-restart-program) + ;; And beside it the cheap one, which is the same question — "run this + ;; program" — asked of a process that is already there: `main' again, with + ;; the globals as the finished run left them. The pairing is `C-c C-b' + ;; and `C-c C-M-b' above: the modifier is what distinguishes two commands + ;; about one subject, and the heavier of the pair keeps the bare key + ;; because it is the one that works from any state. + (define-key map (kbd "C-c C-M-x") #'flan-rerun) map) "Keymap for `flan-mode'.") diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index b59b658..ee9119d 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -107,6 +107,67 @@ is written instead — the real `message' call the real command makes." (test-flan--check "describe lists the program's globals" (member "ticks" (plist-get r :globals)))) + ;; The third state. A program that finishes no longer ends its process: the + ;; main thread parks holding every global, and `flan-rerun' sends it round + ;; `main' again. The client has to be able to *say* that, because from + ;; anywhere else in Emacs a finished program and a running one look the same. + ;; + ;; Driven through `flan-dev--absorb' with a made-up reply rather than by + ;; waiting for this program to finish. What is under test is the client's + ;; reading of `:parked', which is a decision it makes about a plist; making + ;; the real program park first would put the daemon, the agent and a + ;; condition variable between the question and the answer, and test_dev.ml + ;; already does that end to end. + (let ((said (test-flan--said + (flan-dev--absorb '(:status "ok" :stopped nil :parked t))))) + (test-flan--check "a reply that says parked makes the client say so" + (and (eq (flan-dev-state) 'parked) + (string-match-p "parked" (flan-dev-mode-line)))) + ;; Once, on the edge, and naming the way out: the poll runs every second + ;; and the whole point of the message is that it is read. + (test-flan--check "and says how to get the program back, once" + (and said (string-match-p "runs it again" said) + (null (test-flan--said + (flan-dev--absorb + '(:status "ok" :stopped nil :parked t))))))) + ;; Stopped is not parked and must win where both arrive: a break has + ;; restarts to choose and is the state with something to answer in it. + (flan-dev--absorb '(:status "ok" :stopped t :condition "Missing" :parked t)) + (test-flan--check "a stopped program reads as stopped even while parked is set" + (eq (flan-dev-state) 'stopped)) + (flan-dev--absorb '(:status "ok" :stopped nil :parked nil)) + (test-flan--check "and both clear again" + (eq (flan-dev-state) 'live)) + + ;; `flan-describe' had two words for three states, and "exited" was the + ;; wrong one of them: nothing exited, and being told so is what sent people + ;; to `flan-dev-restart-program' for a thing `flan-rerun' does without + ;; losing the build. + (test-flan--check + "flan-describe names the parked state rather than calling it exited" + (let ((said (test-flan--said + (cl-letf (((symbol-function 'flan-dev--request) + (lambda (&rest _) + '(:status "ok" :fns ("step") :globals ("ticks") + :alive t :parked t)))) + (flan-describe))))) + (and said (string-match-p "parked" said)))) + + ;; And the refusal a parked program gives an op it cannot answer, which is + ;; the daemon's words reaching a person: it has to name the state and the + ;; command, not say the program exited. + (test-flan--check + "a parked refusal reaches the user with the way out in it" + (let ((raised nil)) + (cl-letf (((symbol-function 'flan-dev--request) + (lambda (&rest _) + '(:status "error" + :message "a backtrace is the frames of a stopped program, and a parked one has no frames at all; the program has finished and its process is parked — M-x flan-rerun starts it again")))) + (condition-case err (flan-rerun) + (error (setq raised (error-message-string err))))) + (and raised (string-match-p "parked" raised) + (string-match-p "flan-rerun" raised)))) + ;; `layout' against the real daemon, through `flan-cnr-layout', which is how ;; the conditions buffer gets it. The reply is the first one with a list of ;; lists in it, so `read' on this side is doing something it does nowhere diff --git a/lib/dev.ml b/lib/dev.ml index 69139c4..4c0bd95 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -42,10 +42,15 @@ type t = { owners : (string, origin) Hashtbl.t; (* fn name -> the last module sent *) host_ll : string; (* the IR the running program was built from *) host_exe : string; (* ...and the binary it was linked into *) - (* Set when the program's stdout reads EOF. In the two-process daemon that - happens because the child died and [waitpid] is the authority anyway; in - the merged build it is the signal itself — the program's exit closes fd 1 - and parks, and this is how the compiler finds out. *) + (* Set when the program's stdout reads EOF, which in the two-process daemon + means the child died — and [waitpid] is the authority there anyway. + + It used to be the merged build's signal as well: a program that finished + closed fd 1 on its way to the park, and the EOF was how the compiler found + out. That could not survive a program that can be run again, because a + pipe delivers EOF once and the second run would have had nowhere to print. + The merged build keeps fd 1 open across runs now and is asked instead — + see [liveness] and [Program.state]. *) mutable finished : bool; } @@ -322,17 +327,61 @@ let bound_slots t ~frame = (List.filter (fun l -> l <> "" && l <> ".") lines)) | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e) -(* In the merged build the program is this process, so the question answers - itself: if this code is running, so is the program. The two-process daemon - has to ask the kernel. *) -let alive t = - match t.child with - | None -> not t.finished - | Some child -> - (match Unix.waitpid [ Unix.WNOHANG ] child with - | 0, _ -> true - | _ -> false - | exception Unix.Unix_error _ -> false) +(* ── Whether there is still a program, and whether it is running ────── *) + +(* Three states and not two, because the merged build grew a third. A program + that finishes no longer takes the process with it: its main thread parks, + holding every global the run left, and [rerun] sends it round [main] again. + So "the program exited; restart flan dev" — which every op in this file used + 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. *) +type liveness = + | Live (* running: the program is between frames *) + | Parked (* finished, and can be run again *) + | Gone (* the process is not there any more *) + +(* Split out so that it can be tested. The merged arm turns on a C symbol that + only a merged binary has — [Program.state] is [Absent] in the test binary + and in the compiler itself — so the three-way decision has to be reachable + from somewhere other than a running merged build, or the only thing checking + it is the end-to-end case that takes a compile. + + [finished] is the pipe's EOF, which the merged build no longer produces: its + program keeps fd 1 open across runs now, because a pipe delivers EOF once + and spending it would cost the second run its output. It is still read here + for the [Absent] case — a merged-shaped session with no program thread is + what every unit test is — and it is still the two-process daemon's own + answer, arrived at by [waitpid] above it. *) +let liveness_of ~child_alive ~finished ~program = + match child_alive with + | Some true -> Live + | Some false -> Gone + | None -> + (match program with + | Program.Running -> Live + | Program.Parked -> Parked + | Program.Absent -> if finished then Gone else Live) + +let liveness t = + let child_alive = + match t.child with + | None -> None + | Some child -> + Some + (match Unix.waitpid [ Unix.WNOHANG ] child with + | 0, _ -> true + | _ -> false + | exception Unix.Unix_error _ -> false) + in + liveness_of ~child_alive ~finished:t.finished ~program:(Program.state ()) (* ── What a body was built from ─────────────────────────────────────── *) @@ -398,9 +447,18 @@ let with_output t reply = happened to wonder — and the most common moment for a program to stop is the instant after an evaluation, which is a reply it is already reading. - It is the annotation, not the ops, that decides these two fields, so that - there is one place in the daemon that says whether the program is stopped - and the break ops cannot disagree with the poll. *) + [:parked] rides along for exactly the same reason and was added when the + program stopped being something the process could only do once. Finishing is + as unannounced as stopping — more so, since the commonest way to finish is + somebody closing a window with the mouse — and an editor that had to ask + would show "live" until it next happened to wonder. The two are not + alternatives and are not folded together: a stopped program is inside a + frame with restarts on offer, a parked one has no frames at all, and the + only thing they have in common is that neither is running. + + It is the annotation, not the ops, that decides these fields, so that there + is one place in the daemon that says what the program is doing and the ops + cannot disagree with the poll. *) let with_break t reply = let fields = match state t with @@ -411,6 +469,9 @@ let with_break t reply = would be the [ok]-means-probably failure in miniature. *) | Unreachable _ -> " :stopped nil" in + let fields = + fields ^ (if liveness t = Parked then " :parked t" else " :parked nil") + in String.sub reply 0 (String.length reply - 1) ^ fields ^ ")" let error ?loc msg = @@ -441,11 +502,50 @@ let build_module (c : Session.change) ~debug ~out = ~opts:{ Build.default with Build.dev = true; Build.debug = debug } ~ir:c.Session.ir ~out () +(* The two refusals that are about the *state* rather than about the request, + spelled once so that every op tells the same story. + + [gone] is what all of them used to say and is now said only where it is + true: there is no process left and nothing short of a new one will help. + + [parked] is the new half, and the sentence it appends is the whole point of + the distinction. Somebody reading it has a program that is *there* — its + globals are intact, its session is whole, this daemon is answering — and + what they need is not a diagnosis but the name of the verb that starts it. + Each site says in its own words why it in particular cannot be answered from + a parked program, because "parked" is the state and not the reason: an op + refused for want of a frame boundary and an op refused for want of a stopped + stack are refused by the same state for different causes, and a reader who + cannot tell them apart cannot tell what to do instead. *) +let gone = "the program exited; restart flan dev" + +let parked_msg why = + why + ^ "; the program has finished and its process is parked, holding everything \ + the run left in the globals — M-x flan-rerun starts it again, and this \ + answers once it is running" + +let parked why = error (parked_msg why) + (* [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. *) + 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 + 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 + redefined while parked is installed by the re-run and is what that run + executes. Refusing here would mean closing a window, being told to run the + program again, and only then being allowed to fix the thing you closed it + over, which is the loop this whole feature exists to remove. What does + change is the note: "at its next frame boundary" is not a promise anyone can + read while the program is parked. *) let eval t ~code ~origin ~pause = - if not (alive t) then error "the program exited; restart flan dev" + let now = liveness t in + let parked_now = now = Parked in + if now = Gone then error gone else match Session.eval ~origin ?pause t.session code with | c when not c.Session.installs -> @@ -487,7 +587,14 @@ let eval t ~code ~origin ~pause = @ (match pause with | Some (l, c) -> [ ":pause " ^ Wire.quote (Printf.sprintf "%d:%d" l c) ] - | None -> [])) + | None -> []) + @ (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" ] + else [])) | reply -> error ("the program refused the module: " ^ reply) | exception Unix.Unix_error (e, _, _) -> error @@ -501,8 +608,18 @@ let eval t ~code ~origin ~pause = comes back through the runtime rather than through this reply, because the frame boundary it runs at is the program's to choose. *) let eval_expr t ~code ~origin ~pause = - if not (alive t) then error "the program exited; restart flan dev" - else + 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 -> match Session.eval_expr ~origin ~pause t.session code with | c -> let before = match result t with Some (g, _) -> g | None -> 0L in @@ -546,7 +663,12 @@ let eval_expr t ~code ~origin ~pause = | _ when ms <= 0 -> `Timeout | _ -> ignore (Unix.select [] [] [] 0.005); - if alive t then wait (ms - 5) else `Timeout + (* [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 in (match wait 5000 with | `Value v -> ok [ ":value " ^ Wire.quote v ] @@ -569,7 +691,7 @@ let eval_expr t ~code ~origin ~pause = (* What a macro call expands to — [C-c C-m], and the one verb here that never touches the program. - Deliberately not gated on [alive t]. Every other verb in this file is a + Deliberately not gated on [liveness t]. Every other verb in this file is a question about a running process and says so when there is not one; expansion is a question about the *compiler*, answered out of the macros the session holds, and it is still answerable after the program has exited. That @@ -622,7 +744,14 @@ let describe t = ^ Wire.strings (List.map (fun (g : Tast.global) -> g.Tast.gname) t.session.Session.program.Tast.globals); - ":alive " ^ (if alive t then "t" else "nil") ] + (* Two keys for three states, and [:alive] keeps the meaning it has + always had: is there still a session on the other end of this socket. + A parked program is therefore [:alive t], because everything about the + process is intact — it is [:parked], which [with_break] puts on this + reply as it puts it on every other, that says the program is not + running. Folding both into one key would either tell a client the + session had gone when it had not, or leave the new state unsayable. *) + ":alive " ^ (if liveness t = Gone then "nil" else "t") ] (* [describe] answers what exists; this answers what each one *is*. Its own op rather than more fields on [describe], because [describe] is polled — an @@ -784,8 +913,18 @@ let layout t ~ty = adds is the restart names, which cost a second round trip to the program and are wanted only when someone is about to choose one. *) let break t = - if not (alive t) then error "the program exited; restart flan dev" - else + match liveness t with + | Gone -> error gone + (* Before [state t] and not after it, which is the ordering every guard + below shares. The agent's listener thread is alive while the program is + 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 + "a parked program has not stopped on anything, so there are no restarts \ + to offer" + | Live -> match state t with | Running -> ok [] | Unreachable m -> error ("cannot ask the program whether it stopped: " ^ m) @@ -826,8 +965,18 @@ let break t = [nslots] is how many slots the frame has, which is what a client asks about before asking for any of them. *) let backtrace_op t = - if not (alive t) then error "the program exited; restart flan dev" - else + match liveness t with + | Gone -> error gone + (* Not the running refusal below and not an empty list either. The chain is + genuinely empty — the park clears it, because the frames a finished run + 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 + "a backtrace is the frames of a stopped program, and a parked one has \ + no frames at all" + | Live -> match state t with | Running -> error @@ -878,7 +1027,10 @@ let run_render_thunk t ~tag ~(c : Session.change) : (string, string) result = | _ when ms <= 0 -> None | _ -> ignore (Unix.select [] [] [] 0.005); - if alive t then wait (ms - 5) else None + (* [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 None in (match wait 5000 with | Some v -> Ok v @@ -898,8 +1050,16 @@ let run_render_thunk t ~tag ~(c : Session.change) : (string, string) result = [what] goes into the wording — "read slot names from" is not the sentence [inspect] wants — and nothing else differs. *) let stopped_frame t ~frame ~what : (string * Tast.fn, string) result = - if not (alive t) then Error "the program exited; restart flan dev" - else + match liveness t with + | Gone -> Error gone + | Parked -> + 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 -> match state t with | Running -> Error @@ -1312,8 +1472,18 @@ let render_addr (s : Session.t) ~addr ~(ty : Types.t) and stepping into it is a different root. *) let inspect_addr t ~addr ~want_type = if addr <= 0 then error "an address is a positive number" - else if not (alive t) then error "the program exited; restart flan dev" else + match liveness t with + | Gone -> error gone + (* The registry outlives the run, so the entry is still there — and that is + 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 + "an address is rendered by a thunk the program runs, and a parked \ + program runs nothing" + | Live -> match state t with | Running -> error @@ -1528,8 +1698,21 @@ let reg_listing t ~verb ~note = storage. So there is no [bound_slots] round trip and no not-yet-bound case — a global's storage exists from the moment the process started. *) let globals_op t = - if not (alive t) then error "the program exited; restart flan dev" - else + match liveness t with + | Gone -> error gone + (* Refused for the mechanism and not for the policy, which is worth saying + because the storage really is readable: a global's memory exists from the + moment the process started and is exactly as the finished run left it, + which is the whole of what makes a re-run worth having. What does not + exist while parked is the renderer. A globals section is a thunk built + 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 + "a globals section is rendered by a thunk the program runs against the \ + stopped stack, and a parked program has neither" + | Live -> match state t with | Running -> error @@ -1691,8 +1874,14 @@ let globals_op t = still not now. An editor that read [ok] as "running again" would poll once, find it stopped, and re-open the prompt it had just answered. *) let choose_at t ~index ~name = - if not (alive t) then error "the program exited; restart flan dev" - else if + match liveness t with + | Gone -> error gone + | Parked -> + parked + "a restart is taken on a stopped program's stack, and a parked one has \ + no stack to resume into" + | Live -> + if match name with | Some n -> String.exists (fun c -> Char.code c < 32 || Char.code c = 127) n | None -> false @@ -1715,8 +1904,14 @@ let choose_at t ~index ~name = error ("cannot reach the program: " ^ Unix.error_message e) let choose t ~name = - if not (alive t) then error "the program exited; restart flan dev" - else if String.exists (fun c -> Char.code c < 32 || Char.code c = 127) name then + match liveness t with + | Gone -> error gone + | Parked -> + parked + "a restart is taken on a stopped program's stack, and a parked one has \ + no stack to resume into" + | Live -> + 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 this end's to keep: [completing-read] cannot produce one, but the daemon @@ -1738,8 +1933,17 @@ let choose t ~name = daemon too — it owns the program's lifetime and has nothing left to serve. Refused while running, by the program, for the same reason a restart is. *) let abort t = - if not (alive t) then error "the program exited; restart flan dev" - else + match liveness t with + | Gone -> error gone + (* The one refusal here that is good news. Abort exists to end a program + 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 + "the program has already finished, so there is nothing to abort and \ + nothing that would end by aborting it but this session" + | Live -> match ask t "abort" with | reply when String.trim reply = "ok" -> ok [ ":note " ^ Wire.quote "the program is exiting; flan dev ends with it" ] @@ -1747,6 +1951,43 @@ let abort t = | exception Unix.Unix_error (e, _, _) -> error ("cannot reach the program: " ^ Unix.error_message e) +(* Run [main] again. The verb this file was missing, and the one everything + above it about [Parked] is in aid of. + + The complaint it answers, in the words it was made in: you run a program + under [flan dev], it opens a window, you close the window, main returns — + and there is no way to get a new window back short of tearing down the whole + session with [flan-dev-restart-program], which throws away the build, the + session and every global. In Common Lisp or Clojure the image outlives main, + so you call it again. The process here already outlived main; it simply had + nothing that could wake it. + + NOTHING IS RESET, and that is the decision rather than a corner not yet + swept. The process never died, so the second run sees the globals exactly as + the first left them — a counter goes on counting, an arena stays as full as + it was, a cached texture handle is still whatever the closed window made it. + That is what CL and Clojure do and it is what was asked for: a clean slate + is a thing you ask for by hand, in one evaluation, and it cannot be had back + the other way round if this zeroed by default. + + The state is asked twice — here, to say something useful about [Gone], and + again inside [Program.rerun], which is the answer that counts. The C does + its test and its signal under one lock, so the window between them that this + check cannot see is a window that does not exist there. *) +let rerun t = + match liveness t with + | Gone -> error gone + | 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" ] + | Error m -> error m) + (* ── Disassembly ───────────────────────────────────────────────────── *) (* [flan emit --dev] can print the IR of a whole source file, which is a @@ -1973,6 +2214,17 @@ let basis t name = back to say whether it installed this before stopping. Nothing \ further installs until it resumes" m c + (* [state t] answers [Running] for a parked program — the agent's + listener is alive and nothing has stopped — so the frame-boundary + sentence below would be said about a program that will not reach one + until somebody runs it again. Asked of [liveness] first, for the same + reason every guard in this file is. *) + | 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" + m | Running -> Printf.sprintf "%s — the last module delivered for this name, accepted for install; \ @@ -2285,6 +2537,11 @@ let handle t req = | Some index -> choose_at t ~index ~name:(Wire.string_field req "name") | None -> error "restart-at needs :index") | Some "abort" -> abort t + (* No fields: the only thing it could take is which function to run, and the + answer is main — the whole claim is that the process is an image the + program can be started in again, not a way to call arbitrary names, which + is what [eval-expr] already is. *) + | Some "rerun" -> rerun t (* [:on] is how the buffer says it opened or closed. Without it the table is never written, which is the point: a program with watch calls in it and nobody looking pays a load and a branch and nothing else. *) @@ -2460,11 +2717,19 @@ let ignore_sigpipe () = (* [accept] would block past the program's own exit, so it is waited on with a timeout and the child checked each time round: a daemon whose program has finished has nothing left to do, and an editor waiting on it would wait - forever. In the merged build [alive] is always true and the loop ends the - only way it can — the process does, taking the program with it. *) + forever. In the merged build the loop ends the only way it can — the process + does, on [close]. + + [Gone] and nothing narrower, and this is the one place where getting the + three states the wrong way round is fatal rather than merely confusing. A + parked program is a program somebody is about to ask to run again, and they + ask over this socket; stopping the loop when it parked would shut the + listener, return from [merged_serve], and [_exit] the process — closing a + window would kill the session, which is the bug this whole change exists to + remove, reintroduced one line further out. *) let accept_loop t ls = let rec go () = - if alive t then + if liveness t <> Gone then (* The program's pipe is in the same select as the listening socket: it has to be drained whether or not an editor is asking for anything. *) match Unix.select [ ls; t.stdout ] [] [] 0.2 with @@ -2611,17 +2876,22 @@ let two_process ?(debug = false) ?(x86 = false) ~file ~sock () = "the GC does not touch Flan's memory" measurement stops being true, and it would fail intermittently rather than loudly. - WHERE REPL-FIRST WOULD DIFFER, noted now because it is much cheaper to leave - room for than to retrofit. Today [main] runs the program and the compiler - comes up beside it. The SBCL arrangement is the same binary with the two - swapped: the C [main] would not call [flan_program_main] at all, it would - park, and opening the window would be something typed at the prompt — one - more op that asks the game thread to run a named function. The startup below - is the only place that decides, and it decides in three lines of C. What is - genuinely open is the *session*: [Session.create ~file] is the only entry - there is, so a REPL that starts empty and accumulates as files are loaded - needs [Session] to have a second constructor. It already accumulates; it - just cannot start from nothing. *) + WHERE REPL-FIRST WOULD DIFFER, and the half of it that has since been + built. [main] still runs the program first and the compiler still comes up + beside it, but the program finishing is no longer the end of anything: the + main thread parks on a condition variable and the [rerun] op sends it round + [main] again, which is the "opening the window is something the prompt asks + for" half of the SBCL arrangement, arrived at from the other end. What is + left of the difference is only the *first* run — [main] is entered because + the process starts rather than because anybody asked — and the startup below + is still the one place that decides, in three lines of C. + + What is genuinely open is the *session*: [Session.create ~file] is the only + entry there is, so a REPL that starts empty and accumulates as files are + loaded needs [Session] to have a second constructor. It already accumulates; + it just cannot start from nothing. And [rerun] runs [main] and nothing else, + deliberately — running a *named* function is what [eval-expr] already is, + and the two should not grow into one verb with a mode. *) let ocamlfind = try Sys.getenv "FLAN_OCAMLFIND" with Not_found -> "ocamlfind" @@ -2639,7 +2909,7 @@ let merged_main_source = {c| #include #include #include -#include +#include #include #include #include @@ -2654,28 +2924,141 @@ extern int flan_program_main(int argc, char **argv); /* flan_rt.c's, and the reason the program's exit does not end the session. */ extern void (*flan_exit_hook)(int32_t status); +/* What a finished run leaves threaded through stack it no longer owns. Both + * are emptied between runs; their own definitions say why. The frame chain is + * flan_dev.c's, which is in every dev build and so in every merged one — weak + * anyway, because a symbol that is only ever there by construction is exactly + * the kind that stops being there quietly. */ +extern void flan_condition_stacks_reset(void); +extern void flan_dev_frames_reset(void) __attribute__((weak)); + +/* ── The program's thread, between runs ────────────────────────────── */ + +/* A Flan main that finishes leaves this thread with nothing to do and the + * process with everything still in it: the compiler, the session, the editor's + * socket, and the program's own globals. Common Lisp and Clojure call that an + * image, and the reason you can close a window and open another one there is + * simply that main returning is not the end of anything. This is that, and it + * is three pieces: somewhere for the thread to wait, a way for the compiler + * thread to wake it, and a way back to main() from wherever the program + * happened to finish. + * + * The thread matters and cannot be traded away. raylib's window, like every + * GUI toolkit's, belongs to the thread that created it and on macOS belongs to + * the *first* one; running the second main on a thread of its own would give + * a window that does not draw and events that never arrive. So the main thread + * is the one that parks and the one that is woken, and the compiler thread + * only ever leaves a request here. + * + * Getting back to main() is a longjmp because there is no return to use. Emit + * ends @main with a call to flan_exit and an unreachable, and flan_exit is + * reached from wherever the program was — so the hook below is standing on the + * finished run's stack with no way to unwind it. longjmp back to main()'s own + * frame is the whole of the way out, and the two resets above are the price: + * a longjmp pops no frame, so the handler, restart and shadow-frame chains + * still point into stack the next run is about to write over. */ + +enum { PROGRAM_RUNNING = 0, PROGRAM_PARKED = 1 }; + +/* One lock over all three, so that "is it parked" and "wake it" cannot be + * answered and acted on across a gap. The compiler thread takes it for a + * comparison and a signal and nothing else — no dlopen, no allocation, no + * call into OCaml — which is what keeps it clear of the loader lock this file + * is careful about everywhere else. */ +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 int32_t program_status; /* what the last run ended with */ +static jmp_buf program_return; /* main()'s frame, from anywhere */ + /* Installed on flan_rt.c's hook, which a Flan main reaches instead of * returning: Emit ends @main with a call to flan_exit and an unreachable. * * In one process that call cannot be allowed to end the process — it would * take the compiler, the editor's socket and the session down with a program - * that merely finished. So it flushes, closes stdout so that the compiler - * learns the program is done exactly as the daemon learned it (the pipe reads - * EOF, which is what the child's death used to cause), and parks. + * that merely finished. * - * Parking rather than exiting is also the REPL-first shape in miniature: the - * process outliving the program is the whole of the difference between "run a - * program with a REPL attached" and "an image you run programs in". */ + * It used to close fd 1 here as well, so that the compiler thread learned the + * program was done exactly as the two-process daemon learns it: the pipe reads + * EOF, which is what the child's death used to cause. That cannot survive a + * program that can run again. A pipe delivers EOF only once every write end is + * gone, so the signal and the program's stdout were the same resource, and + * spending it ended the program's ability to print for the rest of the + * session. The second run would have had its output go nowhere. + * + * So fd 1 is left alone and the compiler reads [program_state] instead — a + * question with an answer rather than an event with one delivery. The + * descriptor hazard that made the old code reopen /dev/null onto fd 1 the + * 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. */ static void flan_merged_exit(int32_t status) { - (void)status; fflush(NULL); - close(1); - /* ...and take fd 1 straight back, because POSIX hands out the lowest free - * descriptor: leave it open and the compiler thread's next socket or file - * becomes this process's stdout, and the next llc inherits it. The EOF is - * unaffected — the pipe's write end is genuinely gone. */ - if (open("/dev/null", O_WRONLY) < 0) { /* nothing useful to do about it */ } - for (;;) pause(); + program_status = status; + longjmp(program_return, 1); +} + +/* Wait here until somebody asks for another run. + * + * The chains are cleared before the wait rather than after it, so that a + * backtrace asked for while the program is parked walks an empty stack and + * says so, instead of walking the finished run's. + * + * [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. */ +static void flan_merged_park(void) { + flan_condition_stacks_reset(); + if (flan_dev_frames_reset) flan_dev_frames_reset(); + fflush(NULL); + fprintf(stderr, + "flan dev: the program finished with %d; the process is parked and " + "its globals are as it left them — M-x flan-rerun runs it again\n", + (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; + pthread_mutex_unlock(&program_lock); +} + +/* The two the compiler thread calls, through the weak symbols in + * lib/dynload_stubs.c. Both are a lock, a couple of stores and an unlock: the + * rule that the game thread never enters OCaml has a mirror image, which is + * that the compiler thread must never do anything here that could take long + * enough to be noticed on a frame. + * + * [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 + * instant the first finished, which is never what somebody pressing a key + * meant. */ +int flan_merged_rerun(void) { + int rc; + pthread_mutex_lock(&program_lock); + if (program_state != PROGRAM_PARKED) rc = 1; + else { + program_asked = 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); + s = program_state; + pthread_mutex_unlock(&program_lock); + return s; } /* The socket is this process's to remove, and on every way out of it and not @@ -2731,7 +3114,7 @@ static void *flan_merged_compiler(void *unused) { int main(int argc, char **argv) { pthread_t compiler; - int rc; + volatile int rc = 0; g_argv = argv; atexit(flan_merged_unlink_sock); flan_exit_hook = flan_merged_exit; @@ -2743,25 +3126,41 @@ int main(int argc, char **argv) { /* From here the main thread is the program's and nothing else's. It does not * enter OCaml, and it is not joined with the compiler thread — that thread - * is in an accept loop it never leaves. */ - /* Does not come back: a Flan main ends in flan_exit, which is hooked above. - * The lines below are for a program that somehow does return. */ - rc = flan_program_main(argc, argv); - - /* _exit, not exit, for the reason the break loop gives: the atexit chain and - * the ELF destructors want the loader lock the agent's listener may be - * holding inside dlopen, and the merged build adds OCaml's own shutdown to - * that chain. The streams are flushed by hand instead. + * is in an accept loop it never leaves. * - * This is also the line REPL-first would delete: park here instead, and the - * window becomes something the prompt asks for rather than the thing the - * process is. */ - fprintf(stderr, - "flan dev: the program returned %d; the session ends with it\n", rc); - fflush(NULL); - /* By hand, because _exit does not run the atexit chain registered above. */ - flan_merged_unlink_sock(); - _exit(rc); + * A loop, and that is the feature. This used to be one call and an _exit + * underneath it, with a note saying that the line REPL-first would delete is + * exactly this one — park here instead, and the window becomes something the + * prompt asks for rather than the thing the process is. This is that edit. + * The process no longer ends when the program does; it goes back round. + * + * Two ways out of a run and both land here. A Flan main ends in flan_exit, + * which the hook turns into a longjmp back into [setjmp] below — that is the + * ordinary path, and the one closing a raylib window takes. A main that + * somehow returns normally falls out of the call instead, and is worth no + * different treatment: it finished, so it parks, and its status is the one + * it returned. + * + * [volatile] because [rc] is written between the [setjmp] and the [longjmp] + * and read after it, which is the one thing C promises nothing about. + * + * Nothing here _exits any more, so the old note about _exit against exit has + * moved to [merged_serve], which is now the only place the process ends: the + * atexit chain and the ELF destructors want the loader lock the agent's + * listener may be holding inside dlopen, and the merged build adds OCaml's + * 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. */ + for (;;) { + if (setjmp(program_return) == 0) { + rc = flan_program_main(argc, argv); + program_status = (int32_t)rc; + } + flan_merged_park(); + } } |c} diff --git a/lib/dynload_stubs.c b/lib/dynload_stubs.c index ff52d96..515a53e 100644 --- a/lib/dynload_stubs.c +++ b/lib/dynload_stubs.c @@ -171,6 +171,42 @@ extern char *flan_agent_request(const char *line, uint64_t *len) __attribute__((weak)); extern void flan_agent_request_free(char *p) __attribute__((weak)); +/* ── The program's own thread, when it is in this same process ──────── */ + +/* A merged [flan dev] binary runs the Flan program on its main thread and this + * compiler on a thread beside it, and a program that finishes no longer ends + * the process: the main thread parks and can be sent round again. These are + * the two questions the compiler has about that thread — what state it is in, + * and please run the program again — and both are defined in the C that + * lib/dev.ml generates for the merged entry point. + * + * Weak for [flan_agent_request]'s reason, which is the same reason: the [flan] + * binary that *builds* a merged program has no program of its own, and neither + * does the two-process daemon or any test. There the symbols are null, and + * "does this process have a program thread" is answered by the linker rather + * than by a flag that could disagree with it. + * + * The runtime system is *not* released across either call, unlike the agent + * request below. Each is a mutex, two stores and an unlock on a lock nothing + * 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_program_state(void) __attribute__((weak)); + +/* 0 running, 1 parked, 2 no program thread in this process. */ +CAMLprim value flan_program_state(value unit) { + (void)unit; + if (flan_merged_program_state == NULL) return Val_int(2); + return Val_int(flan_merged_program_state() == 0 ? 0 : 1); +} + +/* 0 taken, 1 refused because the program is running, 2 no program thread. */ +CAMLprim value flan_program_rerun(value unit) { + (void)unit; + if (flan_merged_rerun == NULL) return Val_int(2); + return Val_int(flan_merged_rerun() == 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 new file mode 100644 index 0000000..1d17c15 --- /dev/null +++ b/lib/program.ml @@ -0,0 +1,61 @@ +(** The Flan program's own thread, as the compiler reaches it when both are in + one process. + + [flan dev] builds one binary that is the compiled program and holds this + compiler. The program owns the main thread; this compiler is a thread + beside it. What changed to make this module necessary is that a program + which finishes no longer ends the process — the main thread parks, keeping + every global the run left behind, and can be sent round [main] again. That + is the Common Lisp and Clojure arrangement and it is wanted for their + reason: closing a window should not cost the session, and getting another + one should not cost a rebuild. + + Two facts cross from there to here, and both are a call into + [lib/dynload_stubs.c] rather than anything the daemon can infer. Liveness + used to be inferred — the program closed its stdout and the compiler read + EOF off the pipe — and that could not survive a program that runs again: a + pipe delivers EOF once, so the signal and the program's output were the + same resource. Asking is what replaces it. + + [Absent] means there is no program thread in this process: the [flan] + binary that builds a merged program, [flan reload], the two-process daemon, + every test. As with [Agent.request] the answer comes from the linker — the + symbols are weak and null in a binary that links no merged entry point — so + it cannot disagree with reality the way a flag could. *) + +type state = + | Running (* inside [main] *) + | Parked (* finished, waiting to be sent round again *) + | Absent (* this process has no program of its own *) + +external raw_state : unit -> int = "flan_program_state" +external raw_rerun : unit -> int = "flan_program_rerun" + +let state () = + match raw_state () with 0 -> Running | 1 -> Parked | _ -> Absent + +(* 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 + window belongs to the thread that opened it, and on macOS to the first + thread of the process, so a second [main] anywhere else would draw nothing. + This only leaves a request and wakes the sleeper, which is the same rule the + agent already follows for everything the game thread has to do. + + The refusal is the program's to make, not this end's. Checking the state + here and signalling after would leave a gap for the program to finish or + start in; the C does both under one lock, so a request is either taken or + told the program is running, and never both. *) +let rerun () = + match raw_rerun () with + | 0 -> Ok () + | 1 -> + Error + "the program is already running; a re-run starts main again, and two \ + mains in one process would be writing the same globals at once. Close \ + its window, or let it finish, and ask again" + | _ -> + Error + "this session's program is a process of its own, so there is no parked \ + thread here to send round again; it is the merged build that can re-run \ + a program, not --two-process" diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index 441413c..0057891 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -929,6 +929,17 @@ typedef struct flan_frame { * table, which [--dev] links with -rdynamic. */ flan_frame *flan_frame_head; +/* The chain, dropped. The counterpart of flan_rt.c's + * [flan_condition_stacks_reset] and there for the same one caller: the merged + * dev build's [main] can be entered a second time, and it gets back there by + * longjmp rather than by returning, so every frame the finished run pushed is + * still on this chain and every one of them is an alloca in stack that the + * next run is about to reuse. A backtrace taken after that would walk records + * whose [name] and [loc] pointers are whatever the new run happens to have + * written there — a listing that looks like a listing and names nothing real, + * which is the failure this whole file exists to avoid. */ +void flan_dev_frames_reset(void) { flan_frame_head = NULL; } + /* [i] counts from the innermost. NULL past the end, which is how a caller * learns the depth without a second walk. */ void *flan_dev_frame_at(int32_t i) { diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 07ae910..c5cf044 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -189,6 +189,28 @@ void flan_exit(int32_t status) { exit((int)status); } +/* Both stacks above, emptied — for the one caller that can reach this point + * with either of them non-empty. + * + * A handler frame and a restart frame are each an alloca in the function that + * establishes one, pushed on entry and popped on the way out, so in a program + * that runs to its end and stops there both chains are empty or point at + * storage that is about to stop existing, and neither case needs anybody's + * help. The merged dev build is the exception: its hook does not let [main] + * return, it longjmps back to the C [main] so that the program can be run + * again, and a longjmp pops no frame. Without this the second run starts with + * the first run's chains still threaded through stack that has been handed + * back — a [signal] would call a handler in a frame that is gone, which is a + * jump into whatever the new run wrote over it. + * + * Called only from between two runs, on the thread that runs them, which is + * why it needs no lock: there is no Flan code executing anywhere when it + * happens. */ +void flan_condition_stacks_reset(void) { + handlers = NULL; + restarts = NULL; +} + /* The conversions are *text*: bytes->f64 parses "12.5", f64->bytes renders it. * calc-me's tokenizer needs the first, the prelude's printers the second. */ diff --git a/test/test_dev.ml b/test/test_dev.ml index d549100..162e992 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -79,6 +79,47 @@ let listening ?(ms = 30000) ~pid path = false end +(* ── Three states, without a program to be in them ──────────────────── *) + +(* [Dev.liveness] reads a C symbol that only a merged [flan dev] binary has, so + in this one it always answers [Absent] and the interesting arm is out of + reach. [Dev.liveness_of] is the decision on its own, which is why it was + split out: the end-to-end case below proves a real program parks and runs + again, and this proves the three-way itself — including the two-process arm, + which nothing else here can reach at all, and the [Absent] fallback every + test in this directory is running under. *) +let () = + let case name got want = + if got <> want then fail "liveness: %s" name + in + (* A child: the kernel's answer, and never [Parked] — a program in its own + process that finishes is gone, and there is no thread here to wake. *) + case "a living child is live" + (Dev.liveness_of ~child_alive:(Some true) ~finished:false + ~program:Program.Absent) + Dev.Live; + case "a reaped child is gone, whatever this process's own state says" + (Dev.liveness_of ~child_alive:(Some false) ~finished:false + ~program:Program.Parked) + Dev.Gone; + (* Merged: the program is this process, and the C says which. *) + case "a merged program between frames is live" + (Dev.liveness_of ~child_alive:None ~finished:false + ~program:Program.Running) + Dev.Live; + case "a merged program that finished is parked, not gone" + (Dev.liveness_of ~child_alive:None ~finished:false ~program:Program.Parked) + Dev.Parked; + (* And the fallback, which is what a session in a binary with no program + thread of its own gets: the pipe's EOF, which is all there ever was + before the C could be asked. *) + case "with no program thread, EOF on the pipe is still the answer" + (Dev.liveness_of ~child_alive:None ~finished:true ~program:Program.Absent) + Dev.Gone; + case "and no EOF means there is still something there" + (Dev.liveness_of ~child_alive:None ~finished:false ~program:Program.Absent) + Dev.Live + let rec connect ?(ms = 5000) path = let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in match Unix.connect s (Unix.ADDR_UNIX path) with @@ -423,6 +464,80 @@ let () = (Option.value ~default:"" (Wire.string_field r "message")); if not (settle 4) then fail "the third reload was never installed"; + (* ── The program, run again ──────────────────────────────────── *) + + (* [main] has returned by now — dev-loop.flan prints four times and + stops — and that used to be the end of everything: the process stayed + up only to keep the compiler's socket answering, with the program + itself unreachable for the rest of the session. The complaint it came + from was a window: you close one, main returns, and the only way to + get another is to tear down the build, the session and every global + with it. Common Lisp and Clojure do not have that problem, because the + image outlives main and you simply call it again. + + So the main thread parks instead of exiting, and this is the proof + that it can be sent round [main] a second time. *) + let parked () = + match Wire.field (request c "(:op \"describe\")") "parked" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + if not (await parked) then + fail "the program never parked after main returned"; + + (* The refusals a parked program gives. Not "the program exited", which + is what every guard in the daemon used to say and is wrong about the + commonest case there is: the process is there, its globals are there, + and what the reader needs is the name of the verb that starts it. *) + 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" + 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 + 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 + this feature exists to remove. *) + let r = + request c + "(:op \"eval\" :code \"(defn step [] i64 (set extra (+ extra 1)) extra)\" :file \"/tmp/buf.flan\")" + in + if status r <> "ok" then + fail "a redefinition while parked: %s" + (Option.value ~default:"" (Wire.string_field r "message")) + else + (match Wire.string_field r "note" with + | Some n when contains_sub n "parked" -> () + | _ -> + fail + "a delivery to a parked program still promised the next frame \ + boundary"); + + let r = request c "(:op \"rerun\")" in + if status r <> "ok" then + fail "rerun: %s" (Option.value ~default:"" (Wire.string_field r "message")); + + (* Two lines, and between them the whole claim. The first is [step] as + the third reload left it, printed before the new run has reached a + frame boundary; the second is the body delivered while it was parked, + installed at the first [agent/wait] of the new run — and its value is + 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"; + + (* 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. *) + let r = request c "(:op \"rerun\")" in + let refused = Option.value ~default:(status r) (Wire.string_field r "message") in + if status r <> "error" then fail "a second main was started under the first" + else if not (contains_sub refused "already running") then + fail "a re-run while running is refused as: %s" refused; + (* Expression evaluation, which is a different primitive: no name to install a body into, so a thunk runs at a frame boundary and the value comes back rendered. The program has stopped reaching frame boundaries @@ -436,10 +551,16 @@ let () = proof: 1 before any reload, 5 from a body over a var that did not exist when it started, 105 from a second body reading the same one, and 777 from a restart clause in a third — reached by a transfer that - started in a handler and crossed a function the host was built with. *) + started in a handler and crossed a function the host was built with. + + Then the same [main], run a second time in the same process: 777 + 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. *) ignore (Unix.waitpid [] pid); let text = Buffer.contents output in - let wanted = "1\n5\n105\n777\n" in + let wanted = "1\n5\n105\n777\n777\n106\n" in if text <> wanted then fail "program transcript\n got: %S\n wanted: %S" text wanted end; @@ -2718,6 +2839,20 @@ let () = ignore (ask "(:op \"describe\")"); contains_sub (Buffer.contents seen) "42")) then fail "--two-process: the reload was never installed"; + (* And the one verb this shape cannot have. Running [main] again means + waking a thread that parked inside this process, and here the program + is a child: when it finishes it is gone, and there is nothing to wake. + Refused by naming what this daemon is rather than with the message a + merged one gives, because "the program is already running" would send + somebody back to try again after it had exited — and [--x86] arrives + here too, since it refuses the merged daemon for the -rdynamic reason + given below. *) + let r = ask "(:op \"rerun\")" in + let why = Option.value ~default:(status r) (Wire.string_field r "message") in + if status r <> "error" then + fail "--two-process answered a rerun it cannot perform" + else if not (contains_sub why "two-process") then + fail "--two-process refuses a rerun as: %s" why; ignore (ask "(:op \"close\")"); Unix.close tc end;