[Git][ghc/ghc][wip/backports-8.8] 6 commits: Build a threaded stage 1 if the bootstrapping GHC supports it.
Ben Gamari
gitlab at gitlab.haskell.org
Wed Jul 8 16:04:25 UTC 2020
Ben Gamari pushed to branch wip/backports-8.8 at Glasgow Haskell Compiler / GHC
Commits:
4cdac979 by Travis Whitaker at 2020-07-08T12:04:12-04:00
Build a threaded stage 1 if the bootstrapping GHC supports it.
(cherry picked from commit 67738db10010fd28a8e997b5c8f83ea591b88a0e)
- - - - -
716fb3d0 by Moritz Angermann at 2020-07-08T12:04:15-04:00
ghc-prim needs to depend on libc and libm
libm is just an empty shell on musl, and all the math functions are contained in
libc.
(cherry picked from commit b455074875d3c8fd3a5787e01dc6f922f3a97bc2)
- - - - -
f8c9b6dd by Artem Pelenitsyn at 2020-07-08T12:04:15-04:00
base: fix sign confusion in log1mexp implementation (fix #17125)
author: claude (https://gitlab.haskell.org/trac-claude)
The correct threshold for log1mexp is -(log 2) with the current specification
of log1mexp. This change improves accuracy for large negative inputs.
To avoid code duplication, a small helper function is added;
it isn't the default implementation in Floating because it needs Ord.
This patch does nothing to address that the Haskell specification is
different from that in common use in other languages.
(cherry picked from commit af5e3a885ddd09dd5f550552c535af3661ff3dbf)
- - - - -
317c0f7f by Ryan Scott at 2020-07-08T12:04:15-04:00
Add orderingTyCon to wiredInTyCons (#18185)
`Ordering` needs to be wired in for use in the built-in `CmpNat` and
`CmpSymbol` type families, but somehow it was never added to the list
of `wiredInTyCons`, leading to the various oddities observed
in #18185. Easily fixed by moving `orderingTyCon` from
`basicKnownKeyNames` to `wiredInTyCons`.
Fixes #18185.
(cherry picked from commit 66bd24d197251b9907cbffba3d5d8a3f5e3c2e80)
- - - - -
b79343aa by Ben Gamari at 2020-07-08T12:04:15-04:00
rts/CNF: Fix fixup comparison function
Previously we would implicitly convert the difference between two words
to an int, resulting in an integer overflow on 64-bit machines.
Fixes #16992
(cherry picked from commit c00c81a507d31b6d51e89f00d1e4c83f71c7d382)
- - - - -
0111c371 by GHC GitLab CI at 2020-07-08T12:04:15-04:00
Bump to 8.8.4, RELEASE=YES
- - - - -
18 changed files:
- compiler/ghc.mk
- compiler/prelude/PrelNames.hs
- compiler/prelude/TysWiredIn.hs
- configure.ac
- ghc/ghc.mk
- hadrian/cfg/system.config.in
- hadrian/src/Expression.hs
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Settings/Packages.hs
- libraries/base/GHC/Float.hs
- + libraries/ghc-compact/tests/T16992.hs
- + libraries/ghc-compact/tests/T16992.stdout
- libraries/ghc-compact/tests/all.T
- libraries/ghc-prim/ghc-prim.cabal
- mk/config.mk.in
- rts/sm/CNF.c
- + testsuite/tests/typecheck/should_compile/T18185.hs
- testsuite/tests/typecheck/should_compile/all.T
Changes:
=====================================
compiler/ghc.mk
=====================================
@@ -326,6 +326,12 @@ ifeq "$(GhcThreaded)" "YES"
compiler_stage2_CONFIGURE_OPTS += --ghc-option=-optc-DTHREADED_RTS
endif
+# If the bootstrapping GHC supplies the threaded RTS, then we can have a
+# threaded stage 1 too.
+ifeq "$(GhcThreadedRts)" "YES"
+compiler_stage1_CONFIGURE_OPTS += --ghc-option=-optc-DTHREADED_RTS
+endif
+
ifeq "$(GhcWithNativeCodeGen)" "YES"
compiler_stage1_CONFIGURE_OPTS += --flags=ncg
compiler_stage2_CONFIGURE_OPTS += --flags=ncg
=====================================
compiler/prelude/PrelNames.hs
=====================================
@@ -420,10 +420,6 @@ basicKnownKeyNames
-- Annotation type checking
toAnnotationWrapperName
- -- The Ordering type
- , orderingTyConName
- , ordLTDataConName, ordEQDataConName, ordGTDataConName
-
-- The SPEC type for SpecConstr
, specTyConName
=====================================
compiler/prelude/TysWiredIn.hs
=====================================
@@ -197,8 +197,11 @@ names in PrelNames, so they use wTcQual, wDataQual, etc
-- that occurs in this list that name will be assigned the wired-in key we
-- define here.
--
--- Because of their infinite nature, this list excludes tuples, Any and implicit
--- parameter TyCons (see Note [Built-in syntax and the OrigNameCache]).
+-- Because of their infinite nature, this list excludes
+-- * tuples, including boxed, unboxed and constraint tuples
+--- (mkTupleTyCon, unitTyCon, pairTyCon)
+-- * unboxed sums (sumTyCon)
+-- See Note [Infinite families of known-key names] in GHC.Builtin.Names
--
-- See also Note [Known-key names]
wiredInTyCons :: [TyCon]
@@ -219,6 +222,7 @@ wiredInTyCons = [ -- Units are not treated like other tuples, because then
, wordTyCon
, word8TyCon
, listTyCon
+ , orderingTyCon
, maybeTyCon
, heqTyCon
, eqTyCon
=====================================
configure.ac
=====================================
@@ -13,10 +13,10 @@ dnl
# see what flags are available. (Better yet, read the documentation!)
#
-AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.8.3], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
+AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.8.4], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
# Set this to YES for a released version, otherwise NO
-: ${RELEASE=NO}
+: ${RELEASE=YES}
# The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line
# above. If this is not a released version, then we will append the
@@ -127,6 +127,9 @@ dnl CC_STAGE0 is like the "previous" variable CC (inherited by CC_STAGE[123])
dnl but instead used by stage0 for bootstrapping stage1
AC_ARG_VAR(CC_STAGE0, [C compiler command (bootstrap)])
+dnl RTS ways supplied by the bootstrapping compiler.
+AC_ARG_VAR(RTS_WAYS_STAGE0, [RTS ways])
+
if test "$WithGhc" != ""; then
FPTOOLS_GHC_VERSION([GhcVersion], [GhcMajVersion], [GhcMinVersion], [GhcPatchLevel])dnl
@@ -150,6 +153,17 @@ if test "$WithGhc" != ""; then
BOOTSTRAPPING_GHC_INFO_FIELD([AR_STAGE0],[ar command])
BOOTSTRAPPING_GHC_INFO_FIELD([AR_OPTS_STAGE0],[ar flags])
BOOTSTRAPPING_GHC_INFO_FIELD([ArSupportsAtFile_STAGE0],[ar supports at file])
+ BOOTSTRAPPING_GHC_INFO_FIELD([RTS_WAYS_STAGE0],[RTS ways])
+
+ dnl Check whether or not the bootstrapping GHC has a threaded RTS. This
+ dnl determines whether or not we can have a threaded stage 1.
+ dnl See Note [Linking ghc-bin against threaded stage0 RTS] in
+ dnl hadrian/src/Settings/Packages.hs for details.
+ if echo ${RTS_WAYS_STAGE0} | grep '.*thr.*' 2>&1 >/dev/null; then
+ AC_SUBST(GhcThreadedRts, YES)
+ else
+ AC_SUBST(GhcThreadedRts, NO)
+ fi
fi
dnl ** Must have GHC to build GHC
@@ -1372,6 +1386,7 @@ Configure completed successfully.
echo "\
Bootstrapping using : $WithGhc
which is version : $GhcVersion
+ with threaded RTS? : $GhcThreadedRts
"
if test "x$CC_LLVM_BACKEND" = "x1"; then
=====================================
ghc/ghc.mk
=====================================
@@ -63,6 +63,13 @@ ghc_stage2_MORE_HC_OPTS += -threaded
ghc_stage3_MORE_HC_OPTS += -threaded
endif
+# If stage 0 supplies a threaded RTS, we can use it for stage 1.
+# See Note [Linking ghc-bin against threaded stage0 RTS] in
+# hadrian/src/Settings/Packages.hs for details.
+ifeq "$(GhcThreadedRts)" "YES"
+ghc_stage1_MORE_HC_OPTS += -threaded
+endif
+
ifeq "$(GhcProfiled)" "YES"
ghc_stage2_PROGRAM_WAY = p
endif
=====================================
hadrian/cfg/system.config.in
=====================================
@@ -77,6 +77,8 @@ ghc-major-version = @GhcMajVersion@
ghc-minor-version = @GhcMinVersion@
ghc-patch-level = @GhcPatchLevel@
+bootstrap-threaded-rts = @GhcThreadedRts@
+
supports-this-unit-id = @SUPPORTS_THIS_UNIT_ID@
project-name = @ProjectName@
=====================================
hadrian/src/Expression.hs
=====================================
@@ -26,6 +26,7 @@ import Base
import Builder
import Context hiding (stage, package, way)
import Expression.Type
+import Oracles.Flag
import Hadrian.Expression hiding (Expr, Predicate, Args)
import Hadrian.Haskell.Cabal.Type
import Hadrian.Oracles.Cabal
@@ -99,6 +100,13 @@ stage2 = stage Stage2
notStage0 :: Predicate
notStage0 = notM stage0
+-- | Whether or not the bootstrapping compiler provides a threaded RTS. We need
+-- to know this when building stage 1, since stage 1 links against the
+-- compiler's RTS ways. See Note [Linking ghc-bin against threaded stage0 RTS]
+-- in Settings.Packages for details.
+threadedBootstrapper :: Predicate
+threadedBootstrapper = expr (flag BootstrapThreadedRts)
+
-- | Is a certain package /not/ built right now?
notPackage :: Package -> Predicate
notPackage = notM . package
=====================================
hadrian/src/Oracles/Flag.hs
=====================================
@@ -21,6 +21,7 @@ data Flag = ArSupportsAtFile
| WithLibdw
| HaveLibMingwEx
| UseSystemFfi
+ | BootstrapThreadedRts
-- Note, if a flag is set to empty string we treat it as set to NO. This seems
-- fragile, but some flags do behave like this, e.g. GccIsClang.
@@ -39,6 +40,7 @@ flag f = do
WithLibdw -> "with-libdw"
HaveLibMingwEx -> "have-lib-mingw-ex"
UseSystemFfi -> "use-system-ffi"
+ BootstrapThreadedRts -> "bootstrap-threaded-rts"
value <- lookupValueOrError configFile key
when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag "
++ quote (key ++ " = " ++ value) ++ " cannot be parsed."
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -53,10 +53,15 @@ packageArgs = do
, arg "--disable-library-for-ghci"
, anyTargetOs ["openbsd"] ? arg "--ld-options=-E"
, flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS"
- , notM ghcWithSMP ? arg "--ghc-option=-DNOSMP"
- , notM ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP"
+ , notM targetSupportsSMP ? arg "--ghc-option=-DNOSMP"
+ , notM targetSupportsSMP ? arg "--ghc-option=-optc-DNOSMP"
+ -- When building stage 1 or later, use thread-safe RTS functions if
+ -- the configuration calls for a threaded GHC.
, (any (wayUnit Threaded) rtsWays) ?
notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS"
+ -- When building stage 1, use thread-safe RTS functions if the
+ -- bootstrapping (stage 0) compiler provides a threaded RTS way.
+ , stage0 ? threadedBootstrapper ? arg "--ghc-option=-optc-DTHREADED_RTS"
, ghcWithInterpreter ?
ghcEnableTablesNextToCode ?
notM (flag GhcUnregisterised) ?
@@ -85,10 +90,27 @@ packageArgs = do
, builder (Cabal Flags) ? mconcat
[ ghcWithInterpreter ? notStage0 ? arg "ghci"
, flag CrossCompiling ? arg "-terminfo"
- -- the 'threaded' flag is True by default, but
- -- let's record explicitly that we link all ghc
- -- executables with the threaded runtime.
- , arg "threaded" ] ]
+ -- Note [Linking ghc-bin against threaded stage0 RTS]
+ -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ -- We must maintain the invariant that GHCs linked with '-threaded'
+ -- are built with '-optc=-DTHREADED_RTS', otherwise we'll end up
+ -- with a GHC that can use the threaded runtime, but contains some
+ -- non-thread-safe functions. See
+ -- https://gitlab.haskell.org/ghc/ghc/issues/18024 for an example of
+ -- the sort of issues this can cause.
+ , ifM stage0
+ -- We build a threaded stage 1 if the bootstrapping compiler
+ -- supports it.
+ (ifM threadedBootstrapper
+ (arg "threaded")
+ (arg "-threaded"))
+ -- We build a threaded stage N, N>1 if the configuration calls
+ -- for it.
+ (ifM (ghcThreaded <$> expr flavour)
+ (arg "threaded")
+ (arg "-threaded"))
+ ]
+ ]
-------------------------------- ghcPkg --------------------------------
, package ghcPkg ?
=====================================
libraries/base/GHC/Float.hs
=====================================
@@ -141,6 +141,14 @@ class (Fractional a) => Floating a where
log1pexp x = log1p (exp x)
log1mexp x = log1p (negate (exp x))
+-- | Default implementation for @'log1mexp'@ requiring @'Ord'@ to test
+-- against a threshold to decide which implementation variant to use.
+log1mexpOrd :: (Ord a, Floating a) => a -> a
+{-# INLINE log1mexpOrd #-}
+log1mexpOrd a
+ | a > -(log 2) = log (negate (expm1 a))
+ | otherwise = log1p (negate (exp a))
+
-- | Efficient, machine-independent access to the components of a
-- floating-point number.
class (RealFrac a, Floating a) => RealFloat a where
@@ -398,9 +406,7 @@ instance Floating Float where
log1p = log1pFloat
expm1 = expm1Float
- log1mexp a
- | a <= log 2 = log (negate (expm1Float a))
- | otherwise = log1pFloat (negate (exp a))
+ log1mexp x = log1mexpOrd x
{-# INLINE log1mexp #-}
log1pexp a
| a <= 18 = log1pFloat (exp a)
@@ -539,9 +545,7 @@ instance Floating Double where
log1p = log1pDouble
expm1 = expm1Double
- log1mexp a
- | a <= log 2 = log (negate (expm1Double a))
- | otherwise = log1pDouble (negate (exp a))
+ log1mexp x = log1mexpOrd x
{-# INLINE log1mexp #-}
log1pexp a
| a <= 18 = log1pDouble (exp a)
=====================================
libraries/ghc-compact/tests/T16992.hs
=====================================
@@ -0,0 +1,22 @@
+import Data.Bifunctor
+import Foreign.Ptr
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Unsafe as BS
+import qualified GHC.Compact as Compact
+import qualified GHC.Compact.Serialized as CompactSerialize
+
+-- | Minimal test case for reproducing compactFixupPointers# bug for large compact regions.
+-- See Issue #16992.
+main :: IO ()
+main = do
+ let
+ large = 1024 * 1024 * 128
+ largeString = replicate large 'A'
+
+ region <- Compact.compact largeString
+
+ Just deserialized <- CompactSerialize.withSerializedCompact region $ \s -> do
+ blks <- mapM (BS.unsafePackCStringLen . bimap castPtr fromIntegral) (CompactSerialize.serializedCompactBlockList s)
+ CompactSerialize.importCompactByteStrings s blks
+
+ print (Compact.getCompact deserialized == largeString)
=====================================
libraries/ghc-compact/tests/T16992.stdout
=====================================
@@ -0,0 +1 @@
+True
=====================================
libraries/ghc-compact/tests/all.T
=====================================
@@ -22,3 +22,8 @@ test('compact_share', omit_ways(['ghci', 'profasm', 'profthreaded']),
test('compact_bench', [ ignore_stdout, extra_run_opts('100') ],
compile_and_run, [''])
test('T17044', normal, compile_and_run, [''])
+# N.B. Sanity check times out due to large list.
+test('T16992', [when(wordsize(32), skip), # Resource limit exceeded on 32-bit
+ high_memory_usage,
+ run_timeout_multiplier(5),
+ omit_ways(['sanity'])], compile_and_run, [''])
=====================================
libraries/ghc-prim/ghc-prim.cabal
=====================================
@@ -66,6 +66,11 @@ Library
-- on Windows. Required because of mingw32.
extra-libraries: user32, mingw32, mingwex
+ if os(linux)
+ -- we need libm, but for musl and other's we might need libc, as libm
+ -- is just an empty shell.
+ extra-libraries: c, m
+
c-sources:
cbits/atomic.c
cbits/bswap.c
=====================================
mk/config.mk.in
=====================================
@@ -199,6 +199,9 @@ endif
# `GhcUnregisterised` mode doesn't allow that.
GhcWithSMP := $(strip $(if $(filter YESNO, $(ArchSupportsSMP)$(GhcUnregisterised)),YES,NO))
+# Whether or not the bootstrapping GHC supplies a threaded RTS.
+GhcThreadedRts = @GhcThreadedRts@
+
# Whether to include GHCi in the compiler. Depends on whether the RTS linker
# has support for this OS/ARCH combination.
=====================================
rts/sm/CNF.c
=====================================
@@ -1016,8 +1016,9 @@ cmp_fixup_table_item (const void *e1, const void *e2)
{
const StgWord *w1 = e1;
const StgWord *w2 = e2;
-
- return *w1 - *w2;
+ if (*w1 > *w2) return +1;
+ else if (*w1 < *w2) return -1;
+ else return 0;
}
static StgWord *
=====================================
testsuite/tests/typecheck/should_compile/T18185.hs
=====================================
@@ -0,0 +1,31 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+module T18185 where
+
+import GHC.TypeLits
+import Type.Reflection
+
+class iss :|+ is ~ oss => AddT (iss :: [Symbol]) (is :: Symbol) (oss :: [Symbol]) where
+ type iss :|+ is :: [Symbol]
+
+class (CmpSymbol is ish ~ ord, AddT'I ord is ish ist ~ oss) => AddT' ord is ish ist oss where
+ type AddT'I ord is ish ist :: [Symbol]
+
+class (CmpSymbol "a" "a" ~ o) => C1 o
+class (CmpNat 1 1 ~ o) => C2 o
+class ((CmpSymbol "a" "a" :: Ordering) ~ o) => C3 o
+class ((CmpNat 1 1 :: Ordering) ~ o) => C4 o
+
+f1 :: TypeRep (CmpSymbol "a" "a")
+f1 = typeRep
+
+f2 :: TypeRep (CmpNat 1 1)
+f2 = typeRep
+
+f3 :: TypeRep (CmpSymbol "a" "a" :: Ordering)
+f3 = typeRep
+
+f4 :: TypeRep (CmpNat 1 1 :: Ordering)
+f4 = typeRep
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -670,3 +670,4 @@ test('T16204a', normal, compile, [''])
test('T16204b', normal, compile, [''])
test('T16225', normal, compile, [''])
test('T16312', normal, compile, ['-O'])
+test('T18185', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30a5613260a580d26a8bd3ff9391f7c85fe01881...0111c371bb5d8017deee89660f8844f4d078ecf2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30a5613260a580d26a8bd3ff9391f7c85fe01881...0111c371bb5d8017deee89660f8844f4d078ecf2
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200708/f08e000d/attachment-0001.html>
More information about the ghc-commits
mailing list