#include "factor.h" void dump_generations(void) { int i; for(i = 0; i < GC_GENERATIONS; i++) { fprintf(stderr,"Generation %d: base=%d, size=%d, here=%d\n", i, generations[i].base, generations[i].limit - generations[i].base, generations[i].here); } fprintf(stderr,"Semispace: base=%d, size=%d, here=%d\n", prior.base, prior.limit - prior.base, prior.here); fprintf(stderr,"Cards: base=%d, size=%d\n",cards,cards_end - cards); } CELL init_zone(ZONE *z, CELL size, CELL base) { z->base = z->here = base; z->limit = z->base + size; z->alarm = z->base + (size * 3) / 4; return z->limit; } /* input parameters must be 8 byte aligned */ void init_arena(CELL young_size, CELL aging_size) { CELL total_size = (GC_GENERATIONS - 1) * young_size + 2 * aging_size; CELL cards_size = total_size / CARD_SIZE; heap_start = (CELL)alloc_guarded(total_size); cards = alloc_guarded(cards_size); cards_end = cards + cards_size; clear_cards(); int i; CELL alloter = heap_start; if(heap_start == 0) fatal_error("Cannot allocate data heap",total_size); alloter = init_zone(&generations[TENURED],aging_size,alloter); alloter = init_zone(&prior,aging_size,alloter); for(i = 0; i < GC_GENERATIONS - 1; i++) alloter = init_zone(&generations[i],young_size,alloter); if(alloter != heap_start + total_size) fatal_error("Oops",alloter); allot_profiling = false; gc_in_progress = false; heap_scan = false; gc_time = 0; dump_generations(); } void allot_profile_step(CELL a) { CELL depth = (cs - cs_bot) / CELLS; int i; CELL obj; if(gc_in_progress) return; for(i = profile_depth; i < depth; i++) { obj = get(cs_bot + i * CELLS); if(type_of(obj) == WORD_TYPE) untag_word(obj)->allot_count += a; } if(in_zone(&prior,executing)) critical_error("executing in prior zone",executing); untag_word_fast(executing)->allot_count += a; } void flip_zones() { ZONE z = active; active = prior; prior = z; active.here = active.base; } void primitive_room(void) { box_signed_cell(compiling.limit - compiling.here); box_signed_cell(compiling.limit - compiling.base); box_signed_cell(active.limit - active.here); box_signed_cell(active.limit - active.base); } void primitive_allot_profiling(void) { CELL d = dpop(); if(d == F) allot_profiling = false; else { allot_profiling = true; profile_depth = to_fixnum(d); } } void primitive_address(void) { drepl(tag_bignum(s48_ulong_to_bignum(dpeek()))); } void primitive_size(void) { drepl(tag_fixnum(object_size(dpeek()))); } void primitive_begin_scan(void) { primitive_gc(); heap_scan_ptr = active.base; heap_scan_end = active.here; heap_scan = true; } void primitive_next_object(void) { CELL value = get(heap_scan_ptr); CELL obj = heap_scan_ptr; CELL size, type; if(!heap_scan) general_error(ERROR_HEAP_SCAN,F); if(heap_scan_ptr >= heap_scan_end) { dpush(F); return; } if(headerp(value)) { size = align8(untagged_object_size(heap_scan_ptr)); type = untag_header(value); } else { size = CELLS * 2; type = CONS_TYPE; } heap_scan_ptr += size; if(type < HEADER_TYPE) dpush(RETAG(obj,type)); else dpush(RETAG(obj,OBJECT_TYPE)); } void primitive_end_scan(void) { heap_scan = false; }