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

A closed window parks the program instead of ending the session

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-17 19:08:45 +07:00
commit 7704463ecd
10 changed files with 959 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
docs/BUILT.md
View File

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

86
emacs/flan-dev.el
View File

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

11
emacs/flan-mode.el
View File

@ -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'.")

61
emacs/test-flan-dev.el
View File

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

579
lib/dev.ml
View File

@ -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 <caml/callback.h>
#include <caml/mlvalues.h>
#include <pthread.h>
#include <fcntl.h>
#include <setjmp.h>
#include <stdatomic.h>
#include <stdint.h>
#include <stdio.h>
@ -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}

36
lib/dynload_stubs.c
View File

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

61
lib/program.ml Normal file
View File

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

11
runtime/flan_dev.c
View File

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

22
runtime/flan_rt.c
View File

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

139
test/test_dev.ml
View File

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