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