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
122
123
124
125
126
127
128
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
(* Copyright © 2021-2024 OCamlPro *)
(* Written by the Owi programmers *)

open Bos
open Syntax

let compile ~workspace ~entry_point ~includes ~opt_lvl ~out_file
  (files : Fpath.t list) : Fpath.t Result.t =
  let* clangpp_bin = OS.Cmd.resolve @@ Cmd.v "clang++" in
  let opt_lvl = Fmt.str "-O%s" opt_lvl in

  let includes = Cmd.of_list ~slip:"-I" (List.map Cmd.p includes) in

  let err =
    match Logs.level () with
    | Some (Logs.Debug | Logs.Info) -> OS.Cmd.err_run_out
    | None | Some _ -> OS.Cmd.err_null
  in
  let* () =
    (* TODO: we use this recursive function in order to be able to use `-o` on
       each file. We could get rid of this if we managed to call the C++
       compiler and the linker in the same step as it is done for C - then
       there would be a single output file and we could use `-o` more easily. *)
    let rec compile_files = function
      | [] -> Ok ()
      | file :: rest -> (
        let out_bc = Fpath.(workspace // Fpath.base (file -+ ".bc")) in
        let clang_cmd =
          Cmd.(
            clangpp_bin % "-Wno-everything" % opt_lvl % "-emit-llvm"
            % "--target=wasm32" % "-m32" % "-c" %% includes % "-o" % p out_bc
            % p file )
        in
        match OS.Cmd.run ~err clang_cmd with
        | Ok _ -> compile_files rest
        | Error (`Msg e) ->
          Logs.debug (fun m -> m "clang++ failed: %s" e);
          Fmt.error_msg
            "clang++ failed: run with -vv if the error is not displayed above" )
    in
    compile_files files
  in

  let* llc_bin = OS.Cmd.resolve @@ Cmd.v "llc" in

  let files_bc =
    Cmd.of_list
    @@ List.map
         (fun file -> Fpath.(workspace // Fpath.base (file -+ ".bc")) |> Cmd.p)
         files
  in

  let llc_cmd : Cmd.t =
    Cmd.(
      llc_bin
      %
      (* TODO: configure this ? *)
      "-O0" % "-march=wasm32" % "-filetype=obj" %% files_bc )
  in

  let* () =
    match OS.Cmd.run ~err llc_cmd with
    | Ok _ as v -> v
    | Error (`Msg e) ->
      Logs.debug (fun m -> m "llc failed: %s" e);
      Fmt.error_msg "llc failed: run with --debug to get the full error message"
  in
  let* wasmld_bin = OS.Cmd.resolve @@ Cmd.v "wasm-ld" in

  let files_o =
    List.map
      (fun file -> Fpath.(workspace // Fpath.base (file -+ ".o")) |> Cmd.p)
      files
  in

  let out =
    Option.value ~default:Fpath.(workspace // v "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
               ] )
           @ files_o
           @ [ p libc; p libowi; "-o"; p out ] ) )
  in

  let+ () =
    match OS.Cmd.run ~err wasmld_cmd with
    | Ok _ as v -> v
    | Error (`Msg e) ->
      Logs.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 ~arch:_ ~opt_lvl ~includes ~files ~concolic
  ~out_file : unit Result.t =
  let* workspace =
    match symbolic_parameters.Cmd_sym.workspace with
    | Some path -> Ok path
    | None -> OS.Dir.tmp "owi_cpp_%s"
  in
  let* _did_create : bool = OS.Dir.create ~path:true workspace in

  let includes = Cmd_utils.c_files_location @ includes in
  let* source_file =
    compile ~workspace ~entry_point:symbolic_parameters.entry_point ~includes
      ~opt_lvl ~out_file files
  in
  let workspace = Some workspace in

  let parameters = { symbolic_parameters with workspace } in

  (if concolic then Cmd_conc.cmd else Cmd_sym.cmd) ~parameters ~source_file