Faster inline allocators
							parent
							
								
									942313afa3
								
							
						
					
					
						commit
						f48d5091c9
					
				| 
						 | 
				
			
			@ -187,6 +187,9 @@ HOOK: %unbox-any-c-ptr cpu ( dst src -- )
 | 
			
		|||
 | 
			
		||||
HOOK: %box-alien cpu ( dst src -- )
 | 
			
		||||
 | 
			
		||||
! GC check
 | 
			
		||||
HOOK: %gc cpu
 | 
			
		||||
 | 
			
		||||
: operand ( var -- op ) get v>operand ; inline
 | 
			
		||||
 | 
			
		||||
: unique-operands ( operands quot -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -7,7 +7,7 @@ cpu.architecture alien ;
 | 
			
		|||
IN: cpu.ppc.allot
 | 
			
		||||
 | 
			
		||||
: load-zone-ptr ( reg -- )
 | 
			
		||||
    "nursery" f pick %load-dlsym dup 0 LWZ ;
 | 
			
		||||
    "nursery" f pick %load-dlsym ;
 | 
			
		||||
 | 
			
		||||
: %allot ( header size -- )
 | 
			
		||||
    #! Store a pointer to 'size' bytes allocated from the
 | 
			
		||||
| 
						 | 
				
			
			@ -25,6 +25,19 @@ IN: cpu.ppc.allot
 | 
			
		|||
: %store-tagged ( reg tag -- )
 | 
			
		||||
    >r dup fresh-object v>operand 11 r> tag-number ORI ;
 | 
			
		||||
 | 
			
		||||
M: ppc %gc
 | 
			
		||||
    "end" define-label
 | 
			
		||||
    12 load-zone-ptr
 | 
			
		||||
    11 12 cell LWZ ! nursery.here -> r11
 | 
			
		||||
    12 12 3 cells LWZ ! nursery.end -> r12
 | 
			
		||||
    11 12 1024 ADDI ! add ALLOT_BUFFER_ZONE to here
 | 
			
		||||
    0 11 12 CMPI ! is here >= end?
 | 
			
		||||
    "end" get BLE
 | 
			
		||||
    0 frame-required
 | 
			
		||||
    %prepare-alien-invoke
 | 
			
		||||
    "minor_gc" f %alien-invoke
 | 
			
		||||
    "end" resolve-label ;
 | 
			
		||||
 | 
			
		||||
: %allot-float ( reg -- )
 | 
			
		||||
    #! exits with tagged ptr to object in r12, untagged in r11
 | 
			
		||||
    float 16 %allot
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -17,6 +17,8 @@ M: x86.32 ds-reg ESI ;
 | 
			
		|||
M: x86.32 rs-reg EDI ;
 | 
			
		||||
M: x86.32 stack-reg ESP ;
 | 
			
		||||
M: x86.32 stack-save-reg EDX ;
 | 
			
		||||
M: x86.32 temp-reg-1 EAX ;
 | 
			
		||||
M: x86.32 temp-reg-2 ECX ;
 | 
			
		||||
 | 
			
		||||
M: temp-reg v>operand drop EBX ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -12,6 +12,8 @@ M: x86.64 ds-reg R14 ;
 | 
			
		|||
M: x86.64 rs-reg R15 ;
 | 
			
		||||
M: x86.64 stack-reg RSP ;
 | 
			
		||||
M: x86.64 stack-save-reg RSI ;
 | 
			
		||||
M: x86.64 temp-reg-1 RAX ;
 | 
			
		||||
M: x86.64 temp-reg-2 RCX ;
 | 
			
		||||
 | 
			
		||||
M: temp-reg v>operand drop RBX ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -16,12 +16,12 @@ IN: cpu.x86.allot
 | 
			
		|||
 | 
			
		||||
: object@ ( n -- operand ) cells (object@) ;
 | 
			
		||||
 | 
			
		||||
: load-zone-ptr ( -- )
 | 
			
		||||
: load-zone-ptr ( reg -- )
 | 
			
		||||
    #! Load pointer to start of zone array
 | 
			
		||||
    "nursery" f allot-reg %alien-global ;
 | 
			
		||||
    0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
 | 
			
		||||
 | 
			
		||||
: load-allot-ptr ( -- )
 | 
			
		||||
    load-zone-ptr
 | 
			
		||||
    allot-reg load-zone-ptr
 | 
			
		||||
    allot-reg PUSH
 | 
			
		||||
    allot-reg dup cell [+] MOV ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -29,6 +29,19 @@ IN: cpu.x86.allot
 | 
			
		|||
    allot-reg POP
 | 
			
		||||
    allot-reg cell [+] swap 8 align ADD ;
 | 
			
		||||
 | 
			
		||||
M: x86.32 %gc ( -- )
 | 
			
		||||
    "end" define-label
 | 
			
		||||
    temp-reg-1 load-zone-ptr
 | 
			
		||||
    temp-reg-2 temp-reg-1 cell [+] MOV
 | 
			
		||||
    temp-reg-2 1024 ADD
 | 
			
		||||
    temp-reg-1 temp-reg-1 3 cells [+] MOV
 | 
			
		||||
    temp-reg-2 temp-reg-1 CMP
 | 
			
		||||
    "end" get JLE
 | 
			
		||||
    0 frame-required
 | 
			
		||||
    %prepare-alien-invoke
 | 
			
		||||
    "minor_gc" f %alien-invoke
 | 
			
		||||
    "end" resolve-label ;
 | 
			
		||||
 | 
			
		||||
: store-header ( header -- )
 | 
			
		||||
    0 object@ swap type-number tag-fixnum MOV ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -34,6 +34,10 @@ GENERIC: push-return-reg ( reg-class -- )
 | 
			
		|||
GENERIC: load-return-reg ( stack@ reg-class -- )
 | 
			
		||||
GENERIC: store-return-reg ( stack@ reg-class -- )
 | 
			
		||||
 | 
			
		||||
! Only used by inline allocation
 | 
			
		||||
HOOK: temp-reg-1 cpu
 | 
			
		||||
HOOK: temp-reg-2 cpu
 | 
			
		||||
 | 
			
		||||
HOOK: address-operand cpu ( address -- operand )
 | 
			
		||||
 | 
			
		||||
HOOK: fixnum>slot@ cpu
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -468,11 +468,6 @@ M: loc lazy-store
 | 
			
		|||
: finalize-contents ( -- )
 | 
			
		||||
    finalize-locs finalize-vregs reset-phantoms ;
 | 
			
		||||
 | 
			
		||||
: %gc ( -- )
 | 
			
		||||
    0 frame-required
 | 
			
		||||
    %prepare-alien-invoke
 | 
			
		||||
    "simple_gc" f %alien-invoke ;
 | 
			
		||||
 | 
			
		||||
! Loading stacks to vregs
 | 
			
		||||
: free-vregs? ( int# float# -- ? )
 | 
			
		||||
    double-float-regs free-vregs length <=
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -305,6 +305,11 @@ cell-bits 32 = [
 | 
			
		|||
    ] unit-test
 | 
			
		||||
] when
 | 
			
		||||
 | 
			
		||||
[ f ] [
 | 
			
		||||
    [ { integer } declare -63 shift 4095 bitand ]
 | 
			
		||||
    \ shift inlined?
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ t ] [
 | 
			
		||||
    [ B{ 1 0 } *short 0 number= ]
 | 
			
		||||
    \ number= inlined?
 | 
			
		||||
| 
						 | 
				
			
			@ -557,6 +562,11 @@ M: integer detect-integer ;
 | 
			
		|||
    ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ t ] [
 | 
			
		||||
    [ { integer } declare bitnot detect-integer ]
 | 
			
		||||
    \ detect-integer inlined?
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
! Later
 | 
			
		||||
 | 
			
		||||
! [ t ] [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -122,7 +122,7 @@ M: float fp-nan?
 | 
			
		|||
: next-power-of-2 ( m -- n ) 2 swap (next-power-of-2) ; foldable
 | 
			
		||||
 | 
			
		||||
: power-of-2? ( n -- ? )
 | 
			
		||||
    dup 0 < [ drop f ] [ dup 1- bitand zero? ] if ; foldable
 | 
			
		||||
    dup 0 <= [ drop f ] [ dup 1- bitand zero? ] if ; foldable
 | 
			
		||||
 | 
			
		||||
: align ( m w -- n )
 | 
			
		||||
    1- [ + ] keep bitnot bitand ; inline
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -125,7 +125,8 @@ optimizer.math.partial generic.standard system accessors ;
 | 
			
		|||
    ] if ; inline
 | 
			
		||||
 | 
			
		||||
: math-output-class/interval-1 ( node word -- classes intervals )
 | 
			
		||||
    [ drop { } math-output-class ] [ math-output-interval-1 ] 2bi ;
 | 
			
		||||
    [ drop { } math-output-class 1array ]
 | 
			
		||||
    [ math-output-interval-1 1array ] 2bi ;
 | 
			
		||||
 | 
			
		||||
{
 | 
			
		||||
    { bitnot interval-bitnot }
 | 
			
		||||
| 
						 | 
				
			
			@ -362,7 +363,6 @@ most-negative-fixnum most-positive-fixnum [a,b]
 | 
			
		|||
    { + [ [ >fixnum ] bi@ fixnum+fast ] }
 | 
			
		||||
    { - [ [ >fixnum ] bi@ fixnum-fast ] }
 | 
			
		||||
    { * [ [ >fixnum ] bi@ fixnum*fast ] }
 | 
			
		||||
    { shift [ [ >fixnum ] bi@ fixnum-shift-fast ] }
 | 
			
		||||
} [
 | 
			
		||||
    >r derived-ops r> [
 | 
			
		||||
        [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										19
									
								
								vm/data_gc.c
								
								
								
								
							
							
						
						
									
										19
									
								
								vm/data_gc.c
								
								
								
								
							| 
						 | 
				
			
			@ -122,7 +122,7 @@ void clear_cards(CELL from, CELL to)
 | 
			
		|||
void set_data_heap(F_DATA_HEAP *data_heap_)
 | 
			
		||||
{
 | 
			
		||||
	data_heap = data_heap_;
 | 
			
		||||
	nursery = &data_heap->generations[NURSERY];
 | 
			
		||||
	nursery = data_heap->generations[NURSERY];
 | 
			
		||||
	init_cards_offset();
 | 
			
		||||
	clear_cards(NURSERY,TENURED);
 | 
			
		||||
}
 | 
			
		||||
| 
						 | 
				
			
			@ -231,7 +231,7 @@ DEFINE_PRIMITIVE(data_room)
 | 
			
		|||
 | 
			
		||||
	for(gen = 0; gen < data_heap->gen_count; gen++)
 | 
			
		||||
	{
 | 
			
		||||
		F_ZONE *z = &data_heap->generations[gen];
 | 
			
		||||
		F_ZONE *z = (gen == NURSERY ? &nursery : &data_heap->generations[gen]);
 | 
			
		||||
		set_array_nth(a,gen * 2,tag_fixnum((z->end - z->here) >> 10));
 | 
			
		||||
		set_array_nth(a,gen * 2 + 1,tag_fixnum((z->size) >> 10));
 | 
			
		||||
	}
 | 
			
		||||
| 
						 | 
				
			
			@ -583,7 +583,7 @@ CELL collect_next(CELL scan)
 | 
			
		|||
 | 
			
		||||
INLINE void reset_generation(CELL i)
 | 
			
		||||
{
 | 
			
		||||
	F_ZONE *z = &data_heap->generations[i];
 | 
			
		||||
	F_ZONE *z = (i == NURSERY ? &nursery : &data_heap->generations[i]);
 | 
			
		||||
	z->here = z->start;
 | 
			
		||||
	if(secure_gc)
 | 
			
		||||
		memset((void*)z->start,69,z->size);
 | 
			
		||||
| 
						 | 
				
			
			@ -608,7 +608,7 @@ void begin_gc(CELL requested_bytes)
 | 
			
		|||
 | 
			
		||||
		old_data_heap = data_heap;
 | 
			
		||||
		set_data_heap(grow_data_heap(old_data_heap,requested_bytes));
 | 
			
		||||
		newspace = &data_heap->generations[collecting_gen];
 | 
			
		||||
		newspace = &data_heap->generations[TENURED];
 | 
			
		||||
	}
 | 
			
		||||
	else if(collecting_accumulation_gen_p())
 | 
			
		||||
	{
 | 
			
		||||
| 
						 | 
				
			
			@ -783,6 +783,11 @@ void gc(void)
 | 
			
		|||
	garbage_collection(TENURED,false,0);
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
void minor_gc(void)
 | 
			
		||||
{
 | 
			
		||||
	garbage_collection(NURSERY,false,0);
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
DEFINE_PRIMITIVE(gc)
 | 
			
		||||
{
 | 
			
		||||
	gc();
 | 
			
		||||
| 
						 | 
				
			
			@ -794,12 +799,6 @@ DEFINE_PRIMITIVE(gc_time)
 | 
			
		|||
	box_unsigned_8(gc_time);
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
void simple_gc(void)
 | 
			
		||||
{
 | 
			
		||||
	if(nursery->here + ALLOT_BUFFER_ZONE > nursery->end)
 | 
			
		||||
		garbage_collection(NURSERY,false,0);
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
DEFINE_PRIMITIVE(become)
 | 
			
		||||
{
 | 
			
		||||
	F_ARRAY *new_objects = untag_array(dpop());
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										15
									
								
								vm/data_gc.h
								
								
								
								
							
							
						
						
									
										15
									
								
								vm/data_gc.h
								
								
								
								
							| 
						 | 
				
			
			@ -20,6 +20,7 @@ DECLARE_PRIMITIVE(next_object);
 | 
			
		|||
DECLARE_PRIMITIVE(end_scan);
 | 
			
		||||
 | 
			
		||||
void gc(void);
 | 
			
		||||
DLLEXPORT void minor_gc(void);
 | 
			
		||||
 | 
			
		||||
/* generational copying GC divides memory into zones */
 | 
			
		||||
typedef struct {
 | 
			
		||||
| 
						 | 
				
			
			@ -125,7 +126,7 @@ void collect_cards(void);
 | 
			
		|||
F_ZONE *newspace;
 | 
			
		||||
 | 
			
		||||
/* new objects are allocated here */
 | 
			
		||||
DLLEXPORT F_ZONE *nursery;
 | 
			
		||||
DLLEXPORT F_ZONE nursery;
 | 
			
		||||
 | 
			
		||||
INLINE bool in_zone(F_ZONE *z, CELL pointer)
 | 
			
		||||
{
 | 
			
		||||
| 
						 | 
				
			
			@ -200,7 +201,7 @@ INLINE bool should_copy(CELL untagged)
 | 
			
		|||
	else if(HAVE_AGING_P && collecting_gen == AGING)
 | 
			
		||||
		return !in_zone(&data_heap->generations[TENURED],untagged);
 | 
			
		||||
	else if(HAVE_NURSERY_P && collecting_gen == NURSERY)
 | 
			
		||||
		return in_zone(&data_heap->generations[NURSERY],untagged);
 | 
			
		||||
		return in_zone(&nursery,untagged);
 | 
			
		||||
	else
 | 
			
		||||
	{
 | 
			
		||||
		critical_error("Bug in should_copy",untagged);
 | 
			
		||||
| 
						 | 
				
			
			@ -315,13 +316,15 @@ INLINE void* allot_object(CELL type, CELL a)
 | 
			
		|||
{
 | 
			
		||||
	CELL *object;
 | 
			
		||||
 | 
			
		||||
	if(HAVE_NURSERY_P && nursery->size - ALLOT_BUFFER_ZONE > a)
 | 
			
		||||
	if(HAVE_NURSERY_P && nursery.size - ALLOT_BUFFER_ZONE > a)
 | 
			
		||||
	{
 | 
			
		||||
		/* If there is insufficient room, collect the nursery */
 | 
			
		||||
		if(nursery->here + ALLOT_BUFFER_ZONE + a > nursery->end)
 | 
			
		||||
		if(nursery.here + ALLOT_BUFFER_ZONE + a > nursery.end)
 | 
			
		||||
			garbage_collection(NURSERY,false,0);
 | 
			
		||||
 | 
			
		||||
		object = allot_zone(nursery,a);
 | 
			
		||||
		CELL h = nursery.here;
 | 
			
		||||
		nursery.here = h + align8(a);
 | 
			
		||||
		object = (void*)h;
 | 
			
		||||
	}
 | 
			
		||||
	/* If the object is bigger than the nursery, allocate it in
 | 
			
		||||
	tenured space */
 | 
			
		||||
| 
						 | 
				
			
			@ -360,8 +363,6 @@ INLINE void* allot_object(CELL type, CELL a)
 | 
			
		|||
 | 
			
		||||
CELL collect_next(CELL scan);
 | 
			
		||||
 | 
			
		||||
DLLEXPORT void simple_gc(void);
 | 
			
		||||
 | 
			
		||||
DECLARE_PRIMITIVE(gc);
 | 
			
		||||
DECLARE_PRIMITIVE(gc_time);
 | 
			
		||||
DECLARE_PRIMITIVE(become);
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -227,7 +227,11 @@ void dump_zone(F_ZONE *z)
 | 
			
		|||
void dump_generations(void)
 | 
			
		||||
{
 | 
			
		||||
	int i;
 | 
			
		||||
	for(i = 0; i < data_heap->gen_count; i++)
 | 
			
		||||
 | 
			
		||||
	printf("Nursery: ");
 | 
			
		||||
	dump_zone(&nursery);
 | 
			
		||||
	
 | 
			
		||||
	for(i = 1; i < data_heap->gen_count; i++)
 | 
			
		||||
	{
 | 
			
		||||
		printf("Generation %d: ",i);
 | 
			
		||||
		dump_zone(&data_heap->generations[i]);
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -96,7 +96,7 @@ void memory_protection_error(CELL addr, F_STACK_FRAME *native_stack)
 | 
			
		|||
		general_error(ERROR_RS_UNDERFLOW,F,F,native_stack);
 | 
			
		||||
	else if(in_page(addr, rs_bot, rs_size, 0))
 | 
			
		||||
		general_error(ERROR_RS_OVERFLOW,F,F,native_stack);
 | 
			
		||||
	else if(in_page(addr, nursery->end, 0, 0))
 | 
			
		||||
	else if(in_page(addr, nursery.end, 0, 0))
 | 
			
		||||
		critical_error("allot_object() missed GC check",0);
 | 
			
		||||
	else if(in_page(addr, gc_locals_region->start, 0, -1))
 | 
			
		||||
		critical_error("gc locals underflow",0);
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue