+/* Can't use the recommended caml_named_value mechanism for backwards
+ compatibility reasons. This is largely equivalent. */
+static value llvm_ioerror_exn;
+
+CAMLprim value llvm_register_core_exns(value IoError) {
+ llvm_ioerror_exn = Field(IoError, 0);
+ register_global_root(&llvm_ioerror_exn);
+ return Val_unit;
+}
+
+static void llvm_raise(value Prototype, char *Message) {
+ CAMLparam1(Prototype);
+ CAMLlocal1(CamlMessage);
+
+ CamlMessage = copy_string(Message);
+ LLVMDisposeMessage(Message);
+
+ raise_with_arg(Prototype, CamlMessage);
+ abort(); /* NOTREACHED */
+#ifdef CAMLnoreturn
+ CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
+#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)); \
+ }
+
+
+/*===-- Contexts ----------------------------------------------------------===*/
+
+/* unit -> llcontext */
+CAMLprim LLVMContextRef llvm_create_context(value Unit) {
+ return LLVMContextCreate();
+}
+
+/* llcontext -> unit */
+CAMLprim value llvm_dispose_context(LLVMContextRef C) {
+ LLVMContextDispose(C);
+ return Val_unit;
+}
+
+/* unit -> llcontext */
+CAMLprim LLVMContextRef llvm_global_context(value Unit) {
+ return LLVMGetGlobalContext();
+}
+
+/* llcontext -> string -> int */
+CAMLprim value llvm_mdkind_id(LLVMContextRef C, value Name) {
+ unsigned MDKindID = LLVMGetMDKindIDInContext(C, String_val(Name),
+ caml_string_length(Name));
+ return Val_int(MDKindID);
+}
+