replica
/
hanchenye-llvm-project
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

add attributes and module level asm to the ocaml bindings, 

patch by Patrick Walton!

llvm-svn: 100932
This commit is contained in:
Chris Lattner 2010-04-10 17:52:58 +00:00
parent 6e444c07b7
commit 2694145e2e
5 changed files with 93 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
llvm/bindings/ocaml/llvm/llvm.ml
View File

@ -90,13 +90,13 @@ module Attribute = struct
| Optsize
| Ssp
| Sspreq
| Alignment
| Alignment of int
| Nocapture
| Noredzone
| Noimplicitfloat
| Naked
| Inlinehint
| Stackalignment
| Stackalignment of int
end
module Icmp = struct
@ -170,6 +170,8 @@ external delete_type_name : string -> llmodule -> unit
external type_by_name : llmodule -> string -> lltype option
= "llvm_type_by_name"
external dump_module : llmodule -> unit = "llvm_dump_module"
external set_module_inline_asm : llmodule -> string -> unit
= "llvm_set_module_inline_asm"
(*===-- Types -------------------------------------------------------------===*)
external classify_type : lltype -> TypeKind.t = "llvm_classify_type"
@ -548,10 +550,42 @@ 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 add_function_attr : llvalue -> Attribute.t -> unit
= "llvm_add_function_attr"
external remove_function_attr : llvalue -> Attribute.t -> unit
= "llvm_remove_function_attr"
external llvm_add_function_attr : llvalue -> int -> unit
= "llvm_add_function_attr"
external llvm_remove_function_attr : llvalue -> int -> unit
= "llvm_remove_function_attr"
let pack_attr (attr:Attribute.t) : int =
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
let add_function_attr llval attr =
llvm_add_function_attr llval (pack_attr attr)
let remove_function_attr llval attr =
llvm_remove_function_attr llval (pack_attr attr)
(*--... Operations on params ...............................................--*)
external params : llvalue -> llvalue array = "llvm_params"
@ -602,10 +636,17 @@ 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 add_param_attr : llvalue -> Attribute.t -> unit
= "llvm_add_param_attr"
external remove_param_attr : llvalue -> Attribute.t -> unit
= "llvm_remove_param_attr"
external llvm_add_param_attr : llvalue -> int -> unit
= "llvm_add_param_attr"
external llvm_remove_param_attr : llvalue -> int -> unit
= "llvm_remove_param_attr"
let add_param_attr llval attr =
llvm_add_param_attr llval (pack_attr attr)
let remove_param_attr llval attr =
llvm_remove_param_attr llval (pack_attr attr)
external set_param_alignment : llvalue -> int -> unit
= "llvm_set_param_alignment"
@ -727,10 +768,17 @@ external instruction_call_conv: llvalue -> int
= "llvm_instruction_call_conv"
external set_instruction_call_conv: int -> llvalue -> unit
= "llvm_set_instruction_call_conv"
external add_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
= "llvm_add_instruction_param_attr"
external remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
= "llvm_remove_instruction_param_attr"
external llvm_add_instruction_param_attr : llvalue -> int -> int -> unit
= "llvm_add_instruction_param_attr"
external llvm_remove_instruction_param_attr : llvalue -> int -> int -> unit
= "llvm_remove_instruction_param_attr"
let add_instruction_param_attr llval i attr =
llvm_add_instruction_param_attr llval i (pack_attr attr)
let remove_instruction_param_attr llval i attr =
llvm_remove_instruction_param_attr llval i (pack_attr attr)
(*--... Operations on call instructions (only) .............................--*)
external is_tail_call : llvalue -> bool = "llvm_is_tail_call"

26
llvm/bindings/ocaml/llvm/llvm.mli
View File

@ -139,13 +139,13 @@ module Attribute : sig
| Optsize
| Ssp
| Sspreq
| Alignment
| Alignment of int
| Nocapture
| Noredzone
| Noimplicitfloat
| Naked
| Inlinehint
| Stackalignment
| Stackalignment of int
end
(** The predicate for an integer comparison ([icmp]) instruction.
@ -284,6 +284,11 @@ external type_by_name : llmodule -> string -> lltype option
error. See the method [llvm::Module::dump]. *)
external dump_module : llmodule -> unit = "llvm_dump_module"
(** [set_module_inline_asm m asm] sets the inline assembler for the module. See
the method [llvm::Module::setModuleInlineAsm]. *)
external set_module_inline_asm : llmodule -> string -> unit
= "llvm_set_module_inline_asm"
(** {6 Types} *)
@ -1282,13 +1287,11 @@ external set_gc : string option -> llvalue -> unit = "llvm_set_gc"
(** [add_function_attr f a] adds attribute [a] to the return type of function
[f]. *)
external add_function_attr : llvalue -> Attribute.t -> unit
= "llvm_add_function_attr"
val add_function_attr : llvalue -> Attribute.t -> unit
(** [remove_function_attr f a] removes attribute [a] from the return type of
function [f]. *)
external remove_function_attr : llvalue -> Attribute.t -> unit
= "llvm_remove_function_attr"
val remove_function_attr : llvalue -> Attribute.t -> unit
(** {7 Operations on params} *)
@ -1343,11 +1346,10 @@ val rev_iter_params : (llvalue -> unit) -> llvalue -> unit
val fold_right_params : (llvalue -> 'a -> 'a) -> llvalue -> 'a -> 'a
(** [add_param p a] adds attribute [a] to parameter [p]. *)
external add_param_attr : llvalue -> Attribute.t -> unit = "llvm_add_param_attr"
val add_param_attr : llvalue -> Attribute.t -> unit
(** [remove_param_attr p a] removes attribute [a] from parameter [p]. *)
external remove_param_attr : llvalue -> Attribute.t -> unit
= "llvm_remove_param_attr"
val remove_param_attr : llvalue -> Attribute.t -> unit
(** [set_param_alignment p a] set the alignment of parameter [p] to [a]. *)
external set_param_alignment : llvalue -> int -> unit
@ -1499,14 +1501,12 @@ external set_instruction_call_conv: int -> llvalue -> unit
(** [add_instruction_param_attr ci i a] adds attribute [a] to the [i]th
parameter of the call or invoke instruction [ci]. [i]=0 denotes the return
value. *)
external add_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
= "llvm_add_instruction_param_attr"
val add_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
(** [remove_instruction_param_attr ci i a] removes attribute [a] from the
[i]th parameter of the call or invoke instruction [ci]. [i]=0 denotes the
return value. *)
external remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
= "llvm_remove_instruction_param_attr"
val remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
(** {Operations on call instructions (only)} *)

17
llvm/bindings/ocaml/llvm/llvm_ocaml.c
View File

@ -182,6 +182,11 @@ CAMLprim value llvm_dump_module(LLVMModuleRef M) {
return Val_unit;
}
/* llmodule -> string -> unit */
CAMLprim value llvm_set_module_inline_asm(LLVMModuleRef M, value Asm) {
LLVMSetModuleInlineAsm(M, String_val(Asm));
return Val_unit;
}
/*===-- Types -------------------------------------------------------------===*/
@ -941,13 +946,13 @@ CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
/* llvalue -> Attribute.t -> unit */
CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
LLVMAddFunctionAttr(Arg, 1<<Int_val(PA));
LLVMAddFunctionAttr(Arg, Int_val(PA));
return Val_unit;
}
/* llvalue -> Attribute.t -> unit */
CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
LLVMRemoveFunctionAttr(Arg, 1<<Int_val(PA));
LLVMRemoveFunctionAttr(Arg, Int_val(PA));
return Val_unit;
}
/*--... Operations on parameters ...........................................--*/
@ -968,13 +973,13 @@ CAMLprim value llvm_params(LLVMValueRef Fn, value Index) {
/* llvalue -> Attribute.t -> unit */
CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
LLVMAddAttribute(Arg, 1<<Int_val(PA));
LLVMAddAttribute(Arg, Int_val(PA));
return Val_unit;
}
/* llvalue -> Attribute.t -> unit */
CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
LLVMRemoveAttribute(Arg, 1<<Int_val(PA));
LLVMRemoveAttribute(Arg, Int_val(PA));
return Val_unit;
}
@ -1042,7 +1047,7 @@ CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
value index,
value PA) {
LLVMAddInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
LLVMAddInstrAttribute(Instr, Int_val(index), Int_val(PA));
return Val_unit;
}
@ -1050,7 +1055,7 @@ CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
value index,
value PA) {
LLVMRemoveInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
LLVMRemoveInstrAttribute(Instr, Int_val(index), Int_val(PA));
return Val_unit;
}

2
llvm/include/llvm-c/Core.h
View File

@ -319,6 +319,8 @@ LLVMTypeRef LLVMGetTypeByName(LLVMModuleRef M, const char *Name);
/** See Module::dump. */
void LLVMDumpModule(LLVMModuleRef M);
/** See Module::setModuleInlineAsm. */
void LLVMSetModuleInlineAsm(LLVMModuleRef M, const char *Asm);
/*===-- Types -------------------------------------------------------------===*/

5
llvm/lib/VMCore/Core.cpp
View File

@ -119,6 +119,11 @@ void LLVMDumpModule(LLVMModuleRef M) {
unwrap(M)->dump();
}
/*--.. Operations on inline assembler ......................................--*/
void LLVMSetModuleInlineAsm(LLVMModuleRef M, const char *Asm) {
unwrap(M)->setModuleInlineAsm(StringRef(Asm));
}
/*===-- Operations on types -----------------------------------------------===*/