diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,19 @@ +## 5.1.0 (2017-10-12) + +### Bugfixes + +* Set target options in `withTargetMachine`. Previously the options + passed there were simply ignored. +* Fix decoding of constant vectors. +* Fix decoding of function attributes in calls. + +### Enhancements + +* Support for more target options. +* Suport string attributes as parameter attributes. +* Support more calling conventions. +* Support `NoTail` `TailCallKind`. + ## 5.0.0 (2017-09-07) * Support for LLVM 5.0 diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,22 +1,18 @@ {-# LANGUAGE CPP, FlexibleInstances #-} import Control.Exception (SomeException, try) import Control.Monad -import Data.Functor +import Data.Char +import Data.List import Data.Maybe -import Data.List (isPrefixOf, (\\), intercalate, stripPrefix, find) -import Data.Map (Map) -import qualified Data.Map as Map import Data.Monoid -import Data.Char +import Distribution.PackageDescription hiding (buildInfo, includeDirs) import Distribution.Simple +import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PreProcess import Distribution.Simple.Program import Distribution.Simple.Setup hiding (Flag) -import Distribution.Simple.LocalBuildInfo -import Distribution.PackageDescription -import Distribution.Version -import System.Environment import Distribution.System +import System.Environment #ifdef MIN_VERSION_Cabal #if MIN_VERSION_Cabal(2,0,0) @@ -27,16 +23,22 @@ -- define these selectively in C files (we are _not_ using HsFFI.h), -- rather than universally in the ccOptions, because HsFFI.h currently defines them -- without checking they're already defined and so causes warnings. +uncheckedHsFFIDefines :: [String] uncheckedHsFFIDefines = ["__STDC_LIMIT_MACROS"] #ifndef MIN_VERSION_Cabal_2_0_0 +mkVersion :: [Int] -> Version mkVersion ver = Version ver [] +versionNumbers :: Version -> [Int] versionNumbers = versionBranch +mkFlagName :: String -> FlagName mkFlagName = FlagName #endif +llvmVersion :: Version llvmVersion = mkVersion [5,0] +llvmConfigNames :: [String] llvmConfigNames = [ "llvm-config-" ++ (intercalate "." . map show . versionNumbers $ llvmVersion), "llvm-config" @@ -50,35 +52,9 @@ j -> return j findJustBy _ [] = return Nothing -class ProgramSearch a where - programSearch :: (String -> a) -> a - --- this instance is used before Cabal-1.18.0, when programFindLocation took one argument -instance Monad m => ProgramSearch (v -> m (Maybe b)) where - programSearch checkName = \v -> findJustBy (\n -> checkName n v) llvmConfigNames - --- this instance is used for and after Cabal-1.18.0, when programFindLocation took two arguments -instance Monad m => ProgramSearch (v -> p -> m (Maybe b)) where - programSearch checkName = \v p -> findJustBy (\n -> checkName n v p) llvmConfigNames - -class OldHookable hook where - preHookOld :: (PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO ()) -> hook -> hook - --- this instance is used before Cabal-1.22.0.0, when testHook took four arguments -instance OldHookable (PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO ()) where - preHookOld f hook = \packageDescription localBuildInfo userHooks testFlags -> do - f packageDescription localBuildInfo userHooks testFlags - hook packageDescription localBuildInfo userHooks testFlags - --- this instance is used for and after Cabal-1.22.0.0, when testHook took four five arguments -instance OldHookable (Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO ()) where - preHookOld f hook = \args packageDescription localBuildInfo userHooks testFlags -> do - f packageDescription localBuildInfo userHooks testFlags - hook args packageDescription localBuildInfo userHooks testFlags - llvmProgram :: Program llvmProgram = (simpleProgram "llvm-config") { - programFindLocation = programSearch (programFindLocation . simpleProgram), + programFindLocation = \v p -> findJustBy (\n -> programFindLocation (simpleProgram n) v p) llvmConfigNames, programFindVersion = \verbosity path -> let stripVcsSuffix = takeWhile (\c -> isDigit c || c == '.') @@ -87,11 +63,11 @@ } getLLVMConfig :: ConfigFlags -> IO ([String] -> IO String) -getLLVMConfig configFlags = do - let verbosity = fromFlag $ configVerbosity configFlags +getLLVMConfig confFlags = do + let verbosity = fromFlag $ configVerbosity confFlags (program, _, _) <- requireProgramVersion verbosity llvmProgram (withinVersion llvmVersion) - (configPrograms configFlags) + (configPrograms confFlags) return $ getProgramOutput verbosity program addToLdLibraryPath :: String -> IO () @@ -104,8 +80,8 @@ setEnv ldLibraryPathVar (path ++ either (const "") (ldLibraryPathSep ++) v) addLLVMToLdLibraryPath :: ConfigFlags -> IO () -addLLVMToLdLibraryPath configFlags = do - llvmConfig <- getLLVMConfig configFlags +addLLVMToLdLibraryPath confFlags = do + llvmConfig <- getLLVMConfig confFlags [libDir] <- liftM lines $ llvmConfig ["--libdir"] addToLdLibraryPath libDir @@ -128,14 +104,15 @@ isIgnoredCxxFlag :: String -> Bool isIgnoredCxxFlag flag = flag `elem` ignoredCxxFlags || isIncludeFlag flag +main :: IO () main = do let origUserHooks = simpleUserHooks defaultMainWithHooks origUserHooks { hookedPrograms = [ llvmProgram ], - confHook = \(genericPackageDescription, hookedBuildInfo) configFlags -> do - llvmConfig <- getLLVMConfig configFlags + confHook = \(genericPackageDescription, hookedBuildInfo) confFlags -> do + llvmConfig <- getLLVMConfig confFlags llvmCxxFlags <- do rawLlvmCxxFlags <- llvmConfig ["--cxxflags"] return . filter (not . isIgnoredCxxFlag) $ words rawLlvmCxxFlags @@ -144,10 +121,10 @@ (find (isPrefixOf stdlibPrefix) llvmCxxFlags) where stdlibPrefix = "-stdlib=lib" includeDirs <- liftM lines $ llvmConfig ["--includedir"] - libDirs@[libDir] <- liftM lines $ llvmConfig ["--libdir"] + libDirs <- liftM lines $ llvmConfig ["--libdir"] [llvmVersion] <- liftM lines $ llvmConfig ["--version"] let getLibs = liftM (map (fromJust . stripPrefix "-l") . words) . llvmConfig - flags = configConfigurationsFlags configFlags + flags = configConfigurationsFlags confFlags linkFlag = case lookup (mkFlagName "shared-llvm") flags of Nothing -> "--link-shared" Just shared -> if shared then "--link-shared" else "--link-static" @@ -167,9 +144,9 @@ } } } - configFlags' = configFlags { - configExtraLibDirs = libDirs ++ configExtraLibDirs configFlags, - configExtraIncludeDirs = includeDirs ++ configExtraIncludeDirs configFlags + configFlags' = confFlags { + configExtraLibDirs = libDirs ++ configExtraLibDirs confFlags, + configExtraIncludeDirs = includeDirs ++ configExtraIncludeDirs confFlags } addLLVMToLdLibraryPath configFlags' confHook simpleUserHooks (genericPackageDescription', hookedBuildInfo) configFlags', @@ -191,21 +168,22 @@ let buildInfo' = buildInfo { ccOptions = "-Wno-variadic-macros" : llvmCFlags } runPreProcessor (origHsc buildInfo') inFiles outFiles verbosity } - where origHsc buildInfo = + where origHsc buildInfo' = fromMaybe ppHsc2hs (lookup "hsc" origHookedPreprocessors) - buildInfo + buildInfo' localBuildInfo #ifdef MIN_VERSION_Cabal_2_0_0 componentLocalBuildInfo #endif in [("hsc", newHsc)] ++ origHookedPreprocessors, - buildHook = \packageDescription localBuildInfo userHooks buildFlags -> do - addLLVMToLdLibraryPath (configFlags localBuildInfo) - buildHook origUserHooks packageDescription localBuildInfo userHooks buildFlags, + buildHook = \packageDesc localBuildInfo userHooks buildFlags -> + do addLLVMToLdLibraryPath (configFlags localBuildInfo) + buildHook origUserHooks packageDesc localBuildInfo userHooks buildFlags, - testHook = preHookOld (\_ localBuildInfo _ _ -> addLLVMToLdLibraryPath (configFlags localBuildInfo)) - (testHook origUserHooks) + testHook = \args packageDesc localBuildInfo userHooks testFlags -> + do addLLVMToLdLibraryPath (configFlags localBuildInfo) + testHook origUserHooks args packageDesc localBuildInfo userHooks testFlags } diff --git a/llvm-hs.cabal b/llvm-hs.cabal --- a/llvm-hs.cabal +++ b/llvm-hs.cabal @@ -1,5 +1,5 @@ name: llvm-hs -version: 5.0.0 +version: 5.1.0 license: BSD3 license-file: LICENSE author: Anthony Cowley, Stephen Diehl, Moritz Kiefer , Benjamin S. Scarlet @@ -35,7 +35,7 @@ src/LLVM/Internal/FFI/Target.hpp src/LLVM/Internal/FFI/Type.h src/LLVM/Internal/FFI/Value.h -tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2 +tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1 extra-source-files: CHANGELOG.md source-repository head @@ -61,11 +61,11 @@ , containers library - build-tools: llvm-config + build-tools: hsc2hs, llvm-config ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-orphans if flag(semigroups) build-depends: - base >= 4.7 && < 4.9, + base >= 4.8 && < 4.9, semigroups >= 0.18 && < 0.19 else build-depends: @@ -76,12 +76,11 @@ utf8-string >= 0.3.7, bytestring >= 0.9.1.10, transformers >= 0.3 && < 0.6, - transformers-compat >= 0.4, mtl >= 2.1.3, template-haskell >= 2.5.0.0, containers >= 0.4.2.1, array >= 0.4.0.0, - llvm-hs-pure == 5.0.0 + llvm-hs-pure == 5.1.0 hs-source-dirs: src extensions: NoImplicitPrelude @@ -234,7 +233,7 @@ type: exitcode-stdio-1.0 if flag(semigroups) build-depends: - base >= 4.7 && < 4.9, + base >= 4.8 && < 4.9, semigroups >= 0.18 && < 0.19 else build-depends: @@ -246,11 +245,10 @@ tasty-quickcheck >= 0.8, QuickCheck >= 2.5.1.1, llvm-hs, - llvm-hs-pure == 5.0.0, + llvm-hs-pure == 5.1.0, containers >= 0.4.2.1, mtl >= 2.1, transformers >= 0.3.0.0, - transformers-compat, temporary >= 1.2 && < 1.3, pretty-show >= 1.6 && < 1.7 hs-source-dirs: test @@ -261,6 +259,7 @@ main-is: Test.hs other-modules: LLVM.Test.Analysis + LLVM.Test.Attribute LLVM.Test.CallingConvention LLVM.Test.Constants LLVM.Test.DataLayout diff --git a/src/LLVM/Internal/Attribute.hs b/src/LLVM/Internal/Attribute.hs --- a/src/LLVM/Internal/Attribute.hs +++ b/src/LLVM/Internal/Attribute.hs @@ -1,5 +1,4 @@ {-# LANGUAGE - CPP, MultiParamTypeClasses, ConstraintKinds, QuasiQuotes, @@ -7,12 +6,6 @@ UndecidableInstances, RankNTypes #-} -#if __GLASGOW_HASKELL__ < 710 -{-# LANGUAGE OverlappingInstances #-} -#define CPP_OVERLAPPING -#else -#define CPP_OVERLAPPING {-# OVERLAPPING #-} -#endif module LLVM.Internal.Attribute where import LLVM.Prelude @@ -43,6 +36,10 @@ error $ "llvm-hs internal error: cases inconstistent in " ++ name ++ " encoding for " ++ show attr instance Monad m => EncodeM m A.PA.ParameterAttribute (Ptr FFI.ParameterAttrBuilder -> EncodeAST ()) where + encodeM (A.PA.StringAttribute kind value) = return $ \b -> do + (kindP, kindLen) <- encodeM kind + (valueP, valueLen) <- encodeM value + liftIO $ FFI.attrBuilderAddStringAttribute b kindP kindLen valueP valueLen encodeM a = return $ \b -> liftIO $ case a of A.PA.Alignment v -> FFI.attrBuilderAddAlignment b v A.PA.Dereferenceable v -> FFI.attrBuilderAddDereferenceable b v @@ -67,6 +64,7 @@ A.PA.Alignment _ -> inconsistentCases "ParameterAttribute" a A.PA.Dereferenceable _ -> inconsistentCases "ParameterAttribute" a A.PA.DereferenceableOrNull _ -> inconsistentCases "ParameterAttribute" a + A.PA.StringAttribute _ _ -> inconsistentCases "ParameterAttribute" a instance Monad m => EncodeM m A.FA.FunctionAttribute (Ptr FFI.FunctionAttrBuilder -> EncodeAST ()) where encodeM (A.FA.StringAttribute kind value) = return $ \b -> do @@ -121,28 +119,35 @@ instance DecodeM DecodeAST A.PA.ParameterAttribute FFI.ParameterAttribute where decodeM a = 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|NoCapture|] -> return A.PA.NoCapture - [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|Returned|] -> return A.PA.Returned - [parameterAttributeKindP|SwiftSelf|] -> return A.PA.SwiftSelf - [parameterAttributeKindP|SwiftError|] -> return A.PA.SwiftError - _ -> error $ "unhandled parameter attribute enum value: " ++ show enum + isString <- decodeM =<< liftIO (FFI.isStringAttribute a) + if isString + then + A.PA.StringAttribute + <$> decodeM (FFI.attributeKindAsString a) + <*> decodeM (FFI.attributeValueAsString a) + 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|NoCapture|] -> return A.PA.NoCapture + [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|Returned|] -> return A.PA.Returned + [parameterAttributeKindP|SwiftSelf|] -> return A.PA.SwiftSelf + [parameterAttributeKindP|SwiftError|] -> return A.PA.SwiftError + _ -> error $ "unhandled parameter attribute enum value: " ++ show enum instance DecodeM DecodeAST A.FA.FunctionAttribute FFI.FunctionAttribute where decodeM a = do @@ -240,7 +245,7 @@ | ReturnAttributes [A.PA.ParameterAttribute] | ParameterAttributes CUInt [A.PA.ParameterAttribute] -instance CPP_OVERLAPPING EncodeM EncodeAST [Either A.FA.GroupID A.FA.FunctionAttribute] FFI.FunctionAttributeSet where +instance {-# OVERLAPPING #-} EncodeM EncodeAST [Either A.FA.GroupID A.FA.FunctionAttribute] FFI.FunctionAttributeSet where encodeM attrs = do ab <- allocaAttrBuilder forM_ attrs $ \attr -> @@ -270,13 +275,21 @@ instance DecodeM DecodeAST AttributeList (FFI.AttrSetDecoder a, a) where decodeM (FFI.AttrSetDecoder attrsAtIndex countParams, a) = do functionAttrSet <- - do attrSet <- - withAttrsAtIndex FFI.functionIndex :: DecodeAST FFI.FunctionAttributeSet - hasAttributes <- - decodeM =<< liftIO (FFI.attributeSetHasAttributes attrSet) - if hasAttributes - then Just . Left <$> getAttributeGroupID attrSet - else return Nothing + do mAttrSet <- + -- function attributes are grouped and decoded later. Since + -- we are sometimes decoding inside of scopeAnyConT, we + -- cannot use withAttrsAtIndex to allocate the attribute + -- set since it will be freed before we decode it. + liftIO . mask_ $ do + attrSet <- + attrsAtIndex a FFI.functionIndex :: IO FFI.FunctionAttributeSet + hasAttributes <- decodeM =<< FFI.attributeSetHasAttributes attrSet + if hasAttributes + then pure (Just attrSet) + else FFI.disposeAttributeSet attrSet >> pure Nothing + case mAttrSet of + Nothing -> pure Nothing + Just attrSet -> Just . Left <$> getAttributeGroupID attrSet returnAttrs <- do attrSet <- withAttrsAtIndex FFI.returnIndex :: DecodeAST FFI.ParameterAttributeSet @@ -284,7 +297,8 @@ numParams <- liftIO (countParams a) paramAttrs <- forM [1 .. numParams] $ \i -> - decodeM =<< (withAttrsAtIndex (FFI.AttributeIndex i) :: DecodeAST FFI.ParameterAttributeSet) + decodeM =<< + (withAttrsAtIndex (FFI.AttributeIndex i) :: DecodeAST FFI.ParameterAttributeSet) return (AttributeList { functionAttributes = maybeToList functionAttrSet diff --git a/src/LLVM/Internal/CallingConvention.hs b/src/LLVM/Internal/CallingConvention.hs --- a/src/LLVM/Internal/CallingConvention.hs +++ b/src/LLVM/Internal/CallingConvention.hs @@ -21,12 +21,14 @@ A.CC.C -> FFI.callingConventionC A.CC.Fast -> FFI.callingConventionFast A.CC.Cold -> FFI.callingConventionCold - A.CC.GHC -> FFI.callingConventionGHC + A.CC.GHC -> FFI.callingConventionGHC A.CC.HiPE -> FFI.callingConventionHiPE A.CC.WebKit_JS -> FFI.callingConventionWebKit_JS A.CC.AnyReg -> FFI.callingConventionAnyReg A.CC.PreserveMost -> FFI.callingConventionPreserveMost A.CC.PreserveAll -> FFI.callingConventionPreserveAll + A.CC.Swift -> FFI.callingConventionSwift + A.CC.CXX_FastTLS -> FFI.callingConventionCXX_FAST_TLS A.CC.X86_StdCall -> FFI.callingConventionX86_StdCall A.CC.X86_FastCall -> FFI.callingConventionX86_FastCall A.CC.ARM_APCS -> FFI.callingConventionARM_APCS @@ -41,6 +43,21 @@ A.CC.Intel_OCL_BI -> FFI.callingConventionIntel_OCL_BI A.CC.X86_64_SysV -> FFI.callingConventionX86_64_SysV A.CC.Win64 -> FFI.callingConventionWin64 + A.CC.X86_VectorCall -> FFI.callingConventionX86_VectorCall + A.CC.HHVM -> FFI.callingConventionHHVM + A.CC.HHVM_C -> FFI.callingConventionHHVM_C + A.CC.X86_Intr -> FFI.callingConventionX86_INTR + A.CC.AVR_Intr -> FFI.callingConventionAVR_INTR + A.CC.AVR_Signal -> FFI.callingConventionAVR_SIGNAL + A.CC.AVR_Builtin -> FFI.callingConventionAVR_BUILTIN + A.CC.AMDGPU_VS -> FFI.callingConventionAMDGPU_VS + A.CC.AMDGPU_HS -> FFI.callingConventionAMDGPU_HS + A.CC.AMDGPU_GS -> FFI.callingConventionAMDGPU_GS + A.CC.AMDGPU_PS -> FFI.callingConventionAMDGPU_PS + A.CC.AMDGPU_CS -> FFI.callingConventionAMDGPU_CS + A.CC.AMDGPU_Kernel -> FFI.callingConventionAMDGPU_KERNEL + A.CC.X86_RegCall -> FFI.callingConventionX86_RegCall + A.CC.MSP430_Builtin -> FFI.callingConventionMSP430_BUILTIN A.CC.Numbered cc' -> FFI.CallingConvention (fromIntegral cc') instance Monad m => DecodeM m A.CC.CallingConvention FFI.CallingConvention where @@ -54,6 +71,8 @@ [callingConventionP|AnyReg|] -> A.CC.AnyReg [callingConventionP|PreserveMost|] -> A.CC.PreserveMost [callingConventionP|PreserveAll|] -> A.CC.PreserveAll + [callingConventionP|Swift|] -> A.CC.Swift + [callingConventionP|CXX_FAST_TLS|] -> A.CC.CXX_FastTLS [callingConventionP|X86_StdCall|] -> A.CC.X86_StdCall [callingConventionP|X86_FastCall|] -> A.CC.X86_FastCall [callingConventionP|ARM_APCS|] -> A.CC.ARM_APCS @@ -68,6 +87,21 @@ [callingConventionP|Intel_OCL_BI|] -> A.CC.Intel_OCL_BI [callingConventionP|X86_64_SysV|] -> A.CC.X86_64_SysV [callingConventionP|Win64|] -> A.CC.Win64 + [callingConventionP|X86_VectorCall|] -> A.CC.X86_VectorCall + [callingConventionP|HHVM|] -> A.CC.HHVM + [callingConventionP|HHVM_C|] -> A.CC.HHVM_C + [callingConventionP|X86_INTR|] -> A.CC.X86_Intr + [callingConventionP|AVR_INTR|] -> A.CC.AVR_Intr + [callingConventionP|AVR_SIGNAL|] -> A.CC.AVR_Signal + [callingConventionP|AVR_BUILTIN|] -> A.CC.AVR_Builtin + [callingConventionP|AMDGPU_VS|] -> A.CC.AMDGPU_VS + [callingConventionP|AMDGPU_HS|] -> A.CC.AMDGPU_HS + [callingConventionP|AMDGPU_GS|] -> A.CC.AMDGPU_GS + [callingConventionP|AMDGPU_PS|] -> A.CC.AMDGPU_PS + [callingConventionP|AMDGPU_CS|] -> A.CC.AMDGPU_CS + [callingConventionP|AMDGPU_KERNEL|] -> A.CC.AMDGPU_Kernel + [callingConventionP|X86_RegCall|] -> A.CC.X86_RegCall + [callingConventionP|MSP430_BUILTIN|] -> A.CC.MSP430_Builtin FFI.CallingConvention (CUInt ci) | ci >= 64 -> A.CC.Numbered (fromIntegral ci) | otherwise -> error ("Unknown calling convention: " <> show ci) diff --git a/src/LLVM/Internal/Coding.hs b/src/LLVM/Internal/Coding.hs --- a/src/LLVM/Internal/Coding.hs +++ b/src/LLVM/Internal/Coding.hs @@ -40,7 +40,7 @@ instance Monad m => DecodeM m $(ht) $(conT ctn) where decodeM c = return $ $( caseE [| c |] ([ match (dataToPatQ n c) (normalB (dataToExpQ n h)) [] | (c,h) <- chs] ++ - [ match wildP (normalB [e| error ("Decoding failed: Unknown " <> $(litE (stringL (nameBase ctn)))) |]) []])) + [ match wildP (normalB [e| error ("Decoding failed: Unknown " <> show c) |]) []])) |] allocaArray :: (Integral i, Storable a, MonadAnyCont IO m) => i -> m (Ptr a) diff --git a/src/LLVM/Internal/Constant.hs b/src/LLVM/Internal/Constant.hs --- a/src/LLVM/Internal/Constant.hs +++ b/src/LLVM/Internal/Constant.hs @@ -225,6 +225,8 @@ return A.C.Array `ap` (return $ A.elementType t) `ap` getConstantOperands [valueSubclassIdP|ConstantDataVector|] -> return A.C.Vector `ap` getConstantData + [valueSubclassIdP|ConstantVector|] -> + A.C.Vector <$> getConstantOperands [valueSubclassIdP|ConstantExpr|] -> do cppOpcode <- liftIO $ FFI.getConstantCPPOpcode c $( diff --git a/src/LLVM/Internal/FFI/Attribute.hs b/src/LLVM/Internal/FFI/Attribute.hs --- a/src/LLVM/Internal/FFI/Attribute.hs +++ b/src/LLVM/Internal/FFI/Attribute.hs @@ -134,7 +134,7 @@ Ptr ParameterAttrBuilder -> ParameterAttributeKind -> IO () foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddStringAttribute" attrBuilderAddStringAttribute :: - Ptr FunctionAttrBuilder -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO () + Ptr (AttrBuilder a) -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> IO () foreign import ccall unsafe "LLVM_Hs_AttrBuilderAddAlignment" attrBuilderAddAlignment :: Ptr ParameterAttrBuilder -> Word64 -> IO () diff --git a/src/LLVM/Internal/FFI/CallingConvention.h b/src/LLVM/Internal/FFI/CallingConvention.h --- a/src/LLVM/Internal/FFI/CallingConvention.h +++ b/src/LLVM/Internal/FFI/CallingConvention.h @@ -2,29 +2,46 @@ #define __LLVM_INTERNAL_FFI__CALLING_CONVENTION__H__ #define LLVM_HS_FOR_EACH_CALLING_CONVENTION(macro) \ - macro(C, 0) \ - macro(Fast, 8) \ - macro(Cold, 9) \ - macro(GHC, 10) \ - macro(HiPE, 11) \ - macro(WebKit_JS, 12) \ - macro(AnyReg, 13) \ - macro(PreserveMost, 14) \ - macro(PreserveAll, 15) \ - macro(X86_StdCall, 64) \ - macro(X86_FastCall, 65) \ - macro(ARM_APCS, 66) \ - macro(ARM_AAPCS, 67) \ - macro(ARM_AAPCS_VFP, 68) \ - macro(MSP430_INTR, 69) \ - macro(X86_ThisCall, 70) \ - macro(PTX_Kernel, 71) \ - macro(PTX_Device, 72) \ - macro(SPIR_FUNC, 75) \ - macro(SPIR_KERNEL, 76) \ - macro(Intel_OCL_BI, 77) \ - macro(X86_64_SysV, 78) \ - macro(Win64, 79) + macro(C, 0) \ + macro(Fast, 8) \ + macro(Cold, 9) \ + macro(GHC, 10) \ + macro(HiPE, 11) \ + macro(WebKit_JS, 12) \ + macro(AnyReg, 13) \ + macro(PreserveMost, 14) \ + macro(PreserveAll, 15) \ + macro(Swift, 16) \ + macro(CXX_FAST_TLS, 17) \ + macro(X86_StdCall, 64) \ + macro(X86_FastCall, 65) \ + macro(ARM_APCS, 66) \ + macro(ARM_AAPCS, 67) \ + macro(ARM_AAPCS_VFP, 68) \ + macro(MSP430_INTR, 69) \ + macro(X86_ThisCall, 70) \ + macro(PTX_Kernel, 71) \ + macro(PTX_Device, 72) \ + macro(SPIR_FUNC, 75) \ + macro(SPIR_KERNEL, 76) \ + macro(Intel_OCL_BI, 77) \ + macro(X86_64_SysV, 78) \ + macro(Win64, 79) \ + macro(X86_VectorCall, 80) \ + macro(HHVM, 81) \ + macro(HHVM_C, 82) \ + macro(X86_INTR, 83) \ + macro(AVR_INTR, 84) \ + macro(AVR_SIGNAL, 85) \ + macro(AVR_BUILTIN, 86) \ + macro(AMDGPU_VS, 87) \ + macro(AMDGPU_GS, 88) \ + macro(AMDGPU_PS, 89) \ + macro(AMDGPU_CS, 90) \ + macro(AMDGPU_KERNEL, 91) \ + macro(X86_RegCall, 92) \ + macro(AMDGPU_HS, 93) \ + macro(MSP430_BUILTIN, 94) typedef enum { #define ENUM_CASE(l,n) LLVM_Hs_CallingConvention_ ## l = n, diff --git a/src/LLVM/Internal/FFI/Instruction.h b/src/LLVM/Internal/FFI/Instruction.h --- a/src/LLVM/Internal/FFI/Instruction.h +++ b/src/LLVM/Internal/FFI/Instruction.h @@ -59,7 +59,8 @@ #define LLVM_HS_FOR_EACH_TAIL_CALL_KIND(macro) \ macro(None) \ macro(Tail) \ - macro(MustTail) + macro(MustTail) \ + macro(NoTail) typedef enum { #define ENUM_CASE(x) LLVM_Hs_TailCallKind_ ## x, diff --git a/src/LLVM/Internal/FFI/LLVMCTypes.hsc b/src/LLVM/Internal/FFI/LLVMCTypes.hsc --- a/src/LLVM/Internal/FFI/LLVMCTypes.hsc +++ b/src/LLVM/Internal/FFI/LLVMCTypes.hsc @@ -121,22 +121,22 @@ #{inject FAST_MATH_FLAG, FastMathFlags, FastMathFlags, fastMathFlags, FMF_Rec} newtype MemoryOrdering = MemoryOrdering CUInt - deriving (Eq, Typeable, Data, Generic) + deriving (Eq, Show, Typeable, Data, Generic) #define MO_Rec(n) { #n, LLVMAtomicOrdering ## n }, #{inject ATOMIC_ORDERING, MemoryOrdering, MemoryOrdering, memoryOrdering, MO_Rec} newtype UnnamedAddr = UnnamedAddr CUInt - deriving (Eq, Typeable, Data, Generic) + deriving (Eq, Show, Typeable, Data, Generic) #define UA_Rec(n) { #n, LLVMUnnamedAddr ## n }, #{inject UNNAMED_ADDR, UnnamedAddr, UnnamedAddr, unnamedAddr, UA_Rec} newtype SynchronizationScope = SynchronizationScope CUInt - deriving (Eq, Typeable, Data, Generic) + deriving (Eq, Show, Typeable, Data, Generic) #define SS_Rec(n) { #n, LLVM ## n ## SynchronizationScope }, #{inject SYNCRONIZATION_SCOPE, SynchronizationScope, SynchronizationScope, synchronizationScope, SS_Rec} newtype TailCallKind = TailCallKind CUInt - deriving (Eq, Typeable, Data, Generic) + deriving (Eq, Show, Typeable, Data, Generic) #define TCK_Rec(n) { #n, LLVM_Hs_TailCallKind_ ## n }, #{inject TAIL_CALL_KIND, TailCallKind, TailCallKind, tailCallKind, TCK_Rec} @@ -219,6 +219,31 @@ deriving (Eq, Read, Show, Typeable, Data, Generic) #define FPOFM_Rec(n) { #n, LLVM_Hs_FPOpFusionMode_ ## n }, #{inject FP_OP_FUSION_MODE, FPOpFusionMode, FPOpFusionMode, fpOpFusionMode, FPOFM_Rec} + +newtype ThreadModel = ThreadModel CUInt + deriving (Eq, Read, Show, Typeable, Data, Generic) +#define TM_Rec(n) { #n, LLVM_Hs_ThreadModel_ ## n }, +#{inject THREAD_MODEL, ThreadModel, ThreadModel, threadModel, TM_Rec} + +newtype EABI = EABI CUInt + deriving (Eq, Read, Show, Typeable, Data, Generic) +#define EABI_Rec(n) { #n, LLVM_Hs_EABI_ ## n }, +#{inject EABI, EABI, EABI, eabiVersion, EABI_Rec} + +newtype DebuggerKind = DebuggerKind CUInt + deriving (Eq, Read, Show, Typeable, Data, Generic) +#define DBGK_Rec(n) { #n, LLVM_Hs_DebuggerKind_ ## n }, +#{inject DEBUGGER_KIND, DebuggerKind, DebuggerKind, debuggerKind, DBGK_Rec} + +newtype FPDenormalMode = FPDenormalMode CUInt + deriving (Eq, Read, Show, Typeable, Data, Generic) +#define FPDM_Rec(n) { #n, LLVM_Hs_FPDenormalMode_ ## n }, +#{inject FP_DENORMAL_MODE, FPDenormalMode, FPDenormalMode, fpDenormalMode, FPDM_Rec} + +newtype ExceptionHandling = ExceptionHandling CUInt + deriving (Eq, Read, Show, Typeable, Data, Generic) +#define EH_Rec(n) { #n, LLVM_Hs_ExceptionHandling_ ## n }, +#{inject EXCEPTION_HANDLING, ExceptionHandling, ExceptionHandling, exceptionHandling, EH_Rec} newtype TargetOptionFlag = TargetOptionFlag CUInt deriving (Eq, Read, Show, Typeable, Data, Generic) diff --git a/src/LLVM/Internal/FFI/PtrHierarchy.hs b/src/LLVM/Internal/FFI/PtrHierarchy.hs --- a/src/LLVM/Internal/FFI/PtrHierarchy.hs +++ b/src/LLVM/Internal/FFI/PtrHierarchy.hs @@ -2,15 +2,8 @@ ForeignFunctionInterface, MultiParamTypeClasses, FunctionalDependencies, - UndecidableInstances, - CPP + UndecidableInstances #-} -#if __GLASGOW_HASKELL__ < 710 -{-# LANGUAGE OverlappingInstances #-} -#define CPP_OVERLAPPING -#else -#define CPP_OVERLAPPING {-# OVERLAPPING #-} -#endif -- | This module defines typeclasses to represent the relationships of an object-oriented inheritance hierarchy module LLVM.Internal.FFI.PtrHierarchy where @@ -24,7 +17,7 @@ upCast = castPtr -- | trivial casts -instance CPP_OVERLAPPING DescendentOf a a where +instance {-# OVERLAPPING #-} DescendentOf a a where upCast = id -- | a class to represent direct parent-child relationships diff --git a/src/LLVM/Internal/FFI/Target.h b/src/LLVM/Internal/FFI/Target.h --- a/src/LLVM/Internal/FFI/Target.h +++ b/src/LLVM/Internal/FFI/Target.h @@ -30,13 +30,22 @@ macro(UnsafeFPMath) \ macro(NoInfsFPMath) \ macro(NoNaNsFPMath) \ + macro(NoTrappingFPMath) \ + macro(NoSignedZerosFPMath) \ macro(HonorSignDependentRoundingFPMathOption) \ macro(NoZerosInBSS) \ macro(GuaranteedTailCallOpt) \ + macro(StackSymbolOrdering) \ macro(EnableFastISel) \ macro(UseInitArray) \ macro(DisableIntegratedAS) \ - macro(TrapUnreachable) + macro(RelaxELFRelocations) \ + macro(FunctionSections) \ + macro(DataSections) \ + macro(UniqueSectionNames) \ + macro(TrapUnreachable) \ + macro(EmulatedTLS) \ + macro(EnableIPRA) typedef enum { #define ENUM_CASE(n) LLVM_Hs_TargetOptionFlag_ ## n, @@ -76,5 +85,64 @@ LLVM_HS_FOR_EACH_FP_OP_FUSION_MODE(ENUM_CASE) #undef ENUM_CASE } LLVM_Hs_FPOpFusionMode; + +#define LLVM_HS_FOR_EACH_THREAD_MODEL(macro) \ + macro(POSIX) \ + macro(Single) + +typedef enum { +#define ENUM_CASE(n) LLVM_Hs_ThreadModel_ ## n, + LLVM_HS_FOR_EACH_THREAD_MODEL(ENUM_CASE) +#undef ENUM_CASE +} LLVM_Hs_ThreadModel; + +#define LLVM_HS_FOR_EACH_EABI(macro) \ + macro(Unknown) \ + macro(Default) \ + macro(EABI4) \ + macro(EABI5) \ + macro(GNU) + +typedef enum { +#define ENUM_CASE(n) LLVM_Hs_EABI_ ## n, + LLVM_HS_FOR_EACH_EABI(ENUM_CASE) +#undef ENUM_CASE +} LLVM_Hs_EABI; + +#define LLVM_HS_FOR_EACH_DEBUGGER_KIND(macro) \ + macro(Default) \ + macro(GDB) \ + macro(LLDB) \ + macro(SCE) + +typedef enum { +#define ENUM_CASE(n) LLVM_Hs_DebuggerKind_ ## n, + LLVM_HS_FOR_EACH_DEBUGGER_KIND(ENUM_CASE) +#undef ENUM_CASE +} LLVM_Hs_DebuggerKind; + +#define LLVM_HS_FOR_EACH_FP_DENORMAL_MODE(macro) \ + macro(IEEE) \ + macro(PreserveSign) \ + macro(PositiveZero) + +typedef enum { +#define ENUM_CASE(n) LLVM_Hs_FPDenormalMode_ ## n, + LLVM_HS_FOR_EACH_FP_DENORMAL_MODE(ENUM_CASE) +#undef ENUM_CASE +} LLVM_Hs_FPDenormalMode; + +#define LLVM_HS_FOR_EACH_EXCEPTION_HANDLING(macro) \ + macro(None) \ + macro(DwarfCFI) \ + macro(SjLj) \ + macro(ARM) \ + macro(WinEH) + +typedef enum { +#define ENUM_CASE(n) LLVM_Hs_ExceptionHandling_ ## n, + LLVM_HS_FOR_EACH_EXCEPTION_HANDLING(ENUM_CASE) +#undef ENUM_CASE +} LLVM_Hs_ExceptionHandling; #endif diff --git a/src/LLVM/Internal/FFI/Target.hs b/src/LLVM/Internal/FFI/Target.hs --- a/src/LLVM/Internal/FFI/Target.hs +++ b/src/LLVM/Internal/FFI/Target.hs @@ -58,12 +58,42 @@ foreign import ccall unsafe "LLVM_Hs_GetAllowFPOpFusion" getAllowFPOpFusion :: Ptr TargetOptions -> IO FPOpFusionMode +foreign import ccall unsafe "LLVM_Hs_SetThreadModel" setThreadModel :: + Ptr TargetOptions -> ThreadModel -> IO () + +foreign import ccall unsafe "LLVM_Hs_GetThreadModel" getThreadModel :: + Ptr TargetOptions -> IO ThreadModel + +foreign import ccall unsafe "LLVM_Hs_SetEABIVersion" setEABIVersion :: + Ptr TargetOptions -> EABI -> IO () + +foreign import ccall unsafe "LLVM_Hs_GetEABIVersion" getEABIVersion :: + Ptr TargetOptions -> IO EABI + +foreign import ccall unsafe "LLVM_Hs_SetDebuggerTuning" setDebuggerTuning :: + Ptr TargetOptions -> DebuggerKind -> IO () + +foreign import ccall unsafe "LLVM_Hs_GetDebuggerTuning" getDebuggerTuning :: + Ptr TargetOptions -> IO DebuggerKind + +foreign import ccall unsafe "LLVM_Hs_SetFPDenormalMode" setFPDenormalMode :: + Ptr TargetOptions -> FPDenormalMode -> IO () + +foreign import ccall unsafe "LLVM_Hs_GetFPDenormalMode" getFPDenormalMode :: + Ptr TargetOptions -> IO FPDenormalMode + +foreign import ccall unsafe "LLVM_Hs_SetExceptionModel" setExceptionModel :: + Ptr TargetOptions -> ExceptionHandling -> IO () + +foreign import ccall unsafe "LLVM_Hs_GetExceptionModel" getExceptionModel :: + Ptr TargetOptions -> IO ExceptionHandling + foreign import ccall unsafe "LLVM_Hs_DisposeTargetOptions" disposeTargetOptions :: Ptr TargetOptions -> IO () data TargetMachine -foreign import ccall unsafe "LLVMCreateTargetMachine" createTargetMachine :: +foreign import ccall unsafe "LLVM_Hs_CreateTargetMachine" createTargetMachine :: Ptr Target -> CString -> CString @@ -76,6 +106,9 @@ foreign import ccall unsafe "LLVMDisposeTargetMachine" disposeTargetMachine :: Ptr TargetMachine -> IO () + +foreign import ccall unsafe "LLVM_Hs_TargetMachineOptions" targetMachineOptions :: + Ptr TargetMachine -> IO (Ptr TargetOptions) foreign import ccall unsafe "LLVM_Hs_TargetMachineEmit" targetMachineEmit :: Ptr TargetMachine diff --git a/src/LLVM/Internal/FFI/TargetC.cpp b/src/LLVM/Internal/FFI/TargetC.cpp --- a/src/LLVM/Internal/FFI/TargetC.cpp +++ b/src/LLVM/Internal/FFI/TargetC.cpp @@ -1,9 +1,9 @@ #define __STDC_LIMIT_MACROS -#include "llvm-c/Target.h" #include "LLVM/Internal/FFI/LibFunc.h" #include "LLVM/Internal/FFI/Target.h" #include "LLVM/Internal/FFI/Target.hpp" #include "llvm-c/Core.h" +#include "llvm-c/Target.h" #include "llvm-c/TargetMachine.h" #include "llvm/ADT/Triple.h" #include "llvm/Analysis/TargetLibraryInfo.h" @@ -11,6 +11,7 @@ #include "llvm/IR/DataLayout.h" #include "llvm/IR/LegacyPassManager.h" #include "llvm/IR/Module.h" +#include "llvm/Support/CodeGenCWrappers.h" #include "llvm/Support/FormattedStream.h" #include "llvm/Support/Host.h" #include "llvm/Support/TargetRegistry.h" @@ -24,155 +25,277 @@ // These functions need to be marked as static to avoid undefined behavior // due to multiple definitions static LLVMTargetRef wrap(const Target *P) { - return reinterpret_cast(const_cast(P)); + return reinterpret_cast(const_cast(P)); } +static Target *unwrap(LLVMTargetRef P) { return reinterpret_cast(P); } + static inline TargetLibraryInfoImpl *unwrap(LLVMTargetLibraryInfoRef P) { - return reinterpret_cast(P); + return reinterpret_cast(P); } static inline LLVMTargetLibraryInfoRef wrap(const TargetLibraryInfoImpl *P) { - TargetLibraryInfoImpl *X = const_cast(P); - return reinterpret_cast(X); + TargetLibraryInfoImpl *X = const_cast(P); + return reinterpret_cast(X); } static FloatABI::ABIType unwrap(LLVM_Hs_FloatABI x) { - switch (x) { + switch (x) { #define ENUM_CASE(x) \ - case LLVM_Hs_FloatABI_##x: \ - return FloatABI::x; - LLVM_HS_FOR_EACH_FLOAT_ABI(ENUM_CASE) + case LLVM_Hs_FloatABI_##x: \ + return FloatABI::x; + LLVM_HS_FOR_EACH_FLOAT_ABI(ENUM_CASE) #undef ENUM_CASE - default: - return FloatABI::ABIType(0); - } + default: + return FloatABI::ABIType(0); + } } static LibFunc unwrap(LLVMLibFunc x) { - switch (x) { + switch (x) { #define ENUM_CASE(x) \ - case LLVMLibFunc__##x: \ - return LibFunc_ ## x; - LLVM_HS_FOR_EACH_LIB_FUNC(ENUM_CASE) + case LLVMLibFunc__##x: \ + return LibFunc_##x; + LLVM_HS_FOR_EACH_LIB_FUNC(ENUM_CASE) #undef ENUM_CASE - default: - return LibFunc(0); - } + default: + return LibFunc(0); + } } static LLVMLibFunc wrap(LibFunc x) { - switch (x) { + switch (x) { #define ENUM_CASE(x) \ - case LibFunc_ ## x: \ - return LLVMLibFunc__##x; - LLVM_HS_FOR_EACH_LIB_FUNC(ENUM_CASE) + case LibFunc_##x: \ + return LLVMLibFunc__##x; + LLVM_HS_FOR_EACH_LIB_FUNC(ENUM_CASE) #undef ENUM_CASE - default: - return LLVMLibFunc(0); - } + default: + return LLVMLibFunc(0); + } } static LLVM_Hs_FloatABI wrap(FloatABI::ABIType x) { - switch (x) { + switch (x) { #define ENUM_CASE(x) \ - case FloatABI::x: \ - return LLVM_Hs_FloatABI_##x; - LLVM_HS_FOR_EACH_FLOAT_ABI(ENUM_CASE) + case FloatABI::x: \ + return LLVM_Hs_FloatABI_##x; + LLVM_HS_FOR_EACH_FLOAT_ABI(ENUM_CASE) #undef ENUM_CASE - default: - return LLVM_Hs_FloatABI(0); - } + default: + return LLVM_Hs_FloatABI(0); + } } static FPOpFusion::FPOpFusionMode unwrap(LLVM_Hs_FPOpFusionMode x) { - switch (x) { + switch (x) { #define ENUM_CASE(x) \ - case LLVM_Hs_FPOpFusionMode_##x: \ - return FPOpFusion::x; - LLVM_HS_FOR_EACH_FP_OP_FUSION_MODE(ENUM_CASE) + case LLVM_Hs_FPOpFusionMode_##x: \ + return FPOpFusion::x; + LLVM_HS_FOR_EACH_FP_OP_FUSION_MODE(ENUM_CASE) #undef ENUM_CASE - default: - return FPOpFusion::FPOpFusionMode(0); - } + default: + return FPOpFusion::FPOpFusionMode(0); + } } static LLVM_Hs_FPOpFusionMode wrap(FPOpFusion::FPOpFusionMode x) { - switch (x) { + switch (x) { #define ENUM_CASE(x) \ - case FPOpFusion::x: \ - return LLVM_Hs_FPOpFusionMode_##x; - LLVM_HS_FOR_EACH_FP_OP_FUSION_MODE(ENUM_CASE) + case FPOpFusion::x: \ + return LLVM_Hs_FPOpFusionMode_##x; + LLVM_HS_FOR_EACH_FP_OP_FUSION_MODE(ENUM_CASE) #undef ENUM_CASE - default: - return LLVM_Hs_FPOpFusionMode(0); - } + default: + return LLVM_Hs_FPOpFusionMode(0); + } } + +static ThreadModel::Model unwrap(LLVM_Hs_ThreadModel x) { + switch (x) { +#define ENUM_CASE(x) \ + case LLVM_Hs_ThreadModel_##x: \ + return ThreadModel::x; + LLVM_HS_FOR_EACH_THREAD_MODEL(ENUM_CASE) +#undef ENUM_CASE + default: + return ThreadModel::Model(0); + } } +static LLVM_Hs_ThreadModel wrap(ThreadModel::Model x) { + switch (x) { +#define ENUM_CASE(x) \ + case ThreadModel::x: \ + return LLVM_Hs_ThreadModel_##x; + LLVM_HS_FOR_EACH_THREAD_MODEL(ENUM_CASE) +#undef ENUM_CASE + default: + return LLVM_Hs_ThreadModel(0); + } +} +static EABI unwrap(LLVM_Hs_EABI x) { + switch (x) { +#define ENUM_CASE(x) \ + case LLVM_Hs_EABI_##x: \ + return EABI::x; + LLVM_HS_FOR_EACH_EABI(ENUM_CASE) +#undef ENUM_CASE + default: + return EABI(0); + } +} + +static LLVM_Hs_EABI wrap(EABI x) { + switch (x) { +#define ENUM_CASE(x) \ + case EABI::x: \ + return LLVM_Hs_EABI_##x; + LLVM_HS_FOR_EACH_EABI(ENUM_CASE) +#undef ENUM_CASE + default: + return LLVM_Hs_EABI(0); + } +} + +static DebuggerKind unwrap(LLVM_Hs_DebuggerKind x) { + switch (x) { +#define ENUM_CASE(x) \ + case LLVM_Hs_DebuggerKind_##x: \ + return DebuggerKind::x; + LLVM_HS_FOR_EACH_DEBUGGER_KIND(ENUM_CASE) +#undef ENUM_CASE + default: + return DebuggerKind(0); + } +} + +static LLVM_Hs_DebuggerKind wrap(DebuggerKind x) { + switch (x) { +#define ENUM_CASE(x) \ + case DebuggerKind::x: \ + return LLVM_Hs_DebuggerKind_##x; + LLVM_HS_FOR_EACH_DEBUGGER_KIND(ENUM_CASE) +#undef ENUM_CASE + default: + return LLVM_Hs_DebuggerKind(0); + } +} + +static FPDenormal::DenormalMode unwrap(LLVM_Hs_FPDenormalMode x) { + switch (x) { +#define ENUM_CASE(x) \ + case LLVM_Hs_FPDenormalMode_##x: \ + return FPDenormal::x; + LLVM_HS_FOR_EACH_FP_DENORMAL_MODE(ENUM_CASE) +#undef ENUM_CASE + default: + return FPDenormal::DenormalMode(0); + } +} + +static LLVM_Hs_FPDenormalMode wrap(FPDenormal::DenormalMode x) { + switch (x) { +#define ENUM_CASE(x) \ + case FPDenormal::x: \ + return LLVM_Hs_FPDenormalMode_##x; + LLVM_HS_FOR_EACH_FP_DENORMAL_MODE(ENUM_CASE) +#undef ENUM_CASE + default: + return LLVM_Hs_FPDenormalMode(0); + } +} +static ExceptionHandling unwrap(LLVM_Hs_ExceptionHandling x) { + switch (x) { +#define ENUM_CASE(x) \ + case LLVM_Hs_ExceptionHandling_##x: \ + return ExceptionHandling::x; + LLVM_HS_FOR_EACH_EXCEPTION_HANDLING(ENUM_CASE) +#undef ENUM_CASE + default: + return ExceptionHandling(0); + } +} + +static LLVM_Hs_ExceptionHandling wrap(ExceptionHandling x) { + switch (x) { +#define ENUM_CASE(x) \ + case ExceptionHandling::x: \ + return LLVM_Hs_ExceptionHandling_##x; + LLVM_HS_FOR_EACH_EXCEPTION_HANDLING(ENUM_CASE) +#undef ENUM_CASE + default: + return LLVM_Hs_ExceptionHandling(0); + } +} + +} // namespace llvm + extern "C" { LLVMBool LLVM_Hs_InitializeNativeTarget() { - return LLVMInitializeNativeTarget() || InitializeNativeTargetAsmPrinter() || - InitializeNativeTargetAsmParser(); + return LLVMInitializeNativeTarget() || InitializeNativeTargetAsmPrinter() || + InitializeNativeTargetAsmParser(); } LLVMTargetRef LLVM_Hs_LookupTarget(const char *arch, const char *ctriple, - const char **tripleOut, - const char **cerror) { - std::string error; - Triple triple(ctriple); - if (const Target *result = - TargetRegistry::lookupTarget(arch, triple, error)) { - *tripleOut = strdup(triple.getTriple().c_str()); - return wrap(result); - } - *cerror = strdup(error.c_str()); - return 0; + const char **tripleOut, + const char **cerror) { + std::string error; + Triple triple(ctriple); + if (const Target *result = + TargetRegistry::lookupTarget(arch, triple, error)) { + *tripleOut = strdup(triple.getTriple().c_str()); + return wrap(result); + } + *cerror = strdup(error.c_str()); + return 0; } TargetOptions *LLVM_Hs_CreateTargetOptions() { - TargetOptions *to = new TargetOptions(); - return to; + TargetOptions *to = new TargetOptions(); + return to; } -void LLVM_Hs_SetTargetOptionFlag(TargetOptions *to, - LLVM_Hs_TargetOptionFlag f, - unsigned v) { - switch (f) { +void LLVM_Hs_SetTargetOptionFlag(TargetOptions *to, LLVM_Hs_TargetOptionFlag f, + unsigned v) { + switch (f) { #define ENUM_CASE(op) \ - case LLVM_Hs_TargetOptionFlag_##op: \ - to->op = v ? 1 : 0; \ - break; - LLVM_HS_FOR_EACH_TARGET_OPTION_FLAG(ENUM_CASE) + case LLVM_Hs_TargetOptionFlag_##op: \ + to->op = v ? 1 : 0; \ + break; + LLVM_HS_FOR_EACH_TARGET_OPTION_FLAG(ENUM_CASE) #undef ENUM_CASE - } + } } -static llvm::DebugCompressionType unwrap(LLVM_Hs_DebugCompressionType compressionType) { - switch(compressionType) { -#define ENUM_CASE(op) \ - case LLVM_Hs_DebugCompressionType_ ## op: \ - return llvm::DebugCompressionType::op; +static llvm::DebugCompressionType +unwrap(LLVM_Hs_DebugCompressionType compressionType) { + switch (compressionType) { +#define ENUM_CASE(op) \ + case LLVM_Hs_DebugCompressionType_##op: \ + return llvm::DebugCompressionType::op; LLVM_HS_FOR_EACH_DEBUG_COMPRESSION_TYPE(ENUM_CASE) #undef ENUM_CASE default: - assert(false && "Unknown debug compression type"); + assert(false && "Unknown debug compression type"); return llvm::DebugCompressionType::None; } } -static LLVM_Hs_DebugCompressionType wrap(llvm::DebugCompressionType compressionType) { - switch(compressionType) { -#define ENUM_CASE(op) \ - case llvm::DebugCompressionType::op: \ - return LLVM_Hs_DebugCompressionType_ ## op; +static LLVM_Hs_DebugCompressionType +wrap(llvm::DebugCompressionType compressionType) { + switch (compressionType) { +#define ENUM_CASE(op) \ + case llvm::DebugCompressionType::op: \ + return LLVM_Hs_DebugCompressionType_##op; LLVM_HS_FOR_EACH_DEBUG_COMPRESSION_TYPE(ENUM_CASE) #undef ENUM_CASE default: { - assert(false && "Unknown debug compression type"); - return LLVM_Hs_DebugCompressionType_None; - } + assert(false && "Unknown debug compression type"); + return LLVM_Hs_DebugCompressionType_None; } + } } void LLVM_Hs_SetCompressDebugSections(TargetOptions *to, @@ -180,49 +303,89 @@ to->CompressDebugSections = unwrap(compress); } -LLVM_Hs_DebugCompressionType LLVM_Hs_GetCompressDebugSections(TargetOptions* to) { +LLVM_Hs_DebugCompressionType +LLVM_Hs_GetCompressDebugSections(TargetOptions *to) { return wrap(to->CompressDebugSections); } unsigned LLVM_Hs_GetTargetOptionFlag(TargetOptions *to, - LLVM_Hs_TargetOptionFlag f) { - switch (f) { + LLVM_Hs_TargetOptionFlag f) { + switch (f) { #define ENUM_CASE(op) \ - case LLVM_Hs_TargetOptionFlag_##op: \ - return to->op; - LLVM_HS_FOR_EACH_TARGET_OPTION_FLAG(ENUM_CASE) + case LLVM_Hs_TargetOptionFlag_##op: \ + return to->op; + LLVM_HS_FOR_EACH_TARGET_OPTION_FLAG(ENUM_CASE) #undef ENUM_CASE - default: - assert(false && "Unknown target option flag"); - return 0; - } + default: + assert(false && "Unknown target option flag"); + return 0; + } } void LLVM_Hs_SetStackAlignmentOverride(TargetOptions *to, unsigned v) { - to->StackAlignmentOverride = v; + to->StackAlignmentOverride = v; } unsigned LLVM_Hs_GetStackAlignmentOverride(TargetOptions *to) { - return to->StackAlignmentOverride; + return to->StackAlignmentOverride; } void LLVM_Hs_SetFloatABIType(TargetOptions *to, LLVM_Hs_FloatABI v) { - to->FloatABIType = unwrap(v); + to->FloatABIType = unwrap(v); } LLVM_Hs_FloatABI LLVM_Hs_GetFloatABIType(TargetOptions *to) { - return wrap(to->FloatABIType); + return wrap(to->FloatABIType); } -void LLVM_Hs_SetAllowFPOpFusion(TargetOptions *to, - LLVM_Hs_FPOpFusionMode v) { - to->AllowFPOpFusion = unwrap(v); +void LLVM_Hs_SetAllowFPOpFusion(TargetOptions *to, LLVM_Hs_FPOpFusionMode v) { + to->AllowFPOpFusion = unwrap(v); } LLVM_Hs_FPOpFusionMode LLVM_Hs_GetAllowFPOpFusion(TargetOptions *to) { - return wrap(to->AllowFPOpFusion); + return wrap(to->AllowFPOpFusion); } +void LLVM_Hs_SetThreadModel(TargetOptions *to, LLVM_Hs_ThreadModel v) { + to->ThreadModel = unwrap(v); +} + +LLVM_Hs_ThreadModel LLVM_Hs_GetThreadModel(TargetOptions *to) { + return wrap(to->ThreadModel); +} + +void LLVM_Hs_SetEABIVersion(TargetOptions *to, LLVM_Hs_EABI v) { + to->EABIVersion = unwrap(v); +} + +LLVM_Hs_EABI LLVM_Hs_GetEABIVersion(TargetOptions *to) { + return wrap(to->EABIVersion); +} + +void LLVM_Hs_SetDebuggerTuning(TargetOptions *to, LLVM_Hs_DebuggerKind v) { + to->DebuggerTuning = unwrap(v); +} + +LLVM_Hs_DebuggerKind LLVM_Hs_GetDebuggerTuning(TargetOptions *to) { + return wrap(to->DebuggerTuning); +} + +void LLVM_Hs_SetFPDenormalMode(TargetOptions *to, LLVM_Hs_FPDenormalMode v) { + to->FPDenormalMode = unwrap(v); +} + +LLVM_Hs_FPDenormalMode LLVM_Hs_GetFPDenormalMode(TargetOptions *to) { + return wrap(to->FPDenormalMode); +} + +void LLVM_Hs_SetExceptionModel(TargetOptions *to, LLVM_Hs_ExceptionHandling v) { + to->ExceptionModel = unwrap(v); +} + +LLVM_Hs_ExceptionHandling LLVM_Hs_GetExceptionModel(TargetOptions *to) { + return wrap(to->ExceptionModel); +} + void LLVM_Hs_DisposeTargetOptions(TargetOptions *t) { delete t; } // const TargetLowering *LLVM_Hs_GetTargetLowering(LLVMTargetMachineRef t) @@ -231,125 +394,158 @@ // } char *LLVM_Hs_GetDefaultTargetTriple() { - return strdup(sys::getDefaultTargetTriple().c_str()); + return strdup(sys::getDefaultTargetTriple().c_str()); } char *LLVM_Hs_GetProcessTargetTriple() { - return strdup(sys::getProcessTriple().c_str()); + return strdup(sys::getProcessTriple().c_str()); } const char *LLVM_Hs_GetHostCPUName(size_t &len) { - StringRef r = sys::getHostCPUName(); - len = r.size(); - return r.data(); + StringRef r = sys::getHostCPUName(); + len = r.size(); + return r.data(); } char *LLVM_Hs_GetHostCPUFeatures() { - StringMap featureMap; - std::string features; - if (sys::getHostCPUFeatures(featureMap)) { - bool first = true; - for (llvm::StringMap::const_iterator it = featureMap.begin(); - it != featureMap.end(); ++it) { - if (!first) { - features += ","; - } - first = false; - features += (it->second ? "+" : "-") + it->first().str(); + StringMap featureMap; + std::string features; + if (sys::getHostCPUFeatures(featureMap)) { + bool first = true; + for (llvm::StringMap::const_iterator it = featureMap.begin(); + it != featureMap.end(); ++it) { + if (!first) { + features += ","; + } + first = false; + features += (it->second ? "+" : "-") + it->first().str(); + } } - } - return strdup(features.c_str()); + return strdup(features.c_str()); } char *LLVM_Hs_GetTargetMachineDataLayout(LLVMTargetMachineRef t) { - return strdup( - unwrap(t)->createDataLayout().getStringRepresentation().c_str()); + return strdup( + unwrap(t)->createDataLayout().getStringRepresentation().c_str()); } -LLVMTargetLibraryInfoRef -LLVM_Hs_CreateTargetLibraryInfo(const char *triple) { - const TargetLibraryInfoImpl* p = new TargetLibraryInfoImpl(Triple(triple)); +LLVMTargetLibraryInfoRef LLVM_Hs_CreateTargetLibraryInfo(const char *triple) { + const TargetLibraryInfoImpl *p = new TargetLibraryInfoImpl(Triple(triple)); return wrap(p); } -LLVMBool LLVM_Hs_GetLibFunc( - LLVMTargetLibraryInfoRef l, - const char *funcName, - LLVMLibFunc *f -) { - LibFunc func; - LLVMBool result = unwrap(l)->getLibFunc(funcName, func); - *f = wrap(func); - return result; +LLVMBool LLVM_Hs_GetLibFunc(LLVMTargetLibraryInfoRef l, const char *funcName, + LLVMLibFunc *f) { + LibFunc func; + LLVMBool result = unwrap(l)->getLibFunc(funcName, func); + *f = wrap(func); + return result; } -const char *LLVM_Hs_LibFuncGetName( - LLVMTargetLibraryInfoRef l, - LLVMLibFunc f, - size_t *nameSize -) { - TargetLibraryInfo impl(*unwrap(l)); +const char *LLVM_Hs_LibFuncGetName(LLVMTargetLibraryInfoRef l, LLVMLibFunc f, + size_t *nameSize) { + TargetLibraryInfo impl(*unwrap(l)); StringRef s = impl.getName(unwrap(f)); - *nameSize = s.size(); - return s.data(); + *nameSize = s.size(); + return s.data(); } -void LLVM_Hs_LibFuncSetAvailableWithName( - LLVMTargetLibraryInfoRef l, - LLVMLibFunc f, - const char *name -) { - unwrap(l)->setAvailableWithName(unwrap(f), name); +void LLVM_Hs_LibFuncSetAvailableWithName(LLVMTargetLibraryInfoRef l, + LLVMLibFunc f, const char *name) { + unwrap(l)->setAvailableWithName(unwrap(f), name); } void LLVM_Hs_DisposeTargetLibraryInfo(LLVMTargetLibraryInfoRef l) { - delete unwrap(l); + delete unwrap(l); } void LLVM_Hs_InitializeAllTargets() { - InitializeAllTargetInfos(); - InitializeAllTargets(); - InitializeAllTargetMCs(); - InitializeAllAsmPrinters(); - // None of the other components are bound yet + InitializeAllTargetInfos(); + InitializeAllTargets(); + InitializeAllTargetMCs(); + InitializeAllAsmPrinters(); + // None of the other components are bound yet } -// This is identical to LLVMTargetMachineEmit but LLVM doesn’t expose this function so we copy it here. -LLVMBool LLVM_Hs_TargetMachineEmit( - LLVMTargetMachineRef T, - LLVMModuleRef M, - raw_pwrite_stream *OS, - LLVMCodeGenFileType codegen, - char **ErrorMessage -) { - TargetMachine* TM = unwrap(T); - Module* Mod = unwrap(M); +LLVMTargetMachineRef +LLVM_Hs_CreateTargetMachine(LLVMTargetRef T, const char *Triple, + const char *CPU, const char *Features, + TargetOptions *TO, LLVMCodeGenOptLevel Level, + LLVMRelocMode Reloc, LLVMCodeModel CodeModel) { + Optional RM; + switch (Reloc) { + case LLVMRelocStatic: + RM = Reloc::Static; + break; + case LLVMRelocPIC: + RM = Reloc::PIC_; + break; + case LLVMRelocDynamicNoPic: + RM = Reloc::DynamicNoPIC; + break; + default: + break; + } - legacy::PassManager pass; + CodeModel::Model CM = unwrap(CodeModel); - std::string error; + CodeGenOpt::Level OL; + switch (Level) { + case LLVMCodeGenLevelNone: + OL = CodeGenOpt::None; + break; + case LLVMCodeGenLevelLess: + OL = CodeGenOpt::Less; + break; + case LLVMCodeGenLevelAggressive: + OL = CodeGenOpt::Aggressive; + break; + default: + OL = CodeGenOpt::Default; + break; + } - Mod->setDataLayout(TM->createDataLayout()); + return wrap( + unwrap(T)->createTargetMachine(Triple, CPU, Features, *TO, RM, CM, OL)); +} - TargetMachine::CodeGenFileType ft; - switch (codegen) { +TargetOptions *LLVM_Hs_TargetMachineOptions(LLVMTargetMachineRef TM) { + return &unwrap(TM)->Options; +} + +// This is identical to LLVMTargetMachineEmit but LLVM doesn’t expose this +// function so we copy it here. +LLVMBool LLVM_Hs_TargetMachineEmit(LLVMTargetMachineRef T, LLVMModuleRef M, + raw_pwrite_stream *OS, + LLVMCodeGenFileType codegen, + char **ErrorMessage) { + TargetMachine *TM = unwrap(T); + Module *Mod = unwrap(M); + + legacy::PassManager pass; + + std::string error; + + Mod->setDataLayout(TM->createDataLayout()); + + TargetMachine::CodeGenFileType ft; + switch (codegen) { case LLVMAssemblyFile: - ft = TargetMachine::CGFT_AssemblyFile; - break; + ft = TargetMachine::CGFT_AssemblyFile; + break; default: - ft = TargetMachine::CGFT_ObjectFile; - break; - } - if (TM->addPassesToEmitFile(pass, *OS, ft)) { - error = "TargetMachine can't emit a file of this type"; - *ErrorMessage = strdup(error.c_str()); - return true; - } + ft = TargetMachine::CGFT_ObjectFile; + break; + } + if (TM->addPassesToEmitFile(pass, *OS, ft)) { + error = "TargetMachine can't emit a file of this type"; + *ErrorMessage = strdup(error.c_str()); + return true; + } - pass.run(*Mod); + pass.run(*Mod); - OS->flush(); - return false; + OS->flush(); + return false; } - } diff --git a/src/LLVM/Internal/Module.hs b/src/LLVM/Internal/Module.hs --- a/src/LLVM/Internal/Module.hs +++ b/src/LLVM/Internal/Module.hs @@ -23,6 +23,7 @@ import qualified Data.Map as Map import qualified LLVM.Internal.FFI.Assembly as FFI +import qualified LLVM.Internal.FFI.Attribute as FFI import qualified LLVM.Internal.FFI.Builder as FFI import qualified LLVM.Internal.FFI.Bitcode as FFI import qualified LLVM.Internal.FFI.Function as FFI @@ -518,8 +519,10 @@ metadata <- getMetadataDefinitions functionAttributes <- do functionAttributes <- gets $ functionAttributeListIDs - forM functionAttributes $ \(as, gid) -> - A.FunctionAttributes <$> return gid <*> decodeM as + forM functionAttributes $ \(as, gid) -> do + fAttrs <- A.FunctionAttributes <$> return gid <*> decodeM as + liftIO (FFI.disposeAttributeSet as) + pure fAttrs comdats <- gets $ map (uncurry A.COMDAT) . Map.elems . comdats return $ structDefinitions ++ diff --git a/src/LLVM/Internal/TailCallKind.hs b/src/LLVM/Internal/TailCallKind.hs --- a/src/LLVM/Internal/TailCallKind.hs +++ b/src/LLVM/Internal/TailCallKind.hs @@ -14,5 +14,6 @@ genCodingInstance [t| Maybe A.TailCallKind |] ''FFI.TailCallKind [ (FFI.tailCallKindNone, Nothing), (FFI.tailCallKindTail, Just A.Tail), - (FFI.tailCallKindMustTail, Just A.MustTail) + (FFI.tailCallKindMustTail, Just A.MustTail), + (FFI.tailCallKindNoTail, Just A.NoTail) ] diff --git a/src/LLVM/Internal/Target.hs b/src/LLVM/Internal/Target.hs --- a/src/LLVM/Internal/Target.hs +++ b/src/LLVM/Internal/Target.hs @@ -80,6 +80,40 @@ (FFI.debugCompressionTypeZ, TO.CompressZ) ] +genCodingInstance[t| TO.ThreadModel |] ''FFI.ThreadModel [ + (FFI.threadModelPOSIX, TO.ThreadModelPOSIX), + (FFI.threadModelSingle, TO.ThreadModelSingle) + ] + +genCodingInstance[t| TO.EABIVersion |] ''FFI.EABI [ + (FFI.eabiVersionUnknown, TO.EABIVersionUnknown), + (FFI.eabiVersionDefault, TO.EABIVersionDefault), + (FFI.eabiVersionEABI4, TO.EABIVersion4), + (FFI.eabiVersionEABI5, TO.EABIVersion5), + (FFI.eabiVersionGNU, TO.EABIVersionGNU) + ] + +genCodingInstance[t| TO.DebuggerKind |] ''FFI.DebuggerKind [ + (FFI.debuggerKindDefault, TO.DebuggerDefault), + (FFI.debuggerKindGDB, TO.DebuggerGDB), + (FFI.debuggerKindLLDB, TO.DebuggerLLDB), + (FFI.debuggerKindSCE, TO.DebuggerSCE) + ] + +genCodingInstance[t| TO.FloatingPointDenormalMode |] ''FFI.FPDenormalMode [ + (FFI.fpDenormalModeIEEE, TO.FloatingPointDenormalIEEE), + (FFI.fpDenormalModePreserveSign, TO.FloatingPointDenormalPreserveSign), + (FFI.fpDenormalModePositiveZero, TO.FloatingPointDenormalPositiveZero) + ] + +genCodingInstance[t| TO.ExceptionHandling |] ''FFI.ExceptionHandling [ + (FFI.exceptionHandlingNone, TO.ExceptionHandlingNone), + (FFI.exceptionHandlingDwarfCFI, TO.ExceptionHandlingDwarfCFI), + (FFI.exceptionHandlingSjLj, TO.ExceptionHandlingSjLj), + (FFI.exceptionHandlingARM, TO.ExceptionHandlingARM), + (FFI.exceptionHandlingWinEH, TO.ExceptionHandlingWinEH) + ] + -- | newtype Target = Target (Ptr FFI.Target) @@ -136,18 +170,32 @@ (FFI.targetOptionFlagUnsafeFPMath, TO.unsafeFloatingPointMath), (FFI.targetOptionFlagNoInfsFPMath, TO.noInfinitiesFloatingPointMath), (FFI.targetOptionFlagNoNaNsFPMath, TO.noNaNsFloatingPointMath), + (FFI.targetOptionFlagNoTrappingFPMath, TO.noTrappingFloatingPointMath), + (FFI.targetOptionFlagNoSignedZerosFPMath, TO.noSignedZeroesFloatingPointMath), (FFI.targetOptionFlagHonorSignDependentRoundingFPMathOption, TO.honorSignDependentRoundingFloatingPointMathOption), (FFI.targetOptionFlagNoZerosInBSS, TO.noZerosInBSS), (FFI.targetOptionFlagGuaranteedTailCallOpt, TO.guaranteedTailCallOptimization), + (FFI.targetOptionFlagStackSymbolOrdering, TO.stackSymbolOrdering), (FFI.targetOptionFlagEnableFastISel, TO.enableFastInstructionSelection), (FFI.targetOptionFlagUseInitArray, TO.useInitArray), (FFI.targetOptionFlagDisableIntegratedAS, TO.disableIntegratedAssembler), - (FFI.targetOptionFlagTrapUnreachable, TO.trapUnreachable) + (FFI.targetOptionFlagRelaxELFRelocations, TO.relaxELFRelocations), + (FFI.targetOptionFlagFunctionSections, TO.functionSections), + (FFI.targetOptionFlagDataSections, TO.dataSections), + (FFI.targetOptionFlagUniqueSectionNames, TO.uniqueSectionNames), + (FFI.targetOptionFlagTrapUnreachable, TO.trapUnreachable), + (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) + FFI.setThreadModel cOpts =<< encodeM (TO.threadModel hOpts) + FFI.setEABIVersion cOpts =<< encodeM (TO.eabiVersion hOpts) + FFI.setDebuggerTuning cOpts =<< encodeM (TO.debuggerTuning hOpts) + FFI.setFPDenormalMode cOpts =<< encodeM (TO.floatingPointDenormalMode hOpts) + FFI.setExceptionModel cOpts =<< encodeM (TO.exceptionModel hOpts) -- | get all target options peekTargetOptions :: TargetOptions -> IO TO.Options @@ -161,12 +209,18 @@ <- gof FFI.targetOptionFlagNoInfsFPMath noNaNsFloatingPointMath <- gof FFI.targetOptionFlagNoNaNsFPMath + noTrappingFloatingPointMath + <- gof FFI.targetOptionFlagNoTrappingFPMath + noSignedZeroesFloatingPointMath + <- gof FFI.targetOptionFlagNoSignedZerosFPMath honorSignDependentRoundingFloatingPointMathOption <- gof FFI.targetOptionFlagHonorSignDependentRoundingFPMathOption noZerosInBSS <- gof FFI.targetOptionFlagNoZerosInBSS guaranteedTailCallOptimization <- gof FFI.targetOptionFlagGuaranteedTailCallOpt + stackSymbolOrdering + <- gof FFI.targetOptionFlagStackSymbolOrdering enableFastInstructionSelection <- gof FFI.targetOptionFlagEnableFastISel useInitArray @@ -174,11 +228,28 @@ disableIntegratedAssembler <- gof FFI.targetOptionFlagDisableIntegratedAS compressDebugSections <- decodeM =<< FFI.getCompressDebugSections tOpts + relaxELFRelocations + <- gof FFI.targetOptionFlagRelaxELFRelocations + functionSections + <- gof FFI.targetOptionFlagFunctionSections + dataSections + <- gof FFI.targetOptionFlagDataSections + uniqueSectionNames + <- gof FFI.targetOptionFlagUniqueSectionNames trapUnreachable <- gof FFI.targetOptionFlagTrapUnreachable + emulatedThreadLocalStorage + <- 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 + eabiVersion <- decodeM =<< FFI.getEABIVersion tOpts + debuggerTuning <- decodeM =<< FFI.getDebuggerTuning tOpts + floatingPointDenormalMode <- decodeM =<< FFI.getFPDenormalMode tOpts + exceptionModel <- decodeM =<< FFI.getExceptionModel tOpts return TO.Options { .. } -- | @@ -224,6 +295,9 @@ ) FFI.disposeTargetMachine . (. TargetMachine) + +targetMachineOptions :: TargetMachine -> IO TargetOptions +targetMachineOptions (TargetMachine tm) = TargetOptions <$> FFI.targetMachineOptions tm -- | newtype TargetLowering = TargetLowering (Ptr FFI.TargetLowering) diff --git a/src/LLVM/Target.hs b/src/LLVM/Target.hs --- a/src/LLVM/Target.hs +++ b/src/LLVM/Target.hs @@ -7,7 +7,7 @@ Target, TargetMachine, TargetLowering, CPUFeature(..), withTargetOptions, peekTargetOptions, pokeTargetOptions, - withTargetMachine, withHostTargetMachine, + withTargetMachine, withHostTargetMachine, targetMachineOptions, getTargetLowering, getTargetMachineTriple, getDefaultTargetTriple, getProcessTargetTriple, getHostCPUName, getHostCPUFeatures, getTargetMachineDataLayout, initializeNativeTarget, initializeAllTargets, diff --git a/src/LLVM/Target/Options.hs b/src/LLVM/Target/Options.hs --- a/src/LLVM/Target/Options.hs +++ b/src/LLVM/Target/Options.hs @@ -24,6 +24,45 @@ | CompressZ -- ^ zlib style compression deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) +-- | +data ThreadModel + = ThreadModelPOSIX + | ThreadModelSingle + deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + +-- | +data DebuggerKind + = DebuggerDefault + | DebuggerGDB + | DebuggerLLDB + | DebuggerSCE + deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + +-- | +data EABIVersion + = EABIVersionUnknown + | EABIVersionDefault + | EABIVersion4 + | EABIVersion5 + | EABIVersionGNU + deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + +-- | +data FloatingPointDenormalMode + = FloatingPointDenormalIEEE -- ^ IEEE 754 denormal numbers + | FloatingPointDenormalPreserveSign -- ^ The sign of a flushed-to-zero number is preserved in the sign of 0 + | FloatingPointDenormalPositiveZero -- ^ Denormals are flushed to positive zero + deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + +-- | +data ExceptionHandling + = ExceptionHandlingNone -- ^ No exception support + | ExceptionHandlingDwarfCFI -- ^ DWARF-like instruction based exceptions + | ExceptionHandlingSjLj -- ^ setjmp/longjmp based exceptions + | ExceptionHandlingARM -- ^ ARM EHABI + | ExceptionHandlingWinEH -- ^ Windows Exception Handling + deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + -- | The options of a 'LLVM.Target.TargetOptions' -- data Options = Options { @@ -31,17 +70,30 @@ unsafeFloatingPointMath :: Bool, noInfinitiesFloatingPointMath :: Bool, noNaNsFloatingPointMath :: Bool, + noTrappingFloatingPointMath :: Bool, + noSignedZeroesFloatingPointMath :: Bool, honorSignDependentRoundingFloatingPointMathOption :: Bool, noZerosInBSS :: Bool, guaranteedTailCallOptimization :: Bool, + stackSymbolOrdering :: Bool, enableFastInstructionSelection :: Bool, useInitArray :: Bool, disableIntegratedAssembler :: Bool, compressDebugSections :: DebugCompressionType, + relaxELFRelocations :: Bool, + functionSections :: Bool, + dataSections :: Bool, + uniqueSectionNames :: Bool, trapUnreachable :: Bool, + emulatedThreadLocalStorage :: Bool, + enableInterProceduralRegisterAllocation :: Bool, stackAlignmentOverride :: Word32, floatABIType :: FloatABI, - allowFloatingPointOperationFusion :: FloatingPointOperationFusionMode + allowFloatingPointOperationFusion :: FloatingPointOperationFusionMode, + threadModel :: ThreadModel, + eabiVersion :: EABIVersion, + debuggerTuning :: DebuggerKind, + floatingPointDenormalMode :: FloatingPointDenormalMode, + exceptionModel :: ExceptionHandling } deriving (Eq, Ord, Read, Show) - diff --git a/test/LLVM/Test/Attribute.hs b/test/LLVM/Test/Attribute.hs new file mode 100644 --- /dev/null +++ b/test/LLVM/Test/Attribute.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE OverloadedStrings #-} +module LLVM.Test.Attribute + ( tests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import LLVM +import LLVM.AST +import LLVM.AST.CallingConvention (CallingConvention(C)) +import LLVM.AST.Constant (Constant (Int, GlobalReference)) +import LLVM.AST.FunctionAttribute +import LLVM.AST.Global (basicBlocks, name, returnType) +import LLVM.AST.Type (i32, ptr) +import LLVM.Context + +import Data.List +import Prelude + +moduleAst :: LLVM.AST.Module +moduleAst = + defaultModule + { moduleDefinitions = + [ GlobalDefinition + (functionDefaults + { returnType = i32 + , name = "f" + , basicBlocks = + [ BasicBlock + (UnName 0) + [] + (Do + (Ret + { returnOperand = Just (ConstantOperand (Int 32 42)) + , metadata' = [] + })) + ] + }) + , GlobalDefinition + (functionDefaults + { returnType = i32 + , name = "call_15" + , basicBlocks = + [ BasicBlock + (UnName 0) + [ "result" := + Call + { tailCallKind = Nothing + , callingConvention = C + , returnAttributes = [] + , function = + Right + (ConstantOperand + (GlobalReference + (ptr + (FunctionType + { resultType = i32 + , argumentTypes = [] + , isVarArg = False + })) + ("f"))) + , arguments = [] + , functionAttributes = [Left (GroupID 0)] + , metadata = [] + } + ] + (Do + (Ret + { returnOperand = Just (LocalReference i32 ("result")) + , metadata' = [] + })) + ] + }) + , FunctionAttributes + (GroupID 0) + [ AlwaysInline + , ArgMemOnly + , Builtin + , Cold + , Convergent + , InaccessibleMemOnly + , InaccessibleMemOrArgMemOnly + , InlineHint + , JumpTable + , MinimizeSize + , Naked + , NoBuiltin + , NoDuplicate + , NoImplicitFloat + , NoInline + , NoRecurse + , NoRedZone + , NoReturn + , NoUnwind + , NonLazyBind + , OptimizeForSize + , OptimizeNone + , ReadNone + , ReadOnly + , ReturnsTwice + , SafeStack + , SanitizeAddress + , SanitizeMemory + , SanitizeThread + , StackProtect + , StackProtectReq + , StackProtectStrong + , UWTable + , WriteOnly + , AllocSize 8 (Just 16) + , StackAlignment 8 + , StringAttribute "bar" "baz" + , StringAttribute "foo" "" + , StringAttribute "qux" "" + ] + ] + } + +moduleStr :: String +moduleStr = + unlines + [ "define i32 @f() {" + , " ret i32 42" + , "}" + , "" + , "define i32 @call_15() {" + , " %result = call i32 @f() \"foo\" \"bar\"=\"baz\" #0 alignstack(8) allocsize(8) allocsize(8, 16) alwaysinline argmemonly builtin cold convergent inaccessiblemem_or_argmemonly inaccessiblememonly inlinehint jumptable minsize naked nobuiltin noduplicate noimplicitfloat noinline nonlazybind norecurse noredzone noreturn nounwind optnone optsize readnone readonly returns_twice safestack sanitize_address sanitize_memory sanitize_thread ssp sspreq sspstrong uwtable writeonly" + , " ret i32 %result" + , "}" + , "" + , "attributes #0 = { \"qux\" }" + ] + +tests :: TestTree +tests = + testGroup "Attributes" + [ testCase "decoding of call attributes" $ do + withContext $ \ctx -> do + withModuleFromLLVMAssembly ctx moduleStr $ \m -> do + ast <- moduleAST m + ast @?= moduleAst + ] diff --git a/test/LLVM/Test/CallingConvention.hs b/test/LLVM/Test/CallingConvention.hs --- a/test/LLVM/Test/CallingConvention.hs +++ b/test/LLVM/Test/CallingConvention.hs @@ -43,6 +43,8 @@ ("anyregcc", CC.AnyReg), ("preserve_mostcc", CC.PreserveMost), ("preserve_allcc", CC.PreserveAll), + ("swiftcc", CC.Swift), + ("cxx_fast_tlscc", CC.CXX_FastTLS), ("x86_stdcallcc", CC.X86_StdCall), ("x86_fastcallcc", CC.X86_FastCall), ("arm_apcscc", CC.ARM_APCS), @@ -56,6 +58,21 @@ ("spir_kernel", CC.SPIR_KERNEL), ("intel_ocl_bicc", CC.Intel_OCL_BI), ("x86_64_sysvcc", CC.X86_64_SysV), - ("win64cc", CC.Win64) + ("win64cc", CC.Win64), + ("x86_vectorcallcc", CC.X86_VectorCall), + ("hhvmcc", CC.HHVM), + ("hhvm_ccc", CC.HHVM_C), + ("x86_intrcc", CC.X86_Intr), + ("avr_intrcc ", CC.AVR_Intr), -- The spaces are necessary because there is a typo in LLVM’s printer + ("avr_signalcc ", CC.AVR_Signal), + ("cc86", CC.AVR_Builtin), + ("amdgpu_vs", CC.AMDGPU_VS), + ("amdgpu_hs", CC.AMDGPU_HS), + ("amdgpu_gs", CC.AMDGPU_GS), + ("amdgpu_ps", CC.AMDGPU_PS), + ("amdgpu_cs", CC.AMDGPU_CS), + ("amdgpu_kernel", CC.AMDGPU_Kernel), + ("x86_regcallcc", CC.X86_RegCall), + ("cc94", CC.MSP430_Builtin) ] ] diff --git a/test/LLVM/Test/Module.hs b/test/LLVM/Test/Module.hs --- a/test/LLVM/Test/Module.hs +++ b/test/LLVM/Test/Module.hs @@ -64,6 +64,11 @@ \ 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\ + \ 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\ \ %1 = mul nsw i32 %x, %x\n\ @@ -176,6 +181,29 @@ ] }, GlobalDefinition $ functionDefaults { + G.returnType = i32, + G.name = Name "baz", + G.prefix = Just (C.Int 32 1), + G.basicBlocks = [ + BasicBlock (UnName 0) [ + UnName 1 := Call { + tailCallKind = Just NoTail, + callingConvention = CC.C, + 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 8 4), [PA.SignExt]) + ], + functionAttributes = [Left (FA.GroupID 0)], + metadata = [] + } + ] ( + Do $ Ret (Just (LocalReference i32 (UnName 1))) [] + ) + ] + }, + GlobalDefinition $ functionDefaults { G.returnAttributes = [PA.ZeroExt], G.returnType = i32, G.name = Name "foo", @@ -274,6 +302,8 @@ \main:\n\ \\t.cfi_startproc\n\ \\txorl\t%eax, %eax\n\ + \\tmovl\t%edi, -4(%rsp)\n\ + \\tmovq\t%rsi, -16(%rsp)\n\ \\tretq\n\ \.Lfunc_end0:\n\ \\t.size\tmain, .Lfunc_end0-main\n\ diff --git a/test/LLVM/Test/Target.hs b/test/LLVM/Test/Target.hs --- a/test/LLVM/Test/Target.hs +++ b/test/LLVM/Test/Target.hs @@ -6,26 +6,30 @@ #-} module LLVM.Test.Target where -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.QuickCheck -import Test.QuickCheck +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import Test.QuickCheck -import Control.Applicative -import Control.Monad -import Control.Monad.IO.Class +import Control.Applicative +import Control.Monad +import Control.Monad.IO.Class import qualified Data.ByteString.Char8 as ByteString -import Data.Char -import Data.Map (Map) -import Foreign.C.String +import Data.Char +import Data.Map (Map) +import Data.Monoid (mempty) +import Foreign.C.String -import LLVM.Context -import LLVM.Internal.Coding -import LLVM.Internal.EncodeAST -import LLVM.Internal.DecodeAST -import LLVM.Target -import LLVM.Target.Options -import LLVM.Target.LibraryFunction +import qualified LLVM.CodeGenOpt as CodeGenOpt +import qualified LLVM.CodeModel as CodeModel +import LLVM.Context +import LLVM.Internal.Coding +import LLVM.Internal.DecodeAST +import LLVM.Internal.EncodeAST +import qualified LLVM.Relocation as Reloc +import LLVM.Target +import LLVM.Target.LibraryFunction +import LLVM.Target.Options instance Arbitrary FloatABI where arbitrary = elements [minBound .. maxBound] @@ -33,23 +37,52 @@ instance Arbitrary FloatingPointOperationFusionMode where arbitrary = elements [minBound .. maxBound] +instance Arbitrary ThreadModel where + arbitrary = elements [minBound .. maxBound] + +instance Arbitrary EABIVersion where + arbitrary = elements [minBound .. maxBound] + +instance Arbitrary DebuggerKind where + arbitrary = elements [minBound .. maxBound] + +instance Arbitrary FloatingPointDenormalMode where + arbitrary = elements [minBound .. maxBound] + +instance Arbitrary ExceptionHandling where + arbitrary = elements [minBound .. maxBound] + instance Arbitrary Options where arbitrary = do printMachineCode <- arbitrary unsafeFloatingPointMath <- arbitrary noInfinitiesFloatingPointMath <- arbitrary noNaNsFloatingPointMath <- arbitrary + noTrappingFloatingPointMath <- arbitrary + noSignedZeroesFloatingPointMath <- arbitrary honorSignDependentRoundingFloatingPointMathOption <- arbitrary noZerosInBSS <- arbitrary guaranteedTailCallOptimization <- arbitrary + stackSymbolOrdering <- arbitrary enableFastInstructionSelection <- arbitrary useInitArray <- arbitrary disableIntegratedAssembler <- arbitrary compressDebugSections <- arbitrary + relaxELFRelocations <- arbitrary + functionSections <- arbitrary + dataSections <- arbitrary + uniqueSectionNames <- arbitrary trapUnreachable <- arbitrary + emulatedThreadLocalStorage <- arbitrary + enableInterProceduralRegisterAllocation <- arbitrary stackAlignmentOverride <- arbitrary floatABIType <- arbitrary allowFloatingPointOperationFusion <- arbitrary + threadModel <- arbitrary + eabiVersion <- arbitrary + debuggerTuning <- arbitrary + floatingPointDenormalMode <- arbitrary + exceptionModel <- arbitrary return Options { .. } instance Arbitrary DebugCompressionType where @@ -72,7 +105,20 @@ withTargetOptions $ \to -> do pokeTargetOptions options to options' <- peekTargetOptions to - return $ options === options' + return $ options === options', + testProperty "target machine" $ \options -> ioProperty $ do + withTargetOptions $ \to -> do + pokeTargetOptions options to + let triple = "i386-linux-gnu" + cpu = "" + features = mempty + reloc = Reloc.Default + codeModel = CodeModel.Default + codeGenOpt = CodeGenOpt.Default + (target, _) <- lookupTarget Nothing triple + withTargetMachine target triple cpu features to reloc codeModel codeGenOpt $ \tm -> do + options' <- peekTargetOptions =<< targetMachineOptions tm + return $ options === options' ], testGroup "LibraryFunction" [ testGroup "set-get" [ diff --git a/test/LLVM/Test/Tests.hs b/test/LLVM/Test/Tests.hs --- a/test/LLVM/Test/Tests.hs +++ b/test/LLVM/Test/Tests.hs @@ -3,6 +3,7 @@ import Test.Tasty import qualified LLVM.Test.Analysis as Analysis +import qualified LLVM.Test.Attribute as Attribute import qualified LLVM.Test.CallingConvention as CallingConvention import qualified LLVM.Test.Constants as Constants import qualified LLVM.Test.DataLayout as DataLayout @@ -25,6 +26,7 @@ CallingConvention.tests, Constants.tests, DataLayout.tests, + Attribute.tests, FunctionAttribute.tests, ExecutionEngine.tests, Global.tests,