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