[OCaml][NPM] Add OCaml bindings to new pass manager

This commit is contained in:
Alan
2023-09-16 16:06:14 -04:00
committed by GitHub
parent 4bf5fdd611
commit 49610edd49
11 changed files with 409 additions and 9 deletions

View File

@@ -61,6 +61,14 @@ package "transform_utils" (
archive(native) = "llvm_transform_utils.cmxa"
)
package "passbuilder" (
requires = "llvm,llvm.target"
version = "@PACKAGE_VERSION@"
description = "Pass Manager Builder for LLVM"
archive(byte) = "llvm_passbuilder.cma"
archive(native) = "llvm_passbuilder.cmxa"
)
package "target" (
requires = "llvm"
version = "@PACKAGE_VERSION@"

View File

@@ -2,5 +2,5 @@ add_ocaml_library(llvm_target
OCAML llvm_target
OCAMLDEP llvm
C target_ocaml
CFLAGS "-I${CMAKE_CURRENT_SOURCE_DIR}/../llvm"
CFLAGS "-I${CMAKE_CURRENT_SOURCE_DIR}/ -I${CMAKE_CURRENT_SOURCE_DIR}/../llvm"
LLVM Target)

View File

@@ -15,15 +15,16 @@
|* *|
\*===----------------------------------------------------------------------===*/
#include "target_ocaml.h"
#include "caml/alloc.h"
#include "caml/callback.h"
#include "caml/custom.h"
#include "caml/fail.h"
#include "caml/memory.h"
#include "llvm_ocaml.h"
#include "llvm-c/Core.h"
#include "llvm-c/Target.h"
#include "llvm-c/TargetMachine.h"
#include "caml/alloc.h"
#include "caml/fail.h"
#include "caml/memory.h"
#include "caml/custom.h"
#include "caml/callback.h"
#include "llvm_ocaml.h"
void llvm_raise(value Prototype, char *Message);
value llvm_string_of_message(char *Message);
@@ -210,8 +211,6 @@ value llvm_target_has_asm_backend(value Target) {
/*===---- Target Machine --------------------------------------------------===*/
#define TargetMachine_val(v) (*(LLVMTargetMachineRef *)(Data_custom_val(v)))
static void llvm_finalize_target_machine(value Machine) {
LLVMDisposeTargetMachine(TargetMachine_val(Machine));
}

View File

@@ -0,0 +1,18 @@
/*===-- target_ocaml.h - LLVM OCaml Glue ------------------------*- C++ -*-===*\
|* *|
|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *|
|* Exceptions. *|
|* See https://llvm.org/LICENSE.txt for license information. *|
|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *|
|* *|
|*===----------------------------------------------------------------------===*|
|* *|
|* This file glues LLVM's OCaml interface to its C interface. These functions *|
|* are by and large transparent wrappers to the corresponding C functions. *|
|* *|
|* Note that these functions intentionally take liberties with the CAMLparamX *|
|* macros, since most of the parameters are not GC heap objects. *|
|* *|
\*===----------------------------------------------------------------------===*/
#define TargetMachine_val(v) (*(LLVMTargetMachineRef *)(Data_custom_val(v)))

View File

@@ -1,2 +1,3 @@
add_subdirectory(passbuilder)
add_subdirectory(utils)

View File

@@ -0,0 +1,6 @@
add_ocaml_library(llvm_passbuilder
OCAML llvm_passbuilder
OCAMLDEP llvm llvm_target
C passbuilder_ocaml
CFLAGS "-I${CMAKE_CURRENT_SOURCE_DIR}/../../llvm -I${CMAKE_CURRENT_SOURCE_DIR}/../../target"
LLVM Passes)

View File

@@ -0,0 +1,71 @@
(*===-- llvm_passbuilder.ml - LLVM OCaml Interface -------------*- OCaml -*-===*
*
* Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
* See https://llvm.org/LICENSE.txt for license information.
* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
*
*===----------------------------------------------------------------------===*)
type llpassbuilder_options
external run_passes
: Llvm.llmodule
-> string
-> Llvm_target.TargetMachine.t
-> llpassbuilder_options
-> (unit, string) result
= "llvm_run_passes"
external create_passbuilder_options : unit -> llpassbuilder_options =
"llvm_create_passbuilder_options"
external passbuilder_options_set_verify_each
: llpassbuilder_options -> bool -> unit =
"llvm_passbuilder_options_set_verify_each"
external passbuilder_options_set_debug_logging
: llpassbuilder_options -> bool -> unit =
"llvm_passbuilder_options_set_debug_logging"
external passbuilder_options_set_loop_interleaving
: llpassbuilder_options -> bool -> unit =
"llvm_passbuilder_options_set_loop_interleaving"
external passbuilder_options_set_loop_vectorization
: llpassbuilder_options -> bool -> unit =
"llvm_passbuilder_options_set_loop_vectorization"
external passbuilder_options_set_slp_vectorization
: llpassbuilder_options -> bool -> unit =
"llvm_passbuilder_options_set_slp_vectorization"
external passbuilder_options_set_loop_unrolling
: llpassbuilder_options -> bool -> unit =
"llvm_passbuilder_options_set_loop_unrolling"
external passbuilder_options_set_forget_all_scev_in_loop_unroll
: llpassbuilder_options -> bool -> unit =
"llvm_passbuilder_options_set_forget_all_scev_in_loop_unroll"
external passbuilder_options_set_licm_mssa_opt_cap
: llpassbuilder_options -> int -> unit =
"llvm_passbuilder_options_set_licm_mssa_opt_cap"
external passbuilder_options_set_licm_mssa_no_acc_for_promotion_cap
: llpassbuilder_options -> int -> unit =
"llvm_passbuilder_options_set_licm_mssa_opt_cap"
external passbuilder_options_set_call_graph_profile
: llpassbuilder_options -> bool -> unit =
"llvm_passbuilder_options_set_call_graph_profile"
external passbuilder_options_set_merge_functions
: llpassbuilder_options -> bool -> unit =
"llvm_passbuilder_options_set_merge_functions"
external passbuilder_options_set_inliner_threshold
: llpassbuilder_options -> int -> unit =
"llvm_passbuilder_options_set_inliner_threshold"
external dispose_passbuilder_options : llpassbuilder_options -> unit =
"llvm_dispose_passbuilder_options"

View File

@@ -0,0 +1,87 @@
(*===-- llvm_passbuilder.mli - LLVM OCaml Interface ------------*- OCaml -*-===*
*
* Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
* See https://llvm.org/LICENSE.txt for license information.
* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
*
*===----------------------------------------------------------------------===*)
type llpassbuilder_options
(** [run_passes m passes tm opts] runs a set of passes over a module. The
format of the string [passes] is the same as opt's -passes argument for
the new pass manager. Individual passes may be specified, separated by
commas. Full pipelines may also be invoked. See [LLVMRunPasses]. *)
val run_passes
: Llvm.llmodule
-> string
-> Llvm_target.TargetMachine.t
-> llpassbuilder_options
-> (unit, string) result
(** Creates a new set of options for a PassBuilder. See
[llvm::LLVMPassBuilderOptions::LLVMPassBuilderOptions]. *)
val create_passbuilder_options : unit -> llpassbuilder_options
(** Toggles adding the VerifierPass for the PassBuilder. See
[llvm::LLVMPassBuilderOptions::VerifyEach]. *)
val passbuilder_options_set_verify_each
: llpassbuilder_options -> bool -> unit
(** Toggles debug logging. See [llvm::LLVMPassBuilderOptions::DebugLogging]. *)
val passbuilder_options_set_debug_logging
: llpassbuilder_options -> bool -> unit
(** Tuning option to set loop interleaving on/off, set based on opt level.
See [llvm::PipelineTuningOptions::LoopInterleaving]. *)
val passbuilder_options_set_loop_interleaving
: llpassbuilder_options -> bool -> unit
(** Tuning option to enable/disable loop vectorization, set based on opt level.
See [llvm::PipelineTuningOptions::LoopVectorization]. *)
val passbuilder_options_set_loop_vectorization
: llpassbuilder_options -> bool -> unit
(** Tuning option to enable/disable slp loop vectorization, set based on opt
level. See [llvm::PipelineTuningOptions::SLPVectorization]. *)
val passbuilder_options_set_slp_vectorization
: llpassbuilder_options -> bool -> unit
(** Tuning option to enable/disable loop unrolling. Its default value is true.
See [llvm::PipelineTuningOptions::LoopUnrolling]. *)
val passbuilder_options_set_loop_unrolling
: llpassbuilder_options -> bool -> unit
(** Tuning option to forget all SCEV loops in LoopUnroll.
See [llvm::PipelineTuningOptions::ForgetAllSCEVInLoopUnroll]. *)
val passbuilder_options_set_forget_all_scev_in_loop_unroll
: llpassbuilder_options -> bool -> unit
(** Tuning option to cap the number of calls to retrive clobbering accesses in
MemorySSA, in LICM. See [llvm::PipelineTuningOptions::LicmMssaOptCap]. *)
val passbuilder_options_set_licm_mssa_opt_cap
: llpassbuilder_options -> int -> unit
(** Tuning option to disable promotion to scalars in LICM with MemorySSA, if
the number of accesses is too large. See
[llvm::PipelineTuningOptions::LicmMssaNoAccForPromotionCap]. *)
val passbuilder_options_set_licm_mssa_no_acc_for_promotion_cap
: llpassbuilder_options -> int -> unit
(** Tuning option to enable/disable call graph profile. See
[llvm::PipelineTuningOptions::CallGraphProfile]. *)
val passbuilder_options_set_call_graph_profile
: llpassbuilder_options -> bool -> unit
(** Tuning option to enable/disable function merging. See
[llvm::PipelineTuningOptions::MergeFunctions]. *)
val passbuilder_options_set_merge_functions
: llpassbuilder_options -> bool -> unit
(** Tuning option to override the default inliner threshold. See
[llvm::PipelineTuningOptions::InlinerThreshold]. *)
val passbuilder_options_set_inliner_threshold
: llpassbuilder_options -> int -> unit
(** Disposes of the options. *)
val dispose_passbuilder_options : llpassbuilder_options -> unit

View File

@@ -0,0 +1,135 @@
/*===-- passbuilder_ocaml.c - LLVM OCaml Glue -------------------*- C++ -*-===*\
|* *|
|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *|
|* Exceptions. *|
|* See https://llvm.org/LICENSE.txt for license information. *|
|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *|
|* *|
|*===----------------------------------------------------------------------===*|
|* *|
|* This file glues LLVM's OCaml interface to its C interface. These functions *|
|* are by and large transparent wrappers to the corresponding C functions. *|
|* *|
|* Note that these functions intentionally take liberties with the CAMLparamX *|
|* macros, since most of the parameters are not GC heap objects. *|
|* *|
\*===----------------------------------------------------------------------===*/
#include "llvm_ocaml.h"
#include "target_ocaml.h"
#include "llvm-c/Error.h"
#include "llvm-c/Transforms/PassBuilder.h"
#include <caml/memory.h>
#define PassBuilderOptions_val(v) ((LLVMPassBuilderOptionsRef)from_val(v))
value llvm_run_passes(value M, value Passes, value TM, value Options) {
LLVMErrorRef Err =
LLVMRunPasses(Module_val(M), String_val(Passes), TargetMachine_val(TM),
PassBuilderOptions_val(Options));
if (Err == LLVMErrorSuccess) {
value result = caml_alloc(1, 0);
Store_field(result, 0, Val_unit);
return result;
} else {
char *str = LLVMGetErrorMessage(Err);
value v = caml_copy_string(str);
LLVMDisposeErrorMessage(str);
value result = caml_alloc(1, 1);
Store_field(result, 0, v);
return result;
}
}
value llvm_create_passbuilder_options(value Unit) {
LLVMPassBuilderOptionsRef PBO = LLVMCreatePassBuilderOptions();
return to_val(PBO);
}
value llvm_passbuilder_options_set_verify_each(value PBO, value VerifyEach) {
LLVMPassBuilderOptionsSetVerifyEach(PassBuilderOptions_val(PBO),
Bool_val(VerifyEach));
return Val_unit;
}
value llvm_passbuilder_options_set_debug_logging(value PBO,
value DebugLogging) {
LLVMPassBuilderOptionsSetDebugLogging(PassBuilderOptions_val(PBO),
Bool_val(DebugLogging));
return Val_unit;
}
value llvm_passbuilder_options_set_loop_interleaving(value PBO,
value LoopInterleaving) {
LLVMPassBuilderOptionsSetLoopInterleaving(PassBuilderOptions_val(PBO),
Bool_val(LoopInterleaving));
return Val_unit;
}
value llvm_passbuilder_options_set_loop_vectorization(value PBO,
value LoopVectorization) {
LLVMPassBuilderOptionsSetLoopVectorization(PassBuilderOptions_val(PBO),
Bool_val(LoopVectorization));
return Val_unit;
}
value llvm_passbuilder_options_set_slp_vectorization(value PBO,
value SLPVectorization) {
LLVMPassBuilderOptionsSetSLPVectorization(PassBuilderOptions_val(PBO),
Bool_val(SLPVectorization));
return Val_unit;
}
value llvm_passbuilder_options_set_loop_unrolling(value PBO,
value LoopUnrolling) {
LLVMPassBuilderOptionsSetLoopUnrolling(PassBuilderOptions_val(PBO),
Bool_val(LoopUnrolling));
return Val_unit;
}
value llvm_passbuilder_options_set_forget_all_scev_in_loop_unroll(
value PBO, value ForgetAllSCEVInLoopUnroll) {
LLVMPassBuilderOptionsSetForgetAllSCEVInLoopUnroll(
PassBuilderOptions_val(PBO), Bool_val(ForgetAllSCEVInLoopUnroll));
return Val_unit;
}
value llvm_passbuilder_options_set_licm_mssa_opt_cap(value PBO,
value LicmMssaOptCap) {
LLVMPassBuilderOptionsSetLicmMssaOptCap(PassBuilderOptions_val(PBO),
Int_val(LicmMssaOptCap));
return Val_unit;
}
value llvm_passbuilder_options_set_licm_mssa_no_acc_for_promotion_cap(
value PBO, value LicmMssaNoAccForPromotionCap) {
LLVMPassBuilderOptionsSetLicmMssaNoAccForPromotionCap(
PassBuilderOptions_val(PBO), Int_val(LicmMssaNoAccForPromotionCap));
return Val_unit;
}
value llvm_passbuilder_options_set_call_graph_profile(value PBO,
value CallGraphProfile) {
LLVMPassBuilderOptionsSetCallGraphProfile(PassBuilderOptions_val(PBO),
Bool_val(CallGraphProfile));
return Val_unit;
}
value llvm_passbuilder_options_set_merge_functions(value PBO,
value MergeFunctions) {
LLVMPassBuilderOptionsSetMergeFunctions(PassBuilderOptions_val(PBO),
Bool_val(MergeFunctions));
return Val_unit;
}
value llvm_passbuilder_options_set_inliner_threshold(value PBO,
value InlinerThreshold) {
LLVMPassBuilderOptionsSetInlinerThreshold(PassBuilderOptions_val(PBO),
Int_val(InlinerThreshold));
return Val_unit;
}
value llvm_dispose_passbuilder_options(value PBO) {
LLVMDisposePassBuilderOptions(PassBuilderOptions_val(PBO));
return Val_unit;
}

View File

@@ -0,0 +1,74 @@
(* RUN: rm -rf %t && mkdir -p %t && cp %s %t/passbuilder.ml
* RUN: %ocamlc -g -w +A -package llvm.passbuilder -package llvm.all_backends -linkpkg %t/passbuilder.ml -o %t/executable
* RUN: %t/executable
* RUN: %ocamlopt -g -w +A -package llvm.passbuilder -package llvm.all_backends -linkpkg %t/passbuilder.ml -o %t/executable
* RUN: %t/executable
* XFAIL: vg_leak
*)
let () = Llvm_all_backends.initialize ()
(*===-- Fixture -----------------------------------------------------------===*)
let context = Llvm.global_context ()
let m = Llvm.create_module context "mymodule"
let () =
let ty =
Llvm.function_type (Llvm.void_type context)
[| Llvm.i1_type context;
Llvm.pointer_type context;
Llvm.pointer_type context |]
in
let foo = Llvm.define_function "foo" ty m in
let entry = Llvm.entry_block foo in
let builder = Llvm.builder_at_end context entry in
ignore
(Llvm.build_store
(Llvm.const_int (Llvm.i8_type context) 42) (Llvm.param foo 1) builder);
let loop = Llvm.append_block context "loop" foo in
Llvm.position_at_end loop builder;
ignore
(Llvm.build_load (Llvm.i8_type context) (Llvm.param foo 2) "tmp1" builder);
ignore (Llvm.build_br loop builder);
let exit = Llvm.append_block context "exit" foo in
Llvm.position_at_end exit builder;
ignore (Llvm.build_ret_void builder);
Llvm.position_at_end entry builder;
ignore (Llvm.build_cond_br (Llvm.param foo 0) loop exit builder)
let target =
Llvm_target.Target.by_triple (Llvm_target.Target.default_triple ())
let machine =
Llvm_target.TargetMachine.create
~triple:(Llvm_target.Target.default_triple ()) target
let options = Llvm_passbuilder.create_passbuilder_options ()
(*===-- PassBuilder -------------------------------------------------------===*)
let () =
Llvm_passbuilder.passbuilder_options_set_verify_each options true;
Llvm_passbuilder.passbuilder_options_set_debug_logging options true;
Llvm_passbuilder.passbuilder_options_set_loop_interleaving options true;
Llvm_passbuilder.passbuilder_options_set_loop_vectorization options true;
Llvm_passbuilder.passbuilder_options_set_slp_vectorization options true;
Llvm_passbuilder.passbuilder_options_set_loop_unrolling options true;
Llvm_passbuilder.passbuilder_options_set_forget_all_scev_in_loop_unroll
options true;
Llvm_passbuilder.passbuilder_options_set_licm_mssa_opt_cap options 2;
Llvm_passbuilder.passbuilder_options_set_licm_mssa_no_acc_for_promotion_cap
options 2;
Llvm_passbuilder.passbuilder_options_set_call_graph_profile options true;
Llvm_passbuilder.passbuilder_options_set_merge_functions options true;
Llvm_passbuilder.passbuilder_options_set_inliner_threshold options 2;
match Llvm_passbuilder.run_passes m "no-op-module" machine options with
| Error e ->
prerr_endline e;
assert false
| Ok () -> ()
let () =
Llvm_passbuilder.dispose_passbuilder_options options;
Llvm.dispose_module m

View File

@@ -209,6 +209,7 @@ if(TARGET ocaml_llvm)
ocaml_llvm_executionengine
ocaml_llvm_irreader
ocaml_llvm_linker
ocaml_llvm_passbuilder
ocaml_llvm_target
ocaml_llvm_transform_utils
)