Poolawl now takes an additional argument: the find_dependent_object method.

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

5 files changed, 56 insertions, 55 deletions

diff --git a/mps/code/awlut.c b/mps/code/awlut.c
index 1ae9f11f49c..d2d5ebe7db5 100644
--- a/mps/code/awlut.c
+++ b/mps/code/awlut.c
@@ -268,7 +268,8 @@ static void *setup(void *v, size_t s)
       "Format Create (weak)\n");
   die(mps_pool_create(&leafpool, arena, mps_class_lo(), dylanfmt),
       "Leaf Pool Create\n");
-  die(mps_pool_create(&tablepool, arena, mps_class_awl(), dylanweakfmt),
+  die(mps_pool_create(&tablepool, arena, mps_class_awl(), dylanweakfmt,
+                      dylan_weak_dependent),
       "Table Pool Create\n");
   die(mps_ap_create(&leafap, leafpool, MPS_RANK_EXACT),
       "Leaf AP Create\n");
@@ -278,7 +279,7 @@ static void *setup(void *v, size_t s)
       "Weak AP Create\n");
   die(mps_ap_create(&bogusap, tablepool, MPS_RANK_EXACT),
       "Bogus AP Create\n");
-   
+
   test(leafap, exactap, weakap, bogusap);
 
   mps_ap_destroy(bogusap);
diff --git a/mps/code/awlutth.c b/mps/code/awlutth.c
index bcb4ddd0c4e..9d7f2e41855 100644
--- a/mps/code/awlutth.c
+++ b/mps/code/awlutth.c
@@ -264,7 +264,8 @@ static void *setup(void *v, size_t s)
       "Format Create (weak)\n");
   die(mps_pool_create(&leafpool, arena, mps_class_lo(), dylanfmt),
       "Leaf Pool Create\n");
-  die(mps_pool_create(&tablepool, arena, mps_class_awl(), dylanweakfmt),
+  die(mps_pool_create(&tablepool, arena, mps_class_awl(), dylanweakfmt,
+                      dylan_weak_dependent),
       "Table Pool Create\n");
   die(mps_ap_create(&leafap, leafpool, MPS_RANK_EXACT),
       "Leaf AP Create\n");
diff --git a/mps/code/fmtdy.c b/mps/code/fmtdy.c
index dae0dc64e70..84db8101257 100644
--- a/mps/code/fmtdy.c
+++ b/mps/code/fmtdy.c
@@ -182,7 +182,7 @@ int dylan_wrapper_check(mps_word_t *w)
   /* size.  This assumes that DylanWorks is only going to use byte */
   /* vectors in the non-word case. */
 
-  /* Variable part format 6 is reserved. */ 
+  /* Variable part format 6 is reserved. */
   assert(vf != 6);
 
   /* There should be no shift in word vector formats. */
@@ -241,6 +241,32 @@ static mps_res_t dylan_scan_contig(mps_ss_t mps_ss,
   return MPS_RES_OK;
 }
 
+/* dylan_weak_dependent -- returns the linked object, if any.
+ */
+
+extern mps_addr_t dylan_weak_dependent(mps_addr_t parent)
+{
+  mps_word_t *object;
+  mps_word_t *wrapper;
+  mps_word_t fword;
+  mps_word_t fl;
+  mps_word_t ff;
+
+  assert(parent != NULL);
+  object = (mps_word_t *)parent;
+  wrapper = (mps_word_t *)object[0];
+  assert(dylan_wrapper_check(wrapper));
+  fword = wrapper[3];
+  ff = fword & 3;
+  /* traceable fixed part */
+  assert(ff == 1);
+  fl = fword & ~3uL;
+  /* at least one fixed field */
+  assert(fl >= 1);
+  return (mps_addr_t) object[1];
+}
+
+
 /* Scan weakly a contiguous array of references in [base, limit). */
 /* Only required to scan vectors for Dylan Weak Tables. */
 /* Depends on the vector length field being scannable (ie a tagged */
diff --git a/mps/code/fmtdy.h b/mps/code/fmtdy.h
index 39ca3130208..e174121c06f 100644
--- a/mps/code/fmtdy.h
+++ b/mps/code/fmtdy.h
@@ -17,6 +17,7 @@ extern mps_fmt_B_s *dylan_fmt_B_weak(void);
 extern mps_res_t dylan_fmt(mps_fmt_t *, mps_arena_t);
 extern mps_res_t dylan_fmt_weak(mps_fmt_t *, mps_arena_t);
 
+extern mps_addr_t dylan_weak_dependent(mps_addr_t);
 
 /* Used only for debugging / testing */
 extern mps_res_t dylan_init(mps_addr_t addr, size_t size,
diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c
index 482581d37b8..ca7954c5791 100644
--- a/mps/code/poolawl.c
+++ b/mps/code/poolawl.c
@@ -76,6 +76,9 @@ typedef struct awlStatTotalStruct {
   Count declined;      /* number of declined single accesses */
 } awlStatTotalStruct, *awlStatTotal;
 
+/* the type of a function to find an object's dependent object */
+
+typedef Addr (*FindDependentMethod)(Addr object);
 
 /* AWLStruct -- AWL pool structure
  *
@@ -90,6 +93,7 @@ typedef struct AWLStruct {
   Size size;                /* allocated size in bytes */
   Serial gen;               /* associated generation (for SegAlloc) */
   Count succAccesses;       /* number of successive single accesses */
+  FindDependentMethod findDependent; /*  to find a dependent object */
   awlStatTotalStruct stats;
   Sig sig;
 } AWLStruct, *AWL;
@@ -271,7 +275,7 @@ static void AWLSegFinish(Seg seg)
   super = SEG_SUPERCLASS(AWLSegClass);
   super->finish(seg);
 }
- 
+
 
 /* AWLSegClass -- Class definition for AWL segments */
 
@@ -310,7 +314,7 @@ static Bool AWLCanTrySingleAccess(AWL awl, Seg seg, Addr addr)
 
     awlseg = Seg2AWLSeg(seg);
     AVERT(AWLSeg, awlseg);
-   
+
     if (AWLHaveTotalSALimit) {
       if (AWLTotalSALimit < awl->succAccesses) {
         STATISTIC(awl->stats.declined++);
@@ -483,6 +487,7 @@ static Res AWLInit(Pool pool, va_list arg)
 {
   AWL awl;
   Format format;
+  FindDependentMethod findDependent;
   Chain chain;
   Res res;
   static GenParamStruct genParam = { SizeMAX, 0.5 /* dummy */ };
@@ -496,6 +501,10 @@ static Res AWLInit(Pool pool, va_list arg)
   AVERT(Format, format);
   pool->format = format;
 
+  findDependent = va_arg(arg, FindDependentMethod);
+  AVER(FUNCHECK(findDependent));
+  awl->findDependent = findDependent;
+
   res = ChainCreate(&chain, pool->arena, 1, &genParam);
   if (res != ResOK)
     return res;
@@ -777,52 +786,14 @@ static void AWLBlacken(Pool pool, TraceSet traceSet, Seg seg)
   AVERT(AWL, awl);
   awlseg = Seg2AWLSeg(seg);
   AVERT(AWLSeg, awlseg);
- 
-  BTSetRange(awlseg->scanned, 0, awlseg->grains);
-}
-
 
-/* AWLDependentObject -- returns the linked object, if any
- *
- * see design.mps.poolawl.fun.dependent-object, and
- * analysis.mps.poolawl.improve.dependent.abstract
- */
-
-static Bool AWLDependentObject(Addr *objReturn, Addr parent)
-{
-  Word *object;
-  Word *wrapper;
-  Word fword;
-  Word fl;
-  Word ff;
-
-  AVER(objReturn != NULL);
-  AVER(parent != (Addr)0);
-
-  object = (Word *)parent;
-  wrapper = (Word *)object[0];
-  AVER(wrapper != NULL);
-  /* check wrapper wrapper is non-NULL */
-  AVER(wrapper[0] != 0);
-  /* check wrapper wrapper is wrapper wrapper wrapper */
-  AVER(wrapper[0] == ((Word *)wrapper[0])[0]);
-  fword = wrapper[3];
-  ff = fword & 3;
-  /* Traceable Fixed part */
-  AVER(ff == 1);
-  fl = fword & ~3uL;
-  /* At least one fixed field */
-  AVER(fl >= 1);
-  if (object[1] == 0)
-    return FALSE;
-  *objReturn = (Addr)object[1];
-  return TRUE;
+  BTSetRange(awlseg->scanned, 0, awlseg->grains);
 }
 
 
 /* awlScanObject -- scan a single object */
 
-static Res awlScanObject(Arena arena, ScanState ss,
+static Res awlScanObject(Arena arena, AWL awl, ScanState ss,
                          FormatScanMethod scan, Addr base, Addr limit)
 {
   Res res;
@@ -831,19 +802,19 @@ static Res awlScanObject(Arena arena, ScanState ss,
   Seg dependentSeg = NULL; /* segment of dependent object */
 
   AVERT(Arena, arena);
+  AVERT(AWL, awl);
   AVERT(ScanState, ss);
   AVER(FUNCHECK(scan));
   AVER(base != 0);
   AVER(base < limit);
 
-  dependent = AWLDependentObject(&dependentObject, base)
-              && SegOfAddr(&dependentSeg, arena, dependentObject);
-
+  dependentObject = awl->findDependent(base);
+  dependent = SegOfAddr(&dependentSeg, arena, dependentObject);
   if (dependent) {
-    /* design.mps.poolawl.fun.scan.pass.object.dependent.expose */
-    ShieldExpose(arena, dependentSeg);
-    /* design.mps.poolawl.fun.scan.pass.object.dependent.summary */
-    SegSetSummary(dependentSeg, RefSetUNIV);
+      /* design.mps.poolawl.fun.scan.pass.object.dependent.expose */
+      ShieldExpose(arena, dependentSeg);
+      /* design.mps.poolawl.fun.scan.pass.object.dependent.summary */
+      SegSetSummary(dependentSeg, RefSetUNIV);
   }
 
   res = (*scan)(ss, base, limit);
@@ -911,7 +882,7 @@ static Res awlScanSinglePass(Bool *anyScannedReturn,
     /* design.mps.poolawl.fun.scan.pass.object */
     if (scanAllObjects
         || (BTGet(awlseg->mark, i) && !BTGet(awlseg->scanned, i))) {
-      Res res = awlScanObject(arena, ss, pool->format->scan,
+      Res res = awlScanObject(arena, awl, ss, pool->format->scan,
                               p, objectLimit);
       if (res != ResOK)
         return res;
@@ -1001,7 +972,7 @@ static Res AWLFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
 
   ref = *refIO;
   i = awlIndexOfAddr(SegBase(seg), awl, ref);
- 
+
   ss->wasMarked = TRUE;
 
   switch(ss->rank) {
@@ -1243,6 +1214,7 @@ static Bool AWLCheck(AWL awl)
   /* 30 is just a sanity check really, not a constraint. */
   CHECKL(0 <= awl->gen && awl->gen <= 30);
   /* Nothing to check about succAccesses. */
+  CHECKL(FUNCHECK(awl->findDependent));
   /* Don't bother to check stats. */
   return TRUE;
 }