[Git][ghc/ghc][wip/tsan/fixes-2] 6 commits: hadrian: Ensure that way-flags are passed to CC
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Thu Jun 22 23:01:27 UTC 2023
Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC
Commits:
ae33b2c4 by Ben Gamari at 2023-06-22T18:58:53-04:00
hadrian: Ensure that way-flags are passed to CC
Previously the way-specific compilation flags (e.g. `-DDEBUG`,
`-DTHREADED_RTS`) would not be passed to the CC invocations. This meant
that C dependency files would not correctly reflect
dependencies predicated on the way, resulting in the rather
painful #23554.
Closes #23554.
- - - - -
d1297dec by Ben Gamari at 2023-06-22T18:59:22-04:00
rts/Interpreter: Fix data race
- - - - -
634f8086 by Ben Gamari at 2023-06-22T18:59:48-04:00
rts/Messages: Fix data race
- - - - -
e6b6660a by Ben Gamari at 2023-06-22T19:00:06-04:00
rts/Prof: Fix data race
- - - - -
3f409a46 by Ben Gamari at 2023-06-22T19:00:31-04:00
rts: Fix various data races
- - - - -
31b8071c by Ben Gamari at 2023-06-22T19:00:43-04:00
rts: Use fence rather than redundant load
- - - - -
11 changed files:
- hadrian/src/Settings/Builders/Common.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Packages.hs
- rts/Interpreter.c
- rts/Messages.c
- rts/Proftimer.c
- rts/include/rts/storage/ClosureMacros.h
- rts/sm/Evac.c
- rts/sm/GC.c
- rts/sm/GCAux.c
- rts/sm/Storage.c
Changes:
=====================================
hadrian/src/Settings/Builders/Common.hs
=====================================
@@ -6,7 +6,8 @@ module Settings.Builders.Common (
module Settings,
module UserSettings,
cIncludeArgs, ldArgs, cArgs, cppArgs, cWarnings,
- packageDatabaseArgs, bootPackageDatabaseArgs
+ packageDatabaseArgs, bootPackageDatabaseArgs,
+ wayCcArgs
) where
import Hadrian.Haskell.Cabal.Type
@@ -65,3 +66,12 @@ bootPackageDatabaseArgs = do
dbPath <- expr $ packageDbPath loc
expr $ need [dbPath -/- packageDbStamp]
stage0 ? packageDatabaseArgs
+
+wayCcArgs :: Args
+wayCcArgs = do
+ way <- getWay
+ mconcat [ (Threaded `wayUnit` way) ? arg "-DTHREADED_RTS"
+ , (Debug `wayUnit` way) ? arg "-DDEBUG"
+ , (way == debug || way == debugDynamic) ? arg "-DTICKY_TICKY"
+ ]
+
=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -240,11 +240,14 @@ wayGhcArgs = do
mconcat [ if Dynamic `wayUnit` way
then pure ["-fPIC", "-dynamic"]
else arg "-static"
- , (Threaded `wayUnit` way) ? arg "-optc-DTHREADED_RTS"
- , (Debug `wayUnit` way) ? arg "-optc-DDEBUG"
, (Profiling `wayUnit` way) ? arg "-prof"
- , (way == debug || way == debugDynamic) ?
- pure ["-ticky", "-DTICKY_TICKY"] ]
+ , (way == debug || way == debugDynamic) ? arg "-ticky"
+ , wayCcArgs
+ -- We must pass CPP flags via -optc as well to ensure that they
+ -- are passed to the preprocessor when, e.g., compiling Cmm
+ -- sources.
+ , map ("-optc"++) <$> wayCcArgs
+ ]
-- | Args related to correct handling of packages, such as setting
-- -this-unit-id and passing -package-id for dependencies
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -6,6 +6,7 @@ import Oracles.Setting
import Oracles.Flag
import Packages
import Settings
+import Settings.Builders.Common (wayCcArgs)
-- | Package-specific command-line arguments.
packageArgs :: Args
@@ -312,6 +313,7 @@ rtsPackageArgs = package rts ? do
let cArgs = mconcat
[ rtsWarnings
+ , wayCcArgs
, arg "-fomit-frame-pointer"
-- RTS *must* be compiled with optimisations. The INLINE_HEADER macro
-- requires that functions are inlined to work as expected. Inlining
=====================================
rts/Interpreter.c
=====================================
@@ -315,8 +315,9 @@ interpretBCO (Capability* cap)
LOAD_THREAD_STATE();
- RELAXED_STORE(&cap->r.rHpLim, (P_)1); // HpLim is the context-switch flag; when it
- // goes to zero we must return to the scheduler.
+ // N.B. HpLim is the context-switch flag; when it
+ // goes to zero we must return to the scheduler.
+ RELAXED_STORE_ALWAYS(&cap->r.rHpLim, (P_)1);
IF_DEBUG(interpreter,
debugBelch(
=====================================
rts/Messages.c
=====================================
@@ -205,7 +205,7 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg)
StgTSO *owner = (StgTSO*)p;
#if defined(THREADED_RTS)
- if (owner->cap != cap) {
+ if (RELAXED_LOAD(&owner->cap) != cap) {
sendMessage(cap, owner->cap, (Message*)msg);
debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d",
owner->cap->no);
@@ -275,7 +275,7 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg)
ASSERT(owner != END_TSO_QUEUE);
#if defined(THREADED_RTS)
- if (owner->cap != cap) {
+ if (RELAXED_LOAD(&owner->cap) != cap) {
sendMessage(cap, owner->cap, (Message*)msg);
debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d",
owner->cap->no);
=====================================
rts/Proftimer.c
=====================================
@@ -124,7 +124,8 @@ handleProfTick(void)
uint32_t n;
for (n=0; n < getNumCapabilities(); n++) {
Capability *cap = getCapability(n);
- cap->r.rCCCS->time_ticks++;
+ CostCentreStack *ccs = RELAXED_LOAD(&cap->r.rCCCS);
+ ccs->time_ticks++;
traceProfSampleCostCentre(cap, cap->r.rCCCS, total_ticks);
}
}
=====================================
rts/include/rts/storage/ClosureMacros.h
=====================================
@@ -182,7 +182,7 @@ EXTERN_INLINE StgHalfWord GET_TAG(const StgClosure *con)
// Use when changing a closure from one kind to another
#define OVERWRITE_INFO(c, new_info) \
OVERWRITING_CLOSURE((StgClosure *)(c)); \
- SET_INFO((StgClosure *)(c), (new_info)); \
+ SET_INFO_RELAXED((StgClosure *)(c), (new_info)); \
LDV_RECORD_CREATE(c);
/* -----------------------------------------------------------------------------
=====================================
rts/sm/Evac.c
=====================================
@@ -1542,7 +1542,7 @@ selector_loop:
bale_out:
// We didn't manage to evaluate this thunk; restore the old info
// pointer. But don't forget: we still need to evacuate the thunk itself.
- SET_INFO((StgClosure *)p, (const StgInfoTable *)info_ptr);
+ SET_INFO_RELAXED((StgClosure *)p, (const StgInfoTable *)info_ptr);
// THREADED_RTS: we just unlocked the thunk, so another thread
// might get in and update it. copy() will lock it again and
// check whether it was updated in the meantime.
=====================================
rts/sm/GC.c
=====================================
@@ -340,8 +340,8 @@ GarbageCollect (struct GcConfig config,
// attribute any costs to CCS_GC
#if defined(PROFILING)
for (n = 0; n < getNumCapabilities(); n++) {
- save_CCS[n] = getCapability(n)->r.rCCCS;
- getCapability(n)->r.rCCCS = CCS_GC;
+ save_CCS[n] = RELAXED_LOAD(&getCapability(n)->r.rCCCS);
+ RELAXED_STORE(&getCapability(n)->r.rCCCS, CCS_GC);
}
#endif
=====================================
rts/sm/GCAux.c
=====================================
@@ -91,7 +91,7 @@ isAlive(StgClosure *p)
return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info));
}
- ACQUIRE_LOAD(&q->header.info);
+ ACQUIRE_FENCE_ON(&q->header.info);
info = INFO_PTR_TO_STRUCT(info);
switch (info->type) {
=====================================
rts/sm/Storage.c
=====================================
@@ -1431,7 +1431,7 @@ dirty_MUT_VAR(StgRegTable *reg, StgMutVar *mvar, StgClosure *old)
Capability *cap = regTableToCapability(reg);
// No barrier required here as no other heap object fields are read. See
// Note [Heap memory barriers] in SMP.h.
- SET_INFO((StgClosure*) mvar, &stg_MUT_VAR_DIRTY_info);
+ SET_INFO_RELAXED((StgClosure*) mvar, &stg_MUT_VAR_DIRTY_info);
recordClosureMutated(cap, (StgClosure *) mvar);
IF_NONMOVING_WRITE_BARRIER_ENABLED {
// See Note [Dirty flags in the non-moving collector] in NonMoving.c
@@ -1453,7 +1453,7 @@ dirty_TVAR(Capability *cap, StgTVar *p,
// No barrier required here as no other heap object fields are read. See
// Note [Heap memory barriers] in SMP.h.
if (RELAXED_LOAD(&p->header.info) == &stg_TVAR_CLEAN_info) {
- SET_INFO((StgClosure*) p, &stg_TVAR_DIRTY_info);
+ SET_INFO_RELAXED((StgClosure*) p, &stg_TVAR_DIRTY_info);
recordClosureMutated(cap,(StgClosure*)p);
IF_NONMOVING_WRITE_BARRIER_ENABLED {
// See Note [Dirty flags in the non-moving collector] in NonMoving.c
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a177f3fe91f796331bc0abfb84aaf55b1186821d...31b8071c6535820e4edc0a45620a1a66da469a88
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a177f3fe91f796331bc0abfb84aaf55b1186821d...31b8071c6535820e4edc0a45620a1a66da469a88
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/20230622/9a5a7f4a/attachment-0001.html>
More information about the ghc-commits
mailing list