Merge: the dev daemon compiles with its own backend unless asked not to
This commit is contained in:
commit
69c033e946
11
NEXT.md
11
NEXT.md
@ -6,6 +6,17 @@
|
|||||||
|
|
||||||
## The core thesis is done
|
## The core thesis is done
|
||||||
|
|
||||||
|
**`flan dev` is the x86 backend now, with `--llvm` to leave it.** The flag that used to turn it on is the flag
|
||||||
|
that says you meant it; every other command is LLVM by default and unmoved, which is also what keeps
|
||||||
|
`lib/x86.ml`'s convention licensed — a dev build compiled entirely by it, a release build entirely by LLVM.
|
||||||
|
`--debug` picks LLVM on its own, because a redefinition module from this backend carries no line table.
|
||||||
|
|
||||||
|
What the flip costs, and it is more than the refusals: **there is no shadow stack here**, so a session built by
|
||||||
|
it stops on an error and cannot say where — no backtrace, no locals, no globals. The agent used to answer that
|
||||||
|
with "this program was not built with --dev", which is false of an x86 dev host; `Dev.ask` now rewrites it into
|
||||||
|
a sentence naming `--llvm`. `C-u C-c C-a` (the IR view) is gone for the same reason and refuses by name too.
|
||||||
|
Both are documented in `emacs/MANUAL.md`. Frame pushes in `X86.program` would close the larger of the two.
|
||||||
|
|
||||||
`flan dev --x86` works. The hand-written backend now serves the editor, which is the only thing it was ever
|
`flan dev --x86` works. The hand-written backend now serves the editor, which is the only thing it was ever
|
||||||
for, and it is roughly twice as fast as the LLVM path:
|
for, and it is roughly twice as fast as the LLVM path:
|
||||||
|
|
||||||
|
|||||||
11
README.md
11
README.md
@ -124,7 +124,7 @@ Eleven of them, and the four anyone starts with:
|
|||||||
flan check <file.flan> type-check a program
|
flan check <file.flan> type-check a program
|
||||||
flan run <file.flan> [flags] [-- args...] build and run it
|
flan run <file.flan> [flags] [-- args...] build and run it
|
||||||
flan build <file.flan> [-o out] [flags] build a native executable
|
flan build <file.flan> [-o out] [flags] build a native executable
|
||||||
flan dev <file.flan> [-s socket] start a live development session
|
flan dev <file.flan> [-s socket] [--llvm] start a live development session
|
||||||
```
|
```
|
||||||
|
|
||||||
Useful build options include `-O0`…`-O3`, `--debug`, `--sanitize`,
|
Useful build options include `-O0`…`-O3`, `--debug`, `--sanitize`,
|
||||||
@ -135,6 +135,15 @@ guessed at. `run` is native-only; cross-built output should be run with an
|
|||||||
appropriate WASI runtime or browser. A `.wasm` file is not a tiny native
|
appropriate WASI runtime or browser. A `.wasm` file is not a tiny native
|
||||||
executable in a trench coat.
|
executable in a trench coat.
|
||||||
|
|
||||||
|
`--x86` picks the hand-written backend (lib/x86.ml) instead of LLVM, and
|
||||||
|
`flan dev` is the one command that takes it unasked: a dev session is what it
|
||||||
|
was written for, it halves the `C-c C-c` round trip, and nothing it builds
|
||||||
|
outlives the session. `--llvm` is how to ask for the other one there — for a
|
||||||
|
program this backend refuses by name, for `--debug`, and for the inspector,
|
||||||
|
which walks a shadow stack it does not push. Every other command here is LLVM
|
||||||
|
by default and stays that way; `emacs/MANUAL.md` lists what the dev backend
|
||||||
|
does not do.
|
||||||
|
|
||||||
The other seven. Four print a stage of the pipeline, which is how you find out
|
The other seven. Four print a stage of the pipeline, which is how you find out
|
||||||
what the compiler thinks it was given:
|
what the compiler thinks it was given:
|
||||||
|
|
||||||
|
|||||||
120
bin/main.ml
120
bin/main.ml
@ -4,8 +4,15 @@
|
|||||||
still exits 1 and still opens with [file:line:col: message]; a driver that
|
still exits 1 and still opens with [file:line:col: message]; a driver that
|
||||||
got to the end of the file hands over everything it found, sorted, with a
|
got to the end of the file hands over everything it found, sorted, with a
|
||||||
count after it. Nothing here parses the message — the squiggle comes from
|
count after it. Nothing here parses the message — the squiggle comes from
|
||||||
the span and the classification from the kind. *)
|
the span and the classification from the kind.
|
||||||
let with_errors path f =
|
|
||||||
|
[?x86_hint] is the one thing here that is not the same for every command.
|
||||||
|
A refusal from the dev backend is actionable in a different way depending on
|
||||||
|
how that backend was chosen: somebody who typed [--x86] already knows they
|
||||||
|
asked for it, and somebody who typed [flan dev] did not ask for anything.
|
||||||
|
The second is the common case now that it is the default, so the command
|
||||||
|
that takes it by default hands over the sentence naming the way out. *)
|
||||||
|
let with_errors ?x86_hint path f =
|
||||||
try f () with
|
try f () with
|
||||||
| Flan.Loc.Error d ->
|
| Flan.Loc.Error d ->
|
||||||
prerr_endline (Flan.Loc.report d);
|
prerr_endline (Flan.Loc.report d);
|
||||||
@ -21,6 +28,7 @@ let with_errors path f =
|
|||||||
"did not compile". *)
|
"did not compile". *)
|
||||||
| Flan.X86.Unsupported m ->
|
| Flan.X86.Unsupported m ->
|
||||||
prerr_endline ("x86: " ^ m);
|
prerr_endline ("x86: " ^ m);
|
||||||
|
Option.iter prerr_endline x86_hint;
|
||||||
ignore path;
|
ignore path;
|
||||||
exit 3
|
exit 3
|
||||||
(* The JS dialect's refusal, and the same status for the same reason. It is
|
(* The JS dialect's refusal, and the same status for the same reason. It is
|
||||||
@ -152,12 +160,34 @@ let sanitize_flag = "--sanitize"
|
|||||||
let two_process_flag = "--two-process"
|
let two_process_flag = "--two-process"
|
||||||
|
|
||||||
(* The hand-written x86-64 backend (lib/x86.ml) instead of LLVM. The dev
|
(* The hand-written x86-64 backend (lib/x86.ml) instead of LLVM. The dev
|
||||||
backend from docs/DISCUSS.md item 15, off by default and named explicitly:
|
backend from docs/DISCUSS.md item 15. It covers a subset of the IR and
|
||||||
LLVM stays the release path and the default one. It covers a subset of the
|
refuses the rest by name, so a build that succeeds is one it really
|
||||||
IR and refuses the rest by name, so a build that succeeds is one it really
|
compiled.
|
||||||
compiled. *)
|
|
||||||
|
Where it is the default and where it is not is the whole of the split: it
|
||||||
|
is the dev backend, so [flan dev] takes it unasked, and every other command
|
||||||
|
here builds something that outlives the session and stays on LLVM. That is
|
||||||
|
also what keeps [lib/x86.ml]'s calling convention licensed — a dev build is
|
||||||
|
compiled entirely by it and a release build entirely by LLVM, so the two
|
||||||
|
never meet in one process. On the commands that are still LLVM by default
|
||||||
|
this flag is how you ask for the other backend; on [flan dev] it is how you
|
||||||
|
say you meant it, which is what keeps [--x86 --debug] refused by name
|
||||||
|
rather than reached by accident. *)
|
||||||
let x86_flag = "--x86"
|
let x86_flag = "--x86"
|
||||||
|
|
||||||
|
(* The other direction, and it exists because [flan dev] changed sides: a dev
|
||||||
|
session is the x86 backend now, and this is how to ask for the one that
|
||||||
|
compiles every node. The two reasons to want it are the ones the backend
|
||||||
|
itself names — a program it refuses, and [--debug], which it has no line
|
||||||
|
table for in a redefinition module.
|
||||||
|
|
||||||
|
Every other command already builds through LLVM, so there it names the
|
||||||
|
default and is accepted and ignored. That is deliberate rather than an
|
||||||
|
oversight in the flag table: a flag that states what a command was going to
|
||||||
|
do anyway is a true sentence, and refusing it would make the one spelling
|
||||||
|
mean two different things depending on which subcommand it followed. *)
|
||||||
|
let llvm_flag = "--llvm"
|
||||||
|
|
||||||
(* [flan emit --x86] annotates, because it exists to be read. This turns that
|
(* [flan emit --x86] annotates, because it exists to be read. This turns that
|
||||||
off, and the only caller who wants it is the test that assembles the listing
|
off, and the only caller who wants it is the test that assembles the listing
|
||||||
both ways and compares the object's sections byte for byte -- a claim that
|
both ways and compares the object's sections byte for byte -- a claim that
|
||||||
@ -167,7 +197,28 @@ let no_annotate_flag = "--no-annotate"
|
|||||||
|
|
||||||
let flags =
|
let flags =
|
||||||
[ no_checks_flag; dev_flag; debug_flag; sanitize_flag; two_process_flag;
|
[ no_checks_flag; dev_flag; debug_flag; sanitize_flag; two_process_flag;
|
||||||
x86_flag; no_annotate_flag ]
|
x86_flag; llvm_flag; no_annotate_flag ]
|
||||||
|
|
||||||
|
(* Which backend a command got, from the two flags and the default it would
|
||||||
|
have taken. One function because there is one rule, and the only thing that
|
||||||
|
varies is which way it falls with neither flag given: [flan dev] true, every
|
||||||
|
other command false.
|
||||||
|
|
||||||
|
Both flags together is refused rather than resolved. Last-one-wins is what
|
||||||
|
[-O] does above, but an optimisation level is a dial and this is a fork: the
|
||||||
|
two backends disagree on every aggregate, and someone who wrote both
|
||||||
|
spellings does not know which half of their session they were asking about.
|
||||||
|
A sentence is more use than a coin flip. *)
|
||||||
|
let backend_x86 ~default args =
|
||||||
|
let x86 = List.mem x86_flag args and llvm = List.mem llvm_flag args in
|
||||||
|
if x86 && llvm then begin
|
||||||
|
prerr_endline
|
||||||
|
"flan: --x86 and --llvm together — one process is compiled by one \
|
||||||
|
backend, so this asks a question with no answer. Pick the one you \
|
||||||
|
meant.";
|
||||||
|
exit 2
|
||||||
|
end;
|
||||||
|
if x86 then true else if llvm then false else default
|
||||||
|
|
||||||
(* [--target=wasm32-wasi] and [--target=web], the two cross targets. Unlike
|
(* [--target=wasm32-wasi] and [--target=web], the two cross targets. Unlike
|
||||||
the flags above, a target
|
the flags above, a target
|
||||||
@ -574,7 +625,11 @@ let () =
|
|||||||
let dev = List.mem dev_flag rest in
|
let dev = List.mem dev_flag rest in
|
||||||
let debug = List.mem debug_flag rest in
|
let debug = List.mem debug_flag rest in
|
||||||
let sanitize = List.mem sanitize_flag rest in
|
let sanitize = List.mem sanitize_flag rest in
|
||||||
let x86 = List.mem x86_flag rest in
|
(* LLVM by default, and deliberately not moved when [flan dev] moved: a
|
||||||
|
release build is the one thing here that outlives the session, and the
|
||||||
|
argument [lib/x86.ml] rests on is exactly that a dev build is compiled
|
||||||
|
entirely by it and a release build entirely by LLVM. *)
|
||||||
|
let x86 = backend_x86 ~default:false rest in
|
||||||
let opt = opt_of rest in
|
let opt = opt_of rest in
|
||||||
check_opt_against_debug ~debug ~opt;
|
check_opt_against_debug ~debug ~opt;
|
||||||
let target = target_of rest in
|
let target = target_of rest in
|
||||||
@ -629,15 +684,31 @@ let () =
|
|||||||
each redefinition module to still be firing after C-c C-c. It implies
|
each redefinition module to still be firing after C-c C-c. It implies
|
||||||
-O0 on both, so it is asked for rather than assumed. *)
|
-O0 on both, so it is asked for rather than assumed. *)
|
||||||
let debug = List.mem debug_flag rest in
|
let debug = List.mem debug_flag rest in
|
||||||
(* One flag for both halves of the session, which is what makes it safe at
|
(* One decision for both halves of the session, which is what makes it safe
|
||||||
all: the host and every module this daemon sends are compiled by the
|
at all: the host and every module this daemon sends are compiled by the
|
||||||
same backend, because there is one place that says which. The two
|
same backend, because there is one place that says which. The two
|
||||||
conventions agree on every scalar and disagree on every aggregate, so a
|
conventions agree on every scalar and disagree on every aggregate, so a
|
||||||
crossed pair is correct until the first redefined function takes or
|
crossed pair is correct until the first redefined function takes or
|
||||||
returns a struct — and [flan.abi.x86] refuses that pair at [dlopen] if
|
returns a struct — and [flan.abi.x86] refuses that pair at [dlopen] if
|
||||||
this is ever got wrong. Off by default: LLVM stays the default path
|
this is ever got wrong.
|
||||||
here exactly as it is for [flan build]. *)
|
|
||||||
let x86 = List.mem x86_flag rest in
|
x86 by default, and this is the command where that is true. A dev
|
||||||
|
session is the thing the backend was written for: it turns the round
|
||||||
|
trip from 62ms to 28ms, and nothing it builds outlives the session, so
|
||||||
|
the subset it covers is a subset of one editor's afternoon rather than
|
||||||
|
of a shipped binary. [--llvm] is how to leave it — for a program it
|
||||||
|
refuses by name, and for [--debug].
|
||||||
|
|
||||||
|
[--debug] takes [--llvm]'s side on its own, because it is not a
|
||||||
|
preference: [X86.redefinition] emits no line table, so a [--debug]
|
||||||
|
session on this backend would set breakpoints that stop firing at the
|
||||||
|
first C-c C-c. Asking for the debugger is asking for the backend that
|
||||||
|
has one. Writing [--x86] as well still reaches [Dev.start]'s refusal,
|
||||||
|
which is the point of leaving it readable here — the combination stays
|
||||||
|
refused by name, it is just no longer somewhere you arrive by typing one
|
||||||
|
flag. *)
|
||||||
|
let x86 = backend_x86 ~default:(not debug) rest in
|
||||||
|
let asked_x86 = List.mem x86_flag rest in
|
||||||
let merged = not (List.mem two_process_flag rest) in
|
let merged = not (List.mem two_process_flag rest) in
|
||||||
let rest = List.filter (fun a -> not (is_flag a)) rest in
|
let rest = List.filter (fun a -> not (is_flag a)) rest in
|
||||||
let sock =
|
let sock =
|
||||||
@ -646,11 +717,23 @@ let () =
|
|||||||
| [] -> Filename.concat (Filename.dirname path) ".flan-dev.sock"
|
| [] -> Filename.concat (Filename.dirname path) ".flan-dev.sock"
|
||||||
| _ ->
|
| _ ->
|
||||||
prerr_endline
|
prerr_endline
|
||||||
"usage: flan dev <program.flan> [-s socket] [--debug] [--x86] \
|
"usage: flan dev <program.flan> [-s socket] [--debug] [--llvm] \
|
||||||
[--two-process]";
|
[--two-process]";
|
||||||
exit 2
|
exit 2
|
||||||
in
|
in
|
||||||
with_errors path (fun () ->
|
(* Only this command hands one over, and only when it chose the backend
|
||||||
|
itself. A refusal from a session nobody asked to be on this backend is
|
||||||
|
one flag away from building, and the flag is the half of the sentence
|
||||||
|
[X86.unsupported] cannot know to write. *)
|
||||||
|
let x86_hint =
|
||||||
|
if x86 && not asked_x86 then
|
||||||
|
Some
|
||||||
|
"flan dev: the x86 backend is the default for a dev session because \
|
||||||
|
it is about twice as fast, and it does not compile every program. \
|
||||||
|
Start this one with flan dev --llvm."
|
||||||
|
else None
|
||||||
|
in
|
||||||
|
with_errors ?x86_hint path (fun () ->
|
||||||
Flan.Dev.start ~debug ~merged ~x86 ~file:path ~sock ())
|
Flan.Dev.start ~debug ~merged ~x86 ~file:path ~sock ())
|
||||||
|
|
||||||
(* One redefinition, built the way an editor will ask for it: a session over
|
(* One redefinition, built the way an editor will ask for it: a session over
|
||||||
@ -665,7 +748,7 @@ let () =
|
|||||||
compiled is how the crossed pair was reachable from the CLI at all.
|
compiled is how the crossed pair was reachable from the CLI at all.
|
||||||
Building an --x86 host with [flan build --x86 --dev] and then reloading
|
Building an --x86 host with [flan build --x86 --dev] and then reloading
|
||||||
into it now has a spelling that produces a module it can load. *)
|
into it now has a spelling that produces a module it can load. *)
|
||||||
let x86 = List.mem x86_flag rest in
|
let x86 = backend_x86 ~default:false rest in
|
||||||
let rest = List.filter (fun a -> not (is_flag a)) rest in
|
let rest = List.filter (fun a -> not (is_flag a)) rest in
|
||||||
let out =
|
let out =
|
||||||
match rest with
|
match rest with
|
||||||
@ -725,7 +808,8 @@ let () =
|
|||||||
[flan build], and an --x86 --dev route through here would have made that
|
[flan build], and an --x86 --dev route through here would have made that
|
||||||
sentence false. *)
|
sentence false. *)
|
||||||
let run_flags =
|
let run_flags =
|
||||||
[ no_checks_flag; debug_flag; sanitize_flag; x86_flag ] @ opt_levels
|
[ no_checks_flag; debug_flag; sanitize_flag; x86_flag; llvm_flag ]
|
||||||
|
@ opt_levels
|
||||||
in
|
in
|
||||||
let build_args, prog_args =
|
let build_args, prog_args =
|
||||||
let rec split acc = function
|
let rec split acc = function
|
||||||
@ -750,7 +834,7 @@ let () =
|
|||||||
let checks = not (List.mem no_checks_flag build_args) in
|
let checks = not (List.mem no_checks_flag build_args) in
|
||||||
let debug = List.mem debug_flag build_args in
|
let debug = List.mem debug_flag build_args in
|
||||||
let sanitize = List.mem sanitize_flag build_args in
|
let sanitize = List.mem sanitize_flag build_args in
|
||||||
let x86 = List.mem x86_flag build_args in
|
let x86 = backend_x86 ~default:false build_args in
|
||||||
let opt = opt_of build_args in
|
let opt = opt_of build_args in
|
||||||
check_opt_against_debug ~debug ~opt;
|
check_opt_against_debug ~debug ~opt;
|
||||||
with_errors path (fun () ->
|
with_errors path (fun () ->
|
||||||
|
|||||||
@ -90,6 +90,61 @@ stops the program too — but only one this Emacs started. A daemon you launched
|
|||||||
in a terminal is not Emacs' to kill, and it will say so rather than do something
|
in a terminal is not Emacs' to kill, and it will say so rather than do something
|
||||||
surprising.
|
surprising.
|
||||||
|
|
||||||
|
### Which backend the session uses, and what it costs
|
||||||
|
|
||||||
|
`flan dev` compiles the session with the hand-written x86-64 backend. That is
|
||||||
|
the default, and it is the reason `C-c C-c` is fast: about 28ms at the socket
|
||||||
|
against about 63ms through LLVM, because `as` does in 8ms what `llc` does in
|
||||||
|
45ms. On a project you are iterating in, that is the difference you feel.
|
||||||
|
|
||||||
|
It is not the whole compiler. Three things a session built by it cannot do:
|
||||||
|
|
||||||
|
- **No backtrace, no locals, no globals.** The inspector — `C-c C-b`, and
|
||||||
|
everything the break loop shows you about *where* a stopped program is — walks
|
||||||
|
a shadow stack of frames, and this backend does not push them. A program built
|
||||||
|
by it still stops on an unhandled error, still takes a restart, still answers
|
||||||
|
`C-x C-e` at the break. It just cannot tell you where it stopped.
|
||||||
|
- **No `C-u C-c C-a`.** That view shows the LLVM IR a body was built from, and
|
||||||
|
there is none; the listing this backend produced is assembly. Plain `C-c C-a`
|
||||||
|
disassembles the object and works exactly as before.
|
||||||
|
- **Some programs it refuses by name.** It covers a subset of the IR and says
|
||||||
|
so rather than guessing — a `signal` or a `restart-case` inside a global's
|
||||||
|
initialiser, a `declare` that returns a struct by value, a value crossing the
|
||||||
|
C boundary in a shape it has no classifier for. A refusal names the form
|
||||||
|
*and* names `--llvm`, in both places you can meet one: the daemon's own build
|
||||||
|
log when it starts, and the error overlay when `C-c C-c` hits one
|
||||||
|
mid-session. It is never a bare "unsupported".
|
||||||
|
|
||||||
|
**`--debug` is not on this list**, because it picks LLVM for you. `flan dev
|
||||||
|
--debug` — the breakpoint and `flan-dape` path — is an LLVM session, since a
|
||||||
|
redefinition module compiled by the x86 backend carries no line table and a
|
||||||
|
breakpoint set in one would stop firing at the first `C-c C-c`. Writing
|
||||||
|
`--x86 --debug` together is still refused, and now says which one to drop.
|
||||||
|
|
||||||
|
### Asking for LLVM
|
||||||
|
|
||||||
|
Set `flan-daemon-args`. It is a list of strings, spliced into the daemon's
|
||||||
|
command line after the file, and it is how anything that is not the file or the
|
||||||
|
socket reaches `flan dev` from Emacs:
|
||||||
|
|
||||||
|
```elisp
|
||||||
|
(setq flan-daemon-args '("--llvm")) ; the inspector, the IR view, every form
|
||||||
|
(setq flan-daemon-args '("--debug")) ; breakpoints, through flan-dape
|
||||||
|
```
|
||||||
|
|
||||||
|
The first line of `*flan-dev*` is the command that actually ran, so you can
|
||||||
|
always check what a session was started with.
|
||||||
|
|
||||||
|
There is no prefix argument for this and that is deliberate: `C-u M-x flan`
|
||||||
|
already means "ask me which file", and a second level that meant "ask me which
|
||||||
|
flags" would be two unrelated questions on one key. A setting is also the
|
||||||
|
honest shape of the thing — which backend your sessions use is a property of
|
||||||
|
the project you are working on, not of the keystroke that started this one.
|
||||||
|
|
||||||
|
**If you were relying on the old default:** every `flan dev` before this one
|
||||||
|
was an LLVM session, so a workflow built around `C-c C-b` or `C-u C-c C-a` will
|
||||||
|
find them refused now. One line in your init puts it back.
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
## The loop
|
## The loop
|
||||||
@ -809,6 +864,7 @@ Commands with no key: `M-x flan` (start a program), `M-x flan-quit`
|
|||||||
| Variable | Default | What it is |
|
| Variable | Default | What it is |
|
||||||
|---|---|---|
|
|---|---|---|
|
||||||
| `flan-command` | `"flan"` | the compiler binary |
|
| `flan-command` | `"flan"` | the compiler binary |
|
||||||
|
| `flan-daemon-args` | `nil` | extra arguments for `flan dev` — `("--llvm")`, `("--debug")` |
|
||||||
| `flan-socket-name` | `".flan-dev.sock"` | what `C-c C-z` searches for |
|
| `flan-socket-name` | `".flan-dev.sock"` | what `C-c C-z` searches for |
|
||||||
| `flan-echo-result` | `t` | report an accepted evaluation in the echo area |
|
| `flan-echo-result` | `t` | report an accepted evaluation in the echo area |
|
||||||
| `flan-inline-result` | `t` | show an expression's value beside the form, not in the echo area |
|
| `flan-inline-result` | `t` | show an expression's value beside the form, not in the echo area |
|
||||||
|
|||||||
@ -688,6 +688,15 @@ With no argument, look for `flan-socket-name' up from this buffer."
|
|||||||
A name is looked up on `exec-path'; a path is used as given."
|
A name is looked up on `exec-path'; a path is used as given."
|
||||||
:type 'string)
|
:type 'string)
|
||||||
|
|
||||||
|
(defcustom flan-daemon-args nil
|
||||||
|
"Extra arguments for `flan dev', after the file and before `-s'.
|
||||||
|
A list of strings, each one argument: (\"--llvm\") to compile the session
|
||||||
|
with LLVM instead of the x86 dev backend, (\"--debug\") for a session
|
||||||
|
`flan-dape' can set breakpoints in.
|
||||||
|
|
||||||
|
These belong to the daemon, not to the program it runs."
|
||||||
|
:type '(repeat string))
|
||||||
|
|
||||||
;; `flan-daemon-buffer' belongs to this section and is declared with the
|
;; `flan-daemon-buffer' belongs to this section and is declared with the
|
||||||
;; other buffer names at the top of the file instead, because the reply reader
|
;; other buffer names at the top of the file instead, because the reply reader
|
||||||
;; -- which runs long before any of this -- names it in the message it gives
|
;; -- which runs long before any of this -- names it in the message it gives
|
||||||
@ -719,27 +728,37 @@ It builds the program first, which for a cold project is most of this."
|
|||||||
|
|
||||||
(defun flan--start-daemon (file socket)
|
(defun flan--start-daemon (file socket)
|
||||||
"Start `flan dev' on FILE listening on SOCKET, and return the process."
|
"Start `flan dev' on FILE listening on SOCKET, and return the process."
|
||||||
(let ((buf (get-buffer-create flan-daemon-buffer))
|
(let* ((buf (get-buffer-create flan-daemon-buffer))
|
||||||
;; Expanded before `default-directory' moves, so that a command given
|
;; Expanded before `default-directory' moves, so that a command given
|
||||||
;; as a path is the path the user meant and not one relative to the
|
;; as a path is the path the user meant and not one relative to the
|
||||||
;; program's directory. A bare name is left alone for `exec-path'.
|
;; program's directory. A bare name is left alone for `exec-path'.
|
||||||
(cmd (if (file-name-directory flan-command)
|
(cmd (if (file-name-directory flan-command)
|
||||||
(expand-file-name flan-command)
|
(expand-file-name flan-command)
|
||||||
flan-command))
|
flan-command))
|
||||||
;; The daemon runs where the program is, and so does the program it
|
;; `flan-daemon-args' goes after the file and before `-s', which is
|
||||||
;; launches — it inherits this. A game opening "assets/tiles.png"
|
;; where the usage line puts the flags and where `flan dev' reads
|
||||||
;; means the project's directory, not whichever buffer Emacs happened
|
;; them from: everything but the path and the socket pair is a flag,
|
||||||
;; to be in when the command was typed. (Imports do not depend on
|
;; wherever it sits. Built once and used twice, because the buffer's
|
||||||
;; this: lib/load.ml resolves those from the importing file.)
|
;; first line is what somebody reads to find out what ran and it used
|
||||||
(default-directory (file-name-directory (expand-file-name file))))
|
;; to reassemble the command rather than show it — two spellings that
|
||||||
|
;; could disagree, and with anything else on the line they would have.
|
||||||
|
(args (append (list cmd "dev" file)
|
||||||
|
flan-daemon-args
|
||||||
|
(list "-s" socket)))
|
||||||
|
;; The daemon runs where the program is, and so does the program it
|
||||||
|
;; launches — it inherits this. A game opening "assets/tiles.png"
|
||||||
|
;; means the project's directory, not whichever buffer Emacs happened
|
||||||
|
;; to be in when the command was typed. (Imports do not depend on
|
||||||
|
;; this: lib/load.ml resolves those from the importing file.)
|
||||||
|
(default-directory (file-name-directory (expand-file-name file))))
|
||||||
(with-current-buffer buf
|
(with-current-buffer buf
|
||||||
(let ((inhibit-read-only t))
|
(let ((inhibit-read-only t))
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(insert (format "%s dev %s -s %s\n\n" cmd file socket)))
|
(insert (mapconcat #'identity args " ") "\n\n"))
|
||||||
(setq default-directory (file-name-directory (expand-file-name file))))
|
(setq default-directory (file-name-directory (expand-file-name file))))
|
||||||
(make-process
|
(make-process
|
||||||
:name "flan-daemon" :buffer buf
|
:name "flan-daemon" :buffer buf
|
||||||
:command (list cmd "dev" file "-s" socket)
|
:command args
|
||||||
;; The daemon writes its ready line and the program's stderr to stderr,
|
;; The daemon writes its ready line and the program's stderr to stderr,
|
||||||
;; and both belong in the same buffer in the order they happened.
|
;; and both belong in the same buffer in the order they happened.
|
||||||
:connection-type 'pipe :noquery t
|
:connection-type 'pipe :noquery t
|
||||||
|
|||||||
@ -1126,6 +1126,38 @@ already rely on it — so nothing here is a stand-in for the real thing."
|
|||||||
;; `flan dev' with no -s puts one beside the program, which for a test
|
;; `flan dev' with no -s puts one beside the program, which for a test
|
||||||
;; program in /tmp is a path shared with every other thing running there.
|
;; program in /tmp is a path shared with every other thing running there.
|
||||||
(setq flan-command flan)
|
(setq flan-command flan)
|
||||||
|
|
||||||
|
;; `flan-daemon-args' reaches the command line. Checked against the
|
||||||
|
;; argument list rather than by starting a daemon with a flag on it: the
|
||||||
|
;; claim is that the setting is spliced in at all, which a build of the
|
||||||
|
;; whole program would take seconds to say and say no more clearly. The
|
||||||
|
;; daemon buffer's first line is checked too, because it is a second
|
||||||
|
;; spelling of the same command and somebody reads it to find out what ran.
|
||||||
|
(let ((seen nil)
|
||||||
|
(probe nil))
|
||||||
|
(setq probe (lambda (&rest args) (setq seen (plist-get args :command)) nil))
|
||||||
|
(advice-add 'make-process :override probe)
|
||||||
|
(unwind-protect
|
||||||
|
(let ((flan-daemon-args '("--llvm" "--debug")))
|
||||||
|
(flan--start-daemon program "/tmp/does-not-matter.sock")
|
||||||
|
(test-flan--check "flan-daemon-args reaches the daemon's command line"
|
||||||
|
(equal seen (list flan "dev" program
|
||||||
|
"--llvm" "--debug"
|
||||||
|
"-s" "/tmp/does-not-matter.sock")))
|
||||||
|
(test-flan--check "and the daemon buffer shows the command that ran"
|
||||||
|
(with-current-buffer flan-daemon-buffer
|
||||||
|
(string-match-p
|
||||||
|
"--llvm --debug"
|
||||||
|
(buffer-substring-no-properties
|
||||||
|
(point-min) (point-max)))))
|
||||||
|
(setq seen nil)
|
||||||
|
(let ((flan-daemon-args nil))
|
||||||
|
(flan--start-daemon program "/tmp/does-not-matter.sock"))
|
||||||
|
(test-flan--check "and an empty setting leaves the old command line"
|
||||||
|
(equal seen (list flan "dev" program
|
||||||
|
"-s" "/tmp/does-not-matter.sock"))))
|
||||||
|
(advice-remove 'make-process probe)))
|
||||||
|
|
||||||
(let ((socket2 (concat socket "-started-from-emacs")))
|
(let ((socket2 (concat socket "-started-from-emacs")))
|
||||||
(ignore-errors (delete-file socket2))
|
(ignore-errors (delete-file socket2))
|
||||||
(test-flan--check "nothing to quit before anything was started"
|
(test-flan--check "nothing to quit before anything was started"
|
||||||
@ -1377,11 +1409,21 @@ already rely on it — so nothing here is a stand-in for the real thing."
|
|||||||
;; Its own daemon, because the first one was disconnected above and a
|
;; Its own daemon, because the first one was disconnected above and a
|
||||||
;; disassembly is a question only a live session can answer: the daemon is
|
;; disassembly is a question only a live session can answer: the daemon is
|
||||||
;; the thing that built the module and still has the .ll and the .so.
|
;; the thing that built the module and still has the .ll and the .so.
|
||||||
(let ((socket3 (concat socket "-disasm")))
|
;;
|
||||||
|
;; And an LLVM one, asked for through the setting rather than around it:
|
||||||
|
;; `C-u C-c C-a' shows the IR a body was built from and an x86 session has
|
||||||
|
;; none, so half of what this section checks only exists on that backend.
|
||||||
|
;; Going through `flan-daemon-args' means the same run proves the setting
|
||||||
|
;; reaches a daemon that actually starts, which the stubbed check above
|
||||||
|
;; deliberately does not.
|
||||||
|
(let ((socket3 (concat socket "-disasm"))
|
||||||
|
(flan-daemon-args '("--llvm")))
|
||||||
(ignore-errors (delete-file socket3))
|
(ignore-errors (delete-file socket3))
|
||||||
(flan program socket3)
|
(flan program socket3)
|
||||||
(test-flan--check "a daemon to disassemble against"
|
(test-flan--check "a daemon to disassemble against"
|
||||||
(process-live-p flan--connection))
|
(process-live-p flan--connection))
|
||||||
|
(test-flan--check "and flan-daemon-args put --llvm on its command line"
|
||||||
|
(member "--llvm" (process-command flan--daemon)))
|
||||||
|
|
||||||
(when (executable-find "objdump")
|
(when (executable-find "objdump")
|
||||||
(flan-disassemble "step")
|
(flan-disassemble "step")
|
||||||
|
|||||||
72
lib/dev.ml
72
lib/dev.ml
@ -217,7 +217,38 @@ let result t =
|
|||||||
thread on the frame that erred and waits. The agent is where that shows, and
|
thread on the frame that erred and waits. The agent is where that shows, and
|
||||||
the session is the only thing holding it — so an editor asks here or not at
|
the session is the only thing holding it — so an editor asks here or not at
|
||||||
all. *)
|
all. *)
|
||||||
let ask t verb = request t verb
|
(* One sentence the agent cannot write, rewritten in the one place every verb
|
||||||
|
passes through.
|
||||||
|
|
||||||
|
[vendor/agent/flan_agent.c] answers a backtrace, a locals or a globals
|
||||||
|
request from a program with no shadow-stack frames with "this program was
|
||||||
|
not built with --dev". That was true of exactly one thing when it was
|
||||||
|
written -- a release build, which has no frames because it has no dev
|
||||||
|
machinery at all -- and it stopped being true when [lib/x86.ml] became the
|
||||||
|
default for [flan dev]. An x86 dev host has its cells, its globals and its
|
||||||
|
registry; what it has not got is the frame push, so it stops on an error and
|
||||||
|
then cannot say where. The agent has no way to tell the two apart: it sees
|
||||||
|
an empty chain either way, and it is inside the program, which knows nothing
|
||||||
|
about the backend that compiled it.
|
||||||
|
|
||||||
|
The session does know, so it is the one that corrects the sentence. Rewriting
|
||||||
|
the reply rather than teaching the agent a new environment variable keeps the
|
||||||
|
claim where the fact is -- and a message that names [--llvm] is the whole of
|
||||||
|
what the reader needs, where "not built with --dev" sends them to look for a
|
||||||
|
flag they did not leave off. *)
|
||||||
|
let mentions hay needle =
|
||||||
|
let n = String.length hay and m = String.length needle in
|
||||||
|
let rec go i = i + m <= n && (String.sub hay i m = needle || go (i + 1)) in
|
||||||
|
m = 0 || go 0
|
||||||
|
|
||||||
|
let ask t verb =
|
||||||
|
let text = request t verb in
|
||||||
|
if t.session.Session.x86 && mentions text "was not built with --dev" then
|
||||||
|
"err the x86 dev backend pushes no shadow-stack frames, so a stopped \
|
||||||
|
program built by it cannot say where it is -- no backtrace, no locals and \
|
||||||
|
no globals. It is the default for flan dev because it is about twice as \
|
||||||
|
fast; restart the daemon with flan dev --llvm to inspect frames.\n"
|
||||||
|
else text
|
||||||
|
|
||||||
type state =
|
type state =
|
||||||
| Running
|
| Running
|
||||||
@ -2675,7 +2706,21 @@ let disassemble t ~name ~form =
|
|||||||
":loc " ^ Wire.quote o.oloc;
|
":loc " ^ Wire.quote o.oloc;
|
||||||
":basis " ^ Wire.quote why ]
|
":basis " ^ Wire.quote why ]
|
||||||
in
|
in
|
||||||
if form = "ir" then
|
(* There is no LLVM IR in an x86 session, and until now the way that was
|
||||||
|
reported was a grep that found nothing in a file whose name ends [.s]:
|
||||||
|
"no define for @flan.step in .../host.s", which reads like a compiler
|
||||||
|
that lost track of its own output. The view that does exist is the
|
||||||
|
other one -- [:form "asm"] disassembles the object, and an x86 session
|
||||||
|
has objects like any other -- so this says which of the two questions
|
||||||
|
it cannot answer rather than failing at the text of an answer it was
|
||||||
|
never going to find. *)
|
||||||
|
if form = "ir" && t.session.Session.x86 then
|
||||||
|
error
|
||||||
|
"this session was compiled by the x86 dev backend, so there is no \
|
||||||
|
LLVM IR to show — the listing it produced is assembly. C-c C-a \
|
||||||
|
disassembles the object, which works here; for the IR view, restart \
|
||||||
|
the daemon with flan dev --llvm"
|
||||||
|
else if form = "ir" then
|
||||||
match read_file o.oll with
|
match read_file o.oll with
|
||||||
| text ->
|
| text ->
|
||||||
(match ir_of ~ir:text name with
|
(match ir_of ~ir:text name with
|
||||||
@ -3233,7 +3278,7 @@ let accept_loop ?grace t ls =
|
|||||||
deletes it — and silently making every reloaded body -O0 would change the
|
deletes it — and silently making every reloaded body -O0 would change the
|
||||||
frame time of the one function you are iterating on, in the loop whose whole
|
frame time of the one function you are iterating on, in the loop whose whole
|
||||||
point is watching that number. *)
|
point is watching that number. *)
|
||||||
let two_process ?(debug = false) ?(x86 = false) ~file ~sock () =
|
let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
|
||||||
let t0 = Unix.gettimeofday () in
|
let t0 = Unix.gettimeofday () in
|
||||||
(* Absolute, because every location this daemon ever reports is derived from
|
(* Absolute, because every location this daemon ever reports is derived from
|
||||||
it and an editor is not in this process's working directory. [flan dev
|
it and an editor is not in this process's working directory. [flan dev
|
||||||
@ -4114,7 +4159,7 @@ let merged_serve () =
|
|||||||
(* The merged build is made here and then [exec]'d, so what an editor talks to
|
(* The merged build is made here and then [exec]'d, so what an editor talks to
|
||||||
is the program itself rather than something that launched it. The launcher
|
is the program itself rather than something that launched it. The launcher
|
||||||
does not survive: there is one process from the first reply onwards. *)
|
does not survive: there is one process from the first reply onwards. *)
|
||||||
let start_merged ?(debug = false) ?(x86 = false) ~file ~sock () =
|
let start_merged ?(debug = false) ?(x86 = true) ~file ~sock () =
|
||||||
let t0 = Unix.gettimeofday () in
|
let t0 = Unix.gettimeofday () in
|
||||||
let file = try Unix.realpath file with Unix.Unix_error _ -> file in
|
let file = try Unix.realpath file with Unix.Unix_error _ -> file in
|
||||||
let session, l = Session.create ~debug ~x86 ~file () in
|
let session, l = Session.create ~debug ~x86 ~file () in
|
||||||
@ -4166,19 +4211,32 @@ let start_merged ?(debug = false) ?(x86 = false) ~file ~sock () =
|
|||||||
flan.cmxa beside the binary — and it is what every behaviour in this file
|
flan.cmxa beside the binary — and it is what every behaviour in this file
|
||||||
was written against, so it stays until the transport it exists to drive is
|
was written against, so it stays until the transport it exists to drive is
|
||||||
actually deleted. *)
|
actually deleted. *)
|
||||||
let start ?(debug = false) ?(merged = true) ?(x86 = false) ~file ~sock () =
|
let start ?(debug = false) ?(merged = true) ?(x86 = true) ~file ~sock () =
|
||||||
|
(* x86 unless told otherwise, and the default is here rather than only in
|
||||||
|
[bin/main.ml] so that there is one answer to "what backend is a dev
|
||||||
|
session". A library caller that starts a daemon starts the same daemon the
|
||||||
|
editor does; the CLI passes this explicitly and never leans on it, but a
|
||||||
|
default that disagreed with the command would be a second answer nobody
|
||||||
|
had written down. *)
|
||||||
(* [--x86] and [--debug] are refused together here, and only here: [flan
|
(* [--x86] and [--debug] are refused together here, and only here: [flan
|
||||||
build --x86 --debug] is deliberately allowed, because [X86.program] emits
|
build --x86 --debug] is deliberately allowed, because [X86.program] emits
|
||||||
a hand-written DWARF 4 unit. [X86.redefinition] does not, so a [--debug]
|
a hand-written DWARF 4 unit. [X86.redefinition] does not, so a [--debug]
|
||||||
session would build a host with a line table and then send it modules with
|
session would build a host with a line table and then send it modules with
|
||||||
none -- a breakpoint on a line in the buffer would fire before the first
|
none -- a breakpoint on a line in the buffer would fire before the first
|
||||||
C-c C-c and stop firing after it, which is worse than not offering the
|
C-c C-c and stop firing after it, which is worse than not offering the
|
||||||
combination. Accepting the flag and ignoring it would be worse still. *)
|
combination. Accepting the flag and ignoring it would be worse still.
|
||||||
|
|
||||||
|
Now that x86 is the default, this is reachable only by asking for it:
|
||||||
|
[bin/main.ml] lets [--debug] alone select LLVM, precisely so that the one
|
||||||
|
flag a person types to get a debugger does not land on the backend that
|
||||||
|
has no line table for a redefinition. Writing both is still writing both,
|
||||||
|
and it is still refused. *)
|
||||||
if x86 && debug then
|
if x86 && debug then
|
||||||
failwith
|
failwith
|
||||||
"flan dev --x86 --debug: the dev backend emits DWARF for a whole program \
|
"flan dev --x86 --debug: the dev backend emits DWARF for a whole program \
|
||||||
but not yet for a redefinition module, so a breakpoint set on a line \
|
but not yet for a redefinition module, so a breakpoint set on a line \
|
||||||
would stop firing at the first C-c C-c. Use one or the other.";
|
would stop firing at the first C-c C-c. Drop --x86 and --debug will \
|
||||||
|
build this session with LLVM, which has both.";
|
||||||
(* The merged daemon used to be refused here for [--x86] and no longer is,
|
(* The merged daemon used to be refused here for [--x86] and no longer is,
|
||||||
and what made the combination safe is worth stating where the refusal
|
and what made the combination safe is worth stating where the refusal
|
||||||
stood. A merged build is the program and the compiler in one process, and
|
stood. A merged build is the program and the compiler in one process, and
|
||||||
|
|||||||
@ -406,7 +406,16 @@ let redefinition (t : t) ?retains ?call ?(consts = []) program ~fns =
|
|||||||
| Some f -> f.Tast.floc
|
| Some f -> f.Tast.floc
|
||||||
| None -> Loc.unknown
|
| None -> Loc.unknown
|
||||||
in
|
in
|
||||||
fail loc "the x86 dev backend cannot compile this: %s" m
|
(* The flag is named because the backend is no longer something anybody
|
||||||
|
asked for: [flan dev] takes it by default, so the person reading this
|
||||||
|
chose a program and not a code generator. "unsupported" on its own
|
||||||
|
tells them their form is wrong, which it is not — it compiles, on the
|
||||||
|
other backend, and the whole of the fix is one flag on the daemon.
|
||||||
|
Naming it here rather than in the editor keeps the sentence with the
|
||||||
|
refusal it belongs to, and reaches [flan reload] too. *)
|
||||||
|
fail loc
|
||||||
|
"the x86 dev backend cannot compile this: %s. Restart the daemon with \
|
||||||
|
flan dev --llvm, which compiles every form this one refuses" m
|
||||||
|
|
||||||
(* ── Undoing an acceptance ─────────────────────────────────────────── *)
|
(* ── Undoing an acceptance ─────────────────────────────────────────── *)
|
||||||
|
|
||||||
|
|||||||
@ -229,9 +229,18 @@ let () =
|
|||||||
how an editor meets it, and because it launches and owns a program of
|
how an editor meets it, and because it launches and owns a program of
|
||||||
its own. Its child's stdout is what we read the result off. *)
|
its own. Its child's stdout is what we read the result off. *)
|
||||||
let flan = "../bin/main.exe" in
|
let flan = "../bin/main.exe" in
|
||||||
|
(* [--llvm] on this daemon and on the four below it, and it is about what
|
||||||
|
they test rather than about a preference. Everything they ask for -- a
|
||||||
|
backtrace, the locals of a stopped frame, the globals a stopped stack
|
||||||
|
reaches -- is read off the dev shadow stack, and [lib/x86.ml] pushes no
|
||||||
|
frames onto it. x86 is what [flan dev] takes unasked now, so a flagless
|
||||||
|
daemon here would answer every one of those with the sentence [Dev.ask]
|
||||||
|
rewrites: a true statement about the backend and no test of the verb.
|
||||||
|
The default itself is checked further down, on a daemon that does not
|
||||||
|
need frames. *)
|
||||||
let pid =
|
let pid =
|
||||||
Unix.create_process flan
|
Unix.create_process flan
|
||||||
[| flan; "dev"; "programs/dev-loop.flan"; "-s"; sock |]
|
[| flan; "dev"; "programs/dev-loop.flan"; "-s"; sock; "--llvm" |]
|
||||||
Unix.stdin fd Unix.stderr
|
Unix.stdin fd Unix.stderr
|
||||||
in
|
in
|
||||||
Unix.close fd;
|
Unix.close fd;
|
||||||
@ -821,7 +830,7 @@ let () =
|
|||||||
let bfd = Unix.openfile bout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
let bfd = Unix.openfile bout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
||||||
let bpid =
|
let bpid =
|
||||||
Unix.create_process flan
|
Unix.create_process flan
|
||||||
[| flan; "dev"; "programs/dev-break.flan"; "-s"; bsock |]
|
[| flan; "dev"; "programs/dev-break.flan"; "-s"; bsock; "--llvm" |]
|
||||||
Unix.stdin bfd Unix.stderr
|
Unix.stdin bfd Unix.stderr
|
||||||
in
|
in
|
||||||
Unix.close bfd;
|
Unix.close bfd;
|
||||||
@ -1490,7 +1499,7 @@ let () =
|
|||||||
let lfd = Unix.openfile lout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
let lfd = Unix.openfile lout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
||||||
let lpid =
|
let lpid =
|
||||||
Unix.create_process flan
|
Unix.create_process flan
|
||||||
[| flan; "dev"; "programs/dev-locals.flan"; "-s"; lsock |]
|
[| flan; "dev"; "programs/dev-locals.flan"; "-s"; lsock; "--llvm" |]
|
||||||
Unix.stdin lfd Unix.stderr
|
Unix.stdin lfd Unix.stderr
|
||||||
in
|
in
|
||||||
Unix.close lfd;
|
Unix.close lfd;
|
||||||
@ -1671,7 +1680,7 @@ let () =
|
|||||||
let ifd = Unix.openfile iout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
let ifd = Unix.openfile iout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
||||||
let ipid =
|
let ipid =
|
||||||
Unix.create_process flan
|
Unix.create_process flan
|
||||||
[| flan; "dev"; "programs/dev-inspect.flan"; "-s"; isock |]
|
[| flan; "dev"; "programs/dev-inspect.flan"; "-s"; isock; "--llvm" |]
|
||||||
Unix.stdin ifd Unix.stderr
|
Unix.stdin ifd Unix.stderr
|
||||||
in
|
in
|
||||||
Unix.close ifd;
|
Unix.close ifd;
|
||||||
@ -1881,7 +1890,7 @@ let () =
|
|||||||
let pfd = Unix.openfile pout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
let pfd = Unix.openfile pout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
||||||
let ppid =
|
let ppid =
|
||||||
Unix.create_process flan
|
Unix.create_process flan
|
||||||
[| flan; "dev"; "programs/dev-ptr.flan"; "-s"; psock |]
|
[| flan; "dev"; "programs/dev-ptr.flan"; "-s"; psock; "--llvm" |]
|
||||||
Unix.stdin pfd Unix.stderr
|
Unix.stdin pfd Unix.stderr
|
||||||
in
|
in
|
||||||
Unix.close pfd;
|
Unix.close pfd;
|
||||||
@ -2184,7 +2193,7 @@ let () =
|
|||||||
let gfd = Unix.openfile gout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
let gfd = Unix.openfile gout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
||||||
let gpid =
|
let gpid =
|
||||||
Unix.create_process flan
|
Unix.create_process flan
|
||||||
[| flan; "dev"; "programs/dev-globals.flan"; "-s"; gsock |]
|
[| flan; "dev"; "programs/dev-globals.flan"; "-s"; gsock; "--llvm" |]
|
||||||
Unix.stdin gfd Unix.stderr
|
Unix.stdin gfd Unix.stderr
|
||||||
in
|
in
|
||||||
Unix.close gfd;
|
Unix.close gfd;
|
||||||
@ -2407,7 +2416,7 @@ let () =
|
|||||||
let dfd = Unix.openfile dout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
let dfd = Unix.openfile dout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
||||||
let dpid =
|
let dpid =
|
||||||
Unix.create_process flan
|
Unix.create_process flan
|
||||||
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; dsock |]
|
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; dsock; "--llvm" |]
|
||||||
Unix.stdin dfd Unix.stderr
|
Unix.stdin dfd Unix.stderr
|
||||||
in
|
in
|
||||||
Unix.close dfd;
|
Unix.close dfd;
|
||||||
@ -2626,7 +2635,12 @@ let () =
|
|||||||
|
|
||||||
A daemon whose [llc] is [false] reproduces it exactly and cheaply: the
|
A daemon whose [llc] is [false] reproduces it exactly and cheaply: the
|
||||||
host is built by clang and runs, every redefinition checks and then
|
host is built by clang and runs, every redefinition checks and then
|
||||||
fails to build, and nothing is ever delivered. *)
|
fails to build, and nothing is ever delivered.
|
||||||
|
|
||||||
|
[--llvm] with it, and the two go together: [llc] is only in the loop at
|
||||||
|
all on that backend, so a session that defaulted to x86 would assemble
|
||||||
|
its modules with [as] and deliver them, and the window this reproduces
|
||||||
|
would never open. *)
|
||||||
let ssock = tmp "stale.sock" and sout = tmp "stale.out" in
|
let ssock = tmp "stale.sock" and sout = tmp "stale.out" in
|
||||||
(try Sys.remove ssock with Sys_error _ -> ());
|
(try Sys.remove ssock with Sys_error _ -> ());
|
||||||
let sfd = Unix.openfile sout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
let sfd = Unix.openfile sout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
||||||
@ -2635,7 +2649,7 @@ let () =
|
|||||||
in
|
in
|
||||||
let spid =
|
let spid =
|
||||||
Unix.create_process_env flan
|
Unix.create_process_env flan
|
||||||
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; ssock |]
|
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; ssock; "--llvm" |]
|
||||||
env Unix.stdin sfd Unix.stderr
|
env Unix.stdin sfd Unix.stderr
|
||||||
in
|
in
|
||||||
Unix.close sfd;
|
Unix.close sfd;
|
||||||
@ -2721,6 +2735,27 @@ let () =
|
|||||||
(try Unix.kill cpid Sys.sigkill with Unix.Unix_error _ -> ())
|
(try Unix.kill cpid Sys.sigkill with Unix.Unix_error _ -> ())
|
||||||
end
|
end
|
||||||
else begin
|
else begin
|
||||||
|
(* And the default backend, on the first flagless daemon in this file
|
||||||
|
that does not need the shadow stack. No flag was given above, so what
|
||||||
|
it built through is what [flan dev] builds through when nobody says:
|
||||||
|
[start_merged] writes the host's listing beside the binary and names
|
||||||
|
it [host.s] or [host.ll] by the backend that produced it, so the
|
||||||
|
extension is the whole of the claim. Here rather than in a daemon of
|
||||||
|
its own because this one is already standing and the answer costs a
|
||||||
|
[stat] -- the opt-in half is checked the same way on the [--llvm]
|
||||||
|
daemon further down. *)
|
||||||
|
let chost ext =
|
||||||
|
Filename.concat
|
||||||
|
(Filename.concat (Filename.get_temp_dir_name ())
|
||||||
|
(Printf.sprintf "flan-dev-%d" cpid))
|
||||||
|
("host." ^ ext)
|
||||||
|
in
|
||||||
|
if not (Sys.file_exists (chost "s")) then
|
||||||
|
fail "flan dev with no backend flag did not build through x86: %s is \
|
||||||
|
not there"
|
||||||
|
(chost "s");
|
||||||
|
if Sys.file_exists (chost "ll") then
|
||||||
|
fail "flan dev with no backend flag left LLVM IR at %s" (chost "ll");
|
||||||
let c = connect csock in
|
let c = connect csock in
|
||||||
(* Long enough for the program to have run the sixteen frames that fill
|
(* Long enough for the program to have run the sixteen frames that fill
|
||||||
the pipe before anything is asked of the daemon. It prints at 4K a
|
the pipe before anything is asked of the daemon. It prints at 4K a
|
||||||
@ -3491,15 +3526,33 @@ let () =
|
|||||||
let nfd =
|
let nfd =
|
||||||
Unix.openfile nlog [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
|
Unix.openfile nlog [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
|
||||||
in
|
in
|
||||||
|
(* [--llvm] here, on a daemon that was going to stand up anyway: the
|
||||||
|
opt-in is the other half of the default checked at the top of this file,
|
||||||
|
and proving it costs the same [stat] on the same directory. It also
|
||||||
|
keeps one merged LLVM daemon in the suite now that a flagless one is an
|
||||||
|
x86 one -- this test is about a program with no [(agent/start ...)],
|
||||||
|
which is a claim about the daemon and not about a backend, so it is the
|
||||||
|
cheapest place for both. *)
|
||||||
let npid =
|
let npid =
|
||||||
Unix.create_process flan
|
Unix.create_process flan
|
||||||
[| flan; "dev"; "programs/dev-noagent.flan"; "-s"; nsock |]
|
[| flan; "dev"; "programs/dev-noagent.flan"; "-s"; nsock; "--llvm" |]
|
||||||
Unix.stdin nfd nfd
|
Unix.stdin nfd nfd
|
||||||
in
|
in
|
||||||
Unix.close nfd;
|
Unix.close nfd;
|
||||||
if not (listening ~pid:npid nsock) then
|
if not (listening ~pid:npid nsock) then
|
||||||
fail "the agentless daemon %s" !listen_why
|
fail "the agentless daemon %s" !listen_why
|
||||||
else begin
|
else begin
|
||||||
|
let nhost ext =
|
||||||
|
Filename.concat
|
||||||
|
(Filename.concat (Filename.get_temp_dir_name ())
|
||||||
|
(Printf.sprintf "flan-dev-%d" npid))
|
||||||
|
("host." ^ ext)
|
||||||
|
in
|
||||||
|
if not (Sys.file_exists (nhost "ll")) then
|
||||||
|
fail "flan dev --llvm did not build through LLVM: %s is not there"
|
||||||
|
(nhost "ll");
|
||||||
|
if Sys.file_exists (nhost "s") then
|
||||||
|
fail "flan dev --llvm left an x86 listing at %s" (nhost "s");
|
||||||
let nc = connect nsock in
|
let nc = connect nsock in
|
||||||
(* Blocks for the whole of [merged_serve]'s wait, by construction. The
|
(* Blocks for the whole of [merged_serve]'s wait, by construction. The
|
||||||
exception arm is not defensive: a session that adopted the daemon's
|
exception arm is not defensive: a session that adopted the daemon's
|
||||||
|
|||||||
@ -82,9 +82,17 @@ let () =
|
|||||||
let p = "programs/dev-repl.flan" in
|
let p = "programs/dev-repl.flan" in
|
||||||
try Unix.realpath p with Unix.Unix_error _ -> p
|
try Unix.realpath p with Unix.Unix_error _ -> p
|
||||||
in
|
in
|
||||||
|
(* [--llvm], and it is not incidental: this suite drives the inspector --
|
||||||
|
backtrace, locals, globals -- and those are frames on the dev shadow
|
||||||
|
stack, which [lib/x86.ml] does not push. The default backend for [flan
|
||||||
|
dev] is x86 now, so a flagless daemon here would answer every one of
|
||||||
|
those with the refusal naming this flag, and the client half of the
|
||||||
|
break protocol would go untested. The client's own daemon at the end of
|
||||||
|
the run asks for it through [flan-daemon-args] for the same reason,
|
||||||
|
which is also where that setting is proved to reach a command line. *)
|
||||||
let pid =
|
let pid =
|
||||||
Unix.create_process flan
|
Unix.create_process flan
|
||||||
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; sock |]
|
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; sock; "--llvm" |]
|
||||||
Unix.stdin fd efd
|
Unix.stdin fd efd
|
||||||
in
|
in
|
||||||
Unix.close fd;
|
Unix.close fd;
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user