[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Hadrian: fix PowerPC64le support (#17601)
Marge Bot
gitlab at gitlab.haskell.org
Thu Jul 2 15:17:59 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
23e4e047 by Sylvain Henry at 2020-07-02T10:46:31-04:00
Hadrian: fix PowerPC64le support (#17601)
[ci skip]
- - - - -
3cdd8d69 by Sylvain Henry at 2020-07-02T10:47:08-04:00
NCG: correctly handle addresses with huge offsets (#15570)
Before this patch we could generate addresses of this form:
movzbl cP0_str+-9223372036854775808,%eax
The linker can't handle them because the offset is too large:
ld.lld: error: Main.o:(.text+0xB3): relocation R_X86_64_32S out of range: -9223372036852653050 is not in [-2147483648, 2147483647]
With this patch we detect those cases and generate:
movq $-9223372036854775808,%rax
addq $cP0_str,%rax
movzbl (%rax),%eax
I've also refactored `getAmode` a little bit to make it easier to
understand and to trace.
- - - - -
86125c20 by Gabor Greif at 2020-07-02T11:17:51-04:00
No need for CURSES_INCLUDE_DIRS
This is a leftover from ef63ff27251a20ff11e58c9303677fa31e609a88
- - - - -
ddfbf392 by Sylvain Henry at 2020-07-02T11:17:52-04:00
Replace Opt_SccProfilingOn flag with sccProfilingEnabled helper function
SCC profiling was enabled in a convoluted way: if WayProf was enabled,
Opt_SccProfilingOn general flag was set (in
`GHC.Driver.Ways.wayGeneralFlags`), and then this flag was queried in
various places.
There is no need to go via general flags, so this patch defines a
`sccProfilingEnabled :: DynFlags -> Bool` helper function that just
checks whether WayProf is enabled.
- - - - -
24 changed files:
- aclocal.m4
- compiler/GHC.hs
- compiler/GHC/Cmm/Info.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Driver/Ways.hs
- compiler/GHC/HsToCore/Coverage.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/Iface/Recomp/Flags.hs
- compiler/GHC/Runtime/Heap/Layout.hs
- compiler/GHC/Stg/Syntax.hs
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/Closure.hs
- compiler/GHC/StgToCmm/Foreign.hs
- compiler/GHC/StgToCmm/Layout.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToCmm/Prof.hs
- hadrian/src/Hadrian/Haskell/Cabal.hs
- + testsuite/tests/codeGen/should_compile/T15570.hs
- testsuite/tests/codeGen/should_compile/all.T
Changes:
=====================================
aclocal.m4
=====================================
@@ -1875,7 +1875,6 @@ AC_DEFUN([FP_CURSES],
[directory containing curses libraries])],
[CURSES_LIB_DIRS=$withval])
- AC_SUBST(CURSES_INCLUDE_DIRS)
AC_SUBST(CURSES_LIB_DIRS)
])# FP_CURSES
=====================================
compiler/GHC.hs
=====================================
@@ -605,10 +605,12 @@ setSessionDynFlags dflags = do
then do
let
prog = pgm_i dflags ++ flavour
+ profiled = ways dflags `hasWay` WayProf
+ dynamic = ways dflags `hasWay` WayDyn
flavour
- | WayProf `S.member` ways dflags = "-prof"
- | WayDyn `S.member` ways dflags = "-dyn"
- | otherwise = ""
+ | profiled = "-prof" -- FIXME: can't we have both?
+ | dynamic = "-dyn"
+ | otherwise = ""
msg = text "Starting " <> text prog
tr <- if verbosity dflags >= 3
then return (logInfo dflags $ withPprStyle defaultDumpStyle msg)
@@ -617,8 +619,8 @@ setSessionDynFlags dflags = do
conf = IServConfig
{ iservConfProgram = prog
, iservConfOpts = getOpts dflags opt_i
- , iservConfProfiled = gopt Opt_SccProfilingOn dflags
- , iservConfDynamic = WayDyn `S.member` ways dflags
+ , iservConfProfiled = profiled
+ , iservConfDynamic = dynamic
, iservConfHook = createIservProcessHook (hooks dflags)
, iservConfTrace = tr
}
=====================================
compiler/GHC/Cmm/Info.hs
=====================================
@@ -405,7 +405,7 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt layout_lit
where
platform = targetPlatform dflags
prof_info
- | gopt Opt_SccProfilingOn dflags = [type_descr, closure_descr]
+ | sccProfilingEnabled dflags = [type_descr, closure_descr]
| otherwise = []
tag = CmmInt (fromIntegral cl_type) (halfWordWidth platform)
@@ -565,7 +565,7 @@ stdInfoTableSizeW :: DynFlags -> WordOff
-- It must vary in sync with mkStdInfoTable
stdInfoTableSizeW dflags
= fixedInfoTableSizeW
- + if gopt Opt_SccProfilingOn dflags
+ + if sccProfilingEnabled dflags
then profInfoTableSizeW
else 0
=====================================
compiler/GHC/Cmm/Parser.y
=====================================
@@ -1168,7 +1168,7 @@ reserveStackFrame psize preg body = do
withUpdFrameOff frame body
profilingInfo dflags desc_str ty_str
- = if not (gopt Opt_SccProfilingOn dflags)
+ = if not (sccProfilingEnabled dflags)
then NoProfilingInfo
else ProfilingInfo (BS8.pack desc_str) (BS8.pack ty_str)
=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -1241,71 +1241,89 @@ reg2reg format src dst = MOV format (OpReg src) (OpReg dst)
--------------------------------------------------------------------------------
+
+-- | Convert a 'CmmExpr' representing a memory address into an 'Amode'.
+--
+-- An 'Amode' is a datatype representing a valid address form for the target
+-- (e.g. "Base + Index + disp" or immediate) and the code to compute it.
getAmode :: CmmExpr -> NatM Amode
-getAmode e = do is32Bit <- is32BitPlatform
- getAmode' is32Bit e
+getAmode e = do
+ platform <- getPlatform
+ let is32Bit = target32Bit platform
+
+ case e of
+ CmmRegOff r n
+ -> getAmode $ mangleIndexTree platform r n
+
+ CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal PicBaseReg), CmmLit displacement]
+ | not is32Bit
+ -> return $ Amode (ripRel (litToImm displacement)) nilOL
+
+ -- This is all just ridiculous, since it carefully undoes
+ -- what mangleIndexTree has just done.
+ CmmMachOp (MO_Sub _rep) [x, CmmLit lit@(CmmInt i _)]
+ | is32BitLit is32Bit lit
+ -- ASSERT(rep == II32)???
+ -> do
+ (x_reg, x_code) <- getSomeReg x
+ let off = ImmInt (-(fromInteger i))
+ return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
+
+ CmmMachOp (MO_Add _rep) [x, CmmLit lit]
+ | is32BitLit is32Bit lit
+ -- ASSERT(rep == II32)???
+ -> do
+ (x_reg, x_code) <- getSomeReg x
+ let off = litToImm lit
+ return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
+
+ -- Turn (lit1 << n + lit2) into (lit2 + lit1 << n) so it will be
+ -- recognised by the next rule.
+ CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _), b@(CmmLit _)]
+ -> getAmode (CmmMachOp (MO_Add rep) [b,a])
+
+ -- Matches: (x + offset) + (y << shift)
+ CmmMachOp (MO_Add _) [CmmRegOff x offset, CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)]]
+ | shift == 0 || shift == 1 || shift == 2 || shift == 3
+ -> x86_complex_amode (CmmReg x) y shift (fromIntegral offset)
+
+ CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)]]
+ | shift == 0 || shift == 1 || shift == 2 || shift == 3
+ -> x86_complex_amode x y shift 0
+
+ CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Add _) [CmmMachOp (MO_Shl _)
+ [y, CmmLit (CmmInt shift _)], CmmLit (CmmInt offset _)]]
+ | shift == 0 || shift == 1 || shift == 2 || shift == 3
+ && is32BitInteger offset
+ -> x86_complex_amode x y shift offset
+
+ CmmMachOp (MO_Add _) [x,y]
+ | not (isLit y) -- we already handle valid literals above.
+ -> x86_complex_amode x y 0 0
+
+ CmmLit lit
+ | is32BitLit is32Bit lit
+ -> return (Amode (ImmAddr (litToImm lit) 0) nilOL)
+
+ -- Literal with offsets too big (> 32 bits) fails during the linking phase
+ -- (#15570). We already handled valid literals above so we don't have to
+ -- test anything here.
+ CmmLit (CmmLabelOff l off)
+ -> getAmode (CmmMachOp (MO_Add W64) [ CmmLit (CmmLabel l)
+ , CmmLit (CmmInt (fromIntegral off) W64)
+ ])
+ CmmLit (CmmLabelDiffOff l1 l2 off w)
+ -> getAmode (CmmMachOp (MO_Add W64) [ CmmLit (CmmLabelDiffOff l1 l2 0 w)
+ , CmmLit (CmmInt (fromIntegral off) W64)
+ ])
+
+ -- in case we can't do something better, we just compute the expression
+ -- and put the result in a register
+ _ -> do
+ (reg,code) <- getSomeReg e
+ return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code)
-getAmode' :: Bool -> CmmExpr -> NatM Amode
-getAmode' _ (CmmRegOff r n) = do platform <- getPlatform
- getAmode $ mangleIndexTree platform r n
-getAmode' is32Bit (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal PicBaseReg),
- CmmLit displacement])
- | not is32Bit
- = return $ Amode (ripRel (litToImm displacement)) nilOL
-
-
--- This is all just ridiculous, since it carefully undoes
--- what mangleIndexTree has just done.
-getAmode' is32Bit (CmmMachOp (MO_Sub _rep) [x, CmmLit lit@(CmmInt i _)])
- | is32BitLit is32Bit lit
- -- ASSERT(rep == II32)???
- = do (x_reg, x_code) <- getSomeReg x
- let off = ImmInt (-(fromInteger i))
- return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
-
-getAmode' is32Bit (CmmMachOp (MO_Add _rep) [x, CmmLit lit])
- | is32BitLit is32Bit lit
- -- ASSERT(rep == II32)???
- = do (x_reg, x_code) <- getSomeReg x
- let off = litToImm lit
- return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
-
--- Turn (lit1 << n + lit2) into (lit2 + lit1 << n) so it will be
--- recognised by the next rule.
-getAmode' is32Bit (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _),
- b@(CmmLit _)])
- = getAmode' is32Bit (CmmMachOp (MO_Add rep) [b,a])
-
--- Matches: (x + offset) + (y << shift)
-getAmode' _ (CmmMachOp (MO_Add _) [CmmRegOff x offset,
- CmmMachOp (MO_Shl _)
- [y, CmmLit (CmmInt shift _)]])
- | shift == 0 || shift == 1 || shift == 2 || shift == 3
- = x86_complex_amode (CmmReg x) y shift (fromIntegral offset)
-
-getAmode' _ (CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Shl _)
- [y, CmmLit (CmmInt shift _)]])
- | shift == 0 || shift == 1 || shift == 2 || shift == 3
- = x86_complex_amode x y shift 0
-
-getAmode' _ (CmmMachOp (MO_Add _)
- [x, CmmMachOp (MO_Add _)
- [CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)],
- CmmLit (CmmInt offset _)]])
- | shift == 0 || shift == 1 || shift == 2 || shift == 3
- && is32BitInteger offset
- = x86_complex_amode x y shift offset
-
-getAmode' _ (CmmMachOp (MO_Add _) [x,y])
- = x86_complex_amode x y 0 0
-
-getAmode' is32Bit (CmmLit lit) | is32BitLit is32Bit lit
- = return (Amode (ImmAddr (litToImm lit) 0) nilOL)
-
-getAmode' _ expr = do
- (reg,code) <- getSomeReg expr
- return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code)
-- | Like 'getAmode', but on 32-bit use simple register addressing
-- (i.e. no index register). This stops us from running out of
@@ -1510,11 +1528,17 @@ getRegOrMem e = do
return (OpReg reg, code)
is32BitLit :: Bool -> CmmLit -> Bool
-is32BitLit is32Bit (CmmInt i W64)
- | not is32Bit
- = -- assume that labels are in the range 0-2^31-1: this assumes the
+is32BitLit is32Bit lit
+ | not is32Bit = case lit of
+ CmmInt i W64 -> is32BitInteger i
+ -- assume that labels are in the range 0-2^31-1: this assumes the
-- small memory model (see gcc docs, -mcmodel=small).
- is32BitInteger i
+ CmmLabel _ -> True
+ -- however we can't assume that label offsets are in this range
+ -- (see #15570)
+ CmmLabelOff _ off -> is32BitInteger (fromIntegral off)
+ CmmLabelDiffOff _ _ off _ -> is32BitInteger (fromIntegral off)
+ _ -> True
is32BitLit _ _ = True
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -275,11 +275,9 @@ outputForeignStubs_help fname doc_str header footer
-- module;
-- | Generate code to initialise cost centres
-profilingInitCode :: DynFlags -> Module -> CollectedCCs -> SDoc
-profilingInitCode dflags this_mod (local_CCs, singleton_CCSs)
- = if not (gopt Opt_SccProfilingOn dflags)
- then empty
- else vcat
+profilingInitCode :: Module -> CollectedCCs -> SDoc
+profilingInitCode this_mod (local_CCs, singleton_CCSs)
+ = vcat
$ map emit_cc_decl local_CCs
++ map emit_ccs_decl singleton_CCSs
++ [emit_cc_list local_CCs]
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -252,7 +252,6 @@ data GeneralFlag
| Opt_PIE -- ^ @-fPIE@
| Opt_PICExecutable -- ^ @-pie@
| Opt_ExternalDynamicRefs
- | Opt_SccProfilingOn
| Opt_Ticky
| Opt_Ticky_Allocd
| Opt_Ticky_LNE
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1412,7 +1412,9 @@ hscGenHardCode hsc_env cgguts location output_filename = do
let cost_centre_info =
(S.toList local_ccs ++ caf_ccs, caf_cc_stacks)
- prof_init = profilingInitCode dflags this_mod cost_centre_info
+ prof_init
+ | sccProfilingEnabled dflags = profilingInitCode this_mod cost_centre_info
+ | otherwise = empty
foreign_stubs = foreign_stubs0 `appendStubC` prof_init
------------------ Code generation ------------------
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -42,6 +42,7 @@ module GHC.Driver.Session (
whenCannotGenerateDynamicToo,
dynamicTooMkDynamicDynFlags,
dynamicOutputFile,
+ sccProfilingEnabled,
DynFlags(..),
FlagSpec(..),
HasDynFlags(..), ContainsDynFlags(..),
@@ -5094,6 +5095,10 @@ isBmi2Enabled dflags = case platformArch (targetPlatform dflags) of
ArchX86 -> bmiVersion dflags >= Just BMI2
_ -> False
+-- | Indicate if cost-centre profiling is enabled
+sccProfilingEnabled :: DynFlags -> Bool
+sccProfilingEnabled dflags = ways dflags `hasWay` WayProf
+
-- -----------------------------------------------------------------------------
-- Linker/compiler information
=====================================
compiler/GHC/Driver/Ways.hs
=====================================
@@ -20,6 +20,7 @@
-- this compilation.
module GHC.Driver.Ways
( Way(..)
+ , hasWay
, allowed_combination
, wayGeneralFlags
, wayUnsetGeneralFlags
@@ -60,12 +61,15 @@ data Way
| WayDyn -- ^ Dynamic linking
deriving (Eq, Ord, Show)
+-- | Test if a ways is enabled
+hasWay :: Set Way -> Way -> Bool
+hasWay ws w = Set.member w ws
-- | Check if a combination of ways is allowed
allowed_combination :: Set Way -> Bool
allowed_combination ways = not disallowed
where
- disallowed = or [ Set.member ways x && Set.member ways y
+ disallowed = or [ hasWay ways x && hasWay ways y
| (x,y) <- couples
]
-- List of disallowed couples of ways
@@ -121,7 +125,7 @@ wayGeneralFlags _ WayDyn = [Opt_PIC, Opt_ExternalDynamicRefs]
-- .so before loading the .so using the system linker. Since only
-- PIC objects can be linked into a .so, we have to compile even
-- modules of the main program with -fPIC when using -dynamic.
-wayGeneralFlags _ WayProf = [Opt_SccProfilingOn]
+wayGeneralFlags _ WayProf = []
wayGeneralFlags _ WayEventLog = []
-- | Turn these flags off when enabling this way
=====================================
compiler/GHC/HsToCore/Coverage.hs
=====================================
@@ -1040,7 +1040,7 @@ coveragePasses :: DynFlags -> [TickishType]
coveragePasses dflags =
ifa (breakpointsEnabled dflags) Breakpoints $
ifa (gopt Opt_Hpc dflags) HpcTicks $
- ifa (gopt Opt_SccProfilingOn dflags &&
+ ifa (sccProfilingEnabled dflags &&
profAuto dflags /= NoProfAuto) ProfNotes $
ifa (debugLevel dflags > 0) SourceNotes []
where ifa f x xs | f = x:xs
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -813,7 +813,7 @@ dsExpr (HsRecFld {}) = panic "dsExpr:HsRecFld"
ds_prag_expr :: HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr
ds_prag_expr (HsPragSCC _ _ cc) expr = do
dflags <- getDynFlags
- if gopt Opt_SccProfilingOn dflags
+ if sccProfilingEnabled dflags
then do
mod_name <- getModule
count <- goptM Opt_ProfCountEntries
=====================================
compiler/GHC/Iface/Recomp/Flags.hs
=====================================
@@ -55,7 +55,7 @@ fingerprintDynFlags dflags at DynFlags{..} this_mod nameio =
paths = [ hcSuf ]
-- -fprof-auto etc.
- prof = if gopt Opt_SccProfilingOn dflags then fromEnum profAuto else 0
+ prof = if sccProfilingEnabled dflags then fromEnum profAuto else 0
-- Ticky
ticky =
=====================================
compiler/GHC/Runtime/Heap/Layout.hs
=====================================
@@ -282,8 +282,8 @@ fixedHdrSizeW dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
-- (StgProfHeader in includes\/rts\/storage\/Closures.h)
profHdrSize :: DynFlags -> WordOff
profHdrSize dflags
- | gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
- | otherwise = 0
+ | sccProfilingEnabled dflags = pROF_HDR_SIZE dflags
+ | otherwise = 0
-- | The garbage collector requires that every closure is at least as
-- big as this.
=====================================
compiler/GHC/Stg/Syntax.hs
=====================================
@@ -805,7 +805,7 @@ pprStgRhs :: OutputablePass pass => GenStgRhs pass -> SDoc
pprStgRhs (StgRhsClosure ext cc upd_flag args body)
= sdocWithDynFlags $ \dflags ->
- hang (hsep [if gopt Opt_SccProfilingOn dflags then ppr cc else empty,
+ hang (hsep [if sccProfilingEnabled dflags then ppr cc else empty,
ppUnlessOption sdocSuppressStgExts (ppr ext),
char '\\' <> ppr upd_flag, brackets (interppSP args)])
4 (ppr body)
=====================================
compiler/GHC/StgToCmm/Bind.hs
=====================================
@@ -307,7 +307,7 @@ mkRhsClosure dflags bndr _cc
, all (isGcPtrRep . idPrimRep . fromNonVoid) fvs
, isUpdatable upd_flag
, n_fvs <= mAX_SPEC_AP_SIZE dflags
- , not (gopt Opt_SccProfilingOn dflags)
+ , not (sccProfilingEnabled dflags)
-- not when profiling: we don't want to
-- lose information about this particular
-- thunk (e.g. its type) (#949)
@@ -626,7 +626,7 @@ emitBlackHoleCode node = do
-- Note the eager-blackholing check is here rather than in blackHoleOnEntry,
-- because emitBlackHoleCode is called from GHC.Cmm.Parser.
- let eager_blackholing = not (gopt Opt_SccProfilingOn dflags)
+ let eager_blackholing = not (sccProfilingEnabled dflags)
&& gopt Opt_EagerBlackHoling dflags
-- Profiling needs slop filling (to support LDV
-- profiling), so currently eager blackholing doesn't
@@ -655,7 +655,7 @@ setupUpdate closure_info node body
dflags <- getDynFlags
let
bh = blackHoleOnEntry closure_info &&
- not (gopt Opt_SccProfilingOn dflags) &&
+ not (sccProfilingEnabled dflags) &&
gopt Opt_EagerBlackHoling dflags
lbl | bh = mkBHUpdInfoLabel
=====================================
compiler/GHC/StgToCmm/Closure.hs
=====================================
@@ -381,7 +381,7 @@ nodeMustPointToIt dflags (LFThunk top no_fvs updatable NonStandardThunk _)
= not no_fvs -- Self parameter
|| isNotTopLevel top -- Note [GC recovery]
|| updatable -- Need to push update frame
- || gopt Opt_SccProfilingOn dflags
+ || sccProfilingEnabled dflags
-- For the non-updatable (single-entry case):
--
-- True if has fvs (in which case we need access to them, and we
@@ -508,7 +508,7 @@ getCallMethod dflags _ id _ n_args v_args _cg_loc
getCallMethod dflags name id (LFReEntrant _ arity _ _) n_args _v_args _cg_loc
_self_loop_info
| n_args == 0 -- No args at all
- && not (gopt Opt_SccProfilingOn dflags)
+ && not (sccProfilingEnabled dflags)
-- See Note [Evaluating functions with profiling] in rts/Apply.cmm
= ASSERT( arity /= 0 ) ReturnIt
| n_args < arity = SlowCall -- Not enough args
@@ -859,7 +859,7 @@ enterIdLabel platform id c
mkProfilingInfo :: DynFlags -> Id -> String -> ProfilingInfo
mkProfilingInfo dflags id val_descr
- | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
+ | not (sccProfilingEnabled dflags) = NoProfilingInfo
| otherwise = ProfilingInfo ty_descr_w8 (BS8.pack val_descr)
where
ty_descr_w8 = BS8.pack (getTyDescription (idType id))
@@ -906,8 +906,8 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
-- We keep the *zero-indexed* tag in the srt_len field
-- of the info table of a data constructor.
- prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
- | otherwise = ProfilingInfo ty_descr val_descr
+ prof | not (sccProfilingEnabled dflags) = NoProfilingInfo
+ | otherwise = ProfilingInfo ty_descr val_descr
ty_descr = BS8.pack $ occNameString $ getOccName $ dataConTyCon data_con
val_descr = BS8.pack $ occNameString $ getOccName data_con
=====================================
compiler/GHC/StgToCmm/Foreign.hs
=====================================
@@ -306,7 +306,7 @@ saveThreadState dflags = do
spExpr,
close_nursery,
-- and save the current cost centre stack in the TSO when profiling:
- if gopt Opt_SccProfilingOn dflags then
+ if sccProfilingEnabled dflags then
mkStore (cmmOffset platform (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) cccsExpr
else mkNop
]
@@ -421,7 +421,7 @@ loadThreadState dflags = do
mkAssign hpAllocReg (zeroExpr platform),
open_nursery,
-- and load the current cost centre stack from the TSO when profiling:
- if gopt Opt_SccProfilingOn dflags
+ if sccProfilingEnabled dflags
then storeCurCCS
(CmmLoad (cmmOffset platform (CmmReg (CmmLocal tso))
(tso_CCCS dflags)) (ccsType platform))
=====================================
compiler/GHC/StgToCmm/Layout.hs
=====================================
@@ -367,7 +367,7 @@ just more arguments that we are passing on the stack (cml_args).
slowArgs :: DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)]
slowArgs _ [] = []
slowArgs dflags args -- careful: reps contains voids (V), but args does not
- | gopt Opt_SccProfilingOn dflags
+ | sccProfilingEnabled dflags
= save_cccs ++ this_pat ++ slowArgs dflags rest_args
| otherwise = this_pat ++ slowArgs dflags rest_args
where
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -300,8 +300,8 @@ emitPrimOp dflags = \case
GetCCSOfOp -> \[arg] -> opAllDone $ \[res] -> do
let
val
- | gopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg)
- | otherwise = CmmLit (zeroCLit platform)
+ | sccProfilingEnabled dflags = costCentreFrom dflags (cmmUntag dflags arg)
+ | otherwise = CmmLit (zeroCLit platform)
emitAssign (CmmLocal res) val
GetCurrentCCSOp -> \[_] -> opAllDone $ \[res] -> do
=====================================
compiler/GHC/StgToCmm/Prof.hs
=====================================
@@ -76,15 +76,15 @@ costCentreFrom dflags cl = CmmLoad (cmmOffsetB platform cl (oFFSET_StgHeader_ccs
-- | The profiling header words in a static closure
staticProfHdr :: DynFlags -> CostCentreStack -> [CmmLit]
staticProfHdr dflags ccs
- | gopt Opt_SccProfilingOn dflags = [mkCCostCentreStack ccs, staticLdvInit platform]
- | otherwise = []
+ | sccProfilingEnabled dflags = [mkCCostCentreStack ccs, staticLdvInit platform]
+ | otherwise = []
where platform = targetPlatform dflags
-- | Profiling header words in a dynamic closure
dynProfHdr :: DynFlags -> CmmExpr -> [CmmExpr]
dynProfHdr dflags ccs
- | gopt Opt_SccProfilingOn dflags = [ccs, dynLdvInit dflags]
- | otherwise = []
+ | sccProfilingEnabled dflags = [ccs, dynLdvInit dflags]
+ | otherwise = []
-- | Initialise the profiling field of an update frame
initUpdFrameProf :: CmmExpr -> FCode ()
@@ -130,7 +130,7 @@ saveCurrentCostCentre :: FCode (Maybe LocalReg)
saveCurrentCostCentre
= do dflags <- getDynFlags
platform <- getPlatform
- if not (gopt Opt_SccProfilingOn dflags)
+ if not (sccProfilingEnabled dflags)
then return Nothing
else do local_cc <- newTemp (ccType platform)
emitAssign (CmmLocal local_cc) cccsExpr
@@ -195,7 +195,7 @@ enterCostCentreFun ccs closure =
ifProfiling :: FCode () -> FCode ()
ifProfiling code
= do dflags <- getDynFlags
- if gopt Opt_SccProfilingOn dflags
+ if sccProfilingEnabled dflags
then code
else return ()
@@ -207,7 +207,7 @@ initCostCentres :: CollectedCCs -> FCode ()
-- Emit the declarations
initCostCentres (local_CCs, singleton_CCSs)
= do dflags <- getDynFlags
- when (gopt Opt_SccProfilingOn dflags) $
+ when (sccProfilingEnabled dflags) $
do mapM_ emitCostCentreDecl local_CCs
mapM_ emitCostCentreStackDecl singleton_CCSs
@@ -277,7 +277,7 @@ emitSetCCC :: CostCentre -> Bool -> Bool -> FCode ()
emitSetCCC cc tick push
= do dflags <- getDynFlags
platform <- getPlatform
- if not (gopt Opt_SccProfilingOn dflags)
+ if not (sccProfilingEnabled dflags)
then return ()
else do tmp <- newTemp (ccsType platform)
pushCostCentre tmp cccsExpr cc
=====================================
hadrian/src/Hadrian/Haskell/Cabal.hs
=====================================
@@ -59,9 +59,10 @@ pkgGenericDescription = fmap genericPackageDescription . readPackageData
--
-- Inverse of 'Cabal.Distribution.Simple.GHC.ghcArchString'.
cabalArchString :: String -> String
-cabalArchString "powerpc" = "ppc"
-cabalArchString "powerpc64" = "ppc64"
-cabalArchString other = other
+cabalArchString "powerpc" = "ppc"
+cabalArchString "powerpc64" = "ppc64"
+cabalArchString "powerpc64le" = "ppc64"
+cabalArchString other = other
-- | Cabal's rendering of an OS as used in its directory structure.
--
=====================================
testsuite/tests/codeGen/should_compile/T15570.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE MagicHash #-}
+import GHC.Exts
+
+main :: IO ()
+main = print $ C# (indexCharOffAddr# "foo"# -9223372036854775808#)
=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -91,3 +91,8 @@ test('T17648', normal, makefile_test, [])
test('T17904', normal, compile, ['-O'])
test('T18227A', normal, compile, [''])
test('T18227B', normal, compile, [''])
+test('T15570',
+ when(unregisterised(), skip),
+ compile, ['-Wno-overflowed-literals'])
+ # skipped with CmmToC because it generates a warning:
+ # warning: integer constant is so large that it is unsigned
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc31cc3bbc83ddd07ec5fd9197595226ce123d74...ddfbf39253815245653d39c941792859c2948521
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc31cc3bbc83ddd07ec5fd9197595226ce123d74...ddfbf39253815245653d39c941792859c2948521
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/20200702/713b7b42/attachment-0001.html>
More information about the ghc-commits
mailing list