[commit: ghc] master: Implement {resize, shrink}MutableByteArray# primops (246436f)

git at git.haskell.org git at git.haskell.org
Sat Aug 16 14:04:42 UTC 2014


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/246436f13739593d2a211ceb830393338118ca4d/ghc

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

commit 246436f13739593d2a211ceb830393338118ca4d
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Sat Aug 16 09:49:30 2014 +0200

    Implement {resize,shrink}MutableByteArray# primops
    
    The two new primops with the type-signatures
    
      resizeMutableByteArray# :: MutableByteArray# s -> Int#
                              -> State# s -> (# State# s, MutableByteArray# s #)
    
      shrinkMutableByteArray# :: MutableByteArray# s -> Int#
                              -> State# s -> State# s
    
    allow to resize MutableByteArray#s in-place (when possible), and are useful
    for algorithms where memory is temporarily over-allocated. The motivating
    use-case is for implementing integer backends, where the final target size of
    the result is either N or N+1, and only known after the operation has been
    performed.
    
    A future commit will implement a stateful variant of the
    `sizeofMutableByteArray#` operation (see #9447 for details), since now the
    size of a `MutableByteArray#` may change over its lifetime (i.e before
    it gets frozen or GCed).
    
    Test Plan: ./validate --slow
    
    Reviewers: ezyang, austin, simonmar
    
    Reviewed By: austin, simonmar
    
    Differential Revision: https://phabricator.haskell.org/D133


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

246436f13739593d2a211ceb830393338118ca4d
 compiler/prelude/primops.txt.pp      | 24 ++++++++++++++++
 includes/Cmm.h                       |  3 ++
 includes/rts/storage/ClosureMacros.h | 33 ++++++++++++++++++++++
 includes/stg/MiscClosures.h          |  2 ++
 rts/Linker.c                         |  2 ++
 rts/PrimOps.cmm                      | 54 ++++++++++++++++++++++++++++++++++++
 6 files changed, 118 insertions(+)

diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 6844f42..d5566fe 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -1074,6 +1074,30 @@ primop  ByteArrayContents_Char "byteArrayContents#" GenPrimOp
 primop  SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp
    MutableByteArray# s -> MutableByteArray# s -> Int#
 
+primop  ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> State# s
+   {Shrink mutable byte array to new specified size (in bytes), in
+    the specified state thread. The new size argument must be less than or
+    equal to the current size as reported by {\tt sizeofMutableArray\#}.}
+   with out_of_line = True
+        has_side_effects = True
+
+primop  ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #)
+   {Resize (unpinned) mutable byte array to new specified size (in bytes).
+    The returned {\tt MutableByteArray\#} is either the original
+    {\tt MutableByteArray\#} resized in-place or, if not possible, a newly
+    allocated (unpinned) {\tt MutableByteArray\#} (with the original content
+    copied over).
+
+    To avoid undefined behaviour, the original {\tt MutableByteArray\#} shall
+    not be accessed anymore after a {\tt resizeMutableByteArray\#} has been
+    performed.  Moreover, no reference to the old one should be kept in order
+    to allow garbage collection of the original {\tt MutableByteArray\#} in
+    case a new {\tt MutableByteArray\#} had to be allocated.}
+   with out_of_line = True
+        has_side_effects = True
+
 primop  UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp
    MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
    {Make a mutable byte array immutable, without copying.}
diff --git a/includes/Cmm.h b/includes/Cmm.h
index 24bdda3..e62e96f 100644
--- a/includes/Cmm.h
+++ b/includes/Cmm.h
@@ -600,8 +600,11 @@
 
 #if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
 #define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr")
+#define OVERWRITING_CLOSURE_OFS(c,n) \
+    foreign "C" overwritingClosureOfs(c "ptr", n)
 #else
 #define OVERWRITING_CLOSURE(c) /* nothing */
+#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
 #endif
 
 #ifdef THREADED_RTS
diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h
index 3407b71..2a0f197 100644
--- a/includes/rts/storage/ClosureMacros.h
+++ b/includes/rts/storage/ClosureMacros.h
@@ -504,8 +504,11 @@ INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)
 
 #if ZERO_SLOP_FOR_LDV_PROF || ZERO_SLOP_FOR_SANITY_CHECK
 #define OVERWRITING_CLOSURE(c) overwritingClosure(c)
+#define OVERWRITING_CLOSURE_OFS(c,n) \
+    overwritingClosureOfs(c,n)
 #else
 #define OVERWRITING_CLOSURE(c) /* nothing */
+#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
 #endif
 
 #ifdef PROFILING
@@ -534,4 +537,34 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p)
     }
 }
 
+// Version of 'overwritingClosure' which overwrites only a suffix of a
+// closure.  The offset is expressed in words relative to 'p' and shall
+// be less than or equal to closure_sizeW(p), and usually at least as
+// large as the respective thunk header.
+//
+// Note: As this calls LDV_recordDead() you have to call LDV_RECORD()
+//       on the final state of the closure at the call-site
+EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, nat offset);
+EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, nat offset)
+{
+    nat size, i;
+
+#if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
+    // see Note [zeroing slop], also #8402
+    if (era <= 0) return;
+#endif
+
+    size = closure_sizeW(p);
+
+    ASSERT(offset <= size);
+
+    // For LDV profiling, we need to record the closure as dead
+#if defined(PROFILING)
+    LDV_recordDead(p, size);
+#endif
+
+    for (i = offset; i < size; i++)
+        ((StgWord *)p)[i] = 0;
+}
+
 #endif /* RTS_STORAGE_CLOSUREMACROS_H */
diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h
index ee5a119..d2b933d 100644
--- a/includes/stg/MiscClosures.h
+++ b/includes/stg/MiscClosures.h
@@ -347,6 +347,8 @@ RTS_FUN_DECL(stg_casArrayzh);
 RTS_FUN_DECL(stg_newByteArrayzh);
 RTS_FUN_DECL(stg_newPinnedByteArrayzh);
 RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh);
+RTS_FUN_DECL(stg_shrinkMutableByteArrayzh);
+RTS_FUN_DECL(stg_resizzeMutableByteArrayzh);
 RTS_FUN_DECL(stg_casIntArrayzh);
 RTS_FUN_DECL(stg_newArrayzh);
 RTS_FUN_DECL(stg_newArrayArrayzh);
diff --git a/rts/Linker.c b/rts/Linker.c
index 480dc2a..a0ad90c 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1194,6 +1194,8 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_casMutVarzh)                                    \
       SymI_HasProto(stg_newPinnedByteArrayzh)                           \
       SymI_HasProto(stg_newAlignedPinnedByteArrayzh)                    \
+      SymI_HasProto(stg_shrinkMutableByteArrayzh)                       \
+      SymI_HasProto(stg_resizzeMutableByteArrayzh)                      \
       SymI_HasProto(newSpark)                                           \
       SymI_HasProto(performGC)                                          \
       SymI_HasProto(performMajorGC)                                     \
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 5f04a6d..ee50f7f 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -137,6 +137,60 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment )
     return (p);
 }
 
+// shrink size of MutableByteArray in-place
+stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size )
+// MutableByteArray# s -> Int# -> State# s -> State# s
+{
+   ASSERT(new_size >= 0);
+   ASSERT(new_size <= StgArrWords_bytes(mba));
+
+   OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgArrWords) +
+                                 ROUNDUP_BYTES_TO_WDS(new_size)));
+   StgArrWords_bytes(mba) = new_size;
+   LDV_RECORD_CREATE(mba);
+
+   return ();
+}
+
+// resize MutableByteArray
+//
+// The returned MutableByteArray is either the original
+// MutableByteArray resized in-place or, if not possible, a newly
+// allocated (unpinned) MutableByteArray (with the original content
+// copied over)
+stg_resizzeMutableByteArrayzh ( gcptr mba, W_ new_size )
+// MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #)
+{
+   W_ new_size_wds;
+
+   ASSERT(new_size >= 0);
+
+   new_size_wds = ROUNDUP_BYTES_TO_WDS(new_size);
+
+   if (new_size_wds <= BYTE_ARR_WDS(mba)) {
+      OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgArrWords) +
+                                    new_size_wds));
+      StgArrWords_bytes(mba) = new_size;
+      LDV_RECORD_CREATE(mba);
+
+      return (mba);
+   } else {
+      (P_ new_mba) = call stg_newByteArrayzh(new_size);
+
+      // maybe at some point in the future we may be able to grow the
+      // MBA in-place w/o copying if we know the space after the
+      // current MBA is still available, as often we want to grow the
+      // MBA shortly after we allocated the original MBA. So maybe no
+      // further allocations have occurred by then.
+
+      // copy over old content
+      prim %memcpy(BYTE_ARR_CTS(new_mba), BYTE_ARR_CTS(mba),
+                   StgArrWords_bytes(mba), WDS(1));
+
+      return (new_mba);
+   }
+}
+
 // RRN: This one does not use the "ticketing" approach because it
 // deals in unboxed scalars, not heap pointers.
 stg_casIntArrayzh( gcptr arr, W_ ind, W_ old, W_ new )



More information about the ghc-commits mailing list