1/*===-- target_ocaml.c - LLVM OCaml Glue ------------------------*- C++ -*-===*\
2|*                                                                            *|
3|*                     The LLVM Compiler Infrastructure                       *|
4|*                                                                            *|
5|* This file is distributed under the University of Illinois Open Source      *|
6|* License. See LICENSE.TXT for details.                                      *|
7|*                                                                            *|
8|*===----------------------------------------------------------------------===*|
9|*                                                                            *|
10|* This file glues LLVM's OCaml interface to its C interface. These functions *|
11|* are by and large transparent wrappers to the corresponding C functions.    *|
12|*                                                                            *|
13|* Note that these functions intentionally take liberties with the CAMLparamX *|
14|* macros, since most of the parameters are not GC heap objects.              *|
15|*                                                                            *|
16\*===----------------------------------------------------------------------===*/
17
18#include "llvm-c/Target.h"
19#include "llvm-c/TargetMachine.h"
20#include "caml/alloc.h"
21#include "caml/fail.h"
22#include "caml/memory.h"
23#include "caml/custom.h"
24#include "caml/callback.h"
25
26void llvm_raise(value Prototype, char *Message);
27value llvm_string_of_message(char* Message);
28
29/*===---- Data Layout -----------------------------------------------------===*/
30
31#define DataLayout_val(v)  (*(LLVMTargetDataRef *)(Data_custom_val(v)))
32
33static void llvm_finalize_data_layout(value DataLayout) {
34  LLVMDisposeTargetData(DataLayout_val(DataLayout));
35}
36
37static struct custom_operations llvm_data_layout_ops = {
38  (char *) "Llvm_target.DataLayout.t",
39  llvm_finalize_data_layout,
40  custom_compare_default,
41  custom_hash_default,
42  custom_serialize_default,
43  custom_deserialize_default,
44  custom_compare_ext_default
45};
46
47value llvm_alloc_data_layout(LLVMTargetDataRef DataLayout) {
48  value V = alloc_custom(&llvm_data_layout_ops, sizeof(LLVMTargetDataRef),
49                         0, 1);
50  DataLayout_val(V) = DataLayout;
51  return V;
52}
53
54/* string -> DataLayout.t */
55CAMLprim value llvm_datalayout_of_string(value StringRep) {
56  return llvm_alloc_data_layout(LLVMCreateTargetData(String_val(StringRep)));
57}
58
59/* DataLayout.t -> string */
60CAMLprim value llvm_datalayout_as_string(value TD) {
61  char *StringRep = LLVMCopyStringRepOfTargetData(DataLayout_val(TD));
62  value Copy = copy_string(StringRep);
63  LLVMDisposeMessage(StringRep);
64  return Copy;
65}
66
67/* [<Llvm.PassManager.any] Llvm.PassManager.t -> DataLayout.t -> unit */
68CAMLprim value llvm_datalayout_add_to_pass_manager(LLVMPassManagerRef PM,
69                                                   value DL) {
70  LLVMAddTargetData(DataLayout_val(DL), PM);
71  return Val_unit;
72}
73
74/* DataLayout.t -> Endian.t */
75CAMLprim value llvm_datalayout_byte_order(value DL) {
76  return Val_int(LLVMByteOrder(DataLayout_val(DL)));
77}
78
79/* DataLayout.t -> int */
80CAMLprim value llvm_datalayout_pointer_size(value DL) {
81  return Val_int(LLVMPointerSize(DataLayout_val(DL)));
82}
83
84/* Llvm.llcontext -> DataLayout.t -> Llvm.lltype */
85CAMLprim LLVMTypeRef llvm_datalayout_intptr_type(LLVMContextRef C, value DL) {
86  return LLVMIntPtrTypeInContext(C, DataLayout_val(DL));;
87}
88
89/* int -> DataLayout.t -> int */
90CAMLprim value llvm_datalayout_qualified_pointer_size(value AS, value DL) {
91  return Val_int(LLVMPointerSizeForAS(DataLayout_val(DL), Int_val(AS)));
92}
93
94/* Llvm.llcontext -> int -> DataLayout.t -> Llvm.lltype */
95CAMLprim LLVMTypeRef llvm_datalayout_qualified_intptr_type(LLVMContextRef C,
96                                                           value AS,
97                                                           value DL) {
98  return LLVMIntPtrTypeForASInContext(C, DataLayout_val(DL), Int_val(AS));
99}
100
101/* Llvm.lltype -> DataLayout.t -> Int64.t */
102CAMLprim value llvm_datalayout_size_in_bits(LLVMTypeRef Ty, value DL) {
103  return caml_copy_int64(LLVMSizeOfTypeInBits(DataLayout_val(DL), Ty));
104}
105
106/* Llvm.lltype -> DataLayout.t -> Int64.t */
107CAMLprim value llvm_datalayout_store_size(LLVMTypeRef Ty, value DL) {
108  return caml_copy_int64(LLVMStoreSizeOfType(DataLayout_val(DL), Ty));
109}
110
111/* Llvm.lltype -> DataLayout.t -> Int64.t */
112CAMLprim value llvm_datalayout_abi_size(LLVMTypeRef Ty, value DL) {
113  return caml_copy_int64(LLVMABISizeOfType(DataLayout_val(DL), Ty));
114}
115
116/* Llvm.lltype -> DataLayout.t -> int */
117CAMLprim value llvm_datalayout_abi_align(LLVMTypeRef Ty, value DL) {
118  return Val_int(LLVMABIAlignmentOfType(DataLayout_val(DL), Ty));
119}
120
121/* Llvm.lltype -> DataLayout.t -> int */
122CAMLprim value llvm_datalayout_stack_align(LLVMTypeRef Ty, value DL) {
123  return Val_int(LLVMCallFrameAlignmentOfType(DataLayout_val(DL), Ty));
124}
125
126/* Llvm.lltype -> DataLayout.t -> int */
127CAMLprim value llvm_datalayout_preferred_align(LLVMTypeRef Ty, value DL) {
128  return Val_int(LLVMPreferredAlignmentOfType(DataLayout_val(DL), Ty));
129}
130
131/* Llvm.llvalue -> DataLayout.t -> int */
132CAMLprim value llvm_datalayout_preferred_align_of_global(LLVMValueRef GlobalVar,
133                                                         value DL) {
134  return Val_int(LLVMPreferredAlignmentOfGlobal(DataLayout_val(DL), GlobalVar));
135}
136
137/* Llvm.lltype -> Int64.t -> DataLayout.t -> int */
138CAMLprim value llvm_datalayout_element_at_offset(LLVMTypeRef Ty, value Offset,
139                                                 value DL) {
140  return Val_int(LLVMElementAtOffset(DataLayout_val(DL), Ty,
141                                     Int64_val(Offset)));
142}
143
144/* Llvm.lltype -> int -> DataLayout.t -> Int64.t */
145CAMLprim value llvm_datalayout_offset_of_element(LLVMTypeRef Ty, value Index,
146                                                 value DL) {
147  return caml_copy_int64(LLVMOffsetOfElement(DataLayout_val(DL), Ty,
148                                             Int_val(Index)));
149}
150
151/*===---- Target ----------------------------------------------------------===*/
152
153static value llvm_target_option(LLVMTargetRef Target) {
154  if(Target != NULL) {
155    value Result = caml_alloc_small(1, 0);
156    Store_field(Result, 0, (value) Target);
157    return Result;
158  }
159
160  return Val_int(0);
161}
162
163/* unit -> string */
164CAMLprim value llvm_target_default_triple(value Unit) {
165  char *TripleCStr = LLVMGetDefaultTargetTriple();
166  value TripleStr = caml_copy_string(TripleCStr);
167  LLVMDisposeMessage(TripleCStr);
168
169  return TripleStr;
170}
171
172/* unit -> Target.t option */
173CAMLprim value llvm_target_first(value Unit) {
174  return llvm_target_option(LLVMGetFirstTarget());
175}
176
177/* Target.t -> Target.t option */
178CAMLprim value llvm_target_succ(LLVMTargetRef Target) {
179  return llvm_target_option(LLVMGetNextTarget(Target));
180}
181
182/* string -> Target.t option */
183CAMLprim value llvm_target_by_name(value Name) {
184  return llvm_target_option(LLVMGetTargetFromName(String_val(Name)));
185}
186
187/* string -> Target.t */
188CAMLprim LLVMTargetRef llvm_target_by_triple(value Triple) {
189  LLVMTargetRef T;
190  char *Error;
191
192  if(LLVMGetTargetFromTriple(String_val(Triple), &T, &Error))
193    llvm_raise(*caml_named_value("Llvm_target.Error"), Error);
194
195  return T;
196}
197
198/* Target.t -> string */
199CAMLprim value llvm_target_name(LLVMTargetRef Target) {
200  return caml_copy_string(LLVMGetTargetName(Target));
201}
202
203/* Target.t -> string */
204CAMLprim value llvm_target_description(LLVMTargetRef Target) {
205  return caml_copy_string(LLVMGetTargetDescription(Target));
206}
207
208/* Target.t -> bool */
209CAMLprim value llvm_target_has_jit(LLVMTargetRef Target) {
210  return Val_bool(LLVMTargetHasJIT(Target));
211}
212
213/* Target.t -> bool */
214CAMLprim value llvm_target_has_target_machine(LLVMTargetRef Target) {
215  return Val_bool(LLVMTargetHasTargetMachine(Target));
216}
217
218/* Target.t -> bool */
219CAMLprim value llvm_target_has_asm_backend(LLVMTargetRef Target) {
220  return Val_bool(LLVMTargetHasAsmBackend(Target));
221}
222
223/*===---- Target Machine --------------------------------------------------===*/
224
225#define TargetMachine_val(v)  (*(LLVMTargetMachineRef *)(Data_custom_val(v)))
226
227static void llvm_finalize_target_machine(value Machine) {
228  LLVMDisposeTargetMachine(TargetMachine_val(Machine));
229}
230
231static struct custom_operations llvm_target_machine_ops = {
232  (char *) "Llvm_target.TargetMachine.t",
233  llvm_finalize_target_machine,
234  custom_compare_default,
235  custom_hash_default,
236  custom_serialize_default,
237  custom_deserialize_default,
238  custom_compare_ext_default
239};
240
241static value llvm_alloc_targetmachine(LLVMTargetMachineRef Machine) {
242  value V = alloc_custom(&llvm_target_machine_ops, sizeof(LLVMTargetMachineRef),
243                         0, 1);
244  TargetMachine_val(V) = Machine;
245  return V;
246}
247
248/* triple:string -> ?cpu:string -> ?features:string
249   ?level:CodeGenOptLevel.t -> ?reloc_mode:RelocMode.t
250   ?code_model:CodeModel.t -> Target.t -> TargetMachine.t */
251CAMLprim value llvm_create_targetmachine_native(value Triple, value CPU,
252                  value Features, value OptLevel, value RelocMode,
253                  value CodeModel, LLVMTargetRef Target) {
254  LLVMTargetMachineRef Machine;
255  const char *CPUStr = "", *FeaturesStr = "";
256  LLVMCodeGenOptLevel OptLevelEnum = LLVMCodeGenLevelDefault;
257  LLVMRelocMode RelocModeEnum = LLVMRelocDefault;
258  LLVMCodeModel CodeModelEnum = LLVMCodeModelDefault;
259
260  if(CPU != Val_int(0))
261    CPUStr = String_val(Field(CPU, 0));
262  if(Features != Val_int(0))
263    FeaturesStr = String_val(Field(Features, 0));
264  if(OptLevel != Val_int(0))
265    OptLevelEnum = Int_val(Field(OptLevel, 0));
266  if(RelocMode != Val_int(0))
267    RelocModeEnum = Int_val(Field(RelocMode, 0));
268  if(CodeModel != Val_int(0))
269    CodeModelEnum = Int_val(Field(CodeModel, 0));
270
271  Machine = LLVMCreateTargetMachine(Target, String_val(Triple), CPUStr,
272                FeaturesStr, OptLevelEnum, RelocModeEnum, CodeModelEnum);
273
274  return llvm_alloc_targetmachine(Machine);
275}
276
277CAMLprim value llvm_create_targetmachine_bytecode(value *argv, int argn) {
278  return llvm_create_targetmachine_native(argv[0], argv[1], argv[2], argv[3],
279                                    argv[4], argv[5], (LLVMTargetRef) argv[6]);
280}
281
282/* TargetMachine.t -> Target.t */
283CAMLprim LLVMTargetRef llvm_targetmachine_target(value Machine) {
284  return LLVMGetTargetMachineTarget(TargetMachine_val(Machine));
285}
286
287/* TargetMachine.t -> string */
288CAMLprim value llvm_targetmachine_triple(value Machine) {
289  return llvm_string_of_message(LLVMGetTargetMachineTriple(
290                                TargetMachine_val(Machine)));
291}
292
293/* TargetMachine.t -> string */
294CAMLprim value llvm_targetmachine_cpu(value Machine) {
295  return llvm_string_of_message(LLVMGetTargetMachineCPU(
296                                TargetMachine_val(Machine)));
297}
298
299/* TargetMachine.t -> string */
300CAMLprim value llvm_targetmachine_features(value Machine) {
301  return llvm_string_of_message(LLVMGetTargetMachineFeatureString(
302                                TargetMachine_val(Machine)));
303}
304
305/* TargetMachine.t -> DataLayout.t */
306CAMLprim value llvm_targetmachine_data_layout(value Machine) {
307  CAMLparam1(Machine);
308  CAMLlocal1(DataLayout);
309  char *TargetDataCStr;
310
311  /* LLVMGetTargetMachineData returns a pointer owned by the TargetMachine,
312     so it is impossible to wrap it with llvm_alloc_target_data, which assumes
313     that OCaml owns the pointer. */
314  LLVMTargetDataRef OrigDataLayout;
315  OrigDataLayout = LLVMGetTargetMachineData(TargetMachine_val(Machine));
316
317  TargetDataCStr = LLVMCopyStringRepOfTargetData(OrigDataLayout);
318  DataLayout = llvm_alloc_data_layout(LLVMCreateTargetData(TargetDataCStr));
319  LLVMDisposeMessage(TargetDataCStr);
320
321  CAMLreturn(DataLayout);
322}
323
324/* bool -> TargetMachine.t -> unit */
325CAMLprim value llvm_targetmachine_set_verbose_asm(value Verb, value Machine) {
326  LLVMSetTargetMachineAsmVerbosity(TargetMachine_val(Machine), Bool_val(Verb));
327  return Val_unit;
328}
329
330/* Llvm.llmodule -> CodeGenFileType.t -> string -> TargetMachine.t -> unit */
331CAMLprim value llvm_targetmachine_emit_to_file(LLVMModuleRef Module,
332                            value FileType, value FileName, value Machine) {
333  char *ErrorMessage;
334
335  if(LLVMTargetMachineEmitToFile(TargetMachine_val(Machine), Module,
336                                 String_val(FileName), Int_val(FileType),
337                                 &ErrorMessage)) {
338    llvm_raise(*caml_named_value("Llvm_target.Error"), ErrorMessage);
339  }
340
341  return Val_unit;
342}
343
344/* Llvm.llmodule -> CodeGenFileType.t -> TargetMachine.t ->
345   Llvm.llmemorybuffer */
346CAMLprim LLVMMemoryBufferRef llvm_targetmachine_emit_to_memory_buffer(
347                                LLVMModuleRef Module, value FileType,
348                                value Machine) {
349  char *ErrorMessage;
350  LLVMMemoryBufferRef Buffer;
351
352  if(LLVMTargetMachineEmitToMemoryBuffer(TargetMachine_val(Machine), Module,
353                                         Int_val(FileType), &ErrorMessage,
354                                         &Buffer)) {
355    llvm_raise(*caml_named_value("Llvm_target.Error"), ErrorMessage);
356  }
357
358  return Buffer;
359}
360
361/* TargetMachine.t -> Llvm.PassManager.t -> unit */
362CAMLprim value llvm_targetmachine_add_analysis_passes(LLVMPassManagerRef PM,
363                                                      value Machine) {
364  LLVMAddAnalysisPasses(TargetMachine_val(Machine), PM);
365  return Val_unit;
366}
367