Commit 246436f1 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

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
parent d39c434a
......@@ -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.}
......
......@@ -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
......
......@@ -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 */
......@@ -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);
......
......@@ -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) \
......
......@@ -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 )
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment