Joseph Ferano
c8091bdbf9
The boundary and the operators, which are the two halves of dyn being a type rather than a word the checker tolerates. Typed to dyn is implicit and dyn to typed is not, and the asymmetry is the design: boxing loses nothing and can happen wherever a dyn is wanted, while unboxing can fail at run time on a value the compiler cannot inspect, so it happens only where somebody wrote a type. Both go through expect, because expect is already the one place a wanted type meets a produced one, and every annotating site already calls it. Literals take their width from the dyn, not from the default. (defvar x dyn 5) holds an i64 five: the ABI carries one integer width, so the defaulting question never arises, and the literal is built at i64 rather than boxed after defaulting to i32 -- which also means 3000000000 is a dyn integer. An operator with one dyn operand is the runtime's. binary has already checked the second operand against the first, so a mixed pair arrives with the typed side boxed and the fold only has to call flan_dyn_add instead of adding. The comparisons answer bool and not a dyn holding one, because a comparison is almost always the test of an if; a program that wants it as a value boxes it again for free at that boundary. = and != never trap -- two values of unrelated types are unequal, not an error -- and the orderings do. Types.equal had no Dyn case, so dyn was equal to nothing including itself. print hands the whole value to the runtime rather than walking it: every other arm of the structural printer exists because a Flan value carries no header and only the compiler knows what it is, and a dyn is the exact reverse. The compiler carries the dyn runtime the way it already carries flan_rt.c, with the header pasted in front of the stub so there is one self-contained translation unit and one contract.
1132 lines
54 KiB
OCaml
1132 lines
54 KiB
OCaml
(** Driver: typed IR → an executable, via LLVM IR text and clang.
|
|
|
|
The release path from plan.org, Compilation:
|
|
|
|
{v flan → typed IR → .ll → clang --target={native,wasm32} v}
|
|
|
|
Three targets now, and the third takes a different driver: the browser is
|
|
built by emcc, which accepts the same .ll. See [is_web].
|
|
|
|
Not the dev path — that one never invokes the clang driver, because the
|
|
driver *is* the cost, and goes llc + ld -shared + dlopen instead. That is
|
|
[shared], at the bottom of this file, measured at ~19ms. *)
|
|
|
|
let clang = try Sys.getenv "FLAN_CLANG" with Not_found -> "clang"
|
|
|
|
(* The browser target's compiler. emcc is a clang driver with a sysroot, a
|
|
builtins archive, a JS runtime and an HTML shell already attached, so the
|
|
whole of [wasm_sysroot], [wasm_builtins] and [wasm_resource_dir] below —
|
|
everything the wasi target has to find by hand — is what emcc *is*. It also
|
|
accepts a .ll on its command line, which is the one thing that had to be
|
|
true for this target to exist at all: [Emit] writes IR text and nothing
|
|
else. *)
|
|
let emcc = try Sys.getenv "FLAN_EMCC" with Not_found -> "emcc"
|
|
|
|
let write path contents =
|
|
let ch = open_out path in
|
|
output_string ch contents;
|
|
close_out ch
|
|
|
|
let write_bin path contents =
|
|
let ch = open_out_bin path in
|
|
output_string ch contents;
|
|
close_out ch
|
|
|
|
let read_file path =
|
|
let ch = open_in_bin path in
|
|
let n = in_channel_length ch in
|
|
let s = really_input_string ch n in
|
|
close_in ch;
|
|
s
|
|
|
|
let read_file_opt path =
|
|
try Some (read_file path) with Sys_error _ -> None
|
|
|
|
(* One temporary directory per build, so the .ll is findable by name when
|
|
something is wrong with it. *)
|
|
let workdir () =
|
|
let d =
|
|
Filename.concat (Filename.get_temp_dir_name ())
|
|
(Printf.sprintf "flan-%d" (Unix.getpid ()))
|
|
in
|
|
(try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
|
|
d
|
|
|
|
(* [mkdir -p]: each component in turn, [EEXIST] swallowed at each, because the
|
|
cache now lives several directories down rather than one. *)
|
|
let rec mkdir_p d =
|
|
if not (Sys.file_exists d) then begin
|
|
let parent = Filename.dirname d in
|
|
if parent <> d then mkdir_p parent;
|
|
try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
|
|
end
|
|
|
|
(* The object cache, which unlike [workdir] is stable across builds. The C that
|
|
goes into a build — the host shim and the packages' shims — is the same on
|
|
every build and never the thing being edited, yet it was being recompiled
|
|
each time: 40ms of a 140ms build for [flan_rt.c] alone.
|
|
|
|
Under the *cache* directory and not under [TMPDIR], which is where it used
|
|
to be, because dune gives every test run a fresh private [TMPDIR] — so the
|
|
suite never once reused an object and every build in it was cold. Measured
|
|
on this program: [flan dev] to a bound socket in 2.0s cold against 0.48s
|
|
warm, and a whole-program [flan build] in 1.44s against 0.06s. The one
|
|
thing that made the move safe to do rather than a way to serve a stale
|
|
object is that the keys are total: [compile_c] digests the source *text*,
|
|
the compiler binary's own stamp, [opt] and every flag; [wasm_resource_dir]
|
|
digests the builtins archive it copies; [Dev.compiler_object] digests
|
|
flan.cmxa and flan.a. There is nothing an isolated directory was hiding.
|
|
(The one key that was *not* total is [Macro]'s — see the note there.)
|
|
|
|
FLAN_CACHE_DIR overrides it, for a build that wants a cache of its own. *)
|
|
let cachedir () =
|
|
let d =
|
|
match Sys.getenv_opt "FLAN_CACHE_DIR" with
|
|
| Some d when d <> "" -> d
|
|
| _ ->
|
|
let base =
|
|
match Sys.getenv_opt "XDG_CACHE_HOME" with
|
|
| Some d when d <> "" -> d
|
|
| _ ->
|
|
(match Sys.getenv_opt "HOME" with
|
|
| Some h when h <> "" -> Filename.concat h ".cache"
|
|
(* Neither set: back to where this used to live, because a cache
|
|
with nowhere to go must not be a build failure. *)
|
|
| _ -> Filename.get_temp_dir_name ())
|
|
in
|
|
Filename.concat (Filename.concat base "flan") "objcache"
|
|
in
|
|
mkdir_p d;
|
|
d
|
|
|
|
type opts = {
|
|
(* None is the host. "wasm32-wasi" is the headless one, run by a WASI
|
|
runtime; "web" is the browser one, built by emscripten. They share the
|
|
word wasm and almost nothing else — see [is_wasi] and [is_web]. *)
|
|
target : string option;
|
|
opt : string;
|
|
keep : bool; (* leave the .ll behind *)
|
|
checks : bool; (* bounds-check [at] and [slice] *)
|
|
(* A dev build is the one a REPL can attach to. Two things, and they belong
|
|
together because either alone is useless: every cross-function call goes
|
|
through a cell so a redefinition can be installed, and [-rdynamic] exports
|
|
those cells (and the globals) so a dlopen'd module can reach them. *)
|
|
dev : bool;
|
|
(* DWARF in the .ll and -g on the C, so lldb can put a breakpoint on a Flan
|
|
function by name and print its locals.
|
|
|
|
Its own axis, and deliberately not implied by -O0. The acceptance table
|
|
runs the same programs at -O0 and -O2 to compare the emitted IR against
|
|
what mem2reg makes of it, and if -O0 pulled in debug info every one of
|
|
those comparisons would be against a different module. It is not implied
|
|
by [dev] either: a dev build is about reloading, this is about reading,
|
|
and either is useful without the other. What it *does* imply, downwards,
|
|
is -O0 -- see [executable], where it sets [opt] -- because the whole
|
|
mechanism is a [llvm.dbg.declare] on an alloca and mem2reg deletes the
|
|
alloca. *)
|
|
debug : bool;
|
|
(* AddressSanitizer and UndefinedBehaviorSanitizer over the whole program:
|
|
the runtime's C, the generated shim, and — via [Emit]'s
|
|
[sanitize_address] attribute — the Flan code itself.
|
|
|
|
Its own axis and not a mode of [debug]. It deliberately does *not* force
|
|
-O0: the UB worth finding (a shift past the width folding to nothing, a
|
|
float cast that only traps once it is a real cvttss2si) is what the
|
|
optimiser does with it, so the sweep is worth running at -O2 and at -O0
|
|
and any divergence between the two is itself the finding. It does pull in
|
|
-g, because a report without a line number costs more to read than the
|
|
build costs to make.
|
|
|
|
What reaches what, measured rather than assumed:
|
|
- ASan instruments Flan functions only because [Emit] attributes them;
|
|
globals get their redzone from the module pass either way.
|
|
- UBSan instruments the C only. Its checks come out of clang's C
|
|
frontend, and there is no attribute that asks a pass for them, so
|
|
hand-written IR gets none. See [Emit]'s [sanitize] comment.
|
|
- signed-integer-overflow is excluded because wrapping is what this
|
|
language's arithmetic means; without the exclusion every program
|
|
trips on its first [+]. Nothing else is excluded. *)
|
|
sanitize : bool;
|
|
(* The dev backend: lower the typed IR to x86-64 assembly here instead of
|
|
handing LLVM IR to clang. Off by default and off everywhere but the one
|
|
flag that asks for it — LLVM stays the release backend and the default
|
|
one. It refuses rather than degrades: a program holding a node [x86.ml]
|
|
does not lower yet stops the build with that node's name, so a build that
|
|
succeeds is one this backend really compiled. *)
|
|
x86 : bool;
|
|
}
|
|
|
|
(* Checks are deliberately independent of [opt]: the acceptance table runs the
|
|
same programs at -O0 and -O2 to compare the emitted IR against what mem2reg
|
|
makes of it, and that comparison is only meaningful if both emit the same
|
|
checks. Dropping them is a release decision, not an optimisation one. *)
|
|
let default =
|
|
{ target = None; opt = "-O2"; keep = false; checks = true; dev = false;
|
|
debug = false; sanitize = false; x86 = false }
|
|
|
|
(* The flags that are neither [opt] nor the target, spelled once so that the
|
|
compile command and the object-cache key cannot disagree. They did before:
|
|
-g was written out at the command and again at the key, and a flag that
|
|
appears in one and not the other is the silent failure — an unsanitized
|
|
[flan_rt.o] served out of the cache to a sanitized build links fine and
|
|
reports nothing. *)
|
|
let cflags opts =
|
|
(if opts.debug then [ "-g" ] else [])
|
|
@ (if opts.sanitize then
|
|
(* -g here and not via [debug]: a sanitizer report with no file and no
|
|
line is most of the work still to do. *)
|
|
[ "-fsanitize=address,undefined";
|
|
"-fno-sanitize=signed-integer-overflow";
|
|
"-fno-omit-frame-pointer" ]
|
|
@ (if opts.debug then [] else [ "-g" ])
|
|
else [])
|
|
|
|
(* ── wasm32, which needs more than a triple ──────────────────────────
|
|
The native target is whatever clang was built for, so [--target=] alone is
|
|
the whole of it. wasm32-wasi is not: the headers come from a sysroot clang
|
|
does not know about, and the builtins archive is not in clang's resource
|
|
directory on Fedora at all. Both have to be found, and *both* have to reach
|
|
the C compiles as well as the link — [flan_rt.c] includes <stdio.h>.
|
|
|
|
Anything missing is refused by name, with the path that is missing and the
|
|
package that would supply it. A build that reports success for a target it
|
|
cannot actually produce is the one outcome worth avoiding here. *)
|
|
|
|
let getenv name = try Some (Sys.getenv name) with Not_found -> None
|
|
|
|
(* ── Two wasm targets, spelled apart ─────────────────────────────────
|
|
[web] is emscripten's: a browser, a GL context, a JS runtime, and a clang
|
|
whose sysroot and builtins come with it. [wasm32-wasi] is the headless one:
|
|
a WASI runtime, no GL, no browser, and a sysroot this file has to find.
|
|
"wasm32-unknown-emscripten" is accepted as a synonym for [web] because that
|
|
is the triple, and someone will write it.
|
|
|
|
What the two share is the machine — 32-bit pointers, no dlopen — which is
|
|
exactly the set of things [is_wasm] guards: the three refusals below are
|
|
about the machine and so they apply to both. *)
|
|
let is_web t =
|
|
t = "web" || t = "emscripten"
|
|
|| String.starts_with ~prefix:"wasm32-unknown-emscripten" t
|
|
|| String.starts_with ~prefix:"wasm32-emscripten" t
|
|
|
|
let is_wasi t = String.starts_with ~prefix:"wasm32" t && not (is_web t)
|
|
let is_wasm t = is_web t || is_wasi t
|
|
|
|
let wasm_target opts =
|
|
match opts.target with Some t when is_wasm t -> true | _ -> false
|
|
|
|
let web_target opts =
|
|
match opts.target with Some t when is_web t -> true | _ -> false
|
|
|
|
let wasi_target opts =
|
|
match opts.target with Some t when is_wasi t -> true | _ -> false
|
|
|
|
(* ── The fourth target, and the only one with no clang in it ──────────
|
|
|
|
[--target=js] is a *dialect*, not a machine: docs/DISCUSS.md item 5 settled
|
|
object mapping over linear memory, and object mapping leaves the memory
|
|
model behind. See [lib/js.ml]'s header for what maps to what and what is
|
|
refused. Nothing below the fork in [executable] applies to it — there is no
|
|
object to compile, no runtime C to link and no linker to run — so it leaves
|
|
through its own two lines rather than threading a fourth case through
|
|
[target_flags], [compiler] and [cflags]. *)
|
|
let is_js t = t = "js" || t = "javascript" || t = "node"
|
|
|
|
let js_target opts =
|
|
match opts.target with Some t when is_js t -> true | _ -> false
|
|
|
|
(* Which compiler a target is built by. This is not a flag difference: emcc is
|
|
a different program with a different driver, and the object cache key below
|
|
carries it for the same reason it carries clang's mtime. *)
|
|
let compiler opts = if web_target opts then emcc else clang
|
|
|
|
(* Where on PATH a program is, or None. *)
|
|
let on_path prog =
|
|
let dirs = String.split_on_char ':' (try Sys.getenv "PATH" with Not_found -> "") in
|
|
List.find_map
|
|
(fun d ->
|
|
let p = Filename.concat d prog in
|
|
if Sys.file_exists p then Some p else None)
|
|
dirs
|
|
|
|
let wasm_sysroot () =
|
|
match getenv "FLAN_WASM_SYSROOT" with Some s -> s | None -> "/usr/wasm32-wasi"
|
|
|
|
(* The builtins archive — __muldi3, the float conversions, memcpy. Fedora's
|
|
clang ships no wasm copy of it (dnf provides '*libclang_rt.builtins*wasm*'
|
|
finds nothing) and the proper article comes from a wasi-sdk release.
|
|
Failing that, emscripten builds the same compiler-rt for wasm32 and calls it
|
|
libcompiler_rt.a; it is a different triple (wasm32-unknown-emscripten) built
|
|
by a different clang, and it is *substituting* here, not the real thing. It
|
|
links and runs, and the sand hash matches native byte for byte, but a
|
|
session reading this should know the joint is glued. *)
|
|
let wasm_builtins_candidates () =
|
|
(* wasi-sdk's own resource directory, whichever LLVM that release bundled —
|
|
the version is in the path and moves release to release, so it is read
|
|
rather than guessed. Same rule as [clang_resource_dir]. *)
|
|
(let root = "/opt/wasi-sdk/lib/clang" in
|
|
match Sys.readdir root with
|
|
| vs ->
|
|
Array.sort compare vs;
|
|
Array.to_list vs
|
|
|> List.map (fun v ->
|
|
Filename.concat root
|
|
(Filename.concat v "lib/wasm32-unknown-wasi/libclang_rt.builtins.a"))
|
|
| exception Sys_error _ -> [])
|
|
@ (match on_path "emcc" with
|
|
| None -> []
|
|
| Some e ->
|
|
[ Filename.concat (Filename.dirname e)
|
|
"cache/sysroot/lib/wasm32-emscripten/libcompiler_rt.a" ])
|
|
|
|
let wasm_builtins () =
|
|
(* An explicit FLAN_WASM_BUILTINS that does not exist is an error and not a
|
|
hint: falling back to a guess would build against something other than
|
|
what was asked for and say nothing. *)
|
|
match getenv "FLAN_WASM_BUILTINS" with
|
|
| Some s when Sys.file_exists s -> s
|
|
| Some s ->
|
|
failwith (Printf.sprintf "wasm32: FLAN_WASM_BUILTINS is %s, which does not exist" s)
|
|
| None ->
|
|
let cands = wasm_builtins_candidates () in
|
|
match List.find_opt Sys.file_exists cands with
|
|
| Some p -> p
|
|
| None ->
|
|
failwith
|
|
(Printf.sprintf
|
|
"wasm32: no builtins archive. clang wants \
|
|
<resource-dir>/lib/wasm32-unknown-wasi/libclang_rt.builtins.a, which \
|
|
no Fedora package provides; it comes from a wasi-sdk release, or \
|
|
emscripten's libcompiler_rt.a will substitute. Looked in: %s. Set \
|
|
FLAN_WASM_BUILTINS to the archive."
|
|
(String.concat ", " cands))
|
|
|
|
(* clang's own resource directory, asked for rather than guessed — the version
|
|
number is in the path and a Fedora clang bump changes it. *)
|
|
let clang_resource_dir =
|
|
lazy
|
|
(let tmp =
|
|
Filename.concat (Filename.get_temp_dir_name ())
|
|
(Printf.sprintf "flan-rd-%d" (Unix.getpid ()))
|
|
in
|
|
let code =
|
|
Sys.command
|
|
(Printf.sprintf "%s -print-resource-dir > %s 2>/dev/null"
|
|
(Filename.quote clang) (Filename.quote tmp))
|
|
in
|
|
let s = if code = 0 then read_file_opt tmp else None in
|
|
(try Sys.remove tmp with Sys_error _ -> ());
|
|
match s with
|
|
| Some s -> String.trim s
|
|
| None -> failwith "wasm32: clang -print-resource-dir failed")
|
|
|
|
(* A resource directory clang will accept for wasm32-wasi: its real include
|
|
directory, and the builtins archive under the name and triple clang looks
|
|
for. Built under the object cache and named by a digest of what went into
|
|
it, so repointing FLAN_WASM_BUILTINS or upgrading clang makes a new one
|
|
rather than reusing a stale one. *)
|
|
let wasm_resource_dir () =
|
|
let real = Lazy.force clang_resource_dir in
|
|
let builtins = wasm_builtins () in
|
|
let st = Unix.stat builtins in
|
|
let key =
|
|
Digest.to_hex
|
|
(Digest.string
|
|
(String.concat "\000"
|
|
[ real; builtins; string_of_int st.Unix.st_size;
|
|
string_of_float st.Unix.st_mtime ]))
|
|
in
|
|
let dir = Filename.concat (cachedir ()) ("wasm-rd-" ^ key) in
|
|
let lib = Filename.concat dir "lib" in
|
|
let triple = Filename.concat lib "wasm32-unknown-wasi" in
|
|
let archive = Filename.concat triple "libclang_rt.builtins.a" in
|
|
if not (Sys.file_exists archive) then begin
|
|
let mk d = try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> () in
|
|
mk dir; mk lib; mk triple;
|
|
let inc = Filename.concat dir "include" in
|
|
if not (Sys.file_exists inc) then
|
|
(try Unix.symlink (Filename.concat real "include") inc
|
|
with Unix.Unix_error _ -> ());
|
|
let tmp = Printf.sprintf "%s.%d.tmp" archive (Unix.getpid ()) in
|
|
write_bin tmp (read_file builtins);
|
|
(try Unix.rename tmp archive with Unix.Unix_error _ -> ())
|
|
end;
|
|
dir
|
|
|
|
(* The flags a target adds, used by the C compiles and by the link alike. *)
|
|
let target_flags opts =
|
|
match opts.target with
|
|
| None -> []
|
|
(* The browser target adds no flags to a compile at all: emcc already is the
|
|
triple, the sysroot and the builtins. What it does need is to exist, and
|
|
an emcc that is not there must be refused here — where the reason can name
|
|
it — and not at the first "command not found" from a subshell. *)
|
|
| Some t when is_web t ->
|
|
if on_path emcc = None && not (Sys.file_exists emcc) then
|
|
failwith
|
|
(Printf.sprintf
|
|
"web: no %s on PATH. The browser target is built by emscripten: \
|
|
install an emsdk and source its emsdk_env.sh, or set FLAN_EMCC to \
|
|
the emcc to use."
|
|
emcc);
|
|
[]
|
|
| Some t when not (is_wasm t) -> [ "--target=" ^ t ]
|
|
| Some t ->
|
|
let sysroot = wasm_sysroot () in
|
|
(* Fedora's wasi-libc puts the headers one level deeper than wasi-sdk's
|
|
does — include/wasm32-wasi/stdio.h against include/stdio.h — so both
|
|
shapes count as a sysroot. clang finds either on its own. *)
|
|
if not (List.exists
|
|
(fun p -> Sys.file_exists (Filename.concat sysroot p))
|
|
[ "include/stdio.h"; "include/wasm32-wasi/stdio.h" ])
|
|
then
|
|
failwith
|
|
(Printf.sprintf
|
|
"wasm32: no sysroot at %s (wanted include/stdio.h). Install \
|
|
wasi-libc-devel and wasi-libc-static, or set FLAN_WASM_SYSROOT."
|
|
sysroot);
|
|
[ "--target=" ^ t; "--sysroot=" ^ sysroot;
|
|
"-resource-dir=" ^ wasm_resource_dir () ]
|
|
|
|
(* wasi-libc's start code calls __main_argc_argv, not main: clang *renames*
|
|
C's argc/argv [main] to that when it compiles C for wasm32, and the .ll
|
|
Emit writes says @main literally. Without this the link succeeds and the
|
|
program traps at its first instruction on a signature-mismatched weak stub.
|
|
The __asm__ label is load-bearing and must not be "simplified" away —
|
|
spelling the callee [main] makes clang rename *that* too, and the shim
|
|
becomes an infinite self-call that hangs rather than failing. *)
|
|
let wasm_main_source =
|
|
"int flan_entry(int argc, char **argv) __asm__(\"main\");\n\
|
|
int __main_argc_argv(int argc, char **argv) { return flan_entry(argc, argv); }\n"
|
|
|
|
(* ── The browser: the main loop, the shell, and the link ─────────────
|
|
The mechanism, and why it is not the one the old note predicted.
|
|
|
|
docs/BUILT.md says a web build "drives the loop with [emscripten_set_main_loop]
|
|
instead of a [while]. That is a different [main], not a different program."
|
|
The first half is right about the browser and wrong about what it costs
|
|
here: [emscripten_set_main_loop] wants the loop body as a callback, so every
|
|
example that spells
|
|
|
|
(until (rl/window-should-close?) ...)
|
|
|
|
would have to be cut in half — an init and a tick — by hand, in every file,
|
|
and the resulting program would no longer be the one that runs natively.
|
|
|
|
[-sASYNCIFY] is the other half of the same browser fact and costs none of
|
|
that. It rewrites the module so a call can suspend and resume across a
|
|
return to the event loop, and raylib's web platform is built for it:
|
|
[WindowShouldClose] on PLATFORM_WEB is an [emscripten_sleep(16)] that then
|
|
returns false (raylib 5.5, platforms/rcore_web.c). So the Flan [until] loop
|
|
yields to the browser once a frame, at the call it already makes, and not
|
|
one example changes. Same program, same [main], same source on both targets.
|
|
|
|
What it costs is real and worth writing down: asyncify instruments the whole
|
|
module, which is roughly a doubling of code size and a measurable slowdown
|
|
on the instrumented paths. It is applied to every web build rather than to
|
|
the ones that block, because "does this program block" is not a question
|
|
this file can answer and a flag set that varies per program is a cache key
|
|
that varies per program. *)
|
|
|
|
let web_shell_default =
|
|
{html|<!doctype html>
|
|
<!-- The smallest page that makes a Flan web build openable: a canvas for
|
|
raylib's GL context, and stdout on the page rather than only in the
|
|
console, because a headless check and a human reader want the same text.
|
|
emcc substitutes the module's JS for {{{ SCRIPT }}}; nothing else here is
|
|
emscripten's. Replace it with FLAN_WEB_SHELL. -->
|
|
<html lang="en">
|
|
<head>
|
|
<meta charset="utf-8">
|
|
<title>flan</title>
|
|
<style>
|
|
html, body { margin: 0; background: #14161a; color: #d8dee9;
|
|
font: 13px/1.5 ui-monospace, monospace; }
|
|
#canvas { display: block; margin: 0 auto; background: #000;
|
|
outline: none; }
|
|
#out { white-space: pre-wrap; padding: 8px 12px; }
|
|
</style>
|
|
</head>
|
|
<body>
|
|
<canvas id="canvas" tabindex="-1"
|
|
oncontextmenu="event.preventDefault()"></canvas>
|
|
<pre id="out"></pre>
|
|
<script>
|
|
var out = document.getElementById('out');
|
|
var Module = {
|
|
canvas: document.getElementById('canvas'),
|
|
print: function (t) { out.textContent += t + '\n'; },
|
|
printErr: function (t) { out.textContent += t + '\n'; },
|
|
};
|
|
</script>
|
|
{{{ SCRIPT }}}
|
|
</body>
|
|
</html>
|
|
|html}
|
|
|
|
(* The shell is a string here rather than a file in the tree for the same
|
|
reason [Runtime_src] is: it has to be present wherever the compiler is, and
|
|
a build that cannot find its own shell is a build that fails for a reason
|
|
nobody spelled. FLAN_WEB_SHELL replaces it. *)
|
|
let web_shell_file () =
|
|
match getenv "FLAN_WEB_SHELL" with
|
|
| Some p when Sys.file_exists p -> p
|
|
| Some p ->
|
|
failwith (Printf.sprintf "web: FLAN_WEB_SHELL is %s, which does not exist" p)
|
|
| None ->
|
|
let p = Filename.concat (workdir ()) "flan-shell.html" in
|
|
write p web_shell_default;
|
|
p
|
|
|
|
(* The flags the browser target adds at the link, and only at the link.
|
|
|
|
ALLOW_MEMORY_GROWTH because the default heap is 16MB and a texture is not
|
|
small. EXPORT_ES6=0 and the default MODULARIZE are left alone so that the
|
|
.js is a plain script both the shell and node can run — which is what makes
|
|
the test headless.
|
|
|
|
--shell-file only when the output is a page. Asking emcc for a .js and
|
|
handing it an HTML shell is accepted and ignored, which is the kind of
|
|
silence this file tries not to produce. *)
|
|
let web_link_flags ~out =
|
|
[ "-sASYNCIFY"; "-sALLOW_MEMORY_GROWTH=1" ]
|
|
@ (if Filename.extension out = ".html" then
|
|
[ "--shell-file"; Filename.quote (web_shell_file ()) ]
|
|
else [])
|
|
|
|
(* ── A [link] line may be addressed to one target ────────────────────
|
|
`vendor/raylib/link` names Fedora's libraylib.so.550, which exists on the
|
|
host and nowhere else; the browser wants a static archive built by
|
|
emscripten and three -s flags besides. So a line may carry a tag:
|
|
|
|
@native -l:libraylib.so.550
|
|
@web ${FLAN_RAYLIB_WEB}
|
|
|
|
and an untagged line applies to every target, which is what every existing
|
|
`link` file is.
|
|
|
|
The selection happens *here* and not in [Load], which is where the file is
|
|
read, because [Load] resolves imports before a target is chosen — the same
|
|
program is built for both — and a package's linker arguments are carried to
|
|
this function as a flat list of strings. [Load] passing the lines through
|
|
untouched is the whole of its part in this.
|
|
|
|
${NAME} expands from the environment. An unset one is refused by name: the
|
|
archive a web build needs is built once by vendor/raylib/build-web.sh and
|
|
lives at a path only that machine knows, and the alternative to naming it
|
|
here is a linker error about GLFW symbols. *)
|
|
|
|
let link_tags = [ "native"; "wasi"; "web" ]
|
|
|
|
let target_tag opts =
|
|
if web_target opts then "web"
|
|
else if wasi_target opts then "wasi"
|
|
else "native"
|
|
|
|
(* ${NAME} → the environment's NAME. Nothing else is substituted: this is not a
|
|
shell, and a linker argument containing a $ that is not a ${ is left alone
|
|
rather than guessed at. *)
|
|
let expand_vars ~where s =
|
|
let b = Buffer.create (String.length s) in
|
|
let n = String.length s in
|
|
let rec go i =
|
|
if i >= n then ()
|
|
else if i + 1 < n && s.[i] = '$' && s.[i + 1] = '{' then
|
|
match String.index_from_opt s (i + 2) '}' with
|
|
| None -> Buffer.add_char b s.[i]; go (i + 1)
|
|
| Some j ->
|
|
let name = String.sub s (i + 2) (j - i - 2) in
|
|
(match getenv name with
|
|
| Some v -> Buffer.add_string b v
|
|
| None ->
|
|
failwith
|
|
(Printf.sprintf
|
|
"%s: the linker argument %s wants %s, which is not set in the \
|
|
environment"
|
|
where s name));
|
|
go (j + 1)
|
|
else (Buffer.add_char b s.[i]; go (i + 1))
|
|
in
|
|
go 0;
|
|
Buffer.contents b
|
|
|
|
let select_lflags opts flags =
|
|
let want = target_tag opts in
|
|
List.filter_map
|
|
(fun f ->
|
|
if String.length f > 0 && f.[0] = '@' then begin
|
|
let tag, rest =
|
|
match String.index_opt f ' ' with
|
|
| Some i ->
|
|
(String.sub f 1 (i - 1),
|
|
String.trim (String.sub f (i + 1) (String.length f - i - 1)))
|
|
| None -> (String.sub f 1 (String.length f - 1), "")
|
|
in
|
|
if not (List.mem tag link_tags) then
|
|
failwith
|
|
(Printf.sprintf
|
|
"link: @%s is not a target — the tags are %s, and an untagged \
|
|
line applies to all of them"
|
|
tag
|
|
(String.concat ", " (List.map (fun t -> "@" ^ t) link_tags)));
|
|
if tag = want && rest <> "" then
|
|
Some (expand_vars ~where:("link: @" ^ tag) rest)
|
|
else None
|
|
end
|
|
else Some (expand_vars ~where:"link" f))
|
|
flags
|
|
|
|
(* ── A package's C may be addressed to one target too ─────────────────
|
|
[link] lines carry a @tag; a package's .c files had no such channel, and
|
|
[Load] collects every one of them by listing the directory. There is nowhere
|
|
in a directory listing to put a tag except the name, so the tag goes there,
|
|
before the extension:
|
|
|
|
flan_agent.c compiled everywhere, unless displaced
|
|
flan_agent.web.c compiled for the browser, and displaces the above
|
|
|
|
The rule is one sentence: **a tagged file is compiled only on its own
|
|
target, and there it replaces the untagged file of the same base name.**
|
|
Untagged is the default and every existing package is untagged, so nothing
|
|
that does not opt in changes.
|
|
|
|
Replacement rather than pure tagging, which is what Go's `_windows.go` and
|
|
Odin's `file_js.odin` do, and the difference is deliberate: pure tagging
|
|
would mean renaming the file that already works — [flan_agent.c] becoming
|
|
[flan_agent.native.c] — to teach a package about a target it had never
|
|
heard of. Making the browser's answer *additive* means a package gains a
|
|
target by gaining a file, and the file that was right on three targets is
|
|
not touched to say so.
|
|
|
|
The selection is here and not in [Load] for the reason [select_lflags] is:
|
|
[Load] resolves imports before a target is chosen, and the same program is
|
|
built for both.
|
|
|
|
The base name is what is matched, not the path: two packages each with a
|
|
[flan_agent.c] would already collide at the link, so there is nothing new
|
|
to disambiguate here. *)
|
|
let split_csrc_tag path =
|
|
let base = Filename.basename path in
|
|
let stem = Filename.remove_extension base in
|
|
match Filename.extension stem with
|
|
| "" -> (stem, None)
|
|
| dot_tag ->
|
|
let tag = String.sub dot_tag 1 (String.length dot_tag - 1) in
|
|
if List.mem tag link_tags then (Filename.remove_extension stem, Some tag)
|
|
else (stem, None)
|
|
|
|
let select_csrcs opts csrcs =
|
|
let want = target_tag opts in
|
|
(* The base names a tagged file speaks for on *this* target. Only these
|
|
displace; a [foo.wasi.c] is invisible to a native build in both
|
|
directions, so it neither compiles nor hides [foo.c]. *)
|
|
let displaced =
|
|
List.filter_map
|
|
(fun c ->
|
|
match split_csrc_tag c with
|
|
| (base, Some tag) when String.equal tag want -> Some base
|
|
| _ -> None)
|
|
csrcs
|
|
in
|
|
List.filter
|
|
(fun c ->
|
|
match split_csrc_tag c with
|
|
| (_, Some tag) -> String.equal tag want
|
|
| (base, None) -> not (List.mem base displaced))
|
|
csrcs
|
|
|
|
(* What the compiler itself is, cheaply: its path, size and mtime. A clang
|
|
upgrade changes one of those, so the key changes with it — without paying a
|
|
[clang --version] subprocess on every build, which would cost most of what
|
|
the cache buys. Taken of whichever compiler the target uses, so an emcc
|
|
object and a clang object of the same source cannot collide. *)
|
|
let stamp_of prog =
|
|
let path =
|
|
if Filename.is_relative prog then
|
|
let dirs = String.split_on_char ':' (try Sys.getenv "PATH" with Not_found -> "") in
|
|
(try List.find (fun d -> Sys.file_exists (Filename.concat d prog))
|
|
dirs |> fun d -> Filename.concat d prog
|
|
with Not_found -> prog)
|
|
else prog
|
|
in
|
|
match Unix.stat path with
|
|
| st -> Printf.sprintf "%s:%d:%f" path st.Unix.st_size st.Unix.st_mtime
|
|
| exception Unix.Unix_error _ -> path
|
|
|
|
let clang_stamp = lazy (stamp_of clang)
|
|
|
|
(* Compile one C translation unit to an object file, reusing a cached one when
|
|
the source text, the compiler and the flags are all unchanged. The key has
|
|
to carry [opt] and [target]: the acceptance table builds the same programs
|
|
at -O0 and -O2, and an -O2 object must not serve an -O0 build. *)
|
|
(* Warnings for the translation units this project *owns*, which is the runtime
|
|
and the dev half of it. They are not on for a package's C or for the
|
|
generated shim: a package's sources are someone else's code, and a warning
|
|
nobody in this repository can fix is noise on every build that imports it.
|
|
The runtime is the opposite case — an unused result, a sign compare or a
|
|
conversion that narrows is a bug report here, and the file had none of this
|
|
coverage before. [-Werror] is deliberately absent: a clang upgrade must not
|
|
stop a user's build over a new diagnostic in code they did not write. *)
|
|
let runtime_warnings = [ "-Wall"; "-Wextra" ]
|
|
|
|
let compile_c ~opts ?tflags ?(warn = []) ~src ~name () =
|
|
(* The whole flag list, not just the triple: on wasm32 the sysroot and the
|
|
resource directory decide which headers and which builtins an object was
|
|
built against, so repointing either must not serve a stale .o. *)
|
|
let tflags = match tflags with Some f -> f | None -> target_flags opts in
|
|
let cc = compiler opts in
|
|
let key =
|
|
Digest.to_hex
|
|
(Digest.string
|
|
(String.concat "\000"
|
|
[ name; src; stamp_of cc; opts.opt;
|
|
String.concat " " (cflags opts);
|
|
String.concat " " tflags;
|
|
String.concat " " warn ]))
|
|
in
|
|
let obj = Filename.concat (cachedir ()) (key ^ ".o") in
|
|
if not (Sys.file_exists obj) then begin
|
|
let dir = workdir () in
|
|
let c = Filename.concat dir name in
|
|
write c src;
|
|
(* A distinct temporary target, renamed into place, so two builds running
|
|
at once cannot see a half-written object. *)
|
|
let tmp = Printf.sprintf "%s.%d.tmp" obj (Unix.getpid ()) in
|
|
let cmd =
|
|
String.concat " "
|
|
([ Filename.quote cc; opts.opt ]
|
|
@ cflags opts
|
|
@ warn
|
|
@ [ "-c" ] @ tflags
|
|
@ [ Filename.quote c; "-o"; Filename.quote tmp ])
|
|
in
|
|
let code = Sys.command cmd in
|
|
if code <> 0 then
|
|
failwith (Printf.sprintf "%s failed (exit %d) on %s" cc code name);
|
|
(try Unix.rename tmp obj with Unix.Unix_error _ -> ());
|
|
(try Sys.remove c with Sys_error _ -> ())
|
|
end;
|
|
obj
|
|
|
|
(* [csrcs] and [lflags] come from the imported packages (see [Load]): the C
|
|
shim a package binds through, and the arguments needed to link the library
|
|
it binds to. *)
|
|
let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = [])
|
|
(p : Tast.program) ~out =
|
|
(* The JS dialect leaves here, before anything that assumes a clang. Its
|
|
flags are refused rather than ignored, for the reason [flan emit] refuses
|
|
[--target]: a flag that is silently swallowed is the shape the house rule
|
|
exists to prevent. [--dev] is the one worth a sentence of its own — the
|
|
dev loop on JS is a real possibility and deliberately not this lane. *)
|
|
if js_target opts then begin
|
|
if opts.dev then
|
|
failwith
|
|
"js: --dev is not built yet — evaluating new code is the one thing \
|
|
JavaScript makes easy, so this is a lane and not a limit";
|
|
if opts.debug then
|
|
failwith "js: --debug is native only — there is no DWARF in a .js file";
|
|
if opts.sanitize then
|
|
failwith "js: --sanitize is native only";
|
|
if opts.x86 then
|
|
failwith "js: --x86 and --target=js are two different backends";
|
|
write out (Js.program ~checks:opts.checks p);
|
|
out
|
|
end
|
|
else
|
|
(* A dev build is the REPL's, and the REPL reaches a running process through
|
|
[-rdynamic] and [dlopen]. Neither exists on wasm32, so the combination is
|
|
refused rather than quietly producing a module nothing can attach to. *)
|
|
(* Named for the target that was asked for, since two of them answer to
|
|
[wasm_target] now and "wasm32:" on a --target=web build reads as a
|
|
compiler that did not hear the question. *)
|
|
let tname = if web_target opts then "web" else "wasm32" in
|
|
if wasm_target opts && opts.dev then
|
|
failwith
|
|
(tname
|
|
^ ": --dev is native only — the reload path is dlopen, which wasm has \
|
|
no equivalent of");
|
|
(* Refused rather than emitted-and-hoped-for. The member offsets in the DWARF
|
|
are computed for the host's layout — [ptr] 8 bytes — and wasm32's pointer
|
|
is 4, so a slice's [len] is at byte 8 there and at byte 16 here. Emitting
|
|
the host numbers would give a debugger a confident wrong answer for every
|
|
slice and every struct holding one, which is the failure this project
|
|
keeps meeting at the FFI boundary. *)
|
|
if wasm_target opts && opts.debug then
|
|
failwith
|
|
(tname
|
|
^ ": --debug is native only — the DWARF member offsets are computed \
|
|
for the host's layout, and wasm32's 32-bit pointer moves every one \
|
|
of them");
|
|
(* There is no wasm32 sanitizer runtime to link against: clang accepts
|
|
-fsanitize=address for the triple and the link fails on
|
|
__asan_report_load4. Refused by name rather than met at the linker. *)
|
|
(* emscripten does ship an ASan, so the web half of this refusal is weaker
|
|
than the wasi half: it is untested here rather than known to be
|
|
impossible. Refused all the same, because a sanitizer that has never been
|
|
run is a sanitizer whose silence means nothing, and the sweep this project
|
|
runs (@sanitize) is native. *)
|
|
if wasm_target opts && opts.sanitize then
|
|
failwith
|
|
(if web_target opts then
|
|
"web: --sanitize is native only — emscripten has its own ASan, and \
|
|
nothing here has ever run it; the sanitizer sweep is the native one"
|
|
else
|
|
"wasm32: --sanitize is native only — there is no libclang_rt.asan for \
|
|
wasm32-wasi to link against");
|
|
(* -O0 is not a choice a debug build offers: [llvm.dbg.declare] describes an
|
|
alloca, and at -O2 mem2reg deletes the alloca. [sanitize] deliberately
|
|
does not do this: see [opts]. *)
|
|
let opts = if opts.debug then { opts with opt = "-O0" } else opts in
|
|
let tflags = target_flags opts in
|
|
(* [--dev] used to be in this list, for the indirection cells. It is not any
|
|
more: [x86.ml] emits a cell per function, spelled as [Emit.cellname]
|
|
spells it and exported the same way, and calls and function values read
|
|
it. What a `--x86 --dev` build still lacks is anything to *write* one —
|
|
[Emit.redefinition] has no x86 counterpart. That costs nothing here,
|
|
because [flan dev] never reaches this fork: [--x86] is read only by
|
|
[flan build], the daemon builds its host and its modules through this
|
|
function without it, and there is no spelling that hands it one. So the
|
|
flag means what it says — a host whose call sites are redefinable, built
|
|
by this backend — and the module that would redefine through them arrives
|
|
with the lane that writes it.
|
|
|
|
[X86.redefinition] is that lane, and it has landed, so the paragraph this
|
|
comment used to end with — that no counterpart existed — is no longer
|
|
true. What remains true is why it had to be written here rather than
|
|
borrowed from LLVM. [x86.ml]'s header licenses its own calling convention
|
|
on the grounds that a dev build is compiled entirely by it and a release
|
|
build entirely by LLVM, so the two never meet in one process. Publishing
|
|
a cell an LLVM-built module can store into is the first thing that could
|
|
make that false: the two conventions agree on scalars and disagree on
|
|
every aggregate, so an [Emit.redefinition] module dlopened into an
|
|
[--x86] host is correct until the first redefined function takes or
|
|
returns a struct. That pair is now refused at [dlopen] by a marker symbol
|
|
each backend defines and each backend's module references — see [shared]
|
|
below — rather than left to die at the call. The answer was to emit the
|
|
module through this backend too, and never to grow a classifier. *)
|
|
(* [--debug] used to be in this list too. It is not any more: [x86.ml] emits
|
|
a compile unit, a subprogram per function and a line table, all written
|
|
out as bytes because [.loc] cannot work against a file whose instructions
|
|
are [.byte] blobs -- see that file's own debug-information section. What
|
|
it does *not* emit is locals and types, for the reason given there: a
|
|
slot is a bump-allocated frame temporary whose lifetime this backend does
|
|
not model, so there is nothing honest for a [DW_TAG_variable] to point
|
|
at. So `--x86 --debug` gives a backtrace that names Flan files, functions
|
|
and lines, and `print x` says the name is not in the current context. *)
|
|
if opts.x86 && (wasm_target opts || opts.sanitize)
|
|
then
|
|
failwith
|
|
"--x86 is the native dev backend on its own: there is no sanitizer pass \
|
|
over hand-written assembly";
|
|
let dir = workdir () in
|
|
(* The one fork in this function. The x86 backend hands clang an assembly
|
|
file where LLVM hands it IR text; clang takes either on its command line,
|
|
so everything past this point — the runtime objects, the shim, the
|
|
package C, the linker arguments — is the same build. *)
|
|
let ll =
|
|
Filename.concat dir
|
|
(Filename.basename out ^ if opts.x86 then ".s" else ".ll")
|
|
in
|
|
write ll
|
|
(if opts.x86 then
|
|
X86.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug p
|
|
else
|
|
Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug ~pnames
|
|
~sanitize:opts.sanitize p);
|
|
(* [flan_dev.c] is compiled into every build, not only a dev one. Nothing in
|
|
a release build calls into it — the compiler only emits a registry lookup
|
|
for a name the host was not built with, which cannot arise without cells —
|
|
but the agent package's C refers to it, and a package's C sources are
|
|
collected whatever [main] does. Leaving it out made [flan build sand.flan]
|
|
fail at the link with an undefined symbol, which reads as a compiler bug
|
|
rather than as a missing flag. The table is BSS, so this costs address
|
|
space and not binary size, and [-rdynamic] and the cells are still what
|
|
[--dev] means. *)
|
|
let cc ?(warn = []) src name = compile_c ~opts ~tflags ~warn ~src ~name () in
|
|
(* The runtime's own C wants -g too, or a backtrace that passes through
|
|
flan_error lands in a frame with no line. The flag is part of the object
|
|
cache key via [compile_c]'s [opt]/[tflags] digest — see [cflags]. *)
|
|
let objs =
|
|
cc ~warn:runtime_warnings Runtime_src.source "flan_rt.c"
|
|
:: cc ~warn:runtime_warnings Runtime_src.dev_source "flan_dev.c"
|
|
:: [ cc ~warn:runtime_warnings Runtime_src.dyn_source "flan_dyn.c" ]
|
|
(* wasi-libc's entry point, which is not [main]. See [wasm_main_source].
|
|
Not the browser's: emscripten's start code calls [main] under that name,
|
|
so the .ll's @main is already the entry point and the shim would be a
|
|
second definition of it. *)
|
|
@ (if wasi_target opts then [ cc wasm_main_source "flan_wasm_main.c" ] else [])
|
|
(* The generated half of the FFI: one translation unit holding a typedef
|
|
per struct that crosses and a wrapper per (declare-c ...), compiled
|
|
exactly like a package's hand-written .c. It rides on the program
|
|
rather than on a parameter so that every caller of [executable] carries
|
|
it without having been changed to. See [Shim]. *)
|
|
@ (match p.Tast.cshim with
|
|
| [] -> []
|
|
| parts ->
|
|
[ cc (String.concat "" (List.map snd parts)) "flan_shim.c" ])
|
|
(* Per-target selection, the same shape [select_lflags] applies to a
|
|
package's linker arguments. See [select_csrcs]. *)
|
|
@ List.map (fun c -> cc (read_file c) (Filename.basename c))
|
|
(select_csrcs opts csrcs)
|
|
in
|
|
let cmd =
|
|
String.concat " "
|
|
([ Filename.quote (compiler opts); opts.opt; "-Wno-override-module" ]
|
|
(* -g at the link so clang does not strip, and keeps the object files'
|
|
debug sections; the .ll carries its own. The sanitizer flags have to
|
|
be here too — they are what pulls in libclang_rt.asan and the UBSan
|
|
runtime, and they are also what makes clang run the ASan pass over
|
|
the .ll, which is the only place the Flan half of the program gets
|
|
instrumented at all. *)
|
|
@ cflags opts
|
|
(* The .s carries a hand-written DWARF 4 compile unit. The numbered
|
|
[.file] directive in it stops clang's integrated assembler from
|
|
generating one of its own, but the directive still leaves an empty
|
|
line table behind, and at the default version that stub is a DWARF 5
|
|
header whose file table readelf reports as corrupt. Asking for 4
|
|
makes the stub parse, so a readelf cross-check of the real table is
|
|
not read past a warning. It reaches only this command, which
|
|
assembles the .s and links; the C objects were compiled by
|
|
[compile_c] and are already done. *)
|
|
@ (if opts.x86 && opts.debug then [ "-gdwarf-4" ] else [])
|
|
@ (if opts.dev then [ "-rdynamic" ] else [])
|
|
@ tflags
|
|
@ (if web_target opts then web_link_flags ~out else [])
|
|
@ [ Filename.quote ll ]
|
|
@ List.map Filename.quote objs
|
|
(* A package's linker arguments, with the lines addressed to another
|
|
target dropped and ${VAR} expanded. See [select_lflags]. *)
|
|
@ select_lflags opts lflags
|
|
(* The prelude declares sqrtf, so every link needs libm. It goes here
|
|
and not in the leading flags: the default --as-needed drops a
|
|
library named before the object that wants it, so at -O2 this would
|
|
appear to work — LLVM folds most sqrtf calls into the hardware
|
|
instruction and the symbol never has to resolve — and the -O0 build,
|
|
which emits the call, would fail at the link. Untested against
|
|
--target=wasm32; wasi-libc ships libm.a as a stub because the
|
|
symbols live in libc, so it should be inert there. *)
|
|
@ [ "-lm" ]
|
|
@ [ "-o"; Filename.quote out ])
|
|
in
|
|
let code = Sys.command cmd in
|
|
if code <> 0 then
|
|
failwith (Printf.sprintf "%s failed (exit %d); the IR is at %s" clang code ll);
|
|
if not opts.keep then (try Sys.remove ll with Sys_error _ -> ());
|
|
out
|
|
|
|
(* ── The dev path: one function into a loadable object ──────────────── *)
|
|
|
|
(* Step 1 of the dev loop (NEXT.md): [Emit.redefinition] text → a [.so] the
|
|
running process can [dlopen]. This never invokes the clang driver — the
|
|
driver is most of what a build costs and none of what it does is needed
|
|
here, since the input is already IR and the output has no libc to find.
|
|
|
|
[ld -shared] rather than [clang -shared] for the same reason. A shared
|
|
object is allowed undefined symbols, which is the whole mechanism: the
|
|
redefined function's calls to other Flan functions, to the globals and to
|
|
the runtime are all left for the loader to bind back to the host.
|
|
|
|
PIC has to be asked for. [llc] defaults to the static relocation model on
|
|
this target, and the failure is at link time, not at codegen: "relocation
|
|
R_X86_64_32S against ... can not be used when making a shared object". *)
|
|
|
|
let llc = try Sys.getenv "FLAN_LLC" with Not_found -> "llc"
|
|
let linker = try Sys.getenv "FLAN_LD" with Not_found -> "ld"
|
|
|
|
(* Times in milliseconds, per stage, because a single total does not say
|
|
whether the number is worth chasing. *)
|
|
type timing = { llc_ms : float; link_ms : float }
|
|
|
|
let time f =
|
|
let t0 = Unix.gettimeofday () in
|
|
let x = f () in
|
|
(x, (Unix.gettimeofday () -. t0) *. 1000.)
|
|
|
|
let run what cmd =
|
|
let code = Sys.command cmd in
|
|
if code <> 0 then failwith (Printf.sprintf "%s failed (exit %d)" what code)
|
|
|
|
let shared ?(opts = default) ~ir ~out () : timing =
|
|
let opts = if opts.debug then { opts with opt = "-O0" } else opts in
|
|
(* An [--x86] host must get [--x86] modules, and this is the one place that
|
|
can say so cheaply. The two backends' conventions agree on every scalar
|
|
and disagree on every aggregate, so a crossed pair links, loads, and then
|
|
dies at the first call into a redefined function that takes or returns a
|
|
struct — measured as SIGSEGV, in test_reload.ml's aggregate section. The
|
|
option record is where the backend choice lives, so a builder handed the
|
|
other backend's record refuses by name rather than producing that object.
|
|
|
|
Be clear about how little this catches, because a guard that reads wider
|
|
than it is is worse than none. It catches a caller holding one option
|
|
record and reaching for the wrong builder. It does not catch a caller
|
|
holding two and picking the wrong one — the crossed pair that was measured
|
|
segfaulting passes this check, because it hands an LLVM record to the LLVM
|
|
builder and simply loads the result into an x86 host. [flan reload] is
|
|
precisely that caller, and it is why this guard was never the whole
|
|
answer. The whole answer is the marker symbol: a dev build defines
|
|
[flan.abi.x86] or [flan.abi.llvm] according to which backend emitted it,
|
|
each backend's redefinition module holds a pointer to its own, and the
|
|
loader has to resolve that pointer while it maps the object — so a crossed
|
|
pair is refused at [dlopen], naming both backends, before any new body
|
|
runs. That landed; this check is the cheap first line rather than the only
|
|
one. See docs/handoffs/HANDOFF-x86-aggregates.md and
|
|
docs/handoffs/HANDOFF-x86-abi-marker.md. *)
|
|
if opts.x86 then
|
|
failwith
|
|
"--x86: Build.shared is the LLVM redefinition path, and an --x86 host \
|
|
must get --x86 modules — the two calling conventions disagree on every \
|
|
aggregate. Use Build.shared_x86 with X86.redefinition.";
|
|
if wasm_target opts then
|
|
failwith
|
|
((if web_target opts then "web" else "wasm32")
|
|
^ ": the reload path is native only — it is llc + ld -shared + dlopen, \
|
|
and wasm has no dlopen");
|
|
let dir = workdir () in
|
|
let base = Filename.remove_extension (Filename.basename out) in
|
|
let ll = Filename.concat dir (base ^ ".ll") in
|
|
let obj = Filename.concat dir (base ^ ".o") in
|
|
write ll ir;
|
|
let (), llc_ms =
|
|
time (fun () ->
|
|
run llc
|
|
(String.concat " "
|
|
([ Filename.quote llc; opts.opt; "-filetype=obj";
|
|
"-relocation-model=pic" ]
|
|
@ (match opts.target with None -> [] | Some t -> [ "-mtriple=" ^ t ])
|
|
@ [ Filename.quote ll; "-o"; Filename.quote obj ])))
|
|
in
|
|
let (), link_ms =
|
|
time (fun () ->
|
|
run linker
|
|
(String.concat " "
|
|
[ Filename.quote linker; "-shared"; Filename.quote obj; "-o";
|
|
Filename.quote out ]))
|
|
in
|
|
if not opts.keep then begin
|
|
(try Sys.remove ll with Sys_error _ -> ());
|
|
(try Sys.remove obj with Sys_error _ -> ())
|
|
end;
|
|
{ llc_ms; link_ms }
|
|
|
|
(* The same, from the dev backend. [X86.redefinition] hands out assembly rather
|
|
than IR, so [llc] is replaced by the assembler and the link is identical --
|
|
a shared object with undefined symbols, which the loader binds back to the
|
|
host.
|
|
|
|
There is no [-relocation-model=pic] to ask for, because the emitter decides
|
|
that itself: every reference to a symbol the module does not define is
|
|
already written through the GOT. [as] is not given [-fPIC] either; the flag
|
|
does not exist for it.
|
|
|
|
An [--x86] host must get [--x86] modules. The two backends' conventions
|
|
agree on scalars and disagree on every aggregate, so crossing them is
|
|
correct exactly until the first redefined function takes or returns a
|
|
struct. See [lib/x86.ml]'s header. *)
|
|
let assembler = try Sys.getenv "FLAN_AS" with Not_found -> "as"
|
|
|
|
let shared_x86 ?(opts = default) ~asm ~out () : timing =
|
|
(* The other half of the same guard, and it is the half that costs nothing to
|
|
get right: a module built here for a host that was built by LLVM is the
|
|
same mismatch seen from the other side. *)
|
|
if not opts.x86 then
|
|
failwith
|
|
"Build.shared_x86 is the --x86 redefinition path and was handed an LLVM \
|
|
option record — an --x86 host must get --x86 modules, and an LLVM host \
|
|
must get LLVM ones. Set [x86] on the options, or use Build.shared.";
|
|
let dir = workdir () in
|
|
let base = Filename.remove_extension (Filename.basename out) in
|
|
let src = Filename.concat dir (base ^ ".s") in
|
|
let obj = Filename.concat dir (base ^ ".o") in
|
|
write src asm;
|
|
let (), llc_ms =
|
|
time (fun () ->
|
|
run assembler
|
|
(String.concat " "
|
|
[ Filename.quote assembler; Filename.quote src; "-o";
|
|
Filename.quote obj ]))
|
|
in
|
|
let (), link_ms =
|
|
time (fun () ->
|
|
run linker
|
|
(String.concat " "
|
|
[ Filename.quote linker; "-shared"; Filename.quote obj; "-o";
|
|
Filename.quote out ]))
|
|
in
|
|
if not opts.keep then begin
|
|
(try Sys.remove src with Sys_error _ -> ());
|
|
(try Sys.remove obj with Sys_error _ -> ())
|
|
end;
|
|
{ llc_ms; link_ms }
|
|
|
|
(* ── The macro path: a whole program into a shared object ───────────── *)
|
|
|
|
(* A macro module is not a redefinition, and the difference is the whole
|
|
design. [shared] above builds a module full of [declare]s and [external]s
|
|
for a host that is already running Flan; here the host is the *compiler*,
|
|
an OCaml executable with no Flan symbols in it at all. So this module is
|
|
self-contained: the runtime is linked in, every function it calls is
|
|
defined, and nothing is left for the loader to find. That is also what
|
|
keeps [-rdynamic] off the compiler's own link.
|
|
|
|
It goes through clang rather than through llc + ld, unlike [shared]: there
|
|
are C objects to link and a libc to find, which is exactly the part of the
|
|
driver the dev path skips because it does not need it. The cost is the
|
|
driver's ~50ms, paid once per process for the whole macro set. *)
|
|
let macro_module ?(opts = default) ?(csrcs = []) ?(lflags = []) ~macros
|
|
(p : Tast.program) ~out =
|
|
if wasm_target opts then
|
|
failwith
|
|
"macros are native only — running one means dlopening it into the \
|
|
compiler, and wasm has no dlopen";
|
|
let dir = workdir () in
|
|
let ll = Filename.concat dir (Filename.basename out ^ ".ll") in
|
|
(* [~hidden] is what keeps this module's Flan bodies its own. [flan dev]'s
|
|
merged build is the program and the compiler in one [-rdynamic]
|
|
executable, so it exports every [flan.*] body it has and ELF gives it
|
|
precedence over anything dlopened afterwards; the macro module's copy of a
|
|
prelude function would be interposed by the host's, which is a different
|
|
function compiled by a possibly different backend. [Emit.program]'s
|
|
[hidden] comment has the two failures that were measured. This is the
|
|
narrow half of what [-Wl,-Bsymbolic] would do and is the half that is
|
|
wanted: the module links its own [flan_rt.c], and binding *that* locally
|
|
would aim its calls at a copy of the runtime [flan_rt_init] never ran on
|
|
and at a [flan_exit_hook] the merged build never installed, so a trap
|
|
raised inside an expansion would take the process down instead of parking
|
|
it. Only the Flan symbols are pinned here; the C goes on resolving the way
|
|
it always did. *)
|
|
write ll (Emit.program ~checks:opts.checks ~macros ~hidden:true p);
|
|
(* -fPIC on every object, the .ll included. Without it the link fails with a
|
|
relocation against a symbol that cannot be used in a shared object — at
|
|
link time, not at codegen, which is the same trap [shared] meets and
|
|
answers with -relocation-model=pic. *)
|
|
let tflags = target_flags opts @ [ "-fPIC" ] in
|
|
let cc ?(warn = []) src name = compile_c ~opts ~tflags ~warn ~src ~name () in
|
|
let objs =
|
|
cc ~warn:runtime_warnings Runtime_src.source "flan_rt.c"
|
|
:: cc ~warn:runtime_warnings Runtime_src.dev_source "flan_dev.c"
|
|
:: [ cc ~warn:runtime_warnings Runtime_src.dyn_source "flan_dyn.c" ]
|
|
@ (match p.Tast.cshim with
|
|
| [] -> []
|
|
| parts ->
|
|
[ cc (String.concat "" (List.map snd parts)) "flan_shim.c" ])
|
|
@ List.map (fun c -> cc (read_file c) (Filename.basename c))
|
|
(select_csrcs opts csrcs)
|
|
in
|
|
let cmd =
|
|
String.concat " "
|
|
([ Filename.quote (compiler opts); opts.opt; "-Wno-override-module";
|
|
"-shared"; "-fPIC" ]
|
|
@ tflags
|
|
@ [ Filename.quote ll ]
|
|
@ List.map Filename.quote objs
|
|
@ select_lflags opts lflags
|
|
@ [ "-lm"; "-o"; Filename.quote out ])
|
|
in
|
|
let code = Sys.command cmd in
|
|
if code <> 0 then
|
|
failwith
|
|
(Printf.sprintf "building the macro module failed (exit %d); the IR is \
|
|
at %s" code ll);
|
|
if not opts.keep then (try Sys.remove ll with Sys_error _ -> ());
|
|
out
|