[commit: ghc] wip/ghc-8.6-merge: Fix checkPtrInArena (1400129)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/ghc-8.6-merge
Link       : http://ghc.haskell.org/trac/ghc/changeset/14001294137e0f86fb7f7be434a1aa8c58454558/ghc

>---------------------------------------------------------------

commit 14001294137e0f86fb7f7be434a1aa8c58454558
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date:   Sat Jan 12 16:08:24 2019 +0300

    Fix checkPtrInArena
    
    (See comments)
    
    (cherry picked from commit 448f0e7dd78a8d9404f1aa5e8522cc284360c06d)


>---------------------------------------------------------------

14001294137e0f86fb7f7be434a1aa8c58454558
 rts/Arena.c | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/rts/Arena.c b/rts/Arena.c
index e0b4ebd..a4ff11b 100644
--- a/rts/Arena.c
+++ b/rts/Arena.c
@@ -121,8 +121,17 @@ arenaBlocks( void )
 #if defined(DEBUG)
 void checkPtrInArena( StgPtr p, Arena *arena )
 {
-    for (bdescr *bd = arena->current; bd; bd = bd->link) {
-        if (p >= bd->start && p < bd->free) {
+    // We don't update free pointers of arena blocks, so we have to check cached
+    // free pointer for the first block.
+    if (p >= arena->current->start && p < arena->free) {
+        return;
+    }
+
+    // Rest of the blocks should be full (except there may be a little bit of
+    // slop at the end). Again, free pointers are not updated so we can't use
+    // those.
+    for (bdescr *bd = arena->current->link; bd; bd = bd->link) {
+        if (p >= bd->start && p < bd->start + (bd->blocks*BLOCK_SIZE_W)) {
             return;
         }
     }