diff --git a/llvm-general.cabal b/llvm-general.cabal --- a/llvm-general.cabal +++ b/llvm-general.cabal @@ -1,5 +1,5 @@ name: llvm-general -version: 3.3.10.0 +version: 3.3.11.0 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet @@ -16,7 +16,7 @@ handles almost all of the stateful complexities of using the LLVM API to build IR; and it supports moving IR not only from Haskell into LLVM C++ objects, but the other direction - from LLVM C++ into Haskell. . - For haddock, see . + For haddock, see . extra-source-files: src/LLVM/General/Internal/FFI/Analysis.h src/LLVM/General/Internal/FFI/Constant.h @@ -38,7 +38,7 @@ type: git location: git://github.com/bscarlet/llvm-general.git branch: llvm-3.3 - tag: v3.3.10.0 + tag: v3.3.11.0 flag shared-llvm description: link against llvm shared rather than static library @@ -62,7 +62,7 @@ parsec >= 3.1.3, array >= 0.4.0.0, setenv >= 0.1.0, - llvm-general-pure == 3.3.10.0 + llvm-general-pure == 3.3.11.0 extra-libraries: stdc++ hs-source-dirs: src extensions: @@ -86,6 +86,7 @@ LLVM.General.PassManager LLVM.General.Relocation LLVM.General.Target + LLVM.General.Target.LibraryFunction LLVM.General.Target.Options LLVM.General.Transforms @@ -114,6 +115,7 @@ LLVM.General.Internal.Instruction LLVM.General.Internal.InstructionDefs LLVM.General.Internal.IntegerPredicate + LLVM.General.Internal.LibraryFunction LLVM.General.Internal.MemoryBuffer LLVM.General.Internal.Metadata LLVM.General.Internal.Module @@ -194,8 +196,8 @@ HUnit >= 1.2.4.2, test-framework-quickcheck2 >= 0.3.0.1, QuickCheck >= 2.5.1.1, - llvm-general == 3.3.10.0, - llvm-general-pure == 3.3.10.0, + llvm-general == 3.3.11.0, + llvm-general-pure == 3.3.11.0, containers >= 0.4.2.1, mtl >= 2.0.1.0 hs-source-dirs: test diff --git a/src/LLVM/General/Internal/FFI/LLVMCTypes.hsc b/src/LLVM/General/Internal/FFI/LLVMCTypes.hsc --- a/src/LLVM/General/Internal/FFI/LLVMCTypes.hsc +++ b/src/LLVM/General/Internal/FFI/LLVMCTypes.hsc @@ -21,6 +21,7 @@ #include "LLVM/General/Internal/FFI/Constant.h" #include "LLVM/General/Internal/FFI/Analysis.h" #include "LLVM/General/Internal/FFI/Module.h" +#include "LLVM/General/Internal/FFI/LibFunc.h" import Language.Haskell.TH.Quote @@ -209,3 +210,8 @@ deriving (Eq, Read, Show, Bits, Typeable, Data, Num) #define LM_Rec(n) { #n, LLVMLinker ## n }, #{inject LINKER_MODE, LinkerMode, LinkerMode, linkerMode, LM_Rec} + +newtype LibFunc = LibFunc CUInt + deriving (Eq, Read, Show, Bits, Typeable, Data, Num, Storable) +#define LF_Rec(n) { #n, LLVMLibFunc__ ## n }, +#{inject LIB_FUNC, LibFunc, LibFunc, libFunc__, LF_Rec} diff --git a/src/LLVM/General/Internal/FFI/PassManager.hs b/src/LLVM/General/Internal/FFI/PassManager.hs --- a/src/LLVM/General/Internal/FFI/PassManager.hs +++ b/src/LLVM/General/Internal/FFI/PassManager.hs @@ -52,6 +52,9 @@ addDataLayoutPass = flip addDataLayoutPass' +foreign import ccall unsafe "LLVM_General_LLVMAddAnalysisPasses" addAnalysisPasses :: + Ptr TargetMachine -> Ptr PassManager -> IO () + foreign import ccall unsafe "LLVMAddTargetLibraryInfo" addTargetLibraryInfoPass' :: Ptr TargetLibraryInfo -> Ptr PassManager -> IO () @@ -123,3 +126,6 @@ foreign import ccall unsafe "LLVMPassManagerBuilderPopulateLTOPassManager" passManagerBuilderPopulateLTOPassManager :: Ptr PassManagerBuilder -> Ptr PassManager -> CUChar -> CUChar -> IO () + +foreign import ccall unsafe "LLVM_General_PassManagerBuilderSetLibraryInfo" passManagerBuilderSetLibraryInfo :: + Ptr PassManagerBuilder -> Ptr TargetLibraryInfo -> IO () diff --git a/src/LLVM/General/Internal/FFI/PassManagerC.cpp b/src/LLVM/General/Internal/FFI/PassManagerC.cpp --- a/src/LLVM/General/Internal/FFI/PassManagerC.cpp +++ b/src/LLVM/General/Internal/FFI/PassManagerC.cpp @@ -6,6 +6,10 @@ #include "llvm/Transforms/Vectorize.h" #include "llvm/Transforms/Instrumentation.h" #include "llvm/PassManager.h" +#include "llvm-c/Target.h" +#include "llvm-c/Transforms/PassManagerBuilder.h" +#include "llvm/Target/TargetLibraryInfo.h" +#include "llvm/Target/TargetMachine.h" #include "llvm-c/Core.h" @@ -14,6 +18,7 @@ extern "C" { typedef struct LLVMOpaqueVectorizationConfig *LLVMVectorizationConfigRef; typedef struct LLVMOpaqueTargetLowering *LLVMTargetLoweringRef; +typedef struct LLVMOpaqueTargetMachine *LLVMTargetMachineRef; } namespace llvm { @@ -24,14 +29,36 @@ 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)); +} + +// Taken from llvm/lib/Target/Target.cpp +inline TargetLibraryInfo *unwrap(LLVMTargetLibraryInfoRef P) { + return reinterpret_cast(P); +} + +// Taken from llvm/lib/Transforms/IPO/PassManagerBuilder.cpp +inline PassManagerBuilder *unwrap(LLVMPassManagerBuilderRef P) { + return reinterpret_cast(P); +} +} + extern "C" { void LLVM_General_AddDataLayoutPass(LLVMPassManagerRef PM, const char *dl) { unwrap(PM)->add(new DataLayout(dl)); } +void LLVM_General_LLVMAddAnalysisPasses(LLVMTargetMachineRef T, LLVMPassManagerRef PM) { + unwrap(T)->addAnalysisPasses(*unwrap(PM)); +} + #define LLVM_GENERAL_FOR_EACH_PASS_WITHOUT_LLVM_C_BINDING(macro) \ macro(BlockPlacement) \ macro(BreakCriticalEdges) \ @@ -209,6 +236,16 @@ void LLVM_General_AddBoundsCheckingPass(LLVMPassManagerRef PM) { unwrap(PM)->add(createBoundsCheckingPass()); +} + +void +LLVM_General_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 TargetLibraryInfo(*unwrap(l)); } } diff --git a/src/LLVM/General/Internal/FFI/Target.hs b/src/LLVM/General/Internal/FFI/Target.hs --- a/src/LLVM/General/Internal/FFI/Target.hs +++ b/src/LLVM/General/Internal/FFI/Target.hs @@ -112,6 +112,15 @@ foreign import ccall unsafe "LLVM_General_CreateTargetLibraryInfo" createTargetLibraryInfo :: CString -> IO (Ptr TargetLibraryInfo) +foreign import ccall unsafe "LLVM_General_GetLibFunc" getLibFunc :: + Ptr TargetLibraryInfo -> CString -> Ptr LibFunc -> IO LLVMBool + +foreign import ccall unsafe "LLVM_General_LibFuncGetName" libFuncGetName :: + Ptr TargetLibraryInfo -> LibFunc -> Ptr CSize -> IO CString + +foreign import ccall unsafe "LLVM_General_LibFuncSetAvailableWithName" libFuncSetAvailableWithName :: + Ptr TargetLibraryInfo -> LibFunc -> CString -> IO () + foreign import ccall unsafe "LLVM_General_DisposeTargetLibraryInfo" disposeTargetLibraryInfo :: Ptr TargetLibraryInfo -> IO () diff --git a/src/LLVM/General/Internal/FFI/TargetC.cpp b/src/LLVM/General/Internal/FFI/TargetC.cpp --- a/src/LLVM/General/Internal/FFI/TargetC.cpp +++ b/src/LLVM/General/Internal/FFI/TargetC.cpp @@ -14,6 +14,7 @@ #include "llvm-c/TargetMachine.h" #include "llvm-c/Core.h" #include "LLVM/General/Internal/FFI/Target.h" +#include "LLVM/General/Internal/FFI/LibFunc.h" using namespace llvm; @@ -74,6 +75,24 @@ } } +static LibFunc::Func unwrap(LLVMLibFunc x) { + switch(x) { +#define ENUM_CASE(x) case LLVMLibFunc__ ## x: return LibFunc::x; +LLVM_GENERAL_FOR_EACH_LIB_FUNC(ENUM_CASE) +#undef ENUM_CASE + default: return LibFunc::Func(0); + } +} + +static LLVMLibFunc wrap(LibFunc::Func x) { + switch(x) { +#define ENUM_CASE(x) case LibFunc::x : return LLVMLibFunc__ ## x; +LLVM_GENERAL_FOR_EACH_LIB_FUNC(ENUM_CASE) +#undef ENUM_CASE + default: return LLVMLibFunc(0); + } +} + static LLVM_General_FloatABI wrap(FloatABI::ABIType x) { switch(x) { #define ENUM_CASE(x) case FloatABI::x: return LLVM_General_FloatABI_ ## x; @@ -269,6 +288,35 @@ const char *triple ) { return wrap(new TargetLibraryInfo(Triple(triple))); +} + +LLVMBool LLVM_General_GetLibFunc( + LLVMTargetLibraryInfoRef l, + const char *funcName, + LLVMLibFunc *f +) { + LibFunc::Func func; + LLVMBool result = unwrap(l)->getLibFunc(funcName, func); + *f = wrap(func); + return result; +} + +const char *LLVM_General_LibFuncGetName( + LLVMTargetLibraryInfoRef l, + LLVMLibFunc f, + size_t *nameSize +) { + StringRef s = unwrap(l)->getName(unwrap(f)); + *nameSize = s.size(); + return s.data(); +} + +void LLVM_General_LibFuncSetAvailableWithName( + LLVMTargetLibraryInfoRef l, + LLVMLibFunc f, + const char *name +) { + unwrap(l)->setAvailableWithName(unwrap(f), name); } void LLVM_General_DisposeTargetLibraryInfo(LLVMTargetLibraryInfoRef l) { diff --git a/src/LLVM/General/Internal/LibraryFunction.hsc b/src/LLVM/General/Internal/LibraryFunction.hsc new file mode 100644 --- /dev/null +++ b/src/LLVM/General/Internal/LibraryFunction.hsc @@ -0,0 +1,35 @@ +{-# LANGUAGE + MultiParamTypeClasses + #-} +module LLVM.General.Internal.LibraryFunction where + +import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI + +import LLVM.General.Internal.Coding + +#include "LLVM/General/Internal/FFI/LibFunc.h" + +#{ +define hsc_inject(m) { \ + struct { const char *s; unsigned n; } *p, list[] = { LLVM_GENERAL_FOR_EACH_LIB_FUNC(m) }; \ + hsc_printf("data LibraryFunction\n"); \ + for(p = list; p < list + sizeof(list)/sizeof(list[0]); ++p) { \ + hsc_printf(" %s LF__%s\n", (p == list ? "=" : "|"), p->s); \ + } \ + hsc_printf(" deriving (Eq, Ord, Enum, Bounded, Read, Show)"); \ + hsc_printf("\n"); \ + hsc_printf("instance Monad m => EncodeM m LibraryFunction FFI.LibFunc where\n"); \ + for(p = list; p < list + sizeof(list)/sizeof(list[0]); ++p) { \ + hsc_printf(" encodeM LF__%s = return (FFI.LibFunc %u)\n", p->s, p->n); \ + } \ + hsc_printf("\n"); \ + hsc_printf("instance Monad m => DecodeM m LibraryFunction FFI.LibFunc where\n"); \ + for(p = list; p < list + sizeof(list)/sizeof(list[0]); ++p) { \ + hsc_printf(" decodeM (FFI.LibFunc %u) = return LF__%s \n", p->n, p->s); \ + } \ +} +} + +-- | +#define Mac(n) { #n, LLVMLibFunc__ ## n }, +#{inject Mac} diff --git a/src/LLVM/General/Internal/Module.hs b/src/LLVM/General/Internal/Module.hs --- a/src/LLVM/General/Internal/Module.hs +++ b/src/LLVM/General/Internal/Module.hs @@ -65,6 +65,7 @@ -- | newtype Module = Module (Ptr FFI.Module) +-- | A newtype to distinguish strings used for paths from other strings newtype File = File FilePath deriving (Eq, Ord, Read, Show) diff --git a/src/LLVM/General/Internal/PassManager.hs b/src/LLVM/General/Internal/PassManager.hs --- a/src/LLVM/General/Internal/PassManager.hs +++ b/src/LLVM/General/Internal/PassManager.hs @@ -20,6 +20,7 @@ import qualified LLVM.General.Internal.FFI.PassManager as FFI import qualified LLVM.General.Internal.FFI.Transforms as FFI +import qualified LLVM.General.Internal.FFI.Target as FFI import LLVM.General.Internal.Module import LLVM.General.Internal.Target @@ -44,7 +45,7 @@ transforms :: [Pass], dataLayout :: Maybe DataLayout, targetLibraryInfo :: Maybe TargetLibraryInfo, - targetLowering :: Maybe TargetLowering + 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 @@ -54,7 +55,8 @@ sizeLevel :: Maybe Word, unitAtATime :: Maybe Bool, simplifyLibCalls :: Maybe Bool, - useInlinerWithThreshold :: Maybe Word + useInlinerWithThreshold :: Maybe Word, + curatedTargetLibraryInfo :: Maybe TargetLibraryInfo } -- | Helper to make a curated 'PassSetSpec' @@ -63,7 +65,8 @@ sizeLevel = Nothing, unitAtATime = Nothing, simplifyLibCalls = Nothing, - useInlinerWithThreshold = Nothing + useInlinerWithThreshold = Nothing, + curatedTargetLibraryInfo = Nothing } -- | an empty 'PassSetSpec' @@ -71,7 +74,7 @@ transforms = [], dataLayout = Nothing, targetLibraryInfo = Nothing, - targetLowering = Nothing + targetMachine = Nothing } instance (Monad m, MonadAnyCont IO m) => EncodeM m GCOVVersion CString where @@ -89,12 +92,16 @@ handleOption FFI.passManagerBuilderSetDisableUnitAtATime (liftM not . unitAtATime) handleOption FFI.passManagerBuilderSetDisableSimplifyLibCalls (liftM not . simplifyLibCalls) handleOption FFI.passManagerBuilderUseInlinerWithThreshold useInlinerWithThreshold + case (curatedTargetLibraryInfo s) of + (Just (TargetLibraryInfo tl)) -> FFI.passManagerBuilderSetLibraryInfo b tl + Nothing -> return () FFI.passManagerBuilderPopulateModulePassManager b pm - PassSetSpec ps dl tli tl' -> do - let tl = maybe nullPtr (\(TargetLowering tl) -> tl) tl' + PassSetSpec ps dl tli tm' -> do + tl <- liftIO $ maybe (return nullPtr) (\(TargetMachine tm) -> FFI.getTargetLowering tm) tm' forM_ tli $ \(TargetLibraryInfo tli) -> do liftIO $ FFI.addTargetLibraryInfoPass pm tli forM_ dl $ \dl -> liftIO $ withFFIDataLayout dl $ FFI.addDataLayoutPass pm + forM_ tm' $ \(TargetMachine tm) -> liftIO $ FFI.addAnalysisPasses tm pm forM_ ps $ \p -> $( do TH.TyConI (TH.DataD _ _ _ cons _) <- TH.reify ''Pass diff --git a/src/LLVM/General/Internal/Target.hs b/src/LLVM/General/Internal/Target.hs --- a/src/LLVM/General/Internal/Target.hs +++ b/src/LLVM/General/Internal/Target.hs @@ -6,10 +6,11 @@ #-} module LLVM.General.Internal.Target where -import Control.Monad -import Control.Monad.Error +import Control.Monad hiding (forM) +import Control.Monad.Error hiding (forM) import Control.Exception import Data.Functor +import Data.Traversable (forM) import Control.Monad.AnyCont import Data.Maybe @@ -20,6 +21,7 @@ import LLVM.General.Internal.Coding import LLVM.General.Internal.String () +import LLVM.General.Internal.LibraryFunction import LLVM.General.DataLayout import LLVM.General.AST.DataLayout @@ -271,7 +273,7 @@ initializeAllTargets :: IO () initializeAllTargets = FFI.initializeAllTargets --- | Bracket creation and destruction of a TargetMachine configured for the host +-- | Bracket creation and destruction of a 'TargetMachine' configured for the host withDefaultTargetMachine :: (TargetMachine -> IO a) -> ErrorT String IO a withDefaultTargetMachine f = do liftIO $ initializeAllTargets @@ -284,6 +286,31 @@ -- | newtype TargetLibraryInfo = TargetLibraryInfo (Ptr FFI.TargetLibraryInfo) + +-- | Look up a 'LibraryFunction' by its standard name +getLibraryFunction :: TargetLibraryInfo -> String -> IO (Maybe LibraryFunction) +getLibraryFunction (TargetLibraryInfo f) name = flip runAnyContT return $ do + libFuncP <- alloca + name <- encodeM name + r <- decodeM =<< (liftIO $ FFI.getLibFunc f name libFuncP) + forM (if r then Just libFuncP else Nothing) $ decodeM <=< peek + +-- | Get a the current name to be emitted for a 'LibraryFunction' +getLibraryFunctionName :: TargetLibraryInfo -> LibraryFunction -> IO String +getLibraryFunctionName (TargetLibraryInfo f) l = flip runAnyContT return $ do + l <- encodeM l + decodeM $ FFI.libFuncGetName f l + +-- | Set the name of the function on the target platform that corresponds to funcName +setLibraryFunctionAvailableWithName :: + TargetLibraryInfo + -> LibraryFunction + -> String -- ^ The function name to be emitted + -> IO () +setLibraryFunctionAvailableWithName (TargetLibraryInfo f) libraryFunction name = flip runAnyContT return $ do + name <- encodeM name + libraryFunction <- encodeM libraryFunction + liftIO $ FFI.libFuncSetAvailableWithName f libraryFunction name -- | look up information about the library functions available on a given platform withTargetLibraryInfo :: diff --git a/src/LLVM/General/Target.hs b/src/LLVM/General/Target.hs --- a/src/LLVM/General/Target.hs +++ b/src/LLVM/General/Target.hs @@ -1,4 +1,4 @@ --- | A Target describes that for which code may be intended. Targets are used both during actual +-- | A 'Target' describes that for which code may be intended. Targets are used both during actual -- | lowering of LLVM IR to machine code and by some optimization passes which use the target to -- | judge costs. module LLVM.General.Target ( @@ -12,6 +12,9 @@ getDefaultTargetTriple, getProcessTargetTriple, getHostCPUName, getHostCPUFeatures, getTargetMachineDataLayout, initializeNativeTarget, initializeAllTargets, TargetLibraryInfo, + getLibraryFunction, + getLibraryFunctionName, + setLibraryFunctionAvailableWithName, withTargetLibraryInfo ) where diff --git a/src/LLVM/General/Target/LibraryFunction.hs b/src/LLVM/General/Target/LibraryFunction.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/General/Target/LibraryFunction.hs @@ -0,0 +1,7 @@ +-- | A 'LibraryFunction' identifies a function of which LLVM has particular knowledge. +module LLVM.General.Target.LibraryFunction ( + LibraryFunction(..) + ) where + + +import LLVM.General.Internal.LibraryFunction diff --git a/test/LLVM/General/Test/Optimization.hs b/test/LLVM/General/Test/Optimization.hs --- a/test/LLVM/General/Test/Optimization.hs +++ b/test/LLVM/General/Test/Optimization.hs @@ -300,8 +300,7 @@ withTargetOptions $ \targetOptions -> do withTargetMachine target triple "" Set.empty targetOptions R.Default CM.Default CGO.Default $ \tm -> do - tl <- getTargetLowering tm - withPassManager (defaultPassSetSpec { transforms = [LowerInvoke False], targetLowering = Just tl}) $ \passManager -> do + withPassManager (defaultPassSetSpec { transforms = [LowerInvoke False], targetMachine = Just tm}) $ \passManager -> do let astIn = Module "" Nothing Nothing [ GlobalDefinition $ functionDefaults { diff --git a/test/LLVM/General/Test/Target.hs b/test/LLVM/General/Test/Target.hs --- a/test/LLVM/General/Test/Target.hs +++ b/test/LLVM/General/Test/Target.hs @@ -14,6 +14,7 @@ import LLVM.General.Target import LLVM.General.Target.Options +import LLVM.General.Target.LibraryFunction instance Arbitrary FloatABI where arbitrary = elements [minBound .. maxBound] @@ -65,5 +66,21 @@ pokeTargetOptions options to options' <- peekTargetOptions to return $ options == options' + ], + testGroup "LibraryFunction" [ + testGroup "set-get" [ + testCase (show lf) $ do + triple <- getDefaultTargetTriple + withTargetLibraryInfo triple $ \tli -> do + setLibraryFunctionAvailableWithName tli lf "foo" + nm <- getLibraryFunctionName tli lf + nm @?= "foo" + | lf <- [minBound, maxBound] + ], + testCase "get" $ do + triple <- getDefaultTargetTriple + withTargetLibraryInfo triple $ \tli -> do + lf <- getLibraryFunction tli "printf" + lf @?= Just LF__printf ] ]