llvm.org GIT mirror llvm / 0be167b
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 Torok Edwin 7 years ago
3 changed file(s) with 130 addition(s) and 52 deletion(s). Raw diff Collapse all Expand all
9393 | Naked
9494 | Inlinehint
9595 | Stackalignment of int
96 | ReturnsTwice
97 | UWTable
98 | NonLazyBind
9699 end
97100
98101 module Icmp = struct
639642 let fold_right_functions f m init =
640643 fold_right_function_range f (function_end m) (At_start m) init
641644
642 external llvm_add_function_attr : llvalue -> int -> unit
645 external llvm_add_function_attr : llvalue -> int32 -> unit
643646 = "llvm_add_function_attr"
644 external llvm_remove_function_attr : llvalue -> int -> unit
647 external llvm_remove_function_attr : llvalue -> int32 -> unit
645648 = "llvm_remove_function_attr"
646
647 let pack_attr (attr:Attribute.t) : int =
649 external llvm_function_attr : llvalue -> int32 = "llvm_function_attr"
650
651 let pack_attr (attr:Attribute.t) : int32 =
648652 match attr with
649 Attribute.Zext -> 1 lsl 0
650 | Attribute.Sext -> 1 lsl 1
651 | Attribute.Noreturn -> 1 lsl 2
652 | Attribute.Inreg -> 1 lsl 3
653 | Attribute.Structret -> 1 lsl 4
654 | Attribute.Nounwind -> 1 lsl 5
655 | Attribute.Noalias -> 1 lsl 6
656 | Attribute.Byval -> 1 lsl 7
657 | Attribute.Nest -> 1 lsl 8
658 | Attribute.Readnone -> 1 lsl 9
659 | Attribute.Readonly -> 1 lsl 10
660 | Attribute.Noinline -> 1 lsl 11
661 | Attribute.Alwaysinline -> 1 lsl 12
662 | Attribute.Optsize -> 1 lsl 13
663 | Attribute.Ssp -> 1 lsl 14
664 | Attribute.Sspreq -> 1 lsl 15
665 | Attribute.Alignment n -> n lsl 16
666 | Attribute.Nocapture -> 1 lsl 21
667 | Attribute.Noredzone -> 1 lsl 22
668 | Attribute.Noimplicitfloat -> 1 lsl 23
669 | Attribute.Naked -> 1 lsl 24
670 | Attribute.Inlinehint -> 1 lsl 25
671 | Attribute.Stackalignment n -> n lsl 26
653 Attribute.Zext -> Int32.shift_left 1l 0
654 | Attribute.Sext -> Int32.shift_left 1l 1
655 | Attribute.Noreturn -> Int32.shift_left 1l 2
656 | Attribute.Inreg -> Int32.shift_left 1l 3
657 | Attribute.Structret -> Int32.shift_left 1l 4
658 | Attribute.Nounwind -> Int32.shift_left 1l 5
659 | Attribute.Noalias -> Int32.shift_left 1l 6
660 | Attribute.Byval -> Int32.shift_left 1l 7
661 | Attribute.Nest -> Int32.shift_left 1l 8
662 | Attribute.Readnone -> Int32.shift_left 1l 9
663 | Attribute.Readonly -> Int32.shift_left 1l 10
664 | Attribute.Noinline -> Int32.shift_left 1l 11
665 | Attribute.Alwaysinline -> Int32.shift_left 1l 12
666 | Attribute.Optsize -> Int32.shift_left 1l 13
667 | Attribute.Ssp -> Int32.shift_left 1l 14
668 | Attribute.Sspreq -> Int32.shift_left 1l 15
669 | Attribute.Alignment n -> Int32.shift_left (Int32.of_int n) 16
670 | Attribute.Nocapture -> Int32.shift_left 1l 21
671 | Attribute.Noredzone -> Int32.shift_left 1l 22
672 | Attribute.Noimplicitfloat -> Int32.shift_left 1l 23
673 | Attribute.Naked -> Int32.shift_left 1l 24
674 | Attribute.Inlinehint -> Int32.shift_left 1l 25
675 | Attribute.Stackalignment n -> Int32.shift_left (Int32.of_int n) 26
676 | Attribute.ReturnsTwice -> Int32.shift_left 1l 29
677 | Attribute.UWTable -> Int32.shift_left 1l 30
678 | Attribute.NonLazyBind -> Int32.shift_left 1l 31
679
680 let unpack_attr (a : int32) : Attribute.t list =
681 let l = ref [] in
682 let check attr =
683 Int32.logand (pack_attr attr) a in
684 let checkattr attr =
685 if (check attr) <> 0l then begin
686 l := attr :: !l
687 end
688 in
689 checkattr Attribute.Zext;
690 checkattr Attribute.Sext;
691 checkattr Attribute.Noreturn;
692 checkattr Attribute.Inreg;
693 checkattr Attribute.Structret;
694 checkattr Attribute.Nounwind;
695 checkattr Attribute.Noalias;
696 checkattr Attribute.Byval;
697 checkattr Attribute.Nest;
698 checkattr Attribute.Readnone;
699 checkattr Attribute.Readonly;
700 checkattr Attribute.Noinline;
701 checkattr Attribute.Alwaysinline;
702 checkattr Attribute.Optsize;
703 checkattr Attribute.Ssp;
704 checkattr Attribute.Sspreq;
705 let align = Int32.logand (Int32.shift_right_logical a 16) 31l in
706 if align <> 0l then
707 l := Attribute.Alignment (Int32.to_int align) :: !l;
708 checkattr Attribute.Nocapture;
709 checkattr Attribute.Noredzone;
710 checkattr Attribute.Noimplicitfloat;
711 checkattr Attribute.Naked;
712 checkattr Attribute.Inlinehint;
713 let stackalign = Int32.logand (Int32.shift_right_logical a 26) 7l in
714 if stackalign <> 0l then
715 l := Attribute.Stackalignment (Int32.to_int stackalign) :: !l;
716 checkattr Attribute.ReturnsTwice;
717 checkattr Attribute.UWTable;
718 checkattr Attribute.NonLazyBind;
719 !l;;
672720
673721 let add_function_attr llval attr =
674722 llvm_add_function_attr llval (pack_attr attr)
675723
676724 let remove_function_attr llval attr =
677725 llvm_remove_function_attr llval (pack_attr attr)
726
727 let function_attr f = unpack_attr (llvm_function_attr f)
678728
679729 (*--... Operations on params ...............................................--*)
680730 external params : llvalue -> llvalue array = "llvm_params"
681731 external param : llvalue -> int -> llvalue = "llvm_param"
732 external llvm_param_attr : llvalue -> int32 = "llvm_param_attr"
733 let param_attr p = unpack_attr (llvm_param_attr p)
682734 external param_parent : llvalue -> llvalue = "LLVMGetParamParent"
683735 external param_begin : llvalue -> (llvalue, llvalue) llpos = "llvm_param_begin"
684736 external param_succ : llvalue -> (llvalue, llvalue) llpos = "llvm_param_succ"
725777 let fold_right_params f fn init =
726778 fold_right_param_range f init (param_end fn) (At_start fn)
727779
728 external llvm_add_param_attr : llvalue -> int -> unit
780 external llvm_add_param_attr : llvalue -> int32 -> unit
729781 = "llvm_add_param_attr"
730 external llvm_remove_param_attr : llvalue -> int -> unit
782 external llvm_remove_param_attr : llvalue -> int32 -> unit
731783 = "llvm_remove_param_attr"
732784
733785 let add_param_attr llval attr =
863915 external set_instruction_call_conv: int -> llvalue -> unit
864916 = "llvm_set_instruction_call_conv"
865917
866 external llvm_add_instruction_param_attr : llvalue -> int -> int -> unit
918 external llvm_add_instruction_param_attr : llvalue -> int -> int32 -> unit
867919 = "llvm_add_instruction_param_attr"
868 external llvm_remove_instruction_param_attr : llvalue -> int -> int -> unit
920 external llvm_remove_instruction_param_attr : llvalue -> int -> int32 -> unit
869921 = "llvm_remove_instruction_param_attr"
870922
871923 let add_instruction_param_attr llval i attr =
138138 | Naked
139139 | Inlinehint
140140 | Stackalignment of int
141 | ReturnsTwice
142 | UWTable
143 | NonLazyBind
141144 end
142145
143146 (** The predicate for an integer comparison ([icmp]) instruction.
13671370 [f]. *)
13681371 val add_function_attr : llvalue -> Attribute.t -> unit
13691372
1373 (** [function_attr f] returns the function attribute for the function [f].
1374 * See the method [llvm::Function::getAttributes] *)
1375 val function_attr : llvalue -> Attribute.t list
1376
13701377 (** [remove_function_attr f a] removes attribute [a] from the return type of
13711378 function [f]. *)
13721379 val remove_function_attr : llvalue -> Attribute.t -> unit
13801387 (** [param f n] returns the [n]th parameter of function [f].
13811388 See the method [llvm::Function::getArgumentList]. *)
13821389 val param : llvalue -> int -> llvalue
1390
1391 (** [param_attr p] returns the attributes of parameter [p].
1392 * See the methods [llvm::Function::getAttributes] and
1393 * [llvm::Attributes::getParamAttributes] *)
1394 val param_attr : llvalue -> Attribute.t list
13831395
13841396 (** [param_parent p] returns the parent function that owns the parameter.
13851397 See the method [llvm::Argument::getParent]. *)
10331033 return Val_unit;
10341034 }
10351035
1036 /* llvalue -> Attribute.t -> unit */
1036 /* llvalue -> int32 -> unit */
10371037 CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
1038 LLVMAddFunctionAttr(Arg, Int_val(PA));
1039 return Val_unit;
1040 }
1041
1042 /* llvalue -> Attribute.t -> unit */
1038 LLVMAddFunctionAttr(Arg, Int32_val(PA));
1039 return Val_unit;
1040 }
1041
1042 /* llvalue -> int32 */
1043 CAMLprim value llvm_function_attr(LLVMValueRef Fn)
1044 {
1045 CAMLparam0();
1046 CAMLreturn(caml_copy_int32(LLVMGetFunctionAttr(Fn)));
1047 }
1048
1049 /* llvalue -> int32 -> unit */
10431050 CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
1044 LLVMRemoveFunctionAttr(Arg, Int_val(PA));
1051 LLVMRemoveFunctionAttr(Arg, Int32_val(PA));
10451052 return Val_unit;
10461053 }
10471054 /*--... Operations on parameters ...........................................--*/
10511058 /* llvalue -> int -> llvalue */
10521059 CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
10531060 return LLVMGetParam(Fn, Int_val(Index));
1061 }
1062
1063 /* llvalue -> int */
1064 CAMLprim value llvm_param_attr(LLVMValueRef Param)
1065 {
1066 CAMLparam0();
1067 CAMLreturn(caml_copy_int32(LLVMGetAttribute(Param)));
10541068 }
10551069
10561070 /* llvalue -> llvalue */
10601074 return Params;
10611075 }
10621076
1063 /* llvalue -> Attribute.t -> unit */
1077 /* llvalue -> int32 -> unit */
10641078 CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
1065 LLVMAddAttribute(Arg, Int_val(PA));
1066 return Val_unit;
1067 }
1068
1069 /* llvalue -> Attribute.t -> unit */
1079 LLVMAddAttribute(Arg, Int32_val(PA));
1080 return Val_unit;
1081 }
1082
1083 /* llvalue -> int32 -> unit */
10701084 CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
1071 LLVMRemoveAttribute(Arg, Int_val(PA));
1085 LLVMRemoveAttribute(Arg, Int32_val(PA));
10721086 return Val_unit;
10731087 }
10741088
11541168 return Val_unit;
11551169 }
11561170
1157 /* llvalue -> int -> Attribute.t -> unit */
1171 /* llvalue -> int -> int32 -> unit */
11581172 CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
11591173 value index,
11601174 value PA) {
1161 LLVMAddInstrAttribute(Instr, Int_val(index), Int_val(PA));
1162 return Val_unit;
1163 }
1164
1165 /* llvalue -> int -> Attribute.t -> unit */
1175 LLVMAddInstrAttribute(Instr, Int_val(index), Int32_val(PA));
1176 return Val_unit;
1177 }
1178
1179 /* llvalue -> int -> int32 -> unit */
11661180 CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
11671181 value index,
11681182 value PA) {
1169 LLVMRemoveInstrAttribute(Instr, Int_val(index), Int_val(PA));
1183 LLVMRemoveInstrAttribute(Instr, Int_val(index), Int32_val(PA));
11701184 return Val_unit;
11711185 }
11721186