[OCaml] Initialize local roots prior to raising.
[oota-llvm.git] / bindings / ocaml / llvm / llvm_ocaml.c
index 7f762e0ce03d0c7e32465f7e3ae68e2d2a290a5b..d8682880033b1880b8b4e1de6e7a8f4cea351716 100644 (file)
 #include "caml/fail.h"
 #include "caml/callback.h"
 
-static void llvm_raise(value Prototype, char *Message) {
-  CAMLparam1(Prototype);
-  CAMLlocal1(CamlMessage);
-
-  CamlMessage = copy_string(Message);
+value llvm_string_of_message(char* Message) {
+  value String = caml_copy_string(Message);
   LLVMDisposeMessage(Message);
 
-  raise_with_arg(Prototype, CamlMessage);
+  return String;
+}
+
+void llvm_raise(value Prototype, char *Message) {
+  CAMLparam1(Prototype);
+  raise_with_arg(Prototype, llvm_string_of_message(Message));
   CAMLnoreturn;
 }
 
@@ -60,6 +62,17 @@ CAMLprim value llvm_enable_pretty_stacktrace(value Unit) {
   return Val_unit;
 }
 
+CAMLprim value llvm_parse_command_line_options(value Overview, value Args) {
+  char *COverview;
+  if (Overview == Val_int(0)) {
+    COverview = NULL;
+  } else {
+    COverview = String_val(Field(Overview, 0));
+  }
+  LLVMParseCommandLineOptions(Wosize_val(Args), (const char* const*) Op_val(Args), COverview);
+  return Val_unit;
+}
+
 static value alloc_variant(int tag, void *Value) {
   value Iter = alloc_small(1, tag);
   Field(Iter, 0) = Val_op(Value);
@@ -944,6 +957,17 @@ CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) {
   return Val_unit;
 }
 
+/* llvalue -> DLLStorageClass.t */
+CAMLprim value llvm_dll_storage_class(LLVMValueRef Global) {
+  return Val_int(LLVMGetDLLStorageClass(Global));
+}
+
+/* DLLStorageClass.t -> llvalue -> unit */
+CAMLprim value llvm_set_dll_storage_class(value Viz, LLVMValueRef Global) {
+  LLVMSetDLLStorageClass(Global, Int_val(Viz));
+  return Val_unit;
+}
+
 /* llvalue -> int */
 CAMLprim value llvm_alignment(LLVMValueRef Global) {
   return Val_int(LLVMGetAlignment(Global));
@@ -1566,11 +1590,12 @@ CAMLprim value llvm_position_builder(value Pos, value B) {
 }
 
 /* llbuilder -> llbasicblock */
-CAMLprim LLVMBasicBlockRef llvm_insertion_block(value B) {
+CAMLprim value llvm_insertion_block(value B) {
+  CAMLparam0();
   LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B));
   if (!InsertBlock)
-    raise_not_found();
-  return InsertBlock;
+    caml_raise_not_found();
+  CAMLreturn((value) InsertBlock);
 }
 
 /* llvalue -> string -> llbuilder -> unit */