compiler.cfg.value-numbering: maintain a VN to instruction mapping. This eliminates...

diff --git a/basis/compiler/cfg/value-numbering/alien/alien.factor b/basis/compiler/cfg/value-numbering/alien/alien.factor
index cdb56aa9d1013505b019d474dbb9a037d1c66222..8b508550b4196eb524ddc35ee8ecbc460f23be56 100644 (file)
--- 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 <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 )

diff --git a/basis/compiler/cfg/value-numbering/comparisons/comparisons.factor b/basis/compiler/cfg/value-numbering/comparisons/comparisons.factor
index eb6d72f512fc97c63abca5285c1fb1c0b17505da..d9af124f30a619d85f8785d57dbbc8795a57abdd 100644 (file)
--- 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-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
+: >compare< ( insn -- in1 in2 cc )
+    [ src1>> ] [ 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|| ;
-
-: general-compare-expr? ( insn -- ? )
-    {
-        [ scalar-compare-expr? ]
-        [ test-vector-expr? ]
-    } 1|| ;
+UNION: scalar-compare-insn
+    ##compare
+    ##compare-imm
+    ##compare-integer
+    ##compare-integer-imm
+    ##compare-float-unordered
+    ##compare-float-ordered ;
+
+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 b7b7155285fd70bf16645c53fb947ed40872b093..ffd2efbd211151871ccd14a67d346aac4ce34685 100644 (file)
--- 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 ;
+<<
 
-C: <integer-expr> integer-expr
+GENERIC: >expr ( insn -- expr )
+
+: input-values ( slot-specs -- slot-specs' )
+    [ type>> { use literal } member-eq? ] filter ;
 
-: zero-expr? ( expr -- ? ) T{ integer-expr f 0 } = ; inline
+: 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: reference-expr < expr value ;
+>>
+
+TUPLE: integer-expr value ;
+
+C: <integer-expr> integer-expr
+
+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 )
-
-M: integer-expr expr>integer value>> ;
+GENERIC: insn>integer ( insn -- n )
 
-: vn>integer ( vn -- n ) vn>expr expr>integer ;
+M: ##load-integer insn>integer val>> ;
 
-: 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 )
-
-M: integer-expr expr>comparand value>> tag-fixnum ;
+GENERIC: insn>comparand ( expr -- n )
 
-M: reference-expr expr>comparand value>> ;
+M: ##load-integer insn>comparand val>> tag-fixnum ;
 
-: vn>comparand ( vn -- n ) vn>expr expr>comparand ;
+M: ##load-reference insn>comparand obj>> ;
 
-: 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 3cd9df8b4b5ca7bb6221603186f3633ae2ed0cab..6e70e3f80fa102c29e2b1a49614e623f763ef774 100644 (file)
--- 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 0e9dcb6076d822992c6233d31fb94e2579a047bf..bef4956f5e6f3e82752fe9fd8f0c122b1edd3a67 100644 (file)
--- 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
 
+SYMBOL: input-expr-counter
+
 : next-vn ( -- vn ) vn-counter [ 1 - dup ] change ;
 
-! biassoc mapping expressions to value numbers
+! assoc 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
+! assoc mapping value numbers to instructions
+SYMBOL: vns>insns
 
-: next-input-expr ( -- expr )
-    input-expr-counter counter input-expr boa ;
+: 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 ;

diff --git a/basis/compiler/cfg/value-numbering/math/math.factor b/basis/compiler/cfg/value-numbering/math/math.factor
index 219aa82795c37304da88a73c96fe072942f7005a..557fce7d5008153e40476532ce42b6c969d659b9 100644 (file)
--- 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 <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 ;

diff --git a/basis/compiler/cfg/value-numbering/simd/simd.factor b/basis/compiler/cfg/value-numbering/simd/simd.factor
index 6d39a29c14c28a5daebc1273ca7b3055550c5398..4aabfd3d9ac318c6f354c6c5bc910e73b465903f 100644 (file)
--- 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 <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

diff --git a/basis/compiler/cfg/value-numbering/slots/slots.factor b/basis/compiler/cfg/value-numbering/slots/slots.factor
index 21dac9dcfbebc91ea8bfe2bf041ba8bd3df5e721..8733e5f6e90a71fb5ebad531c38aa41fa0a4fa0f 100644 (file)
--- 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 dced1debb461409df57fb7fdd98b44cdf02aac29..a6a20b2229496388b0118a16b7d26f7d33e26bb4 100644 (file)
--- 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 ] [ <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 ;