diff --git a/factor/VocabularyLookup.java b/factor/VocabularyLookup.java
index 5bf3fd1b59..27a8a962cb 100644
--- a/factor/VocabularyLookup.java
+++ b/factor/VocabularyLookup.java
@@ -82,6 +82,12 @@ public class VocabularyLookup
 		FactorWord ket = define("syntax","]");
 		ket.parsing = new Ket(bra,ket);
 
+		/* tuples */
+		FactorWord beginTuple = define("syntax","<<");
+		beginTuple.parsing = new Bra(beginTuple);
+		FactorWord endTuple = define("syntax",">>");
+		endTuple.parsing = new Ket(beginTuple,endTuple);
+
 		/* conses */
 		FactorWord beginCons = define("syntax","[[");
 		beginCons.parsing = new BeginCons(beginCons);
diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor
index 9c499e432c..414f6b36f5 100644
--- a/library/bootstrap/image.factor
+++ b/library/bootstrap/image.factor
@@ -15,9 +15,9 @@
 ! run platform/native/boot-stage2.factor.
 
 IN: image
-USING: errors generic hashtables kernel lists math namespaces
-parser prettyprint sequences sequences stdio streams strings
-vectors words ;
+USING: errors generic hashtables kernel lists
+math namespaces parser prettyprint sequences sequences stdio
+streams strings vectors words ;
 
 ! The image being constructed; a vector of word-size integers
 SYMBOL: image
@@ -37,17 +37,9 @@ SYMBOL: boot-quot
 : cell "64-bits" get 8 4 ? ;
 : char "64-bits" get 4 2 ? ;
 
-: tag-mask BIN: 111 ; inline
-: tag-bits 3 ; inline
-
 : untag ( cell tag -- ) tag-mask bitnot bitand ;
 : tag ( cell -- tag ) tag-mask bitand ;
 
-: fixnum-tag  BIN: 000 ; inline
-: bignum-tag  BIN: 001 ; inline
-: cons-tag    BIN: 010 ; inline
-: object-tag  BIN: 011 ; inline
-
 : t-type         7  ; inline
 : array-type     8  ; inline
 : hashtable-type 10 ; inline
diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor
index ac4ddc8d56..4d3063124c 100644
--- a/library/compiler/intrinsics.factor
+++ b/library/compiler/intrinsics.factor
@@ -53,7 +53,6 @@ words ;
     out-1
 ] "linearizer" set-word-prop
 
-
 \ >r [
     drop
     in-1
@@ -78,9 +77,10 @@ words ;
 : self ( word -- )
     f swap dup "infer-effect" word-prop (consume/produce) ;
 
-\ slot [
-    \ slot self
-] "infer" set-word-prop
+: intrinsic ( word -- )
+    dup [ literal, \ self , ] make-list "infer" set-word-prop ;
+
+\ slot intrinsic
 
 : slot@ ( seq -- n )
     #! Compute slot offset.
@@ -102,9 +102,7 @@ words ;
     ] ifte  out-1
 ] "linearizer" set-word-prop
 
-\ set-slot [
-    \ set-slot self
-] "infer" set-word-prop
+\ set-slot intrinsic
 
 \ set-slot [
     node-consume-d swap hash
@@ -122,37 +120,49 @@ words ;
     ] ifte
 ] "linearizer" set-word-prop
 
-! : binary-op-reg ( op -- )
-!     in-2
-!     [[ << vreg f 1 >> << vreg f 0 >> ]] cons ,
-!     1 %dec-d , out-1 ;
-! 
-! 
-! : binary-op ( node op -- )
-!     top-literal? [
-!         1 %dec-d ,
-!         in-1
-!         literal-value << vreg f 0 >> swons cons ,
-!         out-1
-!     ] [
-!         drop
-!         binary-op-reg
-!     ] ifte ;
-! 
-! [
-!     fixnum+
-!     fixnum-
-!     fixnum*
-!     fixnum-mod
-!     fixnum-bitand
-!     fixnum-bitor
-!     fixnum-bitxor
-!     fixnum/i
-!     fixnum<=
-!     fixnum<
-!     fixnum>=
-!     fixnum>
-! ] [
-!     dup [ literal, \ binary-op , ] make-list
-!     "linearizer" set-word-prop
-! ] each
+\ type intrinsic
+
+\ type [
+    drop
+    in-1
+    0 %type ,
+    out-1
+] "linearizer" set-word-prop
+
+: binary-op-reg ( op -- )
+    in-2
+    << vreg f 1 >> << vreg f 0 >> rot execute ,
+    1 %dec-d ,
+    out-1 ;
+
+
+: binary-op ( node op -- )
+    node-consume-d rot hash
+    dup top-literal? [
+        1 %dec-d ,
+        in-1
+        peek literal-value << vreg f 0 >> rot execute ,
+        out-1
+    ] [
+        drop
+        binary-op-reg
+    ] ifte ;
+
+[
+    [[ fixnum+       %fixnum+       ]]
+    [[ fixnum-       %fixnum-       ]]
+    [[ fixnum*       %fixnum*       ]]
+    [[ fixnum-mod    %fixnum-mod    ]]
+    [[ fixnum-bitand %fixnum-bitand ]]
+    [[ fixnum-bitor  %fixnum-bitor  ]]
+    [[ fixnum-bitxor %fixnum-bitxor ]]
+    [[ fixnum/i      %fixnum/i      ]]
+    [[ fixnum<=      %fixnum<=      ]]
+    [[ fixnum<       %fixnum<       ]]
+    [[ fixnum>=      %fixnum>=      ]]
+    [[ fixnum>       %fixnum>       ]]
+] [
+    uncons over intrinsic
+    [ literal, \ binary-op , ] make-list
+    "linearizer" set-word-prop
+] each
diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor
index 73abc7b475..29ac02de4a 100644
--- a/library/compiler/linearizer.factor
+++ b/library/compiler/linearizer.factor
@@ -78,7 +78,9 @@ errors prettyprint kernel-internals ;
 : dispatch-head ( vtable -- end label/code )
     #! Output the jump table insn and return a list of
     #! label/branch pairs.
-    %dispatch ,
+    in-1
+    1 %dec-d ,
+    0 %dispatch ,
     <label> ( end label ) swap
     [ <label> dup %target-label ,  cons ] map
     %end-dispatch , ;
diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor
index 7ff9406103..41f282efbf 100644
--- a/library/compiler/vops.factor
+++ b/library/compiler/vops.factor
@@ -28,6 +28,7 @@ GENERIC: generate-node ( vop -- )
 : label-vop ( label) >r f f f r> ;
 : label/src-vop ( label src) swap >r f f r> ;
 : src-vop ( src) f f f ;
+: src/dest-vop ( src dest) f f ;
 
 ! miscellanea
 VOP: %prologue
@@ -53,7 +54,7 @@ VOP: %jump-f
 
 ! dispatch tables
 VOP: %dispatch
-: %dispatch empty-vop <%dispatch> ;
+: %dispatch <vreg> src-vop <%dispatch> ;
 VOP: %target-label
 : %target-label label-vop <%target-label> ;
 VOP: %target
@@ -90,7 +91,7 @@ VOP: %inc-r
 
 ! indirect load of a literal through a table
 VOP: %indirect
-: %indirect ( vreg obj -- ) f -rot f <%indirect> ;
+: %indirect ( vreg obj -- ) >r <vreg> r> f -rot f <%indirect> ;
 
 ! object slot accessors
 VOP: %untag
@@ -102,10 +103,28 @@ VOP: %set-slot
 : %set-slot ( vreg:value vreg:obj n )
     >r >r <vreg> r> <vreg> r> <vreg> f <%set-slot> ;
 
-! In the 'fast' versions, the object's type and slot number is
+! in the 'fast' versions, the object's type and slot number is
 ! known at compile time, so these become a single instruction
 VOP: %fast-slot
 : %fast-slot ( vreg n ) >r >r f r> <vreg> r> f <%fast-slot> ;
 VOP: %fast-set-slot
 : %fast-set-slot ( vreg:value vreg:obj n )
     >r >r <vreg> r> <vreg> r> f <%fast-set-slot> ;
+
+! some slightly optimized inline assembly
+VOP: %type
+: %type ( vreg ) <vreg> src-vop <%type> ;
+
+! fixnum intrinsics
+VOP: %fixnum+       : %fixnum+ src/dest-vop <%fixnum+> ;
+VOP: %fixnum-       : %fixnum- src/dest-vop <%fixnum-> ;
+VOP: %fixnum*       : %fixnum* src/dest-vop <%fixnum*> ;
+VOP: %fixnum-mod    : %fixnum-mod src/dest-vop <%fixnum-mod> ;
+VOP: %fixnum-bitand : %fixnum-bitand src/dest-vop <%fixnum-bitand> ;
+VOP: %fixnum-bitor  : %fixnum-bitor src/dest-vop <%fixnum-bitor> ;
+VOP: %fixnum-bitxor : %fixnum-bitxor src/dest-vop <%fixnum-bitxor> ;
+VOP: %fixnum/i      : %fixnum/i src/dest-vop <%fixnum/i> ;
+VOP: %fixnum<=      : %fixnum<= src/dest-vop <%fixnum<=> ;
+VOP: %fixnum<       : %fixnum< src/dest-vop <%fixnum<> ;
+VOP: %fixnum>=      : %fixnum>= src/dest-vop <%fixnum>=> ;
+VOP: %fixnum>       : %fixnum> src/dest-vop <%fixnum>> ;
diff --git a/library/compiler/x86/assembler.factor b/library/compiler/x86/assembler.factor
index 16df112dab..81fd80535c 100644
--- a/library/compiler/x86/assembler.factor
+++ b/library/compiler/x86/assembler.factor
@@ -241,15 +241,35 @@ M: operand CALL HEX: ff compile-byte BIN: 010 1-operand ;
 
 GENERIC: ADD ( dst src -- )
 M: integer ADD HEX: 81 BIN: 000 immediate-8/32 ;
-M: operand ADD HEX: 01 2-operand ;
+M: operand ADD OCT: 001 2-operand ;
 
-GENERIC: SUB ( dst src -- )
-M: integer SUB HEX: 81 BIN: 101 immediate-8/32 ;
-M: operand SUB HEX: 29 2-operand ;
+GENERIC: OR ( dst src -- )
+M: integer OR HEX: 81 BIN: 001 immediate-8/32 ;
+M: operand OR OCT: 011 2-operand ;
+
+GENERIC: ADC ( dst src -- )
+M: integer ADC HEX: 81 BIN: 010 immediate-8/32 ;
+M: operand ADC OCT: 021 2-operand ;
+
+GENERIC: SBB ( dst src -- )
+M: integer SBB HEX: 81 BIN: 011 immediate-8/32 ;
+M: operand SBB OCT: 031 2-operand ;
 
 GENERIC: AND ( dst src -- )
 M: integer AND HEX: 81 BIN: 100 immediate-8/32 ;
-M: operand AND HEX: 21 2-operand ;
+M: operand AND OCT: 041 2-operand ;
+
+GENERIC: SUB ( dst src -- )
+M: integer SUB HEX: 81 BIN: 101 immediate-8/32 ;
+M: operand SUB OCT: 051 2-operand ;
+
+GENERIC: XOR ( dst src -- )
+M: integer XOR HEX: 81 BIN: 110 immediate-8/32 ;
+M: operand XOR OCT: 061 2-operand ;
+
+GENERIC: CMP ( dst src -- )
+M: integer CMP HEX: 81 BIN: 111 immediate-8/32 ;
+M: operand CMP OCT: 071 2-operand ;
 
 : IMUL ( dst src -- )
     HEX: 0f compile-byte HEX: af 2-operand ;
@@ -266,9 +286,6 @@ M: operand AND HEX: 21 2-operand ;
 
 : SHR ( dst src -- ) HEX: c1 BIN: 101 immediate-8 ;
 
-GENERIC: CMP ( dst src -- )
-M: integer CMP HEX: 81 BIN: 111 immediate-8/32 ;
-M: operand CMP HEX: 39 2-operand ;
 
 : LEA ( dst src -- )
     HEX: 8d compile-byte swap register 1-operand ;
diff --git a/library/compiler/x86/generator.factor b/library/compiler/x86/generator.factor
index 442bb77273..702e738df5 100644
--- a/library/compiler/x86/generator.factor
+++ b/library/compiler/x86/generator.factor
@@ -38,8 +38,8 @@ M: %untag generate-node ( vop -- )
     vop-source v>operand BIN: 111 bitnot AND ;
 
 M: %slot generate-node ( vop -- )
-    ! the untagged object is in vop-dest, the tagged slot number
-    ! is in vop-literal.
+    #! the untagged object is in vop-dest, the tagged slot
+    #! number is in vop-literal.
     dup vop-literal v>operand swap vop-dest v>operand
     ! turn tagged fixnum slot # into an offset, multiple of 4
     over 1 SHR
@@ -49,15 +49,15 @@ M: %slot generate-node ( vop -- )
     dup unit MOV ;
 
 M: %fast-slot generate-node ( vop -- )
-    ! the tagged object is in vop-dest, the pointer offset is
-    ! in vop-literal. the offset already takes the type tag
-    ! into account, so its just one instruction to load.
+    #! the tagged object is in vop-dest, the pointer offset is
+    #! in vop-literal. the offset already takes the type tag
+    #! into account, so its just one instruction to load.
     dup vop-literal swap vop-dest v>operand tuck >r 2list r>
     swap MOV ;
 
 M: %set-slot generate-node ( vop -- )
-    ! the untagged object is in vop-dest, the new value is in
-    ! vop-source, the tagged slot number is in vop-literal.
+    #! the untagged object is in vop-dest, the new value is in
+    #! vop-source, the tagged slot number is in vop-literal.
     dup vop-literal v>operand over vop-dest v>operand
     ! turn tagged fixnum slot # into an offset, multiple of 4
     over 1 SHR
@@ -67,22 +67,51 @@ M: %set-slot generate-node ( vop -- )
     >r vop-source v>operand r> unit swap MOV ;
 
 M: %fast-set-slot generate-node ( vop -- )
-    ! the tagged object is in vop-dest, the new value is in
-    ! vop-source, the pointer offset is in vop-literal. the
-    ! offset already takes the type tag into account, so its
-    ! just one instruction to load.
+    #! the tagged object is in vop-dest, the new value is in
+    #! vop-source, the pointer offset is in vop-literal. the
+    #! offset already takes the type tag into account, so its
+    #! just one instruction to load.
     dup vop-literal over vop-dest v>operand swap 2list
     swap vop-source v>operand MOV ;
 
-\ dispatch [
+M: %dispatch generate-node ( vop -- )
     #! Compile a piece of code that jumps to an offset in a
     #! jump table indexed by the fixnum at the top of the stack.
     #! The jump table must immediately follow this macro.
-    drop
-    POP-DS
-    EAX 1 SHR
-    EAX HEX: ffff ADD  just-compiled f rel-address
-    [ EAX ] JMP
+    vop-source v>operand dup 1 SHR
+    dup HEX: ffff ADD  just-compiled >r f rel-address
+    unit JMP
     compile-aligned
-    compiled-offset swap set-compiled-cell ( fixup -- )
-] "generator" set-word-prop
+    compiled-offset r> set-compiled-cell ( fixup -- ) ;
+
+M: %type generate-node ( vop -- )
+    #! Intrinstic version of type primitive.
+    <label> "object" set
+    <label> "f" set
+    <label> "end" set
+    vop-source v>operand
+    ! Make a copy
+    ECX over MOV
+    ! Get the tag
+    dup tag-mask AND
+    ! Compare with object tag number (3).
+    dup object-tag CMP
+    ! Jump if the object stores type info in its header
+    "object" get 0 JE relative
+    ! It doesn't store type info in its header
+    dup tag-bits SHL
+    "end" get compile-jump-label
+    "object" get save-xt
+    ! It does store type info in its header
+    ! Is the pointer itself equal to 3? Then its F_TYPE (9).
+    ECX object-tag CMP
+    "f" get 0 JE relative
+    ! The pointer is not equal to 3. Load the object header.
+    dup ECX object-tag neg 2list MOV
+    ! Headers have tag 3. Clear the tag to turn it into a fixnum.
+    dup object-tag XOR
+    "end" get compile-jump-label
+    "f" get save-xt
+    ! The pointer is equal to 3. Load F_TYPE (9).
+    f type tag-bits shift MOV
+    "end" get save-xt ;
diff --git a/library/generic/builtin.factor b/library/generic/builtin.factor
index 087ed9e560..4f7f352e68 100644
--- a/library/generic/builtin.factor
+++ b/library/generic/builtin.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: generic
-USING: errors hashtables kernel lists namespaces parser
-sequences strings words vectors ;
+USING: errors hashtables kernel lists math namespaces parser
+sequences strings vectors words ;
 
 ! Builtin metaclass for builtin types: fixnum, word, cons, etc.
 SYMBOL: builtin
@@ -51,3 +51,7 @@ builtin [ 2drop t ] "class<" set-word-prop
 : builtin-type ( n -- symbol ) builtins get nth ;
 
 PREDICATE: word builtin metaclass builtin = ;
+
+: type-tag ( type -- tag )
+    #! Given a type number, return the tag number.
+    dup 6 > [ drop 3 ] when ;
diff --git a/library/generic/generic.factor b/library/generic/generic.factor
index 874e19cdc3..7f30fbf575 100644
--- a/library/generic/generic.factor
+++ b/library/generic/generic.factor
@@ -76,7 +76,7 @@ math-internals ;
 : define-method ( class generic definition -- )
     -rot
     over metaclass word? [
-        word-name " is not a class" append throw
+        over word-name " is not a class" append throw
     ] unless
     [ "methods" word-prop set-hash ] keep make-generic ;
 
diff --git a/library/inference/types.factor b/library/inference/types.factor
index 75a7cd9395..d454fd18aa 100644
--- a/library/inference/types.factor
+++ b/library/inference/types.factor
@@ -5,34 +5,15 @@ USING: errors generic interpreter kernel kernel-internals
 lists math namespaces strings vectors words sequences
 stdio prettyprint ;
 
-: fast-slot? ( -- ? )
-    #! If the slot number is literal and the object's type is
-    #! known, we can compile a slot access into a single
-    #! instruction (x86).
-    peek-d literal?
-    peek-next-d value-class builtin-supertypes length 1 = and ;
-
-: fast-slot ( -- )
-    pop-literal
-    peek-d value-class builtin-supertypes cons
-    \ slot [ [ object ] [ object ] ] (consume/produce) ;
-
-: computed-slot ( -- )
-    "Computed slot access is slower" inference-warning
-    \ slot dup "infer-effect" word-prop consume/produce ;
-
-\ slot [
-    [ object fixnum ] ensure-d
-    fast-slot? [ fast-slot ] [ computed-slot ] ifte
-] "infer" set-word-prop
-
 : type-value-map ( value -- )
     num-types
     [ tuck builtin-type <class-tie> cons ] project-with
     [ cdr class-tie-class ] subset ;
 
+: value-types ( value -- list ) value-class builtin-supertypes ;
+
 : literal-type ( -- )
-    dataflow-drop, pop-d value-class builtin-supertypes car
+    dataflow-drop, pop-d value-types car
     apply-literal ;
 
 : computed-type ( -- )
diff --git a/library/inference/words.factor b/library/inference/words.factor
index 67f56764a5..7d1db296dc 100644
--- a/library/inference/words.factor
+++ b/library/inference/words.factor
@@ -100,8 +100,7 @@ M: compound apply-word ( word -- )
     ] ifte ;
 
 : literal-type? ( -- ? )
-    peek-d value-class builtin-supertypes
-    dup length 1 = >r [ tuple ] = not r> and ;
+    peek-d value-types dup length 1 = >r [ tuple ] = not r> and ;
 
 : dynamic-dispatch-warning ( word -- )
     "Dynamic dispatch for " swap word-name cat2
diff --git a/library/kernel.factor b/library/kernel.factor
index ff065e2a7d..9c1599a7d4 100644
--- a/library/kernel.factor
+++ b/library/kernel.factor
@@ -14,6 +14,7 @@ M: object = eq? ;
 
 GENERIC: clone ( obj -- obj )
 M: object clone ;
+
 : set-boot ( quot -- )
     #! Set the boot quotation.
     8 setenv ;
@@ -41,3 +42,11 @@ M: object clone ;
     os "freebsd" =
     os "linux" = or
     os "macosx" = or ;
+
+: tag-mask BIN: 111 ; inline
+: tag-bits 3 ; inline
+
+: fixnum-tag  BIN: 000 ; inline
+: bignum-tag  BIN: 001 ; inline
+: cons-tag    BIN: 010 ; inline
+: object-tag  BIN: 011 ; inline
diff --git a/library/test/benchmark/vectors.factor b/library/test/benchmark/vectors.factor
index 44c3081926..86284bb708 100644
--- a/library/test/benchmark/vectors.factor
+++ b/library/test/benchmark/vectors.factor
@@ -1,9 +1,4 @@
-USE: vectors
-USE: kernel
-USE: math
-USE: compiler
-USE: test
-USE: sequences
+USING: compiler kernel math sequences test vectors ;
 
 ! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html
 
diff --git a/library/test/compiler/stack.factor b/library/test/compiler/stack.factor
index 167a3271c6..0e52a2cd13 100644
--- a/library/test/compiler/stack.factor
+++ b/library/test/compiler/stack.factor
@@ -27,6 +27,9 @@ USE: kernel
 [ 1 2 3 1 ] [ 1 [ 2 3 pick ] compile-1 ] unit-test
 [ 1 2 3 1 ] [ 1 2 [ 3 pick ] compile-1 ] unit-test
 [ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-1 ] unit-test
+[ 1 1 2 ] [ [ 1 2 dupd ] compile-1 ] unit-test
+[ 1 1 2 ] [ 1 [ 2 dupd ] compile-1 ] unit-test
+[ 1 1 2 ] [ 1 2 [ dupd ] compile-1 ] unit-test
 
 ! Test various kill combinations
 
diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index 26e933f1bf..03734775d3 100644
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -27,7 +27,7 @@ C: gadget ( shape -- gadget )
         gadget-parent [ redraw ] when*
     ] ifte ;
 
-: relayout* ( gadget -- )
+: relayout ( gadget -- )
     #! Relayout and redraw a gadget and its parent before the
     #! next iteration of the event loop.
     dup gadget-relayout? [
@@ -35,12 +35,12 @@ C: gadget ( shape -- gadget )
     ] [
         t over set-gadget-redraw?
         t over set-gadget-relayout?
-        gadget-parent [ relayout* ] when*
+        gadget-parent [ relayout ] when*
     ] ifte ;
 
-: relayout ( gadget -- )
+: relayout* ( gadget -- )
     #! Relayout a gadget and its children.
-    dup relayout* gadget-children [ relayout ] each ;
+    dup relayout gadget-children [ relayout* ] each ;
 
 : ?move ( x y gadget quot -- )
     >r 3dup shape-pos >r rect> r> = [
@@ -56,7 +56,7 @@ C: gadget ( shape -- gadget )
     ] r> ifte ; inline
 
 : resize-gadget ( w h gadget -- )
-    [ [ resize-shape ] keep relayout ] ?resize ;
+    [ [ resize-shape ] keep relayout* ] ?resize ;
 
 : paint-prop ( gadget key -- value )
     over [