diff --git a/Makefile b/Makefile
index ad1f392d9e..19f65506da 100644
--- a/Makefile
+++ b/Makefile
@@ -3,8 +3,8 @@ CC = gcc
 BINARY = f
 IMAGE = factor.image
 BUNDLE = Factor.app
-DISK_IMAGE_DIR = Factor-0.81
-DISK_IMAGE = Factor-0.81.dmg
+DISK_IMAGE_DIR = Factor-0.82
+DISK_IMAGE = Factor-0.82.dmg
 
 ifdef DEBUG
 	DEFAULT_CFLAGS = -g
@@ -110,13 +110,16 @@ macosx.app:
 	mkdir -p $(BUNDLE)/Contents/Resources/fonts/
 	cp -R fonts/*.ttf $(BUNDLE)/Contents/Resources/fonts/
 
-	find doc library contrib \( -name '*.factor' \
+	chmod +x cp_dir
+	find doc library contrib examples \( -name '*.factor' \
 		-o -name '*.facts' \
 		-o -name '*.txt' \
 		-o -name '*.html' \
 		-o -name '*.js' \) \
 		-exec ./cp_dir {} $(BUNDLE)/Contents/Resources/{} \;
 
+	cp version.factor $(BUNDLE)/Contents/Resources/
+
 	cp $(IMAGE) $(BUNDLE)/Contents/Resources/factor.image
 
 	install_name_tool \
@@ -128,7 +131,7 @@ macosx.app:
 		Factor.app/Contents/MacOS/Factor
 
 macosx.dmg:
-	rm $(DISK_IMAGE)
+	rm -f $(DISK_IMAGE)
 	rm -rf $(DISK_IMAGE_DIR)
 	mkdir $(DISK_IMAGE_DIR)
 	cp -R $(BUNDLE) $(DISK_IMAGE_DIR)/$(BUNDLE)
diff --git a/README.txt b/README.txt
index c6c9a4cf2d..602262a74c 100644
--- a/README.txt
+++ b/README.txt
@@ -4,6 +4,19 @@ The Factor programming language
 This file covers installation and basic usage of the Factor
 implementation. It is not an introduction to the language itself.
 
+* Contents
+
+- Platform support
+- Compiling Factor
+- Building Factor
+- Running Factor on Unix with X11
+- Running Factor on Mac OS X
+- Running Factor on Windows
+- Source organization
+- Learning Factor
+- Community
+- Credits
+
 * Platform support
 
 Factor is fully supported on the following platforms:
@@ -28,9 +41,8 @@ Other platforms are not supported.
 
 The Factor runtime is written in C, and is built with GNU make and gcc.
 
-Note that on x86 systems, Factor _cannot_ be compiled with gcc 3.3. This
-is due to a bug in gcc and there is nothing we can do about it. Please
-use gcc 2.95, 3.4, or 4.0.
+Factor requires gcc 3.4 or later. On x86, it /will not/ build using gcc
+3.3 or earlier.
 
 Run 'make' (or 'gmake' on non-Linux platforms) with one of the following
 parameters to build the Factor runtime:
@@ -48,9 +60,9 @@ The following options can be given to make:
   DEBUG=1
 
 The former allows optimization flags to be specified, for example
-"-march=pentium4 -ffast-math -O3". Optimization flags can make a *huge*
-difference in Factor's performance, so willing hackers should
-experiment.
+"-march=pentium4 -ffast-math -O3". Nowadays most of the hard work is
+done by Factor compiled code, so optimizing the runtime is not that
+important. Usually the defaults are fine.
 
 The DEBUG flag disables optimization and builds an executable with
 debug symbols. This is probably only of interest to people intending to
@@ -85,72 +97,69 @@ completes, a 'factor.image' file will be generated. Note that this image
 is both CPU and OS-specific, so in general cannot be shared between
 machines.
 
-* Running Factor
+* Running Factor on Unix with X11
 
-To run the Factor system, issue the following command:
+On Unix, Factor can either run a graphical user interface using X11, or
+a terminal listener.
+
+If your DISPLAY environment variable is set, the UI will start
+automatically:
 
   ./f factor.image
 
-This will start the interactive listener where Factor expressions may
-be entered.
+To run an interactive terminal listener:
 
-To run the graphical user interface, issue the following command:
+  ./f factor.image -shell=tty
 
-  ./f factor.image -shell=ui
+If you're inside a terminal session, you can start the UI with one of
+the following two commands:
 
-Note that on Windows, this is the default.
+  ui
+  [ ui ] in-thread
+  
+The latter keeps the terminal listener running.
 
-On Unix, this might fail if the SDL libraries are not installed, or are
-installed under unconventional names. This can be solved by explicitly
-naming the libraries during bootstrap, as in the next section.
+* Running Factor on Mac OS X
 
-* Setting up SDL libraries for use with Factor
+On Mac OS X, a Cocoa UI is available in addition to the terminal
+listener.
 
-The Windows binary package for Factor includes all prerequisite DLLs.
-On Unix, you need recent versions of SDL and FreeType.
+The 'f' executable runs the terminal listener:
 
-If you have installed these libraries but the UI still fails with an
-error, you will need to find out the exact names that they are installed
-as, and issue a command similar to the following to bootstrap Factor:
+  ./f factor.image
 
-  ./f boot.image.<foo> -libraries:sdl:name=libSDL-1.2.so
-                       -libraries:freetype:name=libfreetype.so
+The Cocoa UI requires that after bootstrapping you build the Factor.app
+application bundle:
+
+  make macosx.app
+
+This copies the runtime executable, factor.image (which must exist at
+this point), and the library source into a self-contained Factor.app.
+
+Factor.app runs the UI when double-clicked and can be transported
+between PowerPC Macs.
+
+* Running Factor on Windows
+
+On Windows, double-clicking f.exe will start running the Win32-based UI
+with the factor.image in the same directory as the executable.
+
+Bootstrap runs in a Windows command prompt, however after bootstrapping
+only the UI can be used.
 
 * Source organization
 
   doc/ - the developer's handbook, and various other bits and pieces
   native/ - sources for the Factor runtime, written in C
   library/ - sources for the library, written in Factor
-    alien/ - C library interface
-    bootstrap/ - code for generating boot images
-    cocoa/ - Mac OS X Cocoa API and Objective-C runtime binding
-    collections/ - data types including but not limited to lists,
-      vectors, hashtables, and operations on them
-    compiler/ - optimizing native compiler
-    freetype/ - FreeType binding, rendering glyphs to OpenGL textures
-    generic/ - generic words, for object oriented programming style
-    help/ - online help system
-    inference/ - stack effect inference, used by compiler, as well as a
-      useful development tool of its own
-    io/ - input and output streams
-    math/ - integers, ratios, floats, complex numbers, vectors, matrices
-    opengl/ - OpenGL graphics library binding
-    syntax/ - parser and object prettyprinter
-    test/ - unit test framework and test suite
-    tools/ - interactive development tools
-    ui/ - UI framework
-    unix/ - Unix-specific I/O code
-    win32/ - Windows-specific I/O code
   contrib/ - various handy libraries not part of the core
   examples/ - small examples illustrating various language features
   fonts/ - TrueType fonts used by UI
 
 * Learning Factor
 
-The UI has a simple tutorial that will show you the most basic concepts.
-
-There is a detailed language and library reference available at
-http://factorcode.org/handbook.pdf.
+The UI has a tutorial and defailed reference documentation. You can
+browse it in the UI or by running the HTTP server (contrib/httpd).
 
 You can browse the source code; it is organized into small,
 well-commented files and should be easy to follow once you have a good
diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 71281d07b8..5dd3e978bf 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,27 +1,11 @@
 should fix in 0.82:
 
-- amd64 %box-struct
+- another i/o bug: on factorcode eventually all i/o times out
 - 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
-- defining methods returning structs in objc
-- expired aliens in view hash
-- clicks sent twice
-- speed up ideas:
-  - only do clipping for certain gadgets
-  - use glRect
-- remove <char*>, <ushort*>, set-char*-nth, set-ushort*-nth since they
-  have incorrect semantics
-- cocoa: global menu bar with useful commands
-
-+ portability:
-
-- win64 port
-- amd64 %unbox-struct
 
 + io:
 
+- gdb triggers 'mutliple i/o ops on port' error
 - stream server can hang because of exception handler limitations
 - better i/o scheduler
 - yield in a loop starves i/o
@@ -29,6 +13,11 @@ should fix in 0.82:
 
 + ui/help:
 
+- clicks sent twice
+- speed up ideas:
+  - only do clipping for certain gadgets
+  - use glRect
+- polish OS X menu bar code
 - help search
 - reimplement clicking input
 - reimplement tab completion
@@ -56,14 +45,19 @@ should fix in 0.82:
 
 + compiler/ffi:
 
+- free up r11, r12 as a vreg on ppc
+- float= on powerpc doesn't consider nans equal
+- intrinsic fixnum>float float>fixnum
+- win64 port
+- amd64 %unbox-struct
+- constant branch folding
 - core foundation should use unicode strings
 - alien>utf16-string, utf16-string>alien words
 - can <void*> only be called with an alien?
-- improve callback efficiency
-- float intrinsics
+- remove <char*>, <ushort*>, set-char*-nth, set-ushort*-nth since they
+  have incorrect semantics
 - complex float type
 - complex float intrinsics
-- out of memory from overflow check
 - remove literal table
 - C functions returning structs by value
 - FIELD: char key_vector[32];
@@ -73,13 +67,12 @@ should fix in 0.82:
 - [ [ dup call ] dup call ] infer hangs
 - the invalid recursion form case needs to be fixed, for inlines too
 - code gc
-- compiled gc check slows things down
+- fix compiled gc check
 
 + misc:
 
+- 3 >n fep
 - code walker & exceptions
 - slice: if sequence or seq start is changed, abstraction violation
 - make 3.4 bits>double an error
-- colorcoded prettyprinting for vocabularies
-- signal handler should not lose stack pointers
 - code walker and callbacks is broken?
diff --git a/boot.image.amd64 b/boot.image.amd64
index b539a20d73..34932e70f4 100644
Binary files a/boot.image.amd64 and b/boot.image.amd64 differ
diff --git a/boot.image.pentium4 b/boot.image.pentium4
new file mode 100644
index 0000000000..8b7bb2d9cd
Binary files /dev/null and b/boot.image.pentium4 differ
diff --git a/boot.image.ppc b/boot.image.ppc
index f595c3a583..2608f0bed6 100644
Binary files a/boot.image.ppc and b/boot.image.ppc differ
diff --git a/boot.image.x86 b/boot.image.x86
index dc0024058c..60c9bce931 100644
Binary files a/boot.image.x86 and b/boot.image.x86 differ
diff --git a/contrib/coroutines.factor b/contrib/coroutines.factor
index 8facf45139..2471c4ebed 100644
--- a/contrib/coroutines.factor
+++ b/contrib/coroutines.factor
@@ -56,8 +56,8 @@ TUPLE: coroutine resumecc exitcc ;
 USE: prettyprint
 USE: sequences
 
-: test1 ( -- co )
-  [ swap [ over coyield 2drop ] tree-each f swap coyield ] cocreate ; 
+: test1 ( list -- co )
+  [ swap [ over coyield 2drop ] each f swap coyield ] cocreate ; 
   
 : test2 ( -- co )
   [ 1 over coyield drop 2 over coyield drop 3 over coyield ] cocreate ;
diff --git a/contrib/factory/factory.factor b/contrib/factory/factory.factor
index fe0b6a34fd..5568fdf700 100644
--- a/contrib/factory/factory.factor
+++ b/contrib/factory/factory.factor
@@ -151,6 +151,7 @@ TUPLE: wm-root ;
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 M: wm-root handle-map-request-event ( event <wm-root> -- )
+"handle-map-request-event called on wm-root" print flush
   drop XMapRequestEvent-window id>obj				! obj
 
   { { [ dup wm-frame? ]
@@ -164,6 +165,9 @@ M: wm-root handle-map-request-event ( event <wm-root> -- )
         "new window has override_redirect attribute set." print flush
         drop ] }
 
+    { [ dup window-id window-parent+ id>obj wm-frame? ]
+      [ "Window is already managed" print flush drop ] }
+
     { [ t ] [ window-id manage-window ] } }
 
   cond ;
@@ -332,7 +336,9 @@ TUPLE: wm-frame child ;
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : manage-window ( window -- )
+  flush-dpy
   grab-server
+  flush-dpy
 
   create-wm-child				! child
   create-wm-frame				! frame
@@ -360,8 +366,11 @@ TUPLE: wm-frame child ;
   dup map-subwindows%
 
   dup wm-frame-child PropertyChangeMask swap select-input%
-  
-  flush-dpy 0 sync-dpy ungrab-server ;
+
+  flush-dpy
+  0 sync-dpy
+  ungrab-server
+  flush-dpy ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -558,15 +567,15 @@ SYMBOL: window-list
 : not-transient? ( frame -- ? ) wm-frame-child get-transient-for-hint% not ;
 
 : add-window-to-list ( window-list frame -- window-list )
-  dup					! window-list frame frame
-  wm-frame-child			! window-list frame child
-  fetch-name%				! window-list frame name-or-f
-  dup					! window-list frame name-or-f name-or-f
+  dup				! window-list frame frame
+  wm-frame-child		! window-list frame child
+  fetch-name%			! window-list frame name-or-f
+  dup				! window-list frame name-or-f name-or-f
   [ ] [ drop "*untitled*" ] if	! window-list frame name
-  swap					! window-list name frame
-  [ map-window% ]			! window-list name frame [ map-window% ]
-  cons					! window-list name action
-  pick					! window-list name action window-list
+  swap				! window-list name frame
+  [ map-window% ]		! window-list name frame [ map-window% ]
+  cons				! window-list name action
+  pick				! window-list name action window-list
   add-popup-menu-item ;
 
 : refresh-window-list ( window-list -- )
@@ -591,16 +600,9 @@ SYMBOL: window-list
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: xlib-error-handler ( -- xt ) "void" { "Display*" "XErrorEvent*" }
-[ "X11 : error-handler called" print flush ] alien-callback ; compiled
-
-: install-error-handler ( -- ) xlib-error-handler XSetErrorHandler drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : start-factory ( dpy-string -- )
   initialize-x
-  install-error-handler
+  [ "X11 : error-handler called" print flush ] set-error-handler
   root get [ make-drag-gc ] with-win drag-gc set
   root get [ black-pixel get set-window-background clear-window ] with-win
   root get create-wm-root
diff --git a/contrib/httpd/cont-responder.factor b/contrib/httpd/cont-responder.factor
index d16486e7cd..65e7e78f92 100644
--- a/contrib/httpd/cont-responder.factor
+++ b/contrib/httpd/cont-responder.factor
@@ -1,29 +1,10 @@
 ! Copyright (C) 2004 Chris Double.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-IN: cont-responder
+! See http://factorcode.org/license.txt for BSD license.
+
 USING: http httpd math namespaces io
-       lists strings kernel html hashtables
-       parser generic sequences ;
+lists strings kernel html hashtables
+parser generic sequences ;
+IN: cont-responder
 
 #! Used inside the session state of responders to indicate whether the
 #! next request should use the post-refresh-get pattern. It is set to
@@ -31,95 +12,95 @@ USING: http httpd math namespaces io
 SYMBOL: post-refresh-get?
 
 : expiry-timeout ( -- timeout-seconds )
-  #! Number of seconds to timeout continuations in
-  #! continuation table. This value will need to be
-  #! tuned. I leave it at 24 hours but it can be
-  #! higher/lower as needed. Default to 15 minutes for
-  #! testing.
-  900 ;
+    #! Number of seconds to timeout continuations in
+    #! continuation table. This value will need to be
+    #! tuned. I leave it at 24 hours but it can be
+    #! higher/lower as needed. Default to 15 minutes for
+    #! testing.
+    900 ;
 
 : get-random-id ( -- id ) 
-  #! Generate a random id to use for continuation URL's
-  [ "ID" % 32 [ 9 random-int CHAR: 0 + , ] times ] "" make ;
+    #! Generate a random id to use for continuation URL's
+    [ "ID" % 32 [ 9 random-int CHAR: 0 + , ] times ] "" make ;
 
 SYMBOL: table
 
 : continuation-table ( -- <hashtable> ) 
-  #! Return the global table of continuations
-  table global hash ;
-    
-: reset-continuation-table ( -- ) 
-  #! Create the initial global table
-  continuation-table clear-hash ;
+    #! Return the global table of continuations
+    table get-global ;
 
-H{ } clone table global set-hash
+: reset-continuation-table ( -- ) 
+    #! Create the initial global table
+    continuation-table clear-hash ;
+
+H{ } clone table set-global
 
 #! Tuple for holding data related to a continuation.
 TUPLE: item expire? quot id time-added ;
 
 : continuation-item ( expire? quot id -- <item> )
-  #! A continuation item is the actual item stored
-  #! in the continuation table. It contains the id,
-  #! quotation/continuation, time added, etc. If
-  #! expire? is true then the continuation will
-  #! be expired after a certain amount of time.
-  millis <item> ;  
+    #! A continuation item is the actual item stored
+    #! in the continuation table. It contains the id,
+    #! quotation/continuation, time added, etc. If
+    #! expire? is true then the continuation will
+    #! be expired after a certain amount of time.
+    millis <item> ;  
 
 : seconds>millis ( seconds -- millis )
-  #! Convert a number of seconds to milliseconds
-  1000 * ;
+    #! Convert a number of seconds to milliseconds
+    1000 * ;
 
 : expired? ( timeout-seconds <item> -- bool )
-  #! Return true if the continuation item is expirable
-  #! and has expired (ie. was added to the table more than
-  #! timeout milliseconds ago).
-  [ item-time-added swap seconds>millis + millis - 0 < ] keep item-expire? and ;
+    #! Return true if the continuation item is expirable
+    #! and has expired (ie. was added to the table more than
+    #! timeout milliseconds ago).
+    [ item-time-added swap seconds>millis + millis - 0 < ] keep item-expire? and ;
 
 : expire-continuations ( timeout-seconds -- )
-  #! Expire all continuations in the continuation table
-  #! if they are 'timeout-seconds' old (ie. were added
-  #! more than 'timeout-seconds' ago.
-  continuation-table clone [ ( timeout-seconds [[ id item ]] -- )
-    swapd expired? [
-      continuation-table remove-hash
-    ] [
-      drop
-    ] if
-  ] hash-each-with ;
+    #! Expire all continuations in the continuation table
+    #! if they are 'timeout-seconds' old (ie. were added
+    #! more than 'timeout-seconds' ago.
+    continuation-table clone [
+        swapd expired? [
+            continuation-table remove-hash
+        ] [
+            drop
+        ] if
+    ] hash-each-with ;
 
 : expirable ( quot -- t quot )
-  #! Set the stack up for a register-continuation call 
-  #! so that the given quotation is registered that it can
-  #! be expired.
-  t swap ;
+    #! Set the stack up for a register-continuation call 
+    #! so that the given quotation is registered that it can
+    #! be expired.
+    t swap ;
 
 : permanent ( quot -- f quot )
-  #! Set the stack up for a register-continuation call
-  #! so that the given quotation is never expired after
-  #! registration.
-  f swap ;
+    #! Set the stack up for a register-continuation call
+    #! so that the given quotation is never expired after
+    #! registration.
+    f swap ;
 
 : register-continuation ( expire? quot -- id ) 
-  #! Store a continuation in the table and associate it with
-  #! a random id. That continuation will be expired after
-  #! a certain period of time if 'expire?' is true.  
-  get-random-id 
-  [ continuation-item ] keep ( item id -- )
-  [ continuation-table set-hash ] keep ;
-  
+    #! Store a continuation in the table and associate it with
+    #! a random id. That continuation will be expired after
+    #! a certain period of time if 'expire?' is true.  
+    get-random-id 
+    [ continuation-item ] keep ( item id -- )
+    [ continuation-table set-hash ] keep ;
+
 : register-continuation* ( expire? quots -- id ) 
-  #! Like register-continuation but registers a quotation 
-  #! that will call all quotations in the list, in the order given.
-  concat register-continuation ;
+    #! Like register-continuation but registers a quotation 
+    #! that will call all quotations in the list, in the order given.
+    concat register-continuation ;
 
 : get-continuation-item ( id -- <item> )
-  #! Get the continuation item associated with the id.
-  continuation-table hash ;
+    #! Get the continuation item associated with the id.
+    continuation-table hash ;
 
 : id>url ( id -- string )
-  #! Convert the continuation id to an URL suitable for
-  #! embedding in an HREF or other HTML.
-  url-encode "?id=" swap append ;
+    #! Convert the continuation id to an URL suitable for
+    #! embedding in an HREF or other HTML.
+    url-encode "?id=" swap append ;
 
 DEFER: show-final
 DEFER: show 
@@ -127,268 +108,262 @@ DEFER: show
 TUPLE: resume value stdio ;
 
 : (expired-page-handler) ( alist -- )
-  #! Display a page has expired message.
-  #! TODO: Need to handle this better to enable
-  #!       returning back to root continuation.
+    #! Display a page has expired message.
+    #! TODO: Need to handle this better to enable
+    #!       returning back to root continuation.
     <html>                
-      <body> 
-       <p> "This page has expired." write  </p> 
-      </body>
-    </html> flush  ;
-
-: (expired-page-handler) ( alist -- )
-  #! Display a page has expired message.
-  #! TODO: Need to handle this better to enable
-  #!       returning back to root continuation.
-    drop
-    <html>                
-      <body> 
-       <p> "This page has expired." write  </p> 
-      </body>
+        <body> 
+        <p> "This page has expired." write  </p> 
+        </body>
     </html> flush  ;
 
 : expired-page-handler ( alist -- )
-  [ (expired-page-handler) ] show-final ;
+    [ (expired-page-handler) ] show-final ;
 
 : >callable ( quot|interp|f -- interp )
-  dup continuation? [
-    [ continue-with ] cons
-  ] when ;
+    dup continuation? [
+        [ continue-with ] cons
+    ] when ;
 
 : get-registered-continuation ( id -- cont ) 
-  #! Return the continuation or quotation 
-  #! associated with the given id.  
-  #! TODO: handle expired pages better.
-  expiry-timeout expire-continuations
-  get-continuation-item [
-    item-quot
-  ] [
-    [ (expired-page-handler) ]
-  ] if* >callable ;
+    #! Return the continuation or quotation 
+    #! associated with the given id.  
+    #! TODO: handle expired pages better.
+    expiry-timeout expire-continuations
+    get-continuation-item [
+        item-quot
+    ] [
+        [ (expired-page-handler) ]
+    ] if* >callable ;
 
 : resume-continuation ( resumed-data id  -- ) 
-  #! Call the continuation associated with the given id,
-  #! with 'value' on the top of the stack.
-  get-registered-continuation call ;
+    #! Call the continuation associated with the given id,
+    #! with 'value' on the top of the stack.
+    get-registered-continuation call ;
 
 #! Name of the variable holding the continuation used to exit
 #! back to the httpd responder, returning any generated HTML.
 SYMBOL: exit-cc 
 
 : exit-continuation ( -- exit ) 
-  #! Get the current exit continuation
-  exit-cc get ;
+    #! Get the current exit continuation
+    exit-cc get ;
 
 : call-exit-continuation ( value -- ) 
-  #! Call the exit continuation, passing it the given value on the
-  #! top of the stack.
-  exit-cc get continue-with ;
+    #! Call the exit continuation, passing it the given value on the
+    #! top of the stack.
+    exit-cc get continue-with ;
 
 : with-exit-continuation ( quot -- ) 
-  #! Call the quotation with the variable exit-cc bound such that when
-  #! the exit continuation is called, computation will resume from the
-  #! end of this 'with-exit-continuation' call, with the value passed
-  #! to the exit continuation on the top of the stack.
-  [ exit-cc set call f call-exit-continuation ] callcc1 nip ;
+    #! Call the quotation with the variable exit-cc bound such that when
+    #! the exit continuation is called, computation will resume from the
+    #! end of this 'with-exit-continuation' call, with the value passed
+    #! to the exit continuation on the top of the stack.
+    [ exit-cc set call f call-exit-continuation ] callcc1 nip ;
 
 #! Name of variable holding the 'callback' continuation, used for
 #! returning back to previous 'show' calls.
 SYMBOL: callback-cc
 
 : store-callback-cc ( -- )
-  #! Store the current continuation in the variable 'callback-cc' 
-  #! so it can be returned to later by callbacks. Note that it
-  #! recalls itself when the continuation is called to ensure that
-  #! it resets its value back to the most recent show call.
-  [  ( 0 -- )
-    [ ( 0 1 -- )
-      callback-cc set ( 0 -- )
-      stdio get swap continue-with
-    ] callcc1 ( 0 [ ] == )
-    nip
-    dup resume-stdio stdio set resume-value
-    call
-    store-callback-cc stdio get 
-  ] callcc1 stdio set ;
+    #! Store the current continuation in the variable 'callback-cc' 
+    #! so it can be returned to later by callbacks. Note that it
+    #! recalls itself when the continuation is called to ensure that
+    #! it resets its value back to the most recent show call.
+    [  ( 0 -- )
+        [ ( 0 1 -- )
+            callback-cc set ( 0 -- )
+            stdio get swap continue-with
+        ] callcc1
+        nip
+        dup resume-stdio stdio set
+        resume-value call
+        store-callback-cc stdio get 
+    ] callcc1 stdio set ;
 
 : forward-to-url ( url -- )
-  #! When executed inside a 'show' call, this will force a
-  #! HTTP 302 to occur to instruct the browser to forward to
-  #! the request URL.
-  [ 
-    "HTTP/1.1 302 Document Moved\nLocation: " % %
-    "\nContent-Length: 0\nContent-Type: text/plain\n\n" %
-  ] "" make write "" call-exit-continuation ;
+    #! When executed inside a 'show' call, this will force a
+    #! HTTP 302 to occur to instruct the browser to forward to
+    #! the request URL.
+    [ 
+        "HTTP/1.1 302 Document Moved\nLocation: " % %
+        "\nContent-Length: 0\nContent-Type: text/plain\n\n" %
+    ] "" make write "" call-exit-continuation ;
 
 : forward-to-id ( id -- )
-  #! When executed inside a 'show' call, this will force a
-  #! HTTP 302 to occur to instruct the browser to forward to
-  #! the request URL.
-  >r "request" get r> id>url append forward-to-url ;
+    #! When executed inside a 'show' call, this will force a
+    #! HTTP 302 to occur to instruct the browser to forward to
+    #! the request URL.
+    >r "request" get r> id>url append forward-to-url ;
 
 : redirect-to-here ( -- )
-  #! Force a redirect to the client browser so that the browser
-  #! goes to the current point in the code. This forces an URL
-  #! change on the browser so that refreshing that URL will
-  #! immediately run from this code point. This prevents the 
-  #! "this request will issue a POST" warning from the browser
-  #! and prevents re-running the previous POST logic. This is
-  #! known as the 'post-refresh-get' pattern.
-  post-refresh-get? get [
-    [ 
-      expirable register-continuation forward-to-id
-    ] callcc1 resume-stdio stdio set
-  ] [
-    t post-refresh-get? set
-  ] if ;
+    #! Force a redirect to the client browser so that the browser
+    #! goes to the current point in the code. This forces an URL
+    #! change on the browser so that refreshing that URL will
+    #! immediately run from this code point. This prevents the 
+    #! "this request will issue a POST" warning from the browser
+    #! and prevents re-running the previous POST logic. This is
+    #! known as the 'post-refresh-get' pattern.
+    post-refresh-get? get [
+        [ 
+            expirable register-continuation forward-to-id
+        ] callcc1 resume-stdio stdio set
+    ] [
+        t post-refresh-get? set
+    ] if ;
 
 : (show) ( quot -- namespace )   
-  #! See comments for show. The difference is the 
-  #! quotation MUST set the content-type using 'serving-html'
-  #! or similar.
-  store-callback-cc  redirect-to-here 
-  [ 
-    expirable register-continuation id>url swap 
-    with-scope "" call-exit-continuation
-  ] callcc1 
-  nip dup resume-stdio stdio set resume-value ;
-  
+    #! See comments for show. The difference is the 
+    #! quotation MUST set the content-type using 'serving-html'
+    #! or similar.
+    store-callback-cc  redirect-to-here 
+    [ 
+        expirable register-continuation id>url swap 
+        with-scope "" call-exit-continuation
+    ] callcc1 
+    nip dup resume-stdio stdio set resume-value ;
+
 : show ( quot -- namespace )   
-  #! Call the quotation with the URL associated with the current
-  #! continuation. All output from the quotation goes to the client
-  #! browser. When the URL is later referenced then 
-  #! computation will resume from this 'show' call with a namespace on
-  #! the stack containing any query or post parameters.
-  #! NOTE: On return from 'show' the stack is exactly the same as
-  #! initial entry with 'quot' popped off an <namespace> put on. Even
-  #! if the quotation consumes items on the stack.
-  \ serving-html swons (show) ;
+    #! Call the quotation with the URL associated with the current
+    #! continuation. All output from the quotation goes to the client
+    #! browser. When the URL is later referenced then 
+    #! computation will resume from this 'show' call with a namespace on
+    #! the stack containing any query or post parameters.
+    #! NOTE: On return from 'show' the stack is exactly the same as
+    #! initial entry with 'quot' popped off an <namespace> put on. Even
+    #! if the quotation consumes items on the stack.
+    \ serving-html swons (show) ;
 
 : (show-final) ( quot -- namespace )
-  #! See comments for show-final. The difference is the 
-  #! quotation MUST set the content-type using 'serving-html'
-  #! or similar.
-  store-callback-cc  redirect-to-here 
-  with-scope "" call-exit-continuation ;
+    #! See comments for show-final. The difference is the 
+    #! quotation MUST set the content-type using 'serving-html'
+    #! or similar.
+    store-callback-cc  redirect-to-here 
+    with-scope "" call-exit-continuation ;
 
 : show-final ( quot -- namespace )
-  #! Similar to 'show', except the quotation does not receive the URL
-  #! to resume computation following 'show-final'. No continuation is
-  #! stored for this resumption. As a result, 'show-final' is for use
-  #! when a page is to be displayed with no further action to occur. Its
-  #! use is an optimisation to save having to generate and save a continuation
-  #! in that special case.
-  \ serving-html swons (show-final) ;
+    #! Similar to 'show', except the quotation does not receive the URL
+    #! to resume computation following 'show-final'. No continuation is
+    #! stored for this resumption. As a result, 'show-final' is for use
+    #! when a page is to be displayed with no further action to occur. Its
+    #! use is an optimisation to save having to generate and save a continuation
+    #! in that special case.
+    \ serving-html swons (show-final) ;
 
 #! Name of variable for holding initial continuation id that starts
 #! the responder.
 SYMBOL: root-continuation
 
 : id-or-root ( -- id )
-  #! Return the continuation id for the current requested continuation
-  #! or the root continuation if no id is supplied.
-  "id" "query" get hash [ root-continuation get ] unless* ;
+    #! Return the continuation id for the current requested continuation
+    #! or the root continuation if no id is supplied.
+    "id" "query" get hash [ root-continuation get ] unless* ;
 
 : cont-get/post-responder ( id-or-f -- ) 
-  #! httpd responder that retrieves a continuation and calls it.
-  #! The continuation id must be in a query parameter called 'id'.
-  #! If it does not exist the root continuation is called. If
-  #! no root continuation exists the expired continuation handler
-  #! should be called.
-  drop [
-    "response" get stdio get <resume>
-     id-or-root [
-      resume-continuation
-    ] [
-      (expired-page-handler) "" call-exit-continuation
-    ] if* 
-  ] with-exit-continuation drop ;
+    #! httpd responder that retrieves a continuation and calls it.
+    #! The continuation id must be in a query parameter called 'id'.
+    #! If it does not exist the root continuation is called. If
+    #! no root continuation exists the expired continuation handler
+    #! should be called.
+    [
+        drop [
+            "response" get stdio get <resume>
+            id-or-root [
+                resume-continuation
+            ] [
+                (expired-page-handler) "" call-exit-continuation
+            ] if* 
+        ] with-exit-continuation drop
+    ] with-scope ;
 
 : callback-quot ( quot -- quot )
-  #! Convert the given quotation so it works as a callback
-  #! by returning a quotation that will pass the original 
-  #! quotation to the callback continuation.
-  [ , \ stdio ,  \ get , \ <resume> , callback-cc get , \ continue-with , ] [ ] make ;
+    #! Convert the given quotation so it works as a callback
+    #! by returning a quotation that will pass the original 
+    #! quotation to the callback continuation.
+    [
+        , \ stdio ,  \ get , \ <resume> , callback-cc get ,
+        \ continue-with ,
+    ] [ ] make ;
 
 : quot-url ( quot -- url )
-  callback-quot expirable register-continuation id>url ;
+    callback-quot expirable register-continuation id>url ;
 
 : quot-href ( text quot -- )
-  #! Write to standard output an HTML HREF where the href,
-  #! when referenced, will call the quotation and then return
-  #! back to the most recent 'show' call (via the callback-cc).
-  #! The text of the link will be the 'text' argument on the 
-  #! stack.
-  <a quot-url =href a> write </a> ;
+    #! Write to standard output an HTML HREF where the href,
+    #! when referenced, will call the quotation and then return
+    #! back to the most recent 'show' call (via the callback-cc).
+    #! The text of the link will be the 'text' argument on the 
+    #! stack.
+    <a quot-url =href a> write </a> ;
 
 : init-session-namespace ( <resume> -- )
-  #! Setup the initial session namespace. Currently this only
-  #! sets the redirect flag so that the initial request of the
-  #! responder will not do a post-refresh-get style redirect.
-  #! This prevents the initial request to a responder from redirecting
-  #! to an URL with a continuation id. This word must be run from
-  #! within the session namespace.
-  f post-refresh-get? set dup resume-stdio stdio set ;
+    #! Setup the initial session namespace. Currently this only
+    #! sets the redirect flag so that the initial request of the
+    #! responder will not do a post-refresh-get style redirect.
+    #! This prevents the initial request to a responder from redirecting
+    #! to an URL with a continuation id. This word must be run from
+    #! within the session namespace.
+    f post-refresh-get? set dup resume-stdio stdio set ;
 
 : install-cont-responder ( name quot -- )
-  #! Install a cont-responder with the given name
-  #! that will initially run the given quotation.
-  #!
-  #! Convert the quotation so it is run within a session namespace
-  #! and that namespace is initialized first.
-  \ init-session-namespace swons [ , \ with-scope , ] [ ] make
-  [ 
-     [ cont-get/post-responder ] "get" set 
-     [ cont-get/post-responder ] "post" set 
-     swap "responder" set
-     permanent register-continuation root-continuation set 
-  ] make-responder ;
+    #! Install a cont-responder with the given name
+    #! that will initially run the given quotation.
+    #!
+    #! Convert the quotation so it is run within a session namespace
+    #! and that namespace is initialized first.
+    \ init-session-namespace swons [ , \ with-scope , ] [ ] make
+    [ 
+        [ cont-get/post-responder ] "get" set 
+        [ cont-get/post-responder ] "post" set 
+        swap "responder" set
+        permanent register-continuation root-continuation set 
+    ] make-responder ;
 
 : simple-page ( title quot -- )
-  #! Call the quotation, with all output going to the
-  #! body of an html page with the given title.
-  <html>  
-    <head> <title> swap write </title> </head> 
-    <body> call </body>
-  </html> ;
+    #! Call the quotation, with all output going to the
+    #! body of an html page with the given title.
+    <html>  
+        <head> <title> swap write </title> </head> 
+        <body> call </body>
+    </html> ;
 
 : styled-page ( title stylesheet-quot quot -- )
-  #! Call the quotation, with all output going to the
-  #! body of an html page with the given title. stylesheet-quot
-  #! is called to generate the required stylesheet.
-  <html>  
-    <head>  
-      <title> rot write </title> 
-      swap call 
-    </head> 
-    <body> call </body>
-  </html> ;
+    #! Call the quotation, with all output going to the
+    #! body of an html page with the given title. stylesheet-quot
+    #! is called to generate the required stylesheet.
+    <html>  
+        <head>  
+             <title> rot write </title> 
+             swap call 
+        </head> 
+        <body> call </body>
+    </html> ;
 
 : paragraph ( str -- )
-  #! Output the string as an html paragraph
-  <p> write </p> ;
+    #! Output the string as an html paragraph
+    <p> write </p> ;
 
 : show-message-page ( message -- )
-  #! Display the message in an HTML page with an OK button.
-  [
-    "Press OK to Continue" [
-       swap paragraph 
-       <a =href a> "OK" write </a>
-    ] simple-page 
-  ] show 2drop ;
+    #! Display the message in an HTML page with an OK button.
+    [
+        "Press OK to Continue" [
+            swap paragraph 
+            <a =href a> "OK" write </a>
+        ] simple-page 
+    ] show 2drop ;
 
 : vertical-layout ( list -- )
-  #! Given a list of HTML components, arrange them vertically.
-  <table> 
+    #! Given a list of HTML components, arrange them vertically.
+    <table> 
     [ <tr> <td> call </td> </tr> ] each
-  </table> ;
+    </table> ;
 
 : horizontal-layout ( list -- )
-  #! Given a list of HTML components, arrange them horizontally.
-  <table> 
-    <tr "top" =valign tr> [ <td> call </td> ] each </tr>
-  </table> ;
+    #! Given a list of HTML components, arrange them horizontally.
+    <table> 
+     <tr "top" =valign tr> [ <td> call </td> ] each </tr>
+    </table> ;
 
 : button ( label -- )
-  #! Output an HTML submit button with the given label.
-  <input "submit" =type =value input/> ;
+    #! Output an HTML submit button with the given label.
+    <input "submit" =type =value input/> ;
diff --git a/contrib/math/infix.factor b/contrib/math/infix.factor
index 46f5639be0..f0c8e1df70 100644
--- a/contrib/math/infix.factor
+++ b/contrib/math/infix.factor
@@ -89,6 +89,8 @@ UNION: value number string ;
     #! The semicolon token
     T{ tok f CHAR: ; } ;
 
+: unswons uncons swap ;
+
 : nest-apply ( [ ast ] -- apply )
     unswons unit swap [
         swap <apply> unit
diff --git a/contrib/parser-combinators/parser-combinators.factor b/contrib/parser-combinators/parser-combinators.factor
index c85599044c..eed33ff8b8 100644
--- a/contrib/parser-combinators/parser-combinators.factor
+++ b/contrib/parser-combinators/parser-combinators.factor
@@ -237,6 +237,8 @@ M: list pdrop ( n object -- object )
   >r uncons r> ( x1 xs2 x )
   swap cons cons ;
 
+: unswons uncons swap ;
+
 : <&>-do-parser2 ( [[ x xs ]] parser2 -- result )
   #! Called by the <&>-parser on each result of the
   #! successfull parse of parser1. It's input is the
diff --git a/contrib/random-tester/random-tester.factor b/contrib/random-tester/random-tester.factor
index 5c995d2b0e..20dca6fc48 100644
--- a/contrib/random-tester/random-tester.factor
+++ b/contrib/random-tester/random-tester.factor
@@ -241,7 +241,7 @@ SYMBOL: first-arg
     dup .
     [ last-quot set ] keep
     [ call ] keep
-    [ last car update-xt ] keep call
+    [ peek update-xt ] keep call
     2dup swap unparse write " " write unparse print
     = [ "update-xt problem" throw ] unless ;
 
diff --git a/contrib/splay-trees.factor b/contrib/splay-trees.factor
index fe9bfa33c7..7f8b7e20b8 100644
--- a/contrib/splay-trees.factor
+++ b/contrib/splay-trees.factor
@@ -111,5 +111,5 @@ DEFER: (splay)
 USING: namespaces words ;
 
 <splay-tree> "foo" set
-[ dup word-name "foo" get set-splay ] each-word
-[ dup word-name "foo" get get-splay drop ] each-word
+all-words [ dup word-name "foo" get set-splay ] each
+all-words [ dup word-name "foo" get get-splay drop ] each
diff --git a/contrib/x11/concurrent-widgets.factor b/contrib/x11/concurrent-widgets.factor
index 81fb535354..4593787067 100644
--- a/contrib/x11/concurrent-widgets.factor
+++ b/contrib/x11/concurrent-widgets.factor
@@ -58,21 +58,21 @@ GENERIC: handle-property-event
 
 : handle-event ( event obj -- )
   over XAnyEvent-type
-  { { [ dup Expose = ]			[ drop handle-expose-event ] }
-    { [ dup KeyPress = ]		[ drop handle-key-press-event ] }
-    { [ dup KeyRelease = ]		[ drop handle-key-release-event ] }
-    { [ dup ButtonPress = ]		[ drop handle-button-press-event ] }
-    { [ dup ButtonRelease = ]		[ drop handle-button-release-event ] }
-    { [ dup ConfigureNotify = ]		[ drop handle-configure-event ] }
-    { [ dup EnterNotify = ]		[ drop handle-enter-window-event ] }
-    { [ dup LeaveNotify = ]		[ drop handle-leave-window-event ] }
-    { [ dup DestroyNotify = ]		[ drop handle-destroy-window-event ] }
-    { [ dup MapRequest = ]		[ drop handle-map-request-event ] }
-    { [ dup MapNotify = ]		[ drop handle-map-event ] }
-    { [ dup ConfigureRequest = ]	[ drop handle-configure-request-event ] }
-    { [ dup UnmapNotify = ]		[ drop handle-unmap-event ] }
-    { [ dup PropertyNotify = ]		[ drop handle-property-event ] }
-    { [ t ]                [ "handle-event ignoring event" print flush 3drop ] } }
+  { { [ dup Expose = ]		 [ drop handle-expose-event ] }
+    { [ dup KeyPress = ]	 [ drop handle-key-press-event ] }
+    { [ dup KeyRelease = ]	 [ drop handle-key-release-event ] }
+    { [ dup ButtonPress = ]	 [ drop handle-button-press-event ] }
+    { [ dup ButtonRelease = ]	 [ drop handle-button-release-event ] }
+    { [ dup ConfigureNotify = ]	 [ drop handle-configure-event ] }
+    { [ dup EnterNotify = ]	 [ drop handle-enter-window-event ] }
+    { [ dup LeaveNotify = ]	 [ drop handle-leave-window-event ] }
+    { [ dup DestroyNotify = ]	 [ drop handle-destroy-window-event ] }
+    { [ dup MapRequest = ]	 [ drop handle-map-request-event ] }
+    { [ dup MapNotify = ]	 [ drop handle-map-event ] }
+    { [ dup ConfigureRequest = ] [ drop handle-configure-request-event ] }
+    { [ dup UnmapNotify = ]      [ drop handle-unmap-event ] }
+    { [ dup PropertyNotify = ]   [ drop handle-property-event ] }
+    { [ t ] [ "handle-event ignoring event" print flush 3drop ] } }
   cond ;
 
 M: window handle-configure-event ( event obj -- )
diff --git a/contrib/x11/x.factor b/contrib/x11/x.factor
index 9e63f83281..4242058b4c 100644
--- a/contrib/x11/x.factor
+++ b/contrib/x11/x.factor
@@ -1,5 +1,6 @@
+USING: namespaces kernel compiler math arrays strings alien sequences io
+prettyprint xlib rectangle ;
 
-USING: namespaces kernel math arrays strings alien sequences xlib rectangle ;
 IN: x 
 
 SYMBOL: dpy
@@ -133,12 +134,99 @@ DEFER: with-win
 : get-window-attributes ( -- <XWindowAttributes> )
   dpy get win get "XWindowAttributes" <c-object> dup >r XGetWindowAttributes drop r> ;
 
+: window-root get-window-attributes XWindowAttributes-root ;
+
 : window-map-state
   get-window-attributes XWindowAttributes-map_state ;
 
+: window-event-mask
+get-window-attributes XWindowAttributes-your_event_mask ;
+
+: window-all-event-masks
+get-window-attributes XWindowAttributes-all_event_masks ;
+
 : window-override-redirect
   get-window-attributes XWindowAttributes-override_redirect ;
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SYMBOL: event-masks
+
+{ { "NoEventMask" 0 }
+  { "KeyPressMask" 1 }
+  { "KeyReleaseMask" 2 }
+  { "ButtonPressMask" 4 }
+  { "ButtonReleaseMask" 8 }
+  { "EnterWindowMask" 16 }
+  { "LeaveWindowMask" 32 }
+  { "PointerMotionMask" 64 }
+  { "PointerMotionHintMask" 128 }
+  { "Button1MotionMask" 256 }
+  { "Button2MotionMask" 512 }
+  { "Button3MotionMask" 1024 }
+  { "Button4MotionMask" 2048 }
+  { "Button5MotionMask" 4096 }
+  { "ButtonMotionMask" 8192 }
+  { "KeymapStateMask" 16384 }
+  { "ExposureMask" 32768 }
+  { "VisibilityChangeMask" 65536 }
+  { "StructureNotifyMask" 131072 }
+  { "ResizeRedirectMask" 262144 }
+  { "SubstructureNotifyMask" 524288 }
+  { "SubstructureRedirectMask" 1048576 }
+  { "FocusChangeMask" 2097152 }
+  { "PropertyChangeMask" 4194304 }
+  { "ColormapChangeMask" 8388608 }
+  { "OwnerGrabButtonMask" 16777216 }
+} event-masks set-global
+
+: bit-test ( a b -- t-or-f ) bitand 0 = not ;
+  
+: name>event-mask ( str -- i )
+event-masks get [ first over = ] find 2nip second ;
+
+: event-mask>name ( i -- str )
+event-masks get [ second over = ] find 2nip first ;
+
+: event-mask-names ( -- seq ) event-masks get [ first ] map ;
+
+: event-mask>names ( mask -- seq )
+event-mask-names [ name>event-mask bit-test ] subset-with ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Pretty printing window information
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: print-field ( name value -- ) swap "=" append write pprint ;
+
+: spc ( -- ) " " write ;
+
+: print-window-geometry ( -- )
+window-width pprint "x" write window-height pprint "+" write
+window-x pprint "+" write window-y pprint ;
+
+: print-map-state ( -- )
+"map-state=" write
+window-map-state
+{ { [ dup 0 = ] [ drop "IsUnmapped" write ] }
+  { [ dup 1 = ] [ drop "IsUnviewable" write ] }
+  { [ dup 2 = ] [ drop "IsViewable" write ] }
+} cond ;
+
+: print-window-info ( -- )
+"id" win get print-field spc
+"parent" window-parent print-field spc
+"root" window-root print-field spc
+print-window-geometry terpri
+"children" window-children print-field terpri
+"override-redirect" window-override-redirect print-field spc
+print-map-state terpri
+"event-mask" window-event-mask event-mask>names print-field terpri
+"all-event-masks" window-all-event-masks event-mask>names print-field
+terpri ;
+
+: .win print-window-info ;
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 6 - Color Management Functions
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -205,14 +293,15 @@ dup length 1 - [ swap 2nth draw-line ] each-with ;
 
 ! 8.6 - Drawing Text
 
-: draw-string ( { x y } string -- )
-  >r >r dpy get win get gcontext get r> [ ] each r> dup length XDrawString drop ;
+: draw-string ( { x y } string -- ) >r >r
+dpy get win get gcontext get r> [ ] each r> dup length XDrawString drop ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 9 - Window and Session Manager Functions
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: reparent-window ( parent -- ) >r dpy get win get r> 0 0 XReparentWindow drop ;
+: reparent-window ( parent -- ) >r
+dpy get win get r> 0 0 XReparentWindow drop ;
 
 : add-to-save-set ( -- ) dpy get win get XAddToSaveSet drop ;
 
@@ -238,6 +327,16 @@ dpy get "XEvent" <c-object> dup >r XNextEvent drop r> ;
 
 : events-queued ( mode -- n ) >r dpy get r> XEventsQueued ;
 
+! 11.8 - Handling Protocol Errors
+
+SYMBOL: error-handler-quot
+
+: error-handler-callback ( -- xt ) "void" { "Display*" "XErrorEvent*" }
+[ error-handler-quot get call ] alien-callback ; compiled
+
+: set-error-handler ( quot -- )
+error-handler-quot set error-handler-callback XSetErrorHandler drop ;
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 12 - Input Device Functions
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -246,8 +345,8 @@ dpy get "XEvent" <c-object> dup >r XNextEvent drop r> ;
   >r >r dpy get win get r> r> XSetInputFocus drop ;
 
 : grab-pointer ( mask -- )
-  >r dpy get win get False r> GrabModeAsync GrabModeAsync None None CurrentTime
-  XGrabPointer drop ;
+>r dpy get win get False r> GrabModeAsync GrabModeAsync None None CurrentTime
+XGrabPointer drop ;
 
 : ungrab-pointer ( time -- )
   >r dpy get r> XUngrabPointer drop ;
@@ -284,6 +383,7 @@ dpy get "XEvent" <c-object> dup >r XNextEvent drop r> ;
 : destroy-window+		[ destroy-window ] with-win ;
 : map-window+			[ map-window ] with-win ;
 : unmap-window+			[ unmap-window ] with-win ;
+: window-parent+		[ window-parent ] with-win ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
diff --git a/contrib/x11/xlib.factor b/contrib/x11/xlib.factor
index 0033cab2d6..4bba879a5f 100644
--- a/contrib/x11/xlib.factor
+++ b/contrib/x11/xlib.factor
@@ -472,11 +472,11 @@ FUNCTION: Status XKillClient ( Display* display, XID resource ) ;
 : MotionNotify		6 ;
 : EnterNotify		7 ;
 : LeaveNotify		8 ;
-: FocusIn			9 ;
+: FocusIn		9 ;
 : FocusOut		10 ;
 : KeymapNotify		11 ;
-: Expose			12 ;
-: GraphicsExpose		13 ;
+: Expose		12 ;
+: GraphicsExpose	13 ;
 : NoExpose		14 ;
 : VisibilityNotify	15 ;
 : CreateNotify		16 ;
@@ -484,24 +484,22 @@ FUNCTION: Status XKillClient ( Display* display, XID resource ) ;
 : UnmapNotify		18 ;
 : MapNotify		19 ;
 : MapRequest		20 ;
-: ReparentNotify		21 ;
-: ConfigureNotify		22 ;
+: ReparentNotify	21 ;
+: ConfigureNotify	22 ;
 : ConfigureRequest	23 ;
 : GravityNotify		24 ;
 : ResizeRequest		25 ;
-: CirculateNotify		26 ;
+: CirculateNotify	26 ;
 : CirculateRequest	27 ;
-: PropertyNotify		28 ;
-: SelectionClear		29 ;
+: PropertyNotify	28 ;
+: SelectionClear	29 ;
 : SelectionRequest	30 ;
-: SelectionNotify		31 ;
-: ColormapNotify		32 ;
+: SelectionNotify	31 ;
+: ColormapNotify	32 ;
 : ClientMessage		33 ;
 : MappingNotify		34 ;
 : LASTEvent		35 ;
 
-
-
 BEGIN-STRUCT: XAnyEvent
 	FIELD: int type
 	FIELD: ulong serial
diff --git a/cp_dir b/cp_dir
old mode 100644
new mode 100755
diff --git a/doc/handbook/changes.facts b/doc/handbook/changes.facts
index b8d98523f7..fdf85b462d 100644
--- a/doc/handbook/changes.facts
+++ b/doc/handbook/changes.facts
@@ -1,6 +1,16 @@
 USING: generic help inspector memory sequences ;
 
 ARTICLE: "changes" "Changes in the latest release"
+{ $subheading "Factor 0.82" }
+{ $list
+    "New code generator framework in compiler"
+    "Floating point operations are now open-coded, resulting in a performance gain"
+    { "Remove " { $snippet "unswons" } " word" }
+    "Implement value type struct inputs to callbacks on AMD64"
+    "Fix some Unix I/O bugs"
+    "Standard OS X-style menu bar in the Cocoa UI (Kevin Reid)"
+    "Objective C methods defined in Factor can now return C structures by value"
+}
 { $subheading "Factor 0.81" }
 { $subtopic "UI"
     { $list
diff --git a/doc/handbook/collections.facts b/doc/handbook/collections.facts
index b16c7b504e..ac5991e962 100644
--- a/doc/handbook/collections.facts
+++ b/doc/handbook/collections.facts
@@ -52,7 +52,6 @@ ARTICLE: "hashtables-lookup" "Looking up keys in hashtables"
 
 ARTICLE: "hashtables-mutation" "Storing keys in hashtables"
 { $subsection set-hash }
-{ $subsection ?set-hash }
 { $subsection remove-hash }
 { $subsection clear-hash } ;
 
@@ -140,7 +139,6 @@ ARTICLE: "namespaces-make" "Constructing sequences"
 
 ARTICLE: "namespaces-internals" "Namespace implementation details"
 "The namestack holds namespaces."
-{ $subsection namestack* }
 { $subsection namestack }
 { $subsection set-namestack }
 "A pair of words push and pop namespaces on the namestack."
diff --git a/doc/handbook/streams.facts b/doc/handbook/streams.facts
index 16bf07225a..bb66229cba 100644
--- a/doc/handbook/streams.facts
+++ b/doc/handbook/streams.facts
@@ -24,7 +24,7 @@ GLOSSARY: "output stream" "an object responding to the output words of the " { $
 GLOSSARY: "bidirectional stream" "an object that is both an input and output stream" ;
 
 ARTICLE: "stream-protocol" "Stream protocol"
-"The stream protocol consits of a large number of generic words, many of which are optional."
+"The stream protocol consists of a large number of generic words, many of which are optional."
 $terpri
 "A word required to be implemented for all streams:"
 { $subsection stream-close }
@@ -86,8 +86,6 @@ ARTICLE: "character-styles" "Character styles"
 "Character styles for " { $link stream-format } ":"
 { $subsection foreground }
 { $subsection background }
-{ $subsection foreground }
-{ $subsection background }
 { $subsection font }
 { $subsection font-size }
 { $subsection font-style }
diff --git a/examples/homology.factor b/examples/homology.factor
new file mode 100644
index 0000000000..a4c495e302
--- /dev/null
+++ b/examples/homology.factor
@@ -0,0 +1,156 @@
+IN: homology
+USING: kernel sequences arrays math words namespaces
+hashtables prettyprint io ;
+
+! Utilities
+: S{ [ [ dup ] map>hash ] [ ] ; parsing
+
+: (lengthen) ( seq n -- seq )
+    over length - f <array> append ;
+
+: lengthen ( sim sim -- sim sim )
+    2dup max-length tuck (lengthen) >r (lengthen) r> ;
+
+: unswons* 1 over tail swap first ;
+
+: swons* 1array swap append ;
+
+: rot-seq ( seq -- seq ) unswons* add ;
+
+: <point> ( -- sim ) gensym 1array ;
+
+: (C) ( point sim -- sim )
+    [ [ append natural-sort ] map-with ] map-with ;
+
+: (\/) ( sim sim -- sim ) lengthen [ append natural-sort ] 2map ;
+
+: <range> ( from to -- seq ) dup <slice> ;
+
+! Simplicial complexes
+SYMBOL: basepoint
+
+: {*} ( -- sim )
+    #! Initial object in category
+    { { { basepoint } } } ;
+
+: \/ ( sim sim -- sim )
+    #! Glue two complexes at base point
+    (\/) [ prune ] map ;
+
+: +point ( sim -- sim )
+    #! Adjoint an isolated point
+    unswons* <point> add swons* ;
+
+: C ( sim -- sim )
+    #! Cone on a space
+    <point> over first over add >r swap (C) r> swons* ;
+
+: S ( sim -- sim )
+    #! Suspension
+    [
+        <point> <point> 2dup 2array >r
+        pick (C) >r swap (C) r> (\/) r> swons*
+    ] keep (\/) ;
+
+: S^0 ( -- sim )
+    #! Degenerate sphere -- two points
+    {*} +point ;
+
+: S^ ( n -- sim )
+    #! Sphere
+    S^0 swap [ S ] times ;
+
+: D^ ( n -- sim )
+    #! Disc
+    1- S^ C ;
+
+! Mod 2 matrix algebra
+: remove-1 ( n seq -- seq )
+    >r { } swap dup 1+ r> replace-slice ;
+
+: symmetric-diff ( hash hash -- hash )
+    clone swap [
+        drop dup pick hash [
+            over remove-hash
+        ] [
+            dup pick set-hash
+        ] if
+    ] hash-each ;
+
+SYMBOL: row-basis
+SYMBOL: matrix
+SYMBOL: current-row
+
+: rows ( -- n ) matrix get length ;
+
+: exchange-rows ( m n -- )
+    2dup = [ 2drop ] [ matrix get exchange ] if ;
+
+: row ( n -- row ) matrix get nth ;
+
+: set-row ( row n -- ) matrix get set-nth ;
+
+: add-row ( src# dst# -- )
+    [ [ row ] 2apply symmetric-diff ] keep set-row ;
+
+: pivot-row ( basis-elt -- n )
+    current-row get rows <range>
+    [ row hash-member? ] find-with nip ;
+
+: kill-column ( basis-elt pivot -- )
+    dup 1+ rows <range> [
+        pick over row hash-member? [ dupd add-row ] [ drop ] if
+    ] each 2drop ;
+
+: with-matrix ( matrix basis quot -- matrix )
+    [
+        >r row-basis set matrix set r> call matrix get
+    ] with-scope ; inline
+
+: (row-reduce)
+    0 current-row set
+    row-basis get [
+        dup pivot-row dup [
+            current-row get exchange-rows
+            current-row get kill-column
+            current-row inc
+        ] [
+            2drop
+        ] if
+    ] each ;
+
+: ker/im ( -- ker im )
+    matrix get [ hash-empty? ] subset length
+    row-basis get [
+        matrix get [ hash-member? ] contains-with?
+    ] subset length ;
+
+: row-reduce ( matrix basis -- rowsp colsp matrix )
+    [ (row-reduce) ker/im ] with-matrix ;
+
+! Mod 2 homology
+: (boundary) ( seq -- chain )
+    dup length 1 <= [
+        H{ }
+    ] [
+        dup length [ over remove-1 dup ] map>hash
+    ] if nip ;
+
+: boundary ( chain -- chain )
+    H{ } swap [ drop (boundary) symmetric-diff ] hash-each ;
+
+: homology ( sim -- seq )
+    dup [ [ (boundary) ] map ] map rot-seq
+    [ row-reduce drop 2array ] 2map ;
+
+: print-matrix ( matrix basis -- )
+    swap [
+        swap [
+            ( row basis-elt )
+            swap hash-member? 1 0 ? pprint bl
+        ] each-with terpri
+    ] each-with ;
+
+2 S^ [ [ [ (boundary) ] map ] map unswons* drop ] keep
+[ [ row-reduce 2nip ] 2map ] keep
+[ print-matrix terpri ] 2each
diff --git a/examples/mandel.factor b/examples/mandel.factor
index c50491867b..ae74192ba5 100644
--- a/examples/mandel.factor
+++ b/examples/mandel.factor
@@ -70,7 +70,7 @@ strings test ;
     ] map-with ;
 
 : iter ( c z nb-iter -- x )
-    over absq 4.0 >= over 0 = or
+    over absq 4.0 >= over zero? or
     [ 2nip ] [ 1- >r sq dupd + r> iter ] if ; inline
 
 SYMBOL: cols
@@ -88,7 +88,7 @@ SYMBOL: cols
 : render ( -- )
     height [
         width [
-            2dup swap c 0 nb-iter iter dup 0 = [
+            2dup swap c 0 nb-iter iter dup zero? [
                 drop "\0\0\0"
             ] [
                 cols get [ length mod ] keep nth
diff --git a/examples/numbers-game.factor b/examples/numbers-game.factor
index ab99e51f5b..75e3b382db 100644
--- a/examples/numbers-game.factor
+++ b/examples/numbers-game.factor
@@ -1,5 +1,5 @@
 IN: numbers-game
-USING: kernel math parser random io ;
+USING: kernel math parser io ;
 
 : read-number ( -- n ) readln string>number ;
 
diff --git a/examples/raytracer.factor b/examples/raytracer.factor
index 38867117a7..60eafd6b32 100644
--- a/examples/raytracer.factor
+++ b/examples/raytracer.factor
@@ -2,7 +2,7 @@
 ! http://www.ffconsultancy.com/free/ray_tracer/languages.html
 
 USING: arrays compiler generic io kernel lists math namespaces
-sequences test ;
+sequences test words ;
 IN: ray
 
 ! parameters
@@ -27,24 +27,26 @@ GENERIC: intersect-scene ( hit ray scene -- hit )
 TUPLE: sphere center radius ;
 
 : sphere-v ( sphere ray -- v )
-    swap sphere-center swap ray-orig v- ;
+    swap sphere-center swap ray-orig v- ; inline
 
-: sphere-b ( ray v -- b ) swap ray-dir v. ;
+: sphere-b ( ray v -- b ) swap ray-dir v. ; inline
 
 : sphere-disc ( sphere v b -- d )
-    sq swap norm-sq - swap sphere-radius sq + ;
+    sq swap norm-sq - swap sphere-radius sq + ; inline
 
-: -+ ( x y -- x-y x+y ) [ - ] 2keep + ;
+: -+ ( x y -- x-y x+y ) [ - ] 2keep + ; inline
 
 : sphere-b/d ( b d -- t )
-    -+ dup 0.0 < [ 2drop 1.0/0.0 ] [ >r [ 0.0 > ] keep r> ? ] if ;
+    -+ dup 0.0 < [ 2drop 1.0/0.0 ] [ >r [ 0.0 > ] keep r> ? ] if ; inline
 
 : ray-sphere ( sphere ray -- t )
     2dup sphere-v tuck sphere-b [ sphere-disc ] keep
     over 0.0 < [ 2drop 1.0/0.0 ] [ swap sqrt sphere-b/d ] if ;
+    inline
 
 : sphere-n ( ray sphere l -- n )
     pick ray-dir n*v swap sphere-center v- swap ray-orig v+ ;
+    inline
 
 : if-ray-sphere ( hit ray sphere quot -- hit )
     #! quot: hit ray sphere l -- hit
@@ -69,20 +71,20 @@ M: group intersect-scene ( hit ray group -- hit )
         drop
     ] if-ray-sphere ;
 
-: initial-hit T{ hit f { 0.0 0.0 0.0 } 1.0/0.0 } ;
+: initial-hit T{ hit f { 0.0 0.0 0.0 } 1.0/0.0 } ; inline
 
 : initial-intersect ( ray scene -- hit )
-    initial-hit -rot intersect-scene ;
+    initial-hit -rot intersect-scene ; inline
 
 : ray-o ( ray hit -- o )
     over ray-dir over hit-lambda v*n
     swap hit-normal delta v*n v+
-    swap ray-orig v+ ;
+    swap ray-orig v+ ; inline
 
 : sray-intersect ( ray scene hit -- ray )
-    swap >r ray-o light vneg <ray> r> initial-intersect ;
+    swap >r ray-o light vneg <ray> r> initial-intersect ; inline
 
-: ray-g ( hit -- g ) hit-normal light v. ;
+: ray-g ( hit -- g ) hit-normal light v. ; inline
 
 : cast-ray ( ray scene -- g )
     2dup initial-intersect dup hit-lambda 1.0/0.0 = [
@@ -90,9 +92,10 @@ M: group intersect-scene ( hit ray group -- hit )
     ] [
         dup ray-g >r sray-intersect hit-lambda 1.0/0.0 =
         [ r> neg ] [ r> drop 0.0 ] if
-    ] if ;
+    ] if ; inline
 
-: create-center ( c r d -- c2 ) >r 3.0 12.0 sqrt / * r> n*v v+ ;
+: create-center ( c r d -- c2 )
+    >r 3.0 12.0 sqrt / * r> n*v v+ ; inline
 
 DEFER: create ( level c r -- scene )
 
diff --git a/examples/turing.factor b/examples/turing.factor
index 945cab37de..72987a56fb 100644
--- a/examples/turing.factor
+++ b/examples/turing.factor
@@ -38,7 +38,7 @@ SYMBOL: position
 SYMBOL: tape
 
 ! Initial tape
-20 zero-array >vector tape set
+20 0 <array> >vector tape set
 
 : sym ( -- sym )
     #! Symbol at head position.
diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor
index 4446b4029d..c34d189715 100644
--- a/library/bootstrap/boot-stage1.factor
+++ b/library/bootstrap/boot-stage1.factor
@@ -9,6 +9,17 @@ vectors words ;
 
 "/library/bootstrap/primitives.factor" run-resource
 
+: parse-resource* ( path -- )
+    [ parse-resource ] catch [
+        dup error.
+        "Try again? [yn]" print flush readln "yY" subseq?
+        [ drop parse-resource* ] [ rethrow ] if
+    ] when* ;
+
+: if-arch ( arch seq -- )
+    architecture get rot member?
+    [ [ parse-resource* % ] each ] [ drop ] if ;
+
 ! The [ ] make form creates a boot quotation
 [
     \ boot ,
@@ -77,7 +88,7 @@ vectors words ;
         "/library/generic/math-combination.factor"
         "/library/generic/tuple.factor"
         
-        "/library/alien/aliens.factor"
+        "/library/compiler/alien/aliens.factor"
         
         "/library/syntax/prettyprint.factor"
         "/library/syntax/see.factor"
@@ -109,39 +120,37 @@ vectors words ;
         "/library/io/server.factor"
         "/library/tools/jedit.factor"
 
-        "/library/compiler/architecture.factor"
+        "/library/compiler/inference/shuffle.factor"
+        "/library/compiler/inference/dataflow.factor"
+        "/library/compiler/inference/inference.factor"
+        "/library/compiler/inference/branches.factor"
+        "/library/compiler/inference/words.factor"
+        "/library/compiler/inference/stack.factor"
+        "/library/compiler/inference/known-words.factor"
 
-        "/library/inference/shuffle.factor"
-        "/library/inference/dataflow.factor"
-        "/library/inference/inference.factor"
-        "/library/inference/branches.factor"
-        "/library/inference/words.factor"
-        "/library/inference/class-infer.factor"
-        "/library/inference/kill-literals.factor"
-        "/library/inference/optimizer.factor"
-        "/library/inference/inline-methods.factor"
-        "/library/inference/known-words.factor"
-        "/library/inference/stack.factor"
-        "/library/inference/call-optimizers.factor"
-        "/library/inference/print-dataflow.factor"
+        "/library/compiler/optimizer/specializers.factor"
+        "/library/compiler/optimizer/class-infer.factor"
+        "/library/compiler/optimizer/kill-literals.factor"
+        "/library/compiler/optimizer/optimizer.factor"
+        "/library/compiler/optimizer/inline-methods.factor"
+        "/library/compiler/optimizer/call-optimizers.factor"
+        "/library/compiler/optimizer/print-dataflow.factor"
+
+        "/library/compiler/generator/architecture.factor"
+        "/library/compiler/generator/assembler.factor"
+        "/library/compiler/generator/templates.factor"
+        "/library/compiler/generator/xt.factor"
+        "/library/compiler/generator/generator.factor"
 
-        "/library/compiler/assembler.factor"
-        "/library/compiler/vops.factor"
-        "/library/compiler/linearizer.factor"
-        "/library/compiler/xt.factor"
-        "/library/compiler/stack.factor"
-        "/library/compiler/intrinsics.factor"
-        "/library/compiler/generator.factor"
-        "/library/compiler/basic-blocks.factor"
         "/library/compiler/compiler.factor"
 
-        "/library/alien/malloc.factor"
-        "/library/alien/c-types.factor"
-        "/library/alien/structs.factor"
-        "/library/alien/compiler.factor"
-        "/library/alien/alien-invoke.factor"
-        "/library/alien/alien-callback.factor"
-        "/library/alien/syntax.factor"
+        "/library/compiler/alien/malloc.factor"
+        "/library/compiler/alien/c-types.factor"
+        "/library/compiler/alien/structs.factor"
+        "/library/compiler/alien/compiler.factor"
+        "/library/compiler/alien/alien-invoke.factor"
+        "/library/compiler/alien/alien-callback.factor"
+        "/library/compiler/alien/syntax.factor"
         
         "/library/io/buffer.factor"
 
@@ -193,13 +202,6 @@ vectors words ;
         "/library/kernel.facts"
         "/library/threads.facts"
         "/library/words.facts"
-        "/library/alien/alien-callback.facts"
-        "/library/alien/alien-invoke.facts"
-        "/library/alien/aliens.facts"
-        "/library/alien/c-types.facts"
-        "/library/alien/malloc.facts"
-        "/library/alien/structs.facts"
-        "/library/alien/syntax.facts"
         "/library/bootstrap/image.facts"
         "/library/collections/growable.facts"
         "/library/collections/arrays.facts"
@@ -217,6 +219,14 @@ vectors words ;
         "/library/collections/flatten.facts"
         "/library/collections/vectors.facts"
         "/library/collections/virtual-sequences.facts"
+        "/library/compiler/alien/alien-callback.facts"
+        "/library/compiler/alien/alien-invoke.facts"
+        "/library/compiler/alien/aliens.facts"
+        "/library/compiler/alien/c-types.facts"
+        "/library/compiler/alien/malloc.facts"
+        "/library/compiler/alien/structs.facts"
+        "/library/compiler/alien/syntax.facts"
+        "/library/compiler/inference/inference.facts"
         "/library/compiler/compiler.facts"
         "/library/generic/early-generic.facts"
         "/library/generic/generic.facts"
@@ -224,7 +234,6 @@ vectors words ;
         "/library/generic/slots.facts"
         "/library/generic/standard-combination.facts"
         "/library/generic/tuple.facts"
-        "/library/inference/inference.facts"
         "/library/io/binary.facts"
         "/library/io/buffer.facts"
         "/library/io/c-streams.facts"
@@ -277,49 +286,34 @@ vectors words ;
         "/doc/handbook/tools.facts"
         "/doc/handbook/tutorial.facts"
         "/doc/handbook/words.facts"
-    } [ parse-resource % ] each
+    } [ parse-resource* % ] each
     
-    architecture get {
-        {
-            [ dup "x86" = ] [
-                {
-                    "/library/compiler/x86/assembler.factor"
-                    "/library/compiler/x86/architecture.factor"
-                    "/library/compiler/x86/generator.factor"
-                    "/library/compiler/x86/slots.factor"
-                    "/library/compiler/x86/stack.factor"
-                    "/library/compiler/x86/fixnum.factor"
-                    "/library/compiler/x86/alien.factor"
-                }
-            ]
-        } {
-            [ dup "ppc" = ] [
-                {
-                    "/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"
-                }
-            ]
-        } {
-            [ dup "amd64" = ] [
-                {
-                    "/library/compiler/x86/assembler.factor"
-                    "/library/compiler/amd64/architecture.factor"
-                    "/library/compiler/x86/generator.factor"
-                    "/library/compiler/amd64/generator.factor"
-                    "/library/compiler/x86/slots.factor"
-                    "/library/compiler/amd64/slots.factor"
-                    "/library/compiler/x86/stack.factor"
-                    "/library/compiler/x86/fixnum.factor"
-                    "/library/compiler/amd64/alien.factor"
-                }
-            ]
-        }
-    } cond [ parse-resource % ] each drop
+    { "x86" "pentium4" } {
+        "/library/compiler/x86/assembler.factor"
+        "/library/compiler/x86/architecture.factor"
+        "/library/compiler/x86/alien.factor"
+        "/library/compiler/x86/intrinsics.factor"
+    } if-arch
+    
+    { "pentium4" } {
+        "/library/compiler/x86/intrinsics-sse2.factor"
+    } if-arch
+
+    { "ppc" } {
+        "/library/compiler/ppc/assembler.factor"
+        "/library/compiler/ppc/architecture.factor"
+        "/library/compiler/ppc/intrinsics.factor"
+    } if-arch
+
+    { "amd64" } {
+        "/library/compiler/x86/assembler.factor"
+        "/library/compiler/x86/architecture.factor"
+        "/library/compiler/amd64/architecture.factor"
+        "/library/compiler/amd64/alien.factor"
+        "/library/compiler/x86/intrinsics.factor"
+        "/library/compiler/x86/intrinsics-sse2.factor"
+        "/library/compiler/amd64/intrinsics.factor"
+    } if-arch
     
     [
         "/library/bootstrap/boot-stage2.factor" run-resource
@@ -339,3 +333,6 @@ vocabularies get [
 "Building generic words..." print flush
 
 all-words [ generic? ] subset [ make-generic ] each
+
+FORGET: if-arch
+FORGET: parse-resource*
diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor
index 1cd2362d80..7d5d4d7c4b 100644
--- a/library/bootstrap/boot-stage2.factor
+++ b/library/bootstrap/boot-stage2.factor
@@ -1,20 +1,20 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: compiler compiler-backend help io io-internals kernel
+USING: compiler generic help io io-internals kernel
 kernel-internals lists math memory namespaces optimizer parser
 sequences sequences-internals words ;
 
-"Cross-referencing..." print
-xref-words
-xref-articles
+"Cross-referencing..." print flush
+H{ } clone crossref set-global xref-words
+H{ } clone help-graph set-global xref-articles
 
 "compile" get [
     "native-io" get [
         unix? [
             "/library/unix/load.factor" run-resource
         ] when
-
     ] when
+
     windows? [
         "/library/windows/load.factor" run-resource
     ] when
@@ -23,15 +23,14 @@ 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
-
-    "Compiling system..." print flush
-    compile-all
+    [
+        \ + compile
+        \ = compile
+        { "kernel" "sequences" "assembler" } compile-vocabs
+    
+        "Compiling system..." print flush
+        compile-all
+    ] with-class<cache
     
     terpri
     "Unless you're working on the compiler, ignore the errors above." print
@@ -78,5 +77,5 @@ number>string write " ms" print
 "Bootstrapping is complete." print
 "Now, you can run ./f factor.image" print flush
 
-"factor.image" save-image
+"factor.image" resource-path save-image
 0 exit
diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor
index 06387cf3fc..79bfff5635 100644
--- a/library/bootstrap/image.factor
+++ b/library/bootstrap/image.factor
@@ -62,9 +62,6 @@ SYMBOL: architecture
 : word-type      16 ; inline
 : tuple-type     17 ; inline
 
-: immediate ( x tag -- tagged ) swap tag-bits shift bitor ;
-: >header ( id -- tagged ) object-tag immediate ;
-
 ( Image header )
 
 : base 1024 ;
@@ -104,11 +101,7 @@ GENERIC: ' ( obj -- ptr )
 : align-here ( -- )
     here 8 mod 4 = [ 0 emit ] when ;
 
-( Fixnums )
-
-: emit-fixnum ( n -- ) fixnum-tag immediate emit ;
-
-M: fixnum ' ( n -- tagged ) fixnum-tag immediate ;
+: emit-fixnum ( n -- ) fixnum-tag tag-address emit ;
 
 ( Bignums )
 
@@ -136,14 +129,25 @@ M: fixnum ' ( n -- tagged ) fixnum-tag immediate ;
 M: bignum ' ( bignum -- tagged )
     #! This can only emit 0, -1 and 1.
     bignum-tag here-as >r
-    bignum-tag >header emit
+    bignum-tag tag-header emit
     emit-bignum align-here r> ;
 
+( Fixnums )
+
+M: fixnum ' ( n -- tagged )
+    #! When generating a 32-bit image on a 64-bit system,
+    #! some fixnums should be bignums.
+    dup most-negative-fixnum most-positive-fixnum between? [
+        fixnum-tag tag-address
+    ] [
+        >bignum '
+    ] if ;
+
 ( Floats )
 
 M: float ' ( float -- tagged )
     float-tag here-as >r
-    float-tag >header emit
+    float-tag tag-header emit
     align-here
     double>bits emit-64
     r> ;
@@ -177,7 +181,7 @@ M: f ' ( obj -- ptr )
     dup word-vocabulary ' >r
     dup word-name ' >r
     object-tag here-as over objects get set-hash
-    word-type >header emit
+    word-type tag-header emit
     hashcode emit-fixnum
     r> emit
     r> emit
@@ -209,7 +213,7 @@ M: word ' ( word -- pointer ) ;
 M: wrapper ' ( wrapper -- pointer )
     wrapped '
     object-tag here-as >r
-    wrapper-type >header emit
+    wrapper-type tag-header emit
     emit r> ;
 
 ( Conses )
@@ -234,7 +238,7 @@ M: complex ' ( c -- tagged ) >rect complex-tag emit-cons ;
 
 : emit-string ( string -- ptr )
     object-tag here-as swap
-    string-type >header emit
+    string-type tag-header emit
     dup length emit-fixnum
     dup hashcode emit-fixnum
     pack-string emit-chars
@@ -250,7 +254,7 @@ M: string ' ( string -- pointer )
 : emit-array ( list type -- pointer )
     >r [ ' ] map r>
     object-tag here-as >r
-    >header emit
+    tag-header emit
     dup length emit-fixnum
     ( elements -- ) emit-seq
     align-here r> ;
@@ -270,7 +274,7 @@ M: array ' ( array -- pointer )
 M: vector ' ( vector -- pointer )
     dup underlying ' swap length
     object-tag here-as >r
-    vector-type >header emit
+    vector-type tag-header emit
     emit-fixnum ( length )
     emit ( array ptr )
     align-here r> ;
@@ -278,7 +282,7 @@ M: vector ' ( vector -- pointer )
 M: sbuf ' ( sbuf -- pointer )
     dup underlying ' swap length
     object-tag here-as >r
-    sbuf-type >header emit
+    sbuf-type tag-header emit
     emit-fixnum ( length )
     emit ( array ptr )
     align-here r> ;
@@ -288,7 +292,7 @@ M: sbuf ' ( sbuf -- pointer )
 M: hashtable ' ( hashtable -- pointer )
     [ hash-array ' ] keep
     object-tag here-as >r
-    hashtable-type >header emit
+    hashtable-type tag-header emit
     dup hash-count emit-fixnum
     hash-deleted emit-fixnum
     emit ( array ptr )
@@ -337,7 +341,7 @@ M: hashtable ' ( hashtable -- pointer )
     ] if ;
 
 : image-name
-    "boot.image." architecture get append ;
+    "boot.image." architecture get append resource-path ;
 
 : write-image ( image -- )
     "Writing image to " write dup write "..." print flush
@@ -361,4 +365,4 @@ M: hashtable ' ( hashtable -- pointer )
     ] with-scope ;
 
 : make-images ( -- )
-    { "x86" "ppc" "amd64" } [ make-image ] each ;
+    { "x86" "pentium4" "ppc" "amd64" } [ make-image ] each ;
diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index ccad6ca33b..7b2757e9cb 100644
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -11,13 +11,14 @@ vectors words ;
 "Creating primitives and basic runtime structures..." print flush
 
 H{ } clone c-types set
-"/library/alien/primitive-types.factor" parse-resource
+"/library/compiler/alien/primitive-types.factor" parse-resource
 
 ! These symbols need the same hashcode in the target as in the
-! host.
+! host. They must be symbols -- colon definitions are not
+! permitted to be carried over
 {
     vocabularies typemap builtins c-types
-    cell crossref articles terms
+    crossref articles terms
 }
 
 ! Bring up a bare cross-compiling vocabulary.
@@ -59,7 +60,9 @@ call
     { "bits>double" "math"                  }
     { "<complex>" "math-internals"          }
     { "fixnum+" "math-internals"            }
+    { "fixnum+fast" "math-internals"        }
     { "fixnum-" "math-internals"            }
+    { "fixnum-fast" "math-internals"        }
     { "fixnum*" "math-internals"            }
     { "fixnum/i" "math-internals"           }
     { "fixnum/f" "math-internals"           }
@@ -256,35 +259,39 @@ num-types f <array> builtins set
 
 "fixnum?" "math" create t "inline" set-word-prop
 "fixnum" "math" create 0 "fixnum?" "math" create { } define-builtin
-"fixnum" "math" create 0 "math-priority" set-word-prop
 "fixnum" "math" create ">fixnum" "math" lookup unit "coercer" set-word-prop
 
 "bignum?" "math" create t "inline" set-word-prop
 "bignum" "math" create 1 "bignum?" "math" create { } define-builtin
-"bignum" "math" create 1 "math-priority" set-word-prop
 "bignum" "math" create ">bignum" "math" lookup unit "coercer" set-word-prop
 
 "cons?" "lists" create t "inline" set-word-prop
 "cons" "lists" create 2 "cons?" "lists" create
-{ { 0 { "car" "lists" } f } { 1 { "cdr" "lists" } f } } define-builtin
+{
+    { 0 object { "car" "lists" } f }
+    { 1 object { "cdr" "lists" } f }
+} define-builtin
 
 "ratio?" "math" create t "inline" set-word-prop
 "ratio" "math" create 4 "ratio?" "math" create
-{ { 0 { "numerator" "math" } f } { 1 { "denominator" "math" } f } } define-builtin
-"ratio" "math" create 2 "math-priority" set-word-prop
+{
+    { 0 integer { "numerator" "math" } f }
+    { 1 integer { "denominator" "math" } f }
+} define-builtin
 
 "float?" "math" create t "inline" set-word-prop
 "float" "math" create 5 "float?" "math" create { } define-builtin
-"float" "math" create 3 "math-priority" set-word-prop
 "float" "math" create ">float" "math" lookup unit "coercer" set-word-prop
 
 "complex?" "math" create t "inline" set-word-prop
 "complex" "math" create 6 "complex?" "math" create
-{ { 0 { "real" "math" } f } { 1 { "imaginary" "math" } f } } define-builtin
-"complex" "math" create 4 "math-priority" set-word-prop
+{
+    { 0 real { "real" "math" } f }
+    { 1 real { "imaginary" "math" } f }
+} define-builtin
 
 "alien" "alien" create 7 "alien?" "alien" create
-{ { 1 { "underlying-alien" "alien" } f } } define-builtin
+{ { 1 object { "underlying-alien" "alien" } f } } define-builtin
 
 "array?" "arrays" create t "inline" set-word-prop
 "array" "arrays" create 8 "array?" "arrays" create
@@ -296,49 +303,115 @@ num-types f <array> builtins set
 "hashtable?" "hashtables" create t "inline" set-word-prop
 "hashtable" "hashtables" create 10 "hashtable?" "hashtables" create
 {
-    { 1 { "hash-count" "hashtables" } { "set-hash-count" "hashtables-internals" } }
-    { 2 { "hash-deleted" "hashtables" } { "set-hash-deleted" "hashtables-internals" } }
-    { 3 { "hash-array" "hashtables-internals" } { "set-hash-array" "hashtables-internals" } }
+    {
+        1
+        fixnum
+        { "hash-count" "hashtables" }
+        { "set-hash-count" "hashtables-internals" }
+    } {
+        2
+        fixnum
+        { "hash-deleted" "hashtables" }
+        { "set-hash-deleted" "hashtables-internals" }
+    } {
+        3
+        array
+        { "hash-array" "hashtables-internals" }
+        { "set-hash-array" "hashtables-internals" }
+    }
 } define-builtin
 
 "vector?" "vectors" create t "inline" set-word-prop
 "vector" "vectors" create 11 "vector?" "vectors" create
 {
-    { 1 { "length" "sequences" } { "set-fill" "sequences-internals" } }
-    { 2 { "underlying" "sequences-internals" } { "set-underlying" "sequences-internals" } }
+    {
+        1
+        fixnum
+        { "length" "sequences" }
+        { "set-fill" "sequences-internals" }
+    } {
+        2
+        array
+        { "underlying" "sequences-internals" }
+        { "set-underlying" "sequences-internals" }
+    }
 } define-builtin
 
 "string?" "strings" create t "inline" set-word-prop
 "string" "strings" create 12 "string?" "strings" create
 {
-    { 1 { "length" "sequences" } f }
-    { 2 { "string-hashcode" "kernel-internals" } { "set-string-hashcode" "kernel-internals" } }
+    {
+        1
+        fixnum
+        { "length" "sequences" }
+        f
+    } {
+        2
+        fixnum
+        { "string-hashcode" "kernel-internals" }
+        { "set-string-hashcode" "kernel-internals" }
+    }
 } define-builtin
 
 "sbuf?" "strings" create t "inline" set-word-prop 
 "sbuf" "strings" create 13 "sbuf?" "strings" create
 {
-    { 1 { "length" "sequences" } { "set-fill" "sequences-internals" } }
-    { 2 { "underlying" "sequences-internals" } { "set-underlying" "sequences-internals" } }
+    {
+        1
+        fixnum
+        { "length" "sequences" }
+        { "set-fill" "sequences-internals" }
+    }
+    {
+        2
+        string
+        { "underlying" "sequences-internals" }
+        { "set-underlying" "sequences-internals" }
+    }
 } define-builtin
 
 "wrapper?" "kernel" create t "inline" set-word-prop
 "wrapper" "kernel" create 14 "wrapper?" "kernel" create
-{ { 1 { "wrapped" "kernel" } f } } define-builtin
+{ { 1 object { "wrapped" "kernel" } f } } define-builtin
 
 "dll?" "alien" create t "inline" set-word-prop
 "dll" "alien" create 15 "dll?" "alien" create
-{ { 1 { "dll-path" "alien" } f } } define-builtin
+{ { 1 object { "dll-path" "alien" } f } } define-builtin
 
 "word?" "words" create t "inline" set-word-prop
 "word" "words" create 16 "word?" "words" create
 {
-    { 1 { "hashcode" "kernel" } f }
-    { 2 { "word-name" "words" } f }
-    { 3 { "word-vocabulary" "words" } { "set-word-vocabulary" "words" } }
-    { 4 { "word-primitive" "words" } { "set-word-primitive" "words" } }
-    { 5 { "word-def" "words" } { "set-word-def" "words" } }
-    { 6 { "word-props" "words" } { "set-word-props" "words" } }
+    { 1 fixnum { "hashcode" "kernel" } f }
+    {
+        2
+        object
+        { "word-name" "words" }
+        f
+    }
+    {
+        3
+        object
+        { "word-vocabulary" "words" }
+        { "set-word-vocabulary" "words" }
+    }
+    {
+        4
+        object
+        { "word-primitive" "words" }
+        { "set-word-primitive" "words" }
+    }
+    {
+        5
+        object
+        { "word-def" "words" }
+        { "set-word-def" "words" }
+    }
+    {
+        6
+        object
+        { "word-props" "words" }
+        { "set-word-props" "words" }
+    }
 } define-builtin
 
 "tuple?" "kernel" create t "inline" set-word-prop
diff --git a/library/bootstrap/profile-pentium4.factor b/library/bootstrap/profile-pentium4.factor
new file mode 100644
index 0000000000..daa47e4f52
--- /dev/null
+++ b/library/bootstrap/profile-pentium4.factor
@@ -0,0 +1,6 @@
+USING: image kernel-internals namespaces ;
+
+! Do not load this file into a running image, ever.
+
+4 \ cell set
+big-endian off
diff --git a/library/cli.factor b/library/cli.factor
index a2dba89ccf..3dd48f7999 100644
--- a/library/cli.factor
+++ b/library/cli.factor
@@ -12,7 +12,7 @@ parser sequences strings ;
     ] when ;
 
 : set-path ( value seq -- )
-    unswons over [ nest [ set-path ] bind ] [ nip set ] if ;
+    uncons swap over [ nest [ set-path ] bind ] [ nip set ] if ;
 
 : cli-var-param ( name value -- )
     swap ":" split >list set-path ;
diff --git a/library/cocoa/callback.factor b/library/cocoa/callback.factor
new file mode 100644
index 0000000000..0343f3e967
--- /dev/null
+++ b/library/cocoa/callback.factor
@@ -0,0 +1,27 @@
+IN: objc-FactorCallback
+DEFER: FactorCallback
+
+IN: cocoa
+USING: hashtables kernel namespaces objc objc-NSObject ;
+
+SYMBOL: callbacks
+
+H{ } clone callbacks set
+
+"NSObject" "FactorCallback" {
+    { "perform:" "void" { "id" "SEL" "id" }
+        [ nip swap callbacks get hash call ]
+    }
+    
+    { "dealloc" "void" { "id" "SEL" }
+        [
+            drop
+            dup callbacks get remove-hash
+            SUPER-> [dealloc]
+        ]
+    }
+} { } define-objc-class
+
+: <FactorCallback> ( quot -- id | quot: id -- )
+    FactorCallback [alloc] [init]
+    [ callbacks get set-hash ] keep ;
\ No newline at end of file
diff --git a/library/cocoa/load.factor b/library/cocoa/load.factor
index 5896c419a4..b97e0434c7 100644
--- a/library/cocoa/load.factor
+++ b/library/cocoa/load.factor
@@ -7,9 +7,11 @@ USING: compiler io parser sequences words ;
     "/library/cocoa/core-foundation.factor"
     "/library/cocoa/types.factor"
     "/library/cocoa/init-cocoa.factor"
+    "/library/cocoa/callback.factor"
     "/library/cocoa/application-utils.factor"
     "/library/cocoa/window-utils.factor"
     "/library/cocoa/view-utils.factor"
+    "/library/cocoa/menu-bar.factor"
     "/library/cocoa/ui.factor"
 } [
     run-resource
diff --git a/library/cocoa/menu-bar.factor b/library/cocoa/menu-bar.factor
new file mode 100644
index 0000000000..0f18221105
--- /dev/null
+++ b/library/cocoa/menu-bar.factor
@@ -0,0 +1,142 @@
+USING: kernel sequences objc cocoa objc-NSObject objc-NSApplication objc-NSWindow objc-NSMenu objc-NSMenuItem objc-FactorCallback gadgets gadgets-layouts gadgets-listener words compiler strings lists ;
+
+! for words used by menu bar actions (copied from launchpad.factor)
+USING: gadgets gadgets-browser gadgets-listener help inspector io kernel memory namespaces sequences gadgets-launchpad ; 
+
+IN: cocoa
+
+: NSApp NSApplication [sharedApplication] ;
+
+! -------------------------------------------------------------------------
+
+GENERIC: to-target-and-action ( selector-string-or-quotation -- target action )
+
+M: string to-target-and-action sel_registerName f swap ;
+M: f to-target-and-action f ;
+M: list to-target-and-action \ drop swons <FactorCallback> "perform:" sel_registerName ;
+
+
+: <NSMenu> NSMenu [alloc] swap <NSString> [initWithTitle:] [autorelease] ;
+
+: set-main-menu NSApp swap [setMainMenu:] ;
+
+: <NSMenuItem> ( title action equivalent -- item )
+    >r >r >r
+    NSMenuItem [alloc]
+    r> <NSString>
+    r> dup [ sel_registerName ] when
+    r> <NSString>
+    [initWithTitle:action:keyEquivalent:] [autorelease] ;
+
+: make-menu-item-2 ( title selector-string-or-quotation equivalent -- item )
+    swap to-target-and-action swap >r swap <NSMenuItem> dup r> [setTarget:] ;
+
+: submenu-to-item ( menu -- item )
+    dup [title] CF>string f "" <NSMenuItem> dup rot [setSubmenu:] ;
+
+: add-submenu ( menu submenu -- )
+    submenu-to-item [addItem:] ;
+
+: and-modifiers ( item key-equivalent-modifier-mask -- item )
+    dupd [setKeyEquivalentModifierMask:] ;
+: and-alternate ( item -- item )
+    dup 1 [setAlternate:] ;
+: and-option-equivalent-modifier 1572864 and-modifiers ;
+
+! -------------------------------------------------------------------------
+
+DEFER: described-menu
+
+! { } => separator
+
+! { { ... } } or
+! { { ... } modify-quotation } => submenu as described in inner sequence
+
+! { title action equivalent } or
+! { title action equivalent modify-quotation } => item
+
+! this is a mess
+: described-item ( desc -- menu-item )
+    dup length 0 = [
+        drop NSMenuItem [separatorItem]
+    ] [
+        dup first string? [
+            [ first3 make-menu-item-2 ] keep
+            dup length 4 = [ fourth call ] [ drop ] if
+        ] [
+            [ first described-menu ] keep
+            dup length 2 = [ second call ] [ drop ] if
+            submenu-to-item
+        ] if
+    ] if ;
+
+: and-described-item ( menu desc -- same-menu )
+    described-item dupd [addItem:] ;
+
+: described-menu ( { title items* } -- menu )
+    [ first <NSMenu> ] keep
+    1 swap tail [ and-described-item ] each ;
+
+: and-described-submenu ( menu { title items* } -- menu )
+    described-menu dupd add-submenu ;
+
+! -------------------------------------------------------------------------
+
+
+: default-main-menu 
+    {
+        "<top>"
+        { {
+            "Factor"
+            ! About goes here
+            ! Preferences goes here
+            { {
+                "Services"
+            } [ dup NSApp swap [setServicesMenu:] ] }
+            { }
+            { "Hide Factor" "hide:" "h" }
+            { "Hide Others" "hideOtherApplications:" "h" [ and-option-equivalent-modifier ] }
+            { "Show All" "unhideAllApplications:" "" }
+            { }
+            { "Save Image" [ save ] "s" }
+            { }
+            { "Quit" "terminate:" "q" }
+        } [ dup NSApp swap [setAppleMenu:] ] }
+        { {
+            ! Tools is standing in for the File menu
+            "Tools"
+            { "Listener" [ listener-window ] "n" }
+            { "Vocabulary List" [ [ vocabs. ] "Vocabularies" pane-window ] "y" }
+            { "Globals" [ global browser-window ] "u" }
+            { "Memory" [ [ heap-stats. terpri room. ] "Memory" pane-window ] "u" }
+        } }
+        { {
+            "Edit"
+            { "Undo" "undo:" "z" }
+            { "Redo" "redo:" "Z" }
+            { }
+            { "Cut" "cut:" "x" }
+            { "Copy" "copy:" "c" }
+            { "Paste" "paste:" "v" }
+            { "Paste and Match Style" "pasteAsPlainText:" "V" [ and-option-equivalent-modifier ] }
+            { "Delete" "delete:" "" }
+            { "Select All" "selectAll:" "a" }
+            ! { }
+            ! Find, Spelling, and Speech submenus go here
+        } }
+        { {
+            "Window"
+            { "Close" "performClose:" "w" }
+            { "Zoom" "performZoom:" "" }
+            { "Minimize" "performMiniaturize:" "m" }
+            { "Minimize All" "miniaturizeAll:" "m"  [ and-alternate and-option-equivalent-modifier ] }
+            { }
+            { "Bring All to Front" "arrangeInFront:" "" }
+        } [ dup NSApp swap [setWindowsMenu:] ] }
+        { {
+            "Help"
+            { "Factor Documentation" [ handbook-window ] "?" }
+            { "Help Index" [ [ articles. ] "Help index" pane-window ] "" }
+            { "Vocabularies" [ [ vocabs. ] "Vocabularies" pane-window ] "" }
+        } }
+    } described-menu set-main-menu ;
diff --git a/library/cocoa/subclassing.factor b/library/cocoa/subclassing.factor
index c231027dff..d84a3505d9 100644
--- a/library/cocoa/subclassing.factor
+++ b/library/cocoa/subclassing.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: objc
 USING: alien arrays compiler hashtables kernel kernel-internals
-libc math namespaces sequences strings words ;
+libc lists math namespaces sequences strings words ;
 
 : init-method ( method alien -- )
     >r first3 r>
@@ -64,13 +64,19 @@ libc math namespaces sequences strings words ;
     >r 1array r> append
     [ [ alien>objc-types get hash % CHAR: 0 , ] each ] "" make ;
 
-: prepare-method ( { name ret types quot } -- { name type imp  } )
-    [ first3 encode-types ] keep
-    [ 1 swap tail % \ alien-callback , ] [ ] make compile-quot
-    3array ;
+: struct-return ( ret types quot -- ret types quot )
+    pick c-struct? [
+        pick c-size [ memcpy ] curry append
+        >r { "void*" } swap append >r drop "void" r> r>
+    ] when ;
+
+: prepare-method ( ret types quot -- type imp )
+    >r [ encode-types ] 2keep r>
+    [ struct-return 3array % \ alien-callback , ] [ ] make
+    compile-quot ;
 
 : prepare-methods ( methods -- methods )
-    [ prepare-method ] map ;
+    [ first4 prepare-method 3array ] map ;
 
 : define-objc-class ( superclass name imeth cmeth -- )
     pick >r
diff --git a/library/cocoa/types.factor b/library/cocoa/types.factor
index d1dbcedf5c..54ef1635e4 100644
--- a/library/cocoa/types.factor
+++ b/library/cocoa/types.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 IN: cocoa
-USING: alien kernel ;
+USING: alien kernel math ;
 
 BEGIN-STRUCT: NSRect
     FIELD: float x
@@ -20,6 +20,15 @@ TYPEDEF: NSRect CGRect
     [ set-NSRect-y ] keep
     [ set-NSRect-x ] keep ;
 
+: NSRect-x-y ( rect -- origin-x origin-y )
+    [ NSRect-x ] keep NSRect-y ;
+
+: NSRect-x-far-y ( rect -- origin-x far-y )
+    [ NSRect-x-y ] keep NSRect-h + ;
+  
+: <far-y-NSRect> ( x y w h -- rect )
+    rot dupd swap - -rot <NSRect> ;
+
 BEGIN-STRUCT: NSPoint
     FIELD: float x
     FIELD: float y
diff --git a/library/cocoa/ui.factor b/library/cocoa/ui.factor
index fb0ba981e2..e098ed011e 100644
--- a/library/cocoa/ui.factor
+++ b/library/cocoa/ui.factor
@@ -2,12 +2,14 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: objc-FactorView
 DEFER: FactorView
+IN: objc-FactorUIWindowDelegate
+DEFER: FactorUIWindowDelegate
 
-USING: arrays cocoa errors freetype gadgets gadgets-launchpad
-gadgets-layouts gadgets-listener gadgets-panes hashtables kernel
-lists math namespaces objc objc-NSApplication objc-NSEvent
-objc-NSObject objc-NSOpenGLContext objc-NSOpenGLView objc-NSView
-objc-NSWindow sequences threads ;
+USING: alien arrays cocoa errors freetype gadgets
+gadgets-launchpad gadgets-layouts gadgets-listener gadgets-panes
+hashtables kernel lists math namespaces objc objc-NSApplication
+objc-NSEvent objc-NSObject objc-NSOpenGLContext
+objc-NSOpenGLView objc-NSView objc-NSWindow sequences threads ;
 
 ! Cocoa backend for Factor UI
 
@@ -18,6 +20,11 @@ SYMBOL: views
 
 H{ } clone views set-global
 
+: purge-views ( hash -- hash )
+    global [
+        views [ [ drop expired? not ] hash-subset ] change
+    ] bind ;
+
 : view ( handle -- world ) views get hash ;
 
 : mouse-location ( view event -- loc )
@@ -166,13 +173,42 @@ H{ } clone views set-global
     FactorView over rect-dim <GLView>
     [ over set-world-handle dup add-notify register-view ] keep ;
 
+
+: window-root-gadget-pref-dim  [contentView] view pref-dim ;
+
+: frame-rect-for-window-content-rect ( window rect -- rect )
+    swap [styleMask] NSWindow -rot [frameRectForContentRect:styleMask:] ;
+
+: content-rect-for-window-frame-rect ( window rect -- rect )
+    swap [styleMask] NSWindow -rot [contentRectForFrameRect:styleMask:] ;
+
+: window-content-rect ( window -- rect )
+    dup [frame] content-rect-for-window-frame-rect ;
+
+"NSObject" "FactorUIWindowDelegate" {
+    { "windowWillUseStandardFrame:defaultFrame:" "NSRect" { "id" "SEL" "id" "NSRect" }
+        [
+            drop 2nip ( self sel window default-frame -- window )
+            dup window-content-rect NSRect-x-far-y ( window -- window x y )
+            pick window-root-gadget-pref-dim first2 ( window x y -- window x y w h )
+            <far-y-NSRect>
+            frame-rect-for-window-content-rect
+        ]
+    }
+} { } define-objc-class
+
+: install-window-delegate ( window -- )
+    FactorUIWindowDelegate [alloc] [init] [setDelegate:] ;
+
 IN: gadgets
 
 : redraw-world ( handle -- )
     world-handle 1 [setNeedsDisplay:] ;
 
 : open-window* ( world title -- )
-    >r <FactorView> r> <ViewWindow> [contentView] [release] ;
+    >r <FactorView> r> <ViewWindow> 
+    dup install-window-delegate
+    [contentView] [release] ;
 
 : select-gl-context ( handle -- )
     [openGLContext] [makeCurrentContext] ;
@@ -189,7 +225,8 @@ IN: shells
     [
         [
             init-ui
-            launchpad-window
+            purge-views
+            default-main-menu
             listener-window
             finish-launching
             event-loop
diff --git a/library/cocoa/utilities.factor b/library/cocoa/utilities.factor
index f35555a915..966e456f3e 100644
--- a/library/cocoa/utilities.factor
+++ b/library/cocoa/utilities.factor
@@ -119,9 +119,6 @@ H{
 : class-methods ( classname -- seq )
     objc-meta-class objc-methods ;
 
-: make-dip ( quot n -- quot )
-    dup \ >r <array> -rot \ r> <array> append3 ;
-
 : <super> ( receiver class -- super )
     "objc-super" <c-object>
     [ set-objc-super-class ] keep
diff --git a/library/collections/graphs.factor b/library/collections/graphs.factor
index 5b4175a198..fe909eb504 100644
--- a/library/collections/graphs.factor
+++ b/library/collections/graphs.factor
@@ -17,8 +17,7 @@ USING: hashtables kernel namespaces sequences ;
         swap [ swap (add-vertex) ] each-with
     ] if-graph ;
 
-: (remove-vertex) ( vertex graph -- )
-    nest remove-hash ;
+: (remove-vertex) ( vertex graph -- ) nest remove-hash ;
 
 : remove-vertex ( vertex edges graph -- )
     [
diff --git a/library/collections/growable.factor b/library/collections/growable.factor
index 1beed28947..4c9d13ebec 100644
--- a/library/collections/growable.factor
+++ b/library/collections/growable.factor
@@ -13,7 +13,7 @@ GENERIC: set-fill
 : capacity ( seq -- n ) underlying length ; inline
 
 : expand ( len seq -- )
-    [ underlying resize ] keep set-underlying ;
+    [ underlying resize ] keep set-underlying ; inline
 
 : new-size ( n -- n ) 3 * dup 50 < [ drop 50 ] when ;
 
@@ -22,7 +22,7 @@ GENERIC: set-fill
         >r 1+ r>
         2dup capacity > [ over new-size over expand ] when
         2dup set-fill
-    ] when 2drop ;
+    ] when 2drop ; inline
 
 TUPLE: bounds-error index seq ;
 
@@ -35,7 +35,8 @@ TUPLE: bounds-error index seq ;
     2dup bounds-check? [ bounds-error ] unless ; inline
 
 : grow-length ( len seq -- )
-    growable-check 2dup capacity > [ 2dup expand ] when set-fill ;
+    growable-check 2dup capacity > [ 2dup expand ] when set-fill
+    ; inline
 
 : clone-growable ( obj -- obj )
-    (clone) dup underlying clone over set-underlying ;
+    (clone) dup underlying clone over set-underlying ; inline
diff --git a/library/collections/hashtables.factor b/library/collections/hashtables.factor
index 85519d0d30..0d625d6721 100644
--- a/library/collections/hashtables.factor
+++ b/library/collections/hashtables.factor
@@ -9,9 +9,10 @@ TUPLE: tombstone ;
 : ((empty)) T{ tombstone f } ; inline
 : ((tombstone)) T{ tombstone t } ; inline
 
-: hash@ ( key keys -- n ) >r hashcode r> length 2 /i rem 2 * ;
+: hash@ ( key keys -- n )
+    >r hashcode r> length 2 /i rem 2 * ; inline
 
-: probe ( heys i -- hash i ) 2 + over length mod ;
+: probe ( heys i -- hash i ) 2 + over length mod ; inline
 
 : (key@) ( key keys i -- n )
     3dup swap nth-unsafe {
@@ -21,51 +22,58 @@ TUPLE: tombstone ;
         { [ t ] [ probe (key@) ] }
     } cond ;
 
-: key@ ( key hash -- n ) hash-array 2dup hash@ (key@) ;
+: key@ ( key hash -- n )
+    hash-array 2dup hash@ (key@) ; inline
 
 : if-key ( key hash true false -- | true: index key hash -- )
     >r >r [ key@ ] 2keep pick -1 > r> r> if ; inline
 
-: <hash-array> ( n -- array ) 1+ 4 * ((empty)) <array> ;
+: <hash-array> ( n -- array )
+    1+ 4 * ((empty)) <array> ; inline
+
+: init-hash ( hash -- )
+    0 over set-hash-count 0 swap set-hash-deleted ;
 
 : reset-hash ( n hash -- )
-    swap <hash-array> over set-hash-array
-    0 over set-hash-count 0 swap set-hash-deleted ;
+    swap <hash-array> over set-hash-array init-hash ;
 
 : (new-key@) ( key keys i -- n )
     3dup swap nth-unsafe dup tombstone? [
         2drop 2nip
     ] [
         = [ 2nip ] [ probe (new-key@) ] if
-    ] if ;
+    ] if ; inline
 
 : new-key@ ( key hash -- n )
-    hash-array 2dup hash@ (new-key@) ;
+    hash-array 2dup hash@ (new-key@) ; inline
 
 : nth-pair ( n seq -- key value )
-    [ nth-unsafe ] 2keep >r 1+ r> nth-unsafe ;
+    [ nth-unsafe ] 2keep >r 1+ r> nth-unsafe ; inline
 
 : set-nth-pair ( value key n seq -- )
-    [ set-nth-unsafe ] 2keep >r 1+ r> set-nth-unsafe ;
+    [ set-nth-unsafe ] 2keep >r 1+ r> set-nth-unsafe ; inline
 
-: hash-count+ dup hash-count 1+ swap set-hash-count ;
+: hash-count+
+    dup hash-count 1+ swap set-hash-count ; inline
 
-: hash-deleted+ dup hash-deleted 1+ swap set-hash-deleted ;
+: hash-deleted+
+    dup hash-deleted 1+ swap set-hash-deleted ; inline
 
-: hash-deleted- dup hash-deleted 1- swap set-hash-deleted ;
+: hash-deleted-
+    dup hash-deleted 1- swap set-hash-deleted ; inline
 
 : change-size ( hash old -- )
     dup ((tombstone)) eq? [
         drop hash-deleted-
     ] [
         ((empty)) eq? [ hash-count+ ] [ drop ] if
-    ] if ;
+    ] if ; inline
 
 : (set-hash) ( value key hash -- )
     2dup new-key@ swap
     [ hash-array 2dup nth-unsafe ] keep
     ( value key n hash-array old hash )
-    swap change-size set-nth-pair ;
+    swap change-size set-nth-pair ; inline
 
 : (each-pair) ( quot array i -- | quot: k v -- )
     over length over number= [
@@ -124,7 +132,7 @@ IN: hashtables
     dup [ hash ] [ 2drop f ] if ;
 
 : clear-hash ( hash -- )
-    [ hash-array length ] keep reset-hash ;
+    dup init-hash hash-array [ drop ((empty)) ] inject ;
 
 : remove-hash ( key hash -- )
     [
@@ -135,7 +143,8 @@ IN: hashtables
         3drop
     ] if-key ;
 
-: hash-size ( hash -- n ) dup hash-count swap hash-deleted - ;
+: hash-size ( hash -- n )
+    dup hash-count swap hash-deleted - ; inline
 
 : hash-empty? ( hash -- ? ) hash-size zero? ;
 
@@ -146,7 +155,7 @@ IN: hashtables
 
 : ?grow-hash ( hash -- )
     dup hash-count 3 * over hash-array length >
-    [ dup grow-hash ] when drop ;
+    [ dup grow-hash ] when drop ; inline
 
 : set-hash ( value key hash -- )
     [ (set-hash) ] keep ?grow-hash ;
@@ -235,9 +244,6 @@ M: hashtable hashcode ( hash -- n )
 : ?hash* ( key hash/f -- value/f )
     dup [ hash* ] [ 2drop f f ] if ; flushable
 
-: ?set-hash ( value key hash/f -- hash )
-    [ [ set-hash ] keep ] [ associate ] if ;
-
 : hash-stack ( key seq -- value )
     [ dupd hash-member? ] find-last nip ?hash ; flushable
 
diff --git a/library/collections/hashtables.facts b/library/collections/hashtables.facts
index c27f9b1bce..d39ed9c04a 100644
--- a/library/collections/hashtables.facts
+++ b/library/collections/hashtables.facts
@@ -146,11 +146,6 @@ HELP: set-hash "( value key hash -- )"
 { $description "Stores an entry into the hashtable." }
 { $see-also hash remove-hash } ;
 
-HELP: ?set-hash "( value key hash/f -- hash )"
-{ $values { "value" "a value" } { "key" "a key" } { "hash/f" "a hashtable or " { $link f } } }
-{ $description "If the mapping is " { $link f } ", constructs a new hashtable storing the given key/value pair. Otherwise, stores the key/value pair into the hashtable." }
-{ $see-also hash remove-hash } ;
-
 HELP: hash-keys "( hash -- keys )"
 { $values { "hash" "a hashtable" } { "keys" "an array of keys" } }
 { $description "Outputs an array of all keys in the hashtable." }
diff --git a/library/collections/lists.factor b/library/collections/lists.factor
index 79c6aa5ff8..f8017a7a29 100644
--- a/library/collections/lists.factor
+++ b/library/collections/lists.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: lists USING: errors generic kernel math sequences ;
+IN: lists USING: arrays errors generic kernel math sequences ;
 
 M: f car ;
 M: f cdr ;
@@ -16,7 +16,6 @@ PREDICATE: general-list list ( list -- ? )
     [ cdr list? ] [ t ] if* ;
 
 : uncons ( [[ car cdr ]] -- car cdr ) dup car swap cdr ; inline
-: unswons ( [[ car cdr ]] -- cdr car ) dup cdr swap car ; inline
 
 : swons ( cdr car -- [[ car cdr ]] ) swap cons ; inline
 : unit ( a -- [ a ] ) f cons ; inline
@@ -79,6 +78,9 @@ M: cons = ( obj cons -- ? )
 
 : curry ( obj quot -- quot ) >r literalize r> cons ;
 
+: make-dip ( quot n -- quot )
+    dup \ >r <array> -rot \ r> <array> append3 >list ;
+
 : (>list) ( n i seq -- list )
     pick pick <= [
         3drop [ ]
diff --git a/library/collections/namespaces.factor b/library/collections/namespaces.factor
index 856e64d33f..70b0cab312 100644
--- a/library/collections/namespaces.factor
+++ b/library/collections/namespaces.factor
@@ -1,18 +1,23 @@
-! Copyright (C) 2003, 2005 Slava Pestov.
+! Copyright (C) 2003, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+IN: kernel-internals
+USING: vectors ;
+
+: namestack* ( -- ns ) 3 getenv { vector } declare ; inline
+
 IN: namespaces
 USING: arrays hashtables kernel kernel-internals lists math
-sequences strings vectors words ;
+sequences strings words ;
 
-: namestack* ( -- ns ) 3 getenv ; inline
 : namestack ( -- ns ) namestack* clone ; inline
-: set-namestack ( ns -- ) clone 3 setenv ; inline
-: namespace ( -- namespace ) namestack* peek ; inline
-: >n ( namespace -- n:namespace ) namestack* push ; inline
-: n> ( n:namespace -- namespace ) namestack* pop ; inline
-: global ( -- g ) 4 getenv ; inline
+: set-namestack ( ns -- ) >vector 3 setenv ; inline
+: namespace ( -- namespace ) namestack* peek ;
+: >n ( namespace -- n:namespace ) namestack* push ;
+: n> ( n:namespace -- namespace ) namestack* pop ;
+: ndrop ( n:namespace -- ) namestack* pop* ;
+: global ( -- g ) 4 getenv { hashtable } declare ; inline
 : get ( variable -- value ) namestack* hash-stack ; flushable
-: set ( value variable -- ) namespace set-hash ;
+: set ( value variable -- ) namespace set-hash ; inline
 : on ( var -- ) t swap set ; inline
 : off ( var -- ) f swap set ; inline
 : get-global ( var -- value ) global hash ; inline
@@ -30,13 +35,13 @@ sequences strings vectors words ;
 
 : dec ( var -- ) -1 swap +@ ; inline
 
-: bind ( namespace quot -- ) swap >n call n> drop ; inline
+: bind ( namespace quot -- ) swap >n call ndrop ; inline
 
 : counter ( var -- n ) global [ dup inc get ] bind ;
 
 : make-hash ( quot -- hash ) H{ } clone >n call n> ; inline
 
-: with-scope ( quot -- ) make-hash drop ; inline
+: with-scope ( quot -- ) H{ } clone >n call ndrop ; inline
 
 ! Building sequences
 SYMBOL: building
diff --git a/library/collections/namespaces.facts b/library/collections/namespaces.facts
index cf476d92d9..886f82ae2b 100644
--- a/library/collections/namespaces.facts
+++ b/library/collections/namespaces.facts
@@ -1,5 +1,5 @@
 IN: namespaces
-USING: help ;
+USING: help kernel-internals ;
 
 HELP: get "( variable -- value )"
 { $values { "variable" "a variable, by convention a symbol" } { "value" "the value, or " { $link f } } }
diff --git a/library/collections/sequence-combinators.facts b/library/collections/sequence-combinators.facts
index fa38347f6c..0b21654f74 100644
--- a/library/collections/sequence-combinators.facts
+++ b/library/collections/sequence-combinators.facts
@@ -3,7 +3,7 @@ USING: help math sequences-internals ;
 
 HELP: collect "( n quot -- array )"
 { $values { "n" "a non-negative integer" } { "quot" "a quotation with stack effect " { $snippet "( n -- value )" } } { "array" "an array with " { $snippet "n" } " elements" } }
-{ $description "A primitive mapping operation that applies a quotation to all integers from 0 up to but not including " { $snippet "n" } ", and collects the results in a new array. Client code should use " { $snippet map } " instead." } ;
+{ $description "A primitive mapping operation that applies a quotation to all integers from 0 up to but not including " { $snippet "n" } ", and collects the results in a new array. Client code should use " { $link map } " instead." } ;
 
 HELP: each "( seq quot -- )"
 { $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- )" } } }
diff --git a/library/collections/sequence-eq.factor b/library/collections/sequence-eq.factor
index 563bc0d93b..ac28e1644c 100644
--- a/library/collections/sequence-eq.factor
+++ b/library/collections/sequence-eq.factor
@@ -13,7 +13,7 @@ UNION: sequence array string sbuf vector ;
         dup length [ >r 2dup r> 2nth-unsafe = ] all? 2nip
     ] [
         2drop f
-    ] if ; inline
+    ] if ;
 
 M: sequence = ( obj seq -- ? )
     2dup eq? [
diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor
index f37f61c5c0..e2450e434e 100644
--- a/library/collections/sequences-epilogue.factor
+++ b/library/collections/sequences-epilogue.factor
@@ -1,17 +1,17 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: sequences
-USING: errors generic kernel kernel-internals math
+USING: arrays errors generic kernel kernel-internals math
 sequences-internals strings vectors words ;
 
 : first2 ( { x y } -- x y )
-    1 swap bounds-check nip first2-unsafe ; inline
+    1 swap bounds-check nip first2-unsafe ; flushable
 
 : first3 ( { x y z } -- x y z )
-    2 swap bounds-check nip first3-unsafe ; inline
+    2 swap bounds-check nip first3-unsafe ; flushable
 
 : first4 ( { x y z w } -- x y z w )
-    3 swap bounds-check nip first4-unsafe ; inline
+    3 swap bounds-check nip first4-unsafe ; flushable
 
 M: object like drop ;
 
@@ -82,6 +82,11 @@ M: object like drop ;
 : add ( seq elt -- seq )
     swap [ push ] immutable ; flushable
 
+: add* ( seq elt -- seq )
+    over >r
+    over thaw [ push ] keep [ swap nappend ] keep
+    r> like ; flushable
+
 : diff ( seq1 seq2 -- seq2-seq1 )
     [ swap member? not ] subset-with ; flushable
 
@@ -93,10 +98,10 @@ M: object like drop ;
 : pop* ( sequence -- )
     [ length 1- ] keep
     [ 0 -rot set-nth ] 2keep
-    set-length ; inline
+    set-length ;
 
 : pop ( sequence -- element )
-    dup peek swap pop* ; inline
+    dup peek swap pop* ;
 
 M: object reverse-slice ( seq -- seq ) <reversed> ;
 
diff --git a/library/collections/sequences-epilogue.facts b/library/collections/sequences-epilogue.facts
index 7d9e56ee75..1057e37c2e 100644
--- a/library/collections/sequences-epilogue.facts
+++ b/library/collections/sequences-epilogue.facts
@@ -40,8 +40,8 @@ HELP: memq? "( obj seq -- ? )"
 }
 { $see-also index index* member? } ;
 
-HELP: remove "( elt seq -- ? )"
-{ $values { "elt" "an object" } { "seq" "a sequence" } }
+HELP: remove "( elt seq -- newseq )"
+{ $values { "elt" "an object" } { "seq" "a sequence" } { "newseq" "a new sequence" } }
 { $description "Outputs a new sequence containing all elements of the input sequence except those equal to the given element." } ;
 
 HELP: subst "( newseq oldseq seq -- )"
diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor
index 40d2636b95..fbcd04dfbb 100644
--- a/library/collections/sequences.factor
+++ b/library/collections/sequences.factor
@@ -12,7 +12,7 @@ GENERIC: like ( seq seq -- seq ) flushable
 GENERIC: reverse ( seq -- seq ) flushable
 GENERIC: reverse-slice ( seq -- seq ) flushable
 
-: empty? ( seq -- ? ) length zero? ;
+: empty? ( seq -- ? ) length zero? ; inline
 
 : first 0 swap nth ; inline
 : second 1 swap nth ; inline
@@ -20,13 +20,13 @@ GENERIC: reverse-slice ( seq -- seq ) flushable
 : fourth 3 swap nth ; inline
 
 : push ( element sequence -- )
-    dup length swap set-nth ; inline
+    dup length swap set-nth ;
 
 : ?push ( elt seq/f -- seq )
     [ 1 <vector> ] unless* [ push ] keep ;
 
 : bounds-check? ( n seq -- ? )
-    over 0 >= [ length < ] [ 2drop f ] if ;
+    over 0 >= [ length < ] [ 2drop f ] if ; inline
 
 : ?nth ( n seq/f -- elt/f )
     2dup bounds-check? [ nth ] [ 2drop f ] if ;
diff --git a/library/collections/slicing.factor b/library/collections/slicing.factor
index 7099e80d7e..3784cab3c6 100644
--- a/library/collections/slicing.factor
+++ b/library/collections/slicing.factor
@@ -104,8 +104,7 @@ strings vectors ;
     tuck swap tail-slice >r swap tail-slice r> ;
 
 : unpair ( seq -- firsts seconds )
-    2 swap group flip
-    dup empty? [ drop { } { } ] [ first2 ] if ;
+    flip dup empty? [ drop { } { } ] [ first2 ] if ;
 
 : concat ( seq -- seq )
     dup empty? [ [ [ % ] each ] over first make ] unless ;
diff --git a/library/alien/alien-callback.factor b/library/compiler/alien/alien-callback.factor
similarity index 67%
rename from library/alien/alien-callback.factor
rename to library/compiler/alien/alien-callback.factor
index bf80103403..375b982020 100644
--- a/library/alien/alien-callback.factor
+++ b/library/compiler/alien/alien-callback.factor
@@ -1,9 +1,8 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: alien
-USING: compiler-backend compiler-frontend errors generic
-hashtables inference inspector kernel lists namespaces sequences
-strings words ;
+USING: compiler errors generic hashtables inference inspector
+kernel lists namespaces sequences strings words ;
 
 TUPLE: alien-callback return parameters quot xt ;
 C: alien-callback make-node ;
@@ -33,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 ,
+        dup alien-callback-quot \ init-error-handler add*
+        %alien-callback
         unbox-return
-        %return ,
-    ] make-linear ;
+        %return
+    ] generate-block ;
 
-M: alien-callback linearize* ( node -- )
-    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-callback.facts b/library/compiler/alien/alien-callback.facts
similarity index 100%
rename from library/alien/alien-callback.facts
rename to library/compiler/alien/alien-callback.facts
diff --git a/library/alien/alien-invoke.factor b/library/compiler/alien/alien-invoke.factor
similarity index 76%
rename from library/alien/alien-invoke.factor
rename to library/compiler/alien/alien-invoke.factor
index 64500b44fa..096826f9ba 100644
--- a/library/alien/alien-invoke.factor
+++ b/library/compiler/alien/alien-invoke.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: alien
-USING: arrays assembler compiler compiler-backend
-compiler-frontend errors generic hashtables inference inspector
+USING: arrays assembler compiler compiler
+errors generic hashtables inference inspector
 io kernel kernel-internals lists math namespaces parser
 prettyprint sequences strings words ;
 
@@ -39,48 +39,50 @@ 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 -- )
-    compile-gc
+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*
     alien-invoke-parameters stack-space ;
 
 : parse-arglist ( return seq -- types stack-effect )
-    unpair rot dup "void" = [ drop { } ] [ 1array ] if 2array
+    2 swap group unpair
+    rot dup "void" = [ drop { } ] [ 1array ] if 2array
     effect>string ;
 
 : (define-c-word) ( type lib func types stack-effect -- )
     >r over create-in >r 
-    [ alien-invoke ] cons cons cons cons r> swap define-compound
-    word r> "stack-effect" set-word-prop ;
+    [ alien-invoke ] curry curry curry curry
+    r> swap define-compound word r>
+    "stack-effect" set-word-prop ;
 
 : define-c-word ( return library function parameters -- )
     [ "()" subseq? not ] subset >r pick r> parse-arglist
diff --git a/library/alien/alien-invoke.facts b/library/compiler/alien/alien-invoke.facts
similarity index 100%
rename from library/alien/alien-invoke.facts
rename to library/compiler/alien/alien-invoke.facts
diff --git a/library/alien/aliens.factor b/library/compiler/alien/aliens.factor
similarity index 100%
rename from library/alien/aliens.factor
rename to library/compiler/alien/aliens.factor
diff --git a/library/alien/aliens.facts b/library/compiler/alien/aliens.facts
similarity index 100%
rename from library/alien/aliens.facts
rename to library/compiler/alien/aliens.facts
diff --git a/library/alien/c-types.factor b/library/compiler/alien/c-types.factor
similarity index 89%
rename from library/alien/c-types.factor
rename to library/compiler/alien/c-types.factor
index 4224bb431f..d720775670 100644
--- a/library/alien/c-types.factor
+++ b/library/compiler/alien/c-types.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: alien
-USING: arrays compiler compiler-backend errors generic
+USING: arrays compiler errors generic
 hashtables kernel kernel-internals libc lists math namespaces
 parser sequences strings words ;
 
@@ -53,10 +53,10 @@ SYMBOL: c-types
 
 : define-deref ( name vocab -- )
     >r dup "*" swap append r> create
-    swap c-getter 0 swons define-compound ;
+    swap c-getter 0 add* define-compound ;
 
 : (define-nth) ( word type quot -- )
-    >r c-size [ rot * ] curry r> append define-compound ;
+    >r c-size [ rot * ] swap add* r> append define-compound ;
 
 : define-nth ( name vocab -- )
     >r dup "-nth" append r> create
@@ -67,8 +67,8 @@ SYMBOL: c-types
     swap dup c-setter (define-nth) ;
 
 : define-out ( name vocab -- )
-    over [ <c-object> tuck 0 ] over c-setter append
-    >r >r constructor-word r> r> cons define-compound ;
+    over [ <c-object> tuck 0 ] over c-setter append swap
+    >r >r constructor-word r> r> add* define-compound ;
 
 : init-c-type ( name vocab -- )
     over define-pointer define-nth ;
diff --git a/library/alien/c-types.facts b/library/compiler/alien/c-types.facts
similarity index 100%
rename from library/alien/c-types.facts
rename to library/compiler/alien/c-types.facts
diff --git a/library/alien/compiler.factor b/library/compiler/alien/compiler.factor
similarity index 74%
rename from library/alien/compiler.factor
rename to library/compiler/alien/compiler.factor
index a9a7ce7672..76898257fe 100644
--- a/library/alien/compiler.factor
+++ b/library/compiler/alien/compiler.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: alien
-USING: arrays compiler-backend generic hashtables kernel
+USING: arrays compiler generic hashtables kernel
 kernel-internals math namespaces sequences words ;
 
 : parameter-size c-size cell align ;
@@ -27,7 +27,8 @@ kernel-internals math namespaces sequences words ;
     #! n is a stack location, and the value of the class
     #! variable is a register number.
     c-type "reg-class" swap hash dup reg-class-full?
-    [ spill-param ] [ fastcall-param ] if ;
+    [ spill-param ] [ fastcall-param ] if
+    [ fastcall-regs nth ] keep ;
 
 : flatten-value-types ( params -- params )
     #! Convert value type structs to consecutive void*s.
@@ -36,22 +37,25 @@ 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
+: reset-freg-counts ( -- )
+    0 { int-regs float-regs stack-params } [ set ] each-with ;
 
-: move-parameters ( params vop -- seq )
-    #! Moves values from C stack to registers (if vop is
-    #! %stack>freg) and registers to C stack (if vop is
+: move-parameters ( params word -- )
+    #! Moves values from C stack to registers (if word is
+    #! %stack>freg) and registers to C stack (if word 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
+        reset-freg-counts
+        [ pick >r alloc-parameter r> execute ] each-parameter
+        drop
     ] with-scope ; inline
 
 : box-parameter ( stack# type -- node )
diff --git a/library/alien/malloc.factor b/library/compiler/alien/malloc.factor
similarity index 100%
rename from library/alien/malloc.factor
rename to library/compiler/alien/malloc.factor
diff --git a/library/alien/malloc.facts b/library/compiler/alien/malloc.facts
similarity index 100%
rename from library/alien/malloc.facts
rename to library/compiler/alien/malloc.facts
diff --git a/library/alien/primitive-types.factor b/library/compiler/alien/primitive-types.factor
similarity index 98%
rename from library/alien/primitive-types.factor
rename to library/compiler/alien/primitive-types.factor
index dffe561967..f2415f36d7 100644
--- a/library/alien/primitive-types.factor
+++ b/library/compiler/alien/primitive-types.factor
@@ -1,5 +1,4 @@
-USING: alien compiler-backend kernel kernel-internals
-math namespaces ;
+USING: alien compiler kernel kernel-internals math namespaces ;
 
 [
     [ alien-unsigned-cell <alien> ] "getter" set
diff --git a/library/alien/structs.factor b/library/compiler/alien/structs.factor
similarity index 88%
rename from library/alien/structs.factor
rename to library/compiler/alien/structs.factor
index 65a86504e6..b86ca7973d 100644
--- a/library/alien/structs.factor
+++ b/library/compiler/alien/structs.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: alien
-USING: assembler compiler compiler-backend errors generic
+USING: assembler compiler errors generic
 hashtables kernel kernel-internals lists math namespaces parser
 sequences strings words ;
 
@@ -10,12 +10,12 @@ sequences strings words ;
 : define-getter ( offset type name -- )
     #! Define a word with stack effect ( alien -- obj ) in the
     #! current 'in' vocabulary.
-    create-in >r c-getter cons r> swap define-compound ;
+    create-in >r c-getter swap add* r> swap define-compound ;
 
 : define-setter ( offset type name -- )
     #! Define a word with stack effect ( obj alien -- ) in the
     #! current 'in' vocabulary.
-    "set-" swap append create-in >r c-setter cons r>
+    "set-" swap append create-in >r c-setter swap add* r>
     swap define-compound ;
 
 : define-field ( offset type name -- offset )
diff --git a/library/alien/structs.facts b/library/compiler/alien/structs.facts
similarity index 100%
rename from library/alien/structs.facts
rename to library/compiler/alien/structs.facts
diff --git a/library/alien/syntax.factor b/library/compiler/alien/syntax.factor
similarity index 100%
rename from library/alien/syntax.factor
rename to library/compiler/alien/syntax.factor
diff --git a/library/alien/syntax.facts b/library/compiler/alien/syntax.facts
similarity index 100%
rename from library/alien/syntax.facts
rename to library/compiler/alien/syntax.facts
diff --git a/library/compiler/amd64/alien.factor b/library/compiler/amd64/alien.factor
index 657be36d3b..6b26137a75 100644
--- a/library/compiler/amd64/alien.factor
+++ b/library/compiler/amd64/alien.factor
@@ -1,92 +1,80 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: compiler-backend
+IN: compiler
 USING: alien arrays assembler kernel kernel-internals math
 sequences ;
 
-GENERIC: freg>stack ( stack reg reg-class -- )
-
-GENERIC: stack>freg ( stack reg reg-class -- )
-
 : stack@ RSP swap [+] ;
 
-M: int-regs freg>stack drop >r stack@ r> MOV ;
+M: int-regs %freg>stack drop >r stack@ r> MOV ;
 
-M: int-regs stack>freg drop swap stack@ MOV ;
+M: int-regs %stack>freg drop swap stack@ MOV ;
 
-: MOVSS/LPD float-regs-size 4 = [ MOVSS ] [ MOVLPD ] if ;
+: MOVSS/D float-regs-size 4 = [ MOVSS ] [ MOVSD ] if ;
 
-M: float-regs freg>stack >r >r stack@ r> r> MOVSS/LPD ;
+M: float-regs %freg>stack >r >r stack@ r> r> MOVSS/D ;
 
-M: float-regs stack>freg >r swap stack@ r> MOVSS/LPD ;
+M: float-regs %stack>freg >r swap stack@ r> MOVSS/D ;
 
-M: stack-params stack>freg
+M: stack-params %stack>freg
     drop >r R11 swap stack@ MOV r> stack@ R11 MOV ;
 
-M: stack-params freg>stack
-    >r stack-increment + cell + swap r> stack>freg ;
+M: stack-params %freg>stack
+    >r stack-increment + cell + swap r> %stack>freg ;
 
-M: %unbox-struct generate-node ( vop -- )
-    drop
+: struct-ptr/size ( n reg-class size func -- )
+    rot drop
     ! Load destination address
-    RDI RSP MOV
-    RDI 0 input ADD
+    >r RDI RSP MOV
+    RDI rot ADD
     ! Load struct size
-    RSI 2 input MOV
+    RSI swap MOV
     ! Copy the struct to the stack
-    "unbox_value_struct" f compile-c-call ;
+    r> f compile-c-call ;
 
-M: %unbox generate-node ( vop -- )
-    drop
+: %unbox-struct ( n reg-class size -- )
+    "unbox_value_struct" struct-ptr/size ;
+
+: %unbox ( n reg-class func -- )
     ! Call the unboxer
-    2 input f compile-c-call
+    f compile-c-call
     ! Store the return value on the C stack
-    0 input 1 input [ return-reg ] keep freg>stack ;
+    [ return-reg ] keep %freg>stack ;
 
-: (%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 ;
-
-: reset-sse RAX RAX XOR ;
-
-M: %alien-invoke generate-node
-    reset-sse
-    drop 0 input 1 input load-library compile-c-call ;
+: %box-struct ( n reg-class size -- )
+    "box_value_struct" struct-ptr/size ;
 
 : load-return-value ( reg-class -- )
     dup fastcall-regs first swap return-reg
     2dup eq? [ 2drop ] [ MOV ] if ;
 
-M: %box generate-node ( vop -- )
-    drop
-    0 input [
-        1 input [ fastcall-regs first ] keep stack>freg
+: %box ( n reg-class func -- )
+    rot [
+        rot [ fastcall-regs first ] keep %stack>freg
     ] [
-        1 input load-return-value
+        swap load-return-value
     ] if*
-    2 input f compile-c-call ;
+    f compile-c-call ;
 
-M: %alien-callback generate-node ( vop -- )
-    drop
-    RDI 0 input load-indirect
-    "run_callback" f compile-c-call ;
+: reset-sse RAX RAX XOR ;
 
-: save-return 0 swap [ return-reg ] keep freg>stack ;
-: load-return 0 swap [ return-reg ] keep stack>freg ;
+: %alien-invoke ( symbol dll -- )
+    reset-sse compile-c-call ;
 
-M: %callback-value generate-node ( vop -- )
-    drop
+: %alien-callback ( quot -- )
+    RDI 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 ;
+
+: %callback-value ( reg-class func -- )
     ! Call the unboxer
-    1 input f compile-c-call
+    f compile-c-call
     ! Save return register
-    0 input save-return
+    dup save-return
     ! Restore data/callstacks
     "unnest_stacks" f compile-c-call
     ! Restore return register
-    0 input load-return ;
+    load-return ;
+
+: %cleanup ( n -- ) drop ;
diff --git a/library/compiler/amd64/architecture.factor b/library/compiler/amd64/architecture.factor
index 2c11013128..632a6c3d83 100644
--- a/library/compiler/amd64/architecture.factor
+++ b/library/compiler/amd64/architecture.factor
@@ -1,59 +1,60 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: compiler-backend
-USING: alien arrays assembler compiler compiler-frontend kernel
-kernel-internals math namespaces sequences ;
+IN: compiler
+USING: alien arrays assembler generic kernel kernel-internals
+math namespaces sequences ;
 
 ! AMD64 register assignments
-! RAX RCX RDX RSI RDI R8 R9 R10 R11 vregs
+! RAX RCX RDX RSI RDI R8 R9 R10 integer vregs
+! XMM0 - XMM7 float vregs
 ! R13 cards_offset
 ! 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
-
-: vregs { RAX RCX RDX RSI RDI R8 R9 R10 R11 } ; inline
+: alloc-tmp-reg RBX ; inline
 
 M: int-regs return-reg drop RAX ;
-
+M: int-regs vregs drop { RAX RCX RDX RSI RDI R8 R9 R10 R11 } ;
 M: int-regs fastcall-regs drop { RDI RSI RDX RCX R8 R9 } ;
 
+M: float-regs return-reg drop XMM0 ;
+M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
+M: float-regs fastcall-regs vregs ;
+
+: address-operand ( address -- operand )
+    #! On AMD64, we have to load 64-bit addresses into a
+    #! scratch register first. The usage of R11 here is a hack.
+    #! This word can only be called right before a subroutine
+    #! call, where all vregs have been flushed anyway.
+    R11 [ swap MOV ] keep ; inline
+
 : compile-c-call ( symbol dll -- )
-    2dup dlsym R10 swap MOV
-    rel-absolute-cell rel-dlsym R10 CALL ;
+    2dup dlsym address-operand
+    >r rel-absolute-cell rel-dlsym r> CALL ;
 
 : compile-c-call* ( symbol dll args -- )
     T{ int-regs } fastcall-regs
     swap [ MOV ] 2each compile-c-call ;
 
-M: float-regs return-reg drop XMM0 ;
-
-M: float-regs fastcall-regs
-    drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
-
-: address-operand ( address -- operand )
-    #! On AMD64, we have to load 64-bit addresses into a
-    #! scratch register first. The usage of R11 here is a hack.
-    #! We cannot write '0 scratch' since scratch registers are
-    #! not permitted inside basic-block VOPs.
-    R11 [ swap MOV ] keep ; inline
-
 : fixnum>slot@ drop ; inline
 
 : prepare-division CQO ; inline
 
-: load-indirect ( dest literal -- )
+: load-indirect ( vreg literal -- )
+    swap add-literal from 3 - [] MOV ;
+
+M: object load-literal ( literal vreg -- )
     #! We use RIP-relative addressing. The '3' is a hardcoded
     #! instruction length.
-    add-literal from 3 - [] MOV ; inline
+    v>operand load-indirect ;
 
 : stack-increment \ stack-reserve get 16 align 8 + ;
 
-: compile-epilogue ( -- )
-    RSP stack-increment ADD ; inline
+: %prologue ( n -- )
+    \ stack-reserve set RSP stack-increment SUB ;
+
+: %epilogue ( -- )
+    RSP stack-increment ADD ;
diff --git a/library/compiler/amd64/generator.factor b/library/compiler/amd64/generator.factor
deleted file mode 100644
index 986a0c3819..0000000000
--- a/library/compiler/amd64/generator.factor
+++ /dev/null
@@ -1,9 +0,0 @@
-! Copyright (C) 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: compiler-backend
-USING: assembler compiler-frontend kernel math namespaces ;
-
-M: %prologue generate-node ( vop -- )
-    drop
-    0 input \ stack-reserve set
-    RSP stack-increment SUB ;
diff --git a/library/compiler/amd64/intrinsics.factor b/library/compiler/amd64/intrinsics.factor
new file mode 100644
index 0000000000..b95d82f645
--- /dev/null
+++ b/library/compiler/amd64/intrinsics.factor
@@ -0,0 +1,9 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assembler ;
+IN: compiler
+
+: generate-write-barrier ( -- )
+    #! Mark the card pointed to by vreg.
+    "obj" operand card-bits SHR
+    "obj" operand R13 [+] card-mark OR ;
diff --git a/library/compiler/amd64/slots.factor b/library/compiler/amd64/slots.factor
deleted file mode 100644
index 66697924f5..0000000000
--- a/library/compiler/amd64/slots.factor
+++ /dev/null
@@ -1,11 +0,0 @@
-! Copyright (C) 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: compiler-backend
-USING: alien arrays assembler compiler inference kernel
-kernel-internals lists math memory namespaces sequences words ;
-
-M: %write-barrier generate-node ( vop -- )
-    #! Mark the card pointed to by vreg.
-    drop
-    0 input-operand card-bits SHR
-    0 input-operand R13 [+] card-mark OR ;
diff --git a/library/compiler/architecture.factor b/library/compiler/architecture.factor
deleted file mode 100644
index 1acecc89b5..0000000000
--- a/library/compiler/architecture.factor
+++ /dev/null
@@ -1,10 +0,0 @@
-IN: compiler-backend
-
-! A few things the front-end needs to know about the back-end.
-
-DEFER: fixnum-imm? ( -- ? )
-#! Can fixnum operations take immediate operands?
-
-DEFER: vregs ( -- regs )
-
-DEFER: compile-c-call ( library function -- )
diff --git a/library/compiler/basic-blocks.factor b/library/compiler/basic-blocks.factor
deleted file mode 100644
index 5abd56c0ee..0000000000
--- a/library/compiler/basic-blocks.factor
+++ /dev/null
@@ -1,177 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-backend
-USING: arrays hashtables kernel lists math namespaces sequences ;
-
-! Optimizations performed here:
-! - combining %inc-d/%inc-r within a single basic block
-! - if a literal is loaded into a vreg but the vreg is
-!   overwritten before being read, the literal load is deleted
-! - if a %replace is writing a vreg to a stack location already
-!   holding that vreg, or a stack location that is not read
-!   before being popped, the %replace is deleted
-! - if a %peek is reading a stack location into a vreg that
-!   already holds that vreg, or if the vreg is overwritten
-!   before being read, the %peek is deleted
-! - removing dead loads of stack locations into vregs
-! - removing dead stores of vregs into stack locations
-
-: vop-in ( vop n -- input ) swap vop-inputs nth ;
-: set-vop-in ( input vop n -- ) swap vop-inputs set-nth ;
-: vop-out ( vop n -- input ) swap vop-outputs nth ;
-
-: (split-blocks) ( n linear -- )
-    2dup length = [
-        dup like , drop
-    ] [
-        2dup nth basic-block? [
-            >r 1+ r> (split-blocks)
-        ] [
-            (cut) >r , 1 r> (cut) >r , 0 r> (split-blocks)
-        ] if
-    ] if ;
-
-: split-blocks ( linear -- blocks )
-    [ 0 swap (split-blocks) ] { } make ;
-
-SYMBOL: d-height
-SYMBOL: r-height
-
-! combining %inc-d/%inc-r
-GENERIC: simplify-stack* ( vop -- )
-
-M: tuple simplify-stack* ( vop -- ) drop ;
-
-: accum-height ( vop var -- )
-    >r dup 0 vop-in r> [ + ] change 0 swap 0 set-vop-in ;
-
-M: %inc-d simplify-stack* ( vop -- ) d-height accum-height ;
-
-M: %inc-r simplify-stack* ( vop -- ) r-height accum-height ;
-
-GENERIC: update-loc ( loc -- )
-
-M: ds-loc update-loc
-    dup ds-loc-n d-height get - swap set-ds-loc-n ;
-
-M: cs-loc update-loc
-    dup cs-loc-n r-height get - swap set-cs-loc-n ;
-
-M: %peek simplify-stack* ( vop -- ) 0 vop-in update-loc ;
-
-M: %replace simplify-stack* ( vop -- ) 0 vop-out update-loc ;
-
-: simplify-stack ( block -- )
-    #! Combine all %inc-d/%inc-r into two final ones.
-    #! Destructively modifies the VOPs in the block.
-    [ simplify-stack* ] each ;
-
-: each-tail ( seq quot -- | quot: tail -- )
-    >r dup length [ swap tail-slice ] map-with r> each ; inline
-
-! removing dead loads/stores
-: preserves-location? ( exitcc location vop -- ? )
-    #! If the VOP writes the register, call the loop exit
-    #! continuation with 'f'.
-    {
-        { [ 2dup vop-inputs member? ] [ 3drop t ] }
-        { [ 2dup vop-outputs member? ] [ 2drop f swap continue-with ] }
-        { [ t ] [ 3drop f ] }
-    } cond ;
-
-GENERIC: live@end? ( location -- ? )
-
-M: tuple live@end? drop t ;
-
-M: ds-loc live@end? ds-loc-n d-height get + 0 >= ;
-
-M: cs-loc live@end? cs-loc-n r-height get + 0 >= ;
-
-: location-live? ( location tail -- ? )
-    #! A location is not live if and only if it is overwritten
-    #! before the end of the basic block.
-    [
-        -rot [ >r 2dup r> preserves-location? ] contains?
-        [ dup live@end? ] unless*
-    ] callcc1 2nip ;
-
-! Used for elimination of dead loads from the stack:
-! we keep a map of vregs to ds-loc/cs-loc/f.
-SYMBOL: vreg-contents
-
-GENERIC: trim-dead* ( tail vop -- )
-
-: forget-vregs ( vop -- )
-    vop-outputs [ vreg-contents get remove-hash ] each ;
-
-M: tuple trim-dead* ( tail vop -- ) dup forget-vregs , drop ;
-
-: ?, [ , ] [ drop ] if ;
-
-: simplify-inc ( vop -- ) dup 0 vop-in zero? not ?, ;
-
-M: %inc-d trim-dead* ( tail vop -- ) simplify-inc drop ;
-
-M: %inc-r trim-dead* ( tail vop -- ) simplify-inc drop ;
-
-: live-load? ( tail vop -- ? )
-    #! If the VOP's output location is overwritten before being
-    #! read again, kill the VOP.
-    0 vop-out swap location-live? ;
-
-: remember-peek ( vop -- )
-    dup 0 vop-in swap 0 vop-out vreg-contents get set-hash ;
-
-: redundant-peek? ( vop -- ? )
-    dup 0 vop-in swap 0 vop-out vreg-contents get hash = ;
-
-M: %peek trim-dead* ( tail vop -- )
-    dup redundant-peek? >r tuck live-load? not r> or
-    [ dup remember-peek dup , ] unless drop ;
-
-: redundant-replace? ( vop -- ? )
-    dup 0 vop-out swap 0 vop-in vreg-contents get hash = ;
-
-: forget-stack-loc ( loc -- )
-    #! Forget that any vregs hold this stack location.
-    vreg-contents [ [ nip swap = not ] hash-subset-with ] change ;
-
-: remember-replace ( vop -- )
-    #! If a vreg claims to hold the stack location we are
-    #! writing to, we must forget this fact, since that stack
-    #! location no longer holds this value!
-    dup 0 vop-out forget-stack-loc
-    dup 0 vop-out swap 0 vop-in vreg-contents get set-hash ;
-
-M: %replace trim-dead* ( tail vop -- )
-    dup redundant-replace? >r tuck live-load? not r> or
-    [ dup remember-replace dup , ] unless drop ;
-
-: ?dead-literal dup forget-vregs tuck live-load? ?, ;
-
-M: %immediate trim-dead* ( tail vop -- ) ?dead-literal ;
-
-M: %indirect trim-dead* ( tail vop -- ) ?dead-literal ;
-
-: trim-dead ( block -- )
-    #! Remove dead loads and stores.
-    [ dup first >r 1 swap tail-slice r> trim-dead* ] each-tail ;
-
-: simplify-block ( block -- block )
-    #! Destructively modifies the VOPs in the block.
-    [
-        0 d-height set
-        0 r-height set
-        H{ } clone vreg-contents set
-        dup simplify-stack
-        d-height get %inc-d r-height get %inc-r 2array append
-        trim-dead
-    ] { } make ;
-
-: keep-simplifying ( block -- block )
-    dup length >r simplify-block dup length r> =
-    [ keep-simplifying ] unless ;
-
-: simplify ( blocks -- blocks )
-    #! Simplify basic block IR.
-    [ keep-simplifying ] map ;
diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor
index e1c356abaf..ad191cb707 100644
--- a/library/compiler/compiler.factor
+++ b/library/compiler/compiler.factor
@@ -1,28 +1,20 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: compiler
-USING: compiler-backend compiler-frontend errors hashtables
-inference io kernel lists math namespaces optimizer prettyprint
-sequences test words ;
+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
-    [ split-blocks simplify generate ] hash-each ;
-
-: benchmark-compile
-    [ [ (compile) ] keep ] benchmark nip
-    "compile-time" set-word-prop ;
+    dup specialized-def dataflow optimize generate ;
 
 : 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
deleted file mode 100644
index 05d4b6e1f9..0000000000
--- a/library/compiler/generator.factor
+++ /dev/null
@@ -1,69 +0,0 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-backend
-USING: alien assembler compiler errors inference kernel
-kernel-internals lists math memory namespaces sequences strings
-vectors words ;
-
-! Compile a VOP.
-GENERIC: generate-node ( vop -- )
-
-: generate-code ( word linear -- length )
-    compiled-offset >r
-    compile-aligned
-    swap save-xt
-    [ [ dup [ generate-node ] with-vop ] each ] each
-    compile-aligned
-    compiled-offset r> - ;
-
-: generate-reloc ( -- length )
-    relocation-table get
-    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 -- )
-    #! If generation fails, reset compiled offset.
-    [
-        compiled-offset previous-offset set
-        (generate)
-    ] [
-        previous-offset get set-compiled-offset
-        rethrow
-    ] recover ;
-
-! A few VOPs have trivial generators.
-
-M: %label generate-node ( vop -- )
-    vop-label save-xt ;
-
-M: %target-label generate-node ( vop -- )
-    drop label 0 assemble-cell absolute-cell ;
-
-M: %cleanup generate-node ( vop -- ) drop ;
-
-M: %freg>stack generate-node ( vop -- ) drop ;
-
-M: %stack>freg generate-node ( vop -- ) drop ;
-
-M: %alien-invoke generate-node
-    #! call a C function.
-    drop 0 input 1 input compile-c-call ;
-
-: dest/src ( -- dest src ) 0 output-operand 0 input-operand ;
-
-! These constants must match native/card.h
-: card-bits 7 ;
-: card-mark HEX: 80 ;
-
-: string-offset 3 cells object-tag - ;
diff --git a/library/compiler/generator/architecture.factor b/library/compiler/generator/architecture.factor
new file mode 100644
index 0000000000..be0263f48a
--- /dev/null
+++ b/library/compiler/generator/architecture.factor
@@ -0,0 +1,133 @@
+IN: compiler
+USING: arrays generic kernel kernel-internals math memory
+namespaces sequences ;
+
+! A scratch register for computations
+TUPLE: vreg n ;
+
+C: vreg ( n reg-class -- vreg )
+    [ set-delegate ] keep [ set-vreg-n ] keep ;
+
+! Register classes
+TUPLE: int-regs ;
+TUPLE: float-regs size ;
+
+: <int-vreg> ( n -- vreg ) T{ int-regs } <vreg> ;
+: <float-vreg> ( n -- vreg ) T{ float-regs f 8 } <vreg> ;
+
+! 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
+GENERIC: vregs ( register-class -- regs )
+
+! Map a sequence of literals to f or float
+DEFER: literal-template ( literals -- template )
+
+! Load a literal (immediate or indirect)
+G: load-literal ( obj vreg -- ) 1 standard-combination ;
+
+! Set up caller stack frame (PowerPC and AMD64)
+: %prologue ( n -- ) drop ; inline
+
+! Tear down stack frame (PowerPC and AMD64)
+: %epilogue ( -- ) ; inline
+
+! 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
+GENERIC: (%peek) ( vreg loc reg-class -- )
+: %peek ( vreg loc -- ) over (%peek) ;
+
+! Store vreg to stack
+GENERIC: (%replace) ( vreg loc reg-class -- )
+: %replace ( vreg loc -- ) over (%replace) ;
+
+! Move one vreg to another
+DEFER: %move-int>int ( dst src -- )
+DEFER: %move-int>float ( dst src -- )
+
+: %move ( dst src -- )
+    2dup = [
+        2drop
+    ] [
+        2dup [ delegate class ] 2apply 2array {
+            { [ dup { int-regs int-regs } = ] [ drop %move-int>int ] }
+            { [ dup { float-regs int-regs } = ] [ drop %move-int>float ] }
+        } cond
+    ] if ;
+
+! 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 -- )
+
+GENERIC: %freg>stack ( stack reg reg-class -- )
+
+GENERIC: %stack>freg ( stack reg reg-class -- )
+
+DEFER: %alien-invoke ( library function -- )
+
+DEFER: %cleanup ( n -- )
+
+DEFER: %alien-callback ( quot -- )
+
+DEFER: %callback-value ( reg-class func -- )
+
+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 dup vreg-n swap vregs nth ;
+M: f v>operand address ;
diff --git a/library/compiler/assembler.factor b/library/compiler/generator/assembler.factor
similarity index 100%
rename from library/compiler/assembler.factor
rename to library/compiler/generator/assembler.factor
diff --git a/library/compiler/generator/generator.factor b/library/compiler/generator/generator.factor
new file mode 100644
index 0000000000..088f1851bd
--- /dev/null
+++ b/library/compiler/generator/generator.factor
@@ -0,0 +1,242 @@
+! Copyright (C) 2004, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler
+USING: arrays assembler errors generic hashtables inference
+kernel kernel-internals lists math namespaces queues sequences
+words ;
+
+GENERIC: stack-reserve*
+
+M: object stack-reserve* drop 0 ;
+
+: stack-reserve ( node -- n )
+    0 swap [ stack-reserve* max ] each-node ;
+
+: intrinsic ( #call -- quot )
+    node-param "intrinsic" word-prop ;
+
+: if-intrinsic ( #call -- quot )
+    node-param "if-intrinsic" word-prop ;
+
+DEFER: #terminal?
+
+PREDICATE: #merge #terminal-merge node-successor #terminal? ;
+
+PREDICATE: #call #terminal-call
+    dup node-successor #if?
+    over node-successor node-successor #terminal? and
+    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
+    rot save-xt
+    over stack-reserve %prologue
+    call
+    compile-aligned
+    compiled-offset r> - ;
+
+: generate-reloc ( -- length )
+    relocation-table get
+    dup [ assemble-cell ] each
+    length cells ;
+
+SYMBOL: previous-offset
+
+: 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.
+    [
+        begin-generating >r >r
+            generate-code
+            generate-reloc
+        r> set-compiled-cell
+        r> set-compiled-cell
+    ] [
+        previous-offset get set-compiled-offset rethrow
+    ] recover ;
+
+SYMBOL: generate-queue
+
+: generate-loop ( -- )
+    generate-queue get dup queue-empty? [
+        drop
+    ] [
+        deque first3 generate-1 generate-loop
+    ] if ;
+
+: generate-block ( word node quot -- | quot: node -- )
+    3array generate-queue get enque ;
+
+GENERIC: generate-node ( node -- )
+
+: generate-nodes ( node -- )
+    [ node@ generate-node ] iterate-nodes end-basic-block ;
+
+: generate-word ( node -- )
+    [ [ generate-nodes ] with-node-iterator ]
+    generate-block ;
+
+: generate ( word node -- )
+    [
+        <queue> generate-queue set
+        generate-word generate-loop 
+    ] with-scope ;
+
+! 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
+: end-false-branch ( label -- )
+    tail-call? [ %return drop ] [ %jump-label ] if ;
+
+: generate-if ( node label -- next )
+    <label> [
+        >r >r node-children first2 generate-nodes
+        r> r> end-false-branch save-xt generate-nodes
+    ] keep save-xt iterate-next ;
+
+M: #if generate-node ( node -- next )
+    [
+        end-basic-block
+        <label> dup %jump-t
+    ] H{
+        { +input { { f "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 ;
+
+: define-if-intrinsic ( word quot template -- | quot: label -- )
+    [with-template] "if-intrinsic" set-word-prop ;
+
+: if>boolean-intrinsic ( label -- )
+    <label> "end" set
+    f 0 <int-vreg> load-literal
+    "end" get %jump-label
+    save-xt
+    t 0 <int-vreg> load-literal
+    "end" get save-xt
+    0 <int-vreg> phantom-d get phantom-push
+    compute-free-vregs ;
+
+: do-if-intrinsic ( node -- next )
+    [ <label> dup ] keep if-intrinsic call
+    >r node-successor dup #if? [
+        r> generate-if node-successor
+    ] [
+        drop r> if>boolean-intrinsic iterate-next
+    ] if ;
+
+M: #call generate-node ( node -- next )
+    {
+        { [ dup if-intrinsic ] [ do-if-intrinsic ] }
+        { [ dup intrinsic ] [ intrinsic call iterate-next ] }
+        { [ t ] [ node-param generate-call ] }
+    } cond ;
+
+! #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 %dispatch ] H{
+        { +input { { f "n" } } }
+        { +scratch { { f "scratch" } } }
+    } 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 ?fp-scratch + 0 ensure-vregs
+    [ f spec>vreg [ load-literal ] keep ] map
+    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# 0 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 ;
+: card-mark HEX: 80 ;
+
+: float-offset 8 float-tag - ;
+: string-offset 3 cells object-tag - ;
diff --git a/library/compiler/generator/templates.factor b/library/compiler/generator/templates.factor
new file mode 100644
index 0000000000..54ef930aac
--- /dev/null
+++ b/library/compiler/generator/templates.factor
@@ -0,0 +1,284 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler
+USING: arrays generic hashtables inference io kernel math
+namespaces prettyprint sequences vectors words ;
+
+! Register allocation
+
+! Hash mapping reg-classes to mutable vectors
+: free-vregs ( reg-class -- seq ) \ free-vregs get hash ;
+
+: alloc-reg ( reg-class -- vreg ) free-vregs pop ;
+
+: take-reg ( vreg -- ) dup delegate free-vregs delete ;
+
+: reg-spec>class ( spec -- class )
+    float eq? T{ float-regs f 8 } T{ int-regs } ? ;
+
+: spec>vreg ( spec -- vreg )
+    dup integer? [
+        <int-vreg> dup take-reg
+    ] [
+        reg-spec>class alloc-reg
+    ] if ;
+
+! A data stack location.
+TUPLE: ds-loc n ;
+
+! A call stack location.
+TUPLE: cs-loc n ;
+
+UNION: loc ds-loc cs-loc ;
+
+TUPLE: phantom-stack height ;
+
+C: phantom-stack ( -- stack )
+    0 over set-phantom-stack-height
+    V{ } clone over set-delegate ;
+
+GENERIC: finalize-height ( n stack -- )
+
+GENERIC: <loc> ( n stack -- loc )
+
+: (loc)
+    #! Utility for methods on <loc>
+    phantom-stack-height - ;
+
+: (finalize-height) ( stack word -- )
+    #! We consolidate multiple stack height changes until the
+    #! last moment, and we emit the final height changing
+    #! instruction here.
+    swap [
+        phantom-stack-height
+        dup zero? [ 2drop ] [ swap execute ] if
+        0
+    ] keep set-phantom-stack-height ; inline
+
+TUPLE: phantom-datastack ;
+
+C: phantom-datastack
+    [ >r <phantom-stack> r> set-delegate ] keep ;
+
+M: phantom-datastack <loc> (loc) <ds-loc> ;
+
+M: phantom-datastack finalize-height
+    \ %inc-d (finalize-height) ;
+
+TUPLE: phantom-callstack ;
+
+C: phantom-callstack
+    [ >r <phantom-stack> r> set-delegate ] keep ;
+
+M: phantom-callstack <loc> (loc) <cs-loc> ;
+
+M: phantom-callstack finalize-height
+    \ %inc-r (finalize-height) ;
+
+: phantom-locs ( n phantom -- locs )
+    #! A sequence of n ds-locs or cs-locs indexing the stack.
+    swap reverse-slice [ swap <loc> ] map-with ;
+
+: phantom-locs* ( phantom -- locs )
+    dup length swap phantom-locs ;
+
+: adjust-phantom ( n phantom -- )
+    [ phantom-stack-height + ] keep set-phantom-stack-height ;
+
+GENERIC: cut-phantom ( n phantom -- seq )
+
+M: phantom-stack cut-phantom ( n phantom -- seq )
+    [ delegate cut* swap ] keep set-delegate ;
+
+SYMBOL: phantom-d
+SYMBOL: phantom-r
+
+: phantoms ( -- phantom phantom ) phantom-d get phantom-r get ;
+
+: init-templates ( -- )
+    <phantom-datastack> phantom-d set
+    <phantom-callstack> phantom-r set ;
+
+: finalize-heights ( -- )
+    phantoms [ finalize-height ] 2apply ;
+
+: vreg>stack ( value loc -- )
+    over loc? over not or [ 2drop ] [ %replace ] if ;
+
+: vregs>stack ( phantom -- )
+    [
+        dup phantom-locs* [ vreg>stack ] 2each 0
+    ] keep set-length ;
+
+: (live-locs) ( seq -- seq )
+    dup phantom-locs* [ 2array ] 2map
+    [ first2 over loc? >r = not r> and ] subset
+    [ first ] map ;
+
+: stack>new-vreg ( loc spec -- vreg )
+    spec>vreg [ swap %peek ] keep ;
+
+: live-locs ( phantom phantom -- hash )
+    [ (live-locs) ] 2apply append prune
+    [ dup f stack>new-vreg ] map>hash ;
+
+: lazy-store ( value loc -- )
+    over loc? [
+        2dup =
+        [ 2drop ] [ >r \ live-locs get hash r> vreg>stack ] if
+    ] [
+        2drop
+    ] if ;
+
+: flush-locs ( phantom phantom -- )
+    2dup live-locs \ live-locs set
+    [ dup phantom-locs* [ lazy-store ] 2each ] 2apply ;
+
+: finalize-contents ( -- )
+    phantoms 2dup flush-locs [ vregs>stack ] 2apply ;
+
+: end-basic-block ( -- ) finalize-contents finalize-heights ;
+
+: used-vregs ( -- seq ) phantoms append [ vreg? ] subset ;
+
+: (compute-free-vregs) ( used class -- vector )
+    dup vregs length reverse [ swap <vreg> ] map-with diff
+    >vector ;
+
+: compute-free-vregs ( -- )
+    used-vregs
+    { T{ int-regs } T{ float-regs f 8 } }
+    [ 2dup (compute-free-vregs) ] map>hash \ free-vregs set
+    drop ;
+
+: additional-vregs ( seq seq -- n )
+    2array phantoms 2array [ [ length ] map ] 2apply v-
+    0 [ 0 max + ] reduce ;
+
+: free-vregs# ( -- int# float# )
+    T{ int-regs } free-vregs length
+    phantoms [ [ loc? ] subset length ] 2apply + -
+    T{ float-regs f 8 } free-vregs length ;
+
+: ensure-vregs ( int# float# -- )
+    compute-free-vregs free-vregs# swapd <= >r <= r> and
+    [ finalize-contents compute-free-vregs ] unless ;
+
+: (lazy-load) ( spec value -- value )
+    {
+        { [ dup loc? ] [ >r spec>vreg dup r> %peek ] }
+        { [ dup [ float-regs? ] is? ] [ nip ] }
+        { [ over float eq? ] [ >r spec>vreg dup r> %move ] }
+        { [ t ] [ nip ] }
+    } cond ;
+
+: lazy-load ( values template -- )
+    dup length neg phantom-d get adjust-phantom
+    [ first2 >r swap (lazy-load) r> set ] 2each ;
+
+: compatible-vreg? ( n vreg -- ? )
+    dup [ int-regs? ] is? [ vreg-n = ] [ 2drop f ] if ;
+
+: compatible-values? ( value template -- ? )
+    {
+        { [ over loc? ] [ 2drop t ] }
+        { [ dup not ] [ drop [ float-regs? ] is? not ] }
+        { [ dup float eq? ] [ 2drop t ] }
+        { [ dup integer? ] [ swap compatible-vreg? ] }
+    } cond ;
+
+: template-match? ( template phantom -- ? )
+    [ reverse-slice ] 2apply
+    t [ swap first compatible-values? and ] 2reduce ;
+
+: split-template ( template phantom -- slow fast )
+    over length over length <=
+    [ drop { } swap ] [ length swap cut* ] if ;
+
+: match-template ( template -- slow fast )
+    phantom-d get 2dup template-match?
+    [ split-template ] [ drop { } ] if ;
+
+: fast-input ( template -- )
+    phantom-d get over length swap cut-phantom swap lazy-load ;
+
+: phantom-push ( obj stack -- )
+    1 over adjust-phantom push ;
+
+: phantom-append ( seq stack -- )
+    over length over adjust-phantom swap nappend ;
+
+: (template-outputs) ( seq stack -- )
+    phantoms swapd phantom-append phantom-append ;
+
+SYMBOL: +input
+SYMBOL: +output
+SYMBOL: +scratch
+SYMBOL: +clobber
+
+: fix-spec ( spec -- spec )
+    H{
+        { +input { } }
+        { +output { } }
+        { +scratch { } }
+        { +clobber { } }
+    } swap hash-union ;
+
+: output-vregs ( -- seq seq )
+    +output +clobber [ get [ get ] map ] 2apply ;
+
+: outputs-clash? ( -- ? )
+    output-vregs append phantoms append
+    [ swap member? ] contains-with? ;
+
+: slow-input ( template -- )
+    #! Are we loading stuff from the stack? Then flush out
+    #! remaining vregs, not slurped in by fast-input.
+    #! Do the outputs clash with vregs on the phantom stacks?
+    #! Then we must flush them first.
+    dup empty? not outputs-clash? or [ finalize-contents ] when
+    [ length phantom-d get phantom-locs ] keep lazy-load ;
+
+: requested-vregs ( template -- int# float# )
+    dup length swap [ float eq? ] subset length [ - ] keep ;
+
+: (requests-class?) ( class template -- )
+    [ second reg-spec>class eq? ] contains-with? ;
+
+: requests-class? ( class -- ? )
+    dup +input get (requests-class?) swap
+    +scratch get (requests-class?) or ;
+
+: ?fp-scratch ( -- n )
+    T{ float-regs f 8 } requests-class? 1 0 ? ;
+
+: fp-scratch ( -- vreg )
+    "fp-scratch" get [
+        T{ int-regs } alloc-reg dup "fp-scratch" set
+    ] unless* ;
+
+: guess-vregs ( -- int# float# )
+    +input get { } additional-vregs ?fp-scratch +
+    +scratch get [ first ] map requested-vregs >r + r> ;
+
+: alloc-scratch ( -- )
+    +scratch get [ first2 >r spec>vreg r> set ] each ;
+
+: template-inputs ( -- )
+    ! Ensure we have enough to hold any new stack elements we
+    ! will read (if any), and scratch.
+    guess-vregs ensure-vregs
+    ! Split the template into available (fast) parts and those
+    ! that require allocating registers and reading the stack
+    +input get match-template fast-input slow-input
+    ! Finally allocate scratch registers
+    alloc-scratch ;
+
+: template-outputs ( -- )
+    +output get [ get ] map { } (template-outputs) ;
+
+: 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/xt.factor b/library/compiler/generator/xt.factor
similarity index 94%
rename from library/compiler/xt.factor
rename to library/compiler/generator/xt.factor
index e1f51c8f01..c2962af6b7 100644
--- a/library/compiler/xt.factor
+++ b/library/compiler/generator/xt.factor
@@ -1,9 +1,16 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler
-USING: assembler compiler-backend compiler-frontend errors
-generic hashtables kernel kernel-internals lists math namespaces
-prettyprint sequences strings vectors words ;
+USING: assembler errors generic hashtables kernel
+kernel-internals lists math namespaces prettyprint queues
+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
@@ -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/inference/branches.factor b/library/compiler/inference/branches.factor
similarity index 97%
rename from library/inference/branches.factor
rename to library/compiler/inference/branches.factor
index 94535a898d..e8d9f3b080 100644
--- a/library/inference/branches.factor
+++ b/library/compiler/inference/branches.factor
@@ -31,8 +31,7 @@ namespaces parser prettyprint sequences strings vectors words ;
 
 : unbalanced-branches ( in out -- )
     { "Unbalanced branches:" } -rot [
-        swap number>string " " rot length number>string
-        append3
+        swap unparse " " rot length unparse append3
     ] 2map append "\n" join inference-error ;
 
 : unify-effect ( in out -- in out )
diff --git a/library/inference/dataflow.factor b/library/compiler/inference/dataflow.factor
similarity index 87%
rename from library/inference/dataflow.factor
rename to library/compiler/inference/dataflow.factor
index 263be79353..f5404cd3f6 100644
--- a/library/inference/dataflow.factor
+++ b/library/compiler/inference/dataflow.factor
@@ -4,26 +4,6 @@ IN: inference
 USING: arrays generic hashtables interpreter kernel lists math
 namespaces parser sequences words ;
 
-! Recursive state. An alist, mapping words to labels.
-SYMBOL: recursive-state
-
-: <computed> \ <computed> counter ;
-
-TUPLE: value uid literal recursion ;
-
-C: value ( obj -- value )
-    <computed> over set-value-uid
-    recursive-state get over set-value-recursion
-    [ set-value-literal ] keep ;
-
-M: value hashcode value-uid ;
-
-M: value = eq? ;
-
-M: integer value-uid ;
-
-M: integer value-recursion drop f ;
-
 ! The dataflow IR is the first of the two intermediate
 ! representations used by Factor. It annotates concatenative
 ! code with stack flow information and types.
@@ -51,6 +31,7 @@ M: node = eq? ;
 : param-node ( label) { } { } { } { } ;
 : in-node ( inputs) >r f r> { } { } { } ;
 : out-node ( outputs) >r f { } r> { } { } ;
+: meta-d-node meta-d get clone in-node ;
 
 : d-tail ( n -- list ) meta-d get tail* ;
 : r-tail ( n -- list ) meta-r get tail* ;
@@ -63,7 +44,8 @@ C: #label make-node ;
 
 TUPLE: #entry ;
 C: #entry make-node ;
-: #entry ( -- node ) meta-d get clone in-node <#entry> ;
+
+: #entry ( -- node ) meta-d-node <#entry> ;
 
 TUPLE: #call ;
 C: #call make-node ;
@@ -73,30 +55,33 @@ TUPLE: #call-label ;
 C: #call-label make-node ;
 : #call-label ( label -- node ) param-node <#call-label> ;
 
+TUPLE: #push ;
+C: #push make-node ;
+: #push ( -- node ) peek-d 1array out-node <#push> ;
+: >#push< ( node -- seq ) node-out-d [ value-literal ] map ;
+
 TUPLE: #shuffle ;
 C: #shuffle make-node ;
 : #shuffle ( -- node ) empty-node <#shuffle> ;
-: #push ( outputs -- node ) d-tail out-node <#shuffle> ;
 
 TUPLE: #values ;
 C: #values make-node ;
-: #values ( -- node ) meta-d get clone in-node <#values> ;
+: #values ( -- node ) meta-d-node <#values> ;
 
 TUPLE: #return ;
 C: #return make-node ;
 : #return ( label -- node )
     #! The parameter is the label we are returning from, or if
     #! f, this is a top-level return.
-    meta-d get clone in-node <#return>
-    [ set-node-param ] keep ;
+    meta-d-node <#return> [ set-node-param ] keep ;
 
 TUPLE: #if ;
 C: #if make-node ;
-: #if ( in -- node ) 1 d-tail in-node <#if> ;
+: #if ( in -- node ) peek-d 1array in-node <#if> ;
 
 TUPLE: #dispatch ;
 C: #dispatch make-node ;
-: #dispatch ( in -- node ) 1 d-tail in-node <#dispatch> ;
+: #dispatch ( in -- node ) peek-d 1array in-node <#dispatch> ;
 
 TUPLE: #merge ;
 C: #merge make-node ;
@@ -106,6 +91,10 @@ TUPLE: #terminate ;
 C: #terminate make-node ;
 : #terminate ( -- node ) empty-node <#terminate> ;
 
+TUPLE: #declare ;
+C: #declare make-node ;
+: #declare ( classes -- node ) param-node <#declare> ;
+
 : node-inputs ( d-count r-count node -- )
     tuck
     >r r-tail r> set-node-in-r
@@ -135,11 +124,6 @@ SYMBOL: current-node
         dup node-in-r % node-out-r %
     ] { } make ;
 
-: uses-value? ( value node -- ? ) node-values memq? ;
-
-: outputs-value? ( value node -- ? )
-    2dup node-out-d member? >r node-out-r member? r> or ;
-
 : last-node ( node -- last )
     dup node-successor [ last-node ] [ ] ?if ;
 
diff --git a/library/inference/inference.factor b/library/compiler/inference/inference.factor
similarity index 99%
rename from library/inference/inference.factor
rename to library/compiler/inference/inference.factor
index af22fb903e..818b204d52 100644
--- a/library/inference/inference.factor
+++ b/library/compiler/inference/inference.factor
@@ -76,7 +76,7 @@ GENERIC: apply-object
 : apply-literal ( obj -- )
     #! Literals are annotated with the current recursive
     #! state.
-    <value> push-d  1 #push node, ;
+    <value> push-d #push node, ;
 
 M: object apply-object apply-literal ;
 
diff --git a/library/inference/inference.facts b/library/compiler/inference/inference.facts
similarity index 100%
rename from library/inference/inference.facts
rename to library/compiler/inference/inference.facts
diff --git a/library/inference/known-words.factor b/library/compiler/inference/known-words.factor
similarity index 97%
rename from library/inference/known-words.factor
rename to library/compiler/inference/known-words.factor
index 1100ba8c18..7ae0d7b8c8 100644
--- a/library/inference/known-words.factor
+++ b/library/compiler/inference/known-words.factor
@@ -4,13 +4,14 @@ hashtables-internals interpreter io io-internals kernel
 kernel-internals lists math math-internals memory parser
 sequences strings vectors words prettyprint ;
 
-! We transform calls to these words into 'branched' forms;
-! eg, there is no VOP for fixnum<=, only fixnum<= followed
-! by an #if, so if we have a 'bare' fixnum<= we add
-! [ t ] [ f ] if at the end.
+\ declare [
+    pop-literal nip
+    dup length ensure-values
+    dup #declare [ >r length d-tail r> set-node-in-d ] keep
+    node,
+] "infer" set-word-prop
+\ declare [ [ object ] [ ] ] "infer-effect" set-word-prop
 
-! This transformation really belongs in the optimizer, but it
-! is simpler to do it here.
 \ fixnum< [ [ fixnum fixnum ] [ object ] ] "infer-effect" set-word-prop
 \ fixnum< t "flushable" set-word-prop
 \ fixnum< t "foldable" set-word-prop
@@ -31,13 +32,6 @@ sequences strings vectors words prettyprint ;
 \ eq? t "flushable" set-word-prop
 \ eq? t "foldable" set-word-prop
 
-: manual-branch ( word -- )
-    dup "infer-effect" word-prop consume/produce
-    [ [ t ] [ f ] if ] infer-quot ;
-
-! { fixnum<= fixnum< fixnum>= fixnum> eq? }
-! [ dup [ manual-branch ] curry "infer" set-word-prop ] each
-
 ! Primitive combinators
 \ call [ [ general-list ] [ ] ] "infer-effect" set-word-prop
 
@@ -139,10 +133,18 @@ sequences strings vectors words prettyprint ;
 \ fixnum+ t "flushable" set-word-prop
 \ fixnum+ t "foldable" set-word-prop
 
+\ fixnum+fast [ [ fixnum fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
+\ fixnum+fast t "flushable" set-word-prop
+\ fixnum+fast t "foldable" set-word-prop
+
 \ fixnum- [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
 \ fixnum- t "flushable" set-word-prop
 \ fixnum- t "foldable" set-word-prop
 
+\ fixnum-fast [ [ fixnum fixnum ] [ fixnum ] ] "infer-effect" set-word-prop
+\ fixnum-fast t "flushable" set-word-prop
+\ fixnum-fast t "foldable" set-word-prop
+
 \ fixnum* [ [ fixnum fixnum ] [ integer ] ] "infer-effect" set-word-prop
 \ fixnum* t "flushable" set-word-prop
 \ fixnum* t "foldable" set-word-prop
diff --git a/library/inference/shuffle.factor b/library/compiler/inference/shuffle.factor
similarity index 50%
rename from library/inference/shuffle.factor
rename to library/compiler/inference/shuffle.factor
index d54267abcc..3f783845c6 100644
--- a/library/inference/shuffle.factor
+++ b/library/compiler/inference/shuffle.factor
@@ -1,9 +1,29 @@
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 IN: inference
 USING: hashtables kernel math namespaces sequences ;
 
-TUPLE: shuffle in-d in-r out-d out-r ;
+! Recursive state. An alist, mapping words to labels.
+SYMBOL: recursive-state
 
-: empty-shuffle { } { } { } { } <shuffle> ;
+: <computed> \ <computed> counter ;
+
+TUPLE: value uid literal recursion ;
+
+C: value ( obj -- value )
+    <computed> over set-value-uid
+    recursive-state get over set-value-recursion
+    [ set-value-literal ] keep ;
+
+M: value hashcode value-uid ;
+
+M: value = eq? ;
+
+M: integer value-uid ;
+
+M: integer value-recursion drop f ;
+
+TUPLE: shuffle in-d in-r out-d out-r ;
 
 : load-shuffle ( d r shuffle -- )
     tuck shuffle-in-r [ set ] 2each shuffle-in-d [ set ] 2each ;
@@ -31,28 +51,6 @@ TUPLE: shuffle in-d in-r out-d out-r ;
     #! the shuffle.
     [ split-shuffle ] keep shuffle* join-shuffle ;
 
-: fix-compose-d ( s1 s2 -- )
-    over shuffle-out-d over shuffle-in-d [ length ] 2apply < [
-        over shuffle-out-d length over shuffle-in-d head*
-        [ pick shuffle-in-d append pick set-shuffle-in-d ] keep
-        pick shuffle-out-d append pick set-shuffle-out-d
-    ] when 2drop ;
-
-: fix-compose-r ( s1 s2 -- )
-    over shuffle-out-r over shuffle-in-r [ length ] 2apply < [
-        over shuffle-out-r length over shuffle-in-r head*
-        [ pick shuffle-in-r append pick set-shuffle-in-r ] keep
-        pick shuffle-out-r append pick set-shuffle-out-r
-    ] when 2drop ;
-
-: compose-shuffle ( s1 s2 -- s1+s2 )
-    #! s1's d and r output lengths must be at least the required
-    #! length for the shuffle. If they are not, a special
-    #! behavior is used which is only valid for the optimizer.
-    [ clone ] 2apply 2dup fix-compose-d 2dup fix-compose-r
-    >r dup shuffle-out-d over shuffle-out-r r> shuffle
-    >r >r dup shuffle-in-d swap shuffle-in-r r> r> <shuffle> ;
-
 M: shuffle clone ( shuffle -- shuffle )
     [ shuffle-in-d clone ] keep
     [ shuffle-in-r clone ] keep
diff --git a/library/inference/stack.factor b/library/compiler/inference/stack.factor
similarity index 100%
rename from library/inference/stack.factor
rename to library/compiler/inference/stack.factor
diff --git a/library/inference/words.factor b/library/compiler/inference/words.factor
similarity index 99%
rename from library/inference/words.factor
rename to library/compiler/inference/words.factor
index 3b14dd4d84..4e2a150b9d 100644
--- a/library/inference/words.factor
+++ b/library/compiler/inference/words.factor
@@ -104,7 +104,7 @@ M: #call-label collect-recursion* ( label node -- )
 
 : infer-compound ( word base-case -- terminates? effect )
     #! Infer a word's stack effect in a separate inferencer
-    #! instance. Outputs a boolean if the word terminates
+    #! instance. Outputs a true boolean if the word terminates
     #! control flow by throwing an exception or restoring a
     #! continuation.
     [
diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor
deleted file mode 100644
index dfd5f0f222..0000000000
--- a/library/compiler/intrinsics.factor
+++ /dev/null
@@ -1,235 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-frontend
-USING: arrays assembler compiler-backend generic hashtables
-inference kernel kernel-internals lists math math-internals
-namespaces sequences words ;
-
-: node-peek ( node -- value ) node-in-d peek ;
-
-: type-tag ( type -- tag )
-    #! Given a type number, return the tag number.
-    dup 6 > [ drop 3 ] when ;
-
-: value-tag ( value node -- n/f )
-    #! If the tag is known, output it, otherwise f.
-    node-classes ?hash dup [
-        types [ type-tag ] map dup all-equal?
-        [ first ] [ drop f ] if
-    ] [
-        drop f
-    ] if ;
-
-: slot@ ( node -- n/f )
-    #! Compute slot offset.
-    dup node-in-d reverse-slice dup first dup value? [
-        value-literal cells swap second
-        rot value-tag dup [ - ] [ 2drop f ] if
-    ] [
-        3drop f
-    ] if ;
-
-\ slot [
-    dup slot@ [
-        -1 %inc-d ,
-        in-1
-        0 swap slot@ %fast-slot ,
-    ] [
-        drop
-        in-2
-        -1 %inc-d ,
-        0 %untag ,
-        1 0 %slot ,
-    ] if  out-1
-] "intrinsic" set-word-prop
-
-\ set-slot [
-    dup slot@ [
-        -1 %inc-d ,
-        in-2
-        -2 %inc-d ,
-        slot@ >r 0 1 r> %fast-set-slot ,
-    ] [
-        drop
-        in-3
-        -3 %inc-d ,
-        1 %untag ,
-        0 1 2 %set-slot ,
-    ] if
-    1 %write-barrier ,
-] "intrinsic" set-word-prop
-
-\ char-slot [
-    drop
-    in-2
-    -1 %inc-d ,
-    0 1 %char-slot ,
-    1 <vreg> 0 %replace-d ,
-] "intrinsic" set-word-prop
-
-\ set-char-slot [
-    drop
-    in-3
-    -3 %inc-d ,
-    0 2 1 %set-char-slot ,
-] "intrinsic" set-word-prop
-
-\ type [
-    drop
-    in-1
-    0 %type ,
-    out-1
-] "intrinsic" set-word-prop
-
-\ tag [
-    drop
-    in-1
-    0 %tag ,
-    out-1
-] "intrinsic" set-word-prop
-
-\ getenv [
-    -1 %inc-d ,
-    node-peek value-literal 0 <vreg> swap %getenv ,
-    1 %inc-d ,
-    out-1
-] "intrinsic" set-word-prop
-
-\ setenv [
-    -1 %inc-d ,
-    in-1
-    node-peek value-literal 0 <vreg> swap %setenv ,
-    -1 %inc-d ,
-] "intrinsic" set-word-prop
-
-: value/vreg-list ( in -- list )
-    [ 0 swap length 1- ] keep
-    [ >r 2dup r> 3array >r 1- >r 1+ r> r> ] map 2nip ;
-
-: values>vregs ( in -- in )
-    value/vreg-list
-    dup [ first3 load-value ] each
-    [ first <vreg> ] map ;
-
-: binary-inputs ( node -- in1 in2 )
-    node-in-d values>vregs first2 swap ;
-
-: binary-op-reg ( node op -- )
-    >r binary-inputs dup -1 %inc-d , r> execute , out-1 ; inline
-
-: binary-imm ( node -- in1 in2 )
-    -1 %inc-d , in-1 node-peek value-literal 0 <vreg> ;
-
-: binary-op-imm ( node op -- )
-    >r binary-imm dup r> execute , out-1 ; inline
-
-: literal-immediate? ( value -- ? )
-    dup value? [ value-literal immediate? ] [ drop f ] if ;
-
-: binary-op-imm? ( node -- ? )
-    fixnum-imm? >r node-peek literal-immediate? r> and ;
-
-: binary-op ( node op -- )
-    #! out is a vreg where the vop stores the result.
-    over binary-op-imm?
-    [ binary-op-imm ] [ binary-op-reg ] if ;
-
-{
-    { fixnum+       %fixnum+       }
-    { fixnum-       %fixnum-       }
-    { fixnum-bitand %fixnum-bitand }
-    { fixnum-bitor  %fixnum-bitor  }
-    { fixnum-bitxor %fixnum-bitxor }
-} [
-    first2 [ binary-op ] curry "intrinsic" set-word-prop
-] each
-
-: binary-jump-reg ( node label op -- )
-    >r >r binary-inputs -2 %inc-d , r> r> execute , ; inline
-
-: binary-jump-imm ( node label op -- )
-    >r >r binary-imm -1 %inc-d , r> r> execute , ; inline
-
-: binary-jump ( node label op -- )
-    pick binary-op-imm?
-    [ binary-jump-imm ] [ binary-jump-reg ] if ;
-
-{
-    { fixnum<= %jump-fixnum<= }
-    { fixnum<  %jump-fixnum<  }
-    { fixnum>= %jump-fixnum>= }
-    { fixnum>  %jump-fixnum>  }
-    { eq?      %jump-eq?      }
-} [
-    first2 [ binary-jump ] curry "if-intrinsic" set-word-prop
-] each
-
-\ fixnum/i [
-    \ %fixnum/i binary-op-reg
-] "intrinsic" set-word-prop
-
-\ fixnum-mod [
-    ! This is not clever. Because of x86, %fixnum-mod is
-    ! hard-coded to put its output in vreg 2, which happends to
-    ! be EDX there.
-    drop
-    in-2
-    -1 %inc-d ,
-    1 <vreg> 0 <vreg> 2 <vreg> %fixnum-mod ,
-    T{ vreg f 2 } 0 %replace-d ,
-] "intrinsic" set-word-prop
-
-\ fixnum/mod [
-    ! See the remark on fixnum-mod for vreg usage
-    drop
-    in-2
-    { T{ vreg f 1 } T{ vreg f 0 } }
-    { T{ vreg f 2 } T{ vreg f 0 } }
-    %fixnum/mod ,
-    T{ vreg f 2 } 0 %replace-d ,
-    T{ vreg f 0 } 1 %replace-d ,
-] "intrinsic" set-word-prop
-
-\ fixnum-bitnot [
-    drop
-    in-1
-    0 <vreg> 0 <vreg> %fixnum-bitnot ,
-    out-1
-] "intrinsic" set-word-prop
-
-\ fixnum* [
-    \ %fixnum* binary-op-reg
-] "intrinsic" set-word-prop
-
-: slow-shift ( -- ) \ fixnum-shift %call , ;
-
-: negative-shift ( n -- )
-    -1 %inc-d ,
-    in-1
-    dup cell-bits neg <= [
-        drop 0 <vreg> 2 <vreg> %fixnum-sgn ,
-        T{ vreg f 2 } 0 %replace-d ,
-    ] [
-        neg 0 <vreg> 0 <vreg> %fixnum>> ,
-        out-1
-    ] if ;
-
-: fast-shift ( n -- )
-    dup zero? [
-        -1 %inc-d ,
-        drop
-    ] [
-        dup 0 < [
-            negative-shift
-        ] [
-            drop slow-shift
-        ] if
-    ] if ;
-
-\ fixnum-shift [
-    node-peek dup value? [
-        value-literal fast-shift
-    ] [
-        drop slow-shift
-    ] if
-] "intrinsic" set-word-prop
diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor
deleted file mode 100644
index 39d8da2a46..0000000000
--- a/library/compiler/linearizer.factor
+++ /dev/null
@@ -1,140 +0,0 @@
-! Copyright (C) 2004, 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays compiler-backend generic hashtables inference
-kernel math namespaces sequences words ;
-IN: compiler-frontend
-
-! On PowerPC and AMD64, we use a stack discipline whereby
-! stack frames are used to hold parameters. We need to compute
-! the stack frame size to compile the prologue on entry to a
-! word.
-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? ;
-
-UNION: #terminal POSTPONE: f #return #values #terminal-merge ;
-
-: tail-call? ( -- ? )
-    node-stack get [ node-successor ] map [ #terminal? ] all? ;
-
-GENERIC: linearize* ( node -- next )
-
-: linearize-child ( node -- )
-    [ node@ linearize* ] iterate-nodes ;
-
-! 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 -- )
-    [
-        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 )
-    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> ;
-
-: in-1 0 0 %peek-d , ;
-: in-2 0 1 %peek-d ,  1 0 %peek-d , ;
-: in-3 0 2 %peek-d ,  1 1 %peek-d ,  2 0 %peek-d , ;
-: out-1 T{ vreg f 0 } 0 %replace-d , ;
-
-: 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 ;
-
-: linearize-if ( node label -- next )
-    <label> dup >r >r >r node-children first2 linearize-child
-    r> r> %jump-label , %label , linearize-child r> %label ,
-    iterate-next ;
-
-M: #call linearize* ( node -- next )
-    dup if-intrinsic [
-        >r <label> 2dup 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 ;
-
-: ?static-branch ( node -- n )
-    node-in-d first dup value?
-    [ value-literal 0 1 ? ] [ drop f ] if ;
-
-M: #if linearize* ( node -- next )
-    dup ?static-branch [
-        -1 %inc-d ,
-        swap node-children nth linearize-child iterate-next
-    ] [
-        in-1 -1 %inc-d , <label> dup 0 %jump-t , linearize-if
-    ] if* ;
-
-: dispatch-head ( vtable -- label/node )
-    #! Output the jump table insn and return a list of
-    #! label/branch pairs.
-    in-1 -1 %inc-d , 0 %dispatch ,
-    [ <label> dup %target-label ,  2array ] map ;
-
-: dispatch-body ( label/node -- )
-    <label> swap [
-        first2 %label , linearize-child 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.
-    node-children dispatch-head dispatch-body iterate-next ;
-
-M: #return linearize* drop %return , f ;
diff --git a/library/inference/call-optimizers.factor b/library/compiler/optimizer/call-optimizers.factor
similarity index 89%
rename from library/inference/call-optimizers.factor
rename to library/compiler/optimizer/call-optimizers.factor
index 4f90bd6279..d98bc25bd4 100644
--- a/library/inference/call-optimizers.factor
+++ b/library/compiler/optimizer/call-optimizers.factor
@@ -1,5 +1,5 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 IN: optimizer
 USING: arrays errors generic hashtables inference kernel lists
 math math-internals sequences words ;
@@ -36,17 +36,17 @@ math math-internals sequences words ;
     [ with-datastack ] catch
     [ 3drop t ] [ inline-literals ] if ;
 
-: flip-subst ( not -- )
+: call>no-op ( not -- )
     #! Note: cloning the vectors, since subst-values will modify
     #! them.
     [ node-in-d clone ] keep
     [ node-out-d clone ] keep
-    subst-values ;
+    [ subst-values ] keep node-successor ;
 
 : flip-branches ( not -- #if )
     #! If a not is followed by an #if, flip branches and
     #! remove the not.
-    dup flip-subst node-successor dup
+    call>no-op dup
     dup node-children reverse swap set-node-children ;
 
 \ not {
@@ -62,6 +62,16 @@ math math-internals sequences words ;
     { [ dup disjoint-eq? ] [ [ f ] inline-literals ] }
 } define-optimizers
 
+: useless-coerce? ( node -- )
+    dup 0 node-class#
+    swap node-param "infer-effect" word-prop second first eq? ;
+
+{ >fixnum >bignum >float } [
+    {
+        { [ dup useless-coerce? ] [ call>no-op ] }
+    } define-optimizers
+] each
+
 ! Arithmetic identities
 SYMBOL: @
 
@@ -109,7 +119,7 @@ SYMBOL: @
     { { -1 @ } [ nip 0 swap - ]  }
 } define-identities
 
-[ / /i /f fixnum/i fixnum/f bignum/i bignum/f float/f ] {
+[ / fixnum/i fixnum/f bignum/i bignum/f float/f ] {
     { { @ 1 }  [ drop ]          }
     { { @ -1 } [ drop 0 swap - ] }
 } define-identities
@@ -163,7 +173,7 @@ SYMBOL: @
     { { @ @ } [ 2drop t ] }
 } define-identities
 
-[ eq? number= = ] {
+[ eq? bignum= float= number= = ] {
     { { @ @ } [ 2drop t ] }
 } define-identities
 
@@ -172,7 +182,6 @@ M: #call optimize-node* ( node -- node/t )
         { [ dup partial-eval? ] [ partial-eval ] }
         { [ dup find-identity nip ] [ apply-identities ] }
         { [ dup optimizer-hooks ] [ optimize-hooks ] }
-        { [ dup inlining-class ] [ inline-method ] }
         { [ dup optimize-predicate? ] [ optimize-predicate ] }
-        { [ t ] [ drop t ] }
+        { [ t ] [ inline-method ] }
     } cond ;
diff --git a/library/inference/class-infer.factor b/library/compiler/optimizer/class-infer.factor
similarity index 77%
rename from library/inference/class-infer.factor
rename to library/compiler/optimizer/class-infer.factor
index 5ffc3aa8a6..444c34298c 100644
--- a/library/inference/class-infer.factor
+++ b/library/compiler/optimizer/class-infer.factor
@@ -1,11 +1,17 @@
-! 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: optimizer
 USING: arrays generic hashtables inference kernel
 kernel-internals math namespaces sequences words ;
 
 ! Infer possible classes of values in a dataflow IR.
 
+: node-class ( value node -- class )
+    node-classes ?hash [ object ] unless* ;
+
+: node-class# ( node n -- class )
+    swap [ node-in-d reverse-slice ?nth ] keep node-class ;
+
 ! Variables used by the class inferencer
 
 ! Current value --> class mapping
@@ -104,26 +110,29 @@ M: node child-ties ( node -- seq )
     ] if ;
 
 \ make-tuple [
-    dup node-in-d first value-literal 1array
+    node-in-d first value-literal 1array
 ] "output-classes" set-word-prop
 
+{ clone (clone) } [
+    [
+        node-in-d [ value-class* ] map
+    ] "output-classes" set-word-prop
+] each
+
 : output-classes ( node -- seq )
     dup node-param "output-classes" word-prop [
         call
     ] [
         node-param "infer-effect" word-prop second
         dup integer? [ drop f ] when
-    ] ?if ;
+    ] if* ;
 
 M: #call infer-classes* ( node -- )
-    dup node-param [
-        dup create-ties
-        dup output-classes
-        [ over node-out-d intersect-classes ] when*
-    ] when drop ;
+    dup create-ties dup output-classes
+    [ swap node-out-d intersect-classes ] [ drop ] if* ;
 
-M: #shuffle infer-classes* ( node -- )
-    node-out-d [ value? ] subset
+M: #push infer-classes* ( node -- )
+    node-out-d
     [ [ value-literal ] keep set-value-literal* ] each ;
 
 M: #if child-ties ( node -- seq )
@@ -134,6 +143,9 @@ M: #dispatch child-ties ( node -- seq )
     dup node-in-d first
     swap node-children length [ <literal-tie> ] map-with ;
 
+M: #declare infer-classes* ( node -- )
+    dup node-param swap node-in-d [ set-value-class* ] 2each ;
+
 DEFER: (infer-classes)
 
 : infer-children ( node -- )
@@ -154,10 +166,20 @@ DEFER: (infer-classes)
         node-successor (infer-classes)
     ] when* ;
 
-: infer-classes ( node -- )
+: ?<hashtable> [ H{ } clone ] unless* ;
+
+: infer-classes-with ( node classes literals -- )
     [
-        H{ } clone value-classes set
-        H{ } clone value-literals set
+        ?<hashtable> value-literals set
+        ?<hashtable> value-classes set
         H{ } clone ties set
         (infer-classes)
     ] with-scope ;
+
+: infer-classes ( node -- )
+    f f infer-classes-with ;
+
+: infer-classes/node ( existing node -- )
+    #! Infer classes, using the existing node's class info as a
+    #! starting point.
+    over node-classes rot node-literals infer-classes-with ;
diff --git a/library/compiler/optimizer/inline-methods.factor b/library/compiler/optimizer/inline-methods.factor
new file mode 100644
index 0000000000..23b60df922
--- /dev/null
+++ b/library/compiler/optimizer/inline-methods.factor
@@ -0,0 +1,128 @@
+! Copyright (C) 2004, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: optimizer
+USING: arrays generic hashtables inference kernel
+kernel-internals lists math namespaces prettyprint sequences
+words ;
+
+! Some utilities for splicing in dataflow IR subtrees
+: post-inline ( #return/#values #call/#merge -- )
+    [
+        >r node-in-d r> node-out-d 2array unify-lengths first2
+    ] keep subst-values ;
+
+: ?hash-union ( hash/f hash -- hash )
+    over [ hash-union ] [ nip ] if ;
+
+: add-node-literals ( hash node -- )
+    [ node-literals ?hash-union ] keep set-node-literals ;
+
+: add-node-classes ( hash node -- )
+    [ node-classes ?hash-union ] keep set-node-classes ;
+
+: (subst-classes) ( literals classes node -- )
+    dup [
+        3dup [ add-node-classes ] keep add-node-literals
+        node-successor (subst-classes)
+    ] [
+        3drop
+    ] if ;
+
+: subst-classes ( #return/#values #call/#merge -- )
+    >r dup node-literals swap node-classes r> (subst-classes) ;
+
+: subst-node ( old new -- )
+    #! The last node of 'new' becomes 'old', then values are
+    #! substituted. A subsequent optimizer phase kills the
+    #! last node of 'new' and the first node of 'old'.
+    last-node 2dup swap 2dup post-inline subst-classes
+    set-node-successor ;
+
+: (inline-method) ( #call quot -- node )
+    dup t eq? [
+        2drop t
+    ] [
+        over node-in-d dataflow-with
+        2dup infer-classes/node
+        over node-param over remember-node
+        [ subst-node ] keep
+    ] if ;
+
+! Single dispatch method inlining optimization
+: dispatch# ( #call -- n )
+    node-param "combination" word-prop first ;
+
+: dispatching-class ( node -- seq ) dup dispatch# node-class# ;
+
+: already-inlined? ( node -- ? )
+    #! Was this node inlined from definition of 'word'?
+    dup node-param swap node-history memq? ;
+
+: specific-method ( word class -- ? ) swap order min-class ;
+
+: inlining-class ( #call -- class )
+    #! If the generic dispatch can be eliminated, return the
+    #! class of the method that will always be invoked here.
+    dup node-param swap dispatching-class specific-method ;
+
+: will-inline-method ( node -- quot/t )
+    #! t indicates failure
+    dup inlining-class dup [
+        swap node-param "methods" word-prop hash
+    ] [
+        2drop t
+    ] if ;
+
+: inline-standard-method ( node -- node )
+    dup will-inline-method (inline-method) ;
+
+: inline-standard-method? ( #call -- ? )
+    dup already-inlined? not swap node-param standard-generic?
+    and ;
+
+! Partial dispatch of 2generic words
+: math-both-known? ( word left right -- ? )
+    math-class-max specific-method ;
+
+: will-inline-math-method ( word left right -- quot/t )
+    #! t indicates failure
+    3dup math-both-known? [ math-method ] [ 3drop t ] if ;
+
+: inline-math-method ( #call -- node )
+    dup node-param over 1 node-class# pick 0 node-class#
+    will-inline-math-method (inline-method) ;
+
+: inline-math-method? ( #call -- ? )
+    dup node-history [ 2generic? ] contains? not
+    swap node-param 2generic? and ;
+
+: inline-method ( #call -- node )
+    {
+        { [ dup inline-standard-method? ] [ inline-standard-method ] }
+        { [ dup inline-math-method? ] [ inline-math-method ] }
+        { [ t ] [ drop t ] }
+    } cond ;
+
+! Resolve type checks at compile time where possible
+: comparable? ( actual testing -- ? )
+    #! If actual is a subset of testing or if the two classes
+    #! are disjoint, return t.
+    2dup class< >r classes-intersect? not r> or ;
+
+: optimize-predicate? ( #call -- ? )
+    dup node-param "predicating" word-prop dup [
+        >r 0 node-class# r> comparable?
+    ] [
+        2drop f
+    ] if ;
+
+: inline-literals ( node literals -- node )
+    #! Make #shuffle -> #push -> #return -> successor
+    over drop-inputs [
+        >r >list [ literalize ] map dataflow [ subst-node ] keep
+        r> set-node-successor
+    ] keep ;
+
+: optimize-predicate ( #call -- node )
+    dup node-param "predicating" word-prop >r
+    dup 0 node-class# r> class< 1array inline-literals ;
diff --git a/library/inference/kill-literals.factor b/library/compiler/optimizer/kill-literals.factor
similarity index 73%
rename from library/inference/kill-literals.factor
rename to library/compiler/optimizer/kill-literals.factor
index 24ac75b227..fdb970950e 100644
--- a/library/inference/kill-literals.factor
+++ b/library/compiler/optimizer/kill-literals.factor
@@ -14,11 +14,6 @@ GENERIC: literals* ( node -- seq )
 : literals ( node -- hash )
     [ literals* ] node-union ;
 
-! GENERIC: flushable-values* ( node -- seq )
-! 
-! : flushable-values ( node -- hash )
-!     [ flushable-values* ] node-union ;
-
 GENERIC: live-values* ( node -- seq )
 
 : live-values ( node -- hash )
@@ -35,36 +30,26 @@ GENERIC: live-values* ( node -- seq )
     over hash-empty?
     [ 2drop ] [ [ kill-node* ] each-node-with ] if ;
 
-: kill-unused-literals ( node -- )
-    \ live-values get over literals hash-diff swap kill-node ;
-
 : kill-values ( node -- )
     dup live-values over literals hash-diff swap kill-node ;
 
 ! Generic nodes
 M: node literals* ( node -- ) drop { } ;
 
-! M: node flushable-values* ( node -- ) drop { } ;
+M: node live-values* ( node -- seq )
+    node-in-d [ value? ] subset ;
 
-M: node live-values* ( node -- ) node-values ;
-
-! #shuffle
-M: #shuffle literals* ( node -- seq )
-    dup node-out-d swap node-out-r
-    [ [ value? ] subset ] 2apply append ;
-
-! #call
-! M: #call flushable-values* ( node -- )
-!     dup node-param "flushable" word-prop
-!     [ node-out-d ] [ drop { } ] if ;
+! #push
+M: #push literals* ( node -- seq ) node-out-d ;
 
 ! #return
 M: #return live-values* ( node -- seq )
     #! Values returned by local labels can be killed.
     dup node-param [ drop { } ] [ delegate live-values* ] if ;
 
-! nodes that don't use their input values directly
-UNION: #killable #shuffle #call-label #merge #values #entry ;
+! nodes that don't use their values directly
+UNION: #killable
+    #push #shuffle #call-label #merge #values #entry ;
 
 M: #killable live-values* ( node -- seq ) drop { } ;
 
diff --git a/library/inference/optimizer.factor b/library/compiler/optimizer/optimizer.factor
similarity index 58%
rename from library/inference/optimizer.factor
rename to library/compiler/optimizer/optimizer.factor
index 6e00fa5b0c..e738fa95a1 100644
--- a/library/inference/optimizer.factor
+++ b/library/compiler/optimizer/optimizer.factor
@@ -1,15 +1,15 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: optimizer
-USING: compiler-backend generic hashtables inference io kernel
-lists math namespaces sequences vectors ;
+USING: generic hashtables inference io kernel lists math
+namespaces sequences test vectors ;
 
 SYMBOL: optimizer-changed
 
 GENERIC: optimize-node* ( node -- node/t )
 
 : keep-optimizing ( node -- node ? )
-    dup optimize-node* dup t =
+    dup optimize-node* dup t eq?
     [ drop f ] [ nip keep-optimizing t or ] if ;
 
 : optimize-node ( node -- node )
@@ -34,24 +34,12 @@ M: f optimize-node* drop t ;
 M: node optimize-node* ( node -- t ) drop t ;
 
 ! #shuffle
-: can-compose? ( shuffle -- ? )
-    dup shuffle-in-d length swap shuffle-in-r length +
-    vregs length <= ;
-
-: compose-shuffle-nodes ( #shuffle #shuffle -- #shuffle/t )
-    [ [ node-shuffle ] 2apply compose-shuffle ] keep
-    over can-compose?
-    [ [ set-node-shuffle ] keep ] [ 2drop t ] if ;
-
 M: #shuffle optimize-node*  ( node -- node/t )
-    dup node-successor dup #shuffle? [
-        compose-shuffle-nodes
-    ] [
-        drop [
-            dup node-in-d over node-out-d sequence=
-            >r dup node-in-r swap node-out-r sequence= r> and
-        ] prune-if
-    ] if ;
+    [ node-values empty? ] prune-if ;
+
+! #push
+M: #push optimize-node*  ( node -- node/t )
+    [ node-out-d empty? ] prune-if ;
 
 ! #return
 M: #return optimize-node* ( node -- node/t )
diff --git a/library/inference/print-dataflow.factor b/library/compiler/optimizer/print-dataflow.factor
similarity index 90%
rename from library/inference/print-dataflow.factor
rename to library/compiler/optimizer/print-dataflow.factor
index 7e683e8ae8..d99d21e8c5 100644
--- a/library/inference/print-dataflow.factor
+++ b/library/compiler/optimizer/print-dataflow.factor
@@ -38,6 +38,8 @@ M: comment pprint* ( ann -- )
 M: #shuffle node>quot ( ? node -- )
     >r drop t r> dup effect-str "#shuffle: " swap append comment, ;
 
+M: #push node>quot ( ? node -- ) nip >#push< % ;
+
 DEFER: dataflow>quot
 
 : #call>quot ( ? node -- )
@@ -63,13 +65,7 @@ M: #dispatch node>quot ( ? node -- )
 M: #return node>quot ( ? node -- )
     dup node-param unparse "#return " swap append comment, ;
 
-M: #values node>quot ( ? node -- ) "#values" comment, ;
-
-M: #merge node>quot ( ? node -- ) "#merge" comment, ;
-
-M: #entry node>quot ( ? node -- ) "#entry" comment, ;
-
-M: #terminate node>quot ( ? node -- ) "#terminate" comment, ;
+M: object node>quot ( ? node -- ) dup class word-name comment, ;
 
 : (dataflow>quot) ( ? node -- )
     dup [
diff --git a/library/compiler/optimizer/specializers.factor b/library/compiler/optimizer/specializers.factor
new file mode 100644
index 0000000000..47c38a63db
--- /dev/null
+++ b/library/compiler/optimizer/specializers.factor
@@ -0,0 +1,61 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler
+USING: arrays generic hashtables kernel kernel-internals math
+namespaces sequences vectors words ;
+
+: make-standard-specializer ( quot class picker -- quot )
+    over \ object eq? [
+        2drop
+    ] [
+        [
+            , "predicate" word-prop % dup , , \ if ,
+        ] [ ] make
+    ] if ;
+
+: make-math-specializer ( quot picker -- quot )
+    [
+        , \ tag , num-tags swap <array> , \ dispatch ,
+    ] [ ] make ;
+
+: make-specializer ( quot class picker -- quot )
+    over number eq? [
+        nip make-math-specializer
+    ] [
+        make-standard-specializer
+    ] if ;
+
+: specialized-def ( word -- quot )
+    dup word-def swap "specializer" word-prop [
+        reverse-slice { dup over pick } [
+            make-specializer
+        ] 2each
+    ] when* ;
+
+{ 1+ 1- sq neg recip sgn truncate } [
+    { number } "specializer" set-word-prop
+] each
+
+{ vneg norm-sq norm normalize } [
+    { array } "specializer" set-word-prop
+] each
+
+\ n*v { object array } "specializer" set-word-prop
+\ v*n { array object } "specializer" set-word-prop
+\ n/v { object array } "specializer" set-word-prop
+\ v/n { array object } "specializer" set-word-prop
+
+{ v+ v- v* v/ vmax vmin v. } [
+    { array array } "specializer" set-word-prop
+] each
+
+{ hash* remove-hash set-hash } [
+    { hashtable } "specializer" set-word-prop
+] each
+
+{ first first2 first3 first4 }
+[ { array } "specializer" set-word-prop ] each
+
+{ peek pop* pop push } [
+    { vector } "specializer" set-word-prop
+] each
diff --git a/library/compiler/ppc/alien.factor b/library/compiler/ppc/alien.factor
deleted file mode 100644
index e63628370e..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-backend
-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 1cc3ecd964..42087dcbc2 100644
--- a/library/compiler/ppc/architecture.factor
+++ b/library/compiler/ppc/architecture.factor
@@ -1,23 +1,210 @@
-IN: compiler-backend
-USING: assembler compiler-backend kernel kernel-internals math ;
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler
+USING: alien assembler generic kernel kernel-internals math
+memory namespaces sequences words ;
 
 ! PowerPC register assignments
-! r3-r10 vregs
+! r3-r10 integer vregs
+! f0-f13 float vregs
+! r11, r12 scratch
 ! 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 ;
 M: int-regs fastcall-regs drop { 3 4 5 6 7 8 9 10 } ;
+M: int-regs vregs drop { 3 4 5 6 7 8 9 10 } ;
 
 M: float-regs return-reg drop 1 ;
 M: float-regs fastcall-regs drop { 1 2 3 4 5 6 7 8 } ;
+M: float-regs vregs drop { 0 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
 
 ! 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 -- )
+    [ v>operand ] 2apply 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 ;
+
+: %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 -- )
+    %epilogue dup postpone-word %jump-label ;
+
+: %jump-t ( label -- )
+    0 "flag" operand f address CMPI BNE ;
+
+: %dispatch ( -- )
+    "n" 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 + "scratch" operand LOAD32
+    rel-2/2 rel-address
+    "n" operand dup "scratch" operand ADD
+    "n" operand dup 0 LWZ
+    "n" operand MTLR
+    BLR ;
+
+: %return ( -- ) %epilogue BLR ;
+
+: compile-dlsym ( symbol dll register -- )
+    >r 2dup dlsym r> LOAD32 rel-2/2 rel-dlsym ;
+
+M: int-regs (%peek) ( vreg loc -- )
+    drop >r v>operand r> loc>operand LWZ ;
+
+M: float-regs (%peek) ( vreg loc -- )
+    drop fp-scratch v>operand swap loc>operand LWZ
+    fp-scratch [ v>operand ] 2apply float-offset LFD ;
+
+M: int-regs (%replace) ( vreg loc -- )
+    drop >r v>operand r> loc>operand STW ;
+
+: %move-int>int ( dst src -- )
+    [ v>operand ] 2apply MR ;
+
+: %move-int>float ( dst src -- )
+    [ v>operand ] 2apply float-offset LFD ;
+
+: load-zone-ptr ( reg -- )
+    "generations" f pick compile-dlsym dup 0 LWZ ;
+
+: load-allot-ptr ( -- )
+    12 load-zone-ptr 12 12 cell LWZ ;
+
+: save-allot-ptr ( -- )
+    11 [ load-zone-ptr 12 ] keep cell STW ;
+
+: with-inline-alloc ( prequot postquot spec -- )
+    load-allot-ptr [
+        \ tag-header get call tag-header 11 LI
+        11 12 0 STW
+        >r call 12 11 \ tag get call ORI
+        r> call 12 12 \ size get call ADDI
+    ] bind save-allot-ptr ; inline
+
+M: float-regs (%replace) ( vreg loc reg-class -- )
+    drop swap
+    [ v>operand 12 8 STFD ]
+    [ 11 swap loc>operand STW ] H{
+        { tag-header [ float-tag ] }
+        { tag [ float-tag ] }
+        { size [ 16 ] }
+    } with-inline-alloc ;
+
+: %inc-d ( n -- ) 14 14 rot cells ADDI ;
+
+: %inc-r ( n -- ) 15 15 rot cells ADDI ;
+
+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 ;
+
+: %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 ;
+
+: %alien-invoke ( symbol dll -- )
+    12 [ compile-dlsym ] keep MTLR BLRL ;
+
+: %alien-callback ( quot -- )
+    0 <int-vreg> 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 ;
+
+: %cleanup ( n -- ) drop ;
diff --git a/library/compiler/ppc/assembler.factor b/library/compiler/ppc/assembler.factor
index 2c64e2b6c8..30e5067675 100644
--- a/library/compiler/ppc/assembler.factor
+++ b/library/compiler/ppc/assembler.factor
@@ -16,6 +16,10 @@ USING: compiler errors generic kernel math memory words ;
 
 : insn ( operand opcode -- ) 26 shift bitor assemble-cell ;
 
+: a-form ( d a b c xo rc -- n )
+    >r 1 shift >r 6 shift >r 11 shift >r 16 shift >r 21 shift
+    r> bitor r> bitor r> bitor r> bitor r> bitor ;
+
 : b-form ( bo bi bd aa lk -- n )
     >r 1 shift >r 2 shift >r 16 shift >r 21 shift
     r> bitor r> bitor r> bitor r> bitor ;
@@ -26,10 +30,6 @@ USING: compiler errors generic kernel math memory words ;
 : i-form ( li aa lk -- n )
     >r 1 shift bitor r> bitor ;
 
-: m-form ( s a b mb me -- n )
-    >r 1 shift >r 6 shift >r 11 shift >r 16 shift >r 21 shift
-    r> bitor r> bitor r> bitor r> bitor r> bitor ;
-
 : x-form ( a s b xo rc -- n )
     swap
     >r 1 shift >r 11 shift >r swap 16 shift >r 21 shift
@@ -144,7 +144,7 @@ USING: compiler errors generic kernel math memory words ;
 : CMP 0 0 x-form 31 insn ;
 : CMPL 0 32 x-form 31 insn ;
 
-: (RLWINM) m-form 21 insn ;
+: (RLWINM) a-form 21 insn ;
 : RLWINM 0 (RLWINM) ;  : RLWINM. 1 (RLWINM) ;
 
 : SLWI 0 31 pick - RLWINM ;  : SLWI. 0 31 pick - RLWINM. ;
@@ -193,10 +193,31 @@ M: word BC >r 0 BC r> relative-2 ;
    >r dup -32768 32767 between? [ r> LI ] [ r> LOAD32 ] if ;
 
 ! Floating point
-: (FMR) >r 0 -rot 72 r> x-form 63 insn ;
-: FMR 0 (FMR) ;  : FMR. 1 (FMR) ;
-
 : LFS d-form 48 insn ;  : LFSU d-form 49 insn ;
 : LFD d-form 50 insn ;  : LFDU d-form 51 insn ;
 : STFS d-form 52 insn ; : STFSU d-form 53 insn ;
 : STFD d-form 54 insn ; : STFDU d-form 55 insn ;
+
+: (FMR) >r 0 -rot 72 r> x-form 63 insn ;
+: FMR 0 (FMR) ;  : FMR. 1 (FMR) ;
+
+: (FCTIWZ) >r 0 -rot 15 r> x-form 63 insn ;
+: FCTIWZ 0 (FCTIWZ) ;  : FCTIWZ. 1 (FCTIWZ) ;
+
+: (FADD) >r 0 21 r> a-form 63 insn ;
+: FADD 0 (FADD) ;  : FADD. 1 (FADD) ;
+
+: (FSUB) >r 0 20 r> a-form 63 insn ;
+: FSUB 0 (FSUB) ;  : FSUB. 1 (FSUB) ;
+
+: (FMUL) >r 0 swap 25 r> a-form 63 insn ;
+: FMUL 0 (FMUL) ;  : FMUL. 1 (FMUL) ;
+
+: (FDIV) >r 0 18 r> a-form 63 insn ;
+: FDIV 0 (FDIV) ;  : FDIV. 1 (FDIV) ;
+
+: (FSQRT) >r 0 swap 0 22 r> a-form 63 insn ;
+: FSQRT 0 (FSQRT) ;  : FSQRT. 1 (FSQRT) ;
+
+: FCMPU 0 0 x-form 63 insn ;
+: FCMPO 0 32 x-form 63 insn ;
diff --git a/library/compiler/ppc/fixnum.factor b/library/compiler/ppc/fixnum.factor
deleted file mode 100644
index 0aeadb66ba..0000000000
--- a/library/compiler/ppc/fixnum.factor
+++ /dev/null
@@ -1,129 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-backend
-USING: assembler compiler 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- 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 2b9b391646..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-backend
-USING: alien assembler compiler compiler-frontend 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..a958c3768d
--- /dev/null
+++ b/library/compiler/ppc/intrinsics.factor
@@ -0,0 +1,332 @@
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler
+USING: alien assembler kernel kernel-internals math
+math-internals namespaces sequences words ;
+
+: untag ( dest src -- ) 0 0 31 tag-bits - RLWINM ;
+
+: tag-fixnum ( src dest -- ) tag-bits SLWI ;
+
+: untag-fixnum ( src dest -- ) tag-bits SRAWI ;
+
+: 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
+
+: generate-set-slot ( size quot -- )
+    >r >r
+    ! turn tagged fixnum slot # into an offset, multiple of 4
+    "slot" operand dup tag-bits r> - SRAWI
+    ! compute slot address in 1st input
+    "slot" operand dup "obj" operand ADD
+    ! store new slot value
+    "val" operand "slot" operand r> call ; inline
+
+: generate-write-barrier ( -- )
+    #! Mark the card pointed to by vreg.
+    "obj" operand dup card-bits SRAWI
+    "obj" operand dup 16 ADD
+    "x" operand "obj" operand 0 LBZ
+    "x" operand dup card-mark ORI
+    "x" operand "obj" operand 0 STB ;
+
+\ set-slot [
+    "obj" operand dup untag
+    cell log2 [ 0 STW ] generate-set-slot generate-write-barrier
+] H{
+    { +input { { f "val" } { f "obj" } { f "slot" } } }
+    { +scratch { { f "x" } } }
+    { +clobber { "obj" "slot" } }
+} define-intrinsic
+
+\ set-char-slot [
+    ! untag the new value in 0th input
+    "val" operand dup untag-fixnum
+    1 [ string-offset STH ] generate-set-slot
+] H{
+    { +input { { f "val" } { f "slot" } { f "obj" } } }
+    { +scratch { { f "x" } } }
+    { +clobber { "val" "slot" "obj" } }
+} define-intrinsic
+
+: define-fixnum-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-fixnum-op
+] each
+
+: generate-fixnum-mod
+    #! PowerPC doesn't have a MOD instruction; so we compute
+    #! x-(x/y)*y. Puts the result in "s" operand.
+    "s" operand "r" operand "y" operand MULLW
+    "s" operand "s" operand "x" operand SUBF ;
+
+\ fixnum-mod [
+    ! divide x by y, store result in x
+    "r" operand "x" operand "y" operand DIVW
+    generate-fixnum-mod
+] H{
+    { +input { { f "x" } { f "y" } } }
+    { +scratch { { f "r" } { f "s" } } }
+    { +output { "s" } }
+} define-intrinsic
+
+\ fixnum-bitnot [
+    "x" operand dup NOT
+    "x" operand dup untag
+] H{
+    { +input { { f "x" } } }
+    { +output { "x" } }
+} define-intrinsic
+
+: define-fixnum-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-fixnum-jump
+] each
+
+: simple-overflow ( word -- )
+    >r
+    <label> "end" set
+    "end" get BNO
+    { "x" "y" } [ operand ] map prune [ dup untag-fixnum ] each
+    3 "y" operand "x" operand r> execute
+    "s48_long_to_bignum" f %alien-invoke
+    ! An untagged pointer to the bignum is now in r3; tag it
+    3 "r" operand bignum-tag ORI
+    "end" get save-xt ; inline
+
+\ fixnum+ [
+    finalize-contents
+    0 MTXER
+    "r" operand "y" operand "x" operand ADDO.
+    \ ADD simple-overflow
+] H{
+    { +input { { f "x" } { f "y" } } }
+    { +scratch { { f "r" } } }
+    { +output { "r" } }
+    { +clobber { "x" "y" } }
+} define-intrinsic
+
+\ fixnum- [
+    finalize-contents
+    0 MTXER
+    "r" operand "y" operand "x" operand SUBFO.
+    \ SUBF simple-overflow
+] H{
+    { +input { { f "x" } { f "y" } } }
+    { +scratch { { f "r" } } }
+    { +output { "r" } }
+    { +clobber { "x" "y" } }
+} define-intrinsic
+
+\ fixnum* [
+    finalize-contents
+    <label> "end" set
+    "r" operand "x" operand untag-fixnum
+    0 MTXER
+    12 "y" operand "r" operand MULLWO.
+    "end" get BNO
+    4 "y" operand "r" operand MULHW
+    3 12 MR
+    "s48_fixnum_pair_to_bignum" f %alien-invoke
+    ! now we have to shift it by three bits to remove the second
+    ! tag
+    tag-bits neg 4 LI
+    "s48_bignum_arithmetic_shift" f %alien-invoke
+    ! An untagged pointer to the bignum is now in r3; tag it
+    3 12 bignum-tag ORI
+    "end" get save-xt
+    "s" operand 12 MR
+] H{
+    { +input { { f "x" } { f "y" } } }
+    { +scratch { { f "r" } { f "s" } } }
+    { +output { "s" } }
+    { +clobber { "x" "y" } }
+} define-intrinsic
+
+: generate-fixnum/i
+    #! This VOP is funny. If there is an overflow, it falls
+    #! through to the end, and the result is in "x" operand.
+    #! Otherwise it jumps to the "no-overflow" label and the
+    #! result is in "r" operand.
+    <label> "end" set
+    <label> "no-overflow" set
+    "r" operand "x" operand "y" 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.
+    most-positive-fixnum "s" operand LOAD
+    "r" operand 0 "s" operand CMP
+    "no-overflow" get BLE
+    most-negative-fixnum neg 3 LOAD
+    "s48_long_to_bignum" f %alien-invoke
+    "x" operand 3 bignum-tag ORI ;
+
+\ fixnum/i [
+    finalize-contents
+    generate-fixnum/i
+    "end" get B
+    "no-overflow" get save-xt
+    "r" operand "x" operand tag-fixnum
+    "end" get save-xt
+] H{
+    { +input { { f "x" } { f "y" } } }
+    { +scratch { { f "r" } { f "s" } } }
+    { +output { "x" } }
+    { +clobber { "y" } }
+} define-intrinsic
+
+\ fixnum/mod [
+    finalize-contents
+    generate-fixnum/i
+    0 "s" operand LI
+    "end" get B
+    "no-overflow" get save-xt
+    generate-fixnum-mod
+    "r" operand "x" operand tag-fixnum
+    "end" get save-xt
+] H{
+    { +input { { f "x" } { f "y" } } }
+    { +scratch { { f "r" } { f "s" } } }
+    { +output { "x" "s" } }
+    { +clobber { "y" } }
+} define-intrinsic
+
+: define-float-op ( word op -- )
+    [ [ "x" operand "x" operand "y" operand ] % , ] [ ] make H{
+        { +input { { float "x" } { float "y" } } }
+        { +output { "x" } }
+    } define-intrinsic ;
+
+{
+    { float+ FADD }
+    { float- FSUB }
+    { float* FMUL }
+    { float/f FDIV }
+} [
+    first2 define-float-op
+] each
+
+: define-float-jump ( word op -- )
+    [
+        [ end-basic-block "x" operand 0 "y" operand FCMPU ] % ,
+     ] [ ] make H{ { +input { { float "x" } { float "y" } } } }
+    define-if-intrinsic ;
+
+{
+    { float< BLT }
+    { float<= BLE }
+    { float> BGT }
+    { float>= BGE }
+    { float= BEQ }
+} [
+    first2 define-float-jump
+] each
+
+\ tag [
+    "in" operand "out" operand tag-mask ANDI
+    "out" operand dup tag-fixnum
+] H{
+    { +input { { f "in" } } }
+    { +scratch { { f "out" } } }
+    { +output { "out" } }
+} define-intrinsic
+
+\ type [
+    <label> "f" set
+    <label> "end" set
+    ! Get the tag
+    "obj" operand "y" operand tag-mask ANDI
+    ! Tag the tag
+    "y" operand "x" operand tag-fixnum
+    ! Compare with object tag number (3).
+    0 "y" operand 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 "obj" operand object-tag CMPI
+    "f" get BEQ
+    ! The pointer is not equal to 3. Load the object header.
+    "x" operand "obj" operand object-tag neg LWZ
+    "x" operand dup untag
+    "end" get B
+    "f" get save-xt
+    ! The pointer is equal to 3. Load F_TYPE (9).
+    f type tag-bits shift "x" operand LI
+    "end" get save-xt
+] H{
+    { +input { { f "obj" } } }
+    { +scratch { { f "x" } { f "y" } } }
+    { +output { "x" } }
+} define-intrinsic
+
+: userenv ( reg -- )
+    #! Load the userenv pointer in a register.
+    "userenv" f dlsym swap LOAD32 0 rel-2/2 rel-userenv ;
+
+\ getenv [
+    "n" operand dup 1 SRAWI
+    "x" operand userenv
+    "x" operand "n" operand "x" operand ADD
+    "x" operand dup 0 LWZ
+] H{
+    { +input { { f "n" } } }
+    { +scratch { { f "x" } } }
+    { +output { "x" } }
+    { +clobber { "n" } }
+} define-intrinsic
+
+\ setenv [
+    "n" operand dup 1 SRAWI
+    "x" operand userenv
+    "x" operand "n" operand "x" operand ADD
+    "val" operand "x" operand 0 STW
+] H{
+    { +input { { f "val" } { f "n" } } }
+    { +scratch { { f "x" } } }
+    { +clobber { "n" } }
+} define-intrinsic
diff --git a/library/compiler/ppc/slots.factor b/library/compiler/ppc/slots.factor
deleted file mode 100644
index b6e385ea41..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-backend
-USING: alien assembler compiler 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 167b617740..0000000000
--- a/library/compiler/ppc/stack.factor
+++ /dev/null
@@ -1,31 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-backend
-USING: assembler compiler 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 ;
-
-M: %immediate generate-node ( vop -- )
-    drop 0 input address 0 output-operand LOAD ;
-
-: load-indirect ( dest literal -- )
-    add-literal over LOAD32 rel-2/2 rel-address dup 0 LWZ ;
-
-M: %indirect generate-node ( vop -- )
-    drop 0 output-operand 0 input load-indirect ;
-
-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 22e4ba42e8..0000000000
--- a/library/compiler/stack.factor
+++ /dev/null
@@ -1,92 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-frontend
-USING: compiler-backend generic inference kernel math namespaces
-sequences vectors words ;
-
-: immediate? ( obj -- ? )
-    #! fixnums and f have a pointerless representation, and
-    #! are compiled immediately. Everything else can be moved
-    #! by GC, and is indexed through a table.
-    dup fixnum? swap f eq? or ;
-
-GENERIC: load-value ( vreg n value -- )
-
-M: object load-value ( vreg n value -- )
-    drop %peek-d , ;
-
-: load-literal ( vreg obj -- )
-    dup immediate? [ %immediate ] [ %indirect ] if , ;
-
-M: value load-value ( vreg n value -- )
-    nip value-literal load-literal ;
-
-SYMBOL: vreg-allocator
-SYMBOL: live-d
-SYMBOL: live-r
-
-: value-dropped? ( value -- ? )
-    dup value?
-    over live-d get member? not
-    rot live-r get member? not and
-    or ;
-
-: stack>vreg ( value stack-pos loader -- )
-    pick >r vreg-allocator get r> set
-    pick value-dropped? [ pick get pick pick execute , ] unless
-    3drop vreg-allocator inc ; inline
-
-: (stacks>vregs) ( stack loader -- )
-    swap reverse-slice dup length
-    [ pick stack>vreg ] 2each drop ; inline
-
-: stacks>vregs ( #shuffle -- )
-    dup
-    node-in-d \ %peek-d (stacks>vregs)
-    node-in-r \ %peek-r (stacks>vregs) ;
-
-: shuffle-height ( #shuffle -- )
-    dup node-out-d length over node-in-d length - %inc-d ,
-    dup node-out-r length swap node-in-r length - %inc-r , ;
-
-: literal>stack ( stack-pos value storer -- )
-    >r value-literal r> fixnum-imm? pick immediate? and [
-        >r 0 swap load-literal 0 <vreg> r>
-    ] unless swapd execute , ; inline
-
-: computed>stack >r get <vreg> swap r> execute , ;
-
-: vreg>stack ( stack-pos value storer -- )
-    {
-        { [ over not ] [ 3drop ] }
-        { [ over value? ] [ literal>stack ] }
-        { [ t ] [ computed>stack ] }
-    } cond ; inline
-
-: (vregs>stack) ( stack storer -- )
-    swap reverse-slice [ length ] keep
-    [ pick vreg>stack ] 2each drop ; inline
-
-: (vregs>stacks) ( stack stack -- )
-    \ %replace-r (vregs>stack) \ %replace-d (vregs>stack) ;
-
-: literals/computed ( stack -- literals computed )
-    dup [ dup value? [ drop f ] unless ] map
-    swap [ dup value? [ drop f ] when ] map ;
-
-: vregs>stacks ( -- )
-    live-d get literals/computed
-    live-r get literals/computed
-    swapd (vregs>stacks) (vregs>stacks) ;
-
-: live-stores ( instack outstack -- stack )
-    #! Avoid storing a value into its former position.
-    dup length [ pick ?nth dupd eq? [ drop f ] when ] 2map nip ;
-
-M: #shuffle linearize* ( #shuffle -- )
-    [
-        0 vreg-allocator set
-        dup node-in-d over node-out-d live-stores live-d set
-        dup node-in-r over node-out-r live-stores live-r set
-        dup stacks>vregs shuffle-height vregs>stacks
-    ] with-scope iterate-next ;
diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor
deleted file mode 100644
index aa31799bed..0000000000
--- a/library/compiler/vops.factor
+++ /dev/null
@@ -1,394 +0,0 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-backend
-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 ;
-
-! A data stack location.
-TUPLE: ds-loc n ;
-
-! A call stack location.
-TUPLE: cs-loc n ;
-
-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 ;
-
-GENERIC: basic-block? ( vop -- ? )
-M: vop basic-block? drop f ;
-
-! simplifies some code
-M: f basic-block? drop f ;
-
-: 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> ;
-
-! Return vops take a label that is ignored, to have the
-! same stack effect as jumps. This is needed for the
-! simplifier.
-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 <vreg> label/src-vop <%jump-t> ;
-
-! dispatch tables
-TUPLE: %dispatch ;
-C: %dispatch make-vop ;
-: %dispatch <vreg> 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 ;
-
-M: %peek basic-block? drop t ;
-
-: %peek swap <vreg> src/dest-vop <%peek> ;
-
-: %peek-d ( vreg n -- vop ) <ds-loc> %peek ;
-
-: %peek-r ( vreg n -- vop ) <cs-loc> %peek ;
-
-TUPLE: %replace ;
-C: %replace make-vop ;
-
-M: %replace basic-block? drop t ;
-
-: %replace ( vreg loc -- vop ) src/dest-vop <%replace> ;
-
-: %replace-d ( vreg n -- vop ) <ds-loc> %replace ;
-
-: %replace-r ( vreg n -- vop ) <cs-loc> %replace ;
-
-TUPLE: %inc-d ;
-C: %inc-d make-vop ;
-: %inc-d ( n -- node ) src-vop <%inc-d> ;
-
-M: %inc-d basic-block? drop t ;
-
-TUPLE: %inc-r ;
-
-C: %inc-r make-vop ;
-
-: %inc-r ( n -- ) src-vop <%inc-r> ;
-
-M: %inc-r basic-block? drop t ;
-
-TUPLE: %immediate ;
-C: %immediate make-vop ;
-
-: %immediate ( vreg obj -- vop )
-    swap <vreg> src/dest-vop <%immediate> ;
-
-M: %immediate basic-block? drop t ;
-
-! indirect load of a literal through a table
-TUPLE: %indirect ;
-C: %indirect make-vop ;
-: %indirect ( vreg obj -- )
-    swap <vreg> src/dest-vop <%indirect> ;
-M: %indirect basic-block? drop t ;
-
-! object slot accessors
-TUPLE: %untag ;
-C: %untag make-vop ;
-: %untag <vreg> dest-vop <%untag> ;
-M: %untag basic-block? drop t ;
-
-: slot-vop [ <vreg> ] 2apply 2-vop ;
-
-TUPLE: %slot ;
-C: %slot make-vop ;
-: %slot ( n vreg ) slot-vop <%slot> ;
-M: %slot basic-block? drop t ;
-
-: set-slot-vop
-    rot <vreg> rot <vreg> rot <vreg> dup >r 3array r> 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> ;
-
-M: %set-slot basic-block? drop t ;
-
-! 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 ( vreg n )
-    swap <vreg> 2-vop <%fast-slot> ;
-M: %fast-slot basic-block? drop t ;
-
-TUPLE: %fast-set-slot ;
-C: %fast-set-slot make-vop ;
-: %fast-set-slot ( value obj n )
-    #! %fast-set-slot writes to vreg obj.
-    >r >r <vreg> r> <vreg> r> over >r 3array r> 1array f
-    <%fast-set-slot> ;
-M: %fast-set-slot basic-block? drop t ;
-
-! Char readers and writers
-TUPLE: %char-slot ;
-C: %char-slot make-vop ;
-: %char-slot ( n vreg ) slot-vop <%char-slot> ;
-M: %char-slot basic-block? drop t ;
-
-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> ;
-
-M: %set-char-slot basic-block? drop t ;
-
-TUPLE: %write-barrier ;
-C: %write-barrier make-vop ;
-: %write-barrier ( ptr ) <vreg> dest-vop <%write-barrier> ;
-
-! fixnum intrinsics
-TUPLE: %fixnum+ ;
-C: %fixnum+ make-vop ;       : %fixnum+ 3-vop <%fixnum+> ;
-TUPLE: %fixnum- ;
-C: %fixnum- make-vop ;       : %fixnum- 3-vop <%fixnum-> ;
-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> ;
-M: %fixnum-bitand basic-block? drop t ;
-
-TUPLE: %fixnum-bitor ;
-C: %fixnum-bitor make-vop ;  : %fixnum-bitor 3-vop <%fixnum-bitor> ;
-M: %fixnum-bitor basic-block? drop t ;
-
-TUPLE: %fixnum-bitxor ;
-C: %fixnum-bitxor make-vop ; : %fixnum-bitxor 3-vop <%fixnum-bitxor> ;
-M: %fixnum-bitxor basic-block? drop t ;
-
-TUPLE: %fixnum-bitnot ;
-C: %fixnum-bitnot make-vop ; : %fixnum-bitnot 2-vop <%fixnum-bitnot> ;
-M: %fixnum-bitnot basic-block? drop t ;
-
-! 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>>> ;
-M: %fixnum>> basic-block? drop t ;
-
-! 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> ;
-M: %fixnum-sgn basic-block? drop t ;
-
-! 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 ) <vreg> dest-vop <%type> ;
-
-TUPLE: %tag ;
-C: %tag make-vop ;
-: %tag ( vreg ) <vreg> dest-vop <%tag> ;
-M: %tag basic-block? drop t ;
-
-TUPLE: %getenv ;
-C: %getenv make-vop ;
-: %getenv swap src/dest-vop <%getenv> ;
-M: %getenv basic-block? drop t ;
-
-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/alien.factor b/library/compiler/x86/alien.factor
index 183106dba0..e55d03e774 100644
--- a/library/compiler/x86/alien.factor
+++ b/library/compiler/x86/alien.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-backend
-USING: alien arrays assembler compiler inference kernel
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler
+USING: alien arrays assembler inference kernel
 kernel-internals lists math memory namespaces words ;
 
 GENERIC: push-return-reg ( reg-class -- )
@@ -27,58 +27,55 @@ M: float-regs pop-return-reg
 M: float-regs load-return-reg
     reg-size >r ESP swap [+] r> FLD ;
 
-M: %unbox generate-node
-    drop 2 input f compile-c-call  1 input push-return-reg ;
+: %unbox ( n reg-class func -- )
+    f %alien-invoke push-return-reg drop ;
 
-: struct-ptr/size ( func -- )
+: struct-ptr/size ( size func -- )
     ! Load struct size
-    2 input PUSH
+    swap PUSH
     ! Load destination address
     EAX PUSH
     ! Copy the struct to the stack
-    f compile-c-call
+    f %alien-invoke
     ! Clean up
     EAX POP
     ECX POP ;
 
-M: %unbox-struct generate-node ( vop -- )
-    drop
+: %unbox-struct ( n reg-class size -- )
+    2nip
     ! Increase stack size
-    ESP 2 input SUB
+    ESP over SUB
     ! Save destination address in EAX
     EAX ESP MOV
     "unbox_value_struct" struct-ptr/size ;
 
-M: %box-struct generate-node ( vop -- )
+: %box-struct ( n reg-class size -- )
+    2nip
     ! Compute source address in EAX
     EAX ESP MOV
     EAX 4 ADD
-    drop "box_value_struct" struct-ptr/size ;
+    "box_value_struct" struct-ptr/size ;
 
-M: %box generate-node
-    drop
-    0 input [ 4 + 1 input load-return-reg ] when*
-    1 input push-return-reg
-    2 input f compile-c-call
-    1 input drop-return-reg ;
+: %box ( n reg-class func -- )
+    rot [ 4 + pick load-return-reg ] when*
+    over push-return-reg
+    f %alien-invoke
+    drop-return-reg ;
 
-M: %alien-callback generate-node ( vop -- )
-    drop
-    EAX 0 input load-indirect
+: %alien-callback ( quot -- )
+    0 <int-vreg> load-literal
     EAX PUSH
-    "run_callback" f compile-c-call
+    "run_callback" f %alien-invoke
     EAX POP ;
 
-M: %callback-value generate-node ( vop -- )
-    drop
+: %callback-value ( reg-class func -- )
     ! Call the unboxer
-    1 input f compile-c-call
+    f %alien-invoke
     ! Save return register
-    0 input push-return-reg
+    dup push-return-reg
     ! Restore data/callstacks
-    "unnest_stacks" f compile-c-call
+    "unnest_stacks" f %alien-invoke
     ! Restore return register
-    0 input pop-return-reg ;
+    pop-return-reg ;
 
-M: %cleanup generate-node
-    drop 0 input dup zero? [ drop ] [ ESP swap ADD ] if ;
+: %cleanup ( n -- ) dup zero? [ drop ] [ ESP swap ADD ] if ;
diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor
index 20db81c388..aeb4c52030 100644
--- a/library/compiler/x86/architecture.factor
+++ b/library/compiler/x86/architecture.factor
@@ -1,35 +1,42 @@
-IN: compiler-backend
-USING: alien arrays assembler compiler compiler-backend generic
-kernel kernel-internals sequences words ;
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien arrays assembler generic kernel kernel-internals
+math memory namespaces sequences words ;
+IN: compiler
 
 ! x86 register assignments
-! EAX, ECX, EDX vregs
+! EAX, ECX, EDX integer vregs
+! XMM0 - XMM7 float vregs
 ! ESI datastack
 ! EBX callstack
 
-: fixnum-imm? ( -- ? )
-    #! Can fixnum operations take immediate operands?
-    t ; inline
+! AMD64 redefines a lot of words in this file
 
 : ds-reg ESI ; inline
 : cs-reg EBX ; inline
 : remainder-reg EDX ; inline
+: alloc-tmp-reg EDI ; inline
 
-: vregs { EAX ECX EDX } ; inline
+: reg-stack ( n reg -- op ) swap cells neg [+] ;
 
-: compile-c-call ( symbol dll -- )
+M: ds-loc v>operand ds-loc-n ds-reg reg-stack ;
+M: cs-loc v>operand cs-loc-n cs-reg reg-stack ;
+
+: %alien-invoke ( symbol dll -- )
     2dup dlsym CALL rel-relative rel-dlsym ;
 
 : compile-c-call* ( symbol dll args -- operands )
     reverse-slice
-    [ [ PUSH ] each compile-c-call ] keep
+    [ [ PUSH ] each %alien-invoke ] keep
     [ drop EDX POP ] each ;
 
 ! On x86, parameters are never passed in registers.
 M: int-regs return-reg drop EAX ;
 M: int-regs fastcall-regs drop { } ;
+M: int-regs vregs drop { EAX ECX EDX } ;
 
 M: float-regs fastcall-regs drop { } ;
+M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
 
 : address-operand ( address -- operand )
     #! On x86, we can always use an address as an operand
@@ -40,9 +47,61 @@ M: float-regs fastcall-regs drop { } ;
 
 : prepare-division CDQ ; inline
 
-: compile-prologue ; inline
+M: immediate load-literal ( literal vreg -- )
+    v>operand swap v>operand MOV ;
 
-: compile-epilogue ; inline
+M: object load-literal ( literal vreg -- )
+    v>operand swap add-literal [] MOV
+    rel-absolute-cell rel-address ;
 
-: load-indirect ( dest literal -- )
-    add-literal [] MOV rel-absolute-cell rel-address ; inline
+: (%call) ( label -- label )
+    dup postpone-word dup primitive? [ address-operand ] when ;
+
+: %call ( label -- ) (%call) CALL ;
+
+: %jump ( label -- ) %epilogue (%call) JMP ;
+
+: %jump-label ( label -- ) JMP ;
+
+: %jump-t ( label -- ) "flag" operand f v>operand CMP JNE ;
+
+: %dispatch ( -- )
+    #! 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.
+    <label> "end" set
+    ! Untag and multiply to get a jump table offset
+    "n" operand fixnum>slot@
+    ! Add to jump table base. We use a temporary register since
+    ! on AMD4 we have to load a 64-bit immediate. On x86, this
+    ! is redundant.
+    "scratch" operand HEX: ffffffff MOV "end" get absolute-cell
+    "n" operand "scratch" operand ADD
+    ! Jump to jump table entry
+    "n" operand [] JMP
+    ! Align for better performance
+    compile-aligned
+    ! Fix up jump table pointer
+    "end" get save-xt ;
+
+: %return ( -- ) %epilogue RET ;
+
+: %move-int>int ( dst src -- )
+    [ v>operand ] 2apply MOV ;
+
+: %move-int>float ( dst src -- )
+    [ v>operand ] 2apply float-offset [+] MOVSD ;
+
+M: int-regs (%peek) drop %move-int>int ;
+
+M: int-regs (%replace) drop swap %move-int>int ;
+
+: (%inc) swap cells dup 0 > [ ADD ] [ neg SUB ] if ;
+
+: %inc-d ( n -- ) ds-reg (%inc) ;
+
+: %inc-r ( n -- ) cs-reg (%inc) ;
+
+M: object %stack>freg ( n reg reg-class -- ) 3drop ;
+
+M: object %freg>stack ( n reg reg-class -- ) 3drop ;
diff --git a/library/compiler/x86/assembler.factor b/library/compiler/x86/assembler.factor
index 8521eb4aa0..02f626b08a 100644
--- a/library/compiler/x86/assembler.factor
+++ b/library/compiler/x86/assembler.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: assembler
 USING: arrays compiler errors generic kernel kernel-internals
 lists math namespaces parser sequences words ;
+IN: assembler
 
 ! A postfix assembler for x86 and AMD64.
 
@@ -286,28 +286,28 @@ M: integer CALL HEX: e8 assemble-1 from assemble-4 ;
 M: callable CALL 0 CALL relative-4 ;
 M: operand CALL BIN: 010 t HEX: ff 1-operand ;
 
-GENERIC: JUMPcc ( opcode addr -- )
-M: integer JUMPcc ( opcode addr -- )
-    HEX: 0f assemble-1  swap assemble-1  from assemble-4 ;
-M: callable JUMPcc ( opcode addr -- )
-    >r 0 JUMPcc r> relative-4 ;
+G: JUMPcc ( addr opcode -- ) 1 standard-combination ;
+M: integer JUMPcc ( addr opcode -- )
+    swap HEX: 0f assemble-1  swap assemble-1  from assemble-4 ;
+M: callable JUMPcc ( addr opcode -- )
+    swap >r 0 swap JUMPcc r> relative-4 ;
 
-: JO  HEX: 80 swap JUMPcc ;
-: JNO HEX: 81 swap JUMPcc ;
-: JB  HEX: 82 swap JUMPcc ;
-: JAE HEX: 83 swap JUMPcc ;
-: JE  HEX: 84 swap JUMPcc ; ! aka JZ
-: JNE HEX: 85 swap JUMPcc ;
-: JBE HEX: 86 swap JUMPcc ;
-: JA  HEX: 87 swap JUMPcc ;
-: JS  HEX: 88 swap JUMPcc ;
-: JNS HEX: 89 swap JUMPcc ;
-: JP  HEX: 8a swap JUMPcc ;
-: JNP HEX: 8b swap JUMPcc ;
-: JL  HEX: 8c swap JUMPcc ;
-: JGE HEX: 8d swap JUMPcc ;
-: JLE HEX: 8e swap JUMPcc ;
-: JG  HEX: 8f swap JUMPcc ;
+: JO  HEX: 80 JUMPcc ;
+: JNO HEX: 81 JUMPcc ;
+: JB  HEX: 82 JUMPcc ;
+: JAE HEX: 83 JUMPcc ;
+: JE  HEX: 84 JUMPcc ; ! aka JZ
+: JNE HEX: 85 JUMPcc ;
+: JBE HEX: 86 JUMPcc ;
+: JA  HEX: 87 JUMPcc ;
+: JS  HEX: 88 JUMPcc ;
+: JNS HEX: 89 JUMPcc ;
+: JP  HEX: 8a JUMPcc ;
+: JNP HEX: 8b JUMPcc ;
+: JL  HEX: 8c JUMPcc ;
+: JGE HEX: 8d JUMPcc ;
+: JLE HEX: 8e JUMPcc ;
+: JG  HEX: 8f JUMPcc ;
 
 : RET ( -- ) HEX: c3 assemble-1 ;
 
@@ -374,12 +374,20 @@ M: operand CMP OCT: 071 2-operand ;
 ( SSE multimedia instructions )
 
 : 2-operand-sse ( dst src op1 op2 -- )
-    pick register-128? [ nip ] [ drop swapd ] if
+    #! We swap the operands here to make everything consistent
+    #! with the integer instructions.
+    swap assemble-1 pick register-128? [ swapd ] [ 1 bitor ] if
     >r 2dup t prefix HEX: 0f assemble-1 r>
     assemble-1 reg-code swap addressing ;
 
-: MOVLPD ( dest src -- )
-    HEX: 66 assemble-1 HEX: 12 HEX: 13 2-operand-sse ;
-
-: MOVSS ( dest src -- )
-    HEX: f3 assemble-1 HEX: 10 HEX: 11 2-operand-sse ;
+: MOVSS ( dest src -- ) HEX: f3 HEX: 10 2-operand-sse ;
+: MOVSD ( dest src -- ) HEX: f2 HEX: 10 2-operand-sse ;
+: ADDSD ( dest src -- ) HEX: f2 HEX: 58 2-operand-sse ;
+: MULSD ( dest src -- ) HEX: f2 HEX: 59 2-operand-sse ;
+: SUBSD ( dest src -- ) HEX: f2 HEX: 5c 2-operand-sse ;
+: DIVSD ( dest src -- ) HEX: f2 HEX: 5e 2-operand-sse ;
+: SQRTSD ( dest src -- ) HEX: f2 HEX: 51 2-operand-sse ;
+: UCOMISD ( dest src -- ) HEX: 66 HEX: 2e 2-operand-sse ;
+: COMISD ( dest src -- ) HEX: 66 HEX: 2f 2-operand-sse ;
+: CVTSI2SD ( dest src -- ) HEX: f2 HEX: 2a 2-operand-sse ;
+: CVTSD2SI ( dest src -- ) HEX: f2 HEX: 2d 2-operand-sse ;
diff --git a/library/compiler/x86/fixnum.factor b/library/compiler/x86/fixnum.factor
deleted file mode 100644
index 05a61362c0..0000000000
--- a/library/compiler/x86/fixnum.factor
+++ /dev/null
@@ -1,129 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-backend
-USING: arrays assembler compiler errors kernel kernel-internals
-math math-internals memory namespaces words ;
-
-: literal-overflow ( -- dest src )
-    #! Called if the src operand is a literal.
-    #! Untag the dest operand.
-    dest/src over tag-bits SAR tag-bits neg shift ;
-
-: computed-overflow ( -- dest src )
-    #! Called if the src operand is a register.
-    #! Untag both operands.
-    dest/src 2dup tag-bits SAR tag-bits SAR ;
-
-: simple-overflow ( inverse word -- )
-    #! If the previous arithmetic operation overflowed, then we
-    #! turn the result into a bignum and leave it in EAX.
-    <label> "end" set
-    "end" get JNO
-    ! There was an overflow. Recompute the original operand.
-    >r >r dest/src r> execute
-    0 input integer? [ literal-overflow ] [ computed-overflow ] if
-    ! Compute a result, this time it will fit.
-    r> execute
-    ! Create a bignum.
-    "s48_long_to_bignum" f 0 output-operand
-    1array compile-c-call*
-    ! An untagged pointer to the bignum is now in EAX; tag it
-    T{ int-regs } return-reg bignum-tag OR
-    "end" get save-xt ; inline
-
-M: %fixnum+ generate-node ( vop -- )
-    drop dest/src ADD  \ SUB \ ADD simple-overflow ;
-
-M: %fixnum- generate-node ( vop -- )
-    drop dest/src SUB  \ ADD \ SUB simple-overflow ;
-
-M: %fixnum* generate-node ( vop -- )
-    drop
-    ! both inputs are tagged, so one of them needs to have its
-    ! tag removed.
-    1 input-operand tag-bits SAR
-    0 input-operand IMUL
-    <label> "end" set
-    "end" get JNO
-    "s48_fixnum_pair_to_bignum" f
-    1 input-operand remainder-reg 2array compile-c-call*
-    ! now we have to shift it by three bits to remove the second
-    ! tag
-    "s48_bignum_arithmetic_shift" f
-    1 input-operand tag-bits neg 2array compile-c-call*
-    ! an untagged pointer to the bignum is now in EAX; tag it
-    T{ int-regs } return-reg bignum-tag OR
-    "end" get save-xt ;
-
-M: %fixnum-mod generate-node ( vop -- )
-    #! This has specific register requirements. Inputs are in
-    #! ECX and EAX, and the result is in EDX.
-    drop
-    prepare-division
-    0 input-operand IDIV ;
-
-: generate-fixnum/mod
-    #! The same code is used for %fixnum/i and %fixnum/mod.
-    #! This has specific register requirements. Inputs are in
-    #! ECX and EAX, and the result is in EDX.
-    <label> "end" set
-    prepare-division
-    0 input-operand IDIV
-    ! Make a copy since following shift is destructive
-    0 input-operand 1 input-operand MOV
-    ! Tag the value, since division cancelled tags from both
-    ! inputs
-    1 input-operand tag-bits SHL
-    ! Did it overflow?
-    "end" get JNO
-    ! There was an overflow, so make ECX into a bignum. we must
-    ! save EDX since its volatile.
-    remainder-reg PUSH
-    "s48_long_to_bignum" f
-    0 input-operand 1array compile-c-call*
-    ! An untagged pointer to the bignum is now in EAX; tag it
-    T{ int-regs } return-reg bignum-tag OR
-    ! the remainder is now in EDX
-    remainder-reg POP
-    "end" get save-xt ;
-
-M: %fixnum/i generate-node drop generate-fixnum/mod ;
-
-M: %fixnum/mod generate-node drop generate-fixnum/mod ;
-
-M: %fixnum-bitand generate-node ( vop -- ) drop dest/src AND ;
-
-M: %fixnum-bitor generate-node ( vop -- ) drop dest/src OR ;
-
-M: %fixnum-bitxor generate-node ( vop -- ) drop dest/src XOR ;
-
-M: %fixnum-bitnot generate-node ( vop -- )
-    drop
-    ! Negate the bits of the operand
-    0 output-operand NOT
-    ! Mask off the low 3 bits to give a fixnum tag
-    0 output-operand tag-mask XOR ;
-
-M: %fixnum>> generate-node
-    drop
-    ! shift register
-    0 output-operand 0 input SAR
-    ! give it a fixnum tag
-    0 output-operand tag-mask bitnot AND ;
-
-M: %fixnum-sgn generate-node
-    #! This has specific register requirements.
-    drop
-    ! store 0 in EDX if EAX is >=0, otherwise store -1.
-    prepare-division
-    ! give it a fixnum tag.
-    0 output-operand tag-bits SHL ;
-
-: fixnum-jump ( -- label )
-    1 input-operand 0 input-operand CMP label ;
-
-M: %jump-fixnum<  generate-node ( vop -- ) drop fixnum-jump JL ;
-M: %jump-fixnum<= generate-node ( vop -- ) drop fixnum-jump JLE ;
-M: %jump-fixnum>  generate-node ( vop -- ) drop fixnum-jump JG ;
-M: %jump-fixnum>= generate-node ( vop -- ) drop fixnum-jump JGE ;
-M: %jump-eq?      generate-node ( vop -- ) drop fixnum-jump JE ;
diff --git a/library/compiler/x86/generator.factor b/library/compiler/x86/generator.factor
deleted file mode 100644
index 1bb2db22a8..0000000000
--- a/library/compiler/x86/generator.factor
+++ /dev/null
@@ -1,92 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-backend
-USING: alien arrays assembler compiler inference kernel
-kernel-internals lists math memory namespaces sequences words ;
-
-! Not used on x86
-M: %prologue generate-node ( vop -- )  drop ;
-
-: (%call)
-    label dup postpone-word
-    dup primitive? [ address-operand ] when ;
-
-M: %call generate-node ( vop -- )
-    drop (%call) CALL ;
-
-M: %jump generate-node ( vop -- )
-    drop compile-epilogue (%call) JMP ;
-
-M: %jump-label generate-node ( vop -- )
-    drop label JMP ;
-
-M: %jump-t generate-node ( vop -- )
-    drop
-    ! Compare input with f
-    0 input-operand f address CMP
-    ! If not equal, jump
-    label JNE ;
-
-M: %return generate-node ( vop -- )
-    drop compile-epilogue RET ;
-
-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
-    <label> "end" set
-    ! Untag and multiply to get a jump table offset
-    0 input-operand fixnum>slot@
-    ! Add to jump table base. We use a temporary register since
-    ! on AMD4 we have to load a 64-bit immediate. On x86, this
-    ! is redundant.
-    0 scratch HEX: ffffffff MOV "end" get absolute-cell
-    0 input-operand 0 scratch ADD
-    ! Jump to jump table entry
-    0 input-operand [] JMP
-    ! Align for better performance
-    compile-aligned
-    ! Fix up jump table pointer
-    "end" get save-xt ;
-
-M: %type generate-node ( vop -- )
-    #! Intrinstic version of type primitive.
-    drop
-    <label> "header" set
-    <label> "f" set
-    <label> "end" set
-    ! Make a copy
-    0 scratch 0 output-operand MOV
-    ! Get the tag
-    0 output-operand tag-mask AND
-    ! Compare with object tag number (3).
-    0 output-operand object-tag CMP
-    ! Jump if the object doesn't store type info in its header
-    "header" get JE
-    ! It doesn't store type info in its header
-    0 output-operand tag-bits SHL
-    "end" get JMP
-    "header" get save-xt
-    ! It does store type info in its header
-    ! Is the pointer itself equal to 3? Then its F_TYPE (9).
-    0 scratch object-tag CMP
-    "f" get JE
-    ! The pointer is not equal to 3. Load the object header.
-    0 output-operand ECX object-tag neg [+] MOV
-    ! Mask off header tag, making a fixnum.
-    0 output-operand object-tag XOR
-    "end" get JMP
-    "f" get save-xt
-    ! The pointer is equal to 3. Load F_TYPE (9).
-    0 output-operand f type tag-bits shift MOV
-    "end" get save-xt ;
-
-M: %tag generate-node ( vop -- )
-    drop
-    0 input-operand tag-mask AND
-    0 input-operand tag-bits SHL ;
-
-M: %untag generate-node ( vop -- )
-    drop
-    0 output-operand tag-mask bitnot AND ;
diff --git a/library/compiler/x86/intrinsics-sse2.factor b/library/compiler/x86/intrinsics-sse2.factor
new file mode 100644
index 0000000000..b5b1ea0642
--- /dev/null
+++ b/library/compiler/x86/intrinsics-sse2.factor
@@ -0,0 +1,75 @@
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien arrays assembler generic kernel kernel-internals
+lists math math-internals memory namespaces sequences words ;
+IN: compiler
+
+M: float-regs (%peek) ( vreg loc reg-class -- )
+    drop
+    fp-scratch swap %move-int>int
+    fp-scratch %move-int>float ;
+
+: load-zone-ptr ( vreg -- )
+    #! Load pointer to start of zone array
+    dup "generations" f [ dlsym MOV ] 2keep
+    rel-absolute-cell rel-dlsym
+    dup [] MOV ;
+
+: load-allot-ptr ( vreg -- )
+    dup load-zone-ptr dup cell [+] MOV ;
+
+: inc-allot-ptr ( vreg n -- )
+    >r dup load-zone-ptr cell [+] r> ADD ;
+
+: with-inline-alloc ( prequot postquot spec -- )
+    #! both quotations are called with the vreg
+    [
+        alloc-tmp-reg PUSH
+        alloc-tmp-reg load-allot-ptr
+        alloc-tmp-reg [] \ tag-header get call tag-header MOV
+        >r call alloc-tmp-reg \ tag get call OR
+        r> call alloc-tmp-reg \ size get call inc-allot-ptr
+        alloc-tmp-reg POP
+    ] bind ; inline
+
+M: float-regs (%replace) ( vreg loc reg-class -- )
+    drop
+    [ alloc-tmp-reg 8 [+] rot v>operand MOVSD ]
+    [ v>operand alloc-tmp-reg MOV ] H{
+        { tag-header [ float-tag ] }
+        { tag [ float-tag ] }
+        { size [ 16 ] }
+    } with-inline-alloc ;
+
+! Floats
+: define-float-op ( word op -- )
+    [ [ "x" operand "y" operand ] % , ] [ ] make H{
+        { +input { { float "x" } { float "y" } } }
+        { +output { "x" } }
+    } define-intrinsic ;
+
+{
+    { float+ ADDSD }
+    { float- SUBSD }
+    { float* MULSD }
+    { float/f DIVSD }
+} [
+    first2 define-float-op
+] each
+
+: define-float-jump ( word op -- )
+    [
+        [ end-basic-block "x" operand "y" operand UCOMISD ] % ,
+    ] [ ] make H{
+        { +input { { float "x" } { float "y" } } }
+    } define-if-intrinsic ;
+
+{
+    { float< JB }
+    { float<= JBE }
+    { float> JA }
+    { float>= JAE }
+    { float= JE }
+} [
+    first2 define-float-jump
+] each
diff --git a/library/compiler/x86/intrinsics.factor b/library/compiler/x86/intrinsics.factor
new file mode 100644
index 0000000000..32edad6c85
--- /dev/null
+++ b/library/compiler/x86/intrinsics.factor
@@ -0,0 +1,282 @@
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien arrays assembler kernel kernel-internals lists math
+math-internals namespaces sequences words ;
+IN: compiler
+
+! Type checks
+\ tag [
+    "in" operand tag-mask AND
+    "in" operand tag-bits SHL
+] H{
+    { +input { { f "in" } } }
+    { +output { "in" } }
+} define-intrinsic
+
+\ type [
+    #! Intrinstic version of type primitive.
+    <label> "header" set
+    <label> "f" set
+    <label> "end" set
+    ! Make a copy
+    "x" operand "obj" operand MOV
+    ! Get the tag
+    "obj" operand tag-mask AND
+    ! Compare with object tag number (3).
+    "obj" operand object-tag CMP
+    ! Jump if the object doesn't store type info in its header
+    "header" get JE
+    ! It doesn't store type info in its header
+    "obj" operand tag-bits SHL
+    "end" get JMP
+    "header" get save-xt
+    ! It does store type info in its header
+    ! Is the pointer itself equal to 3? Then its F_TYPE (9).
+    "x" operand object-tag CMP
+    "f" get JE
+    ! The pointer is not equal to 3. Load the object header.
+    "obj" operand "x" operand object-tag neg [+] MOV
+    ! Mask off header tag, making a fixnum.
+    "obj" operand object-tag XOR
+    "end" get JMP
+    "f" get save-xt
+    ! The pointer is equal to 3. Load F_TYPE (9).
+    "obj" operand f type tag-bits shift MOV
+    "end" get save-xt
+] H{
+    { +input { { f "obj" } } }
+    { +scratch { { f "x" } { f "y" } } }
+    { +output { "obj" } }
+} define-intrinsic
+
+! Slots
+: untag ( reg -- ) tag-mask bitnot AND ;
+
+\ slot [
+    "obj" operand untag
+    ! turn tagged fixnum slot # into an offset, multiple of 4
+    "n" operand fixnum>slot@
+    ! compute slot address
+    "obj" operand "n" operand ADD
+    ! load slot value
+    "obj" operand dup [] MOV
+] H{
+    { +input { { f "obj" } { f "n" } } }
+    { +output { "obj" } }
+    { +clobber { "n" } }
+} define-intrinsic
+
+: card-offset 1 getenv ; inline
+
+: generate-write-barrier ( -- )
+    #! Mark the card pointed to by vreg.
+    "obj" operand card-bits SHR
+    "obj" operand card-offset ADD rel-absolute-cell rel-cards
+    "obj" operand [] card-mark OR ;
+
+\ set-slot [
+    "obj" operand untag
+    ! turn tagged fixnum slot # into an offset
+    "slot" operand fixnum>slot@
+    ! compute slot address
+    "slot" operand "obj" operand ADD
+    ! store new slot value
+    "slot" operand [] "val" operand MOV
+    generate-write-barrier
+] H{
+    { +input { { f "val" } { f "obj" } { f "slot" } } }
+    { +clobber { "obj" "slot" } }
+} define-intrinsic
+
+\ char-slot [
+    EBX PUSH
+    "n" operand 2 SHR
+    EBX dup XOR
+    "obj" operand "n" operand ADD
+    BX "obj" operand string-offset [+] MOV
+    EBX tag-bits SHL
+    "obj" operand EBX MOV
+    EBX POP
+] H{
+    { +input { { f "n" } { f "obj" } } }
+    { +output { "obj" } }
+    { +clobber { "n" } }
+} define-intrinsic
+
+\ set-char-slot [
+    EBX PUSH
+    "val" operand tag-bits SHR
+    "slot" operand 2 SHR
+    "obj" operand "slot" operand ADD
+    EBX "val" operand MOV
+    "obj" operand string-offset [+] BX MOV
+    EBX POP
+] H{
+    { +input { { f "val" } { f "slot" } { f "obj" } } }
+    { +clobber { "val" "slot" "obj" } }
+} define-intrinsic
+
+! Fixnums
+: define-fixnum-op ( word op -- )
+    [ [ "x" operand "y" operand ] % , ] [ ] make H{
+        { +input { { f "x" } { f "y" } } }
+        { +output { "x" } }
+    } define-intrinsic ;
+
+{
+    { fixnum+fast ADD }
+    { fixnum-fast SUB }
+    { fixnum-bitand AND }
+    { fixnum-bitor OR }
+    { fixnum-bitxor XOR }
+} [
+    first2 define-fixnum-op
+] each
+
+\ fixnum-bitnot [
+    "x" operand NOT
+    "x" operand tag-mask XOR
+] H{
+    { +input { { f "x" } } }
+    { +output { "x" } }
+} define-intrinsic
+
+! This has specific register requirements. Inputs are in
+! ECX and EAX, and the result is in EDX.
+\ fixnum-mod [
+    prepare-division
+    "y" operand IDIV
+] H{
+    { +input { { 0 "x" } { 1 "y" } } }
+    { +scratch { { 2 "out" } } }
+    { +output { "out" } }
+} define-intrinsic
+
+: ?MOV ( dst src -- ) 2dup = [ 2drop ] [ MOV ] if ;
+
+: unique-operands ( operands quot -- )
+    >r [ operand ] map prune r> each ; inline
+
+: simple-overflow ( word -- )
+    finalize-contents
+    "z" operand "x" operand MOV
+    "z" operand "y" operand pick execute
+    ! If the previous arithmetic operation overflowed, then we
+    ! turn the result into a bignum and leave it in EAX.
+    <label> "end" set
+    "end" get JNO
+    ! There was an overflow. Recompute the original operand.
+    { "y" "x" } [ tag-bits SAR ] unique-operands
+    "x" operand "y" operand rot execute
+    "s48_long_to_bignum" f "x" operand 1array compile-c-call*
+    ! An untagged pointer to the bignum is now in EAX; tag it
+    T{ int-regs } return-reg bignum-tag OR
+    "z" operand T{ int-regs } return-reg ?MOV
+    "end" get save-xt ; inline
+
+: simple-overflow-template ( word insn -- )
+    [ simple-overflow ] curry H{
+        { +input { { f "x" } { f "y" } } }
+        { +scratch { { f "z" } } }
+        { +output { "z" } }
+        { +clobber { "x" "y" } }
+    } define-intrinsic ;
+
+\ fixnum+ \ ADD simple-overflow-template
+\ fixnum- \ SUB simple-overflow-template
+
+\ fixnum* [
+    finalize-contents
+    "y" operand tag-bits SAR
+    "y" operand IMUL
+    <label> "end" set
+    "end" get JNO
+    "s48_fixnum_pair_to_bignum" f
+    "x" operand remainder-reg 2array compile-c-call*
+    ! now we have to shift it by three bits to remove the second
+    ! tag
+    "s48_bignum_arithmetic_shift" f
+    "x" operand tag-bits neg 2array compile-c-call*
+    ! an untagged pointer to the bignum is now in EAX; tag it
+    T{ int-regs } return-reg bignum-tag OR
+    "end" get save-xt
+] H{
+    { +input { { 0 "x" } { 1 "y" } } }
+    { +output { "x" } }
+} define-intrinsic
+
+: generate-fixnum/mod
+    #! The same code is used for fixnum/i and fixnum/mod.
+    #! This has specific register
+    #! ECX and EAX, and the result is in EDX.
+    <label> "end" set
+    prepare-division
+    "y" operand IDIV
+    ! Make a copy since following shift is destructive
+    "y" operand "x" operand MOV
+    ! Tag the value, since division cancelled tags from both
+    ! inputs
+    "x" operand tag-bits SHL
+    ! Did it overflow?
+    "end" get JNO
+    ! There was an overflow, so make ECX into a bignum. we must
+    ! save EDX since its volatile.
+    remainder-reg PUSH
+    "s48_long_to_bignum" f
+    "y" operand 1array compile-c-call*
+    ! An untagged pointer to the bignum is now in EAX; tag it
+    T{ int-regs } return-reg bignum-tag OR
+    ! the remainder is now in EDX
+    remainder-reg POP
+    "end" get save-xt ;
+
+\ fixnum/i [ generate-fixnum/mod ] H{
+    { +input { { 0 "x" } { 1 "y" } } }
+    { +scratch { { 2 "out" } } }
+    { +output { "x" } }
+    { +clobber { "x" "y" } }
+} define-intrinsic
+
+\ fixnum/mod [ generate-fixnum/mod ] H{
+    { +input { { 0 "x" } { 1 "y" } } }
+    { +scratch { { 2 "out" } } }
+    { +output { "x" "out" } }
+    { +clobber { "x" "y" } }
+} define-intrinsic
+
+: define-fixnum-jump ( word op -- )
+    [ end-basic-block "x" operand "y" operand CMP ] swap add
+    H{ { +input { { f "x" } { f "y" } } } } define-if-intrinsic ;
+
+{
+    { fixnum< JL }
+    { fixnum<= JLE }
+    { fixnum> JG }
+    { fixnum>= JGE }
+    { eq? JE }
+} [
+    first2 define-fixnum-jump
+] each
+
+! User environment
+: %userenv ( -- )
+    "x" operand "userenv" f dlsym MOV
+    0 rel-absolute-cell rel-userenv
+    "n" operand fixnum>slot@
+    "n" operand "x" operand ADD ;
+
+\ getenv [
+    %userenv  "n" operand dup [] MOV
+] H{
+    { +input { { f "n" } } }
+    { +scratch { { f "x" } } }
+    { +output { "n" } }
+} define-intrinsic
+
+\ setenv [
+    %userenv  "n" operand [] "val" operand MOV
+] H{
+    { +input { { f "val" } { f "n" } } }
+    { +scratch { { f "x" } } }
+    { +clobber { "n" } }
+} define-intrinsic
diff --git a/library/compiler/x86/slots.factor b/library/compiler/x86/slots.factor
deleted file mode 100644
index a2fae93bcd..0000000000
--- a/library/compiler/x86/slots.factor
+++ /dev/null
@@ -1,74 +0,0 @@
-! Copyright (C) 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: compiler-backend
-USING: alien arrays assembler compiler inference kernel
-kernel-internals lists math memory namespaces sequences words ;
-
-M: %slot generate-node ( vop -- )
-    drop
-    ! turn tagged fixnum slot # into an offset, multiple of 4
-    0 input-operand fixnum>slot@
-    ! compute slot address
-    dest/src ADD
-    ! load slot value
-    0 output-operand dup [] MOV ;
-
-M: %fast-slot generate-node ( vop -- )
-    drop 0 output-operand 1 input-operand 0 input [+] MOV ;
-
-: card-offset 1 getenv ; inline
-
-M: %write-barrier generate-node ( vop -- )
-    #! Mark the card pointed to by vreg.
-    drop
-    0 input-operand card-bits SHR
-    0 input-operand card-offset ADD rel-absolute-cell rel-cards
-    0 input-operand [] card-mark OR ;
-
-M: %set-slot generate-node ( vop -- )
-    drop
-    ! turn tagged fixnum slot # into an offset
-    2 input-operand fixnum>slot@
-    ! compute slot address
-    2 input-operand 1 input-operand ADD
-    ! store new slot value
-    2 input-operand [] 0 input-operand MOV ;
-
-M: %fast-set-slot generate-node ( vop -- )
-    drop 1 input-operand 2 input [+] 0 input-operand MOV ;
-
-: >register-16 ( reg -- reg )
-    "register" word-prop { AX CX DX } nth ;
-
-: scratch-16 ( n -- reg ) scratch >register-16 ;
-
-M: %char-slot generate-node ( vop -- )
-    drop
-    0 input-operand 2 SHR
-    0 scratch dup XOR
-    dest/src ADD
-    0 scratch-16 0 output-operand string-offset [+] MOV
-    0 scratch tag-bits SHL
-    0 output-operand 0 scratch MOV ;
-
-M: %set-char-slot generate-node ( vop -- )
-    drop
-    0 input-operand tag-bits SHR
-    2 input-operand 2 SHR
-    2 input-operand 1 input-operand ADD
-    2 input-operand string-offset [+]
-    0 input-operand >register-16 MOV ;
-
-: userenv@ ( n -- addr ) cells "userenv" f dlsym + ;
-
-M: %getenv generate-node ( vop -- )
-    drop
-    0 output-operand 0 input userenv@ MOV
-    0 input rel-absolute-cell rel-userenv
-    0 output-operand dup [] MOV ;
-
-M: %setenv generate-node ( vop -- )
-    drop
-    0 scratch 1 input userenv@ MOV
-    1 input rel-absolute-cell rel-userenv
-    0 scratch [] 0 input-operand MOV ;
diff --git a/library/compiler/x86/stack.factor b/library/compiler/x86/stack.factor
deleted file mode 100644
index 230719914e..0000000000
--- a/library/compiler/x86/stack.factor
+++ /dev/null
@@ -1,30 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: compiler-backend
-USING: alien arrays assembler compiler inference kernel
-kernel-internals lists math memory sequences words ;
-
-: reg-stack ( n reg -- op ) swap cells neg [+] ;
-
-M: ds-loc v>operand ds-loc-n ds-reg reg-stack ;
-
-M: cs-loc v>operand cs-loc-n cs-reg reg-stack ;
-
-M: %peek generate-node ( vop -- )
-    drop 0 output-operand 0 input-operand MOV ;
-
-M: %replace generate-node ( vop -- )
-    drop 0 output-operand 0 input-operand MOV ;
-
-: (%inc) 0 input cells dup 0 > [ ADD ] [ neg SUB ] if ;
-
-M: %inc-d generate-node ( vop -- ) drop ds-reg (%inc) ;
-
-M: %inc-r generate-node ( vop -- ) drop cs-reg (%inc) ;
-
-M: %immediate generate-node ( vop -- )
-    drop 0 output-operand 0 input address MOV ;
-
-M: %indirect generate-node ( vop -- )
-    #! indirect load of a literal through a table
-    drop 0 output-operand 0 input load-indirect ;
diff --git a/library/continuations.factor b/library/continuations.factor
index 2cbea0fc49..fd897ca8ae 100644
--- a/library/continuations.factor
+++ b/library/continuations.factor
@@ -1,9 +1,13 @@
-! Copyright (C) 2003, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! Copyright (C) 2003, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: kernel-internals
+USING: vectors ;
+
+: catchstack* ( -- cs ) 6 getenv { vector } declare ; inline
+
 IN: errors
 USING: kernel kernel-internals ;
 
-: catchstack* ( -- cs ) 6 getenv ; inline
 : catchstack ( -- cs ) catchstack* clone ; inline
 : set-catchstack ( cs -- ) clone 6 setenv ; inline
 
diff --git a/library/continuations.facts b/library/continuations.facts
index cd01fdccb5..d19997dc72 100644
--- a/library/continuations.facts
+++ b/library/continuations.facts
@@ -1,4 +1,4 @@
-USING: errors help kernel ;
+USING: errors help kernel kernel-internals ;
 
 HELP: catchstack* "( -- catchstack )"
 { $values { "catchstack" "a vector" } }
diff --git a/library/freetype/freetype-gl.factor b/library/freetype/freetype-gl.factor
index 8c593cd6e5..a229f829ff 100644
--- a/library/freetype/freetype-gl.factor
+++ b/library/freetype/freetype-gl.factor
@@ -168,7 +168,7 @@ C: font ( handle -- font )
     #! glyph.
     [ dupd <char-sprite> ] cache-nth nip ;
 
-: draw-string ( open-font sprites string -- )
+: (draw-string) ( open-font sprites string -- )
     GL_TEXTURE_2D [
         GL_MODELVIEW [
             [
diff --git a/library/generic/generic.factor b/library/generic/generic.factor
index f1c7fa9948..7afb3a48e9 100644
--- a/library/generic/generic.factor
+++ b/library/generic/generic.factor
@@ -1,10 +1,14 @@
-! 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: generic
 USING: arrays errors hashtables kernel kernel-internals lists
 namespaces parser sequences strings words vectors math
 math-internals ;
 
+: class? ( word -- ? ) "class" word-prop ;
+
+: classes ( -- list ) [ class? ] word-subset ;
+
 SYMBOL: typemap
 SYMBOL: builtins
 
@@ -39,21 +43,21 @@ SYMBOL: builtins
     ] hash-each ;
 
 : types ( class -- types )
-    [ (types) ] make-hash hash-keys ;
+    [ (types) ] make-hash hash-keys natural-sort ;
 
-DEFER: class<
+DEFER: (class<)
 
 : superclass< ( cls1 cls2 -- ? )
-    >r superclass r> 2dup and [ class< ] [ 2drop f ] if ;
+    >r superclass r> 2dup and [ (class<) ] [ 2drop f ] if ;
 
 : union-class< ( cls1 cls2 -- ? )
-    >r flatten-class r> flatten-class hash-keys swap
-    [ drop swap [ class< ] contains-with? ] hash-all-with? ;
+    [ flatten-class ] 2apply hash-keys swap
+    [ drop swap [ (class<) ] contains-with? ] hash-all-with? ;
 
 : class-empty? ( class -- ? )
     members dup [ empty? ] when ;
 
-: class< ( cls1 cls2 -- ? )
+: (class<) ( cls1 cls2 -- ? )
     {
         { [ 2dup eq? ] [ 2drop t ] }
         { [ over class-empty? ] [ 2drop t ] }
@@ -62,6 +66,21 @@ DEFER: class<
         { [ t ] [ union-class< ] }
     } cond ;
 
+SYMBOL: class<cache
+
+: class< ( cls1 cls2 -- ? )
+    class<cache get [ hash hash-member? ] [ (class<) ] if* ;
+
+: smaller-classes ( class -- )
+    classes [ swap (class<) ] subset-with ;
+
+: make-class<cache ( -- hash )
+    classes [ dup smaller-classes [ dup ] map>hash ] map>hash ;
+
+: with-class<cache ( quot -- )
+    [ make-class<cache class<cache set call ] with-scope ;
+    inline
+
 : class-compare ( cls1 cls2 -- -1/0/1 )
     2dup eq? [ 2drop 0 ] [ class< 1 -1 ? ] if ;
 
@@ -80,8 +99,6 @@ M: generic definer drop \ G: ;
 : make-generic ( word -- )
     dup dup "combination" word-prop call define-compound ;
 
-: class? ( word -- ? ) "class" word-prop ;
-
 : check-method ( class generic -- )
     dup generic? [
         dup word-name " is not a generic word" append throw
@@ -146,13 +163,12 @@ M: generic definer drop \ G: ;
 
 : define-class ( class -- )
     dup t "class" set-word-prop
+    dup H{ } clone "class<" set-word-prop
     dup flatten-class typemap get set-hash ;
 
 : implementors ( class -- list )
     [ "methods" word-prop ?hash* nip ] word-subset-with ;
 
-: classes ( -- list ) [ class? ] word-subset ;
-
 ! Predicate classes for generalized predicate dispatch.
 : define-predicate-class ( class predicate definition -- )
     pick define-class
@@ -165,9 +181,8 @@ PREDICATE: word predicate "definition" word-prop ;
 
 ! Union classes for dispatch on multiple classes.
 : union-predicate ( members -- list )
-    [
-        "predicate" word-prop \ dup swons [ drop t ] 2array
-    ] map [ drop f ] swap alist>quot ;
+    [ dup ] swap [ "predicate" word-prop append ] map-with
+    [ [ drop t ] 2array ] map [ drop f ] swap alist>quot ;
 
 : set-members ( class members -- )
     [ bootstrap-word ] map "members" set-word-prop ;
diff --git a/library/generic/math-combination.factor b/library/generic/math-combination.factor
index f8bc656571..10751ff9cf 100644
--- a/library/generic/math-combination.factor
+++ b/library/generic/math-combination.factor
@@ -1,31 +1,32 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: generic
-USING: errors generic hashtables kernel kernel-internals lists
-math namespaces sequences words ;
+USING: arrays errors generic hashtables kernel kernel-internals
+lists math namespaces sequences words ;
 
 ! Math combination for generic dyadic upgrading arithmetic.
 
-: math-priority ( class -- n )
-    "math-priority" word-prop [ 100 ] unless* ;
+: last/first ( seq -- pair ) dup peek swap first 2array ;
 
-: math-class< ( class class -- ? )
-    [ math-priority ] 2apply < ;
+: math-class? ( object -- ? )
+    dup word? [ number bootstrap-word class< ] [ drop f ] if ;
+
+: math-class-compare ( class class -- n )
+    [
+        dup math-class?
+        [ types last/first ] [ drop { 100 100 } ] if
+    ] 2apply <=> ;
 
 : math-class-max ( class class -- class )
-    [ swap math-class< ] 2keep ? ;
+    [ math-class-compare 0 > ] 2keep ? ;
+
+: (math-upgrade) ( max class -- quot )
+    dupd = [ drop [ ] ] [ "coercer" word-prop ] if ;
 
 : math-upgrade ( left right -- quot )
-    2dup math-class< [
-        nip "coercer" word-prop
-        dup [ [ >r ] swap [ r> ] append3 ] when
-    ] [
-        2dup swap math-class< [
-            drop "coercer" word-prop
-        ] [
-            2drop [ ]
-        ] if
-    ] if ;
+    [ math-class-max ] 2keep
+    >r over r> (math-upgrade)
+    >r (math-upgrade) dup [ 1 make-dip ] when r> append ;
 
 TUPLE: no-math-method left right generic ;
 
@@ -48,17 +49,17 @@ TUPLE: no-math-method left right generic ;
         2drop object-method
     ] if ;
 
-: math-vtable ( picker quot -- )
+: math-vtable* ( picker max quot -- quot )
     [
-        swap , \ tag ,
-        [ num-tags [ type>class ] map swap map % ] { } make ,
+        rot , \ tag ,
+        [ >r [ type>class ] map r> map % ] { } make ,
         \ dispatch ,
     ] [ ] make ; inline
 
-: math-class? ( object -- ? )
-    dup word? [ "math-priority" word-prop ] [ drop f ] if ;
+: math-vtable ( picker quot -- quot )
+    num-tags swap math-vtable* ; inline
 
-: math-combination ( word -- vtable )
+: math-combination ( word -- quot )
     \ over [
         dup math-class? [
             \ dup [ >r 2dup r> math-method ] math-vtable
diff --git a/library/generic/math-combination.facts b/library/generic/math-combination.facts
index 58904ed6f9..a783171fa2 100644
--- a/library/generic/math-combination.facts
+++ b/library/generic/math-combination.facts
@@ -1,14 +1,5 @@
 USING: generic help math ;
 
-HELP: math-priority "( class -- n )"
-{ $values { "class" "a class word" } { "n" "a non-negative integer" } }
-{ $description "Outputs the priority of a built-in number class. If class A has a lower priority than class B, then applying a binary math operation to an instance of A and B will upgrade the instance of A to B's type." }
-{ $notes "To simplify implementation of the math method combination, this word outputs 100 for non-numeric classes. Priorities of numeric classes must always be less than 100." } ;
-
-HELP: math-class< "( class1 class2 -- ? )"
-{ $values { "class1" "a class word" } { "class2" "a class word" } { "?" "a boolean" } }
-{ $description "Defines a total ordering on built-in number classes." } ;
-
 HELP: math-upgrade "( class1 class2 -- quot )"
 { $values { "class1" "a class word" } { "class2" "a class word" } { "quot" "a quotation with stack effect " { $snippet "( n n -- n n )" } } }
 { $description "Outputs a quotation for upgrading numberical types. It takes two numbers on the stack, an instance of " { $snippet "class1" } ", and an instance of " { $snippet "class2" } ", and converts the one with the lower priority to the higher priority type." }
diff --git a/library/generic/slots.factor b/library/generic/slots.factor
index b08ced86fe..7b83fb4d7c 100644
--- a/library/generic/slots.factor
+++ b/library/generic/slots.factor
@@ -10,25 +10,29 @@ parser sequences strings words ;
 
 : define-slot-word ( class slot word quot -- )
     over [
-        >r swap >fixnum r> cons define-typecheck
+        rot >fixnum add* define-typecheck
     ] [
         2drop 2drop
     ] if ;
 
-: define-reader ( class slot reader -- )
-    [ slot ] define-slot-word ;
+: define-reader ( class slot decl reader -- )
+    [ slot ] rot dup object eq? [
+        drop
+    ] [
+        1array [ declare ] swap add* append
+    ] if define-slot-word ;
 
 : define-writer ( class slot writer -- )
     [ set-slot ] define-slot-word ;
 
-: define-slot ( class slot reader writer -- )
-    >r >r 2dup r> define-reader r> define-writer ;
+: define-slot ( class slot decl reader writer -- )
+    >r >r >r 2dup r> r> define-reader r> define-writer ;
 
 : intern-slots ( spec -- spec )
-    [ first3 [ dup [ first2 create ] when ] 2apply 3array ] map ;
+    [ [ dup array? [ first2 create ] when ] map ] map ;
 
 : define-slots ( class spec -- )
-    [ first3 define-slot ] each-with ;
+    [ first4 define-slot ] each-with ;
 
 : reader-word ( class name -- word )
     >r word-name "-" r> append3 in get 2array ;
@@ -36,10 +40,9 @@ parser sequences strings words ;
 : writer-word ( class name -- word )
     [ swap "set-" % word-name % "-" % % ] "" make in get 2array ;
 
-: simple-slot ( class name -- reader writer )
-    [ reader-word ] 2keep writer-word ;
+: simple-slot ( class name -- )
+    2dup reader-word , writer-word , ;
 
 : simple-slots ( class slots base -- spec )
     over length [ + ] map-with
-    [ >r dupd simple-slot r> -rot 3array ] 2map nip
-    intern-slots ;
+    [ [ , object , dupd simple-slot ] { } make ] 2map nip intern-slots ;
diff --git a/library/generic/standard-combination.factor b/library/generic/standard-combination.factor
index 36a183faa8..0eb222ce75 100644
--- a/library/generic/standard-combination.factor
+++ b/library/generic/standard-combination.factor
@@ -32,34 +32,40 @@ math namespaces sequences vectors words ;
         swap [ first classes-intersect? ] subset-with
     ] map-with ;
 
-: simplify-alist ( class assoc -- default assoc )
-    dup cdr [
-        2dup cdr car first class< [
-            cdr simplify-alist
-        ] [
-            uncons >r second nip r>
-        ] if
+: (simplify-alist) ( class i assoc -- default assoc )
+    2dup length 1- = [
+        nth second [ ] rot drop
     ] [
-        nip car second [ ]
+        3dup >r 1+ r> nth first class< [
+            >r 1+ r> (simplify-alist)
+        ] [
+            [ nth second ] 2keep >r 1+ r> tail rot drop
+        ] if
     ] if ;
 
+: simplify-alist ( class assoc -- default assoc )
+    0 swap (simplify-alist) ;
+
+: methods* ( dispatch# word -- assoc )
+    #! Make a class->method association, together with a
+    #! default delegating method at the end.
+    empty-method object bootstrap-word swap 2array 1array
+    swap methods append ;
+
+: small-generic ( dispatch# word -- def )
+    2dup methods* object bootstrap-word swap simplify-alist
+    swapd class-predicates alist>quot ;
+
 : vtable-methods ( dispatch# alist-seq -- alist-seq )
     dup length [
         type>class
-        [ swap simplify-alist ] [ car second [ ] ] if*
+        [ swap simplify-alist ] [ first second [ ] ] if*
         >r over r> class-predicates alist>quot
     ] 2map nip ;
 
 : <vtable> ( dispatch# word n -- vtable )
     #! n is vtable size; either num-types or num-tags.
-    >r 2dup empty-method \ object bootstrap-word swap 2array
-    >r methods >list r> swons r> sort-methods vtable-methods ;
-
-: small-generic ( dispatch# word -- def )
-    2dup empty-method object bootstrap-word swap 2array
-    swap methods >list cons
-    object bootstrap-word swap simplify-alist
-    swapd class-predicates alist>quot ;
+    >r 2dup methods* r> sort-methods vtable-methods ;
 
 : big-generic ( dispatch# word n dispatcher -- def )
     [ >r pick picker % r> , <vtable> , \ dispatch , ] [ ] make ;
diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor
index 6c9379892d..1a30491092 100644
--- a/library/generic/tuple.factor
+++ b/library/generic/tuple.factor
@@ -1,7 +1,11 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: generic
+USING: arrays errors hashtables kernel kernel-internals lists
+math namespaces parser sequences sequences-internals strings
+vectors words ;
+
 IN: kernel-internals
-USING: arrays errors hashtables kernel lists math namespaces parser sequences sequences-internals strings vectors words ;
 
 : class-tuple ( object -- class )
     dup tuple? [ 2 slot ] [ drop f ] if ; inline
@@ -12,11 +16,11 @@ USING: arrays errors hashtables kernel lists math namespaces parser sequences se
         [ 2dup swap array-nth >r pick array-nth r> = ] all? 2nip
     ] [
         2drop f
-    ] if ; inline
+    ] if ;
 
 : tuple-hashcode ( n tuple -- n )
-    dup class-tuple hashcode >r >r 1- r>
-    4 slot hashcode* r> bitxor ;
+    dup class-tuple hashcode >r >r 1-
+    r> 4 slot hashcode* r> bitxor ;
 
 IN: generic
 
@@ -29,7 +33,7 @@ IN: generic
     define-predicate ;
 
 : forget-tuple ( class -- )
-    dup forget "predicate" word-prop car [ forget ] when* ;
+    dup forget "predicate" word-prop first [ forget ] when* ;
 
 : check-shape ( word slots -- )
     >r in get lookup dup [
@@ -39,7 +43,7 @@ IN: generic
         r> 2drop
     ] if ;
 
-: delegate-slots { { 3 delegate set-delegate } } ;
+: delegate-slots { { 3 object delegate set-delegate } } ;
 
 : tuple-slots ( tuple slots -- )
     2dup "slot-names" set-word-prop
@@ -80,7 +84,7 @@ M: tuple clone ( tuple -- tuple )
 M: tuple hashcode* ( n tuple -- n )
     {
         { [ over 0 <= ] [ 2drop 0 ] }
-        { [ dup array-capacity 2 <= ] [ nip class-tuple hashcode ] }
+        { [ dup array-capacity 2 <= ] [ nip class hashcode ] }
         { [ t ] [ tuple-hashcode ] }
     } cond ;
 
diff --git a/library/help/crossref.factor b/library/help/crossref.factor
index 38983c71cc..2061c42ed5 100644
--- a/library/help/crossref.factor
+++ b/library/help/crossref.factor
@@ -52,7 +52,6 @@ SYMBOL: help-graph
     [ links-out ] help-graph get remove-vertex ;
 
 : xref-articles ( -- )
-    H{ } clone help-graph set
     all-articles [ links-out ] help-graph get add-vertices ;
 
 : help-outliner ( seq quot -- | quot: obj -- )
diff --git a/library/inference/inline-methods.factor b/library/inference/inline-methods.factor
deleted file mode 100644
index a83cf68f1f..0000000000
--- a/library/inference/inline-methods.factor
+++ /dev/null
@@ -1,102 +0,0 @@
-! Copyright (C) 2004, 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: optimizer
-USING: arrays generic hashtables inference kernel lists math
-namespaces sequences words ;
-
-! Method inlining optimization
-
-GENERIC: dispatching-values ( node word -- seq )
-
-M: object dispatching-values 2drop { } ;
-
-M: standard-generic dispatching-values
-    "combination" word-prop first swap
-    node-in-d reverse-slice nth 1array ;
-
-M: 2generic dispatching-values drop node-in-d 2 swap tail* ;
-
-: node-classes* ( node seq -- seq )
-    >r node-classes r>
-    [ swap ?hash [ object ] unless* ] map-with ;
-
-: dispatching-classes ( node -- seq )
-    dup node-in-d empty? [
-        drop { }
-    ] [
-        dup dup node-param dispatching-values node-classes*
-    ] if ;
-
-: already-inlined? ( node -- ? )
-    #! Was this node inlined from definition of 'word'?
-    dup node-param swap node-history memq? ;
-
-: inlining-class ( #call -- class )
-    #! If the generic dispatch can be eliminated, return the
-    #! class of the method that will always be invoked here.
-    dup already-inlined? [
-        drop f
-    ] [
-        dup dispatching-classes dup empty? [
-            2drop f
-        ] [
-            dup all-eq? [
-                first swap node-param order min-class
-            ] [
-                2drop f
-            ] if
-        ] if
-    ] if ;
-
-: will-inline ( node -- quot )
-    dup inlining-class swap node-param "methods" word-prop hash ;
-
-: method-dataflow ( node -- dataflow )
-    dup will-inline swap node-in-d dataflow-with ;
-
-: post-inline ( #return/#values #call/#merge -- )
-    dup [
-        [
-            >r node-in-d r> node-out-d
-            2array unify-lengths first2
-        ] keep subst-values
-    ] [
-        2drop
-    ] if ;
-
-: subst-node ( old new -- )
-    #! The last node of 'new' becomes 'old', then values are
-    #! substituted. A subsequent optimizer phase kills the
-    #! last node of 'new' and the first node of 'old'.
-    last-node 2dup swap post-inline set-node-successor ;
-
-: inline-method ( node -- node )
-    #! We set the #call node's param to f so that it gets killed
-    #! later.
-    dup method-dataflow
-    [ >r node-param r> remember-node ] 2keep
-    [ subst-node ] keep ;
-
-: related? ( actual testing -- ? )
-    #! If actual is a subset of testing or if the two classes
-    #! are disjoint, return t.
-    2dup class< >r classes-intersect? not r> or ;
-
-: optimize-predicate? ( #call -- ? )
-    dup node-param "predicating" word-prop dup [
-        >r dup node-in-d node-classes* first r> related?
-    ] [
-        2drop f
-    ] if ;
-
-: inline-literals ( node literals -- node )
-    #! Make #push -> #return -> successor
-    over drop-inputs [
-        >r >list [ literalize ] map dataflow [ subst-node ] keep
-        r> set-node-successor
-    ] keep ;
-
-: optimize-predicate ( #call -- node )
-    dup node-param "predicating" word-prop >r
-    dup dup node-in-d node-classes* first r> class<
-    1array inline-literals ;
diff --git a/library/io/duplex-stream.factor b/library/io/duplex-stream.factor
index 9d296be3f7..58e2636cc3 100644
--- a/library/io/duplex-stream.factor
+++ b/library/io/duplex-stream.factor
@@ -1,44 +1,64 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: io
-USING: kernel ;
+USING: errors kernel ;
 
-TUPLE: duplex-stream in out ;
+! We ensure that the stream can only be closed once, to preserve
+! integrity of duplex I/O ports.
+
+TUPLE: duplex-stream in out closed? ;
+
+C: duplex-stream ( in out -- stream )
+    [ set-duplex-stream-out ] keep
+    [ set-duplex-stream-in ] keep ;
+
+: check-closed ( duplex -- )
+    duplex-stream-closed?
+    [ "Duplex stream closed" throw ] when ;
+
+: duplex-stream-in+ ( duplex -- stream )
+    dup check-closed duplex-stream-in ;
+
+: duplex-stream-out+ ( duplex -- stream )
+    dup check-closed duplex-stream-out ;
 
 M: duplex-stream stream-flush
-    duplex-stream-out stream-flush ;
+    duplex-stream-out+ stream-flush ;
 
 M: duplex-stream stream-readln
-    duplex-stream-in stream-readln ;
+    duplex-stream-in+ stream-readln ;
 
 M: duplex-stream stream-read1
-    duplex-stream-in stream-read1 ;
+    duplex-stream-in+ stream-read1 ;
 
 M: duplex-stream stream-read
-    duplex-stream-in stream-read ;
+    duplex-stream-in+ stream-read ;
 
 M: duplex-stream stream-write1
-    duplex-stream-out stream-write1 ;
+    duplex-stream-out+ stream-write1 ;
 
 M: duplex-stream stream-write
-    duplex-stream-out stream-write ;
+    duplex-stream-out+ stream-write ;
 
 M: duplex-stream stream-terpri
-    duplex-stream-out stream-terpri ;
+    duplex-stream-out+ stream-terpri ;
 
 M: duplex-stream stream-format
-    duplex-stream-out stream-format ;
+    duplex-stream-out+ stream-format ;
 
 M: duplex-stream with-nested-stream
-    duplex-stream-out with-nested-stream ;
+    duplex-stream-out+ with-nested-stream ;
 
 M: duplex-stream stream-close
     #! The output stream is closed first, in case both streams
     #! are attached to the same file descriptor, the output
     #! buffer needs to be flushed before we close the fd.
-    dup
-    duplex-stream-out stream-close
-    duplex-stream-in stream-close ;
+    dup duplex-stream-closed? [
+        t over set-duplex-stream-closed?
+        dup
+        duplex-stream-out stream-close
+        duplex-stream-in stream-close
+    ] unless ;
 
 M: duplex-stream set-timeout
     2dup
diff --git a/library/io/null-stream.factor b/library/io/null-stream.factor
index c710d23816..8410485c25 100644
--- a/library/io/null-stream.factor
+++ b/library/io/null-stream.factor
@@ -3,7 +3,7 @@ USING: kernel ;
 
 ! Think '/dev/null'.
 M: f stream-close drop ;
-M: f set-timeout drop ;
+M: f set-timeout 2drop ;
 
 M: f stream-readln drop f ;
 M: f stream-read1 drop f ;
diff --git a/library/kernel.factor b/library/kernel.factor
index 0a79475942..0e473d75d6 100644
--- a/library/kernel.factor
+++ b/library/kernel.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 IN: kernel
-USING: generic kernel-internals math-internals ;
+USING: generic kernel-internals math math-internals ;
 
 : 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline
 
@@ -79,10 +79,11 @@ M: wrapper literalize <wrapper> ;
 IN: kernel-internals
 
 ! These words are unsafe. Don't use them.
+: declare ( types -- ) drop ;
 
-: array-capacity 1 slot ; inline
-: array-nth swap 2 fixnum+ slot ; inline
-: set-array-nth swap 2 fixnum+ set-slot ; inline
+: array-capacity 1 slot { fixnum } declare ; inline
+: array-nth swap 2 fixnum+fast slot ; inline
+: set-array-nth swap 2 fixnum+fast set-slot ; inline
 
 : make-tuple <tuple> [ 2 set-slot ] keep ; flushable
 
@@ -109,7 +110,5 @@ IN: kernel
 IN: memory
 
 : generations ( -- n ) 15 getenv ;
-
 : image ( -- path ) 16 getenv ;
-
 : save ( -- ) image save-image ;
diff --git a/library/math/complex.factor b/library/math/complex.factor
index 90547d7598..0166d64db2 100644
--- a/library/math/complex.factor
+++ b/library/math/complex.factor
@@ -61,9 +61,6 @@ M: complex * ( x y -- x*y ) 2dup *re - -rot *im + (rect>) ;
 M: complex / ( x y -- x/y ) complex/ tuck / >r / r> (rect>) ;
 M: complex /f ( x y -- x/y ) complex/ tuck /f >r /f r> (rect>) ;
 
-M: complex 1+ >rect >r 1+ r> (rect>) ;
-M: complex 1- >rect >r 1- r> (rect>) ;
-
 M: complex abs ( z -- |z| ) absq fsqrt ;
 
 M: complex hashcode ( n -- n )
diff --git a/library/math/constants.factor b/library/math/constants.factor
index 7ed04d23d7..518f3ccec3 100644
--- a/library/math/constants.factor
+++ b/library/math/constants.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: kernel-internals
-USING: namespaces math ;
+USING: kernel namespaces math ;
 
 : bootstrap-cell \ cell get ; inline
 : cells cell * ; inline
@@ -10,6 +10,9 @@ USING: namespaces math ;
 : cell-bits 8 cells ; inline
 : bootstrap-cell-bits 8 bootstrap-cells ; inline
 
+: tag-address ( x tag -- tagged ) swap tag-bits shift bitor ;
+: tag-header ( id -- tagged ) object-tag tag-address ;
+
 IN: math
 
 : i C{ 0 1 } ; inline
@@ -17,6 +20,6 @@ IN: math
 : e 2.7182818284590452354 ; inline
 : pi 3.14159265358979323846 ; inline
 : epsilon 2.2204460492503131e-16 ; inline
-: first-bignum 1 cell-bits tag-bits - 1- shift ; inline
-: most-positive-fixnum first-bignum 1- >fixnum ; inline
-: most-negative-fixnum first-bignum neg >fixnum ; inline
+: first-bignum 1 bootstrap-cell-bits tag-bits - 1- shift ;
+: most-positive-fixnum first-bignum 1- >fixnum ;
+: most-negative-fixnum first-bignum neg >fixnum ;
diff --git a/library/math/float.factor b/library/math/float.factor
index 9af3f3bbf1..62a9a1666e 100644
--- a/library/math/float.factor
+++ b/library/math/float.factor
@@ -1,7 +1,13 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+IN: math-internals
+USING: math kernel ;
+
+: float= ( n n -- ? )
+    #! The compiler replaces this with a better intrinsic.
+    [ double>bits ] 2apply number= ; foldable
+
 IN: math
-USING: generic kernel math-internals ;
 
 UNION: real rational float ;
 
@@ -14,15 +20,14 @@ M: real <=> - ;
 : fp-nan? ( float -- ? )
     double>bits -51 shift BIN: 111111111111 [ bitand ] keep = ;
 
-M: float zero?
-    double>bits HEX: 8000000000000000 [ bitor ] keep number= ;
-
-M: float number= [ double>bits ] 2apply number= ;
+M: float zero? ( float -- ? )
+    dup 0.0 float= swap -0.0 float= or ;
 
 M: float < float< ;
 M: float <= float<= ;
 M: float > float> ;
 M: float >= float>= ;
+M: float number= float= ;
 
 M: float + float+ ;
 M: float - float- ;
@@ -30,6 +35,3 @@ M: float * float* ;
 M: float / float/f ;
 M: float /f float/f ;
 M: float mod float-mod ;
-
-M: float 1+ 1.0 float+ ;
-M: float 1- 1.0 float- ;
diff --git a/library/math/integer.factor b/library/math/integer.factor
index 605a909478..118f276e73 100644
--- a/library/math/integer.factor
+++ b/library/math/integer.factor
@@ -59,9 +59,6 @@ M: fixnum mod fixnum-mod ;
 
 M: fixnum /mod fixnum/mod ;
 
-M: fixnum 1+ 1 fixnum+ ;
-M: fixnum 1- 1 fixnum- ;
-
 M: fixnum bitand fixnum-bitand ;
 M: fixnum bitor fixnum-bitor ;
 M: fixnum bitxor fixnum-bitxor ;
@@ -69,8 +66,6 @@ M: fixnum shift fixnum-shift ;
 
 M: fixnum bitnot fixnum-bitnot ;
 
-M: fixnum zero? 0 eq? ;
-
 M: bignum number= bignum= ;
 M: bignum < bignum< ;
 M: bignum <= bignum<= ;
@@ -86,9 +81,6 @@ M: bignum mod bignum-mod ;
 
 M: bignum /mod bignum/mod ;
 
-M: bignum 1+ 1 >bignum bignum+ ;
-M: bignum 1- 1 >bignum bignum- ;
-
 M: bignum bitand bignum-bitand ;
 M: bignum bitor bignum-bitor ;
 M: bignum bitxor bignum-bitxor ;
@@ -96,4 +88,4 @@ M: bignum shift bignum-shift ;
 
 M: bignum bitnot bignum-bitnot ;
 
-M: bignum zero? 0 >bignum bignum= ;
+M: integer zero? 0 number= ;
diff --git a/library/math/math.factor b/library/math/math.factor
index 3ed833a28b..480689b402 100644
--- a/library/math/math.factor
+++ b/library/math/math.factor
@@ -28,17 +28,17 @@ G: shift  ( x n -- y ) math-combination ; foldable
 
 GENERIC: bitnot ( n -- n ) foldable
 
-GENERIC: 1+ ( x -- x+1 ) foldable
-GENERIC: 1- ( x -- x-1 ) foldable
 GENERIC: abs ( z -- |z| ) foldable
 GENERIC: absq ( n -- |n|^2 ) foldable
 
 GENERIC: zero? ( x -- ? ) foldable
 M: object zero? drop f ;
 
-: sq dup * ; inline
-: neg 0 swap - ; inline
-: recip 1 swap / ; inline
+: 1+ 1 + ; foldable
+: 1- 1 - ; foldable
+: sq dup * ; foldable
+: neg 0 swap - ; foldable
+: recip 1 swap / ; foldable
 : max ( x y -- z ) [ > ] 2keep ? ; foldable
 : min ( x y -- z ) [ < ] 2keep ? ; foldable
 : between? ( x min max -- ? ) pick >= >r >= r> and ; foldable
@@ -48,17 +48,19 @@ M: object zero? drop f ;
 : truncate ( x -- y ) dup 1 mod - ; foldable
 
 : floor ( x -- y )
-    dup 1 mod dup 0 =
+    dup 1 mod dup zero?
     [ drop ] [ dup 0 < [ - 1- ] [ - ] if ] if ; foldable
 
 : ceiling ( x -- y ) neg floor neg ; foldable
 
 : (repeat) ( i n quot -- )
-    pick pick >=
-    [ 3drop ] [ [ swap >r call 1+ r> ] keep (repeat) ] if ;
-    inline
+    pick pick >= [
+        3drop
+    ] [
+        [ swap >r call 1+ r> ] keep (repeat)
+    ] if ; inline
 
-: repeat ( n quot -- | quot: n -- n ) 0 -rot (repeat) ; inline
+: repeat 0 -rot (repeat) ; inline
 
 : times ( n quot -- | quot: -- )
     swap [ >r dup slip r> ] repeat drop ; inline
diff --git a/library/math/ratio.factor b/library/math/ratio.factor
index 1c61c56f83..70907a563b 100644
--- a/library/math/ratio.factor
+++ b/library/math/ratio.factor
@@ -37,6 +37,3 @@ M: ratio / scale / ;
 M: ratio /i scale /i ;
 M: ratio mod 2dup >r >r /i r> r> rot * - ;
 M: ratio /f scale /f ;
-
-M: ratio 1+ >fraction [ + ] keep fraction> ;
-M: ratio 1- >fraction [ - ] keep fraction> ;
diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor
index b2a86d8509..1c89cab400 100644
--- a/library/syntax/prettyprint.factor
+++ b/library/syntax/prettyprint.factor
@@ -24,7 +24,6 @@ SYMBOL: string-limit
 global [
     4 tab-size set
     64 margin set
-    recursion-check off
     0 position set
     0 indent set
     0 last-newline set
@@ -230,9 +229,9 @@ M: dll pprint* ( obj -- str ) dll-path "DLL\" " pprint-string ;
         over recursion-check get memq? [
             2drop "&" plain-text
         ] [
-            over recursion-check [ cons ] change
+            over recursion-check get push
             call
-            recursion-check [ cdr ] change
+            recursion-check get pop*
         ] if
     ] if ; inline
 
@@ -294,6 +293,7 @@ M: wrapper pprint* ( wrapper -- )
 
 : with-pprint ( quot -- )
     [
+        V{ } clone recursion-check set
         <block> f ?push pprinter-stack set
         call end-blocks do-pprint
     ] with-scope ; inline
diff --git a/library/test/benchmark/empty-loop.factor b/library/test/benchmark/empty-loop.factor
index b0de42a23b..8bdf3af9d1 100644
--- a/library/test/benchmark/empty-loop.factor
+++ b/library/test/benchmark/empty-loop.factor
@@ -1,5 +1,9 @@
 IN: temporary
-USING: compiler kernel math sequences test ;
+USING: compiler kernel math math-internals sequences test ;
+
+: empty-loop-0 ( n -- )
+    dup 0 fixnum< [ drop ] [ 1 fixnum-fast empty-loop-0 ] if ;
+    compiled
 
 : empty-loop-1 ( n -- )
     [ ] times ; compiled
@@ -10,6 +14,7 @@ USING: compiler kernel math sequences test ;
 : empty-loop-3 ( n -- )
     [ drop ] each ; compiled
 
+[ ] [ 5000000 empty-loop-0 ] unit-test
 [ ] [ 5000000 empty-loop-1 ] unit-test
 [ ] [ 5000000 empty-loop-2 ] unit-test
 [ ] [ 5000000 empty-loop-3 ] unit-test
diff --git a/library/test/benchmark/fib.factor b/library/test/benchmark/fib.factor
index 0528391b57..c9602a4458 100644
--- a/library/test/benchmark/fib.factor
+++ b/library/test/benchmark/fib.factor
@@ -5,10 +5,22 @@ USE: math
 USE: test
 USE: math-internals
 USE: namespaces
+USE: words
 
-! Four fibonacci implementations, each one slower than the
+! Five fibonacci implementations, each one slower than the
 ! previous.
 
+: fast-fixnum-fib ( n -- nth fibonacci number )
+    dup 1 fixnum<= [
+        drop 1
+    ] [
+        1 fixnum-fast dup fast-fixnum-fib
+        swap 1 fixnum-fast fast-fixnum-fib fixnum+fast
+    ] if ;
+    compiled
+
+[ 9227465 ] [ 34 fast-fixnum-fib ] unit-test
+
 : fixnum-fib ( n -- nth fibonacci number )
     dup 1 fixnum<= [
         drop 1
@@ -20,8 +32,10 @@ USE: namespaces
 [ 9227465 ] [ 34 fixnum-fib ] unit-test
 
 : fib ( n -- nth fibonacci number )
-    dup 1 <= [ drop 1 ] [ 1- dup fib swap 1- fib + ] if ;
-    compiled
+    dup 1 <= [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ;
+
+\ fib { fixnum } "specializer" set-word-prop
+\ fib compile
 
 [ 9227465 ] [ 34 fib ] unit-test
 
@@ -54,4 +68,4 @@ SYMBOL: n
         ] if
     ] with-scope ; compiled
 
-[ 9227465 ] [ 34 namespace-fib ] unit-test
+[ 1346269 ] [ 30 namespace-fib ] unit-test
diff --git a/library/test/benchmark/prettyprint.factor b/library/test/benchmark/prettyprint.factor
index fa2f583b01..fbda45ac91 100644
--- a/library/test/benchmark/prettyprint.factor
+++ b/library/test/benchmark/prettyprint.factor
@@ -5,5 +5,8 @@ USE: test
 USE: words
 USE: kernel
 USE: sequences
+USE: io
 
-[ ] [ vocabs [ words [ see ] each ] each ] unit-test
+[ ] [
+    [ vocabs [ words [ see ] each ] each ] string-out drop
+] unit-test
diff --git a/library/test/benchmark/sort.factor b/library/test/benchmark/sort.factor
index 806dd786e9..2fdde603e7 100644
--- a/library/test/benchmark/sort.factor
+++ b/library/test/benchmark/sort.factor
@@ -2,6 +2,6 @@ IN: temporary
 USING: compiler kernel math sequences test ;
 
 : sort-benchmark
-    100000 [ drop 100000 random-int ] map number-sort drop ; compiled
+    100000 [ drop 100000 random-int ] map natural-sort drop ; compiled
 
 [ ] [ sort-benchmark ] unit-test
diff --git a/library/test/collections/hashtables.factor b/library/test/collections/hashtables.factor
index 0c54434b8d..9e21211f81 100644
--- a/library/test/collections/hashtables.factor
+++ b/library/test/collections/hashtables.factor
@@ -197,3 +197,7 @@ H{ } clone "cache-test" set
 [ H{ } ] [ { H{ } } hash-concat ] unit-test
 [ H{ { 1 2 } } ] [ { H{ { 1 2 } } } hash-concat ] unit-test
 [ H{ { 1 2 } { 3 4 } } ] [ { H{ { 1 2 } } H{ { 3 4 } } } hash-concat ] unit-test
+
+! Resource leak...
+H{ } "x" set
+100 [ drop "x" get clear-hash ] each
diff --git a/library/test/compiler/assembler-x86.factor b/library/test/compiler/assembler-x86.factor
deleted file mode 100644
index ac12addb2e..0000000000
--- a/library/test/compiler/assembler-x86.factor
+++ /dev/null
@@ -1,9 +0,0 @@
-IN: temporary
-USING: assembler kernel test ;
-
-[ t ] [ { EBP } indirect? >boolean ] unit-test
-[ { EBP 0 } ] [ { EBP } canonicalize ] unit-test
-[ t ] [ { EAX 3 } displaced? >boolean ] unit-test
-[ { EAX } ] [ { EAX 0 } canonicalize ] unit-test
-[ { EAX } ] [ { EAX } canonicalize ] unit-test
-[ { EAX 3 } ] [ { EAX 3 } canonicalize ] unit-test
diff --git a/library/test/compiler/callbacks.factor b/library/test/compiler/callbacks.factor
index 2129a30101..97a77baf49 100644
--- a/library/test/compiler/callbacks.factor
+++ b/library/test/compiler/callbacks.factor
@@ -1,6 +1,6 @@
 IN: temporary
-USING: alien compiler errors inference io kernel math memory
-namespaces test threads ;
+USING: alien compiler errors inference io kernel kernel-internals
+math memory namespaces test threads ;
 
 : callback-1 "void" { } [ ] alien-callback ; compiled
 
diff --git a/library/test/compiler/float.factor b/library/test/compiler/float.factor
new file mode 100644
index 0000000000..7589a1a2be
--- /dev/null
+++ b/library/test/compiler/float.factor
@@ -0,0 +1,83 @@
+IN: temporary
+USING: compiler kernel kernel-internals memory math
+math-internals test ;
+
+[ 5.0 ] [ [ 5.0 ] compile-1 full-gc full-gc full-gc ] unit-test
+[ 2.0 3.0 ] [ 3.0 [ 2.0 swap ] compile-1 ] unit-test
+
+[ 1 2 3 4.0 ] [ [ 1 2 3 4.0 ] compile-1 ] unit-test
+
+[ 3.0 1 2 3 ] [ 1.0 2.0 [ float+ 1 2 3 ] compile-1 ] unit-test
+
+[ 5 ] [ 1.0 [ 2.0 float+ tag ] compile-1 ] unit-test
+
+[ 3.0 ] [ 1.0 [ 2.0 float+ ] compile-1 ] unit-test
+[ 3.0 ] [ 1.0 [ 2.0 swap float+ ] compile-1 ] unit-test
+[ 3.0 ] [ 1.0 2.0 [ float+ ] compile-1 ] unit-test
+[ 3.0 ] [ 1.0 2.0 [ swap float+ ] compile-1 ] unit-test
+
+[ -1.0 ] [ 1.0 [ 2.0 float- ] compile-1 ] unit-test
+[ 1.0 ] [ 1.0 [ 2.0 swap float- ] compile-1 ] unit-test
+[ -1.0 ] [ 1.0 2.0 [ float- ] compile-1 ] unit-test
+[ 1.0 ] [ 1.0 2.0 [ swap float- ] compile-1 ] unit-test
+
+[ 6.0 ] [ 3.0 [ 2.0 float* ] compile-1 ] unit-test
+[ 6.0 ] [ 3.0 [ 2.0 swap float* ] compile-1 ] unit-test
+[ 6.0 ] [ 3.0 2.0 [ float* ] compile-1 ] unit-test
+[ 6.0 ] [ 3.0 2.0 [ swap float* ] compile-1 ] unit-test
+
+[ 0.5 ] [ 1.0 [ 2.0 float/f ] compile-1 ] unit-test
+[ 2.0 ] [ 1.0 [ 2.0 swap float/f ] compile-1 ] unit-test
+[ 0.5 ] [ 1.0 2.0 [ float/f ] compile-1 ] unit-test
+[ 2.0 ] [ 1.0 2.0 [ swap float/f ] compile-1 ] unit-test
+
+[ t ] [ 1.0 2.0 [ float< ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 2.0 float< ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 swap float< ] compile-1 ] unit-test
+[ f ] [ 1.0 1.0 [ float< ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 1.0 float< ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 1.0 swap float< ] compile-1 ] unit-test
+[ f ] [ 3.0 1.0 [ float< ] compile-1 ] unit-test
+[ f ] [ 3.0 [ 1.0 float< ] compile-1 ] unit-test
+[ t ] [ 3.0 [ 1.0 swap float< ] compile-1 ] unit-test
+
+[ t ] [ 1.0 2.0 [ float<= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 2.0 float<= ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 swap float<= ] compile-1 ] unit-test
+[ t ] [ 1.0 1.0 [ float<= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 float<= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 swap float<= ] compile-1 ] unit-test
+[ f ] [ 3.0 1.0 [ float<= ] compile-1 ] unit-test
+[ f ] [ 3.0 [ 1.0 float<= ] compile-1 ] unit-test
+[ t ] [ 3.0 [ 1.0 swap float<= ] compile-1 ] unit-test
+
+[ f ] [ 1.0 2.0 [ float> ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 float> ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 2.0 swap float> ] compile-1 ] unit-test
+[ f ] [ 1.0 1.0 [ float> ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 1.0 float> ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 1.0 swap float> ] compile-1 ] unit-test
+[ t ] [ 3.0 1.0 [ float> ] compile-1 ] unit-test
+[ t ] [ 3.0 [ 1.0 float> ] compile-1 ] unit-test
+[ f ] [ 3.0 [ 1.0 swap float> ] compile-1 ] unit-test
+
+[ f ] [ 1.0 2.0 [ float>= ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 float>= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 2.0 swap float>= ] compile-1 ] unit-test
+[ t ] [ 1.0 1.0 [ float>= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 float>= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 swap float>= ] compile-1 ] unit-test
+[ t ] [ 3.0 1.0 [ float>= ] compile-1 ] unit-test
+[ t ] [ 3.0 [ 1.0 float>= ] compile-1 ] unit-test
+[ f ] [ 3.0 [ 1.0 swap float>= ] compile-1 ] unit-test
+
+[ f ] [ 1.0 2.0 [ float= ] compile-1 ] unit-test
+[ t ] [ 1.0 1.0 [ float= ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 float= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 float= ] compile-1 ] unit-test
+[ f ] [ 1.0 [ 2.0 swap float= ] compile-1 ] unit-test
+[ t ] [ 1.0 [ 1.0 swap float= ] compile-1 ] unit-test
+
+[ t ] [ 0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test
+[ t ] [ -0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test
+[ f ] [ 3.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test
diff --git a/library/test/compiler/identities.factor b/library/test/compiler/identities.factor
index 2926e540b7..b296f7b5ee 100644
--- a/library/test/compiler/identities.factor
+++ b/library/test/compiler/identities.factor
@@ -1,5 +1,5 @@
 IN: temporary
-USING: compiler kernel math test vectors ;
+USING: compiler kernel kernel-internals math test vectors ;
 
 [ 5 ] [ 5 [ 0 + ] compile-1 ] unit-test
 [ 5 ] [ 5 [ 0 swap + ] compile-1 ] unit-test
@@ -22,12 +22,6 @@ USING: compiler kernel math test vectors ;
 [ 0 ] [ 5 [ 1 mod ] compile-1 ] unit-test
 [ 0 ] [ 5 [ 1 rem ] compile-1 ] unit-test
 
-[ 5 ] [ 5 [ 1 ^ ] compile-1 ] unit-test
-[ 25 ] [ 5 [ 2 ^ ] compile-1 ] unit-test
-[ 1/5 ] [ 5 [ -1 ^ ] compile-1 ] unit-test
-[ 1/25 ] [ 5 [ -2 ^ ] compile-1 ] unit-test
-[ 1 ] [ 5 [ 1 swap ^ ] compile-1 ] unit-test
-
 [ 5 ] [ 5 [ -1 bitand ] compile-1 ] unit-test
 [ 0 ] [ 5 [ 0 bitand ] compile-1 ] unit-test
 [ 5 ] [ 5 [ -1 swap bitand ] compile-1 ] unit-test
@@ -58,3 +52,5 @@ USING: compiler kernel math test vectors ;
 [ t ] [ 5 [ dup = ] compile-1 ] unit-test
 [ t ] [ 5 [ dup number= ] compile-1 ] unit-test
 [ t ] [ \ vector [ \ vector = ] compile-1 ] unit-test
+
+[ 3 ] [ 10/3 [ { ratio } declare 1 /i ] compile-1 ] unit-test
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 bd35d2f89d..24d2ed20a2 100644
--- a/library/test/compiler/intrinsics.factor
+++ b/library/test/compiler/intrinsics.factor
@@ -2,10 +2,6 @@ IN: temporary
 USING: arrays compiler kernel kernel-internals lists math
 math-internals sequences strings test words ;
 
-! Oops!
-[ 5000 ] [ [ 5000 ] compile-1 ] unit-test
-[ "hi" ] [ [ "hi" ] compile-1 ] unit-test
-
 ! Make sure that intrinsic ops compile to correct code.
 [ 1 ] [ [[ 1 2 ]] [ 0 slot ] compile-1 ] unit-test
 [ 1 ] [ [ [[ 1 2 ]] 0 slot ] compile-1 ] unit-test
@@ -27,6 +23,9 @@ math-internals sequences strings test words ;
 [ "axc" ] [ CHAR: x 1 [ "abc" [ set-char-slot ] keep dup rehash-string ] compile-1 ] unit-test
 [ "axc" ] [ CHAR: x [ 1 "abc" [ set-char-slot ] keep dup rehash-string ] compile-1 ] unit-test
 
+[ ] [ [ 0 getenv ] compile-1 drop ] unit-test
+[ ] [ 1 getenv [ 1 setenv ] compile-1 ] unit-test
+
 [ ] [ 1 [ drop ] compile-1 ] unit-test
 [ ] [ [ 1 drop ] compile-1 ] unit-test
 [ ] [ [ 1 2 2drop ] compile-1 ] unit-test
@@ -51,6 +50,8 @@ math-internals sequences strings test words ;
 [ 2 ] [ 1 [ 2 nip ] compile-1 ] unit-test
 [ 2 ] [ 1 2 [ nip ] compile-1 ] unit-test
 
+[ 2 1 "hi" ] [ 1 2 [ swap "hi" ] compile-1 ] unit-test
+
 [ 4 ] [ 12 7 [ fixnum-bitand ] compile-1 ] unit-test
 [ 4 ] [ 12 [ 7 fixnum-bitand ] compile-1 ] unit-test
 [ 4 ] [ [ 12 7 fixnum-bitand ] compile-1 ] unit-test
@@ -63,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 3155134d4c..0000000000
--- a/library/test/compiler/linearizer.factor
+++ /dev/null
@@ -1,16 +0,0 @@
-IN: temporary
-USE: test
-USE: kernel
-USE: compiler
-USE: compiler-frontend
-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/optimizer.factor b/library/test/compiler/optimizer.factor
index e6650c1bf8..b4600cd277 100644
--- a/library/test/compiler/optimizer.factor
+++ b/library/test/compiler/optimizer.factor
@@ -1,8 +1,8 @@
-IN: temporary
-USING: arrays assembler compiler compiler-backend generic
+USING: arrays assembler compiler generic
 hashtables inference kernel kernel-internals lists math
 optimizer prettyprint sequences strings test vectors words
 sequences-internals ;
+IN: temporary
 
 : kill-1
     [ 1 2 3 ] [ + ] over drop drop ; compiled
@@ -38,6 +38,8 @@ sequences-internals ;
 
 : set= 2dup subset? >r swap subset? r> and ;
 
+USE: optimizer
+
 : kill-set dup live-values swap literals hash-diff ;
 
 : kill-set=
diff --git a/library/test/compiler/simple.factor b/library/test/compiler/simple.factor
index 059ce97a8e..2674f6a3dd 100644
--- a/library/test/compiler/simple.factor
+++ b/library/test/compiler/simple.factor
@@ -1,4 +1,3 @@
-IN: temporary
 USE: compiler
 USE: test
 USE: math
@@ -7,6 +6,7 @@ USE: words
 USE: kernel
 USE: math-internals
 USE: memory
+IN: temporary
 
 : no-op ; compiled
 
@@ -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/compiler/stack.factor b/library/test/compiler/stack.factor
index 463515b022..ed3d27bf2b 100644
--- a/library/test/compiler/stack.factor
+++ b/library/test/compiler/stack.factor
@@ -18,6 +18,3 @@ USING: compiler kernel math-internals test ;
 [ 1 2 1 ] [ 1 2 [ over ] compile-1 ] unit-test
 [ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-1 ] unit-test
 [ 2 1 ] [ 1 2 [ swap ] compile-1 ] unit-test
-
-! Test literals in either side of a shuffle
-[ 4 1 ] [ 1 [ [ 3 fixnum+ ] keep ] compile-1 ] unit-test
diff --git a/library/test/compiler/templates.factor b/library/test/compiler/templates.factor
new file mode 100644
index 0000000000..3f6d84a1dd
--- /dev/null
+++ b/library/test/compiler/templates.factor
@@ -0,0 +1,125 @@
+! Black box testing of templater optimization
+
+USING: arrays compiler kernel kernel-internals math
+math-internals namespaces sequences sequences-internals test ;
+IN: temporary
+
+! Oops!
+[ 5000 ] [ [ 5000 ] compile-1 ] unit-test
+[ "hi" ] [ [ "hi" ] compile-1 ] unit-test
+
+[ 1 2 3 4 ] [ [ 1 2 3 4 ] compile-1 ] unit-test
+
+[ 1 1 ] [ 1 [ dup ] compile-1 ] unit-test
+[ 0 ] [ 3 [ tag ] compile-1 ] unit-test
+[ 0 3 ] [ 3 [ [ tag ] keep ] compile-1 ] unit-test
+
+[ 2 3 ] [ 3 [ 2 swap ] compile-1 ] unit-test
+
+[ 2 1 3 4 ] [ 1 2 [ swap 3 4 ] compile-1 ] unit-test
+
+[ 2 3 4 ] [ 3 [ 2 swap 4 ] compile-1 ] unit-test
+
+[ { 1 2 3 } { 1 4 3 } 3 3 ]
+[ { 1 2 3 } { 1 4 3 } [ over tag over tag ] compile-1 ]
+unit-test
+
+[ { 1 2 3 } { 1 4 3 } 8 8 ]
+[ { 1 2 3 } { 1 4 3 } [ over type over type ] compile-1 ]
+unit-test
+
+! Test literals in either side of a shuffle
+[ 4 1 ] [ 1 [ [ 3 fixnum+ ] keep ] compile-1 ] unit-test
+
+[ 2 ] [ 1 2 [ swap fixnum/i ] compile-1 ] unit-test
+
+: foo ;
+
+[ 4 4 ]
+[ 1/2 [ tag [ foo ] keep ] compile-1 ]
+unit-test
+
+[ 1 2 2 ]
+[ 1/2 [ dup 0 slot swap 1 slot [ foo ] keep ] compile-1 ]
+unit-test
+
+[ 41 5 4 ] [
+    5/4 4/5 [
+        dup ratio? [
+            over ratio? [
+                2dup 2>fraction >r * swap r> * swap
+                + -rot denominator swap denominator
+            ] [
+                2drop f f f
+            ] if
+        ] [
+            2drop f f f
+        ] if
+    ] compile-1
+] unit-test
+
+: jxyz
+    over bignum? [
+        dup ratio? [
+            [ >fraction ] 2apply swapd
+            >r 2array swap r> 2array swap
+        ] when
+    ] when ;
+
+\ jxyz compile
+
+[ { 1 2 } { 1 1 } ] [ 1 >bignum 1/2 jxyz ] unit-test
+
+[ 3 ]
+[
+    global [ 3 \ foo set ] bind
+    \ foo [ global >n get n> drop ] compile-1
+] unit-test
+
+: blech drop ;
+
+[ 3 ]
+[
+    global [ 3 \ foo set ] bind
+    \ foo [ global [ get ] swap blech call ] compile-1
+] unit-test
+
+[ 3 ]
+[
+    global [ 3 \ foo set ] bind
+    \ foo [ global [ get ] swap >n call n> drop ] compile-1
+] unit-test
+
+[ 3 ]
+[
+    global [ 3 \ foo set ] bind
+    \ foo [ global [ get ] bind ] compile-1
+] unit-test
+
+[ 12 13 ] [
+    -12 -13 [ [ 0 swap fixnum-fast ] 2apply ] compile-1
+] unit-test
+
+[ -1 2 ] [ 1 2 [ >r 0 swap fixnum- r> ] compile-1 ] unit-test
+
+[ 12 13 ] [
+    -12 -13 [ [ 0 swap fixnum- ] 2apply ] compile-1
+] unit-test
+
+[ { t t } ] [
+    { t } { t } [
+        dup array-capacity [
+            2dup swap swap 2 fixnum+fast slot
+            >r pick swap 2 fixnum+fast slot r> 2array
+        ] collect 2nip
+    ] compile-1 first
+] unit-test
+
+[ { t t } ] [
+    { t } { t } [
+        dup array-capacity [
+            2dup swap swap 2 fixnum+ slot
+            >r pick swap 2 fixnum+ slot r> 2array
+        ] collect 2nip
+    ] compile-1 first
+] unit-test
diff --git a/library/test/generic.factor b/library/test/generic.factor
index 84f044a2e4..7ba806f6bd 100644
--- a/library/test/generic.factor
+++ b/library/test/generic.factor
@@ -69,34 +69,39 @@ M: very-funny gooey sq ;
 
 [ cons ] [ [ 1 2 ] class ] unit-test
 
-[ object ] [ object object class-and ] unit-test
-[ fixnum ] [ fixnum object class-and ] unit-test
-[ fixnum ] [ object fixnum class-and ] unit-test
-[ fixnum ] [ fixnum fixnum class-and ] unit-test
-[ fixnum ] [ fixnum integer class-and ] unit-test
-[ fixnum ] [ integer fixnum class-and ] unit-test
-[ null ] [ vector fixnum class-and ] unit-test
-[ number ] [ number object class-and ] unit-test
-[ number ] [ object number class-and ] unit-test
+: class<tests
+    [ object ] [ object object class-and ] unit-test
+    [ fixnum ] [ fixnum object class-and ] unit-test
+    [ fixnum ] [ object fixnum class-and ] unit-test
+    [ fixnum ] [ fixnum fixnum class-and ] unit-test
+    [ fixnum ] [ fixnum integer class-and ] unit-test
+    [ fixnum ] [ integer fixnum class-and ] unit-test
+    [ null ] [ vector fixnum class-and ] unit-test
+    [ number ] [ number object class-and ] unit-test
+    [ number ] [ object number class-and ] unit-test
+    
+    [ t ] [ \ fixnum \ integer class< ] unit-test
+    [ t ] [ \ fixnum \ fixnum class< ] unit-test
+    [ f ] [ \ integer \ fixnum class< ] unit-test
+    [ t ] [ \ integer \ object class< ] unit-test
+    [ f ] [ \ integer \ null class< ] unit-test
+    [ t ] [ \ null \ object class< ] unit-test
+    [ t ] [ \ list \ general-list class< ] unit-test
+    [ t ] [ \ list \ object class< ] unit-test
+    [ t ] [ \ null \ list class< ] unit-test
+    
+    [ t ] [ \ generic \ compound class< ] unit-test
+    [ f ] [ \ compound \ generic class< ] unit-test
+    
+    [ f ] [ \ cons \ list class< ] unit-test
+    [ f ] [ \ list \ cons class< ] unit-test
+    
+    [ f ] [ \ reversed \ slice class< ] unit-test
+    [ f ] [ \ slice \ reversed class< ] unit-test ;
 
-[ t ] [ \ fixnum \ integer class< ] unit-test
-[ t ] [ \ fixnum \ fixnum class< ] unit-test
-[ f ] [ \ integer \ fixnum class< ] unit-test
-[ t ] [ \ integer \ object class< ] unit-test
-[ f ] [ \ integer \ null class< ] unit-test
-[ t ] [ \ null \ object class< ] unit-test
-[ t ] [ \ list \ general-list class< ] unit-test
-[ t ] [ \ list \ object class< ] unit-test
-[ t ] [ \ null \ list class< ] unit-test
+class<tests
 
-[ t ] [ \ generic \ compound class< ] unit-test
-[ f ] [ \ compound \ generic class< ] unit-test
-
-[ f ] [ \ cons \ list class< ] unit-test
-[ f ] [ \ list \ cons class< ] unit-test
-
-[ f ] [ \ reversed \ slice class< ] unit-test
-[ f ] [ \ slice \ reversed class< ] unit-test
+[ class<tests ] with-class<cache
 
 PREDICATE: word no-docs "documentation" word-prop not ;
 
@@ -200,3 +205,11 @@ TUPLE: delegating ;
 [ t ] [ \ + 2generic? ] unit-test
 
 [ "SYMBOL: not-a-class C: not-a-class ;" parse ] unit-test-fails
+
+! Test math-combination
+[ [ >r >float r> ] ] [ \ real \ float math-upgrade ] unit-test
+[ [ >float ] ] [ \ float \ real math-upgrade ] unit-test
+[ [ >r >bignum r> ] ] [ \ fixnum \ bignum math-upgrade ] unit-test
+[ [ >float ] ] [ \ float \ integer math-upgrade ] unit-test
+[ number ] [ \ number \ float math-class-max ] unit-test
+[ float ] [ \ real \ float math-class-max ] unit-test
diff --git a/library/test/inference.factor b/library/test/inference.factor
index f52be71686..b7fbb3d224 100644
--- a/library/test/inference.factor
+++ b/library/test/inference.factor
@@ -10,22 +10,6 @@ math-internals namespaces parser sequences test vectors ;
 
 [ t ] [ [ [ ] [ ] if ] dataflow dup [ [ ] map-nodes ] with-node-iterator = ] unit-test
 
-[
-    T{ shuffle f { "a" } { } { "a" } { "a" } }
-] [
-    T{ shuffle f { "a" } { } { "a" "a" } { } }
-    T{ shuffle f { "b" } { } { } { "b" } }
-    compose-shuffle
-] unit-test
-
-[
-    T{ shuffle f { "b" "a" } { } { "b" "b" } { } }
-] [
-    T{ shuffle f { "a" } { } { } { } }
-    T{ shuffle f { "b" } { } { "b" "b" } { } }
-    compose-shuffle
-] unit-test
-
 [ { 0 2 } ] [ [ 2 "Hello" ] infer ] unit-test
 [ { 1 2 } ] [ [ dup ] infer ] unit-test
 
@@ -225,10 +209,17 @@ DEFER: do-crap
 : do-crap dup [ do-crap ] [ more-crap ] if ;
 [ [ do-crap ] infer ] unit-test-fails
 
+! Error reporting is wrong
+G: xyz math-combination ;
+M: fixnum xyz 2array ;
+M: ratio xyz 
+    [ >fraction ] 2apply swapd >r 2array swap r> 2array swap ;
+
+[ t ] [ [ [ xyz ] infer ] catch inference-error? ] unit-test
+
 [ { 2 1 } ] [ [ swons ] infer ] unit-test
 [ { 1 2 } ] [ [ uncons ] infer ] unit-test
 [ { 1 1 } ] [ [ unit ] infer ] unit-test
-[ { 1 2 } ] [ [ unswons ] infer ] unit-test
 [ { 1 1 } ] [ [ list? ] infer ] unit-test
 
 [ { 1 0 } ] [ [ >n ] infer ] unit-test
diff --git a/library/test/io/io.factor b/library/test/io/io.factor
index 2bcef4f739..ca90ba83b7 100644
--- a/library/test/io/io.factor
+++ b/library/test/io/io.factor
@@ -60,3 +60,5 @@ unit-test
 [ f ]
 [ "" <string-reader> stream-readln ]
 unit-test
+
+[ ] [ 10000 f set-timeout ] unit-test
diff --git a/library/test/lists/cons.factor b/library/test/lists/cons.factor
index d53c7485c7..13fa00d87d 100644
--- a/library/test/lists/cons.factor
+++ b/library/test/lists/cons.factor
@@ -27,9 +27,6 @@ USE: sequences
 [ 1 2     ] [ [[ 1 2 ]] uncons ] unit-test
 [ 1 [ 2 ] ] [ [ 1 2 ]   uncons ] unit-test
 
-[ 1 2     ] [ [[ 2 1 ]] unswons ] unit-test
-[ [ 2 ] 1 ] [ [ 1 2 ]   unswons ] unit-test
-
 [ 1 3 ] [ [[ 1 2 ]] [[ 3 4 ]] 2car ] unit-test
 [ 2 4 ] [ [[ 1 2 ]] [[ 3 4 ]] 2cdr ] unit-test
 
diff --git a/library/test/test.factor b/library/test/test.factor
index 157030f388..6f538b2a2d 100644
--- a/library/test/test.factor
+++ b/library/test/test.factor
@@ -1,18 +1,17 @@
-! Factor test suite.
-
+! Copyright (C) 2003, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 IN: test
-USING: arrays errors inspector io kernel lists math memory
-namespaces parser prettyprint sequences strings words ;
+USING: arrays errors hashtables inspector io kernel lists math
+memory namespaces parser prettyprint sequences strings words
+vectors ;
 
 TUPLE: assert got expect ;
 
 M: assert summary drop "Assertion failed" ;
 
-: assert= ( a b -- )
-    2dup = [ 2drop ] [ <assert> throw ] if ;
+: assert= ( a b -- ) 2dup = [ 2drop ] [ <assert> throw ] if ;
 
-: print-test ( input output -- )
-    "--> " write 2array . flush ;
+: print-test ( input output -- ) "--> " write 2array . flush ;
 
 : benchmark ( quot -- gctime runtime )
     millis >r gc-time >r call gc-time r> - millis r> - ;
@@ -26,7 +25,7 @@ M: assert summary drop "Assertion failed" ;
         [
             2dup print-test
             swap >r >r clear r> call
-            datastack >list r> assert=
+            datastack r> >vector assert=
         ] keep-datastack 2drop
     ] time ;
 
@@ -38,10 +37,10 @@ M: assert summary drop "Assertion failed" ;
 
 SYMBOL: failures
 
-: failure failures [ cons ] change ;
+: failure failures [ ?push ] change ;
 
 : test-handler ( name quot -- ? )
-    catch [ dup error. cons failure f ] [ t ] if* ;
+    catch [ dup error. 2array failure f ] [ t ] if* ;
 
 : test-path ( name -- path )
     "/library/test/" swap ".factor" append3 ;
@@ -55,15 +54,14 @@ SYMBOL: failures
     ] test-handler ;
 
 : prepare-tests ( -- )
-    failures off
-    vocabularies get [ "temporary" off ] bind ;
+    failures off "temporary" forget-vocab ;
 
 : passed.
     "Tests passed:" print . ;
 
 : failed.
     "Tests failed:" print
-    failures get [ unswons write ": " write error. ] each ;
+    failures get [ first2 swap write ": " write error. ] each ;
 
 : run-tests ( list -- )
     prepare-tests [ test ] subset terpri passed. failed. ;
@@ -103,10 +101,10 @@ SYMBOL: failures
 : compiler-tests
     {
         "io/buffer"
-        "compiler/simple"
+        "compiler/simple" "compiler/templates"
         "compiler/stack" "compiler/ifte"
         "compiler/generic" "compiler/bail-out"
-        "compiler/linearizer" "compiler/intrinsics"
+        "compiler/intrinsics" "compiler/float"
         "compiler/identities" "compiler/optimizer"
         "compiler/alien" "compiler/callbacks"
     } run-tests ;
diff --git a/library/threads.factor b/library/threads.factor
index a9a901c819..1534c9a42e 100644
--- a/library/threads.factor
+++ b/library/threads.factor
@@ -1,8 +1,8 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
+! Copyright (C) 2004, 2006 Slava Pestov.
 ! Copyright (C) 2005 Mackenzie Straight.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 IN: threads
-USING: errors hashtables io-internals kernel lists math
+USING: arrays errors hashtables io-internals kernel math
 namespaces queues sequences vectors ;
 
 ! Co-operative multitasker.
@@ -14,16 +14,16 @@ namespaces queues sequences vectors ;
 : sleep-queue ( -- vec ) \ sleep-queue get-global ;
 
 : sleep-queue* ( -- vec )
-    sleep-queue dup [ 2car swap - ] nsort ;
+    sleep-queue dup [ [ first ] 2apply swap - ] nsort ;
 
 : sleep-time ( sorted-queue -- ms )
-    dup empty? [ drop -1 ] [ peek car millis - 0 max ] if ;
+    dup empty? [ drop 1000 ] [ peek first millis - 0 max ] if ;
 
 DEFER: next-thread
 
 : do-sleep ( -- continuation )
     sleep-queue* dup sleep-time dup zero?
-    [ drop pop cdr ] [ nip io-multiplex next-thread ] if ;
+    [ drop pop second ] [ nip io-multiplex next-thread ] if ;
 
 : next-thread ( -- continuation )
     run-queue dup queue-empty? [ drop do-sleep ] [ deque ] if ;
@@ -33,7 +33,7 @@ DEFER: next-thread
 : yield ( -- ) [ schedule-thread stop ] callcc0 ;
 
 : sleep ( ms -- )
-    millis + [ cons sleep-queue push stop ] callcc0 drop ;
+    millis + [ 2array sleep-queue push stop ] callcc0 drop ;
 
 : in-thread ( quot -- )
     [
diff --git a/library/tools/annotations.factor b/library/tools/annotations.factor
index 093ad0a71b..939eafa816 100644
--- a/library/tools/annotations.factor
+++ b/library/tools/annotations.factor
@@ -27,9 +27,5 @@ sequences strings walker ;
         nip [ swap % dup [ walk ] curry , , \ if , ] [ ] make
     ] annotate ;
 
-: with-profile ( quot word -- )
-    millis >r >r call r> millis r> - swap global [ +@ ] bind ;
-    inline
-
 : profile ( word -- )
-    [ swap [ with-profile ] curry cons ] annotate ;
+    [ swap [ global [ inc ] bind ] curry swap append ] annotate ;
diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor
index 59824fb5c9..6aa4d5b68e 100644
--- a/library/tools/debugger.factor
+++ b/library/tools/debugger.factor
@@ -88,7 +88,17 @@ M: kernel-error error. ( error -- )
         [ objc-error. ]
     } dispatch ;
 
-M: no-method summary drop "No suitable method" ;
+M: no-method summary
+    "No suitable method" ;
+
+M: no-method error. ( error -- )
+    "Generic word " write
+    dup no-method-generic pprint
+    " does not define a method for the " write
+    dup no-method-object class pprint
+    " class." print
+    "Allowed classes: " write dup no-method-generic order .
+    "Dispatching on object: " write no-method-object short. ;
 
 M: no-math-method summary drop "No suitable arithmetic method" ;
 
diff --git a/library/tools/describe.factor b/library/tools/describe.factor
index a27b209d06..69c5a66632 100644
--- a/library/tools/describe.factor
+++ b/library/tools/describe.factor
@@ -10,8 +10,11 @@ GENERIC: summary ( object -- string )
     0 > "a positive " "a negative " ? ;
 
 M: integer summary
-    dup sign-string over 2 mod zero? "even " "odd " ?
-    rot class word-name append3 ;
+    dup zero? [
+        "a " "zero "
+    ] [
+        dup sign-string over 2 mod zero? "even " "odd " ?
+    ] if rot class word-name append3 ;
 
 M: real summary
     dup sign-string swap class word-name append ;
@@ -28,7 +31,7 @@ M: object summary
 
 : slot-sheet ( obj -- sheet )
     dup class "slots" word-prop
-    dup [ second ] map -rot
+    dup [ third ] map -rot
     [ first slot ] map-with
     2array ;
 
diff --git a/library/tools/interpreter.factor b/library/tools/interpreter.factor
index df03029438..27882139df 100644
--- a/library/tools/interpreter.factor
+++ b/library/tools/interpreter.factor
@@ -12,9 +12,11 @@ namespaces prettyprint sequences strings vectors words ;
 SYMBOL: meta-r
 : push-r meta-r get push ;
 : pop-r meta-r get pop ;
+: peek-r meta-r get peek ;
 SYMBOL: meta-d
 : push-d meta-d get push ;
 : pop-d meta-d get pop ;
+: peek-d meta-d get peek ;
 SYMBOL: meta-n
 SYMBOL: meta-c
 
diff --git a/library/tools/listener.factor b/library/tools/listener.factor
index 10a94dd78a..d37d1b0c40 100644
--- a/library/tools/listener.factor
+++ b/library/tools/listener.factor
@@ -9,8 +9,10 @@ SYMBOL: quit-flag
 
 SYMBOL: listener-hook
 SYMBOL: datastack-hook
+SYMBOL: error-hook
 
 "  " listener-prompt set-global
+[ drop terpri debug-help ] error-hook set-global
 
 : bye ( -- ) quit-flag on ;
 
@@ -28,10 +30,16 @@ SYMBOL: datastack-hook
 : read-multiline ( -- quot ? )
     [ f depth (read-multiline) >r reverse r> ] with-parser ;
 
+: listen-try
+    [
+        print-error error-continuation get error-hook get call
+    ] recover ;
+
 : listen ( -- )
     listener-hook get call
     listener-prompt get write flush
-    [ read-multiline [ call ] [ bye ] if ] try ;
+    [ read-multiline [ call ] [ bye ] if ]
+    listen-try ;
 
 : (listener) ( -- )
     quit-flag get [ quit-flag off ] [ listen (listener) ] if ;
diff --git a/library/ui/labels.factor b/library/ui/labels.factor
index 366eed992a..5aeac166a2 100644
--- a/library/ui/labels.factor
+++ b/library/ui/labels.factor
@@ -27,7 +27,6 @@ M: label pref-dim* ( label -- dim ) label-size ;
 
 : draw-label ( label -- )
     dup label-color gl-color
-    dup label-font* dup world get font-sprites rot
-    label-text draw-string ;
+    dup label-font* swap label-text draw-string ;
 
 M: label draw-gadget* ( label -- ) draw-label ;
diff --git a/library/ui/listener.factor b/library/ui/listener.factor
index 052946f3c6..248a491db3 100644
--- a/library/ui/listener.factor
+++ b/library/ui/listener.factor
@@ -3,9 +3,9 @@
 IN: gadgets-listener
 USING: arrays gadgets gadgets-editors gadgets-labels
 gadgets-layouts gadgets-panes gadgets-scrolling
-gadgets-splitters gadgets-theme generic hashtables
-io jedit kernel listener lists math
-namespaces parser prettyprint sequences threads words ;
+gadgets-splitters gadgets-theme generic hashtables io jedit
+kernel listener lists math namespaces parser prettyprint
+sequences styles threads words ;
 
 TUPLE: listener-gadget pane stack ;
 
@@ -32,9 +32,15 @@ TUPLE: listener-gadget pane stack ;
     ] keep
     listener-gadget-pane word-completion ;
 
+: ui-error-hook ( error -- )
+    terpri H{ { font-style bold } } [
+        "Debug this error" swap simple-object terpri
+    ] with-style ;
+
 : listener-thread ( listener -- )
     dup listener-gadget-pane [
         [ ui-listener-hook ] curry listener-hook set
+        [ ui-error-hook ] error-hook set
         print-banner listener
     ] with-stream* ;
 
diff --git a/library/ui/world.factor b/library/ui/world.factor
index 62d4e45f80..3e0f3edcac 100644
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -45,3 +45,6 @@ M: world pref-dim* ( world -- dim )
 
 : focused-ancestors ( world -- seq )
     world-focus parents reverse-slice ;
+
+: draw-string ( open-fonts string -- )
+    >r dup world get font-sprites r> (draw-string) ;
diff --git a/library/unix/io.factor b/library/unix/io.factor
index eb68bc3956..623b3e70f1 100644
--- a/library/unix/io.factor
+++ b/library/unix/io.factor
@@ -1,5 +1,5 @@
-! 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: io-internals
 USING: alien arrays errors generic hashtables io kernel
 kernel-internals lists math parser queues sequences strings
@@ -66,7 +66,7 @@ C: port ( handle buffer -- port )
     80 <sbuf> over set-port-sbuf ;
 
 : touch-port ( port -- )
-    dup port-timeout dup 0 =
+    dup port-timeout dup zero?
     [ 2drop ] [ millis + swap set-port-cutoff ] if ;
 
 M: port set-timeout ( timeout port -- )
@@ -104,7 +104,7 @@ GENERIC: task-container ( task -- vector )
 : add-io-task ( callback task -- )
     [ >r <queue> [ enque ] keep r> set-io-task-callbacks ] keep
     dup io-task-fd over task-container 2dup hash [
-        "Cannot perform multiple I/O ops on the same port" throw
+        "Cannot perform multiple reads from the same port" throw
     ] when set-hash ;
 
 : remove-io-task ( task -- )
@@ -115,11 +115,8 @@ GENERIC: task-container ( task -- vector )
     queue-empty? [ remove-io-task ] [ drop ] if r> ;
 
 : handle-fd ( task -- )
-    dup do-io-task [
-        dup io-task-port touch-port pop-callback continue
-    ] [
-        drop
-    ] if ;
+    dup io-task-port touch-port dup do-io-task
+    [ pop-callback continue ] [ drop ] if ;
 
 : timeout? ( port -- ? )
     port-cutoff dup zero? not swap millis < and ;
@@ -136,18 +133,23 @@ GENERIC: task-container ( task -- vector )
     ] hash-each-with ;
 
 : init-fdset ( fdset tasks -- )
-    >r dup FD_SETSIZE clear-bits r>
+    >r dup dup FD_SETSIZE clear-bits r>
     [ drop t swap rot set-bit-nth ] hash-each-with ;
 
+: read-fdset/tasks
+    read-fdset get-global read-tasks get-global ;
+
+: write-fdset/tasks
+    write-fdset get-global write-tasks get-global ;
+
 : init-fdsets ( -- read write except )
-    read-fdset get [ read-tasks get init-fdset ] keep
-    write-fdset get [ write-tasks get init-fdset ] keep
-    f ;
+    read-fdset/tasks init-fdset
+    write-fdset/tasks init-fdset f ;
 
 : io-multiplex ( timeout -- )
-    >r FD_SETSIZE init-fdsets r> make-timeval select ( io-error ) drop
-    read-fdset get read-tasks get handle-fdset
-    write-fdset get write-tasks get handle-fdset ;
+    >r FD_SETSIZE init-fdsets r> make-timeval select io-error
+    read-fdset/tasks handle-fdset
+    write-fdset/tasks handle-fdset ;
 
 ! Readers
 
@@ -206,12 +208,12 @@ M: read-task do-io-task ( task -- ? )
         2drop f
     ] if ;
 
-M: read-task task-container drop read-tasks get ;
+M: read-task task-container drop read-tasks get-global ;
 
 : wait-to-read ( count port -- )
     2dup can-read-count? [
         [ -rot <read-task> add-io-task stop ] callcc0
-    ] unless 2drop ;
+    ] unless pending-error drop ;
 
 M: port stream-read ( count stream -- string )
     dup input check-port
@@ -255,24 +257,14 @@ C: write-task ( port -- task )
     [ >r <io-task> r> set-delegate ] keep ;
 
 M: write-task do-io-task
-    io-task-port dup buffer-length zero? over port-error or [
-        0 swap buffer-reset t
-    ] [
-        write-step f
-    ] if ;
+    io-task-port dup buffer-length zero? over port-error or
+    [ 0 swap buffer-reset t ] [ write-step f ] if ;
 
-M: write-task task-container drop write-tasks get ;
+M: write-task task-container drop write-tasks get-global ;
 
 : add-write-io-task ( callback task -- )
-    dup io-task-fd write-tasks get hash [
-        dup write-task? [
-            nip io-task-callbacks enque
-        ] [
-            drop add-io-task
-        ] if
-    ] [
-        add-io-task
-    ] if* ;
+    dup io-task-fd write-tasks get-global hash
+    [ io-task-callbacks enque ] [ add-io-task ] ?if ;
 
 : port-flush ( port -- )
     [ swap <write-task> add-write-io-task stop ] callcc0 drop ;
@@ -292,8 +284,8 @@ M: port stream-write ( string writer -- )
 
 M: port stream-close ( stream -- )
     dup port-type closed eq? [
-        dup port-type output eq? >r closed over set-port-type r>
-        [ dup port-flush ] when dup port-handle close
+        dup port-type >r closed over set-port-type r>
+        output eq? [ dup port-flush ] when dup port-handle close
         dup delegate [ buffer-free ] when* f over set-delegate
     ] unless drop ;
 
diff --git a/library/unix/syscalls.factor b/library/unix/syscalls.factor
index c859a14f1f..4a73b53929 100644
--- a/library/unix/syscalls.factor
+++ b/library/unix/syscalls.factor
@@ -22,14 +22,10 @@ BEGIN-STRUCT: timeval
 END-STRUCT
 
 : make-timeval ( ms -- timeval )
-    dup -1 = [
-        drop f
-    ] [
-        1000 /mod 1000 *
-        "timeval" <c-object>
-        [ set-timeval-usec ] keep
-        [ set-timeval-sec ] keep
-    ] if ;
+    1000 /mod 1000 *
+    "timeval" <c-object>
+    [ set-timeval-usec ] keep
+    [ set-timeval-sec ] keep ;
 
 FUNCTION: int select ( int nfds, void* readfds, void* writefds, void* exceptfds, timeval* timeout ) ;
 
diff --git a/library/windows/load.factor b/library/windows/load.factor
index f41cb2e218..e68cbfae05 100644
--- a/library/windows/load.factor
+++ b/library/windows/load.factor
@@ -32,4 +32,4 @@ USING: alien compiler kernel namespaces parser sequences words ;
 ] when
 
 IN: kernel
-: default-shell "tty" ;
+: default-shell "ui" ;
diff --git a/library/words.factor b/library/words.factor
index b19cf032da..33c3002c0a 100644
--- a/library/words.factor
+++ b/library/words.factor
@@ -116,7 +116,6 @@ SYMBOL: vocabularies
     all-words swap subset-with ; inline
 
 : xref-words ( -- )
-    H{ } clone crossref set
     all-words [ uses ] crossref get add-vertices ;
 
 : lookup ( name vocab -- word ) vocab ?hash ;
@@ -141,6 +140,9 @@ SYMBOL: vocabularies
     dup unxref-word
     dup word-name swap word-vocabulary vocab remove-hash ;
 
+: forget-vocab ( vocab -- )
+    vocabularies get remove-hash xref-words ;
+
 : target-word ( word -- word )
     dup word-name swap word-vocabulary lookup ;
 
diff --git a/library/x11/events.factor b/library/x11/events.factor
index c9ff273430..59519fc681 100644
--- a/library/x11/events.factor
+++ b/library/x11/events.factor
@@ -30,9 +30,6 @@ GENERIC: client-event ( event window -- )
 
 : events-queued ( mode -- n ) >r dpy get r> XEventsQueued ;
 
-: next-event ( -- event )
-    dpy get "XEvent" <c-object> dup >r XNextEvent drop r> ;
-
 : wait-event ( -- event )
     QueuedAfterFlush events-queued 0 >
     [ next-event ] [ ui-step wait-event ] if ;
diff --git a/native/factor.c b/native/factor.c
index 6e4f31389b..4ddac15031 100644
--- a/native/factor.c
+++ b/native/factor.c
@@ -64,6 +64,7 @@ int main(int argc, char** argv)
 	CELL literal_size = 128;
 	CELL args;
 	CELL i;
+	bool image_given = true;
 
 	early_init();
 
@@ -88,7 +89,10 @@ int main(int argc, char** argv)
 	}
 
 	if(image == NULL)
+	{
+		image_given = false;
 		image = default_image_path();
+	}
 
 	init_factor(image,
 		ds_size * 1024,
@@ -100,7 +104,7 @@ int main(int argc, char** argv)
 		literal_size * 1024);
 
 	args = F;
-	while(--argc > 1)
+	while(--argc > (image_given ? 1 : 0))
 	{
 		args = cons(tag_object(from_c_string(argv[argc])),args);
 	}
diff --git a/native/fixnum.c b/native/fixnum.c
index b23db2b15f..ce90f4b233 100644
--- a/native/fixnum.c
+++ b/native/fixnum.c
@@ -42,6 +42,13 @@ void primitive_fixnum_add(void)
 	box_signed_cell(x + y);
 }
 
+void primitive_fixnum_add_fast(void)
+{
+	F_FIXNUM y = untag_fixnum_fast(dpop());
+	F_FIXNUM x = untag_fixnum_fast(dpop());
+	dpush(tag_fixnum(x + y));
+}
+
 void primitive_fixnum_subtract(void)
 {
 	F_FIXNUM y = untag_fixnum_fast(dpop());
@@ -49,6 +56,13 @@ void primitive_fixnum_subtract(void)
 	box_signed_cell(x - y);
 }
 
+void primitive_fixnum_subtract_fast(void)
+{
+	F_FIXNUM y = untag_fixnum_fast(dpop());
+	F_FIXNUM x = untag_fixnum_fast(dpop());
+	dpush(tag_fixnum(x - y));
+}
+
 /**
  * Multiply two integers, and trap overflow.
  * Thanks to David Blaikie (The_Vulture from freenode #java) for the hint.
diff --git a/native/fixnum.h b/native/fixnum.h
index df60e52a56..99b4e68676 100644
--- a/native/fixnum.h
+++ b/native/fixnum.h
@@ -13,6 +13,8 @@ void primitive_to_fixnum(void);
 
 void primitive_fixnum_add(void);
 void primitive_fixnum_subtract(void);
+void primitive_fixnum_add_fast(void);
+void primitive_fixnum_subtract_fast(void);
 void primitive_fixnum_multiply(void);
 void primitive_fixnum_divint(void);
 void primitive_fixnum_divfloat(void);
diff --git a/native/gc.h b/native/gc.h
index 07482fcbdb..0151aa9b95 100644
--- a/native/gc.h
+++ b/native/gc.h
@@ -18,7 +18,7 @@ CELL gen_count;
 /* the oldest generation */
 #define TENURED (gen_count-1)
 
-ZONE *generations;
+DLLEXPORT ZONE *generations;
 
 /* used during garbage collection only */
 ZONE *newspace;
diff --git a/native/macosx/run.m b/native/macosx/run.m
index 5545dac8ae..6e4d69ce2e 100644
--- a/native/macosx/run.m
+++ b/native/macosx/run.m
@@ -42,7 +42,6 @@ void early_init(void)
 const char *default_image_path(void)
 {
 	NSBundle *bundle = [NSBundle mainBundle];
-	NSString *path = [bundle bundlePath];
-	NSString *image = [path stringByAppendingString:@"/Contents/Resources/factor.image"];
+	NSString *image = [[bundle resourcePath] stringByAppendingString:@"/factor.image"];
 	return [image cString];
 }
diff --git a/native/primitives.c b/native/primitives.c
index 610e31d892..bd2ea1226d 100644
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -24,7 +24,9 @@ void* primitives[] = {
 	primitive_bits_double,
 	primitive_from_rect,
 	primitive_fixnum_add,
+	primitive_fixnum_add_fast,
 	primitive_fixnum_subtract,
+	primitive_fixnum_subtract_fast,
 	primitive_fixnum_multiply,
 	primitive_fixnum_divint,
 	primitive_fixnum_divfloat,
@@ -191,8 +193,5 @@ void* primitives[] = {
 
 CELL primitive_to_xt(CELL primitive)
 {
-	if(primitive < 0 || primitive >= PRIMITIVE_COUNT)
-		return (CELL)undefined;
-	else
-		return (CELL)primitives[primitive];
+	return (CELL)primitives[primitive];
 }
diff --git a/native/primitives.h b/native/primitives.h
index 809f0f05b5..2ed5cdc768 100644
--- a/native/primitives.h
+++ b/native/primitives.h
@@ -1,4 +1,3 @@
 extern void* primitives[];
-#define PRIMITIVE_COUNT 190
 
 CELL primitive_to_xt(CELL primitive);
diff --git a/version.factor b/version.factor
index cd4fdfd04d..2f8468adf4 100644
--- a/version.factor
+++ b/version.factor
@@ -1,2 +1,2 @@
 IN: kernel
-: version "0.81" ;
+: version "0.82" ;