| 132 |
} |
} |
| 133 |
|
|
| 134 |
|
|
|
/* Mark values recursively. |
|
|
Marked values are not collected by the GC. */ |
|
|
inline void gc_mark(value *val) |
|
|
{ |
|
|
if(val==NULL || val->gc.flag.mark) |
|
|
return; |
|
|
|
|
|
val->gc.flag.mark= 1; |
|
|
|
|
|
if(val->type==tcons) { |
|
|
gc_mark(CAR(val)); |
|
|
gc_mark(CDR(val)); |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
/* Start GC */ |
|
|
extern void gc_init(environment *env) |
|
|
{ |
|
|
stackitem *new_head= NULL, *titem; |
|
|
symbol *tsymb; |
|
|
int i; |
|
|
|
|
|
if(env->interactive) |
|
|
printf("Garbage collecting."); |
|
|
|
|
|
/* Mark values on stack */ |
|
|
gc_mark(env->head); |
|
|
|
|
|
if(env->interactive) |
|
|
printf("."); |
|
|
|
|
|
/* Mark values in hashtable */ |
|
|
for(i= 0; i<HASHTBLSIZE; i++) |
|
|
for(tsymb= env->symbols[i]; tsymb!=NULL; tsymb= tsymb->next) |
|
|
if (tsymb->val != NULL) |
|
|
gc_mark(tsymb->val); |
|
|
|
|
|
if(env->interactive) |
|
|
printf("."); |
|
|
|
|
|
env->gc_count= 0; |
|
|
|
|
|
while(env->gc_ref!=NULL) { /* Sweep unused values */ |
|
|
if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */ |
|
|
|
|
|
/* Remove content */ |
|
|
switch(env->gc_ref->item->type){ |
|
|
case string: |
|
|
free(env->gc_ref->item->content.string); |
|
|
break; |
|
|
case tcons: |
|
|
free(env->gc_ref->item->content.c); |
|
|
break; |
|
|
case port: |
|
|
case empty: |
|
|
case unknown: |
|
|
case integer: |
|
|
case tfloat: |
|
|
case func: |
|
|
case symb: |
|
|
/* Symbol strings are freed when walking the hash table */ |
|
|
break; |
|
|
} |
|
|
|
|
|
free(env->gc_ref->item); /* Remove from gc_ref */ |
|
|
titem= env->gc_ref->next; |
|
|
free(env->gc_ref); /* Remove value */ |
|
|
env->gc_ref= titem; |
|
|
continue; |
|
|
} |
|
|
|
|
|
#ifdef DEBUG |
|
|
printf("Kept value (%p)", env->gc_ref->item); |
|
|
if(env->gc_ref->item->gc.flag.mark) |
|
|
printf(" (marked)"); |
|
|
if(env->gc_ref->item->gc.flag.protect) |
|
|
printf(" (protected)"); |
|
|
switch(env->gc_ref->item->type){ |
|
|
case integer: |
|
|
printf(" integer: %d", env->gc_ref->item->content.i); |
|
|
break; |
|
|
case func: |
|
|
printf(" func: %p", env->gc_ref->item->content.func); |
|
|
break; |
|
|
case symb: |
|
|
printf(" symb: %s", env->gc_ref->item->content.sym->id); |
|
|
break; |
|
|
case tcons: |
|
|
printf(" tcons: %p\t%p", CAR(env->gc_ref->item), |
|
|
CDR(env->gc_ref->item)); |
|
|
break; |
|
|
default: |
|
|
printf(" <unknown %d>", (env->gc_ref->item->type)); |
|
|
} |
|
|
printf("\n"); |
|
|
#endif /* DEBUG */ |
|
|
|
|
|
/* Keep values */ |
|
|
env->gc_count += sizeof(value); |
|
|
if(env->gc_ref->item->type==string) |
|
|
env->gc_count += strlen(env->gc_ref->item->content.string)+1; |
|
|
|
|
|
titem= env->gc_ref->next; |
|
|
env->gc_ref->next= new_head; |
|
|
new_head= env->gc_ref; |
|
|
new_head->item->gc.flag.mark= 0; |
|
|
env->gc_ref= titem; |
|
|
} |
|
|
|
|
|
if (env->gc_limit < env->gc_count*2) |
|
|
env->gc_limit= env->gc_count*2; |
|
|
|
|
|
env->gc_ref= new_head; |
|
|
|
|
|
if(env->interactive) |
|
|
printf("done (%d bytes still allocated)\n", env->gc_count); |
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
inline void gc_maybe(environment *env) |
|
|
{ |
|
|
if(env->gc_count < env->gc_limit) |
|
|
return; |
|
|
else |
|
|
return gc_init(env); |
|
|
} |
|
|
|
|
|
|
|
|
/* Protect values from GC */ |
|
|
void protect(value *val) |
|
|
{ |
|
|
if(val==NULL || val->gc.flag.protect) |
|
|
return; |
|
|
|
|
|
val->gc.flag.protect= 1; |
|
|
|
|
|
if(val->type==tcons) { |
|
|
protect(CAR(val)); |
|
|
protect(CDR(val)); |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
|
/* Unprotect values from GC */ |
|
|
void unprotect(value *val) |
|
|
{ |
|
|
if(val==NULL || !(val->gc.flag.protect)) |
|
|
return; |
|
|
|
|
|
val->gc.flag.protect= 0; |
|
|
|
|
|
if(val->type==tcons) { |
|
|
unprotect(CAR(val)); |
|
|
unprotect(CDR(val)); |
|
|
} |
|
|
} |
|
|
|
|
|
|
|
| 135 |
/* Push a value onto the stack */ |
/* Push a value onto the stack */ |
| 136 |
void push_val(environment *env, value *val) |
void push_val(environment *env, value *val) |
| 137 |
{ |
{ |
Parent Directory
| 
Revision Log
| 
Patch