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 uintptr_t custodian_usage(NewGC*gc, void *custodian)
{
OTEntry **owner_table;
uintptr_t retval = 0;
int i;
if(!gc->really_doing_accounting) {
if (!gc->avoid_collection) {
CHECK_PARK_UNUSED(gc);
gc->park[0] = custodian;
gc->really_doing_accounting = 1;
garbage_collect(gc, 1, 0, 0, NULL);
custodian = gc->park[0];
gc->park[0] = NULL;
}
}
i = custodian_to_owner_set(gc, (Scheme_Custodian *)custodian);
owner_table = gc->owner_table;
if (owner_table[i])
retval = (owner_table[i]->memory_use + owner_table[i]->master_memory_use);
else
retval = 0;
return gcWORDS_TO_BYTES(retval);
}
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 *GC_malloc_ephemeron(void *k, void *v)
{
GCTYPE *gc = GC_get_GC();
GC_Ephemeron *eph;
/* Allcation might trigger GC, so we use park: */
CHECK_PARK_UNUSED(gc);
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_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: */
CHECK_PARK_UNUSED(gc);
gc->park[0] = replace_val;
w = (GC_Weak_Array *)GC_malloc_one_tagged(size_in_bytes
+ sizeof(GC_Weak_Array)
- sizeof(void *)
+ sizeof(GC_Weak_Array *));
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_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++;
}
