+<magnus--> http://developer.apple.com/technotes/tn2004/tn2123.html#SECLIMITATIONS\r
+<magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4742.html\r
+<magnus--> not *too* long\r
+<magnus--> but we'd need to longjmp the main thread from the exception handler thread\r
+<magnus--> or cause a signal in the main thread\r
+<magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html\r
+<magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup\r
+\r
- faster layout\r
- tiled window manager\r
- c primitive arrays: or just specialized arrays\r
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
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
[ "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 " ]
[ "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 ] ] ]
: indexed-literal-test "hello world" ; compiled
-garbage-collection
-garbage-collection
+full-gc
+full-gc
[ "hello world" ] [ indexed-literal-test ] unit-test
[ ] [
"20 <sbuf> \"foo\" set" eval
- "garbage-collection" eval
+ "full-gc" eval
] unit-test
[ ] [
! Weird PowerPC bug.
[ ] [
[ "4" throw ] [ drop ] catch
- garbage-collection
- garbage-collection
+ full-gc
+ full-gc
] unit-test
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 ;
void collect_displaced_alien(DISPLACED_ALIEN* d)
{
- COPY_OBJECT(d->alien);
+ copy_handle(&d->alien);
}
#define DEF_ALIEN_SLOT(name,type,boxer) \
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);
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)
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,"\n");
- fprintf(stderr,"*** Executing:\n");
- print_obj(executing);
+ 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");
- 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");
+ }
}
-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);
void collect_dll(DLL* dll)
{
- COPY_OBJECT(dll->path);
+ copy_handle(&dll->path);
}
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)
fprintf(stderr,"Error during startup: ");
print_obj(error);
fprintf(stderr,"\n");
- dump_stacks();
- fflush(stderr);
- exit(1);
+ factorbug();
}
}
void primitive_die(void)
{
- dump_stacks();
- fflush(stderr);
- exit(1);
+ factorbug();
}
void general_error(CELL error, CELL tagged)
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)
{
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;
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)
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)
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);
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);
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);
}
}
+void unmark_cards(CELL from, CELL to)
+{
+ 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(void)
+void collect_cards(CELL gen)
{
- CELL gen;
- for(gen = collecting_generation; gen < GC_GENERATIONS; gen++)
- collect_gen_cards(gen);
+ int i;
+ for(i = gen + 1; i < GC_GENERATIONS; i++)
+ collect_gen_cards(i);
}
void begin_gc(CELL gen)
prior = z;
generations[gen].here = generations[gen].base;
allot_zone = &generations[gen];
+ clear_cards(TENURED,TENURED);
}
else
{
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;
}
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
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)
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;
-
- 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)
+CELL copy_object(CELL pointer);
+#define COPY_OBJECT(lvalue) if(COLLECTING_GEN(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);
void collect_hashtable(F_HASHTABLE* hashtable)
{
- COPY_OBJECT(hashtable->array);
+ copy_handle(&hashtable->array);
}
#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;
}
/* 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);
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)
void primitive_begin_scan(void)
{
- primitive_gc();
+ garbage_collection(TENURED);
heap_scan_ptr = tenured.base;
heap_scan_end = tenured.here;
heap_scan = true;
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;
/* 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 clear_card(CARD *c)
+INLINE void unmark_card(CARD *c)
{
- *c = CARD_BASE_MASK;
+ *c &= CARD_BASE_MASK;
}
-INLINE u8 card_base(CARD c)
+INLINE void clear_card(CARD *c)
{
- return c & CARD_BASE_MASK;
+ *c = CARD_BASE_MASK; /* invalid value */
}
-INLINE void rebase_card(CARD *c, u8 base)
+INLINE u8 card_base(CARD c)
{
- *c = base;
+ return c & CARD_BASE_MASK;
}
#define ADDR_TO_CARD(a) (CARD*)((((CELL)a-heap_start)>>CARD_BITS)+(CELL)cards)
/* 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;
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();
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);
void relocate_object(CELL relocating)
{
- allot_barrier(relocating);
-
switch(untag_header(get(relocating)))
{
case WORD_TYPE:
CELL size = CELLS;
CELL cell = get(relocating);
+ allot_barrier(relocating);
+
if(headerp(cell))
{
size = untagged_object_size(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)
{
code_fixup_16_16((CELL*)rel->offset);
break;
default:
- fatal_error("Unsupported rel",rel->type);
+ critical_error("Unsupported rel",rel->type);
break;
}
#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
#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
void collect_sbuf(F_SBUF* sbuf)
{
- COPY_OBJECT(sbuf->string);
+ copy_handle(&sbuf->string);
}
if(allot_zone->here > allot_zone->limit)
{
fprintf(stderr,"Out of memory!\n");
- dump_generations();
- fflush(stderr);
- exit(1);
+ factorbug();
}
else
signal_error(signal);
void dump_stack_signal(int signal, siginfo_t* siginfo, void* uap)
{
- dump_stacks();
+ factorbug();
}
/* Called from a signal handler. XXX - is this safe? */
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);
void collect_vector(F_VECTOR* vector)
{
- COPY_OBJECT(vector->array);
+ copy_handle(&vector->array);
}
void collect_word(F_WORD* word)
{
- COPY_OBJECT(word->def);
- COPY_OBJECT(word->props);
+ copy_handle(&word->def);
+ copy_handle(&word->props);
}
projects / factor.git / commitdiff