* fixed bug in handling tcbuckets.

Summary of the bug:  
    if ik_alloc is called during gc, and if it causes a heap
    overflow, then the pages are deallocated before returning to
    scheme.
This commit is contained in:
Abdulaziz Ghuloum 2007-01-19 18:13:44 -05:00
parent 8b1236e031
commit c8111df150
4 changed files with 18 additions and 12 deletions

2
BUGS
View File

@ -11,4 +11,4 @@
interrupted. interrupted.
> >
Two displays occurred at the end. Two displays occurred at the end.

Binary file not shown.

View File

@ -320,6 +320,9 @@ ik_collect(int mem_req, ikpcb* pcb){
gc.collect_gen, pcb->collection_id-1); gc.collect_gen, pcb->collection_id-1);
#endif #endif
/* cache heap-pages to delete later */
ikpages* old_heap_pages = pcb->heap_pages;
pcb->heap_pages = 0;
/* the roots are: /* the roots are:
* 0. dirty pages not collected in this run * 0. dirty pages not collected in this run
@ -327,6 +330,7 @@ ik_collect(int mem_req, ikpcb* pcb){
* 2. the next continuation * 2. the next continuation
* 3. the symbol-table * 3. the symbol-table
*/ */
scan_dirty_pages(&gc); scan_dirty_pages(&gc);
collect_stack(&gc, pcb->frame_pointer, pcb->frame_base - wordsize); collect_stack(&gc, pcb->frame_pointer, pcb->frame_base - wordsize);
pcb->next_k = add_object(&gc, pcb->next_k, "next_k"); pcb->next_k = add_object(&gc, pcb->next_k, "next_k");
@ -400,15 +404,15 @@ ik_collect(int mem_req, ikpcb* pcb){
} }
/* delete all old heap pages */ /* delete all old heap pages */
if(pcb->heap_pages){ if(old_heap_pages){
ikpages* p = pcb->heap_pages; ikpages* p = old_heap_pages;
do{ do{
ikpages* next = p->next; ikpages* next = p->next;
ik_munmap_from_segment(p->base, p->size, pcb); ik_munmap_from_segment(p->base, p->size, pcb);
ik_free(p, sizeof(ikpages)); ik_free(p, sizeof(ikpages));
p=next; p=next;
} while(p); } while(p);
pcb->heap_pages = 0; old_heap_pages = 0;
} }
int free_space = int free_space =
@ -1621,6 +1625,7 @@ fix_new_pages(gc_t* gc){
} }
} }
static void static void
add_one_tconc(ikpcb* pcb, ikp tcbucket){ add_one_tconc(ikpcb* pcb, ikp tcbucket){
ikp tc = ref(tcbucket, off_tcbucket_tconc); ikp tc = ref(tcbucket, off_tcbucket_tconc);

View File

@ -5109,14 +5109,15 @@
(newline) (newline)
(for-each (lambda (x) (printf " ~s\n" x)) ls)) (for-each (lambda (x) (printf " ~s\n" x)) ls))
ls*))) ls*)))
(let ([code* (list*->code* (let ([code*
(lambda (x) (list*->code*
(if (closure? x) (lambda (x)
(if (null? (closure-free* x)) (if (closure? x)
(code-loc-label (closure-code x)) (if (null? (closure-free* x))
(error 'compile "BUG: non-thunk escaped: ~s" x)) (code-loc-label (closure-code x))
#f)) (error 'compile "BUG: non-thunk escaped: ~s" x))
ls*)]) #f))
ls*)])
(car code*))))) (car code*)))))
(define compile-file (define compile-file