From e6e313eba9367db5c2041b9c6c5cb7d7a525f3cb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 7 Oct 2008 16:42:11 -0500
Subject: [PATCH] Backend updates

---
 basis/cpu/architecture/architecture.factor    |  42 +-
 basis/cpu/x86/32/32.factor                    |   2 -
 basis/cpu/x86/64/64.factor                    |   2 -
 basis/cpu/x86/allot/allot.factor              | 216 +++---
 .../cpu/x86/architecture/architecture.factor  |  61 +-
 basis/cpu/x86/intrinsics/intrinsics.factor    | 308 +++------
 basis/cpu/x86/sse2/sse2.factor                |   9 +-
 unfinished/compiler/backend/backend.factor    | 189 -----
 unfinished/compiler/backend/x86/32/32.factor  | 318 ---------
 unfinished/compiler/backend/x86/64/64.factor  | 226 ------
 .../compiler/backend/x86/sse2/sse2.factor     | 106 ---
 unfinished/compiler/backend/x86/x86.factor    | 643 ------------------
 12 files changed, 235 insertions(+), 1887 deletions(-)
 delete mode 100644 unfinished/compiler/backend/backend.factor
 delete mode 100644 unfinished/compiler/backend/x86/32/32.factor
 delete mode 100644 unfinished/compiler/backend/x86/64/64.factor
 delete mode 100644 unfinished/compiler/backend/x86/sse2/sse2.factor
 delete mode 100644 unfinished/compiler/backend/x86/x86.factor

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 9e2b4def17..c5e8c88988 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -5,12 +5,15 @@ memory namespaces make sequences layouts system hashtables
 classes alien byte-arrays combinators words sets ;
 IN: cpu.architecture
 
-! Register classes
-SINGLETON: int-regs
-SINGLETON: single-float-regs
-SINGLETON: double-float-regs
-UNION: float-regs single-float-regs double-float-regs ;
-UNION: reg-class int-regs float-regs ;
+! Labels
+TUPLE: label offset ;
+
+: <label> ( -- label ) label new ;
+: define-label ( name -- ) <label> swap set ;
+: resolve-label ( label/name -- ) dup label? [ get ] unless , ;
+
+! 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
@@ -29,7 +32,7 @@ M: object param-reg param-regs nth ;
 GENERIC: vregs ( register-class -- regs )
 
 ! Load a literal (immediate or indirect)
-GENERIC# load-literal 1 ( obj vreg -- )
+GENERIC# load-literal 1 ( obj reg -- )
 
 HOOK: load-indirect cpu ( obj reg -- )
 
@@ -40,21 +43,9 @@ TUPLE: stack-frame total-size size params return ;
 ! Set up caller stack frame
 HOOK: %prologue cpu ( n -- )
 
-: %prologue-later ( -- ) \ %prologue-later , ;
-
 ! Tear down stack frame
 HOOK: %epilogue cpu ( n -- )
 
-: %epilogue-later ( -- ) \ %epilogue-later , ;
-
-! Store word XT in stack frame
-HOOK: %save-word-xt cpu ( -- )
-
-! Store dispatch branch XT in stack frame
-HOOK: %save-dispatch-xt cpu ( -- )
-
-M: object %save-dispatch-xt %save-word-xt ;
-
 ! Call another word
 HOOK: %call cpu ( word -- )
 
@@ -103,7 +94,7 @@ HOOK: small-enough? cpu ( n -- ? )
 ! Is this structure small enough to be returned in registers?
 HOOK: struct-small-enough? cpu ( heap-size -- ? )
 
-! Do we pass explode value structs?
+! Do we pass value structs by value or hidden reference?
 HOOK: value-structs? cpu ( -- ? )
 
 ! If t, fp parameters are shadowed by dummy int parameters
@@ -158,12 +149,6 @@ M: stack-params param-reg drop ;
 
 M: stack-params param-regs drop f ;
 
-GENERIC: v>operand ( obj -- operand )
-
-M: integer v>operand tag-fixnum ;
-
-M: f v>operand drop \ f tag-number ;
-
 M: object load-literal v>operand load-indirect ;
 
 PREDICATE: small-slot < integer cells small-enough? ;
@@ -207,8 +192,3 @@ HOOK: %write-barrier cpu ( src temp -- )
 
 ! GC check
 HOOK: %gc cpu ( -- )
-
-: operand ( var -- op ) get v>operand ; inline
-
-: unique-operands ( operands quot -- )
-    >r [ operand ] map prune r> each ; inline
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index dc891a8178..a16beed09c 100644
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -20,8 +20,6 @@ M: x86.32 stack-reg ESP ;
 M: x86.32 temp-reg-1 EAX ;
 M: x86.32 temp-reg-2 ECX ;
 
-M: temp-reg v>operand drop EBX ;
-
 M: x86.32 %alien-global 0 [] MOV rc-absolute-cell rel-dlsym ;
 
 M: x86.32 %alien-invoke (CALL) rel-dlsym ;
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 5bcd733eaa..9ecd3436bb 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -15,8 +15,6 @@ M: x86.64 stack-reg RSP ;
 M: x86.64 temp-reg-1 RAX ;
 M: x86.64 temp-reg-2 RCX ;
 
-M: temp-reg v>operand drop RBX ;
-
 M: int-regs return-reg drop RAX ;
 M: int-regs vregs drop { RAX RCX RDX RBP RSI RDI R8 R9 R10 R11 R12 R13 } ;
 M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
diff --git a/basis/cpu/x86/allot/allot.factor b/basis/cpu/x86/allot/allot.factor
index d48153e1b6..2c38a99833 100644
--- a/basis/cpu/x86/allot/allot.factor
+++ b/basis/cpu/x86/allot/allot.factor
@@ -7,118 +7,6 @@ compiler.generator.registers system layouts alien locals
 compiler.constants ;
 IN: cpu.x86.allot
 
-: allot-reg ( -- reg )
-    #! We temporarily use the datastack register, since it won't
-    #! be accessed inside the quotation given to %allot in any
-    #! case.
-    ds-reg ;
-
-: (object@) ( n -- operand ) allot-reg swap [+] ;
-
-: object@ ( n -- operand ) cells (object@) ;
-
-: load-zone-ptr ( reg -- )
-    #! Load pointer to start of zone array
-    0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
-
-: load-allot-ptr ( -- )
-    allot-reg load-zone-ptr
-    allot-reg PUSH
-    allot-reg dup cell [+] MOV ;
-
-: inc-allot-ptr ( n -- )
-    allot-reg POP
-    allot-reg cell [+] swap 8 align ADD ;
-
-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
-    0 frame-required
-    %prepare-alien-invoke
-    "minor_gc" f %alien-invoke
-    "end" resolve-label ;
-
-: store-header ( header -- )
-    0 object@ swap type-number tag-fixnum MOV ;
-
-: %allot ( header size quot -- )
-    allot-reg PUSH
-    swap >r >r
-    load-allot-ptr
-    store-header
-    r> call
-    r> inc-allot-ptr
-    allot-reg POP ; inline
-
-: %store-tagged ( reg tag -- )
-    >r dup fresh-object v>operand r>
-    allot-reg swap tag-number OR
-    allot-reg MOV ;
-
-M: x86 %box-float ( dst src -- )
-    #! Only called by pentium4 backend, uses SSE2 instruction
-    #! dest is a loc or a vreg
-    float 16 [
-        8 (object@) swap v>operand MOVSD
-        float %store-tagged
-    ] %allot ;
-
-: %allot-bignum-signed-1 ( outreg inreg -- )
-    #! on entry, inreg is a signed 32-bit quantity
-    #! exits with tagged ptr to bignum in outreg
-    #! 1 cell header, 1 cell length, 1 cell sign, + digits
-    #! length is the # of digits + sign
-    [
-        { "end" "nonzero" "positive" "store" }
-        [ define-label ] each
-        dup v>operand 0 CMP ! is it zero?
-        "nonzero" get JNE
-        0 >bignum pick load-literal ! this is our result
-        "end" get JMP
-        "nonzero" resolve-label
-        bignum 4 cells [
-            ! Write length
-            1 object@ 2 v>operand MOV
-            ! Test sign
-            dup v>operand 0 CMP
-            "positive" get JGE
-            2 object@ 1 MOV ! negative sign
-            dup v>operand NEG
-            "store" get JMP
-            "positive" resolve-label
-            2 object@ 0 MOV ! positive sign
-            "store" resolve-label
-            3 object@ swap v>operand MOV
-            ! Store tagged ptr in reg
-            bignum %store-tagged
-        ] %allot
-        "end" resolve-label
-    ] with-scope ;
-
-M: x86 %box-alien ( dst src -- )
-    [
-        { "end" "f" } [ define-label ] each
-        dup v>operand 0 CMP
-        "f" get JE
-        alien 4 cells [
-            1 object@ f v>operand MOV
-            2 object@ f v>operand MOV
-            ! Store src in alien-offset slot
-            3 object@ swap v>operand MOV
-            ! Store tagged ptr in dst
-            dup object %store-tagged
-        ] %allot
-        "end" get JMP
-        "f" resolve-label
-        f [ v>operand ] bi@ MOV
-        "end" resolve-label
-    ] with-scope ;
-
 M:: x86 %write-barrier ( src temp -- )
     #! Mark the card pointed to by vreg.
     ! Mark the card
@@ -131,24 +19,86 @@ M:: x86 %write-barrier ( src temp -- )
     "decks_offset" f temp %alien-global
     temp temp [+] card-mark <byte> MOV ;
 
-! : load-zone-ptr ( reg -- )
-!     #! Load pointer to start of zone array
-!     0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
-! 
-! : load-allot-ptr ( temp -- )
-!     [ load-zone-ptr ] [ PUSH ] [ dup cell [+] MOV ] tri ;
-! 
-! : inc-allot-ptr ( n temp -- )
-!     [ POP ] [ cell [+] swap 8 align ADD ] bi ;
-! 
-! : store-header ( temp type -- )
-!     [ 0 [+] ] [ type-number tag-fixnum ] bi* MOV ;
-! 
-! : store-tagged ( dst temp tag -- )
-!     dupd tag-number OR MOV ;
-! 
-! M:: x86 %allot ( dst size type tag temp -- )
-!     temp load-allot-ptr
-!     temp type store-header
-!     temp size inc-allot-ptr
-!     dst temp store-tagged ;
+: load-zone-ptr ( reg -- )
+    #! Load pointer to start of zone array
+    0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
+
+: load-allot-ptr ( temp -- )
+    [ load-zone-ptr ] [ PUSH ] [ dup cell [+] MOV ] tri ;
+
+: inc-allot-ptr ( n temp -- )
+    [ POP ] [ cell [+] swap 8 align ADD ] bi ;
+
+: store-header ( temp type -- )
+    [ 0 [+] ] [ type-number tag-fixnum ] bi* MOV ;
+
+: store-tagged ( dst temp tag -- )
+    dupd tag-number OR MOV ;
+
+M:: x86 %allot ( dst size type tag temp -- )
+    temp load-allot-ptr
+    temp type store-header
+    temp size inc-allot-ptr
+    dst temp store-tagged ;
+
+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
+    %prepare-alien-invoke
+    "minor_gc" f %alien-invoke
+    "end" resolve-label ;
+
+: bignum@ ( reg n -- op ) cells bignum tag-number - [+] ;
+
+:: %allot-bignum-signed-1 ( dst src temp -- )
+    #! on entry, inreg is a signed 32-bit quantity
+    #! exits with tagged ptr to bignum in outreg
+    #! 1 cell header, 1 cell length, 1 cell sign, + digits
+    #! length is the # of digits + sign
+    [
+        { "end" "nonzero" "positive" "store" } [ define-label ] each
+        src 0 CMP ! is it zero?
+        "nonzero" get JNE
+        ! Use cached zero value
+        0 >bignum dst load-indirect
+        "end" get JMP
+        "nonzero" resolve-label
+        ! Allocate a bignum
+        dst 4 cells bignum bignum temp %allot
+        ! Write length
+        dst 1 bignum@ 2 MOV
+        ! Test sign
+        src 0 CMP
+        "positive" get JGE
+        dst 2 bignum@ 1 MOV ! negative sign
+        src NEG
+        "store" get JMP
+        "positive" resolve-label
+        dst 2 bignum@ 0 MOV ! positive sign
+        "store" resolve-label
+        dst 3 bignum@ src MOV
+        "end" resolve-label
+    ] with-scope ;
+
+: alien@ ( reg n -- op ) cells object tag-number - [+] ;
+
+M:: x86 %box-alien ( dst src temp -- )
+    [
+        { "end" "f" } [ define-label ] each
+        src 0 CMP
+        "f" get JE
+        dst 4 cells alien object temp %allot
+        dst 1 alien@ \ f tag-number MOV
+        dst 2 alien@ \ f tag-number MOV
+        ! Store src in alien-offset slot
+        dst 3 alien@ src MOV
+        "end" get JMP
+        "f" resolve-label
+        \ f tag-number MOV
+        "end" resolve-label
+    ] with-scope ;
diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor
index 31ead4a005..0ebc696323 100644
--- a/basis/cpu/x86/architecture/architecture.factor
+++ b/basis/cpu/x86/architecture/architecture.factor
@@ -22,8 +22,10 @@ HOOK: stack-reg cpu ( -- reg )
 
 : reg-stack ( n reg -- op ) swap cells neg [+] ;
 
-M: ds-loc v>operand n>> ds-reg reg-stack ;
-M: rs-loc v>operand n>> rs-reg reg-stack ;
+GENERIC: loc>operand ( loc -- operand )
+
+M: ds-loc loc>operand n>> ds-reg reg-stack ;
+M: rs-loc loc>operand n>> rs-reg reg-stack ;
 
 M: int-regs %save-param-reg drop >r stack@ r> MOV ;
 M: int-regs %load-param-reg drop swap stack@ MOV ;
@@ -49,7 +51,11 @@ HOOK: fixnum>slot@ cpu ( op -- )
 
 HOOK: prepare-division cpu ( -- )
 
-M: immediate load-literal v>operand swap v>operand MOV ;
+M: f load-literal
+    \ f tag-number MOV drop ;
+
+M: fixnum load-literal
+    swap tag-fixnum MOV ;
 
 : align-stack ( n -- n' )
     os macosx? cpu x86.64? or [ 16 align ] when ;
@@ -57,16 +63,16 @@ M: immediate load-literal v>operand swap v>operand MOV ;
 M: x86 stack-frame-size ( n -- i )
     3 cells + align-stack ;
 
-M: x86 %save-word-xt ( -- )
-    temp-reg v>operand 0 MOV rc-absolute-cell rel-this ;
+M: x86 %save-word-xt ( -- ) ;
 
 : decr-stack-reg ( n -- )
     dup 0 = [ drop ] [ stack-reg swap SUB ] if ;
 
 M: x86 %prologue ( n -- )
-    dup PUSH
-    temp-reg v>operand PUSH
-    3 cells - decr-stack-reg ;
+    temp-reg-1 0 MOV rc-absolute-cell rel-this
+    dup cell + PUSH
+    temp-reg-1 PUSH
+    stack-reg swap 2 cells - SUB ;
 
 : incr-stack-reg ( n -- )
     dup 0 = [ drop ] [ stack-reg swap ADD ] if ;
@@ -79,21 +85,21 @@ M: x86 %prepare-alien-invoke
     #! Save Factor stack pointers in case the C code calls a
     #! callback which does a GC, which must reliably trace
     #! all roots.
-    "stack_chain" f temp-reg v>operand %alien-global
-    temp-reg v>operand [] stack-reg MOV
-    temp-reg v>operand [] cell SUB
-    temp-reg v>operand 2 cells [+] ds-reg MOV
-    temp-reg v>operand 3 cells [+] rs-reg MOV ;
+    "stack_chain" f temp-reg-1 %alien-global
+    temp-reg-1 [] stack-reg MOV
+    temp-reg-1 [] cell SUB
+    temp-reg-1 2 cells [+] ds-reg MOV
+    temp-reg-1 3 cells [+] rs-reg MOV ;
 
 M: x86 %call ( label -- ) CALL ;
 
 M: x86 %jump-label ( label -- ) JMP ;
 
-M: x86 %jump-f ( label -- )
-    "flag" operand f v>operand CMP JE ;
+M: x86 %jump-f ( label vreg -- )
+    \ f tag-number CMP JE ;
 
-M: x86 %jump-t ( label -- )
-    "flag" operand f v>operand CMP JNE ;
+M: x86 %jump-t ( label vreg -- )
+    \ f tag-number CMP JNE ;
 
 : code-alignment ( -- n )
     building get length dup cell align swap - ;
@@ -126,14 +132,9 @@ M: x86 %dispatch ( -- )
 M: x86 %dispatch-label ( word -- )
     0 cell, rc-absolute-cell rel-word ;
 
-M: x86 %unbox-float ( dst src -- )
-    [ v>operand ] bi@ float-offset [+] MOVSD ;
+M: x86 %peek loc>operand MOV ;
 
-M: x86 %peek [ v>operand ] bi@ MOV ;
-
-M: x86 %replace swap %peek ;
-
-M: x86 %copy [ v>operand ] bi@ MOV ;
+M: x86 %replace loc>operand swap MOV ;
 
 : (%inc) ( n reg -- ) swap cells dup 0 > [ ADD ] [ neg SUB ] if ;
 
@@ -158,13 +159,13 @@ M: x86 %return ( -- ) 0 %unwind ;
 
 ! Alien intrinsics
 M: x86 %unbox-byte-array ( dst src -- )
-    [ v>operand ] bi@ byte-array-offset [+] LEA ;
+    byte-array-offset [+] LEA ;
 
 M: x86 %unbox-alien ( dst src -- )
-    [ v>operand ] bi@ alien-offset [+] MOV ;
+    alien-offset [+] MOV ;
 
 M: x86 %unbox-f ( dst src -- )
-    drop v>operand 0 MOV ;
+    drop 0 MOV ;
 
 M: x86 %unbox-any-c-ptr ( dst src -- )
     { "is-byte-array" "end" "start" } [ define-label ] each
@@ -173,11 +174,11 @@ M: x86 %unbox-any-c-ptr ( dst src -- )
     ds-reg 0 MOV
     ! Object is stored in ds-reg
     rs-reg PUSH
-    rs-reg swap v>operand MOV
+    rs-reg swap MOV
     ! We come back here with displaced aliens
     "start" resolve-label
     ! Is the object f?
-    rs-reg f v>operand CMP
+    rs-reg \ f tag-number CMP
     "end" get JE
     ! Is the object an alien?
     rs-reg header-offset [+] alien type-number tag-fixnum CMP
@@ -194,7 +195,7 @@ M: x86 %unbox-any-c-ptr ( dst src -- )
     ds-reg byte-array-offset ADD
     "end" resolve-label
     ! Done, store address in destination register
-    v>operand ds-reg MOV
+    ds-reg MOV
     ! Restore rs-reg
     rs-reg POP
     ! Restore ds-reg
diff --git a/basis/cpu/x86/intrinsics/intrinsics.factor b/basis/cpu/x86/intrinsics/intrinsics.factor
index a0cfd1b01e..3ef25a9075 100644
--- a/basis/cpu/x86/intrinsics/intrinsics.factor
+++ b/basis/cpu/x86/intrinsics/intrinsics.factor
@@ -1,103 +1,74 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.accessors arrays cpu.x86.assembler
-cpu.x86.allot cpu.x86.architecture cpu.architecture kernel
-kernel.private math math.private namespaces quotations sequences
-words generic byte-arrays hashtables hashtables.private
-sequences.private sbufs sbufs.private
-vectors vectors.private layouts system strings.private
-slots.private 
-compiler.constants
-compiler.intrinsics
-compiler.generator
-compiler.generator.fixup
-compiler.generator.registers ;
+USING: accessors arrays byte-arrays alien.accessors
+compiler.backend kernel kernel.private math memory namespaces
+make sequences words system layouts combinators math.order
+math.private alien alien.c-types slots.private cpu.x86.assembler
+cpu.x86.assembler.private locals compiler.backend
+compiler.codegen.fixup compiler.constants compiler.intrinsics
+compiler.cfg.builder compiler.cfg.registers compiler.cfg.stacks
+compiler.cfg.templates compiler.codegen ;
 IN: cpu.x86.intrinsics
 
 ! Type checks
 \ tag [
     "in" operand tag-mask get AND
     "in" operand %tag-fixnum
-] H{
-    { +input+ { { f "in" } } }
-    { +output+ { "in" } }
+] T{ template
+    { input { { f "in" } } }
+    { output { "in" } }
 } define-intrinsic
 
 ! Slots
-: %slot-literal-known-tag ( -- op )
-    "obj" operand
-    "n" get cells
-    "obj" get operand-tag - [+] ;
-
-: %slot-literal-any-tag ( -- op )
-    "obj" operand %untag
-    "obj" operand "n" get cells [+] ;
-
-: %slot-any ( -- op )
-    "obj" operand %untag
-    "n" operand fixnum>slot@
-    "obj" operand "n" operand [+] ;
-
 \ slot {
     ! Slot number is literal and the tag is known
     {
-        [ "val" operand %slot-literal-known-tag MOV ] H{
-            { +input+ { { f "obj" known-tag } { [ small-slot? ] "n" } } }
-            { +scratch+ { { f "val" } } }
-            { +output+ { "val" } }
+        [ "val" operand %slot-literal-known-tag MOV ] T{ template
+            { input { { f "obj" known-tag } { small-slot "n" } } }
+            { scratch { { f "val" } } }
+            { output { "val" } }
         }
     }
     ! Slot number is literal
     {
-        [ "obj" operand %slot-literal-any-tag MOV ] H{
-            { +input+ { { f "obj" } { [ small-slot? ] "n" } } }
-            { +output+ { "obj" } }
+        [ "obj" operand %slot-literal-any-tag MOV ] T{ template
+            { input { { f "obj" } { small-slot "n" } } }
+            { output { "obj" } }
         }
     }
     ! Slot number in a register
     {
-        [ "obj" operand %slot-any MOV ] H{
-            { +input+ { { f "obj" } { f "n" } } }
-            { +output+ { "obj" } }
-            { +clobber+ { "n" } }
+        [ "obj" operand %slot-any MOV ] T{ template
+            { input { { f "obj" } { f "n" } } }
+            { output { "obj" } }
+            { clobber { "n" } }
         }
     }
 } define-intrinsics
 
-: generate-write-barrier ( -- )
-    #! Mark the card pointed to by vreg.
-    "val" get operand-immediate? "obj" get fresh-object? or [
-        ! Mark the card
-        "obj" operand card-bits SHR
-        "cards_offset" f temp-reg v>operand %alien-global
-        temp-reg v>operand "obj" operand [+] card-mark <byte> MOV
-
-        ! Mark the card deck
-        "obj" operand deck-bits card-bits - SHR
-        "decks_offset" f temp-reg v>operand %alien-global
-        temp-reg v>operand "obj" operand [+] card-mark <byte> MOV
-    ] unless ;
-
-\ set-slot {
+\ (set-slot) {
     ! Slot number is literal and the tag is known
     {
-        [ %slot-literal-known-tag "val" operand MOV generate-write-barrier ] H{
-            { +input+ { { f "val" } { f "obj" known-tag } { [ small-slot? ] "n" } } }
-            { +clobber+ { "obj" } }
+        [ %slot-literal-known-tag "val" operand MOV ] T{ template
+            { input { { f "val" } { f "obj" known-tag } { small-slot "n" } } }
+            { scratch { { f "scratch" } } }
+            { clobber { "obj" } }
         }
     }
     ! Slot number is literal
     {
-        [ %slot-literal-any-tag "val" operand MOV generate-write-barrier ] H{
-            { +input+ { { f "val" } { f "obj" } { [ small-slot? ] "n" } } }
-            { +clobber+ { "obj" } }
+        [ %slot-literal-any-tag "val" operand MOV ] T{ template
+            { input { { f "val" } { f "obj" } { small-slot "n" } } }
+            { scratch { { f "scratch" } } }
+            { clobber { "obj" } }
         }
     }
     ! Slot number in a register
     {
-        [ %slot-any "val" operand MOV generate-write-barrier ] H{
-            { +input+ { { f "val" } { f "obj" } { f "n" } } }
-            { +clobber+ { "obj" "n" } }
+        [ %slot-any "val" operand MOV ] T{ template
+            { input { { f "val" } { f "obj" } { f "n" } } }
+            { scratch { { f "scratch" } } }
+            { clobber { "obj" "n" } }
         }
     }
 } define-intrinsics
@@ -117,15 +88,15 @@ IN: cpu.x86.intrinsics
     >r [ "x" operand "y" operand ] swap suffix r> 2array ;
 
 : fixnum-value-op ( op -- pair )
-    H{
-        { +input+ { { f "x" } { [ small-tagged? ] "y" } } }
-        { +output+ { "x" } }
+    T{ template
+        { input { { f "x" } { small-tagged "y" } } }
+        { output { "x" } }
     } fixnum-op ;
 
 : fixnum-register-op ( op -- pair )
-    H{
-        { +input+ { { f "x" } { f "y" } } }
-        { +output+ { "x" } }
+    T{ template
+        { input { { f "x" } { f "y" } } }
+        { output { "x" } }
     } fixnum-op ;
 
 : define-fixnum-op ( word op -- )
@@ -145,28 +116,28 @@ IN: cpu.x86.intrinsics
 \ fixnum-bitnot [
     "x" operand NOT
     "x" operand tag-mask get XOR
-] H{
-    { +input+ { { f "x" } } }
-    { +output+ { "x" } }
+] T{ template
+    { input { { f "x" } } }
+    { output { "x" } }
 } define-intrinsic
 
 \ fixnum*fast {
     {
         [
             "x" operand "y" get IMUL2
-        ] H{
-            { +input+ { { f "x" } { [ small-tagged? ] "y" } } }
-            { +output+ { "x" } }
+        ] T{ template
+            { input { { f "x" } { [ small-tagged? ] "y" } } }
+            { output { "x" } }
         }
     } {
         [
             "out" operand "x" operand MOV
             "out" operand %untag-fixnum
             "y" operand "out" operand IMUL2
-        ] H{
-            { +input+ { { f "x" } { f "y" } } }
-            { +scratch+ { { f "out" } } }
-            { +output+ { "out" } }
+        ] T{ template
+            { input { { f "x" } { f "y" } } }
+            { scratch { { f "out" } } }
+            { output { "out" } }
         }
     }
 } define-intrinsics
@@ -179,9 +150,9 @@ IN: cpu.x86.intrinsics
     dup 0 < [ neg SAR ] [ SHL ] if
     ! Mask off low bits
     "x" operand %untag
-] H{
-    { +input+ { { f "x" } { [ ] "y" } } }
-    { +output+ { "x" } }
+] T{ template
+    { input { { f "x" } { [ ] "y" } } }
+    { output { "x" } }
 } define-intrinsic
 
 : overflow-check ( word -- )
@@ -194,15 +165,16 @@ IN: cpu.x86.intrinsics
     ! There was an overflow. Recompute the original operand.
     { "y" "x" } %untag-fixnums
     "x" operand "y" operand rot execute
-    "z" get "x" get %allot-bignum-signed-1
+    "z" operand "x" operand "y" operand %allot-bignum-signed-1
     "end" resolve-label ; inline
 
 : overflow-template ( word insn -- )
-    [ overflow-check ] curry H{
-        { +input+ { { f "x" } { f "y" } } }
-        { +scratch+ { { f "z" } } }
-        { +output+ { "z" } }
-        { +clobber+ { "x" "y" } }
+    [ overflow-check ] curry T{ template
+        { input { { f "x" } { f "y" } } }
+        { scratch { { f "z" } } }
+        { output { "z" } }
+        { clobber { "x" "y" } }
+        { gc t }
     } define-intrinsic ;
 
 \ fixnum+ \ ADD overflow-template
@@ -222,21 +194,23 @@ IN: cpu.x86.intrinsics
     2array define-if-intrinsics ;
 
 {
-    { fixnum< JGE }
-    { fixnum<= JG }
-    { fixnum> JLE }
-    { fixnum>= JL }
-    { eq? JNE }
+    { fixnum< JL }
+    { fixnum<= JLE }
+    { fixnum> JG }
+    { fixnum>= JGE }
+    { eq? JE }
 } [
     first2 define-fixnum-jump
 ] each
 
 \ fixnum>bignum [
     "x" operand %untag-fixnum
-    "x" get dup %allot-bignum-signed-1
-] H{
-    { +input+ { { f "x" } } }
-    { +output+ { "x" } }
+    "x" operand dup "scratch" operand %allot-bignum-signed-1
+] T{ template
+    { input { { f "x" } } }
+    { scratch { { f "scratch" } } }
+    { output { "x" } }
+    { gc t }
 } define-intrinsic
 
 \ bignum>fixnum [
@@ -247,7 +221,7 @@ IN: cpu.x86.intrinsics
     "y" operand "x" operand cell [+] MOV
      ! if the length is 1, its just the sign and nothing else,
      ! so output 0
-    "y" operand 1 v>operand CMP
+    "y" operand 1 tag-fixnum CMP
     "nonzero" get JNE
     "y" operand 0 MOV
     "end" get JMP
@@ -263,11 +237,11 @@ IN: cpu.x86.intrinsics
     "positive" resolve-label
     "y" operand 3 SHL
     "end" resolve-label
-] H{
-    { +input+ { { f "x" } } }
-    { +scratch+ { { f "y" } } }
-    { +clobber+ { "x" } }
-    { +output+ { "y" } }
+] T{ template
+    { input { { f "x" } } }
+    { scratch { { f "y" } } }
+    { clobber { "x" } }
+    { output { "y" } }
 } define-intrinsic
 
 ! User environment
@@ -279,96 +253,18 @@ IN: cpu.x86.intrinsics
 
 \ getenv [
     %userenv  "n" operand dup [] MOV
-] H{
-    { +input+ { { f "n" } } }
-    { +scratch+ { { f "x" } } }
-    { +output+ { "n" } }
+] T{ template
+    { input { { f "n" } } }
+    { scratch { { f "x" } } }
+    { output { "n" } }
 } define-intrinsic
 
 \ setenv [
     %userenv  "n" operand [] "val" operand MOV
-] H{
-    { +input+ { { f "val" } { f "n" } } }
-    { +scratch+ { { f "x" } } }
-    { +clobber+ { "n" } }
-} define-intrinsic
-
-\ (tuple) [
-    tuple "layout" get size>> 2 + cells [
-        ! Store layout
-        "layout" get "scratch" get load-literal
-        1 object@ "scratch" operand MOV
-        ! Store tagged ptr in reg
-        "tuple" get tuple %store-tagged
-    ] %allot
-] H{
-    { +input+ { { [ ] "layout" } } }
-    { +scratch+ { { f "tuple" } { f "scratch" } } }
-    { +output+ { "tuple" } }
-} define-intrinsic
-
-\ (array) [
-    array "n" get 2 + cells [
-        ! Store length
-        1 object@ "n" operand MOV
-        ! Store tagged ptr in reg
-        "array" get object %store-tagged
-    ] %allot
-] H{
-    { +input+ { { [ ] "n" } } }
-    { +scratch+ { { f "array" } } }
-    { +output+ { "array" } }
-} define-intrinsic
-
-\ (byte-array) [
-    byte-array "n" get 2 cells + [
-        ! Store length
-        1 object@ "n" operand MOV
-        ! Store tagged ptr in reg
-        "array" get object %store-tagged
-    ] %allot
-] H{
-    { +input+ { { [ ] "n" } } }
-    { +scratch+ { { f "array" } } }
-    { +output+ { "array" } }
-} define-intrinsic
-
-\ <ratio> [
-    ratio 3 cells [
-        1 object@ "numerator" operand MOV
-        2 object@ "denominator" operand MOV
-        ! Store tagged ptr in reg
-        "ratio" get ratio %store-tagged
-    ] %allot
-] H{
-    { +input+ { { f "numerator" } { f "denominator" } } }
-    { +scratch+ { { f "ratio" } } }
-    { +output+ { "ratio" } }
-} define-intrinsic
-
-\ <complex> [
-    complex 3 cells [
-        1 object@ "real" operand MOV
-        2 object@ "imaginary" operand MOV
-        ! Store tagged ptr in reg
-        "complex" get complex %store-tagged
-    ] %allot
-] H{
-    { +input+ { { f "real" } { f "imaginary" } } }
-    { +scratch+ { { f "complex" } } }
-    { +output+ { "complex" } }
-} define-intrinsic
-
-\ <wrapper> [
-    wrapper 2 cells [
-        1 object@ "obj" operand MOV
-        ! Store tagged ptr in reg
-        "wrapper" get object %store-tagged
-    ] %allot
-] H{
-    { +input+ { { f "obj" } } }
-    { +scratch+ { { f "wrapper" } } }
-    { +output+ { "wrapper" } }
+] T{ template
+    { input { { f "val" } { f "n" } } }
+    { scratch { { f "x" } } }
+    { clobber { "n" } }
 } define-intrinsic
 
 ! Alien intrinsics
@@ -385,14 +281,14 @@ IN: cpu.x86.intrinsics
     small-reg POP ; inline
 
 : alien-integer-get-template
-    H{
-        { +input+ {
+    T{ template
+        { input {
             { unboxed-c-ptr "alien" c-ptr }
             { f "offset" fixnum }
         } }
-        { +scratch+ { { f "value" } } }
-        { +output+ { "value" } }
-        { +clobber+ { "offset" } }
+        { scratch { { f "value" } } }
+        { output { "value" } }
+        { clobber { "offset" } }
     } ;
 
 : define-getter ( word quot reg -- )
@@ -414,13 +310,13 @@ IN: cpu.x86.intrinsics
     small-reg POP ; inline
 
 : alien-integer-set-template
-    H{
-        { +input+ {
+    T{ template
+        { input {
             { f "value" fixnum }
             { unboxed-c-ptr "alien" c-ptr }
             { f "offset" fixnum }
         } }
-        { +clobber+ { "value" "offset" } }
+        { clobber { "value" "offset" } }
     } ;
 
 : define-setter ( word reg -- )
@@ -443,23 +339,23 @@ IN: cpu.x86.intrinsics
 
 \ alien-cell [
     "value" operand [ MOV ] %alien-accessor
-] H{
-    { +input+ {
+] T{ template
+    { input {
         { unboxed-c-ptr "alien" c-ptr }
         { f "offset" fixnum }
     } }
-    { +scratch+ { { unboxed-alien "value" } } }
-    { +output+ { "value" } }
-    { +clobber+ { "offset" } }
+    { scratch { { unboxed-alien "value" } } }
+    { output { "value" } }
+    { clobber { "offset" } }
 } define-intrinsic
 
 \ set-alien-cell [
     "value" operand [ swap MOV ] %alien-accessor
-] H{
-    { +input+ {
+] T{ template
+    { input {
         { unboxed-c-ptr "value" pinned-c-ptr }
         { unboxed-c-ptr "alien" c-ptr }
         { f "offset" fixnum }
     } }
-    { +clobber+ { "offset" } }
+    { clobber { "offset" } }
 } define-intrinsic
diff --git a/basis/cpu/x86/sse2/sse2.factor b/basis/cpu/x86/sse2/sse2.factor
index 3e232b518d..81108aa55a 100644
--- a/basis/cpu/x86/sse2/sse2.factor
+++ b/basis/cpu/x86/sse2/sse2.factor
@@ -8,7 +8,14 @@ cpu.architecture math.floats.private layouts quotations
 system ;
 IN: cpu.x86.sse2
 
-M: x86 %copy-float [ v>operand ] bi@ MOVSD ;
+M: x86 %copy-float MOVSD ;
+
+M:: x86 %box-float ( dst src temp -- )
+    dst 16 float float temp %allot
+    dst 8 float tag-number - [+] src MOVSD ;
+
+M: x86 %unbox-float ( dst src -- )
+    float-offset [+] MOVSD ;
 
 : define-float-op ( word op -- )
     [ "x" operand "y" operand ] swap suffix H{
diff --git a/unfinished/compiler/backend/backend.factor b/unfinished/compiler/backend/backend.factor
deleted file mode 100644
index 2a516c6ec4..0000000000
--- a/unfinished/compiler/backend/backend.factor
+++ /dev/null
@@ -1,189 +0,0 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs arrays generic kernel kernel.private
-math memory namespaces make sequences layouts system hashtables
-classes alien byte-arrays combinators words ;
-IN: compiler.backend
-
-! Labels
-TUPLE: label offset ;
-
-: <label> ( -- label ) label new ;
-: define-label ( name -- ) <label> swap set ;
-: resolve-label ( label/name -- ) dup label? [ get ] unless , ;
-
-! 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
-
-! Return values of this class go here
-GENERIC: return-reg ( register-class -- reg )
-
-! Sequence of registers used for parameter passing in class
-GENERIC: param-regs ( register-class -- regs )
-
-GENERIC: param-reg ( n register-class -- reg )
-
-M: object param-reg param-regs nth ;
-
-! Load a literal (immediate or indirect)
-GENERIC# load-literal 1 ( obj reg -- )
-
-HOOK: load-indirect cpu ( obj reg -- )
-
-HOOK: stack-frame-size cpu ( frame-size -- n )
-
-! Set up caller stack frame
-HOOK: %prologue cpu ( n -- )
-
-! Tear down stack frame
-HOOK: %epilogue cpu ( n -- )
-
-! Call another word
-HOOK: %call cpu ( word -- )
-
-! Local jump for branches
-HOOK: %jump-label cpu ( label -- )
-
-! Test if vreg is 'f' or not
-HOOK: %jump-f cpu ( label reg -- )
-
-! Test if vreg is 't' or not
-HOOK: %jump-t cpu ( label reg -- )
-
-HOOK: %dispatch cpu ( -- )
-
-HOOK: %dispatch-label cpu ( word -- )
-
-! Return to caller
-HOOK: %return cpu ( -- )
-
-! Change datastack height
-HOOK: %inc-d cpu ( n -- )
-
-! Change callstack height
-HOOK: %inc-r cpu ( n -- )
-
-! Load stack into vreg
-HOOK: %peek cpu ( reg loc -- )
-
-! Store vreg to stack
-HOOK: %replace cpu ( reg loc -- )
-
-! Copy values between vregs
-HOOK: %copy cpu ( dst src -- )
-HOOK: %copy-float cpu ( dst src -- )
-
-! Box and unbox floats
-HOOK: %unbox-float cpu ( dst src -- )
-HOOK: %box-float cpu ( dst src -- )
-
-! FFI stuff
-
-! Is this integer small enough to appear in value template
-! slots?
-HOOK: small-enough? cpu ( n -- ? )
-
-! Is this structure small enough to be returned in registers?
-HOOK: struct-small-enough? cpu ( heap-size -- ? )
-
-! Do we pass explode value structs?
-HOOK: value-structs? cpu ( -- ? )
-
-! If t, fp parameters are shadowed by dummy int parameters
-HOOK: fp-shadows-int? cpu ( -- ? )
-
-HOOK: %prepare-unbox cpu ( -- )
-
-HOOK: %unbox cpu ( n reg-class func -- )
-
-HOOK: %unbox-long-long cpu ( n func -- )
-
-HOOK: %unbox-small-struct cpu ( c-type -- )
-
-HOOK: %unbox-large-struct cpu ( n c-type -- )
-
-HOOK: %box cpu ( n reg-class func -- )
-
-HOOK: %box-long-long cpu ( n func -- )
-
-HOOK: %prepare-box-struct cpu ( size -- )
-
-HOOK: %box-small-struct cpu ( c-type -- )
-
-HOOK: %box-large-struct cpu ( n c-type -- )
-
-GENERIC: %save-param-reg ( stack reg reg-class -- )
-
-GENERIC: %load-param-reg ( stack reg reg-class -- )
-
-HOOK: %prepare-alien-invoke cpu ( -- )
-
-HOOK: %prepare-var-args cpu ( -- )
-
-M: object %prepare-var-args ;
-
-HOOK: %alien-invoke cpu ( function library -- )
-
-HOOK: %cleanup cpu ( alien-node -- )
-
-HOOK: %alien-callback cpu ( quot -- )
-
-HOOK: %callback-value cpu ( ctype -- )
-
-! Return to caller with stdcall unwinding (only for x86)
-HOOK: %unwind cpu ( n -- )
-
-HOOK: %prepare-alien-indirect cpu ( -- )
-
-HOOK: %alien-indirect cpu ( -- )
-
-M: stack-params param-reg drop ;
-
-M: stack-params param-regs drop f ;
-
-M: object load-literal load-indirect ;
-
-PREDICATE: small-slot < integer cells small-enough? ;
-
-PREDICATE: small-tagged < integer tag-fixnum small-enough? ;
-
-: if-small-struct ( n size true false -- ? )
-    [ over not over struct-small-enough? and ] 2dip
-    [ [ nip ] prepose ] dip if ;
-    inline
-
-: %unbox-struct ( n c-type -- )
-    [
-        %unbox-small-struct
-    ] [
-        %unbox-large-struct
-    ] if-small-struct ;
-
-: %box-struct ( n c-type -- )
-    [
-        %box-small-struct
-    ] [
-        %box-large-struct
-    ] if-small-struct ;
-
-! Alien accessors
-HOOK: %unbox-byte-array cpu ( dst src -- )
-
-HOOK: %unbox-alien cpu ( dst src -- )
-
-HOOK: %unbox-f cpu ( dst src -- )
-
-HOOK: %unbox-any-c-ptr cpu ( dst src -- )
-
-HOOK: %box-alien cpu ( dst src -- )
-
-! Allocation
-HOOK: %allot cpu ( dst size type tag temp -- )
-
-HOOK: %write-barrier cpu ( src temp -- )
-
-! GC check
-HOOK: %gc cpu ( -- )
diff --git a/unfinished/compiler/backend/x86/32/32.factor b/unfinished/compiler/backend/x86/32/32.factor
deleted file mode 100644
index 73fc81bd00..0000000000
--- a/unfinished/compiler/backend/x86/32/32.factor
+++ /dev/null
@@ -1,318 +0,0 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types arrays kernel kernel.private math
-namespaces sequences stack-checker.known-words system layouts
-combinators command-line io vocabs.loader accessors init
-compiler compiler.units compiler.constants compiler.codegen
-compiler.cfg.builder compiler.alien compiler.codegen.fixup
-cpu.x86 compiler.backend compiler.backend.x86 ;
-IN: compiler.backend.x86.32
-
-! We implement the FFI for Linux, OS X and Windows all at once.
-! OS X requires that the stack be 16-byte aligned, and we do
-! this on all platforms, sacrificing some stack space for
-! code simplicity.
-
-M: x86.32 machine-registers
-    {
-        { int-regs { EAX ECX EDX EBP EBX } }
-        { double-float-regs { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } }
-    } ;
-
-M: x86.32 ds-reg ESI ;
-M: x86.32 rs-reg EDI ;
-M: x86.32 stack-reg ESP ;
-M: x86.32 stack-save-reg EDX ;
-M: x86.32 temp-reg-1 EAX ;
-M: x86.32 temp-reg-2 ECX ;
-
-M: x86.32 %alien-global 0 [] MOV rc-absolute-cell rel-dlsym ;
-
-M: x86.32 %alien-invoke (CALL) rel-dlsym ;
-
-M: x86.32 struct-small-enough? ( size -- ? )
-    heap-size { 1 2 4 8 } member?
-    os { linux netbsd solaris } member? not and ;
-
-! On x86, parameters are never passed in registers.
-M: int-regs return-reg drop EAX ;
-M: int-regs param-regs drop { } ;
-M: int-regs push-return-reg return-reg PUSH ;
-: load/store-int-return ( n reg-class -- src dst )
-    return-reg stack-reg rot [+] ;
-M: int-regs load-return-reg load/store-int-return MOV ;
-M: int-regs store-return-reg load/store-int-return swap MOV ;
-
-M: float-regs param-regs drop { } ;
-
-: FSTP ( operand size -- ) 4 = [ FSTPS ] [ FSTPL ] if ;
-
-M: float-regs push-return-reg
-    stack-reg swap reg-size [ SUB  stack-reg [] ] keep FSTP ;
-
-: FLD ( operand size -- ) 4 = [ FLDS ] [ FLDL ] if ;
-
-: load/store-float-return ( n reg-class -- op size )
-    [ stack@ ] [ reg-size ] bi* ;
-M: float-regs load-return-reg load/store-float-return FLD ;
-M: float-regs store-return-reg load/store-float-return FSTP ;
-
-: align-sub ( n -- )
-    dup 16 align swap - ESP swap SUB ;
-
-: align-add ( n -- )
-    16 align ESP swap ADD ;
-
-: with-aligned-stack ( n quot -- )
-    swap dup align-sub slip align-add ; inline
-
-M: x86.32 fixnum>slot@ 1 SHR ;
-
-M: x86.32 prepare-division CDQ ;
-
-M: x86.32 load-indirect
-    0 [] MOV rc-absolute-cell rel-literal ;
-
-M: object %load-param-reg 3drop ;
-
-M: object %save-param-reg 3drop ;
-
-: box@ ( n reg-class -- stack@ )
-    #! Used for callbacks; we want to box the values given to
-    #! us by the C function caller. Computes stack location of
-    #! nth parameter; note that we must go back one more stack
-    #! frame, since %box sets one up to call the one-arg boxer
-    #! function. The size of this stack frame so far depends on
-    #! the reg-class of the boxer's arg.
-    reg-size neg + stack-frame* + 20 + ;
-
-: (%box) ( n reg-class -- )
-    #! If n is f, push the return register onto the stack; we
-    #! are boxing a return value of a C function. If n is an
-    #! integer, push [ESP+n] on the stack; we are boxing a
-    #! parameter being passed to a callback from C.
-    over [ [ box@ ] keep [ load-return-reg ] keep ] [ nip ] if
-    push-return-reg ;
-
-M: x86.32 %box ( n reg-class func -- )
-    over reg-size [
-        >r (%box) r> f %alien-invoke
-    ] with-aligned-stack ;
-    
-: (%box-long-long) ( n -- )
-    #! If n is f, push the return registers onto the stack; we
-    #! are boxing a return value of a C function. If n is an
-    #! integer, push [ESP+n]:[ESP+n+4] on the stack; we are
-    #! boxing a parameter being passed to a callback from C.
-    [
-        int-regs box@
-        EDX over stack@ MOV
-        EAX swap cell - stack@ MOV 
-    ] when*
-    EDX PUSH
-    EAX PUSH ;
-
-M: x86.32 %box-long-long ( n func -- )
-    8 [
-        [ (%box-long-long) ] [ f %alien-invoke ] bi*
-    ] with-aligned-stack ;
-
-: struct-return@ ( size n -- n )
-    [ stack-frame* cell + + ] [ \ stack-frame get swap - ] ?if ;
-
-M: x86.32 %box-large-struct ( n c-type -- )
-    ! Compute destination address
-    heap-size
-    [ swap struct-return@ ] keep
-    ECX ESP roll [+] LEA
-    8 [
-        ! Push struct size
-        PUSH
-        ! Push destination address
-        ECX PUSH
-        ! Copy the struct from the C stack
-        "box_value_struct" f %alien-invoke
-    ] with-aligned-stack ;
-
-M: x86.32 %prepare-box-struct ( size -- )
-    ! Compute target address for value struct return
-    EAX ESP rot f struct-return@ [+] LEA
-    ! Store it as the first parameter
-    ESP [] EAX MOV ;
-
-M: x86.32 %box-small-struct ( c-type -- )
-    #! Box a <= 8-byte struct returned in EAX:EDX. OS X only.
-    12 [
-        heap-size PUSH
-        EDX PUSH
-        EAX PUSH
-        "box_small_struct" f %alien-invoke
-    ] with-aligned-stack ;
-
-M: x86.32 %prepare-unbox ( -- )
-    #! Move top of data stack to EAX.
-    EAX ESI [] MOV
-    ESI 4 SUB ;
-
-: (%unbox) ( func -- )
-    4 [
-        ! Push parameter
-        EAX PUSH
-        ! Call the unboxer
-        f %alien-invoke
-    ] with-aligned-stack ;
-
-M: x86.32 %unbox ( n reg-class func -- )
-    #! The value being unboxed must already be in EAX.
-    #! If n is f, we're unboxing a return value about to be
-    #! returned by the callback. Otherwise, we're unboxing
-    #! a parameter to a C function about to be called.
-    (%unbox)
-    ! Store the return value on the C stack
-    over [ store-return-reg ] [ 2drop ] if ;
-
-M: x86.32 %unbox-long-long ( n func -- )
-    (%unbox)
-    ! Store the return value on the C stack
-    [
-        dup stack@ EAX MOV
-        cell + stack@ EDX MOV
-    ] when* ;
-
-: %unbox-struct-1 ( -- )
-    #! Alien must be in EAX.
-    4 [
-        EAX PUSH
-        "alien_offset" f %alien-invoke
-        ! Load first cell
-        EAX EAX [] MOV
-    ] with-aligned-stack ;
-
-: %unbox-struct-2 ( -- )
-    #! Alien must be in EAX.
-    4 [
-        EAX PUSH
-        "alien_offset" f %alien-invoke
-        ! Load second cell
-        EDX EAX 4 [+] MOV
-        ! Load first cell
-        EAX EAX [] MOV
-    ] with-aligned-stack ;
-
-M: x86 %unbox-small-struct ( size -- )
-    #! Alien must be in EAX.
-    heap-size cell align cell /i {
-        { 1 [ %unbox-struct-1 ] }
-        { 2 [ %unbox-struct-2 ] }
-    } case ;
-
-M: x86.32 %unbox-large-struct ( n c-type -- )
-    #! Alien must be in EAX.
-    heap-size
-    ! Compute destination address
-    ECX ESP roll [+] LEA
-    12 [
-        ! Push struct size
-        PUSH
-        ! Push destination address
-        ECX PUSH
-        ! Push source address
-        EAX PUSH
-        ! Copy the struct to the stack
-        "to_value_struct" f %alien-invoke
-    ] with-aligned-stack ;
-
-M: x86.32 %prepare-alien-indirect ( -- )
-    "unbox_alien" f %alien-invoke
-    cell temp@ EAX MOV ;
-
-M: x86.32 %alien-indirect ( -- )
-    cell temp@ CALL ;
-
-M: x86.32 %alien-callback ( quot -- )
-    4 [
-        EAX load-indirect
-        EAX PUSH
-        "c_to_factor" f %alien-invoke
-    ] with-aligned-stack ;
-
-M: x86.32 %callback-value ( ctype -- )
-    ! Align C stack
-    ESP 12 SUB
-    ! Save top of data stack
-    %prepare-unbox
-    EAX PUSH
-    ! Restore data/call/retain stacks
-    "unnest_stacks" f %alien-invoke
-    ! Place top of data stack in EAX
-    EAX POP
-    ! Restore C stack
-    ESP 12 ADD
-    ! Unbox EAX
-    unbox-return ;
-
-M: x86.32 %cleanup ( alien-node -- )
-    #! a) If we just called an stdcall function in Windows, it
-    #! cleaned up the stack frame for us. But we don't want that
-    #! so we 'undo' the cleanup since we do that in %epilogue.
-    #! b) If we just called a function returning a struct, we
-    #! have to fix ESP.
-    {
-        {
-            [ dup abi>> "stdcall" = ]
-            [ alien-stack-frame ESP swap SUB ]
-        } {
-            [ dup return>> large-struct? ]
-            [ drop EAX PUSH ]
-        }
-        [ drop ]
-    } cond ;
-
-M: x86.32 %unwind ( n -- ) RET ;
-
-os windows? [
-    cell "longlong" c-type (>>align)
-    cell "ulonglong" c-type (>>align)
-    4 "double" c-type (>>align)
-] unless
-
-: (sse2?) ( -- ? ) "Intrinsic" throw ;
-
-<<
-
-\ (sse2?) [
-    { EAX EBX ECX EDX } [ PUSH ] each
-    EAX 1 MOV
-    CPUID
-    EDX 26 SHR
-    EDX 1 AND
-    { EAX EBX ECX EDX } [ POP ] each
-    JE
-] { } define-if-intrinsic
-
-\ (sse2?) { } { object } define-primitive
-
->>
-
-: sse2? ( -- ? ) (sse2?) ;
-
-"-no-sse2" cli-args member? [
-    "Checking if your CPU supports SSE2..." print flush
-    [ optimized-recompile-hook ] recompile-hook [
-        [ sse2? ] compile-call
-    ] with-variable
-    [
-        " - yes" print
-        "compiler.backend.x86.sse2" require
-        [
-            sse2? [
-                "This image was built to use SSE2, which your CPU does not support." print
-                "You will need to bootstrap Factor again." print
-                flush
-                1 exit
-            ] unless
-        ] "compiler.backend.x86" add-init-hook
-    ] [
-        " - no" print
-    ] if
-] unless
diff --git a/unfinished/compiler/backend/x86/64/64.factor b/unfinished/compiler/backend/x86/64/64.factor
deleted file mode 100644
index c8760e51b4..0000000000
--- a/unfinished/compiler/backend/x86/64/64.factor
+++ /dev/null
@@ -1,226 +0,0 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays kernel kernel.private math
-namespaces make sequences system layouts alien alien.accessors
-alien.structs slots splitting assocs combinators
-cpu.x86 compiler.codegen compiler.constants
-compiler.codegen.fixup compiler.cfg.registers compiler.backend
-compiler.backend.x86 compiler.backend.x86.sse2 ;
-IN: compiler.backend.x86.64
-
-M: x86.64 machine-registers
-    {
-        { int-regs { RAX RCX RDX RBP RSI RDI R8 R9 R10 R11 R12 R13 } }
-        { double-float-regs {
-            XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
-            XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
-        } }
-    } ;
-
-M: x86.64 ds-reg R14 ;
-M: x86.64 rs-reg R15 ;
-M: x86.64 stack-reg RSP ;
-M: x86.64 stack-save-reg RSI ;
-M: x86.64 temp-reg-1 RAX ;
-M: x86.64 temp-reg-2 RCX ;
-
-M: int-regs return-reg drop RAX ;
-M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
-
-M: float-regs return-reg drop XMM0 ;
-
-M: float-regs param-regs
-    drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
-
-M: x86.64 fixnum>slot@ drop ;
-
-M: x86.64 prepare-division CQO ;
-
-M: x86.64 load-indirect ( literal reg -- )
-    0 [] MOV rc-relative rel-literal ;
-
-M: stack-params %load-param-reg
-    drop
-    >r R11 swap stack@ MOV
-    r> stack@ R11 MOV ;
-
-M: stack-params %save-param-reg
-    >r stack-frame* + cell + swap r> %load-param-reg ;
-
-: with-return-regs ( quot -- )
-    [
-        V{ RDX RAX } clone int-regs set
-        V{ XMM1 XMM0 } clone float-regs set
-        call
-    ] with-scope ; inline
-
-! The ABI for passing structs by value is pretty messed up
-<< "void*" c-type clone "__stack_value" define-primitive-type
-stack-params "__stack_value" c-type (>>reg-class) >>
-
-: struct-types&offset ( struct-type -- pairs )
-    fields>> [
-        [ type>> ] [ offset>> ] bi 2array
-    ] map ;
-
-: split-struct ( pairs -- seq )
-    [
-        [ 8 mod zero? [ t , ] when , ] assoc-each
-    ] { } make { t } split harvest ;
-
-: flatten-small-struct ( c-type -- seq )
-    struct-types&offset split-struct [
-        [ c-type c-type-reg-class ] map
-        int-regs swap member? "void*" "double" ? c-type
-    ] map ;
-
-: flatten-large-struct ( c-type -- seq )
-    heap-size cell align
-    cell /i "__stack_value" c-type <repetition> ;
-
-M: struct-type flatten-value-type ( type -- seq )
-    dup heap-size 16 > [
-        flatten-large-struct
-    ] [
-        flatten-small-struct
-    ] if ;
-
-M: x86.64 %prepare-unbox ( -- )
-    ! First parameter is top of stack
-    RDI R14 [] MOV
-    R14 cell SUB ;
-
-M: x86.64 %unbox ( n reg-class func -- )
-    ! Call the unboxer
-    f %alien-invoke
-    ! Store the return value on the C stack
-    over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ;
-
-M: x86.64 %unbox-long-long ( n func -- )
-    int-regs swap %unbox ;
-
-: %unbox-struct-field ( c-type i -- )
-    ! Alien must be in RDI.
-    RDI swap cells [+] swap reg-class>> {
-        { int-regs [ int-regs get pop swap MOV ] }
-        { double-float-regs [ float-regs get pop swap MOVSD ] }
-    } case ;
-
-M: x86.64 %unbox-small-struct ( c-type -- )
-    ! Alien must be in RDI.
-    "alien_offset" f %alien-invoke
-    ! Move alien_offset() return value to RDI so that we don't
-    ! clobber it.
-    RDI RAX MOV
-    [
-        flatten-small-struct [ %unbox-struct-field ] each-index
-    ] with-return-regs ;
-
-M: x86.64 %unbox-large-struct ( n c-type -- )
-    ! Source is in RDI
-    heap-size
-    ! Load destination address
-    RSI RSP roll [+] LEA
-    ! Load structure size
-    RDX swap MOV
-    ! Copy the struct to the C stack
-    "to_value_struct" f %alien-invoke ;
-
-: load-return-value ( reg-class -- )
-    0 over param-reg swap return-reg
-    2dup eq? [ 2drop ] [ MOV ] if ;
-
-M: x86.64 %box ( n reg-class func -- )
-    rot [
-        rot [ 0 swap param-reg ] keep %load-param-reg
-    ] [
-        swap load-return-value
-    ] if*
-    f %alien-invoke ;
-
-M: x86.64 %box-long-long ( n func -- )
-    int-regs swap %box ;
-
-M: x86.64 struct-small-enough? ( size -- ? )
-    heap-size 2 cells <= ;
-
-: box-struct-field@ ( i -- operand ) RSP swap 1+ cells [+] ;
-
-: %box-struct-field ( c-type i -- )
-    box-struct-field@ swap reg-class>> {
-        { int-regs [ int-regs get pop MOV ] }
-        { double-float-regs [ float-regs get pop MOVSD ] }
-    } case ;
-
-M: x86.64 %box-small-struct ( c-type -- )
-    #! Box a <= 16-byte struct.
-    [
-        [ flatten-small-struct [ %box-struct-field ] each-index ]
-        [ RDX swap heap-size MOV ] bi
-        RDI 0 box-struct-field@ MOV
-        RSI 1 box-struct-field@ MOV
-        "box_small_struct" f %alien-invoke
-    ] with-return-regs ;
-
-: struct-return@ ( size n -- n )
-    [ ] [ \ stack-frame get swap - ] ?if ;
-
-M: x86.64 %box-large-struct ( n c-type -- )
-    ! Struct size is parameter 2
-    heap-size
-    RSI over MOV
-    ! Compute destination address
-    swap struct-return@ RDI RSP rot [+] LEA
-    ! Copy the struct from the C stack
-    "box_value_struct" f %alien-invoke ;
-
-M: x86.64 %prepare-box-struct ( size -- )
-    ! Compute target address for value struct return
-    RAX RSP rot f struct-return@ [+] LEA
-    RSP 0 [+] RAX MOV ;
-
-M: x86.64 %prepare-var-args RAX RAX XOR ;
-
-M: x86.64 %alien-global
-    [ 0 MOV rc-absolute-cell rel-dlsym ] [ dup [] MOV ] bi ;
-
-M: x86.64 %alien-invoke
-    R11 0 MOV
-    rc-absolute-cell rel-dlsym
-    R11 CALL ;
-
-M: x86.64 %prepare-alien-indirect ( -- )
-    "unbox_alien" f %alien-invoke
-    cell temp@ RAX MOV ;
-
-M: x86.64 %alien-indirect ( -- )
-    cell temp@ CALL ;
-
-M: x86.64 %alien-callback ( quot -- )
-    RDI load-indirect "c_to_factor" f %alien-invoke ;
-
-M: x86.64 %callback-value ( ctype -- )
-    ! Save top of data stack
-    %prepare-unbox
-    ! Put former top of data stack in RDI
-    cell temp@ RDI MOV
-    ! Restore data/call/retain stacks
-    "unnest_stacks" f %alien-invoke
-    ! Put former top of data stack in RDI
-    RDI cell temp@ MOV
-    ! Unbox former top of data stack to return registers
-    unbox-return ;
-
-M: x86.64 %cleanup ( alien-node -- ) drop ;
-
-M: x86.64 %unwind ( n -- ) drop 0 RET ;
-
-USE: cpu.x86.intrinsics
-
-! On 64-bit systems, the result of reading 4 bytes from memory
-! is a fixnum.
-\ alien-unsigned-4 small-reg-32 define-unsigned-getter
-\ set-alien-unsigned-4 small-reg-32 define-setter
-
-\ alien-signed-4 small-reg-32 define-signed-getter
-\ set-alien-signed-4 small-reg-32 define-setter
diff --git a/unfinished/compiler/backend/x86/sse2/sse2.factor b/unfinished/compiler/backend/x86/sse2/sse2.factor
deleted file mode 100644
index 4364a8c24a..0000000000
--- a/unfinished/compiler/backend/x86/sse2/sse2.factor
+++ /dev/null
@@ -1,106 +0,0 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.accessors arrays generic kernel system
-kernel.private math math.private memory namespaces sequences
-words math.floats.private layouts quotations locals cpu.x86
-compiler.codegen compiler.cfg.templates compiler.cfg.builder
-compiler.cfg.registers compiler.constants compiler.backend
-compiler.backend.x86 ;
-IN: compiler.backend.x86.sse2
-
-M:: x86 %box-float ( dst src temp -- )
-    #! Only called by pentium4 backend, uses SSE2 instruction
-    dst 16 float float temp %allot
-    dst 8 float tag-number - [+] src MOVSD ;
-
-M: x86 %unbox-float ( dst src -- )
-    float-offset [+] MOVSD ;
-
-: define-float-op ( word op -- )
-    [ "x" operand "y" operand ] swap suffix T{ template
-        { input { { float "x" } { float "y" } } }
-        { output { "x" } }
-    } define-intrinsic ;
-
-{
-    { float+ ADDSD }
-    { float- SUBSD }
-    { float* MULSD }
-    { float/f DIVSD }
-} [
-    first2 define-float-op
-] each
-
-: define-float-jump ( word op -- )
-    [ "x" operand "y" operand UCOMISD ] swap suffix
-    { { float "x" } { float "y" } } define-if-intrinsic ;
-
-{
-    { float< JAE }
-    { float<= JA }
-    { float> JBE }
-    { float>= JB }
-    { float= JNE }
-} [
-    first2 define-float-jump
-] each
-
-\ float>fixnum [
-    "out" operand "in" operand CVTTSD2SI
-    "out" operand tag-bits get SHL
-] T{ template
-    { input { { float "in" } } }
-    { scratch { { f "out" } } }
-    { output { "out" } }
-} define-intrinsic
-
-\ fixnum>float [
-    "in" operand %untag-fixnum
-    "out" operand "in" operand CVTSI2SD
-] T{ template
-    { input { { f "in" } } }
-    { scratch { { float "out" } } }
-    { output { "out" } }
-    { clobber { "in" } }
-} define-intrinsic
-
-: alien-float-get-template
-    T{ template
-        { input {
-            { unboxed-c-ptr "alien" c-ptr }
-            { f "offset" fixnum }
-        } }
-        { scratch { { float "value" } } }
-        { output { "value" } }
-        { clobber { "offset" } }
-    } ;
-
-: alien-float-set-template
-    T{ template
-        { input {
-            { float "value" float }
-            { unboxed-c-ptr "alien" c-ptr }
-            { f "offset" fixnum }
-        } }
-        { clobber { "offset" } }
-    } ;
-
-: define-alien-float-intrinsics ( word get-quot word set-quot -- )
-    [ "value" operand swap %alien-accessor ] curry
-    alien-float-set-template
-    define-intrinsic
-    [ "value" operand swap %alien-accessor ] curry
-    alien-float-get-template
-    define-intrinsic ;
-
-\ alien-double
-[ MOVSD ]
-\ set-alien-double
-[ swap MOVSD ]
-define-alien-float-intrinsics
-
-\ alien-float
-[ dupd MOVSS dup CVTSS2SD ]
-\ set-alien-float
-[ swap dup dup CVTSD2SS MOVSS ]
-define-alien-float-intrinsics
diff --git a/unfinished/compiler/backend/x86/x86.factor b/unfinished/compiler/backend/x86/x86.factor
deleted file mode 100644
index da0586a7b9..0000000000
--- a/unfinished/compiler/backend/x86/x86.factor
+++ /dev/null
@@ -1,643 +0,0 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays byte-arrays alien.accessors
-compiler.backend kernel kernel.private math memory namespaces
-make sequences words system layouts combinators math.order
-math.private alien alien.c-types slots.private cpu.x86
-cpu.x86.private locals compiler.backend compiler.codegen.fixup
-compiler.constants compiler.intrinsics compiler.cfg.builder
-compiler.cfg.registers compiler.cfg.stacks
-compiler.cfg.templates compiler.codegen ;
-IN: compiler.backend.x86
-
-HOOK: ds-reg cpu ( -- reg )
-HOOK: rs-reg cpu ( -- reg )
-HOOK: stack-reg cpu ( -- reg )
-HOOK: stack-save-reg cpu ( -- reg )
-
-: stack@ ( n -- op ) stack-reg swap [+] ;
-
-: reg-stack ( n reg -- op ) swap cells neg [+] ;
-
-GENERIC: loc>operand ( loc -- operand )
-
-M: ds-loc loc>operand n>> ds-reg reg-stack ;
-M: rs-loc loc>operand n>> rs-reg reg-stack ;
-
-M: int-regs %save-param-reg drop >r stack@ r> MOV ;
-M: int-regs %load-param-reg drop swap stack@ MOV ;
-
-GENERIC: MOVSS/D ( dst src reg-class -- )
-
-M: single-float-regs MOVSS/D drop MOVSS ;
-M: double-float-regs MOVSS/D drop MOVSD ;
-
-M: float-regs %save-param-reg >r >r stack@ r> r> MOVSS/D ;
-M: float-regs %load-param-reg >r swap stack@ r> MOVSS/D ;
-
-GENERIC: push-return-reg ( reg-class -- )
-GENERIC: load-return-reg ( stack@ reg-class -- )
-GENERIC: store-return-reg ( stack@ reg-class -- )
-
-! Only used by inline allocation
-HOOK: temp-reg-1 cpu ( -- reg )
-HOOK: temp-reg-2 cpu ( -- reg )
-
-HOOK: fixnum>slot@ cpu ( op -- )
-
-HOOK: prepare-division cpu ( -- )
-
-M: f load-literal
-    \ f tag-number MOV drop ;
-
-M: fixnum load-literal
-    swap tag-fixnum MOV ;
-
-M: x86 stack-frame ( n -- i )
-    3 cells + 16 align cell - ;
-
-: factor-area-size ( -- n ) 4 cells ;
-
-M: x86 %prologue ( n -- )
-    temp-reg-1 0 MOV rc-absolute-cell rel-this
-    dup cell + PUSH
-    temp-reg-1 PUSH
-    stack-reg swap 2 cells - SUB ;
-
-M: x86 %epilogue ( n -- )
-    stack-reg swap ADD ;
-
-HOOK: %alien-global cpu ( symbol dll register -- )
-
-M: x86 %prepare-alien-invoke
-    #! Save Factor stack pointers in case the C code calls a
-    #! callback which does a GC, which must reliably trace
-    #! all roots.
-    "stack_chain" f temp-reg-1 %alien-global
-    temp-reg-1 [] stack-reg MOV
-    temp-reg-1 [] cell SUB
-    temp-reg-1 2 cells [+] ds-reg MOV
-    temp-reg-1 3 cells [+] rs-reg MOV ;
-
-M: x86 %call ( label -- ) CALL ;
-
-M: x86 %jump-label ( label -- ) JMP ;
-
-M: x86 %jump-f ( label vreg -- ) \ f tag-number CMP JE ;
-
-M: x86 %jump-t ( label vreg -- ) \ f tag-number CMP JNE ;
-
-: code-alignment ( -- n )
-    building get length dup cell align swap - ;
-
-: align-code ( n -- )
-    0 <repetition> % ;
-
-M:: x86 %dispatch ( src temp -- )
-    ! Load jump table base. We use a temporary register
-    ! since on AMD64 we have to load a 64-bit immediate. On
-    ! x86, this is redundant.
-    ! Untag and multiply to get a jump table offset
-    src fixnum>slot@
-    ! Add jump table base
-    temp HEX: ffffffff MOV rc-absolute-cell rel-here
-    src temp ADD
-    src HEX: 7f [+] JMP
-    ! Fix up the displacement above
-    code-alignment dup bootstrap-cell 8 = 15 9 ? +
-    building get dup pop* push
-    align-code ;
-
-M: x86 %dispatch-label ( word -- )
-    0 cell, rc-absolute-cell rel-word ;
-
-M: x86 %peek loc>operand MOV ;
-
-M: x86 %replace loc>operand swap MOV ;
-
-: (%inc) ( n reg -- ) swap cells dup 0 > [ ADD ] [ neg SUB ] if ;
-
-M: x86 %inc-d ( n -- ) ds-reg (%inc) ;
-
-M: x86 %inc-r ( n -- ) rs-reg (%inc) ;
-
-M: x86 fp-shadows-int? ( -- ? ) f ;
-
-M: x86 value-structs? t ;
-
-M: x86 small-enough? ( n -- ? )
-    HEX: -80000000 HEX: 7fffffff between? ;
-
-: %untag ( reg -- ) tag-mask get bitnot AND ;
-
-: %untag-fixnum ( reg -- ) tag-bits get SAR ;
-
-: %tag-fixnum ( reg -- ) tag-bits get SHL ;
-
-: temp@ ( n -- op ) stack-reg \ stack-frame get rot - [+] ;
-
-M: x86 %return ( -- ) 0 %unwind ;
-
-! Alien intrinsics
-M: x86 %unbox-byte-array ( dst src -- )
-    byte-array-offset [+] LEA ;
-
-M: x86 %unbox-alien ( dst src -- )
-    alien-offset [+] MOV ;
-
-M: x86 %unbox-f ( dst src -- )
-    drop 0 MOV ;
-
-M: x86 %unbox-any-c-ptr ( dst src -- )
-    { "is-byte-array" "end" "start" } [ define-label ] each
-    ! Address is computed in ds-reg
-    ds-reg PUSH
-    ds-reg 0 MOV
-    ! Object is stored in ds-reg
-    rs-reg PUSH
-    rs-reg swap MOV
-    ! We come back here with displaced aliens
-    "start" resolve-label
-    ! Is the object f?
-    rs-reg \ f tag-number CMP
-    "end" get JE
-    ! Is the object an alien?
-    rs-reg header-offset [+] alien type-number tag-fixnum CMP
-    "is-byte-array" get JNE
-    ! If so, load the offset and add it to the address
-    ds-reg rs-reg alien-offset [+] ADD
-    ! Now recurse on the underlying alien
-    rs-reg rs-reg underlying-alien-offset [+] MOV
-    "start" get JMP
-    "is-byte-array" resolve-label
-    ! Add byte array address to address being computed
-    ds-reg rs-reg ADD
-    ! Add an offset to start of byte array's data
-    ds-reg byte-array-offset ADD
-    "end" resolve-label
-    ! Done, store address in destination register
-    ds-reg MOV
-    ! Restore rs-reg
-    rs-reg POP
-    ! Restore ds-reg
-    ds-reg POP ;
-
-M:: x86 %write-barrier ( src temp -- )
-    #! Mark the card pointed to by vreg.
-    ! Mark the card
-    src card-bits SHR
-    "cards_offset" f temp %alien-global
-    temp temp [+] card-mark <byte> MOV
-
-    ! Mark the card deck
-    temp deck-bits card-bits - SHR
-    "decks_offset" f temp %alien-global
-    temp temp [+] card-mark <byte> MOV ;
-
-: load-zone-ptr ( reg -- )
-    #! Load pointer to start of zone array
-    0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
-
-: load-allot-ptr ( temp -- )
-    [ load-zone-ptr ] [ PUSH ] [ dup cell [+] MOV ] tri ;
-
-: inc-allot-ptr ( n temp -- )
-    [ POP ] [ cell [+] swap 8 align ADD ] bi ;
-
-: store-header ( temp type -- )
-    [ 0 [+] ] [ type-number tag-fixnum ] bi* MOV ;
-
-: store-tagged ( dst temp tag -- )
-    dupd tag-number OR MOV ;
-
-M:: x86 %allot ( dst size type tag temp -- )
-    temp load-allot-ptr
-    temp type store-header
-    temp size inc-allot-ptr
-    dst temp store-tagged ;
-
-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
-    %prepare-alien-invoke
-    "minor_gc" f %alien-invoke
-    "end" resolve-label ;
-
-: bignum@ ( reg n -- op ) cells bignum tag-number - [+] ;
-
-:: %allot-bignum-signed-1 ( dst src temp -- )
-    #! on entry, inreg is a signed 32-bit quantity
-    #! exits with tagged ptr to bignum in outreg
-    #! 1 cell header, 1 cell length, 1 cell sign, + digits
-    #! length is the # of digits + sign
-    [
-        { "end" "nonzero" "positive" "store" } [ define-label ] each
-        src 0 CMP ! is it zero?
-        "nonzero" get JNE
-        ! Use cached zero value
-        0 >bignum dst load-indirect
-        "end" get JMP
-        "nonzero" resolve-label
-        ! Allocate a bignum
-        dst 4 cells bignum bignum temp %allot
-        ! Write length
-        dst 1 bignum@ 2 MOV
-        ! Test sign
-        src 0 CMP
-        "positive" get JGE
-        dst 2 bignum@ 1 MOV ! negative sign
-        src NEG
-        "store" get JMP
-        "positive" resolve-label
-        dst 2 bignum@ 0 MOV ! positive sign
-        "store" resolve-label
-        dst 3 bignum@ src MOV
-        "end" resolve-label
-    ] with-scope ;
-
-: alien@ ( reg n -- op ) cells object tag-number - [+] ;
-
-M:: x86 %box-alien ( dst src temp -- )
-    [
-        { "end" "f" } [ define-label ] each
-        src 0 CMP
-        "f" get JE
-        dst 4 cells alien object temp %allot
-        dst 1 alien@ \ f tag-number MOV
-        dst 2 alien@ \ f tag-number MOV
-        ! Store src in alien-offset slot
-        dst 3 alien@ src MOV
-        "end" get JMP
-        "f" resolve-label
-        \ f tag-number MOV
-        "end" resolve-label
-    ] with-scope ;
-
-! Type checks
-\ tag [
-    "in" operand tag-mask get AND
-    "in" operand %tag-fixnum
-] T{ template
-    { input { { f "in" } } }
-    { output { "in" } }
-} define-intrinsic
-
-! Slots
-: %slot-literal-known-tag ( -- op )
-    "obj" operand
-    "n" get cells
-    "obj" operand-tag - [+] ;
-
-: %slot-literal-any-tag ( -- op )
-    "obj" operand %untag
-    "obj" operand "n" get cells [+] ;
-
-: %slot-any ( -- op )
-    "obj" operand %untag
-    "n" operand fixnum>slot@
-    "obj" operand "n" operand [+] ;
-
-\ slot {
-    ! Slot number is literal and the tag is known
-    {
-        [ "val" operand %slot-literal-known-tag MOV ] T{ template
-            { input { { f "obj" known-tag } { small-slot "n" } } }
-            { scratch { { f "val" } } }
-            { output { "val" } }
-        }
-    }
-    ! Slot number is literal
-    {
-        [ "obj" operand %slot-literal-any-tag MOV ] T{ template
-            { input { { f "obj" } { small-slot "n" } } }
-            { output { "obj" } }
-        }
-    }
-    ! Slot number in a register
-    {
-        [ "obj" operand %slot-any MOV ] T{ template
-            { input { { f "obj" } { f "n" } } }
-            { output { "obj" } }
-            { clobber { "n" } }
-        }
-    }
-} define-intrinsics
-
-\ (set-slot) {
-    ! Slot number is literal and the tag is known
-    {
-        [ %slot-literal-known-tag "val" operand MOV ] T{ template
-            { input { { f "val" } { f "obj" known-tag } { small-slot "n" } } }
-            { scratch { { f "scratch" } } }
-            { clobber { "obj" } }
-        }
-    }
-    ! Slot number is literal
-    {
-        [ %slot-literal-any-tag "val" operand MOV ] T{ template
-            { input { { f "val" } { f "obj" } { small-slot "n" } } }
-            { scratch { { f "scratch" } } }
-            { clobber { "obj" } }
-        }
-    }
-    ! Slot number in a register
-    {
-        [ %slot-any "val" operand MOV ] T{ template
-            { input { { f "val" } { f "obj" } { f "n" } } }
-            { scratch { { f "scratch" } } }
-            { clobber { "obj" "n" } }
-        }
-    }
-} define-intrinsics
-
-! Sometimes, we need to do stuff with operands which are
-! less than the word size. Instead of teaching the register
-! allocator about the different sized registers, with all
-! the complexity this entails, we just push/pop a register
-! which is guaranteed to be unused (the tempreg)
-: small-reg cell 8 = RBX EBX ? ; inline
-: small-reg-8 BL ; inline
-: small-reg-16 BX ; inline
-: small-reg-32 EBX ; inline
-
-! Fixnums
-: fixnum-op ( op hash -- pair )
-    >r [ "x" operand "y" operand ] swap suffix r> 2array ;
-
-: fixnum-value-op ( op -- pair )
-    T{ template
-        { input { { f "x" } { small-tagged "y" } } }
-        { output { "x" } }
-    } fixnum-op ;
-
-: fixnum-register-op ( op -- pair )
-    T{ template
-        { input { { f "x" } { f "y" } } }
-        { output { "x" } }
-    } fixnum-op ;
-
-: define-fixnum-op ( word op -- )
-    [ fixnum-value-op ] keep fixnum-register-op
-    2array define-intrinsics ;
-
-{
-    { fixnum+fast ADD }
-    { fixnum-fast SUB }
-    { fixnum-bitand AND }
-    { fixnum-bitor OR }
-    { fixnum-bitxor XOR }
-} [
-    first2 define-fixnum-op
-] each
-
-\ fixnum-bitnot [
-    "x" operand NOT
-    "x" operand tag-mask get XOR
-] T{ template
-    { input { { f "x" } } }
-    { output { "x" } }
-} define-intrinsic
-
-\ fixnum*fast {
-    {
-        [
-            "x" operand "y" get IMUL2
-        ] T{ template
-            { input { { f "x" } { [ small-tagged? ] "y" } } }
-            { output { "x" } }
-        }
-    } {
-        [
-            "out" operand "x" operand MOV
-            "out" operand %untag-fixnum
-            "y" operand "out" operand IMUL2
-        ] T{ template
-            { input { { f "x" } { f "y" } } }
-            { scratch { { f "out" } } }
-            { output { "out" } }
-        }
-    }
-} define-intrinsics
-
-: %untag-fixnums ( seq -- )
-    [ %untag-fixnum ] unique-operands ;
-
-\ fixnum-shift-fast [
-    "x" operand "y" get
-    dup 0 < [ neg SAR ] [ SHL ] if
-    ! Mask off low bits
-    "x" operand %untag
-] T{ template
-    { input { { f "x" } { [ ] "y" } } }
-    { output { "x" } }
-} define-intrinsic
-
-: overflow-check ( word -- )
-    "end" define-label
-    "z" operand "x" operand MOV
-    "z" operand "y" operand pick execute
-    ! If the previous arithmetic operation overflowed, then we
-    ! turn the result into a bignum and leave it in EAX.
-    "end" get JNO
-    ! There was an overflow. Recompute the original operand.
-    { "y" "x" } %untag-fixnums
-    "x" operand "y" operand rot execute
-    "z" operand "x" operand "y" operand %allot-bignum-signed-1
-    "end" resolve-label ; inline
-
-: overflow-template ( word insn -- )
-    [ overflow-check ] curry T{ template
-        { input { { f "x" } { f "y" } } }
-        { scratch { { f "z" } } }
-        { output { "z" } }
-        { clobber { "x" "y" } }
-        { gc t }
-    } define-intrinsic ;
-
-\ fixnum+ \ ADD overflow-template
-\ fixnum- \ SUB overflow-template
-
-: fixnum-jump ( op inputs -- pair )
-    >r [ "x" operand "y" operand CMP ] swap suffix r> 2array ;
-
-: fixnum-value-jump ( op -- pair )
-    { { f "x" } { [ small-tagged? ] "y" } } fixnum-jump ;
-
-: fixnum-register-jump ( op -- pair )
-    { { f "x" } { f "y" } } fixnum-jump ;
-
-: define-fixnum-jump ( word op -- )
-    [ fixnum-value-jump ] keep fixnum-register-jump
-    2array define-if-intrinsics ;
-
-{
-    { fixnum< JL }
-    { fixnum<= JLE }
-    { fixnum> JG }
-    { fixnum>= JGE }
-    { eq? JE }
-} [
-    first2 define-fixnum-jump
-] each
-
-\ fixnum>bignum [
-    "x" operand %untag-fixnum
-    "x" operand dup "scratch" operand %allot-bignum-signed-1
-] T{ template
-    { input { { f "x" } } }
-    { scratch { { f "scratch" } } }
-    { output { "x" } }
-    { gc t }
-} define-intrinsic
-
-\ bignum>fixnum [
-    "nonzero" define-label
-    "positive" define-label
-    "end" define-label
-    "x" operand %untag
-    "y" operand "x" operand cell [+] MOV
-     ! if the length is 1, its just the sign and nothing else,
-     ! so output 0
-    "y" operand 1 tag-fixnum CMP
-    "nonzero" get JNE
-    "y" operand 0 MOV
-    "end" get JMP
-    "nonzero" resolve-label
-    ! load the value
-    "y" operand "x" operand 3 cells [+] MOV
-    ! load the sign
-    "x" operand "x" operand 2 cells [+] MOV
-    ! is the sign negative?
-    "x" operand 0 CMP
-    "positive" get JE
-    "y" operand -1 IMUL2
-    "positive" resolve-label
-    "y" operand 3 SHL
-    "end" resolve-label
-] T{ template
-    { input { { f "x" } } }
-    { scratch { { f "y" } } }
-    { clobber { "x" } }
-    { output { "y" } }
-} define-intrinsic
-
-! User environment
-: %userenv ( -- )
-    "x" operand 0 MOV
-    "userenv" f rc-absolute-cell rel-dlsym
-    "n" operand fixnum>slot@
-    "n" operand "x" operand ADD ;
-
-\ getenv [
-    %userenv  "n" operand dup [] MOV
-] T{ template
-    { input { { f "n" } } }
-    { scratch { { f "x" } } }
-    { output { "n" } }
-} define-intrinsic
-
-\ setenv [
-    %userenv  "n" operand [] "val" operand MOV
-] T{ template
-    { input { { f "val" } { f "n" } } }
-    { scratch { { f "x" } } }
-    { clobber { "n" } }
-} define-intrinsic
-
-! Alien intrinsics
-: %alien-accessor ( quot -- )
-    "offset" operand %untag-fixnum
-    "offset" operand "alien" operand ADD
-    "offset" operand [] swap call ; inline
-
-: %alien-integer-get ( quot reg -- )
-    small-reg PUSH
-    swap %alien-accessor
-    "value" operand small-reg MOV
-    "value" operand %tag-fixnum
-    small-reg POP ; inline
-
-: alien-integer-get-template
-    T{ template
-        { input {
-            { unboxed-c-ptr "alien" c-ptr }
-            { f "offset" fixnum }
-        } }
-        { scratch { { f "value" } } }
-        { output { "value" } }
-        { clobber { "offset" } }
-    } ;
-
-: define-getter ( word quot reg -- )
-    [ %alien-integer-get ] 2curry
-    alien-integer-get-template
-    define-intrinsic ;
-
-: define-unsigned-getter ( word reg -- )
-    [ small-reg dup XOR MOV ] swap define-getter ;
-
-: define-signed-getter ( word reg -- )
-    [ [ >r MOV small-reg r> MOVSX ] curry ] keep define-getter ;
-
-: %alien-integer-set ( quot reg -- )
-    small-reg PUSH
-    small-reg "value" operand MOV
-    small-reg %untag-fixnum
-    swap %alien-accessor
-    small-reg POP ; inline
-
-: alien-integer-set-template
-    T{ template
-        { input {
-            { f "value" fixnum }
-            { unboxed-c-ptr "alien" c-ptr }
-            { f "offset" fixnum }
-        } }
-        { clobber { "value" "offset" } }
-    } ;
-
-: define-setter ( word reg -- )
-    [ swap MOV ] swap
-    [ %alien-integer-set ] 2curry
-    alien-integer-set-template
-    define-intrinsic ;
-
-\ alien-unsigned-1 small-reg-8 define-unsigned-getter
-\ set-alien-unsigned-1 small-reg-8 define-setter
-
-\ alien-signed-1 small-reg-8 define-signed-getter
-\ set-alien-signed-1 small-reg-8 define-setter
-
-\ alien-unsigned-2 small-reg-16 define-unsigned-getter
-\ set-alien-unsigned-2 small-reg-16 define-setter
-
-\ alien-signed-2 small-reg-16 define-signed-getter
-\ set-alien-signed-2 small-reg-16 define-setter
-
-\ alien-cell [
-    "value" operand [ MOV ] %alien-accessor
-] T{ template
-    { input {
-        { unboxed-c-ptr "alien" c-ptr }
-        { f "offset" fixnum }
-    } }
-    { scratch { { unboxed-alien "value" } } }
-    { output { "value" } }
-    { clobber { "offset" } }
-} define-intrinsic
-
-\ set-alien-cell [
-    "value" operand [ swap MOV ] %alien-accessor
-] T{ template
-    { input {
-        { unboxed-c-ptr "value" pinned-c-ptr }
-        { unboxed-c-ptr "alien" c-ptr }
-        { f "offset" fixnum }
-    } }
-    { clobber { "offset" } }
-} define-intrinsic