From 8ef426baa36639458f6777309db25c1768dc9c8a Mon Sep 17 00:00:00 2001 From: Gordon Henriksen Date: Tue, 18 Sep 2007 12:49:39 +0000 Subject: [PATCH] Adding ocaml language bindings for the vmcore and bitwriter libraries. These are built atop the C language bindings, and user programs can link with them as such: # Bytecode ocamlc -cc g++ llvm.cma llvmbitwriter.cma -o example example.ml # Native ocamlopt -cc g++ llvm.cmxa llvmbitwriter.cmxa -o example.opt example.ml The vmcore.ml test exercises most/all of the APIs thus far bound. Unfortunately, they're not yet numerous enough to write hello world. But: $ cat example.ml (* example.ml *) open Llvm open Llvm_bitwriter let _ = let filename = Sys.argv.(1) in let m = create_module filename in let v = make_int_constant i32_type 42 false in let g = define_global "hello_world" v m in if not (write_bitcode_file m filename) then exit 1; dispose_module m; $ ocamlc -cc g++ llvm.cma llvm_bitwriter.cma -o example example.ml File "example.ml", line 11, characters 6-7: Warning Y: unused variable g. $ ./example example.bc $ llvm-dis < example.bc ; ModuleID = '' @hello_world = global i32 42 ; [#uses=0] The ocaml test cases provide effective tests for the C interfaces. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@42093 91177308-0d34-0410-b5e6-96231b3b80d8 --- Makefile | 4 +- bindings/Makefile | 18 + bindings/README.txt | 3 + bindings/ocaml/Makefile | 13 + bindings/ocaml/bitwriter/Makefile | 23 ++ bindings/ocaml/bitwriter/bitwriter_ocaml.c | 31 ++ bindings/ocaml/bitwriter/llvm_bitwriter.ml | 18 + bindings/ocaml/bitwriter/llvm_bitwriter.mli | 18 + bindings/ocaml/llvm/Makefile | 24 ++ bindings/ocaml/llvm/llvm.ml | 228 +++++++++++ bindings/ocaml/llvm/llvm.mli | 170 ++++++++ bindings/ocaml/llvm/llvm_ocaml.c | 410 ++++++++++++++++++++ test/Bindings/Ocaml/bitwriter.ml | 16 + test/Bindings/Ocaml/ocaml.exp | 3 + test/Bindings/Ocaml/vmcore.ml | 233 +++++++++++ test/lib/llvm.exp | 4 +- 16 files changed, 1213 insertions(+), 3 deletions(-) create mode 100644 bindings/Makefile create mode 100644 bindings/README.txt create mode 100644 bindings/ocaml/Makefile create mode 100644 bindings/ocaml/bitwriter/Makefile create mode 100644 bindings/ocaml/bitwriter/bitwriter_ocaml.c create mode 100644 bindings/ocaml/bitwriter/llvm_bitwriter.ml create mode 100644 bindings/ocaml/bitwriter/llvm_bitwriter.mli create mode 100644 bindings/ocaml/llvm/Makefile create mode 100644 bindings/ocaml/llvm/llvm.ml create mode 100644 bindings/ocaml/llvm/llvm.mli create mode 100644 bindings/ocaml/llvm/llvm_ocaml.c create mode 100644 test/Bindings/Ocaml/bitwriter.ml create mode 100644 test/Bindings/Ocaml/ocaml.exp create mode 100644 test/Bindings/Ocaml/vmcore.ml diff --git a/Makefile b/Makefile index 0be1f122aac..c367e731acd 100644 --- a/Makefile +++ b/Makefile @@ -20,7 +20,7 @@ LEVEL := . DIRS := lib/System lib/Support utils lib/VMCore lib tools/llvm-config \ tools runtime docs -OPTIONAL_DIRS := examples projects +OPTIONAL_DIRS := examples projects bindings EXTRA_DIST := test llvm.spec include win32 Xcode include $(LEVEL)/Makefile.config @@ -46,7 +46,7 @@ endif # build LLVM. ifeq ($(MAKECMDGOALS),install) DIRS := $(filter-out utils, $(DIRS)) - OPTIONAL_DIRS := + OPTIONAL_DIRS := $(filter bindings, $(OPTIONAL_DIRS)) endif # Include the main makefile machinery. diff --git a/bindings/Makefile b/bindings/Makefile new file mode 100644 index 00000000000..82f84bc9cb9 --- /dev/null +++ b/bindings/Makefile @@ -0,0 +1,18 @@ +##===- bindings/Makefile -----------------------------------*- Makefile -*-===## +# +# The LLVM Compiler Infrastructure +# +# This file was developed by Gordon Henriksen and is distributed under the +# University of Illinois Open Source License. See LICENSE.TXT for details. +# +##===----------------------------------------------------------------------===## + +LEVEL := .. + +include $(LEVEL)/Makefile.config + +ifdef OCAMLC +PARALLEL_DIRS += ocaml +endif + +include $(LEVEL)/Makefile.common diff --git a/bindings/README.txt b/bindings/README.txt new file mode 100644 index 00000000000..7693cb2cead --- /dev/null +++ b/bindings/README.txt @@ -0,0 +1,3 @@ +This directory contains bindings for the LLVM compiler infrastructure to allow +programs written in languages other than C or C++ to take advantage of the LLVM +infrastructure--for instance, a self-hosted compiler front-end. diff --git a/bindings/ocaml/Makefile b/bindings/ocaml/Makefile new file mode 100644 index 00000000000..0fc6b1b6eef --- /dev/null +++ b/bindings/ocaml/Makefile @@ -0,0 +1,13 @@ +##===- bindings/ocaml/Makefile -----------------------------*- Makefile -*-===## +# +# The LLVM Compiler Infrastructure +# +# This file was developed by Gordon Henriksen and is distributed under the +# University of Illinois Open Source License. See LICENSE.TXT for details. +# +##===----------------------------------------------------------------------===## + +LEVEL := ../.. +DIRS = llvm bitwriter + +include $(LEVEL)/Makefile.common diff --git a/bindings/ocaml/bitwriter/Makefile b/bindings/ocaml/bitwriter/Makefile new file mode 100644 index 00000000000..aef41f50092 --- /dev/null +++ b/bindings/ocaml/bitwriter/Makefile @@ -0,0 +1,23 @@ +##===- bindings/ocaml/llvm/Makefile ------------------------*- Makefile -*-===## +# +# The LLVM Compiler Infrastructure +# +# This file was developed by the LLVM research group and is distributed under +# the University of Illinois Open Source License. See LICENSE.TXT for details. +# +##===----------------------------------------------------------------------===## +# +# This is the makefile for the llvm-ml interface. Reference materials on +# installing ocaml libraries: +# +# https://fedoraproject.org/wiki/Packaging/OCaml +# http://pkg-ocaml-maint.alioth.debian.org/ocaml_packaging_policy.txt +# +##===----------------------------------------------------------------------===## + +LEVEL := ../../.. +LIBRARYNAME := llvm_bitwriter +DONT_BUILD_RELINKED := 1 +UsedComponents := bitwriter + +include ../Makefile.ocaml diff --git a/bindings/ocaml/bitwriter/bitwriter_ocaml.c b/bindings/ocaml/bitwriter/bitwriter_ocaml.c new file mode 100644 index 00000000000..4abfa9f7b90 --- /dev/null +++ b/bindings/ocaml/bitwriter/bitwriter_ocaml.c @@ -0,0 +1,31 @@ +/*===-- bitwriter_ocaml.c - LLVM Ocaml Glue ---------------------*- C++ -*-===*\ +|* *| +|* The LLVM Compiler Infrastructure *| +|* *| +|* This file was developed by Gordon Henriksen and is distributed under the *| +|* University of Illinois Open Source License. See LICENSE.TXT for details. *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's ocaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/BitWriter.h" +#include "llvm-c/Core.h" +#include "caml/alloc.h" +#include "caml/mlvalues.h" +#include "caml/memory.h" + +/*===-- Modules -----------------------------------------------------------===*/ + +/* Llvm.llmodule -> string -> bool */ +CAMLprim value llvm_write_bitcode_file(value M, value Path) { + CAMLparam1(Path); + int res = LLVMWriteBitcodeToFile((LLVMModuleRef) M, String_val(Path)); + CAMLreturn(Val_bool(res == 0)); +} diff --git a/bindings/ocaml/bitwriter/llvm_bitwriter.ml b/bindings/ocaml/bitwriter/llvm_bitwriter.ml new file mode 100644 index 00000000000..c9264b16c13 --- /dev/null +++ b/bindings/ocaml/bitwriter/llvm_bitwriter.ml @@ -0,0 +1,18 @@ +(*===-- llvm_bitwriter.ml - LLVM Ocaml Interface ----------------*- C++ -*-===* + * + * The LLVM Compiler Infrastructure + * + * This file was developed by Gordon Henriksen and is distributed under the + * University of Illinois Open Source License. See LICENSE.TXT for details. + * + *===----------------------------------------------------------------------=== + * + * This interface provides an ocaml API for the LLVM intermediate + * representation, the classes in the VMCore library. + * + *===----------------------------------------------------------------------===*) + + +(* Writes the bitcode for module the given path. Returns true if successful. *) +external write_bitcode_file : Llvm.llmodule -> string -> bool + = "llvm_write_bitcode_file" diff --git a/bindings/ocaml/bitwriter/llvm_bitwriter.mli b/bindings/ocaml/bitwriter/llvm_bitwriter.mli new file mode 100644 index 00000000000..3b7c6d49589 --- /dev/null +++ b/bindings/ocaml/bitwriter/llvm_bitwriter.mli @@ -0,0 +1,18 @@ +(*===-- llvm_bitwriter.mli - LLVM Ocaml Interface ---------------*- C++ -*-===* + * + * The LLVM Compiler Infrastructure + * + * This file was developed by Gordon Henriksen and is distributed under the + * University of Illinois Open Source License. See LICENSE.TXT for details. + * + *===----------------------------------------------------------------------=== + * + * This interface provides an ocaml API for the LLVM bitcode writer, the + * classes in the classes in the Bitwriter library. + * + *===----------------------------------------------------------------------===*) + + +(* Writes the bitcode for module the given path. Returns true if successful. *) +external write_bitcode_file : Llvm.llmodule -> string -> bool + = "llvm_write_bitcode_file" diff --git a/bindings/ocaml/llvm/Makefile b/bindings/ocaml/llvm/Makefile new file mode 100644 index 00000000000..cbfb75ca157 --- /dev/null +++ b/bindings/ocaml/llvm/Makefile @@ -0,0 +1,24 @@ +##===- bindings/ocaml/bitwriter/Makefile -------------------*- Makefile -*-===## +# +# The LLVM Compiler Infrastructure +# +# This file was developed by the LLVM research group and is distributed under +# the University of Illinois Open Source License. See LICENSE.TXT for details. +# +##===----------------------------------------------------------------------===## +# +# This is the makefile for the llvm-ml interface. Reference materials on +# installing ocaml libraries: +# +# https://fedoraproject.org/wiki/Packaging/OCaml +# http://pkg-ocaml-maint.alioth.debian.org/ocaml_packaging_policy.txt +# +##===----------------------------------------------------------------------===## + +LEVEL := ../../.. +LIBRARYNAME := llvm +DONT_BUILD_RELINKED := 1 +UsedComponents := core +UsedOcamLibs := llvm + +include ../Makefile.ocaml diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml new file mode 100644 index 00000000000..18a9e2154a3 --- /dev/null +++ b/bindings/ocaml/llvm/llvm.ml @@ -0,0 +1,228 @@ +(*===-- tools/ml/llvm.ml - LLVM Ocaml Interface ---------------------------===* + * + * The LLVM Compiler Infrastructure + * + * This file was developed by Gordon Henriksen and is distributed under the + * University of Illinois Open Source License. See LICENSE.TXT for details. + * + *===----------------------------------------------------------------------=== + * + * This interface provides an ocaml API for the LLVM intermediate + * representation, the classes in the VMCore library. + * + *===----------------------------------------------------------------------===*) + + +(* These abstract types correlate directly to the LLVM VMCore classes. *) +type llmodule +type lltype +type llvalue + +type type_kind = + Void_type +| Float_type +| Double_type +| X86fp80_type +| Fp128_type +| Ppc_fp128_type +| Label_type +| Integer_type +| Function_type +| Struct_type +| Array_type +| Pointer_type +| Opaque_type +| Vector_type + +type linkage = + External_linkage +| Link_once_linkage +| Weak_linkage +| Appending_linkage +| Internal_linkage +| Dllimport_linkage +| Dllexport_linkage +| External_weak_linkage +| Ghost_linkage + +type visibility = + Default_visibility +| Hidden_visibility +| Protected_visibility + + +(*===-- Modules -----------------------------------------------------------===*) + +(* Creates a module with the supplied module ID. Modules are not garbage + collected; it is mandatory to call dispose_module to free memory. *) +external create_module : string -> llmodule = "llvm_create_module" + +(* Disposes a module. All references to subordinate objects are invalidated; + referencing them will invoke undefined behavior. *) +external dispose_module : llmodule -> unit = "llvm_dispose_module" + +(* Adds a named type to the module's symbol table. Returns true if successful. + If such a name already exists, then no entry is added and returns false. *) +external add_type_name : string -> lltype -> llmodule -> bool + = "llvm_add_type_name" + + +(*===-- Types -------------------------------------------------------------===*) + +external classify_type : lltype -> type_kind = "llvm_classify_type" +external refine_abstract_type : lltype -> lltype -> unit + = "llvm_refine_abstract_type" + +(*--... Operations on integer types ........................................--*) +external _i1_type : unit -> lltype = "llvm_i1_type" +external _i8_type : unit -> lltype = "llvm_i8_type" +external _i16_type : unit -> lltype = "llvm_i16_type" +external _i32_type : unit -> lltype = "llvm_i32_type" +external _i64_type : unit -> lltype = "llvm_i64_type" + +let i1_type = _i1_type () +let i8_type = _i8_type () +let i16_type = _i16_type () +let i32_type = _i32_type () +let i64_type = _i64_type () + +external make_integer_type : int -> lltype = "llvm_make_integer_type" +external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth" + +(*--... Operations on real types ...........................................--*) +external _float_type : unit -> lltype = "llvm_float_type" +external _double_type : unit -> lltype = "llvm_double_type" +external _x86fp80_type : unit -> lltype = "llvm_x86fp80_type" +external _fp128_type : unit -> lltype = "llvm_fp128_type" +external _ppc_fp128_type : unit -> lltype = "llvm_ppc_fp128_type" + +let float_type = _float_type () +let double_type = _double_type () +let x86fp80_type = _x86fp80_type () +let fp128_type = _fp128_type () +let ppc_fp128_type = _ppc_fp128_type () + +(*--... Operations on function types .......................................--*) +(* FIXME: handle parameter attributes *) +external make_function_type : lltype -> lltype array -> bool -> lltype + = "llvm_make_function_type" +external is_var_arg : lltype -> bool = "llvm_is_var_arg" +external return_type : lltype -> lltype = "llvm_return_type" +external param_types : lltype -> lltype array = "llvm_param_types" + +(*--... Operations on struct types .........................................--*) +external make_struct_type : lltype array -> bool -> lltype + = "llvm_make_struct_type" +external element_types : lltype -> lltype array = "llvm_element_types" +external is_packed : lltype -> bool = "llvm_is_packed" + +(*--... Operations on pointer, vector, and array types .....................--*) +external make_array_type : lltype -> int -> lltype = "llvm_make_array_type" +external make_pointer_type : lltype -> lltype = "llvm_make_pointer_type" +external make_vector_type : lltype -> int -> lltype = "llvm_make_vector_type" + +external element_type : lltype -> lltype = "llvm_element_type" +external array_length : lltype -> int = "llvm_array_length" +external vector_size : lltype -> int = "llvm_vector_size" + +(*--... Operations on other types ..........................................--*) +external make_opaque_type : unit -> lltype = "llvm_make_opaque_type" +external _void_type : unit -> lltype = "llvm_void_type" +external _label_type : unit -> lltype = "llvm_label_type" + +let void_type = _void_type () +let label_type = _label_type () + + +(*===-- Values ------------------------------------------------------------===*) + +external type_of : llvalue -> lltype = "llvm_type_of" +external value_name : llvalue -> string = "llvm_value_name" +external set_value_name : string -> llvalue -> unit = "llvm_set_value_name" + +(*--... Operations on constants of (mostly) any type .......................--*) +external make_null : lltype -> llvalue = "llvm_make_null" +external make_all_ones : lltype -> llvalue = "llvm_make_all_ones" +external make_undef : lltype -> llvalue = "llvm_make_undef" +external is_null : llvalue -> bool = "llvm_is_null" + +(*--... Operations on scalar constants .....................................--*) +external make_int_constant : lltype -> int -> bool -> llvalue + = "llvm_make_int_constant" +external make_real_constant : lltype -> float -> llvalue + = "llvm_make_real_constant" + +(*--... Operations on composite constants ..................................--*) +external make_string_constant : string -> bool -> llvalue + = "llvm_make_string_constant" +external make_array_constant : lltype -> llvalue array -> llvalue + = "llvm_make_array_constant" +external make_struct_constant : llvalue array -> bool -> llvalue + = "llvm_make_struct_constant" +external make_vector_constant : llvalue array -> llvalue + = "llvm_make_vector_constant" + +(*--... Operations on global variables, functions, and aliases (globals) ...--*) +external is_declaration : llvalue -> bool = "llvm_is_declaration" +external linkage : llvalue -> linkage = "llvm_linkage" +external set_linkage : linkage -> llvalue -> unit = "llvm_set_linkage" +external section : llvalue -> string = "llvm_section" +external set_section : string -> llvalue -> unit = "llvm_set_section" +external visibility : llvalue -> visibility = "llvm_visibility" +external set_visibility : visibility -> llvalue -> unit = "llvm_set_visibility" +external alignment : llvalue -> int = "llvm_alignment" +external set_alignment : int -> llvalue -> unit = "llvm_set_alignment" + +(*--... Operations on global variables .....................................--*) +external declare_global : lltype -> string -> llmodule -> llvalue + = "llvm_declare_global" +external define_global : string -> llvalue -> llmodule -> llvalue + = "llvm_define_global" +external delete_global : llvalue -> unit = "llvm_delete_global" +external global_initializer : llvalue -> llvalue = "llvm_global_initializer" +external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer" +external remove_initializer : llvalue -> unit = "llvm_remove_initializer" +external is_thread_local : llvalue -> bool = "llvm_is_thread_local" +external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local" + + +(*===-- Non-Externs -------------------------------------------------------===*) +(* These functions are built using the externals, so must be declared late. *) + +let concat2 sep arr = + let s = ref "" in + if 0 < Array.length arr then begin + s := !s ^ arr.(0); + for i = 1 to (Array.length arr) - 1 do + s := !s ^ sep ^ arr.(i) + done + end; + !s + +let rec string_of_lltype ty = + match classify_type ty with + Integer_type -> "i" ^ string_of_int (integer_bitwidth ty) + | Pointer_type -> (string_of_lltype (element_type ty)) ^ "*" + | Struct_type -> + let s = "{ " ^ (concat2 ", " ( + Array.map string_of_lltype (element_types ty) + )) ^ " }" in + if is_packed ty + then "<" ^ s ^ ">" + else s + | Array_type -> "[" ^ (string_of_int (array_length ty)) ^ + " x " ^ (string_of_lltype (element_type ty)) ^ "]" + | Vector_type -> "<" ^ (string_of_int (vector_size ty)) ^ + " x " ^ (string_of_lltype (element_type ty)) ^ ">" + | Opaque_type -> "opaque" + | Function_type -> string_of_lltype (return_type ty) ^ + " (" ^ (concat2 ", " ( + Array.map string_of_lltype (param_types ty) + )) ^ ")" + | Label_type -> "label" + | Ppc_fp128_type -> "ppc_fp128" + | Fp128_type -> "fp128" + | X86fp80_type -> "x86_fp80" + | Double_type -> "double" + | Float_type -> "float" + | Void_type -> "void" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli new file mode 100644 index 00000000000..7e14cd78bb6 --- /dev/null +++ b/bindings/ocaml/llvm/llvm.mli @@ -0,0 +1,170 @@ +(*===-- tools/ml/llvm.ml - LLVM Ocaml Interface ---------------------------===* + * + * The LLVM Compiler Infrastructure + * + * This file was developed by Gordon Henriksen and is distributed under the + * University of Illinois Open Source License. See LICENSE.TXT for details. + * + *===----------------------------------------------------------------------=== + * + * This interface provides an ocaml API for the LLVM intermediate + * representation, the classes in the VMCore library. + * + *===----------------------------------------------------------------------===*) + + +(* These abstract types correlate directly to the LLVM VMCore classes. *) +type llmodule +type lltype +type llvalue + +type type_kind = + Void_type +| Float_type +| Double_type +| X86fp80_type +| Fp128_type +| Ppc_fp128_type +| Label_type +| Integer_type +| Function_type +| Struct_type +| Array_type +| Pointer_type +| Opaque_type +| Vector_type + +type linkage = + External_linkage +| Link_once_linkage +| Weak_linkage +| Appending_linkage +| Internal_linkage +| Dllimport_linkage +| Dllexport_linkage +| External_weak_linkage +| Ghost_linkage + +type visibility = + Default_visibility +| Hidden_visibility +| Protected_visibility + + +(*===-- Modules -----------------------------------------------------------===*) + +(* Creates a module with the supplied module ID. Modules are not garbage + collected; it is mandatory to call dispose_module to free memory. *) +external create_module : string -> llmodule = "llvm_create_module" + +(* Disposes a module. All references to subordinate objects are invalidated; + referencing them will invoke undefined behavior. *) +external dispose_module : llmodule -> unit = "llvm_dispose_module" + +(* Adds a named type to the module's symbol table. Returns true if successful. + If such a name already exists, then no entry is added and returns false. *) +external add_type_name : string -> lltype -> llmodule -> bool + = "llvm_add_type_name" + + +(*===-- Types -------------------------------------------------------------===*) +external classify_type : lltype -> type_kind = "llvm_classify_type" +external refine_abstract_type : lltype -> lltype -> unit + = "llvm_refine_abstract_type" +val string_of_lltype : lltype -> string + +(*--... Operations on integer types ........................................--*) +val i1_type : lltype +val i8_type : lltype +val i16_type : lltype +val i32_type : lltype +val i64_type : lltype +external make_integer_type : int -> lltype = "llvm_make_integer_type" +external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth" + +(*--... Operations on real types ...........................................--*) +val float_type : lltype +val double_type : lltype +val x86fp80_type : lltype +val fp128_type : lltype +val ppc_fp128_type : lltype + +(*--... Operations on function types .......................................--*) +(* FIXME: handle parameter attributes *) +external make_function_type : lltype -> lltype array -> bool -> lltype + = "llvm_make_function_type" +external is_var_arg : lltype -> bool = "llvm_is_var_arg" +external return_type : lltype -> lltype = "llvm_return_type" +external param_types : lltype -> lltype array = "llvm_param_types" + +(*--... Operations on struct types .........................................--*) +external make_struct_type : lltype array -> bool -> lltype + = "llvm_make_struct_type" +external element_types : lltype -> lltype array = "llvm_element_types" +external is_packed : lltype -> bool = "llvm_is_packed" + +(*--... Operations on pointer, vector, and array types .....................--*) +external make_array_type : lltype -> int -> lltype = "llvm_make_array_type" +external make_pointer_type : lltype -> lltype = "llvm_make_pointer_type" +external make_vector_type : lltype -> int -> lltype = "llvm_make_vector_type" + +external element_type : lltype -> lltype = "llvm_element_type" +external array_length : lltype -> int = "llvm_array_length" +external vector_size : lltype -> int = "llvm_vector_size" + +(*--... Operations on other types ..........................................--*) +external make_opaque_type : unit -> lltype = "llvm_make_opaque_type" +val void_type : lltype +val label_type : lltype + + +(*===-- Values ------------------------------------------------------------===*) +external type_of : llvalue -> lltype = "llvm_type_of" +external value_name : llvalue -> string = "llvm_value_name" +external set_value_name : string -> llvalue -> unit = "llvm_set_value_name" + +(*--... Operations on constants of (mostly) any type .......................--*) +external make_null : lltype -> llvalue = "llvm_make_null" +external make_all_ones : lltype -> llvalue = "llvm_make_all_ones" +external make_undef : lltype -> llvalue = "llvm_make_undef" +external is_null : llvalue -> bool = "llvm_is_null" + +(*--... Operations on scalar constants .....................................--*) +external make_int_constant : lltype -> int -> bool -> llvalue + = "llvm_make_int_constant" +external make_real_constant : lltype -> float -> llvalue + = "llvm_make_real_constant" + +(*--... Operations on composite constants ..................................--*) +external make_string_constant : string -> bool -> llvalue + = "llvm_make_string_constant" +external make_array_constant : lltype -> llvalue array -> llvalue + = "llvm_make_array_constant" +external make_struct_constant : llvalue array -> bool -> llvalue + = "llvm_make_struct_constant" +external make_vector_constant : llvalue array -> llvalue + = "llvm_make_vector_constant" + +(*--... Operations on global variables, functions, and aliases (globals) ...--*) +external is_declaration : llvalue -> bool = "llvm_is_declaration" +external linkage : llvalue -> linkage = "llvm_linkage" +external set_linkage : linkage -> llvalue -> unit = "llvm_set_linkage" +external section : llvalue -> string = "llvm_section" +external set_section : string -> llvalue -> unit = "llvm_set_section" +external visibility : llvalue -> visibility = "llvm_visibility" +external set_visibility : visibility -> llvalue -> unit = "llvm_set_visibility" +external alignment : llvalue -> int = "llvm_alignment" +external set_alignment : int -> llvalue -> unit = "llvm_set_alignment" + +(*--... Operations on global variables .....................................--*) +external declare_global : lltype -> string -> llmodule -> llvalue + = "llvm_declare_global" +external define_global : string -> llvalue -> llmodule -> llvalue + = "llvm_define_global" +external delete_global : llvalue -> unit = "llvm_delete_global" +external global_initializer : llvalue -> llvalue = "llvm_global_initializer" +external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer" +external remove_initializer : llvalue -> unit = "llvm_remove_initializer" +external is_thread_local : llvalue -> bool = "llvm_is_thread_local" +external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local" + diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c new file mode 100644 index 00000000000..3191cb0563b --- /dev/null +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -0,0 +1,410 @@ +/*===-- llvm_ocaml.h - LLVM Ocaml Glue --------------------------*- C++ -*-===*\ +|* *| +|* The LLVM Compiler Infrastructure *| +|* *| +|* This file was developed by Gordon Henriksen and is distributed under the *| +|* University of Illinois Open Source License. See LICENSE.TXT for details. *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's ocaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Core.h" +#include "caml/alloc.h" +#include "caml/mlvalues.h" +#include "caml/memory.h" +#include "stdio.h" + + +/*===-- Modules -----------------------------------------------------------===*/ + +/* string -> llmodule */ +CAMLprim value llvm_create_module(value ModuleID) { + return (value) LLVMModuleCreateWithName(String_val(ModuleID)); +} + +/* llmodule -> unit */ +CAMLprim value llvm_dispose_module(value M) { + LLVMDisposeModule((LLVMModuleRef) M); + return Val_unit; +} + +/* string -> lltype -> llmodule -> bool */ +CAMLprim value llvm_add_type_name(value Name, value Ty, value M) { + int res = LLVMAddTypeName((LLVMModuleRef) M, + String_val(Name), (LLVMTypeRef) Ty); + return Val_bool(res == 0); +} + + +/*===-- Types -------------------------------------------------------------===*/ + +/* lltype -> type_kind */ +CAMLprim value llvm_classify_type(value Ty) { + return Val_int(LLVMGetTypeKind((LLVMTypeRef) Ty)); +} + +/* lltype -> lltype -> unit */ +CAMLprim value llvm_refine_abstract_type(value ConcreteTy, value AbstractTy) { + LLVMRefineAbstractType((LLVMTypeRef) AbstractTy, (LLVMTypeRef) ConcreteTy); + return (value) Val_unit; +} + +/*--... Operations on integer types ........................................--*/ + +/* unit -> lltype */ +CAMLprim value llvm_i1_type (value Unit) { return (value) LLVMInt1Type(); } +CAMLprim value llvm_i8_type (value Unit) { return (value) LLVMInt8Type(); } +CAMLprim value llvm_i16_type(value Unit) { return (value) LLVMInt16Type(); } +CAMLprim value llvm_i32_type(value Unit) { return (value) LLVMInt32Type(); } +CAMLprim value llvm_i64_type(value Unit) { return (value) LLVMInt64Type(); } + +/* int -> lltype */ +CAMLprim value llvm_make_integer_type(value Width) { + return (value) LLVMCreateIntegerType(Int_val(Width)); +} + +/* lltype -> int */ +CAMLprim value llvm_integer_bitwidth(value IntegerTy) { + return Val_int(LLVMGetIntegerTypeWidth((LLVMTypeRef) IntegerTy)); +} + +/*--... Operations on real types ...........................................--*/ + +/* unit -> lltype */ +CAMLprim value llvm_float_type(value Unit) { + return (value) LLVMFloatType(); +} + +/* unit -> lltype */ +CAMLprim value llvm_double_type(value Unit) { + return (value) LLVMDoubleType(); +} + +/* unit -> lltype */ +CAMLprim value llvm_x86fp80_type(value Unit) { + return (value) LLVMX86FP80Type(); +} + +/* unit -> lltype */ +CAMLprim value llvm_fp128_type(value Unit) { + return (value) LLVMFP128Type(); +} + +/* unit -> lltype */ +CAMLprim value llvm_ppc_fp128_type(value Unit) { + return (value) LLVMPPCFP128Type(); +} + +/*--... Operations on function types .......................................--*/ + +/* lltype -> lltype array -> bool -> lltype */ +CAMLprim value llvm_make_function_type(value RetTy, value ParamTys, + value IsVarArg) { + return (value) LLVMCreateFunctionType((LLVMTypeRef) RetTy, + (LLVMTypeRef *) ParamTys, + Wosize_val(ParamTys), + Bool_val(IsVarArg)); +} + +/* lltype -> bool */ +CAMLprim value llvm_is_var_arg(value FunTy) { + return Val_bool(LLVMIsFunctionVarArg((LLVMTypeRef) FunTy)); +} + +/* lltype -> lltype */ +CAMLprim value llvm_return_type(value FunTy) { + return (value) LLVMGetFunctionReturnType((LLVMTypeRef) FunTy); +} + +/* lltype -> lltype array */ +CAMLprim value llvm_param_types(value FunTy) { + unsigned Count = LLVMGetFunctionParamCount((LLVMTypeRef) FunTy); + LLVMTypeRef *FunTys = alloca(Count * sizeof(LLVMTypeRef)); + + /* copy into an ocaml array */ + unsigned i; + value ParamTys = caml_alloc(Count, 0); + + LLVMGetFunctionParamTypes((LLVMTypeRef) FunTy, FunTys); + for (i = 0; i != Count; ++i) + Store_field(ParamTys, i, (value) FunTys[i]); + + return ParamTys; +} + +/*--... Operations on struct types .........................................--*/ + +/* lltype array -> bool -> lltype */ +CAMLprim value llvm_make_struct_type(value ElementTypes, value Packed) { + return (value) LLVMCreateStructType((LLVMTypeRef *) ElementTypes, + Wosize_val(ElementTypes), + Bool_val(Packed)); +} + +/* lltype -> lltype array */ +CAMLprim value llvm_element_types(value StructTy) { + unsigned Count = LLVMGetStructElementCount((LLVMTypeRef) StructTy); + LLVMTypeRef *Tys = alloca(Count * sizeof(LLVMTypeRef)); + + /* copy into an ocaml array */ + unsigned i; + value ElementTys = caml_alloc(Count, 0); + + LLVMGetStructElementTypes((LLVMTypeRef) StructTy, Tys); + for (i = 0; i != Count; ++i) + Store_field(ElementTys, i, (value) Tys[i]); + + return ElementTys; +} + +CAMLprim value llvm_is_packed(value StructTy) { + return Val_bool(LLVMIsPackedStruct((LLVMTypeRef) StructTy)); +} + +/*--... Operations on array, pointer, and vector types .....................--*/ + +/* lltype -> int -> lltype */ +CAMLprim value llvm_make_array_type(value ElementTy, value Count) { + return (value) LLVMCreateArrayType((LLVMTypeRef) ElementTy, Int_val(Count)); +} + +/* lltype -> lltype */ +CAMLprim value llvm_make_pointer_type(value ElementTy) { + return (value) LLVMCreatePointerType((LLVMTypeRef) ElementTy); +} + +/* lltype -> int -> lltype */ +CAMLprim value llvm_make_vector_type(value ElementTy, value Count) { + return (value) LLVMCreateVectorType((LLVMTypeRef) ElementTy, Int_val(Count)); +} + +/* lltype -> lltype */ +CAMLprim value llvm_element_type(value Ty) { + return (value) LLVMGetElementType((LLVMTypeRef) Ty); +} + +/* lltype -> int */ +CAMLprim value llvm_array_length(value ArrayTy) { + return Val_int(LLVMGetArrayLength((LLVMTypeRef) ArrayTy)); +} + +/* lltype -> int */ +CAMLprim value llvm_vector_size(value VectorTy) { + return Val_int(LLVMGetVectorSize((LLVMTypeRef) VectorTy)); +} + +/*--... Operations on other types ..........................................--*/ + +/* unit -> lltype */ +CAMLprim value llvm_void_type (value Unit) { return (value) LLVMVoidType(); } +CAMLprim value llvm_label_type(value Unit) { return (value) LLVMLabelType(); } + +/* unit -> lltype */ +CAMLprim value llvm_make_opaque_type(value Unit) { + return (value) LLVMCreateOpaqueType(); +} + + +/*===-- VALUES ------------------------------------------------------------===*/ + +/* llvalue -> lltype */ +CAMLprim value llvm_type_of(value Val) { + return (value) LLVMGetTypeOfValue((LLVMValueRef) Val); +} + +/* llvalue -> string */ +CAMLprim value llvm_value_name(value Val) { + return caml_copy_string(LLVMGetValueName((LLVMValueRef) Val)); +} + +/* string -> llvalue -> unit */ +CAMLprim value llvm_set_value_name(value Name, value Val) { + LLVMSetValueName((LLVMValueRef) Val, String_val(Name)); + return Val_unit; +} + +/*--... Operations on constants of (mostly) any type .......................--*/ + +/* lltype -> llvalue */ +CAMLprim value llvm_make_null(value Ty) { + return (value) LLVMGetNull((LLVMTypeRef) Ty); +} + +/* lltype -> llvalue */ +CAMLprim value llvm_make_all_ones(value Ty) { + return (value) LLVMGetAllOnes((LLVMTypeRef) Ty); +} + +/* lltype -> llvalue */ +CAMLprim value llvm_make_undef(value Ty) { + return (value) LLVMGetUndef((LLVMTypeRef) Ty); +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_null(value Val) { + return Val_bool(LLVMIsNull((LLVMValueRef) Val)); +} + +/*--... Operations on scalar constants .....................................--*/ + +/* lltype -> int -> bool -> llvalue */ +CAMLprim value llvm_make_int_constant(value IntTy, value N, value SExt) { + /* GCC warns if we use the ternary operator. */ + unsigned long long N2; + if (Bool_val(SExt)) + N2 = (intnat) Int_val(N); + else + N2 = (uintnat) Int_val(N); + + return (value) LLVMGetIntConstant((LLVMTypeRef) IntTy, N2, Bool_val(SExt)); +} + +/* lltype -> float -> llvalue */ +CAMLprim value llvm_make_real_constant(value RealTy, value N) { + return (value) LLVMGetRealConstant((LLVMTypeRef) RealTy, Double_val(N)); +} + +/*--... Operations on composite constants ..................................--*/ + +/* string -> bool -> llvalue */ +CAMLprim value llvm_make_string_constant(value Str, value NullTerminate) { + return (value) LLVMGetStringConstant(String_val(Str), + Wosize_val(Str), + Bool_val(NullTerminate) == 0); +} + +/* lltype -> llvalue array -> llvalue */ +CAMLprim value llvm_make_array_constant(value ElementTy, value ElementVals) { + return (value) LLVMGetArrayConstant((LLVMTypeRef) ElementTy, + (LLVMValueRef*) Op_val(ElementVals), + Wosize_val(ElementVals)); +} + +/* llvalue array -> bool -> llvalue */ +CAMLprim value llvm_make_struct_constant(value ElementVals, value Packed) { + return (value) LLVMGetStructConstant((LLVMValueRef*) Op_val(ElementVals), + Wosize_val(ElementVals), + Bool_val(Packed)); +} + +/* llvalue array -> llvalue */ +CAMLprim value llvm_make_vector_constant(value ElementVals) { + return (value) LLVMGetVectorConstant((LLVMValueRef*) Op_val(ElementVals), + Wosize_val(ElementVals)); +} + +/*--... Operations on global variables, functions, and aliases (globals) ...--*/ + +/* llvalue -> bool */ +CAMLprim value llvm_is_declaration(value Global) { + return Val_bool(LLVMIsDeclaration((LLVMValueRef) Global)); +} + +/* llvalue -> linkage */ +CAMLprim value llvm_linkage(value Global) { + return Val_int(LLVMGetLinkage((LLVMValueRef) Global)); +} + +/* linkage -> llvalue -> unit */ +CAMLprim value llvm_set_linkage(value Linkage, value Global) { + LLVMSetLinkage((LLVMValueRef) Global, Int_val(Linkage)); + return Val_unit; +} + +/* llvalue -> string */ +CAMLprim value llvm_section(value Global) { + return caml_copy_string(LLVMGetSection((LLVMValueRef) Global)); +} + +/* string -> llvalue -> unit */ +CAMLprim value llvm_set_section(value Section, value Global) { + LLVMSetSection((LLVMValueRef) Global, String_val(Section)); + return Val_unit; +} + +/* llvalue -> visibility */ +CAMLprim value llvm_visibility(value Global) { + return Val_int(LLVMGetVisibility((LLVMValueRef) Global)); +} + +/* visibility -> llvalue -> unit */ +CAMLprim value llvm_set_visibility(value Viz, value Global) { + LLVMSetVisibility((LLVMValueRef) Global, Int_val(Viz)); + return Val_unit; +} + +/* llvalue -> int */ +CAMLprim value llvm_alignment(value Global) { + return Val_int(LLVMGetAlignment((LLVMValueRef) Global)); +} + +/* int -> llvalue -> unit */ +CAMLprim value llvm_set_alignment(value Bytes, value Global) { + LLVMSetAlignment((LLVMValueRef) Global, Int_val(Bytes)); + return Val_unit; +} + +/*--... Operations on global variables .....................................--*/ + +/* lltype -> string -> llmodule -> llvalue */ +CAMLprim value llvm_add_global(value Ty, value Name, value M) { + return (value) LLVMAddGlobal((LLVMModuleRef) M, + (LLVMTypeRef) Ty, String_val(Name)); +} + +/* lltype -> string -> llmodule -> llvalue */ +CAMLprim value llvm_declare_global(value Ty, value Name, value M) { + return (value) LLVMAddGlobal((LLVMModuleRef) M, + (LLVMTypeRef) Ty, String_val(Name)); +} + +/* string -> llvalue -> llmodule -> llvalue */ +CAMLprim value llvm_define_global(value Name, value ConstantVal, value M) { + LLVMValueRef Initializer = (LLVMValueRef) ConstantVal; + LLVMValueRef GlobalVar = LLVMAddGlobal((LLVMModuleRef) M, + LLVMGetTypeOfValue(Initializer), + String_val(Name)); + LLVMSetInitializer(GlobalVar, Initializer); + return (value) GlobalVar; +} + +/* llvalue -> unit */ +CAMLprim value llvm_delete_global(value GlobalVar) { + LLVMDeleteGlobal((LLVMValueRef) GlobalVar); + return Val_unit; +} + +/* llvalue -> llvalue */ +CAMLprim value llvm_global_initializer(value GlobalVar) { + return (value) LLVMGetInitializer((LLVMValueRef) GlobalVar); +} + +/* llvalue -> llvalue -> unit */ +CAMLprim value llvm_set_initializer(value ConstantVal, value GlobalVar) { + LLVMSetInitializer((LLVMValueRef) GlobalVar, (LLVMValueRef) ConstantVal); + return Val_unit; +} + +/* llvalue -> unit */ +CAMLprim value llvm_remove_initializer(value GlobalVar) { + LLVMSetInitializer((LLVMValueRef) GlobalVar, NULL); + return Val_unit; +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_thread_local(value GlobalVar) { + return Val_bool(LLVMIsThreadLocal((LLVMValueRef) GlobalVar)); +} + +/* bool -> llvalue -> unit */ +CAMLprim value llvm_set_thread_local(value IsThreadLocal, value GlobalVar) { + LLVMSetThreadLocal((LLVMValueRef) GlobalVar, Bool_val(IsThreadLocal)); + return Val_unit; +} diff --git a/test/Bindings/Ocaml/bitwriter.ml b/test/Bindings/Ocaml/bitwriter.ml new file mode 100644 index 00000000000..5421e09bcea --- /dev/null +++ b/test/Bindings/Ocaml/bitwriter.ml @@ -0,0 +1,16 @@ +(* RUN: %ocamlc llvm.cma llvm_bitwriter.cma %s -o %t + * RUN: ./%t %t.bc + * RUN: llvm-dis < %t.bc | grep caml_int_ty + *) + +(* Note that this takes a moment to link, so it's best to keep the number of + individual tests low. *) + +let test x = if not x then exit 1 else () + +let _ = + let m = Llvm.create_module "ocaml_test_module" in + + ignore (Llvm.add_type_name "caml_int_ty" Llvm.i32_type m); + + test (Llvm_bitwriter.write_bitcode_file m Sys.argv.(1)) diff --git a/test/Bindings/Ocaml/ocaml.exp b/test/Bindings/Ocaml/ocaml.exp new file mode 100644 index 00000000000..5f8469536a4 --- /dev/null +++ b/test/Bindings/Ocaml/ocaml.exp @@ -0,0 +1,3 @@ +load_lib llvm.exp + +RunLLVMTests [lsort [glob -nocomplain $srcdir/$subdir/*.{ll,llx,c,cpp,tr,ml}]] diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml new file mode 100644 index 00000000000..1fd0d19d421 --- /dev/null +++ b/test/Bindings/Ocaml/vmcore.ml @@ -0,0 +1,233 @@ +(* RUN: %ocamlc llvm.cma llvm_bitwriter.cma %s -o %t + * RUN: ./%t %t.bc + * RUN: llvm-dis < %t.bc > %t.ll + *) + +(* Note: It takes several seconds for ocamlc to link an executable with + libLLVMCore.a, so it's better to write a big test than a bunch of + little ones. *) + +open Llvm +open Llvm_bitwriter + + +(* Tiny unit test framework *) +let exit_status = ref 0 +let case_num = ref 0 + +let all_done () = + prerr_endline ""; + exit !exit_status + +let group name = + prerr_endline ""; + case_num := 0; + prerr_string (" " ^ name ^ "... ") + +let insist cond = + incr case_num; + prerr_char ' '; + if not cond then begin + exit_status := 10; + prerr_char '!' + end; + prerr_int !case_num + +let suite name f = + prerr_endline (name ^ ":"); + f () + + +(*===-- Fixture -----------------------------------------------------------===*) + +let filename = Sys.argv.(1) +let m = create_module filename + + +(*===-- Types -------------------------------------------------------------===*) + +let test_types () = + (* RUN: grep {Ty01.*void} < %t.ll + *) + group "void"; + insist (add_type_name "Ty01" void_type m); + insist (Void_type == classify_type void_type); + + (* RUN: grep {Ty02.*i1} < %t.ll + *) + group "i1"; + insist (add_type_name "Ty02" i1_type m); + insist (Integer_type == classify_type i1_type); + + (* RUN: grep {Ty03.*i32} < %t.ll + *) + group "i32"; + insist (add_type_name "Ty03" i32_type m); + + (* RUN: grep {Ty04.*i42} < %t.ll + *) + group "i42"; + let ty = make_integer_type 42 in + insist (add_type_name "Ty04" ty m); + + (* RUN: grep {Ty05.*float} < %t.ll + *) + group "float"; + insist (add_type_name "Ty05" float_type m); + insist (Float_type == classify_type float_type); + + (* RUN: grep {Ty06.*double} < %t.ll + *) + group "double"; + insist (add_type_name "Ty06" double_type m); + insist (Double_type == classify_type double_type); + + (* RUN: grep {Ty07.*i32.*i1, double} < %t.ll + *) + group "function"; + let ty = make_function_type i32_type [| i1_type; double_type |] false in + insist (add_type_name "Ty07" ty m); + insist (Function_type = classify_type ty); + insist (not (is_var_arg ty)); + insist (i32_type == return_type ty); + insist (double_type == (param_types ty).(1)); + + (* RUN: grep {Ty08.*\.\.\.} < %t.ll + *) + group "vararg"; + let ty = make_function_type void_type [| i32_type |] true in + insist (add_type_name "Ty08" ty m); + insist (is_var_arg ty); + + (* RUN: grep {Ty09.*\\\[7 x i8\\\]} < %t.ll + *) + group "array"; + let ty = make_array_type i8_type 7 in + insist (add_type_name "Ty09" ty m); + insist (7 = array_length ty); + insist (i8_type == element_type ty); + insist (Array_type == classify_type ty); + + (* RUN: grep {Ty10.*float\*} < %t.ll + *) + group "pointer"; + let ty = make_pointer_type float_type in + insist (add_type_name "Ty10" ty m); + insist (float_type == element_type ty); + insist (Pointer_type == classify_type ty); + + (* RUN: grep {Ty11.*\<4 x i16\>} < %t.ll + *) + group "vector"; + let ty = make_vector_type i16_type 4 in + insist (add_type_name "Ty11" ty m); + insist (i16_type == element_type ty); + insist (4 = vector_size ty); + + (* RUN: grep {Ty12.*opaque} < %t.ll + *) + group "opaque"; + let ty = make_opaque_type () in + insist (add_type_name "Ty12" ty m); + insist (ty == ty); + insist (ty <> make_opaque_type ()) + + +(*===-- Global Values -----------------------------------------------------===*) + +let test_global_values () = + let (++) x f = f x; x in + let zero32 = make_null i32_type in + + (* RUN: grep {GVal01} < %t.ll + *) + group "naming"; + let g = define_global "TEMPORARY" zero32 m in + prerr_endline ""; + prerr_endline (value_name g); + insist ("TEMPORARY" = value_name g); + set_value_name "GVal01" g; + insist ("GVal01" = value_name g); + + (* RUN: grep {GVal02.*linkonce} < %t.ll + *) + group "linkage"; + let g = define_global "GVal02" zero32 m ++ + set_linkage Link_once_linkage in + insist (Link_once_linkage = linkage g); + + (* RUN: grep {GVal03.*Hanalei} < %t.ll + *) + group "section"; + let g = define_global "GVal03" zero32 m ++ + set_section "Hanalei" in + insist ("Hanalei" = section g); + + (* RUN: grep {GVal04.*hidden} < %t.ll + *) + group "visibility"; + let g = define_global "GVal04" zero32 m ++ + set_visibility Hidden_visibility in + insist (Hidden_visibility = visibility g); + + (* RUN: grep {GVal05.*align 128} < %t.ll + *) + group "alignment"; + let g = define_global "GVal05" zero32 m ++ + set_alignment 128 in + insist (128 = alignment g) + + +(*===-- Global Variables --------------------------------------------------===*) + +let test_global_variables () = + let (++) x f = f x; x in + let fourty_two32 = make_int_constant i32_type 42 false in + + (* RUN: grep {GVar01.*external} < %t.ll + *) + group "declarations"; + let g = declare_global i32_type "GVar01" m in + insist (is_declaration g); + + (* RUN: grep {GVar02.*42} < %t.ll + * RUN: grep {GVar03.*42} < %t.ll + *) + group "definitions"; + let g = define_global "GVar02" fourty_two32 m in + let g2 = declare_global i32_type "GVar03" m ++ + set_initializer fourty_two32 in + insist (not (is_declaration g)); + insist (not (is_declaration g2)); + insist ((global_initializer g) == (global_initializer g2)); + + (* RUN: grep {GVar04.*thread_local} < %t.ll + *) + group "threadlocal"; + let g = define_global "GVar04" fourty_two32 m ++ + set_thread_local true in + insist (is_thread_local g); + + (* RUN: grep -v {GVar05} < %t.ll + *) + let g = define_global "GVar05" fourty_two32 m in + delete_global g + + +(*===-- Writer ------------------------------------------------------------===*) + +let test_writer () = + group "writer"; + insist (write_bitcode_file m filename); + + dispose_module m + + +(*===-- Driver ------------------------------------------------------------===*) + +let _ = + suite "types" test_types; + suite "global values" test_global_values; + suite "global variables" test_global_variables; + suite "writer" test_writer; + all_done () diff --git a/test/lib/llvm.exp b/test/lib/llvm.exp index 9a85a1c87ae..921bcb5ddd7 100644 --- a/test/lib/llvm.exp +++ b/test/lib/llvm.exp @@ -43,7 +43,7 @@ proc execOneLine { test PRS outcome lineno line } { # cases. proc substitute { line test tmpFile } { global srcroot objroot srcdir objdir subdir target_triplet prcontext - global llvmgcc llvmgxx llvmgcc_version llvmgccmajvers + global llvmgcc llvmgxx llvmgcc_version llvmgccmajvers ocamlc global gccpath gxxpath compile_c compile_cxx link shlibext llvmlibsdir set path [file join $srcdir $subdir] @@ -64,6 +64,8 @@ proc substitute { line test tmpFile } { regsub -all {%link} $new_line "$link" new_line #replace %shlibext with shared library extension regsub -all {%shlibext} $new_line "$shlibext" new_line + #replace %ocamlc with ocaml compiler command + regsub -all {%ocamlc} $new_line "$ocamlc" new_line #replace %llvmlibsdir with configure library directory regsub -all {%llvmlibsdir} $new_line "$llvmlibsdir" new_line #replace %p with path to source, -- 2.34.1