set-phantom-bytes!: fix tracking across generations

This commit is contained in:
Matthew Flatt 2015-09-08 15:27:46 -06:00
parent 33bb5e9060
commit 261b7bde28
3 changed files with 16 additions and 7 deletions

View File

@ -277,10 +277,10 @@ GC2_EXTERN int GC_is_on_allocated_page(void *p);
the GC allocates objects (although p may or may not
be a valid pointer to the start of an alloctaed object). */
GC2_EXTERN int GC_allocate_phantom_bytes(intptr_t);
GC2_EXTERN int GC_allocate_phantom_bytes(void *pb, intptr_t);
/*
Returns 0 if allocation should fail due to a memory limit,
1 otherwise. */
1 otherwise. The representative `pb` determines who is charged. */
/***************************************************************************/
/* Memory tracing */

View File

@ -1656,9 +1656,10 @@ uintptr_t add_no_overflow(uintptr_t a, uintptr_t b)
return c;
}
int GC_allocate_phantom_bytes(intptr_t request_size_bytes)
int GC_allocate_phantom_bytes(void *pb, intptr_t request_size_bytes)
{
NewGC *gc = GC_get_GC();
mpage *page;
#ifdef NEWGC_BTC_ACCOUNT
if (request_size_bytes > 0) {
@ -1674,14 +1675,22 @@ int GC_allocate_phantom_bytes(intptr_t request_size_bytes)
/* overflow */
return 1;
gc->gen0_phantom_count += request_size_bytes;
page = pagemap_find_page(gc->page_maps, pb);
/* adjust `gc->memory_in_use', but protect against {over,under}flow: */
if (request_size_bytes < 0) {
request_size_bytes = -request_size_bytes;
if (gc->memory_in_use > request_size_bytes)
gc->memory_in_use -= request_size_bytes;
} else
if (!page || (page->generation != AGE_GEN_1)) {
if (gc->gen0_phantom_count > request_size_bytes)
gc->gen0_phantom_count -= request_size_bytes;
}
} else {
if (!page || (page->generation != AGE_GEN_1))
gc->gen0_phantom_count = add_no_overflow(gc->gen0_phantom_count, request_size_bytes);
gc->memory_in_use = add_no_overflow(gc->memory_in_use, request_size_bytes);
}
/* If we've allocated enough phantom bytes, then force a GC */
if (gc->gen0_phantom_count > GEN0_MAX_SIZE)

View File

@ -8309,7 +8309,7 @@ static Scheme_Object *make_phantom_bytes(int argc, Scheme_Object *argv[])
pb->size = SCHEME_INT_VAL(argv[0]);
# ifdef MZ_PRECISE_GC
if (!GC_allocate_phantom_bytes(pb->size))
if (!GC_allocate_phantom_bytes(pb, pb->size))
scheme_raise_out_of_memory("make-phantom-bytes", NULL);
# endif
@ -8330,7 +8330,7 @@ static Scheme_Object *set_phantom_bytes(int argc, Scheme_Object *argv[])
amt = SCHEME_INT_VAL(argv[1]);
# ifdef MZ_PRECISE_GC
if (!GC_allocate_phantom_bytes(amt - pb->size))
if (!GC_allocate_phantom_bytes(pb, amt - pb->size))
scheme_raise_out_of_memory("make-phantom-bytes", NULL);
# endif