The watch window pushes, because a poll cannot answer a stopped program
This commit is contained in:
commit
88e6fd9fe5
145
BUILT.md
145
BUILT.md
@ -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
|
||||
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 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
43
NEXT.md
@ -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
|
||||
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
|
||||
original; read it first. Its design, and the parts to keep:
|
||||
~~**A watch window, ported from the author's Clojure one.**~~ **Built.** See `BUILT.md`, "The watch window, and why
|
||||
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
|
||||
returns. There is no watch-expression machinery, no per-variable registration, no UI for building a query. The user
|
||||
writes a function in the game.
|
||||
- **Async, not synchronous.** A sync request on a 0.2s timer blocks Emacs's UI thread 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 tick; erasing yanks
|
||||
the cursor to the top five times a second.
|
||||
- Nothing is appended — the buffer is always the current snapshot.
|
||||
**The design written here was superseded, and the correction is the interesting part.** This entry said the answer to
|
||||
an expensive eval was to **compile the watch thunk once and re-invoke it cheaply per tick**. That is the right
|
||||
instinct about the cost and it is still a *poll*, and a poll has a defect that caching cannot fix: it cannot answer
|
||||
while the program is **stopped**. A thunk runs at a frame boundary and a stopped program has no more frame boundaries
|
||||
— which is exactly the moment you most want to see what the last frame held. So the direction was reversed instead:
|
||||
the program calls into a table from inside its own loop and Emacs reads the table, which is memory rather than an
|
||||
evaluation. That also made the values update at *frame* rate rather than at the timer's, which the compile-once poll
|
||||
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`
|
||||
*compiles a module and `dlopen`s it* — tens of milliseconds and a new `.so` each time, in a directory nothing sweeps.
|
||||
Polling at 5Hz would produce hundreds of shared objects a minute. So **the watch thunk must be compiled once and then
|
||||
called repeatedly**, which makes this a daemon feature rather than something the Emacs side can do alone: a `watch`
|
||||
op that compiles on first use and a cheap re-invoke per tick.
|
||||
**What was not built, deliberately: the `(watch "hp" hp)` form.** Scalars work today through `declare-c` against four
|
||||
runtime entry points, which needs no compiler change at all. A struct or a slice needs a compile-time walk over its
|
||||
type — one arm in `check.ml` beside `print`, which `BUILT.md` writes out in full — and that file is held by another
|
||||
lane, so it was left alone rather than reached into.
|
||||
|
||||
The author also raised **ghost text** as an alternative or addition to a dedicated buffer — values shown inline at the
|
||||
code they belong to. Not designed; the buffer is the port, ghost text is a further question.
|
||||
**Ghost text is gated on that same arm**, which is the finding worth keeping. It was raised here as an alternative or
|
||||
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
|
||||
a walk, and why neither subsumes the other". It went in as a frame and a slot *index* rather than an address and a
|
||||
|
||||
@ -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
|
||||
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
|
||||
@ -395,7 +452,7 @@ Use `C-c C-g` if you need frames.
|
||||
| `M-.` / `M-,` | where a name is written / back |
|
||||
|
||||
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-daemon-buffer` | `"*flan-dev*"` | the daemon's own log |
|
||||
| `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-dev.el` | the client — the socket, evaluation, xref, eldoc, completion |
|
||||
| `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-inspect.el` | the value inspector |
|
||||
| `flan-dape.el` | lldb through dape; optional |
|
||||
|
||||
@ -87,6 +87,37 @@ reply that request was waiting for.")
|
||||
(let* ((payload (encode-coding-string (prin1-to-string form) 'utf-8 t)))
|
||||
(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)
|
||||
"Block until PROC sends one complete framed message, and read it."
|
||||
(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)
|
||||
(< (float-time) deadline))
|
||||
(accept-process-output proc 0.05))
|
||||
(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)))))
|
||||
(flan-dev--extract-reply body-start n)))))
|
||||
|
||||
(defun flan-dev--append-output (text)
|
||||
"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))))
|
||||
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)
|
||||
"Send FORM to the connected program and return its reply."
|
||||
(let* ((proc (flan-dev--live-connection))
|
||||
(flan-dev--busy t))
|
||||
(run-hooks 'flan-dev-settle-hook)
|
||||
(flan-dev--absorb (progn (flan-dev--send proc form)
|
||||
(flan-dev--read-reply proc)))))
|
||||
|
||||
|
||||
276
emacs/flan-watch.el
Normal file
276
emacs/flan-watch.el
Normal 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
|
||||
@ -13,6 +13,7 @@
|
||||
(require 'flan-mode)
|
||||
(require 'flan-dev)
|
||||
(require 'flan-repl)
|
||||
(require 'flan-watch)
|
||||
|
||||
(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"
|
||||
(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)
|
||||
(test-flan--check "disconnected" (not (process-live-p flan-dev--connection)))
|
||||
(test-flan--check "and the poll timer is cancelled with it"
|
||||
|
||||
84
lib/dev.ml
84
lib/dev.ml
@ -1581,6 +1581,81 @@ let disassemble t ~name ~form =
|
||||
":text " ^ Wire.quote text ])
|
||||
| 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 =
|
||||
match Wire.string_field req "op" with
|
||||
| Some "eval" ->
|
||||
@ -1667,6 +1742,15 @@ 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
|
||||
(* [: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" ->
|
||||
(match Wire.string_field req "name" with
|
||||
| Some name ->
|
||||
|
||||
@ -311,6 +311,380 @@ int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen,
|
||||
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 ───────────────────────────────────────────────── */
|
||||
|
||||
/* plan.org's "Dev vs release builds" has had *Frames: shadow stack* in the dev
|
||||
|
||||
38
test/programs/dev-watch.flan
Normal file
38
test/programs/dev-watch.flan
Normal 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
100
test/test_dev.ml
@ -1745,6 +1745,106 @@ let () =
|
||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ gsock; gout ]
|
||||
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 ─────────────────── *)
|
||||
|
||||
(* [--two-process] is the old shape: a compiler process that builds the
|
||||
|
||||
67
vendor/agent/flan_agent.c
vendored
67
vendor/agent/flan_agent.c
vendored
@ -75,6 +75,20 @@ int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen,
|
||||
uint64_t *len);
|
||||
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
|
||||
* consumer, so two atomics and no lock — the game thread must never block on
|
||||
* the loader.
|
||||
@ -869,6 +883,59 @@ static void handle_line(char *line, sink *o) {
|
||||
atomic_store(&aborting, 1);
|
||||
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) {
|
||||
uint64_t gen = 0, len = 0;
|
||||
uint64_t cap = flan_dev_result_cap();
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user