From 46adc22ffecc6b9a2b361a69b47c74c3ddb17eeb Mon Sep 17 00:00:00 2001 From: Moritz Kiefer Date: Sun, 17 Nov 2019 18:35:34 +0100 Subject: [PATCH 01/37] First bindings for OrcJIT V2 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit There is still a lot of stuff missing but given that the existing API is going to go away in the next major LLVM release, I’m going to merge this in the current state so we have at least something after that. --- llvm-hs/llvm-hs.cabal | 3 + .../Internal/FFI/OrcJIT/IRCompileLayer.hs | 2 +- llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp | 4 +- llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs | 39 +++++++++ llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp | 70 ++++++++++++++++ llvm-hs/src/LLVM/Internal/OrcJITV2.hs | 80 +++++++++++++++++++ llvm-hs/test/LLVM/Test/OrcJIT.hs | 29 ++++++- 7 files changed, 223 insertions(+), 4 deletions(-) create mode 100644 llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs create mode 100644 llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp create mode 100644 llvm-hs/src/LLVM/Internal/OrcJITV2.hs diff --git a/llvm-hs/llvm-hs.cabal b/llvm-hs/llvm-hs.cabal index 7df71168..d3fd9918 100644 --- a/llvm-hs/llvm-hs.cabal +++ b/llvm-hs/llvm-hs.cabal @@ -129,6 +129,7 @@ library LLVM.Internal.Module LLVM.Internal.ObjectFile LLVM.Internal.OrcJIT + LLVM.Internal.OrcJITV2 LLVM.Internal.OrcJIT.CompileLayer LLVM.Internal.OrcJIT.LinkingLayer LLVM.Internal.OrcJIT.CompileOnDemandLayer @@ -173,6 +174,7 @@ library LLVM.Internal.FFI.Module LLVM.Internal.FFI.ObjectFile LLVM.Internal.FFI.OrcJIT + LLVM.Internal.FFI.OrcJITV2 LLVM.Internal.FFI.OrcJIT.CompileLayer LLVM.Internal.FFI.OrcJIT.LinkingLayer LLVM.Internal.FFI.OrcJIT.CompileOnDemandLayer @@ -228,6 +230,7 @@ library src/LLVM/Internal/FFI/MetadataC.cpp src/LLVM/Internal/FFI/ModuleC.cpp src/LLVM/Internal/FFI/OrcJITC.cpp + src/LLVM/Internal/FFI/OrcJITV2C.cpp src/LLVM/Internal/FFI/RawOStreamC.cpp src/LLVM/Internal/FFI/PassManagerC.cpp src/LLVM/Internal/FFI/RTDyldMemoryManager.cpp diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRCompileLayer.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRCompileLayer.hs index e4811fcd..78cdf04c 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRCompileLayer.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRCompileLayer.hs @@ -13,5 +13,5 @@ import Foreign.Ptr data IRCompileLayer instance ChildOf CompileLayer IRCompileLayer -foreign import ccall safe "LLVM_Hs_createIRCompileLayer" createIRCompileLayer :: +foreign import ccall safe "LLVM_Hs_createLegacyIRCompileLayer" createIRCompileLayer :: Ptr LinkingLayer -> Ptr TargetMachine -> IO (Ptr IRCompileLayer) diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp index 5a79e165..d60cbf4e 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp @@ -178,8 +178,8 @@ void LLVM_Hs_releaseVModule(ExecutionSession *es, VModuleKey k) { /* Constructor functions for the different compile layers */ -CompileLayer *LLVM_Hs_createIRCompileLayer(LinkingLayer *linkingLayer, - LLVMTargetMachineRef tm) { +CompileLayer *LLVM_Hs_createLegacyIRCompileLayer(LinkingLayer *linkingLayer, + LLVMTargetMachineRef tm) { TargetMachine *tmm = unwrap(tm); return new CompileLayerT>( LegacyIRCompileLayer(*linkingLayer, diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs new file mode 100644 index 00000000..21cc00dd --- /dev/null +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs @@ -0,0 +1,39 @@ +module LLVM.Internal.FFI.OrcJITV2 where + +import LLVM.Prelude + +import LLVM.Internal.FFI.DataLayout (DataLayout) +import LLVM.Internal.FFI.Module (Module) +import LLVM.Internal.FFI.OrcJIT (ExecutionSession) +import LLVM.Internal.FFI.Target (TargetMachine) + +import Foreign.Ptr +import Foreign.C + +data ThreadSafeContext +data ObjectLayer +data IRLayer + +foreign import ccall safe "LLVM_Hs_createThreadSafeContext" createThreadSafeContext :: + IO (Ptr ThreadSafeContext) + +foreign import ccall safe "LLVM_Hs_disposeThreadSafeContext" disposeThreadSafeContext :: + Ptr ThreadSafeContext -> IO () + +foreign import ccall safe "LLVM_Hs_createRTDyldObjectLinkingLayer" createRTDyldObjectLinkingLayer :: + Ptr ExecutionSession -> IO (Ptr ObjectLayer) + +foreign import ccall safe "LLVM_Hs_disposeObjectLayer" disposeObjectLayer :: + Ptr ObjectLayer -> IO () + +foreign import ccall safe "LLVM_Hs_createIRCompileLayer" createIRCompileLayer :: + Ptr ExecutionSession -> Ptr ObjectLayer -> Ptr TargetMachine -> IO (Ptr IRLayer) + +foreign import ccall safe "LLVM_Hs_disposeIRLayer" disposeIRLayer :: + Ptr IRLayer -> IO () + +foreign import ccall safe "LLVM_Hs_IRLayer_add" irLayerAdd :: + Ptr ThreadSafeContext -> Ptr ExecutionSession -> Ptr DataLayout -> Ptr IRLayer -> Ptr Module -> IO () + +foreign import ccall safe "LLVM_Hs_ExecutionSession_lookup" esLookup :: + Ptr ExecutionSession -> CString -> IO Word64 diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp new file mode 100644 index 00000000..a1397e2b --- /dev/null +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp @@ -0,0 +1,70 @@ +#include + +#include +#include +#include +#include +#include +#include + +#include "LLVM/Internal/FFI/Target.hpp" + +using namespace llvm; +using namespace orc; + +extern "C" { + +// Thread-safe context + +ThreadSafeContext* LLVM_Hs_createThreadSafeContext() { + return new ThreadSafeContext(llvm::make_unique()); +} + +void LLVM_Hs_disposeThreadSafeContext(ThreadSafeContext* ctx) { + delete ctx; +} + +// Object layer + +ObjectLayer* LLVM_Hs_createRTDyldObjectLinkingLayer(ExecutionSession* es) { + return new RTDyldObjectLinkingLayer(*es, []() { return llvm::make_unique(); }); +} + +void LLVM_Hs_disposeObjectLayer(ObjectLayer* ol) { + delete ol; +} + +// Compile layer + +IRLayer* LLVM_Hs_createIRCompileLayer(ExecutionSession* es, ObjectLayer* baseLayer, LLVMTargetMachineRef tm) { + return new IRCompileLayer(*es, *baseLayer, SimpleCompiler(*unwrap(tm))); +} + +void LLVM_Hs_disposeIRLayer(IRLayer* il) { + delete il; +} + +// Warning: This consumes the module. +void LLVM_Hs_IRLayer_add(ThreadSafeContext* ctx, ExecutionSession* es, LLVMTargetDataRef dataLayout, IRLayer* il, LLVMModuleRef m) { + std::unique_ptr mod{unwrap(m)}; + if (mod->getDataLayout().isDefault()) { + mod->setDataLayout(*unwrap(dataLayout)); + } + if (Error err = il->add(es->getMainJITDylib(), ThreadSafeModule(std::move(mod), *ctx))) { + llvm::errs() << err << "\n"; + exit(1); + } +} + +uint64_t LLVM_Hs_ExecutionSession_lookup(ExecutionSession* es, const char* mangledName) { + if (auto symbolOrErr = es->lookup({&es->getMainJITDylib()}, mangledName)) { + auto& symbol = *symbolOrErr; + return symbol.getAddress(); + } else { + Error err = symbolOrErr.takeError(); + llvm::errs() << err << "\n"; + exit(1); + } +} + +} diff --git a/llvm-hs/src/LLVM/Internal/OrcJITV2.hs b/llvm-hs/src/LLVM/Internal/OrcJITV2.hs new file mode 100644 index 00000000..e40aefec --- /dev/null +++ b/llvm-hs/src/LLVM/Internal/OrcJITV2.hs @@ -0,0 +1,80 @@ +module LLVM.Internal.OrcJITV2 + ( ExecutionSession + , withExecutionSession + , esLookup + , ThreadSafeContext + , withThreadSafeContext + , ObjectLayer + , withRTDyldObjectLinkingLayer + , IRLayer + , withIRCompileLayer + , irLayerAdd + ) where + +import LLVM.Prelude + +import Control.Exception +import Foreign.C +import Foreign.Ptr + +import LLVM.Internal.Module (Module, readModule, deleteModule) +import LLVM.Internal.OrcJIT (ExecutionSession(..), withExecutionSession) +import LLVM.Internal.Target (TargetMachine(..)) + +import qualified LLVM.Internal.FFI.DataLayout as FFI +import qualified LLVM.Internal.FFI.OrcJITV2 as FFI +import qualified LLVM.Internal.FFI.Target as FFI + +newtype ThreadSafeContext = ThreadSafeContext (Ptr FFI.ThreadSafeContext) +data IRLayer = IRLayer + { _getIRLayer :: Ptr FFI.IRLayer + , _getDataLayout :: Ptr FFI.DataLayout + } +newtype ObjectLayer = ObjectLayer (Ptr FFI.ObjectLayer) + +esLookup :: ExecutionSession -> String -> IO Word64 +esLookup (ExecutionSession es) s = withCString s $ \cStr -> + FFI.esLookup es cStr + +createThreadSafeContext :: IO ThreadSafeContext +createThreadSafeContext = ThreadSafeContext <$> FFI.createThreadSafeContext + +disposeThreadSafeContext :: ThreadSafeContext -> IO () +disposeThreadSafeContext (ThreadSafeContext ctx) = FFI.disposeThreadSafeContext ctx + +withThreadSafeContext :: (ThreadSafeContext -> IO a) -> IO a +withThreadSafeContext = bracket createThreadSafeContext disposeThreadSafeContext + +createRTDyldObjectLinkingLayer :: ExecutionSession -> IO ObjectLayer +createRTDyldObjectLinkingLayer (ExecutionSession es) = + ObjectLayer <$> FFI.createRTDyldObjectLinkingLayer es + +disposeObjectLayer :: ObjectLayer -> IO () +disposeObjectLayer (ObjectLayer ol) = FFI.disposeObjectLayer ol + +withRTDyldObjectLinkingLayer :: ExecutionSession -> (ObjectLayer -> IO a) -> IO a +withRTDyldObjectLinkingLayer es = + bracket + (createRTDyldObjectLinkingLayer es) + disposeObjectLayer + +createIRCompileLayer :: ExecutionSession -> ObjectLayer -> TargetMachine -> IO IRLayer +createIRCompileLayer (ExecutionSession es) (ObjectLayer ol) (TargetMachine tm) = do + dl <- FFI.createTargetDataLayout tm + il <- FFI.createIRCompileLayer es ol tm + pure $ IRLayer il dl + +disposeIRLayer :: IRLayer -> IO () +disposeIRLayer (IRLayer il _) = FFI.disposeIRLayer il + +withIRCompileLayer :: ExecutionSession -> ObjectLayer -> TargetMachine -> (IRLayer -> IO a) -> IO a +withIRCompileLayer es ol tm = + bracket + (createIRCompileLayer es ol tm) + disposeIRLayer + +irLayerAdd :: ThreadSafeContext -> ExecutionSession -> IRLayer -> Module -> IO () +irLayerAdd (ThreadSafeContext ctx) (ExecutionSession es) (IRLayer il dl) m = do + mPtr <- readModule m + deleteModule m + FFI.irLayerAdd ctx es dl il mPtr diff --git a/llvm-hs/test/LLVM/Test/OrcJIT.hs b/llvm-hs/test/LLVM/Test/OrcJIT.hs index 0d9f5fba..b880705b 100644 --- a/llvm-hs/test/LLVM/Test/OrcJIT.hs +++ b/llvm-hs/test/LLVM/Test/OrcJIT.hs @@ -23,6 +23,7 @@ import qualified LLVM.Internal.FFI.PassManager as FFI import LLVM.Context import LLVM.Module import qualified LLVM.Internal.FFI.Module as FFI +import qualified LLVM.Internal.OrcJITV2 as OrcV2 import LLVM.OrcJIT import qualified LLVM.Internal.OrcJIT.CompileLayer as CL import qualified LLVM.Internal.OrcJIT.LinkingLayer as LL @@ -42,9 +43,21 @@ testModule = \ ret i32 %3\n\ \}\n" +test2Module :: ByteString +test2Module = + "; ModuleID = ''\n\ + \source_filename = \"\"\n\ + \\n\ + \define i32 @main() {\n\ + \ ret i32 42\n\ + \}\n" + withTestModule :: (Module -> IO a) -> IO a withTestModule f = withContext $ \context -> withModuleFromLLVMAssembly' context testModule f +withTest2Module :: (Module -> IO a) -> IO a +withTest2Module f = withContext $ \context -> withModuleFromLLVMAssembly' context test2Module f + myTestFuncImpl :: IO Word32 myTestFuncImpl = return 42 @@ -159,5 +172,19 @@ tests = -- Find main symbol by specificly using object handle for given object file Right (JITSymbol mainFn _) <- LL.findSymbolIn linkingLayer k "main" True result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) - result @?= 38 + result @?= 38, + + testCase "OrcV2" $ do + withTest2Module $ \mod -> + withHostTargetMachine Reloc.PIC CodeModel.Default CodeGenOpt.Default $ \tm -> + OrcV2.withExecutionSession $ \es -> + OrcV2.withThreadSafeContext $ \ctx -> + OrcV2.withRTDyldObjectLinkingLayer es $ \ol -> + OrcV2.withIRCompileLayer es ol tm $ \il -> do + dl <- getTargetMachineDataLayout tm + OrcV2.irLayerAdd ctx es il mod + addr <- OrcV2.esLookup es "main" + let mainFn = mkMain (castPtrToFunPtr $ wordPtrToPtr $ fromIntegral addr) + result <- mainFn + result @?= 42 ] From d9ec608c18e658248604cbf0a15f7c1cad60e3ad Mon Sep 17 00:00:00 2001 From: Dan Zheng Date: Fri, 22 Jan 2021 10:16:36 -0500 Subject: [PATCH 02/37] [WIP] Upgrade llvm-hs to LLVM 12. Update llvm-hs from LLVM 9 to LLVM 12. List of changes: - Attributes - Various minor changes, not listed in detail. - Debug information - DIFlag: BlockByrefStruct and ArgumentNotModified removed. - DISubrange - New arguments: upperBound and stride. - Arguments {lowerBound,upperBound,stride} are generalized and may be DIVariable or DIExpression in addition to Constant Int64. - DIModule - New arguments: apiNotesFile and lineNo. - Removed arguments: isysroot. - Instructions - New instructions: freeze. - Modified instructions - shufflevector: now takes mask as [Int32] instead of Constant. - JIT - Some deprecated OrcJIT v1 APIs are now removed: VModuleKey, SymbolResolver. - Start updating APIs and tests using OrcJIT v2 APIs. Work-in-progress. - Target - Target option flag changes, not listed in detail. - Transforms - Some existing transforms were removed or merged into others. Some had options modified. - Newly added APIs - Added Triple (target triple) API to llvm-hs-pure, along with string conversion and parsing. - Added debugging utilities: dumpMetadata. - Tests - Textual LLVM IR changes - Function parameters are now printed with local identifiers (e.g. `%0`). - Instruction alignment arguments must now be explicit: 0 no longer seems like a valid default value. - Instrumentation tests - Update MemorySanitizer test to run only on supported platforms: matching the implementation at https://github.com/llvm/llvm-project/blob/release/12.x/llvm/lib/Transforms/Instrumentation/MemorySanitizer.cpp. - Optimization tests - Add a more robust "is module vectorized?" check for the SLPVectorization test. Current status: all tests pass via `stack test`. Todos: - Relevant comments to resolve: `{FIXME,TODO,NOTE}(llvm-12)` - Lots of code cleanup and API design finalization for OrcJIT v2. - Update installation instructions for llvm-hs@llvm-12. - Fix CI for llvm-hs@llvm-12. - Vote for using GitHub Actions instead of Travis CI. Co-authored-by: Adam Paszke --- .travis.yml | 18 +- llvm-hs-pure/llvm-hs-pure.cabal | 5 +- .../src/LLVM/AST/FunctionAttribute.hs | 60 +-- llvm-hs-pure/src/LLVM/AST/Instruction.hs | 19 +- llvm-hs-pure/src/LLVM/AST/Operand.hs | 21 +- .../src/LLVM/AST/ParameterAttribute.hs | 26 +- llvm-hs-pure/src/LLVM/DataLayout.hs | 2 +- .../src/LLVM/IRBuilder/Instruction.hs | 7 +- llvm-hs-pure/src/LLVM/IRBuilder/Module.hs | 3 - llvm-hs-pure/src/LLVM/IRBuilder/Monad.hs | 3 - llvm-hs-pure/src/LLVM/Triple.hs | 380 ++++++++++++++++++ llvm-hs-pure/test/LLVM/Test/IRBuilder.hs | 2 +- llvm-hs/Setup.hs | 2 +- llvm-hs/llvm-hs.cabal | 6 +- llvm-hs/src/LLVM/Internal/Attribute.hs | 166 ++++---- llvm-hs/src/LLVM/Internal/Coding.hs | 4 +- llvm-hs/src/LLVM/Internal/DecodeAST.hs | 1 - llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 138 ++++--- llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp | 4 +- llvm-hs/src/LLVM/Internal/FFI/BitcodeC.cpp | 2 +- llvm-hs/src/LLVM/Internal/FFI/Builder.hs | 5 +- llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp | 15 +- llvm-hs/src/LLVM/Internal/FFI/Instruction.hs | 16 +- .../src/LLVM/Internal/FFI/InstructionC.cpp | 32 +- llvm-hs/src/LLVM/Internal/FFI/LLVMCTypes.hsc | 3 +- llvm-hs/src/LLVM/Internal/FFI/Metadata.h | 2 +- llvm-hs/src/LLVM/Internal/FFI/Metadata.hs | 41 +- llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp | 93 +++-- llvm-hs/src/LLVM/Internal/FFI/Module.hs | 3 + llvm-hs/src/LLVM/Internal/FFI/ModuleC.cpp | 4 + llvm-hs/src/LLVM/Internal/FFI/OrcJIT.h | 2 +- llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs | 36 ++ .../LLVM/Internal/FFI/OrcJIT/CompileLayer.hs | 6 + llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp | 91 ++++- llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs | 37 +- llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp | 116 +++++- .../src/LLVM/Internal/FFI/PassManagerC.cpp | 50 ++- llvm-hs/src/LLVM/Internal/FFI/Target.h | 20 +- llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp | 24 +- llvm-hs/src/LLVM/Internal/FFI/Transforms.hs | 1 - llvm-hs/src/LLVM/Internal/Instruction.hs | 33 +- llvm-hs/src/LLVM/Internal/Operand.hs | 129 ++++-- llvm-hs/src/LLVM/Internal/OrcJIT.hs | 13 + .../src/LLVM/Internal/OrcJIT/CompileLayer.hs | 9 + .../LLVM/Internal/OrcJIT/IRCompileLayer.hs | 2 + llvm-hs/src/LLVM/Internal/OrcJITV2.hs | 112 +++++- llvm-hs/src/LLVM/Internal/Target.hs | 7 - llvm-hs/src/LLVM/OrcJIT.hs | 41 +- llvm-hs/src/LLVM/OrcJIT/CompileLayer.hs | 9 +- llvm-hs/src/LLVM/Target/Options.hs | 2 - llvm-hs/src/LLVM/Transforms.hs | 14 +- llvm-hs/test/LLVM/Test/FunctionAttribute.hs | 60 +-- llvm-hs/test/LLVM/Test/Instructions.hs | 27 +- llvm-hs/test/LLVM/Test/Instrumentation.hs | 56 ++- llvm-hs/test/LLVM/Test/Metadata.hs | 18 +- llvm-hs/test/LLVM/Test/Module.hs | 3 +- llvm-hs/test/LLVM/Test/Optimization.hs | 123 +++--- llvm-hs/test/LLVM/Test/OrcJIT.hs | 34 +- llvm-hs/test/LLVM/Test/ParameterAttribute.hs | 2 +- llvm-hs/test/LLVM/Test/Target.hs | 2 - llvm-hs/test/debug_metadata_5.ll | 8 +- 61 files changed, 1577 insertions(+), 593 deletions(-) create mode 100644 llvm-hs-pure/src/LLVM/Triple.hs diff --git a/.travis.yml b/.travis.yml index 85065dbb..d751b20a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,8 +5,8 @@ cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store - - $HOME/llvm-build-9.0.1 - - $HOME/llvm-src-9.0.1 + - $HOME/llvm-build-$LLVM_VER + - $HOME/llvm-src-$LLVM_VER before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log @@ -20,7 +20,7 @@ before_cache: env: global: - - LLVM_VER=9.0.1 + - LLVM_VER=12.0.0 matrix: include: @@ -50,13 +50,15 @@ before_install: - export PATH=$HOME/bin:$PATH install: - - curl -L https://github.com/Kitware/CMake/releases/download/v3.15.5/cmake-3.15.5.tar.gz | tar -xzf - -C $HOME - - export PATH=$HOME/cmake-3.15.5-Linux-x86_64/bin:$PATH + - curl -L https://github.com/Kitware/CMake/releases/download/v3.19.7/cmake-3.19.7-Linux-x86_64.tar.gz | tar -xzf - -C $HOME + - export PATH=$HOME/cmake-3.19.7-Linux-x86_64/bin:$PATH - curl -L https://github.com/ninja-build/ninja/releases/download/v1.9.0/ninja-linux.zip -o ninja-linux.zip - unzip ninja-linux.zip -d $HOME/bin - - curl -L https://github.com/llvm/llvm-project/releases/download/llvmorg-${LLVM_VER}/llvm-${LLVM_VER}.src.tar.xz | tar -xJf - -C $HOME - - rsync -ac $HOME/llvm-${LLVM_VER}.src/ $HOME/llvm-src-${LLVM_VER} - - cd $HOME/llvm-src-${LLVM_VER} + - # curl -L https://github.com/llvm/llvm-project/releases/download/llvmorg-${LLVM_VER}/llvm-${LLVM_VER}.src.tar.xz | tar -xJf - -C $HOME + - # rsync -ac $HOME/llvm-${LLVM_VER}.src/ $HOME/llvm-src-${LLVM_VER} + - git clone https://github.com/llvm/llvm-project.git + - git checkout release/12.x + - cd llvm-project/llvm - mkdir -p build && cd build - cmake -DCMAKE_BUILD_TYPE=Release -DCMAKE_CXX_FLAGS_RELEASE=-O0 -DCMAKE_INSTALL_PREFIX=$HOME/llvm-build-${LLVM_VER} -DLLVM_PARALLEL_LINK_JOBS=1 -DLLVM_TARGETS_TO_BUILD=X86 -DLLVM_BUILD_LLVM_DYLIB=True -DLLVM_LINK_LLVM_DYLIB=True -GNinja .. - ninja -j3 install diff --git a/llvm-hs-pure/llvm-hs-pure.cabal b/llvm-hs-pure/llvm-hs-pure.cabal index 656632b7..d17f0ae6 100644 --- a/llvm-hs-pure/llvm-hs-pure.cabal +++ b/llvm-hs-pure/llvm-hs-pure.cabal @@ -1,5 +1,5 @@ name: llvm-hs-pure -version: 9.0.0 +version: 12.0.0 license: BSD3 license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer , Benjamin S. Scarlet @@ -22,7 +22,7 @@ extra-source-files: CHANGELOG.md source-repository head type: git location: git://github.com/llvm-hs/llvm-hs.git - branch: llvm-9 + branch: llvm-12 library default-language: Haskell2010 @@ -81,6 +81,7 @@ library LLVM.IRBuilder.Module LLVM.IRBuilder.Monad LLVM.Prelude + LLVM.Triple test-suite test default-language: Haskell2010 diff --git a/llvm-hs-pure/src/LLVM/AST/FunctionAttribute.hs b/llvm-hs-pure/src/LLVM/AST/FunctionAttribute.hs index 236a966d..b0f8463d 100644 --- a/llvm-hs-pure/src/LLVM/AST/FunctionAttribute.hs +++ b/llvm-hs-pure/src/LLVM/AST/FunctionAttribute.hs @@ -5,50 +5,52 @@ import LLVM.Prelude -- | data FunctionAttribute - = NoReturn - | NoUnwind - | ReadNone - | ReadOnly - | NoInline - | NoRecurse + = AllocSize Word32 (Maybe Word32) -- ^ AllocSize 0 (Just 0) is invalid | AlwaysInline - | MinimizeSize - | OptimizeForSize - | OptimizeNone - | StackProtect - | StackProtectReq - | StackProtectStrong - | StrictFP - | NoRedZone - | NoImplicitFloat - | Naked - | InlineHint - | StackAlignment Word64 - | ReturnsTwice - | UWTable - | NonLazyBind + | ArgMemOnly | Builtin - | NoBuiltin | Cold + | Convergent + | InaccessibleMemOnly + | InaccessibleMemOrArgMemOnly + | InlineHint | JumpTable + | MinimizeSize + | Naked + | NoBuiltin | NoDuplicate | NoFree + | NoImplicitFloat + | NoInline + | NonLazyBind + | NoRecurse + | NoRedZone + | NoReturn + | NoSync + | NoUnwind + | OptimizeForSize + | OptimizeNone + | ReadNone + | ReadOnly + | ReturnsTwice + | SafeStack | SanitizeAddress | SanitizeHWAddress - | SanitizeThread | SanitizeMemory + | SanitizeThread | Speculatable + | StackAlignment Word64 + | StackProtect + | StackProtectReq + | StackProtectStrong + | StrictFP | StringAttribute { stringAttributeKind :: ShortByteString, stringAttributeValue :: ShortByteString -- ^ Use "" for no value -- the two are conflated } - | AllocSize Word32 (Maybe Word32) -- ^ AllocSize 0 (Just 0) is invalid + | UWTable + | WillReturn | WriteOnly - | ArgMemOnly - | Convergent - | InaccessibleMemOnly - | InaccessibleMemOrArgMemOnly - | SafeStack deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) -- | diff --git a/llvm-hs-pure/src/LLVM/AST/Instruction.hs b/llvm-hs-pure/src/LLVM/AST/Instruction.hs index 382b869f..420ccc46 100644 --- a/llvm-hs-pure/src/LLVM/AST/Instruction.hs +++ b/llvm-hs-pure/src/LLVM/AST/Instruction.hs @@ -382,6 +382,17 @@ data Instruction incomingValues :: [ (Operand, Name) ], metadata :: InstructionMetadata } + | Freeze { + operand0 :: Operand, + type' :: Type, + metadata :: InstructionMetadata + } + | Select { + condition' :: Operand, + trueValue :: Operand, + falseValue :: Operand, + metadata :: InstructionMetadata + } | Call { tailCallKind :: Maybe TailCallKind, callingConvention :: CallingConvention, @@ -391,12 +402,6 @@ data Instruction functionAttributes :: [Either FA.GroupID FA.FunctionAttribute], metadata :: InstructionMetadata } - | Select { - condition' :: Operand, - trueValue :: Operand, - falseValue :: Operand, - metadata :: InstructionMetadata - } | VAArg { argList :: Operand, type' :: Type, @@ -416,7 +421,7 @@ data Instruction | ShuffleVector { operand0 :: Operand, operand1 :: Operand, - mask :: Constant, + mask :: [Int32], metadata :: InstructionMetadata } | ExtractValue { diff --git a/llvm-hs-pure/src/LLVM/AST/Operand.hs b/llvm-hs-pure/src/LLVM/AST/Operand.hs index 47d366fd..e7904acb 100644 --- a/llvm-hs-pure/src/LLVM/AST/Operand.hs +++ b/llvm-hs-pure/src/LLVM/AST/Operand.hs @@ -131,7 +131,7 @@ data DIFlag = Accessibility DIAccessibility | FwdDecl | AppleBlock - | BlockByrefStruct + | ReservedBit4 -- Used to be BlockByRef, can be reused for anything except DICompositeType. | VirtualFlag | Artificial | Explicit @@ -146,7 +146,6 @@ data DIFlag | IntroducedVirtual | BitField | NoReturn - | ArgumentNotModified | TypePassByValue | TypePassByReference | EnumClass @@ -218,15 +217,24 @@ data DIEnumerator = deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) -- | -data DISubrange = - Subrange { count :: DICount, lowerBound :: Int64 } - deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) +data DISubrange = Subrange + { count :: DICount + , lowerBound :: Maybe DIBound + , upperBound :: Maybe DIBound + , stride :: Maybe DIBound + } deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) data DICount = DICountConstant Int64 | DICountVariable (MDRef DIVariable) deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) +data DIBound + = DIBoundConstant Int64 + | DIBoundVariable (MDRef DIVariable) + | DIBoundExpression (MDRef DIExpression) + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + -- | data DIScope = DICompileUnit DICompileUnit @@ -242,7 +250,8 @@ data DIModule = Module , name :: ShortByteString , configurationMacros :: ShortByteString , includePath :: ShortByteString - , isysRoot :: ShortByteString + , apiNotesFile :: ShortByteString + , lineNo :: Word32 } deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) data DINamespace = Namespace diff --git a/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs b/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs index f134b3fe..a05873ce 100644 --- a/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs +++ b/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs @@ -5,29 +5,29 @@ import LLVM.Prelude -- | data ParameterAttribute - = ZeroExt - | SignExt + = Alignment Word64 + | ByVal + | Dereferenceable Word64 + | DereferenceableOrNull Word64 + | ImmArg + | InAlloca | InReg - | SRet - | Alignment Word64 + | Nest | NoAlias - | ByVal | NoCapture | NoFree - | Nest + | NonNull | ReadNone | ReadOnly - | WriteOnly - | ImmArg - | InAlloca - | NonNull - | Dereferenceable Word64 - | DereferenceableOrNull Word64 | Returned - | SwiftSelf + | SignExt + | SRet | SwiftError + | SwiftSelf + | WriteOnly | StringAttribute { stringAttributeKind :: ShortByteString, stringAttributeValue :: ShortByteString -- ^ Use "" for no value -- the two are conflated } + | ZeroExt deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) diff --git a/llvm-hs-pure/src/LLVM/DataLayout.hs b/llvm-hs-pure/src/LLVM/DataLayout.hs index 5b552f29..6c487bab 100644 --- a/llvm-hs-pure/src/LLVM/DataLayout.hs +++ b/llvm-hs-pure/src/LLVM/DataLayout.hs @@ -123,5 +123,5 @@ parseDataLayout defaultEndianness str = ] in case parseOnly (parseSpec `sepBy` (char '-')) str of - Left _ -> throwE $ "ill formed data layout: " ++ show str + Left _ -> throwE $ "ill-formed data layout: " ++ show str Right fs -> pure . Just $ foldr ($) (defaultDataLayout defaultEndianness) fs diff --git a/llvm-hs-pure/src/LLVM/IRBuilder/Instruction.hs b/llvm-hs-pure/src/LLVM/IRBuilder/Instruction.hs index a74f8b1a..6c28a6c5 100644 --- a/llvm-hs-pure/src/LLVM/IRBuilder/Instruction.hs +++ b/llvm-hs-pure/src/LLVM/IRBuilder/Instruction.hs @@ -8,6 +8,7 @@ import Control.Monad.State (gets) import qualified Data.Map.Lazy as Map import Data.Word import Data.Char (ord) +import GHC.Int import GHC.Stack import LLVM.AST hiding (args, dests) @@ -210,11 +211,11 @@ insertElement :: MonadIRBuilder m => Operand -> Operand -> Operand -> m Operand insertElement v e i = emitInstr (typeOf v) $ InsertElement v e i [] -- | See . -shuffleVector :: (MonadIRBuilder m, HasCallStack) => Operand -> Operand -> C.Constant -> m Operand +shuffleVector :: (MonadIRBuilder m, HasCallStack) => Operand -> Operand -> [Int32] -> m Operand shuffleVector a b m = emitInstr retType $ ShuffleVector a b m [] where retType = - case (typeOf a, typeOf m) of - (VectorType _ elemTyp, VectorType maskLength _) -> VectorType maskLength elemTyp + case typeOf a of + VectorType _ elemTyp -> VectorType (fromIntegral (length m)) elemTyp _ -> error "shuffleVector: Expected two vectors and a vector mask" diff --git a/llvm-hs-pure/src/LLVM/IRBuilder/Module.hs b/llvm-hs-pure/src/LLVM/IRBuilder/Module.hs index 4264bc3b..073e9110 100644 --- a/llvm-hs-pure/src/LLVM/IRBuilder/Module.hs +++ b/llvm-hs-pure/src/LLVM/IRBuilder/Module.hs @@ -16,7 +16,6 @@ import Prelude hiding (and, or) import Control.Applicative import Control.Monad.Cont import Control.Monad.Except -import Control.Monad.Fail import qualified Control.Monad.Fail as Fail import Control.Monad.Identity import Control.Monad.Writer.Lazy as Lazy @@ -26,7 +25,6 @@ import Control.Monad.RWS.Lazy as Lazy import Control.Monad.RWS.Strict as Strict import qualified Control.Monad.State.Strict as Strict import Control.Monad.State.Lazy -import Control.Monad.List import Control.Monad.Trans.Maybe #if !(MIN_VERSION_mtl(2,2,2)) import Control.Monad.Trans.Identity @@ -234,7 +232,6 @@ instance MonadState s m => MonadState s (ModuleBuilderT m) where instance MonadModuleBuilder m => MonadModuleBuilder (ContT r m) instance MonadModuleBuilder m => MonadModuleBuilder (ExceptT e m) instance MonadModuleBuilder m => MonadModuleBuilder (IdentityT m) -instance MonadModuleBuilder m => MonadModuleBuilder (ListT m) instance MonadModuleBuilder m => MonadModuleBuilder (MaybeT m) instance MonadModuleBuilder m => MonadModuleBuilder (ReaderT r m) instance (MonadModuleBuilder m, Monoid w) => MonadModuleBuilder (Strict.RWST r w s m) diff --git a/llvm-hs-pure/src/LLVM/IRBuilder/Monad.hs b/llvm-hs-pure/src/LLVM/IRBuilder/Monad.hs index d29f307f..d5a03a6b 100644 --- a/llvm-hs-pure/src/LLVM/IRBuilder/Monad.hs +++ b/llvm-hs-pure/src/LLVM/IRBuilder/Monad.hs @@ -13,7 +13,6 @@ import LLVM.Prelude import Control.Monad.Cont import Control.Monad.Except -import Control.Monad.Fail import qualified Control.Monad.Fail as Fail import Control.Monad.Identity import qualified Control.Monad.Writer.Lazy as Lazy @@ -24,7 +23,6 @@ import qualified Control.Monad.RWS.Lazy as Lazy import qualified Control.Monad.RWS.Strict as Strict import qualified Control.Monad.State.Lazy as Lazy import Control.Monad.State.Strict -import Control.Monad.List import Control.Monad.Trans.Maybe #if !(MIN_VERSION_mtl(2,2,2)) import Control.Monad.Trans.Identity @@ -286,7 +284,6 @@ instance MonadState s m => MonadState s (IRBuilderT m) where instance MonadIRBuilder m => MonadIRBuilder (ContT r m) instance MonadIRBuilder m => MonadIRBuilder (ExceptT e m) instance MonadIRBuilder m => MonadIRBuilder (IdentityT m) -instance MonadIRBuilder m => MonadIRBuilder (ListT m) instance MonadIRBuilder m => MonadIRBuilder (MaybeT m) instance MonadIRBuilder m => MonadIRBuilder (ReaderT r m) instance (MonadIRBuilder m, Monoid w) => MonadIRBuilder (Strict.RWST r w s m) diff --git a/llvm-hs-pure/src/LLVM/Triple.hs b/llvm-hs-pure/src/LLVM/Triple.hs new file mode 100644 index 00000000..e1aa50ed --- /dev/null +++ b/llvm-hs-pure/src/LLVM/Triple.hs @@ -0,0 +1,380 @@ +{-# LANGUAGE RecordWildCards #-} + +-- | A 'Triple' represents a target triple, which is a target host description. +-- | Target triples consistent of a few components: architecture, vendor, +-- | operating system, and environment. +-- | + +module LLVM.Triple ( + Triple (..), Architecture (..), Vendor (..), OS (..), unknownTriple, parseTriple, tripleToString + ) where + +import LLVM.Prelude +import Control.Monad.Trans.Except +import Data.Attoparsec.ByteString +import Data.Attoparsec.ByteString.Char8 +import Data.ByteString.Char8 as ByteString hiding (map, foldr) +import Data.ByteString.Short hiding (pack) + +import Data.Map (Map, (!)) +import qualified Data.Map as Map + +data Architecture + = UnknownArch + | Arm -- ARM (little endian): arm armv.* xscale + | Armeb -- ARM (big endian): armeb + | Aarch64 -- AArch64 (little endian): aarch64 + | Aarch64_be -- AArch64 (big endian): aarch64_be + | Aarch64_32 -- AArch64 (little endian) ILP32: aarch64_32 + | Arc -- ARC: Synopsys ARC + | Avr -- AVR: Atmel AVR microcontroller + | Bpfel -- eBPF or extended BPF or 64-bit BPF (little endian) + | Bpfeb -- eBPF or extended BPF or 64-bit BPF (big endian) + | Csky -- CSKY: csky + | Hexagon -- Hexagon: hexagon + | Mips -- MIPS: mips mipsallegrex mipsr6 + | Mipsel -- MIPSEL: mipsel mipsallegrexe mipsr6el + | Mips64 -- MIPS64: mips64 mips64r6 mipsn32 mipsn32r6 + | Mips64el -- MIPS64EL: mips64el mips64r6el mipsn32el mipsn32r6el + | Msp430 -- MSP430: msp430 + | Ppc -- PPC: powerpc + | Ppcle -- PPCLE: powerpc (little endian) + | Ppc64 -- PPC64: powerpc64 ppu + | Ppc64le -- PPC64LE: powerpc64le + | R600 -- R600: AMD GPUs HD2XXX - HD6XXX + | Amdgcn -- AMDGCN: AMD GCN GPUs + | Riscv32 -- RISC-V (32-bit): riscv32 + | Riscv64 -- RISC-V (64-bit): riscv64 + | Sparc -- Sparc: sparc + | Sparcv9 -- Sparcv9: Sparcv9 + | Sparcel -- Sparc: (endianness = little). NB: 'Sparcle' is a CPU variant + | Systemz -- SystemZ: s390x + | Tce -- TCE (http://tce.cs.tut.fi/): tce + | Tcele -- TCE little endian (http://tce.cs.tut.fi/): tcele + | Thumb -- Thumb (little endian): thumb thumbv.* + | Thumbeb -- Thumb (big endian): thumbeb + | X86 -- X86: i[3-9]86 + | X86_64 -- X86-64: amd64 x86_64 + | Xcore -- XCore: xcore + | Nvptx -- NVPTX: 32-bit + | Nvptx64 -- NVPTX: 64-bit + | Le32 -- le32: generic little-endian 32-bit CPU (PNaCl) + | Le64 -- le64: generic little-endian 64-bit CPU (PNaCl) + | Amdil -- AMDIL + | Amdil64 -- AMDIL with 64-bit pointers + | Hsail -- AMD HSAIL + | Hsail64 -- AMD HSAIL with 64-bit pointers + | Spir -- SPIR: standard portable IR for OpenCL 32-bit version + | Spir64 -- SPIR: standard portable IR for OpenCL 64-bit version + | Kalimba -- Kalimba: generic kalimba + | Shave -- SHAVE: Movidius vector VLIW processors + | Lanai -- Lanai: Lanai 32-bit + | Wasm32 -- WebAssembly with 32-bit pointers + | Wasm64 -- WebAssembly with 64-bit pointers + | Renderscript32 -- 32-bit RenderScript + | Renderscript64 -- 64-bit RenderScript + | Ve -- NEC SX-Aurora Vector Engine + deriving (Eq, Ord, Show) + +-- NOTE: SubArchitecture is not currently used. +data SubArchitecture + = NoSubArch + | ARMSubArch_v8_7a + | ARMSubArch_v8_6a + | ARMSubArch_v8_5a + | ARMSubArch_v8_4a + | ARMSubArch_v8_3a + | ARMSubArch_v8_2a + | ARMSubArch_v8_1a + | ARMSubArch_v8 + | ARMSubArch_v8r + | ARMSubArch_v8m_baseline + | ARMSubArch_v8m_mainline + | ARMSubArch_v8_1m_mainline + | ARMSubArch_v7 + | ARMSubArch_v7em + | ARMSubArch_v7m + | ARMSubArch_v7s + | ARMSubArch_v7k + | ARMSubArch_v7ve + | ARMSubArch_v6 + | ARMSubArch_v6m + | ARMSubArch_v6k + | ARMSubArch_v6t2 + | ARMSubArch_v5 + | ARMSubArch_v5te + | ARMSubArch_v4t + | AArch64SubArch_arm64e + | KalimbaSubArch_v3 + | KalimbaSubArch_v4 + | KalimbaSubArch_v5 + | MipsSubArch_r6 + | PPCSubArch_spe + deriving (Eq, Ord, Show) + +data Vendor + = UnknownVendor + | Apple + | PC + | SCEI + | Freescale + | IBM + | ImaginationTechnologies + | MipsTechnologies + | NVIDIA + | CSR + | Myriad + | AMD + | Mesa + | SUSE + | OpenEmbedded + deriving (Eq, Ord, Show) + +data OS + = UnknownOS + | Ananas + | CloudABI + | Darwin + | DragonFly + | FreeBSD + | Fuchsia + | IOS + | KFreeBSD + | Linux + | Lv2 -- PS3 + | MacOSX + | NetBSD + | OpenBSD + | Solaris + | Win32 + | ZOS + | Haiku + | Minix + | RTEMS + | NaCl -- Native Client + | AIX + | CUDA -- NVIDIA CUDA + | NVCL -- NVIDIA OpenCL + | AMDHSA -- AMD HSA Runtime + | PS4 + | ELFIAMCU + | TvOS -- Apple tvOS + | WatchOS -- Apple watchOS + | Mesa3D + | Contiki + | AMDPAL -- AMD PAL Runtime + | HermitCore -- HermitCore Unikernel/Multikernel + | Hurd -- GNU/Hurd + | WASI -- Experimental WebAssembly OS + | Emscripten + deriving (Eq, Ord, Show) + +data Environment + = UnknownEnvironment + | GNU + | GNUABIN32 + | GNUABI64 + | GNUEABI + | GNUEABIHF + | GNUX32 + | GNUILP32 + | CODE16 + | EABI + | EABIHF + | Android + | Musl + | MuslEABI + | MuslEABIHF + | MSVC + | Itanium + | Cygnus + | CoreCLR + | Simulator -- Simulator variants of other systems e.g. Apple's iOS + | MacABI -- Mac Catalyst variant of Apple's iOS deployment target. + deriving (Eq, Ord, Show) + +data ObjectFormat + = UnknownObjectFormat + | COFF + | ELF + | GOFF + | MachO + | Wasm + | XCOFF + deriving (Eq, Ord, Show) + +data Triple = Triple { + architecture :: Architecture, + subarchitecture :: SubArchitecture, + os :: OS, + vendor :: Vendor, + environment :: Environment, + objectFormat :: ObjectFormat + } deriving (Eq, Ord, Show) + +unknownTriple :: Triple +unknownTriple = Triple { + architecture = UnknownArch, + subarchitecture = NoSubArch, + vendor = UnknownVendor, + os = UnknownOS, + environment = UnknownEnvironment, + objectFormat = UnknownObjectFormat + } + +invertBijection :: (Ord k, Ord v) => Map k v -> Map v k +invertBijection = Map.foldrWithKey (flip Map.insert) Map.empty + +architectureFromStringMap :: Map String Architecture +architectureFromStringMap = Map.fromList [ + ("unknown", UnknownArch), + ("arm", Arm), + ("armeb", Armeb), + ("aarch64", Aarch64), + ("aarch64_be", Aarch64_be), + ("aarch64_32", Aarch64_32), + ("arc", Arc), + ("avr", Avr), + ("bpfel", Bpfel), + ("bpfeb", Bpfeb), + ("csky", Csky), + ("hexagon", Hexagon), + ("mips", Mips), + ("mipsel", Mipsel), + ("mips64", Mips64), + ("mips64el", Mips64el), + ("msp430", Msp430), + ("ppc", Ppc), + ("ppcle", Ppcle), + ("ppc64", Ppc64), + ("ppc64le", Ppc64le), + ("r600", R600), + ("amdgcn", Amdgcn), + ("riscv32", Riscv32), + ("riscv64", Riscv64), + ("sparc", Sparc), + ("sparcv9", Sparcv9), + ("sparcel", Sparcel), + ("systemz", Systemz), + ("tce", Tce), + ("tcele", Tcele), + ("thumb", Thumb), + ("thumbeb", Thumbeb), + ("x86", X86), + ("x86_64", X86_64), + ("xcore", Xcore), + ("nvptx", Nvptx), + ("nvptx64", Nvptx64), + ("le32", Le32), + ("le64", Le64), + ("amdil", Amdil), + ("amdil64", Amdil64), + ("hsail", Hsail), + ("hsail64", Hsail64), + ("spir", Spir), + ("spir64", Spir64), + ("kalimba", Kalimba), + ("shave", Shave), + ("lanai", Lanai), + ("wasm32", Wasm32), + ("wasm64", Wasm64), + ("renderscript32", Renderscript32), + ("renderscript64", Renderscript64), + ("ve", Ve) + ] + +architectureToStringMap :: Map Architecture String +architectureToStringMap = invertBijection architectureFromStringMap + +vendorFromStringMap :: Map String Vendor +vendorFromStringMap = Map.fromList [ + ("apple" , Apple ), + ("pc" , PC ), + ("scei" , SCEI ), + ("freescale" , Freescale ), + ("ibm" , IBM ), + ("imaginationtechnologies", ImaginationTechnologies), + ("mipstechnologies" , MipsTechnologies ), + ("nvidia" , NVIDIA ), + ("csr" , CSR ), + ("myriad" , Myriad ), + ("amd" , AMD ), + ("mesa" , Mesa ), + ("suse" , SUSE ), + ("openembedded" , OpenEmbedded ) + ] + +vendorToStringMap :: Map Vendor String +vendorToStringMap = invertBijection vendorFromStringMap + +osFromStringMap :: Map String OS +osFromStringMap = Map.fromList [ + ("ananas" , Ananas ), + ("cloudabi" , CloudABI ), + ("darwin" , Darwin ), + ("dragonfly" , DragonFly ), + ("freebsd" , FreeBSD ), + ("fuchsia" , Fuchsia ), + ("ios" , IOS ), + ("kfreebsd" , KFreeBSD ), + ("linux" , Linux ), + ("lv2" , Lv2 ), + ("macosx" , MacOSX ), + ("netbsd" , NetBSD ), + ("openbsd" , OpenBSD ), + ("solaris" , Solaris ), + ("win32" , Win32 ), + ("zos" , ZOS ), + ("haiku" , Haiku ), + ("minix" , Minix ), + ("rtems" , RTEMS ), + ("nacl" , NaCl ), + ("aix" , AIX ), + ("cuda" , CUDA ), + ("nvcl" , NVCL ), + ("amdhsa" , AMDHSA ), + ("ps4" , PS4 ), + ("elfiamcu" , ELFIAMCU ), + ("tvos" , TvOS ), + ("watchos" , WatchOS ), + ("mesa3d" , Mesa3D ), + ("contiki" , Contiki ), + ("amdpal" , AMDPAL ), + ("hermitcore", HermitCore), + ("hurd" , Hurd ), + ("wasi" , WASI ), + ("emscripten", Emscripten) + ] + +osToStringMap :: Map OS String +osToStringMap = invertBijection osFromStringMap + +tripleToString :: Triple -> ShortByteString +tripleToString Triple {..} = + toShort $ ByteString.intercalate (pack "-") [ + pack (architectureToStringMap ! architecture), + pack (vendorToStringMap ! vendor), + pack (osToStringMap ! os) + ] + +parseTriple :: ShortByteString -> Except String Triple +parseTriple triple = do + let + tripleStr = fromShort triple + parseSpec :: Parser (Triple -> Triple) + parseSpec = choice [ + do + arch <- choice [string (pack s) $> a | (s, a) <- Map.toList architectureFromStringMap] + pure $ \t -> t { architecture = arch }, + do + vendor <- choice [string (pack s) $> v | (s, v) <- Map.toList vendorFromStringMap] + pure $ \t -> t { vendor = vendor }, + do + os <- choice [string (pack s) $> o | (s, o) <- Map.toList osFromStringMap] + pure $ \t -> t { os = os } + ] + in + case parseOnly (parseSpec `sepBy` char '-') tripleStr of + Left _ -> throwE $ "ill-formed triple: " ++ show tripleStr + Right fs -> pure $ foldr ($) unknownTriple fs + diff --git a/llvm-hs-pure/test/LLVM/Test/IRBuilder.hs b/llvm-hs-pure/test/LLVM/Test/IRBuilder.hs index 818e7be5..86b83fd8 100644 --- a/llvm-hs-pure/test/LLVM/Test/IRBuilder.hs +++ b/llvm-hs-pure/test/LLVM/Test/IRBuilder.hs @@ -52,7 +52,7 @@ tests = } , testCase "calls constant globals" callWorksWithConstantGlobals , testCase "supports recursive function calls" recursiveFunctionCalls - , testCase "resolves typefes" resolvesTypeDefs + , testCase "resolves typedefs" resolvesTypeDefs , testCase "builds the example" $ do let f10 = ConstantOperand (C.Float (F.Double 10)) fadd a b = FAdd { operand0 = a, operand1 = b, fastMathFlags = noFastMathFlags, metadata = [] } diff --git a/llvm-hs/Setup.hs b/llvm-hs/Setup.hs index 921b39d0..729cdd75 100644 --- a/llvm-hs/Setup.hs +++ b/llvm-hs/Setup.hs @@ -41,7 +41,7 @@ lookupFlagAssignment = lookup #endif llvmVersion :: Version -llvmVersion = mkVersion [9,0] +llvmVersion = mkVersion [12,0] -- Ordered by decreasing specificty so we will prefer llvm-config-9.0 -- over llvm-config-9 over llvm-config. diff --git a/llvm-hs/llvm-hs.cabal b/llvm-hs/llvm-hs.cabal index d3fd9918..5fb43d49 100644 --- a/llvm-hs/llvm-hs.cabal +++ b/llvm-hs/llvm-hs.cabal @@ -1,5 +1,5 @@ name: llvm-hs -version: 9.0.1 +version: 12.0.0 license: BSD3 license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer , Benjamin S. Scarlet @@ -48,7 +48,7 @@ extra-source-files: CHANGELOG.md source-repository head type: git location: git://github.com/llvm-hs/llvm-hs.git - branch: llvm-9 + branch: llvm-12 flag shared-llvm description: link against llvm shared rather than static library @@ -79,7 +79,7 @@ library template-haskell >= 2.5.0.0, containers >= 0.4.2.1, array >= 0.4.0.0, - llvm-hs-pure == 9.0.* + llvm-hs-pure == 12.0.* hs-source-dirs: src default-extensions: NoImplicitPrelude diff --git a/llvm-hs/src/LLVM/Internal/Attribute.hs b/llvm-hs/src/LLVM/Internal/Attribute.hs index 54d60270..34cec3ae 100644 --- a/llvm-hs/src/LLVM/Internal/Attribute.hs +++ b/llvm-hs/src/LLVM/Internal/Attribute.hs @@ -45,24 +45,24 @@ instance Monad m => EncodeM m A.PA.ParameterAttribute (Ptr FFI.ParameterAttrBuil A.PA.Dereferenceable v -> FFI.attrBuilderAddDereferenceable b v A.PA.DereferenceableOrNull v -> FFI.attrBuilderAddDereferenceableOrNull b v _ -> FFI.attrBuilderAddParameterAttributeKind b $ case a of - A.PA.ZeroExt -> FFI.parameterAttributeKindZExt - A.PA.SignExt -> FFI.parameterAttributeKindSExt + A.PA.ByVal -> FFI.parameterAttributeKindByVal + A.PA.ImmArg -> FFI.parameterAttributeKindImmArg + A.PA.InAlloca -> FFI.parameterAttributeKindInAlloca A.PA.InReg -> FFI.parameterAttributeKindInReg - A.PA.SRet -> FFI.parameterAttributeKindStructRet + A.PA.Nest -> FFI.parameterAttributeKindNest A.PA.NoAlias -> FFI.parameterAttributeKindNoAlias - A.PA.ByVal -> FFI.parameterAttributeKindByVal A.PA.NoCapture -> FFI.parameterAttributeKindNoCapture A.PA.NoFree -> FFI.parameterAttributeKindNoFree - A.PA.Nest -> FFI.parameterAttributeKindNest - A.PA.ReadOnly -> FFI.parameterAttributeKindReadOnly - A.PA.ReadNone -> FFI.parameterAttributeKindReadNone - A.PA.ImmArg -> FFI.parameterAttributeKindImmArg - A.PA.InAlloca -> FFI.parameterAttributeKindInAlloca A.PA.NonNull -> FFI.parameterAttributeKindNonNull + A.PA.ReadNone -> FFI.parameterAttributeKindReadNone + A.PA.ReadOnly -> FFI.parameterAttributeKindReadOnly A.PA.Returned -> FFI.parameterAttributeKindReturned - A.PA.SwiftSelf -> FFI.parameterAttributeKindSwiftSelf + A.PA.SignExt -> FFI.parameterAttributeKindSExt + A.PA.SRet -> FFI.parameterAttributeKindStructRet A.PA.SwiftError -> FFI.parameterAttributeKindSwiftError + A.PA.SwiftSelf -> FFI.parameterAttributeKindSwiftSelf A.PA.WriteOnly -> FFI.parameterAttributeKindWriteOnly + A.PA.ZeroExt -> FFI.parameterAttributeKindZExt A.PA.Alignment _ -> inconsistentCases "ParameterAttribute" a A.PA.Dereferenceable _ -> inconsistentCases "ParameterAttribute" a A.PA.DereferenceableOrNull _ -> inconsistentCases "ParameterAttribute" a @@ -74,52 +74,54 @@ instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilde (valueP, valueLen) <- encodeM value liftIO $ FFI.attrBuilderAddStringAttribute b kindP kindLen valueP valueLen encodeM a = return $ \b -> case a of - A.FA.StackAlignment v -> liftIO $ FFI.attrBuilderAddStackAlignment b v A.FA.AllocSize x y -> do x' <- encodeM x y' <- encodeM y liftIO $ FFI.attrBuilderAddAllocSize b x' y' + A.FA.StackAlignment v -> liftIO $ FFI.attrBuilderAddStackAlignment b v _ -> liftIO $ FFI.attrBuilderAddFunctionAttributeKind b $ case a of + A.FA.AlwaysInline -> FFI.functionAttributeKindAlwaysInline + A.FA.ArgMemOnly -> FFI.functionAttributeKindArgMemOnly + A.FA.Builtin -> FFI.functionAttributeKindBuiltin + A.FA.Cold -> FFI.functionAttributeKindCold A.FA.Convergent -> FFI.functionAttributeKindConvergent A.FA.InaccessibleMemOnly -> FFI.functionAttributeKindInaccessibleMemOnly A.FA.InaccessibleMemOrArgMemOnly -> FFI.functionAttributeKindInaccessibleMemOrArgMemOnly - A.FA.NoReturn -> FFI.functionAttributeKindNoReturn - A.FA.NoUnwind -> FFI.functionAttributeKindNoUnwind - A.FA.ReadNone -> FFI.functionAttributeKindReadNone - A.FA.ReadOnly -> FFI.functionAttributeKindReadOnly - A.FA.NoInline -> FFI.functionAttributeKindNoInline - A.FA.NoRecurse -> FFI.functionAttributeKindNoRecurse - A.FA.AlwaysInline -> FFI.functionAttributeKindAlwaysInline + A.FA.InlineHint -> FFI.functionAttributeKindInlineHint + A.FA.JumpTable -> FFI.functionAttributeKindJumpTable A.FA.MinimizeSize -> FFI.functionAttributeKindMinSize - A.FA.OptimizeForSize -> FFI.functionAttributeKindOptimizeForSize - A.FA.OptimizeNone -> FFI.functionAttributeKindOptimizeNone - A.FA.WriteOnly -> FFI.functionAttributeKindWriteOnly - A.FA.ArgMemOnly -> FFI.functionAttributeKindArgMemOnly - A.FA.StackProtect -> FFI.functionAttributeKindStackProtect - A.FA.StackProtectReq -> FFI.functionAttributeKindStackProtectReq - A.FA.StackProtectStrong -> FFI.functionAttributeKindStackProtectStrong - A.FA.StrictFP -> FFI.functionAttributeKindStrictFP - A.FA.NoRedZone -> FFI.functionAttributeKindNoRedZone - A.FA.NoImplicitFloat -> FFI.functionAttributeKindNoImplicitFloat A.FA.Naked -> FFI.functionAttributeKindNaked - A.FA.InlineHint -> FFI.functionAttributeKindInlineHint - A.FA.ReturnsTwice -> FFI.functionAttributeKindReturnsTwice - A.FA.UWTable -> FFI.functionAttributeKindUWTable - A.FA.NonLazyBind -> FFI.functionAttributeKindNonLazyBind - A.FA.Builtin -> FFI.functionAttributeKindBuiltin A.FA.NoBuiltin -> FFI.functionAttributeKindNoBuiltin - A.FA.Cold -> FFI.functionAttributeKindCold - A.FA.JumpTable -> FFI.functionAttributeKindJumpTable A.FA.NoDuplicate -> FFI.functionAttributeKindNoDuplicate A.FA.NoFree -> FFI.functionAttributeKindNoFree + A.FA.NoImplicitFloat -> FFI.functionAttributeKindNoImplicitFloat + A.FA.NoInline -> FFI.functionAttributeKindNoInline + A.FA.NonLazyBind -> FFI.functionAttributeKindNonLazyBind + A.FA.NoRecurse -> FFI.functionAttributeKindNoRecurse + A.FA.NoRedZone -> FFI.functionAttributeKindNoRedZone + A.FA.NoReturn -> FFI.functionAttributeKindNoReturn + A.FA.NoSync -> FFI.functionAttributeKindNoSync + A.FA.NoUnwind -> FFI.functionAttributeKindNoUnwind + A.FA.OptimizeForSize -> FFI.functionAttributeKindOptimizeForSize + A.FA.OptimizeNone -> FFI.functionAttributeKindOptimizeNone + A.FA.ReadNone -> FFI.functionAttributeKindReadNone + A.FA.ReadOnly -> FFI.functionAttributeKindReadOnly + A.FA.ReturnsTwice -> FFI.functionAttributeKindReturnsTwice + A.FA.SafeStack -> FFI.functionAttributeKindSafeStack A.FA.SanitizeAddress -> FFI.functionAttributeKindSanitizeAddress A.FA.SanitizeHWAddress -> FFI.functionAttributeKindSanitizeHWAddress - A.FA.SanitizeThread -> FFI.functionAttributeKindSanitizeThread A.FA.SanitizeMemory -> FFI.functionAttributeKindSanitizeMemory - A.FA.SafeStack -> FFI.functionAttributeKindSafeStack + A.FA.SanitizeThread -> FFI.functionAttributeKindSanitizeThread A.FA.Speculatable -> FFI.functionAttributeKindSpeculatable - A.FA.StackAlignment _ -> inconsistentCases "FunctionAttribute" a + A.FA.StackProtect -> FFI.functionAttributeKindStackProtect + A.FA.StackProtectReq -> FFI.functionAttributeKindStackProtectReq + A.FA.StackProtectStrong -> FFI.functionAttributeKindStackProtectStrong + A.FA.StrictFP -> FFI.functionAttributeKindStrictFP + A.FA.UWTable -> FFI.functionAttributeKindUWTable + A.FA.WillReturn -> FFI.functionAttributeKindWillReturn + A.FA.WriteOnly -> FFI.functionAttributeKindWriteOnly A.FA.AllocSize _ _ -> inconsistentCases "FunctionAttribute" a + A.FA.StackAlignment _ -> inconsistentCases "FunctionAttribute" a A.FA.StringAttribute _ _ -> inconsistentCases "FunctionAttribute" a instance DecodeM DecodeAST A.PA.ParameterAttribute FFI.ParameterAttribute where @@ -133,27 +135,27 @@ instance DecodeM DecodeAST A.PA.ParameterAttribute FFI.ParameterAttribute where else do enum <- liftIO $ FFI.parameterAttributeKindAsEnum a case enum of - [parameterAttributeKindP|ZExt|] -> return A.PA.ZeroExt - [parameterAttributeKindP|SExt|] -> return A.PA.SignExt - [parameterAttributeKindP|InReg|] -> return A.PA.InReg - [parameterAttributeKindP|StructRet|] -> return A.PA.SRet [parameterAttributeKindP|Alignment|] -> return A.PA.Alignment `ap` (liftIO $ FFI.attributeValueAsInt a) - [parameterAttributeKindP|NoAlias|] -> return A.PA.NoAlias [parameterAttributeKindP|ByVal|] -> return A.PA.ByVal + [parameterAttributeKindP|DereferenceableOrNull|] -> return A.PA.DereferenceableOrNull `ap` (liftIO $ FFI.attributeValueAsInt a) + [parameterAttributeKindP|Dereferenceable|] -> return A.PA.Dereferenceable `ap` (liftIO $ FFI.attributeValueAsInt a) + [parameterAttributeKindP|ImmArg|] -> return A.PA.ImmArg + [parameterAttributeKindP|InAlloca|] -> return A.PA.InAlloca + [parameterAttributeKindP|InReg|] -> return A.PA.InReg + [parameterAttributeKindP|Nest|] -> return A.PA.Nest + [parameterAttributeKindP|NoAlias|] -> return A.PA.NoAlias [parameterAttributeKindP|NoCapture|] -> return A.PA.NoCapture [parameterAttributeKindP|NoFree|] -> return A.PA.NoFree - [parameterAttributeKindP|Nest|] -> return A.PA.Nest - [parameterAttributeKindP|ReadOnly|] -> return A.PA.ReadOnly - [parameterAttributeKindP|ReadNone|] -> return A.PA.ReadNone - [parameterAttributeKindP|WriteOnly|] -> return A.PA.WriteOnly - [parameterAttributeKindP|InAlloca|] -> return A.PA.InAlloca [parameterAttributeKindP|NonNull|] -> return A.PA.NonNull - [parameterAttributeKindP|Dereferenceable|] -> return A.PA.Dereferenceable `ap` (liftIO $ FFI.attributeValueAsInt a) - [parameterAttributeKindP|DereferenceableOrNull|] -> return A.PA.DereferenceableOrNull `ap` (liftIO $ FFI.attributeValueAsInt a) + [parameterAttributeKindP|ReadNone|] -> return A.PA.ReadNone + [parameterAttributeKindP|ReadOnly|] -> return A.PA.ReadOnly [parameterAttributeKindP|Returned|] -> return A.PA.Returned - [parameterAttributeKindP|SwiftSelf|] -> return A.PA.SwiftSelf + [parameterAttributeKindP|SExt|] -> return A.PA.SignExt + [parameterAttributeKindP|StructRet|] -> return A.PA.SRet [parameterAttributeKindP|SwiftError|] -> return A.PA.SwiftError - [parameterAttributeKindP|ImmArg|] -> return A.PA.ImmArg + [parameterAttributeKindP|SwiftSelf|] -> return A.PA.SwiftSelf + [parameterAttributeKindP|WriteOnly|] -> return A.PA.WriteOnly + [parameterAttributeKindP|ZExt|] -> return A.PA.ZeroExt _ -> error $ "unhandled parameter attribute enum value: " ++ show enum instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where @@ -172,45 +174,47 @@ instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where y <- decodeOptional (FFI.attributeGetAllocSizeArgs a x) x' <- decodeM =<< peek x return (A.FA.AllocSize x' y) - [functionAttributeKindP|NoReturn|] -> return A.FA.NoReturn - [functionAttributeKindP|NoUnwind|] -> return A.FA.NoUnwind - [functionAttributeKindP|ReadNone|] -> return A.FA.ReadNone - [functionAttributeKindP|ReadOnly|] -> return A.FA.ReadOnly - [functionAttributeKindP|NoInline|] -> return A.FA.NoInline - [functionAttributeKindP|NoRecurse|] -> return A.FA.NoRecurse [functionAttributeKindP|AlwaysInline|] -> return A.FA.AlwaysInline - [functionAttributeKindP|MinSize|] -> return A.FA.MinimizeSize - [functionAttributeKindP|OptimizeForSize|] -> return A.FA.OptimizeForSize - [functionAttributeKindP|OptimizeNone|] -> return A.FA.OptimizeNone - [functionAttributeKindP|StackProtect|] -> return A.FA.StackProtect - [functionAttributeKindP|StackProtectReq|] -> return A.FA.StackProtectReq - [functionAttributeKindP|StackProtectStrong|] -> return A.FA.StackProtectStrong - [functionAttributeKindP|StrictFP|] -> return A.FA.StrictFP - [functionAttributeKindP|NoRedZone|] -> return A.FA.NoRedZone - [functionAttributeKindP|NoImplicitFloat|] -> return A.FA.NoImplicitFloat - [functionAttributeKindP|Naked|] -> return A.FA.Naked - [functionAttributeKindP|InlineHint|] -> return A.FA.InlineHint - [functionAttributeKindP|StackAlignment|] -> return A.FA.StackAlignment `ap` (liftIO $ FFI.attributeValueAsInt a) - [functionAttributeKindP|ReturnsTwice|] -> return A.FA.ReturnsTwice - [functionAttributeKindP|UWTable|] -> return A.FA.UWTable - [functionAttributeKindP|NonLazyBind|] -> return A.FA.NonLazyBind + [functionAttributeKindP|ArgMemOnly|] -> return A.FA.ArgMemOnly [functionAttributeKindP|Builtin|] -> return A.FA.Builtin - [functionAttributeKindP|NoBuiltin|] -> return A.FA.NoBuiltin [functionAttributeKindP|Cold|] -> return A.FA.Cold + [functionAttributeKindP|Convergent|] -> return A.FA.Convergent + [functionAttributeKindP|InaccessibleMemOnly|] -> return A.FA.InaccessibleMemOnly + [functionAttributeKindP|InaccessibleMemOrArgMemOnly|] -> return A.FA.InaccessibleMemOrArgMemOnly + [functionAttributeKindP|InlineHint|] -> return A.FA.InlineHint [functionAttributeKindP|JumpTable|] -> return A.FA.JumpTable + [functionAttributeKindP|MinSize|] -> return A.FA.MinimizeSize + [functionAttributeKindP|Naked|] -> return A.FA.Naked + [functionAttributeKindP|NoBuiltin|] -> return A.FA.NoBuiltin [functionAttributeKindP|NoDuplicate|] -> return A.FA.NoDuplicate [functionAttributeKindP|NoFree|] -> return A.FA.NoFree + [functionAttributeKindP|NoImplicitFloat|] -> return A.FA.NoImplicitFloat + [functionAttributeKindP|NoInline|] -> return A.FA.NoInline + [functionAttributeKindP|NoRecurse|] -> return A.FA.NoRecurse + [functionAttributeKindP|NoRedZone|] -> return A.FA.NoRedZone + [functionAttributeKindP|NoReturn|] -> return A.FA.NoReturn + [functionAttributeKindP|NoSync|] -> return A.FA.NoSync + [functionAttributeKindP|NoUnwind|] -> return A.FA.NoUnwind + [functionAttributeKindP|NonLazyBind|] -> return A.FA.NonLazyBind + [functionAttributeKindP|OptimizeForSize|] -> return A.FA.OptimizeForSize + [functionAttributeKindP|OptimizeNone|] -> return A.FA.OptimizeNone + [functionAttributeKindP|ReadNone|] -> return A.FA.ReadNone + [functionAttributeKindP|ReadOnly|] -> return A.FA.ReadOnly + [functionAttributeKindP|ReturnsTwice|] -> return A.FA.ReturnsTwice + [functionAttributeKindP|SafeStack|] -> return A.FA.SafeStack [functionAttributeKindP|SanitizeAddress|] -> return A.FA.SanitizeAddress [functionAttributeKindP|SanitizeHWAddress|] -> return A.FA.SanitizeHWAddress - [functionAttributeKindP|SanitizeThread|] -> return A.FA.SanitizeThread [functionAttributeKindP|SanitizeMemory|] -> return A.FA.SanitizeMemory - [functionAttributeKindP|ArgMemOnly|] -> return A.FA.ArgMemOnly - [functionAttributeKindP|Convergent|] -> return A.FA.Convergent - [functionAttributeKindP|InaccessibleMemOnly|] -> return A.FA.InaccessibleMemOnly - [functionAttributeKindP|InaccessibleMemOrArgMemOnly|] -> return A.FA.InaccessibleMemOrArgMemOnly - [functionAttributeKindP|SafeStack|] -> return A.FA.SafeStack - [functionAttributeKindP|WriteOnly|] -> return A.FA.WriteOnly + [functionAttributeKindP|SanitizeThread|] -> return A.FA.SanitizeThread [functionAttributeKindP|Speculatable|] -> return A.FA.Speculatable + [functionAttributeKindP|StackAlignment|] -> return A.FA.StackAlignment `ap` (liftIO $ FFI.attributeValueAsInt a) + [functionAttributeKindP|StackProtectReq|] -> return A.FA.StackProtectReq + [functionAttributeKindP|StackProtectStrong|] -> return A.FA.StackProtectStrong + [functionAttributeKindP|StackProtect|] -> return A.FA.StackProtect + [functionAttributeKindP|StrictFP|] -> return A.FA.StrictFP + [functionAttributeKindP|UWTable|] -> return A.FA.UWTable + [functionAttributeKindP|WillReturn|] -> return A.FA.WillReturn + [functionAttributeKindP|WriteOnly|] -> return A.FA.WriteOnly _ -> error $ "unhandled function attribute enum value: " ++ show enum allocaAttrBuilder :: (Monad m, MonadAnyCont IO m) => m (Ptr (FFI.AttrBuilder a)) diff --git a/llvm-hs/src/LLVM/Internal/Coding.hs b/llvm-hs/src/LLVM/Internal/Coding.hs index 321e0ea9..e042bb30 100644 --- a/llvm-hs/src/LLVM/Internal/Coding.hs +++ b/llvm-hs/src/LLVM/Internal/Coding.hs @@ -35,12 +35,12 @@ genCodingInstance ht ctn chs = do let n = const Nothing [d| instance Monad m => EncodeM m $(ht) $(conT ctn) where - encodeM h = return $ $( + encodeM h = return $( caseE [| h |] [ match (dataToPatQ n h) (normalB (dataToExpQ n c)) [] | (c,h) <- chs ] ) instance Monad m => DecodeM m $(ht) $(conT ctn) where - decodeM c = return $ $( + decodeM c = return $( caseE [| c |] ([ match (dataToPatQ n c) (normalB (dataToExpQ n h)) [] | (c,h) <- chs] ++ [ match wildP (normalB [e| error ("Decoding failed: Unknown " <> show c) |]) []])) |] diff --git a/llvm-hs/src/LLVM/Internal/DecodeAST.hs b/llvm-hs/src/LLVM/Internal/DecodeAST.hs index 393fe201..29de593d 100644 --- a/llvm-hs/src/LLVM/Internal/DecodeAST.hs +++ b/llvm-hs/src/LLVM/Internal/DecodeAST.hs @@ -8,7 +8,6 @@ module LLVM.Internal.DecodeAST where import LLVM.Prelude -import Control.Monad.Fail import Control.Monad.Catch import Control.Monad.State import Control.Monad.AnyCont diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index b264a57b..4a7b1fd0 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -5,72 +5,78 @@ // The last three arguments are flags indicating if this is a // parameter attribute, function result attribute or function attribute. #define LLVM_HS_FOR_EACH_ATTRIBUTE_KIND(macro) \ - macro(None,F,F,F) \ - macro(Alignment,T,T,F) \ - macro(AllocSize,F,F,T) \ - macro(AlwaysInline,F,F,T) \ - macro(ArgMemOnly,F,F,T) \ - macro(Builtin,F,F,T) \ - macro(ByVal,T,F,F) \ - macro(Cold,F,F,T) \ - macro(Convergent,F,F,T) \ - macro(Dereferenceable,T,T,F) \ - macro(DereferenceableOrNull,T,T,F) \ - macro(ImmArg,T,F,F) \ - macro(InAlloca,T,F,F) \ - macro(InReg,T,T,F) \ - macro(InaccessibleMemOnly,F,F,T) \ - macro(InaccessibleMemOrArgMemOnly,F,F,T) \ - macro(InlineHint,F,F,T) \ - macro(JumpTable,F,F,T) \ - macro(MinSize,F,F,T) \ - macro(Naked,F,F,T) \ - macro(Nest,T,F,F) \ - macro(NoAlias,T,T,F) \ - macro(NoBuiltin,F,F,T) \ - macro(NoCapture,T,F,F) \ - macro(NoCfCheck,F,F,T) \ - macro(NoDuplicate,F,F,T) \ - macro(NoFree,T,F,T) \ - macro(NoImplicitFloat,F,F,T) \ - macro(NoInline,F,F,T) \ - macro(NoRecurse,F,F,T) \ - macro(NoRedZone,F,F,T) \ - macro(NoReturn,F,F,T) \ - macro(NoSync,F,F,T) \ - macro(NoUnwind,F,F,T) \ - macro(NonLazyBind,F,F,T) \ - macro(NonNull,T,T,F) \ - macro(OptForFuzzing,F,F,T) \ - macro(OptimizeForSize,F,F,T) \ - macro(OptimizeNone,F,F,T) \ - macro(ReadNone,T,F,T) \ - macro(ReadOnly,T,F,T) \ - macro(Returned,T,F,F) \ - macro(ReturnsTwice,F,F,T) \ - macro(SExt,T,T,F) \ - macro(SafeStack,F,F,T) \ - macro(SanitizeAddress,F,F,T) \ - macro(SanitizeHWAddress,F,F,T) \ - macro(SanitizeMemTag,F,F,T) \ - macro(SanitizeMemory,F,F,T) \ - macro(SanitizeThread,F,F,T) \ - macro(ShadowCallStack,F,F,T) \ - macro(Speculatable,F,F,T) \ - macro(SpeculativeLoadHardening,F,F,T) \ - macro(StackAlignment,F,F,T) \ - macro(StackProtect,F,F,T) \ - macro(StackProtectReq,F,F,T) \ - macro(StackProtectStrong,F,F,T) \ - macro(StrictFP,F,F,T) \ - macro(StructRet,T,F,F) \ - macro(SwiftError,T,F,F) \ - macro(SwiftSelf,T,F,F) \ - macro(UWTable,F,F,T) \ - macro(WillReturn,F,F,T) \ - macro(WriteOnly,T,F,T) \ - macro(ZExt,T,T,F) \ - macro(EndAttrKinds,F,F,F) + macro(None,F,F,F) \ + macro(AlwaysInline,F,F,T) \ + macro(ArgMemOnly,F,F,T) \ + macro(Builtin,F,F,T) \ + macro(Cold,F,F,T) \ + macro(Convergent,F,F,T) \ + macro(ImmArg,T,F,F) \ + macro(InAlloca,T,F,F) \ + macro(InReg,T,T,F) \ + macro(InaccessibleMemOnly,F,F,T) \ + macro(InaccessibleMemOrArgMemOnly,F,F,T) \ + macro(InlineHint,F,F,T) \ + macro(JumpTable,F,F,T) \ + macro(MinSize,F,F,T) \ + macro(Naked,F,F,T) \ + macro(Nest,T,F,F) \ + macro(NoAlias,T,T,F) \ + macro(NoBuiltin,F,F,T) \ + macro(NoCapture,T,F,F) \ + macro(NoCfCheck,F,F,T) \ + macro(NoDuplicate,F,F,T) \ + macro(NoFree,T,F,T) \ + macro(NoImplicitFloat,F,F,T) \ + macro(NoInline,F,F,T) \ + macro(NoMerge,F,F,T) \ + macro(NoRecurse,F,F,T) \ + macro(NoRedZone,F,F,T) \ + macro(NoReturn,F,F,T) \ + macro(NoSync,F,F,T) \ + macro(NoUndef,F,F,T) \ + macro(NoUnwind,F,F,T) \ + macro(NonLazyBind,F,F,T) \ + macro(NonNull,T,T,F) \ + macro(NullPointerIsValid,T,T,F) \ + macro(OptForFuzzing,F,F,T) \ + macro(OptimizeForSize,F,F,T) \ + macro(OptimizeNone,F,F,T) \ + macro(ReadNone,T,F,T) \ + macro(ReadOnly,T,F,T) \ + macro(Returned,T,F,F) \ + macro(ReturnsTwice,F,F,T) \ + macro(SExt,T,T,F) \ + macro(SafeStack,F,F,T) \ + macro(SanitizeAddress,F,F,T) \ + macro(SanitizeHWAddress,F,F,T) \ + macro(SanitizeMemTag,F,F,T) \ + macro(SanitizeMemory,F,F,T) \ + macro(SanitizeThread,F,F,T) \ + macro(ShadowCallStack,F,F,T) \ + macro(Speculatable,F,F,T) \ + macro(SpeculativeLoadHardening,F,F,T) \ + macro(StackProtect,F,F,T) \ + macro(StackProtectReq,F,F,T) \ + macro(StackProtectStrong,F,F,T) \ + macro(StrictFP,F,F,T) \ + macro(SwiftError,T,F,F) \ + macro(SwiftSelf,T,F,F) \ + macro(UWTable,F,F,T) \ + macro(WillReturn,F,F,T) \ + macro(WriteOnly,T,F,T) \ + macro(ZExt,T,T,F) \ + macro(ByRef,T,F,F) \ + macro(ByVal,T,F,F) \ + macro(MustProgress,F,F,T) \ + macro(Preallocated,F,F,T) \ + macro(StructRet,T,F,F) \ + macro(Alignment,T,T,F) \ + macro(AllocSize,F,F,T) \ + macro(Dereferenceable,T,T,F) \ + macro(DereferenceableOrNull,T,T,F) \ + macro(StackAlignment,F,F,T) \ + macro(EndAttrKinds,F,F,F) typedef enum { #define ENUM_CASE(x,p,r,f) LLVM_Hs_AttributeKind_ ## x, diff --git a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp index 3a0308bc..c8728063 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp @@ -123,11 +123,11 @@ void LLVM_Hs_AttrBuilderAddStringAttribute(AttrBuilder &ab, const char *kind, } void LLVM_Hs_AttrBuilderAddAlignment(AttrBuilder &ab, uint64_t v) { - ab.addAlignmentAttr(v); + ab.addAlignmentAttr(MaybeAlign(v)); } void LLVM_Hs_AttrBuilderAddStackAlignment(AttrBuilder &ab, uint64_t v) { - ab.addStackAlignmentAttr(v); + ab.addStackAlignmentAttr(MaybeAlign(v)); } void LLVM_Hs_AttrBuilderAddAllocSize(AttrBuilder &ab, unsigned x, unsigned y, diff --git a/llvm-hs/src/LLVM/Internal/FFI/BitcodeC.cpp b/llvm-hs/src/LLVM/Internal/FFI/BitcodeC.cpp index 62a8a1c6..10a94635 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/BitcodeC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/BitcodeC.cpp @@ -16,7 +16,7 @@ LLVMModuleRef LLVM_Hs_ParseBitcode( LLVMMemoryBufferRef mb, char **error ) { - Expected> moduleOrErr = parseBitcodeFile(unwrap(mb)->getMemBufferRef(), *unwrap(c)); + Expected> moduleOrErr = parseBitcodeFile(unwrap(mb)->getMemBufferRef(), *unwrap(c), [](StringRef) { return None; }); if (Error err = moduleOrErr.takeError()) { handleAllErrors(std::move(err), [&](ErrorInfoBase &eib) { *error = strdup(eib.message().c_str()); diff --git a/llvm-hs/src/LLVM/Internal/FFI/Builder.hs b/llvm-hs/src/LLVM/Internal/FFI/Builder.hs index 7abbe4e8..a721851b 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Builder.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Builder.hs @@ -148,6 +148,9 @@ foreign import ccall unsafe "LLVMBuildPhi" buildPhi :: foreign import ccall unsafe "LLVMBuildCall" buildCall :: Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) +foreign import ccall unsafe "LLVM_Hs_Freeze" buildFreeze :: + Ptr Builder -> Ptr Value -> Ptr Type -> IO (Ptr Instruction) + foreign import ccall unsafe "LLVM_Hs_BuildSelect" buildSelect :: Ptr Builder -> Ptr Value -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction) @@ -161,7 +164,7 @@ foreign import ccall unsafe "LLVM_Hs_BuildInsertElement" buildInsertElement :: Ptr Builder -> Ptr Value -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction) foreign import ccall unsafe "LLVM_Hs_BuildShuffleVector" buildShuffleVector :: - Ptr Builder -> Ptr Value -> Ptr Value -> Ptr Constant -> CString -> IO (Ptr Instruction) + Ptr Builder -> Ptr Value -> Ptr Value -> Ptr CInt -> CUInt -> CString -> IO (Ptr Instruction) foreign import ccall unsafe "LLVM_Hs_BuildExtractValue" buildExtractValue :: Ptr Builder -> Ptr Value -> Ptr CUInt -> CUInt -> CString -> IO (Ptr Instruction) diff --git a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp index 155fa545..3d056fcf 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp @@ -156,7 +156,7 @@ LLVMValueRef LLVM_Hs_BuildLoad( unsigned align, const char *name ) { - LoadInst *i = unwrap(b)->CreateAlignedLoad(unwrap(p), align, isVolatile, name); + LoadInst *i = unwrap(b)->CreateAlignedLoad(unwrap(p), MaybeAlign(align), isVolatile, name); i->setOrdering(unwrap(atomicOrdering)); if (atomicOrdering != LLVMAtomicOrderingNotAtomic) i->setSyncScopeID(unwrap(synchScope)); return wrap(i); @@ -172,7 +172,7 @@ LLVMValueRef LLVM_Hs_BuildStore( unsigned align, const char *name ) { - StoreInst *i = unwrap(b)->CreateAlignedStore(unwrap(v), unwrap(p), align, isVolatile); + StoreInst *i = unwrap(b)->CreateAlignedStore(unwrap(v), unwrap(p), MaybeAlign(align), isVolatile); i->setName(name); i->setOrdering(unwrap(atomicOrdering)); if (atomicOrdering != LLVMAtomicOrderingNotAtomic) i->setSyncScopeID(unwrap(synchScope)); @@ -280,6 +280,10 @@ LLVMValueRef LLVM_Hs_BuildInBoundsGEP(LLVMBuilderRef B, LLVMValueRef Pointer, return wrap(unwrap(B)->Insert(GetElementPtrInst::CreateInBounds(nullptr, unwrap(Pointer), IdxList), Name)); } +LLVMValueRef LLVM_Hs_Freeze(LLVMBuilderRef B, LLVMValueRef Op, const char *Name) { + return wrap(unwrap(B)->Insert(new FreezeInst(unwrap(Op), Name))); +} + LLVMValueRef LLVM_Hs_BuildSelect(LLVMBuilderRef B, LLVMValueRef If, LLVMValueRef Then, LLVMValueRef Else, const char *Name) { @@ -322,10 +326,11 @@ LLVMValueRef LLVM_Hs_BuildInsertElement(LLVMBuilderRef B, LLVMValueRef VecVal, } LLVMValueRef LLVM_Hs_BuildShuffleVector(LLVMBuilderRef B, LLVMValueRef V1, - LLVMValueRef V2, LLVMValueRef Mask, - const char *Name) { + LLVMValueRef V2, int *MaskArgs, + unsigned MaskSize, const char *Name) { + ArrayRef maskArray(MaskArgs, MaskSize); return wrap(unwrap(B)->Insert(new ShuffleVectorInst(unwrap(V1), unwrap(V2), - unwrap(Mask)), + maskArray), Name)); } } diff --git a/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs b/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs index 3d37eb50..07e83a4c 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs @@ -34,10 +34,10 @@ foreign import ccall unsafe "LLVMGetICmpPredicate" getICmpPredicate :: foreign import ccall unsafe "LLVM_Hs_GetFCmpPredicate" getFCmpPredicate :: Ptr Instruction -> IO FCmpPredicate -foreign import ccall unsafe "LLVM_Hs_GetCallSiteCallingConvention" getCallSiteCallingConvention :: +foreign import ccall unsafe "LLVM_Hs_GetAbstractCallSiteCallingConvention" getCallSiteCallingConvention :: Ptr Instruction -> IO CallingConvention -foreign import ccall unsafe "LLVM_Hs_SetCallSiteCallingConvention" setCallSiteCallingConvention :: +foreign import ccall unsafe "LLVM_Hs_SetAbstractCallSiteCallingConvention" setCallSiteCallingConvention :: Ptr Instruction -> CallingConvention -> IO () foreign import ccall unsafe "LLVM_Hs_GetTailCallKind" getTailCallKind :: @@ -52,12 +52,12 @@ foreign import ccall unsafe "LLVMGetCalledValue" getCallSiteCalledValue :: foreign import ccall unsafe "LLVMGetNumArgOperands" getCallSiteNumArgOperands :: Ptr Instruction -> IO CUInt -foreign import ccall unsafe "LLVM_Hs_CallSiteAttributesAtIndex" getCallSiteAttributesAtIndex :: +foreign import ccall unsafe "LLVM_Hs_AbstractCallSiteAttributesAtIndex" getCallSiteAttributesAtIndex :: Ptr Instruction -> AttributeIndex -> IO (AttributeSet a) -foreign import ccall unsafe "LLVM_Hs_CallSiteSetAttributeList" setCallSiteAttributeList :: +foreign import ccall unsafe "LLVM_Hs_AbstractCallSiteSetAttributeList" setCallSiteAttributeList :: Ptr Instruction -> AttributeList -> IO () - + foreign import ccall unsafe "LLVMAddIncoming" addIncoming' :: Ptr Instruction -> Ptr (Ptr Value) -> Ptr (Ptr BasicBlock) -> CUInt -> IO () @@ -149,6 +149,12 @@ foreign import ccall unsafe "LLVM_Hs_SetMetadata" setMetadata :: foreign import ccall unsafe "LLVM_Hs_GetMetadata" getMetadata :: Ptr Instruction -> Ptr MDKindID -> Ptr (Ptr MDNode) -> CUInt -> IO CUInt +foreign import ccall unsafe "LLVM_Hs_GetShuffleVectorMaskSize" getShuffleVectorMaskSize :: + Ptr Instruction -> IO CUInt + +foreign import ccall unsafe "LLVM_Hs_GetShuffleVectorMask" getShuffleVectorMask :: + Ptr Instruction -> Ptr CInt -> IO () + foreign import ccall unsafe "LLVM_Hs_GetCleanupPad" getCleanupPad :: Ptr Instruction -> IO (Ptr Instruction) diff --git a/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp b/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp index 401384bf..daabe898 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp @@ -2,11 +2,12 @@ #include "llvm/Config/llvm-config.h" #include "llvm/IR/LLVMContext.h" #include "llvm/IR/InstrTypes.h" +#include "llvm/IR/Instructions.h" +#include "llvm/IR/AbstractCallSite.h" #include "llvm/IR/Attributes.h" #include "llvm/IR/Operator.h" #include "llvm/IR/BasicBlock.h" #include "llvm/IR/Metadata.h" -#include "llvm/IR/CallSite.h" #include "llvm-c/Core.h" @@ -77,21 +78,21 @@ LLVMFastMathFlags LLVM_Hs_GetFastMathFlags(LLVMValueRef val) { return wrap(unwrap(val)->getFastMathFlags()); } -void LLVM_Hs_CallSiteSetAttributeList(LLVMValueRef i, LLVMAttributeListRef attrs) { - CallSite(unwrap(i)).setAttributes(*attrs); +void LLVM_Hs_AbstractCallSiteSetAttributeList(LLVMValueRef i, LLVMAttributeListRef attrs) { + unwrap(i)->setAttributes(*attrs); } -unsigned LLVM_Hs_GetCallSiteCallingConvention(LLVMValueRef i) { - return unsigned(CallSite(unwrap(i)).getCallingConv()); +unsigned LLVM_Hs_GetAbstractCallSiteCallingConvention(LLVMValueRef i) { + return unsigned(unwrap(i)->getCallingConv()); } -void LLVM_Hs_SetCallSiteCallingConvention(LLVMValueRef i, unsigned cc) { - CallSite(unwrap(i)).setCallingConv(llvm::CallingConv::ID(cc)); +void LLVM_Hs_SetAbstractCallSiteCallingConvention(LLVMValueRef i, unsigned cc) { + unwrap(i)->setCallingConv(llvm::CallingConv::ID(cc)); } -LLVMAttributeSetRef LLVM_Hs_CallSiteAttributesAtIndex(LLVMValueRef i, LLVMAttributeIndex idx) { - auto cs = CallSite(unwrap(i)); - return new AttributeSet(cs.getAttributes().getAttributes(idx)); +LLVMAttributeSetRef LLVM_Hs_AbstractCallSiteAttributesAtIndex(LLVMValueRef i, LLVMAttributeIndex idx) { + auto cs = unwrap(i); + return new AttributeSet(cs->getAttributes().getAttributes(idx)); } #define CHECK(name) \ @@ -136,7 +137,7 @@ unsigned LLVM_Hs_GetInstrAlignment(LLVMValueRef l) { void LLVM_Hs_SetInstrAlignment(LLVMValueRef l, unsigned a) { switch(unwrap(l)->getOpcode()) { -#define ENUM_CASE(n) case Instruction::n: unwrap(l)->setAlignment(a); break; +#define ENUM_CASE(n) case Instruction::n: unwrap(l)->setAlignment(MaybeAlign(a).valueOrOne()); break; LLVM_HS_FOR_EACH_ALIGNMENT_INST(ENUM_CASE) #undef ENUM_CASE } @@ -266,6 +267,15 @@ unsigned LLVM_Hs_GetMetadata( return mds.size(); } +unsigned LLVM_Hs_GetShuffleVectorMaskSize(LLVMValueRef i) { + return unwrap(i)->getShuffleMask().size(); +} + +void LLVM_Hs_GetShuffleVectorMask(LLVMValueRef i, unsigned *result) { + auto mask = unwrap(i)->getShuffleMask(); + std::copy(mask.begin(), mask.end(), result); +} + LLVMValueRef LLVM_Hs_GetCleanupPad(LLVMValueRef i) { return wrap(unwrap(i)->getCleanupPad()); } diff --git a/llvm-hs/src/LLVM/Internal/FFI/LLVMCTypes.hsc b/llvm-hs/src/LLVM/Internal/FFI/LLVMCTypes.hsc index d39fb182..864c0f33 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/LLVMCTypes.hsc +++ b/llvm-hs/src/LLVM/Internal/FFI/LLVMCTypes.hsc @@ -13,7 +13,7 @@ import LLVM.Prelude #endif #include "llvm-c/Core.h" #include "llvm-c/Linker.h" -#include "llvm-c/OrcBindings.h" +#include "llvm-c/Orc.h" #include "llvm-c/Target.h" #include "llvm-c/TargetMachine.h" #include "LLVM/Internal/FFI/Analysis.h" @@ -340,6 +340,7 @@ newtype LibFunc = LibFunc CUInt newtype JITSymbolFlags = JITSymbolFlags CUInt deriving (Eq, Read, Show, Bits, Typeable, Data, Num, Storable, Generic) + #define SF_Rec(n) { #n, LLVMJITSymbolFlag ## n }, #{inject JIT_SYMBOL_FLAG, JITSymbolFlags, JITSymbolFlags, jitSymbolFlags, SF_Rec} diff --git a/llvm-hs/src/LLVM/Internal/FFI/Metadata.h b/llvm-hs/src/LLVM/Internal/FFI/Metadata.h index 8afb729c..b2193908 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Metadata.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Metadata.h @@ -96,7 +96,7 @@ enum LLVM_Hs_DwAtE { macro(ASCII) enum LLVM_Hs_DwTag { -#define HANDLE_DW_TAG(ID, NAME, VERSION, VENDOR) LLVM_Hs_DwTag_##NAME = ID, +#define HANDLE_DW_TAG(ID, NAME, VERSION, VENDOR, KIND) LLVM_Hs_DwTag_##NAME = ID, #include "llvm/BinaryFormat/Dwarf.def" #undef HANDLE_DW_TAG }; diff --git a/llvm-hs/src/LLVM/Internal/FFI/Metadata.hs b/llvm-hs/src/LLVM/Internal/FFI/Metadata.hs index 00bbdb5a..c22f0fe1 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Metadata.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Metadata.hs @@ -37,6 +37,12 @@ foreign import ccall unsafe "LLVM_Hs_IsAMetadataOperand" isAMetadataOperand :: foreign import ccall unsafe "LLVM_Hs_GetMetadataClassId" getMetadataClassId :: Ptr MDNode -> IO (MDSubclassID) +foreign import ccall unsafe "LLVM_Hs_IsADIVariable" isADIVariable :: + Ptr Metadata -> IO (Ptr DIVariable) + +foreign import ccall unsafe "LLVM_Hs_IsADIExpression" isADIExpression :: + Ptr Metadata -> IO (Ptr DIExpression) + -- DILocation foreign import ccall unsafe "LLVM_Hs_DILocation_GetLine" getDILocationLine :: @@ -54,6 +60,9 @@ foreign import ccall unsafe "LLVM_Hs_Get_DILocation" getDILocation :: foreign import ccall unsafe "LLVM_Hs_GetMDValue" getMDValue :: Ptr MDValue -> IO (Ptr Value) +foreign import ccall unsafe "LLVM_Hs_DumpMetadata" dumpMetadata :: + Ptr Metadata -> IO () + foreign import ccall unsafe "LLVM_Hs_GetMetadataOperand" getMetadataOperand :: Ptr MetadataAsVal -> IO (Ptr Metadata) @@ -291,17 +300,34 @@ foreign import ccall unsafe "LLVM_Hs_Get_DISubrangeConstantCount" getDISubrangeC foreign import ccall unsafe "LLVM_Hs_Get_DISubrangeVariableCount" getDISubrangeVariableCount :: Ptr Context -> Ptr DIVariable -> Int64 -> IO (Ptr DISubrange) +foreign import ccall unsafe "LLVM_Hs_Get_DISubrangeVariableFields" getDISubrangeVariableFields :: + Ptr Context -> + Ptr Metadata -> -- count + Ptr Metadata -> -- lowerBound + Ptr Metadata -> -- upperBound + Ptr Metadata -> -- strides + IO (Ptr DISubrange) + foreign import ccall unsafe "LLVM_Hs_DISubrange_HasConstantCount" getDISubrangeHasConstantCount :: Ptr DISubrange -> IO LLVMBool -foreign import ccall unsafe "LLVM_Hs_DISubrange_GetVariableCount" getDISubrangeCountVariable :: +foreign import ccall unsafe "LLVM_Hs_DISubrange_GetCount" getDISubrangeCount :: + Ptr DISubrange -> IO (Ptr Metadata) + +foreign import ccall unsafe "LLVM_Hs_DISubrange_GetCountVariable" getDISubrangeCountVariable :: Ptr DISubrange -> IO (Ptr DIVariable) -foreign import ccall unsafe "LLVM_Hs_DISubrange_GetConstantCount" getDISubrangeCountConstant :: +foreign import ccall unsafe "LLVM_Hs_DISubrange_GetCountConstant" getDISubrangeCountConstant :: Ptr DISubrange -> IO Int64 foreign import ccall unsafe "LLVM_Hs_DISubrange_GetLowerBound" getDISubrangeLowerBound :: - Ptr DISubrange -> IO Int64 + Ptr DISubrange -> IO (Ptr Metadata) + +foreign import ccall unsafe "LLVM_Hs_DISubrange_GetUpperBound" getDISubrangeUpperBound :: + Ptr DISubrange -> IO (Ptr Metadata) + +foreign import ccall unsafe "LLVM_Hs_DISubrange_GetStride" getDISubrangeStride :: + Ptr DISubrange -> IO (Ptr Metadata) -- DISubprogram @@ -519,7 +545,7 @@ foreign import ccall unsafe "LLVM_Hs_Get_DITemplateTypeParameter" getDITemplateT -- DITemplateValueParameter foreign import ccall unsafe "LLVM_Hs_Get_DITemplateValueParameter" getDITemplateValueParameter :: - Ptr Context -> Ptr MDString -> Ptr DIType -> DwTag -> Ptr Metadata -> IO (Ptr DITemplateValueParameter) + Ptr Context -> Ptr MDString -> Ptr DIType -> DwTag -> Bool -> Ptr Metadata -> IO (Ptr DITemplateValueParameter) foreign import ccall unsafe "LLVM_Hs_DITemplateValueParameter_GetValue" getDITemplateValueParameterValue :: Ptr DITemplateValueParameter -> IO (Ptr Metadata) @@ -612,7 +638,7 @@ foreign import ccall unsafe "LLVM_Hs_DIObjCProperty_GetType" getDIObjCPropertyTy -- DIModule foreign import ccall unsafe "LLVM_Hs_Get_DIModule" getDIModule :: - Ptr Context -> Ptr DIScope -> Ptr MDString -> Ptr MDString -> Ptr MDString -> Ptr MDString -> IO (Ptr DIModule) + Ptr Context -> Ptr DIScope -> Ptr MDString -> Ptr MDString -> Ptr MDString -> Ptr MDString -> Word32 -> IO (Ptr DIModule) foreign import ccall unsafe "LLVM_Hs_DIModule_GetConfigurationMacros" getDIModuleConfigurationMacros :: Ptr DIModule -> IO (Ptr MDString) @@ -620,5 +646,8 @@ foreign import ccall unsafe "LLVM_Hs_DIModule_GetConfigurationMacros" getDIModul foreign import ccall unsafe "LLVM_Hs_DIModule_GetIncludePath" getDIModuleIncludePath :: Ptr DIModule -> IO (Ptr MDString) -foreign import ccall unsafe "LLVM_Hs_DIModule_GetISysRoot" getDIModuleISysRoot :: +foreign import ccall unsafe "LLVM_Hs_DIModule_GetAPINotesFile" getDIModuleAPINotesFile :: Ptr DIModule -> IO (Ptr MDString) + +foreign import ccall unsafe "LLVM_Hs_DIModule_GetLineNo" getDIModuleLineNo :: + Ptr DIModule -> IO Word32 diff --git a/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp b/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp index d3097e1a..03ed42e3 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp @@ -51,20 +51,6 @@ LLVMMetadataRef LLVM_Hs_IsAMDNode(LLVMMetadataRef md) { return nullptr; } -LLVMValueRef LLVM_Hs_GetMDValue(LLVMMetadataRef md) { - return wrap(unwrap(md)->getValue()); -} - -LLVMMetadataRef LLVM_Hs_GetMetadataOperand(LLVMValueRef val) { - return wrap(unwrap(val)->getMetadata()); -} - -MDTuple* LLVM_Hs_Get_MDTuple(LLVMContextRef c, - LLVMMetadataRef *mds, - unsigned count) { - return MDTuple::get(*unwrap(c), {unwrap(mds), count}); -} - LLVMMetadataRef LLVM_Hs_IsAMDValue(LLVMMetadataRef md) { if (isa(unwrap(md))) { return md; @@ -72,6 +58,9 @@ LLVMMetadataRef LLVM_Hs_IsAMDValue(LLVMMetadataRef md) { return nullptr; } +LLVMValueRef LLVM_Hs_GetMDValue(LLVMMetadataRef md) { + return wrap(unwrap(md)->getValue()); +} LLVMValueRef LLVM_Hs_IsAMetadataOperand(LLVMValueRef val) { if (isa(unwrap(val))) { @@ -80,6 +69,19 @@ LLVMValueRef LLVM_Hs_IsAMetadataOperand(LLVMValueRef val) { return nullptr; } +LLVMMetadataRef LLVM_Hs_GetMetadataOperand(LLVMValueRef val) { + return wrap(unwrap(val)->getMetadata()); +} + +MDTuple* LLVM_Hs_Get_MDTuple(LLVMContextRef c, + LLVMMetadataRef *mds, + unsigned count) { + return MDTuple::get(*unwrap(c), {unwrap(mds), count}); +} + +void LLVM_Hs_DumpMetadata(LLVMMetadataRef md) { + unwrap(md)->dump(); +} unsigned LLVM_Hs_GetMDKindNames( LLVMContextRef c, @@ -201,7 +203,7 @@ DIEnumerator* LLVM_Hs_Get_DIEnumerator(LLVMContextRef cxt, int64_t value, LLVMBo } int64_t LLVM_Hs_DIEnumerator_GetValue(DIEnumerator* md) { - return md->getValue(); + return md->getValue().getLimitedValue(); } LLVMBool LLVM_Hs_DIEnumerator_GetIsUnsigned(DIEnumerator* md) { @@ -319,21 +321,50 @@ DISubrange* LLVM_Hs_Get_DISubrangeVariableCount(LLVMContextRef ctx, DIVariable* return DISubrange::get(*unwrap(ctx), count, lowerBound); } +DISubrange* LLVM_Hs_Get_DISubrangeVariableFields(LLVMContextRef ctx, Metadata* count, Metadata* lowerBound, Metadata* upperBound, Metadata* stride) { + return DISubrange::get(*unwrap(ctx), count, lowerBound, upperBound, stride); +} + LLVMBool LLVM_Hs_DISubrange_HasConstantCount(DISubrange* range) { return range->getCount().is(); } -int64_t LLVM_Hs_DISubrange_GetConstantCount(DISubrange* range) { +Metadata* LLVM_Hs_DISubrange_GetCount(DISubrange* range) { + return range->getRawCountNode(); +} + +int64_t LLVM_Hs_DISubrange_GetCountConstant(DISubrange* range) { return range->getCount().dyn_cast()->getSExtValue(); } -DIVariable* LLVM_Hs_DISubrange_GetVariableCount(DISubrange* range) { +DIVariable* LLVM_Hs_DISubrange_GetCountVariable(DISubrange* range) { return range->getCount().dyn_cast(); } +Metadata* LLVM_Hs_DISubrange_GetLowerBound(DISubrange* range) { + return range->getRawLowerBound(); +} + +Metadata* LLVM_Hs_DISubrange_GetUpperBound(DISubrange* range) { + return range->getRawUpperBound(); +} -int64_t LLVM_Hs_DISubrange_GetLowerBound(DISubrange* range) { - return range->getLowerBound(); +Metadata* LLVM_Hs_DISubrange_GetStride(DISubrange* range) { + return range->getRawStride(); +} + +LLVMMetadataRef LLVM_Hs_IsADIVariable(LLVMMetadataRef md) { + if (isa(unwrap(md))) { + return md; + } + return nullptr; +} + +LLVMMetadataRef LLVM_Hs_IsADIExpression(LLVMMetadataRef md) { + if (isa(unwrap(md))) { + return md; + } + return nullptr; } MDTuple* LLVM_Hs_DICompositeType_GetElements(DICompositeType *dt) { @@ -653,14 +684,14 @@ DICompileUnit* LLVM_Hs_Get_DICompileUnit unsigned sourceLanguage, DIFile* file, MDString* producer, LLVMBool isOptimized, MDString* flags, unsigned runtimeVersion, MDString* splitDebugFilename, unsigned emissionKind, Metadata* enumTypes, Metadata* retainedTypes, Metadata* globalVariables, Metadata* importedEntities, Metadata* macros, uint64_t dwoid, LLVMBool splitDebugInlining, - LLVMBool debugInfoForProfiling, unsigned nameTableKind, LLVMBool debugBaseAddress) { + LLVMBool debugInfoForProfiling, unsigned nameTableKind, LLVMBool debugBaseAddress, MDString *sysRoot, MDString *sdk) { LLVMContext &c = *unwrap(ctx); return DICompileUnit::getDistinct (c, sourceLanguage, file, producer, isOptimized, flags, runtimeVersion, splitDebugFilename, emissionKind, enumTypes, retainedTypes, globalVariables, importedEntities, macros, dwoid, splitDebugInlining, - debugInfoForProfiling, nameTableKind, debugBaseAddress); + debugInfoForProfiling, nameTableKind, debugBaseAddress, sysRoot, sdk); } unsigned LLVM_Hs_DICompileUnit_GetLanguage(DICompileUnit* cu) { @@ -750,14 +781,14 @@ DIType* LLVM_Hs_DITemplateParameter_GetType(DITemplateParameter* p) { // DITemplateTypeParameter -DITemplateTypeParameter* LLVM_Hs_Get_DITemplateTypeParameter(LLVMContextRef ctx, MDString* name, DIType* type) { - return DITemplateTypeParameter::get(*unwrap(ctx), name, type); +DITemplateTypeParameter* LLVM_Hs_Get_DITemplateTypeParameter(LLVMContextRef ctx, MDString* name, DIType* type, bool isDefault) { + return DITemplateTypeParameter::get(*unwrap(ctx), name, type, isDefault); } // DITemplateValueParameter -DITemplateValueParameter* LLVM_Hs_Get_DITemplateValueParameter(LLVMContextRef ctx, MDString* name, DIType* type, uint16_t tag, Metadata* value) { - return DITemplateValueParameter::get(*unwrap(ctx), tag, name, type, value); +DITemplateValueParameter* LLVM_Hs_Get_DITemplateValueParameter(LLVMContextRef ctx, MDString* name, DIType* type, uint16_t tag, bool isDefault, Metadata* value) { + return DITemplateValueParameter::get(*unwrap(ctx), tag, name, type, isDefault, value); } Metadata* LLVM_Hs_DITemplateValueParameter_GetValue(DITemplateValueParameter* p) { @@ -882,8 +913,8 @@ DIType* LLVM_Hs_DIObjCProperty_GetType(DIObjCProperty* o) { // DIModule -DIModule* LLVM_Hs_Get_DIModule(LLVMContextRef ctx, DIScope* scope, MDString* name, MDString* configurationMacros, MDString* includePath, MDString* isysRoot) { - return DIModule::get(*unwrap(ctx), scope, name, configurationMacros, includePath, isysRoot); +DIModule* LLVM_Hs_Get_DIModule(LLVMContextRef ctx, DIFile* file, DIScope* scope, MDString* name, MDString* configurationMacros, MDString* includePath, MDString* apiNotesFile, unsigned lineNo) { + return DIModule::get(*unwrap(ctx), file, scope, name, configurationMacros, includePath, apiNotesFile, lineNo); } MDString* LLVM_Hs_DIModule_GetConfigurationMacros(DIModule* m) { @@ -894,7 +925,11 @@ MDString* LLVM_Hs_DIModule_GetIncludePath(DIModule* m) { return m->getRawIncludePath(); } -MDString* LLVM_Hs_DIModule_GetISysRoot(DIModule* m) { - return m->getRawISysRoot(); +MDString* LLVM_Hs_DIModule_GetAPINotesFile(DIModule* m) { + return m->getRawAPINotesFile(); +} + +uint32_t LLVM_Hs_DIModule_GetLineNo(DIModule* m) { + return m->getLineNo(); } } diff --git a/llvm-hs/src/LLVM/Internal/FFI/Module.hs b/llvm-hs/src/LLVM/Internal/FFI/Module.hs index d52de457..9c72f1c9 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Module.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Module.hs @@ -37,6 +37,9 @@ foreign import ccall unsafe "LLVMGetTarget" getTargetTriple :: foreign import ccall unsafe "LLVMSetTarget" setTargetTriple :: Ptr Module -> CString -> IO () +foreign import ccall unsafe "LLVM_Hs_DumpModule" dumpModule :: + Ptr Module -> IO () + foreign import ccall unsafe "LLVM_Hs_GetModuleIdentifier" getModuleIdentifier :: Ptr Module -> IO (OwnerTransfered CString) diff --git a/llvm-hs/src/LLVM/Internal/FFI/ModuleC.cpp b/llvm-hs/src/LLVM/Internal/FFI/ModuleC.cpp index f9af19a3..dc601447 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/ModuleC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/ModuleC.cpp @@ -6,6 +6,10 @@ using namespace llvm; extern "C" { +void LLVM_Hs_DumpModule(LLVMModuleRef m) { + unwrap(m)->dump(); +} + char *LLVM_Hs_GetModuleIdentifier(LLVMModuleRef val) { return strdup(unwrap(val)->getModuleIdentifier().c_str()); } diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.h b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.h index fec1365f..437a532e 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.h +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.h @@ -16,6 +16,6 @@ typedef enum { LLVMJITSymbolFlagCommon = 1U << 2, LLVMJITSymbolFlagAbsolute = 1U << 3, LLVMJITSymbolFlagExported = 1U << 4 -} LLVMJITSymbolFlags; +} LLVMJITSymbolFlags_; #endif diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs index 2ae3e7ae..cdaac2e5 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs @@ -16,11 +16,46 @@ newtype ModuleKey = ModuleKey Word64 deriving (Eq, Ord, Show) data JITSymbol data SymbolResolver data ExecutionSession +data JITDylib newtype TargetAddress = TargetAddress Word64 type SymbolResolverFn = CString -> Ptr JITSymbol -> IO () +foreign import ccall safe "LLVM_Hs_disposeJITSymbol" disposeSymbol :: + Ptr JITSymbol -> IO () + +foreign import ccall safe "LLVM_Hs_JITSymbol_getAddress" getAddress :: + Ptr JITSymbol -> Ptr (OwnerTransfered CString) -> IO TargetAddress + +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 () + +foreign import ccall safe "LLVM_Hs_getMangledSymbol" getMangledSymbol :: + Ptr CString -> CString -> Ptr DataLayout -> IO () + +foreign import ccall safe "LLVM_Hs_disposeMangledSymbol" disposeMangledSymbol :: + CString -> IO () + +foreign import ccall safe "LLVM_Hs_createExecutionSession" createExecutionSession :: + IO (Ptr ExecutionSession) + +foreign import ccall safe "LLVM_Hs_disposeExecutionSession" disposeExecutionSession :: + Ptr ExecutionSession -> IO () + +foreign import ccall "wrapper" wrapGetSymbolResolver :: + (ModuleKey -> IO (Ptr SymbolResolver)) -> IO (FunPtr (ModuleKey -> IO (Ptr SymbolResolver))) + +foreign import ccall "wrapper" wrapSetSymbolResolver :: + (ModuleKey -> Ptr SymbolResolver -> IO ()) -> IO (FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ())) + +{- foreign import ccall "wrapper" wrapSymbolResolverFn :: SymbolResolverFn -> IO (FunPtr SymbolResolverFn) @@ -70,3 +105,4 @@ foreign import ccall "wrapper" wrapGetSymbolResolver :: foreign import ccall "wrapper" wrapSetSymbolResolver :: (ModuleKey -> Ptr SymbolResolver -> IO ()) -> IO (FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ())) +-} diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileLayer.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileLayer.hs index c3ad180c..8c16ebd5 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileLayer.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileLayer.hs @@ -16,6 +16,8 @@ data CompileLayer foreign import ccall safe "LLVM_Hs_CompileLayer_dispose" disposeCompileLayer :: Ptr CompileLayer -> IO () +-- TODO(llvm-12): Consider removing this unused API? +{- foreign import ccall safe "LLVM_Hs_CompileLayer_addModule" addModule :: Ptr CompileLayer -> Ptr DataLayout -> @@ -26,9 +28,13 @@ foreign import ccall safe "LLVM_Hs_CompileLayer_addModule" addModule :: foreign import ccall safe "LLVM_Hs_CompileLayer_removeModule" removeModule :: Ptr CompileLayer -> ModuleKey -> IO () +-} foreign import ccall safe "LLVM_Hs_CompileLayer_findSymbol" findSymbol :: Ptr CompileLayer -> CString -> LLVMBool -> IO (Ptr JITSymbol) +-- TODO(llvm-12): Consider removing this unused API? +{- foreign import ccall safe "LLVM_Hs_CompileLayer_findSymbolIn" findSymbolIn :: Ptr CompileLayer -> ModuleKey -> CString -> LLVMBool -> IO (Ptr JITSymbol) +-} diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp index d60cbf4e..377e9deb 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp @@ -2,6 +2,12 @@ #pragma GCC diagnostic ignored "-Wdeprecated-declarations" #pragma clang diagnostic ignored "-Wdeprecated-declarations" +// FIXME(llvm-12): Clean up this file. +// OrcJIT APIs like VModuleKeys and LambdaResolvers seem deprecated, so much of +// the code is commented here - unnecessary bits to be removed. Memory +// management may also need some reworking. + +// #if 0 #include "llvm/Support/Error.h" #include "LLVM/Internal/FFI/ErrorHandling.hpp" @@ -13,7 +19,7 @@ #include "llvm/ExecutionEngine/Orc/IRCompileLayer.h" #include "llvm/ExecutionEngine/Orc/IRTransformLayer.h" #include "llvm/ExecutionEngine/Orc/IndirectionUtils.h" -#include "llvm/ExecutionEngine/Orc/LambdaResolver.h" +// #include "llvm/ExecutionEngine/Orc/LambdaResolver.h" #include "llvm/ExecutionEngine/Orc/RTDyldObjectLinkingLayer.h" #include "llvm/ExecutionEngine/SectionMemoryManager.h" #include "llvm/IR/Mangler.h" @@ -27,8 +33,10 @@ using namespace llvm; using namespace orc; +#if 0 static_assert(std::is_same::value, "VModuleKey should be uint64_t"); +#endif #define SYMBOL_CASE(x) \ static_assert((unsigned)LLVMJITSymbolFlag##x == \ @@ -36,7 +44,7 @@ static_assert(std::is_same::value, "JITSymbolFlag values should agree"); LLVM_HS_FOR_EACH_JIT_SYMBOL_FLAG(SYMBOL_CASE) -typedef std::shared_ptr *LLVMSymbolResolverRef; +typedef std::shared_ptr *LLVMSymbolResolverRef; // We want to allow users to choose themselves which layers they want to use. // However, the LLVM API requires that this is selected statically via template @@ -48,24 +56,27 @@ class LinkingLayer { public: using ObjectPtr = std::unique_ptr; virtual ~LinkingLayer(){}; + virtual JITSymbol findSymbol(StringRef name, bool exportedSymbolsOnly) = 0; +#if 0 virtual Error addObject(VModuleKey k, ObjectPtr objBuffer) = 0; virtual Error removeObject(VModuleKey k) = 0; - virtual JITSymbol findSymbol(StringRef name, bool exportedSymbolsOnly) = 0; virtual JITSymbol findSymbolIn(VModuleKey k, StringRef name, bool exportedSymbolsOnly) = 0; virtual Error emitAndFinalize(VModuleKey k) = 0; +#endif }; template class LinkingLayerT : public LinkingLayer { public: LinkingLayerT(T data_) : data(std::move(data_)) {} + JITSymbol findSymbol(StringRef name, bool exportedSymbolsOnly) override { + return data.findSymbol(name, exportedSymbolsOnly); + } +#if 0 Error addObject(VModuleKey k, ObjectPtr objBuffer) override { return data.addObject(k, std::move(objBuffer)); } Error removeObject(VModuleKey k) override { return data.removeObject(k); } - JITSymbol findSymbol(StringRef name, bool exportedSymbolsOnly) override { - return data.findSymbol(name, exportedSymbolsOnly); - } JITSymbol findSymbolIn(VModuleKey k, StringRef name, bool exportedSymbolsOnly) override { return data.findSymbolIn(k, name, exportedSymbolsOnly); @@ -73,19 +84,23 @@ template class LinkingLayerT : public LinkingLayer { Error emitAndFinalize(VModuleKey k) override { return data.emitAndFinalize(k); } +#endif private: T data; }; -class CompileLayer { +// class CompileLayer : public IRLayer { +class CompileLayer : public IRLayer { public: virtual ~CompileLayer(){}; virtual JITSymbol findSymbol(StringRef Name, bool ExportedSymbolsOnly) = 0; +#if 0 virtual JITSymbol findSymbolIn(VModuleKey K, StringRef Name, bool ExportedSymbolsOnly) = 0; virtual Error addModule(VModuleKey K, std::unique_ptr Module) = 0; virtual Error removeModule(VModuleKey K) = 0; +#endif }; template class CompileLayerT : public CompileLayer { @@ -95,6 +110,7 @@ template class CompileLayerT : public CompileLayer { JITSymbol findSymbol(StringRef Name, bool ExportedSymbolsOnly) override { return data.findSymbol(Name, ExportedSymbolsOnly); } +#if 0 JITSymbol findSymbolIn(VModuleKey K, StringRef Name, bool ExportedSymbolsOnly) override { return data.findSymbolIn(K, Name, ExportedSymbolsOnly); @@ -103,11 +119,13 @@ template class CompileLayerT : public CompileLayer { return data.addModule(K, std::move(Module)); } Error removeModule(VModuleKey K) override { return data.removeModule(K); } +#endif private: T data; }; +#if 0 typedef llvm::orc::LegacyCompileOnDemandLayer LLVMCompileOnDemandLayer; typedef LLVMCompileOnDemandLayer *LLVMCompileOnDemandLayerRef; @@ -115,6 +133,7 @@ typedef llvm::orc::LegacyIRTransformLayer< CompileLayer, std::function(std::unique_ptr)>> LLVMIRTransformLayer; +#endif typedef llvm::orc::JITCompileCallbackManager *LLVMJITCompileCallbackManagerRef; @@ -140,7 +159,7 @@ unwrap(LLVMObjectFileRef OF) { return reinterpret_cast *>(OF); } -static JITSymbolFlags unwrap(LLVMJITSymbolFlags f) { +static JITSymbolFlags unwrap(LLVMJITSymbolFlags_ f) { JITSymbolFlags flags = JITSymbolFlags::None; #define ENUM_CASE(x) \ if (f & LLVMJITSymbolFlag##x) \ @@ -150,14 +169,14 @@ static JITSymbolFlags unwrap(LLVMJITSymbolFlags f) { return flags; } -static LLVMJITSymbolFlags wrap(JITSymbolFlags f) { +static LLVMJITSymbolFlags_ wrap(JITSymbolFlags f) { unsigned r = 0; #define ENUM_CASE(x) \ if (f & JITSymbolFlags::x) \ r |= (unsigned)LLVMJITSymbolFlag##x; LLVM_HS_FOR_EACH_JIT_SYMBOL_FLAG(ENUM_CASE) #undef ENUM_CASE - return LLVMJITSymbolFlags(r); + return LLVMJITSymbolFlags_(r); } extern "C" { @@ -166,8 +185,13 @@ ExecutionSession *LLVM_Hs_createExecutionSession() { return new ExecutionSession(); } -void LLVM_Hs_disposeExecutionSession(ExecutionSession *es) { delete es; } +void LLVM_Hs_disposeExecutionSession(ExecutionSession *es) { + // FIXME(llvm-12): Uncommenting this causes an assertion failure for OrcV2 test. + // Assertion failed: (Pool.empty() && "Dangling references at pool destruction time"), function ~SymbolStringPool, file llvm-project/llvm/include/llvm/ExecutionEngine/Orc/SymbolStringPool.h, line 151. + // delete es; +} +#if 0 VModuleKey LLVM_Hs_allocateVModule(ExecutionSession *es) { return es->allocateVModule(); } @@ -175,9 +199,11 @@ VModuleKey LLVM_Hs_allocateVModule(ExecutionSession *es) { void LLVM_Hs_releaseVModule(ExecutionSession *es, VModuleKey k) { es->releaseVModule(k); } +#endif /* Constructor functions for the different compile layers */ +#if 0 CompileLayer *LLVM_Hs_createLegacyIRCompileLayer(LinkingLayer *linkingLayer, LLVMTargetMachineRef tm) { TargetMachine *tmm = unwrap(tm); @@ -194,14 +220,14 @@ CompileLayer *LLVM_Hs_createCompileOnDemandLayer( LLVMJITCompileCallbackManagerRef callbackManager, LLVMIndirectStubsManagerBuilderRef stubsManager, LLVMBool cloneStubsIntoPartitions) { - std::function(VModuleKey)> + std::function(VModuleKey)> getSymbolResolverFn = [getSymbolResolver](VModuleKey k) { return *getSymbolResolver(k); }; - std::function)> + std::function)> setSymbolResolverFn = [setSymbolResolver](VModuleKey k, - std::shared_ptr r) { - setSymbolResolver(k, new std::shared_ptr(r)); + std::shared_ptr r) { + setSymbolResolver(k, new std::shared_ptr(r)); }; return new CompileLayerT( *es, *compileLayer, getSymbolResolverFn, setSymbolResolverFn, @@ -213,15 +239,33 @@ CompileLayer *LLVM_Hs_createCompileOnDemandLayer( *callbackManager, *stubsManager, static_cast(cloneStubsIntoPartitions)); } +#endif + +// NOTE: An IRCompileLayer actually already exists in OrcJITV2.cpp! No more work needed here :) +#if 0 +SimpleCompiler *LLVM_Hs_createSimpleCompiler(LLVMTargetMachineRef tm) { + TargetMachine *tmm = unwrap(tm); + return new SimpleCompiler(*tmm); +} +// IRCompileLayer(ExecutionSession &ES, ObjectLayer &BaseLayer, +// std::unique_ptr Compile); +IRCompileLayer *LLVM_Hs_createIRCompileLayer(LLVMTargetMachineRef tm) { + TargetMachine *tmm = unwrap(tm); + return new // +} +#endif + +#if 0 CompileLayer *LLVM_Hs_createIRTransformLayer(CompileLayer *compileLayer, Module *(*transform)(Module *)) { std::function(std::unique_ptr)> transform_ = [transform](std::unique_ptr module) { return std::unique_ptr(transform(module.release())); }; - return new CompileLayerT(*compileLayer, transform_); + return new CompileLayerT(*compileLayer, transform_); } +#endif /* Functions that work on all compile layers */ @@ -236,6 +280,7 @@ LLVMJITSymbolRef LLVM_Hs_CompileLayer_findSymbol(CompileLayer *compileLayer, return new JITSymbol(std::move(symbol)); } +#if 0 LLVMJITSymbolRef LLVM_Hs_CompileLayer_findSymbolIn(CompileLayer *compileLayer, VModuleKey k, const char *name, @@ -275,6 +320,7 @@ LinkingLayer *LLVM_Hs_createObjectLinkingLayer( std::make_shared(), *symbolResolver(k)}; })); } +#endif /* Fuctions that work on all object layers */ @@ -291,6 +337,7 @@ LLVMJITSymbolRef LLVM_Hs_LinkingLayer_findSymbol(LinkingLayer *linkingLayer, return new JITSymbol(std::move(symbol)); } + #if 0 LLVMJITSymbolRef LLVM_Hs_LinkingLayer_findSymbolIn(LinkingLayer *linkingLayer, VModuleKey k, const char *name, @@ -308,20 +355,21 @@ LLVMSymbolResolverRef LLVM_Hs_createLambdaResolver( rawResolverFn(name.c_str(), &symbol); return symbol; }; - return new std::shared_ptr( + return new std::shared_ptr( createLegacyLookupResolver(*es, resolverFn, [](Error err) { cantFail(std::move(err), "lookupFlags failed"); })); } +#endif void LLVM_Hs_disposeSymbolResolver(LLVMSymbolResolverRef resolver) { delete resolver; } +#if 0 void LLVM_Hs_LinkingLayer_addObject(LinkingLayer *linkLayer, VModuleKey k, LLVMObjectFileRef objRef, char **errorMessage) { - std::unique_ptr objBuffer = unwrap(objRef)->takeBinary().second; *errorMessage = nullptr; @@ -331,6 +379,7 @@ void LLVM_Hs_LinkingLayer_addObject(LinkingLayer *linkLayer, VModuleKey k, return; } } +#endif JITTargetAddress LLVM_Hs_JITSymbol_getAddress(LLVMJITSymbolRef symbol, char **errorMessage) { @@ -344,7 +393,7 @@ JITTargetAddress LLVM_Hs_JITSymbol_getAddress(LLVMJITSymbolRef symbol, } } -LLVMJITSymbolFlags LLVM_Hs_JITSymbol_getFlags(LLVMJITSymbolRef symbol) { +LLVMJITSymbolFlags_ LLVM_Hs_JITSymbol_getFlags(LLVMJITSymbolRef symbol) { return wrap(symbol->getFlags()); } @@ -357,7 +406,7 @@ const char *LLVM_Hs_JITSymbol_getErrorMsg(LLVMJITSymbolRef symbol) { } void LLVM_Hs_setJITSymbol(LLVMJITSymbolRef symbol, JITTargetAddress addr, - LLVMJITSymbolFlags flags) { + LLVMJITSymbolFlags_ flags) { *symbol = JITSymbol(addr, unwrap(flags)); } @@ -410,3 +459,5 @@ void LLVM_Hs_insertFun(std::set *set, llvm::Function *f) { set->insert(f); } } + +// #endif diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs index 21cc00dd..4dcdaf8c 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs @@ -4,13 +4,16 @@ import LLVM.Prelude import LLVM.Internal.FFI.DataLayout (DataLayout) import LLVM.Internal.FFI.Module (Module) -import LLVM.Internal.FFI.OrcJIT (ExecutionSession) +import LLVM.Internal.FFI.OrcJIT (ExecutionSession, JITDylib) import LLVM.Internal.FFI.Target (TargetMachine) import Foreign.Ptr import Foreign.C +data LLVMJITEvaluatedSymbol +data JITEvaluatedSymbol data ThreadSafeContext +data ThreadSafeModule data ObjectLayer data IRLayer @@ -20,6 +23,12 @@ foreign import ccall safe "LLVM_Hs_createThreadSafeContext" createThreadSafeCont foreign import ccall safe "LLVM_Hs_disposeThreadSafeContext" disposeThreadSafeContext :: Ptr ThreadSafeContext -> IO () +foreign import ccall safe "LLVM_Hs_createThreadSafeModule" createThreadSafeModule :: + Ptr Module -> IO (Ptr ThreadSafeModule) + +foreign import ccall safe "LLVM_Hs_disposeThreadSafeModule" disposeThreadSafeModule :: + Ptr ThreadSafeModule -> IO () + foreign import ccall safe "LLVM_Hs_createRTDyldObjectLinkingLayer" createRTDyldObjectLinkingLayer :: Ptr ExecutionSession -> IO (Ptr ObjectLayer) @@ -32,8 +41,26 @@ foreign import ccall safe "LLVM_Hs_createIRCompileLayer" createIRCompileLayer :: foreign import ccall safe "LLVM_Hs_disposeIRLayer" disposeIRLayer :: Ptr IRLayer -> IO () -foreign import ccall safe "LLVM_Hs_IRLayer_add" irLayerAdd :: - Ptr ThreadSafeContext -> Ptr ExecutionSession -> Ptr DataLayout -> Ptr IRLayer -> Ptr Module -> IO () +foreign import ccall safe "LLVM_Hs_ExecutionSession_createJITDylib" createJITDylib :: + Ptr ExecutionSession -> CString -> IO (Ptr JITDylib) + +foreign import ccall safe "LLVM_Hs_ExecutionSession_getJITDylibByName" getJITDylibByName :: + Ptr ExecutionSession -> CString -> IO (Ptr JITDylib) + +foreign import ccall safe "LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_forCurrentProcess" + addDynamicLibrarySearchGeneratorForCurrentProcess :: + Ptr JITDylib -> Ptr DataLayout -> IO () + +foreign import ccall safe "LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_load" + addDynamicLibrarySearchGenerator :: + Ptr JITDylib -> Ptr DataLayout -> CString -> IO () + +foreign import ccall safe "LLVM_Hs_IRLayer_addModule" irLayerAddModule :: + Ptr ThreadSafeModule -> Ptr JITDylib -> Ptr DataLayout -> Ptr IRLayer -> IO () + +foreign import ccall safe "LLVM_Hs_ExecutionSession_lookup" lookupSymbol :: + Ptr ExecutionSession -> Ptr JITDylib -> CString -> IO WordPtr -foreign import ccall safe "LLVM_Hs_ExecutionSession_lookup" esLookup :: - Ptr ExecutionSession -> CString -> IO Word64 +-- foreign import ccall safe "LLVM_Hs_ExecutionSession_lookup" lookupSymbol' :: +-- -- Ptr ExecutionSession -> Ptr JITDylib -> CString -> IO JITEvaluatedSymbol +-- Ptr ExecutionSession -> Ptr JITDylib -> CString -> IO LLVMJITEvaluatedSymbol diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp index a1397e2b..32d73c8b 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp @@ -2,13 +2,20 @@ #include #include +#include +#include #include #include #include #include +#include +#include #include "LLVM/Internal/FFI/Target.hpp" +// FIXME(llvm-12): Clean up this file. +// Design of ThreadSafeModule APIs may not be ideal. + using namespace llvm; using namespace orc; @@ -17,49 +24,134 @@ extern "C" { // Thread-safe context ThreadSafeContext* LLVM_Hs_createThreadSafeContext() { - return new ThreadSafeContext(llvm::make_unique()); + return new ThreadSafeContext(std::make_unique()); } void LLVM_Hs_disposeThreadSafeContext(ThreadSafeContext* ctx) { delete ctx; } +// Thread-safe module + +ThreadSafeModule* LLVM_Hs_createThreadSafeModule(LLVMModuleRef m) { + // FIXME(llvm-12): Module cloning (via `LLVMCloneModule`) was a short-term + // hack to get OrcJIT end-to-end tests to pass. @dan-zheng tried an + // initial exploration of better memory management but didn't find an easy + // fix at the time. + auto moduleClone = LLVMCloneModule(m); + std::unique_ptr module{unwrap(moduleClone)}; + llvm::errs() << "LLVM_Hs_createThreadSafeModule: " << module.get() << "\n"; + return new ThreadSafeModule(std::move(module), std::make_unique()); +} + +void LLVM_Hs_disposeThreadSafeModule(ThreadSafeModule* module) { + llvm::errs() << "LLVM_Hs_disposeThreadSafeModule: " << module->getModuleUnlocked() << "\n"; + if (module == nullptr) { + return; + } + delete module; +} + // Object layer ObjectLayer* LLVM_Hs_createRTDyldObjectLinkingLayer(ExecutionSession* es) { - return new RTDyldObjectLinkingLayer(*es, []() { return llvm::make_unique(); }); + return new RTDyldObjectLinkingLayer(*es, []() { + return std::make_unique(); + }); } void LLVM_Hs_disposeObjectLayer(ObjectLayer* ol) { - delete ol; + // delete ol; } // Compile layer IRLayer* LLVM_Hs_createIRCompileLayer(ExecutionSession* es, ObjectLayer* baseLayer, LLVMTargetMachineRef tm) { - return new IRCompileLayer(*es, *baseLayer, SimpleCompiler(*unwrap(tm))); + return new IRCompileLayer(*es, *baseLayer, std::make_unique(SimpleCompiler(*unwrap(tm)))); } void LLVM_Hs_disposeIRLayer(IRLayer* il) { delete il; } +void LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_forCurrentProcess(JITDylib* dylib, LLVMTargetDataRef dataLayout) { + auto dataLayoutCpp = *unwrap(dataLayout); + ExitOnError ExitOnErr; + dylib->addGenerator( + ExitOnErr(orc::DynamicLibrarySearchGenerator::GetForCurrentProcess( + dataLayoutCpp.getGlobalPrefix()))); + dylib->addGenerator( + ExitOnErr(orc::DynamicLibrarySearchGenerator::Load( + "/usr/lib/libSystem.dylib", dataLayoutCpp.getGlobalPrefix()))); +} + +void LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_load(JITDylib* dylib, LLVMTargetDataRef dataLayout, const char* name) { + auto dataLayoutCpp = *unwrap(dataLayout); + ExitOnError ExitOnErr; + dylib->addGenerator( + ExitOnErr(orc::DynamicLibrarySearchGenerator::Load( + name, dataLayoutCpp.getGlobalPrefix()))); +} + // Warning: This consumes the module. -void LLVM_Hs_IRLayer_add(ThreadSafeContext* ctx, ExecutionSession* es, LLVMTargetDataRef dataLayout, IRLayer* il, LLVMModuleRef m) { - std::unique_ptr mod{unwrap(m)}; - if (mod->getDataLayout().isDefault()) { - mod->setDataLayout(*unwrap(dataLayout)); +void LLVM_Hs_IRLayer_addModule(ThreadSafeModule* tsm, JITDylib* dylib, LLVMTargetDataRef dataLayout, IRLayer* il) { + auto dataLayoutCpp = *unwrap(dataLayout); + tsm->withModuleDo([&](auto& module) { + if (module.getDataLayout().isDefault()) { + module.setDataLayout(dataLayoutCpp); + } + }); + // NOTE: Maybe try module cloning? + llvm::errs() << "LLVM_Hs_IRLayer_add: " << tsm->getModuleUnlocked() << "\n"; + if (Error err = il->add(*dylib, std::move(*tsm))) { + llvm::errs() << err << "\n"; + exit(1); } - if (Error err = il->add(es->getMainJITDylib(), ThreadSafeModule(std::move(mod), *ctx))) { +} + +JITDylib* LLVM_Hs_ExecutionSession_createJITDylib(ExecutionSession* es, const char* name) { + if (auto dylibOrErr = es->createJITDylib(name)) { + auto& dylib = *dylibOrErr; + return &dylib; + } else { + Error err = dylibOrErr.takeError(); + llvm::errs() << err << "\n"; + exit(1); + } +} + +JITDylib* LLVM_Hs_ExecutionSession_getJITDylibByName(ExecutionSession* es, const char* name) { + return es->getJITDylibByName(name); +} + +uintptr_t LLVM_Hs_ExecutionSession_lookup(ExecutionSession* es, JITDylib *dylib, const char* mangledName) { + llvm::errs() << "LLVM_Hs_ExecutionSession_lookup start\n"; + es->dump(llvm::errs()); + llvm::errs() << "LLVM_Hs_ExecutionSession_lookup next\n"; + if (auto symbolOrErr = es->lookup({dylib}, mangledName)) { + auto& symbol = *symbolOrErr; + llvm::errs() << "LLVM_Hs_ExecutionSession_lookup end\n"; + return (uintptr_t)symbol.getAddress(); + } else { + llvm::errs() << "LLVM_Hs_ExecutionSession_lookup error\n"; + Error err = symbolOrErr.takeError(); llvm::errs() << err << "\n"; exit(1); } } -uint64_t LLVM_Hs_ExecutionSession_lookup(ExecutionSession* es, const char* mangledName) { - if (auto symbolOrErr = es->lookup({&es->getMainJITDylib()}, mangledName)) { +LLVMJITEvaluatedSymbol LLVM_Hs_ExecutionSession_lookupSymbol(ExecutionSession* es, JITDylib *dylib, const char* mangledName) { + llvm::errs() << "LLVM_Hs_ExecutionSession_lookup start\n"; + // Printing here will show unresolved symbols. + // es->dump(llvm::errs()); + llvm::errs() << "LLVM_Hs_ExecutionSession_lookup next\n"; + if (auto symbolOrErr = es->lookup({dylib}, mangledName)) { + es->dump(llvm::errs()); auto& symbol = *symbolOrErr; - return symbol.getAddress(); + llvm::errs() << "LLVM_Hs_ExecutionSession_lookup end\n"; + return LLVMJITEvaluatedSymbol{ + symbol.getFlags().getRawFlagsValue(), + static_cast(symbol.getAddress())}; } else { Error err = symbolOrErr.takeError(); llvm::errs() << err << "\n"; diff --git a/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp b/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp index 9a6ab375..7d938d17 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp @@ -14,7 +14,9 @@ #include "llvm/Transforms/Instrumentation/MemorySanitizer.h" #include "llvm/Transforms/Instrumentation/ThreadSanitizer.h" #include "llvm/Transforms/Utils.h" +#include "llvm/LinkAllPasses.h" #include "llvm/CodeGen/Passes.h" +#include "llvm/CodeGen/TargetLowering.h" #include "llvm-c/Target.h" #include "llvm-c/Transforms/PassManagerBuilder.h" #include "llvm/Analysis/TargetLibraryInfo.h" @@ -47,11 +49,6 @@ inline LLVMTargetMachineRef wrap(const TargetMachine *P) { return reinterpret_cast(const_cast(P)); } -// Taken from llvm/lib/Transforms/IPO/PassManagerBuilder.cpp -inline PassManagerBuilder *unwrap(LLVMPassManagerBuilderRef P) { - return reinterpret_cast(P); -} - inline TargetLibraryInfoImpl *unwrap(LLVMTargetLibraryInfoRef P) { return reinterpret_cast(P); } @@ -63,7 +60,6 @@ extern "C" { #define LLVM_HS_FOR_EACH_PASS_WITHOUT_LLVM_C_BINDING(macro) \ macro(BreakCriticalEdges) \ macro(DeadCodeElimination) \ - macro(DeadInstElimination) \ macro(DemoteRegisterToMemory) \ macro(LCSSA) \ macro(LoopInstSimplify) \ @@ -124,17 +120,19 @@ void LLVM_Hs_AddGCOVProfilerPass( LLVMBool emitNotes, LLVMBool emitData, const char *version, - LLVMBool useCfgChecksum, LLVMBool noRedZone, - LLVMBool functionNamesInData + LLVMBool atomic, + const char *filter, + const char *exclude ) { - struct GCOVOptions options; + auto options = GCOVOptions::getDefault(); options.EmitNotes = emitNotes; options.EmitData = emitData; std::copy(version, version+4, options.Version); - options.UseCfgChecksum = useCfgChecksum; options.NoRedZone = noRedZone; - options.FunctionNamesInData = functionNamesInData; + options.Atomic = atomic; + options.Filter = filter; + options.Exclude = exclude; unwrap(PM)->add(createGCOVProfilerPass(options)); } @@ -153,10 +151,11 @@ void LLVM_Hs_AddAddressSanitizerModulePass( void LLVM_Hs_AddMemorySanitizerPass( LLVMPassManagerRef PM, LLVMBool trackOrigins, - LLVMBool recover, - LLVMBool kernel + LLVMBool recover, + LLVMBool kernel ) { - unwrap(PM)->add(createMemorySanitizerLegacyPassPass({trackOrigins, static_cast(recover), static_cast(kernel)})); + unwrap(PM)->add(createMemorySanitizerLegacyPassPass( + {trackOrigins, static_cast(recover), static_cast(kernel)})); } void LLVM_Hs_AddThreadSanitizerPass( @@ -169,6 +168,29 @@ void LLVM_Hs_AddBoundsCheckingPass(LLVMPassManagerRef PM) { unwrap(PM)->add(createBoundsCheckingLegacyPass()); } +// TODO(llvm-12): Confirm that these passes have been removed in LLVM 9 → LLVM 12. +/* +void LLVM_Hs_AddConstantPropagationPass(LLVMPassManagerRef PM) { + unwrap(PM)->add(createConstantPropagationPass()); +} + +void LLVM_Hs_AddDeadInstEliminationPass(LLVMPassManagerRef PM) { + unwrap(PM)->add(createDeadInstEliminationPass()); +} + +void LLVM_Hs_AddIPConstantPropagationPass(LLVMPassManagerRef PM) { + unwrap(PM)->add(createIPConstantPropagationPass()); +} + +void LLVM_Hs_AddInterproceduralConstantPropagationPass(LLVMPassManagerRef PM) { + unwrap(PM)->add(createInterproceduralConstantPropagationPass()); +} +*/ + +void LLVM_Hs_AddIPSCCPPass(LLVMPassManagerRef PM) { + unwrap(PM)->add(createIPSCCPPass()); +} + void LLVM_Hs_AddLoopVectorizePass( LLVMPassManagerRef PM, LLVMBool interleaveOnlyWhenForced, diff --git a/llvm-hs/src/LLVM/Internal/FFI/Target.h b/llvm-hs/src/LLVM/Internal/FFI/Target.h index bd323257..8da5b0a4 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Target.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Target.h @@ -26,7 +26,6 @@ macro(Object) #define LLVM_HS_FOR_EACH_TARGET_OPTION_FLAG(macro) \ - macro(PrintMachineCode) \ macro(UnsafeFPMath) \ macro(NoInfsFPMath) \ macro(NoNaNsFPMath) \ @@ -37,15 +36,31 @@ macro(GuaranteedTailCallOpt) \ macro(StackSymbolOrdering) \ macro(EnableFastISel) \ + macro(EnableGlobalISel) \ macro(UseInitArray) \ macro(DisableIntegratedAS) \ macro(RelaxELFRelocations) \ macro(FunctionSections) \ macro(DataSections) \ + macro(IgnoreXCOFFVisibility) \ macro(UniqueSectionNames) \ + macro(UniqueBasicBlockSectionNames) \ macro(TrapUnreachable) \ + macro(NoTrapAfterNoreturn) \ macro(EmulatedTLS) \ - macro(EnableIPRA) + macro(ExplicitEmulatedTLS) \ + macro(EnableIPRA) \ + macro(EmitStackSizeSection) \ + macro(EnableMachineOutliner) \ + macro(EnableMachineFunctionSplitter) \ + macro(SupportsDefaultOutlining) \ + macro(EmitAddrsig) \ + macro(EmitCallSiteInfo) \ + macro(SupportsDebugEntryValues) \ + macro(EnableDebugEntryValues) \ + macro(ValueTrackingVariableLocations) \ + macro(ForceDwarfFrameSection) \ + macro(XRayOmitFunctionIndex) \ typedef enum { #define ENUM_CASE(n) LLVM_Hs_TargetOptionFlag_ ## n, @@ -62,7 +77,6 @@ typedef enum { macro(MCSaveTempLabels) \ macro(MCUseDwarfDirectory) \ macro(MCIncrementalLinkerCompatible) \ - macro(MCPIECopyRelocations) \ macro(ShowMCEncoding) \ macro(ShowMCInst) \ macro(AsmVerbose) \ diff --git a/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp b/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp index e472a397..fe1f7224 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp @@ -183,22 +183,22 @@ static LLVM_Hs_DebuggerKind wrap(DebuggerKind x) { } } -static FPDenormal::DenormalMode unwrap(LLVM_Hs_FPDenormalMode x) { +static DenormalMode::DenormalModeKind unwrap(LLVM_Hs_FPDenormalMode x) { switch (x) { #define ENUM_CASE(x) \ case LLVM_Hs_FPDenormalMode_##x: \ - return FPDenormal::x; + return DenormalMode::DenormalModeKind::x; LLVM_HS_FOR_EACH_FP_DENORMAL_MODE(ENUM_CASE) #undef ENUM_CASE default: - return FPDenormal::DenormalMode(0); + return DenormalMode::DenormalModeKind(0); } } -static LLVM_Hs_FPDenormalMode wrap(FPDenormal::DenormalMode x) { +static LLVM_Hs_FPDenormalMode wrap(DenormalMode::DenormalModeKind x) { switch (x) { #define ENUM_CASE(x) \ - case FPDenormal::x: \ + case DenormalMode::DenormalModeKind::x: \ return LLVM_Hs_FPDenormalMode_##x; LLVM_HS_FOR_EACH_FP_DENORMAL_MODE(ENUM_CASE) #undef ENUM_CASE @@ -398,11 +398,15 @@ LLVM_Hs_DebuggerKind LLVM_Hs_GetDebuggerTuning(TargetOptions *to) { } void LLVM_Hs_SetFPDenormalMode(TargetOptions *to, LLVM_Hs_FPDenormalMode v) { - to->FPDenormalMode = unwrap(v); + auto denormalModeKind = unwrap(v); + DenormalMode denormalMode{denormalModeKind, denormalModeKind}; + to->setFPDenormalMode(denormalMode); } LLVM_Hs_FPDenormalMode LLVM_Hs_GetFPDenormalMode(TargetOptions *to) { - return wrap(to->FPDenormalMode); + auto denormalMode = to->getRawFPDenormalMode(); + assert(denormalMode.isSimple() && "Input and output kinds must match"); + return wrap(denormalMode.Input); } void LLVM_Hs_SetExceptionModel(TargetOptions *to, LLVM_Hs_ExceptionHandling v) { @@ -559,13 +563,13 @@ LLVMBool LLVM_Hs_TargetMachineEmit(LLVMTargetMachineRef T, LLVMModuleRef M, Mod->setDataLayout(TM->createDataLayout()); - TargetMachine::CodeGenFileType ft; + CodeGenFileType ft; switch (codegen) { case LLVMAssemblyFile: - ft = TargetMachine::CGFT_AssemblyFile; + ft = CGFT_AssemblyFile; break; default: - ft = TargetMachine::CGFT_ObjectFile; + ft = CGFT_ObjectFile; break; } if (TM->addPassesToEmitFile(pass, *OS, nullptr, ft)) { diff --git a/llvm-hs/src/LLVM/Internal/FFI/Transforms.hs b/llvm-hs/src/LLVM/Internal/FFI/Transforms.hs index 9c855ded..b649eb2f 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Transforms.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Transforms.hs @@ -25,7 +25,6 @@ cName n = "GlobalDeadCodeElimination" -> "GlobalDCE" "InductionVariableSimplify" -> "IndVarSimplify" "InternalizeFunctions" -> "Internalize" - "InterproceduralConstantPropagation" -> "IPConstantPropagation" "InterproceduralSparseConditionalConstantPropagation" -> "IPSCCP" "LoopClosedSingleStaticAssignment" -> "LCSSA" "LoopInvariantCodeMotion" -> "LICM" diff --git a/llvm-hs/src/LLVM/Internal/Instruction.hs b/llvm-hs/src/LLVM/Internal/Instruction.hs index 30682100..2164159a 100644 --- a/llvm-hs/src/LLVM/Internal/Instruction.hs +++ b/llvm-hs/src/LLVM/Internal/Instruction.hs @@ -34,7 +34,6 @@ import qualified LLVM.Internal.FFI.Instruction as FFI import qualified LLVM.Internal.FFI.Value as FFI import qualified LLVM.Internal.FFI.User as FFI import qualified LLVM.Internal.FFI.Builder as FFI -import qualified LLVM.Internal.FFI.Constant as FFI import qualified LLVM.Internal.FFI.BasicBlock as FFI import LLVM.Internal.Atomicity () @@ -302,7 +301,6 @@ $(do t <- typeOf i nOps <- liftIO $ FFI.getNumOperands (FFI.upCast i) let op n = decodeM =<< (liftIO $ FFI.getOperand (FFI.upCast i) n) - cop n = decodeM =<< (liftIO $ FFI.isAConstant =<< FFI.getOperand (FFI.upCast i) n) get_nsw b = liftIO $ decodeM =<< FFI.hasNoSignedWrap (FFI.upCast b) get_nuw b = liftIO $ decodeM =<< FFI.hasNoUnsignedWrap (FFI.upCast b) get_exact b = liftIO $ decodeM =<< FFI.isExact (FFI.upCast b) @@ -333,7 +331,12 @@ $(do "ExtractElement" -> [| op 1 |] "InsertElement" -> [| op 2 |] _ -> [|error "Index fields are only supported for 'ExtractElement' and 'InsertElement': " <> lrn|]) - "mask" -> ([], [| cop 2 |]) + "mask" -> + ([], [| do + n <- liftIO $ FFI.getShuffleVectorMaskSize i + a <- allocaArray n + liftIO $ FFI.getShuffleVectorMask i a + decodeM (n, a) |]) "aggregate" -> ([], [| op 0 |]) "metadata" -> ([], [| meta i |]) "iPredicate" -> ([], [| decodeM =<< liftIO (FFI.getICmpPredicate i) |]) @@ -458,6 +461,17 @@ $(do bs3' <- encodeM bs3 liftIO $ FFI.addIncoming i ivs3' bs3' ) + A.Select { A.condition' = c, A.trueValue = t, A.falseValue = f } -> do + c' <- encodeM c + t' <- encodeM t + f' <- encodeM f + i <- liftIO $ FFI.buildSelect builder c' t' f' s + return' i + A.Freeze { A.operand0 = op0, A.type' = t } -> do + op0' <- encodeM op0 + t' <- encodeM t + i <- liftIO $ FFI.buildFreeze builder op0' t' + return' i A.Call { A.tailCallKind = tck, A.callingConvention = cc, @@ -477,12 +491,6 @@ $(do cc <- encodeM cc liftIO $ FFI.setCallSiteCallingConvention i cc return' i - A.Select { A.condition' = c, A.trueValue = t, A.falseValue = f } -> do - c' <- encodeM c - t' <- encodeM t - f' <- encodeM f - i <- liftIO $ FFI.buildSelect builder c' t' f' s - return' i A.VAArg { A.argList = al, A.type' = t } -> do al' <- encodeM al t' <- encodeM t @@ -502,8 +510,8 @@ $(do A.ShuffleVector { A.operand0 = o0, A.operand1 = o1, A.mask = mask } -> do o0' <- encodeM o0 o1' <- encodeM o1 - mask' <- encodeM mask - i <- liftIO $ FFI.buildShuffleVector builder o0' o1' mask' s + (sizeMask, mask') <- encodeM mask + i <- liftIO $ FFI.buildShuffleVector builder o0' o1' mask' sizeMask s return' i A.ExtractValue { A.aggregate = a, A.indices' = is } -> do a' <- encodeM a @@ -588,8 +596,9 @@ $(do [p|A.ICmp{}|], [p|A.FCmp{}|], [p|A.Phi{}|], - [p|A.Call{}|], [p|A.Select{}|], + [p|A.Freeze{}|], + [p|A.Call{}|], [p|A.VAArg{}|], [p|A.ExtractElement{}|], [p|A.InsertElement{}|], diff --git a/llvm-hs/src/LLVM/Internal/Operand.hs b/llvm-hs/src/LLVM/Internal/Operand.hs index 5e4f9cb4..f0520ca6 100644 --- a/llvm-hs/src/LLVM/Internal/Operand.hs +++ b/llvm-hs/src/LLVM/Internal/Operand.hs @@ -9,6 +9,7 @@ ScopedTypeVariables, TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module LLVM.Internal.Operand where import LLVM.Prelude @@ -42,6 +43,7 @@ import LLVM.Internal.Metadata (getByteStringFromFFI) import qualified LLVM.AST as A hiding (GlobalVariable, Module, PointerType, type') import qualified LLVM.AST.Operand as A +import qualified LLVM.AST.Constant as A (Constant(Int, integerBits, integerValue)) import LLVM.Internal.FFI.LLVMCTypes (mdSubclassIdP) @@ -61,7 +63,7 @@ instance Applicative m => EncodeM m [A.DIFlag] FFI.DIFlags where A.Accessibility A.Public -> 3 A.FwdDecl -> 1 `shiftL` 2 A.AppleBlock -> 1 `shiftL` 3 - A.BlockByrefStruct -> 1 `shiftL` 4 + A.ReservedBit4 -> 1 `shiftL` 4 A.VirtualFlag -> 1 `shiftL` 5 A.Artificial -> 1 `shiftL` 6 A.Explicit -> 1 `shiftL` 7 @@ -78,7 +80,6 @@ instance Applicative m => EncodeM m [A.DIFlag] FFI.DIFlags where A.IntroducedVirtual -> 1 `shiftL` 18 A.BitField -> 1 `shiftL` 19 A.NoReturn -> 1 `shiftL` 20 - A.ArgumentNotModified -> 1 `shiftL` 21 A.TypePassByValue -> 1 `shiftL` 22 A.TypePassByReference -> 1 `shiftL` 23 A.EnumClass -> 1 `shiftL` 24 @@ -113,7 +114,6 @@ instance Applicative m => DecodeM m [A.DIFlag] FFI.DIFlags where flags = [ A.FwdDecl , A.AppleBlock - , A.BlockByrefStruct , A.VirtualFlag , A.Artificial , A.Explicit @@ -127,7 +127,6 @@ instance Applicative m => DecodeM m [A.DIFlag] FFI.DIFlags where , A.IntroducedVirtual , A.BitField , A.NoReturn - , A.ArgumentNotModified , A.TypePassByValue , A.TypePassByReference , A.EnumClass @@ -161,10 +160,12 @@ instance DecodeM DecodeAST A.Metadata (Ptr FFI.Metadata) where n <- liftIO $ FFI.isAMDNode md if n /= nullPtr then A.MDNode <$> decodeM n - else do v <- liftIO $ FFI.isAMDValue md - if v /= nullPtr - then A.MDValue <$> decodeM v - else throwM (DecodeException "Metadata was not one of [MDString, MDValue, MDNode]") + else do + v <- liftIO $ FFI.isAMDValue md + if v /= nullPtr + then A.MDValue <$> decodeM v + else do + throwM (DecodeException "Metadata was not one of [MDString, MDValue, MDNode]") instance DecodeM DecodeAST A.DINode (Ptr FFI.DINode) where decodeM diN = do @@ -172,20 +173,20 @@ instance DecodeM DecodeAST A.DINode (Ptr FFI.DINode) where case sId of [mdSubclassIdP|DIEnumerator|] -> A.DIEnumerator <$> decodeM (castPtr diN :: Ptr FFI.DIEnumerator) - [mdSubclassIdP|DIImportedEntity|] -> A.DIImportedEntity <$> decodeM (castPtr diN :: Ptr FFI.DIImportedEntity) - [mdSubclassIdP|DIObjCProperty|] -> A.DIObjCProperty <$> decodeM (castPtr diN :: Ptr FFI.DIObjCProperty) - [mdSubclassIdP|DISubrange|] -> A.DISubrange <$> decodeM (castPtr diN :: Ptr FFI.DISubrange) [mdSubclassIdP|DIBasicType|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) + [mdSubclassIdP|DICompileUnit|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) [mdSubclassIdP|DICompositeType|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) [mdSubclassIdP|DIDerivedType|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) - [mdSubclassIdP|DISubroutineType|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) + [mdSubclassIdP|DIFile|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) + [mdSubclassIdP|DIImportedEntity|] -> A.DIImportedEntity <$> decodeM (castPtr diN :: Ptr FFI.DIImportedEntity) [mdSubclassIdP|DILexicalBlock|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) [mdSubclassIdP|DILexicalBlockFile|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) - [mdSubclassIdP|DIFile|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) + [mdSubclassIdP|DIModule|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) [mdSubclassIdP|DINamespace|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) + [mdSubclassIdP|DIObjCProperty|] -> A.DIObjCProperty <$> decodeM (castPtr diN :: Ptr FFI.DIObjCProperty) [mdSubclassIdP|DISubprogram|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) - [mdSubclassIdP|DICompileUnit|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) - [mdSubclassIdP|DIModule|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) + [mdSubclassIdP|DISubrange|] -> A.DISubrange <$> decodeM (castPtr diN :: Ptr FFI.DISubrange) + [mdSubclassIdP|DISubroutineType|] -> A.DIScope <$> decodeM (castPtr diN :: Ptr FFI.DIScope) [mdSubclassIdP|DIGlobalVariable|] -> A.DIVariable <$> decodeM (castPtr diN :: Ptr FFI.DIVariable) [mdSubclassIdP|DILocalVariable|] -> A.DIVariable <$> decodeM (castPtr diN :: Ptr FFI.DIVariable) @@ -195,26 +196,70 @@ instance DecodeM DecodeAST A.DINode (Ptr FFI.DINode) where _ -> throwM (DecodeException ("Unknown subclass id for DINode: " <> show sId)) +instance EncodeM EncodeAST A.DICount (Ptr FFI.Metadata) where + encodeM count = do + case count of + A.DICountConstant i -> do + let constant = A.MDValue (A.ConstantOperand (A.Int { A.integerBits = 64, A.integerValue = toInteger i })) + encodeM constant + A.DICountVariable v -> do + encodeM (A.MDNode $ A.DINode . A.DIVariable <$> v) + +instance EncodeM EncodeAST A.DIBound (Ptr FFI.Metadata) where + encodeM bound = do + case bound of + A.DIBoundConstant i -> do + let constant = A.MDValue (A.ConstantOperand (A.Int { A.integerBits = 64, A.integerValue = toInteger i })) + encodeM constant + A.DIBoundVariable v -> do + encodeM (A.MDNode (A.DINode . A.DIVariable <$> v)) + A.DIBoundExpression e -> do + encodeM (A.MDNode (A.DIExpression <$> e)) + +instance DecodeM DecodeAST A.DICount (Ptr FFI.Metadata) where + decodeM m = do + c <- liftIO $ FFI.isAMDValue m + if c /= nullPtr + then do + (A.ConstantOperand A.Int { A.integerValue = i }) <- decodeM c + pure (A.DICountConstant (fromInteger i)) + else do + v <- decodeM =<< liftIO (FFI.isADIVariable m) + pure (A.DICountVariable v) + +instance DecodeM DecodeAST A.DIBound (Ptr FFI.Metadata) where + decodeM m = do + c <- liftIO $ FFI.isAMDValue m + if c /= nullPtr + then do + (A.ConstantOperand A.Int { A.integerValue = i }) <- decodeM c + pure (A.DIBoundConstant (fromInteger i)) + else do + v <- liftIO (FFI.isADIVariable m) + if v /= nullPtr + then do + v' <- decodeM =<< pure v + pure (A.DIBoundVariable v') + else do + e <- decodeM =<< liftIO (FFI.isADIExpression m) + pure (A.DIBoundExpression e) + instance EncodeM EncodeAST A.DISubrange (Ptr FFI.DISubrange) where encodeM (A.Subrange {..}) = do Context c <- gets encodeStateContext - case count of - A.DICountConstant i -> liftIO (FFI.getDISubrangeConstantCount c i lowerBound) - A.DICountVariable v -> do - v' <- encodeM v - liftIO (FFI.getDISubrangeVariableCount c v' lowerBound) + count' <- encodeM count + lowerBound' <- encodeM lowerBound + upperBound' <- encodeM upperBound + stride' <- encodeM stride + liftIO (FFI.getDISubrangeVariableFields c count' lowerBound' upperBound' stride') instance DecodeM DecodeAST A.DISubrange (Ptr FFI.DISubrange) where decodeM r = do - lowerBound <- liftIO (FFI.getDISubrangeLowerBound r) - hasConstantCount <- decodeM =<< liftIO (FFI.getDISubrangeHasConstantCount r) - if hasConstantCount - then do - count <- liftIO (FFI.getDISubrangeCountConstant r) - pure (A.Subrange (A.DICountConstant count) lowerBound) - else do - count <- decodeM =<< liftIO (FFI.getDISubrangeCountVariable r) - pure (A.Subrange (A.DICountVariable count) lowerBound) + count <- decodeM =<< liftIO (FFI.getDISubrangeCount r) + lowerBound <- decodeM =<< liftIO (FFI.getDISubrangeLowerBound r) + upperBound <- decodeM =<< liftIO (FFI.getDISubrangeUpperBound r) + stride <- decodeM =<< liftIO (FFI.getDISubrangeStride r) + pure (A.Subrange count lowerBound upperBound stride) instance EncodeM EncodeAST A.DIEnumerator (Ptr FFI.DIEnumerator) where encodeM (A.Enumerator {..}) = do @@ -293,13 +338,15 @@ instance DecodeM DecodeAST A.DIModule (Ptr FFI.DIModule) where let m = castPtr p :: Ptr FFI.DIModule configurationMacros <- decodeM =<< liftIO (FFI.getDIModuleConfigurationMacros m) includePath <- decodeM =<< liftIO (FFI.getDIModuleIncludePath m) - isysRoot <- decodeM =<< liftIO (FFI.getDIModuleISysRoot m) + apiNotesFile <- decodeM =<< liftIO (FFI.getDIModuleAPINotesFile m) + lineNo <- liftIO (FFI.getDIModuleLineNo m) pure A.Module { A.scope = scope , A.name = name , A.configurationMacros = configurationMacros , A.includePath = includePath - , A.isysRoot = isysRoot + , A.apiNotesFile = apiNotesFile + , A.lineNo = lineNo } instance EncodeM EncodeAST A.DIModule (Ptr FFI.DIModule) where @@ -308,9 +355,9 @@ instance EncodeM EncodeAST A.DIModule (Ptr FFI.DIModule) where name <- encodeM name configurationMacros <- encodeM configurationMacros includePath <- encodeM includePath - isysRoot <- encodeM isysRoot + apiNotesFile <- encodeM apiNotesFile Context c <- gets encodeStateContext - liftIO (FFI.getDIModule c scope name configurationMacros includePath isysRoot) + liftIO (FFI.getDIModule c scope name configurationMacros includePath apiNotesFile lineNo) genCodingInstance [t|A.DebugEmissionKind|] ''FFI.DebugEmissionKind [ (FFI.NoDebug, A.NoDebug) @@ -774,7 +821,7 @@ instance EncodeM EncodeAST A.DITemplateParameter (Ptr FFI.DITemplateParameter) w A.DITemplateValueParameter {..} -> do tag <- encodeM tag value <- encodeM value - FFI.upCast <$> liftIO (FFI.getDITemplateValueParameter c name' ty tag value) + FFI.upCast <$> liftIO (FFI.getDITemplateValueParameter c name' ty tag True value) instance DecodeM DecodeAST A.DITemplateParameter (Ptr FFI.DITemplateParameter) where decodeM p = do @@ -927,7 +974,10 @@ instance DecodeM DecodeAST A.CallableOperand (Ptr FFI.Value) where else Right <$> decodeM v instance EncodeM EncodeAST A.Operand (Ptr FFI.Value) where - encodeM (A.ConstantOperand c) = (FFI.upCast :: Ptr FFI.Constant -> Ptr FFI.Value) <$> encodeM c + encodeM (A.ConstantOperand c) = do + c' <- (encodeM :: A.Constant -> EncodeAST (Ptr FFI.Constant)) c + let v = (FFI.upCast :: Ptr FFI.Constant -> Ptr FFI.Value) c' + return v encodeM (A.LocalReference t n) = do lv <- refer encodeStateLocals n $ do lv <- do @@ -951,7 +1001,8 @@ instance EncodeM EncodeAST A.Metadata (Ptr FFI.Metadata) where encodeM (A.MDNode mdn) = (FFI.upCast :: Ptr FFI.MDNode -> Ptr FFI.Metadata) <$> encodeM mdn encodeM (A.MDValue v) = do v <- encodeM v - FFI.upCast <$> liftIO (FFI.mdValue v) + mdVal <- liftIO $ FFI.mdValue v + return $ FFI.upCast mdVal instance EncodeM EncodeAST A.CallableOperand (Ptr FFI.Value) where encodeM (Right o) = encodeM o @@ -994,8 +1045,10 @@ instance (MonadIO m, MonadState EncodeState m, MonadAnyCont IO m, EncodeM m a (P instance (MonadIO m, MonadAnyCont IO m, DecodeM m a (Ptr a')) => DecodeM m [a] (FFI.TupleArray a') where decodeM (FFI.TupleArray p) | p == nullPtr = pure [] - | otherwise = decodeArray FFI.getMDNodeNumOperands getOperand (FFI.upCast p) - where getOperand md i = (castPtr <$> FFI.getMDNodeOperand md i) :: IO (Ptr a') + | otherwise = do + decodeArray FFI.getMDNodeNumOperands getOperand (FFI.upCast p) + where + getOperand md i = (castPtr <$> FFI.getMDNodeOperand md i) :: IO (Ptr a') encodeDWOp :: A.DWOp -> [Word64] encodeDWOp op = diff --git a/llvm-hs/src/LLVM/Internal/OrcJIT.hs b/llvm-hs/src/LLVM/Internal/OrcJIT.hs index d37f2d70..416d91d0 100644 --- a/llvm-hs/src/LLVM/Internal/OrcJIT.hs +++ b/llvm-hs/src/LLVM/Internal/OrcJIT.hs @@ -1,6 +1,10 @@ {-# LANGUAGE MultiParamTypeClasses #-} module LLVM.Internal.OrcJIT where +-- FIXME(llvm-12): Clean up this file. +-- Most logic exists in llvm-hs/src/LLVM/Internal/OrcJITV2.hs now. Perhaps +-- consider combining the files. + import LLVM.Prelude import Control.Exception @@ -32,6 +36,8 @@ instance MonadIO m => DecodeM m MangledSymbol CString where newtype ExecutionSession = ExecutionSession (Ptr FFI.ExecutionSession) +newtype JITDylib = JITDylib (Ptr FFI.JITDylib) + -- | 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. @@ -70,6 +76,8 @@ newtype SymbolResolver = -- | Create a `FFI.SymbolResolver` that can be used with the JIT. withSymbolResolver :: ExecutionSession -> SymbolResolver -> (Ptr FFI.SymbolResolver -> IO a) -> IO a withSymbolResolver (ExecutionSession es) (SymbolResolver resolverFn) f = + error "NOTE(llvm-12): SymbolResolvers seem deprecated and this should never be called" + {- bracket (FFI.wrapSymbolResolverFn resolverFn') freeHaskellFunPtr $ \resolverPtr -> bracket (FFI.createLambdaResolver es resolverPtr) FFI.disposeSymbolResolver $ \resolver -> f resolver @@ -77,6 +85,7 @@ withSymbolResolver (ExecutionSession es) (SymbolResolver resolverFn) f = resolverFn' symbol result = do setSymbol <- encodeM =<< resolverFn =<< decodeM symbol setSymbol result + -} instance Monad m => EncodeM m JITSymbolFlags FFI.JITSymbolFlags where encodeM f = return $ foldr1 (.|.) [ @@ -120,6 +129,7 @@ instance (MonadIO m, MonadAnyCont IO m) => DecodeM m (Either JITSymbolError JITS flags <- decodeM rawFlags pure (Right (JITSymbol (fromIntegral addr) flags)) +{- instance MonadIO m => EncodeM m SymbolResolver (IORef [IO ()] -> Ptr FFI.ExecutionSession -> IO (Ptr FFI.SymbolResolver)) where encodeM (SymbolResolver resolverFn) = return $ \cleanups es -> do @@ -132,6 +142,7 @@ instance MonadIO m => EncodeM m (MangledSymbol -> IO (Either JITSymbolError JITS (\symbol result -> do setSymbol <- encodeM =<< callback =<< decodeM symbol setSymbol result) +-} -- | Allocate the resource and register it for cleanup. allocWithCleanup :: IORef [IO ()] -> IO a -> (a -> IO ()) -> IO a @@ -166,6 +177,7 @@ disposeExecutionSession (ExecutionSession es) = FFI.disposeExecutionSession es withExecutionSession :: (ExecutionSession -> IO a) -> IO a withExecutionSession = bracket createExecutionSession disposeExecutionSession +{- -- | Allocate a module key for a new module to add to the JIT. allocateModuleKey :: ExecutionSession -> IO FFI.ModuleKey allocateModuleKey (ExecutionSession es) = FFI.allocateVModule es @@ -179,3 +191,4 @@ releaseModuleKey (ExecutionSession es) k = FFI.releaseVModule es k -- `releaseModuleKey`. withModuleKey :: ExecutionSession -> (FFI.ModuleKey -> IO a) -> IO a withModuleKey es = bracket (allocateModuleKey es) (releaseModuleKey es) +-} diff --git a/llvm-hs/src/LLVM/Internal/OrcJIT/CompileLayer.hs b/llvm-hs/src/LLVM/Internal/OrcJIT/CompileLayer.hs index 1f4742ef..d78bbaa0 100644 --- a/llvm-hs/src/LLVM/Internal/OrcJIT/CompileLayer.hs +++ b/llvm-hs/src/LLVM/Internal/OrcJIT/CompileLayer.hs @@ -51,6 +51,8 @@ findSymbol compileLayer symbol exportedSymbolsOnly = flip runAnyContT return $ d (FFI.findSymbol (getCompileLayer compileLayer) symbol' exportedSymbolsOnly') FFI.disposeSymbol decodeM symbol +-- TODO(llvm-12): Consider removing this unused API? +{- -- | @'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. @@ -61,7 +63,10 @@ findSymbolIn compileLayer handle symbol exportedSymbolsOnly = flip runAnyContT r symbol <- anyContToM $ bracket (FFI.findSymbolIn (getCompileLayer compileLayer) handle symbol' exportedSymbolsOnly') FFI.disposeSymbol decodeM symbol +-} +-- TODO(llvm-12): Consider removing this unused API? +{- -- | Add a module to the 'CompileLayer'. The 'SymbolResolver' is used -- to resolve external symbols in the module. -- @@ -79,7 +84,10 @@ addModule compileLayer k mod = flip runAnyContT return $ do k mod' errMsg +-} +-- TODO(llvm-12): Consider removing this unused API? +{- -- | Remove a previously added module. removeModule :: CompileLayer l => l -> FFI.ModuleKey -> IO () removeModule compileLayer handle = @@ -94,6 +102,7 @@ withModule compileLayer k mod = bracket_ (addModule compileLayer k mod) (removeModule compileLayer k) +-} -- | Dispose of a 'CompileLayer'. This should called when the -- 'CompileLayer' is not needed anymore. diff --git a/llvm-hs/src/LLVM/Internal/OrcJIT/IRCompileLayer.hs b/llvm-hs/src/LLVM/Internal/OrcJIT/IRCompileLayer.hs index 415bafea..47d83442 100644 --- a/llvm-hs/src/LLVM/Internal/OrcJIT/IRCompileLayer.hs +++ b/llvm-hs/src/LLVM/Internal/OrcJIT/IRCompileLayer.hs @@ -46,7 +46,9 @@ newIRCompileLayer linkingLayer (TargetMachine tm) = flip runAnyContT return $ do (FFI.disposeCompileLayer . FFI.upCast) return (IRCompileLayer cl dl cleanups) +{- -- | 'bracket'-style wrapper around 'newIRCompileLayer' and 'disposeCompileLayer'. withIRCompileLayer :: LinkingLayer l => l -> TargetMachine -> (IRCompileLayer l -> IO a) -> IO a withIRCompileLayer linkingLayer tm = bracket (newIRCompileLayer linkingLayer tm) disposeCompileLayer +-} diff --git a/llvm-hs/src/LLVM/Internal/OrcJITV2.hs b/llvm-hs/src/LLVM/Internal/OrcJITV2.hs index e40aefec..8fbbfb41 100644 --- a/llvm-hs/src/LLVM/Internal/OrcJITV2.hs +++ b/llvm-hs/src/LLVM/Internal/OrcJITV2.hs @@ -1,40 +1,113 @@ module LLVM.Internal.OrcJITV2 ( ExecutionSession , withExecutionSession - , esLookup + , lookupSymbol + , createJITDylib + , getJITDylibByName + , addDynamicLibrarySearchGeneratorForCurrentProcess + , addDynamicLibrarySearchGenerator , ThreadSafeContext , withThreadSafeContext + , createThreadSafeContext + , disposeThreadSafeContext + , withThreadSafeModule + , createThreadSafeModule + , disposeThreadSafeModule , ObjectLayer + , createRTDyldObjectLinkingLayer + , disposeObjectLayer , withRTDyldObjectLinkingLayer , IRLayer , withIRCompileLayer - , irLayerAdd + , createIRCompileLayer + , disposeIRCompileLayer + , addModule + , mangleSymbol + -- , JITEvaluatedSymbol ) where +-- FIXME(llvm-12): Clean up this file. + import LLVM.Prelude import Control.Exception +import Control.Monad.AnyCont import Foreign.C import Foreign.Ptr -import LLVM.Internal.Module (Module, readModule, deleteModule) -import LLVM.Internal.OrcJIT (ExecutionSession(..), withExecutionSession) +import LLVM.Internal.Coding +import LLVM.Internal.Module (Module, readModule) +-- import LLVM.Internal.OrcJIT (ExecutionSession(..), JITDylib(..), withExecutionSession, MangledSymbol, JITSymbol, JITSymbolError) +import LLVM.Internal.OrcJIT (ExecutionSession(..), JITDylib(..), withExecutionSession, MangledSymbol) import LLVM.Internal.Target (TargetMachine(..)) import qualified LLVM.Internal.FFI.DataLayout as FFI +import qualified LLVM.Internal.FFI.OrcJIT as FFI import qualified LLVM.Internal.FFI.OrcJITV2 as FFI import qualified LLVM.Internal.FFI.Target as FFI +-- newtype JITEvaluatedSymbol = JITEvaluatedSymbol (Ptr FFI.JITEvaluatedSymbol, Word8) + newtype ThreadSafeContext = ThreadSafeContext (Ptr FFI.ThreadSafeContext) + +newtype ThreadSafeModule = ThreadSafeModule (Ptr FFI.ThreadSafeModule) + data IRLayer = IRLayer { _getIRLayer :: Ptr FFI.IRLayer , _getDataLayout :: Ptr FFI.DataLayout } newtype ObjectLayer = ObjectLayer (Ptr FFI.ObjectLayer) -esLookup :: ExecutionSession -> String -> IO Word64 -esLookup (ExecutionSession es) s = withCString s $ \cStr -> - FFI.esLookup es cStr +createJITDylib :: ExecutionSession -> String -> IO JITDylib +createJITDylib (ExecutionSession es) s = withCString s + (fmap JITDylib . FFI.createJITDylib es) + +getJITDylibByName :: ExecutionSession -> String -> IO JITDylib +getJITDylibByName (ExecutionSession es) s = withCString s + (fmap JITDylib . FFI.getJITDylibByName es) + +addDynamicLibrarySearchGeneratorForCurrentProcess :: IRLayer -> JITDylib -> IO () +addDynamicLibrarySearchGeneratorForCurrentProcess compileLayer (JITDylib dylib) = + FFI.addDynamicLibrarySearchGeneratorForCurrentProcess dylib (_getDataLayout compileLayer) + +addDynamicLibrarySearchGenerator :: IRLayer -> JITDylib -> String -> IO () +addDynamicLibrarySearchGenerator compileLayer (JITDylib dylib) s = withCString s $ \cStr -> + FFI.addDynamicLibrarySearchGenerator dylib (_getDataLayout compileLayer) cStr + +-- | Mangle a symbol according to the data layout stored in the +-- 'CompileLayer'. +mangleSymbol :: IRLayer -> ShortByteString -> IO MangledSymbol +mangleSymbol compileLayer symbol = flip runAnyContT return $ do + mangledSymbol <- alloca + symbol' <- encodeM symbol + anyContToM $ bracket + (FFI.getMangledSymbol mangledSymbol symbol' (_getDataLayout compileLayer)) + (\_ -> FFI.disposeMangledSymbol =<< peek mangledSymbol) + decodeM =<< peek mangledSymbol + +-- NOTE(llvm-12): This is commented because finding via *MangledSymbol* is not +-- yet supported. Supporting this function seems important and desirable because +-- "looking up mangled symbols" is platform-independent while "looking up +-- symbols directly via mangled string name" is not. +{- +-- | @'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 :: IRLayer -> MangledSymbol -> Bool -> IO (Either JITSymbolError JITSymbol) +findSymbolIn compileLayer symbol exportedSymbolsOnly = flip runAnyContT return $ do + symbol' <- encodeM symbol + exportedSymbolsOnly' <- encodeM exportedSymbolsOnly + symbol <- anyContToM $ bracket + (FFI.findSymbolIn compileLayer symbol' exportedSymbolsOnly') FFI.disposeSymbol + decodeM symbol +-} + +-- TODO(llvm-12): Consider removing "looking up symbols directly via mangled +-- string name", which is platform-dependent. See comment above on +-- @findSymbolIn@. Example: platform-dependent @main@ vs @_main@ symbol name. +lookupSymbol :: ExecutionSession -> JITDylib -> String -> IO WordPtr +lookupSymbol (ExecutionSession es) (JITDylib dylib) s = withCString s $ \cStr -> + FFI.lookupSymbol es dylib cStr createThreadSafeContext :: IO ThreadSafeContext createThreadSafeContext = ThreadSafeContext <$> FFI.createThreadSafeContext @@ -45,6 +118,17 @@ disposeThreadSafeContext (ThreadSafeContext ctx) = FFI.disposeThreadSafeContext withThreadSafeContext :: (ThreadSafeContext -> IO a) -> IO a withThreadSafeContext = bracket createThreadSafeContext disposeThreadSafeContext +createThreadSafeModule :: Module -> IO ThreadSafeModule +createThreadSafeModule m = do + mPtr <- readModule m + ThreadSafeModule <$> FFI.createThreadSafeModule mPtr + +disposeThreadSafeModule :: ThreadSafeModule -> IO () +disposeThreadSafeModule (ThreadSafeModule m) = FFI.disposeThreadSafeModule m + +withThreadSafeModule :: Module -> (ThreadSafeModule -> IO a) -> IO a +withThreadSafeModule m = bracket (createThreadSafeModule m) disposeThreadSafeModule + createRTDyldObjectLinkingLayer :: ExecutionSession -> IO ObjectLayer createRTDyldObjectLinkingLayer (ExecutionSession es) = ObjectLayer <$> FFI.createRTDyldObjectLinkingLayer es @@ -64,17 +148,15 @@ createIRCompileLayer (ExecutionSession es) (ObjectLayer ol) (TargetMachine tm) = il <- FFI.createIRCompileLayer es ol tm pure $ IRLayer il dl -disposeIRLayer :: IRLayer -> IO () -disposeIRLayer (IRLayer il _) = FFI.disposeIRLayer il +disposeIRCompileLayer :: IRLayer -> IO () +disposeIRCompileLayer (IRLayer il _) = FFI.disposeIRLayer il withIRCompileLayer :: ExecutionSession -> ObjectLayer -> TargetMachine -> (IRLayer -> IO a) -> IO a withIRCompileLayer es ol tm = bracket (createIRCompileLayer es ol tm) - disposeIRLayer + disposeIRCompileLayer -irLayerAdd :: ThreadSafeContext -> ExecutionSession -> IRLayer -> Module -> IO () -irLayerAdd (ThreadSafeContext ctx) (ExecutionSession es) (IRLayer il dl) m = do - mPtr <- readModule m - deleteModule m - FFI.irLayerAdd ctx es dl il mPtr +addModule :: ThreadSafeModule -> JITDylib -> IRLayer -> IO () +addModule (ThreadSafeModule m) (JITDylib dylib) (IRLayer il dl) = do + FFI.irLayerAddModule m dylib dl il diff --git a/llvm-hs/src/LLVM/Internal/Target.hs b/llvm-hs/src/LLVM/Internal/Target.hs index 7f2fe3c8..abb16c04 100644 --- a/llvm-hs/src/LLVM/Internal/Target.hs +++ b/llvm-hs/src/LLVM/Internal/Target.hs @@ -11,7 +11,6 @@ import LLVM.Prelude import Control.Monad.AnyCont import Control.Monad.Catch -import Control.Monad.Fail (MonadFail) import Control.Monad.IO.Class import Control.Monad.Trans.Except @@ -169,7 +168,6 @@ withTargetOptions = bracket FFI.createTargetOptions FFI.disposeTargetOptions . ( pokeTargetOptions :: TO.Options -> TargetOptions -> IO () pokeTargetOptions hOpts opts@(TargetOptions cOpts) = do mapM_ (\(c, ha) -> FFI.setTargetOptionFlag cOpts c =<< encodeM (ha hOpts)) [ - (FFI.targetOptionFlagPrintMachineCode, TO.printMachineCode), (FFI.targetOptionFlagUnsafeFPMath, TO.unsafeFloatingPointMath), (FFI.targetOptionFlagNoInfsFPMath, TO.noInfinitiesFloatingPointMath), (FFI.targetOptionFlagNoNaNsFPMath, TO.noNaNsFloatingPointMath), @@ -212,7 +210,6 @@ pokeMachineCodeOptions hOpts (MCTargetOptions cOpts) = (FFI.mcTargetOptionFlagMCSaveTempLabels, TO.saveTemporaryLabels), (FFI.mcTargetOptionFlagMCUseDwarfDirectory, TO.useDwarfDirectory), (FFI.mcTargetOptionFlagMCIncrementalLinkerCompatible, TO.incrementalLinkerCompatible), - (FFI.mcTargetOptionFlagMCPIECopyRelocations, TO.pieCopyRelocations), (FFI.mcTargetOptionFlagShowMCEncoding, TO.showMachineCodeEncoding), (FFI.mcTargetOptionFlagShowMCInst, TO.showMachineCodeInstructions), (FFI.mcTargetOptionFlagAsmVerbose, TO.verboseAssembly), @@ -223,8 +220,6 @@ pokeMachineCodeOptions hOpts (MCTargetOptions cOpts) = peekTargetOptions :: TargetOptions -> IO TO.Options peekTargetOptions opts@(TargetOptions tOpts) = do let gof = decodeM <=< FFI.getTargetOptionsFlag tOpts - printMachineCode - <- gof FFI.targetOptionFlagPrintMachineCode unsafeFloatingPointMath <- gof FFI.targetOptionFlagUnsafeFPMath noInfinitiesFloatingPointMath @@ -295,8 +290,6 @@ peekMachineCodeOptions (MCTargetOptions tOpts) = do <- gof FFI.mcTargetOptionFlagMCUseDwarfDirectory incrementalLinkerCompatible <- gof FFI.mcTargetOptionFlagMCIncrementalLinkerCompatible - pieCopyRelocations - <- gof FFI.mcTargetOptionFlagMCPIECopyRelocations showMachineCodeEncoding <- gof FFI.mcTargetOptionFlagShowMCEncoding showMachineCodeInstructions diff --git a/llvm-hs/src/LLVM/OrcJIT.hs b/llvm-hs/src/LLVM/OrcJIT.hs index 0f6bdd30..3edf89d1 100644 --- a/llvm-hs/src/LLVM/OrcJIT.hs +++ b/llvm-hs/src/LLVM/OrcJIT.hs @@ -3,9 +3,10 @@ module LLVM.OrcJIT ( CompileLayer, -- ** Add/remove modules ModuleKey, - addModule, - removeModule, - withModule, + -- TODO(llvm-12): Remove unused APIs. + -- LLVM.Internal.OrcJIT.CompileLayer.addModule, + -- removeModule, + -- withModule, -- ** Search for symbols JITSymbol(..), JITSymbolError(..), @@ -14,16 +15,17 @@ module LLVM.OrcJIT ( SymbolResolver(..), withSymbolResolver, -- ** Symbol mangling - MangledSymbol, - mangleSymbol, + MangledSymbol(..), + -- TODO: Remove prefix. + LLVM.Internal.OrcJITV2.mangleSymbol, -- ** ExecutionSession ExecutionSession, createExecutionSession, disposeExecutionSession, withExecutionSession, - allocateModuleKey, - releaseModuleKey, - withModuleKey, + -- allocateModuleKey, + -- releaseModuleKey, + -- withModuleKey, -- ** IRCompileLayer IRCompileLayer, newIRCompileLayer, @@ -58,6 +60,28 @@ module LLVM.OrcJIT ( newIndirectStubsManagerBuilder, disposeIndirectStubsManagerBuilder, withIndirectStubsManagerBuilder, + -- * OrcJITV2 + JITDylib(..), + lookupSymbol, + createJITDylib, + getJITDylibByName, + addDynamicLibrarySearchGeneratorForCurrentProcess, + addDynamicLibrarySearchGenerator, + ThreadSafeContext, + withThreadSafeContext, + createThreadSafeContext, + disposeThreadSafeContext, + withThreadSafeModule, + createThreadSafeModule, + disposeThreadSafeModule, + ObjectLayer, + createRTDyldObjectLinkingLayer, + disposeObjectLayer, + withRTDyldObjectLinkingLayer, + IRLayer, + createIRCompileLayer, + disposeIRCompileLayer, + LLVM.Internal.OrcJITV2.addModule, ) where import LLVM.Internal.OrcJIT @@ -66,3 +90,4 @@ import LLVM.Internal.OrcJIT.LinkingLayer import LLVM.Internal.OrcJIT.CompileOnDemandLayer import LLVM.Internal.OrcJIT.IRCompileLayer import LLVM.Internal.OrcJIT.IRTransformLayer +import LLVM.Internal.OrcJITV2 diff --git a/llvm-hs/src/LLVM/OrcJIT/CompileLayer.hs b/llvm-hs/src/LLVM/OrcJIT/CompileLayer.hs index 1ecfe3a4..7758f890 100644 --- a/llvm-hs/src/LLVM/OrcJIT/CompileLayer.hs +++ b/llvm-hs/src/LLVM/OrcJIT/CompileLayer.hs @@ -2,10 +2,11 @@ module LLVM.OrcJIT.CompileLayer ( CompileLayer(..) , mangleSymbol , findSymbol - , findSymbolIn - , addModule - , removeModule - , withModule + -- TODO(llvm-12): Remove unused APIs. + -- , findSymbolIn + -- , addModule + -- , removeModule + -- , withModule , disposeCompileLayer ) where diff --git a/llvm-hs/src/LLVM/Target/Options.hs b/llvm-hs/src/LLVM/Target/Options.hs index 98fa6600..fa731d61 100644 --- a/llvm-hs/src/LLVM/Target/Options.hs +++ b/llvm-hs/src/LLVM/Target/Options.hs @@ -66,7 +66,6 @@ data ExceptionHandling -- | The options of a 'LLVM.Target.TargetOptions' -- data Options = Options { - printMachineCode :: Bool, unsafeFloatingPointMath :: Bool, noInfinitiesFloatingPointMath :: Bool, noNaNsFloatingPointMath :: Bool, @@ -109,7 +108,6 @@ data MachineCodeOptions = MachineCodeOptions { saveTemporaryLabels :: Bool, useDwarfDirectory :: Bool, incrementalLinkerCompatible :: Bool, - pieCopyRelocations :: Bool, showMachineCodeEncoding :: Bool, showMachineCodeInstructions :: Bool, verboseAssembly :: Bool, diff --git a/llvm-hs/src/LLVM/Transforms.hs b/llvm-hs/src/LLVM/Transforms.hs index d5a65204..7e595f4f 100644 --- a/llvm-hs/src/LLVM/Transforms.hs +++ b/llvm-hs/src/LLVM/Transforms.hs @@ -17,16 +17,15 @@ data Pass | BreakCriticalEdges -- | can use a 'LLVM.Target.TargetMachine' | CodeGenPrepare - | ConstantPropagation | CorrelatedValuePropagation | DeadCodeElimination - | DeadInstructionElimination | DeadStoreElimination | DemoteRegisterToMemory | EarlyCommonSubexpressionElimination | GlobalValueNumbering { noLoads :: Bool } | InductionVariableSimplify | InstructionCombining + | InstructionSimplify | JumpThreading | LoopClosedSingleStaticAssignment | LoopInvariantCodeMotion @@ -68,7 +67,6 @@ data Pass } | GlobalDeadCodeElimination | InternalizeFunctions { exportList :: [String] } - | InterproceduralConstantPropagation | InterproceduralSparseConditionalConstantPropagation | MergeFunctions | PartialInlining @@ -90,9 +88,10 @@ data Pass emitNotes :: Bool, emitData :: Bool, version :: GCOVVersion, - useCfgChecksum :: Bool, noRedZone :: Bool, - functionNamesInData :: Bool + atomic :: Bool, + filter :: String, + exclude :: String } | AddressSanitizer | AddressSanitizerModule @@ -122,9 +121,10 @@ defaultGCOVProfiler = GCOVProfiler { emitNotes = True, emitData = True, version = GCOVVersion "402*", - useCfgChecksum = False, noRedZone = False, - functionNamesInData = True + atomic = True, + LLVM.Transforms.filter = "", + exclude = "" } -- | Defaults for 'AddressSanitizer'. diff --git a/llvm-hs/test/LLVM/Test/FunctionAttribute.hs b/llvm-hs/test/LLVM/Test/FunctionAttribute.hs index dbc1344a..c6343834 100644 --- a/llvm-hs/test/LLVM/Test/FunctionAttribute.hs +++ b/llvm-hs/test/LLVM/Test/FunctionAttribute.hs @@ -26,47 +26,47 @@ import qualified Data.ByteString.Short as B instance Arbitrary FunctionAttribute where arbitrary = oneof - [ return NoReturn - , return NoUnwind - , return ReadNone - , return ReadOnly + [ return AlwaysInline + , return ArgMemOnly + , return Builtin + , return Cold + , return Convergent + , return InaccessibleMemOnly + , return InaccessibleMemOrArgMemOnly + , return InlineHint + , return JumpTable + , return MinimizeSize + , return Naked + , return NoBuiltin + , return NoDuplicate + , return NoFree + , return NoImplicitFloat , return NoInline + , return NonLazyBind , return NoRecurse - , return AlwaysInline - , return MinimizeSize + , return NoRedZone + , return NoReturn + , return NoUnwind , return OptimizeForSize , return OptimizeNone + , return ReadNone + , return ReadOnly + , return ReturnsTwice + , return SafeStack + , return SanitizeAddress + , return SanitizeHWAddress + , return SanitizeMemory + , return SanitizeThread + , return Speculatable , return StackProtect , return StackProtectReq , return StackProtectStrong , return StrictFP - , return NoRedZone - , return NoImplicitFloat - , return Naked - , return InlineHint - , StackAlignment <$> elements (map (2^) [0..8 :: Int]) - , return ReturnsTwice , return UWTable - , return NonLazyBind - , return Builtin - , return NoBuiltin - , return Cold - , return JumpTable - , return NoDuplicate - , return NoFree - , return SanitizeAddress - , return SanitizeHWAddress - , return SanitizeThread - , return SanitizeMemory + , return WriteOnly + , StackAlignment <$> elements (map (2^) [0..8 :: Int]) , StringAttribute <$> (B.pack <$> arbitrary) <*> (B.pack <$> arbitrary) , suchThat (AllocSize <$> arbitrary <*> arbitrary) (/= AllocSize 0 (Just 0)) - , return WriteOnly - , return ArgMemOnly - , return Convergent - , return InaccessibleMemOnly - , return InaccessibleMemOrArgMemOnly - , return SafeStack - , return Speculatable ] shrink = \case diff --git a/llvm-hs/test/LLVM/Test/Instructions.hs b/llvm-hs/test/LLVM/Test/Instructions.hs index d279510b..474430e4 100644 --- a/llvm-hs/test/LLVM/Test/Instructions.hs +++ b/llvm-hs/test/LLVM/Test/Instructions.hs @@ -58,7 +58,7 @@ tests = testGroup "Instructions" [ mStr = "; ModuleID = ''\n\ \source_filename = \"\"\n\ \\n\ - \define void @0(i32, float, i32*, i64, i1, <2 x i32>, { i32, i32 }) {\n\ + \define void @0(i32 %0, float %1, i32* %2, i64 %3, i1 %4, <2 x i32> %5, { i32, i32 } %6) {\n\ \ " <> namedInstrS <> "\n\ \ ret void\n\ \}\n" @@ -266,10 +266,10 @@ tests = testGroup "Instructions" [ Alloca { allocatedType = i32, numElements = Nothing, - alignment = 0, + alignment = 4, metadata = [] }, - "alloca i32"), + "alloca i32, align 4"), ("alloca tricky", Alloca { allocatedType = IntegerType 7, @@ -283,19 +283,19 @@ tests = testGroup "Instructions" [ volatile = False, address = a 2, maybeAtomicity = Nothing, - alignment = 0, + alignment = 4, metadata = [] }, - "load i32, i32* %2"), + "load i32, i32* %2, align 4"), ("volatile", Load { volatile = True, address = a 2, maybeAtomicity = Nothing, - alignment = 0, + alignment = 4, metadata = [] }, - "load volatile i32, i32* %2"), + "load volatile i32, i32* %2, align 4"), ("acquire", Load { volatile = False, @@ -477,7 +477,7 @@ tests = testGroup "Instructions" [ ShuffleVector { operand0 = a 5, operand1 = a 5, - mask = C.Vector [ C.Int 32 p | p <- [0..1] ], + mask = [0..1], metadata = [] }, "shufflevector <2 x i32> %5, <2 x i32> %5, <2 x i32> "), @@ -565,10 +565,10 @@ tests = testGroup "Instructions" [ address = a 2, value = a 0, maybeAtomicity = Nothing, - alignment = 0, + alignment = 4, metadata = [] }, - "store i32 %0, i32* %2"), + "store i32 %0, i32* %2, align 4"), ("fence", Do $ Fence { atomicity = (System, Acquire), @@ -763,7 +763,7 @@ tests = testGroup "Instructions" [ volatile = False, address = ConstantOperand (C.GlobalReference (ptr (ptr i8)) (UnName 0)), maybeAtomicity = Nothing, - alignment = 0, + alignment = 8, metadata = [] } ] ( @@ -779,14 +779,13 @@ tests = testGroup "Instructions" [ ] } ], --- \ indirectbr i8* null, [label %foo]\n\ "; ModuleID = ''\n\ \source_filename = \"\"\n\ \\n\ \@0 = global i8* blockaddress(@foo, %2)\n\ \\n\ \define void @foo() {\n\ - \ %1 = load i8*, i8** @0\n\ + \ %1 = load i8*, i8** @0, align 8\n\ \ indirectbr i8* %1, [label %2]\n\ \\n\ \2: ; preds = %0\n\ @@ -844,7 +843,7 @@ tests = testGroup "Instructions" [ "; ModuleID = ''\n\ \source_filename = \"\"\n\ \\n\ - \define void @0(i32, i16) personality void (i32, i16)* @0 {\n\ + \define void @0(i32 %0, i16 %1) personality void (i32, i16)* @0 {\n\ \ invoke void @0(i32 4, i16 8)\n\ \ to label %foo unwind label %bar\n\ \\n\ diff --git a/llvm-hs/test/LLVM/Test/Instrumentation.hs b/llvm-hs/test/LLVM/Test/Instrumentation.hs index 12e822aa..9198d903 100644 --- a/llvm-hs/test/LLVM/Test/Instrumentation.hs +++ b/llvm-hs/test/LLVM/Test/Instrumentation.hs @@ -7,6 +7,7 @@ import Test.Tasty.HUnit import LLVM.Test.Support import Control.Monad.Trans.Except +import Control.Monad.Except (catchError) import Control.Monad.IO.Class import Data.Functor hiding (void) @@ -25,6 +26,7 @@ import LLVM.AST.Type import LLVM.AST.Name import LLVM.AST.AddrSpace import LLVM.AST.DataLayout +import LLVM.Triple import qualified LLVM.AST.IntegerPredicate as IPred import qualified LLVM.AST.Linkage as L import qualified LLVM.AST.Visibility as V @@ -33,6 +35,8 @@ import qualified LLVM.AST.Attribute as A import qualified LLVM.AST.Global as G import qualified LLVM.AST.Constant as C +import Debug.Trace + instrument :: PassSetSpec -> A.Module -> IO A.Module instrument s m = withContext $ \context -> withModuleFromAST context m $ \mIn' -> do withPassManager s $ \pm -> runPassManager pm mIn' @@ -144,23 +148,41 @@ ast = do } ] -tests = testGroup "Instrumentation" [ +isMemorySanitizerSupported :: IO Bool +isMemorySanitizerSupported = do + triple <- getProcessTargetTriple + let ~(Right triple') = runExcept (parseTriple triple) + let os' = os triple' + return $ Set.member os' (Set.fromList [FreeBSD, NetBSD, Linux]) + +instrumentationPasses :: [(TestName, Pass, IO Bool)] +instrumentationPasses = [ + ("GCOVProfiler", defaultGCOVProfiler, return True), + ("AddressSanitizer", defaultAddressSanitizer, return True), + ("AddressSanitizerModule", defaultAddressSanitizerModule, return True), + ("ThreadSanitizer", defaultThreadSanitizer, return True), + ("BoundsChecking", BoundsChecking, return True), + ("MemorySanitizer", defaultMemorySanitizer, isMemorySanitizerSupported) + ] + +tests = + testGroup "Instrumentation" [ testGroup "basic" [ testCase n $ do - triple <- getProcessTargetTriple - withTargetLibraryInfo triple $ \tli -> do - dl <- withHostTargetMachineDefault getTargetMachineDataLayout - ast <- ast - ast' <- instrument (defaultPassSetSpec { transforms = [p], dataLayout = Just dl, targetLibraryInfo = Just tli }) ast - let names ast = [ n | GlobalDefinition d <- moduleDefinitions ast, Name n <- return (G.name d) ] - (names ast') `List.intersect` (names ast) @?= names ast - | (n,p) <- [ - ("GCOVProfiler", defaultGCOVProfiler), - ("AddressSanitizer", defaultAddressSanitizer), - ("AddressSanitizerModule", defaultAddressSanitizerModule), - ("MemorySanitizer", defaultMemorySanitizer), - ("ThreadSanitizer", defaultThreadSanitizer), - ("BoundsChecking", BoundsChecking)--, + shouldTestPass' <- shouldTestPass + if not shouldTestPass' + then return () + else do + cpu <- getHostCPUName + triple <- getProcessTargetTriple + bool <- isMemorySanitizerSupported + withTargetLibraryInfo triple $ \tli -> do + dl <- withHostTargetMachineDefault getTargetMachineDataLayout + ast <- ast + ast' <- instrument (defaultPassSetSpec { transforms = [p], dataLayout = Just dl, targetLibraryInfo = Just tli }) ast + let names ast = [ n | GlobalDefinition d <- moduleDefinitions ast, Name n <- return (G.name d) ] + names ast' `List.intersect` names ast @?= names ast + | + (n, p, shouldTestPass) <- instrumentationPasses ] - ] - ] + ] diff --git a/llvm-hs/test/LLVM/Test/Metadata.hs b/llvm-hs/test/LLVM/Test/Metadata.hs index b78eecea..88177dc3 100644 --- a/llvm-hs/test/LLVM/Test/Metadata.hs +++ b/llvm-hs/test/LLVM/Test/Metadata.hs @@ -249,12 +249,16 @@ instance Arbitrary DIFile where O.File <$> arbitrarySbs <*> arbitrarySbs <*> arbitrary instance Arbitrary DISubrange where - arbitrary = Subrange <$> arbitrary <*> arbitrary + arbitrary = Subrange <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary DICount where - -- TODO Include DICountVariable + -- TODO: Also generate non-trivial DICountVariable case. arbitrary = DICountConstant <$> arbitrary +instance Arbitrary DIBound where + -- TODO: Also generate non-trivial DIBoundVariable, DIBoundExpression cases. + arbitrary = DIBoundConstant <$> arbitrary + instance Arbitrary DIEnumerator where arbitrary = Enumerator <$> arbitrary <*> arbitrary <*> arbitrarySbs @@ -263,7 +267,7 @@ instance Arbitrary DINode where oneof [ DISubrange <$> arbitrary , DIEnumerator <$> arbitrary - -- TODO: Add missing constructors + -- TODO: Also generate non-trivial cases. ] roundtripDIBasicType :: TestTree @@ -462,7 +466,6 @@ instance Arbitrary A.DIFlag where , QC.elements [ A.FwdDecl , A.AppleBlock - , A.BlockByrefStruct , A.VirtualFlag , A.Artificial , A.Explicit @@ -476,7 +479,6 @@ instance Arbitrary A.DIFlag where , A.IntroducedVirtual , A.BitField , A.NoReturn - , A.ArgumentNotModified , A.TypePassByValue , A.TypePassByReference , A.EnumClass @@ -516,7 +518,6 @@ genDIFlags = do flags = [ A.FwdDecl , A.AppleBlock - , A.BlockByrefStruct , A.VirtualFlag , A.Artificial , A.Explicit @@ -530,7 +531,6 @@ genDIFlags = do , A.IntroducedVirtual , A.BitField , A.NoReturn - , A.ArgumentNotModified , A.TypePassByValue , A.TypePassByReference , A.EnumClass @@ -612,7 +612,7 @@ instance Arbitrary Virtuality where arbitrary = QC.elements [A.NoVirtuality, A.Virtual, A.PureVirtual] roundtripDITemplateParameter :: TestTree -roundtripDITemplateParameter = testProperty "rountrip DITemplateParameter" $ \diType -> +roundtripDITemplateParameter = testProperty "roundtrip DITemplateParameter" $ \diType -> forAll (genDITemplateParameter (MDValue (ConstantOperand (C.Int 32 1))) (MDRef tyID)) $ \param -> ioProperty $ withContext $ \context -> runEncodeAST context $ do let mod = defaultModule @@ -638,7 +638,7 @@ genDITemplateParameter value ty = ] roundtripDINamespace :: TestTree -roundtripDINamespace = testProperty "rountrip DINamespace" $ \diFile -> +roundtripDINamespace = testProperty "roundtrip DINamespace" $ \diFile -> forAll (genDINamespace (MDRef fileID)) $ \diNamespace -> ioProperty $ withContext $ \context -> runEncodeAST context $ do let mod = defaultModule diff --git a/llvm-hs/test/LLVM/Test/Module.hs b/llvm-hs/test/LLVM/Test/Module.hs index 9f082414..3f0ef1eb 100644 --- a/llvm-hs/test/LLVM/Test/Module.hs +++ b/llvm-hs/test/LLVM/Test/Module.hs @@ -307,7 +307,6 @@ tests = testGroup "Module" [ \\t.size\tmain, .Lfunc_end0-main\n\ \\t.cfi_endproc\n\ \\n\ - \\n\ \\t.section\t\".note.GNU-stack\",\"\",@progbits\n" ], @@ -392,7 +391,7 @@ tests = testGroup "Module" [ let s = "; ModuleID = ''\n\ \source_filename = \"\"\n\ \\n\ - \define void @bar(metadata) {\n\ + \define void @bar(metadata %0) {\n\ \ ret void\n\ \}\n" ast = Module "" "" Nothing Nothing [ diff --git a/llvm-hs/test/LLVM/Test/Optimization.hs b/llvm-hs/test/LLVM/Test/Optimization.hs index 47e9d6f1..ed54cae3 100644 --- a/llvm-hs/test/LLVM/Test/Optimization.hs +++ b/llvm-hs/test/LLVM/Test/Optimization.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} module LLVM.Test.Optimization where import Test.Tasty @@ -29,11 +30,22 @@ import qualified LLVM.AST.CallingConvention as CC import qualified LLVM.AST.Attribute as A import qualified LLVM.AST.Global as G import qualified LLVM.AST.Constant as C +import qualified LLVM.Internal.Module as M (readModule) +import qualified LLVM.Internal.FFI.Module as M (dumpModule) import qualified LLVM.Relocation as R import qualified LLVM.CodeModel as CM import qualified LLVM.CodeGenOpt as CGO +import Debug.Trace + +-- TODO(llvm-12): This utility for dumping a module might be useful. +-- Consider moving to library code or deleting it from this test. +dumpModule' :: A.Module -> IO () +dumpModule' m = withContext $ \context -> withModuleFromAST context m $ \m' -> do + mPtr <- M.readModule m' + M.dumpModule mPtr + handAST = Module "" "" Nothing Nothing [ GlobalDefinition $ functionDefaults { @@ -96,13 +108,27 @@ handAST = FunctionAttributes (A.GroupID 0) [A.NoUnwind, A.ReadNone, A.UWTable] ] -isVectory :: A.Module -> Assertion -isVectory Module { moduleDefinitions = ds } = - (@? "Module is not vectory") $ not $ null [ i - | GlobalDefinition (Function { G.basicBlocks = b }) <- ds, - BasicBlock _ is _ <- b, - _ := i@(ExtractElement {}) <- is - ] +pattern LLVMLoopIsVectorizedMetadata :: Integer -> Definition +pattern LLVMLoopIsVectorizedMetadata i <- MetadataNodeDefinition _ (MDTuple [ + Just (MDString "llvm.loop.isvectorized"), + Just (MDValue (ConstantOperand C.Int {C.integerBits = 32, C.integerValue = i})) + ]) + +isVectorized :: A.Module -> Assertion +isVectorized mod@Module { moduleDefinitions = defs } = do + let assertHasVectorTypedValues = + (@? "Module contains no vector-typed phi instructions") $ + not $ null [ i + | GlobalDefinition Function { G.basicBlocks = b } <- defs, + BasicBlock _ is _ <- b, + _ := i@Phi { type' = VectorType _ _ } <- is + ] + let assertHasVectorizedMetadata = + (@? "Module is missing 'llvm.loop.isvectorized' metadata") $ + not $ null [ 1 + | LLVMLoopIsVectorizedMetadata 1 <- defs + ] + assertHasVectorTypedValues <> assertHasVectorizedMetadata optimize :: PassSetSpec -> A.Module -> IO A.Module optimize pss m = withContext $ \context -> withModuleFromAST context m $ \mIn' -> do @@ -130,49 +156,42 @@ tests = testGroup "Optimization" [ ], testGroup "individual" [ - testCase "ConstantPropagation" $ do - mOut <- optimize defaultPassSetSpec { transforms = [T.ConstantPropagation] } handAST - - mOut @?= Module "" "" Nothing Nothing [ - GlobalDefinition $ functionDefaults { - G.returnType = i32, - G.name = Name "foo", - G.parameters = ([Parameter i32 (Name "x") []], False), - G.functionAttributes = [Left (A.GroupID 0)], - G.basicBlocks = [ - BasicBlock (UnName 0) [] (Do $ Br (Name "here") []), - BasicBlock (Name "here") [] ( - Do $ CondBr { - condition = ConstantOperand (C.Int 1 1), - trueDest = Name "take", - falseDest = Name "done", - metadata' = [] - } - ), - BasicBlock (Name "take") [ - UnName 1 := Sub { - nsw = False, - nuw = False, - operand0 = LocalReference i32 (Name "x"), - operand1 = LocalReference i32 (Name "x"), - metadata = [] - } - ] ( - Do $ Br (Name "done") [] - ), - BasicBlock (Name "done") [ - Name "r" := Phi { - type' = i32, - incomingValues = [(LocalReference i32 (UnName 1), Name "take"),(ConstantOperand (C.Int 32 57), Name "here")], - metadata = [] - } - ] ( - Do $ Ret (Just (LocalReference i32 (Name "r"))) [] - ) - ] - }, - FunctionAttributes (A.GroupID 0) [A.NoUnwind, A.ReadNone, A.UWTable] - ], + testCase "InstSimplify" $ do + let + mIn = Module "" "" Nothing Nothing [ + GlobalDefinition $ functionDefaults { + G.returnType = i32, + G.name = Name "foo", + G.parameters = ([Parameter i32 (Name "x") []], False), + G.functionAttributes = [Left (A.GroupID 0)], + G.basicBlocks = [ + BasicBlock (UnName 0) [] (Do $ Br (Name "here") []), + BasicBlock (Name "here") [] ( + Do $ CondBr { + condition = ConstantOperand (C.Int 1 1), + trueDest = Name "take", + falseDest = Name "done", + metadata' = [] + } + ), + BasicBlock (Name "take") [] ( + Do $ Br (Name "done") [] + ), + BasicBlock (Name "done") [ + Name "r" := Phi { + type' = i32, + incomingValues = [(ConstantOperand (C.Int 32 0), Name "take"), (ConstantOperand (C.Int 32 57), Name "here")], + metadata = [] + } + ] ( + Do $ Ret (Just (LocalReference i32 (Name "r"))) [] + ) + ] + }, + FunctionAttributes (A.GroupID 0) [A.NoUnwind, A.ReadNone, A.UWTable] + ] + mOut <- optimize defaultPassSetSpec { transforms = [T.InstructionSimplify] } handAST + mOut @?= mIn, testCase "SLPVectorization" $ do let @@ -264,7 +283,7 @@ tests = testGroup "Optimization" [ ] [], UnName 2 := GetElementPtr True (ConstantOperand (C.GlobalReference (PointerType (A.T.ArrayType 2048 i32) (AddrSpace 0)) (Name "a"))) [ ConstantOperand (C.Int 64 0), - (LocalReference i64 (Name "indvars.iv")) + LocalReference i64 (Name "indvars.iv") ] [], UnName 3 := Load False (LocalReference (ptr i32) (UnName 2)) Nothing 4 [], UnName 4 := Trunc (LocalReference i64 (Name "indvars.iv")) i32 [], @@ -292,7 +311,7 @@ tests = testGroup "Optimization" [ dataLayout = moduleDataLayout mIn, targetMachine = Just tm }) mIn - isVectory mOut, + isVectorized mOut, testCase "LowerInvoke" $ do -- This test doesn't test much about what LowerInvoke does, just that it seems to work. diff --git a/llvm-hs/test/LLVM/Test/OrcJIT.hs b/llvm-hs/test/LLVM/Test/OrcJIT.hs index b880705b..eefef6b7 100644 --- a/llvm-hs/test/LLVM/Test/OrcJIT.hs +++ b/llvm-hs/test/LLVM/Test/OrcJIT.hs @@ -89,6 +89,10 @@ moduleTransform passmanagerSuccessful modulePtr = do tests :: TestTree tests = testGroup "OrcJit" [ + -- FIXME(llvm-12): Re-enable tests. + -- Tests are temporarily disabled until they are rewritten using OrcJIT V2 APIs. + -- API usages to be updated: withModuleKey, withSymbolResolver, etc. + {- testCase "eager compilation" $ do resolvers <- newIORef Map.empty withTestModule $ \mod -> @@ -173,18 +177,26 @@ tests = Right (JITSymbol mainFn _) <- LL.findSymbolIn linkingLayer k "main" True result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) result @?= 38, + -} testCase "OrcV2" $ do - withTest2Module $ \mod -> + withTest2Module $ \m -> withHostTargetMachine Reloc.PIC CodeModel.Default CodeGenOpt.Default $ \tm -> - OrcV2.withExecutionSession $ \es -> - OrcV2.withThreadSafeContext $ \ctx -> - OrcV2.withRTDyldObjectLinkingLayer es $ \ol -> - OrcV2.withIRCompileLayer es ol tm $ \il -> do - dl <- getTargetMachineDataLayout tm - OrcV2.irLayerAdd ctx es il mod - addr <- OrcV2.esLookup es "main" - let mainFn = mkMain (castPtrToFunPtr $ wordPtrToPtr $ fromIntegral addr) - result <- mainFn - result @?= 42 + OrcV2.withExecutionSession $ \es -> do + let dylibName = "JITDylibName" + dylib <- OrcV2.createJITDylib es dylibName + OrcV2.withThreadSafeModule m $ \mod -> + OrcV2.withRTDyldObjectLinkingLayer es $ \ol -> + OrcV2.withIRCompileLayer es ol tm $ \il -> do + dl <- getTargetMachineDataLayout tm + dylib' <- OrcV2.getJITDylibByName es dylibName + OrcV2.addModule mod dylib il + -- FIXME(llvm-12): "main" vs "_main" symbol name seems platform-dependent, + -- to be verified. "main" on Linux and "_main" on macOS. Find a + -- robust platform-independent fix – perhaps by reviving + -- `OrcV2.findSymbolIn` which takes a `MangledSymbol`. + addr <- OrcV2.lookupSymbol es dylib "_main" + let mainFn = mkMain (castPtrToFunPtr $ wordPtrToPtr $ fromIntegral addr) + result <- mainFn + result @?= 42 ] diff --git a/llvm-hs/test/LLVM/Test/ParameterAttribute.hs b/llvm-hs/test/LLVM/Test/ParameterAttribute.hs index af7cf4ad..79342124 100644 --- a/llvm-hs/test/LLVM/Test/ParameterAttribute.hs +++ b/llvm-hs/test/LLVM/Test/ParameterAttribute.hs @@ -31,7 +31,7 @@ instance Arbitrary ParameterAttribute where , return SignExt , return InReg , return SRet - , Alignment <$> elements (map (2^) [0..30 :: Int]) + , Alignment <$> elements (map (2^) [0..29 :: Int]) , return NoAlias , return ByVal , return NoCapture diff --git a/llvm-hs/test/LLVM/Test/Target.hs b/llvm-hs/test/LLVM/Test/Target.hs index e019261d..0843b80f 100644 --- a/llvm-hs/test/LLVM/Test/Target.hs +++ b/llvm-hs/test/LLVM/Test/Target.hs @@ -54,7 +54,6 @@ instance Arbitrary ExceptionHandling where instance Arbitrary Options where arbitrary = do - printMachineCode <- arbitrary unsafeFloatingPointMath <- arbitrary noInfinitiesFloatingPointMath <- arbitrary noNaNsFloatingPointMath <- arbitrary @@ -96,7 +95,6 @@ instance Arbitrary MachineCodeOptions where saveTemporaryLabels <- arbitrary useDwarfDirectory <- arbitrary incrementalLinkerCompatible <- arbitrary - pieCopyRelocations <- arbitrary showMachineCodeEncoding <- arbitrary showMachineCodeInstructions <- arbitrary verboseAssembly <- arbitrary diff --git a/llvm-hs/test/debug_metadata_5.ll b/llvm-hs/test/debug_metadata_5.ll index 4a0a5edc..540cb892 100644 --- a/llvm-hs/test/debug_metadata_5.ll +++ b/llvm-hs/test/debug_metadata_5.ll @@ -2616,7 +2616,7 @@ define hidden zeroext i8 @_ZN7mozilla4a11y4aria15GetRoleMapIndexEPNS_3dom7Elemen %82 = phi i64 [ %68, %67 ], [ %80, %79 ], [ %72, %71 ], !dbg !30310 call void @llvm.dbg.value(metadata %"class.mozilla::RangedPtr"* undef, metadata !30276, metadata !DIExpression(DW_OP_deref)) #5, !dbg !30330 call void @llvm.dbg.value(metadata %"class.mozilla::RangedPtr"* undef, metadata !30277, metadata !DIExpression(DW_OP_deref)) #5, !dbg !30331 - call void @_Z9SubstringIDsEK21nsTDependentSubstringIT_EPKS1_S5_(%class.nsTDependentSubstring* nonnull sret %5, i16* %55, i16* %69) #5, !dbg !30329 + call void @_Z9SubstringIDsEK21nsTDependentSubstringIT_EPKS1_S5_(%class.nsTDependentSubstring* nonnull sret(%class.nsTDependentSubstring) %5, i16* %55, i16* %69) #5, !dbg !30329 call void @llvm.dbg.value(metadata %class.nsTDependentSubstring* %5, metadata !30071, metadata !DIExpression(DW_OP_deref)), !dbg !30272 call void @llvm.dbg.value(metadata [114 x %struct.nsRoleMapEntry]* @_ZL12sWAIRoleMaps, metadata !30332, metadata !DIExpression()) #5, !dbg !30355 call void @llvm.dbg.value(metadata i64 0, metadata !30343, metadata !DIExpression()) #5, !dbg !30358 @@ -9805,7 +9805,7 @@ define hidden void @_ZN7mozilla4a11y14IDRefsIteratorC2EPNS0_13DocAccessibleEP10n } ; Function Attrs: nounwind sspstrong uwtable -define hidden void @_ZN7mozilla4a11y14IDRefsIterator6NextIDEv(%class.nsTDependentSubstring* noalias sret, %"class.mozilla::a11y::IDRefsIterator"*) local_unnamed_addr #0 align 2 !dbg !38561 { +define hidden void @_ZN7mozilla4a11y14IDRefsIterator6NextIDEv(%class.nsTDependentSubstring* noalias sret(%class.nsTDependentSubstring), %"class.mozilla::a11y::IDRefsIterator"*) local_unnamed_addr #0 align 2 !dbg !38561 { call void @llvm.dbg.value(metadata %"class.mozilla::a11y::IDRefsIterator"* %1, metadata !38563, metadata !DIExpression()), !dbg !38565 %3 = getelementptr inbounds %"class.mozilla::a11y::IDRefsIterator", %"class.mozilla::a11y::IDRefsIterator"* %1, i64 0, i32 4, !dbg !38566 %4 = load i32, i32* %3, align 8, !dbg !38566 @@ -36780,7 +36780,7 @@ define hidden void @_ZN7mozilla4a11y22NotificationController11WillRefreshENS_9Ti %258 = getelementptr inbounds void (%"struct.nsIFrame::RenderedText"*, %class.nsIFrame*, i32, i32, i32, i32)*, void (%"struct.nsIFrame::RenderedText"*, %class.nsIFrame*, i32, i32, i32, i32)** %257, i64 70, !dbg !69972 %259 = load void (%"struct.nsIFrame::RenderedText"*, %class.nsIFrame*, i32, i32, i32, i32)*, void (%"struct.nsIFrame::RenderedText"*, %class.nsIFrame*, i32, i32, i32, i32)** %258, align 8, !dbg !69972 call void @llvm.dbg.value(metadata %"struct.nsIFrame::RenderedText"* %7, metadata !68047, metadata !DIExpression(DW_OP_deref)), !dbg !69973 - call void %259(%"struct.nsIFrame::RenderedText"* nonnull sret %7, %class.nsIFrame* nonnull %247, i32 0, i32 -1, i32 0, i32 1) #5, !dbg !69972 + call void %259(%"struct.nsIFrame::RenderedText"* nonnull sret(%"struct.nsIFrame::RenderedText") %7, %class.nsIFrame* nonnull %247, i32 0, i32 -1, i32 0, i32 1) #5, !dbg !69972 %260 = icmp eq %"class.mozilla::a11y::Accessible"* %223, null, !dbg !69974 call void @llvm.dbg.value(metadata %"struct.nsIFrame::RenderedText"* %7, metadata !30155, metadata !DIExpression()), !dbg !69976 %261 = load i32, i32* %170, align 8, !dbg !69978 @@ -43746,7 +43746,7 @@ declare hidden zeroext i1 @_ZNK7mozilla6detail13nsTStringReprIDsE11EqualsASCIIEP declare hidden void @_ZN13nsCOMPtr_base14assign_from_qiE25nsQueryInterfaceISupportsRK4nsID(%class.nsCOMPtr_base*, %class.nsISupports*, %struct.nsID* dereferenceable(16)) local_unnamed_addr #4 -declare hidden void @_Z9SubstringIDsEK21nsTDependentSubstringIT_EPKS1_S5_(%class.nsTDependentSubstring* sret, i16*, i16*) local_unnamed_addr #4 +declare hidden void @_Z9SubstringIDsEK21nsTDependentSubstringIT_EPKS1_S5_(%class.nsTDependentSubstring* sret(%class.nsTDependentSubstring), i16*, i16*) local_unnamed_addr #4 declare hidden i32 @_Z7CompareIDsEiRKN7mozilla6detail13nsTStringReprIT_EES6_RK19nsTStringComparatorIS3_E(%"class.mozilla::detail::nsTStringRepr"* dereferenceable(16), %"class.mozilla::detail::nsTStringRepr"* dereferenceable(16), %class.nsTStringComparator* dereferenceable(8)) local_unnamed_addr #4 From 7dc26d28e0f3bfb20c12aed3434e888309f31c13 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Thu, 18 Mar 2021 12:27:33 +0000 Subject: [PATCH 03/37] Remove OrcJITv1, lots of cleanups and fixes. --- .travis.yml | 11 +- README.md | 62 +-- llvm-hs-pure/CHANGELOG.md | 4 + llvm-hs-pure/llvm-hs-pure.cabal | 2 +- llvm-hs/CHANGELOG.md | 5 + llvm-hs/default.nix | 26 - llvm-hs/llvm-hs.cabal | 17 +- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 3 + llvm-hs/src/LLVM/Internal/FFI/BitcodeC.cpp | 4 +- llvm-hs/src/LLVM/Internal/FFI/Builder.hs | 2 +- llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp | 14 +- llvm-hs/src/LLVM/Internal/FFI/Instruction.hs | 6 +- .../src/LLVM/Internal/FFI/InstructionC.cpp | 9 +- llvm-hs/src/LLVM/Internal/FFI/OrcJIT.h | 6 +- llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs | 130 ++--- .../LLVM/Internal/FFI/OrcJIT/CompileLayer.hs | 40 -- .../FFI/OrcJIT/CompileOnDemandLayer.hs | 52 -- .../Internal/FFI/OrcJIT/IRCompileLayer.hs | 17 - .../Internal/FFI/OrcJIT/IRTransformLayer.hs | 21 - .../LLVM/Internal/FFI/OrcJIT/LinkingLayer.hs | 43 -- llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp | 494 +++++------------- llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs | 66 --- llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp | 162 ------ .../src/LLVM/Internal/FFI/PassManagerC.cpp | 21 +- llvm-hs/src/LLVM/Internal/Instruction.hs | 2 +- llvm-hs/src/LLVM/Internal/Linking.hs | 8 +- llvm-hs/src/LLVM/Internal/Module.hs | 6 + llvm-hs/src/LLVM/Internal/OrcJIT.hs | 297 +++++++---- .../src/LLVM/Internal/OrcJIT/CompileLayer.hs | 112 ---- .../Internal/OrcJIT/CompileOnDemandLayer.hs | 186 ------- .../LLVM/Internal/OrcJIT/IRCompileLayer.hs | 54 -- .../LLVM/Internal/OrcJIT/IRTransformLayer.hs | 69 --- .../src/LLVM/Internal/OrcJIT/LinkingLayer.hs | 87 --- llvm-hs/src/LLVM/Internal/OrcJITV2.hs | 162 ------ llvm-hs/src/LLVM/Module.hs | 4 +- llvm-hs/src/LLVM/OrcJIT.hs | 95 +--- llvm-hs/src/LLVM/OrcJIT/CompileLayer.hs | 13 - llvm-hs/src/LLVM/OrcJIT/LinkingLayer.hs | 12 - llvm-hs/src/LLVM/Transforms.hs | 13 +- llvm-hs/test/LLVM/Test/Instrumentation.hs | 12 +- llvm-hs/test/LLVM/Test/Optimization.hs | 23 +- llvm-hs/test/LLVM/Test/OrcJIT.hs | 111 ++-- llvm-hs/test/LLVM/Test/ParameterAttribute.hs | 2 +- shell.nix | 33 -- stack.yaml | 2 +- 45 files changed, 518 insertions(+), 2002 deletions(-) delete mode 100644 llvm-hs/default.nix delete mode 100644 llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileLayer.hs delete mode 100644 llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileOnDemandLayer.hs delete mode 100644 llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRCompileLayer.hs delete mode 100644 llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRTransformLayer.hs delete mode 100644 llvm-hs/src/LLVM/Internal/FFI/OrcJIT/LinkingLayer.hs delete mode 100644 llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs delete mode 100644 llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp delete mode 100644 llvm-hs/src/LLVM/Internal/OrcJIT/CompileLayer.hs delete mode 100644 llvm-hs/src/LLVM/Internal/OrcJIT/CompileOnDemandLayer.hs delete mode 100644 llvm-hs/src/LLVM/Internal/OrcJIT/IRCompileLayer.hs delete mode 100644 llvm-hs/src/LLVM/Internal/OrcJIT/IRTransformLayer.hs delete mode 100644 llvm-hs/src/LLVM/Internal/OrcJIT/LinkingLayer.hs delete mode 100644 llvm-hs/src/LLVM/Internal/OrcJITV2.hs delete mode 100644 llvm-hs/src/LLVM/OrcJIT/CompileLayer.hs delete mode 100644 llvm-hs/src/LLVM/OrcJIT/LinkingLayer.hs delete mode 100644 shell.nix diff --git a/.travis.yml b/.travis.yml index d751b20a..461a61a8 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,14 +24,6 @@ env: matrix: include: - - compiler: "ghc-8.0.2" - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-3.0,ghc-8.0.2,gcc,g++], sources: [hvr-ghc]}} - - compiler: "ghc-8.2.2" - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-3.0,ghc-8.2.2,gcc,g++], sources: [hvr-ghc]}} - - compiler: "ghc-8.4.4" - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-3.0,ghc-8.4.4,gcc,g++], sources: [hvr-ghc]}} - - compiler: "ghc-8.6.5" - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-3.0,ghc-8.6.5,gcc,g++], sources: [hvr-ghc]}} - compiler: "ghc-8.8.1" addons: {apt: {packages: [ghc-ppa-tools,cabal-install-3.0,ghc-8.8.1,gcc,g++], sources: [hvr-ghc]}} @@ -56,8 +48,7 @@ install: - unzip ninja-linux.zip -d $HOME/bin - # curl -L https://github.com/llvm/llvm-project/releases/download/llvmorg-${LLVM_VER}/llvm-${LLVM_VER}.src.tar.xz | tar -xJf - -C $HOME - # rsync -ac $HOME/llvm-${LLVM_VER}.src/ $HOME/llvm-src-${LLVM_VER} - - git clone https://github.com/llvm/llvm-project.git - - git checkout release/12.x + - git clone https://github.com/llvm/llvm-project -b release/12.x --single-branch - cd llvm-project/llvm - mkdir -p build && cd build - cmake -DCMAKE_BUILD_TYPE=Release -DCMAKE_CXX_FLAGS_RELEASE=-O0 -DCMAKE_INSTALL_PREFIX=$HOME/llvm-build-${LLVM_VER} -DLLVM_PARALLEL_LINK_JOBS=1 -DLLVM_TARGETS_TO_BUILD=X86 -DLLVM_BUILD_LLVM_DYLIB=True -DLLVM_LINK_LLVM_DYLIB=True -GNinja .. diff --git a/README.md b/README.md index 62e76f1a..949e67a6 100644 --- a/README.md +++ b/README.md @@ -27,40 +27,9 @@ inconveniences. ## Installing LLVM -### Homebrew - -Example using Homebrew on macOS: - -```bash -$ brew install llvm-hs/llvm/llvm-9 -``` - -### Debian/Ubuntu - -For Debian/Ubuntu based Linux distributions, the LLVM.org website provides -binary distribution packages. Check [apt.llvm.org](http://apt.llvm.org/) for -instructions for adding the correct package database for your OS version, and -then: - -```bash -$ apt-get install llvm-9-dev -``` - -### Nix - -Nix users can use the following commands to build the library: - -```bash -$ nix-shell -$ cabal new-build llvm-hs -``` - -The Nix shell uses a pinned version of nixpkgs by default. -You can define the `nixpkgs` argument to use a different nixpkgs tree: - -```bash -$ nix-shell --arg nixpkgs '' -``` +LLVM 12 is still not fully released, and as such is unavailable in most +package managers. For now, the only reliable way to obtain the binaries +is to build it form source, following the instructions below. ### Building from source @@ -70,22 +39,25 @@ on the LLVM.org website [here](http://llvm.org/docs/CMake.html). [CMake compiler are required, at least Clang 3.1, GCC 4.8, or Visual Studio 2015 (Update 3). - 1. Download and unpack the [LLVM-9.0 source code](http://releases.llvm.org/9.0.0/llvm-9.0.0.src.tar.xz). - We'll refer to the path the source tree was unpacked to as `LLVM_SRC`. + 1. Download and unpack the [LLVM source code](https://github.com/llvm/llvm-project): + ```sh + git clone https://github.com/llvm/llvm-project -b release/12.x --single-branch + cd llvm-project + ``` 2. Create a temporary build directory and `cd` to it, for example: ```sh - mkdir /tmp/build - cd /tmp/build + mkdir build && cd build ``` 3. Execute the following to configure the build. Here, `INSTALL_PREFIX` is where LLVM is to be installed, for example `/usr/local`: ```sh - cmake $LLVM_SRC -DCMAKE_INSTALL_PREFIX=$INSTALL_PREFIX -DLLVM_BUILD_LLVM_DYLIB=True -DLLVM_LINK_LLVM_DYLIB=True + cmake -DCMAKE_BUILD_TYPE=Release -DCMAKE_INSTALL_PREFIX=$INSTALL_PREFIX -DLLVM_PARALLEL_LINK_JOBS=1 -DLLVM_BUILD_LLVM_DYLIB=True -DLLVM_LINK_LLVM_DYLIB=True ../llvm ``` See [options and variables](http://llvm.org/docs/CMake.html#options-and-variables) - for a list of additional build parameters you can specify. + for a list of additional build parameters you can specify (we especially recommend the + `ninja` build system). 4. Build and install: ```sh @@ -93,16 +65,6 @@ compiler are required, at least Clang 3.1, GCC 4.8, or Visual Studio 2015 cmake --build . --target install ``` - 5. For macOS only, some additional steps are useful to work around issues related - to [System Integrity Protection](https://en.wikipedia.org/wiki/System_Integrity_Protection): - ```sh - cd $INSTALL_PREFIX/lib - ln -s libLLVM.dylib libLLVM-9.dylib - install_name_tool -id $PWD/libLTO.dylib libLTO.dylib - install_name_tool -id $PWD/libLLVM.dylib libLLVM.dylib - install_name_tool -change '@rpath/libLLVM.dylib' $PWD/libLLVM.dylib libLTO.dylib - ``` - ## Versioning diff --git a/llvm-hs-pure/CHANGELOG.md b/llvm-hs-pure/CHANGELOG.md index fe151d28..a4888649 100644 --- a/llvm-hs-pure/CHANGELOG.md +++ b/llvm-hs-pure/CHANGELOG.md @@ -1,3 +1,7 @@ +## 12.0.0 (2021-03-19) + +* Update to LLVM 12.0 + ## 9.0.0 (2019-09-06) * The functions in `LLVM.IRBuilder.Constant` no longer return a diff --git a/llvm-hs-pure/llvm-hs-pure.cabal b/llvm-hs-pure/llvm-hs-pure.cabal index d17f0ae6..3ed4dcd4 100644 --- a/llvm-hs-pure/llvm-hs-pure.cabal +++ b/llvm-hs-pure/llvm-hs-pure.cabal @@ -16,7 +16,7 @@ description: llvm-hs-pure is a set of pure Haskell types and functions for interacting with LLVM . It includes an ADT to represent LLVM IR (). The llvm-hs package builds on this one with FFI bindings to LLVM, but llvm-hs-pure does not require LLVM to be available. -tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5 +tested-with: GHC == 8.8.1 extra-source-files: CHANGELOG.md source-repository head diff --git a/llvm-hs/CHANGELOG.md b/llvm-hs/CHANGELOG.md index 9d7990bb..2d684ae3 100644 --- a/llvm-hs/CHANGELOG.md +++ b/llvm-hs/CHANGELOG.md @@ -1,3 +1,8 @@ +## 12.0.0 (2021-03-19) + +* Update to LLVM 12.0 +* Remove OrcJIT V1 bindings and replace them with OrcJIT V2. + ## 9.0.1 (2019-09-28) * Fix build with Clang on MacOS. diff --git a/llvm-hs/default.nix b/llvm-hs/default.nix deleted file mode 100644 index 37018b37..00000000 --- a/llvm-hs/default.nix +++ /dev/null @@ -1,26 +0,0 @@ -{ mkDerivation, array, attoparsec, base, bytestring, Cabal -, containers, exceptions, llvm-config, llvm-hs-pure, mtl -, pretty-show, QuickCheck, stdenv, tasty, tasty-hunit -, tasty-quickcheck, template-haskell, temporary, transformers -, transformers-compat, utf8-string -}: -mkDerivation { - pname = "llvm-hs"; - version = "4.1.0.0"; - src = ./.; - configureFlags = [ "-fshared-llvm" ]; - setupHaskellDepends = [ base Cabal containers ]; - libraryHaskellDepends = [ - array attoparsec base bytestring containers exceptions llvm-hs-pure - mtl template-haskell transformers transformers-compat utf8-string - ]; - libraryToolDepends = [ llvm-config ]; - testHaskellDepends = [ - base bytestring containers llvm-hs-pure mtl pretty-show QuickCheck - tasty tasty-hunit tasty-quickcheck temporary transformers - transformers-compat - ]; - homepage = "http://github.com/llvm-hs/llvm-hs/"; - description = "General purpose LLVM bindings"; - license = stdenv.lib.licenses.bsd3; -} diff --git a/llvm-hs/llvm-hs.cabal b/llvm-hs/llvm-hs.cabal index 5fb43d49..015140a2 100644 --- a/llvm-hs/llvm-hs.cabal +++ b/llvm-hs/llvm-hs.cabal @@ -42,7 +42,7 @@ extra-source-files: test/debug_metadata_4.ll test/debug_metadata_5.ll test/main_return_38.c -tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5 +tested-with: GHC == 8.8.1 extra-source-files: CHANGELOG.md source-repository head @@ -129,12 +129,6 @@ library LLVM.Internal.Module LLVM.Internal.ObjectFile LLVM.Internal.OrcJIT - LLVM.Internal.OrcJITV2 - LLVM.Internal.OrcJIT.CompileLayer - LLVM.Internal.OrcJIT.LinkingLayer - LLVM.Internal.OrcJIT.CompileOnDemandLayer - LLVM.Internal.OrcJIT.IRCompileLayer - LLVM.Internal.OrcJIT.IRTransformLayer LLVM.Internal.Operand LLVM.Internal.PassManager LLVM.Internal.RawOStream @@ -174,12 +168,6 @@ library LLVM.Internal.FFI.Module LLVM.Internal.FFI.ObjectFile LLVM.Internal.FFI.OrcJIT - LLVM.Internal.FFI.OrcJITV2 - LLVM.Internal.FFI.OrcJIT.CompileLayer - LLVM.Internal.FFI.OrcJIT.LinkingLayer - LLVM.Internal.FFI.OrcJIT.CompileOnDemandLayer - LLVM.Internal.FFI.OrcJIT.IRCompileLayer - LLVM.Internal.FFI.OrcJIT.IRTransformLayer LLVM.Internal.FFI.PassManager LLVM.Internal.FFI.PtrHierarchy LLVM.Internal.FFI.RawOStream @@ -196,8 +184,6 @@ library LLVM.Linking LLVM.Module LLVM.OrcJIT - LLVM.OrcJIT.CompileLayer - LLVM.OrcJIT.LinkingLayer LLVM.PassManager LLVM.Relocation LLVM.Target @@ -230,7 +216,6 @@ library src/LLVM/Internal/FFI/MetadataC.cpp src/LLVM/Internal/FFI/ModuleC.cpp src/LLVM/Internal/FFI/OrcJITC.cpp - src/LLVM/Internal/FFI/OrcJITV2C.cpp src/LLVM/Internal/FFI/RawOStreamC.cpp src/LLVM/Internal/FFI/PassManagerC.cpp src/LLVM/Internal/FFI/RTDyldMemoryManager.cpp diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index 4a7b1fd0..61f84a36 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -11,6 +11,7 @@ macro(Builtin,F,F,T) \ macro(Cold,F,F,T) \ macro(Convergent,F,F,T) \ + macro(Hot,F,F,T) \ macro(ImmArg,T,F,F) \ macro(InAlloca,T,F,F) \ macro(InReg,T,T,F) \ @@ -23,6 +24,7 @@ macro(Nest,T,F,F) \ macro(NoAlias,T,T,F) \ macro(NoBuiltin,F,F,T) \ + macro(NoCallback,F,F,T) \ macro(NoCapture,T,F,F) \ macro(NoCfCheck,F,F,T) \ macro(NoDuplicate,F,F,T) \ @@ -30,6 +32,7 @@ macro(NoImplicitFloat,F,F,T) \ macro(NoInline,F,F,T) \ macro(NoMerge,F,F,T) \ + macro(NoProfile,F,F,T) \ macro(NoRecurse,F,F,T) \ macro(NoRedZone,F,F,T) \ macro(NoReturn,F,F,T) \ diff --git a/llvm-hs/src/LLVM/Internal/FFI/BitcodeC.cpp b/llvm-hs/src/LLVM/Internal/FFI/BitcodeC.cpp index 10a94635..f8aa06f6 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/BitcodeC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/BitcodeC.cpp @@ -13,10 +13,10 @@ extern "C" { LLVMModuleRef LLVM_Hs_ParseBitcode( LLVMContextRef c, - LLVMMemoryBufferRef mb, + LLVMMemoryBufferRef mb, char **error ) { - Expected> moduleOrErr = parseBitcodeFile(unwrap(mb)->getMemBufferRef(), *unwrap(c), [](StringRef) { return None; }); + Expected> moduleOrErr = parseBitcodeFile(unwrap(mb)->getMemBufferRef(), *unwrap(c)); if (Error err = moduleOrErr.takeError()) { handleAllErrors(std::move(err), [&](ErrorInfoBase &eib) { *error = strdup(eib.message().c_str()); diff --git a/llvm-hs/src/LLVM/Internal/FFI/Builder.hs b/llvm-hs/src/LLVM/Internal/FFI/Builder.hs index a721851b..0b3aa901 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Builder.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Builder.hs @@ -148,7 +148,7 @@ foreign import ccall unsafe "LLVMBuildPhi" buildPhi :: foreign import ccall unsafe "LLVMBuildCall" buildCall :: Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVM_Hs_Freeze" buildFreeze :: +foreign import ccall unsafe "LLVMBuildFreeze" buildFreeze :: Ptr Builder -> Ptr Value -> Ptr Type -> IO (Ptr Instruction) foreign import ccall unsafe "LLVM_Hs_BuildSelect" buildSelect :: diff --git a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp index 3d056fcf..3149cdee 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp @@ -190,9 +190,9 @@ LLVMValueRef LLVM_Hs_BuildFence( LLVMValueRef LLVM_Hs_BuildAtomicCmpXchg( LLVMBuilderRef b, LLVMBool v, - LLVMValueRef ptr, - LLVMValueRef cmp, - LLVMValueRef n, + LLVMValueRef ptr, + LLVMValueRef cmp, + LLVMValueRef n, LLVMAtomicOrdering successOrdering, LLVMAtomicOrdering failureOrdering, LLVMSynchronizationScope lss, @@ -210,8 +210,8 @@ LLVMValueRef LLVM_Hs_BuildAtomicRMW( LLVMBuilderRef b, LLVMBool v, LLVMAtomicRMWBinOp_ rmwOp, - LLVMValueRef ptr, - LLVMValueRef val, + LLVMValueRef ptr, + LLVMValueRef val, LLVMAtomicOrdering lao, LLVMSynchronizationScope lss, const char *name @@ -280,10 +280,6 @@ LLVMValueRef LLVM_Hs_BuildInBoundsGEP(LLVMBuilderRef B, LLVMValueRef Pointer, return wrap(unwrap(B)->Insert(GetElementPtrInst::CreateInBounds(nullptr, unwrap(Pointer), IdxList), Name)); } -LLVMValueRef LLVM_Hs_Freeze(LLVMBuilderRef B, LLVMValueRef Op, const char *Name) { - return wrap(unwrap(B)->Insert(new FreezeInst(unwrap(Op), Name))); -} - LLVMValueRef LLVM_Hs_BuildSelect(LLVMBuilderRef B, LLVMValueRef If, LLVMValueRef Then, LLVMValueRef Else, const char *Name) { diff --git a/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs b/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs index 07e83a4c..7719c4e4 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs @@ -21,11 +21,11 @@ foreign import ccall unsafe "LLVMIsAInstruction" isAInstruction :: newtype COpcode = COpcode CUInt -- get the C API opcode -foreign import ccall unsafe "LLVMGetInstructionOpcode" getInstructionOpcode :: +foreign import ccall unsafe "LLVMGetInstructionOpcode" getInstructionOpcode :: Ptr Instruction -> IO COpcode -- get the C++ API opcode (one less level of mapping than for that from the C API) -foreign import ccall unsafe "LLVM_Hs_GetInstructionDefOpcode" getInstructionDefOpcode :: +foreign import ccall unsafe "LLVM_Hs_GetInstructionDefOpcode" getInstructionDefOpcode :: Ptr Instruction -> IO CPPOpcode foreign import ccall unsafe "LLVMGetICmpPredicate" getICmpPredicate :: @@ -153,7 +153,7 @@ foreign import ccall unsafe "LLVM_Hs_GetShuffleVectorMaskSize" getShuffleVectorM Ptr Instruction -> IO CUInt foreign import ccall unsafe "LLVM_Hs_GetShuffleVectorMask" getShuffleVectorMask :: - Ptr Instruction -> Ptr CInt -> IO () + Ptr Instruction -> CUInt -> Ptr CInt -> IO () foreign import ccall unsafe "LLVM_Hs_GetCleanupPad" getCleanupPad :: Ptr Instruction -> IO (Ptr Instruction) diff --git a/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp b/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp index daabe898..d74fa32d 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp @@ -137,7 +137,7 @@ unsigned LLVM_Hs_GetInstrAlignment(LLVMValueRef l) { void LLVM_Hs_SetInstrAlignment(LLVMValueRef l, unsigned a) { switch(unwrap(l)->getOpcode()) { -#define ENUM_CASE(n) case Instruction::n: unwrap(l)->setAlignment(MaybeAlign(a).valueOrOne()); break; +#define ENUM_CASE(n) case Instruction::n: unwrap(l)->setAlignment(Align(a)); break; LLVM_HS_FOR_EACH_ALIGNMENT_INST(ENUM_CASE) #undef ENUM_CASE } @@ -271,9 +271,10 @@ unsigned LLVM_Hs_GetShuffleVectorMaskSize(LLVMValueRef i) { return unwrap(i)->getShuffleMask().size(); } -void LLVM_Hs_GetShuffleVectorMask(LLVMValueRef i, unsigned *result) { - auto mask = unwrap(i)->getShuffleMask(); - std::copy(mask.begin(), mask.end(), result); +void LLVM_Hs_GetShuffleVectorMask(LLVMValueRef i, unsigned int numResults, int *result) { + const auto& mask = unwrap(i)->getShuffleMask(); + assert(numResults == mask.size()); + std::copy(mask.begin(), mask.end(), result); } LLVMValueRef LLVM_Hs_GetCleanupPad(LLVMValueRef i) { diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.h b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.h index 437a532e..4aef1f72 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.h +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.h @@ -8,6 +8,8 @@ macro(Common) \ macro(Absolute) \ macro(Exported) \ + macro(Callable) \ + macro(MaterializationSideEffectsOnly) typedef enum { LLVMJITSymbolFlagNone = 0, @@ -15,7 +17,9 @@ typedef enum { LLVMJITSymbolFlagWeak = 1U << 1, LLVMJITSymbolFlagCommon = 1U << 2, LLVMJITSymbolFlagAbsolute = 1U << 3, - LLVMJITSymbolFlagExported = 1U << 4 + LLVMJITSymbolFlagExported = 1U << 4, + LLVMJITSymbolFlagCallable = 1U << 5, + LLVMJITSymbolFlagMaterializationSideEffectsOnly = 1U << 6 } LLVMJITSymbolFlags_; #endif diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs index cdaac2e5..02a301c4 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs @@ -1,47 +1,26 @@ -{-# LANGUAGE MultiParamTypeClasses, ForeignFunctionInterface #-} - module LLVM.Internal.FFI.OrcJIT where import LLVM.Prelude -import Foreign.C -import Foreign.Ptr - -import LLVM.Internal.FFI.DataLayout +import LLVM.Internal.FFI.DataLayout (DataLayout) +import LLVM.Internal.FFI.Module (Module) +import LLVM.Internal.FFI.Target (TargetMachine) import LLVM.Internal.FFI.LLVMCTypes --- | Abstract type used as the identifier for a module. -newtype ModuleKey = ModuleKey Word64 deriving (Eq, Ord, Show) - -data JITSymbol -data SymbolResolver -data ExecutionSession -data JITDylib +import Foreign.Ptr +import Foreign.C newtype TargetAddress = TargetAddress Word64 -type SymbolResolverFn = CString -> Ptr JITSymbol -> IO () - -foreign import ccall safe "LLVM_Hs_disposeJITSymbol" disposeSymbol :: - Ptr JITSymbol -> IO () - -foreign import ccall safe "LLVM_Hs_JITSymbol_getAddress" getAddress :: - Ptr JITSymbol -> Ptr (OwnerTransfered CString) -> IO TargetAddress - -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 () - -foreign import ccall safe "LLVM_Hs_getMangledSymbol" getMangledSymbol :: - Ptr CString -> CString -> Ptr DataLayout -> IO () - -foreign import ccall safe "LLVM_Hs_disposeMangledSymbol" disposeMangledSymbol :: - CString -> IO () +data LLVMJITEvaluatedSymbol +data ExpectedJITEvaluatedSymbol +data MangleAndInterner +data ThreadSafeContext +data ThreadSafeModule +data ObjectLayer +data IRLayer +data JITDylib +data ExecutionSession foreign import ccall safe "LLVM_Hs_createExecutionSession" createExecutionSession :: IO (Ptr ExecutionSession) @@ -49,60 +28,61 @@ foreign import ccall safe "LLVM_Hs_createExecutionSession" createExecutionSessio foreign import ccall safe "LLVM_Hs_disposeExecutionSession" disposeExecutionSession :: Ptr ExecutionSession -> IO () -foreign import ccall "wrapper" wrapGetSymbolResolver :: - (ModuleKey -> IO (Ptr SymbolResolver)) -> IO (FunPtr (ModuleKey -> IO (Ptr SymbolResolver))) +foreign import ccall safe "LLVM_Hs_ExecutionSession_endSession" endSession :: + Ptr ExecutionSession -> IO () -foreign import ccall "wrapper" wrapSetSymbolResolver :: - (ModuleKey -> Ptr SymbolResolver -> IO ()) -> IO (FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ())) +foreign import ccall safe "LLVM_Hs_ExecutionSession_createJITDylib" createJITDylib :: + Ptr ExecutionSession -> CString -> IO (Ptr JITDylib) -{- -foreign import ccall "wrapper" wrapSymbolResolverFn :: - SymbolResolverFn -> IO (FunPtr SymbolResolverFn) +foreign import ccall safe "LLVM_Hs_ExecutionSession_lookupSymbol" lookupSymbol :: + Ptr ExecutionSession -> Ptr JITDylib -> Ptr MangleAndInterner -> CString -> IO (Ptr ExpectedJITEvaluatedSymbol) -foreign import ccall safe "LLVM_Hs_disposeJITSymbol" disposeSymbol :: - Ptr JITSymbol -> IO () +foreign import ccall safe "LLVM_Hs_createThreadSafeContext" createThreadSafeContext :: + IO (Ptr ThreadSafeContext) -foreign import ccall safe "LLVM_Hs_createLambdaResolver" createLambdaResolver :: - Ptr ExecutionSession -> - FunPtr SymbolResolverFn -> - IO (Ptr SymbolResolver) +foreign import ccall safe "LLVM_Hs_disposeThreadSafeContext" disposeThreadSafeContext :: + Ptr ThreadSafeContext -> IO () -foreign import ccall safe "LLVM_Hs_disposeSymbolResolver" disposeSymbolResolver :: - Ptr SymbolResolver -> IO () +foreign import ccall safe "LLVM_Hs_cloneAsThreadSafeModule" cloneAsThreadSafeModule :: + Ptr Module -> IO (Ptr ThreadSafeModule) -foreign import ccall safe "LLVM_Hs_JITSymbol_getAddress" getAddress :: - Ptr JITSymbol -> Ptr (OwnerTransfered CString) -> IO TargetAddress +foreign import ccall safe "LLVM_Hs_disposeThreadSafeModule" disposeThreadSafeModule :: + Ptr ThreadSafeModule -> IO () -foreign import ccall safe "LLVM_Hs_JITSymbol_getFlags" getFlags :: - Ptr JITSymbol -> IO JITSymbolFlags +foreign import ccall safe "LLVM_Hs_createRTDyldObjectLinkingLayer" createRTDyldObjectLinkingLayer :: + Ptr ExecutionSession -> IO (Ptr ObjectLayer) -foreign import ccall safe "LLVM_Hs_JITSymbol_getErrorMsg" getErrorMsg :: - Ptr JITSymbol -> IO (OwnerTransfered CString) +foreign import ccall safe "LLVM_Hs_disposeObjectLayer" disposeObjectLayer :: + Ptr ObjectLayer -> IO () -foreign import ccall safe "LLVM_Hs_setJITSymbol" setJITSymbol :: - Ptr JITSymbol -> TargetAddress -> JITSymbolFlags -> IO () +foreign import ccall safe "LLVM_Hs_createIRCompileLayer" createIRCompileLayer :: + Ptr ExecutionSession -> Ptr ObjectLayer -> Ptr TargetMachine -> IO (Ptr IRLayer) -foreign import ccall safe "LLVM_Hs_getMangledSymbol" getMangledSymbol :: - Ptr CString -> CString -> Ptr DataLayout -> IO () +foreign import ccall safe "LLVM_Hs_disposeIRLayer" disposeIRLayer :: + Ptr IRLayer -> IO () -foreign import ccall safe "LLVM_Hs_disposeMangledSymbol" disposeMangledSymbol :: - CString -> IO () +foreign import ccall safe "LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_forCurrentProcess" + addDynamicLibrarySearchGeneratorForCurrentProcess :: + Ptr JITDylib -> Ptr DataLayout -> IO () -foreign import ccall safe "LLVM_Hs_createExecutionSession" createExecutionSession :: - IO (Ptr ExecutionSession) +foreign import ccall safe "LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_load" + addDynamicLibrarySearchGenerator :: + Ptr JITDylib -> Ptr DataLayout -> CString -> IO () -foreign import ccall safe "LLVM_Hs_disposeExecutionSession" disposeExecutionSession :: - Ptr ExecutionSession -> IO () +foreign import ccall safe "LLVM_Hs_IRLayer_addModule" irLayerAddModule :: + Ptr ThreadSafeModule -> Ptr JITDylib -> Ptr DataLayout -> Ptr IRLayer -> IO () + +foreign import ccall safe "LLVM_Hs_getExpectedJITEvaluatedSymbolAddress" getExpectedSymbolAddress :: + Ptr ExpectedJITEvaluatedSymbol -> Ptr (OwnerTransfered CString) -> IO TargetAddress -foreign import ccall safe "LLVM_Hs_allocateVModule" allocateVModule :: - Ptr ExecutionSession -> IO ModuleKey +foreign import ccall safe "LLVM_Hs_getExpectedJITEvaluatedSymbolFlags" getExpectedSymbolFlags :: + Ptr ExpectedJITEvaluatedSymbol -> IO JITSymbolFlags -foreign import ccall safe "LLVM_Hs_releaseVModule" releaseVModule :: - Ptr ExecutionSession -> ModuleKey -> IO () +foreign import ccall safe "LLVM_Hs_disposeJITEvaluatedSymbol" disposeJITEvaluatedSymbol :: + Ptr ExpectedJITEvaluatedSymbol -> IO () -foreign import ccall "wrapper" wrapGetSymbolResolver :: - (ModuleKey -> IO (Ptr SymbolResolver)) -> IO (FunPtr (ModuleKey -> IO (Ptr SymbolResolver))) +foreign import ccall safe "LLVM_Hs_createMangleAndInterner" createMangleAndInterner :: + Ptr ExecutionSession -> Ptr DataLayout -> IO (Ptr MangleAndInterner) -foreign import ccall "wrapper" wrapSetSymbolResolver :: - (ModuleKey -> Ptr SymbolResolver -> IO ()) -> IO (FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ())) --} +foreign import ccall safe "LLVM_Hs_disposeMangleAndInterner" disposeMangleAndInterner :: + Ptr MangleAndInterner -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileLayer.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileLayer.hs deleted file mode 100644 index 8c16ebd5..00000000 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileLayer.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -module LLVM.Internal.FFI.OrcJIT.CompileLayer where - -import LLVM.Prelude - -import LLVM.Internal.FFI.DataLayout -import LLVM.Internal.FFI.LLVMCTypes -import LLVM.Internal.FFI.Module -import LLVM.Internal.FFI.OrcJIT - -import Foreign.C -import Foreign.Ptr - -data CompileLayer - -foreign import ccall safe "LLVM_Hs_CompileLayer_dispose" disposeCompileLayer :: - Ptr CompileLayer -> IO () - --- TODO(llvm-12): Consider removing this unused API? -{- -foreign import ccall safe "LLVM_Hs_CompileLayer_addModule" addModule :: - Ptr CompileLayer -> - Ptr DataLayout -> - ModuleKey -> - Ptr Module -> - Ptr (OwnerTransfered CString) -> - IO () - -foreign import ccall safe "LLVM_Hs_CompileLayer_removeModule" removeModule :: - Ptr CompileLayer -> ModuleKey -> IO () --} - -foreign import ccall safe "LLVM_Hs_CompileLayer_findSymbol" findSymbol :: - Ptr CompileLayer -> CString -> LLVMBool -> IO (Ptr JITSymbol) - --- TODO(llvm-12): Consider removing this unused API? -{- -foreign import ccall safe "LLVM_Hs_CompileLayer_findSymbolIn" findSymbolIn :: - Ptr CompileLayer -> ModuleKey -> CString -> LLVMBool -> IO (Ptr JITSymbol) --} diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileOnDemandLayer.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileOnDemandLayer.hs deleted file mode 100644 index 374888ae..00000000 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/CompileOnDemandLayer.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface, MultiParamTypeClasses #-} -module LLVM.Internal.FFI.OrcJIT.CompileOnDemandLayer where - -import LLVM.Prelude - -import Foreign.C -import Foreign.Ptr - -import LLVM.Internal.FFI.LLVMCTypes -import LLVM.Internal.FFI.OrcJIT -import LLVM.Internal.FFI.OrcJIT.CompileLayer -import LLVM.Internal.FFI.PtrHierarchy - -data IndirectStubsManagerBuilder -data JITCompileCallbackManager -data Set a -data CompileOnDemandLayer -instance ChildOf CompileLayer CompileOnDemandLayer - -type PartitioningFn = Ptr Function -> Ptr (Set (Ptr Function)) -> IO () - -foreign import ccall "wrapper" wrapPartitioningFn :: - PartitioningFn -> IO (FunPtr PartitioningFn) - -foreign import ccall "wrapper" wrapErrorHandler :: - IO () -> IO (FunPtr (IO ())) - -foreign import ccall safe "LLVM_Hs_createLocalCompileCallbackManager" createLocalCompileCallbackManager :: - Ptr ExecutionSession -> CString -> TargetAddress -> IO (Ptr JITCompileCallbackManager) - -foreign import ccall safe "LLVM_Hs_disposeCallbackManager" disposeCallbackManager :: - Ptr JITCompileCallbackManager -> IO () - -foreign import ccall safe "LLVM_Hs_createLocalIndirectStubsManagerBuilder" createLocalIndirectStubsManagerBuilder :: - CString -> IO (Ptr IndirectStubsManagerBuilder) - -foreign import ccall safe "LLVM_Hs_disposeIndirectStubsManagerBuilder" disposeIndirectStubsManagerBuilder :: - Ptr IndirectStubsManagerBuilder -> IO () - -foreign import ccall safe "LLVM_Hs_insertFun" insertFun :: - Ptr (Set (Ptr Function)) -> Ptr Function -> IO () - -foreign import ccall safe "LLVM_Hs_createCompileOnDemandLayer" createCompileOnDemandLayer :: - Ptr ExecutionSession -> - Ptr CompileLayer -> - FunPtr (ModuleKey -> IO (Ptr SymbolResolver)) -> - FunPtr (ModuleKey -> Ptr SymbolResolver -> IO ()) -> - FunPtr PartitioningFn -> - Ptr JITCompileCallbackManager -> - Ptr IndirectStubsManagerBuilder -> - LLVMBool -> - IO (Ptr CompileOnDemandLayer) diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRCompileLayer.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRCompileLayer.hs deleted file mode 100644 index 78cdf04c..00000000 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRCompileLayer.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface, MultiParamTypeClasses #-} -module LLVM.Internal.FFI.OrcJIT.IRCompileLayer where - -import LLVM.Prelude - -import LLVM.Internal.FFI.OrcJIT.LinkingLayer -import LLVM.Internal.FFI.OrcJIT.CompileLayer -import LLVM.Internal.FFI.PtrHierarchy -import LLVM.Internal.FFI.Target - -import Foreign.Ptr - -data IRCompileLayer -instance ChildOf CompileLayer IRCompileLayer - -foreign import ccall safe "LLVM_Hs_createLegacyIRCompileLayer" createIRCompileLayer :: - Ptr LinkingLayer -> Ptr TargetMachine -> IO (Ptr IRCompileLayer) diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRTransformLayer.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRTransformLayer.hs deleted file mode 100644 index 30f1b447..00000000 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/IRTransformLayer.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface, MultiParamTypeClasses #-} -module LLVM.Internal.FFI.OrcJIT.IRTransformLayer where - -import LLVM.Prelude - -import LLVM.Internal.FFI.OrcJIT.CompileLayer -import LLVM.Internal.FFI.PtrHierarchy -import LLVM.Internal.FFI.Module - -import Foreign.Ptr - -data IRTransformLayer -instance ChildOf CompileLayer IRTransformLayer - -type ModuleTransform = Ptr Module -> IO (Ptr Module) - -foreign import ccall "wrapper" wrapModuleTransform :: - ModuleTransform -> IO (FunPtr ModuleTransform) - -foreign import ccall safe "LLVM_Hs_createIRTransformLayer" createIRTransformLayer :: - Ptr CompileLayer -> FunPtr ModuleTransform -> IO (Ptr IRTransformLayer) diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/LinkingLayer.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/LinkingLayer.hs deleted file mode 100644 index 1268d3d1..00000000 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT/LinkingLayer.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface, MultiParamTypeClasses #-} - -module LLVM.Internal.FFI.OrcJIT.LinkingLayer where - -import LLVM.Prelude - -import Foreign.C -import Foreign.Ptr - -import LLVM.Internal.FFI.OrcJIT -import LLVM.Internal.FFI.LLVMCTypes -import LLVM.Internal.FFI.PtrHierarchy -import LLVM.Internal.FFI.ObjectFile - -data LinkingLayer -data ObjectLinkingLayer -instance ChildOf LinkingLayer ObjectLinkingLayer - -foreign import ccall safe "LLVM_Hs_createObjectLinkingLayer" createObjectLinkingLayer :: - Ptr ExecutionSession -> FunPtr (ModuleKey -> IO (Ptr SymbolResolver)) -> IO (Ptr ObjectLinkingLayer) - -foreign import ccall safe "LLVM_Hs_LinkingLayer_dispose" disposeLinkingLayer :: - Ptr LinkingLayer -> IO () - -foreign import ccall safe "LLVM_Hs_LinkingLayer_addObject" addObjectFile :: - Ptr LinkingLayer -> - ModuleKey -> - Ptr ObjectFile -> - Ptr (OwnerTransfered CString) -> - IO () - -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 -> - ModuleKey -> - CString -> - LLVMBool -> - IO (Ptr JITSymbol) diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp index 377e9deb..7b46ec10 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp @@ -1,164 +1,30 @@ -// We ignore deprecations until we get around to updating to the new OrcJIT API -#pragma GCC diagnostic ignored "-Wdeprecated-declarations" -#pragma clang diagnostic ignored "-Wdeprecated-declarations" +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include -// FIXME(llvm-12): Clean up this file. -// OrcJIT APIs like VModuleKeys and LambdaResolvers seem deprecated, so much of -// the code is commented here - unnecessary bits to be removed. Memory -// management may also need some reworking. - -// #if 0 -#include "llvm/Support/Error.h" - -#include "LLVM/Internal/FFI/ErrorHandling.hpp" #include "LLVM/Internal/FFI/OrcJIT.h" #include "LLVM/Internal/FFI/Target.hpp" -#include "llvm/ExecutionEngine/JITSymbol.h" -#include "llvm/ExecutionEngine/Orc/CompileOnDemandLayer.h" -#include "llvm/ExecutionEngine/Orc/CompileUtils.h" -#include "llvm/ExecutionEngine/Orc/IRCompileLayer.h" -#include "llvm/ExecutionEngine/Orc/IRTransformLayer.h" -#include "llvm/ExecutionEngine/Orc/IndirectionUtils.h" -// #include "llvm/ExecutionEngine/Orc/LambdaResolver.h" -#include "llvm/ExecutionEngine/Orc/RTDyldObjectLinkingLayer.h" -#include "llvm/ExecutionEngine/SectionMemoryManager.h" -#include "llvm/IR/Mangler.h" - -#include -#include - -#include "llvm-c/Object.h" -#include "llvm/ExecutionEngine/Orc/RTDyldObjectLinkingLayer.h" using namespace llvm; using namespace orc; -#if 0 -static_assert(std::is_same::value, - "VModuleKey should be uint64_t"); -#endif - #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 std::shared_ptr *LLVMSymbolResolverRef; - -// We want to allow users to choose themselves which layers they want to use. -// However, the LLVM API requires that this is selected statically via template -// arguments. We convert this static polymorphism to runtime polymorphism by -// creating an LinkingLayer and a CompileLayer class which use virtual dispatch -// to select the concrete layer. - -class LinkingLayer { - public: - using ObjectPtr = std::unique_ptr; - virtual ~LinkingLayer(){}; - virtual JITSymbol findSymbol(StringRef name, bool exportedSymbolsOnly) = 0; -#if 0 - virtual Error addObject(VModuleKey k, ObjectPtr objBuffer) = 0; - virtual Error removeObject(VModuleKey k) = 0; - virtual JITSymbol findSymbolIn(VModuleKey k, StringRef name, - bool exportedSymbolsOnly) = 0; - virtual Error emitAndFinalize(VModuleKey k) = 0; -#endif -}; - -template class LinkingLayerT : public LinkingLayer { - public: - LinkingLayerT(T data_) : data(std::move(data_)) {} - JITSymbol findSymbol(StringRef name, bool exportedSymbolsOnly) override { - return data.findSymbol(name, exportedSymbolsOnly); - } -#if 0 - Error addObject(VModuleKey k, ObjectPtr objBuffer) override { - return data.addObject(k, std::move(objBuffer)); - } - Error removeObject(VModuleKey k) override { return data.removeObject(k); } - JITSymbol findSymbolIn(VModuleKey k, StringRef name, - bool exportedSymbolsOnly) override { - return data.findSymbolIn(k, name, exportedSymbolsOnly); - } - Error emitAndFinalize(VModuleKey k) override { - return data.emitAndFinalize(k); - } -#endif - - private: - T data; -}; - -// class CompileLayer : public IRLayer { -class CompileLayer : public IRLayer { - public: - virtual ~CompileLayer(){}; - virtual JITSymbol findSymbol(StringRef Name, bool ExportedSymbolsOnly) = 0; -#if 0 - virtual JITSymbol findSymbolIn(VModuleKey K, StringRef Name, - bool ExportedSymbolsOnly) = 0; - virtual Error addModule(VModuleKey K, std::unique_ptr Module) = 0; - virtual Error removeModule(VModuleKey K) = 0; -#endif -}; - -template class CompileLayerT : public CompileLayer { - public: - template - CompileLayerT(Arg &&... arg) : data{std::forward(arg)...} {} - JITSymbol findSymbol(StringRef Name, bool ExportedSymbolsOnly) override { - return data.findSymbol(Name, ExportedSymbolsOnly); - } -#if 0 - JITSymbol findSymbolIn(VModuleKey K, StringRef Name, - bool ExportedSymbolsOnly) override { - return data.findSymbolIn(K, Name, ExportedSymbolsOnly); - } - Error addModule(VModuleKey K, std::unique_ptr Module) override { - return data.addModule(K, std::move(Module)); - } - Error removeModule(VModuleKey K) override { return data.removeModule(K); } -#endif - - private: - T data; -}; - -#if 0 -typedef llvm::orc::LegacyCompileOnDemandLayer LLVMCompileOnDemandLayer; -typedef LLVMCompileOnDemandLayer *LLVMCompileOnDemandLayerRef; - -typedef llvm::orc::LegacyIRTransformLayer< - CompileLayer, - std::function(std::unique_ptr)>> - LLVMIRTransformLayer; -#endif - -typedef llvm::orc::JITCompileCallbackManager *LLVMJITCompileCallbackManagerRef; - -typedef llvm::JITSymbol *LLVMJITSymbolRef; - -typedef llvm::orc::IndirectStubsManager *LLVMIndirectStubsManagerRef; -typedef std::function()> - *LLVMIndirectStubsManagerBuilderRef; - -static std::string mangle(StringRef name, LLVMTargetDataRef dataLayout) { - std::string mangledName; - { - raw_string_ostream mangledNameStream(mangledName); - Mangler::getNameWithPrefix(mangledNameStream, name, - *unwrap(dataLayout)); - } - return mangledName; -} - -// LLVM doesn’t declare this function in a header so we need to copy it here -static inline object::OwningBinary * -unwrap(LLVMObjectFileRef OF) { - return reinterpret_cast *>(OF); -} - static JITSymbolFlags unwrap(LLVMJITSymbolFlags_ f) { JITSymbolFlags flags = JITSymbolFlags::None; #define ENUM_CASE(x) \ @@ -172,7 +38,7 @@ static JITSymbolFlags unwrap(LLVMJITSymbolFlags_ f) { static LLVMJITSymbolFlags_ wrap(JITSymbolFlags f) { unsigned r = 0; #define ENUM_CASE(x) \ - if (f & JITSymbolFlags::x) \ + if (f & JITSymbolFlags::x) \ r |= (unsigned)LLVMJITSymbolFlag##x; LLVM_HS_FOR_EACH_JIT_SYMBOL_FLAG(ENUM_CASE) #undef ENUM_CASE @@ -181,283 +47,165 @@ static LLVMJITSymbolFlags_ wrap(JITSymbolFlags f) { extern "C" { +// ExecutionSession + ExecutionSession *LLVM_Hs_createExecutionSession() { return new ExecutionSession(); } void LLVM_Hs_disposeExecutionSession(ExecutionSession *es) { - // FIXME(llvm-12): Uncommenting this causes an assertion failure for OrcV2 test. - // Assertion failed: (Pool.empty() && "Dangling references at pool destruction time"), function ~SymbolStringPool, file llvm-project/llvm/include/llvm/ExecutionEngine/Orc/SymbolStringPool.h, line 151. - // delete es; -} - -#if 0 -VModuleKey LLVM_Hs_allocateVModule(ExecutionSession *es) { - return es->allocateVModule(); -} - -void LLVM_Hs_releaseVModule(ExecutionSession *es, VModuleKey k) { - es->releaseVModule(k); -} -#endif - -/* Constructor functions for the different compile layers */ - -#if 0 -CompileLayer *LLVM_Hs_createLegacyIRCompileLayer(LinkingLayer *linkingLayer, - LLVMTargetMachineRef tm) { - TargetMachine *tmm = unwrap(tm); - return new CompileLayerT>( - LegacyIRCompileLayer(*linkingLayer, - SimpleCompiler(*tmm))); + delete es; } -CompileLayer *LLVM_Hs_createCompileOnDemandLayer( - ExecutionSession *es, CompileLayer *compileLayer, - LLVMSymbolResolverRef (*getSymbolResolver)(VModuleKey k), - void (*setSymbolResolver)(VModuleKey k, LLVMSymbolResolverRef r), - void (*partitioningFtor)(llvm::Function *, std::set *set), - LLVMJITCompileCallbackManagerRef callbackManager, - LLVMIndirectStubsManagerBuilderRef stubsManager, - LLVMBool cloneStubsIntoPartitions) { - std::function(VModuleKey)> - getSymbolResolverFn = - [getSymbolResolver](VModuleKey k) { return *getSymbolResolver(k); }; - std::function)> - setSymbolResolverFn = - [setSymbolResolver](VModuleKey k, - std::shared_ptr r) { - setSymbolResolver(k, new std::shared_ptr(r)); - }; - return new CompileLayerT( - *es, *compileLayer, getSymbolResolverFn, setSymbolResolverFn, - [partitioningFtor](llvm::Function &f) -> std::set { - std::set result; - partitioningFtor(&f, &result); - return result; - }, - *callbackManager, *stubsManager, - static_cast(cloneStubsIntoPartitions)); +void LLVM_Hs_ExecutionSession_endSession(ExecutionSession *es) { + if (Error err = es->endSession()) { + llvm::errs() << err << "\n"; + // FIXME: Better error handling + exit(1); + } } -#endif -// NOTE: An IRCompileLayer actually already exists in OrcJITV2.cpp! No more work needed here :) -#if 0 -SimpleCompiler *LLVM_Hs_createSimpleCompiler(LLVMTargetMachineRef tm) { - TargetMachine *tmm = unwrap(tm); - return new SimpleCompiler(*tmm); -} +// Thread-safe context -// IRCompileLayer(ExecutionSession &ES, ObjectLayer &BaseLayer, -// std::unique_ptr Compile); -IRCompileLayer *LLVM_Hs_createIRCompileLayer(LLVMTargetMachineRef tm) { - TargetMachine *tmm = unwrap(tm); - return new // +ThreadSafeContext* LLVM_Hs_createThreadSafeContext() { + return new ThreadSafeContext(std::make_unique()); } -#endif - -#if 0 -CompileLayer *LLVM_Hs_createIRTransformLayer(CompileLayer *compileLayer, - Module *(*transform)(Module *)) { - std::function(std::unique_ptr)> transform_ = - [transform](std::unique_ptr module) { - return std::unique_ptr(transform(module.release())); - }; - return new CompileLayerT(*compileLayer, transform_); -} -#endif - -/* Functions that work on all compile layers */ -void LLVM_Hs_CompileLayer_dispose(CompileLayer *compileLayer) { - delete compileLayer; +void LLVM_Hs_disposeThreadSafeContext(ThreadSafeContext* ctx) { + delete ctx; } -LLVMJITSymbolRef LLVM_Hs_CompileLayer_findSymbol(CompileLayer *compileLayer, - const char *name, - LLVMBool exportedSymbolsOnly) { - JITSymbol symbol = compileLayer->findSymbol(name, exportedSymbolsOnly); - return new JITSymbol(std::move(symbol)); -} +// Thread-safe module -#if 0 -LLVMJITSymbolRef -LLVM_Hs_CompileLayer_findSymbolIn(CompileLayer *compileLayer, VModuleKey k, - const char *name, - LLVMBool exportedSymbolsOnly) { - JITSymbol symbol = compileLayer->findSymbolIn(k, name, exportedSymbolsOnly); - return new JITSymbol(std::move(symbol)); -} +// TODO: Figure out a way to do this without cloning the module +// The cloning is inspired by the code in llvm::orc::cloneToNewContext +ThreadSafeModule* LLVM_Hs_cloneAsThreadSafeModule(LLVMModuleRef m) { + Module* module = unwrap(m); + SmallVector bitcode; + BitcodeWriter writer(bitcode); + writer.writeModule(*module); + writer.writeSymtab(); + writer.writeStrtab(); -void LLVM_Hs_CompileLayer_addModule(CompileLayer *compileLayer, - LLVMTargetDataRef dataLayout, VModuleKey k, - LLVMModuleRef module, char **errorMessage) { - std::unique_ptr mod{unwrap(module)}; - if (mod->getDataLayout().isDefault()) { - mod->setDataLayout(*unwrap(dataLayout)); - } - if (auto err = compileLayer->addModule(k, std::move(mod))) { - std::string errString = toString(std::move(err)); - *errorMessage = strdup(errString.c_str()); - } - *errorMessage = nullptr; + ThreadSafeContext clone_context(std::make_unique()); + MemoryBufferRef bitcode_ref(StringRef(bitcode.data(), bitcode.size()), "clone bitcode"); + std::unique_ptr cloned_module = cantFail( + parseBitcodeFile(bitcode_ref, *clone_context.getContext())); + cloned_module->setModuleIdentifier(module->getName()); + return new ThreadSafeModule(std::move(cloned_module), std::move(clone_context)); } -void LLVM_Hs_CompileLayer_removeModule(CompileLayer *compileLayer, - VModuleKey k) { - if (compileLayer->removeModule(k)) { - // TODO handle failure - } +void LLVM_Hs_disposeThreadSafeModule(ThreadSafeModule* module) { + delete module; } -/* Constructor functions for the different object layers */ +// Object layer -LinkingLayer *LLVM_Hs_createObjectLinkingLayer( - ExecutionSession *es, LLVMSymbolResolverRef (*symbolResolver)(VModuleKey)) { - return new LinkingLayerT( - LegacyRTDyldObjectLinkingLayer(*es, [symbolResolver](VModuleKey k) { - return LegacyRTDyldObjectLinkingLayer::Resources{ - std::make_shared(), *symbolResolver(k)}; - })); +ObjectLayer* LLVM_Hs_createRTDyldObjectLinkingLayer(ExecutionSession* es) { + return new RTDyldObjectLinkingLayer(*es, []() { + return std::make_unique(); + }); } -#endif -/* Fuctions that work on all object layers */ - -void LLVM_Hs_LinkingLayer_dispose(LinkingLayer *linkingLayer) { - delete linkingLayer; +void LLVM_Hs_disposeObjectLayer(ObjectLayer* ol) { + delete ol; } -void LLVM_Hs_disposeJITSymbol(LLVMJITSymbolRef symbol) { delete symbol; } +// Compile layer -LLVMJITSymbolRef LLVM_Hs_LinkingLayer_findSymbol(LinkingLayer *linkingLayer, - const char *name, - LLVMBool exportedSymbolsOnly) { - JITSymbol symbol = linkingLayer->findSymbol(name, exportedSymbolsOnly); - return new JITSymbol(std::move(symbol)); +IRLayer* LLVM_Hs_createIRCompileLayer(ExecutionSession* es, ObjectLayer* baseLayer, LLVMTargetMachineRef tm) { + return new IRCompileLayer(*es, *baseLayer, std::make_unique(SimpleCompiler(*unwrap(tm)))); } - #if 0 -LLVMJITSymbolRef -LLVM_Hs_LinkingLayer_findSymbolIn(LinkingLayer *linkingLayer, VModuleKey k, - const char *name, - LLVMBool exportedSymbolsOnly) { - JITSymbol symbol = linkingLayer->findSymbolIn(k, name, exportedSymbolsOnly); - return new JITSymbol(std::move(symbol)); +void LLVM_Hs_disposeIRLayer(IRLayer* il) { + delete il; } -LLVMSymbolResolverRef LLVM_Hs_createLambdaResolver( - ExecutionSession *es, - void (*rawResolverFn)(const char *, LLVMJITSymbolRef)) { - std::function resolverFn = - [rawResolverFn](const std::string &name) -> JITSymbol { - JITSymbol symbol(nullptr); - rawResolverFn(name.c_str(), &symbol); - return symbol; - }; - return new std::shared_ptr( - createLegacyLookupResolver(*es, resolverFn, [](Error err) { - cantFail(std::move(err), "lookupFlags failed"); - })); +void LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_forCurrentProcess(JITDylib* dylib, LLVMTargetDataRef dataLayout) { + auto dataLayoutCpp = *unwrap(dataLayout); + ExitOnError ExitOnErr; + dylib->addGenerator( + ExitOnErr(orc::DynamicLibrarySearchGenerator::GetForCurrentProcess( + dataLayoutCpp.getGlobalPrefix()))); } -#endif -void LLVM_Hs_disposeSymbolResolver(LLVMSymbolResolverRef resolver) { - delete resolver; +void LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_load(JITDylib* dylib, LLVMTargetDataRef dataLayout, const char* name) { + auto dataLayoutCpp = *unwrap(dataLayout); + ExitOnError ExitOnErr; + dylib->addGenerator( + ExitOnErr(orc::DynamicLibrarySearchGenerator::Load( + name, dataLayoutCpp.getGlobalPrefix()))); } -#if 0 -void LLVM_Hs_LinkingLayer_addObject(LinkingLayer *linkLayer, VModuleKey k, - LLVMObjectFileRef objRef, - char **errorMessage) { - std::unique_ptr objBuffer = - unwrap(objRef)->takeBinary().second; - *errorMessage = nullptr; - if (auto err = linkLayer->addObject(k, std::move(objBuffer))) { - std::string error = toString(std::move(err)); - *errorMessage = strdup(error.c_str()); - return; +// Warning: This consumes the module. +void LLVM_Hs_IRLayer_addModule(ThreadSafeModule* tsm, JITDylib* dylib, LLVMTargetDataRef dataLayout, IRLayer* il) { + auto dataLayoutCpp = *unwrap(dataLayout); + tsm->withModuleDo([&](auto& module) { + if (module.getDataLayout().isDefault()) { + module.setDataLayout(dataLayoutCpp); + } + }); + if (Error err = il->add(*dylib, std::move(*tsm))) { + llvm::errs() << err << "\n"; + // FIXME: Better error handling + exit(1); } } -#endif -JITTargetAddress LLVM_Hs_JITSymbol_getAddress(LLVMJITSymbolRef symbol, - char **errorMessage) { - *errorMessage = nullptr; - if (auto addrOrErr = symbol->getAddress()) { - return *addrOrErr; +JITDylib* LLVM_Hs_ExecutionSession_createJITDylib(ExecutionSession* es, const char* name) { + if (auto dylibOrErr = es->createJITDylib(name)) { + auto& dylib = *dylibOrErr; + return &dylib; } else { - std::string error = toString(addrOrErr.takeError()); - *errorMessage = strdup(error.c_str()); - return 0; - } -} - -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()); + Error err = dylibOrErr.takeError(); + llvm::errs() << err << "\n"; + // FIXME: Better error handling + exit(1); } - return strdup(""); } -void LLVM_Hs_setJITSymbol(LLVMJITSymbolRef symbol, JITTargetAddress addr, - LLVMJITSymbolFlags_ flags) { - *symbol = JITSymbol(addr, unwrap(flags)); -} -void LLVM_Hs_getMangledSymbol(char **mangledSymbol, const char *symbol, - LLVMTargetDataRef dataLayout) { - std::string mangled = mangle(symbol, dataLayout); - *mangledSymbol = new char[mangled.size() + 1]; - strcpy(*mangledSymbol, mangled.c_str()); +Expected* LLVM_Hs_ExecutionSession_lookupSymbol( + ExecutionSession* es, JITDylib* dylib, + MangleAndInterner* mangler, const char* name) { + // Printing here will show unresolved symbols. + // es->dump(llvm::errs()); + return new Expected(es->lookup({dylib}, (*mangler)(name))); } -void LLVM_Hs_disposeMangledSymbol(char *mangledSymbol) { - delete[] mangledSymbol; +uint64_t LLVM_Hs_getExpectedJITEvaluatedSymbolAddress( + Expected* symbolPtr, + char** errMsg) { + auto& symbol = *symbolPtr; + *errMsg = nullptr; + if (symbol) { + return symbol->getAddress(); + } else { + *errMsg = strdup(toString(symbol.takeError()).c_str()); + return 0; + } } -LLVMJITCompileCallbackManagerRef LLVM_Hs_createLocalCompileCallbackManager( - ExecutionSession *es, const char *triple, JITTargetAddress errorHandler) { - // We copy the string so that it can be freed on the Haskell side. - std::string tripleStr(triple); - auto ccMgr = - llvm::orc::createLocalCompileCallbackManager(Triple(std::move(tripleStr)), *es, errorHandler); - if (!ccMgr) { - std::string errMsg; - raw_string_ostream errStream(errMsg); - errStream << ccMgr.takeError(); - reportFatalError(errStream.str()); +LLVMJITSymbolFlags_ LLVM_Hs_getExpectedJITEvaluatedSymbolFlags( + Expected* symbolPtr) { + auto& symbol = *symbolPtr; + if (!symbol) { + return LLVMJITSymbolFlagHasError; } - return std::move(*ccMgr).release(); + return wrap(symbol->getFlags()); } -void LLVM_Hs_disposeCallbackManager( - LLVMJITCompileCallbackManagerRef callbackManager) { - delete callbackManager; +void LLVM_Hs_disposeJITEvaluatedSymbol(Expected* symbol) { + delete symbol; } -LLVMIndirectStubsManagerBuilderRef -LLVM_Hs_createLocalIndirectStubsManagerBuilder(const char *triple) { - // We copy the string so that it can be freed on the Haskell side. - std::string tripleStr(triple); - return new std::function()>( - llvm::orc::createLocalIndirectStubsManagerBuilder( - Triple(std::move(tripleStr)))); +MangleAndInterner* LLVM_Hs_createMangleAndInterner(ExecutionSession* es, + LLVMTargetDataRef dl) { + return new MangleAndInterner(*es, *unwrap(dl)); } -void LLVM_Hs_disposeIndirectStubsManagerBuilder( - LLVMIndirectStubsManagerBuilderRef stubsManager) { - delete stubsManager; +void LLVM_Hs_disposeMangleAndInterner(MangleAndInterner* mangler) { + delete mangler; } -void LLVM_Hs_insertFun(std::set *set, llvm::Function *f) { - set->insert(f); -} } - -// #endif diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs deleted file mode 100644 index 4dcdaf8c..00000000 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2.hs +++ /dev/null @@ -1,66 +0,0 @@ -module LLVM.Internal.FFI.OrcJITV2 where - -import LLVM.Prelude - -import LLVM.Internal.FFI.DataLayout (DataLayout) -import LLVM.Internal.FFI.Module (Module) -import LLVM.Internal.FFI.OrcJIT (ExecutionSession, JITDylib) -import LLVM.Internal.FFI.Target (TargetMachine) - -import Foreign.Ptr -import Foreign.C - -data LLVMJITEvaluatedSymbol -data JITEvaluatedSymbol -data ThreadSafeContext -data ThreadSafeModule -data ObjectLayer -data IRLayer - -foreign import ccall safe "LLVM_Hs_createThreadSafeContext" createThreadSafeContext :: - IO (Ptr ThreadSafeContext) - -foreign import ccall safe "LLVM_Hs_disposeThreadSafeContext" disposeThreadSafeContext :: - Ptr ThreadSafeContext -> IO () - -foreign import ccall safe "LLVM_Hs_createThreadSafeModule" createThreadSafeModule :: - Ptr Module -> IO (Ptr ThreadSafeModule) - -foreign import ccall safe "LLVM_Hs_disposeThreadSafeModule" disposeThreadSafeModule :: - Ptr ThreadSafeModule -> IO () - -foreign import ccall safe "LLVM_Hs_createRTDyldObjectLinkingLayer" createRTDyldObjectLinkingLayer :: - Ptr ExecutionSession -> IO (Ptr ObjectLayer) - -foreign import ccall safe "LLVM_Hs_disposeObjectLayer" disposeObjectLayer :: - Ptr ObjectLayer -> IO () - -foreign import ccall safe "LLVM_Hs_createIRCompileLayer" createIRCompileLayer :: - Ptr ExecutionSession -> Ptr ObjectLayer -> Ptr TargetMachine -> IO (Ptr IRLayer) - -foreign import ccall safe "LLVM_Hs_disposeIRLayer" disposeIRLayer :: - Ptr IRLayer -> IO () - -foreign import ccall safe "LLVM_Hs_ExecutionSession_createJITDylib" createJITDylib :: - Ptr ExecutionSession -> CString -> IO (Ptr JITDylib) - -foreign import ccall safe "LLVM_Hs_ExecutionSession_getJITDylibByName" getJITDylibByName :: - Ptr ExecutionSession -> CString -> IO (Ptr JITDylib) - -foreign import ccall safe "LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_forCurrentProcess" - addDynamicLibrarySearchGeneratorForCurrentProcess :: - Ptr JITDylib -> Ptr DataLayout -> IO () - -foreign import ccall safe "LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_load" - addDynamicLibrarySearchGenerator :: - Ptr JITDylib -> Ptr DataLayout -> CString -> IO () - -foreign import ccall safe "LLVM_Hs_IRLayer_addModule" irLayerAddModule :: - Ptr ThreadSafeModule -> Ptr JITDylib -> Ptr DataLayout -> Ptr IRLayer -> IO () - -foreign import ccall safe "LLVM_Hs_ExecutionSession_lookup" lookupSymbol :: - Ptr ExecutionSession -> Ptr JITDylib -> CString -> IO WordPtr - --- foreign import ccall safe "LLVM_Hs_ExecutionSession_lookup" lookupSymbol' :: --- -- Ptr ExecutionSession -> Ptr JITDylib -> CString -> IO JITEvaluatedSymbol --- Ptr ExecutionSession -> Ptr JITDylib -> CString -> IO LLVMJITEvaluatedSymbol diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp deleted file mode 100644 index 32d73c8b..00000000 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITV2C.cpp +++ /dev/null @@ -1,162 +0,0 @@ -#include - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "LLVM/Internal/FFI/Target.hpp" - -// FIXME(llvm-12): Clean up this file. -// Design of ThreadSafeModule APIs may not be ideal. - -using namespace llvm; -using namespace orc; - -extern "C" { - -// Thread-safe context - -ThreadSafeContext* LLVM_Hs_createThreadSafeContext() { - return new ThreadSafeContext(std::make_unique()); -} - -void LLVM_Hs_disposeThreadSafeContext(ThreadSafeContext* ctx) { - delete ctx; -} - -// Thread-safe module - -ThreadSafeModule* LLVM_Hs_createThreadSafeModule(LLVMModuleRef m) { - // FIXME(llvm-12): Module cloning (via `LLVMCloneModule`) was a short-term - // hack to get OrcJIT end-to-end tests to pass. @dan-zheng tried an - // initial exploration of better memory management but didn't find an easy - // fix at the time. - auto moduleClone = LLVMCloneModule(m); - std::unique_ptr module{unwrap(moduleClone)}; - llvm::errs() << "LLVM_Hs_createThreadSafeModule: " << module.get() << "\n"; - return new ThreadSafeModule(std::move(module), std::make_unique()); -} - -void LLVM_Hs_disposeThreadSafeModule(ThreadSafeModule* module) { - llvm::errs() << "LLVM_Hs_disposeThreadSafeModule: " << module->getModuleUnlocked() << "\n"; - if (module == nullptr) { - return; - } - delete module; -} - -// Object layer - -ObjectLayer* LLVM_Hs_createRTDyldObjectLinkingLayer(ExecutionSession* es) { - return new RTDyldObjectLinkingLayer(*es, []() { - return std::make_unique(); - }); -} - -void LLVM_Hs_disposeObjectLayer(ObjectLayer* ol) { - // delete ol; -} - -// Compile layer - -IRLayer* LLVM_Hs_createIRCompileLayer(ExecutionSession* es, ObjectLayer* baseLayer, LLVMTargetMachineRef tm) { - return new IRCompileLayer(*es, *baseLayer, std::make_unique(SimpleCompiler(*unwrap(tm)))); -} - -void LLVM_Hs_disposeIRLayer(IRLayer* il) { - delete il; -} - -void LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_forCurrentProcess(JITDylib* dylib, LLVMTargetDataRef dataLayout) { - auto dataLayoutCpp = *unwrap(dataLayout); - ExitOnError ExitOnErr; - dylib->addGenerator( - ExitOnErr(orc::DynamicLibrarySearchGenerator::GetForCurrentProcess( - dataLayoutCpp.getGlobalPrefix()))); - dylib->addGenerator( - ExitOnErr(orc::DynamicLibrarySearchGenerator::Load( - "/usr/lib/libSystem.dylib", dataLayoutCpp.getGlobalPrefix()))); -} - -void LLVM_Hs_JITDylib_addDynamicLibrarySearchGenerator_load(JITDylib* dylib, LLVMTargetDataRef dataLayout, const char* name) { - auto dataLayoutCpp = *unwrap(dataLayout); - ExitOnError ExitOnErr; - dylib->addGenerator( - ExitOnErr(orc::DynamicLibrarySearchGenerator::Load( - name, dataLayoutCpp.getGlobalPrefix()))); -} - -// Warning: This consumes the module. -void LLVM_Hs_IRLayer_addModule(ThreadSafeModule* tsm, JITDylib* dylib, LLVMTargetDataRef dataLayout, IRLayer* il) { - auto dataLayoutCpp = *unwrap(dataLayout); - tsm->withModuleDo([&](auto& module) { - if (module.getDataLayout().isDefault()) { - module.setDataLayout(dataLayoutCpp); - } - }); - // NOTE: Maybe try module cloning? - llvm::errs() << "LLVM_Hs_IRLayer_add: " << tsm->getModuleUnlocked() << "\n"; - if (Error err = il->add(*dylib, std::move(*tsm))) { - llvm::errs() << err << "\n"; - exit(1); - } -} - -JITDylib* LLVM_Hs_ExecutionSession_createJITDylib(ExecutionSession* es, const char* name) { - if (auto dylibOrErr = es->createJITDylib(name)) { - auto& dylib = *dylibOrErr; - return &dylib; - } else { - Error err = dylibOrErr.takeError(); - llvm::errs() << err << "\n"; - exit(1); - } -} - -JITDylib* LLVM_Hs_ExecutionSession_getJITDylibByName(ExecutionSession* es, const char* name) { - return es->getJITDylibByName(name); -} - -uintptr_t LLVM_Hs_ExecutionSession_lookup(ExecutionSession* es, JITDylib *dylib, const char* mangledName) { - llvm::errs() << "LLVM_Hs_ExecutionSession_lookup start\n"; - es->dump(llvm::errs()); - llvm::errs() << "LLVM_Hs_ExecutionSession_lookup next\n"; - if (auto symbolOrErr = es->lookup({dylib}, mangledName)) { - auto& symbol = *symbolOrErr; - llvm::errs() << "LLVM_Hs_ExecutionSession_lookup end\n"; - return (uintptr_t)symbol.getAddress(); - } else { - llvm::errs() << "LLVM_Hs_ExecutionSession_lookup error\n"; - Error err = symbolOrErr.takeError(); - llvm::errs() << err << "\n"; - exit(1); - } -} - -LLVMJITEvaluatedSymbol LLVM_Hs_ExecutionSession_lookupSymbol(ExecutionSession* es, JITDylib *dylib, const char* mangledName) { - llvm::errs() << "LLVM_Hs_ExecutionSession_lookup start\n"; - // Printing here will show unresolved symbols. - // es->dump(llvm::errs()); - llvm::errs() << "LLVM_Hs_ExecutionSession_lookup next\n"; - if (auto symbolOrErr = es->lookup({dylib}, mangledName)) { - es->dump(llvm::errs()); - auto& symbol = *symbolOrErr; - llvm::errs() << "LLVM_Hs_ExecutionSession_lookup end\n"; - return LLVMJITEvaluatedSymbol{ - symbol.getFlags().getRawFlagsValue(), - static_cast(symbol.getAddress())}; - } else { - Error err = symbolOrErr.takeError(); - llvm::errs() << err << "\n"; - exit(1); - } -} - -} diff --git a/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp b/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp index 7d938d17..827b6302 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp @@ -132,7 +132,7 @@ void LLVM_Hs_AddGCOVProfilerPass( options.NoRedZone = noRedZone; options.Atomic = atomic; options.Filter = filter; - options.Exclude = exclude; + options.Exclude = exclude; unwrap(PM)->add(createGCOVProfilerPass(options)); } @@ -168,25 +168,6 @@ void LLVM_Hs_AddBoundsCheckingPass(LLVMPassManagerRef PM) { unwrap(PM)->add(createBoundsCheckingLegacyPass()); } -// TODO(llvm-12): Confirm that these passes have been removed in LLVM 9 → LLVM 12. -/* -void LLVM_Hs_AddConstantPropagationPass(LLVMPassManagerRef PM) { - unwrap(PM)->add(createConstantPropagationPass()); -} - -void LLVM_Hs_AddDeadInstEliminationPass(LLVMPassManagerRef PM) { - unwrap(PM)->add(createDeadInstEliminationPass()); -} - -void LLVM_Hs_AddIPConstantPropagationPass(LLVMPassManagerRef PM) { - unwrap(PM)->add(createIPConstantPropagationPass()); -} - -void LLVM_Hs_AddInterproceduralConstantPropagationPass(LLVMPassManagerRef PM) { - unwrap(PM)->add(createInterproceduralConstantPropagationPass()); -} -*/ - void LLVM_Hs_AddIPSCCPPass(LLVMPassManagerRef PM) { unwrap(PM)->add(createIPSCCPPass()); } diff --git a/llvm-hs/src/LLVM/Internal/Instruction.hs b/llvm-hs/src/LLVM/Internal/Instruction.hs index 2164159a..f1f2d299 100644 --- a/llvm-hs/src/LLVM/Internal/Instruction.hs +++ b/llvm-hs/src/LLVM/Internal/Instruction.hs @@ -335,7 +335,7 @@ $(do ([], [| do n <- liftIO $ FFI.getShuffleVectorMaskSize i a <- allocaArray n - liftIO $ FFI.getShuffleVectorMask i a + liftIO $ FFI.getShuffleVectorMask i n a decodeM (n, a) |]) "aggregate" -> ([], [| op 0 |]) "metadata" -> ([], [| meta i |]) diff --git a/llvm-hs/src/LLVM/Internal/Linking.hs b/llvm-hs/src/LLVM/Internal/Linking.hs index 13b4485b..c04d915a 100644 --- a/llvm-hs/src/LLVM/Internal/Linking.hs +++ b/llvm-hs/src/LLVM/Internal/Linking.hs @@ -11,14 +11,14 @@ import Foreign.Ptr import LLVM.Internal.Coding import qualified LLVM.Internal.FFI.DynamicLibrary as DL import qualified LLVM.Internal.FFI.RTDyldMemoryManager as Dyld -import LLVM.Internal.OrcJIT +-- FIXME(llvm-12): Add this back -- | Get the address of the given symbol in -- the current process' address space. getSymbolAddressInProcess - :: MangledSymbol -> IO WordPtr -getSymbolAddressInProcess (MangledSymbol sym) - = fromIntegral <$> BS.useAsCString sym Dyld.getSymbolAddressInProcess + :: a -> IO WordPtr +getSymbolAddressInProcess _ = undefined + -- = undefined -- fromIntegral <$> BS.useAsCString sym Dyld.getSymbolAddressInProcess -- | Loads the given dynamic library permanently. If 'Nothing' -- is given, this will make the symbols from the current diff --git a/llvm-hs/src/LLVM/Internal/Module.hs b/llvm-hs/src/LLVM/Internal/Module.hs index cb84a107..24300085 100644 --- a/llvm-hs/src/LLVM/Internal/Module.hs +++ b/llvm-hs/src/LLVM/Internal/Module.hs @@ -564,3 +564,9 @@ moduleAST m = runDecodeAST $ do metadata ++ functionAttributes ++ comdats) + +-- | Dump LLVM IR contained in a module to standard error output (stderr). +dumpModule :: Module -> IO () +dumpModule m = do + mPtr <- readModule m + FFI.dumpModule mPtr diff --git a/llvm-hs/src/LLVM/Internal/OrcJIT.hs b/llvm-hs/src/LLVM/Internal/OrcJIT.hs index 416d91d0..8643ca9d 100644 --- a/llvm-hs/src/LLVM/Internal/OrcJIT.hs +++ b/llvm-hs/src/LLVM/Internal/OrcJIT.hs @@ -1,42 +1,55 @@ {-# LANGUAGE MultiParamTypeClasses #-} module LLVM.Internal.OrcJIT where --- FIXME(llvm-12): Clean up this file. --- Most logic exists in llvm-hs/src/LLVM/Internal/OrcJITV2.hs now. Perhaps --- consider combining the files. - import LLVM.Prelude import Control.Exception import Control.Monad.AnyCont import Control.Monad.IO.Class import Data.Bits -import Data.ByteString (packCString, useAsCString) import Data.IORef import Foreign.C.String import Foreign.Ptr import LLVM.Internal.Coding -import LLVM.Internal.Target -import qualified LLVM.Internal.FFI.DataLayout as FFI +import LLVM.Internal.Module (Module, readModule) +import LLVM.Internal.Target (TargetMachine(..)) + import qualified LLVM.Internal.FFI.LLVMCTypes as FFI +import qualified LLVM.Internal.FFI.ShortByteString as SBS +import qualified LLVM.Internal.FFI.DataLayout as FFI import qualified LLVM.Internal.FFI.OrcJIT as FFI import qualified LLVM.Internal.FFI.Target as FFI --- | A mangled symbol which can be used in 'findSymbol'. This can be --- created using 'mangleSymbol'. -newtype MangledSymbol = MangledSymbol ByteString - deriving (Show, Eq, Ord) +-------------------------------------------------------------------------------- +-- ExecutionSession +-------------------------------------------------------------------------------- -instance EncodeM (AnyContT IO) MangledSymbol CString where - encodeM (MangledSymbol bs) = anyContToM $ useAsCString bs +data ExecutionSession = ExecutionSession { + sessionPtr :: !(Ptr FFI.ExecutionSession), + sessionCleanups :: !(IORef [IO ()]) + } -instance MonadIO m => DecodeM m MangledSymbol CString where - decodeM str = liftIO $ MangledSymbol <$> packCString str +-- | Create a new `ExecutionSession`. +createExecutionSession :: IO ExecutionSession +createExecutionSession = ExecutionSession <$> FFI.createExecutionSession <*> newIORef [] -newtype ExecutionSession = ExecutionSession (Ptr FFI.ExecutionSession) +-- | Dispose of an `ExecutionSession`. This should be called when the +-- `ExecutionSession` is not needed anymore. +disposeExecutionSession :: ExecutionSession -> IO () +disposeExecutionSession (ExecutionSession es cleanups) = do + FFI.endSession es + sequence_ =<< readIORef cleanups + FFI.disposeExecutionSession es -newtype JITDylib = JITDylib (Ptr FFI.JITDylib) +-- | `bracket`-style wrapper around `createExecutionSession` and +-- `disposeExecutionSession`. +withExecutionSession :: (ExecutionSession -> IO a) -> IO a +withExecutionSession = bracket createExecutionSession disposeExecutionSession + +-------------------------------------------------------------------------------- +-- JITSymbol +-------------------------------------------------------------------------------- -- | Contrary to the C++ interface, we do not store the HasError flag -- here. Instead decoding a JITSymbol produces a sumtype based on @@ -50,11 +63,13 @@ data JITSymbolFlags = -- absolute relocations for the symbol even in position -- independent code. , jitSymbolExported :: !Bool -- ^ Is this symbol exported? + , jitSymbolCallable :: !Bool + , jitSymbolMaterializationSideEffectsOnly :: !Bool } deriving (Show, Eq, Ord) defaultJITSymbolFlags :: JITSymbolFlags -defaultJITSymbolFlags = JITSymbolFlags False False False False +defaultJITSymbolFlags = JITSymbolFlags False False False False False False data JITSymbol = JITSymbol { @@ -68,25 +83,6 @@ data JITSymbol = data JITSymbolError = JITSymbolError ShortByteString deriving (Show, Eq) --- | Specifies how external symbols in a module added to a --- 'CompileLayer' should be resolved. -newtype SymbolResolver = - SymbolResolver (MangledSymbol -> IO (Either JITSymbolError JITSymbol)) - --- | Create a `FFI.SymbolResolver` that can be used with the JIT. -withSymbolResolver :: ExecutionSession -> SymbolResolver -> (Ptr FFI.SymbolResolver -> IO a) -> IO a -withSymbolResolver (ExecutionSession es) (SymbolResolver resolverFn) f = - error "NOTE(llvm-12): SymbolResolvers seem deprecated and this should never be called" - {- - bracket (FFI.wrapSymbolResolverFn resolverFn') freeHaskellFunPtr $ \resolverPtr -> - bracket (FFI.createLambdaResolver es resolverPtr) FFI.disposeSymbolResolver $ \resolver -> - f resolver - where - resolverFn' symbol result = do - setSymbol <- encodeM =<< resolverFn =<< decodeM symbol - setSymbol result - -} - instance Monad m => EncodeM m JITSymbolFlags FFI.JITSymbolFlags where encodeM f = return $ foldr1 (.|.) [ if a f @@ -96,7 +92,9 @@ instance Monad m => EncodeM m JITSymbolFlags FFI.JITSymbolFlags where (jitSymbolWeak, FFI.jitSymbolFlagsWeak), (jitSymbolCommon, FFI.jitSymbolFlagsCommon), (jitSymbolAbsolute, FFI.jitSymbolFlagsAbsolute), - (jitSymbolExported, FFI.jitSymbolFlagsExported) + (jitSymbolExported, FFI.jitSymbolFlagsExported), + (jitSymbolCallable, FFI.jitSymbolFlagsCallable), + (jitSymbolMaterializationSideEffectsOnly, FFI.jitSymbolFlagsMaterializationSideEffectsOnly) ] ] @@ -106,89 +104,168 @@ instance Monad m => DecodeM m JITSymbolFlags FFI.JITSymbolFlags where jitSymbolWeak = FFI.jitSymbolFlagsWeak .&. f /= 0, jitSymbolCommon = FFI.jitSymbolFlagsCommon .&. f /= 0, jitSymbolAbsolute = FFI.jitSymbolFlagsAbsolute .&. f /= 0, - jitSymbolExported = FFI.jitSymbolFlagsExported .&. f /= 0 + jitSymbolExported = FFI.jitSymbolFlagsExported .&. f /= 0, + jitSymbolCallable = FFI.jitSymbolFlagsCallable .&. f /= 0, + jitSymbolMaterializationSideEffectsOnly = FFI.jitSymbolFlagsMaterializationSideEffectsOnly .&. f /= 0 } -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 (Either JITSymbolError JITSymbol) (Ptr FFI.JITSymbol) where - decodeM jitSymbol = do +instance (MonadIO m, MonadAnyCont IO m) => + DecodeM m (Either JITSymbolError JITSymbol) (Ptr FFI.ExpectedJITEvaluatedSymbol) where + decodeM expectedSym = do errMsg <- alloca - FFI.TargetAddress addr <- liftIO $ FFI.getAddress jitSymbol errMsg - rawFlags <- liftIO (FFI.getFlags jitSymbol) + FFI.TargetAddress addr <- liftIO $ FFI.getExpectedSymbolAddress expectedSym errMsg + rawFlags <- liftIO (FFI.getExpectedSymbolFlags expectedSym) if addr == 0 || (rawFlags .&. FFI.jitSymbolFlagsHasError /= 0) then do - errMsg <- decodeM =<< liftIO (FFI.getErrorMsg jitSymbol) + errMsg <- decodeM errMsg pure (Left (JITSymbolError errMsg)) else do flags <- decodeM rawFlags pure (Right (JITSymbol (fromIntegral addr) flags)) -{- -instance MonadIO m => - EncodeM m SymbolResolver (IORef [IO ()] -> Ptr FFI.ExecutionSession -> IO (Ptr FFI.SymbolResolver)) where - encodeM (SymbolResolver resolverFn) = return $ \cleanups es -> do - resolverFn' <- allocFunPtr cleanups (encodeM resolverFn) - allocWithCleanup cleanups (FFI.createLambdaResolver es resolverFn') FFI.disposeSymbolResolver - -instance MonadIO m => EncodeM m (MangledSymbol -> IO (Either JITSymbolError JITSymbol)) (FunPtr FFI.SymbolResolverFn) where - encodeM callback = - liftIO $ FFI.wrapSymbolResolverFn - (\symbol result -> do - setSymbol <- encodeM =<< callback =<< decodeM symbol - setSymbol result) --} - --- | Allocate the resource and register it for cleanup. -allocWithCleanup :: IORef [IO ()] -> IO a -> (a -> IO ()) -> IO a -allocWithCleanup cleanups alloc free = mask $ \restore -> do - a <- restore alloc - modifyIORef cleanups (free a :) - pure a - --- | Allocate a function pointer and register it for cleanup. -allocFunPtr :: IORef [IO ()] -> IO (FunPtr a) -> IO (FunPtr a) -allocFunPtr cleanups alloc = allocWithCleanup cleanups alloc freeHaskellFunPtr - -createRegisteredDataLayout :: (MonadAnyCont IO m) => TargetMachine -> IORef [IO ()] -> m (Ptr FFI.DataLayout) -createRegisteredDataLayout (TargetMachine tm) cleanups = - let createDataLayout = do - dl <- FFI.createTargetDataLayout tm - modifyIORef' cleanups (FFI.disposeDataLayout dl :) - pure dl - in anyContToM $ bracketOnError createDataLayout FFI.disposeDataLayout +-------------------------------------------------------------------------------- +-- JITDylib +-------------------------------------------------------------------------------- --- | Create a new `ExecutionSession`. -createExecutionSession :: IO ExecutionSession -createExecutionSession = ExecutionSession <$> FFI.createExecutionSession +newtype JITDylib = JITDylib (Ptr FFI.JITDylib) --- | Dispose of an `ExecutionSession`. This should be called when the --- `ExecutionSession` is not needed anymore. -disposeExecutionSession :: ExecutionSession -> IO () -disposeExecutionSession (ExecutionSession es) = FFI.disposeExecutionSession es +-- | Create a new 'JITDylib' with the given name. +createJITDylib :: ExecutionSession -> ShortByteString -> IO JITDylib +createJITDylib (ExecutionSession es _) name = + SBS.useAsCString name $ fmap JITDylib . FFI.createJITDylib es --- | `bracket`-style wrapper around `createExecutionSession` and --- `disposeExecutionSession`. -withExecutionSession :: (ExecutionSession -> IO a) -> IO a -withExecutionSession = bracket createExecutionSession disposeExecutionSession +-- NB: JITDylib unloading is WIP (at least according to some old-looking docs) + +-- | Adds a 'JITDylib' definition generator that looks up missing symbols in +-- the namespace of the current process. +addDynamicLibrarySearchGeneratorForCurrentProcess :: IRLayer l => l -> JITDylib -> IO () +addDynamicLibrarySearchGeneratorForCurrentProcess compileLayer (JITDylib dylib) = + FFI.addDynamicLibrarySearchGeneratorForCurrentProcess dylib (getDataLayout compileLayer) + +-- | Adds a 'JITDylib' definition generator that looks up missing symbols in +-- the namespace of a shared library located at the specified 'FilePath'. +addDynamicLibrarySearchGenerator :: IRLayer l => l -> JITDylib -> FilePath -> IO () +addDynamicLibrarySearchGenerator compileLayer (JITDylib dylib) s = withCString s $ \cStr -> + FFI.addDynamicLibrarySearchGenerator dylib (getDataLayout compileLayer) cStr + +-- | Looks up an (unmangled) symbol name in the given 'JITDylib'. +-- +-- The symbol is expected to have been added to the 'JITDylib' by the same 'IRLayer' +-- as specified in this function. Using a different 'IRLayer' can cause the lookup +-- to fail due to differences in mangling schemes. +lookupSymbol :: IRLayer l => ExecutionSession -> l -> JITDylib -> ShortByteString -> IO (Either JITSymbolError JITSymbol) +lookupSymbol (ExecutionSession es _) irl (JITDylib dylib) name = SBS.useAsCString name $ \nameStr -> + flip runAnyContT return $ do + symbol <- anyContToM $ bracket + (FFI.lookupSymbol es dylib (getMangler irl) nameStr) FFI.disposeJITEvaluatedSymbol + decodeM symbol + +-------------------------------------------------------------------------------- +-- ThreadSafeContext +-------------------------------------------------------------------------------- + +newtype ThreadSafeContext = ThreadSafeContext (Ptr FFI.ThreadSafeContext) + +-- | Create a 'ThreadSafeContext' +createThreadSafeContext :: IO ThreadSafeContext +createThreadSafeContext = ThreadSafeContext <$> FFI.createThreadSafeContext + +-- | Dispose of a 'ThreadSafeContext' +disposeThreadSafeContext :: ThreadSafeContext -> IO () +disposeThreadSafeContext (ThreadSafeContext ctx) = FFI.disposeThreadSafeContext ctx + +-- | 'bracket'-style wrapper around 'createThreadSafeContext' +-- and 'disposeThreadSafeContext'. +withThreadSafeContext :: (ThreadSafeContext -> IO a) -> IO a +withThreadSafeContext = bracket createThreadSafeContext disposeThreadSafeContext + +-------------------------------------------------------------------------------- +-- ThreadSafeModule +-------------------------------------------------------------------------------- + +newtype ThreadSafeModule = ThreadSafeModule (Ptr FFI.ThreadSafeModule) + +-- | Create a 'ThreadSafeModule' with the same content as the input 'Module'. +-- +-- The module will get cloned into a fresh LLVM context. The lifetime of the +-- new context is bound to the lifetime of the returned 'ThreadSafeModule'. +cloneAsThreadSafeModule :: Module -> IO ThreadSafeModule +cloneAsThreadSafeModule m = do + mPtr <- readModule m + ThreadSafeModule <$> FFI.cloneAsThreadSafeModule mPtr + +-- | Dispose of a 'ThreadSafeModule'. +disposeThreadSafeModule :: ThreadSafeModule -> IO () +disposeThreadSafeModule (ThreadSafeModule m) = FFI.disposeThreadSafeModule m + +-- | 'bracket'-style wrapper around 'cloneAsThreadSafeModule' +-- and 'disposeThreadSafeModule'. +withClonedThreadSafeModule :: Module -> (ThreadSafeModule -> IO a) -> IO a +withClonedThreadSafeModule m = bracket (cloneAsThreadSafeModule m) disposeThreadSafeModule + +-------------------------------------------------------------------------------- +-- ObjectLayer + RTDyldObjectLinkingLayer +-------------------------------------------------------------------------------- + +-- | A type class implemented by the different OrcJIT object layers. +-- +-- See e.g. 'RTDyldObjectLinkingLayer'. +class ObjectLayer l where + getObjectLayer :: l -> Ptr FFI.ObjectLayer + + +data RTDyldObjectLinkingLayer = RTDyldObjectLinkingLayer !(Ptr FFI.ObjectLayer) + +instance ObjectLayer RTDyldObjectLinkingLayer where + getObjectLayer (RTDyldObjectLinkingLayer ol) = ol + +-- | Create a new 'RTDyldObjectLinkingLayer'. +-- +-- The layer will get automatically disposed along with its ExecutionSession. +createRTDyldObjectLinkingLayer :: ExecutionSession -> IO RTDyldObjectLinkingLayer +createRTDyldObjectLinkingLayer (ExecutionSession es cleanups) = do + ol <- FFI.createRTDyldObjectLinkingLayer es + modifyIORef' cleanups (FFI.disposeObjectLayer ol :) + return $ RTDyldObjectLinkingLayer ol + +-------------------------------------------------------------------------------- +-- IRLayer + IRCompileLayer +-------------------------------------------------------------------------------- + +-- | A type class implemented by the different OrcJIT IR layers. +-- +-- See e.g. 'IRCompileLayer'. +class IRLayer l where + getIRLayer :: l -> Ptr FFI.IRLayer + getDataLayout :: l -> Ptr FFI.DataLayout + getMangler :: l -> Ptr FFI.MangleAndInterner + +-- | Add a 'Module' to the specified 'JITDylib'. +-- +-- The specified 'IRLayer' will be responsible for compiling the symbols +-- present in the module. The module itself is consumed and __should not be used again__. +addModule :: IRLayer l => ThreadSafeModule -> JITDylib -> l -> IO () +addModule (ThreadSafeModule m) (JITDylib dylib) irl = + FFI.irLayerAddModule m dylib (getDataLayout irl) (getIRLayer irl) + + +-- | An IR layer that compiles the symbols in a module eagerly. +data IRCompileLayer = IRCompileLayer !(Ptr FFI.IRLayer) !(Ptr FFI.DataLayout) !(Ptr FFI.MangleAndInterner) + +instance IRLayer IRCompileLayer where + getIRLayer (IRCompileLayer cl _ _) = cl + getDataLayout (IRCompileLayer _ dl _) = dl + getMangler (IRCompileLayer _ _ mg) = mg -{- --- | Allocate a module key for a new module to add to the JIT. -allocateModuleKey :: ExecutionSession -> IO FFI.ModuleKey -allocateModuleKey (ExecutionSession es) = FFI.allocateVModule es - --- | Return a module key to the `ExecutionSession` so that it can be --- re-used. -releaseModuleKey :: ExecutionSession -> FFI.ModuleKey -> IO () -releaseModuleKey (ExecutionSession es) k = FFI.releaseVModule es k - --- | `bracket`-style wrapper around `allocateModuleKey` and --- `releaseModuleKey`. -withModuleKey :: ExecutionSession -> (FFI.ModuleKey -> IO a) -> IO a -withModuleKey es = bracket (allocateModuleKey es) (releaseModuleKey es) --} +-- | Create a new 'IRCompileLayer'. +-- +-- The layer will get automatically disposed along with its ExecutionSession. +createIRCompileLayer :: ObjectLayer l => ExecutionSession -> l -> TargetMachine -> IO IRCompileLayer +createIRCompileLayer (ExecutionSession es cleanups) ol (TargetMachine tm) = do + dl <- FFI.createTargetDataLayout tm + modifyIORef' cleanups (FFI.disposeDataLayout dl :) + mg <- FFI.createMangleAndInterner es dl + modifyIORef' cleanups (FFI.disposeMangleAndInterner mg :) + cl <- FFI.createIRCompileLayer es (getObjectLayer ol) tm + modifyIORef' cleanups (FFI.disposeIRLayer cl :) + return $ IRCompileLayer cl dl mg diff --git a/llvm-hs/src/LLVM/Internal/OrcJIT/CompileLayer.hs b/llvm-hs/src/LLVM/Internal/OrcJIT/CompileLayer.hs deleted file mode 100644 index d78bbaa0..00000000 --- a/llvm-hs/src/LLVM/Internal/OrcJIT/CompileLayer.hs +++ /dev/null @@ -1,112 +0,0 @@ -module LLVM.Internal.OrcJIT.CompileLayer - ( module LLVM.Internal.OrcJIT.CompileLayer - , FFI.ModuleKey - ) where - -import LLVM.Prelude - -import Control.Exception -import Control.Monad.AnyCont -import Control.Monad.IO.Class -import Data.IORef -import Foreign.Ptr - -import LLVM.Internal.Coding -import qualified LLVM.Internal.FFI.DataLayout as FFI -import qualified LLVM.Internal.FFI.OrcJIT as FFI -import qualified LLVM.Internal.FFI.OrcJIT.CompileLayer as FFI -import LLVM.Internal.Module hiding (getDataLayout) -import LLVM.Internal.OrcJIT - --- | There are two main types of operations provided by instances of 'CompileLayer'. --- --- 1. You can add \/ remove modules using 'addModule' \/ 'removeModuleSet'. --- --- 2. You can search for symbols using 'findSymbol' \/ 'findSymbolIn' in --- the previously added modules. -class CompileLayer l where - getCompileLayer :: l -> Ptr FFI.CompileLayer - getDataLayout :: l -> Ptr FFI.DataLayout - getCleanups :: l -> IORef [IO ()] - --- | Mangle a symbol according to the data layout stored in the --- 'CompileLayer'. -mangleSymbol :: CompileLayer l => l -> ShortByteString -> IO MangledSymbol -mangleSymbol compileLayer symbol = flip runAnyContT return $ do - mangledSymbol <- alloca - symbol' <- encodeM symbol - anyContToM $ bracket - (FFI.getMangledSymbol mangledSymbol symbol' (getDataLayout compileLayer)) - (\_ -> FFI.disposeMangledSymbol =<< peek mangledSymbol) - decodeM =<< peek mangledSymbol - --- | @'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 (Either JITSymbolError JITSymbol) -findSymbol compileLayer symbol exportedSymbolsOnly = flip runAnyContT return $ do - symbol' <- encodeM symbol - exportedSymbolsOnly' <- encodeM exportedSymbolsOnly - symbol <- anyContToM $ bracket - (FFI.findSymbol (getCompileLayer compileLayer) symbol' exportedSymbolsOnly') FFI.disposeSymbol - decodeM symbol - --- TODO(llvm-12): Consider removing this unused API? -{- --- | @'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.ModuleKey -> MangledSymbol -> Bool -> IO (Either JITSymbolError JITSymbol) -findSymbolIn compileLayer handle symbol exportedSymbolsOnly = flip runAnyContT return $ do - symbol' <- encodeM symbol - exportedSymbolsOnly' <- encodeM exportedSymbolsOnly - symbol <- anyContToM $ bracket - (FFI.findSymbolIn (getCompileLayer compileLayer) handle symbol' exportedSymbolsOnly') FFI.disposeSymbol - decodeM symbol --} - --- TODO(llvm-12): Consider removing this unused API? -{- --- | Add a module to the 'CompileLayer'. The 'SymbolResolver' is used --- to resolve external symbols in the module. --- --- /Note:/ This function consumes the module passed to it and it must --- not be used after calling this method. -addModule :: CompileLayer l => l -> FFI.ModuleKey -> Module -> IO () -addModule compileLayer k mod = flip runAnyContT return $ do - mod' <- liftIO $ readModule mod - liftIO $ deleteModule mod - errMsg <- alloca - liftIO $ - FFI.addModule - (getCompileLayer compileLayer) - (getDataLayout compileLayer) - k - mod' - errMsg --} - --- TODO(llvm-12): Consider removing this unused API? -{- --- | Remove a previously added module. -removeModule :: CompileLayer l => l -> FFI.ModuleKey -> IO () -removeModule compileLayer handle = - FFI.removeModule (getCompileLayer compileLayer) handle - --- | 'bracket'-style wrapper around 'addModule' and 'removeModule'. --- --- /Note:/ This function consumes the module passed to it and it must --- not be used after calling this method. -withModule :: CompileLayer l => l -> FFI.ModuleKey -> Module -> IO a -> IO a -withModule compileLayer k mod = - bracket_ - (addModule compileLayer k mod) - (removeModule compileLayer k) --} - --- | Dispose of a 'CompileLayer'. This should called when the --- 'CompileLayer' is not needed anymore. -disposeCompileLayer :: CompileLayer l => l -> IO () -disposeCompileLayer l = do - FFI.disposeCompileLayer (getCompileLayer l) - sequence_ =<< readIORef (getCleanups l) diff --git a/llvm-hs/src/LLVM/Internal/OrcJIT/CompileOnDemandLayer.hs b/llvm-hs/src/LLVM/Internal/OrcJIT/CompileOnDemandLayer.hs deleted file mode 100644 index eae2d8bf..00000000 --- a/llvm-hs/src/LLVM/Internal/OrcJIT/CompileOnDemandLayer.hs +++ /dev/null @@ -1,186 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-} -module LLVM.Internal.OrcJIT.CompileOnDemandLayer where - -import LLVM.Prelude - -import Control.Exception -import Control.Monad.AnyCont -import Control.Monad.IO.Class -import Data.IORef -import Foreign.Ptr - -import LLVM.Internal.Coding -import LLVM.Internal.OrcJIT -import LLVM.Internal.OrcJIT.CompileLayer -import LLVM.Internal.Target -import qualified LLVM.Internal.FFI.DataLayout as FFI -import qualified LLVM.Internal.FFI.OrcJIT as FFI -import qualified LLVM.Internal.FFI.OrcJIT.CompileOnDemandLayer as FFI -import qualified LLVM.Internal.FFI.PtrHierarchy as FFI - -type PartitioningFn = Ptr FFI.Function -> IO [Ptr FFI.Function] - --- | This is used by 'CompileOnDemandLayer' to create callback that --- compile functions when they are called. -data JITCompileCallbackManager = - CallbackMgr !(Ptr FFI.JITCompileCallbackManager) - !(IO ()) - --- | This is used by 'CompileOnDemandLayer' to manage the stubs --- created for function definitions that have not yet been compiled. -newtype IndirectStubsManagerBuilder = - StubsMgr (Ptr FFI.IndirectStubsManagerBuilder) - --- | Adding a module to a 'CompileOnDemandLayer' creates stubs for its --- functions definitions. When one of those stubs is called, the --- corresponding function body is extracted and compiled. -data CompileOnDemandLayer baseLayer = - CompileOnDemandLayer { - compileLayer :: !(Ptr FFI.CompileOnDemandLayer), - dataLayout :: !(Ptr FFI.DataLayout), - cleanupActions :: !(IORef [IO ()]) - } - deriving Eq - -instance CompileLayer (CompileOnDemandLayer l) where - getCompileLayer = FFI.upCast . compileLayer - getDataLayout = dataLayout - getCleanups = cleanupActions - -instance MonadIO m => - EncodeM m PartitioningFn (IORef [IO ()] -> IO (FunPtr FFI.PartitioningFn)) where - encodeM partition = return $ \cleanups -> do - allocFunPtr - cleanups - (FFI.wrapPartitioningFn - (\f set -> do - fs <- partition f - traverse_ (FFI.insertFun set) fs - return ())) - -instance (MonadIO m, MonadAnyCont IO m) => - EncodeM m (Maybe (IO ())) (FFI.TargetAddress, IO ()) where - encodeM Nothing = return (FFI.TargetAddress 0, return ()) - encodeM (Just f) = do - f' <- anyContToM $ bracketOnError (FFI.wrapErrorHandler f) freeHaskellFunPtr - return - ( (FFI.TargetAddress . fromIntegral . ptrToWordPtr . castFunPtrToPtr) f' - , freeHaskellFunPtr f') - --- | Create a new 'IndirectStubsManagerBuilder'. --- --- When the stubs manager is no longer needed, it should be freed --- using 'disposeIndirectStubsManagerBuilder'. -newIndirectStubsManagerBuilder :: - ShortByteString {- ^ target triple -} -> - IO IndirectStubsManagerBuilder -newIndirectStubsManagerBuilder triple = - flip runAnyContT return $ do - triple' <- encodeM triple - stubsMgr <- liftIO (FFI.createLocalIndirectStubsManagerBuilder triple') - return (StubsMgr stubsMgr) - --- | Dispose of an 'IndirectStubsManagerBuilder'. -disposeIndirectStubsManagerBuilder :: IndirectStubsManagerBuilder -> IO () -disposeIndirectStubsManagerBuilder (StubsMgr stubsMgr) = - FFI.disposeIndirectStubsManagerBuilder stubsMgr - --- | 'bracket'-style wrapper around 'newIndirectStubsManagerBuilder' --- and 'disposeIndirectStubsManagerBuilder'. -withIndirectStubsManagerBuilder :: - ShortByteString {- ^ target triple -} -> - (IndirectStubsManagerBuilder -> IO a) -> - IO a -withIndirectStubsManagerBuilder triple = - bracket - (newIndirectStubsManagerBuilder triple) - disposeIndirectStubsManagerBuilder - --- | Create a new 'JITCompileCallbackManager'. --- --- When the callback manager is no longer needed, it should be freed --- using 'disposeJITCompileCallbackManager'. -newJITCompileCallbackManager :: - ExecutionSession -> - ShortByteString {- ^ target triple -} -> - Maybe (IO ()) {- ^ called on compilation errors -} -> - IO JITCompileCallbackManager -newJITCompileCallbackManager (ExecutionSession es) triple errorHandler = flip runAnyContT return $ do - triple' <- encodeM triple - (errorHandler', cleanup) <- encodeM errorHandler - callbackMgr <- liftIO (FFI.createLocalCompileCallbackManager es triple' errorHandler') - return (CallbackMgr callbackMgr cleanup) - --- | Dispose of a 'JITCompileCallbackManager'. -disposeJITCompileCallbackManager :: JITCompileCallbackManager -> IO () -disposeJITCompileCallbackManager (CallbackMgr mgr cleanup) = - FFI.disposeCallbackManager mgr >> cleanup - --- | Execute a computation using a new 'JITCompileCallbackManager'. -withJITCompileCallbackManager :: - ExecutionSession -> - ShortByteString {- ^ target triple -} -> - Maybe (IO ()) {- ^ called on compilation errors -} -> - (JITCompileCallbackManager -> IO a) -> - IO a -withJITCompileCallbackManager es triple errorHandler = - bracket - (newJITCompileCallbackManager es triple errorHandler) - disposeJITCompileCallbackManager - --- | Create a new 'CompileOnDemandLayer'. The partitioning function --- specifies which functions should be compiled when a function is --- called. --- --- When the layer is no longer needed, it should be disposed using 'disposeCompileLayer'. -newCompileOnDemandLayer :: CompileLayer l => - ExecutionSession -> - l -> - TargetMachine -> - (ModuleKey -> IO (Ptr FFI.SymbolResolver)) -> - (ModuleKey -> Ptr FFI.SymbolResolver -> IO ()) -> - (Ptr FFI.Function -> IO [Ptr FFI.Function]) {- ^ partitioning function -} -> - JITCompileCallbackManager -> - IndirectStubsManagerBuilder -> - Bool {- ^ clone stubs into partitions -} -> - IO (CompileOnDemandLayer l) -newCompileOnDemandLayer (ExecutionSession es) baseLayer tm getSymbolResolver setSymbolResolver partition (CallbackMgr callbackMgr _) (StubsMgr stubsMgr) cloneStubs = - flip runAnyContT return $ do - cleanups <- liftIO (newIORef []) - dl <- createRegisteredDataLayout tm cleanups - getSymbolResolver' <- liftIO (allocFunPtr cleanups (FFI.wrapGetSymbolResolver getSymbolResolver)) - setSymbolResolver' <- liftIO (allocFunPtr cleanups (FFI.wrapSetSymbolResolver setSymbolResolver)) - partitionAct <- encodeM partition - partition' <- liftIO $ partitionAct cleanups - cloneStubs' <- encodeM cloneStubs - cl <- - liftIO - (FFI.createCompileOnDemandLayer - es - (getCompileLayer baseLayer) - getSymbolResolver' - setSymbolResolver' - partition' - callbackMgr - stubsMgr - cloneStubs') - return (CompileOnDemandLayer cl dl cleanups) - --- | 'bracket'-style wrapper around 'newCompileOnDemandLayer' and 'disposeCompileLayer'. -withCompileOnDemandLayer :: - CompileLayer l => - ExecutionSession -> - l -> - TargetMachine -> - (ModuleKey -> IO (Ptr FFI.SymbolResolver)) -> - (ModuleKey -> Ptr FFI.SymbolResolver -> IO ()) -> - (Ptr FFI.Function -> IO [Ptr FFI.Function]) {- ^ partitioning function -} -> - JITCompileCallbackManager -> - IndirectStubsManagerBuilder -> - Bool {- ^ clone stubs into partitions -} -> - (CompileOnDemandLayer l -> IO a) -> - IO a -withCompileOnDemandLayer es l tm getSymbolResolver setSymbolResolver partition callbackMgr stubsMgr cloneStubs = - bracket - (newCompileOnDemandLayer es l tm getSymbolResolver setSymbolResolver partition callbackMgr stubsMgr cloneStubs) - disposeCompileLayer diff --git a/llvm-hs/src/LLVM/Internal/OrcJIT/IRCompileLayer.hs b/llvm-hs/src/LLVM/Internal/OrcJIT/IRCompileLayer.hs deleted file mode 100644 index 47d83442..00000000 --- a/llvm-hs/src/LLVM/Internal/OrcJIT/IRCompileLayer.hs +++ /dev/null @@ -1,54 +0,0 @@ -module LLVM.Internal.OrcJIT.IRCompileLayer where - -import LLVM.Prelude - -import Control.Exception -import Control.Monad.AnyCont -import Control.Monad.IO.Class -import Data.IORef -import Foreign.Ptr - -import qualified LLVM.Internal.FFI.DataLayout as FFI -import qualified LLVM.Internal.FFI.OrcJIT.CompileLayer as FFI -import qualified LLVM.Internal.FFI.OrcJIT.IRCompileLayer as FFI -import qualified LLVM.Internal.FFI.PtrHierarchy as FFI -import LLVM.Internal.OrcJIT -import LLVM.Internal.OrcJIT.CompileLayer -import LLVM.Internal.OrcJIT.LinkingLayer (LinkingLayer(..), getLinkingLayer) -import LLVM.Internal.Target - --- | 'IRCompileLayer' compiles modules immediately when they are --- added. It parametrized by a 'LinkingLayer' which handles linking of --- the generated object files. -data IRCompileLayer linkingLayer = - IRCompileLayer { - compileLayer :: !(Ptr FFI.IRCompileLayer), - dataLayout :: !(Ptr FFI.DataLayout), - cleanupActions :: !(IORef [IO ()]) - } - deriving Eq - -instance CompileLayer (IRCompileLayer l) where - getCompileLayer = FFI.upCast . compileLayer - getDataLayout = dataLayout - getCleanups = cleanupActions - --- | Create a new 'IRCompileLayer'. --- --- When the layer is no longer needed, it should be disposed using 'disposeCompileLayer. -newIRCompileLayer :: LinkingLayer l => l -> TargetMachine -> IO (IRCompileLayer l) -newIRCompileLayer linkingLayer (TargetMachine tm) = flip runAnyContT return $ do - cleanups <- liftIO (newIORef []) - dl <- createRegisteredDataLayout (TargetMachine tm) cleanups - cl <- anyContToM $ - bracketOnError - (FFI.createIRCompileLayer (getLinkingLayer linkingLayer) tm) - (FFI.disposeCompileLayer . FFI.upCast) - return (IRCompileLayer cl dl cleanups) - -{- --- | 'bracket'-style wrapper around 'newIRCompileLayer' and 'disposeCompileLayer'. -withIRCompileLayer :: LinkingLayer l => l -> TargetMachine -> (IRCompileLayer l -> IO a) -> IO a -withIRCompileLayer linkingLayer tm = - bracket (newIRCompileLayer linkingLayer tm) disposeCompileLayer --} diff --git a/llvm-hs/src/LLVM/Internal/OrcJIT/IRTransformLayer.hs b/llvm-hs/src/LLVM/Internal/OrcJIT/IRTransformLayer.hs deleted file mode 100644 index 747cb811..00000000 --- a/llvm-hs/src/LLVM/Internal/OrcJIT/IRTransformLayer.hs +++ /dev/null @@ -1,69 +0,0 @@ -module LLVM.Internal.OrcJIT.IRTransformLayer where - -import LLVM.Prelude - -import Control.Exception -import Control.Monad.AnyCont -import Control.Monad.IO.Class -import Data.IORef -import Foreign.Ptr - -import qualified LLVM.Internal.FFI.DataLayout as FFI -import qualified LLVM.Internal.FFI.Module as FFI -import qualified LLVM.Internal.FFI.OrcJIT.IRTransformLayer as FFI -import qualified LLVM.Internal.FFI.PtrHierarchy as FFI -import LLVM.Internal.OrcJIT -import LLVM.Internal.OrcJIT.CompileLayer -import LLVM.Internal.Target - --- | 'IRTransformLayer' allows transforming modules before handing off --- compilation to the underlying 'CompileLayer'. -data IRTransformLayer baseLayer = - IRTransformLayer { - compileLayer :: !(Ptr FFI.IRTransformLayer), - dataLayout :: !(Ptr FFI.DataLayout), - cleanupActions :: !(IORef [IO ()]) - } - deriving Eq - -instance CompileLayer (IRTransformLayer l) where - getCompileLayer = FFI.upCast . compileLayer - getDataLayout = dataLayout - getCleanups = cleanupActions - --- | Create a new 'IRTransformLayer'. --- --- When the layer is no longer needed, it should be disposed using 'disposeCompileLayer'. -newIRTransformLayer - :: CompileLayer l - => l - -> TargetMachine - -> (Ptr FFI.Module -> IO (Ptr FFI.Module)) {- ^ module transformation -} - -> IO (IRTransformLayer l) -newIRTransformLayer compileLayer tm moduleTransform = - flip runAnyContT return $ do - cleanups <- liftIO (newIORef []) - dl <- createRegisteredDataLayout tm cleanups - let encodedModuleTransform = - allocFunPtr cleanups (FFI.wrapModuleTransform moduleTransform) - moduleTransform' <- - anyContToM $ bracketOnError encodedModuleTransform freeHaskellFunPtr - cl <- - liftIO - (FFI.createIRTransformLayer - (getCompileLayer compileLayer) - moduleTransform') - return (IRTransformLayer cl dl cleanups) - --- | 'bracket'-style wrapper around 'newIRTransformLayer' and 'disposeCompileLayer'. -withIRTransformLayer :: - CompileLayer l - => l - -> TargetMachine - -> (Ptr FFI.Module -> IO (Ptr FFI.Module)) {- ^ module transformation -} - -> (IRTransformLayer l -> IO a) - -> IO a -withIRTransformLayer compileLayer tm moduleTransform = - bracket - (newIRTransformLayer compileLayer tm moduleTransform) - disposeCompileLayer diff --git a/llvm-hs/src/LLVM/Internal/OrcJIT/LinkingLayer.hs b/llvm-hs/src/LLVM/Internal/OrcJIT/LinkingLayer.hs deleted file mode 100644 index fd5b11a9..00000000 --- a/llvm-hs/src/LLVM/Internal/OrcJIT/LinkingLayer.hs +++ /dev/null @@ -1,87 +0,0 @@ -module LLVM.Internal.OrcJIT.LinkingLayer where - -import LLVM.Prelude - -import Control.Exception -import Control.Monad.AnyCont -import Control.Monad.IO.Class -import Data.IORef -import Foreign.Ptr - -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, --- it passes the resulting object files to a 'LinkingLayer'. -class LinkingLayer l where - getLinkingLayer :: l -> Ptr FFI.LinkingLayer - getCleanups :: l -> IORef [IO ()] - --- | Dispose of a 'LinkingLayer'. -disposeLinkingLayer :: LinkingLayer l => l -> IO () -disposeLinkingLayer l = do - FFI.disposeLinkingLayer (getLinkingLayer l) - sequence_ =<< readIORef (getCleanups l) - --- | Add an object file to the 'LinkingLayer'. -addObjectFile :: LinkingLayer l => l -> FFI.ModuleKey -> ObjectFile -> IO () -addObjectFile linkingLayer k (ObjectFile obj) = flip runAnyContT return $ do - errMsg <- alloca - liftIO $ - FFI.addObjectFile - (getLinkingLayer linkingLayer) - k - obj - errMsg - --- | Bare bones implementation of a 'LinkingLayer'. -data ObjectLinkingLayer = ObjectLinkingLayer { - linkingLayer :: !(Ptr FFI.ObjectLinkingLayer), - cleanupActions :: !(IORef [IO ()]) - } - -instance LinkingLayer ObjectLinkingLayer where - getLinkingLayer (ObjectLinkingLayer ptr _) = FFI.upCast ptr - getCleanups = cleanupActions - --- | Create a new 'ObjectLinkingLayer'. This should be disposed using --- 'disposeLinkingLayer' when it is no longer needed. -newObjectLinkingLayer :: ExecutionSession -> (FFI.ModuleKey -> IO (Ptr FFI.SymbolResolver)) -> IO ObjectLinkingLayer -newObjectLinkingLayer (ExecutionSession es) getResolver = do - cleanups <- liftIO (newIORef []) - getResolver' <- allocFunPtr cleanups (FFI.wrapGetSymbolResolver getResolver) - linkingLayer <- FFI.createObjectLinkingLayer es getResolver' - return $ ObjectLinkingLayer linkingLayer cleanups - --- | 'bracket'-style wrapper around 'newObjectLinkingLayer' and 'disposeLinkingLayer'. -withObjectLinkingLayer :: ExecutionSession -> (FFI.ModuleKey -> IO (Ptr FFI.SymbolResolver)) -> (ObjectLinkingLayer -> IO a) -> IO a -withObjectLinkingLayer es resolver = bracket (newObjectLinkingLayer es resolver) 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.ModuleKey -> 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 diff --git a/llvm-hs/src/LLVM/Internal/OrcJITV2.hs b/llvm-hs/src/LLVM/Internal/OrcJITV2.hs deleted file mode 100644 index 8fbbfb41..00000000 --- a/llvm-hs/src/LLVM/Internal/OrcJITV2.hs +++ /dev/null @@ -1,162 +0,0 @@ -module LLVM.Internal.OrcJITV2 - ( ExecutionSession - , withExecutionSession - , lookupSymbol - , createJITDylib - , getJITDylibByName - , addDynamicLibrarySearchGeneratorForCurrentProcess - , addDynamicLibrarySearchGenerator - , ThreadSafeContext - , withThreadSafeContext - , createThreadSafeContext - , disposeThreadSafeContext - , withThreadSafeModule - , createThreadSafeModule - , disposeThreadSafeModule - , ObjectLayer - , createRTDyldObjectLinkingLayer - , disposeObjectLayer - , withRTDyldObjectLinkingLayer - , IRLayer - , withIRCompileLayer - , createIRCompileLayer - , disposeIRCompileLayer - , addModule - , mangleSymbol - -- , JITEvaluatedSymbol - ) where - --- FIXME(llvm-12): Clean up this file. - -import LLVM.Prelude - -import Control.Exception -import Control.Monad.AnyCont -import Foreign.C -import Foreign.Ptr - -import LLVM.Internal.Coding -import LLVM.Internal.Module (Module, readModule) --- import LLVM.Internal.OrcJIT (ExecutionSession(..), JITDylib(..), withExecutionSession, MangledSymbol, JITSymbol, JITSymbolError) -import LLVM.Internal.OrcJIT (ExecutionSession(..), JITDylib(..), withExecutionSession, MangledSymbol) -import LLVM.Internal.Target (TargetMachine(..)) - -import qualified LLVM.Internal.FFI.DataLayout as FFI -import qualified LLVM.Internal.FFI.OrcJIT as FFI -import qualified LLVM.Internal.FFI.OrcJITV2 as FFI -import qualified LLVM.Internal.FFI.Target as FFI - --- newtype JITEvaluatedSymbol = JITEvaluatedSymbol (Ptr FFI.JITEvaluatedSymbol, Word8) - -newtype ThreadSafeContext = ThreadSafeContext (Ptr FFI.ThreadSafeContext) - -newtype ThreadSafeModule = ThreadSafeModule (Ptr FFI.ThreadSafeModule) - -data IRLayer = IRLayer - { _getIRLayer :: Ptr FFI.IRLayer - , _getDataLayout :: Ptr FFI.DataLayout - } -newtype ObjectLayer = ObjectLayer (Ptr FFI.ObjectLayer) - -createJITDylib :: ExecutionSession -> String -> IO JITDylib -createJITDylib (ExecutionSession es) s = withCString s - (fmap JITDylib . FFI.createJITDylib es) - -getJITDylibByName :: ExecutionSession -> String -> IO JITDylib -getJITDylibByName (ExecutionSession es) s = withCString s - (fmap JITDylib . FFI.getJITDylibByName es) - -addDynamicLibrarySearchGeneratorForCurrentProcess :: IRLayer -> JITDylib -> IO () -addDynamicLibrarySearchGeneratorForCurrentProcess compileLayer (JITDylib dylib) = - FFI.addDynamicLibrarySearchGeneratorForCurrentProcess dylib (_getDataLayout compileLayer) - -addDynamicLibrarySearchGenerator :: IRLayer -> JITDylib -> String -> IO () -addDynamicLibrarySearchGenerator compileLayer (JITDylib dylib) s = withCString s $ \cStr -> - FFI.addDynamicLibrarySearchGenerator dylib (_getDataLayout compileLayer) cStr - --- | Mangle a symbol according to the data layout stored in the --- 'CompileLayer'. -mangleSymbol :: IRLayer -> ShortByteString -> IO MangledSymbol -mangleSymbol compileLayer symbol = flip runAnyContT return $ do - mangledSymbol <- alloca - symbol' <- encodeM symbol - anyContToM $ bracket - (FFI.getMangledSymbol mangledSymbol symbol' (_getDataLayout compileLayer)) - (\_ -> FFI.disposeMangledSymbol =<< peek mangledSymbol) - decodeM =<< peek mangledSymbol - --- NOTE(llvm-12): This is commented because finding via *MangledSymbol* is not --- yet supported. Supporting this function seems important and desirable because --- "looking up mangled symbols" is platform-independent while "looking up --- symbols directly via mangled string name" is not. -{- --- | @'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 :: IRLayer -> MangledSymbol -> Bool -> IO (Either JITSymbolError JITSymbol) -findSymbolIn compileLayer symbol exportedSymbolsOnly = flip runAnyContT return $ do - symbol' <- encodeM symbol - exportedSymbolsOnly' <- encodeM exportedSymbolsOnly - symbol <- anyContToM $ bracket - (FFI.findSymbolIn compileLayer symbol' exportedSymbolsOnly') FFI.disposeSymbol - decodeM symbol --} - --- TODO(llvm-12): Consider removing "looking up symbols directly via mangled --- string name", which is platform-dependent. See comment above on --- @findSymbolIn@. Example: platform-dependent @main@ vs @_main@ symbol name. -lookupSymbol :: ExecutionSession -> JITDylib -> String -> IO WordPtr -lookupSymbol (ExecutionSession es) (JITDylib dylib) s = withCString s $ \cStr -> - FFI.lookupSymbol es dylib cStr - -createThreadSafeContext :: IO ThreadSafeContext -createThreadSafeContext = ThreadSafeContext <$> FFI.createThreadSafeContext - -disposeThreadSafeContext :: ThreadSafeContext -> IO () -disposeThreadSafeContext (ThreadSafeContext ctx) = FFI.disposeThreadSafeContext ctx - -withThreadSafeContext :: (ThreadSafeContext -> IO a) -> IO a -withThreadSafeContext = bracket createThreadSafeContext disposeThreadSafeContext - -createThreadSafeModule :: Module -> IO ThreadSafeModule -createThreadSafeModule m = do - mPtr <- readModule m - ThreadSafeModule <$> FFI.createThreadSafeModule mPtr - -disposeThreadSafeModule :: ThreadSafeModule -> IO () -disposeThreadSafeModule (ThreadSafeModule m) = FFI.disposeThreadSafeModule m - -withThreadSafeModule :: Module -> (ThreadSafeModule -> IO a) -> IO a -withThreadSafeModule m = bracket (createThreadSafeModule m) disposeThreadSafeModule - -createRTDyldObjectLinkingLayer :: ExecutionSession -> IO ObjectLayer -createRTDyldObjectLinkingLayer (ExecutionSession es) = - ObjectLayer <$> FFI.createRTDyldObjectLinkingLayer es - -disposeObjectLayer :: ObjectLayer -> IO () -disposeObjectLayer (ObjectLayer ol) = FFI.disposeObjectLayer ol - -withRTDyldObjectLinkingLayer :: ExecutionSession -> (ObjectLayer -> IO a) -> IO a -withRTDyldObjectLinkingLayer es = - bracket - (createRTDyldObjectLinkingLayer es) - disposeObjectLayer - -createIRCompileLayer :: ExecutionSession -> ObjectLayer -> TargetMachine -> IO IRLayer -createIRCompileLayer (ExecutionSession es) (ObjectLayer ol) (TargetMachine tm) = do - dl <- FFI.createTargetDataLayout tm - il <- FFI.createIRCompileLayer es ol tm - pure $ IRLayer il dl - -disposeIRCompileLayer :: IRLayer -> IO () -disposeIRCompileLayer (IRLayer il _) = FFI.disposeIRLayer il - -withIRCompileLayer :: ExecutionSession -> ObjectLayer -> TargetMachine -> (IRLayer -> IO a) -> IO a -withIRCompileLayer es ol tm = - bracket - (createIRCompileLayer es ol tm) - disposeIRCompileLayer - -addModule :: ThreadSafeModule -> JITDylib -> IRLayer -> IO () -addModule (ThreadSafeModule m) (JITDylib dylib) (IRLayer il dl) = do - FFI.irLayerAddModule m dylib dl il diff --git a/llvm-hs/src/LLVM/Module.hs b/llvm-hs/src/LLVM/Module.hs index 562ca8c9..d3b8db51 100644 --- a/llvm-hs/src/LLVM/Module.hs +++ b/llvm-hs/src/LLVM/Module.hs @@ -25,7 +25,9 @@ module LLVM.Module ( moduleObject, writeObjectToFile, - linkModules + linkModules, + + dumpModule ) where import LLVM.Internal.Module diff --git a/llvm-hs/src/LLVM/OrcJIT.hs b/llvm-hs/src/LLVM/OrcJIT.hs index 3edf89d1..74c14462 100644 --- a/llvm-hs/src/LLVM/OrcJIT.hs +++ b/llvm-hs/src/LLVM/OrcJIT.hs @@ -1,93 +1,44 @@ module LLVM.OrcJIT ( - -- * CompileLayer - CompileLayer, - -- ** Add/remove modules - ModuleKey, - -- TODO(llvm-12): Remove unused APIs. - -- LLVM.Internal.OrcJIT.CompileLayer.addModule, - -- removeModule, - -- withModule, - -- ** Search for symbols - JITSymbol(..), - JITSymbolError(..), - JITSymbolFlags(..), - defaultJITSymbolFlags, - SymbolResolver(..), - withSymbolResolver, - -- ** Symbol mangling - MangledSymbol(..), - -- TODO: Remove prefix. - LLVM.Internal.OrcJITV2.mangleSymbol, - -- ** ExecutionSession + -- * ExecutionSession ExecutionSession, createExecutionSession, disposeExecutionSession, withExecutionSession, - -- allocateModuleKey, - -- releaseModuleKey, - -- withModuleKey, - -- ** IRCompileLayer - IRCompileLayer, - newIRCompileLayer, - withIRCompileLayer, - -- ** CompileOnDemandLayer - CompileOnDemandLayer, - newCompileOnDemandLayer, - withCompileOnDemandLayer, - -- ** IRTRansformLayer - IRTransformLayer, - newIRTransformLayer, - withIRTransformLayer, - -- ** Dispose of compile layers - disposeCompileLayer, - -- * LinkingLayer - LinkingLayer, - -- ** Create linking layers - ObjectLinkingLayer, - newObjectLinkingLayer, - withObjectLinkingLayer, - -- ** Dispose of linking layers - disposeLinkingLayer, - -- ** Add an object file - addObjectFile, - -- * JITCompileCallbackManager - JITCompileCallbackManager, - newJITCompileCallbackManager, - disposeJITCompileCallbackManager, - withJITCompileCallbackManager, - -- * IndirectStubsManagerBuilder - IndirectStubsManagerBuilder, - newIndirectStubsManagerBuilder, - disposeIndirectStubsManagerBuilder, - withIndirectStubsManagerBuilder, - -- * OrcJITV2 + -- * JITDylib JITDylib(..), - lookupSymbol, createJITDylib, - getJITDylibByName, + -- ** Symbol search generators addDynamicLibrarySearchGeneratorForCurrentProcess, addDynamicLibrarySearchGenerator, + -- ** Symbol lookups + lookupSymbol, + JITSymbol(..), + JITSymbolError(..), + JITSymbolFlags(..), + defaultJITSymbolFlags, + -- * ThreadSafeContext ThreadSafeContext, + -- ** Lifetime management withThreadSafeContext, createThreadSafeContext, disposeThreadSafeContext, - withThreadSafeModule, - createThreadSafeModule, + -- * ThreadSafeModule + ThreadSafeModule, + -- ** Lifetime management + withClonedThreadSafeModule, + cloneAsThreadSafeModule, disposeThreadSafeModule, + -- * Object layers ObjectLayer, + -- ** RTDyldObjectLinkingLayer + RTDyldObjectLinkingLayer, createRTDyldObjectLinkingLayer, - disposeObjectLayer, - withRTDyldObjectLinkingLayer, + -- * IR layers IRLayer, + addModule, + -- ** IRCompileLayer + IRCompileLayer, createIRCompileLayer, - disposeIRCompileLayer, - LLVM.Internal.OrcJITV2.addModule, ) where import LLVM.Internal.OrcJIT -import LLVM.Internal.OrcJIT.CompileLayer -import LLVM.Internal.OrcJIT.LinkingLayer -import LLVM.Internal.OrcJIT.CompileOnDemandLayer -import LLVM.Internal.OrcJIT.IRCompileLayer -import LLVM.Internal.OrcJIT.IRTransformLayer -import LLVM.Internal.OrcJITV2 diff --git a/llvm-hs/src/LLVM/OrcJIT/CompileLayer.hs b/llvm-hs/src/LLVM/OrcJIT/CompileLayer.hs deleted file mode 100644 index 7758f890..00000000 --- a/llvm-hs/src/LLVM/OrcJIT/CompileLayer.hs +++ /dev/null @@ -1,13 +0,0 @@ -module LLVM.OrcJIT.CompileLayer - ( CompileLayer(..) - , mangleSymbol - , findSymbol - -- TODO(llvm-12): Remove unused APIs. - -- , findSymbolIn - -- , addModule - -- , removeModule - -- , withModule - , disposeCompileLayer - ) where - -import LLVM.Internal.OrcJIT.CompileLayer diff --git a/llvm-hs/src/LLVM/OrcJIT/LinkingLayer.hs b/llvm-hs/src/LLVM/OrcJIT/LinkingLayer.hs deleted file mode 100644 index 7a534bf8..00000000 --- a/llvm-hs/src/LLVM/OrcJIT/LinkingLayer.hs +++ /dev/null @@ -1,12 +0,0 @@ -module LLVM.OrcJIT.LinkingLayer - ( LinkingLayer(..) - , disposeLinkingLayer - , ObjectLinkingLayer(..) - , newObjectLinkingLayer - , withObjectLinkingLayer - , addObjectFile - , findSymbol - , findSymbolIn - ) where - -import LLVM.Internal.OrcJIT.LinkingLayer diff --git a/llvm-hs/src/LLVM/Transforms.hs b/llvm-hs/src/LLVM/Transforms.hs index 7e595f4f..2fa59a99 100644 --- a/llvm-hs/src/LLVM/Transforms.hs +++ b/llvm-hs/src/LLVM/Transforms.hs @@ -25,6 +25,7 @@ data Pass | GlobalValueNumbering { noLoads :: Bool } | InductionVariableSimplify | InstructionCombining + -- | Instruction simplification includes constant folding | InstructionSimplify | JumpThreading | LoopClosedSingleStaticAssignment @@ -44,9 +45,9 @@ data Pass | PromoteMemoryToRegister | Reassociate | ScalarReplacementOfAggregates { requiresDominatorTree :: Bool } - | OldScalarReplacementOfAggregates { - oldScalarReplacementOfAggregatesThreshold :: Maybe Word, - useDominatorTree :: Bool, + | OldScalarReplacementOfAggregates { + oldScalarReplacementOfAggregatesThreshold :: Maybe Word, + useDominatorTree :: Bool, structMemberThreshold :: Maybe Word, arrayElementThreshold :: Maybe Word, scalarLoadThreshold :: Maybe Word @@ -62,7 +63,7 @@ data Pass | ArgumentPromotion | ConstantMerge | FunctionAttributes - | FunctionInlining { + | FunctionInlining { functionInliningThreshold :: Word } | GlobalDeadCodeElimination @@ -87,7 +88,7 @@ data Pass | GCOVProfiler { emitNotes :: Bool, emitData :: Bool, - version :: GCOVVersion, + version :: GCOVVersion, noRedZone :: Bool, atomic :: Bool, filter :: String, @@ -120,7 +121,7 @@ defaultGCOVProfiler :: Pass defaultGCOVProfiler = GCOVProfiler { emitNotes = True, emitData = True, - version = GCOVVersion "402*", + version = GCOVVersion "402*", noRedZone = False, atomic = True, LLVM.Transforms.filter = "", diff --git a/llvm-hs/test/LLVM/Test/Instrumentation.hs b/llvm-hs/test/LLVM/Test/Instrumentation.hs index 9198d903..67f8c3d4 100644 --- a/llvm-hs/test/LLVM/Test/Instrumentation.hs +++ b/llvm-hs/test/LLVM/Test/Instrumentation.hs @@ -6,7 +6,7 @@ import Test.Tasty.HUnit import LLVM.Test.Support -import Control.Monad.Trans.Except +import Control.Monad.Trans.Except import Control.Monad.Except (catchError) import Control.Monad.IO.Class @@ -35,8 +35,6 @@ import qualified LLVM.AST.Attribute as A import qualified LLVM.AST.Global as G import qualified LLVM.AST.Constant as C -import Debug.Trace - instrument :: PassSetSpec -> A.Module -> IO A.Module instrument s m = withContext $ \context -> withModuleFromAST context m $ \mIn' -> do withPassManager s $ \pm -> runPassManager pm mIn' @@ -169,13 +167,11 @@ tests = testGroup "Instrumentation" [ testGroup "basic" [ testCase n $ do - shouldTestPass' <- shouldTestPass - if not shouldTestPass' + shouldTest <- checkIfShouldTest + if not shouldTest then return () else do - cpu <- getHostCPUName triple <- getProcessTargetTriple - bool <- isMemorySanitizerSupported withTargetLibraryInfo triple $ \tli -> do dl <- withHostTargetMachineDefault getTargetMachineDataLayout ast <- ast @@ -183,6 +179,6 @@ tests = let names ast = [ n | GlobalDefinition d <- moduleDefinitions ast, Name n <- return (G.name d) ] names ast' `List.intersect` names ast @?= names ast | - (n, p, shouldTestPass) <- instrumentationPasses + (n, p, checkIfShouldTest) <- instrumentationPasses ] ] diff --git a/llvm-hs/test/LLVM/Test/Optimization.hs b/llvm-hs/test/LLVM/Test/Optimization.hs index ed54cae3..9a4d553e 100644 --- a/llvm-hs/test/LLVM/Test/Optimization.hs +++ b/llvm-hs/test/LLVM/Test/Optimization.hs @@ -30,8 +30,6 @@ import qualified LLVM.AST.CallingConvention as CC import qualified LLVM.AST.Attribute as A import qualified LLVM.AST.Global as G import qualified LLVM.AST.Constant as C -import qualified LLVM.Internal.Module as M (readModule) -import qualified LLVM.Internal.FFI.Module as M (dumpModule) import qualified LLVM.Relocation as R import qualified LLVM.CodeModel as CM @@ -39,14 +37,7 @@ import qualified LLVM.CodeGenOpt as CGO import Debug.Trace --- TODO(llvm-12): This utility for dumping a module might be useful. --- Consider moving to library code or deleting it from this test. -dumpModule' :: A.Module -> IO () -dumpModule' m = withContext $ \context -> withModuleFromAST context m $ \m' -> do - mPtr <- M.readModule m' - M.dumpModule mPtr - -handAST = +handAST = Module "" "" Nothing Nothing [ GlobalDefinition $ functionDefaults { G.returnType = i32, @@ -252,11 +243,11 @@ tests = testGroup "Optimization" [ testCase "LoopVectorize" $ do let - mIn = + mIn = Module { moduleName = "", moduleSourceFileName = "", - moduleDataLayout = Just $ (defaultDataLayout BigEndian) { + moduleDataLayout = Just $ (defaultDataLayout BigEndian) { typeLayouts = Map.singleton (VectorAlign, 128) (AlignmentInfo 128 128) }, moduleTargetTriple = Just "x86_64", @@ -277,7 +268,7 @@ tests = testGroup "Optimization" [ UnName 1 := ICmp IPred.SGT (LocalReference i32 (Name "n")) (ConstantOperand (C.Int 32 0)) [] ] (Do $ CondBr (LocalReference i1 (UnName 1)) (Name ".lr.ph") (Name "._crit_edge") []), BasicBlock (Name ".lr.ph") [ - Name "indvars.iv" := Phi i64 [ + Name "indvars.iv" := Phi i64 [ (ConstantOperand (C.Int 64 0), UnName 0), (LocalReference i64 (Name "indvars.iv.next"), Name ".lr.ph") ] [], @@ -306,7 +297,7 @@ tests = testGroup "Optimization" [ (target, _) <- lookupTarget Nothing triple withTargetOptions $ \targetOptions -> do withTargetMachine target triple "" Map.empty targetOptions R.Default CM.Default CGO.Default $ \tm -> do - optimize (defaultPassSetSpec { + optimize (defaultPassSetSpec { transforms = [ T.defaultLoopVectorize ], dataLayout = moduleDataLayout mIn, targetMachine = Just tm @@ -319,7 +310,7 @@ tests = testGroup "Optimization" [ -- how unwinding works (as is the invoke instruction) withContext $ \context -> do withPassManager (defaultPassSetSpec { transforms = [T.LowerInvoke] }) $ \passManager -> do - let astIn = + let astIn = Module "" "" Nothing Nothing [ GlobalDefinition $ functionDefaults { G.returnType = i32, @@ -332,7 +323,7 @@ tests = testGroup "Optimization" [ ) ] } - ] + ] astOut <- withModuleFromAST context astIn $ \mIn -> do runPassManager passManager mIn moduleAST mIn diff --git a/llvm-hs/test/LLVM/Test/OrcJIT.hs b/llvm-hs/test/LLVM/Test/OrcJIT.hs index eefef6b7..ddacca52 100644 --- a/llvm-hs/test/LLVM/Test/OrcJIT.hs +++ b/llvm-hs/test/LLVM/Test/OrcJIT.hs @@ -23,10 +23,8 @@ import qualified LLVM.Internal.FFI.PassManager as FFI import LLVM.Context import LLVM.Module import qualified LLVM.Internal.FFI.Module as FFI -import qualified LLVM.Internal.OrcJITV2 as OrcV2 +-- import qualified LLVM.Internal.OrcJITV2 as OrcV2 import LLVM.OrcJIT -import qualified LLVM.Internal.OrcJIT.CompileLayer as CL -import qualified LLVM.Internal.OrcJIT.LinkingLayer as LL import LLVM.Target import qualified LLVM.Relocation as Reloc import qualified LLVM.CodeModel as CodeModel @@ -67,18 +65,6 @@ foreign import ccall "wrapper" foreign import ccall "dynamic" mkMain :: FunPtr (IO Word32) -> IO Word32 -resolver :: CompileLayer l => MangledSymbol -> l -> MangledSymbol -> IO (Either JITSymbolError JITSymbol) -resolver testFunc compileLayer symbol = do - if symbol /= testFunc - then CL.findSymbol compileLayer symbol True - else do - funPtr <- wrapTestFunc myTestFuncImpl - let addr = ptrToWordPtr (castFunPtrToPtr funPtr) - return (Right (JITSymbol addr defaultJITSymbolFlags)) - -nullResolver :: MangledSymbol -> IO (Either JITSymbolError JITSymbol) -nullResolver s = putStrLn "nullresolver" >> return (Left (JITSymbolError "unknown symbol")) - moduleTransform :: IORef Bool -> Ptr FFI.Module -> IO (Ptr FFI.Module) moduleTransform passmanagerSuccessful modulePtr = do withPassManager defaultCuratedPassSetSpec { optLevel = Just 2 } $ \(PassManager pm) -> do @@ -88,34 +74,50 @@ moduleTransform passmanagerSuccessful modulePtr = do tests :: TestTree tests = - testGroup "OrcJit" [ - -- FIXME(llvm-12): Re-enable tests. - -- Tests are temporarily disabled until they are rewritten using OrcJIT V2 APIs. - -- API usages to be updated: withModuleKey, withSymbolResolver, etc. - {- - testCase "eager compilation" $ do - resolvers <- newIORef Map.empty - withTestModule $ \mod -> + testGroup "OrcJIT" [ + testCase "basic self-contained function" $ do + withTest2Module $ \m -> withHostTargetMachine Reloc.PIC CodeModel.Default CodeGenOpt.Default $ \tm -> - withExecutionSession $ \es -> - withObjectLinkingLayer es (\k -> fmap (\rs -> rs Map.! k) (readIORef resolvers)) $ \linkingLayer -> - withIRCompileLayer linkingLayer tm $ \compileLayer -> do - testFunc <- mangleSymbol compileLayer "testFunc" - withModuleKey es $ \k -> - withSymbolResolver es (SymbolResolver (resolver testFunc compileLayer)) $ \resolver -> do - modifyIORef' resolvers (Map.insert k resolver) - withModule compileLayer k mod $ do - mainSymbol <- mangleSymbol compileLayer "main" - Right (JITSymbol mainFn _) <- CL.findSymbol compileLayer mainSymbol True - result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) - result @?= 42 - Right (JITSymbol mainFn _) <- CL.findSymbolIn compileLayer k mainSymbol True - result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) - result @?= 42 - unknownSymbol <- mangleSymbol compileLayer "unknownSymbol" - unknownSymbolRes <- CL.findSymbol compileLayer unknownSymbol True - unknownSymbolRes @?= Left (JITSymbolError mempty), + withExecutionSession $ \es -> do + let dylibName = "myDylib" + dylib <- createJITDylib es dylibName + withClonedThreadSafeModule m $ \tsm -> do + ol <- createRTDyldObjectLinkingLayer es + il <- createIRCompileLayer es ol tm + addModule tsm dylib il + Right (JITSymbol addr _) <- lookupSymbol es il dylib "main" + let mainFn = mkMain (castPtrToFunPtr $ wordPtrToPtr $ fromIntegral addr) + result <- mainFn + result @?= 42 + + -- TODO: Make it possible to use Haskell functions as definition generators + -- and update to OrcJITv2 + {- + testCase "eager compilation" $ do + withTestModule $ \mod -> + withHostTargetMachine Reloc.PIC CodeModel.Default CodeGenOpt.Default $ \tm -> + withExecutionSession $ \es -> + withObjectLinkingLayer es (\k -> fmap (\rs -> rs Map.! k) (readIORef resolvers)) $ \linkingLayer -> + withIRCompileLayer linkingLayer tm $ \compileLayer -> do + testFunc <- mangleSymbol compileLayer "testFunc" + withModuleKey es $ \k -> + withSymbolResolver es (SymbolResolver (resolver testFunc compileLayer)) $ \resolver -> do + modifyIORef' resolvers (Map.insert k resolver) + withModule compileLayer k mod $ do + mainSymbol <- mangleSymbol compileLayer "main" + Right (JITSymbol mainFn _) <- CL.findSymbol compileLayer mainSymbol True + result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) + result @?= 42 + Right (JITSymbol mainFn _) <- CL.findSymbolIn compileLayer k mainSymbol True + result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) + result @?= 42 + unknownSymbol <- mangleSymbol compileLayer "unknownSymbol" + unknownSymbolRes <- CL.findSymbol compileLayer unknownSymbol True + unknownSymbolRes @?= Left (JITSymbolError mempty), + -} + -- TODO: Add IRTransformLayer and translate to OrcJITv2 + {- testCase "IRTransformLayer" $ do passmanagerSuccessful <- newIORef False resolvers <- newIORef Map.empty @@ -135,7 +137,10 @@ tests = result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) result @?= 42 readIORef passmanagerSuccessful @? "passmanager failed", + -} + -- TODO: Add IRTransformLayer and translate to OrcJITv2 + {- testCase "lazy compilation" $ do resolvers <- newIORef Map.empty let getResolver k = fmap (Map.! k) (readIORef resolvers) @@ -158,7 +163,10 @@ tests = Right (JITSymbol mainFn _) <- CL.findSymbol compileLayer mainSymbol True result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) result @?= 42, + -} + -- TODO: Add support for loading object files and update to OrcJITv2 + {- testCase "finding symbols in linking layer" $ withExecutionSession $ \es -> withModuleKey es $ \k -> @@ -178,25 +186,4 @@ tests = result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) result @?= 38, -} - - testCase "OrcV2" $ do - withTest2Module $ \m -> - withHostTargetMachine Reloc.PIC CodeModel.Default CodeGenOpt.Default $ \tm -> - OrcV2.withExecutionSession $ \es -> do - let dylibName = "JITDylibName" - dylib <- OrcV2.createJITDylib es dylibName - OrcV2.withThreadSafeModule m $ \mod -> - OrcV2.withRTDyldObjectLinkingLayer es $ \ol -> - OrcV2.withIRCompileLayer es ol tm $ \il -> do - dl <- getTargetMachineDataLayout tm - dylib' <- OrcV2.getJITDylibByName es dylibName - OrcV2.addModule mod dylib il - -- FIXME(llvm-12): "main" vs "_main" symbol name seems platform-dependent, - -- to be verified. "main" on Linux and "_main" on macOS. Find a - -- robust platform-independent fix – perhaps by reviving - -- `OrcV2.findSymbolIn` which takes a `MangledSymbol`. - addr <- OrcV2.lookupSymbol es dylib "_main" - let mainFn = mkMain (castPtrToFunPtr $ wordPtrToPtr $ fromIntegral addr) - result <- mainFn - result @?= 42 ] diff --git a/llvm-hs/test/LLVM/Test/ParameterAttribute.hs b/llvm-hs/test/LLVM/Test/ParameterAttribute.hs index 79342124..af7cf4ad 100644 --- a/llvm-hs/test/LLVM/Test/ParameterAttribute.hs +++ b/llvm-hs/test/LLVM/Test/ParameterAttribute.hs @@ -31,7 +31,7 @@ instance Arbitrary ParameterAttribute where , return SignExt , return InReg , return SRet - , Alignment <$> elements (map (2^) [0..29 :: Int]) + , Alignment <$> elements (map (2^) [0..30 :: Int]) , return NoAlias , return ByVal , return NoCapture diff --git a/shell.nix b/shell.nix deleted file mode 100644 index 3a889530..00000000 --- a/shell.nix +++ /dev/null @@ -1,33 +0,0 @@ -let - default_nixpkgs = (import {}).fetchFromGitHub { - owner = "NixOS"; - repo = "nixpkgs"; - rev = "d587092e9e7df9786495c19f710cf6469d72eecb"; - sha256 = "1ygabmi2lmgy93a1zlmd7hw4ky83rjb6hn6ji40pj8flb437b8c4"; - }; -in - -{ nixpkgs ? default_nixpkgs -, compiler ? "ghc881" }: -let - hsOverlay = self: super: { - llvm_9 = (super.llvm_9.override { debugVersion = true; }).overrideAttrs(_: { doCheck = false; }); - haskell = super.haskell // { - packages = super.haskell.packages // { - "${compiler}" = super.haskell.packages."${compiler}".override { - overrides = haskellSelf: haskellSuper: { - llvm-hs = haskellSuper.callCabal2nix "llvm-hs" ./llvm-hs { llvm-config = self.llvm_9; }; - llvm-hs-pure = haskellSuper.callCabal2nix "llvm-hs-pure" ./llvm-hs-pure {}; - }; - }; - }; - }; - }; - - orig_pkgs = import nixpkgs {}; - pkgs = import orig_pkgs.path { overlays = [ hsOverlay ]; }; -in -pkgs.haskell.packages."${compiler}".shellFor { - packages = pkgs: with pkgs; [llvm-hs llvm-hs-pure]; - nativeBuildInputs = with pkgs; [ llvm_9 gdb lldb ]; -} diff --git a/stack.yaml b/stack.yaml index 9d7f92aa..124ff6e4 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: nightly-2020-01-30 +resolver: lts-16.31 packages: - llvm-hs From f5ee162a4a942ab874c4e9ab7d91a776661fb11d Mon Sep 17 00:00:00 2001 From: Shaurya Gupta Date: Wed, 17 Mar 2021 16:40:47 +0000 Subject: [PATCH 04/37] Fix Optimization.hs test: willreturn attributes are now inferred. https://github.com/llvm/llvm-project/commit/65fd034b95d69fa0e634861ee165b502ceb92a12 --- llvm-hs/test/LLVM/Test/Optimization.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/llvm-hs/test/LLVM/Test/Optimization.hs b/llvm-hs/test/LLVM/Test/Optimization.hs index 9a4d553e..004f38b5 100644 --- a/llvm-hs/test/LLVM/Test/Optimization.hs +++ b/llvm-hs/test/LLVM/Test/Optimization.hs @@ -143,7 +143,7 @@ tests = testGroup "Optimization" [ ) ] }, - FunctionAttributes (A.GroupID 0) [A.NoRecurse, A.NoUnwind, A.ReadNone, A.UWTable] + FunctionAttributes (A.GroupID 0) [A.NoRecurse, A.NoUnwind, A.ReadNone, A.UWTable, A.WillReturn] ], testGroup "individual" [ From 24ddfdf45f69bbe94ec0c97c7d4faae4a0ed205f Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Thu, 18 Mar 2021 17:39:55 +0000 Subject: [PATCH 05/37] Restore getSymbolAddressInProcess --- llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs | 10 ++++++++++ llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp | 12 ++++++++++++ llvm-hs/src/LLVM/Internal/Linking.hs | 11 ++++++----- llvm-hs/src/LLVM/Internal/OrcJIT.hs | 12 ++++++++++++ 4 files changed, 40 insertions(+), 5 deletions(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs index 02a301c4..23040f32 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJIT.hs @@ -21,6 +21,7 @@ data ObjectLayer data IRLayer data JITDylib data ExecutionSession +data SymbolStringPtr foreign import ccall safe "LLVM_Hs_createExecutionSession" createExecutionSession :: IO (Ptr ExecutionSession) @@ -86,3 +87,12 @@ foreign import ccall safe "LLVM_Hs_createMangleAndInterner" createMangleAndInter foreign import ccall safe "LLVM_Hs_disposeMangleAndInterner" disposeMangleAndInterner :: Ptr MangleAndInterner -> IO () + +foreign import ccall safe "LLVM_Hs_MangleAndInterner_call" mangleSymbol :: + Ptr MangleAndInterner -> CString -> IO (Ptr SymbolStringPtr) + +foreign import ccall safe "LLVM_Hs_SymbolStringPtr_c_str" mangledSymbolString :: + Ptr SymbolStringPtr -> IO CString + +foreign import ccall safe "LLVM_Hs_disposeSymbolStringPtr" disposeMangledSymbol :: + Ptr SymbolStringPtr -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp index 7b46ec10..29515d8d 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp @@ -208,4 +208,16 @@ void LLVM_Hs_disposeMangleAndInterner(MangleAndInterner* mangler) { delete mangler; } +SymbolStringPtr* LLVM_Hs_MangleAndInterner_call(MangleAndInterner* mangler, const char* name) { + return new SymbolStringPtr((*mangler)(name)); +} + +const char* LLVM_Hs_SymbolStringPtr_c_str(SymbolStringPtr* ptr) { + return (*(*ptr)).data(); +} + +void LLVM_Hs_disposeSymbolStringPtr(SymbolStringPtr* ptr) { + delete ptr; +} + } diff --git a/llvm-hs/src/LLVM/Internal/Linking.hs b/llvm-hs/src/LLVM/Internal/Linking.hs index c04d915a..402ce3cb 100644 --- a/llvm-hs/src/LLVM/Internal/Linking.hs +++ b/llvm-hs/src/LLVM/Internal/Linking.hs @@ -5,20 +5,21 @@ module LLVM.Internal.Linking import LLVM.Prelude -import qualified Data.ByteString as BS import Foreign.C.String import Foreign.Ptr import LLVM.Internal.Coding +import LLVM.Internal.OrcJIT +import qualified LLVM.Internal.FFI.OrcJIT as FFI import qualified LLVM.Internal.FFI.DynamicLibrary as DL import qualified LLVM.Internal.FFI.RTDyldMemoryManager as Dyld --- FIXME(llvm-12): Add this back -- | Get the address of the given symbol in -- the current process' address space. getSymbolAddressInProcess - :: a -> IO WordPtr -getSymbolAddressInProcess _ = undefined - -- = undefined -- fromIntegral <$> BS.useAsCString sym Dyld.getSymbolAddressInProcess + :: MangledSymbol -> IO WordPtr +getSymbolAddressInProcess (MangledSymbol sym) = do + symStr <- FFI.mangledSymbolString sym + fromIntegral <$> Dyld.getSymbolAddressInProcess symStr -- | Loads the given dynamic library permanently. If 'Nothing' -- is given, this will make the symbols from the current diff --git a/llvm-hs/src/LLVM/Internal/OrcJIT.hs b/llvm-hs/src/LLVM/Internal/OrcJIT.hs index 8643ca9d..220688aa 100644 --- a/llvm-hs/src/LLVM/Internal/OrcJIT.hs +++ b/llvm-hs/src/LLVM/Internal/OrcJIT.hs @@ -232,6 +232,9 @@ createRTDyldObjectLinkingLayer (ExecutionSession es cleanups) = do -- IRLayer + IRCompileLayer -------------------------------------------------------------------------------- +-- | A mangled symbol name. Valid only for as long as the IRLayer that created it. +newtype MangledSymbol = MangledSymbol (Ptr FFI.SymbolStringPtr) + -- | A type class implemented by the different OrcJIT IR layers. -- -- See e.g. 'IRCompileLayer'. @@ -248,6 +251,15 @@ addModule :: IRLayer l => ThreadSafeModule -> JITDylib -> l -> IO () addModule (ThreadSafeModule m) (JITDylib dylib) irl = FFI.irLayerAddModule m dylib (getDataLayout irl) (getIRLayer irl) +mangleSymbol :: IRLayer l => l -> ShortByteString -> IO MangledSymbol +mangleSymbol irl name = SBS.useAsCString name $ \namePtr -> + MangledSymbol <$> FFI.mangleSymbol (getMangler irl) namePtr + +disposeMangledSymbol :: MangledSymbol -> IO () +disposeMangledSymbol (MangledSymbol symbol) = FFI.disposeMangledSymbol symbol + +withMangledSymbol :: IRLayer l => l -> ShortByteString -> (MangledSymbol -> IO a) -> IO a +withMangledSymbol irl name = bracket (mangleSymbol irl name) disposeMangledSymbol -- | An IR layer that compiles the symbols in a module eagerly. data IRCompileLayer = IRCompileLayer !(Ptr FFI.IRLayer) !(Ptr FFI.DataLayout) !(Ptr FFI.MangleAndInterner) From 313cf5e1bef0e91f13165e31d53f44867dc7924d Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Fri, 19 Mar 2021 18:43:49 +0000 Subject: [PATCH 06/37] Replace calls to dump() with print() dump() is only available in debug builds of LLVM. --- llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp | 2 +- llvm-hs/src/LLVM/Internal/FFI/ModuleC.cpp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp b/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp index 03ed42e3..6dbdc43a 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp @@ -80,7 +80,7 @@ MDTuple* LLVM_Hs_Get_MDTuple(LLVMContextRef c, } void LLVM_Hs_DumpMetadata(LLVMMetadataRef md) { - unwrap(md)->dump(); + unwrap(md)->print(llvm::errs(), nullptr); } unsigned LLVM_Hs_GetMDKindNames( diff --git a/llvm-hs/src/LLVM/Internal/FFI/ModuleC.cpp b/llvm-hs/src/LLVM/Internal/FFI/ModuleC.cpp index dc601447..80751576 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/ModuleC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/ModuleC.cpp @@ -7,7 +7,7 @@ using namespace llvm; extern "C" { void LLVM_Hs_DumpModule(LLVMModuleRef m) { - unwrap(m)->dump(); + unwrap(m)->print(llvm::errs(), nullptr); } char *LLVM_Hs_GetModuleIdentifier(LLVMModuleRef val) { From 7d3033a4a6c041d517ce2a8c1f5bdeb82ab90361 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Fri, 19 Mar 2021 19:30:35 +0000 Subject: [PATCH 07/37] Remove incorrect alignment value from tests --- llvm-hs/test/LLVM/Test/ParameterAttribute.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/llvm-hs/test/LLVM/Test/ParameterAttribute.hs b/llvm-hs/test/LLVM/Test/ParameterAttribute.hs index af7cf4ad..2776f499 100644 --- a/llvm-hs/test/LLVM/Test/ParameterAttribute.hs +++ b/llvm-hs/test/LLVM/Test/ParameterAttribute.hs @@ -31,7 +31,8 @@ instance Arbitrary ParameterAttribute where , return SignExt , return InReg , return SRet - , Alignment <$> elements (map (2^) [0..30 :: Int]) + -- LLVM doesn't allow alignments larger than 2^29! + , Alignment <$> elements (map (2^) [0..29 :: Int]) , return NoAlias , return ByVal , return NoCapture From 0eab4eb0f50949b84d4a66e11be97b335c3532cc Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Fri, 19 Mar 2021 18:44:32 +0000 Subject: [PATCH 08/37] Update to LLVM HEAD (version 13) * Add an `alignment` field to atomic instructions to match the new builder signatures. --- .travis.yml | 2 +- README.md | 5 +- llvm-hs-pure/llvm-hs-pure.cabal | 4 +- llvm-hs-pure/src/LLVM/AST/Instruction.hs | 178 +++++++++--------- llvm-hs/Setup.hs | 2 +- llvm-hs/llvm-hs.cabal | 6 +- llvm-hs/src/LLVM/Internal/FFI/Builder.hs | 12 +- llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp | 10 +- .../src/LLVM/Internal/FFI/InstructionC.cpp | 6 +- llvm-hs/test/LLVM/Test/Instructions.hs | 98 +++++----- 10 files changed, 166 insertions(+), 157 deletions(-) diff --git a/.travis.yml b/.travis.yml index 461a61a8..aae4d196 100644 --- a/.travis.yml +++ b/.travis.yml @@ -48,7 +48,7 @@ install: - unzip ninja-linux.zip -d $HOME/bin - # curl -L https://github.com/llvm/llvm-project/releases/download/llvmorg-${LLVM_VER}/llvm-${LLVM_VER}.src.tar.xz | tar -xJf - -C $HOME - # rsync -ac $HOME/llvm-${LLVM_VER}.src/ $HOME/llvm-src-${LLVM_VER} - - git clone https://github.com/llvm/llvm-project -b release/12.x --single-branch + - git clone https://github.com/llvm/llvm-project --single-branch - cd llvm-project/llvm - mkdir -p build && cd build - cmake -DCMAKE_BUILD_TYPE=Release -DCMAKE_CXX_FLAGS_RELEASE=-O0 -DCMAKE_INSTALL_PREFIX=$HOME/llvm-build-${LLVM_VER} -DLLVM_PARALLEL_LINK_JOBS=1 -DLLVM_TARGETS_TO_BUILD=X86 -DLLVM_BUILD_LLVM_DYLIB=True -DLLVM_LINK_LLVM_DYLIB=True -GNinja .. diff --git a/README.md b/README.md index 949e67a6..edadf0ac 100644 --- a/README.md +++ b/README.md @@ -27,9 +27,8 @@ inconveniences. ## Installing LLVM -LLVM 12 is still not fully released, and as such is unavailable in most -package managers. For now, the only reliable way to obtain the binaries -is to build it form source, following the instructions below. +This branch tracks LLVM HEAD, meaning that the only way to build it is to +use a fresh checkout of LLVM sources. ### Building from source diff --git a/llvm-hs-pure/llvm-hs-pure.cabal b/llvm-hs-pure/llvm-hs-pure.cabal index 3ed4dcd4..9daa376c 100644 --- a/llvm-hs-pure/llvm-hs-pure.cabal +++ b/llvm-hs-pure/llvm-hs-pure.cabal @@ -1,5 +1,5 @@ name: llvm-hs-pure -version: 12.0.0 +version: 13.0.0 license: BSD3 license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer , Benjamin S. Scarlet @@ -22,7 +22,7 @@ extra-source-files: CHANGELOG.md source-repository head type: git location: git://github.com/llvm-hs/llvm-hs.git - branch: llvm-12 + branch: llvm-head-unstable library default-language: Haskell2010 diff --git a/llvm-hs-pure/src/LLVM/AST/Instruction.hs b/llvm-hs-pure/src/LLVM/AST/Instruction.hs index 420ccc46..5ff94d16 100644 --- a/llvm-hs-pure/src/LLVM/AST/Instruction.hs +++ b/llvm-hs-pure/src/LLVM/AST/Instruction.hs @@ -1,4 +1,4 @@ --- | LLVM instructions +-- | LLVM instructions -- module LLVM.AST.Instruction where @@ -22,18 +22,18 @@ import Data.List.NonEmpty type InstructionMetadata = [(ShortByteString, MDRef MDNode)] -- | -data Terminator - = Ret { +data Terminator + = Ret { returnOperand :: Maybe Operand, metadata' :: InstructionMetadata } - | CondBr { - condition :: Operand, - trueDest :: Name, + | CondBr { + condition :: Operand, + trueDest :: Name, falseDest :: Name, metadata' :: InstructionMetadata } - | Br { + | Br { dest :: Name, metadata' :: InstructionMetadata } @@ -84,7 +84,7 @@ data Terminator deriving (Eq, Read, Show, Typeable, Data, Generic) -- | -data FastMathFlags +data FastMathFlags = FastMathFlags { allowReassoc :: Bool, noNaNs :: Bool, @@ -145,7 +145,7 @@ data TailCallKind = Tail | MustTail | NoTail -- -- data Instruction - = Add { + = Add { nsw :: Bool, nuw :: Bool, operand0 :: Operand, @@ -165,150 +165,152 @@ data Instruction operand1 :: Operand, metadata :: InstructionMetadata } - | FSub { + | FSub { fastMathFlags :: FastMathFlags, - operand0 :: Operand, - operand1 :: Operand, + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | Mul { - nsw :: Bool, - nuw :: Bool, - operand0 :: Operand, - operand1 :: Operand, - metadata :: InstructionMetadata + | Mul { + nsw :: Bool, + nuw :: Bool, + operand0 :: Operand, + operand1 :: Operand, + metadata :: InstructionMetadata } - | FMul { + | FMul { fastMathFlags :: FastMathFlags, - operand0 :: Operand, - operand1 :: Operand, + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | UDiv { - exact :: Bool, - operand0 :: Operand, - operand1 :: Operand, + | UDiv { + exact :: Bool, + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | SDiv { - exact :: Bool, - operand0 :: Operand, - operand1 :: Operand, + | SDiv { + exact :: Bool, + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | FDiv { + | FDiv { fastMathFlags :: FastMathFlags, - operand0 :: Operand, - operand1 :: Operand, + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | URem { - operand0 :: Operand, - operand1 :: Operand, + | URem { + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | SRem { - operand0 :: Operand, - operand1 :: Operand, + | SRem { + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | FRem { + | FRem { fastMathFlags :: FastMathFlags, - operand0 :: Operand, - operand1 :: Operand, + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | Shl { - nsw :: Bool, - nuw :: Bool, - operand0 :: Operand, - operand1 :: Operand, + | Shl { + nsw :: Bool, + nuw :: Bool, + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | LShr { - exact :: Bool, - operand0 :: Operand, - operand1 :: Operand, + | LShr { + exact :: Bool, + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | AShr { - exact :: Bool, - operand0 :: Operand, - operand1 :: Operand, + | AShr { + exact :: Bool, + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | And { - operand0 :: Operand, - operand1 :: Operand, + | And { + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | Or { - operand0 :: Operand, - operand1 :: Operand, + | Or { + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | Xor { - operand0 :: Operand, - operand1 :: Operand, + | Xor { + operand0 :: Operand, + operand1 :: Operand, metadata :: InstructionMetadata } - | Alloca { + | Alloca { allocatedType :: Type, numElements :: Maybe Operand, alignment :: Word32, metadata :: InstructionMetadata } | Load { - volatile :: Bool, + volatile :: Bool, address :: Operand, maybeAtomicity :: Maybe Atomicity, alignment :: Word32, metadata :: InstructionMetadata } | Store { - volatile :: Bool, + volatile :: Bool, address :: Operand, value :: Operand, maybeAtomicity :: Maybe Atomicity, alignment :: Word32, metadata :: InstructionMetadata } - | GetElementPtr { + | GetElementPtr { inBounds :: Bool, address :: Operand, indices :: [Operand], metadata :: InstructionMetadata } - | Fence { + | Fence { atomicity :: Atomicity, - metadata :: InstructionMetadata + metadata :: InstructionMetadata } - | CmpXchg { + | CmpXchg { volatile :: Bool, address :: Operand, expected :: Operand, replacement :: Operand, + alignment :: Word32, atomicity :: Atomicity, failureMemoryOrdering :: MemoryOrdering, - metadata :: InstructionMetadata + metadata :: InstructionMetadata } - | AtomicRMW { + | AtomicRMW { volatile :: Bool, rmwOperation :: RMWOperation, address :: Operand, value :: Operand, + alignment :: Word32, atomicity :: Atomicity, - metadata :: InstructionMetadata + metadata :: InstructionMetadata } - | Trunc { + | Trunc { operand0 :: Operand, type' :: Type, - metadata :: InstructionMetadata + metadata :: InstructionMetadata } | ZExt { operand0 :: Operand, type' :: Type, - metadata :: InstructionMetadata + metadata :: InstructionMetadata } | SExt { operand0 :: Operand, @@ -381,7 +383,7 @@ data Instruction type' :: Type, incomingValues :: [ (Operand, Name) ], metadata :: InstructionMetadata - } + } | Freeze { operand0 :: Operand, type' :: Type, @@ -402,44 +404,44 @@ data Instruction functionAttributes :: [Either FA.GroupID FA.FunctionAttribute], metadata :: InstructionMetadata } - | VAArg { + | VAArg { argList :: Operand, type' :: Type, - metadata :: InstructionMetadata + metadata :: InstructionMetadata } - | ExtractElement { + | ExtractElement { vector :: Operand, index :: Operand, - metadata :: InstructionMetadata + metadata :: InstructionMetadata } - | InsertElement { + | InsertElement { vector :: Operand, element :: Operand, index :: Operand, metadata :: InstructionMetadata } - | ShuffleVector { + | ShuffleVector { operand0 :: Operand, operand1 :: Operand, mask :: [Int32], metadata :: InstructionMetadata } - | ExtractValue { + | ExtractValue { aggregate :: Operand, indices' :: [Word32], metadata :: InstructionMetadata } - | InsertValue { + | InsertValue { aggregate :: Operand, element :: Operand, indices' :: [Word32], metadata :: InstructionMetadata } - | LandingPad { + | LandingPad { type' :: Type, cleanup :: Bool, clauses :: [LandingPadClause], - metadata :: InstructionMetadata + metadata :: InstructionMetadata } | CatchPad { catchSwitch :: Operand, @@ -456,7 +458,7 @@ data Instruction -- | Instances of instructions may be given a name, allowing their results to be referenced as 'Operand's. -- Sometimes instructions - e.g. a call to a function returning void - don't need names. -data Named a +data Named a = Name := a | Do a deriving (Eq, Read, Show, Typeable, Data, Generic) diff --git a/llvm-hs/Setup.hs b/llvm-hs/Setup.hs index 729cdd75..20fbb965 100644 --- a/llvm-hs/Setup.hs +++ b/llvm-hs/Setup.hs @@ -41,7 +41,7 @@ lookupFlagAssignment = lookup #endif llvmVersion :: Version -llvmVersion = mkVersion [12,0] +llvmVersion = mkVersion [13,0] -- Ordered by decreasing specificty so we will prefer llvm-config-9.0 -- over llvm-config-9 over llvm-config. diff --git a/llvm-hs/llvm-hs.cabal b/llvm-hs/llvm-hs.cabal index 015140a2..593cd7a4 100644 --- a/llvm-hs/llvm-hs.cabal +++ b/llvm-hs/llvm-hs.cabal @@ -1,5 +1,5 @@ name: llvm-hs -version: 12.0.0 +version: 13.0.0 license: BSD3 license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer , Benjamin S. Scarlet @@ -48,7 +48,7 @@ extra-source-files: CHANGELOG.md source-repository head type: git location: git://github.com/llvm-hs/llvm-hs.git - branch: llvm-12 + branch: llvm-head-unstable flag shared-llvm description: link against llvm shared rather than static library @@ -79,7 +79,7 @@ library template-haskell >= 2.5.0.0, containers >= 0.4.2.1, array >= 0.4.0.0, - llvm-hs-pure == 12.0.* + llvm-hs-pure == 13.0.* hs-source-dirs: src default-extensions: NoImplicitPrelude diff --git a/llvm-hs/src/LLVM/Internal/FFI/Builder.hs b/llvm-hs/src/LLVM/Internal/FFI/Builder.hs index 0b3aa901..e3167ce7 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Builder.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Builder.hs @@ -125,16 +125,16 @@ buildFence :: Ptr Builder -> (SynchronizationScope, MemoryOrdering) -> CString - buildFence builder (ss, mo) s = buildFence' builder mo ss s foreign import ccall unsafe "LLVM_Hs_BuildAtomicCmpXchg" buildCmpXchg' :: - Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> Ptr Value -> MemoryOrdering -> MemoryOrdering -> SynchronizationScope -> CString -> IO (Ptr Instruction) + Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> Ptr Value -> CUInt -> MemoryOrdering -> MemoryOrdering -> SynchronizationScope -> CString -> IO (Ptr Instruction) -buildCmpXchg :: Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> Ptr Value -> (SynchronizationScope, MemoryOrdering) -> MemoryOrdering -> CString -> IO (Ptr Instruction) -buildCmpXchg builder vol a e r (ss, smo) fmo s = buildCmpXchg' builder vol a e r smo fmo ss s +buildCmpXchg :: Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> Ptr Value -> CUInt -> (SynchronizationScope, MemoryOrdering) -> MemoryOrdering -> CString -> IO (Ptr Instruction) +buildCmpXchg builder vol a e r al (ss, smo) fmo s = buildCmpXchg' builder vol a e r al smo fmo ss s foreign import ccall unsafe "LLVM_Hs_BuildAtomicRMW" buildAtomicRMW' :: - Ptr Builder -> LLVMBool -> RMWOperation -> Ptr Value -> Ptr Value -> MemoryOrdering -> SynchronizationScope -> CString -> IO (Ptr Instruction) + Ptr Builder -> LLVMBool -> RMWOperation -> Ptr Value -> Ptr Value -> CUInt -> MemoryOrdering -> SynchronizationScope -> CString -> IO (Ptr Instruction) -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 +buildAtomicRMW :: Ptr Builder -> LLVMBool -> RMWOperation -> Ptr Value -> Ptr Value -> CUInt -> (SynchronizationScope, MemoryOrdering) -> CString -> IO (Ptr Instruction) +buildAtomicRMW builder vol rmwOp a v al (ss, mo) s = buildAtomicRMW' builder vol rmwOp a v al mo ss s foreign import ccall unsafe "LLVM_Hs_BuildICmp" buildICmp :: Ptr Builder -> ICmpPredicate -> Ptr Value -> Ptr Value -> CString -> IO (Ptr Instruction) diff --git a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp index 3149cdee..f4b3fb25 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp @@ -156,7 +156,9 @@ LLVMValueRef LLVM_Hs_BuildLoad( unsigned align, const char *name ) { - LoadInst *i = unwrap(b)->CreateAlignedLoad(unwrap(p), MaybeAlign(align), isVolatile, name); + LoadInst *i = unwrap(b)->CreateAlignedLoad( + unwrap(p)->getType()->getPointerElementType(), + unwrap(p), MaybeAlign(align), isVolatile, name); i->setOrdering(unwrap(atomicOrdering)); if (atomicOrdering != LLVMAtomicOrderingNotAtomic) i->setSyncScopeID(unwrap(synchScope)); return wrap(i); @@ -193,13 +195,14 @@ LLVMValueRef LLVM_Hs_BuildAtomicCmpXchg( LLVMValueRef ptr, LLVMValueRef cmp, LLVMValueRef n, + unsigned align, LLVMAtomicOrdering successOrdering, LLVMAtomicOrdering failureOrdering, LLVMSynchronizationScope lss, const char *name ) { AtomicCmpXchgInst *a = unwrap(b)->CreateAtomicCmpXchg( - unwrap(ptr), unwrap(cmp), unwrap(n), unwrap(successOrdering), unwrap(failureOrdering), unwrap(lss) + unwrap(ptr), unwrap(cmp), unwrap(n), MaybeAlign(align), unwrap(successOrdering), unwrap(failureOrdering), unwrap(lss) ); a->setVolatile(v); a->setName(name); @@ -212,12 +215,13 @@ LLVMValueRef LLVM_Hs_BuildAtomicRMW( LLVMAtomicRMWBinOp_ rmwOp, LLVMValueRef ptr, LLVMValueRef val, + unsigned align, LLVMAtomicOrdering lao, LLVMSynchronizationScope lss, const char *name ) { AtomicRMWInst *a = unwrap(b)->CreateAtomicRMW( - unwrap(rmwOp), unwrap(ptr), unwrap(val), unwrap(lao), unwrap(lss) + unwrap(rmwOp), unwrap(ptr), unwrap(val), MaybeAlign(align), unwrap(lao), unwrap(lss) ); a->setVolatile(v); a->setName(name); diff --git a/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp b/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp index d74fa32d..da1fd65a 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/InstructionC.cpp @@ -124,11 +124,13 @@ LLVMTypeRef LLVM_Hs_GetAllocatedType(LLVMValueRef a) { #define LLVM_HS_FOR_EACH_ALIGNMENT_INST(macro) \ macro(Alloca) \ macro(Load) \ - macro(Store) + macro(Store) \ + macro(AtomicCmpXchg) \ + macro(AtomicRMW) unsigned LLVM_Hs_GetInstrAlignment(LLVMValueRef l) { switch(unwrap(l)->getOpcode()) { -#define ENUM_CASE(n) case Instruction::n: return unwrap(l)->getAlignment(); +#define ENUM_CASE(n) case Instruction::n: return unwrap(l)->getAlign().value(); LLVM_HS_FOR_EACH_ALIGNMENT_INST(ENUM_CASE) #undef ENUM_CASE default: return 0; diff --git a/llvm-hs/test/LLVM/Test/Instructions.hs b/llvm-hs/test/LLVM/Test/Instructions.hs index 474430e4..8ea60262 100644 --- a/llvm-hs/test/LLVM/Test/Instructions.hs +++ b/llvm-hs/test/LLVM/Test/Instructions.hs @@ -83,7 +83,7 @@ tests = testGroup "Instructions" [ nuw = False, operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "add i32 %0, %0"), ("nsw", @@ -92,7 +92,7 @@ tests = testGroup "Instructions" [ nuw = False, operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "add nsw i32 %0, %0"), ("nuw", @@ -101,7 +101,7 @@ tests = testGroup "Instructions" [ nuw = True, operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "add nuw i32 %0, %0"), ("fadd", @@ -109,7 +109,7 @@ tests = testGroup "Instructions" [ fastMathFlags = noFastMathFlags, operand0 = a 1, operand1 = a 1, - metadata = [] + metadata = [] }, "fadd float %1, %1"), ("sub", @@ -118,7 +118,7 @@ tests = testGroup "Instructions" [ nuw = False, operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "sub i32 %0, %0"), ("fsub", @@ -126,7 +126,7 @@ tests = testGroup "Instructions" [ fastMathFlags = noFastMathFlags, operand0 = a 1, operand1 = a 1, - metadata = [] + metadata = [] }, "fsub float %1, %1"), ("mul", @@ -135,7 +135,7 @@ tests = testGroup "Instructions" [ nuw = False, operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "mul i32 %0, %0"), ("fmul", @@ -143,7 +143,7 @@ tests = testGroup "Instructions" [ fastMathFlags = noFastMathFlags, operand0 = a 1, operand1 = a 1, - metadata = [] + metadata = [] }, "fmul float %1, %1"), ("udiv", @@ -151,7 +151,7 @@ tests = testGroup "Instructions" [ exact = False, operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "udiv i32 %0, %0"), ("exact", @@ -159,7 +159,7 @@ tests = testGroup "Instructions" [ exact = True, operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "udiv exact i32 %0, %0"), ("sdiv", @@ -167,7 +167,7 @@ tests = testGroup "Instructions" [ exact = False, operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "sdiv i32 %0, %0"), ("fdiv", @@ -175,21 +175,21 @@ tests = testGroup "Instructions" [ fastMathFlags = noFastMathFlags, operand0 = a 1, operand1 = a 1, - metadata = [] + metadata = [] }, "fdiv float %1, %1"), ("urem", URem { operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "urem i32 %0, %0"), ("srem", SRem { operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "srem i32 %0, %0"), ("frem", @@ -197,7 +197,7 @@ tests = testGroup "Instructions" [ fastMathFlags = noFastMathFlags, operand0 = a 1, operand1 = a 1, - metadata = [] + metadata = [] }, "frem float %1, %1"), ("frem fast", @@ -213,7 +213,7 @@ tests = testGroup "Instructions" [ }, operand0 = a 1, operand1 = a 1, - metadata = [] + metadata = [] }, "frem fast float %1, %1"), ("shl", @@ -222,7 +222,7 @@ tests = testGroup "Instructions" [ nuw = False, operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "shl i32 %0, %0"), ("ashr", @@ -230,7 +230,7 @@ tests = testGroup "Instructions" [ exact = False, operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "ashr i32 %0, %0"), ("lshr", @@ -238,28 +238,28 @@ tests = testGroup "Instructions" [ exact = False, operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "lshr i32 %0, %0"), ("and", And { operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "and i32 %0, %0"), ("or", Or { operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "or i32 %0, %0"), ("xor", Xor { operand0 = a 0, operand1 = a 0, - metadata = [] + metadata = [] }, "xor i32 %0, %0"), ("alloca", @@ -267,7 +267,7 @@ tests = testGroup "Instructions" [ allocatedType = i32, numElements = Nothing, alignment = 4, - metadata = [] + metadata = [] }, "alloca i32, align 4"), ("alloca tricky", @@ -275,7 +275,7 @@ tests = testGroup "Instructions" [ allocatedType = IntegerType 7, numElements = Just (ConstantOperand (C.Int 32 2)), alignment = 128, - metadata = [] + metadata = [] }, "alloca i7, i32 2, align 128"), ("load", @@ -284,7 +284,7 @@ tests = testGroup "Instructions" [ address = a 2, maybeAtomicity = Nothing, alignment = 4, - metadata = [] + metadata = [] }, "load i32, i32* %2, align 4"), ("volatile", @@ -293,7 +293,7 @@ tests = testGroup "Instructions" [ address = a 2, maybeAtomicity = Nothing, alignment = 4, - metadata = [] + metadata = [] }, "load volatile i32, i32* %2, align 4"), ("acquire", @@ -302,7 +302,7 @@ tests = testGroup "Instructions" [ address = a 2, maybeAtomicity = Just (System, Acquire), alignment = 1, - metadata = [] + metadata = [] }, "load atomic i32, i32* %2 acquire, align 1"), ("singlethread", @@ -311,7 +311,7 @@ tests = testGroup "Instructions" [ address = a 2, maybeAtomicity = Just (SingleThread, Monotonic), alignment = 1, - metadata = [] + metadata = [] }, "load atomic i32, i32* %2 syncscope(\"singlethread\") monotonic, align 1"), ("GEP", @@ -319,7 +319,7 @@ tests = testGroup "Instructions" [ inBounds = False, address = a 2, indices = [ a 0 ], - metadata = [] + metadata = [] }, "getelementptr i32, i32* %2, i32 %0"), ("inBounds", @@ -327,7 +327,7 @@ tests = testGroup "Instructions" [ inBounds = True, address = a 2, indices = [ a 0 ], - metadata = [] + metadata = [] }, "getelementptr inbounds i32, i32* %2, i32 %0"), ("cmpxchg", @@ -336,111 +336,113 @@ tests = testGroup "Instructions" [ address = a 2, expected = a 0, replacement = a 0, + alignment = 16, atomicity = (System, Monotonic), failureMemoryOrdering = Monotonic, - metadata = [] + metadata = [] }, - "cmpxchg i32* %2, i32 %0, i32 %0 monotonic monotonic"), + "cmpxchg i32* %2, i32 %0, i32 %0 monotonic monotonic, align 16"), ("atomicrmw", AtomicRMW { volatile = False, rmwOperation = RMWOp.UMax, address = a 2, value = a 0, + alignment = 16, atomicity = (System, Release), metadata = [] }, - "atomicrmw umax i32* %2, i32 %0 release"), + "atomicrmw umax i32* %2, i32 %0 release, align 16"), ("trunc", Trunc { operand0 = a 0, type' = i16, - metadata = [] + metadata = [] }, "trunc i32 %0 to i16"), ("zext", ZExt { operand0 = a 0, type' = i64, - metadata = [] + metadata = [] }, "zext i32 %0 to i64"), ("sext", SExt { operand0 = a 0, type' = i64, - metadata = [] + metadata = [] }, "sext i32 %0 to i64"), ("fptoui", FPToUI { operand0 = a 1, type' = i64, - metadata = [] + metadata = [] }, "fptoui float %1 to i64"), ("fptosi", FPToSI { operand0 = a 1, type' = i64, - metadata = [] + metadata = [] }, "fptosi float %1 to i64"), ("uitofp", UIToFP { operand0 = a 0, type' = float, - metadata = [] + metadata = [] }, "uitofp i32 %0 to float"), ("sitofp", SIToFP { operand0 = a 0, type' = float, - metadata = [] + metadata = [] }, "sitofp i32 %0 to float"), ("fptrunc", FPTrunc { operand0 = a 1, type' = half, - metadata = [] + metadata = [] }, "fptrunc float %1 to half"), ("fpext", FPExt { operand0 = a 1, type' = double, - metadata = [] + metadata = [] }, "fpext float %1 to double"), ("ptrtoint", PtrToInt { operand0 = a 2, type' = i32, - metadata = [] + metadata = [] }, "ptrtoint i32* %2 to i32"), ("inttoptr", IntToPtr { operand0 = a 0, type' = ptr i32, - metadata = [] + metadata = [] }, "inttoptr i32 %0 to i32*"), ("bitcast", BitCast { operand0 = a 0, type' = float, - metadata = [] + metadata = [] }, "bitcast i32 %0 to float"), ("addrspacecast", AddrSpaceCast { operand0 = a 2, type' = PointerType i32 (AddrSpace 2), - metadata = [] + metadata = [] }, "addrspacecast i32* %2 to i32 addrspace(2)*"), ("select", @@ -633,7 +635,7 @@ tests = testGroup "Instructions" [ \}\n" s <- withContext $ \context -> withModuleFromAST context mAST moduleLLVMAssembly s @?= mStr, - + testGroup "terminators" [ testCase name $ strCheck mAST mStr | (name, mAST, mStr) <- [ @@ -764,7 +766,7 @@ tests = testGroup "Instructions" [ address = ConstantOperand (C.GlobalReference (ptr (ptr i8)) (UnName 0)), maybeAtomicity = Nothing, alignment = 8, - metadata = [] + metadata = [] } ] ( Do $ IndirectBr { From b7fc62f6a0d0034e96dd431d08d2b84d44df6702 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Wed, 24 Mar 2021 17:41:48 +0000 Subject: [PATCH 09/37] Add VStackRange attribute, expose other function attributes missing in AST --- .../src/LLVM/AST/FunctionAttribute.hs | 18 ++++++- llvm-hs/src/LLVM/Internal/Attribute.hs | 48 +++++++++++++++---- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 3 +- llvm-hs/src/LLVM/Internal/FFI/Attribute.hs | 6 +++ llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp | 11 +++++ llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp | 2 + llvm-hs/test/LLVM/Test/FunctionAttribute.hs | 14 +++++- 7 files changed, 91 insertions(+), 11 deletions(-) diff --git a/llvm-hs-pure/src/LLVM/AST/FunctionAttribute.hs b/llvm-hs-pure/src/LLVM/AST/FunctionAttribute.hs index b0f8463d..a790d1bc 100644 --- a/llvm-hs-pure/src/LLVM/AST/FunctionAttribute.hs +++ b/llvm-hs-pure/src/LLVM/AST/FunctionAttribute.hs @@ -11,23 +11,31 @@ data FunctionAttribute | Builtin | Cold | Convergent + | Hot | InaccessibleMemOnly | InaccessibleMemOrArgMemOnly | InlineHint | JumpTable | MinimizeSize + | MustProgress | Naked | NoBuiltin + | NoCallback + | NoCfCheck | NoDuplicate | NoFree | NoImplicitFloat | NoInline - | NonLazyBind + | NoMerge + | NoProfile | NoRecurse | NoRedZone | NoReturn | NoSync | NoUnwind + | NonLazyBind + | NullPointerIsValid + | OptForFuzzing | OptimizeForSize | OptimizeNone | ReadNone @@ -36,9 +44,12 @@ data FunctionAttribute | SafeStack | SanitizeAddress | SanitizeHWAddress + | SanitizeMemTag | SanitizeMemory | SanitizeThread + | ShadowCallStack | Speculatable + | SpeculativeLoadHardening | StackAlignment Word64 | StackProtect | StackProtectReq @@ -49,6 +60,11 @@ data FunctionAttribute stringAttributeValue :: ShortByteString -- ^ Use "" for no value -- the two are conflated } | UWTable + | VScaleRange { + vScaleRangeMin :: Word32, + vScaleRangeMax :: Word32 -- ^ Optional max is not supported. Set it to the minimum + -- value if unspecified. + } | WillReturn | WriteOnly deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) diff --git a/llvm-hs/src/LLVM/Internal/Attribute.hs b/llvm-hs/src/LLVM/Internal/Attribute.hs index 34cec3ae..6c337da1 100644 --- a/llvm-hs/src/LLVM/Internal/Attribute.hs +++ b/llvm-hs/src/LLVM/Internal/Attribute.hs @@ -21,13 +21,13 @@ import Data.Maybe import qualified LLVM.Internal.FFI.Attribute as FFI import qualified LLVM.Internal.FFI.LLVMCTypes as FFI -import LLVM.Internal.FFI.LLVMCTypes (parameterAttributeKindP, functionAttributeKindP) +import LLVM.Internal.FFI.LLVMCTypes (parameterAttributeKindP, functionAttributeKindP) -import qualified LLVM.AST.ParameterAttribute as A.PA -import qualified LLVM.AST.FunctionAttribute as A.FA +import qualified LLVM.AST.ParameterAttribute as A.PA +import qualified LLVM.AST.FunctionAttribute as A.FA import LLVM.Internal.Coding -import LLVM.Internal.Context +import LLVM.Internal.Context import LLVM.Internal.EncodeAST import LLVM.Internal.DecodeAST @@ -78,6 +78,10 @@ instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilde x' <- encodeM x y' <- encodeM y liftIO $ FFI.attrBuilderAddAllocSize b x' y' + A.FA.VScaleRange vsMin vsMax -> do + vsMin' <- encodeM vsMin + vsMax' <- encodeM vsMax + liftIO $ FFI.attrBuilderAddVScaleRange b vsMin' vsMax' A.FA.StackAlignment v -> liftIO $ FFI.attrBuilderAddStackAlignment b v _ -> liftIO $ FFI.attrBuilderAddFunctionAttributeKind b $ case a of A.FA.AlwaysInline -> FFI.functionAttributeKindAlwaysInline @@ -85,23 +89,31 @@ instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilde A.FA.Builtin -> FFI.functionAttributeKindBuiltin A.FA.Cold -> FFI.functionAttributeKindCold A.FA.Convergent -> FFI.functionAttributeKindConvergent + A.FA.Hot -> FFI.functionAttributeKindHot A.FA.InaccessibleMemOnly -> FFI.functionAttributeKindInaccessibleMemOnly A.FA.InaccessibleMemOrArgMemOnly -> FFI.functionAttributeKindInaccessibleMemOrArgMemOnly A.FA.InlineHint -> FFI.functionAttributeKindInlineHint A.FA.JumpTable -> FFI.functionAttributeKindJumpTable A.FA.MinimizeSize -> FFI.functionAttributeKindMinSize + A.FA.MustProgress -> FFI.functionAttributeKindMustProgress A.FA.Naked -> FFI.functionAttributeKindNaked A.FA.NoBuiltin -> FFI.functionAttributeKindNoBuiltin + A.FA.NoCallback -> FFI.functionAttributeKindNoCallback + A.FA.NoCfCheck -> FFI.functionAttributeKindNoCfCheck A.FA.NoDuplicate -> FFI.functionAttributeKindNoDuplicate A.FA.NoFree -> FFI.functionAttributeKindNoFree A.FA.NoImplicitFloat -> FFI.functionAttributeKindNoImplicitFloat A.FA.NoInline -> FFI.functionAttributeKindNoInline - A.FA.NonLazyBind -> FFI.functionAttributeKindNonLazyBind + A.FA.NoMerge -> FFI.functionAttributeKindNoMerge + A.FA.NoProfile -> FFI.functionAttributeKindNoProfile A.FA.NoRecurse -> FFI.functionAttributeKindNoRecurse A.FA.NoRedZone -> FFI.functionAttributeKindNoRedZone A.FA.NoReturn -> FFI.functionAttributeKindNoReturn A.FA.NoSync -> FFI.functionAttributeKindNoSync A.FA.NoUnwind -> FFI.functionAttributeKindNoUnwind + A.FA.NonLazyBind -> FFI.functionAttributeKindNonLazyBind + A.FA.NullPointerIsValid -> FFI.functionAttributeKindNullPointerIsValid + A.FA.OptForFuzzing -> FFI.functionAttributeKindOptForFuzzing A.FA.OptimizeForSize -> FFI.functionAttributeKindOptimizeForSize A.FA.OptimizeNone -> FFI.functionAttributeKindOptimizeNone A.FA.ReadNone -> FFI.functionAttributeKindReadNone @@ -110,9 +122,12 @@ instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilde A.FA.SafeStack -> FFI.functionAttributeKindSafeStack A.FA.SanitizeAddress -> FFI.functionAttributeKindSanitizeAddress A.FA.SanitizeHWAddress -> FFI.functionAttributeKindSanitizeHWAddress + A.FA.SanitizeMemTag -> FFI.functionAttributeKindSanitizeMemTag A.FA.SanitizeMemory -> FFI.functionAttributeKindSanitizeMemory A.FA.SanitizeThread -> FFI.functionAttributeKindSanitizeThread + A.FA.ShadowCallStack -> FFI.functionAttributeKindShadowCallStack A.FA.Speculatable -> FFI.functionAttributeKindSpeculatable + A.FA.SpeculativeLoadHardening -> FFI.functionAttributeKindSpeculativeLoadHardening A.FA.StackProtect -> FFI.functionAttributeKindStackProtect A.FA.StackProtectReq -> FFI.functionAttributeKindStackProtectReq A.FA.StackProtectStrong -> FFI.functionAttributeKindStackProtectStrong @@ -123,6 +138,7 @@ instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilde A.FA.AllocSize _ _ -> inconsistentCases "FunctionAttribute" a A.FA.StackAlignment _ -> inconsistentCases "FunctionAttribute" a A.FA.StringAttribute _ _ -> inconsistentCases "FunctionAttribute" a + A.FA.VScaleRange _ _ -> inconsistentCases "FunctionAttribute" a instance DecodeM DecodeAST A.PA.ParameterAttribute FFI.ParameterAttribute where decodeM a = do @@ -165,7 +181,7 @@ instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where then return A.FA.StringAttribute `ap` (decodeM $ FFI.attributeKindAsString a) - `ap` (decodeM $ FFI.attributeValueAsString a) + `ap` (decodeM $ FFI.attributeValueAsString a) else do enum <- liftIO $ FFI.functionAttributeKindAsEnum a case enum of @@ -179,23 +195,31 @@ instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where [functionAttributeKindP|Builtin|] -> return A.FA.Builtin [functionAttributeKindP|Cold|] -> return A.FA.Cold [functionAttributeKindP|Convergent|] -> return A.FA.Convergent + [functionAttributeKindP|Hot|] -> return A.FA.Hot [functionAttributeKindP|InaccessibleMemOnly|] -> return A.FA.InaccessibleMemOnly [functionAttributeKindP|InaccessibleMemOrArgMemOnly|] -> return A.FA.InaccessibleMemOrArgMemOnly [functionAttributeKindP|InlineHint|] -> return A.FA.InlineHint [functionAttributeKindP|JumpTable|] -> return A.FA.JumpTable [functionAttributeKindP|MinSize|] -> return A.FA.MinimizeSize + [functionAttributeKindP|MustProgress|] -> return A.FA.MustProgress [functionAttributeKindP|Naked|] -> return A.FA.Naked [functionAttributeKindP|NoBuiltin|] -> return A.FA.NoBuiltin + [functionAttributeKindP|NoCallback|] -> return A.FA.NoCallback + [functionAttributeKindP|NoCfCheck|] -> return A.FA.NoCfCheck [functionAttributeKindP|NoDuplicate|] -> return A.FA.NoDuplicate [functionAttributeKindP|NoFree|] -> return A.FA.NoFree [functionAttributeKindP|NoImplicitFloat|] -> return A.FA.NoImplicitFloat [functionAttributeKindP|NoInline|] -> return A.FA.NoInline + [functionAttributeKindP|NoMerge|] -> return A.FA.NoMerge + [functionAttributeKindP|NoProfile|] -> return A.FA.NoProfile [functionAttributeKindP|NoRecurse|] -> return A.FA.NoRecurse [functionAttributeKindP|NoRedZone|] -> return A.FA.NoRedZone [functionAttributeKindP|NoReturn|] -> return A.FA.NoReturn [functionAttributeKindP|NoSync|] -> return A.FA.NoSync [functionAttributeKindP|NoUnwind|] -> return A.FA.NoUnwind [functionAttributeKindP|NonLazyBind|] -> return A.FA.NonLazyBind + [functionAttributeKindP|NullPointerIsValid|] -> return A.FA.NullPointerIsValid + [functionAttributeKindP|OptForFuzzing|] -> return A.FA.OptForFuzzing [functionAttributeKindP|OptimizeForSize|] -> return A.FA.OptimizeForSize [functionAttributeKindP|OptimizeNone|] -> return A.FA.OptimizeNone [functionAttributeKindP|ReadNone|] -> return A.FA.ReadNone @@ -204,9 +228,12 @@ instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where [functionAttributeKindP|SafeStack|] -> return A.FA.SafeStack [functionAttributeKindP|SanitizeAddress|] -> return A.FA.SanitizeAddress [functionAttributeKindP|SanitizeHWAddress|] -> return A.FA.SanitizeHWAddress + [functionAttributeKindP|SanitizeMemTag|] -> return A.FA.SanitizeMemTag [functionAttributeKindP|SanitizeMemory|] -> return A.FA.SanitizeMemory [functionAttributeKindP|SanitizeThread|] -> return A.FA.SanitizeThread + [functionAttributeKindP|ShadowCallStack|] -> return A.FA.ShadowCallStack [functionAttributeKindP|Speculatable|] -> return A.FA.Speculatable + [functionAttributeKindP|SpeculativeLoadHardening|] -> return A.FA.SpeculativeLoadHardening [functionAttributeKindP|StackAlignment|] -> return A.FA.StackAlignment `ap` (liftIO $ FFI.attributeValueAsInt a) [functionAttributeKindP|StackProtectReq|] -> return A.FA.StackProtectReq [functionAttributeKindP|StackProtectStrong|] -> return A.FA.StackProtectStrong @@ -215,6 +242,11 @@ instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where [functionAttributeKindP|UWTable|] -> return A.FA.UWTable [functionAttributeKindP|WillReturn|] -> return A.FA.WillReturn [functionAttributeKindP|WriteOnly|] -> return A.FA.WriteOnly + [functionAttributeKindP|VScaleRange|] -> do + vsMin <- alloca + vsMax <- alloca + liftIO $ FFI.attributeGetVScaleRangeArgs a vsMin vsMax + A.FA.VScaleRange <$> (decodeM =<< peek vsMin) <*> (decodeM =<< peek vsMax) _ -> error $ "unhandled function attribute enum value: " ++ show enum allocaAttrBuilder :: (Monad m, MonadAnyCont IO m) => m (Ptr (FFI.AttrBuilder a)) @@ -242,7 +274,7 @@ instance forall a b. DecodeM DecodeAST a (FFI.Attribute b) => DecodeM DecodeAST attrs <- allocaArray numAttributes liftIO (FFI.getAttributes as attrs) decodeM (numAttributes, attrs :: Ptr (FFI.Attribute b)) - + data AttributeList = AttributeList { functionAttributes :: [Either A.FA.GroupID A.FA.FunctionAttribute], returnAttributes :: [A.PA.ParameterAttribute], @@ -254,7 +286,7 @@ data PreSlot = IndirectFunctionAttributes A.FA.GroupID | DirectFunctionAttributes [A.FA.FunctionAttribute] | ReturnAttributes [A.PA.ParameterAttribute] - | ParameterAttributes CUInt [A.PA.ParameterAttribute] + | ParameterAttributes CUInt [A.PA.ParameterAttribute] instance {-# OVERLAPPING #-} EncodeM EncodeAST [Either A.FA.GroupID A.FA.FunctionAttribute] FFI.FunctionAttributeSet where encodeM attrs = do diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index 61f84a36..a2015674 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -41,7 +41,7 @@ macro(NoUnwind,F,F,T) \ macro(NonLazyBind,F,F,T) \ macro(NonNull,T,T,F) \ - macro(NullPointerIsValid,T,T,F) \ + macro(NullPointerIsValid,F,F,T) \ macro(OptForFuzzing,F,F,T) \ macro(OptimizeForSize,F,F,T) \ macro(OptimizeNone,F,F,T) \ @@ -79,6 +79,7 @@ macro(Dereferenceable,T,T,F) \ macro(DereferenceableOrNull,T,T,F) \ macro(StackAlignment,F,F,T) \ + macro(VScaleRange,F,F,T) \ macro(EndAttrKinds,F,F,F) typedef enum { diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs b/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs index e07d20c0..85c828bd 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs @@ -157,3 +157,9 @@ foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddDereferenceableOrNullAttr" at foreign import ccall unsafe "LLVM_Hs_AttributeGetAllocSizeArgs" attributeGetAllocSizeArgs :: FunctionAttribute -> Ptr CUInt -> Ptr CUInt -> IO LLVMBool + +foreign import ccall unsafe "LLVM_Hs_AttributeGetVScaleRangeArgs" attributeGetVScaleRangeArgs :: + FunctionAttribute -> Ptr CUInt -> Ptr CUInt -> IO () + +foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddVScaleRange" attrBuilderAddVScaleRange :: + Ptr FunctionAttrBuilder -> CUInt -> CUInt -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp index c8728063..34bcae82 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp @@ -2,6 +2,8 @@ #include "LLVM/Internal/FFI/AttributeC.hpp" #include "llvm/IR/LLVMContext.h" +#include + extern "C" { static_assert(sizeof(AttributeList) == sizeof(AttributeListImpl *), @@ -159,4 +161,13 @@ LLVMBool LLVM_Hs_AttributeGetAllocSizeArgs(LLVMAttributeRef a, unsigned *x, return 0; } } + +void LLVM_Hs_AttributeGetVScaleRangeArgs(LLVMAttributeRef a, unsigned *min, unsigned *max) { + std::tie(*min, *max) = unwrap(a).getVScaleRangeArgs(); +} + +void LLVM_Hs_AttrBuilderAddVScaleRange(AttrBuilder &ab, unsigned min, unsigned max) { + ab.addVScaleRangeAttr(min, max); +} + } diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp index 29515d8d..0b2308ad 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp @@ -25,6 +25,7 @@ using namespace orc; "JITSymbolFlag values should agree"); LLVM_HS_FOR_EACH_JIT_SYMBOL_FLAG(SYMBOL_CASE) +#if 0 // This is not useful for now, but keeping in case we end up needing it static JITSymbolFlags unwrap(LLVMJITSymbolFlags_ f) { JITSymbolFlags flags = JITSymbolFlags::None; #define ENUM_CASE(x) \ @@ -34,6 +35,7 @@ static JITSymbolFlags unwrap(LLVMJITSymbolFlags_ f) { #undef ENUM_CASE return flags; } +#endif static LLVMJITSymbolFlags_ wrap(JITSymbolFlags f) { unsigned r = 0; diff --git a/llvm-hs/test/LLVM/Test/FunctionAttribute.hs b/llvm-hs/test/LLVM/Test/FunctionAttribute.hs index c6343834..1094f5e6 100644 --- a/llvm-hs/test/LLVM/Test/FunctionAttribute.hs +++ b/llvm-hs/test/LLVM/Test/FunctionAttribute.hs @@ -31,22 +31,30 @@ instance Arbitrary FunctionAttribute where , return Builtin , return Cold , return Convergent + , return Hot , return InaccessibleMemOnly , return InaccessibleMemOrArgMemOnly , return InlineHint , return JumpTable , return MinimizeSize + , return MustProgress , return Naked , return NoBuiltin + , return NoCallback + , return NoCfCheck , return NoDuplicate , return NoFree , return NoImplicitFloat , return NoInline - , return NonLazyBind + , return NoMerge + , return NoProfile , return NoRecurse , return NoRedZone , return NoReturn , return NoUnwind + , return NonLazyBind + , return NullPointerIsValid + , return OptForFuzzing , return OptimizeForSize , return OptimizeNone , return ReadNone @@ -55,9 +63,12 @@ instance Arbitrary FunctionAttribute where , return SafeStack , return SanitizeAddress , return SanitizeHWAddress + , return SanitizeMemTag , return SanitizeMemory , return SanitizeThread + , return ShadowCallStack , return Speculatable + , return SpeculativeLoadHardening , return StackProtect , return StackProtectReq , return StackProtectStrong @@ -67,6 +78,7 @@ instance Arbitrary FunctionAttribute where , StackAlignment <$> elements (map (2^) [0..8 :: Int]) , StringAttribute <$> (B.pack <$> arbitrary) <*> (B.pack <$> arbitrary) , suchThat (AllocSize <$> arbitrary <*> arbitrary) (/= AllocSize 0 (Just 0)) + , suchThat (VScaleRange <$> arbitrary <*> arbitrary) (\(VScaleRange l h) -> l <= h) ] shrink = \case From 43b81ade15cfcf377abe8c3fa2792fbac78c1128 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Tue, 30 Mar 2021 10:29:47 +0000 Subject: [PATCH 10/37] Update to LLVM HEAD The order of generated attributes has changed, so update the list. --- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index a2015674..acf16505 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -13,7 +13,6 @@ macro(Convergent,F,F,T) \ macro(Hot,F,F,T) \ macro(ImmArg,T,F,F) \ - macro(InAlloca,T,F,F) \ macro(InReg,T,T,F) \ macro(InaccessibleMemOnly,F,F,T) \ macro(InaccessibleMemOrArgMemOnly,F,F,T) \ @@ -71,6 +70,7 @@ macro(ZExt,T,T,F) \ macro(ByRef,T,F,F) \ macro(ByVal,T,F,F) \ + macro(InAlloca,T,F,F) \ macro(MustProgress,F,F,T) \ macro(Preallocated,F,F,T) \ macro(StructRet,T,F,F) \ From 52ec271d5a4780deb120196b63a5e78409078775 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Wed, 31 Mar 2021 10:38:14 +0000 Subject: [PATCH 11/37] Fix issues found by ASAN while running tests --- llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp | 2 +- llvm-hs/src/LLVM/Internal/FFI/Metadata.hs | 2 +- llvm-hs/src/LLVM/Internal/Operand.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp index 34bcae82..225c717b 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp @@ -106,7 +106,7 @@ AttrBuilder *LLVM_Hs_AttrBuilderFromAttrSet(LLVMAttributeSetRef as) { return new AttrBuilder(*as); } -void LLVM_Hs_DisposeAttrBuilder(LLVMAttributeSetRef as) { delete as; } +void LLVM_Hs_DisposeAttrBuilder(AttrBuilder *as) { delete as; } void LLVM_Hs_AttrBuilderMerge(AttrBuilder *ab1, AttrBuilder *ab2) { ab1->merge(*ab2); diff --git a/llvm-hs/src/LLVM/Internal/FFI/Metadata.hs b/llvm-hs/src/LLVM/Internal/FFI/Metadata.hs index c22f0fe1..d9027575 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Metadata.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Metadata.hs @@ -540,7 +540,7 @@ foreign import ccall unsafe "LLVM_Hs_DITemplateParameter_GetType" getDITemplateP -- DITemplateTypeParameter foreign import ccall unsafe "LLVM_Hs_Get_DITemplateTypeParameter" getDITemplateTypeParameter :: - Ptr Context -> Ptr MDString -> Ptr DIType -> IO (Ptr DITemplateTypeParameter) + Ptr Context -> Ptr MDString -> Ptr DIType -> Bool -> IO (Ptr DITemplateTypeParameter) -- DITemplateValueParameter diff --git a/llvm-hs/src/LLVM/Internal/Operand.hs b/llvm-hs/src/LLVM/Internal/Operand.hs index f0520ca6..1caff364 100644 --- a/llvm-hs/src/LLVM/Internal/Operand.hs +++ b/llvm-hs/src/LLVM/Internal/Operand.hs @@ -817,7 +817,7 @@ instance EncodeM EncodeAST A.DITemplateParameter (Ptr FFI.DITemplateParameter) w Context c <- gets encodeStateContext case p of A.DITemplateTypeParameter {} -> - FFI.upCast <$> liftIO (FFI.getDITemplateTypeParameter c name' ty) + FFI.upCast <$> liftIO (FFI.getDITemplateTypeParameter c name' ty True) A.DITemplateValueParameter {..} -> do tag <- encodeM tag value <- encodeM value From 06ec19077d7e6309fabe6e70da7cfdc831d80ee0 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Thu, 1 Jul 2021 10:33:32 +0000 Subject: [PATCH 12/37] Update to match LLVM head - Add new attributes - Remove stack alignment from target options (it is not a module attribute) - Update curated pass tests with new inferred attributes - Remove illegal align annotations on tail call tests --- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 2 ++ llvm-hs/src/LLVM/Internal/FFI/Target.hs | 6 ------ llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp | 8 -------- llvm-hs/src/LLVM/Internal/Target.hs | 2 -- llvm-hs/src/LLVM/Target/Options.hs | 1 - llvm-hs/test/LLVM/Test/Module.hs | 12 ++++++------ llvm-hs/test/LLVM/Test/Optimization.hs | 2 +- llvm-hs/test/LLVM/Test/Target.hs | 1 - 8 files changed, 9 insertions(+), 25 deletions(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index acf16505..a426449e 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -35,6 +35,7 @@ macro(NoRecurse,F,F,T) \ macro(NoRedZone,F,F,T) \ macro(NoReturn,F,F,T) \ + macro(NoSanitizeCoverage,F,F,T) \ macro(NoSync,F,F,T) \ macro(NoUndef,F,F,T) \ macro(NoUnwind,F,F,T) \ @@ -62,6 +63,7 @@ macro(StackProtectReq,F,F,T) \ macro(StackProtectStrong,F,F,T) \ macro(StrictFP,F,F,T) \ + macro(SwiftAsync,T,F,F) \ macro(SwiftError,T,F,F) \ macro(SwiftSelf,T,F,F) \ macro(UWTable,F,F,T) \ diff --git a/llvm-hs/src/LLVM/Internal/FFI/Target.hs b/llvm-hs/src/LLVM/Internal/FFI/Target.hs index 901d979a..82c81eeb 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Target.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Target.hs @@ -47,12 +47,6 @@ foreign import ccall unsafe "LLVM_Hs_GetCompressDebugSections" getCompressDebugS foreign import ccall unsafe "LLVM_Hs_SetCompressDebugSections" setCompressDebugSections :: Ptr TargetOptions -> DebugCompressionType -> IO () -foreign import ccall unsafe "LLVM_Hs_SetStackAlignmentOverride" setStackAlignmentOverride :: - Ptr TargetOptions -> CUInt -> IO () - -foreign import ccall unsafe "LLVM_Hs_GetStackAlignmentOverride" getStackAlignmentOverride :: - Ptr TargetOptions -> IO CUInt - foreign import ccall unsafe "LLVM_Hs_SetFloatABIType" setFloatABIType :: Ptr TargetOptions -> FloatABIType -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp b/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp index fe1f7224..7bc7e39b 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp @@ -349,14 +349,6 @@ unsigned LLVM_Hs_GetMCTargetOptionFlag(MCTargetOptions *to, } } -void LLVM_Hs_SetStackAlignmentOverride(TargetOptions *to, unsigned v) { - to->StackAlignmentOverride = v; -} - -unsigned LLVM_Hs_GetStackAlignmentOverride(TargetOptions *to) { - return to->StackAlignmentOverride; -} - void LLVM_Hs_SetFloatABIType(TargetOptions *to, LLVM_Hs_FloatABI v) { to->FloatABIType = unwrap(v); } diff --git a/llvm-hs/src/LLVM/Internal/Target.hs b/llvm-hs/src/LLVM/Internal/Target.hs index abb16c04..e36e5f18 100644 --- a/llvm-hs/src/LLVM/Internal/Target.hs +++ b/llvm-hs/src/LLVM/Internal/Target.hs @@ -188,7 +188,6 @@ pokeTargetOptions hOpts opts@(TargetOptions cOpts) = do (FFI.targetOptionFlagEmulatedTLS, TO.emulatedThreadLocalStorage), (FFI.targetOptionFlagEnableIPRA, TO.enableInterProceduralRegisterAllocation) ] - FFI.setStackAlignmentOverride cOpts =<< encodeM (TO.stackAlignmentOverride hOpts) FFI.setFloatABIType cOpts =<< encodeM (TO.floatABIType hOpts) FFI.setAllowFPOpFusion cOpts =<< encodeM (TO.allowFloatingPointOperationFusion hOpts) FFI.setCompressDebugSections cOpts =<< encodeM (TO.compressDebugSections hOpts) @@ -259,7 +258,6 @@ peekTargetOptions opts@(TargetOptions tOpts) = do <- gof FFI.targetOptionFlagEmulatedTLS enableInterProceduralRegisterAllocation <- gof FFI.targetOptionFlagEnableIPRA - stackAlignmentOverride <- decodeM =<< FFI.getStackAlignmentOverride tOpts floatABIType <- decodeM =<< FFI.getFloatABIType tOpts allowFloatingPointOperationFusion <- decodeM =<< FFI.getAllowFPOpFusion tOpts threadModel <- decodeM =<< FFI.getThreadModel tOpts diff --git a/llvm-hs/src/LLVM/Target/Options.hs b/llvm-hs/src/LLVM/Target/Options.hs index fa731d61..4b79ee36 100644 --- a/llvm-hs/src/LLVM/Target/Options.hs +++ b/llvm-hs/src/LLVM/Target/Options.hs @@ -86,7 +86,6 @@ data Options = Options { trapUnreachable :: Bool, emulatedThreadLocalStorage :: Bool, enableInterProceduralRegisterAllocation :: Bool, - stackAlignmentOverride :: Word32, floatABIType :: FloatABI, allowFloatingPointOperationFusion :: FloatingPointOperationFusionMode, threadModel :: ThreadModel, diff --git a/llvm-hs/test/LLVM/Test/Module.hs b/llvm-hs/test/LLVM/Test/Module.hs index 3f0ef1eb..7b7604fa 100644 --- a/llvm-hs/test/LLVM/Test/Module.hs +++ b/llvm-hs/test/LLVM/Test/Module.hs @@ -60,17 +60,17 @@ handString = "; ModuleID = ''\n\ \@one = thread_local(initialexec) alias i32, i32* @5\n\ \\n\ \define i32 @bar() prefix i32 1 {\n\ - \ %1 = musttail call zeroext i32 @foo(i32 inreg align 16 1, i8 signext 4) #0\n\ + \ %1 = musttail call zeroext i32 @foo(i32 inreg 1, i8 signext 4) #0\n\ \ ret i32 %1\n\ \}\n\ \\n\ \define i32 @baz() prefix i32 1 {\n\ - \ %1 = notail call zeroext i32 @foo(i32 inreg align 16 1, i8 signext 4) #0\n\ + \ %1 = notail call zeroext i32 @foo(i32 inreg 1, i8 signext 4) #0\n\ \ ret i32 %1\n\ \}\n\ \\n\ \; Function Attrs: nounwind readnone uwtable\n\ - \define zeroext i32 @foo(i32 inreg align 16 %x, i8 signext %y) #0 {\n\ + \define zeroext i32 @foo(i32 inreg %x, i8 signext %y) #0 {\n\ \ %1 = mul nsw i32 %x, %x\n\ \ br label %here\n\ \\n\ @@ -169,7 +169,7 @@ handAST = Module "" "" Nothing Nothing [ returnAttributes = [PA.ZeroExt], function = Right (ConstantOperand (C.GlobalReference (ptr (FunctionType i32 [i32, i8] False)) (Name "foo"))), arguments = [ - (ConstantOperand (C.Int 32 1), [PA.InReg, PA.Alignment 16]), + (ConstantOperand (C.Int 32 1), [PA.InReg]), (ConstantOperand (C.Int 8 4), [PA.SignExt]) ], functionAttributes = [Left (FA.GroupID 0)], @@ -192,7 +192,7 @@ handAST = Module "" "" Nothing Nothing [ returnAttributes = [PA.ZeroExt], function = Right (ConstantOperand (C.GlobalReference (ptr (FunctionType i32 [i32, i8] False)) (Name "foo"))), arguments = [ - (ConstantOperand (C.Int 32 1), [PA.InReg, PA.Alignment 16]), + (ConstantOperand (C.Int 32 1), [PA.InReg]), (ConstantOperand (C.Int 8 4), [PA.SignExt]) ], functionAttributes = [Left (FA.GroupID 0)], @@ -208,7 +208,7 @@ handAST = Module "" "" Nothing Nothing [ G.returnType = i32, G.name = Name "foo", G.parameters = ([ - Parameter i32 (Name "x") [PA.InReg, PA.Alignment 16], + Parameter i32 (Name "x") [PA.InReg], Parameter i8 (Name "y") [PA.SignExt] ], False), G.functionAttributes = [Left (FA.GroupID 0)], diff --git a/llvm-hs/test/LLVM/Test/Optimization.hs b/llvm-hs/test/LLVM/Test/Optimization.hs index 004f38b5..409c1916 100644 --- a/llvm-hs/test/LLVM/Test/Optimization.hs +++ b/llvm-hs/test/LLVM/Test/Optimization.hs @@ -143,7 +143,7 @@ tests = testGroup "Optimization" [ ) ] }, - FunctionAttributes (A.GroupID 0) [A.NoRecurse, A.NoUnwind, A.ReadNone, A.UWTable, A.WillReturn] + FunctionAttributes (A.GroupID 0) [A.NoFree, A.NoRecurse, A.NoSync, A.NoUnwind, A.ReadNone, A.UWTable, A.WillReturn, A.MustProgress] ], testGroup "individual" [ diff --git a/llvm-hs/test/LLVM/Test/Target.hs b/llvm-hs/test/LLVM/Test/Target.hs index 0843b80f..7ab01bb6 100644 --- a/llvm-hs/test/LLVM/Test/Target.hs +++ b/llvm-hs/test/LLVM/Test/Target.hs @@ -74,7 +74,6 @@ instance Arbitrary Options where trapUnreachable <- arbitrary emulatedThreadLocalStorage <- arbitrary enableInterProceduralRegisterAllocation <- arbitrary - stackAlignmentOverride <- arbitrary floatABIType <- arbitrary allowFloatingPointOperationFusion <- arbitrary threadModel <- arbitrary From aba6986a644916239ad414f0966b40f2faffa5f3 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Tue, 13 Jul 2021 11:09:34 +0000 Subject: [PATCH 13/37] Update to match LLVM HEAD changes - Slight updates to Attribute order - GetElementPtr instruction no longer supports pointee type inference. We should stop using that, as LLVM is migrating to opaque pointers. --- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 2 +- llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp | 13 +++++++++++-- llvm-hs/test/LLVM/Test/Optimization.hs | 2 +- 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index a426449e..0b1b3ebd 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -19,6 +19,7 @@ macro(InlineHint,F,F,T) \ macro(JumpTable,F,F,T) \ macro(MinSize,F,F,T) \ + macro(MustProgress,F,F,T) \ macro(Naked,F,F,T) \ macro(Nest,T,F,F) \ macro(NoAlias,T,T,F) \ @@ -73,7 +74,6 @@ macro(ByRef,T,F,F) \ macro(ByVal,T,F,F) \ macro(InAlloca,T,F,F) \ - macro(MustProgress,F,F,T) \ macro(Preallocated,F,F,T) \ macro(StructRet,T,F,F) \ macro(Alignment,T,T,F) \ diff --git a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp index f4b3fb25..dd29d55f 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp @@ -48,6 +48,9 @@ LLVM_HS_FOR_EACH_FAST_MATH_FLAG(ENUM_CASE) return r; } +static llvm::Type* getPointeeType(LLVMValueRef ptr) { + return llvm::cast(unwrap(ptr)->getType())->getElementType(); +} } extern "C" { @@ -274,14 +277,20 @@ LLVMValueRef LLVM_Hs_BuildGEP(LLVMBuilderRef B, LLVMValueRef Pointer, LLVMValueRef *Indices, unsigned NumIndices, const char *Name) { ArrayRef IdxList(unwrap(Indices), NumIndices); - return wrap(unwrap(B)->Insert(GetElementPtrInst::Create(nullptr, unwrap(Pointer), IdxList), Name)); + return wrap( + unwrap(B)->Insert(GetElementPtrInst::Create(getPointeeType(Pointer), + unwrap(Pointer), IdxList), + Name)); } LLVMValueRef LLVM_Hs_BuildInBoundsGEP(LLVMBuilderRef B, LLVMValueRef Pointer, LLVMValueRef *Indices, unsigned NumIndices, const char *Name) { ArrayRef IdxList(unwrap(Indices), NumIndices); - return wrap(unwrap(B)->Insert(GetElementPtrInst::CreateInBounds(nullptr, unwrap(Pointer), IdxList), Name)); + return wrap( + unwrap(B)->Insert(GetElementPtrInst::CreateInBounds( + getPointeeType(Pointer), unwrap(Pointer), IdxList), + Name)); } LLVMValueRef LLVM_Hs_BuildSelect(LLVMBuilderRef B, LLVMValueRef If, diff --git a/llvm-hs/test/LLVM/Test/Optimization.hs b/llvm-hs/test/LLVM/Test/Optimization.hs index 409c1916..d7b986ab 100644 --- a/llvm-hs/test/LLVM/Test/Optimization.hs +++ b/llvm-hs/test/LLVM/Test/Optimization.hs @@ -143,7 +143,7 @@ tests = testGroup "Optimization" [ ) ] }, - FunctionAttributes (A.GroupID 0) [A.NoFree, A.NoRecurse, A.NoSync, A.NoUnwind, A.ReadNone, A.UWTable, A.WillReturn, A.MustProgress] + FunctionAttributes (A.GroupID 0) [A.MustProgress, A.NoFree, A.NoRecurse, A.NoSync, A.NoUnwind, A.ReadNone, A.UWTable, A.WillReturn] ], testGroup "individual" [ From cd50e1e0f6b4cabc6937b4d7a9b833f6e8f048f7 Mon Sep 17 00:00:00 2001 From: Andrew Anderson Date: Fri, 23 Apr 2021 11:40:38 +0100 Subject: [PATCH 14/37] Add a Typed instances for [Int32] Since LLVM 12 changed the mask argument of `shufflevector` to a constant vector of `Int32`, `ppLlvm` requires a `Typed` instance for `[Int32]` for the above snippet to work properly. --- llvm-hs-pure/src/LLVM/AST/Typed.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/llvm-hs-pure/src/LLVM/AST/Typed.hs b/llvm-hs-pure/src/LLVM/AST/Typed.hs index 886a0ce0..1f812492 100644 --- a/llvm-hs-pure/src/LLVM/AST/Typed.hs +++ b/llvm-hs-pure/src/LLVM/AST/Typed.hs @@ -133,3 +133,6 @@ instance Typed Global where in FunctionType returnType (map typeOf params) isVarArg instance Typed Parameter where typeOf (Parameter t _ _) = t + +instance Typed [Int32] where + typeOf mask = VectorType (fromIntegral $ length mask) i32 From 5582e67f73f9a0eec1f2bf42d5ca33dcb8e164ed Mon Sep 17 00:00:00 2001 From: Andrew Date: Mon, 26 Apr 2021 09:37:04 +0100 Subject: [PATCH 15/37] Update the CI configuration -- don't build or download any unnecessary LLVM components, remove hardcoded parallelism limits and let cmake figure things out automatically --- .travis.yml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index aae4d196..4a2734cd 100644 --- a/.travis.yml +++ b/.travis.yml @@ -46,13 +46,11 @@ install: - export PATH=$HOME/cmake-3.19.7-Linux-x86_64/bin:$PATH - curl -L https://github.com/ninja-build/ninja/releases/download/v1.9.0/ninja-linux.zip -o ninja-linux.zip - unzip ninja-linux.zip -d $HOME/bin - - # curl -L https://github.com/llvm/llvm-project/releases/download/llvmorg-${LLVM_VER}/llvm-${LLVM_VER}.src.tar.xz | tar -xJf - -C $HOME - - # rsync -ac $HOME/llvm-${LLVM_VER}.src/ $HOME/llvm-src-${LLVM_VER} - git clone https://github.com/llvm/llvm-project --single-branch - cd llvm-project/llvm - mkdir -p build && cd build - - cmake -DCMAKE_BUILD_TYPE=Release -DCMAKE_CXX_FLAGS_RELEASE=-O0 -DCMAKE_INSTALL_PREFIX=$HOME/llvm-build-${LLVM_VER} -DLLVM_PARALLEL_LINK_JOBS=1 -DLLVM_TARGETS_TO_BUILD=X86 -DLLVM_BUILD_LLVM_DYLIB=True -DLLVM_LINK_LLVM_DYLIB=True -GNinja .. - - ninja -j3 install + - cmake -Wno-dev -G "Ninja" .. -DCMAKE_{BUILD_TYPE=Release,CXX_FLAGS_RELEASE=-O0,INSTALL_PREFIX=$HOME/llvm-build-${LLVM_VER}} -DLLVM_{TARGETS_TO_BUILD="X86",ENABLE_PROJECTS="clang;",INCLUDE_{TOOLS=ON,EXAMPLES=OFF,TESTS=OFF,BENCHMARKS=OFF},ENABLE_BINDINGS=OFF,PARALLEL_LINK_JOBS=1,BUILD_LLVM_DYLIB=ON,LINK_LLVM_DYLIB=ON} + - cmake --build . --parallel --target install - cd $TRAVIS_BUILD_DIR - ln -s $HOME/llvm-build-${LLVM_VER}/bin/llvm-config $HOME/bin/llvm-config - llvm-config --version From 91e2303751df0d09f2f96ec835eb9c609aef2af4 Mon Sep 17 00:00:00 2001 From: Andrew Date: Mon, 26 Apr 2021 09:49:54 +0100 Subject: [PATCH 16/37] Depth 1 clone for llvm --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 4a2734cd..b508616e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -46,7 +46,7 @@ install: - export PATH=$HOME/cmake-3.19.7-Linux-x86_64/bin:$PATH - curl -L https://github.com/ninja-build/ninja/releases/download/v1.9.0/ninja-linux.zip -o ninja-linux.zip - unzip ninja-linux.zip -d $HOME/bin - - git clone https://github.com/llvm/llvm-project --single-branch + - git clone https://github.com/llvm/llvm-project --single-branch --depth 1 - cd llvm-project/llvm - mkdir -p build && cd build - cmake -Wno-dev -G "Ninja" .. -DCMAKE_{BUILD_TYPE=Release,CXX_FLAGS_RELEASE=-O0,INSTALL_PREFIX=$HOME/llvm-build-${LLVM_VER}} -DLLVM_{TARGETS_TO_BUILD="X86",ENABLE_PROJECTS="clang;",INCLUDE_{TOOLS=ON,EXAMPLES=OFF,TESTS=OFF,BENCHMARKS=OFF},ENABLE_BINDINGS=OFF,PARALLEL_LINK_JOBS=1,BUILD_LLVM_DYLIB=ON,LINK_LLVM_DYLIB=ON} From 0231a8341451824fbb5fe86ff71f94d065d3ef3f Mon Sep 17 00:00:00 2001 From: Andrew Date: Tue, 27 Apr 2021 12:00:10 +0100 Subject: [PATCH 17/37] Provide at least the bare minimum of help to the user when they misuse getElementPtrType or getElementType --- llvm-hs-pure/src/LLVM/AST/Typed.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/llvm-hs-pure/src/LLVM/AST/Typed.hs b/llvm-hs-pure/src/LLVM/AST/Typed.hs index 1f812492..8a6f2744 100644 --- a/llvm-hs-pure/src/LLVM/AST/Typed.hs +++ b/llvm-hs-pure/src/LLVM/AST/Typed.hs @@ -102,11 +102,11 @@ getElementPtrType (StructureType _ elTys) (C.Int 32 val:is) = getElementPtrType (elTys !! fromIntegral val) is getElementPtrType (VectorType _ elTy) (_:is) = getElementPtrType elTy is getElementPtrType (ArrayType _ elTy) (_:is) = getElementPtrType elTy is -getElementPtrType _ _ = error "Expecting aggregate type. (Malformed AST)" +getElementPtrType ty@_ _ = error $ "Expecting aggregate type but saw " ++ show ty ++ " (Malformed AST)" getElementType :: Type -> Type getElementType (PointerType t _) = t -getElementType _ = error $ "Expecting pointer type. (Malformed AST)" +getElementType ty@_ = error $ "Expecting pointer type but saw " ++ show ty ++ " (Malformed AST)" extractValueType :: [Word32] -> Type -> Type extractValueType [] ty = ty From 9cdd39ed8b909f0f07b475ddc4c43dd696a29d1a Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Wed, 21 Jul 2021 14:19:57 +0000 Subject: [PATCH 18/37] Fix build breakages caused by upstream changes --- .../src/LLVM/AST/ParameterAttribute.hs | 7 +++--- llvm-hs/src/LLVM/Internal/Attribute.hs | 22 ++++++++++++++----- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 1 + llvm-hs/src/LLVM/Internal/FFI/Attribute.hs | 7 ++++++ llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp | 10 +++++++++ llvm-hs/src/LLVM/Internal/FFI/GlobalValue.h | 2 +- llvm-hs/src/LLVM/Internal/Global.hs | 2 +- llvm-hs/test/LLVM/Test/ParameterAttribute.hs | 7 +++--- 8 files changed, 44 insertions(+), 14 deletions(-) diff --git a/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs b/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs index a05873ce..1c44305b 100644 --- a/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs +++ b/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs @@ -2,15 +2,16 @@ module LLVM.AST.ParameterAttribute where import LLVM.Prelude +import LLVM.AST.Type -- | data ParameterAttribute = Alignment Word64 - | ByVal + | ByVal Type | Dereferenceable Word64 | DereferenceableOrNull Word64 | ImmArg - | InAlloca + | InAlloca Type | InReg | Nest | NoAlias @@ -21,7 +22,7 @@ data ParameterAttribute | ReadOnly | Returned | SignExt - | SRet + | SRet Type | SwiftError | SwiftSelf | WriteOnly diff --git a/llvm-hs/src/LLVM/Internal/Attribute.hs b/llvm-hs/src/LLVM/Internal/Attribute.hs index 6c337da1..73ce2b3e 100644 --- a/llvm-hs/src/LLVM/Internal/Attribute.hs +++ b/llvm-hs/src/LLVM/Internal/Attribute.hs @@ -21,6 +21,7 @@ import Data.Maybe import qualified LLVM.Internal.FFI.Attribute as FFI import qualified LLVM.Internal.FFI.LLVMCTypes as FFI +import LLVM.Internal.Type () import LLVM.Internal.FFI.LLVMCTypes (parameterAttributeKindP, functionAttributeKindP) import qualified LLVM.AST.ParameterAttribute as A.PA @@ -40,14 +41,21 @@ instance Monad m => EncodeM m A.PA.ParameterAttribute (Ptr FFI.ParameterAttrBuil (kindP, kindLen) <- encodeM kind (valueP, valueLen) <- encodeM value liftIO $ FFI.attrBuilderAddStringAttribute b kindP kindLen valueP valueLen + encodeM (A.PA.ByVal t) = return $ \b -> do + ty <- encodeM t + liftIO $ FFI.attrBuilderAddParameterTypeAttribute b FFI.parameterAttributeKindByVal ty + encodeM (A.PA.InAlloca t) = return $ \b -> do + ty <- encodeM t + liftIO $ FFI.attrBuilderAddParameterTypeAttribute b FFI.parameterAttributeKindInAlloca ty + encodeM (A.PA.SRet t) = return $ \b -> do + ty <- encodeM t + liftIO $ FFI.attrBuilderAddParameterTypeAttribute b FFI.parameterAttributeKindStructRet ty encodeM a = return $ \b -> liftIO $ case a of A.PA.Alignment v -> FFI.attrBuilderAddAlignment b v A.PA.Dereferenceable v -> FFI.attrBuilderAddDereferenceable b v A.PA.DereferenceableOrNull v -> FFI.attrBuilderAddDereferenceableOrNull b v _ -> FFI.attrBuilderAddParameterAttributeKind b $ case a of - A.PA.ByVal -> FFI.parameterAttributeKindByVal A.PA.ImmArg -> FFI.parameterAttributeKindImmArg - A.PA.InAlloca -> FFI.parameterAttributeKindInAlloca A.PA.InReg -> FFI.parameterAttributeKindInReg A.PA.Nest -> FFI.parameterAttributeKindNest A.PA.NoAlias -> FFI.parameterAttributeKindNoAlias @@ -58,11 +66,13 @@ instance Monad m => EncodeM m A.PA.ParameterAttribute (Ptr FFI.ParameterAttrBuil A.PA.ReadOnly -> FFI.parameterAttributeKindReadOnly A.PA.Returned -> FFI.parameterAttributeKindReturned A.PA.SignExt -> FFI.parameterAttributeKindSExt - A.PA.SRet -> FFI.parameterAttributeKindStructRet A.PA.SwiftError -> FFI.parameterAttributeKindSwiftError A.PA.SwiftSelf -> FFI.parameterAttributeKindSwiftSelf A.PA.WriteOnly -> FFI.parameterAttributeKindWriteOnly A.PA.ZeroExt -> FFI.parameterAttributeKindZExt + A.PA.ByVal _ -> inconsistentCases "ParameterAttribute" a + A.PA.InAlloca _ -> inconsistentCases "ParameterAttribute" a + A.PA.SRet _ -> inconsistentCases "ParameterAttribute" a A.PA.Alignment _ -> inconsistentCases "ParameterAttribute" a A.PA.Dereferenceable _ -> inconsistentCases "ParameterAttribute" a A.PA.DereferenceableOrNull _ -> inconsistentCases "ParameterAttribute" a @@ -152,11 +162,12 @@ instance DecodeM DecodeAST A.PA.ParameterAttribute FFI.ParameterAttribute where enum <- liftIO $ FFI.parameterAttributeKindAsEnum a case enum of [parameterAttributeKindP|Alignment|] -> return A.PA.Alignment `ap` (liftIO $ FFI.attributeValueAsInt a) - [parameterAttributeKindP|ByVal|] -> return A.PA.ByVal + [parameterAttributeKindP|ByVal|] -> A.PA.ByVal <$> (decodeM =<< liftIO (FFI.attributeValueAsType a)) + [parameterAttributeKindP|InAlloca|] -> A.PA.InAlloca <$> (decodeM =<< liftIO (FFI.attributeValueAsType a)) + [parameterAttributeKindP|StructRet|] -> A.PA.SRet <$> (decodeM =<< liftIO (FFI.attributeValueAsType a)) [parameterAttributeKindP|DereferenceableOrNull|] -> return A.PA.DereferenceableOrNull `ap` (liftIO $ FFI.attributeValueAsInt a) [parameterAttributeKindP|Dereferenceable|] -> return A.PA.Dereferenceable `ap` (liftIO $ FFI.attributeValueAsInt a) [parameterAttributeKindP|ImmArg|] -> return A.PA.ImmArg - [parameterAttributeKindP|InAlloca|] -> return A.PA.InAlloca [parameterAttributeKindP|InReg|] -> return A.PA.InReg [parameterAttributeKindP|Nest|] -> return A.PA.Nest [parameterAttributeKindP|NoAlias|] -> return A.PA.NoAlias @@ -167,7 +178,6 @@ instance DecodeM DecodeAST A.PA.ParameterAttribute FFI.ParameterAttribute where [parameterAttributeKindP|ReadOnly|] -> return A.PA.ReadOnly [parameterAttributeKindP|Returned|] -> return A.PA.Returned [parameterAttributeKindP|SExt|] -> return A.PA.SignExt - [parameterAttributeKindP|StructRet|] -> return A.PA.SRet [parameterAttributeKindP|SwiftError|] -> return A.PA.SwiftError [parameterAttributeKindP|SwiftSelf|] -> return A.PA.SwiftSelf [parameterAttributeKindP|WriteOnly|] -> return A.PA.WriteOnly diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index 0b1b3ebd..956dde8d 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -73,6 +73,7 @@ macro(ZExt,T,T,F) \ macro(ByRef,T,F,F) \ macro(ByVal,T,F,F) \ + macro(ElementType,T,F,F) \ macro(InAlloca,T,F,F) \ macro(Preallocated,F,F,T) \ macro(StructRet,T,F,F) \ diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs b/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs index 85c828bd..ac65715a 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs @@ -11,6 +11,7 @@ import Foreign.Ptr import LLVM.Internal.FFI.Context import LLVM.Internal.FFI.LLVMCTypes +import LLVM.Internal.FFI.PtrHierarchy type Slot = CUInt type IntValue = Word64 @@ -78,6 +79,9 @@ foreign import ccall unsafe "LLVM_Hs_AttributeValueAsString" attributeValueAsStr foreign import ccall unsafe "LLVM_Hs_AttributeValueAsInt" attributeValueAsInt :: Attribute a -> IO Word64 +foreign import ccall unsafe "LLVM_Hs_AttributeValueAsType" attributeValueAsType :: + Attribute a -> IO (Ptr Type) + foreign import ccall unsafe "LLVM_Hs_getNumAttributes" getNumAttributes :: AttributeSet a -> IO CUInt @@ -133,6 +137,9 @@ foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddAttributeKind" attrBuilderAdd foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddAttributeKind" attrBuilderAddParameterAttributeKind :: Ptr ParameterAttrBuilder -> ParameterAttributeKind -> IO () +foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddTypeAttribute" attrBuilderAddParameterTypeAttribute :: + Ptr ParameterAttrBuilder -> ParameterAttributeKind -> Ptr Type -> IO () + foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddStringAttribute" attrBuilderAddStringAttribute :: Ptr (AttrBuilder a) -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp index 225c717b..cfe73f11 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp @@ -1,4 +1,6 @@ #define __STDC_LIMIT_MACROS +#include "llvm-c/Core.h" +#include "llvm/IR/DerivedTypes.h" #include "LLVM/Internal/FFI/AttributeC.hpp" #include "llvm/IR/LLVMContext.h" @@ -28,6 +30,10 @@ uint64_t LLVM_Hs_AttributeValueAsInt(LLVMAttributeRef a) { return unwrap(a).getValueAsInt(); } +LLVMTypeRef LLVM_Hs_AttributeValueAsType(LLVMAttributeRef a) { + return wrap(unwrap(a).getValueAsType()); +} + LLVMBool LLVM_Hs_IsStringAttribute(LLVMAttributeRef a) { return unwrap(a).isStringAttribute(); } @@ -118,6 +124,10 @@ void LLVM_Hs_AttrBuilderAddAttributeKind(AttrBuilder &ab, unsigned kind) { ab.addAttribute(Attribute::AttrKind(kind)); } +void LLVM_Hs_AttrBuilderAddTypeAttribute(AttrBuilder &ab, unsigned kind, LLVMTypeRef t) { + ab.addTypeAttr(Attribute::AttrKind(kind), unwrap(t)); +} + void LLVM_Hs_AttrBuilderAddStringAttribute(AttrBuilder &ab, const char *kind, size_t kind_len, const char *value, size_t value_len) { diff --git a/llvm-hs/src/LLVM/Internal/FFI/GlobalValue.h b/llvm-hs/src/LLVM/Internal/FFI/GlobalValue.h index 40f3450c..0fdb14dc 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/GlobalValue.h +++ b/llvm-hs/src/LLVM/Internal/FFI/GlobalValue.h @@ -23,7 +23,7 @@ macro(Any) \ macro(ExactMatch) \ macro(Largest) \ - macro(NoDuplicates) \ + macro(NoDeduplicate) \ macro(SameSize) typedef enum { diff --git a/llvm-hs/src/LLVM/Internal/Global.hs b/llvm-hs/src/LLVM/Internal/Global.hs index bf69cdc5..b56c3e0b 100644 --- a/llvm-hs/src/LLVM/Internal/Global.hs +++ b/llvm-hs/src/LLVM/Internal/Global.hs @@ -91,7 +91,7 @@ genCodingInstance [t| A.COMDAT.SelectionKind |] ''FFI.COMDATSelectionKind [ (FFI.comdatSelectionKindAny, A.COMDAT.Any), (FFI.comdatSelectionKindExactMatch, A.COMDAT.ExactMatch), (FFI.comdatSelectionKindLargest, A.COMDAT.Largest), - (FFI.comdatSelectionKindNoDuplicates, A.COMDAT.NoDuplicates), + (FFI.comdatSelectionKindNoDeduplicate, A.COMDAT.NoDuplicates), (FFI.comdatSelectionKindSameSize, A.COMDAT.SameSize) ] diff --git a/llvm-hs/test/LLVM/Test/ParameterAttribute.hs b/llvm-hs/test/LLVM/Test/ParameterAttribute.hs index 2776f499..9e0b1639 100644 --- a/llvm-hs/test/LLVM/Test/ParameterAttribute.hs +++ b/llvm-hs/test/LLVM/Test/ParameterAttribute.hs @@ -9,6 +9,7 @@ import Test.Tasty.QuickCheck hiding ( (.&.) ) import LLVM.Test.Support import LLVM.AST.ParameterAttribute +import qualified LLVM.AST as A import LLVM.Internal.Coding import LLVM.Internal.Context import LLVM.Internal.EncodeAST @@ -30,11 +31,11 @@ instance Arbitrary ParameterAttribute where [ return ZeroExt , return SignExt , return InReg - , return SRet + , return $ SRet $ A.IntegerType 32 -- LLVM doesn't allow alignments larger than 2^29! , Alignment <$> elements (map (2^) [0..29 :: Int]) , return NoAlias - , return ByVal + , return $ ByVal $ A.IntegerType 32 , return NoCapture , return NoFree , return Nest @@ -42,7 +43,7 @@ instance Arbitrary ParameterAttribute where , return ReadOnly , return WriteOnly , return ImmArg - , return InAlloca + , return $ InAlloca $ A.IntegerType 32 , return NonNull , Dereferenceable <$> suchThat arbitrary (/= 0) , DereferenceableOrNull <$> suchThat arbitrary (/= 0) From 1a69805f63fdd175377f2f35290101f71c0c296d Mon Sep 17 00:00:00 2001 From: Robbert van der Helm Date: Sun, 14 Nov 2021 16:06:23 +0100 Subject: [PATCH 19/37] Add missing argument to ORC ExecutionSession As of the LLVM 13 commit linked below, the executor process control for interacting with an ORC session has been moved into the `ExecutionSession`. llvm-hs currently does also doesn't support the old way of interacting with these. This `UnsupportedExecutorProcessControl` is simply an empty implementation meant as a migration path for clients that don't already use `ExecutorProcessControl`-based APIs. https://github.com/llvm/llvm-project/commit/2487db1f286222e2501c2fa8e8244eda13f6afc3 --- llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp index 0b2308ad..8c7f9406 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp @@ -52,7 +52,8 @@ extern "C" { // ExecutionSession ExecutionSession *LLVM_Hs_createExecutionSession() { - return new ExecutionSession(); + // TODO: llvm-hs does not yet expose LLVM 13's executor process control API + return new ExecutionSession(std::make_unique()); } void LLVM_Hs_disposeExecutionSession(ExecutionSession *es) { From 86365deebf891cf88a08d3744fe2771969b61f80 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Mon, 7 Mar 2022 12:51:04 +0000 Subject: [PATCH 20/37] A bunch of updates to match LLVM HEAD --- .../src/LLVM/AST/ParameterAttribute.hs | 1 + llvm-hs/src/LLVM/Internal/Attribute.hs | 25 +++++++++++-------- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 6 +++-- llvm-hs/src/LLVM/Internal/FFI/Attribute.hs | 10 ++++++-- llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp | 19 ++++++++++---- llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp | 3 ++- llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp | 5 ++-- llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp | 3 +-- llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp | 2 +- llvm-hs/test/LLVM/Test/Attribute.hs | 2 +- llvm-hs/test/LLVM/Test/Optimization.hs | 2 +- 11 files changed, 51 insertions(+), 27 deletions(-) diff --git a/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs b/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs index 1c44305b..f9bd5a27 100644 --- a/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs +++ b/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs @@ -17,6 +17,7 @@ data ParameterAttribute | NoAlias | NoCapture | NoFree + | NoUndef | NonNull | ReadNone | ReadOnly diff --git a/llvm-hs/src/LLVM/Internal/Attribute.hs b/llvm-hs/src/LLVM/Internal/Attribute.hs index 73ce2b3e..e70d77e3 100644 --- a/llvm-hs/src/LLVM/Internal/Attribute.hs +++ b/llvm-hs/src/LLVM/Internal/Attribute.hs @@ -20,6 +20,7 @@ import Foreign.Ptr import Data.Maybe import qualified LLVM.Internal.FFI.Attribute as FFI +import qualified LLVM.Internal.FFI.Context as FFI import qualified LLVM.Internal.FFI.LLVMCTypes as FFI import LLVM.Internal.Type () import LLVM.Internal.FFI.LLVMCTypes (parameterAttributeKindP, functionAttributeKindP) @@ -61,6 +62,7 @@ instance Monad m => EncodeM m A.PA.ParameterAttribute (Ptr FFI.ParameterAttrBuil A.PA.NoAlias -> FFI.parameterAttributeKindNoAlias A.PA.NoCapture -> FFI.parameterAttributeKindNoCapture A.PA.NoFree -> FFI.parameterAttributeKindNoFree + A.PA.NoUndef -> FFI.parameterAttributeKindNoUndef A.PA.NonNull -> FFI.parameterAttributeKindNonNull A.PA.ReadNone -> FFI.parameterAttributeKindReadNone A.PA.ReadOnly -> FFI.parameterAttributeKindReadOnly @@ -93,6 +95,7 @@ instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilde vsMax' <- encodeM vsMax liftIO $ FFI.attrBuilderAddVScaleRange b vsMin' vsMax' A.FA.StackAlignment v -> liftIO $ FFI.attrBuilderAddStackAlignment b v + A.FA.UWTable -> liftIO $ FFI.attrBuilderAddUWTable b _ -> liftIO $ FFI.attrBuilderAddFunctionAttributeKind b $ case a of A.FA.AlwaysInline -> FFI.functionAttributeKindAlwaysInline A.FA.ArgMemOnly -> FFI.functionAttributeKindArgMemOnly @@ -142,7 +145,6 @@ instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilde A.FA.StackProtectReq -> FFI.functionAttributeKindStackProtectReq A.FA.StackProtectStrong -> FFI.functionAttributeKindStackProtectStrong A.FA.StrictFP -> FFI.functionAttributeKindStrictFP - A.FA.UWTable -> FFI.functionAttributeKindUWTable A.FA.WillReturn -> FFI.functionAttributeKindWillReturn A.FA.WriteOnly -> FFI.functionAttributeKindWriteOnly A.FA.AllocSize _ _ -> inconsistentCases "FunctionAttribute" a @@ -174,6 +176,7 @@ instance DecodeM DecodeAST A.PA.ParameterAttribute FFI.ParameterAttribute where [parameterAttributeKindP|NoCapture|] -> return A.PA.NoCapture [parameterAttributeKindP|NoFree|] -> return A.PA.NoFree [parameterAttributeKindP|NonNull|] -> return A.PA.NonNull + [parameterAttributeKindP|NoUndef|] -> return A.PA.NoUndef [parameterAttributeKindP|ReadNone|] -> return A.PA.ReadNone [parameterAttributeKindP|ReadOnly|] -> return A.PA.ReadOnly [parameterAttributeKindP|Returned|] -> return A.PA.Returned @@ -249,7 +252,9 @@ instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where [functionAttributeKindP|StackProtectStrong|] -> return A.FA.StackProtectStrong [functionAttributeKindP|StackProtect|] -> return A.FA.StackProtect [functionAttributeKindP|StrictFP|] -> return A.FA.StrictFP - [functionAttributeKindP|UWTable|] -> return A.FA.UWTable + [functionAttributeKindP|UWTable|] -> do + liftIO $ FFI.attributeEnsureUWTableKindDefault a + return A.FA.UWTable [functionAttributeKindP|WillReturn|] -> return A.FA.WillReturn [functionAttributeKindP|WriteOnly|] -> return A.FA.WriteOnly [functionAttributeKindP|VScaleRange|] -> do @@ -259,11 +264,11 @@ instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where A.FA.VScaleRange <$> (decodeM =<< peek vsMin) <*> (decodeM =<< peek vsMax) _ -> error $ "unhandled function attribute enum value: " ++ show enum -allocaAttrBuilder :: (Monad m, MonadAnyCont IO m) => m (Ptr (FFI.AttrBuilder a)) -allocaAttrBuilder = do +allocaAttrBuilder :: (Monad m, MonadAnyCont IO m) => Ptr (FFI.Context) -> m (Ptr (FFI.AttrBuilder a)) +allocaAttrBuilder (context) = do p <- allocaArray FFI.getAttrBuilderSize anyContToM $ \f -> do - ab <- FFI.constructAttrBuilder p + ab <- FFI.constructAttrBuilder context p r <- f ab FFI.destroyAttrBuilder ab return r @@ -271,10 +276,10 @@ allocaAttrBuilder = do instance forall a b. EncodeM EncodeAST a (Ptr (FFI.AttrBuilder b) -> EncodeAST ()) => EncodeM EncodeAST [a] (FFI.AttributeSet b) where encodeM as = do - ab <- allocaAttrBuilder + Context context <- gets encodeStateContext + ab <- allocaAttrBuilder context builds <- mapM encodeM as void (forM builds ($ ab) :: EncodeAST [()]) - Context context <- gets encodeStateContext anyContToM (bracket (FFI.getAttributeSet context ab) FFI.disposeAttributeSet) @@ -300,17 +305,17 @@ data PreSlot instance {-# OVERLAPPING #-} EncodeM EncodeAST [Either A.FA.GroupID A.FA.FunctionAttribute] FFI.FunctionAttributeSet where encodeM attrs = do - ab <- allocaAttrBuilder + Context context <- gets encodeStateContext + ab <- allocaAttrBuilder context forM_ attrs $ \attr -> case attr of Left groupId -> do attrSet <- referAttributeGroup groupId - ab' <- anyContToM (bracket (FFI.attrBuilderFromSet attrSet) FFI.disposeAttrBuilder) + ab' <- anyContToM (bracket (FFI.attrBuilderFromSet context attrSet) FFI.disposeAttrBuilder) liftIO (FFI.mergeAttrBuilder ab ab') Right attr -> do addAttr <- encodeM attr addAttr ab :: EncodeAST () - Context context <- gets encodeStateContext anyContToM (bracket (FFI.getAttributeSet context ab) FFI.disposeAttributeSet) diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index 956dde8d..1e491dc3 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -11,6 +11,7 @@ macro(Builtin,F,F,T) \ macro(Cold,F,F,T) \ macro(Convergent,F,F,T) \ + macro(DisableSanitizerInstrumentation,F,F,T) \ macro(Hot,F,F,T) \ macro(ImmArg,T,F,F) \ macro(InReg,T,T,F) \ @@ -36,9 +37,10 @@ macro(NoRecurse,F,F,T) \ macro(NoRedZone,F,F,T) \ macro(NoReturn,F,F,T) \ + macro(NoSanitizeBounds,F,F,T) \ macro(NoSanitizeCoverage,F,F,T) \ macro(NoSync,F,F,T) \ - macro(NoUndef,F,F,T) \ + macro(NoUndef,T,F,T) \ macro(NoUnwind,F,F,T) \ macro(NonLazyBind,F,F,T) \ macro(NonNull,T,T,F) \ @@ -67,7 +69,6 @@ macro(SwiftAsync,T,F,F) \ macro(SwiftError,T,F,F) \ macro(SwiftSelf,T,F,F) \ - macro(UWTable,F,F,T) \ macro(WillReturn,F,F,T) \ macro(WriteOnly,T,F,T) \ macro(ZExt,T,T,F) \ @@ -82,6 +83,7 @@ macro(Dereferenceable,T,T,F) \ macro(DereferenceableOrNull,T,T,F) \ macro(StackAlignment,F,F,T) \ + macro(UWTable,F,F,T) \ macro(VScaleRange,F,F,T) \ macro(EndAttrKinds,F,F,F) diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs b/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs index ac65715a..2be57e88 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs @@ -79,6 +79,9 @@ foreign import ccall unsafe "LLVM_Hs_AttributeValueAsString" attributeValueAsStr foreign import ccall unsafe "LLVM_Hs_AttributeValueAsInt" attributeValueAsInt :: Attribute a -> IO Word64 +foreign import ccall unsafe "LLVM_Hs_AttributeEnsureUWTableKindDefault" attributeEnsureUWTableKindDefault :: + Attribute a -> IO () + foreign import ccall unsafe "LLVM_Hs_AttributeValueAsType" attributeValueAsType :: Attribute a -> IO (Ptr Type) @@ -117,7 +120,7 @@ foreign import ccall unsafe "LLVM_Hs_GetAttrBuilderSize" getAttrBuilderSize :: CSize foreign import ccall unsafe "LLVM_Hs_AttrBuilderFromAttrSet" attrBuilderFromSet :: - AttributeSet a -> IO (Ptr (AttrBuilder a)) + Ptr Context -> AttributeSet a -> IO (Ptr (AttrBuilder a)) foreign import ccall unsafe "LLVM_Hs_DisposeAttrBuilder" disposeAttrBuilder :: Ptr (AttrBuilder a) -> IO () @@ -126,7 +129,7 @@ foreign import ccall unsafe "LLVM_Hs_AttrBuilderMerge" mergeAttrBuilder :: Ptr (AttrBuilder a) -> Ptr (AttrBuilder a) -> IO () foreign import ccall unsafe "LLVM_Hs_ConstructAttrBuilder" constructAttrBuilder :: - Ptr Word8 -> IO (Ptr (AttrBuilder a)) + Ptr Context -> Ptr Word8 -> IO (Ptr (AttrBuilder a)) foreign import ccall unsafe "LLVM_Hs_DestroyAttrBuilder" destroyAttrBuilder :: Ptr (AttrBuilder a) -> IO () @@ -149,6 +152,9 @@ foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddAlignment" attrBuilderAddAlig foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddStackAlignment" attrBuilderAddStackAlignment :: Ptr FunctionAttrBuilder -> Word64 -> IO () +foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddUWTable" attrBuilderAddUWTable :: + Ptr FunctionAttrBuilder -> IO () + -- The CInt is 0 if the last value is null and 1 otherwise foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddAllocSize" attrBuilderAddAllocSize' :: Ptr FunctionAttrBuilder -> CUInt -> CUInt -> LLVMBool -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp index cfe73f11..f5566bce 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp @@ -30,6 +30,10 @@ uint64_t LLVM_Hs_AttributeValueAsInt(LLVMAttributeRef a) { return unwrap(a).getValueAsInt(); } +void LLVM_Hs_AttributeEnsureUWTableKindDefault(LLVMAttributeRef a) { + assert(unwrap(a).getUWTableKind() == UWTableKind::Default); +} + LLVMTypeRef LLVM_Hs_AttributeValueAsType(LLVMAttributeRef a) { return wrap(unwrap(a).getValueAsType()); } @@ -104,12 +108,12 @@ void LLVM_Hs_getAttributes(LLVMAttributeSetRef attributeSet, size_t LLVM_Hs_GetAttrBuilderSize() { return sizeof(AttrBuilder); } -AttrBuilder *LLVM_Hs_ConstructAttrBuilder(char *p) { - return new (p) AttrBuilder(); +AttrBuilder *LLVM_Hs_ConstructAttrBuilder(LLVMContextRef context, char *p) { + return new (p) AttrBuilder(*unwrap(context)); } -AttrBuilder *LLVM_Hs_AttrBuilderFromAttrSet(LLVMAttributeSetRef as) { - return new AttrBuilder(*as); +AttrBuilder *LLVM_Hs_AttrBuilderFromAttrSet(LLVMContextRef context, LLVMAttributeSetRef as) { + return new AttrBuilder(*unwrap(context), *as); } void LLVM_Hs_DisposeAttrBuilder(AttrBuilder *as) { delete as; } @@ -142,6 +146,10 @@ void LLVM_Hs_AttrBuilderAddStackAlignment(AttrBuilder &ab, uint64_t v) { ab.addStackAlignmentAttr(MaybeAlign(v)); } +void LLVM_Hs_AttrBuilderAddUWTable(AttrBuilder &ab) { + ab.addUWTableAttr(UWTableKind::Default); +} + void LLVM_Hs_AttrBuilderAddAllocSize(AttrBuilder &ab, unsigned x, unsigned y, LLVMBool optionalIsThere) { if (optionalIsThere) { @@ -173,7 +181,8 @@ LLVMBool LLVM_Hs_AttributeGetAllocSizeArgs(LLVMAttributeRef a, unsigned *x, } void LLVM_Hs_AttributeGetVScaleRangeArgs(LLVMAttributeRef a, unsigned *min, unsigned *max) { - std::tie(*min, *max) = unwrap(a).getVScaleRangeArgs(); + *min = unwrap(a).getVScaleRangeMin(); + *max = unwrap(a).getVScaleRangeMax().getValueOr(0); } void LLVM_Hs_AttrBuilderAddVScaleRange(AttrBuilder &ab, unsigned min, unsigned max) { diff --git a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp index dd29d55f..3f6bcefc 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp @@ -48,8 +48,9 @@ LLVM_HS_FOR_EACH_FAST_MATH_FLAG(ENUM_CASE) return r; } +// TODO: Pass in pointee types when building GEPs and remove this. static llvm::Type* getPointeeType(LLVMValueRef ptr) { - return llvm::cast(unwrap(ptr)->getType())->getElementType(); + return unwrap(ptr)->getType()->getPointerElementType(); } } diff --git a/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp b/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp index 6dbdc43a..10473d5c 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp @@ -3,6 +3,7 @@ #include #include "llvm/Support/FormattedStream.h" +#include "llvm/BinaryFormat/Dwarf.h" #include "llvm/Config/llvm-config.h" #include "llvm/IR/LLVMContext.h" #include "llvm/IR/Metadata.h" @@ -634,7 +635,7 @@ DILocalVariable* LLVM_Hs_Get_DILocalVariable(LLVMContextRef ctx, DINode::DIFlags flags, uint32_t alignInBits) { LLVMContext &c = *unwrap(ctx); return DILocalVariable::get(c, static_cast(scope), name, file, line, type, - arg, flags, alignInBits); + arg, flags, alignInBits, nullptr); } uint16_t LLVM_Hs_DILocalVariable_GetArg(DILocalVariable* v) { @@ -659,7 +660,7 @@ DIGlobalVariable* LLVM_Hs_Get_DIGlobalVariable(LLVMContextRef ctx, file, line, type, isLocalToUnit, isDefinition, declaration, templateParams, - alignInBits); + alignInBits, nullptr); } LLVMBool LLVM_Hs_DIGlobalVariable_GetLocal(DIGlobalVariable* v) { diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp index 8c7f9406..7ad2eb3f 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp @@ -52,8 +52,7 @@ extern "C" { // ExecutionSession ExecutionSession *LLVM_Hs_createExecutionSession() { - // TODO: llvm-hs does not yet expose LLVM 13's executor process control API - return new ExecutionSession(std::make_unique()); + return new ExecutionSession(std::move(*SelfExecutorProcessControl::Create())); } void LLVM_Hs_disposeExecutionSession(ExecutionSession *es) { diff --git a/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp b/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp index 7bc7e39b..51d2c186 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp @@ -12,9 +12,9 @@ #include "llvm/IR/DataLayout.h" #include "llvm/IR/LegacyPassManager.h" #include "llvm/IR/Module.h" +#include "llvm/MC/TargetRegistry.h" #include "llvm/Support/FormattedStream.h" #include "llvm/Support/Host.h" -#include "llvm/Support/TargetRegistry.h" #include "llvm/Support/TargetSelect.h" #include "llvm/Target/CodeGenCWrappers.h" #include "llvm/Target/TargetMachine.h" diff --git a/llvm-hs/test/LLVM/Test/Attribute.hs b/llvm-hs/test/LLVM/Test/Attribute.hs index da75ce69..d91d1e6e 100644 --- a/llvm-hs/test/LLVM/Test/Attribute.hs +++ b/llvm-hs/test/LLVM/Test/Attribute.hs @@ -106,10 +106,10 @@ moduleAst = , StackProtect , StackProtectReq , StackProtectStrong - , UWTable , WriteOnly , AllocSize 8 (Just 16) , StackAlignment 8 + , UWTable , StringAttribute "bar" "baz" , StringAttribute "foo" "" , StringAttribute "qux" "" diff --git a/llvm-hs/test/LLVM/Test/Optimization.hs b/llvm-hs/test/LLVM/Test/Optimization.hs index d7b986ab..8d7c437d 100644 --- a/llvm-hs/test/LLVM/Test/Optimization.hs +++ b/llvm-hs/test/LLVM/Test/Optimization.hs @@ -143,7 +143,7 @@ tests = testGroup "Optimization" [ ) ] }, - FunctionAttributes (A.GroupID 0) [A.MustProgress, A.NoFree, A.NoRecurse, A.NoSync, A.NoUnwind, A.ReadNone, A.UWTable, A.WillReturn] + FunctionAttributes (A.GroupID 0) [A.MustProgress, A.NoFree, A.NoRecurse, A.NoSync, A.NoUnwind, A.ReadNone, A.WillReturn, A.UWTable] ], testGroup "individual" [ From bc670889a83879c8507e8caeed9beb71c749df5f Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Mon, 7 Mar 2022 12:51:04 +0000 Subject: [PATCH 21/37] A bunch of updates to match LLVM HEAD --- .../src/LLVM/AST/ParameterAttribute.hs | 1 + llvm-hs/src/LLVM/Internal/Attribute.hs | 25 +++++++++++-------- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 6 +++-- llvm-hs/src/LLVM/Internal/FFI/Attribute.hs | 10 ++++++-- llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp | 19 ++++++++++---- llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp | 3 ++- llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp | 5 ++-- llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp | 3 +-- llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp | 2 +- llvm-hs/test/LLVM/Test/Attribute.hs | 2 +- llvm-hs/test/LLVM/Test/Optimization.hs | 2 +- 11 files changed, 51 insertions(+), 27 deletions(-) diff --git a/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs b/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs index 1c44305b..f9bd5a27 100644 --- a/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs +++ b/llvm-hs-pure/src/LLVM/AST/ParameterAttribute.hs @@ -17,6 +17,7 @@ data ParameterAttribute | NoAlias | NoCapture | NoFree + | NoUndef | NonNull | ReadNone | ReadOnly diff --git a/llvm-hs/src/LLVM/Internal/Attribute.hs b/llvm-hs/src/LLVM/Internal/Attribute.hs index 73ce2b3e..e70d77e3 100644 --- a/llvm-hs/src/LLVM/Internal/Attribute.hs +++ b/llvm-hs/src/LLVM/Internal/Attribute.hs @@ -20,6 +20,7 @@ import Foreign.Ptr import Data.Maybe import qualified LLVM.Internal.FFI.Attribute as FFI +import qualified LLVM.Internal.FFI.Context as FFI import qualified LLVM.Internal.FFI.LLVMCTypes as FFI import LLVM.Internal.Type () import LLVM.Internal.FFI.LLVMCTypes (parameterAttributeKindP, functionAttributeKindP) @@ -61,6 +62,7 @@ instance Monad m => EncodeM m A.PA.ParameterAttribute (Ptr FFI.ParameterAttrBuil A.PA.NoAlias -> FFI.parameterAttributeKindNoAlias A.PA.NoCapture -> FFI.parameterAttributeKindNoCapture A.PA.NoFree -> FFI.parameterAttributeKindNoFree + A.PA.NoUndef -> FFI.parameterAttributeKindNoUndef A.PA.NonNull -> FFI.parameterAttributeKindNonNull A.PA.ReadNone -> FFI.parameterAttributeKindReadNone A.PA.ReadOnly -> FFI.parameterAttributeKindReadOnly @@ -93,6 +95,7 @@ instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilde vsMax' <- encodeM vsMax liftIO $ FFI.attrBuilderAddVScaleRange b vsMin' vsMax' A.FA.StackAlignment v -> liftIO $ FFI.attrBuilderAddStackAlignment b v + A.FA.UWTable -> liftIO $ FFI.attrBuilderAddUWTable b _ -> liftIO $ FFI.attrBuilderAddFunctionAttributeKind b $ case a of A.FA.AlwaysInline -> FFI.functionAttributeKindAlwaysInline A.FA.ArgMemOnly -> FFI.functionAttributeKindArgMemOnly @@ -142,7 +145,6 @@ instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilde A.FA.StackProtectReq -> FFI.functionAttributeKindStackProtectReq A.FA.StackProtectStrong -> FFI.functionAttributeKindStackProtectStrong A.FA.StrictFP -> FFI.functionAttributeKindStrictFP - A.FA.UWTable -> FFI.functionAttributeKindUWTable A.FA.WillReturn -> FFI.functionAttributeKindWillReturn A.FA.WriteOnly -> FFI.functionAttributeKindWriteOnly A.FA.AllocSize _ _ -> inconsistentCases "FunctionAttribute" a @@ -174,6 +176,7 @@ instance DecodeM DecodeAST A.PA.ParameterAttribute FFI.ParameterAttribute where [parameterAttributeKindP|NoCapture|] -> return A.PA.NoCapture [parameterAttributeKindP|NoFree|] -> return A.PA.NoFree [parameterAttributeKindP|NonNull|] -> return A.PA.NonNull + [parameterAttributeKindP|NoUndef|] -> return A.PA.NoUndef [parameterAttributeKindP|ReadNone|] -> return A.PA.ReadNone [parameterAttributeKindP|ReadOnly|] -> return A.PA.ReadOnly [parameterAttributeKindP|Returned|] -> return A.PA.Returned @@ -249,7 +252,9 @@ instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where [functionAttributeKindP|StackProtectStrong|] -> return A.FA.StackProtectStrong [functionAttributeKindP|StackProtect|] -> return A.FA.StackProtect [functionAttributeKindP|StrictFP|] -> return A.FA.StrictFP - [functionAttributeKindP|UWTable|] -> return A.FA.UWTable + [functionAttributeKindP|UWTable|] -> do + liftIO $ FFI.attributeEnsureUWTableKindDefault a + return A.FA.UWTable [functionAttributeKindP|WillReturn|] -> return A.FA.WillReturn [functionAttributeKindP|WriteOnly|] -> return A.FA.WriteOnly [functionAttributeKindP|VScaleRange|] -> do @@ -259,11 +264,11 @@ instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where A.FA.VScaleRange <$> (decodeM =<< peek vsMin) <*> (decodeM =<< peek vsMax) _ -> error $ "unhandled function attribute enum value: " ++ show enum -allocaAttrBuilder :: (Monad m, MonadAnyCont IO m) => m (Ptr (FFI.AttrBuilder a)) -allocaAttrBuilder = do +allocaAttrBuilder :: (Monad m, MonadAnyCont IO m) => Ptr (FFI.Context) -> m (Ptr (FFI.AttrBuilder a)) +allocaAttrBuilder (context) = do p <- allocaArray FFI.getAttrBuilderSize anyContToM $ \f -> do - ab <- FFI.constructAttrBuilder p + ab <- FFI.constructAttrBuilder context p r <- f ab FFI.destroyAttrBuilder ab return r @@ -271,10 +276,10 @@ allocaAttrBuilder = do instance forall a b. EncodeM EncodeAST a (Ptr (FFI.AttrBuilder b) -> EncodeAST ()) => EncodeM EncodeAST [a] (FFI.AttributeSet b) where encodeM as = do - ab <- allocaAttrBuilder + Context context <- gets encodeStateContext + ab <- allocaAttrBuilder context builds <- mapM encodeM as void (forM builds ($ ab) :: EncodeAST [()]) - Context context <- gets encodeStateContext anyContToM (bracket (FFI.getAttributeSet context ab) FFI.disposeAttributeSet) @@ -300,17 +305,17 @@ data PreSlot instance {-# OVERLAPPING #-} EncodeM EncodeAST [Either A.FA.GroupID A.FA.FunctionAttribute] FFI.FunctionAttributeSet where encodeM attrs = do - ab <- allocaAttrBuilder + Context context <- gets encodeStateContext + ab <- allocaAttrBuilder context forM_ attrs $ \attr -> case attr of Left groupId -> do attrSet <- referAttributeGroup groupId - ab' <- anyContToM (bracket (FFI.attrBuilderFromSet attrSet) FFI.disposeAttrBuilder) + ab' <- anyContToM (bracket (FFI.attrBuilderFromSet context attrSet) FFI.disposeAttrBuilder) liftIO (FFI.mergeAttrBuilder ab ab') Right attr -> do addAttr <- encodeM attr addAttr ab :: EncodeAST () - Context context <- gets encodeStateContext anyContToM (bracket (FFI.getAttributeSet context ab) FFI.disposeAttributeSet) diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index 956dde8d..1e491dc3 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -11,6 +11,7 @@ macro(Builtin,F,F,T) \ macro(Cold,F,F,T) \ macro(Convergent,F,F,T) \ + macro(DisableSanitizerInstrumentation,F,F,T) \ macro(Hot,F,F,T) \ macro(ImmArg,T,F,F) \ macro(InReg,T,T,F) \ @@ -36,9 +37,10 @@ macro(NoRecurse,F,F,T) \ macro(NoRedZone,F,F,T) \ macro(NoReturn,F,F,T) \ + macro(NoSanitizeBounds,F,F,T) \ macro(NoSanitizeCoverage,F,F,T) \ macro(NoSync,F,F,T) \ - macro(NoUndef,F,F,T) \ + macro(NoUndef,T,F,T) \ macro(NoUnwind,F,F,T) \ macro(NonLazyBind,F,F,T) \ macro(NonNull,T,T,F) \ @@ -67,7 +69,6 @@ macro(SwiftAsync,T,F,F) \ macro(SwiftError,T,F,F) \ macro(SwiftSelf,T,F,F) \ - macro(UWTable,F,F,T) \ macro(WillReturn,F,F,T) \ macro(WriteOnly,T,F,T) \ macro(ZExt,T,T,F) \ @@ -82,6 +83,7 @@ macro(Dereferenceable,T,T,F) \ macro(DereferenceableOrNull,T,T,F) \ macro(StackAlignment,F,F,T) \ + macro(UWTable,F,F,T) \ macro(VScaleRange,F,F,T) \ macro(EndAttrKinds,F,F,F) diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs b/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs index ac65715a..2be57e88 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.hs @@ -79,6 +79,9 @@ foreign import ccall unsafe "LLVM_Hs_AttributeValueAsString" attributeValueAsStr foreign import ccall unsafe "LLVM_Hs_AttributeValueAsInt" attributeValueAsInt :: Attribute a -> IO Word64 +foreign import ccall unsafe "LLVM_Hs_AttributeEnsureUWTableKindDefault" attributeEnsureUWTableKindDefault :: + Attribute a -> IO () + foreign import ccall unsafe "LLVM_Hs_AttributeValueAsType" attributeValueAsType :: Attribute a -> IO (Ptr Type) @@ -117,7 +120,7 @@ foreign import ccall unsafe "LLVM_Hs_GetAttrBuilderSize" getAttrBuilderSize :: CSize foreign import ccall unsafe "LLVM_Hs_AttrBuilderFromAttrSet" attrBuilderFromSet :: - AttributeSet a -> IO (Ptr (AttrBuilder a)) + Ptr Context -> AttributeSet a -> IO (Ptr (AttrBuilder a)) foreign import ccall unsafe "LLVM_Hs_DisposeAttrBuilder" disposeAttrBuilder :: Ptr (AttrBuilder a) -> IO () @@ -126,7 +129,7 @@ foreign import ccall unsafe "LLVM_Hs_AttrBuilderMerge" mergeAttrBuilder :: Ptr (AttrBuilder a) -> Ptr (AttrBuilder a) -> IO () foreign import ccall unsafe "LLVM_Hs_ConstructAttrBuilder" constructAttrBuilder :: - Ptr Word8 -> IO (Ptr (AttrBuilder a)) + Ptr Context -> Ptr Word8 -> IO (Ptr (AttrBuilder a)) foreign import ccall unsafe "LLVM_Hs_DestroyAttrBuilder" destroyAttrBuilder :: Ptr (AttrBuilder a) -> IO () @@ -149,6 +152,9 @@ foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddAlignment" attrBuilderAddAlig foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddStackAlignment" attrBuilderAddStackAlignment :: Ptr FunctionAttrBuilder -> Word64 -> IO () +foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddUWTable" attrBuilderAddUWTable :: + Ptr FunctionAttrBuilder -> IO () + -- The CInt is 0 if the last value is null and 1 otherwise foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddAllocSize" attrBuilderAddAllocSize' :: Ptr FunctionAttrBuilder -> CUInt -> CUInt -> LLVMBool -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp index cfe73f11..f5566bce 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp @@ -30,6 +30,10 @@ uint64_t LLVM_Hs_AttributeValueAsInt(LLVMAttributeRef a) { return unwrap(a).getValueAsInt(); } +void LLVM_Hs_AttributeEnsureUWTableKindDefault(LLVMAttributeRef a) { + assert(unwrap(a).getUWTableKind() == UWTableKind::Default); +} + LLVMTypeRef LLVM_Hs_AttributeValueAsType(LLVMAttributeRef a) { return wrap(unwrap(a).getValueAsType()); } @@ -104,12 +108,12 @@ void LLVM_Hs_getAttributes(LLVMAttributeSetRef attributeSet, size_t LLVM_Hs_GetAttrBuilderSize() { return sizeof(AttrBuilder); } -AttrBuilder *LLVM_Hs_ConstructAttrBuilder(char *p) { - return new (p) AttrBuilder(); +AttrBuilder *LLVM_Hs_ConstructAttrBuilder(LLVMContextRef context, char *p) { + return new (p) AttrBuilder(*unwrap(context)); } -AttrBuilder *LLVM_Hs_AttrBuilderFromAttrSet(LLVMAttributeSetRef as) { - return new AttrBuilder(*as); +AttrBuilder *LLVM_Hs_AttrBuilderFromAttrSet(LLVMContextRef context, LLVMAttributeSetRef as) { + return new AttrBuilder(*unwrap(context), *as); } void LLVM_Hs_DisposeAttrBuilder(AttrBuilder *as) { delete as; } @@ -142,6 +146,10 @@ void LLVM_Hs_AttrBuilderAddStackAlignment(AttrBuilder &ab, uint64_t v) { ab.addStackAlignmentAttr(MaybeAlign(v)); } +void LLVM_Hs_AttrBuilderAddUWTable(AttrBuilder &ab) { + ab.addUWTableAttr(UWTableKind::Default); +} + void LLVM_Hs_AttrBuilderAddAllocSize(AttrBuilder &ab, unsigned x, unsigned y, LLVMBool optionalIsThere) { if (optionalIsThere) { @@ -173,7 +181,8 @@ LLVMBool LLVM_Hs_AttributeGetAllocSizeArgs(LLVMAttributeRef a, unsigned *x, } void LLVM_Hs_AttributeGetVScaleRangeArgs(LLVMAttributeRef a, unsigned *min, unsigned *max) { - std::tie(*min, *max) = unwrap(a).getVScaleRangeArgs(); + *min = unwrap(a).getVScaleRangeMin(); + *max = unwrap(a).getVScaleRangeMax().getValueOr(0); } void LLVM_Hs_AttrBuilderAddVScaleRange(AttrBuilder &ab, unsigned min, unsigned max) { diff --git a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp index dd29d55f..3f6bcefc 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp @@ -48,8 +48,9 @@ LLVM_HS_FOR_EACH_FAST_MATH_FLAG(ENUM_CASE) return r; } +// TODO: Pass in pointee types when building GEPs and remove this. static llvm::Type* getPointeeType(LLVMValueRef ptr) { - return llvm::cast(unwrap(ptr)->getType())->getElementType(); + return unwrap(ptr)->getType()->getPointerElementType(); } } diff --git a/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp b/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp index 6dbdc43a..10473d5c 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp @@ -3,6 +3,7 @@ #include #include "llvm/Support/FormattedStream.h" +#include "llvm/BinaryFormat/Dwarf.h" #include "llvm/Config/llvm-config.h" #include "llvm/IR/LLVMContext.h" #include "llvm/IR/Metadata.h" @@ -634,7 +635,7 @@ DILocalVariable* LLVM_Hs_Get_DILocalVariable(LLVMContextRef ctx, DINode::DIFlags flags, uint32_t alignInBits) { LLVMContext &c = *unwrap(ctx); return DILocalVariable::get(c, static_cast(scope), name, file, line, type, - arg, flags, alignInBits); + arg, flags, alignInBits, nullptr); } uint16_t LLVM_Hs_DILocalVariable_GetArg(DILocalVariable* v) { @@ -659,7 +660,7 @@ DIGlobalVariable* LLVM_Hs_Get_DIGlobalVariable(LLVMContextRef ctx, file, line, type, isLocalToUnit, isDefinition, declaration, templateParams, - alignInBits); + alignInBits, nullptr); } LLVMBool LLVM_Hs_DIGlobalVariable_GetLocal(DIGlobalVariable* v) { diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp index 8c7f9406..7ad2eb3f 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp @@ -52,8 +52,7 @@ extern "C" { // ExecutionSession ExecutionSession *LLVM_Hs_createExecutionSession() { - // TODO: llvm-hs does not yet expose LLVM 13's executor process control API - return new ExecutionSession(std::make_unique()); + return new ExecutionSession(std::move(*SelfExecutorProcessControl::Create())); } void LLVM_Hs_disposeExecutionSession(ExecutionSession *es) { diff --git a/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp b/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp index 7bc7e39b..51d2c186 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp @@ -12,9 +12,9 @@ #include "llvm/IR/DataLayout.h" #include "llvm/IR/LegacyPassManager.h" #include "llvm/IR/Module.h" +#include "llvm/MC/TargetRegistry.h" #include "llvm/Support/FormattedStream.h" #include "llvm/Support/Host.h" -#include "llvm/Support/TargetRegistry.h" #include "llvm/Support/TargetSelect.h" #include "llvm/Target/CodeGenCWrappers.h" #include "llvm/Target/TargetMachine.h" diff --git a/llvm-hs/test/LLVM/Test/Attribute.hs b/llvm-hs/test/LLVM/Test/Attribute.hs index da75ce69..d91d1e6e 100644 --- a/llvm-hs/test/LLVM/Test/Attribute.hs +++ b/llvm-hs/test/LLVM/Test/Attribute.hs @@ -106,10 +106,10 @@ moduleAst = , StackProtect , StackProtectReq , StackProtectStrong - , UWTable , WriteOnly , AllocSize 8 (Just 16) , StackAlignment 8 + , UWTable , StringAttribute "bar" "baz" , StringAttribute "foo" "" , StringAttribute "qux" "" diff --git a/llvm-hs/test/LLVM/Test/Optimization.hs b/llvm-hs/test/LLVM/Test/Optimization.hs index d7b986ab..8d7c437d 100644 --- a/llvm-hs/test/LLVM/Test/Optimization.hs +++ b/llvm-hs/test/LLVM/Test/Optimization.hs @@ -143,7 +143,7 @@ tests = testGroup "Optimization" [ ) ] }, - FunctionAttributes (A.GroupID 0) [A.MustProgress, A.NoFree, A.NoRecurse, A.NoSync, A.NoUnwind, A.ReadNone, A.UWTable, A.WillReturn] + FunctionAttributes (A.GroupID 0) [A.MustProgress, A.NoFree, A.NoRecurse, A.NoSync, A.NoUnwind, A.ReadNone, A.WillReturn, A.UWTable] ], testGroup "individual" [ From 724096a42920a36332b7993be02dc198c4aea15f Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Mon, 7 Mar 2022 16:35:48 +0000 Subject: [PATCH 22/37] Add the AllocAlign attribute to Attribute.h --- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 1 + 1 file changed, 1 insertion(+) diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index 632cbf9e..c469bb1a 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -6,6 +6,7 @@ // parameter attribute, function result attribute or function attribute. #define LLVM_HS_FOR_EACH_ATTRIBUTE_KIND(macro) \ macro(None,F,F,F) \ + macro(AllocAlign,T,F,F) \ macro(AlwaysInline,F,F,T) \ macro(ArgMemOnly,F,F,T) \ macro(Builtin,F,F,T) \ From 024ecb7e8205e52edd0574a7a0a2c27b5234911e Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Tue, 19 Apr 2022 09:18:25 +0000 Subject: [PATCH 23/37] Remove legacy bindings for instrumentation passes They're being removed from LLVM as this is written and will soon break our build. --- llvm-hs/src/LLVM/Internal/FFI/PassManager.hs | 1 - .../src/LLVM/Internal/FFI/PassManagerC.cpp | 47 ---------------- llvm-hs/src/LLVM/Internal/PassManager.hs | 9 +-- llvm-hs/src/LLVM/Transforms.hs | 56 ------------------- llvm-hs/test/LLVM/Test/Instrumentation.hs | 13 +++-- 5 files changed, 9 insertions(+), 117 deletions(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/PassManager.hs b/llvm-hs/src/LLVM/Internal/FFI/PassManager.hs index 330345f5..0da7acf2 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/PassManager.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/PassManager.hs @@ -61,7 +61,6 @@ $(do passTypeMapping :: TH.Type -> TH.TypeQ passTypeMapping t = case t of TH.ConT h | h == ''Word -> [t| CUInt |] - | h == ''G.GCOVVersion -> [t| CString |] -- some of the LLVM methods for making passes use "-1" as a special value -- handle those here TH.AppT (TH.ConT mby) t' | mby == ''Maybe -> diff --git a/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp b/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp index 827b6302..74fb25b6 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp @@ -115,59 +115,12 @@ void LLVM_Hs_AddSROAPass(LLVMPassManagerRef PM) { unwrap(PM)->add(createSROAPass()); } -void LLVM_Hs_AddGCOVProfilerPass( - LLVMPassManagerRef PM, - LLVMBool emitNotes, - LLVMBool emitData, - const char *version, - LLVMBool noRedZone, - LLVMBool atomic, - const char *filter, - const char *exclude -) { - auto options = GCOVOptions::getDefault(); - options.EmitNotes = emitNotes; - options.EmitData = emitData; - std::copy(version, version+4, options.Version); - options.NoRedZone = noRedZone; - options.Atomic = atomic; - options.Filter = filter; - options.Exclude = exclude; - unwrap(PM)->add(createGCOVProfilerPass(options)); -} - void LLVM_Hs_AddAddressSanitizerFunctionPass( LLVMPassManagerRef PM ) { unwrap(PM)->add(createAddressSanitizerFunctionPass()); } -void LLVM_Hs_AddAddressSanitizerModulePass( - LLVMPassManagerRef PM -) { - unwrap(PM)->add(createModuleAddressSanitizerLegacyPassPass()); -} - -void LLVM_Hs_AddMemorySanitizerPass( - LLVMPassManagerRef PM, - LLVMBool trackOrigins, - LLVMBool recover, - LLVMBool kernel -) { - unwrap(PM)->add(createMemorySanitizerLegacyPassPass( - {trackOrigins, static_cast(recover), static_cast(kernel)})); -} - -void LLVM_Hs_AddThreadSanitizerPass( - LLVMPassManagerRef PM -) { - unwrap(PM)->add(createThreadSanitizerLegacyPassPass()); -} - -void LLVM_Hs_AddBoundsCheckingPass(LLVMPassManagerRef PM) { - unwrap(PM)->add(createBoundsCheckingLegacyPass()); -} - void LLVM_Hs_AddIPSCCPPass(LLVMPassManagerRef PM) { unwrap(PM)->add(createIPSCCPPass()); } diff --git a/llvm-hs/src/LLVM/Internal/PassManager.hs b/llvm-hs/src/LLVM/Internal/PassManager.hs index 528fffd4..f844202e 100644 --- a/llvm-hs/src/LLVM/Internal/PassManager.hs +++ b/llvm-hs/src/LLVM/Internal/PassManager.hs @@ -87,11 +87,6 @@ defaultPassSetSpec = PassSetSpec { targetMachine = Nothing } -instance (Monad m, MonadThrow m, MonadAnyCont IO m) => EncodeM m GCOVVersion CString where - encodeM (GCOVVersion cs) - | ByteString.length cs == 4 = encodeM cs - | otherwise = throwM (EncodeException "GCOVVersion should consist of exactly 4 characters") - createPassManager :: HasCallStack => PassSetSpec -> IO (Ptr FFI.PassManager) createPassManager pss = runAnyContT' return $ do pm <- liftIO $ FFI.createPassManager @@ -101,7 +96,7 @@ createPassManager pss = runAnyContT' return $ do case pss of s@CuratedPassSetSpec {} -> liftIO $ do bracket FFI.passManagerBuilderCreate FFI.passManagerBuilderDispose $ \b -> do - let handleOption g m = forM_ (m s) (g b <=< encodeM) + let handleOption g m = forM_ (m s) (g b <=< encodeM) handleOption FFI.passManagerBuilderSetOptLevel optLevel handleOption FFI.passManagerBuilderSetSizeLevel sizeLevel handleOption FFI.passManagerBuilderSetDisableUnitAtATime (liftM not . unitAtATime) @@ -125,7 +120,7 @@ createPassManager pss = runAnyContT' return $ do TH.RecC n fs -> (n, [ TH.nameBase fn | (fn, _, _) <- fs ]) TH.NormalC n [] -> (n, []) _ -> error "pass descriptor constructors with fields need to be records" - actions = + actions = [ TH.bindS (TH.varP . TH.mkName $ fn) [| encodeM $(TH.dyn fn) |] | fn <- fns ] ++ [ TH.noBindS [| diff --git a/llvm-hs/src/LLVM/Transforms.hs b/llvm-hs/src/LLVM/Transforms.hs index 2fa59a99..89c16414 100644 --- a/llvm-hs/src/LLVM/Transforms.hs +++ b/llvm-hs/src/LLVM/Transforms.hs @@ -83,26 +83,6 @@ data Pass vectorizeOnlyWhenForced :: Bool } | SuperwordLevelParallelismVectorize - - -- here begin the instrumentation passes - | GCOVProfiler { - emitNotes :: Bool, - emitData :: Bool, - version :: GCOVVersion, - noRedZone :: Bool, - atomic :: Bool, - filter :: String, - exclude :: String - } - | AddressSanitizer - | AddressSanitizerModule - | MemorySanitizer { - trackOrigins :: Bool, - recover :: Bool, - kernel :: Bool - } - | ThreadSanitizer - | BoundsChecking deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) -- | Defaults for the 'LoopVectorize' pass @@ -111,39 +91,3 @@ defaultLoopVectorize = LoopVectorize { interleaveOnlyWhenForced = False, vectorizeOnlyWhenForced = False } - --- | See . -newtype GCOVVersion = GCOVVersion ShortByteString - deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) - --- | Defaults for 'GCOVProfiler'. -defaultGCOVProfiler :: Pass -defaultGCOVProfiler = GCOVProfiler { - emitNotes = True, - emitData = True, - version = GCOVVersion "402*", - noRedZone = False, - atomic = True, - LLVM.Transforms.filter = "", - exclude = "" - } - --- | Defaults for 'AddressSanitizer'. -defaultAddressSanitizer :: Pass -defaultAddressSanitizer = AddressSanitizer - --- | Defaults for 'AddressSanitizerModule'. -defaultAddressSanitizerModule :: Pass -defaultAddressSanitizerModule = AddressSanitizerModule - --- | Defaults for 'MemorySanitizer'. -defaultMemorySanitizer :: Pass -defaultMemorySanitizer = MemorySanitizer { - trackOrigins = False, - recover = False, - kernel = False -} - --- | Defaults for 'ThreadSanitizer'. -defaultThreadSanitizer :: Pass -defaultThreadSanitizer = ThreadSanitizer diff --git a/llvm-hs/test/LLVM/Test/Instrumentation.hs b/llvm-hs/test/LLVM/Test/Instrumentation.hs index 67f8c3d4..6ab2ae6f 100644 --- a/llvm-hs/test/LLVM/Test/Instrumentation.hs +++ b/llvm-hs/test/LLVM/Test/Instrumentation.hs @@ -155,12 +155,13 @@ isMemorySanitizerSupported = do instrumentationPasses :: [(TestName, Pass, IO Bool)] instrumentationPasses = [ - ("GCOVProfiler", defaultGCOVProfiler, return True), - ("AddressSanitizer", defaultAddressSanitizer, return True), - ("AddressSanitizerModule", defaultAddressSanitizerModule, return True), - ("ThreadSanitizer", defaultThreadSanitizer, return True), - ("BoundsChecking", BoundsChecking, return True), - ("MemorySanitizer", defaultMemorySanitizer, isMemorySanitizerSupported) + -- TODO: Add back instrumentation passes + --("GCOVProfiler", defaultGCOVProfiler, return True), + --("AddressSanitizer", defaultAddressSanitizer, return True), + --("AddressSanitizerModule", defaultAddressSanitizerModule, return True), + --("ThreadSanitizer", defaultThreadSanitizer, return True), + --("BoundsChecking", BoundsChecking, return True), + --("MemorySanitizer", defaultMemorySanitizer, isMemorySanitizerSupported) ] tests = From b9bf66dcea0768beaec5469e7d1de3e619b80ec9 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Fri, 22 Apr 2022 10:44:38 +0000 Subject: [PATCH 24/37] Remove C bindings to legacy ASAN pass It's being removed as well and those functions are dead at this point. --- llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp b/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp index 74fb25b6..72151066 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp @@ -9,10 +9,6 @@ #include "llvm/Transforms/IPO/PassManagerBuilder.h" #include "llvm/Transforms/Vectorize.h" #include "llvm/Transforms/Instrumentation.h" -#include "llvm/Transforms/Instrumentation/AddressSanitizer.h" -#include "llvm/Transforms/Instrumentation/BoundsChecking.h" -#include "llvm/Transforms/Instrumentation/MemorySanitizer.h" -#include "llvm/Transforms/Instrumentation/ThreadSanitizer.h" #include "llvm/Transforms/Utils.h" #include "llvm/LinkAllPasses.h" #include "llvm/CodeGen/Passes.h" @@ -115,12 +111,6 @@ void LLVM_Hs_AddSROAPass(LLVMPassManagerRef PM) { unwrap(PM)->add(createSROAPass()); } -void LLVM_Hs_AddAddressSanitizerFunctionPass( - LLVMPassManagerRef PM -) { - unwrap(PM)->add(createAddressSanitizerFunctionPass()); -} - void LLVM_Hs_AddIPSCCPPass(LLVMPassManagerRef PM) { unwrap(PM)->add(createIPSCCPPass()); } From 66bdb2317149e9b617e5c610320ccb4e233aa72e Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Fri, 22 Apr 2022 10:57:52 +0000 Subject: [PATCH 25/37] Remove more dead legacy code Or else the build will be broken with latest LLVM --- llvm-hs/src/LLVM/Internal/FFI/PassManager.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/PassManager.hs b/llvm-hs/src/LLVM/Internal/FFI/PassManager.hs index 0da7acf2..f45329e9 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/PassManager.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/PassManager.hs @@ -120,9 +120,6 @@ foreign import ccall unsafe "LLVMPassManagerBuilderPopulateFunctionPassManager" foreign import ccall unsafe "LLVMPassManagerBuilderPopulateModulePassManager" passManagerBuilderPopulateModulePassManager :: Ptr PassManagerBuilder -> Ptr PassManager -> IO () -foreign import ccall unsafe "LLVMPassManagerBuilderPopulateLTOPassManager" passManagerBuilderPopulateLTOPassManager :: - Ptr PassManagerBuilder -> Ptr PassManager -> CUChar -> CUChar -> IO () - foreign import ccall unsafe "LLVM_Hs_PassManagerBuilderSetLibraryInfo" passManagerBuilderSetLibraryInfo :: Ptr PassManagerBuilder -> Ptr TargetLibraryInfo -> IO () From ac69933628d4b30c65215fb2d856ff31bc960ebc Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Fri, 22 Apr 2022 12:36:31 +0000 Subject: [PATCH 26/37] Remove legacy PassManager, add limited support for new PassBuilder LLVM is in the process of removing the legacy PassManager APIs that llvm-hs depends on pretty heavily. To harden against future breakage this commit adds preliminary support for the new PassBuilder-based infrastructure. However, since it is quite different than the previous API, only curated pass specs are supported for now. --- llvm-hs/llvm-hs.cabal | 16 +- llvm-hs/src/LLVM/Internal/FFI/Error.hs | 14 ++ llvm-hs/src/LLVM/Internal/FFI/PassManager.hs | 130 ---------- .../src/LLVM/Internal/FFI/PassManagerC.cpp | 149 ------------ llvm-hs/src/LLVM/Internal/FFI/Passes.hs | 22 ++ llvm-hs/src/LLVM/Internal/FFI/Transforms.hs | 75 ------ llvm-hs/src/LLVM/Internal/PassManager.hs | 148 ------------ llvm-hs/src/LLVM/Internal/Passes.hs | 36 +++ llvm-hs/src/LLVM/PassManager.hs | 14 -- llvm-hs/src/LLVM/Passes.hs | 4 + llvm-hs/src/LLVM/Transforms.hs | 93 ------- llvm-hs/test/LLVM/Test/Instrumentation.hs | 9 +- llvm-hs/test/LLVM/Test/Linking.hs | 2 - llvm-hs/test/LLVM/Test/Optimization.hs | 227 +----------------- llvm-hs/test/LLVM/Test/OrcJIT.hs | 20 +- 15 files changed, 100 insertions(+), 859 deletions(-) create mode 100644 llvm-hs/src/LLVM/Internal/FFI/Error.hs delete mode 100644 llvm-hs/src/LLVM/Internal/FFI/PassManager.hs delete mode 100644 llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp create mode 100644 llvm-hs/src/LLVM/Internal/FFI/Passes.hs delete mode 100644 llvm-hs/src/LLVM/Internal/FFI/Transforms.hs delete mode 100644 llvm-hs/src/LLVM/Internal/PassManager.hs create mode 100644 llvm-hs/src/LLVM/Internal/Passes.hs delete mode 100644 llvm-hs/src/LLVM/PassManager.hs create mode 100644 llvm-hs/src/LLVM/Passes.hs delete mode 100644 llvm-hs/src/LLVM/Transforms.hs diff --git a/llvm-hs/llvm-hs.cabal b/llvm-hs/llvm-hs.cabal index 961dea17..32b1f101 100644 --- a/llvm-hs/llvm-hs.cabal +++ b/llvm-hs/llvm-hs.cabal @@ -167,7 +167,7 @@ library LLVM.Internal.ObjectFile LLVM.Internal.OrcJIT LLVM.Internal.Operand - LLVM.Internal.PassManager + LLVM.Internal.Passes LLVM.Internal.RawOStream LLVM.Internal.RMWOperation LLVM.Internal.String @@ -177,8 +177,8 @@ library LLVM.Internal.Type LLVM.Internal.Value LLVM.Internal.FFI.Analysis - LLVM.Internal.FFI.Attribute LLVM.Internal.FFI.Assembly + LLVM.Internal.FFI.Attribute LLVM.Internal.FFI.BasicBlock LLVM.Internal.FFI.BinaryOperator LLVM.Internal.FFI.Bitcode @@ -190,6 +190,7 @@ library LLVM.Internal.FFI.Context LLVM.Internal.FFI.DataLayout LLVM.Internal.FFI.DynamicLibrary + LLVM.Internal.FFI.Error LLVM.Internal.FFI.ExecutionEngine LLVM.Internal.FFI.Function LLVM.Internal.FFI.GlobalAlias @@ -205,15 +206,14 @@ library LLVM.Internal.FFI.Module LLVM.Internal.FFI.ObjectFile LLVM.Internal.FFI.OrcJIT - LLVM.Internal.FFI.PassManager + LLVM.Internal.FFI.Passes LLVM.Internal.FFI.PtrHierarchy - LLVM.Internal.FFI.RawOStream LLVM.Internal.FFI.RTDyldMemoryManager - LLVM.Internal.FFI.ShortByteString + LLVM.Internal.FFI.RawOStream LLVM.Internal.FFI.SMDiagnostic + LLVM.Internal.FFI.ShortByteString LLVM.Internal.FFI.Target LLVM.Internal.FFI.Threading - LLVM.Internal.FFI.Transforms LLVM.Internal.FFI.Type LLVM.Internal.FFI.User LLVM.Internal.FFI.Value @@ -221,13 +221,12 @@ library LLVM.Linking LLVM.Module LLVM.OrcJIT - LLVM.PassManager + LLVM.Passes LLVM.Relocation LLVM.Target LLVM.Target.LibraryFunction LLVM.Target.Options LLVM.Threading - LLVM.Transforms other-modules: Control.Monad.AnyCont @@ -254,7 +253,6 @@ library src/LLVM/Internal/FFI/ModuleC.cpp src/LLVM/Internal/FFI/OrcJITC.cpp src/LLVM/Internal/FFI/RawOStreamC.cpp - src/LLVM/Internal/FFI/PassManagerC.cpp src/LLVM/Internal/FFI/RTDyldMemoryManager.cpp src/LLVM/Internal/FFI/SMDiagnosticC.cpp src/LLVM/Internal/FFI/TargetC.cpp diff --git a/llvm-hs/src/LLVM/Internal/FFI/Error.hs b/llvm-hs/src/LLVM/Internal/FFI/Error.hs new file mode 100644 index 00000000..ccc2c9e2 --- /dev/null +++ b/llvm-hs/src/LLVM/Internal/FFI/Error.hs @@ -0,0 +1,14 @@ +module LLVM.Internal.FFI.Error where + +import LLVM.Prelude + +import Foreign.Ptr +import Foreign.C.String + +data Error + +foreign import ccall unsafe "LLVMConsumeError" consumeError :: Ptr Error -> IO () + +foreign import ccall unsafe "LLVMGetErrorMessage" getErrorMessage :: Ptr Error -> IO CString + +foreign import ccall unsafe "LLVMDisposeErrorMessage" disposeErrorMessage :: CString -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/PassManager.hs b/llvm-hs/src/LLVM/Internal/FFI/PassManager.hs deleted file mode 100644 index f45329e9..00000000 --- a/llvm-hs/src/LLVM/Internal/FFI/PassManager.hs +++ /dev/null @@ -1,130 +0,0 @@ -{-# LANGUAGE - TemplateHaskell, - ForeignFunctionInterface, - CPP - #-} - -module LLVM.Internal.FFI.PassManager where - -import LLVM.Prelude - -import qualified Language.Haskell.TH as TH - -import Foreign.Ptr -import Foreign.C - -import LLVM.Internal.FFI.LLVMCTypes -import LLVM.Internal.FFI.PtrHierarchy -import LLVM.Internal.FFI.Cleanup -import LLVM.Internal.FFI.Module -import LLVM.Internal.FFI.Target -import LLVM.Internal.FFI.Transforms - -import qualified LLVM.Transforms as G - -data PassManager - -foreign import ccall unsafe "LLVMCreatePassManager" createPassManager :: - IO (Ptr PassManager) - -foreign import ccall unsafe "LLVMDisposePassManager" disposePassManager :: - Ptr PassManager -> IO () - -foreign import ccall unsafe "LLVMRunPassManager" runPassManager :: - Ptr PassManager -> Ptr Module -> IO CUInt - -foreign import ccall unsafe "LLVMCreateFunctionPassManagerForModule" createFunctionPassManagerForModule :: - Ptr Module -> IO (Ptr PassManager) - -foreign import ccall unsafe "LLVMInitializeFunctionPassManager" initializeFunctionPassManager :: - Ptr PassManager -> IO CUInt - -foreign import ccall unsafe "LLVMRunFunctionPassManager" runFunctionPassManager :: - Ptr PassManager -> Ptr Value -> IO CUInt - -foreign import ccall unsafe "LLVMFinalizeFunctionPassManager" finalizeFunctionPassManager :: - Ptr PassManager -> IO CUInt - -foreign import ccall unsafe "LLVMAddAnalysisPasses" addAnalysisPasses :: - Ptr TargetMachine -> Ptr PassManager -> IO () - -foreign import ccall unsafe "LLVMAddTargetLibraryInfo" addTargetLibraryInfoPass' :: - Ptr TargetLibraryInfo -> Ptr PassManager -> IO () - -addTargetLibraryInfoPass :: Ptr PassManager -> Ptr TargetLibraryInfo -> IO () -addTargetLibraryInfoPass = flip addTargetLibraryInfoPass' - -$(do - let declareForeign :: TH.Name -> [TH.Type] -> TH.DecsQ - declareForeign hName extraParams = do - let n = TH.nameBase hName - passTypeMapping :: TH.Type -> TH.TypeQ - passTypeMapping t = case t of - TH.ConT h | h == ''Word -> [t| CUInt |] - -- some of the LLVM methods for making passes use "-1" as a special value - -- handle those here - TH.AppT (TH.ConT mby) t' | mby == ''Maybe -> - case t' of - TH.ConT h | h == ''Bool -> [t| NothingAsMinusOne Bool |] - | h == ''Word -> [t| NothingAsMinusOne Word |] - | h == ''FilePath -> [t| NothingAsEmptyString CString |] - _ -> typeMapping t - _ -> typeMapping t - foreignDecl - (cName n) - ("add" ++ n ++ "Pass") - ([[t| Ptr PassManager |]] - ++ [[t| Ptr TargetMachine |] | needsTargetMachine n] - ++ map passTypeMapping extraParams) - (TH.tupleT 0) -#if __GLASGOW_HASKELL__ < 800 - TH.TyConI (TH.DataD _ _ _ cons _) <- TH.reify ''G.Pass -#else - TH.TyConI (TH.DataD _ _ _ _ cons _) <- TH.reify ''G.Pass -#endif - liftM concat $ forM cons $ \con -> case con of - TH.RecC n l -> declareForeign n [ t | (_,_,t) <- l ] - TH.NormalC n [] -> declareForeign n [] - _ -> error "pass descriptor constructors with fields need to be records" - ) - -data PassManagerBuilder - -foreign import ccall unsafe "LLVMPassManagerBuilderCreate" passManagerBuilderCreate :: - IO (Ptr PassManagerBuilder) - -foreign import ccall unsafe "LLVMPassManagerBuilderDispose" passManagerBuilderDispose :: - Ptr PassManagerBuilder -> IO () - -foreign import ccall unsafe "LLVMPassManagerBuilderSetOptLevel" passManagerBuilderSetOptLevel :: - Ptr PassManagerBuilder -> CUInt -> IO () - -foreign import ccall unsafe "LLVMPassManagerBuilderSetSizeLevel" passManagerBuilderSetSizeLevel :: - Ptr PassManagerBuilder -> CUInt -> IO () - -foreign import ccall unsafe "LLVMPassManagerBuilderSetDisableUnitAtATime" passManagerBuilderSetDisableUnitAtATime :: - Ptr PassManagerBuilder -> LLVMBool -> IO () - -foreign import ccall unsafe "LLVMPassManagerBuilderSetDisableUnrollLoops" passManagerBuilderSetDisableUnrollLoops :: - Ptr PassManagerBuilder -> CUInt -> IO () - -foreign import ccall unsafe "LLVMPassManagerBuilderSetDisableSimplifyLibCalls" passManagerBuilderSetDisableSimplifyLibCalls :: - Ptr PassManagerBuilder -> LLVMBool -> IO () - -foreign import ccall unsafe "LLVMPassManagerBuilderUseInlinerWithThreshold" passManagerBuilderUseInlinerWithThreshold :: - Ptr PassManagerBuilder -> CUInt -> IO () - -foreign import ccall unsafe "LLVMPassManagerBuilderPopulateFunctionPassManager" passManagerBuilderPopulateFunctionPassManager :: - Ptr PassManagerBuilder -> Ptr PassManager -> IO () - -foreign import ccall unsafe "LLVMPassManagerBuilderPopulateModulePassManager" passManagerBuilderPopulateModulePassManager :: - Ptr PassManagerBuilder -> Ptr PassManager -> IO () - -foreign import ccall unsafe "LLVM_Hs_PassManagerBuilderSetLibraryInfo" passManagerBuilderSetLibraryInfo :: - Ptr PassManagerBuilder -> Ptr TargetLibraryInfo -> IO () - -foreign import ccall unsafe "LLVM_Hs_PassManagerBuilderSetLoopVectorize" passManagerBuilderSetLoopVectorize :: - Ptr PassManagerBuilder -> LLVMBool -> IO () - -foreign import ccall unsafe "LLVM_Hs_PassManagerBuilderSetSuperwordLevelParallelismVectorize" passManagerBuilderSetSuperwordLevelParallelismVectorize :: - Ptr PassManagerBuilder -> LLVMBool -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp b/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp deleted file mode 100644 index 72151066..00000000 --- a/llvm-hs/src/LLVM/Internal/FFI/PassManagerC.cpp +++ /dev/null @@ -1,149 +0,0 @@ -#define __STDC_LIMIT_MACROS -#include "llvm/IR/LLVMContext.h" -#include "llvm/IR/DataLayout.h" -#include "llvm/IR/LegacyPassManager.h" -#include "llvm/Transforms/Scalar.h" -#include "llvm/Transforms/Scalar/GVN.h" -#include "llvm/Transforms/IPO.h" -#include "llvm/Transforms/IPO/Internalize.h" -#include "llvm/Transforms/IPO/PassManagerBuilder.h" -#include "llvm/Transforms/Vectorize.h" -#include "llvm/Transforms/Instrumentation.h" -#include "llvm/Transforms/Utils.h" -#include "llvm/LinkAllPasses.h" -#include "llvm/CodeGen/Passes.h" -#include "llvm/CodeGen/TargetLowering.h" -#include "llvm-c/Target.h" -#include "llvm-c/Transforms/PassManagerBuilder.h" -#include "llvm/Analysis/TargetLibraryInfo.h" -#include "llvm/Target/TargetMachine.h" - -#include "llvm-c/Core.h" - -using namespace llvm; - -extern "C" { -typedef struct LLVMOpaqueVectorizationConfig *LLVMVectorizationConfigRef; -typedef struct LLVMOpaqueTargetLowering *LLVMTargetLoweringRef; -typedef struct LLVMOpaqueTargetMachine *LLVMTargetMachineRef; -} - -namespace llvm { -inline TargetLowering *unwrap(LLVMTargetLoweringRef P) { - return reinterpret_cast(P); -} - -inline LLVMTargetLoweringRef wrap(const TargetLowering *P) { - return reinterpret_cast(const_cast(P)); -} - -inline TargetMachine *unwrap(LLVMTargetMachineRef P) { - return reinterpret_cast(P); -} - -inline LLVMTargetMachineRef wrap(const TargetMachine *P) { - return reinterpret_cast(const_cast(P)); -} - -inline TargetLibraryInfoImpl *unwrap(LLVMTargetLibraryInfoRef P) { - return reinterpret_cast(P); -} - -} - -extern "C" { - -#define LLVM_HS_FOR_EACH_PASS_WITHOUT_LLVM_C_BINDING(macro) \ - macro(BreakCriticalEdges) \ - macro(DeadCodeElimination) \ - macro(DemoteRegisterToMemory) \ - macro(LCSSA) \ - macro(LoopInstSimplify) \ - macro(LowerAtomic) \ - macro(LowerSwitch) \ - macro(MergeFunctions) \ - macro(PartialInlining) \ - macro(Sinking) \ - macro(StripDeadDebugInfo) \ - macro(StripDebugDeclare) \ - macro(StripNonDebugSymbols) \ - -#define ENUM_CASE(p) \ -void LLVM_Hs_Add ## p ## Pass(LLVMPassManagerRef PM) { \ - unwrap(PM)->add(create ## p ## Pass()); \ -} -LLVM_HS_FOR_EACH_PASS_WITHOUT_LLVM_C_BINDING(ENUM_CASE) -#undef ENUM_CASE - -void LLVM_Hs_AddCodeGenPreparePass(LLVMPassManagerRef PM) { - unwrap(PM)->add(createCodeGenPreparePass()); -} - -void LLVM_Hs_AddGlobalValueNumberingPass(LLVMPassManagerRef PM, LLVMBool noLoads) { - unwrap(PM)->add(createGVNPass(noLoads)); -} - -void LLVM_Hs_AddInternalizePass(LLVMPassManagerRef PM, unsigned nExports, const char **exports) { - std::vector exportList(nExports); - for (unsigned i = 0; i < nExports; ++i) { - exportList.at(i) = exports[i]; - } - std::function mustPreserveGV = [exportList](const GlobalValue & gv) { - for (const auto& exp : exportList) { - if (gv.getName().equals(exp)) { - return true; - } - } - return false; - }; - unwrap(PM)->add(createInternalizePass(std::move(mustPreserveGV))); -} - -void LLVM_Hs_AddLoopStrengthReducePass(LLVMPassManagerRef PM) { - unwrap(PM)->add(createLoopStrengthReducePass()); -} - -void LLVM_Hs_AddLowerInvokePass(LLVMPassManagerRef PM) { - unwrap(PM)->add(createLowerInvokePass()); -} - -void LLVM_Hs_AddSROAPass(LLVMPassManagerRef PM) { - unwrap(PM)->add(createSROAPass()); -} - -void LLVM_Hs_AddIPSCCPPass(LLVMPassManagerRef PM) { - unwrap(PM)->add(createIPSCCPPass()); -} - -void LLVM_Hs_AddLoopVectorizePass( - LLVMPassManagerRef PM, - LLVMBool interleaveOnlyWhenForced, - LLVMBool vectorizeOnlyWhenForced -) { - unwrap(PM)->add(createLoopVectorizePass(interleaveOnlyWhenForced, vectorizeOnlyWhenForced)); -} - -void LLVM_Hs_PassManagerBuilderSetLibraryInfo( - LLVMPassManagerBuilderRef PMB, - LLVMTargetLibraryInfoRef l -) { - // The PassManager frees the TargetLibraryInfo when done, - // but we also free our ref, so give it a new copy. - unwrap(PMB)->LibraryInfo = new TargetLibraryInfoImpl(*unwrap(l)); -} - -void LLVM_Hs_PassManagerBuilderSetLoopVectorize( - LLVMPassManagerBuilderRef PMB, - LLVMBool runLoopVectorization -) { - unwrap(PMB)->LoopVectorize = runLoopVectorization; -} - -void LLVM_Hs_PassManagerBuilderSetSuperwordLevelParallelismVectorize( - LLVMPassManagerBuilderRef PMB, - LLVMBool runSLPVectorization -) { - unwrap(PMB)->SLPVectorize = runSLPVectorization; -} - -} diff --git a/llvm-hs/src/LLVM/Internal/FFI/Passes.hs b/llvm-hs/src/LLVM/Internal/FFI/Passes.hs new file mode 100644 index 00000000..fa9abbe8 --- /dev/null +++ b/llvm-hs/src/LLVM/Internal/FFI/Passes.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module LLVM.Internal.FFI.Passes where + +import LLVM.Prelude + +import Foreign.Ptr +import Foreign.C.String + +import LLVM.Internal.FFI.Error +import LLVM.Internal.FFI.Module +import LLVM.Internal.FFI.Target + + +data PassBuilderOptions + +foreign import ccall unsafe "LLVMCreatePassBuilderOptions" createPassBuilderOptions :: IO (Ptr PassBuilderOptions) +foreign import ccall unsafe "LLVMDisposePassBuilderOptions" disposePassBuilderOptions :: Ptr PassBuilderOptions -> IO () + +foreign import ccall unsafe "LLVMRunPasses" runPasses + :: Ptr Module -> CString -> Ptr TargetMachine -> Ptr PassBuilderOptions -> IO (Ptr Error) + diff --git a/llvm-hs/src/LLVM/Internal/FFI/Transforms.hs b/llvm-hs/src/LLVM/Internal/FFI/Transforms.hs deleted file mode 100644 index b649eb2f..00000000 --- a/llvm-hs/src/LLVM/Internal/FFI/Transforms.hs +++ /dev/null @@ -1,75 +0,0 @@ --- | Code used with Template Haskell to build the FFI for transform passes. -module LLVM.Internal.FFI.Transforms where - -import LLVM.Prelude - --- | does the constructor for this pass require a TargetMachine object -needsTargetMachine :: String -> Bool -needsTargetMachine "CodeGenPrepare" = True -needsTargetMachine _ = False - --- | Translate a Haskell name (used in the public Haskell interface, typically not abbreviated) --- | for a pass into the (sometimes obscure, sometimes abbreviated) name used in the LLVM C interface. --- | This translation includes, by choice of prefix, whether the C interface implementation is found in --- | the LLVM distribution ("LLVM" prefix) or either not available or broken there and so implemented --- | as part of this Haskell package ("LLVM_Hs_" prefix). -cName :: String -> String -cName n = - let core = case n of - "AddressSanitizer" -> "AddressSanitizerFunction" - "AggressiveDeadCodeElimination" -> "AggressiveDCE" - "AlwaysInline" -> "AlwaysInliner" - "DeadInstructionElimination" -> "DeadInstElimination" - "EarlyCommonSubexpressionElimination" -> "EarlyCSE" - "FunctionAttributes" -> "FunctionAttrs" - "GlobalDeadCodeElimination" -> "GlobalDCE" - "InductionVariableSimplify" -> "IndVarSimplify" - "InternalizeFunctions" -> "Internalize" - "InterproceduralSparseConditionalConstantPropagation" -> "IPSCCP" - "LoopClosedSingleStaticAssignment" -> "LCSSA" - "LoopInvariantCodeMotion" -> "LICM" - "LoopInstructionSimplify" -> "LoopInstSimplify" - "MemcpyOptimization" -> "MemCpyOpt" - "PruneExceptionHandling" -> "PruneEH" - "ScalarReplacementOfAggregates" -> "SROA" - "OldScalarReplacementOfAggregates" -> "ScalarReplAggregates" - "SimplifyControlFlowGraph" -> "CFGSimplification" - "SparseConditionalConstantPropagation" -> "SCCP" - "SuperwordLevelParallelismVectorize" -> "SLPVectorize" - h -> h - patchImpls = [ - "AddressSanitizer", - "AddressSanitizerModule", - "BoundsChecking", - "CodeGenPrepare", - "GlobalValueNumbering", - "InternalizeFunctions", - "BasicBlockVectorize", - "BlockPlacement", - "BreakCriticalEdges", - "DeadCodeElimination", - "DeadInstructionElimination", - "DemoteRegisterToMemory", - "EdgeProfiler", - "GCOVProfiler", - "LoopClosedSingleStaticAssignment", - "LoopInstructionSimplify", - "LoopStrengthReduce", - "LoopVectorize", - "LowerAtomic", - "LowerInvoke", - "LowerSwitch", - "MemorySanitizer", - "MergeFunctions", - "OptimalEdgeProfiler", - "PathProfiler", - "PartialInlining", - "ScalarReplacementOfAggregates", - "Sinking", - "StripDeadDebugInfo", - "StripDebugDeclare", - "StripNonDebugSymbols", - "ThreadSanitizer" - ] - in - (if (n `elem` patchImpls) then "LLVM_Hs_" else "LLVM") ++ "Add" ++ core ++ "Pass" diff --git a/llvm-hs/src/LLVM/Internal/PassManager.hs b/llvm-hs/src/LLVM/Internal/PassManager.hs deleted file mode 100644 index f844202e..00000000 --- a/llvm-hs/src/LLVM/Internal/PassManager.hs +++ /dev/null @@ -1,148 +0,0 @@ -{-# LANGUAGE - TemplateHaskell, - MultiParamTypeClasses, - CPP - #-} -module LLVM.Internal.PassManager where - -import LLVM.Prelude - -import qualified Language.Haskell.TH as TH - -import Control.Monad.AnyCont -import Control.Monad.Catch -import Control.Monad.IO.Class - -import qualified Data.ByteString.Short as ByteString - -import Foreign.C (CString) -import Foreign.Ptr -import GHC.Stack - -import qualified LLVM.Internal.FFI.PassManager as FFI -import qualified LLVM.Internal.FFI.Transforms as FFI - -import LLVM.Exception -import LLVM.Internal.Module -import LLVM.Internal.Target -import LLVM.Internal.Coding -import LLVM.Transforms - -import LLVM.AST.DataLayout - --- | --- Note: a PassManager does substantive behind-the-scenes work, arranging for the --- results of various analyses to be available as needed by transform passes, shared --- as possible. -newtype PassManager = PassManager (Ptr FFI.PassManager) - --- | There are different ways to get a 'PassManager'. This type embodies them. -data PassSetSpec - -- | a 'PassSetSpec' is a lower-level, detailed specification of a set of passes. It - -- allows fine-grained control of what passes are to be run when, and the specification - -- of passes not available through 'CuratedPassSetSpec'. - = PassSetSpec { - transforms :: [Pass], - dataLayout :: Maybe DataLayout, - targetLibraryInfo :: Maybe TargetLibraryInfo, - targetMachine :: Maybe TargetMachine - } - -- | This type is a high-level specification of a set of passes. It uses the same - -- collection of passes chosen by the LLVM team in the command line tool 'opt'. The fields - -- of this spec are much like typical compiler command-line flags - e.g. -O\, etc. - | CuratedPassSetSpec { - optLevel :: Maybe Word, - sizeLevel :: Maybe Word, - unitAtATime :: Maybe Bool, - simplifyLibCalls :: Maybe Bool, - loopVectorize :: Maybe Bool, - superwordLevelParallelismVectorize :: Maybe Bool, - useInlinerWithThreshold :: Maybe Word, - dataLayout :: Maybe DataLayout, - targetLibraryInfo :: Maybe TargetLibraryInfo, - targetMachine :: Maybe TargetMachine - } - --- | Helper to make a curated 'PassSetSpec' -defaultCuratedPassSetSpec :: PassSetSpec -defaultCuratedPassSetSpec = CuratedPassSetSpec { - optLevel = Nothing, - sizeLevel = Nothing, - unitAtATime = Nothing, - simplifyLibCalls = Nothing, - loopVectorize = Nothing, - superwordLevelParallelismVectorize = Nothing, - useInlinerWithThreshold = Nothing, - dataLayout = Nothing, - targetLibraryInfo = Nothing, - targetMachine = Nothing -} - --- | an empty 'PassSetSpec' -defaultPassSetSpec :: PassSetSpec -defaultPassSetSpec = PassSetSpec { - transforms = [], - dataLayout = Nothing, - targetLibraryInfo = Nothing, - targetMachine = Nothing -} - -createPassManager :: HasCallStack => PassSetSpec -> IO (Ptr FFI.PassManager) -createPassManager pss = runAnyContT' return $ do - pm <- liftIO $ FFI.createPassManager - forM_ (targetLibraryInfo pss) $ \(TargetLibraryInfo tli) -> do - liftIO $ FFI.addTargetLibraryInfoPass pm tli - forM_ (targetMachine pss) $ \(TargetMachine tm) -> liftIO $ FFI.addAnalysisPasses tm pm - case pss of - s@CuratedPassSetSpec {} -> liftIO $ do - bracket FFI.passManagerBuilderCreate FFI.passManagerBuilderDispose $ \b -> do - let handleOption g m = forM_ (m s) (g b <=< encodeM) - handleOption FFI.passManagerBuilderSetOptLevel optLevel - handleOption FFI.passManagerBuilderSetSizeLevel sizeLevel - handleOption FFI.passManagerBuilderSetDisableUnitAtATime (liftM not . unitAtATime) - handleOption FFI.passManagerBuilderSetDisableSimplifyLibCalls (liftM not . simplifyLibCalls) - handleOption FFI.passManagerBuilderUseInlinerWithThreshold useInlinerWithThreshold - handleOption FFI.passManagerBuilderSetLoopVectorize loopVectorize - handleOption FFI.passManagerBuilderSetSuperwordLevelParallelismVectorize superwordLevelParallelismVectorize - FFI.passManagerBuilderPopulateModulePassManager b pm - PassSetSpec ps _ _ tm' -> do - let tm = maybe nullPtr (\(TargetMachine tm) -> tm) tm' - forM_ ps $ \p -> $( - do -#if __GLASGOW_HASKELL__ < 800 - TH.TyConI (TH.DataD _ _ _ cons _) <- TH.reify ''Pass -#else - TH.TyConI (TH.DataD _ _ _ _ cons _) <- TH.reify ''Pass -#endif - TH.caseE [| p |] $ flip map cons $ \con -> do - let - (n, fns) = case con of - TH.RecC n fs -> (n, [ TH.nameBase fn | (fn, _, _) <- fs ]) - TH.NormalC n [] -> (n, []) - _ -> error "pass descriptor constructors with fields need to be records" - actions = - [ TH.bindS (TH.varP . TH.mkName $ fn) [| encodeM $(TH.dyn fn) |] | fn <- fns ] - ++ [ - TH.noBindS [| - liftIO $( - foldl1 TH.appE - (map TH.dyn $ - ["FFI.add" ++ TH.nameBase n ++ "Pass", "pm"] - ++ ["tm" | FFI.needsTargetMachine (TH.nameBase n)] - ++ fns) - ) - |] - ] - TH.match (TH.conP n $ map (TH.varP . TH.mkName) fns) (TH.normalB (TH.doE actions)) [] - ) - return pm - --- | bracket the creation of a 'PassManager' -withPassManager :: PassSetSpec -> (PassManager -> IO a) -> IO a -withPassManager s = bracket (createPassManager s) FFI.disposePassManager . (. PassManager) - --- | run the passes in a 'PassManager' on a 'Module', modifying the 'Module'. -runPassManager :: PassManager -> Module -> IO Bool -runPassManager (PassManager p) m = do - m' <- readModule m - toEnum . fromIntegral <$> FFI.runPassManager p m' diff --git a/llvm-hs/src/LLVM/Internal/Passes.hs b/llvm-hs/src/LLVM/Internal/Passes.hs new file mode 100644 index 00000000..3c2da37b --- /dev/null +++ b/llvm-hs/src/LLVM/Internal/Passes.hs @@ -0,0 +1,36 @@ +-- | This module provides an interface to LLVM's passes. +module LLVM.Internal.Passes where + +import LLVM.Prelude + +import Foreign.Ptr +import Foreign.C.String + +import LLVM.Internal.Module +import LLVM.Internal.Target + +import qualified LLVM.Internal.FFI.Error as FFI +import qualified LLVM.Internal.FFI.Passes as FFI + +data PassSetSpec + -- | This type is a high-level specification of a set of passes. It uses the same + -- collection of passes chosen by the LLVM team in the command line tool 'opt'. The fields + -- of this spec are much like typical compiler command-line flags - e.g. -O\, etc. + = CuratedPassSetSpec { + optLevel :: Word, + targetMachine :: Maybe TargetMachine + } + +runPasses :: PassSetSpec -> Module -> IO Bool +runPasses spec m = do + m' <- readModule m + opts <- FFI.createPassBuilderOptions + err <- withCString passStr $ \passCStr -> + FFI.runPasses m' passCStr tm' opts + FFI.disposePassBuilderOptions opts + FFI.consumeError err + return $ err == nullPtr + where + (passStr, tm) = case spec of + CuratedPassSetSpec optLevel tm -> ("default", tm) + tm' = case tm of Nothing -> nullPtr; Just (TargetMachine ptr) -> ptr diff --git a/llvm-hs/src/LLVM/PassManager.hs b/llvm-hs/src/LLVM/PassManager.hs deleted file mode 100644 index cb948acf..00000000 --- a/llvm-hs/src/LLVM/PassManager.hs +++ /dev/null @@ -1,14 +0,0 @@ --- | A 'PassManager' holds collection of passes, to be run on 'Module's. --- Build one with 'withPassManager': --- --- * using 'CuratedPassSetSpec' if you want optimization but not to play with your compiler --- --- * using 'PassSetSpec' if you do want to play with your compiler -module LLVM.PassManager ( - PassManager, - PassSetSpec(..), defaultPassSetSpec, defaultCuratedPassSetSpec, - withPassManager, - runPassManager - ) where - -import LLVM.Internal.PassManager diff --git a/llvm-hs/src/LLVM/Passes.hs b/llvm-hs/src/LLVM/Passes.hs new file mode 100644 index 00000000..a0e1a3c4 --- /dev/null +++ b/llvm-hs/src/LLVM/Passes.hs @@ -0,0 +1,4 @@ +-- | This module provides an interface to LLVM's passes. +module LLVM.Passes (PassSetSpec (..), runPasses) where + +import LLVM.Internal.Passes diff --git a/llvm-hs/src/LLVM/Transforms.hs b/llvm-hs/src/LLVM/Transforms.hs deleted file mode 100644 index 89c16414..00000000 --- a/llvm-hs/src/LLVM/Transforms.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --- | This module provides an enumeration of the various transformation (e.g. optimization) passes --- provided by LLVM. They can be used to create a 'LLVM.PassManager.PassManager' to, in turn, --- run the passes on 'LLVM.Module.Module's. If you don't know what passes you want, consider --- instead using 'LLVM.PassManager.CuratedPassSetSpec'. -module LLVM.Transforms where - -import LLVM.Prelude - --- | --- A few passes can make use of information in a 'LLVM.Target.TargetMachine' if one --- is provided to 'LLVM.PassManager.createPassManager'. --- -data Pass - -- here begin the Scalar passes - = AggressiveDeadCodeElimination - | BreakCriticalEdges - -- | can use a 'LLVM.Target.TargetMachine' - | CodeGenPrepare - | CorrelatedValuePropagation - | DeadCodeElimination - | DeadStoreElimination - | DemoteRegisterToMemory - | EarlyCommonSubexpressionElimination - | GlobalValueNumbering { noLoads :: Bool } - | InductionVariableSimplify - | InstructionCombining - -- | Instruction simplification includes constant folding - | InstructionSimplify - | JumpThreading - | LoopClosedSingleStaticAssignment - | LoopInvariantCodeMotion - | LoopDeletion - | LoopIdiom - | LoopInstructionSimplify - | LoopRotate - | LoopStrengthReduce - | LoopUnroll { loopUnrollThreshold :: Maybe Word, count :: Maybe Word, allowPartial :: Maybe Bool } - | LoopUnswitch { optimizeForSize :: Bool } - | LowerAtomic - | LowerInvoke - | LowerSwitch - | LowerExpectIntrinsic - | MemcpyOptimization - | PromoteMemoryToRegister - | Reassociate - | ScalarReplacementOfAggregates { requiresDominatorTree :: Bool } - | OldScalarReplacementOfAggregates { - oldScalarReplacementOfAggregatesThreshold :: Maybe Word, - useDominatorTree :: Bool, - structMemberThreshold :: Maybe Word, - arrayElementThreshold :: Maybe Word, - scalarLoadThreshold :: Maybe Word - } - | SparseConditionalConstantPropagation - | SimplifyLibCalls - | SimplifyControlFlowGraph - | Sinking - | TailCallElimination - - -- here begin the Interprocedural passes - | AlwaysInline { insertLifetime :: Bool } - | ArgumentPromotion - | ConstantMerge - | FunctionAttributes - | FunctionInlining { - functionInliningThreshold :: Word - } - | GlobalDeadCodeElimination - | InternalizeFunctions { exportList :: [String] } - | InterproceduralSparseConditionalConstantPropagation - | MergeFunctions - | PartialInlining - | PruneExceptionHandling - | StripDeadDebugInfo - | StripDebugDeclare - | StripNonDebugSymbols - | StripSymbols { onlyDebugInfo :: Bool } - - -- here begin the vectorization passes - | LoopVectorize { - interleaveOnlyWhenForced :: Bool, - vectorizeOnlyWhenForced :: Bool - } - | SuperwordLevelParallelismVectorize - deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) - --- | Defaults for the 'LoopVectorize' pass -defaultLoopVectorize :: Pass -defaultLoopVectorize = LoopVectorize { - interleaveOnlyWhenForced = False, - vectorizeOnlyWhenForced = False - } diff --git a/llvm-hs/test/LLVM/Test/Instrumentation.hs b/llvm-hs/test/LLVM/Test/Instrumentation.hs index 6ab2ae6f..6d384e27 100644 --- a/llvm-hs/test/LLVM/Test/Instrumentation.hs +++ b/llvm-hs/test/LLVM/Test/Instrumentation.hs @@ -17,8 +17,7 @@ import qualified Data.Map as Map import LLVM.Module import LLVM.Context -import LLVM.PassManager -import LLVM.Transforms +import LLVM.Passes import LLVM.Target import LLVM.AST as A @@ -37,7 +36,7 @@ import qualified LLVM.AST.Constant as C instrument :: PassSetSpec -> A.Module -> IO A.Module instrument s m = withContext $ \context -> withModuleFromAST context m $ \mIn' -> do - withPassManager s $ \pm -> runPassManager pm mIn' + runPasses s mIn' moduleAST mIn' ast = do @@ -153,7 +152,7 @@ isMemorySanitizerSupported = do let os' = os triple' return $ Set.member os' (Set.fromList [FreeBSD, NetBSD, Linux]) -instrumentationPasses :: [(TestName, Pass, IO Bool)] +instrumentationPasses :: [(TestName, PassSetSpec, IO Bool)] instrumentationPasses = [ -- TODO: Add back instrumentation passes --("GCOVProfiler", defaultGCOVProfiler, return True), @@ -176,7 +175,7 @@ tests = withTargetLibraryInfo triple $ \tli -> do dl <- withHostTargetMachineDefault getTargetMachineDataLayout ast <- ast - ast' <- instrument (defaultPassSetSpec { transforms = [p], dataLayout = Just dl, targetLibraryInfo = Just tli }) ast + ast' <- instrument p ast let names ast = [ n | GlobalDefinition d <- moduleDefinitions ast, Name n <- return (G.name d) ] names ast' `List.intersect` names ast @?= names ast | diff --git a/llvm-hs/test/LLVM/Test/Linking.hs b/llvm-hs/test/LLVM/Test/Linking.hs index d3c23ecc..34a323f1 100644 --- a/llvm-hs/test/LLVM/Test/Linking.hs +++ b/llvm-hs/test/LLVM/Test/Linking.hs @@ -13,8 +13,6 @@ import qualified Data.Map as Map import LLVM.Module import LLVM.Context -import LLVM.PassManager -import LLVM.Transforms import LLVM.Target import LLVM.AST as A diff --git a/llvm-hs/test/LLVM/Test/Optimization.hs b/llvm-hs/test/LLVM/Test/Optimization.hs index 8d7c437d..67ec82a4 100644 --- a/llvm-hs/test/LLVM/Test/Optimization.hs +++ b/llvm-hs/test/LLVM/Test/Optimization.hs @@ -14,8 +14,7 @@ import qualified Data.Map as Map import LLVM.Module import LLVM.Context -import LLVM.PassManager -import qualified LLVM.Transforms as T +import LLVM.Passes import LLVM.Target import LLVM.AST as A @@ -99,36 +98,14 @@ handAST = FunctionAttributes (A.GroupID 0) [A.NoUnwind, A.ReadNone, A.UWTable] ] -pattern LLVMLoopIsVectorizedMetadata :: Integer -> Definition -pattern LLVMLoopIsVectorizedMetadata i <- MetadataNodeDefinition _ (MDTuple [ - Just (MDString "llvm.loop.isvectorized"), - Just (MDValue (ConstantOperand C.Int {C.integerBits = 32, C.integerValue = i})) - ]) - -isVectorized :: A.Module -> Assertion -isVectorized mod@Module { moduleDefinitions = defs } = do - let assertHasVectorTypedValues = - (@? "Module contains no vector-typed phi instructions") $ - not $ null [ i - | GlobalDefinition Function { G.basicBlocks = b } <- defs, - BasicBlock _ is _ <- b, - _ := i@Phi { type' = VectorType _ _ } <- is - ] - let assertHasVectorizedMetadata = - (@? "Module is missing 'llvm.loop.isvectorized' metadata") $ - not $ null [ 1 - | LLVMLoopIsVectorizedMetadata 1 <- defs - ] - assertHasVectorTypedValues <> assertHasVectorizedMetadata - optimize :: PassSetSpec -> A.Module -> IO A.Module optimize pss m = withContext $ \context -> withModuleFromAST context m $ \mIn' -> do - withPassManager pss $ \pm -> runPassManager pm mIn' + runPasses pss mIn' moduleAST mIn' tests = testGroup "Optimization" [ testCase "curated" $ do - mOut <- optimize defaultCuratedPassSetSpec handAST + mOut <- optimize (CuratedPassSetSpec 2 Nothing) handAST mOut @?= Module "" "" Nothing Nothing [ GlobalDefinition $ functionDefaults { @@ -144,201 +121,5 @@ tests = testGroup "Optimization" [ ] }, FunctionAttributes (A.GroupID 0) [A.MustProgress, A.NoFree, A.NoRecurse, A.NoSync, A.NoUnwind, A.ReadNone, A.WillReturn, A.UWTable] - ], - - testGroup "individual" [ - testCase "InstSimplify" $ do - let - mIn = Module "" "" Nothing Nothing [ - GlobalDefinition $ functionDefaults { - G.returnType = i32, - G.name = Name "foo", - G.parameters = ([Parameter i32 (Name "x") []], False), - G.functionAttributes = [Left (A.GroupID 0)], - G.basicBlocks = [ - BasicBlock (UnName 0) [] (Do $ Br (Name "here") []), - BasicBlock (Name "here") [] ( - Do $ CondBr { - condition = ConstantOperand (C.Int 1 1), - trueDest = Name "take", - falseDest = Name "done", - metadata' = [] - } - ), - BasicBlock (Name "take") [] ( - Do $ Br (Name "done") [] - ), - BasicBlock (Name "done") [ - Name "r" := Phi { - type' = i32, - incomingValues = [(ConstantOperand (C.Int 32 0), Name "take"), (ConstantOperand (C.Int 32 57), Name "here")], - metadata = [] - } - ] ( - Do $ Ret (Just (LocalReference i32 (Name "r"))) [] - ) - ] - }, - FunctionAttributes (A.GroupID 0) [A.NoUnwind, A.ReadNone, A.UWTable] - ] - mOut <- optimize defaultPassSetSpec { transforms = [T.InstructionSimplify] } handAST - mOut @?= mIn, - - testCase "SLPVectorization" $ do - let - fadd op0 op1 = - FAdd { fastMathFlags = noFastMathFlags, operand0 = op0, operand1 = op1, metadata = [] } - doubleVec = VectorType 2 double - constInt i = ConstantOperand (C.Int {C.integerBits = 32, C.integerValue = i}) - undef = ConstantOperand (C.Undef doubleVec) - extractElement vec index' = - ExtractElement { vector = vec, index = index', metadata = [] } - insertElement vec el i = - InsertElement { vector = vec, element = el, index = i, metadata = [] } - mIn = Module "" "" Nothing Nothing [ - GlobalDefinition $ functionDefaults { - G.returnType = doubleVec, - G.name = Name "buildVector_add_2f64", - G.parameters = ([ - Parameter doubleVec n [] - | n <- [ "a", "b" ] - ], False), - G.basicBlocks = [ - BasicBlock (UnName 0) - ["a0" := extractElement (LocalReference doubleVec "a") (constInt 0), - "a1" := extractElement (LocalReference doubleVec "a") (constInt 1), - "b0" := extractElement (LocalReference doubleVec "b") (constInt 0), - "b1" := extractElement (LocalReference doubleVec "b") (constInt 1), - "c0" := fadd (LocalReference double "a0") (LocalReference double "b0"), - "c1" := fadd (LocalReference double "a1") (LocalReference double "b1"), - "r0" := insertElement undef (LocalReference double "c0") (constInt 0), - "r1" := insertElement (LocalReference doubleVec "r0") (LocalReference double "c1") (constInt 1) - ] - (Do (Ret (Just (LocalReference doubleVec "r1")) [])) - ] - } - ] - mOut <- optimize (defaultPassSetSpec { - transforms = [ - T.SuperwordLevelParallelismVectorize, - T.InstructionCombining, - T.GlobalValueNumbering False - ] }) mIn - mOut @?= - Module "" "" Nothing Nothing [ - GlobalDefinition $ functionDefaults { - G.returnType = doubleVec, - G.name = Name "buildVector_add_2f64", - G.parameters = ([ - Parameter doubleVec n [] - | n <- [ "a", "b" ] - ], False), - G.basicBlocks = [ - BasicBlock (UnName 0) - [UnName 1 := fadd (LocalReference doubleVec "a") (LocalReference doubleVec "b")] - (Do (Ret (Just (LocalReference doubleVec (UnName 1))) [])) - ] - } - ], - - testCase "LoopVectorize" $ do - let - mIn = - Module { - moduleName = "", - moduleSourceFileName = "", - moduleDataLayout = Just $ (defaultDataLayout BigEndian) { - typeLayouts = Map.singleton (VectorAlign, 128) (AlignmentInfo 128 128) - }, - moduleTargetTriple = Just "x86_64", - moduleDefinitions = [ - GlobalDefinition $ globalVariableDefaults { - G.name = Name "a", - G.linkage = L.Common, - G.type' = A.T.ArrayType 2048 i32, - G.initializer = Just (C.AggregateZero (A.T.ArrayType 2048 i32)) - }, - GlobalDefinition $ functionDefaults { - G.returnType = A.T.void, - G.name = Name "inc", - G.functionAttributes = [Left (A.GroupID 0)], - G.parameters = ([Parameter i32 (Name "n") []], False), - G.basicBlocks = [ - BasicBlock (UnName 0) [ - UnName 1 := ICmp IPred.SGT (LocalReference i32 (Name "n")) (ConstantOperand (C.Int 32 0)) [] - ] (Do $ CondBr (LocalReference i1 (UnName 1)) (Name ".lr.ph") (Name "._crit_edge") []), - BasicBlock (Name ".lr.ph") [ - Name "indvars.iv" := Phi i64 [ - (ConstantOperand (C.Int 64 0), UnName 0), - (LocalReference i64 (Name "indvars.iv.next"), Name ".lr.ph") - ] [], - UnName 2 := GetElementPtr True (ConstantOperand (C.GlobalReference (PointerType (A.T.ArrayType 2048 i32) (AddrSpace 0)) (Name "a"))) [ - ConstantOperand (C.Int 64 0), - LocalReference i64 (Name "indvars.iv") - ] [], - UnName 3 := Load False (LocalReference (ptr i32) (UnName 2)) Nothing 4 [], - UnName 4 := Trunc (LocalReference i64 (Name "indvars.iv")) i32 [], - UnName 5 := Add True False (LocalReference i32 (UnName 3)) (LocalReference i32 (UnName 4)) [], - Do $ Store False (LocalReference (ptr i32) (UnName 2)) (LocalReference i32 (UnName 5)) Nothing 4 [], - Name "indvars.iv.next" := Add False False (LocalReference i64 (Name "indvars.iv")) (ConstantOperand (C.Int 64 1)) [], - Name "lftr.wideiv" := Trunc (LocalReference i64 (Name "indvars.iv.next")) i32 [], - Name "exitcond" := ICmp IPred.EQ (LocalReference i32 (Name "lftr.wideiv")) (LocalReference i32 (Name "n")) [] - ] (Do $ CondBr (LocalReference i1 (Name "exitcond")) (Name "._crit_edge") (Name ".lr.ph") []), - BasicBlock (Name "._crit_edge") [ - ] (Do $ Ret Nothing []) - ] - }, - FunctionAttributes (A.GroupID 0) [A.NoUnwind, A.ReadNone, A.UWTable, A.StackProtect] - ] - } - mOut <- do - initializeAllTargets - let triple = "x86_64" - (target, _) <- lookupTarget Nothing triple - withTargetOptions $ \targetOptions -> do - withTargetMachine target triple "" Map.empty targetOptions R.Default CM.Default CGO.Default $ \tm -> do - optimize (defaultPassSetSpec { - transforms = [ T.defaultLoopVectorize ], - dataLayout = moduleDataLayout mIn, - targetMachine = Just tm - }) mIn - isVectorized mOut, - - testCase "LowerInvoke" $ do - -- This test doesn't test much about what LowerInvoke does, just that it seems to work. - -- The pass seems to be quite deeply dependent on weakly documented presumptions about - -- how unwinding works (as is the invoke instruction) - withContext $ \context -> do - withPassManager (defaultPassSetSpec { transforms = [T.LowerInvoke] }) $ \passManager -> do - let astIn = - Module "" "" Nothing Nothing [ - GlobalDefinition $ functionDefaults { - G.returnType = i32, - G.name = Name "foo", - G.parameters = ([Parameter i32 (Name "x") []], False), - G.basicBlocks = [ - BasicBlock (Name "here") [ - ] ( - Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [] - ) - ] - } - ] - astOut <- withModuleFromAST context astIn $ \mIn -> do - runPassManager passManager mIn - moduleAST mIn - astOut @?= Module "" "" Nothing Nothing [ - GlobalDefinition $ functionDefaults { - G.returnType = i32, - G.name = Name "foo", - G.parameters = ([Parameter i32 (Name "x") []], False), - G.basicBlocks = [ - BasicBlock (Name "here") [ - ] ( - Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [] - ) - ] - } - ] - ] + ] ] diff --git a/llvm-hs/test/LLVM/Test/OrcJIT.hs b/llvm-hs/test/LLVM/Test/OrcJIT.hs index f03d1d4a..356f37b6 100644 --- a/llvm-hs/test/LLVM/Test/OrcJIT.hs +++ b/llvm-hs/test/LLVM/Test/OrcJIT.hs @@ -17,9 +17,8 @@ import System.Process (callProcess) import System.IO.Temp (withSystemTempFile) import System.IO -import LLVM.Internal.PassManager import LLVM.Internal.ObjectFile (withObjectFile) -import LLVM.PassManager +import LLVM.Passes import LLVM.Context import LLVM.Module import qualified LLVM.Internal.FFI.Module as FFI @@ -103,15 +102,14 @@ tests = il <- createIRCompileLayer es ol tm dylib <- createJITDylib es "testDylib" withTest2Module $ \m -> do - withPassManager defaultCuratedPassSetSpec { optLevel = Just 2 } $ \pm -> do - success <- runPassManager pm m - writeIORef passmanagerSuccessful success - withClonedThreadSafeModule m $ \tsm -> do - addModule tsm dylib il - Right (JITSymbol mainFn _) <- lookupSymbol es il dylib "main" - result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) - result @?= 42 - readIORef passmanagerSuccessful @? "passmanager failed" + success <- runPasses (CuratedPassSetSpec 2 Nothing) m + writeIORef passmanagerSuccessful success + withClonedThreadSafeModule m $ \tsm -> do + addModule tsm dylib il + Right (JITSymbol mainFn _) <- lookupSymbol es il dylib "main" + result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) + result @?= 42 + readIORef passmanagerSuccessful @? "passmanager failed" -- TODO: Make it possible to use Haskell functions as definition generators -- and update to OrcJITv2 From 118fa0e99c5e55d0c4c86f264d9ccd9da8d5b976 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Fri, 22 Apr 2022 12:48:52 +0000 Subject: [PATCH 27/37] Skip dynamic library test when gcc is unavailable in PATH --- llvm-hs/llvm-hs.cabal | 1 + llvm-hs/test/LLVM/Test/OrcJIT.hs | 15 ++++++++++----- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/llvm-hs/llvm-hs.cabal b/llvm-hs/llvm-hs.cabal index 32b1f101..ae5150a9 100644 --- a/llvm-hs/llvm-hs.cabal +++ b/llvm-hs/llvm-hs.cabal @@ -276,6 +276,7 @@ test-suite test transformers >= 0.3.0.0, temporary >= 1.2 && < 1.4, pretty-show >= 1.6, + directory >= 1.3 && < 1.4, process, temporary hs-source-dirs: test diff --git a/llvm-hs/test/LLVM/Test/OrcJIT.hs b/llvm-hs/test/LLVM/Test/OrcJIT.hs index 356f37b6..0b61877c 100644 --- a/llvm-hs/test/LLVM/Test/OrcJIT.hs +++ b/llvm-hs/test/LLVM/Test/OrcJIT.hs @@ -15,6 +15,7 @@ import Data.Word import Foreign.Ptr import System.Process (callProcess) import System.IO.Temp (withSystemTempFile) +import System.Directory import System.IO import LLVM.Internal.ObjectFile (withObjectFile) @@ -88,11 +89,15 @@ tests = dylib <- createJITDylib es "testDylib" let inputPath = "./test/main_return_38.c" withSystemTempFile "main.o" $ \outputPath _ -> do - callProcess "gcc" ["-shared", "-fPIC", inputPath, "-o", outputPath] - addDynamicLibrarySearchGenerator il dylib outputPath - Right (JITSymbol mainFn _) <- lookupSymbol es il dylib "main" - result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) - result @?= 38, + findExecutable "gcc" >>= \gccPath -> + case gccPath of + Nothing -> return () -- Tasty.HUnit doesn't seem to support skips? + Just _ -> do + callProcess "gcc" ["-shared", "-fPIC", inputPath, "-o", outputPath] + addDynamicLibrarySearchGenerator il dylib outputPath + Right (JITSymbol mainFn _) <- lookupSymbol es il dylib "main" + result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) + result @?= 38, testCase "run optimization passes on a JIT module" $ do passmanagerSuccessful <- newIORef False From f8b006c22c305bf0a6d61669d6a3490e80bd4bba Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Fri, 29 Apr 2022 16:11:53 +0000 Subject: [PATCH 28/37] Add support for custom pass pipeline We only support a few non-default module passes for now, but it lays down the infrastructure for other passes. --- llvm-hs/llvm-hs.cabal | 1 + llvm-hs/src/LLVM/Internal/FFI/Passes.hs | 31 +++++++++ llvm-hs/src/LLVM/Internal/FFI/PassesC.cpp | 85 +++++++++++++++++++++++ llvm-hs/src/LLVM/Internal/Passes.hs | 51 +++++++++----- llvm-hs/src/LLVM/Passes.hs | 2 +- llvm-hs/test/LLVM/Test/Optimization.hs | 2 +- llvm-hs/test/LLVM/Test/OrcJIT.hs | 5 +- 7 files changed, 153 insertions(+), 24 deletions(-) create mode 100644 llvm-hs/src/LLVM/Internal/FFI/PassesC.cpp diff --git a/llvm-hs/llvm-hs.cabal b/llvm-hs/llvm-hs.cabal index ae5150a9..78a1e6e7 100644 --- a/llvm-hs/llvm-hs.cabal +++ b/llvm-hs/llvm-hs.cabal @@ -252,6 +252,7 @@ library src/LLVM/Internal/FFI/MetadataC.cpp src/LLVM/Internal/FFI/ModuleC.cpp src/LLVM/Internal/FFI/OrcJITC.cpp + src/LLVM/Internal/FFI/PassesC.cpp src/LLVM/Internal/FFI/RawOStreamC.cpp src/LLVM/Internal/FFI/RTDyldMemoryManager.cpp src/LLVM/Internal/FFI/SMDiagnosticC.cpp diff --git a/llvm-hs/src/LLVM/Internal/FFI/Passes.hs b/llvm-hs/src/LLVM/Internal/FFI/Passes.hs index fa9abbe8..6179610a 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Passes.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Passes.hs @@ -5,6 +5,7 @@ module LLVM.Internal.FFI.Passes where import LLVM.Prelude import Foreign.Ptr +import Foreign.C.Types import Foreign.C.String import LLVM.Internal.FFI.Error @@ -20,3 +21,33 @@ foreign import ccall unsafe "LLVMDisposePassBuilderOptions" disposePassBuilderOp foreign import ccall unsafe "LLVMRunPasses" runPasses :: Ptr Module -> CString -> Ptr TargetMachine -> Ptr PassBuilderOptions -> IO (Ptr Error) +data PassBuilderPackage +data ModulePassManager +data ModulePass + +foreign import ccall unsafe "LLVM_Hs_CreatePassBuilderPackage" createPassBuilderPackage + :: Ptr TargetMachine -> IO (Ptr PassBuilderPackage) + +foreign import ccall unsafe "LLVM_Hs_DisposePassBuilderPackage" disposePassBuilderPackage + :: Ptr PassBuilderPackage -> IO () + +foreign import ccall unsafe "LLVM_Hs_CreateModulePassManager" createModulePassManager + :: IO (Ptr ModulePassManager) + +foreign import ccall unsafe "LLVM_Hs_DisposeModulePassManager" disposeModulePassManager + :: Ptr ModulePassManager -> IO () + +foreign import ccall unsafe "LLVM_Hs_ModulePassManagerRun" modulePassManagerRun + :: Ptr ModulePassManager -> Ptr PassBuilderPackage -> Ptr Module -> IO () + +foreign import ccall unsafe "LLVM_Hs_AddPerModuleDefaultPipeline" addPerModuleDefaultPipeline + :: Ptr ModulePassManager -> Ptr PassBuilderPackage -> CInt -> IO () + +foreign import ccall unsafe "LLVM_Hs_AddGlobalDeadCodeEliminationPass" addGlobalDeadCodeEliminationPass + :: Ptr ModulePassManager -> IO () + +foreign import ccall unsafe "LLVM_Hs_AddAlwaysInlinePass" addAlwaysInlinePass + :: Ptr ModulePassManager -> CInt -> IO () + +foreign import ccall unsafe "LLVM_Hs_AddInternalizeFunctionsPass" addInternalizeFunctionsPass + :: Ptr ModulePassManager -> CInt -> Ptr CString -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/PassesC.cpp b/llvm-hs/src/LLVM/Internal/FFI/PassesC.cpp new file mode 100644 index 00000000..93ac7a5c --- /dev/null +++ b/llvm-hs/src/LLVM/Internal/FFI/PassesC.cpp @@ -0,0 +1,85 @@ +#define __STDC_LIMIT_MACROS +#include "llvm/Passes/PassBuilder.h" +#include "llvm/Transforms/IPO/GlobalDCE.h" +#include "llvm/Transforms/IPO/AlwaysInliner.h" +#include "llvm/Transforms/IPO/Internalize.h" + +using namespace llvm; + +namespace { + +struct PassBuilderPackage { + LoopAnalysisManager LAM; + FunctionAnalysisManager FAM; + CGSCCAnalysisManager CGAM; + ModuleAnalysisManager MAM; + PassBuilder PB; + + PassBuilderPackage(TargetMachine* tm) : PB(tm) { + PB.registerModuleAnalyses(MAM); + PB.registerCGSCCAnalyses(CGAM); + PB.registerFunctionAnalyses(FAM); + PB.registerLoopAnalyses(LAM); + PB.crossRegisterProxies(LAM, FAM, CGAM, MAM); + } +}; + +} + +extern "C" { + +PassBuilderPackage* LLVM_Hs_CreatePassBuilderPackage(TargetMachine* tm) { + return new PassBuilderPackage(tm); +} + +void LLVM_Hs_DisposePassBuilderPackage(PassBuilderPackage* pbp) { + delete pbp; +} + +ModulePassManager* LLVM_Hs_CreateModulePassManager() { + return new ModulePassManager(); +} + +void LLVM_Hs_DisposeModulePassManager(ModulePassManager* mpm) { + delete mpm; +} + +void LLVM_Hs_ModulePassManagerRun(ModulePassManager *mpm, PassBuilderPackage* pbp, Module* m) { + mpm->run(*m, pbp->MAM); +} + +void LLVM_Hs_AddPerModuleDefaultPipeline(ModulePassManager* mpm, PassBuilderPackage* pbp, int opt) { + OptimizationLevel opt_lvl; + if (opt == 0) { + opt_lvl = OptimizationLevel::O0; + } if (opt == 1) { + opt_lvl = OptimizationLevel::O1; + } else if (opt == 2) { + opt_lvl = OptimizationLevel::O2; + } else if (opt >= 3) { + opt_lvl = OptimizationLevel::O3; + } + mpm->addPass(pbp->PB.buildPerModuleDefaultPipeline(opt_lvl)); +} + +void LLVM_Hs_AddGlobalDeadCodeEliminationPass(ModulePassManager* mpm) { + mpm->addPass(GlobalDCEPass()); +} + +void LLVM_Hs_AddAlwaysInlinePass(ModulePassManager* mpm, int insert_lifetimes) { + mpm->addPass(AlwaysInlinerPass(insert_lifetimes)); +} + +void LLVM_Hs_AddInternalizeFunctionsPass(ModulePassManager* mpm, int num_exports, char** exports) { + std::vector owned_exports; + for (int i = 0; i < num_exports; ++i) { + owned_exports.push_back(std::string(exports[i])); + } + StringSet<> exports_set; + for (const std::string& e : owned_exports) exports_set.insert(e); + mpm->addPass(InternalizePass([owned_exports, exports_set](const GlobalValue &gv) -> bool { + return exports_set.contains(gv.getName()); + })); +} + +} diff --git a/llvm-hs/src/LLVM/Internal/Passes.hs b/llvm-hs/src/LLVM/Internal/Passes.hs index 3c2da37b..41c51bd2 100644 --- a/llvm-hs/src/LLVM/Internal/Passes.hs +++ b/llvm-hs/src/LLVM/Internal/Passes.hs @@ -3,34 +3,49 @@ module LLVM.Internal.Passes where import LLVM.Prelude -import Foreign.Ptr import Foreign.C.String +import Foreign.C.Types +import Foreign.Marshal.Array +import Foreign.Ptr import LLVM.Internal.Module import LLVM.Internal.Target -import qualified LLVM.Internal.FFI.Error as FFI import qualified LLVM.Internal.FFI.Passes as FFI +data ModulePass + = GlobalDeadCodeElimination + | InternalizeFunctions { exportList :: [String] } + | AlwaysInline { insertLifetime :: Bool } + | CuratedPassSet { optLevel :: Word } + data PassSetSpec - -- | This type is a high-level specification of a set of passes. It uses the same - -- collection of passes chosen by the LLVM team in the command line tool 'opt'. The fields - -- of this spec are much like typical compiler command-line flags - e.g. -O\, etc. - = CuratedPassSetSpec { - optLevel :: Word, + = PassSetSpec { + passes :: [ModulePass], targetMachine :: Maybe TargetMachine } -runPasses :: PassSetSpec -> Module -> IO Bool -runPasses spec m = do +runPasses :: PassSetSpec -> Module -> IO () +runPasses (PassSetSpec passes tm) m = do m' <- readModule m - opts <- FFI.createPassBuilderOptions - err <- withCString passStr $ \passCStr -> - FFI.runPasses m' passCStr tm' opts - FFI.disposePassBuilderOptions opts - FFI.consumeError err - return $ err == nullPtr + pb <- FFI.createPassBuilderPackage tm' + mpm <- FFI.createModulePassManager + forM_ passes $ addPass mpm pb + FFI.modulePassManagerRun mpm pb m' + FFI.disposeModulePassManager mpm + FFI.disposePassBuilderPackage pb + where tm' = case tm of Nothing -> nullPtr; Just (TargetMachine ptr) -> ptr + +addPass :: Ptr FFI.ModulePassManager -> Ptr FFI.PassBuilderPackage -> ModulePass -> IO () +addPass mpm pb p = case p of + CuratedPassSet level -> FFI.addPerModuleDefaultPipeline mpm pb (fromIntegral level) + GlobalDeadCodeElimination -> FFI.addGlobalDeadCodeEliminationPass mpm + AlwaysInline l -> FFI.addAlwaysInlinePass mpm (if l then 1 else 0) + InternalizeFunctions exports -> encodeExports exports $ FFI.addInternalizeFunctionsPass mpm + +encodeExports :: [String] -> (CInt -> Ptr CString -> IO a) -> IO a +encodeExports topExports cont = go [] topExports where - (passStr, tm) = case spec of - CuratedPassSetSpec optLevel tm -> ("default", tm) - tm' = case tm of Nothing -> nullPtr; Just (TargetMachine ptr) -> ptr + go ptrs exports = case exports of + [] -> withArrayLen ptrs $ \n p -> cont (fromIntegral n) p + (e:es) -> withCString e $ \ep -> go (ep:ptrs) es diff --git a/llvm-hs/src/LLVM/Passes.hs b/llvm-hs/src/LLVM/Passes.hs index a0e1a3c4..5405995e 100644 --- a/llvm-hs/src/LLVM/Passes.hs +++ b/llvm-hs/src/LLVM/Passes.hs @@ -1,4 +1,4 @@ -- | This module provides an interface to LLVM's passes. -module LLVM.Passes (PassSetSpec (..), runPasses) where +module LLVM.Passes (PassSetSpec (..), ModulePass (..), runPasses) where import LLVM.Internal.Passes diff --git a/llvm-hs/test/LLVM/Test/Optimization.hs b/llvm-hs/test/LLVM/Test/Optimization.hs index 67ec82a4..27586b68 100644 --- a/llvm-hs/test/LLVM/Test/Optimization.hs +++ b/llvm-hs/test/LLVM/Test/Optimization.hs @@ -105,7 +105,7 @@ optimize pss m = withContext $ \context -> withModuleFromAST context m $ \mIn' - tests = testGroup "Optimization" [ testCase "curated" $ do - mOut <- optimize (CuratedPassSetSpec 2 Nothing) handAST + mOut <- optimize (PassSetSpec [CuratedPassSet 2] Nothing) handAST mOut @?= Module "" "" Nothing Nothing [ GlobalDefinition $ functionDefaults { diff --git a/llvm-hs/test/LLVM/Test/OrcJIT.hs b/llvm-hs/test/LLVM/Test/OrcJIT.hs index 0b61877c..7ca9e816 100644 --- a/llvm-hs/test/LLVM/Test/OrcJIT.hs +++ b/llvm-hs/test/LLVM/Test/OrcJIT.hs @@ -100,21 +100,18 @@ tests = result @?= 38, testCase "run optimization passes on a JIT module" $ do - passmanagerSuccessful <- newIORef False withHostTargetMachine Reloc.PIC CodeModel.Default CodeGenOpt.Default $ \tm -> withExecutionSession $ \es -> do ol <- createRTDyldObjectLinkingLayer es il <- createIRCompileLayer es ol tm dylib <- createJITDylib es "testDylib" withTest2Module $ \m -> do - success <- runPasses (CuratedPassSetSpec 2 Nothing) m - writeIORef passmanagerSuccessful success + runPasses (PassSetSpec [CuratedPassSet 2] Nothing) m withClonedThreadSafeModule m $ \tsm -> do addModule tsm dylib il Right (JITSymbol mainFn _) <- lookupSymbol es il dylib "main" result <- mkMain (castPtrToFunPtr (wordPtrToPtr mainFn)) result @?= 42 - readIORef passmanagerSuccessful @? "passmanager failed" -- TODO: Make it possible to use Haskell functions as definition generators -- and update to OrcJITv2 From 0851136a504b0f736233ff75a1fec82f096e3671 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Fri, 29 Apr 2022 17:07:43 +0000 Subject: [PATCH 29/37] Make UseDwarfDirectory MCTargetOption an enum To mirror upstream LLVM changes. --- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 1 + llvm-hs/src/LLVM/Internal/FFI/LLVMCTypes.hsc | 6 ++-- llvm-hs/src/LLVM/Internal/FFI/Target.h | 29 +++++++++--------- llvm-hs/src/LLVM/Internal/FFI/Target.hs | 14 ++++++--- llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp | 31 +++++++++++++++----- llvm-hs/src/LLVM/Internal/Target.hs | 10 +++---- llvm-hs/src/LLVM/Target/Options.hs | 8 ++++- llvm-hs/test/LLVM/Test/Target.hs | 3 ++ 8 files changed, 66 insertions(+), 36 deletions(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index c469bb1a..a9023497 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -7,6 +7,7 @@ #define LLVM_HS_FOR_EACH_ATTRIBUTE_KIND(macro) \ macro(None,F,F,F) \ macro(AllocAlign,T,F,F) \ + macro(AllocatedPointer,T,F,F) \ macro(AlwaysInline,F,F,T) \ macro(ArgMemOnly,F,F,T) \ macro(Builtin,F,F,T) \ diff --git a/llvm-hs/src/LLVM/Internal/FFI/LLVMCTypes.hsc b/llvm-hs/src/LLVM/Internal/FFI/LLVMCTypes.hsc index 864c0f33..bb23fff6 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/LLVMCTypes.hsc +++ b/llvm-hs/src/LLVM/Internal/FFI/LLVMCTypes.hsc @@ -288,10 +288,10 @@ newtype TargetOptionFlag = TargetOptionFlag CUInt #define TOF_Rec(n) { #n, LLVM_Hs_TargetOptionFlag_ ## n }, #{inject TARGET_OPTION_FLAG, TargetOptionFlag, TargetOptionFlag, targetOptionFlag, TOF_Rec} -newtype MCTargetOptionFlag = MCTargetOptionFlag CUInt +newtype MCTargetOptionBoolFlag = MCTargetOptionBoolFlag CUInt deriving (Eq, Read, Show, Typeable, Data, Generic) -#define MCTOF_Rec(n) { #n, LLVM_Hs_MCTargetOptionFlag_ ## n }, -#{inject MC_TARGET_OPTION_FLAG, MCTargetOptionFlag, MCTargetOptionFlag, mcTargetOptionFlag, MCTOF_Rec} +#define MCTOF_Rec(n) { #n, LLVM_Hs_MCTargetOptionBoolFlag_ ## n }, +#{inject MC_TARGET_OPTION_BOOL_FLAG, MCTargetOptionBoolFlag, MCTargetOptionBoolFlag, mcTargetOptionFlag, MCTOF_Rec} newtype DebugCompressionType = DebugCompressionType CUInt deriving (Eq, Read, Show, Typeable, Data, Generic) diff --git a/llvm-hs/src/LLVM/Internal/FFI/Target.h b/llvm-hs/src/LLVM/Internal/FFI/Target.h index 8da5b0a4..85f7043e 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Target.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Target.h @@ -68,25 +68,24 @@ typedef enum { #undef ENUM_CASE } LLVM_Hs_TargetOptionFlag; -#define LLVM_HS_FOR_EACH_MC_TARGET_OPTION_FLAG(macro) \ - macro(MCRelaxAll) \ - macro(MCNoExecStack) \ - macro(MCFatalWarnings) \ - macro(MCNoWarn) \ - macro(MCNoDeprecatedWarn) \ - macro(MCSaveTempLabels) \ - macro(MCUseDwarfDirectory) \ - macro(MCIncrementalLinkerCompatible) \ - macro(ShowMCEncoding) \ - macro(ShowMCInst) \ - macro(AsmVerbose) \ +#define LLVM_HS_FOR_EACH_MC_TARGET_OPTION_BOOL_FLAG(macro) \ + macro(MCRelaxAll) \ + macro(MCNoExecStack) \ + macro(MCFatalWarnings) \ + macro(MCNoWarn) \ + macro(MCNoDeprecatedWarn) \ + macro(MCSaveTempLabels) \ + macro(MCIncrementalLinkerCompatible) \ + macro(ShowMCEncoding) \ + macro(ShowMCInst) \ + macro(AsmVerbose) \ macro(PreserveAsmComments) typedef enum { -#define ENUM_CASE(n) LLVM_Hs_MCTargetOptionFlag_ ## n, - LLVM_HS_FOR_EACH_MC_TARGET_OPTION_FLAG(ENUM_CASE) +#define ENUM_CASE(n) LLVM_Hs_MCTargetOptionBoolFlag_ ## n, + LLVM_HS_FOR_EACH_MC_TARGET_OPTION_BOOL_FLAG(ENUM_CASE) #undef ENUM_CASE -} LLVM_Hs_MCTargetOptionFlag; +} LLVM_Hs_MCTargetOptionBoolFlag; #define LLVM_HS_FOR_EACH_DEBUG_COMPRESSION_TYPE(macro) \ macro(None) \ diff --git a/llvm-hs/src/LLVM/Internal/FFI/Target.hs b/llvm-hs/src/LLVM/Internal/FFI/Target.hs index 82c81eeb..fb2fc325 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Target.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Target.hs @@ -35,11 +35,17 @@ foreign import ccall unsafe "LLVM_Hs_SetTargetOptionFlag" setTargetOptionFlag :: foreign import ccall unsafe "LLVM_Hs_GetTargetOptionFlag" getTargetOptionsFlag :: Ptr TargetOptions -> TargetOptionFlag -> IO LLVMBool -foreign import ccall unsafe "LLVM_Hs_SetMCTargetOptionFlag" setMCTargetOptionFlag :: - Ptr MCTargetOptions -> MCTargetOptionFlag -> LLVMBool -> IO () +foreign import ccall unsafe "LLVM_Hs_SetMCTargetOptionBoolFlag" setMCTargetOptionBoolFlag :: + Ptr MCTargetOptions -> MCTargetOptionBoolFlag -> LLVMBool -> IO () -foreign import ccall unsafe "LLVM_Hs_GetMCTargetOptionFlag" getMCTargetOptionsFlag :: - Ptr MCTargetOptions -> MCTargetOptionFlag -> IO LLVMBool +foreign import ccall unsafe "LLVM_Hs_GetMCTargetOptionBoolFlag" getMCTargetOptionsBoolFlag :: + Ptr MCTargetOptions -> MCTargetOptionBoolFlag -> IO LLVMBool + +foreign import ccall unsafe "LLVM_Hs_SetMCTargetOptionFlagUseDwarfDirectory" setMCTargetOptionFlagUseDwarfDirectory :: + Ptr MCTargetOptions -> CInt -> IO () + +foreign import ccall unsafe "LLVM_Hs_GetMCTargetOptionFlagUseDwarfDirectory" getMCTargetOptionFlagUseDwarfDirectory :: + Ptr MCTargetOptions -> IO CInt foreign import ccall unsafe "LLVM_Hs_GetCompressDebugSections" getCompressDebugSections :: Ptr TargetOptions -> IO DebugCompressionType diff --git a/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp b/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp index 51d2c186..c6746fcf 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/TargetC.cpp @@ -270,18 +270,29 @@ void LLVM_Hs_SetTargetOptionFlag(TargetOptions *to, LLVM_Hs_TargetOptionFlag f, } } -void LLVM_Hs_SetMCTargetOptionFlag(MCTargetOptions *to, - LLVM_Hs_MCTargetOptionFlag f, unsigned v) { +void LLVM_Hs_SetMCTargetOptionBoolFlag(MCTargetOptions *to, + LLVM_Hs_MCTargetOptionBoolFlag f, + unsigned v) { switch (f) { #define ENUM_CASE(op) \ - case LLVM_Hs_MCTargetOptionFlag_##op: \ + case LLVM_Hs_MCTargetOptionBoolFlag_##op: \ to->op = v ? 1 : 0; \ break; - LLVM_HS_FOR_EACH_MC_TARGET_OPTION_FLAG(ENUM_CASE) + LLVM_HS_FOR_EACH_MC_TARGET_OPTION_BOOL_FLAG(ENUM_CASE) #undef ENUM_CASE } } +void LLVM_Hs_SetMCTargetOptionFlagUseDwarfDirectory(MCTargetOptions *to, int v) { + if (v == 0) { + to->MCUseDwarfDirectory = MCTargetOptions::DisableDwarfDirectory; + } else if (v == 1) { + to->MCUseDwarfDirectory = MCTargetOptions::EnableDwarfDirectory; + } else { + to->MCUseDwarfDirectory = MCTargetOptions::DefaultDwarfDirectory; + } +} + static llvm::DebugCompressionType unwrap(LLVM_Hs_DebugCompressionType compressionType) { switch (compressionType) { @@ -335,13 +346,13 @@ unsigned LLVM_Hs_GetTargetOptionFlag(TargetOptions *to, } } -unsigned LLVM_Hs_GetMCTargetOptionFlag(MCTargetOptions *to, - LLVM_Hs_MCTargetOptionFlag f) { +unsigned LLVM_Hs_GetMCTargetOptionBoolFlag(MCTargetOptions *to, + LLVM_Hs_MCTargetOptionBoolFlag f) { switch (f) { #define ENUM_CASE(op) \ - case LLVM_Hs_MCTargetOptionFlag_##op: \ + case LLVM_Hs_MCTargetOptionBoolFlag_##op: \ return to->op; - LLVM_HS_FOR_EACH_MC_TARGET_OPTION_FLAG(ENUM_CASE) + LLVM_HS_FOR_EACH_MC_TARGET_OPTION_BOOL_FLAG(ENUM_CASE) #undef ENUM_CASE default: reportFatalError("Unknown machine code target option flag"); @@ -349,6 +360,10 @@ unsigned LLVM_Hs_GetMCTargetOptionFlag(MCTargetOptions *to, } } +int LLVM_Hs_GetMCTargetOptionFlagUseDwarfDirectory(MCTargetOptions *to) { + return to->MCUseDwarfDirectory; +} + void LLVM_Hs_SetFloatABIType(TargetOptions *to, LLVM_Hs_FloatABI v) { to->FloatABIType = unwrap(v); } diff --git a/llvm-hs/src/LLVM/Internal/Target.hs b/llvm-hs/src/LLVM/Internal/Target.hs index c6e76fca..e6cbc143 100644 --- a/llvm-hs/src/LLVM/Internal/Target.hs +++ b/llvm-hs/src/LLVM/Internal/Target.hs @@ -202,21 +202,21 @@ pokeTargetOptions hOpts opts@(TargetOptions cOpts) = do pokeMachineCodeOptions (TO.machineCodeOptions hOpts) =<< machineCodeOptions opts pokeMachineCodeOptions :: TO.MachineCodeOptions -> MCTargetOptions -> IO () -pokeMachineCodeOptions hOpts (MCTargetOptions cOpts) = - mapM_ (\(c, ha) -> FFI.setMCTargetOptionFlag cOpts c =<< encodeM (ha hOpts)) [ +pokeMachineCodeOptions hOpts (MCTargetOptions cOpts) = do + mapM_ (\(c, ha) -> FFI.setMCTargetOptionBoolFlag cOpts c =<< encodeM (ha hOpts)) [ (FFI.mcTargetOptionFlagMCRelaxAll, TO.relaxAll), (FFI.mcTargetOptionFlagMCNoExecStack, TO.noExecutableStack), (FFI.mcTargetOptionFlagMCFatalWarnings, TO.fatalWarnings), (FFI.mcTargetOptionFlagMCNoWarn, TO.noWarnings), (FFI.mcTargetOptionFlagMCNoDeprecatedWarn, TO.noDeprecatedWarning), (FFI.mcTargetOptionFlagMCSaveTempLabels, TO.saveTemporaryLabels), - (FFI.mcTargetOptionFlagMCUseDwarfDirectory, TO.useDwarfDirectory), (FFI.mcTargetOptionFlagMCIncrementalLinkerCompatible, TO.incrementalLinkerCompatible), (FFI.mcTargetOptionFlagShowMCEncoding, TO.showMachineCodeEncoding), (FFI.mcTargetOptionFlagShowMCInst, TO.showMachineCodeInstructions), (FFI.mcTargetOptionFlagAsmVerbose, TO.verboseAssembly), (FFI.mcTargetOptionFlagPreserveAsmComments, TO.preserveComentsInAssembly) ] + FFI.setMCTargetOptionFlagUseDwarfDirectory cOpts $ fromIntegral $ fromEnum $ TO.useDwarfDirectory hOpts -- | get all target options peekTargetOptions :: TargetOptions -> IO TO.Options @@ -274,7 +274,7 @@ peekTargetOptions opts@(TargetOptions tOpts) = do -- | get all machine code options peekMachineCodeOptions :: MCTargetOptions -> IO TO.MachineCodeOptions peekMachineCodeOptions (MCTargetOptions tOpts) = do - let gof = decodeM <=< FFI.getMCTargetOptionsFlag tOpts + let gof = decodeM <=< FFI.getMCTargetOptionsBoolFlag tOpts relaxAll <- gof FFI.mcTargetOptionFlagMCRelaxAll noExecutableStack @@ -288,7 +288,7 @@ peekMachineCodeOptions (MCTargetOptions tOpts) = do saveTemporaryLabels <- gof FFI.mcTargetOptionFlagMCSaveTempLabels useDwarfDirectory - <- gof FFI.mcTargetOptionFlagMCUseDwarfDirectory + <- toEnum . fromIntegral <$> FFI.getMCTargetOptionFlagUseDwarfDirectory tOpts incrementalLinkerCompatible <- gof FFI.mcTargetOptionFlagMCIncrementalLinkerCompatible showMachineCodeEncoding diff --git a/llvm-hs/src/LLVM/Target/Options.hs b/llvm-hs/src/LLVM/Target/Options.hs index 4b79ee36..a6c3c615 100644 --- a/llvm-hs/src/LLVM/Target/Options.hs +++ b/llvm-hs/src/LLVM/Target/Options.hs @@ -97,6 +97,12 @@ data Options = Options { } deriving (Eq, Ord, Read, Show) +data DwarfDirectory + = DisableDwarfDirectory + | EnableDwarfDirectory + | DefaultDwarfDirectory -- ^ target specific + deriving (Eq, Ord, Read, Show, Enum, Bounded) + -- | data MachineCodeOptions = MachineCodeOptions { relaxAll :: Bool, @@ -105,7 +111,7 @@ data MachineCodeOptions = MachineCodeOptions { noWarnings :: Bool, noDeprecatedWarning :: Bool, saveTemporaryLabels :: Bool, - useDwarfDirectory :: Bool, + useDwarfDirectory :: DwarfDirectory, incrementalLinkerCompatible :: Bool, showMachineCodeEncoding :: Bool, showMachineCodeInstructions :: Bool, diff --git a/llvm-hs/test/LLVM/Test/Target.hs b/llvm-hs/test/LLVM/Test/Target.hs index 7ab01bb6..0b76a218 100644 --- a/llvm-hs/test/LLVM/Test/Target.hs +++ b/llvm-hs/test/LLVM/Test/Target.hs @@ -84,6 +84,9 @@ instance Arbitrary Options where machineCodeOptions <- arbitrary return Options { .. } +instance Arbitrary DwarfDirectory where + arbitrary = elements [minBound .. maxBound] + instance Arbitrary MachineCodeOptions where arbitrary = do relaxAll <- arbitrary From 73a6a8db44757299623e078da43236fffb1d708a Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Thu, 12 May 2022 09:35:22 +0000 Subject: [PATCH 30/37] Reserve vector space to be slightly more efficient --- llvm-hs/src/LLVM/Internal/FFI/PassesC.cpp | 1 + 1 file changed, 1 insertion(+) diff --git a/llvm-hs/src/LLVM/Internal/FFI/PassesC.cpp b/llvm-hs/src/LLVM/Internal/FFI/PassesC.cpp index 93ac7a5c..1477e807 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/PassesC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/PassesC.cpp @@ -72,6 +72,7 @@ void LLVM_Hs_AddAlwaysInlinePass(ModulePassManager* mpm, int insert_lifetimes) { void LLVM_Hs_AddInternalizeFunctionsPass(ModulePassManager* mpm, int num_exports, char** exports) { std::vector owned_exports; + owned_exports.reserve(num_exports); for (int i = 0; i < num_exports; ++i) { owned_exports.push_back(std::string(exports[i])); } From c1e52cd41089375a647a5944964e1f93a1523d12 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Thu, 12 May 2022 09:45:32 +0000 Subject: [PATCH 31/37] Transition to opaque pointers LLVM devs are currently busy at work cleaning up the typed pointer types that have been deprecated a while back, and that are the only ones representable in llvm-hs at the moment. This patch rewrites the whole library to work with opaque pointers (i.e. ones that are not labeled with the pointee type, only by their address space). They've been just enabled by default in clang, so it seems like high time for us to make the switch. See the [migration guide](https://llvm.org/docs/OpaquePointers.html) for extra context. --- llvm-hs-pure/src/LLVM/AST/Constant.hs | 7 +- llvm-hs-pure/src/LLVM/AST/Instruction.hs | 4 + llvm-hs-pure/src/LLVM/AST/Type.hs | 8 +- llvm-hs-pure/src/LLVM/AST/Typed.hs | 25 +-- .../src/LLVM/IRBuilder/Instruction.hs | 54 ++----- llvm-hs-pure/src/LLVM/IRBuilder/Module.hs | 11 +- llvm-hs-pure/test/LLVM/Test/IRBuilder.hs | 75 +++++---- llvm-hs/llvm-hs.cabal | 1 + llvm-hs/src/LLVM/Internal/Constant.hs | 19 +-- llvm-hs/src/LLVM/Internal/Context.hs | 10 +- llvm-hs/src/LLVM/Internal/FFI/Builder.hs | 26 +-- llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp | 17 +- llvm-hs/src/LLVM/Internal/FFI/Constant.hs | 17 +- llvm-hs/src/LLVM/Internal/FFI/ConstantC.cpp | 4 + llvm-hs/src/LLVM/Internal/FFI/Context.hs | 3 + llvm-hs/src/LLVM/Internal/FFI/ContextC.cpp | 13 ++ llvm-hs/src/LLVM/Internal/FFI/GlobalValue.hs | 7 + .../src/LLVM/Internal/FFI/GlobalValueC.cpp | 9 ++ .../src/LLVM/Internal/FFI/InlineAssembly.hs | 2 + .../src/LLVM/Internal/FFI/InlineAssemblyC.cpp | 5 +- llvm-hs/src/LLVM/Internal/FFI/Instruction.hs | 6 + llvm-hs/src/LLVM/Internal/FFI/Type.hs | 6 + llvm-hs/src/LLVM/Internal/FFI/TypeC.cpp | 8 + llvm-hs/src/LLVM/Internal/FFI/Value.hs | 2 +- llvm-hs/src/LLVM/Internal/Global.hs | 7 +- llvm-hs/src/LLVM/Internal/InlineAssembly.hs | 9 +- llvm-hs/src/LLVM/Internal/Instruction.hs | 15 +- llvm-hs/src/LLVM/Internal/Module.hs | 11 +- llvm-hs/src/LLVM/Internal/Type.hs | 14 +- llvm-hs/src/LLVM/Internal/Value.hs | 3 +- llvm-hs/test/LLVM/Test/Analysis.hs | 22 +-- llvm-hs/test/LLVM/Test/Attribute.hs | 15 +- llvm-hs/test/LLVM/Test/Constants.hs | 32 ++-- llvm-hs/test/LLVM/Test/InlineAssembly.hs | 3 +- llvm-hs/test/LLVM/Test/Instructions.hs | 149 ++++++++---------- llvm-hs/test/LLVM/Test/Instrumentation.hs | 6 +- llvm-hs/test/LLVM/Test/Metadata.hs | 4 +- llvm-hs/test/LLVM/Test/Module.hs | 44 +++--- llvm-hs/test/LLVM/Test/Regression.hs | 67 +------- llvm-hs/test/LLVM/Test/Support.hs | 4 + llvm-hs/test/LLVM/Test/Target.hs | 1 + llvm-hs/test/LLVM/Test/Tests.hs | 4 +- 42 files changed, 358 insertions(+), 391 deletions(-) create mode 100644 llvm-hs/src/LLVM/Internal/FFI/ContextC.cpp diff --git a/llvm-hs-pure/src/LLVM/AST/Constant.hs b/llvm-hs-pure/src/LLVM/AST/Constant.hs index dfab7934..7c955677 100644 --- a/llvm-hs-pure/src/LLVM/AST/Constant.hs +++ b/llvm-hs-pure/src/LLVM/AST/Constant.hs @@ -32,7 +32,7 @@ data Constant | Vector { memberValues :: [ Constant ] } | Undef { constantType :: Type } | BlockAddress { blockAddressFunction :: Name, blockAddressBlock :: Name } - | GlobalReference Type Name + | GlobalReference Name | TokenNone | Add { nsw :: Bool, @@ -120,6 +120,7 @@ data Constant } | GetElementPtr { inBounds :: Bool, + type' :: Type, address :: Constant, indices :: [Constant] } @@ -242,6 +243,6 @@ unsignedIntegerValue _ = error "unsignedIntegerValue is only defined for Int" sizeof :: Word32 -> Type -> Constant sizeof szBits t = PtrToInt szPtr (IntegerType szBits) where - ptrType = PointerType t (AddrSpace 0) + ptrType = PointerType (AddrSpace 0) nullPtr = IntToPtr (Int szBits 0) ptrType - szPtr = GetElementPtr True nullPtr [Int szBits 1] + szPtr = GetElementPtr True t nullPtr [Int szBits 1] diff --git a/llvm-hs-pure/src/LLVM/AST/Instruction.hs b/llvm-hs-pure/src/LLVM/AST/Instruction.hs index 8a81afb2..2ab85d2c 100644 --- a/llvm-hs-pure/src/LLVM/AST/Instruction.hs +++ b/llvm-hs-pure/src/LLVM/AST/Instruction.hs @@ -51,6 +51,7 @@ data Terminator | Invoke { callingConvention' :: CallingConvention, returnAttributes' :: [PA.ParameterAttribute], + type'' :: Type, function' :: CallableOperand, arguments' :: [(Operand, [PA.ParameterAttribute])], functionAttributes' :: [Either FA.GroupID FA.FunctionAttribute], @@ -266,6 +267,7 @@ data Instruction } | Load { volatile :: Bool, + type' :: Type, address :: Operand, maybeAtomicity :: Maybe Atomicity, alignment :: Word32, @@ -281,6 +283,7 @@ data Instruction } | GetElementPtr { inBounds :: Bool, + type' :: Type, address :: Operand, indices :: [Operand], metadata :: InstructionMetadata @@ -405,6 +408,7 @@ data Instruction tailCallKind :: Maybe TailCallKind, callingConvention :: CallingConvention, returnAttributes :: [PA.ParameterAttribute], + type' :: Type, function :: CallableOperand, arguments :: [(Operand, [PA.ParameterAttribute])], functionAttributes :: [Either FA.GroupID FA.FunctionAttribute], diff --git a/llvm-hs-pure/src/LLVM/AST/Type.hs b/llvm-hs-pure/src/LLVM/AST/Type.hs index 686ce587..a0c548d6 100644 --- a/llvm-hs-pure/src/LLVM/AST/Type.hs +++ b/llvm-hs-pure/src/LLVM/AST/Type.hs @@ -23,7 +23,7 @@ data Type -- | | IntegerType { typeBits :: Word32 } -- | - | PointerType { pointerReferent :: Type, pointerAddrSpace :: AddrSpace } + | PointerType { pointerAddrSpace :: AddrSpace } -- | | FloatingPointType { floatingPointType :: FloatingPointType } -- | @@ -72,9 +72,9 @@ i64 = IntegerType 64 i128 :: Type i128 = IntegerType 128 --- | An abbreviation for 'PointerType' t ('AddrSpace' 0) -ptr :: Type -> Type -ptr t = PointerType t (AddrSpace 0) +-- | An abbreviation for 'PointerType' ('AddrSpace' 0) +ptr :: Type +ptr = PointerType (AddrSpace 0) -- | An abbreviation for 'FloatingPointType' 'HalfFP' half :: Type diff --git a/llvm-hs-pure/src/LLVM/AST/Typed.hs b/llvm-hs-pure/src/LLVM/AST/Typed.hs index fcbf72a4..097fb462 100644 --- a/llvm-hs-pure/src/LLVM/AST/Typed.hs +++ b/llvm-hs-pure/src/LLVM/AST/Typed.hs @@ -3,7 +3,6 @@ -- | Querying the type of LLVM expressions module LLVM.AST.Typed ( Typed(..), - getElementType, indexTypeByConstants, indexTypeByOperands, extractValueType, @@ -61,8 +60,8 @@ instance Typed C.Constant where (Right t') -> return $ Right $ VectorType (fromIntegral $ length memberValues) t' typeOf (C.Undef t) = return $ Right t - typeOf (C.BlockAddress {}) = return $ Right $ ptr i8 - typeOf (C.GlobalReference t _) = return $ Right t + typeOf (C.BlockAddress {}) = return $ Right ptr + typeOf (C.GlobalReference _) = return $ Right ptr typeOf (C.Add {..}) = typeOf operand0 typeOf (C.FAdd {..}) = typeOf operand0 typeOf (C.FDiv {..}) = typeOf operand0 @@ -81,11 +80,7 @@ instance Typed C.Constant where typeOf (C.And {..}) = typeOf operand0 typeOf (C.Or {..}) = typeOf operand0 typeOf (C.Xor {..}) = typeOf operand0 - typeOf (C.GetElementPtr {..}) = do - aty <- typeOf address - case aty of - (Left _) -> return aty - (Right aty') -> indexTypeByConstants aty' indices + typeOf (C.GetElementPtr {}) = return $ Right ptr typeOf (C.Trunc {..}) = return $ Right type' typeOf (C.ZExt {..}) = return $ Right type' typeOf (C.SExt {..}) = return $ Right type' @@ -133,10 +128,9 @@ instance Typed C.Constant where typeOf (C.TokenNone) = return $ Right TokenType typeOf (C.AddrSpaceCast {..}) = return $ Right type' --- | Index into a type using a list of 'Constant' values. Returns a pointer type whose referent is the indexed type, or an error message if indexing was not possible. +-- | Index into a type using a list of 'Constant' values. Returns the indexed type, or an error message if indexing was not possible. indexTypeByConstants :: (HasCallStack, MonadModuleBuilder m) => Type -> [C.Constant] -> m (Either String Type) -indexTypeByConstants ty [] = return $ Right $ ptr ty -indexTypeByConstants (PointerType ty _) (_:is) = indexTypeByConstants ty is +indexTypeByConstants ty [] = return $ Right ty indexTypeByConstants (StructureType _ elTys) (C.Int 32 val:is) = indexTypeByConstants (elTys !! fromIntegral val) is indexTypeByConstants (StructureType _ _) (i:_) = @@ -150,10 +144,9 @@ indexTypeByConstants (NamedTypeReference n) is = do Just ty -> indexTypeByConstants ty is indexTypeByConstants ty _ = return $ Left $ "Expecting aggregate type. (Malformed AST): " ++ show ty --- | Index into a type using a list of 'Operand' values. Returns a pointer type whose referent is the indexed type, or an error message if indexing was not possible. +-- | Index into a type using a list of 'Operand' values. Returns the indexed type, or an error message if indexing was not possible. indexTypeByOperands :: (HasCallStack, MonadModuleBuilder m) => Type -> [Operand] -> m (Either String Type) -indexTypeByOperands ty [] = return $ Right $ ptr ty -indexTypeByOperands (PointerType ty _) (_:is) = indexTypeByOperands ty is +indexTypeByOperands ty [] = return $ Right ty indexTypeByOperands (StructureType _ elTys) (ConstantOperand (C.Int 32 val):is) = indexTypeByOperands (elTys !! fromIntegral val) is indexTypeByOperands (StructureType _ _) (i:_) = @@ -167,10 +160,6 @@ indexTypeByOperands (NamedTypeReference n) is = do Just ty -> indexTypeByOperands ty is indexTypeByOperands ty _ = return $ Left $ "Expecting aggregate type. (Malformed AST): " ++ show ty -getElementType :: Type -> Either String Type -getElementType (PointerType t _) = Right t -getElementType t = Left $ "Expecting pointer type. (Malformed AST): " ++ show t - extractValueType :: (HasCallStack, MonadModuleBuilder m) => [Word32] -> Type -> m (Either String Type) extractValueType [] ty = return $ Right ty extractValueType (i : is) (ArrayType numEls elTy) diff --git a/llvm-hs-pure/src/LLVM/IRBuilder/Instruction.hs b/llvm-hs-pure/src/LLVM/IRBuilder/Instruction.hs index cc0f35f9..7058c513 100644 --- a/llvm-hs-pure/src/LLVM/IRBuilder/Instruction.hs +++ b/llvm-hs-pure/src/LLVM/IRBuilder/Instruction.hs @@ -179,19 +179,11 @@ xor a b = do -- | See . alloca :: MonadIRBuilder m => Type -> Maybe Operand -> Word32 -> m Operand -alloca ty count align = emitInstr (ptr ty) $ Alloca ty count align [] +alloca ty count align = emitInstr ptr $ Alloca ty count align [] -- | See . -load :: (HasCallStack, MonadIRBuilder m, MonadModuleBuilder m) => Operand -> Word32 -> m Operand -load a align = do - ta <- typeOf a - case ta of - (Left s) -> error s - (Right ta') -> do - let retty = case ta' of - PointerType ty _ -> ty - _ -> error "Cannot load non-pointer (Malformed AST)." - emitInstr retty $ Load False a Nothing align [] +load :: (HasCallStack, MonadIRBuilder m, MonadModuleBuilder m) => Type -> Operand -> Word32 -> m Operand +load ty a align = emitInstr ty $ Load False ty a Nothing align [] -- | See . store :: MonadIRBuilder m => Operand -> Word32 -> Operand -> m () @@ -199,16 +191,8 @@ store addr align val = emitInstrVoid $ Store False addr val Nothing align [] -- | Emit the @getelementptr@ instruction. -- See . -gep :: (HasCallStack, MonadIRBuilder m, MonadModuleBuilder m) => Operand -> [Operand] -> m Operand -gep addr is = do - ta <- typeOf addr - case ta of - (Left s) -> error s - (Right ta') -> do - ty <- indexTypeByOperands ta' is - case ty of - (Left s) -> error s - (Right ty') -> emitInstr ty' (GetElementPtr False addr is []) +gep :: (HasCallStack, MonadIRBuilder m, MonadModuleBuilder m) => Type -> Operand -> [Operand] -> m Operand +gep ty addr is = emitInstr ptr $ GetElementPtr False ty addr is [] -- | Emit the @trunc ... to@ instruction. -- See . @@ -311,7 +295,7 @@ extractValue a i = do retType <- indexTypeByOperands aggType (map (ConstantOperand . C.Int 32 . fromIntegral) i) case retType of (Left s) -> error s - (Right retType') -> emitInstr (pointerReferent retType') $ ExtractValue a i [] + (Right retType') -> emitInstr retType' $ ExtractValue a i [] -- | See . insertValue :: (HasCallStack, MonadIRBuilder m, MonadModuleBuilder m) => Operand -> Operand -> [Word32] -> m Operand @@ -350,27 +334,23 @@ retVoid :: MonadIRBuilder m => m () retVoid = emitTerm (Ret Nothing []) -- | See . -call :: (HasCallStack, MonadIRBuilder m, MonadModuleBuilder m) => Operand -> [(Operand, [ParameterAttribute])] -> m Operand -call fun args = do +call :: (HasCallStack, MonadIRBuilder m, MonadModuleBuilder m) => Type -> Operand -> [(Operand, [ParameterAttribute])] -> m Operand +call funty fun args = do let instr = Call { AST.tailCallKind = Nothing , AST.callingConvention = CC.C , AST.returnAttributes = [] + , AST.type' = funty , AST.function = Right fun , AST.arguments = args , AST.functionAttributes = [] , AST.metadata = [] } - tf <- typeOf fun - case tf of - (Left s) -> error s - (Right (FunctionType r _ _)) -> case r of - VoidType -> emitInstrVoid instr >> (pure (ConstantOperand (C.Undef void))) - _ -> emitInstr r instr - (Right (PointerType (FunctionType r _ _) _)) -> case r of + case funty of + FunctionType r _ _ -> case r of VoidType -> emitInstrVoid instr >> (pure (ConstantOperand (C.Undef void))) _ -> emitInstr r instr - (Right _) -> error "Cannot call non-function (Malformed AST)." + _ -> error "Cannot call non-function (Malformed AST)." -- | See . ret :: MonadIRBuilder m => Operand -> m () @@ -422,11 +402,9 @@ globalStringPtr str nm = do , unnamedAddr = Just GlobalAddr } return $ C.GetElementPtr True - (C.GlobalReference (ptr ty') nm) - [(C.Int 32 0), (C.Int 32 0)] + ty' + (C.GlobalReference nm) + [(C.Int 32 0), (C.Int 32 0)] sizeof :: (HasCallStack, MonadIRBuilder m, MonadModuleBuilder m) => Word32 -> Type -> m Operand -sizeof szBits ty = do - tyNullPtr <- inttoptr (ConstantOperand $ C.Int szBits 0) (ptr ty) - tySzPtr <- gep tyNullPtr [ConstantOperand $ C.Int szBits 1] - ptrtoint tySzPtr $ IntegerType szBits +sizeof szBits ty = return $ ConstantOperand $ C.sizeof szBits ty diff --git a/llvm-hs-pure/src/LLVM/IRBuilder/Module.hs b/llvm-hs-pure/src/LLVM/IRBuilder/Module.hs index b9bb9b91..fa5e2765 100644 --- a/llvm-hs-pure/src/LLVM/IRBuilder/Module.hs +++ b/llvm-hs-pure/src/LLVM/IRBuilder/Module.hs @@ -147,9 +147,8 @@ function label argtys retty body = do , returnType = retty , basicBlocks = blocks } - funty = ptr $ FunctionType retty (fst <$> argtys) False emitDefn def - pure $ ConstantOperand $ C.GlobalReference funty label + pure $ ConstantOperand $ C.GlobalReference label -- | An external function definition extern @@ -165,8 +164,7 @@ extern nm argtys retty = do , parameters = ([Parameter ty (mkName "") [] | ty <- argtys], False) , returnType = retty } - let funty = ptr $ FunctionType retty argtys False - pure $ ConstantOperand $ C.GlobalReference funty nm + pure $ ConstantOperand $ C.GlobalReference nm -- | An external variadic argument function definition externVarArgs @@ -182,8 +180,7 @@ externVarArgs nm argtys retty = do , parameters = ([Parameter ty (mkName "") [] | ty <- argtys], True) , returnType = retty } - let funty = ptr $ FunctionType retty argtys True - pure $ ConstantOperand $ C.GlobalReference funty nm + pure $ ConstantOperand $ C.GlobalReference nm -- | A global variable definition global @@ -199,7 +196,7 @@ global nm ty initVal = do , linkage = External , initializer = Just initVal } - pure $ ConstantOperand $ C.GlobalReference (ptr ty) nm + pure $ ConstantOperand $ C.GlobalReference nm -- | A named type definition typedef diff --git a/llvm-hs-pure/test/LLVM/Test/IRBuilder.hs b/llvm-hs-pure/test/LLVM/Test/IRBuilder.hs index 52cb7fe4..c6a6a8ad 100644 --- a/llvm-hs-pure/test/LLVM/Test/IRBuilder.hs +++ b/llvm-hs-pure/test/LLVM/Test/IRBuilder.hs @@ -149,20 +149,13 @@ tests = (UnName 7) [ UnName 8 := GetElementPtr { inBounds = False, - address = ConstantOperand (C.Null (AST.ptr (AST.ptr (AST.ptr AST.i32)))), + type' = AST.i32, + address = ConstantOperand (C.Null AST.ptr), indices = - [ ConstantOperand (C.Int 32 10) - , ConstantOperand (C.Int 32 20) - , ConstantOperand (C.Int 32 30) + [ ConstantOperand (C.Int 32 40) ], metadata = [] } - , UnName 9 := GetElementPtr { - inBounds = False, - address = LocalReference (AST.ptr AST.i32) (UnName 8), - indices = [ ConstantOperand (C.Int 32 40) ], - metadata = [] - } ] (Do (Ret Nothing [])) ] @@ -187,8 +180,8 @@ recursiveFunctionCalls = do { tailCallKind = Nothing , callingConvention = CC.C , returnAttributes = [] - , I.function = - Right (ConstantOperand (C.GlobalReference (AST.ptr (FunctionType AST.i32 [AST.i32] False)) (Name "f"))) + , type' = (FunctionType AST.i32 [AST.i32] False) + , I.function = Right (ConstantOperand (C.GlobalReference (Name "f"))) , arguments = [(LocalReference (IntegerType {typeBits = 32}) (Name "a_0"),[])] , functionAttributes = [] , metadata = [] @@ -203,7 +196,7 @@ recursiveFunctionCalls = do m = buildModule "exampleModule" $ mdo f <- function "f" [(AST.i32, "a")] AST.i32 $ \[a] -> mdo entry <- block `named` "entry"; do - c <- call f [(a, [])] + c <- call (FunctionType AST.i32 [AST.i32] False) f [(a, [])] ret c pure () @@ -213,7 +206,7 @@ callWorksWithConstantGlobals = do { moduleName = "exampleModule" , moduleDefinitions = [ GlobalDefinition functionDefaults { - LLVM.AST.Global.returnType = AST.ptr AST.i8, + LLVM.AST.Global.returnType = AST.ptr, LLVM.AST.Global.name = Name "malloc", LLVM.AST.Global.parameters = ([Parameter (IntegerType {typeBits = 64}) (Name "") []],False), LLVM.AST.Global.basicBlocks = [] @@ -224,11 +217,12 @@ callWorksWithConstantGlobals = do LLVM.AST.Global.parameters = ([],False), LLVM.AST.Global.basicBlocks = [ BasicBlock (UnName 0) [ - UnName 1 := Call { tailCallKind = Nothing + UnName 1 := Call + { tailCallKind = Nothing + , type' = FunctionType {resultType = AST.ptr, argumentTypes = [IntegerType {typeBits = 64}], isVarArg = False} , I.function = Right ( ConstantOperand ( C.GlobalReference - (AST.ptr $ FunctionType {resultType = AST.ptr $ IntegerType {typeBits = 8}, argumentTypes = [IntegerType {typeBits = 64}], isVarArg = False}) (Name "malloc") ) ) @@ -250,9 +244,9 @@ resolvesTypeDefs = do buildModule "" builder @?= ast where builder = mdo pairTy <- typedef "pair" (Just (StructureType False [AST.i32, AST.i32])) - function "f" [(AST.ptr pairTy, "ptr"), (AST.i32, "x"), (AST.i32, "y")] AST.void $ \[ptr, x, y] -> do - xPtr <- gep ptr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] - yPtr <- gep ptr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] + function "f" [(AST.ptr, "ptr"), (AST.i32, "x"), (AST.i32, "y")] AST.void $ \[ptr, x, y] -> do + xPtr <- gep pairTy ptr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] + yPtr <- gep pairTy ptr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] store xPtr 0 x store yPtr 0 y function "g" [(pairTy, "pair")] AST.i32 $ \[pair] -> do @@ -267,7 +261,7 @@ resolvesTypeDefs = do [ TypeDefinition "pair" (Just (StructureType False [AST.i32, AST.i32])) , GlobalDefinition functionDefaults { LLVM.AST.Global.name = "f" - , LLVM.AST.Global.parameters = ( [ Parameter (AST.ptr (NamedTypeReference "pair")) "ptr_0" [] + , LLVM.AST.Global.parameters = ( [ Parameter AST.ptr "ptr_0" [] , Parameter AST.i32 "x_0" [] , Parameter AST.i32 "y_0" []] , False) @@ -276,19 +270,21 @@ resolvesTypeDefs = do [ BasicBlock (UnName 0) [ UnName 1 := GetElementPtr { inBounds = False - , address = LocalReference (AST.ptr (NamedTypeReference "pair")) "ptr_0" + , type' = NamedTypeReference "pair" + , address = LocalReference AST.ptr "ptr_0" , indices = [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] , metadata = [] } , UnName 2 := GetElementPtr { inBounds = False - , address = LocalReference (AST.ptr (NamedTypeReference "pair")) "ptr_0" + , type' = NamedTypeReference "pair" + , address = LocalReference AST.ptr "ptr_0" , indices = [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] , metadata = [] } , Do $ Store { volatile = False - , address = LocalReference (AST.ptr AST.i32) (UnName 1) + , address = LocalReference AST.ptr (UnName 1) , value = LocalReference AST.i32 "x_0" , maybeAtomicity = Nothing , alignment = 0 @@ -296,7 +292,7 @@ resolvesTypeDefs = do } , Do $ Store { volatile = False - , address = LocalReference (AST.ptr AST.i32) (UnName 2) + , address = LocalReference AST.ptr (UnName 2) , value = LocalReference AST.i32 "y_0" , maybeAtomicity = Nothing , alignment = 0 @@ -343,13 +339,13 @@ resolvesConstantTypeDefs = do pairTy <- typedef "pair" (Just (StructureType False [AST.i32, AST.i32])) globalPair <- global "gpair" pairTy (C.AggregateZero pairTy) function "f" [(AST.i32, "x"), (AST.i32, "y")] AST.void $ \[x, y] -> do - let ptr = ConstantOperand $ C.GlobalReference (AST.ptr pairTy) "gpair" - xPtr <- gep ptr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] - yPtr <- gep ptr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] + let ptr = ConstantOperand $ C.GlobalReference "gpair" + xPtr <- gep pairTy ptr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] + yPtr <- gep pairTy ptr [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] store xPtr 0 x store yPtr 0 y function "g" [] AST.i32 $ \[] -> do - pair <- load (ConstantOperand $ C.GlobalReference (AST.ptr pairTy) "gpair") 0 + pair <- load pairTy (ConstantOperand $ C.GlobalReference "gpair") 0 x <- extractValue pair [0] y <- extractValue pair [1] z <- add x y @@ -375,19 +371,21 @@ resolvesConstantTypeDefs = do [ BasicBlock (UnName 0) [ UnName 1 := GetElementPtr { inBounds = False - , address = ConstantOperand (C.GlobalReference (AST.ptr (NamedTypeReference "pair")) "gpair") + , type' = NamedTypeReference "pair" + , address = ConstantOperand (C.GlobalReference "gpair") , indices = [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 0)] , metadata = [] } , UnName 2 := GetElementPtr { inBounds = False - , address = ConstantOperand (C.GlobalReference (AST.ptr (NamedTypeReference "pair")) "gpair") + , type' = NamedTypeReference "pair" + , address = ConstantOperand (C.GlobalReference "gpair") , indices = [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 1)] , metadata = [] } , Do $ Store { volatile = False - , address = LocalReference (AST.ptr AST.i32) (UnName 1) + , address = LocalReference AST.ptr (UnName 1) , value = LocalReference AST.i32 "x_0" , maybeAtomicity = Nothing , alignment = 0 @@ -395,7 +393,7 @@ resolvesConstantTypeDefs = do } , Do $ Store { volatile = False - , address = LocalReference (AST.ptr AST.i32) (UnName 2) + , address = LocalReference AST.ptr (UnName 2) , value = LocalReference AST.i32 "y_0" , maybeAtomicity = Nothing , alignment = 0 @@ -413,7 +411,8 @@ resolvesConstantTypeDefs = do [ BasicBlock (UnName 0) [ UnName 1 := Load { volatile = False, - address = ConstantOperand (C.GlobalReference (AST.ptr (NamedTypeReference "pair")) "gpair"), + type' = NamedTypeReference "pair", + address = ConstantOperand (C.GlobalReference "gpair"), maybeAtomicity = Nothing, alignment = 0, metadata = [] @@ -605,9 +604,7 @@ example = mkModule $ execModuleBuilder emptyModuleBuilder $ mdo retVoid blk3 <- block; do - let nul = cons $ C.Null $ AST.ptr $ AST.ptr $ AST.ptr $ IntegerType 32 - addr <- gep nul [cons $ C.Int 32 10, cons $ C.Int 32 20, cons $ C.Int 32 30] - addr' <- gep addr [cons $ C.Int 32 40] + addr <- gep AST.i32 (cons (C.Null AST.ptr)) [cons $ C.Int 32 40] retVoid pure () @@ -617,13 +614,13 @@ example = mkModule $ execModuleBuilder emptyModuleBuilder $ mdo funcCall :: Module funcCall = mkModule $ execModuleBuilder emptyModuleBuilder $ mdo - extern "malloc" [AST.i64] (AST.ptr AST.i8) + extern "malloc" [AST.i64] AST.ptr - let mallocTy = AST.ptr $ AST.FunctionType (AST.ptr AST.i8) [AST.i64] False + let mallocTy = AST.FunctionType AST.ptr [AST.i64] False function "omg" [] (AST.void) $ \_ -> do let size = int64 10 - call (ConstantOperand $ C.GlobalReference mallocTy "malloc") [(size, [])] + call mallocTy (ConstantOperand $ C.GlobalReference "malloc") [(size, [])] unreachable where mkModule ds = defaultModule { moduleName = "exampleModule", moduleDefinitions = ds } diff --git a/llvm-hs/llvm-hs.cabal b/llvm-hs/llvm-hs.cabal index 78a1e6e7..bcfd035f 100644 --- a/llvm-hs/llvm-hs.cabal +++ b/llvm-hs/llvm-hs.cabal @@ -241,6 +241,7 @@ library src/LLVM/Internal/FFI/BuilderC.cpp src/LLVM/Internal/FFI/CallingConventionC.cpp src/LLVM/Internal/FFI/ConstantC.cpp + src/LLVM/Internal/FFI/ContextC.cpp src/LLVM/Internal/FFI/CommandLineC.cpp src/LLVM/Internal/FFI/ErrorHandling.cpp src/LLVM/Internal/FFI/ExecutionEngineC.cpp diff --git a/llvm-hs/src/LLVM/Internal/Constant.hs b/llvm-hs/src/LLVM/Internal/Constant.hs index 17f7aacb..e46c977b 100644 --- a/llvm-hs/src/LLVM/Internal/Constant.hs +++ b/llvm-hs/src/LLVM/Internal/Constant.hs @@ -47,8 +47,7 @@ import LLVM.Internal.DecodeAST import LLVM.Internal.EncodeAST import LLVM.Internal.FloatingPointPredicate () import LLVM.Internal.IntegerPredicate () -import LLVM.Internal.Type (renameType) -import LLVM.Internal.Value +import LLVM.Internal.Type () allocaWords :: forall a m . (Storable a, MonadAnyCont IO m, Monad m, MonadIO m) => Word32 -> m (Ptr a) allocaWords nBits = do @@ -96,15 +95,7 @@ instance EncodeM EncodeAST A.Constant (Ptr FFI.Constant) where A.F.PPC_FP128 _ _ -> FFI.floatSemanticsPPCDoubleDouble nBits <- encodeM nBits liftIO $ FFI.constantFloatOfArbitraryPrecision context nBits words fpSem - A.C.GlobalReference ty n -> do - ref <- FFI.upCast <$> referGlobal n - ty' <- (liftIO . runDecodeAST . typeOf) ref - renamedTy <- renameType ty - if renamedTy /= ty' - then throwM - (EncodeException - ("The serialized GlobalReference " ++ show n ++ " has type " ++ show ty ++ " but should have type " ++ show ty')) - else return ref + A.C.GlobalReference n -> FFI.upCast <$> referGlobal n A.C.BlockAddress f b -> do f' <- referGlobal f b' <- getBlockForAddress f b @@ -204,9 +195,7 @@ instance DecodeM DecodeAST A.Constant (Ptr FFI.Constant) where t <- decodeM ft valueSubclassId <- liftIO $ FFI.getValueSubclassId v nOps <- liftIO $ FFI.getNumOperands u - let globalRef = return A.C.GlobalReference - `ap` (return t) - `ap` (getGlobalName =<< liftIO (FFI.isAGlobalValue v)) + let globalRef = A.C.GlobalReference <$> (getGlobalName =<< liftIO (FFI.isAGlobalValue v)) op = decodeM <=< liftIO . FFI.getConstantOperand c getConstantOperands = mapM op [0..nOps-1] getConstantData = do @@ -281,6 +270,8 @@ instance DecodeM DecodeAST A.Constant (Ptr FFI.Constant) where operandNumber <- get modify (+1) return [| op $(TH.litE . TH.integerL $ operandNumber) |] + | h == ''A.Type && n == 'A.C.GetElementPtr -> + return [| decodeM =<< liftIO (FFI.getConstantGEPSourceType c) |] | h == ''A.Type -> return [| pure t |] | h == ''A.IntegerPredicate -> return [| liftIO $ decodeM =<< FFI.getConstantICmpPredicate c |] diff --git a/llvm-hs/src/LLVM/Internal/Context.hs b/llvm-hs/src/LLVM/Internal/Context.hs index e2352cd3..5b89ec03 100644 --- a/llvm-hs/src/LLVM/Internal/Context.hs +++ b/llvm-hs/src/LLVM/Internal/Context.hs @@ -14,14 +14,20 @@ import qualified LLVM.Internal.FFI.Context as FFI -- | Then it got packed up in this object to allow multiple threads to compile at once. data Context = Context (Ptr FFI.Context) +contextCreate :: IO (Ptr FFI.Context) +contextCreate = do + ctx <- FFI.contextCreate + FFI.contextSetOpaquePointers ctx + return ctx + -- | Create a Context, run an action (to which it is provided), then destroy the Context. withContext :: (Context -> IO a) -> IO a -withContext = runBound . bracket FFI.contextCreate FFI.contextDispose . (. Context) +withContext = runBound . bracket contextCreate FFI.contextDispose . (. Context) where runBound = if rtsSupportsBoundThreads then runInBoundThread else id -- | Create a Context. createContext :: IO Context -createContext = Context <$> FFI.contextCreate +createContext = Context <$> contextCreate -- | Destroy a context created by 'createContext'. disposeContext :: Context -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/Builder.hs b/llvm-hs/src/LLVM/Internal/FFI/Builder.hs index 54a602c1..0626c09a 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Builder.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Builder.hs @@ -39,8 +39,8 @@ foreign import ccall unsafe "LLVMBuildSwitch" buildSwitch :: foreign import ccall unsafe "LLVMBuildIndirectBr" buildIndirectBr :: Ptr Builder -> Ptr Value -> CUInt -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVMBuildInvoke" buildInvoke :: - Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt +foreign import ccall unsafe "LLVMBuildInvoke2" buildInvoke :: + Ptr Builder -> Ptr Type -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> Ptr BasicBlock -> Ptr BasicBlock -> CString -> IO (Ptr Instruction) foreign import ccall unsafe "LLVMBuildResume" buildResume :: @@ -158,10 +158,10 @@ foreign import ccall unsafe "LLVMBuildArrayAlloca" buildAlloca :: Ptr Builder -> Ptr Type -> Ptr Value -> CString -> IO (Ptr Instruction) foreign import ccall unsafe "LLVM_Hs_BuildLoad" buildLoad' :: - Ptr Builder -> LLVMBool -> Ptr Value -> MemoryOrdering -> SynchronizationScope -> CUInt -> CString -> IO (Ptr Instruction) + Ptr Builder -> LLVMBool -> Ptr Type -> Ptr Value -> MemoryOrdering -> SynchronizationScope -> CUInt -> CString -> IO (Ptr Instruction) -buildLoad :: Ptr Builder -> LLVMBool -> Ptr Value -> (SynchronizationScope, MemoryOrdering) -> CUInt -> CString -> IO (Ptr Instruction) -buildLoad builder vol a' (ss, mo) al s = buildLoad' builder vol a' mo ss al s +buildLoad :: Ptr Builder -> LLVMBool -> Ptr Type -> Ptr Value -> (SynchronizationScope, MemoryOrdering) -> CUInt -> CString -> IO (Ptr Instruction) +buildLoad builder vol ty a' (ss, mo) al s = buildLoad' builder vol ty a' mo ss al s foreign import ccall unsafe "LLVM_Hs_BuildStore" buildStore' :: Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> MemoryOrdering -> SynchronizationScope -> CUInt -> CString -> IO (Ptr Instruction) @@ -170,15 +170,15 @@ buildStore :: Ptr Builder -> LLVMBool -> Ptr Value -> Ptr Value -> (Synchronizat buildStore builder vol a' v' (ss, mo) al s = buildStore' builder vol a' v' mo ss al s foreign import ccall unsafe "LLVM_Hs_BuildGEP" buildGetElementPtr' :: - Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) + Ptr Builder -> Ptr Type -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) foreign import ccall unsafe "LLVM_Hs_BuildInBoundsGEP" buildInBoundsGetElementPtr' :: - Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) + Ptr Builder -> Ptr Type -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) -buildGetElementPtr :: HasCallStack => Ptr Builder -> LLVMBool -> Ptr Value -> (CUInt, Ptr (Ptr Value)) -> CString -> IO (Ptr Instruction) -buildGetElementPtr builder (LLVMBool 1) a (n, is) s = buildInBoundsGetElementPtr' builder a is n s -buildGetElementPtr builder (LLVMBool 0) a (n, is) s = buildGetElementPtr' builder a is n s -buildGetElementPtr _ (LLVMBool i) _ _ _ = error ("LLVMBool should be 0 or 1 but is " <> show i) +buildGetElementPtr :: HasCallStack => Ptr Builder -> LLVMBool -> Ptr Type -> Ptr Value -> (CUInt, Ptr (Ptr Value)) -> CString -> IO (Ptr Instruction) +buildGetElementPtr builder (LLVMBool 1) ty a (n, is) s = buildInBoundsGetElementPtr' builder ty a is n s +buildGetElementPtr builder (LLVMBool 0) ty a (n, is) s = buildGetElementPtr' builder ty a is n s +buildGetElementPtr _ (LLVMBool i) _ _ _ _ = error ("LLVMBool should be 0 or 1 but is " <> show i) foreign import ccall unsafe "LLVM_Hs_BuildFence" buildFence' :: Ptr Builder -> MemoryOrdering -> SynchronizationScope -> CString -> IO (Ptr Instruction) @@ -207,8 +207,8 @@ foreign import ccall unsafe "LLVMBuildFCmp" buildFCmp :: foreign import ccall unsafe "LLVMBuildPhi" buildPhi :: Ptr Builder -> Ptr Type -> CString -> IO (Ptr Instruction) -foreign import ccall unsafe "LLVMBuildCall" buildCall :: - Ptr Builder -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) +foreign import ccall unsafe "LLVMBuildCall2" buildCall :: + Ptr Builder -> Ptr Type -> Ptr Value -> Ptr (Ptr Value) -> CUInt -> CString -> IO (Ptr Instruction) foreign import ccall unsafe "LLVMBuildFreeze" buildFreeze :: Ptr Builder -> Ptr Value -> Ptr Type -> IO (Ptr Instruction) diff --git a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp index 56361e05..d02c04bb 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/BuilderC.cpp @@ -51,11 +51,6 @@ LLVM_HS_FOR_EACH_FAST_MATH_FLAG(ENUM_CASE) #undef ENUM_CASE return r; } - -// TODO: Pass in pointee types when building GEPs and remove this. -static llvm::Type* getPointeeType(LLVMValueRef ptr) { - return unwrap(ptr)->getType()->getPointerElementType(); -} } extern "C" { @@ -298,6 +293,7 @@ LLVMValueRef LLVM_Hs_BuildICmp(LLVMBuilderRef b, LLVMIntPredicate op, LLVMValueR LLVMValueRef LLVM_Hs_BuildLoad( LLVMBuilderRef b, LLVMBool isVolatile, + LLVMTypeRef ty, LLVMValueRef p, LLVMAtomicOrdering atomicOrdering, LLVMSynchronizationScope synchScope, @@ -305,8 +301,7 @@ LLVMValueRef LLVM_Hs_BuildLoad( const char *name ) { LoadInst *i = unwrap(b)->CreateAlignedLoad( - unwrap(p)->getType()->getPointerElementType(), - unwrap(p), MaybeAlign(align), isVolatile, name); + unwrap(ty), unwrap(p), MaybeAlign(align), isVolatile, name); i->setOrdering(unwrap(atomicOrdering)); if (atomicOrdering != LLVMAtomicOrderingNotAtomic) i->setSyncScopeID(unwrap(synchScope)); return wrap(i); @@ -418,23 +413,23 @@ LLVMValueRef LLVM_Hs_BuildCatchSwitch(LLVMBuilderRef b, LLVMValueRef parentPad, unwrap(unwindDest), numHandlers)); } -LLVMValueRef LLVM_Hs_BuildGEP(LLVMBuilderRef B, LLVMValueRef Pointer, +LLVMValueRef LLVM_Hs_BuildGEP(LLVMBuilderRef B, LLVMTypeRef PointeeType, LLVMValueRef Pointer, LLVMValueRef *Indices, unsigned NumIndices, const char *Name) { ArrayRef IdxList(unwrap(Indices), NumIndices); return wrap( - unwrap(B)->Insert(GetElementPtrInst::Create(getPointeeType(Pointer), + unwrap(B)->Insert(GetElementPtrInst::Create(unwrap(PointeeType), unwrap(Pointer), IdxList), Name)); } -LLVMValueRef LLVM_Hs_BuildInBoundsGEP(LLVMBuilderRef B, LLVMValueRef Pointer, +LLVMValueRef LLVM_Hs_BuildInBoundsGEP(LLVMBuilderRef B, LLVMTypeRef PointeeType, LLVMValueRef Pointer, LLVMValueRef *Indices, unsigned NumIndices, const char *Name) { ArrayRef IdxList(unwrap(Indices), NumIndices); return wrap( unwrap(B)->Insert(GetElementPtrInst::CreateInBounds( - getPointeeType(Pointer), unwrap(Pointer), IdxList), + unwrap(PointeeType), unwrap(Pointer), IdxList), Name)); } diff --git a/llvm-hs/src/LLVM/Internal/FFI/Constant.hs b/llvm-hs/src/LLVM/Internal/FFI/Constant.hs index ae46338e..764abde4 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Constant.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Constant.hs @@ -107,19 +107,22 @@ $(do foreignDecl (prefix ++ "Const" ++ name) ("constant" ++ name) (map typeMapping fieldTypes) [t| Ptr Constant |] ) -foreign import ccall unsafe "LLVMConstGEP" constantGetElementPtr' :: - Ptr Constant -> Ptr (Ptr Constant) -> CUInt -> IO (Ptr Constant) +foreign import ccall unsafe "LLVMConstGEP2" constantGetElementPtr' :: + Ptr Type -> Ptr Constant -> Ptr (Ptr Constant) -> CUInt -> IO (Ptr Constant) -foreign import ccall unsafe "LLVMConstInBoundsGEP" constantInBoundsGetElementPtr' :: - Ptr Constant -> Ptr (Ptr Constant) -> CUInt -> IO (Ptr Constant) +foreign import ccall unsafe "LLVMConstInBoundsGEP2" constantInBoundsGetElementPtr' :: + Ptr Type -> Ptr Constant -> Ptr (Ptr Constant) -> CUInt -> IO (Ptr Constant) -constantGetElementPtr :: LLVMBool -> Ptr Constant -> (CUInt, Ptr (Ptr Constant)) -> IO (Ptr Constant) -constantGetElementPtr (LLVMBool ib) a (n, is) = +constantGetElementPtr :: LLVMBool -> Ptr Type -> Ptr Constant -> (CUInt, Ptr (Ptr Constant)) -> IO (Ptr Constant) +constantGetElementPtr (LLVMBool ib) ty a (n, is) = (case ib of 0 -> constantGetElementPtr' 1 -> constantInBoundsGetElementPtr' _ -> error ("LLVMBool should be 0 or 1 but is " <> show ib) - ) a is n + ) ty a is n + +foreign import ccall unsafe "LLVM_Hs_GetConstGEPSourceType" getConstantGEPSourceType :: + Ptr Constant -> IO (Ptr Type) foreign import ccall unsafe "LLVM_Hs_GetConstCPPOpcode" getConstantCPPOpcode :: Ptr Constant -> IO CPPOpcode diff --git a/llvm-hs/src/LLVM/Internal/FFI/ConstantC.cpp b/llvm-hs/src/LLVM/Internal/FFI/ConstantC.cpp index d22c52ce..2e5f6f7c 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/ConstantC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/ConstantC.cpp @@ -2,6 +2,7 @@ #include "llvm/IR/LLVMContext.h" #include "llvm/IR/Constants.h" #include "llvm/IR/Function.h" +#include "llvm/IR/Operator.h" #include "llvm-c/Core.h" #include "LLVM/Internal/FFI/Value.h" @@ -127,5 +128,8 @@ LLVMValueRef LLVM_Hs_GetConstTokenNone(LLVMContextRef context) { return wrap(ConstantTokenNone::get(*unwrap(context))); } +LLVMTypeRef LLVM_Hs_GetConstGEPSourceType(LLVMValueRef v) { + return wrap(unwrap(v)->getSourceElementType()); +} } diff --git a/llvm-hs/src/LLVM/Internal/FFI/Context.hs b/llvm-hs/src/LLVM/Internal/FFI/Context.hs index 8fd08bb7..1af18d4f 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Context.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Context.hs @@ -23,6 +23,9 @@ foreign import ccall unsafe "LLVMContextCreate" contextCreate :: foreign import ccall unsafe "LLVMGetGlobalContext" getGlobalContext :: IO (Ptr Context) +foreign import ccall unsafe "LLVM_Hs_SetOpaquePointers" contextSetOpaquePointers :: + Ptr Context -> IO () + -- | foreign import ccall unsafe "LLVMContextDispose" contextDispose :: Ptr Context -> IO () diff --git a/llvm-hs/src/LLVM/Internal/FFI/ContextC.cpp b/llvm-hs/src/LLVM/Internal/FFI/ContextC.cpp new file mode 100644 index 00000000..4b313c20 --- /dev/null +++ b/llvm-hs/src/LLVM/Internal/FFI/ContextC.cpp @@ -0,0 +1,13 @@ +#define __STDC_LIMIT_MACROS +#include "llvm-c/Core.h" +#include "llvm/IR/LLVMContext.h" + +using namespace llvm; + +extern "C" { + +void LLVM_Hs_SetOpaquePointers(LLVMContextRef context) { + unwrap(context)->setOpaquePointers(true); +} + +} diff --git a/llvm-hs/src/LLVM/Internal/FFI/GlobalValue.hs b/llvm-hs/src/LLVM/Internal/FFI/GlobalValue.hs index f745a463..c8f7013e 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/GlobalValue.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/GlobalValue.hs @@ -13,12 +13,19 @@ import Foreign.C import LLVM.Internal.FFI.PtrHierarchy import LLVM.Internal.FFI.LLVMCTypes +import LLVM.Internal.FFI.Type data COMDAT foreign import ccall unsafe "LLVMIsAGlobalValue" isAGlobalValue :: Ptr Value -> IO (Ptr GlobalValue) +foreign import ccall unsafe "LLVM_Hs_GetGlobalValueType" getGlobalValueType :: + Ptr GlobalValue -> IO (Ptr Type) + +foreign import ccall unsafe "LLVM_Hs_GetGlobalValueAddressSpace" getGlobalValueAddressSpace :: + Ptr GlobalValue -> IO AddrSpace + foreign import ccall unsafe "LLVMGetLinkage" getLinkage :: Ptr GlobalValue -> IO Linkage diff --git a/llvm-hs/src/LLVM/Internal/FFI/GlobalValueC.cpp b/llvm-hs/src/LLVM/Internal/FFI/GlobalValueC.cpp index 1681463d..7474f251 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/GlobalValueC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/GlobalValueC.cpp @@ -1,5 +1,6 @@ #define __STDC_LIMIT_MACROS #include "llvm/IR/Comdat.h" +#include "llvm/IR/Type.h" #include "llvm/IR/GlobalValue.h" #include "llvm/IR/GlobalObject.h" #include "llvm/IR/Metadata.h" @@ -78,4 +79,12 @@ void LLVM_Hs_GlobalObject_SetMetadata(GlobalObject* obj, unsigned kind, MDNode* obj->setMetadata(kind, node); } +LLVMTypeRef LLVM_Hs_GetGlobalValueType(LLVMValueRef v) { + return wrap(unwrap(v)->getValueType()); +} + +unsigned LLVM_Hs_GetGlobalValueAddressSpace(LLVMValueRef v) { + return unwrap(v)->getAddressSpace(); +} + } diff --git a/llvm-hs/src/LLVM/Internal/FFI/InlineAssembly.hs b/llvm-hs/src/LLVM/Internal/FFI/InlineAssembly.hs index f1797775..37c5e133 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/InlineAssembly.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/InlineAssembly.hs @@ -33,3 +33,5 @@ foreign import ccall unsafe "LLVM_Hs_InlineAsmIsAlignStack" inlineAsmIsAlignStac foreign import ccall unsafe "LLVM_Hs_GetInlineAsmDialect" getInlineAsmDialect :: Ptr InlineAsm -> IO AsmDialect +foreign import ccall unsafe "LLVM_Hs_GetInlineAsmFunctionType" getInlineAsmFunctionType :: + Ptr InlineAsm -> IO (Ptr Type) diff --git a/llvm-hs/src/LLVM/Internal/FFI/InlineAssemblyC.cpp b/llvm-hs/src/LLVM/Internal/FFI/InlineAssemblyC.cpp index 92533904..cbabe76b 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/InlineAssemblyC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/InlineAssemblyC.cpp @@ -39,7 +39,7 @@ LLVMValueRef LLVM_Hs_CreateInlineAsm( ) { return wrap( InlineAsm::get( - unwrap(t), + unwrap(t), asmStr, constraintsStr, hasSideEffects, @@ -69,5 +69,8 @@ LLVMAsmDialect LLVM_Hs_GetInlineAsmDialect(LLVMValueRef v) { return wrap(unwrap(v)->getDialect()); } +LLVMTypeRef LLVM_Hs_GetInlineAsmFunctionType(LLVMValueRef v) { + return wrap(unwrap(v)->getFunctionType()); } +} diff --git a/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs b/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs index 7719c4e4..14c2d2df 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Instruction.hs @@ -49,6 +49,12 @@ foreign import ccall unsafe "LLVM_Hs_SetTailCallKind" setTailCallKind :: foreign import ccall unsafe "LLVMGetCalledValue" getCallSiteCalledValue :: Ptr Instruction -> IO (Ptr Value) +foreign import ccall unsafe "LLVMGetCalledFunctionType" getCalledFunctionType :: + Ptr Instruction -> IO (Ptr Type) + +foreign import ccall unsafe "LLVMGetGEPSourceElementType" getGEPSourceElementType :: + Ptr Instruction -> IO (Ptr Type) + foreign import ccall unsafe "LLVMGetNumArgOperands" getCallSiteNumArgOperands :: Ptr Instruction -> IO CUInt diff --git a/llvm-hs/src/LLVM/Internal/FFI/Type.hs b/llvm-hs/src/LLVM/Internal/FFI/Type.hs index 96e13c0b..73ab48f6 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Type.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Type.hs @@ -57,6 +57,12 @@ newtype AddrSpace = AddrSpace CUInt foreign import ccall unsafe "LLVMPointerType" pointerType :: Ptr Type -> AddrSpace -> IO (Ptr Type) +foreign import ccall unsafe "LLVM_Hs_OpaquePointerType" opaquePointerType :: + Ptr Context -> AddrSpace -> IO (Ptr Type) + +foreign import ccall unsafe "LLVM_Hs_IsOpaquePointerType" isOpaquePointerType :: + Ptr Type -> IO LLVMBool + -- | foreign import ccall unsafe "LLVMGetPointerAddressSpace" getPointerAddressSpace :: Ptr Type -> IO AddrSpace diff --git a/llvm-hs/src/LLVM/Internal/FFI/TypeC.cpp b/llvm-hs/src/LLVM/Internal/FFI/TypeC.cpp index 1ca661da..8d529e9e 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/TypeC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/TypeC.cpp @@ -24,6 +24,14 @@ LLVMTypeRef LLVM_Hs_ArrayType(LLVMTypeRef ElementType, uint64_t ElementCount) { return wrap(ArrayType::get(unwrap(ElementType), ElementCount)); } +LLVMTypeRef LLVM_Hs_OpaquePointerType(LLVMContextRef C, unsigned AddrSpace) { + return wrap(PointerType::get(*unwrap(C), AddrSpace)); +} + +LLVMBool LLVM_Hs_IsOpaquePointerType(LLVMTypeRef type) { + return unwrap(type)->isOpaquePointerTy(); +} + uint64_t LLVM_Hs_GetArrayLength(LLVMTypeRef ArrayTy) { return unwrap(ArrayTy)->getNumElements(); } diff --git a/llvm-hs/src/LLVM/Internal/FFI/Value.hs b/llvm-hs/src/LLVM/Internal/FFI/Value.hs index fcd88ebb..88f739d3 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Value.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Value.hs @@ -27,7 +27,7 @@ foreign import ccall unsafe "LLVMSetValueName" setValueName :: Ptr Value -> CString -> IO () -- | This function exposes the ID returned by llvm::Value::getValueID() --- | . +-- | . foreign import ccall unsafe "LLVM_Hs_GetValueSubclassId" getValueSubclassId :: Ptr Value -> IO ValueSubclassId diff --git a/llvm-hs/src/LLVM/Internal/Global.hs b/llvm-hs/src/LLVM/Internal/Global.hs index b56c3e0b..fe48fdff 100644 --- a/llvm-hs/src/LLVM/Internal/Global.hs +++ b/llvm-hs/src/LLVM/Internal/Global.hs @@ -19,6 +19,7 @@ import qualified LLVM.Internal.FFI.GlobalValue as FFI import LLVM.Internal.Coding import LLVM.Internal.DecodeAST import LLVM.Internal.EncodeAST +import LLVM.Internal.Type () import qualified LLVM.AST.Linkage as A.L import qualified LLVM.AST.Visibility as A.V @@ -26,6 +27,7 @@ import qualified LLVM.AST.COMDAT as A.COMDAT import qualified LLVM.AST.DLL as A.DLL import qualified LLVM.AST.ThreadLocalStorage as A.TLS import qualified LLVM.AST.Global as A.G +import qualified LLVM.AST.Type as A.T genCodingInstance [t| A.L.Linkage |] ''FFI.Linkage [ (FFI.linkageExternal, A.L.External), @@ -46,7 +48,7 @@ getLinkage g = liftIO $ decodeM =<< FFI.getLinkage (FFI.upCast g) setLinkage :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> A.L.Linkage -> EncodeAST () setLinkage g l = liftIO . FFI.setLinkage (FFI.upCast g) =<< encodeM l - + genCodingInstance [t| A.V.Visibility |] ''FFI.Visibility [ (FFI.visibilityDefault, A.V.Default), (FFI.visibilityHidden, A.V.Hidden), @@ -146,3 +148,6 @@ genCodingInstance [t| Maybe A.G.UnnamedAddr |] ''FFI.UnnamedAddr [ (FFI.unnamedAddrLocal, Just A.G.LocalAddr), (FFI.unnamedAddrGlobal, Just A.G.GlobalAddr) ] + +typeOfGlobal :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST A.T.Type +typeOfGlobal = decodeM <=< liftIO . FFI.getGlobalValueType . FFI.upCast diff --git a/llvm-hs/src/LLVM/Internal/InlineAssembly.hs b/llvm-hs/src/LLVM/Internal/InlineAssembly.hs index 4901ea36..39a11c5a 100644 --- a/llvm-hs/src/LLVM/Internal/InlineAssembly.hs +++ b/llvm-hs/src/LLVM/Internal/InlineAssembly.hs @@ -4,7 +4,7 @@ OverloadedStrings #-} module LLVM.Internal.InlineAssembly where - + import LLVM.Prelude import Control.Monad.IO.Class @@ -21,12 +21,11 @@ import qualified LLVM.Internal.FFI.PtrHierarchy as FFI import qualified LLVM.AST as A (Definition(..)) import qualified LLVM.AST.InlineAssembly as A -import qualified LLVM.AST.Type as A -import LLVM.Internal.Coding +import LLVM.Internal.Coding import LLVM.Internal.EncodeAST import LLVM.Internal.DecodeAST -import LLVM.Internal.Value +import LLVM.Internal.Type () genCodingInstance [t| A.Dialect |] ''FFI.AsmDialect [ (FFI.asmDialectATT, A.ATTDialect), @@ -53,7 +52,7 @@ instance EncodeM EncodeAST A.InlineAssembly (Ptr FFI.InlineAsm) where instance DecodeM DecodeAST A.InlineAssembly (Ptr FFI.InlineAsm) where decodeM p = do return A.InlineAssembly - `ap` (liftM (\(A.PointerType f _) -> f) (typeOf p)) + `ap` (decodeM =<< liftIO (FFI.getInlineAsmFunctionType p)) `ap` (decodeM =<< liftIO (FFI.getInlineAsmAssemblyString p)) `ap` (decodeM =<< liftIO (FFI.getInlineAsmConstraintString p)) `ap` (decodeM =<< liftIO (FFI.inlineAsmHasSideEffects p)) diff --git a/llvm-hs/src/LLVM/Internal/Instruction.hs b/llvm-hs/src/LLVM/Internal/Instruction.hs index d91f9325..39f45a75 100644 --- a/llvm-hs/src/LLVM/Internal/Instruction.hs +++ b/llvm-hs/src/LLVM/Internal/Instruction.hs @@ -137,6 +137,7 @@ instance DecodeM DecodeAST A.Terminator (Ptr FFI.Instruction) where cc <- decodeM =<< liftIO (FFI.getCallSiteCallingConvention i) attrs <- callInstAttributeList i fv <- liftIO $ FFI.getCallSiteCalledValue i + ty <- decodeM =<< liftIO (FFI.getCalledFunctionType i) f <- decodeM fv let argIndices = if nOps >= 4 then [0 .. nOps - 4] else [] args <- @@ -147,6 +148,7 @@ instance DecodeM DecodeAST A.Terminator (Ptr FFI.Instruction) where return A.Invoke { A.callingConvention' = cc, A.returnAttributes' = returnAttributes attrs, + A.type'' = ty, A.function' = f, A.arguments' = args, A.functionAttributes' = functionAttributes attrs, @@ -236,6 +238,7 @@ instance EncodeM EncodeAST A.Terminator (Ptr FFI.Instruction) where A.Invoke { A.callingConvention' = cc, A.returnAttributes' = rAttrs, + A.type'' = ty, A.function' = fun, A.arguments' = args, A.functionAttributes' = fAttrs, @@ -243,11 +246,12 @@ instance EncodeM EncodeAST A.Terminator (Ptr FFI.Instruction) where A.exceptionDest = ed } -> do fv <- encodeM fun + tb <- encodeM ty rb <- encodeM rd eb <- encodeM ed let (argvs, argAttrs) = unzip args (n, argvs) <- encodeM argvs - i <- liftIO $ FFI.buildInvoke builder fv argvs n rb eb s + i <- liftIO $ FFI.buildInvoke builder tb fv argvs n rb eb s attrs <- encodeM $ AttributeList fAttrs rAttrs argAttrs liftIO $ FFI.setCallSiteAttributeList i attrs cc <- encodeM cc @@ -360,7 +364,10 @@ $(do t <- typeOf v return $ case t of { A.ArrayType _ _ -> A.Filter; _ -> A.Catch} $ c |]) "functionAttributes" -> (["attrs"], [| return $ functionAttributes $(TH.dyn "attrs") |]) - "type'" -> ([], [| return t |]) + "type'" -> ([], case lrn of + "GetElementPtr" -> [| decodeM =<< liftIO (FFI.getGEPSourceElementType i) |] + "Call" -> [| decodeM =<< liftIO (FFI.getCalledFunctionType i) |] + _ -> [| return t |]) "incomingValues" -> ([], [| do n <- liftIO $ FFI.countIncoming i @@ -476,6 +483,7 @@ $(do A.tailCallKind = tck, A.callingConvention = cc, A.returnAttributes = rAttrs, + A.type' = ty, A.function = f, A.arguments = args, A.functionAttributes = fAttrs @@ -483,7 +491,8 @@ $(do fv <- encodeM f let (argvs, argAttrs) = unzip args (n, argvs) <- encodeM argvs - i <- liftIO $ FFI.buildCall builder fv argvs n s + tb <- encodeM ty + i <- liftIO $ FFI.buildCall builder tb fv argvs n s attrs <- encodeM $ AttributeList fAttrs rAttrs argAttrs liftIO $ FFI.setCallSiteAttributeList i attrs tck <- encodeM tck diff --git a/llvm-hs/src/LLVM/Internal/Module.hs b/llvm-hs/src/LLVM/Internal/Module.hs index 4023b6fb..ebae63d8 100644 --- a/llvm-hs/src/LLVM/Internal/Module.hs +++ b/llvm-hs/src/LLVM/Internal/Module.hs @@ -48,6 +48,7 @@ import LLVM.Internal.DecodeAST import LLVM.Internal.EncodeAST import LLVM.Internal.Function import LLVM.Internal.Global +import LLVM.Internal.Type import LLVM.Internal.Instruction () import qualified LLVM.Internal.MemoryBuffer as MB import LLVM.Internal.Metadata @@ -55,8 +56,6 @@ import LLVM.Internal.Operand import LLVM.Internal.RawOStream import LLVM.Internal.String import LLVM.Internal.Target -import LLVM.Internal.Type -import LLVM.Internal.Value import LLVM.DataLayout import LLVM.Exception @@ -399,7 +398,8 @@ decodeGlobalVariables :: Ptr FFI.Module -> DecodeAST (DecodeAST [A.G.Global]) decodeGlobalVariables mod = do ffiGlobals <- liftIO $ FFI.getXs (FFI.getFirstGlobal mod) FFI.getNextGlobal fmap sequence . forM ffiGlobals $ \g -> do - A.PointerType t as <- typeOf g + t <- typeOfGlobal g + as <- decodeM =<< (liftIO $ FFI.getGlobalValueAddressSpace $ FFI.upCast g) n <- getGlobalName g return $ A.GlobalVariable @@ -429,7 +429,8 @@ decodeGlobalAliases mod = do ffiAliases <- liftIO $ FFI.getXs (FFI.getFirstAlias mod) FFI.getNextAlias fmap sequence . forM ffiAliases $ \a -> do n <- getGlobalName a - A.PointerType t as <- typeOf a + t <- typeOfGlobal a + as <- decodeM =<< (liftIO $ FFI.getGlobalValueAddressSpace $ FFI.upCast a) return $ A.G.GlobalAlias <$> return n @@ -466,7 +467,7 @@ decodeFunctions mod = do liftIO $ FFI.getXs (FFI.getFirstFunction mod) FFI.getNextFunction fmap sequence . forM ffiFunctions $ \f -> localScope $ do - A.PointerType (A.FunctionType returnType _ isVarArg) _ <- typeOf f + A.FunctionType returnType _ isVarArg <- typeOfGlobal f n <- getGlobalName f AttributeList fAttrs rAttrs pAttrs <- getAttributeList f parameters <- getParameters f pAttrs diff --git a/llvm-hs/src/LLVM/Internal/Type.hs b/llvm-hs/src/LLVM/Internal/Type.hs index f631f2b2..0a7eb05e 100644 --- a/llvm-hs/src/LLVM/Internal/Type.hs +++ b/llvm-hs/src/LLVM/Internal/Type.hs @@ -78,10 +78,9 @@ instance EncodeM EncodeAST A.Type (Ptr FFI.Type) where argTypes <- encodeM argTypeASTs isVarArg <- encodeM isVarArg liftIO $ FFI.functionType returnType argTypes isVarArg - A.PointerType elementType addressSpace -> do - e <- encodeM elementType + A.PointerType addressSpace -> do a <- encodeM addressSpace - liftIO $ FFI.pointerType e a + liftIO $ FFI.opaquePointerType context a A.VoidType -> liftIO $ FFI.voidTypeInContext context A.FloatingPointType A.HalfFP -> liftIO $ FFI.halfTypeInContext context A.FloatingPointType A.FloatFP -> liftIO $ FFI.floatTypeInContext context @@ -122,10 +121,9 @@ instance DecodeM DecodeAST A.Type (Ptr FFI.Type) where decodeM (n, ts) ) `ap` (decodeM =<< liftIO (FFI.isFunctionVarArg t)) - [typeKindP|Pointer|] -> - return A.PointerType - `ap` (decodeM =<< liftIO (FFI.getElementType t)) - `ap` (decodeM =<< liftIO (FFI.getPointerAddressSpace t)) + [typeKindP|Pointer|] -> do + addrSpace <- decodeM =<< liftIO (FFI.getPointerAddressSpace t) + return $ A.PointerType addrSpace [typeKindP|Half|] -> return $ A.FloatingPointType A.HalfFP [typeKindP|Float|] -> return $ A.FloatingPointType A.FloatFP [typeKindP|Double|] -> return $ A.FloatingPointType A.DoubleFP @@ -166,7 +164,7 @@ createNamedType n = do renameType :: A.Type -> EncodeAST A.Type renameType A.VoidType = pure A.VoidType renameType t@(A.IntegerType _) = pure t -renameType (A.PointerType r a) = fmap (\r' -> A.PointerType r' a) (renameType r) +renameType t@(A.PointerType _) = pure t renameType t@(A.FloatingPointType _) = pure t renameType (A.FunctionType r as varArg) = liftA2 diff --git a/llvm-hs/src/LLVM/Internal/Value.hs b/llvm-hs/src/LLVM/Internal/Value.hs index fdf65e85..1f35efd3 100644 --- a/llvm-hs/src/LLVM/Internal/Value.hs +++ b/llvm-hs/src/LLVM/Internal/Value.hs @@ -14,10 +14,9 @@ import qualified LLVM.Internal.FFI.Value as FFI import LLVM.Internal.Coding import LLVM.Internal.DecodeAST -import LLVM.Internal.Type () +import LLVM.Internal.Type () import qualified LLVM.AST.Type as A typeOf :: FFI.DescendentOf FFI.Value v => Ptr v -> DecodeAST A.Type typeOf = decodeM <=< liftIO . FFI.typeOf . FFI.upCast - diff --git a/llvm-hs/test/LLVM/Test/Analysis.hs b/llvm-hs/test/LLVM/Test/Analysis.hs index 93d79e5d..f983fc24 100644 --- a/llvm-hs/test/LLVM/Test/Analysis.hs +++ b/llvm-hs/test/LLVM/Test/Analysis.hs @@ -38,8 +38,8 @@ tests = testGroup "Analysis" [ GlobalDefinition $ Function L.External V.Default CC.C [] A.T.void (Name "foo") ([ Parameter i32 (Name "x") [] ],False) - [] - Nothing 0 Nothing + [] + Nothing 0 Nothing [ BasicBlock (UnName 0) [ UnName 1 := Call { @@ -71,31 +71,33 @@ tests = testGroup "Analysis" [ let str = "; ModuleID = ''\n\ \source_filename = \"\"\n\ \\n\ - \define double @my_function2(double* %input_0) {\n\ + \define double @my_function2(ptr %input_0) {\n\ \foo:\n\ - \ %tmp_input_w0 = getelementptr inbounds double, double* %input_0, i64 0\n\ - \ %0 = load double, double* %tmp_input_w0, align 8\n\ + \ %tmp_input_w0 = getelementptr inbounds double, ptr %input_0, i64 0\n\ + \ %0 = load double, ptr %tmp_input_w0, align 8\n\ \ ret double %0\n\ \}\n" - ast = + ast = Module "" "" Nothing Nothing [ GlobalDefinition $ functionDefaults { G.returnType = double, G.name = Name "my_function2", G.parameters = ([ - Parameter (ptr double) (Name "input_0") [] + Parameter ptr (Name "input_0") [] ],False), G.basicBlocks = [ - BasicBlock (Name "foo") [ + BasicBlock (Name "foo") [ Name "tmp_input_w0" := GetElementPtr { inBounds = True, - address = LocalReference (ptr double) (Name "input_0"), + type' = double, + address = LocalReference ptr (Name "input_0"), indices = [ConstantOperand (C.Int 64 0)], metadata = [] }, UnName 0 := Load { volatile = False, - address = LocalReference (ptr double) (Name "tmp_input_w0"), + type' = double, + address = LocalReference ptr (Name "tmp_input_w0"), maybeAtomicity = Nothing, alignment = 8, metadata = [] diff --git a/llvm-hs/test/LLVM/Test/Attribute.hs b/llvm-hs/test/LLVM/Test/Attribute.hs index d91d1e6e..0fd81a84 100644 --- a/llvm-hs/test/LLVM/Test/Attribute.hs +++ b/llvm-hs/test/LLVM/Test/Attribute.hs @@ -49,17 +49,16 @@ moduleAst = { tailCallKind = Nothing , callingConvention = C , returnAttributes = [] + , type' = + FunctionType + { resultType = i32 + , argumentTypes = [] + , isVarArg = False + } , function = Right (ConstantOperand - (GlobalReference - (ptr - (FunctionType - { resultType = i32 - , argumentTypes = [] - , isVarArg = False - })) - ("f"))) + (GlobalReference "f")) , arguments = [] , functionAttributes = [Left (GroupID 0)] , metadata = [] diff --git a/llvm-hs/test/LLVM/Test/Constants.hs b/llvm-hs/test/LLVM/Test/Constants.hs index 269ea572..f02e27c2 100644 --- a/llvm-hs/test/LLVM/Test/Constants.hs +++ b/llvm-hs/test/LLVM/Test/Constants.hs @@ -117,44 +117,44 @@ tests = testGroup "Constants" [ ), ( "binop/cast", i64, - C.Add False False (C.PtrToInt (C.GlobalReference (ptr i32) (UnName 1)) i64) (C.Int 64 2), - "global i64 add (i64 ptrtoint (i32* @1 to i64), i64 2)" + C.Add False False (C.PtrToInt (C.GlobalReference (UnName 1)) i64) (C.Int 64 2), + "global i64 add (i64 ptrtoint (ptr @1 to i64), i64 2)" ), ( "binop/cast nsw", i64, - C.Add True False (C.PtrToInt (C.GlobalReference (ptr i32) (UnName 1)) i64) (C.Int 64 2), - "global i64 add nsw (i64 ptrtoint (i32* @1 to i64), i64 2)" + C.Add True False (C.PtrToInt (C.GlobalReference (UnName 1)) i64) (C.Int 64 2), + "global i64 add nsw (i64 ptrtoint (ptr @1 to i64), i64 2)" ), ( "icmp", i1, - C.ICmp IPred.SGE (C.GlobalReference (ptr i32) (UnName 1)) (C.GlobalReference (ptr i32) (UnName 2)), - "global i1 icmp sge (i32* @1, i32* @2)" + C.ICmp IPred.SGE (C.GlobalReference (UnName 1)) (C.GlobalReference (UnName 2)), + "global i1 icmp sge (ptr @1, ptr @2)" ), ( "getelementptr", - ptr i32, - C.GetElementPtr True (C.GlobalReference (ptr i32) (UnName 1)) [C.Int 64 27], - "global i32* getelementptr inbounds (i32, i32* @1, i64 27)" + ptr, + C.GetElementPtr True i32 (C.GlobalReference (UnName 1)) [C.Int 64 27], + "global ptr getelementptr inbounds (i32, ptr @1, i64 27)" ), ( "selectvalue", i32, - C.Select (C.PtrToInt (C.GlobalReference (ptr i32) (UnName 1)) i1) + C.Select (C.PtrToInt (C.GlobalReference (UnName 1)) i1) (C.Int 32 1) (C.Int 32 2), - "global i32 select (i1 ptrtoint (i32* @1 to i1), i32 1, i32 2)" + "global i32 select (i1 ptrtoint (ptr @1 to i1), i32 1, i32 2)" ), ( "extractelement", i32, C.ExtractElement (C.BitCast - (C.PtrToInt (C.GlobalReference (ptr i32) (UnName 1)) i64) + (C.PtrToInt (C.GlobalReference (UnName 1)) i64) (VectorType 2 i32)) (C.Int 32 1), - "global i32 extractelement (<2 x i32> bitcast (i64 ptrtoint (i32* @1 to i64) to <2 x i32>), i32 1)" + "global i32 extractelement (<2 x i32> bitcast (i64 ptrtoint (ptr @1 to i64) to <2 x i32>), i32 1)" ), ( "addrspacecast", - (PointerType i32 (AddrSpace 1)), - C.AddrSpaceCast (C.GlobalReference (ptr i32) (UnName 1)) (PointerType i32 (AddrSpace 1)), - "global i32 addrspace(1)* addrspacecast (i32* @1 to i32 addrspace(1)*)" + (PointerType (AddrSpace 1)), + C.AddrSpaceCast (C.GlobalReference (UnName 1)) (PointerType (AddrSpace 1)), + "global ptr addrspace(1) addrspacecast (ptr @1 to ptr addrspace(1))" {- ), ( -- This test fails since LLVM 3.2! -- LLVM parses the extractValue instruction from a file via llvm-as properly, but it does not here. diff --git a/llvm-hs/test/LLVM/Test/InlineAssembly.hs b/llvm-hs/test/LLVM/Test/InlineAssembly.hs index 8eb3892d..782bec12 100644 --- a/llvm-hs/test/LLVM/Test/InlineAssembly.hs +++ b/llvm-hs/test/LLVM/Test/InlineAssembly.hs @@ -21,7 +21,7 @@ import qualified LLVM.AST.Global as G tests = testGroup "InlineAssembly" [ testCase "expression" $ do let ast = Module "" "" Nothing Nothing [ - GlobalDefinition $ + GlobalDefinition $ functionDefaults { G.returnType = i32, G.name = Name "foo", @@ -32,6 +32,7 @@ tests = testGroup "InlineAssembly" [ tailCallKind = Nothing, callingConvention = CC.C, returnAttributes = [], + LLVM.AST.type' = FunctionType i32 [i32] False, function = Left $ InlineAssembly { IA.type' = FunctionType i32 [i32] False, assembly = "bswap $0", diff --git a/llvm-hs/test/LLVM/Test/Instructions.hs b/llvm-hs/test/LLVM/Test/Instructions.hs index 20a933a1..ad241bdb 100644 --- a/llvm-hs/test/LLVM/Test/Instructions.hs +++ b/llvm-hs/test/LLVM/Test/Instructions.hs @@ -58,7 +58,7 @@ tests = testGroup "Instructions" [ mStr = "; ModuleID = ''\n\ \source_filename = \"\"\n\ \\n\ - \define void @0(i32 %0, float %1, i32* %2, i64 %3, i1 %4, <2 x i32> %5, { i32, i32 } %6) {\n\ + \define void @0(i32 %0, float %1, ptr %2, i64 %3, i1 %4, <2 x i32> %5, { i32, i32 } %6) {\n\ \ " <> namedInstrS <> "\n\ \ ret void\n\ \}\n" @@ -66,7 +66,7 @@ tests = testGroup "Instructions" [ | let ts = [ i32, float, - ptr i32, + ptr, i64, i1, VectorType 2 i32, @@ -288,55 +288,61 @@ tests = testGroup "Instructions" [ ("load", Load { volatile = False, + type' = i32, address = a 2, maybeAtomicity = Nothing, alignment = 4, metadata = [] }, - "load i32, i32* %2, align 4"), + "load i32, ptr %2, align 4"), ("volatile", Load { volatile = True, + type' = i32, address = a 2, maybeAtomicity = Nothing, alignment = 4, metadata = [] }, - "load volatile i32, i32* %2, align 4"), + "load volatile i32, ptr %2, align 4"), ("acquire", Load { volatile = False, + type' = i32, address = a 2, maybeAtomicity = Just (System, Acquire), alignment = 1, metadata = [] }, - "load atomic i32, i32* %2 acquire, align 1"), + "load atomic i32, ptr %2 acquire, align 1"), ("singlethread", Load { volatile = False, + type' = i32, address = a 2, maybeAtomicity = Just (SingleThread, Monotonic), alignment = 1, metadata = [] }, - "load atomic i32, i32* %2 syncscope(\"singlethread\") monotonic, align 1"), + "load atomic i32, ptr %2 syncscope(\"singlethread\") monotonic, align 1"), ("GEP", GetElementPtr { inBounds = False, + type' = i32, address = a 2, indices = [ a 0 ], metadata = [] }, - "getelementptr i32, i32* %2, i32 %0"), + "getelementptr i32, ptr %2, i32 %0"), ("inBounds", GetElementPtr { inBounds = True, + type' = i32, address = a 2, indices = [ a 0 ], metadata = [] }, - "getelementptr inbounds i32, i32* %2, i32 %0"), + "getelementptr inbounds i32, ptr %2, i32 %0"), ("cmpxchg", CmpXchg { volatile = False, @@ -348,7 +354,7 @@ tests = testGroup "Instructions" [ failureMemoryOrdering = Monotonic, metadata = [] }, - "cmpxchg i32* %2, i32 %0, i32 %0 monotonic monotonic, align 16"), + "cmpxchg ptr %2, i32 %0, i32 %0 monotonic monotonic, align 16"), ("atomicrmw", AtomicRMW { volatile = False, @@ -359,7 +365,7 @@ tests = testGroup "Instructions" [ atomicity = (System, Release), metadata = [] }, - "atomicrmw umax i32* %2, i32 %0 release, align 16"), + "atomicrmw umax ptr %2, i32 %0 release, align 16"), ("trunc", Trunc { @@ -430,14 +436,14 @@ tests = testGroup "Instructions" [ type' = i32, metadata = [] }, - "ptrtoint i32* %2 to i32"), + "ptrtoint ptr %2 to i32"), ("inttoptr", IntToPtr { operand0 = a 0, - type' = ptr i32, + type' = ptr, metadata = [] }, - "inttoptr i32 %0 to i32*"), + "inttoptr i32 %0 to ptr"), ("bitcast", BitCast { operand0 = a 0, @@ -448,10 +454,10 @@ tests = testGroup "Instructions" [ ("addrspacecast", AddrSpaceCast { operand0 = a 2, - type' = PointerType i32 (AddrSpace 2), + type' = PointerType (AddrSpace 2), metadata = [] }, - "addrspacecast i32* %2 to i32 addrspace(2)*"), + "addrspacecast ptr %2 to ptr addrspace(2)"), ("select", Select { condition' = a 4, @@ -466,7 +472,7 @@ tests = testGroup "Instructions" [ type' = i16, metadata = [] }, - "va_arg i32* %2, i16"), + "va_arg ptr %2, i16"), ("extractelement", ExtractElement { vector = a 5, @@ -509,21 +515,21 @@ tests = testGroup "Instructions" [ ("landingpad-" ++ n, LandingPad { type' = StructureType False [ - ptr i8, + ptr, i32 ], cleanup = cp, clauses = cls, metadata = [] }, - "landingpad { i8*, i32 }" <> s) + "landingpad { ptr, i32 }" <> s) | (clsn,cls,clss) <- [ ("catch", - [Catch (C.Null (ptr i8))], - "\n catch i8* null"), + [Catch (C.Null ptr)], + "\n catch ptr null"), ("filter", - [Filter (C.AggregateZero (ArrayType 1 (ptr i8)))], - "\n filter [1 x i8*] zeroinitializer") + [Filter (C.AggregateZero (ArrayType 1 ptr))], + "\n filter [1 x ptr] zeroinitializer") ], (cpn, cp, cps) <- [ ("-cleanup", True, "\n cleanup"), ("", False, "") ], let s = cps <> clss @@ -577,7 +583,7 @@ tests = testGroup "Instructions" [ alignment = 4, metadata = [] }, - "store i32 %0, i32* %2, align 4"), + "store i32 %0, ptr %2, align 4"), ("fence", Do $ Fence { atomicity = (System, Acquire), @@ -589,12 +595,13 @@ tests = testGroup "Instructions" [ tailCallKind = Nothing, callingConvention = CC.C, returnAttributes = [], - function = Right (ConstantOperand (C.GlobalReference (ptr (FunctionType A.T.void ts False)) (UnName 0))), + type' = FunctionType A.T.void ts False, + function = Right (ConstantOperand (C.GlobalReference (UnName 0))), arguments = [ (a i, []) | i <- [0..6] ], functionAttributes = [], metadata = [] }, - "call void @0(i32 %0, float %1, i32* %2, i64 %3, i1 %4, <2 x i32> %5, { i32, i32 } %6)") + "call void @0(i32 %0, float %1, ptr %2, i64 %3, i1 %4, <2 x i32> %5, { i32, i32 } %6)") ] ) ], @@ -613,13 +620,15 @@ tests = testGroup "Instructions" [ BasicBlock (UnName 1) [ UnName 2 := GetElementPtr { inBounds = True, - address = ConstantOperand (C.GlobalReference (ptr i32) (Name "fortytwo")), + type' = i32, + address = ConstantOperand (C.GlobalReference (Name "fortytwo")), indices = [ ConstantOperand (C.Int 32 0) ], metadata = [] }, UnName 3 := Load { volatile = False, - address = LocalReference (ptr i32) (UnName 2), + type' = i32, + address = LocalReference ptr (UnName 2), maybeAtomicity = Nothing, alignment = 1, metadata = [] @@ -636,8 +645,8 @@ tests = testGroup "Instructions" [ \@fortytwo = constant i32 42\n\ \\n\ \define i32 @0() {\n\ - \ %1 = getelementptr inbounds i32, i32* @fortytwo, i32 0\n\ - \ %2 = load i32, i32* %1, align 1\n\ + \ %1 = getelementptr inbounds i32, ptr @fortytwo, i32 0\n\ + \ %2 = load i32, ptr %1, align 1\n\ \ ret i32 %2\n\ \}\n" s <- withContext $ \context -> withModuleFromAST context mAST moduleLLVMAssembly @@ -760,7 +769,7 @@ tests = testGroup "Instructions" [ Module "" "" Nothing Nothing [ GlobalDefinition $ globalVariableDefaults { G.name = UnName 0, - G.type' = ptr i8, + G.type' = ptr, G.initializer = Just (C.BlockAddress (Name "foo") (UnName 2)) }, GlobalDefinition $ functionDefaults { @@ -770,14 +779,15 @@ tests = testGroup "Instructions" [ BasicBlock (UnName 0) [ UnName 1 := Load { volatile = False, - address = ConstantOperand (C.GlobalReference (ptr (ptr i8)) (UnName 0)), + type' = ptr, + address = ConstantOperand (C.GlobalReference (UnName 0)), maybeAtomicity = Nothing, alignment = 8, metadata = [] } ] ( Do $ IndirectBr { - operand0' = LocalReference (ptr i8) (UnName 1), + operand0' = LocalReference ptr (UnName 1), possibleDests = [UnName 2], metadata' = [] } @@ -791,11 +801,11 @@ tests = testGroup "Instructions" [ "; ModuleID = ''\n\ \source_filename = \"\"\n\ \\n\ - \@0 = global i8* blockaddress(@foo, %2)\n\ + \@0 = global ptr blockaddress(@foo, %2)\n\ \\n\ \define void @foo() {\n\ - \ %1 = load i8*, i8** @0, align 8\n\ - \ indirectbr i8* %1, [label %2]\n\ + \ %1 = load ptr, ptr @0, align 8\n\ + \ indirectbr ptr %1, [label %2]\n\ \\n\ \2: ; preds = %0\n\ \ ret void\n\ @@ -806,9 +816,7 @@ tests = testGroup "Instructions" [ GlobalDefinition $ functionDefaults { G.returnType = A.T.void, G.name = UnName 0, - G.personalityFunction = Just $ C.GlobalReference - (ptr (FunctionType A.T.void [i32,i16] False)) - (UnName 0) + G.personalityFunction = Just $ C.GlobalReference (UnName 0) , G.parameters = ([ Parameter i32 (UnName 0) [], @@ -819,7 +827,8 @@ tests = testGroup "Instructions" [ Do $ Invoke { callingConvention' = CC.C, returnAttributes' = [], - function' = Right (ConstantOperand (C.GlobalReference (ptr (FunctionType A.T.void [i32, i16] False)) (UnName 0))), + type'' = FunctionType A.T.void [i32, i16] False, + function' = Right (ConstantOperand (C.GlobalReference (UnName 0))), arguments' = [ (ConstantOperand (C.Int 32 4), []), (ConstantOperand (C.Int 16 8), []) @@ -836,11 +845,11 @@ tests = testGroup "Instructions" [ BasicBlock (Name "bar") [ UnName 3 := LandingPad { type' = StructureType False [ - ptr i8, + ptr, i32 ], cleanup = True, - clauses = [Catch (C.Null (ptr i8))], + clauses = [Catch (C.Null ptr)], metadata = [] } ] ( @@ -852,7 +861,7 @@ tests = testGroup "Instructions" [ "; ModuleID = ''\n\ \source_filename = \"\"\n\ \\n\ - \define void @0(i32 %0, i16 %1) personality void (i32, i16)* @0 {\n\ + \define void @0(i32 %0, i16 %1) personality ptr @0 {\n\ \ invoke void @0(i32 4, i16 8)\n\ \ to label %foo unwind label %bar\n\ \\n\ @@ -860,9 +869,9 @@ tests = testGroup "Instructions" [ \ ret void\n\ \\n\ \bar: ; preds = %2\n\ - \ %3 = landingpad { i8*, i32 }\n\ + \ %3 = landingpad { ptr, i32 }\n\ \ cleanup\n\ - \ catch i8* null\n\ + \ catch ptr null\n\ \ ret void\n\ \}\n" ), ( @@ -928,12 +937,10 @@ tests = testGroup "Instructions" [ Do Invoke { callingConvention' = CC.C, returnAttributes' = [], + type'' = FunctionType {resultType = VoidType, argumentTypes = [], isVarArg = False}, function' = Right ( ConstantOperand ( - C.GlobalReference PointerType { - pointerReferent = FunctionType {resultType = VoidType, argumentTypes = [], isVarArg = False}, - pointerAddrSpace = AddrSpace 0 - } (Name "_Z3quxv") + C.GlobalReference (Name "_Z3quxv") ) ), arguments' = [], @@ -956,10 +963,7 @@ tests = testGroup "Instructions" [ G.BasicBlock (Name "exit") [] (Do Ret { returnOperand = Nothing, metadata' = [] }) ], G.personalityFunction = Just ( - C.GlobalReference PointerType { - pointerReferent = FunctionType {resultType = IntegerType { typeBits = 32 }, argumentTypes = [], isVarArg = True}, - pointerAddrSpace = AddrSpace 0 - } (Name "__gxx_personality_v0") + C.GlobalReference (Name "__gxx_personality_v0") ) } ] @@ -971,7 +975,7 @@ tests = testGroup "Instructions" [ \\n\ \declare i32 @__gxx_personality_v0(...)\n\ \\n\ - \define void @cleanupret0() personality i32 (...)* @__gxx_personality_v0 {\n\ + \define void @cleanupret0() personality ptr @__gxx_personality_v0 {\n\ \entry:\n\ \ invoke void @_Z3quxv()\n\ \ to label %exit unwind label %pad\n\ @@ -1008,12 +1012,10 @@ tests = testGroup "Instructions" [ Do Invoke { callingConvention' = CC.C, returnAttributes' = [], + type'' = FunctionType {resultType = VoidType, argumentTypes = [], isVarArg = False}, function' = Right ( ConstantOperand ( - C.GlobalReference PointerType { - pointerReferent = FunctionType {resultType = VoidType, argumentTypes = [], isVarArg = False}, - pointerAddrSpace = AddrSpace 0 - } (Name "_Z3quxv") + C.GlobalReference (Name "_Z3quxv") ) ), arguments' = [], @@ -1038,10 +1040,7 @@ tests = testGroup "Instructions" [ G.BasicBlock (Name "exit") [] (Do Ret { returnOperand = Nothing, metadata' = [] }) ], G.personalityFunction = Just ( - C.GlobalReference PointerType { - pointerReferent = FunctionType {resultType = IntegerType { typeBits = 32 }, argumentTypes = [], isVarArg = True}, - pointerAddrSpace = AddrSpace 0 - } (Name "__gxx_personality_v0") + C.GlobalReference (Name "__gxx_personality_v0") ) } ] @@ -1053,7 +1052,7 @@ tests = testGroup "Instructions" [ \\n\ \declare i32 @__gxx_personality_v0(...)\n\ \\n\ - \define void @cleanupret1() personality i32 (...)* @__gxx_personality_v0 {\n\ + \define void @cleanupret1() personality ptr @__gxx_personality_v0 {\n\ \entry:\n\ \ invoke void @_Z3quxv()\n\ \ to label %exit unwind label %pad\n\ @@ -1093,12 +1092,10 @@ tests = testGroup "Instructions" [ Do Invoke { callingConvention' = CC.C, returnAttributes' = [], + type'' = FunctionType {resultType = VoidType, argumentTypes = [], isVarArg = False}, function' = Right ( ConstantOperand ( - C.GlobalReference PointerType { - pointerReferent = FunctionType {resultType = VoidType, argumentTypes = [], isVarArg = False}, - pointerAddrSpace = AddrSpace 0 - } (Name "_Z3quxv") + C.GlobalReference (Name "_Z3quxv") ) ), arguments' = [], @@ -1128,10 +1125,7 @@ tests = testGroup "Instructions" [ G.BasicBlock (Name "exit") [] (Do Ret { returnOperand = Nothing, metadata' = [] }) ], G.personalityFunction = Just ( - C.GlobalReference PointerType { - pointerReferent = FunctionType {resultType = IntegerType { typeBits = 32 }, argumentTypes = [], isVarArg = True}, - pointerAddrSpace = AddrSpace 0 - } (Name "__gxx_personality_v0") + C.GlobalReference (Name "__gxx_personality_v0") ) } ] @@ -1143,7 +1137,7 @@ tests = testGroup "Instructions" [ \\n\ \declare i32 @__gxx_personality_v0(...)\n\ \\n\ - \define void @catchret0() personality i32 (...)* @__gxx_personality_v0 {\n\ + \define void @catchret0() personality ptr @__gxx_personality_v0 {\n\ \entry:\n\ \ invoke void @_Z3quxv()\n\ \ to label %exit unwind label %pad\n\ @@ -1183,12 +1177,10 @@ tests = testGroup "Instructions" [ Do Invoke { callingConvention' = CC.C, returnAttributes' = [], + type'' = FunctionType {resultType = VoidType, argumentTypes = [], isVarArg = False}, function' = Right ( ConstantOperand ( - C.GlobalReference PointerType { - pointerReferent = FunctionType {resultType = VoidType, argumentTypes = [], isVarArg = False}, - pointerAddrSpace = AddrSpace 0 - } (Name "_Z3quxv") + C.GlobalReference (Name "_Z3quxv") ) ), arguments' = [], @@ -1221,10 +1213,7 @@ tests = testGroup "Instructions" [ G.BasicBlock (Name "exit") [] (Do Ret { returnOperand = Nothing, metadata' = [] }) ], G.personalityFunction = Just ( - C.GlobalReference PointerType { - pointerReferent = FunctionType {resultType = IntegerType { typeBits = 32 }, argumentTypes = [], isVarArg = True}, - pointerAddrSpace = AddrSpace 0 - } (Name "__gxx_personality_v0") + C.GlobalReference (Name "__gxx_personality_v0") ) } ] @@ -1236,7 +1225,7 @@ tests = testGroup "Instructions" [ \\n\ \declare i32 @__gxx_personality_v0(...)\n\ \\n\ - \define void @catchret0() personality i32 (...)* @__gxx_personality_v0 {\n\ + \define void @catchret0() personality ptr @__gxx_personality_v0 {\n\ \entry:\n\ \ invoke void @_Z3quxv()\n\ \ to label %exit unwind label %pad\n\ diff --git a/llvm-hs/test/LLVM/Test/Instrumentation.hs b/llvm-hs/test/LLVM/Test/Instrumentation.hs index 6d384e27..04341dbd 100644 --- a/llvm-hs/test/LLVM/Test/Instrumentation.hs +++ b/llvm-hs/test/LLVM/Test/Instrumentation.hs @@ -117,7 +117,7 @@ ast = do G.name = Name "main", G.parameters = ([ Parameter i32 (Name "argc") [], - Parameter (ptr (ptr i8)) (Name "argv") [] + Parameter ptr (Name "argv") [] ],False), G.basicBlocks = [ BasicBlock (UnName 0) [ @@ -125,12 +125,10 @@ ast = do tailCallKind = Nothing, callingConvention = CC.C, returnAttributes = [], + type' = FunctionType i32 [i128] False, function = Right (ConstantOperand (C.GlobalReference - (PointerType - { pointerReferent = FunctionType i32 [i128] False - , pointerAddrSpace = AddrSpace 0}) (Name "foo"))), arguments = [ (ConstantOperand (C.Int 128 9491828328), []) diff --git a/llvm-hs/test/LLVM/Test/Metadata.hs b/llvm-hs/test/LLVM/Test/Metadata.hs index b379ce74..692c4e85 100644 --- a/llvm-hs/test/LLVM/Test/Metadata.hs +++ b/llvm-hs/test/LLVM/Test/Metadata.hs @@ -827,7 +827,7 @@ cyclicMetadata = testGroup "cyclic" [ }, MetadataNodeDefinition (MetadataNodeID 0) - (MDTuple [Just $ MDValue $ ConstantOperand (C.GlobalReference (ptr (FunctionType A.T.void [] False)) (Name "foo"))]) + (MDTuple [Just $ MDValue $ ConstantOperand (C.GlobalReference (Name "foo"))]) ] let s = "; ModuleID = ''\n\ \source_filename = \"\"\n\ @@ -836,7 +836,7 @@ cyclicMetadata = testGroup "cyclic" [ \ ret void, !my-metadatum !0\n\ \}\n\ \\n\ - \!0 = !{void ()* @foo}\n" + \!0 = !{ptr @foo}\n" strCheck ast s ] diff --git a/llvm-hs/test/LLVM/Test/Module.hs b/llvm-hs/test/LLVM/Test/Module.hs index 7b7604fa..533f5916 100644 --- a/llvm-hs/test/LLVM/Test/Module.hs +++ b/llvm-hs/test/LLVM/Test/Module.hs @@ -42,8 +42,7 @@ import qualified LLVM.CodeGenOpt as CGO handString = "; ModuleID = ''\n\ \source_filename = \"\"\n\ \\n\ - \%0 = type { i32, %1*, %0* }\n\ - \%1 = type opaque\n\ + \%0 = type { i32, ptr, ptr }\n\ \\n\ \$bob = comdat largest\n\ \\n\ @@ -55,9 +54,9 @@ handString = "; ModuleID = ''\n\ \@.argyle = thread_local global i32 0\n\ \@5 = thread_local(localdynamic) global i32 1\n\ \\n\ - \@three = private alias i32, i32 addrspace(3)* @1\n\ - \@two = unnamed_addr alias i32, i32 addrspace(3)* @three\n\ - \@one = thread_local(initialexec) alias i32, i32* @5\n\ + \@three = private alias i32, ptr addrspace(3) @1\n\ + \@two = unnamed_addr alias i32, ptr addrspace(3) @three\n\ + \@one = thread_local(initialexec) alias i32, ptr @5\n\ \\n\ \define i32 @bar() prefix i32 1 {\n\ \ %1 = musttail call zeroext i32 @foo(i32 inreg 1, i8 signext 4) #0\n\ @@ -93,10 +92,9 @@ handAST = Module "" "" Nothing Nothing [ TypeDefinition (UnName 0) ( Just $ StructureType False [ i32, - ptr (NamedTypeReference (UnName 1)), - ptr (NamedTypeReference (UnName 0)) + ptr, + ptr ]), - TypeDefinition (UnName 1) Nothing, GlobalDefinition $ globalVariableDefaults { G.name = UnName 0, G.type' = i32, @@ -142,19 +140,19 @@ handAST = Module "" "" Nothing Nothing [ G.linkage = L.Private, G.type' = i32, G.addrSpace = AddrSpace 3, - G.aliasee = C.GlobalReference (PointerType i32 (AddrSpace 3)) (UnName 1) + G.aliasee = C.GlobalReference (UnName 1) }, GlobalDefinition $ globalAliasDefaults { G.name = Name "two", G.unnamedAddr = Just GlobalAddr, G.type' = i32, G.addrSpace = AddrSpace 3, - G.aliasee = C.GlobalReference (PointerType i32 (AddrSpace 3)) (Name "three") + G.aliasee = C.GlobalReference (Name "three") }, GlobalDefinition $ globalAliasDefaults { G.name = Name "one", G.type' = i32, - G.aliasee = C.GlobalReference (ptr i32) (UnName 5), + G.aliasee = C.GlobalReference (UnName 5), G.threadLocalMode = Just TLS.InitialExec }, GlobalDefinition $ functionDefaults { @@ -167,7 +165,8 @@ handAST = Module "" "" Nothing Nothing [ tailCallKind = Just MustTail, callingConvention = CC.C, returnAttributes = [PA.ZeroExt], - function = Right (ConstantOperand (C.GlobalReference (ptr (FunctionType i32 [i32, i8] False)) (Name "foo"))), + type' = FunctionType i32 [i32, i8] False, + function = Right (ConstantOperand (C.GlobalReference (Name "foo"))), arguments = [ (ConstantOperand (C.Int 32 1), [PA.InReg]), (ConstantOperand (C.Int 8 4), [PA.SignExt]) @@ -190,7 +189,8 @@ handAST = Module "" "" Nothing Nothing [ tailCallKind = Just NoTail, callingConvention = CC.C, returnAttributes = [PA.ZeroExt], - function = Right (ConstantOperand (C.GlobalReference (ptr (FunctionType i32 [i32, i8] False)) (Name "foo"))), + type' = FunctionType i32 [i32, i8] False, + function = Right (ConstantOperand (C.GlobalReference (Name "foo"))), arguments = [ (ConstantOperand (C.Int 32 1), [PA.InReg]), (ConstantOperand (C.Int 8 4), [PA.SignExt]) @@ -286,7 +286,7 @@ tests = testGroup "Module" [ testGroup "emit" [ testCase "assemble" $ withContext $ \context -> do - let s = "define i32 @main(i32 %argc, i8** %argv) {\n\ + let s = "define i32 @main(i32 %argc, ptr %argv) {\n\ \ ret i32 0\n\ \}\n" a <- withModuleFromLLVMAssembly' context s $ \m -> do @@ -317,7 +317,7 @@ tests = testGroup "Module" [ testCase "moduleAST" $ withContext $ \context -> do ast <- withModuleFromLLVMAssembly' context handString moduleAST assertEqPretty ast handAST, - + testCase "withModuleFromAST" $ withContext $ \context -> do s <- withModuleFromAST context handAST moduleLLVMAssembly s @?= handString, @@ -457,7 +457,7 @@ tests = testGroup "Module" [ ] ( Do $ Br (Name "elsewhere") [] ), - BasicBlock (Name "elsewhere") [ + BasicBlock (Name "elsewhere") [ ] ( Do $ Br (Name "there") [] ), @@ -536,7 +536,7 @@ tests = testGroup "Module" [ ] strCheck ast s ], - + testGroup "failures" [ testCase "bad block reference" $ withContext $ \context -> do let badAST = Module "" "" Nothing Nothing [ @@ -610,8 +610,8 @@ tests = testGroup "Module" [ t @?= Left (EncodeException "A type definition requires a structure type but got: VoidType"), testCase "renamed type definitions" $ do let modStr1 = unlines - [ "%struct = type { %struct* }" - , "define void @f(%struct*) {" + [ "%struct = type { ptr }" + , "define void @f(ptr) {" , " ret void" , "}" ] @@ -619,10 +619,10 @@ tests = testGroup "Module" [ [ ] modStr2 = unlines - [ "%struct = type { %struct* }" - , "declare void @f(%struct*)" + [ "%struct = type { ptr }" + , "declare void @f(ptr)" , "define void @main() {" - , " call void @f(%struct* zeroinitializer)" + , " call void @f(ptr zeroinitializer)" , " ret void" , "}" ] diff --git a/llvm-hs/test/LLVM/Test/Regression.hs b/llvm-hs/test/LLVM/Test/Regression.hs index 743f475c..30785f53 100644 --- a/llvm-hs/test/LLVM/Test/Regression.hs +++ b/llvm-hs/test/LLVM/Test/Regression.hs @@ -35,7 +35,7 @@ example1 = , UnName 1 := Store False - (LocalReference (ptr i32) (UnName 0)) + (LocalReference ptr (UnName 0)) (ConstantOperand (C.Int 32 42)) Nothing 0 @@ -47,61 +47,6 @@ example1 = ] } -example2 :: AST.Module -example2 = - defaultModule - { moduleDefinitions = - [ GlobalDefinition - functionDefaults - { name = "test" - , returnType = void - , basicBlocks = - [ BasicBlock - "entry" - [ UnName 0 := - Alloca (ptr $ FunctionType void [] False) Nothing 0 [] - , Do $ - Store - False - (LocalReference - (ptr $ ptr $ FunctionType void [] False) - (UnName 0)) - (ConstantOperand $ - C.GlobalReference (FunctionType void [] False) "test") - Nothing - 0 - [] - ] - (Do $ Ret Nothing []) - ] - } - ] - } - -example3 :: AST.Module -example3 = - defaultModule - { moduleDefinitions = - [ GlobalDefinition - functionDefaults - { name = "test" - , returnType = void - , basicBlocks = - [ BasicBlock - "entry" - [ UnName 0 := GetElementPtr { - inBounds = False, - address = ConstantOperand (C.Null i32), - indices = [ ConstantOperand (C.Int 32 0) ], - metadata = [] - } - ] - (Do $ Ret Nothing []) - ] - } - ] - } - duplicateDefinitions :: AST.Module duplicateDefinitions = defaultModule @@ -202,15 +147,7 @@ tests = [ testCase "no named voids" (example1 `shouldThrowEncodeException` - "Instruction of type void must not have a name: UnName 1 := Store {volatile = False, address = LocalReference (PointerType {pointerReferent = IntegerType {typeBits = 32}, pointerAddrSpace = AddrSpace 0}) (UnName 0), value = ConstantOperand (Int {integerBits = 32, integerValue = 42}), maybeAtomicity = Nothing, alignment = 0, metadata = []}") - , testCase - "no implicit casts" - (example2 `shouldThrowEncodeException` - "The serialized GlobalReference Name \"test\" has type FunctionType {resultType = VoidType, argumentTypes = [], isVarArg = False} but should have type PointerType {pointerReferent = FunctionType {resultType = VoidType, argumentTypes = [], isVarArg = False}, pointerAddrSpace = AddrSpace 0}") - , testCase - "null constants must have pointer type" - (example3 `shouldThrowEncodeException` - "Null pointer constant must have pointer type but has type IntegerType {typeBits = 32}.") + "Instruction of type void must not have a name: UnName 1 := Store {volatile = False, address = LocalReference (PointerType {pointerAddrSpace = AddrSpace 0}) (UnName 0), value = ConstantOperand (Int {integerBits = 32, integerValue = 42}), maybeAtomicity = Nothing, alignment = 0, metadata = []}") , testCase "Duplicate definitions are not allowed" (duplicateDefinitions `shouldThrowEncodeException` diff --git a/llvm-hs/test/LLVM/Test/Support.hs b/llvm-hs/test/LLVM/Test/Support.hs index 0bae50cc..08452b61 100644 --- a/llvm-hs/test/LLVM/Test/Support.hs +++ b/llvm-hs/test/LLVM/Test/Support.hs @@ -20,6 +20,7 @@ import Text.Show.Pretty import LLVM.Context import LLVM.Module import LLVM.Diagnostic +import LLVM.Target withModuleFromLLVMAssembly' :: Context -> ByteString -> (Module -> IO a) -> IO a withModuleFromLLVMAssembly' c s f = withModuleFromLLVMAssembly c s f @@ -40,3 +41,6 @@ strCheck mAST mStr = strCheckC mAST mStr mStr arbitrarySbs :: Gen ShortByteString arbitrarySbs = BSS.pack <$> listOf arbitrary + +withTargets :: TestTree -> TestTree +withTargets = withResource initializeAllTargets return . const diff --git a/llvm-hs/test/LLVM/Test/Target.hs b/llvm-hs/test/LLVM/Test/Target.hs index 0b76a218..977f07b8 100644 --- a/llvm-hs/test/LLVM/Test/Target.hs +++ b/llvm-hs/test/LLVM/Test/Target.hs @@ -133,6 +133,7 @@ tests = testGroup "Target" [ reloc = Reloc.Default codeModel = CodeModel.Default codeGenOpt = CodeGenOpt.Default + initializeAllTargets (target, _) <- lookupTarget Nothing triple withTargetMachine target triple cpu features to reloc codeModel codeGenOpt $ \tm -> do options' <- peekTargetOptions =<< targetMachineOptions tm diff --git a/llvm-hs/test/LLVM/Test/Tests.hs b/llvm-hs/test/LLVM/Test/Tests.hs index 1dccd2da..127fc9ac 100644 --- a/llvm-hs/test/LLVM/Test/Tests.hs +++ b/llvm-hs/test/LLVM/Test/Tests.hs @@ -22,8 +22,10 @@ import qualified LLVM.Test.OrcJIT as OrcJIT import qualified LLVM.Test.ParameterAttribute as ParameterAttribute import qualified LLVM.Test.Target as Target import qualified LLVM.Test.Regression as Regression +import qualified LLVM.Test.Support as Support -tests = testGroup "llvm-hs" [ + +tests = Support.withTargets $ testGroup "llvm-hs" [ CallingConvention.tests, Constants.tests, DataLayout.tests, From cc9db6b22919396403a432e37836a4d06085b97b Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Mon, 25 Jul 2022 12:55:00 +0000 Subject: [PATCH 32/37] Small updates to match HEAD refactors Most notably, a bunch of constant expressions have been removed. --- llvm-hs-pure/src/LLVM/AST/Constant.hs | 19 ------------------- llvm-hs-pure/src/LLVM/AST/Typed.hs | 8 -------- llvm-hs/src/LLVM/Internal/Constant.hs | 8 -------- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 3 +++ llvm-hs/src/LLVM/Internal/FFI/Constant.hs | 3 --- llvm-hs/src/LLVM/Internal/FFI/ConstantC.cpp | 14 -------------- llvm-hs/src/LLVM/Internal/FFI/Target.h | 1 - llvm-hs/src/LLVM/Internal/Target.hs | 1 - llvm-hs/src/LLVM/Target/Options.hs | 1 - llvm-hs/test/LLVM/Test/Target.hs | 2 +- 10 files changed, 4 insertions(+), 56 deletions(-) diff --git a/llvm-hs-pure/src/LLVM/AST/Constant.hs b/llvm-hs-pure/src/LLVM/AST/Constant.hs index 7c955677..b042cb3b 100644 --- a/llvm-hs-pure/src/LLVM/AST/Constant.hs +++ b/llvm-hs-pure/src/LLVM/AST/Constant.hs @@ -64,16 +64,6 @@ data Constant operand0 :: Constant, operand1 :: Constant } - | UDiv { - exact :: Bool, - operand0 :: Constant, - operand1 :: Constant - } - | SDiv { - exact :: Bool, - operand0 :: Constant, - operand1 :: Constant - } | FDiv { operand0 :: Constant, operand1 :: Constant @@ -205,15 +195,6 @@ data Constant operand1 :: Constant, mask :: Constant } - | ExtractValue { - aggregate :: Constant, - indices' :: [Word32] - } - | InsertValue { - aggregate :: Constant, - element :: Constant, - indices' :: [Word32] - } deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) diff --git a/llvm-hs-pure/src/LLVM/AST/Typed.hs b/llvm-hs-pure/src/LLVM/AST/Typed.hs index 097fb462..cc8f7df5 100644 --- a/llvm-hs-pure/src/LLVM/AST/Typed.hs +++ b/llvm-hs-pure/src/LLVM/AST/Typed.hs @@ -70,8 +70,6 @@ instance Typed C.Constant where typeOf (C.FSub {..}) = typeOf operand0 typeOf (C.Mul {..}) = typeOf operand0 typeOf (C.FMul {..}) = typeOf operand0 - typeOf (C.UDiv {..}) = typeOf operand0 - typeOf (C.SDiv {..}) = typeOf operand0 typeOf (C.URem {..}) = typeOf operand0 typeOf (C.SRem {..}) = typeOf operand0 typeOf (C.Shl {..}) = typeOf operand0 @@ -119,12 +117,6 @@ instance Typed C.Constant where case (t0, tm) of (Right (VectorType _ t), Right (VectorType m _)) -> return $ Right $ VectorType m t _ -> return $ Left "The first operand of an shufflevector instruction is a value of vector type. (Malformed AST)" - typeOf (C.ExtractValue {..}) = do - t <- typeOf aggregate - case t of - (Left _) -> return t - (Right t') -> extractValueType indices' t' - typeOf (C.InsertValue {..}) = typeOf aggregate typeOf (C.TokenNone) = return $ Right TokenType typeOf (C.AddrSpaceCast {..}) = return $ Right type' diff --git a/llvm-hs/src/LLVM/Internal/Constant.hs b/llvm-hs/src/LLVM/Internal/Constant.hs index e46c977b..035ff69e 100644 --- a/llvm-hs/src/LLVM/Internal/Constant.hs +++ b/llvm-hs/src/LLVM/Internal/Constant.hs @@ -284,14 +284,6 @@ instance DecodeM DecodeAST A.Constant (Ptr FFI.Constant) where "nuw" -> return [| liftIO $ decodeM =<< FFI.hasNoUnsignedWrap v |] x -> error $ "constant bool field " ++ show x ++ " not handled yet" TH.AppT TH.ListT (TH.ConT h) - | h == ''Word32 -> - return [| - do - np <- alloca - isp <- liftIO $ FFI.getConstantIndices c np - n <- peek np - decodeM (n, isp) - |] | h == ''A.Constant && TH.nameBase fn == "indices" -> do operandNumber <- get diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index a9023497..b34e034e 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -14,6 +14,7 @@ macro(Cold,F,F,T) \ macro(Convergent,F,F,T) \ macro(DisableSanitizerInstrumentation,F,F,T) \ + macro(FnRetThunkExtern,F,F,T) \ macro(Hot,F,F,T) \ macro(ImmArg,T,F,F) \ macro(InReg,T,T,F) \ @@ -50,6 +51,7 @@ macro(OptForFuzzing,F,F,T) \ macro(OptimizeForSize,F,F,T) \ macro(OptimizeNone,F,F,T) \ + macro(PresplitCoroutine,F,F,T) \ macro(ReadNone,T,F,T) \ macro(ReadOnly,T,F,T) \ macro(Returned,T,F,F) \ @@ -81,6 +83,7 @@ macro(Preallocated,F,F,T) \ macro(StructRet,T,F,F) \ macro(Alignment,T,T,F) \ + macro(AllocKind,F,F,T) \ macro(AllocSize,F,F,T) \ macro(Dereferenceable,T,T,F) \ macro(DereferenceableOrNull,T,T,F) \ diff --git a/llvm-hs/src/LLVM/Internal/FFI/Constant.hs b/llvm-hs/src/LLVM/Internal/FFI/Constant.hs index 764abde4..3d48581c 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Constant.hs +++ b/llvm-hs/src/LLVM/Internal/FFI/Constant.hs @@ -133,9 +133,6 @@ foreign import ccall unsafe "LLVM_Hs_GetConstPredicate" getConstantICmpPredicate foreign import ccall unsafe "LLVM_Hs_GetConstPredicate" getConstantFCmpPredicate :: Ptr Constant -> IO FCmpPredicate -foreign import ccall unsafe "LLVM_Hs_GetConstIndices" getConstantIndices :: - Ptr Constant -> Ptr CUInt -> IO (Ptr CUInt) - foreign import ccall unsafe "LLVMGetUndef" constantUndef :: Ptr Type -> IO (Ptr Constant) diff --git a/llvm-hs/src/LLVM/Internal/FFI/ConstantC.cpp b/llvm-hs/src/LLVM/Internal/FFI/ConstantC.cpp index 2e5f6f7c..af201010 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/ConstantC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/ConstantC.cpp @@ -69,14 +69,6 @@ LLVMValueRef LLVM_Hs_ConstSub(unsigned nsw, unsigned nuw, LLVMValueRef o0, LLVMV return wrap(ConstantExpr::getSub(unwrap(o0), unwrap(o1), nuw != 0, nsw != 0)); } -LLVMValueRef LLVM_Hs_ConstUDiv(unsigned isExact, LLVMValueRef o0, LLVMValueRef o1) { - return wrap(ConstantExpr::getUDiv(unwrap(o0), unwrap(o1), isExact != 0)); -} - -LLVMValueRef LLVM_Hs_ConstSDiv(unsigned isExact, LLVMValueRef o0, LLVMValueRef o1) { - return wrap(ConstantExpr::getSDiv(unwrap(o0), unwrap(o1), isExact != 0)); -} - LLVMValueRef LLVM_Hs_ConstLShr(unsigned isExact, LLVMValueRef o0, LLVMValueRef o1) { return wrap(ConstantExpr::getLShr(unwrap(o0), unwrap(o1), isExact != 0)); } @@ -93,12 +85,6 @@ unsigned LLVM_Hs_GetConstPredicate(LLVMValueRef v) { return unwrap(v)->getPredicate(); } -const unsigned *LLVM_Hs_GetConstIndices(LLVMValueRef v, unsigned *n) { - ArrayRef r = unwrap(v)->getIndices(); - *n = r.size(); - return r.data(); -} - const uint64_t *LLVM_Hs_GetConstantIntWords(LLVMValueRef v, unsigned *n) { const APInt &i = unwrap(v)->getValue(); *n = i.getNumWords(); diff --git a/llvm-hs/src/LLVM/Internal/FFI/Target.h b/llvm-hs/src/LLVM/Internal/FFI/Target.h index 85f7043e..9294c06e 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Target.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Target.h @@ -89,7 +89,6 @@ typedef enum { #define LLVM_HS_FOR_EACH_DEBUG_COMPRESSION_TYPE(macro) \ macro(None) \ - macro(GNU) \ macro(Z) typedef enum { diff --git a/llvm-hs/src/LLVM/Internal/Target.hs b/llvm-hs/src/LLVM/Internal/Target.hs index e6cbc143..7b7e9a91 100644 --- a/llvm-hs/src/LLVM/Internal/Target.hs +++ b/llvm-hs/src/LLVM/Internal/Target.hs @@ -79,7 +79,6 @@ genCodingInstance [t| TO.FloatingPointOperationFusionMode |] ''FFI.FPOpFusionMod genCodingInstance[t| TO.DebugCompressionType |] ''FFI.DebugCompressionType [ (FFI.debugCompressionTypeNone, TO.CompressNone), - (FFI.debugCompressionTypeGNU, TO.CompressGNU), (FFI.debugCompressionTypeZ, TO.CompressZ) ] diff --git a/llvm-hs/src/LLVM/Target/Options.hs b/llvm-hs/src/LLVM/Target/Options.hs index a6c3c615..36a9b0c2 100644 --- a/llvm-hs/src/LLVM/Target/Options.hs +++ b/llvm-hs/src/LLVM/Target/Options.hs @@ -20,7 +20,6 @@ data FloatingPointOperationFusionMode -- | data DebugCompressionType = CompressNone -- ^ No compression - | CompressGNU -- ^ zlib-gnu style compression | CompressZ -- ^ zlib style compression deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) diff --git a/llvm-hs/test/LLVM/Test/Target.hs b/llvm-hs/test/LLVM/Test/Target.hs index 977f07b8..3b5e9b06 100644 --- a/llvm-hs/test/LLVM/Test/Target.hs +++ b/llvm-hs/test/LLVM/Test/Target.hs @@ -104,7 +104,7 @@ instance Arbitrary MachineCodeOptions where return MachineCodeOptions { .. } instance Arbitrary DebugCompressionType where - arbitrary = elements [CompressNone, CompressGNU, CompressZ] + arbitrary = elements [CompressNone, CompressZ] arbitraryASCIIString :: Gen String #if MIN_VERSION_QuickCheck(2,10,0) From 2168e327abdc477e9987df91ba8ff651b9be39b9 Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Mon, 25 Jul 2022 13:15:00 +0000 Subject: [PATCH 33/37] Don't create trivial VScaleRange function attributes in tests --- llvm-hs/test/LLVM/Test/FunctionAttribute.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/llvm-hs/test/LLVM/Test/FunctionAttribute.hs b/llvm-hs/test/LLVM/Test/FunctionAttribute.hs index 1094f5e6..bf09e23a 100644 --- a/llvm-hs/test/LLVM/Test/FunctionAttribute.hs +++ b/llvm-hs/test/LLVM/Test/FunctionAttribute.hs @@ -78,7 +78,7 @@ instance Arbitrary FunctionAttribute where , StackAlignment <$> elements (map (2^) [0..8 :: Int]) , StringAttribute <$> (B.pack <$> arbitrary) <*> (B.pack <$> arbitrary) , suchThat (AllocSize <$> arbitrary <*> arbitrary) (/= AllocSize 0 (Just 0)) - , suchThat (VScaleRange <$> arbitrary <*> arbitrary) (\(VScaleRange l h) -> l <= h) + , suchThat (VScaleRange <$> arbitrary <*> arbitrary) (\(VScaleRange l h) -> l <= h && h /= 0) ] shrink = \case From 76c4ecafaa43b7783e0672d160221510152be9fd Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Thu, 8 Sep 2022 11:59:19 +0000 Subject: [PATCH 34/37] Don't use deprecated getValueOr --- llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp index c0546db0..349b1c78 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp @@ -178,7 +178,7 @@ LLVMBool LLVM_Hs_AttributeGetAllocSizeArgs(LLVMAttributeRef a, unsigned *x, void LLVM_Hs_AttributeGetVScaleRangeArgs(LLVMAttributeRef a, unsigned *min, unsigned *max) { *min = unwrap(a).getVScaleRangeMin(); - *max = unwrap(a).getVScaleRangeMax().getValueOr(0); + *max = unwrap(a).getVScaleRangeMax().value_or(0); } void LLVM_Hs_AttrBuilderAddVScaleRange(AttrBuilder &ab, unsigned min, unsigned max) { From 8dedb3f84a31d0aa709806106750fbfed5f669f7 Mon Sep 17 00:00:00 2001 From: Alexey Radul Date: Tue, 11 Oct 2022 10:30:29 -0400 Subject: [PATCH 35/37] Update to LLVM head. Co-authored-by: Fangrui Song --- llvm-hs/src/LLVM/Internal/FFI/Attribute.h | 1 + llvm-hs/src/LLVM/Internal/FFI/Target.h | 2 +- llvm-hs/src/LLVM/Internal/Target.hs | 2 +- llvm-hs/src/LLVM/Target/Options.hs | 2 +- llvm-hs/test/LLVM/Test/Target.hs | 2 +- 5 files changed, 5 insertions(+), 4 deletions(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h index b34e034e..2f12fa01 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Attribute.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Attribute.h @@ -64,6 +64,7 @@ macro(SanitizeMemory,F,F,T) \ macro(SanitizeThread,F,F,T) \ macro(ShadowCallStack,F,F,T) \ + macro(SkipProfile,F,F,T) \ macro(Speculatable,F,F,T) \ macro(SpeculativeLoadHardening,F,F,T) \ macro(StackProtect,F,F,T) \ diff --git a/llvm-hs/src/LLVM/Internal/FFI/Target.h b/llvm-hs/src/LLVM/Internal/FFI/Target.h index 9294c06e..454e1a3c 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/Target.h +++ b/llvm-hs/src/LLVM/Internal/FFI/Target.h @@ -89,7 +89,7 @@ typedef enum { #define LLVM_HS_FOR_EACH_DEBUG_COMPRESSION_TYPE(macro) \ macro(None) \ - macro(Z) + macro(Zlib) typedef enum { #define ENUM_CASE(n) LLVM_Hs_DebugCompressionType_ ## n, diff --git a/llvm-hs/src/LLVM/Internal/Target.hs b/llvm-hs/src/LLVM/Internal/Target.hs index 7b7e9a91..bb07bd0a 100644 --- a/llvm-hs/src/LLVM/Internal/Target.hs +++ b/llvm-hs/src/LLVM/Internal/Target.hs @@ -79,7 +79,7 @@ genCodingInstance [t| TO.FloatingPointOperationFusionMode |] ''FFI.FPOpFusionMod genCodingInstance[t| TO.DebugCompressionType |] ''FFI.DebugCompressionType [ (FFI.debugCompressionTypeNone, TO.CompressNone), - (FFI.debugCompressionTypeZ, TO.CompressZ) + (FFI.debugCompressionTypeZlib, TO.CompressZlib) ] genCodingInstance[t| TO.ThreadModel |] ''FFI.ThreadModel [ diff --git a/llvm-hs/src/LLVM/Target/Options.hs b/llvm-hs/src/LLVM/Target/Options.hs index 36a9b0c2..f187a85e 100644 --- a/llvm-hs/src/LLVM/Target/Options.hs +++ b/llvm-hs/src/LLVM/Target/Options.hs @@ -20,7 +20,7 @@ data FloatingPointOperationFusionMode -- | data DebugCompressionType = CompressNone -- ^ No compression - | CompressZ -- ^ zlib style compression + | CompressZlib -- ^ zlib style compression deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) -- | diff --git a/llvm-hs/test/LLVM/Test/Target.hs b/llvm-hs/test/LLVM/Test/Target.hs index 3b5e9b06..e9aa4450 100644 --- a/llvm-hs/test/LLVM/Test/Target.hs +++ b/llvm-hs/test/LLVM/Test/Target.hs @@ -104,7 +104,7 @@ instance Arbitrary MachineCodeOptions where return MachineCodeOptions { .. } instance Arbitrary DebugCompressionType where - arbitrary = elements [CompressNone, CompressZ] + arbitrary = elements [CompressNone, CompressZlib] arbitraryASCIIString :: Gen String #if MIN_VERSION_QuickCheck(2,10,0) From 7be21dcb2576304b1bf1945e3375844e2deed3d7 Mon Sep 17 00:00:00 2001 From: Alexey Radul Date: Wed, 12 Oct 2022 09:54:30 -0400 Subject: [PATCH 36/37] Bump to version 16, bump to C++17, fix deprecation warnings. --- llvm-hs-pure/llvm-hs-pure.cabal | 2 +- llvm-hs/Setup.hs | 2 +- llvm-hs/llvm-hs.cabal | 8 ++++---- llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp | 4 ++-- llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp | 8 ++++---- stack.yaml | 4 ---- 6 files changed, 12 insertions(+), 16 deletions(-) diff --git a/llvm-hs-pure/llvm-hs-pure.cabal b/llvm-hs-pure/llvm-hs-pure.cabal index 20874e73..0aeb1b65 100644 --- a/llvm-hs-pure/llvm-hs-pure.cabal +++ b/llvm-hs-pure/llvm-hs-pure.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: llvm-hs-pure -version: 15.0.0 +version: 16.0.0 license: BSD-3-Clause license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer , Benjamin S. Scarlet diff --git a/llvm-hs/Setup.hs b/llvm-hs/Setup.hs index 925e20e6..52549cc5 100644 --- a/llvm-hs/Setup.hs +++ b/llvm-hs/Setup.hs @@ -41,7 +41,7 @@ lookupFlagAssignment = lookup #endif llvmVersion :: Version -llvmVersion = mkVersion [15,0] +llvmVersion = mkVersion [16,0] -- Ordered by decreasing specificty so we will prefer llvm-config-9.0 -- over llvm-config-9 over llvm-config. diff --git a/llvm-hs/llvm-hs.cabal b/llvm-hs/llvm-hs.cabal index bcfd035f..1a5c297a 100644 --- a/llvm-hs/llvm-hs.cabal +++ b/llvm-hs/llvm-hs.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: llvm-hs -version: 15.0.0 +version: 16.0.0 license: BSD-3-Clause license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer , Benjamin S. Scarlet @@ -80,13 +80,13 @@ library -fno-warn-orphans -optcxx=-O3 -optcxx=-Wall - -optcxx=-std=c++14 + -optcxx=-std=c++17 -optcxx=-lstdc++ cxx-options: -O3 -Wall - -std=c++14 + -std=c++17 if flag(llvm-with-rtti) cxx-options: -frtti @@ -114,7 +114,7 @@ library template-haskell >= 2.5.0.0, containers >= 0.4.2.1, array >= 0.4.0.0, - llvm-hs-pure == 15.0.* + llvm-hs-pure == 16.0.* hs-source-dirs: src default-extensions: diff --git a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp index 349b1c78..05346ea4 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/AttributeC.cpp @@ -168,8 +168,8 @@ LLVMBool LLVM_Hs_AttributeGetAllocSizeArgs(LLVMAttributeRef a, unsigned *x, unsigned *y) { auto pair = unwrap(a).getAllocSizeArgs(); *x = pair.first; - if (pair.second.hasValue()) { - *y = pair.second.getValue(); + if (pair.second.has_value()) { + *y = pair.second.value(); return 1; } else { return 0; diff --git a/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp b/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp index 10473d5c..93e8f16c 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/MetadataC.cpp @@ -225,7 +225,7 @@ MDString* LLVM_Hs_DIFileGetDirectory(DIFile *di) { MDString* LLVM_Hs_DIFileGetChecksum(DIFile *di) { auto checksumInfo = di->getRawChecksum(); - if (checksumInfo.hasValue()) { + if (checksumInfo.has_value()) { return checksumInfo->Value; } return nullptr; @@ -233,7 +233,7 @@ MDString* LLVM_Hs_DIFileGetChecksum(DIFile *di) { llvm::DIFile::ChecksumKind LLVM_Hs_DIFileGetChecksumKind(DIFile *di) { auto checksumInfo = di->getRawChecksum(); - if (checksumInfo.hasValue()) { + if (checksumInfo.has_value()) { return checksumInfo->Kind; } return static_cast(0); @@ -470,8 +470,8 @@ DILexicalBlock* LLVM_Hs_Get_DILexicalBlock(LLVMContextRef ctx, DILocalScope* sco LLVMBool LLVM_Hs_DIDerivedTypeGetAddressSpace(DIDerivedType *a, unsigned *x) { auto addressSpace = a->getDWARFAddressSpace(); - if (addressSpace.hasValue()) { - *x = addressSpace.getValue(); + if (addressSpace.has_value()) { + *x = addressSpace.value(); return 1; } else { return 0; diff --git a/stack.yaml b/stack.yaml index 54d2023d..623eccbb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,7 +6,3 @@ resolver: nightly-2021-07-04 # 9.0.1 packages: - llvm-hs - llvm-hs-pure - -# We should not need to do this, but unfortunately, removing it breaks the stack build. -ghc-options: - llvm-hs: -optcxx=-std=c++14 -optcxx=-lstdc++ -optcxx=-fno-rtti From bb655b8b2fbe6346f2bbb480987d0f323ba62c3b Mon Sep 17 00:00:00 2001 From: Adam Paszke Date: Wed, 12 Oct 2022 15:37:05 +0000 Subject: [PATCH 37/37] More updates, to satisfy LLVM assertions + fix ObjectLinkingLayer build LLVM doesn't like that we're not checking the error flags, so we have to make it more explicit. --- llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp | 12 +++++++++--- llvm-hs/test/LLVM/Test/OrcJIT.hs | 2 +- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp index ccbe99db..5f04d33e 100644 --- a/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp +++ b/llvm-hs/src/LLVM/Internal/FFI/OrcJITC.cpp @@ -8,7 +8,6 @@ #include #include #include -#include #include #include #include @@ -53,7 +52,14 @@ extern "C" { // ExecutionSession ExecutionSession *LLVM_Hs_createExecutionSession() { - return new ExecutionSession(std::move(*SelfExecutorProcessControl::Create())); + auto sepc = SelfExecutorProcessControl::Create(); + if (sepc) { + return new ExecutionSession(std::move(*sepc)); + } else { + llvm::errs() << sepc.takeError() << "\n"; + // FIXME: Better error handling + exit(1); + } } void LLVM_Hs_disposeExecutionSession(ExecutionSession *es) { @@ -111,7 +117,7 @@ ObjectLayer* LLVM_Hs_createRTDyldObjectLinkingLayer(ExecutionSession* es) { } ObjectLayer* LLVM_Hs_createObjectLinkingLayer(ExecutionSession* es) { - return new ObjectLinkingLayer(*es, std::make_unique()); + return new ObjectLinkingLayer(*es); } void LLVM_Hs_ObjectLayerAddObjectFile(ObjectLayer* ol, JITDylib* dylib, const char* path) { diff --git a/llvm-hs/test/LLVM/Test/OrcJIT.hs b/llvm-hs/test/LLVM/Test/OrcJIT.hs index 3aa822aa..cf8e9d6b 100644 --- a/llvm-hs/test/LLVM/Test/OrcJIT.hs +++ b/llvm-hs/test/LLVM/Test/OrcJIT.hs @@ -78,7 +78,7 @@ foreign import ccall "dynamic" tests :: TestTree tests = testGroup "OrcJIT" [ - testCase "basic self-contained function" $ do + testCase "basic self-contained function" $ withHostTargetMachine Reloc.PIC CodeModel.Default CodeGenOpt.Default $ \tm -> withExecutionSession $ \es -> do ol <- createRTDyldObjectLinkingLayer es pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy