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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2009-10-15 12:23:50 -05:00
parent 0dc734195c d48c72a274
commit baa3e74864
19 changed files with 214 additions and 386 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
basis/compiler/cfg/intrinsics/slots/slots.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: layouts namespaces kernel accessors sequences classes.algebra USING: layouts namespaces kernel accessors sequences
fry compiler.tree.propagation.info compiler.cfg.stacks compiler.cfg.hats classes.algebra locals compiler.tree.propagation.info
compiler.cfg.registers compiler.cfg.instructions compiler.cfg.stacks compiler.cfg.hats compiler.cfg.registers
compiler.cfg.utilities compiler.cfg.builder.blocks ; compiler.cfg.instructions compiler.cfg.utilities
compiler.cfg.builder.blocks compiler.constants ;
IN: compiler.cfg.intrinsics.slots IN: compiler.cfg.intrinsics.slots
: value-tag ( info -- n ) class>> class-tag ; inline : value-tag ( info -- n ) class>> class-tag ; inline
@ -30,18 +31,31 @@ IN: compiler.cfg.intrinsics.slots
ds-push ds-push
] [ drop emit-primitive ] if ; ] [ drop emit-primitive ] if ;
: (emit-set-slot) ( infos -- ) : emit-write-barrier? ( infos -- ? )
[ first class>> immediate class<= ] first class>> immediate class<= not ;
[ [ 3inputs ] [ second value-tag ] bi* ^^tag-offset>slot ] bi
[ ##set-slot ]
[ '[ _ drop _ _ next-vreg next-vreg ##write-barrier ] unless ] 3bi ;
: (emit-set-slot-imm) ( infos -- ) :: (emit-set-slot) ( infos -- )
3inputs :> slot :> obj :> src
slot infos second value-tag ^^tag-offset>slot :> slot
src obj slot ##set-slot
infos emit-write-barrier?
[ obj slot next-vreg next-vreg ##write-barrier ] when ;
:: (emit-set-slot-imm) ( infos -- )
ds-drop ds-drop
[ first class>> immediate class<= ]
[ [ 2inputs ] [ [ third literal>> ] [ second value-tag ] bi ] bi* ] bi 2inputs :> obj :> src
'[ _ ##set-slot-imm ]
[ '[ _ drop _ _ cells next-vreg next-vreg ##write-barrier-imm ] unless ] 3bi ; infos third literal>> :> slot
infos second value-tag :> tag
src obj slot tag ##set-slot-imm
infos emit-write-barrier?
[ obj slot tag slot-offset next-vreg next-vreg ##write-barrier-imm ] when ;
: emit-set-slot ( node -- ) : emit-set-slot ( node -- )
dup node-input-infos dup node-input-infos

7
basis/compiler/cfg/linear-scan/linear-scan-tests.factor
View File

@ -1306,10 +1306,11 @@ V{
{ slot 2 } { slot 2 }
{ tag 7 } { tag 7 }
} }
T{ ##write-barrier T{ ##write-barrier-imm
{ src 141 } { src 141 }
{ card# 145 } { slot 2 }
{ table 146 } { temp1 145 }
{ temp2 146 }
} }
T{ ##inc-d { n -1 } } T{ ##inc-d { n -1 } }
T{ ##inc-r { n -1 } } T{ ##inc-r { n -1 } }

190
basis/compiler/cfg/write-barrier/write-barrier-tests.factor
View File

@ -1,190 +0,0 @@
! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs compiler.cfg
compiler.cfg.alias-analysis compiler.cfg.block-joining
compiler.cfg.branch-splitting compiler.cfg.copy-prop
compiler.cfg.dce compiler.cfg.debugger
compiler.cfg.instructions compiler.cfg.loop-detection
compiler.cfg.registers compiler.cfg.ssa.construction
compiler.cfg.tco compiler.cfg.useless-conditionals
compiler.cfg.utilities compiler.cfg.value-numbering
compiler.cfg.write-barrier cpu.architecture kernel
kernel.private math namespaces sequences sequences.private
tools.test vectors ;
IN: compiler.cfg.write-barrier.tests
: test-write-barrier ( insns -- insns )
<simple-block> dup write-barriers-step instructions>> ;
[
V{
T{ ##peek f 4 D 0 f }
T{ ##allot f 7 24 array 8 f }
T{ ##load-immediate f 9 8 f }
T{ ##set-slot-imm f 9 7 1 3 f }
T{ ##set-slot-imm f 4 7 2 3 f }
T{ ##replace f 7 D 0 f }
T{ ##branch }
}
] [
{
T{ ##peek f 4 D 0 }
T{ ##allot f 7 24 array 8 }
T{ ##load-immediate f 9 8 }
T{ ##set-slot-imm f 9 7 1 3 }
T{ ##write-barrier f 7 10 11 }
T{ ##set-slot-imm f 4 7 2 3 }
T{ ##write-barrier f 7 12 13 }
T{ ##replace f 7 D 0 }
} test-write-barrier
] unit-test
[
V{
T{ ##load-immediate f 4 24 }
T{ ##peek f 5 D -1 }
T{ ##peek f 6 D -2 }
T{ ##set-slot-imm f 5 6 3 2 }
T{ ##write-barrier f 6 7 8 }
T{ ##branch }
}
] [
{
T{ ##load-immediate f 4 24 }
T{ ##peek f 5 D -1 }
T{ ##peek f 6 D -2 }
T{ ##set-slot-imm f 5 6 3 2 }
T{ ##write-barrier f 6 7 8 }
} test-write-barrier
] unit-test
[
V{
T{ ##peek f 19 D -3 }
T{ ##peek f 22 D -2 }
T{ ##set-slot-imm f 22 19 3 2 }
T{ ##write-barrier f 19 24 25 }
T{ ##peek f 28 D -1 }
T{ ##set-slot-imm f 28 19 4 2 }
T{ ##branch }
}
] [
{
T{ ##peek f 19 D -3 }
T{ ##peek f 22 D -2 }
T{ ##set-slot-imm f 22 19 3 2 }
T{ ##write-barrier f 19 24 25 }
T{ ##peek f 28 D -1 }
T{ ##set-slot-imm f 28 19 4 2 }
T{ ##write-barrier f 19 30 3 }
} test-write-barrier
] unit-test
V{
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} 1 test-bb
V{
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} 2 test-bb
1 get 2 get 1vector >>successors drop
cfg new 1 get >>entry 0 set
[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test
[ V{
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} ] [ 1 get instructions>> ] unit-test
[ V{
T{ ##set-slot-imm f 2 1 3 4 }
} ] [ 2 get instructions>> ] unit-test
V{
T{ ##allot f 1 }
} 1 test-bb
V{
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} 2 test-bb
1 get 2 get 1vector >>successors drop
cfg new 1 get >>entry 0 set
[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test
[ V{
T{ ##allot f 1 }
} ] [ 1 get instructions>> ] unit-test
[ V{
T{ ##set-slot-imm f 2 1 3 4 }
} ] [ 2 get instructions>> ] unit-test
V{
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} 1 test-bb
V{
T{ ##allot }
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} 2 test-bb
1 get 2 get 1vector >>successors drop
cfg new 1 get >>entry 0 set
[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test
[ V{
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} ] [ 1 get instructions>> ] unit-test
[ V{
T{ ##allot }
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} ] [ 2 get instructions>> ] unit-test
V{
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} 1 test-bb
V{
T{ ##allot }
} 2 test-bb
1 get 2 get 1vector >>successors drop
V{
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} 3 test-bb
2 get 3 get 1vector >>successors drop
cfg new 1 get >>entry 0 set
[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test
[ V{
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} ] [ 1 get instructions>> ] unit-test
[ V{ T{ ##allot } } ] [ 2 get instructions>> ] unit-test
[ V{
T{ ##set-slot-imm f 2 1 3 4 }
T{ ##write-barrier f 1 2 3 }
} ] [ 3 get instructions>> ] unit-test
: reverse-here' ( seq -- )
{ array } declare
[ length 2/ iota ] [ length ] [ ] tri
[ [ over - 1 - ] dip exchange-unsafe ] 2curry each ;
: write-barrier-stats ( word -- cfg )
test-cfg first [
optimize-tail-calls
delete-useless-conditionals
split-branches
join-blocks
construct-ssa
alias-analysis
value-numbering
copy-propagation
eliminate-dead-code
eliminate-write-barriers
] with-cfg
post-order>> write-barriers
[ [ loop-nesting-at ] [ length ] bi* ] assoc-map ;
[ { { 0 1 } } ] [ \ reverse-here' write-barrier-stats ] unit-test

26
basis/compiler/constants/constants.factor
View File

@ -10,19 +10,21 @@ CONSTANT: deck-bits 18
: card-mark ( -- n ) HEX: 40 HEX: 80 bitor ; inline : card-mark ( -- n ) HEX: 40 HEX: 80 bitor ; inline
! These constants must match vm/layouts.h ! These constants must match vm/layouts.h
: header-offset ( -- n ) object tag-number neg ; inline : slot-offset ( slot tag -- n ) [ bootstrap-cells ] dip - ; inline
: header-offset ( -- n ) 0 object tag-number slot-offset ; inline
: float-offset ( -- n ) 8 float tag-number - ; inline : float-offset ( -- n ) 8 float tag-number - ; inline
: string-offset ( -- n ) 4 bootstrap-cells string tag-number - ; inline : string-offset ( -- n ) 4 string tag-number slot-offset ; inline
: string-aux-offset ( -- n ) 2 bootstrap-cells string tag-number - ; inline : string-aux-offset ( -- n ) 2 string tag-number slot-offset ; inline
: profile-count-offset ( -- n ) 8 bootstrap-cells \ word tag-number - ; inline : profile-count-offset ( -- n ) 8 \ word tag-number slot-offset ; inline
: byte-array-offset ( -- n ) 2 bootstrap-cells byte-array tag-number - ; inline : byte-array-offset ( -- n ) 2 byte-array tag-number slot-offset ; inline
: alien-offset ( -- n ) 3 bootstrap-cells alien tag-number - ; inline : alien-offset ( -- n ) 3 alien tag-number slot-offset ; inline
: underlying-alien-offset ( -- n ) bootstrap-cell alien tag-number - ; inline : underlying-alien-offset ( -- n ) 1 alien tag-number slot-offset ; inline
: tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline : tuple-class-offset ( -- n ) 1 tuple tag-number slot-offset ; inline
: word-xt-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline : word-xt-offset ( -- n ) 10 \ word tag-number slot-offset ; inline
: quot-xt-offset ( -- n ) 4 bootstrap-cells quotation tag-number - ; inline : quot-xt-offset ( -- n ) 4 quotation tag-number slot-offset ; inline
: word-code-offset ( -- n ) 11 bootstrap-cells \ word tag-number - ; inline : word-code-offset ( -- n ) 11 \ word tag-number slot-offset ; inline
: array-start-offset ( -- n ) 2 bootstrap-cells array tag-number - ; inline : array-start-offset ( -- n ) 2 array tag-number slot-offset ; inline
: compiled-header-size ( -- n ) 4 bootstrap-cells ; inline : compiled-header-size ( -- n ) 4 bootstrap-cells ; inline
! Relocation classes ! Relocation classes

3
basis/cpu/ppc/bootstrap.factor
View File

@ -255,7 +255,7 @@ CONSTANT: rs-reg 14
[ [
3 ds-reg 0 LWZ 3 ds-reg 0 LWZ
ds-reg dup 4 SUBI ds-reg dup 4 SUBI
4 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel 4 0 swap LOAD32 0 jit-literal rc-absolute-ppc-2/2 rt-vm jit-rel
5 3 quot-xt-offset LWZ 5 3 quot-xt-offset LWZ
5 MTCTR 5 MTCTR
BCTR BCTR
@ -387,6 +387,7 @@ CONSTANT: rs-reg 14
! Comparisons ! Comparisons
: jit-compare ( insn -- ) : jit-compare ( insn -- )
t jit-literal
0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel 0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
4 ds-reg 0 LWZ 4 ds-reg 0 LWZ
5 ds-reg -4 LWZU 5 ds-reg -4 LWZU

47
basis/cpu/ppc/ppc.factor
View File

@ -32,11 +32,11 @@ enable-float-intrinsics
>> >>
: %load-vm-addr ( reg -- ) : %load-vm-addr ( reg -- )
0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm rel-fixup ; 0 swap LOAD32 0 rc-absolute-ppc-2/2 rel-vm ;
: %load-vm-field-addr ( reg symbol -- ) : %load-vm-field-addr ( reg symbol -- )
[ drop %load-vm-addr ] [ 0 swap LOAD32 ] dip
[ [ dup ] dip vm-field-offset ADDI ] 2bi ; vm-field-offset rc-absolute-ppc-2/2 rel-vm ;
M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ; M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ;
@ -137,13 +137,10 @@ M:: ppc %dispatch ( src temp -- )
temp MTCTR temp MTCTR
BCTR ; BCTR ;
: (%slot-imm) ( obj slot tag -- reg offset )
[ cells ] dip - ; inline
M: ppc %slot ( dst obj slot -- ) swapd LWZX ; M: ppc %slot ( dst obj slot -- ) swapd LWZX ;
M: ppc %slot-imm ( dst obj slot tag -- ) (%slot-imm) LWZ ; M: ppc %slot-imm ( dst obj slot tag -- ) slot-offset LWZ ;
M: ppc %set-slot ( src obj slot -- ) swapd STWX ; M: ppc %set-slot ( src obj slot -- ) swapd STWX ;
M: ppc %set-slot-imm ( src obj slot tag -- ) (%slot-imm) STW ; M: ppc %set-slot-imm ( src obj slot tag -- ) slot-offset STW ;
M:: ppc %string-nth ( dst src index temp -- ) M:: ppc %string-nth ( dst src index temp -- )
[ [
@ -374,11 +371,11 @@ M: ppc %set-alien-double -rot STFD ;
"nursery" %load-vm-field-addr ; "nursery" %load-vm-field-addr ;
: load-allot-ptr ( nursery-ptr allot-ptr -- ) : load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop load-zone-ptr ] [ swap 4 LWZ ] 2bi ; [ drop load-zone-ptr ] [ swap 0 LWZ ] 2bi ;
:: inc-allot-ptr ( nursery-ptr allot-ptr n -- ) :: inc-allot-ptr ( nursery-ptr allot-ptr n -- )
scratch-reg allot-ptr n 8 align ADDI scratch-reg allot-ptr n 8 align ADDI
scratch-reg nursery-ptr 4 STW ; scratch-reg nursery-ptr 0 STW ;
:: store-header ( dst class -- ) :: store-header ( dst class -- )
class type-number tag-fixnum scratch-reg LI class type-number tag-fixnum scratch-reg LI
@ -394,28 +391,36 @@ M:: ppc %allot ( dst size class nursery-ptr -- )
dst class store-tagged ; dst class store-tagged ;
: load-cards-offset ( dst -- ) : load-cards-offset ( dst -- )
[ "cards_offset" %load-vm-field-addr ] [ dup 0 LWZ ] bi ; 0 swap LOAD32 rc-absolute-ppc-2/2 rel-cards-offset ;
: load-decks-offset ( dst -- ) : load-decks-offset ( dst -- )
[ "decks_offset" %load-vm-field-addr ] [ dup 0 LWZ ] bi ; 0 swap LOAD32 rc-absolute-ppc-2/2 rel-decks-offset ;
M:: ppc %write-barrier ( src card# table -- ) :: (%write-barrier) ( temp1 temp2 -- )
card-mark scratch-reg LI card-mark scratch-reg LI
! Mark the card ! Mark the card
table load-cards-offset temp1 temp1 card-bits SRWI
src card# card-bits SRWI temp2 load-cards-offset
table scratch-reg card# STBX temp1 scratch-reg temp2 STBX
! Mark the card deck ! Mark the card deck
table load-decks-offset temp1 temp1 deck-bits card-bits - SRWI
src card# deck-bits SRWI temp2 load-decks-offset
table scratch-reg card# STBX ; temp1 scratch-reg temp2 STBX ;
M:: ppc %write-barrier ( src slot temp1 temp2 -- )
temp1 src slot ADD
temp1 temp2 (%write-barrier) ;
M:: ppc %write-barrier-imm ( src slot temp1 temp2 -- )
temp1 src slot ADDI
temp1 temp2 (%write-barrier) ;
M:: ppc %check-nursery ( label size temp1 temp2 -- ) M:: ppc %check-nursery ( label size temp1 temp2 -- )
temp2 load-zone-ptr temp2 load-zone-ptr
temp1 temp2 cell LWZ temp1 temp2 0 LWZ
temp2 temp2 3 cells LWZ temp2 temp2 2 cells LWZ
temp1 temp1 size ADDI temp1 temp1 size ADDI
! is here >= end? ! is here >= end?
temp1 0 temp2 CMP temp1 0 temp2 CMP

15
basis/cpu/x86/x86.factor
View File

@ -93,7 +93,7 @@ M: x86 %return ( -- ) 0 RET ;
0 <repetition> % ; 0 <repetition> % ;
:: (%slot-imm) ( obj slot tag -- op ) :: (%slot-imm) ( obj slot tag -- op )
obj slot cells tag - [+] ; inline obj slot tag slot-offset [+] ; inline
M: x86 %slot ( dst obj slot -- ) [+] MOV ; M: x86 %slot ( dst obj slot -- ) [+] MOV ;
M: x86 %slot-imm ( dst obj slot tag -- ) (%slot-imm) MOV ; M: x86 %slot-imm ( dst obj slot tag -- ) (%slot-imm) MOV ;
@ -387,6 +387,12 @@ M: x86 %vm-field-ptr ( dst field -- )
: store-tagged ( dst tag -- ) : store-tagged ( dst tag -- )
tag-number OR ; tag-number OR ;
: load-cards-offset ( dst -- )
0 MOV rc-absolute-cell rel-cards-offset ;
: load-decks-offset ( dst -- )
0 MOV rc-absolute-cell rel-decks-offset ;
M:: x86 %allot ( dst size class nursery-ptr -- ) M:: x86 %allot ( dst size class nursery-ptr -- )
nursery-ptr dst load-allot-ptr nursery-ptr dst load-allot-ptr
dst class store-header dst class store-header
@ -395,17 +401,16 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
:: (%write-barrier) ( src slot temp1 temp2 -- ) :: (%write-barrier) ( src slot temp1 temp2 -- )
! Compute slot address. ! Compute slot address.
temp1 src MOV temp1 src slot [+] LEA
temp1 slot ADD
! Mark the card ! Mark the card
temp1 card-bits SHR temp1 card-bits SHR
temp2 0 MOV rc-absolute-cell rel-cards-offset temp2 load-cards-offset
temp2 temp1 [+] card-mark <byte> MOV temp2 temp1 [+] card-mark <byte> MOV
! Mark the card deck ! Mark the card deck
temp1 deck-bits card-bits - SHR temp1 deck-bits card-bits - SHR
temp2 0 MOV rc-absolute-cell rel-decks-offset temp2 load-decks-offset
temp2 temp1 [+] card-mark <byte> MOV ; temp2 temp1 [+] card-mark <byte> MOV ;
M: x86 %write-barrier ( src slot temp1 temp2 -- ) (%write-barrier) ; M: x86 %write-barrier ( src slot temp1 temp2 -- ) (%write-barrier) ;

16
vm/aging_collector.cpp
View File

@ -4,12 +4,21 @@ namespace factor
{ {
aging_collector::aging_collector(factor_vm *myvm_) : aging_collector::aging_collector(factor_vm *myvm_) :
copying_collector<aging_space,aging_policy> copying_collector<aging_space,aging_policy>(
(myvm_,myvm_->data->aging,aging_policy(myvm_)) {} myvm_,
&myvm_->gc_stats.aging_stats,
myvm_->data->aging,
aging_policy(myvm_)) {}
void factor_vm::collect_aging() void factor_vm::collect_aging()
{ {
{ {
/* Change the op so that if we fail here, we proceed to a full
tenured collection. We are collecting to tenured space, and
cards were unmarked, so we can't proceed with a to_tenured
collection. */
current_gc->op = collect_to_tenured_op;
to_tenured_collector collector(this); to_tenured_collector collector(this);
collector.trace_cards(data->tenured, collector.trace_cards(data->tenured,
card_points_to_aging, card_points_to_aging,
@ -17,6 +26,9 @@ void factor_vm::collect_aging()
collector.cheneys_algorithm(); collector.cheneys_algorithm();
} }
{ {
/* If collection fails here, do a to_tenured collection. */
current_gc->op = collect_aging_op;
std::swap(data->aging,data->aging_semispace); std::swap(data->aging,data->aging_semispace);
reset_generation(data->aging); reset_generation(data->aging);

2
vm/code_heap.cpp
View File

@ -229,7 +229,7 @@ critical here */
void factor_vm::compact_code_heap() void factor_vm::compact_code_heap()
{ {
/* Free all unreachable code blocks, don't trace contexts */ /* Free all unreachable code blocks, don't trace contexts */
garbage_collection(tenured_gen,false,false,0); garbage_collection(collect_full_op,false,0);
/* Figure out where the code heap blocks are going to end up */ /* Figure out where the code heap blocks are going to end up */
cell size = code->compute_heap_forwarding(); cell size = code->compute_heap_forwarding();

5
vm/collector.hpp
View File

@ -6,14 +6,16 @@ template<typename TargetGeneration, typename Policy> struct collector {
data_heap *data; data_heap *data;
code_heap *code; code_heap *code;
gc_state *current_gc; gc_state *current_gc;
generation_statistics *stats;
TargetGeneration *target; TargetGeneration *target;
Policy policy; Policy policy;
explicit collector(factor_vm *myvm_, TargetGeneration *target_, Policy policy_) : explicit collector(factor_vm *myvm_, generation_statistics *stats_, TargetGeneration *target_, Policy policy_) :
myvm(myvm_), myvm(myvm_),
data(myvm_->data), data(myvm_->data),
code(myvm_->code), code(myvm_->code),
current_gc(myvm_->current_gc), current_gc(myvm_->current_gc),
stats(stats_),
target(target_), target(target_),
policy(policy_) {} policy(policy_) {}
@ -74,7 +76,6 @@ template<typename TargetGeneration, typename Policy> struct collector {
memcpy(newpointer,untagged,size); memcpy(newpointer,untagged,size);
untagged->h.forward_to(newpointer); untagged->h.forward_to(newpointer);
generation_statistics *stats = &myvm->gc_stats.generations[current_gc->collecting_gen];
stats->object_count++; stats->object_count++;
stats->bytes_copied += size; stats->bytes_copied += size;

9
vm/copying_collector.hpp
View File

@ -15,8 +15,8 @@ template<typename TargetGeneration, typename Policy>
struct copying_collector : collector<TargetGeneration,Policy> { struct copying_collector : collector<TargetGeneration,Policy> {
cell scan; cell scan;
explicit copying_collector(factor_vm *myvm_, TargetGeneration *target_, Policy policy_) : explicit copying_collector(factor_vm *myvm_, generation_statistics *stats_, TargetGeneration *target_, Policy policy_) :
collector<TargetGeneration,Policy>(myvm_,target_,policy_), scan(target_->here) {} collector<TargetGeneration,Policy>(myvm_,stats_,target_,policy_), scan(target_->here) {}
inline cell first_card_in_deck(cell deck) inline cell first_card_in_deck(cell deck)
{ {
@ -28,11 +28,6 @@ struct copying_collector : collector<TargetGeneration,Policy> {
return first_card_in_deck(deck + 1); return first_card_in_deck(deck + 1);
} }
inline cell card_to_addr(cell c)
{
return c << card_bits + this->data->start;
}
inline cell card_deck_for_address(cell a) inline cell card_deck_for_address(cell a)
{ {
return addr_to_deck(a - this->data->start); return addr_to_deck(a - this->data->start);

5
vm/data_heap.hpp
View File

@ -27,9 +27,4 @@ struct data_heap {
data_heap *grow(cell requested_size); data_heap *grow(cell requested_size);
}; };
static const cell nursery_gen = 0;
static const cell aging_gen = 1;
static const cell tenured_gen = 2;
static const cell gen_count = 3;
} }

10
vm/debug.cpp
View File

@ -211,9 +211,9 @@ void factor_vm::dump_memory(cell from, cell to)
dump_cell(from); dump_cell(from);
} }
void factor_vm::dump_zone(cell gen, zone *z) void factor_vm::dump_zone(char *name, zone *z)
{ {
print_string("Generation "); print_cell(gen); print_string(": "); print_string(name); print_string(": ");
print_string("Start="); print_cell(z->start); print_string("Start="); print_cell(z->start);
print_string(", size="); print_cell(z->size); print_string(", size="); print_cell(z->size);
print_string(", here="); print_cell(z->here - z->start); nl(); print_string(", here="); print_cell(z->here - z->start); nl();
@ -221,9 +221,9 @@ void factor_vm::dump_zone(cell gen, zone *z)
void factor_vm::dump_generations() void factor_vm::dump_generations()
{ {
dump_zone(nursery_gen,&nursery); dump_zone("Nursery",&nursery);
dump_zone(aging_gen,data->aging); dump_zone("Aging",data->aging);
dump_zone(tenured_gen,data->tenured); dump_zone("Tenured",data->tenured);
print_string("Cards: base="); print_string("Cards: base=");
print_cell((cell)data->cards); print_cell((cell)data->cards);

6
vm/full_collector.cpp
View File

@ -4,7 +4,11 @@ namespace factor
{ {
full_collector::full_collector(factor_vm *myvm_) : full_collector::full_collector(factor_vm *myvm_) :
copying_collector<tenured_space,full_policy>(myvm_,myvm_->data->tenured,full_policy(myvm_)) {} copying_collector<tenured_space,full_policy>(
myvm_,
&myvm_->gc_stats.full_stats,
myvm_->data->tenured,
full_policy(myvm_)) {}
struct stack_frame_marker { struct stack_frame_marker {
factor_vm *myvm; factor_vm *myvm;

141
vm/gc.cpp
View File

@ -3,14 +3,9 @@
namespace factor namespace factor
{ {
gc_state::gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_gen_) : gc_state::gc_state(gc_op op_) : op(op_), start_time(current_micros()) {}
data(data_),
growing_data_heap(growing_data_heap_),
collecting_gen(collecting_gen_),
collecting_aging_again(false),
start_time(current_micros()) { }
gc_state::~gc_state() { } gc_state::~gc_state() {}
void factor_vm::update_dirty_code_blocks(std::set<code_block *> *remembered_set) void factor_vm::update_dirty_code_blocks(std::set<code_block *> *remembered_set)
{ {
@ -21,80 +16,81 @@ void factor_vm::update_dirty_code_blocks(std::set<code_block *> *remembered_set)
for(; iter != end; iter++) update_literal_references(*iter); for(; iter != end; iter++) update_literal_references(*iter);
} }
void factor_vm::record_gc_stats() void factor_vm::record_gc_stats(generation_statistics *stats)
{ {
generation_statistics *s = &gc_stats.generations[current_gc->collecting_gen];
cell gc_elapsed = (current_micros() - current_gc->start_time); cell gc_elapsed = (current_micros() - current_gc->start_time);
s->collections++; stats->collections++;
s->gc_time += gc_elapsed; stats->gc_time += gc_elapsed;
if(s->max_gc_time < gc_elapsed) if(stats->max_gc_time < gc_elapsed)
s->max_gc_time = gc_elapsed; stats->max_gc_time = gc_elapsed;
} }
/* Collect gen and all younger generations. /* Collect gen and all younger generations.
If growing_data_heap_ is true, we must grow the data heap to such a size that If growing_data_heap_ is true, we must grow the data heap to such a size that
an allocation of requested_bytes won't fail */ an allocation of requested_bytes won't fail */
void factor_vm::garbage_collection(cell collecting_gen_, bool growing_data_heap_, bool trace_contexts_p, cell requested_bytes) void factor_vm::garbage_collection(gc_op op, bool trace_contexts_p, cell requested_bytes)
{ {
assert(!gc_off); assert(!gc_off);
assert(!current_gc); assert(!current_gc);
save_stacks(); save_stacks();
current_gc = new gc_state(data,growing_data_heap_,collecting_gen_); current_gc = new gc_state(op);
/* Keep trying to GC higher and higher generations until we don't run out /* Keep trying to GC higher and higher generations until we don't run out
of space */ of space */
if(setjmp(current_gc->gc_unwind)) if(setjmp(current_gc->gc_unwind))
{ {
/* We come back here if a generation is full */ /* We come back here if a generation is full */
switch(current_gc->op)
/* We have no older generations we can try collecting, so we
resort to growing the data heap */
if(current_gc->collecting_tenured_p())
{ {
assert(!current_gc->growing_data_heap); case collect_nursery_op:
current_gc->growing_data_heap = true; current_gc->op = collect_aging_op;
break;
case collect_aging_op:
current_gc->op = collect_to_tenured_op;
break;
case collect_to_tenured_op:
current_gc->op = collect_full_op;
break;
case collect_full_op:
/* Since we start tracing again, any previously /* Since we start tracing again, any previously
marked code blocks must be re-marked and re-traced */ marked code blocks must be re-marked and re-traced */
code->clear_mark_bits(); code->clear_mark_bits();
} current_gc->op = collect_growing_heap_op;
/* we try collecting aging space twice before going on to break;
collect tenured */ default:
else if(current_gc->collecting_aging_p() critical_error("Bad GC op\n",op);
&& !current_gc->collecting_aging_again) break;
{
current_gc->collecting_aging_again = true;
}
/* Collect the next oldest generation */
else
{
current_gc->collecting_gen++;
} }
} }
if(current_gc->collecting_nursery_p()) switch(current_gc->op)
{
case collect_nursery_op:
collect_nursery(); collect_nursery();
else if(current_gc->collecting_aging_p()) record_gc_stats(&gc_stats.nursery_stats);
{ break;
if(current_gc->collecting_aging_again) case collect_aging_op:
collect_to_tenured(); collect_aging();
else record_gc_stats(&gc_stats.aging_stats);
collect_aging(); break;
case collect_to_tenured_op:
collect_to_tenured();
record_gc_stats(&gc_stats.aging_stats);
break;
case collect_full_op:
collect_full(trace_contexts_p);
record_gc_stats(&gc_stats.full_stats);
break;
case collect_growing_heap_op:
collect_growing_heap(requested_bytes,trace_contexts_p);
record_gc_stats(&gc_stats.full_stats);
break;
default:
critical_error("Bad GC op\n",op);
break;
} }
else if(current_gc->collecting_tenured_p())
{
if(current_gc->growing_data_heap)
collect_growing_heap(requested_bytes,trace_contexts_p);
else
collect_full(trace_contexts_p);
}
else
critical_error("Bug in GC",0);
record_gc_stats();
delete current_gc; delete current_gc;
current_gc = NULL; current_gc = NULL;
@ -102,7 +98,7 @@ void factor_vm::garbage_collection(cell collecting_gen_, bool growing_data_heap_
void factor_vm::gc() void factor_vm::gc()
{ {
garbage_collection(tenured_gen,false,true,0); garbage_collection(collect_full_op,true,0);
} }
void factor_vm::primitive_gc() void factor_vm::primitive_gc()
@ -110,25 +106,28 @@ void factor_vm::primitive_gc()
gc(); gc();
} }
void factor_vm::add_gc_stats(generation_statistics *stats, growable_array *result)
{
result->add(allot_cell(stats->collections));
result->add(tag<bignum>(long_long_to_bignum(stats->gc_time)));
result->add(tag<bignum>(long_long_to_bignum(stats->max_gc_time)));
result->add(allot_cell(stats->collections == 0 ? 0 : stats->gc_time / stats->collections));
result->add(allot_cell(stats->object_count));
result->add(tag<bignum>(long_long_to_bignum(stats->bytes_copied)));
}
void factor_vm::primitive_gc_stats() void factor_vm::primitive_gc_stats()
{ {
growable_array result(this); growable_array result(this);
cell i; add_gc_stats(&gc_stats.nursery_stats,&result);
u64 total_gc_time = 0; add_gc_stats(&gc_stats.aging_stats,&result);
add_gc_stats(&gc_stats.full_stats,&result);
for(i = 0; i < gen_count; i++) u64 total_gc_time =
{ gc_stats.nursery_stats.gc_time +
generation_statistics *s = &gc_stats.generations[i]; gc_stats.aging_stats.gc_time +
result.add(allot_cell(s->collections)); gc_stats.full_stats.gc_time;
result.add(tag<bignum>(long_long_to_bignum(s->gc_time)));
result.add(tag<bignum>(long_long_to_bignum(s->max_gc_time)));
result.add(allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections));
result.add(allot_cell(s->object_count));
result.add(tag<bignum>(long_long_to_bignum(s->bytes_copied)));
total_gc_time += s->gc_time;
}
result.add(tag<bignum>(ulong_long_to_bignum(total_gc_time))); result.add(tag<bignum>(ulong_long_to_bignum(total_gc_time)));
result.add(tag<bignum>(ulong_long_to_bignum(gc_stats.cards_scanned))); result.add(tag<bignum>(ulong_long_to_bignum(gc_stats.cards_scanned)));
@ -186,7 +185,7 @@ void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
for(cell i = 0; i < gc_roots_size; i++) for(cell i = 0; i < gc_roots_size; i++)
gc_locals.push_back((cell)&gc_roots_base[i]); gc_locals.push_back((cell)&gc_roots_base[i]);
garbage_collection(nursery_gen,false,true,0); garbage_collection(collect_nursery_op,true,0);
for(cell i = 0; i < gc_roots_size; i++) for(cell i = 0; i < gc_roots_size; i++)
gc_locals.pop_back(); gc_locals.pop_back();
@ -215,7 +214,7 @@ object *factor_vm::allot_object(header header, cell size)
{ {
/* If there is insufficient room, collect the nursery */ /* If there is insufficient room, collect the nursery */
if(nursery.here + size > nursery.end) if(nursery.here + size > nursery.end)
garbage_collection(nursery_gen,false,true,0); garbage_collection(collect_nursery_op,true,0);
obj = nursery.allot(size); obj = nursery.allot(size);
} }
@ -229,7 +228,7 @@ object *factor_vm::allot_object(header header, cell size)
/* If it still won't fit, grow the heap */ /* If it still won't fit, grow the heap */
if(data->tenured->here + size > data->tenured->end) if(data->tenured->here + size > data->tenured->end)
garbage_collection(tenured_gen,true,true,size); garbage_collection(collect_growing_heap_op,true,size);
obj = data->tenured->allot(size); obj = data->tenured->allot(size);

51
vm/gc.hpp
View File

@ -1,6 +1,14 @@
namespace factor namespace factor
{ {
enum gc_op {
collect_nursery_op,
collect_aging_op,
collect_to_tenured_op,
collect_full_op,
collect_growing_heap_op
};
/* statistics */ /* statistics */
struct generation_statistics { struct generation_statistics {
cell collections; cell collections;
@ -11,7 +19,9 @@ struct generation_statistics {
}; };
struct gc_statistics { struct gc_statistics {
generation_statistics generations[gen_count]; generation_statistics nursery_stats;
generation_statistics aging_stats;
generation_statistics full_stats;
u64 cards_scanned; u64 cards_scanned;
u64 decks_scanned; u64 decks_scanned;
u64 card_scan_time; u64 card_scan_time;
@ -19,47 +29,12 @@ struct gc_statistics {
}; };
struct gc_state { struct gc_state {
/* The data heap we're collecting */ gc_op op;
data_heap *data;
/* sometimes we grow the heap */
bool growing_data_heap;
/* Which generation is being collected */
cell collecting_gen;
/* If true, we are collecting aging space for the second time, so if it is still
full, we go on to collect tenured */
bool collecting_aging_again;
/* GC start time, for benchmarking */
u64 start_time; u64 start_time;
jmp_buf gc_unwind; jmp_buf gc_unwind;
explicit gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_gen_); explicit gc_state(gc_op op_);
~gc_state(); ~gc_state();
inline bool collecting_nursery_p()
{
return collecting_gen == nursery_gen;
}
inline bool collecting_aging_p()
{
return collecting_gen == aging_gen;
}
inline bool collecting_tenured_p()
{
return collecting_gen == tenured_gen;
}
inline bool collecting_accumulation_gen_p()
{
return ((collecting_aging_p() && !collecting_aging_again)
|| collecting_tenured_p());
}
}; };
VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm); VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm);

7
vm/nursery_collector.cpp
View File

@ -4,8 +4,11 @@ namespace factor
{ {
nursery_collector::nursery_collector(factor_vm *myvm_) : nursery_collector::nursery_collector(factor_vm *myvm_) :
copying_collector<aging_space,nursery_policy> copying_collector<aging_space,nursery_policy>(
(myvm_,myvm_->data->aging,nursery_policy(myvm_)) {} myvm_,
&myvm_->gc_stats.nursery_stats,
myvm_->data->aging,
nursery_policy(myvm_)) {}
void factor_vm::collect_nursery() void factor_vm::collect_nursery()
{ {

7
vm/to_tenured_collector.cpp
View File

@ -4,8 +4,11 @@ namespace factor
{ {
to_tenured_collector::to_tenured_collector(factor_vm *myvm_) : to_tenured_collector::to_tenured_collector(factor_vm *myvm_) :
copying_collector<tenured_space,to_tenured_policy> copying_collector<tenured_space,to_tenured_policy>(
(myvm_,myvm_->data->tenured,to_tenured_policy(myvm_)) {} myvm_,
&myvm_->gc_stats.aging_stats,
myvm_->data->tenured,
to_tenured_policy(myvm_)) {}
void factor_vm::collect_to_tenured() void factor_vm::collect_to_tenured()
{ {

11
vm/vm.hpp
View File

@ -1,6 +1,8 @@
namespace factor namespace factor
{ {
struct growable_array;
struct factor_vm struct factor_vm
{ {
// First five fields accessed directly by assembler. See vm.factor // First five fields accessed directly by assembler. See vm.factor
@ -240,8 +242,8 @@ struct factor_vm
void collect_full_impl(bool trace_contexts_p); void collect_full_impl(bool trace_contexts_p);
void collect_growing_heap(cell requested_bytes, bool trace_contexts_p); void collect_growing_heap(cell requested_bytes, bool trace_contexts_p);
void collect_full(bool trace_contexts_p); void collect_full(bool trace_contexts_p);
void record_gc_stats(); void record_gc_stats(generation_statistics *stats);
void garbage_collection(cell gen, bool growing_data_heap, bool trace_contexts_p, cell requested_bytes); void garbage_collection(gc_op op, bool trace_contexts_p, cell requested_bytes);
void gc(); void gc();
void primitive_gc(); void primitive_gc();
void primitive_gc_stats(); void primitive_gc_stats();
@ -249,6 +251,7 @@ struct factor_vm
void primitive_become(); void primitive_become();
void inline_gc(cell *gc_roots_base, cell gc_roots_size); void inline_gc(cell *gc_roots_base, cell gc_roots_size);
object *allot_object(header header, cell size); object *allot_object(header header, cell size);
void add_gc_stats(generation_statistics *stats, growable_array *result);
void primitive_clear_gc_stats(); void primitive_clear_gc_stats();
template<typename Type> Type *allot(cell size) template<typename Type> Type *allot(cell size)
@ -259,7 +262,7 @@ struct factor_vm
inline void check_data_pointer(object *pointer) inline void check_data_pointer(object *pointer)
{ {
#ifdef FACTOR_DEBUG #ifdef FACTOR_DEBUG
if(!(current_gc && current_gc->growing_data_heap)) if(!(current_gc && current_gc->op == collect_growing_heap_op))
{ {
assert((cell)pointer >= data->seg->start assert((cell)pointer >= data->seg->start
&& (cell)pointer < data->seg->end); && (cell)pointer < data->seg->end);
@ -298,7 +301,7 @@ struct factor_vm
void print_callstack(); void print_callstack();
void dump_cell(cell x); void dump_cell(cell x);
void dump_memory(cell from, cell to); void dump_memory(cell from, cell to);
void dump_zone(cell gen, zone *z); void dump_zone(char *name, zone *z);
void dump_generations(); void dump_generations();
void dump_objects(cell type); void dump_objects(cell type);
void find_data_references_step(cell *scan); void find_data_references_step(cell *scan);