From 8f6b41e9ac801880d2bdce8a148bbe6aed121bfe Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 17 Apr 2014 14:22:19 +0100
Subject: [PATCH] New function tracedescribe.

Copied from Perforce
 Change: 185631
 ServerID: perforce.ravenbrook.com
---
 mps/code/global.c | 10 +++++++++-
 mps/code/mpm.h    |  1 +
 mps/code/trace.c  | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 56 insertions(+), 1 deletion(-)

diff --git a/mps/code/global.c b/mps/code/global.c
index 58cc3e8fcbd..d9820e19981 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -1040,6 +1040,8 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
   Arena arena;
   Ring node, nextNode;
   Index i;
+  TraceId ti;
+  Trace trace;
 
   if (!TESTT(Globals, arenaGlobals)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
@@ -1070,7 +1072,6 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
                arena->insideShield ? "inside shield\n" : "outside shield\n",
                "busyTraces    $B\n", (WriteFB)arena->busyTraces,
                "flippedTraces $B\n", (WriteFB)arena->flippedTraces,
-               /* @@@@ no TraceDescribe function */
                "epoch $U\n", (WriteFU)arena->epoch,
                "history {\n",
                NULL);
@@ -1119,6 +1120,13 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
     if (res != ResOK) return res;
   }
 
+  TRACE_SET_ITER(ti, trace, TraceSetUNIV, arena)
+    if (TraceSetIsMember(arena->busyTraces, trace)) {
+      res = TraceDescribe(trace, stream);
+      if (res != ResOK) return res;
+    }
+  TRACE_SET_ITER_END(ti, trace, TraceSetUNIV, arena);
+
   /* @@@@ What about grey rings? */
 
   res = WriteF(stream, "} Globals $P\n", (WriteFP)arenaGlobals, NULL);
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 0cbad2b0f1c..14bd71be909 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -397,6 +397,7 @@ extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode);
 
 extern void TraceQuantum(Trace trace);
 extern Res TraceStartCollectAll(Trace *traceReturn, Arena arena, int why);
+extern Res TraceDescribe(Trace trace, mps_lib_FILE *stream);
 
 /* traceanc.c -- Trace Ancillary */
 
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 61e9d396155..91004bf65aa 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1899,6 +1899,52 @@ failStart:
 }
 
 
+/* TraceDescribe -- describe a trace */
+
+Res TraceDescribe(Trace trace, mps_lib_FILE *stream)
+{
+  Res res;
+  const char *state;
+
+  if (!TESTT(Trace, trace)) return ResFAIL;
+  if (stream == NULL) return ResFAIL;
+
+  switch (trace->state) {
+  case TraceINIT:      state = "INIT";      break;
+  case TraceUNFLIPPED: state = "UNFLIPPED"; break;
+  case TraceFLIPPED:   state = "FLIPPED";   break;
+  case TraceRECLAIM:   state = "RECLAIM";   break;
+  case TraceFINISHED:  state = "FINISHED";  break;
+  default:             state = "unknown";   break;
+  }
+
+  res = WriteF(stream, "Trace $P ($U) {\n", (WriteFP)trace, (WriteFU)trace->ti,
+               "arena $P ($U)\n", (WriteFP)trace->arena,
+               (WriteFU)trace->arena->serial,
+               "why \"$S\"\n", (WriteFS)TraceStartWhyToString(trace->why),
+               "state $S\n", (WriteFS)state,
+               "band $U\n", (WriteFU)trace->band,
+               "white   $B\n", (WriteFB)trace->white,
+               "mayMove $B\n", (WriteFB)trace->mayMove,
+               "chain $P\n", (WriteFP)trace->chain,
+               "condemned $U\n", (WriteFU)trace->condemned,
+               "notCondemned $U\n", (WriteFU)trace->notCondemned,
+               "foundation $U\n", (WriteFU)trace->foundation,
+               "rate $U\n", (WriteFU)trace->rate,
+               "rootScanSize $U\n", (WriteFU)trace->rootScanSize,
+               "rootCopiedSize $U\n", (WriteFU)trace->rootCopiedSize,
+               "segScanSize $U\n", (WriteFU)trace->segScanSize,
+               "segCopiedSize $U\n", (WriteFU)trace->segCopiedSize,
+               "forwardedSize $U\n", (WriteFU)trace->forwardedSize,
+               "preservedInPlaceSize $U\n", (WriteFU)trace->preservedInPlaceSize,
+               NULL);
+  if (res != ResOK) return res;
+
+  res = WriteF(stream, "} Trace $P\n", (WriteFP)trace, NULL);
+  return res;
+}
+
+
 /* C. COPYRIGHT AND LICENSE
  *
  * Copyright (C) 2001-2014 Ravenbrook Limited