mirror of
https://github.com/c64scene-ar/llvm-6502.git
synced 2024-12-13 20:32:21 +00:00
OCaml bindings: fix attributes to use all 32 bits
OCaml's int is limited to 31 bits on 32-bit architectures, so use Int32
explicitly.
Also add an unpack_attr, and {function,param,instr}_attr functions to read
the attributes.
git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@141996 91177308-0d34-0410-b5e6-96231b3b80d8
This commit is contained in:
Torok Edwin
parent
8da43bf60e
commit
0be167bab2
@ -94,6 +94,9 @@ module Attribute = struct
|
||||
| Naked
|
||||
| Inlinehint
|
||||
| Stackalignment of int
|
||||
| ReturnsTwice
|
||||
| UWTable
|
||||
| NonLazyBind
|
||||
end
|
||||
|
||||
module Icmp = struct
|
||||
@ -640,36 +643,81 @@ let rec fold_right_function_range f i e init =
|
||||
let fold_right_functions f m init =
|
||||
fold_right_function_range f (function_end m) (At_start m) init
|
||||
|
||||
external llvm_add_function_attr : llvalue -> int -> unit
|
||||
external llvm_add_function_attr : llvalue -> int32 -> unit
|
||||
= "llvm_add_function_attr"
|
||||
external llvm_remove_function_attr : llvalue -> int -> unit
|
||||
external llvm_remove_function_attr : llvalue -> int32 -> unit
|
||||
= "llvm_remove_function_attr"
|
||||
external llvm_function_attr : llvalue -> int32 = "llvm_function_attr"
|
||||
|
||||
let pack_attr (attr:Attribute.t) : int =
|
||||
let pack_attr (attr:Attribute.t) : int32 =
|
||||
match attr with
|
||||
Attribute.Zext -> 1 lsl 0
|
||||
| Attribute.Sext -> 1 lsl 1
|
||||
| Attribute.Noreturn -> 1 lsl 2
|
||||
| Attribute.Inreg -> 1 lsl 3
|
||||
| Attribute.Structret -> 1 lsl 4
|
||||
| Attribute.Nounwind -> 1 lsl 5
|
||||
| Attribute.Noalias -> 1 lsl 6
|
||||
| Attribute.Byval -> 1 lsl 7
|
||||
| Attribute.Nest -> 1 lsl 8
|
||||
| Attribute.Readnone -> 1 lsl 9
|
||||
| Attribute.Readonly -> 1 lsl 10
|
||||
| Attribute.Noinline -> 1 lsl 11
|
||||
| Attribute.Alwaysinline -> 1 lsl 12
|
||||
| Attribute.Optsize -> 1 lsl 13
|
||||
| Attribute.Ssp -> 1 lsl 14
|
||||
| Attribute.Sspreq -> 1 lsl 15
|
||||
| Attribute.Alignment n -> n lsl 16
|
||||
| Attribute.Nocapture -> 1 lsl 21
|
||||
| Attribute.Noredzone -> 1 lsl 22
|
||||
| Attribute.Noimplicitfloat -> 1 lsl 23
|
||||
| Attribute.Naked -> 1 lsl 24
|
||||
| Attribute.Inlinehint -> 1 lsl 25
|
||||
| Attribute.Stackalignment n -> n lsl 26
|
||||
Attribute.Zext -> Int32.shift_left 1l 0
|
||||
| Attribute.Sext -> Int32.shift_left 1l 1
|
||||
| Attribute.Noreturn -> Int32.shift_left 1l 2
|
||||
| Attribute.Inreg -> Int32.shift_left 1l 3
|
||||
| Attribute.Structret -> Int32.shift_left 1l 4
|
||||
| Attribute.Nounwind -> Int32.shift_left 1l 5
|
||||
| Attribute.Noalias -> Int32.shift_left 1l 6
|
||||
| Attribute.Byval -> Int32.shift_left 1l 7
|
||||
| Attribute.Nest -> Int32.shift_left 1l 8
|
||||
| Attribute.Readnone -> Int32.shift_left 1l 9
|
||||
| Attribute.Readonly -> Int32.shift_left 1l 10
|
||||
| Attribute.Noinline -> Int32.shift_left 1l 11
|
||||
| Attribute.Alwaysinline -> Int32.shift_left 1l 12
|
||||
| Attribute.Optsize -> Int32.shift_left 1l 13
|
||||
| Attribute.Ssp -> Int32.shift_left 1l 14
|
||||
| Attribute.Sspreq -> Int32.shift_left 1l 15
|
||||
| Attribute.Alignment n -> Int32.shift_left (Int32.of_int n) 16
|
||||
| Attribute.Nocapture -> Int32.shift_left 1l 21
|
||||
| Attribute.Noredzone -> Int32.shift_left 1l 22
|
||||
| Attribute.Noimplicitfloat -> Int32.shift_left 1l 23
|
||||
| Attribute.Naked -> Int32.shift_left 1l 24
|
||||
| Attribute.Inlinehint -> Int32.shift_left 1l 25
|
||||
| Attribute.Stackalignment n -> Int32.shift_left (Int32.of_int n) 26
|
||||
| Attribute.ReturnsTwice -> Int32.shift_left 1l 29
|
||||
| Attribute.UWTable -> Int32.shift_left 1l 30
|
||||
| Attribute.NonLazyBind -> Int32.shift_left 1l 31
|
||||
|
||||
let unpack_attr (a : int32) : Attribute.t list =
|
||||
let l = ref [] in
|
||||
let check attr =
|
||||
Int32.logand (pack_attr attr) a in
|
||||
let checkattr attr =
|
||||
if (check attr) <> 0l then begin
|
||||
l := attr :: !l
|
||||
end
|
||||
in
|
||||
checkattr Attribute.Zext;
|
||||
checkattr Attribute.Sext;
|
||||
checkattr Attribute.Noreturn;
|
||||
checkattr Attribute.Inreg;
|
||||
checkattr Attribute.Structret;
|
||||
checkattr Attribute.Nounwind;
|
||||
checkattr Attribute.Noalias;
|
||||
checkattr Attribute.Byval;
|
||||
checkattr Attribute.Nest;
|
||||
checkattr Attribute.Readnone;
|
||||
checkattr Attribute.Readonly;
|
||||
checkattr Attribute.Noinline;
|
||||
checkattr Attribute.Alwaysinline;
|
||||
checkattr Attribute.Optsize;
|
||||
checkattr Attribute.Ssp;
|
||||
checkattr Attribute.Sspreq;
|
||||
let align = Int32.logand (Int32.shift_right_logical a 16) 31l in
|
||||
if align <> 0l then
|
||||
l := Attribute.Alignment (Int32.to_int align) :: !l;
|
||||
checkattr Attribute.Nocapture;
|
||||
checkattr Attribute.Noredzone;
|
||||
checkattr Attribute.Noimplicitfloat;
|
||||
checkattr Attribute.Naked;
|
||||
checkattr Attribute.Inlinehint;
|
||||
let stackalign = Int32.logand (Int32.shift_right_logical a 26) 7l in
|
||||
if stackalign <> 0l then
|
||||
l := Attribute.Stackalignment (Int32.to_int stackalign) :: !l;
|
||||
checkattr Attribute.ReturnsTwice;
|
||||
checkattr Attribute.UWTable;
|
||||
checkattr Attribute.NonLazyBind;
|
||||
!l;;
|
||||
|
||||
let add_function_attr llval attr =
|
||||
llvm_add_function_attr llval (pack_attr attr)
|
||||
@ -677,9 +725,13 @@ let add_function_attr llval attr =
|
||||
let remove_function_attr llval attr =
|
||||
llvm_remove_function_attr llval (pack_attr attr)
|
||||
|
||||
let function_attr f = unpack_attr (llvm_function_attr f)
|
||||
|
||||
(*--... Operations on params ...............................................--*)
|
||||
external params : llvalue -> llvalue array = "llvm_params"
|
||||
external param : llvalue -> int -> llvalue = "llvm_param"
|
||||
external llvm_param_attr : llvalue -> int32 = "llvm_param_attr"
|
||||
let param_attr p = unpack_attr (llvm_param_attr p)
|
||||
external param_parent : llvalue -> llvalue = "LLVMGetParamParent"
|
||||
external param_begin : llvalue -> (llvalue, llvalue) llpos = "llvm_param_begin"
|
||||
external param_succ : llvalue -> (llvalue, llvalue) llpos = "llvm_param_succ"
|
||||
@ -726,9 +778,9 @@ let rec fold_right_param_range f init i e =
|
||||
let fold_right_params f fn init =
|
||||
fold_right_param_range f init (param_end fn) (At_start fn)
|
||||
|
||||
external llvm_add_param_attr : llvalue -> int -> unit
|
||||
external llvm_add_param_attr : llvalue -> int32 -> unit
|
||||
= "llvm_add_param_attr"
|
||||
external llvm_remove_param_attr : llvalue -> int -> unit
|
||||
external llvm_remove_param_attr : llvalue -> int32 -> unit
|
||||
= "llvm_remove_param_attr"
|
||||
|
||||
let add_param_attr llval attr =
|
||||
@ -864,9 +916,9 @@ external instruction_call_conv: llvalue -> int
|
||||
external set_instruction_call_conv: int -> llvalue -> unit
|
||||
= "llvm_set_instruction_call_conv"
|
||||
|
||||
external llvm_add_instruction_param_attr : llvalue -> int -> int -> unit
|
||||
external llvm_add_instruction_param_attr : llvalue -> int -> int32 -> unit
|
||||
= "llvm_add_instruction_param_attr"
|
||||
external llvm_remove_instruction_param_attr : llvalue -> int -> int -> unit
|
||||
external llvm_remove_instruction_param_attr : llvalue -> int -> int32 -> unit
|
||||
= "llvm_remove_instruction_param_attr"
|
||||
|
||||
let add_instruction_param_attr llval i attr =
|
||||
|
||||
@ -139,6 +139,9 @@ module Attribute : sig
|
||||
| Naked
|
||||
| Inlinehint
|
||||
| Stackalignment of int
|
||||
| ReturnsTwice
|
||||
| UWTable
|
||||
| NonLazyBind
|
||||
end
|
||||
|
||||
(** The predicate for an integer comparison ([icmp]) instruction.
|
||||
@ -1368,6 +1371,10 @@ val set_gc : string option -> llvalue -> unit
|
||||
[f]. *)
|
||||
val add_function_attr : llvalue -> Attribute.t -> unit
|
||||
|
||||
(** [function_attr f] returns the function attribute for the function [f].
|
||||
* See the method [llvm::Function::getAttributes] *)
|
||||
val function_attr : llvalue -> Attribute.t list
|
||||
|
||||
(** [remove_function_attr f a] removes attribute [a] from the return type of
|
||||
function [f]. *)
|
||||
val remove_function_attr : llvalue -> Attribute.t -> unit
|
||||
@ -1382,6 +1389,11 @@ val params : llvalue -> llvalue array
|
||||
See the method [llvm::Function::getArgumentList]. *)
|
||||
val param : llvalue -> int -> llvalue
|
||||
|
||||
(** [param_attr p] returns the attributes of parameter [p].
|
||||
* See the methods [llvm::Function::getAttributes] and
|
||||
* [llvm::Attributes::getParamAttributes] *)
|
||||
val param_attr : llvalue -> Attribute.t list
|
||||
|
||||
(** [param_parent p] returns the parent function that owns the parameter.
|
||||
See the method [llvm::Argument::getParent]. *)
|
||||
val param_parent : llvalue -> llvalue
|
||||
|
||||
@ -1034,15 +1034,22 @@ CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
/* llvalue -> Attribute.t -> unit */
|
||||
/* llvalue -> int32 -> unit */
|
||||
CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
|
||||
LLVMAddFunctionAttr(Arg, Int_val(PA));
|
||||
LLVMAddFunctionAttr(Arg, Int32_val(PA));
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
/* llvalue -> Attribute.t -> unit */
|
||||
/* llvalue -> int32 */
|
||||
CAMLprim value llvm_function_attr(LLVMValueRef Fn)
|
||||
{
|
||||
CAMLparam0();
|
||||
CAMLreturn(caml_copy_int32(LLVMGetFunctionAttr(Fn)));
|
||||
}
|
||||
|
||||
/* llvalue -> int32 -> unit */
|
||||
CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
|
||||
LLVMRemoveFunctionAttr(Arg, Int_val(PA));
|
||||
LLVMRemoveFunctionAttr(Arg, Int32_val(PA));
|
||||
return Val_unit;
|
||||
}
|
||||
/*--... Operations on parameters ...........................................--*/
|
||||
@ -1054,6 +1061,13 @@ CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
|
||||
return LLVMGetParam(Fn, Int_val(Index));
|
||||
}
|
||||
|
||||
/* llvalue -> int */
|
||||
CAMLprim value llvm_param_attr(LLVMValueRef Param)
|
||||
{
|
||||
CAMLparam0();
|
||||
CAMLreturn(caml_copy_int32(LLVMGetAttribute(Param)));
|
||||
}
|
||||
|
||||
/* llvalue -> llvalue */
|
||||
CAMLprim value llvm_params(LLVMValueRef Fn) {
|
||||
value Params = alloc(LLVMCountParams(Fn), 0);
|
||||
@ -1061,15 +1075,15 @@ CAMLprim value llvm_params(LLVMValueRef Fn) {
|
||||
return Params;
|
||||
}
|
||||
|
||||
/* llvalue -> Attribute.t -> unit */
|
||||
/* llvalue -> int32 -> unit */
|
||||
CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
|
||||
LLVMAddAttribute(Arg, Int_val(PA));
|
||||
LLVMAddAttribute(Arg, Int32_val(PA));
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
/* llvalue -> Attribute.t -> unit */
|
||||
/* llvalue -> int32 -> unit */
|
||||
CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
|
||||
LLVMRemoveAttribute(Arg, Int_val(PA));
|
||||
LLVMRemoveAttribute(Arg, Int32_val(PA));
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
@ -1155,19 +1169,19 @@ CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
/* llvalue -> int -> Attribute.t -> unit */
|
||||
/* llvalue -> int -> int32 -> unit */
|
||||
CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
|
||||
value index,
|
||||
value PA) {
|
||||
LLVMAddInstrAttribute(Instr, Int_val(index), Int_val(PA));
|
||||
LLVMAddInstrAttribute(Instr, Int_val(index), Int32_val(PA));
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
/* llvalue -> int -> Attribute.t -> unit */
|
||||
/* llvalue -> int -> int32 -> unit */
|
||||
CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
|
||||
value index,
|
||||
value PA) {
|
||||
LLVMRemoveInstrAttribute(Instr, Int_val(index), Int_val(PA));
|
||||
LLVMRemoveInstrAttribute(Instr, Int_val(index), Int32_val(PA));
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user