Commit 52c07834 authored by simonmar's avatar simonmar
Browse files

[project @ 2001-08-08 10:50:36 by simonmar]

Had a brainwave on the way to work this morning, and realised that the
garbage collector can handle "pinned objects" as long as they don't
contain any pointers.

This is absolutely ideal for doing temporary allocation in the FFI,
because what we really want to do is allocate a pinned ByteArray and
let the GC clean it up later.  So this set of changes adds the
required framework.

There are two new primops:

 newPinnedByteArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #)
 byteArrayContents#  :: ByteArr# -> Addr#

obviously byteArrayContents# is highly unsafe.

Allocating a pinned ByteArr# isn't the default, because a pinned
ByteArr# will hold an entire block (currently 4k) live until it is
garbage collected (that doesn't mean each pinned ByteArr# requires
4k of storage, just that if a block contains a single live pinned
ByteArray, the whole block must be retained).
parent 1cc01ada
-----------------------------------------------------------------------
-- $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
--
......@@ -534,6 +534,12 @@ primop NewByteArrayOp_Char "newByteArray#" GenPrimOp
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
*
......@@ -664,8 +664,13 @@ EXTFUN_RTS(unsafeThawArrayzh_fast);
/* 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 */
......
......@@ -228,12 +228,12 @@ __export PrelGHC
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
*
......@@ -794,6 +794,9 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
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
*
......@@ -263,6 +263,24 @@ FN_(newByteArrayzh_fast) \
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
*
......@@ -29,6 +29,7 @@ StgClosure *caf_list = NULL;
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 */
......@@ -408,7 +409,7 @@ resizeNursery ( nat blocks )
-------------------------------------------------------------------------- */
StgPtr
allocate(nat n)
allocate( nat n )
{
bdescr *bd;
StgPtr p;
......@@ -459,11 +460,71 @@ allocate(nat n)
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
*
......@@ -24,12 +24,24 @@ extern void exitStorage(void);
/* -----------------------------------------------------------------------------
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
......@@ -43,12 +55,15 @@ extern void exitStorage(void);
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
*
......@@ -33,6 +33,7 @@ extern StgClosure *caf_list;
extern bdescr *small_alloc_list;
extern bdescr *large_alloc_list;
extern bdescr *pinned_object_block;
extern StgPtr alloc_Hp;
extern StgPtr alloc_HpLim;
......
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