conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Reimplemented the guardians collector which was yellowing out since 

the last update to the GC.  All tests now run without a glitch.
This commit is contained in:
Abdulaziz Ghuloum 2008-01-12 17:32:43 -05:00
parent 7a2ac14f5a
commit 2dc4542148
9 changed files with 155 additions and 310 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
scheme/ikarus.io.ss
View File

@ -1418,30 +1418,30 @@
(proc))) (proc)))
(define (standard-input-port) (define (standard-input-port)
(fh->input-port 0 '*stdin* 256 #f #f)) (fh->input-port 0 '*stdin1* 256 #f #f))
(define (standard-output-port) (define (standard-output-port)
(fh->output-port 1 '*stdout* 256 #f #f)) (fh->output-port 1 '*stdout1* 256 #f #f))
(define (standard-error-port) (define (standard-error-port)
(fh->output-port 2 '*stderr* 256 #f #f)) (fh->output-port 2 '*stderr1* 256 #f #f))
(define *the-input-port* (define *the-input-port*
(make-parameter (make-parameter
(transcoded-port (transcoded-port
(fh->input-port 0 '*stdin* input-file-buffer-size #f #f) (fh->input-port 0 '*stdin2* input-file-buffer-size #f #f)
(native-transcoder)))) (native-transcoder))))
(define *the-output-port* (define *the-output-port*
(make-parameter (make-parameter
(transcoded-port (transcoded-port
(fh->output-port 1 '*stdout* output-file-buffer-size #f #f) (fh->output-port 1 '*stdout2* output-file-buffer-size #f #f)
(native-transcoder)))) (native-transcoder))))
(define *the-error-port* (define *the-error-port*
(make-parameter (make-parameter
(transcoded-port (transcoded-port
(fh->output-port 2 '*stderr* output-file-buffer-size #f #f) (fh->output-port 2 '*stderr2* output-file-buffer-size #f #f)
(native-transcoder)))) (native-transcoder))))
(define console-output-port (define console-output-port

2
scheme/ikarus.writer.ss
View File

@ -543,11 +543,13 @@
i] i]
[(output-port? x) [(output-port? x)
(write-char* "#<output-port " p) (write-char* "#<output-port " p)
(write-char* (if (binary-port? p) "(binary)" "(textual)") p)
(let ([i (writer (output-port-name x) p #t h i)]) (let ([i (writer (output-port-name x) p #t h i)])
(write-char #\> p) (write-char #\> p)
i)] i)]
[(input-port? x) [(input-port? x)
(write-char* "#<input-port " p) (write-char* "#<input-port " p)
(write-char* (if (binary-port? p) "(binary)" "(textual)") p)
(let ([i (writer (input-port-name x) p #t h i)]) (let ([i (writer (input-port-name x) p #t h i)])
(write-char #\> p) (write-char #\> p)
i)] i)]

2
scheme/last-revision
View File

@ -1 +1 @@
1337 1338

3
scheme/run-tests.ss
View File

@ -49,8 +49,8 @@
(f 0 536870911000 536870911) (f 0 536870911000 536870911)
(printf "[exact-integer-sqrt] Happy Happy Joy Joy\n")) (printf "[exact-integer-sqrt] Happy Happy Joy Joy\n"))
(test-case-folding)
(test-parse-flonums) (test-parse-flonums)
(test-case-folding)
(test-reader) (test-reader)
(test-char-syntax) (test-char-syntax)
(test-bytevectors) (test-bytevectors)
@ -61,6 +61,7 @@
(test-div-and-mod) (test-div-and-mod)
(test-bignums) (test-bignums)
(test-bignum-length) (test-bignum-length)
(test-fxcarry) (test-fxcarry)
(test-lists) (test-lists)
(test-hashtables) (test-hashtables)

9
scheme/tests/io.ss
View File

@ -66,7 +66,6 @@
(define (test-get-char-1 p n) (define (test-get-char-1 p n)
(let f ([i 0]) (let f ([i 0])
(printf "test-getchar1 ~s\n" i)
(let ([x (get-char p)]) (let ([x (get-char p)])
(cond (cond
[(eof-object? x) [(eof-object? x)
@ -165,14 +164,6 @@
;;; ;;;
(begin
(printf "making transcoder ...\n")
(make-transcoder (latin-1-codec) 'none 'raise)
(printf "making transcoded port ...\n")
(transcoded-port (make-n-byte-bytevector-binary-input-port 256)
(make-transcoder (latin-1-codec) 'none 'raise))
(printf "OK?\n"))
(test "reading 256 latin1 chars from bytevector-input-port" (test "reading 256 latin1 chars from bytevector-input-port"
(test-get-char-1 (test-get-char-1
(transcoded-port (make-n-byte-bytevector-binary-input-port 256) (transcoded-port (make-n-byte-bytevector-binary-input-port 256)

9
scheme/tests/parse-flonums.ss
View File

@ -53,15 +53,6 @@
[else (error 'frac "invalid char" x)]))) [else (error 'frac "invalid char" x)])))
(st)) (st))
;(define (ratnum->flonum x)
; (let f ([n (numerator x)] [d (denominator x)])
; (let-values ([(q r) (quotient+remainder n d)])
; (if (= q 0)
; (/ 1.0 (f d n))
; (if (= r 0)
; (inexact q)
; (+ q (f r d)))))))
(define smallest-flonum (define smallest-flonum
(bytevector-ieee-double-ref (bytevector-ieee-double-ref
#vu8(1 0 0 0 0 0 0 0) #vu8(1 0 0 0 0 0 0 0)

417
src/ikarus-collect.c
View File

@ -98,8 +98,12 @@ typedef struct gc_t{
ikptr tconc_ep; ikptr tconc_ep;
ikptr tconc_base; ikptr tconc_base;
ikpages* tconc_queue; ikpages* tconc_queue;
ik_ptr_page* forward_list;
} gc_t; } gc_t;
static void handle_guardians(gc_t* gc);
static void gc_finalize_guardians(gc_t* gc);
static unsigned int static unsigned int
next_gen_tag[generation_count] = { next_gen_tag[generation_count] = {
(4 << meta_dirty_shift) | 1 | new_gen_tag, (4 << meta_dirty_shift) | 1 | new_gen_tag,
@ -326,10 +330,8 @@ static ikptr add_object_proc(gc_t* gc, ikptr x);
static void collect_stack(gc_t*, ikptr top, ikptr base); static void collect_stack(gc_t*, ikptr top, ikptr base);
static void collect_loop(gc_t*); static void collect_loop(gc_t*);
static void forward_guardians(gc_t*);
static void fix_weak_pointers(gc_t*); static void fix_weak_pointers(gc_t*);
static void gc_add_tconcs(gc_t*); static void gc_add_tconcs(gc_t*);
static void empty_dropped_guardians(gc_t*);
/* ik_collect is called from scheme under the following conditions: /* ik_collect is called from scheme under the following conditions:
* 1. An attempt is made to allocate a small object and the ap is above * 1. An attempt is made to allocate a small object and the ap is above
@ -431,31 +433,24 @@ ik_collect(int mem_req, ikpcb* pcb){
/* next we trace all guardian/guarded objects, /* next we trace all guardian/guarded objects,
the procedure does a collect_loop at the end */ the procedure does a collect_loop at the end */
#ifndef NDEBUG handle_guardians(&gc);
fprintf(stderr, "forwarding guardians ...\n");
#endif
forward_guardians(&gc);
#ifndef NDEBUG #ifndef NDEBUG
fprintf(stderr, "done\n"); fprintf(stderr, "done\n");
#endif #endif
collect_loop(&gc); collect_loop(&gc);
//guardians_loop_old(&gc);
/* does not allocate, only bwp's dead pointers */ /* does not allocate, only bwp's dead pointers */
fix_weak_pointers(&gc); fix_weak_pointers(&gc);
/* now deallocate all unused pages */ /* now deallocate all unused pages */
deallocate_unused_pages(&gc); deallocate_unused_pages(&gc);
fix_new_pages(&gc); fix_new_pages(&gc);
gc_finalize_guardians(&gc);
pcb->allocation_pointer = pcb->heap_base; pcb->allocation_pointer = pcb->heap_base;
/* does not allocate */ /* does not allocate */
gc_add_tconcs(&gc); gc_add_tconcs(&gc);
/* does not allocate */ /* does not allocate */
#ifndef NDEBUG
fprintf(stderr, "emptying guardians ...\n");
#endif
empty_dropped_guardians(&gc);
#ifndef NDEBUG #ifndef NDEBUG
fprintf(stderr, "done\n"); fprintf(stderr, "done\n");
#endif #endif
@ -598,292 +593,158 @@ next_gen(int i){
return ((i == generation_count) ? generation_count : (i+1)); return ((i == generation_count) ? generation_count : (i+1));
} }
static ik_ptr_page* static ik_ptr_page*
move_guardian(ikptr x, ik_ptr_page* dst, ik_ptr_page** cache){ move_tconc(ikptr tc, ik_ptr_page* ls){
if((dst == 0) || (dst->count == ik_ptr_page_size)){ if((ls == NULL) || (ls->count == ik_ptr_page_size)){
ik_ptr_page* y = *cache; ik_ptr_page* page = (ik_ptr_page*)ik_mmap(pagesize);
if(y){ page->count = 0;
*cache = y->next; page->next = ls;
ls = page;
}
ls->ptr[ls->count++] = tc;
return ls;
}
static void
handle_guardians(gc_t* gc){
ikpcb* pcb = gc->pcb;
ik_ptr_page* pend_hold_list = 0;
ik_ptr_page* pend_final_list = 0;
int gen;
/* sort protected pairs into pend_hold and pend_final lists */
for(gen=0; gen<=gc->collect_gen; gen++){
ik_ptr_page* prot_list = pcb->protected_list[gen];
pcb->protected_list[gen] = 0;
while(prot_list){
int i;
for(i=0; i<prot_list->count; i++){
ikptr p = prot_list->ptr[i];
ikptr tc = ref(p, off_car);
ikptr obj = ref(p, off_cdr);
if(tc == forward_ptr){
ikptr np = ref(p, off_cdr);
tc = ref(np, off_car);
obj = ref(np, off_cdr);
}
if(is_live(obj, gc)){
pend_hold_list = move_tconc(p, pend_hold_list);
} else {
pend_final_list = move_tconc(p, pend_final_list);
}
}
ik_ptr_page* next = prot_list->next;
ik_munmap((ikptr)prot_list, pagesize);
prot_list = next;
}
}
/* move live tc pend_final_list pairs into final_list,
the rest remain in pend_final_list,
final_list objects are made live and collected in
gc->forward_list */
gc->forward_list = 0;
int done = 0;
while(!done){
ik_ptr_page* final_list = 0;
ik_ptr_page* ls = pend_final_list;
pend_final_list = 0;
while(ls){
int i;
for(i=0; i<ls->count; i++){
ikptr p = ls->ptr[i];
ikptr tc = ref(p, off_car);
if(tc == forward_ptr){
ikptr np = ref(p, off_cdr);
tc = ref(np, off_car);
}
if(is_live(tc, gc)){
final_list = move_tconc(p, final_list);
} else {
pend_final_list = move_tconc(p, pend_final_list);
}
}
ik_ptr_page* next = ls->next;
ik_munmap((ikptr)ls, pagesize);
ls = next;
}
if(final_list == NULL){
done = 1;
} else { } else {
y = (ik_ptr_page*)(long)ik_mmap(sizeof(ik_ptr_page)); ls = final_list;
} while(ls){
y->count = 0; int i;
y->next = dst; for(i=0; i<ls->count; i++){
dst = y; ikptr p = ls->ptr[i];
} gc->forward_list =
dst->ptr[dst->count++] = x; move_tconc(add_object(gc, p, "guardian"),
return dst; gc->forward_list);
}
static int
forward_guardians_initial(gc_t* gc,
ik_ptr_page** cache,
ik_ptr_page** dead_tc_dead_obj_list,
ik_ptr_page** live_tc_dead_obj_list,
ik_ptr_page** dead_tc_live_obj_list,
ik_ptr_page** live_tc_live_obj_list){
int gen;
int seen_live_tc_dead_obj = 0;
ikpcb* pcb = gc->pcb;
/* move guardians[0..g] to dead/live lists */
for(gen=0; gen<=gc->collect_gen; gen++){
ik_ptr_page* src = pcb->guardians[gen];
ik_ptr_page* dead_dead = 0;
ik_ptr_page* dead_live = 0;
ik_ptr_page* live_dead = 0;
ik_ptr_page* live_live = 0;
while(src){
int i;
int n = src->count;
for(i=0; i<n; i++){
ikptr a = src->ptr[i];
ikptr tc = ref(a, off_car);
ikptr obj = ref(a, off_cdr);
if(is_live(tc, gc)){
if(is_live(obj, gc)){
live_live = move_guardian(a, live_live, cache);
} else {
live_dead = move_guardian(a, live_dead, cache);
}
} else {
if(is_live(obj, gc)){
dead_live = move_guardian(a, dead_live, cache);
} else {
dead_dead = move_guardian(a, dead_dead, cache);
}
} }
ik_ptr_page* next = ls->next;
ik_munmap((ikptr)ls, pagesize);
ls = next;
} }
ik_ptr_page* next = src->next;
src->next = *cache;
*cache = src;
src = next;
}
if(live_dead) {
seen_live_tc_dead_obj = 1;
}
dead_tc_dead_obj_list[gen] = dead_dead;
live_tc_dead_obj_list[gen] = live_dead;
dead_tc_live_obj_list[gen] = dead_live;
live_tc_live_obj_list[gen] = live_live;
pcb->guardians[gen] = 0;
}
return seen_live_tc_dead_obj;
}
static void
forward_guardians_revive_dead(gc_t* gc,
ik_ptr_page** live_tc_dead_obj_list){
int gen;
for(gen=0; gen<=gc->collect_gen; gen++){
ik_ptr_page* src = live_tc_dead_obj_list[gen];
while(src){
int i;
int n = src->count;
for(i=0; i<n; i++){
ikptr a = src->ptr[i];
ikptr obj = ref(a, off_cdr);
add_object(gc, obj, "guardian1");
}
src = src->next;
}
}
}
static int
forward_guardians_process_tconcs(gc_t* gc,
ik_ptr_page** cache,
ik_ptr_page** dead_tc_dead_obj_list,
ik_ptr_page** live_tc_dead_obj_list,
ik_ptr_page** dead_tc_live_obj_list,
ik_ptr_page** live_tc_live_obj_list){
int gen;
int some_were_revived = 0;
/* objects in dead_tc_live_obj_list whos tconcs have become
alive must move to live_tc_live_obj list */
for(gen=0; gen<=gc->collect_gen; gen++){
ik_ptr_page* src = dead_tc_live_obj_list[gen];
ik_ptr_page* live = live_tc_live_obj_list[gen];
ik_ptr_page* dead = 0;
while(src){
int i;
int n = src->count;
for(i=0; i<n; i++){
ikptr a = src->ptr[i];
ikptr tc = ref(a, off_car);
if(is_live(tc, gc)){
live = move_guardian(a, live, cache);
} else {
dead = move_guardian(a, dead, cache);
}
}
ik_ptr_page* next = src->next;
src->next = *cache;
*cache = src;
src = next;
}
live_tc_live_obj_list[gen] = live;
dead_tc_live_obj_list[gen] = dead;
}
/* objects in dead_tc_dead_obj_list whos tconcs have become
alive must move to live_tc_dead_obj list
obj must be resurrected */
for(gen=0; gen<=gc->collect_gen; gen++){
ik_ptr_page* src = dead_tc_dead_obj_list[gen];
ik_ptr_page* dead = 0;
ik_ptr_page* live = live_tc_dead_obj_list[gen];
while(src){
int i;
int n = src->count;
for(i=0; i<n; i++){
ikptr a = src->ptr[i];
ikptr tc = ref(a, off_car);
if(is_live(tc, gc)){
some_were_revived = 1;
add_object(gc, ref(a, off_cdr), "guardian2");
live = move_guardian(a, live, cache);
} else {
dead = move_guardian(a, dead, cache);
}
}
ik_ptr_page* next = src->next;
src->next = *cache;
*cache = src;
src = next;
}
live_tc_dead_obj_list[gen] = live;
dead_tc_dead_obj_list[gen] = dead;
}
return some_were_revived;
}
static void
forward_guardians(gc_t* gc){
ikpcb* pcb = gc->pcb;
ik_ptr_page* dead_tc_dead_obj_list[generation_count];
ik_ptr_page* live_tc_dead_obj_list[generation_count];
ik_ptr_page* dead_tc_live_obj_list[generation_count];
ik_ptr_page* live_tc_live_obj_list[generation_count];
ik_ptr_page* cache = 0;
int seen_live_tc_dead_obj =
forward_guardians_initial(gc, &cache,
dead_tc_dead_obj_list, live_tc_dead_obj_list,
dead_tc_live_obj_list, live_tc_live_obj_list);
if (seen_live_tc_dead_obj){
/* objects in live_tc_dead_obj_list must be revived */
forward_guardians_revive_dead(gc, live_tc_dead_obj_list);
int some_were_revived = 1;
while(some_were_revived){
collect_loop(gc); collect_loop(gc);
some_were_revived =
forward_guardians_process_tconcs(gc, &cache,
dead_tc_dead_obj_list, live_tc_dead_obj_list,
dead_tc_live_obj_list, live_tc_live_obj_list);
} }
} }
/* dead_tc_dead_obj_list and dead_tc_live_obj_list must go away */ /* pend_final_list now contains things that are dead and
int gen; their tconcs are also dead, deallocate */
for(gen=0; gen<=gc->collect_gen; gen++){ while(pend_final_list){
ik_ptr_page* src,* dst; ik_ptr_page* next = pend_final_list->next;
src = dead_tc_dead_obj_list[gen]; ik_munmap((ikptr)pend_final_list, pagesize);
while(src){ pend_final_list = next;
ik_ptr_page* next = src->next; }
src->next = cache; /* pend_hold_list pairs with live tconcs are moved to
cache = src; the protected list of next generation. */
src = next; ik_ptr_page* target = pcb->protected_list[next_gen(gc->collect_gen)];
} while(pend_hold_list){
src = dead_tc_live_obj_list[gen]; int i;
while(src){ for(i=0; i<pend_hold_list->count; i++){
ik_ptr_page* next = src->next; ikptr p = pend_hold_list->ptr[i];
src->next = cache; ikptr tc = ref(p, off_car);
cache = src; if(tc == forward_ptr){
src = next; ikptr np = ref(p, off_cdr);
} tc = ref(np, off_car);
/* make all pairs in live_tc_dead_obj live */
src = live_tc_dead_obj_list[gen];
pcb->guardians_dropped[gen] = src;
while(src){
int i;
int n = src->count;
for(i=0; i<n; i++){
src->ptr[i] =
add_object(gc, src->ptr[i], "guardian3");
} }
src = src->next; if(is_live(tc, gc)){
} target = move_tconc(add_object(gc, p, "guardian"), target);
/* make all pairs in live_tc_live_obj live and
add them to next gen */
src = live_tc_live_obj_list[gen];
dst = pcb->guardians[next_gen(gen)];
while(src){
int i;
int n = src->count;
for(i=0; i<n; i++){
dst = move_guardian(add_object(gc, src->ptr[i], "g4"), dst, &cache);
} }
ik_ptr_page* next = src->next;
src->next = cache;
cache = src;
src = next;
} }
pcb->guardians[next_gen(gen)] = dst; ik_ptr_page* next = pend_hold_list->next;
ik_munmap((ikptr)pend_hold_list, pagesize);
pend_hold_list = next;
} }
collect_loop(gc); collect_loop(gc);
while(cache){ pcb->protected_list[next_gen(gc->collect_gen)] = target;
ik_ptr_page* next = cache->next;
ik_munmap((ikptr)(long)cache, sizeof(ik_ptr_page));
cache = next;
}
} }
static void static void
empty_dropped_guardians(gc_t* gc){ gc_finalize_guardians(gc_t* gc){
ikpcb* pcb = gc->pcb; ik_ptr_page* ls = gc->forward_list;
int gen; int tconc_count = 0;
for(gen = 0; gen<=gc->collect_gen; gen++){ unsigned int* dirty_vec = (unsigned int*)(long)gc->pcb->dirty_vector;
ik_ptr_page* src = pcb->guardians_dropped[gen]; while(ls){
while(src){ int i;
int i; for(i=0; i<ls->count; i++){
int n = src->count; tconc_count++;
for(i=0; i<n; i++){ ikptr p = ls->ptr[i];
ikptr a = src->ptr[i]; ikptr tc = ref(p, off_car);
ikptr tc = ref(a, off_car); ikptr obj = ref(p, off_cdr);
ikptr obj = ref(a, off_cdr); ikptr last_pair = ref(tc, off_cdr);
assert(tagof(tc) == pair_tag); ref(last_pair, off_car) = obj;
ikptr d = ref(tc, off_cdr); ref(last_pair, off_cdr) = p;
assert(tagof(d) == pair_tag); ref(p, off_car) = false_object;
ref(d, off_car) = obj; ref(p, off_cdr) = false_object;
ref(d, off_cdr) = a; ref(tc, off_cdr) = p;
ref(a, off_car) = false_object; dirty_vec[page_index(tc)] = -1;
ref(a, off_cdr) = false_object; dirty_vec[page_index(last_pair)] = -1;
ref(tc, off_cdr) = a;
((int*)(long)pcb->dirty_vector)[page_index(tc)] = -1;
//pcb->dirty_vector[page_index(d)] = -1;
{
int dgen = pcb->segment_vector[page_index(d)] & gen_mask;
if( (dgen > (pcb->segment_vector[page_index(obj)] & gen_mask))
||
(dgen > (pcb->segment_vector[page_index(a)] & gen_mask))){
((int*)(long)pcb->dirty_vector)[page_index(d)] = -1;
}
}
}
ik_ptr_page* next = src->next;
ik_munmap((ikptr)(long)src, sizeof(ik_ptr_page));
src = next;
} }
pcb->guardians_dropped[gen] = 0; ik_ptr_page* next = ls->next;
ik_munmap((ikptr)ls, pagesize);
ls = next;
} }
} }
#define CODE_EXTENSION_SIZE (pagesize)
static int alloc_code_count = 0; static int alloc_code_count = 0;

3
src/ikarus-data.h
View File

@ -156,8 +156,7 @@ typedef struct ikpcb{
int stack_size; int stack_size;
ikptr symbol_table; ikptr symbol_table;
ikptr gensym_table; ikptr gensym_table;
ik_ptr_page* guardians[generation_count]; ik_ptr_page* protected_list[generation_count];
ik_ptr_page* guardians_dropped[generation_count];
unsigned int* dirty_vector_base; unsigned int* dirty_vector_base;
unsigned int* segment_vector_base; unsigned int* segment_vector_base;
ikptr memory_base; ikptr memory_base;

6
src/ikarus-runtime.c
View File

@ -376,7 +376,7 @@ void ik_delete_pcb(ikpcb* pcb){
{ {
int i; int i;
for(i=0; i<generation_count; i++){ for(i=0; i<generation_count; i++){
ik_ptr_page* p = pcb->guardians[i]; ik_ptr_page* p = pcb->protected_list[i];
while(p){ while(p){
ik_ptr_page* next = p->next; ik_ptr_page* next = p->next;
ik_munmap((ikptr)(long)p, pagesize); ik_munmap((ikptr)(long)p, pagesize);
@ -795,13 +795,13 @@ ikrt_bvftime(ikptr outbv, ikptr fmtbv){
ikptr ikptr
ikrt_register_guardian_pair(ikptr p0, ikpcb* pcb){ ikrt_register_guardian_pair(ikptr p0, ikpcb* pcb){
ik_ptr_page* x = pcb->guardians[0]; ik_ptr_page* x = pcb->protected_list[0];
if((x == NULL) || (x->count == ik_ptr_page_size)){ if((x == NULL) || (x->count == ik_ptr_page_size)){
assert(sizeof(ik_ptr_page) == pagesize); assert(sizeof(ik_ptr_page) == pagesize);
ik_ptr_page* y = (ik_ptr_page*)(long)ik_mmap(pagesize); ik_ptr_page* y = (ik_ptr_page*)(long)ik_mmap(pagesize);
y->count = 0; y->count = 0;
y->next = x; y->next = x;
pcb->guardians[0] = y; pcb->protected_list[0] = y;
x = y; x = y;
} }
x->ptr[x->count++] = p0; x->ptr[x->count++] = p0;