CC = gcc
-#DEFAULT_CFLAGS = -Wall -O3 -fomit-frame-pointer $(SITE_CFLAGS)
-DEFAULT_CFLAGS = -g
+DEFAULT_CFLAGS = -Wall -O3 -fomit-frame-pointer $(SITE_CFLAGS)
+#DEFAULT_CFLAGS = -g
DEFAULT_LIBS = -lm
-#STRIP = strip
-STRIP = touch
+STRIP = strip
+#STRIP = touch
UNIX_OBJS = native/unix/file.o \
native/unix/signal.o \
[ "set-datastack" "kernel" " ds -- " ]
[ "set-callstack" "kernel" " cs -- " ]
[ "exit" "kernel" [ [ integer ] [ ] ] ]
- [ "room" "memory" [ [ ] [ integer integer integer integer ] ] ]
+ [ "room" "memory" [ [ ] [ integer integer general-list ] ] ]
[ "os-env" "kernel" [ [ string ] [ object ] ] ]
[ "millis" "kernel" [ [ ] [ integer ] ] ]
[ "(random-int)" "math" [ [ ] [ integer ] ] ]
: save
#! Save the current image.
"image" get save-image ;
-
+
! Printing an overview of heap usage.
: kb. 1024 /i unparse write " KB" write ;
: room. ( -- )
room
- "Data space: " write (room.)
+ 0 swap [
+ "Generation " write over unparse write ": " write
+ uncons (room.) 1 +
+ ] each drop
"Code space: " write (room.) ;
! Some words for iterating through the heap.
copy_handle(&userenv[i]);
}
-void clear_cards(void)
-{
- BYTE *ptr;
- for(ptr = cards; ptr < cards_end; ptr++)
- clear_card(ptr);
-}
-
-void collect_cards(void)
-{
- BYTE *ptr;
- for(ptr = cards; ptr < cards_end; ptr++)
- {
- CARD c = *ptr;
- if(card_marked(*ptr))
- {
- CELL offset = (c & CARD_BASE_MASK);
- if(offset == 0x7f)
- critical_error("bad card",c);
- CELL ea = (CELL)CARD_TO_ADDR(c) + offset;
- printf("write barrier hit %d\n",offset);
- printf("object header: %x\n",get(ea));
- clear_card(ptr);
- }
- }
-}
-
/*
Given a pointer to a tagged pointer to oldspace, copy it to newspace.
If the object has already been copied, return the forwarding
return scan + size;
}
-void primitive_gc(void)
+void clear_cards(void)
+{
+ BYTE *ptr;
+ for(ptr = cards; ptr < cards_end; ptr++)
+ clear_card(ptr);
+}
+
+/* scan all the objects in the card */
+void collect_card(CARD *ptr)
+{
+ CARD c = *ptr;
+ CELL offset = (c & CARD_BASE_MASK);
+ CELL card_scan = (CELL)CARD_TO_ADDR(ptr) + offset;
+ CELL card_end = (CELL)CARD_TO_ADDR(ptr + 1);
+
+ if(offset == 0x7f)
+ critical_error("bad card",c);
+
+ printf("! write barrier hit %d\n",offset);
+ while(card_scan < card_end)
+ card_scan = collect_next(card_scan);
+
+ clear_card(ptr);
+}
+
+void collect_gen_cards(CELL gen)
+{
+ CARD *ptr = ADDR_TO_CARD(generations[gen].base);
+ CARD *last_card = ADDR_TO_CARD(generations[gen].here);
+ for(ptr = cards; ptr <= last_card; ptr++)
+ {
+ if(card_marked(*ptr))
+ collect_card(ptr);
+ }
+}
+
+/* scan cards in all generations older than the one being collected */
+void collect_cards(void)
+{
+ CELL gen;
+ for(gen = collecting_generation; gen < GC_GENERATIONS; gen++)
+ collect_gen_cards(gen);
+}
+
+void begin_gc(CELL gen)
+{
+ collecting_generation = generations[gen].base;
+
+ if(gen == TENURED)
+ {
+ /* when collecting the oldest generation, rotate it
+ with the semispace */
+ ZONE z = generations[gen];
+ generations[gen] = prior;
+ prior = z;
+ generations[gen].here = generations[gen].base;
+ allot_zone = &generations[gen];
+ }
+ else
+ {
+ /* when collecting a younger generation, we copy
+ reachable objects to the next oldest generation,
+ so we set the allot_zone so the next generation. */
+ allot_zone = &generations[gen + 1];
+ }
+}
+
+void end_gc(CELL gen)
+{
+ /* continue allocating from the nursery. */
+ allot_zone = &nursery;
+}
+
+/* collect gen and all younger generations */
+void garbage_collection(CELL gen)
{
s64 start = current_millis();
CELL scan;
gc_in_progress = true;
- flip_zones();
- scan = active.base;
+ begin_gc(gen);
+
+ /* initialize chase pointer */
+ scan = allot_zone->here;
collect_roots();
collect_cards();
/* collect literal objects referenced from compiled code */
collect_literals();
- while(scan < active.here)
+ while(scan < allot_zone->here)
{
gc_debug("scan loop",scan);
scan = collect_next(scan);
}
+
+ end_gc(gen);
+
gc_debug("gc done",0);
gc_in_progress = false;
-
gc_time += (current_millis() - start);
}
+void primitive_gc(void)
+{
+ garbage_collection(TENURED);
+}
+
/* WARNING: only call this from a context where all local variables
are also reachable via the GC roots. */
void maybe_garbage_collection(void)
{
- if(active.here > active.alarm)
+ if(nursery.here > nursery.alarm)
primitive_gc();
}
s64 gc_time;
+/* only meaningful during a GC */
+CELL collecting_generation;
+
+/* test if the pointer is in generation being collected, or a younger one.
+init_arena() arranges things so that the older generations are first,
+so we have to check that the pointer occurs after the beginning of
+the requested generation. */
+#define COLLECTING_GEN(ptr) (collecting_generation <= ptr)
+
/* Given a pointer to oldspace, copy it to newspace. */
INLINE void* copy_untagged_object(void* pointer, CELL size)
{
gc_debug("copy object",pointer);
+ if(!COLLECTING_GEN(pointer))
+ return pointer;
+
if(pointer == F)
return F;
header = get(UNTAG(pointer));
untagged = UNTAG(header);
- if(TAG(header) != FIXNUM_TYPE && in_zone(&active,untagged))
+ if(TAG(header) != FIXNUM_TYPE && in_zone(&tenured,untagged))
{
gc_debug("forwarding",untagged);
return RETAG(untagged,tag);
}
void collect_roots(void);
+void collect_card(CARD *ptr);
+void collect_gen_cards(CELL gen);
void collect_cards(void);
void clear_cards(void);
void primitive_gc(void);
CELL size = h.size / CELLS;
allot(h.size);
- if(size != fread((void*)active.base,sizeof(CELL),size,file))
+ if(size != fread((void*)tenured.base,sizeof(CELL),size,file))
fatal_error("Wrong data heap length",h.size);
- active.here = active.base + h.size;
+ tenured.here = tenured.base + h.size;
data_relocation_base = h.relocation_base;
}
h.magic = IMAGE_MAGIC;
h.version = IMAGE_VERSION;
- h.relocation_base = active.base;
+ h.relocation_base = tenured.base;
h.boot = userenv[BOOT_ENV];
- h.size = active.here - active.base;
+ h.size = tenured.here - tenured.base;
h.global = userenv[GLOBAL_ENV];
h.t = T;
h.bignum_zero = bignum_zero;
ext_h.relocation_base = compiling.base;
fwrite(&ext_h,sizeof(HEADER_2),1,file);
- fwrite((void*)active.base,h.size,1,file);
+ fwrite((void*)tenured.base,h.size,1,file);
fwrite((void*)compiling.base,ext_h.size,1,file);
fclose(file);
void primitive_save_image(void)
{
F_STRING* filename;
- primitive_gc();
+ /* do a full GC to push everything into tenured space */
+ garbage_collection(TENURED);
filename = untag_string(dpop());
save_image(to_c_string(filename));
}
if(heap_start == 0)
fatal_error("Cannot allocate data heap",total_size);
- alloter = init_zone(&generations[TENURED],aging_size,alloter);
+ alloter = init_zone(&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);
+ allot_zone = &nursery;
+
if(alloter != heap_start + total_size)
fatal_error("Oops",alloter);
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)
{
+ CELL list = F;
+ int gen;
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);
+ for(gen = GC_GENERATIONS - 1; gen >= 0; gen--)
+ {
+ ZONE *z = &generations[gen];
+ list = cons(cons(
+ tag_fixnum(z->limit - z->here),
+ tag_fixnum(z->limit - z->base)),
+ list);
+ }
+ dpush(list);
}
void primitive_allot_profiling(void)
void primitive_begin_scan(void)
{
primitive_gc();
- heap_scan_ptr = active.base;
- heap_scan_end = active.here;
+ heap_scan_ptr = tenured.base;
+ heap_scan_end = tenured.here;
heap_scan = true;
}
#define TENURED (GC_GENERATIONS-1)
ZONE generations[GC_GENERATIONS];
+ZONE *allot_zone;
-CELL heap_start;
+#define tenured generations[TENURED]
+#define nursery generations[TENURED] /* XXX */
-#define active generations[TENURED]
+CELL heap_start;
-/* spare semi-space; rotates with generations[TENURED]. */
+/* spare semi-space; rotates with tenured. */
ZONE prior;
/* card marking write barrier. a card is a byte storing a mark flag,
offset within the card */
#define CARD_SIZE 16
#define CARD_BITS 4
-#define CARD_MASK CARD_SIZE-1
+#define CARD_MASK (CARD_SIZE-1)
INLINE CARD card_marked(CARD c)
{
*c = base;
}
-#define ADDR_TO_CARD(a) (CARD*)(((a-heap_start)>>CARD_BITS)+(CELL)cards)
-#define CARD_TO_ADDR(c) (CELL*)(((c-(CELL)cards)<<CARD_BITS)+heap_start)
+#define ADDR_TO_CARD(a) (CARD*)((((CELL)a-heap_start)>>CARD_BITS)+(CELL)cards)
+#define CARD_TO_ADDR(c) (CELL*)((((CELL)c-(CELL)cards)<<CARD_BITS)+heap_start)
/* this is an inefficient write barrier. compiled definitions use a more
efficient one hand-coded in assembly. the write barrier must be called
CARD *c = ADDR_TO_CARD(address);
/* we need to remember the first object allocated in the
card */
- rebase_card(c,MIN(card_base(*c),address & CARD_MASK));
+ rebase_card(c,MIN(card_base(*c),(address & CARD_MASK)));
}
bool allot_profiling;
INLINE void* allot(CELL a)
{
- CELL h = active.here;
+ CELL h = allot_zone->here;
allot_barrier(h);
- active.here += align8(a);
+ allot_zone->here = h + align8(a);
if(allot_profiling)
allot_profile_step(align8(a));
return (void*)h;
void relocate_data()
{
- CELL relocating = active.base;
+ CELL relocating = tenured.base;
data_fixup(&userenv[BOOT_ENV]);
data_fixup(&userenv[GLOBAL_ENV]);
for(;;)
{
- if(relocating >= active.here)
+ if(relocating >= tenured.here)
break;
relocating = relocate_data_next(relocating);
INLINE void data_fixup(CELL* cell)
{
if(TAG(*cell) != FIXNUM_TYPE && *cell != F)
- *cell += (active.base - data_relocation_base);
+ *cell += (tenured.base - data_relocation_base);
}
typedef enum {
void signal_handler(int signal, siginfo_t* siginfo, void* uap)
{
- if(active.here > active.limit)
+ if(allot_zone->here > allot_zone->limit)
{
- fprintf(stderr,"Out of memory\n");
- fprintf(stderr,"active.base = %ld\n",active.base);
- fprintf(stderr,"active.here = %ld\n",active.here);
- fprintf(stderr,"active.limit = %ld\n",active.limit);
+ fprintf(stderr,"Out of memory!\n");
+ dump_generations();
fflush(stderr);
- flip_zones();
- dump_stacks();
exit(1);
}
else
projects / factor.git / commitdiff