[llvm] 5c25ff8 - [OCaml] Fix unsafe uses of Store_field
Josh Berdine via llvm-commits
llvm-commits at lists.llvm.org
Mon Apr 5 02:58:57 PDT 2021
Author: Josh Berdine
Date: 2021-04-05T10:55:07+01:00
New Revision: 5c25ff8739e013fec39bc8c6fc1df16e0e5041ca
URL: https://github.com/llvm/llvm-project/commit/5c25ff8739e013fec39bc8c6fc1df16e0e5041ca
DIFF: https://github.com/llvm/llvm-project/commit/5c25ff8739e013fec39bc8c6fc1df16e0e5041ca.diff
LOG: [OCaml] Fix unsafe uses of Store_field
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.
Differential Revision: https://reviews.llvm.org/D99471
Added:
Modified:
llvm/bindings/ocaml/analysis/CMakeLists.txt
llvm/bindings/ocaml/analysis/analysis_ocaml.c
llvm/bindings/ocaml/llvm/llvm_ocaml.c
llvm/bindings/ocaml/llvm/llvm_ocaml.h
llvm/bindings/ocaml/target/CMakeLists.txt
llvm/bindings/ocaml/target/target_ocaml.c
Removed:
################################################################################
diff --git a/llvm/bindings/ocaml/analysis/CMakeLists.txt b/llvm/bindings/ocaml/analysis/CMakeLists.txt
index 5eb04b66a724f..622ecdfca615e 100644
--- a/llvm/bindings/ocaml/analysis/CMakeLists.txt
+++ b/llvm/bindings/ocaml/analysis/CMakeLists.txt
@@ -2,4 +2,5 @@ add_ocaml_library(llvm_analysis
OCAML llvm_analysis
OCAMLDEP llvm
C analysis_ocaml
+ CFLAGS "-I${CMAKE_CURRENT_SOURCE_DIR}/../llvm"
LLVM Analysis)
diff --git a/llvm/bindings/ocaml/analysis/analysis_ocaml.c b/llvm/bindings/ocaml/analysis/analysis_ocaml.c
index af98e651e3b4a..1db09fa5419c5 100644
--- a/llvm/bindings/ocaml/analysis/analysis_ocaml.c
+++ b/llvm/bindings/ocaml/analysis/analysis_ocaml.c
@@ -20,6 +20,7 @@
#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) {
@@ -30,11 +31,10 @@ CAMLprim value llvm_verify_module(LLVMModuleRef M) {
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);
diff --git a/llvm/bindings/ocaml/llvm/llvm_ocaml.c b/llvm/bindings/ocaml/llvm/llvm_ocaml.c
index 04bc06e65b759..83f27290977b6 100644
--- a/llvm/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/llvm/bindings/ocaml/llvm/llvm_ocaml.c
@@ -24,9 +24,17 @@
#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);
@@ -35,13 +43,9 @@ value llvm_string_of_message(char* Message) {
}
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) {
@@ -58,14 +62,12 @@ CAMLprim value cstr_to_string(const char *Str, mlsize_t Len) {
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) {
@@ -712,7 +714,7 @@ CAMLprim value llvm_classify_value(LLVMValueRef Val) {
}
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)) {
diff --git a/llvm/bindings/ocaml/llvm/llvm_ocaml.h b/llvm/bindings/ocaml/llvm/llvm_ocaml.h
index 1202cc79f2c28..a272cafff680a 100644
--- a/llvm/bindings/ocaml/llvm/llvm_ocaml.h
+++ b/llvm/bindings/ocaml/llvm/llvm_ocaml.h
@@ -20,6 +20,17 @@
#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);
diff --git a/llvm/bindings/ocaml/target/CMakeLists.txt b/llvm/bindings/ocaml/target/CMakeLists.txt
index 6e01a27a200b6..03fd231f7bea3 100644
--- a/llvm/bindings/ocaml/target/CMakeLists.txt
+++ b/llvm/bindings/ocaml/target/CMakeLists.txt
@@ -2,4 +2,5 @@ add_ocaml_library(llvm_target
OCAML llvm_target
OCAMLDEP llvm
C target_ocaml
+ CFLAGS "-I${CMAKE_CURRENT_SOURCE_DIR}/../llvm"
LLVM Target)
diff --git a/llvm/bindings/ocaml/target/target_ocaml.c b/llvm/bindings/ocaml/target/target_ocaml.c
index b19f6337e368c..c120356bc2497 100644
--- a/llvm/bindings/ocaml/target/target_ocaml.c
+++ b/llvm/bindings/ocaml/target/target_ocaml.c
@@ -23,6 +23,7 @@
#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);
@@ -144,16 +145,6 @@ CAMLprim value llvm_datalayout_offset_of_element(LLVMTypeRef Ty, value 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();
@@ -165,17 +156,17 @@ CAMLprim value llvm_target_default_triple(value Unit) {
/* 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 */
More information about the llvm-commits
mailing list