diff --git a/bin/ikarus b/bin/ikarus index 1b10991..bb76219 100755 Binary files a/bin/ikarus and b/bin/ikarus differ diff --git a/bin/ikarus-collect.c b/bin/ikarus-collect.c index a802770..bb6022d 100644 --- a/bin/ikarus-collect.c +++ b/bin/ikarus-collect.c @@ -57,7 +57,7 @@ static int extension_amount[meta_count] = { 1 * pagesize, 1 * pagesize, 1 * pagesize, - 1 * pagesize + 1 * pagesize, }; static unsigned int meta_mt[meta_count] = { @@ -149,6 +149,43 @@ gc_alloc_new_ptr(int size, int old_gen, gc_t* gc){ return meta_alloc(size, old_gen, gc, meta_ptrs); } +static inline ikp +gc_alloc_new_large_ptr(int size, int old_gen, gc_t* gc){ + int memreq = align_to_next_page(size); + ikp mem = + ik_mmap_typed(memreq, + pointers_mt | large_object_tag | next_gen_tag[old_gen], + gc->pcb); + gc->segment_vector = gc->pcb->segment_vector; + qupages_t* p = ik_malloc(sizeof(qupages_t)); + p->p = mem; + p->q = mem+size; + bzero(mem+size, memreq-size); + p->next = gc->queues[meta_ptrs]; + gc->queues[meta_ptrs] = p; + return mem; +} + + +static inline void +enqueue_large_ptr(ikp mem, int size, int old_gen, gc_t* gc){ + int i = page_index(mem); + int j = page_index(mem+size-1); + while(i<=j){ + gc->segment_vector[i] = + pointers_mt | large_object_tag | next_gen_tag[old_gen]; + i++; + } + qupages_t* p = ik_malloc(sizeof(qupages_t)); + p->p = mem; + p->q = mem+size; + p->next = gc->queues[meta_ptrs]; + gc->queues[meta_ptrs] = p; +} + + + + #if 0 static inline ikp gc_alloc_new_symbol(int old_gen, gc_t* gc){ @@ -221,6 +258,9 @@ gc_alloc_new_code(int size, int old_gen, gc_t* gc){ } } + + + static void gc_tconc_push_extending(gc_t* gc, ikp tcbucket){ if(gc->tconc_base){ @@ -989,16 +1029,32 @@ add_object_proc(gc_t* gc, ikp x) int size = (int)fst; assert(size >= 0); int memreq = align(size + disp_vector_data); - ikp y = gc_alloc_new_ptr(memreq, gen, gc) + vector_tag; - ref(y, disp_vector_length-vector_tag) = fst; - ref(y, memreq-vector_tag-wordsize) = 0; - memcpy(y+off_vector_data, x+off_vector_data, size); - ref(x,-vector_tag) = forward_ptr; - ref(x,wordsize-vector_tag) = y; + if(memreq >= pagesize){ + if((t & large_object_mask) == large_object_tag){ + enqueue_large_ptr(x-vector_tag, size+disp_vector_data, gen, gc); + return x; + } else { + ikp y = gc_alloc_new_large_ptr(size+disp_vector_data, gen, gc) + + vector_tag; + ref(y, disp_vector_length-vector_tag) = fst; + ref(y, memreq-vector_tag-wordsize) = 0; + memcpy(y+off_vector_data, x+off_vector_data, size); + ref(x,-vector_tag) = forward_ptr; + ref(x,wordsize-vector_tag) = y; + return y; + } + } else { + ikp y = gc_alloc_new_ptr(memreq, gen, gc) + vector_tag; + ref(y, disp_vector_length-vector_tag) = fst; + ref(y, memreq-vector_tag-wordsize) = 0; + memcpy(y+off_vector_data, x+off_vector_data, size); + ref(x,-vector_tag) = forward_ptr; + ref(x,wordsize-vector_tag) = y; + return y; + } #if accounting vector_count++; #endif - return y; } else if(fst == symbol_record_tag){ ikp y = gc_alloc_new_symbol_record(gen, gc) + record_tag; diff --git a/bin/ikarus.h b/bin/ikarus.h index 78a4c4e..01e70cd 100644 --- a/bin/ikarus.h +++ b/bin/ikarus.h @@ -14,21 +14,22 @@ extern int hash_table_count; #define most_bytes_in_minor 0x10000000 -#define old_gen_mask 0x00000007 -#define new_gen_mask 0x00000008 -#define gen_mask 0x0000000F -#define new_gen_tag 0x00000008 -#define meta_dirty_mask 0x000000F0 -#define type_mask 0x00000F00 -#define scannable_mask 0x0000F000 -#define dealloc_mask 0x000F0000 +#define old_gen_mask 0x00000007 +#define new_gen_mask 0x00000008 +#define gen_mask 0x0000000F +#define new_gen_tag 0x00000008 +#define meta_dirty_mask 0x000000F0 +#define type_mask 0x00000F00 +#define scannable_mask 0x0000F000 +#define dealloc_mask 0x000F0000 +#define large_object_mask 0x00100000 #define meta_dirty_shift 4 #define hole_type 0x00000000 #define mainheap_type 0x00000100 #define mainstack_type 0x00000200 #define pointers_type 0x00000300 -#define dat_type 0x00000400 +#define dat_type 0x00000400 #define code_type 0x00000500 #define weak_pairs_type 0x00000600 #define symbols_type 0x00000700 @@ -39,6 +40,8 @@ extern int hash_table_count; #define dealloc_tag 0x00010000 #define retain_tag 0x00000000 +#define large_object_tag 0x00100000 + #define hole_mt (hole_type | unscannable_tag | retain_tag) #define mainheap_mt (mainheap_type | unscannable_tag | retain_tag) #define mainstack_mt (mainstack_type | unscannable_tag | retain_tag) diff --git a/src/ikarus.boot b/src/ikarus.boot index aa602d3..b8190c7 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ