4 files changed, 161 insertions, 23 deletions

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 <http://www.ravenbrook.com/>.
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 <design/writef/>, also <design/lib/>
+ *
+ * .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;
 }
 
+Res WriteF_v(mps_lib_FILE *stream, va_list args)
+{
+  const char *firstformat;
+  int r;
+  size_t i;
+  Res res;
 
-/* WriteF_v -- write formatted output
- *
- * .writef.des: See <design/writef/>, also <design/lib/>
- *
- * .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. */
+  firstformat = va_arg(args, const char *);
+  res = WriteF_firstformat_v(stream, firstformat, args);
+  return res;
+}
 
-Res WriteF_v(mps_lib_FILE *stream, va_list args)
+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 <code/mpm.c> */
@@ -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);