compiler.cfg.stacks.*: vacant-peek checking readded

diff --git a/basis/compiler/cfg/stacks/clearing/clearing.factor b/basis/compiler/cfg/stacks/clearing/clearing.factor
index 93854902aebcdbb175551bd7dbd247905c955d6f..3e65588e638b491faf419c9b6f597de0233d3a4a 100644 (file)
--- a/basis/compiler/cfg/stacks/clearing/clearing.factor
+++ b/basis/compiler/cfg/stacks/clearing/clearing.factor
@@ -4,12 +4,12 @@ compiler.cfg.stacks.map kernel math sequences ;
 IN: compiler.cfg.stacks.clearing
 
 : state>replaces ( state -- replaces )
-    state>vacancies first2
+    [ stack>vacant ] map first2
     [ [ <ds-loc> ] map ] [ [ <rs-loc> ] map ] bi* append
     [ 17 swap f ##replace-imm boa ] map ;
 
 : dangerous-insn? ( state insn -- ? )
-    { [ nip ##peek? ] [ dangerous-peek? ] } 2&& ;
+    { [ nip ##peek? ] [ underflowable-peek? ] } 2&& ;
 
 : clearing-replaces ( assoc insn -- insns' )
     [ of ] keep 2dup dangerous-insn? [

diff --git a/basis/compiler/cfg/stacks/map/map.factor b/basis/compiler/cfg/stacks/map/map.factor
index 6aaccf78cc50c5e9eda4e89ada0fb52ef86eec28..0ad9a7e2ea4b2f40ebd80762607f87bf56b642db 100644 (file)
--- a/basis/compiler/cfg/stacks/map/map.factor
+++ b/basis/compiler/cfg/stacks/map/map.factor
@@ -1,4 +1,4 @@
-USING: accessors arrays assocs compiler.cfg.dataflow-analysis
+USING: accessors arrays assocs combinators compiler.cfg.dataflow-analysis
 compiler.cfg.instructions compiler.cfg.registers fry kernel math math.order
 namespaces sequences ;
 QUALIFIED: sets
@@ -14,6 +14,9 @@ IN: compiler.cfg.stacks.map
 : stack>vacant ( stack -- seq )
     first2 [ 0 max iota ] dip sets:diff ;
 
+: classify-read ( stack n -- val )
+    swap 2dup second member? [ 2drop 0 ] [ first >= [ 1 ] [ 2 ] if ] if ;
+
 CONSTANT: initial-state { { 0 { } } { 0 { } } }
 
 : insn>location ( insn -- n ds? )
@@ -23,11 +26,8 @@ CONSTANT: initial-state { { 0 { } } { 0 { } } }
     [ first2 ] dip insn>location
     [ rot register-write swap ] [ swap register-write ] if 2array ;
 
-: state>vacancies ( state -- vacants )
-    [ stack>vacant ] map ;
-
 : fill-vacancies ( state -- state' )
-    dup state>vacancies [ [ first2 ] dip append 2array ] 2map ;
+    [ [ first2 ] [ stack>vacant ] bi append 2array ] map ;
 
 GENERIC: visit-insn ( state insn -- state' )
 
@@ -45,11 +45,14 @@ M: ##call visit-insn ( state insn -- state' )
     ! to contain valid pointers anymore.
     drop [ first2 [ 0 >= ] filter 2array ] map ;
 
-: dangerous-peek? ( state peek -- ? )
-    loc>> [ ds-loc? 0 1 ? swap nth first ] keep n>> <= ;
+ERROR: vacant-peek insn ;
+
+: underflowable-peek? ( state peek -- ? )
+    2dup insn>location swap [ 0 1 ? swap nth ] dip classify-read
+    dup 2 = [ drop vacant-peek ] [ 2nip 1 = ] if ;
 
 M: ##peek visit-insn ( state insn -- state' )
-    2dup dangerous-peek? [ [ fill-vacancies ] dip ] when mark-location ;
+    2dup underflowable-peek? [ [ fill-vacancies ] dip ] when mark-location ;
 
 M: insn visit-insn ( state insn -- state' )
     drop ;