diff --git a/mps/code/diag.c b/mps/code/diag.c
index 639401b4169..6c369cce110 100644
--- a/mps/code/diag.c
+++ b/mps/code/diag.c
@@ -28,6 +28,92 @@ mps_lib_FILE *DiagStream(void)
return mps_lib_stdout;
}
+const char *DiagTagGlobal = NULL;
+
+static void DiagTagBegin(const char *tag)
+{
+ Res res;
+
+ AVER(DiagTagGlobal == NULL);
+ DiagTagGlobal = tag;
+ res = WriteF(DiagStream(), "MPS.$S { ", tag, NULL);
+ AVER(res == ResOK);
+}
+
+static void DiagTagEnd(const char *tag)
+{
+ Res res;
+
+ AVER(DiagTagGlobal != NULL);
+ /* AVER(strequal(DiagTagGlobal, tag)); */
+ res = WriteF(DiagStream(), "} MPS.$S\n", tag, NULL);
+ DiagTagGlobal = NULL;
+ AVER(DiagTagGlobal == NULL);
+}
+
+void DiagSingleF(const char *tag, ...)
+{
+ va_list args;
+ Res res;
+
+ DiagTagBegin(tag);
+
+ va_start(args, tag);
+ res = WriteF_v(DiagStream(), args);
+ AVER(res == ResOK);
+ va_end(args);
+
+ DiagTagEnd(tag);
+}
+
+void DiagFirstF(const char *tag, ...)
+{
+ va_list args;
+ Res res;
+
+ DiagTagBegin(tag);
+
+ va_start(args, tag);
+ res = WriteF_v(DiagStream(), args);
+ AVER(res == ResOK);
+ va_end(args);
+}
+
+void DiagMoreF(const char *firstformat, ...)
+{
+ va_list args;
+ Res res;
+
+ /* ISO C says there must be at least one named parameter: hence */
+ /* the named firstformat. It only looks different: there is no */
+ /* change from the expected WriteF protocol. (In particular, */
+ /* firstformat may legally be NULL, with the variable part empty). */
+
+ va_start(args, firstformat);
+ res = WriteF_firstformat_v(DiagStream(), firstformat, args);
+ AVER(res == ResOK);
+ va_end(args);
+}
+
+void DiagEnd(const char *tag)
+{
+ DiagTagEnd(tag);
+}
+
+extern void diag_test(void);
+
+void diag_test(void)
+{
+ DIAG_SINGLEF(( "TestTag1", "text $U.\n", 42, NULL ));
+
+ DIAG_FIRSTF(( "TestTag2", "text $U.\n", 42, NULL ));
+ DIAG_MOREF(( NULL ));
+ DIAG_MOREF(( "string $S.\n", "fooey!", NULL ));
+ DIAG_MOREF(( NULL ));
+ DIAG_MOREF(( "Another string $S.\n", "baloney!", NULL ));
+ DIAG_END( "TestTag2" );
+}
+
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2007 Ravenbrook Limited .
diff --git a/mps/code/mpm.c b/mps/code/mpm.c
index 4282a06b937..04bb8418f61 100644
--- a/mps/code/mpm.c
+++ b/mps/code/mpm.c
@@ -409,7 +409,16 @@ static Res WriteDouble(mps_lib_FILE *stream, double d)
/* WriteF -- write formatted output
*
- * Calls WriteF_v.
+ * .writef.des: See , also
+ *
+ * .writef.p: There is an assumption that void * fits in Word in
+ * the case of $P, and unsigned long for $U and $B. This is checked in
+ * MPMCheck.
+ *
+ * .writef.div: Although MPS_WORD_WIDTH/4 appears three times, there
+ * are effectively three separate decisions to format at this width.
+ *
+ * .writef.check: See .check.writef.
*/
Res WriteF(mps_lib_FILE *stream, ...)
@@ -423,21 +432,20 @@ Res WriteF(mps_lib_FILE *stream, ...)
return res;
}
-
-/* WriteF_v -- write formatted output
- *
- * .writef.des: See , also
- *
- * .writef.p: There is an assumption that void * fits in Word in
- * the case of $P, and unsigned long for $U and $B. This is checked in
- * MPMCheck.
- *
- * .writef.div: Although MPS_WORD_WIDTH/4 appears three times, there
- * are effectively three separate decisions to format at this width.
- *
- * .writef.check: See .check.writef. */
-
Res WriteF_v(mps_lib_FILE *stream, va_list args)
+{
+ const char *firstformat;
+ int r;
+ size_t i;
+ Res res;
+
+ firstformat = va_arg(args, const char *);
+ res = WriteF_firstformat_v(stream, firstformat, args);
+ return res;
+}
+
+Res WriteF_firstformat_v(mps_lib_FILE *stream,
+ const char *firstformat, va_list args)
{
const char *format;
int r;
@@ -445,9 +453,10 @@ Res WriteF_v(mps_lib_FILE *stream, va_list args)
Res res;
AVER(stream != NULL);
+
+ format = firstformat;
for(;;) {
- format = va_arg(args, const char *);
if (format == NULL)
break;
@@ -534,6 +543,8 @@ Res WriteF_v(mps_lib_FILE *stream, va_list args)
++format;
}
+
+ format = va_arg(args, const char *);
}
return ResOK;
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 8c1a61617ca..02bb0659915 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -144,6 +144,8 @@ extern Shift SizeFloorLog2(Size size);
extern Res WriteF(mps_lib_FILE *stream, ...);
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);
/* Miscellaneous support -- see */
@@ -953,6 +955,18 @@ extern void StackProbe(Size depth);
Bool DiagIsOn(void);
mps_lib_FILE *DiagStream(void);
+
+/* Diag*F functions -- formatted diagnostic output
+ *
+ * Note: do not call these directly; use the DIAG_*F macros below.
+ */
+
+extern void DiagSingleF(const char *tag, ...);
+extern void DiagFirstF(const char *tag, ...);
+extern void DiagMoreF(const char *format, ...);
+extern void DiagEnd(const char *tag);
+
+
#if defined(DIAG_WITH_STREAM_AND_WRITEF)
/* Diagnostic Calculation and Output */
@@ -961,17 +975,36 @@ mps_lib_FILE *DiagStream(void);
#define DIAG(s) BEGIN \
s \
END
-/*
- * Note the macro argument args should have parens around it (in the
- * invocation); it is a variable number of arguments that we pass
- * to another function.
- * That makes this macro unclean in all sorts of ways.
+
+
+/* DIAG_*F macros -- formatted diagnostic output
+ *
+ * Note: when invoking these macros, the value passed as macro
+ * argument "args" might contain commas; it must therefore be
+ * enclosed in parentheses. That makes these macros unclean in
+ * all sorts of ways.
*/
+
#define DIAG_WRITEF(args) DIAG( \
if(DiagIsOn()) { \
WriteF args; \
} \
)
+#define DIAG_SINGLEF(args) DIAG( \
+ DiagSingleF args; \
+)
+#define DIAG_FIRSTF(args) DIAG( \
+ DiagFirstF args; \
+)
+#define DIAG_MOREF(args) DIAG( \
+ DiagMoreF args; \
+)
+
+/* Note: extra parens *not* required when invoking DIAG_END */
+#define DIAG_END(tag) DIAG( \
+ DiagEnd(tag); \
+)
+
#else
@@ -980,6 +1013,12 @@ mps_lib_FILE *DiagStream(void);
#define DIAG(s) BEGIN END
#define DIAG_WRITEF(args) BEGIN END
+/* DIAG_*F macros */
+#define DIAG_SINGLEF(args) BEGIN END
+#define DIAG_FIRSTF(args) BEGIN END
+#define DIAG_MOREF(args) BEGIN END
+#define DIAG_END(tag) BEGIN END
+
#endif
/* ------------ DIAG_WITH_PRINTF --------------- */
diff --git a/mps/code/trace.c b/mps/code/trace.c
index da1952a5c37..d4ad1d25903 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1903,14 +1903,14 @@ void TraceStart(Trace trace, double mortality, double finishingTime)
} while (SegNext(&seg, arena, base));
}
- DIAG_WRITEF(( DIAG_STREAM,
- "MPS: TraceStart, because code $U: $S\n",
+ DIAG_FIRSTF(( "TraceStart",
+ "because code $U: $S\n",
trace->why, traceStartWhyToString(trace->why),
NULL ));
DIAG( ArenaDescribe(arena, DIAG_STREAM); );
- DIAG_WRITEF(( DIAG_STREAM,
+ DIAG_MOREF((
"MPS: white set:$B\n",
trace->white,
NULL ));
@@ -1940,6 +1940,8 @@ void TraceStart(Trace trace, double mortality, double finishingTime)
NULL ));
TraceStartGenDesc_diag(&arena->topGen, -1);
}
+
+ DIAG_END( "TraceStart" );
res = RootsIterate(ArenaGlobals(arena), rootGrey, (void *)trace);
AVER(res == ResOK);