X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=blobdiff_plain;f=bindings%2Focaml%2Ftarget%2Fllvm_target.mli;h=676bc613c649c4b21c86d29f5b881ba17c246dad;hp=a82e1b684fadb4c29a2ceafa1b852641940541ce;hb=0357f8735ed3f102248961dbc5fa48f2f21e395e;hpb=777d2306b36816a53bc1ae1244c0dc7d998ae691 diff --git a/bindings/ocaml/target/llvm_target.mli b/bindings/ocaml/target/llvm_target.mli index a82e1b684fa..676bc613c64 100644 --- a/bindings/ocaml/target/llvm_target.mli +++ b/bindings/ocaml/target/llvm_target.mli @@ -1,4 +1,4 @@ -(*===-- llvm_target.mli - LLVM Ocaml Interface -----------------*- OCaml -*-===* +(*===-- llvm_target.mli - LLVM OCaml Interface -----------------*- OCaml -*-===* * * The LLVM Compiler Infrastructure * @@ -9,7 +9,7 @@ (** Target Information. - This interface provides an ocaml API for LLVM target information, + This interface provides an OCaml API for LLVM target information, the classes in the Target library. *) module Endian : sig @@ -18,85 +18,209 @@ module Endian : sig | Little end -module TargetData : sig +module CodeGenOptLevel : sig + type t = + | None + | Less + | Default + | Aggressive +end + +module RelocMode : sig + type t = + | Default + | Static + | PIC + | DynamicNoPIC +end + +module CodeModel : sig + type t = + | Default + | JITDefault + | Small + | Kernel + | Medium + | Large +end + +module CodeGenFileType : sig + type t = + | AssemblyFile + | ObjectFile +end + +(** {6 Exceptions} *) + +exception Error of string + +(** {6 Data Layout} *) + +module DataLayout : sig type t - (** [TargetData.create rep] parses the target data string representation [rep]. - See the constructor llvm::TargetData::TargetData. *) - external create : string -> t = "llvm_targetdata_create" - - (** [add_target_data td pm] adds the target data [td] to the pass manager [pm]. - Does not take ownership of the target data. - See the method llvm::PassManagerBase::add. *) - external add : t -> [ unit - = "llvm_targetdata_add" - - (** [as_string td] is the string representation of the target data [td]. - See the constructor llvm::TargetData::TargetData. *) - external as_string : t -> string = "llvm_targetdata_as_string" - - (** Struct layouts are speculatively cached. If a TargetDataRef is alive when - types are being refined and removed, this method must be called whenever a - struct type is removed to avoid a dangling pointer in this cache. - See the method llvm::TargetData::InvalidateStructLayoutInfo. *) - external invalidate_struct_layout : t -> Llvm.lltype -> unit - = "llvm_targetdata_invalidate_struct_layout" - - (** Deallocates a TargetData. - See the destructor llvm::TargetData::~TargetData. *) - external dispose : t -> unit = "llvm_targetdata_dispose" + (** [of_string rep] parses the data layout string representation [rep]. + See the constructor [llvm::DataLayout::DataLayout]. *) + val of_string : string -> t + + (** [as_string dl] is the string representation of the data layout [dl]. + See the method [llvm::DataLayout::getStringRepresentation]. *) + val as_string : t -> string + + (** [add_to_pass_manager pm dl] adds the data layout [dl] to + the pass manager [pm]. + See the method [llvm::PassManagerBase::add]. *) + val add_to_pass_manager : [ + t -> unit + + (** Returns the byte order of a target, either [Endian.Big] or + [Endian.Little]. + See the method [llvm::DataLayout::isLittleEndian]. *) + val byte_order : t -> Endian.t + + (** Returns the pointer size in bytes for a target. + See the method [llvm::DataLayout::getPointerSize]. *) + val pointer_size : t -> int + + (** Returns the integer type that is the same size as a pointer on a target. + See the method [llvm::DataLayout::getIntPtrType]. *) + val intptr_type : Llvm.llcontext -> t -> Llvm.lltype + + (** Returns the pointer size in bytes for a target in a given address space. + See the method [llvm::DataLayout::getPointerSize]. *) + val qualified_pointer_size : int -> t -> int + + (** Returns the integer type that is the same size as a pointer on a target + in a given address space. + See the method [llvm::DataLayout::getIntPtrType]. *) + val qualified_intptr_type : Llvm.llcontext -> int -> t -> Llvm.lltype + + (** Computes the size of a type in bits for a target. + See the method [llvm::DataLayout::getTypeSizeInBits]. *) + val size_in_bits : Llvm.lltype -> t -> Int64.t + + (** Computes the storage size of a type in bytes for a target. + See the method [llvm::DataLayout::getTypeStoreSize]. *) + val store_size : Llvm.lltype -> t -> Int64.t + + (** Computes the ABI size of a type in bytes for a target. + See the method [llvm::DataLayout::getTypeAllocSize]. *) + val abi_size : Llvm.lltype -> t -> Int64.t + + (** Computes the ABI alignment of a type in bytes for a target. + See the method [llvm::DataLayout::getTypeABISize]. *) + val abi_align : Llvm.lltype -> t -> int + + (** Computes the call frame alignment of a type in bytes for a target. + See the method [llvm::DataLayout::getTypeABISize]. *) + val stack_align : Llvm.lltype -> t -> int + + (** Computes the preferred alignment of a type in bytes for a target. + See the method [llvm::DataLayout::getTypeABISize]. *) + val preferred_align : Llvm.lltype -> t -> int + + (** Computes the preferred alignment of a global variable in bytes for + a target. See the method [llvm::DataLayout::getPreferredAlignment]. *) + val preferred_align_of_global : Llvm.llvalue -> t -> int + + (** Computes the structure element that contains the byte offset for a target. + See the method [llvm::StructLayout::getElementContainingOffset]. *) + val element_at_offset : Llvm.lltype -> Int64.t -> t -> int + + (** Computes the byte offset of the indexed struct element for a target. + See the method [llvm::StructLayout::getElementContainingOffset]. *) + val offset_of_element : Llvm.lltype -> int -> t -> Int64.t end -(** Returns the byte order of a target, either LLVMBigEndian or - LLVMLittleEndian. - See the method llvm::TargetData::isLittleEndian. *) -external byte_order : TargetData.t -> Endian.t = "llvm_byte_order" - -(** Returns the pointer size in bytes for a target. - See the method llvm::TargetData::getPointerSize. *) -external pointer_size : TargetData.t -> int = "llvm_pointer_size" - -(** Returns the integer type that is the same size as a pointer on a target. - See the method llvm::TargetData::getIntPtrType. *) -external intptr_type : TargetData.t -> Llvm.lltype = "LLVMIntPtrType" - -(** Computes the size of a type in bytes for a target. - See the method llvm::TargetData::getTypeSizeInBits. *) -external size_in_bits : TargetData.t -> Llvm.lltype -> Int64.t - = "llvm_size_in_bits" - -(** Computes the storage size of a type in bytes for a target. - See the method llvm::TargetData::getTypeStoreSize. *) -external store_size : TargetData.t -> Llvm.lltype -> Int64.t = "llvm_store_size" - -(** Computes the ABI size of a type in bytes for a target. - See the method llvm::TargetData::getTypeAllocSize. *) -external abi_size : TargetData.t -> Llvm.lltype -> Int64.t = "llvm_abi_size" - -(** Computes the ABI alignment of a type in bytes for a target. - See the method llvm::TargetData::getTypeABISize. *) -external abi_align : TargetData.t -> Llvm.lltype -> int = "llvm_abi_align" - -(** Computes the call frame alignment of a type in bytes for a target. - See the method llvm::TargetData::getTypeABISize. *) -external stack_align : TargetData.t -> Llvm.lltype -> int = "llvm_stack_align" - -(** Computes the preferred alignment of a type in bytes for a target. - See the method llvm::TargetData::getTypeABISize. *) -external preferred_align : TargetData.t -> Llvm.lltype -> int - = "llvm_preferred_align" - -(** Computes the preferred alignment of a global variable in bytes for a target. - See the method llvm::TargetData::getPreferredAlignment. *) -external preferred_align_of_global : TargetData.t -> Llvm.llvalue -> int - = "llvm_preferred_align_of_global" - -(** Computes the structure element that contains the byte offset for a target. - See the method llvm::StructLayout::getElementContainingOffset. *) -external element_at_offset : TargetData.t -> Llvm.lltype -> Int64.t -> int - = "llvm_element_at_offset" - -(** Computes the byte offset of the indexed struct element for a target. - See the method llvm::StructLayout::getElementContainingOffset. *) -external offset_of_element : TargetData.t -> Llvm.lltype -> int -> Int64.t - = "llvm_offset_of_element" +(** {6 Target} *) + +module Target : sig + type t + + (** [default_triple ()] returns the default target triple for current + platform. *) + val default_triple : unit -> string + + (** [first ()] returns the first target in the registered targets + list, or [None]. *) + val first : unit -> t option + + (** [succ t] returns the next target after [t], or [None] + if [t] was the last target. *) + val succ : t -> t option + + (** [all ()] returns a list of known targets. *) + val all : unit -> t list + + (** [by_name name] returns [Some t] if a target [t] named [name] is + registered, or [None] otherwise. *) + val by_name : string -> t option + + (** [by_triple triple] returns a target for a triple [triple], or raises + [Error] if [triple] does not correspond to a registered target. *) + val by_triple : string -> t + + (** Returns the name of a target. See [llvm::Target::getName]. *) + val name : t -> string + + (** Returns the description of a target. + See [llvm::Target::getDescription]. *) + val description : t -> string + + (** Returns [true] if the target has a JIT. *) + val has_jit : t -> bool + + (** Returns [true] if the target has a target machine associated. *) + val has_target_machine : t -> bool + + (** Returns [true] if the target has an ASM backend (required for + emitting output). *) + val has_asm_backend : t -> bool +end + +(** {6 Target Machine} *) + +module TargetMachine : sig + type t + + (** Creates a new target machine. + See [llvm::Target::createTargetMachine]. *) + val create : triple:string -> ?cpu:string -> ?features:string -> + ?level:CodeGenOptLevel.t -> ?reloc_mode:RelocMode.t -> + ?code_model:CodeModel.t -> Target.t -> t + + (** Returns the Target used in a TargetMachine *) + val target : t -> Target.t + + (** Returns the triple used while creating this target machine. See + [llvm::TargetMachine::getTriple]. *) + val triple : t -> string + + (** Returns the CPU used while creating this target machine. See + [llvm::TargetMachine::getCPU]. *) + val cpu : t -> string + + (** Returns the feature string used while creating this target machine. See + [llvm::TargetMachine::getFeatureString]. *) + val features : t -> string + + (** Returns the data layout of this target machine. *) + val data_layout : t -> DataLayout.t + + (** Adds the target-specific analysis passes to the pass manager. + See [llvm::TargetMachine::addAnalysisPasses]. *) + val add_analysis_passes : [< Llvm.PassManager.any ] Llvm.PassManager.t -> t -> unit + + (** Sets the assembly verbosity of this target machine. + See [llvm::TargetMachine::setAsmVerbosity]. *) + val set_verbose_asm : bool -> t -> unit + + (** Emits assembly or object data for the given module to the given + file or raise [Error]. *) + val emit_to_file : Llvm.llmodule -> CodeGenFileType.t -> string -> t -> unit + + (** Emits assembly or object data for the given module to a fresh memory + buffer or raise [Error]. *) + val emit_to_memory_buffer : Llvm.llmodule -> CodeGenFileType.t -> t -> + Llvm.llmemorybuffer +end