[OCaml] Minor optimizations by avoiding double initialization

[jberdine]

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.

[vaivaswatha]

As far as I can see, this looks fine, but I'm far from an expert on OCaml internals. It would be greatly useful if someone else who understands OCaml internals can take a look, but I don't know if it's easy finding such a reviewer here. So if you're confident and the code has been tested well on your end, I suppose it's okay to commit this.

llvm/bindings/ocaml/llvm/llvm_ocaml.c

 value caml_alloc_some(value v) {
   CAMLparam1(v);
   value Some = caml_alloc_small(1, 0);
   Field(Some, 0) = v;
   CAMLreturn(Some);
 }
 #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);
 
   return String;
 }
 
 CAMLprim value ptr_to_option(void *Ptr) {

 
 /* lltype -> bool */
 CAMLprim value llvm_is_var_arg(LLVMTypeRef FunTy) {
   return Val_bool(LLVMIsFunctionVarArg(FunTy));
 }
 
 /* lltype -> lltype array */
 CAMLprim value llvm_param_types(LLVMTypeRef FunTy) {
-  value Tys = alloc(LLVMCountParamTypes(FunTy), 0);
-  LLVMGetParamTypes(FunTy, (LLVMTypeRef *) Tys);
+  value Tys = caml_alloc_tuple_uninit(LLVMCountParamTypes(FunTy));
+  LLVMGetParamTypes(FunTy, (LLVMTypeRef *)Op_val(Tys));
   return Tys;
 }
 
 /*--... Operations on struct types .........................................--*/
 
 /* llcontext -> lltype array -> lltype */
 CAMLprim LLVMTypeRef llvm_struct_type(LLVMContextRef C, value ElementTypes) {
   return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
CAMLprim value llvm_struct_name(LLVMTypeRef Ty) {
   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);
+  value Tys = caml_alloc_tuple_uninit(LLVMCountStructElementTypes(StructTy));
+  LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *)Op_val(Tys));
   return Tys;
 }
 
 /* lltype -> bool */
 CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) {
   return Val_bool(LLVMIsPackedStruct(StructTy));
 }
 
 /* lltype -> bool */
 CAMLprim value llvm_is_opaque(LLVMTypeRef StructTy) {
   return Val_bool(LLVMIsOpaqueStruct(StructTy));
 }
 
 /* lltype -> bool */
 CAMLprim value llvm_is_literal(LLVMTypeRef StructTy) {
   return Val_bool(LLVMIsLiteralStruct(StructTy));
 }
 
 /*--... Operations on array, pointer, and vector types .....................--*/
 
 /* lltype -> lltype array */
 CAMLprim value llvm_subtypes(LLVMTypeRef Ty) {
-    CAMLparam0();
-    CAMLlocal1(Arr);
 
-    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);
 }
 
 /* lltype -> int -> lltype */
 CAMLprim LLVMTypeRef llvm_array_type(LLVMTypeRef ElementTy, value Count) {
   return LLVMArrayType(ElementTy, Int_val(Count));
 }
 
 /* lltype -> lltype */

 }
 
 /* llvalue -> int array */
 CAMLprim value llvm_indices(LLVMValueRef Instr) {
   CAMLparam0();
   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]);
   }
   CAMLreturn(indices);
 }
 
 /*--... Operations on constants of (mostly) any type .......................--*/
 

 }
 
 CAMLprim value llvm_get_mdnode_operands(LLVMValueRef V) {
   CAMLparam0();
   CAMLlocal1(Operands);
   unsigned int n;
 
   n = LLVMGetMDNodeNumOperands(V);
-  Operands = alloc(n, 0);
-  LLVMGetMDNodeOperands(V, (LLVMValueRef *)  Operands);
+  Operands = caml_alloc_tuple_uninit(n);
+  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);
-  LLVMGetNamedMetadataOperands(M, String_val(Name), (LLVMValueRef *) Nodes);
+  Nodes = caml_alloc_tuple_uninit(
+      LLVMGetNamedMetadataNumOperands(M, String_val(Name)));
+  LLVMGetNamedMetadataOperands(M, String_val(Name),
+                               (LLVMValueRef *)Op_val(Nodes));
   CAMLreturn(Nodes);
 }
 
 /* llmodule -> string -> llvalue -> unit */
 CAMLprim value llvm_append_namedmd(LLVMModuleRef M, value Name, LLVMValueRef Val) {
   LLVMAddNamedMetadataOperand(M, String_val(Name), Val);
   return Val_unit;
 }

 CAMLprim value llvm_global_copy_all_metadata(LLVMValueRef Global) {
   CAMLparam0();
   CAMLlocal2(Array, Pair);
   size_t NumEntries;
   LLVMValueMetadataEntry *Entries =
       LLVMGlobalCopyAllMetadata(Global, &NumEntries);
   Array = caml_alloc_tuple(NumEntries);
   for (int i = 0; i < NumEntries; i++) {
-    Pair = caml_alloc_tuple(2);
-    Store_field(Pair, 0, Val_int(LLVMValueMetadataEntriesGetKind(Entries, i)));
-    Store_field(Pair, 1,
-                (value)LLVMValueMetadataEntriesGetMetadata(Entries, i));
+    Pair = caml_alloc_small(2, 0);
+    Field(Pair, 0) = Val_int(LLVMValueMetadataEntriesGetKind(Entries, i));
+    Field(Pair, 1) = (value)LLVMValueMetadataEntriesGetMetadata(Entries, i);
     Store_field(Array, i, Pair);
   }
   LLVMDisposeValueMetadataEntries(Entries);
   CAMLreturn(Array);
 }
 
 /*--... Operations on uses .................................................--*/
 
CAMLprim value llvm_add_function_attr(LLVMValueRef F, LLVMAttributeRef A,
                                       value Index) {
   LLVMAddAttributeAtIndex(F, Int_val(Index), A);
   return Val_unit;
 }
 
 /* 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;
 }
 
 /* llvalue -> llattrkind -> int -> unit */
 CAMLprim value llvm_remove_enum_function_attr(LLVMValueRef F, value Kind,
                                               value Index) {

 
 /* llvalue -> int -> llvalue */
 CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
   return LLVMGetParam(Fn, Int_val(Index));
 }
 
 /* llvalue -> llvalue */
 CAMLprim value llvm_params(LLVMValueRef Fn) {
-  value Params = alloc(LLVMCountParams(Fn), 0);
-  LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
+  value Params = caml_alloc_tuple_uninit(LLVMCountParams(Fn));
+  LLVMGetParams(Fn, (LLVMValueRef *)Op_val(Params));
   return Params;
 }
 
 /*--... Operations on basic blocks .........................................--*/
 
 DEFINE_ITERATORS(
   block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
 
 /* llbasicblock -> llvalue option */
 CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
 {
   CAMLparam0();
   LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
   if (Term) {
     value Option = alloc(1, 0);
     Field(Option, 0) = (value) Term;
     CAMLreturn(Option);
   }
   CAMLreturn(Val_int(0));
 }
 
 /* llvalue -> llbasicblock array */
 CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
-  value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
-  LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray));
+  value MLArray = caml_alloc_tuple_uninit(LLVMCountBasicBlocks(Fn));
+  LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *)Op_val(MLArray));
   return MLArray;
 }
 
 /* llbasicblock -> unit */
 CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) {
   LLVMDeleteBasicBlock(BB);
   return Val_unit;
 }
CAMLprim value llvm_add_call_site_attr(LLVMValueRef F, LLVMAttributeRef A,
                                        value Index) {
   LLVMAddCallSiteAttribute(F, Int_val(Index), A);
   return Val_unit;
 }
 
 /* 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;
 }
 
 /* llvalue -> llattrkind -> int -> unit */
 CAMLprim value llvm_remove_enum_call_site_attr(LLVMValueRef F, value Kind,
                                                value Index) {

 /* llvalue -> (llvalue * llbasicblock) list */
 CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
   unsigned I;
   CAMLparam0();
   CAMLlocal3(Hd, Tl, Tmp);
 
   /* Build a tuple list of them. */
   Tl = Val_int(0);
-  for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
-    Hd = alloc(2, 0);
-    Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
-    Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
-
-    Tmp = alloc(2, 0);
-    Store_field(Tmp, 0, Hd);
-    Store_field(Tmp, 1, Tl);
+  for (I = LLVMCountIncoming(PhiNode); I != 0;) {
+    Hd = caml_alloc_small(2, 0);
+    Field(Hd, 0) = (value)LLVMGetIncomingValue(PhiNode, --I);
+    Field(Hd, 1) = (value)LLVMGetIncomingBlock(PhiNode, I);
+
+    Tmp = caml_alloc_small(2, 0);
+    Field(Tmp, 0) = Hd;
+    Field(Tmp, 1) = Tl;
     Tl = Tmp;
   }
 
   CAMLreturn(Tl);
 }
 
 /* llvalue -> unit */
 CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {