diff --git a/core/compiler/constants/constants.factor b/core/compiler/constants/constants.factor
index 3de32ab7fa..66fc8d5789 100755
--- a/core/compiler/constants/constants.factor
+++ b/core/compiler/constants/constants.factor
@@ -19,4 +19,4 @@ IN: compiler.constants
 : class-hash-offset bootstrap-cell object tag-number - ;
 : word-xt-offset 8 bootstrap-cells object tag-number - ;
 : word-code-offset 9 bootstrap-cells object tag-number - ;
-: compiled-header-size 8 bootstrap-cells ;
+: compiled-header-size 4 bootstrap-cells ;
diff --git a/core/compiler/test/redefine.factor b/core/compiler/test/redefine.factor
index 821daef203..6e652df877 100755
--- a/core/compiler/test/redefine.factor
+++ b/core/compiler/test/redefine.factor
@@ -17,7 +17,7 @@ DEFER: x-2
 
         { x-1 } compile
 
-        \ x-2 word-xt eq?
+        \ x-2 word-xt =
     ] unit-test
 ] with-variable
 
@@ -115,7 +115,7 @@ DEFER: g-test-3
 
     "IN: temporary USE: math GENERIC: g-test-1 ( x -- y ) M: integer g-test-1 3 + ;" eval
 
-    \ g-test-3 word-xt eq?
+    \ g-test-3 word-xt =
 ] unit-test
 
 DEFER: g-test-5
diff --git a/core/compiler/test/templates-early.factor b/core/compiler/test/templates-early.factor
index 795d331c00..e518d2de8a 100755
--- a/core/compiler/test/templates-early.factor
+++ b/core/compiler/test/templates-early.factor
@@ -44,7 +44,7 @@ words kernel math effects definitions compiler.units ;
 [
     [ ] [ init-templates ] unit-test
 
-    [ ] [ \ + init-generator ] unit-test
+    [ ] [ init-generator ] unit-test
 
     [ t ] [ [ end-basic-block ] { } make empty? ] unit-test
 
diff --git a/core/cpu/architecture/architecture.factor b/core/cpu/architecture/architecture.factor
index 2409eafaf0..e48ba97f33 100755
--- a/core/cpu/architecture/architecture.factor
+++ b/core/cpu/architecture/architecture.factor
@@ -72,8 +72,6 @@ HOOK: %jump-dispatch compiler-backend ( -- )
 
 HOOK: %dispatch-label compiler-backend ( word -- )
 
-HOOK: %end-dispatch compiler-backend ( label -- )
-
 ! Return to caller
 HOOK: %return compiler-backend ( -- )
 
diff --git a/core/cpu/ppc/architecture/architecture.factor b/core/cpu/ppc/architecture/architecture.factor
index a156c173a1..edbed571e1 100755
--- a/core/cpu/ppc/architecture/architecture.factor
+++ b/core/cpu/ppc/architecture/architecture.factor
@@ -144,9 +144,6 @@ M: ppc-backend %jump-dispatch ( -- )
 M: ppc-backend %dispatch-label ( word -- )
     0 , rc-absolute-cell rel-word ;
 
-M: ppc-backend %end-dispatch ( label -- )
-    resolve-label ;
-
 M: ppc-backend %return ( -- ) %epilogue-later BLR ;
 
 M: ppc-backend %unwind drop %return ;
diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor
index 96b2dcf1ec..876c631b81 100755
--- a/core/cpu/x86/architecture/architecture.factor
+++ b/core/cpu/x86/architecture/architecture.factor
@@ -85,7 +85,7 @@ M: x86-backend %jump-label ( label -- ) JMP ;
 M: x86-backend %jump-t ( label -- )
     "flag" operand f v>operand CMP JNE ;
 
-: (%dispatch) ( -- operand )
+: (%dispatch) ( n -- operand )
     ! Load jump table base. We use a temporary register
     ! since on AMD64 we have to load a 64-bit immediate. On
     ! x86, this is redundant.
@@ -94,18 +94,20 @@ M: x86-backend %jump-t ( label -- )
     ! Add jump table base
     "offset" operand HEX: ffffffff MOV rc-absolute-cell rel-here
     "n" operand "offset" operand ADD
-    "n" operand bootstrap-cell 8 = 14 9 ? [+] ;
+    "n" operand swap bootstrap-cell 8 = 14 9 ? + [+] ;
 
 M: x86-backend %call-dispatch ( word-table# -- )
-    [ (%dispatch) CALL <label> dup JMP ] H{
+    [ 5 (%dispatch) CALL <label> dup JMP ] H{
         { +input+ { { f "n" } } }
         { +scratch+ { { f "offset" } } }
+        { +clobber+ { "n" } }
     } with-template ;
 
 M: x86-backend %jump-dispatch ( -- )
-    [ %epilogue-later (%dispatch) JMP ] H{
+    [ %epilogue-later 0 (%dispatch) JMP ] H{
         { +input+ { { f "n" } } }
         { +scratch+ { { f "offset" } } }
+        { +clobber+ { "n" } }
     } with-template ;
 
 M: x86-backend %dispatch-label ( word -- )
diff --git a/core/generator/fixup/fixup-docs.factor b/core/generator/fixup/fixup-docs.factor
index 284af26a9b..7f4b5026da 100644
--- a/core/generator/fixup/fixup-docs.factor
+++ b/core/generator/fixup/fixup-docs.factor
@@ -13,13 +13,6 @@ HELP: add-literal
 { $values { "obj" object } { "n" integer } }
 { $description "Adds a literal to the " { $link literal-table } ", if it is not already there, and outputs the index of the literal in the table. This literal can then be used as an argument for a " { $link rt-literal } " relocation with " { $link rel-fixup } "." } ;
 
-HELP: word-table
-{ $var-description "Holds a vector of words called from the currently compiling word." } ;
-
-HELP: add-word
-{ $values { "word" word } { "n" integer } }
-{ $description "Adds a word to the " { $link word-table } ", if it is not already there, and outputs the index of the word in the table. This literal can then be used as an argument for a " { $link rt-xt } " relocation with " { $link rel-fixup } "." } ;
-
 HELP: string>symbol
 { $values { "str" string } { "alien" alien } }
 { $description "Converts the string to a format which is a valid symbol name for the Factor VM's compiled code linker. By performing this conversion ahead of time, the image loader can run without allocating memory."
diff --git a/core/generator/fixup/fixup.factor b/core/generator/fixup/fixup.factor
index 3a30a51d09..17c0c64bf1 100755
--- a/core/generator/fixup/fixup.factor
+++ b/core/generator/fixup/fixup.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic assocs hashtables
 kernel kernel.private math namespaces sequences words
@@ -110,10 +110,6 @@ SYMBOL: literal-table
 
 : add-literal ( obj -- n ) literal-table get push-new* ;
 
-SYMBOL: word-table
-
-: add-word ( word -- n ) word-table get push-new* ;
-
 : string>symbol ( str -- alien )
     wince? [ string>u16-alien ] [ string>char-alien ] if ;
 
@@ -125,10 +121,8 @@ SYMBOL: word-table
     add-dlsym-literals
     r> r> rt-dlsym rel-fixup ;
 
-: rel-dispatch ( word-table# class -- ) rt-dispatch rel-fixup ;
-
 : rel-word ( word class -- )
-    >r add-word r> rt-xt rel-fixup ;
+    >r add-literal r> rt-xt rel-fixup ;
 
 : rel-primitive ( word class -- )
     >r word-def first r> rt-primitive rel-fixup ;
diff --git a/core/generator/generator.factor b/core/generator/generator.factor
index 1c23e51e12..df01f9e490 100755
--- a/core/generator/generator.factor
+++ b/core/generator/generator.factor
@@ -1,22 +1,20 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes combinators cpu.architecture
 effects generator.fixup generator.registers generic hashtables
 inference inference.backend inference.dataflow io kernel
 kernel.private layouts math namespaces optimizer prettyprint
-quotations sequences system threads words ;
+quotations sequences system threads words vectors ;
 IN: generator
 
 SYMBOL: compile-queue
 SYMBOL: compiled
 
-: 5array 3array >r 2array r> append ;
-
 : begin-compiling ( word -- )
     f swap compiled get set-at ;
 
-: finish-compiling ( word literals words relocation labels code -- )
-    5array swap compiled get set-at ;
+: finish-compiling ( word literals relocation labels code -- )
+    4array swap compiled get set-at ;
 
 : queue-compile ( word -- )
     {
@@ -38,20 +36,18 @@ SYMBOL: current-label-start
 
 : compiled-stack-traces? ( -- ? ) 36 getenv ;
 
-: init-generator ( compiling -- )
-    V{ } clone literal-table set
-    V{ } clone word-table set
-    compiled-stack-traces? swap f ?
-    literal-table get push ;
+: init-generator ( -- )
+    compiled-stack-traces?
+    compiling-word get  f ?
+    1vector literal-table set ;
 
 : generate-1 ( word label node quot -- )
     pick begin-compiling [
         roll compiling-word set
         pick compiling-label set
-        compiling-word get init-generator
+        init-generator
         call
         literal-table get >array
-        word-table get >array
     ] { } make fixup finish-compiling ;
 
 GENERIC: generate-node ( node -- next )
@@ -182,7 +178,7 @@ M: #dispatch generate-node
         %jump-dispatch dispatch-branches
     ] [
         0 frame-required
-        %call-dispatch >r dispatch-branches r> %end-dispatch
+        %call-dispatch >r dispatch-branches r> resolve-label
     ] if
     init-templates iterate-next ;
 
diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor
index 851a58ecd6..6cc7f7f3e8 100755
--- a/core/generic/standard/standard.factor
+++ b/core/generic/standard/standard.factor
@@ -139,7 +139,8 @@ TUPLE: no-method object generic ;
 
 M: standard-combination perform-combination
     standard-combination-# (dispatch#) [
-        standard-methods single-combination
+        [ standard-methods ] keep "inline" word-prop
+        [ small-generic ] [ single-combination ] if
     ] with-variable ;
 
 : default-hook-method ( word -- pair )
diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor
index 2cb308b619..c294c23738 100755
--- a/core/kernel/kernel-tests.factor
+++ b/core/kernel/kernel-tests.factor
@@ -1,6 +1,6 @@
 USING: arrays byte-arrays kernel kernel.private math memory
 namespaces sequences tools.test math.private quotations
-continuations prettyprint io.streams.string debugger ;
+continuations prettyprint io.streams.string debugger assocs ;
 IN: temporary
 
 [ 0 ] [ f size ] unit-test
diff --git a/core/optimizer/known-words/known-words.factor b/core/optimizer/known-words/known-words.factor
index 1d8395d667..6828a0948c 100755
--- a/core/optimizer/known-words/known-words.factor
+++ b/core/optimizer/known-words/known-words.factor
@@ -14,8 +14,8 @@ float-arrays combinators.private combinators ;
 ! its second-to-last input
 { <tuple> <tuple-boa> } [
     [
-        node-in-d dup length 2 - swap nth dup value?
-        [ value-literal ] [ drop tuple ] if 1array f
+        dup node-in-d dup length 2 - swap nth node-literal
+        dup class? [ drop tuple ] unless 1array f
     ] "output-classes" set-word-prop
 ] each
 
diff --git a/extra/balloon-bomber/balloon-bomber-docs.factor b/extra/balloon-bomber/balloon-bomber-docs.factor
index ad7464aa64..694ac1882a 100644
--- a/extra/balloon-bomber/balloon-bomber-docs.factor
+++ b/extra/balloon-bomber/balloon-bomber-docs.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup cpu.8080 ;
+USING: help.syntax help.markup cpu.8080.emulator ;
 IN: balloon-bomber
 
 HELP: run 
diff --git a/extra/cpu/8080/8080-docs.factor b/extra/cpu/8080/8080-docs.factor
index c92d26ec3a..48b68360cb 100644
--- a/extra/cpu/8080/8080-docs.factor
+++ b/extra/cpu/8080/8080-docs.factor
@@ -1,39 +1,8 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax sequences strings ;
+USING: help.markup help.syntax sequences strings cpu.8080.emulator ;
 IN: cpu.8080
 
-HELP: load-rom 
-{ $values { "filename" string } { "cpu" cpu } }
-{ $description 
-"Read the ROM file into the cpu's memory starting at address 0000. " 
-"The filename is relative to the path stored in the " { $link rom-root }
-" variable. An exception is thrown if this variable is not set."
-}
-{ $see-also load-rom* } ;
-
-HELP: load-rom*
-{ $values { "seq" sequence } { "cpu" cpu } }
-{ $description 
-"Loads one or more ROM files into the cpu's memory. Each file is "
-"loaded at a particular starting address. 'seq' is a sequence of "
-"2 element arrays. The first element is the address and the second "
-"element is the file to load at that address." $nl
-"The filenames are relative to the path stored in the " { $link rom-root }
-" variable. An exception is thrown if this variable is not set."
-}
-{ $examples
-  { $code "{ { HEX: 0000 \"invaders.rom\" } } <cpu> load-rom*" }
-}
-{ $see-also load-rom } ;
-
-HELP: rom-root
-{ $description 
-"Holds the path where the ROM files are stored. Used for expanding "
-"the relative filenames passed to " { $link load-rom } " and "
-{ $link load-rom* } "."
-}
-{ $see-also load-rom load-rom* } ;
 
 ARTICLE: { "cpu-8080" "cpu-8080" } "Intel 8080 CPU Emulator"
 "The cpu-8080 library provides an emulator for the Intel 8080 CPU"
diff --git a/extra/cpu/8080/8080.factor b/extra/cpu/8080/8080.factor
index d05c3ab634..fa88cf6c6a 100644
--- a/extra/cpu/8080/8080.factor
+++ b/extra/cpu/8080/8080.factor
@@ -1,1358 +1,254 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 !
-USING: kernel math sequences words arrays io 
-       io.files namespaces math.parser kernel.private
-       assocs quotations parser parser-combinators tools.time
-       combinators.private compiler.units ;
+USING: cpu.8080.emulator tools.time ;
 IN: cpu.8080
 
-TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles ram ;
-
-GENERIC: reset        ( cpu            -- )
-GENERIC: update-video ( value addr cpu -- )
-GENERIC: read-port    ( port cpu       -- byte )
-GENERIC: write-port   ( value port cpu -- )
-
-M: cpu update-video ( value addr cpu -- )
-  3drop ;
-
-M: cpu read-port ( port cpu -- byte )
-  #! Read a byte from the hardware port. 'port' should
-  #! be an 8-bit value.
-  2drop 0 ;
-
-M: cpu write-port ( value port cpu -- )
-  #! Write a byte to the hardware port, where 'port' is
-  #! an 8-bit value.
-  3drop ;
-
-: carry-flag        HEX: 01 ; inline
-: parity-flag       HEX: 04 ; inline
-: half-carry-flag   HEX: 10 ; inline
-: interrupt-flag    HEX: 20 ; inline
-: zero-flag         HEX: 40 ; inline
-: sign-flag         HEX: 80 ; inline
-
-: >word< ( word -- byte byte )
-  #! Explode a word into its two 8 bit values.
-  dup HEX: FF bitand swap -8 shift HEX: FF bitand swap ;
-
-: cpu-af ( cpu -- word )
-  #! Return the 16-bit pseudo register AF.
-  [ cpu-a 8 shift ] keep cpu-f bitor ;
-
-: set-cpu-af ( value cpu -- )
-  #! Set the value of the 16-bit pseudo register AF
-  >r >word< r> tuck set-cpu-f set-cpu-a ;
-
-: cpu-bc ( cpu -- word )
-  #! Return the 16-bit pseudo register BC.
-  [ cpu-b 8 shift ] keep cpu-c bitor ;
-
-: set-cpu-bc ( value cpu -- )
-  #! Set the value of the 16-bit pseudo register BC
-  >r >word< r> tuck set-cpu-c set-cpu-b ;
-
-: cpu-de ( cpu -- word )
-  #! Return the 16-bit pseudo register DE.
-  [ cpu-d 8 shift ] keep cpu-e bitor ;
-
-: set-cpu-de ( value cpu -- )
-  #! Set the value of the 16-bit pseudo register DE
-  >r >word< r> tuck set-cpu-e set-cpu-d ;
-
-: cpu-hl ( cpu -- word )
-  #! Return the 16-bit pseudo register HL.
-  [ cpu-h 8 shift ] keep cpu-l bitor ;
-
-: set-cpu-hl ( value cpu -- )
-  #! Set the value of the 16-bit pseudo register HL
-  >r >word< r> tuck set-cpu-l set-cpu-h ;
-
-: flag-set? ( flag cpu -- bool )
-  cpu-f bitand 0 = not ;
-
-: flag-clear? ( flag cpu -- bool )
-  cpu-f bitand 0 = ;
-
-: flag-nz? ( cpu -- bool )
-  #! Test flag status
-  cpu-f zero-flag bitand 0 = ;
-
-: flag-z? ( cpu -- bool )
-  #! Test flag status
-  cpu-f zero-flag bitand 0 = not ;
-
-: flag-nc? ( cpu -- bool )
-  #! Test flag status
-  cpu-f carry-flag bitand 0 = ;
-
-: flag-c? ( cpu -- bool )
-  #! Test flag status
-  cpu-f carry-flag bitand 0 = not ;
-
-: flag-po? ( cpu -- bool )
-  #! Test flag status
-  cpu-f parity-flag bitand 0 =  ;
-
-: flag-pe? ( cpu -- bool )
-  #! Test flag status
-  cpu-f parity-flag bitand 0 = not ;
-
-: flag-p? ( cpu -- bool )
-  #! Test flag status
-  cpu-f sign-flag bitand 0 = ;
-
-: flag-m? ( cpu -- bool )
-  #! Test flag status
-  cpu-f sign-flag bitand 0 = not ;
-
-: read-byte ( addr cpu -- byte )
-  #! Read one byte from memory at the specified address.
-  #! The address is 16-bit, but if a value greater than
-  #! 0xFFFF is provided then return a default value.
-  over HEX: FFFF <= [
-    cpu-ram nth
-  ] [
-    2drop HEX: FF
-  ] if ;
-
-: read-word ( addr cpu -- word )  
-  #! Read a 16-bit word from memory at the specified address.
-  #! The address is 16-bit, but if a value greater than
-  #! 0xFFFF is provided then return a default value.
-  [ read-byte ] 2keep >r 1 + r> read-byte 8 shift bitor ;
- 
-: next-byte ( cpu -- byte )
-  #! Return the value of the byte at PC, and increment PC.
-  [ cpu-pc ] keep
-  [ read-byte ] keep 
-  [ cpu-pc 1 + ] keep
-  set-cpu-pc ;
-
-: next-word ( cpu -- word )
-  #! Return the value of the word at PC, and increment PC.
-  [ cpu-pc ] keep
-  [ read-word ] keep 
-  [ cpu-pc 2 + ] keep
-  set-cpu-pc ;
-
-
-: write-byte ( value addr cpu -- )
-  #! Write a byte to the specified memory address.
-  over dup HEX: 2000 < swap HEX: FFFF > or [
-    3drop
-  ] [
-    3dup cpu-ram set-nth
-    update-video
-  ] if ;
-
-
-: write-word ( value addr cpu -- )
-  #! Write a 16-bit word to the specified memory address.
-  >r >r >word< r> r> [ write-byte ] 2keep >r 1 + r> write-byte ;
-
-: cpu-a-bitand ( quot cpu -- )
-  #! A &= quot call 
-  [ cpu-a swap call bitand ] keep set-cpu-a ; inline
-
-: cpu-a-bitor ( quot cpu -- )
-  #! A |= quot call 
-  [ cpu-a swap call bitor ] keep set-cpu-a ; inline
-
-: cpu-a-bitxor ( quot cpu -- )
-  #! A ^= quot call 
-  [ cpu-a swap call bitxor ] keep set-cpu-a ; inline
-
-: cpu-a-bitxor= ( value cpu -- )
-  #! cpu-a ^= value
-  [ cpu-a bitxor ] keep set-cpu-a ;
-
-: cpu-f-bitand ( quot cpu -- )
-  #! F &= quot call 
-  [ cpu-f swap call bitand ] keep set-cpu-f ; inline
-
-: cpu-f-bitor ( quot cpu -- )
-  #! F |= quot call 
-  [ cpu-f swap call bitor ] keep set-cpu-f ; inline
-
-: cpu-f-bitxor ( quot cpu -- )
-  #! F |= quot call 
-  [ cpu-f swap call bitxor ] keep set-cpu-f ; inline
-
-: cpu-f-bitor= ( value cpu -- )
-  #! cpu-f |= value
-  [ cpu-f bitor ] keep set-cpu-f ;
-
-: cpu-f-bitand= ( value cpu -- )
-  #! cpu-f &= value
-  [ cpu-f bitand ] keep set-cpu-f ;
-
-: cpu-f-bitxor= ( value cpu -- )
-  #! cpu-f ^= value
-  [ cpu-f bitxor ] keep set-cpu-f ;
-
-: set-flag ( cpu flag -- )
-  swap cpu-f-bitor= ;
-
-: clear-flag ( cpu flag -- )
-   bitnot HEX: FF bitand swap cpu-f-bitand= ;
-
-: update-zero-flag ( result cpu -- )
-  #! If the result of an instruction has the value 0, this
-  #! flag is set, otherwise it is reset.
-  swap HEX: FF bitand 0 = [ zero-flag set-flag ] [ zero-flag clear-flag ] if ;
-
-: update-sign-flag ( result cpu -- )
-  #! If the most significant bit of the result 
-  #! has the value 1 then the flag is set, otherwise
-  #! it is reset.
-  swap HEX: 80 bitand 0 = [ sign-flag clear-flag ] [ sign-flag set-flag ] if ;
-
-: update-parity-flag ( result cpu -- )
-  #! If the modulo 2 sum of the bits of the result
-  #! is 0, (ie. if the result has even parity) this flag
-  #! is set, otherwise it is reset.
-  swap HEX: FF bitand 2 mod 0 = [ parity-flag set-flag ] [ parity-flag clear-flag ] if ;
-
-: update-carry-flag ( result cpu -- )
-  #! If the instruction resulted in a carry (from addition) 
-  #! or a borrow (from subtraction or a comparison) out of the
-  #! higher order bit, this flag is set, otherwise it is reset.
-  swap dup HEX: 100 >= swap 0 < or [ carry-flag set-flag ] [ carry-flag clear-flag ] if ;
-
-: update-half-carry-flag ( original change-by result cpu -- )
-  #! If the instruction caused a carry out of bit 3 and into bit 4 of the
-  #! resulting value, the half carry flag is set, otherwise it is reset.
-  #! The 'original' is the original value of the register being changed.
-  #! 'change-by' is the amount it is being added or decremented by.
-  #! 'result' is the result of that change.
-  >r bitxor bitxor HEX: 10 bitand 0 = not r> 
-  swap [ half-carry-flag set-flag ] [ half-carry-flag clear-flag ] if ;
-
-: update-flags ( result cpu -- )
-  2dup update-carry-flag
-  2dup update-parity-flag
-  2dup update-sign-flag
-  update-zero-flag ;
-
-: update-flags-no-carry ( result cpu -- )
-  2dup update-parity-flag
-  2dup update-sign-flag
-  update-zero-flag ;
-
-: add-byte ( lhs rhs cpu -- result )
-  #! Add rhs to lhs
-  >r 2dup + r> ! lhs rhs result cpu
-  [ update-flags ] 2keep 
-  [ update-half-carry-flag ] 2keep
-  drop HEX: FF bitand ;
-
-: add-carry ( change-by result cpu -- change-by result )
-  #! Add the effect of the carry flag to the result
-  flag-c? [ 1 + >r 1 + r> ] when ;
-
-: add-byte-with-carry ( lhs rhs cpu -- result )
-  #! Add rhs to lhs plus carry.
-  >r 2dup + r> ! lhs rhs result cpu
-  [ add-carry ] keep
-  [ update-flags ] 2keep 
-  [ update-half-carry-flag ] 2keep
-  drop HEX: FF bitand ;
-
-: sub-carry ( change-by result cpu -- change-by result ) 
-  #! Subtract the effect of the carry flag from the result
-  flag-c? [ 1 - >r 1 - r>  ] when ;
-
-: sub-byte ( lhs rhs cpu -- result )
-  #! Subtract rhs from lhs
-  >r 2dup - r> 
-  [ update-flags ] 2keep 
-  [ update-half-carry-flag ] 2keep
-  drop HEX: FF bitand ;
-
-: sub-byte-with-carry ( lhs rhs cpu -- result )
-  #! Subtract rhs from lhs and take carry into account
-  >r 2dup - r> 
-  [ sub-carry ] keep 
-  [ update-flags ] 2keep 
-  [ update-half-carry-flag ] 2keep
-  drop HEX: FF bitand ;
- 
-: inc-byte ( byte cpu -- result )
-  #! Increment byte by one. Note that carry flag is not affected
-  #! by this operation.
-  >r 1 2dup + r> ! lhs rhs result cpu
-  [ update-flags-no-carry ] 2keep 
-  [ update-half-carry-flag ] 2keep
-  drop HEX: FF bitand ;
-
-: dec-byte ( byte cpu -- result )
-  #! Decrement byte by one. Note that carry flag is not affected
-  #! by this operation.
-  >r 1 2dup - r> ! lhs rhs result cpu
-  [ update-flags-no-carry ] 2keep 
-  [ update-half-carry-flag ] 2keep
-  drop HEX: FF bitand ;
-
-: inc-word ( w cpu -- w )
-  #! Increment word by one. Note that no flags are modified.
-  drop 1 + HEX: FFFF bitand ;
-
-: dec-word ( w cpu -- w )
-  #! Decrement word by one. Note that no flags are modified.
-  drop 1 - HEX: FFFF bitand ;
-
-: add-word ( lhs rhs cpu -- result )
-  #! Add rhs to lhs. Note that only the carry flag is modified
-  #! and only if there is a carry out of the double precision add.
-  >r + r> over HEX: FFFF > [ carry-flag set-flag ] [ drop ] if HEX: FFFF bitand ;
-
-: bit3or ( lhs rhs -- 0|1 )
-  #! bitor bit 3 of the two numbers on the stack
-  BIN: 00001000 bitand -3 shift >r
-  BIN: 00001000 bitand -3 shift r> 
-  bitor ;
-
-: and-byte ( lhs rhs cpu -- result )
-  #! Logically and rhs to lhs. The carry flag is cleared and
-  #! the half carry is set to the ORing of bits 3 of the operands.
-  [ drop bit3or ] 3keep ! bit3or lhs rhs cpu
-  >r bitand r> [ update-flags ] 2keep 
-  [ carry-flag clear-flag ] keep
-  rot 0 = [ half-carry-flag set-flag ] [ half-carry-flag clear-flag ] if
-  HEX: FF bitand ;
-
-: xor-byte ( lhs rhs cpu -- result )
-  #! Logically xor rhs to lhs. The carry and half-carry flags are cleared.
-  >r bitxor r> [ update-flags ] 2keep 
-  [ half-carry-flag carry-flag bitor clear-flag ] keep
-  drop HEX: FF bitand ;
-
-: or-byte ( lhs rhs cpu -- result )
-  #! Logically or rhs to lhs. The carry and half-carry flags are cleared.
-  >r bitor r> [ update-flags ] 2keep 
-  [ half-carry-flag carry-flag bitor clear-flag ] keep
-  drop HEX: FF bitand ;
-
-: flags ( seq -- seq )
-  [ 0 [ execute bitor ] reduce ] map ;
-
-: decrement-sp ( n cpu -- )
-  #! Decrement the stackpointer by n.  
-  [ cpu-sp ] keep 
-  >r swap - r> set-cpu-sp ;
-
-: save-pc ( cpu -- )
-  #! Save the value of the PC on the stack.
-  [ cpu-pc ] keep ! pc cpu
-  [ cpu-sp ] keep ! pc sp cpu
-  write-word ;
-
-: push-pc ( cpu -- )
-  #! Push the value of the PC on the stack.
-  2 over decrement-sp
-  save-pc ;
-
-: pop-pc ( cpu -- pc )
-  #! Pop the value of the PC off the stack.
-  [ cpu-sp ] keep
-  [ read-word ] keep 
-  -2 swap decrement-sp ;
-
-: push-sp ( value cpu -- )
-  [ 2 swap decrement-sp ] keep
-  [ cpu-sp ] keep
-  write-word ;
-  
-: pop-sp ( cpu -- value )
-  [ cpu-sp ] keep
-  [ read-word ] keep
-  -2 swap decrement-sp ;
-
-: call-sub ( addr cpu -- )
-  #! Call the address as a subroutine.
-  dup push-pc 
-  >r HEX: FFFF bitand r> set-cpu-pc ;
-
-: ret-from-sub ( cpu -- )
-  [ pop-pc ] keep set-cpu-pc ;
- 
-: interrupt ( number cpu -- )
-  #! Perform a hardware interrupt
-!  "***Interrupt: " write over 16 >base print 
-  dup cpu-f interrupt-flag bitand 0 = not [
-    dup push-pc
-    set-cpu-pc
-  ] [
-    2drop
-  ] if ;
-
-: inc-cycles ( n cpu -- )
-  #! Increment the number of cpu cycles
-  [ cpu-cycles + ] keep set-cpu-cycles ;
-  
-: instruction-cycles ( -- vector )
-  #! Return a 256 element vector containing the cycles for
-  #! each opcode in the 8080 instruction set.
-  { 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f } ;
-
-: instructions ( -- vector )
-  #! Return a 256 element vector containing the emulation words for
-  #! each opcode in the 8080 instruction set.
-  { 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
-    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f } ; 
-
-: not-implemented ( <cpu> -- )
-  drop ;
-
-instructions length [ 
-  dup instructions nth [
-    drop
-  ] [
-    [ not-implemented ] swap instructions set-nth 
-  ] if
-] each
-
-M: cpu reset ( cpu -- )
-  #! Reset the CPU to its poweron state
-  [ 0 swap set-cpu-b  ] keep
-  [ 0 swap set-cpu-c  ] keep
-  [ 0 swap set-cpu-d  ] keep
-  [ 0 swap set-cpu-e  ] keep
-  [ 0 swap set-cpu-h  ] keep
-  [ 0 swap set-cpu-l  ] keep
-  [ 0 swap set-cpu-a  ] keep
-  [ 0 swap set-cpu-f  ] keep
-  [ 0 swap set-cpu-pc  ] keep
-  [ HEX: F000 swap set-cpu-sp  ] keep 
-  [ HEX: FFFF 0 <array> swap set-cpu-ram ] keep
-  [ f swap set-cpu-halted? ] keep
-  [ HEX: 10 swap set-cpu-last-interrupt ] keep
-  0 swap set-cpu-cycles ;
-
-: <cpu> ( -- cpu ) cpu construct-empty dup reset ;
-
-: (load-rom) ( n ram -- )
-  read1 [ ! n ram ch
-    -rot [ set-nth ] 2keep >r 1 + r> (load-rom)
-  ] [
-    2drop
-  ] if* ;
-
-  #! Reads the ROM from stdin and stores it in ROM from
-  #! offset n.
-: load-rom ( filename cpu -- )
-  #! Load the contents of the file into ROM.
-  #! (address 0x0000-0x1FFF).
-  cpu-ram swap <file-reader> [ 
-    0 swap (load-rom)
-  ] with-stream ;
-
-SYMBOL: rom-root
-
-: rom-dir ( -- string )
-  rom-root get [ home "roms" path+ dup exists? [ drop f ] unless ] unless* ;
-
-: load-rom* ( seq cpu -- )
-  #! 'seq' is an array of arrays. Each array contains
-  #! an address and filename of a ROM file. The ROM
-  #! file will be loaded at the specified address. This
-  #! file path shoul dbe relative to the '/roms' resource path.
-  rom-dir [
-    cpu-ram [
-      swap first2 rom-dir swap path+ <file-reader> [      
-        swap (load-rom)
-      ] with-stream
-    ] curry each 
-  ] [
-    ! 
-    ! the ROM files.
-    "Set 'rom-root' to the path containing the root of the 8080 ROM files." throw
-  ] if ;
-
-: read-instruction ( cpu -- word )
-  #! Read the next instruction from the cpu's program 
-  #! counter, and increment the program counter.
-  [ cpu-pc ] keep ! pc cpu
-  [ over 1 + swap set-cpu-pc ] keep
-  read-byte ;
-
-: get-cycles ( n -- opcode )
-  #! Returns the cycles for the given instruction value.
-  #! If the opcode is not defined throw an error.
-  dup instruction-cycles nth [ 
-    nip  
-  ] [
-    [ "Undefined 8080 opcode: " % number>string % ] "" make throw
-  ] if* ;
-
-: process-interrupts ( cpu -- )
-  #! Process any hardware interrupts
-  [ cpu-cycles ] keep 
-  over 16667 < [
-    2drop
-  ] [ 
-    [ >r 16667 - r> set-cpu-cycles ] keep
-    dup cpu-last-interrupt HEX: 10 = [
-      HEX: 08 over set-cpu-last-interrupt HEX: 08 swap interrupt
-    ] [
-      HEX: 10 over set-cpu-last-interrupt HEX: 10 swap interrupt
-    ] if     
-  ] if ;
-
-: step ( cpu -- )
-  #! Run a single 8080 instruction
-  [ read-instruction ] keep ! n cpu
-  over get-cycles over inc-cycles
-  [ swap instructions dispatch ] keep
-  [ cpu-pc HEX: FFFF bitand ] keep 
-  [ set-cpu-pc ] keep 
-  process-interrupts ;
-
-: peek-instruction ( cpu -- word )
-  #! Return the next instruction from the cpu's program
-  #! counter, but don't increment the counter.
-  [ cpu-pc ] keep read-byte instructions nth first ;
-
-: cpu. ( cpu -- )
-  [ " PC: " write cpu-pc 16 >base 4 CHAR: \s pad-left write ] keep 
-  [ " B: " write cpu-b 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " C: " write cpu-c 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " D: " write cpu-d 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " E: " write cpu-e 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " F: " write cpu-f 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " H: " write cpu-h 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " L: " write cpu-l 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " A: " write cpu-a 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " SP: " write cpu-sp 16 >base 4 CHAR: \s pad-left write ] keep 
-  [ " cycles: " write cpu-cycles number>string 5 CHAR: \s pad-left write ] keep 
-  [ " " write peek-instruction word-name write " " write ] keep
-  nl drop ;
-
-: cpu*. ( cpu -- )
-  [ " PC: " write cpu-pc 16 >base 4 CHAR: \s pad-left write ] keep 
-  [ " B: " write cpu-b 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " C: " write cpu-c 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " D: " write cpu-d 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " E: " write cpu-e 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " F: " write cpu-f 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " H: " write cpu-h 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " L: " write cpu-l 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " A: " write cpu-a 16 >base 2 CHAR: \s pad-left write ] keep 
-  [ " SP: " write cpu-sp 16 >base 4 CHAR: \s pad-left write ] keep 
-  [ " cycles: " write cpu-cycles number>string 5 CHAR: \s pad-left write ] keep 
-  nl drop ;
-
-: test-step ( cpu -- cpu )
-  [ step ] keep dup cpu. ;
-
-: test-cpu ( -- cpu )
-  <cpu> "invaders.rom" over load-rom dup cpu. ;
-
-: test-n ( n -- )
-  test-cpu swap [ test-step ] times ;
-
-: run-n ( cpu n -- cpu )
-  [ dup step ] times ;
-
-: register-lookup ( string -- vector )
-  #! Given a string containing a register name, return a vector
-  #! where the 1st item is the getter and the 2nd is the setter
-  #! for that register.
-  H{
-    { "A"  { cpu-a  set-cpu-a  } }
-    { "B"  { cpu-b  set-cpu-b  } }
-    { "C"  { cpu-c  set-cpu-c  } }
-    { "D"  { cpu-d  set-cpu-d  } }
-    { "E"  { cpu-e  set-cpu-e  } }
-    { "H"  { cpu-h  set-cpu-h  } }
-    { "L"  { cpu-l  set-cpu-l  } }
-    { "AF" { cpu-af set-cpu-af } }
-    { "BC" { cpu-bc set-cpu-bc } }
-    { "DE" { cpu-de set-cpu-de } }
-    { "HL" { cpu-hl set-cpu-hl } }
-    { "SP" { cpu-sp set-cpu-sp } }
-  } at ;
-
-
-: flag-lookup ( string -- vector )
-  #! Given a string containing a flag name, return a vector
-  #! where the 1st item is a word that tests that flag.
-  H{
-    { "NZ"  { flag-nz?  } }
-    { "NC"  { flag-nc?  } }
-    { "PO"  { flag-po?  } }
-    { "PE"  { flag-pe?  } }
-    { "Z"  { flag-z?  } }
-    { "C"  { flag-c? } }
-    { "P"  { flag-p?  } }
-    { "M" { flag-m?  } }
-  } at ;
-
-SYMBOL: $1
-SYMBOL: $2
-SYMBOL: $3
-SYMBOL: $4
-
-: replace-patterns ( vector tree -- tree )
-  #! Copy the tree, replacing each occurence of 
-  #! $1, $2, etc with the relevant item from the 
-  #! given index.
-  dup quotation? over [ ] = not and [ ! vector tree
-    dup first swap 1 tail ! vector car cdr
-    >r dupd replace-patterns ! vector v R: cdr
-    swap r> replace-patterns >r 1quotation r> append
-  ] [ ! vector value
-    dup $1 = [ drop 0 over nth  ] when 
-    dup $2 = [ drop 1 over nth  ] when 
-    dup $3 = [ drop 2 over nth  ] when 
-    dup $4 = [ drop 3 over nth  ] when 
-    nip
-  ] if ;
-
-: test-rp 
-  { 4 5 3 } [ 1 $2 [ $1 4 ] ] replace-patterns ;
-
-: (emulate-RST) ( n cpu -- )
-  #! RST nn
-  [ cpu-sp 2 - dup ] keep ! sp sp cpu
-  [ set-cpu-sp ] keep ! sp cpu
-  [ cpu-pc ] keep ! sp pc cpu
-  swapd [ write-word ] keep ! cpu
-  >r 8 * r> set-cpu-pc ;
-
-: (emulate-CALL) ( cpu -- )
-  #! 205 - CALL nn
-  [ next-word HEX: FFFF bitand ] keep ! addr cpu
-  [ cpu-sp 2 - dup ] keep ! addr sp sp cpu
-  [ set-cpu-sp ] keep ! addr sp cpu
-  [ cpu-pc ] keep ! addr sp pc cpu
-  swapd [ write-word ] keep ! addr cpu
-  set-cpu-pc ;
-
-: (emulate-RLCA) ( cpu -- )
-  #! The content of the accumulator is rotated left
-  #! one position. The low order bit and the carry flag
-  #! are both set to the value shifd out of the high
-  #! order bit position. Only the carry flag is affected.
-  [ cpu-a -7 shift ] keep 
-  over 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if
-  [ cpu-a 1 shift HEX: FF bitand ] keep 
-  >r bitor r> set-cpu-a ;
-
-: (emulate-RRCA) ( cpu -- )
-  #! The content of the accumulator is rotated right
-  #! one position. The high order bit and the carry flag
-  #! are both set to the value shifd out of the low
-  #! order bit position. Only the carry flag is affected.
-  [ cpu-a 1 bitand 7 shift ] keep 
-  over 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if
-  [ cpu-a 254 bitand -1 shift ] keep 
-  >r bitor r> set-cpu-a ;
-
-: (emulate-RLA) ( cpu -- )  
-  #! The content of the accumulator is rotated left
-  #! one position through the carry flag. The low
-  #! order bit is set equal to the carry flag and
-  #! the carry flag is set to the value shifd out 
-  #! of the high order bit. Only the carry flag is
-  #! affected.
-  [ carry-flag swap flag-set? [ 1 ] [ 0 ] if ] keep 
-  [ cpu-a 127 bitand 7 shift ] keep 
-  dup cpu-a 128 bitand 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if
-  >r bitor r> set-cpu-a ;
-
-: (emulate-RRA) ( cpu -- )  
-  #! The content of the accumulator is rotated right
-  #! one position through the carry flag. The high order
-  #! bit is set to the carry flag and the carry flag is
-  #! set to the value shifd out of the low order bit. 
-  #! Only the carry flag is affected.
-  [ carry-flag swap flag-set? [ BIN: 10000000 ] [ 0 ] if ] keep 
-  [ cpu-a 254 bitand -1 shift ] keep 
-  dup cpu-a 1 bitand 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if
-  >r bitor r> set-cpu-a ;
-
-: (emulate-CPL) ( cpu -- )  
-  #! The contents of the accumulator are complemented
-  #! (zero bits become one, one bits becomes zero).
-  #! No flags are affected.
-  HEX: FF swap cpu-a-bitxor= ;
-
-: (emulate-DAA) ( cpu -- )  
-  #! The eight bit number in the accumulator is
-  #! adjusted to form two four-bit binary-coded-decimal
-  #! digits.
-  [
-    dup half-carry-flag swap flag-set? swap 
-    cpu-a BIN: 1111 bitand 9 > or [ 6 ] [ 0 ] if 
-  ] keep 
-  [ cpu-a + ] keep
-  [ update-flags ] 2keep  
-  [ swap HEX: FF bitand swap set-cpu-a ] keep 
-  [
-    dup carry-flag swap flag-set? swap 
-    cpu-a -4 shift BIN: 1111 bitand 9 > or [ 96 ] [ 0 ] if 
-  ] keep 
-  [ cpu-a + ] keep
-  [ update-flags ] 2keep  
-  swap HEX: FF bitand swap set-cpu-a ;
-  
-: patterns ( -- hashtable )
-  #! table of code quotation patterns for each type of instruction.
-  H{
-    { "NOP"          [ drop ]               }
-    { "RET-NN"          [ ret-from-sub  ]               }
-    { "RST-0"      [ 0 swap (emulate-RST) ] }
-    { "RST-8"      [ 8 swap (emulate-RST) ] }
-    { "RST-10H"      [ HEX: 10 swap (emulate-RST) ] }
-    { "RST-18H"      [ HEX: 18 swap (emulate-RST) ] }
-    { "RST-20H"      [ HEX: 20 swap (emulate-RST) ] }
-    { "RST-28H"      [ HEX: 28 swap (emulate-RST) ] }
-    { "RST-30H"      [ HEX: 30 swap (emulate-RST) ] }
-    { "RST-38H"      [ HEX: 38 swap (emulate-RST) ] }
-    { "RET-F|FF"      [ dup $1 [ 6 over inc-cycles ret-from-sub ] [ drop ] if ] }
-    { "CP-N"      [ [ cpu-a ] keep [ next-byte ] keep sub-byte drop ] }
-    { "CP-R"      [ [ cpu-a ] keep [ $1 ] keep sub-byte drop  ] }
-    { "CP-(RR)"      [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep sub-byte drop ] }
-    { "OR-N"      [ [ cpu-a ] keep [ next-byte ] keep [ or-byte ] keep set-cpu-a ] }
-    { "OR-R"      [ [ cpu-a ] keep [ $1 ] keep [ or-byte ] keep set-cpu-a ] }
-    { "OR-(RR)"      [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ or-byte ] keep set-cpu-a  ] }
-    { "XOR-N"      [ [ cpu-a ] keep [ next-byte ] keep [ xor-byte ] keep set-cpu-a ] }
-    { "XOR-R"      [ [ cpu-a ] keep [ $1 ] keep [ xor-byte ] keep set-cpu-a ] }
-    { "XOR-(RR)"   [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ xor-byte ] keep set-cpu-a  ] }
-    { "AND-N"      [ [ cpu-a ] keep [ next-byte ] keep [ and-byte ] keep set-cpu-a  ] }
-    { "AND-R"      [ [ cpu-a ] keep [ $1 ] keep [ and-byte ] keep set-cpu-a ] }
-    { "AND-(RR)"      [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ and-byte ] keep set-cpu-a  ] }
-    { "ADC-R,N"      [ [ $1 ] keep [ next-byte ] keep [ add-byte-with-carry ] keep $2 ] }
-    { "ADC-R,R"      [ [ $1 ] keep [ $3 ] keep [ add-byte-with-carry ] keep $2 ] }
-    { "ADC-R,(RR)"      [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ add-byte-with-carry ] keep $2 ] }
-    { "ADD-R,N"      [ [ $1 ] keep [ next-byte ] keep [ add-byte ] keep $2 ] }
-    { "ADD-R,R"      [ [ $1 ] keep [ $3 ] keep [ add-byte ] keep $2 ] }
-    { "ADD-RR,RR"    [ [ $1 ] keep [ $3 ] keep [ add-word ] keep $2 ] }
-    { "ADD-R,(RR)"    [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ add-byte ] keep $2   ]  }
-    { "SBC-R,N"      [ [ $1 ] keep [ next-byte ] keep [ sub-byte-with-carry ] keep $2 ] }
-    { "SBC-R,R"      [ [ $1 ] keep [ $3 ] keep [ sub-byte-with-carry ] keep $2 ] }
-    { "SBC-R,(RR)"      [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ sub-byte-with-carry ] keep $2 ] }
-    { "SUB-R"      [ [ cpu-a ] keep [ $1 ] keep [ sub-byte ] keep set-cpu-a ] }
-    { "SUB-(RR)"      [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ sub-byte ] keep set-cpu-a ] }
-    { "SUB-N"      [ [ cpu-a ] keep [ next-byte ] keep [ sub-byte ] keep set-cpu-a ] }
-    { "CPL"          [ (emulate-CPL) ]               }
-    { "DAA"          [ (emulate-DAA) ]               }
-    { "RLA"          [ (emulate-RLA) ]               }
-    { "RRA"          [ (emulate-RRA) ]               }
-    { "CCF"          [ carry-flag swap cpu-f-bitxor= ]               }
-    { "SCF"          [ carry-flag swap cpu-f-bitor= ]               }
-    { "RLCA"          [ (emulate-RLCA) ]               }
-    { "RRCA"          [ (emulate-RRCA) ]               }
-    { "HALT"          [ drop  ]               }
-    { "DI"          [ [ 255 interrupt-flag - ] swap cpu-f-bitand  ]               }
-    { "EI"          [ [ interrupt-flag ] swap cpu-f-bitor  ]  }  
-    { "POP-RR"     [ [ pop-sp ] keep $2 ] }
-    { "PUSH-RR"     [ [ $1 ] keep push-sp ] }
-    { "INC-R"     [ [ $1 ] keep [ inc-byte ] keep $2 ] }
-    { "DEC-R"     [ [ $1 ] keep [ dec-byte ] keep $2 ] }
-    { "INC-RR"     [ [ $1 ] keep [ inc-word ] keep $2 ] }
-    { "DEC-RR"     [ [ $1 ] keep [ dec-word ] keep $2 ] }
-    { "DEC-(RR)"     [ [ $1 ] keep [ read-byte ] keep [ dec-byte ] keep [ $1 ] keep write-byte ] }
-    { "INC-(RR)" [ [ $1 ] keep [ read-byte ] keep [ inc-byte ] keep  [ $1 ] keep write-byte ] }
-    { "JP-NN"           [ [ cpu-pc ] keep [ read-word ] keep set-cpu-pc ]               }
-    { "JP-F|FF,NN"      [ [ $1 ] keep swap [ [ next-word ] keep [ set-cpu-pc ] keep [ cpu-cycles ] keep swap 5 + swap set-cpu-cycles ] [ [ cpu-pc 2 + ] keep set-cpu-pc ] if ] }
-    { "JP-(RR)"      [ [ $1 ] keep set-cpu-pc ] }
-    { "CALL-NN"         [ (emulate-CALL) ] }
-    { "CALL-F|FF,NN"    [ [ $1 ] keep swap [ 7 over inc-cycles (emulate-CALL) ] [ [ cpu-pc 2 + ] keep set-cpu-pc ] if ]   }
-    { "LD-RR,NN"     [ [ next-word ] keep $2 ] }
-    { "LD-RR,RR"     [ [ $3 ] keep $2 ] }
-    { "LD-R,N"     [ [ next-byte ] keep $2 ] }
-    { "LD-(RR),N"    [ [ next-byte ] keep [ $1 ] keep write-byte ] }
-    { "LD-(RR),R"    [ [ $3 ] keep [ $1 ] keep write-byte ] }
-    { "LD-R,R"    [ [ $3 ] keep $2 ] }
-    { "LD-R,(RR)"    [ [ $3 ] keep [ read-byte ] keep $2  ] }
-    { "LD-(NN),RR"    [ [ $1 ] keep [ next-word ] keep write-word ] }
-    { "LD-(NN),R"    [  [ $1 ] keep [ next-word ] keep write-byte ] }
-    { "LD-RR,(NN)"    [ [ next-word ] keep [ read-word ] keep $2 ]  }
-    { "LD-R,(NN)"    [ [ next-word ] keep [ read-byte ] keep $2 ] }
-    { "OUT-(N),R"    [ [ $1 ] keep [ next-byte ] keep write-port ] }
-    { "IN-R,(N)"    [ [ next-byte ] keep [ read-port ] keep set-cpu-a ] }
-    { "EX-(RR),RR"  [  [ $1 ] keep [ read-word ] keep [ $3 ] keep [ $1 ] keep [ write-word ] keep $4 ] }
-    { "EX-RR,RR"    [ [ $1 ] keep [ $3 ] keep [ $2 ] keep $4 ] }
-  } ;
-
-: 8-bit-registers ( -- parser )
-  #! A parser for 8-bit registers. On a successfull parse the
-  #! parse tree contains a vector. The first item in the vector
-  #! is the getter word for that register with stack effect
-  #! ( cpu -- value ). The second item is the setter word with
-  #! stack effect ( value cpu -- ).
-  "A" token 
-  "B" token  <|>
-  "C" token  <|>
-  "D" token  <|>
-  "E" token  <|>
-  "H" token  <|>
-  "L" token  <|> [ register-lookup ] <@ ;
-
-: all-flags
-  #! A parser for 16-bit flags. 
-  "NZ" token  
-  "NC" token <|>
-  "PO" token <|>
-  "PE" token <|> 
-  "Z" token <|> 
-  "C" token <|> 
-  "P" token <|> 
-  "M" token <|> [ flag-lookup ] <@ ;
-
-: 16-bit-registers
-  #! A parser for 16-bit registers. On a successfull parse the
-  #! parse tree contains a vector. The first item in the vector
-  #! is the getter word for that register with stack effect
-  #! ( cpu -- value ). The second item is the setter word with
-  #! stack effect ( value cpu -- ).
-  "AF" token  
-  "BC" token <|>
-  "DE" token <|>
-  "HL" token <|>
-  "SP" token <|> [ register-lookup ] <@ ;
-
-: all-registers ( -- parser )
-  #! Return a parser that can parse the format
-  #! for 8 bit or 16 bit registers. 
-  8-bit-registers 16-bit-registers <|> ;
-
-: indirect ( parser -- parser )
-  #! Given a parser, return a parser which parses the original
-  #! wrapped in brackets, representing an indirect reference.
-  #! eg. BC -> (BC). The value of the original parser is left in
-  #! the parse tree.
-  "(" token swap &> ")" token <& ;
-
-: generate-instruction ( vector string -- quot )
-  #! Generate the quotation for an instruction, given the instruction in 
-  #! the 'string' and a vector containing the arguments for that instruction.
-  patterns at replace-patterns ;
-
-: simple-instruction ( token -- parser )
-  #! Return a parser for then instruction identified by the token. 
-  #! The parser return parses the token only and expects no additional
-  #! arguments to the instruction.
-  token [ [ { } clone , , \ generate-instruction , ] [ ] make ] <@ ;
-
-: complex-instruction ( type token -- parser )
-  #! Return a parser for an instruction identified by the token. 
-  #! The instruction is expected to take additional arguments by 
-  #! being combined with other parsers. Then 'type' is used for a lookup
-  #! in a pattern hashtable to return the instruction quotation pattern.
-  token swap [ nip [ , \ generate-instruction , ] [ ] make ] curry <@ ;
-
-: NOP-instruction ( -- parser )
-  "NOP" simple-instruction ;
-
-: RET-NN-instruction ( -- parser )  
-  "RET-NN" "RET" complex-instruction  
-  "nn" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: RST-0-instruction ( -- parser )  
-  "RST-0" "RST" complex-instruction  
-  "0" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: RST-8-instruction ( -- parser )  
-  "RST-8" "RST" complex-instruction  
-  "8" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: RST-10H-instruction ( -- parser )  
-  "RST-10H" "RST" complex-instruction  
-  "10H" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: RST-18H-instruction ( -- parser )  
-  "RST-18H" "RST" complex-instruction  
-  "18H" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: RST-20H-instruction ( -- parser )  
-  "RST-20H" "RST" complex-instruction  
-  "20H" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: RST-28H-instruction ( -- parser )  
-  "RST-28H" "RST" complex-instruction  
-  "28H" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: RST-30H-instruction ( -- parser )  
-  "RST-30H" "RST" complex-instruction  
-  "30H" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: RST-38H-instruction ( -- parser )  
-  "RST-38H" "RST" complex-instruction  
-  "38H" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: JP-NN-instruction ( -- parser )  
-  "JP-NN" "JP" complex-instruction  
-  "nn" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: JP-F|FF,NN-instruction ( -- parser )
-  "JP-F|FF,NN" "JP" complex-instruction  
-  all-flags sp <&> 
-  ",nn" token <&
-  just [ first2 swap curry ] <@ ;
-
-: JP-(RR)-instruction ( -- parser )
-  "JP-(RR)" "JP" complex-instruction  
-  16-bit-registers indirect sp <&>
-  just [ first2 swap curry ] <@ ;
-
-: CALL-NN-instruction ( -- parser )  
-  "CALL-NN" "CALL" complex-instruction  
-  "nn" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: CALL-F|FF,NN-instruction ( -- parser )
-  "CALL-F|FF,NN" "CALL" complex-instruction  
-  all-flags sp <&> 
-  ",nn" token <&
-  just [ first2 swap curry ] <@ ;
-
-: RLCA-instruction ( -- parser )
-  "RLCA" simple-instruction ;
-
-: RRCA-instruction ( -- parser )
-  "RRCA" simple-instruction ;
-
-: HALT-instruction ( -- parser )
-  "HALT" simple-instruction ;
-
-: DI-instruction ( -- parser )
-  "DI" simple-instruction ;
-
-: EI-instruction ( -- parser )
-  "EI" simple-instruction ;
-
-: CPL-instruction ( -- parser )
-  "CPL" simple-instruction ;
-
-: CCF-instruction ( -- parser )
-  "CCF" simple-instruction ;
-
-: SCF-instruction ( -- parser )
-  "SCF" simple-instruction ;
-
-: DAA-instruction ( -- parser )
-  "DAA" simple-instruction ;
-
-: RLA-instruction ( -- parser )
-  "RLA" simple-instruction ;
-
-: RRA-instruction ( -- parser )
-  "RRA" simple-instruction ;
-
-: DEC-R-instruction ( -- parser )
-  "DEC-R" "DEC" complex-instruction  8-bit-registers sp <&> 
-  just [ first2 swap curry ] <@ ;
-
-: DEC-RR-instruction ( -- parser )
-  "DEC-RR" "DEC" complex-instruction  16-bit-registers sp <&> 
-  just [ first2 swap curry ] <@ ;
-
-: DEC-(RR)-instruction ( -- parser )
-  "DEC-(RR)" "DEC" complex-instruction  
-  16-bit-registers indirect sp <&>
-  just [ first2 swap curry ] <@ ;
-
-: POP-RR-instruction ( -- parser )
-  "POP-RR" "POP" complex-instruction  all-registers sp <&> 
-  just [ first2 swap curry ] <@ ;
-
-: PUSH-RR-instruction ( -- parser )
-  "PUSH-RR" "PUSH" complex-instruction  all-registers sp <&> 
-  just [ first2 swap curry ] <@ ;
-
-: INC-R-instruction ( -- parser )
-  "INC-R" "INC" complex-instruction  8-bit-registers sp <&> 
-  just [ first2 swap curry ] <@ ;
-
-: INC-RR-instruction ( -- parser )
-  "INC-RR" "INC" complex-instruction  16-bit-registers sp <&> 
-  just [ first2 swap curry ] <@ ;
-   
-: INC-(RR)-instruction  ( -- parser )
-  "INC-(RR)" "INC" complex-instruction
-  all-registers indirect sp <&> just [ first2 swap curry ] <@ ;
-
-: RET-F|FF-instruction ( -- parser )
-  "RET-F|FF" "RET" complex-instruction  all-flags sp <&> 
-  just [ first2 swap curry ] <@ ;
-
-: AND-N-instruction ( -- parser )
-  "AND-N" "AND" complex-instruction
-  "n" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: AND-R-instruction  ( -- parser )
-  "AND-R" "AND" complex-instruction
-  8-bit-registers sp <&> just [ first2 swap curry ] <@ ;
-
-: AND-(RR)-instruction  ( -- parser )
-  "AND-(RR)" "AND" complex-instruction
-  16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ;
-
-: XOR-N-instruction ( -- parser )
-  "XOR-N" "XOR" complex-instruction
-  "n" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: XOR-R-instruction  ( -- parser )
-  "XOR-R" "XOR" complex-instruction
-  8-bit-registers sp <&> just [ first2 swap curry ] <@ ;
-
-: XOR-(RR)-instruction  ( -- parser )
-  "XOR-(RR)" "XOR" complex-instruction
-  16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ;
-
-: OR-N-instruction ( -- parser )
-  "OR-N" "OR" complex-instruction
-  "n" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: OR-R-instruction  ( -- parser )
-  "OR-R" "OR" complex-instruction
-  8-bit-registers sp <&> just [ first2 swap curry ] <@ ;
-
-: OR-(RR)-instruction  ( -- parser )
-  "OR-(RR)" "OR" complex-instruction
-  16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ;
-
-: CP-N-instruction ( -- parser )
-  "CP-N" "CP" complex-instruction
-  "n" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: CP-R-instruction  ( -- parser )
-  "CP-R" "CP" complex-instruction
-  8-bit-registers sp <&> just [ first2 swap curry ] <@ ;
-
-: CP-(RR)-instruction  ( -- parser )
-  "CP-(RR)" "CP" complex-instruction
-  16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ;
-
-: ADC-R,N-instruction ( -- parser )
-  "ADC-R,N" "ADC" complex-instruction
-  8-bit-registers sp <&>
-  ",n" token <& 
-  just [ first2 swap curry ] <@ ;  
-
-: ADC-R,R-instruction ( -- parser )
-  "ADC-R,R" "ADC" complex-instruction
-  8-bit-registers sp <&>
-  "," token <& 
-  8-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
-
-: ADC-R,(RR)-instruction ( -- parser )
-  "ADC-R,(RR)" "ADC" complex-instruction
-  8-bit-registers sp <&>
-  "," token <& 
-  16-bit-registers indirect <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
-
-: SBC-R,N-instruction ( -- parser )
-  "SBC-R,N" "SBC" complex-instruction
-  8-bit-registers sp <&>
-  ",n" token <& 
-  just [ first2 swap curry ] <@ ;  
-
-: SBC-R,R-instruction ( -- parser )
-  "SBC-R,R" "SBC" complex-instruction
-  8-bit-registers sp <&>
-  "," token <& 
-  8-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry  ] <@ ;  
-
-: SBC-R,(RR)-instruction ( -- parser )
-  "SBC-R,(RR)" "SBC" complex-instruction
-  8-bit-registers sp <&>
-  "," token <& 
-  16-bit-registers indirect  <&>
-  just [ first2 swap first2 swap >r swap append r> curry  ] <@ ;  
-
-: SUB-R-instruction ( -- parser )
-  "SUB-R" "SUB" complex-instruction
-  8-bit-registers sp <&>
-  just [ first2 swap curry ] <@ ;  
-
-: SUB-(RR)-instruction ( -- parser )
-  "SUB-(RR)" "SUB" complex-instruction
-  16-bit-registers indirect sp <&>
-  just [ first2 swap curry ] <@ ;  
-
-: SUB-N-instruction ( -- parser )
-  "SUB-N" "SUB" complex-instruction
-  "n" token sp <&
-  just [ { } clone swap curry  ] <@ ;
-
-: ADD-R,N-instruction ( -- parser )
-  "ADD-R,N" "ADD" complex-instruction
-  8-bit-registers sp <&>
-  ",n" token <& 
-  just [ first2 swap curry ] <@ ;  
-
-: ADD-R,R-instruction ( -- parser )
-  "ADD-R,R" "ADD" complex-instruction
-  8-bit-registers sp <&>
-  "," token <& 
-  8-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
-
-: ADD-RR,RR-instruction ( -- parser )
-  "ADD-RR,RR" "ADD" complex-instruction
-  16-bit-registers sp <&>
-  "," token <& 
-  16-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
-
-: ADD-R,(RR)-instruction ( -- parser )
-  "ADD-R,(RR)" "ADD" complex-instruction
-  8-bit-registers sp <&>
-  "," token <& 
-  16-bit-registers indirect <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
-  
-: LD-RR,NN-instruction
-  #! LD BC,nn
-  "LD-RR,NN" "LD" complex-instruction
-  16-bit-registers sp <&>
-  ",nn" token <& 
-  just [ first2 swap curry ] <@ ;
-
-: LD-R,N-instruction
-  #! LD B,n
-  "LD-R,N" "LD" complex-instruction
-  8-bit-registers sp <&>
-  ",n" token <& 
-  just [ first2 swap curry ] <@ ;
-  
-: LD-(RR),N-instruction
-  "LD-(RR),N" "LD" complex-instruction
-  16-bit-registers indirect sp <&> 
-  ",n" token <&
-  just [ first2 swap curry ] <@ ;
-
-: LD-(RR),R-instruction
-  #! LD (BC),A
-  "LD-(RR),R" "LD" complex-instruction
-  16-bit-registers indirect sp <&> 
-  "," token <&
-  8-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
-
-: LD-R,R-instruction
-  "LD-R,R" "LD" complex-instruction
-  8-bit-registers sp <&> 
-  "," token <&
-  8-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
-
-: LD-RR,RR-instruction
-  "LD-RR,RR" "LD" complex-instruction
-  16-bit-registers sp <&> 
-  "," token <&
-  16-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
-
-: LD-R,(RR)-instruction
-  "LD-R,(RR)" "LD" complex-instruction
-  8-bit-registers sp <&> 
-  "," token <&
-  16-bit-registers indirect <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
-
-: LD-(NN),RR-instruction
-  "LD-(NN),RR" "LD" complex-instruction
-  "nn" token indirect sp <&
-  "," token <&
-  16-bit-registers <&>
-  just [ first2 swap curry ] <@ ;
-
-: LD-(NN),R-instruction
-  "LD-(NN),R" "LD" complex-instruction
-  "nn" token indirect sp <&
-  "," token <&
-  8-bit-registers <&>
-  just [ first2 swap curry ] <@ ;
-
-: LD-RR,(NN)-instruction
-  "LD-RR,(NN)" "LD" complex-instruction
-  16-bit-registers sp <&>
-  "," token <&
-  "nn" token indirect <&
-  just [ first2 swap curry ] <@ ;
-
-: LD-R,(NN)-instruction
-  "LD-R,(NN)" "LD" complex-instruction
-  8-bit-registers sp <&>
-  "," token <&
-  "nn" token indirect <&
-  just [ first2 swap curry ] <@ ;
-
-: OUT-(N),R-instruction
-  "OUT-(N),R" "OUT" complex-instruction
-  "n" token indirect sp <&
-  "," token <&
-  8-bit-registers <&>
-  just [ first2 swap curry ] <@ ;
-
-: IN-R,(N)-instruction
-  "IN-R,(N)" "IN" complex-instruction
-  8-bit-registers sp <&>
-  "," token <&
-  "n" token indirect <&
-  just [ first2 swap curry ] <@ ;
-
-: EX-(RR),RR-instruction
-  "EX-(RR),RR" "EX" complex-instruction
-  16-bit-registers indirect sp <&> 
-  "," token <&
-  16-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
-
-: EX-RR,RR-instruction
-  "EX-RR,RR" "EX" complex-instruction
-  16-bit-registers sp <&> 
-  "," token <&
-  16-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
-
-: 8080-generator-parser
-  NOP-instruction 
-  RST-0-instruction <|> 
-  RST-8-instruction <|> 
-  RST-10H-instruction <|> 
-  RST-18H-instruction <|> 
-  RST-20H-instruction <|> 
-  RST-28H-instruction <|> 
-  RST-30H-instruction <|> 
-  RST-38H-instruction <|> 
-  JP-F|FF,NN-instruction <|> 
-  JP-NN-instruction <|> 
-  JP-(RR)-instruction <|> 
-  CALL-F|FF,NN-instruction <|> 
-  CALL-NN-instruction <|> 
-  CPL-instruction <|> 
-  CCF-instruction <|> 
-  SCF-instruction <|> 
-  DAA-instruction <|> 
-  RLA-instruction <|> 
-  RRA-instruction <|> 
-  RLCA-instruction <|> 
-  RRCA-instruction <|> 
-  HALT-instruction <|> 
-  DI-instruction <|> 
-  EI-instruction <|> 
-  AND-N-instruction <|> 
-  AND-R-instruction <|> 
-  AND-(RR)-instruction <|> 
-  XOR-N-instruction <|> 
-  XOR-R-instruction <|> 
-  XOR-(RR)-instruction <|> 
-  OR-N-instruction <|> 
-  OR-R-instruction <|> 
-  OR-(RR)-instruction <|> 
-  CP-N-instruction <|> 
-  CP-R-instruction <|> 
-  CP-(RR)-instruction <|> 
-  DEC-RR-instruction <|> 
-  DEC-R-instruction <|> 
-  DEC-(RR)-instruction <|> 
-  POP-RR-instruction <|> 
-  PUSH-RR-instruction <|> 
-  INC-RR-instruction <|> 
-  INC-R-instruction <|> 
-  INC-(RR)-instruction <|>
-  LD-RR,NN-instruction <|> 
-  LD-R,N-instruction <|> 
-  LD-R,R-instruction <|> 
-  LD-RR,RR-instruction <|> 
-  LD-(RR),N-instruction <|> 
-  LD-(RR),R-instruction <|> 
-  LD-R,(RR)-instruction <|> 
-  LD-(NN),RR-instruction <|> 
-  LD-(NN),R-instruction <|> 
-  LD-RR,(NN)-instruction <|> 
-  LD-R,(NN)-instruction <|> 
-  ADC-R,N-instruction <|> 
-  ADC-R,R-instruction <|> 
-  ADC-R,(RR)-instruction <|> 
-  ADD-R,N-instruction <|> 
-  ADD-R,R-instruction <|> 
-  ADD-RR,RR-instruction <|> 
-  ADD-R,(RR)-instruction <|> 
-  SBC-R,N-instruction <|> 
-  SBC-R,R-instruction <|> 
-  SBC-R,(RR)-instruction <|> 
-  SUB-R-instruction <|> 
-  SUB-(RR)-instruction <|> 
-  SUB-N-instruction <|> 
-  RET-F|FF-instruction <|> 
-  RET-NN-instruction <|>
-  OUT-(N),R-instruction <|>
-  IN-R,(N)-instruction <|>
-  EX-(RR),RR-instruction <|>
-  EX-RR,RR-instruction <|>
-  just ;
-
-: instruction-quotations ( string -- emulate-quot )
-  #! Given an instruction string, return the emulation quotation for
-  #! it. This will later be expanded to produce the disassembly and
-  #! assembly quotations.
-  8080-generator-parser some parse call ;
-
-SYMBOL: last-instruction
-SYMBOL: last-opcode
-
-: parse-instructions ( list -- emulate-quot )
-  #! Process the list of strings, which should make
-  #! up an 8080 instruction, and output a quotation
-  #! that would implement that instruction.
-  [
-    dup " " join instruction-quotations
-    >r "_" join [ "emulate-" % % ] "" make create-in dup last-instruction global set-at  
-    r> define
-  ] with-compilation-unit ;
-
-: INSTRUCTION: ";" parse-tokens parse-instructions ; parsing
-
-: cycles ( -- )
-  #! Set the number of cycles for the last instruction that was defined. 
-  scan string>number last-opcode global at instruction-cycles set-nth ; parsing
-
-: opcode ( -- )
-  #! Set the opcode number for the last instruction that was defined.
-  last-instruction global at 1quotation scan 16 base>
-  dup last-opcode global set-at instructions set-nth ; parsing
+INSTRUCTION: NOP          ; opcode 00 cycles 04 
+INSTRUCTION: LD   BC,nn   ; opcode 01 cycles 10 
+INSTRUCTION: LD   (BC),A  ; opcode 02 cycles 07 
+INSTRUCTION: INC  BC      ; opcode 03 cycles 06 
+INSTRUCTION: INC  B       ; opcode 04 cycles 05 
+INSTRUCTION: DEC  B       ; opcode 05 cycles 05 
+INSTRUCTION: LD   B,n     ; opcode 06 cycles 07 
+INSTRUCTION: RLCA         ; opcode 07 cycles 04 
+! INSTRUCTION: NOP          ; opcode 08 cycles 04 
+INSTRUCTION: ADD  HL,BC   ; opcode 09 cycles 11 
+INSTRUCTION: LD   A,(BC)  ; opcode 0A cycles 07 
+INSTRUCTION: DEC  BC      ; opcode 0B cycles 06 
+INSTRUCTION: INC  C       ; opcode 0C cycles 05 
+INSTRUCTION: DEC  C       ; opcode 0D cycles 05 
+INSTRUCTION: LD   C,n     ; opcode 0E cycles 07 
+INSTRUCTION: RRCA         ; opcode 0F cycles 04 
+INSTRUCTION: LD   DE,nn   ; opcode 11 cycles 10 
+INSTRUCTION: LD   (DE),A  ; opcode 12 cycles 07 
+INSTRUCTION: INC  DE      ; opcode 13 cycles 06 
+INSTRUCTION: INC  D       ; opcode 14 cycles 05 
+INSTRUCTION: DEC  D       ; opcode 15 cycles 05 
+INSTRUCTION: LD   D,n     ; opcode 16 cycles 07 
+INSTRUCTION: RLA          ; opcode 17 cycles 04 
+INSTRUCTION: ADD  HL,DE   ; opcode 19 cycles 11 
+INSTRUCTION: LD   A,(DE)  ; opcode 1A cycles 07 
+INSTRUCTION: DEC  DE      ; opcode 1B cycles 06 
+INSTRUCTION: INC  E       ; opcode 1C cycles 05 
+INSTRUCTION: DEC  E       ; opcode 1D cycles 05 
+INSTRUCTION: LD   E,n     ; opcode 1E cycles 07 
+INSTRUCTION: RRA          ; opcode 1F cycles 04 
+INSTRUCTION: LD   HL,nn   ; opcode 21 cycles 10 
+INSTRUCTION: LD   (nn),HL ; opcode 22 cycles 16 
+INSTRUCTION: INC  HL      ; opcode 23 cycles 06 
+INSTRUCTION: INC  H       ; opcode 24 cycles 05 
+INSTRUCTION: DEC  H       ; opcode 25 cycles 05 
+INSTRUCTION: LD   H,n     ; opcode 26 cycles 07 
+INSTRUCTION: DAA          ; opcode 27 cycles 04 
+INSTRUCTION: ADD  HL,HL   ; opcode 29 cycles 11 
+INSTRUCTION: LD   HL,(nn) ; opcode 2A cycles 16 
+INSTRUCTION: DEC  HL      ; opcode 2B cycles 06 
+INSTRUCTION: INC  L       ; opcode 2C cycles 05 
+INSTRUCTION: DEC  L       ; opcode 2D cycles 05 
+INSTRUCTION: LD   L,n     ; opcode 2E cycles 07 
+INSTRUCTION: CPL          ; opcode 2F cycles 04 
+INSTRUCTION: LD   SP,nn   ; opcode 31 cycles 10 
+INSTRUCTION: LD   (nn),A  ; opcode 32 cycles 13 
+INSTRUCTION: INC  SP      ; opcode 33 cycles 06 
+INSTRUCTION: INC  (HL)    ; opcode 34 cycles 10 
+INSTRUCTION: DEC  (HL)    ; opcode 35 cycles 10 
+INSTRUCTION: LD   (HL),n  ; opcode 36 cycles 10 
+INSTRUCTION: SCF          ; opcode 37 cycles 04 
+INSTRUCTION: ADD  HL,SP   ; opcode 39 cycles 11 
+INSTRUCTION: LD   A,(nn)  ; opcode 3A cycles 13 
+INSTRUCTION: DEC  SP      ; opcode 3B cycles 06 
+INSTRUCTION: INC  A       ; opcode 3C cycles 05 
+INSTRUCTION: DEC  A       ; opcode 3D cycles 05 
+INSTRUCTION: LD   A,n     ; opcode 3E cycles 07 
+INSTRUCTION: CCF          ; opcode 3F cycles 04 
+INSTRUCTION: LD   B,B     ; opcode 40 cycles 05 
+INSTRUCTION: LD   B,C     ; opcode 41 cycles 05 
+INSTRUCTION: LD   B,D     ; opcode 42 cycles 05 
+INSTRUCTION: LD   B,E     ; opcode 43 cycles 05 
+INSTRUCTION: LD   B,H     ; opcode 44 cycles 05 
+INSTRUCTION: LD   B,L     ; opcode 45 cycles 05 
+INSTRUCTION: LD   B,(HL)  ; opcode 46 cycles 07 
+INSTRUCTION: LD   B,A     ; opcode 47 cycles 05 
+INSTRUCTION: LD   C,B     ; opcode 48 cycles 05 
+INSTRUCTION: LD   C,C     ; opcode 49 cycles 05 
+INSTRUCTION: LD   C,D     ; opcode 4A cycles 05 
+INSTRUCTION: LD   C,E     ; opcode 4B cycles 05 
+INSTRUCTION: LD   C,H     ; opcode 4C cycles 05 
+INSTRUCTION: LD   C,L     ; opcode 4D cycles 05 
+INSTRUCTION: LD   C,(HL)  ; opcode 4E cycles 07 
+INSTRUCTION: LD   C,A     ; opcode 4F cycles 05 
+INSTRUCTION: LD   D,B     ; opcode 50 cycles 05 
+INSTRUCTION: LD   D,C     ; opcode 51 cycles 05 
+INSTRUCTION: LD   D,D     ; opcode 52 cycles 05 
+INSTRUCTION: LD   D,E     ; opcode 53 cycles 05 
+INSTRUCTION: LD   D,H     ; opcode 54 cycles 05 
+INSTRUCTION: LD   D,L     ; opcode 55 cycles 05 
+INSTRUCTION: LD   D,(HL)  ; opcode 56 cycles 07 
+INSTRUCTION: LD   D,A     ; opcode 57 cycles 05 
+INSTRUCTION: LD   E,B     ; opcode 58 cycles 05 
+INSTRUCTION: LD   E,C     ; opcode 59 cycles 05 
+INSTRUCTION: LD   E,D     ; opcode 5A cycles 05 
+INSTRUCTION: LD   E,E     ; opcode 5B cycles 05 
+INSTRUCTION: LD   E,H     ; opcode 5C cycles 05 
+INSTRUCTION: LD   E,L     ; opcode 5D cycles 05 
+INSTRUCTION: LD   E,(HL)  ; opcode 5E cycles 07 
+INSTRUCTION: LD   E,A     ; opcode 5F cycles 05 
+INSTRUCTION: LD   H,B     ; opcode 60 cycles 05 
+INSTRUCTION: LD   H,C     ; opcode 61 cycles 05 
+INSTRUCTION: LD   H,D     ; opcode 62 cycles 05 
+INSTRUCTION: LD   H,E     ; opcode 63 cycles 05 
+INSTRUCTION: LD   H,H     ; opcode 64 cycles 05 
+INSTRUCTION: LD   H,L     ; opcode 65 cycles 05 
+INSTRUCTION: LD   H,(HL)  ; opcode 66 cycles 07 
+INSTRUCTION: LD   H,A     ; opcode 67 cycles 05 
+INSTRUCTION: LD   L,B     ; opcode 68 cycles 05 
+INSTRUCTION: LD   L,C     ; opcode 69 cycles 05 
+INSTRUCTION: LD   L,D     ; opcode 6A cycles 05 
+INSTRUCTION: LD   L,E     ; opcode 6B cycles 05 
+INSTRUCTION: LD   L,H     ; opcode 6C cycles 05 
+INSTRUCTION: LD   L,L     ; opcode 6D cycles 05 
+INSTRUCTION: LD   L,(HL)  ; opcode 6E cycles 07 
+INSTRUCTION: LD   L,A     ; opcode 6F cycles 05 
+INSTRUCTION: LD   (HL),B  ; opcode 70 cycles 07 
+INSTRUCTION: LD   (HL),C  ; opcode 71 cycles 07 
+INSTRUCTION: LD   (HL),D  ; opcode 72 cycles 07 
+INSTRUCTION: LD   (HL),E  ; opcode 73 cycles 07 
+INSTRUCTION: LD   (HL),H  ; opcode 74 cycles 07 
+INSTRUCTION: LD   (HL),L  ; opcode 75 cycles 07 
+INSTRUCTION: HALT         ; opcode 76 cycles 07 
+INSTRUCTION: LD   (HL),A  ; opcode 77 cycles 07 
+INSTRUCTION: LD   A,B     ; opcode 78 cycles 05 
+INSTRUCTION: LD   A,C     ; opcode 79 cycles 05 
+INSTRUCTION: LD   A,D     ; opcode 7A cycles 05 
+INSTRUCTION: LD   A,E     ; opcode 7B cycles 05 
+INSTRUCTION: LD   A,H     ; opcode 7C cycles 05 
+INSTRUCTION: LD   A,L     ; opcode 7D cycles 05 
+INSTRUCTION: LD   A,(HL)  ; opcode 7E cycles 07 
+INSTRUCTION: LD   A,A     ; opcode 7F cycles 05 
+INSTRUCTION: ADD  A,B     ; opcode 80 cycles 04 
+INSTRUCTION: ADD  A,C     ; opcode 81 cycles 04 
+INSTRUCTION: ADD  A,D     ; opcode 82 cycles 04 
+INSTRUCTION: ADD  A,E     ; opcode 83 cycles 04 
+INSTRUCTION: ADD  A,H     ; opcode 84 cycles 04 
+INSTRUCTION: ADD  A,L     ; opcode 85 cycles 04 
+INSTRUCTION: ADD  A,(HL)  ; opcode 86 cycles 07 
+INSTRUCTION: ADD  A,A     ; opcode 87 cycles 04 
+INSTRUCTION: ADC  A,B     ; opcode 88 cycles 04 
+INSTRUCTION: ADC  A,C     ; opcode 89 cycles 04 
+INSTRUCTION: ADC  A,D     ; opcode 8A cycles 04 
+INSTRUCTION: ADC  A,E     ; opcode 8B cycles 04 
+INSTRUCTION: ADC  A,H     ; opcode 8C cycles 04 
+INSTRUCTION: ADC  A,L     ; opcode 8D cycles 04 
+INSTRUCTION: ADC  A,(HL)  ; opcode 8E cycles 07 
+INSTRUCTION: ADC  A,A     ; opcode 8F cycles 04 
+INSTRUCTION: SUB  B       ; opcode 90 cycles 04 
+INSTRUCTION: SUB  C       ; opcode 91 cycles 04 
+INSTRUCTION: SUB  D       ; opcode 92 cycles 04 
+INSTRUCTION: SUB  E       ; opcode 93 cycles 04 
+INSTRUCTION: SUB  H       ; opcode 94 cycles 04 
+INSTRUCTION: SUB  L       ; opcode 95 cycles 04 
+INSTRUCTION: SUB  (HL)    ; opcode 96 cycles 07 
+INSTRUCTION: SUB  A       ; opcode 97 cycles 04 
+INSTRUCTION: SBC  A,B     ; opcode 98 cycles 04 
+INSTRUCTION: SBC  A,C     ; opcode 99 cycles 04 
+INSTRUCTION: SBC  A,D     ; opcode 9A cycles 04 
+INSTRUCTION: SBC  A,E     ; opcode 9B cycles 04 
+INSTRUCTION: SBC  A,H     ; opcode 9C cycles 04 
+INSTRUCTION: SBC  A,L     ; opcode 9D cycles 04 
+INSTRUCTION: SBC  A,(HL)  ; opcode 9E cycles 07 
+INSTRUCTION: SBC  A,A     ; opcode 9F cycles 04 
+INSTRUCTION: AND  B       ; opcode A0 cycles 04 
+INSTRUCTION: AND  C       ; opcode A1 cycles 04 
+INSTRUCTION: AND  D       ; opcode A2 cycles 04 
+INSTRUCTION: AND  E       ; opcode A3 cycles 04 
+INSTRUCTION: AND  H       ; opcode A4 cycles 04 
+INSTRUCTION: AND  L       ; opcode A5 cycles 04 
+INSTRUCTION: AND  (HL)    ; opcode A6 cycles 07 
+INSTRUCTION: AND  A       ; opcode A7 cycles 04 
+INSTRUCTION: XOR  B       ; opcode A8 cycles 04 
+INSTRUCTION: XOR  C       ; opcode A9 cycles 04 
+INSTRUCTION: XOR  D       ; opcode AA cycles 04 
+INSTRUCTION: XOR  E       ; opcode AB cycles 04 
+INSTRUCTION: XOR  H       ; opcode AC cycles 04 
+INSTRUCTION: XOR  L       ; opcode AD cycles 04 
+INSTRUCTION: XOR  (HL)    ; opcode AE cycles 07 
+INSTRUCTION: XOR  A       ; opcode AF cycles 04 
+INSTRUCTION: OR   B       ; opcode B0 cycles 04 
+INSTRUCTION: OR   C       ; opcode B1 cycles 04 
+INSTRUCTION: OR   D       ; opcode B2 cycles 04 
+INSTRUCTION: OR   E       ; opcode B3 cycles 04 
+INSTRUCTION: OR   H       ; opcode B4 cycles 04 
+INSTRUCTION: OR   L       ; opcode B5 cycles 04 
+INSTRUCTION: OR   (HL)    ; opcode B6 cycles 07 
+INSTRUCTION: OR   A       ; opcode B7 cycles 04 
+INSTRUCTION: CP   B       ; opcode B8 cycles 04 
+INSTRUCTION: CP   C       ; opcode B9 cycles 04 
+INSTRUCTION: CP   D       ; opcode BA cycles 04 
+INSTRUCTION: CP   E       ; opcode BB cycles 04 
+INSTRUCTION: CP   H       ; opcode BC cycles 04 
+INSTRUCTION: CP   L       ; opcode BD cycles 04 
+INSTRUCTION: CP   (HL)    ; opcode BE cycles 07 
+INSTRUCTION: CP   A       ; opcode BF cycles 04 
+INSTRUCTION: RET  NZ      ; opcode C0 cycles 05 
+INSTRUCTION: POP  BC      ; opcode C1 cycles 10 
+INSTRUCTION: JP   NZ,nn   ; opcode C2 cycles 10 
+INSTRUCTION: JP   nn      ; opcode C3 cycles 10 
+INSTRUCTION: CALL NZ,nn   ; opcode C4 cycles 11 
+INSTRUCTION: PUSH BC      ; opcode C5 cycles 11 
+INSTRUCTION: ADD  A,n     ; opcode C6 cycles 07 
+INSTRUCTION: RST  0       ; opcode C7 cycles 11 
+INSTRUCTION: RET  Z       ; opcode C8 cycles 05 
+INSTRUCTION: RET  nn      ; opcode C9 cycles 10 
+INSTRUCTION: JP   Z,nn    ; opcode CA cycles 10 
+INSTRUCTION: CALL Z,nn    ; opcode CC cycles 11 
+INSTRUCTION: CALL nn      ; opcode CD cycles 17 
+INSTRUCTION: ADC  A,n     ; opcode CE cycles 07 
+INSTRUCTION: RST  8       ; opcode CF cycles 11 
+INSTRUCTION: RET  NC      ; opcode D0 cycles 05 
+INSTRUCTION: POP  DE      ; opcode D1 cycles 10 
+INSTRUCTION: JP   NC,nn   ; opcode D2 cycles 10 
+INSTRUCTION: OUT  (n),A   ; opcode D3 cycles 10 
+INSTRUCTION: CALL NC,nn   ; opcode D4 cycles 11 
+INSTRUCTION: PUSH DE      ; opcode D5 cycles 11 
+INSTRUCTION: SUB  n       ; opcode D6 cycles 07 
+INSTRUCTION: RST  10H     ; opcode D7 cycles 11 
+INSTRUCTION: RET  C       ; opcode D8 cycles 05 
+INSTRUCTION: JP   C,nn    ; opcode DA cycles 10 
+INSTRUCTION: IN   A,(n)   ; opcode DB cycles 10 
+INSTRUCTION: CALL C,nn    ; opcode DC cycles 11 
+INSTRUCTION: SBC  A,n     ; opcode DE cycles 07 
+INSTRUCTION: RST  18H     ; opcode DF cycles 11 
+INSTRUCTION: RET  PO      ; opcode E0 cycles 05 
+INSTRUCTION: POP  HL      ; opcode E1 cycles 10 
+INSTRUCTION: JP   PO,nn   ; opcode E2 cycles 10 
+INSTRUCTION: EX   (SP),HL ; opcode E3 cycles 04 
+INSTRUCTION: CALL PO,nn   ; opcode E4 cycles 11 
+INSTRUCTION: PUSH HL      ; opcode E5 cycles 11 
+INSTRUCTION: AND  n       ; opcode E6 cycles 07 
+INSTRUCTION: RST  20H     ; opcode E7 cycles 11 
+INSTRUCTION: RET  PE      ; opcode E8 cycles 05 
+INSTRUCTION: JP   (HL)    ; opcode E9 cycles 04 
+INSTRUCTION: JP   PE,nn   ; opcode EA cycles 10 
+INSTRUCTION: EX   DE,HL   ; opcode EB cycles 04 
+INSTRUCTION: CALL PE,nn   ; opcode EC cycles 11 
+INSTRUCTION: XOR  n       ; opcode EE cycles 07 
+INSTRUCTION: RST  28H     ; opcode EF cycles 11 
+INSTRUCTION: RET  P       ; opcode F0 cycles 05 
+INSTRUCTION: POP  AF      ; opcode F1 cycles 10 
+INSTRUCTION: JP   P,nn    ; opcode F2 cycles 10 
+INSTRUCTION: DI           ; opcode F3 cycles 04 
+INSTRUCTION: CALL P,nn    ; opcode F4 cycles 11 
+INSTRUCTION: PUSH AF      ; opcode F5 cycles 11 
+INSTRUCTION: OR   n       ; opcode F6 cycles 07 
+INSTRUCTION: RST  30H     ; opcode F7 cycles 11 
+INSTRUCTION: RET  M       ; opcode F8 cycles 05 
+INSTRUCTION: LD   SP,HL   ; opcode F9 cycles 06 
+INSTRUCTION: JP   M,nn    ; opcode FA cycles 10 
+INSTRUCTION: EI           ; opcode FB cycles 04 
+INSTRUCTION: CALL M,nn    ; opcode FC cycles 11 
+INSTRUCTION: CP   n       ; opcode FE cycles 07 
+INSTRUCTION: RST  38H     ; opcode FF cycles 11 
 
 ! : each-8bit ( n quot -- )
 !   8 [ ! n quot bit
diff --git a/extra/cpu/8080/authors.txt b/extra/cpu/8080/authors.txt
new file mode 100644
index 0000000000..44b06f94bc
--- /dev/null
+++ b/extra/cpu/8080/authors.txt
@@ -0,0 +1 @@
+Chris Double
diff --git a/extra/cpu/8080/emulator/authors.txt b/extra/cpu/8080/emulator/authors.txt
new file mode 100644
index 0000000000..44b06f94bc
--- /dev/null
+++ b/extra/cpu/8080/emulator/authors.txt
@@ -0,0 +1 @@
+Chris Double
diff --git a/extra/cpu/8080/emulator/emulator-docs.factor b/extra/cpu/8080/emulator/emulator-docs.factor
new file mode 100644
index 0000000000..438b5cf268
--- /dev/null
+++ b/extra/cpu/8080/emulator/emulator-docs.factor
@@ -0,0 +1,36 @@
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax sequences strings ;
+IN: cpu.8080.emulator
+
+HELP: load-rom 
+{ $values { "filename" string } { "cpu" cpu } }
+{ $description 
+"Read the ROM file into the cpu's memory starting at address 0000. " 
+"The filename is relative to the path stored in the " { $link rom-root }
+" variable. An exception is thrown if this variable is not set."
+}
+{ $see-also load-rom* } ;
+
+HELP: load-rom*
+{ $values { "seq" sequence } { "cpu" cpu } }
+{ $description 
+"Loads one or more ROM files into the cpu's memory. Each file is "
+"loaded at a particular starting address. 'seq' is a sequence of "
+"2 element arrays. The first element is the address and the second "
+"element is the file to load at that address." $nl
+"The filenames are relative to the path stored in the " { $link rom-root }
+" variable. An exception is thrown if this variable is not set."
+}
+{ $examples
+  { $code "{ { HEX: 0000 \"invaders.rom\" } } <cpu> load-rom*" }
+}
+{ $see-also load-rom } ;
+
+HELP: rom-root
+{ $description 
+"Holds the path where the ROM files are stored. Used for expanding "
+"the relative filenames passed to " { $link load-rom } " and "
+{ $link load-rom* } "."
+}
+{ $see-also load-rom load-rom* } ;
diff --git a/extra/cpu/8080/emulator/emulator.factor b/extra/cpu/8080/emulator/emulator.factor
new file mode 100644
index 0000000000..0eca7bdc47
--- /dev/null
+++ b/extra/cpu/8080/emulator/emulator.factor
@@ -0,0 +1,1356 @@
+! Copyright (C) 2006 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+!
+USING: kernel math sequences words arrays io 
+       io.files namespaces math.parser kernel.private
+       assocs quotations parser parser-combinators tools.time
+       combinators.private compiler.units ;
+IN: cpu.8080.emulator
+
+TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles ram ;
+
+GENERIC: reset        ( cpu            -- )
+GENERIC: update-video ( value addr cpu -- )
+GENERIC: read-port    ( port cpu       -- byte )
+GENERIC: write-port   ( value port cpu -- )
+
+M: cpu update-video ( value addr cpu -- )
+  3drop ;
+
+M: cpu read-port ( port cpu -- byte )
+  #! Read a byte from the hardware port. 'port' should
+  #! be an 8-bit value.
+  2drop 0 ;
+
+M: cpu write-port ( value port cpu -- )
+  #! Write a byte to the hardware port, where 'port' is
+  #! an 8-bit value.
+  3drop ;
+
+: carry-flag        HEX: 01 ; inline
+: parity-flag       HEX: 04 ; inline
+: half-carry-flag   HEX: 10 ; inline
+: interrupt-flag    HEX: 20 ; inline
+: zero-flag         HEX: 40 ; inline
+: sign-flag         HEX: 80 ; inline
+
+: >word< ( word -- byte byte )
+  #! Explode a word into its two 8 bit values.
+  dup HEX: FF bitand swap -8 shift HEX: FF bitand swap ;
+
+: cpu-af ( cpu -- word )
+  #! Return the 16-bit pseudo register AF.
+  [ cpu-a 8 shift ] keep cpu-f bitor ;
+
+: set-cpu-af ( value cpu -- )
+  #! Set the value of the 16-bit pseudo register AF
+  >r >word< r> tuck set-cpu-f set-cpu-a ;
+
+: cpu-bc ( cpu -- word )
+  #! Return the 16-bit pseudo register BC.
+  [ cpu-b 8 shift ] keep cpu-c bitor ;
+
+: set-cpu-bc ( value cpu -- )
+  #! Set the value of the 16-bit pseudo register BC
+  >r >word< r> tuck set-cpu-c set-cpu-b ;
+
+: cpu-de ( cpu -- word )
+  #! Return the 16-bit pseudo register DE.
+  [ cpu-d 8 shift ] keep cpu-e bitor ;
+
+: set-cpu-de ( value cpu -- )
+  #! Set the value of the 16-bit pseudo register DE
+  >r >word< r> tuck set-cpu-e set-cpu-d ;
+
+: cpu-hl ( cpu -- word )
+  #! Return the 16-bit pseudo register HL.
+  [ cpu-h 8 shift ] keep cpu-l bitor ;
+
+: set-cpu-hl ( value cpu -- )
+  #! Set the value of the 16-bit pseudo register HL
+  >r >word< r> tuck set-cpu-l set-cpu-h ;
+
+: flag-set? ( flag cpu -- bool )
+  cpu-f bitand 0 = not ;
+
+: flag-clear? ( flag cpu -- bool )
+  cpu-f bitand 0 = ;
+
+: flag-nz? ( cpu -- bool )
+  #! Test flag status
+  cpu-f zero-flag bitand 0 = ;
+
+: flag-z? ( cpu -- bool )
+  #! Test flag status
+  cpu-f zero-flag bitand 0 = not ;
+
+: flag-nc? ( cpu -- bool )
+  #! Test flag status
+  cpu-f carry-flag bitand 0 = ;
+
+: flag-c? ( cpu -- bool )
+  #! Test flag status
+  cpu-f carry-flag bitand 0 = not ;
+
+: flag-po? ( cpu -- bool )
+  #! Test flag status
+  cpu-f parity-flag bitand 0 =  ;
+
+: flag-pe? ( cpu -- bool )
+  #! Test flag status
+  cpu-f parity-flag bitand 0 = not ;
+
+: flag-p? ( cpu -- bool )
+  #! Test flag status
+  cpu-f sign-flag bitand 0 = ;
+
+: flag-m? ( cpu -- bool )
+  #! Test flag status
+  cpu-f sign-flag bitand 0 = not ;
+
+: read-byte ( addr cpu -- byte )
+  #! Read one byte from memory at the specified address.
+  #! The address is 16-bit, but if a value greater than
+  #! 0xFFFF is provided then return a default value.
+  over HEX: FFFF <= [
+    cpu-ram nth
+  ] [
+    2drop HEX: FF
+  ] if ;
+
+: read-word ( addr cpu -- word )  
+  #! Read a 16-bit word from memory at the specified address.
+  #! The address is 16-bit, but if a value greater than
+  #! 0xFFFF is provided then return a default value.
+  [ read-byte ] 2keep >r 1 + r> read-byte 8 shift bitor ;
+ 
+: next-byte ( cpu -- byte )
+  #! Return the value of the byte at PC, and increment PC.
+  [ cpu-pc ] keep
+  [ read-byte ] keep 
+  [ cpu-pc 1 + ] keep
+  set-cpu-pc ;
+
+: next-word ( cpu -- word )
+  #! Return the value of the word at PC, and increment PC.
+  [ cpu-pc ] keep
+  [ read-word ] keep 
+  [ cpu-pc 2 + ] keep
+  set-cpu-pc ;
+
+
+: write-byte ( value addr cpu -- )
+  #! Write a byte to the specified memory address.
+  over dup HEX: 2000 < swap HEX: FFFF > or [
+    3drop
+  ] [
+    3dup cpu-ram set-nth
+    update-video
+  ] if ;
+
+
+: write-word ( value addr cpu -- )
+  #! Write a 16-bit word to the specified memory address.
+  >r >r >word< r> r> [ write-byte ] 2keep >r 1 + r> write-byte ;
+
+: cpu-a-bitand ( quot cpu -- )
+  #! A &= quot call 
+  [ cpu-a swap call bitand ] keep set-cpu-a ; inline
+
+: cpu-a-bitor ( quot cpu -- )
+  #! A |= quot call 
+  [ cpu-a swap call bitor ] keep set-cpu-a ; inline
+
+: cpu-a-bitxor ( quot cpu -- )
+  #! A ^= quot call 
+  [ cpu-a swap call bitxor ] keep set-cpu-a ; inline
+
+: cpu-a-bitxor= ( value cpu -- )
+  #! cpu-a ^= value
+  [ cpu-a bitxor ] keep set-cpu-a ;
+
+: cpu-f-bitand ( quot cpu -- )
+  #! F &= quot call 
+  [ cpu-f swap call bitand ] keep set-cpu-f ; inline
+
+: cpu-f-bitor ( quot cpu -- )
+  #! F |= quot call 
+  [ cpu-f swap call bitor ] keep set-cpu-f ; inline
+
+: cpu-f-bitxor ( quot cpu -- )
+  #! F |= quot call 
+  [ cpu-f swap call bitxor ] keep set-cpu-f ; inline
+
+: cpu-f-bitor= ( value cpu -- )
+  #! cpu-f |= value
+  [ cpu-f bitor ] keep set-cpu-f ;
+
+: cpu-f-bitand= ( value cpu -- )
+  #! cpu-f &= value
+  [ cpu-f bitand ] keep set-cpu-f ;
+
+: cpu-f-bitxor= ( value cpu -- )
+  #! cpu-f ^= value
+  [ cpu-f bitxor ] keep set-cpu-f ;
+
+: set-flag ( cpu flag -- )
+  swap cpu-f-bitor= ;
+
+: clear-flag ( cpu flag -- )
+   bitnot HEX: FF bitand swap cpu-f-bitand= ;
+
+: update-zero-flag ( result cpu -- )
+  #! If the result of an instruction has the value 0, this
+  #! flag is set, otherwise it is reset.
+  swap HEX: FF bitand 0 = [ zero-flag set-flag ] [ zero-flag clear-flag ] if ;
+
+: update-sign-flag ( result cpu -- )
+  #! If the most significant bit of the result 
+  #! has the value 1 then the flag is set, otherwise
+  #! it is reset.
+  swap HEX: 80 bitand 0 = [ sign-flag clear-flag ] [ sign-flag set-flag ] if ;
+
+: update-parity-flag ( result cpu -- )
+  #! If the modulo 2 sum of the bits of the result
+  #! is 0, (ie. if the result has even parity) this flag
+  #! is set, otherwise it is reset.
+  swap HEX: FF bitand 2 mod 0 = [ parity-flag set-flag ] [ parity-flag clear-flag ] if ;
+
+: update-carry-flag ( result cpu -- )
+  #! If the instruction resulted in a carry (from addition) 
+  #! or a borrow (from subtraction or a comparison) out of the
+  #! higher order bit, this flag is set, otherwise it is reset.
+  swap dup HEX: 100 >= swap 0 < or [ carry-flag set-flag ] [ carry-flag clear-flag ] if ;
+
+: update-half-carry-flag ( original change-by result cpu -- )
+  #! If the instruction caused a carry out of bit 3 and into bit 4 of the
+  #! resulting value, the half carry flag is set, otherwise it is reset.
+  #! The 'original' is the original value of the register being changed.
+  #! 'change-by' is the amount it is being added or decremented by.
+  #! 'result' is the result of that change.
+  >r bitxor bitxor HEX: 10 bitand 0 = not r> 
+  swap [ half-carry-flag set-flag ] [ half-carry-flag clear-flag ] if ;
+
+: update-flags ( result cpu -- )
+  2dup update-carry-flag
+  2dup update-parity-flag
+  2dup update-sign-flag
+  update-zero-flag ;
+
+: update-flags-no-carry ( result cpu -- )
+  2dup update-parity-flag
+  2dup update-sign-flag
+  update-zero-flag ;
+
+: add-byte ( lhs rhs cpu -- result )
+  #! Add rhs to lhs
+  >r 2dup + r> ! lhs rhs result cpu
+  [ update-flags ] 2keep 
+  [ update-half-carry-flag ] 2keep
+  drop HEX: FF bitand ;
+
+: add-carry ( change-by result cpu -- change-by result )
+  #! Add the effect of the carry flag to the result
+  flag-c? [ 1 + >r 1 + r> ] when ;
+
+: add-byte-with-carry ( lhs rhs cpu -- result )
+  #! Add rhs to lhs plus carry.
+  >r 2dup + r> ! lhs rhs result cpu
+  [ add-carry ] keep
+  [ update-flags ] 2keep 
+  [ update-half-carry-flag ] 2keep
+  drop HEX: FF bitand ;
+
+: sub-carry ( change-by result cpu -- change-by result ) 
+  #! Subtract the effect of the carry flag from the result
+  flag-c? [ 1 - >r 1 - r>  ] when ;
+
+: sub-byte ( lhs rhs cpu -- result )
+  #! Subtract rhs from lhs
+  >r 2dup - r> 
+  [ update-flags ] 2keep 
+  [ update-half-carry-flag ] 2keep
+  drop HEX: FF bitand ;
+
+: sub-byte-with-carry ( lhs rhs cpu -- result )
+  #! Subtract rhs from lhs and take carry into account
+  >r 2dup - r> 
+  [ sub-carry ] keep 
+  [ update-flags ] 2keep 
+  [ update-half-carry-flag ] 2keep
+  drop HEX: FF bitand ;
+ 
+: inc-byte ( byte cpu -- result )
+  #! Increment byte by one. Note that carry flag is not affected
+  #! by this operation.
+  >r 1 2dup + r> ! lhs rhs result cpu
+  [ update-flags-no-carry ] 2keep 
+  [ update-half-carry-flag ] 2keep
+  drop HEX: FF bitand ;
+
+: dec-byte ( byte cpu -- result )
+  #! Decrement byte by one. Note that carry flag is not affected
+  #! by this operation.
+  >r 1 2dup - r> ! lhs rhs result cpu
+  [ update-flags-no-carry ] 2keep 
+  [ update-half-carry-flag ] 2keep
+  drop HEX: FF bitand ;
+
+: inc-word ( w cpu -- w )
+  #! Increment word by one. Note that no flags are modified.
+  drop 1 + HEX: FFFF bitand ;
+
+: dec-word ( w cpu -- w )
+  #! Decrement word by one. Note that no flags are modified.
+  drop 1 - HEX: FFFF bitand ;
+
+: add-word ( lhs rhs cpu -- result )
+  #! Add rhs to lhs. Note that only the carry flag is modified
+  #! and only if there is a carry out of the double precision add.
+  >r + r> over HEX: FFFF > [ carry-flag set-flag ] [ drop ] if HEX: FFFF bitand ;
+
+: bit3or ( lhs rhs -- 0|1 )
+  #! bitor bit 3 of the two numbers on the stack
+  BIN: 00001000 bitand -3 shift >r
+  BIN: 00001000 bitand -3 shift r> 
+  bitor ;
+
+: and-byte ( lhs rhs cpu -- result )
+  #! Logically and rhs to lhs. The carry flag is cleared and
+  #! the half carry is set to the ORing of bits 3 of the operands.
+  [ drop bit3or ] 3keep ! bit3or lhs rhs cpu
+  >r bitand r> [ update-flags ] 2keep 
+  [ carry-flag clear-flag ] keep
+  rot 0 = [ half-carry-flag set-flag ] [ half-carry-flag clear-flag ] if
+  HEX: FF bitand ;
+
+: xor-byte ( lhs rhs cpu -- result )
+  #! Logically xor rhs to lhs. The carry and half-carry flags are cleared.
+  >r bitxor r> [ update-flags ] 2keep 
+  [ half-carry-flag carry-flag bitor clear-flag ] keep
+  drop HEX: FF bitand ;
+
+: or-byte ( lhs rhs cpu -- result )
+  #! Logically or rhs to lhs. The carry and half-carry flags are cleared.
+  >r bitor r> [ update-flags ] 2keep 
+  [ half-carry-flag carry-flag bitor clear-flag ] keep
+  drop HEX: FF bitand ;
+
+: flags ( seq -- seq )
+  [ 0 [ execute bitor ] reduce ] map ;
+
+: decrement-sp ( n cpu -- )
+  #! Decrement the stackpointer by n.  
+  [ cpu-sp ] keep 
+  >r swap - r> set-cpu-sp ;
+
+: save-pc ( cpu -- )
+  #! Save the value of the PC on the stack.
+  [ cpu-pc ] keep ! pc cpu
+  [ cpu-sp ] keep ! pc sp cpu
+  write-word ;
+
+: push-pc ( cpu -- )
+  #! Push the value of the PC on the stack.
+  2 over decrement-sp
+  save-pc ;
+
+: pop-pc ( cpu -- pc )
+  #! Pop the value of the PC off the stack.
+  [ cpu-sp ] keep
+  [ read-word ] keep 
+  -2 swap decrement-sp ;
+
+: push-sp ( value cpu -- )
+  [ 2 swap decrement-sp ] keep
+  [ cpu-sp ] keep
+  write-word ;
+  
+: pop-sp ( cpu -- value )
+  [ cpu-sp ] keep
+  [ read-word ] keep
+  -2 swap decrement-sp ;
+
+: call-sub ( addr cpu -- )
+  #! Call the address as a subroutine.
+  dup push-pc 
+  >r HEX: FFFF bitand r> set-cpu-pc ;
+
+: ret-from-sub ( cpu -- )
+  [ pop-pc ] keep set-cpu-pc ;
+ 
+: interrupt ( number cpu -- )
+  #! Perform a hardware interrupt
+!  "***Interrupt: " write over 16 >base print 
+  dup cpu-f interrupt-flag bitand 0 = not [
+    dup push-pc
+    set-cpu-pc
+  ] [
+    2drop
+  ] if ;
+
+: inc-cycles ( n cpu -- )
+  #! Increment the number of cpu cycles
+  [ cpu-cycles + ] keep set-cpu-cycles ;
+  
+: instruction-cycles ( -- vector )
+  #! Return a 256 element vector containing the cycles for
+  #! each opcode in the 8080 instruction set.
+  { 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f } ;
+
+: instructions ( -- vector )
+  #! Return a 256 element vector containing the emulation words for
+  #! each opcode in the 8080 instruction set.
+  { 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f 
+    f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f } ; 
+
+: not-implemented ( <cpu> -- )
+  drop ;
+
+instructions length [ 
+  dup instructions nth [
+    drop
+  ] [
+    [ not-implemented ] swap instructions set-nth 
+  ] if
+] each
+
+M: cpu reset ( cpu -- )
+  #! Reset the CPU to its poweron state
+  [ 0 swap set-cpu-b  ] keep
+  [ 0 swap set-cpu-c  ] keep
+  [ 0 swap set-cpu-d  ] keep
+  [ 0 swap set-cpu-e  ] keep
+  [ 0 swap set-cpu-h  ] keep
+  [ 0 swap set-cpu-l  ] keep
+  [ 0 swap set-cpu-a  ] keep
+  [ 0 swap set-cpu-f  ] keep
+  [ 0 swap set-cpu-pc  ] keep
+  [ HEX: F000 swap set-cpu-sp  ] keep 
+  [ HEX: FFFF 0 <array> swap set-cpu-ram ] keep
+  [ f swap set-cpu-halted? ] keep
+  [ HEX: 10 swap set-cpu-last-interrupt ] keep
+  0 swap set-cpu-cycles ;
+
+: <cpu> ( -- cpu ) cpu construct-empty dup reset ;
+
+: (load-rom) ( n ram -- )
+  read1 [ ! n ram ch
+    -rot [ set-nth ] 2keep >r 1 + r> (load-rom)
+  ] [
+    2drop
+  ] if* ;
+
+  #! Reads the ROM from stdin and stores it in ROM from
+  #! offset n.
+: load-rom ( filename cpu -- )
+  #! Load the contents of the file into ROM.
+  #! (address 0x0000-0x1FFF).
+  cpu-ram swap <file-reader> [ 
+    0 swap (load-rom)
+  ] with-stream ;
+
+SYMBOL: rom-root
+
+: rom-dir ( -- string )
+  rom-root get [ home "roms" path+ dup exists? [ drop f ] unless ] unless* ;
+
+: load-rom* ( seq cpu -- )
+  #! 'seq' is an array of arrays. Each array contains
+  #! an address and filename of a ROM file. The ROM
+  #! file will be loaded at the specified address. This
+  #! file path shoul dbe relative to the '/roms' resource path.
+  rom-dir [
+    cpu-ram [
+      swap first2 rom-dir swap path+ <file-reader> [      
+        swap (load-rom)
+      ] with-stream
+    ] curry each 
+  ] [
+    ! 
+    ! the ROM files.
+    "Set 'rom-root' to the path containing the root of the 8080 ROM files." throw
+  ] if ;
+
+: read-instruction ( cpu -- word )
+  #! Read the next instruction from the cpu's program 
+  #! counter, and increment the program counter.
+  [ cpu-pc ] keep ! pc cpu
+  [ over 1 + swap set-cpu-pc ] keep
+  read-byte ;
+
+: get-cycles ( n -- opcode )
+  #! Returns the cycles for the given instruction value.
+  #! If the opcode is not defined throw an error.
+  dup instruction-cycles nth [ 
+    nip  
+  ] [
+    [ "Undefined 8080 opcode: " % number>string % ] "" make throw
+  ] if* ;
+
+: process-interrupts ( cpu -- )
+  #! Process any hardware interrupts
+  [ cpu-cycles ] keep 
+  over 16667 < [
+    2drop
+  ] [ 
+    [ >r 16667 - r> set-cpu-cycles ] keep
+    dup cpu-last-interrupt HEX: 10 = [
+      HEX: 08 over set-cpu-last-interrupt HEX: 08 swap interrupt
+    ] [
+      HEX: 10 over set-cpu-last-interrupt HEX: 10 swap interrupt
+    ] if     
+  ] if ;
+
+: step ( cpu -- )
+  #! Run a single 8080 instruction
+  [ read-instruction ] keep ! n cpu
+  over get-cycles over inc-cycles
+  [ swap instructions dispatch ] keep
+  [ cpu-pc HEX: FFFF bitand ] keep 
+  [ set-cpu-pc ] keep 
+  process-interrupts ;
+
+: peek-instruction ( cpu -- word )
+  #! Return the next instruction from the cpu's program
+  #! counter, but don't increment the counter.
+  [ cpu-pc ] keep read-byte instructions nth first ;
+
+: cpu. ( cpu -- )
+  [ " PC: " write cpu-pc 16 >base 4 CHAR: \s pad-left write ] keep 
+  [ " B: " write cpu-b 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " C: " write cpu-c 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " D: " write cpu-d 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " E: " write cpu-e 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " F: " write cpu-f 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " H: " write cpu-h 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " L: " write cpu-l 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " A: " write cpu-a 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " SP: " write cpu-sp 16 >base 4 CHAR: \s pad-left write ] keep 
+  [ " cycles: " write cpu-cycles number>string 5 CHAR: \s pad-left write ] keep 
+  [ " " write peek-instruction word-name write " " write ] keep
+  nl drop ;
+
+: cpu*. ( cpu -- )
+  [ " PC: " write cpu-pc 16 >base 4 CHAR: \s pad-left write ] keep 
+  [ " B: " write cpu-b 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " C: " write cpu-c 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " D: " write cpu-d 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " E: " write cpu-e 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " F: " write cpu-f 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " H: " write cpu-h 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " L: " write cpu-l 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " A: " write cpu-a 16 >base 2 CHAR: \s pad-left write ] keep 
+  [ " SP: " write cpu-sp 16 >base 4 CHAR: \s pad-left write ] keep 
+  [ " cycles: " write cpu-cycles number>string 5 CHAR: \s pad-left write ] keep 
+  nl drop ;
+
+: test-step ( cpu -- cpu )
+  [ step ] keep dup cpu. ;
+
+: test-cpu ( -- cpu )
+  <cpu> "invaders.rom" over load-rom dup cpu. ;
+
+: test-n ( n -- )
+  test-cpu swap [ test-step ] times ;
+
+: run-n ( cpu n -- cpu )
+  [ dup step ] times ;
+
+: register-lookup ( string -- vector )
+  #! Given a string containing a register name, return a vector
+  #! where the 1st item is the getter and the 2nd is the setter
+  #! for that register.
+  H{
+    { "A"  { cpu-a  set-cpu-a  } }
+    { "B"  { cpu-b  set-cpu-b  } }
+    { "C"  { cpu-c  set-cpu-c  } }
+    { "D"  { cpu-d  set-cpu-d  } }
+    { "E"  { cpu-e  set-cpu-e  } }
+    { "H"  { cpu-h  set-cpu-h  } }
+    { "L"  { cpu-l  set-cpu-l  } }
+    { "AF" { cpu-af set-cpu-af } }
+    { "BC" { cpu-bc set-cpu-bc } }
+    { "DE" { cpu-de set-cpu-de } }
+    { "HL" { cpu-hl set-cpu-hl } }
+    { "SP" { cpu-sp set-cpu-sp } }
+  } at ;
+
+
+: flag-lookup ( string -- vector )
+  #! Given a string containing a flag name, return a vector
+  #! where the 1st item is a word that tests that flag.
+  H{
+    { "NZ"  { flag-nz?  } }
+    { "NC"  { flag-nc?  } }
+    { "PO"  { flag-po?  } }
+    { "PE"  { flag-pe?  } }
+    { "Z"  { flag-z?  } }
+    { "C"  { flag-c? } }
+    { "P"  { flag-p?  } }
+    { "M" { flag-m?  } }
+  } at ;
+
+SYMBOL: $1
+SYMBOL: $2
+SYMBOL: $3
+SYMBOL: $4
+
+: replace-patterns ( vector tree -- tree )
+  #! Copy the tree, replacing each occurence of 
+  #! $1, $2, etc with the relevant item from the 
+  #! given index.
+  dup quotation? over [ ] = not and [ ! vector tree
+    dup first swap 1 tail ! vector car cdr
+    >r dupd replace-patterns ! vector v R: cdr
+    swap r> replace-patterns >r 1quotation r> append
+  ] [ ! vector value
+    dup $1 = [ drop 0 over nth  ] when 
+    dup $2 = [ drop 1 over nth  ] when 
+    dup $3 = [ drop 2 over nth  ] when 
+    dup $4 = [ drop 3 over nth  ] when 
+    nip
+  ] if ;
+
+: test-rp 
+  { 4 5 3 } [ 1 $2 [ $1 4 ] ] replace-patterns ;
+
+: (emulate-RST) ( n cpu -- )
+  #! RST nn
+  [ cpu-sp 2 - dup ] keep ! sp sp cpu
+  [ set-cpu-sp ] keep ! sp cpu
+  [ cpu-pc ] keep ! sp pc cpu
+  swapd [ write-word ] keep ! cpu
+  >r 8 * r> set-cpu-pc ;
+
+: (emulate-CALL) ( cpu -- )
+  #! 205 - CALL nn
+  [ next-word HEX: FFFF bitand ] keep ! addr cpu
+  [ cpu-sp 2 - dup ] keep ! addr sp sp cpu
+  [ set-cpu-sp ] keep ! addr sp cpu
+  [ cpu-pc ] keep ! addr sp pc cpu
+  swapd [ write-word ] keep ! addr cpu
+  set-cpu-pc ;
+
+: (emulate-RLCA) ( cpu -- )
+  #! The content of the accumulator is rotated left
+  #! one position. The low order bit and the carry flag
+  #! are both set to the value shifd out of the high
+  #! order bit position. Only the carry flag is affected.
+  [ cpu-a -7 shift ] keep 
+  over 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if
+  [ cpu-a 1 shift HEX: FF bitand ] keep 
+  >r bitor r> set-cpu-a ;
+
+: (emulate-RRCA) ( cpu -- )
+  #! The content of the accumulator is rotated right
+  #! one position. The high order bit and the carry flag
+  #! are both set to the value shifd out of the low
+  #! order bit position. Only the carry flag is affected.
+  [ cpu-a 1 bitand 7 shift ] keep 
+  over 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if
+  [ cpu-a 254 bitand -1 shift ] keep 
+  >r bitor r> set-cpu-a ;
+
+: (emulate-RLA) ( cpu -- )  
+  #! The content of the accumulator is rotated left
+  #! one position through the carry flag. The low
+  #! order bit is set equal to the carry flag and
+  #! the carry flag is set to the value shifd out 
+  #! of the high order bit. Only the carry flag is
+  #! affected.
+  [ carry-flag swap flag-set? [ 1 ] [ 0 ] if ] keep 
+  [ cpu-a 127 bitand 7 shift ] keep 
+  dup cpu-a 128 bitand 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if
+  >r bitor r> set-cpu-a ;
+
+: (emulate-RRA) ( cpu -- )  
+  #! The content of the accumulator is rotated right
+  #! one position through the carry flag. The high order
+  #! bit is set to the carry flag and the carry flag is
+  #! set to the value shifd out of the low order bit. 
+  #! Only the carry flag is affected.
+  [ carry-flag swap flag-set? [ BIN: 10000000 ] [ 0 ] if ] keep 
+  [ cpu-a 254 bitand -1 shift ] keep 
+  dup cpu-a 1 bitand 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if
+  >r bitor r> set-cpu-a ;
+
+: (emulate-CPL) ( cpu -- )  
+  #! The contents of the accumulator are complemented
+  #! (zero bits become one, one bits becomes zero).
+  #! No flags are affected.
+  HEX: FF swap cpu-a-bitxor= ;
+
+: (emulate-DAA) ( cpu -- )  
+  #! The eight bit number in the accumulator is
+  #! adjusted to form two four-bit binary-coded-decimal
+  #! digits.
+  [
+    dup half-carry-flag swap flag-set? swap 
+    cpu-a BIN: 1111 bitand 9 > or [ 6 ] [ 0 ] if 
+  ] keep 
+  [ cpu-a + ] keep
+  [ update-flags ] 2keep  
+  [ swap HEX: FF bitand swap set-cpu-a ] keep 
+  [
+    dup carry-flag swap flag-set? swap 
+    cpu-a -4 shift BIN: 1111 bitand 9 > or [ 96 ] [ 0 ] if 
+  ] keep 
+  [ cpu-a + ] keep
+  [ update-flags ] 2keep  
+  swap HEX: FF bitand swap set-cpu-a ;
+  
+: patterns ( -- hashtable )
+  #! table of code quotation patterns for each type of instruction.
+  H{
+    { "NOP"          [ drop ]               }
+    { "RET-NN"          [ ret-from-sub  ]               }
+    { "RST-0"      [ 0 swap (emulate-RST) ] }
+    { "RST-8"      [ 8 swap (emulate-RST) ] }
+    { "RST-10H"      [ HEX: 10 swap (emulate-RST) ] }
+    { "RST-18H"      [ HEX: 18 swap (emulate-RST) ] }
+    { "RST-20H"      [ HEX: 20 swap (emulate-RST) ] }
+    { "RST-28H"      [ HEX: 28 swap (emulate-RST) ] }
+    { "RST-30H"      [ HEX: 30 swap (emulate-RST) ] }
+    { "RST-38H"      [ HEX: 38 swap (emulate-RST) ] }
+    { "RET-F|FF"      [ dup $1 [ 6 over inc-cycles ret-from-sub ] [ drop ] if ] }
+    { "CP-N"      [ [ cpu-a ] keep [ next-byte ] keep sub-byte drop ] }
+    { "CP-R"      [ [ cpu-a ] keep [ $1 ] keep sub-byte drop  ] }
+    { "CP-(RR)"      [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep sub-byte drop ] }
+    { "OR-N"      [ [ cpu-a ] keep [ next-byte ] keep [ or-byte ] keep set-cpu-a ] }
+    { "OR-R"      [ [ cpu-a ] keep [ $1 ] keep [ or-byte ] keep set-cpu-a ] }
+    { "OR-(RR)"      [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ or-byte ] keep set-cpu-a  ] }
+    { "XOR-N"      [ [ cpu-a ] keep [ next-byte ] keep [ xor-byte ] keep set-cpu-a ] }
+    { "XOR-R"      [ [ cpu-a ] keep [ $1 ] keep [ xor-byte ] keep set-cpu-a ] }
+    { "XOR-(RR)"   [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ xor-byte ] keep set-cpu-a  ] }
+    { "AND-N"      [ [ cpu-a ] keep [ next-byte ] keep [ and-byte ] keep set-cpu-a  ] }
+    { "AND-R"      [ [ cpu-a ] keep [ $1 ] keep [ and-byte ] keep set-cpu-a ] }
+    { "AND-(RR)"      [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ and-byte ] keep set-cpu-a  ] }
+    { "ADC-R,N"      [ [ $1 ] keep [ next-byte ] keep [ add-byte-with-carry ] keep $2 ] }
+    { "ADC-R,R"      [ [ $1 ] keep [ $3 ] keep [ add-byte-with-carry ] keep $2 ] }
+    { "ADC-R,(RR)"      [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ add-byte-with-carry ] keep $2 ] }
+    { "ADD-R,N"      [ [ $1 ] keep [ next-byte ] keep [ add-byte ] keep $2 ] }
+    { "ADD-R,R"      [ [ $1 ] keep [ $3 ] keep [ add-byte ] keep $2 ] }
+    { "ADD-RR,RR"    [ [ $1 ] keep [ $3 ] keep [ add-word ] keep $2 ] }
+    { "ADD-R,(RR)"    [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ add-byte ] keep $2   ]  }
+    { "SBC-R,N"      [ [ $1 ] keep [ next-byte ] keep [ sub-byte-with-carry ] keep $2 ] }
+    { "SBC-R,R"      [ [ $1 ] keep [ $3 ] keep [ sub-byte-with-carry ] keep $2 ] }
+    { "SBC-R,(RR)"      [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ sub-byte-with-carry ] keep $2 ] }
+    { "SUB-R"      [ [ cpu-a ] keep [ $1 ] keep [ sub-byte ] keep set-cpu-a ] }
+    { "SUB-(RR)"      [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ sub-byte ] keep set-cpu-a ] }
+    { "SUB-N"      [ [ cpu-a ] keep [ next-byte ] keep [ sub-byte ] keep set-cpu-a ] }
+    { "CPL"          [ (emulate-CPL) ]               }
+    { "DAA"          [ (emulate-DAA) ]               }
+    { "RLA"          [ (emulate-RLA) ]               }
+    { "RRA"          [ (emulate-RRA) ]               }
+    { "CCF"          [ carry-flag swap cpu-f-bitxor= ]               }
+    { "SCF"          [ carry-flag swap cpu-f-bitor= ]               }
+    { "RLCA"          [ (emulate-RLCA) ]               }
+    { "RRCA"          [ (emulate-RRCA) ]               }
+    { "HALT"          [ drop  ]               }
+    { "DI"          [ [ 255 interrupt-flag - ] swap cpu-f-bitand  ]               }
+    { "EI"          [ [ interrupt-flag ] swap cpu-f-bitor  ]  }  
+    { "POP-RR"     [ [ pop-sp ] keep $2 ] }
+    { "PUSH-RR"     [ [ $1 ] keep push-sp ] }
+    { "INC-R"     [ [ $1 ] keep [ inc-byte ] keep $2 ] }
+    { "DEC-R"     [ [ $1 ] keep [ dec-byte ] keep $2 ] }
+    { "INC-RR"     [ [ $1 ] keep [ inc-word ] keep $2 ] }
+    { "DEC-RR"     [ [ $1 ] keep [ dec-word ] keep $2 ] }
+    { "DEC-(RR)"     [ [ $1 ] keep [ read-byte ] keep [ dec-byte ] keep [ $1 ] keep write-byte ] }
+    { "INC-(RR)" [ [ $1 ] keep [ read-byte ] keep [ inc-byte ] keep  [ $1 ] keep write-byte ] }
+    { "JP-NN"           [ [ cpu-pc ] keep [ read-word ] keep set-cpu-pc ]               }
+    { "JP-F|FF,NN"      [ [ $1 ] keep swap [ [ next-word ] keep [ set-cpu-pc ] keep [ cpu-cycles ] keep swap 5 + swap set-cpu-cycles ] [ [ cpu-pc 2 + ] keep set-cpu-pc ] if ] }
+    { "JP-(RR)"      [ [ $1 ] keep set-cpu-pc ] }
+    { "CALL-NN"         [ (emulate-CALL) ] }
+    { "CALL-F|FF,NN"    [ [ $1 ] keep swap [ 7 over inc-cycles (emulate-CALL) ] [ [ cpu-pc 2 + ] keep set-cpu-pc ] if ]   }
+    { "LD-RR,NN"     [ [ next-word ] keep $2 ] }
+    { "LD-RR,RR"     [ [ $3 ] keep $2 ] }
+    { "LD-R,N"     [ [ next-byte ] keep $2 ] }
+    { "LD-(RR),N"    [ [ next-byte ] keep [ $1 ] keep write-byte ] }
+    { "LD-(RR),R"    [ [ $3 ] keep [ $1 ] keep write-byte ] }
+    { "LD-R,R"    [ [ $3 ] keep $2 ] }
+    { "LD-R,(RR)"    [ [ $3 ] keep [ read-byte ] keep $2  ] }
+    { "LD-(NN),RR"    [ [ $1 ] keep [ next-word ] keep write-word ] }
+    { "LD-(NN),R"    [  [ $1 ] keep [ next-word ] keep write-byte ] }
+    { "LD-RR,(NN)"    [ [ next-word ] keep [ read-word ] keep $2 ]  }
+    { "LD-R,(NN)"    [ [ next-word ] keep [ read-byte ] keep $2 ] }
+    { "OUT-(N),R"    [ [ $1 ] keep [ next-byte ] keep write-port ] }
+    { "IN-R,(N)"    [ [ next-byte ] keep [ read-port ] keep set-cpu-a ] }
+    { "EX-(RR),RR"  [  [ $1 ] keep [ read-word ] keep [ $3 ] keep [ $1 ] keep [ write-word ] keep $4 ] }
+    { "EX-RR,RR"    [ [ $1 ] keep [ $3 ] keep [ $2 ] keep $4 ] }
+  } ;
+
+: 8-bit-registers ( -- parser )
+  #! A parser for 8-bit registers. On a successfull parse the
+  #! parse tree contains a vector. The first item in the vector
+  #! is the getter word for that register with stack effect
+  #! ( cpu -- value ). The second item is the setter word with
+  #! stack effect ( value cpu -- ).
+  "A" token 
+  "B" token  <|>
+  "C" token  <|>
+  "D" token  <|>
+  "E" token  <|>
+  "H" token  <|>
+  "L" token  <|> [ register-lookup ] <@ ;
+
+: all-flags
+  #! A parser for 16-bit flags. 
+  "NZ" token  
+  "NC" token <|>
+  "PO" token <|>
+  "PE" token <|> 
+  "Z" token <|> 
+  "C" token <|> 
+  "P" token <|> 
+  "M" token <|> [ flag-lookup ] <@ ;
+
+: 16-bit-registers
+  #! A parser for 16-bit registers. On a successfull parse the
+  #! parse tree contains a vector. The first item in the vector
+  #! is the getter word for that register with stack effect
+  #! ( cpu -- value ). The second item is the setter word with
+  #! stack effect ( value cpu -- ).
+  "AF" token  
+  "BC" token <|>
+  "DE" token <|>
+  "HL" token <|>
+  "SP" token <|> [ register-lookup ] <@ ;
+
+: all-registers ( -- parser )
+  #! Return a parser that can parse the format
+  #! for 8 bit or 16 bit registers. 
+  8-bit-registers 16-bit-registers <|> ;
+
+: indirect ( parser -- parser )
+  #! Given a parser, return a parser which parses the original
+  #! wrapped in brackets, representing an indirect reference.
+  #! eg. BC -> (BC). The value of the original parser is left in
+  #! the parse tree.
+  "(" token swap &> ")" token <& ;
+
+: generate-instruction ( vector string -- quot )
+  #! Generate the quotation for an instruction, given the instruction in 
+  #! the 'string' and a vector containing the arguments for that instruction.
+  patterns at replace-patterns ;
+
+: simple-instruction ( token -- parser )
+  #! Return a parser for then instruction identified by the token. 
+  #! The parser return parses the token only and expects no additional
+  #! arguments to the instruction.
+  token [ [ { } clone , , \ generate-instruction , ] [ ] make ] <@ ;
+
+: complex-instruction ( type token -- parser )
+  #! Return a parser for an instruction identified by the token. 
+  #! The instruction is expected to take additional arguments by 
+  #! being combined with other parsers. Then 'type' is used for a lookup
+  #! in a pattern hashtable to return the instruction quotation pattern.
+  token swap [ nip [ , \ generate-instruction , ] [ ] make ] curry <@ ;
+
+: NOP-instruction ( -- parser )
+  "NOP" simple-instruction ;
+
+: RET-NN-instruction ( -- parser )  
+  "RET-NN" "RET" complex-instruction  
+  "nn" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: RST-0-instruction ( -- parser )  
+  "RST-0" "RST" complex-instruction  
+  "0" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: RST-8-instruction ( -- parser )  
+  "RST-8" "RST" complex-instruction  
+  "8" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: RST-10H-instruction ( -- parser )  
+  "RST-10H" "RST" complex-instruction  
+  "10H" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: RST-18H-instruction ( -- parser )  
+  "RST-18H" "RST" complex-instruction  
+  "18H" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: RST-20H-instruction ( -- parser )  
+  "RST-20H" "RST" complex-instruction  
+  "20H" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: RST-28H-instruction ( -- parser )  
+  "RST-28H" "RST" complex-instruction  
+  "28H" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: RST-30H-instruction ( -- parser )  
+  "RST-30H" "RST" complex-instruction  
+  "30H" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: RST-38H-instruction ( -- parser )  
+  "RST-38H" "RST" complex-instruction  
+  "38H" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: JP-NN-instruction ( -- parser )  
+  "JP-NN" "JP" complex-instruction  
+  "nn" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: JP-F|FF,NN-instruction ( -- parser )
+  "JP-F|FF,NN" "JP" complex-instruction  
+  all-flags sp <&> 
+  ",nn" token <&
+  just [ first2 swap curry ] <@ ;
+
+: JP-(RR)-instruction ( -- parser )
+  "JP-(RR)" "JP" complex-instruction  
+  16-bit-registers indirect sp <&>
+  just [ first2 swap curry ] <@ ;
+
+: CALL-NN-instruction ( -- parser )  
+  "CALL-NN" "CALL" complex-instruction  
+  "nn" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: CALL-F|FF,NN-instruction ( -- parser )
+  "CALL-F|FF,NN" "CALL" complex-instruction  
+  all-flags sp <&> 
+  ",nn" token <&
+  just [ first2 swap curry ] <@ ;
+
+: RLCA-instruction ( -- parser )
+  "RLCA" simple-instruction ;
+
+: RRCA-instruction ( -- parser )
+  "RRCA" simple-instruction ;
+
+: HALT-instruction ( -- parser )
+  "HALT" simple-instruction ;
+
+: DI-instruction ( -- parser )
+  "DI" simple-instruction ;
+
+: EI-instruction ( -- parser )
+  "EI" simple-instruction ;
+
+: CPL-instruction ( -- parser )
+  "CPL" simple-instruction ;
+
+: CCF-instruction ( -- parser )
+  "CCF" simple-instruction ;
+
+: SCF-instruction ( -- parser )
+  "SCF" simple-instruction ;
+
+: DAA-instruction ( -- parser )
+  "DAA" simple-instruction ;
+
+: RLA-instruction ( -- parser )
+  "RLA" simple-instruction ;
+
+: RRA-instruction ( -- parser )
+  "RRA" simple-instruction ;
+
+: DEC-R-instruction ( -- parser )
+  "DEC-R" "DEC" complex-instruction  8-bit-registers sp <&> 
+  just [ first2 swap curry ] <@ ;
+
+: DEC-RR-instruction ( -- parser )
+  "DEC-RR" "DEC" complex-instruction  16-bit-registers sp <&> 
+  just [ first2 swap curry ] <@ ;
+
+: DEC-(RR)-instruction ( -- parser )
+  "DEC-(RR)" "DEC" complex-instruction  
+  16-bit-registers indirect sp <&>
+  just [ first2 swap curry ] <@ ;
+
+: POP-RR-instruction ( -- parser )
+  "POP-RR" "POP" complex-instruction  all-registers sp <&> 
+  just [ first2 swap curry ] <@ ;
+
+: PUSH-RR-instruction ( -- parser )
+  "PUSH-RR" "PUSH" complex-instruction  all-registers sp <&> 
+  just [ first2 swap curry ] <@ ;
+
+: INC-R-instruction ( -- parser )
+  "INC-R" "INC" complex-instruction  8-bit-registers sp <&> 
+  just [ first2 swap curry ] <@ ;
+
+: INC-RR-instruction ( -- parser )
+  "INC-RR" "INC" complex-instruction  16-bit-registers sp <&> 
+  just [ first2 swap curry ] <@ ;
+   
+: INC-(RR)-instruction  ( -- parser )
+  "INC-(RR)" "INC" complex-instruction
+  all-registers indirect sp <&> just [ first2 swap curry ] <@ ;
+
+: RET-F|FF-instruction ( -- parser )
+  "RET-F|FF" "RET" complex-instruction  all-flags sp <&> 
+  just [ first2 swap curry ] <@ ;
+
+: AND-N-instruction ( -- parser )
+  "AND-N" "AND" complex-instruction
+  "n" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: AND-R-instruction  ( -- parser )
+  "AND-R" "AND" complex-instruction
+  8-bit-registers sp <&> just [ first2 swap curry ] <@ ;
+
+: AND-(RR)-instruction  ( -- parser )
+  "AND-(RR)" "AND" complex-instruction
+  16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ;
+
+: XOR-N-instruction ( -- parser )
+  "XOR-N" "XOR" complex-instruction
+  "n" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: XOR-R-instruction  ( -- parser )
+  "XOR-R" "XOR" complex-instruction
+  8-bit-registers sp <&> just [ first2 swap curry ] <@ ;
+
+: XOR-(RR)-instruction  ( -- parser )
+  "XOR-(RR)" "XOR" complex-instruction
+  16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ;
+
+: OR-N-instruction ( -- parser )
+  "OR-N" "OR" complex-instruction
+  "n" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: OR-R-instruction  ( -- parser )
+  "OR-R" "OR" complex-instruction
+  8-bit-registers sp <&> just [ first2 swap curry ] <@ ;
+
+: OR-(RR)-instruction  ( -- parser )
+  "OR-(RR)" "OR" complex-instruction
+  16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ;
+
+: CP-N-instruction ( -- parser )
+  "CP-N" "CP" complex-instruction
+  "n" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: CP-R-instruction  ( -- parser )
+  "CP-R" "CP" complex-instruction
+  8-bit-registers sp <&> just [ first2 swap curry ] <@ ;
+
+: CP-(RR)-instruction  ( -- parser )
+  "CP-(RR)" "CP" complex-instruction
+  16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ;
+
+: ADC-R,N-instruction ( -- parser )
+  "ADC-R,N" "ADC" complex-instruction
+  8-bit-registers sp <&>
+  ",n" token <& 
+  just [ first2 swap curry ] <@ ;  
+
+: ADC-R,R-instruction ( -- parser )
+  "ADC-R,R" "ADC" complex-instruction
+  8-bit-registers sp <&>
+  "," token <& 
+  8-bit-registers <&>
+  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+
+: ADC-R,(RR)-instruction ( -- parser )
+  "ADC-R,(RR)" "ADC" complex-instruction
+  8-bit-registers sp <&>
+  "," token <& 
+  16-bit-registers indirect <&>
+  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+
+: SBC-R,N-instruction ( -- parser )
+  "SBC-R,N" "SBC" complex-instruction
+  8-bit-registers sp <&>
+  ",n" token <& 
+  just [ first2 swap curry ] <@ ;  
+
+: SBC-R,R-instruction ( -- parser )
+  "SBC-R,R" "SBC" complex-instruction
+  8-bit-registers sp <&>
+  "," token <& 
+  8-bit-registers <&>
+  just [ first2 swap first2 swap >r swap append r> curry  ] <@ ;  
+
+: SBC-R,(RR)-instruction ( -- parser )
+  "SBC-R,(RR)" "SBC" complex-instruction
+  8-bit-registers sp <&>
+  "," token <& 
+  16-bit-registers indirect  <&>
+  just [ first2 swap first2 swap >r swap append r> curry  ] <@ ;  
+
+: SUB-R-instruction ( -- parser )
+  "SUB-R" "SUB" complex-instruction
+  8-bit-registers sp <&>
+  just [ first2 swap curry ] <@ ;  
+
+: SUB-(RR)-instruction ( -- parser )
+  "SUB-(RR)" "SUB" complex-instruction
+  16-bit-registers indirect sp <&>
+  just [ first2 swap curry ] <@ ;  
+
+: SUB-N-instruction ( -- parser )
+  "SUB-N" "SUB" complex-instruction
+  "n" token sp <&
+  just [ { } clone swap curry  ] <@ ;
+
+: ADD-R,N-instruction ( -- parser )
+  "ADD-R,N" "ADD" complex-instruction
+  8-bit-registers sp <&>
+  ",n" token <& 
+  just [ first2 swap curry ] <@ ;  
+
+: ADD-R,R-instruction ( -- parser )
+  "ADD-R,R" "ADD" complex-instruction
+  8-bit-registers sp <&>
+  "," token <& 
+  8-bit-registers <&>
+  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+
+: ADD-RR,RR-instruction ( -- parser )
+  "ADD-RR,RR" "ADD" complex-instruction
+  16-bit-registers sp <&>
+  "," token <& 
+  16-bit-registers <&>
+  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+
+: ADD-R,(RR)-instruction ( -- parser )
+  "ADD-R,(RR)" "ADD" complex-instruction
+  8-bit-registers sp <&>
+  "," token <& 
+  16-bit-registers indirect <&>
+  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  
+: LD-RR,NN-instruction
+  #! LD BC,nn
+  "LD-RR,NN" "LD" complex-instruction
+  16-bit-registers sp <&>
+  ",nn" token <& 
+  just [ first2 swap curry ] <@ ;
+
+: LD-R,N-instruction
+  #! LD B,n
+  "LD-R,N" "LD" complex-instruction
+  8-bit-registers sp <&>
+  ",n" token <& 
+  just [ first2 swap curry ] <@ ;
+  
+: LD-(RR),N-instruction
+  "LD-(RR),N" "LD" complex-instruction
+  16-bit-registers indirect sp <&> 
+  ",n" token <&
+  just [ first2 swap curry ] <@ ;
+
+: LD-(RR),R-instruction
+  #! LD (BC),A
+  "LD-(RR),R" "LD" complex-instruction
+  16-bit-registers indirect sp <&> 
+  "," token <&
+  8-bit-registers <&>
+  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+
+: LD-R,R-instruction
+  "LD-R,R" "LD" complex-instruction
+  8-bit-registers sp <&> 
+  "," token <&
+  8-bit-registers <&>
+  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+
+: LD-RR,RR-instruction
+  "LD-RR,RR" "LD" complex-instruction
+  16-bit-registers sp <&> 
+  "," token <&
+  16-bit-registers <&>
+  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+
+: LD-R,(RR)-instruction
+  "LD-R,(RR)" "LD" complex-instruction
+  8-bit-registers sp <&> 
+  "," token <&
+  16-bit-registers indirect <&>
+  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+
+: LD-(NN),RR-instruction
+  "LD-(NN),RR" "LD" complex-instruction
+  "nn" token indirect sp <&
+  "," token <&
+  16-bit-registers <&>
+  just [ first2 swap curry ] <@ ;
+
+: LD-(NN),R-instruction
+  "LD-(NN),R" "LD" complex-instruction
+  "nn" token indirect sp <&
+  "," token <&
+  8-bit-registers <&>
+  just [ first2 swap curry ] <@ ;
+
+: LD-RR,(NN)-instruction
+  "LD-RR,(NN)" "LD" complex-instruction
+  16-bit-registers sp <&>
+  "," token <&
+  "nn" token indirect <&
+  just [ first2 swap curry ] <@ ;
+
+: LD-R,(NN)-instruction
+  "LD-R,(NN)" "LD" complex-instruction
+  8-bit-registers sp <&>
+  "," token <&
+  "nn" token indirect <&
+  just [ first2 swap curry ] <@ ;
+
+: OUT-(N),R-instruction
+  "OUT-(N),R" "OUT" complex-instruction
+  "n" token indirect sp <&
+  "," token <&
+  8-bit-registers <&>
+  just [ first2 swap curry ] <@ ;
+
+: IN-R,(N)-instruction
+  "IN-R,(N)" "IN" complex-instruction
+  8-bit-registers sp <&>
+  "," token <&
+  "n" token indirect <&
+  just [ first2 swap curry ] <@ ;
+
+: EX-(RR),RR-instruction
+  "EX-(RR),RR" "EX" complex-instruction
+  16-bit-registers indirect sp <&> 
+  "," token <&
+  16-bit-registers <&>
+  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+
+: EX-RR,RR-instruction
+  "EX-RR,RR" "EX" complex-instruction
+  16-bit-registers sp <&> 
+  "," token <&
+  16-bit-registers <&>
+  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+
+: 8080-generator-parser
+  NOP-instruction 
+  RST-0-instruction <|> 
+  RST-8-instruction <|> 
+  RST-10H-instruction <|> 
+  RST-18H-instruction <|> 
+  RST-20H-instruction <|> 
+  RST-28H-instruction <|> 
+  RST-30H-instruction <|> 
+  RST-38H-instruction <|> 
+  JP-F|FF,NN-instruction <|> 
+  JP-NN-instruction <|> 
+  JP-(RR)-instruction <|> 
+  CALL-F|FF,NN-instruction <|> 
+  CALL-NN-instruction <|> 
+  CPL-instruction <|> 
+  CCF-instruction <|> 
+  SCF-instruction <|> 
+  DAA-instruction <|> 
+  RLA-instruction <|> 
+  RRA-instruction <|> 
+  RLCA-instruction <|> 
+  RRCA-instruction <|> 
+  HALT-instruction <|> 
+  DI-instruction <|> 
+  EI-instruction <|> 
+  AND-N-instruction <|> 
+  AND-R-instruction <|> 
+  AND-(RR)-instruction <|> 
+  XOR-N-instruction <|> 
+  XOR-R-instruction <|> 
+  XOR-(RR)-instruction <|> 
+  OR-N-instruction <|> 
+  OR-R-instruction <|> 
+  OR-(RR)-instruction <|> 
+  CP-N-instruction <|> 
+  CP-R-instruction <|> 
+  CP-(RR)-instruction <|> 
+  DEC-RR-instruction <|> 
+  DEC-R-instruction <|> 
+  DEC-(RR)-instruction <|> 
+  POP-RR-instruction <|> 
+  PUSH-RR-instruction <|> 
+  INC-RR-instruction <|> 
+  INC-R-instruction <|> 
+  INC-(RR)-instruction <|>
+  LD-RR,NN-instruction <|> 
+  LD-R,N-instruction <|> 
+  LD-R,R-instruction <|> 
+  LD-RR,RR-instruction <|> 
+  LD-(RR),N-instruction <|> 
+  LD-(RR),R-instruction <|> 
+  LD-R,(RR)-instruction <|> 
+  LD-(NN),RR-instruction <|> 
+  LD-(NN),R-instruction <|> 
+  LD-RR,(NN)-instruction <|> 
+  LD-R,(NN)-instruction <|> 
+  ADC-R,N-instruction <|> 
+  ADC-R,R-instruction <|> 
+  ADC-R,(RR)-instruction <|> 
+  ADD-R,N-instruction <|> 
+  ADD-R,R-instruction <|> 
+  ADD-RR,RR-instruction <|> 
+  ADD-R,(RR)-instruction <|> 
+  SBC-R,N-instruction <|> 
+  SBC-R,R-instruction <|> 
+  SBC-R,(RR)-instruction <|> 
+  SUB-R-instruction <|> 
+  SUB-(RR)-instruction <|> 
+  SUB-N-instruction <|> 
+  RET-F|FF-instruction <|> 
+  RET-NN-instruction <|>
+  OUT-(N),R-instruction <|>
+  IN-R,(N)-instruction <|>
+  EX-(RR),RR-instruction <|>
+  EX-RR,RR-instruction <|>
+  just ;
+
+: instruction-quotations ( string -- emulate-quot )
+  #! Given an instruction string, return the emulation quotation for
+  #! it. This will later be expanded to produce the disassembly and
+  #! assembly quotations.
+  8080-generator-parser some parse call ;
+
+SYMBOL: last-instruction
+SYMBOL: last-opcode
+
+: parse-instructions ( list -- emulate-quot )
+  #! Process the list of strings, which should make
+  #! up an 8080 instruction, and output a quotation
+  #! that would implement that instruction.
+  [
+    dup " " join instruction-quotations
+    >r "_" join [ "emulate-" % % ] "" make create-in dup last-instruction global set-at  
+    r> define
+  ] with-compilation-unit ;
+
+: INSTRUCTION: ";" parse-tokens parse-instructions ; parsing
+
+: cycles ( -- )
+  #! Set the number of cycles for the last instruction that was defined. 
+  scan string>number last-opcode global at instruction-cycles set-nth ; parsing
+
+: opcode ( -- )
+  #! Set the opcode number for the last instruction that was defined.
+  last-instruction global at 1quotation scan 16 base>
+  dup last-opcode global set-at instructions set-nth ; parsing
+
diff --git a/extra/cpu/8080/emulator/summary.txt b/extra/cpu/8080/emulator/summary.txt
new file mode 100644
index 0000000000..083492dfc4
--- /dev/null
+++ b/extra/cpu/8080/emulator/summary.txt
@@ -0,0 +1 @@
+Intel 8080 CPU Emulator
diff --git a/extra/cpu/8080/emulator/tags.txt b/extra/cpu/8080/emulator/tags.txt
new file mode 100644
index 0000000000..86069f7680
--- /dev/null
+++ b/extra/cpu/8080/emulator/tags.txt
@@ -0,0 +1 @@
+emulator
diff --git a/extra/cpu/8080/instructions/instructions.factor b/extra/cpu/8080/instructions/instructions.factor
deleted file mode 100644
index a1c3240d81..0000000000
--- a/extra/cpu/8080/instructions/instructions.factor
+++ /dev/null
@@ -1,250 +0,0 @@
-! Copyright (C) 2006 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-USING: cpu.8080 ;
-IN: cpu.8080.instructions
-
-INSTRUCTION: NOP          ; opcode 00 cycles 04 
-INSTRUCTION: LD   BC,nn   ; opcode 01 cycles 10 
-INSTRUCTION: LD   (BC),A  ; opcode 02 cycles 07 
-INSTRUCTION: INC  BC      ; opcode 03 cycles 06 
-INSTRUCTION: INC  B       ; opcode 04 cycles 05 
-INSTRUCTION: DEC  B       ; opcode 05 cycles 05 
-INSTRUCTION: LD   B,n     ; opcode 06 cycles 07 
-INSTRUCTION: RLCA         ; opcode 07 cycles 04 
-! INSTRUCTION: NOP          ; opcode 08 cycles 04 
-INSTRUCTION: ADD  HL,BC   ; opcode 09 cycles 11 
-INSTRUCTION: LD   A,(BC)  ; opcode 0A cycles 07 
-INSTRUCTION: DEC  BC      ; opcode 0B cycles 06 
-INSTRUCTION: INC  C       ; opcode 0C cycles 05 
-INSTRUCTION: DEC  C       ; opcode 0D cycles 05 
-INSTRUCTION: LD   C,n     ; opcode 0E cycles 07 
-INSTRUCTION: RRCA         ; opcode 0F cycles 04 
-INSTRUCTION: LD   DE,nn   ; opcode 11 cycles 10 
-INSTRUCTION: LD   (DE),A  ; opcode 12 cycles 07 
-INSTRUCTION: INC  DE      ; opcode 13 cycles 06 
-INSTRUCTION: INC  D       ; opcode 14 cycles 05 
-INSTRUCTION: DEC  D       ; opcode 15 cycles 05 
-INSTRUCTION: LD   D,n     ; opcode 16 cycles 07 
-INSTRUCTION: RLA          ; opcode 17 cycles 04 
-INSTRUCTION: ADD  HL,DE   ; opcode 19 cycles 11 
-INSTRUCTION: LD   A,(DE)  ; opcode 1A cycles 07 
-INSTRUCTION: DEC  DE      ; opcode 1B cycles 06 
-INSTRUCTION: INC  E       ; opcode 1C cycles 05 
-INSTRUCTION: DEC  E       ; opcode 1D cycles 05 
-INSTRUCTION: LD   E,n     ; opcode 1E cycles 07 
-INSTRUCTION: RRA          ; opcode 1F cycles 04 
-INSTRUCTION: LD   HL,nn   ; opcode 21 cycles 10 
-INSTRUCTION: LD   (nn),HL ; opcode 22 cycles 16 
-INSTRUCTION: INC  HL      ; opcode 23 cycles 06 
-INSTRUCTION: INC  H       ; opcode 24 cycles 05 
-INSTRUCTION: DEC  H       ; opcode 25 cycles 05 
-INSTRUCTION: LD   H,n     ; opcode 26 cycles 07 
-INSTRUCTION: DAA          ; opcode 27 cycles 04 
-INSTRUCTION: ADD  HL,HL   ; opcode 29 cycles 11 
-INSTRUCTION: LD   HL,(nn) ; opcode 2A cycles 16 
-INSTRUCTION: DEC  HL      ; opcode 2B cycles 06 
-INSTRUCTION: INC  L       ; opcode 2C cycles 05 
-INSTRUCTION: DEC  L       ; opcode 2D cycles 05 
-INSTRUCTION: LD   L,n     ; opcode 2E cycles 07 
-INSTRUCTION: CPL          ; opcode 2F cycles 04 
-INSTRUCTION: LD   SP,nn   ; opcode 31 cycles 10 
-INSTRUCTION: LD   (nn),A  ; opcode 32 cycles 13 
-INSTRUCTION: INC  SP      ; opcode 33 cycles 06 
-INSTRUCTION: INC  (HL)    ; opcode 34 cycles 10 
-INSTRUCTION: DEC  (HL)    ; opcode 35 cycles 10 
-INSTRUCTION: LD   (HL),n  ; opcode 36 cycles 10 
-INSTRUCTION: SCF          ; opcode 37 cycles 04 
-INSTRUCTION: ADD  HL,SP   ; opcode 39 cycles 11 
-INSTRUCTION: LD   A,(nn)  ; opcode 3A cycles 13 
-INSTRUCTION: DEC  SP      ; opcode 3B cycles 06 
-INSTRUCTION: INC  A       ; opcode 3C cycles 05 
-INSTRUCTION: DEC  A       ; opcode 3D cycles 05 
-INSTRUCTION: LD   A,n     ; opcode 3E cycles 07 
-INSTRUCTION: CCF          ; opcode 3F cycles 04 
-INSTRUCTION: LD   B,B     ; opcode 40 cycles 05 
-INSTRUCTION: LD   B,C     ; opcode 41 cycles 05 
-INSTRUCTION: LD   B,D     ; opcode 42 cycles 05 
-INSTRUCTION: LD   B,E     ; opcode 43 cycles 05 
-INSTRUCTION: LD   B,H     ; opcode 44 cycles 05 
-INSTRUCTION: LD   B,L     ; opcode 45 cycles 05 
-INSTRUCTION: LD   B,(HL)  ; opcode 46 cycles 07 
-INSTRUCTION: LD   B,A     ; opcode 47 cycles 05 
-INSTRUCTION: LD   C,B     ; opcode 48 cycles 05 
-INSTRUCTION: LD   C,C     ; opcode 49 cycles 05 
-INSTRUCTION: LD   C,D     ; opcode 4A cycles 05 
-INSTRUCTION: LD   C,E     ; opcode 4B cycles 05 
-INSTRUCTION: LD   C,H     ; opcode 4C cycles 05 
-INSTRUCTION: LD   C,L     ; opcode 4D cycles 05 
-INSTRUCTION: LD   C,(HL)  ; opcode 4E cycles 07 
-INSTRUCTION: LD   C,A     ; opcode 4F cycles 05 
-INSTRUCTION: LD   D,B     ; opcode 50 cycles 05 
-INSTRUCTION: LD   D,C     ; opcode 51 cycles 05 
-INSTRUCTION: LD   D,D     ; opcode 52 cycles 05 
-INSTRUCTION: LD   D,E     ; opcode 53 cycles 05 
-INSTRUCTION: LD   D,H     ; opcode 54 cycles 05 
-INSTRUCTION: LD   D,L     ; opcode 55 cycles 05 
-INSTRUCTION: LD   D,(HL)  ; opcode 56 cycles 07 
-INSTRUCTION: LD   D,A     ; opcode 57 cycles 05 
-INSTRUCTION: LD   E,B     ; opcode 58 cycles 05 
-INSTRUCTION: LD   E,C     ; opcode 59 cycles 05 
-INSTRUCTION: LD   E,D     ; opcode 5A cycles 05 
-INSTRUCTION: LD   E,E     ; opcode 5B cycles 05 
-INSTRUCTION: LD   E,H     ; opcode 5C cycles 05 
-INSTRUCTION: LD   E,L     ; opcode 5D cycles 05 
-INSTRUCTION: LD   E,(HL)  ; opcode 5E cycles 07 
-INSTRUCTION: LD   E,A     ; opcode 5F cycles 05 
-INSTRUCTION: LD   H,B     ; opcode 60 cycles 05 
-INSTRUCTION: LD   H,C     ; opcode 61 cycles 05 
-INSTRUCTION: LD   H,D     ; opcode 62 cycles 05 
-INSTRUCTION: LD   H,E     ; opcode 63 cycles 05 
-INSTRUCTION: LD   H,H     ; opcode 64 cycles 05 
-INSTRUCTION: LD   H,L     ; opcode 65 cycles 05 
-INSTRUCTION: LD   H,(HL)  ; opcode 66 cycles 07 
-INSTRUCTION: LD   H,A     ; opcode 67 cycles 05 
-INSTRUCTION: LD   L,B     ; opcode 68 cycles 05 
-INSTRUCTION: LD   L,C     ; opcode 69 cycles 05 
-INSTRUCTION: LD   L,D     ; opcode 6A cycles 05 
-INSTRUCTION: LD   L,E     ; opcode 6B cycles 05 
-INSTRUCTION: LD   L,H     ; opcode 6C cycles 05 
-INSTRUCTION: LD   L,L     ; opcode 6D cycles 05 
-INSTRUCTION: LD   L,(HL)  ; opcode 6E cycles 07 
-INSTRUCTION: LD   L,A     ; opcode 6F cycles 05 
-INSTRUCTION: LD   (HL),B  ; opcode 70 cycles 07 
-INSTRUCTION: LD   (HL),C  ; opcode 71 cycles 07 
-INSTRUCTION: LD   (HL),D  ; opcode 72 cycles 07 
-INSTRUCTION: LD   (HL),E  ; opcode 73 cycles 07 
-INSTRUCTION: LD   (HL),H  ; opcode 74 cycles 07 
-INSTRUCTION: LD   (HL),L  ; opcode 75 cycles 07 
-INSTRUCTION: HALT         ; opcode 76 cycles 07 
-INSTRUCTION: LD   (HL),A  ; opcode 77 cycles 07 
-INSTRUCTION: LD   A,B     ; opcode 78 cycles 05 
-INSTRUCTION: LD   A,C     ; opcode 79 cycles 05 
-INSTRUCTION: LD   A,D     ; opcode 7A cycles 05 
-INSTRUCTION: LD   A,E     ; opcode 7B cycles 05 
-INSTRUCTION: LD   A,H     ; opcode 7C cycles 05 
-INSTRUCTION: LD   A,L     ; opcode 7D cycles 05 
-INSTRUCTION: LD   A,(HL)  ; opcode 7E cycles 07 
-INSTRUCTION: LD   A,A     ; opcode 7F cycles 05 
-INSTRUCTION: ADD  A,B     ; opcode 80 cycles 04 
-INSTRUCTION: ADD  A,C     ; opcode 81 cycles 04 
-INSTRUCTION: ADD  A,D     ; opcode 82 cycles 04 
-INSTRUCTION: ADD  A,E     ; opcode 83 cycles 04 
-INSTRUCTION: ADD  A,H     ; opcode 84 cycles 04 
-INSTRUCTION: ADD  A,L     ; opcode 85 cycles 04 
-INSTRUCTION: ADD  A,(HL)  ; opcode 86 cycles 07 
-INSTRUCTION: ADD  A,A     ; opcode 87 cycles 04 
-INSTRUCTION: ADC  A,B     ; opcode 88 cycles 04 
-INSTRUCTION: ADC  A,C     ; opcode 89 cycles 04 
-INSTRUCTION: ADC  A,D     ; opcode 8A cycles 04 
-INSTRUCTION: ADC  A,E     ; opcode 8B cycles 04 
-INSTRUCTION: ADC  A,H     ; opcode 8C cycles 04 
-INSTRUCTION: ADC  A,L     ; opcode 8D cycles 04 
-INSTRUCTION: ADC  A,(HL)  ; opcode 8E cycles 07 
-INSTRUCTION: ADC  A,A     ; opcode 8F cycles 04 
-INSTRUCTION: SUB  B       ; opcode 90 cycles 04 
-INSTRUCTION: SUB  C       ; opcode 91 cycles 04 
-INSTRUCTION: SUB  D       ; opcode 92 cycles 04 
-INSTRUCTION: SUB  E       ; opcode 93 cycles 04 
-INSTRUCTION: SUB  H       ; opcode 94 cycles 04 
-INSTRUCTION: SUB  L       ; opcode 95 cycles 04 
-INSTRUCTION: SUB  (HL)    ; opcode 96 cycles 07 
-INSTRUCTION: SUB  A       ; opcode 97 cycles 04 
-INSTRUCTION: SBC  A,B     ; opcode 98 cycles 04 
-INSTRUCTION: SBC  A,C     ; opcode 99 cycles 04 
-INSTRUCTION: SBC  A,D     ; opcode 9A cycles 04 
-INSTRUCTION: SBC  A,E     ; opcode 9B cycles 04 
-INSTRUCTION: SBC  A,H     ; opcode 9C cycles 04 
-INSTRUCTION: SBC  A,L     ; opcode 9D cycles 04 
-INSTRUCTION: SBC  A,(HL)  ; opcode 9E cycles 07 
-INSTRUCTION: SBC  A,A     ; opcode 9F cycles 04 
-INSTRUCTION: AND  B       ; opcode A0 cycles 04 
-INSTRUCTION: AND  C       ; opcode A1 cycles 04 
-INSTRUCTION: AND  D       ; opcode A2 cycles 04 
-INSTRUCTION: AND  E       ; opcode A3 cycles 04 
-INSTRUCTION: AND  H       ; opcode A4 cycles 04 
-INSTRUCTION: AND  L       ; opcode A5 cycles 04 
-INSTRUCTION: AND  (HL)    ; opcode A6 cycles 07 
-INSTRUCTION: AND  A       ; opcode A7 cycles 04 
-INSTRUCTION: XOR  B       ; opcode A8 cycles 04 
-INSTRUCTION: XOR  C       ; opcode A9 cycles 04 
-INSTRUCTION: XOR  D       ; opcode AA cycles 04 
-INSTRUCTION: XOR  E       ; opcode AB cycles 04 
-INSTRUCTION: XOR  H       ; opcode AC cycles 04 
-INSTRUCTION: XOR  L       ; opcode AD cycles 04 
-INSTRUCTION: XOR  (HL)    ; opcode AE cycles 07 
-INSTRUCTION: XOR  A       ; opcode AF cycles 04 
-INSTRUCTION: OR   B       ; opcode B0 cycles 04 
-INSTRUCTION: OR   C       ; opcode B1 cycles 04 
-INSTRUCTION: OR   D       ; opcode B2 cycles 04 
-INSTRUCTION: OR   E       ; opcode B3 cycles 04 
-INSTRUCTION: OR   H       ; opcode B4 cycles 04 
-INSTRUCTION: OR   L       ; opcode B5 cycles 04 
-INSTRUCTION: OR   (HL)    ; opcode B6 cycles 07 
-INSTRUCTION: OR   A       ; opcode B7 cycles 04 
-INSTRUCTION: CP   B       ; opcode B8 cycles 04 
-INSTRUCTION: CP   C       ; opcode B9 cycles 04 
-INSTRUCTION: CP   D       ; opcode BA cycles 04 
-INSTRUCTION: CP   E       ; opcode BB cycles 04 
-INSTRUCTION: CP   H       ; opcode BC cycles 04 
-INSTRUCTION: CP   L       ; opcode BD cycles 04 
-INSTRUCTION: CP   (HL)    ; opcode BE cycles 07 
-INSTRUCTION: CP   A       ; opcode BF cycles 04 
-INSTRUCTION: RET  NZ      ; opcode C0 cycles 05 
-INSTRUCTION: POP  BC      ; opcode C1 cycles 10 
-INSTRUCTION: JP   NZ,nn   ; opcode C2 cycles 10 
-INSTRUCTION: JP   nn      ; opcode C3 cycles 10 
-INSTRUCTION: CALL NZ,nn   ; opcode C4 cycles 11 
-INSTRUCTION: PUSH BC      ; opcode C5 cycles 11 
-INSTRUCTION: ADD  A,n     ; opcode C6 cycles 07 
-INSTRUCTION: RST  0       ; opcode C7 cycles 11 
-INSTRUCTION: RET  Z       ; opcode C8 cycles 05 
-INSTRUCTION: RET  nn      ; opcode C9 cycles 10 
-INSTRUCTION: JP   Z,nn    ; opcode CA cycles 10 
-INSTRUCTION: CALL Z,nn    ; opcode CC cycles 11 
-INSTRUCTION: CALL nn      ; opcode CD cycles 17 
-INSTRUCTION: ADC  A,n     ; opcode CE cycles 07 
-INSTRUCTION: RST  8       ; opcode CF cycles 11 
-INSTRUCTION: RET  NC      ; opcode D0 cycles 05 
-INSTRUCTION: POP  DE      ; opcode D1 cycles 10 
-INSTRUCTION: JP   NC,nn   ; opcode D2 cycles 10 
-INSTRUCTION: OUT  (n),A   ; opcode D3 cycles 10 
-INSTRUCTION: CALL NC,nn   ; opcode D4 cycles 11 
-INSTRUCTION: PUSH DE      ; opcode D5 cycles 11 
-INSTRUCTION: SUB  n       ; opcode D6 cycles 07 
-INSTRUCTION: RST  10H     ; opcode D7 cycles 11 
-INSTRUCTION: RET  C       ; opcode D8 cycles 05 
-INSTRUCTION: JP   C,nn    ; opcode DA cycles 10 
-INSTRUCTION: IN   A,(n)   ; opcode DB cycles 10 
-INSTRUCTION: CALL C,nn    ; opcode DC cycles 11 
-INSTRUCTION: SBC  A,n     ; opcode DE cycles 07 
-INSTRUCTION: RST  18H     ; opcode DF cycles 11 
-INSTRUCTION: RET  PO      ; opcode E0 cycles 05 
-INSTRUCTION: POP  HL      ; opcode E1 cycles 10 
-INSTRUCTION: JP   PO,nn   ; opcode E2 cycles 10 
-INSTRUCTION: EX   (SP),HL ; opcode E3 cycles 04 
-INSTRUCTION: CALL PO,nn   ; opcode E4 cycles 11 
-INSTRUCTION: PUSH HL      ; opcode E5 cycles 11 
-INSTRUCTION: AND  n       ; opcode E6 cycles 07 
-INSTRUCTION: RST  20H     ; opcode E7 cycles 11 
-INSTRUCTION: RET  PE      ; opcode E8 cycles 05 
-INSTRUCTION: JP   (HL)    ; opcode E9 cycles 04 
-INSTRUCTION: JP   PE,nn   ; opcode EA cycles 10 
-INSTRUCTION: EX   DE,HL   ; opcode EB cycles 04 
-INSTRUCTION: CALL PE,nn   ; opcode EC cycles 11 
-INSTRUCTION: XOR  n       ; opcode EE cycles 07 
-INSTRUCTION: RST  28H     ; opcode EF cycles 11 
-INSTRUCTION: RET  P       ; opcode F0 cycles 05 
-INSTRUCTION: POP  AF      ; opcode F1 cycles 10 
-INSTRUCTION: JP   P,nn    ; opcode F2 cycles 10 
-INSTRUCTION: DI           ; opcode F3 cycles 04 
-INSTRUCTION: CALL P,nn    ; opcode F4 cycles 11 
-INSTRUCTION: PUSH AF      ; opcode F5 cycles 11 
-INSTRUCTION: OR   n       ; opcode F6 cycles 07 
-INSTRUCTION: RST  30H     ; opcode F7 cycles 11 
-INSTRUCTION: RET  M       ; opcode F8 cycles 05 
-INSTRUCTION: LD   SP,HL   ; opcode F9 cycles 06 
-INSTRUCTION: JP   M,nn    ; opcode FA cycles 10 
-INSTRUCTION: EI           ; opcode FB cycles 04 
-INSTRUCTION: CALL M,nn    ; opcode FC cycles 11 
-INSTRUCTION: CP   n       ; opcode FE cycles 07 
-INSTRUCTION: RST  38H     ; opcode FF cycles 11 
diff --git a/extra/cpu/8080/summary.txt b/extra/cpu/8080/summary.txt
new file mode 100644
index 0000000000..083492dfc4
--- /dev/null
+++ b/extra/cpu/8080/summary.txt
@@ -0,0 +1 @@
+Intel 8080 CPU Emulator
diff --git a/extra/cpu/8080/tags.txt b/extra/cpu/8080/tags.txt
new file mode 100644
index 0000000000..86069f7680
--- /dev/null
+++ b/extra/cpu/8080/tags.txt
@@ -0,0 +1 @@
+emulator
diff --git a/extra/crypto/sha1/sha1.factor b/extra/crypto/sha1/sha1.factor
index 6906ce2b9a..94a51288bb 100644
--- a/extra/crypto/sha1/sha1.factor
+++ b/extra/crypto/sha1/sha1.factor
@@ -78,7 +78,7 @@ SYMBOL: K
         K get nth ,
         A get 5 bitroll-32 ,
         E get ,
-    ] { } make sum 4294967295 bitand ; inline
+    ] { } make sum >32-bit ; inline
 
 : set-vars ( temp -- )
     ! E = D;  D = C;  C = S^30(B);  B = A; A = TEMP;
diff --git a/extra/io/sniffer/bsd/bsd.factor b/extra/io/sniffer/bsd/bsd.factor
index 6a0d092807..5c32bd78d2 100644
--- a/extra/io/sniffer/bsd/bsd.factor
+++ b/extra/io/sniffer/bsd/bsd.factor
@@ -17,7 +17,7 @@ TUPLE: sniffer-spec path ifname ;
 C: <sniffer-spec> sniffer-spec
 
 : IOCPARM_MASK   HEX: 1fff ; inline
-: IOCPARM_MAX    IOCPARM_MASK 1 + ; inline
+: IOCPARM_MAX    IOCPARM_MASK 1+ ; inline
 : IOC_VOID       HEX: 20000000 ; inline
 : IOC_OUT        HEX: 40000000 ; inline
 : IOC_IN         HEX: 80000000 ; inline
diff --git a/extra/io/sniffer/filter/bsd/bsd.factor b/extra/io/sniffer/filter/bsd/bsd.factor
index c18cae41e5..4f6d8b2420 100644
--- a/extra/io/sniffer/filter/bsd/bsd.factor
+++ b/extra/io/sniffer/filter/bsd/bsd.factor
@@ -9,7 +9,7 @@ IN: io.sniffer.filter.bsd
 
 : bpf-align ( n -- n' )
     #! Align to next higher word size
-    "long" heap-size 1- [ + ] keep bitnot bitand ;
+    "long" heap-size align ;
 
 M: unix-io packet. ( string -- )
     18 cut swap >byte-array bpfh.
diff --git a/extra/lunar-rescue/lunar-rescue-docs.factor b/extra/lunar-rescue/lunar-rescue-docs.factor
index 7755415b1a..d54fe7d485 100644
--- a/extra/lunar-rescue/lunar-rescue-docs.factor
+++ b/extra/lunar-rescue/lunar-rescue-docs.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup cpu.8080 ;
+USING: help.syntax help.markup cpu.8080.emulator ;
 IN: lunar-rescue 
 
 HELP: run 
diff --git a/extra/match/match.factor b/extra/match/match.factor
index 117fc7ce05..6d63b5af21 100755
--- a/extra/match/match.factor
+++ b/extra/match/match.factor
@@ -3,7 +3,7 @@
 !
 ! Based on pattern matching code from Paul Graham's book 'On Lisp'.
 USING: parser kernel words namespaces sequences tuples
-combinators macros assocs ;
+combinators macros assocs math ;
 IN: match
 
 SYMBOL: _
@@ -54,6 +54,7 @@ MACRO: match-cond ( assoc -- )
 
 : replace-patterns ( object -- result )
     {
+	{ [ dup number? ] [ ] }
         { [ dup match-var? ] [ get ] }
         { [ dup sequence? ] [ [ replace-patterns ] map ] }
         { [ dup tuple? ] [ tuple>array replace-patterns >tuple ] }
diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor
index f805df8249..000d97f2a6 100644
--- a/extra/math/polynomials/polynomials.factor
+++ b/extra/math/polynomials/polynomials.factor
@@ -1,5 +1,5 @@
 USING: arrays kernel sequences vectors math math.vectors namespaces
-shuffle splitting ;
+shuffle splitting sequences.lib ;
 IN: math.polynomials
 
 ! Polynomials are vectors with the highest powers on the right:
@@ -22,7 +22,7 @@ PRIVATE>
 : p= ( p p -- ? ) pextend = ;
 
 : ptrim ( p -- p )
-    dup length 1 = [ [ zero? ] right-trim ] unless ;
+    dup singleton? [ [ zero? ] right-trim ] unless ;
 
 : 2ptrim ( p p -- p p ) [ ptrim ] 2apply ;
 : p+ ( p p -- p ) pextend v+ ;
diff --git a/extra/multiline/multiline.factor b/extra/multiline/multiline.factor
index e8063fc759..7f831e5351 100644
--- a/extra/multiline/multiline.factor
+++ b/extra/multiline/multiline.factor
@@ -16,7 +16,7 @@ IN: multiline
 
 : STRING:
     CREATE dup reset-generic
-    [ parse-here 1quotation define ] keep make-inline ; parsing
+    parse-here 1quotation define ; parsing
 
 : (parse-multiline-string) ( start-index end-text -- end-index )
     lexer get line-text 2dup start
diff --git a/extra/odbc/odbc-docs.factor b/extra/odbc/odbc-docs.factor
index b6915a01fb..57bc35d930 100644
--- a/extra/odbc/odbc-docs.factor
+++ b/extra/odbc/odbc-docs.factor
@@ -1,6 +1,8 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup odbc threads ;
+USING: help.syntax help.markup threads ;
+
+IN: odbc
 
 HELP: odbc-init 
 { $values { "env" "an ODBC environment handle" } } 
diff --git a/extra/ogg/ogg.factor b/extra/ogg/ogg.factor
index 9d6647858f..b0a78e1490 100644
--- a/extra/ogg/ogg.factor
+++ b/extra/ogg/ogg.factor
@@ -4,14 +4,13 @@
 USING: kernel system combinators alien alien.syntax ;
 IN: ogg
 
-: load-ogg-library ( -- )
-    "ogg" {
-        { [ win32? ]  [ "ogg.dll" ] }
-        { [ macosx? ] [ "libogg.0.dylib" ] }
-        { [ unix? ]   [ "libogg.so" ] }
-    } cond "cdecl" add-library ; parsing
-
-load-ogg-library
+<<
+"ogg" {
+    { [ win32? ]  [ "ogg.dll" ] }
+    { [ macosx? ] [ "libogg.0.dylib" ] }
+    { [ unix? ]   [ "libogg.so" ] }
+} cond "cdecl" add-library
+>>
 
 LIBRARY: ogg
 
diff --git a/extra/ogg/theora/theora.factor b/extra/ogg/theora/theora.factor
index 325fb91dad..0d9748a6f3 100644
--- a/extra/ogg/theora/theora.factor
+++ b/extra/ogg/theora/theora.factor
@@ -4,14 +4,13 @@
 USING: kernel system combinators alien alien.syntax ;
 IN: ogg.theora
 
-: load-theora-library ( -- )
-    "theora" {
-        { [ win32? ]  [ "libtheora.dll" ] }
-        { [ macosx? ] [ "libtheora.0.dylib" ] }
-        { [ unix? ]   [ "libtheora.so" ] }
-    } cond "cdecl" add-library ; parsing
-
-load-theora-library
+<<
+"theora" {
+    { [ win32? ]  [ "libtheora.dll" ] }
+    { [ macosx? ] [ "libtheora.0.dylib" ] }
+    { [ unix? ]   [ "libtheora.so" ] }
+} cond "cdecl" add-library
+>>
 
 LIBRARY: theora
 
diff --git a/extra/ogg/vorbis/vorbis.factor b/extra/ogg/vorbis/vorbis.factor
index e6e08efb0a..eff28b69ca 100644
--- a/extra/ogg/vorbis/vorbis.factor
+++ b/extra/ogg/vorbis/vorbis.factor
@@ -4,14 +4,13 @@
 USING: kernel system combinators alien alien.syntax ;
 IN: ogg.vorbis
 
-: load-vorbis-library ( -- )
-    "vorbis" {
-        { [ win32? ]  [ "vorbis.dll" ] }
-        { [ macosx? ] [ "libvorbis.0.dylib" ] }
-        { [ unix? ]   [ "libvorbis.so" ] }
-    } cond "cdecl" add-library ; parsing
-
-load-vorbis-library
+<<
+"vorbis" {
+    { [ win32? ]  [ "vorbis.dll" ] }
+    { [ macosx? ] [ "libvorbis.0.dylib" ] }
+    { [ unix? ]   [ "libvorbis.so" ] }
+} cond "cdecl" add-library 
+>>
 
 LIBRARY: vorbis
 
diff --git a/extra/ori/ori.factor b/extra/ori/ori.factor
index 3ada07b53f..db60f95183 100644
--- a/extra/ori/ori.factor
+++ b/extra/ori/ori.factor
@@ -1,7 +1,7 @@
 
 USING: kernel namespaces
        math math.constants math.functions math.matrices math.vectors
-       sequences splitting self ;
+       sequences splitting self math.trig ;
 
 IN: ori
 
@@ -11,13 +11,6 @@ C: <ori> ori
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! Temporarily defined here until math-contrib gets moved to extra/
-
-: deg>rad pi * 180 / ; inline
-: rad>deg 180 * pi / ; inline
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : ori> ( -- val ) self> ori-val ;
 
 : >ori ( val -- ) self> set-ori-val ;
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 411a47b9bd..3d9128fec9 100644
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -1,12 +1,16 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences strings namespaces math assocs shuffle 
-       vectors arrays combinators.lib memoize math.parser ;
+       vectors arrays combinators.lib memoize math.parser match ;
 IN: peg
 
 TUPLE: parse-result remaining ast ;
 
-GENERIC: (parse) ( state parser -- result )
+GENERIC: compile ( parser -- quot )
+
+: (parse) ( state parser -- result )
+  compile call ;
+
 
 <PRIVATE
 
@@ -72,135 +76,199 @@ PRIVATE>
 
 TUPLE: token-parser symbol ;
 
-M: token-parser (parse) ( input parser -- result )
-  token-parser-symbol 2dup head? [
-    dup >r length tail-slice r> <parse-result>
-  ] [
-    2drop f
-  ] if ;
-   
-TUPLE: satisfy-parser quot ;
+MATCH-VARS: ?token ;
 
-M: satisfy-parser (parse) ( state parser -- result )
-  over empty? [
-    2drop f 
-  ] [
-    satisfy-parser-quot [ unclip-slice dup ] dip call [  
-      <parse-result>
+: token-pattern ( -- quot )
+  [
+    ?token 2dup head? [
+      dup >r length tail-slice r> <parse-result>
     ] [
       2drop f
-    ] if
-  ] if ;
+    ] if 
+  ] ;
+  
+M: token-parser compile ( parser -- quot )
+  token-parser-symbol \ ?token token-pattern match-replace ;
+      
+TUPLE: satisfy-parser quot ;
+
+MATCH-VARS: ?quot ;
+
+: satisfy-pattern ( -- quot )
+  [
+    dup empty? [
+      drop f 
+    ] [
+      unclip-slice dup ?quot call [  
+        <parse-result>
+      ] [
+        2drop f
+      ] if
+    ] if 
+  ] ;
+
+M: satisfy-parser compile ( parser -- quot )
+  satisfy-parser-quot \ ?quot satisfy-pattern match-replace ;
 
 TUPLE: range-parser min max ;
 
-M: range-parser (parse) ( state parser -- result )
-  over empty? [
-    2drop f
-  ] [
-    0 pick nth dup rot 
-    { range-parser-min range-parser-max } get-slots between? [
-      [ 1 tail-slice ] dip <parse-result>
+MATCH-VARS: ?min ?max ;
+
+: range-pattern ( -- quot )
+  [
+    dup empty? [
+      drop f
     ] [
-      2drop f
-    ] if
-  ] if ;
+      0 over nth dup 
+      ?min ?max between? [
+         [ 1 tail-slice ] dip <parse-result>
+      ] [
+        2drop f
+      ] if
+    ] if 
+  ] ;
+
+M: range-parser compile ( parser -- quot )
+  T{ range-parser _ ?min ?max } range-pattern match-replace ;
 
 TUPLE: seq-parser parsers ;
 
-: do-seq-parser ( result parser -- result )
-  [ dup parse-result-remaining ] dip parse [
-    [ parse-result-remaining swap set-parse-result-remaining ] 2keep  
-    parse-result-ast dup ignore = [ drop ] [ swap [ parse-result-ast push ] keep ] if
-  ] [
-    drop f
-  ] if* ;
+: seq-pattern ( -- quot )
+  [
+    dup [
+      dup parse-result-remaining ?quot call [
+        [ parse-result-remaining swap set-parse-result-remaining ] 2keep
+        parse-result-ast dup ignore = [ 
+          drop  
+        ] [ 
+          swap [ parse-result-ast push ] keep 
+        ] if
+      ] [
+        drop f 
+      ] if*
+    ] [
+      drop f
+    ] if  
+  ] ;
 
-: (seq-parser) ( result parsers -- result )
-  dup empty? not pick and [
-    unclip swap [ do-seq-parser ] dip (seq-parser)
-  ] [
-    drop   
-  ] if ;
-
-M: seq-parser (parse) ( state parser -- result )
-  seq-parser-parsers [ V{ } clone <parse-result> ] dip  (seq-parser) ;
+M: seq-parser compile ( parser -- quot )
+  [
+    [ V{ } clone <parse-result> ] %
+    seq-parser-parsers [ compile \ ?quot seq-pattern match-replace % ] each 
+  ] [ ] make ;
 
 TUPLE: choice-parser parsers ;
-  
-: (choice-parser) ( state parsers -- result )
-  dup empty? [
-    2drop f
-  ] [
-    unclip pick swap parse [
-      2nip 
-    ] [
-      (choice-parser)
-    ] if* 
-  ] if ;
 
-M: choice-parser (parse) ( state parser -- result )
-  choice-parser-parsers (choice-parser) ;
+: choice-pattern ( -- quot )
+  [
+    dup [
+          
+    ] [
+      drop dup ?quot call   
+    ] if
+  ] ;
+
+M: choice-parser compile ( parser -- quot )
+  [
+    f ,
+    choice-parser-parsers [ compile \ ?quot choice-pattern match-replace % ] each
+    \ nip ,
+  ] [ ] make ;
 
 TUPLE: repeat0-parser p1 ;
 
-: (repeat-parser) ( parser result -- result )
-  2dup parse-result-remaining swap parse [
+: (repeat0) ( quot result -- result )
+  2dup parse-result-remaining swap call [
     [ parse-result-remaining swap set-parse-result-remaining ] 2keep 
     parse-result-ast swap [ parse-result-ast push ] keep
-    (repeat-parser) 
+    (repeat0) 
  ] [
     nip
-  ] if* ;
+  ] if* ; inline
 
-: clone-result ( result -- result )
-  { parse-result-remaining parse-result-ast }
-  get-slots 1vector  <parse-result> ;
+: repeat0-pattern ( -- quot )
+  [
+    ?quot swap (repeat0) 
+  ] ;
 
-M: repeat0-parser (parse) ( state parser -- result )
-     repeat0-parser-p1 2dup parse [ 
-       nipd clone-result (repeat-parser) 
-     ] [ 
-       drop V{ } clone <parse-result> 
-     ] if* ;
+M: repeat0-parser compile ( parser -- quot )
+  [
+    [ V{ } clone <parse-result> ] %
+    repeat0-parser-p1 compile \ ?quot repeat0-pattern match-replace %        
+  ] [ ] make ;
 
 TUPLE: repeat1-parser p1 ;
 
-M: repeat1-parser (parse) ( state parser -- result )
-   repeat1-parser-p1 tuck parse dup [ clone-result (repeat-parser) ] [ nip ] if ;
+: repeat1-pattern ( -- quot )
+  [
+    ?quot swap (repeat0) [
+      dup parse-result-ast empty? [
+        drop f
+      ] when  
+    ] [
+      f 
+    ] if*
+  ] ;
+
+M: repeat1-parser compile ( parser -- quot )
+  [
+    [ V{ } clone <parse-result> ] %
+    repeat1-parser-p1 compile \ ?quot repeat1-pattern match-replace % 
+  ] [ ] make ;
 
 TUPLE: optional-parser p1 ;
 
-M: optional-parser (parse) ( state parser -- result )
-   dupd optional-parser-p1 parse swap f <parse-result> or ;
+: optional-pattern ( -- quot )
+  [
+    dup ?quot call swap f <parse-result> or 
+  ] ;
+
+M: optional-parser compile ( parser -- quot )
+  optional-parser-p1 compile \ ?quot optional-pattern match-replace ;
 
 TUPLE: ensure-parser p1 ;
 
-M: ensure-parser (parse) ( state parser -- result )
-   dupd ensure-parser-p1 parse [
-     ignore <parse-result>  
-   ] [
-     drop f
-   ] if ;
+: ensure-pattern ( -- quot )
+  [
+    dup ?quot call [
+      ignore <parse-result>
+    ] [
+      drop f
+    ] if
+  ] ;
+
+M: ensure-parser compile ( parser -- quot )
+  ensure-parser-p1 compile \ ?quot ensure-pattern match-replace ;
 
 TUPLE: ensure-not-parser p1 ;
 
-M: ensure-not-parser (parse) ( state parser -- result )
-   dupd ensure-not-parser-p1 parse [
-     drop f
-   ] [
-     ignore <parse-result>  
-   ] if ;
+: ensure-not-pattern ( -- quot )
+  [
+    dup ?quot call [
+      drop f
+    ] [
+      ignore <parse-result>
+    ] if
+  ] ;
+
+M: ensure-not-parser compile ( parser -- quot )
+  ensure-not-parser-p1 compile \ ?quot ensure-not-pattern match-replace ;
 
 TUPLE: action-parser p1 quot ;
 
-M: action-parser (parse) ( state parser -- result )
-   tuck action-parser-p1 parse dup [ 
-     dup parse-result-ast rot action-parser-quot call
-     swap [ set-parse-result-ast ] keep
-   ] [
-     nip
-   ] if ;
+MATCH-VARS: ?action ;
+
+: action-pattern ( -- quot )
+  [
+    ?quot call dup [ 
+      dup parse-result-ast ?action call
+      swap [ set-parse-result-ast ] keep
+    ] when 
+  ] ;
+
+M: action-parser compile ( parser -- quot )
+  { action-parser-p1 action-parser-quot } get-slots [ compile ] dip 
+  2array { ?quot ?action } action-pattern match-replace ;
 
 : left-trim-slice ( string -- string )
   #! Return a new string without any leading whitespace
@@ -211,13 +279,17 @@ M: action-parser (parse) ( state parser -- result )
 
 TUPLE: sp-parser p1 ;
 
-M: sp-parser (parse) ( state parser -- result )
-  [ left-trim-slice ] dip sp-parser-p1 parse ;
+M: sp-parser compile ( parser -- quot )
+  [
+    \ left-trim-slice , sp-parser-p1 compile % 
+  ] [ ] make ;
 
 TUPLE: delay-parser quot ;
 
-M: delay-parser (parse) ( state parser -- result )
-  delay-parser-quot call parse ;
+M: delay-parser compile ( parser -- quot )
+  [
+    delay-parser-quot % \ compile , \ call ,
+  ] [ ] make ;
 
 PRIVATE>
 
diff --git a/extra/peg/search/search-docs.factor b/extra/peg/search/search-docs.factor
index 244dc7f838..fc1e618b9b 100755
--- a/extra/peg/search/search-docs.factor
+++ b/extra/peg/search/search-docs.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup peg peg.search ;
+USING: help.syntax help.markup peg ;
+IN: peg.search
 
 HELP: tree-write
 { $values
diff --git a/extra/postgresql/libpq/libpq.factor b/extra/postgresql/libpq/libpq.factor
index a7f4261055..3b21fd8203 100644
--- a/extra/postgresql/libpq/libpq.factor
+++ b/extra/postgresql/libpq/libpq.factor
@@ -8,14 +8,13 @@
 USING: alien alien.syntax combinators system ;
 IN: postgresql.libpq
 
-: load-postgresql-library ( -- )
-    "postgresql" {
-        { [ win32? ]  [ "libpq.dll" ] }
-        { [ macosx? ] [ "/opt/local/lib/postgresql81/libpq.dylib" ] }
-        { [ unix?  ]  [ "libpq.so" ] }
-    } cond "cdecl" add-library ; parsing
-
-load-postgresql-library
+<<
+"postgresql" {
+    { [ win32? ]  [ "libpq.dll" ] }
+    { [ macosx? ] [ "/opt/local/lib/postgresql81/libpq.dylib" ] }
+    { [ unix?  ]  [ "libpq.so" ] }
+} cond "cdecl" add-library
+>>
 
 ! ConnSatusType
 : CONNECTION_OK 					HEX: 0 ; inline
diff --git a/extra/space-invaders/space-invaders-docs.factor b/extra/space-invaders/space-invaders-docs.factor
index e6f5b123b0..c4e3a35668 100644
--- a/extra/space-invaders/space-invaders-docs.factor
+++ b/extra/space-invaders/space-invaders-docs.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup cpu.8080 ;
+USING: help.syntax help.markup cpu.8080.emulator ;
 IN: space-invaders 
 
 HELP: run 
diff --git a/extra/space-invaders/space-invaders.factor b/extra/space-invaders/space-invaders.factor
index aa76f8ec3f..4d74968c35 100755
--- a/extra/space-invaders/space-invaders.factor
+++ b/extra/space-invaders/space-invaders.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 !
-USING: cpu.8080 openal math alien.c-types sequences kernel
+USING: cpu.8080 cpu.8080.emulator openal math alien.c-types sequences kernel
        shuffle arrays io.files combinators kernel.private
        ui.gestures ui.gadgets ui.render opengl.gl system 
        threads concurrency match ui byte-arrays combinators.lib
diff --git a/extra/sqlite/lib/lib.factor b/extra/sqlite/lib/lib.factor
index d544b8f888..438f22a80f 100644
--- a/extra/sqlite/lib/lib.factor
+++ b/extra/sqlite/lib/lib.factor
@@ -12,14 +12,13 @@ IN: sqlite.lib
 USING: alien compiler kernel math namespaces sequences strings alien.syntax
     system combinators ;
 
-: load-sqlite-library ( -- )
-  "sqlite" {
-    { [ win32? ]  [ "sqlite3.dll" ] }
-    { [ macosx? ] [ "/usr/lib/libsqlite3.dylib" ] }
-    { [ unix? ]  [ "libsqlite3.so" ] }
-  } cond "cdecl" add-library ; parsing
-
-load-sqlite-library
+<<
+"sqlite" {
+  { [ win32? ]  [ "sqlite3.dll" ] }
+  { [ macosx? ] [ "/usr/lib/libsqlite3.dylib" ] }
+  { [ unix? ]  [ "libsqlite3.so" ] }
+} cond "cdecl" add-library
+>>
 
 ! Return values from sqlite functions
 : SQLITE_OK           0   ; inline ! Successful result
diff --git a/extra/sqlite/sqlite-docs.factor b/extra/sqlite/sqlite-docs.factor
index 7bdec6efa4..d58b553f11 100644
--- a/extra/sqlite/sqlite-docs.factor
+++ b/extra/sqlite/sqlite-docs.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help sqlite help.syntax help.markup ;
+USING: help help.syntax help.markup ;
 IN: sqlite
 
 HELP: sqlite-open 
diff --git a/extra/sqlite/tuple-db/tuple-db-docs.factor b/extra/sqlite/tuple-db/tuple-db-docs.factor
index 795836fa56..3c6df0eaa6 100644
--- a/extra/sqlite/tuple-db/tuple-db-docs.factor
+++ b/extra/sqlite/tuple-db/tuple-db-docs.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help sqlite sqlite.tuple-db help.syntax help.markup ;
+USING: help sqlite help.syntax help.markup ;
 IN: sqlite.tuple-db
 
 ARTICLE: { "sqlite" "tuple-db-loading" } "Loading"
diff --git a/extra/trees/avl/avl-docs.factor b/extra/trees/avl/avl-docs.factor
index 12465eec98..46f647470a 100644
--- a/extra/trees/avl/avl-docs.factor
+++ b/extra/trees/avl/avl-docs.factor
@@ -1,4 +1,5 @@
-USING: help.syntax help.markup trees.avl assocs ;
+USING: help.syntax help.markup assocs ;
+IN: trees.avl 
 
 HELP: AVL{
 { $syntax "AVL{ { key value }... }" }
@@ -23,5 +24,4 @@ ARTICLE: { "avl" "intro" } "AVL trees"
 { $subsection >avl }
 { $subsection POSTPONE: AVL{ } ;
 
-IN: trees.avl
 ABOUT: { "avl" "intro" }
diff --git a/extra/trees/avl/avl.factor b/extra/trees/avl/avl.factor
index 0c4bf5af28..a806dafdec 100644
--- a/extra/trees/avl/avl.factor
+++ b/extra/trees/avl/avl.factor
@@ -6,10 +6,10 @@ IN: trees.avl
 
 TUPLE: avl ;
 
-INSTANCE: avl assoc
+INSTANCE: avl tree-mixin
 
 : <avl> ( -- tree )
-    avl construct-empty <tree> over set-delegate ;
+    avl construct-tree ;
 
 TUPLE: avl-node balance ;
 
@@ -148,11 +148,3 @@ M: avl assoc-like
     \ } [ >avl ] parse-literal ; parsing
 
 M: avl pprint-delims drop \ AVL{ \ } ;
-
-! When tuple inheritance is used, the following lines won't be necessary
-M: avl assoc-size tree-count ;
-M: avl clear-assoc delegate clear-assoc ;
-M: avl assoc-find >r tree-root r> find-node ;
-M: avl clone dup assoc-clone-like ;
-M: avl >pprint-sequence >alist ;
-M: avl pprint-narrow? drop t ;
diff --git a/extra/trees/splay/splay-docs.factor b/extra/trees/splay/splay-docs.factor
index b621155e73..1c49febe01 100644
--- a/extra/trees/splay/splay-docs.factor
+++ b/extra/trees/splay/splay-docs.factor
@@ -1,4 +1,5 @@
-USING: help.syntax help.markup trees.splay assocs ;
+USING: help.syntax help.markup assocs ;
+IN: trees.splay 
 
 HELP: SPLAY{
 { $syntax "SPLAY{ { key value }... }" }
@@ -23,5 +24,4 @@ ARTICLE: { "splay" "intro" } "Splay trees"
 { $subsection >splay }
 { $subsection POSTPONE: SPLAY{ } ;
 
-IN: trees.splay
 ABOUT: { "splay" "intro" }
diff --git a/extra/trees/splay/splay.factor b/extra/trees/splay/splay.factor
index 5f7c50cfb2..4fe6fe79a5 100644
--- a/extra/trees/splay/splay.factor
+++ b/extra/trees/splay/splay.factor
@@ -1,5 +1,5 @@
 ! Copyright (c) 2005 Mackenzie Straight.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel math namespaces sequences assocs parser
 prettyprint.backend trees generic ;
 IN: trees.splay
@@ -7,10 +7,9 @@ IN: trees.splay
 TUPLE: splay ;
 
 : <splay> ( -- splay-tree )
-    \ splay construct-empty
-    <tree> over set-delegate ;
+    splay construct-tree ;
 
-INSTANCE: splay assoc
+INSTANCE: splay tree-mixin
 
 : rotate-right ( node -- node )
     dup node-left
@@ -138,16 +137,6 @@ M: splay new-assoc
     \ } [ >splay ] parse-literal ; parsing
 
 M: splay assoc-like
-    drop dup splay? [
-        dup tree? [ <splay> tuck set-delegate ] [ >splay ] if
-    ] unless ;
+    drop dup splay? [ >splay ] unless ;
 
 M: splay pprint-delims drop \ SPLAY{ \ } ;
-
-! When tuple inheritance is used, the following lines won't be necessary
-M: splay assoc-size tree-count ;
-M: splay clear-assoc delegate clear-assoc ;
-M: splay assoc-find >r tree-root r> find-node ;
-M: splay clone dup assoc-clone-like ;
-M: splay >pprint-sequence >alist ;
-M: splay pprint-narrow? drop t ;
diff --git a/extra/trees/trees-docs.factor b/extra/trees/trees-docs.factor
index 12bae4bac5..df04f1cb40 100644
--- a/extra/trees/trees-docs.factor
+++ b/extra/trees/trees-docs.factor
@@ -1,4 +1,5 @@
-USING: help.syntax help.markup trees assocs ;
+USING: help.syntax help.markup assocs ;
+IN: trees
 
 HELP: TREE{
 { $syntax "TREE{ { key value }... }" }
diff --git a/extra/trees/trees.factor b/extra/trees/trees.factor
index 971c961cbc..6d53d9e541 100644
--- a/extra/trees/trees.factor
+++ b/extra/trees/trees.factor
@@ -5,11 +5,19 @@ prettyprint.private kernel.private assocs random combinators
 parser prettyprint.backend ;
 IN: trees
 
+MIXIN: tree-mixin
+
 TUPLE: tree root count ;
+
 : <tree> ( -- tree )
     f 0 tree construct-boa ;
 
-INSTANCE: tree assoc
+: construct-tree ( class -- tree )
+    construct-empty <tree> over set-delegate ; inline
+
+INSTANCE: tree tree-mixin
+
+INSTANCE: tree-mixin assoc
 
 TUPLE: node key value left right ;
 : <node> ( key value -- node )
@@ -111,16 +119,13 @@ M: tree set-at ( value key tree -- )
         { [ t ] [ >r node-right r> find-node ] }
     } cond ; inline
 
-M: tree assoc-find ( tree quot -- key value ? )
+M: tree-mixin assoc-find ( tree quot -- key value ? )
     >r tree-root r> find-node ;
 
-M: tree clear-assoc
+M: tree-mixin clear-assoc
     0 over set-tree-count
     f swap set-tree-root ;
 
-M: tree assoc-size
-    tree-count ;
-
 : copy-node-contents ( new old -- )
     dup node-key pick set-node-key node-value swap set-node-value ;
 
@@ -189,16 +194,14 @@ M: tree clone dup assoc-clone-like ;
 : >tree ( assoc -- tree )
     T{ tree f f 0 } assoc-clone-like ;
 
-GENERIC: tree-assoc-like ( assoc -- tree )
-M: tuple tree-assoc-like ! will need changes for tuple inheritance
-    dup delegate dup tree? [ nip ] [ drop >tree ] if ;
-M: tree tree-assoc-like ;
-M: assoc tree-assoc-like >tree ;
-M: tree assoc-like drop tree-assoc-like ;
+M: tree-mixin assoc-like drop dup tree? [ >tree ] unless ;
 
 : TREE{
     \ } [ >tree ] parse-literal ; parsing
 
 M: tree pprint-delims drop \ TREE{ \ } ;
-M: tree >pprint-sequence >alist ;
-M: tree pprint-narrow? drop t ;
+
+M: tree-mixin assoc-size tree-count ;
+M: tree-mixin clone dup assoc-clone-like ;
+M: tree-mixin >pprint-sequence >alist ;
+M: tree-mixin pprint-narrow? drop t ;
diff --git a/extra/tuple-syntax/tuple-syntax-docs.factor b/extra/tuple-syntax/tuple-syntax-docs.factor
index 7d4c12c0e9..aacc48f9e5 100644
--- a/extra/tuple-syntax/tuple-syntax-docs.factor
+++ b/extra/tuple-syntax/tuple-syntax-docs.factor
@@ -1,4 +1,5 @@
-USING: help.markup help.syntax tuple-syntax ;
+USING: help.markup help.syntax ;
+IN: tuple-syntax
 
 HELP: TUPLE{
 { $syntax "TUPLE{ class slot-name: value... }" }
diff --git a/extra/webapps/cgi/cgi.factor b/extra/webapps/cgi/cgi.factor
index 26b8f31eae..9dd9dca39c 100644
--- a/extra/webapps/cgi/cgi.factor
+++ b/extra/webapps/cgi/cgi.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces kernel assocs io.files combinators
 arrays io.launcher io http.server.responders webapps.file
-sequences strings ;
+sequences strings math.parser ;
 IN: webapps.cgi
 
 SYMBOL: cgi-root
@@ -12,6 +12,8 @@ SYMBOL: cgi-root
 : cgi-variables ( name -- assoc )
     #! This needs some work.
     [
+        cgi-root get over path+ "PATH_TRANSLATED" set
+        cgi-root get over path+ "SCRIPT_FILENAME" set
         "SCRIPT_NAME" set
 
         "CGI/1.0" "GATEWAY_INTERFACE" set
@@ -29,13 +31,14 @@ SYMBOL: cgi-root
 
         "method" get >upper "REQUEST_METHOD" set
         "raw-query" get "QUERY_STRING" set
+	"Cookie" header-param "HTTP_COOKIE" set 
 
         "User-Agent" header-param "HTTP_USER_AGENT" set
         "Accept" header-param "HTTP_ACCEPT" set
 
         post? [
             "Content-Type" header-param "CONTENT_TYPE" set
-            "raw-response" get length "CONTENT_LENGTH" set
+            "raw-response" get length number>string "CONTENT_LENGTH" set
         ] when
     ] H{ } make-assoc ;
 
@@ -49,8 +52,7 @@ SYMBOL: cgi-root
     "200 CGI output follows" response
     stdio get swap cgi-descriptor <process-stream> [
         post? [
-            "raw-response" get
-            stream-write stream-flush
+            "raw-response" get write flush
         ] when
         stdio get swap (stream-copy)
     ] with-stream ;
diff --git a/extra/xmode/loader/loader.factor b/extra/xmode/loader/loader.factor
index e631a920be..096b83e22e 100755
--- a/extra/xmode/loader/loader.factor
+++ b/extra/xmode/loader/loader.factor
@@ -1,59 +1,11 @@
-USING: xmode.tokens xmode.rules xmode.keyword-map xml.data
-xml.utilities xml assocs kernel combinators sequences
-math.parser namespaces parser xmode.utilities regexp io.files ;
+USING: xmode.loader.syntax xmode.tokens xmode.rules
+xmode.keyword-map xml.data xml.utilities xml assocs kernel
+combinators sequences math.parser namespaces parser
+xmode.utilities regexp io.files ;
 IN: xmode.loader
 
 ! Based on org.gjt.sp.jedit.XModeHandler
 
-SYMBOL: ignore-case?
-
-! Attribute utilities
-: string>boolean ( string -- ? ) "TRUE" = ;
-
-: string>match-type ( string -- obj )
-    {
-        { "RULE" [ f ] }
-        { "CONTEXT" [ t ] }
-        [ string>token ]
-    } case ;
-
-: string>rule-set-name "MAIN" or ;
-
-! PROP, PROPS
-: parse-prop-tag ( tag -- key value )
-    "NAME" over at "VALUE" rot at ;
-
-: parse-props-tag ( tag -- assoc )
-    child-tags
-    [ parse-prop-tag ] H{ } map>assoc ;
-
-: position-attrs ( tag -- at-line-start? at-whitespace-end? at-word-start? )
-    ! XXX Wrong logic!
-    { "AT_LINE_START" "AT_WHITESPACE_END" "AT_WORD_START" }
-    swap [ at string>boolean ] curry map first3 ;
-
-: parse-literal-matcher ( tag -- matcher )
-    dup children>string
-    ignore-case? get <string-matcher>
-    swap position-attrs <matcher> ;
-
-: parse-regexp-matcher ( tag -- matcher )
-    dup children>string ignore-case? get <regexp>
-    swap position-attrs <matcher> ;
-
-! SPAN's children
-<TAGS: parse-begin/end-tag
-
-TAG: BEGIN
-    ! XXX
-    parse-literal-matcher swap set-rule-start ;
-
-TAG: END
-    ! XXX
-    parse-literal-matcher swap set-rule-end ;
-
-TAGS>
-
 ! RULES and its children
 <TAGS: parse-rule-tag
 
@@ -66,56 +18,12 @@ TAG: IMPORT ( rule-set tag -- )
 TAG: TERMINATE ( rule-set tag -- )
     "AT_CHAR" swap at string>number swap set-rule-set-terminate-char ;
 
-: (parse-rule-tag) ( rule-set tag specs class -- )
-    construct-rule swap init-from-tag swap add-rule ; inline
-
-: RULE:
-    scan scan-word
-    parse-definition { } make
-    swap [ (parse-rule-tag) ] 2curry (TAG:) ; parsing
-
-: shared-tag-attrs
-    { "TYPE" string>token set-rule-body-token } , ; inline
-
-: delegate-attr
-    { "DELEGATE" f set-rule-delegate } , ;
-
-: regexp-attr
-    { "HASH_CHAR" f set-rule-chars } , ;
-
-: match-type-attr
-    { "MATCH_TYPE" string>match-type set-rule-match-token } , ;
-
-: span-attrs
-    { "NO_LINE_BREAK" string>boolean set-rule-no-line-break? } ,
-    { "NO_WORD_BREAK" string>boolean set-rule-no-word-break? } ,
-    { "NO_ESCAPE" string>boolean set-rule-no-escape? } , ;
-
-: literal-start
-    [ parse-literal-matcher swap set-rule-start ] , ;
-
-: regexp-start
-    [ parse-regexp-matcher swap set-rule-start ] , ;
-
-: literal-end
-    [ parse-literal-matcher swap set-rule-end ] , ;
-
 RULE: SEQ seq-rule
     shared-tag-attrs delegate-attr literal-start ;
 
 RULE: SEQ_REGEXP seq-rule
     shared-tag-attrs delegate-attr regexp-attr regexp-start ;
 
-: parse-begin/end-tags
-    [
-        ! XXX: handle position attrs on span tag itself
-        child-tags [ parse-begin/end-tag ] with each
-    ] , ;
-
-: init-span-tag [ drop init-span ] , ;
-
-: init-eol-span-tag [ drop init-eol-span ] , ;
-
 RULE: SPAN span-rule
     shared-tag-attrs delegate-attr match-type-attr span-attrs parse-begin/end-tags init-span-tag ;
 
@@ -134,9 +42,6 @@ RULE: MARK_FOLLOWING mark-following-rule
 RULE: MARK_PREVIOUS mark-previous-rule
     shared-tag-attrs match-type-attr literal-start ;
 
-: parse-keyword-tag ( tag keyword-map -- )
-    >r dup name-tag string>token swap children>string r> set-at ;
-
 TAG: KEYWORDS ( rule-set tag -- key value )
     ignore-case? get <keyword-map>
     swap child-tags [ over parse-keyword-tag ] each
diff --git a/extra/xmode/loader/syntax/syntax.factor b/extra/xmode/loader/syntax/syntax.factor
new file mode 100644
index 0000000000..c754db61c8
--- /dev/null
+++ b/extra/xmode/loader/syntax/syntax.factor
@@ -0,0 +1,101 @@
+USING: xmode.tokens xmode.rules xmode.keyword-map xml.data
+xml.utilities xml assocs kernel combinators sequences
+math.parser namespaces parser xmode.utilities regexp io.files ;
+IN: xmode.loader.syntax
+
+SYMBOL: ignore-case?
+
+! Rule tag parsing utilities
+: (parse-rule-tag) ( rule-set tag specs class -- )
+    construct-rule swap init-from-tag swap add-rule ; inline
+
+: RULE:
+    scan scan-word
+    parse-definition { } make
+    swap [ (parse-rule-tag) ] 2curry (TAG:) ; parsing
+
+! Attribute utilities
+: string>boolean ( string -- ? ) "TRUE" = ;
+
+: string>match-type ( string -- obj )
+    {
+        { "RULE" [ f ] }
+        { "CONTEXT" [ t ] }
+        [ string>token ]
+    } case ;
+
+: string>rule-set-name "MAIN" or ;
+
+! PROP, PROPS
+: parse-prop-tag ( tag -- key value )
+    "NAME" over at "VALUE" rot at ;
+
+: parse-props-tag ( tag -- assoc )
+    child-tags
+    [ parse-prop-tag ] H{ } map>assoc ;
+
+: position-attrs ( tag -- at-line-start? at-whitespace-end? at-word-start? )
+    ! XXX Wrong logic!
+    { "AT_LINE_START" "AT_WHITESPACE_END" "AT_WORD_START" }
+    swap [ at string>boolean ] curry map first3 ;
+
+: parse-literal-matcher ( tag -- matcher )
+    dup children>string
+    ignore-case? get <string-matcher>
+    swap position-attrs <matcher> ;
+
+: parse-regexp-matcher ( tag -- matcher )
+    dup children>string ignore-case? get <regexp>
+    swap position-attrs <matcher> ;
+
+: shared-tag-attrs
+    { "TYPE" string>token set-rule-body-token } , ; inline
+
+: delegate-attr
+    { "DELEGATE" f set-rule-delegate } , ;
+
+: regexp-attr
+    { "HASH_CHAR" f set-rule-chars } , ;
+
+: match-type-attr
+    { "MATCH_TYPE" string>match-type set-rule-match-token } , ;
+
+: span-attrs
+    { "NO_LINE_BREAK" string>boolean set-rule-no-line-break? } ,
+    { "NO_WORD_BREAK" string>boolean set-rule-no-word-break? } ,
+    { "NO_ESCAPE" string>boolean set-rule-no-escape? } , ;
+
+: literal-start
+    [ parse-literal-matcher swap set-rule-start ] , ;
+
+: regexp-start
+    [ parse-regexp-matcher swap set-rule-start ] , ;
+
+: literal-end
+    [ parse-literal-matcher swap set-rule-end ] , ;
+
+! SPAN's children
+<TAGS: parse-begin/end-tag
+
+TAG: BEGIN
+    ! XXX
+    parse-literal-matcher swap set-rule-start ;
+
+TAG: END
+    ! XXX
+    parse-literal-matcher swap set-rule-end ;
+
+TAGS>
+
+: parse-begin/end-tags
+    [
+        ! XXX: handle position attrs on span tag itself
+        child-tags [ parse-begin/end-tag ] with each
+    ] , ;
+
+: init-span-tag [ drop init-span ] , ;
+
+: init-eol-span-tag [ drop init-eol-span ] , ;
+
+: parse-keyword-tag ( tag keyword-map -- )
+    >r dup name-tag string>token swap children>string r> set-at ;
diff --git a/extra/xmode/tokens/tokens.factor b/extra/xmode/tokens/tokens.factor
index 14a48582ec..e1fa2dd04f 100644
--- a/extra/xmode/tokens/tokens.factor
+++ b/extra/xmode/tokens/tokens.factor
@@ -1,20 +1,18 @@
-USING: parser words sequences namespaces kernel assocs ;
+USING: parser words sequences namespaces kernel assocs
+compiler.units ;
 IN: xmode.tokens
 
 ! Based on org.gjt.sp.jedit.syntax.Token
 SYMBOL: tokens
 
-: string>token ( string -- id ) tokens get at ;
-
-: TOKENS:
-    ";" parse-tokens [
+[
+    { "COMMENT1" "COMMENT2" "COMMENT3" "COMMENT4" "DIGIT" "FUNCTION" "INVALID" "KEYWORD1" "KEYWORD2" "KEYWORD3" "KEYWORD4" "LABEL" "LITERAL1" "LITERAL2" "LITERAL3" "LITERAL4" "MARKUP" "OPERATOR" "END" "NULL" } [
         create-in dup define-symbol
         dup word-name swap
-    ] H{ } map>assoc tokens set-global ; parsing
+    ] H{ } map>assoc tokens set-global
+] with-compilation-unit
 
-TOKENS: COMMENT1 COMMENT2 COMMENT3 COMMENT4 DIGIT FUNCTION
-INVALID KEYWORD1 KEYWORD2 KEYWORD3 KEYWORD4 LABEL LITERAL1
-LITERAL2 LITERAL3 LITERAL4 MARKUP OPERATOR END NULL ;
+: string>token ( string -- id ) tokens get at ;
 
 TUPLE: token str id ;
 
diff --git a/extra/xmode/utilities/utilities.factor b/extra/xmode/utilities/utilities.factor
index d4096b17e0..f7c8606420 100644
--- a/extra/xmode/utilities/utilities.factor
+++ b/extra/xmode/utilities/utilities.factor
@@ -55,4 +55,4 @@ SYMBOL: tag-handler-word
 : TAGS>
     tag-handler-word get
     tag-handlers get >alist [ >r dup name-tag r> case ] curry
-    define-compound ; parsing
+    define ; parsing
diff --git a/extra/yahoo/yahoo-docs.factor b/extra/yahoo/yahoo-docs.factor
index abc80c4ea6..b5603103e1 100644
--- a/extra/yahoo/yahoo-docs.factor
+++ b/extra/yahoo/yahoo-docs.factor
@@ -1,4 +1,5 @@
-USING: yahoo help.syntax help.markup ;
+USING: help.syntax help.markup ;
+IN: yahoo
 
 HELP: search-yahoo
 { $values { "search" "a string" } { "num" "a positive integer" } { "seq" "sequence of arrays of length 3" } }
diff --git a/misc/factor.el b/misc/factor.el
index 985e10e285..a5ba44357f 100644
--- a/misc/factor.el
+++ b/misc/factor.el
@@ -102,7 +102,7 @@
   (setq font-lock-defaults
 	'(factor-font-lock-keywords nil nil nil nil))
   (set-syntax-table factor-mode-syntax-table)
-  (run-hooks 'factor-mode-hooks))
+  (run-hooks 'factor-mode-hook))
 
 (add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode))
 
diff --git a/vm/code_gc.c b/vm/code_gc.c
index 4c5e3c436f..5c51fe7e8b 100755
--- a/vm/code_gc.c
+++ b/vm/code_gc.c
@@ -245,17 +245,13 @@ void iterate_code_heap(CODE_HEAP_ITERATOR iter)
 
 /* Copy all literals referenced from a code block to newspace */
 void collect_literals_step(F_COMPILED *compiled, CELL code_start,
-	CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end)
+	CELL reloc_start, CELL literals_start)
 {
 	CELL scan;
-
 	CELL literal_end = literals_start + compiled->literals_length;
 
 	for(scan = literals_start; scan < literal_end; scan += CELLS)
 		copy_handle((CELL*)scan);
-
-	for(scan = words_start; scan < words_end; scan += CELLS)
-		copy_handle((CELL*)scan);
 }
 
 /* Copy literals referenced from all code blocks to newspace */
diff --git a/vm/code_gc.h b/vm/code_gc.h
index b91f16e5b0..4341d8ce64 100644
--- a/vm/code_gc.h
+++ b/vm/code_gc.h
@@ -48,17 +48,15 @@ INLINE F_BLOCK *next_block(F_HEAP *heap, F_BLOCK *block)
 F_HEAP code_heap;
 
 typedef void (*CODE_HEAP_ITERATOR)(F_COMPILED *compiled, CELL code_start,
-	CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end);
+	CELL reloc_start, CELL literals_start);
 
 INLINE void iterate_code_heap_step(F_COMPILED *compiled, CODE_HEAP_ITERATOR iter)
 {
 	CELL code_start = (CELL)(compiled + 1);
 	CELL reloc_start = code_start + compiled->code_length;
 	CELL literals_start = reloc_start + compiled->reloc_length;
-	CELL words_start = literals_start + compiled->literals_length;
-	CELL words_end = words_start + compiled->words_length;
 
-	iter(compiled,code_start,reloc_start,literals_start,words_start,words_end);
+	iter(compiled,code_start,reloc_start,literals_start);
 }
 
 INLINE F_BLOCK *compiled_to_block(F_COMPILED *compiled)
diff --git a/vm/code_heap.c b/vm/code_heap.c
index ddd7efb4a0..5771725f9d 100755
--- a/vm/code_heap.c
+++ b/vm/code_heap.c
@@ -38,7 +38,7 @@ void *get_rel_symbol(F_REL *rel, CELL literals_start)
 
 /* Compute an address to store at a relocation */
 INLINE CELL compute_code_rel(F_REL *rel,
-	CELL code_start, CELL literals_start, CELL words_start)
+	CELL code_start, CELL literals_start)
 {
 	switch(REL_TYPE(rel))
 	{
@@ -48,10 +48,8 @@ INLINE CELL compute_code_rel(F_REL *rel,
 		return (CELL)get_rel_symbol(rel,literals_start);
 	case RT_LITERAL:
 		return CREF(literals_start,REL_ARGUMENT(rel));
-	case RT_DISPATCH:
-		return CREF(words_start,REL_ARGUMENT(rel));
 	case RT_XT:
-		return (CELL)untag_word(get(CREF(words_start,REL_ARGUMENT(rel))))->xt;
+		return (CELL)untag_word(get(CREF(literals_start,REL_ARGUMENT(rel))))->xt;
 	case RT_HERE:
 		return rel->offset + code_start;
 	case RT_LABEL:
@@ -127,7 +125,7 @@ void apply_relocation(CELL class, CELL offset, F_FIXNUM absolute_value)
 
 /* Perform all fixups on a code block */
 void relocate_code_block(F_COMPILED *relocating, CELL code_start,
-	CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end)
+	CELL reloc_start, CELL literals_start)
 {
 	if(reloc_start != literals_start)
 	{
@@ -138,8 +136,8 @@ void relocate_code_block(F_COMPILED *relocating, CELL code_start,
 		{
 			CELL offset = rel->offset + code_start;
 
-			F_FIXNUM absolute_value = compute_code_rel(rel,
-				code_start,literals_start,words_start);
+			F_FIXNUM absolute_value = compute_code_rel(
+				rel,code_start,literals_start);
 
 			apply_relocation(REL_CLASS(rel),offset,absolute_value);
 
@@ -228,27 +226,23 @@ F_COMPILED *add_compiled_block(
 	F_ARRAY *code,
 	F_ARRAY *labels,
 	F_ARRAY *relocation,
-	F_ARRAY *words,
 	F_ARRAY *literals)
 {
 	CELL code_format = compiled_code_format();
 
 	CELL code_length = align8(array_capacity(code) * code_format);
 	CELL rel_length = array_capacity(relocation) * sizeof(unsigned int);
-	CELL words_length = (words ? array_capacity(words) * CELLS : 0);
 	CELL literals_length = array_capacity(literals) * CELLS;
 
 	REGISTER_UNTAGGED(code);
 	REGISTER_UNTAGGED(labels);
 	REGISTER_UNTAGGED(relocation);
-	REGISTER_UNTAGGED(words);
 	REGISTER_UNTAGGED(literals);
 
 	CELL here = allot_code_block(sizeof(F_COMPILED) + code_length
-		+ rel_length + literals_length + words_length);
+		+ rel_length + literals_length);
 
 	UNREGISTER_UNTAGGED(literals);
-	UNREGISTER_UNTAGGED(words);
 	UNREGISTER_UNTAGGED(relocation);
 	UNREGISTER_UNTAGGED(labels);
 	UNREGISTER_UNTAGGED(code);
@@ -259,7 +253,6 @@ F_COMPILED *add_compiled_block(
 	header->code_length = code_length;
 	header->reloc_length = rel_length;
 	header->literals_length = literals_length;
-	header->words_length = words_length;
 
 	here += sizeof(F_COMPILED);
 
@@ -277,13 +270,6 @@ F_COMPILED *add_compiled_block(
 	deposit_objects(here,literals);
 	here += literals_length;
 
-	/* words */
-	if(words)
-	{
-		deposit_objects(here,words);
-		here += words_length;
-	}
-
 	/* fixup labels */
 	if(labels)
 		fixup_labels(labels,code_format,code_start);
@@ -347,10 +333,9 @@ DEFINE_PRIMITIVE(modify_code_heap)
 			F_ARRAY *compiled_code = untag_array(data);
 
 			F_ARRAY *literals = untag_array(array_nth(compiled_code,0));
-			F_ARRAY *words = untag_array(array_nth(compiled_code,1));
-			F_ARRAY *relocation = untag_array(array_nth(compiled_code,2));
-			F_ARRAY *labels = untag_array(array_nth(compiled_code,3));
-			F_ARRAY *code = untag_array(array_nth(compiled_code,4));
+			F_ARRAY *relocation = untag_array(array_nth(compiled_code,1));
+			F_ARRAY *labels = untag_array(array_nth(compiled_code,2));
+			F_ARRAY *code = untag_array(array_nth(compiled_code,3));
 
 			REGISTER_UNTAGGED(alist);
 			REGISTER_UNTAGGED(word);
@@ -360,7 +345,6 @@ DEFINE_PRIMITIVE(modify_code_heap)
 				code,
 				labels,
 				relocation,
-				words,
 				literals);
 
 			UNREGISTER_UNTAGGED(word);
diff --git a/vm/code_heap.h b/vm/code_heap.h
index d5b361e693..4e65313d3b 100755
--- a/vm/code_heap.h
+++ b/vm/code_heap.h
@@ -54,7 +54,7 @@ typedef struct {
 } F_REL;
 
 void relocate_code_block(F_COMPILED *relocating, CELL code_start,
-	CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end);
+	CELL reloc_start, CELL literals_start);
 
 void default_word_code(F_WORD *word, bool relocate);
 
@@ -65,7 +65,6 @@ F_COMPILED *add_compiled_block(
 	F_ARRAY *code,
 	F_ARRAY *labels,
 	F_ARRAY *rel,
-	F_ARRAY *words,
 	F_ARRAY *literals);
 
 CELL compiled_code_format(void);
diff --git a/vm/image.c b/vm/image.c
index 0f80303749..3d3c352093 100755
--- a/vm/image.c
+++ b/vm/image.c
@@ -179,7 +179,7 @@ void fixup_word(F_WORD *word)
 	{
 		code_fixup((CELL)&word->code);
 		if(word->profiling) code_fixup((CELL)&word->profiling);
-		update_word_xt(word);
+		code_fixup((CELL)&word->xt);
 	}
 }
 
@@ -262,7 +262,7 @@ void relocate_data()
 }
 
 void fixup_code_block(F_COMPILED *relocating, CELL code_start,
-	CELL reloc_start, CELL literals_start, CELL words_start, CELL words_end)
+	CELL reloc_start, CELL literals_start)
 {
 	/* relocate literal table data */
 	CELL scan;
@@ -271,14 +271,8 @@ void fixup_code_block(F_COMPILED *relocating, CELL code_start,
 	for(scan = literals_start; scan < literal_end; scan += CELLS)
 		data_fixup((CELL*)scan);
 
-	for(scan = words_start; scan < words_end; scan += CELLS)
-		data_fixup((CELL*)scan);
-
 	if(reloc_start != literals_start)
-	{
-		relocate_code_block(relocating,code_start,reloc_start,
-			literals_start,words_start,words_end);
-	}
+		relocate_code_block(relocating,code_start,reloc_start,literals_start);
 }
 
 void relocate_code()
diff --git a/vm/layouts.h b/vm/layouts.h
index 7c6d775209..302a4497b4 100755
--- a/vm/layouts.h
+++ b/vm/layouts.h
@@ -151,8 +151,6 @@ typedef struct
 	CELL code_length; /* # bytes */
 	CELL reloc_length; /* # bytes */
 	CELL literals_length; /* # bytes */
-	CELL words_length; /* # bytes */
-	CELL padding[3];
 } F_COMPILED;
 
 /* Assembly code makes assumptions about the layout of this struct */
diff --git a/vm/profiler.c b/vm/profiler.c
index f9dbda860a..72c9046eab 100755
--- a/vm/profiler.c
+++ b/vm/profiler.c
@@ -25,7 +25,6 @@ F_COMPILED *compile_profiling_stub(F_WORD *word)
 		untag_object(code),
 		NULL, /* no labels */
 		untag_object(relocation),
-		NULL, /* no words */
 		untag_object(literals));
 }
 
diff --git a/vm/quotations.c b/vm/quotations.c
index 1e3fa8a47a..536d5d7d5a 100755
--- a/vm/quotations.c
+++ b/vm/quotations.c
@@ -116,9 +116,6 @@ void jit_compile(CELL quot, bool relocate)
 	GROWABLE_ARRAY(literals);
 	REGISTER_ROOT(literals);
 
-	GROWABLE_ARRAY(words);
-	REGISTER_ROOT(words);
-
 	GROWABLE_ADD(literals,stack_traces_p() ? quot : F);
 
 	bool stack_frame = jit_stack_frame_p(untag_object(array));
@@ -144,19 +141,19 @@ void jit_compile(CELL quot, bool relocate)
 			current stack frame. */
 			word = untag_object(obj);
 
-			GROWABLE_ADD(words,array_nth(untag_object(array),i));
+			GROWABLE_ADD(literals,array_nth(untag_object(array),i));
 
 			if(i == length - 1)
 			{
 				if(stack_frame)
 					EMIT(JIT_EPILOG,0);
 
-				EMIT(JIT_WORD_JUMP,words_count - 1);
+				EMIT(JIT_WORD_JUMP,literals_count - 1);
 
 				tail_call = true;
 			}
 			else
-				EMIT(JIT_WORD_CALL,words_count - 1);
+				EMIT(JIT_WORD_CALL,literals_count - 1);
 			break;
 		case WRAPPER_TYPE:
 			wrapper = untag_object(obj);
@@ -220,14 +217,12 @@ void jit_compile(CELL quot, bool relocate)
 	GROWABLE_TRIM(code);
 	GROWABLE_TRIM(relocation);
 	GROWABLE_TRIM(literals);
-	GROWABLE_TRIM(words);
 
 	F_COMPILED *compiled = add_compiled_block(
 		QUOTATION_TYPE,
 		untag_object(code),
 		NULL,
 		untag_object(relocation),
-		untag_object(words),
 		untag_object(literals));
 
 	set_quot_xt(untag_object(quot),compiled);
@@ -235,7 +230,6 @@ void jit_compile(CELL quot, bool relocate)
 	if(relocate)
 		iterate_code_heap_step(compiled,relocate_code_block);
 
-	UNREGISTER_ROOT(words);
 	UNREGISTER_ROOT(literals);
 	UNREGISTER_ROOT(relocation);
 	UNREGISTER_ROOT(code);