steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

generational GC work

cvs
Slava Pestov 2005-05-12 05:02:39 +00:00
parent ef2670ba05
commit 055d116310
24 changed files with 421 additions and 198 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
TODO.FACTOR.txt
View File

@ -1,3 +1,11 @@
<magnus--> http://developer.apple.com/technotes/tn2004/tn2123.html#SECLIMITATIONS
<magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4742.html
<magnus--> not *too* long
<magnus--> but we'd need to longjmp the main thread from the exception handler thread
<magnus--> or cause a signal in the main thread
<magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html
<magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup
- faster layout
- tiled window manager
- c primitive arrays: or just specialized arrays

6
library/bootstrap/boot-stage4.factor
View File

@ -3,8 +3,8 @@
IN: kernel
USING: alien assembler command-line compiler console errors
generic inference kernel-internals listener lists math memory
namespaces parser presentation random stdio streams unparser
words ;
namespaces parser presentation prettyprint random stdio streams
unparser words ;
"Bootstrap stage 4..." print
@ -42,6 +42,8 @@ unparse write " words compiled" print
0 [ drop 1 + ] each-word
unparse write " words total" print
"Total bootstrap GC time: " write gc-time unparse write " ms" print
"Bootstrapping is complete." print
"Now, you can run ./f factor.image" print

4
library/bootstrap/primitives.factor
View File

@ -126,7 +126,7 @@ vocabularies get [
[ "setenv" "kernel-internals" [ [ object fixnum ] [ ] ] ]
[ "stat" "files" [ [ string ] [ general-list ] ] ]
[ "(directory)" "files" [ [ string ] [ general-list ] ] ]
[ "garbage-collection" "memory" [ [ ] [ ] ] ]
[ "gc" "memory" [ [ fixnum ] [ ] ] ]
[ "gc-time" "memory" [ [ string ] [ ] ] ]
[ "save-image" "memory" [ [ string ] [ ] ] ]
[ "datastack" "kernel" " -- ds " ]
@ -134,7 +134,7 @@ vocabularies get [
[ "set-datastack" "kernel" " ds -- " ]
[ "set-callstack" "kernel" " cs -- " ]
[ "exit" "kernel" [ [ integer ] [ ] ] ]
[ "room" "memory" [ [ ] [ integer integer general-list ] ] ]
[ "room" "memory" [ [ ] [ integer integer integer integer general-list ] ] ]
[ "os-env" "kernel" [ [ string ] [ object ] ] ]
[ "millis" "kernel" [ [ ] [ integer ] ] ]
[ "(random-int)" "math" [ [ ] [ integer ] ] ]

4
library/test/compiler/simple.factor
View File

@ -34,7 +34,7 @@ USE: memory
: indexed-literal-test "hello world" ; compiled
garbage-collection
garbage-collection
full-gc
full-gc
[ "hello world" ] [ indexed-literal-test ] unit-test

6
library/test/crashes.factor
View File

@ -6,7 +6,7 @@ prettyprint sequences strings test vectors words ;
[ ] [
"20 <sbuf> \"foo\" set" eval
"garbage-collection" eval
"full-gc" eval
] unit-test
[ ] [
@ -26,6 +26,6 @@ prettyprint sequences strings test vectors words ;
! Weird PowerPC bug.
[ ] [
[ "4" throw ] [ drop ] catch
garbage-collection
garbage-collection
full-gc
full-gc
] unit-test

4
library/tools/memory.factor
View File

@ -5,6 +5,10 @@ USING: errors generic hashtables kernel kernel-internals lists
math namespaces prettyprint sequences stdio strings unparser
vectors words ;
: generations 15 getenv ;
: full-gc generations 1 - gc ;
: save
#! Save the current image.
"image" get save-image ;

2
native/alien.c
View File

@ -87,7 +87,7 @@ void fixup_displaced_alien(DISPLACED_ALIEN* d)
void collect_displaced_alien(DISPLACED_ALIEN* d)
{
COPY_OBJECT(d->alien);
copy_handle(&d->alien);
}
#define DEF_ALIEN_SLOT(name,type,boxer) \

8
native/array.c
View File

@ -14,6 +14,12 @@ F_ARRAY* allot_array(CELL type, CELL capacity)
return array;
}
/* WARNING: fill must be an immediate type:
either be F or a fixnum.
if you want to use pass a pointer, you _must_ hit
the write barrier manually with a write_barrier()
call with the returned object. */
F_ARRAY* array(CELL type, CELL capacity, CELL fill)
{
int i; F_ARRAY* array = allot_array(type, capacity);
@ -40,9 +46,9 @@ void primitive_byte_array(void)
dpush(tag_object(array(BYTE_ARRAY_TYPE,to_fixnum(dpop()),0)));
}
/* see note about fill in array() */
F_ARRAY* grow_array(F_ARRAY* array, CELL capacity, CELL fill)
{
/* later on, do an optimization: if end of array is here, just grow */
int i; F_ARRAY* new_array;
CELL curr_cap = array_capacity(array);
if(curr_cap >= capacity)

184
native/debug.c
View File

@ -135,32 +135,184 @@ void print_obj(CELL obj)
fprintf(stderr,"f");
break;
default:
fprintf(stderr,"#<type %ld @ %ld>",type_of(obj),obj);
fprintf(stderr,"#<type %ld @ %lx>",type_of(obj),obj);
break;
}
}
void print_stack(CELL* start, CELL* end)
void print_objects(CELL start, CELL end)
{
while(start < end)
for(; start <= end; start += CELLS)
{
print_obj(*start);
print_obj(get(start));
fprintf(stderr,"\n");
start++;
}
}
void dump_stacks(void)
void dump_cell(CELL cell)
{
fprintf(stderr,"*** Data stack:\n");
print_stack((CELL*)ds_bot,(CELL*)(ds + CELLS));
fprintf(stderr,"*** Call stack:\n");
print_stack((CELL*)cs_bot,(CELL*)(cs + CELLS));
fprintf(stderr,"*** Call frame:\n");
print_obj(callframe);
fprintf(stderr,"%08lx: ",cell);
cell = get(cell);
fprintf(stderr,"%08lx tag %ld",cell,TAG(cell));
switch(TAG(cell))
{
case OBJECT_TYPE:
case BIGNUM_TYPE:
case FLOAT_TYPE:
if(cell == F)
fprintf(stderr," -- F");
else if(cell < TYPE_COUNT<<TAG_BITS)
fprintf(stderr," -- header: %ld",cell>>TAG_BITS);
else if(cell >= heap_start && cell < heap_end)
{
CELL header = get(UNTAG(cell));
CELL type = header>>TAG_BITS;
fprintf(stderr," -- object; ");
if(TAG(header) == OBJECT_TYPE && type < TYPE_COUNT)
fprintf(stderr," type %ld",type);
else
fprintf(stderr," header corrupt");
}
break;
case GC_COLLECTED:
fprintf(stderr," -- forwarding pointer");
break;
}
fprintf(stderr,"\n");
fprintf(stderr,"*** Executing:\n");
print_obj(executing);
fprintf(stderr,"\n");
fflush(stderr);
}
void dump_memory(CELL from, CELL to)
{
for(; from <= to; from += CELLS)
dump_cell(from);
}
void dump_generation(ZONE *z)
{
fprintf(stderr,"base=%lx, size=%lx, here=%lx, alarm=%lx\n",
z->base,
z->limit - z->base,
z->here - z->base,
z->alarm - z->base);
}
void dump_generations(void)
{
int i;
for(i = 0; i < GC_GENERATIONS; i++)
{
fprintf(stderr,"Generation %d: ",i);
dump_generation(&generations[i]);
}
fprintf(stderr,"Semispace: ");
dump_generation(&prior);
fprintf(stderr,"Cards: base=%lx, size=%lx\n",(CELL)cards,
(CELL)(cards_end - cards));
}
void factorbug(void)
{
fprintf(stderr,"Factor low-level debugger\n");
fprintf(stderr,"d <addr> <count> -- dump memory\n");
fprintf(stderr,". <addr> -- print object at <addr>\n");
fprintf(stderr,"sz <addr> -- print size of object at <addr>\n");
fprintf(stderr,"s r -- dump data and return stacks\n");
fprintf(stderr,".s .r -- print data and return stacks\n");
fprintf(stderr,"i -- dump interpreter state\n");
fprintf(stderr,"e -- dump environment\n");
fprintf(stderr,"g -- dump generations\n");
fprintf(stderr,"card <addr> -- print card containing address\n");
fprintf(stderr,"addr <card> -- print address containing card\n");
fprintf(stderr,"c <gen> -- force garbage collection\n");
fprintf(stderr,"t -- throw t\n");
fprintf(stderr,"x -- exit debugger\n");
fprintf(stderr,"im -- save factor.crash.image\n");
for(;;)
{
char cmd[1024];
fprintf(stderr,"ldb ");
fflush(stdout);
if(scanf("%s",cmd) <= 0)
exit(1);
if(strcmp(cmd,"d") == 0)
{
CELL addr, count;
scanf("%lx %lx",&addr,&count);
dump_memory(addr,addr+count);
}
else if(strcmp(cmd,".") == 0)
{
CELL addr;
scanf("%lx",&addr);
print_obj(addr);
fprintf(stderr,"\n");
}
else if(strcmp(cmd,"sz") == 0)
{
CELL addr;
scanf("%lx",&addr);
fprintf(stderr,"%ld\n",object_size(addr));
}
else if(strcmp(cmd,"s") == 0)
dump_memory(ds_bot,(ds + CELLS));
else if(strcmp(cmd,"r") == 0)
dump_memory(cs_bot,(cs + CELLS));
else if(strcmp(cmd,".s") == 0)
print_objects(ds_bot,(ds + CELLS));
else if(strcmp(cmd,".r") == 0)
print_objects(cs_bot,(cs + CELLS));
else if(strcmp(cmd,"i") == 0)
{
fprintf(stderr,"Call frame:\n");
dump_cell(callframe);
fprintf(stderr,"\n");
fprintf(stderr,"Executing:\n");
dump_cell(executing);
fprintf(stderr,"\n");
}
else if(strcmp(cmd,"e") == 0)
{
int i;
for(i = 0; i < USER_ENV; i++)
dump_cell(userenv[i]);
}
else if(strcmp(cmd,"g") == 0)
dump_generations();
else if(strcmp(cmd,"c") == 0)
{
CELL gen;
scanf("%lu",&gen);
garbage_collection(gen);
}
else if(strcmp(cmd,"card") == 0)
{
CELL addr;
scanf("%lx",&addr);
fprintf(stderr,"%lx\n",(CELL)ADDR_TO_CARD(addr));
}
else if(strcmp(cmd,"addr") == 0)
{
CELL card;
scanf("%lx",&card);
fprintf(stderr,"%lx\n",(CELL)CARD_TO_ADDR(card));
}
else if(strcmp(cmd,"t") == 0)
throw_error(T,true);
else if(strcmp(cmd,"x") == 0)
return;
else if(strcmp(cmd,"y") == 0)
save_image("factor.crash.image");
else
fprintf(stderr,"unknown command\n");
}
}

8
native/debug.h
View File

@ -1,7 +1,3 @@
CELL assoc(CELL alist, CELL key);
void print_cons(CELL cons);
void print_word(F_WORD* word);
void print_string(F_STRING* str);
void print_obj(CELL obj);
void print_stack(CELL* start, CELL* end);
void dump_stacks(void);
void dump_generations(void);
void factorbug(void);

2
native/dll.c
View File

@ -53,5 +53,5 @@ void fixup_dll(DLL* dll)
void collect_dll(DLL* dll)
{
COPY_OBJECT(dll->path);
copy_handle(&dll->path);
}

11
native/error.c
View File

@ -14,8 +14,7 @@ void fatal_error(char* msg, CELL tagged)
void critical_error(char* msg, CELL tagged)
{
fprintf(stderr,"Critical error: %s %ld\n",msg,tagged);
save_image("factor.crash.image");
exit(1);
factorbug();
}
void early_error(CELL error)
@ -26,9 +25,7 @@ void early_error(CELL error)
fprintf(stderr,"Error during startup: ");
print_obj(error);
fprintf(stderr,"\n");
dump_stacks();
fflush(stderr);
exit(1);
factorbug();
}
}
@ -60,9 +57,7 @@ void primitive_throw(void)
void primitive_die(void)
{
dump_stacks();
fflush(stderr);
exit(1);
factorbug();
}
void general_error(CELL error, CELL tagged)

5
native/factor.c
View File

@ -15,6 +15,7 @@ void init_factor(char* image, CELL ds_size, CELL cs_size,
init_errors();
userenv[CPU_ENV] = tag_object(from_c_string(FACTOR_CPU_STRING));
userenv[OS_ENV] = tag_object(from_c_string(FACTOR_OS_STRING));
userenv[GEN_ENV] = tag_fixnum(GC_GENERATIONS);
}
INLINE bool factor_arg(const char* str, const char* arg, CELL* value)
@ -33,8 +34,8 @@ int main(int argc, char** argv)
{
CELL ds_size = 2048;
CELL cs_size = 2048;
CELL young_size = 4;
CELL aging_size = 8;
CELL young_size = 8;
CELL aging_size = 16;
CELL code_size = 2;
CELL literal_size = 64;
CELL args;

211
native/gc.c
View File

@ -7,17 +7,13 @@ void collect_roots(void)
int i;
CELL ptr;
gc_debug("root: t",T);
COPY_OBJECT(T);
gc_debug("root: bignum_zero",bignum_zero);
COPY_OBJECT(bignum_zero);
gc_debug("root: bignum_pos_one",bignum_pos_one);
COPY_OBJECT(bignum_pos_one);
gc_debug("root: bignum_neg_one",bignum_neg_one);
COPY_OBJECT(bignum_neg_one);
gc_debug("root: callframe",callframe);
copy_handle(&T);
copy_handle(&bignum_zero);
copy_handle(&bignum_pos_one);
copy_handle(&bignum_neg_one);
/* we can't use & here since these two are in
registers on PowerPC */
COPY_OBJECT(callframe);
gc_debug("root: executing",executing);
COPY_OBJECT(executing);
for(ptr = ds_bot; ptr <= ds; ptr += CELLS)
@ -30,22 +26,68 @@ void collect_roots(void)
copy_handle(&userenv[i]);
}
/* Given a pointer to oldspace, copy it to newspace. */
INLINE void* copy_untagged_object(void* pointer, CELL size)
{
void* newpointer = allot(size);
memcpy(newpointer,pointer,size);
return newpointer;
}
INLINE CELL copy_object_impl(CELL pointer)
{
CELL newpointer;
if(pointer < collecting_generation)
critical_error("asked to copy object outside collected generation",pointer);
newpointer = (CELL)copy_untagged_object((void*)UNTAG(pointer),
object_size(pointer));
/* install forwarding pointer */
put(UNTAG(pointer),RETAG(newpointer,GC_COLLECTED));
return newpointer;
}
/*
Given a pointer to a tagged pointer to oldspace, copy it to newspace.
If the object has already been copied, return the forwarding
pointer address without copying anything; otherwise, install
a new forwarding pointer.
*/
CELL copy_object_impl(CELL pointer)
CELL copy_object(CELL pointer)
{
CELL newpointer;
CELL tag;
CELL header;
CELL untagged;
gc_debug("copy_object",pointer);
newpointer = (CELL)copy_untagged_object((void*)UNTAG(pointer),
object_size(pointer));
put(UNTAG(pointer),RETAG(newpointer,OBJECT_TYPE));
gc_debug("copy object",pointer);
return newpointer;
if(pointer == F)
return F;
tag = TAG(pointer);
if(tag == FIXNUM_TYPE)
return pointer;
header = get(UNTAG(pointer));
untagged = UNTAG(header);
if(TAG(header) == GC_COLLECTED)
{
header = get(untagged);
while(header == GC_COLLECTED)
{
untagged = UNTAG(header);
header = get(untagged);
}
gc_debug("forwarding",untagged);
return RETAG(untagged,tag);
}
else
return RETAG(copy_object_impl(pointer),tag);
}
INLINE void collect_object(CELL scan)
@ -80,8 +122,6 @@ INLINE void collect_object(CELL scan)
INLINE CELL collect_next(CELL scan)
{
CELL size;
gc_debug("collect_next",scan);
gc_debug("collect_next header",get(scan));
if(headerp(get(scan)))
{
size = untagged_object_size(scan);
@ -96,15 +136,8 @@ INLINE CELL collect_next(CELL scan)
return scan + size;
}
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)
INLINE void collect_card(CARD *ptr, CELL here)
{
CARD c = *ptr;
CELL offset = (c & CARD_BASE_MASK);
@ -112,32 +145,66 @@ void collect_card(CARD *ptr)
CELL card_end = (CELL)CARD_TO_ADDR(ptr + 1);
if(offset == 0x7f)
critical_error("bad card",c);
{
if(c == 0xff)
critical_error("bad card",c);
else
return;
}
printf("! write barrier hit %d\n",offset);
while(card_scan < card_end)
/* printf("write barrier hit %ld\n",offset); */
while(card_scan < card_end && card_scan < here)
card_scan = collect_next(card_scan);
clear_card(ptr);
}
void collect_gen_cards(CELL gen)
INLINE 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++)
CELL here = generations[gen].here;
CARD *last_card = ADDR_TO_CARD(here);
if(generations[gen].here == generations[gen].limit)
last_card--;
for(; ptr <= last_card; ptr++)
{
if(card_marked(*ptr))
collect_card(ptr);
collect_card(ptr,here);
}
}
/* scan cards in all generations older than the one being collected */
void collect_cards(void)
void unmark_cards(CELL from, CELL to)
{
CELL gen;
for(gen = collecting_generation; gen < GC_GENERATIONS; gen++)
collect_gen_cards(gen);
CARD *ptr = ADDR_TO_CARD(generations[from].base);
CARD *last_card = ADDR_TO_CARD(generations[to].here);
if(generations[to].here == generations[to].limit)
last_card--;
for(; ptr <= last_card; ptr++)
unmark_card(ptr);
}
void clear_cards(CELL from, CELL to)
{
CARD *ptr = ADDR_TO_CARD(generations[from].base);
CARD *last_card = ADDR_TO_CARD(generations[to].limit);
for(; ptr < last_card; ptr++)
clear_card(ptr);
}
void reset_generations(CELL from, CELL to)
{
CELL i;
for(i = from; i <= to; i++)
generations[i].here = generations[i].base;
clear_cards(from,to);
}
/* scan cards in all generations older than the one being collected */
void collect_cards(CELL gen)
{
int i;
for(i = gen + 1; i < GC_GENERATIONS; i++)
collect_gen_cards(i);
}
void begin_gc(CELL gen)
@ -153,6 +220,7 @@ void begin_gc(CELL gen)
prior = z;
generations[gen].here = generations[gen].base;
allot_zone = &generations[gen];
clear_cards(TENURED,TENURED);
}
else
{
@ -165,7 +233,29 @@ void begin_gc(CELL gen)
void end_gc(CELL gen)
{
/* continue allocating from the nursery. */
if(gen == TENURED)
{
/* we did a full collection; no more
old-to-new pointers remain since everything
is in tenured space */
unmark_cards(TENURED,TENURED);
/* all generations except tenured space are
now empty */
reset_generations(NURSERY,TENURED - 1);
}
else
{
/* we collected a younger generation. so the
next-oldest generation no longer has any
pointers into the younger generation (the
younger generation is empty!) */
unmark_cards(gen + 1,gen + 1);
/* all generations up to and including the one
collected are now empty */
reset_generations(NURSERY,gen);
}
/* new objects are allocated from the nursery. */
allot_zone = &nursery;
}
@ -186,32 +276,41 @@ void garbage_collection(CELL gen)
begin_gc(gen);
printf("collecting generation %ld\n",gen);
dump_generations();
/* initialize chase pointer */
scan = allot_zone->here;
/* collect objects referenced from stacks and environment */
collect_roots();
collect_cards();
/* collect objects referenced from older generations */
collect_cards(gen);
/* collect literal objects referenced from compiled code */
collect_literals();
while(scan < allot_zone->here)
{
gc_debug("scan loop",scan);
scan = collect_next(scan);
}
end_gc(gen);
gc_debug("gc done",0);
gc_debug("gc done",gen);
gc_in_progress = false;
gc_time += (current_millis() - start);
gc_debug("total gc time",gc_time);
}
void primitive_gc(void)
{
garbage_collection(TENURED);
CELL gen = to_fixnum(dpop());
gen = MAX(NURSERY,MIN(TENURED,gen));
garbage_collection(gen);
printf("After:\n");
dump_generations();
}
/* WARNING: only call this from a context where all local variables
@ -219,7 +318,21 @@ are also reachable via the GC roots. */
void maybe_garbage_collection(void)
{
if(nursery.here > nursery.alarm)
primitive_gc();
{
if(tenured.here > tenured.alarm)
{
printf("Major GC\n");
garbage_collection(TENURED);
}
else
{
printf("Minor GC\n");
garbage_collection(NURSERY);
}
printf("After:\n");
dump_generations();
}
}
void primitive_gc_time(void)

56
native/gc.h
View File

@ -14,67 +14,25 @@ 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)
{
void* newpointer = allot(size);
memcpy(newpointer,pointer,size);
return newpointer;
}
CELL copy_object_impl(CELL pointer);
/* #define GC_DEBUG */
INLINE void gc_debug(char* msg, CELL x) {
#ifdef GC_DEBUG
printf("%s %d\n",msg,x);
printf("%s %ld\n",msg,x);
#endif
}
INLINE CELL copy_object(CELL pointer)
{
CELL tag;
CELL header;
CELL untagged;
CELL copy_object(CELL pointer);
#define COPY_OBJECT(lvalue) if(COLLECTING_GEN(lvalue)) lvalue = copy_object(lvalue)
gc_debug("copy object",pointer);
if(!COLLECTING_GEN(pointer))
return pointer;
if(pointer == F)
return F;
tag = TAG(pointer);
if(tag == FIXNUM_TYPE)
return pointer;
header = get(UNTAG(pointer));
untagged = UNTAG(header);
if(TAG(header) != FIXNUM_TYPE && in_zone(&tenured,untagged))
{
gc_debug("forwarding",untagged);
return RETAG(untagged,tag);
}
else
return RETAG(copy_object_impl(pointer),tag);
}
#define COPY_OBJECT(lvalue) lvalue = copy_object(lvalue)
INLINE void copy_handle(CELL* handle)
INLINE void copy_handle(CELL *handle)
{
COPY_OBJECT(*handle);
}
void collect_roots(void);
void collect_card(CARD *ptr);
void collect_gen_cards(CELL gen);
void collect_cards(void);
void clear_cards(void);
void clear_cards(CELL from, CELL to);
void unmark_cards(CELL from, CELL to);
void primitive_gc(void);
void garbage_collection(CELL gen);
void maybe_garbage_collection(void);
void primitive_gc_time(void);

2
native/hashtable.c
View File

@ -24,5 +24,5 @@ void fixup_hashtable(F_HASHTABLE* hashtable)
void collect_hashtable(F_HASHTABLE* hashtable)
{
COPY_OBJECT(hashtable->array);
copy_handle(&hashtable->array);
}

39
native/memory.c
View File

@ -1,26 +1,5 @@
#include "factor.h"
void dump_generations(void)
{
int i;
for(i = 0; i < GC_GENERATIONS; i++)
{
fprintf(stderr,"Generation %d: base=%lu, size=%lu, here=%lu\n",
i,
generations[i].base,
generations[i].limit - generations[i].base,
generations[i].here);
}
fprintf(stderr,"Semispace: base=%lu, size=%lu, here=%lu\n",
prior.base,
prior.limit - prior.base,
prior.here);
fprintf(stderr,"Cards: base=%lu, size=%lu\n",(CELL)cards,
(CELL)(cards_end - cards));
}
CELL init_zone(ZONE *z, CELL size, CELL base)
{
z->base = z->here = base;
@ -30,18 +9,24 @@ CELL init_zone(ZONE *z, CELL size, CELL base)
}
/* input parameters must be 8 byte aligned */
/* the heap layout is important:
- two semispaces: tenured and prior
- younger generations follow */
void init_arena(CELL young_size, CELL aging_size)
{
int i;
CELL alloter;
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);
heap_end = heap_start + total_size;
cards = alloc_guarded(cards_size);
cards_end = cards + cards_size;
clear_cards();
int i;
CELL alloter = heap_start;
alloter = heap_start;
if(heap_start == 0)
fatal_error("Cannot allocate data heap",total_size);
@ -49,9 +34,11 @@ void init_arena(CELL young_size, CELL aging_size)
alloter = init_zone(&tenured,aging_size,alloter);
alloter = init_zone(&prior,aging_size,alloter);
for(i = 0; i < GC_GENERATIONS - 1; i++)
for(i = GC_GENERATIONS - 2; i >= 0; i--)
alloter = init_zone(&generations[i],young_size,alloter);
clear_cards(TENURED,NURSERY);
allot_zone = &nursery;
if(alloter != heap_start + total_size)
@ -127,7 +114,7 @@ void primitive_size(void)
void primitive_begin_scan(void)
{
primitive_gc();
garbage_collection(TENURED);
heap_scan_ptr = tenured.base;
heap_scan_end = tenured.here;
heap_scan = true;

29
native/memory.h
View File

@ -58,9 +58,10 @@ ZONE generations[GC_GENERATIONS];
ZONE *allot_zone;
#define tenured generations[TENURED]
#define nursery generations[TENURED] /* XXX */
#define nursery generations[NURSERY]
CELL heap_start;
CELL heap_end;
/* spare semi-space; rotates with tenured. */
ZONE prior;
@ -82,18 +83,23 @@ CARD *cards_end;
/* A card is 16 bytes (128 bits), 5 address bits per card.
it is important that 7 bits is sufficient to represent every
offset within the card */
#define CARD_SIZE 16
#define CARD_BITS 4
#define CARD_MASK (CARD_SIZE-1)
#define CARD_SIZE 128
#define CARD_BITS 7
#define ADDR_CARD_MASK (CARD_SIZE-1)
INLINE CARD card_marked(CARD c)
{
return c & CARD_MARK_MASK;
}
INLINE void unmark_card(CARD *c)
{
*c &= CARD_BASE_MASK;
}
INLINE void clear_card(CARD *c)
{
*c = CARD_BASE_MASK;
*c = CARD_BASE_MASK; /* invalid value */
}
INLINE u8 card_base(CARD c)
@ -101,11 +107,6 @@ INLINE u8 card_base(CARD c)
return c & CARD_BASE_MASK;
}
INLINE void rebase_card(CARD *c, u8 base)
{
*c = base;
}
#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)
@ -122,10 +123,11 @@ INLINE void write_barrier(CELL address)
/* we need to remember the first object allocated in the card */
INLINE void allot_barrier(CELL address)
{
CARD *c = ADDR_TO_CARD(address);
CARD *ptr = 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)));
CARD c = *ptr;
*ptr = (card_marked(c) | MIN(card_base(c),(address & ADDR_CARD_MASK)));
}
bool allot_profiling;
@ -134,7 +136,6 @@ bool allot_profiling;
size must be a multiple of the page size */
void* alloc_guarded(CELL size);
void dump_generations(void);
CELL init_zone(ZONE *z, CELL size, CELL base);
void init_arena(CELL young_size, CELL aging_size);
void flip_zones();
@ -146,7 +147,7 @@ INLINE CELL align8(CELL a)
return ((a & 7) == 0) ? a : ((a + 8) & ~7);
}
INLINE void* allot(CELL a)
INLINE void *allot(CELL a)
{
CELL h = allot_zone->here;
allot_barrier(h);

8
native/relocate.c
View File

@ -2,8 +2,6 @@
void relocate_object(CELL relocating)
{
allot_barrier(relocating);
switch(untag_header(get(relocating)))
{
case WORD_TYPE:
@ -42,6 +40,8 @@ INLINE CELL relocate_data_next(CELL relocating)
CELL size = CELLS;
CELL cell = get(relocating);
allot_barrier(relocating);
if(headerp(cell))
{
size = untagged_object_size(relocating);
@ -136,7 +136,7 @@ INLINE CELL relocate_code_next(CELL relocating)
+ compiled->reloc_length);
if(compiled->header != COMPILED_HEADER)
fatal_error("Wrong compiled header",relocating);
critical_error("Wrong compiled header",relocating);
while(rel < rel_end)
{
@ -175,7 +175,7 @@ INLINE CELL relocate_code_next(CELL relocating)
code_fixup_16_16((CELL*)rel->offset);
break;
default:
fatal_error("Unsupported rel",rel->type);
critical_error("Unsupported rel",rel->type);
break;
}

4
native/run.h
View File

@ -1,8 +1,5 @@
#define USER_ENV 16
#define STDIN_ENV 0
#define STDOUT_ENV 1
#define STDERR_ENV 2
#define NAMESTACK_ENV 3 /* used by library only */
#define GLOBAL_ENV 4
#define BREAK_ENV 5
@ -15,6 +12,7 @@
#define ERROR_ENV 12 /* a marker consed onto kernel errors */
#define IN_ENV 13
#define OUT_ENV 14
#define GEN_ENV 15 /* set to GC_GENERATIONS constant */
/* Profiling timer */
#ifndef WIN32

2
native/sbuf.c
View File

@ -24,5 +24,5 @@ void fixup_sbuf(F_SBUF* sbuf)
void collect_sbuf(F_SBUF* sbuf)
{
COPY_OBJECT(sbuf->string);
copy_handle(&sbuf->string);
}

10
native/unix/signal.c
View File

@ -5,9 +5,7 @@ void signal_handler(int signal, siginfo_t* siginfo, void* uap)
if(allot_zone->here > allot_zone->limit)
{
fprintf(stderr,"Out of memory!\n");
dump_generations();
fflush(stderr);
exit(1);
factorbug();
}
else
signal_error(signal);
@ -15,7 +13,7 @@ void signal_handler(int signal, siginfo_t* siginfo, void* uap)
void dump_stack_signal(int signal, siginfo_t* siginfo, void* uap)
{
dump_stacks();
factorbug();
}
/* Called from a signal handler. XXX - is this safe? */
@ -40,12 +38,16 @@ void init_signals(void)
struct sigaction profiling_sigaction;
struct sigaction ign_sigaction;
struct sigaction dump_sigaction;
sigemptyset(&custom_sigaction.sa_mask);
custom_sigaction.sa_sigaction = signal_handler;
custom_sigaction.sa_flags = SA_SIGINFO;
sigemptyset(&profiling_sigaction.sa_mask);
profiling_sigaction.sa_sigaction = call_profiling_step;
profiling_sigaction.sa_flags = SA_SIGINFO;
sigemptyset(&dump_sigaction.sa_mask);
dump_sigaction.sa_sigaction = dump_stack_signal;
dump_sigaction.sa_flags = SA_SIGINFO;
sigemptyset(&ign_sigaction.sa_mask);
ign_sigaction.sa_handler = SIG_IGN;
sigaction(SIGABRT,&custom_sigaction,NULL);
sigaction(SIGFPE,&custom_sigaction,NULL);

2
native/vector.c
View File

@ -24,5 +24,5 @@ void fixup_vector(F_VECTOR* vector)
void collect_vector(F_VECTOR* vector)
{
COPY_OBJECT(vector->array);
copy_handle(&vector->array);
}

4
native/word.c
View File

@ -54,6 +54,6 @@ void fixup_word(F_WORD* word)
void collect_word(F_WORD* word)
{
COPY_OBJECT(word->def);
COPY_OBJECT(word->props);
copy_handle(&word->def);
copy_handle(&word->props);
}