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