[sledge][llvm] Minor optimizations by avoiding double initialization

Summary:
In several functions an OCaml block is allocated and no further OCaml
allocation functions (or other functions that might trigger allocation
or collection) are performed before the block is fully initialized. In
these cases, it is safe and slightly more efficient to allocate an
uninitialized block.

Also, the code does not become more complex after the non-initializing
allocation, since in the case that a non-small allocation is made, the
initial values stored are definitely not pointers to OCaml young
blocks, and so initializing via direct assignment is still safe. That
is, in general if `caml_alloc_small` is called, initializing it with
direct assignments is safe, but if `caml_alloc_shr` is
called (e.g. for a block larger than `Max_young_wosize`), then
`caml_initialize` should be called to inform the GC of a potential
major to minor pointer. But if the initial value is definitely not a
young OCaml block, direct assignment is safe.

Upstream Differential Revision: https://reviews.llvm.org/D99472

Reviewed By: ngorogiannis

Differential Revision: D27564878

fbshipit-source-id: 20cd69e92

sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm_ocaml.c

@@ -36,6 +36,14 @@ value caml_alloc_some(value v) {
 }
 #endif
 
+value caml_alloc_tuple_uninit(mlsize_t wosize) {
+  if (wosize <= Max_young_wosize) {
+    return caml_alloc_small(wosize, 0);
+  } else {
+    return caml_alloc_shr(wosize, 0);
+  }
+}
+
 value llvm_string_of_message(char* Message) {
   value String = caml_copy_string(Message);
   LLVMDisposeMessage(Message);
@@ -509,8 +517,8 @@ CAMLprim value llvm_is_var_arg(LLVMTypeRef FunTy) {
 
 /* lltype -> lltype array */
 CAMLprim value llvm_param_types(LLVMTypeRef FunTy) {
-  value Tys = alloc(LLVMCountParamTypes(FunTy), 0);
+  value Tys = caml_alloc_tuple_uninit(LLVMCountParamTypes(FunTy));
-  LLVMGetParamTypes(FunTy, (LLVMTypeRef *) Tys);
+  LLVMGetParamTypes(FunTy, (LLVMTypeRef *)Op_val(Tys));
   return Tys;
 }
 
@@ -555,8 +563,8 @@ CAMLprim value llvm_struct_name(LLVMTypeRef Ty) {
 
 /* lltype -> lltype array */
 CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) {
-  value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0);
+  value Tys = caml_alloc_tuple_uninit(LLVMCountStructElementTypes(StructTy));
-  LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys);
+  LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *)Op_val(Tys));
   return Tys;
 }
 
@@ -579,16 +587,16 @@ CAMLprim value llvm_is_literal(LLVMTypeRef StructTy) {
 
 /* lltype -> lltype array */
 CAMLprim value llvm_subtypes(LLVMTypeRef Ty) {
-    CAMLparam0();
+  CAMLparam0();
-    CAMLlocal1(Arr);
+  CAMLlocal1(Arr);
 
-    unsigned Size = LLVMGetNumContainedTypes(Ty);
+  unsigned Size = LLVMGetNumContainedTypes(Ty);
 
-    Arr = caml_alloc(Size, 0);
+  Arr = caml_alloc_tuple_uninit(Size);
 
-    LLVMGetSubtypes(Ty, (LLVMTypeRef *) Arr);
+  LLVMGetSubtypes(Ty, (LLVMTypeRef *)Op_val(Arr));
 
-    CAMLreturn(Arr);
+  CAMLreturn(Arr);
 }
 
 /* lltype -> int -> lltype */
@@ -798,7 +806,7 @@ CAMLprim value llvm_indices(LLVMValueRef Instr) {
   CAMLlocal1(indices);
   unsigned n = LLVMGetNumIndices(Instr);
   const unsigned *Indices = LLVMGetIndices(Instr);
-  indices = caml_alloc(n, 0);
+  indices = caml_alloc_tuple_uninit(n);
   for (unsigned i = 0; i < n; i++) {
     Op_val(indices)[i] = Val_int(Indices[i]);
   }
@@ -892,18 +900,19 @@ CAMLprim value llvm_get_mdnode_operands(LLVMValueRef V) {
   unsigned int n;
 
   n = LLVMGetMDNodeNumOperands(V);
-  Operands = alloc(n, 0);
+  Operands = caml_alloc_tuple_uninit(n);
-  LLVMGetMDNodeOperands(V, (LLVMValueRef *)  Operands);
+  LLVMGetMDNodeOperands(V, (LLVMValueRef *)Op_val(Operands));
   CAMLreturn(Operands);
 }
 
 /* llmodule -> string -> llvalue array */
-CAMLprim value llvm_get_namedmd(LLVMModuleRef M, value Name)
+CAMLprim value llvm_get_namedmd(LLVMModuleRef M, value Name) {
-{
   CAMLparam1(Name);
   CAMLlocal1(Nodes);
-  Nodes = alloc(LLVMGetNamedMetadataNumOperands(M, String_val(Name)), 0);
+  Nodes = caml_alloc_tuple_uninit(
-  LLVMGetNamedMetadataOperands(M, String_val(Name), (LLVMValueRef *) Nodes);
+      LLVMGetNamedMetadataNumOperands(M, String_val(Name)));
+  LLVMGetNamedMetadataOperands(M, String_val(Name),
+                               (LLVMValueRef *)Op_val(Nodes));
   CAMLreturn(Nodes);
 }
 
@@ -1319,10 +1328,9 @@ CAMLprim value llvm_global_copy_all_metadata(LLVMValueRef Global) {
       LLVMGlobalCopyAllMetadata(Global, &NumEntries);
   Array = caml_alloc_tuple(NumEntries);
   for (int i = 0; i < NumEntries; i++) {
-    Pair = caml_alloc_tuple(2);
+    Pair = caml_alloc_small(2, 0);
-    Store_field(Pair, 0, Val_int(LLVMValueMetadataEntriesGetKind(Entries, i)));
+    Field(Pair, 0) = Val_int(LLVMValueMetadataEntriesGetKind(Entries, i));
-    Store_field(Pair, 1,
+    Field(Pair, 1) = (value)LLVMValueMetadataEntriesGetMetadata(Entries, i);
-                (value)LLVMValueMetadataEntriesGetMetadata(Entries, i));
     Store_field(Array, i, Pair);
   }
   LLVMDisposeValueMetadataEntries(Entries);
@@ -1601,7 +1609,7 @@ CAMLprim value llvm_add_function_attr(LLVMValueRef F, LLVMAttributeRef A,
 /* llvalue -> int -> llattribute array */
 CAMLprim value llvm_function_attrs(LLVMValueRef F, value Index) {
   unsigned Length = LLVMGetAttributeCountAtIndex(F, Int_val(Index));
-  value Array = caml_alloc(Length, 0);
+  value Array = caml_alloc_tuple_uninit(Length);
   LLVMGetAttributesAtIndex(F, Int_val(Index),
                            (LLVMAttributeRef *) Op_val(Array));
   return Array;
@@ -1633,8 +1641,8 @@ CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
 
 /* llvalue -> llvalue */
 CAMLprim value llvm_params(LLVMValueRef Fn) {
-  value Params = alloc(LLVMCountParams(Fn), 0);
+  value Params = caml_alloc_tuple_uninit(LLVMCountParams(Fn));
-  LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
+  LLVMGetParams(Fn, (LLVMValueRef *)Op_val(Params));
   return Params;
 }
 
@@ -1658,8 +1666,8 @@ CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
 
 /* llvalue -> llbasicblock array */
 CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
-  value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
+  value MLArray = caml_alloc_tuple_uninit(LLVMCountBasicBlocks(Fn));
-  LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray));
+  LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *)Op_val(MLArray));
   return MLArray;
 }
 
@@ -1774,7 +1782,7 @@ CAMLprim value llvm_add_call_site_attr(LLVMValueRef F, LLVMAttributeRef A,
 /* llvalue -> int -> llattribute array */
 CAMLprim value llvm_call_site_attrs(LLVMValueRef F, value Index) {
   unsigned Count = LLVMGetCallSiteAttributeCount(F, Int_val(Index));
-  value Array = caml_alloc(Count, 0);
+  value Array = caml_alloc_tuple_uninit(Count);
   LLVMGetCallSiteAttributes(F, Int_val(Index),
                             (LLVMAttributeRef *)Op_val(Array));
   return Array;
@@ -1884,14 +1892,14 @@ CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
 
   /* Build a tuple list of them. */
   Tl = Val_int(0);
-  for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
+  for (I = LLVMCountIncoming(PhiNode); I != 0;) {
-    Hd = alloc(2, 0);
+    Hd = caml_alloc_small(2, 0);
-    Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
+    Field(Hd, 0) = (value)LLVMGetIncomingValue(PhiNode, --I);
-    Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
+    Field(Hd, 1) = (value)LLVMGetIncomingBlock(PhiNode, I);
-
+
-    Tmp = alloc(2, 0);
+    Tmp = caml_alloc_small(2, 0);
-    Store_field(Tmp, 0, Hd);
+    Field(Tmp, 0) = Hd;
-    Store_field(Tmp, 1, Tl);
+    Field(Tmp, 1) = Tl;
     Tl = Tmp;
   }