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 .
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 */
@@ -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 MPS_FIX1 */
@@ -430,7 +436,17 @@ extern double TraceWorkFactor;
/* Equivalent to 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 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 .) */
-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 .) */
-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) {
/* */
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 */
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 */
- 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,