bool isCotype(refObject leftType, refObject rightType)
{ while (true)
{ if (isGroundSubtype(leftType, rightType))
{ return true; }
else
{ switch (toHook(car(leftType)))
{ case char0Hook:
{ leftType = char1Simple;
break; }
case char1Hook:
{ return isGroundSubtype(rightType, int2Simple); }
case int0Hook:
{ return isGroundSubtype(rightType, injJoker); }
case int1Hook:
{ return isGroundSubtype(rightType, int2Simple); }
case real0Hook:
{ return isGroundSubtype(rightType, real1Simple); }
case referHook:
{ return
isCar(rightType, rowHook) &&
! isForwarded(leftType) &&
! isForwarded(rightType) &&
isGroundSubtype(cadr(leftType), cadr(rightType)); }
case varHook:
{ leftType = cadr(leftType);
break; }
default:
{ return false; }}}}}
/* allocate an object */
void *ggggc_malloc(struct GGGGC_Descriptor *descriptor)
{
/* FILLME */
ggc_size_t *ret = NULL;
//allocate a pool if no pool
if(!ggggc_fromPoolList){
ggggc_fromPoolList = newPool(1);
ggggc_fromPoolList->generation = 1;
totalYoungSpace += ggggc_fromPoolList->end - ggggc_fromPoolList->start;
ggggc_toPoolList = newPool(1);
ggggc_toPoolList->generation = 3;
totalYoungSpace += ggggc_toPoolList->end - ggggc_toPoolList->start;
ggggc_fromPoolTail = ggggc_fromPoolList;
ggggc_toPoolTail = ggggc_toPoolList;
}
if(!ggggc_curToPool)
ggggc_curToPool = ggggc_toPoolList;
while (ggggc_curToPool){
if (ggggc_curToPool->end - ggggc_curToPool->free >= descriptor->size){
//allocate using free space
ret = (ggc_size_t*)ggggc_curToPool->free;
ggggc_curToPool->free += descriptor->size;
setToZero(ret, descriptor->size);
((struct GGGGC_Header*)ret)->descriptor__ptr = descriptor;
//totalFilled += allocationSizeRounded;
return ret;
}
ggggc_curToPool = ggggc_curToPool -> next;
}
ggggc_collect();
//the descriptor used for allocate sis moved after collect
if(isForwarded((ggc_size_t *)descriptor))
descriptor = (struct GGGGC_Descriptor *)(getForwardingAddress((ggc_size_t *)descriptor));
return ggggc_malloc(descriptor);
//return GC_MALLOC(descriptor->size * sizeof(void*));
}
bool isJokey(refObject type)
{ bool found;
struct
{ refFrame link;
int count;
refObject labeler; } f;
// JOKING. Traverse OBJECT and set FOUND to TRUE if we visit a joker. We use a
// layer LABELER to avoid being trapped inside circular structures.
void joking(refObject term)
{ if (term != nil && isPair(term) && ! gotKey(toss, toss, f.labeler, term))
{ setKey(f.labeler, term, nil, nil);
switch (toHook(car(term)))
{ case arraysHook:
case jokerHook:
case tuplesHook:
{ found = true;
break; }
case referHook:
case rowHook:
{ if (! isForwarded(term))
{ joking(cadr(term)); }
break; }
default:
{ while (! found && term != nil)
{ joking(car(term));
term = cdr(term); }
break; }}}}
// Assume TYPE has no jokers, then try to falsify this assumption.
push(f, 1);
found = false;
f.labeler = pushLayer(nil, plainInfo);
joking(type);
pop();
destroyLayer(f.labeler);
return found; }
void GarbageCollector::processReference(Object *slot)
{
size_t size = SizeOfObject(*slot);
if (size <= 0)
return;
Object obj = *slot;
if (obj == 0) return;
if (from_space_->contains(obj))
{
if (!isForwarded(obj))
{
Object new_obj = swap(obj, size);
forwardTo(obj, new_obj);
*slot = new_obj;
}
else
{
*slot = forwardee(obj);
}
}
}
