void *GC_malloc_weak_box(void *p, void **secondary, int soffset, int is_late)
{
GCTYPE *gc = GC_get_GC();
GC_Weak_Box *w;
/* Allcation might trigger GC, so we use park: */
CHECK_PARK_UNUSED(gc);
gc->park[0] = p;
gc->park[1] = secondary;
w = (GC_Weak_Box *)GC_malloc_one_tagged(sizeof(GC_Weak_Box));
/* Future-local allocation may fail: */
if (!w) return NULL;
p = gc->park[0];
secondary = (void **)gc->park[1];
gc->park[0] = NULL;
gc->park[1] = NULL;
w->type = gc->weak_box_tag;
w->val = p;
w->secondary_erase = secondary;
w->is_late = is_late;
w->soffset = soffset;
return w;
}
inline static void BTC_register_thread(void *t, void *c)
{
NewGC *gc = GC_get_GC();
GC_Thread_Info *work;
work = ((Scheme_Thread *)t)->gc_info;
work->owner = current_owner(gc, (Scheme_Custodian *)c);
}
inline static void BTC_register_thread(void *t, void *c)
{
NewGC *gc = GC_get_GC();
GC_Thread_Info *work;
if (((Scheme_Object *)t)->type == scheme_thread_type)
work = ((Scheme_Thread *)t)->gc_info;
else
work = ((Scheme_Place *)t)->gc_info;
work->owner = current_owner(gc, (Scheme_Custodian *)c);
}
int GC_dbg_dump_mpage_for_p(void *p) {
NewGC *gc = GC_get_GC();
mpage *page = pagemap_find_page(gc->page_maps, p);
if (page) {
GC_dbg_dump_mpage(page);
return 1;
}
else {
printf("Not allocated by the GC\n");
return 0;
}
}
void GC_add_roots(void *start, void *end)
{
GCTYPE *gc = GC_get_GC();
Roots *roots = &gc->roots;
if (roots->count >= roots->size) {
grow_roots(roots);
}
roots->roots[roots->count++] = ROOTS_PTR_TO_INT(start);
roots->roots[roots->count++] = ROOTS_PTR_TO_INT(end) - ROOTS_PTR_ALIGNMENT;
roots->nothing_new = 0;
}
inline static void BTC_register_new_thread(void *t, void *c)
{
NewGC *gc = GC_get_GC();
GC_Thread_Info *work;
work = (GC_Thread_Info *)ofm_malloc(sizeof(GC_Thread_Info));
((Scheme_Thread *)t)->gc_info = work;
work->owner = current_owner(gc, (Scheme_Custodian *)c);
work->thread = t;
work->next = gc->thread_infos;
gc->thread_infos = work;
}
static uintptr_t BTC_get_account_hook(void *c1)
{
NewGC *gc = GC_get_GC();
uintptr_t mem;
if (!gc->really_doing_accounting)
return 0;
mem = custodian_single_time_limit(gc, custodian_to_owner_set(gc, c1));
if (mem == (uintptr_t)(intptr_t)-1)
return 0;
return mem;
}
int GC_is_live(void *p)
{
NewGC *gc = GC_get_GC();
mpage *page = pagemap_find_page(gc->page_maps, p);
if (!page) { /* NOT GC ALLOCATED */
printf("%p page: %p NOT GC ALLOCATED\n", p, page);
fflush(stdout);
return 0;
}
else if (page->generation == 0) {
if (page == gc->gen0.curr_alloc_page) {
if (p < (void*) GC_gen0_alloc_page_ptr) {
printf("GEN0 object %p page: %p gen: %i class: %i ALIVE\n", p, page, page->generation, page->size_class);
printf("%p BEGIN: %p ALLOCED_UPTO: %p END: %p\n", p, (void*) gc->gen0.curr_alloc_page->addr, (void*) GC_gen0_alloc_page_ptr, (void*) GC_gen0_alloc_page_end);
fflush(stdout);
return 1;
}
else {
printf("GEN0 object %p page: %p gen: %i class: %i DEAD\n", p, page, page->generation, page->size_class);
printf("%p BEGIN: %p ALLOCED_UPTO: %p END: %p\n", p, (void*) gc->gen0.curr_alloc_page->addr, (void*) GC_gen0_alloc_page_ptr, (void*) GC_gen0_alloc_page_end);
fflush(stdout);
return 0;
}
}
return NUM(p) < (NUM(page->addr) + page->size);
}
else { /* page->generation */
if (page->size_class == 1) {
int dead = OBJPTR_TO_OBJHEAD(p)->dead;
printf("MEDIUM object %p page: %p gen: %i class: %i dead: %i\n", p, page, page->generation, page->size_class, dead);
fflush(stdout);
return !dead;
}
else if((NUM(page->addr) + page->size) > NUM(p)) {
printf("%p page: %p gen: %i class: %i ALIVE\n", p, page, page->generation, page->size_class);
printf("%p BEGIN: %p ALLOCED_UPTO: %p\n", p, (void*) page->addr, (void*) (NUM(page->addr) + page->size));
fflush(stdout);
return 1;
}
else {
printf("%p page: %p gen: %i class: %i DEAD\n", p, page, page->generation, page->size_class);
printf("%p BEGIN: %p ALLOCED_UPTO: %p\n", p, (void*) page->addr, (void*) (NUM(page->addr) + page->size));
fflush(stdout);
return 0;
}
}
}
inline static void BTC_add_account_hook(int type,void *c1,void *c2,uintptr_t b)
{
NewGC *gc = GC_get_GC();
AccountHook *work;
if(!gc->really_doing_accounting) {
if (!gc->avoid_collection) {
CHECK_PARK_UNUSED(gc);
gc->park[0] = c1;
gc->park[1] = c2;
gc->really_doing_accounting = 1;
garbage_collect(gc, 1, 0, 0, NULL);
c1 = gc->park[0]; gc->park[0] = NULL;
c2 = gc->park[1]; gc->park[1] = NULL;
}
}
if (type == MZACCT_LIMIT)
gc->reset_limits = 1;
if (type == MZACCT_REQUIRE)
gc->reset_required = 1;
for(work = gc->hooks; work; work = work->next) {
if((work->type == type) && (work->c2 == c2) && (work->c1 == c1)) {
if(type == MZACCT_REQUIRE) {
if(b > work->amount) work->amount = b;
} else { /* (type == MZACCT_LIMIT) */
if(b < work->amount) work->amount = b;
}
break;
}
}
if(!work) {
work = ofm_malloc(sizeof(AccountHook));
work->type = type;
work->c1 = c1;
work->c2 = c2;
work->amount = b;
/* push work onto hooks */
work->next = gc->hooks;
gc->hooks = work;
}
}
void BTC_register_root_custodian(void *_c)
{
NewGC *gc = GC_get_GC();
Scheme_Custodian *c = (Scheme_Custodian *)_c;
if (gc->owner_table) {
/* Reset */
ofm_free(gc->owner_table, sizeof(OTEntry*) * gc->owner_table_size);
gc->owner_table = NULL;
gc->owner_table_size = 0;
}
if (create_blank_owner_set(gc) != 1) {
GCPRINT(GCOUTF, "Something extremely weird (and bad) has happened.\n");
abort();
}
gc->owner_table[1]->originator = c;
c->gc_owner_set = 1;
}
void *GC_malloc_weak_array(size_t size_in_bytes, void *replace_val)
{
GCTYPE *gc = GC_get_GC();
GC_Weak_Array *w;
/* Allcation might trigger GC, so we use park: */
gc->park[0] = replace_val;
w = (GC_Weak_Array *)GC_malloc_one_tagged(size_in_bytes
+ sizeof(GC_Weak_Array)
- sizeof(void *));
replace_val = gc->park[0];
gc->park[0] = NULL;
w->type = gc->weak_array_tag;
w->replace_val = replace_val;
w->count = (size_in_bytes >> LOG_WORD_SIZE);
return w;
}
void *GC_malloc_ephemeron(void *k, void *v)
{
GCTYPE *gc = GC_get_GC();
GC_Ephemeron *eph;
/* Allcation might trigger GC, so we use park: */
gc->park[0] = k;
gc->park[1] = v;
eph = (GC_Ephemeron *)GC_malloc_one_tagged(sizeof(GC_Ephemeron));
k = gc->park[0];
v = gc->park[1];
gc->park[0] = NULL;
gc->park[1] = NULL;
eph->type = gc->ephemeron_tag;
eph->key = k;
eph->val = v;
return eph;
}
void GC_set_finalizer(void *p, int tagged, int level, void (*f)(void *p, void *data),
void *data, void (**oldf)(void *p, void *data),
void **olddata)
{
GCTYPE *gc = GC_get_GC();
Fnl *fnl;
if (!is_finalizable_page(gc, p)) {
/* Never collected. Don't finalize it. */
if (oldf) *oldf = NULL;
if (olddata) *olddata = NULL;
return;
}
gc->splayed_gen0_finalizers = fnl_splay((intptr_t)p, gc->splayed_gen0_finalizers);
fnl = gc->splayed_gen0_finalizers;
if (!fnl || (fnl->p != p)) {
gc->splayed_finalizers = fnl_splay((intptr_t)p, gc->splayed_finalizers);
fnl = gc->splayed_finalizers;
if (!fnl || (fnl->p != p))
fnl = NULL;
else {
/* since we're mutating this finalizer, move it to the gen0 list and tree */
remove_finalizer(fnl, 0, gc);
add_finalizer(fnl, 1, gc);
}
}
if (fnl && (fnl->p == p)) {
if (oldf) *oldf = fnl->f;
if (olddata) *olddata = fnl->data;
if (f) {
fnl->f = f;
fnl->data = data;
fnl->eager_level = level;
} else {
/* remove finalizer */
remove_finalizer(fnl, 1, gc);
--gc->num_fnls;
}
return;
}
if (oldf) *oldf = NULL;
if (olddata) *olddata = NULL;
if (!f)
return;
/* Allcation might trigger GC, so we use park: */
CHECK_PARK_UNUSED(gc);
gc->park[0] = p;
gc->park[1] = data;
fnl = (Fnl *)GC_malloc_atomic(sizeof(Fnl));
memset(fnl, 0, sizeof(Fnl));
p = gc->park[0];
data = gc->park[1];
gc->park[0] = NULL;
gc->park[1] = NULL;
fnl->p = p;
fnl->f = f;
fnl->data = data;
fnl->eager_level = level;
fnl->tagged = tagged;
#if CHECKS
{
MPage *m;
m = find_page(p);
if (tagged) {
if ((m->type != MTYPE_TAGGED)
|| (m->type != MTYPE_PAIR)) {
GCPRINT(GCOUTF, "Not tagged: %lx (%d)\n",
(intptr_t)p, m->type);
CRASH(4);
}
}
}
#endif
add_finalizer(fnl, 1, gc);
gc->num_fnls++;
}
