From 29395bf900817a1119e0c0533a79408d3bfd3ce4 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-122.local>
Date: Mon, 1 Jun 2009 22:37:44 -0500
Subject: [PATCH 01/10] Words in images to get and set pixels

---
 basis/images/authors.txt         |  3 ++-
 basis/images/images-tests.factor | 29 +++++++++++++++++++++++++++++
 basis/images/images.factor       | 22 ++++++++++++++++++++--
 3 files changed, 51 insertions(+), 3 deletions(-)
 create mode 100644 basis/images/images-tests.factor

diff --git a/basis/images/authors.txt b/basis/images/authors.txt
index b4bd0e7b35..a4a77d97e9 100644
--- a/basis/images/authors.txt
+++ b/basis/images/authors.txt
@@ -1 +1,2 @@
-Doug Coleman
\ No newline at end of file
+Doug Coleman
+Daniel Ehrenberg
diff --git a/basis/images/images-tests.factor b/basis/images/images-tests.factor
new file mode 100644
index 0000000000..39e8b4a364
--- /dev/null
+++ b/basis/images/images-tests.factor
@@ -0,0 +1,29 @@
+! Copyright (C) 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: images tools.test kernel accessors ;
+IN: images.tests
+
+[ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA f B{
+    0 0 0 0 
+    0 0 0 0 
+    0 0 0 0 
+    0 0 0 0 
+    57 57 57 255
+    0 0 0 0 
+} } pixel-at ] unit-test
+
+[ B{
+    0 0 0 0 
+    0 0 0 0 
+    0 0 0 0 
+    0 0 0 0 
+    57 57 57 255
+    0 0 0 0 
+} ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA f B{
+    0 0 0 0 
+    0 0 0 0 
+    0 0 0 0 
+    0 0 0 0 
+    0 0 0 0 
+    0 0 0 0 
+} } [ set-pixel-at ] keep bitmap>> ] unit-test
diff --git a/basis/images/images.factor b/basis/images/images.factor
index 178b91ab52..ed317b4685 100755
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@@ -1,6 +1,6 @@
-! Copyright (C) 2009 Doug Coleman.
+! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel accessors ;
+USING: combinators kernel accessors sequences math ;
 IN: images
 
 SINGLETONS: L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
@@ -35,3 +35,21 @@ TUPLE: image dim component-order upside-down? bitmap ;
 : has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
 
 GENERIC: load-image* ( path tuple -- image )
+
+<PRIVATE
+
+: pixel@ ( x y image -- start end bitmap )
+    [ dim>> second * + ]
+    [ component-order>> bytes-per-pixel [ * dup ] keep + ]
+    [ bitmap>> ] tri ;
+
+: set-subseq ( new-value from to victim -- )
+    <slice> 0 swap copy ; inline
+
+PRIVATE>
+
+: pixel-at ( x y image -- pixel )
+    pixel@ subseq ;
+
+: set-pixel-at ( pixel x y image -- )
+    pixel@ set-subseq ;

From 52017e22f39902fbe8c493d89744c9e275522fad Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@Macintosh-122.local>
Date: Mon, 1 Jun 2009 22:39:02 -0500
Subject: [PATCH 02/10] unbits word in math.bits vocab

---
 basis/math/bits/bits-docs.factor  | 6 +++++-
 basis/math/bits/bits-tests.factor | 3 +++
 basis/math/bits/bits.factor       | 3 +++
 3 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/basis/math/bits/bits-docs.factor b/basis/math/bits/bits-docs.factor
index 6ae83f7af0..36043a5576 100644
--- a/basis/math/bits/bits-docs.factor
+++ b/basis/math/bits/bits-docs.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup math ;
+USING: help.syntax help.markup math sequences ;
 IN: math.bits
 
 ABOUT: "math.bits"
@@ -24,3 +24,7 @@ HELP: make-bits
     { $example "USING: math.bits prettyprint arrays ;" "BIN: 1101 make-bits >array ." "{ t f t t }" }
     { $example "USING: math.bits prettyprint arrays ;" "-3 make-bits >array ." "{ t f }" }
 } ;
+
+HELP: unbits
+{ $values { "seq" sequence } { "number" integer } }
+{ $description "Turns a sequence of booleans, of the same format made by the " { $link bits } " class, and calculates the number that it represents as little-endian." } ;
diff --git a/basis/math/bits/bits-tests.factor b/basis/math/bits/bits-tests.factor
index b17d9d8b6e..c6f4c6e8fa 100644
--- a/basis/math/bits/bits-tests.factor
+++ b/basis/math/bits/bits-tests.factor
@@ -29,3 +29,6 @@ IN: math.bits.tests
 [ t ] [
     1067811677921310779 >bignum make-bits last
 ] unit-test
+
+[ 6 ] [ 6 make-bits unbits ] unit-test
+[ 6 ] [ 6 3 <bits> >array unbits ] unit-test
diff --git a/basis/math/bits/bits.factor b/basis/math/bits/bits.factor
index 72b83a991f..0fbfdf0bd9 100644
--- a/basis/math/bits/bits.factor
+++ b/basis/math/bits/bits.factor
@@ -14,3 +14,6 @@ M: bits length length>> ;
 M: bits nth-unsafe number>> swap bit? ;
 
 INSTANCE: bits immutable-sequence
+
+: unbits ( seq -- number )
+    <reversed> 0 [ [ 1 shift ] dip [ 1+ ] when ] reduce ;

From 2d231f066a09e322e4a35181db4d9415f080fe10 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 2 Jun 2009 18:23:47 -0500
Subject: [PATCH 03/10] GC checks now save and restore registers

---
 .../build-stack-frame.factor                  |  74 ++++++++++
 .../summary.txt                               |   0
 basis/compiler/cfg/builder/builder.factor     |   1 +
 basis/compiler/cfg/def-use/def-use.factor     |   2 +-
 basis/compiler/cfg/gc-checks/gc-checks.factor |   7 +-
 .../cfg/instructions/instructions.factor      |  12 +-
 .../linear-scan/assignment/assignment.factor  |  34 ++++-
 .../cfg/linearization/linearization.factor    |  55 +++++++-
 basis/compiler/cfg/mr/mr.factor               |   2 +-
 basis/compiler/cfg/stack-frame/authors.txt    |   1 +
 .../cfg/stack-frame/stack-frame.factor        | 107 +++++++--------
 basis/compiler/codegen/codegen.factor         |  19 ++-
 basis/cpu/architecture/architecture.factor    |  18 ++-
 basis/cpu/x86/64/64.factor                    |   4 +-
 basis/cpu/x86/x86.factor                      | 127 ++++++++++--------
 basis/heaps/heaps.factor                      |   3 +
 vm/data_gc.cpp                                |   8 +-
 vm/data_gc.hpp                                |   2 +-
 18 files changed, 319 insertions(+), 157 deletions(-)
 create mode 100644 basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
 rename basis/compiler/cfg/{stack-frame => build-stack-frame}/summary.txt (100%)
 create mode 100644 basis/compiler/cfg/stack-frame/authors.txt

diff --git a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
new file mode 100644
index 0000000000..e5be2d9eb9
--- /dev/null
+++ b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
@@ -0,0 +1,74 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces accessors math.order assocs kernel sequences
+combinators make classes words cpu.architecture
+compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.stack-frame ;
+IN: compiler.cfg.build-stack-frame
+
+SYMBOL: frame-required?
+
+SYMBOL: spill-counts
+
+GENERIC: compute-stack-frame* ( insn -- )
+
+: request-stack-frame ( stack-frame -- )
+    stack-frame [ max-stack-frame ] change ;
+
+M: ##stack-frame compute-stack-frame*
+    frame-required? on
+    stack-frame>> request-stack-frame ;
+
+M: ##call compute-stack-frame*
+    word>> sub-primitive>> [ frame-required? on ] unless ;
+
+M: _gc compute-stack-frame*
+    frame-required? on
+    stack-frame new swap gc-root-size>> >>gc-root-size
+    request-stack-frame ;
+
+M: _spill-counts compute-stack-frame*
+    counts>> stack-frame get (>>spill-counts) ;
+
+M: insn compute-stack-frame*
+    class frame-required? word-prop [
+        frame-required? on
+    ] when ;
+
+\ _spill t frame-required? set-word-prop
+\ ##fixnum-add t frame-required? set-word-prop
+\ ##fixnum-sub t frame-required? set-word-prop
+\ ##fixnum-mul t frame-required? set-word-prop
+\ ##fixnum-add-tail f frame-required? set-word-prop
+\ ##fixnum-sub-tail f frame-required? set-word-prop
+\ ##fixnum-mul-tail f frame-required? set-word-prop
+
+: compute-stack-frame ( insns -- )
+    frame-required? off
+    T{ stack-frame } clone stack-frame set
+    [ compute-stack-frame* ] each
+    stack-frame get dup stack-frame-size >>total-size drop ;
+
+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 ;
+
+M: ##epilogue insert-pro/epilogues*
+    drop frame-required? get [ stack-frame get _epilogue ] when ;
+
+M: insn insert-pro/epilogues* , ;
+
+: insert-pro/epilogues ( insns -- insns )
+    [ [ insert-pro/epilogues* ] each ] { } make ;
+
+: build-stack-frame ( mr -- mr )
+    [
+        [
+            [ compute-stack-frame ]
+            [ insert-pro/epilogues ]
+            bi
+        ] change-instructions
+    ] with-scope ;
diff --git a/basis/compiler/cfg/stack-frame/summary.txt b/basis/compiler/cfg/build-stack-frame/summary.txt
similarity index 100%
rename from basis/compiler/cfg/stack-frame/summary.txt
rename to basis/compiler/cfg/build-stack-frame/summary.txt
diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index 38075c24a3..d323263fc7 100755
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/basis/compiler/cfg/builder/builder.factor
@@ -15,6 +15,7 @@ compiler.cfg.iterator
 compiler.cfg.utilities
 compiler.cfg.registers
 compiler.cfg.intrinsics
+compiler.cfg.stack-frame
 compiler.cfg.instructions
 compiler.alien ;
 IN: compiler.cfg.builder
diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor
index 1484b3ec72..cdd767ef8d 100644
--- a/basis/compiler/cfg/def-use/def-use.factor
+++ b/basis/compiler/cfg/def-use/def-use.factor
@@ -31,6 +31,7 @@ M: ##compare-imm temp-vregs temp>> 1array ;
 M: ##compare-float temp-vregs temp>> 1array ;
 M: ##fixnum-mul temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
 M: ##fixnum-mul-tail temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
+M: ##gc temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
 M: _dispatch temp-vregs temp>> 1array ;
 M: insn temp-vregs drop f ;
 
@@ -51,7 +52,6 @@ M: ##alien-getter uses-vregs src>> 1array ;
 M: ##alien-setter uses-vregs [ src>> ] [ value>> ] bi 2array ;
 M: ##fixnum-overflow uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
 M: ##phi uses-vregs inputs>> ;
-M: ##gc uses-vregs live-in>> ;
 M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
 M: _compare-imm-branch uses-vregs src1>> 1array ;
 M: _dispatch uses-vregs src>> 1array ;
diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor
index 91e79ea2dd..4176914126 100644
--- a/basis/compiler/cfg/gc-checks/gc-checks.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks.factor
@@ -2,7 +2,8 @@
 ! 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.liveness compiler.cfg.instructions
+compiler.cfg.hats ;
 IN: compiler.cfg.gc-checks
 
 : gc? ( bb -- ? )
@@ -13,9 +14,7 @@ IN: compiler.cfg.gc-checks
 
 : insert-gc-check ( basic-block -- )
     dup gc? [
-        dup
-        [ swap object-pointer-regs \ ##gc new-insn prefix ]
-        change-instructions drop
+        [ i i f 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 314a66ba9c..fe853cf490 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -52,12 +52,6 @@ INSN: ##inc-d { n integer } ;
 INSN: ##inc-r { n integer } ;
 
 ! Subroutine calls
-TUPLE: stack-frame
-{ params integer }
-{ return integer }
-{ total-size integer }
-spill-counts ;
-
 INSN: ##stack-frame stack-frame ;
 INSN: ##call word { height integer } ;
 INSN: ##jump word ;
@@ -223,7 +217,7 @@ INSN: ##compare-imm < ##binary-imm cc temp ;
 INSN: ##compare-float-branch < ##conditional-branch ;
 INSN: ##compare-float < ##binary cc temp ;
 
-INSN: ##gc live-in ;
+INSN: ##gc { temp1 vreg } { temp2 vreg } live-registers live-spill-slots ;
 
 ! Instructions used by machine IR only.
 INSN: _prologue stack-frame ;
@@ -243,6 +237,10 @@ INSN: _compare-imm-branch label { src1 vreg } { src2 integer } cc ;
 
 INSN: _compare-float-branch < _conditional-branch ;
 
+TUPLE: spill-slot n ; C: <spill-slot> spill-slot
+
+INSN: _gc { temp1 vreg } { temp2 vreg } gc-roots gc-root-count gc-root-size ;
+
 ! These instructions operate on machine registers and not
 ! virtual registers
 INSN: _spill src class n ;
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index c7e3380f83..0de350c215 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -58,17 +58,34 @@ SYMBOL: unhandled-intervals
         ] [ 2drop ] if
     ] if ;
 
-GENERIC: assign-registers-in-insn ( insn -- )
+GENERIC: assign-before ( insn -- )
+
+GENERIC: assign-after ( insn -- )
 
 : all-vregs ( insn -- vregs )
     [ defs-vregs ] [ temp-vregs ] [ uses-vregs ] tri 3append ;
 
-M: vreg-insn assign-registers-in-insn
+M: vreg-insn assign-before
     active-intervals get seq>> over all-vregs '[ vreg>> _ member? ] filter
     [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc
     >>regs drop ;
 
-M: insn assign-registers-in-insn drop ;
+M: insn assign-before drop ;
+
+: compute-live-registers ( -- regs )
+    active-intervals get seq>> [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc ;
+
+: compute-live-spill-slots ( -- spill-slots )
+    unhandled-intervals get
+    heap-values [ reload-from>> ] filter
+    [ [ vreg>> ] [ reload-from>> ] bi ] { } map>assoc ;
+
+M: ##gc assign-after
+    compute-live-registers >>live-registers
+    compute-live-spill-slots >>live-spill-slots
+    drop ;
+
+M: insn assign-after drop ;
 
 : <active-intervals> ( -- obj )
     V{ } clone active-intervals boa ;
@@ -82,10 +99,13 @@ M: insn assign-registers-in-insn drop ;
     [
         [
             [
-                [ insn#>> activate-new-intervals ]
-                [ [ assign-registers-in-insn ] [ , ] bi ]
-                [ insn#>> expire-old-intervals ]
-                tri
+                {
+                    [ insn#>> activate-new-intervals ]
+                    [ assign-before ]
+                    [ , ]
+                    [ insn#>> expire-old-intervals ]
+                    [ assign-after ]
+                } cleave
             ] each
         ] V{ } make
     ] change-instructions drop ;
diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index 53ca56907d..9e222f1832 100755
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math accessors sequences namespaces make
-combinators assocs
-cpu.architecture
+combinators assocs arrays locals cpu.architecture
 compiler.cfg
 compiler.cfg.rpo
 compiler.cfg.liveness
+compiler.cfg.stack-frame
 compiler.cfg.instructions ;
 IN: compiler.cfg.linearization
 
@@ -68,6 +68,57 @@ M: ##dispatch linearize-insn
     [ successors>> [ number>> _dispatch-label ] each ]
     bi* ;
 
+: gc-root-registers ( n live-registers -- n )
+    [
+        [ second 2array , ]
+        [ first reg-class>> reg-size + ]
+        2bi
+    ] each ;
+
+: gc-root-spill-slots ( n live-spill-slots -- n )
+    [
+        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
+        ! 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
+        drop
+    ] { } make ;
+
+: count-gc-roots ( live-registers live-spill-slots -- n )
+    ! Size of GC root area, minus the float registers
+    [ oop-registers length ] bi@ + ;
+
+M: ##gc linearize-insn
+    nip
+    [
+        [ temp1>> ]
+        [ temp2>> ]
+        [
+            [ live-registers>> ] [ live-spill-slots>> ] bi
+            [ compute-gc-roots ]
+            [ count-gc-roots ]
+            [ gc-roots-size ]
+            2tri
+        ] tri
+        _gc
+    ] with-regs ;
+
 : linearize-basic-blocks ( cfg -- insns )
     [
         [ [ linearize-basic-block ] each-basic-block ]
diff --git a/basis/compiler/cfg/mr/mr.factor b/basis/compiler/cfg/mr/mr.factor
index 49f7c793e5..9f6a62090c 100644
--- a/basis/compiler/cfg/mr/mr.factor
+++ b/basis/compiler/cfg/mr/mr.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: compiler.cfg.linearization compiler.cfg.two-operand
 compiler.cfg.liveness compiler.cfg.gc-checks compiler.cfg.linear-scan
-compiler.cfg.stack-frame compiler.cfg.rpo ;
+compiler.cfg.build-stack-frame compiler.cfg.rpo ;
 IN: compiler.cfg.mr
 
 : build-mr ( cfg -- mr )
diff --git a/basis/compiler/cfg/stack-frame/authors.txt b/basis/compiler/cfg/stack-frame/authors.txt
new file mode 100644
index 0000000000..d4f5d6b3ae
--- /dev/null
+++ b/basis/compiler/cfg/stack-frame/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor
index fd11260f97..5cb5762b78 100644
--- a/basis/compiler/cfg/stack-frame/stack-frame.factor
+++ b/basis/compiler/cfg/stack-frame/stack-frame.factor
@@ -1,72 +1,55 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces accessors math.order assocs kernel sequences
-combinators make classes words cpu.architecture
-compiler.cfg.instructions compiler.cfg.registers ;
+USING: math math.order namespaces accessors kernel layouts combinators
+combinators.smart assocs sequences cpu.architecture ;
 IN: compiler.cfg.stack-frame
 
-SYMBOL: frame-required?
+TUPLE: stack-frame
+{ params integer }
+{ return integer }
+{ total-size integer }
+{ gc-root-size integer }
+spill-counts ;
 
-SYMBOL: spill-counts
+! Stack frame utilities
+: param-base ( -- n )
+    stack-frame get [ params>> ] [ return>> ] bi + ;
 
-GENERIC: compute-stack-frame* ( insn -- )
+: spill-float-offset ( n -- offset )
+    double-float-regs reg-size * ;
+
+: spill-integer-base ( -- n )
+    stack-frame get spill-counts>> double-float-regs [ swap at ] keep reg-size *
+    param-base + ;
+
+: spill-integer-offset ( n -- offset )
+    cells spill-integer-base + ;
+
+: spill-area-size ( stack-frame -- n )
+    spill-counts>> [ swap reg-size * ] { } assoc>map sum ;
+
+: gc-root-base ( -- n )
+    stack-frame get spill-area-size
+    param-base + ;
+
+: gc-root-offset ( n -- n' ) gc-root-base + ;
+
+: gc-roots-size ( live-registers live-spill-slots -- n )
+    [ keys [ reg-class>> reg-size ] sigma ] bi@ + ;
+
+: (stack-frame-size) ( stack-frame -- n )
+    [
+        {
+            [ spill-area-size ]
+            [ gc-root-size>> ]
+            [ params>> ]
+            [ return>> ]
+        } cleave
+    ] sum-outputs ;
 
 : max-stack-frame ( frame1 frame2 -- frame3 )
     [ stack-frame new ] 2dip
         [ [ params>> ] bi@ max >>params ]
         [ [ return>> ] bi@ max >>return ]
-        2bi ;
-
-M: ##stack-frame compute-stack-frame*
-    frame-required? on
-    stack-frame>> stack-frame [ max-stack-frame ] change ;
-
-M: ##call compute-stack-frame*
-    word>> sub-primitive>> [ frame-required? on ] unless ;
-
-M: _spill-counts compute-stack-frame*
-    counts>> stack-frame get (>>spill-counts) ;
-
-M: insn compute-stack-frame*
-    class frame-required? word-prop [
-        frame-required? on
-    ] when ;
-
-\ _spill t frame-required? set-word-prop
-\ ##gc t frame-required? set-word-prop
-\ ##fixnum-add t frame-required? set-word-prop
-\ ##fixnum-sub t frame-required? set-word-prop
-\ ##fixnum-mul t frame-required? set-word-prop
-\ ##fixnum-add-tail f frame-required? set-word-prop
-\ ##fixnum-sub-tail f frame-required? set-word-prop
-\ ##fixnum-mul-tail f frame-required? set-word-prop
-
-: compute-stack-frame ( insns -- )
-    frame-required? off
-    T{ stack-frame } clone stack-frame set
-    [ compute-stack-frame* ] each
-    stack-frame get dup stack-frame-size >>total-size drop ;
-
-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 ;
-
-M: ##epilogue insert-pro/epilogues*
-    drop frame-required? get [ stack-frame get _epilogue ] when ;
-
-M: insn insert-pro/epilogues* , ;
-
-: insert-pro/epilogues ( insns -- insns )
-    [ [ insert-pro/epilogues* ] each ] { } make ;
-
-: build-stack-frame ( mr -- mr )
-    [
-        [
-            [ compute-stack-frame ]
-            [ insert-pro/epilogues ]
-            bi
-        ] change-instructions
-    ] with-scope ;
+        [ [ gc-root-size>> ] bi@ max >>gc-root-size ]
+        2tri ;
\ No newline at end of file
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 3962902c62..7bdaace1db 100755
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -10,6 +10,7 @@ compiler.errors
 compiler.alien
 compiler.cfg
 compiler.cfg.instructions
+compiler.cfg.stack-frame
 compiler.cfg.registers
 compiler.cfg.builder
 compiler.codegen.fixup
@@ -234,7 +235,13 @@ M: ##write-barrier generate-insn
     [ table>> register ]
     tri %write-barrier ;
 
-M: ##gc generate-insn drop %gc ;
+M: _gc generate-insn
+    {
+        [ temp1>> register ]
+        [ temp2>> register ]
+        [ gc-roots>> ]
+        [ gc-root-count>> ]
+    } cleave %gc ;
 
 M: ##loop-entry generate-insn drop %loop-entry ;
 
@@ -243,16 +250,6 @@ M: ##alien-global generate-insn
     %alien-global ;
 
 ! ##alien-invoke
-GENERIC: reg-size ( register-class -- n )
-
-M: int-regs reg-size drop cell ;
-
-M: single-float-regs reg-size drop 4 ;
-
-M: double-float-regs reg-size drop 8 ;
-
-M: stack-params reg-size drop "void*" heap-size ;
-
 GENERIC: reg-class-variable ( register-class -- symbol )
 
 M: reg-class reg-class-variable ;
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index f7f91524c3..805ba4fd71 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -12,12 +12,22 @@ SINGLETON: double-float-regs
 UNION: float-regs single-float-regs double-float-regs ;
 UNION: reg-class int-regs float-regs ;
 
-! Mapping from register class to machine registers
-HOOK: machine-registers cpu ( -- assoc )
-
 ! A pseudo-register class for parameters spilled on the stack
 SINGLETON: stack-params
 
+GENERIC: reg-size ( register-class -- n )
+
+M: int-regs reg-size drop cell ;
+
+M: single-float-regs reg-size drop 4 ;
+
+M: double-float-regs reg-size drop 8 ;
+
+M: stack-params reg-size drop cell ;
+
+! Mapping from register class to machine registers
+HOOK: machine-registers cpu ( -- assoc )
+
 ! Return values of this class go here
 GENERIC: return-reg ( register-class -- reg )
 
@@ -119,7 +129,7 @@ HOOK: %alien-global cpu ( dst symbol library -- )
 
 HOOK: %allot cpu ( dst size class temp -- )
 HOOK: %write-barrier cpu ( src card# table -- )
-HOOK: %gc cpu ( -- )
+HOOK: %gc cpu ( temp1 temp2 live-registers live-spill-slots -- )
 
 HOOK: %prologue cpu ( n -- )
 HOOK: %epilogue cpu ( n -- )
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 0b9b4e8ddf..3a7221c239 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel math namespaces make sequences
 system layouts alien alien.c-types alien.accessors alien.structs
@@ -6,7 +6,7 @@ slots splitting assocs combinators locals cpu.x86.assembler
 cpu.x86 cpu.architecture compiler.constants
 compiler.codegen compiler.codegen.fixup
 compiler.cfg.instructions compiler.cfg.builder
-compiler.cfg.intrinsics ;
+compiler.cfg.intrinsics compiler.cfg.stack-frame ;
 IN: cpu.x86.64
 
 M: x86.64 machine-registers
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 1a2c2e3ee1..375ea32940 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -6,7 +6,7 @@ kernel kernel.private math memory namespaces make sequences
 words system layouts combinators math.order fry locals
 compiler.constants compiler.cfg.registers
 compiler.cfg.instructions compiler.cfg.intrinsics
-compiler.codegen compiler.codegen.fixup ;
+compiler.cfg.stack-frame compiler.codegen compiler.codegen.fixup ;
 IN: cpu.x86
 
 << enable-fixnum-log2 >>
@@ -17,6 +17,32 @@ M: label JUMPcc [ 0 ] dip JUMPcc rc-relative label-fixup ;
 
 M: x86 two-operand? t ;
 
+HOOK: stack-reg cpu ( -- reg )
+
+HOOK: reserved-area-size cpu ( -- n )
+
+: stack@ ( n -- op ) stack-reg swap [+] ;
+
+: param@ ( n -- op ) reserved-area-size + stack@ ;
+
+: spill-integer@ ( n -- op ) spill-integer-offset param@ ;
+
+: spill-float@ ( n -- op ) spill-float-offset param@ ;
+
+: gc-root@ ( n -- op ) gc-root-offset param@ ;
+
+: decr-stack-reg ( n -- )
+    dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
+
+: incr-stack-reg ( n -- )
+    dup 0 = [ drop ] [ stack-reg swap ADD ] if ;
+
+: align-stack ( n -- n' )
+    os macosx? cpu x86.64? or [ 16 align ] when ;
+
+M: x86 stack-frame-size ( stack-frame -- i )
+    (stack-frame-size) 3 cells reserved-area-size + + align-stack ;
+
 HOOK: temp-reg-1 cpu ( -- reg )
 HOOK: temp-reg-2 cpu ( -- reg )
 
@@ -45,20 +71,6 @@ M: x86 %replace loc>operand swap MOV ;
 M: x86 %inc-d ( n -- ) ds-reg (%inc) ;
 M: x86 %inc-r ( n -- ) rs-reg (%inc) ;
 
-: align-stack ( n -- n' )
-    os macosx? cpu x86.64? or [ 16 align ] when ;
-
-HOOK: reserved-area-size cpu ( -- n )
-
-M: x86 stack-frame-size ( stack-frame -- i )
-    [ spill-counts>> [ swap reg-size * ] { } assoc>map sum ]
-    [ params>> ]
-    [ return>> ]
-    tri + +
-    3 cells +
-    reserved-area-size +
-    align-stack ;
-
 M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ;
 
 : xt-tail-pic-offset ( -- n )
@@ -492,29 +504,58 @@ M:: x86 %write-barrier ( src card# table -- )
     table table [] MOV
     table card# [+] card-mark <byte> MOV ;
 
-M: x86 %gc ( -- )
-    "end" define-label
-    temp-reg-1 load-zone-ptr
-    temp-reg-2 temp-reg-1 cell [+] MOV
-    temp-reg-2 1024 ADD
-    temp-reg-1 temp-reg-1 3 cells [+] MOV
-    temp-reg-2 temp-reg-1 CMP
-    "end" get JLE
+:: check-nursery ( temp1 temp2 -- )
+    temp1 load-zone-ptr
+    temp2 temp1 cell [+] MOV
+    temp2 1024 ADD
+    temp1 temp1 3 cells [+] MOV
+    temp2 temp1 CMP ;
+
+GENERIC# save-gc-root 1 ( gc-root operand temp -- )
+
+M:: spill-slot save-gc-root ( gc-root spill-slot temp -- )
+    temp spill-slot n>> spill-integer@ MOV
+    gc-root gc-root@ temp MOV ;
+
+M:: word save-gc-root ( gc-root register temp -- )
+    gc-root gc-root@ register MOV ;
+
+: save-gc-roots ( gc-roots temp -- )
+    '[ _ save-gc-root ] assoc-each ;
+
+GENERIC# load-gc-root 1 ( gc-root operand temp -- )
+
+M:: spill-slot load-gc-root ( gc-root spill-slot temp -- )
+    temp gc-root gc-root@ MOV
+    spill-slot n>> spill-integer@ temp MOV ;
+
+M:: word load-gc-root ( gc-root register temp -- )
+    register gc-root gc-root@ MOV ;
+
+: load-gc-roots ( gc-roots temp -- )
+    '[ _ load-gc-root ] assoc-each ;
+
+:: call-gc ( gc-root-count -- )
+    ! Pass pointer to start of GC roots as first parameter
+    param-reg-1 gc-root-base param@ LEA
+    ! Pass number of roots as second parameter
+    param-reg-2 gc-root-count MOV
+    ! Call GC
     %prepare-alien-invoke
-    "minor_gc" f %alien-invoke
+    "inline_gc" f %alien-invoke ;
+
+M:: x86 %gc ( temp1 temp2 gc-roots gc-root-count -- )
+    "end" define-label
+    temp1 temp2 check-nursery
+    "end" get JLE
+    gc-roots temp1 save-gc-roots
+    gc-root-count call-gc
+    gc-roots temp1 load-gc-roots
     "end" resolve-label ;
 
 M: x86 %alien-global
     [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
 
-HOOK: stack-reg cpu ( -- reg )
-
-: decr-stack-reg ( n -- )
-    dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
-
-: incr-stack-reg ( n -- )
-    dup 0 = [ drop ] [ stack-reg swap ADD ] if ;
-
 M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
 
 :: %boolean ( dst temp word -- )
@@ -568,28 +609,6 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
         { cc/= [ JNE ] }
     } case ;
 
-: stack@ ( n -- op ) stack-reg swap [+] ;
-
-: param@ ( n -- op ) reserved-area-size + stack@ ;
-
-: spill-integer-base ( stack-frame -- n )
-    [ params>> ] [ return>> ] bi + reserved-area-size + ;
-
-: spill-integer@ ( n -- op )
-    cells
-    stack-frame get spill-integer-base
-    + stack@ ;
-
-: spill-float-base ( stack-frame -- n )
-    [ spill-integer-base ]
-    [ spill-counts>> int-regs swap at int-regs reg-size * ]
-    bi + ;
-
-: spill-float@ ( n -- op )
-    double-float-regs reg-size *
-    stack-frame get spill-float-base
-    + stack@ ;
-
 M: x86 %spill-integer ( src n -- ) spill-integer@ swap MOV ;
 M: x86 %reload-integer ( dst n -- ) spill-integer@ MOV ;
 
diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor
index f2ccaad1b4..becfb6826d 100644
--- a/basis/heaps/heaps.factor
+++ b/basis/heaps/heaps.factor
@@ -192,6 +192,9 @@ M: heap heap-pop ( heap -- value key )
     [ dup heap-pop swap 2array ]
     produce nip ;
 
+: heap-values ( heap -- alist )
+    data>> [ value>> ] { } map-as ;
+
 : slurp-heap ( heap quot: ( elt -- ) -- )
     over heap-empty? [ 2drop ] [
         [ [ heap-pop drop ] dip call ] [ slurp-heap ] 2bi
diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index bcf6387639..6631a046ac 100755
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -680,9 +680,15 @@ PRIMITIVE(become)
 	compile_all_words();
 }
 
-VM_C_API void minor_gc()
+VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size)
 {
+	for(cell i = 0; i < gc_roots_size; i++)
+		gc_local_push((cell)&gc_roots_base[i]);
+
 	garbage_collection(data->nursery(),false,0);
+
+	for(cell i = 0; i < gc_roots_size; i++)
+		gc_local_pop();
 }
 
 }
diff --git a/vm/data_gc.hpp b/vm/data_gc.hpp
index 2d6a1ab897..334ad5a2bb 100755
--- a/vm/data_gc.hpp
+++ b/vm/data_gc.hpp
@@ -143,6 +143,6 @@ inline static void check_tagged_pointer(cell tagged)
 #endif
 }
 
-VM_C_API void minor_gc();
+VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size);
 
 }

From ba5b582e0174f691a7dc630f28f3ce163aa32996 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@pool-116-90.res.carleton.edu>
Date: Tue, 2 Jun 2009 20:39:51 -0500
Subject: [PATCH 04/10] Redoing images.loader to work with jpeg

---
 basis/images/bitmap/bitmap.factor |  4 +++-
 basis/images/images.factor        | 11 +++++++++--
 basis/images/jpeg/jpeg.factor     |  4 +++-
 basis/images/loader/loader.factor | 24 ++++++++++++------------
 basis/images/png/png.factor       |  5 ++++-
 basis/images/tiff/tiff.factor     |  5 ++++-
 basis/ui/images/images.factor     |  4 ++--
 7 files changed, 37 insertions(+), 20 deletions(-)

diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor
index 48095bb26b..04a4fae77e 100755
--- a/basis/images/bitmap/bitmap.factor
+++ b/basis/images/bitmap/bitmap.factor
@@ -3,7 +3,7 @@
 USING: accessors alien alien.c-types arrays byte-arrays columns
 combinators fry grouping io io.binary io.encodings.binary io.files
 kernel macros math math.bitwise math.functions namespaces sequences
-strings images endian summary locals ;
+strings images endian summary locals images.loader ;
 IN: images.bitmap
 
 : assert-sequence= ( a b -- )
@@ -129,6 +129,8 @@ ERROR: unknown-component-order bitmap ;
 M: bitmap-image load-image* ( path loading-bitmap -- bitmap )
     swap load-bitmap-data loading-bitmap>bitmap-image ;
 
+"bmp" bitmap-image register-image-class
+
 PRIVATE>
 
 : bitmap>color-index ( bitmap -- byte-array )
diff --git a/basis/images/images.factor b/basis/images/images.factor
index ed317b4685..62c4f7e2ed 100755
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel accessors sequences math ;
+USING: combinators kernel accessors sequences math arrays ;
 IN: images
 
 SINGLETONS: L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
@@ -36,10 +36,17 @@ TUPLE: image dim component-order upside-down? bitmap ;
 
 GENERIC: load-image* ( path tuple -- image )
 
+: make-image ( bitmap -- image )
+    ! bitmap is a sequence of sequences of pixels which are RGBA
+    <image>
+        over [ first length ] [ length ] bi 2array >>dim
+        RGBA >>component-order
+        swap concat concat B{ } like >>bitmap ;
+
 <PRIVATE
 
 : pixel@ ( x y image -- start end bitmap )
-    [ dim>> second * + ]
+    [ dim>> first * + ]
     [ component-order>> bytes-per-pixel [ * dup ] keep + ]
     [ bitmap>> ] tri ;
 
diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor
index 648923704a..9d44aa1187 100755
--- a/basis/images/jpeg/jpeg.factor
+++ b/basis/images/jpeg/jpeg.factor
@@ -6,7 +6,7 @@ images.processing io io.binary io.encodings.binary io.files
 io.streams.byte-array kernel locals math math.bitwise
 math.constants math.functions math.matrices math.order
 math.ranges math.vectors memoize multiline namespaces
-sequences sequences.deep ;
+sequences sequences.deep images.loader ;
 IN: images.jpeg
 
 QUALIFIED-WITH: bitstreams bs
@@ -302,3 +302,5 @@ PRIVATE>
 
 M: jpeg-image load-image* ( path jpeg-image -- bitmap )
     drop load-jpeg ;
+
+{ "jpg" "jpeg" } [ jpeg-image register-image-class ] each
diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor
index d86b275635..19f2fd12c8 100644
--- a/basis/images/loader/loader.factor
+++ b/basis/images/loader/loader.factor
@@ -1,22 +1,22 @@
-! Copyright (C) 2009 Doug Coleman.
+! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: constructors kernel splitting unicode.case combinators
-accessors images.bitmap images.tiff images io.pathnames
-images.png ;
+accessors images io.pathnames namespaces assocs ;
 IN: images.loader
 
 ERROR: unknown-image-extension extension ;
 
+<PRIVATE
+SYMBOL: types
+types [ H{ } clone ] initialize
+
 : image-class ( path -- class )
-    file-extension >lower {
-        { "bmp" [ bitmap-image ] }
-        { "tif" [ tiff-image ] }
-        { "tiff" [ tiff-image ] }
-        ! { "jpg" [ jpeg-image ] }
-        ! { "jpeg" [ jpeg-image ] }
-        { "png" [ png-image ] }
-        [ unknown-image-extension ]
-    } case ;
+    file-extension >lower types get ?at
+    [ unknown-image-extension ] unless ;
+PRIVATE>
+
+: register-image-class ( extension class -- )
+    swap types get set-at ;
 
 : load-image ( path -- image )
     dup image-class new load-image* ;
diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index c5b84de221..d4b284142f 100755
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -3,7 +3,8 @@
 USING: accessors constructors images io io.binary io.encodings.ascii
 io.encodings.binary io.encodings.string io.files io.files.info kernel
 sequences io.streams.limited fry combinators arrays math
-checksums checksums.crc32 compression.inflate grouping byte-arrays ;
+checksums checksums.crc32 compression.inflate grouping byte-arrays
+images.loader ;
 IN: images.png
 
 TUPLE: png-image < image chunks
@@ -115,3 +116,5 @@ ERROR: unimplemented-color-type image ;
 
 M: png-image load-image*
     drop load-png ;
+
+"png" png-image register-image-class
diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor
index 27dc25de73..c98f737b11 100755
--- a/basis/images/tiff/tiff.factor
+++ b/basis/images/tiff/tiff.factor
@@ -5,7 +5,8 @@ compression.lzw constructors endian fry grouping images io
 io.binary io.encodings.ascii io.encodings.binary
 io.encodings.string io.encodings.utf8 io.files kernel math
 math.bitwise math.order math.parser pack prettyprint sequences
-strings math.vectors specialized-arrays.float locals ;
+strings math.vectors specialized-arrays.float locals
+images.loader ;
 IN: images.tiff
 
 TUPLE: tiff-image < image ;
@@ -561,3 +562,5 @@ ERROR: unknown-component-order ifd ;
 ! tiff files can store several images -- we just take the first for now
 M: tiff-image load-image* ( path tiff-image -- image )
     drop load-tiff tiff>image ;
+
+{ "tif" "tiff" } [ tiff-image register-image-class ] each
diff --git a/basis/ui/images/images.factor b/basis/ui/images/images.factor
index 2b1caa8ab9..519217a644 100755
--- a/basis/ui/images/images.factor
+++ b/basis/ui/images/images.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces cache images images.loader accessors assocs
 kernel opengl opengl.gl opengl.textures ui.gadgets.worlds
-memoize ;
+memoize images.tiff ;
 IN: ui.images
 
 TUPLE: image-name path ;
@@ -29,4 +29,4 @@ PRIVATE>
     rendered-image draw-scaled-texture ;
 
 : image-dim ( image-name -- dim )
-    cached-image dim>> ;
\ No newline at end of file
+    cached-image dim>> ;

From 8ec2e12b221d29d6a110239271e8f0f31043d7a2 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <littledan@pool-116-90.res.carleton.edu>
Date: Tue, 2 Jun 2009 21:17:45 -0500
Subject: [PATCH 05/10] fixing images unit test

---
 basis/images/images-tests.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/basis/images/images-tests.factor b/basis/images/images-tests.factor
index 39e8b4a364..8918dcb38c 100644
--- a/basis/images/images-tests.factor
+++ b/basis/images/images-tests.factor
@@ -7,18 +7,18 @@ IN: images.tests
     0 0 0 0 
     0 0 0 0 
     0 0 0 0 
-    0 0 0 0 
     57 57 57 255
     0 0 0 0 
+    0 0 0 0 
 } } pixel-at ] unit-test
 
 [ B{
     0 0 0 0 
     0 0 0 0 
     0 0 0 0 
-    0 0 0 0 
     57 57 57 255
     0 0 0 0 
+    0 0 0 0 
 } ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA f B{
     0 0 0 0 
     0 0 0 0 

From 367623e375a07a64b21817084a80703a3410e874 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Tue, 2 Jun 2009 23:20:07 -0500
Subject: [PATCH 06/10] report unhandled compression modes

---
 basis/images/bitmap/bitmap.factor | 34 +++++++++++++++++++++++--------
 1 file changed, 25 insertions(+), 9 deletions(-)

diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor
index 04a4fae77e..998cf54075 100755
--- a/basis/images/bitmap/bitmap.factor
+++ b/basis/images/bitmap/bitmap.factor
@@ -21,7 +21,8 @@ TUPLE: bitmap-image < image ;
 TUPLE: loading-bitmap 
 size reserved offset header-length width
 height planes bit-count compression size-image
-x-pels y-pels color-used color-important rgb-quads color-index ;
+x-pels y-pels color-used color-important color-palette color-index
+uncompressed-bytes ;
 
 ERROR: bitmap-magic magic ;
 
@@ -31,7 +32,7 @@ M: bitmap-magic summary
 <PRIVATE
 
 : 8bit>buffer ( bitmap -- array )
-    [ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]
+    [ color-palette>> 4 <sliced-groups> [ 3 head-slice ] map ]
     [ color-index>> >array ] bi [ swap nth ] with map concat ;
 
 ERROR: bmp-not-supported n ;
@@ -39,7 +40,7 @@ ERROR: bmp-not-supported n ;
 : reverse-lines ( byte-array width -- byte-array )
     <sliced-groups> <reversed> concat ; inline
 
-: raw-bitmap>seq ( loading-bitmap -- array )
+: bitmap>bytes ( loading-bitmap -- array )
     dup bit-count>>
     {
         { 32 [ color-index>> ] }
@@ -48,6 +49,21 @@ ERROR: bmp-not-supported n ;
         [ bmp-not-supported ]
     } case >byte-array ;
 
+ERROR: unsupported-bitmap-compression compression ;
+
+: uncompress-bitmap ( loading-bitmap -- loading-bitmap' )
+    dup compression>> {
+        { 0 [ ] }
+        { 1 [ "run-length encoding 8" unsupported-bitmap-compression ] }
+        { 2 [ "run-length encoding 4" unsupported-bitmap-compression ] }
+        { 3 [ "bitfields" unsupported-bitmap-compression ] }
+        { 4 [ "jpeg" unsupported-bitmap-compression ] }
+        { 5 [ "png" unsupported-bitmap-compression ] }
+    } case ;
+
+: loading-bitmap>bytes ( loading-bitmap -- byte-array )
+    uncompress-bitmap bitmap>bytes ;
+
 : parse-file-header ( loading-bitmap -- loading-bitmap )
     2 read "BM" assert-sequence=
     read4 >>size
@@ -67,7 +83,7 @@ ERROR: bmp-not-supported n ;
     read4 >>color-used
     read4 >>color-important ;
 
-: rgb-quads-length ( loading-bitmap -- n )
+: color-palette-length ( loading-bitmap -- n )
     [ offset>> 14 - ] [ header-length>> ] bi - ;
 
 : color-index-length ( loading-bitmap -- n )
@@ -98,11 +114,11 @@ ERROR: bmp-not-supported n ;
     ] when ;
 
 : parse-bitmap ( loading-bitmap -- loading-bitmap )
-    dup rgb-quads-length read >>rgb-quads
+    dup color-palette-length read >>color-palette
     dup color-index-length read >>color-index
     fixup-color-index ;
 
-: load-bitmap-data ( path -- loading-bitmap )
+: load-bitmap ( path -- loading-bitmap )
     binary [
         loading-bitmap new
         parse-file-header parse-bitmap-header parse-bitmap
@@ -120,14 +136,14 @@ ERROR: unknown-component-order bitmap ;
 
 : loading-bitmap>bitmap-image ( bitmap-image loading-bitmap -- bitmap-image )
     {
-        [ raw-bitmap>seq >>bitmap ]
+        [ loading-bitmap>bytes >>bitmap ]
         [ [ width>> ] [ height>> abs ] bi 2array >>dim ]
         [ height>> 0 < [ t >>upside-down? ] when ]
         [ bitmap>component-order >>component-order ]
     } cleave ;
 
 M: bitmap-image load-image* ( path loading-bitmap -- bitmap )
-    swap load-bitmap-data loading-bitmap>bitmap-image ;
+    swap load-bitmap loading-bitmap>bitmap-image ;
 
 "bmp" bitmap-image register-image-class
 
@@ -185,7 +201,7 @@ PRIVATE>
                 ! color-important
                 [ drop 0 write4 ]
 
-                ! rgb-quads
+                ! color-palette
                 [
                     [ bitmap>color-index ]
                     [ dim>> first 3 * ]

From f31c3f867a9a5966234d557d5a647c50d44076ec Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Tue, 2 Jun 2009 23:29:04 -0500
Subject: [PATCH 07/10] support run-length encoding in bitmaps

---
 basis/compression/run-length/run-length.factor | 7 +++++++
 basis/images/bitmap/bitmap.factor              | 9 +++++----
 2 files changed, 12 insertions(+), 4 deletions(-)
 create mode 100644 basis/compression/run-length/run-length.factor

diff --git a/basis/compression/run-length/run-length.factor b/basis/compression/run-length/run-length.factor
new file mode 100644
index 0000000000..d281b0718a
--- /dev/null
+++ b/basis/compression/run-length/run-length.factor
@@ -0,0 +1,7 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays grouping sequences ;
+IN: compression.run-length
+
+: run-length-uncompress8 ( byte-array -- byte-array' )
+    2 group [ first2 <array> ] map concat ;
diff --git a/basis/images/bitmap/bitmap.factor b/basis/images/bitmap/bitmap.factor
index 998cf54075..8bf8d59944 100755
--- a/basis/images/bitmap/bitmap.factor
+++ b/basis/images/bitmap/bitmap.factor
@@ -1,9 +1,10 @@
 ! Copyright (C) 2007, 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types arrays byte-arrays columns
-combinators fry grouping io io.binary io.encodings.binary io.files
-kernel macros math math.bitwise math.functions namespaces sequences
-strings images endian summary locals images.loader ;
+combinators compression.run-length endian fry grouping images
+images.loader io io.binary io.encodings.binary io.files kernel
+locals macros math math.bitwise math.functions namespaces
+sequences strings summary ;
 IN: images.bitmap
 
 : assert-sequence= ( a b -- )
@@ -54,7 +55,7 @@ ERROR: unsupported-bitmap-compression compression ;
 : uncompress-bitmap ( loading-bitmap -- loading-bitmap' )
     dup compression>> {
         { 0 [ ] }
-        { 1 [ "run-length encoding 8" unsupported-bitmap-compression ] }
+        { 1 [ [ run-length-uncompress8 ] change-color-index ] }
         { 2 [ "run-length encoding 4" unsupported-bitmap-compression ] }
         { 3 [ "bitfields" unsupported-bitmap-compression ] }
         { 4 [ "jpeg" unsupported-bitmap-compression ] }

From 6d04bf9c4a230f79ed6c240ee76fcde55a74c0b3 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 3 Jun 2009 03:22:27 -0500
Subject: [PATCH 08/10] Linear scan: build live ranges

---
 basis/compiler/cfg/def-use/def-use.factor     |   8 --
 .../cfg/linear-scan/linear-scan-tests.factor  |  21 +---
 .../live-intervals/live-intervals.factor      | 106 ++++++++++++++----
 3 files changed, 86 insertions(+), 49 deletions(-)

diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor
index cdd767ef8d..4ff9814e6d 100644
--- a/basis/compiler/cfg/def-use/def-use.factor
+++ b/basis/compiler/cfg/def-use/def-use.factor
@@ -8,14 +8,6 @@ GENERIC: temp-vregs ( insn -- seq )
 GENERIC: uses-vregs ( insn -- seq )
 
 M: ##flushable defs-vregs dst>> 1array ;
-M: ##unary/temp defs-vregs dst>> 1array ;
-M: ##allot defs-vregs dst>> 1array ;
-M: ##slot defs-vregs dst>> 1array ;
-M: ##set-slot defs-vregs temp>> 1array ;
-M: ##string-nth defs-vregs dst>> 1array ;
-M: ##compare defs-vregs dst>> 1array ;
-M: ##compare-imm defs-vregs dst>> 1array ;
-M: ##compare-float defs-vregs dst>> 1array ;
 M: insn defs-vregs drop f ;
 
 M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ;
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index 030d8503e9..e0cbe3774f 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -242,11 +242,12 @@ SYMBOL: max-uses
         max-insns get [ 0 ] replicate taken set
         max-insns get [ dup ] H{ } map>assoc available set
         [
-            live-interval new
+            \ live-interval new
                 swap int-regs swap vreg boa >>vreg
                 max-uses get random 2 max [ not-taken ] replicate natural-sort
                 [ >>uses ] [ first >>start ] bi
                 dup uses>> last >>end
+                dup [ start>> ] [ end>> ] bi <live-range> 1vector >>ranges
         ] map
     ] with-scope ;
 
@@ -271,24 +272,6 @@ USING: math.private compiler.cfg.debugger ;
     test-cfg first optimize-cfg linear-scan drop
 ] unit-test
 
-[ f ] [
-    T{ basic-block
-       { instructions
-         V{
-             T{ ##allot
-                f
-                T{ vreg f int-regs 1 }
-                40
-                array
-                T{ vreg f int-regs 2 }
-                f
-             }
-         }
-       }
-    } clone [ [ clone ] map ] change-instructions
-    dup 1array (linear-scan) instructions>> first regs>> values all-equal?
-] unit-test
-
 [ 0 1 ] [
     {
         T{ live-interval
diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index 55bcdc7470..78ac9428d8 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -1,26 +1,56 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces kernel assocs accessors sequences math fry
+USING: namespaces kernel assocs accessors sequences math math.order fry
 compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.def-use ;
+compiler.cfg.def-use compiler.cfg.liveness compiler.cfg ;
 IN: compiler.cfg.linear-scan.live-intervals
 
+TUPLE: live-range from to ;
+
+C: <live-range> live-range
+
 TUPLE: live-interval
 vreg
 reg spill-to reload-from split-before split-after
-start end uses
+start end ranges uses
 copy-from ;
 
-: add-use ( n live-interval -- )
-    dup live-interval? [ "No def" throw ] unless
-    [ (>>end) ] [ uses>> push ] 2bi ;
+ERROR: dead-value-error vreg ;
 
-: <live-interval> ( start vreg -- live-interval )
-    live-interval new
+: shorten-range ( n live-interval -- )
+    dup ranges>> empty?
+    [ vreg>> dead-value-error ] [ ranges>> last (>>from) ] if ;
+
+: extend-range ( from to live-range -- )
+    ranges>> last
+    [ max ] change-to
+    [ min ] change-from
+    drop ;
+
+: add-new-range ( from to live-interval -- )
+    [ <live-range> ] dip ranges>> push ;
+
+: extend-range? ( to live-interval -- ? )
+    ranges>> [ drop f ] [ last from>> >= ] if-empty ;
+
+: add-range ( from to live-interval -- )
+    2dup extend-range?
+    [ extend-range ] [ add-new-range ] if ;
+
+: add-use ( n live-interval -- )
+    uses>> push ;
+
+: <live-interval> ( vreg -- live-interval )
+    \ live-interval new
         V{ } clone >>uses
-        swap >>vreg
-        over >>start
-        [ add-use ] keep ;
+        V{ } clone >>ranges
+        swap >>vreg ;
+
+: block-from ( -- n )
+    basic-block get instructions>> first insn#>> ;
+
+: block-to ( -- n )
+    basic-block get instructions>> last insn#>> ;
 
 M: live-interval hashcode*
     nip [ start>> ] [ end>> 1000 * ] bi + ;
@@ -31,23 +61,31 @@ M: live-interval clone
 ! Mapping from vreg to live-interval
 SYMBOL: live-intervals
 
-: new-live-interval ( n vreg live-intervals -- )
-    2dup key? [
-        at add-use
-    ] [
-        [ [ <live-interval> ] keep ] dip set-at
-    ] if ;
+: live-interval ( vreg live-intervals -- live-interval )
+    [ <live-interval> ] cache ;
 
 GENERIC: compute-live-intervals* ( insn -- )
 
 M: insn compute-live-intervals* drop ;
 
+: handle-output ( n vreg live-intervals -- )
+    live-interval
+    [ add-use ] [ shorten-range ] 2bi ;
+
+: handle-input ( n vreg live-intervals -- )
+    live-interval
+    [ [ block-from ] 2dip add-range ] [ add-use ] 2bi ;
+
+: handle-temp ( n vreg live-intervals -- )
+    live-interval
+    [ dupd add-range ] [ add-use ] 2bi ;
+
 M: vreg-insn compute-live-intervals*
     dup insn#>>
     live-intervals get
-    [ [ uses-vregs ] 2dip '[ _ swap _ at add-use ] each ]
-    [ [ defs-vregs ] 2dip '[ _ swap _ new-live-interval ] each ]
-    [ [ temp-vregs ] 2dip '[ _ swap _ new-live-interval ] each ]
+    [ [ defs-vregs ] 2dip '[ [ _ ] dip _ handle-output ] each ]
+    [ [ uses-vregs ] 2dip '[ [ _ ] dip _ handle-input ] each ]
+    [ [ temp-vregs ] 2dip '[ [ _ ] dip _ handle-temp ] each ]
     3tri ;
 
 : record-copy ( insn -- )
@@ -59,8 +97,32 @@ M: ##copy compute-live-intervals*
 M: ##copy-float compute-live-intervals*
     [ call-next-method ] [ record-copy ] bi ;
 
+: handle-live-out ( bb -- )
+    live-out keys block-from block-to live-intervals get '[
+        [ _ _ ] dip _ live-interval add-range
+    ] each ;
+
+: compute-live-intervals-step ( bb -- )
+    [ basic-block set ]
+    [ handle-live-out ]
+    [ instructions>> <reversed> [ compute-live-intervals* ] each ] tri ;
+
+: compute-start/end ( live-interval -- )
+    dup ranges>> [ first from>> ] [ last to>> ] bi
+    [ >>start ] [ >>end ] bi* drop ;
+
+: finish-live-intervals ( live-intervals -- )
+    ! Since live intervals are computed in a backward order, we have
+    ! to reverse some sequences, and compute the start and end.
+    [
+        [ ranges>> reverse-here ]
+        [ uses>> reverse-here ]
+        [ compute-start/end ]
+        tri
+    ] each ;
+
 : compute-live-intervals ( rpo -- live-intervals )
     H{ } clone [
         live-intervals set
-        [ instructions>> [ compute-live-intervals* ] each ] each
-    ] keep values ;
+        <reversed> [ compute-live-intervals-step ] each
+    ] keep values dup finish-live-intervals ;

From ade5db24059a6877b3bdfacda2e0a604b900f1fa Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 3 Jun 2009 03:22:46 -0500
Subject: [PATCH 09/10] cpu.x86: fix small register intrinsics on x86-64

---
 basis/compiler/tests/codegen.factor |  9 +++++-
 basis/cpu/x86/x86.factor            | 45 +++++++++++++++++++++--------
 2 files changed, 41 insertions(+), 13 deletions(-)

diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index e0bc917f1c..47c6fa31e7 100644
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -2,7 +2,7 @@ USING: generalizations accessors arrays compiler kernel kernel.private
 math hashtables.private math.private namespaces sequences tools.test
 namespaces.private slots.private sequences.private byte-arrays alien
 alien.accessors layouts words definitions compiler.units io
-combinators vectors grouping make ;
+combinators vectors grouping make alien.c-types ;
 QUALIFIED: namespaces.private
 IN: compiler.tests.codegen
 
@@ -282,3 +282,10 @@ TUPLE: cucumber ;
 M: cucumber equal? "The cucumber has no equal" throw ;
 
 [ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test
+
+[ 4294967295 B{ 255 255 255 255 } -1 ]
+[
+    -1 <int> -1 <int>
+    [ [ 0 alien-unsigned-cell swap ] [ 0 alien-signed-2 ] bi ]
+    compile-call
+] unit-test
\ No newline at end of file
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 375ea32940..ef353281e5 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -327,17 +327,29 @@ M:: x86 %box-alien ( dst src temp -- )
         "end" resolve-label
     ] with-scope ;
 
-: small-reg-4 ( reg -- reg' )
+: small-reg-8 ( reg -- reg' )
     H{
-        { EAX EAX }
-        { ECX ECX }
-        { EDX EDX }
-        { EBX EBX }
-        { ESP ESP }
-        { EBP EBP }
-        { ESI ESP }
-        { EDI EDI }
+        { EAX RAX }
+        { ECX RCX }
+        { EDX RDX }
+        { EBX RBX }
+        { ESP RSP }
+        { EBP RBP }
+        { ESI RSP }
+        { EDI RDI }
 
+        { RAX RAX }
+        { RCX RCX }
+        { RDX RDX }
+        { RBX RBX }
+        { RSP RSP }
+        { RBP RBP }
+        { RSI RSP }
+        { RDI RDI }
+    } at ; inline
+
+: small-reg-4 ( reg -- reg' )
+    small-reg-8 H{
         { RAX EAX }
         { RCX ECX }
         { RDX EDX }
@@ -373,12 +385,21 @@ M:: x86 %box-alien ( dst src temp -- )
         { 1 [ small-reg-1 ] }
         { 2 [ small-reg-2 ] }
         { 4 [ small-reg-4 ] }
+        { 8 [ small-reg-8 ] }
     } case ;
 
-: small-regs ( -- regs ) { EAX ECX EDX EBX } ; inline
+HOOK: small-regs cpu ( -- regs )
+
+M: x86.32 small-regs { EAX ECX EDX EBX } ;
+M: x86.64 small-regs { RAX RCX RDX RBX } ;
+
+HOOK: small-reg-native cpu ( reg -- reg' )
+
+M: x86.32 small-reg-native small-reg-4 ;
+M: x86.64 small-reg-native small-reg-8 ;
 
 : small-reg-that-isn't ( exclude -- reg' )
-    small-regs swap [ small-reg-4 ] map '[ _ memq? not ] find nip ;
+    small-regs swap [ small-reg-native ] map '[ _ memq? not ] find nip ;
 
 : with-save/restore ( reg quot -- )
     [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline
@@ -388,7 +409,7 @@ M:: x86 %box-alien ( dst src temp -- )
     #! call the quot with that. Otherwise, we find a small
     #! register that is not in exclude, and call quot, saving
     #! and restoring the small register.
-    dst small-reg-4 small-regs memq? [ dst quot call ] [
+    dst small-reg-native small-regs memq? [ dst quot call ] [
         exclude small-reg-that-isn't
         [ quot call ] with-save/restore
     ] if ; inline

From 49f670be05afdf94830c23f2df8cc92d2511c7e9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 3 Jun 2009 03:23:55 -0500
Subject: [PATCH 10/10] Fix 32-bit bootstrap

---
 basis/cpu/x86/32/32.factor | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index cf84b083fe..b591b254f8 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -3,10 +3,11 @@
 USING: locals alien.c-types alien.syntax arrays kernel
 math namespaces sequences system layouts io vocabs.loader
 accessors init combinators command-line cpu.x86.assembler
-cpu.x86 cpu.architecture compiler compiler.units
+cpu.x86 cpu.architecture make compiler compiler.units
 compiler.constants compiler.alien compiler.codegen
 compiler.codegen.fixup compiler.cfg.instructions
-compiler.cfg.builder compiler.cfg.intrinsics make ;
+compiler.cfg.builder compiler.cfg.intrinsics
+compiler.cfg.stack-frame ;
 IN: cpu.x86.32
 
 ! We implement the FFI for Linux, OS X and Windows all at once.