@ -36,6 +36,14 @@ value caml_alloc_some(value v) {
}
}
# endif
# 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 llvm_string_of_message ( char * Message ) {
value String = caml_copy_string ( Message ) ;
value String = caml_copy_string ( Message ) ;
LLVMDisposeMessage ( Message ) ;
LLVMDisposeMessage ( Message ) ;
@ -509,8 +517,8 @@ CAMLprim value llvm_is_var_arg(LLVMTypeRef FunTy) {
/* lltype -> lltype array */
/* lltype -> lltype array */
CAMLprim value llvm_param_types ( LLVMTypeRef FunTy ) {
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 ;
return Tys ;
}
}
@ -555,8 +563,8 @@ CAMLprim value llvm_struct_name(LLVMTypeRef Ty) {
/* lltype -> lltype array */
/* lltype -> lltype array */
CAMLprim value llvm_struct_element_types ( LLVMTypeRef StructTy ) {
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 ;
return Tys ;
}
}
@ -584,9 +592,9 @@ CAMLprim value llvm_subtypes(LLVMTypeRef Ty) {
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 ) ;
}
}
@ -798,7 +806,7 @@ CAMLprim value llvm_indices(LLVMValueRef Instr) {
CAMLlocal1 ( indices ) ;
CAMLlocal1 ( indices ) ;
unsigned n = LLVMGetNumIndices ( Instr ) ;
unsigned n = LLVMGetNumIndices ( Instr ) ;
const unsigned * Indices = LLVMGetIndices ( Instr ) ;
const unsigned * Indices = LLVMGetIndices ( Instr ) ;
indices = caml_alloc ( n , 0 ) ;
indices = caml_alloc _tuple_uninit ( n ) ;
for ( unsigned i = 0 ; i < n ; i + + ) {
for ( unsigned i = 0 ; i < n ; i + + ) {
Op_val ( indices ) [ i ] = Val_int ( Indices [ i ] ) ;
Op_val ( indices ) [ i ] = Val_int ( Indices [ i ] ) ;
}
}
@ -892,18 +900,19 @@ CAMLprim value llvm_get_mdnode_operands(LLVMValueRef V) {
unsigned int n ;
unsigned int n ;
n = LLVMGetMDNodeNumOperands ( V ) ;
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 ) ;
CAMLreturn ( Operands ) ;
}
}
/* llmodule -> string -> llvalue array */
/* llmodule -> string -> llvalue array */
CAMLprim value llvm_get_namedmd ( LLVMModuleRef M , value Name )
CAMLprim value llvm_get_namedmd ( LLVMModuleRef M , value Name ) {
{
CAMLparam1 ( Name ) ;
CAMLparam1 ( Name ) ;
CAMLlocal1 ( Nodes ) ;
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 ) ;
CAMLreturn ( Nodes ) ;
}
}
@ -1319,10 +1328,9 @@ CAMLprim value llvm_global_copy_all_metadata(LLVMValueRef Global) {
LLVMGlobalCopyAllMetadata ( Global , & NumEntries ) ;
LLVMGlobalCopyAllMetadata ( Global , & NumEntries ) ;
Array = caml_alloc_tuple ( NumEntries ) ;
Array = caml_alloc_tuple ( NumEntries ) ;
for ( int i = 0 ; i < NumEntries ; i + + ) {
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 ) ;
Store_field ( Array , i , Pair ) ;
}
}
LLVMDisposeValueMetadataEntries ( Entries ) ;
LLVMDisposeValueMetadataEntries ( Entries ) ;
@ -1601,7 +1609,7 @@ CAMLprim value llvm_add_function_attr(LLVMValueRef F, LLVMAttributeRef A,
/* llvalue -> int -> llattribute array */
/* llvalue -> int -> llattribute array */
CAMLprim value llvm_function_attrs ( LLVMValueRef F , value Index ) {
CAMLprim value llvm_function_attrs ( LLVMValueRef F , value Index ) {
unsigned Length = LLVMGetAttributeCountAtIndex ( F , Int_val ( 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 ) ,
LLVMGetAttributesAtIndex ( F , Int_val ( Index ) ,
( LLVMAttributeRef * ) Op_val ( Array ) ) ;
( LLVMAttributeRef * ) Op_val ( Array ) ) ;
return Array ;
return Array ;
@ -1633,7 +1641,7 @@ CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
/* llvalue -> llvalue */
/* llvalue -> llvalue */
CAMLprim value llvm_params ( LLVMValueRef Fn ) {
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 ;
return Params ;
}
}
@ -1658,7 +1666,7 @@ CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
/* llvalue -> llbasicblock array */
/* llvalue -> llbasicblock array */
CAMLprim value llvm_basic_blocks ( LLVMValueRef Fn ) {
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 ;
return MLArray ;
}
}
@ -1774,7 +1782,7 @@ CAMLprim value llvm_add_call_site_attr(LLVMValueRef F, LLVMAttributeRef A,
/* llvalue -> int -> llattribute array */
/* llvalue -> int -> llattribute array */
CAMLprim value llvm_call_site_attrs ( LLVMValueRef F , value Index ) {
CAMLprim value llvm_call_site_attrs ( LLVMValueRef F , value Index ) {
unsigned Count = LLVMGetCallSiteAttributeCount ( F , Int_val ( 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 ) ,
LLVMGetCallSiteAttributes ( F , Int_val ( Index ) ,
( LLVMAttributeRef * ) Op_val ( Array ) ) ;
( LLVMAttributeRef * ) Op_val ( Array ) ) ;
return Array ;
return Array ;
@ -1885,13 +1893,13 @@ CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
/* Build a tuple list of them. */
/* Build a tuple list of them. */
Tl = Val_int ( 0 ) ;
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 ;
Tl = Tmp ;
}
}