-/*===-- llvm_ocaml.c - LLVM Ocaml Glue --------------------------*- C++ -*-===*\
+/*===-- llvm_ocaml.c - LLVM OCaml Glue --------------------------*- C++ -*-===*\
|* *|
|* The LLVM Compiler Infrastructure *|
|* *|
|* *|
|*===----------------------------------------------------------------------===*|
|* *|
-|* This file glues LLVM's ocaml interface to its C interface. These functions *|
+|* 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 *|
#include "caml/memory.h"
#include "caml/fail.h"
#include "caml/callback.h"
-#include "llvm/Config/config.h"
#include <assert.h>
#include <stdlib.h>
#include <string.h>
return LLVMLabelTypeInContext(Context);
}
+CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
+{
+ CAMLparam1(Name);
+ LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name));
+ if (Ty) {
+ value Option = alloc(1, 0);
+ Field(Option, 0) = (value) Ty;
+ CAMLreturn(Option);
+ }
+ CAMLreturn(Val_int(0));
+}
+
/*===-- VALUES ------------------------------------------------------------===*/
/* llvalue -> lltype */
return Val_unit;
}
+/* llvalue -> llvalue -> unit */
+CAMLprim value llvm_replace_all_uses_with(LLVMValueRef OldVal,
+ LLVMValueRef NewVal) {
+ LLVMReplaceAllUsesWith(OldVal, NewVal);
+ return Val_unit;
+}
+
/*--... Operations on users ................................................--*/
/* llvalue -> int -> llvalue */
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);
if (!LLVMIsAInstruction(Inst))
failwith("Not an instruction");
o = LLVMGetInstructionOpcode(Inst);
- assert (o <= LLVMUnwind );
+ assert (o <= LLVMLandingPad);
return Val_int(o);
}
CAMLreturn(Tl);
}
+/* llvalue -> unit */
+CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {
+ LLVMInstructionEraseFromParent(Instruction);
+ return Val_unit;
+}
/*===-- Instruction builders ----------------------------------------------===*/
custom_hash_default,
custom_serialize_default,
custom_deserialize_default
+#ifdef custom_compare_ext_default
+ , custom_compare_ext_default
+#endif
};
static value alloc_builder(LLVMBuilderRef B) {
return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
}
+/* lltype -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name,
+ value B)
+{
+ return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
+}
+
+/* lltype -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty,
+ LLVMValueRef Val,
+ value Name, value B)
+{
+ return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name));
+}
+
+/* llvalue -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B)
+{
+ return LLVMBuildFree(Builder_val(B), P);
+}
+
/* llvalue -> llvalue -> llbasicblock -> unit */
CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
LLVMBasicBlockRef Dest) {
Args[4], Args[5]);
}
+/* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
value NumClauses, value Name,
value B) {
String_val(Name));
}
+/* llvalue -> llvalue -> unit */
+CAMLprim value llvm_add_clause(LLVMValueRef LandingPadInst, LLVMValueRef ClauseVal)
+{
+ LLVMAddClause(LandingPadInst, ClauseVal);
+ return Val_unit;
+}
+
+
+/* llvalue -> bool -> unit */
CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
{
LLVMSetCleanup(LandingPadInst, Bool_val(flag));
return Val_unit;
}
+/* llvalue -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_resume(LLVMValueRef Exn, value B)
+{
+ return LLVMBuildResume(Builder_val(B), Exn);
+}
+
/* llbuilder -> llvalue */
CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
return LLVMBuildUnreachable(Builder_val(B));