replica
/
hanchenye-llvm-project
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[OCaml] Drop support for 3.12.1 and earlier. 

In practice this means:
  * Always using -g flag.
  * Embedding -cclib -lstdc++ into the corresponding cma/cmxa file.
    This also moves -lstdc++ in a single place.
  * Using caml_named_value instead of a homegrown mechanism.

llvm-svn: 220843
This commit is contained in:
Peter Zotov 2014-10-29 08:15:54 +00:00
parent e447b61c50
commit 662538ac40
29 changed files with 167 additions and 263 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
llvm/bindings/ocaml/Makefile.ocaml
View File

@ -61,11 +61,11 @@ ifneq ($(ObjectsO),)
OCAMLAFLAGS += $(patsubst %,-cclib %, \
$(filter-out -L$(LibDir),-l$(LIBRARYNAME) \
$(shell $(LLVM_CONFIG) --ldflags)) \
$(UsedLibs))
$(UsedLibs) $(ExtraLibs))
else
OCAMLAFLAGS += $(patsubst %,-cclib %, \
$(filter-out -L$(LibDir),$(shell $(LLVM_CONFIG) --ldflags)) \
$(UsedLibs))
$(UsedLibs) $(ExtraLibs))
endif
endif
@ -481,6 +481,7 @@ printcamlvars::
$(Echo) "DestSharedLib: " '$(DestSharedLib)'
$(Echo) "UsedLibs : " '$(UsedLibs)'
$(Echo) "UsedLibNames : " '$(UsedLibNames)'
$(Echo) "ExtraLibs : " '$(ExtraLibs)'
.PHONY: printcamlvars build-cmis \
clean-a clean-cmis clean-cma clean-cmxa \

4
llvm/bindings/ocaml/all_backends/Makefile
View File

@ -1,4 +1,4 @@
##===- bindings/ocaml/all_backends/Makefile ----------------------*- Makefile -*-===##
##===- bindings/ocaml/all_backends/Makefile ----------------*- Makefile -*-===##
#
# The LLVM Compiler Infrastructure
#
@ -7,7 +7,7 @@
#
##===----------------------------------------------------------------------===##
#
# This is the makefile for the Objective Caml Llvm_backends interface.
# This is the makefile for the Objective Caml Llvm_all_backends interface.
#
##===----------------------------------------------------------------------===##

1
llvm/bindings/ocaml/analysis/analysis_ocaml.c
View File

@ -20,7 +20,6 @@
#include "caml/mlvalues.h"
#include "caml/memory.h"
/* Llvm.llmodule -> string option */
CAMLprim value llvm_verify_module(LLVMModuleRef M) {
CAMLparam0();

2
llvm/bindings/ocaml/analysis/llvm_analysis.ml
View File

@ -1,4 +1,4 @@
(*===-- llvm_analysis.ml - LLVM OCaml Interface -----------------*- C++ -*-===*
(*===-- llvm_analysis.ml - LLVM OCaml Interface ---------------*- OCaml -*-===*
*
* The LLVM Compiler Infrastructure
*

2
llvm/bindings/ocaml/analysis/llvm_analysis.mli
View File

@ -1,4 +1,4 @@
(*===-- llvm_analysis.mli - LLVM OCaml Interface ----------------*- C++ -*-===*
(*===-- llvm_analysis.mli - LLVM OCaml Interface --------------*- OCaml -*-===*
*
* The LLVM Compiler Infrastructure
*

1
llvm/bindings/ocaml/backends/META.llvm_backend.in
View File

@ -5,4 +5,3 @@ requires = "llvm"
archive(byte) = "llvm_@TARGET@.cma"
archive(native) = "llvm_@TARGET@.cmxa"
directory = "."
linkopts = "-ccopt -lstdc++"

9
llvm/bindings/ocaml/backends/backend_ocaml.c
View File

@ -19,10 +19,11 @@
#include "caml/alloc.h"
#include "caml/memory.h"
// TODO: Figure out how to call these only for targets which support them.
// LLVMInitialize ## target ## AsmPrinter();
// LLVMInitialize ## target ## AsmParser();
// LLVMInitialize ## target ## Disassembler();
/* TODO: Figure out how to call these only for targets which support them.
* LLVMInitialize ## target ## AsmPrinter();
* LLVMInitialize ## target ## AsmParser();
* LLVMInitialize ## target ## Disassembler();
*/
#define INITIALIZER1(target) \
CAMLprim value llvm_initialize_ ## target(value Unit) { \

39
llvm/bindings/ocaml/bitreader/bitreader_ocaml.c
View File

@ -16,17 +16,7 @@
#include "caml/alloc.h"
#include "caml/fail.h"
#include "caml/memory.h"
/* Can't use the recommended caml_named_value mechanism for backwards
compatibility reasons. This is largely equivalent. */
static value llvm_bitreader_error_exn;
CAMLprim value llvm_register_bitreader_exns(value Error) {
llvm_bitreader_error_exn = Field(Error, 0);
register_global_root(&llvm_bitreader_error_exn);
return Val_unit;
}
#include "caml/callback.h"
static void llvm_raise(value Prototype, char *Message) {
CAMLparam1(Prototype);
@ -36,38 +26,29 @@ static void llvm_raise(value Prototype, char *Message) {
LLVMDisposeMessage(Message);
raise_with_arg(Prototype, CamlMessage);
abort(); /* NOTREACHED */
#ifdef CAMLnoreturn
CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
#endif
CAMLnoreturn;
}
/*===-- Modules -----------------------------------------------------------===*/
/*===-- BitReader --------------------------------------------------------===*/
/* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */
CAMLprim value llvm_get_module(LLVMContextRef C, LLVMMemoryBufferRef MemBuf) {
CAMLparam0();
CAMLlocal2(Variant, MessageVal);
CAMLprim LLVMModuleRef llvm_get_module(LLVMContextRef C, LLVMMemoryBufferRef MemBuf) {
LLVMModuleRef M;
char *Message;
LLVMModuleRef M;
if (LLVMGetBitcodeModuleInContext(C, MemBuf, &M, &Message))
llvm_raise(llvm_bitreader_error_exn, Message);
llvm_raise(*caml_named_value("Llvm_bitreader.Error"), Message);
CAMLreturn((value) M);
return M;
}
/* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */
CAMLprim value llvm_parse_bitcode(LLVMContextRef C,
LLVMMemoryBufferRef MemBuf) {
CAMLparam0();
CAMLlocal2(Variant, MessageVal);
CAMLprim LLVMModuleRef llvm_parse_bitcode(LLVMContextRef C, LLVMMemoryBufferRef MemBuf) {
LLVMModuleRef M;
char *Message;
if (LLVMParseBitcodeInContext(C, MemBuf, &M, &Message))
llvm_raise(llvm_bitreader_error_exn, Message);
llvm_raise(*caml_named_value("Llvm_bitreader.Error"), Message);
CAMLreturn((value) M);
return M;
}

17
llvm/bindings/ocaml/bitreader/llvm_bitreader.ml
View File

@ -1,4 +1,4 @@
(*===-- llvm_bitreader.ml - LLVM OCaml Interface ----------------*- C++ -*-===*
(*===-- llvm_bitreader.ml - LLVM OCaml Interface --------------*- OCaml -*-===*
*
* The LLVM Compiler Infrastructure
*
@ -7,14 +7,13 @@
*
*===----------------------------------------------------------------------===*)
exception Error of string
external register_exns : exn -> unit = "llvm_register_bitreader_exns"
let _ = register_exns (Error "")
let () = Callback.register_exception "Llvm_bitreader.Error" (Error "")
external get_module : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule
= "llvm_get_module"
external parse_bitcode : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule
= "llvm_parse_bitcode"
external get_module
: Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule
= "llvm_get_module"
external parse_bitcode
: Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule
= "llvm_parse_bitcode"

3
llvm/bindings/ocaml/bitreader/llvm_bitreader.mli
View File

@ -1,4 +1,4 @@
(*===-- llvm_bitreader.mli - LLVM OCaml Interface ---------------*- C++ -*-===*
(*===-- llvm_bitreader.mli - LLVM OCaml Interface -------------*- OCaml -*-===*
*
* The LLVM Compiler Infrastructure
*
@ -20,7 +20,6 @@ exception Error of string
encountered. See the function [llvm::getBitcodeModule]. *)
val get_module : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule
(** [parse_bitcode context mb] parses the bitcode for a new module [m] from the
memory buffer [mb] in the context [context]. Returns [m] if successful, or
raises [Error msg] otherwise, where [msg] is a description of the error

18
llvm/bindings/ocaml/bitwriter/bitwriter_ocaml.c
View File

@ -21,25 +21,25 @@
#include "caml/mlvalues.h"
#include "caml/memory.h"
/*===-- Modules -----------------------------------------------------------===*/
/*===-- BitWriter ---------------------------------------------------------===*/
/* Llvm.llmodule -> string -> bool */
CAMLprim value llvm_write_bitcode_file(value M, value Path) {
int res = LLVMWriteBitcodeToFile((LLVMModuleRef) M, String_val(Path));
return Val_bool(res == 0);
CAMLprim value llvm_write_bitcode_file(LLVMModuleRef M, value Path) {
int Result = LLVMWriteBitcodeToFile(M, String_val(Path));
return Val_bool(Result == 0);
}
/* ?unbuffered:bool -> Llvm.llmodule -> Unix.file_descr -> bool */
CAMLprim value llvm_write_bitcode_to_fd(value U, value M, value FD) {
CAMLprim value llvm_write_bitcode_to_fd(value U, LLVMModuleRef M, value FD) {
int Unbuffered;
int res;
int Result;
if (U == Val_int(0)) {
Unbuffered = 0;
} else {
Unbuffered = Bool_val(Field(U,0));
Unbuffered = Bool_val(Field(U, 0));
}
res = LLVMWriteBitcodeToFD((LLVMModuleRef) M, Int_val(FD), 0, Unbuffered);
return Val_bool(res == 0);
Result = LLVMWriteBitcodeToFD(M, Int_val(FD), 0, Unbuffered);
return Val_bool(Result == 0);
}

2
llvm/bindings/ocaml/executionengine/Makefile
View File

@ -1,4 +1,4 @@
##===- bindings/ocaml/executionengine/Makefile --------------*- Makefile -*-===##
##===- bindings/ocaml/executionengine/Makefile -------------*- Makefile -*-===##
#
# The LLVM Compiler Infrastructure
#

82
llvm/bindings/ocaml/executionengine/executionengine_ocaml.c
View File

@ -15,37 +15,15 @@
|* *|
\*===----------------------------------------------------------------------===*/
#include <string.h>
#include <assert.h>
#include "llvm-c/ExecutionEngine.h"
#include "llvm-c/Target.h"
#include "caml/alloc.h"
#include "caml/custom.h"
#include "caml/fail.h"
#include "caml/memory.h"
#include <string.h>
#include <assert.h>
/* Force the LLVM interpreter and JIT to be linked in. */
void llvm_initialize(void) {
LLVMLinkInInterpreter();
LLVMLinkInMCJIT();
}
/* unit -> bool */
CAMLprim value llvm_initialize_native_target(value Unit) {
return Val_bool(!LLVMInitializeNativeTarget() &&
!LLVMInitializeNativeAsmParser() &&
!LLVMInitializeNativeAsmPrinter());
}
/* Can't use the recommended caml_named_value mechanism for backwards
compatibility reasons. This is largely equivalent. */
static value llvm_ee_error_exn;
CAMLprim value llvm_register_ee_exns(value Error) {
llvm_ee_error_exn = Field(Error, 0);
register_global_root(&llvm_ee_error_exn);
return Val_unit;
}
#include "caml/callback.h"
static void llvm_raise(value Prototype, char *Message) {
CAMLparam1(Prototype);
@ -55,13 +33,9 @@ static void llvm_raise(value Prototype, char *Message) {
LLVMDisposeMessage(Message);
raise_with_arg(Prototype, CamlMessage);
abort(); /* NOTREACHED */
#ifdef CAMLnoreturn
CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
#endif
CAMLnoreturn;
}
/*--... Operations on generic values .......................................--*/
#define Genericvalue_val(v) (*(LLVMGenericValueRef *)(Data_custom_val(v)))
@ -71,15 +45,13 @@ static void llvm_finalize_generic_value(value GenVal) {
}
static struct custom_operations generic_value_ops = {
(char *) "LLVMGenericValue",
(char *) "Llvm_executionengine.GenericValue.t",
llvm_finalize_generic_value,
custom_compare_default,
custom_hash_default,
custom_serialize_default,
custom_deserialize_default
#ifdef custom_compare_ext_default
, custom_compare_ext_default
#endif
custom_deserialize_default,
custom_compare_ext_default
};
static value alloc_generic_value(LLVMGenericValueRef Ref) {
@ -173,12 +145,22 @@ CAMLprim value llvm_genericvalue_as_nativeint(value GenVal) {
/*--... Operations on execution engines ....................................--*/
/* unit -> bool */
CAMLprim value llvm_initialize_native_target(value Unit) {
LLVMLinkInInterpreter();
LLVMLinkInMCJIT();
return Val_bool(!LLVMInitializeNativeTarget() &&
!LLVMInitializeNativeAsmParser() &&
!LLVMInitializeNativeAsmPrinter());
}
/* llmodule -> ExecutionEngine.t */
CAMLprim LLVMExecutionEngineRef llvm_ee_create(LLVMModuleRef M) {
LLVMExecutionEngineRef Interp;
char *Error;
if (LLVMCreateExecutionEngineForModule(&Interp, M, &Error))
llvm_raise(llvm_ee_error_exn, Error);
llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
return Interp;
}
@ -188,7 +170,7 @@ llvm_ee_create_interpreter(LLVMModuleRef M) {
LLVMExecutionEngineRef Interp;
char *Error;
if (LLVMCreateInterpreterForModule(&Interp, M, &Error))
llvm_raise(llvm_ee_error_exn, Error);
llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
return Interp;
}
@ -198,7 +180,7 @@ llvm_ee_create_jit(LLVMModuleRef M, value OptLevel) {
LLVMExecutionEngineRef JIT;
char *Error;
if (LLVMCreateJITCompilerForModule(&JIT, M, Int_val(OptLevel), &Error))
llvm_raise(llvm_ee_error_exn, Error);
llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
return JIT;
}
@ -207,16 +189,18 @@ CAMLprim LLVMExecutionEngineRef
llvm_ee_create_mcjit(LLVMModuleRef M, value OptRecord) {
LLVMExecutionEngineRef MCJIT;
char *Error;
struct LLVMMCJITCompilerOptions Options = {
.OptLevel = Int_val(Field(OptRecord, 0)),
.CodeModel = Int_val(Field(OptRecord, 1)),
.NoFramePointerElim = Int_val(Field(OptRecord, 2)),
.EnableFastISel = Int_val(Field(OptRecord, 3)),
.MCJMM = NULL
};
struct LLVMMCJITCompilerOptions Options;
LLVMInitializeMCJITCompilerOptions(&Options, sizeof(Options));
Options.OptLevel = Int_val(Field(OptRecord, 0));
Options.CodeModel = Int_val(Field(OptRecord, 1));
Options.NoFramePointerElim = Int_val(Field(OptRecord, 2));
Options.EnableFastISel = Int_val(Field(OptRecord, 3));
Options.MCJMM = NULL;
if (LLVMCreateMCJITCompilerForModule(&MCJIT, M, &Options,
sizeof(Options), &Error))
llvm_raise(llvm_ee_error_exn, Error);
llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
return MCJIT;
}
@ -238,7 +222,7 @@ CAMLprim LLVMModuleRef llvm_ee_remove_module(LLVMModuleRef M,
LLVMModuleRef RemovedModule;
char *Error;
if (LLVMRemoveModule(EE, M, &RemovedModule, &Error))
llvm_raise(llvm_ee_error_exn, Error);
llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
return RemovedModule;
}
@ -350,9 +334,9 @@ extern value llvm_alloc_data_layout(LLVMTargetDataRef TargetData);
CAMLprim value llvm_ee_get_data_layout(LLVMExecutionEngineRef EE) {
value DataLayout;
LLVMTargetDataRef OrigDataLayout;
OrigDataLayout = LLVMGetExecutionEngineTargetData(EE);
char* TargetDataCStr;
OrigDataLayout = LLVMGetExecutionEngineTargetData(EE);
TargetDataCStr = LLVMCopyStringRepOfTargetData(OrigDataLayout);
DataLayout = llvm_alloc_data_layout(LLVMCreateTargetData(TargetDataCStr));
LLVMDisposeMessage(TargetDataCStr);

27
llvm/bindings/ocaml/executionengine/llvm_executionengine.ml
View File

@ -1,4 +1,4 @@
(*===-- llvm_executionengine.ml - LLVM OCaml Interface ----------*- C++ -*-===*
(*===-- llvm_executionengine.ml - LLVM OCaml Interface --------*- OCaml -*-===*
*
* The LLVM Compiler Infrastructure
*
@ -7,21 +7,18 @@
*
*===----------------------------------------------------------------------===*)
exception Error of string
external register_exns: exn -> unit
= "llvm_register_ee_exns"
let () = Callback.register_exception "Llvm_executionengine.Error" (Error "")
module CodeModel = struct
type t =
| Default
| JIT_default
| Small
| Kernel
| Medium
| Large
| Default
| JIT_default
| Small
| Kernel
| Medium
| Large
end
module GenericValue = struct
@ -71,14 +68,6 @@ module ExecutionEngine = struct
no_framepointer_elim = false;
enable_fast_isel = false }
(* FIXME: Ocaml is not running this setup code unless we use 'val' in the
interface, which causes the emission of a stub for each function;
using 'external' in the module allows direct calls into
ocaml_executionengine.c. This is hardly fatal, but it is unnecessary
overhead on top of the two stubs that are already invoked for each
call into LLVM. *)
let _ = register_exns (Error "")
external create: Llvm.llmodule -> t
= "llvm_ee_create"
external create_interpreter: Llvm.llmodule -> t

16
llvm/bindings/ocaml/executionengine/llvm_executionengine.mli
View File

@ -1,4 +1,4 @@
(*===-- llvm_executionengine.mli - LLVM OCaml Interface ---------*- C++ -*-===*
(*===-- llvm_executionengine.mli - LLVM OCaml Interface -------*- OCaml -*-===*
*
* The LLVM Compiler Infrastructure
*
@ -10,19 +10,19 @@
(** JIT Interpreter.
This interface provides an OCaml API for LLVM execution engine (JIT/
interpreter), the classes in the ExecutionEngine library. *)
interpreter), the classes in the [ExecutionEngine] library. *)
exception Error of string
(** The JIT code model. See [llvm::CodeModel::Model]. *)
module CodeModel : sig
type t =
| Default
| JIT_default
| Small
| Kernel
| Medium
| Large
| Default
| JIT_default
| Small
| Kernel
| Medium
| Large
end
module GenericValue: sig

21
llvm/bindings/ocaml/irreader/irreader_ocaml.c
View File

@ -16,16 +16,7 @@
#include "caml/alloc.h"
#include "caml/fail.h"
#include "caml/memory.h"
/* Can't use the recommended caml_named_value mechanism for backwards
compatibility reasons. This is largely equivalent. */
static value llvm_irreader_error_exn;
CAMLprim value llvm_register_irreader_exns(value Error) {
llvm_irreader_error_exn = Field(Error, 0);
register_global_root(&llvm_irreader_error_exn);
return Val_unit;
}
#include "caml/callback.h"
static void llvm_raise(value Prototype, char *Message) {
CAMLparam1(Prototype);
@ -35,14 +26,10 @@ static void llvm_raise(value Prototype, char *Message) {
LLVMDisposeMessage(Message);
raise_with_arg(Prototype, CamlMessage);
abort(); /* NOTREACHED */
#ifdef CAMLnoreturn
CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
#endif
CAMLnoreturn;
}
/*===-- Modules -----------------------------------------------------------===*/
/*===-- IRReader ----------------------------------------------------------===*/
/* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */
CAMLprim value llvm_parse_ir(LLVMContextRef C,
@ -53,7 +40,7 @@ CAMLprim value llvm_parse_ir(LLVMContextRef C,
char *Message;
if (LLVMParseIRInContext(C, MemBuf, &M, &Message))
llvm_raise(llvm_irreader_error_exn, Message);
llvm_raise(*caml_named_value("Llvm_irreader.Error"), Message);
CAMLreturn((value) M);
}

3
llvm/bindings/ocaml/irreader/llvm_irreader.ml
View File

@ -10,8 +10,7 @@
exception Error of string
external register_exns : exn -> unit = "llvm_register_irreader_exns"
let _ = register_exns (Error "")
let _ = Callback.register_exception "Llvm_irreader.Error" (Error "")
external parse_ir : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule
= "llvm_parse_ir"

19
llvm/bindings/ocaml/linker/linker_ocaml.c
View File

@ -19,14 +19,7 @@
#include "caml/alloc.h"
#include "caml/memory.h"
#include "caml/fail.h"
static value llvm_linker_error_exn;
CAMLprim value llvm_register_linker_exns(value Error) {
llvm_linker_error_exn = Field(Error, 0);
register_global_root(&llvm_linker_error_exn);
return Val_unit;
}
#include "caml/callback.h"
static void llvm_raise(value Prototype, char *Message) {
CAMLparam1(Prototype);
@ -36,19 +29,15 @@ static void llvm_raise(value Prototype, char *Message) {
LLVMDisposeMessage(Message);
raise_with_arg(Prototype, CamlMessage);
abort(); /* NOTREACHED */
#ifdef CAMLnoreturn
CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
#endif
CAMLnoreturn;
}
/* llmodule -> llmodule -> Mode.t -> unit
raises Error msg on error */
/* llmodule -> llmodule -> Mode.t -> unit */
CAMLprim value llvm_link_modules(LLVMModuleRef Dst, LLVMModuleRef Src, value Mode) {
char* Message;
if (LLVMLinkModules(Dst, Src, Int_val(Mode), &Message))
llvm_raise(llvm_linker_error_exn, Message);
llvm_raise(*caml_named_value("Llvm_linker.Error"), Message);
return Val_unit;
}

5
llvm/bindings/ocaml/linker/llvm_linker.ml
View File

@ -9,8 +9,7 @@
exception Error of string
external register_exns : exn -> unit = "llvm_register_linker_exns"
let _ = register_exns (Error "")
let () = Callback.register_exception "Llvm_linker.Error" (Error "")
module Mode = struct
type t =
@ -19,4 +18,4 @@ module Mode = struct
end
external link_modules : Llvm.llmodule -> Llvm.llmodule -> Mode.t -> unit
= "llvm_link_modules"
= "llvm_link_modules"

1
llvm/bindings/ocaml/llvm/META.llvm.in
View File

@ -4,7 +4,6 @@ description = "LLVM OCaml bindings"
archive(byte) = "llvm.cma"
archive(native) = "llvm.cmxa"
directory = "."
linkopts = "-ccopt -lstdc++"
package "analysis" (
requires = "llvm"

1
llvm/bindings/ocaml/llvm/Makefile
View File

@ -15,6 +15,7 @@ LEVEL := ../../..
LIBRARYNAME := llvm
UsedComponents := core
UsedOcamlLibs := llvm
ExtraLibs := -lstdc++
include ../Makefile.ocaml

5
llvm/bindings/ocaml/llvm/llvm.ml
View File

@ -1,4 +1,4 @@
(*===-- llvm/llvm.ml - LLVM Ocaml Interface --------------------------------===*
(*===-- llvm/llvm.ml - LLVM OCaml Interface -------------------------------===*
*
* The LLVM Compiler Infrastructure
*
@ -278,8 +278,7 @@ end
exception IoError of string
external register_exns : exn -> unit = "llvm_register_core_exns"
let _ = register_exns (IoError "")
let () = Callback.register_exception "Llvm.IoError" (IoError "")
external install_fatal_error_handler : (string -> unit) -> unit
= "llvm_install_fatal_error_handler"

86
llvm/bindings/ocaml/llvm/llvm_ocaml.c
View File

@ -15,27 +15,15 @@
|* *|
\*===----------------------------------------------------------------------===*/
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include "llvm-c/Core.h"
#include "caml/alloc.h"
#include "caml/custom.h"
#include "caml/memory.h"
#include "caml/fail.h"
#include "caml/callback.h"
#include <assert.h>
#include <stdlib.h>
#include <string.h>
/* Can't use the recommended caml_named_value mechanism for backwards
compatibility reasons. This is largely equivalent. */
static value llvm_ioerror_exn;
CAMLprim value llvm_register_core_exns(value IoError) {
llvm_ioerror_exn = Field(IoError, 0);
register_global_root(&llvm_ioerror_exn);
return Val_unit;
}
static void llvm_raise(value Prototype, char *Message) {
CAMLparam1(Prototype);
@ -45,10 +33,7 @@ static void llvm_raise(value Prototype, char *Message) {
LLVMDisposeMessage(Message);
raise_with_arg(Prototype, CamlMessage);
abort(); /* NOTREACHED */
#ifdef CAMLnoreturn
CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
#endif
CAMLnoreturn;
}
static value llvm_fatal_error_handler;
@ -186,22 +171,24 @@ CAMLprim value llvm_dump_module(LLVMModuleRef M) {
/* string -> llmodule -> unit */
CAMLprim value llvm_print_module(value Filename, LLVMModuleRef M) {
char* Message;
if(LLVMPrintModuleToFile(M, String_val(Filename), &Message)) {
llvm_raise(llvm_ioerror_exn, Message);
}
if(LLVMPrintModuleToFile(M, String_val(Filename), &Message))
llvm_raise(*caml_named_value("Llvm.IoError"), Message);
return Val_unit;
}
/* llmodule -> string */
CAMLprim value llvm_string_of_llmodule(LLVMModuleRef M) {
CAMLparam0();
CAMLlocal1(ModuleStr);
char* ModuleCStr;
ModuleCStr = LLVMPrintModuleToString(M);
value ModuleStr = caml_copy_string(ModuleCStr);
ModuleCStr = LLVMPrintModuleToString(M);
ModuleStr = caml_copy_string(ModuleCStr);
LLVMDisposeMessage(ModuleCStr);
return ModuleStr;
CAMLreturn(ModuleStr);
}
/* llmodule -> string -> unit */
@ -234,13 +221,15 @@ CAMLprim value llvm_dump_type(LLVMTypeRef Val) {
/* lltype -> string */
CAMLprim value llvm_string_of_lltype(LLVMTypeRef M) {
CAMLparam0();
CAMLlocal1(TypeStr);
char* TypeCStr;
TypeCStr = LLVMPrintTypeToString(M);
value TypeStr = caml_copy_string(TypeCStr);
TypeCStr = LLVMPrintTypeToString(M);
TypeStr = caml_copy_string(TypeCStr);
LLVMDisposeMessage(TypeCStr);
return TypeStr;
CAMLreturn(TypeStr);
}
/*--... Operations on integer types ........................................--*/
@ -554,13 +543,15 @@ CAMLprim value llvm_dump_value(LLVMValueRef Val) {
/* llvalue -> string */
CAMLprim value llvm_string_of_llvalue(LLVMValueRef M) {
CAMLparam0();
CAMLlocal1(ValueStr);
char* ValueCStr;
ValueCStr = LLVMPrintValueToString(M);
value ValueStr = caml_copy_string(ValueCStr);
ValueCStr = LLVMPrintValueToString(M);
ValueStr = caml_copy_string(ValueCStr);
LLVMDisposeMessage(ValueCStr);
return ValueStr;
CAMLreturn(ValueStr);
}
/* llvalue -> llvalue -> unit */
@ -738,16 +729,22 @@ CAMLprim LLVMValueRef llvm_const_float(LLVMTypeRef RealTy, value N) {
/* llvalue -> float */
CAMLprim value llvm_float_of_const(LLVMValueRef Const)
{
CAMLparam0();
CAMLlocal1(Option);
LLVMBool LosesInfo;
double Result;
if (LLVMIsAConstantFP(Const)) {
LLVMBool LosesInfo;
double res = LLVMConstRealGetDouble(Const, &LosesInfo);
Result = LLVMConstRealGetDouble(Const, &LosesInfo);
if (LosesInfo)
return Val_int(0);
value Option = alloc(1, 0);
Field(Option, 0) = caml_copy_double(res);
return Option;
Option = alloc(1, 0);
Field(Option, 0) = caml_copy_double(Result);
CAMLreturn(Option);
}
return Val_int(0);
CAMLreturn(Val_int(0));
}
/* lltype -> string -> llvalue */
@ -1536,15 +1533,13 @@ static void llvm_finalize_builder(value B) {
}
static struct custom_operations builder_ops = {
(char *) "LLVMIRBuilder",
(char *) "Llvm.llbuilder",
llvm_finalize_builder,
custom_compare_default,
custom_hash_default,
custom_serialize_default,
custom_deserialize_default
#ifdef custom_compare_ext_default
, custom_compare_ext_default
#endif
custom_deserialize_default,
custom_compare_ext_default
};
static value alloc_builder(LLVMBuilderRef B) {
@ -2254,7 +2249,7 @@ CAMLprim value llvm_memorybuffer_of_file(value Path) {
if (LLVMCreateMemoryBufferWithContentsOfFile(String_val(Path),
&MemBuf, &Message))
llvm_raise(llvm_ioerror_exn, Message);
llvm_raise(*caml_named_value("Llvm.IoError"), Message);
CAMLreturn((value) MemBuf);
}
@ -2266,20 +2261,21 @@ CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) {
LLVMMemoryBufferRef MemBuf;
if (LLVMCreateMemoryBufferWithSTDIN(&MemBuf, &Message))
llvm_raise(llvm_ioerror_exn, Message);
llvm_raise(*caml_named_value("Llvm.IoError"), Message);
return MemBuf;
}
/* ?name:string -> string -> llmemorybuffer */
CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_string(value Name, value String) {
LLVMMemoryBufferRef MemBuf;
const char *NameCStr;
if(Name == Val_int(0))
NameCStr = "";
else
NameCStr = String_val(Field(Name, 0));
LLVMMemoryBufferRef MemBuf;
MemBuf = LLVMCreateMemoryBufferWithMemoryRangeCopy(
String_val(String), caml_string_length(String), NameCStr);

3
llvm/bindings/ocaml/target/llvm_target.ml
View File

@ -47,8 +47,7 @@ end
exception Error of string
external register_exns : exn -> unit = "llvm_register_target_exns"
let _ = register_exns (Error "")
let () = Callback.register_exception "Llvm_target.Error" (Error "")
module DataLayout = struct
type t

42
llvm/bindings/ocaml/target/target_ocaml.c
View File

@ -21,17 +21,10 @@
#include "caml/fail.h"
#include "caml/memory.h"
#include "caml/custom.h"
#include "caml/callback.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);
@ -40,10 +33,7 @@ static void llvm_raise(value Prototype, char *Message) {
LLVMDisposeMessage(Message);
raise_with_arg(Prototype, CamlMessage);
abort(); /* NOTREACHED */
#ifdef CAMLnoreturn
CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
#endif
CAMLnoreturn;
}
static value llvm_string_of_message(char* Message) {
@ -62,15 +52,13 @@ static void llvm_finalize_data_layout(value DataLayout) {
}
static struct custom_operations llvm_data_layout_ops = {
(char *) "LLVMDataLayout",
(char *) "Llvm_target.DataLayout.t",
llvm_finalize_data_layout,
custom_compare_default,
custom_hash_default,
custom_serialize_default,
custom_deserialize_default
#ifdef custom_compare_ext_default
, custom_compare_ext_default
#endif
custom_deserialize_default,
custom_compare_ext_default
};
value llvm_alloc_data_layout(LLVMTargetDataRef DataLayout) {
@ -219,7 +207,7 @@ CAMLprim LLVMTargetRef llvm_target_by_triple(value Triple) {
char *Error;
if(LLVMGetTargetFromTriple(String_val(Triple), &T, &Error))
llvm_raise(llvm_target_error_exn, Error);
llvm_raise(*caml_named_value("Llvm_target.Error"), Error);
return T;
}
@ -258,15 +246,13 @@ static void llvm_finalize_target_machine(value Machine) {
}
static struct custom_operations llvm_target_machine_ops = {
(char *) "LLVMTargetMachine",
(char *) "Llvm_target.TargetMachine.t",
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
custom_deserialize_default,
custom_compare_ext_default
};
static value llvm_alloc_targetmachine(LLVMTargetMachineRef Machine) {
@ -337,6 +323,7 @@ CAMLprim value llvm_targetmachine_features(value Machine) {
CAMLprim value llvm_targetmachine_data_layout(value Machine) {
CAMLparam1(Machine);
CAMLlocal1(DataLayout);
char *TargetDataCStr;
/* LLVMGetTargetMachineData returns a pointer owned by the TargetMachine,
so it is impossible to wrap it with llvm_alloc_target_data, which assumes
@ -344,7 +331,6 @@ CAMLprim value llvm_targetmachine_data_layout(value Machine) {
LLVMTargetDataRef OrigDataLayout;
OrigDataLayout = LLVMGetTargetMachineData(TargetMachine_val(Machine));
char* TargetDataCStr;
TargetDataCStr = LLVMCopyStringRepOfTargetData(OrigDataLayout);
DataLayout = llvm_alloc_data_layout(LLVMCreateTargetData(TargetDataCStr));
LLVMDisposeMessage(TargetDataCStr);
@ -361,12 +347,12 @@ CAMLprim value llvm_targetmachine_set_verbose_asm(value Verb, value Machine) {
/* 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;
char *ErrorMessage;
if(LLVMTargetMachineEmitToFile(TargetMachine_val(Machine), Module,
String_val(FileName), Int_val(FileType),
&ErrorMessage)) {
llvm_raise(llvm_target_error_exn, ErrorMessage);
llvm_raise(*caml_named_value("Llvm_target.Error"), ErrorMessage);
}
return Val_unit;
@ -377,13 +363,13 @@ CAMLprim value llvm_targetmachine_emit_to_file(LLVMModuleRef Module,
CAMLprim LLVMMemoryBufferRef llvm_targetmachine_emit_to_memory_buffer(
LLVMModuleRef Module, value FileType,
value Machine) {
char* ErrorMessage;
char *ErrorMessage;
LLVMMemoryBufferRef Buffer;
if(LLVMTargetMachineEmitToMemoryBuffer(TargetMachine_val(Machine), Module,
Int_val(FileType), &ErrorMessage,
&Buffer)) {
llvm_raise(llvm_target_error_exn, ErrorMessage);
llvm_raise(*caml_named_value("Llvm_target.Error"), ErrorMessage);
}
return Buffer;

4
llvm/bindings/ocaml/transforms/ipo/Makefile
View File

@ -1,4 +1,4 @@
##===- bindings/ocaml/transforms/scalar/Makefile -----------*- Makefile -*-===##
##===- bindings/ocaml/transforms/ipo/Makefile --------------*- Makefile -*-===##
#
# The LLVM Compiler Infrastructure
#
@ -7,7 +7,7 @@
#
##===----------------------------------------------------------------------===##
#
# This is the makefile for the Objective Caml Llvm_scalar_opts interface.
# This is the makefile for the Objective Caml Llvm_ipo interface.
#
##===----------------------------------------------------------------------===##

8
llvm/bindings/ocaml/transforms/passmgr_builder/passmgr_builder_ocaml.c
View File

@ -27,15 +27,13 @@ static void llvm_finalize_pmbuilder(value PMB) {
}
static struct custom_operations pmbuilder_ops = {
(char *) "LLVMPassManagerBuilder",
(char *) "Llvm_passmgr_builder.t",
llvm_finalize_pmbuilder,
custom_compare_default,
custom_hash_default,
custom_serialize_default,
custom_deserialize_default
#ifdef custom_compare_ext_default
, custom_compare_ext_default
#endif
custom_deserialize_default,
custom_compare_ext_default
};
static value alloc_pmbuilder(LLVMPassManagerBuilderRef Ref) {

2
llvm/bindings/ocaml/transforms/vectorize/Makefile
View File

@ -7,7 +7,7 @@
#
##===----------------------------------------------------------------------===##
#
# This is the makefile for the Objective Caml Llvm_vectorize_opts interface.
# This is the makefile for the Objective Caml Llvm_vectorize interface.
#
##===----------------------------------------------------------------------===##

2
llvm/test/Makefile
View File

@ -129,7 +129,7 @@ lit.site.cfg: FORCE
@$(ECHOPATH) s=@PYTHON_EXECUTABLE@=$(PYTHON)=g >> lit.tmp
@$(ECHOPATH) s=@OCAMLC@=$(OCAMLC)=g >> lit.tmp
@$(ECHOPATH) s=@OCAMLOPT@=$(OCAMLOPT)=g >> lit.tmp
@$(ECHOPATH) s=@OCAMLFLAGS@=-cclib -lstdc++ -cclib -L$(LibDir) -I $(LibDir)/ocaml $(addprefix -cclib ,$(LDFLAGS))=g >> lit.tmp
@$(ECHOPATH) s=@OCAMLFLAGS@=-cclib -L$(LibDir) -I $(LibDir)/ocaml $(addprefix -cclib ,$(LDFLAGS))=g >> lit.tmp
@$(ECHOPATH) s=@GO_EXECUTABLE@=$(GO)=g >> lit.tmp
@$(ECHOPATH) s!@HOST_CC@!$(CC)!g >> lit.tmp
@$(ECHOPATH) s!@HOST_CXX@!$(CXX)!g >> lit.tmp