bindings/ocaml/target/target_ocaml.c

   1 /*===-- target_ocaml.c - LLVM OCaml Glue ------------------------*- C++ -*-===*\
   2 |*                                                                            *|
   3 |* Part of the LLVM Project, under the Apache License v2.0 with LLVM          *|
   4 |* Exceptions.                                                                *|
   5 |* See https://llvm.org/LICENSE.txt for license information.                  *|
   6 |* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception                    *|
   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 }