[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Cmm constant folding: Narrow results to operations bitwidth.
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Nov 27 12:20:55 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
0ffb8c18 by Andreas Klebinger at 2024-11-27T07:20:39-05:00
Cmm constant folding: Narrow results to operations bitwidth.
When constant folding ensure the result is still within bounds
for the given type by explicitly narrowing the results.
Not doing so results in a lot of spurious assembler warnings
especially when testing primops.
- - - - -
091f0167 by Ben Gamari at 2024-11-27T07:20:40-05:00
ghc-toolchain: Introduce basic flag validation
We verify that required flags (currently `--output` and `--triple`) are
provided. The implementation is truly awful, but so is getopt.
Begins to address #25500.
- - - - -
3a7021cb by Ben Gamari at 2024-11-27T07:20:41-05:00
rts: Allow ExecPage to allocate anywhere in address space
Currently the ExecPage facility has two users:
* GHCi, for constructing info tables, and
* the adjustor allocation path
Despite neither of these have any spatial locality constraints ExecPage
was using the linker's `mmapAnonForLinker`, which tries hard to ensure
that mappings end up nearby the executable image. This makes adjustor
allocation needlessly subject to fragmentation concerns.
We now instead return less constrained mappings, improving the
robustness of the mechanism.
Addresses #25503.
- - - - -
76bc29cf by Ben Gamari at 2024-11-27T07:20:42-05:00
base: Fix incorrect mentions of GHC.Internal.Numeric
These were incorrectly changed by the automated refactoring of the
`ghc-internal` migration.
Fixes #25521.
- - - - -
15 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Cmm/Opt.hs
- libraries/base/src/Data/Char.hs
- libraries/base/src/Data/Semigroup.hs
- libraries/base/src/Prelude.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs
- rts/ExecPage.c
- rts/linker/MMap.c
- rts/linker/MMap.h
- + testsuite/tests/cmm/opt/T24556.cmm
- testsuite/tests/cmm/opt/all.T
- utils/ghc-toolchain/exe/Main.hs
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -279,7 +279,7 @@ basicKnownKeyNames
-- Dynamic
toDynName,
- -- GHC.Internal.Numeric stuff
+ -- Numeric stuff
negateName, minusName, geName, eqName,
mkRationalBase2Name, mkRationalBase10Name,
=====================================
compiler/GHC/Cmm/Opt.hs
=====================================
@@ -49,6 +49,7 @@ constantFoldExprOpt e = wrapRecExpOpt f e
CmmMachOp op' args' -> fromMaybe (CmmMachOp op' args') <$> cmmMachOpFoldOptM cfg op' args'
e -> pure e
f (CmmRegOff r 0) = pure (CmmReg r)
+ f (CmmLit (CmmInt x rep)) = pure (CmmLit $ CmmInt (narrowU rep x) rep)
f e = pure e
constantFoldExpr :: Platform -> CmmExpr -> CmmExpr
@@ -88,7 +89,7 @@ cmmMachOpFoldM _ (MO_VF_Broadcast lg _w) exprs =
_ -> Nothing
cmmMachOpFoldM _ op [CmmLit (CmmInt x rep)]
= Just $! case op of
- MO_S_Neg _ -> CmmLit (CmmInt (-x) rep)
+ MO_S_Neg _ -> CmmLit (CmmInt (narrowS rep (-x)) rep)
MO_Not _ -> CmmLit (CmmInt (complement x) rep)
-- these are interesting: we must first narrow to the
@@ -164,9 +165,9 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform))
MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform))
- MO_Add r -> Just $! CmmLit (CmmInt (x + y) r)
- MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r)
- MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r)
+ MO_Add r -> Just $! CmmLit (CmmInt (narrowU r $ x + y) r)
+ MO_Sub r -> Just $! CmmLit (CmmInt (narrowS r $ x - y) r)
+ MO_Mul r -> Just $! CmmLit (CmmInt (narrowU r $ x * y) r)
MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r)
MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r)
MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_s `quot` y_s) r)
@@ -176,7 +177,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r)
MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r)
- MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r)
+ MO_Shl r -> Just $! CmmLit (CmmInt (narrowU r $ x `shiftL` fromIntegral y) r)
MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
MO_S_Shr r -> Just $! CmmLit (CmmInt (x_s `shiftR` fromIntegral y) r)
=====================================
libraries/base/src/Data/Char.hs
=====================================
@@ -42,7 +42,7 @@ module Data.Char
, digitToInt
, intToDigit
- -- * GHC.Internal.Numeric representations
+ -- * Numeric representations
, ord
, chr
=====================================
libraries/base/src/Data/Semigroup.hs
=====================================
@@ -89,7 +89,7 @@ module Data.Semigroup (
, First(..)
, Last(..)
, WrappedMonoid(..)
- -- * Re-exported monoids from GHC.Internal.Data.Monoid
+ -- * Re-exported monoids
, Dual(..)
, Endo(..)
, All(..)
=====================================
libraries/base/src/Prelude.hs
=====================================
@@ -47,11 +47,11 @@ module Prelude (
-- ** Numbers
- -- *** GHC.Internal.Numeric types
+ -- *** Numeric types
Int, Integer, Float, Double,
Rational, Word,
- -- *** GHC.Internal.Numeric type classes
+ -- *** Numeric type classes
Num((+), (-), (*), negate, abs, signum, fromInteger),
Real(toRational),
Integral(quot, rem, div, mod, quotRem, divMod, toInteger),
@@ -63,7 +63,7 @@ module Prelude (
encodeFloat, exponent, significand, scaleFloat, isNaN,
isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),
- -- *** GHC.Internal.Numeric functions
+ -- *** Numeric functions
subtract, even, odd, gcd, lcm, (^), (^^),
fromIntegral, realToFrac,
=====================================
libraries/ghc-internal/src/GHC/Internal/Base.hs
=====================================
@@ -2355,7 +2355,7 @@ getTag :: forall {lev :: Levity} (a :: TYPE (BoxedRep lev))
getTag = dataToTag#
----------------------------------------------
--- GHC.Internal.Numeric primops
+-- Numeric primops
----------------------------------------------
-- Definitions of the boxed PrimOps; these will be
=====================================
libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs
=====================================
@@ -47,7 +47,7 @@ module GHC.Internal.Foreign.C.Types
, CLLong(..), CULLong(..), CBool(..)
, CIntPtr(..), CUIntPtr(..), CIntMax(..), CUIntMax(..)
- -- ** GHC.Internal.Numeric types
+ -- ** Numeric types
-- | These types are represented as @newtype at s of basic
-- foreign types, and are instances of
-- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',
=====================================
libraries/ghc-internal/src/GHC/Internal/Read.hs
=====================================
@@ -551,7 +551,7 @@ instance Read L.Lexeme where
readList = readListDefault
--------------------------------------------------------------
--- GHC.Internal.Numeric instances of Read
+-- Numeric instances of Read
--------------------------------------------------------------
readNumber :: Num a => (L.Lexeme -> ReadPrec a) -> ReadPrec a
=====================================
libraries/ghc-internal/src/GHC/Internal/Real.hs
=====================================
@@ -360,7 +360,7 @@ numericEnumFrom :: (Fractional a) => a -> [a]
{-# INLINE numericEnumFrom #-} -- See Note [Inline Enum method helpers] in GHC.Internal.Enum
numericEnumFrom n = go 0
where
- -- See Note [GHC.Internal.Numeric Stability of Enumerating Floating Numbers]
+ -- See Note [Numeric Stability of Enumerating Floating Numbers]
go !k = let !n' = n + k
in n' : go (k + 1)
@@ -369,7 +369,7 @@ numericEnumFromThen :: (Fractional a) => a -> a -> [a]
numericEnumFromThen n m = go 0
where
step = m - n
- -- See Note [GHC.Internal.Numeric Stability of Enumerating Floating Numbers]
+ -- See Note [Numeric Stability of Enumerating Floating Numbers]
go !k = let !n' = n + k * step
in n' : go (k + 1)
@@ -386,7 +386,7 @@ numericEnumFromThenTo e1 e2 !e3
!predicate | e2 >= e1 = (<= e3 + mid)
| otherwise = (>= e3 + mid)
-{- Note [GHC.Internal.Numeric Stability of Enumerating Floating Numbers]
+{- Note [Numeric Stability of Enumerating Floating Numbers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When enumerate floating numbers, we could add the increment to the last number
at every run (as what we did previously):
=====================================
rts/ExecPage.c
=====================================
@@ -10,7 +10,7 @@
#include "linker/MMap.h"
ExecPage *allocateExecPage(void) {
- ExecPage *page = (ExecPage *) mmapAnonForLinker(getPageSize());
+ ExecPage *page = (ExecPage *) mmapAnon(getPageSize());
return page;
}
=====================================
rts/linker/MMap.c
=====================================
@@ -207,6 +207,12 @@ memoryAccessToProt(MemoryAccess access)
}
}
+void *
+mmapAnon (size_t bytes)
+{
+ return VirtualAlloc(NULL, bytes, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
+}
+
//
// Returns NULL on failure.
//
@@ -410,6 +416,15 @@ mmapForLinker (size_t bytes, MemoryAccess access, uint32_t flags, int fd, int of
return result;
}
+/*
+ * Map read/write pages anywhere in memory. Returns NULL on failure.
+ */
+void *
+mmapAnon (size_t bytes)
+{
+ return mmapAnywhere(bytes, MEM_READ_WRITE_THEN_READ_EXECUTE, MAP_ANONYMOUS, -1, 0);
+}
+
/*
* Map read/write pages in low memory. Returns NULL on failure.
*/
=====================================
rts/linker/MMap.h
=====================================
@@ -64,7 +64,11 @@ typedef enum {
extern void *mmap_32bit_base;
-// Map read/write anonymous memory.
+// Map read/write anonymous memory anywhere in memory.
+void *mmapAnon(size_t bytes);
+
+// Map read/write anonymous memory, enforcing the constraint of
+// placing the mapping within 4GB of the executable image.
void *mmapAnonForLinker (size_t bytes);
// Change protection of previous mapping memory.
=====================================
testsuite/tests/cmm/opt/T24556.cmm
=====================================
@@ -0,0 +1,12 @@
+#include "Cmm.h"
+
+func(W_ buffer) {
+ I8[buffer] = %lobits8(255 + 45);
+ I8[buffer+(1)] = %lobits8(310 - 10);
+ I8[buffer+(2)] = %lobits8(30 * 10);
+ I8[buffer+(3)] = %lobits8(150 << 1);
+ // This one comes from test-primops
+ I64[buffer+(4)] = %zx64(((1 :: bits16) & ((1 :: bits16) & (((516 :: bits16) * (154 :: bits16)) + bits16[buffer + (0 :: W_)]))));
+ return(1);
+}
+
=====================================
testsuite/tests/cmm/opt/all.T
=====================================
@@ -3,3 +3,8 @@
test('T15188', cmm_src, makefile_test, [])
test('T18141', normal, compile, [''])
test('T20142', normal, compile, [''])
+
+# Cmm opt should not produce oversized literals in the assembly output.
+# We check this by telling the assembler to exit on warnings.
+test('T24556', [only_ways('optasm'), cmm_src], compile, ['-O -opta -Xassembler -opta --fatal-warnings'])
+
=====================================
utils/ghc-toolchain/exe/Main.hs
=====================================
@@ -35,11 +35,11 @@ import GHC.Toolchain.NormaliseTriple (normaliseTriple)
import Text.Read (readMaybe)
data Opts = Opts
- { optTriple :: String
+ { optTriple :: Maybe String
, optTargetPrefix :: Maybe String
, optLocallyExecutable :: Maybe Bool
, optLlvmTriple :: Maybe String
- , optOutput :: String
+ , optOutput :: Maybe String
, optCc :: ProgOpt
, optCxx :: ProgOpt
, optCpp :: ProgOpt
@@ -82,11 +82,11 @@ emptyFormatOpts = FormatOpts { formatOptInput = error "formatOpts: input"
emptyOpts :: Opts
emptyOpts = Opts
- { optTriple = ""
+ { optTriple = Nothing
, optTargetPrefix = Nothing
, optLocallyExecutable = Nothing
, optLlvmTriple = Nothing
- , optOutput = ""
+ , optOutput = Nothing
, optCc = po0
, optCxx = po0
, optCpp = po0
@@ -129,13 +129,13 @@ _optMergeObjs = Lens optMergeObjs (\x o -> o {optMergeObjs=x})
_optWindres = Lens optWindres (\x o -> o {optWindres=x})
_optLd = Lens optLd (\x o -> o {optLd= x})
-_optTriple :: Lens Opts String
+_optTriple :: Lens Opts (Maybe String)
_optTriple = Lens optTriple (\x o -> o {optTriple=x})
_optLlvmTriple :: Lens Opts (Maybe String)
_optLlvmTriple = Lens optLlvmTriple (\x o -> o {optLlvmTriple=x})
-_optOutput :: Lens Opts String
+_optOutput :: Lens Opts (Maybe String)
_optOutput = Lens optOutput (\x o -> o {optOutput=x})
_optTargetPrefix :: Lens Opts (Maybe String)
@@ -213,7 +213,7 @@ options =
, Option [] ["disable-" ++ optName] (NoArg (set lens (Just False))) ("Disable " ++ description)
]
- tripleOpt = Option ['t'] ["triple"] (ReqArg (set _optTriple) "TRIPLE") "Target triple"
+ tripleOpt = Option ['t'] ["triple"] (ReqArg (set _optTriple . Just) "TRIPLE") "Target triple"
llvmTripleOpt = Option [] ["llvm-triple"] (ReqArg (set _optLlvmTriple . Just) "LLVM-TRIPLE") "LLVM Target triple"
targetPrefixOpt = Option ['T'] ["target-prefix"] (ReqArg (set _optTargetPrefix . Just) "PREFIX")
@@ -233,7 +233,7 @@ options =
keepTempOpt = Option [] ["keep-temp"] (NoArg (set _optKeepTemp True))
"do not remove temporary files"
- outputOpt = Option ['o'] ["output"] (ReqArg (set _optOutput) "OUTPUT")
+ outputOpt = Option ['o'] ["output"] (ReqArg (set _optOutput . Just) "OUTPUT")
"The output path for the generated target toolchain configuration"
formatOpts :: [OptDescr (FormatOpts -> FormatOpts)]
@@ -244,6 +244,16 @@ formatOpts = [
"The target file to format")
]
+validateOpts :: Opts -> [String]
+validateOpts opts = mconcat
+ [ assertJust _optTriple "missing --triple flag"
+ , assertJust _optOutput "missing --output flag"
+ ]
+ where
+ assertJust :: Lens Opts (Maybe a) -> String -> [String]
+ assertJust lens msg =
+ [ msg | Nothing <- pure $ view lens opts ]
+
main :: IO ()
main = do
argv <- getArgs
@@ -273,14 +283,14 @@ doFormat args = do
doConfigure :: [String] -> IO ()
doConfigure args = do
- let (opts0, _nonopts, errs) = getOpt RequireOrder options args
+ let (opts0, _nonopts, parseErrs) = getOpt RequireOrder options args
let opts = foldr (.) id opts0 emptyOpts
- case errs of
+ case parseErrs ++ validateOpts opts of
[] -> do
let env = Env { verbosity = optVerbosity opts
, targetPrefix = case optTargetPrefix opts of
Just prefix -> Just prefix
- Nothing -> Just $ optTriple opts ++ "-"
+ Nothing -> Just $ fromMaybe (error "undefined triple") (optTriple opts) ++ "-"
, keepTemp = optKeepTemp opts
, canLocallyExecute = fromMaybe True (optLocallyExecutable opts)
, logContexts = []
@@ -289,7 +299,7 @@ doConfigure args = do
case r of
Left err -> print err >> exitWith (ExitFailure 2)
Right () -> return ()
- _ -> do
+ errs -> do
mapM_ putStrLn errs
putStrLn $ usageInfo "ghc-toolchain" options
exitWith (ExitFailure 1)
@@ -298,7 +308,7 @@ run :: Opts -> M ()
run opts = do
tgt <- mkTarget opts
logDebug $ "Final Target: " ++ show tgt
- let file = optOutput opts
+ let file = fromMaybe (error "undefined --output") (optOutput opts)
writeFile file (show tgt)
optional :: M a -> M (Maybe a)
@@ -390,7 +400,7 @@ ldOverrideWhitelist a =
mkTarget :: Opts -> M Target
mkTarget opts = do
- normalised_triple <- normaliseTriple (optTriple opts)
+ normalised_triple <- normaliseTriple (fromMaybe (error "missing --triple") (optTriple opts))
-- Use Llvm target if specified, otherwise use triple as llvm target
let tgtLlvmTarget = fromMaybe normalised_triple (optLlvmTriple opts)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/685b39e72fcffb3a82eaf600443b22567ac09ef9...76bc29cfd7e9afa19eb8b48453d08872e5bf5f3f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/685b39e72fcffb3a82eaf600443b22567ac09ef9...76bc29cfd7e9afa19eb8b48453d08872e5bf5f3f
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/20241127/ca5b120e/attachment-0001.html>
More information about the ghc-commits
mailing list