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

Add SSA comparison instructions, fix various problems

db4
Slava Pestov 2008-10-20 05:55:20 -05:00
parent af6b8c4e97
commit 37cf7d9a9c
9 changed files with 179 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
basis/compiler/cfg/builder/builder-tests.factor
View File

@ -1,19 +1,42 @@
IN: compiler.cfg.builder.tests IN: compiler.cfg.builder.tests
USING: tools.test kernel sequences USING: tools.test kernel sequences
words sequences.private fry prettyprint alien words sequences.private fry prettyprint alien alien.accessors
math.private compiler.tree.builder compiler.tree.optimizer math.private compiler.tree.builder compiler.tree.optimizer
compiler.cfg.builder compiler.cfg.debugger ; compiler.cfg.builder compiler.cfg.debugger arrays locals byte-arrays
kernel.private math ;
\ build-cfg must-infer \ build-cfg must-infer
! Just ensure that various CFGs build correctly. ! Just ensure that various CFGs build correctly.
: unit-test-cfg ( quot -- ) '[ _ test-cfg drop ] [ ] swap unit-test ;
{ {
[ ] [ ]
[ dup ] [ dup ]
[ swap ] [ swap ]
[ >r r> ] [ >r r> ]
[ fixnum+ ] [ fixnum+ ]
[ fixnum+fast ]
[ 3 fixnum+fast ]
[ fixnum*fast ]
[ 3 fixnum*fast ]
[ fixnum-shift-fast ]
[ 10 fixnum-shift-fast ]
[ -10 fixnum-shift-fast ]
[ 0 fixnum-shift-fast ]
[ fixnum-bitnot ]
[ eq? ]
[ "hi" eq? ]
[ fixnum< ] [ fixnum< ]
[ 5 fixnum< ]
[ float+ ]
[ 3.0 float+ ]
[ float<= ]
[ fixnum>bignum ]
[ bignum>fixnum ]
[ fixnum>float ]
[ float>fixnum ]
[ 3 f <array> ]
[ [ 1 ] [ 2 ] if ] [ [ 1 ] [ 2 ] if ]
[ fixnum< [ 1 ] [ 2 ] if ] [ fixnum< [ 1 ] [ 2 ] if ]
[ float+ [ 2.0 float* ] [ 3.0 float* ] bi float/f ] [ float+ [ 2.0 float* ] [ 3.0 float* ] bi float/f ]
@ -25,7 +48,7 @@ compiler.cfg.builder compiler.cfg.debugger ;
[ "int" { "int" } "cdecl" alien-indirect ] [ "int" { "int" } "cdecl" alien-indirect ]
[ "int" { "int" } "cdecl" [ ] alien-callback ] [ "int" { "int" } "cdecl" [ ] alien-callback ]
} [ } [
'[ _ test-cfg drop ] [ ] swap unit-test unit-test-cfg
] each ] each
: test-1 ( -- ) test-1 ; : test-1 ( -- ) test-1 ;
@ -36,6 +59,47 @@ compiler.cfg.builder compiler.cfg.debugger ;
test-1 test-1
test-2 test-2
test-3 test-3
} [ } [ unit-test-cfg ] each
'[ _ test-cfg drop ] [ ] swap unit-test
{
byte-array
simple-alien
alien
POSTPONE: f
} [| class |
{
alien-signed-1
alien-signed-2
alien-signed-4
alien-unsigned-1
alien-unsigned-2
alien-unsigned-4
alien-cell
alien-float
alien-double
} [| word |
{ class } word '[ _ declare 10 _ execute ] unit-test-cfg
{ class fixnum } word '[ _ declare _ execute ] unit-test-cfg
] each
{
set-alien-signed-1
set-alien-signed-2
set-alien-signed-4
set-alien-unsigned-1
set-alien-unsigned-2
set-alien-unsigned-4
} [| word |
{ fixnum class } word '[ _ declare 10 _ execute ] unit-test-cfg
{ fixnum class fixnum } word '[ _ declare _ execute ] unit-test-cfg
] each
{ float class } \ set-alien-float '[ _ declare 10 _ execute ] unit-test-cfg
{ float class fixnum } \ set-alien-float '[ _ declare _ execute ] unit-test-cfg
{ float class } \ set-alien-double '[ _ declare 10 _ execute ] unit-test-cfg
{ float class fixnum } \ set-alien-double '[ _ declare _ execute ] unit-test-cfg
{ pinned-c-ptr class } \ set-alien-cell '[ _ declare 10 _ execute ] unit-test-cfg
{ pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-cfg
] each ] each

6
basis/compiler/cfg/builder/builder.factor
View File

@ -139,7 +139,7 @@ M: #recursive emit-node
init-phantoms ; init-phantoms ;
: ##branch-t ( vreg -- ) : ##branch-t ( vreg -- )
\ f tag-number cc/= ##binary-imm-branch ; \ f tag-number cc/= ##compare-imm-branch ;
M: #if emit-node M: #if emit-node
phantom-pop ##branch-t emit-if iterate-next ; phantom-pop ##branch-t emit-if iterate-next ;
@ -168,7 +168,9 @@ M: #if emit-node
: emit-dispatch ( node -- ) : emit-dispatch ( node -- )
phantom-pop int-regs next-vreg phantom-pop int-regs next-vreg
[ finalize-phantoms ##epilogue ] 2dip ##dispatch [ finalize-phantoms ##epilogue ] 2dip
[ ^^offset>slot ] dip
##dispatch
dispatch-branches init-phantoms ; dispatch-branches init-phantoms ;
: <dispatch-block> ( -- word ) : <dispatch-block> ( -- word )

13
basis/compiler/cfg/builder/calls/calls.factor
View File

@ -85,8 +85,6 @@ IN: compiler.cfg.builder.calls
: emit-tag ( -- ) : emit-tag ( -- )
phantom-pop tag-mask get ^^and-imm ^^tag-fixnum phantom-push ; phantom-pop tag-mask get ^^and-imm ^^tag-fixnum phantom-push ;
: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] when ;
: (emit-slot) ( infos -- dst ) : (emit-slot) ( infos -- dst )
[ 2phantom-pop ] [ third literal>> ] bi* [ 2phantom-pop ] [ third literal>> ] bi*
^^slot ; ^^slot ;
@ -108,7 +106,7 @@ IN: compiler.cfg.builder.calls
: (emit-set-slot) ( infos -- ) : (emit-set-slot) ( infos -- )
[ 3phantom-pop ] [ fourth literal>> ] bi* [ 3phantom-pop ] [ fourth literal>> ] bi*
##set-slot ; ^^set-slot ;
: (emit-set-slot-imm) ( infos -- ) : (emit-set-slot-imm) ( infos -- )
1 phantom-drop 1 phantom-drop
@ -136,6 +134,7 @@ IN: compiler.cfg.builder.calls
[ infos imm-insn (emit-fixnum-imm-op) ] [ infos imm-insn (emit-fixnum-imm-op) ]
[ insn (emit-fixnum-op) ] [ insn (emit-fixnum-op) ]
if if
phantom-push
] ; inline ] ; inline
: emit-primitive ( node -- ) : emit-primitive ( node -- )
@ -170,7 +169,7 @@ IN: compiler.cfg.builder.calls
phantom-push ; phantom-push ;
: emit-fixnum-comparison ( node cc -- ) : emit-fixnum-comparison ( node cc -- )
[ '[ _ ##boolean ] ] [ '[ _ ##boolean-imm ] ] bi [ '[ _ ^^compare ] ] [ '[ _ ^^compare-imm ] ] bi
emit-fixnum-op ; emit-fixnum-op ;
: emit-bignum>fixnum ( -- ) : emit-bignum>fixnum ( -- )
@ -180,10 +179,12 @@ IN: compiler.cfg.builder.calls
phantom-pop ^^untag-fixnum ^^integer>bignum phantom-push ; phantom-pop ^^untag-fixnum ^^integer>bignum phantom-push ;
: emit-float-op ( insn -- ) : emit-float-op ( insn -- )
[ 2phantom-pop [ ^^unbox-float ] bi@ ] dip call ^^box-float ; inline [ 2phantom-pop [ ^^unbox-float ] bi@ ] dip call ^^box-float
phantom-push ; inline
: emit-float-comparison ( cc -- ) : emit-float-comparison ( cc -- )
'[ _ ##boolean ] emit-float-op ; [ 2phantom-pop [ ^^unbox-float ] bi@ ] dip ^^compare-float
phantom-push ; inline
: emit-float>fixnum ( -- ) : emit-float>fixnum ( -- )
phantom-pop ^^unbox-float ^^float>integer ^^tag-fixnum phantom-push ; phantom-pop ^^unbox-float ^^float>integer ^^tag-fixnum phantom-push ;

17
basis/compiler/cfg/builder/hats/hats.factor
View File

@ -1,6 +1,6 @@
! 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 cpu.architecture compiler.cfg.registers USING: kernel layouts cpu.architecture compiler.cfg.registers
compiler.cfg.instructions ; compiler.cfg.instructions ;
IN: compiler.cfg.builder.hats IN: compiler.cfg.builder.hats
@ -18,8 +18,9 @@ IN: compiler.cfg.builder.hats
: ^^load-literal ( obj -- dst ) ^^i1 ##load-literal ; inline : ^^load-literal ( obj -- dst ) ^^i1 ##load-literal ; inline
: ^^peek ( loc -- dst ) ^^i1 ##peek ; inline : ^^peek ( loc -- dst ) ^^i1 ##peek ; inline
: ^^slot ( obj slot tag -- dst ) ^^i3 ##slot ; inline : ^^slot ( obj slot tag -- dst ) ^^i3 i ##slot ; inline
: ^^slot-imm ( obj slot tag -- dst ) ^^i3 ##slot-imm ; inline : ^^slot-imm ( obj slot tag -- dst ) ^^i3 ##slot-imm ; inline
: ^^set-slot ( src obj slot tag -- ) i ##set-slot ; inline
: ^^add ( src1 src2 -- dst ) ^^i2 ##add ; inline : ^^add ( src1 src2 -- dst ) ^^i2 ##add ; inline
: ^^add-imm ( src1 src2 -- dst ) ^^i2 ##add-imm ; inline : ^^add-imm ( src1 src2 -- dst ) ^^i2 ##add-imm ; inline
: ^^sub ( src1 src2 -- dst ) ^^i2 ##sub ; inline : ^^sub ( src1 src2 -- dst ) ^^i2 ##sub ; inline
@ -36,27 +37,31 @@ IN: compiler.cfg.builder.hats
: ^^shr-imm ( src1 src2 -- dst ) ^^i2 ##shr-imm ; inline : ^^shr-imm ( src1 src2 -- dst ) ^^i2 ##shr-imm ; inline
: ^^sar-imm ( src1 src2 -- dst ) ^^i2 ##sar-imm ; inline : ^^sar-imm ( src1 src2 -- dst ) ^^i2 ##sar-imm ; inline
: ^^not ( src -- dst ) ^^i1 ##not ; inline : ^^not ( src -- dst ) ^^i1 ##not ; inline
: ^^bignum>integer ( src -- dst ) ^^i1 ##bignum>integer ; inline : ^^bignum>integer ( src -- dst ) ^^i1 i ##bignum>integer ; inline
: ^^integer>bignum ( src -- dst ) ^^i1 i ##integer>bignum ; inline : ^^integer>bignum ( src -- dst ) ^^i1 i ##integer>bignum ; inline
: ^^add-float ( src1 src2 -- dst ) ^^d2 ##add-float ; inline : ^^add-float ( src1 src2 -- dst ) ^^d2 ##add-float ; inline
: ^^sub-float ( src1 src2 -- dst ) ^^d2 ##sub-float ; inline : ^^sub-float ( src1 src2 -- dst ) ^^d2 ##sub-float ; inline
: ^^mul-float ( src1 src2 -- dst ) ^^d2 ##mul-float ; inline : ^^mul-float ( src1 src2 -- dst ) ^^d2 ##mul-float ; inline
: ^^div-float ( src1 src2 -- dst ) ^^d2 ##div-float ; inline : ^^div-float ( src1 src2 -- dst ) ^^d2 ##div-float ; inline
: ^^float>integer ( src -- dst ) ^^i1 ##float>integer ; inline : ^^float>integer ( src -- dst ) ^^i1 ##float>integer ; inline
: ^^integer>float ( src -- dst ) ^^d1 i ##integer>float ; inline : ^^integer>float ( src -- dst ) ^^d1 ##integer>float ; inline
: ^^allot ( size type tag -- dst ) ^^i3 i ##allot ; inline : ^^allot ( size type tag -- dst ) ^^i3 i ##allot ; inline
: ^^write-barrier ( src -- ) i i ##write-barrier ; inline : ^^write-barrier ( src -- ) i i ##write-barrier ; inline
: ^^box-float ( src -- dst ) ^^i1 i ##box-float ; inline : ^^box-float ( src -- dst ) ^^i1 i ##box-float ; inline
: ^^unbox-float ( src -- dst ) ^^d1 ##unbox-float ; inline : ^^unbox-float ( src -- dst ) ^^d1 ##unbox-float ; inline
: ^^box-alien ( src -- dst ) ^^i1 i ##box-alien ; inline : ^^box-alien ( src -- dst ) ^^i1 i ##box-alien ; inline
: ^^unbox-alien ( src -- dst ) ^^i1 ##unbox-alien ; inline : ^^unbox-alien ( src -- dst ) ^^i1 ##unbox-alien ; inline
: ^^unbox-c-ptr ( src class -- dst ) ^^i2 ##unbox-c-ptr ; : ^^unbox-c-ptr ( src class -- dst ) ^^i2 i ##unbox-c-ptr ;
: ^^alien-unsigned-1 ( src -- dst ) ^^i1 ##alien-unsigned-1 ; inline : ^^alien-unsigned-1 ( src -- dst ) ^^i1 ##alien-unsigned-1 ; inline
: ^^alien-unsigned-2 ( src -- dst ) ^^i1 ##alien-unsigned-2 ; inline : ^^alien-unsigned-2 ( src -- dst ) ^^i1 ##alien-unsigned-2 ; inline
: ^^alien-unsigned-4 ( src -- dst ) ^^i1 ##alien-unsigned-4 ; inline : ^^alien-unsigned-4 ( src -- dst ) ^^i1 ##alien-unsigned-4 ; inline
: ^^alien-signed-1 ( src -- dst ) ^^i1 ##alien-signed-1 ; inline : ^^alien-signed-1 ( src -- dst ) ^^i1 ##alien-signed-1 ; inline
: ^^alien-signed-2 ( src -- dst ) ^^i1 ##alien-signed-2 ; inline : ^^alien-signed-2 ( src -- dst ) ^^i1 ##alien-signed-2 ; inline
: ^^alien-signed-4 ( src -- dst ) ^^i1 ##alien-signed-3 ; inline : ^^alien-signed-4 ( src -- dst ) ^^i1 ##alien-signed-4 ; inline
: ^^alien-cell ( src -- dst ) ^^i1 ##alien-cell ; inline : ^^alien-cell ( src -- dst ) ^^i1 ##alien-cell ; inline
: ^^alien-float ( src -- dst ) ^^i1 ##alien-float ; inline : ^^alien-float ( src -- dst ) ^^i1 ##alien-float ; inline
: ^^alien-double ( src -- dst ) ^^i1 ##alien-double ; inline : ^^alien-double ( src -- dst ) ^^i1 ##alien-double ; inline
: ^^compare ( src1 src2 -- dst ) ^^i2 ##compare ; inline
: ^^compare-imm ( src1 src2 -- dst ) ^^i2 ##compare-imm ; inline
: ^^compare-float ( src1 src2 -- dst ) ^^i2 ##compare-float ; inline
: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] when ; inline

14
basis/compiler/cfg/def-use/def-use.factor
View File

@ -7,11 +7,11 @@ IN: compiler.cfg.def-use
GENERIC: defs-vregs ( insn -- seq ) GENERIC: defs-vregs ( insn -- seq )
GENERIC: uses-vregs ( insn -- seq ) GENERIC: uses-vregs ( insn -- seq )
: allot-defs-vregs ( insn -- seq ) [ dst>> ] [ temp>> ] bi 2array ; : dst/tmp-vregs ( insn -- seq ) [ dst>> ] [ temp>> ] bi 2array ;
M: ##flushable defs-vregs dst>> 1array ; M: ##flushable defs-vregs dst>> 1array ;
M: ##write-barrier defs-vregs [ card#>> ] [ table>> ] bi 2array ; M: ##write-barrier defs-vregs [ card#>> ] [ table>> ] bi 2array ;
M: ##boxer defs-vregs allot-defs-vregs ; M: ##unary/temp defs-vregs dst/tmp-vregs ;
M: ##allot defs-vregs allot-defs-vregs ; M: ##allot defs-vregs dst/tmp-vregs ;
M: ##dispatch defs-vregs temp>> 1array ; M: ##dispatch defs-vregs temp>> 1array ;
M: insn defs-vregs drop f ; M: insn defs-vregs drop f ;
@ -23,9 +23,9 @@ M: ##slot uses-vregs [ obj>> ] [ slot>> ] bi 2array ;
M: ##slot-imm uses-vregs obj>> 1array ; M: ##slot-imm uses-vregs obj>> 1array ;
M: ##set-slot uses-vregs [ src>> ] [ obj>> ] [ slot>> ] tri 3array ; M: ##set-slot uses-vregs [ src>> ] [ obj>> ] [ slot>> ] tri 3array ;
M: ##set-slot-imm uses-vregs [ src>> ] [ obj>> ] bi 2array ; M: ##set-slot-imm uses-vregs [ src>> ] [ obj>> ] bi 2array ;
M: ##binary-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ; M: ##conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
M: ##binary-imm-branch uses-vregs src1>> 1array ; M: ##compare-imm-branch uses-vregs src1>> 1array ;
M: ##dispatch uses-vregs src>> 1array ; M: ##dispatch uses-vregs src>> 1array ;
M: _binary-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ; M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
M: _binary-imm-branch uses-vregs src1>> 1array ; M: _compare-imm-branch uses-vregs src1>> 1array ;
M: insn uses-vregs drop f ; M: insn uses-vregs drop f ;

60
basis/compiler/cfg/instructions/instructions.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs accessors arrays kernel sequences namespaces words USING: assocs accessors arrays kernel sequences namespaces words
math math.order layouts classes.algebra alien byte-arrays math math.order layouts classes.algebra alien byte-arrays
combinators compiler.cfg.registers compiler.constants combinators compiler.cfg.registers
compiler.cfg.instructions.syntax ; compiler.cfg.instructions.syntax ;
IN: compiler.cfg.instructions IN: compiler.cfg.instructions
@ -17,7 +17,7 @@ TUPLE: ##flushable < insn { dst vreg } ;
TUPLE: ##pure < ##flushable ; TUPLE: ##pure < ##flushable ;
TUPLE: ##unary < ##pure { src vreg } ; TUPLE: ##unary < ##pure { src vreg } ;
TUPLE: ##boxer < ##unary { temp vreg } ; TUPLE: ##unary/temp < ##unary { temp vreg } ;
TUPLE: ##binary < ##pure { src1 vreg } { src2 vreg } ; TUPLE: ##binary < ##pure { src1 vreg } { src2 vreg } ;
TUPLE: ##binary-imm < ##pure { src1 vreg } { src2 integer } ; TUPLE: ##binary-imm < ##pure { src1 vreg } { src2 integer } ;
TUPLE: ##commutative < ##binary ; TUPLE: ##commutative < ##binary ;
@ -65,9 +65,9 @@ INSN: ##dispatch src temp ;
INSN: ##dispatch-label label ; INSN: ##dispatch-label label ;
! Slot access ! Slot access
INSN: ##slot < ##read { obj vreg } { slot vreg } { tag integer } ; INSN: ##slot < ##read { obj vreg } { slot vreg } { tag integer } { temp vreg } ;
INSN: ##slot-imm < ##read { obj vreg } { slot integer } { tag integer } ; INSN: ##slot-imm < ##read { obj vreg } { slot integer } { tag integer } ;
INSN: ##set-slot < ##write { obj vreg } { slot vreg } { tag integer } ; INSN: ##set-slot < ##write { obj vreg } { slot vreg } { tag integer } { temp vreg } ;
INSN: ##set-slot-imm < ##write { obj vreg } { slot integer } { tag integer } ; INSN: ##set-slot-imm < ##write { obj vreg } { slot integer } { tag integer } ;
! Integer arithmetic ! Integer arithmetic
@ -89,8 +89,8 @@ INSN: ##sar-imm < ##binary-imm ;
INSN: ##not < ##unary ; INSN: ##not < ##unary ;
! Bignum/integer conversion ! Bignum/integer conversion
INSN: ##integer>bignum < ##boxer ; INSN: ##integer>bignum < ##unary/temp ;
INSN: ##bignum>integer < ##unary ; INSN: ##bignum>integer < ##unary/temp ;
! Float arithmetic ! Float arithmetic
INSN: ##add-float < ##commutative ; INSN: ##add-float < ##commutative ;
@ -106,20 +106,21 @@ INSN: ##integer>float < ##unary ;
INSN: ##copy < ##unary ; INSN: ##copy < ##unary ;
INSN: ##copy-float < ##unary ; INSN: ##copy-float < ##unary ;
INSN: ##unbox-float < ##unary ; INSN: ##unbox-float < ##unary ;
INSN: ##unbox-f < ##unary ; INSN: ##unbox-any-c-ptr < ##unary/temp ;
INSN: ##unbox-alien < ##unary ; INSN: ##box-float < ##unary/temp ;
INSN: ##unbox-byte-array < ##unary ; INSN: ##box-alien < ##unary/temp ;
INSN: ##unbox-any-c-ptr < ##unary ;
INSN: ##box-float < ##boxer ;
INSN: ##box-alien < ##boxer ;
: ##unbox-c-ptr ( dst src class -- ) : ##unbox-f ( dst src -- ) drop 0 ##load-immediate ;
: ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ;
: ##unbox-alien ( dst src -- ) 3 object tag-number ##slot-imm ;
: ##unbox-c-ptr ( dst src class temp -- )
{ {
{ [ dup \ f class<= ] [ drop ##unbox-f ] } { [ over \ f class<= ] [ 2drop ##unbox-f ] }
{ [ dup simple-alien class<= ] [ drop ##unbox-alien ] } { [ over simple-alien class<= ] [ 2drop ##unbox-alien ] }
{ [ dup byte-array class<= ] [ drop ##unbox-byte-array ] } { [ over byte-array class<= ] [ 2drop ##unbox-byte-array ] }
[ drop ##unbox-any-c-ptr ] [ nip ##unbox-any-c-ptr ]
} cond ; inline } cond ;
! Alien accessors ! Alien accessors
INSN: ##alien-unsigned-1 < ##alien-getter ; INSN: ##alien-unsigned-1 < ##alien-getter ;
@ -127,7 +128,7 @@ INSN: ##alien-unsigned-2 < ##alien-getter ;
INSN: ##alien-unsigned-4 < ##alien-getter ; INSN: ##alien-unsigned-4 < ##alien-getter ;
INSN: ##alien-signed-1 < ##alien-getter ; INSN: ##alien-signed-1 < ##alien-getter ;
INSN: ##alien-signed-2 < ##alien-getter ; INSN: ##alien-signed-2 < ##alien-getter ;
INSN: ##alien-signed-3 < ##alien-getter ; INSN: ##alien-signed-4 < ##alien-getter ;
INSN: ##alien-cell < ##alien-getter ; INSN: ##alien-cell < ##alien-getter ;
INSN: ##alien-float < ##alien-getter ; INSN: ##alien-float < ##alien-getter ;
INSN: ##alien-double < ##alien-getter ; INSN: ##alien-double < ##alien-getter ;
@ -174,11 +175,16 @@ SYMBOL: cc/=
{ cc/= { +lt+ +gt+ } } { cc/= { +lt+ +gt+ } }
} at memq? ; } at memq? ;
INSN: ##binary-branch { src1 vreg } { src2 vreg } cc ; TUPLE: ##conditional-branch < insn { src1 vreg } { src2 vreg } cc ;
INSN: ##binary-imm-branch { src1 vreg } { src2 integer } cc ;
INSN: ##boolean < ##binary cc ; INSN: ##compare-branch < ##conditional-branch ;
INSN: ##boolean-imm < ##binary-imm cc ; INSN: ##compare-imm-branch { src1 vreg } { src2 integer } cc ;
INSN: ##compare < ##binary cc ;
INSN: ##compare-imm < ##binary-imm cc ;
INSN: ##compare-float-branch < ##conditional-branch ;
INSN: ##compare-float < ##binary cc ;
! Instructions used by machine IR only. ! Instructions used by machine IR only.
INSN: _prologue stack-frame ; INSN: _prologue stack-frame ;
@ -188,8 +194,12 @@ INSN: _label id ;
INSN: _branch label ; INSN: _branch label ;
INSN: _binary-branch label { src1 vreg } { src2 vreg } cc ; TUPLE: _conditional-branch < insn label { src1 vreg } { src2 vreg } cc ;
INSN: _binary-imm-branch label { src1 vreg } { src2 integer } cc ;
INSN: _compare-branch < _conditional-branch ;
INSN: _compare-imm-branch label { src1 vreg } { src2 integer } cc ;
INSN: _compare-float-branch < _conditional-branch ;
! These instructions operate on machine registers and not ! These instructions operate on machine registers and not
! virtual registers ! virtual registers

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

@ -43,11 +43,14 @@ M: ##branch linearize-insn
: binary-conditional ( basic-block insn -- basic-block successor label2 src1 src2 cc ) : binary-conditional ( basic-block insn -- basic-block successor label2 src1 src2 cc )
[ conditional ] [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline [ conditional ] [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline
M: ##binary-branch linearize-insn M: ##compare-branch linearize-insn
binary-conditional _binary-branch emit-branch ; binary-conditional _compare-branch emit-branch ;
M: ##binary-imm-branch linearize-insn M: ##compare-imm-branch linearize-insn
binary-conditional _binary-imm-branch emit-branch ; binary-conditional _compare-imm-branch emit-branch ;
M: ##compare-float-branch linearize-insn
binary-conditional _compare-float-branch emit-branch ;
: linearize-basic-block ( bb -- ) : linearize-basic-block ( bb -- )
[ number>> _label ] [ linearize-insns ] bi ; [ number>> _label ] [ linearize-insns ] bi ;

32
basis/compiler/codegen/codegen.factor
View File

@ -98,9 +98,11 @@ M: ##dispatch generate-insn
[ tag>> ] [ tag>> ]
} cleave ; inline } cleave ; inline
M: ##slot generate-insn >slot< %slot ; M: ##slot generate-insn
[ >slot< ] [ temp>> register ] bi %slot ;
M: ##slot-imm generate-insn >slot< %slot-imm ; M: ##slot-imm generate-insn
>slot< %slot-imm ;
: >set-slot< : >set-slot<
{ {
@ -110,9 +112,11 @@ M: ##slot-imm generate-insn >slot< %slot-imm ;
[ tag>> ] [ tag>> ]
} cleave ; inline } cleave ; inline
M: ##set-slot generate-insn >set-slot< %set-slot ; M: ##set-slot generate-insn
[ >set-slot< ] [ temp>> register ] bi %set-slot ;
M: ##set-slot-imm generate-insn >set-slot< %set-slot-imm ; M: ##set-slot-imm generate-insn
>set-slot< %set-slot-imm ;
: dst/src ( insn -- dst src ) : dst/src ( insn -- dst src )
[ dst>> register ] [ src>> register ] bi ; inline [ dst>> register ] [ src>> register ] bi ; inline
@ -154,9 +158,6 @@ M: ##float>integer generate-insn dst/src %float>integer ;
M: ##copy generate-insn dst/src %copy ; M: ##copy generate-insn dst/src %copy ;
M: ##copy-float generate-insn dst/src %copy-float ; M: ##copy-float generate-insn dst/src %copy-float ;
M: ##unbox-float generate-insn dst/src %unbox-float ; M: ##unbox-float generate-insn dst/src %unbox-float ;
M: ##unbox-f generate-insn dst/src %unbox-f ;
M: ##unbox-alien generate-insn dst/src %unbox-alien ;
M: ##unbox-byte-array generate-insn dst/src %unbox-byte-array ;
M: ##unbox-any-c-ptr generate-insn dst/src %unbox-any-c-ptr ; M: ##unbox-any-c-ptr generate-insn dst/src %unbox-any-c-ptr ;
M: ##box-float generate-insn dst/src/temp %box-float ; M: ##box-float generate-insn dst/src/temp %box-float ;
M: ##box-alien generate-insn dst/src/temp %box-alien ; M: ##box-alien generate-insn dst/src/temp %box-alien ;
@ -166,7 +167,7 @@ M: ##alien-unsigned-2 generate-insn dst/src %alien-unsigned-2 ;
M: ##alien-unsigned-4 generate-insn dst/src %alien-unsigned-4 ; M: ##alien-unsigned-4 generate-insn dst/src %alien-unsigned-4 ;
M: ##alien-signed-1 generate-insn dst/src %alien-signed-1 ; M: ##alien-signed-1 generate-insn dst/src %alien-signed-1 ;
M: ##alien-signed-2 generate-insn dst/src %alien-signed-2 ; M: ##alien-signed-2 generate-insn dst/src %alien-signed-2 ;
M: ##alien-signed-3 generate-insn dst/src %alien-signed-3 ; M: ##alien-signed-4 generate-insn dst/src %alien-signed-4 ;
M: ##alien-cell generate-insn dst/src %alien-cell ; M: ##alien-cell generate-insn dst/src %alien-cell ;
M: ##alien-float generate-insn dst/src %alien-float ; M: ##alien-float generate-insn dst/src %alien-float ;
M: ##alien-double generate-insn dst/src %alien-double ; M: ##alien-double generate-insn dst/src %alien-double ;
@ -461,19 +462,22 @@ M: _label generate-insn
M: _branch generate-insn M: _branch generate-insn
label>> lookup-label %jump-label ; label>> lookup-label %jump-label ;
: >binary-branch< ( insn -- label src1 src2 cc ) : >binary-branch< ( insn -- label cc src1 src2 )
{ {
[ label>> lookup-label ] [ label>> lookup-label ]
[ cc>> ]
[ src1>> register ] [ src1>> register ]
[ src2>> dup vreg? [ register ] when ] [ src2>> dup vreg? [ register ] when ]
[ cc>> ]
} cleave ; } cleave ;
M: _binary-branch generate-insn M: _compare-branch generate-insn
>binary-branch< %binary-branch ; >binary-branch< %compare-branch ;
M: _binary-imm-branch generate-insn M: _compare-imm-branch generate-insn
>binary-branch< %binary-imm-branch ; >binary-branch< %compare-imm-branch ;
M: _compare-float-branch generate-insn
>binary-branch< %compare-float-branch ;
M: _spill generate-insn M: _spill generate-insn
[ src>> ] [ n>> ] [ class>> ] tri { [ src>> ] [ n>> ] [ class>> ] tri {

44
basis/cpu/architecture/architecture.factor
View File

@ -51,9 +51,9 @@ HOOK: %return cpu ( -- )
HOOK: %dispatch cpu ( src temp -- ) HOOK: %dispatch cpu ( src temp -- )
HOOK: %dispatch-label cpu ( word -- ) HOOK: %dispatch-label cpu ( word -- )
HOOK: %slot cpu ( dst obj slot tag -- ) HOOK: %slot cpu ( dst obj slot tag temp -- )
HOOK: %slot-imm cpu ( dst obj slot tag -- ) HOOK: %slot-imm cpu ( dst obj slot tag -- )
HOOK: %set-slot cpu ( src obj slot tag -- ) HOOK: %set-slot cpu ( src obj slot tag temp -- )
HOOK: %set-slot-imm cpu ( src obj slot tag -- ) HOOK: %set-slot-imm cpu ( src obj slot tag -- )
HOOK: %add cpu ( dst src1 src2 -- ) HOOK: %add cpu ( dst src1 src2 -- )
@ -73,24 +73,21 @@ HOOK: %shr-imm cpu ( dst src1 src2 -- )
HOOK: %sar-imm cpu ( dst src1 src2 -- ) HOOK: %sar-imm cpu ( dst src1 src2 -- )
HOOK: %not cpu ( dst src -- ) HOOK: %not cpu ( dst src -- )
HOOK: %integer>bignum cpu ( dst src -- ) HOOK: %integer>bignum cpu ( dst src temp -- )
HOOK: %bignum>integer cpu ( dst src -- ) HOOK: %bignum>integer cpu ( dst src temp -- )
HOOK: %add-float cpu ( dst src1 src2 -- ) HOOK: %add-float cpu ( dst src1 src2 -- )
HOOK: %sub-float cpu ( dst src1 src2 -- ) HOOK: %sub-float cpu ( dst src1 src2 -- )
HOOK: %mul-float cpu ( dst src1 src2 -- ) HOOK: %mul-float cpu ( dst src1 src2 -- )
HOOK: %div-float cpu ( dst src1 src2 -- ) HOOK: %div-float cpu ( dst src1 src2 -- )
HOOK: %integer>float cpu ( dst src -- ) HOOK: %integer>float cpu ( dst src -- )
HOOK: %float>integer cpu ( dst src -- ) HOOK: %float>integer cpu ( dst src -- )
HOOK: %copy cpu ( dst src -- ) HOOK: %copy cpu ( dst src -- )
HOOK: %copy-float cpu ( dst src -- ) HOOK: %copy-float cpu ( dst src -- )
HOOK: %unbox-float cpu ( dst src -- ) HOOK: %unbox-float cpu ( dst src -- )
HOOK: %unbox-f cpu ( dst src -- ) HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
HOOK: %unbox-alien cpu ( dst src -- )
HOOK: %unbox-byte-array cpu ( dst src -- )
HOOK: %unbox-any-c-ptr cpu ( dst src -- )
HOOK: %box-float cpu ( dst src temp -- ) HOOK: %box-float cpu ( dst src temp -- )
HOOK: %box-alien cpu ( dst src temp -- ) HOOK: %box-alien cpu ( dst src temp -- )
@ -99,17 +96,17 @@ HOOK: %alien-unsigned-2 cpu ( dst src -- )
HOOK: %alien-unsigned-4 cpu ( dst src -- ) HOOK: %alien-unsigned-4 cpu ( dst src -- )
HOOK: %alien-signed-1 cpu ( dst src -- ) HOOK: %alien-signed-1 cpu ( dst src -- )
HOOK: %alien-signed-2 cpu ( dst src -- ) HOOK: %alien-signed-2 cpu ( dst src -- )
HOOK: %alien-signed-3 cpu ( dst src -- ) HOOK: %alien-signed-4 cpu ( dst src -- )
HOOK: %alien-cell cpu ( dst src -- ) HOOK: %alien-cell cpu ( dst src -- )
HOOK: %alien-float cpu ( dst src -- ) HOOK: %alien-float cpu ( dst src -- )
HOOK: %alien-double cpu ( dst src -- ) HOOK: %alien-double cpu ( dst src -- )
HOOK: %set-alien-integer-1 cpu ( src value -- ) HOOK: %set-alien-integer-1 cpu ( ptr value -- )
HOOK: %set-alien-integer-2 cpu ( src value -- ) HOOK: %set-alien-integer-2 cpu ( ptr value -- )
HOOK: %set-alien-integer-4 cpu ( src value -- ) HOOK: %set-alien-integer-4 cpu ( ptr value -- )
HOOK: %set-alien-cell cpu ( src value -- ) HOOK: %set-alien-cell cpu ( ptr value -- )
HOOK: %set-alien-float cpu ( src value -- ) HOOK: %set-alien-float cpu ( ptr value -- )
HOOK: %set-alien-double cpu ( src value -- ) HOOK: %set-alien-double cpu ( ptr value -- )
HOOK: %allot cpu ( dst size type tag temp -- ) HOOK: %allot cpu ( dst size type tag temp -- )
HOOK: %write-barrier cpu ( src card# table -- ) HOOK: %write-barrier cpu ( src card# table -- )
@ -118,8 +115,9 @@ HOOK: %gc cpu ( -- )
HOOK: %prologue cpu ( n -- ) HOOK: %prologue cpu ( n -- )
HOOK: %epilogue cpu ( n -- ) HOOK: %epilogue cpu ( n -- )
HOOK: %binary-branch cpu ( label src1 src2 label cc -- ) HOOK: %compare-branch cpu ( label cc src1 src2 -- )
HOOK: %binary-imm-branch cpu ( label src1 src2 label cc -- ) HOOK: %compare-imm-branch cpu ( label cc src1 src2 -- )
HOOK: %compare-float-branch cpu ( label cc src1 src2 -- )
HOOK: %spill-integer cpu ( src n -- ) HOOK: %spill-integer cpu ( src n -- )
HOOK: %spill-float cpu ( src n -- ) HOOK: %spill-float cpu ( src n -- )