[llvm] r194774 - [OCaml] Add Target and TargetMachine bindings to Llvm_target
Peter Zotov
whitequark at whitequark.org
Thu Nov 14 18:51:57 PST 2013
Author: whitequark
Date: Thu Nov 14 20:51:57 2013
New Revision: 194774
URL: http://llvm.org/viewvc/llvm-project?rev=194774&view=rev
Log:
[OCaml] Add Target and TargetMachine bindings to Llvm_target
Modified:
llvm/trunk/bindings/ocaml/target/llvm_target.ml
llvm/trunk/bindings/ocaml/target/llvm_target.mli
llvm/trunk/bindings/ocaml/target/target_ocaml.c
llvm/trunk/test/Bindings/Ocaml/target.ml
Modified: llvm/trunk/bindings/ocaml/target/llvm_target.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/target/llvm_target.ml?rev=194774&r1=194773&r2=194774&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/target/llvm_target.ml (original)
+++ llvm/trunk/bindings/ocaml/target/llvm_target.ml Thu Nov 14 20:51:57 2013
@@ -13,6 +13,43 @@ module Endian = struct
| Little
end
+module CodeGenOptLevel = struct
+ type t =
+ | None
+ | Less
+ | Default
+ | Aggressive
+end
+
+module RelocMode = struct
+ type t =
+ | Default
+ | Static
+ | PIC
+ | DynamicNoPIC
+end
+
+module CodeModel = struct
+ type t =
+ | Default
+ | JITDefault
+ | Small
+ | Kernel
+ | Medium
+ | Large
+end
+
+module CodeGenFileType = struct
+ type t =
+ | AssemblyFile
+ | ObjectFile
+end
+
+exception Error of string
+
+external register_exns : exn -> unit = "llvm_register_target_exns"
+let _ = register_exns (Error "")
+
module DataLayout = struct
type t
@@ -49,3 +86,53 @@ module DataLayout = struct
= "llvm_datalayout_offset_of_element"
end
+module Target = struct
+ type t
+
+ external default_triple : unit -> string = "llvm_target_default_triple"
+ external first : unit -> t option = "llvm_target_first"
+ external succ : t -> t option = "llvm_target_succ"
+ external by_name : string -> t option = "llvm_target_by_name"
+ external by_triple : string -> t = "llvm_target_by_triple"
+ external name : t -> string = "llvm_target_name"
+ external description : t -> string = "llvm_target_description"
+ external has_jit : t -> bool = "llvm_target_has_jit"
+ external has_target_machine : t -> bool = "llvm_target_has_target_machine"
+ external has_asm_backend : t -> bool = "llvm_target_has_asm_backend"
+
+ let all () =
+ let rec step elem lst =
+ match elem with
+ | Some target -> step (succ target) (target :: lst)
+ | None -> lst
+ in
+ step (first ()) []
+end
+
+module TargetMachine = struct
+ type t
+
+ external create : triple:string -> ?cpu:string -> ?features:string ->
+ ?level:CodeGenOptLevel.t -> ?reloc_mode:RelocMode.t ->
+ ?code_model:CodeModel.t -> Target.t -> t
+ = "llvm_create_targetmachine_bytecode"
+ "llvm_create_targetmachine_native"
+ external target : t -> Target.t
+ = "llvm_targetmachine_target"
+ external triple : t -> string
+ = "llvm_targetmachine_triple"
+ external cpu : t -> string
+ = "llvm_targetmachine_cpu"
+ external features : t -> string
+ = "llvm_targetmachine_features"
+ external data_layout : t -> DataLayout.t
+ = "llvm_targetmachine_data_layout"
+ external set_verbose_asm : bool -> t -> unit
+ = "llvm_targetmachine_set_verbose_asm"
+ external emit_to_file : Llvm.llmodule -> CodeGenFileType.t -> string ->
+ t -> unit
+ = "llvm_targetmachine_emit_to_file"
+ external emit_to_memory_buffer : Llvm.llmodule -> CodeGenFileType.t ->
+ t -> Llvm.llmemorybuffer
+ = "llvm_targetmachine_emit_to_memory_buffer"
+end
Modified: llvm/trunk/bindings/ocaml/target/llvm_target.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/target/llvm_target.mli?rev=194774&r1=194773&r2=194774&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/target/llvm_target.mli (original)
+++ llvm/trunk/bindings/ocaml/target/llvm_target.mli Thu Nov 14 20:51:57 2013
@@ -18,6 +18,44 @@ module Endian : sig
| Little
end
+module CodeGenOptLevel : sig
+ type t =
+ | None
+ | Less
+ | Default
+ | Aggressive
+end
+
+module RelocMode : sig
+ type t =
+ | Default
+ | Static
+ | PIC
+ | DynamicNoPIC
+end
+
+module CodeModel : sig
+ type t =
+ | Default
+ | JITDefault
+ | Small
+ | Kernel
+ | Medium
+ | Large
+end
+
+module CodeGenFileType : sig
+ type t =
+ | AssemblyFile
+ | ObjectFile
+end
+
+(** {6 Exceptions} *)
+
+exception Error of string
+
+(** {6 Data Layout} *)
+
module DataLayout : sig
type t
@@ -93,3 +131,92 @@ module DataLayout : sig
See the method [llvm::StructLayout::getElementContainingOffset]. *)
val offset_of_element : Llvm.lltype -> int -> t -> Int64.t
end
+
+(** {6 Target} *)
+
+module Target : sig
+ type t
+
+ (** [default_triple ()] returns the default target triple for current
+ platform. *)
+ val default_triple : unit -> string
+
+ (** [first ()] returns the first target in the registered targets
+ list, or [None]. *)
+ val first : unit -> t option
+
+ (** [succ t] returns the next target after [t], or [None]
+ if [t] was the last target. *)
+ val succ : t -> t option
+
+ (** [all ()] returns a list of known targets. *)
+ val all : unit -> t list
+
+ (** [by_name name] returns [Some t] if a target [t] named [name] is
+ registered, or [None] otherwise. *)
+ val by_name : string -> t option
+
+ (** [by_triple triple] returns a target for a triple [triple], or raises
+ [Error] if [triple] does not correspond to a registered target. *)
+ val by_triple : string -> t
+
+ (** Returns the name of a target. See [llvm::Target::getName]. *)
+ val name : t -> string
+
+ (** Returns the description of a target.
+ See [llvm::Target::getDescription]. *)
+ val description : t -> string
+
+ (** Returns [true] if the target has a JIT. *)
+ val has_jit : t -> bool
+
+ (** Returns [true] if the target has a target machine associated. *)
+ val has_target_machine : t -> bool
+
+ (** Returns [true] if the target has an ASM backend (required for
+ emitting output). *)
+ val has_asm_backend : t -> bool
+end
+
+(** {6 Target Machine} *)
+
+module TargetMachine : sig
+ type t
+
+ (** Creates a new target machine.
+ See [llvm::Target::createTargetMachine]. *)
+ val create : triple:string -> ?cpu:string -> ?features:string ->
+ ?level:CodeGenOptLevel.t -> ?reloc_mode:RelocMode.t ->
+ ?code_model:CodeModel.t -> Target.t -> t
+
+ (** Returns the Target used in a TargetMachine *)
+ val target : t -> Target.t
+
+ (** Returns the triple used while creating this target machine. See
+ [llvm::TargetMachine::getTriple]. *)
+ val triple : t -> string
+
+ (** Returns the CPU used while creating this target machine. See
+ [llvm::TargetMachine::getCPU]. *)
+ val cpu : t -> string
+
+ (** Returns the feature string used while creating this target machine. See
+ [llvm::TargetMachine::getFeatureString]. *)
+ val features : t -> string
+
+ (** Returns the data layout of this target machine. *)
+ val data_layout : t -> DataLayout.t
+
+ (** Sets the assembly verbosity of this target machine.
+ See [llvm::TargetMachine::setAsmVerbosity]. *)
+ val set_verbose_asm : bool -> t -> unit
+
+ (** Emits assembly or object data for the given module to the given
+ file or raise [Error]. *)
+ val emit_to_file : Llvm.llmodule -> CodeGenFileType.t -> string -> t -> unit
+
+ (** Emits assembly or object data for the given module to a fresh memory
+ buffer or raise [Error]. *)
+ val emit_to_memory_buffer : Llvm.llmodule -> CodeGenFileType.t -> t ->
+ Llvm.llmemorybuffer
+end
Modified: llvm/trunk/bindings/ocaml/target/target_ocaml.c
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/target/target_ocaml.c?rev=194774&r1=194773&r2=194774&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/target/target_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/target/target_ocaml.c Thu Nov 14 20:51:57 2013
@@ -16,9 +16,45 @@
\*===----------------------------------------------------------------------===*/
#include "llvm-c/Target.h"
+#include "llvm-c/TargetMachine.h"
#include "caml/alloc.h"
+#include "caml/fail.h"
+#include "caml/memory.h"
#include "caml/custom.h"
+/*===---- Exceptions ------------------------------------------------------===*/
+
+static value llvm_target_error_exn;
+
+CAMLprim value llvm_register_target_exns(value Error) {
+ llvm_target_error_exn = Field(Error, 0);
+ register_global_root(&llvm_target_error_exn);
+ return Val_unit;
+}
+
+static void llvm_raise(value Prototype, char *Message) {
+ CAMLparam1(Prototype);
+ CAMLlocal1(CamlMessage);
+
+ CamlMessage = copy_string(Message);
+ LLVMDisposeMessage(Message);
+
+ raise_with_arg(Prototype, CamlMessage);
+ abort(); /* NOTREACHED */
+#ifdef CAMLnoreturn
+ CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
+#endif
+}
+
+static value llvm_string_of_message(char* Message) {
+ value String = caml_copy_string(Message);
+ LLVMDisposeMessage(Message);
+
+ return String;
+}
+
+/*===---- Data Layout -----------------------------------------------------===*/
+
#define DataLayout_val(v) (*(LLVMTargetDataRef *)(Data_custom_val(v)))
static void llvm_finalize_data_layout(value DataLayout) {
@@ -38,7 +74,8 @@ static struct custom_operations llvm_dat
};
value llvm_alloc_data_layout(LLVMTargetDataRef DataLayout) {
- value V = alloc_custom(&llvm_data_layout_ops, sizeof(LLVMTargetDataRef), 0, 1);
+ value V = alloc_custom(&llvm_data_layout_ops, sizeof(LLVMTargetDataRef),
+ 0, 1);
DataLayout_val(V) = DataLayout;
return V;
}
@@ -139,3 +176,215 @@ CAMLprim value llvm_datalayout_offset_of
return caml_copy_int64(LLVMOffsetOfElement(DataLayout_val(DL), Ty,
Int_val(Index)));
}
+
+/*===---- Target ----------------------------------------------------------===*/
+
+static value llvm_target_option(LLVMTargetRef Target) {
+ if(Target != NULL) {
+ value Result = caml_alloc_small(1, 0);
+ Store_field(Result, 0, (value) Target);
+ return Result;
+ }
+
+ return Val_int(0);
+}
+
+/* unit -> string */
+CAMLprim value llvm_target_default_triple(value Unit) {
+ char *TripleCStr = LLVMGetDefaultTargetTriple();
+ value TripleStr = caml_copy_string(TripleCStr);
+ LLVMDisposeMessage(TripleCStr);
+
+ return TripleStr;
+}
+
+/* unit -> Target.t option */
+CAMLprim value llvm_target_first(value Unit) {
+ return llvm_target_option(LLVMGetFirstTarget());
+}
+
+/* Target.t -> Target.t option */
+CAMLprim value llvm_target_succ(LLVMTargetRef Target) {
+ return llvm_target_option(LLVMGetNextTarget(Target));
+}
+
+/* string -> Target.t option */
+CAMLprim value llvm_target_by_name(value Name) {
+ return llvm_target_option(LLVMGetTargetFromName(String_val(Name)));
+}
+
+/* string -> Target.t */
+CAMLprim LLVMTargetRef llvm_target_by_triple(value Triple) {
+ LLVMTargetRef T;
+ char *Error;
+
+ if(LLVMGetTargetFromTriple(String_val(Triple), &T, &Error))
+ llvm_raise(llvm_target_error_exn, Error);
+
+ return T;
+}
+
+/* Target.t -> string */
+CAMLprim value llvm_target_name(LLVMTargetRef Target) {
+ return caml_copy_string(LLVMGetTargetName(Target));
+}
+
+/* Target.t -> string */
+CAMLprim value llvm_target_description(LLVMTargetRef Target) {
+ return caml_copy_string(LLVMGetTargetDescription(Target));
+}
+
+/* Target.t -> bool */
+CAMLprim value llvm_target_has_jit(LLVMTargetRef Target) {
+ return Val_bool(LLVMTargetHasJIT(Target));
+}
+
+/* Target.t -> bool */
+CAMLprim value llvm_target_has_target_machine(LLVMTargetRef Target) {
+ return Val_bool(LLVMTargetHasTargetMachine(Target));
+}
+
+/* Target.t -> bool */
+CAMLprim value llvm_target_has_asm_backend(LLVMTargetRef Target) {
+ return Val_bool(LLVMTargetHasAsmBackend(Target));
+}
+
+/*===---- Target Machine --------------------------------------------------===*/
+
+#define TargetMachine_val(v) (*(LLVMTargetMachineRef *)(Data_custom_val(v)))
+
+static void llvm_finalize_target_machine(value Machine) {
+ LLVMDisposeTargetMachine(TargetMachine_val(Machine));
+}
+
+static struct custom_operations llvm_target_machine_ops = {
+ (char *) "LLVMTargetMachine",
+ llvm_finalize_target_machine,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default
+#ifdef custom_compare_ext_default
+ , custom_compare_ext_default
+#endif
+};
+
+static value llvm_alloc_targetmachine(LLVMTargetMachineRef Machine) {
+ value V = alloc_custom(&llvm_target_machine_ops, sizeof(LLVMTargetMachineRef),
+ 0, 1);
+ TargetMachine_val(V) = Machine;
+ return V;
+}
+
+/* triple:string -> ?cpu:string -> ?features:string
+ ?level:CodeGenOptLevel.t -> ?reloc_mode:RelocMode.t
+ ?code_model:CodeModel.t -> Target.t -> TargetMachine.t */
+CAMLprim value llvm_create_targetmachine_native(value Triple, value CPU,
+ value Features, value OptLevel, value RelocMode,
+ value CodeModel, LLVMTargetRef Target) {
+ LLVMTargetMachineRef Machine;
+ const char *CPUStr = "", *FeaturesStr = "";
+ LLVMCodeGenOptLevel OptLevelEnum = LLVMCodeGenLevelDefault;
+ LLVMRelocMode RelocModeEnum = LLVMRelocDefault;
+ LLVMCodeModel CodeModelEnum = LLVMCodeModelDefault;
+
+ if(CPU != Val_int(0))
+ CPUStr = String_val(Field(CPU, 0));
+ if(Features != Val_int(0))
+ FeaturesStr = String_val(Field(Features, 0));
+ if(OptLevel != Val_int(0))
+ OptLevelEnum = Int_val(Field(OptLevel, 0));
+ if(RelocMode != Val_int(0))
+ RelocModeEnum = Int_val(Field(RelocMode, 0));
+ if(CodeModel != Val_int(0))
+ CodeModelEnum = Int_val(Field(CodeModel, 0));
+
+ Machine = LLVMCreateTargetMachine(Target, String_val(Triple), CPUStr,
+ FeaturesStr, OptLevelEnum, RelocModeEnum, CodeModelEnum);
+
+ return llvm_alloc_targetmachine(Machine);
+}
+
+CAMLprim value llvm_create_targetmachine_bytecode(value *argv, int argn) {
+ return llvm_create_targetmachine_native(argv[0], argv[1], argv[2], argv[3],
+ argv[4], argv[5], (LLVMTargetRef) argv[6]);
+}
+
+/* TargetMachine.t -> Target.t */
+CAMLprim LLVMTargetRef llvm_targetmachine_target(value Machine) {
+ return LLVMGetTargetMachineTarget(TargetMachine_val(Machine));
+}
+
+/* TargetMachine.t -> string */
+CAMLprim value llvm_targetmachine_triple(value Machine) {
+ return llvm_string_of_message(LLVMGetTargetMachineTriple(
+ TargetMachine_val(Machine)));
+}
+
+/* TargetMachine.t -> string */
+CAMLprim value llvm_targetmachine_cpu(value Machine) {
+ return llvm_string_of_message(LLVMGetTargetMachineCPU(
+ TargetMachine_val(Machine)));
+}
+
+/* TargetMachine.t -> string */
+CAMLprim value llvm_targetmachine_features(value Machine) {
+ return llvm_string_of_message(LLVMGetTargetMachineFeatureString(
+ TargetMachine_val(Machine)));
+}
+
+/* TargetMachine.t -> DataLayout.t */
+CAMLprim value llvm_targetmachine_data_layout(value Machine) {
+ CAMLparam1(Machine);
+ CAMLlocal1(DataLayout);
+
+ /* LLVMGetTargetMachineData returns a pointer owned by the TargetMachine,
+ so it is impossible to wrap it with llvm_alloc_target_data, which assumes
+ that OCaml owns the pointer. */
+ LLVMTargetDataRef OrigDataLayout;
+ OrigDataLayout = LLVMGetTargetMachineData(TargetMachine_val(Machine));
+
+ char* TargetDataCStr;
+ TargetDataCStr = LLVMCopyStringRepOfTargetData(OrigDataLayout);
+ DataLayout = llvm_alloc_data_layout(LLVMCreateTargetData(TargetDataCStr));
+ LLVMDisposeMessage(TargetDataCStr);
+
+ CAMLreturn(DataLayout);
+}
+
+/* TargetMachine.t -> bool -> unit */
+CAMLprim value llvm_targetmachine_set_verbose_asm(value Machine, value Verb) {
+ LLVMSetTargetMachineAsmVerbosity(TargetMachine_val(Machine), Bool_val(Verb));
+ return Val_unit;
+}
+
+/* Llvm.llmodule -> CodeGenFileType.t -> string -> TargetMachine.t -> unit */
+CAMLprim value llvm_targetmachine_emit_to_file(LLVMModuleRef Module,
+ value FileType, value FileName, value Machine) {
+ char* ErrorMessage;
+
+ if(LLVMTargetMachineEmitToFile(TargetMachine_val(Machine), Module,
+ String_val(FileName), Int_val(FileType),
+ &ErrorMessage)) {
+ llvm_raise(llvm_target_error_exn, ErrorMessage);
+ }
+
+ return Val_unit;
+}
+
+/* Llvm.llmodule -> CodeGenFileType.t -> TargetMachine.t ->
+ Llvm.llmemorybuffer */
+CAMLprim LLVMMemoryBufferRef llvm_targetmachine_emit_to_memory_buffer(
+ LLVMModuleRef Module, value FileType,
+ value Machine) {
+ char* ErrorMessage;
+ LLVMMemoryBufferRef Buffer;
+
+ if(LLVMTargetMachineEmitToMemoryBuffer(TargetMachine_val(Machine), Module,
+ Int_val(FileType), &ErrorMessage,
+ &Buffer)) {
+ llvm_raise(llvm_target_error_exn, ErrorMessage);
+ }
+
+ return Buffer;
+}
Modified: llvm/trunk/test/Bindings/Ocaml/target.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/target.ml?rev=194774&r1=194773&r2=194774&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/target.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/target.ml Thu Nov 14 20:51:57 2013
@@ -1,7 +1,7 @@
(* RUN: rm -rf %t.builddir
* RUN: mkdir -p %t.builddir
* RUN: cp %s %t.builddir
- * RUN: %ocamlopt -g -warn-error A llvm.cmxa llvm_target.cmxa %t.builddir/target.ml -o %t
+ * RUN: %ocamlopt -g -warn-error A llvm.cmxa llvm_target.cmxa llvm_X86.cmxa %t.builddir/target.ml -o %t
* RUN: %t %t.bc
* XFAIL: vg_leak
*)
@@ -13,6 +13,7 @@
open Llvm
open Llvm_target
+let _ = Llvm_X86.initialize ()
let context = global_context ()
let i32_type = Llvm.i32_type context
@@ -33,8 +34,15 @@ let assert_equal a b =
let filename = Sys.argv.(1)
let m = create_module context filename
+let target =
+ match Target.by_name "x86" with
+ | Some t -> t
+ | None -> failwith "need a target"
-(*===-- Target Data -------------------------------------------------------===*)
+let machine =
+ TargetMachine.create ~triple:"i686-linux-gnu" ~cpu:"core2" target
+
+(*===-- Data Layout -------------------------------------------------------===*)
let test_target_data () =
let module DL = DataLayout in
@@ -63,8 +71,50 @@ let test_target_data () =
ignore (DL.add_to_pass_manager pm dl)
+(*===-- Target ------------------------------------------------------------===*)
+
+let test_target () =
+ let module T = Target in
+ ignore (T.succ target);
+ assert_equal (T.name target) "x86";
+ assert_equal (T.description target) "32-bit X86: Pentium-Pro and above";
+ assert_equal (T.has_jit target) true;
+ assert_equal (T.has_target_machine target) true;
+ assert_equal (T.has_asm_backend target) true
+
+
+(*===-- Target Machine ----------------------------------------------------===*)
+
+let test_target_machine () =
+ let module TM = TargetMachine in
+ assert_equal (TM.target machine) target;
+ assert_equal (TM.triple machine) "i686-linux-gnu";
+ assert_equal (TM.cpu machine) "core2";
+ assert_equal (TM.features machine) "";
+ ignore (TM.data_layout machine)
+
+
+(*===-- Code Emission -----------------------------------------------------===*)
+
+let test_code_emission () =
+ TargetMachine.emit_to_file m CodeGenFileType.ObjectFile filename machine;
+ try
+ TargetMachine.emit_to_file m CodeGenFileType.ObjectFile
+ "/nonexistent/file" machine;
+ failwith "must raise"
+ with Llvm_target.Error _ ->
+ ();
+
+ let buf = TargetMachine.emit_to_memory_buffer m CodeGenFileType.ObjectFile
+ machine in
+ Llvm.MemoryBuffer.dispose buf
+
+
(*===-- Driver ------------------------------------------------------------===*)
let _ =
test_target_data ();
+ test_target ();
+ test_target_machine ();
+ (* test_code_emission (); *) (* broken without AsmParser support *)
dispose_module m
More information about the llvm-commits
mailing list