diff --git a/basis/compiler/cfg/value-numbering/alien/alien.factor b/basis/compiler/cfg/value-numbering/alien/alien.factor index cdb56aa9d1..8b508550b4 100644 --- a/basis/compiler/cfg/value-numbering/alien/alien.factor +++ b/basis/compiler/cfg/value-numbering/alien/alien.factor @@ -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 ] [ drop f ] if ; ! ##box-displaced-alien f 1 2 3 @@ -23,22 +24,22 @@ M: ##box-displaced-alien rewrite ! ##unbox-c-ptr 5 3 ! ##add 4 5 2 -: rewrite-unbox-alien ( insn expr -- insn ) - [ dst>> ] [ src>> vn>vreg ] bi* ; +: rewrite-unbox-alien ( insn box-insn -- insn ) + [ dst>> ] [ src>> ] bi* ; -: 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 ) diff --git a/basis/compiler/cfg/value-numbering/comparisons/comparisons.factor b/basis/compiler/cfg/value-numbering/comparisons/comparisons.factor index eb6d72f512..d9af124f30 100644 --- a/basis/compiler/cfg/value-numbering/comparisons/comparisons.factor +++ b/basis/compiler/cfg/value-numbering/comparisons/comparisons.factor @@ -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 ; diff --git a/basis/compiler/cfg/value-numbering/expressions/expressions.factor b/basis/compiler/cfg/value-numbering/expressions/expressions.factor index b7b7155285..ffd2efbd21 100644 --- a/basis/compiler/cfg/value-numbering/expressions/expressions.factor +++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor @@ -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 ] % ] + [ + 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 -: zero-expr? ( expr -- ? ) T{ integer-expr f 0 } = ; inline - -TUPLE: reference-expr < expr value ; +TUPLE: reference-expr value ; C: 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>> ; M: ##load-reference >expr obj>> ; -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 - ->> diff --git a/basis/compiler/cfg/value-numbering/folding/folding.factor b/basis/compiler/cfg/value-numbering/folding/folding.factor index 3cd9df8b4b..6e70e3f80f 100644 --- a/basis/compiler/cfg/value-numbering/folding/folding.factor +++ b/basis/compiler/cfg/value-numbering/folding/folding.factor @@ -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 ) diff --git a/basis/compiler/cfg/value-numbering/graph/graph.factor b/basis/compiler/cfg/value-numbering/graph/graph.factor index 0e9dcb6076..bef4956f5e 100644 --- a/basis/compiler/cfg/value-numbering/graph/graph.factor +++ b/basis/compiler/cfg/value-numbering/graph/graph.factor @@ -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 - exprs>vns set - vregs>vns set ; + vregs>vns set + H{ } clone exprs>vns set + H{ } clone vns>insns set ; diff --git a/basis/compiler/cfg/value-numbering/math/math.factor b/basis/compiler/cfg/value-numbering/math/math.factor index 219aa82795..557fce7d50 100644 --- a/basis/compiler/cfg/value-numbering/math/math.factor +++ b/basis/compiler/cfg/value-numbering/math/math.factor @@ -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 ; + [ dst>> ] [ src>> vreg>insn src>> ] bi ; : identity ( insn -- insn' ) [ dst>> ] [ src1>> ] bi ; 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 ; diff --git a/basis/compiler/cfg/value-numbering/simd/simd.factor b/basis/compiler/cfg/value-numbering/simd/simd.factor index 6d39a29c14..4aabfd3d9a 100644 --- a/basis/compiler/cfg/value-numbering/simd/simd.factor +++ b/basis/compiler/cfg/value-numbering/simd/simd.factor @@ -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 ] } - { [ 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 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* ] } + dup src>> vreg>insn { + { [ dup ##load-reference? ] [ fold-scalar>vector ] } + { [ dup ##vector>scalar? ] [ [ dst>> ] [ src>> ] bi* ] } [ 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 diff --git a/basis/compiler/cfg/value-numbering/slots/slots.factor b/basis/compiler/cfg/value-numbering/slots/slots.factor index 21dac9dcfb..8733e5f6e9 100644 --- a/basis/compiler/cfg/value-numbering/slots/slots.factor +++ b/basis/compiler/cfg/value-numbering/slots/slots.factor @@ -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 ; diff --git a/basis/compiler/cfg/value-numbering/value-numbering.factor b/basis/compiler/cfg/value-numbering/value-numbering.factor index dced1debb4..a6a20b2229 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering.factor @@ -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 ] [ nip ] if ; - GENERIC: process-instruction ( insn -- insn' ) +: redundant-instruction ( insn vn -- insn' ) + [ dst>> ] dip [ swap set-vn ] [ vn>vreg ] 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 ;