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 }