diff --git a/mps/code/global.c b/mps/code/global.c
index 5c19db2b329..9c68a483dd1 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -871,7 +871,7 @@ Res ArenaDefinalize(Arena arena, Ref obj)
 }
 
 
-/* Peek / Poke */
+/* ArenaPeek -- read a single reference, possibly through a barrier */
 
 Ref ArenaPeek(Arena arena, Ref *p)
 {
@@ -888,74 +888,19 @@ Ref ArenaPeek(Arena arena, Ref *p)
   return ref;
 }
 
+/* ArenaPeekSeg -- as ArenaPeek, but p must be in seg. */
+
 Ref ArenaPeekSeg(Arena arena, Seg seg, Ref *p)
 {
   Ref ref;
-
-  AVERT(Arena, arena);
-  AVERT(Seg, seg);
-
-  AVER(SegBase(seg) <= (Addr)p);
-  AVER((Addr)p < SegLimit(seg));
-  /* TODO: Consider checking p's alignment using seg->pool->alignment */
-
-  ShieldExpose(arena, seg);
-  ref = *p;
-  ShieldCover(arena, seg);
-  return ref;
-}
-
-void ArenaPoke(Arena arena, Ref *p, Ref ref)
-{
-  Seg seg;
-
-  AVERT(Arena, arena);
-  /* Can't check p as it is arbitrary */
-  /* Can't check ref as it is arbitrary */
-
-  if (SegOfAddr(&seg, arena, (Addr)p))
-    ArenaPokeSeg(arena, seg, p, ref);
-  else
-    *p = ref;
-}
-
-void ArenaPokeSeg(Arena arena, Seg seg, Ref *p, Ref ref)
-{
-  RefSet summary;
-
-  AVERT(Arena, arena);
-  AVERT(Seg, seg);
-  AVER(SegBase(seg) <= (Addr)p);
-  AVER((Addr)p < SegLimit(seg));
-  /* TODO: Consider checking p's alignment using seg->pool->alignment */
-  /* ref is arbitrary and can't be checked */
-
-  ShieldExpose(arena, seg);
-  *p = ref;
-  summary = SegSummary(seg);
-  summary = RefSetAdd(arena, summary, (Addr)ref);
-  SegSetSummary(seg, summary);
-  ShieldCover(arena, seg);
-}
-
-
-/* ArenaRead -- read a single reference, possibly through a barrier
- *
- * This forms part of a software barrier.  It provides fine-grain access
- * to single references in segments.
- * 
- * See also PoolSingleAccess and PoolSegAccess. */
-
-Ref ArenaRead(Arena arena, Ref *p)
-{
-  Bool b;
-  Seg seg = NULL;       /* suppress "may be used uninitialized" */
   Rank rank;
 
   AVERT(Arena, arena);
-
-  b = SegOfAddr(&seg, arena, (Addr)p);
-  AVER(b == TRUE);
+  AVERT(Seg, seg);
+  AVER(PoolArena(SegPool(seg)) == arena);
+  AVER(SegBase(seg) <= (Addr)p);
+  AVER((Addr)p < SegLimit(seg));
+  /* TODO: Consider checking p's alignment using seg->pool->alignment */
 
   /* .read.flipped: We AVER that the reference that we are reading */
   /* refers to an object for which all the traces that the object is */
@@ -977,11 +922,81 @@ Ref ArenaRead(Arena arena, Ref *p)
 
   /* We don't need to update the Seg Summary as in PoolSingleAccess
    * because we are not changing it after it has been scanned. */
+
+  ShieldExpose(arena, seg);
+  ref = *p;
+  ShieldCover(arena, seg);
+  return ref;
+}
+
+/* ArenaPoke -- write a single reference, possibly through a barrier */
+
+void ArenaPoke(Arena arena, Ref *p, Ref ref)
+{
+  Seg seg;
+
+  AVERT(Arena, arena);
+  /* Can't check p as it is arbitrary */
+  /* Can't check ref as it is arbitrary */
+
+  if (SegOfAddr(&seg, arena, (Addr)p))
+    ArenaPokeSeg(arena, seg, p, ref);
+  else
+    *p = ref;
+}
+
+/* ArenaPokeSeg -- as ArenaPoke, but p must be in seg. */
+
+void ArenaPokeSeg(Arena arena, Seg seg, Ref *p, Ref ref)
+{
+  RefSet summary;
+
+  AVERT(Arena, arena);
+  AVERT(Seg, seg);
+  AVER(PoolArena(SegPool(seg)) == arena);
+  AVER(SegBase(seg) <= (Addr)p);
+  AVER((Addr)p < SegLimit(seg));
+  /* TODO: Consider checking p's alignment using seg->pool->alignment */
+  /* ref is arbitrary and can't be checked */
+
+  ShieldExpose(arena, seg);
+  *p = ref;
+  summary = SegSummary(seg);
+  summary = RefSetAdd(arena, summary, (Addr)ref);
+  SegSetSummary(seg, summary);
+  ShieldCover(arena, seg);
+}
+
+/* ArenaRead -- like ArenaPeek, but reference known to be owned by arena */
+
+Ref ArenaRead(Arena arena, Ref *p)
+{
+  Bool b;
+  Seg seg = NULL;       /* suppress "may be used uninitialized" */
+
+  AVERT(Arena, arena);
+
+  b = SegOfAddr(&seg, arena, (Addr)p);
+  AVER(b == TRUE);
   
-  /* get the possibly fixed reference */
   return ArenaPeekSeg(arena, seg, p);
 }
 
+/* ArenaWrite -- like ArenaPoke, but reference known to be owned by arena */
+
+void ArenaWrite(Arena arena, Ref *p, Ref ref)
+{
+  Bool b;
+  Seg seg = NULL;       /* suppress "may be used uninitialized" */
+
+  AVERT(Arena, arena);
+
+  b = SegOfAddr(&seg, arena, (Addr)p);
+  AVER(b == TRUE);
+  
+  ArenaPokeSeg(arena, seg, p, ref);
+}
+
 
 /* GlobalsDescribe -- describe the arena globals */
 
diff --git a/mps/code/locus.c b/mps/code/locus.c
index a93fb72f0ae..7f78e17831b 100644
--- a/mps/code/locus.c
+++ b/mps/code/locus.c
@@ -605,11 +605,11 @@ static void PoolGenAccountForAlloc(PoolGen pgen, Size size)
 
 /* PoolGenAlloc -- allocate a segment in a pool generation
  *
- * Allocate a GCSeg, attach it to the generation, and update the
- * accounting.
+ * Allocate a segment belong to klass (which must be GCSegClass or a
+ * subclass), attach it to the generation, and update the accounting.
  */
 
-Res PoolGenAlloc(Seg *segReturn, PoolGen pgen, SegClass class, Size size,
+Res PoolGenAlloc(Seg *segReturn, PoolGen pgen, SegClass klass, Size size,
                  ArgList args)
 {
   LocusPrefStruct pref;
@@ -621,7 +621,8 @@ Res PoolGenAlloc(Seg *segReturn, PoolGen pgen, SegClass class, Size size,
 
   AVER(segReturn != NULL);
   AVERT(PoolGen, pgen);
-  AVERT(SegClass, class);
+  AVERT(SegClass, klass);
+  AVER(IsSubclass(klass, GCSeg));
   AVER(size > 0);
   AVERT(ArgList, args);
 
@@ -633,7 +634,7 @@ Res PoolGenAlloc(Seg *segReturn, PoolGen pgen, SegClass class, Size size,
   pref.high = FALSE;
   pref.zones = zones;
   pref.avoid = ZoneSetBlacklist(arena);
-  res = SegAlloc(&seg, class, &pref, size, pgen->pool, args);
+  res = SegAlloc(&seg, klass, &pref, size, pgen->pool, args);
   if (res != ResOK)
     return res;
 
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 07a3d08bd4f..dabf090ea2b 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -551,37 +551,32 @@ extern void ControlFree(Arena arena, void *base, size_t size);
 extern Res ControlDescribe(Arena arena, mps_lib_FILE *stream, Count depth);
 
 
-/* Peek/Poke
+/* Peek/Poke/Read/Write -- read/write possibly through barrier
  *
  * These are provided so that modules in the MPS can make occasional
- * access to client data.  They perform the appropriate shield and
- * summary manipulations that are necessary.
+ * access to client data, and to implement a software barrier for
+ * segments that are not handed out to the mutator. They protect the
+ * necessary colour, shield and summary invariants.
  *
- * Note that Peek and Poke can be called with address that may or
- * may not be in arena managed memory.  */
+ * Note that Peek and Poke can be called with an address that may or
+ * may not be in memory managed by arena, whereas Read and Write
+ * assert this is the case.
+ */
 
 /* Peek reads a value */
 extern Ref ArenaPeek(Arena arena, Ref *p);
+/* Same, but p known to be owned by arena */
+extern Ref ArenaRead(Arena arena, Ref *p);
 /* Same, but p must be in seg */
 extern Ref ArenaPeekSeg(Arena arena, Seg seg, Ref *p);
 /* Poke stores a value */
 extern void ArenaPoke(Arena arena, Ref *p, Ref ref);
+/* Same, but p known to be owned by arena */
+extern void ArenaWrite(Arena arena, Ref *p, Ref ref);
 /* Same, but p must be in seg */
 extern void ArenaPokeSeg(Arena arena, Seg seg, Ref *p, Ref ref);
 
 
-/* Read/Write
- *
- * These simulate mutator reads and writes to locations.
- * They are effectively a software barrier, and maintain the tricolor
- * invariant (hence performing any scanning or color manipulation
- * necessary).
- *
- * Only Read provided right now.  */
-
-Ref ArenaRead(Arena arena, Ref *p);
-
-
 extern Size ArenaReserved(Arena arena);
 extern Size ArenaCommitted(Arena arena);
 extern Size ArenaSpareCommitted(Arena arena);
@@ -651,6 +646,7 @@ extern Bool SegNext(Seg *segReturn, Arena arena, Seg seg);
 extern Bool SegNextOfRing(Seg *segReturn, Arena arena, Pool pool, Ring next);
 extern void SegSetWhite(Seg seg, TraceSet white);
 extern void SegSetGrey(Seg seg, TraceSet grey);
+extern void SegFlip(Seg seg, Trace trace);
 extern void SegSetRankSet(Seg seg, RankSet rankSet);
 extern void SegSetRankAndSummary(Seg seg, RankSet rankSet, RefSet summary);
 extern Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi);
@@ -684,6 +680,7 @@ extern Bool SegClassCheck(SegClass klass);
 DECLARE_CLASS(Inst, SegClass, InstClass);
 DECLARE_CLASS(Seg, Seg, Inst);
 DECLARE_CLASS(Seg, GCSeg, Seg);
+DECLARE_CLASS(Seg, MutatorSeg, GCSeg);
 #define SegGCSeg(seg) MustBeA(GCSeg, (seg))
 extern void SegClassMixInNoSplitMerge(SegClass klass);
 
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index fd02a6979ed..9510b8799bc 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -191,6 +191,7 @@ typedef struct SegClassStruct {
   SegSetBufferMethod setBuffer; /* set the segment buffer  */
   SegUnsetBufferMethod unsetBuffer; /* unset the segment buffer */
   SegSetGreyMethod setGrey;     /* change greyness of segment */
+  SegFlipMethod flip;           /* raise barrier for a flipped trace */
   SegSetWhiteMethod setWhite;   /* change whiteness of segment */
   SegSetRankSetMethod setRankSet; /* change rank set of segment */
   SegSetRankSummaryMethod setRankSummary; /* change rank set & summary */
diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h
index 33ffd2fdc98..3f87e5d0dfb 100644
--- a/mps/code/mpmtypes.h
+++ b/mps/code/mpmtypes.h
@@ -153,6 +153,7 @@ typedef void (*FreeBlockVisitor)(Addr base, Addr limit, Pool pool, void *p);
 typedef Res (*SegInitMethod)(Seg seg, Pool pool, Addr base, Size size,
                              ArgList args);
 typedef void (*SegSetGreyMethod)(Seg seg, TraceSet grey);
+typedef void (*SegFlipMethod)(Seg seg, Trace trace);
 typedef void (*SegSetWhiteMethod)(Seg seg, TraceSet white);
 typedef void (*SegSetRankSetMethod)(Seg seg, RankSet rankSet);
 typedef void (*SegSetRankSummaryMethod)(Seg seg, RankSet rankSet,
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index 3269c9b0665..8a85d13e5c3 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -44,7 +44,7 @@ typedef AMC AMCPool;
 DECLARE_CLASS(Pool, AMCPool, AMCZPool);
 
 DECLARE_CLASS(Buffer, amcBuf, SegBuf);
-DECLARE_CLASS(Seg, amcSeg, GCSeg);
+DECLARE_CLASS(Seg, amcSeg, MutatorSeg);
 
 
 /* amcGenStruct -- pool AMC generation descriptor */
@@ -351,7 +351,7 @@ static Res AMCSegDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
 
 DEFINE_CLASS(Seg, amcSeg, klass)
 {
-  INHERIT_CLASS(klass, amcSeg, GCSeg);
+  INHERIT_CLASS(klass, amcSeg, MutatorSeg);
   SegClassMixInNoSplitMerge(klass);  /* no support for this (yet) */
   klass->instClassStruct.describe = AMCSegDescribe;
   klass->instClassStruct.finish = amcSegFinish;
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index 00e1f782c75..392a2d7137a 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -615,7 +615,7 @@ static Res AMSSegDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
 
 DEFINE_CLASS(Seg, AMSSeg, klass)
 {
-  INHERIT_CLASS(klass, AMSSeg, GCSeg);
+  INHERIT_CLASS(klass, AMSSeg, MutatorSeg);
   klass->instClassStruct.describe = AMSSegDescribe;
   klass->instClassStruct.finish = AMSSegFinish;
   klass->size = sizeof(AMSSegStruct);
diff --git a/mps/code/poolams.h b/mps/code/poolams.h
index b168d6a250e..31be405ded6 100644
--- a/mps/code/poolams.h
+++ b/mps/code/poolams.h
@@ -172,7 +172,7 @@ DECLARE_CLASS(Pool, AMSPool, AbstractCollectPool);
 typedef AMS AMSDebugPool;
 DECLARE_CLASS(Pool, AMSDebugPool, AMSPool);
 
-DECLARE_CLASS(Seg, AMSSeg, GCSeg);
+DECLARE_CLASS(Seg, AMSSeg, MutatorSeg);
 
 
 #endif /* poolams_h */
diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c
index 287ce82e831..73564d4d904 100644
--- a/mps/code/poolawl.c
+++ b/mps/code/poolawl.c
@@ -111,10 +111,7 @@ typedef AWL AWLPool;
 DECLARE_CLASS(Pool, AWLPool, AbstractCollectPool);
 
 
-/* AWLSegStruct -- AWL segment subclass
- *
- * Subclass of GCSeg
- */
+/* AWLSegStruct -- AWL segment subclass */
 
 #define AWLSegSig ((Sig)0x519A3759) /* SIGnature AWL SeG */
 
@@ -134,7 +131,7 @@ typedef struct AWLSegStruct {
   Sig sig;                  /* <code/misc.h#sig> */
 } AWLSegStruct, *AWLSeg;
 
-DECLARE_CLASS(Seg, AWLSeg, GCSeg);
+DECLARE_CLASS(Seg, AWLSeg, MutatorSeg);
 
 ATTRIBUTE_UNUSED
 static Bool AWLSegCheck(AWLSeg awlseg)
@@ -277,7 +274,7 @@ static void AWLSegFinish(Inst inst)
 
 DEFINE_CLASS(Seg, AWLSeg, klass)
 {
-  INHERIT_CLASS(klass, AWLSeg, GCSeg);
+  INHERIT_CLASS(klass, AWLSeg, MutatorSeg);
   SegClassMixInNoSplitMerge(klass);  /* no support for this (yet) */
   klass->instClassStruct.finish = AWLSegFinish;
   klass->size = sizeof(AWLSegStruct);
diff --git a/mps/code/poollo.c b/mps/code/poollo.c
index a1b26255023..2bedfc44e21 100644
--- a/mps/code/poollo.c
+++ b/mps/code/poollo.c
@@ -31,7 +31,7 @@ typedef struct LOStruct {
 typedef LO LOPool;
 #define LOPoolCheck LOCheck
 DECLARE_CLASS(Pool, LOPool, AbstractSegBufPool);
-DECLARE_CLASS(Seg, LOSeg, GCSeg);
+DECLARE_CLASS(Seg, LOSeg, MutatorSeg);
 
 
 /* forward declaration */
@@ -71,7 +71,7 @@ static void loSegWalk(Seg seg, Format format, FormattedObjectsVisitor f,
 
 DEFINE_CLASS(Seg, LOSeg, klass)
 {
-  INHERIT_CLASS(klass, LOSeg, GCSeg);
+  INHERIT_CLASS(klass, LOSeg, MutatorSeg);
   SegClassMixInNoSplitMerge(klass);
   klass->instClassStruct.finish = loSegFinish;
   klass->size = sizeof(LOSegStruct);
diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index fbbaad87d26..0fb05d23cc6 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -74,7 +74,8 @@ typedef struct RefPartStruct {
 } RefPartStruct;
 
 
-/* MRGRefPartRef,MRGRefPartSetRef -- Peek and poke the reference
+/* MRGRefPartRef,MRGRefPartSetRef -- read and write the reference
+ * using the software barrier
  *
  * Might be more efficient to take a seg, rather than calculate it
  * every time.
@@ -87,7 +88,7 @@ static Ref MRGRefPartRef(Arena arena, RefPart refPart)
 
   AVER(refPart != NULL);
 
-  ref = ArenaPeek(arena, &refPart->ref);
+  ref = ArenaRead(arena, &refPart->ref);
   return ref;
 }
 
@@ -102,7 +103,7 @@ static void MRGRefPartSetRef(Arena arena, RefPart refPart, Ref ref)
 {
   AVER(refPart != NULL);
 
-  ArenaPoke(arena, &refPart->ref, ref);
+  ArenaWrite(arena, &refPart->ref, ref);
 }
 
 
diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c
index d72ab1400ed..11a6ed30ad6 100644
--- a/mps/code/poolsnc.c
+++ b/mps/code/poolsnc.c
@@ -47,7 +47,7 @@ typedef SNC SNCPool;
 #define SNCPoolCheck SNCCheck
 DECLARE_CLASS(Pool, SNCPool, AbstractSegBufPool);
 
-DECLARE_CLASS(Seg, SNCSeg, GCSeg);
+DECLARE_CLASS(Seg, SNCSeg, MutatorSeg);
 DECLARE_CLASS(Buffer, SNCBuf, RankBuf);
 static Bool SNCCheck(SNC snc);
 static void sncPopPartialSegChain(SNC snc, Buffer buf, Seg upTo);
@@ -171,7 +171,7 @@ DEFINE_CLASS(Buffer, SNCBuf, klass)
 
 /* SNCSegStruct -- SNC segment subclass
  *
- * This subclass of GCSeg links segments in chains.
+ * This subclass of MutatorSeg links segments in chains.
  */
 
 #define SNCSegSig ((Sig)0x51954C59)    /* SIGSNCSeG */
@@ -247,7 +247,7 @@ static void sncSegFinish(Inst inst)
 
 DEFINE_CLASS(Seg, SNCSeg, klass)
 {
-  INHERIT_CLASS(klass, SNCSeg, GCSeg);
+  INHERIT_CLASS(klass, SNCSeg, MutatorSeg);
   SegClassMixInNoSplitMerge(klass);  /* no support for this (yet) */
   klass->instClassStruct.finish = sncSegFinish;
   klass->size = sizeof(SNCSegStruct);
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 75c1d864af7..62f071d28b2 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -7,15 +7,8 @@
  *
  * PURPOSE
  *
- * .purpose: This is the implementation of the generic segment interface.
- * It defines the interface functions and two useful segment classes:
- * .purpose.class.seg: Class Seg is a class which is as simple
- * as efficiency demands permit.  (It includes fields for storing colour
- * for efficiency).  It may be subclassed by clients of the module.
- * .purpose.class.seg-gc: Class GCSeg is a concrete class support all
- * all current GC features, and providing full backwards compatibility
- * with "old-style" segments.  It may be subclassed by clients of the
- * module.
+ * .purpose: This is the implementation of the generic segment
+ * interface and the segment classes Seg, GCSeg and MutatorSeg.
  */
 
 #include "tract.h"
@@ -113,7 +106,7 @@ void SegFree(Seg seg)
 
 /* SegInit -- initialize a segment */
 
-static Res SegAbsInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
+static Res segAbsInit(Seg seg, Pool pool, Addr base, Size size, ArgList args)
 {
   Arena arena;
   Addr addr, limit;
@@ -185,7 +178,7 @@ static Res SegInit(Seg seg, SegClass klass, Pool pool, Addr base, Size size, Arg
 
 /* SegFinish -- finish a segment */
 
-static void SegAbsFinish(Inst inst)
+static void segAbsFinish(Inst inst)
 {
   Seg seg = MustBeA(Seg, inst);
   Arena arena;
@@ -259,6 +252,22 @@ void SegSetGrey(Seg seg, TraceSet grey)
      greyness, or if the segment doesn't contain any references. */
   if (grey != SegGrey(seg) && SegRankSet(seg) != RankSetEMPTY)
     Method(Seg, seg, setGrey)(seg, grey);
+
+  EVENT3(SegSetGrey, PoolArena(SegPool(seg)), seg, grey);
+}
+
+
+/* SegFlip -- update barriers for trace that's about to flip */
+
+void SegFlip(Seg seg, Trace trace)
+{
+  AVERT(Seg, seg);
+  AVERT(Trace, trace);
+
+  /* Don't dispatch to the class method unless the segment is grey for
+     the trace that's about to flip, and contains references. */
+  if (TraceSetIsMember(SegGrey(seg), trace) && SegRankSet(seg) != RankSetEMPTY)
+    Method(Seg, seg, flip)(seg, trace);
 }
 
 
@@ -385,7 +394,7 @@ Addr SegBufferScanLimit(Seg seg)
 
 /* SegDescribe -- describe a segment */
 
-Res SegAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
+static Res segAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
 {
   Seg seg = CouldBeA(Seg, inst);
   Res res;
@@ -929,6 +938,16 @@ static void segNoSetGrey(Seg seg, TraceSet grey)
 }
 
 
+/* segTrivFlip -- ignore trace that's about to flip */
+
+static void segTrivFlip(Seg seg, Trace trace)
+{
+  AVERT(Seg, seg);
+  AVERT(Trace, trace);
+  AVER(seg->rankSet != RankSetEMPTY);
+}
+
+
 /* segNoSetWhite -- non-method to change the whiteness of a segment */
 
 static void segNoSetWhite(Seg seg, TraceSet white)
@@ -1308,7 +1327,7 @@ static void segNoGreyen(Seg seg, Trace trace)
 }
 
 
-/* segNoGreyen -- blacken method for non-GC segs */
+/* segNoBlacken -- blacken method for non-GC segs */
 
 static void segNoBlacken(Seg seg, TraceSet traceSet)
 {
@@ -1369,9 +1388,7 @@ static void segTrivWalk(Seg seg, Format format, FormattedObjectsVisitor f,
 }
 
 
-/* Class GCSeg -- Segment class with GC support
- */
-
+/* Class GCSeg -- collectable segment class */
 
 /* GCSegCheck -- check the integrity of a GCSeg */
 
@@ -1520,31 +1537,39 @@ static void gcSegSetGreyInternal(Seg seg, TraceSet oldGrey, TraceSet grey)
 
 /* gcSegSetGrey -- GCSeg method to change the greyness of a segment
  *
- * Sets the segment greyness to the trace set grey and adjusts
- * the shielding on the segment appropriately.
+ * Sets the segment greyness to the trace set grey.
  */
 
 static void gcSegSetGrey(Seg seg, TraceSet grey)
 {
-  GCSeg gcseg;
+  AVERT_CRITICAL(Seg, seg);            /* .seg.method.check */
+  AVERT_CRITICAL(TraceSet, grey);      /* .seg.method.check */
+  AVER_CRITICAL(seg->rankSet != RankSetEMPTY);
+
+  gcSegSetGreyInternal(seg, seg->grey, grey); /* do the work */
+}
+
+
+/* mutatorSegSetGrey -- MutatorSeg method to change greyness of segment
+ *
+ * As gcSegSetGrey, but also raise or lower the read barrier.
+ */
+
+static void mutatorSegSetGrey(Seg seg, TraceSet grey)
+{
   TraceSet oldGrey, flippedTraces;
   Arena arena;
  
   AVERT_CRITICAL(Seg, seg);            /* .seg.method.check */
-  AVERT_CRITICAL(TraceSet, grey);      /* .seg.method.check */
-  AVER(seg->rankSet != RankSetEMPTY);
-  gcseg = SegGCSeg(seg);
-  AVERT_CRITICAL(GCSeg, gcseg);
-  AVER_CRITICAL(&gcseg->segStruct == seg);
-  UNUSED(gcseg);
 
-  arena = PoolArena(SegPool(seg));
   oldGrey = seg->grey;
-  gcSegSetGreyInternal(seg, oldGrey, grey); /* do the work */
+
+  NextMethod(Seg, MutatorSeg, setGrey)(seg, grey);
 
   /* The read barrier is raised when the segment is grey for */
   /* some _flipped_ trace, i.e., is grey for a trace for which */
   /* the mutator is black. */
+  arena = PoolArena(SegPool(seg));
   flippedTraces = arena->flippedTraces;
   if (TraceSetInter(oldGrey, flippedTraces) == TraceSetEMPTY) {
     if (TraceSetInter(grey, flippedTraces) != TraceSetEMPTY)
@@ -1553,8 +1578,31 @@ static void gcSegSetGrey(Seg seg, TraceSet grey)
     if (TraceSetInter(grey, flippedTraces) == TraceSetEMPTY)
       ShieldLower(arena, seg, AccessREAD);
   }
+}
 
-  EVENT3(SegSetGrey, arena, seg, grey);
+/* mutatorSegFlip -- update barriers for a trace that's about to flip */
+
+static void mutatorSegFlip(Seg seg, Trace trace)
+{
+  TraceSet flippedTraces;
+  Arena arena;
+
+  NextMethod(Seg, MutatorSeg, flip)(seg, trace);
+
+  arena = PoolArena(SegPool(seg));
+  flippedTraces = arena->flippedTraces;
+  AVER(!TraceSetIsMember(flippedTraces, trace));
+
+  /* Raise the read barrier if the segment was not grey for any
+     currently flipped trace. */
+  if (TraceSetInter(SegGrey(seg), flippedTraces) == TraceSetEMPTY) {
+    ShieldRaise(arena, seg, AccessREAD);
+  } else {
+    /* If the segment is grey for some currently flipped trace then
+       the read barrier must already have been raised, either in this
+       method or in mutatorSegSetGrey. */
+    AVER(SegSM(seg) & AccessREAD);
+  }
 }
 
 
@@ -1588,19 +1636,13 @@ static void gcSegSetWhite(Seg seg, TraceSet white)
     AVER_CRITICAL(trseg == seg);
     TractSetWhite(tract, BS_BITFIELD(Trace, white));
   }
-  AVER(addr == limit);
+  AVER_CRITICAL(addr == limit);
 
   seg->white = BS_BITFIELD(Trace, white);
 }
 
 
 /* gcSegSetRankSet -- GCSeg method to set the rank set of a segment
- *
- * If the rank set is made non-empty then the segment's summary is
- * now a subset of the mutator's (which is assumed to be RefSetUNIV)
- * so the write barrier must be imposed on the segment.  If the
- * rank set is made empty then there are no longer any references
- * on the segment so the barrier is removed.
  *
  * The caller must set the summary to empty before setting the rank
  * set to empty.  The caller must set the rank set to non-empty before
@@ -1609,38 +1651,62 @@ static void gcSegSetWhite(Seg seg, TraceSet white)
 
 static void gcSegSetRankSet(Seg seg, RankSet rankSet)
 {
-  GCSeg gcseg;
-  RankSet oldRankSet;
-  Arena arena;
-
   AVERT_CRITICAL(Seg, seg);                /* .seg.method.check */
   AVERT_CRITICAL(RankSet, rankSet);        /* .seg.method.check */
   AVER_CRITICAL(rankSet == RankSetEMPTY
                 || RankSetIsSingle(rankSet)); /* .seg.method.check */
-  gcseg = SegGCSeg(seg);
-  AVERT_CRITICAL(GCSeg, gcseg);
-  AVER_CRITICAL(&gcseg->segStruct == seg);
 
-  arena = PoolArena(SegPool(seg));
-  oldRankSet = seg->rankSet;
   seg->rankSet = BS_BITFIELD(Rank, rankSet);
+}
+
+
+/* mutatorSegSetRankSet -- MutatorSeg method to set rank set of segment
+ *
+ * As gcSegSetRankSet, but also sets or clears the write barrier on
+ * the segment.
+ *
+ * If the rank set is made non-empty then the segment's summary is now
+ * a subset of the mutator's (which is assumed to be RefSetUNIV) so
+ * the write barrier must be imposed on the segment. If the rank set
+ * is made empty then there are no longer any references on the
+ * segment so the barrier is removed.
+ */
+
+static void mutatorSegSetRankSet(Seg seg, RankSet rankSet)
+{
+  RankSet oldRankSet;
+
+  AVERT_CRITICAL(Seg, seg);                /* .seg.method.check */
+  oldRankSet = seg->rankSet;
+
+  NextMethod(Seg, MutatorSeg, setRankSet)(seg, rankSet);
 
   if (oldRankSet == RankSetEMPTY) {
     if (rankSet != RankSetEMPTY) {
-      AVER(gcseg->summary == RefSetEMPTY);
-      ShieldRaise(arena, seg, AccessWRITE);
+      AVER_CRITICAL(SegGCSeg(seg)->summary == RefSetEMPTY);
+      ShieldRaise(PoolArena(SegPool(seg)), seg, AccessWRITE);
     }
   } else {
     if (rankSet == RankSetEMPTY) {
-      AVER(gcseg->summary == RefSetEMPTY);
-      ShieldLower(arena, seg, AccessWRITE);
+      AVER_CRITICAL(SegGCSeg(seg)->summary == RefSetEMPTY);
+      ShieldLower(PoolArena(SegPool(seg)), seg, AccessWRITE);
     }
   }
 }
 
 
-static void gcSegSyncWriteBarrier(Seg seg, Arena arena)
+/* mutatorSegSyncWriteBarrier -- raise or lower write barrier on segment
+ *
+ * We only need to raise the write barrier if the segment contains
+ * references, and its summary is strictly smaller than the summary of
+ * the unprotectable data (that is, the mutator). We don't maintain
+ * such a summary, assuming that the mutator can access all
+ * references, so its summary is RefSetUNIV.
+ */
+
+static void mutatorSegSyncWriteBarrier(Seg seg)
 {
+  Arena arena = PoolArena(SegPool(seg));
   /* Can't check seg -- this function enforces invariants tested by SegCheck. */
   if (SegSummary(seg) == RefSetUNIV)
     ShieldLower(arena, seg, AccessWRITE);
@@ -1649,40 +1715,41 @@ static void gcSegSyncWriteBarrier(Seg seg, Arena arena)
 }
 
 
-/* gcSegSetSummary -- GCSeg method to change the summary on a segment
- *
- * In fact, we only need to raise the write barrier if the
- * segment contains references, and its summary is strictly smaller
- * than the summary of the unprotectable data (i.e. the mutator).
- * We don't maintain such a summary, assuming that the mutator can
- * access all references, so its summary is RefSetUNIV.
- */
+/* gcSegSetSummary -- GCSeg method to change the summary on a segment */
 
 static void gcSegSetSummary(Seg seg, RefSet summary)
 {
   GCSeg gcseg;
-  Arena arena;
 
   AVERT_CRITICAL(Seg, seg);                 /* .seg.method.check */
   gcseg = SegGCSeg(seg);
   AVERT_CRITICAL(GCSeg, gcseg);
   AVER_CRITICAL(&gcseg->segStruct == seg);
 
-  arena = PoolArena(SegPool(seg));
   gcseg->summary = summary;
 
-  AVER(seg->rankSet != RankSetEMPTY);
-
-  gcSegSyncWriteBarrier(seg, arena);
+  AVER_CRITICAL(seg->rankSet != RankSetEMPTY);
 }
 
 
+/* mutatorSegSetSummary -- MutatorSeg method to change summary on segment
+ *
+ * As gcSegSetSummary, but also raise or lower the write barrier.
+ */
+
+static void mutatorSegSetSummary(Seg seg, RefSet summary)
+{
+  NextMethod(Seg, MutatorSeg, setSummary)(seg, summary);
+  mutatorSegSyncWriteBarrier(seg);
+}
+
+
+
 /* gcSegSetRankSummary -- GCSeg method to set both rank set and summary */
 
 static void gcSegSetRankSummary(Seg seg, RankSet rankSet, RefSet summary)
 {
   GCSeg gcseg;
-  Arena arena;
 
   AVERT_CRITICAL(Seg, seg);                    /* .seg.method.check */
   AVERT_CRITICAL(RankSet, rankSet);            /* .seg.method.check */
@@ -1693,15 +1760,17 @@ static void gcSegSetRankSummary(Seg seg, RankSet rankSet, RefSet summary)
   AVER_CRITICAL(&gcseg->segStruct == seg);
 
   /* rankSet == RankSetEMPTY implies summary == RefSetEMPTY */
-  AVER(rankSet != RankSetEMPTY || summary == RefSetEMPTY);
-
-  arena = PoolArena(SegPool(seg));
+  AVER_CRITICAL(rankSet != RankSetEMPTY || summary == RefSetEMPTY);
 
   seg->rankSet = BS_BITFIELD(Rank, rankSet);
   gcseg->summary = summary;
+}
 
+static void mutatorSegSetRankSummary(Seg seg, RankSet rankSet, RefSet summary)
+{
+  NextMethod(Seg, MutatorSeg, setRankSummary)(seg, rankSet, summary);
   if (rankSet != RankSetEMPTY)
-    gcSegSyncWriteBarrier(seg, arena);
+    mutatorSegSyncWriteBarrier(seg);
 }
 
 
@@ -1997,8 +2066,8 @@ Bool SegClassCheck(SegClass klass)
   CHECKL(FUNCHECK(klass->walk));
 
   /* Check that segment classes override sets of related methods. */
-  CHECKL((klass->init == SegAbsInit)
-         == (klass->instClassStruct.finish == SegAbsFinish));
+  CHECKL((klass->init == segAbsInit)
+         == (klass->instClassStruct.finish == segAbsFinish));
   CHECKL((klass->init == gcSegInit)
          == (klass->instClassStruct.finish == gcSegFinish));
   CHECKL((klass->merge == segTrivMerge) == (klass->split == segTrivSplit));
@@ -2021,15 +2090,16 @@ DEFINE_CLASS(Inst, SegClass, klass)
 DEFINE_CLASS(Seg, Seg, klass)
 {
   INHERIT_CLASS(&klass->instClassStruct, Seg, Inst);
-  klass->instClassStruct.describe = SegAbsDescribe;
-  klass->instClassStruct.finish = SegAbsFinish;
+  klass->instClassStruct.describe = segAbsDescribe;
+  klass->instClassStruct.finish = segAbsFinish;
   klass->size = sizeof(SegStruct);
-  klass->init = SegAbsInit;
+  klass->init = segAbsInit;
   klass->setSummary = segNoSetSummary; 
   klass->buffer = segNoBuffer; 
   klass->setBuffer = segNoSetBuffer;
   klass->unsetBuffer = segNoUnsetBuffer;
   klass->setGrey = segNoSetGrey;
+  klass->flip = segTrivFlip;
   klass->setWhite = segNoSetWhite;
   klass->setRankSet = segNoSetRankSet;
   klass->setRankSummary = segNoSetRankSummary;
@@ -2083,6 +2153,22 @@ DEFINE_CLASS(Seg, GCSeg, klass)
 }
 
 
+/* MutatorSegClass -- collectable mutator segment class definition */
+
+typedef SegClassStruct MutatorSegClassStruct;
+
+DEFINE_CLASS(Seg, MutatorSeg, klass)
+{
+  INHERIT_CLASS(klass, MutatorSeg, GCSeg);
+  klass->setSummary = mutatorSegSetSummary; 
+  klass->setGrey = mutatorSegSetGrey;
+  klass->flip = mutatorSegFlip;
+  klass->setRankSet = mutatorSegSetRankSet;
+  klass->setRankSummary = mutatorSegSetRankSummary;
+  AVERT(SegClass, klass);
+}
+
+
 /* SegClassMixInNoSplitMerge -- Mix-in for unsupported merge
  *
  * Classes which don't support segment splitting and merging
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 44046041efb..35762ef2668 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -590,15 +590,11 @@ static Res traceFlip(Trace trace)
   /* drj 2003-02-19) */
 
   /* Now that the mutator is black we must prevent it from reading */
-  /* grey objects so that it can't obtain white pointers.  This is */
-  /* achieved by read protecting all segments containing objects */
-  /* which are grey for any of the flipped traces. */
+  /* grey objects so that it can't obtain white pointers. */
   for(rank = RankMIN; rank < RankLIMIT; ++rank)
     RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) {
       Seg seg = SegOfGreyRing(node);
-      if(TraceSetInter(SegGrey(seg), arena->flippedTraces) == TraceSetEMPTY
-          && TraceSetIsMember(SegGrey(seg), trace))
-        ShieldRaise(arena, seg, AccessREAD);
+      SegFlip(seg, trace);
     }
 
   /* @@@@ When write barrier collection is implemented, this is where */
diff --git a/mps/design/finalize.txt b/mps/design/finalize.txt
index f75cb3ccd24..65f82562494 100644
--- a/mps/design/finalize.txt
+++ b/mps/design/finalize.txt
@@ -74,30 +74,11 @@ then ``ArenaDestroy()`` destroys the final pool.
 _`.impl.access`: ``mps_message_finalization_ref()`` needs to access
 the finalization message to retrieve the reference and then write it
 to where the client asks. This must be done carefully, in order to
-avoid hitting the write barrier or invalidating collection invariants
-such as the segment summary.
+avoid invalidating collection invariants such as the segment summary.
 
-_`.impl.invariants`: We protect the invariants by using special
-routines ``ArenaRead()`` and ``ArenaPoke()`` to read and write the
-reference. This works as long as there's no write-barrier collection.
-
-.. note::
-
-    Instead of ``ArenaPoke()``, we could put in an ``ArenaWrite()``
-    that would be identical to ``ArenaPoke()``, except that it would
-    ``AVER()`` the invariant (or it can just ``AVER()`` that there are
-    no busy traces unflipped). When we get write-barrier collection,
-    we could change it to do the real thing, but in the absence of a
-    write-barrier, it's functionally identical to ``ArenaPoke()``.
-    Pekka P. Pirinen, 1997-12-09.
-
-.. note::
-
-    There is no need to maintain a write barrier on segments belonging
-    to the MRG pool, as these segments are never given to the mutator.
-    See job004030_.
-
-    .. _job004030: https://www.ravenbrook.com/project/mps/issue/job004030/
+_`.impl.invariants`: We protect the invariants by using
+``ArenaRead()`` and ``ArenaWrite()`` to read and write the reference
+via the software barrier.
 
 
 External interface
diff --git a/mps/design/poolamc.txt b/mps/design/poolamc.txt
index a45463da7e3..d2be512aafb 100644
--- a/mps/design/poolamc.txt
+++ b/mps/design/poolamc.txt
@@ -350,7 +350,10 @@ Segments
 --------
 
 _`.seg.class`: AMC allocates segments of class ``AMCSegClass``, which
-is a subclass of ``GCSegClass``.
+is a subclass of ``MutatorSegClass`` (see
+design.mps.seg.over.hierarchy.mutatorseg_).
+
+.. _design.mps.seg.over.hierarchy.mutatorseg: seg#over-hierarchy-mutatorseg
 
 _`.seg.gen`: AMC organizes the segments it manages into generations.
 
diff --git a/mps/design/poolawl.txt b/mps/design/poolawl.txt
index c17985d9d51..404d0e3128c 100644
--- a/mps/design/poolawl.txt
+++ b/mps/design/poolawl.txt
@@ -112,9 +112,9 @@ _`.poolstruct`: The class specific pool structure is::
     }
 
 _`.awlseg`: The pool defines a segment class ``AWLSegClass``, which is
-a subclass of ``GCSegClass`` (see
-design.mps.seg.over.hierarchy.gcseg_). All segments allocated by the
-pool are instances of this class, and are of type ``AWLSeg``, for
+a subclass of ``MutatorSegClass`` (see
+design.mps.seg.over.hierarchy.mutatorseg_). All segments allocated by
+the pool are instances of this class, and are of type ``AWLSeg``, for
 which the structure is::
 
     struct AWLSegStruct {
@@ -132,7 +132,7 @@ which the structure is::
       Sig sig;                  /* <code/misc.h#sig> */
     }
 
-.. _design.mps.seg.over.hierarchy.gcseg: seg#over-hierarchy-gcseg
+.. _design.mps.seg.over.hierarchy.mutatorseg: seg#over-hierarchy-mutatorseg
 
 _`.awlseg.bt`: The ``mark``, ``alloc``, and ``scanned`` fields are
 bit-tables (see design.mps.bt_). Each bit in the table corresponds to
diff --git a/mps/design/poollo.txt b/mps/design/poollo.txt
index 88fb14f5271..05c91ee14fd 100644
--- a/mps/design/poollo.txt
+++ b/mps/design/poollo.txt
@@ -121,8 +121,12 @@ _`.poolstruct`: The class specific pool structure is::
       Sig sig;                      /* <code/misc.h#sig> */
     } LOStruct;
 
-_`.loseg`: Every segment is an instance of segment class ``LOSegClass``, a
-subclass of ``GCSegClass``, and is an object of type ``LOSegStruct``.
+_`.loseg`: Every segment is an instance of segment class
+``LOSegClass``, a subclass of ``MutatorSegClass`` (see
+design.mps.seg.over.hierarchy.mutatorseg_), and is an object of type
+``LOSegStruct``.
+
+.. _design.mps.seg.over.hierarchy.mutatorseg: seg#over-hierarchy-mutatorseg
 
 _`.loseg.purpose`: The purpose of the ``LOSeg`` structure is to
 associate the bit tables used for recording allocation and mark
diff --git a/mps/design/poolmrg.txt b/mps/design/poolmrg.txt
index 09d71c81205..69280a30301 100644
--- a/mps/design/poolmrg.txt
+++ b/mps/design/poolmrg.txt
@@ -336,7 +336,7 @@ the latter will be used to store the link parts of guardians (see
 one of each class, by the function ``MRGSegPairCreate()``. Each
 segment contains a link to its pair.
 
-_`.mrgseg.ref`: ``MRGRefSegClass`` is a subclass of ``GCSegClass``.
+_`.mrgseg.ref`: ``MRGRefSegClass`` is a subclass of ``MutatorSegClass``.
 Instances are of type ``MRGRefSeg``, and contain:
 
 - _`.mrgseg.ref.mrgring`: a field for the ring of ref part segments in
diff --git a/mps/design/seg.txt b/mps/design/seg.txt
index 4a8bfd76b98..7609e0dbb01 100644
--- a/mps/design/seg.txt
+++ b/mps/design/seg.txt
@@ -51,9 +51,15 @@ subclass with additional properties.
 
 .. _design.mps.protocol: protocol
 
-_`.over.hierarchy.gcseg`: The segment module provides ``GCSeg`` - a
-subclass of ``Seg`` which has full support for GC including buffering
-and the ability to be linked onto the grey ring.
+_`.over.hierarchy.gcseg`: ``GCSeg`` is a subclass of ``Seg`` which
+implements garbage collection, including buffering and the ability to
+be linked onto the grey ring. It does not implement hardware barriers,
+and so can only be used with software barriers, for example internally
+in the MPS.
+
+_`.over.hierarchy.mutatorseg`: ``MutatorSeg`` is a subclass of
+``GCSeg`` implementing hardware barriers. It is suitable for handing
+out to the mutator.
 
 
 Data Structure
@@ -345,6 +351,12 @@ in the walk. Segment classes need not provide this method. This
 method is called by the genetic function ``SegWalk()``, which is
 called by the heap walker ``mps_arena_formatted_objects_walk()``.
 
+``typedef void (*SegFlipMethod)(Seg seg, Trace trace)``
+
+_`.method.flip`: Raise the read barrier, if necessary, for a trace
+that's about to flip and for which the segment is grey and potentially
+contains references.
+
 
 Splitting and merging
 .....................