From 670388b45a16b18e518d2830031677114ddd9829 Mon Sep 17 00:00:00 2001
From: Jeremy Hughes <jedahu@gmail.com>
Date: Fri, 3 Jul 2009 14:55:50 +1200
Subject: [PATCH 01/17] whitespace

---
 basis/alien/inline/tests/tests.factor | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/basis/alien/inline/tests/tests.factor b/basis/alien/inline/tests/tests.factor
index aea41ea8b8..cfa98cacfc 100644
--- a/basis/alien/inline/tests/tests.factor
+++ b/basis/alien/inline/tests/tests.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Jeremy Hughes.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test alien.inline alien.inline.private io.files io.directories kernel ;
+USING: tools.test alien.inline alien.inline.private io.files
+io.directories kernel ;
 IN: alien.inline.tests
 
 C-LIBRARY: const

From 408bbbdcf820863b16e22ad1c85bb750fde76f59 Mon Sep 17 00:00:00 2001
From: Jeremy Hughes <jedahu@gmail.com>
Date: Fri, 3 Jul 2009 15:32:00 +1200
Subject: [PATCH 02/17] alien.inline renamed words for runtime use

---
 basis/alien/inline/inline.factor      | 73 ++++++++++++++-------------
 basis/alien/inline/tests/tests.factor |  2 +-
 2 files changed, 40 insertions(+), 35 deletions(-)

diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor
index 5e235fe74e..8e58071427 100644
--- a/basis/alien/inline/inline.factor
+++ b/basis/alien/inline/inline.factor
@@ -12,28 +12,17 @@ SYMBOL: library-is-c++
 SYMBOL: compiler-args
 SYMBOL: c-strings
 
-: (C-LIBRARY:) ( -- )
-    scan c-library set
-    V{ } clone c-strings set
-    V{ } clone compiler-args set ;
-
-: (C-LINK:) ( -- )
-    "-l" scan append compiler-args get push ;
-
-: (C-FRAMEWORK:) ( -- )
-    "-framework" scan compiler-args get '[ _ push ] bi@ ;
-
 : return-library-function-params ( -- return library function params )
     scan c-library get scan ")" parse-tokens
     [ "(" subseq? not ] filter [
         [ dup CHAR: - = [ drop CHAR: space ] when ] map
     ] 3dip ;
 
-: factor-function ( return library functions params -- )
+: factor-function ( return library function params -- )
     [ dup "const " head? [ 6 tail ] when ] 3dip
     make-function define-declared ;
 
-: (C-FUNCTION:) ( return library function params -- str )
+: c-function-string ( return library function params -- str )
     [ nip ] dip
     " " join "(" prepend ")" append 3array " " join
     library-is-c++ get [ "extern \"C\" " prepend ] when ;
@@ -53,31 +42,47 @@ SYMBOL: c-strings
     compiler-args get
     c-strings get "\n" join
     c-library get compile-to-library ;
-
-: (;C-LIBRARY) ( -- )
-    compile-library? [ compile-library ] when
-    c-library get library-path "cdecl" add-library ;
 PRIVATE>
 
-SYNTAX: C-LIBRARY: (C-LIBRARY:) ;
+: define-c-library ( name -- )
+    c-library set
+    V{ } clone c-strings set
+    V{ } clone compiler-args set ;
 
-SYNTAX: COMPILE-AS-C++ t library-is-c++ set ;
+: compile-c-library ( -- )
+    compile-library? [ compile-library ] when
+    c-library get library-path "cdecl" add-library ;
 
-SYNTAX: C-LINK: (C-LINK:) ;
-
-SYNTAX: C-FRAMEWORK: (C-FRAMEWORK:) ;
-
-SYNTAX: C-LINK/FRAMEWORK:
-    os macosx? [ (C-FRAMEWORK:) ] [ (C-LINK:) ] if ;
-
-SYNTAX: C-INCLUDE:
-    "#include " scan append c-strings get push ;
-
-SYNTAX: C-FUNCTION:
-    return-library-function-params
-    [ factor-function ]
-    4 nkeep (C-FUNCTION:)
+: define-c-function ( return library function params -- )
+    [ factor-function ] 4 nkeep c-function-string
     " {\n" append parse-here append "\n}\n" append
     c-strings get push ;
 
-SYNTAX: ;C-LIBRARY (;C-LIBRARY) ;
+: define-c-link ( str -- )
+    "-l" prepend compiler-args get push ;
+
+: define-c-framework ( str -- )
+    "-framework" swap compiler-args get '[ _ push ] bi@ ;
+
+: define-c-link/framework ( str -- )
+    os macosx? [ define-c-framework ] [ define-c-link ] if ;
+
+: define-c-include ( str -- )
+    "#include " prepend c-strings get push ;
+
+SYNTAX: C-LIBRARY: scan define-c-library ;
+
+SYNTAX: COMPILE-AS-C++ t library-is-c++ set ;
+
+SYNTAX: C-LINK: scan define-c-link ;
+
+SYNTAX: C-FRAMEWORK: scan define-c-framework ;
+
+SYNTAX: C-LINK/FRAMEWORK: scan define-c-link/framework ;
+
+SYNTAX: C-INCLUDE: scan define-c-include ;
+
+SYNTAX: C-FUNCTION:
+    return-library-function-params define-c-function ;
+
+SYNTAX: ;C-LIBRARY compile-c-library ;
diff --git a/basis/alien/inline/tests/tests.factor b/basis/alien/inline/tests/tests.factor
index cfa98cacfc..acd2d615cd 100644
--- a/basis/alien/inline/tests/tests.factor
+++ b/basis/alien/inline/tests/tests.factor
@@ -43,6 +43,6 @@ C-FUNCTION: char* breakme ( )
     return not a string;
 ;
 
-<< [ (;C-LIBRARY) ] must-fail >>
+<< [ compile-c-library ] must-fail >>
 
 << library-path dup exists? [ delete-file ] [ drop ] if >>

From 2c3b2a0b714363c36a467295b2f257cfc391d301 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Fri, 3 Jul 2009 18:45:03 -0500
Subject: [PATCH 03/17] compiler.cfg.predecessors: delete dead predecessors
 from phi nodes

---
 .../branch-folding-tests.factor               | 47 +++++++++++++++++--
 basis/compiler/cfg/gc-checks/gc-checks.factor |  6 +--
 .../cfg/predecessors/predecessors.factor      | 26 +++++++---
 3 files changed, 65 insertions(+), 14 deletions(-)

diff --git a/basis/compiler/cfg/branch-folding/branch-folding-tests.factor b/basis/compiler/cfg/branch-folding/branch-folding-tests.factor
index 1068954f9d..964620d2d3 100644
--- a/basis/compiler/cfg/branch-folding/branch-folding-tests.factor
+++ b/basis/compiler/cfg/branch-folding/branch-folding-tests.factor
@@ -1,8 +1,8 @@
 IN: compiler.cfg.branch-folding.tests
 USING: compiler.cfg.branch-folding compiler.cfg.instructions
 compiler.cfg compiler.cfg.registers compiler.cfg.debugger
-arrays compiler.cfg.phi-elimination
-compiler.cfg.predecessors kernel accessors
+arrays compiler.cfg.phi-elimination compiler.cfg.dce
+compiler.cfg.predecessors kernel accessors assocs
 sequences classes namespaces tools.test cpu.architecture ;
 
 V{ T{ ##branch } } 0 test-bb
@@ -41,4 +41,45 @@ test-diamond
 [ t ] [ 1 get successors>> first 3 get eq? ] unit-test
 
 [ T{ ##copy f V int-regs 3 V int-regs 2 } ] [ 3 get instructions>> second ] unit-test
-[ 2 ] [ 4 get instructions>> length ] unit-test
\ No newline at end of file
+[ 2 ] [ 4 get instructions>> length ] unit-test
+
+V{
+    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##branch }
+} 0 test-bb
+
+V{
+    T{ ##peek f V int-regs 1 D 1 }
+    T{ ##compare-branch f V int-regs 1 V int-regs 1 cc< }
+} 1 test-bb
+
+V{
+    T{ ##copy f V int-regs 2 V int-regs 0 }
+    T{ ##branch }
+} 2 test-bb
+
+V{
+    T{ ##phi f V int-regs 3 V{ } }
+    T{ ##branch }
+} 3 test-bb
+
+V{
+    T{ ##replace f V int-regs 3 D 0 }
+    T{ ##return }
+} 4 test-bb
+
+1 get V int-regs 1 2array
+2 get V int-regs 0 2array 2array 3 get instructions>> first (>>inputs)
+
+test-diamond
+
+[ ] [
+    cfg new 0 get >>entry
+    compute-predecessors
+    fold-branches
+    compute-predecessors
+    eliminate-dead-code
+    drop
+] unit-test
+
+[ 1 ] [ 3 get instructions>> first inputs>> assoc-size ] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor
index 4176914126..090283410f 100644
--- a/basis/compiler/cfg/gc-checks/gc-checks.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks.factor
@@ -1,17 +1,13 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sequences assocs
-cpu.architecture compiler.cfg.rpo
-compiler.cfg.liveness compiler.cfg.instructions
+compiler.cfg.rpo compiler.cfg.instructions
 compiler.cfg.hats ;
 IN: compiler.cfg.gc-checks
 
 : gc? ( bb -- ? )
     instructions>> [ ##allocation? ] any? ;
 
-: object-pointer-regs ( basic-block -- vregs )
-    live-in keys [ reg-class>> int-regs eq? ] filter ;
-
 : insert-gc-check ( basic-block -- )
     dup gc? [
         [ i i f f \ ##gc new-insn prefix ] change-instructions drop
diff --git a/basis/compiler/cfg/predecessors/predecessors.factor b/basis/compiler/cfg/predecessors/predecessors.factor
index 54efc53bc4..73ae3ee242 100644
--- a/basis/compiler/cfg/predecessors/predecessors.factor
+++ b/basis/compiler/cfg/predecessors/predecessors.factor
@@ -1,13 +1,27 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences compiler.cfg.rpo ;
+USING: kernel accessors combinators fry sequences assocs compiler.cfg.rpo
+compiler.cfg.instructions ;
 IN: compiler.cfg.predecessors
 
-: predecessors-step ( bb -- )
+: update-predecessors ( bb -- )
     dup successors>> [ predecessors>> push ] with each ;
 
+: update-phi ( bb ##phi -- )
+    [
+        swap predecessors>>
+        '[ drop _ memq? ] assoc-filter
+    ] change-inputs drop ;
+
+: update-phis ( bb -- )
+    dup instructions>> [
+        dup ##phi? [ update-phi ] [ 2drop ] if
+    ] with each ;
+
 : compute-predecessors ( cfg -- cfg' )
-    [ [ V{ } clone >>predecessors drop ] each-basic-block ]
-    [ [ predecessors-step ] each-basic-block ]
-    [ ]
-    tri ;
+    {
+        [ [ V{ } clone >>predecessors drop ] each-basic-block ]
+        [ [ update-predecessors ] each-basic-block ]
+        [ [ update-phis ] each-basic-block ]
+        [ ]
+    } cleave ;

From cae8fed16cba346e94fcafe4c5486c556642b30d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 3 Jul 2009 19:19:33 -0500
Subject: [PATCH 04/17] convert ##compare with immediates to ##compare-imm

---
 .../value-numbering/rewrite/rewrite.factor    | 30 +++++++++++--------
 1 file changed, 17 insertions(+), 13 deletions(-)

diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
index bbfeb3f8bf..9fb6e66e9f 100755
--- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
+++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
@@ -70,21 +70,25 @@ M: ##compare-imm-branch rewrite
         dup rewrite-tagged-comparison? [ rewrite-tagged-comparison ] when
     ] when ;
 
-: flip-comparison? ( insn -- ? )
-    dup cc>> cc= eq? [ src1>> vreg>expr constant-expr? ] [ drop f ] if ;
-
-: flip-comparison ( insn -- insn' )
-    [ dst>> ]
-    [ src2>> ]
-    [ src1>> vreg>constant ] tri
-    cc= i \ ##compare-imm new-insn ;
+: >compare-imm ( insn swap? -- insn' )
+    [
+        {
+            [ dst>> ]
+            [ src1>> ]
+            [ src2>> ]
+            [ cc>> ]
+        } cleave
+    ] dip [ [ swap ] [ ] bi* ] when
+    [ vreg>constant ] dip
+    i \ ##compare-imm new-insn ; inline
 
 M: ##compare rewrite
-    dup flip-comparison? [
-        flip-comparison
-        dup number-values
-        rewrite
-    ] when ;
+    dup [ src1>> ] [ src2>> ] bi
+    [ vreg>expr constant-expr? ] bi@ 2array {
+        { { f t } [ f >compare-imm ] }
+        { { t f } [ t >compare-imm ] }
+        [ drop ]
+    } case ;
 
 : rewrite-redundant-comparison? ( insn -- ? )
     {

From 28a8e83642a2302e4ae6d1d7da39f20a768be124 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 3 Jul 2009 21:19:17 -0500
Subject: [PATCH 05/17] ui.tools.listener.history: Fix bug reported by Doug

---
 .../ui/tools/listener/history/history-tests.factor  | 13 +++++++++++++
 basis/ui/tools/listener/history/history.factor      |  8 +++++++-
 2 files changed, 20 insertions(+), 1 deletion(-)

diff --git a/basis/ui/tools/listener/history/history-tests.factor b/basis/ui/tools/listener/history/history-tests.factor
index 5a2e3cf1b5..068673889a 100644
--- a/basis/ui/tools/listener/history/history-tests.factor
+++ b/basis/ui/tools/listener/history/history-tests.factor
@@ -52,3 +52,16 @@ IN: ui.tools.listener.history.tests
 [ ] [ "h" get history-recall-previous ] unit-test
 
 [ "22" ] [ "d" get doc-string ] unit-test
+
+[ ] [ <document> "d" set ] unit-test
+[ ] [ "d" get <history> "h" set ] unit-test
+
+[ ] [ "aaa" "d" get set-doc-string ] unit-test
+[ T{ input f "aaa" } ] [ "h" get history-add ] unit-test
+
+[ ] [ "" "d" get set-doc-string ] unit-test
+[ T{ input f "" } ] [ "h" get history-add ] unit-test
+[ T{ input f "" } ] [ "h" get history-add ] unit-test
+[ ] [ "   " "d" get set-doc-string ] unit-test
+[ ] [ "h" get history-recall-previous ] unit-test
+
diff --git a/basis/ui/tools/listener/history/history.factor b/basis/ui/tools/listener/history/history.factor
index 333347dbac..5e03ab21ad 100644
--- a/basis/ui/tools/listener/history/history.factor
+++ b/basis/ui/tools/listener/history/history.factor
@@ -16,9 +16,15 @@ TUPLE: history document elements index ;
 
 <PRIVATE
 
+: (save-history) ( input index elements -- )
+    2dup length > [
+        [ [ T{ input f "" } ] dip push ] keep
+        (save-history)
+    ] [ set-nth ] if ;
+
 : save-history ( history -- )
     [ document>> doc-string ] keep
-    '[ <input> _ [ index>> ] [ elements>> ] bi set-nth ]
+    '[ <input> _ [ index>> ] [ elements>> ] bi (save-history) ]
     unless-empty ;
 
 : update-document ( history -- )

From 7718cce3394b28a6979123e94a106038008d4d06 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-122.local>
Date: Fri, 3 Jul 2009 21:22:46 -0500
Subject: [PATCH 06/17] More features in the unicode.breaks API, with
 documentation

---
 basis/unicode/breaks/breaks-docs.factor  | 27 +++++++++++++++++++++++-
 basis/unicode/breaks/breaks-tests.factor |  5 +++++
 basis/unicode/breaks/breaks.factor       |  9 ++++++++
 3 files changed, 40 insertions(+), 1 deletion(-)

diff --git a/basis/unicode/breaks/breaks-docs.factor b/basis/unicode/breaks/breaks-docs.factor
index 552883a299..9c57aab9f6 100644
--- a/basis/unicode/breaks/breaks-docs.factor
+++ b/basis/unicode/breaks/breaks-docs.factor
@@ -7,11 +7,16 @@ ARTICLE: "unicode.breaks" "Word and grapheme breaks"
 "The " { $vocab-link "unicode.breaks" "unicode.breaks" } " vocabulary partially implements Unicode Standard Annex #29. This provides for segmentation of a string along grapheme and word boundaries. In Unicode, a grapheme, or a basic unit of display in text, may be more than one code point. For example, in the string \"e\\u000301\" (where U+0301 is a combining acute accent), there is only one grapheme, as the acute accent goes above the e, forming a single grapheme. Word breaks, in general, are more complicated than simply splitting by whitespace, and the Unicode algorithm provides for that."
 $nl "Operations for graphemes:"
 { $subsection first-grapheme }
+{ $subsection first-grapheme-from }
 { $subsection last-grapheme }
+{ $subsection last-grapheme-from }
 { $subsection >graphemes }
 { $subsection string-reverse }
 "Operations on words:"
 { $subsection first-word }
+{ $subsection first-word-from }
+{ $subsection last-word }
+{ $subsection last-word-from }
 { $subsection >words } ;
 
 HELP: first-grapheme
@@ -22,6 +27,14 @@ HELP: last-grapheme
 { $values { "str" string } { "i" "an index" } }
 { $description "Finds the index of the start of the last grapheme of the string. This can be used to traverse the graphemes of a string backwards." } ;
 
+HELP: first-grapheme-from
+{ $values { "start" "an index" } { "str" string } { "i" "an index" } }
+{ $description "Finds the length of the first grapheme of the string, starting from the given index. This can be used repeatedly to efficiently traverse the graphemes of the string, using slices." } ;
+
+HELP: last-grapheme-from
+{ $values { "end" "an index" } { "str" string } { "i" "an index" } }
+{ $description "Finds the index of the start of the last grapheme of the string, starting from the given index. This can be used to traverse the graphemes of a string backwards." } ;
+
 HELP: >graphemes
 { $values { "str" string } { "graphemes" "an array of strings" } }
 { $description "Divides a string into a sequence of individual graphemes." } ;
@@ -32,7 +45,19 @@ HELP: string-reverse
 
 HELP: first-word
 { $values { "str" string } { "i" "index" } }
-{ $description "Finds the length of the first word in the string." } ;
+{ $description "Finds the index of the end of the first word in the string." } ;
+
+HELP: last-word
+{ $values { "str" string } { "i" "index" } }
+{ $description "Finds the index of the beginning of the last word in the string." } ;
+
+HELP: first-word-from
+{ $values { "start" "index" } { "str" string } { "i" "index" } }
+{ $description "Finds the index of the end of the first word in the string, starting from the given index." } ;
+
+HELP: last-word-from
+{ $values { "end" "index" } { "str" string } { "i" "index" } }
+{ $description "Finds the index of the start of the word that the index is contained in." } ;
 
 HELP: >words
 { $values { "str" string } { "words" "an array of strings" } }
diff --git a/basis/unicode/breaks/breaks-tests.factor b/basis/unicode/breaks/breaks-tests.factor
index 6d6d4233f5..bbce857681 100644
--- a/basis/unicode/breaks/breaks-tests.factor
+++ b/basis/unicode/breaks/breaks-tests.factor
@@ -12,6 +12,11 @@ IN: unicode.breaks.tests
 [ 3 ] [ 2 "hello" first-grapheme-from ] unit-test
 [ 1 ] [ 2 "hello" last-grapheme-from ] unit-test
 
+[ 4 ] [ 2 "what am I saying" first-word-from ] unit-test
+[ 0 ] [ 2 "what am I saying" last-word-from ] unit-test
+[ 16 ] [ 11 "what am I saying" first-word-from ] unit-test
+[ 10 ] [ 11 "what am I saying" last-word-from ] unit-test
+
 : grapheme-break-test ( -- filename )
     "vocab:unicode/breaks/GraphemeBreakTest.txt" ;
 
diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor
index 6d6b5cc0cf..ed96842c41 100644
--- a/basis/unicode/breaks/breaks.factor
+++ b/basis/unicode/breaks/breaks.factor
@@ -247,3 +247,12 @@ PRIVATE>
             word-break-next nip
         ]
     } 2|| ;
+
+: first-word-from ( start str -- i )
+    over tail-slice first-word + ;
+
+: last-word ( str -- i )
+    [ length ] keep '[ _ word-break-at? ] find-last drop 0 or ;
+
+: last-word-from ( end str -- i )
+    swap head-slice last-word ;

From 0180209f4ec94be20872bf73a59cbccbe0b120e8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 3 Jul 2009 21:31:26 -0500
Subject: [PATCH 07/17] compiler.tree.dead-code: methods on flushable generics
 should be flushable

---
 .../tree/cleanup/cleanup-tests.factor         | 21 +++++++++++++++++++
 .../tree/dead-code/simple/simple.factor       | 11 +++++++---
 2 files changed, 29 insertions(+), 3 deletions(-)

diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor
index 549d492d20..e5b75bb5b0 100755
--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/basis/compiler/tree/cleanup/cleanup-tests.factor
@@ -6,6 +6,7 @@ definitions system layouts vectors math.partial-dispatch
 math.order math.functions accessors hashtables classes assocs
 io.encodings.utf8 io.encodings.ascii io.encodings fry slots
 sorting.private combinators.short-circuit grouping prettyprint
+generalizations
 compiler.tree
 compiler.tree.combinators
 compiler.tree.cleanup
@@ -518,3 +519,23 @@ cell-bits 32 = [
     [ { integer integer } declare + drop ]
     { + +-integer-integer } inlined?
 ] unit-test
+
+[ [ ] ] [
+    [
+        20 f <array>
+        [ 0 swap nth ] keep
+        [ 1 swap nth ] keep
+        [ 2 swap nth ] keep
+        [ 3 swap nth ] keep
+        [ 4 swap nth ] keep
+        [ 5 swap nth ] keep
+        [ 6 swap nth ] keep
+        [ 7 swap nth ] keep
+        [ 8 swap nth ] keep
+        [ 9 swap nth ] keep
+        [ 10 swap nth ] keep
+        [ 11 swap nth ] keep
+        [ 12 swap nth ] keep
+        14 ndrop
+    ] cleaned-up-tree nodes>quot
+] unit-test
\ No newline at end of file
diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor
index c9b73808a1..5134a67a5b 100755
--- a/basis/compiler/tree/dead-code/simple/simple.factor
+++ b/basis/compiler/tree/dead-code/simple/simple.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors words assocs sequences arrays namespaces
-fry locals definitions classes.algebra
+fry locals definitions classes classes.algebra generic
 stack-checker.state
 stack-checker.backend
 compiler.tree
@@ -9,8 +9,13 @@ compiler.tree.propagation.info
 compiler.tree.dead-code.liveness ;
 IN: compiler.tree.dead-code.simple
 
-: flushable? ( word -- ? )
-    [ "flushable" word-prop ] [ "predicating" word-prop ] bi or ;
+GENERIC: flushable? ( word -- ? )
+
+M: predicate flushable? drop t ;
+
+M: word flushable? "flushable" word-prop ;
+
+M: method-body flushable? "method-generic" word-prop flushable? ;
 
 : flushable-call? ( #call -- ? )
     dup word>> dup flushable? [

From f53efa88c61eff15ca65c29dd82641f1588bd858 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 3 Jul 2009 22:32:30 -0500
Subject: [PATCH 08/17] tools.annotations: redo 'watch' so that it doesn't call
 'datastack' anymore, instead use macros to capture stack values. This works
 better with compiler optimizations

---
 .../annotations/annotations-tests.factor      | 11 +++++++++
 basis/tools/annotations/annotations.factor    | 24 +++++++++++--------
 2 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/basis/tools/annotations/annotations-tests.factor b/basis/tools/annotations/annotations-tests.factor
index c312b54edb..79aef90bea 100644
--- a/basis/tools/annotations/annotations-tests.factor
+++ b/basis/tools/annotations/annotations-tests.factor
@@ -49,3 +49,14 @@ M: string blah-generic ;
 [ ] [ M\ string blah-generic watch ] unit-test
 
 [ "hi" ] [ "hi" blah-generic ] unit-test
+
+! See how well watch interacts with optimizations.
+GENERIC: my-generic ( a -- b )
+M: object my-generic ;
+
+\ my-generic watch
+
+: some-code ( -- )
+    f my-generic drop ;
+
+[ ] [ some-code ] unit-test
\ No newline at end of file
diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor
index 3aac371a6a..e7e5837ee8 100644
--- a/basis/tools/annotations/annotations.factor
+++ b/basis/tools/annotations/annotations.factor
@@ -3,7 +3,8 @@
 USING: accessors kernel math sorting words parser io summary
 quotations sequences prettyprint continuations effects
 definitions compiler.units namespaces assocs tools.walker
-tools.time generic inspector fry tools.continuations ;
+tools.time generic inspector fry tools.continuations
+locals generalizations macros ;
 IN: tools.annotations
 
 GENERIC: reset ( word -- )
@@ -46,17 +47,20 @@ M: word annotate
 
 <PRIVATE
 
-: stack-values ( names -- alist )
-    [ datastack ] dip [ nip ] [ length tail* ] 2bi zip ;
+:: trace-quot ( word effect quot str -- quot' )
+    effect quot call :> values
+    values length :> n
+    [
+        "--- " write str write bl word .
+        n ndup n narray values swap zip simple-table.
+        flush
+    ] ; inline
 
-: trace-message ( word quot str -- )
-    "--- " write write bl over .
-    [ stack-effect ] dip '[ @ stack-values ] [ f ] if*
-    [ simple-table. ] unless-empty flush ; inline
+MACRO: entering ( word -- quot )
+    dup stack-effect [ in>> ] "Entering" trace-quot ;
 
-: entering ( str -- ) [ in>> ] "Entering" trace-message ;
-
-: leaving ( str -- ) [ out>> ] "Leaving" trace-message ;
+MACRO: leaving ( word -- quot )
+    dup stack-effect [ out>> ] "Leaving" trace-quot ;
 
 : (watch) ( word def -- def )
     over '[ _ entering @ _ leaving ] ;

From 8c3c007d8e34baae00f2208cbcfb0ab3dca6da77 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 3 Jul 2009 22:35:34 -0500
Subject: [PATCH 09/17] ui.tools.listener.completion: if listener is not
 accepting input, pressing TAB would throw an error (reported by Doug Coleman)

---
 basis/ui/tools/listener/completion/completion.factor | 1 +
 1 file changed, 1 insertion(+)

diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor
index f215e297ff..760b959e78 100644
--- a/basis/ui/tools/listener/completion/completion.factor
+++ b/basis/ui/tools/listener/completion/completion.factor
@@ -63,6 +63,7 @@ M: definition-completion row-columns
 
 M: word-completion row-color
     [ vocabulary>> ] [ manifest>> ] bi* {
+        { [ dup not ] [ COLOR: black ] }
         { [ 2dup search-vocabs>> memq? ] [ COLOR: black ] }
         { [ over ".private" tail? ] [ COLOR: dark-red ] }
         [ COLOR: dark-gray ]

From d108324f192af7c85e9d17dfa50750ef4515827f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 3 Jul 2009 22:41:32 -0500
Subject: [PATCH 10/17] ui.gadgets.panes: Shift-clicking to extend the
 selection in a pane should not focus the pane's input area

---
 basis/ui/gadgets/panes/panes.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor
index 2c5ed596ac..6f68c32ff0 100644
--- a/basis/ui/gadgets/panes/panes.factor
+++ b/basis/ui/gadgets/panes/panes.factor
@@ -397,8 +397,8 @@ M: f sloppy-pick-up*
     ] [ drop ] if ;
 
 : end-selection ( pane -- )
-    f >>selecting?
-    hand-moved?
+    dup selecting?>> hand-moved? or
+    [ f >>selecting? ] dip
     [ [ com-copy-selection ] [ request-focus ] bi ]
     [ [ relayout-1 ] [ focus-input ] bi ]
     if ;

From d07c0429fc23b2b24f6d4d6c59079774e0b936c9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 3 Jul 2009 22:51:40 -0500
Subject: [PATCH 11/17] compiler.cfg.linear-scan: assign spill slots to vregs
 globally, so that resolve pass never has to perform a memory->memory transfer

---
 .../linear-scan/allocation/spilling/spilling.factor  |  4 +---
 .../cfg/linear-scan/allocation/state/state.factor    | 12 ++++++++++--
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
index 73d4570b02..e5c4b10021 100644
--- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor
@@ -48,9 +48,7 @@ ERROR: bad-live-ranges interval ;
     } 2cleave ;
 
 : assign-spill ( live-interval -- live-interval )
-    dup reload-from>>
-    [ dup vreg>> reg-class>> next-spill-location ] unless*
-    >>spill-to ;
+    dup vreg>> assign-spill-slot >>spill-to ;
 
 : assign-reload ( before after -- before after )
     over spill-to>> >>reload-from ;
diff --git a/basis/compiler/cfg/linear-scan/allocation/state/state.factor b/basis/compiler/cfg/linear-scan/allocation/state/state.factor
index 737133aa32..a17a1181b5 100644
--- a/basis/compiler/cfg/linear-scan/allocation/state/state.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/state/state.factor
@@ -109,18 +109,26 @@ CONSTANT: reg-classes { int-regs double-float-regs }
 : reg-class-assoc ( quot -- assoc )
     [ reg-classes ] dip { } map>assoc ; inline
 
+! Mapping from register classes to spill counts
 SYMBOL: spill-counts
 
-: next-spill-location ( reg-class -- n )
+: next-spill-slot ( reg-class -- n )
     spill-counts get [ dup 1 + ] change-at ;
 
+! Mapping from vregs to spill slots
+SYMBOL: spill-slots
+
+: assign-spill-slot ( vreg -- n )
+    spill-slots get [ reg-class>> next-spill-slot ] cache ;
+
 : init-allocator ( registers -- )
     registers set
-    [ 0 ] reg-class-assoc spill-counts set
     <min-heap> unhandled-intervals set
     [ V{ } clone ] reg-class-assoc active-intervals set
     [ V{ } clone ] reg-class-assoc inactive-intervals set
     V{ } clone handled-intervals set
+    [ 0 ] reg-class-assoc spill-counts set
+    H{ } clone spill-slots set
     -1 progress set ;
 
 : init-unhandled ( live-intervals -- )

From 8d3a45dee2eac7336b0d218ecce72227aa86f478 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 3 Jul 2009 23:11:23 -0500
Subject: [PATCH 12/17] compiler.cfg: clean up GC check generation to use
 spill-slot data type

---
 basis/compiler/cfg/gc-checks/gc-checks.factor |  2 +-
 .../cfg/instructions/instructions.factor      |  2 +-
 .../linear-scan/assignment/assignment.factor  | 15 +++---
 .../cfg/linearization/linearization.factor    | 48 ++++++++-----------
 .../cfg/stack-frame/stack-frame.factor        |  4 +-
 5 files changed, 32 insertions(+), 39 deletions(-)

diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor
index 090283410f..8435a231e6 100644
--- a/basis/compiler/cfg/gc-checks/gc-checks.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks.factor
@@ -10,7 +10,7 @@ IN: compiler.cfg.gc-checks
 
 : insert-gc-check ( basic-block -- )
     dup gc? [
-        [ i i f f \ ##gc new-insn prefix ] change-instructions drop
+        [ i i f \ ##gc new-insn prefix ] change-instructions drop
     ] [ drop ] if ;
 
 : insert-gc-checks ( cfg -- cfg' )
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 8e2d2ff75e..56f0452d1a 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -220,7 +220,7 @@ INSN: ##compare-imm < ##binary-imm cc temp ;
 INSN: ##compare-float-branch < ##conditional-branch ;
 INSN: ##compare-float < ##binary cc temp ;
 
-INSN: ##gc { temp1 vreg } { temp2 vreg } live-registers live-spill-slots ;
+INSN: ##gc { temp1 vreg } { temp2 vreg } live-values ;
 
 ! Instructions used by machine IR only.
 INSN: _prologue stack-frame ;
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index 0956b7263f..0ade81311a 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -105,7 +105,7 @@ ERROR: already-reloaded ;
 GENERIC: assign-registers-in-insn ( insn -- )
 
 : register-mapping ( live-intervals -- alist )
-    [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc ;
+    [ [ vreg>> ] [ reg>> ] bi ] H{ } map>assoc ;
 
 : all-vregs ( insn -- vregs )
     [ defs-vregs ] [ temp-vregs ] [ uses-vregs ] tri 3append ;
@@ -130,19 +130,22 @@ M: vreg-insn assign-registers-in-insn
     register-mapping
     >>regs drop ;
 
-: compute-live-registers ( insn -- regs )
+: compute-live-registers ( insn -- assoc )
     [ active-intervals ] [ temp-vregs ] bi
     '[ vreg>> _ memq? not ] filter
     register-mapping ;
 
-: compute-live-spill-slots ( -- spill-slots )
+: compute-live-spill-slots ( -- assocs )
     spill-slots get values
-    [ [ vreg>> swap ] { } assoc-map-as ] map concat ;
+    [ [ vreg>> swap <spill-slot> ] H{ } assoc-map-as ] map ;
+
+: compute-live-values ( insn -- assoc )
+    [ compute-live-spill-slots ] dip compute-live-registers suffix
+    assoc-combine ;
 
 M: ##gc assign-registers-in-insn
     dup call-next-method
-    dup compute-live-registers >>live-registers
-    compute-live-spill-slots >>live-spill-slots
+    dup compute-live-values >>live-values
     drop ;
 
 M: insn assign-registers-in-insn drop ;
diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index 8165553a28..15e7cef553 100755
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@@ -57,41 +57,31 @@ M: ##dispatch linearize-insn
     [ successors>> [ number>> _dispatch-label ] each ]
     bi* ;
 
-: gc-root-registers ( n live-registers -- n )
+: (compute-gc-roots) ( n live-values -- n )
     [
-        [ second 2array , ]
-        [ first reg-class>> reg-size + ]
-        2bi
-    ] each ;
+        [ nip 2array , ]
+        [ drop reg-class>> reg-size + ]
+        3bi
+    ] assoc-each ;
 
-: gc-root-spill-slots ( n live-spill-slots -- n )
+: oop-values ( regs -- regs' )
+    [ drop reg-class>> int-regs eq? ] assoc-filter ;
+
+: data-values ( regs -- regs' )
+    [ drop reg-class>> double-float-regs eq? ] assoc-filter ;
+
+: compute-gc-roots ( live-values -- alist )
     [
-        dup first reg-class>> int-regs eq? [
-            [ second <spill-slot> 2array , ]
-            [ first reg-class>> reg-size + ]
-            2bi
-        ] [ drop ] if
-    ] each ;
-
-: oop-registers ( regs -- regs' )
-    [ first reg-class>> int-regs eq? ] filter ;
-
-: data-registers ( regs -- regs' )
-    [ first reg-class>> double-float-regs eq? ] filter ;
-
-:: compute-gc-roots ( live-registers live-spill-slots -- alist )
-    [
-        0
+        [ 0 ] dip
         ! we put float registers last; the GC doesn't actually scan them
-        live-registers oop-registers gc-root-registers
-        live-spill-slots gc-root-spill-slots
-        live-registers data-registers gc-root-registers
+        [ oop-values (compute-gc-roots) ]
+        [ data-values (compute-gc-roots) ] bi
         drop
     ] { } make ;
 
-: count-gc-roots ( live-registers live-spill-slots -- n )
+: count-gc-roots ( live-values -- n )
     ! Size of GC root area, minus the float registers
-    [ oop-registers length ] bi@ + ;
+    oop-values assoc-size ;
 
 M: ##gc linearize-insn
     nip
@@ -99,11 +89,11 @@ M: ##gc linearize-insn
         [ temp1>> ]
         [ temp2>> ]
         [
-            [ live-registers>> ] [ live-spill-slots>> ] bi
+            live-values>>
             [ compute-gc-roots ]
             [ count-gc-roots ]
             [ gc-roots-size ]
-            2tri
+            tri
         ] tri
         _gc
     ] with-regs ;
diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor
index 5cb5762b78..9eb6d27521 100644
--- a/basis/compiler/cfg/stack-frame/stack-frame.factor
+++ b/basis/compiler/cfg/stack-frame/stack-frame.factor
@@ -34,8 +34,8 @@ spill-counts ;
 
 : gc-root-offset ( n -- n' ) gc-root-base + ;
 
-: gc-roots-size ( live-registers live-spill-slots -- n )
-    [ keys [ reg-class>> reg-size ] sigma ] bi@ + ;
+: gc-roots-size ( live-values -- n )
+    keys [ reg-class>> reg-size ] sigma ;
 
 : (stack-frame-size) ( stack-frame -- n )
     [

From da13681bc809e41f9697185f873bd259af237a5c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 3 Jul 2009 23:38:52 -0500
Subject: [PATCH 13/17] compiler.cfg.linear-scan: redo resolve pass to fix a
 correctness issue

---
 .../cfg/instructions/instructions.factor      |  2 +-
 .../linear-scan/assignment/assignment.factor  | 72 +++++++++-----
 .../cfg/linear-scan/linear-scan-tests.factor  | 59 +++++++++++-
 .../linear-scan/resolve/resolve-tests.factor  | 57 +----------
 .../cfg/linear-scan/resolve/resolve.factor    | 95 +++++--------------
 5 files changed, 131 insertions(+), 154 deletions(-)

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 56f0452d1a..a2b12300f7 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -240,7 +240,7 @@ INSN: _compare-imm-branch label { src1 vreg } { src2 integer } cc ;
 
 INSN: _compare-float-branch < _conditional-branch ;
 
-TUPLE: spill-slot { n integer } ; C: <spill-slot> spill-slot
+TUPLE: spill-slot n ; C: <spill-slot> spill-slot
 
 INSN: _gc { temp1 vreg } { temp2 vreg } gc-roots gc-root-count gc-root-size ;
 
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index 0ade81311a..c95771835a 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -33,6 +33,20 @@ SYMBOL: spill-slots
 : spill-slots-for ( vreg -- assoc )
     reg-class>> spill-slots get at ;
 
+! Mapping from basic blocks to values which are live at the start
+SYMBOL: register-live-ins
+
+! Mapping from basic blocks to values which are live at the end
+SYMBOL: register-live-outs
+
+: init-assignment ( live-intervals -- )
+    V{ } clone pending-intervals set
+    <min-heap> unhandled-intervals set
+    [ H{ } clone ] reg-class-assoc spill-slots set
+    H{ } clone register-live-ins set
+    H{ } clone register-live-outs set
+    init-unhandled ;
+
 ERROR: already-spilled ;
 
 : record-spill ( live-interval -- )
@@ -102,6 +116,9 @@ ERROR: already-reloaded ;
         ] [ 2drop ] if
     ] if ;
 
+: prepare-insn ( insn -- )
+    insn#>> [ expire-old-intervals ] [ activate-new-intervals ] bi ;
+
 GENERIC: assign-registers-in-insn ( insn -- )
 
 : register-mapping ( live-intervals -- alist )
@@ -118,60 +135,65 @@ ERROR: overlapping-registers intervals ;
     dup [ copy-from>> ] map sift '[ vreg>> _ member? not ] filter
     dup [ reg>> ] map all-unique? [ drop ] [ overlapping-registers ] if ;
 
-: active-intervals ( insn -- intervals )
-    insn#>> pending-intervals get [ covers? ] with filter
+: active-intervals ( n -- intervals )
+    pending-intervals get [ covers? ] with filter
     check-assignment? get [
         dup check-assignment
     ] when ;
 
 M: vreg-insn assign-registers-in-insn
-    dup [ active-intervals ] [ all-vregs ] bi
+    dup [ insn#>> active-intervals ] [ all-vregs ] bi
     '[ vreg>> _ member? ] filter
     register-mapping
     >>regs drop ;
 
-: compute-live-registers ( insn -- assoc )
-    [ active-intervals ] [ temp-vregs ] bi
-    '[ vreg>> _ memq? not ] filter
-    register-mapping ;
+: compute-live-registers ( n -- assoc )
+    active-intervals register-mapping ;
 
 : compute-live-spill-slots ( -- assocs )
-    spill-slots get values
-    [ [ vreg>> swap <spill-slot> ] H{ } assoc-map-as ] map ;
+    spill-slots get values first2
+    [ [ vreg>> swap <spill-slot> ] H{ } assoc-map-as ] bi@
+    assoc-union ;
 
-: compute-live-values ( insn -- assoc )
-    [ compute-live-spill-slots ] dip compute-live-registers suffix
-    assoc-combine ;
+: compute-live-values ( n -- assoc )
+    [ compute-live-spill-slots ] dip compute-live-registers
+    assoc-union ;
+
+: compute-live-gc-values ( insn -- assoc )
+    [ insn#>> compute-live-values ] [ temp-vregs ] bi
+    '[ drop _ memq? not ] assoc-filter ;
 
 M: ##gc assign-registers-in-insn
     dup call-next-method
-    dup compute-live-values >>live-values
+    dup compute-live-gc-values >>live-values
     drop ;
 
 M: insn assign-registers-in-insn drop ;
 
-: init-assignment ( live-intervals -- )
-    V{ } clone pending-intervals set
-    <min-heap> unhandled-intervals set
-    [ H{ } clone ] reg-class-assoc spill-slots set 
-    init-unhandled ;
+: begin-block ( bb -- )
+    [ block-from compute-live-values ] keep register-live-ins get set-at ;
+
+: end-block ( bb -- )
+    [ block-to compute-live-values ] keep register-live-outs get set-at ;
+
+: vreg-at-start ( vreg bb -- state ) register-live-ins get at at ;
+
+: vreg-at-end ( vreg bb -- state ) register-live-outs get at at ;
 
 : assign-registers-in-block ( bb -- )
+    dup
+    begin-block
     [
         [
             [
-                [
-                    insn#>>
-                    [ expire-old-intervals ]
-                    [ activate-new-intervals ]
-                    bi
-                ]
+                [ prepare-insn ]
                 [ assign-registers-in-insn ]
                 [ , ]
                 tri
             ] each
         ] V{ } make
-    ] change-instructions drop ;
+    ] change-instructions
+    end-block ;
 
 : assign-registers ( live-intervals rpo -- )
     [ init-assignment ] dip
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index 65778a3e7b..377b3bff74 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -1353,7 +1353,7 @@ USING: math.private ;
 
 ! Spill slot liveness was computed incorrectly, leading to a FEP
 ! early in bootstrap on x86-32
-[ t t ] [
+[ t ] [
     [
         H{ } clone live-ins set
         H{ } clone live-outs set
@@ -1379,8 +1379,7 @@ USING: math.private ;
            }
         } dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan)
         instructions>> first
-        [ live-spill-slots>> empty? ]
-        [ live-registers>> empty? ] bi
+        live-values>> assoc-empty?
     ] with-scope
 ] unit-test
 
@@ -1859,4 +1858,56 @@ test-diamond
 
 [ _spill ] [ 3 get instructions>> second class ] unit-test
 
-[ _reload ] [ 4 get instructions>> first class ] unit-test
\ No newline at end of file
+[ _reload ] [ 4 get instructions>> first class ] unit-test
+
+! Resolve pass
+V{
+    T{ ##branch }
+} 0 test-bb
+
+V{
+    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##compare-imm-branch f V int-regs 0 5 cc= }
+} 1 test-bb
+
+V{
+    T{ ##replace f V int-regs 0 D 0 }
+    T{ ##peek f V int-regs 1 D 0 }
+    T{ ##peek f V int-regs 2 D 0 }
+    T{ ##replace f V int-regs 1 D 0 }
+    T{ ##replace f V int-regs 2 D 0 }
+    T{ ##branch }
+} 2 test-bb
+
+V{
+    T{ ##branch }
+} 3 test-bb
+
+V{
+    T{ ##peek f V int-regs 1 D 0 }
+    T{ ##compare-imm-branch f V int-regs 1 5 cc= }
+} 4 test-bb
+
+V{
+    T{ ##replace f V int-regs 0 D 0 }
+    T{ ##return }
+} 5 test-bb
+
+V{
+    T{ ##replace f V int-regs 0 D 0 }
+    T{ ##return }
+} 6 test-bb
+
+0 get 1 get V{ } 1sequence >>successors drop
+1 get 2 get 3 get V{ } 2sequence >>successors drop
+2 get 4 get V{ } 1sequence >>successors drop
+3 get 4 get V{ } 1sequence >>successors drop
+4 get 5 get 6 get V{ } 2sequence >>successors drop
+
+[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
+
+[ t ] [ 2 get instructions>> [ _spill? ] any? ] unit-test
+
+[ t ] [ 3 get instructions>> [ _spill? ] any? ] unit-test
+
+[ t ] [ 5 get instructions>> [ _reload? ] any? ] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
index f2d71691aa..4c27e5c4eb 100644
--- a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
@@ -12,59 +12,6 @@ IN: compiler.cfg.linear-scan.resolve.tests
     { 3 4 } V{ 1 2 } clone [ { 5 6 } 3append-here ] keep >array
 ] unit-test
 
-V{
-    T{ ##peek f V int-regs 0 D 0 }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##replace f V int-regs 0 D 1 }
-    T{ ##return }
-} 1 test-bb
-
-1 get 1vector 0 get (>>successors)
-
-cfg new 0 get >>entry
-compute-predecessors
-dup reverse-post-order number-instructions
-drop
-
-CONSTANT: test-live-interval-1
-T{ live-interval
-   { start 0 }
-   { end 6 }
-   { uses V{ 0 6 } }
-   { ranges V{ T{ live-range f 0 2 } T{ live-range f 4 6 } } }
-   { spill-to 0 }
-   { vreg V int-regs 0 }
-}
-
-[ f ] [
-    test-live-interval-1 0 get spill-to
-] unit-test
-
-[ 0 ] [
-    test-live-interval-1 1 get spill-to
-] unit-test
-
-CONSTANT: test-live-interval-2
-T{ live-interval
-   { start 0 }
-   { end 6 }
-   { uses V{ 0 6 } }
-   { ranges V{ T{ live-range f 0 2 } T{ live-range f 4 6 } } }
-   { reload-from 0 }
-   { vreg V int-regs 0 }
-}
-
-[ 0 ] [
-    test-live-interval-2 0 get reload-from
-] unit-test
-
-[ f ] [
-    test-live-interval-2 1 get reload-from
-] unit-test
-
 [
     {
         T{ _copy { dst 5 } { src 4 } { class int-regs } }
@@ -142,8 +89,8 @@ T{ live-interval
     }
 ] [
     {
-       T{ register->memory { from 3 } { to 4 } { reg-class int-regs } }
-       T{ memory->register { from 1 } { to 2 } { reg-class int-regs } }
+        T{ register->memory { from 3 } { to T{ spill-slot f 4 } } { reg-class int-regs } }
+        T{ memory->register { from T{ spill-slot f 1 } } { to 2 } { reg-class int-regs } }
     } mapping-instructions
 ] unit-test
 
diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
index 7681b811c4..951e727375 100644
--- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
@@ -3,7 +3,7 @@
 USING: accessors arrays assocs classes.parser classes.tuple
 combinators combinators.short-circuit fry hashtables kernel locals
 make math math.order namespaces sequences sets words parser
-compiler.cfg.instructions compiler.cfg.linear-scan.live-intervals
+compiler.cfg.instructions compiler.cfg.linear-scan.assignment
 compiler.cfg.liveness ;
 IN: compiler.cfg.linear-scan.resolve
 
@@ -14,50 +14,33 @@ TUPLE: operation from to reg-class ;
 SYNTAX: OPERATION:
     CREATE-CLASS dup save-location
     [ operation { } define-tuple-class ]
-    [
-        [ scan-word scan-word ] keep
-        '[
-            [ [ _ execute ] [ _ execute ] bi* ]
-            [ vreg>> reg-class>> ]
-            bi _ boa ,
-        ] (( from to -- )) define-declared
-    ] bi ;
+    [ dup '[ _ boa , ] (( from to reg-class -- )) define-declared ] bi ;
 
 >>
 
-: insn-in-block? ( insn# bb -- ? )
-    [ block-from ] [ block-to ] bi between? ;
+OPERATION: register->memory
+OPERATION: memory->register
+OPERATION: register->register
 
-: reload-from ( live-interval bb -- n/f )
-    2dup [ start>> ] dip insn-in-block?
-    [ drop reload-from>> ] [ 2drop f ] if ;
+! This should never come up because of how spill slots are assigned,
+! so make it an error.
+: memory->memory ( from to reg-class -- ) drop [ n>> ] bi@ assert= ;
 
-: spill-to ( live-interval bb -- n/f )
-    2dup [ end>> ] dip insn-in-block?
-    [ drop spill-to>> ] [ 2drop f ] if ;
-
-OPERATION: memory->memory spill-to>> reload-from>>
-OPERATION: register->memory reg>> reload-from>>
-OPERATION: memory->register spill-to>> reg>>
-OPERATION: register->register reg>> reg>>
-
-:: add-mapping ( bb1 bb2 li1 li2 -- )
-    li2 bb2 reload-from [
-        li1 bb1 spill-to
-        [ li1 li2 memory->memory ]
-        [ li1 li2 register->memory ] if
+: add-mapping ( from to reg-class -- )
+    over spill-slot? [
+        pick spill-slot?
+        [ memory->memory ]
+        [ register->memory ] if
     ] [
-        li1 bb1 spill-to
-        [ li1 li2 memory->register ]
-        [ li1 li2 register->register ] if
+        pick spill-slot?
+        [ memory->register ]
+        [ register->register ] if
     ] if ;
 
-: resolve-value-data-flow ( bb to vreg -- )
-    [ 2dup ] dip
-    live-intervals get at
-    [ [ block-to ] dip child-interval-at ]
-    [ [ block-from ] dip child-interval-at ]
-    bi-curry bi* 2dup eq? [ 2drop 2drop ] [ add-mapping ] if ;
+:: resolve-value-data-flow ( bb to vreg -- )
+    vreg bb vreg-at-end
+    vreg to vreg-at-start
+    2dup eq? [ 2drop ] [ vreg reg-class>> add-mapping ] if ;
 
 : compute-mappings ( bb to -- mappings )
     [
@@ -67,48 +50,23 @@ OPERATION: register->register reg>> reg>>
 
 GENERIC: >insn ( operation -- )
 
-M: memory->memory >insn
-    [ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ;
-
 M: register->memory >insn
-    [ from>> ] [ reg-class>> ] [ to>> ] tri _spill ;
+    [ from>> ] [ reg-class>> ] [ to>> n>> ] tri _spill ;
 
 M: memory->register >insn
-    [ to>> ] [ reg-class>> ] [ from>> ] tri  _reload ;
+    [ to>> ] [ reg-class>> ] [ from>> n>> ] tri  _reload ;
 
 M: register->register >insn
     [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ;
 
-GENERIC: >collision-table ( operation -- )
-
-M: memory->memory >collision-table
-    [ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ;
-
-M: register->memory >collision-table
-    [ from>> ] [ reg-class>> ] [ to>> ] tri _spill ;
-
-M: memory->register >collision-table
-    [ to>> ] [ reg-class>> ] [ from>> ] tri _reload ;
-
-M: register->register >collision-table
-    [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ;
-
 SYMBOL: froms
 SYMBOL: tos
 
 SINGLETONS: memory register ;
 
-GENERIC: from-loc ( operation -- obj )
-M: memory->memory from-loc drop memory ;
-M: register->memory from-loc drop register ;
-M: memory->register from-loc drop memory ;
-M: register->register from-loc drop register ;
+: from-loc ( operation -- obj ) from>> spill-slot? memory register ? ;
 
-GENERIC: to-loc ( operation -- obj )
-M: memory->memory to-loc drop memory ;
-M: register->memory to-loc drop memory ;
-M: memory->register to-loc drop register ;
-M: register->register to-loc drop register ;
+: to-loc ( operation -- obj ) to>> spill-slot? memory register ? ;
 
 : from-reg ( operation -- seq )
     [ from-loc ] [ from>> ] [ reg-class>> ] tri 3array ;
@@ -142,7 +100,6 @@ M: register->register to-loc drop register ;
         dup dup associate (trace-chain)
     ] { } make prune reverse ;
 
-
 : trace-chains ( seq -- seq' )
     [ trace-chain ] map concat ;
 
@@ -159,10 +116,10 @@ ERROR: resolve-error ;
 
 : break-cycle-n ( operations -- operations' )
     split-cycle [
-        [ from>> spill-temp ]
+        [ from>> spill-temp <spill-slot> ]
         [ reg-class>> ] bi \ register->memory boa
     ] [
-        [ to>> spill-temp swap ]
+        [ to>> spill-temp <spill-slot> swap ]
         [ reg-class>> ] bi \ memory->register boa
     ] bi [ 1array ] bi@ surround ;
 

From c00af97fa16eb5931ea5d1359edee454d0c8be3d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 4 Jul 2009 00:45:06 -0500
Subject: [PATCH 14/17] compiler.cfg.linear-scan.resolve: More fixes

---
 .../linear-scan/assignment/assignment.factor  | 28 ++++----
 .../cfg/linear-scan/linear-scan-tests.factor  | 67 ++++++++++++++++++-
 2 files changed, 82 insertions(+), 13 deletions(-)

diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index c95771835a..e9f12ea668 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel math assocs namespaces sequences heaps
-fry make combinators sets
+fry make combinators sets locals
 cpu.architecture
 compiler.cfg.def-use
 compiler.cfg.registers
@@ -116,8 +116,8 @@ ERROR: already-reloaded ;
         ] [ 2drop ] if
     ] if ;
 
-: prepare-insn ( insn -- )
-    insn#>> [ expire-old-intervals ] [ activate-new-intervals ] bi ;
+: prepare-insn ( n -- )
+    [ expire-old-intervals ] [ activate-new-intervals ] bi ;
 
 GENERIC: assign-registers-in-insn ( insn -- )
 
@@ -171,29 +171,33 @@ M: ##gc assign-registers-in-insn
 M: insn assign-registers-in-insn drop ;
 
 : begin-block ( bb -- )
+    dup block-from prepare-insn
     [ block-from compute-live-values ] keep register-live-ins get set-at ;
 
 : end-block ( bb -- )
     [ block-to compute-live-values ] keep register-live-outs get set-at ;
 
-: vreg-at-start ( vreg bb -- state ) register-live-ins get at at ;
+ERROR: bad-vreg vreg ;
 
-: vreg-at-end ( vreg bb -- state ) register-live-outs get at at ;
+: vreg-at-start ( vreg bb -- state )
+    register-live-ins get at ?at [ bad-vreg ] unless ;
 
-: assign-registers-in-block ( bb -- )
-    dup
-    begin-block
-    [
+: vreg-at-end ( vreg bb -- state )
+    register-live-outs get at ?at [ bad-vreg ] unless ;
+
+:: assign-registers-in-block ( bb -- )
+    bb [
         [
+            bb begin-block
             [
-                [ prepare-insn ]
+                [ insn#>> prepare-insn ]
                 [ assign-registers-in-insn ]
                 [ , ]
                 tri
             ] each
+            bb end-block
         ] V{ } make
-    ] change-instructions
-    end-block ;
+    ] change-instructions drop ;
 
 : assign-registers ( live-intervals rpo -- )
     [ init-assignment ] dip
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index 377b3bff74..63d31dfb4e 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -1910,4 +1910,69 @@ V{
 
 [ t ] [ 3 get instructions>> [ _spill? ] any? ] unit-test
 
-[ t ] [ 5 get instructions>> [ _reload? ] any? ] unit-test
\ No newline at end of file
+[ t ] [ 5 get instructions>> [ _reload? ] any? ] unit-test
+
+! A more complicated failure case with resolve that came up after the above
+! got fixed
+V{ T{ ##branch } } 0 test-bb
+V{
+    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##peek f V int-regs 1 D 1 }
+    T{ ##peek f V int-regs 2 D 2 }
+    T{ ##peek f V int-regs 3 D 3 }
+    T{ ##peek f V int-regs 4 D 0 }
+    T{ ##branch }
+} 1 test-bb
+V{ T{ ##branch } } 2 test-bb
+V{ T{ ##branch } } 3 test-bb
+V{
+    
+    T{ ##replace f V int-regs 1 D 1 }
+    T{ ##replace f V int-regs 2 D 2 }
+    T{ ##replace f V int-regs 3 D 3 }
+    T{ ##replace f V int-regs 4 D 4 }
+    T{ ##replace f V int-regs 0 D 0 }
+    T{ ##branch }
+} 4 test-bb
+V{ T{ ##replace f V int-regs 0 D 0 } T{ ##branch } } 5 test-bb
+V{ T{ ##return } } 6 test-bb
+V{ T{ ##branch } } 7 test-bb
+V{
+    T{ ##replace f V int-regs 1 D 1 }
+    T{ ##replace f V int-regs 2 D 2 }
+    T{ ##replace f V int-regs 3 D 3 }
+    T{ ##peek f V int-regs 5 D 1 }
+    T{ ##peek f V int-regs 6 D 2 }
+    T{ ##peek f V int-regs 7 D 3 }
+    T{ ##peek f V int-regs 8 D 4 }
+    T{ ##replace f V int-regs 5 D 1 }
+    T{ ##replace f V int-regs 6 D 2 }
+    T{ ##replace f V int-regs 7 D 3 }
+    T{ ##replace f V int-regs 8 D 4 }
+    T{ ##branch }
+} 8 test-bb
+V{
+    T{ ##replace f V int-regs 1 D 1 }
+    T{ ##replace f V int-regs 2 D 2 }
+    T{ ##replace f V int-regs 3 D 3 }
+    T{ ##return }
+} 9 test-bb
+
+0 get 1 get 1vector >>successors drop
+1 get 2 get 7 get V{ } 2sequence >>successors drop
+7 get 8 get 1vector >>successors drop
+8 get 9 get 1vector >>successors drop
+2 get 3 get 5 get V{ } 2sequence >>successors drop
+3 get 4 get 1vector >>successors drop
+4 get 9 get 1vector >>successors drop
+5 get 6 get 1vector >>successors drop
+
+[ ] [ { 1 2 3 4 } test-linear-scan-on-cfg ] unit-test
+
+[ _spill ] [ 1 get instructions>> second class ] unit-test
+[ _reload ] [ 4 get instructions>> 4 swap nth class ] unit-test
+[ V{ 3 2 1 } ] [ 8 get instructions>> [ _spill? ] filter [ n>> ] map ] unit-test
+[ V{ 3 2 1 } ] [ 9 get instructions>> [ _reload? ] filter [ n>> ] map ] unit-test
+
+! Resolve pass should insert this
+[ _reload ] [ 5 get instructions>> first class ] unit-test
\ No newline at end of file

From fb488025aa77c93ef4649a161b1794cf23170545 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Sat, 4 Jul 2009 02:50:50 -0500
Subject: [PATCH 15/17] compiler.cfg.value-numbering.rewrite: fix ##compare-imm
 rewrite rule

---
 .../cfg/instructions/instructions.factor      | 10 +++++
 .../value-numbering/rewrite/rewrite.factor    | 39 ++++++++++++-------
 basis/compiler/tests/codegen.factor           |  6 ++-
 3 files changed, 39 insertions(+), 16 deletions(-)

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index a2b12300f7..1a1b2fd65c 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -199,6 +199,16 @@ SYMBOL: cc/=
         { cc/= cc= }
     } at ;
 
+: swap-cc ( cc -- cc' )
+    H{
+        { cc< cc> }
+        { cc<= cc>= }
+        { cc> cc< }
+        { cc>= cc<= }
+        { cc= cc= }
+        { cc/= cc/= }
+    } at ;
+
 : evaluate-cc ( result cc -- ? )
     H{
         { cc<  { +lt+           } }
diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
index 9fb6e66e9f..8a435135c7 100755
--- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
+++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
@@ -1,11 +1,11 @@
-! Copyright (C) 2008 Slava Pestov, Doug Coleman.
+! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators combinators.short-circuit
-arrays compiler.cfg.hats compiler.cfg.instructions
+USING: accessors locals combinators combinators.short-circuit arrays
+fry kernel layouts math namespaces sequences cpu.architecture
+math.bitwise compiler.cfg.hats compiler.cfg.instructions
 compiler.cfg.value-numbering.expressions
 compiler.cfg.value-numbering.graph
-compiler.cfg.value-numbering.simplify fry kernel layouts math
-namespaces sequences cpu.architecture math.bitwise locals ;
+compiler.cfg.value-numbering.simplify ;
 IN: compiler.cfg.value-numbering.rewrite
 
 GENERIC: rewrite ( insn -- insn' )
@@ -70,16 +70,11 @@ M: ##compare-imm-branch rewrite
         dup rewrite-tagged-comparison? [ rewrite-tagged-comparison ] when
     ] when ;
 
-: >compare-imm ( insn swap? -- insn' )
-    [
-        {
-            [ dst>> ]
-            [ src1>> ]
-            [ src2>> ]
-            [ cc>> ]
-        } cleave
-    ] dip [ [ swap ] [ ] bi* ] when
-    [ vreg>constant ] dip
+:: >compare-imm ( insn swap? -- insn' )
+    insn dst>>
+    insn src1>>
+    insn src2>> swap? [ swap ] when vreg>constant
+    insn cc>> swap? [ swap-cc ] when
     i \ ##compare-imm new-insn ; inline
 
 M: ##compare rewrite
@@ -90,6 +85,20 @@ M: ##compare rewrite
         [ drop ]
     } case ;
 
+:: >compare-imm-branch ( insn swap? -- insn' )
+    insn src1>>
+    insn src2>> swap? [ swap ] when vreg>constant
+    insn cc>> swap? [ swap-cc ] when
+    \ ##compare-imm-branch new-insn ; inline
+
+M: ##compare-branch rewrite
+    dup [ src1>> ] [ src2>> ] bi
+    [ vreg>expr constant-expr? ] bi@ 2array {
+        { { f t } [ f >compare-imm-branch ] }
+        { { t f } [ t >compare-imm-branch ] }
+        [ drop ]
+    } case ;
+
 : rewrite-redundant-comparison? ( insn -- ? )
     {
         [ src1>> vreg>expr compare-expr? ]
diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index 36ee5eb94d..82da31b5fe 100644
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -310,4 +310,8 @@ M: cucumber equal? "The cucumber has no equal" throw ;
     }
 ] [
     [ { 1 2 3 } "x" "y" linear-scan-regression ] { } make
-] unit-test
\ No newline at end of file
+] unit-test
+
+! Regression from Doug's value numbering changes
+[ t ] [ 2 [ 1 swap fixnum< ] compile-call ] unit-test
+[ 3 ] [ 2 [ 1 swap fixnum< [ 3 ] [ 4 ] if ] compile-call ] unit-test
\ No newline at end of file

From c0f1b2205aad70afa2c0c90ed5fb4be9863190f6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Sat, 4 Jul 2009 03:26:37 -0500
Subject: [PATCH 16/17] compiler.cfg.value-numbering.rewrite: disable ##compare
 optimizations for now

---
 .../value-numbering/rewrite/rewrite.factor    | 28 +++++++++----------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
index 8a435135c7..ca7a959a82 100755
--- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
+++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
@@ -77,13 +77,13 @@ M: ##compare-imm-branch rewrite
     insn cc>> swap? [ swap-cc ] when
     i \ ##compare-imm new-insn ; inline
 
-M: ##compare rewrite
-    dup [ src1>> ] [ src2>> ] bi
-    [ vreg>expr constant-expr? ] bi@ 2array {
-        { { f t } [ f >compare-imm ] }
-        { { t f } [ t >compare-imm ] }
-        [ drop ]
-    } case ;
+! M: ##compare rewrite
+!     dup [ src1>> ] [ src2>> ] bi
+!     [ vreg>expr constant-expr? ] bi@ 2array {
+!         { { f t } [ f >compare-imm ] }
+!         { { t f } [ t >compare-imm ] }
+!         [ drop ]
+!     } case ;
 
 :: >compare-imm-branch ( insn swap? -- insn' )
     insn src1>>
@@ -91,13 +91,13 @@ M: ##compare rewrite
     insn cc>> swap? [ swap-cc ] when
     \ ##compare-imm-branch new-insn ; inline
 
-M: ##compare-branch rewrite
-    dup [ src1>> ] [ src2>> ] bi
-    [ vreg>expr constant-expr? ] bi@ 2array {
-        { { f t } [ f >compare-imm-branch ] }
-        { { t f } [ t >compare-imm-branch ] }
-        [ drop ]
-    } case ;
+! M: ##compare-branch rewrite
+!     dup [ src1>> ] [ src2>> ] bi
+!     [ vreg>expr constant-expr? ] bi@ 2array {
+!         { { f t } [ f >compare-imm-branch ] }
+!         { { t f } [ t >compare-imm-branch ] }
+!         [ drop ]
+!     } case ;
 
 : rewrite-redundant-comparison? ( insn -- ? )
     {

From f14a61fac21985ea40fd3e57c29c0a8694394617 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 4 Jul 2009 16:30:16 -0500
Subject: [PATCH 17/17] Fix compiler.cfg.linear-scan.resolve test failure

---
 basis/compiler/cfg/linear-scan/assignment/assignment.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index e9f12ea668..6b7fdd8ce1 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -171,7 +171,7 @@ M: ##gc assign-registers-in-insn
 M: insn assign-registers-in-insn drop ;
 
 : begin-block ( bb -- )
-    dup block-from prepare-insn
+    dup block-from 1 - prepare-insn
     [ block-from compute-live-values ] keep register-live-ins get set-at ;
 
 : end-block ( bb -- )