Fixing bugs introduced by type puns passed through scanning methods, discovered by offsetting mps_ss_s from the beginning of scanstatestruct.

Adding a pseudo-target "find-puns" which, on FreeBSD mostly, prints useful warnings about strict aliasing rule violations.
Fixing more strict aliasing rule violations found by the above.

Copied from Perforce
 Change: 179358
 ServerID: perforce.ravenbrook.com

9 files changed, 60 insertions, 41 deletions

diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index 3b775882bc3..6ab9dec268c 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -498,6 +498,18 @@ $(PFM)/$(VARIETY)/%:
         $(CC) $(CFLAGS) $(LINKFLAGS) -o $@ $^ $(LIBS)
 
 
+# Special targets for development
+
+# Currently FreeBSD 7 GCC 4.2.1 is the best platform we have for warning
+# us about strict aliasing rule violations caused by type puns.  This
+# target reveals them, and produces an assembler output file that can be
+# examined to see if they're actually dangerous.  RB 2012-09-07
+
+find-puns: phony
+        { echo '#include "mps.c"'; echo '#include "fmtdy.c"'; } | \
+        gcc -S -fverbose-asm -ansi -pedantic -Wall -Wstrict-aliasing=2 -O3 -x c -o pun.s -
+
+
 # C. COPYRIGHT AND LICENSE
 #
 # Copyright (C) 2001-2002 Ravenbrook Limited <http://www.ravenbrook.com/>.
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index bdf4ba79d74..d43e92d10a2 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -154,9 +154,13 @@ extern Res WriteF_v(mps_lib_FILE *stream, va_list args);
 extern Res WriteF_firstformat_v(mps_lib_FILE *stream,
                                 const char *firstformat, va_list args);
 
+#if defined(DIAG_WITH_STREAM_AND_WRITEF)
 extern int Stream_fputc(int c, mps_lib_FILE *stream);
 extern int Stream_fputs(const char *s, mps_lib_FILE *stream);
-
+#else
+#define Stream_fputc mps_lib_fputc
+#define Stream_fputs mps_lib_fputs
+#endif
 
 
 /* Miscellaneous support -- see <code/mpm.c> */
@@ -419,6 +423,8 @@ extern double TraceWorkFactor;
       ZoneSet SCANwhite = ScanStateWhite(ss); \
       RefSet SCANsummary = ScanStateUnfixedSummary(ss); \
       Word SCANt; \
+      mps_addr_t SCANref; \
+      Res SCANres; \
       {
 
 /* Equivalent to <code/mps.h> MPS_FIX1 */
@@ -430,7 +436,17 @@ extern double TraceWorkFactor;
 
 /* Equivalent to <code/mps.h> MPS_FIX2 */
 
-#define TRACE_FIX2(ss, refIO) _mps_fix2((mps_ss_t)(ss), (mps_addr_t *)(refIO))
+/* TODO: The ref is copied to avoid breaking strict aliasing rules that could
+   well affect optimised scan loops.  This code could be improved by
+   returning the fixed ref as a result and using longjmp to signal errors,
+   and that might well improve all scan loops too.  The problem is whether
+   some embedded client platforms support longjmp.  RB 2012-09-07 */
+
+#define TRACE_FIX2(ss, refIO) \
+  (SCANref = (mps_addr_t)*(refIO), \
+   SCANres = _mps_fix2(&(ss)->ss_s, &SCANref), \
+   *(refIO) = SCANref, \
+   SCANres)
 
 /* Equivalent to <code/mps.h> MPS_FIX */
 
diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h
index a15098c53ee..b1853178cbb 100644
--- a/mps/code/mpmtypes.h
+++ b/mps/code/mpmtypes.h
@@ -246,7 +246,7 @@ typedef struct TraceMessageStruct *TraceMessage;  /* trace end */
 /* .fmt-methods: These methods must match those defined in the */
 /* MPS C Interface.  (See <code/mps.h#fmt-methods>.) */
 
-typedef Res  (*FormatScanMethod)(ScanState ss, Addr base, Addr limit);
+typedef Res  (*FormatScanMethod)(mps_ss_t ss, Addr base, Addr limit);
 typedef Addr (*FormatSkipMethod)(Addr object);
 typedef void (*FormatMoveMethod)(Addr object, Addr to);
 typedef Addr (*FormatIsMovedMethod)(Addr object);
@@ -259,8 +259,8 @@ typedef Addr (*FormatClassMethod)(Addr object);
 /* .root-methods: These methods must match those defined in the */
 /* MPS C Interface.  (See <code/mps.h#root-methods>.) */
 
-typedef Res (*RootScanMethod)(ScanState ss, void *p, size_t s);
-typedef Res (*RootScanRegMethod)(ScanState ss, Thread thread, void *p, size_t s);
+typedef Res (*RootScanMethod)(mps_ss_t ss, void *p, size_t s);
+typedef Res (*RootScanRegMethod)(mps_ss_t ss, Thread thread, void *p, size_t s);
 
 
 /* CONSTANTS */
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index c4500a811dd..fc71144ab84 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -1453,7 +1453,7 @@ static Res amcScanNailedOnce(Bool *totalReturn, Bool *moreReturn,
       Addr q;
       q = (*format->skip)(p);
       if(amcNailGetMark(seg, p)) {
-        res = (*format->scan)(ss, p, q);
+        res = (*format->scan)(&ss->ss_s, p, q);
         if(res != ResOK) {
           *totalReturn = FALSE;
           *moreReturn = TRUE;
@@ -1476,7 +1476,7 @@ static Res amcScanNailedOnce(Bool *totalReturn, Bool *moreReturn,
     Addr q;
     q = (*format->skip)(p);
     if(amcNailGetMark(seg, p)) {
-      res = (*format->scan)(ss, p, q);
+      res = (*format->scan)(&ss->ss_s, p, q);
       if(res != ResOK) {
         *totalReturn = FALSE;
         *moreReturn = TRUE;
@@ -1601,7 +1601,7 @@ static Res AMCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
       *totalReturn = TRUE;
       return ResOK;
     }
-    res = (*format->scan)(ss, base, limit);
+    res = (*format->scan)(&ss->ss_s, base, limit);
     if(res != ResOK) {
       *totalReturn = FALSE;
       return res;
@@ -1615,7 +1615,7 @@ static Res AMCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
   AVER(SegBase(seg) <= base);
   AVER(base <= AddrAdd(SegLimit(seg), format->headerSize));
   if(base < limit) {
-    res = (*format->scan)(ss, base, limit);
+    res = (*format->scan)(&ss->ss_s, base, limit);
     if(res != ResOK) {
       *totalReturn = FALSE;
       return res;
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index 880e20f7bb0..34e07fceccc 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -1237,7 +1237,7 @@ static Res amsScanObject(Seg seg, Index i, Addr p, Addr next, void *clos)
 
   /* @@@@ This isn't quite right for multiple traces. */
   if (closure->scanAllObjects || AMS_IS_GREY(seg, i)) {
-    res = (*format->scan)(closure->ss,
+    res = (*format->scan)(&closure->ss->ss_s,
                           AddrAdd(p, format->headerSize),
                           AddrAdd(next, format->headerSize));
     if (res != ResOK)
@@ -1331,7 +1331,7 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
             next = AddrAdd(p, alignment);
           }
           j = AMS_ADDR_INDEX(seg, next);
-          res = (*format->scan)(ss, clientP, clientNext);
+          res = (*format->scan)(&ss->ss_s, clientP, clientNext);
           if (res != ResOK) {
             /* <design/poolams/#marked.scan.fail> */
             amsseg->marksChanged = TRUE;
diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c
index e1fcbd94b4e..da63a4374d3 100644
--- a/mps/code/poolawl.c
+++ b/mps/code/poolawl.c
@@ -820,7 +820,7 @@ static Res awlScanObject(Arena arena, AWL awl, ScanState ss,
       SegSetSummary(dependentSeg, RefSetUNIV);
   }
 
-  res = (*format->scan)(ss, base, limit);
+  res = (*format->scan)(&ss->ss_s, base, limit);
   if (res == ResOK)
     ss->scannedSize += AddrOffset(base, limit);
 
diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c
index 657c0f54843..4dcb7115902 100644
--- a/mps/code/poolsnc.c
+++ b/mps/code/poolsnc.c
@@ -516,7 +516,7 @@ static Res SNCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
   }
  
   if (base < limit) {
-    res = (*format->scan)(ss, base, limit);
+    res = (*format->scan)(&ss->ss_s, base, limit);
     if (res != ResOK) {
       *totalReturn = FALSE;
       return res;
diff --git a/mps/code/root.c b/mps/code/root.c
index 9484c4bfa36..9ce385a124c 100644
--- a/mps/code/root.c
+++ b/mps/code/root.c
@@ -478,20 +478,20 @@ Res RootScan(ScanState ss, Root root)
     break;
 
     case RootFUN:
-    res = (*root->the.fun.scan)(ss, root->the.fun.p, root->the.fun.s);
+    res = (*root->the.fun.scan)(&ss->ss_s, root->the.fun.p, root->the.fun.s);
     if (res != ResOK)
       goto failScan;
     break;
 
     case RootREG:
-    res = (*root->the.reg.scan)(ss, root->the.reg.thread,
+    res = (*root->the.reg.scan)(&ss->ss_s, root->the.reg.thread,
                                 root->the.reg.p, root->the.reg.s);
     if (res != ResOK)
       goto failScan;
     break;
 
     case RootFMT:
-    res = (*root->the.fmt.scan)(ss, root->the.fmt.base, root->the.fmt.limit);
+    res = (*root->the.fmt.scan)(&ss->ss_s, root->the.fmt.base, root->the.fmt.limit);
     ss->scannedSize += AddrOffset(root->the.fmt.base, root->the.fmt.limit);
     if (res != ResOK)
       goto failScan;
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 09fb803b2cc..ffe800e151e 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1295,26 +1295,31 @@ void TraceSegAccess(Arena arena, Seg seg, AccessSet mode)
 }
 
 
-/* TraceFix2 -- second stage of fixing a reference
+/* _mps_fix2 (a.k.a. "TraceFix") -- second stage of fixing a reference
  *
- * TraceFix is on the [critical path](../design/critical-path.txt).  A
+ * _mps_fix2 is on the [critical path](../design/critical-path.txt).  A
  * one-instruction difference in the early parts of this code will have a
  * significant impact on overall run time.  The priority is to eliminate
  * irrelevant references early and fast using the colour information stored
  * in the tract table.
+ *
+ * The name "TraceFix" is pervasive in the MPS and its documents to describe
+ * this function.  Optimisation and strict aliasing rules have meant that we
+ * need to use the external name for it here.
  */
 
-static Res TraceFix2(ScanState ss, Ref *refIO)
+mps_res_t _mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io)
 {
+  ScanState ss = PARENT(ScanStateStruct, ss_s, mps_ss);
   Ref ref;
   Tract tract;
 
   /* Special AVER macros are used on the critical path. */
   /* See <design/trace/#fix.noaver> */
   AVERT_CRITICAL(ScanState, ss);
-  AVER_CRITICAL(refIO != NULL);
+  AVER_CRITICAL(mps_ref_io != NULL);
 
-  ref = *refIO;
+  ref = (Ref)*mps_ref_io;
 
   /* The zone test should already have been passed by MPS_FIX1 in mps.h. */
   AVER_CRITICAL(ZoneSetInter(ScanStateWhite(ss),
@@ -1322,7 +1327,7 @@ static Res TraceFix2(ScanState ss, Ref *refIO)
                 ZoneSetEMPTY);
 
   STATISTIC(++ss->fixRefCount);
-  EVENT4(TraceFix, ss, refIO, ref, ss->rank);
+  EVENT4(TraceFix, ss, mps_ref_io, ref, ss->rank);
 
   TRACT_OF_ADDR(&tract, ss->arena, ref);
   if(tract) {
@@ -1336,7 +1341,7 @@ static Res TraceFix2(ScanState ss, Ref *refIO)
         EVENT1(TraceFixSeg, seg);
         EVENT0(TraceFixWhite);
         pool = TractPool(tract);
-        res = (*ss->fix)(pool, ss, seg, refIO);
+        res = (*ss->fix)(pool, ss, seg, &ref);
         if(res != ResOK) {
           /* PoolFixEmergency should never fail. */
           AVER_CRITICAL(ss->fix != PoolFixEmergency);
@@ -1347,7 +1352,7 @@ static Res TraceFix2(ScanState ss, Ref *refIO)
            * C: the code (here) already assumes this: it returns without 
            *    updating ss->fixedSummary.  RHSK 2007-03-21.
            */
-          AVER(*refIO == ref);
+          AVER(ref == (Ref)*mps_ref_io);
           return res;
         }
       } else {
@@ -1378,27 +1383,13 @@ static Res TraceFix2(ScanState ss, Ref *refIO)
   }
 
   /* See <design/trace/#fix.fixed.all> */
-  ss->fixedSummary = RefSetAdd(ss->arena, ss->fixedSummary, *refIO);
-
+  ss->fixedSummary = RefSetAdd(ss->arena, ss->fixedSummary, ref);
+  
+  *mps_ref_io = (mps_addr_t)ref;
   return ResOK;
 }
 
 
-/* mps_fix2 -- external interface to TraceFix
- *
- * We rely on compiler inlining to make this equivalent to TraceFix, because
- * the name "TraceFix" is pervasive in the MPS.  That's also why this
- * function is in trace.c and not mpsi.c.
- */
-
-mps_res_t _mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io)
-{
-  ScanState ss = PARENT(ScanStateStruct, ss_s, mps_ss);
-  Ref *refIO = (Ref *)mps_ref_io;
-  return TraceFix2(ss, refIO);
-}
-
-
 /* traceScanSingleRefRes -- scan a single reference, with result code */
 
 static Res traceScanSingleRefRes(TraceSet ts, Rank rank, Arena arena,