/* minor-gc.c
*
* COPYRIGHT (c) 1993 by AT&T Bell Laboratories.
*
* This is the code for doing minor collections (i.e., collecting the
* allocation arena).
*/
#include "ml-base.h"
#include "ml-limits.h"
#include "ml-state.h"
#include "ml-values.h"
#include "ml-objects.h"
#include "card-map.h"
#include "heap.h"
#include "tags.h"
#include "copy-loop.h"
#ifdef MP_SUPPORT
#include "vproc-state.h"
#endif
#ifdef GC_STATS
extern long numUpdates;
extern long numBytesAlloc;
extern long numBytesCopied;
#endif
/** store list operations */
#define STL_nil ML_unit
#define STL_hd(p) REC_SELPTR(ml_val_t, p, 0)
#define STL_tl(p) REC_SEL(p, 1)
/* local routines */
PVT void MinorGC_ScanStoreList (heap_t *heap, ml_val_t stl);
PVT void MinorGC_SweepToSpace (gen_t *gen1);
PVT ml_val_t MinorGC_ForwardObj (gen_t *gen1, ml_val_t v);
PVT ml_val_t MinorGC_FwdSpecial (gen_t *gen1, ml_val_t *obj, ml_val_t desc);
#ifdef VERBOSE
extern char *ArenaName[];
#endif
/* Check a word for a allocation space reference */
#ifndef NO_GC_INLINE
#define MinorGC_CheckWord(bibop, g1, p) { \
ml_val_t __w = *(p); \
if (isBOXED(__w) && (ADDR_TO_PAGEID(bibop, __w) == AID_NEW)) \
*(p) = MinorGC_ForwardObj(g1, __w); \
}
#else
PVT void MinorGC_CheckWord (bibop_t bibop, gen_t *g1, ml_val_t *p)
{
ml_val_t w = *(p);
if (isBOXED(w)) {
aid_t aid = ADDR_TO_PAGEID(bibop, w);
if (aid == AID_NEW)
*(p) = MinorGC_ForwardObj(g1, w);
}
}
#endif
/* MinorGC:
*
* Do a collection of the allocation space.
*/
void MinorGC (ml_state_t *msp, ml_val_t **roots)
{
heap_t *heap = msp->ml_heap;
gen_t *gen1 = heap->gen[0];
#ifdef GC_STATS
long nbytesAlloc, nbytesCopied, nUpdates=numUpdates;
Addr_t gen1Top[NUM_ARENAS];
int i;
{
nbytesAlloc = (Addr_t)(msp->ml_allocPtr) - (Addr_t)(heap->allocBase);
CNTR_INCR(&(heap->numAlloc), nbytesAlloc);
for (i = 0; i < NUM_ARENAS; i++)
gen1Top[i] = (Addr_t)(gen1->arena[i]->nextw);
}
#elif defined(VM_STATS)
{
Addr_t nbytesAlloc;
nbytesAlloc = ((Addr_t)(msp->ml_allocPtr) - (Addr_t)(heap->allocBase));
CNTR_INCR(&(heap->numAlloc), nbytesAlloc);
}
#endif
#ifdef VERBOSE
{
int i;
SayDebug ("Generation 1 before MinorGC:\n");
for (i = 0; i < NUM_ARENAS; i++) {
SayDebug (" %s: base = %#x, oldTop = %#x, nextw = %#x\n",
ArenaName[i+1], gen1->arena[i]->tospBase,
gen1->arena[i]->oldTop, gen1->arena[i]->nextw);
}
}
#endif
/* scan the standard roots */
{
ml_val_t *rp;
bibop_t bibop = BIBOP;
while ((rp = *roots++) != NIL(ml_val_t *)) {
MinorGC_CheckWord(bibop, gen1, rp);
}
}
/* Scan the store list */
#ifdef MP_SUPPORT
{
ml_val_t stl;
int i;
ml_state_t *msp;
vproc_state_t *vsp;
for (i = 0; i < MAX_NUM_PROCS; i++) {
vsp = VProc[i];
msp = vsp->vp_state;
if ((vsp->vp_mpState == MP_PROC_RUNNING)
&& ((stl = msp->ml_storePtr) != STL_nil)) {
MinorGC_ScanStoreList (heap, stl);
msp->ml_storePtr = STL_nil;
}
}
}
#else
{
ml_val_t stl = msp->ml_storePtr;
if (stl != STL_nil) {
MinorGC_ScanStoreList (heap, stl);
msp->ml_storePtr = STL_nil;
}
}
#endif
/* Sweep the first generation to-space */
MinorGC_SweepToSpace (gen1);
heap->numMinorGCs++;
/* Handle weak pointers */
if (heap->weakList != NIL(ml_val_t *))
ScanWeakPtrs (heap);
#ifdef VERBOSE
{
int i;
SayDebug ("Generation 1 after MinorGC:\n");
for (i = 0; i < NUM_ARENAS; i++) {
SayDebug (" %s: base = %#x, oldTop = %#x, nextw = %#x\n",
ArenaName[i+1], gen1->arena[i]->tospBase,
gen1->arena[i]->oldTop, gen1->arena[i]->nextw);
}
}
#endif
#ifdef GC_STATS
{
int nbytes;
nbytesCopied = 0;
for (i = 0; i < NUM_ARENAS; i++) {
nbytes = ((Word_t)(gen1->arena[i]->nextw) - gen1Top[i]);
nbytesCopied += nbytes;
CNTR_INCR(&(heap->numCopied[0][i]), nbytes);
}
numBytesAlloc += nbytesAlloc;
numBytesCopied += nbytesCopied;
#ifdef XXX
SayDebug ("Minor GC: %d/%d (%5.2f%%) bytes copied; %d updates\n",
nbytesCopied, nbytesAlloc,
(nbytesAlloc ? (double)(100*nbytesCopied)/(double)nbytesAlloc : 0.0),
numUpdates-nUpdates);
#endif
}
#endif
#ifdef CHECK_HEAP
CheckHeap(heap, 1);
#endif
} /* end of MinorGC. */
/* MinorGC_ScanStoreList:
*
* Scan the store list. The store list pointer (stl) is guaranteed to
* be non-null.
*/
PVT void MinorGC_ScanStoreList (heap_t *heap, ml_val_t stl)
{
ml_val_t *addr, w;
gen_t *gen1 = heap->gen[0];
bibop_t bibop = BIBOP;
#ifdef GC_STATS
int nUpdates = 0;
#endif
/* Scan the store list */
do {
#ifdef GC_STATS
nUpdates++;
#endif
addr = STL_hd(stl);
stl = STL_tl(stl);
w = *addr;
if (isBOXED(w)) {
aid_t srcId = ADDR_TO_PAGEID(bibop, addr);
/* We can ignore updates to objects in new-space, and to references
* in the runtime system references (ie, UNMAPPED)
*/
if ((srcId != AID_NEW) && (! isUNMAPPED(srcId))) {
/* srcGen is the generation of the updated cell; dstGen is the
* generation of the object that the cell points to.
*/
int srcGen = EXTRACT_GEN(srcId);
aid_t dstId = ADDR_TO_PAGEID(bibop, w);
int dstGen = EXTRACT_GEN(dstId);
if (IS_BIGOBJ_AID(dstId)) {
int i;
bigobj_region_t *region;
bigobj_desc_t *dp;
if (dstGen >= srcGen)
continue;
for (i = BIBOP_ADDR_TO_INDEX(w); !BO_IS_HDR(dstId); dstId = BIBOP[--i])
continue;
region = (bigobj_region_t *)BIBOP_INDEX_TO_ADDR(i);
dp = ADDR_TO_BODESC(region, w);
dstGen = dp->gen;
}
else {
if (dstGen == ALLOC_GEN) {
/* The refered to object is in allocation space, and will be
* forwarded to the first generation.
*/
dstGen = 1;
*addr = MinorGC_ForwardObj(gen1, w);
}
}
if (srcGen > dstGen) {
/* mark the card containing "addr" */
#ifndef BIT_CARDS
MARK_CARD(heap->gen[srcGen-1]->dirty, addr, dstGen);
#else
MARK_CARD(heap->gen[srcGen-1]->dirty, addr);
#endif
}
}
}
} while (stl != STL_nil);
#ifdef GC_STATS
numUpdates += nUpdates;
#endif
} /* end MinorGC_ScanStoreList */
/* MinorGC_SweepToSpace:
*
* Sweep the first generation's to-space. Note, that since there are
* no younger objects, we don't have to do anything special for the
* array space.
*/
PVT void MinorGC_SweepToSpace (gen_t *gen1)
{
bibop_t bibop = BIBOP;
bool_t swept;
#define MinorGC_SweepToSpArena(indx) { \
arena_t *__ap = gen1->arena[(indx)]; \
ml_val_t *__p, *__q; \
__p = __ap->sweep_nextw; \
if (__p < __ap->nextw) { \
swept = TRUE; \
do { \
for (__q = __ap->nextw; __p < __q; __p++) \
MinorGC_CheckWord(bibop, gen1, __p); \
} while (__q != __ap->nextw); \
__ap->sweep_nextw = __q; \
} \
} /* MinorGC_SweepToSpArena */
do {
swept = FALSE;
/* Sweep the record, pair and array arenas */
MinorGC_SweepToSpArena(RECORD_INDX);
MinorGC_SweepToSpArena(PAIR_INDX);
MinorGC_SweepToSpArena(ARRAY_INDX);
} while (swept);
} /* end of MinorGC_SweepToSpace. */
/* MinorGC_ForwardObj:
*
* Forward an object from the allocation space to the first generation.
*/
PVT ml_val_t MinorGC_ForwardObj (gen_t *gen1, ml_val_t v)
{
ml_val_t *obj = PTR_MLtoC(ml_val_t, v);
ml_val_t *new_obj, desc;
Word_t len;
arena_t *arena;
desc = obj[-1];
switch (GET_TAG(desc)) {
case DTAG_record:
len = GET_LEN(desc);
#ifdef NO_PAIR_STRIP
arena = gen1->arena[RECORD_INDX];
#else
if (len == 2) {
arena = gen1->arena[PAIR_INDX];
new_obj = arena->nextw;
arena->nextw += 2;
new_obj[0] = obj[0];
new_obj[1] = obj[1];
/* setup the forward pointer in the old pair */
obj[-1] = DESC_forwarded;
obj[0] = (ml_val_t)(Addr_t)new_obj;
return PTR_CtoML(new_obj);
}
else
arena = gen1->arena[RECORD_INDX];
#endif
break;
case DTAG_vec_hdr:
case DTAG_arr_hdr:
len = 2;
arena = gen1->arena[RECORD_INDX];
break;
case DTAG_arr_data:
len = GET_LEN(desc);
arena = gen1->arena[ARRAY_INDX];
break;
case DTAG_raw32:
len = GET_LEN(desc);
arena = gen1->arena[STRING_INDX];
break;
case DTAG_raw64:
len = GET_LEN(desc);
arena = gen1->arena[STRING_INDX];
#ifdef ALIGN_REALDS
# ifdef CHECK_HEAP
if (((Addr_t)arena->nextw & WORD_SZB) == 0) {
*(arena->nextw) = (ml_val_t)0;
arena->nextw++;
}
# else
arena->nextw = (ml_val_t *)(((Addr_t)arena->nextw) | WORD_SZB);
# endif
#endif
break;
case DTAG_special:
return MinorGC_FwdSpecial (gen1, obj, desc);
case DTAG_forward:
return PTR_CtoML(FOLLOW_FWDOBJ(obj));
default:
Die ("bad object tag %d, obj = %#x, desc = %#x", GET_TAG(desc), obj, desc);
} /* end of switch */
/* Allocate and initialize a to-space copy of the object */
new_obj = arena->nextw;
arena->nextw += (len + 1);
*new_obj++ = desc;
ASSERT(arena->nextw <= arena->tospTop);
COPYLOOP(obj, new_obj, len);
/* set up the forward pointer, and return the new object. */
obj[-1] = DESC_forwarded;
obj[0] = (ml_val_t)(Addr_t)new_obj;
return PTR_CtoML(new_obj);
} /* end of MinorGC_ForwardObj */
/* MinorGC_FwdSpecial:
*
* Forward a special object (suspension, weak pointer, ...).
*/
PVT ml_val_t MinorGC_FwdSpecial (gen_t *gen1, ml_val_t *obj, ml_val_t desc)
{
arena_t *arena = gen1->arena[ARRAY_INDX];
ml_val_t *new_obj = arena->nextw;
arena->nextw += SPECIAL_SZW; /* all specials are two words */
switch (GET_LEN(desc)) {
case SPCL_evaled_susp:
case SPCL_unevaled_susp:
*new_obj++ = desc;
*new_obj = *obj;
break;
case SPCL_weak: {
ml_val_t v = *obj;
#ifdef DEBUG_WEAK_PTRS
SayDebug ("MinorGC: weak [%#x ==> %#x] --> %#x", obj, new_obj+1, v);
#endif
if (! isBOXED(v)) {
#ifdef DEBUG_WEAK_PTRS
SayDebug (" unboxed\n");
#endif
/* weak references to unboxed objects are never nullified */
*new_obj++ = DESC_weak;
*new_obj = v;
}
else {
aid_t aid = ADDR_TO_PAGEID(BIBOP, v);
ml_val_t *vp = PTR_MLtoC(ml_val_t, v);
if (aid == AID_NEW) {
if (vp[-1] == DESC_forwarded) {
/* Reference to an object that has already been forwarded.
* NOTE: we have to put the pointer to the non-forwarded
* copy of the object (i.e, v) into the to-space copy
* of the weak pointer, since the GC has the invariant
* it never sees to-space pointers during sweeping.
*/
#ifdef DEBUG_WEAK_PTRS
SayDebug (" already forwarded to %#x\n", PTR_CtoML(FOLLOW_FWDOBJ(vp)));
#endif
*new_obj++ = DESC_weak;
*new_obj = v;
}
else {
/* the forwarded version of weak objects are threaded
* via their descriptor fields. We mark the object
* reference field to make it look like an unboxed value,
* so that the to-space sweeper does not follow the weak
* reference.
*/
#ifdef DEBUG_WEAK_PTRS
SayDebug (" forward\n");
#endif
*new_obj = MARK_PTR(PTR_CtoML(gen1->heap->weakList));
gen1->heap->weakList = new_obj++;
*new_obj = MARK_PTR(vp);
}
}
else {
/* reference to an older object */
#ifdef DEBUG_WEAK_PTRS
SayDebug (" old object\n");
#endif
*new_obj++ = DESC_weak;
*new_obj = v;
}
}
} break;
case SPCL_null_weak: /* shouldn't happen in the allocation arena */
default:
Die ("strange/unexpected special object @ %#x; desc = %#x\n", obj, desc);
} /* end of switch */
obj[-1] = DESC_forwarded;
obj[0] = (ml_val_t)(Addr_t)new_obj;
return PTR_CtoML(new_obj);
} /* end of MinorGC_FwdSpecial */
syntax highlighted by Code2HTML, v. 0.9.1