-----------------------------------------------------------------------
--- $Id: primops.txt.pp,v 1.1 2001/08/04 06:19:54 ken Exp $
+-- $Id: primops.txt.pp,v 1.2 2001/08/08 10:50:36 simonmar Exp $
--
-- Primitive Operations
--
Int# -> State# s -> (# State# s, MutByteArr# s #)
with out_of_line = True
+primop NewPinnedByteArrayOp_Char "newPinnedByteArray#" GenPrimOp
+ Int# -> State# s -> (# State# s, MutByteArr# s #)
+ with out_of_line = True
+
+primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp
+ ByteArr# -> Addr#
primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp
ByteArr# -> Int# -> Char#
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.79 2001/07/24 06:31:35 ken Exp $
+ * $Id: PrimOps.h,v 1.80 2001/08/08 10:50:37 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
/* and the out-of-line ones... */
EXTFUN_RTS(newByteArrayzh_fast);
+EXTFUN_RTS(newPinnedByteArrayzh_fast);
EXTFUN_RTS(newArrayzh_fast);
+// Highly unsafe, for use with a pinned ByteArray
+// being kept alive with touch#
+#define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
+
/* encoding and decoding of floats/doubles. */
/* We only support IEEE floating point format */
ByteArrayzh
MutableArrayzh
MutableByteArrayzh
-
sameMutableArrayzh
sameMutableByteArrayzh
-
newArrayzh
newByteArrayzh
+ newPinnedByteArrayzh
+ byteArrayContentszh
indexArrayzh
indexCharArrayzh
/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.115 2001/08/07 10:49:49 simonmar Exp $
+ * $Id: GC.c,v 1.116 2001/08/08 10:50:37 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
alloc_HpLim = NULL;
alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
+ // Start a new pinned_object_block
+ pinned_object_block = NULL;
+
/* Free the mark stack.
*/
if (mark_stack_bdescr != NULL) {
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.82 2001/07/26 03:08:39 ken Exp $
+ * $Id: PrimOps.hc,v 1.83 2001/08/08 10:50:37 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
FE_ \
}
+FN_(newPinnedByteArrayzh_fast) \
+ { \
+ W_ size, stuff_size, n; \
+ StgArrWords* p; \
+ FB_ \
+ MAYBE_GC(NO_PTRS,newPinnedByteArrayzh_fast); \
+ n = R1.w; \
+ stuff_size = BYTES_TO_STGWORDS(n); \
+ size = sizeofW(StgArrWords)+ stuff_size; \
+ p = (StgArrWords *)RET_STGCALL1(P_,allocatePinned,size); \
+ TICK_ALLOC_PRIM(sizeofW(StgArrWords),stuff_size,0); \
+ SET_HDR(p, &stg_ARR_WORDS_info, CCCS); \
+ p->words = stuff_size; \
+ TICK_RET_UNBOXED_TUP(1) \
+ RET_P(p); \
+ FE_ \
+ }
+
FN_(newArrayzh_fast)
{
W_ size, n, init;
/* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.43 2001/08/07 09:20:52 simonmar Exp $
+ * $Id: Storage.c,v 1.44 2001/08/08 10:50:37 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
bdescr *small_alloc_list; /* allocate()d small objects */
bdescr *large_alloc_list; /* allocate()d large objects */
+bdescr *pinned_object_block; /* allocate pinned objects into this block */
nat alloc_blocks; /* number of allocate()d blocks since GC */
nat alloc_blocks_lim; /* approximate limit on alloc_blocks */
-------------------------------------------------------------------------- */
StgPtr
-allocate(nat n)
+allocate( nat n )
{
bdescr *bd;
StgPtr p;
return p;
}
-lnat allocated_bytes(void)
+lnat
+allocated_bytes( void )
{
return (alloc_blocks * BLOCK_SIZE_W - (alloc_HpLim - alloc_Hp));
}
+/* ---------------------------------------------------------------------------
+ Allocate a fixed/pinned object.
+
+ We allocate small pinned objects into a single block, allocating a
+ new block when the current one overflows. The block is chained
+ onto the large_object_list of generation 0 step 0.
+
+ NOTE: The GC can't in general handle pinned objects. This
+ interface is only safe to use for ByteArrays, which have no
+ pointers and don't require scavenging. It works because the
+ block's descriptor has the BF_LARGE flag set, so the block is
+ treated as a large object and chained onto various lists, rather
+ than the individual objects being copied. However, when it comes
+ to scavenge the block, the GC will only scavenge the first object.
+ The reason is that the GC can't linearly scan a block of pinned
+ objects at the moment (doing so would require using the
+ mostly-copying techniques). But since we're restricting ourselves
+ to pinned ByteArrays, not scavenging is ok.
+
+ This function is called by newPinnedByteArray# which immediately
+ fills the allocated memory with a MutableByteArray#.
+ ------------------------------------------------------------------------- */
+
+StgPtr
+allocatePinned( nat n )
+{
+ StgPtr p;
+ bdescr *bd = pinned_object_block;
+
+ ACQUIRE_LOCK(&sm_mutex);
+
+ TICK_ALLOC_HEAP_NOCTR(n);
+ CCS_ALLOC(CCCS,n);
+
+ // If the request is for a large object, then allocate()
+ // will give us a pinned object anyway.
+ if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
+ RELEASE_LOCK(&sm_mutex);
+ return allocate(n);
+ }
+
+ // If we don't have a block of pinned objects yet, or the current
+ // one isn't large enough to hold the new object, allocate a new one.
+ if (bd == NULL || (bd->free + n) > (bd->start + BLOCK_SIZE_W)) {
+ pinned_object_block = bd = allocBlock();
+ dbl_link_onto(bd, &g0s0->large_objects);
+ bd->gen_no = 0;
+ bd->step = g0s0;
+ bd->flags = BF_LARGE;
+ bd->free = bd->start;
+ alloc_blocks++;
+ }
+
+ p = bd->free;
+ bd->free += n;
+ RELEASE_LOCK(&sm_mutex);
+ return p;
+}
+
/* -----------------------------------------------------------------------------
Allocation functions for GMP.
/* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.35 2001/07/24 06:31:36 ken Exp $
+ * $Id: Storage.h,v 1.36 2001/08/08 10:50:37 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
/* -----------------------------------------------------------------------------
Generic allocation
- StgPtr allocate(int n) Allocates a chunk of contiguous store
+ StgPtr allocate(nat n) Allocates a chunk of contiguous store
n words long, returning a pointer to
the first word. Always succeeds.
+ StgPtr allocatePinned(nat n) Allocates a chunk of contiguous store
+ n words long, which is at a fixed
+ address (won't be moved by GC).
+ Returns a pointer to the first word.
+ Always succeeds.
+
+ NOTE: the GC can't in general handle
+ pinned objects, so allocatePinned()
+ can only be used for ByteArrays at the
+ moment.
+
Don't forget to TICK_ALLOC_XXX(...)
- after calling allocate, for the
+ after calling allocate or
+ allocatePinned, for the
benefit of the ticky-ticky profiler.
rtsBool doYouWantToGC(void) Returns True if the storage manager is
surrounded by a mutex.
-------------------------------------------------------------------------- */
-extern StgPtr allocate(nat n);
-static inline rtsBool doYouWantToGC(void)
+extern StgPtr allocate ( nat n );
+extern StgPtr allocatePinned ( nat n );
+extern lnat allocated_bytes ( void );
+
+static inline rtsBool
+doYouWantToGC( void )
{
return (alloc_blocks >= alloc_blocks_lim);
}
-extern lnat allocated_bytes(void);
/* -----------------------------------------------------------------------------
ExtendNursery(hp,hplim) When hplim is reached, try to grab
/* -----------------------------------------------------------------------------
- * $Id: StoragePriv.h,v 1.16 2001/08/02 15:33:35 ken Exp $
+ * $Id: StoragePriv.h,v 1.17 2001/08/08 10:50:37 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
extern bdescr *small_alloc_list;
extern bdescr *large_alloc_list;
+extern bdescr *pinned_object_block;
extern StgPtr alloc_Hp;
extern StgPtr alloc_HpLim;
projects / ghc-hetmet.git / commitdiff