compiler.cfg: if a block has an instruction that kills values it must be the only...

diff --git a/basis/compiler/cfg/block-joining/block-joining.factor b/basis/compiler/cfg/block-joining/block-joining.factor
index 982f0866e603b0f4fdeda4b50844c7f5c5927840..b4c72234355ecbb24c883a005abb45a13780945a 100644 (file)
--- a/basis/compiler/cfg/block-joining/block-joining.factor
+++ b/basis/compiler/cfg/block-joining/block-joining.factor
@@ -8,20 +8,14 @@ IN: compiler.cfg.block-joining
 ! Joining blocks that are not calls and are connected by a single CFG edge.
 ! Predecessors must be recomputed after this. Also this pass does not
 ! update ##phi nodes and should therefore only run before stack analysis.
-
-: kill-vreg-block? ( bb -- ? )
-    instructions>> {
-        [ length 2 >= ]
-        [ penultimate kill-vreg-insn? ]
-    } 1&& ;
-
 : predecessor ( bb -- pred )
     predecessors>> first ; inline
 
 : join-block? ( bb -- ? )
     {
+        [ kill-block? not ]
         [ predecessors>> length 1 = ]
-        [ predecessor kill-vreg-block? not ]
+        [ predecessor kill-block? not ]
         [ predecessor successors>> length 1 = ]
         [ [ predecessor ] keep back-edge? not ]
     } 1&& ;

diff --git a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
index 71798da6fc6aa480f0d589420e21a2d71812d26c..76b10dda01611324466292afd6092b1fceb76bc2 100644 (file)
--- a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
+++ b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
@@ -13,10 +13,16 @@ SYMBOL: spill-counts
 GENERIC: compute-stack-frame* ( insn -- )
 
 : request-stack-frame ( stack-frame -- )
+    frame-required? on
     stack-frame [ max-stack-frame ] change ;
 
-M: ##stack-frame compute-stack-frame*
-    frame-required? on
+M: ##alien-invoke compute-stack-frame*
+    stack-frame>> request-stack-frame ;
+
+M: ##alien-indirect compute-stack-frame*
+    stack-frame>> request-stack-frame ;
+
+M: ##alien-callback compute-stack-frame*
     stack-frame>> request-stack-frame ;
 
 M: ##call compute-stack-frame*
@@ -45,8 +51,6 @@ M: insn compute-stack-frame*
 
 GENERIC: insert-pro/epilogues* ( insn -- )
 
-M: ##stack-frame insert-pro/epilogues* drop ;
-
 M: ##prologue insert-pro/epilogues*
     drop frame-required? get [ stack-frame get _prologue ] when ;
 

diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index 4a481a09d81385ab390a39d6823b4ddc91b3e5f3..90e42912a1276c5bf052629d0ec45b47416b436b 100644 (file)
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/basis/compiler/cfg/builder/builder-tests.factor
@@ -1,12 +1,13 @@
 IN: compiler.cfg.builder.tests
-USING: tools.test kernel sequences
-words sequences.private fry prettyprint alien alien.accessors
-math.private compiler.tree.builder compiler.tree.optimizer
-compiler.cfg.builder compiler.cfg.debugger arrays locals byte-arrays
-kernel.private math ;
+USING: tools.test kernel sequences words sequences.private fry
+prettyprint alien alien.accessors math.private compiler.tree.builder
+compiler.tree.optimizer compiler.cfg.builder compiler.cfg.debugger
+compiler.cfg.predecessors compiler.cfg.checker arrays locals
+byte-arrays kernel.private math slots.private ;
 
 ! Just ensure that various CFGs build correctly.
-: unit-test-cfg ( quot -- ) '[ _ test-cfg drop ] [ ] swap unit-test ;
+: unit-test-cfg ( quot -- )
+    '[ _ test-cfg [ compute-predecessors check-cfg ] each ] [ ] swap unit-test ;
 
 {
     [ ]
@@ -49,6 +50,8 @@ kernel.private math ;
     [ "int" f "malloc" { "int" } alien-invoke ]
     [ "int" { "int" } "cdecl" alien-indirect ]
     [ "int" { "int" } "cdecl" [ ] alien-callback ]
+    [ swap - + * ]
+    [ swap slot ]
 } [
     unit-test-cfg
 ] each

diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index 30c15b787fc255c6f40ecb88813f621a396c8a83..e3c502e66e1315e54d13eed89a3cf070affe7331 100755 (executable)
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/basis/compiler/cfg/builder/builder.factor
@@ -63,10 +63,15 @@ GENERIC: emit-node ( node -- )
     basic-block get successors>> push
     basic-block off ;
 
+: emit-trivial-block ( quot -- )
+    basic-block get instructions>> empty? [ ##branch begin-basic-block ] unless
+    call
+    ##branch begin-basic-block ; inline
+
 : emit-call ( word height -- )
     over loops get key?
     [ drop loops get at emit-loop-call ]
-    [ ##call ##branch begin-basic-block ]
+    [ [ ##call ] emit-trivial-block ]
     if ;
 
 ! #recursive
@@ -157,7 +162,7 @@ M: #shuffle emit-node
 
 ! #return
 M: #return emit-node
-    drop ##epilogue ##return ;
+    drop ##branch begin-basic-block ##epilogue ##return ;
 
 M: #return-recursive emit-node
     label>> id>> loops get key?
@@ -181,12 +186,10 @@ M: #terminate emit-node drop ##no-tco basic-block off ;
         [ return>> return-size >>return ]
         [ alien-parameters parameter-sizes drop >>params ] bi ;
 
-: alien-stack-frame ( params -- )
-    <alien-stack-frame> ##stack-frame ;
-
 : emit-alien-node ( node quot -- )
-    [ params>> ] dip [ drop alien-stack-frame ] [ call ] 2bi
-    ##branch begin-basic-block ; inline
+    [
+        [ params>> dup <alien-stack-frame> ] dip call
+    ] emit-trivial-block ; inline
 
 M: #alien-invoke emit-node
     [ ##alien-invoke ] emit-alien-node ;

diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor
index 49ea775600f90997090907533ccbbb0367e777b8..f9f5211c9c865e0b39a5c532fa93f75e5af1b221 100644 (file)
--- a/basis/compiler/cfg/checker/checker.factor
+++ b/basis/compiler/cfg/checker/checker.factor
@@ -1,34 +1,51 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel compiler.cfg.instructions compiler.cfg.rpo
-compiler.cfg.def-use compiler.cfg.linearization compiler.cfg.liveness
-combinators.short-circuit accessors math sequences sets assocs ;
+USING: kernel combinators.short-circuit accessors math sequences sets
+assocs compiler.cfg.instructions compiler.cfg.rpo compiler.cfg.def-use
+compiler.cfg.linearization compiler.cfg.liveness
+compiler.cfg.utilities ;
 IN: compiler.cfg.checker
 
-ERROR: last-insn-not-a-jump insn ;
+ERROR: bad-kill-block bb ;
+
+: check-kill-block ( bb -- )
+    dup instructions>> first2
+    swap ##epilogue? [ [ ##return? ] [ ##callback-return? ] bi or ] [ ##branch? ] if
+    [ drop ] [ bad-kill-block ] if ;
+
+ERROR: last-insn-not-a-jump bb ;
 
 : check-last-instruction ( bb -- )
-    last dup {
+    dup instructions>> last {
         [ ##branch? ]
         [ ##dispatch? ]
         [ ##conditional-branch? ]
         [ ##compare-imm-branch? ]
-        [ ##return? ]
-        [ ##callback-return? ]
-        [ ##jump? ]
         [ ##fixnum-add? ]
         [ ##fixnum-sub? ]
         [ ##fixnum-mul? ]
         [ ##no-tco? ]
     } 1|| [ drop ] [ last-insn-not-a-jump ] if ;
 
-ERROR: bad-loop-entry ;
+ERROR: bad-loop-entry bb ;
 
 : check-loop-entry ( bb -- )
-    dup length 2 >= [
+    dup instructions>> dup length 2 >= [
         2 head* [ ##loop-entry? ] any?
-        [ bad-loop-entry ] when
-    ] [ drop ] if ;
+        [ bad-loop-entry ] [ drop ] if
+    ] [ 2drop ] if ;
+
+ERROR: bad-kill-insn bb ;
+
+: check-kill-instructions ( bb -- )
+    dup instructions>> [ kill-vreg-insn? ] any?
+    [ bad-kill-insn ] [ drop ] if ;
+
+: check-normal-block ( bb -- )
+    [ check-loop-entry ]
+    [ check-last-instruction ]
+    [ check-kill-instructions ]
+    tri ;
 
 ERROR: bad-successors ;
 
@@ -37,10 +54,9 @@ ERROR: bad-successors ;
     [ bad-successors ] unless ;
 
 : check-basic-block ( bb -- )
-    [ instructions>> check-last-instruction ]
-    [ instructions>> check-loop-entry ]
+    [ dup kill-block? [ check-kill-block ] [ check-normal-block ] if ]
     [ check-successors ]
-    tri ;
+    bi ;
 
 ERROR: bad-live-in ;
 

diff --git a/basis/compiler/cfg/dcn/dcn-tests.factor b/basis/compiler/cfg/dcn/dcn-tests.factor
index 40cfaae8f833b390f39003bada900b634d1bd26c..29ed81082adb71adc28a7352272b5d9cf63d2f45 100644 (file)
--- a/basis/compiler/cfg/dcn/dcn-tests.factor
+++ b/basis/compiler/cfg/dcn/dcn-tests.factor
@@ -2,6 +2,7 @@ IN: compiler.cfg.dcn.tests
 USING: tools.test kernel accessors namespaces assocs
 cpu.architecture vectors sequences
 compiler.cfg
+compiler.cfg.utilities
 compiler.cfg.debugger
 compiler.cfg.registers
 compiler.cfg.predecessors

diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor
index c8a9d1861bed1ef9ffc242f922ccd57297f84729..2aa55df9118baf86c913946380774a29b1e5b957 100644 (file)
--- a/basis/compiler/cfg/def-use/def-use.factor
+++ b/basis/compiler/cfg/def-use/def-use.factor
@@ -9,6 +9,7 @@ GENERIC: uses-vregs ( insn -- seq )
 
 M: ##flushable defs-vregs dst>> 1array ;
 M: ##fixnum-overflow defs-vregs dst>> 1array ;
+M: _fixnum-overflow defs-vregs dst>> 1array ;
 M: insn defs-vregs drop f ;
 
 M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ;
@@ -47,18 +48,3 @@ M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
 M: _compare-imm-branch uses-vregs src1>> 1array ;
 M: _dispatch uses-vregs src>> 1array ;
 M: insn uses-vregs drop f ;
-
-! Instructions that use vregs
-UNION: vreg-insn
-##flushable
-##write-barrier
-##dispatch
-##effect
-##fixnum-overflow
-##conditional-branch
-##compare-imm-branch
-##phi
-##gc
-_conditional-branch
-_compare-imm-branch
-_dispatch ;

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index dc656d61fac69ecf7a32e8b75c4ae4ffc0218c42..43d92c9ccc1a61bdca1c661d227245aaac967c22 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -52,7 +52,6 @@ INSN: ##inc-d { n integer } ;
 INSN: ##inc-r { n integer } ;
 
 ! Subroutine calls
-INSN: ##stack-frame stack-frame ;
 INSN: ##call word { height integer } ;
 INSN: ##jump word ;
 INSN: ##return ;
@@ -160,9 +159,9 @@ INSN: ##write-barrier < ##effect card# table ;
 INSN: ##alien-global < ##flushable symbol library ;
 
 ! FFI
-INSN: ##alien-invoke params ;
-INSN: ##alien-indirect params ;
-INSN: ##alien-callback params ;
+INSN: ##alien-invoke params stack-frame ;
+INSN: ##alien-indirect params stack-frame ;
+INSN: ##alien-callback params stack-frame ;
 INSN: ##callback-return params ;
 
 ! Instructions used by CFG IR only.
@@ -230,16 +229,23 @@ INSN: _reload dst class n ;
 INSN: _copy dst src class ;
 INSN: _spill-counts counts ;
 
-! Instructions that poison the stack state
-UNION: poison-insn
-    ##jump
-    ##return
-    ##callback-return ;
+! Instructions that use vregs
+UNION: vreg-insn
+    ##flushable
+    ##write-barrier
+    ##dispatch
+    ##effect
+    ##fixnum-overflow
+    ##conditional-branch
+    ##compare-imm-branch
+    ##phi
+    ##gc
+    _conditional-branch
+    _compare-imm-branch
+    _dispatch ;
 
 ! Instructions that kill all live vregs
 UNION: kill-vreg-insn
-    poison-insn
-    ##stack-frame
     ##call
     ##prologue
     ##epilogue

diff --git a/basis/compiler/cfg/stack-analysis/stack-analysis.factor b/basis/compiler/cfg/stack-analysis/stack-analysis.factor
index cf15c0a312042fd037c4eddfa88ed34244e1bf2b..ec34c96a24d89e8ca3889073fe301aa70228a1b6 100644 (file)
--- a/basis/compiler/cfg/stack-analysis/stack-analysis.factor
+++ b/basis/compiler/cfg/stack-analysis/stack-analysis.factor
@@ -26,19 +26,14 @@ SYMBOL: global-optimization?
         [ 2drop ] [ state get untranslate-loc ##replace ] if
     ] each ;
 
-ERROR: poisoned-state state ;
-
 : sync-state ( -- )
     state get {
-        [ dup poisoned?>> [ poisoned-state ] [ drop ] if ]
         [ ds-height>> save-ds-height ]
         [ rs-height>> save-rs-height ]
         [ save-changed-locs ]
         [ clear-state ]
     } cleave ;
 
-: poison-state ( -- ) state get t >>poisoned? drop ;
-
 ! Abstract interpretation
 GENERIC: visit ( insn -- )
 
@@ -87,7 +82,11 @@ M: ##replace visit
 M: ##copy visit
     [ call-next-method ] [ record-copy ] bi ;
 
-M: poison-insn visit call-next-method poison-state ;
+M: ##jump visit sync-state , ;
+
+M: ##return visit sync-state , ;
+
+M: ##callback-return visit sync-state , ;
 
 M: kill-vreg-insn visit sync-state , ;
 

diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor
index 6edc883af4d0f1a09f33c55a754764cb6d72fef8..c3d3e47485aae940ebaee3a12162d91793fcf254 100644 (file)
--- a/basis/compiler/cfg/utilities/utilities.factor
+++ b/basis/compiler/cfg/utilities/utilities.factor
@@ -33,11 +33,16 @@ IN: compiler.cfg.utilities
     building off
     basic-block off ;
 
+: emit-trivial-block ( quot -- )
+    basic-block get instructions>> empty? [ ##branch begin-basic-block ] unless
+    call
+    ##branch begin-basic-block ; inline
+
 : call-height ( #call -- n )
     [ out-d>> length ] [ in-d>> length ] bi - ;
 
 : emit-primitive ( node -- )
-    [ word>> ] [ call-height ] bi ##call ##branch begin-basic-block ;
+    [ [ word>> ] [ call-height ] bi ##call ] emit-trivial-block ;
 
 : with-branch ( quot -- final-bb )
     [