bindings/ocaml/target/target_ocaml.c

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