1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
(* Copyright © 2021-2026 OCamlPro *)
(* Written by the Owi programmers *)
open Bos
open Syntax
let resolve_binary name =
match OS.Cmd.resolve @@ Cmd.v name with
| Error _ ->
Fmt.error_msg
"The `%s` binary was not found, please make sure it is in your path." name
| Ok _ as ok -> ok
let err_output =
match Logs.Src.level Log.main_src with
| Some (Logs.Debug | Logs.Info) -> OS.Cmd.err_run_out
| None | Some _ -> OS.Cmd.err_null
let bitcode_of_input ~workspace ~llvm_as_bin file : Fpath.t Result.t =
match Fpath.get_ext ~multi:false file with
| ".bc" -> Ok file
| ".ll" ->
let out_bc = Fpath.(workspace // Fpath.base (file -+ ".bc")) in
let llvm_as_cmd : Cmd.t = Cmd.(llvm_as_bin % p file % "-o" % p out_bc) in
let+ () =
match OS.Cmd.run ~err:err_output llvm_as_cmd with
| Ok _ as v -> v
| Error (`Msg e) ->
Log.debug (fun m -> m "llvm-as failed: %s" e);
Fmt.error_msg
"llvm-as failed: run with -vv to get the full error message if it \
was not displayed above"
in
out_bc
| ext ->
Fmt.error_msg
"Unsupported file extension `%s` for LLVM command, expected .ll or .bc"
ext
let compile ~workspace ~entry_point ~out_file (files : Fpath.t list) :
Fpath.t Result.t =
let* llvm_as_bin = resolve_binary "llvm-as" in
let* llc_bin = resolve_binary "llc" in
let* wasmld_bin = resolve_binary "wasm-ld" in
let* bc_files = list_map (bitcode_of_input ~workspace ~llvm_as_bin) files in
let files_bc = Cmd.of_list (List.map Cmd.p bc_files) in
let llc_cmd : Cmd.t =
Cmd.(
llc_bin % "-O0" % "-march=wasm32" % "-mtriple=wasm32-unknown-unknown"
% "-filetype=obj" %% files_bc )
in
let* () =
Log.bench_fn "llc time" @@ fun () ->
match OS.Cmd.run ~err:err_output llc_cmd with
| Ok _ as v -> v
| Error (`Msg e) ->
Log.debug (fun m -> m "llc failed: %s" e);
Fmt.error_msg "llc failed: run with -vv to get the full error message"
in
let files_o =
Cmd.of_list (List.map (fun file -> Cmd.p Fpath.(file -+ ".o")) bc_files)
in
let out = Option.value ~default:Fpath.(workspace / "a.out.wasm") out_file in
let* libc = Cmd_utils.find_installed_c_file (Fpath.v "libc.wasm") in
let* libowi = Cmd_utils.find_installed_c_file (Fpath.v "libowi.wasm") in
let wasmld_cmd : Cmd.t =
Cmd.(
wasmld_bin
%% of_list
( [ "-z"; "stack-size=8388608" ]
@ ( match entry_point with
| None -> []
| Some entry_point ->
[ Fmt.str "--export=%s" entry_point
; Fmt.str "--entry=%s" entry_point
] )
@ [ "--allow-undefined" ]
@ [ p libc; p libowi ]
@ [ "-o"; p out ] )
%% files_o )
in
let+ () =
Log.bench_fn "wasm-ld time" @@ fun () ->
match OS.Cmd.run ~err:err_output wasmld_cmd with
| Ok _ as v -> v
| Error (`Msg e) ->
Log.debug (fun m -> m "wasm-ld failed: %s" e);
Fmt.error_msg
"wasm-ld failed: run with -vv to get the full error message if it was \
not displayed above"
in
out
let cmd ~(symbolic_parameters : Symbolic_parameters.t) ~files ~out_file :
unit Result.t =
let* workspace =
match symbolic_parameters.workspace with
| Some path -> Ok path
| None -> OS.Dir.tmp "owi_llvm_%s"
in
let* _did_create : bool = OS.Dir.create ~path:true workspace in
let* source_file =
compile ~workspace ~entry_point:symbolic_parameters.entry_point ~out_file
files
in
let workspace = Some workspace in
let parameters = { symbolic_parameters with workspace } in
Cmd_sym.cmd ~parameters ~source_file