llvm-hs 6.2.0 → 6.3.0

raw patch · 21 files changed

+521/−72 lines, 21 filesdep +processdep ~pretty-showdep ~temporaryPVP ok

version bump matches the API change (PVP)

Dependencies added: process

Dependency ranges changed: pretty-show, temporary

API changes (from Hackage documentation)

Files

• CHANGELOG.md +22/−0
• llvm-hs.cabal +7/−2
• src/LLVM.hs +115/−1
• src/LLVM/Internal/FFI/Builder.hs +8/−8
• src/LLVM/Internal/FFI/BuilderC.cpp +129/−23
• src/LLVM/Internal/FFI/MetadataC.cpp +1/−1
• src/LLVM/Internal/FFI/OrcJIT.h +12/−6
• src/LLVM/Internal/FFI/OrcJIT.hs +3/−0
• src/LLVM/Internal/FFI/OrcJIT/LinkingLayer.hs +13/−0
• src/LLVM/Internal/FFI/OrcJITC.cpp +26/−0
• src/LLVM/Internal/ObjectFile.hs +9/−1
• src/LLVM/Internal/OrcJIT.hs +34/−9
• src/LLVM/Internal/OrcJIT/CompileLayer.hs +2/−2
• src/LLVM/Internal/OrcJIT/LinkingLayer.hs +26/−0
• src/LLVM/OrcJIT.hs +2/−2
• src/LLVM/OrcJIT/CompileLayer.hs +12/−0
• src/LLVM/OrcJIT/LinkingLayer.hs +12/−0
• test/LLVM/Test/Instructions.hs +5/−4
• test/LLVM/Test/Metadata.hs +42/−0
• test/LLVM/Test/OrcJIT.hs +38/−13
• test/main_return_38.c +3/−0

@@ -1,3 +1,25 @@+## 6.3.0 (2018-06-12)++* `findSymbol` and `findSymbolIn` now return `Either JITSymbolError+  JITSymbol` if the JIT symbol has the error flag set or the address+  is 0. (This is consistent with how LLVM treats JIT symbols).+* The return type of `SymbolResolverFn` has been changed to `Either+  JITSymbolError JITSymbol`. It is fine to return a 0 address in+  `Right` so existing resolvers can be adapted by wrapping the result+  in `Right`.+* Fixed a bug where instructions were constant-folded during+  encoding. This caused problems since the API available on a Constant+  is not the same as the one on an Instruction (e.g., we cannot set+  metadata on a Constant).+* Fix use-after-free in `createObjectFile`.+* Add `withObjectFile` wrapper for `createObjectFile` and+  `disposeObjectFile`.+* Add API for looking up symbols in the `LinkingLayer`.+* Add `LLVM.OrcJIT.CompileLayer` and `LLVM.OrcJIT.LinkingLayer`+  modules that reexport the internal modules. The+  `findSymbol/findSymbolIn` methods that have previously been exported+  from `LLVM.OrcJIT` can now be found in `LLVM.OrcJIT.CompileLayer`.+ ## 6.2.0 (2018-05-08)  * Remove field prefixes from `DIDerivedType`, `DIBasicType` and

@@ -1,5 +1,5 @@ name: llvm-hs-version: 6.2.0+version: 6.3.0 license: BSD3 license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer <moritz.kiefer@purelyfunctional.org>, Benjamin S. Scarlet@@ -38,6 +38,7 @@   src/LLVM/Internal/FFI/Value.h   test/debug_metadata_1.ll   test/debug_metadata_2.ll+  test/main_return_38.c tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1 extra-source-files: CHANGELOG.md @@ -190,6 +191,8 @@     LLVM.Linking     LLVM.Module     LLVM.OrcJIT+    LLVM.OrcJIT.CompileLayer+    LLVM.OrcJIT.LinkingLayer     LLVM.PassManager     LLVM.Relocation     LLVM.Target@@ -249,7 +252,9 @@     mtl >= 2.1,     transformers >= 0.3.0.0,     temporary >= 1.2 && < 1.4,-    pretty-show >= 1.6 && < 1.8+    pretty-show >= 1.6 && < 1.8,+    process,+    temporary   hs-source-dirs: test   default-extensions:     TupleSections

@@ -1,7 +1,121 @@--- | An interface to use LLVM in all capacities+{-|+Module : LLVM+Description: An interface to use LLVM in all capacities.+Copyright: (c) Moritz Kiefer 2018+               Stephen Diehl 2018+               Benjamin Scarlett 2016+Maintainer: moritz.kiefer@purelyfunctional.org+-} module LLVM (   module LLVM.Module+  -- * Overview of the @llvm-hs@ library ecosystem+  -- $ecosystem++  -- * Constructing the C++ representation of an LLVM module+  -- $moduleconstruction++  -- * #objectcode# Generating object code+  -- $objectcode++  -- * #jitcompilation# JIT compilation+  -- $jitcompilation   ) where  import LLVM.Module +import LLVM.AST ()++{- $ecosystem++The main two libraries in the @llvm-hs@ ecosystem are @llvm-hs-pure@+and @llvm-hs@.++* @llvm-hs-pure@ defines a pure Haskell representation of the LLVM+AST. It has no dependency on the LLVM C/C++ libraries so even if you+have trouble installing those or want to avoid that dependency, you+should be able to use it. The documentation+in [LLVM.AST](https://hackage.haskell.org/package/llvm-hs-pure/docs/LLVM-AST.html)+describes the different options for constructing the AST.++* @llvm-hs@ then builds upon @llvm-hs-pure@ and provides the actual FFI+bindings to LLVM’s C++ libraries. Most importantly this includes+bidirectional conversions from the Haskell representation of an LLVM+module to the C++ representation and the other way around.++Once you have constructed the C++ representation, there are two main options:++1. Generate object code as described in "LLVM#objectcode"+2. or JIT compile the module as described in "LLVM#jitcompilation".++In addition to @llvm-hs@ and @llvm-hs-pure@, there are a couple of+other libraries that you be interested in:++* [llvm-hs-pretty](https://hackage.haskell.org/package/llvm-hs-pretty)+  a pure Haskell prettyprinter for the AST in @llvm-hs-pure@. This is+  useful if you just want to render your AST to LLVM’s textual IR+  format either for debugging purposes (@llc@ will usually give pretty+  good error messages for invalid IR) or because you prefer to call+  the LLVM CLI tools over the linking against the LLVM libraries.++* [llvm-hs-typed](https://github.com/llvm-hs/llvm-hs-typed) contains a+  strongly-typed wrapper for the AST in @llvm-hs-pure@ which makes it+  harder to accidentally construct invalid LLVM IR.++* [llvm-hs-quote](https://github.com/llvm-hs/llvm-hs-quote) contains a+  Haskell quasiquoter that can be used for splicing larger chunks of+  existing LLVM IR into your Haskell code.++Finally, there is a [translation](https://github.com/llvm-hs/llvm-hs-kaleidoscope) of+LLVM’s official Kaleidoscope tutorial to @llvm-hs@ and you can find+small, self-contained examples covering various parts of the API in+the [llvm-hs-examples](https://github.com/llvm-hs/llvm-hs-examples)+repository.+-}++{- $moduleconstruction++Interacting with the LLVM libraries requires that you first construct+the C++ representation of an LLVM `Module`.++The most common way of doing that is to first construct the Haskell+representation of an LLVM module using @llvm-hs-pure@. You can then+use `withModuleFromAST` to convert the Haskell AST to the C+++representation.++Alternatively, you can also construct a module from LLVM’s textual IR+or the binary bitcode format using `withModuleFromLLVMAssembly` and+`withModuleFromBitcode`.++-}++{- $objectcode++Once you have constructed the C++ representation of an LLVM `Module`,+you can generate an object file using `moduleObject` which will give+you a `Data.ByteString.ByteString` or write it to a file using+`writeObjectToFile`. To construct the `TargetMachine` for these+functions you can use `LLVM.Target.withHostTargetMachine` if you want+to generate object code for the machine you are currently running on+or use `LLVM.Target.withTargetMachine` and customize the target+machine based on your needs.+-}++{- $jitcompilation++In addition to generating object code, you can also JIT-compile LLVM+modules and call functions in the resulting `Module` from Haskell.++LLVM has several JIT compilers but ORC JIT is the one that is actively+being developed and the one best supported by @llvm-hs@.++To use ORC JIT you first have to create a+`LLVM.OrcJIT.CompileLayer`. You can then use `LLVM.OrcJIT.withModule`+to add an LLVM module to the compile layer and finally use+`LLVM.Internal.OrcJIT.CompileLayer.findSymbol` to get the address of a+symbol in the module.  In most cases, you want to lookup the address+of a function so you have to first convert the `Foreign.Ptr.WordPtr`+to a `Foreign.Ptr.FunPtr` using `Foreign.Ptr.wordPtrToPtr` and+`Foreign.Ptr.castPtrToFunPtr`. Then you can use a foreign dynamic+import to construct a Haskell function which will call the function+located at the `Foreign.Ptr.FunPtr`.+-}

@@ -83,7 +83,7 @@       _ -> []      let ats = map typeMapping (fieldTypes List.\\ [TH.ConT ''A.InstructionMetadata, TH.ConT ''A.FastMathFlags])-        cName = (if hasFlags fieldTypes then "LLVM_Hs_" else "LLVM") ++ "Build" ++ a+        cName = "LLVM_Hs_Build" ++ a     rt <- case k of             ID.Binary -> [[t| BinaryOperator |]]             ID.Cast -> [[t| Instruction |]]@@ -106,10 +106,10 @@ buildStore :: Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> (SynchronizationScope, MemoryOrdering) -> CUInt -> CString -> IO (Ptr Instruction) buildStore builder vol a' v' (ss, mo) al s = buildStore' builder vol a' v' mo ss al s -foreign import ccall unsafe "LLVMBuildGEP" buildGetElementPtr' ::+foreign import ccall unsafe "LLVM_Hs_BuildGEP" buildGetElementPtr' ::   Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVMBuildInBoundsGEP" buildInBoundsGetElementPtr' ::+foreign import ccall unsafe "LLVM_Hs_BuildInBoundsGEP" buildInBoundsGetElementPtr' ::   Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction)  buildGetElementPtr :: Ptr Builder -> LLVMBool -> Ptr Value -> (CUInt, Ptr (Ptr Value)) -> CString -> IO (Ptr Instruction)@@ -135,7 +135,7 @@ buildAtomicRMW :: Ptr Builder -> LLVMBool -> RMWOperation -> Ptr Value -> Ptr Value -> (SynchronizationScope, MemoryOrdering) -> CString -> IO (Ptr Instruction) buildAtomicRMW builder vol rmwOp a v (ss, mo) s = buildAtomicRMW' builder vol rmwOp a v mo ss s -foreign import ccall unsafe "LLVMBuildICmp" buildICmp ::+foreign import ccall unsafe "LLVM_Hs_BuildICmp" buildICmp ::   Ptr Builder -> ICmpPredicate -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction)  foreign import ccall unsafe "LLVMBuildFCmp" buildFCmp ::@@ -147,19 +147,19 @@ foreign import ccall unsafe "LLVMBuildCall" buildCall ::   Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVMBuildSelect" buildSelect ::+foreign import ccall unsafe "LLVM_Hs_BuildSelect" buildSelect ::   Ptr Builder -> Ptr Value -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction)  foreign import ccall unsafe "LLVMBuildVAArg" buildVAArg ::   Ptr Builder -> Ptr Value -> Ptr Type -> CString -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVMBuildExtractElement" buildExtractElement ::+foreign import ccall unsafe "LLVM_Hs_BuildExtractElement" buildExtractElement ::   Ptr Builder -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVMBuildInsertElement" buildInsertElement ::+foreign import ccall unsafe "LLVM_Hs_BuildInsertElement" buildInsertElement ::   Ptr Builder -> Ptr Value -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVMBuildShuffleVector" buildShuffleVector ::+foreign import ccall unsafe "LLVM_Hs_BuildShuffleVector" buildShuffleVector ::   Ptr Builder -> Ptr Value -> Ptr Value -> Ptr Constant -> CString -> IO (Ptr Instruction)  foreign import ccall unsafe "LLVM_Hs_BuildExtractValue" buildExtractValue ::

@@ -61,7 +61,10 @@ 	LLVMValueRef o1,																											\ 	const char *s																													\ ) {																																			\-	return wrap(unwrap(b)->Create ## Op(unwrap(o0), unwrap(o1), s, nuw, nsw)); \+    BinaryOperator *BO = unwrap(b)->Insert(BinaryOperator::Create(Instruction::Op, unwrap(o0), unwrap(o1)), s); \+    if (nuw) BO->setHasNoUnsignedWrap(); \+    if (nsw) BO->setHasNoSignedWrap(); \+    return wrap(BO);                   \ } LLVM_HS_FOR_EACH_OVERFLOWING_BINARY_OPERATOR(ENUM_CASE) #undef ENUM_CASE@@ -74,15 +77,76 @@ 	LLVMValueRef o1,																											\ 	const char *s																													\ ) {																																			\-	return wrap(unwrap(b)->Create ## Op(unwrap(o0), unwrap(o1), s, exact)); \+    if (!exact) { \+        return wrap(unwrap(b)->Insert(BinaryOperator::Create##Op(unwrap(o0), unwrap(o1)), s)); \+    } \+     return wrap(unwrap(b)->Insert(BinaryOperator::CreateExact##Op(unwrap(o0), unwrap(o1)), s)); \ } LLVM_HS_FOR_EACH_POSSIBLY_EXACT_BINARY_OPERATOR(ENUM_CASE) #undef ENUM_CASE +#define LLVM_HS_FOR_EACH_CAST_INSTR(macro) \+    macro(AddrSpaceCast) \+    macro(BitCast) \+    macro(FPExt) \+    macro(FPToSI) \+    macro(FPToUI) \+    macro(FPTrunc) \+    macro(IntToPtr) \+    macro(PtrToInt) \+    macro(SExt) \+    macro(SIToFP) \+    macro(Trunc) \+    macro(UIToFP) \+    macro(ZExt)++#define ENUM_CASE(Op) \+LLVMValueRef LLVM_Hs_Build##Op(LLVMBuilderRef b, LLVMValueRef val, LLVMTypeRef destTy, const char *name) {\+    return wrap(unwrap(b)->Insert(CastInst::Create(Instruction::Op, unwrap(val), unwrap(destTy)), name));\+}+LLVM_HS_FOR_EACH_CAST_INSTR(ENUM_CASE)+#undef ENUM_CASE++#define LLVM_HS_FOR_EACH_BINOP(macro) \+    macro(And) \+    macro(Or) \+    macro(SRem) \+    macro(URem) \+    macro(Xor)++#define ENUM_CASE(Op) \+LLVMValueRef LLVM_Hs_Build##Op(LLVMBuilderRef b, LLVMValueRef lhs, LLVMValueRef rhs, const char *name) {\+    return wrap(unwrap(b)->Insert(BinaryOperator::Create##Op(unwrap(lhs), unwrap(rhs)), name)); \+}+LLVM_HS_FOR_EACH_BINOP(ENUM_CASE)+#undef ENUM_CASE++#define LLVM_HS_FOR_EACH_FP_BINOP(macro) \+    macro(FAdd) \+    macro(FDiv) \+    macro(FMul) \+    macro(FRem) \+    macro(FSub)++#define ENUM_CASE(Op) \+LLVMValueRef LLVM_Hs_Build##Op(LLVMBuilderRef b, LLVMValueRef lhs, LLVMValueRef rhs, const char *name) { \+    BinaryOperator* bo = BinaryOperator::Create##Op(unwrap(lhs), unwrap(rhs)); \+    bo->setFastMathFlags(unwrap(b)->getFastMathFlags()); \+    return wrap(unwrap(b)->Insert(bo, name)); \+}+LLVM_HS_FOR_EACH_FP_BINOP(ENUM_CASE)+#undef ENUM_CASE+ void LLVM_Hs_SetFastMathFlags(LLVMBuilderRef b, LLVMFastMathFlags f) { 	unwrap(b)->setFastMathFlags(unwrap(f)); } +LLVMValueRef LLVM_Hs_BuildICmp(LLVMBuilderRef b, LLVMIntPredicate op, LLVMValueRef lhs, LLVMValueRef rhs, const char* name) {++    return wrap(unwrap(b)->Insert(new ICmpInst(static_cast<ICmpInst::Predicate>(op),+                                               unwrap(lhs), unwrap(rhs)), name));+}+ LLVMValueRef LLVM_Hs_BuildLoad( 	LLVMBuilderRef b, 	LLVMBool isVolatile,@@ -160,27 +224,6 @@ 	return wrap(a); } -LLVMValueRef LLVM_Hs_BuildExtractValue(-	LLVMBuilderRef b,-	LLVMValueRef a,-	unsigned *idxs,-	unsigned n,-	const char *name-) {-	return wrap(unwrap(b)->CreateExtractValue(unwrap(a), ArrayRef<unsigned>(idxs, n), name));-}--LLVMValueRef LLVM_Hs_BuildInsertValue(-	LLVMBuilderRef b,-	LLVMValueRef a,-	LLVMValueRef v,-	unsigned *idxs,-	unsigned n,-	const char *name-) {-	return wrap(unwrap(b)->CreateInsertValue(unwrap(a), unwrap(v), ArrayRef<unsigned>(idxs, n), name));-}- LLVMValueRef LLVM_Hs_BuildCleanupPad(LLVMBuilderRef b, LLVMValueRef parentPad,                                      LLVMValueRef *args, unsigned numArgs,                                      const char *name) {@@ -221,5 +264,68 @@                                       unsigned numHandlers) {     return wrap(unwrap(b)->CreateCatchSwitch(unwrap(parentPad),                                              unwrap(unwindDest), numHandlers));+}++LLVMValueRef LLVM_Hs_BuildGEP(LLVMBuilderRef B, LLVMValueRef Pointer,+                             LLVMValueRef *Indices, unsigned NumIndices,+                             const char *Name) {+  ArrayRef<Value *> IdxList(unwrap(Indices), NumIndices);+  return wrap(unwrap(B)->Insert(GetElementPtrInst::Create(nullptr, unwrap(Pointer), IdxList), Name));+}++LLVMValueRef LLVM_Hs_BuildInBoundsGEP(LLVMBuilderRef B, LLVMValueRef Pointer,+                                      LLVMValueRef *Indices, unsigned NumIndices,+                                      const char *Name) {+  ArrayRef<Value *> IdxList(unwrap(Indices), NumIndices);+  return wrap(unwrap(B)->Insert(GetElementPtrInst::CreateInBounds(nullptr, unwrap(Pointer), IdxList), Name));+}++LLVMValueRef LLVM_Hs_BuildSelect(LLVMBuilderRef B, LLVMValueRef If,+                                 LLVMValueRef Then, LLVMValueRef Else,+                                 const char *Name) {+    return wrap(unwrap(B)->Insert(SelectInst::Create(unwrap(If), unwrap(Then), unwrap(Else))));+}++LLVMValueRef LLVM_Hs_BuildExtractValue(+	LLVMBuilderRef b,+	LLVMValueRef a,+	unsigned *idxs,+	unsigned n,+	const char *name+) {+	return wrap(unwrap(b)->Insert(ExtractValueInst::Create(unwrap(a), ArrayRef<unsigned>(idxs, n)), name));+}++LLVMValueRef LLVM_Hs_BuildInsertValue(+	LLVMBuilderRef b,+	LLVMValueRef a,+	LLVMValueRef v,+	unsigned *idxs,+	unsigned n,+	const char *name+) {+	return wrap(unwrap(b)->Insert(InsertValueInst::Create(unwrap(a), unwrap(v), ArrayRef<unsigned>(idxs, n)), name));+}++LLVMValueRef LLVM_Hs_BuildExtractElement(LLVMBuilderRef B, LLVMValueRef VecVal,+                                         LLVMValueRef Index, const char *Name) {+    return wrap(unwrap(B)->Insert(ExtractElementInst::Create(unwrap(VecVal), unwrap(Index)),+                                  Name));+}++LLVMValueRef LLVM_Hs_BuildInsertElement(LLVMBuilderRef B, LLVMValueRef VecVal,+                                        LLVMValueRef EltVal, LLVMValueRef Index,+                                        const char *Name) {+    return wrap(unwrap(B)->Insert(InsertElementInst::Create(unwrap(VecVal), unwrap(EltVal),+                                                            unwrap(Index)),+                                  Name));+}++LLVMValueRef LLVM_Hs_BuildShuffleVector(LLVMBuilderRef B, LLVMValueRef V1,+                                        LLVMValueRef V2, LLVMValueRef Mask,+                                        const char *Name) {+    return wrap(unwrap(B)->Insert(new ShuffleVectorInst(unwrap(V1), unwrap(V2),+                                                        unwrap(Mask)),+                                  Name)); } }

@@ -536,7 +536,7 @@     return e->getNumElements(); } -unsigned LLVM_Hs_DIExpression_GetElement(DIExpression* e, unsigned i) {+uint64_t LLVM_Hs_DIExpression_GetElement(DIExpression* e, unsigned i) {     return e->getElement(i); } 

@@ -2,14 +2,20 @@ #define __LLVM_INTERNAL_FFI__ORC_JIT__H__  #define LLVM_HS_FOR_EACH_JIT_SYMBOL_FLAG(macro) \-	macro(None)                                      \-	macro(Weak)                                      \-	macro(Exported)                                  \+    macro(None)                                      \+    macro(HasError)                                  \+    macro(Weak)                                      \+    macro(Common)                                    \+    macro(Absolute)                                  \+    macro(Exported)                                  \  typedef enum {-#define ENUM_CASE(x) LLVMJITSymbolFlag ## x,-LLVM_HS_FOR_EACH_JIT_SYMBOL_FLAG(ENUM_CASE)-#undef ENUM_CASE+              LLVMJITSymbolFlagNone = 0,+              LLVMJITSymbolFlagHasError = 1U << 0,+              LLVMJITSymbolFlagWeak = 1U << 1,+              LLVMJITSymbolFlagCommon = 1U << 2,+              LLVMJITSymbolFlagAbsolute = 1U << 3,+              LLVMJITSymbolFlagExported = 1U << 4 } LLVMJITSymbolFlags;  #endif

@@ -37,6 +37,9 @@ foreign import ccall safe "LLVM_Hs_JITSymbol_getFlags" getFlags ::   Ptr JITSymbol -> IO JITSymbolFlags +foreign import ccall safe "LLVM_Hs_JITSymbol_getErrorMsg" getErrorMsg ::+  Ptr JITSymbol -> IO (OwnerTransfered CString)+ foreign import ccall safe "LLVM_Hs_setJITSymbol" setJITSymbol ::   Ptr JITSymbol -> TargetAddress -> JITSymbolFlags -> IO () 

@@ -30,3 +30,16 @@   Ptr LambdaResolver ->   Ptr (OwnerTransfered CString) ->   IO ObjectHandle++foreign import ccall safe "LLVM_Hs_LinkingLayer_findSymbol" findSymbol ::+  Ptr LinkingLayer ->+  CString ->+  LLVMBool ->+  IO (Ptr JITSymbol)++foreign import ccall safe "LLVM_Hs_LinkingLayer_findSymbolIn" findSymbolIn ::+  Ptr LinkingLayer ->+  ObjectHandle ->+  CString ->+  LLVMBool ->+  IO (Ptr JITSymbol)

@@ -22,6 +22,9 @@ using namespace llvm; using namespace orc; +#define SYMBOL_CASE(x) static_assert((unsigned)LLVMJITSymbolFlag ## x == (unsigned) llvm::JITSymbolFlags::FlagNames::x, "JITSymbolFlag values should agree");+LLVM_HS_FOR_EACH_JIT_SYMBOL_FLAG(SYMBOL_CASE)+ typedef unsigned LLVMModuleHandle; typedef unsigned LLVMObjectHandle; typedef llvm::orc::LambdaResolver<@@ -301,6 +304,21 @@  void LLVM_Hs_disposeJITSymbol(LLVMJITSymbolRef symbol) { delete symbol; } +LLVMJITSymbolRef LLVM_Hs_LinkingLayer_findSymbol(LinkingLayer *linkingLayer,+                                     const char *name,+                                     LLVMBool exportedSymbolsOnly) {+  JITSymbol symbol = linkingLayer->findSymbol(name, exportedSymbolsOnly);+  return new JITSymbol(std::move(symbol));+}++LLVMJITSymbolRef LLVM_Hs_LinkingLayer_findSymbolIn(LinkingLayer *linkingLayer,+                                                   LLVMObjectHandle handle,+                                                   const char *name,+                                                   LLVMBool exportedSymbolsOnly) {+  JITSymbol symbol = linkingLayer->findSymbolIn(handle, name, exportedSymbolsOnly);+  return new JITSymbol(std::move(symbol));+}+ LLVMLambdaResolverRef LLVM_Hs_createLambdaResolver(     void (*dylibResolver)(const char *, LLVMJITSymbolRef),     void (*externalResolver)(const char *, LLVMJITSymbolRef)) {@@ -355,6 +373,14 @@  LLVMJITSymbolFlags LLVM_Hs_JITSymbol_getFlags(LLVMJITSymbolRef symbol) {     return wrap(symbol->getFlags());+}++const char* LLVM_Hs_JITSymbol_getErrorMsg(LLVMJITSymbolRef symbol) {+    if (!symbol) {+        Error err = symbol->takeError();+        return strdup(toString(std::move(err)).c_str());+    }+    return strdup(""); }  void LLVM_Hs_setJITSymbol(LLVMJITSymbolRef symbol, JITTargetAddress addr,

@@ -1,5 +1,6 @@ module LLVM.Internal.ObjectFile where +import Control.Exception (bracket) import Control.Monad.IO.Class import Control.Monad.AnyCont import Foreign.Ptr@@ -7,6 +8,7 @@ import LLVM.Prelude import LLVM.Internal.Coding import LLVM.Internal.MemoryBuffer+import qualified LLVM.Internal.FFI.LLVMCTypes as FFI import qualified LLVM.Internal.FFI.ObjectFile as FFI  newtype ObjectFile = ObjectFile (Ptr FFI.ObjectFile)@@ -22,7 +24,13 @@ -- `.o` file. This does *not* compile source files. createObjectFile :: FilePath -> IO ObjectFile createObjectFile path = flip runAnyContT return $ do-  buf <- encodeM (File path)+  -- The ownership of the object file is transfered to the object+  -- file, so we need to make sure that we do not free it here.+  FFI.OwnerTransfered buf <- encodeM (File path)   obj <- liftIO $ FFI.createObjectFile buf   when (obj == nullPtr) $ error "LLVMCreateObjectFile returned a null pointer."   return (ObjectFile obj)++-- | @bracket@-style wrapper for `createObjectFile` and `disposeObjectFile`.+withObjectFile :: FilePath -> (ObjectFile -> IO a) -> IO a+withObjectFile f = bracket (createObjectFile f) disposeObjectFile

@@ -30,13 +30,24 @@ instance MonadIO m => DecodeM m MangledSymbol CString where   decodeM str = liftIO $ MangledSymbol <$> packCString str +-- | Contrary to the C++ interface, we do not store the HasError flag+-- here. Instead decoding a JITSymbol produces a sumtype based on+-- whether that flag is set or not. data JITSymbolFlags =   JITSymbolFlags {-    jitSymbolWeak :: !Bool, -- ^ Is this a weak symbol?-    jitSymbolExported :: !Bool -- ^ Is this symbol exported?+    jitSymbolWeak :: !Bool -- ^ Is this a weak symbol?+  , jitSymbolCommon :: !Bool -- ^ Is this a common symbol?+  , jitSymbolAbsolute :: !Bool+    -- ^ Is this an absolute symbol? This will cause LLVM to use+    -- absolute relocations for the symbol even in position+    -- independent code.+  , jitSymbolExported :: !Bool -- ^ Is this symbol exported?   }   deriving (Show, Eq, Ord) +defaultJITSymbolFlags :: JITSymbolFlags+defaultJITSymbolFlags = JITSymbolFlags False False False False+ data JITSymbol =   JITSymbol {     jitSymbolAddress :: !WordPtr, -- ^ The address of the symbol. If@@ -46,8 +57,11 @@   }   deriving (Show, Eq, Ord) -type SymbolResolverFn = MangledSymbol -> IO JITSymbol+data JITSymbolError = JITSymbolError ShortByteString+  deriving (Show, Eq) +type SymbolResolverFn = MangledSymbol -> IO (Either JITSymbolError JITSymbol)+ -- | Specifies how external symbols in a module added to a -- 'CompielLayer' should be resolved. data SymbolResolver =@@ -67,6 +81,8 @@          else 0     | (a,b) <- [           (jitSymbolWeak, FFI.jitSymbolFlagsWeak),+          (jitSymbolCommon, FFI.jitSymbolFlagsCommon),+          (jitSymbolAbsolute, FFI.jitSymbolFlagsAbsolute),           (jitSymbolExported, FFI.jitSymbolFlagsExported)         ]     ]@@ -75,21 +91,30 @@   decodeM f =     return $ JITSymbolFlags {       jitSymbolWeak = FFI.jitSymbolFlagsWeak .&. f /= 0,+      jitSymbolCommon = FFI.jitSymbolFlagsCommon .&. f /= 0,+      jitSymbolAbsolute = FFI.jitSymbolFlagsAbsolute .&. f /= 0,       jitSymbolExported = FFI.jitSymbolFlagsExported .&. f /= 0     } -instance MonadIO m => EncodeM m JITSymbol (Ptr FFI.JITSymbol -> IO ()) where-  encodeM (JITSymbol addr flags) = return $ \jitSymbol -> do+instance MonadIO m => EncodeM m (Either JITSymbolError JITSymbol) (Ptr FFI.JITSymbol -> IO ()) where+  encodeM (Left (JITSymbolError _)) = return $ \jitSymbol ->+    FFI.setJITSymbol jitSymbol (FFI.TargetAddress 0) FFI.jitSymbolFlagsHasError+  encodeM (Right (JITSymbol addr flags)) = return $ \jitSymbol -> do     flags' <- encodeM flags     FFI.setJITSymbol jitSymbol (FFI.TargetAddress (fromIntegral addr)) flags' -instance (MonadIO m, MonadAnyCont IO m) => DecodeM m JITSymbol (Ptr FFI.JITSymbol) where+instance (MonadIO m, MonadAnyCont IO m) => DecodeM m (Either JITSymbolError JITSymbol) (Ptr FFI.JITSymbol) where   decodeM jitSymbol = do     errMsg <- alloca     FFI.TargetAddress addr <- liftIO $ FFI.getAddress jitSymbol errMsg-    -- TODO read error message and throw exception-    flags <- liftIO $ decodeM =<< FFI.getFlags jitSymbol-    return (JITSymbol (fromIntegral addr) flags)+    rawFlags <- liftIO (FFI.getFlags jitSymbol)+    if addr == 0 || (rawFlags .&. FFI.jitSymbolFlagsHasError /= 0)+      then do+        errMsg <- decodeM =<< liftIO (FFI.getErrorMsg jitSymbol)+        pure (Left (JITSymbolError errMsg))+      else do+        flags <- decodeM rawFlags+        pure (Right (JITSymbol (fromIntegral addr) flags))  instance MonadIO m =>   EncodeM m SymbolResolver (IORef [IO ()] -> IO (Ptr FFI.LambdaResolver)) where

@@ -43,7 +43,7 @@ -- | @'findSymbol' layer symbol exportedSymbolsOnly@ searches for -- @symbol@ in all modules added to @layer@. If @exportedSymbolsOnly@ -- is 'True' only exported symbols are searched.-findSymbol :: CompileLayer l => l -> MangledSymbol -> Bool -> IO JITSymbol+findSymbol :: CompileLayer l => l -> MangledSymbol -> Bool -> IO (Either JITSymbolError JITSymbol) findSymbol compileLayer symbol exportedSymbolsOnly = flip runAnyContT return $ do   symbol' <- encodeM symbol   exportedSymbolsOnly' <- encodeM exportedSymbolsOnly@@ -54,7 +54,7 @@ -- | @'findSymbolIn' layer handle symbol exportedSymbolsOnly@ searches for -- @symbol@ in the context of the module represented by @handle@. If -- @exportedSymbolsOnly@ is 'True' only exported symbols are searched.-findSymbolIn :: CompileLayer l => l -> FFI.ModuleHandle -> MangledSymbol -> Bool -> IO JITSymbol+findSymbolIn :: CompileLayer l => l -> FFI.ModuleHandle -> MangledSymbol -> Bool -> IO (Either JITSymbolError JITSymbol) findSymbolIn compileLayer handle symbol exportedSymbolsOnly = flip runAnyContT return $ do   symbol' <- encodeM symbol   exportedSymbolsOnly' <- encodeM exportedSymbolsOnly

@@ -11,7 +11,9 @@ import LLVM.Internal.OrcJIT import LLVM.Internal.Coding import LLVM.Internal.ObjectFile+import qualified LLVM.Internal.FFI.ShortByteString as SBS import qualified LLVM.Internal.FFI.PtrHierarchy as FFI+import qualified LLVM.Internal.FFI.OrcJIT as FFI import qualified LLVM.Internal.FFI.OrcJIT.LinkingLayer as FFI  -- | After a 'CompileLayer' has compiled the modules to object code,@@ -62,3 +64,27 @@ -- | 'bracket'-style wrapper around 'newObjectLinkingLayer' and 'disposeLinkingLayer'. withObjectLinkingLayer :: (ObjectLinkingLayer -> IO a) -> IO a withObjectLinkingLayer = bracket newObjectLinkingLayer disposeLinkingLayer++-- | @'findSymbol' layer symbol exportedSymbolsOnly@ searches for+-- @symbol@ in all modules added to @layer@. If @exportedSymbolsOnly@+-- is 'True' only exported symbols are searched.+findSymbol :: LinkingLayer l => l -> ShortByteString -> Bool -> IO (Either JITSymbolError JITSymbol)+findSymbol linkingLayer symbol exportedSymbolsOnly =+  SBS.useAsCString symbol $ \symbol' ->+    flip runAnyContT return $ do+      exportedSymbolsOnly' <- encodeM exportedSymbolsOnly+      symbol <- anyContToM $ bracket+        (FFI.findSymbol (getLinkingLayer linkingLayer) symbol' exportedSymbolsOnly') FFI.disposeSymbol+      decodeM symbol++-- | @'findSymbolIn' layer handle symbol exportedSymbolsOnly@ searches for+-- @symbol@ in the context of the module represented by @handle@. If+-- @exportedSymbolsOnly@ is 'True' only exported symbols are searched.+findSymbolIn :: LinkingLayer l => l -> FFI.ObjectHandle -> ShortByteString -> Bool -> IO (Either JITSymbolError JITSymbol)+findSymbolIn linkingLayer handle symbol exportedSymbolsOnly =+  SBS.useAsCString symbol $ \symbol' ->+    flip runAnyContT return $ do+      exportedSymbolsOnly' <- encodeM exportedSymbolsOnly+      symbol <- anyContToM $ bracket+        (FFI.findSymbolIn (getLinkingLayer linkingLayer) handle symbol' exportedSymbolsOnly') FFI.disposeSymbol+      decodeM symbol

@@ -7,10 +7,10 @@     removeModule,     withModule,     -- ** Search for symbols-    findSymbol,-    findSymbolIn,     JITSymbol(..),+    JITSymbolError(..),     JITSymbolFlags(..),+    defaultJITSymbolFlags,     SymbolResolver(..),     -- ** Symbol mangling     MangledSymbol,

@@ -0,0 +1,12 @@+module LLVM.OrcJIT.CompileLayer+  ( CompileLayer(..)+  , mangleSymbol+  , findSymbol+  , findSymbolIn+  , addModule+  , removeModule+  , withModule+  , disposeCompileLayer+  ) where++import LLVM.Internal.OrcJIT.CompileLayer

@@ -0,0 +1,12 @@+module LLVM.OrcJIT.LinkingLayer+  ( LinkingLayer(..)+  , disposeLinkingLayer+  , ObjectLinkingLayer(..)+  , newObjectLinkingLayer+  , withObjectLinkingLayer+  , addObjectFile+  , findSymbol+  , findSymbolIn+  ) where++import LLVM.Internal.OrcJIT.LinkingLayer

@@ -624,11 +624,12 @@         mStr = "; ModuleID = '<string>'\n\                \source_filename = \"<string>\"\n\                \\n\-               \@0 = constant i32 42\n\+               \@fortytwo = constant i32 42\n\                \\n\-               \define i32 @1() {\n\-               \  %1 = load i32, i32* @0, align 1\n\-               \  ret i32 %1\n\+               \define i32 @0() {\n\+               \  %1 = getelementptr inbounds i32, i32* @fortytwo, i32 0\n\+               \  %2 = load i32, i32* %1, align 1\n\+               \  ret i32 %2\n\                \}\n"     s <- withContext $ \context -> withModuleFromAST context mAST moduleLLVMAssembly     s @?= mStr,

@@ -19,6 +19,7 @@ import Foreign.Ptr import Text.Show.Pretty (pPrint) +import qualified LLVM.AST.IntegerPredicate as IP import LLVM.AST as A hiding (GlobalVariable, PointerType) import LLVM.AST.Operand hiding (Module) import qualified LLVM.AST.Operand as O@@ -44,6 +45,7 @@   , namedMetadata   , nullMetadata   , cyclicMetadata+  , metadataConstantFolding   , globalObjectMetadata   , roundtripDIBasicType   , roundtripDIDerivedType@@ -780,6 +782,46 @@               \!0 = !{void ()* @foo}\n"       strCheck ast s    ]++metadataConstantFolding = testGroup "constant folding" [+    testCase "metadata on instructions that can be constant folded" $+      let ast = Module "<string>" "<string>" Nothing Nothing+            [ GlobalDefinition functionDefaults+                { name = "f"+                , parameters = ([Parameter i32 "x" []] , False)+                , returnType = i32+                , basicBlocks =+                    [ BasicBlock "if"+                        [UnName 0 := ICmp IP.EQ (ConstantOperand (C.Int 32 0)) (ConstantOperand (C.Int 32 0))+                           [("foobar", MDRef (MetadataNodeID 0))]+                        ]+                        (Do (CondBr (LocalReference i1 (UnName 0)) "if.true" "if.false" []))+                    , BasicBlock "if.true" []+                        (Do (Ret (Just (ConstantOperand (C.Int 32 0))) []))+                    , BasicBlock "if.false" []+                        (Do (Ret (Just (ConstantOperand (C.Int 32 0))) []))+                    ]+                }+            , MetadataNodeDefinition (MetadataNodeID 0) (MDTuple [])+            ]+          s = "; ModuleID = '<string>'\n\+              \source_filename = \"<string>\"\n\+              \\n\+              \define i32 @f(i32 %x) {\n\+              \if:\n\+              \  %0 = icmp eq i32 0, 0, !foobar !0\n\+              \  br i1 %0, label %if.true, label %if.false\n\+              \\n\+              \if.true:                                          ; preds = %if\n\+              \  ret i32 0\n\+              \\n\+              \if.false:                                         ; preds = %if\n\+              \  ret i32 0\n\+              \}\n\+              \\n\+              \!0 = !{}\n"+      in strCheck ast s+    ]  globalObjectMetadata = testGroup "Metadata on GlobalObject" $   [ testCase "metadata on functions" $ do

@@ -12,14 +12,19 @@ import Data.IORef import Data.Word import Foreign.Ptr+import System.Process (callProcess)+import System.IO.Temp (withSystemTempFile)+import System.IO  import LLVM.Internal.PassManager+import LLVM.Internal.ObjectFile (withObjectFile) import qualified LLVM.Internal.FFI.PassManager as FFI import LLVM.Context import LLVM.Module import qualified LLVM.Internal.FFI.Module as FFI import LLVM.OrcJIT-import LLVM.Internal.OrcJIT.CompileLayer+import qualified LLVM.Internal.OrcJIT.CompileLayer as CL+import qualified LLVM.Internal.OrcJIT.LinkingLayer as LL import LLVM.Target  testModule :: ByteString@@ -45,16 +50,16 @@ foreign import ccall "dynamic"   mkMain :: FunPtr (IO Word32) -> IO Word32 -nullResolver :: MangledSymbol -> IO JITSymbol-nullResolver s = putStrLn "nullresolver" >> return (JITSymbol 0 (JITSymbolFlags False False))+nullResolver :: MangledSymbol -> IO (Either JITSymbolError JITSymbol)+nullResolver s = putStrLn "nullresolver" >> return (Left (JITSymbolError "unknown symbol")) -resolver :: CompileLayer l => MangledSymbol -> l -> MangledSymbol -> IO JITSymbol+resolver :: CompileLayer l => MangledSymbol -> l -> MangledSymbol -> IO (Either JITSymbolError JITSymbol) resolver testFunc compileLayer symbol   | symbol == testFunc = do       funPtr <- wrapTestFunc myTestFuncImpl       let addr = ptrToWordPtr (castFunPtrToPtr funPtr)-      return (JITSymbol addr (JITSymbolFlags False True))-  | otherwise = findSymbol compileLayer symbol True+      return (Right (JITSymbol addr defaultJITSymbolFlags))+  | otherwise = CL.findSymbol compileLayer symbol True  moduleTransform :: IORef Bool -> Ptr FFI.Module -> IO (Ptr FFI.Module) moduleTransform passmanagerSuccessful modulePtr = do@@ -78,12 +83,15 @@                 (SymbolResolver (resolver testFunc compileLayer) nullResolver) $                 \moduleHandle -> do                   mainSymbol <- mangleSymbol compileLayer "main"-                  JITSymbol mainFn _ <- findSymbol compileLayer mainSymbol True+                  Right (JITSymbol mainFn _) <- CL.findSymbol compileLayer mainSymbol True                   result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))                   result @?= 42-                  JITSymbol mainFn _ <- findSymbolIn compileLayer moduleHandle mainSymbol True+                  Right (JITSymbol mainFn _) <- CL.findSymbolIn compileLayer moduleHandle mainSymbol True                   result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))-                  result @?= 42,+                  result @?= 42+                  unknownSymbol <- mangleSymbol compileLayer "unknownSymbol"+                  unknownSymbolRes <- CL.findSymbol compileLayer unknownSymbol True+                  unknownSymbolRes @?= Left (JITSymbolError mempty),      testCase "IRTransformLayer" $ do       passmanagerSuccessful <- newIORef False@@ -99,7 +107,7 @@                   (SymbolResolver (resolver testFunc compileLayer) nullResolver) $                   \moduleHandle -> do                     mainSymbol <- mangleSymbol compileLayer "main"-                    JITSymbol mainFn _ <- findSymbol compileLayer mainSymbol True+                    Right (JITSymbol mainFn _) <- CL.findSymbol compileLayer mainSymbol True                     result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))                     result @?= 42                     readIORef passmanagerSuccessful @? "passmanager failed",@@ -120,7 +128,24 @@                       (SymbolResolver (resolver testFunc compileLayer) nullResolver) $                       \moduleHandle -> do                         mainSymbol <- mangleSymbol compileLayer "main"-                        JITSymbol mainFn _ <- findSymbol compileLayer mainSymbol True+                        Right (JITSymbol mainFn _) <- CL.findSymbol compileLayer mainSymbol True                         result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))-                        result @?= 42-  ]+                        result @?= 42,++    testCase "finding symbols in linking layer" $ do+      withObjectLinkingLayer $ \linkingLayer -> do+        let inputPath = "./test/main_return_38.c"+        withSystemTempFile "main.o" $ \outputPath _ -> do+          callProcess "gcc" ["-c", inputPath, "-o", outputPath]+          withObjectFile outputPath $ \objFile -> do+            let resl = SymbolResolver nullResolver nullResolver+            objectHandle <- addObjectFile linkingLayer objFile resl+            -- Find main symbol by looking into global linking context+            Right (JITSymbol mainFn _) <- LL.findSymbol linkingLayer "main" True+            result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))+            result @?= 38+            -- Find main symbol by specificly using object handle for given object file+            Right (JITSymbol mainFn _) <- LL.findSymbolIn linkingLayer objectHandle "main" True+            result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn))+            result @?= 38+    ]

@@ -0,0 +1,3 @@+int main() {+  return 38;+}