X-Git-Url: http://plrg.eecs.uci.edu/git/?a=blobdiff_plain;f=bindings%2Focaml%2Fllvm%2Fllvm_ocaml.c;h=610380ca69eb32f239191d5c9ff9d02cc7926ecb;hb=e0f8bf6cbe1bee904021a8ae45008e3703dde283;hp=c966091ccbb74755d6e3f86024b7ef6939f38543;hpb=dc1ce7bdc6e32e7a4c4a110caa32834730183c1b;p=oota-llvm.git diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index c966091ccbb..610380ca69e 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -50,6 +50,47 @@ static void llvm_raise(value Prototype, char *Message) { #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 -----------------------------------------------------------===*/ @@ -288,7 +329,7 @@ CAMLprim LLVMTypeRef llvm_type_of_handle(value TH) { } CAMLprim value llvm_refine_type(LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy){ - LLVMRefineAbstractType(AbstractTy, ConcreteTy); + LLVMRefineType(AbstractTy, ConcreteTy); return Val_unit; } @@ -464,6 +505,9 @@ CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) { /*--... 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) { @@ -541,6 +585,9 @@ CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) { /*--... 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) { @@ -579,18 +626,6 @@ CAMLprim value llvm_delete_function(LLVMValueRef Fn) { 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)); @@ -608,13 +643,13 @@ CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef 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; @@ -625,13 +660,61 @@ CAMLprim value llvm_collector(LLVMValueRef Fn) { } /* 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< Attribute.t -> unit */ +CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) { + LLVMRemoveFunctionAttr(Arg, 1< 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< Attribute.t -> unit */ +CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) { + LLVMRemoveAttribute(Arg, 1< 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); @@ -660,6 +743,12 @@ CAMLprim value llvm_value_is_block(LLVMValueRef Val) { return Val_bool(LLVMValueIsBasicBlock(Val)); } +/*--... Operations on instructions .........................................--*/ + +DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef, + LLVMGetInstructionParent) + + /*--... Operations on call sites ...........................................--*/ /* llvalue -> int */ @@ -673,6 +762,36 @@ CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) { 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 -> Attribute.t -> unit */ +CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr, + value index, + value PA) { + LLVMRemoveInstrAttribute(Instr, Int_val(index), 1< 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 */ @@ -716,7 +835,7 @@ static void llvm_finalize_builder(value B) { } static struct custom_operations builder_ops = { - (char *) "LLVMBuilder", + (char *) "IRBuilder", llvm_finalize_builder, custom_compare_default, custom_hash_default, @@ -735,29 +854,15 @@ CAMLprim value llvm_builder(value Unit) { 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); - return Val_unit; -} - -/* llbasicblock -> llbuilder -> unit */ -CAMLprim value llvm_position_at_end(LLVMBasicBlockRef BB, value B) { - LLVMPositionBuilderAtEnd(Builder_val(B), BB); +/* (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; } @@ -802,6 +907,13 @@ CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of, 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, @@ -839,18 +951,42 @@ CAMLprim LLVMValueRef llvm_build_add(LLVMValueRef LHS, LLVMValueRef RHS, 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) { @@ -863,6 +999,12 @@ CAMLprim LLVMValueRef llvm_build_sdiv(LLVMValueRef LHS, LLVMValueRef RHS, 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) { @@ -986,6 +1128,37 @@ CAMLprim LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices, 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 */ @@ -1060,6 +1233,43 @@ CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty, 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 */ @@ -1144,6 +1354,38 @@ CAMLprim LLVMValueRef llvm_build_shufflevector(LLVMValueRef V1, LLVMValueRef V2, 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 --------------------------------------------------===*/