Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

12 changed files:

Changes:

  • changelog.d/T27046
    1 
    +section: compiler
    2 
    +issues: #27046
    3 
    +mrs: !16031
    4 
    +synopsis:
    5 
    +  Avoid AArch64 register clobbering bug in MUL2
    6 
    +description:
    7 
    +  Fixes an issue in which, on AArch64, code generation for the MUL2 operation
    8 
    +  could clobber one of the input operands when computing the lower bits, which
    9 
    +  rendered invalid the subsequent computation of the high bits.

  • changelog.d/T27182.md
    1 
    +section: compiler
    2 
    +issues: #27182
    3 
    +mrs: !16003
    4 
    +synopsis:
    5 
    +  Fix `getStgArgFromTrivialArg` panic in CoreToStg
    6 
    +description:
    7 
    +  Avoid a `getStgArgFromTrivialArg` panic in CoreToStg due to a call to `mkTick`
    8 
    +  in Core Prep which invalidated ANF.

  • compiler/GHC/Builtin/primops.txt.pp
    ... ... @@ -2149,7 +2149,7 @@ primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
    2149 2149
    2150 2150 
     primop  GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp
    2151 2151 
        MutableByteArray# s -> State# s -> (# State# s, Int# #)
    2152 
    -   {Return the number of elements in the array, correctly accounting for
    2152 
    +   {Return the number of bytes in the array, correctly accounting for
    2153 2153 
        the effect of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'.
    2154 2154
    2155 2155 
        @since 0.5.0.0}

  • compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
    ... ... @@ -2300,11 +2300,19 @@ genCCall target dest_regs arg_regs = do
    2300 2300 
                   let lo = getRegisterReg platform (CmmLocal dst_lo)
    2301 2301 
                       hi = getRegisterReg platform (CmmLocal dst_hi)
    2302 2302 
                       nd = getRegisterReg platform (CmmLocal dst_needed)
    2303 
    +
    2304 
    +              -- Generate a fresh virtual register for the low word computation.
    2305 
    +              -- This avoids clobbering reg_a or reg_b in the first MUL instruction,
    2306 
    +              -- which could for example happen if 'lo' and 'reg_a' are the same
    2307 
    +              -- virtual register.
    2308 
    +              tmp_lo <- getNewRegNat II64
    2309 
    +
    2303 2310 
                   return $
    2304 2311 
                       code_x `appOL`
    2305 2312 
                       code_y `snocOL`
    2306 
    -                  MUL   II64 (OpReg W64 lo) (OpReg W64 reg_a) (OpReg W64 reg_b) `snocOL`
    2313 
    +                  MUL   II64 (OpReg W64 tmp_lo) (OpReg W64 reg_a) (OpReg W64 reg_b) `snocOL`
    2307 2314 
                       SMULH (OpReg W64 hi) (OpReg W64 reg_a) (OpReg W64 reg_b) `snocOL`
    2315 
    +                  MOV   (OpReg W64 lo) (OpReg W64 tmp_lo) `snocOL`
    2308 2316 
                       -- Are all high bits equal to the sign bit of the low word?
    2309 2317 
                       -- nd = (hi == ASR(lo,width-1)) ? 1 : 0
    2310 2318 
                       CMP   (OpReg W64 hi) (OpRegShift W64 lo SASR (widthInBits w - 1)) `snocOL`

  • compiler/GHC/Core/Utils.hs
    ... ... @@ -11,6 +11,7 @@ module GHC.Core.Utils (
    11 11 
             -- * Constructing expressions
    12 12 
             mkCast, mkCastMCo, mkPiMCo,
    13 13 
             mkTick, mkTicks, mkTickNoHNF, tickHNFArgs,
    14 
    +        mkTickCpe,
    14 15 
             bindNonRec, needsCaseBinding, needsCaseBindingL,
    15 16 
             mkAltExpr, mkDefaultCase, mkSingleAltCase,
    16 17
    ... ... @@ -319,7 +320,18 @@ mkCast expr co
    319 320 
     --   * Split profiling ticks into counting/scoping parts so that the two parts
    320 321 
     --     can be placed independently into the AST.
    321 322 
     mkTick :: CoreTickish -> CoreExpr -> CoreExpr
    322 
    -mkTick t orig_expr = mkTick' orig_expr
    323 
    +mkTick = mk_tick False
    324 
    +
    325 
    +-- | A version of 'mkTick' that preserves ANF, for use in Core Prep.
    326 
    +--
    327 
    +-- See Note [mkTick breaks ANF] in GHC.CoreToStg.Prep.
    328 
    +mkTickCpe :: CoreTickish -> CoreExpr -> CoreExpr
    329 
    +mkTickCpe = mk_tick True
    330 
    +
    331 
    +-- | Internal function used to define both 'mkTick' and 'mkTickCpe'
    332 
    +-- without duplication.
    333 
    +mk_tick :: Bool -> CoreTickish -> CoreExpr -> CoreExpr
    334 
    +mk_tick preserve_anf t orig_expr = mkTick' orig_expr
    323 335 
      where
    324 336 
       -- Some ticks (cost-centres) can be split in two, with the
    325 337 
       -- non-counting part having laxer placement properties.
    ... ... @@ -343,7 +355,7 @@ mkTick t orig_expr = mkTick' orig_expr
    343 355 
           -- Push SCCs into lambdas.
    344 356 
           -- See (PSCC2) in Note [Pushing SCCs inwards].
    345 357 
           | can_split
    346 
    -      -> Tick (mkNoScope t) $ Lam x $ mkTick (mkNoCount t) e
    358 
    +      -> Tick (mkNoScope t) $ Lam x $ mk_tick preserve_anf (mkNoCount t) e
    347 359
    348 360 
         App f arg
    349 361 
           -- All ticks float inwards through non-runtime arguments, as per
    ... ... @@ -353,7 +365,9 @@ mkTick t orig_expr = mkTick' orig_expr
    353 365
    354 366 
           -- Push SCCs into saturated constructor applications.
    355 367 
           -- See (PSCC3) in Note [Pushing SCCs inwards].
    356 
    -      | isSaturatedConApp expr
    368 
    +      | not preserve_anf -- this optimisation breaks ANF;
    369 
    +                         -- see Note [mkTick breaks ANF] in GHC.CoreToStg.Prep
    370 
    +      , isSaturatedConApp expr
    357 371 
           , tickishPlace t == PlaceCostCentre || can_split
    358 372 
           -> if tickishPlace t == PlaceCostCentre
    359 373 
              then tickHNFArgs t expr

  • compiler/GHC/CoreToStg/Prep.hs
    ... ... @@ -801,7 +801,9 @@ cpeBodyF env (Tick tickish expr)
    801 801 
            ; return (FloatTick tickish `consFloat` floats, body) }
    802 802 
       | otherwise
    803 803 
       = do { body <- cpeBody env expr
    804 
    -       ; return (emptyFloats, mkTick tickish' body) }
    804 
    +       ; return (emptyFloats, mkTickCpe tickish' body) }
    805 
    +    -- Use mkTickCpe and not mkTick, as the latter may break ANF (#27182).
    806 
    +    -- See (TickANF2) in Note [mkTick breaks ANF].
    805 807 
       where
    806 808 
         tickish' | Breakpoint ext bid fvs <- tickish
    807 809 
                  -- See also 'substTickish'
    ... ... @@ -905,6 +907,28 @@ cpeBodyF env (Case scrut bndr ty alts)
    905 907 
                 ; rhs' <- cpeBody env2 rhs
    906 908 
                 ; return (Alt con bs' rhs') }
    907 909
    910 
    +{- Note [mkTick breaks ANF]
    911 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~
    912 
    +mkTick does not preserve the ANF property as required by Core Prep (see
    913 
    +Note [CorePrep invariants]), as seen in #27182. Given:
    914 
    +
    915 
    +  mkTick scc<foo> (\ (eta :: Char -> Bool) -> BindP (p :: Int) eta)
    916 
    +
    917 
    +mkTick will push the SCC into the constructor application, resulting in:
    918 
    +
    919 
    +  \ (eta :: Char -> Bool) -> BindP (p :: Int) (scc<oneM> eta)
    920 
    +
    921 
    +To avoid this problem (at least until 'mkTick' is more thoroughly reworked to
    922 
    +avoid this infelicity, see #27141), we define a variant of 'mkTick', called
    923 
    +'mkTickCpe', which does not push ticks into constructor applications (this is
    924 
    +the only optimisation done by 'mkTick' that can break ANF).
    925 
    +
    926 
    +We prefer using a small variant of 'mkTick' rather than using the 'Tick'
    927 
    +constructor, as the latter can slightly degrade profiling reports by failing to
    928 
    +combine ticks (can result in spurious cost centres with 0 entries appearing in
    929 
    +profiling reports).
    930 
    +-}
    931 
    +
    908 932 
     -- ---------------------------------------------------------------------------
    909 933 
     --              CpeBody: produces a result satisfying CpeBody
    910 934 
     -- ---------------------------------------------------------------------------
    ... ... @@ -1207,7 +1231,7 @@ cpeApp top_env expr
    1207 1231 
         rebuild_app' env (a : as) fun' floats ss rt_ticks req_depth = case a of
    1208 1232 
           -- See Note [Ticks and mandatory eta expansion]
    1209 1233 
           _ | not (null rt_ticks), req_depth <= 0
    1210 
    -        -> let tick_fun = foldr mkTick fun' rt_ticks
    1234 
    +        -> let tick_fun = foldr mkTickCpe fun' rt_ticks
    1211 1235 
                in rebuild_app' env (a : as) tick_fun floats ss rt_ticks req_depth
    1212 1236
    1213 1237 
           AIApp (Type arg_ty)
    ... ... @@ -2307,7 +2331,7 @@ wrapBinds floats body
    2307 2331 
         mk_bind (UnsafeEqualityCase scrut b con bs) body
    2308 2332 
           = mkSingleAltCase scrut b con bs body
    2309 2333 
         mk_bind (FloatTick tickish) body
    2310 
    -      = mkTick tickish body
    2334 
    +      = mkTickCpe tickish body
    2311 2335
    2312 2336 
     -- | Put floats at top-level
    2313 2337 
     deFloatTop :: Floats -> [CoreBind]
    ... ... @@ -2735,7 +2759,7 @@ newVar env ty
    2735 2759 
     wrapTicks :: Floats -> CoreExpr -> (Floats, CoreExpr)
    2736 2760 
     wrapTicks floats expr
    2737 2761 
       | (floats1, ticks1) <- fold_fun go floats
    2738 
    -  = (floats1, foldrOL mkTick expr ticks1)
    2762 
    +  = (floats1, foldrOL mkTickCpe expr ticks1)
    2739 2763 
       where fold_fun f floats =
    2740 2764 
                let (binds, ticks) = foldlOL f (nilOL,nilOL) (fs_binds floats)
    2741 2765 
                in (floats { fs_binds = binds }, ticks)
    ... ... @@ -2755,8 +2779,8 @@ wrapTicks floats expr
    2755 2779
    2756 2780 
             wrap t (Float bind bound info) = Float (wrapBind t bind) bound info
    2757 2781 
             wrap _ f                 = pprPanic "Unexpected FloatingBind" (ppr f)
    2758 
    -        wrapBind t (NonRec binder rhs) = NonRec binder (mkTick t rhs)
    2759 
    -        wrapBind t (Rec pairs)         = Rec (mapSnd (mkTick t) pairs)
    2782 
    +        wrapBind t (NonRec binder rhs) = NonRec binder (mkTickCpe t rhs)
    2783 
    +        wrapBind t (Rec pairs)         = Rec (mapSnd (mkTickCpe t) pairs)
    2760 2784
    2761 2785 
     ------------------------------------------------------------------------------
    2762 2786 
     -- Numeric literals

  • testsuite/driver/runtests.py
    ... ... @@ -133,7 +133,7 @@ if args.unexpected_output_dir:
    133 133 
         config.unexpected_output_dir = Path(args.unexpected_output_dir)
    134 134
    135 135 
     if args.only:
    136 
    -    config.only = args.only
    136 
    +    config.only = set(args.only)
    137 137 
         config.run_only_some_tests = True
    138 138
    139 139 
     if args.skip:

  • testsuite/tests/codeGen/should_run/T27046.hs
    1 
    +{-# LANGUAGE MagicHash #-}
    2 
    +{-# LANGUAGE ForeignFunctionInterface, GHCForeignImportPrim, UnliftedFFITypes #-}
    3 
    +
    4 
    +module Main where
    5 
    +
    6 
    +import Control.Monad
    7 
    +  ( unless )
    8 
    +import Data.Bits
    9 
    +  ( shiftL )
    10 
    +import GHC.Exts
    11 
    +  ( Int64# )
    12 
    +import GHC.Int
    13 
    +  ( Int64(..) )
    14 
    +
    15 
    +foreign import prim "test_mul2_clobber"
    16 
    +  test_mul2_clobber :: Int64# -> Int64# -> Int64#
    17 
    +
    18 
    +main :: IO ()
    19 
    +main = do
    20 
    +  let
    21 
    +    I64# x = 1 `shiftL` 32
    22 
    +    hi = I64# $ test_mul2_clobber x x
    23 
    +
    24 
    +  unless ( hi == 1 ) $
    25 
    +    error $ unlines
    26 
    +      [ "Incorrect result for Mul2 operation."
    27 
    +      , "Expected high word: 1"
    28 
    +      , "  Actual high word: " ++ show hi
    29 
    +      ]

  • testsuite/tests/codeGen/should_run/T27046_cmm.cmm
    1 
    +#include "Cmm.h"
    2 
    +
    3 
    +// Test for #27046
    4 
    +test_mul2_clobber (bits64 x, bits64 y)
    5 
    +{
    6 
    +    bits64 hi, nd;
    7 
    +
    8 
    +    // Deliberately alias the destination 'lo' with the source 'x'
    9 
    +    // This forces the NCG to use the same virtual register for both.
    10 
    +    (nd, hi, x) = prim %mul2_64(x, y);
    11 
    +
    12 
    +    return (hi);
    13 
    +}

  • testsuite/tests/codeGen/should_run/all.T
    ... ... @@ -260,6 +260,7 @@ test('T25364', normal, compile_and_run, [''])
    260 260 
     test('T26061', normal, compile_and_run, [''])
    261 261 
     test('T26537', normal, compile_and_run, ['-O2 -fregs-graph'])
    262 262 
     test('T24016', normal, compile_and_run, ['-O1 -fPIC'])
    263 
    +test('T27046', [req_cmm], compile_and_run, ['T27046_cmm.cmm'])
    263 264
    264 265 
     # Check that GHC-generated finalizers run on Darwin. The Apple linker doesn't
    265 266 
     # support --wrap, so we can't intercept hs_spt_remove directly.  Instead we

  • testsuite/tests/profiling/should_compile/T27182.hs
    1 
    +module T27182 ( oneM ) where
    2 
    +
    3 
    +data Parser = BindP Int ( Char -> Bool )
    4 
    +
    5 
    +oneM :: Int -> ( Char -> Bool ) -> Parser
    6 
    +oneM p = BindP p

  • testsuite/tests/profiling/should_compile/all.T
    ... ... @@ -22,3 +22,4 @@ test('T19894', [test_opts, extra_files(['T19894'])], multimod_compile, ['Main',
    22 22 
     test('T20938', [test_opts], compile, ['-O -prof'])
    23 23 
     test('T26056', [test_opts], compile, ['-O -prof'])
    24 24 
     test('T27121', [test_opts, extra_files(['T27121_aux.hs'])], multimod_compile, ['T27121', '-v0 -O -prof -fprof-auto'])
    25 
    +test('T27182', [test_opts], compile, ['-O -prof -fprof-late'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help