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