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 #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 }
    367