diff --git a/NEXT.md b/NEXT.md index 3c605b8..705d346 100644 --- a/NEXT.md +++ b/NEXT.md @@ -1,10 +1,15 @@ # Where this is -**Dev loop steps 1 and 2 are done** — see *The reload primitive* below. A list +**Dev loop steps 1, 2 and 3 are done** — see *The reload primitive* below. A list of top-level forms can be recompiled and installed into a running process; call sites compiled before they existed follow them, and a `defn` or `defvar` the process was never built with can be added and then redefined again. That is the -whole of `C-c C-c`, minus an editor and a frame boundary. +whole of `C-c C-c`, minus an editor: sand.flan takes a redefinition over a +socket and installs it between frames. + +What is left is the *session* — something that holds the checker environment +between evaluations, tracks which names the running process was built with, and +speaks a protocol an editor can talk to. Milestone 4 is done: **sand.flan builds, links raylib and runs**, and its simulation has a headless acceptance case that runs on the `dune test` path at @@ -32,11 +37,13 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅ | `runtime/flan_rt.c` | the host ABI: argv, stdout, exit, 4 conversions | | `runtime/flan_dev.c` | **dev only: the by-name registry a run-time-new name needs** | | `vendor/raylib/` | **the raylib package: `raylib.flan`, `shim.c`, `link`** | +| `vendor/agent/` | **the dev agent: a socket, a loader thread, install at a frame boundary** | | `sand-sim/` | **the falling-sand simulation, with no raylib in it** | -| `bin/main.ml` | `flan read \| parse \| check \| emit \| build \| run` | +| `bin/main.ml` | `flan read \| parse \| check \| emit \| build \| run \| reload` | | `test/test_flan.ml` | reader, parser and checker | | `test/test_acceptance.ml` | expression/result pairs + whole programs + the traps | | `test/test_reload.ml` | **the reload primitive: recompile one function, load it, call it** | +| `test/test_agent.ml` | **a running program taking a redefinition over a socket** | | `test/reload_host.c` | the C host that loads and installs two rebuilds, in one process | ``` @@ -454,10 +461,51 @@ Sizes are spelled LLVM's way — `ptrtoint (ptr getelementptr (T, ptr null, i32 1) to i64)` — rather than by a layout calculator in OCaml that would have to agree with LLVM's on every target. +### The agent — dev loop step 3 + +`vendor/agent/` is a package like any other: `agent.flan` declares three calls, +`flan_agent.c` implements them, `link` asks for `-lpthread`. + +``` +(agent/start path) listen on a unix socket; once, at startup +(agent/poll) install whatever has arrived; returns how many +(agent/wait ms) the same, but waits for something first +``` + +The split between them is the design. `dlopen` relocates a module and takes the +loader lock — milliseconds, unbounded — so it happens on the listener thread. +`flan_reload_install` is one store per function and must not land while a +redefined function is on the stack, so it happens on the game thread, at the +top of the frame, when the program asks. The two are connected by a +single-producer/single-consumer ring and two atomics; the game thread never +blocks on the loader. + +`wait` exists for tests. A test that races the frame rate fails on a loaded +machine, so `test/programs/agent.flan` waits for the reload instead of sleeping +past it. + +Two details found by running it: + +- **The reply goes out before the module is queued.** The other way round, the + game thread can install and the program can exit between the two, and the + answer reaches the sender as a connection reset rather than as `ok`. +- **`ok` means queued, not installed.** The sender does not get to know when + the swap happened; only the program knows when it is between frames. + +**sand.flan calls `agent/poll` at the top of its loop**, which is what step 3 +was for. Verified: with sand running under Xvfb, `flan reload sand-probe.flan +game-draw` and one line on the socket, and 455 consecutive frames drew from a +body that did not exist when the process started. Building without `--dev` is +fine — there are no cells, so a module is refused on the listener thread and +the loop never notices. + +`flan reload ... [-o out.so] [--new name,...]` builds one +module the way the daemon will. `--new` is the names the host was *not* built +with; it is the one thing the command cannot work out for itself, and it is +exactly what the session will track automatically. + ### Still missing for `C-c C-c` -- **The agent**, so the install happens at a frame boundary in a real process - rather than in a C test harness. Step 3. - **A session that holds the checker environment.** `Check.program` builds a `new_env ()`, prepends the prelude, mutates it through `collect` and throws it away. A REPL keeps it — and has to check each new form into a scratch copy @@ -519,11 +567,9 @@ primitive works. `flan_reload_install`, `runtime/flan_dev.c` for names introduced at run time, and a fixture where an untouched call site follows the swap and a run-time-added function is itself redefined. See the section above. -3. **The agent, in C.** A socket listener in the game process, `dlopen` off the - game thread with `RTLD_NOW`, and the staged cell publish at a frame - boundary. It lives next to `flan_rt.c` — no OCaml runtime in the game - binary. sand.flan is the test: redefine `settle` while grains are falling - and see the behaviour change with no stutter and no dropped frame. +3. ~~**The agent, in C.**~~ **Done** — `vendor/agent/`, a listener thread that + loads and a game thread that installs, and sand.flan polling at the top of + its frame. See the section above. 4. **The daemon and nREPL** (bencode over a socket; `eval`, `load-file`, `describe`, `interrupt`), then **5. the Emacs client** — a focused ~3–5k line client, not a CIDER fork. Deliberately last and deliberately separate: diff --git a/bin/main.ml b/bin/main.ml index 898b64c..b3d0707 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -109,6 +109,39 @@ let () = ignore (Flan.Build.executable ~opts:{ Flan.Build.default with checks; dev } ~csrcs:l.csrcs ~lflags:l.lflags p ~out)) + (* One redefinition, built the way the daemon will build it: the forms named + become a module the running process can install. [--new] is the names the + host was *not* built with, which is the one thing this command cannot work + out for itself — a session tracks it, a CLI has to be told. *) + | _ :: "reload" :: path :: rest when rest <> [] -> + let rec split acc out news = function + | "-o" :: o :: r -> split acc (Some o) news r + | "--new" :: n :: r -> + split acc out (news @ String.split_on_char ',' n) r + | f :: r -> split (acc @ [ f ]) out news r + | [] -> (acc, out, news) + in + let fns, out, news = split [] None [] rest in + let out = + match out with + | Some o -> o + | None -> Filename.remove_extension (Filename.basename path) ^ ".so" + in + if fns = [] then begin + prerr_endline + "usage: flan reload ... [-o out.so] [--new name,...]"; + exit 2 + end; + with_errors path (fun () -> + let p = Flan.Check.program (load path).decls in + let known n = not (List.exists (String.equal n) news) in + let opts = { Flan.Build.default with dev = true } in + let t = + Flan.Build.shared ~opts + ~ir:(Flan.Emit.redefinition ~dev:true ~known p ~fns) ~out () + in + Printf.eprintf "%s llc %.1fms ld %.1fms\n" out t.Flan.Build.llc_ms + t.Flan.Build.link_ms) | _ :: "run" :: path :: args -> with_errors path (fun () -> let exe = @@ -127,5 +160,6 @@ let () = prerr_endline "usage: flan (read|parse|check|emit) ...\n\ \ flan build [-o out] [--no-bounds-checks] [--dev]\n\ - \ flan run [args...]"; + \ flan run [args...]\n\ + \ flan reload ... [-o out.so] [--new name,...]"; exit 2 diff --git a/sand.flan b/sand.flan index 4f09a59..8671f69 100644 --- a/sand.flan +++ b/sand.flan @@ -26,6 +26,7 @@ (import rl "vendor:raylib") ; directory = package; declaration optional (import sim "sand-sim") ; no collection prefix: relative to this file +(import agent "vendor:agent") ; the dev agent: redefinitions, installed below ;; Locals are assignable places (spec-memory.md); parameters are not. (defn paint [] @@ -67,9 +68,17 @@ (rl/init-window sim/screen-width sim/screen-height "SAND") (defer (rl/close-window)) (rl/set-target-fps 120) + ;; The dev agent listens on a socket for redefinitions and hands them over; + ;; (agent/poll) below is where they are installed. Building without --dev is + ;; fine — nothing has cells to install into, so a module is refused on the + ;; listener thread and the loop never notices. + (agent/start "/tmp/flan-sand.sock") ;; Bare (defn main []) — argv and the i32 status are both optional. ;; Nothing in this loop allocates, so context/temp is never even touched. (until (rl/window-should-close?) + ;; The frame boundary, and the only place a redefinition becomes visible: + ;; nothing that could be redefined is on the stack here. + (agent/poll) (game-update) (rl/begin-drawing) (game-draw) diff --git a/test/dune b/test/dune index d3c98fd..7b1dad6 100644 --- a/test/dune +++ b/test/dune @@ -1,5 +1,5 @@ (tests - (names test_flan test_acceptance test_reload) + (names test_flan test_acceptance test_reload test_agent) (libraries flan unix) ; The acceptance programs are part of the test corpus: if the reader, the ; parser or the checker regresses on them we want to know here, not at the CLI. @@ -10,6 +10,8 @@ ; the FFI case import them and an import reads the directory at build time. (glob_files %{workspace_root}/sand-sim/*) (glob_files %{workspace_root}/vendor/raylib/*) + ; The dev agent package: its Flan declarations and the C that implements them. + (glob_files %{workspace_root}/vendor/agent/*) (glob_files programs/*.flan) ; The reload primitive's host: a C main that dlopens what Build.shared made. (file reload_host.c))) diff --git a/test/programs/agent-v2.flan b/test/programs/agent-v2.flan new file mode 100644 index 0000000..e112ebb --- /dev/null +++ b/test/programs/agent-v2.flan @@ -0,0 +1,32 @@ +;;;; agent.flan with [tick] changed, and nothing else. Only [tick] is compiled +;;;; into the module that gets sent over the socket; the rest of this file is +;;;; here because a redefinition is checked against the whole program it +;;;; belongs to, not against itself. +;;;; +;;;; [tick] is the function that gets redefined. It is called once before the +;;;; reload and once after, and nothing else in this file changes, so the two +;;;; numbers are the whole result. +;;;; +;;;; It waits rather than polling on a timer because a test that races the +;;;; frame rate is a test that fails on a loaded machine. A game loop calls +;;;; poll at the top of the frame and ignores the answer; the split is in +;;;; vendor/agent/agent.flan. +(import agent "vendor:agent") + +(defvar ticks i64) + +(defn tick [] i64 + (set ticks (+ ticks 1000)) + ticks) + +(defn main [args [string]] i32 + (if (< (len args) 2) + (do (print-line "usage: agent ") 2) + (do + (if (< (agent/start (at args 1)) 0) + (do (print-line "cannot listen") 1) + (do + (print-i64 (tick)) (newline) + (while (= (agent/wait 100) 0) 0) + (print-i64 (tick)) (newline) + 0))))) diff --git a/test/programs/agent.flan b/test/programs/agent.flan new file mode 100644 index 0000000..73e65f8 --- /dev/null +++ b/test/programs/agent.flan @@ -0,0 +1,30 @@ +;;;; The agent, end to end: a running program takes a redefinition over a +;;;; socket and installs it between "frames". +;;;; +;;;; [tick] is the function that gets redefined. It is called once before the +;;;; reload and once after, and nothing else in this file changes, so the two +;;;; numbers are the whole result. +;;;; +;;;; It waits rather than polling on a timer because a test that races the +;;;; frame rate is a test that fails on a loaded machine. A game loop calls +;;;; poll at the top of the frame and ignores the answer; the split is in +;;;; vendor/agent/agent.flan. +(import agent "vendor:agent") + +(defvar ticks i64) + +(defn tick [] i64 + (set ticks (+ ticks 1)) + ticks) + +(defn main [args [string]] i32 + (if (< (len args) 2) + (do (print-line "usage: agent ") 2) + (do + (if (< (agent/start (at args 1)) 0) + (do (print-line "cannot listen") 1) + (do + (print-i64 (tick)) (newline) + (while (= (agent/wait 100) 0) 0) + (print-i64 (tick)) (newline) + 0))))) diff --git a/test/test_agent.ml b/test/test_agent.ml new file mode 100644 index 0000000..9bdfb66 --- /dev/null +++ b/test/test_agent.ml @@ -0,0 +1,130 @@ +(* The agent, end to end (NEXT.md, dev loop step 3). + + test_reload.ml proves the primitive with a C harness driving it. This one + proves the thing the dev loop actually is: a program that is running its own + loop, a redefinition arriving over a socket while it runs, and the swap + becoming visible at a point the program chose. + + The split the agent exists for is between two threads. [dlopen] relocates a + module and takes the loader lock — milliseconds, unbounded — so it happens + on the listener thread. [flan_reload_install] is one store per function, and + it must not land while a redefined function is on the stack, so it happens + on the game thread when it asks. Everything here is arranged to make that + observable rather than to make it fast. *) + +open Flan + +let failures = ref 0 +let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt + +let scratch = Filename.get_temp_dir_name () +let tmp name = Filename.concat scratch ("flan-agent-" ^ name) + +let load path = Load.program ~file:path (Parse.program (Reader.read_file path)) +let checked path = Check.program (load path).Load.decls + +(* Poll for a condition rather than sleeping a fixed time: the program has to + bind its socket before there is anything to connect to, and how long that + takes is not ours to predict. *) +let rec await ?(ms = 3000) f = + if f () then true + else if ms <= 0 then false + else begin + ignore (Unix.select [] [] [] 0.005); + await ~ms:(ms - 5) f + end + +(* The socket file appears at [bind], which is a moment before [listen], so a + connect can lose that race and get ECONNREFUSED. Retry rather than sleep. *) +let rec connect ?(ms = 2000) path = + let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in + match Unix.connect s (Unix.ADDR_UNIX path) with + | () -> s + | exception Unix.Unix_error (Unix.ECONNREFUSED, _, _) when ms > 0 -> + Unix.close s; + ignore (Unix.select [] [] [] 0.005); + connect ~ms:(ms - 5) path + +let send path line = + let s = connect path in + let msg = line ^ "\n" in + ignore (Unix.write_substring s msg 0 (String.length msg)); + let buf = Bytes.create 512 in + let n = try Unix.read s buf 0 512 with Unix.Unix_error _ -> 0 in + Unix.close s; + Bytes.sub_string buf 0 n + +let () = + match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with + | 0 -> + let l = load "programs/agent.flan" in + let p = Check.program l.Load.decls in + let p2 = checked "programs/agent-v2.flan" in + + (* A dev build, because that is what has cells to install into and exports + them. The agent's own C and its -lpthread come from the package. *) + let dev = { Build.default with Build.dev = true } in + let exe = tmp "prog" in + ignore + (Build.executable ~opts:dev ~csrcs:l.Load.csrcs ~lflags:l.Load.lflags p + ~out:exe); + + (* What the running process was built with; [tick] is in it, so the module + reaches its cell as a symbol rather than through the registry. *) + let known n = + List.exists (fun (f : Tast.fn) -> f.Tast.name = n) p.Tast.fns + || List.exists (fun (g : Tast.global) -> g.Tast.gname = n) p.Tast.globals + in + let so = tmp "tick.so" in + ignore + (Build.shared ~opts:dev + ~ir:(Emit.redefinition ~dev:true ~known p2 ~fns:[ "tick" ]) + ~out:so ()); + + let sock = tmp "sock" in + let out = tmp "out" in + (try Sys.remove sock with Sys_error _ -> ()); + let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let pid = + Unix.create_process exe [| exe; sock |] Unix.stdin fd Unix.stderr + in + Unix.close fd; + + if not (await (fun () -> Sys.file_exists sock)) then begin + fail "the program never bound its socket"; + (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ()) + end else begin + (* Refusing junk comes first, while the program is still running: the + daemon is a separate process and can send anything, and a bad path + must not take down the program it was sent to. Nothing is queued by + it, so the program is still waiting afterwards. *) + let reply = send sock "/nonexistent/nope.so" in + if String.length reply < 4 || String.sub reply 0 4 <> "err " then + fail "a bad path was not refused: %S" reply; + + (* "ok" means queued, not installed — the store happens on the other + thread, at a time this one does not choose. *) + let reply = send sock so in + if reply <> "ok\n" then fail "agent replied %S, wanted \"ok\\n\"" reply; + let _, status = Unix.waitpid [] pid in + let text = In_channel.with_open_bin out In_channel.input_all in + (* 1 from the original [tick], then 1001: the same call site, in a + program that never stopped, running a body that did not exist when it + started. *) + if status <> Unix.WEXITED 0 || text <> "1\n1001\n" then + fail "agent reload\n got: %S (%s)\n wanted: %S" text + (match status with + | Unix.WEXITED c -> Printf.sprintf "exit %d" c + | Unix.WSIGNALED c -> Printf.sprintf "signal %d" c + | Unix.WSTOPPED c -> Printf.sprintf "stopped %d" c) + "1\n1001\n" + end; + + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) + [ exe; so; sock; out ]; + if !failures = 0 then print_endline "agent: all tests passed" + else begin + Printf.printf "\n%d failure(s)\n" !failures; + exit 1 + end + | _ -> print_endline "agent: skipped (no clang or llc on PATH)" diff --git a/vendor/agent/agent.flan b/vendor/agent/agent.flan new file mode 100644 index 0000000..34559bb --- /dev/null +++ b/vendor/agent/agent.flan @@ -0,0 +1,21 @@ +;;;; The dev agent, as Flan sees it. Three calls, and the shape of them is the +;;;; design: loading a redefinition and installing it are separate, because +;;;; only the program knows when it is between frames. +;;;; +;;;; (agent/start path) listen on a unix socket; once, at startup +;;;; (agent/poll) install whatever has arrived; returns how many +;;;; (agent/wait ms) the same, but waits for something first +;;;; +;;;; A game loop calls poll at the top of the frame and ignores the result. +;;;; wait is for a headless test, where waiting is what makes a reload +;;;; deterministic rather than a race against the frame rate. +;;;; +;;;; No aggregate crosses this boundary, so there is no shim: a Flan string is +;;;; already ptr+len and flan_agent_start takes it that way. +(declare start-raw [path string] i32 "flan_agent_start") +(declare poll-raw [] i32 "flan_agent_poll") +(declare wait-raw [ms i32] i32 "flan_agent_wait") + +(defn start [path string] i32 (start-raw path)) +(defn poll [] i32 (poll-raw)) +(defn wait [ms i32] i32 (wait-raw ms)) diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c new file mode 100644 index 0000000..afa1182 --- /dev/null +++ b/vendor/agent/flan_agent.c @@ -0,0 +1,162 @@ +/* flan_agent — the half of the dev loop that lives in the running program. + * + * A redefinition arrives as a path to a .so (runtime/flan_dev.c and + * Emit.redefinition are what put it there). Two things have to happen to it, + * and they must happen on different threads: + * + * dlopen relocates the module and runs the loader. It is milliseconds, + * unbounded, and takes the loader lock. Doing it on the game thread + * is a dropped frame. + * install is one store per redefined function. It is sub-microsecond, and + * it must happen at a point where no redefined function is on the + * stack — a frame boundary — or a frame runs half in the old code + * and half in the new. + * + * So the listener thread does the loading and hands over a function pointer; + * the game thread calls flan-poll or flan-wait when it is between frames and + * that is when the swap becomes visible. Nothing else in the program needs to + * know the agent exists. + * + * Nothing is ever dlclosed: a cell holds an address inside a module's text, + * and unloading it would leave every call site pointing at unmapped memory. + * + * This is not a protocol. One line per request, the path to load, and a one + * line answer. The daemon and its nREPL are a separate program that will speak + * to a socket, not something this file grows into. + */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +typedef void (*install_fn)(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. Overflow drops the oldest request rather than stalling; a dev + * loop that queues 64 reloads between two frames has a bigger problem. */ +#define QUEUE 64 +static install_fn queue[QUEUE]; +static atomic_uint head; /* written by the listener */ +static atomic_uint tail; /* written by the game thread */ + +static int listen_fd = -1; +static pthread_t listener; +static atomic_int started; + +static void publish(install_fn f) { + unsigned h = atomic_load_explicit(&head, memory_order_relaxed); + queue[h % QUEUE] = f; + /* Release: the store to the slot must be visible before the index that + * advertises it. */ + atomic_store_explicit(&head, h + 1, memory_order_release); +} + +/* Returns how many modules were installed. Call it between frames. */ +int32_t flan_agent_poll(void) { + unsigned t = atomic_load_explicit(&tail, memory_order_relaxed); + unsigned h = atomic_load_explicit(&head, memory_order_acquire); + int32_t n = 0; + while (t != h) { + install_fn f = queue[t % QUEUE]; + t++; + if (f != NULL) { f(); n++; } + } + atomic_store_explicit(&tail, t, memory_order_relaxed); + return n; +} + +/* The same, but waits up to [ms] for something to arrive first. A game loop + * does not want this; a headless test does, because it makes the reload + * deterministic instead of a race against the frame rate. */ +int32_t flan_agent_wait(int32_t ms) { + struct timespec step = { 0, 1000000 }; /* 1ms */ + for (int32_t i = 0; i < ms; i++) { + int32_t n = flan_agent_poll(); + if (n > 0) return n; + nanosleep(&step, NULL); + } + return flan_agent_poll(); +} + +static void reply(int fd, const char *s) { + size_t n = strlen(s); + while (n > 0) { + ssize_t k = write(fd, s, n); + if (k <= 0) return; + s += k; + n -= (size_t)k; + } +} + +/* One connection, one line, one module. Loading here rather than in the game + * thread is the whole reason this thread exists. */ +static void serve(int fd) { + char line[4096]; + size_t n = 0; + for (;;) { + ssize_t k = read(fd, line + n, sizeof line - n - 1); + if (k <= 0) return; + n += (size_t)k; + line[n] = '\0'; + char *nl = strchr(line, '\n'); + if (nl == NULL) { + if (n == sizeof line - 1) { reply(fd, "err path too long\n"); return; } + continue; + } + *nl = '\0'; + void *h = dlopen(line, RTLD_NOW | RTLD_LOCAL); + if (h == NULL) { + reply(fd, "err "); + reply(fd, dlerror()); + reply(fd, "\n"); + return; + } + install_fn f = (install_fn)(uintptr_t)dlsym(h, "flan_reload_install"); + if (f == NULL) { reply(fd, "err no flan_reload_install\n"); return; } + /* Answer before queueing, not after. The game thread can install and run + * to completion between the two, and a program that exits there would tear + * down this connection with the reply still unwritten — which reaches the + * sender as a reset, not as an answer. */ + reply(fd, "ok\n"); + /* "queued", not "installed": the store happens on the game thread, at a + * time this thread does not get to choose. */ + publish(f); + return; + } +} + +static void *accept_loop(void *arg) { + (void)arg; + for (;;) { + int fd = accept(listen_fd, NULL, NULL); + if (fd < 0) { if (errno == EINTR) continue; return NULL; } + serve(fd); + close(fd); + } +} + +/* [path] is a Flan string: ptr and len, not NUL-terminated. */ +int32_t flan_agent_start(const uint8_t *path, int64_t len) { + struct sockaddr_un addr; + if (atomic_exchange(&started, 1)) return 0; + if (len <= 0 || (size_t)len >= sizeof addr.sun_path) return -1; + memset(&addr, 0, sizeof addr); + addr.sun_family = AF_UNIX; + memcpy(addr.sun_path, path, (size_t)len); + unlink(addr.sun_path); + listen_fd = socket(AF_UNIX, SOCK_STREAM, 0); + if (listen_fd < 0) return -1; + if (bind(listen_fd, (struct sockaddr *)&addr, sizeof addr) < 0) return -1; + if (listen(listen_fd, 4) < 0) return -1; + if (pthread_create(&listener, NULL, accept_loop, NULL) != 0) return -1; + return 0; +} diff --git a/vendor/agent/link b/vendor/agent/link new file mode 100644 index 0000000..7d0f073 --- /dev/null +++ b/vendor/agent/link @@ -0,0 +1,2 @@ +-lpthread +-ldl