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