Merge branch 'new_gc'

db4
Slava Pestov 2009-10-14 19:51:06 -05:00
commit 51e0d5c466
43 changed files with 468 additions and 411 deletions

View File

@ -111,18 +111,25 @@ SYMBOL: jit-relocations
: jit-rel ( rc rt -- ) : jit-rel ( rc rt -- )
over compute-offset 3array jit-relocations get push-all ; over compute-offset 3array jit-relocations get push-all ;
: make-jit ( quot -- jit-data ) SYMBOL: jit-literals
: jit-literal ( literal -- )
jit-literals get push ;
: make-jit ( quot -- jit-literals jit-data )
[ [
V{ } clone jit-literals set
V{ } clone jit-relocations set V{ } clone jit-relocations set
call( -- ) call( -- )
jit-literals get >array
jit-relocations get >array jit-relocations get >array
] B{ } make prefix ; ] B{ } make prefix ;
: jit-define ( quot name -- ) : jit-define ( quot name -- )
[ make-jit ] dip set ; [ make-jit nip ] dip set ;
: define-sub-primitive ( quot word -- ) : define-sub-primitive ( quot word -- )
[ make-jit ] dip sub-primitives get set-at ; [ make-jit 2array ] dip sub-primitives get set-at ;
! The image being constructed; a vector of word-size integers ! The image being constructed; a vector of word-size integers
SYMBOL: image SYMBOL: image

View File

@ -42,6 +42,9 @@ M: ##set-slot-imm build-liveness-graph
M: ##write-barrier build-liveness-graph M: ##write-barrier build-liveness-graph
dup src>> setter-liveness-graph ; dup src>> setter-liveness-graph ;
M: ##write-barrier-imm build-liveness-graph
dup src>> setter-liveness-graph ;
M: ##allot build-liveness-graph M: ##allot build-liveness-graph
[ dst>> allocations get conjoin ] [ call-next-method ] bi ; [ dst>> allocations get conjoin ] [ call-next-method ] bi ;
@ -74,6 +77,9 @@ M: ##set-slot-imm compute-live-vregs
M: ##write-barrier compute-live-vregs M: ##write-barrier compute-live-vregs
dup src>> setter-live-vregs ; dup src>> setter-live-vregs ;
M: ##write-barrier-imm compute-live-vregs
dup src>> setter-live-vregs ;
M: ##fixnum-add compute-live-vregs record-live ; M: ##fixnum-add compute-live-vregs record-live ;
M: ##fixnum-sub compute-live-vregs record-live ; M: ##fixnum-sub compute-live-vregs record-live ;
@ -91,6 +97,8 @@ M: ##set-slot-imm live-insn? obj>> live-vreg? ;
M: ##write-barrier live-insn? src>> live-vreg? ; M: ##write-barrier live-insn? src>> live-vreg? ;
M: ##write-barrier-imm live-insn? src>> live-vreg? ;
M: ##fixnum-add live-insn? drop t ; M: ##fixnum-add live-insn? drop t ;
M: ##fixnum-sub live-insn? drop t ; M: ##fixnum-sub live-insn? drop t ;

View File

@ -619,8 +619,13 @@ literal: size class
temp: temp/int-rep ; temp: temp/int-rep ;
INSN: ##write-barrier INSN: ##write-barrier
use: src/int-rep slot/int-rep
temp: temp1/int-rep temp2/int-rep ;
INSN: ##write-barrier-imm
use: src/int-rep use: src/int-rep
temp: card#/int-rep table/int-rep ; literal: slot
temp: temp1/int-rep temp2/int-rep ;
INSN: ##alien-global INSN: ##alien-global
def: dst/int-rep def: dst/int-rep

View File

@ -1,7 +1,7 @@
! 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 classes.algebra
compiler.tree.propagation.info compiler.cfg.stacks compiler.cfg.hats fry compiler.tree.propagation.info compiler.cfg.stacks compiler.cfg.hats
compiler.cfg.registers compiler.cfg.instructions compiler.cfg.registers compiler.cfg.instructions
compiler.cfg.utilities compiler.cfg.builder.blocks ; compiler.cfg.utilities compiler.cfg.builder.blocks ;
IN: compiler.cfg.intrinsics.slots IN: compiler.cfg.intrinsics.slots
@ -30,25 +30,25 @@ IN: compiler.cfg.intrinsics.slots
ds-push ds-push
] [ drop emit-primitive ] if ; ] [ drop emit-primitive ] if ;
: (emit-set-slot) ( infos -- obj-reg ) : (emit-set-slot) ( infos -- )
[ 3inputs ] [ second value-tag ] bi* [ first class>> immediate class<= ]
^^tag-offset>slot over [ ##set-slot ] dip ; [ [ 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 -- obj-reg ) : (emit-set-slot-imm) ( infos -- )
ds-drop ds-drop
[ 2inputs ] [ first class>> immediate class<= ]
[ [ third literal>> ] [ second value-tag ] bi ] bi* [ [ 2inputs ] [ [ third literal>> ] [ second value-tag ] bi ] bi* ] bi
pick [ ##set-slot-imm ] dip ; '[ _ ##set-slot-imm ]
[ '[ _ drop _ _ cells next-vreg next-vreg ##write-barrier-imm ] unless ] 3bi ;
: emit-set-slot ( node -- ) : emit-set-slot ( node -- )
dup node-input-infos dup node-input-infos
dup second value-tag [ dup second value-tag [
nip nip
[
dup third value-info-small-fixnum? dup third value-info-small-fixnum?
[ (emit-set-slot-imm) ] [ (emit-set-slot) ] if [ (emit-set-slot-imm) ] [ (emit-set-slot) ] if
] [ first class>> immediate class<= ] bi
[ drop ] [ next-vreg next-vreg ##write-barrier ] if
] [ drop emit-primitive ] if ; ] [ drop emit-primitive ] if ;
: emit-string-nth ( -- ) : emit-string-nth ( -- )

View File

@ -1,139 +1,43 @@
! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg. ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors namespaces assocs sets sequences USING: accessors assocs combinators.short-circuit
fry combinators.short-circuit locals make arrays compiler.cfg.instructions compiler.cfg.rpo kernel namespaces
compiler.cfg sequences sets ;
compiler.cfg.dominance
compiler.cfg.predecessors
compiler.cfg.loop-detection
compiler.cfg.rpo
compiler.cfg.instructions
compiler.cfg.registers
compiler.cfg.dataflow-analysis
compiler.cfg.utilities ;
IN: compiler.cfg.write-barrier IN: compiler.cfg.write-barrier
! Eliminate redundant write barrier hits. SYMBOL: fresh-allocations
! Objects which have already been marked, as well as SYMBOL: mutated-objects
! freshly-allocated objects
SYMBOL: safe
! Objects which have been mutated
SYMBOL: mutated
GENERIC: eliminate-write-barrier ( insn -- ? ) GENERIC: eliminate-write-barrier ( insn -- ? )
M: ##allot eliminate-write-barrier M: ##allot eliminate-write-barrier
dst>> safe get conjoin t ; dst>> fresh-allocations get conjoin t ;
M: ##set-slot eliminate-write-barrier
obj>> mutated-objects get conjoin t ;
M: ##set-slot-imm eliminate-write-barrier
obj>> mutated-objects get conjoin t ;
: needs-write-barrier? ( insn -- ? )
{ [ fresh-allocations get key? not ] [ mutated-objects get key? ] } 1&& ;
M: ##write-barrier eliminate-write-barrier M: ##write-barrier eliminate-write-barrier
src>> dup safe get key? not src>> needs-write-barrier? ;
[ safe get conjoin t ] [ drop f ] if ;
M: ##write-barrier-imm eliminate-write-barrier
src>> needs-write-barrier? ;
M: ##copy eliminate-write-barrier
"Run copy propagation first" throw ;
M: insn eliminate-write-barrier drop t ; M: insn eliminate-write-barrier drop t ;
! This doesn't actually benefit from being a dataflow analysis
! might as well be dominator-based
! Dealing with phi functions would help, though
FORWARD-ANALYSIS: safe
: has-allocation? ( bb -- ? )
instructions>> [ { [ ##allocation? ] [ ##call? ] } 1|| ] any? ;
M: safe-analysis transfer-set
drop [ H{ } assoc-clone-like safe set ] dip
instructions>> [
eliminate-write-barrier drop
] each safe get ;
M: safe-analysis join-sets
drop has-allocation? [ drop H{ } clone ] [ assoc-refine ] if ;
: write-barriers-step ( bb -- ) : write-barriers-step ( bb -- )
dup safe-in H{ } assoc-clone-like safe set H{ } clone fresh-allocations set
H{ } clone mutated-objects set
instructions>> [ eliminate-write-barrier ] filter-here ; instructions>> [ eliminate-write-barrier ] filter-here ;
GENERIC: remove-dead-barrier ( insn -- ? )
M: ##write-barrier remove-dead-barrier
src>> mutated get key? ;
M: ##set-slot remove-dead-barrier
obj>> mutated get conjoin t ;
M: ##set-slot-imm remove-dead-barrier
obj>> mutated get conjoin t ;
M: insn remove-dead-barrier drop t ;
: remove-dead-barriers ( bb -- )
H{ } clone mutated set
instructions>> [ remove-dead-barrier ] filter-here ;
! Availability of slot
! Anticipation of this and set-slot would help too, maybe later
FORWARD-ANALYSIS: slot
UNION: access ##slot ##slot-imm ##set-slot ##set-slot-imm ;
M: slot-analysis transfer-set
drop [ H{ } assoc-clone-like ] dip
instructions>> over '[
dup access? [
obj>> _ conjoin
] [ drop ] if
] each ;
: slot-available? ( vreg bb -- ? )
slot-in key? ;
: make-barriers ( vregs -- bb )
[ [ next-vreg next-vreg ##write-barrier ] each ] V{ } make <simple-block> ;
: emit-barriers ( vregs loop -- )
swap [
[ [ header>> predecessors>> ] [ ends>> keys ] bi diff ]
[ header>> ] bi
] [ make-barriers ] bi*
insert-basic-block ;
: write-barriers ( bbs -- bb=>barriers )
[
dup instructions>>
[ ##write-barrier? ] filter
[ src>> ] map
] { } map>assoc
[ nip empty? not ] assoc-filter ;
: filter-dominant ( bb=>barriers bbs -- barriers )
'[ drop _ [ dominates? ] with all? ] assoc-filter
values concat prune ;
: dominant-write-barriers ( loop -- vregs )
[ blocks>> values write-barriers ] [ ends>> keys ] bi filter-dominant ;
: safe-loops ( -- loops )
loops get values
[ blocks>> keys [ has-allocation? not ] all? ] filter ;
:: insert-extra-barriers ( cfg -- )
safe-loops [| loop |
cfg needs-dominance needs-predecessors drop
loop dominant-write-barriers
loop header>> '[ _ slot-available? ] filter
[ loop emit-barriers cfg cfg-changed drop ] unless-empty
] each ;
: contains-write-barrier? ( cfg -- ? )
post-order [ instructions>> [ ##write-barrier? ] any? ] any? ;
: eliminate-write-barriers ( cfg -- cfg' ) : eliminate-write-barriers ( cfg -- cfg' )
dup contains-write-barrier? [ dup [ write-barriers-step ] each-basic-block ;
needs-loops
dup [ remove-dead-barriers ] each-basic-block
dup compute-slot-sets
dup insert-extra-barriers
dup compute-safe-sets
dup [ write-barriers-step ] each-basic-block
] when ;

View File

@ -63,7 +63,7 @@ M: ##no-tco generate-insn drop ;
M: ##call generate-insn M: ##call generate-insn
word>> dup sub-primitive>> word>> dup sub-primitive>>
[ first % ] [ [ add-call ] [ %call ] bi ] ?if ; [ second first % ] [ [ add-call ] [ %call ] bi ] ?if ;
M: ##jump generate-insn word>> [ add-call ] [ %jump ] bi ; M: ##jump generate-insn word>> [ add-call ] [ %jump ] bi ;
@ -218,6 +218,7 @@ CODEGEN: ##set-alien-double %set-alien-double
CODEGEN: ##set-alien-vector %set-alien-vector CODEGEN: ##set-alien-vector %set-alien-vector
CODEGEN: ##allot %allot CODEGEN: ##allot %allot
CODEGEN: ##write-barrier %write-barrier CODEGEN: ##write-barrier %write-barrier
CODEGEN: ##write-barrier-imm %write-barrier-imm
CODEGEN: ##compare %compare CODEGEN: ##compare %compare
CODEGEN: ##compare-imm %compare-imm CODEGEN: ##compare-imm %compare-imm
CODEGEN: ##compare-float-ordered %compare-float-ordered CODEGEN: ##compare-float-ordered %compare-float-ordered

View File

@ -77,6 +77,15 @@ SYMBOL: relocation-table
: rel-here ( offset class -- ) : rel-here ( offset class -- )
[ add-literal ] dip rt-here rel-fixup ; [ add-literal ] dip rt-here rel-fixup ;
: rel-vm ( offset class -- )
[ add-literal ] dip rt-vm rel-fixup ;
: rel-cards-offset ( class -- )
rt-cards-offset rel-fixup ;
: rel-decks-offset ( class -- )
rt-decks-offset rel-fixup ;
! And the rest ! And the rest
: resolve-offset ( label-fixup -- offset ) : resolve-offset ( label-fixup -- offset )
label>> offset>> [ "Unresolved label" throw ] unless* ; label>> offset>> [ "Unresolved label" throw ] unless* ;

View File

@ -51,6 +51,8 @@ CONSTANT: rt-stack-chain 9
CONSTANT: rt-untagged 10 CONSTANT: rt-untagged 10
CONSTANT: rt-megamorphic-cache-hits 11 CONSTANT: rt-megamorphic-cache-hits 11
CONSTANT: rt-vm 12 CONSTANT: rt-vm 12
CONSTANT: rt-cards-offset 13
CONSTANT: rt-decks-offset 14
: rc-absolute? ( n -- ? ) : rc-absolute? ( n -- ? )
${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ; ${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;

View File

@ -397,7 +397,8 @@ HOOK: %alien-global cpu ( dst symbol library -- )
HOOK: %vm-field-ptr cpu ( dst fieldname -- ) HOOK: %vm-field-ptr cpu ( dst fieldname -- )
HOOK: %allot cpu ( dst size class temp -- ) HOOK: %allot cpu ( dst size class temp -- )
HOOK: %write-barrier cpu ( src card# table -- ) HOOK: %write-barrier cpu ( src slot temp1 temp2 -- )
HOOK: %write-barrier-imm cpu ( src slot temp1 temp2 -- )
! GC checks ! GC checks
HOOK: %check-nursery cpu ( label size temp1 temp2 -- ) HOOK: %check-nursery cpu ( label size temp1 temp2 -- )

View File

@ -50,7 +50,7 @@ M: x86.32 reserved-area-size 0 ;
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ; M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
: push-vm-ptr ( -- ) : push-vm-ptr ( -- )
0 PUSH rc-absolute-cell rt-vm rel-fixup ; ! push the vm ptr as an argument 0 PUSH 0 rc-absolute-cell rel-vm ; ! push the vm ptr as an argument
M: x86.32 return-struct-in-registers? ( c-type -- ? ) M: x86.32 return-struct-in-registers? ( c-type -- ? )
c-type c-type
@ -263,7 +263,7 @@ M: x86.32 %alien-callback ( quot -- )
4 [ 4 [
EAX swap %load-reference EAX swap %load-reference
EAX PUSH EAX PUSH
param-reg-2 0 MOV rc-absolute-cell rt-vm rel-fixup param-reg-2 %mov-vm-ptr
"c_to_factor" f %alien-invoke "c_to_factor" f %alien-invoke
] with-aligned-stack ; ] with-aligned-stack ;
@ -348,7 +348,7 @@ M:: x86.32 %call-gc ( gc-root-count temp -- )
temp gc-root-base param@ LEA temp gc-root-base param@ LEA
12 [ 12 [
! Pass the VM ptr as the third parameter ! Pass the VM ptr as the third parameter
0 PUSH rc-absolute-cell rt-vm rel-fixup push-vm-ptr
! Pass number of roots as second parameter ! Pass number of roots as second parameter
gc-root-count PUSH gc-root-count PUSH
! Pass pointer to start of GC roots as first parameter ! Pass pointer to start of GC roots as first parameter

View File

@ -75,9 +75,6 @@ M: x86.64 %prepare-unbox ( -- )
param-reg-1 R14 [] MOV param-reg-1 R14 [] MOV
R14 cell SUB ; R14 cell SUB ;
: %mov-vm-ptr ( reg -- )
0 MOV rc-absolute-cell rt-vm rel-fixup ;
M:: x86.64 %unbox ( n rep func -- ) M:: x86.64 %unbox ( n rep func -- )
param-reg-2 %mov-vm-ptr param-reg-2 %mov-vm-ptr
! Call the unboxer ! Call the unboxer
@ -183,11 +180,11 @@ M: x86.64 %alien-invoke
R11 CALL ; R11 CALL ;
M: x86.64 %nest-stacks ( -- ) M: x86.64 %nest-stacks ( -- )
param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup param-reg-1 %mov-vm-ptr
"nest_stacks" f %alien-invoke ; "nest_stacks" f %alien-invoke ;
M: x86.64 %unnest-stacks ( -- ) M: x86.64 %unnest-stacks ( -- )
param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup param-reg-1 %mov-vm-ptr
"unnest_stacks" f %alien-invoke ; "unnest_stacks" f %alien-invoke ;
M: x86.64 %prepare-alien-indirect ( -- ) M: x86.64 %prepare-alien-indirect ( -- )

View File

@ -26,10 +26,10 @@ IN: bootstrap.x86
temp0 temp0 [] MOV temp0 temp0 [] MOV
! save stack pointer ! save stack pointer
temp0 [] stack-reg MOV temp0 [] stack-reg MOV
! load XT
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
! load vm ptr ! load vm ptr
arg1 0 MOV rc-absolute-cell rt-vm jit-rel arg1 0 MOV rc-absolute-cell rt-vm jit-rel
! load XT
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
! go ! go
temp1 JMP temp1 JMP
] jit-primitive jit-define ] jit-primitive jit-define

View File

@ -252,7 +252,7 @@ big-endian off
! pop stack ! pop stack
ds-reg bootstrap-cell SUB ds-reg bootstrap-cell SUB
! pass vm pointer ! pass vm pointer
arg2 0 MOV rc-absolute-cell rt-vm jit-rel arg2 0 MOV 0 jit-literal rc-absolute-cell rt-vm jit-rel
! call quotation ! call quotation
arg1 quot-xt-offset [+] JMP arg1 quot-xt-offset [+] JMP
] \ (call) define-sub-primitive ] \ (call) define-sub-primitive
@ -402,6 +402,7 @@ big-endian off
! Comparisons ! Comparisons
: jit-compare ( insn -- ) : jit-compare ( insn -- )
! load t ! load t
t jit-literal
temp3 0 MOV rc-absolute-cell rt-immediate jit-rel temp3 0 MOV rc-absolute-cell rt-immediate jit-rel
! load f ! load f
temp1 \ f tag-number MOV temp1 \ f tag-number MOV

View File

@ -369,19 +369,17 @@ M: x86 %shl int-rep two-operand [ SHL ] emit-shift ;
M: x86 %shr int-rep two-operand [ SHR ] emit-shift ; M: x86 %shr int-rep two-operand [ SHR ] emit-shift ;
M: x86 %sar int-rep two-operand [ SAR ] emit-shift ; M: x86 %sar int-rep two-operand [ SAR ] emit-shift ;
M: x86 %vm-field-ptr ( dst field -- ) : %mov-vm-ptr ( reg -- )
[ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ] 0 MOV 0 rc-absolute-cell rel-vm ;
[ vm-field-offset ADD ] 2bi ;
: load-zone-ptr ( reg -- ) M: x86 %vm-field-ptr ( dst field -- )
#! Load pointer to start of zone array [ 0 MOV ] dip vm-field-offset rc-absolute-cell rel-vm ;
"nursery" %vm-field-ptr ;
: load-allot-ptr ( nursery-ptr allot-ptr -- ) : load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop load-zone-ptr ] [ swap cell [+] MOV ] 2bi ; [ drop "nursery" %vm-field-ptr ] [ swap [] MOV ] 2bi ;
: inc-allot-ptr ( nursery-ptr n -- ) : inc-allot-ptr ( nursery-ptr n -- )
[ cell [+] ] dip 8 align ADD ; [ [] ] dip 8 align ADD ;
: store-header ( temp class -- ) : store-header ( temp class -- )
[ [] ] [ type-number tag-fixnum ] bi* MOV ; [ [] ] [ type-number tag-fixnum ] bi* MOV ;
@ -395,26 +393,32 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
dst class store-tagged dst class store-tagged
nursery-ptr size inc-allot-ptr ; nursery-ptr size inc-allot-ptr ;
M:: x86 %write-barrier ( src card# table -- ) :: (%write-barrier) ( src slot temp1 temp2 -- )
#! Mark the card pointed to by vreg. ! Compute slot address.
temp1 src MOV
temp1 slot ADD
! Mark the card ! Mark the card
card# src MOV temp1 card-bits SHR
card# card-bits SHR temp2 0 MOV rc-absolute-cell rel-cards-offset
table "cards_offset" %vm-field-ptr temp2 temp1 [+] card-mark <byte> MOV
table table [] MOV
table card# [+] card-mark <byte> MOV
! Mark the card deck ! Mark the card deck
card# deck-bits card-bits - SHR temp1 deck-bits card-bits - SHR
table "decks_offset" %vm-field-ptr temp2 0 MOV rc-absolute-cell rel-decks-offset
table table [] MOV temp2 temp1 [+] card-mark <byte> MOV ;
table card# [+] card-mark <byte> MOV ;
M: x86 %write-barrier ( src slot temp1 temp2 -- ) (%write-barrier) ;
M: x86 %write-barrier-imm ( src slot temp1 temp2 -- ) (%write-barrier) ;
M:: x86 %check-nursery ( label size temp1 temp2 -- ) M:: x86 %check-nursery ( label size temp1 temp2 -- )
temp1 load-zone-ptr temp1 "nursery" %vm-field-ptr
temp2 temp1 cell [+] MOV ! Load 'here' into temp2
temp2 temp1 [] MOV
temp2 size ADD temp2 size ADD
temp1 temp1 3 cells [+] MOV ! Load 'end' into temp1
temp1 temp1 2 cells [+] MOV
temp2 temp1 CMP temp2 temp1 CMP
label JLE ; label JLE ;
@ -1327,8 +1331,8 @@ M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
#! Save Factor stack pointers in case the C code calls a #! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace #! callback which does a GC, which must reliably trace
#! all roots. #! all roots.
temp1 0 MOV rc-absolute-cell rt-vm rel-fixup temp1 "stack_chain" %vm-field-ptr
temp1 temp1 "stack_chain" vm-field-offset [+] MOV temp1 temp1 [] MOV
temp2 stack-reg cell neg [+] LEA temp2 stack-reg cell neg [+] LEA
temp1 [] temp2 MOV temp1 [] temp2 MOV
callback-allowed? [ callback-allowed? [

View File

@ -8,10 +8,10 @@ IN: quotations
<PRIVATE <PRIVATE
: uncurry ( curry -- obj quot ) : uncurry ( curry -- obj quot )
dup 2 slot swap 3 slot ; inline { curry } declare dup 2 slot swap 3 slot ; inline
: uncompose ( compose -- quot quot2 ) : uncompose ( compose -- quot quot2 )
dup 2 slot swap 3 slot ; inline { compose } declare dup 2 slot swap 3 slot ; inline
PRIVATE> PRIVATE>

View File

@ -3,6 +3,6 @@
USING: math sequences kernel ; USING: math sequences kernel ;
IN: benchmark.gc1 IN: benchmark.gc1
: gc1 ( -- ) 10 [ 600000 [ >bignum 1 + ] map drop ] times ; : gc1 ( -- ) 600000 [ >bignum 1 + ] map drop ;
MAIN: gc1 MAIN: gc1

View File

@ -0,0 +1 @@
Slava Pestov

View File

@ -0,0 +1,11 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: math.parser fry sequences kernel assocs hashtables ;
IN: benchmark.gc3
: gc3 ( -- )
1000000 iota
1000000 <hashtable>
'[ [ number>string ] keep _ set-at ] each ;
MAIN: gc3

View File

@ -8,6 +8,14 @@ aging_collector::aging_collector(factor_vm *myvm_) :
(myvm_,myvm_->data->aging,aging_policy(myvm_)) {} (myvm_,myvm_->data->aging,aging_policy(myvm_)) {}
void factor_vm::collect_aging() void factor_vm::collect_aging()
{
{
to_tenured_collector collector(this);
collector.trace_cards(data->tenured,
card_points_to_aging,
simple_unmarker(card_mark_mask));
collector.cheneys_algorithm();
}
{ {
std::swap(data->aging,data->aging_semispace); std::swap(data->aging,data->aging_semispace);
reset_generation(data->aging); reset_generation(data->aging);
@ -16,9 +24,6 @@ void factor_vm::collect_aging()
collector.trace_roots(); collector.trace_roots();
collector.trace_contexts(); collector.trace_contexts();
collector.trace_cards(data->tenured,
card_points_to_aging,
complex_unmarker(card_mark_mask,card_points_to_nursery));
collector.trace_code_heap_roots(&code->points_to_aging); collector.trace_code_heap_roots(&code->points_to_aging);
collector.cheneys_algorithm(); collector.cheneys_algorithm();
update_dirty_code_blocks(&code->points_to_aging); update_dirty_code_blocks(&code->points_to_aging);
@ -26,5 +31,6 @@ void factor_vm::collect_aging()
nursery.here = nursery.start; nursery.here = nursery.start;
code->points_to_nursery.clear(); code->points_to_nursery.clear();
} }
}
} }

View File

@ -16,8 +16,7 @@ array *factor_vm::allot_array(cell capacity, cell fill_)
/* No need for write barrier here. Either the object is in /* No need for write barrier here. Either the object is in
the nursery, or it was allocated directly in tenured space the nursery, or it was allocated directly in tenured space
and the write barrier is already hit for us in that case. */ and the write barrier is already hit for us in that case. */
cell i; for(cell i = 0; i < capacity; i++)
for(i = 0; i < capacity; i++)
new_array->data()[i] = fill.value(); new_array->data()[i] = fill.value();
} }
return new_array.untagged(); return new_array.untagged();
@ -80,6 +79,21 @@ void growable_array::add(cell elt_)
parent_vm->set_array_nth(elements.untagged(),count++,elt.value()); parent_vm->set_array_nth(elements.untagged(),count++,elt.value());
} }
void growable_array::append(array *elts_)
{
factor_vm *parent_vm = elements.parent_vm;
gc_root<array> elts(elts_,parent_vm);
cell capacity = array_capacity(elts.untagged());
if(count + capacity > array_capacity(elements.untagged()))
{
elements = parent_vm->reallot_array(elements.untagged(),
(count + capacity) * 2);
}
for(cell index = 0; index < capacity; index++)
parent_vm->set_array_nth(elements.untagged(),count++,array_nth(elts.untagged(),index));
}
void growable_array::trim() void growable_array::trim()
{ {
factor_vm *parent_vm = elements.parent_vm; factor_vm *parent_vm = elements.parent_vm;

View File

@ -17,8 +17,9 @@ inline void factor_vm::set_array_nth(array *array, cell slot, cell value)
assert(array->h.hi_tag() == ARRAY_TYPE); assert(array->h.hi_tag() == ARRAY_TYPE);
check_tagged_pointer(value); check_tagged_pointer(value);
#endif #endif
array->data()[slot] = value; cell *slot_ptr = &array->data()[slot];
write_barrier(array); *slot_ptr = value;
write_barrier(slot_ptr);
} }
struct growable_array { struct growable_array {
@ -28,6 +29,7 @@ struct growable_array {
explicit growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {} explicit growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
void add(cell elt); void add(cell elt);
void append(array *elts);
void trim(); void trim();
}; };

View File

@ -34,13 +34,15 @@ int factor_vm::number_of_parameters(relocation_type type)
case RT_IMMEDIATE: case RT_IMMEDIATE:
case RT_HERE: case RT_HERE:
case RT_UNTAGGED: case RT_UNTAGGED:
case RT_VM:
return 1; return 1;
case RT_DLSYM: case RT_DLSYM:
return 2; return 2;
case RT_THIS: case RT_THIS:
case RT_STACK_CHAIN: case RT_STACK_CHAIN:
case RT_MEGAMORPHIC_CACHE_HITS: case RT_MEGAMORPHIC_CACHE_HITS:
case RT_VM: case RT_CARDS_OFFSET:
case RT_DECKS_OFFSET:
return 0; return 0;
default: default:
critical_error("Bad rel type",type); critical_error("Bad rel type",type);
@ -179,7 +181,11 @@ cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block
case RT_MEGAMORPHIC_CACHE_HITS: case RT_MEGAMORPHIC_CACHE_HITS:
return (cell)&megamorphic_cache_hits; return (cell)&megamorphic_cache_hits;
case RT_VM: case RT_VM:
return (cell)this; return (cell)this + untag_fixnum(ARG);
case RT_CARDS_OFFSET:
return cards_offset;
case RT_DECKS_OFFSET:
return decks_offset;
default: default:
critical_error("Bad rel type",rel); critical_error("Bad rel type",rel);
return 0; /* Can't happen */ return 0; /* Can't happen */
@ -366,7 +372,6 @@ struct code_block_relocator {
{ {
myvm->relocate_code_block_step(rel,index,compiled); myvm->relocate_code_block_step(rel,index,compiled);
} }
}; };
/* Perform all fixups on a code block */ /* Perform all fixups on a code block */

View File

@ -28,6 +28,10 @@ enum relocation_type {
RT_MEGAMORPHIC_CACHE_HITS, RT_MEGAMORPHIC_CACHE_HITS,
/* address of vm object */ /* address of vm object */
RT_VM, RT_VM,
/* value of vm->cards_offset */
RT_CARDS_OFFSET,
/* value of vm->decks_offset */
RT_DECKS_OFFSET,
}; };
enum relocation_class { enum relocation_class {

View File

@ -30,15 +30,15 @@ template<typename TargetGeneration, typename Policy> struct collector {
return untagged; return untagged;
} }
bool trace_handle(cell *handle) void trace_handle(cell *handle)
{ {
cell pointer = *handle; cell pointer = *handle;
if(immediate_p(pointer)) return false; if(immediate_p(pointer)) return;
object *untagged = myvm->untag<object>(pointer); object *untagged = myvm->untag<object>(pointer);
if(!policy.should_copy_p(untagged)) if(!policy.should_copy_p(untagged))
return false; return;
object *forwarding = resolve_forwarding(untagged); object *forwarding = resolve_forwarding(untagged);
@ -50,24 +50,18 @@ template<typename TargetGeneration, typename Policy> struct collector {
untagged = forwarding; untagged = forwarding;
*handle = RETAG(untagged,TAG(pointer)); *handle = RETAG(untagged,TAG(pointer));
return true;
} }
bool trace_slots(object *ptr) void trace_slots(object *ptr)
{ {
cell *slot = (cell *)ptr; cell *slot = (cell *)ptr;
cell *end = (cell *)((cell)ptr + myvm->binary_payload_start(ptr)); cell *end = (cell *)((cell)ptr + myvm->binary_payload_start(ptr));
bool copied = false;
if(slot != end) if(slot != end)
{ {
slot++; slot++;
for(; slot < end; slot++) copied |= trace_handle(slot); for(; slot < end; slot++) trace_handle(slot);
} }
return copied;
} }
object *promote_object(object *untagged) object *promote_object(object *untagged)

View File

@ -2,23 +2,13 @@ namespace factor
{ {
struct dummy_unmarker { struct dummy_unmarker {
void operator()(bool result, card *ptr) {} void operator()(card *ptr) {}
}; };
struct simple_unmarker { struct simple_unmarker {
card unmask; card unmask;
simple_unmarker(card unmask_) : unmask(unmask_) {} simple_unmarker(card unmask_) : unmask(unmask_) {}
void operator()(bool result, card *ptr) { *ptr &= ~unmask; } void operator()(card *ptr) { *ptr &= ~unmask; }
};
struct complex_unmarker {
card unmask_none, unmask_some;
complex_unmarker(card unmask_none_, card unmask_some_) :
unmask_none(unmask_none_), unmask_some(unmask_some_) {}
void operator()(bool result, card *ptr) {
*ptr &= (result ? ~unmask_some : ~unmask_none);
}
}; };
template<typename TargetGeneration, typename Policy> template<typename TargetGeneration, typename Policy>
@ -28,63 +18,127 @@ struct copying_collector : collector<TargetGeneration,Policy> {
explicit copying_collector(factor_vm *myvm_, TargetGeneration *target_, Policy policy_) : explicit copying_collector(factor_vm *myvm_, TargetGeneration *target_, Policy policy_) :
collector<TargetGeneration,Policy>(myvm_,target_,policy_), scan(target_->here) {} collector<TargetGeneration,Policy>(myvm_,target_,policy_), scan(target_->here) {}
template<typename SourceGeneration> inline cell first_card_in_deck(cell deck)
bool trace_objects_between(SourceGeneration *gen, cell scan, cell *end)
{ {
bool copied = false; return deck << (deck_bits - card_bits);
while(scan && scan < *end)
{
copied |= this->trace_slots((object *)scan);
scan = gen->next_object_after(this->myvm,scan);
} }
return copied; inline cell last_card_in_deck(cell deck)
{
return first_card_in_deck(deck + 1);
} }
template<typename SourceGeneration, typename Unmarker> inline cell card_to_addr(cell c)
bool trace_card(SourceGeneration *gen, card *ptr, Unmarker unmarker)
{ {
cell card_start = this->myvm->card_to_addr(ptr); return c << card_bits + this->data->start;
cell card_scan = card_start + gen->first_object_in_card(card_start);
cell card_end = this->myvm->card_to_addr(ptr + 1);
bool result = this->trace_objects_between(gen,card_scan,&card_end);
unmarker(result,ptr);
this->myvm->gc_stats.cards_scanned++;
return result;
} }
template<typename SourceGeneration, typename Unmarker> inline cell card_deck_for_address(cell a)
bool trace_card_deck(SourceGeneration *gen, card_deck *deck, card mask, Unmarker unmarker)
{ {
card *first_card = this->myvm->deck_to_card(deck); return addr_to_deck(a - this->data->start);
card *last_card = this->myvm->deck_to_card(deck + 1); }
bool copied = false; inline cell card_start_address(cell card)
{
return (card << card_bits) + this->data->start;
}
for(card *ptr = first_card; ptr < last_card; ptr++) inline cell card_end_address(cell card)
if(*ptr & mask) copied |= trace_card(gen,ptr,unmarker); {
return ((card + 1) << card_bits) + this->data->start;
}
this->myvm->gc_stats.decks_scanned++; void trace_partial_objects(cell start, cell end, cell card_start, cell card_end)
{
if(card_start < end)
{
start += sizeof(cell);
return copied; if(start < card_start) start = card_start;
if(end > card_end) end = card_end;
cell *slot_ptr = (cell *)start;
cell *end_ptr = (cell *)end;
if(slot_ptr != end_ptr)
{
for(; slot_ptr < end_ptr; slot_ptr++)
this->trace_handle(slot_ptr);
}
}
} }
template<typename SourceGeneration, typename Unmarker> template<typename SourceGeneration, typename Unmarker>
void trace_cards(SourceGeneration *gen, card mask, Unmarker unmarker) void trace_cards(SourceGeneration *gen, card mask, Unmarker unmarker)
{ {
u64 start = current_micros(); u64 start_time = current_micros();
card_deck *first_deck = this->myvm->addr_to_deck(gen->start); card_deck *decks = this->data->decks;
card_deck *last_deck = this->myvm->addr_to_deck(gen->end); card_deck *cards = this->data->cards;
for(card_deck *ptr = first_deck; ptr < last_deck; ptr++) cell gen_start_card = addr_to_card(gen->start - this->data->start);
if(*ptr & mask) unmarker(trace_card_deck(gen,ptr,mask,unmarker),ptr);
this->myvm->gc_stats.card_scan_time += (current_micros() - start); cell first_deck = card_deck_for_address(gen->start);
cell last_deck = card_deck_for_address(gen->end);
cell start = 0, binary_start = 0, end = 0;
for(cell deck_index = first_deck; deck_index < last_deck; deck_index++)
{
if(decks[deck_index] & mask)
{
this->myvm->gc_stats.decks_scanned++;
cell first_card = first_card_in_deck(deck_index);
cell last_card = last_card_in_deck(deck_index);
for(cell card_index = first_card; card_index < last_card; card_index++)
{
if(cards[card_index] & mask)
{
this->myvm->gc_stats.cards_scanned++;
if(end < card_start_address(card_index))
{
start = gen->find_object_containing_card(card_index - gen_start_card);
binary_start = start + this->myvm->binary_payload_start((object *)start);
end = start + this->myvm->untagged_object_size((object *)start);
}
#ifdef FACTOR_DEBUG
assert(addr_to_card(start - this->data->start) <= card_index);
assert(start < card_end_address(card_index));
#endif
scan_next_object: {
trace_partial_objects(
start,
binary_start,
card_start_address(card_index),
card_end_address(card_index));
if(end < card_end_address(card_index))
{
start = gen->next_object_after(this->myvm,start);
if(start)
{
binary_start = start + this->myvm->binary_payload_start((object *)start);
end = start + this->myvm->untagged_object_size((object *)start);
goto scan_next_object;
}
}
}
unmarker(&cards[card_index]);
if(!start) goto end;
}
}
unmarker(&decks[deck_index]);
}
}
end: this->myvm->gc_stats.card_scan_time += (current_micros() - start_time);
} }
/* Trace all literals referenced from a code block. Only for aging and nursery collections */ /* Trace all literals referenced from a code block. Only for aging and nursery collections */
@ -104,6 +158,16 @@ struct copying_collector : collector<TargetGeneration,Policy> {
for(; iter != end; iter++) trace_literal_references(*iter); for(; iter != end; iter++) trace_literal_references(*iter);
} }
template<typename SourceGeneration>
void trace_objects_between(SourceGeneration *gen, cell scan, cell *end)
{
while(scan && scan < *end)
{
this->trace_slots((object *)scan);
scan = gen->next_object_after(this->myvm,scan);
}
}
void cheneys_algorithm() void cheneys_algorithm()
{ {
trace_objects_between(this->target,scan,&this->target->here); trace_objects_between(this->target,scan,&this->target->here);

View File

@ -5,12 +5,11 @@ namespace factor
void factor_vm::init_card_decks() void factor_vm::init_card_decks()
{ {
cell start = align(data->seg->start,deck_size); cards_offset = (cell)data->cards - addr_to_card(data->start);
cards_offset = (cell)data->cards - (start >> card_bits); decks_offset = (cell)data->decks - addr_to_deck(data->start);
decks_offset = (cell)data->decks - (start >> deck_bits);
} }
data_heap::data_heap(factor_vm *myvm, cell young_size_, cell aging_size_, cell tenured_size_) data_heap::data_heap(cell young_size_, cell aging_size_, cell tenured_size_)
{ {
young_size_ = align(young_size_,deck_size); young_size_ = align(young_size_,deck_size);
aging_size_ = align(aging_size_,deck_size); aging_size_ = align(aging_size_,deck_size);
@ -26,16 +25,16 @@ data_heap::data_heap(factor_vm *myvm, cell young_size_, cell aging_size_, cell t
seg = new segment(total_size); seg = new segment(total_size);
cell cards_size = total_size >> card_bits; cell cards_size = addr_to_card(total_size);
cards = new char[cards_size]; cards = new card[cards_size];
cards_end = cards + cards_size; cards_end = cards + cards_size;
cell decks_size = total_size >> deck_bits; cell decks_size = addr_to_deck(total_size);
decks = new char[decks_size]; decks = new card_deck[decks_size];
decks_end = decks + decks_size; decks_end = decks + decks_size;
cell start = align(seg->start,deck_size); start = align(seg->start,deck_size);
tenured = new tenured_space(tenured_size,start); tenured = new tenured_space(tenured_size,start);
tenured_semispace = new tenured_space(tenured_size,tenured->end); tenured_semispace = new tenured_space(tenured_size,tenured->end);
@ -60,30 +59,24 @@ data_heap::~data_heap()
delete[] decks; delete[] decks;
} }
data_heap *factor_vm::grow_data_heap(data_heap *data, cell requested_bytes) data_heap *data_heap::grow(cell requested_bytes)
{ {
cell new_tenured_size = (data->tenured_size * 2) + requested_bytes; cell new_tenured_size = (tenured_size * 2) + requested_bytes;
return new data_heap(young_size,aging_size,new_tenured_size);
return new data_heap(this,
data->young_size,
data->aging_size,
new_tenured_size);
} }
void factor_vm::clear_cards(old_space *gen) void factor_vm::clear_cards(old_space *gen)
{ {
/* NOTE: reverse order due to heap layout. */ cell first_card = addr_to_card(gen->start - data->start);
card *first_card = addr_to_card(gen->start); cell last_card = addr_to_card(gen->end - data->start);
card *last_card = addr_to_card(gen->end); memset(&data->cards[first_card],0,last_card - first_card);
memset(first_card,0,last_card - first_card);
} }
void factor_vm::clear_decks(old_space *gen) void factor_vm::clear_decks(old_space *gen)
{ {
/* NOTE: reverse order due to heap layout. */ cell first_deck = addr_to_deck(gen->start - data->start);
card_deck *first_deck = addr_to_deck(gen->start); cell last_deck = addr_to_deck(gen->end - data->start);
card_deck *last_deck = addr_to_deck(gen->end); memset(&data->decks[first_deck],0,last_deck - first_deck);
memset(first_deck,0,last_deck - first_deck);
} }
/* After garbage collection, any generations which are now empty need to have /* After garbage collection, any generations which are now empty need to have
@ -110,7 +103,7 @@ void factor_vm::set_data_heap(data_heap *data_)
void factor_vm::init_data_heap(cell young_size, cell aging_size, cell tenured_size, bool secure_gc_) void factor_vm::init_data_heap(cell young_size, cell aging_size, cell tenured_size, bool secure_gc_)
{ {
set_data_heap(new data_heap(this,young_size,aging_size,tenured_size)); set_data_heap(new data_heap(young_size,aging_size,tenured_size));
secure_gc = secure_gc_; secure_gc = secure_gc_;
} }

View File

@ -2,6 +2,8 @@ namespace factor
{ {
struct data_heap { struct data_heap {
cell start;
cell young_size; cell young_size;
cell aging_size; cell aging_size;
cell tenured_size; cell tenured_size;
@ -14,14 +16,15 @@ struct data_heap {
tenured_space *tenured; tenured_space *tenured;
tenured_space *tenured_semispace; tenured_space *tenured_semispace;
char *cards; card *cards;
char *cards_end; card *cards_end;
char *decks; card_deck *decks;
char *decks_end; card_deck *decks_end;
explicit data_heap(factor_vm *myvm, cell young_size, cell aging_size, cell tenured_size); explicit data_heap(cell young_size, cell aging_size, cell tenured_size);
~data_heap(); ~data_heap();
data_heap *grow(cell requested_size);
}; };
static const cell nursery_gen = 0; static const cell nursery_gen = 0;

View File

@ -346,8 +346,6 @@ void factor_vm::factorbug()
print_string(".s .r .c -- print data, retain, call stacks\n"); print_string(".s .r .c -- print data, retain, call stacks\n");
print_string("e -- dump environment\n"); print_string("e -- dump environment\n");
print_string("g -- dump generations\n"); print_string("g -- dump generations\n");
print_string("card <addr> -- print card containing address\n");
print_string("addr <card> -- print address containing card\n");
print_string("data -- data heap dump\n"); print_string("data -- data heap dump\n");
print_string("words -- words dump\n"); print_string("words -- words dump\n");
print_string("tuples -- tuples dump\n"); print_string("tuples -- tuples dump\n");
@ -423,18 +421,6 @@ void factor_vm::factorbug()
} }
else if(strcmp(cmd,"g") == 0) else if(strcmp(cmd,"g") == 0)
dump_generations(); dump_generations();
else if(strcmp(cmd,"card") == 0)
{
cell addr = read_cell_hex();
print_cell_hex((cell)addr_to_card(addr));
nl();
}
else if(strcmp(cmd,"addr") == 0)
{
card *ptr = (card *)read_cell_hex();
print_cell_hex(card_to_addr(ptr));
nl();
}
else if(strcmp(cmd,"q") == 0) else if(strcmp(cmd,"q") == 0)
return; return;
else if(strcmp(cmd,"x") == 0) else if(strcmp(cmd,"x") == 0)

View File

@ -93,19 +93,49 @@ void full_collector::cheneys_algorithm()
} }
} }
void factor_vm::collect_full(cell requested_bytes, bool trace_contexts_p) struct full_updater {
factor_vm *myvm;
full_updater(factor_vm *myvm_) : myvm(myvm_) {}
void operator()(heap_block *block)
{ {
if(current_gc->growing_data_heap) myvm->relocate_code_block((code_block *)block);
}
};
struct literal_and_word_reference_updater {
factor_vm *myvm;
literal_and_word_reference_updater(factor_vm *myvm_) : myvm(myvm_) {}
void operator()(heap_block *block)
{ {
current_gc->old_data_heap = data; code_block *compiled = (code_block *)block;
set_data_heap(grow_data_heap(current_gc->old_data_heap,requested_bytes)); myvm->update_literal_references(compiled);
myvm->update_word_references(compiled);
}
};
void factor_vm::free_unmarked_code_blocks(bool growing_data_heap)
{
if(growing_data_heap)
{
full_updater updater(this);
code->free_unmarked(updater);
} }
else else
{ {
std::swap(data->tenured,data->tenured_semispace); literal_and_word_reference_updater updater(this);
reset_generation(data->tenured); code->free_unmarked(updater);
} }
code->points_to_nursery.clear();
code->points_to_aging.clear();
}
void factor_vm::collect_full_impl(bool trace_contexts_p)
{
full_collector collector(this); full_collector collector(this);
collector.trace_roots(); collector.trace_roots();
@ -116,13 +146,26 @@ void factor_vm::collect_full(cell requested_bytes, bool trace_contexts_p)
} }
collector.cheneys_algorithm(); collector.cheneys_algorithm();
free_unmarked_code_blocks();
reset_generation(data->aging); reset_generation(data->aging);
nursery.here = nursery.start; nursery.here = nursery.start;
}
if(current_gc->growing_data_heap) void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p)
delete current_gc->old_data_heap; {
data_heap *old = data;
set_data_heap(data->grow(requested_bytes));
collect_full_impl(trace_contexts_p);
free_unmarked_code_blocks(true);
delete old;
}
void factor_vm::collect_full(bool trace_contexts_p)
{
std::swap(data->tenured,data->tenured_semispace);
reset_generation(data->tenured);
collect_full_impl(trace_contexts_p);
free_unmarked_code_blocks(false);
} }
} }

View File

@ -12,27 +12,6 @@ gc_state::gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_ge
gc_state::~gc_state() { } gc_state::~gc_state() { }
struct literal_and_word_reference_updater {
factor_vm *myvm;
literal_and_word_reference_updater(factor_vm *myvm_) : myvm(myvm_) {}
void operator()(heap_block *block)
{
code_block *compiled = (code_block *)block;
myvm->update_literal_references(compiled);
myvm->update_word_references(compiled);
}
};
void factor_vm::free_unmarked_code_blocks()
{
literal_and_word_reference_updater updater(this);
code->free_unmarked(updater);
code->points_to_nursery.clear();
code->points_to_aging.clear();
}
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)
{ {
/* The youngest generation that any code block can now reference */ /* The youngest generation that any code block can now reference */
@ -75,6 +54,7 @@ void factor_vm::garbage_collection(cell collecting_gen_, bool growing_data_heap_
resort to growing the data heap */ resort to growing the data heap */
if(current_gc->collecting_tenured_p()) if(current_gc->collecting_tenured_p())
{ {
assert(!current_gc->growing_data_heap);
current_gc->growing_data_heap = true; current_gc->growing_data_heap = true;
/* Since we start tracing again, any previously /* Since we start tracing again, any previously
@ -105,7 +85,14 @@ void factor_vm::garbage_collection(cell collecting_gen_, bool growing_data_heap_
collect_aging(); collect_aging();
} }
else if(current_gc->collecting_tenured_p()) else if(current_gc->collecting_tenured_p())
collect_full(requested_bytes,trace_contexts_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(); record_gc_stats();
@ -249,7 +236,9 @@ object *factor_vm::allot_object(header header, cell size)
/* Allows initialization code to store old->new pointers /* Allows initialization code to store old->new pointers
without hitting the write barrier in the common case of without hitting the write barrier in the common case of
a nursery allocation */ a nursery allocation */
write_barrier(obj); char *start = (char *)obj;
for(cell offset = 0; offset < size; offset += card_size)
write_barrier((cell *)(start + offset));
} }
obj->h = header; obj->h = header;

View File

@ -24,7 +24,6 @@ struct gc_state {
/* sometimes we grow the heap */ /* sometimes we grow the heap */
bool growing_data_heap; bool growing_data_heap;
data_heap *old_data_heap;
/* Which generation is being collected */ /* Which generation is being collected */
cell collecting_gen; cell collecting_gen;

View File

@ -41,9 +41,9 @@ struct jit {
void emit_subprimitive(cell word_) { void emit_subprimitive(cell word_) {
gc_root<word> word(word_,parent_vm); gc_root<word> word(word_,parent_vm);
gc_root<array> code_template(word->subprimitive,parent_vm); gc_root<array> code_pair(word->subprimitive,parent_vm);
if(array_capacity(code_template.untagged()) > 1) literal(parent_vm->T); literals.append(parent_vm->untag<array>(array_nth(code_pair.untagged(),0)));
emit(code_template.value()); emit(array_nth(code_pair.untagged(),1));
} }
void emit_class_lookup(fixnum index, cell type); void emit_class_lookup(fixnum index, cell type);

View File

@ -199,9 +199,6 @@ struct string : public object {
/* The compiled code heap is structured into blocks. */ /* The compiled code heap is structured into blocks. */
struct heap_block struct heap_block
{ {
/* Bit 0: mark
Bit 1-7: type
Bit 8-...: size */
cell header; cell header;
bool marked_p() { return header & 1; } bool marked_p() { return header & 1; }

View File

@ -5,9 +5,8 @@ namespace factor
old_space::old_space(cell size_, cell start_) : zone(size_,start_) old_space::old_space(cell size_, cell start_) : zone(size_,start_)
{ {
cell cards_size = size_ >> card_bits; object_start_offsets = new card[addr_to_card(size_)];
object_start_offsets = new card[cards_size]; object_start_offsets_end = object_start_offsets + addr_to_card(size_);
object_start_offsets_end = object_start_offsets + cards_size;
} }
old_space::~old_space() old_space::~old_space()
@ -15,12 +14,38 @@ old_space::~old_space()
delete[] object_start_offsets; delete[] object_start_offsets;
} }
cell old_space::first_object_in_card(cell card_index)
{
return object_start_offsets[card_index];
}
cell old_space::find_object_containing_card(cell card_index)
{
if(card_index == 0)
return start;
else
{
card_index--;
while(first_object_in_card(card_index) == card_starts_inside_object)
{
#ifdef FACTOR_DEBUG
/* First card should start with an object */
assert(card_index > 0);
#endif
card_index--;
}
return start + (card_index << card_bits) + first_object_in_card(card_index);
}
}
/* we need to remember the first object allocated in the card */ /* we need to remember the first object allocated in the card */
void old_space::record_object_start_offset(object *obj) void old_space::record_object_start_offset(object *obj)
{ {
card *ptr = (card *)((((cell)obj - start) >> card_bits) + (cell)object_start_offsets); cell idx = addr_to_card((cell)obj - start);
if(*ptr == card_starts_inside_object) if(object_start_offsets[idx] == card_starts_inside_object)
*ptr = ((cell)obj & addr_card_mask); object_start_offsets[idx] = ((cell)obj & addr_card_mask);
} }
object *old_space::allot(cell size) object *old_space::allot(cell size)
@ -34,7 +59,7 @@ object *old_space::allot(cell size)
void old_space::clear_object_start_offsets() void old_space::clear_object_start_offsets()
{ {
memset(object_start_offsets,card_starts_inside_object,size >> card_bits); memset(object_start_offsets,card_starts_inside_object,addr_to_card(size));
} }
cell old_space::next_object_after(factor_vm *myvm, cell scan) cell old_space::next_object_after(factor_vm *myvm, cell scan)

View File

@ -10,11 +10,8 @@ struct old_space : zone {
old_space(cell size_, cell start_); old_space(cell size_, cell start_);
~old_space(); ~old_space();
cell first_object_in_card(cell address) cell old_space::first_object_in_card(cell card_index);
{ cell find_object_containing_card(cell card_index);
return object_start_offsets[(address - start) >> card_bits];
}
void record_object_start_offset(object *obj); void record_object_start_offset(object *obj);
object *allot(cell size); object *allot(cell size);
void clear_object_start_offsets(); void clear_object_start_offsets();

View File

@ -211,7 +211,6 @@ void unix_init_signals()
misc_sigaction.sa_sigaction = misc_signal_handler; misc_sigaction.sa_sigaction = misc_signal_handler;
misc_sigaction.sa_flags = SA_SIGINFO; misc_sigaction.sa_flags = SA_SIGINFO;
sigaction_safe(SIGABRT,&misc_sigaction,NULL);
sigaction_safe(SIGQUIT,&misc_sigaction,NULL); sigaction_safe(SIGQUIT,&misc_sigaction,NULL);
sigaction_safe(SIGILL,&misc_sigaction,NULL); sigaction_safe(SIGILL,&misc_sigaction,NULL);

View File

@ -199,7 +199,9 @@ void quotation_jit::iterate_quotation()
/* Primitive calls */ /* Primitive calls */
if(primitive_call_p(i,length)) if(primitive_call_p(i,length))
{ {
emit_with(parent_vm->userenv[JIT_PRIMITIVE],obj.value()); literal(tag_fixnum(0));
literal(obj.value());
emit(parent_vm->userenv[JIT_PRIMITIVE]);
i++; i++;

View File

@ -37,8 +37,9 @@ void factor_vm::primitive_set_slot()
object *obj = untag<object>(dpop()); object *obj = untag<object>(dpop());
cell value = dpop(); cell value = dpop();
obj->slots()[slot] = value; cell *slot_ptr = &obj->slots()[slot];
write_barrier(obj); *slot_ptr = value;
write_barrier(slot_ptr);
} }
void factor_vm::primitive_load_locals() void factor_vm::primitive_load_locals()

View File

@ -45,8 +45,8 @@ void factor_vm::set_string_nth_slow(string *str_, cell index, cell ch)
the bits are clear. */ the bits are clear. */
aux = allot_array_internal<byte_array>(untag_fixnum(str->length) * sizeof(u16)); aux = allot_array_internal<byte_array>(untag_fixnum(str->length) * sizeof(u16));
write_barrier(str.untagged());
str->aux = tag<byte_array>(aux); str->aux = tag<byte_array>(aux);
write_barrier(&str->aux);
} }
else else
aux = untag<byte_array>(str->aux); aux = untag<byte_array>(str->aux);
@ -143,8 +143,8 @@ string* factor_vm::reallot_string(string *str_, cell capacity)
{ {
byte_array *new_aux = allot_byte_array(capacity * sizeof(u16)); byte_array *new_aux = allot_byte_array(capacity * sizeof(u16));
write_barrier(new_str.untagged());
new_str->aux = tag<byte_array>(new_aux); new_str->aux = tag<byte_array>(new_aux);
write_barrier(&new_str->aux);
byte_array *aux = untag<byte_array>(str->aux); byte_array *aux = untag<byte_array>(str->aux);
memcpy(new_aux->data<u16>(),aux->data<u16>(),to_copy * sizeof(u16)); memcpy(new_aux->data<u16>(),aux->data<u16>(),to_copy * sizeof(u16));

View File

@ -203,7 +203,6 @@ struct factor_vm
//data heap //data heap
void init_card_decks(); void init_card_decks();
data_heap *grow_data_heap(data_heap *data, cell requested_bytes);
void clear_cards(old_space *gen); void clear_cards(old_space *gen);
void clear_decks(old_space *gen); void clear_decks(old_space *gen);
void reset_generation(old_space *gen); void reset_generation(old_space *gen);
@ -224,47 +223,23 @@ struct factor_vm
cell find_all_words(); cell find_all_words();
cell object_size(cell tagged); cell object_size(cell tagged);
//write barrier
inline card *addr_to_card(cell a)
{
return (card*)(((cell)(a) >> card_bits) + cards_offset);
}
inline cell card_to_addr(card *c)
{
return ((cell)c - cards_offset) << card_bits;
}
inline card_deck *addr_to_deck(cell a)
{
return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
}
inline cell deck_to_addr(card_deck *c)
{
return ((cell)c - decks_offset) << deck_bits;
}
inline card *deck_to_card(card_deck *d)
{
return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
}
/* the write barrier must be called any time we are potentially storing a /* the write barrier must be called any time we are potentially storing a
pointer from an older generation to a younger one */ pointer from an older generation to a younger one */
inline void write_barrier(object *obj) inline void write_barrier(cell *slot_ptr)
{ {
*addr_to_card((cell)obj) = card_mark_mask; *(char *)(cards_offset + ((cell)slot_ptr >> card_bits)) = card_mark_mask;
*addr_to_deck((cell)obj) = card_mark_mask; *(char *)(decks_offset + ((cell)slot_ptr >> deck_bits)) = card_mark_mask;
} }
// gc // gc
void free_unmarked_code_blocks();
void update_dirty_code_blocks(std::set<code_block *> *remembered_set); void update_dirty_code_blocks(std::set<code_block *> *remembered_set);
void collect_nursery(); void collect_nursery();
void collect_aging(); void collect_aging();
void collect_to_tenured(); void collect_to_tenured();
void collect_full(cell requested_bytes, bool trace_contexts_p); void free_unmarked_code_blocks(bool growing_data_heap);
void collect_full_impl(bool trace_contexts_p);
void collect_growing_heap(cell requested_bytes, bool trace_contexts_p);
void collect_full(bool trace_contexts_p);
void record_gc_stats(); void record_gc_stats();
void garbage_collection(cell gen, bool growing_data_heap, bool trace_contexts_p, cell requested_bytes); void garbage_collection(cell gen, bool growing_data_heap, bool trace_contexts_p, cell requested_bytes);
void gc(); void gc();

View File

@ -25,4 +25,13 @@ static const cell deck_bits = (card_bits + 10);
static const cell deck_size = (1<<deck_bits); static const cell deck_size = (1<<deck_bits);
static const cell addr_deck_mask = (deck_size-1); static const cell addr_deck_mask = (deck_size-1);
inline cell addr_to_card(cell a)
{
return a >> card_bits;
}
inline cell addr_to_deck(cell a)
{
return a >> deck_bits;
}
} }

View File

@ -2,14 +2,13 @@ namespace factor
{ {
struct zone { struct zone {
/* allocation pointer is 'here'; its offset is hardcoded in the /* offset of 'here' and 'end' is hardcoded in compiler backends */
compiler backends */
cell start;
cell here; cell here;
cell size; cell start;
cell end; cell end;
cell size;
zone(cell size_, cell start_) : start(start_), here(0), size(size_), end(start_ + size_) {} zone(cell size_, cell start_) : here(0), start(start_), end(start_ + size_), size(size_) {}
inline bool contains_p(object *pointer) inline bool contains_p(object *pointer)
{ {