[OCaml] Migrate from naked pointers to prepare for OCaml 5

The OCaml bindings currently return pointers to LLVM objects as-is to
OCaml. These "naked pointers" end up appearing as values of local
variables in OCaml code, stored as part of other OCaml values,
etc. The safety of this design relies on the OCaml runtime system's
ability to distinguish these pointers from pointers to memory on the
OCaml garbage collected heap. In particular, when the OCaml GC
encounters a pointer to memory known to not be part of the OCaml heap,
it does not follow it.

In OCaml 4.02 an optimized "no naked pointers" mode was introduced
where the runtime system does not perform such checks and requires
that no such naked pointers be passed to OCaml code, instead one of
several encodings needs to be used. In OCaml 5, the no naked pointers
mode is now the only mode. This diff uses one of the potential
encodings to eliminate naked pointers, making the LLVM OCaml bindings
compatible with the "no naked pointers" mode of OCaml >= 4.02 and 5.

The encoding implemented in this diff relies on LLVM objects to be at
least 2-byte aligned, meaning that the lsb of pointers will
necessarily be clear. The encoding sets the lsb when passing LLVM
pointers to OCaml, and clears it on the return path. Setting the lsb
causes the OCaml runtime system to interpret the resulting value as a
tagged integer, which does not participate in garbage collection.

In some cases, particularly functions that receive an OCaml array of
LLVM pointers, this encoding requires allocation of a temporary array,
but otherwise this diff aims to preserve the existing performance
characteristics of the OCaml bindings.

Reviewed By: jberdine

Differential Revision: https://reviews.llvm.org/D136400

llvm/bindings/ocaml/analysis/analysis_ocaml.c

@@ -23,17 +23,18 @@
 #include "llvm_ocaml.h"
 
 /* Llvm.llmodule -> string option */
-value llvm_verify_module(LLVMModuleRef M) {
+value llvm_verify_module(value M) {
   CAMLparam0();
   CAMLlocal2(String, Option);
 
   char *Message;
-  int Result = LLVMVerifyModule(M, LLVMReturnStatusAction, &Message);
+  int Result =
+      LLVMVerifyModule(Module_val(M), LLVMReturnStatusAction, &Message);
 
   if (0 == Result) {
     Option = Val_none;
   } else {
-    String = copy_string(Message);
+    String = caml_copy_string(Message);
     Option = caml_alloc_some(String);
   }
 
@@ -43,30 +44,31 @@ value llvm_verify_module(LLVMModuleRef M) {
 }
 
 /* Llvm.llvalue -> bool */
-value llvm_verify_function(LLVMValueRef Fn) {
-  return Val_bool(LLVMVerifyFunction(Fn, LLVMReturnStatusAction) == 0);
+value llvm_verify_function(value Fn) {
+  return Val_bool(LLVMVerifyFunction(Value_val(Fn), LLVMReturnStatusAction) ==
+                  0);
 }
 
 /* Llvm.llmodule -> unit */
-value llvm_assert_valid_module(LLVMModuleRef M) {
-  LLVMVerifyModule(M, LLVMAbortProcessAction, 0);
+value llvm_assert_valid_module(value M) {
+  LLVMVerifyModule(Module_val(M), LLVMAbortProcessAction, 0);
   return Val_unit;
 }
 
 /* Llvm.llvalue -> unit */
-value llvm_assert_valid_function(LLVMValueRef Fn) {
-  LLVMVerifyFunction(Fn, LLVMAbortProcessAction);
+value llvm_assert_valid_function(value Fn) {
+  LLVMVerifyFunction(Value_val(Fn), LLVMAbortProcessAction);
   return Val_unit;
 }
 
 /* Llvm.llvalue -> unit */
-value llvm_view_function_cfg(LLVMValueRef Fn) {
-  LLVMViewFunctionCFG(Fn);
+value llvm_view_function_cfg(value Fn) {
+  LLVMViewFunctionCFG(Value_val(Fn));
   return Val_unit;
 }
 
 /* Llvm.llvalue -> unit */
-value llvm_view_function_cfg_only(LLVMValueRef Fn) {
-  LLVMViewFunctionCFGOnly(Fn);
+value llvm_view_function_cfg_only(value Fn) {
+  LLVMViewFunctionCFGOnly(Value_val(Fn));
   return Val_unit;
 }

llvm/bindings/ocaml/bitreader/CMakeLists.txt

@@ -2,4 +2,5 @@ add_ocaml_library(llvm_bitreader
   OCAML    llvm_bitreader
   OCAMLDEP llvm
   C        bitreader_ocaml
+  CFLAGS   "-I${CMAKE_CURRENT_SOURCE_DIR}/../llvm"
   LLVM     BitReader)

llvm/bindings/ocaml/bitreader/bitreader_ocaml.c

@@ -12,33 +12,35 @@
 |*                                                                            *|
 \*===----------------------------------------------------------------------===*/
 
-#include "llvm-c/BitReader.h"
-#include "llvm-c/Core.h"
 #include "caml/alloc.h"
+#include "caml/callback.h"
 #include "caml/fail.h"
 #include "caml/memory.h"
-#include "caml/callback.h"
+#include "llvm_ocaml.h"
+#include "llvm-c/BitReader.h"
+#include "llvm-c/Core.h"
 
 void llvm_raise(value Prototype, char *Message);
 
 /* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */
-LLVMModuleRef llvm_get_module(LLVMContextRef C, LLVMMemoryBufferRef MemBuf) {
+value llvm_get_module(value C, value MemBuf) {
   LLVMModuleRef M;
 
-  if (LLVMGetBitcodeModuleInContext2(C, MemBuf, &M))
+  if (LLVMGetBitcodeModuleInContext2(Context_val(C), MemoryBuffer_val(MemBuf),
+                                     &M))
     llvm_raise(*caml_named_value("Llvm_bitreader.Error"),
                LLVMCreateMessage(""));
 
-  return M;
+  return to_val(M);
 }
 
 /* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */
-LLVMModuleRef llvm_parse_bitcode(LLVMContextRef C, LLVMMemoryBufferRef MemBuf) {
+value llvm_parse_bitcode(value C, value MemBuf) {
   LLVMModuleRef M;
 
-  if (LLVMParseBitcodeInContext2(C, MemBuf, &M))
+  if (LLVMParseBitcodeInContext2(Context_val(C), MemoryBuffer_val(MemBuf), &M))
     llvm_raise(*caml_named_value("Llvm_bitreader.Error"),
                LLVMCreateMessage(""));
 
-  return M;
+  return to_val(M);
 }

llvm/bindings/ocaml/bitwriter/CMakeLists.txt

@@ -2,4 +2,6 @@ add_ocaml_library(llvm_bitwriter
   OCAML    llvm_bitwriter
   OCAMLDEP llvm
   C        bitwriter_ocaml
+  CFLAGS   "-I${CMAKE_CURRENT_SOURCE_DIR}/../llvm"
+  PKG      unix
   LLVM     BitWriter)

llvm/bindings/ocaml/bitwriter/bitwriter_ocaml.c

@@ -15,20 +15,21 @@
 |*                                                                            *|
 \*===----------------------------------------------------------------------===*/
 
-#include "llvm-c/BitWriter.h"
-#include "llvm-c/Core.h"
 #include "caml/alloc.h"
-#include "caml/mlvalues.h"
 #include "caml/memory.h"
+#include "caml/mlvalues.h"
+#include "llvm_ocaml.h"
+#include "llvm-c/BitWriter.h"
+#include "llvm-c/Core.h"
 
 /* Llvm.llmodule -> string -> bool */
-value llvm_write_bitcode_file(LLVMModuleRef M, value Path) {
-  int Result = LLVMWriteBitcodeToFile(M, String_val(Path));
+value llvm_write_bitcode_file(value M, value Path) {
+  int Result = LLVMWriteBitcodeToFile(Module_val(M), String_val(Path));
   return Val_bool(Result == 0);
 }
 
 /* ?unbuffered:bool -> Llvm.llmodule -> Unix.file_descr -> bool */
-value llvm_write_bitcode_to_fd(value U, LLVMModuleRef M, value FD) {
+value llvm_write_bitcode_to_fd(value U, value M, value FD) {
   int Unbuffered;
   int Result;
 
@@ -38,11 +39,11 @@ value llvm_write_bitcode_to_fd(value U, LLVMModuleRef M, value FD) {
     Unbuffered = Bool_val(Field(U, 0));
   }
 
-  Result = LLVMWriteBitcodeToFD(M, Int_val(FD), 0, Unbuffered);
+  Result = LLVMWriteBitcodeToFD(Module_val(M), Int_val(FD), 0, Unbuffered);
   return Val_bool(Result == 0);
 }
 
 /* Llvm.llmodule -> Llvm.llmemorybuffer */
-LLVMMemoryBufferRef llvm_write_bitcode_to_memory_buffer(LLVMModuleRef M) {
-  return LLVMWriteBitcodeToMemoryBuffer(M);
+value llvm_write_bitcode_to_memory_buffer(value M) {
+  return to_val(LLVMWriteBitcodeToMemoryBuffer(Module_val(M)));
 }