Skip to content

Commit

Permalink
add attributes and module level asm to the ocaml bindings,
Browse files Browse the repository at this point in the history
patch by Patrick Walton!


git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@100932 91177308-0d34-0410-b5e6-96231b3b80d8
  • Loading branch information
lattner committed Apr 10, 2010
1 parent 35a3d3f commit 0941534
Show file tree
Hide file tree
Showing 5 changed files with 93 additions and 33 deletions.
76 changes: 62 additions & 14 deletions bindings/ocaml/llvm/llvm.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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"

Expand Down Expand Up @@ -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"
Expand Down
26 changes: 13 additions & 13 deletions bindings/ocaml/llvm/llvm.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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} *)

Expand Down Expand Up @@ -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} *)

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)} *)

Expand Down
17 changes: 11 additions & 6 deletions bindings/ocaml/llvm/llvm_ocaml.c
Original file line number Diff line number Diff line change
Expand Up @@ -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 -------------------------------------------------------------===*/

Expand Down Expand Up @@ -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 ...........................................--*/
Expand All @@ -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;
}

Expand Down Expand Up @@ -1042,15 +1047,15 @@ 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;
}

/* llvalue -> int -> Attribute.t -> unit */
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;
}

Expand Down
2 changes: 2 additions & 0 deletions include/llvm-c/Core.h
Original file line number Diff line number Diff line change
Expand Up @@ -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 -------------------------------------------------------------===*/

Expand Down
5 changes: 5 additions & 0 deletions lib/VMCore/Core.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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 -----------------------------------------------===*/

Expand Down

0 comments on commit 0941534

Please sign in to comment.