diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/ipo_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/ipo_ocaml.c index 9fcaa1053..729b54dc6 100644 --- a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/ipo_ocaml.c +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/ipo_ocaml.c @@ -15,9 +15,14 @@ |* *| \*===----------------------------------------------------------------------===*/ +#include +#include "llvm-c/Core.h" #include "llvm-c/Transforms/IPO.h" -#include "caml/mlvalues.h" +#include "caml/alloc.h" +#include "caml/callback.h" +#include "caml/memory.h" #include "caml/misc.h" +#include "caml/mlvalues.h" /* [`Module] Llvm.PassManager.t -> unit */ CAMLprim value llvm_add_argument_promotion(LLVMPassManagerRef PM) { @@ -97,6 +102,33 @@ CAMLprim value llvm_add_internalize(LLVMPassManagerRef PM, value AllButMain) { return Val_unit; } +/* string -> bool */ +static value *predicate_f = NULL; + +LLVMBool MustPreserveCallBack(LLVMValueRef Val, void* Ctx) { + CAMLparam0(); + CAMLlocal1(LLVMValName); + const char *llvmValName; + LLVMBool ret; + assert(predicate_f != NULL + && "llvm_add_internalize_predicate must be called with \ + LLVMInternalizePredicateCallback symbol set"); + + llvmValName = LLVMGetValueName(Val); + LLVMValName = caml_copy_string(llvmValName); + ret = Bool_val(caml_callback(*predicate_f, LLVMValName)); + + CAMLreturnT(LLVMBool, ret); +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_internalize_predicate(LLVMPassManagerRef PM) { + predicate_f = caml_named_value("LLVMInternalizePredicateCallback"); + LLVMAddInternalizePassWithMustPreservePredicate(PM, NULL, + &MustPreserveCallBack); + return Val_unit; +} + /* [`Module] Llvm.PassManager.t -> unit */ CAMLprim value llvm_add_strip_dead_prototypes(LLVMPassManagerRef PM) { LLVMAddStripDeadPrototypesPass(PM); diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.ml index 1fb5594fc..4617b688f 100644 --- a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.ml +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.ml @@ -45,6 +45,17 @@ external add_ipsccp external add_internalize : [ `Module ] Llvm.PassManager.t -> all_but_main:bool -> unit = "llvm_add_internalize" + +external add_internalize_predicate_raw + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_internalize_predicate" + +let add_internalize_predicate + : [ `Module ] Llvm.PassManager.t -> (string -> bool) -> unit = + fun pm predicate -> + Callback.register "LLVMInternalizePredicateCallback" predicate; + add_internalize_predicate_raw pm + external add_strip_dead_prototypes : [ `Module ] Llvm.PassManager.t -> unit = "llvm_add_strip_dead_prototypes" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.mli index 6507c5d92..8d48702a2 100644 --- a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.mli +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.mli @@ -76,6 +76,12 @@ external add_internalize : [ `Module ] Llvm.PassManager.t -> all_but_main:bool -> unit = "llvm_add_internalize" +(** See the [llvm::createInternalizePass] function. + If predicate returns [true], that symbol is preserved. + NOT THREAD SAFE! *) +val add_internalize_predicate + : [ `Module ] Llvm.PassManager.t -> (string -> bool) -> unit + (** See the [llvm::createStripDeadPrototypesPass] function. *) external add_strip_dead_prototypes : [ `Module ] Llvm.PassManager.t -> unit