Merge branch 'new_gc'
commit
51e0d5c466
|
@ -111,18 +111,25 @@ SYMBOL: jit-relocations
|
|||
: jit-rel ( rc rt -- )
|
||||
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
|
||||
call( -- )
|
||||
jit-literals get >array
|
||||
jit-relocations get >array
|
||||
] B{ } make prefix ;
|
||||
|
||||
: jit-define ( quot name -- )
|
||||
[ make-jit ] dip set ;
|
||||
[ make-jit nip ] dip set ;
|
||||
|
||||
: 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
|
||||
SYMBOL: image
|
||||
|
|
|
@ -42,6 +42,9 @@ M: ##set-slot-imm build-liveness-graph
|
|||
M: ##write-barrier build-liveness-graph
|
||||
dup src>> setter-liveness-graph ;
|
||||
|
||||
M: ##write-barrier-imm build-liveness-graph
|
||||
dup src>> setter-liveness-graph ;
|
||||
|
||||
M: ##allot build-liveness-graph
|
||||
[ 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
|
||||
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-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-imm live-insn? src>> live-vreg? ;
|
||||
|
||||
M: ##fixnum-add live-insn? drop t ;
|
||||
|
||||
M: ##fixnum-sub live-insn? drop t ;
|
||||
|
|
|
@ -619,8 +619,13 @@ literal: size class
|
|||
temp: temp/int-rep ;
|
||||
|
||||
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
|
||||
temp: card#/int-rep table/int-rep ;
|
||||
literal: slot
|
||||
temp: temp1/int-rep temp2/int-rep ;
|
||||
|
||||
INSN: ##alien-global
|
||||
def: dst/int-rep
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
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.utilities compiler.cfg.builder.blocks ;
|
||||
IN: compiler.cfg.intrinsics.slots
|
||||
|
@ -30,25 +30,25 @@ IN: compiler.cfg.intrinsics.slots
|
|||
ds-push
|
||||
] [ drop emit-primitive ] if ;
|
||||
|
||||
: (emit-set-slot) ( infos -- obj-reg )
|
||||
[ 3inputs ] [ second value-tag ] bi*
|
||||
^^tag-offset>slot over [ ##set-slot ] dip ;
|
||||
: (emit-set-slot) ( infos -- )
|
||||
[ first class>> immediate class<= ]
|
||||
[ [ 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
|
||||
[ 2inputs ]
|
||||
[ [ third literal>> ] [ second value-tag ] bi ] bi*
|
||||
pick [ ##set-slot-imm ] dip ;
|
||||
[ first class>> immediate class<= ]
|
||||
[ [ 2inputs ] [ [ third literal>> ] [ second value-tag ] bi ] bi* ] bi
|
||||
'[ _ ##set-slot-imm ]
|
||||
[ '[ _ drop _ _ cells next-vreg next-vreg ##write-barrier-imm ] unless ] 3bi ;
|
||||
|
||||
: emit-set-slot ( node -- )
|
||||
dup node-input-infos
|
||||
dup second value-tag [
|
||||
nip
|
||||
[
|
||||
dup third value-info-small-fixnum?
|
||||
[ (emit-set-slot-imm) ] [ (emit-set-slot) ] if
|
||||
] [ first class>> immediate class<= ] bi
|
||||
[ drop ] [ next-vreg next-vreg ##write-barrier ] if
|
||||
dup third value-info-small-fixnum?
|
||||
[ (emit-set-slot-imm) ] [ (emit-set-slot) ] if
|
||||
] [ drop emit-primitive ] if ;
|
||||
|
||||
: emit-string-nth ( -- )
|
||||
|
|
|
@ -1,139 +1,43 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors namespaces assocs sets sequences
|
||||
fry combinators.short-circuit locals make arrays
|
||||
compiler.cfg
|
||||
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 ;
|
||||
USING: accessors assocs combinators.short-circuit
|
||||
compiler.cfg.instructions compiler.cfg.rpo kernel namespaces
|
||||
sequences sets ;
|
||||
IN: compiler.cfg.write-barrier
|
||||
|
||||
! Eliminate redundant write barrier hits.
|
||||
SYMBOL: fresh-allocations
|
||||
|
||||
! Objects which have already been marked, as well as
|
||||
! freshly-allocated objects
|
||||
SYMBOL: safe
|
||||
|
||||
! Objects which have been mutated
|
||||
SYMBOL: mutated
|
||||
SYMBOL: mutated-objects
|
||||
|
||||
GENERIC: eliminate-write-barrier ( insn -- ? )
|
||||
|
||||
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
|
||||
src>> dup safe get key? not
|
||||
[ safe get conjoin t ] [ drop f ] if ;
|
||||
src>> needs-write-barrier? ;
|
||||
|
||||
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 ;
|
||||
|
||||
! 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 -- )
|
||||
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 ;
|
||||
|
||||
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' )
|
||||
dup contains-write-barrier? [
|
||||
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 ;
|
||||
dup [ write-barriers-step ] each-basic-block ;
|
||||
|
|
|
@ -63,7 +63,7 @@ M: ##no-tco generate-insn drop ;
|
|||
|
||||
M: ##call generate-insn
|
||||
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 ;
|
||||
|
||||
|
@ -218,6 +218,7 @@ CODEGEN: ##set-alien-double %set-alien-double
|
|||
CODEGEN: ##set-alien-vector %set-alien-vector
|
||||
CODEGEN: ##allot %allot
|
||||
CODEGEN: ##write-barrier %write-barrier
|
||||
CODEGEN: ##write-barrier-imm %write-barrier-imm
|
||||
CODEGEN: ##compare %compare
|
||||
CODEGEN: ##compare-imm %compare-imm
|
||||
CODEGEN: ##compare-float-ordered %compare-float-ordered
|
||||
|
|
|
@ -77,6 +77,15 @@ SYMBOL: relocation-table
|
|||
: rel-here ( offset class -- )
|
||||
[ 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
|
||||
: resolve-offset ( label-fixup -- offset )
|
||||
label>> offset>> [ "Unresolved label" throw ] unless* ;
|
||||
|
|
|
@ -51,6 +51,8 @@ CONSTANT: rt-stack-chain 9
|
|||
CONSTANT: rt-untagged 10
|
||||
CONSTANT: rt-megamorphic-cache-hits 11
|
||||
CONSTANT: rt-vm 12
|
||||
CONSTANT: rt-cards-offset 13
|
||||
CONSTANT: rt-decks-offset 14
|
||||
|
||||
: rc-absolute? ( n -- ? )
|
||||
${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;
|
||||
|
|
|
@ -397,7 +397,8 @@ HOOK: %alien-global cpu ( dst symbol library -- )
|
|||
HOOK: %vm-field-ptr cpu ( dst fieldname -- )
|
||||
|
||||
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
|
||||
HOOK: %check-nursery cpu ( label size temp1 temp2 -- )
|
||||
|
|
|
@ -50,7 +50,7 @@ M: x86.32 reserved-area-size 0 ;
|
|||
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
|
||||
|
||||
: 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 -- ? )
|
||||
c-type
|
||||
|
@ -263,7 +263,7 @@ M: x86.32 %alien-callback ( quot -- )
|
|||
4 [
|
||||
EAX swap %load-reference
|
||||
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
|
||||
] with-aligned-stack ;
|
||||
|
||||
|
@ -348,7 +348,7 @@ M:: x86.32 %call-gc ( gc-root-count temp -- )
|
|||
temp gc-root-base param@ LEA
|
||||
12 [
|
||||
! 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
|
||||
gc-root-count PUSH
|
||||
! Pass pointer to start of GC roots as first parameter
|
||||
|
|
|
@ -75,9 +75,6 @@ M: x86.64 %prepare-unbox ( -- )
|
|||
param-reg-1 R14 [] MOV
|
||||
R14 cell SUB ;
|
||||
|
||||
: %mov-vm-ptr ( reg -- )
|
||||
0 MOV rc-absolute-cell rt-vm rel-fixup ;
|
||||
|
||||
M:: x86.64 %unbox ( n rep func -- )
|
||||
param-reg-2 %mov-vm-ptr
|
||||
! Call the unboxer
|
||||
|
@ -183,11 +180,11 @@ M: x86.64 %alien-invoke
|
|||
R11 CALL ;
|
||||
|
||||
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 ;
|
||||
|
||||
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 ;
|
||||
|
||||
M: x86.64 %prepare-alien-indirect ( -- )
|
||||
|
|
|
@ -26,10 +26,10 @@ IN: bootstrap.x86
|
|||
temp0 temp0 [] MOV
|
||||
! save stack pointer
|
||||
temp0 [] stack-reg MOV
|
||||
! load XT
|
||||
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
|
||||
! load vm ptr
|
||||
arg1 0 MOV rc-absolute-cell rt-vm jit-rel
|
||||
! load XT
|
||||
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
|
||||
! go
|
||||
temp1 JMP
|
||||
] jit-primitive jit-define
|
||||
|
|
|
@ -252,7 +252,7 @@ big-endian off
|
|||
! pop stack
|
||||
ds-reg bootstrap-cell SUB
|
||||
! 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
|
||||
arg1 quot-xt-offset [+] JMP
|
||||
] \ (call) define-sub-primitive
|
||||
|
@ -402,6 +402,7 @@ big-endian off
|
|||
! Comparisons
|
||||
: jit-compare ( insn -- )
|
||||
! load t
|
||||
t jit-literal
|
||||
temp3 0 MOV rc-absolute-cell rt-immediate jit-rel
|
||||
! load f
|
||||
temp1 \ f tag-number MOV
|
||||
|
|
|
@ -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 %sar int-rep two-operand [ SAR ] emit-shift ;
|
||||
|
||||
M: x86 %vm-field-ptr ( dst field -- )
|
||||
[ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
|
||||
[ vm-field-offset ADD ] 2bi ;
|
||||
: %mov-vm-ptr ( reg -- )
|
||||
0 MOV 0 rc-absolute-cell rel-vm ;
|
||||
|
||||
: load-zone-ptr ( reg -- )
|
||||
#! Load pointer to start of zone array
|
||||
"nursery" %vm-field-ptr ;
|
||||
M: x86 %vm-field-ptr ( dst field -- )
|
||||
[ 0 MOV ] dip vm-field-offset rc-absolute-cell rel-vm ;
|
||||
|
||||
: 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 -- )
|
||||
[ cell [+] ] dip 8 align ADD ;
|
||||
[ [] ] dip 8 align ADD ;
|
||||
|
||||
: store-header ( temp class -- )
|
||||
[ [] ] [ type-number tag-fixnum ] bi* MOV ;
|
||||
|
@ -395,26 +393,32 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
|
|||
dst class store-tagged
|
||||
nursery-ptr size inc-allot-ptr ;
|
||||
|
||||
M:: x86 %write-barrier ( src card# table -- )
|
||||
#! Mark the card pointed to by vreg.
|
||||
:: (%write-barrier) ( src slot temp1 temp2 -- )
|
||||
! Compute slot address.
|
||||
temp1 src MOV
|
||||
temp1 slot ADD
|
||||
|
||||
! Mark the card
|
||||
card# src MOV
|
||||
card# card-bits SHR
|
||||
table "cards_offset" %vm-field-ptr
|
||||
table table [] MOV
|
||||
table card# [+] card-mark <byte> MOV
|
||||
temp1 card-bits SHR
|
||||
temp2 0 MOV rc-absolute-cell rel-cards-offset
|
||||
temp2 temp1 [+] card-mark <byte> MOV
|
||||
|
||||
! Mark the card deck
|
||||
card# deck-bits card-bits - SHR
|
||||
table "decks_offset" %vm-field-ptr
|
||||
table table [] MOV
|
||||
table card# [+] card-mark <byte> MOV ;
|
||||
temp1 deck-bits card-bits - SHR
|
||||
temp2 0 MOV rc-absolute-cell rel-decks-offset
|
||||
temp2 temp1 [+] 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 -- )
|
||||
temp1 load-zone-ptr
|
||||
temp2 temp1 cell [+] MOV
|
||||
temp1 "nursery" %vm-field-ptr
|
||||
! Load 'here' into temp2
|
||||
temp2 temp1 [] MOV
|
||||
temp2 size ADD
|
||||
temp1 temp1 3 cells [+] MOV
|
||||
! Load 'end' into temp1
|
||||
temp1 temp1 2 cells [+] MOV
|
||||
temp2 temp1 CMP
|
||||
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
|
||||
#! callback which does a GC, which must reliably trace
|
||||
#! all roots.
|
||||
temp1 0 MOV rc-absolute-cell rt-vm rel-fixup
|
||||
temp1 temp1 "stack_chain" vm-field-offset [+] MOV
|
||||
temp1 "stack_chain" %vm-field-ptr
|
||||
temp1 temp1 [] MOV
|
||||
temp2 stack-reg cell neg [+] LEA
|
||||
temp1 [] temp2 MOV
|
||||
callback-allowed? [
|
||||
|
|
|
@ -8,10 +8,10 @@ IN: quotations
|
|||
<PRIVATE
|
||||
|
||||
: uncurry ( curry -- obj quot )
|
||||
dup 2 slot swap 3 slot ; inline
|
||||
{ curry } declare dup 2 slot swap 3 slot ; inline
|
||||
|
||||
: uncompose ( compose -- quot quot2 )
|
||||
dup 2 slot swap 3 slot ; inline
|
||||
{ compose } declare dup 2 slot swap 3 slot ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
@ -3,6 +3,6 @@
|
|||
USING: math sequences kernel ;
|
||||
IN: benchmark.gc1
|
||||
|
||||
: gc1 ( -- ) 10 [ 600000 [ >bignum 1 + ] map drop ] times ;
|
||||
: gc1 ( -- ) 600000 [ >bignum 1 + ] map drop ;
|
||||
|
||||
MAIN: gc1
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -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
|
|
@ -9,22 +9,28 @@ aging_collector::aging_collector(factor_vm *myvm_) :
|
|||
|
||||
void factor_vm::collect_aging()
|
||||
{
|
||||
std::swap(data->aging,data->aging_semispace);
|
||||
reset_generation(data->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);
|
||||
reset_generation(data->aging);
|
||||
|
||||
aging_collector collector(this);
|
||||
aging_collector collector(this);
|
||||
|
||||
collector.trace_roots();
|
||||
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.cheneys_algorithm();
|
||||
update_dirty_code_blocks(&code->points_to_aging);
|
||||
collector.trace_roots();
|
||||
collector.trace_contexts();
|
||||
collector.trace_code_heap_roots(&code->points_to_aging);
|
||||
collector.cheneys_algorithm();
|
||||
update_dirty_code_blocks(&code->points_to_aging);
|
||||
|
||||
nursery.here = nursery.start;
|
||||
code->points_to_nursery.clear();
|
||||
nursery.here = nursery.start;
|
||||
code->points_to_nursery.clear();
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -16,8 +16,7 @@ array *factor_vm::allot_array(cell capacity, cell fill_)
|
|||
/* No need for write barrier here. Either the object is in
|
||||
the nursery, or it was allocated directly in tenured space
|
||||
and the write barrier is already hit for us in that case. */
|
||||
cell i;
|
||||
for(i = 0; i < capacity; i++)
|
||||
for(cell i = 0; i < capacity; i++)
|
||||
new_array->data()[i] = fill.value();
|
||||
}
|
||||
return new_array.untagged();
|
||||
|
@ -65,14 +64,14 @@ cell factor_vm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
|
|||
|
||||
void factor_vm::primitive_resize_array()
|
||||
{
|
||||
array* a = untag_check<array>(dpop());
|
||||
array *a = untag_check<array>(dpop());
|
||||
cell capacity = unbox_array_size();
|
||||
dpush(tag<array>(reallot_array(a,capacity)));
|
||||
}
|
||||
|
||||
void growable_array::add(cell elt_)
|
||||
{
|
||||
factor_vm* parent_vm = elements.parent_vm;
|
||||
factor_vm *parent_vm = elements.parent_vm;
|
||||
gc_root<object> elt(elt_,parent_vm);
|
||||
if(count == array_capacity(elements.untagged()))
|
||||
elements = parent_vm->reallot_array(elements.untagged(),count * 2);
|
||||
|
@ -80,6 +79,21 @@ void growable_array::add(cell elt_)
|
|||
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()
|
||||
{
|
||||
factor_vm *parent_vm = elements.parent_vm;
|
||||
|
|
|
@ -17,8 +17,9 @@ inline void factor_vm::set_array_nth(array *array, cell slot, cell value)
|
|||
assert(array->h.hi_tag() == ARRAY_TYPE);
|
||||
check_tagged_pointer(value);
|
||||
#endif
|
||||
array->data()[slot] = value;
|
||||
write_barrier(array);
|
||||
cell *slot_ptr = &array->data()[slot];
|
||||
*slot_ptr = value;
|
||||
write_barrier(slot_ptr);
|
||||
}
|
||||
|
||||
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) {}
|
||||
|
||||
void add(cell elt);
|
||||
void append(array *elts);
|
||||
void trim();
|
||||
};
|
||||
|
||||
|
|
|
@ -34,13 +34,15 @@ int factor_vm::number_of_parameters(relocation_type type)
|
|||
case RT_IMMEDIATE:
|
||||
case RT_HERE:
|
||||
case RT_UNTAGGED:
|
||||
case RT_VM:
|
||||
return 1;
|
||||
case RT_DLSYM:
|
||||
return 2;
|
||||
case RT_THIS:
|
||||
case RT_STACK_CHAIN:
|
||||
case RT_MEGAMORPHIC_CACHE_HITS:
|
||||
case RT_VM:
|
||||
case RT_CARDS_OFFSET:
|
||||
case RT_DECKS_OFFSET:
|
||||
return 0;
|
||||
default:
|
||||
critical_error("Bad rel type",type);
|
||||
|
@ -168,7 +170,7 @@ cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block
|
|||
case RT_HERE:
|
||||
{
|
||||
fixnum arg = untag_fixnum(ARG);
|
||||
return (arg >= 0 ? offset + arg : (cell)(compiled +1) - arg);
|
||||
return (arg >= 0 ? offset + arg : (cell)(compiled + 1) - arg);
|
||||
}
|
||||
case RT_THIS:
|
||||
return (cell)(compiled + 1);
|
||||
|
@ -179,7 +181,11 @@ cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block
|
|||
case RT_MEGAMORPHIC_CACHE_HITS:
|
||||
return (cell)&megamorphic_cache_hits;
|
||||
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:
|
||||
critical_error("Bad rel type",rel);
|
||||
return 0; /* Can't happen */
|
||||
|
@ -366,7 +372,6 @@ struct code_block_relocator {
|
|||
{
|
||||
myvm->relocate_code_block_step(rel,index,compiled);
|
||||
}
|
||||
|
||||
};
|
||||
|
||||
/* Perform all fixups on a code block */
|
||||
|
|
|
@ -28,6 +28,10 @@ enum relocation_type {
|
|||
RT_MEGAMORPHIC_CACHE_HITS,
|
||||
/* address of vm object */
|
||||
RT_VM,
|
||||
/* value of vm->cards_offset */
|
||||
RT_CARDS_OFFSET,
|
||||
/* value of vm->decks_offset */
|
||||
RT_DECKS_OFFSET,
|
||||
};
|
||||
|
||||
enum relocation_class {
|
||||
|
|
|
@ -30,15 +30,15 @@ template<typename TargetGeneration, typename Policy> struct collector {
|
|||
return untagged;
|
||||
}
|
||||
|
||||
bool trace_handle(cell *handle)
|
||||
void trace_handle(cell *handle)
|
||||
{
|
||||
cell pointer = *handle;
|
||||
|
||||
if(immediate_p(pointer)) return false;
|
||||
if(immediate_p(pointer)) return;
|
||||
|
||||
object *untagged = myvm->untag<object>(pointer);
|
||||
if(!policy.should_copy_p(untagged))
|
||||
return false;
|
||||
return;
|
||||
|
||||
object *forwarding = resolve_forwarding(untagged);
|
||||
|
||||
|
@ -50,24 +50,18 @@ template<typename TargetGeneration, typename Policy> struct collector {
|
|||
untagged = forwarding;
|
||||
|
||||
*handle = RETAG(untagged,TAG(pointer));
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
bool trace_slots(object *ptr)
|
||||
void trace_slots(object *ptr)
|
||||
{
|
||||
cell *slot = (cell *)ptr;
|
||||
cell *end = (cell *)((cell)ptr + myvm->binary_payload_start(ptr));
|
||||
|
||||
bool copied = false;
|
||||
|
||||
if(slot != end)
|
||||
{
|
||||
slot++;
|
||||
for(; slot < end; slot++) copied |= trace_handle(slot);
|
||||
for(; slot < end; slot++) trace_handle(slot);
|
||||
}
|
||||
|
||||
return copied;
|
||||
}
|
||||
|
||||
object *promote_object(object *untagged)
|
||||
|
|
|
@ -2,23 +2,13 @@ namespace factor
|
|||
{
|
||||
|
||||
struct dummy_unmarker {
|
||||
void operator()(bool result, card *ptr) {}
|
||||
void operator()(card *ptr) {}
|
||||
};
|
||||
|
||||
struct simple_unmarker {
|
||||
card unmask;
|
||||
simple_unmarker(card unmask_) : unmask(unmask_) {}
|
||||
void operator()(bool result, 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);
|
||||
}
|
||||
void operator()(card *ptr) { *ptr &= ~unmask; }
|
||||
};
|
||||
|
||||
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_) :
|
||||
collector<TargetGeneration,Policy>(myvm_,target_,policy_), scan(target_->here) {}
|
||||
|
||||
template<typename SourceGeneration>
|
||||
bool trace_objects_between(SourceGeneration *gen, cell scan, cell *end)
|
||||
inline cell first_card_in_deck(cell deck)
|
||||
{
|
||||
bool copied = false;
|
||||
return deck << (deck_bits - card_bits);
|
||||
}
|
||||
|
||||
while(scan && scan < *end)
|
||||
inline cell last_card_in_deck(cell deck)
|
||||
{
|
||||
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)
|
||||
{
|
||||
return addr_to_deck(a - this->data->start);
|
||||
}
|
||||
|
||||
inline cell card_start_address(cell card)
|
||||
{
|
||||
return (card << card_bits) + this->data->start;
|
||||
}
|
||||
|
||||
inline cell card_end_address(cell card)
|
||||
{
|
||||
return ((card + 1) << card_bits) + this->data->start;
|
||||
}
|
||||
|
||||
void trace_partial_objects(cell start, cell end, cell card_start, cell card_end)
|
||||
{
|
||||
if(card_start < end)
|
||||
{
|
||||
copied |= this->trace_slots((object *)scan);
|
||||
scan = gen->next_object_after(this->myvm,scan);
|
||||
start += sizeof(cell);
|
||||
|
||||
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);
|
||||
}
|
||||
}
|
||||
|
||||
return copied;
|
||||
}
|
||||
|
||||
template<typename SourceGeneration, typename Unmarker>
|
||||
bool trace_card(SourceGeneration *gen, card *ptr, Unmarker unmarker)
|
||||
{
|
||||
cell card_start = this->myvm->card_to_addr(ptr);
|
||||
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>
|
||||
bool trace_card_deck(SourceGeneration *gen, card_deck *deck, card mask, Unmarker unmarker)
|
||||
{
|
||||
card *first_card = this->myvm->deck_to_card(deck);
|
||||
card *last_card = this->myvm->deck_to_card(deck + 1);
|
||||
|
||||
bool copied = false;
|
||||
|
||||
for(card *ptr = first_card; ptr < last_card; ptr++)
|
||||
if(*ptr & mask) copied |= trace_card(gen,ptr,unmarker);
|
||||
|
||||
this->myvm->gc_stats.decks_scanned++;
|
||||
|
||||
return copied;
|
||||
}
|
||||
|
||||
template<typename SourceGeneration, typename Unmarker>
|
||||
void trace_cards(SourceGeneration *gen, card mask, Unmarker unmarker)
|
||||
{
|
||||
u64 start = current_micros();
|
||||
u64 start_time = current_micros();
|
||||
|
||||
card_deck *decks = this->data->decks;
|
||||
card_deck *cards = this->data->cards;
|
||||
|
||||
cell gen_start_card = addr_to_card(gen->start - this->data->start);
|
||||
|
||||
card_deck *first_deck = this->myvm->addr_to_deck(gen->start);
|
||||
card_deck *last_deck = this->myvm->addr_to_deck(gen->end);
|
||||
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++;
|
||||
|
||||
for(card_deck *ptr = first_deck; ptr < last_deck; ptr++)
|
||||
if(*ptr & mask) unmarker(trace_card_deck(gen,ptr,mask,unmarker),ptr);
|
||||
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++;
|
||||
|
||||
this->myvm->gc_stats.card_scan_time += (current_micros() - start);
|
||||
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 */
|
||||
|
@ -104,6 +158,16 @@ struct copying_collector : collector<TargetGeneration,Policy> {
|
|||
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()
|
||||
{
|
||||
trace_objects_between(this->target,scan,&this->target->here);
|
||||
|
|
|
@ -5,12 +5,11 @@ namespace factor
|
|||
|
||||
void factor_vm::init_card_decks()
|
||||
{
|
||||
cell start = align(data->seg->start,deck_size);
|
||||
cards_offset = (cell)data->cards - (start >> card_bits);
|
||||
decks_offset = (cell)data->decks - (start >> deck_bits);
|
||||
cards_offset = (cell)data->cards - addr_to_card(data->start);
|
||||
decks_offset = (cell)data->decks - addr_to_deck(data->start);
|
||||
}
|
||||
|
||||
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);
|
||||
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);
|
||||
|
||||
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;
|
||||
|
||||
cell decks_size = total_size >> deck_bits;
|
||||
decks = new char[decks_size];
|
||||
cell decks_size = addr_to_deck(total_size);
|
||||
decks = new card_deck[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_semispace = new tenured_space(tenured_size,tenured->end);
|
||||
|
@ -60,30 +59,24 @@ data_heap::~data_heap()
|
|||
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;
|
||||
|
||||
return new data_heap(this,
|
||||
data->young_size,
|
||||
data->aging_size,
|
||||
new_tenured_size);
|
||||
cell new_tenured_size = (tenured_size * 2) + requested_bytes;
|
||||
return new data_heap(young_size,aging_size,new_tenured_size);
|
||||
}
|
||||
|
||||
void factor_vm::clear_cards(old_space *gen)
|
||||
{
|
||||
/* NOTE: reverse order due to heap layout. */
|
||||
card *first_card = addr_to_card(gen->start);
|
||||
card *last_card = addr_to_card(gen->end);
|
||||
memset(first_card,0,last_card - first_card);
|
||||
cell first_card = addr_to_card(gen->start - data->start);
|
||||
cell last_card = addr_to_card(gen->end - data->start);
|
||||
memset(&data->cards[first_card],0,last_card - first_card);
|
||||
}
|
||||
|
||||
void factor_vm::clear_decks(old_space *gen)
|
||||
{
|
||||
/* NOTE: reverse order due to heap layout. */
|
||||
card_deck *first_deck = addr_to_deck(gen->start);
|
||||
card_deck *last_deck = addr_to_deck(gen->end);
|
||||
memset(first_deck,0,last_deck - first_deck);
|
||||
cell first_deck = addr_to_deck(gen->start - data->start);
|
||||
cell last_deck = addr_to_deck(gen->end - data->start);
|
||||
memset(&data->decks[first_deck],0,last_deck - first_deck);
|
||||
}
|
||||
|
||||
/* 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_)
|
||||
{
|
||||
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_;
|
||||
}
|
||||
|
||||
|
|
|
@ -2,6 +2,8 @@ namespace factor
|
|||
{
|
||||
|
||||
struct data_heap {
|
||||
cell start;
|
||||
|
||||
cell young_size;
|
||||
cell aging_size;
|
||||
cell tenured_size;
|
||||
|
@ -14,14 +16,15 @@ struct data_heap {
|
|||
tenured_space *tenured;
|
||||
tenured_space *tenured_semispace;
|
||||
|
||||
char *cards;
|
||||
char *cards_end;
|
||||
card *cards;
|
||||
card *cards_end;
|
||||
|
||||
char *decks;
|
||||
char *decks_end;
|
||||
card_deck *decks;
|
||||
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 *grow(cell requested_size);
|
||||
};
|
||||
|
||||
static const cell nursery_gen = 0;
|
||||
|
|
14
vm/debug.cpp
14
vm/debug.cpp
|
@ -346,8 +346,6 @@ void factor_vm::factorbug()
|
|||
print_string(".s .r .c -- print data, retain, call stacks\n");
|
||||
print_string("e -- dump environment\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("words -- words dump\n");
|
||||
print_string("tuples -- tuples dump\n");
|
||||
|
@ -423,18 +421,6 @@ void factor_vm::factorbug()
|
|||
}
|
||||
else if(strcmp(cmd,"g") == 0)
|
||||
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)
|
||||
return;
|
||||
else if(strcmp(cmd,"x") == 0)
|
||||
|
|
|
@ -93,19 +93,49 @@ void full_collector::cheneys_algorithm()
|
|||
}
|
||||
}
|
||||
|
||||
void factor_vm::collect_full(cell requested_bytes, bool trace_contexts_p)
|
||||
{
|
||||
if(current_gc->growing_data_heap)
|
||||
struct full_updater {
|
||||
factor_vm *myvm;
|
||||
|
||||
full_updater(factor_vm *myvm_) : myvm(myvm_) {}
|
||||
|
||||
void operator()(heap_block *block)
|
||||
{
|
||||
current_gc->old_data_heap = data;
|
||||
set_data_heap(grow_data_heap(current_gc->old_data_heap,requested_bytes));
|
||||
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)
|
||||
{
|
||||
code_block *compiled = (code_block *)block;
|
||||
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
|
||||
{
|
||||
std::swap(data->tenured,data->tenured_semispace);
|
||||
reset_generation(data->tenured);
|
||||
literal_and_word_reference_updater updater(this);
|
||||
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);
|
||||
|
||||
collector.trace_roots();
|
||||
|
@ -116,13 +146,26 @@ void factor_vm::collect_full(cell requested_bytes, bool trace_contexts_p)
|
|||
}
|
||||
|
||||
collector.cheneys_algorithm();
|
||||
free_unmarked_code_blocks();
|
||||
|
||||
reset_generation(data->aging);
|
||||
nursery.here = nursery.start;
|
||||
}
|
||||
|
||||
if(current_gc->growing_data_heap)
|
||||
delete current_gc->old_data_heap;
|
||||
void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p)
|
||||
{
|
||||
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);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
35
vm/gc.cpp
35
vm/gc.cpp
|
@ -12,27 +12,6 @@ gc_state::gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_ge
|
|||
|
||||
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)
|
||||
{
|
||||
/* 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 */
|
||||
if(current_gc->collecting_tenured_p())
|
||||
{
|
||||
assert(!current_gc->growing_data_heap);
|
||||
current_gc->growing_data_heap = true;
|
||||
|
||||
/* 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();
|
||||
}
|
||||
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();
|
||||
|
||||
|
@ -249,7 +236,9 @@ object *factor_vm::allot_object(header header, cell size)
|
|||
/* Allows initialization code to store old->new pointers
|
||||
without hitting the write barrier in the common case of
|
||||
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;
|
||||
|
|
|
@ -24,7 +24,6 @@ struct gc_state {
|
|||
|
||||
/* sometimes we grow the heap */
|
||||
bool growing_data_heap;
|
||||
data_heap *old_data_heap;
|
||||
|
||||
/* Which generation is being collected */
|
||||
cell collecting_gen;
|
||||
|
|
|
@ -45,13 +45,13 @@ template<typename Array> Array *factor_vm::reallot_array(Array *array_, cell cap
|
|||
cell to_copy = array_capacity(array.untagged());
|
||||
if(capacity < to_copy)
|
||||
to_copy = capacity;
|
||||
|
||||
|
||||
Array *new_array = allot_array_internal<Array>(capacity);
|
||||
|
||||
|
||||
memcpy(new_array + 1,array.untagged() + 1,to_copy * Array::element_size);
|
||||
memset((char *)(new_array + 1) + to_copy * Array::element_size,
|
||||
0,(capacity - to_copy) * Array::element_size);
|
||||
|
||||
|
||||
return new_array;
|
||||
}
|
||||
}
|
||||
|
|
|
@ -41,9 +41,9 @@ struct jit {
|
|||
|
||||
void emit_subprimitive(cell word_) {
|
||||
gc_root<word> word(word_,parent_vm);
|
||||
gc_root<array> code_template(word->subprimitive,parent_vm);
|
||||
if(array_capacity(code_template.untagged()) > 1) literal(parent_vm->T);
|
||||
emit(code_template.value());
|
||||
gc_root<array> code_pair(word->subprimitive,parent_vm);
|
||||
literals.append(parent_vm->untag<array>(array_nth(code_pair.untagged(),0)));
|
||||
emit(array_nth(code_pair.untagged(),1));
|
||||
}
|
||||
|
||||
void emit_class_lookup(fixnum index, cell type);
|
||||
|
|
|
@ -199,9 +199,6 @@ struct string : public object {
|
|||
/* The compiled code heap is structured into blocks. */
|
||||
struct heap_block
|
||||
{
|
||||
/* Bit 0: mark
|
||||
Bit 1-7: type
|
||||
Bit 8-...: size */
|
||||
cell header;
|
||||
|
||||
bool marked_p() { return header & 1; }
|
||||
|
|
|
@ -5,9 +5,8 @@ namespace factor
|
|||
|
||||
old_space::old_space(cell size_, cell start_) : zone(size_,start_)
|
||||
{
|
||||
cell cards_size = size_ >> card_bits;
|
||||
object_start_offsets = new card[cards_size];
|
||||
object_start_offsets_end = object_start_offsets + cards_size;
|
||||
object_start_offsets = new card[addr_to_card(size_)];
|
||||
object_start_offsets_end = object_start_offsets + addr_to_card(size_);
|
||||
}
|
||||
|
||||
old_space::~old_space()
|
||||
|
@ -15,12 +14,38 @@ old_space::~old_space()
|
|||
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 */
|
||||
void old_space::record_object_start_offset(object *obj)
|
||||
{
|
||||
card *ptr = (card *)((((cell)obj - start) >> card_bits) + (cell)object_start_offsets);
|
||||
if(*ptr == card_starts_inside_object)
|
||||
*ptr = ((cell)obj & addr_card_mask);
|
||||
cell idx = addr_to_card((cell)obj - start);
|
||||
if(object_start_offsets[idx] == card_starts_inside_object)
|
||||
object_start_offsets[idx] = ((cell)obj & addr_card_mask);
|
||||
}
|
||||
|
||||
object *old_space::allot(cell size)
|
||||
|
@ -34,7 +59,7 @@ object *old_space::allot(cell size)
|
|||
|
||||
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)
|
||||
|
|
|
@ -10,11 +10,8 @@ struct old_space : zone {
|
|||
old_space(cell size_, cell start_);
|
||||
~old_space();
|
||||
|
||||
cell first_object_in_card(cell address)
|
||||
{
|
||||
return object_start_offsets[(address - start) >> card_bits];
|
||||
}
|
||||
|
||||
cell old_space::first_object_in_card(cell card_index);
|
||||
cell find_object_containing_card(cell card_index);
|
||||
void record_object_start_offset(object *obj);
|
||||
object *allot(cell size);
|
||||
void clear_object_start_offsets();
|
||||
|
|
|
@ -211,7 +211,6 @@ void unix_init_signals()
|
|||
misc_sigaction.sa_sigaction = misc_signal_handler;
|
||||
misc_sigaction.sa_flags = SA_SIGINFO;
|
||||
|
||||
sigaction_safe(SIGABRT,&misc_sigaction,NULL);
|
||||
sigaction_safe(SIGQUIT,&misc_sigaction,NULL);
|
||||
sigaction_safe(SIGILL,&misc_sigaction,NULL);
|
||||
|
||||
|
|
|
@ -199,7 +199,9 @@ void quotation_jit::iterate_quotation()
|
|||
/* Primitive calls */
|
||||
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++;
|
||||
|
||||
|
|
|
@ -37,8 +37,9 @@ void factor_vm::primitive_set_slot()
|
|||
object *obj = untag<object>(dpop());
|
||||
cell value = dpop();
|
||||
|
||||
obj->slots()[slot] = value;
|
||||
write_barrier(obj);
|
||||
cell *slot_ptr = &obj->slots()[slot];
|
||||
*slot_ptr = value;
|
||||
write_barrier(slot_ptr);
|
||||
}
|
||||
|
||||
void factor_vm::primitive_load_locals()
|
||||
|
|
|
@ -45,8 +45,8 @@ void factor_vm::set_string_nth_slow(string *str_, cell index, cell ch)
|
|||
the bits are clear. */
|
||||
aux = allot_array_internal<byte_array>(untag_fixnum(str->length) * sizeof(u16));
|
||||
|
||||
write_barrier(str.untagged());
|
||||
str->aux = tag<byte_array>(aux);
|
||||
write_barrier(&str->aux);
|
||||
}
|
||||
else
|
||||
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));
|
||||
|
||||
write_barrier(new_str.untagged());
|
||||
new_str->aux = tag<byte_array>(new_aux);
|
||||
write_barrier(&new_str->aux);
|
||||
|
||||
byte_array *aux = untag<byte_array>(str->aux);
|
||||
memcpy(new_aux->data<u16>(),aux->data<u16>(),to_copy * sizeof(u16));
|
||||
|
|
39
vm/vm.hpp
39
vm/vm.hpp
|
@ -203,7 +203,6 @@ struct factor_vm
|
|||
|
||||
//data heap
|
||||
void init_card_decks();
|
||||
data_heap *grow_data_heap(data_heap *data, cell requested_bytes);
|
||||
void clear_cards(old_space *gen);
|
||||
void clear_decks(old_space *gen);
|
||||
void reset_generation(old_space *gen);
|
||||
|
@ -224,47 +223,23 @@ struct factor_vm
|
|||
cell find_all_words();
|
||||
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
|
||||
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;
|
||||
*addr_to_deck((cell)obj) = card_mark_mask;
|
||||
*(char *)(cards_offset + ((cell)slot_ptr >> card_bits)) = card_mark_mask;
|
||||
*(char *)(decks_offset + ((cell)slot_ptr >> deck_bits)) = card_mark_mask;
|
||||
}
|
||||
|
||||
// gc
|
||||
void free_unmarked_code_blocks();
|
||||
void update_dirty_code_blocks(std::set<code_block *> *remembered_set);
|
||||
void collect_nursery();
|
||||
void collect_aging();
|
||||
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 garbage_collection(cell gen, bool growing_data_heap, bool trace_contexts_p, cell requested_bytes);
|
||||
void gc();
|
||||
|
|
|
@ -25,4 +25,13 @@ static const cell deck_bits = (card_bits + 10);
|
|||
static const cell deck_size = (1<<deck_bits);
|
||||
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;
|
||||
}
|
||||
}
|
||||
|
|
|
@ -2,14 +2,13 @@ namespace factor
|
|||
{
|
||||
|
||||
struct zone {
|
||||
/* allocation pointer is 'here'; its offset is hardcoded in the
|
||||
compiler backends */
|
||||
cell start;
|
||||
/* offset of 'here' and 'end' is hardcoded in compiler backends */
|
||||
cell here;
|
||||
cell size;
|
||||
cell start;
|
||||
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)
|
||||
{
|
||||
|
|
Loading…
Reference in New Issue