Move awldependentobject function out into the dylan format.

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

mps/src/awlut.c

@@ -270,7 +270,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");
@@ -280,7 +281,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);

mps/src/awlutth.c

@@ -273,7 +273,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");

mps/src/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 */

mps/src/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,

mps/src/poolawl.c

@@ -71,6 +71,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);
 
 /* design.mps.poolawl.poolstruct */
 typedef struct AWLStruct {
@@ -81,6 +84,7 @@ typedef struct AWLStruct {
   Serial gen;               /* associated generation (for SegAlloc) */
   Sig sig;
   Count succAccesses;       /* number of successive single accesses */
+  FindDependentMethod findDependent; /*  to find a dependent object */
   AWLStatTotalStruct stats;
 } AWLStruct, *AWL;
 
@@ -486,6 +490,7 @@ static Res AWLInit(Pool pool, va_list arg)
 {
   AWL awl;
   Format format;
+  FindDependentMethod findDependent;
 
   /* weak check, as half way through initialization */
   AVER(pool != NULL);
@@ -496,6 +501,11 @@ 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;
+
   awl->alignShift = SizeLog2(pool->alignment);
   ActionInit(&awl->actionStruct, pool);
   awl->lastCollected = ArenaMutatorAllocSize(PoolArena(pool));
@@ -756,43 +766,7 @@ static void AWLBlacken(Pool pool, TraceSet traceSet, Seg seg)
 }
 
 
-/* Returns the linked object (or possibly there is none) */
-/* 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;
-}
-
-
-static Res awlScanObject(Arena arena, ScanState ss,
+static Res awlScanObject(Arena arena, AWL awl, ScanState ss,
                          FormatScanMethod scan, Addr base, Addr limit)
 {
   Res res;
@@ -801,23 +775,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);
 
-  if(AWLDependentObject(&dependentObject, base) &&
-     SegOfAddr(&dependentSeg, arena, dependentObject)) {
-    dependent = TRUE;
-  } else {
-    dependent = FALSE;
-  }
-
-  if(dependent) {
-    /* design.mps.poolawl.fun.scan.pass.repeat.object.dependent.expose */
-    ShieldExpose(arena, dependentSeg);
-    /* design.mps.poolawl.fun.scan.pass.repeat.object.dependent.summary */
-    SegSetSummary(dependentSeg, RefSetUNIV);
+  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);
   }
 
   res = (*scan)(ss, base, limit);
@@ -882,7 +852,7 @@ static Res awlScanSinglePass(Bool *anyScannedReturn,
     /* design.mps.poolawl.fun.scan.scan */
     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;
@@ -1265,5 +1235,6 @@ static Bool AWLCheck(AWL awl)
 
   /* 30 is just a sanity check really, not a constraint */
   CHECKL(0 <= awl->gen && awl->gen <= 30);
+  CHECKL(FUNCHECK(awl->findDependent));
   return TRUE;
 }