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