From 16ef264ac5cba1e341650fa7e730d07796dddb6a Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 11 Jan 2008 19:25:17 +0000
Subject: [PATCH] Mps br/vmarenagrow: drop slices from top half of request
 until

satisified.  WARNING: contains test code that fails deliberately.

Copied from Perforce
 Change: 163757
 ServerID: perforce.ravenbrook.com
---
 mps/code/amcss.c   |  2 +-
 mps/code/arenavm.c | 80 +++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 76 insertions(+), 6 deletions(-)

diff --git a/mps/code/amcss.c b/mps/code/amcss.c
index a31b1023a35..f0c24868b32 100644
--- a/mps/code/amcss.c
+++ b/mps/code/amcss.c
@@ -297,7 +297,7 @@ int main(int argc, char **argv)
   /* /4 => too-small arena, to test arena growth */
   die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE/4),
       "arena_create");
-  die(mps_arena_vm_growth(arena, -1, 0),
+  die(mps_arena_vm_growth(arena, 16 * 0x1000, 0),
       "arena_vm_growth");
   
   mps_message_type_enable(arena, mps_message_type_gc());
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 86e20d03186..7258bbc68b2 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -1089,14 +1089,84 @@ static Res vmArenaExtend(VMArena vmArena, Size size)
     VMArenaReserved(VMArena2Arena(vmArena)), NULL ));
 
   /* .chunk-create.fail: If we fail, try again with a smaller size */
-  for(;; chunkSize /= 2) {
-    res = VMChunkCreate(&newChunk, vmArena, chunkSize);
-    if(res == ResOK)
-      break;
+  {
+    int fidelity = 8;  /* max fraction of addr-space we may 'waste' */
+    Size chunkHalf;
+    Size chunkMin = 4 * 1024;  /* typical single page */
+    Size sliceSize;
+    
+    if (vmArena->extendMin > chunkMin)
+      chunkMin = vmArena->extendMin;
+    if (chunkSize < chunkMin)
+      chunkSize = chunkMin;
+    
+    DIAG_SINGLEF(( "vmArenaExtend_START", 
+      "chunkMin: $W\n", chunkMin,
+      NULL ));
+
+    for(;; chunkSize = chunkHalf) {
+      chunkHalf = chunkSize / 2;
+      sliceSize = chunkHalf / fidelity;
+
+      DIAG_SINGLEF(( "vmArenaExtend_OUTER", 
+        "chunkSize: $W; ", chunkSize,
+        "chunkHalf: $W; ", chunkHalf,
+        "sliceSize: $W\n", sliceSize,
+        NULL ));
+
+      if(sliceSize == 0) {
+        DIAG_SINGLEF(( "vmArenaExtend_NOSLICE", 
+          "chunkSize: $W; ", chunkSize,
+          "chunkHalf: $W\n", chunkHalf,
+          NULL ));
+      }
+      AVER(sliceSize > 0);
+      
+      /* remove slices, down to chunkHalf but no further */
+      for(; chunkSize > chunkHalf; chunkSize -= sliceSize) {
+        static Size lastSize = -1;
+        
+        DIAG_SINGLEF(( "vmArenaExtend_inner", 
+          "chunkSize: $W; ", chunkSize,
+          "chunkHalf: $W; ", chunkHalf,
+          "sliceSize: $W\n", sliceSize,
+          NULL ));
+
+        if(chunkSize < chunkMin) {
+          DIAG_SINGLEF(( "vmArenaExtend_FailMin", 
+            "no remaining address-space chunk >= min($W)", chunkMin,
+            " (so VMArenaReserved remains $W bytes)\n",
+            VMArenaReserved(VMArena2Arena(vmArena)), NULL ));
+          return ResRESOURCE;
+        }
+
+        if(chunkSize >= lastSize) {
+          DIAG_SINGLEF(( "vmArenaExtend_TESTFAIL",
+            "DELIBERATELY FAILING REQUEST OF SIZE $W.\n", chunkSize,
+            "chunkSize: $W; ", chunkSize,
+            "chunkHalf: $W.\n", chunkHalf,
+            NULL ));
+          res = ResRESOURCE;
+        }
+        else {
+          lastSize = chunkSize;
+          res = VMChunkCreate(&newChunk, vmArena, chunkSize);
+          DIAG_SINGLEF(( "vmArenaExtend_ChunkCreate",
+            "chunkSize: $W; ", chunkSize,
+            "res: $W.\n", res,
+          NULL ));
+        }
+
+        if(res == ResOK)
+          goto vmArenaExtend_Done;
+      }
+    }
   }
 
+vmArenaExtend_Done:
+
   DIAG_SINGLEF(( "vmArenaExtend_Done",
-    "Reserved new chunk of VM $W bytes", chunkSize,
+    "Request for new chunk of VM $W bytes succeeded", chunkSize,
     " (VMArenaReserved now $W bytes)\n", 
     VMArenaReserved(VMArena2Arena(vmArena)), NULL ));