From 17d6efb543cb064a971bf8b7b7209d9f75df2abb Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Fri, 28 Apr 2006 22:38:48 +0000
Subject: [PATCH] Removing linear IR

---
 TODO.FACTOR.txt                            |   2 -
 library/alien/alien-callback.factor        |  25 +-
 library/alien/alien-invoke.factor          |  20 +-
 library/alien/compiler.factor              |  12 +-
 library/bootstrap/boot-stage1.factor       |  14 +-
 library/bootstrap/boot-stage2.factor       |   7 +-
 library/compiler/amd64/architecture.factor |   4 -
 library/compiler/architecture.factor       | 108 ++++++-
 library/compiler/compiler.factor           |  20 +-
 library/compiler/generator.factor          | 222 +++++++++++---
 library/compiler/linearizer.factor         | 134 --------
 library/compiler/ppc/alien.factor          |  89 ------
 library/compiler/ppc/architecture.factor   | 163 +++++++++-
 library/compiler/ppc/fixnum.factor         | 133 --------
 library/compiler/ppc/generator.factor      | 108 -------
 library/compiler/ppc/intrinsics.factor     | 225 ++++++++++++++
 library/compiler/ppc/slots.factor          |  64 ----
 library/compiler/ppc/stack.factor          |  39 ---
 library/compiler/stack.factor              |  47 ---
 library/compiler/templates.factor          |   8 +-
 library/compiler/vops.factor               | 340 ---------------------
 library/compiler/x86/architecture.factor   |   4 -
 library/compiler/xt.factor                 |   8 +-
 library/test/compiler/ifte.factor          |   1 +
 library/test/compiler/intrinsics.factor    |  74 ++---
 library/test/compiler/linearizer.factor    |  15 -
 library/test/compiler/simple.factor        |   5 +
 library/test/test.factor                   |   2 +-
 28 files changed, 775 insertions(+), 1118 deletions(-)
 delete mode 100644 library/compiler/linearizer.factor
 delete mode 100644 library/compiler/ppc/alien.factor
 delete mode 100644 library/compiler/ppc/fixnum.factor
 delete mode 100644 library/compiler/ppc/generator.factor
 create mode 100644 library/compiler/ppc/intrinsics.factor
 delete mode 100644 library/compiler/ppc/slots.factor
 delete mode 100644 library/compiler/ppc/stack.factor
 delete mode 100644 library/compiler/stack.factor
 delete mode 100644 library/compiler/vops.factor
 delete mode 100644 library/test/compiler/linearizer.factor

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 269f36bf87..6edf8eba78 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -9,8 +9,6 @@ should fix in 0.82:
 - get factor running on mac intel
 - when generating a 32-bit image on a 64-bit system, large numbers which should
   be bignums become fixnums
-- httpd fep
-- SBUF" " i/o bug
 - clicks sent twice
 - speed up ideas:
   - only do clipping for certain gadgets
diff --git a/library/alien/alien-callback.factor b/library/alien/alien-callback.factor
index fef4d10f6c..633b7a86ec 100644
--- a/library/alien/alien-callback.factor
+++ b/library/alien/alien-callback.factor
@@ -32,35 +32,34 @@ M: alien-callback-error summary ( error -- )
 ] "infer" set-word-prop
 
 : box-parameters ( parameters -- )
-    [ box-parameter ] map-parameters % ;
+    [ box-parameter ] each-parameter ;
 
 : registers>objects ( parameters -- )
-    dup \ %freg>stack move-parameters %
-    "nest_stacks" f %alien-invoke , box-parameters ;
+    dup \ %freg>stack move-parameters
+    "nest_stacks" f %alien-invoke box-parameters ;
 
 : unbox-return ( node -- )
     alien-callback-return [
-        "unnest_stacks" f %alien-invoke ,
+        "unnest_stacks" f %alien-invoke
     ] [
         c-type [
             "reg-class" get
             "unboxer-function" get
-            %callback-value ,
+            %callback-value
         ] bind
     ] if-void ;
 
-: linearize-callback ( node -- )
-    dup alien-callback-xt [
-        dup stack-reserve* %prologue ,
+: generate-callback ( node -- )
+    [ alien-callback-xt ] keep [
         dup alien-callback-parameters registers>objects
         dup alien-callback-quot \ init-error-handler swons
-        %alien-callback ,
+        %alien-callback
         unbox-return
-        %return ,
-    ] make-linear ;
+        %return
+    ] generate-block ;
 
-M: alien-callback linearize* ( node -- )
-    end-basic-block compile-gc linearize-callback iterate-next ;
+M: alien-callback generate-node ( node -- )
+    end-basic-block compile-gc generate-callback iterate-next ;
 
 M: alien-callback stack-reserve*
     alien-callback-parameters stack-space ;
diff --git a/library/alien/alien-invoke.factor b/library/alien/alien-invoke.factor
index 853939cc47..213ff16c67 100644
--- a/library/alien/alien-invoke.factor
+++ b/library/alien/alien-invoke.factor
@@ -39,35 +39,35 @@ M: alien-invoke-error summary ( error -- )
     node,
 ] "infer" set-word-prop
 
-: unbox-parameter ( stack# type -- node )
+: unbox-parameter ( stack# type -- )
     c-type [ "reg-class" get "unboxer" get call ] bind ;
 
 : unbox-parameters ( parameters -- )
-    [ unbox-parameter , ] reverse-each-parameter ;
+    [ unbox-parameter ] reverse-each-parameter ;
 
 : objects>registers ( parameters -- )
     #! Generate code for boxing a list of C types, then generate
     #! code for moving these parameters to register on
     #! architectures where parameters are passed in registers
     #! (PowerPC, AMD64).
-    dup unbox-parameters "save_stacks" f %alien-invoke ,
-    \ %stack>freg move-parameters % ;
+    dup unbox-parameters "save_stacks" f %alien-invoke
+    \ %stack>freg move-parameters ;
 
 : box-return ( node -- )
-    alien-invoke-return [ ] [ f swap box-parameter , ] if-void ;
+    alien-invoke-return [ ] [ f swap box-parameter ] if-void ;
 
-: linearize-cleanup ( node -- )
+: generate-cleanup ( node -- )
     dup alien-invoke-library library-abi "stdcall" = [
         drop
     ] [
-        alien-invoke-parameters stack-space %cleanup ,
+        alien-invoke-parameters stack-space %cleanup
     ] if ;
 
-M: alien-invoke linearize* ( node -- )
+M: alien-invoke generate-node ( node -- )
     end-basic-block compile-gc
     dup alien-invoke-parameters objects>registers
-    dup alien-invoke-dlsym %alien-invoke ,
-    dup linearize-cleanup box-return
+    dup alien-invoke-dlsym %alien-invoke
+    dup generate-cleanup box-return
     iterate-next ;
 
 M: alien-invoke stack-reserve*
diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor
index 9deb4f3a2b..63df3cdd23 100644
--- a/library/alien/compiler.factor
+++ b/library/alien/compiler.factor
@@ -36,22 +36,22 @@ kernel-internals math namespaces sequences words ;
         [ c-size cell / "void*" <array> ] [ 1array ] if
     ] map concat ;
 
+: each-parameter ( parameters quot -- )
+    >r [ parameter-sizes ] keep r> 2each ; inline
+
 : reverse-each-parameter ( parameters quot -- )
     >r [ parameter-sizes ] keep
     [ reverse-slice ] 2apply r> 2each ; inline
 
-: map-parameters ( parameters quot -- seq )
-    >r [ parameter-sizes ] keep r> 2map ; inline
-
-: move-parameters ( params vop -- seq )
+: move-parameters ( params vop -- )
     #! Moves values from C stack to registers (if vop is
     #! %stack>freg) and registers to C stack (if vop is
     #! %freg>stack).
     swap [
         flatten-value-types
         0 { int-regs float-regs stack-params } [ set ] each-with
-        [ pick >r alloc-parameter r> execute ] map-parameters
-        nip
+        [ pick >r alloc-parameter r> execute ] each-parameter
+        drop
     ] with-scope ; inline
 
 : box-parameter ( stack# type -- node )
diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor
index e063ee395e..6a928e1e21 100644
--- a/library/bootstrap/boot-stage1.factor
+++ b/library/bootstrap/boot-stage1.factor
@@ -126,12 +126,8 @@ vectors words ;
         "/library/inference/print-dataflow.factor"
 
         "/library/compiler/assembler.factor"
-        "/library/compiler/vops.factor"
         "/library/compiler/templates.factor"
-        "/library/compiler/linearizer.factor"
-        "/library/compiler/stack.factor"
         "/library/compiler/xt.factor"
-        "/library/compiler/intrinsics.factor"
         "/library/compiler/generator.factor"
         "/library/compiler/compiler.factor"
 
@@ -297,11 +293,11 @@ vectors words ;
                 {
                     "/library/compiler/ppc/assembler.factor"
                     "/library/compiler/ppc/architecture.factor"
-                    "/library/compiler/ppc/generator.factor"
-                    "/library/compiler/ppc/slots.factor"
-                    "/library/compiler/ppc/stack.factor"
-                    "/library/compiler/ppc/fixnum.factor"
-                    "/library/compiler/ppc/alien.factor"
+                    ! "/library/compiler/ppc/generator.factor"
+                    ! "/library/compiler/ppc/slots.factor"
+                    ! "/library/compiler/ppc/stack.factor"
+                    ! "/library/compiler/ppc/fixnum.factor"
+                    ! "/library/compiler/ppc/alien.factor"
                 }
             ]
         } {
diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor
index d13befd2b4..ba1de70cb3 100644
--- a/library/bootstrap/boot-stage2.factor
+++ b/library/bootstrap/boot-stage2.factor
@@ -23,12 +23,7 @@ H{ } clone help-graph set-global xref-articles
 
     "Compiling base..." print flush
 
-    {
-        uncons 1+ 1- + <= > >= mod length
-        nth-unsafe set-nth-unsafe
-        = string>number number>string scan
-        kill-values (generate)
-    } [ compile ] each
+    { "kernel" "sequences" "assembler" } compile-vocabs
 
     "Compiling system..." print flush
     compile-all
diff --git a/library/compiler/amd64/architecture.factor b/library/compiler/amd64/architecture.factor
index 6950d4dec3..4922f704d5 100644
--- a/library/compiler/amd64/architecture.factor
+++ b/library/compiler/amd64/architecture.factor
@@ -10,10 +10,6 @@ kernel-internals math namespaces sequences ;
 ! R14 datastack
 ! R15 callstack
 
-: fixnum-imm? ( -- ? )
-    #! Can fixnum operations take immediate operands?
-    f ; inline
-
 : ds-reg R14 ; inline
 : cs-reg R15 ; inline
 : remainder-reg RDX ; inline
diff --git a/library/compiler/architecture.factor b/library/compiler/architecture.factor
index 2325bd7299..acc122ed6a 100644
--- a/library/compiler/architecture.factor
+++ b/library/compiler/architecture.factor
@@ -1,10 +1,110 @@
 IN: compiler
+USING: generic kernel kernel-internals math memory namespaces
+sequences ;
 
-! A few things the front-end needs to know about the back-end.
+! A scratch register for computations
+TUPLE: vreg n ;
 
-DEFER: fixnum-imm? ( -- ? )
-#! Can fixnum operations take immediate operands?
+! Register classes
+TUPLE: int-regs ;
+TUPLE: float-regs size ;
 
+! A pseudo-register class for parameters spilled on the stack
+TUPLE: 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: fastcall-regs ( register-class -- regs )
+
+! Sequence mapping vreg-n to native assembler registers
 DEFER: vregs ( -- regs )
 
-DEFER: compile-c-call ( library function -- )
+! Load a literal (immediate or indirect)
+G: load-literal ( obj vreg -- ) 1 standard-combination ;
+
+! Set up caller stack frame (PowerPC and AMD64)
+DEFER: %prologue ( n -- )
+
+! Tail call another word
+DEFER: %jump ( label -- )
+
+! Call another word
+DEFER: %call ( label -- )
+
+! Local jump for branches or tail calls in nested #label
+DEFER: %jump-label ( label -- )
+
+! Test if vreg is 'f' or not
+DEFER: %jump-t ( label vreg -- )
+
+! Jump table of addresses (one cell each) is right after this
+DEFER: %dispatch ( vreg -- )
+
+! Return to caller
+DEFER: %return ( -- )
+
+! Change datastack height
+DEFER: %inc-d ( n -- )
+
+! Change callstack height
+DEFER: %inc-r ( n -- )
+
+! Load stack into vreg
+DEFER: %peek ( vreg loc -- )
+
+! Store vreg to stack
+DEFER: %replace ( vreg loc -- )
+
+! FFI stuff
+DEFER: %unbox ( n reg-class func -- )
+
+DEFER: %unbox-struct ( n reg-class size -- )
+
+DEFER: %box ( n reg-class func -- )
+
+DEFER: %box-struct ( n reg-class size -- )
+
+DEFER: %alien-invoke ( library function -- )
+
+DEFER: %alien-callback ( quot -- )
+
+DEFER: %callback-value ( reg-class func -- )
+
+! A few FFI operations have default implementations
+: %cleanup ( n -- ) drop ;
+
+: %stack>freg ( n reg reg-class -- ) 3drop ;
+
+: %freg>stack ( n reg reg-class -- ) 3drop ;
+
+! Some stuff probably not worth redefining in other backends
+M: stack-params fastcall-regs drop 0 ;
+
+GENERIC: reg-size ( register-class -- n )
+
+GENERIC: inc-reg-class ( register-class -- )
+
+M: int-regs reg-size drop cell ;
+
+: (inc-reg-class)
+    dup class inc
+    macosx? [ reg-size stack-params +@ ] [ drop ] if ;
+
+M: int-regs inc-reg-class
+    (inc-reg-class) ;
+
+M: float-regs reg-size float-regs-size ;
+
+M: float-regs inc-reg-class
+    dup (inc-reg-class)
+    macosx? [ reg-size 4 / int-regs +@ ] [ drop ] if ;
+
+GENERIC: v>operand
+
+M: integer v>operand tag-bits shift ;
+
+M: vreg v>operand vreg-n vregs nth ;
+
+M: f v>operand address ;
diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor
index e3f5d2885a..ec7681d4ef 100644
--- a/library/compiler/compiler.factor
+++ b/library/compiler/compiler.factor
@@ -5,23 +5,21 @@ USING: errors hashtables inference io kernel lists math
 namespaces optimizer prettyprint sequences test words ;
 
 : (compile) ( word -- )
-    #! Should be called inside the with-compiler scope.
-    dup word-def dataflow optimize linearize
-    [ generate ] hash-each ;
-
-: benchmark-compile
-    [ [ (compile) ] keep ] benchmark nip
+    [
+        [
+            dup word-def dataflow optimize generate
+        ] keep
+    ] benchmark nip
     "compile-time" set-word-prop ;
 
 : inform-compile ( word -- ) "Compiling " write . flush ;
 
 : compile-postponed ( -- )
     compile-words get dup empty? [
-        dup pop
-        dup inform-compile
-        benchmark-compile
-        compile-postponed
-    ] unless drop ;
+        drop
+    ] [
+        pop dup inform-compile (compile) compile-postponed
+    ] if ;
 
 : compile ( word -- )
     [ postpone-word compile-postponed ] with-compiler ;
diff --git a/library/compiler/generator.factor b/library/compiler/generator.factor
index 78c6e40fe1..0d3b2862a9 100644
--- a/library/compiler/generator.factor
+++ b/library/compiler/generator.factor
@@ -1,18 +1,39 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! Copyright (C) 2004, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 IN: compiler
-USING: alien assembler errors inference kernel
-kernel-internals lists math memory namespaces sequences strings
-vectors words ;
+USING: arrays assembler errors generic hashtables inference
+kernel kernel-internals lists math namespaces queues sequences
+words ;
 
-! Compile a VOP.
-GENERIC: generate-node ( vop -- )
+GENERIC: stack-reserve*
 
-: generate-code ( word linear -- length )
+M: object stack-reserve* drop 0 ;
+
+: stack-reserve ( node -- n )
+    0 swap [ stack-reserve* max ] each-node ;
+
+DEFER: #terminal?
+
+PREDICATE: #merge #terminal-merge node-successor #terminal? ;
+
+PREDICATE: #call #terminal-call
+    dup node-successor node-successor #terminal?
+    swap if-intrinsic and ;
+
+UNION: #terminal
+    POSTPONE: f #return #values #terminal-merge ;
+
+: tail-call? ( -- ? )
+    node-stack get [
+        dup #terminal-call? swap node-successor #terminal? or
+    ] all? ;
+
+: generate-code ( word node quot -- length | quot: node -- )
     compiled-offset >r
     compile-aligned
-    swap save-xt
-    [ dup [ generate-node ] with-vop ] each
+    rot save-xt
+    over stack-reserve %prologue
+    call
     compile-aligned
     compiled-offset r> - ;
 
@@ -21,46 +42,175 @@ GENERIC: generate-node ( vop -- )
     dup [ assemble-cell ] each
     length cells ;
 
-: (generate) ( word linear -- )
-    #! Compile a word definition from linear IR.
-    V{ } clone relocation-table set
-    begin-assembly swap >r >r
-        generate-code
-        generate-reloc
-    r> set-compiled-cell
-    r> set-compiled-cell ;
-
 SYMBOL: previous-offset
 
-: generate ( word linear -- )
+: begin-generating ( -- code-len-fixup reloc-len-fixup )
+    compiled-offset previous-offset set
+    V{ } clone relocation-table set
+    init-templates begin-assembly swap ;
+
+: generate-1 ( word node quot -- | quot: node -- )
     #! If generation fails, reset compiled offset.
     [
-        compiled-offset previous-offset set
-        (generate)
+        begin-generating >r >r
+            generate-code
+            generate-reloc
+        r> set-compiled-cell
+        r> set-compiled-cell
     ] [
-        previous-offset get set-compiled-offset
-        rethrow
+        previous-offset get set-compiled-offset rethrow
     ] recover ;
 
-! A few VOPs have trivial generators.
+SYMBOL: generate-queue
 
-M: %label generate-node ( vop -- )
-    vop-label save-xt ;
+: generate-loop ( -- )
+    generate-queue get dup queue-empty? [
+        drop
+    ] [
+        deque first3 generate-1 generate-loop
+    ] if ;
 
-M: %target-label generate-node ( vop -- )
-    drop label 0 assemble-cell absolute-cell ;
+: generate-block ( word node quot -- | quot: node -- )
+    3array generate-queue get enque ;
 
-M: %cleanup generate-node ( vop -- ) drop ;
+GENERIC: generate-node ( node -- )
 
-M: %freg>stack generate-node ( vop -- ) drop ;
+: generate-nodes ( node -- )
+    [ node@ generate-node ] iterate-nodes end-basic-block ;
 
-M: %stack>freg generate-node ( vop -- ) drop ;
+: generate-word ( node -- )
+    [ [ generate-nodes ] with-node-iterator ]
+    generate-block ;
 
-M: %alien-invoke generate-node
-    #! call a C function.
-    drop 0 input 1 input compile-c-call ;
+: generate ( word node -- )
+    [
+        <queue> generate-queue set
+        generate-word generate-loop 
+    ] with-scope ;
 
-: dest/src ( -- dest src ) 0 output-operand 0 input-operand ;
+! node
+M: node generate-node ( node -- next ) drop iterate-next ;
+
+! #label
+: generate-call ( label -- next )
+    end-basic-block
+    tail-call? [ %jump f ] [ %call iterate-next ] if ;
+
+M: #label generate-node ( node -- next )
+    #! We remap the IR node's label to a new label object here,
+    #! to avoid problems with two IR #label nodes having the
+    #! same label in different lexical scopes.
+    dup node-param dup generate-call >r
+    swap node-child generate-word r> ;
+
+! #if
+: generate-if ( node label -- next )
+    <label> [
+        >r >r node-children first2 generate-nodes
+        r> r> %jump-label save-xt generate-nodes
+    ] keep save-xt iterate-next ;
+
+M: #if generate-node ( node -- next )
+    [
+        end-basic-block
+        <label> dup "flag" get %jump-t
+    ] H{
+        { +input { { 0 "flag" } } }
+    } with-template generate-if ;
+
+! #call
+: [with-template] ( quot template -- quot )
+    2array >list [ with-template ] append ;
+
+: define-intrinsic ( word quot template -- | quot: -- )
+    [with-template] "intrinsic" set-word-prop ;
+
+: intrinsic ( #call -- quot ) node-param "intrinsic" word-prop ;
+
+: define-if-intrinsic ( word quot template -- | quot: label -- )
+    [with-template] "if-intrinsic" set-word-prop ;
+
+: if-intrinsic ( #call -- quot )
+    dup node-successor #if?
+    [ node-param "if-intrinsic" word-prop ] [ drop f ] if ;
+
+M: #call generate-node ( node -- next )
+    dup if-intrinsic [
+        >r <label> dup r> call
+        >r node-successor r> generate-if node-successor
+    ] [
+        dup intrinsic
+        [ call iterate-next ] [ node-param generate-call ] ?if
+    ] if* ;
+
+! #call-label
+M: #call-label generate-node ( node -- next )
+    node-param generate-call ;
+
+! #dispatch
+: target-label ( label -- ) 0 assemble-cell absolute-cell ;
+
+: dispatch-head ( node -- label/node )
+    #! Output the jump table insn and return a list of
+    #! label/branch pairs.
+    [ end-basic-block "n" get %dispatch ]
+    H{ { +input { { 0 "n" } } } } with-template
+    node-children [ <label> dup target-label 2array ] map ;
+
+: dispatch-body ( label/node -- )
+    <label> swap [
+        first2 save-xt generate-nodes end-basic-block
+        dup %jump-label
+    ] each save-xt ;
+
+M: #dispatch generate-node ( node -- next )
+    #! The parameter is a list of nodes, each one is a branch to
+    #! take in case the top of stack has that type.
+    dispatch-head dispatch-body iterate-next ;
+
+! #push
+UNION: immediate fixnum POSTPONE: f ;
+
+: generate-push ( node -- )
+    >#push< dup length dup ensure-vregs
+    alloc-reg# [ <vreg> ] map
+    [ [ load-literal ] 2each ] keep
+    phantom-d get phantom-append ;
+
+M: #push generate-node ( #push -- )
+    generate-push iterate-next ;
+
+! #shuffle
+: phantom-shuffle-input ( n phantom -- seq )
+    2dup length <= [
+        cut-phantom
+    ] [
+        [ phantom-locs ] keep [ length swap head-slice* ] keep
+        [ append 0 ] keep set-length
+    ] if ;
+
+: phantom-shuffle-inputs ( shuffle -- locs locs )
+    dup shuffle-in-d length phantom-d get phantom-shuffle-input
+    swap shuffle-in-r length phantom-r get phantom-shuffle-input ;
+
+: adjust-shuffle ( shuffle -- )
+    dup shuffle-in-d length neg phantom-d get adjust-phantom
+    shuffle-in-r length neg phantom-r get adjust-phantom ;
+
+: shuffle-vregs# ( shuffle -- n )
+    dup shuffle-in-d swap shuffle-in-r additional-vregs# ;
+
+: phantom-shuffle ( shuffle -- )
+    dup shuffle-vregs# ensure-vregs
+    [ phantom-shuffle-inputs ] keep
+    [ shuffle* ] keep adjust-shuffle
+    (template-outputs) ;
+
+M: #shuffle generate-node ( #shuffle -- )
+    node-shuffle phantom-shuffle iterate-next ;
+
+! #return
+M: #return generate-node drop end-basic-block %return f ;
 
 ! These constants must match native/card.h
 : card-bits 7 ;
diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor
deleted file mode 100644
index f26a1506b4..0000000000
--- a/library/compiler/linearizer.factor
+++ /dev/null
@@ -1,134 +0,0 @@
-! Copyright (C) 2004, 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays generic hashtables inference
-kernel math namespaces sequences words ;
-IN: compiler
-
-GENERIC: stack-reserve*
-
-M: object stack-reserve* drop 0 ;
-
-: stack-reserve ( node -- )
-    0 swap [ stack-reserve* max ] each-node ;
-
-DEFER: #terminal?
-
-PREDICATE: #merge #terminal-merge node-successor #terminal? ;
-
-: intrinsic ( #call -- quot ) node-param "intrinsic" word-prop ;
-
-: if-intrinsic ( #call -- quot )
-    dup node-successor #if?
-    [ node-param "if-intrinsic" word-prop ] [ drop f ] if ;
-
-PREDICATE: #call #terminal-call
-    dup node-successor node-successor #terminal?
-    swap if-intrinsic and ;
-
-UNION: #terminal
-    POSTPONE: f #return #values #terminal-merge ;
-
-: tail-call? ( -- ? )
-    node-stack get [
-        dup #terminal-call? swap node-successor #terminal? or
-    ] all? ;
-
-GENERIC: linearize* ( node -- next )
-
-: linearize-child ( node -- )
-    [ node@ linearize* ] iterate-nodes end-basic-block ;
-
-! A map from words to linear IR.
-SYMBOL: linearized
-
-! Renamed labels. To avoid problems with labels with the same
-! name in different scopes.
-SYMBOL: renamed-labels
-
-: make-linear ( word quot -- )
-    [
-        init-templates
-        swap >r { } make r> linearized get set-hash
-    ] with-node-iterator ; inline
-
-: linearize-1 ( word node -- )
-    swap [
-        dup stack-reserve %prologue , linearize-child
-    ] make-linear ;
-
-: init-linearizer ( -- )
-    H{ } clone linearized set
-    H{ } clone renamed-labels set ;
-
-: linearize ( word dataflow -- linearized )
-    #! Outputs a hashtable mapping from labels to their
-    #! respective linear IR.
-    init-linearizer linearize-1 linearized get ;
-
-M: node linearize* ( node -- next ) drop iterate-next ;
-
-: linearize-call ( label -- next )
-    end-basic-block
-    tail-call? [ %jump , f ] [ %call , iterate-next ] if ;
-
-: rename-label ( label -- label )
-    <label> dup rot renamed-labels get set-hash ;
-
-: renamed-label ( label -- label )
-    renamed-labels get hash ;
-
-: linearize-call-label ( label -- next )
-    rename-label linearize-call ;
-
-M: #label linearize* ( node -- next )
-    #! We remap the IR node's label to a new label object here,
-    #! to avoid problems with two IR #label nodes having the
-    #! same label in different lexical scopes.
-    dup node-param dup linearize-call-label >r
-    renamed-label swap node-child linearize-1 r> ;
-
-: linearize-if ( node label -- next )
-    <label> [
-        >r >r node-children first2 linearize-child
-        r> r> %jump-label , %label , linearize-child
-    ] keep %label , iterate-next ;
-
-M: #call linearize* ( node -- next )
-    dup if-intrinsic [
-        >r <label> dup r> call
-        >r node-successor r> linearize-if node-successor
-    ] [
-        dup intrinsic
-        [ call iterate-next ] [ node-param linearize-call ] ?if
-    ] if* ;
-
-M: #call-label linearize* ( node -- next )
-    node-param renamed-label linearize-call ;
-
-M: #if linearize* ( node -- next )
-    [
-        end-basic-block
-        <label> dup "flag" get %jump-t ,
-    ] H{
-        { +input { { 0 "flag" } } }
-    } with-template linearize-if ;
-
-: dispatch-head ( node -- label/node )
-    #! Output the jump table insn and return a list of
-    #! label/branch pairs.
-    [ end-basic-block "n" get %dispatch , ]
-    H{ { +input { { 0 "n" } } } } with-template
-    node-children [ <label> dup %target-label ,  2array ] map ;
-
-: dispatch-body ( label/node -- )
-    <label> swap [
-        first2 %label , linearize-child end-basic-block
-        dup %jump-label ,
-    ] each %label , ;
-
-M: #dispatch linearize* ( node -- next )
-    #! The parameter is a list of nodes, each one is a branch to
-    #! take in case the top of stack has that type.
-    dispatch-head dispatch-body iterate-next ;
-
-M: #return linearize* drop end-basic-block %return , f ;
diff --git a/library/compiler/ppc/alien.factor b/library/compiler/ppc/alien.factor
deleted file mode 100644
index dd7120cdad..0000000000
--- a/library/compiler/ppc/alien.factor
+++ /dev/null
@@ -1,89 +0,0 @@
-! Copyright (C) 2005, 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: compiler
-USING: alien assembler kernel kernel-internals math sequences ;
-
-GENERIC: freg>stack ( stack reg reg-class -- )
-
-GENERIC: stack>freg ( stack reg reg-class -- )
-
-M: int-regs freg>stack drop 1 rot stack@ STW ;
-
-M: int-regs stack>freg drop 1 rot stack@ LWZ ;
-
-: STF float-regs-size 4 = [ STFS ] [ STFD ] if ;
-
-M: float-regs freg>stack >r 1 rot stack@ r> STF ;
-
-: LF float-regs-size 4 = [ LFS ] [ LFD ] if ;
-
-M: float-regs stack>freg >r 1 rot stack@ r> LF ;
-
-M: stack-params stack>freg
-    drop 2dup = [
-        2drop
-    ] [
-        >r 0 1 rot stack@ LWZ 0 1 r> stack@ STW
-    ] if ;
-
-M: stack-params freg>stack
-   >r stack-increment + swap r> stack>freg ;
-
-M: %unbox generate-node ( vop -- )
-    drop
-    ! Call the unboxer
-    2 input f compile-c-call
-    ! Store the return value on the C stack
-    0 input 1 input [ return-reg ] keep freg>stack ;
-
-: struct-ptr/size ( func -- )
-    ! Load destination address
-    3 1 0 input stack@ ADDI
-    ! Load struct size
-    2 input 4 LI
-    f compile-c-call ;
-
-M: %unbox-struct generate-node ( vop -- )
-    drop "unbox_value_struct" struct-ptr/size ;
-
-M: %box-struct generate-node ( vop -- )
-    drop "box_value_struct" struct-ptr/size ;
-
-: (%move) 0 input 1 input 2 input [ fastcall-regs nth ] keep ;
-
-M: %stack>freg generate-node ( vop -- )
-    ! Move a value from the C stack into the fastcall register
-    drop (%move) stack>freg ;
-
-M: %freg>stack generate-node ( vop -- )
-    ! Move a value from a fastcall register to the C stack
-    drop (%move) freg>stack ;
-
-M: %box generate-node ( vop -- )
-    drop
-    ! If the source is a stack location, load it into freg #0.
-    ! If the source is f, then we assume the value is already in
-    ! freg #0.
-    0 input [
-        1 input [ fastcall-regs first ] keep stack>freg
-    ] when*
-    2 input f compile-c-call ;
-
-M: %alien-callback generate-node ( vop -- )
-    drop
-    3 0 input load-indirect
-    "run_callback" f compile-c-call ;
-
-: save-return 0 swap [ return-reg ] keep freg>stack ;
-: load-return 0 swap [ return-reg ] keep stack>freg ;
-
-M: %callback-value generate-node ( vop -- )
-    drop
-    ! Call the unboxer
-    1 input f compile-c-call
-    ! Save return register
-    0 input save-return
-    ! Restore data/callstacks
-    "unnest_stacks" f compile-c-call
-    ! Restore return register
-    0 input load-return ;
diff --git a/library/compiler/ppc/architecture.factor b/library/compiler/ppc/architecture.factor
index f37c35fcbf..7db7535da3 100644
--- a/library/compiler/ppc/architecture.factor
+++ b/library/compiler/ppc/architecture.factor
@@ -1,15 +1,13 @@
 IN: compiler
-USING: assembler kernel kernel-internals math ;
+USING: alien assembler generic kernel kernel-internals math
+memory namespaces sequences words ;
 
 ! PowerPC register assignments
 ! r3-r10 vregs
+! r11 linkage
 ! r14 data stack
 ! r15 call stack
 
-: fixnum-imm? ( -- ? )
-    #! Can fixnum operations take immediate operands?
-    f ; inline
-
 : vregs { 3 4 5 6 7 8 9 10 } ; inline
 
 M: int-regs return-reg drop 3 ;
@@ -21,3 +19,158 @@ M: float-regs fastcall-regs drop { 1 2 3 4 5 6 7 8 } ;
 ! Mach-O -vs- Linux/PPC
 : stack@ macosx? 24 8 ? + ;
 : lr@ macosx? 8 4 ? + ;
+
+GENERIC: loc>operand
+
+M: ds-loc loc>operand ds-loc-n cells neg 14 swap ;
+M: cs-loc loc>operand cs-loc-n cells neg 15 swap ;
+
+M: immediate load-literal ( literal vreg -- )
+    >r address r> v>operand LOAD ;
+
+M: object load-literal ( literal vreg -- )
+    v>operand swap
+    add-literal over
+    LOAD32 rel-2/2 rel-address
+    dup 0 LWZ ;
+
+: stack-increment \ stack-reserve get 32 max stack@ 16 align ;
+
+: %prologue ( n -- )
+    \ stack-reserve set
+    1 1 stack-increment neg STWU
+    0 MFLR
+    0 1 stack-increment lr@ STW ;
+
+: compile-epilogue ( -- )
+    #! At the end of each word that calls a subroutine, we store
+    #! the previous link register value in r0 by popping it off
+    #! the stack, set the link register to the contents of r0,
+    #! and jump to the link register.
+    0 1 stack-increment lr@ LWZ
+    1 1 stack-increment ADDI
+    0 MTLR ;
+
+: word-addr ( word -- )
+    #! Load a word address into r3.
+    dup word-xt 3 LOAD32  rel-2/2 rel-word ;
+
+: %call ( label -- )
+    #! Far C call for primitives, near C call for compiled defs.
+    dup postpone-word
+    dup primitive? [ word-addr  3 MTLR  BLRL ] [ BL ] if ;
+
+: %jump-label ( label -- )
+    #! For tail calls. IP not saved on C stack.
+    dup primitive? [ word-addr  3 MTCTR  BCTR ] [ B ] if ;
+
+: %jump ( label -- )
+    compile-epilogue dup postpone-word %jump-label ;
+
+: %jump-t ( label vreg -- )
+    0 swap v>operand f address CMPI BNE ;
+
+: %dispatch ( vreg -- )
+    v>operand dup dup 1 SRAWI
+    ! The value 24 is a magic number. It is the length of the
+    ! instruction sequence that follows to be generated.
+    compiled-offset 24 + 11 LOAD32  rel-2/2 rel-address
+    dup dup 11 ADD
+    dup dup 0 LWZ
+    MTLR
+    BLR ;
+
+: %return ( -- ) compile-epilogue BLR ;
+
+: %peek ( vreg loc -- ) >r v>operand r> loc>operand LWZ ;
+
+: %replace ( vreg loc -- ) >r v>operand r> loc>operand STW ;
+
+: %inc-d ( n -- ) 14 14 rot cells ADDI ;
+
+: %inc-r ( n -- ) 15 15 rot cells ADDI ;
+
+GENERIC: freg>stack ( stack reg reg-class -- )
+
+GENERIC: stack>freg ( stack reg reg-class -- )
+
+M: int-regs freg>stack drop 1 rot stack@ STW ;
+
+M: int-regs stack>freg drop 1 rot stack@ LWZ ;
+
+: STF float-regs-size 4 = [ STFS ] [ STFD ] if ;
+
+M: float-regs freg>stack >r 1 rot stack@ r> STF ;
+
+: LF float-regs-size 4 = [ LFS ] [ LFD ] if ;
+
+M: float-regs stack>freg >r 1 rot stack@ r> LF ;
+
+M: stack-params stack>freg
+    drop 2dup = [
+        2drop
+    ] [
+        >r 0 1 rot stack@ LWZ 0 1 r> stack@ STW
+    ] if ;
+
+M: stack-params freg>stack
+   >r stack-increment + swap r> stack>freg ;
+
+: (%move) [ fastcall-regs nth ] keep ;
+
+: %stack>freg ( n reg reg-class -- ) (%move) stack>freg ;
+
+: %freg>stack ( n reg reg-class -- ) (%move) freg>stack ;
+
+: %unbox ( n reg-class func -- )
+    ! Call the unboxer
+    f %alien-invoke
+    ! Store the return value on the C stack
+    [ return-reg ] keep freg>stack ;
+
+: %box ( n reg-class func -- )
+    ! If the source is a stack location, load it into freg #0.
+    ! If the source is f, then we assume the value is already in
+    ! freg #0.
+    pick [
+        >r [ fastcall-regs first ] keep stack>freg r>
+    ] [
+        2nip
+    ] if
+    f %alien-invoke ;
+
+: struct-ptr/size ( n reg-class size func -- )
+    rot drop
+    ! Load destination address
+    >r >r 3 1 rot stack@ ADDI r>
+    ! Load struct size
+    4 LI
+    r> f %alien-invoke ;
+
+: %unbox-struct ( n reg-class size -- )
+    "unbox_value_struct" struct-ptr/size ;
+
+: %box-struct ( n reg-class size -- )
+    "box_value_struct" struct-ptr/size ;
+
+: compile-dlsym ( symbol dll register -- )
+    >r 2dup dlsym r> LOAD32 rel-2/2 rel-dlsym ;
+
+: %alien-invoke ( symbol dll -- )
+    11 [ compile-dlsym ] keep MTLR BLRL ;
+
+: %alien-callback ( quot -- )
+    T{ vreg f 0 } load-literal "run_callback" f %alien-invoke ;
+
+: save-return 0 swap [ return-reg ] keep freg>stack ;
+: load-return 0 swap [ return-reg ] keep stack>freg ;
+
+: %callback-value ( reg-class func -- )
+    ! Call the unboxer
+    f %alien-invoke
+    ! Save return register
+    dup save-return
+    ! Restore data/callstacks
+    "unnest_stacks" f %alien-invoke
+    ! Restore return register
+    load-return ;
diff --git a/library/compiler/ppc/fixnum.factor b/library/compiler/ppc/fixnum.factor
deleted file mode 100644
index f5e6b762a8..0000000000
--- a/library/compiler/ppc/fixnum.factor
+++ /dev/null
@@ -1,133 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler
-USING: assembler kernel kernel-internals math
-math-internals memory namespaces words ;
-
-: >3-vop< ( -- out1 in1 in2 )
-    0 output-operand 0 input-operand 1 input-operand ;
-
-: simple-overflow ( inv word -- )
-    >r >r
-    <label> "end" set
-    "end" get BNO
-    >3-vop< r> execute
-    0 input-operand dup untag-fixnum
-    1 input-operand dup untag-fixnum
-    >3-vop< r> execute
-    "s48_long_to_bignum" f compile-c-call
-    ! An untagged pointer to the bignum is now in r3; tag it
-    0 output-operand dup bignum-tag ORI
-    "end" get save-xt ; inline
-
-M: %fixnum+ generate-node ( vop -- )
-    drop 0 MTXER >3-vop< ADDO. \ SUBF \ ADD simple-overflow ;
-
-M: %fixnum+fast generate-node ( vop -- ) drop >3-vop< ADD ;
-
-M: %fixnum-fast generate-node ( vop -- ) drop >3-vop< SUBF ;
-
-M: %fixnum- generate-node ( vop -- )
-    drop 0 MTXER >3-vop< SUBFO. \ ADD \ SUBF simple-overflow ;
-
-M: %fixnum* generate-node ( vop -- )
-    #! Note that this assumes the output will be in r3.
-    drop
-    <label> "end" set
-    1 input-operand dup untag-fixnum
-    0 MTXER
-    0 scratch 0 input-operand 1 input-operand MULLWO.
-    "end" get BNO
-    1 scratch 0 input-operand 1 input-operand MULHW
-    4 1 scratch MR
-    3 0 scratch MR
-    "s48_fixnum_pair_to_bignum" f compile-c-call
-    ! now we have to shift it by three bits to remove the second
-    ! tag
-    tag-bits neg 4 LI
-    "s48_bignum_arithmetic_shift" f compile-c-call
-    ! An untagged pointer to the bignum is now in r3; tag it
-    0 output-operand 0 scratch bignum-tag ORI
-    "end" get save-xt
-    0 output-operand 0 scratch MR ;
-
-: generate-fixnum/i
-    #! This VOP is funny. If there is an overflow, it falls
-    #! through to the end, and the result is in 0 output-operand.
-    #! Otherwise it jumps to the "no-overflow" label and the
-    #! result is in 0 scratch.
-    0 scratch 1 input-operand 0 input-operand DIVW
-    ! if the result is greater than the most positive fixnum,
-    ! which can only ever happen if we do
-    ! most-negative-fixnum -1 /i, then the result is a bignum.
-    <label> "end" set
-    <label> "no-overflow" set
-    most-positive-fixnum 1 scratch LOAD
-    0 scratch 0 1 scratch CMP
-    "no-overflow" get BLE
-    most-negative-fixnum neg 3 LOAD
-    "s48_long_to_bignum" f compile-c-call
-    3 dup bignum-tag ORI ;
-
-M: %fixnum/i generate-node ( vop -- )
-    #! This has specific vreg requirements.
-    drop
-    generate-fixnum/i
-    "end" get B
-    "no-overflow" get save-xt
-    0 scratch 0 output-operand tag-fixnum
-    "end" get save-xt ;
-
-: generate-fixnum-mod
-    #! PowerPC doesn't have a MOD instruction; so we compute
-    #! x-(x/y)*y. Puts the result in 1 scratch.
-    1 scratch 0 scratch 0 input-operand MULLW
-    1 scratch 1 scratch 1 input-operand SUBF ;
-
-M: %fixnum-mod generate-node ( vop -- )
-    drop
-    ! divide in2 by in1, store result in out1
-    0 scratch 1 input-operand 0 input-operand DIVW
-    generate-fixnum-mod
-    0 output-operand 1 scratch MR ;
-
-M: %fixnum/mod generate-node ( vop -- )
-    #! This has specific vreg requirements. Note: if there's an
-    #! overflow, (most-negative-fixnum 1 /mod) the modulus is
-    #! always zero.
-    drop
-    generate-fixnum/i
-    0 0 output-operand LI
-    "end" get B
-    "no-overflow" get save-xt
-    generate-fixnum-mod
-    0 scratch 1 output-operand tag-fixnum
-    0 output-operand 1 scratch MR
-    "end" get save-xt ;
-
-M: %fixnum-bitand generate-node ( vop -- ) drop >3-vop< AND ;
-
-M: %fixnum-bitor generate-node ( vop -- ) drop >3-vop< OR ;
-
-M: %fixnum-bitxor generate-node ( vop -- ) drop >3-vop< XOR ;
-
-M: %fixnum-bitnot generate-node ( vop -- )
-    drop dest/src NOT
-    0 output-operand dup untag ;
-
-M: %fixnum>> generate-node ( vop -- )
-    drop
-    1 input-operand 0 output-operand 0 input SRAWI
-    0 output-operand dup untag ;
-
-M: %fixnum-sgn generate-node ( vop -- )
-    drop dest/src cell-bits 1- SRAWI 0 output-operand dup untag ;
-
-: fixnum-jump ( -- label )
-    1 input-operand 0 0 input-operand CMP label ;
-
-M: %jump-fixnum<  generate-node ( vop -- ) drop fixnum-jump BLT ;
-M: %jump-fixnum<= generate-node ( vop -- ) drop fixnum-jump BLE ;
-M: %jump-fixnum>  generate-node ( vop -- ) drop fixnum-jump BGT ;
-M: %jump-fixnum>= generate-node ( vop -- ) drop fixnum-jump BGE ;
-M: %jump-eq?      generate-node ( vop -- ) drop fixnum-jump BEQ ;
diff --git a/library/compiler/ppc/generator.factor b/library/compiler/ppc/generator.factor
deleted file mode 100644
index 3c9fc49463..0000000000
--- a/library/compiler/ppc/generator.factor
+++ /dev/null
@@ -1,108 +0,0 @@
-! Copyright (C) 2005, 200 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: compiler
-USING: alien assembler inference kernel kernel-internals lists
-math memory namespaces words ;
-
-: compile-dlsym ( symbol dll register -- )
-    >r 2dup dlsym  r> LOAD32 rel-2/2 rel-dlsym ;
-
-: compile-c-call ( symbol dll -- )
-    11 [ compile-dlsym ] keep MTLR  BLRL ;
-
-: stack-increment \ stack-reserve get 32 max stack@ 16 align ;
-
-M: %prologue generate-node ( vop -- )
-    drop
-    0 input \ stack-reserve set
-    1 1 stack-increment neg STWU
-    0 MFLR
-    0 1 stack-increment lr@ STW ;
-
-: compile-epilogue
-    #! At the end of each word that calls a subroutine, we store
-    #! the previous link register value in r0 by popping it off
-    #! the stack, set the link register to the contents of r0,
-    #! and jump to the link register.
-    0 1 stack-increment lr@ LWZ
-    1 1 stack-increment ADDI
-    0 MTLR ;
-
-: word-addr ( word -- )
-    #! Load a word address into r3.
-    dup word-xt 3 LOAD32  rel-2/2 rel-word ;
-
-: compile-call ( label -- )
-    #! Far C call for primitives, near C call for compiled defs.
-    dup postpone-word
-    dup primitive? [ word-addr  3 MTLR  BLRL ] [ BL ] if ;
-
-M: %call generate-node ( vop -- )
-    vop-label compile-call ;
-
-: compile-jump ( label -- )
-    #! For tail calls. IP not saved on C stack.
-    dup postpone-word
-    dup primitive? [ word-addr  3 MTCTR  BCTR ] [ B ] if ;
-
-M: %jump generate-node ( vop -- )
-    drop compile-epilogue label compile-jump ;
-
-M: %jump-label generate-node ( vop -- )
-    drop label compile-jump ;
-
-M: %jump-t generate-node ( vop -- )
-    drop 0 input-operand 0 swap f address CMPI label BNE ;
-
-M: %return generate-node ( vop -- )
-    drop compile-epilogue BLR ;
-
-: untag ( dest src -- ) 0 0 31 tag-bits - RLWINM ;
-
-M: %untag generate-node ( vop -- )
-    drop dest/src untag ;
-
-: tag-fixnum ( src dest -- ) tag-bits SLWI ;
-
-: untag-fixnum ( src dest -- ) tag-bits SRAWI ;
-
-M: %dispatch generate-node ( vop -- )
-    drop
-    0 input-operand dup 1 SRAWI
-    ! The value 24 is a magic number. It is the length of the
-    ! instruction sequence that follows to be generated.
-    compiled-offset 24 + 0 scratch LOAD32  rel-2/2 rel-address
-    0 input-operand dup 0 scratch ADD
-    0 input-operand dup 0 LWZ
-    0 input-operand MTLR
-    BLR ;
-
-M: %type generate-node ( vop -- )
-    drop
-    <label> "f" set
-    <label> "end" set
-    ! Get the tag
-    0 input-operand 1 scratch tag-mask ANDI
-    ! Tag the tag
-    1 scratch 0 scratch tag-fixnum
-    ! Compare with object tag number (3).
-    0 1 scratch object-tag CMPI
-    ! Jump if the object doesn't store type info in its header
-    "end" get BNE
-    ! It does store type info in its header
-    ! Is the pointer itself equal to 3? Then its F_TYPE (9).
-    0 0 input-operand object-tag CMPI
-    "f" get BEQ
-    ! The pointer is not equal to 3. Load the object header.
-    0 scratch 0 input-operand object-tag neg LWZ
-    0 scratch dup untag
-    "end" get B
-    "f" get save-xt
-    ! The pointer is equal to 3. Load F_TYPE (9).
-    f type tag-bits shift 0 scratch LI
-    "end" get save-xt
-    0 output-operand 0 scratch MR ;
-
-M: %tag generate-node ( vop -- )
-    drop dest/src swap tag-mask ANDI
-    0 output-operand dup tag-fixnum ;
diff --git a/library/compiler/ppc/intrinsics.factor b/library/compiler/ppc/intrinsics.factor
new file mode 100644
index 0000000000..50a8971688
--- /dev/null
+++ b/library/compiler/ppc/intrinsics.factor
@@ -0,0 +1,225 @@
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler
+USING: assembler kernel kernel-internals math math-internals
+namespaces sequences ;
+
+: untag ( dest src -- ) 0 0 31 tag-bits - RLWINM ;
+
+: tag-fixnum ( src dest -- ) tag-bits SLWI ;
+
+: untag-fixnum ( src dest -- ) tag-bits SRAWI ;
+
+\ tag [
+    "in" operand dup tag-mask ANDI
+    "in" operand dup tag-fixnum
+] H{
+    { +input { { f "in" } } }
+    { +output { "in" } }
+} define-intrinsic
+
+: generate-slot ( size quot -- )
+    >r >r
+    ! turn tagged fixnum slot # into an offset, multiple of 4
+    "n" operand dup tag-bits r> - SRAWI
+    ! compute slot address
+    "obj" operand dup "n" operand ADD
+    ! load slot value
+    "obj" operand dup r> call ; inline
+
+\ slot [
+    "obj" operand dup untag
+    cell log2 [ 0 LWZ ] generate-slot
+] H{
+    { +input { { f "obj" } { f "n" } } }
+    { +output { "obj" } }
+} define-intrinsic
+
+\ char-slot [
+    1 [ string-offset LHZ ] generate-slot
+    "obj" operand dup tag-fixnum
+] H{
+    { +input { { f "n" } { f "obj" } } }
+    { +output { "obj" } }
+} define-intrinsic
+
+: define-binary-op ( word op -- )
+    [ [ "x" operand "y" operand "x" operand ] % , ] [ ] make H{
+        { +input { { f "x" } { f "y" } } }
+        { +output { "x" } }
+    } define-intrinsic ;
+
+{
+    { fixnum+fast ADD }
+    { fixnum-fast SUBF }
+    { fixnum-bitand AND }
+    { fixnum-bitor OR }
+    { fixnum-bitxor XOR }
+} [
+    first2 define-binary-op
+] each
+
+\ fixnum-bitnot [
+    "x" operand dup NOT
+    "x" operand dup untag
+] H{
+    { +input { { f "x" } } }
+    { +output { "x" } }
+} define-intrinsic
+
+: define-binary-jump ( word op -- )
+    [
+        [ end-basic-block "x" operand 0 "y" operand CMP ] % ,
+     ] [ ] make H{ { +input { { f "x" } { f "y" } } } }
+    define-if-intrinsic ;
+
+{
+    { fixnum< BLT }
+    { fixnum<= BLE }
+    { fixnum> BGT }
+    { fixnum>= BGE }
+    { eq? BEQ }
+} [
+    first2 define-binary-jump
+] each
+
+! M: %type generate-node ( vop -- )
+!     drop
+!     <label> "f" set
+!     <label> "end" set
+!     ! Get the tag
+!     0 input-operand 1 scratch tag-mask ANDI
+!     ! Tag the tag
+!     1 scratch 0 scratch tag-fixnum
+!     ! Compare with object tag number (3).
+!     0 1 scratch object-tag CMPI
+!     ! Jump if the object doesn't store type info in its header
+!     "end" get BNE
+!     ! It does store type info in its header
+!     ! Is the pointer itself equal to 3? Then its F_TYPE (9).
+!     0 0 input-operand object-tag CMPI
+!     "f" get BEQ
+!     ! The pointer is not equal to 3. Load the object header.
+!     0 scratch 0 input-operand object-tag neg LWZ
+!     0 scratch dup untag
+!     "end" get B
+!     "f" get save-xt
+!     ! The pointer is equal to 3. Load F_TYPE (9).
+!     f type tag-bits shift 0 scratch LI
+!     "end" get save-xt
+!     0 output-operand 0 scratch MR ;
+! 
+! : generate-set-slot ( size quot -- )
+!     >r >r
+!     ! turn tagged fixnum slot # into an offset, multiple of 4
+!     2 input-operand dup tag-bits r> - SRAWI
+!     ! compute slot address in 1st input
+!     2 input-operand dup 1 input-operand ADD
+!     ! store new slot value
+!     0 input-operand 2 input-operand r> call ; inline
+! 
+! M: %set-slot generate-node ( vop -- )
+!     drop cell log2 [ 0 STW ] generate-set-slot ;
+! 
+! M: %write-barrier generate-node ( vop -- )
+!     #! Mark the card pointed to by vreg.
+!     drop
+!     0 input-operand dup card-bits SRAWI
+!     0 input-operand dup 16 ADD
+!     0 scratch 0 input-operand 0 LBZ
+!     0 scratch dup card-mark ORI
+!     0 scratch 0 input-operand 0 STB ;
+! 
+! : simple-overflow ( inv word -- )
+!     >r >r
+!     <label> "end" set
+!     "end" get BNO
+!     >3-vop< r> execute
+!     0 input-operand dup untag-fixnum
+!     1 input-operand dup untag-fixnum
+!     >3-vop< r> execute
+!     "s48_long_to_bignum" f compile-c-call
+!     ! An untagged pointer to the bignum is now in r3; tag it
+!     0 output-operand dup bignum-tag ORI
+!     "end" get save-xt ; inline
+! 
+! M: %fixnum+ generate-node ( vop -- )
+!     drop 0 MTXER >3-vop< ADDO. \ SUBF \ ADD simple-overflow ;
+! 
+! M: %fixnum- generate-node ( vop -- )
+!     drop 0 MTXER >3-vop< SUBFO. \ ADD \ SUBF simple-overflow ;
+! 
+! M: %fixnum* generate-node ( vop -- )
+!     #! Note that this assumes the output will be in r3.
+!     drop
+!     <label> "end" set
+!     1 input-operand dup untag-fixnum
+!     0 MTXER
+!     0 scratch 0 input-operand 1 input-operand MULLWO.
+!     "end" get BNO
+!     1 scratch 0 input-operand 1 input-operand MULHW
+!     4 1 scratch MR
+!     3 0 scratch MR
+!     "s48_fixnum_pair_to_bignum" f compile-c-call
+!     ! now we have to shift it by three bits to remove the second
+!     ! tag
+!     tag-bits neg 4 LI
+!     "s48_bignum_arithmetic_shift" f compile-c-call
+!     ! An untagged pointer to the bignum is now in r3; tag it
+!     0 output-operand 0 scratch bignum-tag ORI
+!     "end" get save-xt
+!     0 output-operand 0 scratch MR ;
+! 
+! : generate-fixnum/i
+!     #! This VOP is funny. If there is an overflow, it falls
+!     #! through to the end, and the result is in 0 output-operand.
+!     #! Otherwise it jumps to the "no-overflow" label and the
+!     #! result is in 0 scratch.
+!     0 scratch 1 input-operand 0 input-operand DIVW
+!     ! if the result is greater than the most positive fixnum,
+!     ! which can only ever happen if we do
+!     ! most-negative-fixnum -1 /i, then the result is a bignum.
+!     <label> "end" set
+!     <label> "no-overflow" set
+!     most-positive-fixnum 1 scratch LOAD
+!     0 scratch 0 1 scratch CMP
+!     "no-overflow" get BLE
+!     most-negative-fixnum neg 3 LOAD
+!     "s48_long_to_bignum" f compile-c-call
+!     3 dup bignum-tag ORI ;
+! 
+! M: %fixnum/i generate-node ( vop -- )
+!     #! This has specific vreg requirements.
+!     drop
+!     generate-fixnum/i
+!     "end" get B
+!     "no-overflow" get save-xt
+!     0 scratch 0 output-operand tag-fixnum
+!     "end" get save-xt ;
+! 
+! : generate-fixnum-mod
+!     #! PowerPC doesn't have a MOD instruction; so we compute
+!     #! x-(x/y)*y. Puts the result in 1 scratch.
+!     1 scratch 0 scratch 0 input-operand MULLW
+!     1 scratch 1 scratch 1 input-operand SUBF ;
+! 
+! M: %fixnum-mod generate-node ( vop -- )
+!     drop
+!     ! divide in2 by in1, store result in out1
+!     0 scratch 1 input-operand 0 input-operand DIVW
+!     generate-fixnum-mod
+!     0 output-operand 1 scratch MR ;
+! 
+! M: %fixnum/mod generate-node ( vop -- )
+!     #! This has specific vreg requirements. Note: if there's an
+!     #! overflow, (most-negative-fixnum 1 /mod) the modulus is
+!     #! always zero.
+!     drop
+!     generate-fixnum/i
+!     0 0 output-operand LI
+!     "end" get B
+!     "no-overflow" get save-xt
+!     generate-fixnum-mod
+!     0 scratch 1 output-operand tag-fixnum
+!     0 output-operand 1 scratch MR
+!     "end" get save-xt ;
diff --git a/library/compiler/ppc/slots.factor b/library/compiler/ppc/slots.factor
deleted file mode 100644
index 6209357695..0000000000
--- a/library/compiler/ppc/slots.factor
+++ /dev/null
@@ -1,64 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler
-USING: alien assembler inference kernel
-kernel-internals lists math memory namespaces sequences words ;
-
-: generate-slot ( size quot -- )
-    >r >r
-    ! turn tagged fixnum slot # into an offset, multiple of 4
-    0 input-operand dup tag-bits r> - SRAWI
-    ! compute slot address
-    0 output-operand dup 0 input-operand ADD
-    ! load slot value
-    0 output-operand dup r> call ; inline
-
-M: %slot generate-node ( vop -- )
-    drop cell log2 [ 0 LWZ ] generate-slot ;
-
-M: %fast-slot generate-node ( vop -- )
-    drop 0 output-operand dup 0 input LWZ ;
-
-: generate-set-slot ( size quot -- )
-    >r >r
-    ! turn tagged fixnum slot # into an offset, multiple of 4
-    2 input-operand dup tag-bits r> - SRAWI
-    ! compute slot address in 1st input
-    2 input-operand dup 1 input-operand ADD
-    ! store new slot value
-    0 input-operand 2 input-operand r> call ; inline
-
-M: %set-slot generate-node ( vop -- )
-    drop cell log2 [ 0 STW ] generate-set-slot ;
-
-M: %fast-set-slot generate-node ( vop -- )
-    drop 0 input-operand 1 input-operand 2 input STW ;
-
-M: %write-barrier generate-node ( vop -- )
-    #! Mark the card pointed to by vreg.
-    drop
-    0 input-operand dup card-bits SRAWI
-    0 input-operand dup 16 ADD
-    0 scratch 0 input-operand 0 LBZ
-    0 scratch dup card-mark ORI
-    0 scratch 0 input-operand 0 STB ;
-
-M: %char-slot generate-node ( vop -- )
-    drop 1 [ string-offset LHZ ] generate-slot
-    0 output-operand dup tag-fixnum ;
-
-M: %set-char-slot generate-node ( vop -- )
-    ! untag the new value in 0th input
-    drop 0 input-operand dup untag-fixnum
-    1 [ string-offset STH ] generate-set-slot ;
-
-: userenv ( reg -- )
-    #! Load the userenv pointer in a virtual register.
-    "userenv" f dlsym swap LOAD32 0 rel-2/2 rel-userenv ;
-
-M: %getenv generate-node ( vop -- )
-    drop 0 output-operand dup dup userenv 0 input cells LWZ ;
-
-M: %setenv generate-node ( vop -- )
-    drop 0 scratch userenv
-    0 input-operand 0 scratch 1 input cells STW ;
diff --git a/library/compiler/ppc/stack.factor b/library/compiler/ppc/stack.factor
deleted file mode 100644
index abba554663..0000000000
--- a/library/compiler/ppc/stack.factor
+++ /dev/null
@@ -1,39 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler
-USING: assembler errors kernel kernel-internals math
-memory namespaces words ;
-
-GENERIC: loc>operand
-
-M: ds-loc loc>operand ds-loc-n cells neg 14 swap ;
-M: cs-loc loc>operand cs-loc-n cells neg 15 swap ;
-
-: %literal ( quot -- )
-    0 output vreg? [
-        0 input 0 output-operand rot call
-    ] [
-        0 input 11 rot call
-        11 0 output loc>operand STW
-    ] if ; inline
-
-M: %immediate generate-node ( vop -- )
-    drop [ >r address r> LOAD ] %literal ;
-
-: load-indirect ( dest literal -- )
-    add-literal over LOAD32 rel-2/2 rel-address dup 0 LWZ ;
-
-M: %indirect generate-node ( vop -- )
-    drop [ swap load-indirect ] %literal ;
-
-M: %peek generate-node ( vop -- )
-    drop 0 output-operand 0 input loc>operand LWZ ;
-
-M: %replace generate-node ( vop -- )
-    drop 0 input-operand 0 output loc>operand STW ;
-
-M: %inc-d generate-node ( vop -- )
-    drop 14 14 0 input cells ADDI ;
-
-M: %inc-r generate-node ( vop -- )
-    drop 15 15 0 input cells ADDI ;
diff --git a/library/compiler/stack.factor b/library/compiler/stack.factor
deleted file mode 100644
index 2cfc2e5e8d..0000000000
--- a/library/compiler/stack.factor
+++ /dev/null
@@ -1,47 +0,0 @@
-! Copyright (C) 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: compiler
-USING: arrays generic inference io kernel math
-namespaces prettyprint sequences vectors words ;
-
-: immediate? ( obj -- ? ) dup fixnum? swap not or ;
-
-: load-literal ( obj dest -- )
-    over immediate? [ %immediate ] [ %indirect ] if , ;
-
-: phantom-shuffle-input ( n phantom -- seq )
-    2dup length <= [
-        cut-phantom
-    ] [
-        [ phantom-locs ] keep [ length swap head-slice* ] keep
-        [ append 0 ] keep set-length
-    ] if ;
-
-: phantom-shuffle-inputs ( shuffle -- locs locs )
-    dup shuffle-in-d length phantom-d get phantom-shuffle-input
-    swap shuffle-in-r length phantom-r get phantom-shuffle-input ;
-
-: adjust-shuffle ( shuffle -- )
-    dup shuffle-in-d length neg phantom-d get adjust-phantom
-    shuffle-in-r length neg phantom-r get adjust-phantom ;
-
-: shuffle-vregs# ( shuffle -- n )
-    dup shuffle-in-d swap shuffle-in-r additional-vregs# ;
-
-: phantom-shuffle ( shuffle -- )
-    dup shuffle-vregs# ensure-vregs
-    [ phantom-shuffle-inputs ] keep
-    [ shuffle* ] keep adjust-shuffle
-    (template-outputs) ;
-
-M: #shuffle linearize* ( #shuffle -- )
-    node-shuffle phantom-shuffle iterate-next ;
-
-: linearize-push ( node -- )
-    >#push< dup length dup ensure-vregs
-    alloc-reg# [ <vreg> ] map
-    [ [ load-literal ] 2each ] keep
-    phantom-d get phantom-append ;
-
-M: #push linearize* ( #push -- )
-    linearize-push iterate-next ;
diff --git a/library/compiler/templates.factor b/library/compiler/templates.factor
index 7ce0b760dd..1c934b7bf9 100644
--- a/library/compiler/templates.factor
+++ b/library/compiler/templates.factor
@@ -34,7 +34,7 @@ GENERIC: <loc> ( n stack -- loc )
     #! instruction here.
     swap [
         phantom-stack-height
-        dup zero? [ 2drop ] [ swap execute , ] if
+        dup zero? [ 2drop ] [ swap execute ] if
         0
     ] keep set-phantom-stack-height ; inline
 
@@ -89,7 +89,7 @@ SYMBOL: phantom-r
 : alloc-reg ( -- n ) free-vregs get pop ;
 
 : stack>vreg ( vreg# loc -- operand )
-    >r <vreg> dup r> %peek , ;
+    >r <vreg> dup r> %peek ;
 
 : stack>new-vreg ( loc -- vreg )
     alloc-reg swap stack>vreg ;
@@ -98,7 +98,7 @@ SYMBOL: phantom-r
     over loc? [
         2drop
     ] [
-        over [ %replace , ] [ 2drop ] if
+        over [ %replace ] [ 2drop ] if
     ] if ;
 
 : vregs>stack ( phantom -- )
@@ -257,3 +257,5 @@ SYMBOL: +clobber
 : with-template ( quot spec -- )
     fix-spec [ template-inputs call template-outputs ] bind
     compute-free-vregs ; inline
+
+: operand ( var -- op ) get v>operand ; inline
diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor
deleted file mode 100644
index 129b90b096..0000000000
--- a/library/compiler/vops.factor
+++ /dev/null
@@ -1,340 +0,0 @@
-! Copyright (C) 2004, 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: compiler
-USING: arrays errors generic hashtables kernel kernel-internals
-lists math memory namespaces parser sequences words ;
-
-! The linear IR is the second of the two intermediate
-! representations used by Factor. It is basically a high-level
-! assembly language. Linear IR operations are called VOPs.
-
-! This file defines all the types of VOPs. A linear IR program
-! is then just a list of VOPs.
-
-: <label> ( -- label )
-    #! Make a label.
-    gensym  dup t "label" set-word-prop ;
-
-: label? ( obj -- ? )
-    dup word? [ "label" word-prop ] [ drop f ] if ;
-
-! A virtual register
-TUPLE: vreg n ;
-
-! Register classes
-TUPLE: int-regs ;
-TUPLE: float-regs size ;
-
-! A pseudo-register class for parameters spilled on the stack
-TUPLE: stack-params ;
-
-GENERIC: return-reg ( register-class -- reg )
-
-GENERIC: fastcall-regs ( register-class -- regs )
-
-M: stack-params fastcall-regs drop 0 ;
-
-GENERIC: reg-size ( register-class -- n )
-
-GENERIC: inc-reg-class ( register-class -- )
-
-M: int-regs reg-size drop cell ;
-
-: (inc-reg-class)
-    dup class inc
-    macosx? [ reg-size stack-params +@ ] [ drop ] if ;
-
-M: int-regs inc-reg-class
-    (inc-reg-class) ;
-
-M: float-regs reg-size float-regs-size ;
-
-M: float-regs inc-reg-class
-    dup (inc-reg-class)
-    macosx? [ reg-size 4 / int-regs +@ ] [ drop ] if ;
-
-GENERIC: v>operand
-
-M: integer v>operand tag-bits shift ;
-
-M: vreg v>operand vreg-n vregs nth ;
-
-M: f v>operand address ;
-
-! A virtual operation
-TUPLE: vop inputs outputs label ;
-
-: (scratch)
-    vop get dup vop-inputs swap vop-outputs append
-    [ vreg? ] subset [ v>operand ] map vregs diff ;
-
-: scratch ( n -- reg )
-    #! Output a scratch register that is not used by the
-    #! current VOP.
-    \ scratch get nth ;
-
-: with-vop ( vop quot -- )
-    swap vop set (scratch) \ scratch set call ; inline
-
-: input ( n -- obj ) vop get vop-inputs nth ;
-: input-operand ( n -- n ) input v>operand ;
-: output ( n -- obj ) vop get vop-outputs nth ;
-: output-operand ( n -- n ) output v>operand ;
-: label ( -- label ) vop get vop-label ;
-
-: make-vop ( inputs outputs label vop -- vop )
-    [ >r <vop> r> set-delegate ] keep ;
-
-: empty-vop f f f ;
-: label-vop ( label) >r f f r> ;
-: label/src-vop ( label src) 1array swap f swap ;
-: src-vop ( src) 1array f f ;
-: dest-vop ( dest) 1array dup f ;
-: src/dest-vop ( src dest) >r 1array r> 1array f ;
-: 2-in-vop ( in1 in2) 2array f f ;
-: 3-in-vop ( in1 in2 in3) 3array f f ;
-: 2-in/label-vop ( in1 in2 label) >r 2array f r> ;
-: 2-vop ( in dest) [ 2array ] keep 1array f ;
-: 3-vop ( in1 in2 dest) >r 2array r> 1array f ;
-
-! miscellanea
-TUPLE: %prologue ;
-C: %prologue make-vop ;
-: %prologue src-vop <%prologue> ;
-
-TUPLE: %label ;
-C: %label make-vop ;
-: %label label-vop <%label> ;
-
-TUPLE: %return ;
-C: %return make-vop ;
-: %return empty-vop <%return> ;
-
-TUPLE: %jump ;
-C: %jump make-vop ;
-: %jump label-vop <%jump> ;
-
-TUPLE: %jump-label ;
-C: %jump-label make-vop ;
-: %jump-label label-vop <%jump-label> ;
-
-TUPLE: %call ;
-C: %call make-vop ;
-: %call label-vop <%call> ;
-
-TUPLE: %jump-t ;
-C: %jump-t make-vop ;
-: %jump-t label/src-vop <%jump-t> ;
-
-! dispatch tables
-TUPLE: %dispatch ;
-C: %dispatch make-vop ;
-: %dispatch src-vop <%dispatch> ;
-
-TUPLE: %target-label ;
-C: %target-label make-vop ;
-: %target-label label-vop <%target-label> ;
-
-! stack operations
-TUPLE: %peek ;
-C: %peek make-vop ;
-: %peek swap src/dest-vop <%peek> ;
-
-TUPLE: %replace ;
-C: %replace make-vop ;
-: %replace ( vreg loc -- vop ) src/dest-vop <%replace> ;
-
-TUPLE: %inc-d ;
-C: %inc-d make-vop ;
-: %inc-d ( n -- node ) src-vop <%inc-d> ;
-
-TUPLE: %inc-r ;
-C: %inc-r make-vop ;
-: %inc-r ( n -- ) src-vop <%inc-r> ;
-
-TUPLE: %immediate ;
-C: %immediate make-vop ;
-
-: %immediate ( obj vreg -- vop )
-    src/dest-vop <%immediate> ;
-
-! indirect load of a literal through a table
-TUPLE: %indirect ;
-C: %indirect make-vop ;
-: %indirect ( obj vreg -- )
-    src/dest-vop <%indirect> ;
-
-! object slot accessors
-TUPLE: %untag ;
-C: %untag make-vop ;
-: %untag dest-vop <%untag> ;
-
-TUPLE: %slot ;
-C: %slot make-vop ;
-: %slot ( n vreg ) 2-vop <%slot> ;
-
-: set-slot-vop
-    [ 3array ] keep 1array f ;
-
-TUPLE: %set-slot ;
-C: %set-slot make-vop ;
-
-: %set-slot ( value obj n )
-    #! %set-slot writes to vreg obj.
-    set-slot-vop <%set-slot> ;
-
-! in the 'fast' versions, the object's type and slot number is
-! known at compile time, so these become a single instruction
-TUPLE: %fast-slot ;
-C: %fast-slot make-vop ;
-: %fast-slot ( n vreg )
-    2-vop <%fast-slot> ;
-
-TUPLE: %fast-set-slot ;
-C: %fast-set-slot make-vop ;
-: %fast-set-slot ( value obj n )
-    #! %fast-set-slot writes to vreg obj.
-    over >r 3array r> 1array f <%fast-set-slot> ;
-
-! Char readers and writers
-TUPLE: %char-slot ;
-C: %char-slot make-vop ;
-: %char-slot ( n vreg ) 2-vop <%char-slot> ;
-
-TUPLE: %set-char-slot ;
-C: %set-char-slot make-vop ;
-
-: %set-char-slot ( value ch n )
-    #! %set-char-slot writes to vreg obj.
-    set-slot-vop <%set-char-slot> ;
-
-TUPLE: %write-barrier ;
-C: %write-barrier make-vop ;
-: %write-barrier ( ptr ) dest-vop <%write-barrier> ;
-
-! fixnum intrinsics
-TUPLE: %fixnum+ ;
-C: %fixnum+ make-vop ;       : %fixnum+ 3-vop <%fixnum+> ;
-TUPLE: %fixnum+fast ;
-C: %fixnum+fast make-vop ;   : %fixnum+fast 3-vop <%fixnum+fast> ;
-TUPLE: %fixnum- ;
-C: %fixnum- make-vop ;       : %fixnum- 3-vop <%fixnum-> ;
-TUPLE: %fixnum-fast ;
-C: %fixnum-fast make-vop ;   : %fixnum-fast 3-vop <%fixnum-fast> ;
-TUPLE: %fixnum* ;
-C: %fixnum* make-vop ;       : %fixnum* 3-vop <%fixnum*> ;
-TUPLE: %fixnum-mod ;
-C: %fixnum-mod make-vop ;    : %fixnum-mod 3-vop <%fixnum-mod> ;
-TUPLE: %fixnum/i ;
-C: %fixnum/i make-vop ;      : %fixnum/i 3-vop <%fixnum/i> ;
-TUPLE: %fixnum/mod ;
-C: %fixnum/mod make-vop ;    : %fixnum/mod f <%fixnum/mod> ;
-
-TUPLE: %fixnum-bitand ;
-C: %fixnum-bitand make-vop ; : %fixnum-bitand 3-vop <%fixnum-bitand> ;
-
-TUPLE: %fixnum-bitor ;
-C: %fixnum-bitor make-vop ;  : %fixnum-bitor 3-vop <%fixnum-bitor> ;
-
-TUPLE: %fixnum-bitxor ;
-C: %fixnum-bitxor make-vop ; : %fixnum-bitxor 3-vop <%fixnum-bitxor> ;
-
-TUPLE: %fixnum-bitnot ;
-C: %fixnum-bitnot make-vop ; : %fixnum-bitnot 2-vop <%fixnum-bitnot> ;
-
-! At the VOP level, the 'shift' operation is split into four
-! distinct operations:
-! - shifts with a positive count: calls runtime to make
-!   a bignum
-! - shifts with a small negative count: %fixnum>>
-! - shifts with a small negative count: %fixnum>>
-! - shifts with a large negative count: %fixnum-sgn
-TUPLE: %fixnum>> ;
-C: %fixnum>> make-vop ;   : %fixnum>>   3-vop <%fixnum>>> ;
-
-! due to x86 limitations the destination of this VOP must be
-! vreg 2 (EDX), and the source must be vreg 0 (EAX).
-TUPLE: %fixnum-sgn ;
-C: %fixnum-sgn make-vop ; : %fixnum-sgn src/dest-vop <%fixnum-sgn> ;
-
-! Integer comparison followed by a conditional branch is
-! optimized
-TUPLE: %jump-fixnum<= ;
-C: %jump-fixnum<= make-vop ;
-: %jump-fixnum<= 2-in/label-vop <%jump-fixnum<=> ;
-
-TUPLE: %jump-fixnum< ;
-C: %jump-fixnum< make-vop ; 
-: %jump-fixnum< 2-in/label-vop <%jump-fixnum<> ;
-
-TUPLE: %jump-fixnum>= ;
-C: %jump-fixnum>= make-vop ;
-: %jump-fixnum>= 2-in/label-vop <%jump-fixnum>=> ;
-
-TUPLE: %jump-fixnum> ;
-C: %jump-fixnum> make-vop ; 
-: %jump-fixnum> 2-in/label-vop <%jump-fixnum>> ;
-
-TUPLE: %jump-eq? ;
-C: %jump-eq? make-vop ;     
-: %jump-eq? 2-in/label-vop <%jump-eq?> ;
-
-! some slightly optimized inline assembly
-TUPLE: %type ;
-C: %type make-vop ;
-: %type ( vreg ) dest-vop <%type> ;
-
-TUPLE: %tag ;
-C: %tag make-vop ;
-: %tag ( vreg ) dest-vop <%tag> ;
-
-TUPLE: %getenv ;
-C: %getenv make-vop ;
-: %getenv src/dest-vop <%getenv> ;
-
-TUPLE: %setenv ;
-C: %setenv make-vop ;
-: %setenv 2-in-vop <%setenv> ;
-
-TUPLE: %stack>freg ;
-C: %stack>freg make-vop ;
-: %stack>freg ( n reg reg-class -- vop ) 3-in-vop <%stack>freg> ;
-
-TUPLE: %freg>stack ;
-C: %freg>stack make-vop ;
-: %freg>stack ( n reg reg-class -- vop ) 3-in-vop <%freg>stack> ;
-
-TUPLE: %cleanup ;
-C: %cleanup make-vop ;
-: %cleanup ( n -- vop ) src-vop <%cleanup> ;
-
-TUPLE: %unbox ;
-C: %unbox make-vop ;
-: %unbox ( n reg-class func -- vop ) 3-in-vop <%unbox> ;
-
-TUPLE: %unbox-struct ;
-C: %unbox-struct make-vop ;
-: %unbox-struct ( n reg-class size -- vop )
-    3-in-vop <%unbox-struct> ;
-
-TUPLE: %box ;
-C: %box make-vop ;
-: %box ( n reg-class func -- vop ) 3-in-vop <%box> ;
-
-TUPLE: %box-struct ;
-C: %box-struct make-vop ;
-: %box-struct ( n reg-class size -- vop )
-    3-in-vop <%box-struct> ;
-
-TUPLE: %alien-invoke ;
-C: %alien-invoke make-vop ;
-: %alien-invoke ( func lib -- vop ) 2-in-vop <%alien-invoke> ;
-
-TUPLE: %alien-callback ;
-C: %alien-callback make-vop ;
-: %alien-callback ( quot -- vop ) src-vop <%alien-callback> ;
-
-TUPLE: %callback-value ;
-C: %callback-value make-vop ;
-: %callback-value ( reg-class func -- vop )
-    2-in-vop <%callback-value> ;
diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor
index a3eb4024f9..5f857fd0d1 100644
--- a/library/compiler/x86/architecture.factor
+++ b/library/compiler/x86/architecture.factor
@@ -7,10 +7,6 @@ sequences words ;
 ! ESI datastack
 ! EBX callstack
 
-: fixnum-imm? ( -- ? )
-    #! Can fixnum operations take immediate operands?
-    t ; inline
-
 : ds-reg ESI ; inline
 : cs-reg EBX ; inline
 : remainder-reg EDX ; inline
diff --git a/library/compiler/xt.factor b/library/compiler/xt.factor
index f6b92b144e..b8baa0e517 100644
--- a/library/compiler/xt.factor
+++ b/library/compiler/xt.factor
@@ -5,6 +5,13 @@ USING: assembler errors generic hashtables kernel
 kernel-internals lists math namespaces prettyprint sequences
 strings vectors words ;
 
+: <label> ( -- label )
+    #! Make a label.
+    gensym  dup t "label" set-word-prop ;
+
+: label? ( obj -- ? )
+    dup word? [ "label" word-prop ] [ drop f ] if ;
+
 ! We use a hashtable "compiled-xts" that maps words to
 ! xt's that are currently being compiled. The commit-xt's word
 ! sets the xt of each word in the hashtable to the value in the
@@ -170,7 +177,6 @@ SYMBOL: compile-words
     #! added to the list of words to be compiled.
     dup compiled?
     over label? or
-    over linearized get ?hash or
     over compile-words get member? or
     swap compiled-xts get hash or ;
 
diff --git a/library/test/compiler/ifte.factor b/library/test/compiler/ifte.factor
index 065195208b..3249a08fc1 100644
--- a/library/test/compiler/ifte.factor
+++ b/library/test/compiler/ifte.factor
@@ -96,6 +96,7 @@ DEFER: countdown-b
 [ 3 ] [ f dummy-unless-3 ] unit-test
 [ 4 ] [ 4 dummy-unless-3 ] unit-test
 
+! Test cond expansion
 [ "even" ] [
     [
         2 {
diff --git a/library/test/compiler/intrinsics.factor b/library/test/compiler/intrinsics.factor
index a24d9bc4a4..24d2ed20a2 100644
--- a/library/test/compiler/intrinsics.factor
+++ b/library/test/compiler/intrinsics.factor
@@ -64,48 +64,54 @@ math-internals sequences strings test words ;
 [ 11 ] [ 12 [ 7 fixnum-bitxor ] compile-1 ] unit-test
 [ 11 ] [ [ 12 7 fixnum-bitxor ] compile-1 ] unit-test
 
-[ f ] [ 12 7 [ fixnum< ] compile-1 ] unit-test
-[ f ] [ 12 [ 7 fixnum< ] compile-1 ] unit-test
-[ f ] [ [ 12 7 fixnum< ] compile-1 ] unit-test
-[ f ] [ [ 12 12 fixnum< ] compile-1 ] unit-test
+[ f ] [ 12 7 [ fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ 12 [ 7 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ [ 12 7 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ [ 12 12 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ 12 12 [ fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
 
-[ t ] [ 12 70 [ fixnum< ] compile-1 ] unit-test
-[ t ] [ 12 [ 70 fixnum< ] compile-1 ] unit-test
-[ t ] [ [ 12 70 fixnum< ] compile-1 ] unit-test
+[ t ] [ 12 70 [ fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ 12 [ 70 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ [ 12 70 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
 
-[ f ] [ 12 7 [ fixnum<= ] compile-1 ] unit-test
-[ f ] [ 12 [ 7 fixnum<= ] compile-1 ] unit-test
-[ f ] [ [ 12 7 fixnum<= ] compile-1 ] unit-test
-[ t ] [ [ 12 12 fixnum<= ] compile-1 ] unit-test
+[ f ] [ 12 7 [ fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ 12 [ 7 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ [ 12 7 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ 12 12 [ fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
 
-[ t ] [ 12 70 [ fixnum<= ] compile-1 ] unit-test
-[ t ] [ 12 [ 70 fixnum<= ] compile-1 ] unit-test
-[ t ] [ [ 12 70 fixnum<= ] compile-1 ] unit-test
+[ t ] [ 12 70 [ fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ 12 [ 70 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ [ 12 70 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
 
-[ t ] [ 12 7 [ fixnum> ] compile-1 ] unit-test
-[ t ] [ 12 [ 7 fixnum> ] compile-1 ] unit-test
-[ t ] [ [ 12 7 fixnum> ] compile-1 ] unit-test
-[ f ] [ [ 12 12 fixnum> ] compile-1 ] unit-test
+[ t ] [ 12 7 [ fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ 12 [ 7 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ [ 12 7 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ 12 12 [ fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
 
-[ f ] [ 12 70 [ fixnum> ] compile-1 ] unit-test
-[ f ] [ 12 [ 70 fixnum> ] compile-1 ] unit-test
-[ f ] [ [ 12 70 fixnum> ] compile-1 ] unit-test
+[ f ] [ 12 70 [ fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ 12 [ 70 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ [ 12 70 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
 
-[ t ] [ 12 7 [ fixnum>= ] compile-1 ] unit-test
-[ t ] [ 12 [ 7 fixnum>= ] compile-1 ] unit-test
-[ t ] [ [ 12 7 fixnum>= ] compile-1 ] unit-test
-[ t ] [ [ 12 12 fixnum>= ] compile-1 ] unit-test
+[ t ] [ 12 7 [ fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ 12 [ 7 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ [ 12 7 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ [ 12 12 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ 12 12 [ fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
 
-[ f ] [ 12 70 [ fixnum>= ] compile-1 ] unit-test
-[ f ] [ 12 [ 70 fixnum>= ] compile-1 ] unit-test
-[ f ] [ [ 12 70 fixnum>= ] compile-1 ] unit-test
+[ f ] [ 12 70 [ fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ 12 [ 70 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ [ 12 70 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
 
-[ f ] [ 1 2 [ eq? ] compile-1 ] unit-test
-[ f ] [ 1 [ 2 eq? ] compile-1 ] unit-test
-[ f ] [ [ 1 2 eq? ] compile-1 ] unit-test
-[ t ] [ 3 3 [ eq? ] compile-1 ] unit-test
-[ t ] [ 3 [ 3 eq? ] compile-1 ] unit-test
-[ t ] [ [ 3 3 eq? ] compile-1 ] unit-test
+[ f ] [ 1 2 [ eq? [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ 1 [ 2 eq? [ t ] [ f ] if ] compile-1 ] unit-test
+[ f ] [ [ 1 2 eq? [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ 3 3 [ eq? [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ 3 [ 3 eq? [ t ] [ f ] if ] compile-1 ] unit-test
+[ t ] [ [ 3 3 eq? [ t ] [ f ] if ] compile-1 ] unit-test
 
 [ -1 ] [ 0 [ fixnum-bitnot ] compile-1 ] unit-test
 [ -1 ] [ [ 0 fixnum-bitnot ] compile-1 ] unit-test
diff --git a/library/test/compiler/linearizer.factor b/library/test/compiler/linearizer.factor
deleted file mode 100644
index 42cdaf0d4a..0000000000
--- a/library/test/compiler/linearizer.factor
+++ /dev/null
@@ -1,15 +0,0 @@
-IN: temporary
-USE: test
-USE: kernel
-USE: compiler
-USE: inference
-USE: words
-USE: sequences
-
-: fie [ ] [ ] if ;
-
-[ ] [ \ fie dup word-def dataflow linearize drop ] unit-test
-
-: foo all-words [ drop ] each ;
-
-[ ] [ \ foo dup word-def dataflow linearize drop ] unit-test
diff --git a/library/test/compiler/simple.factor b/library/test/compiler/simple.factor
index 059ce97a8e..0ee94dd17c 100644
--- a/library/test/compiler/simple.factor
+++ b/library/test/compiler/simple.factor
@@ -42,3 +42,8 @@ full-gc
 : foo dup [ dup [ ] [ ] if drop ] [ drop ] if ; compiled
 
 [ 10 ] [ 10 2 foo ] unit-test
+
+: foox dup [ foox ] when ; inline
+: bar foox ;
+
+[ ] [ \ bar compile ] unit-test
diff --git a/library/test/test.factor b/library/test/test.factor
index 9e6c67657e..b579bb0e0c 100644
--- a/library/test/test.factor
+++ b/library/test/test.factor
@@ -104,7 +104,7 @@ SYMBOL: failures
         "compiler/simple" "compiler/templates"
         "compiler/stack" "compiler/ifte"
         "compiler/generic" "compiler/bail-out"
-        "compiler/linearizer" "compiler/intrinsics"
+        "compiler/intrinsics"
         "compiler/identities" "compiler/optimizer"
         "compiler/alien" "compiler/callbacks"
     } run-tests ;