Tests of the ocaml (and thus C) bindings for constants.
[oota-llvm.git] / bindings / ocaml / llvm / llvm_ocaml.c
1 /*===-- llvm_ocaml.h - LLVM Ocaml Glue --------------------------*- C++ -*-===*\
2 |*                                                                            *|
3 |*                     The LLVM Compiler Infrastructure                       *|
4 |*                                                                            *|
5 |* This file was developed by Gordon Henriksen and is distributed under the   *|
6 |* University of Illinois Open Source 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/Core.h"
19 #include "caml/alloc.h"
20 #include "caml/mlvalues.h"
21 #include "caml/memory.h"
22 #include "stdio.h"
23
24
25 /*===-- Modules -----------------------------------------------------------===*/
26
27 /* string -> llmodule */
28 CAMLprim value llvm_create_module(value ModuleID) {
29   return (value) LLVMModuleCreateWithName(String_val(ModuleID));
30 }
31
32 /* llmodule -> unit */
33 CAMLprim value llvm_dispose_module(value M) {
34   LLVMDisposeModule((LLVMModuleRef) M);
35   return Val_unit;
36 }
37
38 /* string -> lltype -> llmodule -> bool */
39 CAMLprim value llvm_add_type_name(value Name, value Ty, value M) {
40   int res = LLVMAddTypeName((LLVMModuleRef) M,
41                             String_val(Name), (LLVMTypeRef) Ty);
42   return Val_bool(res == 0);
43 }
44
45
46 /*===-- Types -------------------------------------------------------------===*/
47
48 /* lltype -> type_kind */
49 CAMLprim value llvm_classify_type(value Ty) {
50   return Val_int(LLVMGetTypeKind((LLVMTypeRef) Ty));
51 }
52
53 /* lltype -> lltype -> unit */
54 CAMLprim value llvm_refine_abstract_type(value ConcreteTy, value AbstractTy) {
55   LLVMRefineAbstractType((LLVMTypeRef) AbstractTy, (LLVMTypeRef) ConcreteTy);
56   return (value) Val_unit;
57 }
58
59 /*--... Operations on integer types ........................................--*/
60
61 /* unit -> lltype */
62 CAMLprim value llvm_i1_type (value Unit) { return (value) LLVMInt1Type();  }
63 CAMLprim value llvm_i8_type (value Unit) { return (value) LLVMInt8Type();  }
64 CAMLprim value llvm_i16_type(value Unit) { return (value) LLVMInt16Type(); }
65 CAMLprim value llvm_i32_type(value Unit) { return (value) LLVMInt32Type(); }
66 CAMLprim value llvm_i64_type(value Unit) { return (value) LLVMInt64Type(); }
67
68 /* int -> lltype */
69 CAMLprim value llvm_make_integer_type(value Width) {
70   return (value) LLVMCreateIntegerType(Int_val(Width));
71 }
72
73 /* lltype -> int */
74 CAMLprim value llvm_integer_bitwidth(value IntegerTy) {
75   return Val_int(LLVMGetIntegerTypeWidth((LLVMTypeRef) IntegerTy));
76 }
77
78 /*--... Operations on real types ...........................................--*/
79
80 /* unit -> lltype */
81 CAMLprim value llvm_float_type(value Unit) {
82   return (value) LLVMFloatType();
83 }
84
85 /* unit -> lltype */
86 CAMLprim value llvm_double_type(value Unit) {
87   return (value) LLVMDoubleType();
88 }
89
90 /* unit -> lltype */
91 CAMLprim value llvm_x86fp80_type(value Unit) {
92   return (value) LLVMX86FP80Type();
93 }
94
95 /* unit -> lltype */
96 CAMLprim value llvm_fp128_type(value Unit) {
97   return (value) LLVMFP128Type();
98 }
99
100 /* unit -> lltype */
101 CAMLprim value llvm_ppc_fp128_type(value Unit) {
102   return (value) LLVMPPCFP128Type();
103 }
104
105 /*--... Operations on function types .......................................--*/
106
107 /* lltype -> lltype array -> bool -> lltype */
108 CAMLprim value llvm_make_function_type(value RetTy, value ParamTys,
109                                        value IsVarArg) {
110   return (value) LLVMCreateFunctionType((LLVMTypeRef) RetTy,
111                                         (LLVMTypeRef *) ParamTys,
112                                         Wosize_val(ParamTys),
113                                         Bool_val(IsVarArg));
114 }
115
116 /* lltype -> bool */
117 CAMLprim value llvm_is_var_arg(value FunTy) {
118   return Val_bool(LLVMIsFunctionVarArg((LLVMTypeRef) FunTy));
119 }
120
121 /* lltype -> lltype */
122 CAMLprim value llvm_return_type(value FunTy) {
123   return (value) LLVMGetFunctionReturnType((LLVMTypeRef) FunTy);
124 }
125
126 /* lltype -> lltype array */
127 CAMLprim value llvm_param_types(value FunTy) {
128   unsigned Count = LLVMGetFunctionParamCount((LLVMTypeRef) FunTy);
129   LLVMTypeRef *FunTys = alloca(Count * sizeof(LLVMTypeRef));
130   
131   /* copy into an ocaml array */
132   unsigned i;
133   value ParamTys = caml_alloc(Count, 0);
134   
135   LLVMGetFunctionParamTypes((LLVMTypeRef) FunTy, FunTys);
136   for (i = 0; i != Count; ++i)
137     Store_field(ParamTys, i, (value) FunTys[i]);
138   
139   return ParamTys;
140 }
141
142 /*--... Operations on struct types .........................................--*/
143
144 /* lltype array -> bool -> lltype */
145 CAMLprim value llvm_make_struct_type(value ElementTypes, value Packed) {
146   return (value) LLVMCreateStructType((LLVMTypeRef *) ElementTypes,
147                                       Wosize_val(ElementTypes),
148                                       Bool_val(Packed));
149 }
150
151 /* lltype -> lltype array */
152 CAMLprim value llvm_element_types(value StructTy) {
153   unsigned Count = LLVMGetStructElementCount((LLVMTypeRef) StructTy);
154   LLVMTypeRef *Tys = alloca(Count * sizeof(LLVMTypeRef));
155   
156   /* copy into an ocaml array */
157   unsigned i;
158   value ElementTys = caml_alloc(Count, 0);
159   
160   LLVMGetStructElementTypes((LLVMTypeRef) StructTy, Tys);
161   for (i = 0; i != Count; ++i)
162     Store_field(ElementTys, i, (value) Tys[i]);
163   
164   return ElementTys;
165 }
166
167 CAMLprim value llvm_is_packed(value StructTy) {
168   return Val_bool(LLVMIsPackedStruct((LLVMTypeRef) StructTy));
169 }
170
171 /*--... Operations on array, pointer, and vector types .....................--*/
172
173 /* lltype -> int -> lltype */
174 CAMLprim value llvm_make_array_type(value ElementTy, value Count) {
175   return (value) LLVMCreateArrayType((LLVMTypeRef) ElementTy, Int_val(Count));
176 }
177
178 /* lltype -> lltype */
179 CAMLprim value llvm_make_pointer_type(value ElementTy) {
180   return (value) LLVMCreatePointerType((LLVMTypeRef) ElementTy);
181 }
182
183 /* lltype -> int -> lltype */
184 CAMLprim value llvm_make_vector_type(value ElementTy, value Count) {
185   return (value) LLVMCreateVectorType((LLVMTypeRef) ElementTy, Int_val(Count));
186 }
187
188 /* lltype -> lltype */
189 CAMLprim value llvm_element_type(value Ty) {
190   return (value) LLVMGetElementType((LLVMTypeRef) Ty);
191 }
192
193 /* lltype -> int */
194 CAMLprim value llvm_array_length(value ArrayTy) {
195   return Val_int(LLVMGetArrayLength((LLVMTypeRef) ArrayTy));
196 }
197
198 /* lltype -> int */
199 CAMLprim value llvm_vector_size(value VectorTy) {
200   return Val_int(LLVMGetVectorSize((LLVMTypeRef) VectorTy));
201 }
202
203 /*--... Operations on other types ..........................................--*/
204
205 /* unit -> lltype */
206 CAMLprim value llvm_void_type (value Unit) { return (value) LLVMVoidType();  }
207 CAMLprim value llvm_label_type(value Unit) { return (value) LLVMLabelType(); }
208
209 /* unit -> lltype */
210 CAMLprim value llvm_make_opaque_type(value Unit) {
211   return (value) LLVMCreateOpaqueType();
212 }
213
214
215 /*===-- VALUES ------------------------------------------------------------===*/
216
217 /* llvalue -> lltype */
218 CAMLprim value llvm_type_of(value Val) {
219   return (value) LLVMGetTypeOfValue((LLVMValueRef) Val);
220 }
221
222 /* llvalue -> string */
223 CAMLprim value llvm_value_name(value Val) {
224   return caml_copy_string(LLVMGetValueName((LLVMValueRef) Val));
225 }
226
227 /* string -> llvalue -> unit */
228 CAMLprim value llvm_set_value_name(value Name, value Val) {
229   LLVMSetValueName((LLVMValueRef) Val, String_val(Name));
230   return Val_unit;
231 }
232
233 /*--... Operations on constants of (mostly) any type .......................--*/
234
235 /* lltype -> llvalue */
236 CAMLprim value llvm_make_null(value Ty) {
237   return (value) LLVMGetNull((LLVMTypeRef) Ty);
238 }
239
240 /* lltype -> llvalue */
241 CAMLprim value llvm_make_all_ones(value Ty) {
242   return (value) LLVMGetAllOnes((LLVMTypeRef) Ty);
243 }
244
245 /* lltype -> llvalue */
246 CAMLprim value llvm_make_undef(value Ty) {
247   return (value) LLVMGetUndef((LLVMTypeRef) Ty);
248 }
249
250 /* llvalue -> bool */
251 CAMLprim value llvm_is_constant(value Ty) {
252   return Val_bool(LLVMIsConstant((LLVMValueRef) Ty));
253 }
254
255 /* llvalue -> bool */
256 CAMLprim value llvm_is_null(value Val) {
257   return Val_bool(LLVMIsNull((LLVMValueRef) Val));
258 }
259
260 /* llvalue -> bool */
261 CAMLprim value llvm_is_undef(value Ty) {
262   return Val_bool(LLVMIsUndef((LLVMValueRef) Ty));
263 }
264
265 /*--... Operations on scalar constants .....................................--*/
266
267 /* lltype -> int -> bool -> llvalue */
268 CAMLprim value llvm_make_int_constant(value IntTy, value N, value SExt) {
269   /* GCC warns if we use the ternary operator. */
270   unsigned long long N2;
271   if (Bool_val(SExt))
272     N2 = (intnat) Int_val(N);
273   else
274     N2 = (uintnat) Int_val(N);
275   
276   return (value) LLVMGetIntConstant((LLVMTypeRef) IntTy, N2, Bool_val(SExt));
277 }
278
279 /* lltype -> Int64.t -> bool -> llvalue */
280 CAMLprim value llvm_make_int64_constant(value IntTy, value N, value SExt) {
281   return (value) LLVMGetIntConstant((LLVMTypeRef) IntTy, Int64_val(N),
282                                     Bool_val(SExt));
283 }
284
285 /* lltype -> float -> llvalue */
286 CAMLprim value llvm_make_real_constant(value RealTy, value N) {
287   return (value) LLVMGetRealConstant((LLVMTypeRef) RealTy, Double_val(N));
288 }
289
290 /*--... Operations on composite constants ..................................--*/
291
292 /* string -> bool -> llvalue */
293 CAMLprim value llvm_make_string_constant(value Str, value NullTerminate) {
294   return (value) LLVMGetStringConstant(String_val(Str),
295                                        caml_string_length(Str),
296                                        Bool_val(NullTerminate) == 0);
297 }
298
299 /* lltype -> llvalue array -> llvalue */
300 CAMLprim value llvm_make_array_constant(value ElementTy, value ElementVals) {
301   return (value) LLVMGetArrayConstant((LLVMTypeRef) ElementTy,
302                                       (LLVMValueRef*) Op_val(ElementVals),
303                                       Wosize_val(ElementVals));
304 }
305
306 /* llvalue array -> bool -> llvalue */
307 CAMLprim value llvm_make_struct_constant(value ElementVals, value Packed) {
308   return (value) LLVMGetStructConstant((LLVMValueRef*) Op_val(ElementVals),
309                                        Wosize_val(ElementVals),
310                                        Bool_val(Packed));
311 }
312
313 /* llvalue array -> llvalue */
314 CAMLprim value llvm_make_vector_constant(value ElementVals) {
315   return (value) LLVMGetVectorConstant((LLVMValueRef*) Op_val(ElementVals),
316                                        Wosize_val(ElementVals));
317 }
318
319 /*--... Operations on global variables, functions, and aliases (globals) ...--*/
320
321 /* llvalue -> bool */
322 CAMLprim value llvm_is_declaration(value Global) {
323   return Val_bool(LLVMIsDeclaration((LLVMValueRef) Global));
324 }
325
326 /* llvalue -> linkage */
327 CAMLprim value llvm_linkage(value Global) {
328   return Val_int(LLVMGetLinkage((LLVMValueRef) Global));
329 }
330
331 /* linkage -> llvalue -> unit */
332 CAMLprim value llvm_set_linkage(value Linkage, value Global) {
333   LLVMSetLinkage((LLVMValueRef) Global, Int_val(Linkage));
334   return Val_unit;
335 }
336
337 /* llvalue -> string */
338 CAMLprim value llvm_section(value Global) {
339   return caml_copy_string(LLVMGetSection((LLVMValueRef) Global));
340 }
341
342 /* string -> llvalue -> unit */
343 CAMLprim value llvm_set_section(value Section, value Global) {
344   LLVMSetSection((LLVMValueRef) Global, String_val(Section));
345   return Val_unit;
346 }
347
348 /* llvalue -> visibility */
349 CAMLprim value llvm_visibility(value Global) {
350   return Val_int(LLVMGetVisibility((LLVMValueRef) Global));
351 }
352
353 /* visibility -> llvalue -> unit */
354 CAMLprim value llvm_set_visibility(value Viz, value Global) {
355   LLVMSetVisibility((LLVMValueRef) Global, Int_val(Viz));
356   return Val_unit;
357 }
358
359 /* llvalue -> int */
360 CAMLprim value llvm_alignment(value Global) {
361   return Val_int(LLVMGetAlignment((LLVMValueRef) Global));
362 }
363
364 /* int -> llvalue -> unit */
365 CAMLprim value llvm_set_alignment(value Bytes, value Global) {
366   LLVMSetAlignment((LLVMValueRef) Global, Int_val(Bytes));
367   return Val_unit;
368 }
369
370 /*--... Operations on global variables .....................................--*/
371
372 /* lltype -> string -> llmodule -> llvalue */
373 CAMLprim value llvm_add_global(value Ty, value Name, value M) {
374   return (value) LLVMAddGlobal((LLVMModuleRef) M,
375                                (LLVMTypeRef) Ty, String_val(Name));
376 }
377
378 /* lltype -> string -> llmodule -> llvalue */
379 CAMLprim value llvm_declare_global(value Ty, value Name, value M) {
380   return (value) LLVMAddGlobal((LLVMModuleRef) M,
381                                (LLVMTypeRef) Ty, String_val(Name));
382 }
383
384 /* string -> llvalue -> llmodule -> llvalue */
385 CAMLprim value llvm_define_global(value Name, value ConstantVal, value M) {
386   LLVMValueRef Initializer = (LLVMValueRef) ConstantVal;
387   LLVMValueRef GlobalVar = LLVMAddGlobal((LLVMModuleRef) M,
388                                          LLVMGetTypeOfValue(Initializer),
389                                          String_val(Name));
390   LLVMSetInitializer(GlobalVar, Initializer);
391   return (value) GlobalVar;
392 }
393
394 /* llvalue -> unit */
395 CAMLprim value llvm_delete_global(value GlobalVar) {
396   LLVMDeleteGlobal((LLVMValueRef) GlobalVar);
397   return Val_unit;
398 }
399
400 /* llvalue -> llvalue */
401 CAMLprim value llvm_global_initializer(value GlobalVar) {
402   return (value) LLVMGetInitializer((LLVMValueRef) GlobalVar);
403 }
404
405 /* llvalue -> llvalue -> unit */
406 CAMLprim value llvm_set_initializer(value ConstantVal, value GlobalVar) {
407   LLVMSetInitializer((LLVMValueRef) GlobalVar, (LLVMValueRef) ConstantVal);
408   return Val_unit;
409 }
410
411 /* llvalue -> unit */
412 CAMLprim value llvm_remove_initializer(value GlobalVar) {
413   LLVMSetInitializer((LLVMValueRef) GlobalVar, NULL);
414   return Val_unit;
415 }
416
417 /* llvalue -> bool */
418 CAMLprim value llvm_is_thread_local(value GlobalVar) {
419   return Val_bool(LLVMIsThreadLocal((LLVMValueRef) GlobalVar));
420 }
421
422 /* bool -> llvalue -> unit */
423 CAMLprim value llvm_set_thread_local(value IsThreadLocal, value GlobalVar) {
424   LLVMSetThreadLocal((LLVMValueRef) GlobalVar, Bool_val(IsThreadLocal));
425   return Val_unit;
426 }