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 } 337