6 files changed, 61 insertions, 1 deletions

diff --git a/mps/code/amcss.c b/mps/code/amcss.c
index 647d0525fc4..8b88dd38bec 100644
--- a/mps/code/amcss.c
+++ b/mps/code/amcss.c
@@ -47,7 +47,27 @@ static mps_addr_t exactRoots[exactRootsCOUNT];
 static mps_addr_t ambigRoots[ambigRootsCOUNT];
 
 
-/* report - report statistics from any messages */
+/* alert -- synchronous alert of collection start/stop */
+
+static void alertfn(int alertcode, int whycode)
+{
+  switch(alertcode) {
+    case MPS_ALERT_COLLECTION_START: {
+      printf("\n^^^^^^ START (why: %d) ^^^^^^\n", whycode);
+      break;
+    }
+    case MPS_ALERT_COLLECTION_STOP: {
+      printf("vvvvvv STOP (why: %d)  vvvvvv\n", whycode);
+      break;
+    }
+    default: {
+      cdie(0, "unknown alertcode");
+      break;
+    }
+  }
+}
+
+/* report -- report statistics from any messages */
 
 static void report(mps_arena_t arena)
 {
@@ -313,6 +333,7 @@ int main(int argc, char **argv)
       "arena_create");
   mps_message_type_enable(arena, mps_message_type_gc());
   mps_message_type_enable(arena, mps_message_type_gc_start());
+  mps_alert_collection_set(arena, &alertfn);
   die(mps_arena_commit_limit_set(arena, testArenaSIZE), "set limit");
   die(mps_thread_reg(&thread, arena), "thread_reg");
   mps_tramp(&r, test, arena, 0);
diff --git a/mps/code/arena.c b/mps/code/arena.c
index dc2f008303c..0e7b89eb4d8 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -135,6 +135,8 @@ Bool ArenaCheck(Arena arena)
   CHECKD(ChunkCacheEntry, &arena->chunkCache);
 
   CHECKL(LocusCheck(arena));
+  
+  /* nothing to check for alertCollection */
 
   return TRUE;
 }
@@ -176,6 +178,8 @@ Res ArenaInit(Arena arena, ArenaClass class)
   ChunkCacheEntryInit(&arena->chunkCache);
 
   LocusInit(arena);
+  
+  arena->alertCollection = 0;
 
   res = GlobalsInit(ArenaGlobals(arena));
   if (res != ResOK)
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index af5e2d89fd6..efc4ce18366 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -688,6 +688,9 @@ typedef struct ArenaStruct {
   Bool isFinalPool;             /* indicator for finalPool */
   Pool finalPool;               /* either NULL or an MRG pool */
 
+  /* alert fields <code/trace.c> */
+  mps_alert_collection_fn_t alertCollection;  /* client alert fn or 0 */
+
   /* thread fields (<code/thread.c>) */
   RingStruct threadRing;        /* ring of attached threads */
   Serial threadSerial;          /* serial of next thread */
diff --git a/mps/code/mps.h b/mps/code/mps.h
index 2852416bac8..01e556374ed 100644
--- a/mps/code/mps.h
+++ b/mps/code/mps.h
@@ -550,6 +550,18 @@ extern mps_res_t mps_finalize(mps_arena_t, mps_addr_t *);
 extern mps_res_t mps_definalize(mps_arena_t, mps_addr_t *);
 
 
+/* Alert */
+
+/* Alert codes. */
+enum {
+  MPS_ALERT_COLLECTION_START,
+  MPS_ALERT_COLLECTION_STOP
+};
+typedef void (*mps_alert_collection_fn_t)(int, int);
+extern mps_res_t mps_alert_collection_set(mps_arena_t, 
+                                          mps_alert_collection_fn_t);
+
+
 /* Telemetry */
 
 extern mps_word_t mps_telemetry_control(mps_word_t, mps_word_t);
diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c
index 400ab84c486..b2193825c2d 100644
--- a/mps/code/mpsi.c
+++ b/mps/code/mpsi.c
@@ -1799,6 +1799,20 @@ const char *mps_message_gc_start_why(mps_arena_t mps_arena,
   return s;
 }
 
+
+/* Alert */
+
+mps_res_t mps_alert_collection_set(mps_arena_t mps_arena, 
+                                   mps_alert_collection_fn_t fn)
+{
+  Arena arena = (Arena)mps_arena;
+  ArenaEnter(arena);
+  arena->alertCollection = fn;
+  ArenaLeave(arena);
+  return MPS_RES_OK;  
+}
+
+
 /* Telemetry */
 
 mps_word_t mps_telemetry_control(mps_word_t resetMask, mps_word_t flipMask)
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 3614f3157df..69ff0018404 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1056,6 +1056,9 @@ static void tracePostMessage(Trace trace)
     message->notCondemnedSize = trace->notCondemned;
     MessagePost(arena, TraceMessageMessage(message));
   }
+  if(arena->alertCollection) {
+    (*arena->alertCollection)(MPS_ALERT_COLLECTION_STOP, trace->why);
+  }
 
   return;
 }
@@ -1859,6 +1862,9 @@ void TraceStart(Trace trace, double mortality, double finishingTime)
   if(!MessageOnQueue(message)) {
     MessagePost(arena, message);
   }
+  if(arena->alertCollection) {
+    (*arena->alertCollection)(MPS_ALERT_COLLECTION_START, trace->why);
+  }
 
   /* From the already set up white set, derive a grey set. */