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

Don't generate GC checks if the allocation instruction is optimized out

db4
Slava Pestov 2008-11-02 01:50:48 -06:00
parent 8df1aba71d
commit 3834eaeb05
6 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/compiler/cfg/cfg.factor
View File

@ -11,8 +11,7 @@ TUPLE: basic-block < identity-tuple
id id
number number
instructions instructions
successors successors ;
gc ;
: <basic-block> ( -- basic-block ) : <basic-block> ( -- basic-block )
basic-block new basic-block new

6
basis/compiler/cfg/intrinsics/allot/allot.factor
View File

@ -13,8 +13,7 @@ IN: compiler.cfg.intrinsics.allot
: emit-simple-allot ( node -- ) : emit-simple-allot ( node -- )
[ in-d>> length ] [ node-output-infos first class>> ] bi [ in-d>> length ] [ node-output-infos first class>> ] bi
[ drop ds-load ] [ [ 1+ cells ] dip ^^allot ] [ nip ] 2tri [ drop ds-load ] [ [ 1+ cells ] dip ^^allot ] [ nip ] 2tri
[ ##set-slots ] [ [ drop ] [ ds-push ] [ drop ] tri* ] 3bi [ ##set-slots ] [ [ drop ] [ ds-push ] [ drop ] tri* ] 3bi ;
need-gc ;
: tuple-slot-regs ( layout -- vregs ) : tuple-slot-regs ( layout -- vregs )
[ size>> ds-load ] [ ^^load-literal ] bi prefix ; [ size>> ds-load ] [ ^^load-literal ] bi prefix ;
@ -26,7 +25,6 @@ IN: compiler.cfg.intrinsics.allot
ds-drop ds-drop
[ tuple-slot-regs ] [ size>> ^^allot-tuple ] bi [ tuple-slot-regs ] [ size>> ^^allot-tuple ] bi
[ tuple ##set-slots ] [ ds-push drop ] 2bi [ tuple ##set-slots ] [ ds-push drop ] 2bi
need-gc
] [ drop emit-primitive ] if ; ] [ drop emit-primitive ] if ;
: store-length ( len reg -- ) : store-length ( len reg -- )
@ -47,7 +45,6 @@ IN: compiler.cfg.intrinsics.allot
len reg store-length len reg store-length
elt reg len store-initial-element elt reg len store-initial-element
reg ds-push reg ds-push
need-gc
] ]
] [ node emit-primitive ] if ] [ node emit-primitive ] if
] ; ] ;
@ -66,7 +63,6 @@ IN: compiler.cfg.intrinsics.allot
len reg store-length len reg store-length
elt reg len bytes>cells store-initial-element elt reg len bytes>cells store-initial-element
reg ds-push reg ds-push
need-gc
] ]
] [ node emit-primitive ] if ] [ node emit-primitive ] if
] ; ] ;

2
basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
View File

@ -60,4 +60,4 @@ IN: compiler.cfg.intrinsics.fixnum
ds-pop ^^bignum>integer ^^tag-fixnum ds-push ; ds-pop ^^bignum>integer ^^tag-fixnum ds-push ;
: emit-fixnum>bignum ( -- ) : emit-fixnum>bignum ( -- )
ds-pop ^^untag-fixnum ^^integer>bignum ds-push need-gc ; ds-pop ^^untag-fixnum ^^integer>bignum ds-push ;

6
basis/compiler/cfg/intrinsics/float/float.factor
View File

@ -6,8 +6,7 @@ IN: compiler.cfg.intrinsics.float
: emit-float-op ( insn -- ) : emit-float-op ( insn -- )
[ 2inputs [ ^^unbox-float ] bi@ ] dip call ^^box-float [ 2inputs [ ^^unbox-float ] bi@ ] dip call ^^box-float
ds-push ds-push ; inline
need-gc ; inline
: emit-float-comparison ( cc -- ) : emit-float-comparison ( cc -- )
[ 2inputs [ ^^unbox-float ] bi@ ] dip ^^compare-float [ 2inputs [ ^^unbox-float ] bi@ ] dip ^^compare-float
@ -17,5 +16,4 @@ IN: compiler.cfg.intrinsics.float
ds-pop ^^unbox-float ^^float>integer ^^tag-fixnum ds-push ; ds-pop ^^unbox-float ^^float>integer ^^tag-fixnum ds-push ;
: emit-fixnum>float ( -- ) : emit-fixnum>float ( -- )
ds-pop ^^untag-fixnum ^^integer>float ^^box-float ds-push ds-pop ^^untag-fixnum ^^integer>float ^^box-float ds-push ;
need-gc ;

14
basis/compiler/cfg/linearization/linearization.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math accessors sequences namespaces make USING: kernel math accessors sequences namespaces make
combinators combinators classes
compiler.cfg compiler.cfg
compiler.cfg.rpo compiler.cfg.rpo
compiler.cfg.instructions ; compiler.cfg.instructions ;
@ -51,9 +51,19 @@ M: ##compare-imm-branch linearize-insn
M: ##compare-float-branch linearize-insn M: ##compare-float-branch linearize-insn
binary-conditional _compare-float-branch emit-branch ; binary-conditional _compare-float-branch emit-branch ;
: gc? ( bb -- ? )
instructions>> [
class {
##allot
##integer>bignum
##box-float
##box-alien
} memq?
] contains? ;
: linearize-basic-block ( bb -- ) : linearize-basic-block ( bb -- )
[ number>> _label ] [ number>> _label ]
[ gc>> [ _gc ] when ] [ gc? [ _gc ] when ]
[ linearize-insns ] [ linearize-insns ]
tri ; tri ;

2
basis/compiler/cfg/utilities/utilities.factor
View File

@ -23,5 +23,3 @@ IN: compiler.cfg.utilities
: emit-primitive ( node -- ) : emit-primitive ( node -- )
word>> ##call begin-basic-block ; word>> ##call begin-basic-block ;
: need-gc ( -- ) basic-block get t >>gc drop ;