2010-04-21 03:08:52 -04:00
|
|
|
! Copyright (C) 2010 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: accessors combinators cpu.architecture fry kernel layouts
|
2010-04-23 04:17:41 -04:00
|
|
|
locals make math sequences compiler.cfg.instructions
|
|
|
|
compiler.cfg.registers
|
2010-04-24 02:38:43 -04:00
|
|
|
compiler.cfg.utilities
|
2010-04-21 03:08:52 -04:00
|
|
|
compiler.cfg.value-numbering.expressions
|
|
|
|
compiler.cfg.value-numbering.folding
|
|
|
|
compiler.cfg.value-numbering.graph
|
2010-04-24 02:38:43 -04:00
|
|
|
compiler.cfg.value-numbering.rewrite ;
|
2010-04-21 03:08:52 -04:00
|
|
|
IN: compiler.cfg.value-numbering.math
|
|
|
|
|
2010-04-24 04:49:35 -04:00
|
|
|
: f-expr? ( expr -- ? ) T{ reference-expr f f } = ; inline
|
2010-04-23 04:17:41 -04:00
|
|
|
|
2010-04-21 03:08:52 -04:00
|
|
|
M: ##tagged>integer rewrite
|
|
|
|
[ dst>> ] [ src>> vreg>expr ] bi {
|
|
|
|
{ [ dup integer-expr? ] [ value>> tag-fixnum \ ##load-integer new-insn ] }
|
2010-04-23 04:23:32 -04:00
|
|
|
{ [ dup f-expr? ] [ drop \ f type-number \ ##load-integer new-insn ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
[ 2drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
2010-04-24 02:38:43 -04:00
|
|
|
: self-inverse ( insn -- insn' )
|
|
|
|
[ dst>> ] [ src>> vreg>expr src>> vn>vreg ] bi <copy> ;
|
|
|
|
|
|
|
|
: identity ( insn -- insn' )
|
|
|
|
[ dst>> ] [ src1>> ] bi <copy> ;
|
|
|
|
|
2010-04-21 03:08:52 -04:00
|
|
|
M: ##neg rewrite
|
2010-04-24 02:38:43 -04:00
|
|
|
{
|
|
|
|
{ [ dup src>> vreg>expr neg-expr? ] [ self-inverse ] }
|
|
|
|
{ [ dup unary-constant-fold? ] [ unary-constant-fold ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
2010-04-21 03:08:52 -04:00
|
|
|
|
|
|
|
M: ##not rewrite
|
2010-04-24 02:38:43 -04:00
|
|
|
{
|
|
|
|
{ [ dup src>> vreg>expr not-expr? ] [ self-inverse ] }
|
|
|
|
{ [ dup unary-constant-fold? ] [ unary-constant-fold ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
2010-04-21 03:08:52 -04:00
|
|
|
|
2010-04-23 04:17:41 -04:00
|
|
|
! Reassociation converts
|
|
|
|
! ## *-imm 2 1 X
|
|
|
|
! ## *-imm 3 2 Y
|
|
|
|
! into
|
|
|
|
! ## *-imm 3 1 (X $ Y)
|
|
|
|
! If * is associative, then $ is the same operation as *.
|
|
|
|
! In the case of shifts, $ is addition.
|
|
|
|
: (reassociate) ( insn -- dst src1 src2' src2'' )
|
2010-04-21 03:08:52 -04:00
|
|
|
{
|
|
|
|
[ dst>> ]
|
2010-04-24 04:49:35 -04:00
|
|
|
[ src1>> vreg>expr [ src1>> vn>vreg ] [ src2>> ] bi ]
|
2010-04-21 03:08:52 -04:00
|
|
|
[ src2>> ]
|
2010-04-23 04:17:41 -04:00
|
|
|
} cleave ; inline
|
|
|
|
|
|
|
|
: reassociate ( insn -- dst src1 src2 )
|
|
|
|
[ (reassociate) ] keep binary-constant-fold* ;
|
2010-04-21 03:08:52 -04:00
|
|
|
|
|
|
|
: ?new-insn ( dst src1 src2 ? class -- insn/f )
|
|
|
|
'[ _ new-insn ] [ 3drop f ] if ; inline
|
|
|
|
|
|
|
|
: reassociate-arithmetic ( insn new-insn -- insn/f )
|
|
|
|
[ reassociate dup immediate-arithmetic? ] dip ?new-insn ; inline
|
|
|
|
|
|
|
|
: reassociate-bitwise ( insn new-insn -- insn/f )
|
|
|
|
[ reassociate dup immediate-bitwise? ] dip ?new-insn ; inline
|
|
|
|
|
2010-04-23 04:17:41 -04:00
|
|
|
: reassociate-shift ( insn new-insn -- insn/f )
|
|
|
|
[ (reassociate) + dup immediate-shift-count? ] dip ?new-insn ; inline
|
|
|
|
|
2010-04-21 03:08:52 -04:00
|
|
|
M: ##add-imm rewrite
|
|
|
|
{
|
2010-04-24 02:38:43 -04:00
|
|
|
{ [ dup src2>> 0 = ] [ identity ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
|
|
|
{ [ dup src1>> vreg>expr add-imm-expr? ] [ \ ##add-imm reassociate-arithmetic ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
: sub-imm>add-imm ( insn -- insn' )
|
2010-04-24 02:38:43 -04:00
|
|
|
[ dst>> ] [ src1>> ] [ src2>> neg ] tri
|
|
|
|
dup immediate-arithmetic?
|
2010-04-21 03:08:52 -04:00
|
|
|
\ ##add-imm ?new-insn ;
|
|
|
|
|
2010-04-24 02:38:43 -04:00
|
|
|
M: ##sub-imm rewrite sub-imm>add-imm ;
|
2010-04-21 03:08:52 -04:00
|
|
|
|
2010-04-23 04:17:41 -04:00
|
|
|
! Convert ##mul-imm -1 => ##neg
|
2010-04-21 03:08:52 -04:00
|
|
|
: mul-to-neg? ( insn -- ? )
|
|
|
|
src2>> -1 = ;
|
|
|
|
|
|
|
|
: mul-to-neg ( insn -- insn' )
|
|
|
|
[ dst>> ] [ src1>> ] bi \ ##neg new-insn ;
|
|
|
|
|
2010-04-23 04:17:41 -04:00
|
|
|
! Convert ##mul-imm 2^X => ##shl-imm X
|
2010-04-21 03:08:52 -04:00
|
|
|
: mul-to-shl? ( insn -- ? )
|
|
|
|
src2>> power-of-2? ;
|
|
|
|
|
|
|
|
: mul-to-shl ( insn -- insn' )
|
|
|
|
[ [ dst>> ] [ src1>> ] bi ] [ src2>> log2 ] bi \ ##shl-imm new-insn ;
|
|
|
|
|
2010-04-23 04:17:41 -04:00
|
|
|
! Distribution converts
|
|
|
|
! ##+-imm 2 1 X
|
|
|
|
! ##*-imm 3 2 Y
|
|
|
|
! Into
|
|
|
|
! ##*-imm 4 1 Y
|
|
|
|
! ##+-imm 3 4 X*Y
|
|
|
|
! Where * is mul or shl, + is add or sub
|
|
|
|
! Have to make sure that X*Y fits in an immediate
|
|
|
|
:: (distribute) ( insn expr imm temp add-op mul-op -- new-insns/f )
|
|
|
|
imm immediate-arithmetic? [
|
|
|
|
[
|
|
|
|
temp expr src1>> vn>vreg insn src2>> mul-op execute
|
|
|
|
insn dst>> temp imm add-op execute
|
|
|
|
] { } make
|
2010-04-23 04:23:32 -04:00
|
|
|
] [ f ] if ; inline
|
2010-04-23 04:17:41 -04:00
|
|
|
|
|
|
|
: distribute-over-add? ( insn -- ? )
|
|
|
|
src1>> vreg>expr add-imm-expr? ;
|
|
|
|
|
|
|
|
: distribute-over-sub? ( insn -- ? )
|
|
|
|
src1>> vreg>expr sub-imm-expr? ;
|
|
|
|
|
|
|
|
: distribute ( insn add-op mul-op -- new-insns/f )
|
|
|
|
[
|
|
|
|
dup src1>> vreg>expr
|
2010-04-24 04:49:35 -04:00
|
|
|
2dup src2>> swap [ src2>> ] keep binary-constant-fold*
|
2010-04-23 04:17:41 -04:00
|
|
|
next-vreg
|
2010-04-23 04:23:32 -04:00
|
|
|
] 2dip (distribute) ; inline
|
2010-04-23 04:17:41 -04:00
|
|
|
|
2010-04-21 03:08:52 -04:00
|
|
|
M: ##mul-imm rewrite
|
|
|
|
{
|
|
|
|
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
|
|
|
{ [ dup mul-to-neg? ] [ mul-to-neg ] }
|
|
|
|
{ [ dup mul-to-shl? ] [ mul-to-shl ] }
|
|
|
|
{ [ dup src1>> vreg>expr mul-imm-expr? ] [ \ ##mul-imm reassociate-arithmetic ] }
|
2010-04-23 04:17:41 -04:00
|
|
|
{ [ dup distribute-over-add? ] [ \ ##add-imm \ ##mul-imm distribute ] }
|
|
|
|
{ [ dup distribute-over-sub? ] [ \ ##sub-imm \ ##mul-imm distribute ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##and-imm rewrite
|
|
|
|
{
|
|
|
|
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
|
|
|
{ [ dup src1>> vreg>expr and-imm-expr? ] [ \ ##and-imm reassociate-bitwise ] }
|
2010-04-24 02:38:43 -04:00
|
|
|
{ [ dup src2>> 0 = ] [ dst>> 0 \ ##load-integer new-insn ] }
|
|
|
|
{ [ dup src2>> -1 = ] [ identity ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##or-imm rewrite
|
|
|
|
{
|
2010-04-24 02:38:43 -04:00
|
|
|
{ [ dup src2>> 0 = ] [ identity ] }
|
|
|
|
{ [ dup src2>> -1 = ] [ dst>> -1 \ ##load-integer new-insn ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
|
|
|
{ [ dup src1>> vreg>expr or-imm-expr? ] [ \ ##or-imm reassociate-bitwise ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##xor-imm rewrite
|
|
|
|
{
|
2010-04-24 02:38:43 -04:00
|
|
|
{ [ dup src2>> 0 = ] [ identity ] }
|
|
|
|
{ [ dup src2>> -1 = ] [ [ dst>> ] [ src1>> ] bi \ ##not new-insn ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
|
|
|
{ [ dup src1>> vreg>expr xor-imm-expr? ] [ \ ##xor-imm reassociate-bitwise ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##shl-imm rewrite
|
|
|
|
{
|
2010-04-24 02:38:43 -04:00
|
|
|
{ [ dup src2>> 0 = ] [ identity ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
2010-04-23 04:17:41 -04:00
|
|
|
{ [ dup src1>> vreg>expr shl-imm-expr? ] [ \ ##shl-imm reassociate-shift ] }
|
|
|
|
{ [ dup distribute-over-add? ] [ \ ##add-imm \ ##shl-imm distribute ] }
|
|
|
|
{ [ dup distribute-over-sub? ] [ \ ##sub-imm \ ##shl-imm distribute ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##shr-imm rewrite
|
|
|
|
{
|
2010-04-24 02:38:43 -04:00
|
|
|
{ [ dup src2>> 0 = ] [ identity ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
2010-04-23 04:17:41 -04:00
|
|
|
{ [ dup src1>> vreg>expr shr-imm-expr? ] [ \ ##shr-imm reassociate-shift ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##sar-imm rewrite
|
|
|
|
{
|
2010-04-24 02:38:43 -04:00
|
|
|
{ [ dup src2>> 0 = ] [ identity ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
2010-04-23 04:17:41 -04:00
|
|
|
{ [ dup src1>> vreg>expr sar-imm-expr? ] [ \ ##sar-imm reassociate-shift ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
2010-04-23 04:17:41 -04:00
|
|
|
! Convert
|
|
|
|
! ##load-integer 2 X
|
|
|
|
! ##* 3 1 2
|
|
|
|
! Where * is an operation with an -imm equivalent into
|
|
|
|
! ##*-imm 3 1 X
|
2010-04-21 03:08:52 -04:00
|
|
|
: insn>imm-insn ( insn op swap? -- new-insn )
|
|
|
|
swap [
|
|
|
|
[ [ dst>> ] [ src1>> ] [ src2>> ] tri ] dip
|
|
|
|
[ swap ] when vreg>integer
|
|
|
|
] dip new-insn ; inline
|
|
|
|
|
|
|
|
M: ##add rewrite
|
|
|
|
{
|
|
|
|
{ [ dup src2>> vreg-immediate-arithmetic? ] [ \ ##add-imm f insn>imm-insn ] }
|
|
|
|
{ [ dup src1>> vreg-immediate-arithmetic? ] [ \ ##add-imm t insn>imm-insn ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
2010-04-24 02:38:43 -04:00
|
|
|
: diagonal? ( insn -- ? )
|
|
|
|
[ src1>> vreg>vn ] [ src2>> vreg>vn ] bi = ; inline
|
2010-04-21 03:08:52 -04:00
|
|
|
|
2010-04-24 02:38:43 -04:00
|
|
|
! ##sub 2 1 1 => ##load-integer 2 0
|
2010-04-21 03:08:52 -04:00
|
|
|
: rewrite-subtraction-identity ( insn -- insn' )
|
|
|
|
dst>> 0 \ ##load-integer new-insn ;
|
|
|
|
|
2010-04-23 04:17:41 -04:00
|
|
|
! ##load-integer 1 0
|
|
|
|
! ##sub 3 1 2
|
|
|
|
! =>
|
|
|
|
! ##neg 3 2
|
2010-04-21 03:08:52 -04:00
|
|
|
: sub-to-neg? ( ##sub -- ? )
|
2010-04-24 04:49:35 -04:00
|
|
|
src1>> vreg>expr zero-expr? ;
|
2010-04-21 03:08:52 -04:00
|
|
|
|
|
|
|
: sub-to-neg ( ##sub -- insn )
|
|
|
|
[ dst>> ] [ src2>> ] bi \ ##neg new-insn ;
|
|
|
|
|
|
|
|
M: ##sub rewrite
|
|
|
|
{
|
|
|
|
{ [ dup sub-to-neg? ] [ sub-to-neg ] }
|
2010-04-24 02:38:43 -04:00
|
|
|
{ [ dup diagonal? ] [ rewrite-subtraction-identity ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
{ [ dup src2>> vreg-immediate-arithmetic? ] [ \ ##sub-imm f insn>imm-insn ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##mul rewrite
|
|
|
|
{
|
|
|
|
{ [ dup src2>> vreg-immediate-arithmetic? ] [ \ ##mul-imm f insn>imm-insn ] }
|
|
|
|
{ [ dup src1>> vreg-immediate-arithmetic? ] [ \ ##mul-imm t insn>imm-insn ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##and rewrite
|
|
|
|
{
|
2010-04-24 02:38:43 -04:00
|
|
|
{ [ dup diagonal? ] [ identity ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##and-imm f insn>imm-insn ] }
|
|
|
|
{ [ dup src1>> vreg-immediate-bitwise? ] [ \ ##and-imm t insn>imm-insn ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##or rewrite
|
|
|
|
{
|
2010-04-24 02:38:43 -04:00
|
|
|
{ [ dup diagonal? ] [ identity ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##or-imm f insn>imm-insn ] }
|
|
|
|
{ [ dup src1>> vreg-immediate-bitwise? ] [ \ ##or-imm t insn>imm-insn ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##xor rewrite
|
|
|
|
{
|
2010-04-24 02:38:43 -04:00
|
|
|
{ [ dup diagonal? ] [ dst>> 0 \ ##load-integer new-insn ] }
|
2010-04-21 03:08:52 -04:00
|
|
|
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##xor-imm f insn>imm-insn ] }
|
|
|
|
{ [ dup src1>> vreg-immediate-bitwise? ] [ \ ##xor-imm t insn>imm-insn ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##shl rewrite
|
|
|
|
{
|
|
|
|
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##shl-imm f insn>imm-insn ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##shr rewrite
|
|
|
|
{
|
|
|
|
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##shr-imm f insn>imm-insn ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
M: ##sar rewrite
|
|
|
|
{
|
|
|
|
{ [ dup src2>> vreg-immediate-bitwise? ] [ \ ##sar-imm f insn>imm-insn ] }
|
|
|
|
[ drop f ]
|
|
|
|
} cond ;
|