From d1d62ad63b4ef1300d020f2018f4094f215ebbb0 Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Fri, 30 Jan 1998 15:11:17 +0000
Subject: [PATCH] Adding walker, in anticipation of change for
 request.dylan.170440

Copied from Perforce
 Change: 19288
 ServerID: perforce.ravenbrook.com
---
 mps/src/arena.c | 82 +++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 80 insertions(+), 2 deletions(-)

diff --git a/mps/src/arena.c b/mps/src/arena.c
index 0190c8296d8..f6f97c203c5 100644
--- a/mps/src/arena.c
+++ b/mps/src/arena.c
@@ -1,6 +1,6 @@
 /* impl.c.arena: ARENA IMPLEMENTATION
  *
- * $HopeName: MMsrc!arena.c(trunk.24) $
+ * $HopeName: MMsrc!arena.c(trunk.25) $
  * Copyright (C) 1997 The Harlequin Group Limited.  All rights reserved.
  *
  * .readership: Any MPS developer
@@ -34,8 +34,9 @@
 
 /* finalization */
 #include "poolmrg.h"
+#include "mps.h"
 
-SRCID(arena, "$HopeName: MMsrc!arena.c(trunk.24) $");
+SRCID(arena, "$HopeName: MMsrc!arena.c(trunk.25) $");
 
 
 /* All static data objects are declared here. See .static */
@@ -1261,3 +1262,80 @@ Ref ArenaRead(Arena arena, Addr addr)
   /* get the possibly fixed reference */
   return ArenaPeekSeg(arena, seg, addr);
 }
+
+
+/* Heap Walking
+ *
+ * .trans.mod: There's no particular reason these functions belong in
+ * arena.c, it's just a matter of convenience.
+ */
+
+typedef struct FormattedObjectsStepClosureStruct *FormattedObjectsStepClosure;
+typedef struct FormattedObjectsStepClosureStruct {
+  mps_formatted_objects_stepper_t f;
+  Pool pool;
+  void *p;
+  unsigned long s;
+} FormattedObjectsStepClosureStruct;
+
+
+static void ArenaFormattedObjectsStep(Addr object, Format format,
+                                      void *p, unsigned long s)
+{
+  FormattedObjectsStepClosure c = p;
+  /* Can't check object */
+  /* Checking format would be too painful */
+  AVER(s == 0);
+
+  (*c->f)((mps_addr_t)object, (mps_fmt_t)format, (mps_pool_t)c->pool, 
+          c->p, c->s);
+}
+
+/* so called because it walk all formatted objects in an arena */
+static void ArenaFormattedObjectsWalk(Arena arena,
+                                      FormattedObjectsStepMethod f,
+	            	              void *p, unsigned long s)
+{
+  Seg seg;
+  FormattedObjectsStepClosure c;
+
+  AVERT(Arena, arena);
+  AVER(FUNCHECK(f));
+  AVER(f == ArenaFormattedObjectsStep);
+  /* p and s are arbitrary closure and can't be checked */
+  AVER(p != NULL);
+  AVER(s == 0);
+  c = p;
+
+  if(SegFirst(&seg, arena)) {
+    Addr base;
+    do {
+      Pool pool;
+      base = SegBase(seg);
+      pool = SegPool(seg);
+      if(pool->class->attr & AttrFMT) {
+        c->pool = pool;
+	PoolWalk(pool, seg, f, p, s);
+      }
+    } while(SegNext(&seg, arena, base));
+  }
+}
+
+void mps_arena_formatted_objects_walk(mps_arena_t mps_arena,
+                                      mps_formatted_objects_stepper_t f,
+			              void *p,
+			              unsigned long s)
+{
+  Arena arena = (Arena)mps_arena;
+  FormattedObjectsStepClosureStruct c;
+
+  ArenaEnter(arena);
+  AVERT(Arena, arena);
+  AVER(FUNCHECK(f));
+  /* p and s are arbitrary closures, hence can't be checked */
+  c.f = f;
+  c.p = p;
+  c.s = s;
+  ArenaFormattedObjectsWalk(arena, ArenaFormattedObjectsStep, &c, 0);
+  ArenaLeave(arena);
+}