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

The watch window pushes, because a poll cannot answer a stopped program

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-13 07:25:51 +07:00
commit 88e6fd9fe5
11 changed files with 1277 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

145
BUILT.md
View File

@ -3669,3 +3669,148 @@ expression root with an effect in it would fire once a second for ever.
**One wire detail worth recording.** An empty `:path` is sent by omission. Emacs prints an empty list as `nil`, which **One wire detail worth recording.** An empty `:path` is sent by omission. Emacs prints an empty list as `nil`, which
is a symbol on the wire and would be read as a step, so there is no way for a client in that language to spell `()`. is a symbol on the wire and would be read as a step, so there is no way for a client in that language to spell `()`.
The daemon reads a missing `:path` — and `nil` — as the slot itself. The daemon reads a missing `:path` — and `nil` — as the slot itself.
## The watch window, and why it is the only listing that is pushed
The port of the author's Clojure `watch.el`, with the good idea kept and the transport turned round. The original is
85 lines and three of its decisions survive contact unchanged:
- **The program decides what is shown.** Emacs paints what one function hands it. There is no watch-expression
machinery, no per-variable registration, no UI for building a query. Everything a watch list would otherwise have to
answer — where it lives, whether it survives a restart, whether it gets committed by accident — stops being a
question once the list *is* the code, edited with `C-c C-c` like anything else.
- **The request is async.** A synchronous call on a 0.2s timer blocks Emacs's UI every tick. The original says so in a
comment, having evidently learned it.
- **`replace-buffer-contents`, not erase-and-insert.** It diffs, so point and scroll survive every repaint. Erasing
yanks the cursor to the top five times a second, which makes the buffer useless for the one thing anyone wants to do
in it — look at a particular line while the program runs.
### The one thing that does not port, and it inverts the design
In Clojure an eval is cheap. Here `eval-expr` **compiles a module and `dlopen`s it** — tens of milliseconds and a new
`.so` each time, in a directory nothing sweeps. Polling `(watch/render)` at 5Hz would produce hundreds of shared
objects a minute to read a number that was already in a register.
The first answer written down — in NEXT.md, now superseded — was to compile the render thunk *once* and re-invoke it
cheaply per tick. That is the right instinct and it is still a poll, and a poll has a defect no amount of caching
fixes: **it cannot answer while the program is stopped.** A thunk runs at a frame boundary, a stopped program has no
more frame boundaries, and a break loop is precisely when you most want to see what the last frame held.
So the direction is reversed. **The program pushes.** It calls into a table in `flan_dev.c` from inside its own loop;
Emacs reads the table, which is memory rather than an evaluation. Both halves are cheap for opposite reasons, and two
properties fall out that no poll has:
- the values are as fresh as the **last frame**, whatever the repaint interval happens to be — the timer decides how
often the picture is redrawn, not how current it is;
- and they are **still there while the program is stopped**, because nothing has to run to produce them.
This makes `watch` the only listing in the daemon that compiles nothing. Every other one — `locals`, `globals`,
`inspect`, `eval-expr` — is a thunk built from the types, delivered, and run at a frame boundary. That is affordable
at the rate a person presses a key and ruinous at the rate a HUD refreshes, and the difference in rate is the whole
reason this one is shaped differently.
### What the frame thread is allowed to do, and what the table is therefore made of
The writer is the game thread, mid-frame, every frame. That is a stricter constraint than the rest of `flan_dev.c` is
under, and it decides the storage:
- **No allocation.** Names are fixed `char` arrays inside the table, not `strdup`'d the way `intern` does it
alongside. `intern` runs at module load and may `malloc`; this runs at 60fps and may not.
- **No lock**, because the reader is the agent's listener thread and neither side may wait for the other.
- **No call into OCaml**, which is the rule that keeps the collector off the frame thread. Nothing in the table is
OCaml.
**The `result` buffer is deliberately not reused**, and this was the tempting mistake. The renderers are the same
shape, so sharing looks free — and it is wrong, because `result` is written once per `C-x C-e` and this is written
every frame. Sharing would mean watch traffic overwriting the value of every expression anyone evaluated. Separate
storage, separate counters.
**One seqlock per slot rather than one for the table.** A table-wide counter makes a read all-or-nothing: the reader
has to copy every slot inside a single even generation, which means catching the gap *between* two frames' worth of
writes — a window that at 60fps is whatever the program does after its last watch call, and may be nothing. Per-slot,
the reader retries one slot at a time and always gets somewhere. The worst it can produce is a snapshot whose entries
come from adjacent frames, which for a HUD is not a defect: a frame counter one ahead of a position read a
millisecond earlier is what a HUD looks like anyway. It would be a defect for anything where two values have to agree,
and that is a different op rather than a bigger counter.
A torn slot is still **listed**, with an empty value, rather than dropped. Dropping it would make the buffer's rows
move under the reader every time the game happened to be mid-write, which is much worse to look at than one value
that is blank for a tick.
### The bounds, and what happens past each
**64 slots. Past that a name is dropped, not fatal.** This is the one place the house style in `flan_dev.c` — `die`,
loudly — would be wrong: a watch is a diagnostic, and killing the program because somebody watched a 65th value is the
diagnostic shooting the patient. It is not silent either. An overflow flag is read back with the table and the buffer
says so, because a value that simply never appeared would send someone looking for a bug in their program.
**A flag and not a count, which was a correction.** The first version counted, and a counter on the write path counts
*writes*: the write path runs once per watched value per frame, so one name too many at 60fps reads back as "3847
names found no slot" within a minute — a false sentence about a true problem. What a reader needs is "the table is
full and something is not being shown", which is one bit, and one bit cannot drift into a wrong number. Counting
*distinct* names that missed would mean remembering which ones had, which is exactly the bookkeeping the frame thread
has no room for.
**31 bytes of name, 192 bytes of rendered value.** Both truncate; the value's truncation shows as an ellipsis, the
same as `flan_dev_result_end` does, so a clipped value does not read as a complete one.
### What it costs when nobody is watching
Nothing writes the table until a watch buffer is open. `M-x flan-watch` sends `watch-enable :on t` and closing it
sends `:on nil`, so arming is a *message* rather than something the daemon infers — the program is the writer and it
has to be told.
So the cost of a watch call in a program nobody is debugging is **one relaxed load and a not-taken branch**, and that
is the same number in a release build as in a dev one: `flan_dev.c` is linked into every build (`Build`, which says
why), so the symbols resolve either way and there is no second version of the file.
It is not *free*, and the distinction is worth keeping honest. Eliding the call entirely needs the compiler to know
the form, which is the `check.ml` arm below. A load and a branch per watched value per frame is the real number.
### Scalars work today; composites need a `check.ml` arm that was not built
The four entry points a program can reach through `declare-c` are the whole feature for a scalar:
```flan
(declare-c watch-i64 [name string x i64] i32 "flan_dev_watch_i64")
(watch-i64 "ticks" ticks)
```
No arm in the checker, no new special form, nothing the compiler has to learn. They return `i32` rather than nothing
for a blunt reason: `declare-c` refuses a void return outright — "which is not a value C can carry", `shim.ml` — so a
function a program can declare has to return something, and since it must, it returns the useful thing: 1 if the value
was written, 0 if nobody is watching or the table is full.
A composite — a struct, a slice, a union — cannot be reached this way, and that is not a shortcoming of the four. A
Flan value carries no header, so nothing at run time can say what it is, and rendering one is a compile-time walk over
its *type*. **That is the same reason `C-x C-e` renders in the thunk rather than marshalling anything**, and it is the
layout decision's bill, paid in the same place.
**The missing piece is one arm in `check.ml`, and it was deliberately not written** — that file is held by another
lane. It sits beside `print` (`check.ml:3480`) and is the same shape as it:
```
| "watch" ->
arity loc name 2 args; (* a name and a value *)
(* a read, not a move — as print is, for the same reason: (watch "v" v)
must not consume a Vec and make that its last showing *)
let n = check ctx (List.nth args 0) in (* must be String *)
let a = borrowed ctx target (fun () -> check ctx (List.nth args 1)) in
(* begin, the walk, end — with the emitter aimed at the four
flan_dev_watch_emit_* rather than at WriteStdout *)
Render.render { rc with emit = watch_emitter } 0 a
```
with `flan/watch-begin`, `flan/watch-end` and the four emit functions declared as externs the way `Session.externs`
already declares `flan_dev_emit*`. Nothing else has to move: `Render.render` is unchanged, the runtime side is built
and tested, and the daemon and the editor cannot tell which kind of caller filled the table.
That arm is also what **ghost text** is gated on, which is the more interesting consequence. Values shown inline
beside the code they belong to need a *place*, and nothing in the table has one — `(watch-i64 "ticks" ticks)` says
what the value is called, not where it was written. A source location would have to be carried per entry, which means
the caller supplies it, which means the call site is generated rather than hand-written. A `declare-c` call cannot do
it: the program would have to pass its own `__FILE__` by hand and it would drift the moment the line moved. So the
composite renderer and ghost text want the same form, for different reasons. `flan-watch.el` records the other two
things ghost text would need — overlay invalidation as the buffer is edited, and a rule for a watch inside a loop,
which the buffer sidesteps by showing the last value written and which inline has no obvious answer that does not
become the query UI this design exists to avoid.

43
NEXT.md
View File

@ -929,28 +929,35 @@ today.
`exported` and the refusal machinery already exist and take a second rule in one line, but there is no way for a `exported` and the refusal machinery already exist and take a second rule in one line, but there is no way for a
package to *mark* a name private, and adding one means a parser change. package to *mark* a name private, and adding one means a parser change.
## Decided in discussion — three more, all approved and none started ## Decided in discussion — three more, two now built
**A watch window, ported from the author's Clojure one.** `~/Development/siam-farmer/watch.el` is the working ~~**A watch window, ported from the author's Clojure one.**~~ **Built.** See `BUILT.md`, "The watch window, and why
original; read it first. Its design, and the parts to keep: it is the only listing that is pushed", and `emacs/MANUAL.md` under "Looking at values". Three of the original's
decisions were kept unchanged — the program decides what is shown, the request is async, and the paint is
`replace-buffer-contents` so point and scroll survive every tick.
- **The program defines what is shown.** Emacs polls one function — `(watch/render)` — and paints the string it **The design written here was superseded, and the correction is the interesting part.** This entry said the answer to
returns. There is no watch-expression machinery, no per-variable registration, no UI for building a query. The user an expensive eval was to **compile the watch thunk once and re-invoke it cheaply per tick**. That is the right
writes a function in the game. instinct about the cost and it is still a *poll*, and a poll has a defect that caching cannot fix: it cannot answer
- **Async, not synchronous.** A sync request on a 0.2s timer blocks Emacs's UI thread every tick. The original says so while the program is **stopped**. A thunk runs at a frame boundary and a stopped program has no more frame boundaries
in a comment, having evidently learned it. — which is exactly the moment you most want to see what the last frame held. So the direction was reversed instead:
- **`replace-buffer-contents`, not erase-and-insert.** It diffs, so point and scroll survive every tick; erasing yanks the program calls into a table from inside its own loop and Emacs reads the table, which is memory rather than an
the cursor to the top five times a second. evaluation. That also made the values update at *frame* rate rather than at the timer's, which the compile-once poll
- Nothing is appended — the buffer is always the current snapshot. could not have done at any price.
**The one thing that does not port, and it decides the design.** In Clojure an eval is cheap. Here `eval-expr` **What was not built, deliberately: the `(watch "hp" hp)` form.** Scalars work today through `declare-c` against four
*compiles a module and `dlopen`s it* — tens of milliseconds and a new `.so` each time, in a directory nothing sweeps. runtime entry points, which needs no compiler change at all. A struct or a slice needs a compile-time walk over its
Polling at 5Hz would produce hundreds of shared objects a minute. So **the watch thunk must be compiled once and then type — one arm in `check.ml` beside `print`, which `BUILT.md` writes out in full — and that file is held by another
called repeatedly**, which makes this a daemon feature rather than something the Emacs side can do alone: a `watch` lane, so it was left alone rather than reached into.
op that compiles on first use and a cheap re-invoke per tick.
The author also raised **ghost text** as an alternative or addition to a dedicated buffer — values shown inline at the **Ghost text is gated on that same arm**, which is the finding worth keeping. It was raised here as an alternative or
code they belong to. Not designed; the buffer is the port, ghost text is a further question. addition to the buffer, and it turns out not to be independent: values shown inline need a *place*, and nothing in
the table has one — `(watch-i64 "ticks" ticks)` says what the value is called, not where it was written. Carrying a
source location means the caller supplies it, which means the call site is generated rather than hand-written. A
`declare-c` call cannot do it; the program would have to pass its own `__FILE__` by hand and it would drift the
moment the line moved. `flan-watch.el` records the other two things ghost text would need: invalidating overlays as
the buffer is edited, and a rule for a watch inside a loop — which the buffer sidesteps by showing the last value
written, and which inline has no obvious answer that does not turn into the query UI this design exists to avoid.
~~**The inspector gets a second way to start: an address and a type.**~~ **Built.** See `BUILT.md`, "Two ways to root ~~**The inspector gets a second way to start: an address and a type.**~~ **Built.** See `BUILT.md`, "Two ways to root
a walk, and why neither subsumes the other". It went in as a frame and a slot *index* rather than an address and a a walk, and why neither subsumes the other". It went in as a frame and a slot *index* rather than an address and a

62
emacs/MANUAL.md
View File

@ -233,6 +233,63 @@ root; `RET` only ever lengthens the path under the root already in hand; and
starting a new root starts an empty stack. So a stack with both kinds in it starting a new root starts an empty stack. So a stack with both kinds in it
cannot be built, and `l` has nothing to cross into. cannot be built, and `l` has nothing to cross into.
### The watch buffer — values while the program runs
Everything above is for a program you have stopped, or one you interrupt with a
keystroke. **`M-x flan-watch`** is the other thing: a small buffer that shows
values *while the game runs*, updating at frame rate. `M-x flan-watch-stop`
closes it down, and killing the buffer does the same.
**The program decides what is shown.** There is no watch list to maintain, no
per-variable registration, no place to type an expression. The program says
what it wants seen, from inside its own loop:
```flan
(declare-c watch-i64 [name string x i64] i32 "flan_dev_watch_i64")
(declare-c watch-f64 [name string x f64] i32 "flan_dev_watch_f64")
(declare-c watch-str [name string s string] i32 "flan_dev_watch_str")
(defn step [] i64
(set ticks (+ ticks 1))
(watch-i64 "ticks" ticks)
ticks)
```
That is the whole of it. `C-c C-c` on `step` adds or removes a watched value
the same way it changes anything else, so the watch list is edited in the place
you were already looking.
**Why it is pushed rather than polled.** Every other listing in this manual is
a question the editor asks, which the daemon answers by compiling a small
module and handing it to the program. That is fine at the rate you press a key
and ruinous at the rate a HUD refreshes — each one is a new `.so`. So the
direction is inverted: the program writes into a table, and the editor reads
the table, which is memory. Two things follow that a poll could not have given.
The values are as fresh as the last frame, whatever the repaint interval is set
to. And **they are still there while the program is stopped** — a break loop is
exactly when nothing can be run at a frame boundary, and exactly when you want
to see what the last frame held.
**What it costs when you are not watching.** Nothing writes the table until a
watch buffer is open; `M-x flan-watch` tells the program somebody is looking
and closing it tells the program to stop. So a `watch-i64` call in a program
nobody is debugging is a load and a branch that is not taken, in a release
build as in a dev one.
**The limits.** The table holds **64 names**, and names past that are dropped
rather than being fatal — the buffer says how many, because a value that simply
never appeared would send you looking for a bug in the program. A name is
truncated at 31 bytes and a rendered value at 192, with an ellipsis where a
value was clipped.
**Scalars only, so far.** `i64`, `u64`, `f64` and `string` have entry points; a
struct or a slice does not. That is not an oversight in the runtime — a Flan
value carries no header, so rendering one is a walk over its *type* at compile
time, and a `(watch "hp" hp)` form in the compiler is what would do that walk.
It is not built. Ghost text — values shown inline beside the code they came
from — is a further question and needs the same form, because nothing in the
table carries a source location. `flan-watch.el` says what both would need.
--- ---
## When a change is refused ## When a change is refused
@ -395,7 +452,7 @@ Use `C-c C-g` if you need frames.
| `M-.` / `M-,` | where a name is written / back | | `M-.` / `M-,` | where a name is written / back |
Commands with no key: `M-x flan-dev` (start a program), `M-x flan-dev-quit` Commands with no key: `M-x flan-dev` (start a program), `M-x flan-dev-quit`
(stop it). (stop it), `M-x flan-watch` (the watch buffer) and `M-x flan-watch-stop`.
--- ---
@ -411,6 +468,8 @@ Commands with no key: `M-x flan-dev` (start a program), `M-x flan-dev-quit`
| `flan-dev-poll-interval` | `1.0` | seconds between checks for whether it stopped | | `flan-dev-poll-interval` | `1.0` | seconds between checks for whether it stopped |
| `flan-dev-daemon-buffer` | `"*flan-dev*"` | the daemon's own log | | `flan-dev-daemon-buffer` | `"*flan-dev*"` | the daemon's own log |
| `flan-dev-start-timeout` | `60` | seconds to wait for a program to come up | | `flan-dev-start-timeout` | `60` | seconds to wait for a program to come up |
| `flan-watch-buffer` | `"*flan-watch*"` | where watched values are painted |
| `flan-watch-interval` | `0.2` | seconds between repaints — not the watch rate |
--- ---
@ -421,6 +480,7 @@ Commands with no key: `M-x flan-dev` (start a program), `M-x flan-dev-quit`
| `flan-mode.el` | the major mode: syntax, indentation, imenu, the keymap | | `flan-mode.el` | the major mode: syntax, indentation, imenu, the keymap |
| `flan-dev.el` | the client — the socket, evaluation, xref, eldoc, completion | | `flan-dev.el` | the client — the socket, evaluation, xref, eldoc, completion |
| `flan-repl.el` | the `*flan-repl*` buffer | | `flan-repl.el` | the `*flan-repl*` buffer |
| `flan-watch.el` | the watch buffer: the program pushes, this paints |
| `flan-cnr.el` | the conditions-and-restarts buffer | | `flan-cnr.el` | the conditions-and-restarts buffer |
| `flan-inspect.el` | the value inspector | | `flan-inspect.el` | the value inspector |
| `flan-dape.el` | lldb through dape; optional | | `flan-dape.el` | lldb through dape; optional |

52
emacs/flan-dev.el
View File

@ -87,6 +87,37 @@ reply that request was waiting for.")
(let* ((payload (encode-coding-string (prin1-to-string form) 'utf-8 t))) (let* ((payload (encode-coding-string (prin1-to-string form) 'utf-8 t)))
(process-send-string proc (format "%d\n%s" (length payload) payload)))) (process-send-string proc (format "%d\n%s" (length payload) payload))))
(defun flan-dev--take-reply (proc)
"Read one complete framed message out of PROC's buffer, or return nil.
Never waits. This is the half of `flan-dev--read-reply' that does not block,
split out for the watch timer: a timer that called `accept-process-output'
would stall the UI every tick, which is exactly the mistake the Clojure
original left a comment about. See `flan-watch--tick'."
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(goto-char (point-min))
(when (re-search-forward "\\`\\([0-9]+\\)\n" nil t)
(let* ((n (string-to-number (match-string 1)))
(body-start (point)))
;; Present in full, or not yet — a partial body is not an error here,
;; it is the ordinary state between the send and the reply.
(when (>= (- (position-bytes (point-max)) (position-bytes body-start)) n)
(flan-dev--extract-reply body-start n)))))))
(defun flan-dev--extract-reply (body-start n)
"Read the N bytes at BODY-START as a reply and delete the frame.
Point is in the process buffer, and the frame is known to be complete."
(let* ((end (byte-to-position (+ (position-bytes body-start) n)))
(text (decode-coding-string
(encode-coding-string (buffer-substring-no-properties
body-start end)
'utf-8 t)
'utf-8))
(form (car (read-from-string text))))
(delete-region (point-min) end)
form))
(defun flan-dev--read-reply (proc) (defun flan-dev--read-reply (proc)
"Block until PROC sends one complete framed message, and read it." "Block until PROC sends one complete framed message, and read it."
(with-current-buffer (process-buffer proc) (with-current-buffer (process-buffer proc)
@ -113,15 +144,7 @@ reply that request was waiting for.")
(while (and (< (- (position-bytes (point-max)) (position-bytes body-start)) n) (while (and (< (- (position-bytes (point-max)) (position-bytes body-start)) n)
(< (float-time) deadline)) (< (float-time) deadline))
(accept-process-output proc 0.05)) (accept-process-output proc 0.05))
(let* ((end (byte-to-position (+ (position-bytes body-start) n))) (flan-dev--extract-reply body-start n)))))
(text (decode-coding-string
(encode-coding-string (buffer-substring-no-properties
body-start end)
'utf-8 t)
'utf-8))
(form (car (read-from-string text))))
(delete-region (point-min) end)
form)))))
(defun flan-dev--append-output (text) (defun flan-dev--append-output (text)
"Append TEXT, the running program's own output, to its buffer." "Append TEXT, the running program's own output, to its buffer."
@ -243,10 +266,21 @@ with it, and a rejected evaluation is a likely moment to *become* stopped."
(run-at-time 0 nil #'flan-dev--auto-break)))) (run-at-time 0 nil #'flan-dev--auto-break))))
reply) reply)
(defvar flan-dev-settle-hook nil
"Run before a request is sent, with the connection already open.
The protocol is one reply per request on one connection, and that is the whole
reason this exists. Anything that sends without waiting — the watch timer is
the only such thing — leaves a reply in flight that the *next* request would
otherwise read as its own. So a sender-in-flight hangs a function here that
collects its own reply first, and the invariant holds: exactly one request
outstanding, and every reply consumed by whoever asked for it.")
(defun flan-dev--request (form) (defun flan-dev--request (form)
"Send FORM to the connected program and return its reply." "Send FORM to the connected program and return its reply."
(let* ((proc (flan-dev--live-connection)) (let* ((proc (flan-dev--live-connection))
(flan-dev--busy t)) (flan-dev--busy t))
(run-hooks 'flan-dev-settle-hook)
(flan-dev--absorb (progn (flan-dev--send proc form) (flan-dev--absorb (progn (flan-dev--send proc form)
(flan-dev--read-reply proc))))) (flan-dev--read-reply proc)))))

276
emacs/flan-watch.el Normal file
View File

@ -0,0 +1,276 @@
;;; flan-watch.el --- A pinned, self-overwriting watch buffer -*- lexical-binding: t; -*-
;; A HUD for a running Flan program: a buffer that always shows the current
;; frame's values and nothing else. Ported from the author's Clojure
;; `clj-watch', with one thing kept and one thing inverted.
;;
;; KEPT, and it is the good idea in the original: **the program decides what is
;; shown**. There is no watch-expression machinery here, no per-variable
;; registration, no UI for building a query. The program says what it wants
;; seen, from inside its own loop, and this paints it. Everything a watch list
;; would need — where it lives, whether it survives a restart, whether it gets
;; committed by accident — stops being a question when the list is the code.
;;
;; INVERTED: the original polls. Emacs calls `(watch/render)' on a timer and
;; paints the string that comes back, which in Clojure costs an eval and an eval
;; is cheap. Here it is not. An evaluation *compiles a module and dlopens it*
;; — tens of milliseconds and a new .so each time, in a directory nothing
;; sweeps — so polling at 5Hz would produce hundreds of shared objects a minute
;; to read a number that was already in a register.
;;
;; So the program pushes. It calls into the runtime's watch table from its own
;; loop; this reads the table, which is memory rather than an evaluation. Both
;; halves are cheap for opposite reasons, and two things fall out that a poll
;; could not have given:
;;
;; the values update at *frame rate* rather than at the timer's rate — the
;; timer only decides how often the picture is repainted, not how fresh it
;; is;
;;
;; and the last frame's values are still there while the program is
;; *stopped*. A break loop is precisely when no thunk can run at a frame
;; boundary, because there are no more frames, and precisely when you want to
;; see what the last one held.
;;
;; Also kept from the original, and for its stated reasons: the request is
;; **async**, because a synchronous call on a timer blocks Emacs's UI every
;; tick; and the paint is `replace-buffer-contents' rather than erase-and-
;; insert, because it diffs, so point and scroll survive a repaint instead of
;; being yanked to the top five times a second.
;;
;; What a program writes today, with no compiler change:
;;
;; (declare-c watch-i64 [name string x i64] i32 "flan_dev_watch_i64")
;; (declare-c watch-f64 [name string x f64] i32 "flan_dev_watch_f64")
;;
;; (defn step [] i64
;; (set ticks (+ ticks 1))
;; (watch-i64 "ticks" ticks)
;; ticks)
;;
;; Scalars only, so far. A struct or a slice needs a compile-time walk over
;; its type — a `(watch "hp" hp)' form in the checker — and that is a file this
;; change does not own. See BUILT.md.
;;; Code:
(require 'flan-dev)
(require 'subr-x)
(defgroup flan-watch nil
"A pinned watch buffer for a running Flan program."
:group 'flan
:prefix "flan-watch-")
(defcustom flan-watch-buffer "*flan-watch*"
"Buffer the watch table is painted into."
:type 'string)
(defcustom flan-watch-interval 0.2
"Seconds between repaints.
This is the *repaint* rate, not the watch rate. The program writes its values
every frame whatever this is; all this decides is how often the picture is
refreshed, which is why a slow value here costs freshness and nothing else."
:type 'number)
(defvar flan-watch--timer nil)
(defvar flan-watch--pending nil
"Non-nil while a watch request is out and its reply has not been read.")
(defvar flan-watch--rows nil
"The last table painted, as a list of (NAME . VALUE).")
;;; Painting
(defun flan-watch--format (rows overflow)
"The buffer's text for ROWS. OVERFLOW means some name found no slot."
(if (null rows)
(concat "nothing is being watched\n\n"
"The program decides what is shown. Call into the watch table\n"
"from your own loop:\n\n"
" (declare-c watch-i64 [name string x i64] i32 \"flan_dev_watch_i64\")\n"
" ...\n"
" (watch-i64 \"ticks\" ticks)\n")
(let ((w (apply #'max (mapcar (lambda (r) (length (car r))) rows))))
(concat
(mapconcat (lambda (r)
;; Padded before it is propertised, not with a width in the
;; format string: `format' has no `%-*s', and a face on the
;; padding would underline trailing space.
(concat (propertize (car r) 'face
'font-lock-variable-name-face)
(make-string (+ 2 (- w (length (car r)))) ?\s)
(cdr r)))
rows "\n")
"\n"
;; Reported rather than swallowed. A name past the table's limit is a
;; value that simply never appears, and a buffer that said nothing about
;; it would be lying by omission — the reader would go looking for a bug
;; in the program. A flag and not a number: the only count the runtime
;; could keep is of write *attempts* that missed, and those happen every
;; frame, so one name too many would read as thousands.
(if overflow
(concat "\nthe table is full: some names found no slot,"
" and their values are not shown.\n"
"It holds 64.\n")
"")))))
(defun flan-watch--paint (text)
"Replace the watch buffer's contents with TEXT."
(when-let* ((buf (get-buffer flan-watch-buffer)))
(let ((tmp (get-buffer-create " *flan-watch-src*")))
(with-current-buffer tmp
(erase-buffer)
(insert text))
(with-current-buffer buf
(let ((inhibit-read-only t))
;; `replace-buffer-contents' diffs rather than erasing, so point and
;; the window's scroll position survive every tick. `erase-buffer'
;; and insert would yank the cursor to the top five times a second,
;; which makes the buffer unusable for the one thing you want to do
;; in it — look at a particular line while the program runs.
(replace-buffer-contents tmp))))))
;;; The tick
(defun flan-watch--absorb (reply)
"Paint REPLY, a watch answer from the daemon."
(pcase (plist-get reply :status)
("ok"
(setq flan-watch--rows
(mapcar (lambda (r) (cons (nth 0 r) (nth 1 r)))
(plist-get reply :watch)))
(flan-watch--paint
(flan-watch--format flan-watch--rows (plist-get reply :overflow))))
(_ (flan-watch--paint
(format "error:\n%s\n" (or (plist-get reply :message) "refused"))))))
(defun flan-watch--settle ()
"Collect an outstanding watch reply, blocking if it has not arrived.
Hung on `flan-dev-settle-hook', so an ordinary request never reads the watch
timer's reply as its own. Blocking here is fine and blocking in the tick is
not: this runs inside something a person asked for, which already waits, and
what it waits for is a table read with nothing compiled behind it."
(when flan-watch--pending
(setq flan-watch--pending nil)
(when-let* ((proc flan-dev--connection))
(when (process-live-p proc)
(ignore-errors (flan-watch--absorb (flan-dev--read-reply proc)))))))
(defun flan-watch--tick ()
"Collect the last reply if it has come, then ask again. Never blocks.
Deliberately not `flan-dev--request', which waits for its answer: a
synchronous call on a 0.2s timer stalls Emacs's UI every tick, and a timer is
the one caller that must not. So this takes whatever has already arrived and
sends the next question, leaving at most one request in flight — the invariant
`flan-dev-settle-hook' exists to keep."
(cond
;; The buffer is the subscription. Killing it stops the timer and disarms
;; the table, so a program whose watch buffer is closed is back to paying a
;; load and a branch per watch call.
((not (get-buffer flan-watch-buffer)) (flan-watch-stop))
((not (process-live-p flan-dev--connection))
(flan-watch--paint "error:\nnot connected to a running program\n")
(flan-watch-stop))
;; Something else owns the connection this instant — an evaluation is
;; mid-flight. Skipping is right: its `flan-dev-settle-hook' has already
;; taken any reply of ours, and the next tick is 0.2s away.
(flan-dev--busy nil)
(t
(when flan-watch--pending
(when-let* ((reply (flan-dev--take-reply flan-dev--connection)))
(setq flan-watch--pending nil)
(flan-watch--absorb reply)))
(unless flan-watch--pending
(condition-case nil
(progn (flan-dev--send flan-dev--connection '(:op "watch"))
(setq flan-watch--pending t))
(error (flan-watch-stop)))))))
;;; Commands
(define-derived-mode flan-watch-mode special-mode "flan-watch"
"Major mode for the pinned watch buffer."
(setq-local truncate-lines t))
;;;###autoload
(defun flan-watch ()
"Open the watch buffer and start painting the running program's values."
(interactive)
(flan-dev--live-connection)
;; Arming is a message, not something the daemon infers. The program is the
;; writer, so it has to be told somebody is looking — and while nobody is,
;; nothing writes the table at all, which is what makes a watch call in a
;; program nobody is debugging a load and a not-taken branch.
(let ((r (flan-dev--request '(:op "watch-enable" :on t))))
(unless (equal (plist-get r :status) "ok")
(user-error "flan: %s" (or (plist-get r :message) "watch refused"))))
(with-current-buffer (get-buffer-create flan-watch-buffer)
(unless (eq major-mode 'flan-watch-mode) (flan-watch-mode)))
;; Painted before the first reply, rather than left blank until one arrives.
;; An empty buffer is the same picture as a broken one, and the likeliest
;; reason for it here is the honest one — the program is not calling into the
;; table — which is worth saying in words rather than by showing nothing.
(flan-watch--paint (flan-watch--format nil 0))
(add-hook 'flan-dev-settle-hook #'flan-watch--settle)
(when flan-watch--timer (cancel-timer flan-watch--timer))
(setq flan-watch--timer
(run-with-timer 0 flan-watch-interval #'flan-watch--tick))
(display-buffer flan-watch-buffer))
(defun flan-watch-stop ()
"Stop painting, and tell the program to stop writing the table."
(interactive)
(when flan-watch--timer
(cancel-timer flan-watch--timer)
(setq flan-watch--timer nil))
;; Settle before disarming, or the disarm request reads the tick's reply.
(flan-watch--settle)
(remove-hook 'flan-dev-settle-hook #'flan-watch--settle)
;; Only on a connection that is already live, and this is the important half.
;; `flan-dev--request' *reconnects* — which is right for something a person
;; did and wrong here, because this is also called from the tick, and the
;; reason the tick calls it is that the connection has gone. Reconnecting
;; from a timer would quietly erase the `lost' state that exists to be seen,
;; which `flan-dev.el' already forbids for its own poll timer. And there is
;; nothing to disarm anyway: the table went with the program.
(when (process-live-p flan-dev--connection)
(ignore-errors (flan-dev--request '(:op "watch-enable" :on nil)))))
;;; Ghost text — not built, and what it would need
;; The author raised showing values *inline at the code they belong to* rather
;; than in a buffer of their own. It is a better picture and it is a different
;; feature, so it is written down here rather than half-done.
;;
;; What the buffer needs is a name and a string. Ghost text needs a *place*,
;; and nothing in the table has one: `(watch-i64 "ticks" ticks)' says what the
;; value is called, not where it was written. Three things would have to be
;; added, and the first is the real one:
;;
;; 1. A source location per entry. The runtime would have to carry a
;; file:line:col alongside the name, which means the *caller* supplies it,
;; which means the call site is generated rather than hand-written — i.e.
;; the `(watch ...)' form in the checker, which is where a form's own
;; location is already known. A declare-c call cannot do it: the program
;; would have to pass __FILE__ by hand and it would drift the moment the
;; line moved. So ghost text is gated on the same check.ml arm the
;; composite renderer is.
;;
;; 2. Overlays keyed to that location, with `after-string', refreshed on the
;; same timer. Cheap once (1) exists; the work is invalidating them when
;; the buffer is edited, since a line that moved leaves its overlay behind.
;;
;; 3. A rule for a watch inside a loop, which the buffer sidesteps by showing
;; the last value written. Inline, "the last of 4000 iterations" is
;; usually not the interesting one, and there is no obvious better answer
;; that does not become a UI for building a query — which is the thing
;; this design exists to avoid.
;;
;; (3) is why this is a question and not a task. (1) is why it cannot be
;; started here.
(provide 'flan-watch)
;;; flan-watch.el ends here

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

@ -13,6 +13,7 @@
(require 'flan-mode) (require 'flan-mode)
(require 'flan-dev) (require 'flan-dev)
(require 'flan-repl) (require 'flan-repl)
(require 'flan-watch)
(defvar test-flan--failures 0) (defvar test-flan--failures 0)
@ -534,6 +535,69 @@ is written instead — the real `message' call the real command makes."
(test-flan--check "and a name the program has not got is refused" (test-flan--check "and a name the program has not got is refused"
(and raised (string-match-p "no no-such-name" raised)))) (and raised (string-match-p "no no-such-name" raised))))
;; ── The watch buffer ──────────────────────────────────────────────────
;;
;; test_dev.ml proves the table itself: a program pushes and the daemon reads
;; it back without compiling anything. What is left to prove here is the
;; part that is only true in Emacs, and it is not the painting — it is that
;; an *asynchronous* sender and the ordinary synchronous request can share one
;; connection.
;;
;; The protocol is one reply per request on one socket. The watch timer
;; sends and does not wait, deliberately, because waiting on a 0.2s timer
;; stalls the UI. That leaves a reply in flight that the next C-c C-c would
;; read as its own — an evaluation reporting the watch table's answer, which
;; is the exact bug `flan-dev-settle-hook' exists to make impossible. This
;; program writes nothing into the table, which does not matter: the
;; interleaving is the claim.
(flan-watch)
(test-flan--check "the watch buffer opens" (get-buffer flan-watch-buffer))
(test-flan--check "and the timer is running" flan-watch--timer)
(test-flan--check "a program that watches nothing says so, rather than looking broken"
(with-current-buffer flan-watch-buffer
(string-match-p "nothing is being watched" (buffer-string))))
;; The tick by hand, so this does not depend on a timer firing inside a batch
;; run. Two of them: the first sends, the second collects and sends again.
(flan-watch--tick)
(test-flan--check "a tick leaves a request in flight rather than waiting for it"
flan-watch--pending)
;; And now the interleaving, with a reply outstanding on purpose. If the
;; settle hook were not there this would return the watch table's plist and
;; `flan-dev--report' would take its missing :status for a rejection.
;;
;; Back in the source buffer first: `flan-doc' and `flan-watch' above both
;; display buffers of their own, and C-c C-c reads the buffer it is run in.
(pop-to-buffer (flan-dev--buffer-visiting file))
(goto-char (point-min))
(search-forward "(defn step")
(goto-char (match-beginning 0))
(let ((said (test-flan--said (flan-eval-defun))))
(test-flan--check "an eval with a watch reply in flight still gets its own answer"
(and said (string-match-p "step" said)))
(test-flan--check "and the watch request was settled, not abandoned"
(null flan-watch--pending)))
(flan-watch--tick)
(flan-watch--tick)
(test-flan--check "and the buffer keeps painting afterwards"
(with-current-buffer flan-watch-buffer
(> (buffer-size) 0)))
;; Point survives a repaint. This is why `replace-buffer-contents' is used
;; rather than erase-and-insert: the latter would put the cursor back at the
;; top of the buffer on every tick, which makes the one thing you want to do
;; in a watch buffer — look at a line while the program runs — impossible.
(with-current-buffer flan-watch-buffer
(goto-char (point-max))
(let ((where (point)))
(flan-watch--tick)
(flan-watch--tick)
(test-flan--check "and point does not jump to the top on a repaint"
(= (point) where))))
(flan-watch-stop)
(test-flan--check "stopping cancels the timer" (null flan-watch--timer))
(test-flan--check "and takes the settle hook off with it"
(not (memq #'flan-watch--settle flan-dev-settle-hook)))
(kill-buffer flan-watch-buffer)
(flan-disconnect) (flan-disconnect)
(test-flan--check "disconnected" (not (process-live-p flan-dev--connection))) (test-flan--check "disconnected" (not (process-live-p flan-dev--connection)))
(test-flan--check "and the poll timer is cancelled with it" (test-flan--check "and the poll timer is cancelled with it"

84
lib/dev.ml
View File

@ -1581,6 +1581,81 @@ let disassemble t ~name ~form =
":text " ^ Wire.quote text ]) ":text " ^ Wire.quote text ])
| Error m -> error m | Error m -> error m
(* ── The watch table ───────────────────────────────────────────────── *)
(* Read the table the *program* fills, and arm and disarm it.
This op is the opposite shape from every other one here, and the reason is
worth stating because the obvious design is the wrong one. Everything else
in this file answers a question by *compiling something*: a locals listing,
an inspection, a globals section are each a thunk built from the types, sent
over, and run at a frame boundary. That is affordable at the rate a person
presses a key and ruinous at the rate a HUD refreshes — an evaluation here
is a module and a [dlopen], tens of milliseconds and a new .so in a
directory nothing sweeps, so a 5Hz poll is hundreds of shared objects a
minute.
So the program pushes instead. It calls [flan_dev_watch_*] from inside its
own loop, which renders the value and stores it under a name; this reads the
table, which is memory. Nothing is compiled, nothing is loaded, and the
answer is as cheap as [status].
Two things fall out of that which a poll could not have. The values update
at *frame rate* rather than at whatever the editor's timer is. And they are
still here while the program is *stopped* — a break loop is exactly when a
thunk cannot be run at a frame boundary, because there are no more frames,
and it is exactly when you want to see the last one's values. *)
(* On and off are a message rather than something inferred, because the writer
is the program: the table is untouched while it is off, which is what makes
a watch call in a program nobody is debugging a load and a not-taken branch.
See [flan_dev_watch_enable]. *)
let watch_enable t ~on =
match String.trim (request t (if on then "watch on" else "watch off")) with
| "ok" -> ok [ (if on then ":watching t" else ":watching nil") ]
| reply -> error ("the program refused the watch request: " ^ reply)
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e)
(* [NAME <tab> VALUE] per line, after a header of [COUNT DROPPED].
Tab is safe as the separator for [render_locals]'s reason: every string that
reaches a value goes through an emitter that escapes tab and newline, so
neither can appear inside one. [OVERFLOW] is carried rather than dropped —
a name that found no slot is a value that never appears, and a buffer that
said nothing about it would be lying by omission. It is a flag and not a
count on purpose: the only number available is of write *attempts* that
missed, which at frame rate says "3847 names" about one name. *)
let watch_read t =
match request t "watch" with
| text ->
let lines = String.split_on_char '\n' text in
(match lines with
| [] -> error "the program gave an empty watch reply"
| hdr :: rows when not (String.length hdr >= 3 && String.sub hdr 0 3 = "err")
->
let overflow =
match String.split_on_char ' ' (String.trim hdr) with
| [ _; d ] -> d <> "0"
| _ -> false
in
let pair line =
match String.index_opt line '\t' with
| None -> None
| Some i ->
Some
(Wire.list
[ Wire.quote (String.sub line 0 i);
Wire.quote
(String.sub line (i + 1) (String.length line - i - 1)) ])
in
ok
[ ":watch " ^ Wire.list (List.filter_map pair rows);
(if overflow then ":overflow t" else ":overflow nil") ]
| hdr :: _ -> error (String.trim hdr))
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e)
let handle t req = let handle t req =
match Wire.string_field req "op" with match Wire.string_field req "op" with
| Some "eval" -> | Some "eval" ->
@ -1667,6 +1742,15 @@ let handle t req =
| Some index -> choose_at t ~index ~name:(Wire.string_field req "name") | Some index -> choose_at t ~index ~name:(Wire.string_field req "name")
| None -> error "restart-at needs :index") | None -> error "restart-at needs :index")
| Some "abort" -> abort t | Some "abort" -> abort 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. *)
| Some "watch-enable" ->
watch_enable t
~on:(match Wire.field req "on" with
| Some { Form.v = Form.Sym "nil"; _ } | None -> false
| Some _ -> true)
| Some "watch" -> watch_read t
| Some "disassemble" -> | Some "disassemble" ->
(match Wire.string_field req "name" with (match Wire.string_field req "name" with
| Some name -> | Some name ->

374
runtime/flan_dev.c
View File

@ -311,6 +311,380 @@ int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen,
return 0; return 0;
} }
/* ── The watch table ────────────────────────────────────────────────── */
/* A HUD, pushed rather than polled, and the push is why it exists at all.
*
* The watch buffer's obvious shape is the one the author's Clojure version
* has: Emacs polls a render function on a timer and paints what it returns.
* That does not port. Here an evaluation *compiles a module and dlopens it* —
* tens of milliseconds and a new .so each time, in a directory nothing sweeps
* — so a 5Hz poll is hundreds of shared objects a minute for a value that was
* already sitting in a register.
*
* So the direction is inverted. The program writes: it calls
* [flan_dev_watch_*] from inside its own loop, which renders the value to text
* and stores it under a name. Emacs reads the *table*, which is memory. Both
* halves are cheap for opposite reasons, the values update at frame rate
* rather than at timer rate, and — the part a poll cannot do at all — the last
* frame's values are still here while the program is stopped in a break loop,
* because nothing has to run to produce them.
*
* Everything below is written for one caller: the game thread, mid-frame.
* That is the same constraint the rest of this file is under and it is
* stricter here, because this runs every frame rather than once per
* evaluation:
*
* - No allocation. Names are fixed char arrays inside the table, not
* strdup'd the way [intern] above does it. [intern] runs at module load
* and may malloc; this runs at 60fps and may not.
* - No lock. The reader is the agent's listener thread and the writer is the
* game thread; neither waits for the other.
* - No call into OCaml, which is the rule that keeps the collector off the
* frame thread. Nothing here is OCaml.
*
* Deliberately NOT sharing [result] and [generation] above. It was tempting —
* the renderers are the same shape — and it is wrong: [result] is written once
* per C-x C-e and this is written every frame, so watch traffic would overwrite
* the value of every expression anyone evaluated. The two are separate storage
* with separate counters and that is not an accident.
*/
/* The three bounds, and what happens past each one.
*
* [WATCH_MAX] slots. Past it, a name is **dropped**, not fatal. The house
* style elsewhere in this file is [die], and this is the one place it would be
* wrong: a watch is a diagnostic, and killing the program because somebody
* watched a 65th value is the diagnostic shooting the patient. It is not
* silent either — [flan_dev_watch_overflowed] is read back with the table and
* the buffer says so, so an overflow is visible rather than a value that
* mysteriously never appears.
*
* A flag and **not a count**, which is the correction worth recording. A
* counter here would be incremented from the write path, and the write path
* runs once per watched value per *frame* — so one name too many at 60fps
* reads back as "3847 names found no slot" within a minute, which is a false
* sentence about a true problem. What a reader needs is "the table is full and
* something is not being shown", which is one bit, and one bit cannot drift
* into a wrong number. Counting *distinct* names that missed would mean
* remembering which ones had, which is exactly the bookkeeping the frame
* thread has no room for.
*
* [WATCH_NAME] bytes of name, [WATCH_VAL] bytes of rendered value. Both
* truncate; the value's truncation shows as an ellipsis, the same as
* [result_end] does, so a clipped value does not read as a complete one. */
#define WATCH_MAX 64
#define WATCH_NAME 32
#define WATCH_VAL 192
typedef struct {
char name[WATCH_NAME]; /* NUL-terminated, truncated to fit */
char val[WATCH_VAL];
uint32_t len;
int full; /* the value did not fit */
uint64_t gen; /* this slot's own seqlock */
} watch_slot;
static watch_slot watch_table[WATCH_MAX];
static uint32_t watch_used; /* claimed slots; only ever grows */
static int watch_overflowed; /* some name found no slot; see above */
/* One counter per slot rather than one for the table.
*
* A table-wide counter would make a read all-or-nothing: the reader would have
* to copy every slot inside a single even generation, which means catching the
* gap *between* two frames' worth of writes — a window that at 60fps is
* whatever the game does after its last watch call, and may be nothing.
* Per-slot, the reader retries one slot at a time and always gets somewhere,
* and the worst it can produce is a snapshot whose entries come from adjacent
* frames. For a HUD that is not a defect: a frame counter one ahead of a
* position read a millisecond earlier is what a HUD looks like anyway. It
* would be a defect for anything where two values have to agree, and if that
* is ever wanted it is a different op, not a bigger counter. */
/* Is anyone looking?
*
* Set when a watch buffer opens and cleared when it closes, so the cost of a
* watch call in a program nobody is debugging is one relaxed load and a
* not-taken branch. That is what "watching costs nothing when nobody is
* watching" means here, and it is the same number in a dev build and a release
* build — [flan_dev.c] is linked into both (see [Build], which says why) so the
* symbols resolve either way and there is no second version of this file.
*
* What it is *not*: free. Eliding the call entirely needs the compiler to know
* the form, which is a [check.ml] arm this does not have. A load and a branch
* per watched value per frame is the honest number, and it is the same number
* in both builds rather than a dev-only tax. */
static int watch_on;
void flan_dev_watch_enable(int on) {
__atomic_store_n(&watch_on, on ? 1 : 0, __ATOMIC_RELAXED);
}
int flan_dev_watch_enabled(void) {
return __atomic_load_n(&watch_on, __ATOMIC_RELAXED);
}
/* The slot a name owns, or NULL if the table is full.
*
* Linear, because the table is 64 long and a hash would need a policy for
* collisions that a scan does not. A HUD with twenty values does twenty
* strcmps of a handful of bytes per frame; if that ever shows up in a profile
* the answer is to watch fewer things.
*
* [watch_used] only ever grows and a slot's name never changes once set, so a
* reader can walk [0, watch_used) without synchronising against this: the
* worst it sees is a slot whose name is written and whose value is not yet,
* which that slot's own seqlock catches. */
static watch_slot *watch_find(const char *name) {
uint32_t used = __atomic_load_n(&watch_used, __ATOMIC_RELAXED);
for (uint32_t i = 0; i < used; i++)
if (strncmp(watch_table[i].name, name, WATCH_NAME - 1) == 0)
return &watch_table[i];
if (used == WATCH_MAX) {
__atomic_store_n(&watch_overflowed, 1, __ATOMIC_RELAXED);
return NULL;
}
watch_slot *s = &watch_table[used];
size_t n = strlen(name);
if (n > WATCH_NAME - 1) n = WATCH_NAME - 1;
memcpy(s->name, name, n);
s->name[n] = '\0';
s->len = 0;
s->full = 0;
/* Published last, so a reader that sees this index sees a finished name. */
__atomic_store_n(&watch_used, used + 1, __ATOMIC_RELEASE);
return s;
}
/* The slot the emitters below are writing into. A plain static and not an
* atomic, because begin/emit/end is one uninterrupted run on the one thread
* that writes — the same assumption [result_len] above is written under. */
static watch_slot *watch_cur;
/* Open a slot for writing; 0 if nobody is watching or the table is full, in
* which case the emitters below are no-ops and the caller need not branch.
*
* Odd first, then the reset, for [flan_dev_result_begin]'s reason: the counter
* has to say "in progress" before the buffer stops being the value it used to
* be, and a release *store* orders only what precedes it, so the fence is the
* half it cannot do. Setting the low bit rather than incrementing means a
* begin whose end never runs — a break taken inside a render — is repaired by
* the next write rather than poisoning the slot for the life of the process. */
int flan_dev_watch_begin(const char *name) {
if (!__atomic_load_n(&watch_on, __ATOMIC_RELAXED)) { watch_cur = NULL; return 0; }
watch_slot *s = watch_find(name);
watch_cur = s;
if (s == NULL) return 0;
__atomic_store_n(&s->gen, s->gen | 1, __ATOMIC_RELAXED);
__atomic_thread_fence(__ATOMIC_RELEASE);
s->len = 0;
s->full = 0;
return 1;
}
void flan_dev_watch_emit(const uint8_t *bytes, int64_t len) {
watch_slot *s = watch_cur;
if (s == NULL) return;
size_t n = len < 0 ? 0 : (size_t)len;
if (s->len + n > WATCH_VAL) {
n = WATCH_VAL - s->len;
s->full = 1;
}
memcpy(s->val + s->len, bytes, n);
s->len += (uint32_t)n;
}
static void watch_cstr(const char *str) {
flan_dev_watch_emit((const uint8_t *)str, (int64_t)strlen(str));
}
void flan_dev_watch_emit_i64(int64_t x) {
char buf[32];
snprintf(buf, sizeof buf, "%lld", (long long)x);
watch_cstr(buf);
}
void flan_dev_watch_emit_u64(uint64_t x) {
char buf[32];
snprintf(buf, sizeof buf, "%llu", (unsigned long long)x);
watch_cstr(buf);
}
void flan_dev_watch_emit_f64(double x) {
char buf[64];
snprintf(buf, sizeof buf, "%g", x);
watch_cstr(buf);
}
/* Quoted and escaped, for [flan_dev_emit_str]'s reason and one more: a string
* whose content is not escaped does not round-trip, and a newline in one would
* become a second row of the table on the wire rather than part of a value. */
void flan_dev_watch_emit_str(const uint8_t *bytes, int64_t len) {
size_t n = len < 0 ? 0 : (size_t)len;
watch_cstr("\"");
for (size_t i = 0; i < n; i++) {
unsigned char c = bytes[i];
switch (c) {
case '"': watch_cstr("\\\""); break;
case '\\': watch_cstr("\\\\"); break;
case '\n': watch_cstr("\\n"); break;
case '\t': watch_cstr("\\t"); break;
case '\r': watch_cstr("\\r"); break;
default:
if (c < 0x20) {
char buf[8];
snprintf(buf, sizeof buf, "\\x%02x", c);
watch_cstr(buf);
} else {
flan_dev_watch_emit(&c, 1);
}
}
}
watch_cstr("\"");
}
void flan_dev_watch_end(void) {
watch_slot *s = watch_cur;
watch_cur = NULL;
if (s == NULL) return;
if (s->full) {
/* Room is made for it rather than assumed: the value is full by
* definition when this fires. */
const char *ell = "...";
size_t k = strlen(ell);
if (s->len > WATCH_VAL - k) s->len = (uint32_t)(WATCH_VAL - k);
memcpy(s->val + s->len, ell, k);
s->len += (uint32_t)k;
}
/* Last, and back to even, so a reader that sees the new generation sees the
* whole value. [| 1] first for the same reason begin sets rather than
* increments: this must land on an even count whatever an abandoned write
* left behind. */
__atomic_store_n(&s->gen, (s->gen | 1) + 1, __ATOMIC_RELEASE);
}
/* ── Watching one scalar, with no compiler change ───────────────────── */
/* These are the whole feature for a scalar, and they are what a program can
* use today:
*
* (declare-c watch-i64 [name string x i64] i32 "flan_dev_watch_i64")
* ...
* (watch-i64 "ticks" ticks)
*
* No arm in the checker, no new special form, nothing the compiler has to
* learn — which is the point, because the checker is not a file this change
* owns.
*
* They return i32 rather than nothing for a blunt reason: [declare-c] refuses
* a void return outright — "which is not a value C can carry", shim.ml — so a
* function a program can declare has to return something. Since it must, it
* returns the useful thing: 1 if the value was written, 0 if it was not,
* which is either nobody watching or a full table. A caller is free to ignore
* it and normally does.
*
* A composite — a struct, a slice, a union — cannot be done this way, and that
* is not a shortcoming of these four: a Flan value carries no header, so
* nothing at run time can say what it is, and rendering one is a compile-time
* walk over its *type*. The walk already exists — [Render.render] — and the
* four [flan_dev_watch_emit_*] above are the emitter it would be pointed at,
* shaped exactly like the [print] arm's. What is missing is the
* [(watch "hp" hp)] arm in check.ml that joins the two, which is a file this
* change does not own. BUILT.md says what that arm is. */
int32_t flan_dev_watch_i64(const char *name, int64_t x) {
if (!flan_dev_watch_begin(name)) return 0;
flan_dev_watch_emit_i64(x);
flan_dev_watch_end();
return 1;
}
int32_t flan_dev_watch_u64(const char *name, uint64_t x) {
if (!flan_dev_watch_begin(name)) return 0;
flan_dev_watch_emit_u64(x);
flan_dev_watch_end();
return 1;
}
int32_t flan_dev_watch_f64(const char *name, double x) {
if (!flan_dev_watch_begin(name)) return 0;
flan_dev_watch_emit_f64(x);
flan_dev_watch_end();
return 1;
}
int32_t flan_dev_watch_str(const char *name, const char *s) {
if (!flan_dev_watch_begin(name)) return 0;
flan_dev_watch_emit_str((const uint8_t *)s, (int64_t)strlen(s));
flan_dev_watch_end();
return 1;
}
/* ── Reading the table back ─────────────────────────────────────────── */
/* How many slots have ever been claimed. Only grows, so a reader walking
* [0, n) is walking names that are all finished. */
uint32_t flan_dev_watch_count(void) {
return __atomic_load_n(&watch_used, __ATOMIC_ACQUIRE);
}
/* Whether any name ever found no slot. Never cleared: a table that overflowed
* once is a table whose contents are incomplete, and a name that was refused a
* slot does not get one later. */
int flan_dev_watch_overflowed(void) {
return __atomic_load_n(&watch_overflowed, __ATOMIC_RELAXED);
}
/* Copy slot [i] out: its name into [nd], its value into [vd].
*
* Returns 1 having copied a value that was complete for the whole of the copy,
* 0 if the game thread was in the middle of writing one — in which case [vlen]
* is 0 and the caller keeps whatever it showed last, which for a HUD is the
* right failure: a value that flickers to blank for one tick is worse than one
* that is a frame stale.
*
* The name needs no seqlock. It is written once, before [watch_used] is
* published with a release store, and never again.
*
* The copy is what makes this safe, and the API is shaped around it: the
* caller gets bytes of its own, never a pointer into the table. A seqlock
* cannot validate a read that happens after it returns — the bug
* [flan_dev_result_read] was rewritten for. */
int flan_dev_watch_read(uint32_t i, char *nd, uint64_t ncap,
char *vd, uint64_t vcap, uint64_t *vlen) {
*vlen = 0;
if (i >= __atomic_load_n(&watch_used, __ATOMIC_ACQUIRE)) return 0;
watch_slot *s = &watch_table[i];
if (ncap > 0) {
size_t n = strlen(s->name);
if (n > ncap - 1) n = (size_t)ncap - 1;
memcpy(nd, s->name, n);
nd[n] = '\0';
}
for (int attempt = 0; attempt < 64; attempt++) {
uint64_t g1 = __atomic_load_n(&s->gen, __ATOMIC_ACQUIRE);
if (g1 & 1) continue; /* a write is in progress */
size_t n = __atomic_load_n(&s->len, __ATOMIC_RELAXED);
if (n > WATCH_VAL) n = WATCH_VAL; /* a torn read cannot overrun */
if ((uint64_t)n > vcap) n = (size_t)vcap;
memcpy(vd, s->val, n);
/* Ordered before the second read of the counter, or the check is of a copy
* the compiler was free to make afterwards. */
__atomic_thread_fence(__ATOMIC_ACQUIRE);
if (__atomic_load_n(&s->gen, __ATOMIC_ACQUIRE) == g1) {
*vlen = (uint64_t)n;
return 1;
}
}
return 0;
}
/* What a caller's buffers have to be for a copy never to be truncated. Asked
* for rather than written down twice, the same as [flan_dev_result_cap]. The
* value's is [WATCH_VAL] plus the ellipsis [end] may append. */
uint64_t flan_dev_watch_name_cap(void) { return WATCH_NAME; }
uint64_t flan_dev_watch_val_cap(void) { return WATCH_VAL + 4; }
/* ── The shadow stack ───────────────────────────────────────────────── */ /* ── The shadow stack ───────────────────────────────────────────────── */
/* plan.org's "Dev vs release builds" has had *Frames: shadow stack* in the dev /* plan.org's "Dev vs release builds" has had *Frames: shadow stack* in the dev

38
test/programs/dev-watch.flan Normal file
View File

@ -0,0 +1,38 @@
;;;; A program that pushes values into the watch table from its own loop.
;;;;
;;;; The point of the case is that this needs no compiler change: the watch
;;;; entry points are ordinary C functions, so a program reaches them through
;;;; [declare-c] the same way it reaches anything else in the runtime. That is
;;;; deliberate — a [(watch "hp" hp)] form would be an arm in the checker, and
;;;; a scalar does not need one.
;;;;
;;;; The values are written every iteration and are *not* read back from here.
;;;; What reads them is the daemon's [watch] op, over the agent, while this
;;;; program is still running — which is the whole design: the program pushes
;;;; at frame rate and the editor reads memory.
(import agent "vendor:agent")
(declare-c watch-i64 [name string x i64] i32 "flan_dev_watch_i64")
(declare-c watch-f64 [name string x f64] i32 "flan_dev_watch_f64")
(declare-c watch-str [name string s string] i32 "flan_dev_watch_str")
(defvar ticks i64)
(defn step [] i64
(set ticks (+ ticks 1))
;; Three types, because the table stores *rendered text* and the rendering
;; is per type: an i64 and an f64 do not print the same way, and a string is
;; quoted and escaped so that a newline in one cannot become a second row.
(watch-i64 "ticks" ticks)
(watch-f64 "half" (/ (f64 ticks) 2.0))
(watch-str "label" "sand")
ticks)
(defn main [] i32
(agent/start "/tmp/flan-dev-watch-fallback.sock")
;; A watch call costs a load and a not-taken branch until somebody opens a
;; watch buffer, so spinning here writes nothing until the test arms it.
(while (= (agent/wait 20) 0) (step))
(step)
(while (= (agent/wait 20) 0) (step))
0)

100
test/test_dev.ml
View File

@ -1745,6 +1745,106 @@ let () =
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ gsock; gout ] List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ gsock; gout ]
end; end;
(* ── The watch table ───────────────────────────────────────────── *)
(* The claim being tested is the one that makes the watch buffer possible
at all: values reach the editor *without anything being compiled*.
Every other listing here — locals, globals, inspect — is a thunk built
from the types, sent over and run at a frame boundary, which is fine at
the rate a person presses a key and ruinous at the rate a HUD refreshes.
This op compiles nothing. The program pushes into a table from inside
its own loop and the daemon reads memory.
Four things in order: nothing is written while nobody is watching; a
value appears once the table is armed; the *rendering* is per type, so
an f64 and a string do not come back looking like the i64 beside them;
and disarming stops it again. The first and the last are the ones that
make watching free when a watch buffer is closed, which is the whole
reason arming is a message rather than something inferred. *)
let wsock = tmp "watch.sock" and wout = tmp "watch.out" in
(try Sys.remove wsock with Sys_error _ -> ());
let wfd =
Unix.openfile wout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
in
let wpid =
Unix.create_process flan
[| flan; "dev"; "programs/dev-watch.flan"; "-s"; wsock |]
Unix.stdin wfd Unix.stderr
in
Unix.close wfd;
if not (await (fun () -> Sys.file_exists wsock)) then
fail "the watch daemon never listened"
else begin
let wc = connect wsock in
let ask q = Wire.parse (Wire.send wc q; Wire.recv wc) in
let table () =
match Wire.field (ask "(:op \"watch\")") "watch" with
| Some { Form.v = Form.List rows; _ } ->
List.filter_map
(fun (r : Form.t) ->
match r.Form.v with
| Form.List [ { Form.v = Form.Str n; _ };
{ Form.v = Form.Str v; _ } ] -> Some (n, v)
| _ -> None)
rows
| _ -> []
in
(* Nothing yet, and this is not "the program has not got there" — the
loop has been running since before the socket existed. The table is
empty because a watch call with nobody watching writes nothing, which
is what "it costs nothing when nobody is looking" means. *)
if table () <> [] then
fail "the watch table had values before anything armed it";
if status (ask "(:op \"watch-enable\" :on t)") <> "ok" then
fail "watch-enable was refused";
(* Waiting on the *program*, not on the daemon. Arming is immediate; a
value appearing means the game thread has been round its loop since,
which is the hand-off this whole design turns on. *)
if not (await (fun () -> List.mem_assoc "ticks" (table ()))) then
fail "no value ever reached the watch table"
else begin
let t = table () in
(* Per type, because the table stores rendered text and nothing at run
time could say what a Flan value is. An i64 with a decimal point in
it, or a string without its quotes, would mean one renderer had been
used for all three. *)
(match List.assoc_opt "ticks" t with
| Some v when int_of_string_opt v <> None -> ()
| Some v -> fail "watch rendered an i64 as %s" v
| None -> fail "watch lost the i64");
(match List.assoc_opt "half" t with
| Some v when float_of_string_opt v <> None -> ()
| Some v -> fail "watch rendered an f64 as %s" v
| None -> fail "watch lost the f64");
(match List.assoc_opt "label" t with
| Some "\"sand\"" -> ()
| Some v -> fail "watch rendered a string as %s, unquoted" v
| None -> fail "watch lost the string");
(* It keeps moving. A table that filled once and froze would pass
everything above and be useless — the counter has to be the
program's, not a snapshot the daemon took when it armed. *)
let first = List.assoc "ticks" t in
if not (await (fun () ->
match List.assoc_opt "ticks" (table ()) with
| Some v -> v <> first
| None -> false))
then fail "the watch table stopped moving";
(* And off again. The value already in a slot stays — nothing clears
it — but the program stops writing, so it stops changing. *)
if status (ask "(:op \"watch-enable\" :on nil)") <> "ok" then
fail "watch-enable :on nil was refused";
let frozen = List.assoc_opt "ticks" (table ()) in
ignore (Unix.select [] [] [] 0.2);
if List.assoc_opt "ticks" (table ()) <> frozen then
fail "the program kept writing the watch table after it was disarmed"
end;
ignore (ask "(:op \"close\")");
Unix.close wc
end;
(try Unix.kill wpid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] wpid) with Unix.Unix_error _ -> ());
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ wsock; wout ];
(* ── The escape hatch, which still has to work ─────────────────── *) (* ── The escape hatch, which still has to work ─────────────────── *)
(* [--two-process] is the old shape: a compiler process that builds the (* [--two-process] is the old shape: a compiler process that builds the

67
vendor/agent/flan_agent.c vendored
View File

@ -75,6 +75,20 @@ int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen,
uint64_t *len); uint64_t *len);
uint64_t flan_dev_result_cap(void); uint64_t flan_dev_result_cap(void);
/* The watch table, same arrangement and for the same reason: the game thread
* writes it mid-frame into fixed storage that belongs to flan_dev.c, and this
* file only ever copies out of it, on the listener thread. The one addition is
* [enable] — the table is written only while somebody is reading it, so
* opening and closing a watch buffer is a message that arrives here. */
void flan_dev_watch_enable(int on);
int flan_dev_watch_enabled(void);
uint32_t flan_dev_watch_count(void);
int flan_dev_watch_overflowed(void);
int flan_dev_watch_read(uint32_t i, char *nd, uint64_t ncap,
char *vd, uint64_t vcap, uint64_t *vlen);
uint64_t flan_dev_watch_name_cap(void);
uint64_t flan_dev_watch_val_cap(void);
/* A ring the listener writes and the game thread reads. One producer, one /* A ring the listener writes and the game thread reads. One producer, one
* consumer, so two atomics and no lock — the game thread must never block on * consumer, so two atomics and no lock — the game thread must never block on
* the loader. * the loader.
@ -869,6 +883,59 @@ static void handle_line(char *line, sink *o) {
atomic_store(&aborting, 1); atomic_store(&aborting, 1);
return; return;
} }
/* "watch on" / "watch off" arm and disarm the table; bare "watch" reads it.
*
* Arming is a message rather than something the daemon infers, because the
* program is the writer and it has to be told. Nothing writes the table
* while it is off, which is the whole of "watching costs nothing when nobody
* is watching" — see flan_dev.c. */
if (strcmp(line, "watch on") == 0 || strcmp(line, "watch off") == 0) {
flan_dev_watch_enable(line[6] == 'o' && line[7] == 'n');
reply(o, "ok\n");
return;
}
if (strcmp(line, "watch") == 0) {
/* One line per slot: NAME<tab>VALUE. The name cannot contain a tab — it is
* a C identifier-ish string the program passed — and the value cannot
* contain a raw tab or newline, because everything that reaches it goes
* through an emitter that escapes both. So no framing is needed beyond
* this, which is the same bet render_locals makes on the same grounds.
*
* A header first: the count actually written, and how many names were
* whether any name ever found no slot, so an overflow is reported rather
* than showing up as a value that never appears. A flag rather than a
* count, because the count would be of *writes* — see flan_dev.c. */
uint64_t ncap = flan_dev_watch_name_cap();
uint64_t vcap = flan_dev_watch_val_cap();
char *nb = malloc((size_t)ncap + 1);
char *vb = malloc((size_t)vcap + 1);
if (nb == NULL || vb == NULL) {
free(nb); free(vb);
reply(o, "err out of memory reading the watch table\n");
return;
}
/* Allocating here is fine, for [result]'s reason: this is the listener
* thread. The table the game thread writes is a fixed static. */
uint32_t n = flan_dev_watch_count();
char hdr[64];
int k = snprintf(hdr, sizeof hdr, "%lu %d\n", (unsigned long)n,
flan_dev_watch_overflowed());
if (k > 0) emit(o, hdr, (size_t)k);
for (uint32_t i = 0; i < n; i++) {
uint64_t vlen = 0;
/* A torn slot is *still listed*, with an empty value. Dropping the row
* would make the buffer's rows move under the reader every time the
* game happened to be mid-write, which is far worse to look at than one
* value that is blank for a tick. */
flan_dev_watch_read(i, nb, ncap, vb, vcap, &vlen);
emit(o, nb, strlen(nb));
emit(o, "\t", 1);
if (vlen > 0) emit(o, vb, (size_t)vlen);
emit(o, "\n", 1);
}
free(nb); free(vb);
return;
}
if (strcmp(line, "result") == 0) { if (strcmp(line, "result") == 0) {
uint64_t gen = 0, len = 0; uint64_t gen = 0, len = 0;
uint64_t cap = flan_dev_result_cap(); uint64_t cap = flan_dev_result_cap();