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