+external gc : llvalue -> string option = "llvm_gc"
+external set_gc : string option -> llvalue -> unit = "llvm_set_gc"
+external function_begin : llmodule -> (llmodule, llvalue) llpos
+ = "llvm_function_begin"
+external function_succ : llvalue -> (llmodule, llvalue) llpos
+ = "llvm_function_succ"
+external function_end : llmodule -> (llmodule, llvalue) llrev_pos
+ = "llvm_function_end"
+external function_pred : llvalue -> (llmodule, llvalue) llrev_pos
+ = "llvm_function_pred"
+
+let rec iter_function_range f i e =
+ if i = e then () else
+ match i with
+ | At_end _ -> raise (Invalid_argument "Invalid function range.")
+ | Before fn ->
+ f fn;
+ iter_function_range f (function_succ fn) e
+
+let iter_functions f m =
+ iter_function_range f (function_begin m) (At_end m)
+
+let rec fold_left_function_range f init i e =
+ if i = e then init else
+ match i with
+ | At_end _ -> raise (Invalid_argument "Invalid function range.")
+ | Before fn -> fold_left_function_range f (f init fn) (function_succ fn) e
+
+let fold_left_functions f init m =
+ fold_left_function_range f init (function_begin m) (At_end m)
+
+let rec rev_iter_function_range f i e =
+ if i = e then () else
+ match i with
+ | At_start _ -> raise (Invalid_argument "Invalid function range.")
+ | After fn ->
+ f fn;
+ rev_iter_function_range f (function_pred fn) e
+
+let rev_iter_functions f m =
+ rev_iter_function_range f (function_end m) (At_start m)
+
+let rec fold_right_function_range f i e init =
+ if i = e then init else
+ match i with
+ | At_start _ -> raise (Invalid_argument "Invalid function range.")
+ | After fn -> fold_right_function_range f (function_pred fn) e (f fn 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 -> int32 -> unit
+ = "llvm_add_function_attr"
+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) : int32 =
+ match attr with
+ 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;;