diff --git a/sledge/src/llair/frontend.ml b/sledge/src/llair/frontend.ml index eedff14bd..ae74c27bd 100644 --- a/sledge/src/llair/frontend.ml +++ b/sledge/src/llair/frontend.ml @@ -1395,8 +1395,8 @@ let link_in : Llvm.llcontext -> Llvm.lllinker -> string -> unit = |> [%Trace.retn fun {pf} _ -> pf ""] -let translate : string list -> Llair.t = - fun inputs -> +let translate : lib_fuzzer_harness:bool -> string list -> Llair.t = + fun ~lib_fuzzer_harness inputs -> [%Trace.call fun {pf} -> pf "%a" (List.pp "@ " Format.pp_print_string) inputs] ; @@ -1409,6 +1409,13 @@ let translate : string list -> Llair.t = in Llvm_irreader.parse_ir llcontext model_memorybuffer in + ( if lib_fuzzer_harness then + let lib_fuzzer_memorybuffer = + Llvm.MemoryBuffer.of_string + (Option.value_exn (Model.read "/lib_fuzzer_main.bc")) + in + Llvm_linker.link_modules' llmodule + (Llvm_irreader.parse_ir llcontext lib_fuzzer_memorybuffer) ) ; let link_ctx = Llvm_linker.get_linker llmodule in List.iter inputs ~f:(link_in llcontext link_ctx) ; Llvm_linker.linker_dispose link_ctx ; diff --git a/sledge/src/llair/frontend.mli b/sledge/src/llair/frontend.mli index 4824844ab..ce3fbb63f 100644 --- a/sledge/src/llair/frontend.mli +++ b/sledge/src/llair/frontend.mli @@ -9,6 +9,6 @@ exception Invalid_llvm of string -val translate : string list -> Llair.t +val translate : lib_fuzzer_harness:bool -> string list -> Llair.t (** Translate the compilation units in the named (llvm or bitcode) files to LLAIR. Attempts to raise [Invalid_llvm] when the input is invalid LLVM. *) diff --git a/sledge/src/sledge.ml b/sledge/src/sledge.ml index c76149707..5b4814e08 100644 --- a/sledge/src/sledge.ml +++ b/sledge/src/sledge.ml @@ -88,9 +88,11 @@ let translate = let%map_open output = flag "output-llair" (optional string) ~doc:" write generated LLAIR to " + and lib_fuzzer_harness = + flag "lib-fuzzer" no_arg ~doc:"add a harness for lib fuzzer binaries" in fun bitcode_inputs () -> - let program = Frontend.translate bitcode_inputs in + let program = Frontend.translate ~lib_fuzzer_harness bitcode_inputs in Option.iter ~f:(marshal program) output ; program