compiler.cfg.value-numbering: maintain a VN to instruction mapping. This eliminates all instances of expression inspection, allowing the auto-generated expression classes to be removed
Slava Pestov
parent
f548a08637
commit
edaf59bf46
|
|
@ -7,13 +7,14 @@ compiler.cfg.hats
|
|||
compiler.cfg.utilities
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.value-numbering.expressions
|
||||
compiler.cfg.value-numbering.math
|
||||
compiler.cfg.value-numbering.graph
|
||||
compiler.cfg.value-numbering.rewrite ;
|
||||
compiler.cfg.value-numbering.rewrite
|
||||
compiler.cfg.value-numbering.expressions ;
|
||||
IN: compiler.cfg.value-numbering.alien
|
||||
|
||||
M: ##box-displaced-alien rewrite
|
||||
dup displacement>> vreg>expr zero-expr?
|
||||
dup displacement>> vreg>insn zero-insn?
|
||||
[ [ dst>> ] [ base>> ] bi <copy> ] [ drop f ] if ;
|
||||
|
||||
! ##box-displaced-alien f 1 2 3 <class>
|
||||
|
|
@ -23,22 +24,22 @@ M: ##box-displaced-alien rewrite
|
|||
! ##unbox-c-ptr 5 3 <class>
|
||||
! ##add 4 5 2
|
||||
|
||||
: rewrite-unbox-alien ( insn expr -- insn )
|
||||
[ dst>> ] [ src>> vn>vreg ] bi* <copy> ;
|
||||
: rewrite-unbox-alien ( insn box-insn -- insn )
|
||||
[ dst>> ] [ src>> ] bi* <copy> ;
|
||||
|
||||
: rewrite-unbox-displaced-alien ( insn expr -- insns )
|
||||
: rewrite-unbox-displaced-alien ( insn box-insn -- insns )
|
||||
[
|
||||
[ dst>> ]
|
||||
[ [ base>> vn>vreg ] [ base-class>> ] [ displacement>> vn>vreg ] tri ] bi*
|
||||
[ [ base>> ] [ base-class>> ] [ displacement>> ] tri ] bi*
|
||||
[ ^^unbox-c-ptr ] dip
|
||||
##add
|
||||
] { } make ;
|
||||
|
||||
: rewrite-unbox-any-c-ptr ( insn -- insn/f )
|
||||
dup src>> vreg>expr
|
||||
dup src>> vreg>insn
|
||||
{
|
||||
{ [ dup box-alien-expr? ] [ rewrite-unbox-alien ] }
|
||||
{ [ dup box-displaced-alien-expr? ] [ rewrite-unbox-displaced-alien ] }
|
||||
{ [ dup ##box-alien? ] [ rewrite-unbox-alien ] }
|
||||
{ [ dup ##box-displaced-alien? ] [ rewrite-unbox-displaced-alien ] }
|
||||
[ 2drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -49,28 +50,28 @@ M: ##unbox-alien rewrite rewrite-unbox-any-c-ptr ;
|
|||
! Fuse ##add-imm into ##load-memory(-imm) and ##store-memory(-imm)
|
||||
! just update the offset in the instruction
|
||||
: fuse-base-offset? ( insn -- ? )
|
||||
base>> vreg>expr add-imm-expr? ;
|
||||
base>> vreg>insn ##add-imm? ;
|
||||
|
||||
: fuse-base-offset ( insn -- insn' )
|
||||
dup base>> vreg>expr
|
||||
[ src1>> vn>vreg ] [ src2>> ] bi
|
||||
dup base>> vreg>insn
|
||||
[ src1>> ] [ src2>> ] bi
|
||||
[ >>base ] [ '[ _ + ] change-offset ] bi* ;
|
||||
|
||||
! Fuse ##add-imm into ##load-memory and ##store-memory
|
||||
! just update the offset in the instruction
|
||||
: fuse-displacement-offset? ( insn -- ? )
|
||||
{ [ scale>> 0 = ] [ displacement>> vreg>expr add-imm-expr? ] } 1&& ;
|
||||
{ [ scale>> 0 = ] [ displacement>> vreg>insn ##add-imm? ] } 1&& ;
|
||||
|
||||
: fuse-displacement-offset ( insn -- insn' )
|
||||
dup displacement>> vreg>expr
|
||||
[ src1>> vn>vreg ] [ src2>> ] bi
|
||||
dup displacement>> vreg>insn
|
||||
[ src1>> ] [ src2>> ] bi
|
||||
[ >>displacement ] [ '[ _ + ] change-offset ] bi* ;
|
||||
|
||||
! Fuse ##add into ##load-memory-imm and ##store-memory-imm
|
||||
! construct a new ##load-memory or ##store-memory with the
|
||||
! ##add's operand as the displacement
|
||||
: fuse-displacement? ( insn -- ? )
|
||||
base>> vreg>expr add-expr? ;
|
||||
base>> vreg>insn ##add? ;
|
||||
|
||||
GENERIC: alien-insn-value ( insn -- value )
|
||||
|
||||
|
|
@ -85,7 +86,7 @@ M: ##store-memory-imm new-alien-insn drop \ ##store-memory new-insn ;
|
|||
: fuse-displacement ( insn -- insn' )
|
||||
{
|
||||
[ alien-insn-value ]
|
||||
[ base>> vreg>expr [ src1>> vn>vreg ] [ src2>> vn>vreg ] bi ]
|
||||
[ base>> vreg>insn [ src1>> ] [ src2>> ] bi ]
|
||||
[ drop 0 ]
|
||||
[ offset>> ]
|
||||
[ rep>> ]
|
||||
|
|
@ -94,15 +95,15 @@ M: ##store-memory-imm new-alien-insn drop \ ##store-memory new-insn ;
|
|||
} cleave new-alien-insn ;
|
||||
|
||||
! Fuse ##shl-imm into ##load-memory or ##store-memory
|
||||
: scale-expr? ( expr -- ? )
|
||||
{ [ shl-imm-expr? ] [ src2>> { 1 2 3 } member? ] } 1&& ;
|
||||
: scale-insn? ( insn -- ? )
|
||||
{ [ ##shl-imm? ] [ src2>> { 1 2 3 } member? ] } 1&& ;
|
||||
|
||||
: fuse-scale? ( insn -- ? )
|
||||
{ [ scale>> 0 = ] [ displacement>> vreg>expr scale-expr? ] } 1&& ;
|
||||
{ [ scale>> 0 = ] [ displacement>> vreg>insn scale-insn? ] } 1&& ;
|
||||
|
||||
: fuse-scale ( insn -- insn' )
|
||||
dup displacement>> vreg>expr
|
||||
[ src1>> vn>vreg ] [ src2>> ] bi
|
||||
dup displacement>> vreg>insn
|
||||
[ src1>> ] [ src2>> ] bi
|
||||
[ >>displacement ] [ >>scale ] bi* ;
|
||||
|
||||
: rewrite-memory-op ( insn -- insn/f )
|
||||
|
|
|
|||
|
|
@ -18,8 +18,10 @@ IN: compiler.cfg.value-numbering.comparisons
|
|||
! 3) Folding comparisons where both inputs are congruent
|
||||
! 4) Converting compare instructions into compare-imm instructions
|
||||
|
||||
UNION: literal-insn ##load-integer ##load-reference ;
|
||||
|
||||
: fold-compare-imm? ( insn -- ? )
|
||||
src1>> vreg>expr literal-expr? ;
|
||||
src1>> vreg>insn literal-insn? ;
|
||||
|
||||
: evaluate-compare-imm ( insn -- ? )
|
||||
[ src1>> vreg>comparand ] [ src2>> ] [ cc>> ] tri
|
||||
|
|
@ -29,64 +31,49 @@ IN: compiler.cfg.value-numbering.comparisons
|
|||
} case ;
|
||||
|
||||
: fold-compare-integer-imm? ( insn -- ? )
|
||||
src1>> vreg>expr integer-expr? ;
|
||||
src1>> vreg>insn ##load-integer? ;
|
||||
|
||||
: evaluate-compare-integer-imm ( insn -- ? )
|
||||
[ src1>> vreg>integer ] [ src2>> ] [ cc>> ] tri
|
||||
[ <=> ] dip evaluate-cc ;
|
||||
|
||||
: >compare-expr< ( expr -- in1 in2 cc )
|
||||
[ src1>> vn>vreg ] [ src2>> vn>vreg ] [ cc>> ] tri ; inline
|
||||
: >compare< ( insn -- in1 in2 cc )
|
||||
[ src1>> ] [ src2>> ] [ cc>> ] tri ; inline
|
||||
|
||||
: >compare-imm-expr< ( expr -- in1 in2 cc )
|
||||
[ src1>> vn>vreg ] [ src2>> ] [ cc>> ] tri ; inline
|
||||
|
||||
: >compare-integer-expr< ( expr -- in1 in2 cc )
|
||||
[ src1>> vn>vreg ] [ src2>> vn>vreg ] [ cc>> ] tri ; inline
|
||||
|
||||
: >compare-integer-imm-expr< ( expr -- in1 in2 cc )
|
||||
[ src1>> vn>vreg ] [ src2>> ] [ cc>> ] tri ; inline
|
||||
|
||||
: >test-vector-expr< ( expr -- src1 temp rep vcc )
|
||||
: >test-vector< ( insn -- src1 temp rep vcc )
|
||||
{
|
||||
[ src1>> vn>vreg ]
|
||||
[ src1>> ]
|
||||
[ drop next-vreg ]
|
||||
[ rep>> ]
|
||||
[ vcc>> ]
|
||||
} cleave ; inline
|
||||
|
||||
: scalar-compare-expr? ( insn -- ? )
|
||||
{
|
||||
[ compare-expr? ]
|
||||
[ compare-imm-expr? ]
|
||||
[ compare-integer-expr? ]
|
||||
[ compare-integer-imm-expr? ]
|
||||
[ compare-float-unordered-expr? ]
|
||||
[ compare-float-ordered-expr? ]
|
||||
} 1|| ;
|
||||
UNION: scalar-compare-insn
|
||||
##compare
|
||||
##compare-imm
|
||||
##compare-integer
|
||||
##compare-integer-imm
|
||||
##compare-float-unordered
|
||||
##compare-float-ordered ;
|
||||
|
||||
: general-compare-expr? ( insn -- ? )
|
||||
{
|
||||
[ scalar-compare-expr? ]
|
||||
[ test-vector-expr? ]
|
||||
} 1|| ;
|
||||
UNION: general-compare-insn scalar-compare-insn ##test-vector ;
|
||||
|
||||
: rewrite-boolean-comparison? ( insn -- ? )
|
||||
{
|
||||
[ src1>> vreg>expr general-compare-expr? ]
|
||||
[ src1>> vreg>insn general-compare-insn? ]
|
||||
[ src2>> not ]
|
||||
[ cc>> cc/= eq? ]
|
||||
} 1&& ; inline
|
||||
|
||||
: rewrite-boolean-comparison ( expr -- insn )
|
||||
src1>> vreg>expr {
|
||||
{ [ dup compare-expr? ] [ >compare-expr< \ ##compare-branch new-insn ] }
|
||||
{ [ dup compare-imm-expr? ] [ >compare-imm-expr< \ ##compare-imm-branch new-insn ] }
|
||||
{ [ dup compare-integer-expr? ] [ >compare-integer-expr< \ ##compare-integer-branch new-insn ] }
|
||||
{ [ dup compare-integer-imm-expr? ] [ >compare-integer-imm-expr< \ ##compare-integer-imm-branch new-insn ] }
|
||||
{ [ dup compare-float-unordered-expr? ] [ >compare-expr< \ ##compare-float-unordered-branch new-insn ] }
|
||||
{ [ dup compare-float-ordered-expr? ] [ >compare-expr< \ ##compare-float-ordered-branch new-insn ] }
|
||||
{ [ dup test-vector-expr? ] [ >test-vector-expr< \ ##test-vector-branch new-insn ] }
|
||||
: rewrite-boolean-comparison ( insn -- insn )
|
||||
src1>> vreg>insn {
|
||||
{ [ dup ##compare? ] [ >compare< \ ##compare-branch new-insn ] }
|
||||
{ [ dup ##compare-imm? ] [ >compare< \ ##compare-imm-branch new-insn ] }
|
||||
{ [ dup ##compare-integer? ] [ >compare< \ ##compare-integer-branch new-insn ] }
|
||||
{ [ dup ##compare-integer-imm? ] [ >compare< \ ##compare-integer-imm-branch new-insn ] }
|
||||
{ [ dup ##compare-float-unordered? ] [ >compare< \ ##compare-float-unordered-branch new-insn ] }
|
||||
{ [ dup ##compare-float-ordered? ] [ >compare< \ ##compare-float-ordered-branch new-insn ] }
|
||||
{ [ dup ##test-vector? ] [ >test-vector< \ ##test-vector-branch new-insn ] }
|
||||
} cond ;
|
||||
|
||||
: fold-branch ( ? -- insn )
|
||||
|
|
@ -189,19 +176,19 @@ M: ##compare-integer rewrite
|
|||
|
||||
: rewrite-redundant-comparison? ( insn -- ? )
|
||||
{
|
||||
[ src1>> vreg>expr scalar-compare-expr? ]
|
||||
[ src1>> vreg>insn scalar-compare-insn? ]
|
||||
[ src2>> not ]
|
||||
[ cc>> { cc= cc/= } member? ]
|
||||
} 1&& ; inline
|
||||
|
||||
: rewrite-redundant-comparison ( insn -- insn' )
|
||||
[ cc>> ] [ dst>> ] [ src1>> vreg>expr ] tri {
|
||||
{ [ dup compare-expr? ] [ >compare-expr< next-vreg \ ##compare new-insn ] }
|
||||
{ [ dup compare-imm-expr? ] [ >compare-imm-expr< next-vreg \ ##compare-imm new-insn ] }
|
||||
{ [ dup compare-integer-expr? ] [ >compare-integer-expr< next-vreg \ ##compare-integer new-insn ] }
|
||||
{ [ dup compare-integer-imm-expr? ] [ >compare-integer-imm-expr< next-vreg \ ##compare-integer-imm new-insn ] }
|
||||
{ [ dup compare-float-unordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-unordered new-insn ] }
|
||||
{ [ dup compare-float-ordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-ordered new-insn ] }
|
||||
[ cc>> ] [ dst>> ] [ src1>> vreg>insn ] tri {
|
||||
{ [ dup ##compare? ] [ >compare< next-vreg \ ##compare new-insn ] }
|
||||
{ [ dup ##compare-imm? ] [ >compare< next-vreg \ ##compare-imm new-insn ] }
|
||||
{ [ dup ##compare-integer? ] [ >compare< next-vreg \ ##compare-integer new-insn ] }
|
||||
{ [ dup ##compare-integer-imm? ] [ >compare< next-vreg \ ##compare-integer-imm new-insn ] }
|
||||
{ [ dup ##compare-float-unordered? ] [ >compare< next-vreg \ ##compare-float-unordered new-insn ] }
|
||||
{ [ dup ##compare-float-ordered? ] [ >compare< next-vreg \ ##compare-float-ordered new-insn ] }
|
||||
} cond
|
||||
swap cc= eq? [ [ negate-cc ] change-cc ] when ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,22 +1,69 @@
|
|||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors classes classes.algebra classes.parser
|
||||
USING: accessors arrays classes classes.algebra classes.parser
|
||||
classes.tuple combinators combinators.short-circuit fry
|
||||
generic.parser kernel layouts math namespaces quotations
|
||||
sequences slots splitting words
|
||||
sequences slots splitting words make
|
||||
cpu.architecture
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.instructions.syntax
|
||||
compiler.cfg.value-numbering.graph ;
|
||||
FROM: sequences.private => set-array-nth ;
|
||||
IN: compiler.cfg.value-numbering.expressions
|
||||
|
||||
TUPLE: integer-expr < expr value ;
|
||||
<<
|
||||
|
||||
GENERIC: >expr ( insn -- expr )
|
||||
|
||||
: input-values ( slot-specs -- slot-specs' )
|
||||
[ type>> { use literal } member-eq? ] filter ;
|
||||
|
||||
: slot->expr-quot ( slot-spec -- quot )
|
||||
[ name>> reader-word 1quotation ]
|
||||
[
|
||||
type>> {
|
||||
{ use [ [ vreg>vn ] ] }
|
||||
{ literal [ [ ] ] }
|
||||
} case
|
||||
] bi append ;
|
||||
|
||||
: narray-quot ( length -- quot )
|
||||
[
|
||||
[ , [ f <array> ] % ]
|
||||
[
|
||||
dup iota [
|
||||
- 1 - , [ swap [ set-array-nth ] keep ] %
|
||||
] with each
|
||||
] bi
|
||||
] [ ] make ;
|
||||
|
||||
: >expr-quot ( insn slot-specs -- quot )
|
||||
[
|
||||
[ literalize , \ swap , ]
|
||||
[
|
||||
[ [ slot->expr-quot ] map cleave>quot % ]
|
||||
[ length 1 + narray-quot % ]
|
||||
bi
|
||||
] bi*
|
||||
] [ ] make ;
|
||||
|
||||
: define->expr-method ( insn slot-specs -- )
|
||||
[ drop \ >expr create-method-in ] [ >expr-quot ] 2bi define ;
|
||||
|
||||
insn-classes get
|
||||
[ pure-insn class<= ] filter
|
||||
[
|
||||
dup "insn-slots" word-prop input-values
|
||||
define->expr-method
|
||||
] each
|
||||
|
||||
>>
|
||||
|
||||
TUPLE: integer-expr value ;
|
||||
|
||||
C: <integer-expr> integer-expr
|
||||
|
||||
: zero-expr? ( expr -- ? ) T{ integer-expr f 0 } = ; inline
|
||||
|
||||
TUPLE: reference-expr < expr value ;
|
||||
TUPLE: reference-expr value ;
|
||||
|
||||
C: <reference-expr> reference-expr
|
||||
|
||||
|
|
@ -30,9 +77,11 @@ M: reference-expr equal?
|
|||
M: reference-expr hashcode*
|
||||
nip value>> dup float? [ double>bits ] [ identity-hashcode ] if ;
|
||||
|
||||
UNION: literal-expr integer-expr reference-expr ;
|
||||
! Expressions whose values are inputs to the basic block.
|
||||
TUPLE: input-expr n ;
|
||||
|
||||
GENERIC: >expr ( insn -- expr )
|
||||
: next-input-expr ( -- expr )
|
||||
input-expr-counter counter input-expr boa ;
|
||||
|
||||
M: insn >expr drop next-input-expr ;
|
||||
|
||||
|
|
@ -42,72 +91,35 @@ M: ##load-integer >expr val>> <integer-expr> ;
|
|||
|
||||
M: ##load-reference >expr obj>> <reference-expr> ;
|
||||
|
||||
GENERIC: expr>integer ( expr -- n )
|
||||
GENERIC: insn>integer ( insn -- n )
|
||||
|
||||
M: integer-expr expr>integer value>> ;
|
||||
M: ##load-integer insn>integer val>> ;
|
||||
|
||||
: vn>integer ( vn -- n ) vn>expr expr>integer ;
|
||||
|
||||
: vreg>integer ( vreg -- n ) vreg>vn vn>integer ; inline
|
||||
: vreg>integer ( vreg -- n ) vreg>insn insn>integer ; inline
|
||||
|
||||
: vreg-immediate-arithmetic? ( vreg -- ? )
|
||||
vreg>expr {
|
||||
[ integer-expr? ]
|
||||
[ expr>integer immediate-arithmetic? ]
|
||||
vreg>insn {
|
||||
[ ##load-integer? ]
|
||||
[ val>> immediate-arithmetic? ]
|
||||
} 1&& ;
|
||||
|
||||
: vreg-immediate-bitwise? ( vreg -- ? )
|
||||
vreg>expr {
|
||||
[ integer-expr? ]
|
||||
[ expr>integer immediate-bitwise? ]
|
||||
vreg>insn {
|
||||
[ ##load-integer? ]
|
||||
[ val>> immediate-bitwise? ]
|
||||
} 1&& ;
|
||||
|
||||
GENERIC: expr>comparand ( expr -- n )
|
||||
GENERIC: insn>comparand ( expr -- n )
|
||||
|
||||
M: integer-expr expr>comparand value>> tag-fixnum ;
|
||||
M: ##load-integer insn>comparand val>> tag-fixnum ;
|
||||
|
||||
M: reference-expr expr>comparand value>> ;
|
||||
M: ##load-reference insn>comparand obj>> ;
|
||||
|
||||
: vn>comparand ( vn -- n ) vn>expr expr>comparand ;
|
||||
|
||||
: vreg>comparand ( vreg -- n ) vreg>vn vn>comparand ; inline
|
||||
: vreg>comparand ( vreg -- n ) vreg>insn insn>comparand ; inline
|
||||
|
||||
: vreg-immediate-comparand? ( vreg -- ? )
|
||||
vreg>expr {
|
||||
{ [ dup integer-expr? ] [ expr>integer tag-fixnum immediate-comparand? ] }
|
||||
{ [ dup reference-expr? ] [ value>> immediate-comparand? ] }
|
||||
vreg>insn {
|
||||
{ [ dup ##load-integer? ] [ val>> tag-fixnum immediate-comparand? ] }
|
||||
{ [ dup ##load-reference? ] [ obj>> immediate-comparand? ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
<<
|
||||
|
||||
: input-values ( slot-specs -- slot-specs' )
|
||||
[ type>> { use literal } member-eq? ] filter ;
|
||||
|
||||
: expr-class ( insn -- expr )
|
||||
name>> "##" ?head drop "-expr" append create-class-in ;
|
||||
|
||||
: define-expr-class ( expr slot-specs -- )
|
||||
[ expr ] dip [ name>> ] map define-tuple-class ;
|
||||
|
||||
: >expr-quot ( expr slot-specs -- quot )
|
||||
[
|
||||
[ name>> reader-word 1quotation ]
|
||||
[
|
||||
type>> {
|
||||
{ use [ [ vreg>vn ] ] }
|
||||
{ literal [ [ ] ] }
|
||||
} case
|
||||
] bi append
|
||||
] map cleave>quot swap suffix \ boa suffix ;
|
||||
|
||||
: define->expr-method ( insn expr slot-specs -- )
|
||||
[ \ >expr create-method-in ] 2dip >expr-quot define ;
|
||||
|
||||
: handle-pure-insn ( insn -- )
|
||||
[ ] [ expr-class ] [ "insn-slots" word-prop input-values ] tri
|
||||
[ define-expr-class drop ] [ define->expr-method ] 3bi ;
|
||||
|
||||
insn-classes get [ pure-insn class<= ] filter [ handle-pure-insn ] each
|
||||
|
||||
>>
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ compiler.cfg.value-numbering.graph ;
|
|||
IN: compiler.cfg.value-numbering.folding
|
||||
|
||||
: binary-constant-fold? ( insn -- ? )
|
||||
src1>> vreg>expr integer-expr? ; inline
|
||||
src1>> vreg>insn ##load-integer? ; inline
|
||||
|
||||
GENERIC: binary-constant-fold* ( x y insn -- z )
|
||||
|
||||
|
|
@ -27,7 +27,7 @@ M: ##shl-imm binary-constant-fold* drop shift ;
|
|||
\ ##load-integer new-insn ; inline
|
||||
|
||||
: unary-constant-fold? ( insn -- ? )
|
||||
src>> vreg>expr integer-expr? ; inline
|
||||
src>> vreg>insn ##load-integer? ; inline
|
||||
|
||||
GENERIC: unary-constant-fold* ( x insn -- y )
|
||||
|
||||
|
|
|
|||
|
|
@ -6,38 +6,33 @@ IN: compiler.cfg.value-numbering.graph
|
|||
! Value numbers are negative, to catch confusion with vregs
|
||||
SYMBOL: vn-counter
|
||||
|
||||
: next-vn ( -- vn ) vn-counter [ 1 - dup ] change ;
|
||||
|
||||
! biassoc mapping expressions to value numbers
|
||||
SYMBOL: exprs>vns
|
||||
|
||||
TUPLE: expr ;
|
||||
|
||||
: expr>vn ( expr -- vn ) exprs>vns get [ drop next-vn ] cache ;
|
||||
|
||||
: vn>expr ( vn -- expr ) exprs>vns get value-at ;
|
||||
|
||||
! Expressions whose values are inputs to the basic block.
|
||||
TUPLE: input-expr < expr n ;
|
||||
|
||||
SYMBOL: input-expr-counter
|
||||
|
||||
: next-input-expr ( -- expr )
|
||||
input-expr-counter counter input-expr boa ;
|
||||
: next-vn ( -- vn ) vn-counter [ 1 - dup ] change ;
|
||||
|
||||
! assoc mapping expressions to value numbers
|
||||
SYMBOL: exprs>vns
|
||||
|
||||
! assoc mapping value numbers to instructions
|
||||
SYMBOL: vns>insns
|
||||
|
||||
: vn>insn ( vn -- insn ) vns>insns get at ;
|
||||
|
||||
! biassocs mapping vregs to value numbers, and value numbers to
|
||||
! their primary vregs
|
||||
SYMBOL: vregs>vns
|
||||
|
||||
: vreg>vn ( vreg -- vn )
|
||||
vregs>vns get [ drop next-input-expr expr>vn ] cache ;
|
||||
: vreg>vn ( vreg -- vn ) vregs>vns get [ drop next-vn ] cache ;
|
||||
|
||||
: vn>vreg ( vn -- vreg ) vregs>vns get value-at ;
|
||||
|
||||
: set-vn ( vn vreg -- ) vregs>vns get set-at ;
|
||||
|
||||
: vreg>expr ( vreg -- expr ) vreg>vn vn>expr ; inline
|
||||
: vreg>insn ( vreg -- insn ) vreg>vn vn>insn ; inline
|
||||
|
||||
: init-value-graph ( -- )
|
||||
0 vn-counter set
|
||||
0 input-expr-counter set
|
||||
<bihash> exprs>vns set
|
||||
<bihash> vregs>vns set ;
|
||||
<bihash> vregs>vns set
|
||||
H{ } clone exprs>vns set
|
||||
H{ } clone vns>insns set ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators cpu.architecture fry kernel layouts
|
||||
locals make math sequences compiler.cfg.instructions
|
||||
USING: accessors combinators combinators.short-circuit
|
||||
cpu.architecture fry kernel layouts locals make math sequences
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.registers
|
||||
compiler.cfg.utilities
|
||||
compiler.cfg.value-numbering.expressions
|
||||
|
|
@ -10,31 +11,35 @@ compiler.cfg.value-numbering.graph
|
|||
compiler.cfg.value-numbering.rewrite ;
|
||||
IN: compiler.cfg.value-numbering.math
|
||||
|
||||
: f-expr? ( expr -- ? ) T{ reference-expr f f } = ; inline
|
||||
: f-insn? ( insn -- ? )
|
||||
{ [ ##load-reference? ] [ obj>> not ] } 1&& ; inline
|
||||
|
||||
: zero-insn? ( insn -- ? )
|
||||
{ [ ##load-integer? ] [ val>> 0 = ] } 1&& ; inline
|
||||
|
||||
M: ##tagged>integer rewrite
|
||||
[ dst>> ] [ src>> vreg>expr ] bi {
|
||||
{ [ dup integer-expr? ] [ value>> tag-fixnum \ ##load-integer new-insn ] }
|
||||
{ [ dup f-expr? ] [ drop \ f type-number \ ##load-integer new-insn ] }
|
||||
[ dst>> ] [ src>> vreg>insn ] bi {
|
||||
{ [ dup ##load-integer? ] [ val>> tag-fixnum \ ##load-integer new-insn ] }
|
||||
{ [ dup f-insn? ] [ drop \ f type-number \ ##load-integer new-insn ] }
|
||||
[ 2drop f ]
|
||||
} cond ;
|
||||
|
||||
: self-inverse ( insn -- insn' )
|
||||
[ dst>> ] [ src>> vreg>expr src>> vn>vreg ] bi <copy> ;
|
||||
[ dst>> ] [ src>> vreg>insn src>> ] bi <copy> ;
|
||||
|
||||
: identity ( insn -- insn' )
|
||||
[ dst>> ] [ src1>> ] bi <copy> ;
|
||||
|
||||
M: ##neg rewrite
|
||||
{
|
||||
{ [ dup src>> vreg>expr neg-expr? ] [ self-inverse ] }
|
||||
{ [ dup src>> vreg>insn ##neg? ] [ self-inverse ] }
|
||||
{ [ dup unary-constant-fold? ] [ unary-constant-fold ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
M: ##not rewrite
|
||||
{
|
||||
{ [ dup src>> vreg>expr not-expr? ] [ self-inverse ] }
|
||||
{ [ dup src>> vreg>insn ##not? ] [ self-inverse ] }
|
||||
{ [ dup unary-constant-fold? ] [ unary-constant-fold ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
|
@ -49,7 +54,7 @@ M: ##not rewrite
|
|||
: (reassociate) ( insn -- dst src1 src2' src2'' )
|
||||
{
|
||||
[ dst>> ]
|
||||
[ src1>> vreg>expr [ src1>> vn>vreg ] [ src2>> ] bi ]
|
||||
[ src1>> vreg>insn [ src1>> ] [ src2>> ] bi ]
|
||||
[ src2>> ]
|
||||
} cleave ; inline
|
||||
|
||||
|
|
@ -72,7 +77,7 @@ M: ##add-imm rewrite
|
|||
{
|
||||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>expr add-imm-expr? ] [ \ ##add-imm reassociate-arithmetic ] }
|
||||
{ [ dup src1>> vreg>insn ##add-imm? ] [ \ ##add-imm reassociate-arithmetic ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -105,23 +110,23 @@ M: ##sub-imm rewrite sub-imm>add-imm ;
|
|||
! ##+-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 )
|
||||
:: (distribute) ( outer inner imm temp add-op mul-op -- new-outers/f )
|
||||
imm immediate-arithmetic? [
|
||||
[
|
||||
temp expr src1>> vn>vreg insn src2>> mul-op execute
|
||||
insn dst>> temp imm add-op execute
|
||||
temp inner src1>> outer src2>> mul-op execute
|
||||
outer dst>> temp imm add-op execute
|
||||
] { } make
|
||||
] [ f ] if ; inline
|
||||
|
||||
: distribute-over-add? ( insn -- ? )
|
||||
src1>> vreg>expr add-imm-expr? ;
|
||||
src1>> vreg>insn ##add-imm? ;
|
||||
|
||||
: distribute-over-sub? ( insn -- ? )
|
||||
src1>> vreg>expr sub-imm-expr? ;
|
||||
src1>> vreg>insn ##sub-imm? ;
|
||||
|
||||
: distribute ( insn add-op mul-op -- new-insns/f )
|
||||
[
|
||||
dup src1>> vreg>expr
|
||||
dup src1>> vreg>insn
|
||||
2dup src2>> swap [ src2>> ] keep binary-constant-fold*
|
||||
next-vreg
|
||||
] 2dip (distribute) ; inline
|
||||
|
|
@ -131,7 +136,7 @@ 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 ] }
|
||||
{ [ dup src1>> vreg>insn ##mul-imm? ] [ \ ##mul-imm reassociate-arithmetic ] }
|
||||
{ [ dup distribute-over-add? ] [ \ ##add-imm \ ##mul-imm distribute ] }
|
||||
{ [ dup distribute-over-sub? ] [ \ ##sub-imm \ ##mul-imm distribute ] }
|
||||
[ drop f ]
|
||||
|
|
@ -140,7 +145,7 @@ M: ##mul-imm rewrite
|
|||
M: ##and-imm rewrite
|
||||
{
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>expr and-imm-expr? ] [ \ ##and-imm reassociate-bitwise ] }
|
||||
{ [ dup src1>> vreg>insn ##and-imm? ] [ \ ##and-imm reassociate-bitwise ] }
|
||||
{ [ dup src2>> 0 = ] [ dst>> 0 \ ##load-integer new-insn ] }
|
||||
{ [ dup src2>> -1 = ] [ identity ] }
|
||||
[ drop f ]
|
||||
|
|
@ -151,7 +156,7 @@ M: ##or-imm rewrite
|
|||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup src2>> -1 = ] [ dst>> -1 \ ##load-integer new-insn ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>expr or-imm-expr? ] [ \ ##or-imm reassociate-bitwise ] }
|
||||
{ [ dup src1>> vreg>insn ##or-imm? ] [ \ ##or-imm reassociate-bitwise ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -160,7 +165,7 @@ M: ##xor-imm rewrite
|
|||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup src2>> -1 = ] [ [ dst>> ] [ src1>> ] bi \ ##not new-insn ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>expr xor-imm-expr? ] [ \ ##xor-imm reassociate-bitwise ] }
|
||||
{ [ dup src1>> vreg>insn ##xor-imm? ] [ \ ##xor-imm reassociate-bitwise ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -168,7 +173,7 @@ M: ##shl-imm rewrite
|
|||
{
|
||||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>expr shl-imm-expr? ] [ \ ##shl-imm reassociate-shift ] }
|
||||
{ [ dup src1>> vreg>insn ##shl-imm? ] [ \ ##shl-imm reassociate-shift ] }
|
||||
{ [ dup distribute-over-add? ] [ \ ##add-imm \ ##shl-imm distribute ] }
|
||||
{ [ dup distribute-over-sub? ] [ \ ##sub-imm \ ##shl-imm distribute ] }
|
||||
[ drop f ]
|
||||
|
|
@ -178,7 +183,7 @@ M: ##shr-imm rewrite
|
|||
{
|
||||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>expr shr-imm-expr? ] [ \ ##shr-imm reassociate-shift ] }
|
||||
{ [ dup src1>> vreg>insn ##shr-imm? ] [ \ ##shr-imm reassociate-shift ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -186,7 +191,7 @@ M: ##sar-imm rewrite
|
|||
{
|
||||
{ [ dup src2>> 0 = ] [ identity ] }
|
||||
{ [ dup binary-constant-fold? ] [ binary-constant-fold ] }
|
||||
{ [ dup src1>> vreg>expr sar-imm-expr? ] [ \ ##sar-imm reassociate-shift ] }
|
||||
{ [ dup src1>> vreg>insn ##sar-imm? ] [ \ ##sar-imm reassociate-shift ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -220,7 +225,7 @@ M: ##add rewrite
|
|||
! =>
|
||||
! ##neg 3 2
|
||||
: sub-to-neg? ( ##sub -- ? )
|
||||
src1>> vreg>expr zero-expr? ;
|
||||
src1>> vreg>insn zero-insn? ;
|
||||
|
||||
: sub-to-neg ( ##sub -- insn )
|
||||
[ dst>> ] [ src2>> ] bi \ ##neg new-insn ;
|
||||
|
|
|
|||
|
|
@ -10,9 +10,9 @@ compiler.cfg.registers
|
|||
compiler.cfg.utilities
|
||||
compiler.cfg.comparisons
|
||||
compiler.cfg.instructions
|
||||
compiler.cfg.value-numbering.alien
|
||||
compiler.cfg.value-numbering.expressions
|
||||
compiler.cfg.value-numbering.math
|
||||
compiler.cfg.value-numbering.graph
|
||||
compiler.cfg.value-numbering.expressions
|
||||
compiler.cfg.value-numbering.rewrite ;
|
||||
IN: compiler.cfg.value-numbering.simd
|
||||
|
||||
|
|
@ -22,9 +22,9 @@ IN: compiler.cfg.value-numbering.simd
|
|||
: useless-shuffle-vector-imm? ( insn -- ? )
|
||||
[ shuffle>> ] [ rep>> rep-length iota ] bi sequence= ;
|
||||
|
||||
: compose-shuffle-vector-imm ( insn expr -- insn' )
|
||||
: compose-shuffle-vector-imm ( outer inner -- insn' )
|
||||
2dup [ rep>> ] bi@ eq? [
|
||||
[ [ dst>> ] [ src>> vn>vreg ] bi* ]
|
||||
[ [ dst>> ] [ src>> ] bi* ]
|
||||
[ [ shuffle>> ] bi@ nths ]
|
||||
[ drop rep>> ]
|
||||
2tri \ ##shuffle-vector-imm new-insn
|
||||
|
|
@ -33,15 +33,15 @@ IN: compiler.cfg.value-numbering.simd
|
|||
: (fold-shuffle-vector-imm) ( shuffle bytes -- bytes' )
|
||||
2dup length swap length /i group nths concat ;
|
||||
|
||||
: fold-shuffle-vector-imm ( insn expr -- insn' )
|
||||
[ [ dst>> ] [ shuffle>> ] bi ] dip value>>
|
||||
: fold-shuffle-vector-imm ( outer inner -- insn' )
|
||||
[ [ dst>> ] [ shuffle>> ] bi ] [ obj>> ] bi*
|
||||
(fold-shuffle-vector-imm) \ ##load-reference new-insn ;
|
||||
|
||||
M: ##shuffle-vector-imm rewrite
|
||||
dup src>> vreg>expr {
|
||||
dup src>> vreg>insn {
|
||||
{ [ over useless-shuffle-vector-imm? ] [ drop [ dst>> ] [ src>> ] bi <copy> ] }
|
||||
{ [ dup shuffle-vector-imm-expr? ] [ compose-shuffle-vector-imm ] }
|
||||
{ [ dup reference-expr? ] [ fold-shuffle-vector-imm ] }
|
||||
{ [ dup ##shuffle-vector-imm? ] [ compose-shuffle-vector-imm ] }
|
||||
{ [ dup ##load-reference? ] [ fold-shuffle-vector-imm ] }
|
||||
[ 2drop f ]
|
||||
} cond ;
|
||||
|
||||
|
|
@ -49,52 +49,55 @@ M: ##shuffle-vector-imm rewrite
|
|||
[ [ dst>> ] [ rep>> rep-length ] bi ] dip <repetition> concat
|
||||
\ ##load-reference new-insn ;
|
||||
|
||||
: fold-scalar>vector ( insn expr -- insn' )
|
||||
value>> over rep>> {
|
||||
: fold-scalar>vector ( outer inner -- insn' )
|
||||
obj>> over rep>> {
|
||||
{ float-4-rep [ float>bits 4 >le (fold-scalar>vector) ] }
|
||||
{ double-2-rep [ double>bits 8 >le (fold-scalar>vector) ] }
|
||||
[ [ untag-fixnum ] dip rep-component-type heap-size >le (fold-scalar>vector) ]
|
||||
} case ;
|
||||
|
||||
M: ##scalar>vector rewrite
|
||||
dup src>> vreg>expr {
|
||||
{ [ dup reference-expr? ] [ fold-scalar>vector ] }
|
||||
{ [ dup vector>scalar-expr? ] [ [ dst>> ] [ src>> vn>vreg ] bi* <copy> ] }
|
||||
dup src>> vreg>insn {
|
||||
{ [ dup ##load-reference? ] [ fold-scalar>vector ] }
|
||||
{ [ dup ##vector>scalar? ] [ [ dst>> ] [ src>> ] bi* <copy> ] }
|
||||
[ 2drop f ]
|
||||
} cond ;
|
||||
|
||||
M: ##xor-vector rewrite
|
||||
dup [ src1>> vreg>vn ] [ src2>> vreg>vn ] bi eq?
|
||||
dup diagonal?
|
||||
[ [ dst>> ] [ rep>> ] bi \ ##zero-vector new-insn ] [ drop f ] if ;
|
||||
|
||||
: vector-not? ( expr -- ? )
|
||||
: vector-not? ( insn -- ? )
|
||||
{
|
||||
[ not-vector-expr? ]
|
||||
[ ##not-vector? ]
|
||||
[ {
|
||||
[ xor-vector-expr? ]
|
||||
[ [ src1>> ] [ src2>> ] bi [ vn>expr fill-vector-expr? ] either? ]
|
||||
[ ##xor-vector? ]
|
||||
[ [ src1>> ] [ src2>> ] bi [ vreg>insn ##fill-vector? ] either? ]
|
||||
} 1&& ]
|
||||
} 1|| ;
|
||||
|
||||
GENERIC: vector-not-src ( expr -- vreg )
|
||||
M: not-vector-expr vector-not-src src>> vn>vreg ;
|
||||
M: xor-vector-expr vector-not-src
|
||||
dup src1>> vn>expr fill-vector-expr? [ src2>> ] [ src1>> ] if vn>vreg ;
|
||||
GENERIC: vector-not-src ( insn -- vreg )
|
||||
|
||||
M: ##not-vector vector-not-src
|
||||
src>> ;
|
||||
|
||||
M: ##xor-vector vector-not-src
|
||||
dup src1>> vreg>insn ##fill-vector? [ src2>> ] [ src1>> ] if ;
|
||||
|
||||
M: ##and-vector rewrite
|
||||
{
|
||||
{ [ dup src1>> vreg>expr vector-not? ] [
|
||||
{ [ dup src1>> vreg>insn vector-not? ] [
|
||||
{
|
||||
[ dst>> ]
|
||||
[ src1>> vreg>expr vector-not-src ]
|
||||
[ src1>> vreg>insn vector-not-src ]
|
||||
[ src2>> ]
|
||||
[ rep>> ]
|
||||
} cleave \ ##andn-vector new-insn
|
||||
] }
|
||||
{ [ dup src2>> vreg>expr vector-not? ] [
|
||||
{ [ dup src2>> vreg>insn vector-not? ] [
|
||||
{
|
||||
[ dst>> ]
|
||||
[ src2>> vreg>expr vector-not-src ]
|
||||
[ src2>> vreg>insn vector-not-src ]
|
||||
[ src1>> ]
|
||||
[ rep>> ]
|
||||
} cleave \ ##andn-vector new-insn
|
||||
|
|
@ -103,10 +106,10 @@ M: ##and-vector rewrite
|
|||
} cond ;
|
||||
|
||||
M: ##andn-vector rewrite
|
||||
dup src1>> vreg>expr vector-not? [
|
||||
dup src1>> vreg>insn vector-not? [
|
||||
{
|
||||
[ dst>> ]
|
||||
[ src1>> vreg>expr vector-not-src ]
|
||||
[ src1>> vreg>insn vector-not-src ]
|
||||
[ src2>> ]
|
||||
[ rep>> ]
|
||||
} cleave \ ##and-vector new-insn
|
||||
|
|
|
|||
|
|
@ -10,12 +10,12 @@ IN: compiler.cfg.value-numbering.slots
|
|||
|
||||
: simplify-slot-addressing? ( insn -- ? )
|
||||
complex-addressing?
|
||||
[ slot>> vreg>expr add-imm-expr? ] [ drop f ] if ;
|
||||
[ slot>> vreg>insn ##add-imm? ] [ drop f ] if ;
|
||||
|
||||
: simplify-slot-addressing ( insn -- insn/f )
|
||||
dup simplify-slot-addressing? [
|
||||
dup slot>> vreg>expr
|
||||
[ src1>> vn>vreg >>slot ]
|
||||
dup slot>> vreg>insn
|
||||
[ src1>> >>slot ]
|
||||
[ src2>> over scale>> '[ _ _ shift - ] change-tag ]
|
||||
bi
|
||||
] [ drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces assocs kernel accessors
|
||||
sorting sets sequences arrays
|
||||
USING: namespaces arrays assocs kernel accessors
|
||||
sorting sets sequences locals
|
||||
cpu.architecture
|
||||
sequences.deep
|
||||
compiler.cfg
|
||||
|
|
@ -18,22 +18,26 @@ compiler.cfg.value-numbering.rewrite
|
|||
compiler.cfg.value-numbering.slots ;
|
||||
IN: compiler.cfg.value-numbering
|
||||
|
||||
: >copy ( insn vn dst -- insn/##copy )
|
||||
swap vn>vreg 2dup eq? [ 2drop ] [ <copy> nip ] if ;
|
||||
|
||||
GENERIC: process-instruction ( insn -- insn' )
|
||||
|
||||
: redundant-instruction ( insn vn -- insn' )
|
||||
[ dst>> ] dip [ swap set-vn ] [ vn>vreg <copy> ] 2bi ;
|
||||
|
||||
:: useful-instruction ( insn expr -- insn' )
|
||||
next-vn :> vn
|
||||
vn insn dst>> vregs>vns get set-at
|
||||
vn expr exprs>vns get set-at
|
||||
insn vn vns>insns get set-at
|
||||
insn ;
|
||||
|
||||
: check-redundancy ( insn -- insn' )
|
||||
dup >expr dup exprs>vns get at
|
||||
[ redundant-instruction ] [ useful-instruction ] ?if ;
|
||||
|
||||
M: insn process-instruction
|
||||
dup rewrite
|
||||
[ process-instruction ]
|
||||
[
|
||||
dup defs-vreg [
|
||||
dup [ >expr expr>vn ] [ dst>> ] bi
|
||||
[ set-vn drop ]
|
||||
[ >copy ]
|
||||
3bi
|
||||
] when
|
||||
] ?if ;
|
||||
[ dup defs-vreg [ check-redundancy ] when ] ?if ;
|
||||
|
||||
M: ##copy process-instruction
|
||||
dup [ src>> vreg>vn ] [ dst>> ] bi set-vn ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue