Overflowing fixnum intrinsics now expand into several CFG nodes. This speeds up the common case since only the uncommon case is now a stack syncpoint
Slava Pestov
parent
685e32b091
commit
e76dce8aff
basis
compiler
cfg
branch-splitting
build-stack-frame
builder
checker
def-use
hats
instructions
intrinsics
linear-scan
linearization
renaming
stack-analysis
tco
two-operand
utilities
codegen
tree
debugger
finalization
modular-arithmetic
cpu
architecture
x86
|
|
@ -1,6 +1,6 @@
|
|||
USING: accessors assocs compiler.cfg
|
||||
compiler.cfg.branch-splitting compiler.cfg.debugger
|
||||
compiler.cfg.predecessors compiler.cfg.rpo fry kernel
|
||||
compiler.cfg.predecessors compiler.cfg.rpo compiler.cfg.instructions fry kernel
|
||||
tools.test namespaces sequences vectors ;
|
||||
IN: compiler.cfg.branch-splitting.tests
|
||||
|
||||
|
|
@ -20,31 +20,31 @@ IN: compiler.cfg.branch-splitting.tests
|
|||
: test-branch-splitting ( -- )
|
||||
cfg new 0 get >>entry check-branch-splitting ;
|
||||
|
||||
V{ } 0 test-bb
|
||||
V{ T{ ##branch } } 0 test-bb
|
||||
|
||||
V{ } 1 test-bb
|
||||
V{ T{ ##branch } } 1 test-bb
|
||||
|
||||
V{ } 2 test-bb
|
||||
V{ T{ ##branch } } 2 test-bb
|
||||
|
||||
V{ } 3 test-bb
|
||||
V{ T{ ##branch } } 3 test-bb
|
||||
|
||||
V{ } 4 test-bb
|
||||
V{ T{ ##branch } } 4 test-bb
|
||||
|
||||
test-diamond
|
||||
|
||||
[ ] [ test-branch-splitting ] unit-test
|
||||
|
||||
V{ } 0 test-bb
|
||||
V{ T{ ##branch } } 0 test-bb
|
||||
|
||||
V{ } 1 test-bb
|
||||
V{ T{ ##branch } } 1 test-bb
|
||||
|
||||
V{ } 2 test-bb
|
||||
V{ T{ ##branch } } 2 test-bb
|
||||
|
||||
V{ } 3 test-bb
|
||||
V{ T{ ##branch } } 3 test-bb
|
||||
|
||||
V{ } 4 test-bb
|
||||
V{ T{ ##branch } } 4 test-bb
|
||||
|
||||
V{ } 5 test-bb
|
||||
V{ T{ ##branch } } 5 test-bb
|
||||
|
||||
0 get 1 get 2 get V{ } 2sequence >>successors drop
|
||||
|
||||
|
|
@ -54,15 +54,15 @@ V{ } 5 test-bb
|
|||
|
||||
[ ] [ test-branch-splitting ] unit-test
|
||||
|
||||
V{ } 0 test-bb
|
||||
V{ T{ ##branch } } 0 test-bb
|
||||
|
||||
V{ } 1 test-bb
|
||||
V{ T{ ##branch } } 1 test-bb
|
||||
|
||||
V{ } 2 test-bb
|
||||
V{ T{ ##branch } } 2 test-bb
|
||||
|
||||
V{ } 3 test-bb
|
||||
V{ T{ ##branch } } 3 test-bb
|
||||
|
||||
V{ } 4 test-bb
|
||||
V{ T{ ##branch } } 4 test-bb
|
||||
|
||||
0 get 1 get 2 get V{ } 2sequence >>successors drop
|
||||
|
||||
|
|
@ -72,11 +72,11 @@ V{ } 4 test-bb
|
|||
|
||||
[ ] [ test-branch-splitting ] unit-test
|
||||
|
||||
V{ } 0 test-bb
|
||||
V{ T{ ##branch } } 0 test-bb
|
||||
|
||||
V{ } 1 test-bb
|
||||
V{ T{ ##branch } } 1 test-bb
|
||||
|
||||
V{ } 2 test-bb
|
||||
V{ T{ ##branch } } 2 test-bb
|
||||
|
||||
0 get 1 get 2 get V{ } 2sequence >>successors drop
|
||||
|
||||
|
|
|
|||
|
|
@ -63,7 +63,9 @@ IN: compiler.cfg.branch-splitting
|
|||
UNION: irrelevant ##peek ##replace ##inc-d ##inc-r ;
|
||||
|
||||
: split-instructions? ( insns -- ? )
|
||||
[ irrelevant? not ] count 5 <= ;
|
||||
[ [ irrelevant? not ] count 5 <= ]
|
||||
[ last ##fixnum-overflow? not ]
|
||||
bi and ;
|
||||
|
||||
: split-branch? ( bb -- ? )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces accessors math.order assocs kernel sequences
|
||||
combinators make classes words cpu.architecture
|
||||
|
|
@ -36,12 +36,6 @@ M: insn compute-stack-frame*
|
|||
] when ;
|
||||
|
||||
\ _spill t frame-required? set-word-prop
|
||||
\ ##fixnum-add t frame-required? set-word-prop
|
||||
\ ##fixnum-sub t frame-required? set-word-prop
|
||||
\ ##fixnum-mul t frame-required? set-word-prop
|
||||
\ ##fixnum-add-tail f frame-required? set-word-prop
|
||||
\ ##fixnum-sub-tail f frame-required? set-word-prop
|
||||
\ ##fixnum-mul-tail f frame-required? set-word-prop
|
||||
|
||||
: compute-stack-frame ( insns -- )
|
||||
frame-required? off
|
||||
|
|
|
|||
|
|
@ -98,17 +98,10 @@ M: #recursive emit-node
|
|||
|
||||
! #if
|
||||
: emit-branch ( obj -- final-bb )
|
||||
[
|
||||
begin-basic-block
|
||||
emit-nodes
|
||||
basic-block get dup [ ##branch ] when
|
||||
] with-scope ;
|
||||
[ emit-nodes ] with-branch ;
|
||||
|
||||
: emit-if ( node -- )
|
||||
children>> [ emit-branch ] map
|
||||
end-basic-block
|
||||
begin-basic-block
|
||||
basic-block get '[ [ _ swap successors>> push ] when* ] each ;
|
||||
children>> [ emit-branch ] map emit-conditional ;
|
||||
|
||||
: ##branch-t ( vreg -- )
|
||||
\ f tag-number cc/= ##compare-imm-branch ;
|
||||
|
|
|
|||
|
|
@ -16,9 +16,9 @@ ERROR: last-insn-not-a-jump insn ;
|
|||
[ ##return? ]
|
||||
[ ##callback-return? ]
|
||||
[ ##jump? ]
|
||||
[ ##fixnum-add-tail? ]
|
||||
[ ##fixnum-sub-tail? ]
|
||||
[ ##fixnum-mul-tail? ]
|
||||
[ ##fixnum-add? ]
|
||||
[ ##fixnum-sub? ]
|
||||
[ ##fixnum-mul? ]
|
||||
[ ##no-tco? ]
|
||||
} 1|| [ drop ] [ last-insn-not-a-jump ] if ;
|
||||
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@ GENERIC: temp-vregs ( insn -- seq )
|
|||
GENERIC: uses-vregs ( insn -- seq )
|
||||
|
||||
M: ##flushable defs-vregs dst>> 1array ;
|
||||
M: ##fixnum-overflow defs-vregs dst>> 1array ;
|
||||
M: insn defs-vregs drop f ;
|
||||
|
||||
M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ;
|
||||
|
|
@ -21,8 +22,6 @@ M: ##set-string-nth-fast temp-vregs temp>> 1array ;
|
|||
M: ##compare temp-vregs temp>> 1array ;
|
||||
M: ##compare-imm temp-vregs temp>> 1array ;
|
||||
M: ##compare-float temp-vregs temp>> 1array ;
|
||||
M: ##fixnum-mul temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
|
||||
M: ##fixnum-mul-tail temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
|
||||
M: ##gc temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
|
||||
M: _dispatch temp-vregs temp>> 1array ;
|
||||
M: insn temp-vregs drop f ;
|
||||
|
|
|
|||
|
|
@ -73,5 +73,7 @@ IN: compiler.cfg.hats
|
|||
: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] when ; inline
|
||||
: ^^tag-fixnum ( src -- dst ) ^^i1 ##tag-fixnum ; inline
|
||||
: ^^untag-fixnum ( src -- dst ) ^^i1 ##untag-fixnum ; inline
|
||||
|
||||
: ^^fixnum-add ( src1 src2 -- dst ) ^^i2 ##fixnum-add ; inline
|
||||
: ^^fixnum-sub ( src1 src2 -- dst ) ^^i2 ##fixnum-sub ; inline
|
||||
: ^^fixnum-mul ( src1 src2 -- dst ) ^^i2 ##fixnum-mul ; inline
|
||||
: ^^phi ( inputs -- dst ) ^^i1 ##phi ; inline
|
||||
|
|
@ -92,15 +92,6 @@ INSN: ##sar-imm < ##binary-imm ;
|
|||
INSN: ##not < ##unary ;
|
||||
INSN: ##log2 < ##unary ;
|
||||
|
||||
! Overflowing arithmetic
|
||||
TUPLE: ##fixnum-overflow < insn src1 src2 ;
|
||||
INSN: ##fixnum-add < ##fixnum-overflow ;
|
||||
INSN: ##fixnum-add-tail < ##fixnum-overflow ;
|
||||
INSN: ##fixnum-sub < ##fixnum-overflow ;
|
||||
INSN: ##fixnum-sub-tail < ##fixnum-overflow ;
|
||||
INSN: ##fixnum-mul < ##fixnum-overflow temp1 temp2 ;
|
||||
INSN: ##fixnum-mul-tail < ##fixnum-overflow temp1 temp2 ;
|
||||
|
||||
: ##tag-fixnum ( dst src -- ) tag-bits get ##shl-imm ; inline
|
||||
: ##untag-fixnum ( dst src -- ) tag-bits get ##sar-imm ; inline
|
||||
|
||||
|
|
@ -181,6 +172,7 @@ INSN: ##loop-entry ;
|
|||
|
||||
INSN: ##phi < ##pure inputs ;
|
||||
|
||||
! Conditionals
|
||||
TUPLE: ##conditional-branch < insn { src1 vreg } { src2 vreg } cc ;
|
||||
|
||||
INSN: ##compare-branch < ##conditional-branch ;
|
||||
|
|
@ -192,6 +184,12 @@ INSN: ##compare-imm < ##binary-imm cc temp ;
|
|||
INSN: ##compare-float-branch < ##conditional-branch ;
|
||||
INSN: ##compare-float < ##binary cc temp ;
|
||||
|
||||
! Overflowing arithmetic
|
||||
TUPLE: ##fixnum-overflow < insn { dst vreg } { src1 vreg } { src2 vreg } ;
|
||||
INSN: ##fixnum-add < ##fixnum-overflow ;
|
||||
INSN: ##fixnum-sub < ##fixnum-overflow ;
|
||||
INSN: ##fixnum-mul < ##fixnum-overflow ;
|
||||
|
||||
INSN: ##gc { temp1 vreg } { temp2 vreg } live-values ;
|
||||
|
||||
! Instructions used by machine IR only.
|
||||
|
|
@ -212,6 +210,12 @@ INSN: _compare-imm-branch label { src1 vreg } { src2 integer } cc ;
|
|||
|
||||
INSN: _compare-float-branch < _conditional-branch ;
|
||||
|
||||
! Overflowing arithmetic
|
||||
TUPLE: _fixnum-overflow < insn label { dst vreg } { src1 vreg } { src2 vreg } ;
|
||||
INSN: _fixnum-add < _fixnum-overflow ;
|
||||
INSN: _fixnum-sub < _fixnum-overflow ;
|
||||
INSN: _fixnum-mul < _fixnum-overflow ;
|
||||
|
||||
TUPLE: spill-slot n ; C: <spill-slot> spill-slot
|
||||
|
||||
INSN: _gc { temp1 vreg } { temp2 vreg } gc-roots gc-root-count gc-root-size ;
|
||||
|
|
@ -227,10 +231,7 @@ INSN: _spill-counts counts ;
|
|||
UNION: poison-insn
|
||||
##jump
|
||||
##return
|
||||
##callback-return
|
||||
##fixnum-mul-tail
|
||||
##fixnum-add-tail
|
||||
##fixnum-sub-tail ;
|
||||
##callback-return ;
|
||||
|
||||
! Instructions that kill all live vregs
|
||||
UNION: kill-vreg-insn
|
||||
|
|
@ -239,9 +240,6 @@ UNION: kill-vreg-insn
|
|||
##call
|
||||
##prologue
|
||||
##epilogue
|
||||
##fixnum-mul
|
||||
##fixnum-add
|
||||
##fixnum-sub
|
||||
##alien-invoke
|
||||
##alien-indirect
|
||||
##alien-callback ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: sequences accessors layouts kernel math namespaces
|
||||
combinators fry
|
||||
combinators fry arrays
|
||||
compiler.tree.propagation.info
|
||||
compiler.cfg.hats
|
||||
compiler.cfg.stacks
|
||||
|
|
@ -54,6 +54,28 @@ IN: compiler.cfg.intrinsics.fixnum
|
|||
: emit-fixnum>bignum ( -- )
|
||||
ds-pop ^^untag-fixnum ^^integer>bignum ds-push ;
|
||||
|
||||
: emit-fixnum-overflow-op ( quot -- next )
|
||||
[ 2inputs 1 ##inc-d ] dip call ##branch
|
||||
begin-basic-block ; inline
|
||||
: emit-no-overflow-case ( dst -- final-bb )
|
||||
[ -2 ##inc-d ds-push ] with-branch ;
|
||||
|
||||
: emit-overflow-case ( word -- final-bb )
|
||||
[ ##call ] with-branch ;
|
||||
|
||||
: emit-fixnum-overflow-op ( quot word -- )
|
||||
[ [ D 1 ^^peek D 0 ^^peek ] dip call ] dip
|
||||
[ emit-no-overflow-case ] [ emit-overflow-case ] bi* 2array
|
||||
emit-conditional ; inline
|
||||
|
||||
: fixnum+overflow ( x y -- z ) [ >bignum ] bi@ + ;
|
||||
|
||||
: fixnum-overflow ( x y -- z ) [ >bignum ] bi@ - ;
|
||||
|
||||
: fixnum*overflow ( x y -- z ) [ >bignum ] bi@ * ;
|
||||
|
||||
: emit-fixnum+ ( -- )
|
||||
[ ^^fixnum-add ] \ fixnum+overflow emit-fixnum-overflow-op ;
|
||||
|
||||
: emit-fixnum- ( -- )
|
||||
[ ^^fixnum-sub ] \ fixnum-overflow emit-fixnum-overflow-op ;
|
||||
|
||||
: emit-fixnum* ( -- )
|
||||
[ ^^untag-fixnum ^^fixnum-mul ] \ fixnum*overflow emit-fixnum-overflow-op ;
|
||||
|
|
@ -100,9 +100,9 @@ IN: compiler.cfg.intrinsics
|
|||
{ \ kernel.private:tag [ drop emit-tag ] }
|
||||
{ \ kernel.private:getenv [ emit-getenv ] }
|
||||
{ \ math.private:both-fixnums? [ drop emit-both-fixnums? ] }
|
||||
{ \ math.private:fixnum+ [ drop [ ##fixnum-add ] emit-fixnum-overflow-op ] }
|
||||
{ \ math.private:fixnum- [ drop [ ##fixnum-sub ] emit-fixnum-overflow-op ] }
|
||||
{ \ math.private:fixnum* [ drop [ i i ##fixnum-mul ] emit-fixnum-overflow-op ] }
|
||||
{ \ math.private:fixnum+ [ drop emit-fixnum+ ] }
|
||||
{ \ math.private:fixnum- [ drop emit-fixnum- ] }
|
||||
{ \ math.private:fixnum* [ drop emit-fixnum* ] }
|
||||
{ \ math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] }
|
||||
{ \ math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] }
|
||||
{ \ math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] }
|
||||
|
|
|
|||
|
|
@ -2159,12 +2159,7 @@ V{
|
|||
T{ ##replace { src V int-regs 85 } { loc D 1 } }
|
||||
T{ ##replace { src V int-regs 89 } { loc D 4 } }
|
||||
T{ ##replace { src V int-regs 96 } { loc R 0 } }
|
||||
T{ ##fixnum-mul
|
||||
{ src1 V int-regs 128 }
|
||||
{ src2 V int-regs 129 }
|
||||
{ temp1 V int-regs 132 }
|
||||
{ temp2 V int-regs 133 }
|
||||
}
|
||||
T{ ##replace { src V int-regs 129 } { loc R 0 } }
|
||||
T{ ##branch }
|
||||
} 2 test-bb
|
||||
|
||||
|
|
@ -2255,206 +2250,6 @@ V{
|
|||
|
||||
[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
|
||||
|
||||
! Another push-all reduction to demonstrate numbering anamoly
|
||||
V{ T{ ##prologue } T{ ##branch } }
|
||||
0 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek { dst V int-regs 1 } { loc D 0 } }
|
||||
T{ ##slot-imm
|
||||
{ dst V int-regs 5 }
|
||||
{ obj V int-regs 1 }
|
||||
{ slot 3 }
|
||||
{ tag 7 }
|
||||
}
|
||||
T{ ##peek { dst V int-regs 7 } { loc D 1 } }
|
||||
T{ ##slot-imm
|
||||
{ dst V int-regs 12 }
|
||||
{ obj V int-regs 7 }
|
||||
{ slot 1 }
|
||||
{ tag 6 }
|
||||
}
|
||||
T{ ##add
|
||||
{ dst V int-regs 25 }
|
||||
{ src1 V int-regs 5 }
|
||||
{ src2 V int-regs 12 }
|
||||
}
|
||||
T{ ##compare-branch
|
||||
{ src1 V int-regs 25 }
|
||||
{ src2 V int-regs 5 }
|
||||
{ cc cc> }
|
||||
}
|
||||
}
|
||||
1 test-bb
|
||||
|
||||
V{
|
||||
T{ ##slot-imm
|
||||
{ dst V int-regs 41 }
|
||||
{ obj V int-regs 1 }
|
||||
{ slot 2 }
|
||||
{ tag 7 }
|
||||
}
|
||||
T{ ##slot-imm
|
||||
{ dst V int-regs 44 }
|
||||
{ obj V int-regs 41 }
|
||||
{ slot 1 }
|
||||
{ tag 6 }
|
||||
}
|
||||
T{ ##compare-branch
|
||||
{ src1 V int-regs 25 }
|
||||
{ src2 V int-regs 44 }
|
||||
{ cc cc> }
|
||||
}
|
||||
}
|
||||
2 test-bb
|
||||
|
||||
V{
|
||||
T{ ##add-imm
|
||||
{ dst V int-regs 54 }
|
||||
{ src1 V int-regs 25 }
|
||||
{ src2 8 }
|
||||
}
|
||||
T{ ##load-immediate { dst V int-regs 55 } { val 24 } }
|
||||
T{ ##inc-d { n 4 } }
|
||||
T{ ##inc-r { n 1 } }
|
||||
T{ ##replace { src V int-regs 25 } { loc D 2 } }
|
||||
T{ ##replace { src V int-regs 1 } { loc D 3 } }
|
||||
T{ ##replace { src V int-regs 5 } { loc D 4 } }
|
||||
T{ ##replace { src V int-regs 1 } { loc D 1 } }
|
||||
T{ ##replace { src V int-regs 54 } { loc D 0 } }
|
||||
T{ ##replace { src V int-regs 12 } { loc R 0 } }
|
||||
T{ ##fixnum-mul
|
||||
{ src1 V int-regs 54 }
|
||||
{ src2 V int-regs 55 }
|
||||
{ temp1 V int-regs 58 }
|
||||
{ temp2 V int-regs 59 }
|
||||
}
|
||||
T{ ##branch }
|
||||
}
|
||||
3 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek { dst V int-regs 60 } { loc D 1 } }
|
||||
T{ ##slot-imm
|
||||
{ dst V int-regs 66 }
|
||||
{ obj V int-regs 60 }
|
||||
{ slot 2 }
|
||||
{ tag 7 }
|
||||
}
|
||||
T{ ##inc-d { n 1 } }
|
||||
T{ ##inc-r { n 1 } }
|
||||
T{ ##replace { src V int-regs 66 } { loc D 0 } }
|
||||
T{ ##replace { src V int-regs 60 } { loc R 0 } }
|
||||
T{ ##call { word resize-string } }
|
||||
T{ ##branch }
|
||||
}
|
||||
4 test-bb
|
||||
|
||||
V{
|
||||
T{ ##peek { dst V int-regs 67 } { loc R 0 } }
|
||||
T{ ##peek { dst V int-regs 68 } { loc D 0 } }
|
||||
T{ ##set-slot-imm
|
||||
{ src V int-regs 68 }
|
||||
{ obj V int-regs 67 }
|
||||
{ slot 2 }
|
||||
{ tag 7 }
|
||||
}
|
||||
T{ ##write-barrier
|
||||
{ src V int-regs 67 }
|
||||
{ card# V int-regs 75 }
|
||||
{ table V int-regs 76 }
|
||||
}
|
||||
T{ ##inc-d { n -1 } }
|
||||
T{ ##inc-r { n -1 } }
|
||||
T{ ##peek { dst V int-regs 94 } { loc D 0 } }
|
||||
T{ ##peek { dst V int-regs 96 } { loc D 1 } }
|
||||
T{ ##peek { dst V int-regs 98 } { loc D 2 } }
|
||||
T{ ##peek { dst V int-regs 100 } { loc D 3 } }
|
||||
T{ ##peek { dst V int-regs 102 } { loc D 4 } }
|
||||
T{ ##peek { dst V int-regs 106 } { loc R 0 } }
|
||||
T{ ##copy { dst V int-regs 95 } { src V int-regs 94 } }
|
||||
T{ ##copy { dst V int-regs 97 } { src V int-regs 96 } }
|
||||
T{ ##copy { dst V int-regs 99 } { src V int-regs 98 } }
|
||||
T{ ##copy { dst V int-regs 101 } { src V int-regs 100 } }
|
||||
T{ ##copy { dst V int-regs 103 } { src V int-regs 102 } }
|
||||
T{ ##copy { dst V int-regs 107 } { src V int-regs 106 } }
|
||||
T{ ##branch }
|
||||
}
|
||||
5 test-bb
|
||||
|
||||
V{
|
||||
T{ ##inc-d { n 3 } }
|
||||
T{ ##inc-r { n 1 } }
|
||||
T{ ##copy { dst V int-regs 95 } { src V int-regs 1 } }
|
||||
T{ ##copy { dst V int-regs 97 } { src V int-regs 25 } }
|
||||
T{ ##copy { dst V int-regs 99 } { src V int-regs 1 } }
|
||||
T{ ##copy { dst V int-regs 101 } { src V int-regs 5 } }
|
||||
T{ ##copy { dst V int-regs 103 } { src V int-regs 7 } }
|
||||
T{ ##copy { dst V int-regs 107 } { src V int-regs 12 } }
|
||||
T{ ##branch }
|
||||
}
|
||||
6 test-bb
|
||||
|
||||
V{
|
||||
T{ ##load-immediate
|
||||
{ dst V int-regs 78 }
|
||||
{ val 4611686018427387896 }
|
||||
}
|
||||
T{ ##and
|
||||
{ dst V int-regs 81 }
|
||||
{ src1 V int-regs 97 }
|
||||
{ src2 V int-regs 78 }
|
||||
}
|
||||
T{ ##set-slot-imm
|
||||
{ src V int-regs 81 }
|
||||
{ obj V int-regs 95 }
|
||||
{ slot 3 }
|
||||
{ tag 7 }
|
||||
}
|
||||
T{ ##inc-d { n -2 } }
|
||||
T{ ##copy { dst V int-regs 110 } { src V int-regs 99 } }
|
||||
T{ ##copy { dst V int-regs 111 } { src V int-regs 101 } }
|
||||
T{ ##copy { dst V int-regs 112 } { src V int-regs 103 } }
|
||||
T{ ##copy { dst V int-regs 117 } { src V int-regs 107 } }
|
||||
T{ ##branch }
|
||||
}
|
||||
7 test-bb
|
||||
|
||||
V{
|
||||
T{ ##inc-d { n 1 } }
|
||||
T{ ##inc-r { n 1 } }
|
||||
T{ ##copy { dst V int-regs 110 } { src V int-regs 1 } }
|
||||
T{ ##copy { dst V int-regs 111 } { src V int-regs 5 } }
|
||||
T{ ##copy { dst V int-regs 112 } { src V int-regs 7 } }
|
||||
T{ ##copy { dst V int-regs 117 } { src V int-regs 12 } }
|
||||
T{ ##branch }
|
||||
}
|
||||
8 test-bb
|
||||
|
||||
V{
|
||||
T{ ##inc-d { n 1 } }
|
||||
T{ ##inc-r { n -1 } }
|
||||
T{ ##replace { src V int-regs 117 } { loc D 0 } }
|
||||
T{ ##replace { src V int-regs 110 } { loc D 1 } }
|
||||
T{ ##replace { src V int-regs 111 } { loc D 2 } }
|
||||
T{ ##replace { src V int-regs 112 } { loc D 3 } }
|
||||
T{ ##epilogue }
|
||||
T{ ##return }
|
||||
}
|
||||
9 test-bb
|
||||
|
||||
0 get 1 get 1vector >>successors drop
|
||||
1 get 2 get 8 get V{ } 2sequence >>successors drop
|
||||
2 get 3 get 6 get V{ } 2sequence >>successors drop
|
||||
3 get 4 get 1vector >>successors drop
|
||||
4 get 5 get 1vector >>successors drop
|
||||
5 get 7 get 1vector >>successors drop
|
||||
6 get 7 get 1vector >>successors drop
|
||||
7 get 9 get 1vector >>successors drop
|
||||
8 get 9 get 1vector >>successors drop
|
||||
|
||||
[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
|
||||
|
||||
! Fencepost error in assignment pass
|
||||
V{ T{ ##branch } } 0 test-bb
|
||||
|
||||
|
|
|
|||
|
|
@ -31,8 +31,10 @@ M: insn linearize-insn , drop ;
|
|||
M: ##branch linearize-insn
|
||||
drop dup successors>> first emit-branch ;
|
||||
|
||||
: successors ( bb -- first second ) successors>> first2 ; inline
|
||||
|
||||
: (binary-conditional) ( basic-block insn -- basic-block successor1 successor2 src1 src2 cc )
|
||||
[ dup successors>> first2 ]
|
||||
[ dup successors ]
|
||||
[ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline
|
||||
|
||||
: binary-conditional ( basic-block insn -- basic-block successor label2 src1 src2 cc )
|
||||
|
|
@ -52,6 +54,19 @@ M: ##compare-imm-branch linearize-insn
|
|||
M: ##compare-float-branch linearize-insn
|
||||
[ binary-conditional _compare-float-branch ] with-regs emit-branch ;
|
||||
|
||||
: overflow-conditional ( basic-block insn -- basic-block successor label2 dst src1 src2 )
|
||||
[ dup successors number>> ]
|
||||
[ [ dst>> ] [ src1>> ] [ src2>> ] tri ] bi* ; inline
|
||||
|
||||
M: ##fixnum-add linearize-insn
|
||||
[ overflow-conditional _fixnum-add ] with-regs emit-branch ;
|
||||
|
||||
M: ##fixnum-sub linearize-insn
|
||||
[ overflow-conditional _fixnum-sub ] with-regs emit-branch ;
|
||||
|
||||
M: ##fixnum-mul linearize-insn
|
||||
[ overflow-conditional _fixnum-mul ] with-regs emit-branch ;
|
||||
|
||||
M: ##dispatch linearize-insn
|
||||
swap
|
||||
[ [ [ src>> ] [ temp>> ] bi _dispatch ] with-regs ]
|
||||
|
|
|
|||
|
|
@ -136,16 +136,6 @@ M: ##compare-imm fresh-insn-temps
|
|||
M: ##compare-float fresh-insn-temps
|
||||
[ fresh-vreg ] change-temp drop ;
|
||||
|
||||
M: ##fixnum-mul fresh-insn-temps
|
||||
[ fresh-vreg ] change-temp1
|
||||
[ fresh-vreg ] change-temp2
|
||||
drop ;
|
||||
|
||||
M: ##fixnum-mul-tail fresh-insn-temps
|
||||
[ fresh-vreg ] change-temp1
|
||||
[ fresh-vreg ] change-temp2
|
||||
drop ;
|
||||
|
||||
M: ##gc fresh-insn-temps
|
||||
[ fresh-vreg ] change-temp1
|
||||
[ fresh-vreg ] change-temp2
|
||||
|
|
|
|||
|
|
@ -61,7 +61,8 @@ UNION: sync-if-back-edge
|
|||
##conditional-branch
|
||||
##compare-imm-branch
|
||||
##dispatch
|
||||
##loop-entry ;
|
||||
##loop-entry
|
||||
##fixnum-overflow ;
|
||||
|
||||
: sync-state? ( -- ? )
|
||||
basic-block get successors>>
|
||||
|
|
|
|||
|
|
@ -53,28 +53,11 @@ IN: compiler.cfg.tco
|
|||
[ [ cfg get entry>> successors>> first ] dip successors>> push ]
|
||||
tri ;
|
||||
|
||||
: fixnum-tail-call? ( bb -- ? )
|
||||
instructions>> penultimate
|
||||
{ [ ##fixnum-add? ] [ ##fixnum-sub? ] [ ##fixnum-mul? ] } 1|| ;
|
||||
|
||||
GENERIC: convert-fixnum-tail-call* ( src1 src2 insn -- insn' )
|
||||
|
||||
M: ##fixnum-add convert-fixnum-tail-call* drop \ ##fixnum-add-tail new-insn ;
|
||||
M: ##fixnum-sub convert-fixnum-tail-call* drop \ ##fixnum-sub-tail new-insn ;
|
||||
M: ##fixnum-mul convert-fixnum-tail-call* drop i i \ ##fixnum-mul-tail new-insn ;
|
||||
|
||||
: convert-fixnum-tail-call ( bb -- )
|
||||
[
|
||||
[ src1>> ] [ src2>> ] [ ] tri
|
||||
convert-fixnum-tail-call*
|
||||
] convert-tail-call ;
|
||||
|
||||
: optimize-tail-call ( bb -- )
|
||||
dup tail-call? [
|
||||
{
|
||||
{ [ dup loop-tail-call? ] [ convert-loop-tail-call ] }
|
||||
{ [ dup word-tail-call? ] [ convert-word-tail-call ] }
|
||||
{ [ dup fixnum-tail-call? ] [ convert-fixnum-tail-call ] }
|
||||
[ drop ]
|
||||
} cond
|
||||
] [ drop ] if ;
|
||||
|
|
|
|||
|
|
@ -44,6 +44,8 @@ M: ##shl-imm convert-two-operand* convert-two-operand/integer ;
|
|||
M: ##shr-imm convert-two-operand* convert-two-operand/integer ;
|
||||
M: ##sar-imm convert-two-operand* convert-two-operand/integer ;
|
||||
|
||||
M: ##fixnum-overflow convert-two-operand* convert-two-operand/integer ;
|
||||
|
||||
M: ##add-float convert-two-operand* convert-two-operand/float ;
|
||||
M: ##sub-float convert-two-operand* convert-two-operand/float ;
|
||||
M: ##mul-float convert-two-operand* convert-two-operand/float ;
|
||||
|
|
|
|||
|
|
@ -36,6 +36,18 @@ IN: compiler.cfg.utilities
|
|||
: emit-primitive ( node -- )
|
||||
word>> ##call ##branch begin-basic-block ;
|
||||
|
||||
: with-branch ( quot -- final-bb )
|
||||
[
|
||||
begin-basic-block
|
||||
call
|
||||
basic-block get dup [ ##branch ] when
|
||||
] with-scope ; inline
|
||||
|
||||
: emit-conditional ( branches -- )
|
||||
end-basic-block
|
||||
begin-basic-block
|
||||
basic-block get '[ [ _ swap successors>> push ] when* ] each ;
|
||||
|
||||
: back-edge? ( from to -- ? )
|
||||
[ number>> ] bi@ >= ;
|
||||
|
||||
|
|
|
|||
|
|
@ -171,18 +171,12 @@ M: ##sar-imm generate-insn dst/src1/src2 %sar-imm ;
|
|||
M: ##not generate-insn dst/src %not ;
|
||||
M: ##log2 generate-insn dst/src %log2 ;
|
||||
|
||||
: src1/src2 ( insn -- src1 src2 )
|
||||
[ src1>> register ] [ src2>> register ] bi ; inline
|
||||
: label/dst/src1/src2 ( insn -- label dst src1 src2 )
|
||||
[ label>> lookup-label ] [ dst/src1/src2 ] bi ; inline
|
||||
|
||||
: src1/src2/temp1/temp2 ( insn -- src1 src2 temp1 temp2 )
|
||||
[ src1/src2 ] [ temp1>> register ] [ temp2>> register ] tri ; inline
|
||||
|
||||
M: ##fixnum-add generate-insn src1/src2 %fixnum-add ;
|
||||
M: ##fixnum-add-tail generate-insn src1/src2 %fixnum-add-tail ;
|
||||
M: ##fixnum-sub generate-insn src1/src2 %fixnum-sub ;
|
||||
M: ##fixnum-sub-tail generate-insn src1/src2 %fixnum-sub-tail ;
|
||||
M: ##fixnum-mul generate-insn src1/src2/temp1/temp2 %fixnum-mul ;
|
||||
M: ##fixnum-mul-tail generate-insn src1/src2/temp1/temp2 %fixnum-mul-tail ;
|
||||
M: _fixnum-add generate-insn label/dst/src1/src2 %fixnum-add ;
|
||||
M: _fixnum-sub generate-insn label/dst/src1/src2 %fixnum-sub ;
|
||||
M: _fixnum-mul generate-insn label/dst/src1/src2 %fixnum-mul ;
|
||||
|
||||
: dst/src/temp ( insn -- dst src temp )
|
||||
[ dst/src ] [ temp>> register ] bi ; inline
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel assocs match fry accessors namespaces make effects
|
||||
sequences sequences.private quotations generic macros arrays
|
||||
|
|
@ -15,7 +15,9 @@ compiler.tree.def-use
|
|||
compiler.tree.builder
|
||||
compiler.tree.optimizer
|
||||
compiler.tree.combinators
|
||||
compiler.tree.checker ;
|
||||
compiler.tree.checker
|
||||
compiler.tree.dead-code
|
||||
compiler.tree.modular-arithmetic ;
|
||||
FROM: fry => _ ;
|
||||
RENAME: _ match => __
|
||||
IN: compiler.tree.debugger
|
||||
|
|
@ -201,8 +203,15 @@ SYMBOL: node-count
|
|||
|
||||
: cleaned-up-tree ( quot -- nodes )
|
||||
[
|
||||
check-optimizer? on
|
||||
build-tree optimize-tree
|
||||
build-tree
|
||||
analyze-recursive
|
||||
normalize
|
||||
propagate
|
||||
cleanup
|
||||
compute-def-use
|
||||
remove-dead-code
|
||||
compute-def-use
|
||||
optimize-modular-arithmetic
|
||||
] with-scope ;
|
||||
|
||||
: inlined? ( quot seq/word -- ? )
|
||||
|
|
|
|||
|
|
@ -46,6 +46,9 @@ M: predicate finalize-word
|
|||
[ drop ]
|
||||
} cond ;
|
||||
|
||||
M: math-partial finalize-word
|
||||
dup primitive? [ drop ] [ nip cached-expansion ] if ;
|
||||
|
||||
M: word finalize-word drop ;
|
||||
|
||||
M: #call finalize*
|
||||
|
|
|
|||
|
|
@ -4,12 +4,12 @@ IN: compiler.tree.modular-arithmetic.tests
|
|||
USING: kernel kernel.private tools.test math math.partial-dispatch
|
||||
math.private accessors slots.private sequences strings sbufs
|
||||
compiler.tree.builder
|
||||
compiler.tree.optimizer
|
||||
compiler.tree.normalization
|
||||
compiler.tree.debugger
|
||||
alien.accessors layouts combinators byte-arrays ;
|
||||
|
||||
: test-modular-arithmetic ( quot -- quot' )
|
||||
build-tree optimize-tree nodes>quot ;
|
||||
cleaned-up-tree nodes>quot ;
|
||||
|
||||
[ [ >R >fixnum R> >fixnum fixnum+fast ] ]
|
||||
[ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test
|
||||
|
|
|
|||
|
|
@ -82,12 +82,9 @@ HOOK: %sar-imm cpu ( dst src1 src2 -- )
|
|||
HOOK: %not cpu ( dst src -- )
|
||||
HOOK: %log2 cpu ( dst src -- )
|
||||
|
||||
HOOK: %fixnum-add cpu ( src1 src2 -- )
|
||||
HOOK: %fixnum-add-tail cpu ( src1 src2 -- )
|
||||
HOOK: %fixnum-sub cpu ( src1 src2 -- )
|
||||
HOOK: %fixnum-sub-tail cpu ( src1 src2 -- )
|
||||
HOOK: %fixnum-mul cpu ( src1 src2 temp1 temp2 -- )
|
||||
HOOK: %fixnum-mul-tail cpu ( src1 src2 temp1 temp2 -- )
|
||||
HOOK: %fixnum-add cpu ( label dst src1 src2 -- )
|
||||
HOOK: %fixnum-sub cpu ( label dst src1 src2 -- )
|
||||
HOOK: %fixnum-mul cpu ( label dst src1 src2 -- )
|
||||
|
||||
HOOK: %integer>bignum cpu ( dst src temp -- )
|
||||
HOOK: %bignum>integer cpu ( dst src temp -- )
|
||||
|
|
|
|||
|
|
@ -51,8 +51,6 @@ M: x86.32 reserved-area-size 0 ;
|
|||
|
||||
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
|
||||
|
||||
M: x86.32 %alien-invoke-tail 0 JMP rc-relative rel-dlsym ;
|
||||
|
||||
M: x86.32 return-struct-in-registers? ( c-type -- ? )
|
||||
c-type
|
||||
[ return-in-registers?>> ]
|
||||
|
|
|
|||
|
|
@ -167,11 +167,6 @@ M: x86.64 %alien-invoke
|
|||
rc-absolute-cell rel-dlsym
|
||||
R11 CALL ;
|
||||
|
||||
M: x86.64 %alien-invoke-tail
|
||||
R11 0 MOV
|
||||
rc-absolute-cell rel-dlsym
|
||||
R11 JMP ;
|
||||
|
||||
M: x86.64 %prepare-alien-indirect ( -- )
|
||||
"unbox_alien" f %alien-invoke
|
||||
RBP RAX MOV ;
|
||||
|
|
|
|||
|
|
@ -129,83 +129,18 @@ M: x86 %log2 BSR ;
|
|||
: ?MOV ( dst src -- )
|
||||
2dup = [ 2drop ] [ MOV ] if ; inline
|
||||
|
||||
:: move>args ( src1 src2 -- )
|
||||
{
|
||||
{ [ src1 param-reg-2 = ] [ param-reg-1 src2 ?MOV param-reg-1 param-reg-2 XCHG ] }
|
||||
{ [ src1 param-reg-1 = ] [ param-reg-2 src2 ?MOV ] }
|
||||
{ [ src2 param-reg-1 = ] [ param-reg-2 src1 ?MOV param-reg-1 param-reg-2 XCHG ] }
|
||||
{ [ src2 param-reg-2 = ] [ param-reg-1 src1 ?MOV ] }
|
||||
[
|
||||
param-reg-1 src1 MOV
|
||||
param-reg-2 src2 MOV
|
||||
]
|
||||
} cond ;
|
||||
|
||||
HOOK: %alien-invoke-tail cpu ( func dll -- )
|
||||
|
||||
:: overflow-template ( src1 src2 insn inverse func -- )
|
||||
<label> "no-overflow" set
|
||||
:: overflow-template ( label dst src1 src2 insn -- )
|
||||
src1 src2 insn call
|
||||
ds-reg [] src1 MOV
|
||||
"no-overflow" get JNO
|
||||
src1 src2 inverse call
|
||||
src1 src2 move>args
|
||||
%prepare-alien-invoke
|
||||
func f %alien-invoke
|
||||
"no-overflow" resolve-label ; inline
|
||||
label JO ; inline
|
||||
|
||||
:: overflow-template-tail ( src1 src2 insn inverse func -- )
|
||||
<label> "no-overflow" set
|
||||
src1 src2 insn call
|
||||
"no-overflow" get JNO
|
||||
src1 src2 inverse call
|
||||
src1 src2 move>args
|
||||
%prepare-alien-invoke
|
||||
func f %alien-invoke-tail
|
||||
"no-overflow" resolve-label
|
||||
ds-reg [] src1 MOV
|
||||
0 RET ; inline
|
||||
M: x86 %fixnum-add ( label dst src1 src2 -- )
|
||||
[ ADD ] overflow-template ;
|
||||
|
||||
M: x86 %fixnum-add ( src1 src2 -- )
|
||||
[ ADD ] [ SUB ] "overflow_fixnum_add" overflow-template ;
|
||||
M: x86 %fixnum-sub ( label dst src1 src2 -- )
|
||||
[ SUB ] overflow-template ;
|
||||
|
||||
M: x86 %fixnum-add-tail ( src1 src2 -- )
|
||||
[ ADD ] [ SUB ] "overflow_fixnum_add" overflow-template-tail ;
|
||||
|
||||
M: x86 %fixnum-sub ( src1 src2 -- )
|
||||
[ SUB ] [ ADD ] "overflow_fixnum_subtract" overflow-template ;
|
||||
|
||||
M: x86 %fixnum-sub-tail ( src1 src2 -- )
|
||||
[ SUB ] [ ADD ] "overflow_fixnum_subtract" overflow-template-tail ;
|
||||
|
||||
M:: x86 %fixnum-mul ( src1 src2 temp1 temp2 -- )
|
||||
"no-overflow" define-label
|
||||
temp1 src1 MOV
|
||||
temp1 tag-bits get SAR
|
||||
src2 temp1 IMUL2
|
||||
ds-reg [] temp1 MOV
|
||||
"no-overflow" get JNO
|
||||
src1 src2 move>args
|
||||
param-reg-1 tag-bits get SAR
|
||||
param-reg-2 tag-bits get SAR
|
||||
%prepare-alien-invoke
|
||||
"overflow_fixnum_multiply" f %alien-invoke
|
||||
"no-overflow" resolve-label ;
|
||||
|
||||
M:: x86 %fixnum-mul-tail ( src1 src2 temp1 temp2 -- )
|
||||
"overflow" define-label
|
||||
temp1 src1 MOV
|
||||
temp1 tag-bits get SAR
|
||||
src2 temp1 IMUL2
|
||||
"overflow" get JO
|
||||
ds-reg [] temp1 MOV
|
||||
0 RET
|
||||
"overflow" resolve-label
|
||||
src1 src2 move>args
|
||||
param-reg-1 tag-bits get SAR
|
||||
param-reg-2 tag-bits get SAR
|
||||
%prepare-alien-invoke
|
||||
"overflow_fixnum_multiply" f %alien-invoke-tail ;
|
||||
M: x86 %fixnum-mul ( label dst src1 src2 -- )
|
||||
[ swap IMUL2 ] overflow-template ;
|
||||
|
||||
: bignum@ ( reg n -- op )
|
||||
cells bignum tag-number - [+] ; inline
|
||||
|
|
|
|||
Loading…
Reference in New Issue