Merging mps_arena_has_addr() stuff from configura branch to master sources.

Copied from Perforce
 Change: 24163
 ServerID: perforce.ravenbrook.com

5 files changed, 43 insertions, 3 deletions

diff --git a/mps/code/amcss.c b/mps/code/amcss.c
index 454c4c777ad..32278402d74 100644
--- a/mps/code/amcss.c
+++ b/mps/code/amcss.c
@@ -50,7 +50,7 @@ static void enable(mps_arena_t arena)
 static void report(mps_arena_t arena)
 {
     mps_message_t message;
-
+    
     while (mps_message_get(&message, arena, mps_message_type_gc())) {
         size_t live, condemned, not_condemned;
 
@@ -156,10 +156,23 @@ static void *test(void *arg, size_t s)
       collections = c;
       printf("\nCollection %lu, %lu objects.\n",
              c, objs);
+      do {
+          mps_addr_t p = (mps_addr_t)rnd();
+          if (mps_arena_has_addr(arena, p)) {
+              printf("0x%08x is in arena\n", (int)p);
+              break;
+          }
+      } while(1);
+    
       report(arena);
       for(r = 0; r < exactRootsCOUNT; ++r)
-        cdie(exactRoots[r] == objNULL || dylan_check(exactRoots[r]),
+        cdie(exactRoots[r] == objNULL ||
+             (dylan_check(exactRoots[r]) &&
+              mps_arena_has_addr(arena, exactRoots[r])),
              "all roots check");
+      cdie(!mps_arena_has_addr(arena, NULL),
+           "NULL in arena");
+
       if(collections == collectionsCOUNT / 2) {
         unsigned long object_count = 0;
         mps_arena_park(arena);
diff --git a/mps/code/arena.c b/mps/code/arena.c
index c0bb7888524..83c3ee600ff 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -647,3 +647,14 @@ Res ArenaNoExtend(Arena arena, Addr base, Size size)
   NOTREACHED;
   return ResUNIMPL;
 }
+
+
+/* Has Addr */
+
+Bool ArenaHasAddr(Arena arena, Addr addr)
+{
+  Seg seg;
+
+  AVERT(Arena, arena);
+  return SegOfAddr(&seg, arena, addr);
+}
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 0572b1a5a20..a810d6b0b40 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -523,11 +523,11 @@ extern void (ArenaPoll)(Globals globals);
 /* .nogc.why: ScriptWorks doesn't use MM-provided incremental GC, so */
 /* doesn't need to poll when allocating. */
 
-
 extern void ArenaClamp(Globals globals);
 extern void ArenaRelease(Globals globals);
 extern void ArenaPark(Globals globals);
 extern Res ArenaCollect(Globals globals);
+extern Bool ArenaHasAddr(Arena arena, Addr addr);
 
 extern Res ControlInit(Arena arena);
 extern void ControlFinish(Arena arena);
diff --git a/mps/code/mps.h b/mps/code/mps.h
index 7339319d815..5af0608b240 100644
--- a/mps/code/mps.h
+++ b/mps/code/mps.h
@@ -262,6 +262,8 @@ extern size_t mps_arena_spare_commit_limit(mps_arena_t);
 extern size_t mps_space_reserved(mps_space_t);
 extern size_t mps_space_committed(mps_space_t);
 
+extern mps_bool_t mps_arena_has_addr(mps_arena_t, mps_addr_t);
+
 /* Client memory arenas */
 extern mps_res_t mps_arena_extend(mps_arena_t, mps_addr_t, size_t);
 extern mps_res_t mps_arena_retract(mps_arena_t, mps_addr_t, size_t);
diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c
index c72bf7549b1..cff889c8872 100644
--- a/mps/code/mpsi.c
+++ b/mps/code/mpsi.c
@@ -432,6 +432,20 @@ void mps_space_destroy(mps_space_t mps_space)
 }
 #endif
 
+/* mps_arena_has_addr -- is this address managed by this arena? */
+
+mps_bool_t mps_arena_has_addr(mps_arena_t mps_arena, mps_addr_t p)
+{
+    Bool b;
+    Arena arena = (Arena)mps_arena;
+
+    ArenaEnter(arena);
+    AVERT(Arena, arena);
+    b = ArenaHasAddr(arena, (Addr)p);
+    ArenaLeave(arena);
+    return b;
+}
+
 
 /* mps_fmt_create_A -- create an object format of variant A
  *