[OCaml] Fix a possible crash in llvm_struct_name

[jberdine]

Summary

The implementation of llvm_struct_name before this diff calls
caml_copy_string, which allocates, while the result local variable
points to a block allocated by caml_alloc_small that has not yet
been initialized. If the allocation in caml_copy_string triggers a
garbage collection, then the GC root result contains a pointer to
uninitialized data, which may crash the GC or lead to a memory
corruption.

This diff fixes this by allocating and initializing the string first
and then allocating and initializing the option, thereby leaving no
dangling pointers when allocations are made.

The conversion from a C string to an OCaml string option is refactored
into a function, cstr_to_string_option. This function is also used
to simplify the definitions of llvm_get_mdstring and
llvm_string_of_const.

[vaivaswatha]

llvm/bindings/ocaml/llvm/llvm_ocaml.c

888–890

Given that the order of argument evaluation is unspecified in C, if the second argument Len to cstr_to_string_option is evaluated first (at which point it is uninitialized), then an incorrect value gets passed.

1046–1047

Same as the previous change.

1046–1047

Would it be a good idea to define a macro #define OCAML_OPTION_NONE Val_Int(0) to use in such places? I'm not saying we should do it in this patch (if you think it's a good idea to do it at all), but may be in a later one that changes it at all places uniformly.

[jberdine]

fix bug spotted in CR, formatting

llvm/bindings/ocaml/llvm/llvm_ocaml.c

888–890

Gah, yes, of course, thanks!

1046–1047

It might help, but I am also slightly concerned that Val_int(0) is the representation of many other OCaml values too, like []. So it would be a leaky abstraction. It seems that choosing to name the macro after None is arbitrary, and potentially confusing.

llvm/bindings/ocaml/llvm/llvm_ocaml.c

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);
+  if (!CStr)
+    CAMLreturn(Val_int(0));
+  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);
+}
+
 void llvm_raise(value Prototype, char *Message) {
   CAMLparam1(Prototype);
   caml_raise_with_arg(Prototype, llvm_string_of_message(Message));
   CAMLnoreturn;
 }
 
 static value llvm_fatal_error_handler;
 
CAMLprim value llvm_struct_set_body(LLVMTypeRef Ty,
                                     value ElementTypes,
                                     value Packed) {
   LLVMStructSetBody(Ty, (LLVMTypeRef *) ElementTypes,
                     Wosize_val(ElementTypes), Bool_val(Packed));
   return Val_unit;
 }
 
 /* lltype -> string option */
-CAMLprim value llvm_struct_name(LLVMTypeRef Ty)
-{
-  CAMLparam0();
-  CAMLlocal1(result);
-  const char *C = LLVMGetStructName(Ty);
-  if (C) {
-    result = caml_alloc_small(1, 0);
-    Store_field(result, 0, caml_copy_string(C));
-    CAMLreturn(result);
-  }
-  CAMLreturn(Val_int(0));
+CAMLprim value llvm_struct_name(LLVMTypeRef Ty) {
+  const char *CStr = LLVMGetStructName(Ty);
+  size_t Len;
+  if (!CStr)
+    return Val_int(0);
+  Len = strlen(CStr);
+  return cstr_to_string_option(CStr, Len);
 }
 
 /* lltype -> lltype array */
 CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) {
   value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0);
   LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys);
   return Tys;
 }

 
 /* llcontext -> llvalue */
 CAMLprim LLVMValueRef llvm_mdnull(LLVMContextRef C) {
   return NULL;
 }
 
 /* llvalue -> string option */
 CAMLprim value llvm_get_mdstring(LLVMValueRef V) {
-  CAMLparam0();
-  CAMLlocal2(Option, Str);
-  const char *S;
-  unsigned Len;
-
-  if ((S = LLVMGetMDString(V, &Len))) {
-    Str = caml_alloc_string(Len);
-    memcpy((char *)String_val(Str), S, Len);
-    Option = alloc(1,0);
-    Store_field(Option, 0, Str);
-    CAMLreturn(Option);
-  }
-  CAMLreturn(Val_int(0));
+  size_t Len;
+  const char *CStr = LLVMGetMDString(V, &Len);
+  return cstr_to_string_option(CStr, Len);
 }
 
 CAMLprim value llvm_get_mdnode_operands(LLVMValueRef V) {
   CAMLparam0();
   CAMLlocal1(Operands);
   unsigned int n;
 
   n = LLVMGetMDNodeNumOperands(V);

 /* llvalue array -> llvalue */
 CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) {
   return LLVMConstVector((LLVMValueRef*) Op_val(ElementVals),
                          Wosize_val(ElementVals));
 }
 
 /* llvalue -> string option */
 CAMLprim value llvm_string_of_const(LLVMValueRef Const) {
-  const char *S;
   size_t Len;
-  CAMLparam0();
-  CAMLlocal2(Option, Str);
-
-  if(LLVMIsAConstantDataSequential(Const) && LLVMIsConstantString(Const)) {
-    S = LLVMGetAsString(Const, &Len);
-    Str = caml_alloc_string(Len);
-    memcpy((char *)String_val(Str), S, Len);
-
-    Option = alloc(1, 0);
-    Field(Option, 0) = Str;
-    CAMLreturn(Option);
-  } else {
-    CAMLreturn(Val_int(0));
-  }
+  const char *CStr;
+  if (!LLVMIsAConstantDataSequential(Const) || !LLVMIsConstantString(Const))
+    return Val_int(0);
+  CStr = LLVMGetAsString(Const, &Len);
+  return cstr_to_string_option(CStr, Len);
 }
 
 /* llvalue -> int -> llvalue */
 CAMLprim LLVMValueRef llvm_const_element(LLVMValueRef Const, value N) {
   return LLVMGetElementAsConstant(Const, Int_val(N));
 }
 
 /*--... Constant expressions ...............................................--*/