[OCaml] Fix unsafe uses of Store_field

[jberdine]

Summary

Using Store_field to initialize fields of blocks allocated with
caml_alloc_small is unsafe. The fields of blocks allocated by
caml_alloc_small are not initialized, and Store_field calls the
OCaml GC write barrier. If the uninitialized value of a field happens
to point into the OCaml heap, then it will e.g. be added to a conflict
set or followed and have what the GC thinks are color bits
changed. This leads to crashes or memory corruption.

This diff fixes a few (I think all) instances of this problem. Some of
these are creating option values. OCaml 4.12 has a dedicated
caml_alloc_some function for this, so this diff adds a compatible
function with a version check to avoid conflict. With that, macros for
accessing option values are also added.

[vaivaswatha]

This fixes a potentially hard-to-discover bug ! The last thing that a user of the OCaml API would think of is "oh this function uses Store_field to initialize fields of blocks allocated with caml_alloc_small and that could lead to a hard to trace GC bug".

Thank you !.

llvm/bindings/ocaml/analysis/CMakeLists.txt

 add_ocaml_library(llvm_analysis
   OCAML    llvm_analysis
   OCAMLDEP llvm
   C        analysis_ocaml
+  CFLAGS   "-I${CMAKE_CURRENT_SOURCE_DIR}/../llvm"
   LLVM     Analysis)

llvm/bindings/ocaml/analysis/analysis_ocaml.c

 |*                                                                            *|
 \*===----------------------------------------------------------------------===*/
 
 #include "llvm-c/Analysis.h"
 #include "llvm-c/Core.h"
 #include "caml/alloc.h"
 #include "caml/mlvalues.h"
 #include "caml/memory.h"
+#include "llvm_ocaml.h"
 
 /* Llvm.llmodule -> string option */
 CAMLprim value llvm_verify_module(LLVMModuleRef M) {
   CAMLparam0();
   CAMLlocal2(String, Option);
 
   char *Message;
   int Result = LLVMVerifyModule(M, LLVMReturnStatusAction, &Message);
 
   if (0 == Result) {
-    Option = Val_int(0);
+    Option = Val_none;
   } else {
-    Option = alloc(1, 0);
     String = copy_string(Message);
-    Store_field(Option, 0, String);
+    Option = caml_alloc_some(String);
   }
 
   LLVMDisposeMessage(Message);
 
   CAMLreturn(Option);
 }
 
 /* Llvm.llvalue -> bool */

llvm/bindings/ocaml/llvm/llvm_ocaml.h

 |*                                                                            *|
 \*===----------------------------------------------------------------------===*/
 
 #ifndef LLVM_LLVM_OCAML_H
 #define LLVM_LLVM_OCAML_H
 
 #include "caml/alloc.h"
 #include "caml/custom.h"
+#include "caml/version.h"
+
+#if OCAML_VERSION < 41200
+/* operations on OCaml option values, defined by OCaml 4.12 */
+#define Val_none Val_int(0)
+#define Some_val(v) Field(v, 0)
+#define Tag_some 0
+#define Is_none(v) ((v) == Val_none)
+#define Is_some(v) Is_block(v)
+value caml_alloc_some(value);
+#endif
 
 /* Convert a C pointer to an OCaml option */
 CAMLprim value ptr_to_option(void *Ptr);
 
 /* Convert a C string into an OCaml string */
 CAMLprim value cstr_to_string(const char *Str, mlsize_t Len);
 
 #endif // LLVM_LLVM_OCAML_H

llvm/bindings/ocaml/llvm/llvm_ocaml.c

 #include <stdlib.h>
 #include <string.h>
 #include "llvm-c/Core.h"
 #include "llvm-c/Support.h"
 #include "llvm/Config/llvm-config.h"
 #include "caml/memory.h"
 #include "caml/fail.h"
 #include "caml/callback.h"
-
 #include "llvm_ocaml.h"
 
+#if OCAML_VERSION < 41200
+value caml_alloc_some(value v) {
+  CAMLparam1(v);
+  value Some = caml_alloc_small(1, 0);
+  Field(Some, 0) = v;
+  CAMLreturn(Some);
+}
+#endif
+
 value llvm_string_of_message(char* Message) {
   value String = caml_copy_string(Message);
   LLVMDisposeMessage(Message);
 
   return String;
 }
 
 CAMLprim value ptr_to_option(void *Ptr) {
-  CAMLparam0();
-  CAMLlocal1(Option);
   if (!Ptr)
-    CAMLreturn(Val_int(0));
-  Option = caml_alloc_small(1, 0);
-  Store_field(Option, 0, (value)Ptr);
-  CAMLreturn(Option);
+    return Val_none;
+  return caml_alloc_some((value)Ptr);
 }
 
 CAMLprim value cstr_to_string(const char *Str, mlsize_t Len) {
   CAMLparam0();
   CAMLlocal1(String);
   if (Str) {
     String = caml_alloc_string(Len);
     memcpy((char *)String_val(String), Str, Len);
   } else {
     String = caml_alloc_string(0);
   }
   CAMLreturn(String);
 }
 
 CAMLprim value cstr_to_string_option(const char *CStr, mlsize_t Len) {
   CAMLparam0();
-  CAMLlocal2(Option, String);
+  CAMLlocal1(String);
   if (!CStr)
-    CAMLreturn(Val_int(0));
+    CAMLreturn(Val_none);
   String = caml_alloc_string(Len);
   memcpy((char *)String_val(String), CStr, Len);
-  Option = caml_alloc_small(1, 0);
-  Store_field(Option, 0, (value)String);
-  CAMLreturn(Option);
+  return caml_alloc_some(String);
 }
 
 void llvm_raise(value Prototype, char *Message) {
   CAMLparam1(Prototype);
   caml_raise_with_arg(Prototype, llvm_string_of_message(Message));
   CAMLnoreturn;
 }
 
if (LLVMIsAConstant(Val)) {
     DEFINE_CASE(Val, ConstantFP);
     DEFINE_CASE(Val, ConstantInt);
     DEFINE_CASE(Val, ConstantPointerNull);
     DEFINE_CASE(Val, ConstantStruct);
     DEFINE_CASE(Val, ConstantVector);
   }
   if (LLVMIsAInstruction(Val)) {
     result = caml_alloc_small(1, 0);
-    Store_field(result, 0, Val_int(LLVMGetInstructionOpcode(Val)));
+    Field(result, 0) = Val_int(LLVMGetInstructionOpcode(Val));
     CAMLreturn(result);
   }
   if (LLVMIsAGlobalValue(Val)) {
     DEFINE_CASE(Val, Function);
     DEFINE_CASE(Val, GlobalAlias);
     DEFINE_CASE(Val, GlobalIFunc);
     DEFINE_CASE(Val, GlobalVariable);
   }

llvm/bindings/ocaml/target/CMakeLists.txt

 add_ocaml_library(llvm_target
   OCAML    llvm_target
   OCAMLDEP llvm
   C        target_ocaml
+  CFLAGS   "-I${CMAKE_CURRENT_SOURCE_DIR}/../llvm"
   LLVM     Target)

llvm/bindings/ocaml/target/target_ocaml.c

 #include "llvm-c/Core.h"
 #include "llvm-c/Target.h"
 #include "llvm-c/TargetMachine.h"
 #include "caml/alloc.h"
 #include "caml/fail.h"
 #include "caml/memory.h"
 #include "caml/custom.h"
 #include "caml/callback.h"
+#include "llvm_ocaml.h"
 
 void llvm_raise(value Prototype, char *Message);
 value llvm_string_of_message(char* Message);
 
 /*===---- Data Layout -----------------------------------------------------===*/
 
 #define DataLayout_val(v)  (*(LLVMTargetDataRef *)(Data_custom_val(v)))
 

 CAMLprim value llvm_datalayout_offset_of_element(LLVMTypeRef Ty, value Index,
                                                  value DL) {
   return caml_copy_int64(LLVMOffsetOfElement(DataLayout_val(DL), Ty,
                                              Int_val(Index)));
 }
 
 /*===---- Target ----------------------------------------------------------===*/
 
-static value llvm_target_option(LLVMTargetRef Target) {
-  if(Target != NULL) {
-    value Result = caml_alloc_small(1, 0);
-    Store_field(Result, 0, (value) Target);
-    return Result;
-  }
-
-  return Val_int(0);
-}
-
 /* unit -> string */
 CAMLprim value llvm_target_default_triple(value Unit) {
   char *TripleCStr = LLVMGetDefaultTargetTriple();
   value TripleStr = caml_copy_string(TripleCStr);
   LLVMDisposeMessage(TripleCStr);
 
   return TripleStr;
 }
 
 /* unit -> Target.t option */
 CAMLprim value llvm_target_first(value Unit) {
-  return llvm_target_option(LLVMGetFirstTarget());
+  return ptr_to_option(LLVMGetFirstTarget());
 }
 
 /* Target.t -> Target.t option */
 CAMLprim value llvm_target_succ(LLVMTargetRef Target) {
-  return llvm_target_option(LLVMGetNextTarget(Target));
+  return ptr_to_option(LLVMGetNextTarget(Target));
 }
 
 /* string -> Target.t option */
 CAMLprim value llvm_target_by_name(value Name) {
-  return llvm_target_option(LLVMGetTargetFromName(String_val(Name)));
+  return ptr_to_option(LLVMGetTargetFromName(String_val(Name)));
 }
 
 /* string -> Target.t */
 CAMLprim LLVMTargetRef llvm_target_by_triple(value Triple) {
   LLVMTargetRef T;
   char *Error;
 
   if(LLVMGetTargetFromTriple(String_val(Triple), &T, &Error))