ghc-lib 8.10.5.20210606 → 8.10.6.20210814

raw patch · 13 files changed

+95/−50 lines, 13 filesdep ~basedep ~ghc-lib-parserPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, ghc-lib-parser

API changes (from Hackage documentation)

Files

• compiler/GHC/StgToCmm/Prim.hs +3/−3
• compiler/ghci/Linker.hs +2/−2
• compiler/llvmGen/Llvm/PpLlvm.hs +8/−5
• compiler/llvmGen/Llvm/Types.hs +12/−4
• compiler/llvmGen/LlvmCodeGen.hs +3/−3
• compiler/llvmGen/LlvmCodeGen/Base.hs +9/−7
• compiler/llvmGen/LlvmCodeGen/CodeGen.hs +16/−1
• compiler/main/DriverPipeline.hs +2/−2
• compiler/main/SysTools.hs +4/−4
• compiler/main/SysTools/Tasks.hs +31/−9
• ghc-lib.cabal +3/−4
• ghc-lib/stage0/lib/ghcautoconf.h +2/−2
• includes/ghcconfig.h +0/−4

@@ -2599,7 +2599,7 @@         dst_off <- assignTempE dst_off0          -- Nonmoving collector write barrier-        emitCopyUpdRemSetPush dflags (arrPtrsHdrSizeW dflags) dst dst_off n+        emitCopyUpdRemSetPush dflags (arrPtrsHdrSize dflags) dst dst_off n          -- Set the dirty bit in the header.         emit (setInfo dst (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))@@ -2664,7 +2664,7 @@         dst     <- assignTempE dst0          -- Nonmoving collector write barrier-        emitCopyUpdRemSetPush dflags (smallArrPtrsHdrSizeW dflags) dst dst_off n+        emitCopyUpdRemSetPush dflags (smallArrPtrsHdrSize dflags) dst dst_off n          -- Set the dirty bit in the header.         emit (setInfo dst (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel)))@@ -2987,7 +2987,7 @@ -- | Push a range of pointer-array elements that are about to be copied over to -- the update remembered set. emitCopyUpdRemSetPush :: DynFlags-                      -> WordOff    -- ^ array header size+                      -> ByteOff    -- ^ array header size (in bytes)                       -> CmmExpr    -- ^ destination array                       -> CmmExpr    -- ^ offset in destination array (in words)                       -> Int        -- ^ number of elements to copy

@@ -914,7 +914,7 @@                            concatMap (\l -> [ Option ("-l" ++ l) ])                                      (nub $ snd <$> temp_sos)                         ++ concatMap (\lp -> Option ("-L" ++ lp)-                                          : if gopt Opt_RPath dflags+                                          : if useXLinkerRPath dflags (platformOS platform)                                             then [ Option "-Xlinker"                                                  , Option "-rpath"                                                  , Option "-Xlinker"@@ -923,7 +923,7 @@                                      (nub $ fst <$> temp_sos)                         ++ concatMap                              (\lp -> Option ("-L" ++ lp)-                                  : if gopt Opt_RPath dflags+                                  : if useXLinkerRPath dflags (platformOS platform)                                     then [ Option "-Xlinker"                                          , Option "-rpath"                                          , Option "-Xlinker"

@@ -268,7 +268,7 @@     where         ppCall' (LlvmFunctionDecl _ _ cc ret argTy params _) =             let tc = if ct == TailCall then text "tail " else empty-                ppValues = hsep $ punctuate comma $ map ppCallMetaExpr args+                ppValues = ppCallParams (map snd params) args                 ppArgTy  = (ppCommaJoin $ map fst params) <>                            (case argTy of                                VarArgs   -> text ", ..."@@ -279,10 +279,13 @@                     <> fnty <+> ppName fptr <> lparen <+> ppValues                     <+> rparen <+> attrDoc -        -- Metadata needs to be marked as having the `metadata` type when used-        -- in a call argument-        ppCallMetaExpr (MetaVar v) = ppr v-        ppCallMetaExpr v           = text "metadata" <+> ppr v+        ppCallParams :: [[LlvmParamAttr]] -> [MetaExpr] -> SDoc+        ppCallParams attrs args = hsep $ punctuate comma $ zipWith ppCallMetaExpr attrs args+         where+          -- Metadata needs to be marked as having the `metadata` type when used+          -- in a call argument+          ppCallMetaExpr attrs (MetaVar v) = ppVar' attrs v+          ppCallMetaExpr _ v               = text "metadata" <+> ppr v  ppMachOp :: LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc ppMachOp op left right =

@@ -114,10 +114,14 @@   deriving (Eq)  instance Outputable LlvmVar where-  ppr (LMLitVar x)  = ppr x-  ppr (x         )  = ppr (getVarType x) <+> ppName x+  ppr = ppVar' [] +ppVar' :: [LlvmParamAttr] -> LlvmVar -> SDoc+ppVar' attrs v = case v of+  LMLitVar x -> ppTypeLit' attrs x+  x          -> ppr (getVarType x) <+> ppSpaceJoin attrs <+> ppName x + -- | Llvm Literal Data. -- -- These can be used inline in expressions.@@ -135,8 +139,12 @@   deriving (Eq)  instance Outputable LlvmLit where-  ppr l@(LMVectorLit {}) = ppLit l-  ppr l                  = ppr (getLitType l) <+> ppLit l+  ppr = ppTypeLit' []++ppTypeLit' :: [LlvmParamAttr] -> LlvmLit -> SDoc+ppTypeLit' attrs l = case l of+  l@(LMVectorLit {}) -> ppLit l+  _                  -> ppr (getLitType l) <+> ppSpaceJoin attrs <+> ppLit l   -- | Llvm Static Data.

@@ -58,8 +58,8 @@          let doWarn = wopt Opt_WarnUnsupportedLlvmVersion dflags          when (not (llvmVersionSupported ver) && doWarn) $ putMsg dflags $            "You are using an unsupported version of LLVM!" $$-           "Currently only" <+> text (llvmVersionStr supportedLlvmVersionMin) <+>-           "to" <+> text (llvmVersionStr supportedLlvmVersionMax) <+> "is supported." <+>+           "Currently only" <+> text (llvmVersionStr supportedLlvmVersionLowerBound) <+>+           "to" <+> text (llvmVersionStr supportedLlvmVersionUpperBound) <+> "is supported." <+>            "System LLVM version: " <> text (llvmVersionStr ver) $$            "We will try though..."          let isS390X = platformArch (targetPlatform dflags) == ArchS390X@@ -72,7 +72,7 @@        -- currently don't use the LLVM version to guide code generation        -- so this is okay.        let llvm_ver :: LlvmVersion-           llvm_ver = fromMaybe supportedLlvmVersionMin mb_ver+           llvm_ver = fromMaybe supportedLlvmVersionLowerBound mb_ver         -- run code generation        a <- runLlvm dflags llvm_ver bufh $

@@ -14,7 +14,7 @@         LlvmUnresData, LlvmData, UnresLabel, UnresStatic,          LlvmVersion, llvmVersionSupported, parseLlvmVersion,-        supportedLlvmVersionMin, supportedLlvmVersionMax,+        supportedLlvmVersionLowerBound, supportedLlvmVersionUpperBound,         llvmVersionStr, llvmVersionList,          LlvmM,@@ -267,7 +267,6 @@ -- * Llvm Version -- --- Newtype to avoid using the Eq instance! newtype LlvmVersion = LlvmVersion { llvmVersionNE :: NE.NonEmpty Int }   deriving (Eq, Ord) @@ -285,14 +284,17 @@       where         (ver_str, rest) = span isDigit s --- | The LLVM Version that is currently supported.-supportedLlvmVersionMin, supportedLlvmVersionMax :: LlvmVersion-supportedLlvmVersionMin = LlvmVersion (sUPPORTED_LLVM_VERSION_MIN NE.:| [])-supportedLlvmVersionMax = LlvmVersion (sUPPORTED_LLVM_VERSION_MAX NE.:| [])+-- | The (inclusive) lower bound on the LLVM Version that is currently supported.+supportedLlvmVersionLowerBound :: LlvmVersion+supportedLlvmVersionLowerBound = LlvmVersion (sUPPORTED_LLVM_VERSION_MIN NE.:| []) +-- | The (not-inclusive) upper bound  bound on the LLVM Version that is currently supported.+supportedLlvmVersionUpperBound :: LlvmVersion+supportedLlvmVersionUpperBound = LlvmVersion (sUPPORTED_LLVM_VERSION_MAX NE.:| [])+ llvmVersionSupported :: LlvmVersion -> Bool llvmVersionSupported v =-  v > supportedLlvmVersionMin && v <= supportedLlvmVersionMax+  v >= supportedLlvmVersionLowerBound && v < supportedLlvmVersionUpperBound  llvmVersionStr :: LlvmVersion -> String llvmVersionStr = intercalate "." . map show . llvmVersionList

@@ -460,6 +460,12 @@         The native code generator only handles StdCall and CCallConv.     -} +    let arg_type (hint, expr) =+          case expr of+            ty@(LMInt n) | n < 64 && lmconv == CC_Ccc && platformCConvNeedsExtension platform+               -> (ty, if hint == Signed then [SignExt] else [ZeroExt])+            ty -> (ty, [])+     -- call attributes     let fnAttrs | never_returns = NoReturn : llvmStdFunAttrs                 | otherwise     = llvmStdFunAttrs@@ -477,7 +483,7 @@      let retTyCmm = ret_type_cmm ress_hints -    let argTy = tysToParams $ map (snd . primRepToLlvmTy) args_rep+    let argTy = map arg_type $ map primRepToLlvmTy args_rep     let retTy = snd $ primRepToLlvmTy ret_rep     let funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible                              lmconv retTy FixedArgs argTy (llvmFunAlign dflags)@@ -524,6 +530,15 @@                     v2 <- doExprW ty $ Cast op v1 ty                     statement $ Store v2 vreg                     doReturn+ where+  -- | For some architectures the C calling convention is that any+  -- integer shorter than 64 bits is replaced by its 64 bits+  -- representation using sign or zero extension.+  platformCConvNeedsExtension :: Platform -> Bool+  platformCConvNeedsExtension platform = case platformArch platform of+    ArchPPC_64 _ -> True+    ArchS390X    -> True+    _            -> False  -- | Generate a call to an LLVM intrinsic that performs arithmetic operation -- with overflow bit (i.e., returns a struct containing the actual result of the

@@ -1731,7 +1731,7 @@                                  (l `makeRelativeTo` full_output_fn)                             else l                   -- See Note [-Xlinker -rpath vs -Wl,-rpath]-                  rpath = if gopt Opt_RPath dflags+                  rpath = if useXLinkerRPath dflags (platformOS platform)                           then ["-Xlinker", "-rpath", "-Xlinker", libpath]                           else []                   -- Solaris 11's linker does not support -rpath-link option. It silently@@ -1747,7 +1747,7 @@          | osMachOTarget (platformOS platform) &&            dynLibLoader dflags == SystemDependent &&            WayDyn `elem` ways dflags &&-           gopt Opt_RPath dflags+           useXLinkerRPath dflags (platformOS platform)             = let libpath = if gopt Opt_RelativeDynlibPaths dflags                             then "@loader_path" </>                                  (l `makeRelativeTo` full_output_fn)

@@ -248,6 +248,8 @@      pkgs <- getPreloadPackagesAnd dflags dep_packages +    let platform = targetPlatform dflags+        os = platformOS platform     let pkg_lib_paths = collectLibraryPaths dflags pkgs     let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths         get_pkg_lib_path_opts l@@ -257,7 +259,7 @@            -- Only if we want dynamic libraries            WayDyn `elem` ways dflags &&            -- Only use RPath if we explicitly asked for it-           gopt Opt_RPath dflags+           useXLinkerRPath dflags os             = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l]               -- See Note [-Xlinker -rpath vs -Wl,-rpath]          | otherwise = ["-L" ++ l]@@ -272,9 +274,7 @@     -- not allow undefined symbols.     -- The RTS library path is still added to the library search path     -- above in case the RTS is being explicitly linked in (see #3807).-    let platform = targetPlatform dflags-        os = platformOS platform-        pkgs_no_rts = case os of+    let pkgs_no_rts = case os of                       OSMinGW32 ->                           pkgs                       _ ->

@@ -18,19 +18,22 @@ import Util  import Data.List+import Data.Char+import Data.Maybe  import System.IO import System.Process import GhcPrelude -import LlvmCodeGen.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersionMin, supportedLlvmVersionMax, llvmVersionStr, parseLlvmVersion)+import LlvmCodeGen.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersionLowerBound, supportedLlvmVersionUpperBound, llvmVersionStr, parseLlvmVersion)  import SysTools.Process import SysTools.Info -import Control.Monad (join, forM, filterM)+import Control.Monad (join, forM, filterM, void) import System.Directory (doesFileExist) import System.FilePath ((</>))+import Text.ParserCombinators.ReadP as Parser  {- ************************************************************************@@ -236,10 +239,11 @@                 errorMsg dflags $ vcat                     [ text "Warning:", nest 9 $                           text "Couldn't figure out LLVM version!" $$-                          text ("Make sure you have installed LLVM between "-                                ++ llvmVersionStr supportedLlvmVersionMin+                          text ("Make sure you have installed LLVM between ["+                                ++ llvmVersionStr supportedLlvmVersionLowerBound                                 ++ " and "-                                ++ llvmVersionStr supportedLlvmVersionMax) ]+                                ++ llvmVersionStr supportedLlvmVersionUpperBound+                                ++ ")") ]                 return Nothing)  @@ -260,15 +264,15 @@ -- -- See Note [Dynamic linking on macOS] runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO ()+runInjectRPaths dflags _ _ | not (gopt Opt_RPath dflags) = return () runInjectRPaths dflags lib_paths dylib = do   info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib]   -- filter the output for only the libraries. And then drop the @rpath prefix.   let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info   -- find any pre-existing LC_PATH items-  info <- fmap words.lines <$> askOtool dflags Nothing [Option "-l", Option dylib]-  let paths = concatMap f info-        where f ("path":p:_) = [p]-              f _            = []+  info <- lines <$> askOtool dflags Nothing [Option "-l", Option dylib]++  let paths = mapMaybe get_rpath info       lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ]   -- only find those rpaths, that aren't already in the library.   rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l </> f)) lib_paths')@@ -277,6 +281,24 @@     [] -> return ()     _  -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib] +get_rpath :: String -> Maybe FilePath+get_rpath l = case readP_to_S rpath_parser l of+                [(rpath, "")] -> Just rpath+                _ -> Nothing+++rpath_parser :: ReadP FilePath+rpath_parser = do+  skipSpaces+  void $ string "path"+  void $ many1 (satisfy isSpace)+  rpath <- many get+  void $ many1 (satisfy isSpace)+  void $ string "(offset "+  void $ munch1 isDigit+  void $ Parser.char ')'+  skipSpaces+  return rpath  runLink :: DynFlags -> [Option] -> IO () runLink dflags args = traceToolCommand dflags "linker" $ do

@@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib-version: 8.10.5.20210606+version: 8.10.6.20210814 license: BSD3 license-file: LICENSE category: Development@@ -39,7 +39,6 @@     ghc-lib/stage0/compiler/build/primop-vector-tys-exports.hs-incl     ghc-lib/stage0/compiler/build/primop-vector-tys.hs-incl     ghc-lib/stage0/compiler/build/primop-vector-uniques.hs-incl-    includes/ghcconfig.h     includes/MachDeps.h     includes/stg/MachRegs.h     includes/CodeGen.Platform.hs@@ -65,7 +64,6 @@     else         build-depends: Win32     build-depends:-        rts,         ghc-prim > 0.2 && < 0.8,         base >= 4.12 && < 4.16,         containers >= 0.5 && < 0.7,@@ -79,8 +77,9 @@         time >= 1.4 && < 1.10,         transformers == 0.5.*,         process >= 1 && < 1.7,+        rts,         hpc == 0.6.*,-        ghc-lib-parser == 8.10.5.20210606+        ghc-lib-parser == 8.10.6.20210814     build-tools: alex >= 3.1, happy >= 1.19.4     other-extensions:         BangPatterns

@@ -598,10 +598,10 @@ /* #undef pid_t */  /* The maximum supported LLVM version number */-#define sUPPORTED_LLVM_VERSION_MAX (12)+#define sUPPORTED_LLVM_VERSION_MAX (13)  /* The minimum supported LLVM version number */-#define sUPPORTED_LLVM_VERSION_MIN (10)+#define sUPPORTED_LLVM_VERSION_MIN (9)  /* Define to `unsigned int' if <sys/types.h> does not define. */ /* #undef size_t */

@@ -1,4 +0,0 @@-#pragma once--#include "ghcautoconf.h"-#include "ghcplatform.h"