-/*===-- llvm_ocaml.h - LLVM Ocaml Glue --------------------------*- C++ -*-===*\
+/*===-- llvm_ocaml.c - LLVM Ocaml Glue --------------------------*- C++ -*-===*\
|* *|
|* The LLVM Compiler Infrastructure *|
|* *|
#endif
}
+static value alloc_variant(int tag, void *Value) {
+ value Iter = alloc_small(1, tag);
+ Field(Iter, 0) = Val_op(Value);
+ return Iter;
+}
+
+/* Macro to convert the C first/next/last/prev idiom to the Ocaml llpos/
+ llrev_pos idiom. */
+#define DEFINE_ITERATORS(camlname, cname, pty, cty, pfun) \
+ /* llmodule -> ('a, 'b) llpos */ \
+ CAMLprim value llvm_##camlname##_begin(pty Mom) { \
+ cty First = LLVMGetFirst##cname(Mom); \
+ if (First) \
+ return alloc_variant(1, First); \
+ return alloc_variant(0, Mom); \
+ } \
+ \
+ /* llvalue -> ('a, 'b) llpos */ \
+ CAMLprim value llvm_##camlname##_succ(cty Kid) { \
+ cty Next = LLVMGetNext##cname(Kid); \
+ if (Next) \
+ return alloc_variant(1, Next); \
+ return alloc_variant(0, pfun(Kid)); \
+ } \
+ \
+ /* llmodule -> ('a, 'b) llrev_pos */ \
+ CAMLprim value llvm_##camlname##_end(pty Mom) { \
+ cty Last = LLVMGetLast##cname(Mom); \
+ if (Last) \
+ return alloc_variant(1, Last); \
+ return alloc_variant(0, Mom); \
+ } \
+ \
+ /* llvalue -> ('a, 'b) llrev_pos */ \
+ CAMLprim value llvm_##camlname##_pred(cty Kid) { \
+ cty Prev = LLVMGetPrevious##cname(Kid); \
+ if (Prev) \
+ return alloc_variant(1, Prev); \
+ return alloc_variant(0, pfun(Kid)); \
+ }
+
/*===-- Modules -----------------------------------------------------------===*/
return Val_unit;
}
+/* llmodule -> unit */
+CAMLprim value llvm_dump_module(LLVMModuleRef M) {
+ LLVMDumpModule(M);
+ return Val_unit;
+}
+
/*===-- Types -------------------------------------------------------------===*/
}
CAMLprim value llvm_refine_type(LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy){
- LLVMRefineAbstractType(AbstractTy, ConcreteTy);
+ LLVMRefineType(AbstractTy, ConcreteTy);
return Val_unit;
}
/*--... Operations on global variables .....................................--*/
+DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef,
+ LLVMGetGlobalParent)
+
/* lltype -> string -> llmodule -> llvalue */
CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name,
LLVMModuleRef M) {
/*--... Operations on functions ............................................--*/
+DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef,
+ LLVMGetGlobalParent)
+
/* string -> lltype -> llmodule -> llvalue */
CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty,
LLVMModuleRef M) {
return Val_unit;
}
-/* llvalue -> int -> llvalue */
-CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
- return LLVMGetParam(Fn, Int_val(Index));
-}
-
-/* llvalue -> int -> llvalue */
-CAMLprim value llvm_params(LLVMValueRef Fn, value Index) {
- value Params = alloc(LLVMCountParams(Fn), 0);
- LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
- return Params;
-}
-
/* llvalue -> bool */
CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) {
return Val_bool(LLVMGetIntrinsicID(Fn));
}
/* llvalue -> string option */
-CAMLprim value llvm_collector(LLVMValueRef Fn) {
- const char *Collector;
+CAMLprim value llvm_gc(LLVMValueRef Fn) {
+ const char *GC;
CAMLparam0();
CAMLlocal2(Name, Option);
- if ((Collector = LLVMGetCollector(Fn))) {
- Name = copy_string(Collector);
+ if ((GC = LLVMGetGC(Fn))) {
+ Name = copy_string(GC);
Option = alloc(1, 0);
Field(Option, 0) = Name;
}
/* string option -> llvalue -> unit */
-CAMLprim value llvm_set_collector(value GC, LLVMValueRef Fn) {
- LLVMSetCollector(Fn, GC == Val_int(0)? 0 : String_val(Field(GC, 0)));
+CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
+ LLVMSetGC(Fn, GC == Val_int(0)? 0 : String_val(Field(GC, 0)));
+ return Val_unit;
+}
+
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
+ LLVMAddFunctionAttr(Arg, 1<<Int_val(PA));
+ return Val_unit;
+}
+
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
+ LLVMRemoveFunctionAttr(Arg, 1<<Int_val(PA));
+ return Val_unit;
+}
+/*--... Operations on parameters ...........................................--*/
+
+DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent)
+
+/* llvalue -> int -> llvalue */
+CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
+ return LLVMGetParam(Fn, Int_val(Index));
+}
+
+/* llvalue -> int -> llvalue */
+CAMLprim value llvm_params(LLVMValueRef Fn, value Index) {
+ value Params = alloc(LLVMCountParams(Fn), 0);
+ LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
+ return Params;
+}
+
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
+ LLVMAddAttribute(Arg, 1<<Int_val(PA));
+ return Val_unit;
+}
+
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
+ LLVMRemoveAttribute(Arg, 1<<Int_val(PA));
+ return Val_unit;
+}
+
+/* llvalue -> int -> unit */
+CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
+ LLVMSetParamAlignment(Arg, Int_val(align));
return Val_unit;
}
/*--... Operations on basic blocks .........................................--*/
+DEFINE_ITERATORS(
+ block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
+
/* llvalue -> llbasicblock array */
CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
return Val_bool(LLVMValueIsBasicBlock(Val));
}
+/*--... Operations on instructions .........................................--*/
+
+DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
+ LLVMGetInstructionParent)
+
+
/*--... Operations on call sites ...........................................--*/
/* llvalue -> int */
return Val_unit;
}
+/* llvalue -> int -> Attribute.t -> unit */
+CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
+ value index,
+ value PA) {
+ LLVMAddInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
+ return Val_unit;
+}
+
+/* llvalue -> int -> Attribute.t -> unit */
+CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
+ value index,
+ value PA) {
+ LLVMRemoveInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
+ return Val_unit;
+}
+
+/*--... Operations on call instructions (only) .............................--*/
+
+/* llvalue -> bool */
+CAMLprim value llvm_is_tail_call(LLVMValueRef CallInst) {
+ return Val_bool(LLVMIsTailCall(CallInst));
+}
+
+/* bool -> llvalue -> unit */
+CAMLprim value llvm_set_tail_call(value IsTailCall,
+ LLVMValueRef CallInst) {
+ LLVMSetTailCall(CallInst, Bool_val(IsTailCall));
+ return Val_unit;
+}
+
/*--... Operations on phi nodes ............................................--*/
/* (llvalue * llbasicblock) -> llvalue -> unit */
}
static struct custom_operations builder_ops = {
- (char *) "LLVMBuilder",
+ (char *) "IRBuilder",
llvm_finalize_builder,
custom_compare_default,
custom_hash_default,
return alloc_builder(LLVMCreateBuilder());
}
-/* llvalue -> llbuilder */
-CAMLprim value llvm_builder_before(LLVMValueRef Inst) {
- LLVMBuilderRef B = LLVMCreateBuilder();
- LLVMPositionBuilderBefore(B, Inst);
- return alloc_builder(B);
-}
-
-/* llbasicblock -> llbuilder */
-CAMLprim value llvm_builder_at_end(LLVMBasicBlockRef BB) {
- LLVMBuilderRef B = LLVMCreateBuilder();
- LLVMPositionBuilderAtEnd(B, BB);
- return alloc_builder(B);
-}
-
-/* llvalue -> llbuilder -> unit */
-CAMLprim value llvm_position_before(LLVMValueRef Inst, value B) {
- LLVMPositionBuilderBefore(Builder_val(B), Inst);
+/* (llbasicblock, llvalue) llpos -> llbuilder -> unit */
+CAMLprim value llvm_position_builder(value Pos, value B) {
+ if (Tag_val(Pos) == 0) {
+ LLVMBasicBlockRef BB = (LLVMBasicBlockRef) Op_val(Field(Pos, 0));
+ LLVMPositionBuilderAtEnd(Builder_val(B), BB);
+ } else {
+ LLVMValueRef I = (LLVMValueRef) Op_val(Field(Pos, 0));
+ LLVMPositionBuilderBefore(Builder_val(B), I);
+ }
return Val_unit;
}
-/* llbasicblock -> llbuilder -> unit */
-CAMLprim value llvm_position_at_end(LLVMBasicBlockRef BB, value B) {
- LLVMPositionBuilderAtEnd(Builder_val(B), BB);
- return Val_unit;
+/* llbuilder -> llbasicblock */
+CAMLprim LLVMBasicBlockRef llvm_insertion_block(LLVMBuilderRef B) {
+ LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B));
+ if (!InsertBlock)
+ raise_not_found();
+ return InsertBlock;
}
/*--... Terminators ........................................................--*/
return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
}
+CAMLprim value llvm_add_case(LLVMValueRef Switch,
+ LLVMValueRef OnVal,
+ LLVMBasicBlockRef Dest) {
+ LLVMAddCase(Switch, OnVal, Dest);
+ return Val_unit;
+}
+
/* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args,
return LLVMBuildAdd(Builder_val(B), LHS, RHS, String_val(Name));
}
+/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_nsw_add(LLVMValueRef LHS, LLVMValueRef RHS,
+ value Name, value B) {
+ return LLVMBuildNSWAdd(Builder_val(B), LHS, RHS, String_val(Name));
+}
+
+/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_fadd(LLVMValueRef LHS, LLVMValueRef RHS,
+ value Name, value B) {
+ return LLVMBuildFAdd(Builder_val(B), LHS, RHS, String_val(Name));
+}
+
/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS,
value Name, value B) {
return LLVMBuildSub(Builder_val(B), LHS, RHS, String_val(Name));
}
+/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_fsub(LLVMValueRef LHS, LLVMValueRef RHS,
+ value Name, value B) {
+ return LLVMBuildFSub(Builder_val(B), LHS, RHS, String_val(Name));
+}
+
/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS,
value Name, value B) {
return LLVMBuildMul(Builder_val(B), LHS, RHS, String_val(Name));
}
+/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_fmul(LLVMValueRef LHS, LLVMValueRef RHS,
+ value Name, value B) {
+ return LLVMBuildFMul(Builder_val(B), LHS, RHS, String_val(Name));
+}
+
/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_udiv(LLVMValueRef LHS, LLVMValueRef RHS,
value Name, value B) {
return LLVMBuildSDiv(Builder_val(B), LHS, RHS, String_val(Name));
}
+/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_exact_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
+ value Name, value B) {
+ return LLVMBuildExactSDiv(Builder_val(B), LHS, RHS, String_val(Name));
+}
+
/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_fdiv(LLVMValueRef LHS, LLVMValueRef RHS,
value Name, value B) {
String_val(Name));
}
+/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_in_bounds_gep(LLVMValueRef Pointer,
+ value Indices, value Name,
+ value B) {
+ return LLVMBuildInBoundsGEP(Builder_val(B), Pointer,
+ (LLVMValueRef *) Op_val(Indices),
+ Wosize_val(Indices), String_val(Name));
+}
+
+/* llvalue -> int -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_struct_gep(LLVMValueRef Pointer,
+ value Indices, value Name,
+ value B) {
+ return LLVMBuildInBoundsGEP(Builder_val(B), Pointer,
+ (LLVMValueRef *) Op_val(Indices),
+ Wosize_val(Indices), String_val(Name));
+}
+
+/* string -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_global_string(value Str, value Name, value B) {
+ return LLVMBuildGlobalString(Builder_val(B), String_val(Str),
+ String_val(Name));
+}
+
+/* string -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_global_stringptr(value Str, value Name,
+ value B) {
+ return LLVMBuildGlobalStringPtr(Builder_val(B), String_val(Str),
+ String_val(Name));
+}
+
/*--... Casts ..............................................................--*/
/* llvalue -> lltype -> string -> llbuilder -> llvalue */
return LLVMBuildBitCast(Builder_val(B), X, Ty, String_val(Name));
}
+/* llvalue -> lltype -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_zext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
+ value Name, value B) {
+ return LLVMBuildZExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
+}
+
+/* llvalue -> lltype -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_sext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
+ value Name, value B) {
+ return LLVMBuildSExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
+}
+
+/* llvalue -> lltype -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_trunc_or_bitcast(LLVMValueRef X,
+ LLVMTypeRef Ty, value Name,
+ value B) {
+ return LLVMBuildTruncOrBitCast(Builder_val(B), X, Ty, String_val(Name));
+}
+
+/* llvalue -> lltype -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_pointercast(LLVMValueRef X, LLVMTypeRef Ty,
+ value Name, value B) {
+ return LLVMBuildPointerCast(Builder_val(B), X, Ty, String_val(Name));
+}
+
+/* llvalue -> lltype -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_intcast(LLVMValueRef X, LLVMTypeRef Ty,
+ value Name, value B) {
+ return LLVMBuildIntCast(Builder_val(B), X, Ty, String_val(Name));
+}
+
+/* llvalue -> lltype -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_fpcast(LLVMValueRef X, LLVMTypeRef Ty,
+ value Name, value B) {
+ return LLVMBuildFPCast(Builder_val(B), X, Ty, String_val(Name));
+}
+
/*--... Comparisons ........................................................--*/
/* Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
return LLVMBuildShuffleVector(Builder_val(B), V1, V2, Mask, String_val(Name));
}
+/* llvalue -> int -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_extractvalue(LLVMValueRef Aggregate,
+ value Idx, value Name, value B) {
+ return LLVMBuildExtractValue(Builder_val(B), Aggregate, Int_val(Idx),
+ String_val(Name));
+}
+
+/* llvalue -> llvalue -> int -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_insertvalue(LLVMValueRef Aggregate,
+ LLVMValueRef Val, value Idx,
+ value Name, value B) {
+ return LLVMBuildInsertValue(Builder_val(B), Aggregate, Val, Int_val(Idx),
+ String_val(Name));
+}
+
+/* llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_is_null(LLVMValueRef Val, value Name,
+ value B) {
+ return LLVMBuildIsNull(Builder_val(B), Val, String_val(Name));
+}
+
+/* llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_is_not_null(LLVMValueRef Val, value Name,
+ value B) {
+ return LLVMBuildIsNotNull(Builder_val(B), Val, String_val(Name));
+}
+
+/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS,
+ value Name, value B) {
+ return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name));
+}
/*===-- Module Providers --------------------------------------------------===*/
return Val_unit;
}
+/*===-- Pass Managers -----------------------------------------------------===*/
+
+/* unit -> [ `Module ] PassManager.t */
+CAMLprim LLVMPassManagerRef llvm_passmanager_create(value Unit) {
+ return LLVMCreatePassManager();
+}
+
+/* llmodule -> [ `Function ] PassManager.t -> bool */
+CAMLprim value llvm_passmanager_run_module(LLVMModuleRef M,
+ LLVMPassManagerRef PM) {
+ return Val_bool(LLVMRunPassManager(PM, M));
+}
+
+/* [ `Function ] PassManager.t -> bool */
+CAMLprim value llvm_passmanager_initialize(LLVMPassManagerRef FPM) {
+ return Val_bool(LLVMInitializeFunctionPassManager(FPM));
+}
+
+/* llvalue -> [ `Function ] PassManager.t -> bool */
+CAMLprim value llvm_passmanager_run_function(LLVMValueRef F,
+ LLVMPassManagerRef FPM) {
+ return Val_bool(LLVMRunFunctionPassManager(FPM, F));
+}
+
+/* [ `Function ] PassManager.t -> bool */
+CAMLprim value llvm_passmanager_finalize(LLVMPassManagerRef FPM) {
+ return Val_bool(LLVMFinalizeFunctionPassManager(FPM));
+}
+
+/* PassManager.any PassManager.t -> unit */
+CAMLprim value llvm_passmanager_dispose(LLVMPassManagerRef PM) {
+ LLVMDisposePassManager(PM);
+ return Val_unit;
+}
projects / oota-llvm.git / blobdiff