source: parabix-LLVM/llvm_git/bindings/ocaml/llvm/llvm_ocaml.c @ 4078

Last change on this file since 4078 was 4078, checked in by linmengl, 5 years ago

checkin llvm-meng source

File size: 75.2 KB
Line 
1/*===-- llvm_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/Core.h"
19#include "caml/alloc.h"
20#include "caml/custom.h"
21#include "caml/memory.h"
22#include "caml/fail.h"
23#include "caml/callback.h"
24#include <assert.h>
25#include <stdlib.h>
26#include <string.h>
27
28
29/* Can't use the recommended caml_named_value mechanism for backwards
30   compatibility reasons. This is largely equivalent. */
31static value llvm_ioerror_exn;
32
33CAMLprim value llvm_register_core_exns(value IoError) {
34  llvm_ioerror_exn = Field(IoError, 0);
35  register_global_root(&llvm_ioerror_exn);
36
37  return Val_unit;
38}
39
40static void llvm_raise(value Prototype, char *Message) {
41  CAMLparam1(Prototype);
42  CAMLlocal1(CamlMessage);
43 
44  CamlMessage = copy_string(Message);
45  LLVMDisposeMessage(Message);
46 
47  raise_with_arg(Prototype, CamlMessage);
48  abort(); /* NOTREACHED */
49#ifdef CAMLnoreturn
50  CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
51#endif
52}
53
54static value llvm_fatal_error_handler;
55
56static void llvm_fatal_error_trampoline(const char *Reason) {
57  callback(llvm_fatal_error_handler, copy_string(Reason));
58}
59
60CAMLprim value llvm_install_fatal_error_handler(value Handler) {
61  LLVMInstallFatalErrorHandler(llvm_fatal_error_trampoline);
62  llvm_fatal_error_handler = Handler;
63  caml_register_global_root(&llvm_fatal_error_handler);
64  return Val_unit;
65}
66
67CAMLprim value llvm_reset_fatal_error_handler(value Unit) {
68  caml_remove_global_root(&llvm_fatal_error_handler);
69  LLVMResetFatalErrorHandler();
70  return Val_unit;
71}
72
73CAMLprim value llvm_enable_pretty_stacktrace(value Unit) {
74  LLVMEnablePrettyStackTrace();
75  return Val_unit;
76}
77
78static value alloc_variant(int tag, void *Value) {
79  value Iter = alloc_small(1, tag);
80  Field(Iter, 0) = Val_op(Value);
81  return Iter;
82}
83
84/* Macro to convert the C first/next/last/prev idiom to the Ocaml llpos/
85   llrev_pos idiom. */
86#define DEFINE_ITERATORS(camlname, cname, pty, cty, pfun) \
87  /* llmodule -> ('a, 'b) llpos */                        \
88  CAMLprim value llvm_##camlname##_begin(pty Mom) {       \
89    cty First = LLVMGetFirst##cname(Mom);                 \
90    if (First)                                            \
91      return alloc_variant(1, First);                     \
92    return alloc_variant(0, Mom);                         \
93  }                                                       \
94                                                          \
95  /* llvalue -> ('a, 'b) llpos */                         \
96  CAMLprim value llvm_##camlname##_succ(cty Kid) {        \
97    cty Next = LLVMGetNext##cname(Kid);                   \
98    if (Next)                                             \
99      return alloc_variant(1, Next);                      \
100    return alloc_variant(0, pfun(Kid));                   \
101  }                                                       \
102                                                          \
103  /* llmodule -> ('a, 'b) llrev_pos */                    \
104  CAMLprim value llvm_##camlname##_end(pty Mom) {         \
105    cty Last = LLVMGetLast##cname(Mom);                   \
106    if (Last)                                             \
107      return alloc_variant(1, Last);                      \
108    return alloc_variant(0, Mom);                         \
109  }                                                       \
110                                                          \
111  /* llvalue -> ('a, 'b) llrev_pos */                     \
112  CAMLprim value llvm_##camlname##_pred(cty Kid) {        \
113    cty Prev = LLVMGetPrevious##cname(Kid);               \
114    if (Prev)                                             \
115      return alloc_variant(1, Prev);                      \
116    return alloc_variant(0, pfun(Kid));                   \
117  }
118
119
120/*===-- Contexts ----------------------------------------------------------===*/
121
122/* unit -> llcontext */
123CAMLprim LLVMContextRef llvm_create_context(value Unit) {
124  return LLVMContextCreate();
125}
126
127/* llcontext -> unit */
128CAMLprim value llvm_dispose_context(LLVMContextRef C) {
129  LLVMContextDispose(C);
130  return Val_unit;
131}
132
133/* unit -> llcontext */
134CAMLprim LLVMContextRef llvm_global_context(value Unit) {
135  return LLVMGetGlobalContext();
136}
137
138/* llcontext -> string -> int */
139CAMLprim value llvm_mdkind_id(LLVMContextRef C, value Name) {
140  unsigned MDKindID = LLVMGetMDKindIDInContext(C, String_val(Name),
141                                               caml_string_length(Name));
142  return Val_int(MDKindID);
143}
144
145/*===-- Modules -----------------------------------------------------------===*/
146
147/* llcontext -> string -> llmodule */
148CAMLprim LLVMModuleRef llvm_create_module(LLVMContextRef C, value ModuleID) {
149  return LLVMModuleCreateWithNameInContext(String_val(ModuleID), C);
150}
151
152/* llmodule -> unit */
153CAMLprim value llvm_dispose_module(LLVMModuleRef M) {
154  LLVMDisposeModule(M);
155  return Val_unit;
156}
157
158/* llmodule -> string */
159CAMLprim value llvm_target_triple(LLVMModuleRef M) {
160  return copy_string(LLVMGetTarget(M));
161}
162
163/* string -> llmodule -> unit */
164CAMLprim value llvm_set_target_triple(value Trip, LLVMModuleRef M) {
165  LLVMSetTarget(M, String_val(Trip));
166  return Val_unit;
167}
168
169/* llmodule -> string */
170CAMLprim value llvm_data_layout(LLVMModuleRef M) {
171  return copy_string(LLVMGetDataLayout(M));
172}
173
174/* string -> llmodule -> unit */
175CAMLprim value llvm_set_data_layout(value Layout, LLVMModuleRef M) {
176  LLVMSetDataLayout(M, String_val(Layout));
177  return Val_unit;
178}
179
180/* llmodule -> unit */
181CAMLprim value llvm_dump_module(LLVMModuleRef M) {
182  LLVMDumpModule(M);
183  return Val_unit;
184}
185
186/* string -> llmodule -> unit */
187CAMLprim value llvm_print_module(value Filename, LLVMModuleRef M) {
188  char* Message;
189  if(LLVMPrintModuleToFile(M, String_val(Filename), &Message)) {
190    llvm_raise(llvm_ioerror_exn, Message);
191  }
192
193  return Val_unit;
194}
195
196/* llmodule -> string */
197CAMLprim value llvm_string_of_llmodule(LLVMModuleRef M) {
198  char* ModuleCStr;
199  ModuleCStr = LLVMPrintModuleToString(M);
200
201  value ModuleStr = caml_copy_string(ModuleCStr);
202  LLVMDisposeMessage(ModuleCStr);
203
204  return ModuleStr;
205}
206
207/* llmodule -> string -> unit */
208CAMLprim value llvm_set_module_inline_asm(LLVMModuleRef M, value Asm) {
209  LLVMSetModuleInlineAsm(M, String_val(Asm));
210  return Val_unit;
211}
212
213/*===-- Types -------------------------------------------------------------===*/
214
215/* lltype -> TypeKind.t */
216CAMLprim value llvm_classify_type(LLVMTypeRef Ty) {
217  return Val_int(LLVMGetTypeKind(Ty));
218}
219
220CAMLprim value llvm_type_is_sized(LLVMTypeRef Ty) {
221    return Val_bool(LLVMTypeIsSized(Ty));
222}
223
224/* lltype -> llcontext */
225CAMLprim LLVMContextRef llvm_type_context(LLVMTypeRef Ty) {
226  return LLVMGetTypeContext(Ty);
227}
228
229/* lltype -> unit */
230CAMLprim value llvm_dump_type(LLVMTypeRef Val) {
231  LLVMDumpType(Val);
232  return Val_unit;
233}
234
235/* lltype -> string */
236CAMLprim value llvm_string_of_lltype(LLVMTypeRef M) {
237  char* TypeCStr;
238  TypeCStr = LLVMPrintTypeToString(M);
239
240  value TypeStr = caml_copy_string(TypeCStr);
241  LLVMDisposeMessage(TypeCStr);
242
243  return TypeStr;
244}
245
246/*--... Operations on integer types ........................................--*/
247
248/* llcontext -> lltype */
249CAMLprim LLVMTypeRef llvm_i1_type (LLVMContextRef Context) {
250  return LLVMInt1TypeInContext(Context);
251}
252
253/* llcontext -> lltype */
254CAMLprim LLVMTypeRef llvm_i8_type (LLVMContextRef Context) {
255  return LLVMInt8TypeInContext(Context);
256}
257
258/* llcontext -> lltype */
259CAMLprim LLVMTypeRef llvm_i16_type (LLVMContextRef Context) {
260  return LLVMInt16TypeInContext(Context);
261}
262
263/* llcontext -> lltype */
264CAMLprim LLVMTypeRef llvm_i32_type (LLVMContextRef Context) {
265  return LLVMInt32TypeInContext(Context);
266}
267
268/* llcontext -> lltype */
269CAMLprim LLVMTypeRef llvm_i64_type (LLVMContextRef Context) {
270  return LLVMInt64TypeInContext(Context);
271}
272
273/* llcontext -> int -> lltype */
274CAMLprim LLVMTypeRef llvm_integer_type(LLVMContextRef Context, value Width) {
275  return LLVMIntTypeInContext(Context, Int_val(Width));
276}
277
278/* lltype -> int */
279CAMLprim value llvm_integer_bitwidth(LLVMTypeRef IntegerTy) {
280  return Val_int(LLVMGetIntTypeWidth(IntegerTy));
281}
282
283/*--... Operations on real types ...........................................--*/
284
285/* llcontext -> lltype */
286CAMLprim LLVMTypeRef llvm_float_type(LLVMContextRef Context) {
287  return LLVMFloatTypeInContext(Context);
288}
289
290/* llcontext -> lltype */
291CAMLprim LLVMTypeRef llvm_double_type(LLVMContextRef Context) {
292  return LLVMDoubleTypeInContext(Context);
293}
294
295/* llcontext -> lltype */
296CAMLprim LLVMTypeRef llvm_x86fp80_type(LLVMContextRef Context) {
297  return LLVMX86FP80TypeInContext(Context);
298}
299
300/* llcontext -> lltype */
301CAMLprim LLVMTypeRef llvm_fp128_type(LLVMContextRef Context) {
302  return LLVMFP128TypeInContext(Context);
303}
304
305/* llcontext -> lltype */
306CAMLprim LLVMTypeRef llvm_ppc_fp128_type(LLVMContextRef Context) {
307  return LLVMPPCFP128TypeInContext(Context);
308}
309
310/*--... Operations on function types .......................................--*/
311
312/* lltype -> lltype array -> lltype */
313CAMLprim LLVMTypeRef llvm_function_type(LLVMTypeRef RetTy, value ParamTys) {
314  return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
315                          Wosize_val(ParamTys), 0);
316}
317
318/* lltype -> lltype array -> lltype */
319CAMLprim LLVMTypeRef llvm_var_arg_function_type(LLVMTypeRef RetTy,
320                                                value ParamTys) {
321  return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys,
322                          Wosize_val(ParamTys), 1);
323}
324
325/* lltype -> bool */
326CAMLprim value llvm_is_var_arg(LLVMTypeRef FunTy) {
327  return Val_bool(LLVMIsFunctionVarArg(FunTy));
328}
329
330/* lltype -> lltype array */
331CAMLprim value llvm_param_types(LLVMTypeRef FunTy) {
332  value Tys = alloc(LLVMCountParamTypes(FunTy), 0);
333  LLVMGetParamTypes(FunTy, (LLVMTypeRef *) Tys);
334  return Tys;
335}
336
337/*--... Operations on struct types .........................................--*/
338
339/* llcontext -> lltype array -> lltype */
340CAMLprim LLVMTypeRef llvm_struct_type(LLVMContextRef C, value ElementTypes) {
341  return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
342                                 Wosize_val(ElementTypes), 0);
343}
344
345/* llcontext -> lltype array -> lltype */
346CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C,
347                                             value ElementTypes) {
348  return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes,
349                                 Wosize_val(ElementTypes), 1);
350}
351
352/* llcontext -> string -> lltype */
353CAMLprim LLVMTypeRef llvm_named_struct_type(LLVMContextRef C,
354                                            value Name) {
355  return LLVMStructCreateNamed(C, String_val(Name));
356}
357
358CAMLprim value llvm_struct_set_body(LLVMTypeRef Ty,
359                                    value ElementTypes,
360                                    value Packed) {
361  LLVMStructSetBody(Ty, (LLVMTypeRef *) ElementTypes,
362                    Wosize_val(ElementTypes), Bool_val(Packed));
363  return Val_unit;
364}
365
366/* lltype -> string option */
367CAMLprim value llvm_struct_name(LLVMTypeRef Ty)
368{
369  CAMLparam0();
370  const char *C = LLVMGetStructName(Ty);
371  if (C) {
372    CAMLlocal1(result);
373    result = caml_alloc_small(1, 0);
374    Store_field(result, 0, caml_copy_string(C));
375    CAMLreturn(result);
376  }
377  CAMLreturn(Val_int(0));
378}
379
380/* lltype -> lltype array */
381CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) {
382  value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0);
383  LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys);
384  return Tys;
385}
386
387/* lltype -> bool */
388CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) {
389  return Val_bool(LLVMIsPackedStruct(StructTy));
390}
391
392/* lltype -> bool */
393CAMLprim value llvm_is_opaque(LLVMTypeRef StructTy) {
394  return Val_bool(LLVMIsOpaqueStruct(StructTy));
395}
396
397/*--... Operations on array, pointer, and vector types .....................--*/
398
399/* lltype -> int -> lltype */
400CAMLprim LLVMTypeRef llvm_array_type(LLVMTypeRef ElementTy, value Count) {
401  return LLVMArrayType(ElementTy, Int_val(Count));
402}
403
404/* lltype -> lltype */
405CAMLprim LLVMTypeRef llvm_pointer_type(LLVMTypeRef ElementTy) {
406  return LLVMPointerType(ElementTy, 0);
407}
408
409/* lltype -> int -> lltype */
410CAMLprim LLVMTypeRef llvm_qualified_pointer_type(LLVMTypeRef ElementTy,
411                                                 value AddressSpace) {
412  return LLVMPointerType(ElementTy, Int_val(AddressSpace));
413}
414
415/* lltype -> int -> lltype */
416CAMLprim LLVMTypeRef llvm_vector_type(LLVMTypeRef ElementTy, value Count) {
417  return LLVMVectorType(ElementTy, Int_val(Count));
418}
419
420/* lltype -> int */
421CAMLprim value llvm_array_length(LLVMTypeRef ArrayTy) {
422  return Val_int(LLVMGetArrayLength(ArrayTy));
423}
424
425/* lltype -> int */
426CAMLprim value llvm_address_space(LLVMTypeRef PtrTy) {
427  return Val_int(LLVMGetPointerAddressSpace(PtrTy));
428}
429
430/* lltype -> int */
431CAMLprim value llvm_vector_size(LLVMTypeRef VectorTy) {
432  return Val_int(LLVMGetVectorSize(VectorTy));
433}
434
435/*--... Operations on other types ..........................................--*/
436
437/* llcontext -> lltype */
438CAMLprim LLVMTypeRef llvm_void_type (LLVMContextRef Context) {
439  return LLVMVoidTypeInContext(Context);
440}
441
442/* llcontext -> lltype */
443CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
444  return LLVMLabelTypeInContext(Context);
445}
446
447/* llcontext -> lltype */
448CAMLprim LLVMTypeRef llvm_x86_mmx_type(LLVMContextRef Context) {
449  return LLVMX86MMXTypeInContext(Context);
450}
451
452CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
453{
454  CAMLparam1(Name);
455  LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name));
456  if (Ty) {
457    value Option = alloc(1, 0);
458    Field(Option, 0) = (value) Ty;
459    CAMLreturn(Option);
460  }
461  CAMLreturn(Val_int(0));
462}
463
464/*===-- VALUES ------------------------------------------------------------===*/
465
466/* llvalue -> lltype */
467CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) {
468  return LLVMTypeOf(Val);
469}
470
471/* keep in sync with ValueKind.t */
472enum ValueKind {
473  NullValue=0,
474  Argument,
475  BasicBlock,
476  InlineAsm,
477  MDNode,
478  MDString,
479  BlockAddress,
480  ConstantAggregateZero,
481  ConstantArray,
482  ConstantDataArray,
483  ConstantDataVector,
484  ConstantExpr,
485  ConstantFP,
486  ConstantInt,
487  ConstantPointerNull,
488  ConstantStruct,
489  ConstantVector,
490  Function,
491  GlobalAlias,
492  GlobalVariable,
493  UndefValue,
494  Instruction
495};
496
497/* llvalue -> ValueKind.t */
498#define DEFINE_CASE(Val, Kind) \
499    do {if (LLVMIsA##Kind(Val)) CAMLreturn(Val_int(Kind));} while(0)
500
501CAMLprim value llvm_classify_value(LLVMValueRef Val) {
502  CAMLparam0();
503  if (!Val)
504    CAMLreturn(Val_int(NullValue));
505  if (LLVMIsAConstant(Val)) {
506    DEFINE_CASE(Val, BlockAddress);
507    DEFINE_CASE(Val, ConstantAggregateZero);
508    DEFINE_CASE(Val, ConstantArray);
509    DEFINE_CASE(Val, ConstantDataArray);
510    DEFINE_CASE(Val, ConstantDataVector);
511    DEFINE_CASE(Val, ConstantExpr);
512    DEFINE_CASE(Val, ConstantFP);
513    DEFINE_CASE(Val, ConstantInt);
514    DEFINE_CASE(Val, ConstantPointerNull);
515    DEFINE_CASE(Val, ConstantStruct);
516    DEFINE_CASE(Val, ConstantVector);
517  }
518  if (LLVMIsAInstruction(Val)) {
519    CAMLlocal1(result);
520    result = caml_alloc_small(1, 0);
521    Store_field(result, 0, Val_int(LLVMGetInstructionOpcode(Val)));
522    CAMLreturn(result);
523  }
524  if (LLVMIsAGlobalValue(Val)) {
525    DEFINE_CASE(Val, Function);
526    DEFINE_CASE(Val, GlobalAlias);
527    DEFINE_CASE(Val, GlobalVariable);
528  }
529  DEFINE_CASE(Val, Argument);
530  DEFINE_CASE(Val, BasicBlock);
531  DEFINE_CASE(Val, InlineAsm);
532  DEFINE_CASE(Val, MDNode);
533  DEFINE_CASE(Val, MDString);
534  DEFINE_CASE(Val, UndefValue);
535  failwith("Unknown Value class");
536}
537
538/* llvalue -> string */
539CAMLprim value llvm_value_name(LLVMValueRef Val) {
540  return copy_string(LLVMGetValueName(Val));
541}
542
543/* string -> llvalue -> unit */
544CAMLprim value llvm_set_value_name(value Name, LLVMValueRef Val) {
545  LLVMSetValueName(Val, String_val(Name));
546  return Val_unit;
547}
548
549/* llvalue -> unit */
550CAMLprim value llvm_dump_value(LLVMValueRef Val) {
551  LLVMDumpValue(Val);
552  return Val_unit;
553}
554
555/* llvalue -> string */
556CAMLprim value llvm_string_of_llvalue(LLVMValueRef M) {
557  char* ValueCStr;
558  ValueCStr = LLVMPrintValueToString(M);
559
560  value ValueStr = caml_copy_string(ValueCStr);
561  LLVMDisposeMessage(ValueCStr);
562
563  return ValueStr;
564}
565
566/* llvalue -> llvalue -> unit */
567CAMLprim value llvm_replace_all_uses_with(LLVMValueRef OldVal,
568                                          LLVMValueRef NewVal) {
569  LLVMReplaceAllUsesWith(OldVal, NewVal);
570  return Val_unit;
571}
572
573/*--... Operations on users ................................................--*/
574
575/* llvalue -> int -> llvalue */
576CAMLprim LLVMValueRef llvm_operand(LLVMValueRef V, value I) {
577  return LLVMGetOperand(V, Int_val(I));
578}
579
580/* llvalue -> int -> llvalue -> unit */
581CAMLprim value llvm_set_operand(LLVMValueRef U, value I, LLVMValueRef V) {
582  LLVMSetOperand(U, Int_val(I), V);
583  return Val_unit;
584}
585
586/* llvalue -> int */
587CAMLprim value llvm_num_operands(LLVMValueRef V) {
588  return Val_int(LLVMGetNumOperands(V));
589}
590
591/*--... Operations on constants of (mostly) any type .......................--*/
592
593/* llvalue -> bool */
594CAMLprim value llvm_is_constant(LLVMValueRef Val) {
595  return Val_bool(LLVMIsConstant(Val));
596}
597
598/* llvalue -> bool */
599CAMLprim value llvm_is_null(LLVMValueRef Val) {
600  return Val_bool(LLVMIsNull(Val));
601}
602
603/* llvalue -> bool */
604CAMLprim value llvm_is_undef(LLVMValueRef Val) {
605  return Val_bool(LLVMIsUndef(Val));
606}
607
608/* llvalue -> Opcode.t */
609CAMLprim value llvm_constexpr_get_opcode(LLVMValueRef Val) {
610  return LLVMIsAConstantExpr(Val) ?
611      Val_int(LLVMGetConstOpcode(Val)) : Val_int(0);
612}
613
614/*--... Operations on instructions .........................................--*/
615
616/* llvalue -> bool */
617CAMLprim value llvm_has_metadata(LLVMValueRef Val) {
618  return Val_bool(LLVMHasMetadata(Val));
619}
620
621/* llvalue -> int -> llvalue option */
622CAMLprim value llvm_metadata(LLVMValueRef Val, value MDKindID) {
623  CAMLparam1(MDKindID);
624  LLVMValueRef MD;
625  if ((MD = LLVMGetMetadata(Val, Int_val(MDKindID)))) {
626    value Option = alloc(1, 0);
627    Field(Option, 0) = (value) MD;
628    CAMLreturn(Option);
629  }
630  CAMLreturn(Val_int(0));
631}
632
633/* llvalue -> int -> llvalue -> unit */
634CAMLprim value llvm_set_metadata(LLVMValueRef Val, value MDKindID,
635                                 LLVMValueRef MD) {
636  LLVMSetMetadata(Val, Int_val(MDKindID), MD);
637  return Val_unit;
638}
639
640/* llvalue -> int -> unit */
641CAMLprim value llvm_clear_metadata(LLVMValueRef Val, value MDKindID) {
642  LLVMSetMetadata(Val, Int_val(MDKindID), NULL);
643  return Val_unit;
644}
645
646
647/*--... Operations on metadata .............................................--*/
648
649/* llcontext -> string -> llvalue */
650CAMLprim LLVMValueRef llvm_mdstring(LLVMContextRef C, value S) {
651  return LLVMMDStringInContext(C, String_val(S), caml_string_length(S));
652}
653
654/* llcontext -> llvalue array -> llvalue */
655CAMLprim LLVMValueRef llvm_mdnode(LLVMContextRef C, value ElementVals) {
656  return LLVMMDNodeInContext(C, (LLVMValueRef*) Op_val(ElementVals),
657                             Wosize_val(ElementVals));
658}
659
660/* llvalue -> string option */
661CAMLprim value llvm_get_mdstring(LLVMValueRef V) {
662  CAMLparam0();
663  const char *S;
664  unsigned Len;
665
666  if ((S = LLVMGetMDString(V, &Len))) {
667    CAMLlocal2(Option, Str);
668
669    Str = caml_alloc_string(Len);
670    memcpy(String_val(Str), S, Len);
671    Option = alloc(1,0);
672    Store_field(Option, 0, Str);
673    CAMLreturn(Option);
674  }
675  CAMLreturn(Val_int(0));
676}
677
678/* llmodule -> string -> llvalue array */
679CAMLprim value llvm_get_namedmd(LLVMModuleRef M, value Name)
680{
681  CAMLparam1(Name);
682  CAMLlocal1(Nodes);
683  Nodes = alloc(LLVMGetNamedMetadataNumOperands(M, String_val(Name)), 0);
684  LLVMGetNamedMetadataOperands(M, String_val(Name), (LLVMValueRef *) Nodes);
685  CAMLreturn(Nodes);
686}
687
688/* llmodule -> string -> llvalue -> unit */
689CAMLprim value llvm_append_namedmd(LLVMModuleRef M, value Name, LLVMValueRef Val) {
690  LLVMAddNamedMetadataOperand(M, String_val(Name), Val);
691  return Val_unit;
692}
693
694/*--... Operations on scalar constants .....................................--*/
695
696/* lltype -> int -> llvalue */
697CAMLprim LLVMValueRef llvm_const_int(LLVMTypeRef IntTy, value N) {
698  return LLVMConstInt(IntTy, (long long) Int_val(N), 1);
699}
700
701/* lltype -> Int64.t -> bool -> llvalue */
702CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N,
703                                          value SExt) {
704  return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt));
705}
706
707/* llvalue -> Int64.t */
708CAMLprim value llvm_int64_of_const(LLVMValueRef Const)
709{
710  CAMLparam0();
711  if (LLVMIsAConstantInt(Const) &&
712      LLVMGetIntTypeWidth(LLVMTypeOf(Const)) <= 64) {
713    value Option = alloc(1, 0);
714    Field(Option, 0) = caml_copy_int64(LLVMConstIntGetSExtValue(Const));
715    CAMLreturn(Option);
716  }
717  CAMLreturn(Val_int(0));
718}
719
720/* lltype -> string -> int -> llvalue */
721CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S,
722                                               value Radix) {
723  return LLVMConstIntOfStringAndSize(IntTy, String_val(S), caml_string_length(S),
724                                     Int_val(Radix));
725}
726
727/* lltype -> float -> llvalue */
728CAMLprim LLVMValueRef llvm_const_float(LLVMTypeRef RealTy, value N) {
729  return LLVMConstReal(RealTy, Double_val(N));
730}
731
732/* lltype -> string -> llvalue */
733CAMLprim LLVMValueRef llvm_const_float_of_string(LLVMTypeRef RealTy, value S) {
734  return LLVMConstRealOfStringAndSize(RealTy, String_val(S),
735                                      caml_string_length(S));
736}
737
738/*--... Operations on composite constants ..................................--*/
739
740/* llcontext -> string -> llvalue */
741CAMLprim LLVMValueRef llvm_const_string(LLVMContextRef Context, value Str,
742                                        value NullTerminate) {
743  return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
744                                  1);
745}
746
747/* llcontext -> string -> llvalue */
748CAMLprim LLVMValueRef llvm_const_stringz(LLVMContextRef Context, value Str,
749                                         value NullTerminate) {
750  return LLVMConstStringInContext(Context, String_val(Str), string_length(Str),
751                                  0);
752}
753
754/* lltype -> llvalue array -> llvalue */
755CAMLprim LLVMValueRef llvm_const_array(LLVMTypeRef ElementTy,
756                                               value ElementVals) {
757  return LLVMConstArray(ElementTy, (LLVMValueRef*) Op_val(ElementVals),
758                        Wosize_val(ElementVals));
759}
760
761/* llcontext -> llvalue array -> llvalue */
762CAMLprim LLVMValueRef llvm_const_struct(LLVMContextRef C, value ElementVals) {
763  return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
764                                  Wosize_val(ElementVals), 0);
765}
766
767/* lltype -> llvalue array -> llvalue */
768CAMLprim LLVMValueRef llvm_const_named_struct(LLVMTypeRef Ty, value ElementVals) {
769    return LLVMConstNamedStruct(Ty, (LLVMValueRef *) Op_val(ElementVals),  Wosize_val(ElementVals));
770}
771
772/* llcontext -> llvalue array -> llvalue */
773CAMLprim LLVMValueRef llvm_const_packed_struct(LLVMContextRef C,
774                                               value ElementVals) {
775  return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals),
776                                  Wosize_val(ElementVals), 1);
777}
778
779/* llvalue array -> llvalue */
780CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) {
781  return LLVMConstVector((LLVMValueRef*) Op_val(ElementVals),
782                         Wosize_val(ElementVals));
783}
784
785/*--... Constant expressions ...............................................--*/
786
787/* Icmp.t -> llvalue -> llvalue -> llvalue */
788CAMLprim LLVMValueRef llvm_const_icmp(value Pred,
789                                      LLVMValueRef LHSConstant,
790                                      LLVMValueRef RHSConstant) {
791  return LLVMConstICmp(Int_val(Pred) + LLVMIntEQ, LHSConstant, RHSConstant);
792}
793
794/* Fcmp.t -> llvalue -> llvalue -> llvalue */
795CAMLprim LLVMValueRef llvm_const_fcmp(value Pred,
796                                      LLVMValueRef LHSConstant,
797                                      LLVMValueRef RHSConstant) {
798  return LLVMConstFCmp(Int_val(Pred), LHSConstant, RHSConstant);
799}
800
801/* llvalue -> llvalue array -> llvalue */
802CAMLprim LLVMValueRef llvm_const_gep(LLVMValueRef ConstantVal, value Indices) {
803  return LLVMConstGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
804                      Wosize_val(Indices));
805}
806
807/* llvalue -> llvalue array -> llvalue */
808CAMLprim LLVMValueRef llvm_const_in_bounds_gep(LLVMValueRef ConstantVal,
809                                               value Indices) {
810  return LLVMConstInBoundsGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices),
811                              Wosize_val(Indices));
812}
813
814/* llvalue -> lltype -> is_signed:bool -> llvalue */
815CAMLprim LLVMValueRef llvm_const_intcast(LLVMValueRef CV, LLVMTypeRef T,
816                                         value IsSigned) {
817  return LLVMConstIntCast(CV, T, Bool_val(IsSigned));
818}
819
820/* llvalue -> int array -> llvalue */
821CAMLprim LLVMValueRef llvm_const_extractvalue(LLVMValueRef Aggregate,
822                                              value Indices) {
823  CAMLparam1(Indices);
824  int size = Wosize_val(Indices);
825  int i;
826  LLVMValueRef result;
827
828  unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
829  for (i = 0; i < size; i++) {
830    idxs[i] = Int_val(Field(Indices, i));
831  }
832
833  result = LLVMConstExtractValue(Aggregate, idxs, size);
834  free(idxs);
835  CAMLreturnT(LLVMValueRef, result);
836}
837
838/* llvalue -> llvalue -> int array -> llvalue */
839CAMLprim LLVMValueRef llvm_const_insertvalue(LLVMValueRef Aggregate,
840                                             LLVMValueRef Val, value Indices) {
841  CAMLparam1(Indices);
842  int size = Wosize_val(Indices);
843  int i;
844  LLVMValueRef result;
845
846  unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned));
847  for (i = 0; i < size; i++) {
848    idxs[i] = Int_val(Field(Indices, i));
849  }
850
851  result = LLVMConstInsertValue(Aggregate, Val, idxs, size);
852  free(idxs);
853  CAMLreturnT(LLVMValueRef, result);
854}
855
856/* lltype -> string -> string -> bool -> bool -> llvalue */
857CAMLprim LLVMValueRef llvm_const_inline_asm(LLVMTypeRef Ty, value Asm,
858                                     value Constraints, value HasSideEffects,
859                                     value IsAlignStack) {
860  return LLVMConstInlineAsm(Ty, String_val(Asm), String_val(Constraints),
861                            Bool_val(HasSideEffects), Bool_val(IsAlignStack));
862}
863
864/*--... Operations on global variables, functions, and aliases (globals) ...--*/
865
866/* llvalue -> bool */
867CAMLprim value llvm_is_declaration(LLVMValueRef Global) {
868  return Val_bool(LLVMIsDeclaration(Global));
869}
870
871/* llvalue -> Linkage.t */
872CAMLprim value llvm_linkage(LLVMValueRef Global) {
873  return Val_int(LLVMGetLinkage(Global));
874}
875
876/* Linkage.t -> llvalue -> unit */
877CAMLprim value llvm_set_linkage(value Linkage, LLVMValueRef Global) {
878  LLVMSetLinkage(Global, Int_val(Linkage));
879  return Val_unit;
880}
881
882/* llvalue -> string */
883CAMLprim value llvm_section(LLVMValueRef Global) {
884  return copy_string(LLVMGetSection(Global));
885}
886
887/* string -> llvalue -> unit */
888CAMLprim value llvm_set_section(value Section, LLVMValueRef Global) {
889  LLVMSetSection(Global, String_val(Section));
890  return Val_unit;
891}
892
893/* llvalue -> Visibility.t */
894CAMLprim value llvm_visibility(LLVMValueRef Global) {
895  return Val_int(LLVMGetVisibility(Global));
896}
897
898/* Visibility.t -> llvalue -> unit */
899CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) {
900  LLVMSetVisibility(Global, Int_val(Viz));
901  return Val_unit;
902}
903
904/* llvalue -> int */
905CAMLprim value llvm_alignment(LLVMValueRef Global) {
906  return Val_int(LLVMGetAlignment(Global));
907}
908
909/* int -> llvalue -> unit */
910CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) {
911  LLVMSetAlignment(Global, Int_val(Bytes));
912  return Val_unit;
913}
914
915/*--... Operations on uses .................................................--*/
916
917/* llvalue -> lluse option */
918CAMLprim value llvm_use_begin(LLVMValueRef Val) {
919  CAMLparam0();
920  LLVMUseRef First;
921  if ((First = LLVMGetFirstUse(Val))) {
922    value Option = alloc(1, 0);
923    Field(Option, 0) = (value) First;
924    CAMLreturn(Option);
925  }
926  CAMLreturn(Val_int(0));
927}
928
929/* lluse -> lluse option */
930CAMLprim value llvm_use_succ(LLVMUseRef U) {
931  CAMLparam0();
932  LLVMUseRef Next;
933  if ((Next = LLVMGetNextUse(U))) {
934    value Option = alloc(1, 0);
935    Field(Option, 0) = (value) Next;
936    CAMLreturn(Option);
937  }
938  CAMLreturn(Val_int(0));
939}
940
941/* lluse -> llvalue */
942CAMLprim LLVMValueRef llvm_user(LLVMUseRef UR) {
943  return LLVMGetUser(UR);
944}
945
946/* lluse -> llvalue */
947CAMLprim LLVMValueRef llvm_used_value(LLVMUseRef UR) {
948  return LLVMGetUsedValue(UR);
949}
950
951/*--... Operations on global variables .....................................--*/
952
953DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef,
954                 LLVMGetGlobalParent)
955
956/* lltype -> string -> llmodule -> llvalue */
957CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name,
958                                          LLVMModuleRef M) {
959  LLVMValueRef GlobalVar;
960  if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
961    if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
962      return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty, 0));
963    return GlobalVar;
964  }
965  return LLVMAddGlobal(M, Ty, String_val(Name));
966}
967
968/* lltype -> string -> int -> llmodule -> llvalue */
969CAMLprim LLVMValueRef llvm_declare_qualified_global(LLVMTypeRef Ty, value Name,
970                                                    value AddressSpace,
971                                                    LLVMModuleRef M) {
972  LLVMValueRef GlobalVar;
973  if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
974    if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty)
975      return LLVMConstBitCast(GlobalVar,
976                              LLVMPointerType(Ty, Int_val(AddressSpace)));
977    return GlobalVar;
978  }
979  return LLVMAddGlobalInAddressSpace(M, Ty, String_val(Name),
980                                     Int_val(AddressSpace));
981}
982
983/* string -> llmodule -> llvalue option */
984CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) {
985  CAMLparam1(Name);
986  LLVMValueRef GlobalVar;
987  if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
988    value Option = alloc(1, 0);
989    Field(Option, 0) = (value) GlobalVar;
990    CAMLreturn(Option);
991  }
992  CAMLreturn(Val_int(0));
993}
994
995/* string -> llvalue -> llmodule -> llvalue */
996CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer,
997                                         LLVMModuleRef M) {
998  LLVMValueRef GlobalVar = LLVMAddGlobal(M, LLVMTypeOf(Initializer),
999                                         String_val(Name));
1000  LLVMSetInitializer(GlobalVar, Initializer);
1001  return GlobalVar;
1002}
1003
1004/* string -> llvalue -> int -> llmodule -> llvalue */
1005CAMLprim LLVMValueRef llvm_define_qualified_global(value Name,
1006                                                   LLVMValueRef Initializer,
1007                                                   value AddressSpace,
1008                                                   LLVMModuleRef M) {
1009  LLVMValueRef GlobalVar = LLVMAddGlobalInAddressSpace(M,
1010                                                       LLVMTypeOf(Initializer),
1011                                                       String_val(Name),
1012                                                       Int_val(AddressSpace));
1013  LLVMSetInitializer(GlobalVar, Initializer);
1014  return GlobalVar;
1015}
1016
1017/* llvalue -> unit */
1018CAMLprim value llvm_delete_global(LLVMValueRef GlobalVar) {
1019  LLVMDeleteGlobal(GlobalVar);
1020  return Val_unit;
1021}
1022
1023/* llvalue -> llvalue -> unit */
1024CAMLprim value llvm_set_initializer(LLVMValueRef ConstantVal,
1025                                    LLVMValueRef GlobalVar) {
1026  LLVMSetInitializer(GlobalVar, ConstantVal);
1027  return Val_unit;
1028}
1029
1030/* llvalue -> unit */
1031CAMLprim value llvm_remove_initializer(LLVMValueRef GlobalVar) {
1032  LLVMSetInitializer(GlobalVar, NULL);
1033  return Val_unit;
1034}
1035
1036/* llvalue -> bool */
1037CAMLprim value llvm_is_thread_local(LLVMValueRef GlobalVar) {
1038  return Val_bool(LLVMIsThreadLocal(GlobalVar));
1039}
1040
1041/* bool -> llvalue -> unit */
1042CAMLprim value llvm_set_thread_local(value IsThreadLocal,
1043                                     LLVMValueRef GlobalVar) {
1044  LLVMSetThreadLocal(GlobalVar, Bool_val(IsThreadLocal));
1045  return Val_unit;
1046}
1047
1048/* llvalue -> ThreadLocalMode.t */
1049CAMLprim value llvm_thread_local_mode(LLVMValueRef GlobalVar) {
1050  return Val_int(LLVMGetThreadLocalMode(GlobalVar));
1051}
1052
1053/* ThreadLocalMode.t -> llvalue -> unit */
1054CAMLprim value llvm_set_thread_local_mode(value ThreadLocalMode,
1055                                          LLVMValueRef GlobalVar) {
1056  LLVMSetThreadLocalMode(GlobalVar, Int_val(ThreadLocalMode));
1057  return Val_unit;
1058}
1059
1060/* llvalue -> bool */
1061CAMLprim value llvm_is_externally_initialized(LLVMValueRef GlobalVar) {
1062  return Val_bool(LLVMIsExternallyInitialized(GlobalVar));
1063}
1064
1065/* bool -> llvalue -> unit */
1066CAMLprim value llvm_set_externally_initialized(value IsExternallyInitialized,
1067                                               LLVMValueRef GlobalVar) {
1068  LLVMSetExternallyInitialized(GlobalVar, Bool_val(IsExternallyInitialized));
1069  return Val_unit;
1070}
1071
1072/* llvalue -> bool */
1073CAMLprim value llvm_is_global_constant(LLVMValueRef GlobalVar) {
1074  return Val_bool(LLVMIsGlobalConstant(GlobalVar));
1075}
1076
1077/* bool -> llvalue -> unit */
1078CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) {
1079  LLVMSetGlobalConstant(GlobalVar, Bool_val(Flag));
1080  return Val_unit;
1081}
1082
1083/*--... Operations on aliases ..............................................--*/
1084
1085CAMLprim LLVMValueRef llvm_add_alias(LLVMModuleRef M, LLVMTypeRef Ty,
1086                                     LLVMValueRef Aliasee, value Name) {
1087  return LLVMAddAlias(M, Ty, Aliasee, String_val(Name));
1088}
1089
1090/*--... Operations on functions ............................................--*/
1091
1092DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef,
1093                 LLVMGetGlobalParent)
1094
1095/* string -> lltype -> llmodule -> llvalue */
1096CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty,
1097                                            LLVMModuleRef M) {
1098  LLVMValueRef Fn;
1099  if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
1100    if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty)
1101      return LLVMConstBitCast(Fn, LLVMPointerType(Ty, 0));
1102    return Fn;
1103  }
1104  return LLVMAddFunction(M, String_val(Name), Ty);
1105}
1106
1107/* string -> llmodule -> llvalue option */
1108CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) {
1109  CAMLparam1(Name);
1110  LLVMValueRef Fn;
1111  if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
1112    value Option = alloc(1, 0);
1113    Field(Option, 0) = (value) Fn;
1114    CAMLreturn(Option);
1115  }
1116  CAMLreturn(Val_int(0));
1117}
1118
1119/* string -> lltype -> llmodule -> llvalue */
1120CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty,
1121                                           LLVMModuleRef M) {
1122  LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty);
1123  LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry");
1124  return Fn;
1125}
1126
1127/* llvalue -> unit */
1128CAMLprim value llvm_delete_function(LLVMValueRef Fn) {
1129  LLVMDeleteFunction(Fn);
1130  return Val_unit;
1131}
1132
1133/* llvalue -> bool */
1134CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) {
1135  return Val_bool(LLVMGetIntrinsicID(Fn));
1136}
1137
1138/* llvalue -> int */
1139CAMLprim value llvm_function_call_conv(LLVMValueRef Fn) {
1140  return Val_int(LLVMGetFunctionCallConv(Fn));
1141}
1142
1143/* int -> llvalue -> unit */
1144CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef Fn) {
1145  LLVMSetFunctionCallConv(Fn, Int_val(Id));
1146  return Val_unit;
1147}
1148
1149/* llvalue -> string option */
1150CAMLprim value llvm_gc(LLVMValueRef Fn) {
1151  const char *GC;
1152  CAMLparam0();
1153  CAMLlocal2(Name, Option);
1154 
1155  if ((GC = LLVMGetGC(Fn))) {
1156    Name = copy_string(GC);
1157   
1158    Option = alloc(1, 0);
1159    Field(Option, 0) = Name;
1160    CAMLreturn(Option);
1161  } else {
1162    CAMLreturn(Val_int(0));
1163  }
1164}
1165
1166/* string option -> llvalue -> unit */
1167CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
1168  LLVMSetGC(Fn, GC == Val_int(0)? 0 : String_val(Field(GC, 0)));
1169  return Val_unit;
1170}
1171
1172/* llvalue -> int32 -> unit */
1173CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
1174  LLVMAddFunctionAttr(Arg, Int32_val(PA));
1175  return Val_unit;
1176}
1177
1178/* llvalue -> string -> string -> unit */
1179CAMLprim value llvm_add_target_dependent_function_attr(
1180                  LLVMValueRef Arg, value A, value V) {
1181  LLVMAddTargetDependentFunctionAttr(Arg, String_val(A), String_val(V));
1182  return Val_unit;
1183}
1184
1185/* llvalue -> int32 */
1186CAMLprim value llvm_function_attr(LLVMValueRef Fn)
1187{
1188    CAMLparam0();
1189    CAMLreturn(caml_copy_int32(LLVMGetFunctionAttr(Fn)));
1190}
1191
1192/* llvalue -> int32 -> unit */
1193CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
1194  LLVMRemoveFunctionAttr(Arg, Int32_val(PA));
1195  return Val_unit;
1196}
1197/*--... Operations on parameters ...........................................--*/
1198
1199DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent)
1200
1201/* llvalue -> int -> llvalue */
1202CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
1203  return LLVMGetParam(Fn, Int_val(Index));
1204}
1205
1206/* llvalue -> int */
1207CAMLprim value llvm_param_attr(LLVMValueRef Param)
1208{
1209    CAMLparam0();
1210    CAMLreturn(caml_copy_int32(LLVMGetAttribute(Param)));
1211}
1212
1213/* llvalue -> llvalue */
1214CAMLprim value llvm_params(LLVMValueRef Fn) {
1215  value Params = alloc(LLVMCountParams(Fn), 0);
1216  LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params));
1217  return Params;
1218}
1219
1220/* llvalue -> int32 -> unit */
1221CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
1222  LLVMAddAttribute(Arg, Int32_val(PA));
1223  return Val_unit;
1224}
1225
1226/* llvalue -> int32 -> unit */
1227CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
1228  LLVMRemoveAttribute(Arg, Int32_val(PA));
1229  return Val_unit;
1230}
1231
1232/* llvalue -> int -> unit */
1233CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
1234  LLVMSetParamAlignment(Arg, Int_val(align));
1235  return Val_unit;
1236}
1237
1238/*--... Operations on basic blocks .........................................--*/
1239
1240DEFINE_ITERATORS(
1241  block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
1242
1243/* llbasicblock -> llvalue option */
1244CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
1245{
1246  CAMLparam0();
1247  LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
1248  if (Term) {
1249    value Option = alloc(1, 0);
1250    Field(Option, 0) = (value) Term;
1251    CAMLreturn(Option);
1252  }
1253  CAMLreturn(Val_int(0));
1254}
1255
1256/* llvalue -> llbasicblock array */
1257CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
1258  value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
1259  LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray));
1260  return MLArray;
1261}
1262
1263/* llbasicblock -> unit */
1264CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) {
1265  LLVMDeleteBasicBlock(BB);
1266  return Val_unit;
1267}
1268
1269/* llbasicblock -> unit */
1270CAMLprim value llvm_remove_block(LLVMBasicBlockRef BB) {
1271  LLVMRemoveBasicBlockFromParent(BB);
1272  return Val_unit;
1273}
1274
1275/* llbasicblock -> llbasicblock -> unit */
1276CAMLprim value llvm_move_block_before(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
1277  LLVMMoveBasicBlockBefore(BB, Pos);
1278  return Val_unit;
1279}
1280
1281/* llbasicblock -> llbasicblock -> unit */
1282CAMLprim value llvm_move_block_after(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) {
1283  LLVMMoveBasicBlockAfter(BB, Pos);
1284  return Val_unit;
1285}
1286
1287/* string -> llvalue -> llbasicblock */
1288CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name,
1289                                             LLVMValueRef Fn) {
1290  return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name));
1291}
1292
1293/* string -> llbasicblock -> llbasicblock */
1294CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name,
1295                                             LLVMBasicBlockRef BB) {
1296  return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name));
1297}
1298
1299/* llvalue -> bool */
1300CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
1301  return Val_bool(LLVMValueIsBasicBlock(Val));
1302}
1303
1304/*--... Operations on instructions .........................................--*/
1305
1306DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
1307                 LLVMGetInstructionParent)
1308
1309/* llvalue -> Opcode.t */
1310CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) {
1311  LLVMOpcode o;
1312  if (!LLVMIsAInstruction(Inst))
1313      failwith("Not an instruction");
1314  o = LLVMGetInstructionOpcode(Inst);
1315  assert (o <= LLVMLandingPad);
1316  return Val_int(o);
1317}
1318
1319/* llvalue -> ICmp.t option */
1320CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) {
1321  CAMLparam0();
1322  int x = LLVMGetICmpPredicate(Val);
1323  if (x) {
1324    value Option = alloc(1, 0);
1325    Field(Option, 0) = Val_int(x - LLVMIntEQ);
1326    CAMLreturn(Option);
1327  }
1328  CAMLreturn(Val_int(0));
1329}
1330
1331
1332/*--... Operations on call sites ...........................................--*/
1333
1334/* llvalue -> int */
1335CAMLprim value llvm_instruction_call_conv(LLVMValueRef Inst) {
1336  return Val_int(LLVMGetInstructionCallConv(Inst));
1337}
1338
1339/* int -> llvalue -> unit */
1340CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
1341  LLVMSetInstructionCallConv(Inst, Int_val(CC));
1342  return Val_unit;
1343}
1344
1345/* llvalue -> int -> int32 -> unit */
1346CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
1347                                               value index,
1348                                               value PA) {
1349  LLVMAddInstrAttribute(Instr, Int_val(index), Int32_val(PA));
1350  return Val_unit;
1351}
1352
1353/* llvalue -> int -> int32 -> unit */
1354CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
1355                                                  value index,
1356                                                  value PA) {
1357  LLVMRemoveInstrAttribute(Instr, Int_val(index), Int32_val(PA));
1358  return Val_unit;
1359}
1360
1361/*--... Operations on call instructions (only) .............................--*/
1362
1363/* llvalue -> bool */
1364CAMLprim value llvm_is_tail_call(LLVMValueRef CallInst) {
1365  return Val_bool(LLVMIsTailCall(CallInst));
1366}
1367
1368/* bool -> llvalue -> unit */
1369CAMLprim value llvm_set_tail_call(value IsTailCall,
1370                                  LLVMValueRef CallInst) {
1371  LLVMSetTailCall(CallInst, Bool_val(IsTailCall));
1372  return Val_unit;
1373}
1374
1375/*--... Operations on load/store instructions (only)........................--*/
1376
1377/* llvalue -> bool */
1378CAMLprim value llvm_is_volatile(LLVMValueRef MemoryInst) {
1379  return Val_bool(LLVMGetVolatile(MemoryInst));
1380}
1381
1382/* bool -> llvalue -> unit */
1383CAMLprim value llvm_set_volatile(value IsVolatile,
1384                                  LLVMValueRef MemoryInst) {
1385  LLVMSetVolatile(MemoryInst, Bool_val(IsVolatile));
1386  return Val_unit;
1387}
1388
1389/*--... Operations on phi nodes ............................................--*/
1390
1391/* (llvalue * llbasicblock) -> llvalue -> unit */
1392CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) {
1393  LLVMAddIncoming(PhiNode,
1394                  (LLVMValueRef*) &Field(Incoming, 0),
1395                  (LLVMBasicBlockRef*) &Field(Incoming, 1),
1396                  1);
1397  return Val_unit;
1398}
1399
1400/* llvalue -> (llvalue * llbasicblock) list */
1401CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
1402  unsigned I;
1403  CAMLparam0();
1404  CAMLlocal3(Hd, Tl, Tmp);
1405 
1406  /* Build a tuple list of them. */
1407  Tl = Val_int(0);
1408  for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
1409    Hd = alloc(2, 0);
1410    Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
1411    Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
1412   
1413    Tmp = alloc(2, 0);
1414    Store_field(Tmp, 0, Hd);
1415    Store_field(Tmp, 1, Tl);
1416    Tl = Tmp;
1417  }
1418 
1419  CAMLreturn(Tl);
1420}
1421
1422/* llvalue -> unit */
1423CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {
1424  LLVMInstructionEraseFromParent(Instruction);
1425  return Val_unit;
1426}
1427
1428/*===-- Instruction builders ----------------------------------------------===*/
1429
1430#define Builder_val(v)  (*(LLVMBuilderRef *)(Data_custom_val(v)))
1431
1432static void llvm_finalize_builder(value B) {
1433  LLVMDisposeBuilder(Builder_val(B));
1434}
1435
1436static struct custom_operations builder_ops = {
1437  (char *) "LLVMIRBuilder",
1438  llvm_finalize_builder,
1439  custom_compare_default,
1440  custom_hash_default,
1441  custom_serialize_default,
1442  custom_deserialize_default
1443#ifdef custom_compare_ext_default
1444  , custom_compare_ext_default
1445#endif
1446};
1447
1448static value alloc_builder(LLVMBuilderRef B) {
1449  value V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1);
1450  Builder_val(V) = B;
1451  return V;
1452}
1453
1454/* llcontext -> llbuilder */
1455CAMLprim value llvm_builder(LLVMContextRef C) {
1456  return alloc_builder(LLVMCreateBuilderInContext(C));
1457}
1458
1459/* (llbasicblock, llvalue) llpos -> llbuilder -> unit */
1460CAMLprim value llvm_position_builder(value Pos, value B) {
1461  if (Tag_val(Pos) == 0) {
1462    LLVMBasicBlockRef BB = (LLVMBasicBlockRef) Op_val(Field(Pos, 0));
1463    LLVMPositionBuilderAtEnd(Builder_val(B), BB);
1464  } else {
1465    LLVMValueRef I = (LLVMValueRef) Op_val(Field(Pos, 0));
1466    LLVMPositionBuilderBefore(Builder_val(B), I);
1467  }
1468  return Val_unit;
1469}
1470
1471/* llbuilder -> llbasicblock */
1472CAMLprim LLVMBasicBlockRef llvm_insertion_block(value B) {
1473  LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B));
1474  if (!InsertBlock)
1475    raise_not_found();
1476  return InsertBlock;
1477}
1478
1479/* llvalue -> string -> llbuilder -> unit */
1480CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) {
1481  LLVMInsertIntoBuilderWithName(Builder_val(B), I, String_val(Name));
1482  return Val_unit;
1483}
1484
1485/*--... Metadata ...........................................................--*/
1486
1487/* llbuilder -> llvalue -> unit */
1488CAMLprim value llvm_set_current_debug_location(value B, LLVMValueRef V) {
1489  LLVMSetCurrentDebugLocation(Builder_val(B), V);
1490  return Val_unit;
1491}
1492
1493/* llbuilder -> unit */
1494CAMLprim value llvm_clear_current_debug_location(value B) {
1495  LLVMSetCurrentDebugLocation(Builder_val(B), NULL);
1496  return Val_unit;
1497}
1498
1499/* llbuilder -> llvalue option */
1500CAMLprim value llvm_current_debug_location(value B) {
1501  CAMLparam0();
1502  LLVMValueRef L;
1503  if ((L = LLVMGetCurrentDebugLocation(Builder_val(B)))) {
1504    value Option = alloc(1, 0);
1505    Field(Option, 0) = (value) L;
1506    CAMLreturn(Option);
1507  }
1508  CAMLreturn(Val_int(0));
1509}
1510
1511/* llbuilder -> llvalue -> unit */
1512CAMLprim value llvm_set_inst_debug_location(value B, LLVMValueRef V) {
1513  LLVMSetInstDebugLocation(Builder_val(B), V);
1514  return Val_unit;
1515}
1516
1517
1518/*--... Terminators ........................................................--*/
1519
1520/* llbuilder -> llvalue */
1521CAMLprim LLVMValueRef llvm_build_ret_void(value B) {
1522  return LLVMBuildRetVoid(Builder_val(B));
1523}
1524
1525/* llvalue -> llbuilder -> llvalue */
1526CAMLprim LLVMValueRef llvm_build_ret(LLVMValueRef Val, value B) {
1527  return LLVMBuildRet(Builder_val(B), Val);
1528}
1529
1530/* llvalue array -> llbuilder -> llvalue */
1531CAMLprim LLVMValueRef llvm_build_aggregate_ret(value RetVals, value B) {
1532  return LLVMBuildAggregateRet(Builder_val(B), (LLVMValueRef *) Op_val(RetVals),
1533                               Wosize_val(RetVals));
1534}
1535
1536/* llbasicblock -> llbuilder -> llvalue */
1537CAMLprim LLVMValueRef llvm_build_br(LLVMBasicBlockRef BB, value B) {
1538  return LLVMBuildBr(Builder_val(B), BB);
1539}
1540
1541/* llvalue -> llbasicblock -> llbasicblock -> llbuilder -> llvalue */
1542CAMLprim LLVMValueRef llvm_build_cond_br(LLVMValueRef If,
1543                                         LLVMBasicBlockRef Then,
1544                                         LLVMBasicBlockRef Else,
1545                                         value B) {
1546  return LLVMBuildCondBr(Builder_val(B), If, Then, Else);
1547}
1548
1549/* llvalue -> llbasicblock -> int -> llbuilder -> llvalue */
1550CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
1551                                        LLVMBasicBlockRef Else,
1552                                        value EstimatedCount,
1553                                        value B) {
1554  return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
1555}
1556
1557/* lltype -> string -> llbuilder -> llvalue */
1558CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name,
1559                                        value B)
1560{
1561  return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
1562}
1563
1564/* lltype -> llvalue -> string -> llbuilder -> llvalue */
1565CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty,
1566                                              LLVMValueRef Val,
1567                                              value Name, value B)
1568{
1569  return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name));
1570}
1571
1572/* llvalue -> llbuilder -> llvalue */
1573CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B)
1574{
1575  return LLVMBuildFree(Builder_val(B), P);
1576}
1577
1578/* llvalue -> llvalue -> llbasicblock -> unit */
1579CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
1580                             LLVMBasicBlockRef Dest) {
1581  LLVMAddCase(Switch, OnVal, Dest);
1582  return Val_unit;
1583}
1584
1585/* llvalue -> llbasicblock -> llbuilder -> llvalue */
1586CAMLprim LLVMValueRef llvm_build_indirect_br(LLVMValueRef Addr,
1587                                             value EstimatedDests,
1588                                             value B) {
1589  return LLVMBuildIndirectBr(Builder_val(B), Addr, EstimatedDests);
1590}
1591
1592/* llvalue -> llvalue -> llbasicblock -> unit */
1593CAMLprim value llvm_add_destination(LLVMValueRef IndirectBr,
1594                                    LLVMBasicBlockRef Dest) {
1595  LLVMAddDestination(IndirectBr, Dest);
1596  return Val_unit;
1597}
1598
1599/* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1600   llbuilder -> llvalue */
1601CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args,
1602                                            LLVMBasicBlockRef Then,
1603                                            LLVMBasicBlockRef Catch,
1604                                            value Name, value B) {
1605  return LLVMBuildInvoke(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Args),
1606                         Wosize_val(Args), Then, Catch, String_val(Name));
1607}
1608
1609/* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string ->
1610   llbuilder -> llvalue */
1611CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
1612  return llvm_build_invoke_nat((LLVMValueRef) Args[0], Args[1],
1613                               (LLVMBasicBlockRef) Args[2],
1614                               (LLVMBasicBlockRef) Args[3],
1615                               Args[4], Args[5]);
1616}
1617
1618/* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */
1619CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
1620                                            value NumClauses,  value Name,
1621                                            value B) {
1622    return LLVMBuildLandingPad(Builder_val(B), Ty, PersFn, Int_val(NumClauses),
1623                               String_val(Name));
1624}
1625
1626/* llvalue -> llvalue -> unit */
1627CAMLprim value llvm_add_clause(LLVMValueRef LandingPadInst, LLVMValueRef ClauseVal)
1628{
1629    LLVMAddClause(LandingPadInst, ClauseVal);
1630    return Val_unit;
1631}
1632
1633
1634/* llvalue -> bool -> unit */
1635CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
1636{
1637    LLVMSetCleanup(LandingPadInst, Bool_val(flag));
1638    return Val_unit;
1639}
1640
1641/* llvalue -> llbuilder -> llvalue */
1642CAMLprim LLVMValueRef llvm_build_resume(LLVMValueRef Exn, value B)
1643{
1644    return LLVMBuildResume(Builder_val(B), Exn);
1645}
1646
1647/* llbuilder -> llvalue */
1648CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
1649  return LLVMBuildUnreachable(Builder_val(B));
1650}
1651
1652/*--... Arithmetic .........................................................--*/
1653
1654/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1655CAMLprim LLVMValueRef llvm_build_add(LLVMValueRef LHS, LLVMValueRef RHS,
1656                                     value Name, value B) {
1657  return LLVMBuildAdd(Builder_val(B), LHS, RHS, String_val(Name));
1658}
1659
1660/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1661CAMLprim LLVMValueRef llvm_build_nsw_add(LLVMValueRef LHS, LLVMValueRef RHS,
1662                                         value Name, value B) {
1663  return LLVMBuildNSWAdd(Builder_val(B), LHS, RHS, String_val(Name));
1664}
1665
1666/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1667CAMLprim LLVMValueRef llvm_build_nuw_add(LLVMValueRef LHS, LLVMValueRef RHS,
1668                                         value Name, value B) {
1669  return LLVMBuildNUWAdd(Builder_val(B), LHS, RHS, String_val(Name));
1670}
1671
1672/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1673CAMLprim LLVMValueRef llvm_build_fadd(LLVMValueRef LHS, LLVMValueRef RHS,
1674                                      value Name, value B) {
1675  return LLVMBuildFAdd(Builder_val(B), LHS, RHS, String_val(Name));
1676}
1677
1678/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1679CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1680                                     value Name, value B) {
1681  return LLVMBuildSub(Builder_val(B), LHS, RHS, String_val(Name));
1682}
1683
1684/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1685CAMLprim LLVMValueRef llvm_build_nsw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1686                                         value Name, value B) {
1687  return LLVMBuildNSWSub(Builder_val(B), LHS, RHS, String_val(Name));
1688}
1689
1690/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1691CAMLprim LLVMValueRef llvm_build_nuw_sub(LLVMValueRef LHS, LLVMValueRef RHS,
1692                                         value Name, value B) {
1693  return LLVMBuildNUWSub(Builder_val(B), LHS, RHS, String_val(Name));
1694}
1695
1696/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1697CAMLprim LLVMValueRef llvm_build_fsub(LLVMValueRef LHS, LLVMValueRef RHS,
1698                                      value Name, value B) {
1699  return LLVMBuildFSub(Builder_val(B), LHS, RHS, String_val(Name));
1700}
1701
1702/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1703CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1704                                     value Name, value B) {
1705  return LLVMBuildMul(Builder_val(B), LHS, RHS, String_val(Name));
1706}
1707
1708/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1709CAMLprim LLVMValueRef llvm_build_nsw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1710                                         value Name, value B) {
1711  return LLVMBuildNSWMul(Builder_val(B), LHS, RHS, String_val(Name));
1712}
1713
1714/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1715CAMLprim LLVMValueRef llvm_build_nuw_mul(LLVMValueRef LHS, LLVMValueRef RHS,
1716                                         value Name, value B) {
1717  return LLVMBuildNUWMul(Builder_val(B), LHS, RHS, String_val(Name));
1718}
1719
1720/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1721CAMLprim LLVMValueRef llvm_build_fmul(LLVMValueRef LHS, LLVMValueRef RHS,
1722                                      value Name, value B) {
1723  return LLVMBuildFMul(Builder_val(B), LHS, RHS, String_val(Name));
1724}
1725
1726/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1727CAMLprim LLVMValueRef llvm_build_udiv(LLVMValueRef LHS, LLVMValueRef RHS,
1728                                      value Name, value B) {
1729  return LLVMBuildUDiv(Builder_val(B), LHS, RHS, String_val(Name));
1730}
1731
1732/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1733CAMLprim LLVMValueRef llvm_build_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1734                                      value Name, value B) {
1735  return LLVMBuildSDiv(Builder_val(B), LHS, RHS, String_val(Name));
1736}
1737
1738/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1739CAMLprim LLVMValueRef llvm_build_exact_sdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1740                                            value Name, value B) {
1741  return LLVMBuildExactSDiv(Builder_val(B), LHS, RHS, String_val(Name));
1742}
1743
1744/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1745CAMLprim LLVMValueRef llvm_build_fdiv(LLVMValueRef LHS, LLVMValueRef RHS,
1746                                      value Name, value B) {
1747  return LLVMBuildFDiv(Builder_val(B), LHS, RHS, String_val(Name));
1748}
1749
1750/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1751CAMLprim LLVMValueRef llvm_build_urem(LLVMValueRef LHS, LLVMValueRef RHS,
1752                                      value Name, value B) {
1753  return LLVMBuildURem(Builder_val(B), LHS, RHS, String_val(Name));
1754}
1755
1756/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1757CAMLprim LLVMValueRef llvm_build_srem(LLVMValueRef LHS, LLVMValueRef RHS,
1758                                      value Name, value B) {
1759  return LLVMBuildSRem(Builder_val(B), LHS, RHS, String_val(Name));
1760}
1761
1762/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1763CAMLprim LLVMValueRef llvm_build_frem(LLVMValueRef LHS, LLVMValueRef RHS,
1764                                      value Name, value B) {
1765  return LLVMBuildFRem(Builder_val(B), LHS, RHS, String_val(Name));
1766}
1767
1768/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1769CAMLprim LLVMValueRef llvm_build_shl(LLVMValueRef LHS, LLVMValueRef RHS,
1770                                     value Name, value B) {
1771  return LLVMBuildShl(Builder_val(B), LHS, RHS, String_val(Name));
1772}
1773
1774/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1775CAMLprim LLVMValueRef llvm_build_lshr(LLVMValueRef LHS, LLVMValueRef RHS,
1776                                      value Name, value B) {
1777  return LLVMBuildLShr(Builder_val(B), LHS, RHS, String_val(Name));
1778}
1779
1780/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1781CAMLprim LLVMValueRef llvm_build_ashr(LLVMValueRef LHS, LLVMValueRef RHS,
1782                                      value Name, value B) {
1783  return LLVMBuildAShr(Builder_val(B), LHS, RHS, String_val(Name));
1784}
1785
1786/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1787CAMLprim LLVMValueRef llvm_build_and(LLVMValueRef LHS, LLVMValueRef RHS,
1788                                     value Name, value B) {
1789  return LLVMBuildAnd(Builder_val(B), LHS, RHS, String_val(Name));
1790}
1791
1792/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1793CAMLprim LLVMValueRef llvm_build_or(LLVMValueRef LHS, LLVMValueRef RHS,
1794                                    value Name, value B) {
1795  return LLVMBuildOr(Builder_val(B), LHS, RHS, String_val(Name));
1796}
1797
1798/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
1799CAMLprim LLVMValueRef llvm_build_xor(LLVMValueRef LHS, LLVMValueRef RHS,
1800                                     value Name, value B) {
1801  return LLVMBuildXor(Builder_val(B), LHS, RHS, String_val(Name));
1802}
1803
1804/* llvalue -> string -> llbuilder -> llvalue */
1805CAMLprim LLVMValueRef llvm_build_neg(LLVMValueRef X,
1806                                     value Name, value B) {
1807  return LLVMBuildNeg(Builder_val(B), X, String_val(Name));
1808}
1809
1810/* llvalue -> string -> llbuilder -> llvalue */
1811CAMLprim LLVMValueRef llvm_build_nsw_neg(LLVMValueRef X,
1812                                         value Name, value B) {
1813  return LLVMBuildNSWNeg(Builder_val(B), X, String_val(Name));
1814}
1815
1816/* llvalue -> string -> llbuilder -> llvalue */
1817CAMLprim LLVMValueRef llvm_build_nuw_neg(LLVMValueRef X,
1818                                         value Name, value B) {
1819  return LLVMBuildNUWNeg(Builder_val(B), X, String_val(Name));
1820}
1821
1822/* llvalue -> string -> llbuilder -> llvalue */
1823CAMLprim LLVMValueRef llvm_build_fneg(LLVMValueRef X,
1824                                     value Name, value B) {
1825  return LLVMBuildFNeg(Builder_val(B), X, String_val(Name));
1826}
1827
1828/* llvalue -> string -> llbuilder -> llvalue */
1829CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X,
1830                                     value Name, value B) {
1831  return LLVMBuildNot(Builder_val(B), X, String_val(Name));
1832}
1833
1834/*--... Memory .............................................................--*/
1835
1836/* lltype -> string -> llbuilder -> llvalue */
1837CAMLprim LLVMValueRef llvm_build_alloca(LLVMTypeRef Ty,
1838                                        value Name, value B) {
1839  return LLVMBuildAlloca(Builder_val(B), Ty, String_val(Name));
1840}
1841
1842/* lltype -> llvalue -> string -> llbuilder -> llvalue */
1843CAMLprim LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size,
1844                                              value Name, value B) {
1845  return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name));
1846}
1847
1848/* llvalue -> string -> llbuilder -> llvalue */
1849CAMLprim LLVMValueRef llvm_build_load(LLVMValueRef Pointer,
1850                                      value Name, value B) {
1851  return LLVMBuildLoad(Builder_val(B), Pointer, String_val(Name));
1852}
1853
1854/* llvalue -> llvalue -> llbuilder -> llvalue */
1855CAMLprim LLVMValueRef llvm_build_store(LLVMValueRef Value, LLVMValueRef Pointer,
1856                                       value B) {
1857  return LLVMBuildStore(Builder_val(B), Value, Pointer);
1858}
1859
1860/* AtomicRMWBinOp.t -> llvalue -> llvalue -> AtomicOrdering.t ->
1861   bool -> llbuilder -> llvalue */
1862CAMLprim LLVMValueRef llvm_build_atomicrmw_native(value BinOp, LLVMValueRef Ptr,
1863                                                  LLVMValueRef Val, value Ord,
1864                                                  value ST, value Name, value B) {
1865  LLVMValueRef Instr;
1866  Instr = LLVMBuildAtomicRMW(Builder_val(B), Int_val(BinOp),
1867                             Ptr, Val, Int_val(Ord), Bool_val(ST));
1868  LLVMSetValueName(Instr, String_val(Name));
1869  return Instr;
1870}
1871
1872CAMLprim LLVMValueRef llvm_build_atomicrmw_bytecode(value *argv, int argn) {
1873  return llvm_build_atomicrmw_native(argv[0], (LLVMValueRef) argv[1],
1874                                     (LLVMValueRef) argv[2], argv[3],
1875                                     argv[4], argv[5], argv[6]);
1876}
1877
1878/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
1879CAMLprim LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices,
1880                                     value Name, value B) {
1881  return LLVMBuildGEP(Builder_val(B), Pointer,
1882                      (LLVMValueRef *) Op_val(Indices), Wosize_val(Indices),
1883                      String_val(Name));
1884}
1885
1886/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
1887CAMLprim LLVMValueRef llvm_build_in_bounds_gep(LLVMValueRef Pointer,
1888                                               value Indices, value Name,
1889                                               value B) {
1890  return LLVMBuildInBoundsGEP(Builder_val(B), Pointer,
1891                              (LLVMValueRef *) Op_val(Indices),
1892                              Wosize_val(Indices), String_val(Name));
1893}
1894
1895/* llvalue -> int -> string -> llbuilder -> llvalue */
1896CAMLprim LLVMValueRef llvm_build_struct_gep(LLVMValueRef Pointer,
1897                                               value Index, value Name,
1898                                               value B) {
1899  return LLVMBuildStructGEP(Builder_val(B), Pointer,
1900                              Int_val(Index), String_val(Name));
1901}
1902
1903/* string -> string -> llbuilder -> llvalue */
1904CAMLprim LLVMValueRef llvm_build_global_string(value Str, value Name, value B) {
1905  return LLVMBuildGlobalString(Builder_val(B), String_val(Str),
1906                               String_val(Name));
1907}
1908
1909/* string -> string -> llbuilder -> llvalue */
1910CAMLprim LLVMValueRef llvm_build_global_stringptr(value Str, value Name,
1911                                                  value B) {
1912  return LLVMBuildGlobalStringPtr(Builder_val(B), String_val(Str),
1913                                  String_val(Name));
1914}
1915
1916/*--... Casts ..............................................................--*/
1917
1918/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1919CAMLprim LLVMValueRef llvm_build_trunc(LLVMValueRef X, LLVMTypeRef Ty,
1920                                       value Name, value B) {
1921  return LLVMBuildTrunc(Builder_val(B), X, Ty, String_val(Name));
1922}
1923
1924/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1925CAMLprim LLVMValueRef llvm_build_zext(LLVMValueRef X, LLVMTypeRef Ty,
1926                                      value Name, value B) {
1927  return LLVMBuildZExt(Builder_val(B), X, Ty, String_val(Name));
1928}
1929
1930/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1931CAMLprim LLVMValueRef llvm_build_sext(LLVMValueRef X, LLVMTypeRef Ty,
1932                                      value Name, value B) {
1933  return LLVMBuildSExt(Builder_val(B), X, Ty, String_val(Name));
1934}
1935
1936/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1937CAMLprim LLVMValueRef llvm_build_fptoui(LLVMValueRef X, LLVMTypeRef Ty,
1938                                        value Name, value B) {
1939  return LLVMBuildFPToUI(Builder_val(B), X, Ty, String_val(Name));
1940}
1941
1942/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1943CAMLprim LLVMValueRef llvm_build_fptosi(LLVMValueRef X, LLVMTypeRef Ty,
1944                                        value Name, value B) {
1945  return LLVMBuildFPToSI(Builder_val(B), X, Ty, String_val(Name));
1946}
1947
1948/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1949CAMLprim LLVMValueRef llvm_build_uitofp(LLVMValueRef X, LLVMTypeRef Ty,
1950                                        value Name, value B) {
1951  return LLVMBuildUIToFP(Builder_val(B), X, Ty, String_val(Name));
1952}
1953
1954/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1955CAMLprim LLVMValueRef llvm_build_sitofp(LLVMValueRef X, LLVMTypeRef Ty,
1956                                        value Name, value B) {
1957  return LLVMBuildSIToFP(Builder_val(B), X, Ty, String_val(Name));
1958}
1959
1960/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1961CAMLprim LLVMValueRef llvm_build_fptrunc(LLVMValueRef X, LLVMTypeRef Ty,
1962                                         value Name, value B) {
1963  return LLVMBuildFPTrunc(Builder_val(B), X, Ty, String_val(Name));
1964}
1965
1966/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1967CAMLprim LLVMValueRef llvm_build_fpext(LLVMValueRef X, LLVMTypeRef Ty,
1968                                       value Name, value B) {
1969  return LLVMBuildFPExt(Builder_val(B), X, Ty, String_val(Name));
1970}
1971
1972/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1973CAMLprim LLVMValueRef llvm_build_prttoint(LLVMValueRef X, LLVMTypeRef Ty,
1974                                          value Name, value B) {
1975  return LLVMBuildPtrToInt(Builder_val(B), X, Ty, String_val(Name));
1976}
1977
1978/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1979CAMLprim LLVMValueRef llvm_build_inttoptr(LLVMValueRef X, LLVMTypeRef Ty,
1980                                          value Name, value B) {
1981  return LLVMBuildIntToPtr(Builder_val(B), X, Ty, String_val(Name));
1982}
1983
1984/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1985CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1986                                         value Name, value B) {
1987  return LLVMBuildBitCast(Builder_val(B), X, Ty, String_val(Name));
1988}
1989
1990/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1991CAMLprim LLVMValueRef llvm_build_zext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1992                                                 value Name, value B) {
1993  return LLVMBuildZExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
1994}
1995
1996/* llvalue -> lltype -> string -> llbuilder -> llvalue */
1997CAMLprim LLVMValueRef llvm_build_sext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty,
1998                                                 value Name, value B) {
1999  return LLVMBuildSExtOrBitCast(Builder_val(B), X, Ty, String_val(Name));
2000}
2001
2002/* llvalue -> lltype -> string -> llbuilder -> llvalue */
2003CAMLprim LLVMValueRef llvm_build_trunc_or_bitcast(LLVMValueRef X,
2004                                                  LLVMTypeRef Ty, value Name,
2005                                                  value B) {
2006  return LLVMBuildTruncOrBitCast(Builder_val(B), X, Ty, String_val(Name));
2007}
2008
2009/* llvalue -> lltype -> string -> llbuilder -> llvalue */
2010CAMLprim LLVMValueRef llvm_build_pointercast(LLVMValueRef X, LLVMTypeRef Ty,
2011                                             value Name, value B) {
2012  return LLVMBuildPointerCast(Builder_val(B), X, Ty, String_val(Name));
2013}
2014
2015/* llvalue -> lltype -> string -> llbuilder -> llvalue */
2016CAMLprim LLVMValueRef llvm_build_intcast(LLVMValueRef X, LLVMTypeRef Ty,
2017                                         value Name, value B) {
2018  return LLVMBuildIntCast(Builder_val(B), X, Ty, String_val(Name));
2019}
2020
2021/* llvalue -> lltype -> string -> llbuilder -> llvalue */
2022CAMLprim LLVMValueRef llvm_build_fpcast(LLVMValueRef X, LLVMTypeRef Ty,
2023                                        value Name, value B) {
2024  return LLVMBuildFPCast(Builder_val(B), X, Ty, String_val(Name));
2025}
2026
2027/*--... Comparisons ........................................................--*/
2028
2029/* Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2030CAMLprim LLVMValueRef llvm_build_icmp(value Pred,
2031                                      LLVMValueRef LHS, LLVMValueRef RHS,
2032                                      value Name, value B) {
2033  return LLVMBuildICmp(Builder_val(B), Int_val(Pred) + LLVMIntEQ, LHS, RHS,
2034                       String_val(Name));
2035}
2036
2037/* Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2038CAMLprim LLVMValueRef llvm_build_fcmp(value Pred,
2039                                      LLVMValueRef LHS, LLVMValueRef RHS,
2040                                      value Name, value B) {
2041  return LLVMBuildFCmp(Builder_val(B), Int_val(Pred), LHS, RHS,
2042                       String_val(Name));
2043}
2044
2045/*--... Miscellaneous instructions .........................................--*/
2046
2047/* (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue */
2048CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) {
2049  value Hd, Tl;
2050  LLVMValueRef FirstValue, PhiNode;
2051 
2052  assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!");
2053 
2054  Hd = Field(Incoming, 0);
2055  FirstValue = (LLVMValueRef) Field(Hd, 0);
2056  PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue),
2057                         String_val(Name));
2058
2059  for (Tl = Incoming; Tl != Val_int(0); Tl = Field(Tl, 1)) {
2060    value Hd = Field(Tl, 0);
2061    LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0),
2062                    (LLVMBasicBlockRef*) &Field(Hd, 1), 1);
2063  }
2064 
2065  return PhiNode;
2066}
2067
2068/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */
2069CAMLprim LLVMValueRef llvm_build_call(LLVMValueRef Fn, value Params,
2070                                      value Name, value B) {
2071  return LLVMBuildCall(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Params),
2072                       Wosize_val(Params), String_val(Name));
2073}
2074
2075/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2076CAMLprim LLVMValueRef llvm_build_select(LLVMValueRef If,
2077                                        LLVMValueRef Then, LLVMValueRef Else,
2078                                        value Name, value B) {
2079  return LLVMBuildSelect(Builder_val(B), If, Then, Else, String_val(Name));
2080}
2081
2082/* llvalue -> lltype -> string -> llbuilder -> llvalue */
2083CAMLprim LLVMValueRef llvm_build_va_arg(LLVMValueRef List, LLVMTypeRef Ty,
2084                                        value Name, value B) {
2085  return LLVMBuildVAArg(Builder_val(B), List, Ty, String_val(Name));
2086}
2087
2088/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2089CAMLprim LLVMValueRef llvm_build_extractelement(LLVMValueRef Vec,
2090                                                LLVMValueRef Idx,
2091                                                value Name, value B) {
2092  return LLVMBuildExtractElement(Builder_val(B), Vec, Idx, String_val(Name));
2093}
2094
2095/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2096CAMLprim LLVMValueRef llvm_build_insertelement(LLVMValueRef Vec,
2097                                               LLVMValueRef Element,
2098                                               LLVMValueRef Idx,
2099                                               value Name, value B) {
2100  return LLVMBuildInsertElement(Builder_val(B), Vec, Element, Idx, 
2101                                String_val(Name));
2102}
2103
2104/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */
2105CAMLprim LLVMValueRef llvm_build_shufflevector(LLVMValueRef V1, LLVMValueRef V2,
2106                                               LLVMValueRef Mask,
2107                                               value Name, value B) {
2108  return LLVMBuildShuffleVector(Builder_val(B), V1, V2, Mask, String_val(Name));
2109}
2110
2111/* llvalue -> int -> string -> llbuilder -> llvalue */
2112CAMLprim LLVMValueRef llvm_build_extractvalue(LLVMValueRef Aggregate,
2113                                              value Idx, value Name, value B) {
2114  return LLVMBuildExtractValue(Builder_val(B), Aggregate, Int_val(Idx),
2115                               String_val(Name));
2116}
2117
2118/* llvalue -> llvalue -> int -> string -> llbuilder -> llvalue */
2119CAMLprim LLVMValueRef llvm_build_insertvalue(LLVMValueRef Aggregate,
2120                                             LLVMValueRef Val, value Idx,
2121                                             value Name, value B) {
2122  return LLVMBuildInsertValue(Builder_val(B), Aggregate, Val, Int_val(Idx),
2123                              String_val(Name));
2124}
2125
2126/* llvalue -> string -> llbuilder -> llvalue */
2127CAMLprim LLVMValueRef llvm_build_is_null(LLVMValueRef Val, value Name,
2128                                         value B) {
2129  return LLVMBuildIsNull(Builder_val(B), Val, String_val(Name));
2130}
2131
2132/* llvalue -> string -> llbuilder -> llvalue */
2133CAMLprim LLVMValueRef llvm_build_is_not_null(LLVMValueRef Val, value Name,
2134                                             value B) {
2135  return LLVMBuildIsNotNull(Builder_val(B), Val, String_val(Name));
2136}
2137
2138/* llvalue -> llvalue -> string -> llbuilder -> llvalue */
2139CAMLprim LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS,
2140                                         value Name, value B) {
2141  return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name));
2142}
2143
2144/*===-- Memory buffers ----------------------------------------------------===*/
2145
2146/* string -> llmemorybuffer
2147   raises IoError msg on error */
2148CAMLprim value llvm_memorybuffer_of_file(value Path) {
2149  CAMLparam1(Path);
2150  char *Message;
2151  LLVMMemoryBufferRef MemBuf;
2152 
2153  if (LLVMCreateMemoryBufferWithContentsOfFile(String_val(Path),
2154                                               &MemBuf, &Message))
2155    llvm_raise(llvm_ioerror_exn, Message);
2156 
2157  CAMLreturn((value) MemBuf);
2158}
2159
2160/* unit -> llmemorybuffer
2161   raises IoError msg on error */
2162CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) {
2163  char *Message;
2164  LLVMMemoryBufferRef MemBuf;
2165 
2166  if (LLVMCreateMemoryBufferWithSTDIN(&MemBuf, &Message))
2167    llvm_raise(llvm_ioerror_exn, Message);
2168 
2169  return MemBuf;
2170}
2171
2172/* ?name:string -> string -> llmemorybuffer */
2173CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_string(value Name, value String) {
2174  const char *NameCStr;
2175  if(Name == Val_int(0))
2176    NameCStr = "";
2177  else
2178    NameCStr = String_val(Field(Name, 0));
2179
2180  LLVMMemoryBufferRef MemBuf;
2181  MemBuf = LLVMCreateMemoryBufferWithMemoryRangeCopy(
2182                String_val(String), caml_string_length(String), NameCStr);
2183
2184  return MemBuf;
2185}
2186
2187/* llmemorybuffer -> string */
2188CAMLprim value llvm_memorybuffer_as_string(LLVMMemoryBufferRef MemBuf) {
2189  value String = caml_alloc_string(LLVMGetBufferSize(MemBuf));
2190  memcpy(String_val(String), LLVMGetBufferStart(MemBuf),
2191         LLVMGetBufferSize(MemBuf));
2192
2193  return String;
2194}
2195
2196/* llmemorybuffer -> unit */
2197CAMLprim value llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf) {
2198  LLVMDisposeMemoryBuffer(MemBuf);
2199  return Val_unit;
2200}
2201
2202/*===-- Pass Managers -----------------------------------------------------===*/
2203
2204/* unit -> [ `Module ] PassManager.t */
2205CAMLprim LLVMPassManagerRef llvm_passmanager_create(value Unit) {
2206  return LLVMCreatePassManager();
2207}
2208
2209/* llmodule -> [ `Function ] PassManager.t -> bool */
2210CAMLprim value llvm_passmanager_run_module(LLVMModuleRef M,
2211                                           LLVMPassManagerRef PM) {
2212  return Val_bool(LLVMRunPassManager(PM, M));
2213}
2214
2215/* [ `Function ] PassManager.t -> bool */
2216CAMLprim value llvm_passmanager_initialize(LLVMPassManagerRef FPM) {
2217  return Val_bool(LLVMInitializeFunctionPassManager(FPM));
2218}
2219
2220/* llvalue -> [ `Function ] PassManager.t -> bool */
2221CAMLprim value llvm_passmanager_run_function(LLVMValueRef F,
2222                                             LLVMPassManagerRef FPM) {
2223  return Val_bool(LLVMRunFunctionPassManager(FPM, F));
2224}
2225
2226/* [ `Function ] PassManager.t -> bool */
2227CAMLprim value llvm_passmanager_finalize(LLVMPassManagerRef FPM) {
2228  return Val_bool(LLVMFinalizeFunctionPassManager(FPM));
2229}
2230
2231/* PassManager.any PassManager.t -> unit */
2232CAMLprim value llvm_passmanager_dispose(LLVMPassManagerRef PM) {
2233  LLVMDisposePassManager(PM);
2234  return Val_unit;
2235}
Note: See TracBrowser for help on using the repository browser.