Dead code is gone, and the daemon says what to fix when a session cannot start or reach its program
This commit is contained in:
commit
0beafedd14
25
TODO.org
25
TODO.org
@ -1440,13 +1440,11 @@ The opposite of what the escaping-alloca argument predicts, and the measurement
|
||||
that first said otherwise was comparing a 40-frame binary with a 600-frame one.
|
||||
That is why every number in =docs/BUILT.md= is a minimum of nine runs.
|
||||
|
||||
** NEXT runtime/flan_dyn_stub.c is dead
|
||||
Decided 2026-09-25: delete it, as part of a sweep for dead code across the repository, each removal checked unused first.
|
||||
No dune rule mentions it, no module refers to it, no test links it, and it does
|
||||
not compile — two conflicting-type errors against its own header. It is maintained
|
||||
by accident: one lane added a function to it, which is duplicity on the same side
|
||||
of the same capability. The recommendation is delete, and the author added the
|
||||
file, so it is his call.
|
||||
** DONE runtime/flan_dyn_stub.c is dead
|
||||
CLOSED: [2026-09-25]
|
||||
Deleted, in a sweep for dead code across the repository in which each removal
|
||||
was first shown unused. flan_dyn.c is the one implementation of the flan_dyn.h
|
||||
ABI; a stand-in beside it is not to come back.
|
||||
|
||||
* Dev loop
|
||||
|
||||
@ -1588,11 +1586,14 @@ only by an explicit call. A sentence about the shape of the gate rather than an
|
||||
observed problem: only the daemon sets the variable and it never runs release
|
||||
builds. The fix, if it is ever felt, is a narrower gate.
|
||||
|
||||
** NEXT The daemon's "has not called (agent/start ...)" note is unreachable
|
||||
Decided 2026-09-25: retire the note in the same dead-code sweep.
|
||||
Unreachable, not merely unexercised: the one state it was true of is closed by the
|
||||
constructor. Retiring it is the author's call over a lane that merged days ago, so
|
||||
it is left in place saying a true thing about a state nothing can be in.
|
||||
** DONE The daemon's "has not called (agent/start ...)" note is unreachable
|
||||
CLOSED: [2026-09-25]
|
||||
Retired, with the matching arm of an evaluation's timeout, because it named the
|
||||
wrong cause: with the agent linked, its constructor binds the socket before
|
||||
=main=, and the one way left to be unbound is a socket path over 107 bytes, which
|
||||
=flan dev= refuses at start, naming TMPDIR. A program with no agent linked is
|
||||
told it has none and how to add one. No reply says =(agent/start ...)= has not
|
||||
been called.
|
||||
|
||||
** DONE The allocation registry
|
||||
CLOSED: [2026-09-13]
|
||||
|
||||
@ -5478,7 +5478,7 @@ error that could actually be clicked.
|
||||
|
||||
The source cache in `loc.ml` is process-lifetime, which is right for `flan build` — a fresh process per run. The
|
||||
daemon is long-lived and never calls `report`; the interactive path draws no squiggle, it takes a location and a
|
||||
message. `Loc.forget_sources` exists for the day that changes.
|
||||
message. A daemon that did draw one would have to reset the cache when a file changes.
|
||||
|
||||
### Collecting, and where it stops
|
||||
|
||||
@ -5504,7 +5504,7 @@ file-shaped pile of nonsense. First error, stop. That is a decision, not an omis
|
||||
Changing the error type without touching `dev.ml` and `session.ml` needed a compatible way to get one location and
|
||||
one message out. The answer is that **the single-diagnostic exception is still the single-diagnostic exception**.
|
||||
`Session.eval` and the daemon evaluate one form and have one failure to report; they keep catching `Loc.Error` and
|
||||
take the pair out of it with `Loc.summary`. Only a driver that compiles a whole file raises `Loc.Errors`.
|
||||
read `dloc` and `dmsg` out of it. Only a driver that compiles a whole file raises `Loc.Errors`.
|
||||
|
||||
That guarantee is **structural and not conventional**. `Parse.program` / `Check.program` stop at the first refusal;
|
||||
`Parse.program_all` / `Check.program_all` collect. Two names rather than one function with a `~keep_going` label,
|
||||
@ -7024,9 +7024,8 @@ registry now holds.
|
||||
**When it happens.** At the next frame boundary of a running program. A parked program — one whose `main` has
|
||||
finished — drains its ring when that sleep ends, so the store lands at the top of its next run, ahead of `main`; the
|
||||
run's own startup then computes the initialiser again, which is not a wart but the two events `defparameter` has: an
|
||||
evaluation assigns, and a re-run re-initialises. A program that has not called `(agent/start ...)` yet installs at its
|
||||
next `(agent/poll)`, and never if it has none — the reply already says so. A program stopped at a break runs it in the
|
||||
break loop, like any other evaluation.
|
||||
evaluation assigns, and a re-run re-initialises. A program stopped at a break runs it in the break loop, like any other
|
||||
evaluation.
|
||||
|
||||
**A brand-new `def`** gets its initialiser run too. Its storage comes from `flan_dev_global` and nothing in the host's
|
||||
`.init-globals` names it, so before this a new `(def n i64 (count-them))` came up as `calloc`'s zeroes and stayed
|
||||
|
||||
@ -21,3 +21,7 @@
|
||||
the compiler thread calling C, never the other way. *)
|
||||
|
||||
external request : string -> string option = "flan_agent_direct"
|
||||
|
||||
(** Whether this process links the agent. [false] in the same binaries where
|
||||
[request] is [None]. *)
|
||||
external present : unit -> bool = "flan_agent_present"
|
||||
|
||||
13
lib/check.ml
13
lib/check.ml
@ -747,10 +747,6 @@ and captured_set ctx loc name =
|
||||
"Return the new value, or keep it in a local of this fn")
|
||||
| None -> ()
|
||||
|
||||
(* A binding this body captured, as opposed to one it declared. Used where the
|
||||
difference matters and nowhere else. *)
|
||||
let is_captured ctx name = List.mem_assoc name ctx.caught
|
||||
|
||||
let scoped ctx f =
|
||||
let saved = ctx.scope in
|
||||
let r = f () in
|
||||
@ -2338,11 +2334,6 @@ let widen loc (want : Types.t) (e : Tast.expr) =
|
||||
if Types.equal want e.Tast.ty then e
|
||||
else mk loc want (Tast.Prim (Tast.Cast want, [ e ]))
|
||||
|
||||
let unboxable t =
|
||||
match t with
|
||||
| Types.Int Types.I64 | Types.Float Types.F64 | Types.Bool -> true
|
||||
| _ -> false
|
||||
|
||||
(* The sentence a refusal at this boundary gives. It names the type and says
|
||||
which direction failed, because "expected dyn, found (Vec i64)" would read
|
||||
as a type error the programmer could fix by writing something else, and
|
||||
@ -2353,7 +2344,7 @@ let no_dyn_yet loc ~into t extra =
|
||||
(Types.to_string t) (if into then "dyn" else "a written type") extra
|
||||
|
||||
(* M2 item 3: a typed container crossing into dyn as a view. The element set
|
||||
is exactly [unboxable] above — i64, f64, bool — and that is not a smaller
|
||||
is exactly the unboxable scalars — i64, f64, bool — and that is not a smaller
|
||||
version of the same cut for the same reason: every other element type
|
||||
would need [box] to run on IT too, and a string element's dyn form is a
|
||||
pointer into the collector's heap, while a typed container's storage is
|
||||
@ -3416,7 +3407,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
|
||||
runtime owns the storage the way (vec-new dyn) does, keys and values are
|
||||
both dyn words, and a typed want other than dyn refuses through [expect]
|
||||
like any other dyn value would. The literal lowers to a fresh slot — a
|
||||
rooted one, because a slot of type dyn is what [dyn_roots] counts — so
|
||||
rooted one, because a slot of type dyn is what [Emit.root_plan] counts — so
|
||||
the map stays reachable across the allocations its own entries make. *)
|
||||
| Ast.MapLit (tag, kvs) ->
|
||||
let m = fresh_slot ctx Types.Dyn in
|
||||
|
||||
188
lib/dev.ml
188
lib/dev.ml
@ -122,9 +122,31 @@ let await ?(ms = 5000) f =
|
||||
in
|
||||
go ms
|
||||
|
||||
(* What a program needs so that code from the editor can reach it. Spelled once
|
||||
because three replies give it: a delivery, an evaluation and the daemon's
|
||||
own warning. Both lines compile as written. *)
|
||||
let agent_howto =
|
||||
"Import the agent with (import agent \"vendor:agent\") and call \
|
||||
(agent/poll) once in each pass of the program's main loop, then start \
|
||||
flan dev again."
|
||||
|
||||
let no_agent =
|
||||
"the program has no agent, so nothing in it can receive code from the \
|
||||
editor. " ^ agent_howto
|
||||
|
||||
(* Whether anything in this session can hand code to the program. A merged
|
||||
build with no agent linked has no agent to call and never binds a socket,
|
||||
and a connect to one answers "No such file or directory" about a path the
|
||||
reader never chose; that is the case this names. *)
|
||||
let agentless t = t.child = None && not (Agent.present ())
|
||||
|
||||
let unreachable t e =
|
||||
if agentless t then no_agent
|
||||
else "cannot reach the program: " ^ Unix.error_message e
|
||||
|
||||
(* Whether the program has bound the socket it receives modules on.
|
||||
|
||||
Cheap enough to ask on every reply — one [stat] — and asked rather than
|
||||
Cheap enough to ask before every request — one [stat] — and asked rather than
|
||||
remembered because the answer moves in one direction at a moment this side
|
||||
does not get to see: [agent/start] runs on the program's own thread. *)
|
||||
let agent_bound t = Sys.file_exists t.agent
|
||||
@ -160,8 +182,8 @@ let agent_check t =
|
||||
otherwise repeat this on every keystroke's worth of polling. *)
|
||||
t.agent_watch <- None;
|
||||
Printf.eprintf
|
||||
"flan dev: the program is not listening on %s — does it call \
|
||||
(agent/start ...)?\n%!" t.agent
|
||||
"flan dev: nothing is listening on %s, so code from the editor cannot \
|
||||
reach the program. %s\n%!" t.agent agent_howto
|
||||
end
|
||||
|
||||
(* ── Asking the agent ──────────────────────────────────────────────── *)
|
||||
@ -781,7 +803,7 @@ let refusal ~parked reply =
|
||||
refusal; it is the difference between "queued" and "running", which is a
|
||||
difference only the program can close and only at a moment of its choosing.
|
||||
|
||||
Three of them, in the order of how far the module is from being live:
|
||||
Two of them, in the order of how far the module is from being live:
|
||||
|
||||
A PARKED program has finished [main] and is asleep in [flan_merged_park].
|
||||
Its ring is drained whenever that sleep ends — for an expression to run, or
|
||||
@ -796,16 +818,16 @@ let refusal ~parked reply =
|
||||
not per session, because the reader of a *new* park may not be the reader
|
||||
of the last one.
|
||||
|
||||
A RUNNING program that has not bound its agent socket has not called
|
||||
[(agent/start ...)] yet — it may be about to, ahead of a window that is
|
||||
still being created, or it may have no such call at all. Either way the
|
||||
module is in the ring and the ring is drained by [(agent/poll)], so what
|
||||
can honestly be promised is the poll and not a frame: a program with no
|
||||
poll in it never installs this, and saying "at its next frame boundary"
|
||||
would be the reply that made a redefinition look applied when it was not.
|
||||
|
||||
A RUNNING program that has bound it needs no note: the reply already says
|
||||
queued, and the frame boundary is the next one it reaches. *)
|
||||
A RUNNING program needs no note: the reply already says queued, and the
|
||||
frame boundary is the next one it reaches. That includes a running program
|
||||
whose agent socket is not bound. The agent package binds it in a
|
||||
constructor before [main], so the one way to be running and unbound with
|
||||
the agent linked is a bind that failed — a socket path longer than
|
||||
[max_socket_path], which [session_dir] refuses before building — and there
|
||||
the module is still queued through the in-process call. A note saying the
|
||||
program "has not called (agent/start ...)" named a cause that was not the
|
||||
cause, so there is none. A program with no agent linked has nothing to
|
||||
queue a module on, and its delivery is refused with [no_agent]. *)
|
||||
let install_note t ~parked =
|
||||
if parked then begin
|
||||
let first = not t.park_noted in
|
||||
@ -821,13 +843,6 @@ let install_note t ~parked =
|
||||
else "queued; installs no later than the parked program's next run")
|
||||
]
|
||||
end
|
||||
else if not (agent_bound t) then
|
||||
[ ":note "
|
||||
^ Wire.quote
|
||||
"queued, but the program has not called (agent/start ...) yet, so \
|
||||
this installs when it next reaches an (agent/poll) — and not at \
|
||||
all if it never does"
|
||||
]
|
||||
else []
|
||||
|
||||
(* [pause], when given, is the position of the form to stop at — §9. It rides
|
||||
@ -932,8 +947,10 @@ let eval t ~code ~origin ~pause =
|
||||
| reply -> refused (refusal ~parked:parked_now reply)
|
||||
| exception Unix.Unix_error (e, _, _) ->
|
||||
refused
|
||||
("cannot reach the program on " ^ t.agent ^ ": "
|
||||
^ Unix.error_message e))
|
||||
(if agentless t then no_agent
|
||||
else
|
||||
"cannot reach the program on " ^ t.agent ^ ": "
|
||||
^ Unix.error_message e))
|
||||
| exception Failure m -> refused m)
|
||||
with e when not !accepted -> Session.restore t.session before; raise e)
|
||||
(* Nothing to put back: the check itself raised, so [Session.eval] never
|
||||
@ -984,6 +1001,7 @@ let eval t ~code ~origin ~pause =
|
||||
let eval_expr t ~code ~origin ~pause =
|
||||
match liveness t with
|
||||
| Gone -> error gone
|
||||
| (Live | Parked) when agentless t -> error no_agent
|
||||
| Live | Parked ->
|
||||
(* The same rollback [eval] takes, for the same reason and a smaller
|
||||
cargo. A thunk is not a declaration and never joins the session, but the
|
||||
@ -1253,21 +1271,6 @@ let eval_expr t ~code ~origin ~pause =
|
||||
the program is stopped at an earlier break and runs \
|
||||
nothing until that ends. Take a restart or abort in the \
|
||||
break buffer, and evaluate this again"
|
||||
(* And a third cause, which is the one a session now reaches
|
||||
early enough to hit: the program has not bound its agent
|
||||
socket, so it is still ahead of its own [(agent/start ...)]
|
||||
— inside whatever it does first, a window being created —
|
||||
and asking whether it calls [(agent/poll)] would send the
|
||||
reader to look at a loop it has not got to yet. Said only
|
||||
where it is a fact about *this* program: the socket is
|
||||
missing, which is a stat, not a guess. *)
|
||||
else if not (agent_bound t) then
|
||||
error
|
||||
"the program has not called (agent/start ...) yet, so \
|
||||
nothing has run the expression. It is queued and will run \
|
||||
at the program's first (agent/poll); this reply cannot \
|
||||
carry its value, so evaluate it again once the program is \
|
||||
up"
|
||||
else
|
||||
error
|
||||
"the program did not reach a frame boundary; is it calling \
|
||||
@ -1279,7 +1282,7 @@ let eval_expr t ~code ~origin ~pause =
|
||||
put the session back. *)
|
||||
| reply -> refused (refusal ~parked:(liveness t = Parked) reply)
|
||||
| exception Unix.Unix_error (e, _, _) ->
|
||||
refused ("cannot reach the program: " ^ Unix.error_message e))
|
||||
refused (unreachable t e))
|
||||
| exception Failure m -> refused m)
|
||||
| exception Loc.Error { Loc.dloc = l; dmsg = msg; _ } -> error ~loc:(Loc.to_string l) msg
|
||||
|
||||
@ -1965,7 +1968,7 @@ let run_render_thunk ?(stopped_only = false) ?at_stop t ~tag
|
||||
| None -> if stopped_only then deliver_stopped_only t out else deliver t out)
|
||||
with
|
||||
| exception Unix.Unix_error (e, _, _) ->
|
||||
Error ("cannot reach the program: " ^ Unix.error_message e)
|
||||
Error (unreachable t e)
|
||||
| "ok" ->
|
||||
let rec wait ms =
|
||||
(* Drained every tick for the reason [eval_expr]'s own wait spells
|
||||
@ -2520,7 +2523,7 @@ type reg_entry =
|
||||
let reg_at t ~addr : (reg_entry option, string) result =
|
||||
match request t (Printf.sprintf "reg at %d" addr) with
|
||||
| exception Unix.Unix_error (e, _, _) ->
|
||||
Error ("cannot reach the program: " ^ Unix.error_message e)
|
||||
Error (unreachable t e)
|
||||
| text ->
|
||||
let line = String.trim (List.hd (String.split_on_char '\n' text)) in
|
||||
if line = "none" then Ok None
|
||||
@ -2823,7 +2826,7 @@ let inspect_addr t ~addr ~want_type =
|
||||
let reg_rows t ~verb =
|
||||
match request t verb with
|
||||
| exception Unix.Unix_error (e, _, _) ->
|
||||
Error ("cannot reach the program: " ^ Unix.error_message e)
|
||||
Error (unreachable t e)
|
||||
| text ->
|
||||
(match String.split_on_char '\n' text with
|
||||
| [] -> Error "the program answered nothing"
|
||||
@ -3187,7 +3190,7 @@ let choose_at t ~index ~name =
|
||||
^ taken_note ~abandoned:(accepted reply = Some true) ]
|
||||
| reply -> error (String.trim reply)
|
||||
| exception Unix.Unix_error (e, _, _) ->
|
||||
error ("cannot reach the program: " ^ Unix.error_message e)
|
||||
error (unreachable t e)
|
||||
|
||||
let choose t ~name =
|
||||
match liveness t with
|
||||
@ -3215,7 +3218,7 @@ let choose t ~name =
|
||||
":note " ^ taken_note ~abandoned:(accepted reply = Some true) ]
|
||||
| reply -> error (String.trim reply)
|
||||
| exception Unix.Unix_error (e, _, _) ->
|
||||
error ("cannot reach the program: " ^ Unix.error_message e)
|
||||
error (unreachable t e)
|
||||
|
||||
(* The other way out. The program exits 134 where it stopped, which ends this
|
||||
daemon too — it owns the program's lifetime and has nothing left to serve.
|
||||
@ -3242,7 +3245,7 @@ let abort t =
|
||||
ok [ ":note " ^ Wire.quote "the program is exiting; flan dev ends with it" ]
|
||||
| reply -> error (String.trim reply)
|
||||
| exception Unix.Unix_error (e, _, _) ->
|
||||
error ("cannot reach the program: " ^ Unix.error_message e)
|
||||
error (unreachable t e)
|
||||
|
||||
(* Run [main] again. The verb this file was missing, and the one everything
|
||||
above it about [Parked] is in aid of.
|
||||
@ -3689,7 +3692,7 @@ let watch_enable t ~on =
|
||||
| "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)
|
||||
error (unreachable t e)
|
||||
|
||||
(* [NAME <tab> VALUE] per line, after a header of [COUNT DROPPED].
|
||||
|
||||
@ -3739,7 +3742,7 @@ let watch_read t ~reset =
|
||||
(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)
|
||||
error (unreachable t e)
|
||||
|
||||
(* [(:op "memory")] — which lines of this session's program allocate.
|
||||
|
||||
@ -4310,6 +4313,74 @@ let remove_session_dirs t =
|
||||
remove t.dir;
|
||||
remove (Build.workdir ())
|
||||
|
||||
(* The longest path a unix socket can be bound at: [sun_path] is 108 bytes on
|
||||
Linux and the path is written into it with its terminating NUL. A longer one
|
||||
fails at the bind, where the reason reaches nobody — the agent's constructor
|
||||
drops it, and [connect] later answers "File name too long" with no path. *)
|
||||
let max_socket_path = 107
|
||||
|
||||
let socket_fits ~what ~fix path =
|
||||
let n = String.length path in
|
||||
if n > max_socket_path then
|
||||
failwith
|
||||
(Printf.sprintf
|
||||
"%s would be at %s, which is %d bytes long, and a unix socket path \
|
||||
can be at most %d bytes. %s"
|
||||
what path n max_socket_path fix)
|
||||
|
||||
(* The directory a session keeps its program, its modules and the agent's
|
||||
socket in, checked before anything is built so that a TMPDIR that cannot
|
||||
hold one is said once, at the start, in words. *)
|
||||
let session_dir ~file ~sock =
|
||||
let tmp = Filename.get_temp_dir_name () in
|
||||
let dir = Filename.concat tmp (Printf.sprintf "flan-dev-%d" (Unix.getpid ())) in
|
||||
let shorter =
|
||||
Printf.sprintf
|
||||
"Set TMPDIR to a shorter directory, for example: TMPDIR=/tmp flan dev %s"
|
||||
(Filename.quote file)
|
||||
in
|
||||
if not (Sys.file_exists tmp && Sys.is_directory tmp) then
|
||||
failwith
|
||||
(Printf.sprintf
|
||||
"the temporary directory %s does not exist, and flan dev builds the \
|
||||
program there. Create it, or set TMPDIR to a directory that exists, \
|
||||
for example: TMPDIR=/tmp flan dev %s"
|
||||
tmp (Filename.quote file));
|
||||
socket_fits ~what:"the program's agent socket" ~fix:shorter
|
||||
(Filename.concat dir "agent.sock");
|
||||
socket_fits ~what:"the editor's socket"
|
||||
~fix:"Give flan dev -s a shorter path." sock;
|
||||
dir
|
||||
|
||||
(* Made only once the program has been found to have something to run, so a
|
||||
refusal leaves nothing behind in TMPDIR. *)
|
||||
let make_session_dir ~file dir =
|
||||
match Unix.mkdir dir 0o700 with
|
||||
| () | exception Unix.Unix_error (Unix.EEXIST, _, _) -> ()
|
||||
| exception Unix.Unix_error (e, _, _) ->
|
||||
failwith
|
||||
(Printf.sprintf
|
||||
"cannot create %s: %s. flan dev builds the program under TMPDIR; set \
|
||||
it to a directory you can write to, for example: TMPDIR=/tmp flan \
|
||||
dev %s"
|
||||
dir (Unix.error_message e) (Filename.quote file))
|
||||
|
||||
(* A session over a file with no [main] has nothing to run, and the build
|
||||
would find that out at the link — as a missing symbol, or as the merged
|
||||
build's rename finding nothing to rename. *)
|
||||
let need_main ~file (session : Session.t) =
|
||||
if not
|
||||
(List.exists (fun (f : Tast.fn) -> f.Tast.name = "main")
|
||||
session.Session.host.Tast.fns)
|
||||
then
|
||||
failwith
|
||||
(Printf.sprintf
|
||||
"%s has no main, so flan dev has nothing to run. A program starts at \
|
||||
a function named main, for example:\n\n\
|
||||
\ (defn main [] i32\n\
|
||||
\ 0)"
|
||||
file)
|
||||
|
||||
(* [debug] is off by default, which keeps [flan dev] exactly what it was: a
|
||||
-O2 host and -O2 modules. It is opt-in rather than always-on because a debug
|
||||
build is an -O0 build — [llvm.dbg.declare] describes an alloca and mem2reg
|
||||
@ -4323,13 +4394,12 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
|
||||
src/game.flan] run from a project root would otherwise send back
|
||||
"src/game.flan:12:7", which the editor can only resolve by guessing which
|
||||
directory it was relative to. *)
|
||||
let dir = session_dir ~file ~sock in
|
||||
let given = file in
|
||||
let file = try Unix.realpath file with Unix.Unix_error _ -> file in
|
||||
let session, l = Session.create ~debug ~x86 ~file () in
|
||||
let dir =
|
||||
Filename.concat (Filename.get_temp_dir_name ())
|
||||
(Printf.sprintf "flan-dev-%d" (Unix.getpid ()))
|
||||
in
|
||||
(try Unix.mkdir dir 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
|
||||
need_main ~file:given session;
|
||||
make_session_dir ~file:given dir;
|
||||
let exe = Filename.concat dir "program" in
|
||||
(* [keep] so the host's own IR survives the build. It is the text [llc] was
|
||||
actually given, not a second emission of it, which is the difference
|
||||
@ -4396,8 +4466,9 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
|
||||
if not (await (fun () -> Sys.file_exists agent)) then begin
|
||||
(try Unix.kill child Sys.sigterm with Unix.Unix_error _ -> ());
|
||||
failwith
|
||||
("the program never listened on " ^ agent
|
||||
^ " — does it call (agent/start ...)?")
|
||||
("the program did not open its agent socket at " ^ agent
|
||||
^ ". Under --two-process every edit reaches the program through that \
|
||||
socket. " ^ agent_howto)
|
||||
end;
|
||||
|
||||
let t =
|
||||
@ -5327,13 +5398,12 @@ let merged_serve () =
|
||||
does not survive: there is one process from the first reply onwards. *)
|
||||
let start_merged ?(debug = false) ?(x86 = true) ~file ~sock () =
|
||||
let t0 = Unix.gettimeofday () in
|
||||
let dir = session_dir ~file ~sock in
|
||||
let given = file in
|
||||
let file = try Unix.realpath file with Unix.Unix_error _ -> file in
|
||||
let session, l = Session.create ~debug ~x86 ~file () in
|
||||
let dir =
|
||||
Filename.concat (Filename.get_temp_dir_name ())
|
||||
(Printf.sprintf "flan-dev-%d" (Unix.getpid ()))
|
||||
in
|
||||
(try Unix.mkdir dir 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
|
||||
need_main ~file:given session;
|
||||
make_session_dir ~file:given dir;
|
||||
let exe = Filename.concat dir "program" in
|
||||
(* The host's IR goes straight to its final home rather than being written
|
||||
into the build's working directory and moved: the merged link is spelled
|
||||
|
||||
@ -219,6 +219,13 @@ CAMLprim value flan_program_wake(value unit) {
|
||||
return Val_int(flan_merged_wake() == 0 ? 0 : 1);
|
||||
}
|
||||
|
||||
/* Whether this process has an agent to call at all: the same weak symbol
|
||||
* [flan_agent_direct] tests, asked without a request. */
|
||||
CAMLprim value flan_agent_present(value unit) {
|
||||
(void)unit;
|
||||
return Val_bool(flan_agent_request != NULL);
|
||||
}
|
||||
|
||||
CAMLprim value flan_agent_direct(value line) {
|
||||
CAMLparam1(line);
|
||||
CAMLlocal2(s, r);
|
||||
|
||||
19
lib/emit.ml
19
lib/emit.ml
@ -35,8 +35,6 @@
|
||||
through a [(Ptr Cursor)] becomes a [getelementptr] on the pointer, not on
|
||||
a copy of the struct. *)
|
||||
|
||||
let fail = Loc.fail
|
||||
|
||||
(* The assertions below this line are not diagnostics. Every one of them says
|
||||
the checker admitted something it refuses — a type with no layout, a case
|
||||
that is not a case of its data type, arithmetic on a struct — so no program
|
||||
@ -112,11 +110,6 @@ let xfer_param = "%xfer"
|
||||
to have had all along. *)
|
||||
let env_param = "%env"
|
||||
|
||||
(* What a call through a [(Fn ...)] value passes when it has no environment —
|
||||
a value made out of a name, or one widened from a [CFn]. Spelled once so
|
||||
the sites cannot drift. *)
|
||||
let no_env = "ptr null"
|
||||
|
||||
(* The condition's own name, for the message an unhandled [error] prints. The
|
||||
checker has already refused anything that is not a struct. *)
|
||||
let struct_name_of (t : Types.t) =
|
||||
@ -936,7 +929,7 @@ type f = {
|
||||
It is a count and not a saved depth because the ABI offers
|
||||
[flan_dyn_root_pop(n)] and no way to read the stack's height; it can be a
|
||||
count, rather than needing one, because the number is a static property of
|
||||
the function that [dyn_roots] works out before a line of the body is
|
||||
the function that [root_plan] works out before a line of the body is
|
||||
emitted. That matters: [ret] runs *during* emission, and a count
|
||||
accumulated as roots were discovered would be short at every early
|
||||
return. *)
|
||||
@ -1370,16 +1363,12 @@ let root_plan m (fn : Tast.fn) : rootplan =
|
||||
!agg;
|
||||
rpins = !pins }
|
||||
|
||||
let dyn_roots m (fn : Tast.fn) =
|
||||
let p = root_plan m fn in
|
||||
List.length p.rslots + p.rdyn + List.length p.ragg
|
||||
|
||||
(* The next pre-made root slot for a dyn temporary. They are all minted, zeroed
|
||||
and pushed in the entry block before a line of the body is emitted, and this
|
||||
only hands them out — which is what makes the pushes and the pops balance by
|
||||
construction rather than by the body being walked the same way twice.
|
||||
|
||||
[dyn_roots] counts the same nodes the emission visits, so the supply runs
|
||||
[root_plan] counts the same nodes the emission visits, so the supply runs
|
||||
out only if those two disagree. If it ever does, the fallback is an ordinary
|
||||
unrooted slot: one temporary the collector cannot see is a bug to find,
|
||||
where a root stack that pops more than it pushed is memory corruption. *)
|
||||
@ -3357,7 +3346,7 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
|
||||
(* A dyn word is spilled into a rooted slot the instant it exists. It is
|
||||
an SSA value otherwise, and an SSA value is invisible to a collector
|
||||
that finds its roots by address — the next allocation could be the one
|
||||
that frees what this is holding. [dyn_roots] counted this call, so the
|
||||
that frees what this is holding. [root_plan] counted this call, so the
|
||||
slot below is one the entry block has already pushed.
|
||||
|
||||
The value carries on being used as a register: the store is what the
|
||||
@ -3574,7 +3563,7 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
|
||||
a debugging convenience and a release build does without it, while a
|
||||
collector that cannot find its roots is a collector that frees live
|
||||
values. Every build pays this, and only a function that has a dyn in it
|
||||
pays anything — [dyn_roots] is zero otherwise and not a line is emitted,
|
||||
pays anything — [root_plan] is empty otherwise and not a line is emitted,
|
||||
which is what makes an annotated program's IR identical with and without
|
||||
--no-gc.
|
||||
|
||||
|
||||
@ -143,10 +143,6 @@ exception Error of diag
|
||||
and never raised by a path that checks a single form. *)
|
||||
exception Errors of diag list
|
||||
|
||||
(** The one location and one message a caller with a single line to print gets
|
||||
out of a diagnostic. Notes are dropped here on purpose. *)
|
||||
let summary (d : diag) = (d.dloc, d.dmsg)
|
||||
|
||||
let before (a : t) (b : t) =
|
||||
if a.line <> b.line then compare a.line b.line else compare a.col b.col
|
||||
|
||||
@ -210,8 +206,6 @@ let caught s f =
|
||||
| x -> Some x
|
||||
| exception Error d -> s.found <- d :: s.found; None
|
||||
|
||||
let any s = s.found <> []
|
||||
|
||||
(** Raise everything found, in the order it was found, or return if the pass
|
||||
was clean. *)
|
||||
let finish s =
|
||||
@ -255,8 +249,6 @@ let lines_of file =
|
||||
Hashtbl.replace source_cache file v;
|
||||
v
|
||||
|
||||
let forget_sources () = Hashtbl.reset source_cache
|
||||
|
||||
let source_line (t : t) =
|
||||
if t.line <= 0 then None
|
||||
else
|
||||
|
||||
38
lib/x86.ml
38
lib/x86.ml
@ -355,7 +355,6 @@ let and_imm b ~dst n = grp1_imm b ~ext:4 ~dst n
|
||||
let sub_imm b ~dst n = grp1_imm b ~ext:5 ~dst n
|
||||
let cmp_imm b ~dst n = grp1_imm b ~ext:7 ~dst n
|
||||
|
||||
let neg_r b ~dst = rex b ~w:true ~r:0 ~x:0 ~m:dst; u8 b 0xf7; modrm_r b ~r:3 ~m:dst
|
||||
let not_r b ~dst = rex b ~w:true ~r:0 ~x:0 ~m:dst; u8 b 0xf7; modrm_r b ~r:2 ~m:dst
|
||||
let test_rr b ~a ~c = rex b ~w:true ~r:c ~x:0 ~m:a; u8 b 0x85; modrm_r b ~r:c ~m:a
|
||||
|
||||
@ -696,7 +695,7 @@ type fnctx = {
|
||||
|
||||
A count rather than a running tally for [emit.ml]'s reason: the epilogue
|
||||
is emitted after the body, but the pushes are decided before it, by
|
||||
[Emit.dyn_roots], which is deliberately the *same* function both backends
|
||||
[Emit.root_plan], which is deliberately the *same* function both backends
|
||||
call. The pushes and the pops balance because one counter decides both
|
||||
ends, and the two backends root the same nodes because there is one
|
||||
counter and not two. *)
|
||||
@ -943,7 +942,7 @@ let scoped f g =
|
||||
|
||||
(* ── Moving values ───────────────────────────────────────────────────── *)
|
||||
|
||||
(* Scalar in [reg] <- [rbp+off], and back. A bool is a byte; everything else
|
||||
(* Scalar in [reg] <- [rbp+off]. A bool is a byte; everything else
|
||||
is its own width, widened on load. *)
|
||||
let load_scalar f ~reg ~off (t : Types.t) =
|
||||
if is_float t then fload f.b ~dst:reg ~mm:(Frame off) ~f64:(f64_of t)
|
||||
@ -951,26 +950,6 @@ let load_scalar f ~reg ~off (t : Types.t) =
|
||||
let size = match t with Types.Bool -> 1 | _ -> max 1 (sizeof f.md t) in
|
||||
load_int f.b ~dst:reg ~mm:(Frame off) ~size ~signed:(signed_of t)
|
||||
|
||||
let store_scalar f ~reg ~off (t : Types.t) =
|
||||
if is_float t then fstore f.b ~src:reg ~mm:(Frame off) ~f64:(f64_of t)
|
||||
else
|
||||
let size = match t with Types.Bool -> 1 | _ -> max 1 (sizeof f.md t) in
|
||||
store_int f.b ~src:reg ~mm:(Frame off) ~size
|
||||
|
||||
(* Through a pointer rather than a frame offset: the same two, with the
|
||||
address already in a register. *)
|
||||
let load_scalar_at f ~reg ~base ~disp (t : Types.t) =
|
||||
if is_float t then fload f.b ~dst:reg ~mm:(Reg (base, disp)) ~f64:(f64_of t)
|
||||
else
|
||||
let size = match t with Types.Bool -> 1 | _ -> max 1 (sizeof f.md t) in
|
||||
load_int f.b ~dst:reg ~mm:(Reg (base, disp)) ~size ~signed:(signed_of t)
|
||||
|
||||
let store_scalar_at f ~reg ~base ~disp (t : Types.t) =
|
||||
if is_float t then fstore f.b ~src:reg ~mm:(Reg (base, disp)) ~f64:(f64_of t)
|
||||
else
|
||||
let size = match t with Types.Bool -> 1 | _ -> max 1 (sizeof f.md t) in
|
||||
store_int f.b ~src:reg ~mm:(Reg (base, disp)) ~size
|
||||
|
||||
(* n bytes from the address in rsi to the address in rdi. *)
|
||||
let blockcopy f n =
|
||||
if n > 0 then begin
|
||||
@ -981,13 +960,6 @@ let blockcopy f n =
|
||||
rep_movsb f.b
|
||||
end
|
||||
|
||||
let copy_frames f ~dst ~src n =
|
||||
if n > 0 then begin
|
||||
lea f.b ~dst:rdi ~mm:(Frame dst);
|
||||
lea f.b ~dst:rsi ~mm:(Frame src);
|
||||
blockcopy f n
|
||||
end
|
||||
|
||||
let zero_frame f ~dst n =
|
||||
if n > 0 then begin
|
||||
note f (Printf.sprintf "rep stosb: %d bytes of zero, which is what this backend \
|
||||
@ -1449,7 +1421,7 @@ let with_pad f tag g =
|
||||
hands them out, which is what makes the pushes and the pops balance by
|
||||
construction rather than by the body being walked the same way twice.
|
||||
|
||||
[Emit.dyn_roots] counts the same nodes this emission visits, so the supply
|
||||
[Emit.root_plan] counts the same nodes this emission visits, so the supply
|
||||
runs out only if those two disagree — and since both backends call that one
|
||||
function, disagreeing would be one of them visiting a node the other does
|
||||
not. The fallback is an ordinary unrooted temporary, for [emit.ml]'s
|
||||
@ -3007,7 +2979,7 @@ and call_rt f ~sym ~args ~rty dst =
|
||||
the collector finds its roots by address. [dst] is not enough: it is
|
||||
often a temporary inside a [scoped] that the bump allocator is about to
|
||||
hand out again, and it is never a slot anything was pushed for.
|
||||
[Emit.dyn_roots] counted this call, so the slot below is one the entry
|
||||
[Emit.root_plan] counted this call, so the slot below is one the entry
|
||||
block has already zeroed and pushed.
|
||||
|
||||
Here rather than in [call_native], which is [call_c]'s as well: a dyn
|
||||
@ -3777,7 +3749,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
|
||||
everything below it: the shadow stack is a debugging convenience a release
|
||||
build does without, while a collector that cannot find its roots is a
|
||||
collector that frees live values. Only a function with a dyn in it pays
|
||||
anything, because [Emit.dyn_roots] is zero otherwise and not an
|
||||
anything, because [Emit.root_plan] is empty otherwise and not an
|
||||
instruction is emitted — which is what keeps every dyn-free program in the
|
||||
survey byte for byte what it was before this lane.
|
||||
|
||||
|
||||
@ -1,410 +0,0 @@
|
||||
/* flan_dyn_stub — a standing-in implementation of the flan_dyn.h ABI.
|
||||
*
|
||||
* THE MERGE REPLACES THIS FILE WITH runtime/flan_dyn.c. It exists so that the
|
||||
* compiler side of dynamic-by-default can be built and run against the fixed
|
||||
* ABI before the real runtime lands; the real one is being written in parallel
|
||||
* against the same header, and flan_dyn.h is the contract the two are diffed
|
||||
* against.
|
||||
*
|
||||
* What it is not: it mallocs and never frees, it collects nothing, and
|
||||
* flan_dyn_root_push / flan_dyn_root_pop record their arguments and do nothing
|
||||
* with them. That last point matters for anyone reading a passing test here —
|
||||
* root emission is *not* exercised by this file. A program with entirely wrong
|
||||
* root discipline passes every test that runs against this stub. The check
|
||||
* that does bite is the one over the emitted IR, counting pushes against pops
|
||||
* per function; see the acceptance tests.
|
||||
*
|
||||
* The representation is the simplest thing that satisfies the header's rule
|
||||
* that the word is opaque: every value is a pointer to a heap cell, including
|
||||
* the small ones. The real runtime will not do this.
|
||||
*/
|
||||
|
||||
#include <stdint.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <unistd.h>
|
||||
|
||||
/* The compiler carries this file as one string with flan_dyn.h pasted in front
|
||||
* of it (lib/dune), and in that form there is no header on disk to find. The
|
||||
* probe keeps the file compilable both ways: standalone against the real
|
||||
* header, and concatenated, where the declarations are already above. The
|
||||
* header's own include guard makes the two agree. */
|
||||
#if defined(__has_include)
|
||||
# if __has_include("flan_dyn.h")
|
||||
# include "flan_dyn.h"
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/* flan_rt.c's own [rt_trap] is static, so this mirrors it rather than calling
|
||||
* it: print the sentence, offer the name to the dev daemon's hook, and leave
|
||||
* with flan_rt's exit code so that a dyn trap is indistinguishable from any
|
||||
* other trap to whoever is watching. The hook is flan_rt.c's global, and a
|
||||
* program links both files. */
|
||||
extern void (*flan_trap_hook)(const uint8_t *name, int64_t namelen);
|
||||
|
||||
static _Noreturn void dyn_trap(const char *name, const char *sentence) {
|
||||
fflush(stdout);
|
||||
fprintf(stderr, "%s\n", sentence);
|
||||
fflush(stderr);
|
||||
if (flan_trap_hook != NULL)
|
||||
flan_trap_hook((const uint8_t *)name, (int64_t)strlen(name));
|
||||
_exit(134);
|
||||
}
|
||||
|
||||
enum tag { T_NIL, T_I64, T_F64, T_BOOL, T_STR, T_VEC };
|
||||
|
||||
typedef struct cell {
|
||||
enum tag tag;
|
||||
union {
|
||||
int64_t i;
|
||||
double f;
|
||||
int32_t b;
|
||||
struct { uint8_t *ptr; int64_t len; } s;
|
||||
struct { struct cell **items; int64_t len, cap; } v;
|
||||
} u;
|
||||
} cell;
|
||||
|
||||
static cell *alloc(enum tag t) {
|
||||
cell *c = calloc(1, sizeof *c);
|
||||
if (c == NULL) dyn_trap("OutOfMemory", "the dyn runtime could not allocate");
|
||||
c->tag = t;
|
||||
return c;
|
||||
}
|
||||
|
||||
static cell *as(flan_dyn d) { return (cell *)(uintptr_t)d; }
|
||||
static flan_dyn word(cell *c) { return (flan_dyn)(uintptr_t)c; }
|
||||
|
||||
/* ── Construction ──────────────────────────────────────────────────── */
|
||||
|
||||
flan_dyn flan_dyn_nil(void) { return word(alloc(T_NIL)); }
|
||||
|
||||
flan_dyn flan_dyn_from_i64(int64_t v) {
|
||||
cell *c = alloc(T_I64); c->u.i = v; return word(c);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_from_f64(double v) {
|
||||
cell *c = alloc(T_F64); c->u.f = v; return word(c);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_from_bool(int32_t v) {
|
||||
cell *c = alloc(T_BOOL); c->u.b = (v != 0); return word(c);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_from_bytes(const uint8_t *ptr, int64_t len) {
|
||||
cell *c = alloc(T_STR);
|
||||
c->u.s.ptr = malloc((size_t)len + 1);
|
||||
if (c->u.s.ptr == NULL) dyn_trap("OutOfMemory", "the dyn runtime could not allocate");
|
||||
if (len > 0) memcpy(c->u.s.ptr, ptr, (size_t)len);
|
||||
c->u.s.ptr[len] = 0;
|
||||
c->u.s.len = len;
|
||||
return word(c);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_vec_new(void) {
|
||||
cell *c = alloc(T_VEC);
|
||||
c->u.v.cap = 8;
|
||||
c->u.v.items = calloc((size_t)c->u.v.cap, sizeof(cell *));
|
||||
if (c->u.v.items == NULL) dyn_trap("OutOfMemory", "the dyn runtime could not allocate");
|
||||
return word(c);
|
||||
}
|
||||
|
||||
/* ── Arithmetic ────────────────────────────────────────────────────── */
|
||||
|
||||
/* Two numbers promote to f64 when either is one, which is the rule a reader
|
||||
* expects of a dynamic language and is still not the rule the typed language
|
||||
* uses. The typed side widens only where nothing can be lost, and an i64 into
|
||||
* an f64 can — TODO.org, "Implicit numeric widening is legal; narrowing stays
|
||||
* a hard error" — so (+ i64-x 2.5) is written there and is promoted here. The
|
||||
* difference is not an oversight on either side: here there
|
||||
* is no annotation to have been written, so refusing would leave (+ 1 2.5)
|
||||
* with no spelling that works. */
|
||||
static int numeric(cell *c) { return c->tag == T_I64 || c->tag == T_F64; }
|
||||
static double as_f(cell *c) { return c->tag == T_I64 ? (double)c->u.i : c->u.f; }
|
||||
|
||||
static flan_dyn arith(flan_dyn a, flan_dyn b, char op) {
|
||||
cell *x = as(a), *y = as(b);
|
||||
if (!numeric(x) || !numeric(y)) dyn_trap("DynArithType", "this arithmetic needs two numbers, and one of the two values is not one");
|
||||
if (x->tag == T_I64 && y->tag == T_I64) {
|
||||
int64_t p = x->u.i, q = y->u.i, r = 0;
|
||||
switch (op) {
|
||||
case '+': r = p + q; break;
|
||||
case '-': r = p - q; break;
|
||||
case '*': r = p * q; break;
|
||||
case '/': if (q == 0) dyn_trap("DivideByZero", "division by zero"); r = p / q; break;
|
||||
case '%': if (q == 0) dyn_trap("DivideByZero", "division by zero"); r = p % q; break;
|
||||
}
|
||||
return flan_dyn_from_i64(r);
|
||||
}
|
||||
{
|
||||
double p = as_f(x), q = as_f(y), r = 0;
|
||||
switch (op) {
|
||||
case '+': r = p + q; break;
|
||||
case '-': r = p - q; break;
|
||||
case '*': r = p * q; break;
|
||||
case '/': r = p / q; break;
|
||||
/* fmod without math.h, to keep the stub's link line as short as the
|
||||
* real runtime's is meant to be. */
|
||||
case '%': r = p - q * (double)(int64_t)(p / q); break;
|
||||
}
|
||||
return flan_dyn_from_f64(r);
|
||||
}
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
(void)loc; (void)loclen;
|
||||
return arith(a, b, '+');
|
||||
}
|
||||
flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
(void)loc; (void)loclen;
|
||||
return arith(a, b, '-');
|
||||
}
|
||||
flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
(void)loc; (void)loclen;
|
||||
return arith(a, b, '*');
|
||||
}
|
||||
flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
(void)loc; (void)loclen;
|
||||
return arith(a, b, '/');
|
||||
}
|
||||
flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
(void)loc; (void)loclen;
|
||||
return arith(a, b, '%');
|
||||
}
|
||||
|
||||
/* ── Ordering and equality ─────────────────────────────────────────── */
|
||||
|
||||
static int cmp(flan_dyn a, flan_dyn b) {
|
||||
cell *x = as(a), *y = as(b);
|
||||
if (x->tag == T_STR && y->tag == T_STR) {
|
||||
int64_t n = x->u.s.len < y->u.s.len ? x->u.s.len : y->u.s.len;
|
||||
int r = memcmp(x->u.s.ptr, y->u.s.ptr, (size_t)n);
|
||||
if (r != 0) return r < 0 ? -1 : 1;
|
||||
return x->u.s.len == y->u.s.len ? 0 : (x->u.s.len < y->u.s.len ? -1 : 1);
|
||||
}
|
||||
if (!numeric(x) || !numeric(y)) dyn_trap("DynCompareType", "these two values have no ordering between them");
|
||||
if (x->tag == T_I64 && y->tag == T_I64)
|
||||
return x->u.i == y->u.i ? 0 : (x->u.i < y->u.i ? -1 : 1);
|
||||
{
|
||||
double p = as_f(x), q = as_f(y);
|
||||
return p == q ? 0 : (p < q ? -1 : 1);
|
||||
}
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
(void)loc; (void)loclen;
|
||||
return flan_dyn_from_bool(cmp(a, b) < 0);
|
||||
}
|
||||
flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
(void)loc; (void)loclen;
|
||||
return flan_dyn_from_bool(cmp(a, b) <= 0);
|
||||
}
|
||||
flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
(void)loc; (void)loclen;
|
||||
return flan_dyn_from_bool(cmp(a, b) > 0);
|
||||
}
|
||||
flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
(void)loc; (void)loclen;
|
||||
return flan_dyn_from_bool(cmp(a, b) >= 0);
|
||||
}
|
||||
|
||||
/* Structural, and never traps — the header's one exception. */
|
||||
static int eq(cell *x, cell *y) {
|
||||
if (numeric(x) && numeric(y)) {
|
||||
if (x->tag == T_I64 && y->tag == T_I64) return x->u.i == y->u.i;
|
||||
return as_f(x) == as_f(y);
|
||||
}
|
||||
if (x->tag != y->tag) return 0;
|
||||
switch (x->tag) {
|
||||
case T_NIL: return 1;
|
||||
case T_BOOL: return x->u.b == y->u.b;
|
||||
case T_STR: return x->u.s.len == y->u.s.len
|
||||
&& memcmp(x->u.s.ptr, y->u.s.ptr, (size_t)x->u.s.len) == 0;
|
||||
case T_VEC: {
|
||||
if (x->u.v.len != y->u.v.len) return 0;
|
||||
for (int64_t i = 0; i < x->u.v.len; i++)
|
||||
if (!eq(x->u.v.items[i], y->u.v.items[i])) return 0;
|
||||
return 1;
|
||||
}
|
||||
default: return 0;
|
||||
}
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b) {
|
||||
return flan_dyn_from_bool(eq(as(a), as(b)));
|
||||
}
|
||||
|
||||
/* ── Containers ────────────────────────────────────────────────────── */
|
||||
|
||||
static cell *need_vec(flan_dyn v) {
|
||||
cell *c = as(v);
|
||||
if (c->tag != T_VEC) dyn_trap("DynNotAVec", "this value is not a vector, so it has no elements");
|
||||
return c;
|
||||
}
|
||||
|
||||
static int64_t need_index(flan_dyn i) {
|
||||
cell *c = as(i);
|
||||
if (c->tag != T_I64) dyn_trap("DynIndexType", "an index must be an integer");
|
||||
return c->u.i;
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_len(flan_dyn v) {
|
||||
cell *c = as(v);
|
||||
if (c->tag == T_STR) return flan_dyn_from_i64(c->u.s.len);
|
||||
return flan_dyn_from_i64(need_vec(v)->u.v.len);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i) {
|
||||
cell *c = need_vec(v);
|
||||
int64_t k = need_index(i);
|
||||
if (k < 0 || k >= c->u.v.len) dyn_trap("Bounds", "index out of bounds");
|
||||
return word(c->u.v.items[k]);
|
||||
}
|
||||
|
||||
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x) {
|
||||
cell *c = need_vec(v);
|
||||
int64_t k = need_index(i);
|
||||
if (k < 0 || k >= c->u.v.len) dyn_trap("Bounds", "index out of bounds");
|
||||
c->u.v.items[k] = as(x);
|
||||
}
|
||||
|
||||
void flan_dyn_push(flan_dyn v, flan_dyn x) {
|
||||
cell *c = need_vec(v);
|
||||
if (c->u.v.len == c->u.v.cap) {
|
||||
int64_t cap = c->u.v.cap * 2;
|
||||
cell **items = realloc(c->u.v.items, (size_t)cap * sizeof(cell *));
|
||||
if (items == NULL) dyn_trap("OutOfMemory", "the dyn runtime could not allocate");
|
||||
c->u.v.items = items;
|
||||
c->u.v.cap = cap;
|
||||
}
|
||||
c->u.v.items[c->u.v.len++] = as(x);
|
||||
}
|
||||
|
||||
static void print_cell(cell *c) {
|
||||
switch (c->tag) {
|
||||
case T_NIL: fputs("nil", stdout); break;
|
||||
case T_I64: printf("%lld", (long long)c->u.i); break;
|
||||
/* %g, so that a whole-numbered f64 does not print as an i64 would and
|
||||
* the two remain distinguishable in a test's expected output. */
|
||||
case T_F64: printf("%g", c->u.f); break;
|
||||
case T_BOOL: fputs(c->u.b ? "true" : "false", stdout); break;
|
||||
case T_STR: printf("%.*s", (int)c->u.s.len, (const char *)c->u.s.ptr); break;
|
||||
case T_VEC:
|
||||
fputc('[', stdout);
|
||||
for (int64_t i = 0; i < c->u.v.len; i++) {
|
||||
if (i > 0) fputc(' ', stdout);
|
||||
print_cell(c->u.v.items[i]);
|
||||
}
|
||||
fputc(']', stdout);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
void flan_dyn_print(flan_dyn v) { print_cell(as(v)); }
|
||||
|
||||
/* ── Extraction ────────────────────────────────────────────────────── */
|
||||
|
||||
int64_t flan_dyn_need_i64(flan_dyn v) {
|
||||
cell *c = as(v);
|
||||
if (c->tag != T_I64) dyn_trap("DynExpectedI64", "this value was required to be an i64 and is not");
|
||||
return c->u.i;
|
||||
}
|
||||
|
||||
double flan_dyn_need_f64(flan_dyn v) {
|
||||
cell *c = as(v);
|
||||
/* An i64 satisfies an f64 slot, because a dyn integer literal is an i64 by
|
||||
* the header's rule and (defonce x f64 (f 1)) would otherwise be unwritable
|
||||
* for any f returning dyn. The reverse is not true: f64 to i64 loses. */
|
||||
if (c->tag == T_I64) return (double)c->u.i;
|
||||
if (c->tag != T_F64) dyn_trap("DynExpectedF64", "this value was required to be an f64 and is not");
|
||||
return c->u.f;
|
||||
}
|
||||
|
||||
int32_t flan_dyn_need_bool(flan_dyn v) {
|
||||
cell *c = as(v);
|
||||
if (c->tag != T_BOOL) dyn_trap("DynExpectedBool", "this value was required to be a bool and is not");
|
||||
return c->u.b;
|
||||
}
|
||||
|
||||
/* The cast boundary's tag question — see flan_dyn.h. The stub keeps its own
|
||||
* trap vocabulary, as every function above it does; what it must agree with
|
||||
* the real runtime about is the *answer*, 1 for a float box and 0 for an int
|
||||
* one, because that is what the compiler branches on. The once-per-site
|
||||
* table is the real runtime's word for word: a program built against the
|
||||
* stub that warns twice for one line would be a difference in the
|
||||
* diagnostic, which is the thing this pair exists to keep identical. */
|
||||
|
||||
#define STUB_SITE_MAX 64
|
||||
|
||||
static struct { const uint8_t *ptr; int64_t len; } stub_warned[STUB_SITE_MAX];
|
||||
static int stub_warned_count;
|
||||
|
||||
int32_t flan_dyn_cast_kind(flan_dyn v, const uint8_t *loc, int64_t loc_len,
|
||||
const uint8_t *target, int64_t target_len,
|
||||
int32_t want_float) {
|
||||
cell *c = as(v);
|
||||
if (c->tag != T_I64 && c->tag != T_F64)
|
||||
dyn_trap("DynExpectedNumber",
|
||||
"a numeric cast was written on this value and it is not a number");
|
||||
int32_t is_float = c->tag == T_F64 ? 1 : 0;
|
||||
if (is_float != (want_float ? 1 : 0)) {
|
||||
int first = 1;
|
||||
for (int i = 0; i < stub_warned_count; i++)
|
||||
if (stub_warned[i].len == loc_len &&
|
||||
memcmp(stub_warned[i].ptr, loc, (size_t)loc_len) == 0)
|
||||
first = 0;
|
||||
if (first) {
|
||||
if (stub_warned_count < STUB_SITE_MAX) {
|
||||
stub_warned[stub_warned_count].ptr = loc;
|
||||
stub_warned[stub_warned_count].len = loc_len;
|
||||
stub_warned_count++;
|
||||
}
|
||||
fflush(stdout);
|
||||
fprintf(stderr,
|
||||
"flan %.*s: (%.*s x) found a dyn holding %s, and converted it "
|
||||
"to %.*s — warned once for this site\n",
|
||||
(int)loc_len, (const char *)loc, (int)target_len,
|
||||
(const char *)target, is_float ? "a float" : "an int",
|
||||
(int)target_len, (const char *)target);
|
||||
}
|
||||
}
|
||||
return is_float;
|
||||
}
|
||||
|
||||
/* ── Roots ─────────────────────────────────────────────────────────────
|
||||
*
|
||||
* Recorded and otherwise ignored. The shadow stack is kept, and its depth
|
||||
* checked against the pops, only so that a badly unbalanced emission fails
|
||||
* loudly here rather than silently: an over-pop is a compiler bug worth
|
||||
* dying on even in a stub that collects nothing. Under-pushing is invisible,
|
||||
* and stays invisible until the real collector lands. */
|
||||
|
||||
static flan_dyn **roots = NULL;
|
||||
static int64_t roots_len = 0, roots_cap = 0;
|
||||
|
||||
void flan_dyn_root_push(flan_dyn *slot) {
|
||||
if (roots_len == roots_cap) {
|
||||
int64_t cap = roots_cap == 0 ? 64 : roots_cap * 2;
|
||||
flan_dyn **r = realloc(roots, (size_t)cap * sizeof(flan_dyn *));
|
||||
if (r == NULL) dyn_trap("OutOfMemory", "the dyn runtime could not allocate");
|
||||
roots = r;
|
||||
roots_cap = cap;
|
||||
}
|
||||
roots[roots_len++] = slot;
|
||||
}
|
||||
|
||||
void flan_dyn_root_pop(int64_t n) {
|
||||
if (n < 0 || n > roots_len) dyn_trap("DynRootUnderflow", "the dyn root stack was popped further than it was pushed - a compiler bug");
|
||||
roots_len -= n;
|
||||
}
|
||||
|
||||
void flan_gc_init(void) { /* nothing to initialise: this stub never collects */ }
|
||||
@ -5,14 +5,13 @@
|
||||
;;;; parked program is answered by the parking path. This one keeps running,
|
||||
;;;; which is the state nothing had pinned: there is no agent in the process to
|
||||
;;;; hand a module to and no socket to fall back on, so the daemon refuses the
|
||||
;;;; delivery and says which socket it could not reach.
|
||||
;;;; delivery.
|
||||
;;;;
|
||||
;;;; That is the honest answer for it. The sentence [install_note] keeps for a
|
||||
;;;; running program with no socket — queued, installs at its next
|
||||
;;;; (agent/poll) — was true of a program that *links* the agent and has not
|
||||
;;;; reached its (agent/start ...) yet, because there the ring is reachable
|
||||
;;;; in-process while the socket is not yet bound. The package's constructor
|
||||
;;;; binds before main now, so that window is gone; see TODO.org, "(agent/start) takes no argument, and binds before main".
|
||||
;;;; That is the honest answer for it: the reply says the program has no agent
|
||||
;;;; and how to add one. A program that *links* the agent has its socket bound
|
||||
;;;; by the package's constructor before main, and the one way that bind fails
|
||||
;;;; — a socket path too long for a unix socket — is refused when flan dev
|
||||
;;;; starts.
|
||||
;;;;
|
||||
;;;; So: no (import agent ...) anywhere, and a loop that outlasts the test.
|
||||
(defn step [] i64 7)
|
||||
|
||||
2
test/programs/dev-nomain.flan
Normal file
2
test/programs/dev-nomain.flan
Normal file
@ -0,0 +1,2 @@
|
||||
;;;; A file with no main: flan dev has nothing to run, and says so before building.
|
||||
(defn helper [] i64 1)
|
||||
@ -1,8 +0,0 @@
|
||||
;;;; `free` consumes its argument exactly as any other move does, so the second
|
||||
;;;; one is a compile error rather than a runtime crash. Nothing analyses this
|
||||
;;;; specially: it is the same dead-binding rule as passing one to a function.
|
||||
(defn main [] i32
|
||||
(let [v (vec-new i32)]
|
||||
(free v)
|
||||
(free v)
|
||||
0))
|
||||
@ -1,8 +0,0 @@
|
||||
;;;; A loop body that moves a binding declared outside the loop: the second
|
||||
;;;; iteration would use what the first gave away. The dead set alone cannot
|
||||
;;;; see this — merged once at the end of the body it counts one move, not two
|
||||
;;;; — so it is a rule, and it is refused with the reason.
|
||||
(defn main [] i32
|
||||
(let [v (vec-new i32)]
|
||||
(dotimes [i 3] (free v))
|
||||
0))
|
||||
@ -1,15 +0,0 @@
|
||||
;;;; A Vec is move-only: passing one to a function transfers ownership, and the
|
||||
;;;; source binding is dead afterwards. That rule is what makes a double free
|
||||
;;;; unrepresentable, which is why `free` needs no analysis of its own.
|
||||
(defn take [v (Vec i32)] i32
|
||||
(let [n (length v)]
|
||||
(free v)
|
||||
n))
|
||||
|
||||
(defn main [] i32
|
||||
(let [v (vec-new i32)]
|
||||
(push v 1)
|
||||
(println (take v))
|
||||
;; v went with the call. Being refused here is the whole test.
|
||||
(println (length v))
|
||||
0))
|
||||
152
test/test_dev.ml
152
test/test_dev.ml
@ -4748,14 +4748,14 @@ let () =
|
||||
contains_sub
|
||||
(try In_channel.with_open_bin nlog In_channel.input_all
|
||||
with Sys_error _ -> "")
|
||||
"does it call (agent/start ...)?"
|
||||
"(import agent \"vendor:agent\")"
|
||||
in
|
||||
ignore (await ~ms:30000 nlog_says);
|
||||
(try Unix.kill npid Sys.sigkill with Unix.Unix_error _ -> ());
|
||||
(try ignore (Unix.waitpid [] npid) with Unix.Unix_error _ -> ());
|
||||
if not (nlog_says ()) then
|
||||
fail
|
||||
"a program without (agent/start ...) drew no warning from flan dev:\n%s"
|
||||
"a program with no agent drew no warning from flan dev:\n%s"
|
||||
(try In_channel.with_open_bin nlog In_channel.input_all
|
||||
with Sys_error _ -> "");
|
||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
|
||||
@ -4767,20 +4767,12 @@ let () =
|
||||
reply an editor gets for a redefinition, and it is here because that
|
||||
reply was never pinned and this lane changed which of two it is.
|
||||
|
||||
[install_note] has a sentence for a RUNNING program whose socket is not
|
||||
bound — queued, installs at its next [(agent/poll)], not at all if there
|
||||
is never one. It was true of exactly one thing: a merged session whose
|
||||
program links the agent, so the ring is reachable in-process, but has
|
||||
not got to its [(agent/start ...)] yet. The constructor closed that
|
||||
window, so nothing reaches the sentence any more; the late-agent row
|
||||
below asserts its absence, and TODO.org's entry on the unreachable
|
||||
agent-start note says the branch can be retired.
|
||||
|
||||
A program that does not link the agent at all never reached it either,
|
||||
and this row is what says so rather than leaving it to be assumed. There
|
||||
is no agent in this process to call and no socket to fall back to, so
|
||||
the delivery is REFUSED — which is the honest answer and not the note:
|
||||
"queued" would have promised a poll that has nothing to drain.
|
||||
A program that does not link the agent at all has no agent in this
|
||||
process to call and no socket to fall back to, so the delivery is
|
||||
REFUSED, and the reply says the program has no agent and how to give it
|
||||
one — both for a redefinition and for an expression. "Queued" would
|
||||
have promised a poll that has nothing to drain, and "connect: No such
|
||||
file or directory" names a path the reader never chose.
|
||||
|
||||
It needs the program to be running, which is why it is not folded into
|
||||
the row above: dev-noagent.flan's main returns, so it parks within the
|
||||
@ -4809,9 +4801,14 @@ let () =
|
||||
\"programs/dev-noagent-running.flan\")"
|
||||
in
|
||||
let msg = Option.value ~default:"" (Wire.string_field r "message") in
|
||||
(* Refused, and the reason names the socket it could not reach rather
|
||||
than the compiler: the module built, and what failed is the hand-off
|
||||
to a program that has no agent in it. *)
|
||||
(* Refused, and the reason is the program's rather than the compiler's:
|
||||
the module built, and what is missing is an agent to hand it to. The
|
||||
fix it names is the import. *)
|
||||
let names_the_fix m =
|
||||
contains_sub m "has no agent"
|
||||
&& contains_sub m "(import agent \"vendor:agent\")"
|
||||
&& contains_sub m "(agent/poll)"
|
||||
in
|
||||
if status r = "ok" then
|
||||
fail
|
||||
"a redefinition for a program with no agent in it was answered \
|
||||
@ -4819,9 +4816,20 @@ let () =
|
||||
(match Wire.string_field r "note" with
|
||||
| Some n -> Printf.sprintf " (note: %S)" n
|
||||
| None -> "")
|
||||
else if not (contains_sub msg "cannot reach the program on ") then
|
||||
else if not (names_the_fix msg) then
|
||||
fail "a delivery to a running agentless program was refused with: %S"
|
||||
msg;
|
||||
(* And an expression, which used to be answered with the connect's own
|
||||
errno. *)
|
||||
let r =
|
||||
request gc
|
||||
"(:op \"eval-expr\" :code \"(step)\" :file \
|
||||
\"programs/dev-noagent-running.flan\")"
|
||||
in
|
||||
let msg = Option.value ~default:"" (Wire.string_field r "message") in
|
||||
if status r = "ok" || not (names_the_fix msg) then
|
||||
fail "an expression for a running agentless program was answered %s: %S"
|
||||
(status r) msg;
|
||||
(* And the session is still there afterwards, which is the rest of the
|
||||
claim: a refusal is a reply, not the end. *)
|
||||
(match request gc "(:op \"describe\")" with
|
||||
@ -4843,6 +4851,65 @@ let () =
|
||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
|
||||
[ gsock; glog ];
|
||||
|
||||
(* ── What stops a session from starting, said at the start ─────────
|
||||
|
||||
Three things a session cannot start without, each refused before
|
||||
anything is built, in both shapes, with the fix named: a TMPDIR that
|
||||
does not exist (it was an uncaught ENOENT out of mkdir), one so deep
|
||||
that the agent's socket path does not fit in a unix socket address
|
||||
(the bind failed where nobody heard it, and every reply after that
|
||||
said "File name too long" or asked about (agent/start ...)), and a
|
||||
program with no main (a link error, or a sentence about the merged
|
||||
build's internals). *)
|
||||
let refused_at_start what ~tmpdir ~prog ~mode want =
|
||||
let out = tmp "start-refusal.out" in
|
||||
let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
||||
let env =
|
||||
Array.append
|
||||
[| "TMPDIR=" ^ tmpdir |]
|
||||
(Array.of_list
|
||||
(List.filter
|
||||
(fun v -> not (String.starts_with ~prefix:"TMPDIR=" v))
|
||||
(Array.to_list (Unix.environment ()))))
|
||||
in
|
||||
let argv =
|
||||
Array.append [| flan; "dev"; prog; "-s"; tmp "start-refusal.sock" |] mode
|
||||
in
|
||||
let pid = Unix.create_process_env flan argv env Unix.stdin fd fd in
|
||||
Unix.close fd;
|
||||
let _, st = Unix.waitpid [] pid in
|
||||
let said = In_channel.with_open_bin out In_channel.input_all in
|
||||
(try Sys.remove out with Sys_error _ -> ());
|
||||
let shape = if mode = [||] then "one process" else "--two-process" in
|
||||
(match st with
|
||||
| Unix.WEXITED 1 -> ()
|
||||
| _ -> fail "%s (%s): flan dev did not exit 1: %S" what shape said);
|
||||
List.iter
|
||||
(fun w ->
|
||||
if not (contains_sub said w) then
|
||||
fail "%s (%s): the refusal does not say %S: %S" what shape w said)
|
||||
want
|
||||
in
|
||||
let here = Filename.get_temp_dir_name () in
|
||||
let deep =
|
||||
Filename.concat here (String.make (max 1 (110 - String.length here)) 'd')
|
||||
in
|
||||
Unix.mkdir deep 0o700;
|
||||
let missing = Filename.concat here "no-such-directory" in
|
||||
let nomain = "programs/dev-nomain.flan" in
|
||||
List.iter
|
||||
(fun mode ->
|
||||
refused_at_start "a TMPDIR too deep for a socket path" ~tmpdir:deep
|
||||
~prog:"programs/dev-lateagent.flan" ~mode
|
||||
[ "at most 107 bytes"; "TMPDIR=/tmp flan dev" ];
|
||||
refused_at_start "a TMPDIR that does not exist" ~tmpdir:missing
|
||||
~prog:"programs/dev-lateagent.flan" ~mode
|
||||
[ missing ^ " does not exist"; "TMPDIR=/tmp flan dev" ];
|
||||
refused_at_start "a program with no main" ~tmpdir:here ~prog:nomain
|
||||
~mode [ "has no main"; "(defn main [] i32" ])
|
||||
[ [||]; [| "--two-process" |] ];
|
||||
(try Unix.rmdir deep with Unix.Unix_error _ -> ());
|
||||
|
||||
(* ── A build that fails is a refusal, not the end of the session ── *)
|
||||
|
||||
(* Evaluating runs a compiler, and a compiler can fail in ways the
|
||||
@ -6751,36 +6818,33 @@ let () =
|
||||
fail
|
||||
"the first editor request waited %.1fs on a program whose agent \
|
||||
starts late; the accept loop is gated on the agent again" ldt;
|
||||
(* And the delivery, also inside the delay. It is taken, and it carries
|
||||
no note about [(agent/start ...)]: that sentence is for a program
|
||||
whose socket is not bound, and the constructor bound this one before
|
||||
main. [install_note] answering nothing here is therefore the evidence
|
||||
that the socket is up — the assertion is on the absence because the
|
||||
absence is the claim.
|
||||
|
||||
It used to be the presence. The program's own start call is still
|
||||
three seconds away, so this is the same moment it always was; what
|
||||
changed is that the moment is no longer one in which the program
|
||||
cannot be reached. lib/dev.ml's branch still says the true thing for
|
||||
a program that does not link the agent at all (the agentless row
|
||||
above), and TODO.org's entry on the unreachable agent-start note
|
||||
records that a dev program which links it can no longer get
|
||||
there. *)
|
||||
(* The socket is up inside the delay, three seconds before the program's
|
||||
own start call: the constructor bound it before main. Checked on the
|
||||
file itself, at the path the daemon named in FLAN_AGENT_SOCKET — the
|
||||
merged build execs in place, so its directory carries the daemon's
|
||||
pid. *)
|
||||
let agent_sock =
|
||||
Filename.concat
|
||||
(Filename.concat (Filename.get_temp_dir_name ())
|
||||
(Printf.sprintf "flan-dev-%d" lpid))
|
||||
"agent.sock"
|
||||
in
|
||||
(match (Unix.stat agent_sock).Unix.st_kind with
|
||||
| Unix.S_SOCK -> ()
|
||||
| _ -> fail "%s is not a socket" agent_sock
|
||||
| exception Unix.Unix_error (e, _, _) ->
|
||||
fail
|
||||
"the agent socket was not bound before main: %s: %s" agent_sock
|
||||
(Unix.error_message e));
|
||||
(* And the delivery, also inside the delay. It is taken. *)
|
||||
let r =
|
||||
request lc
|
||||
"(:op \"eval\" :code \"(defn step [] i64 9)\" :file \
|
||||
\"programs/dev-lateagent.flan\")"
|
||||
in
|
||||
if status r <> "ok" then
|
||||
fail "a redefinition sent before (agent/start ...): %s" (said r)
|
||||
else begin
|
||||
let note = Option.value ~default:"" (Wire.string_field r "note") in
|
||||
if contains_sub note "(agent/start ...)" then
|
||||
fail
|
||||
"the agent socket was not bound before main, so a delivery was \
|
||||
told to wait for a call the program had not made: %S" note
|
||||
end;
|
||||
(* The claim the note makes, checked against the program rather than
|
||||
fail "a redefinition sent before (agent/start ...): %s" (said r);
|
||||
(* The delivery, checked against the program rather than
|
||||
against the reply: once the sleep is over and the program is polling,
|
||||
the body that was queued is the one that runs. [await] because the
|
||||
moment the agent comes up is the program's to choose, and each
|
||||
|
||||
@ -179,8 +179,8 @@ let check label path args ~checks =
|
||||
- dev-* and reload-*, which need a host process or a dlopen harness.
|
||||
- the compile-time refusals: nth-gone, pkg-hidden-main, pkg-two-aliases,
|
||||
pkg-two-mains, pkg-cycle, pkg-alias-clash, user-allocator, and the whole
|
||||
vec-moved / vec-double-free / vec-in-struct / vec-global / vec-to-c /
|
||||
vec-untyped family. These never produce a binary at all: the
|
||||
vec-in-struct / vec-global / vec-to-c / vec-untyped family. These never
|
||||
produce a binary at all: the
|
||||
checker refuses them, which is the point of them. There is nothing for
|
||||
memcheck to run.
|
||||
- shadow-pkg.flan, which is a package fragment with no main and does not
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user