1(*===-- llvm_target.mli - LLVM OCaml Interface -----------------*- OCaml -*-===*
2 *
3 * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 * See https://llvm.org/LICENSE.txt for license information.
5 * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 *
7 *===----------------------------------------------------------------------===*)
8
9(** Target Information.
10
11    This interface provides an OCaml API for LLVM target information,
12    the classes in the Target library. *)
13
14module Endian : sig
15  type t =
16  | Big
17  | Little
18end
19
20module CodeGenOptLevel : sig
21  type t =
22  | None
23  | Less
24  | Default
25  | Aggressive
26end
27
28module RelocMode : sig
29  type t =
30  | Default
31  | Static
32  | PIC
33  | DynamicNoPIC
34end
35
36module CodeModel : sig
37  type t =
38  | Default
39  | JITDefault
40  | Small
41  | Kernel
42  | Medium
43  | Large
44end
45
46module CodeGenFileType : sig
47  type t =
48  | AssemblyFile
49  | ObjectFile
50end
51
52(** {6 Exceptions} *)
53
54exception Error of string
55
56(** {6 Data Layout} *)
57
58module DataLayout : sig
59  type t
60
61  (** [of_string rep] parses the data layout string representation [rep].
62      See the constructor [llvm::DataLayout::DataLayout]. *)
63  val of_string : string -> t
64
65  (** [as_string dl] is the string representation of the data layout [dl].
66      See the method [llvm::DataLayout::getStringRepresentation]. *)
67  val as_string : t -> string
68
69  (** Returns the byte order of a target, either [Endian.Big] or
70      [Endian.Little].
71      See the method [llvm::DataLayout::isLittleEndian]. *)
72  val byte_order : t -> Endian.t
73
74  (** Returns the pointer size in bytes for a target.
75      See the method [llvm::DataLayout::getPointerSize]. *)
76  val pointer_size : t -> int
77
78  (** Returns the integer type that is the same size as a pointer on a target.
79      See the method [llvm::DataLayout::getIntPtrType]. *)
80  val intptr_type : Llvm.llcontext -> t -> Llvm.lltype
81
82  (** Returns the pointer size in bytes for a target in a given address space.
83      See the method [llvm::DataLayout::getPointerSize]. *)
84  val qualified_pointer_size : int -> t -> int
85
86  (** Returns the integer type that is the same size as a pointer on a target
87      in a given address space.
88      See the method [llvm::DataLayout::getIntPtrType]. *)
89  val qualified_intptr_type : Llvm.llcontext -> int -> t -> Llvm.lltype
90
91  (** Computes the size of a type in bits for a target.
92      See the method [llvm::DataLayout::getTypeSizeInBits]. *)
93  val size_in_bits : Llvm.lltype -> t -> Int64.t
94
95  (** Computes the storage size of a type in bytes for a target.
96      See the method [llvm::DataLayout::getTypeStoreSize]. *)
97  val store_size : Llvm.lltype -> t -> Int64.t
98
99  (** Computes the ABI size of a type in bytes for a target.
100      See the method [llvm::DataLayout::getTypeAllocSize]. *)
101  val abi_size : Llvm.lltype -> t -> Int64.t
102
103  (** Computes the ABI alignment of a type in bytes for a target.
104      See the method [llvm::DataLayout::getTypeABISize]. *)
105  val abi_align : Llvm.lltype -> t -> int
106
107  (** Computes the call frame alignment of a type in bytes for a target.
108      See the method [llvm::DataLayout::getTypeABISize]. *)
109  val stack_align : Llvm.lltype -> t -> int
110
111  (** Computes the preferred alignment of a type in bytes for a target.
112      See the method [llvm::DataLayout::getTypeABISize]. *)
113  val preferred_align : Llvm.lltype -> t -> int
114
115  (** Computes the preferred alignment of a global variable in bytes for
116      a target. See the method [llvm::DataLayout::getPreferredAlignment]. *)
117  val preferred_align_of_global : Llvm.llvalue -> t -> int
118
119  (** Computes the structure element that contains the byte offset for a target.
120      See the method [llvm::StructLayout::getElementContainingOffset]. *)
121  val element_at_offset : Llvm.lltype -> Int64.t -> t -> int
122
123  (** Computes the byte offset of the indexed struct element for a target.
124      See the method [llvm::StructLayout::getElementContainingOffset]. *)
125  val offset_of_element : Llvm.lltype -> int -> t -> Int64.t
126end
127
128(** {6 Target} *)
129
130module Target : sig
131  type t
132
133  (** [default_triple ()] returns the default target triple for current
134      platform. *)
135  val default_triple : unit -> string
136
137  (** [first ()] returns the first target in the registered targets
138      list, or [None]. *)
139  val first : unit -> t option
140
141  (** [succ t] returns the next target after [t], or [None]
142      if [t] was the last target. *)
143  val succ : t -> t option
144
145  (** [all ()] returns a list of known targets. *)
146  val all : unit -> t list
147
148  (** [by_name name] returns [Some t] if a target [t] named [name] is
149      registered, or [None] otherwise. *)
150  val by_name : string -> t option
151
152  (** [by_triple triple] returns a target for a triple [triple], or raises
153      [Error] if [triple] does not correspond to a registered target. *)
154  val by_triple : string -> t
155
156  (** Returns the name of a target. See [llvm::Target::getName]. *)
157  val name : t -> string
158
159  (** Returns the description of a target.
160      See [llvm::Target::getDescription]. *)
161  val description : t -> string
162
163  (** Returns [true] if the target has a JIT. *)
164  val has_jit : t -> bool
165
166  (** Returns [true] if the target has a target machine associated. *)
167  val has_target_machine : t -> bool
168
169  (** Returns [true] if the target has an ASM backend (required for
170      emitting output). *)
171  val has_asm_backend : t -> bool
172end
173
174(** {6 Target Machine} *)
175
176module TargetMachine : sig
177  type t
178
179  (** Creates a new target machine.
180      See [llvm::Target::createTargetMachine]. *)
181  val create : triple:string -> ?cpu:string -> ?features:string ->
182               ?level:CodeGenOptLevel.t -> ?reloc_mode:RelocMode.t ->
183               ?code_model:CodeModel.t -> Target.t -> t
184
185  (** Returns the Target used in a TargetMachine *)
186  val target : t -> Target.t
187
188  (** Returns the triple used while creating this target machine. See
189      [llvm::TargetMachine::getTriple]. *)
190  val triple : t -> string
191
192  (** Returns the CPU used while creating this target machine. See
193      [llvm::TargetMachine::getCPU]. *)
194  val cpu : t -> string
195
196  (** Returns the data layout of this target machine. *)
197  val data_layout : t -> DataLayout.t
198
199  (** Returns the feature string used while creating this target machine. See
200      [llvm::TargetMachine::getFeatureString]. *)
201  val features : t -> string
202
203  (** Adds the target-specific analysis passes to the pass manager.
204      See [llvm::TargetMachine::addAnalysisPasses]. *)
205  val add_analysis_passes : [< Llvm.PassManager.any ] Llvm.PassManager.t -> t -> unit
206
207  (** Sets the assembly verbosity of this target machine.
208      See [llvm::TargetMachine::setAsmVerbosity]. *)
209  val set_verbose_asm : bool -> t -> unit
210
211  (** Emits assembly or object data for the given module to the given
212      file or raise [Error]. *)
213  val emit_to_file : Llvm.llmodule -> CodeGenFileType.t -> string -> t -> unit
214
215  (** Emits assembly or object data for the given module to a fresh memory
216      buffer or raise [Error]. *)
217  val emit_to_memory_buffer : Llvm.llmodule -> CodeGenFileType.t -> t ->
218                              Llvm.llmemorybuffer
219end
220