[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: hadrian: Decrease verbosity of cabal commands
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Oct 13 13:42:16 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
9e6ef7ba by Matthew Pickering at 2023-10-12T20:35:00-04:00
hadrian: Decrease verbosity of cabal commands
In Normal, most tools do not produce output to stdout unless there are
error conditions.
Reverts 7ed65f5a1bc8e040e318ccff395f53a9bbfd8217
- - - - -
08fc27af by John Ericson at 2023-10-12T20:35:36-04:00
Do not substitute `@...@` for stage-specific values in cabal files
`rts` and `ghc-prim` now no longer have a `*.cabal.in` to set Cabal flag
defaults; instead manual choices are passed to configure in the usual
way.
The old way was fundamentally broken, because it meant we were baking
these Cabal files for a specific stage. Now we only do stage-agnostic
@...@ substitution in cabal files (the GHC version), and so all
stage-specific configuration is properly confined to `_build` and the
right stage dir.
Also `include-ghc-prim` is a flag that no longer exists for `ghc-prim`
(it was removed in 835d8ddbbfb11796ea8a03d1806b7cee38ba17a6) so I got
rid of it.
Co-Authored-By: Matthew Pickering <matthewtpickering at gmail.com>
- - - - -
eed25eee by Sylvain Henry at 2023-10-13T09:41:25-04:00
Avoid out-of-bound array access in bigNatIsPowerOf2 (fix #24066)
bigNatIndex# in the `where` clause wasn't guarded by "bigNatIsZero a".
- - - - -
a5fc1478 by Sylvain Henry at 2023-10-13T09:41:25-04:00
Rts: expose rtsOutOfBoundsAccess symbol
- - - - -
b291930e by Sylvain Henry at 2023-10-13T09:41:25-04:00
Hadrian: enable `-fcheck-prim-bounds` in validate flavour
This allows T24066 to fail when the bug is present.
Otherwise the out-of-bound access isn't detected as it happens in
ghc-bignum which wasn't compiled with the bounds check.
- - - - -
b60fa193 by Ilias Tsitsimpis at 2023-10-13T09:41:27-04:00
hadrian: Pass -DNOSMP to C compiler when needed
Hadrian passes the -DNOSMP flag to GHC when the target doesn't support
SMP, but doesn't pass it to CC as well, leading to the following
compilation error on mips64el:
| Run Cc (FindCDependencies CDep) Stage1: rts/sm/NonMovingScav.c => _build/stage1/rts/build/c/sm/NonMovingScav.o.d
Command line: /usr/bin/mips64el-linux-gnuabi64-gcc -E -MM -MG -MF _build/stage1/rts/build/c/hooks/FlagDefaults.thr_debug_p_o.d -MT _build/stage1/rts/build/c/hooks/FlagDefaults.o -Irts/include -I_build/stage1/rts/build -I_build/stage1/rts/build/include -Irts/include -x c rts/hooks/FlagDefaults.c -Wall -Wextra -Wstrict-prototypes -Wmissing-prototypes -Wmissing-declarations -Winline -Wpointer-arith -Wmissing-noreturn -Wnested-externs -Wredundant-decls -Wundef -fno-strict-aliasing -DTHREADED_RTS -DDEBUG -fomit-frame-pointer -O2 -g -Irts -I_build/stage1/rts/build -DDEBUG -fno-omit-frame-pointer -g3 -O0
===> Command failed with error code: 1
In file included from rts/include/Stg.h:348,
from rts/include/Rts.h:38,
from rts/hooks/FlagDefaults.c:8:
rts/include/stg/SMP.h:416:2: error: #error memory barriers unimplemented on this architecture
416 | #error memory barriers unimplemented on this architecture
| ^~~~~
rts/include/stg/SMP.h:440:2: error: #error memory barriers unimplemented on this architecture
440 | #error memory barriers unimplemented on this architecture
| ^~~~~
rts/include/stg/SMP.h:464:2: error: #error memory barriers unimplemented on this architecture
464 | #error memory barriers unimplemented on this architecture
| ^~~~~
The old make system correctly passed this flag to both GHC and CC [1].
Fix this error by passing -DNOSMP to CC as well.
[1] https://gitlab.haskell.org/ghc/ghc/-/blob/00920f176b0235d5bb52a8e054d89a664f8938fe/rts/ghc.mk#L407
Closes #24082
- - - - -
16 changed files:
- .gitignore
- hadrian/doc/flavours.md
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings/Flavours/Validate.hs
- hadrian/src/Settings/Packages.hs
- libraries/ghc-bignum/src/GHC/Num/BigNat.hs
- libraries/ghc-prim/ghc-prim.cabal.in → libraries/ghc-prim/ghc-prim.cabal
- rts/.gitignore
- rts/RtsMessages.c
- rts/RtsSymbols.c
- rts/include/rts/Messages.h
- rts/rts.cabal.in → rts/rts.cabal
- + testsuite/tests/numeric/should_run/T24066.hs
- + testsuite/tests/numeric/should_run/T24066.stdout
- testsuite/tests/numeric/should_run/all.T
Changes:
=====================================
.gitignore
=====================================
@@ -167,7 +167,6 @@ _darcs/
/libraries/ghc-boot-th/ghc-boot-th.cabal
/libraries/ghc-boot-th/ghc.mk
/libraries/ghc-heap/ghc-heap.cabal
-/libraries/ghc-prim/ghc-prim.cabal
/libraries/ghci/GNUmakefile
/libraries/ghci/ghci.cabal
/libraries/ghci/ghc.mk
=====================================
hadrian/doc/flavours.md
=====================================
@@ -157,7 +157,7 @@ when compiling the `compiler` library, and `hsGhc` when compiling/linking the GH
<th>validate</td>
<td></td>
<td>-O0<br>-H64m</td>
- <td>-fllvm-fill-undef-with-garbage</td>
+ <td>-fllvm-fill-undef-with-garbage<br>-fcheck-prim-bounds</td>
<td></td>
<td>-O<br>-dcore-lint<br>-dno-debug-output</td>
<td>-O2<br>-DDEBUG</td>
=====================================
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
=====================================
@@ -198,9 +198,10 @@ copyPackage context at Context {..} = do
shakeVerbosityToCabalFlag :: Verbosity -> String
shakeVerbosityToCabalFlag = \case
Diagnostic -> "-v3"
- Verbose -> "-v3"
+ Verbose -> "-v2"
+ -- Normal levels should not produce output to stdout
Silent -> "-v0"
- _ -> "-v2"
+ _ -> "-v1"
-- | What type of file is Main
data MainSourceType = HsMain | CppMain | CMain
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -268,17 +268,6 @@ runInterpolations (Interpolations mk_substs) input = do
subst = foldr (.) id [replace ("@"++k++"@") v | (k,v) <- substs]
return (subst input)
-toCabalBool :: Bool -> String
-toCabalBool True = "True"
-toCabalBool False = "False"
-
--- | Interpolate the given variable with the value of the given 'Flag', using
--- Cabal's boolean syntax.
-interpolateCabalFlag :: String -> Flag -> Interpolations
-interpolateCabalFlag name flg = interpolateVar name $ do
- val <- flag flg
- return (toCabalBool val)
-
-- | Interpolate the given variable with the value of the given 'Setting'.
interpolateSetting :: String -> Setting -> Interpolations
interpolateSetting name settng = interpolateVar name $ setting settng
@@ -290,31 +279,6 @@ projectVersion = mconcat
, interpolateSetting "ProjectVersionMunged" ProjectVersionMunged
]
-rtsCabalFlags :: Interpolations
-rtsCabalFlags = mconcat
- [ flag "CabalHaveLibdw" UseLibdw
- , flag "CabalHaveLibm" UseLibm
- , flag "CabalHaveLibrt" UseLibrt
- , flag "CabalHaveLibdl" UseLibdl
- , flag "CabalNeedLibpthread" UseLibpthread
- , flag "CabalHaveLibbfd" UseLibbfd
- , flag "CabalHaveLibNuma" UseLibnuma
- , flag "CabalHaveLibZstd" UseLibzstd
- , flag "CabalStaticLibZstd" StaticLibzstd
- , flag "CabalNeedLibatomic" NeedLibatomic
- , flag "CabalUseSystemLibFFI" UseSystemFfi
- , targetFlag "CabalLibffiAdjustors" tgtUseLibffiForAdjustors
- , targetFlag "CabalLeadingUnderscore" tgtSymbolsHaveLeadingUnderscore
- ]
- where
- flag = interpolateCabalFlag
- targetFlag name q = interpolateVar name $ do
- val <- queryTargetTarget q
- return (toCabalBool val)
-
-ghcPrimCabalFlags :: Interpolations
-ghcPrimCabalFlags = interpolateCabalFlag "CabalNeedLibatomic" NeedLibatomic
-
packageVersions :: Interpolations
packageVersions = foldMap f [ base, ghcPrim, compiler, ghc, cabal, templateHaskell, ghcCompact, array ]
where
@@ -347,8 +311,6 @@ templateRule outPath interps = do
templateRules :: Rules ()
templateRules = do
templateRule "compiler/ghc.cabal" $ projectVersion
- templateRule "rts/rts.cabal" $ rtsCabalFlags
- templateRule "libraries/ghc-prim/ghc-prim.cabal" $ ghcPrimCabalFlags
templateRule "driver/ghci/ghci-wrapper.cabal" $ projectVersion
templateRule "ghc/ghc-bin.cabal" $ projectVersion
templateRule "utils/iserv/iserv.cabal" $ projectVersion
=====================================
hadrian/src/Settings/Flavours/Validate.hs
=====================================
@@ -35,6 +35,7 @@ validateArgs = sourceArgs SourceArgs
-- See #11487
, notStage0 ? arg "-fllvm-fill-undef-with-garbage"
, notStage0 ? arg "-dno-debug-output"
+ , notStage0 ? arg "-fcheck-prim-bounds"
]
, hsLibrary = pure ["-O"]
, hsCompiler = mconcat [ stage0 ? pure ["-O2"]
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -114,7 +114,7 @@ packageArgs = do
-------------------------------- ghcPrim -------------------------------
, package ghcPrim ? mconcat
- [ builder (Cabal Flags) ? arg "include-ghc-prim"
+ [ builder (Cabal Flags) ? flag NeedLibatomic `cabalFlag` "need-atomic"
, builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ?
input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ]
@@ -302,13 +302,11 @@ rtsPackageArgs = package rts ? do
let ghcArgs = mconcat
[ arg "-Irts"
, arg $ "-I" ++ path
- , notM targetSupportsSMP ? arg "-DNOSMP"
, way `elem` [debug, debugDynamic] ? pure [ "-DTICKY_TICKY"
, "-optc-DTICKY_TICKY"]
, Profiling `wayUnit` way ? arg "-DPROFILING"
, Threaded `wayUnit` way ? arg "-DTHREADED_RTS"
- , notM targetSupportsSMP ? pure [ "-DNOSMP"
- , "-optc-DNOSMP" ]
+ , notM targetSupportsSMP ? arg "-optc-DNOSMP"
]
let cArgs = mconcat
@@ -326,6 +324,8 @@ rtsPackageArgs = package rts ? do
, arg "-Irts"
, arg $ "-I" ++ path
+ , notM targetSupportsSMP ? arg "-DNOSMP"
+
, Debug `wayUnit` way ? pure [ "-DDEBUG"
, "-fno-omit-frame-pointer"
, "-g3"
@@ -401,8 +401,19 @@ rtsPackageArgs = package rts ? do
, any (wayUnit Debug) rtsWays `cabalFlag` "debug"
, any (wayUnit Dynamic) rtsWays `cabalFlag` "dynamic"
, any (wayUnit Threaded) rtsWays `cabalFlag` "threaded"
+ , flag UseLibm `cabalFlag` "libm"
+ , flag UseLibrt `cabalFlag` "librt"
+ , flag UseLibdl `cabalFlag` "libdl"
, useSystemFfi `cabalFlag` "use-system-libffi"
, useLibffiForAdjustors `cabalFlag` "libffi-adjustors"
+ , flag UseLibpthread `cabalFlag` "need-pthread"
+ , flag UseLibbfd `cabalFlag` "libbfd"
+ , flag NeedLibatomic `cabalFlag` "need-atomic"
+ , flag UseLibdw `cabalFlag` "libdw"
+ , flag UseLibnuma `cabalFlag` "libnuma"
+ , flag UseLibzstd `cabalFlag` "libzstd"
+ , flag StaticLibzstd `cabalFlag` "static-libzstd"
+ , queryTargetTarget tgtSymbolsHaveLeadingUnderscore `cabalFlag` "leading-underscore"
, Debug `wayUnit` way `cabalFlag` "find-ptr"
]
, builder (Cabal Setup) ? mconcat
=====================================
libraries/ghc-bignum/src/GHC/Num/BigNat.hs
=====================================
@@ -135,13 +135,8 @@ bigNatIsTwo# ba =
bigNatIsPowerOf2# :: BigNat# -> (# (# #) | Word# #)
bigNatIsPowerOf2# a
| bigNatIsZero a = (# (# #) | #)
- | True = case wordIsPowerOf2# msw of
- (# (# #) | #) -> (# (# #) | #)
- (# | c #) -> case checkAllZeroes (imax -# 1#) of
- 0# -> (# (# #) | #)
- _ -> (# | c `plusWord#`
- (int2Word# imax `uncheckedShiftL#` WORD_SIZE_BITS_SHIFT#) #)
- where
+ | True =
+ let
msw = bigNatIndex# a imax
sz = bigNatSize# a
imax = sz -# 1#
@@ -150,6 +145,12 @@ bigNatIsPowerOf2# a
| True = case bigNatIndex# a i of
0## -> checkAllZeroes (i -# 1#)
_ -> 0#
+ in case wordIsPowerOf2# msw of
+ (# (# #) | #) -> (# (# #) | #)
+ (# | c #) -> case checkAllZeroes (imax -# 1#) of
+ 0# -> (# (# #) | #)
+ _ -> (# | c `plusWord#`
+ (int2Word# imax `uncheckedShiftL#` WORD_SIZE_BITS_SHIFT#) #)
-- | Return the Word# at the given index
bigNatIndex# :: BigNat# -> Int# -> Word#
=====================================
libraries/ghc-prim/ghc-prim.cabal.in → libraries/ghc-prim/ghc-prim.cabal
=====================================
@@ -28,7 +28,7 @@ custom-setup
setup-depends: base >= 4 && < 5, process, filepath, directory, Cabal >= 1.23 && < 3.9
flag need-atomic
- default: @CabalNeedLibatomic@
+ default: False
Library
default-language: Haskell2010
=====================================
rts/.gitignore
=====================================
@@ -2,8 +2,6 @@
/dist/
/dist-*/
-/rts.cabal
-
/include/ghcversion.h
/package.conf.inplace
=====================================
rts/RtsMessages.c
=====================================
@@ -326,27 +326,18 @@ rtsDebugMsgFn(const char *s, va_list ap)
}
-// Used in stg_badAlignment_entry defined in StgStartup.cmm.
-void rtsBadAlignmentBarf(void) STG_NORETURN;
-
void
rtsBadAlignmentBarf(void)
{
barf("Encountered incorrectly aligned pointer. This can't be good.");
}
-// Used by code generator
-void rtsOutOfBoundsAccess(void) STG_NORETURN;
-
void
rtsOutOfBoundsAccess(void)
{
barf("Encountered out of bounds array access.");
}
-// Used by code generator
-void rtsMemcpyRangeOverlap(void) STG_NORETURN;
-
void
rtsMemcpyRangeOverlap(void)
{
=====================================
rts/RtsSymbols.c
=====================================
@@ -947,6 +947,9 @@ extern char **environ;
SymI_HasProto(arenaFree) \
SymI_HasProto(rts_clearMemory) \
SymI_HasProto(setKeepCAFs) \
+ SymI_HasProto(rtsBadAlignmentBarf) \
+ SymI_HasProto(rtsOutOfBoundsAccess) \
+ SymI_HasProto(rtsMemcpyRangeOverlap) \
RTS_USER_SIGNALS_SYMBOLS \
RTS_INTCHAR_SYMBOLS
=====================================
rts/include/rts/Messages.h
=====================================
@@ -78,7 +78,6 @@ void debugBelch(const char *s, ...)
int vdebugBelch(const char *s, va_list ap);
-
/* Hooks for redirecting message generation: */
typedef void RtsMsgFunction(const char *, va_list);
@@ -94,3 +93,8 @@ extern RtsMsgFunction rtsFatalInternalErrorFn;
extern RtsMsgFunctionRetLen rtsDebugMsgFn;
extern RtsMsgFunction rtsErrorMsgFn;
extern RtsMsgFunction rtsSysErrorMsgFn;
+
+/* Used by code generator */
+void rtsBadAlignmentBarf(void) STG_NORETURN;
+void rtsOutOfBoundsAccess(void) STG_NORETURN;
+void rtsMemcpyRangeOverlap(void) STG_NORETURN;
=====================================
rts/rts.cabal.in → rts/rts.cabal
=====================================
@@ -29,31 +29,31 @@ source-repository head
subdir: rts
flag libm
- default: @CabalHaveLibm@
+ default: False
flag librt
- default: @CabalHaveLibrt@
+ default: False
flag libdl
- default: @CabalHaveLibdl@
+ default: False
flag use-system-libffi
- default: @CabalUseSystemLibFFI@
+ default: False
flag libffi-adjustors
- default: @CabalLibffiAdjustors@
+ default: False
flag need-pthread
- default: @CabalNeedLibpthread@
+ default: False
flag libbfd
- default: @CabalHaveLibbfd@
+ default: False
flag need-atomic
- default: @CabalNeedLibatomic@
+ default: False
flag libdw
- default: @CabalHaveLibdw@
+ default: False
flag libnuma
- default: @CabalHaveLibNuma@
+ default: False
flag libzstd
- default: @CabalHaveLibZstd@
+ default: False
flag static-libzstd
- default: @CabalStaticLibZstd@
+ default: False
flag leading-underscore
- default: @CabalLeadingUnderscore@
+ default: False
flag smp
default: True
flag find-ptr
=====================================
testsuite/tests/numeric/should_run/T24066.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main where
+
+import GHC.Num.BigNat
+import GHC.Exts
+
+-- just to ensure that (future) rewrite rules don't mess with the test
+{-# NOINLINE foo #-}
+foo (# #) = bigNatZero# (# #)
+
+main = do
+ case bigNatIsPowerOf2# (foo (# #)) of
+ (# _ | #) -> putStrLn "Zero isn't a power of two"
+ (# | w #) -> putStrLn $ "Zero is 2^" ++ show (W# w)
=====================================
testsuite/tests/numeric/should_run/T24066.stdout
=====================================
@@ -0,0 +1 @@
+Zero isn't a power of two
=====================================
testsuite/tests/numeric/should_run/all.T
=====================================
@@ -81,3 +81,4 @@ test('T20291', normal, compile_and_run, [''])
test('T22282', normal, compile_and_run, [''])
test('T22671', normal, compile_and_run, [''])
test('foundation', [when(js_arch(), run_timeout_multiplier(2))], compile_and_run, ['-O -package transformers'])
+test('T24066', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6cda769ec00498de73f7642c8fa9505eecc4b019...b60fa19354638c0321002a47a29b0c15598242e2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6cda769ec00498de73f7642c8fa9505eecc4b019...b60fa19354638c0321002a47a29b0c15598242e2
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/20231013/7ccf4ff8/attachment-0001.html>
More information about the ghc-commits
mailing list