[Git][ghc/ghc][wip/T7275] rts: Further simplify

[Ben Gamari]

Ben Gamari pushed to branch wip/T7275 at Glasgow Haskell Compiler / GHC


Commits:
bcefe62f by Ben Gamari at 2020-12-09T16:53:50-05:00
rts: Further simplify

- - - - -


1 changed file:

- rts/ProfHeap.c


Changes:

=====================================
rts/ProfHeap.c
=====================================
@@ -1103,41 +1103,21 @@ heapCensusCompactList(Census *census, bdescr *bd)
     }
 }
 
-static void
-heapCensusPinnedBlock( Census *census, bdescr *bd )
-{
-    StgWord *p = (StgWord *) bd->start;
-    while (p < bd->free) {
-        if (*(StgWord *) p == 0) {
-            p++;
-            continue;
-        }
-
-        ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-        const StgInfoTable *info = get_itbl((StgClosure *) p);
-        switch (info->type) {
-          case ARR_WORDS:
-            {
-              StgArrBytes *arr = (StgArrBytes *) p;
-              const size_t size = arr_words_sizeW(arr);
-              heapProfObject(census, (StgClosure *)p, size, /*prim*/ true);
-              p += size;
-              break;
-            }
-          default:
-            barf("heapCensusPinnedBlock: Unknown object: %p (info=%p, type=%d)", p, info, info->type);
-        }
-    }
-}
-
 /*
- * Take a census of the contents of a "normal" (e.g. not large, not pinned, not
- * compact) heap block.
+ * Take a census of the contents of a "normal" (e.g. not large, not compact)
+ * heap block. This can, however, handle PINNED blocks.
  */
 static void
-heapCensusNormalBlock(Census *census, bdescr *bd)
+heapCensusBlock(Census *census, bdescr *bd)
 {
     StgPtr p = bd->start;
+
+    // In the case of PINNED blocks there can be (zeroed) slop at the beginning
+    // due to object alignment.
+    if (bd->flags & BF_PINNED) {
+        while (p < bd->free && !*p) p++;
+    }
+
     while (p < bd->free) {
         const StgInfoTable *info = get_itbl((const StgClosure *)p);
         bool prim = false;
@@ -1331,12 +1311,7 @@ heapCensusChain( Census *census, bdescr *bd )
             continue;
         }
 
-        if (bd->flags & BF_PINNED) {
-            heapCensusPinnedBlock(census, bd);
-            continue;
-        }
-
-        heapCensusNormalBlock(census, bd);
+        heapCensusBlock(census, bd);
     }
 }
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bcefe62f03fd89006e5539883aeae2a8286ea083

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bcefe62f03fd89006e5539883aeae2a8286ea083
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201209/f0b052b6/attachment-0001.html>