[llvm-ocaml] Replace all typed pointer functions with opaque pointer functions

Reviewed By: aeubanks

Differential Revision: https://reviews.llvm.org/D135524
This commit is contained in:
Alan Hu 2022-10-11 16:25:29 -07:00 committed by Arthur Eubanks
parent f2b73f517b
commit d226244ae0
7 changed files with 114 additions and 269 deletions

View File

@ -505,11 +505,9 @@ external is_literal : lltype -> bool = "llvm_is_literal"
external subtypes : lltype -> lltype array = "llvm_subtypes"
external array_type : lltype -> int -> lltype = "llvm_array_type"
external pointer_type : lltype -> lltype = "llvm_pointer_type"
external qualified_pointer_type : lltype -> int -> lltype
external pointer_type : llcontext -> lltype = "llvm_pointer_type"
external qualified_pointer_type : llcontext -> int -> lltype
= "llvm_qualified_pointer_type"
external pointer_type_in_context : llcontext -> int -> lltype
= "llvm_pointer_type_in_context"
external vector_type : lltype -> int -> lltype = "llvm_vector_type"
external element_type : lltype -> lltype = "LLVMGetElementType"
@ -659,9 +657,8 @@ external const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue
external const_shl : llvalue -> llvalue -> llvalue = "LLVMConstShl"
external const_lshr : llvalue -> llvalue -> llvalue = "LLVMConstLShr"
external const_ashr : llvalue -> llvalue -> llvalue = "LLVMConstAShr"
external const_gep : llvalue -> llvalue array -> llvalue = "llvm_const_gep"
external const_gep2 : lltype -> llvalue -> llvalue array -> llvalue
= "llvm_const_gep2"
external const_gep : lltype -> llvalue -> llvalue array -> llvalue
= "llvm_const_gep"
external const_in_bounds_gep : llvalue -> llvalue array -> llvalue
= "llvm_const_in_bounds_gep"
external const_trunc : llvalue -> lltype -> llvalue = "LLVMConstTrunc"
@ -798,12 +795,9 @@ let fold_right_globals f m init =
fold_right_global_range f (global_end m) (At_start m) init
(*--... Operations on aliases ..............................................--*)
external add_alias : llmodule -> lltype -> llvalue -> string -> llvalue
external add_alias : llmodule -> lltype -> int -> llvalue -> string -> llvalue
= "llvm_add_alias"
external add_alias2 : llmodule -> lltype -> int -> llvalue -> string -> llvalue
= "llvm_add_alias2"
(*--... Operations on functions ............................................--*)
external declare_function : string -> lltype -> llmodule -> llvalue
= "llvm_declare_function"
@ -1212,12 +1206,9 @@ external build_indirect_br : llvalue -> int -> llbuilder -> llvalue
= "llvm_build_indirect_br"
external add_destination : llvalue -> llbasicblock -> unit
= "llvm_add_destination"
external build_invoke : llvalue -> llvalue array -> llbasicblock ->
external build_invoke : lltype -> llvalue -> llvalue array -> llbasicblock ->
llbasicblock -> string -> llbuilder -> llvalue
= "llvm_build_invoke_bc" "llvm_build_invoke_nat"
external build_invoke2 : lltype -> llvalue -> llvalue array -> llbasicblock ->
llbasicblock -> string -> llbuilder -> llvalue
= "llvm_build_invoke2_bc" "llvm_build_invoke2_nat"
external build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
llvalue = "llvm_build_landingpad"
external is_cleanup : llvalue -> bool = "llvm_is_cleanup"
@ -1293,10 +1284,8 @@ external build_alloca : lltype -> string -> llbuilder -> llvalue
= "llvm_build_alloca"
external build_array_alloca : lltype -> llvalue -> string -> llbuilder ->
llvalue = "llvm_build_array_alloca"
external build_load : llvalue -> string -> llbuilder -> llvalue
external build_load : lltype -> llvalue -> string -> llbuilder -> llvalue
= "llvm_build_load"
external build_load2 : lltype -> llvalue -> string -> llbuilder -> llvalue
= "llvm_build_load2"
external build_store : llvalue -> llvalue -> llbuilder -> llvalue
= "llvm_build_store"
external build_atomicrmw : AtomicRMWBinOp.t -> llvalue -> llvalue ->
@ -1304,18 +1293,12 @@ external build_atomicrmw : AtomicRMWBinOp.t -> llvalue -> llvalue ->
llvalue
= "llvm_build_atomicrmw_bytecode"
"llvm_build_atomicrmw_native"
external build_gep : llvalue -> llvalue array -> string -> llbuilder -> llvalue
= "llvm_build_gep"
external build_gep2 : lltype -> llvalue -> llvalue array -> string -> llbuilder
-> llvalue = "llvm_build_gep2"
external build_in_bounds_gep : llvalue -> llvalue array -> string ->
external build_gep : lltype -> llvalue -> llvalue array -> string -> llbuilder
-> llvalue = "llvm_build_gep"
external build_in_bounds_gep : lltype -> llvalue -> llvalue array -> string ->
llbuilder -> llvalue = "llvm_build_in_bounds_gep"
external build_in_bounds_gep2 : lltype -> llvalue -> llvalue array -> string ->
llbuilder -> llvalue = "llvm_build_in_bounds_gep2"
external build_struct_gep : llvalue -> int -> string -> llbuilder -> llvalue
= "llvm_build_struct_gep"
external build_struct_gep2 : lltype -> llvalue -> int -> string -> llbuilder ->
llvalue = "llvm_build_struct_gep2"
external build_struct_gep : lltype -> llvalue -> int -> string -> llbuilder ->
llvalue = "llvm_build_struct_gep"
external build_global_string : string -> string -> llbuilder -> llvalue
= "llvm_build_global_string"
@ -1371,10 +1354,8 @@ external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder ->
llvalue = "llvm_build_phi"
external build_empty_phi : lltype -> string -> llbuilder -> llvalue
= "llvm_build_empty_phi"
external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue
= "llvm_build_call"
external build_call2 : lltype -> llvalue -> llvalue array -> string ->
llbuilder -> llvalue = "llvm_build_call2"
external build_call : lltype -> llvalue -> llvalue array -> string ->
llbuilder -> llvalue = "llvm_build_call"
external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder ->
llvalue = "llvm_build_select"
external build_va_arg : llvalue -> lltype -> string -> llbuilder -> llvalue
@ -1394,10 +1375,8 @@ external build_is_null : llvalue -> string -> llbuilder -> llvalue
= "llvm_build_is_null"
external build_is_not_null : llvalue -> string -> llbuilder -> llvalue
= "llvm_build_is_not_null"
external build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue
= "llvm_build_ptrdiff"
external build_ptrdiff2 : lltype -> llvalue -> llvalue -> string -> llbuilder ->
llvalue = "llvm_build_ptrdiff2"
external build_ptrdiff : lltype -> llvalue -> llvalue -> string -> llbuilder ->
llvalue = "llvm_build_ptrdiff"
external build_freeze : llvalue -> string -> llbuilder -> llvalue
= "llvm_build_freeze"

View File

@ -716,20 +716,15 @@ val subtypes : lltype -> lltype array
[ty]. See the method [llvm::ArrayType::get]. *)
val array_type : lltype -> int -> lltype
(** [pointer_type ty] returns the pointer type referencing objects of type
[ty] in the default address space (0).
(** [pointer_type context] returns the pointer type in the default
address space (0).
See the method [llvm::PointerType::getUnqual]. *)
val pointer_type : lltype -> lltype
val pointer_type : llcontext -> lltype
(** [qualified_pointer_type ty as] returns the pointer type referencing objects
of type [ty] in address space [as].
(** [qualified_pointer_type context sp] returns the pointer type referencing
objects in address space [sp].
See the method [llvm::PointerType::get]. *)
val qualified_pointer_type : lltype -> int -> lltype
(** [pointer_type_in_context context as] returns the opaque pointer type
referencing objects in address space [as].
See the method [llvm::PointerType::get]. *)
val pointer_type_in_context : llcontext -> int -> lltype
val qualified_pointer_type : llcontext -> int -> lltype
(** [vector_type ty n] returns the array type containing [n] elements of the
primitive type [ty]. See the method [llvm::ArrayType::get]. *)
@ -1168,16 +1163,11 @@ val const_lshr : llvalue -> llvalue -> llvalue
See the method [llvm::ConstantExpr::getAShr]. *)
val const_ashr : llvalue -> llvalue -> llvalue
(** [const_gep pc indices] returns the constant [getElementPtr] of [pc] with the
constant integers indices from the array [indices].
See the method [llvm::ConstantExpr::getGetElementPtr]. *)
val const_gep : llvalue -> llvalue array -> llvalue
(** [const_gep2 srcty pc indices] returns the constant [getElementPtr] of [pc]
(** [const_gep srcty pc indices] returns the constant [getElementPtr] of [pc]
with source element type [srcty] and the constant integers indices from the
array [indices].
See the method [llvm::ConstantExpr::getGetElementPtr]. *)
val const_gep2 : lltype -> llvalue -> llvalue array -> llvalue
val const_gep : lltype -> llvalue -> llvalue array -> llvalue
(** [const_in_bounds_gep pc indices] returns the constant [getElementPtr] of [pc]
with the constant integers indices from the array [indices].
@ -1509,15 +1499,10 @@ val set_externally_initialized : bool -> llvalue -> unit
(** {7 Operations on aliases} *)
(** [add_alias m t a n] inserts an alias in the module [m] with the type [t] and
the aliasee [a] with the name [n].
(** [add_alias m vt sp a n] inserts an alias in the module [m] with the value
type [vt] the address space [sp] the aliasee [a] with the name [n].
See the constructor for [llvm::GlobalAlias]. *)
val add_alias : llmodule -> lltype -> llvalue -> string -> llvalue
(** [add_alias m vt as a n] inserts an alias in the module [m] with the value
type [vt] the address space [as] the aliasee [a] with the name [n].
See the constructor for [llvm::GlobalAlias]. *)
val add_alias2 : llmodule -> lltype -> int -> llvalue -> string -> llvalue
val add_alias : llmodule -> lltype -> int -> llvalue -> string -> llvalue
(** {7 Operations on functions} *)
@ -2097,19 +2082,12 @@ val build_indirect_br : llvalue -> int -> llbuilder -> llvalue
See the method [llvm::IndirectBrInst::addDestination]. **)
val add_destination : llvalue -> llbasicblock -> unit
(** [build_invoke fn args tobb unwindbb name b] creates an
(** [build_invoke fnty fn args tobb unwindbb name b] creates an
[%name = invoke %fn(args) to %tobb unwind %unwindbb]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateInvoke]. *)
val build_invoke : llvalue -> llvalue array -> llbasicblock ->
llbasicblock -> string -> llbuilder -> llvalue
(** [build_invoke2 fnty fn args tobb unwindbb name b] creates an
[%name = invoke %fn(args) to %tobb unwind %unwindbb]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateInvoke]. *)
val build_invoke2 : lltype -> llvalue -> llvalue array -> llbasicblock ->
llbasicblock -> string -> llbuilder -> llvalue
val build_invoke : lltype -> llvalue -> llvalue array -> llbasicblock ->
llbasicblock -> string -> llbuilder -> llvalue
(** [build_landingpad ty persfn numclauses name b] creates an
[landingpad]
@ -2345,17 +2323,11 @@ val build_alloca : lltype -> string -> llbuilder -> llvalue
val build_array_alloca : lltype -> llvalue -> string -> llbuilder ->
llvalue
(** [build_load v name b] creates a
[%name = load %v]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateLoad]. *)
val build_load : llvalue -> string -> llbuilder -> llvalue
(** [build_load2 ty v name b] creates a
(** [build_load ty v name b] creates a
[%name = load %ty, %v]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateLoad]. *)
val build_load2 : lltype -> llvalue -> string -> llbuilder -> llvalue
val build_load : lltype -> llvalue -> string -> llbuilder -> llvalue
(** [build_store v p b] creates a
[store %v, %p]
@ -2371,46 +2343,26 @@ val build_store : llvalue -> llvalue -> llbuilder -> llvalue
val build_atomicrmw : AtomicRMWBinOp.t -> llvalue -> llvalue ->
AtomicOrdering.t -> bool -> string -> llbuilder -> llvalue
(** [build_gep p indices name b] creates a
[%name = getelementptr %p, indices...]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateGetElementPtr]. *)
val build_gep : llvalue -> llvalue array -> string -> llbuilder -> llvalue
(** [build_gep2 srcty p indices name b] creates a
(** [build_gep srcty p indices name b] creates a
[%name = getelementptr srcty, %p, indices...]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateGetElementPtr]. *)
val build_gep2 : lltype -> llvalue -> llvalue array -> string -> llbuilder ->
llvalue
val build_gep : lltype -> llvalue -> llvalue array -> string -> llbuilder ->
llvalue
(** [build_in_bounds_gep p indices name b] creates a
[%name = gelementptr inbounds %p, indices...]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateInBoundsGetElementPtr]. *)
val build_in_bounds_gep : llvalue -> llvalue array -> string -> llbuilder ->
llvalue
(** [build_in_bounds_gep2 srcty p indices name b] creates a
(** [build_in_bounds_gep srcty p indices name b] creates a
[%name = gelementptr inbounds srcty, %p, indices...]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateInBoundsGetElementPtr]. *)
val build_in_bounds_gep2 : lltype -> llvalue -> llvalue array -> string ->
llbuilder -> llvalue
val build_in_bounds_gep : lltype -> llvalue -> llvalue array -> string ->
llbuilder -> llvalue
(** [build_struct_gep p idx name b] creates a
[%name = getelementptr %p, 0, idx]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateStructGetElementPtr]. *)
val build_struct_gep : llvalue -> int -> string -> llbuilder ->
llvalue
(** [build_struct_gep2 srcty p idx name b] creates a
(** [build_struct_gep srcty p idx name b] creates a
[%name = getelementptr srcty, %p, 0, idx]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateStructGetElementPtr]. *)
val build_struct_gep2 : lltype -> llvalue -> int -> string -> llbuilder ->
llvalue
val build_struct_gep : lltype -> llvalue -> int -> string -> llbuilder ->
llvalue
(** [build_global_string str name b] creates a series of instructions that adds
a global string at the position specified by the instruction builder [b].
@ -2565,18 +2517,12 @@ val build_phi : (llvalue * llbasicblock) list -> string -> llbuilder ->
See the method [llvm::LLVMBuilder::CreatePHI]. *)
val build_empty_phi : lltype -> string -> llbuilder -> llvalue
(** [build_call fn args name b] creates a
(** [build_call fnty fn args name b] creates a
[%name = call %fn(args...)]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateCall]. *)
val build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue
(** [build_call2 fnty fn args name b] creates a
[%name = call %fn(args...)]
instruction at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreateCall]. *)
val build_call2 : lltype -> llvalue -> llvalue array -> string -> llbuilder ->
llvalue
val build_call : lltype -> llvalue -> llvalue array -> string -> llbuilder ->
llvalue
(** [build_select cond thenv elsev name b] creates a
[%name = select %cond, %thenv, %elsev]
@ -2638,18 +2584,12 @@ val build_is_null : llvalue -> string -> llbuilder -> llvalue
See the method [llvm::LLVMBuilder::CreateIsNotNull]. *)
val build_is_not_null : llvalue -> string -> llbuilder -> llvalue
(** [build_ptrdiff lhs rhs name b] creates a series of instructions that measure
the difference between two pointer values at the position specified by the
instruction builder [b].
See the method [llvm::LLVMBuilder::CreatePtrDiff]. *)
val build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue
(** [build_ptrdiff2 elemty lhs rhs name b] creates a series of instructions
(** [build_ptrdiff elemty lhs rhs name b] creates a series of instructions
that measure the difference between two pointer values in multiples of
[elemty] at the position specified by the instruction builder [b].
See the method [llvm::LLVMBuilder::CreatePtrDiff]. *)
val build_ptrdiff2 : lltype -> llvalue -> llvalue -> string -> llbuilder ->
llvalue
val build_ptrdiff : lltype -> llvalue -> llvalue -> string -> llbuilder ->
llvalue
(** [build_freeze x name b] creates a
[%name = freeze %x]

View File

@ -570,19 +570,13 @@ LLVMTypeRef llvm_array_type(LLVMTypeRef ElementTy, value Count) {
return LLVMArrayType(ElementTy, Int_val(Count));
}
/* lltype -> lltype */
LLVMTypeRef llvm_pointer_type(LLVMTypeRef ElementTy) {
return LLVMPointerType(ElementTy, 0);
}
/* lltype -> int -> lltype */
LLVMTypeRef llvm_qualified_pointer_type(LLVMTypeRef ElementTy,
value AddressSpace) {
return LLVMPointerType(ElementTy, Int_val(AddressSpace));
/* llcontext -> lltype */
LLVMTypeRef llvm_pointer_type(LLVMContextRef C, value AddressSpace) {
return LLVMPointerTypeInContext(C, 0);
}
/* llcontext -> int -> lltype */
LLVMTypeRef llvm_pointer_type_in_context(LLVMContextRef C, value AddressSpace) {
LLVMTypeRef llvm_qualified_pointer_type(LLVMContextRef C, value AddressSpace) {
return LLVMPointerTypeInContext(C, Int_val(AddressSpace));
}
@ -993,14 +987,8 @@ LLVMValueRef llvm_const_fcmp(value Pred, LLVMValueRef LHSConstant,
return LLVMConstFCmp(Int_val(Pred), LHSConstant, RHSConstant);
}
/* llvalue -> llvalue array -> llvalue */
LLVMValueRef llvm_const_gep(LLVMValueRef ConstantVal, value Indices) {
return LLVMConstGEP(ConstantVal, (LLVMValueRef *)Op_val(Indices),
Wosize_val(Indices));
}
/* lltype -> llvalue -> llvalue array -> llvalue */
LLVMValueRef llvm_const_gep2(LLVMTypeRef Ty, LLVMValueRef ConstantVal,
LLVMValueRef llvm_const_gep(LLVMTypeRef Ty, LLVMValueRef ConstantVal,
value Indices) {
return LLVMConstGEP2(Ty, ConstantVal, (LLVMValueRef *)Op_val(Indices),
Wosize_val(Indices));
@ -1257,12 +1245,7 @@ value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) {
/*--... Operations on aliases ..............................................--*/
LLVMValueRef llvm_add_alias(LLVMModuleRef M, LLVMTypeRef Ty,
LLVMValueRef Aliasee, value Name) {
return LLVMAddAlias(M, Ty, Aliasee, String_val(Name));
}
LLVMValueRef llvm_add_alias2(LLVMModuleRef M, LLVMTypeRef ValueTy,
LLVMValueRef llvm_add_alias(LLVMModuleRef M, LLVMTypeRef ValueTy,
value AddrSpace, LLVMValueRef Aliasee, value Name) {
return LLVMAddAlias2(M, ValueTy, Int_val(AddrSpace), Aliasee,
String_val(Name));
@ -1764,30 +1747,12 @@ value llvm_add_destination(LLVMValueRef IndirectBr, LLVMBasicBlockRef Dest) {
return Val_unit;
}
/* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
llbuilder -> llvalue */
LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args,
LLVMBasicBlockRef Then,
LLVMBasicBlockRef Catch, value Name,
value B) {
return LLVMBuildInvoke(Builder_val(B), Fn, (LLVMValueRef *)Op_val(Args),
Wosize_val(Args), Then, Catch, String_val(Name));
}
/* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
llbuilder -> llvalue */
LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
return llvm_build_invoke_nat((LLVMValueRef)Args[0], Args[1],
(LLVMBasicBlockRef)Args[2],
(LLVMBasicBlockRef)Args[3], Args[4], Args[5]);
}
/* lltype -> llvalue -> llvalue array -> llbasicblock -> llbasicblock ->
string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_invoke2_nat(LLVMTypeRef FnTy, LLVMValueRef Fn,
value Args, LLVMBasicBlockRef Then,
LLVMBasicBlockRef Catch, value Name,
value B) {
LLVMValueRef llvm_build_invoke_nat(LLVMTypeRef FnTy, LLVMValueRef Fn,
value Args, LLVMBasicBlockRef Then,
LLVMBasicBlockRef Catch, value Name,
value B) {
return LLVMBuildInvoke2(Builder_val(B), FnTy, Fn,
(LLVMValueRef *)Op_val(Args), Wosize_val(Args),
Then, Catch, String_val(Name));
@ -1795,9 +1760,9 @@ LLVMValueRef llvm_build_invoke2_nat(LLVMTypeRef FnTy, LLVMValueRef Fn,
/* lltype -> llvalue -> llvalue array -> llbasicblock -> llbasicblock ->
string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_invoke2_bc(value Args[], int NumArgs) {
return llvm_build_invoke2_nat((LLVMTypeRef)Args[0], (LLVMValueRef)Args[1],
Args[2], (LLVMBasicBlockRef)Args[3],
LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
return llvm_build_invoke_nat((LLVMTypeRef)Args[0], (LLVMValueRef)Args[1],
Args[2], (LLVMBasicBlockRef)Args[3],
(LLVMBasicBlockRef)Args[4], Args[5], Args[6]);
}
@ -2025,14 +1990,9 @@ LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size,
return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name));
}
/* llvalue -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_load(LLVMValueRef Pointer, value Name, value B) {
return LLVMBuildLoad(Builder_val(B), Pointer, String_val(Name));
}
/* lltype -> llvalue -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_load2(LLVMTypeRef Ty, LLVMValueRef Pointer, value Name,
value B) {
LLVMValueRef llvm_build_load(LLVMTypeRef Ty, LLVMValueRef Pointer, value Name,
value B) {
return LLVMBuildLoad2(Builder_val(B), Ty, Pointer, String_val(Name));
}
@ -2060,47 +2020,25 @@ LLVMValueRef llvm_build_atomicrmw_bytecode(value *argv, int argn) {
argv[5], argv[6]);
}
/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices, value Name,
value B) {
return LLVMBuildGEP(Builder_val(B), Pointer, (LLVMValueRef *)Op_val(Indices),
Wosize_val(Indices), String_val(Name));
}
/* lltype -> llvalue -> llvalue array -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_gep2(LLVMTypeRef Ty, LLVMValueRef Pointer,
value Indices, value Name, value B) {
LLVMValueRef llvm_build_gep(LLVMTypeRef Ty, LLVMValueRef Pointer, value Indices,
value Name, value B) {
return LLVMBuildGEP2(Builder_val(B), Ty, Pointer,
(LLVMValueRef *)Op_val(Indices), Wosize_val(Indices),
String_val(Name));
}
/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_in_bounds_gep(LLVMValueRef Pointer, value Indices,
value Name, value B) {
return LLVMBuildInBoundsGEP(Builder_val(B), Pointer,
(LLVMValueRef *)Op_val(Indices),
Wosize_val(Indices), String_val(Name));
}
/* lltype -> llvalue -> llvalue array -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_in_bounds_gep2(LLVMTypeRef Ty, LLVMValueRef Pointer,
value Indices, value Name, value B) {
LLVMValueRef llvm_build_in_bounds_gep(LLVMTypeRef Ty, LLVMValueRef Pointer,
value Indices, value Name, value B) {
return LLVMBuildInBoundsGEP2(Builder_val(B), Ty, Pointer,
(LLVMValueRef *)Op_val(Indices),
Wosize_val(Indices), String_val(Name));
}
/* llvalue -> int -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_struct_gep(LLVMValueRef Pointer, value Index,
value Name, value B) {
return LLVMBuildStructGEP(Builder_val(B), Pointer, Int_val(Index),
String_val(Name));
}
/* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_struct_gep2(LLVMTypeRef Ty, LLVMValueRef Pointer,
value Index, value Name, value B) {
LLVMValueRef llvm_build_struct_gep(LLVMTypeRef Ty, LLVMValueRef Pointer,
value Index, value Name, value B) {
return LLVMBuildStructGEP2(Builder_val(B), Ty, Pointer, Int_val(Index),
String_val(Name));
}
@ -2271,16 +2209,9 @@ LLVMValueRef llvm_build_empty_phi(LLVMTypeRef Type, value Name, value B) {
return LLVMBuildPhi(Builder_val(B), Type, String_val(Name));
}
/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_call(LLVMValueRef Fn, value Params, value Name,
value B) {
return LLVMBuildCall(Builder_val(B), Fn, (LLVMValueRef *)Op_val(Params),
Wosize_val(Params), String_val(Name));
}
/* lltype -> llvalue -> llvalue array -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_call2(LLVMTypeRef FnTy, LLVMValueRef Fn, value Params,
value Name, value B) {
LLVMValueRef llvm_build_call(LLVMTypeRef FnTy, LLVMValueRef Fn, value Params,
value Name, value B) {
return LLVMBuildCall2(Builder_val(B), FnTy, Fn,
(LLVMValueRef *)Op_val(Params), Wosize_val(Params),
String_val(Name));
@ -2342,14 +2273,8 @@ LLVMValueRef llvm_build_is_not_null(LLVMValueRef Val, value Name, value B) {
}
/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS, value Name,
value B) {
return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name));
}
/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
LLVMValueRef llvm_build_ptrdiff2(LLVMTypeRef ElemTy, LLVMValueRef LHS,
LLVMValueRef RHS, value Name, value B) {
LLVMValueRef llvm_build_ptrdiff(LLVMTypeRef ElemTy, LLVMValueRef LHS,
LLVMValueRef RHS, value Name, value B) {
return LLVMBuildPtrDiff2(Builder_val(B), ElemTy, LHS, RHS, String_val(Name));
}

View File

@ -43,8 +43,9 @@ let test_contained_types () =
(*===-- Pointer types ----------------------------------------------------===*)
let test_pointer_types () =
insist (address_space (pointer_type_in_context context 0) = 0);
insist (address_space (pointer_type_in_context context 1) = 1)
insist (address_space (pointer_type context) = 0);
insist (address_space (qualified_pointer_type context 0) = 0);
insist (address_space (qualified_pointer_type context 1) = 1)
(*===-- Conversion --------------------------------------------------------===*)
@ -219,7 +220,7 @@ let test_constants () =
group "pointer null"; begin
(* CHECK: const_pointer_null = global ptr null
*)
let c = const_pointer_null (pointer_type i64_type) in
let c = const_pointer_null (pointer_type context) in
ignore (define_global "const_pointer_null" c m);
end;
@ -259,7 +260,7 @@ let test_constants () =
* CHECK: @const_icmp = global i1 icmp sle
* CHECK: @const_fcmp = global i1 fcmp ole
*)
let void_ptr = pointer_type i8_type in
let void_ptr = pointer_type context in
let five = const_int i64_type 5 in
let ffive = const_uitofp five double_type in
let foldbomb_gv = define_global "FoldBomb" (const_null i8_type) m in
@ -311,8 +312,8 @@ let test_constants () =
ignore (define_global "const_fptoui" (const_fptoui ffoldbomb i32_type) m);
ignore (define_global "const_fptosi" (const_fptosi ffoldbomb i32_type) m);
ignore (define_global "const_ptrtoint" (const_ptrtoint
(const_gep2 i8_type (const_null (pointer_type i8_type))
[| const_int i32_type 1 |])
(const_gep i8_type (const_null (pointer_type context))
[| const_int i32_type 1 |])
i32_type) m);
ignore (define_global "const_inttoptr" (const_inttoptr (const_add foldbomb five)
void_ptr) m);
@ -328,8 +329,8 @@ let test_constants () =
* CHECK: const_insertelement{{.*}}insertelement
* CHECK: const_shufflevector = global <4 x i32> <i32 0, i32 1, i32 1, i32 0>
*)
ignore (define_global "const_size_of" (size_of (pointer_type i8_type)) m);
ignore (define_global "const_gep" (const_gep2 i8_type foldbomb_gv [| five |])
ignore (define_global "const_size_of" (size_of (pointer_type context)) m);
ignore (define_global "const_gep" (const_gep i8_type foldbomb_gv [| five |])
m);
ignore (define_global "const_select" (const_select
(const_icmp Icmp.Sle foldbomb five)
@ -361,7 +362,7 @@ let test_constants () =
group "recursive struct"; begin
let nsty = named_struct_type context "rec" in
let pty = pointer_type nsty in
let pty = pointer_type context in
struct_set_body nsty [| i32_type; pty |] false;
let elts = [| const_int i32_type 4; const_pointer_null pty |] in
let grec_init = const_named_struct nsty elts in
@ -469,7 +470,7 @@ let test_global_variables () =
insist (None == lookup_global "GVar01" m);
let g = declare_global i32_type "GVar01" m in
insist (is_declaration g);
insist (pointer_type float_type ==
insist (pointer_type context ==
type_of (declare_global float_type "GVar01" m));
insist (g == declare_global i32_type "GVar01" m);
insist (match lookup_global "GVar01" m with Some x -> x = g
@ -478,7 +479,7 @@ let test_global_variables () =
insist (None == lookup_global "QGVar01" m);
let g = declare_qualified_global i32_type "QGVar01" 3 m in
insist (is_declaration g);
insist (qualified_pointer_type float_type 3 ==
insist (qualified_pointer_type context 3 ==
type_of (declare_qualified_global float_type "QGVar01" 3 m));
insist (g == declare_qualified_global i32_type "QGVar01" 3 m);
insist (match lookup_global "QGVar01" m with Some x -> x = g
@ -613,7 +614,7 @@ let test_users () =
let p1 = param fn 0 in
let p2 = param fn 1 in
let a3 = build_alloca i32_type "user_alloca" b in
let p3 = build_load2 i32_type a3 "user_load" b in
let p3 = build_load i32_type a3 "user_load" b in
let i = build_add p1 p2 "sum" b in
insist ((num_operands i) = 2);
@ -634,7 +635,7 @@ let test_aliases () =
*)
let forty_two32 = const_int i32_type 42 in
let v = define_global "aliasee" forty_two32 m in
ignore (add_alias2 m i32_type 0 v "alias")
ignore (add_alias m i32_type 0 v "alias")
(*===-- Functions ---------------------------------------------------------===*)
@ -648,10 +649,10 @@ let test_functions () =
begin group "declare";
insist (None = lookup_function "Fn1" m);
let fn = declare_function "Fn1" ty m in
insist (pointer_type ty = type_of fn);
insist (pointer_type context = type_of fn);
insist (is_declaration fn);
insist (0 = Array.length (basic_blocks fn));
insist (pointer_type ty2 == type_of (declare_function "Fn1" ty2 m));
insist (pointer_type context == type_of (declare_function "Fn1" ty2 m));
insist (fn == declare_function "Fn1" ty m);
insist (None <> lookup_function "Fn1" m);
insist (match lookup_function "Fn1" m with Some x -> x = fn
@ -982,7 +983,7 @@ let test_builder () =
end;
group "casts"; begin
let void_ptr = pointer_type i8_type in
let void_ptr = pointer_type context in
(* CHECK-DAG: %build_trunc = trunc i32 %P1 to i8
* CHECK-DAG: %build_trunc2 = trunc i32 %P1 to i8
@ -1023,7 +1024,7 @@ let test_builder () =
ignore(build_zext_or_bitcast inst38 double_type "build_bitcast2" atentry);
ignore(build_sext_or_bitcast inst38 double_type "build_bitcast3" atentry);
ignore(build_trunc_or_bitcast inst38 double_type "build_bitcast4" atentry);
ignore(build_pointercast inst37 (pointer_type i16_type) "build_pointercast" atentry);
ignore(build_pointercast inst37 (pointer_type context) "build_pointercast" atentry);
ignore(build_zext_or_bitcast inst28 i32_type "build_zext2" atentry);
ignore(build_sext_or_bitcast inst29 i64_type "build_sext2" atentry);
@ -1060,13 +1061,13 @@ let test_builder () =
(* insist (Some Fcmp.True = fcmp_predicate c); *)
insist (None = icmp_predicate c);
let g0 = declare_global (pointer_type i8_type) "g0" m in
let g1 = declare_global (pointer_type i8_type) "g1" m in
let p0 = build_load2 (pointer_type i8_type) g0 "X0" atentry in
let p1 = build_load2 (pointer_type i8_type) g1 "X1" atentry in
let g0 = declare_global (pointer_type context) "g0" m in
let g1 = declare_global (pointer_type context) "g1" m in
let p0 = build_load (pointer_type context) g0 "X0" atentry in
let p1 = build_load (pointer_type context) g1 "X1" atentry in
ignore (build_is_null p0 "build_is_null" atentry);
ignore (build_is_not_null p1 "build_is_not_null" atentry);
ignore (build_ptrdiff2 i8_type p1 p0 "build_ptrdiff" atentry);
ignore (build_ptrdiff i8_type p1 p0 "build_ptrdiff" atentry);
end;
group "miscellaneous"; begin
@ -1079,7 +1080,7 @@ let test_builder () =
* CHECK: %build_insertvalue0 = insertvalue{{.*}}%bl, i32 1, 0
* CHECK: %build_extractvalue = extractvalue{{.*}}%build_insertvalue1, 1
*)
let ci = build_call2 fty fn [| p2; p1 |] "build_call" atentry in
let ci = build_call fty fn [| p2; p1 |] "build_call" atentry in
insist (CallConv.c = instruction_call_conv ci);
set_instruction_call_conv 63 ci;
insist (63 = instruction_call_conv ci);
@ -1107,7 +1108,7 @@ let test_builder () =
let inst46 = build_icmp Icmp.Eq p1 p2 "build_icmp" atentry in
ignore (build_select inst46 p1 p2 "build_select" atentry);
ignore (build_va_arg
(const_null (pointer_type (pointer_type i8_type)))
(const_null (pointer_type context))
i32_type "build_va_arg" atentry);
(* Set up some vector vregs. *)
@ -1125,7 +1126,7 @@ let test_builder () =
ignore (build_shufflevector vec1 vec2 t3 "build_shufflevector" atentry);
let p = build_alloca sty "ba" atentry in
let agg = build_load2 sty p "bl" atentry in
let agg = build_load sty p "bl" atentry in
let agg0 = build_insertvalue agg (const_int i32_type 1) 0
"build_insertvalue0" atentry in
let agg1 = build_insertvalue agg0 (const_int i8_type 2) 1
@ -1179,12 +1180,12 @@ let test_builder () =
(* see test/Feature/exception.ll *)
let bblpad = append_block context "Bblpad" fn in
let rt = struct_type context [| pointer_type i8_type; i32_type |] in
let rt = struct_type context [| pointer_type context; i32_type |] in
let ft = var_arg_function_type i32_type [||] in
let personality = declare_function "__gxx_personality_v0" ft m in
let ztic = declare_global (pointer_type i8_type) "_ZTIc" m in
let ztid = declare_global (pointer_type i8_type) "_ZTId" m in
let ztipkc = declare_global (pointer_type i8_type) "_ZTIPKc" m in
let ztic = declare_global (pointer_type context) "_ZTIc" m in
let ztid = declare_global (pointer_type context) "_ZTId" m in
let ztipkc = declare_global (pointer_type context) "_ZTIPKc" m in
begin
set_global_constant true ztic;
set_global_constant true ztid;
@ -1193,8 +1194,8 @@ let test_builder () =
(builder_at_end context bblpad) in begin
set_cleanup lp true;
add_clause lp ztic;
insist((pointer_type (pointer_type i8_type)) = type_of ztid);
let ety = pointer_type (pointer_type i8_type) in
insist((pointer_type context) = type_of ztid);
let ety = pointer_type context in
add_clause lp (const_array ety [| ztipkc; ztid |]);
ignore (build_resume lp (builder_at_end context bblpad));
end;
@ -1254,7 +1255,7 @@ let test_builder () =
* CHECK: call{{.*}}@malloc(i32 %
*)
let bb1 = append_block context "MallocBlock1" fn in
let m1 = (build_malloc (pointer_type i32_type) "m1"
let m1 = (build_malloc (pointer_type context) "m1"
(builder_at_end context bb1)) in
ignore (build_free m1 (builder_at_end context bb1));
ignore (build_array_malloc i32_type p1 "m2" (builder_at_end context bb1));
@ -1284,7 +1285,7 @@ let test_builder () =
*)
let bb04 = append_block context "Bb04" fn in
let b = builder_at_end context bb04 in
ignore (build_invoke2 fty fn [| p1; p2 |] bb04 bblpad "build_invoke" b)
ignore (build_invoke fty fn [| p1; p2 |] bb04 bblpad "build_invoke" b)
end;
group "unreachable"; begin
@ -1381,7 +1382,7 @@ let test_builder () =
let alloca = build_alloca i32_type "build_alloca" b in
let array_alloca = build_array_alloca i32_type p2 "build_array_alloca" b in
let load = build_load2 i32_type array_alloca "build_load" b in
let load = build_load i32_type array_alloca "build_load" b in
ignore(set_alignment 4 load);
ignore(set_volatile true load);
insist(true = is_volatile load);
@ -1392,13 +1393,13 @@ let test_builder () =
ignore(set_alignment 4 store);
insist(true = is_volatile store);
insist(4 = alignment store);
ignore(build_gep2 i32_type array_alloca [| p2 |] "build_gep" b);
ignore(build_in_bounds_gep2 i32_type array_alloca [| p2 |]
ignore(build_gep i32_type array_alloca [| p2 |] "build_gep" b);
ignore(build_in_bounds_gep i32_type array_alloca [| p2 |]
"build_in_bounds_gep" b);
let sty = struct_type context [| i32_type; i8_type |] in
let alloca2 = build_alloca sty "build_alloca2" b in
ignore(build_struct_gep2 sty alloca2 1 "build_struct_gep" b);
ignore(build_struct_gep sty alloca2 1 "build_struct_gep" b);
let p = build_alloca i8_type "p" b in
ignore(build_atomicrmw AtomicRMWBinOp.Xchg p (const_int i8_type 42)
@ -1411,7 +1412,7 @@ let test_builder () =
group "string"; begin
let bb09 = append_block context "Bb09" fn in
let b = builder_at_end context bb09 in
let p = build_alloca (pointer_type i8_type) "p" b in
let p = build_alloca (pointer_type context) "p" b in
(* build_global_string is emitted above.
* CHECK: store{{.*}}build_global_string1{{.*}}p
* *)

View File

@ -183,7 +183,7 @@ let test_bbinstr fty f f_di file_di dibuilder =
| Some file_of_f_di', Some file_of_scope' ->
file_of_f_di' = file_di && file_of_scope' = file_di
| _ -> false );
let foocall = Llvm.build_call2 fty foodecl [| arg0 |] "" builder in
let foocall = Llvm.build_call fty foodecl [| arg0 |] "" builder in
let foocall_loc =
Llvm_debuginfo.dibuild_create_debug_location context ~line:10 ~column:12
~scope

View File

@ -31,7 +31,7 @@ let define_getglobal m pg =
let fty = function_type i32_type [||] in
let fn = define_function "getglobal" fty m in
let b = builder_at_end (global_context ()) (entry_block fn) in
let g = build_call2 fty pg [||] "" b in
let g = build_call fty pg [||] "" b in
ignore (build_ret g b);
fn

View File

@ -43,7 +43,7 @@ let test_transforms () =
let fn2 = define_function "fn2" fty m in begin
ignore (build_ret (const_int i8_type 4) (builder_at_end context (entry_block fn)));
let b = builder_at_end context (entry_block fn2) in
ignore (build_ret (build_call2 fty fn [| |] "" b) b);
ignore (build_ret (build_call fty fn [| |] "" b) b);
end;
ignore (PassManager.create ()