+/* llvalue -> ThreadLocalMode.t */
+CAMLprim value llvm_thread_local_mode(LLVMValueRef GlobalVar) {
+ return Val_int(LLVMGetThreadLocalMode(GlobalVar));
+}
+
+/* ThreadLocalMode.t -> llvalue -> unit */
+CAMLprim value llvm_set_thread_local_mode(value ThreadLocalMode,
+ LLVMValueRef GlobalVar) {
+ LLVMSetThreadLocalMode(GlobalVar, Int_val(ThreadLocalMode));
+ return Val_unit;
+}
+
+/* llvalue -> bool */
+CAMLprim value llvm_is_externally_initialized(LLVMValueRef GlobalVar) {
+ return Val_bool(LLVMIsExternallyInitialized(GlobalVar));
+}
+
+/* bool -> llvalue -> unit */
+CAMLprim value llvm_set_externally_initialized(value IsExternallyInitialized,
+ LLVMValueRef GlobalVar) {
+ LLVMSetExternallyInitialized(GlobalVar, Bool_val(IsExternallyInitialized));
+ return Val_unit;
+}
+
+/* llvalue -> bool */
+CAMLprim value llvm_is_global_constant(LLVMValueRef GlobalVar) {
+ return Val_bool(LLVMIsGlobalConstant(GlobalVar));
+}
+
+/* bool -> llvalue -> unit */
+CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) {
+ LLVMSetGlobalConstant(GlobalVar, Bool_val(Flag));
+ return Val_unit;
+}
+
+/*--... Operations on aliases ..............................................--*/
+
+CAMLprim LLVMValueRef llvm_add_alias(LLVMModuleRef M, LLVMTypeRef Ty,
+ LLVMValueRef Aliasee, value Name) {
+ return LLVMAddAlias(M, Ty, Aliasee, String_val(Name));
+}
+
+/*--... 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) {
+ LLVMValueRef Fn;
+ if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
+ if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty)
+ return LLVMConstBitCast(Fn, LLVMPointerType(Ty, 0));
+ return Fn;
+ }
+ return LLVMAddFunction(M, String_val(Name), Ty);
+}
+
+/* string -> llmodule -> llvalue option */
+CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) {
+ CAMLparam1(Name);
+ LLVMValueRef Fn;
+ if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
+ value Option = alloc(1, 0);
+ Field(Option, 0) = (value) Fn;
+ CAMLreturn(Option);
+ }
+ CAMLreturn(Val_int(0));
+}
+
+/* string -> lltype -> llmodule -> llvalue */
+CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty,
+ LLVMModuleRef M) {
+ LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty);
+ LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry");
+ return Fn;
+}
+
+/* llvalue -> unit */
+CAMLprim value llvm_delete_function(LLVMValueRef Fn) {
+ LLVMDeleteFunction(Fn);
+ return Val_unit;
+}
+
+/* llvalue -> bool */
+CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) {
+ return Val_bool(LLVMGetIntrinsicID(Fn));
+}
+
+/* llvalue -> int */
+CAMLprim value llvm_function_call_conv(LLVMValueRef Fn) {
+ return Val_int(LLVMGetFunctionCallConv(Fn));
+}
+
+/* int -> llvalue -> unit */
+CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef Fn) {
+ LLVMSetFunctionCallConv(Fn, Int_val(Id));
+ return Val_unit;
+}
+
+/* llvalue -> string option */
+CAMLprim value llvm_gc(LLVMValueRef Fn) {
+ const char *GC;
+ CAMLparam0();
+ CAMLlocal2(Name, Option);
+
+ if ((GC = LLVMGetGC(Fn))) {
+ Name = copy_string(GC);
+
+ Option = alloc(1, 0);
+ Field(Option, 0) = Name;
+ CAMLreturn(Option);
+ } else {
+ CAMLreturn(Val_int(0));
+ }
+}
+
+/* string option -> llvalue -> unit */
+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 -> int32 -> unit */
+CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
+ LLVMAddFunctionAttr(Arg, Int32_val(PA));
+ return Val_unit;
+}
+
+/* llvalue -> string -> string -> unit */
+CAMLprim value llvm_add_target_dependent_function_attr(
+ LLVMValueRef Arg, value A, value V) {
+ LLVMAddTargetDependentFunctionAttr(Arg, String_val(A), String_val(V));
+ return Val_unit;
+}
+
+/* llvalue -> int32 */
+CAMLprim value llvm_function_attr(LLVMValueRef Fn)
+{
+ CAMLparam0();
+ CAMLreturn(caml_copy_int32(LLVMGetFunctionAttr(Fn)));
+}
+
+/* llvalue -> int32 -> unit */
+CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
+ LLVMRemoveFunctionAttr(Arg, Int32_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 */
+CAMLprim value llvm_param_attr(LLVMValueRef Param)
+{
+ CAMLparam0();
+ CAMLreturn(caml_copy_int32(LLVMGetAttribute(Param)));
+}
+
+/* llvalue -> llvalue */
+CAMLprim value llvm_params(LLVMValueRef Fn) {
+ value Params = alloc(LLVMCountParams(Fn), 0);
+ LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
+ return Params;
+}
+
+/* llvalue -> int32 -> unit */
+CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
+ LLVMAddAttribute(Arg, Int32_val(PA));
+ return Val_unit;
+}
+
+/* llvalue -> int32 -> unit */
+CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
+ LLVMRemoveAttribute(Arg, Int32_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)
+
+/* llbasicblock -> llvalue option */
+CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
+{
+ CAMLparam0();
+ LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
+ if (Term) {
+ value Option = alloc(1, 0);
+ Field(Option, 0) = (value) Term;
+ CAMLreturn(Option);
+ }
+ CAMLreturn(Val_int(0));
+}
+
+/* llvalue -> llbasicblock array */
+CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
+ value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
+ LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray));
+ return MLArray;
+}
+
+/* llbasicblock -> unit */
+CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) {
+ LLVMDeleteBasicBlock(BB);
+ return Val_unit;
+}
+
+/* llbasicblock -> unit */
+CAMLprim value llvm_remove_block(LLVMBasicBlockRef BB) {
+ LLVMRemoveBasicBlockFromParent(BB);
+ return Val_unit;
+}
+
+/* llbasicblock -> llbasicblock -> unit */
+CAMLprim value llvm_move_block_before(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
+ LLVMMoveBasicBlockBefore(BB, Pos);
+ return Val_unit;
+}
+
+/* llbasicblock -> llbasicblock -> unit */
+CAMLprim value llvm_move_block_after(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
+ LLVMMoveBasicBlockAfter(BB, Pos);
+ return Val_unit;
+}
+
+/* string -> llvalue -> llbasicblock */
+CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name,
+ LLVMValueRef Fn) {
+ return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name));
+}
+
+/* string -> llbasicblock -> llbasicblock */
+CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name,
+ LLVMBasicBlockRef BB) {
+ return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name));
+}
+
+/* llvalue -> bool */
+CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
+ return Val_bool(LLVMValueIsBasicBlock(Val));
+}
+
+/*--... Operations on instructions .........................................--*/
+
+DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
+ LLVMGetInstructionParent)
+
+/* llvalue -> Opcode.t */
+CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) {
+ LLVMOpcode o;
+ if (!LLVMIsAInstruction(Inst))
+ failwith("Not an instruction");
+ o = LLVMGetInstructionOpcode(Inst);
+ assert (o <= LLVMLandingPad);
+ return Val_int(o);
+}
+
+/* llvalue -> ICmp.t option */
+CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) {
+ CAMLparam0();
+ int x = LLVMGetICmpPredicate(Val);
+ if (x) {
+ value Option = alloc(1, 0);
+ Field(Option, 0) = Val_int(x - LLVMIntEQ);
+ CAMLreturn(Option);
+ }
+ CAMLreturn(Val_int(0));
+}
+
+/* llvalue -> llvalue */
+CAMLprim LLVMValueRef llvm_instr_clone(LLVMValueRef Inst) {
+ if (!LLVMIsAInstruction(Inst))
+ failwith("Not an instruction");
+ return LLVMInstructionClone(Inst);
+}
+
+
+/*--... Operations on call sites ...........................................--*/