void cheney(VM *vm) {
int i;
int ar;
char* scan = vm->heap.heap;
while(scan < vm->heap.next) {
size_t inc = *((size_t*)scan);
VAL heap_item = (VAL)(scan+sizeof(size_t));
// If it's a CON or STROFFSET, copy its arguments
switch(GETTY(heap_item)) {
case CON:
ar = ARITY(heap_item);
for(i = 0; i < ar; ++i) {
// printf("Copying %d %p\n", heap_item->info.c.tag, *argptr);
VAL newptr = copy(vm, heap_item->info.c.args[i]);
// printf("Got %p\t\t%p %p\n", newptr, scan, vm->heap_next);
heap_item->info.c.args[i] = newptr;
}
break;
case STROFFSET:
heap_item->info.str_offset->str
= copy(vm, heap_item->info.str_offset->str);
break;
default: // Nothing to copy
break;
}
scan += inc;
}
assert(scan == vm->heap.next);
}
VAL GETBIG(VM * vm, VAL x) {
idris_requireAlloc(IDRIS_MAXGMP);
if (ISINT(x)) {
mpz_t* bigint;
VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
idris_doneAlloc();
bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
mpz_init(*bigint);
mpz_set_si(*bigint, GETINT(x));
SETTY(cl, CT_BIGINT);
cl -> info.ptr = (void*)bigint;
return cl;
} else {
idris_doneAlloc();
switch(GETTY(x)) {
case CT_FWD:
return GETBIG(vm, x->info.ptr);
default:
return x;
}
}
}
void dumpClosureA(Closure* c, int rec) {
c = DO_EVAL(c,0);
switch(GETTY(c)) {
case FUN:
printf("FUN[");
break;
case THUNK:
printf("THUNK[");
break;
case CON:
if (!rec) { printf("CON["); } else { printf("["); }
dumpCon((con*)c->info, rec);
break;
case INT:
if (!rec) { printf("INT[%ld", ((eint)c)>>1); } else { printf("[%ld", ((eint)c)>>1); }
VAL GETBIG(VM * vm, VAL x) {
if (ISINT(x)) {
mpz_t* bigint;
VAL cl = allocate(vm, sizeof(Closure) + sizeof(mpz_t), 0);
bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));
mpz_init(*bigint);
mpz_set_si(*bigint, GETINT(x));
SETTY(cl, BIGINT);
cl -> info.ptr = (void*)bigint;
return cl;
} else {
switch(GETTY(x)) {
case FWD:
return GETBIG(vm, x->info.ptr);
default:
return x;
}
}
}
VAL copy(VM* vm, VAL x) {
int i, ar;
Closure* cl = NULL;
if (x==NULL || ISINT(x)) {
return x;
}
switch(GETTY(x)) {
case CON:
ar = CARITY(x);
if (ar == 0 && CTAG(x) < 256) {
return x;
} else {
allocCon(cl, vm, CTAG(x), ar, 1);
for(i = 0; i < ar; ++i) {
// *argptr = copy(vm, *((VAL*)(x->info.c.args)+i)); // recursive version
cl->info.c.args[i] = x->info.c.args[i];
}
}
break;
case FLOAT:
cl = MKFLOATc(vm, x->info.f);
break;
case STRING:
cl = MKSTRc(vm, x->info.str);
break;
case STROFFSET:
cl = MKSTROFFc(vm, x->info.str_offset);
break;
case BUFFER:
cl = MKBUFFERc(vm, x->info.buf);
break;
case BIGINT:
cl = MKBIGMc(vm, x->info.ptr);
break;
case PTR:
cl = MKPTRc(vm, x->info.ptr);
break;
case MANAGEDPTR:
cl = MKMPTRc(vm, x->info.mptr->data, x->info.mptr->size);
break;
case BITS8:
cl = idris_b8CopyForGC(vm, x);
break;
case BITS16:
cl = idris_b16CopyForGC(vm, x);
break;
case BITS32:
cl = idris_b32CopyForGC(vm, x);
break;
case BITS64:
cl = idris_b64CopyForGC(vm, x);
break;
case FWD:
return x->info.ptr;
default:
break;
}
SETTY(x, FWD);
x->info.ptr = cl;
return cl;
}
VAL copy(VM* vm, VAL x) {
int i, ar;
Closure* cl = NULL;
if (x==NULL || ISINT(x)) {
return x;
}
switch(GETTY(x)) {
case CT_CON:
ar = CARITY(x);
if (ar == 0 && CTAG(x) < 256) {
return x;
} else {
allocCon(cl, vm, CTAG(x), ar, 1);
for(i = 0; i < ar; ++i) {
cl->info.c.args[i] = x->info.c.args[i];
}
}
break;
case CT_FLOAT:
cl = MKFLOATc(vm, x->info.f);
break;
case CT_STRING:
cl = MKSTRc(vm, x->info.str);
break;
case CT_STROFFSET:
cl = MKSTROFFc(vm, x->info.str_offset);
break;
case CT_BIGINT:
cl = MKBIGMc(vm, x->info.ptr);
break;
case CT_PTR:
cl = MKPTRc(vm, x->info.ptr);
break;
case CT_MANAGEDPTR:
cl = MKMPTRc(vm, x->info.mptr->data, x->info.mptr->size);
break;
case CT_BITS8:
cl = idris_b8CopyForGC(vm, x);
break;
case CT_BITS16:
cl = idris_b16CopyForGC(vm, x);
break;
case CT_BITS32:
cl = idris_b32CopyForGC(vm, x);
break;
case CT_BITS64:
cl = idris_b64CopyForGC(vm, x);
break;
case CT_FWD:
return x->info.ptr;
case CT_RAWDATA:
{
size_t size = x->info.size + sizeof(Closure);
cl = allocate(size, 0);
memcpy(cl, x, size);
}
break;
case CT_CDATA:
cl = MKCDATAc(vm, x->info.c_heap_item);
c_heap_mark_item(x->info.c_heap_item);
break;
default:
break;
}
SETTY(x, CT_FWD);
x->info.ptr = cl;
return cl;
}
