9 files changed, 53 insertions, 11 deletions

diff --git a/mps/code/mpm.c b/mps/code/mpm.c
index 4f9af3f888c..71b93d8a41d 100644
--- a/mps/code/mpm.c
+++ b/mps/code/mpm.c
@@ -174,7 +174,14 @@ Word (WordAlignDown)(Word word, Align alignment)
 
 Bool SizeIsP2(Size size)
 {
-  return size > 0 && (size & (size - 1)) == 0;
+  return WordIsP2((Word)size);
+}
+
+/* WordIsP2 -- tests whether a word is a power of two */
+
+Bool WordIsP2(Word word)
+{
+  return word > 0 && (word & (word - 1)) == 0;  
 }
 
 
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index b5a58eeef59..263cb795e5d 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -145,6 +145,7 @@ extern Bool SizeIsP2(Size size);
 extern Shift SizeLog2(Size size);
 extern Shift SizeFloorLog2(Size size);
 
+extern Bool WordIsP2(Word word);
 
 /* Formatted Output -- see <design/writef/>, <code/mpm.c> */
 
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 488a6d1b54b..0903e783ba0 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -499,6 +499,7 @@ typedef struct TraceStruct {
   TraceId ti;                   /* index into TraceSets */
   Arena arena;                  /* owning arena */
   int why;                      /* why the trace began */
+  Align whiteMinAlign;          /* minimum alignment of references in white set */
   ZoneSet white;                /* zones in the white set */
   ZoneSet mayMove;              /* zones containing possibly moving objs */
   TraceState state;             /* current state of trace */
diff --git a/mps/code/pool.c b/mps/code/pool.c
index e2578cf3497..55e70ff1462 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -305,6 +305,8 @@ Res PoolAlloc(Addr *pReturn, Pool pool, Size size,
   /* .hasaddr.critical: The PoolHasAddr check is expensive, and in */
   /* allocation-bound programs this is on the critical path. */
   AVER_CRITICAL(PoolHasAddr(pool, *pReturn));
+  /* All allocations should be aligned to the pool's alignment */
+  AVER_CRITICAL(AddrIsAligned(*pReturn, pool->alignment));
 
   /* All PoolAllocs should advance the allocation clock, so we count */
   /* it all in the fillMutatorSize field. */
diff --git a/mps/code/ssixi3.c b/mps/code/ssixi3.c
index 0d1c31c7501..04601803438 100644
--- a/mps/code/ssixi3.c
+++ b/mps/code/ssixi3.c
@@ -66,7 +66,7 @@ Res StackScan(ScanState ss, Addr *stackBot)
   ASMV("mov %%esp, %0" : "=r" (stackTop) :);    /* stackTop = esp */
 
   AVER(AddrIsAligned((Addr)stackTop, sizeof(Addr)));  /* .assume.align */
-  res = TraceScanArea(ss, stackTop, stackBot);
+  res = TraceScanAreaTagged(ss, stackTop, stackBot);
 
   return res;
 }
diff --git a/mps/code/ssixi6.c b/mps/code/ssixi6.c
index 6b425bed804..6eeac9ae45b 100644
--- a/mps/code/ssixi6.c
+++ b/mps/code/ssixi6.c
@@ -62,7 +62,7 @@ Res StackScan(ScanState ss, Addr *stackBot)
   ASMV("mov %%rsp, %0" : "=r" (stackTop) :);    /* stackTop = rsp */
 
   AVER(AddrIsAligned((Addr)stackTop, sizeof(Addr)));  /* .assume.align */
-  res = TraceScanArea(ss, stackTop, stackBot);
+  res = TraceScanAreaTagged(ss, stackTop, stackBot);
 
   return res;
 }
diff --git a/mps/code/ssw3i3.c b/mps/code/ssw3i3.c
index f9b2646b3b6..40f412b12ae 100644
--- a/mps/code/ssw3i3.c
+++ b/mps/code/ssw3i3.c
@@ -35,7 +35,7 @@ Res StackScan(ScanState ss, Addr *stackBot)
   }
 
   AVER(AddrIsAligned((Addr)stackTop, sizeof(Addr)));  /* .align */
-  res = TraceScanArea(ss, stackTop, stackBot);
+  res = TraceScanAreaTagged(ss, stackTop, stackBot);
 
   __asm {
     add esp, 0xc       /* pop 3 registers to restore the stack pointer */
diff --git a/mps/code/ssw3i6.asm b/mps/code/ssw3i6.asm
index 4589147758f..c856ef47c33 100644
--- a/mps/code/ssw3i6.asm
+++ b/mps/code/ssw3i6.asm
@@ -9,7 +9,7 @@
 ; <http://msdn.microsoft.com/en-us/library/9z1stfyw>
 
 .CODE
-EXTERN TraceScanArea : PROC
+EXTERN TraceScanAreaTagged : PROC
 
 StackScan PROC FRAME
    ; Prolog follows.  See 
@@ -56,7 +56,7 @@ StackScan PROC FRAME
    mov rdx, rsp    ; top of stack
    add rdx, 40     ; where last callee-save register stored
    ; mov rcx, rcx  ; ss already in the right register.
-   call TraceScanArea
+   call TraceScanAreaTagged
    add rsp, 40
    pop r15         ; pop the callee-save registers
    pop r14
diff --git a/mps/code/trace.c b/mps/code/trace.c
index a12800d4dd9..0f8d84ba3ac 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -138,6 +138,7 @@ Bool TraceCheck(Trace trace)
   CHECKL(TraceIdCheck(trace->ti));
   CHECKL(trace == &trace->arena->trace[trace->ti]);
   CHECKL(TraceSetIsMember(trace->arena->busyTraces, trace));
+  CHECKL(AlignCheck(trace->whiteMinAlign));
   CHECKL(ZoneSetSub(trace->mayMove, trace->white));
   /* Use trace->state to check more invariants. */
   switch(trace->state) {
@@ -367,6 +368,10 @@ Res TraceAddWhite(Trace trace, Seg seg)
       trace->mayMove = ZoneSetUnion(trace->mayMove,
                                     ZoneSetOfSeg(trace->arena, seg));
     }
+    /* This is used to eliminate unaligned references in TraceScanAreaTagged */
+    if(pool->alignment < trace->whiteMinAlign) {
+      trace->whiteMinAlign = pool->alignment;
+    }
   }
 
   return ResOK;
@@ -656,6 +661,7 @@ found:
 
   trace->arena = arena;
   trace->why = why;
+  trace->whiteMinAlign = (Align)1 << (MPS_WORD_WIDTH - 1);
   trace->white = ZoneSetEMPTY;
   trace->mayMove = ZoneSetEMPTY;
   trace->ti = ti;
@@ -1402,13 +1408,37 @@ Res TraceScanArea(ScanState ss, Addr *base, Addr *limit)
 
 /* TraceScanAreaTagged -- scan contiguous area of tagged references
  *
- * This is as TraceScanArea except words are only fixed if they are
- * tagged as Dylan references (i.e., bottom two bits are zero).  @@@@
- * This Dylan-specificness should be generalized in some way.  */
-
+ * This is as TraceScanArea except words are only fixed they are tagged
+ * as zero according to the minimum alignment of the condemned set.
+ */
 Res TraceScanAreaTagged(ScanState ss, Addr *base, Addr *limit)
 {
-  return TraceScanAreaMasked(ss, base, limit, (Word)3);
+  TraceSet ts;
+  TraceId ti;
+  Trace trace;
+  Arena arena;
+  Word mask;
+  
+  AVERT(ScanState, ss);
+
+  /* This calculation of the mask could be moved to ScanStateInit
+   * but there is little point as we probably only do a couple of ambiguous
+   * scan per thread per flip. */
+  /* NOTE: An optimisation that maybe worth considering is setting some of the
+   * top bits in the mask as an early catch of addresses outside the arena.
+   * This might help slightly on 64-bit windows. However these are picked up
+   * soon afterwards by later checks.  The bottom bits are more important
+   * to check as we ignore them in AMCFix, so the non-reference could
+   * otherwise end up pinning an object. */
+  mask = (Word)-1;
+  ts = ss->traces;
+  arena = ss->arena;
+  TRACE_SET_ITER(ti, trace, ts, arena)
+    AVER(WordIsP2(trace->whiteMinAlign));
+    mask = mask & (trace->whiteMinAlign - 1);
+  TRACE_SET_ITER_END(ti, trace, ts, arena);
+
+  return TraceScanAreaMasked(ss, base, limit, mask);
 }
 
 
@@ -1423,6 +1453,7 @@ Res TraceScanAreaMasked(ScanState ss, Addr *base, Addr *limit, Word mask)
   Addr *p;
   Ref ref;
 
+  AVERT(ScanState, ss);
   AVER(base != NULL);
   AVER(limit != NULL);
   AVER(base < limit);