Home | History | Annotate | Download | only in target 
      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 }
    391