Cheng Shao pushed to branch wip/grow-block-free at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • rts/PrimOps.cmm
    ... ... @@ -258,20 +258,35 @@ stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size )
    258 258
     stg_resizzeMutableByteArrayzh ( gcptr mba, W_ new_size )
    
    259 259
     // MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #)
    
    260 260
     {
    
    261
    +   W_ old_size, old_wds, new_wds, new_free;
    
    262
    +   W_ bd;
    
    263
    +
    
    261 264
        ASSERT(new_size `ge` 0);
    
    262 265
     
    
    263
    -   if (new_size <= StgArrBytes_bytes(mba)) {
    
    266
    +   old_size = StgArrBytes_bytes(mba);
    
    267
    +   if (new_size <= old_size) {
    
    264 268
           call stg_shrinkMutableByteArrayzh(mba, new_size);
    
    265 269
           return (mba);
    
    270
    +   }
    
    271
    +
    
    272
    +   bd = Bdescr(mba);
    
    273
    +   old_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(old_size);
    
    274
    +   new_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(new_size);
    
    275
    +   new_free = mba + WDS(new_wds);
    
    276
    +
    
    277
    +   // Just like stg_shrinkMutableByteArrayzh above, we try to grow mba
    
    278
    +   // in-place if possible. The conditions are similar to the
    
    279
    +   // conditions when we can set bd->free when shrinking mba, and we
    
    280
    +   // also need to check that we don't grow past the end of current block.
    
    281
    +   if (bdescr_free(bd) == mba + WDS(old_wds) &&
    
    282
    +       (bd == StgRegTable_rCurrentAlloc(BaseReg) || bd == Capability_pinned_object_block(MyCapability())) &&
    
    283
    +       new_free <= bdescr_start(bd) + (TO_W_(bdescr_blocks(bd)) * BLOCK_SIZE)) {
    
    284
    +      bdescr_free(bd) = new_free;
    
    285
    +      StgArrBytes_bytes(mba) = new_size;
    
    286
    +      return (mba);
    
    266 287
        } else {
    
    267 288
           (P_ new_mba) = call stg_newByteArrayzh(new_size);
    
    268 289
     
    
    269
    -      // maybe at some point in the future we may be able to grow the
    
    270
    -      // MBA in-place w/o copying if we know the space after the
    
    271
    -      // current MBA is still available, as often we want to grow the
    
    272
    -      // MBA shortly after we allocated the original MBA. So maybe no
    
    273
    -      // further allocations have occurred by then.
    
    274
    -
    
    275 290
           // copy over old content
    
    276 291
           prim %memcpy(BYTE_ARR_CTS(new_mba), BYTE_ARR_CTS(mba),
    
    277 292
                        StgArrBytes_bytes(mba), SIZEOF_W);