diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 6149e83893..3ce783d620 100755
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -607,7 +607,7 @@ tuple
     { "(exists?)" "io.files.private" }
     { "(directory)" "io.files.private" }
     { "gc" "memory" }
-    { "gc-time" "memory" }
+    { "gc-stats" "memory" }
     { "save-image" "memory" }
     { "save-image-and-exit" "memory" }
     { "datastack" "kernel" }
@@ -702,6 +702,7 @@ tuple
     { "resize-float-array" "float-arrays" }
     { "dll-valid?" "alien" }
     { "unimplemented" "kernel.private" }
+    { "gc-reset" "memory" }
 }
 dup length [ >r first2 r> make-primitive ] 2each
 
diff --git a/core/compiler/constants/constants.factor b/core/compiler/constants/constants.factor
index 11f64c9373..9594cf7b23 100755
--- a/core/compiler/constants/constants.factor
+++ b/core/compiler/constants/constants.factor
@@ -5,6 +5,7 @@ IN: compiler.constants
 
 ! These constants must match vm/memory.h
 : card-bits 6 ;
+: deck-bits 12 ;
 : card-mark HEX: 40 HEX: 80 bitor ;
 
 ! These constants must match vm/layouts.h
diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor
index 34e9900893..95af9e4b4b 100755
--- a/core/cpu/ppc/intrinsics/intrinsics.factor
+++ b/core/cpu/ppc/intrinsics/intrinsics.factor
@@ -56,14 +56,25 @@ IN: cpu.ppc.intrinsics
 : load-cards-offset ( dest -- )
     "cards_offset" f pick %load-dlsym  dup 0 LWZ ;
 
+: load-decks-offset ( dest -- )
+    "decks_offset" f pick %load-dlsym  dup 0 LWZ ;
+
 : %write-barrier ( -- )
     "val" get operand-immediate? "obj" get fresh-object? or [
+        ! Mark the card
         "obj" operand "scratch" operand card-bits SRWI
         "val" operand load-cards-offset
         "scratch" operand dup "val" operand ADD
         "val" operand "scratch" operand 0 LBZ
         "val" operand dup card-mark ORI
         "val" operand "scratch" operand 0 STB
+
+        ! Mark the card deck
+        "obj" operand "scratch" operand deck-bits SRWI
+        "val" operand load-decks-offset
+        "scratch" operand dup "val" operand ADD
+        card-mark "val" operand LI
+        "val" operand "scratch" operand 0 STB
     ] unless ;
 
 \ set-slot {
diff --git a/core/cpu/x86/assembler/assembler-tests.factor b/core/cpu/x86/assembler/assembler-tests.factor
index caa00bd618..4c0f04fcc2 100644
--- a/core/cpu/x86/assembler/assembler-tests.factor
+++ b/core/cpu/x86/assembler/assembler-tests.factor
@@ -36,3 +36,6 @@ IN: cpu.x86.assembler.tests
 
 [ { HEX: 0f HEX: be HEX: c3 } ] [ [ EAX BL MOVSX ] { } make ] unit-test
 [ { HEX: 0f HEX: bf HEX: c3 } ] [ [ EAX BX MOVSX ] { } make ] unit-test
+
+[ { HEX: 80 HEX: 08 HEX: 05 } ] [ [ EAX [] 5 <byte> OR ] { } make ] unit-test
+[ { HEX: c6 HEX: 00 HEX: 05 } ] [ [ EAX [] 5 <byte> MOV ] { } make ] unit-test
diff --git a/core/cpu/x86/assembler/assembler.factor b/core/cpu/x86/assembler/assembler.factor
index cabd81dad6..bc6a12d167 100755
--- a/core/cpu/x86/assembler/assembler.factor
+++ b/core/cpu/x86/assembler/assembler.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generator.fixup io.binary kernel
 combinators kernel.private math namespaces parser sequences
-words system layouts math.order ;
+words system layouts math.order accessors ;
 IN: cpu.x86.assembler
 
 ! A postfix assembler for x86 and AMD64.
@@ -11,11 +11,6 @@ IN: cpu.x86.assembler
 ! In 64-bit mode, { 1234 } is RIP-relative.
 ! Beware!
 
-: n, >le % ; inline
-: 4, 4 n, ; inline
-: 2, 2 n, ; inline
-: cell, bootstrap-cell n, ; inline
-
 ! Register operands -- eg, ECX
 <<
 
@@ -45,6 +40,10 @@ REGISTERS: 128
 XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ;
 
+TUPLE: byte value ;
+
+C: <byte> byte
+
 <PRIVATE
 
 #! Extended AMD64 registers (R8-R15) return true.
@@ -75,50 +74,38 @@ M: register extended? "register" word-prop 7 > ;
 ! Addressing modes
 TUPLE: indirect base index scale displacement ;
 
-M: indirect extended? indirect-base extended? ;
+M: indirect extended? base>> extended? ;
 
 : canonicalize-EBP
     #! { EBP } ==> { EBP 0 }
-    dup indirect-base { EBP RBP R13 } memq? [
-        dup indirect-displacement [
-            drop
-        ] [
-            0 swap set-indirect-displacement
-        ] if
-    ] [
-        drop
-    ] if ;
+    dup base>> { EBP RBP R13 } member? [
+        dup displacement>> [ 0 >>displacement ] unless
+    ] when drop ;
 
 : canonicalize-ESP
     #! { ESP } ==> { ESP ESP }
-    dup indirect-base { ESP RSP R12 } memq? [
-        ESP swap set-indirect-index
-    ] [
-        drop
-    ] if ;
+    dup base>> { ESP RSP R12 } member? [ ESP >>index ] when drop ;
 
 : canonicalize ( indirect -- )
     #! Modify the indirect to work around certain addressing mode
     #! quirks.
-    dup canonicalize-EBP
-    canonicalize-ESP ;
+    [ canonicalize-EBP ] [ canonicalize-ESP ] bi ;
 
 : <indirect> ( base index scale displacement -- indirect )
     indirect boa dup canonicalize ;
 
 : reg-code "register" word-prop 7 bitand ;
 
-: indirect-base* indirect-base EBP or reg-code ;
+: indirect-base* base>> EBP or reg-code ;
 
-: indirect-index* indirect-index ESP or reg-code ;
+: indirect-index* index>> ESP or reg-code ;
 
-: indirect-scale* indirect-scale 0 or ;
+: indirect-scale* scale>> 0 or ;
 
 GENERIC: sib-present? ( op -- ? )
 
 M: indirect sib-present?
-    dup indirect-base { ESP RSP } memq?
-    over indirect-index rot indirect-scale or or ;
+    [ base>> { ESP RSP } member? ] [ index>> ] [ scale>> ] tri or or ;
 
 M: register sib-present? drop f ;
 
@@ -130,16 +117,23 @@ M: indirect r/m
 
 M: register r/m reg-code ;
 
-: byte? -128 127 between? ;
+! Immediate operands
+UNION: immediate byte integer ;
+
+GENERIC: fits-in-byte? ( value -- ? )
+
+M: byte fits-in-byte? drop t ;
+
+M: integer fits-in-byte? -128 127 between? ;
 
 GENERIC: modifier ( op -- n )
 
 M: indirect modifier
-    dup indirect-base [
-        indirect-displacement {
-            { [ dup not ]      [ BIN: 00 ] }
-            { [ dup byte? ]    [ BIN: 01 ] }
-            { [ dup integer? ] [ BIN: 10 ] }
+    dup base>> [
+        displacement>> {
+            { [ dup not ] [ BIN: 00 ] }
+            { [ dup fits-in-byte? ] [ BIN: 01 ] }
+            { [ dup immediate? ] [ BIN: 10 ] }
         } cond nip
     ] [
         drop BIN: 00
@@ -147,14 +141,23 @@ M: indirect modifier
 
 M: register modifier drop BIN: 11 ;
 
+GENERIC# n, 1 ( value n -- )
+
+M: integer n, >le % ;
+M: byte n, >r value>> r> n, ;
+: 1, 1 n, ; inline
+: 4, 4 n, ; inline
+: 2, 2 n, ; inline
+: cell, bootstrap-cell n, ; inline
+
 : mod-r/m, ( reg# indirect -- )
-    dup modifier 6 shift rot 3 shift rot r/m bitor bitor , ;
+    [ 3 shift ] [ [ modifier 6 shift ] [ r/m ] bi ] bi* bitor bitor , ;
 
 : sib, ( indirect -- )
     dup sib-present? [
-        dup indirect-base*
-        over indirect-index* 3 shift bitor
-        swap indirect-scale* 6 shift bitor ,
+        [ indirect-base* ]
+        [ indirect-index* 3 shift ]
+        [ indirect-scale* 6 shift ] tri bitor bitor ,
     ] [
         drop
     ] if ;
@@ -162,9 +165,9 @@ M: register modifier drop BIN: 11 ;
 GENERIC: displacement, ( op -- )
 
 M: indirect displacement,
-    dup indirect-displacement dup [
-        swap indirect-base
-        [ dup byte? [ , ] [ 4, ] if ] [ 4, ] if
+    dup displacement>> dup [
+        swap base>>
+        [ dup fits-in-byte? [ , ] [ 4, ] if ] [ 4, ] if
     ] [
         2drop
     ] if ;
@@ -172,18 +175,19 @@ M: indirect displacement,
 M: register displacement, drop ;
 
 : addressing ( reg# indirect -- )
-    [ mod-r/m, ] keep [ sib, ] keep displacement, ;
+    [ mod-r/m, ] [ sib, ] [ displacement, ] tri ;
 
 ! Utilities
 UNION: operand register indirect ;
 
-: operand-64? ( operand -- ? )
-    dup indirect? [
-        dup indirect-base register-64?
-        swap indirect-index register-64? or
-    ] [
-        register-64?
-    ] if ;
+GENERIC: operand-64? ( operand -- ? )
+
+M: indirect operand-64?
+    [ base>> ] [ index>> ] bi [ operand-64? ] either? ;
+
+M: register-64 operand-64? drop t ;
+
+M: object operand-64? drop f ;
 
 : rex.w? ( rex.w reg r/m -- ? )
     {
@@ -198,8 +202,7 @@ UNION: operand register indirect ;
 : rex.b
     [ extended? [ BIN: 00000001 bitor ] when ] keep
     dup indirect? [
-        indirect-index extended?
-        [ BIN: 00000010 bitor ] when
+        index>> extended? [ BIN: 00000010 bitor ] when
     ] [
         drop
     ] if ;
@@ -230,25 +233,34 @@ UNION: operand register indirect ;
 
 : opcode-or ( opcode mask -- opcode' )
     swap dup array?
-    [ 1 cut* first rot bitor suffix ] [ bitor ] if ;
+    [ unclip-last rot bitor suffix ] [ bitor ] if ;
 
-: 1-operand ( op reg rex.w opcode -- )
+: 1-operand ( op reg,rex.w,opcode -- )
     #! The 'reg' is not really a register, but a value for the
     #! 'reg' field of the mod-r/m byte.
-    >r >r over r> prefix-1 r> opcode, swap addressing ;
+    first3 >r >r over r> prefix-1 r> opcode, swap addressing ;
 
-: immediate-1 ( imm dst reg rex.w opcode -- )
-    1-operand , ;
+: immediate-operand-size-bit
+    pick integer? [ first3 BIN: 1 opcode-or 3array ] when ;
 
-: immediate-1/4 ( imm dst reg rex.w opcode -- )
+: immediate-1 ( imm dst reg,rex.w,opcode -- )
+    immediate-operand-size-bit 1-operand 1, ;
+
+: immediate-4 ( imm dst reg,rex.w,opcode -- )
+    immediate-operand-size-bit 1-operand 4, ;
+
+: immediate-fits-in-size-bit
+    pick integer? [ first3 BIN: 10 opcode-or 3array ] when ;
+
+: immediate-1/4 ( imm dst reg,rex.w,opcode -- )
     #! If imm is a byte, compile the opcode and the byte.
-    #! Otherwise, set the 32-bit operand flag in the opcode, and
+    #! Otherwise, set the 8-bit operand flag in the opcode, and
     #! compile the cell. The 'reg' is not really a register, but
     #! a value for the 'reg' field of the mod-r/m byte.
-    >r >r pick byte? [
-        r> r> BIN: 10 opcode-or immediate-1
+    pick fits-in-byte? [
+        immediate-fits-in-size-bit immediate-1
     ] [
-        r> r> 1-operand 4,
+        immediate-4
     ] if ;
 
 : (2-operand) ( dst src op -- )
@@ -283,22 +295,24 @@ PRIVATE>
 ! Moving stuff
 GENERIC: PUSH ( op -- )
 M: register PUSH f HEX: 50 short-operand ;
-M: integer PUSH HEX: 68 , 4, ;
-M: operand PUSH BIN: 110 f HEX: ff 1-operand ;
+M: immediate PUSH HEX: 68 , 4, ;
+M: operand PUSH { BIN: 110 f HEX: ff } 1-operand ;
 
 GENERIC: POP ( op -- )
 M: register POP f HEX: 58 short-operand ;
-M: operand POP BIN: 000 f HEX: 8f 1-operand ;
+M: operand POP { BIN: 000 f HEX: 8f } 1-operand ;
 
 ! MOV where the src is immediate.
 GENERIC: (MOV-I) ( src dst -- )
 M: register (MOV-I) t HEX: b8 short-operand cell, ;
-M: operand (MOV-I) BIN: 000 t HEX: c7 1-operand 4, ;
+M: operand (MOV-I)
+    { BIN: 000 t HEX: c6 }
+    pick byte? [ immediate-1 ] [ immediate-4 ] if ;
 
 PREDICATE: callable < word register? not ;
 
 GENERIC: MOV ( dst src -- )
-M: integer MOV swap (MOV-I) ;
+M: immediate MOV swap (MOV-I) ;
 M: callable MOV 0 rot (MOV-I) rc-absolute-cell rel-word ;
 M: operand MOV HEX: 88 2-operand ;
 
@@ -309,13 +323,13 @@ GENERIC: JMP ( op -- )
 : (JMP) HEX: e9 , 0 4, rc-relative ;
 M: callable JMP (JMP) rel-word ;
 M: label JMP (JMP) label-fixup ;
-M: operand JMP BIN: 100 t HEX: ff 1-operand ;
+M: operand JMP { BIN: 100 t HEX: ff } 1-operand ;
 
 GENERIC: CALL ( op -- )
 : (CALL) HEX: e8 , 0 4, rc-relative ;
 M: callable CALL (CALL) rel-word ;
 M: label CALL (CALL) label-fixup ;
-M: operand CALL BIN: 010 t HEX: ff 1-operand ;
+M: operand CALL { BIN: 010 t HEX: ff } 1-operand ;
 
 GENERIC# JUMPcc 1 ( addr opcode -- )
 : (JUMPcc) extended-opcode, 0 4, rc-relative ;
@@ -347,57 +361,57 @@ M: label JUMPcc (JUMPcc) label-fixup ;
 ! Arithmetic
 
 GENERIC: ADD ( dst src -- )
-M: integer ADD swap BIN: 000 t HEX: 81 immediate-1/4 ;
+M: immediate ADD swap { BIN: 000 t HEX: 80 } immediate-1/4 ;
 M: operand ADD OCT: 000 2-operand ;
 
 GENERIC: OR ( dst src -- )
-M: integer OR swap BIN: 001 t HEX: 81 immediate-1/4 ;
+M: immediate OR swap { BIN: 001 t HEX: 80 } immediate-1/4 ;
 M: operand OR OCT: 010 2-operand ;
 
 GENERIC: ADC ( dst src -- )
-M: integer ADC swap BIN: 010 t HEX: 81 immediate-1/4 ;
+M: immediate ADC swap { BIN: 010 t HEX: 80 } immediate-1/4 ;
 M: operand ADC OCT: 020 2-operand ;
 
 GENERIC: SBB ( dst src -- )
-M: integer SBB swap BIN: 011 t HEX: 81 immediate-1/4 ;
+M: immediate SBB swap { BIN: 011 t HEX: 80 } immediate-1/4 ;
 M: operand SBB OCT: 030 2-operand ;
 
 GENERIC: AND ( dst src -- )
-M: integer AND swap BIN: 100 t HEX: 81 immediate-1/4 ;
+M: immediate AND swap { BIN: 100 t HEX: 80 } immediate-1/4 ;
 M: operand AND OCT: 040 2-operand ;
 
 GENERIC: SUB ( dst src -- )
-M: integer SUB swap BIN: 101 t HEX: 81 immediate-1/4 ;
+M: immediate SUB swap { BIN: 101 t HEX: 80 } immediate-1/4 ;
 M: operand SUB OCT: 050 2-operand ;
 
 GENERIC: XOR ( dst src -- )
-M: integer XOR swap BIN: 110 t HEX: 81 immediate-1/4 ;
+M: immediate XOR swap { BIN: 110 t HEX: 80 } immediate-1/4 ;
 M: operand XOR OCT: 060 2-operand ;
 
 GENERIC: CMP ( dst src -- )
-M: integer CMP swap BIN: 111 t HEX: 81 immediate-1/4 ;
+M: immediate CMP swap { BIN: 111 t HEX: 80 } immediate-1/4 ;
 M: operand CMP OCT: 070 2-operand ;
 
-: NOT  ( dst -- ) BIN: 010 t HEX: f7 1-operand ;
-: NEG  ( dst -- ) BIN: 011 t HEX: f7 1-operand ;
-: MUL  ( dst -- ) BIN: 100 t HEX: f7 1-operand ;
-: IMUL ( src -- ) BIN: 101 t HEX: f7 1-operand ;
-: DIV  ( dst -- ) BIN: 110 t HEX: f7 1-operand ;
-: IDIV ( src -- ) BIN: 111 t HEX: f7 1-operand ;
+: NOT  ( dst -- ) { BIN: 010 t HEX: f7 } 1-operand ;
+: NEG  ( dst -- ) { BIN: 011 t HEX: f7 } 1-operand ;
+: MUL  ( dst -- ) { BIN: 100 t HEX: f7 } 1-operand ;
+: IMUL ( src -- ) { BIN: 101 t HEX: f7 } 1-operand ;
+: DIV  ( dst -- ) { BIN: 110 t HEX: f7 } 1-operand ;
+: IDIV ( src -- ) { BIN: 111 t HEX: f7 } 1-operand ;
 
 : CDQ HEX: 99 , ;
 : CQO HEX: 48 , CDQ ;
 
-: ROL ( dst n -- ) swap BIN: 000 t HEX: c1 immediate-1 ;
-: ROR ( dst n -- ) swap BIN: 001 t HEX: c1 immediate-1 ;
-: RCL ( dst n -- ) swap BIN: 010 t HEX: c1 immediate-1 ;
-: RCR ( dst n -- ) swap BIN: 011 t HEX: c1 immediate-1 ;
-: SHL ( dst n -- ) swap BIN: 100 t HEX: c1 immediate-1 ;
-: SHR ( dst n -- ) swap BIN: 101 t HEX: c1 immediate-1 ;
-: SAR ( dst n -- ) swap BIN: 111 t HEX: c1 immediate-1 ;
+: ROL ( dst n -- ) swap { BIN: 000 t HEX: c0 } immediate-1 ;
+: ROR ( dst n -- ) swap { BIN: 001 t HEX: c0 } immediate-1 ;
+: RCL ( dst n -- ) swap { BIN: 010 t HEX: c0 } immediate-1 ;
+: RCR ( dst n -- ) swap { BIN: 011 t HEX: c0 } immediate-1 ;
+: SHL ( dst n -- ) swap { BIN: 100 t HEX: c0 } immediate-1 ;
+: SHR ( dst n -- ) swap { BIN: 101 t HEX: c0 } immediate-1 ;
+: SAR ( dst n -- ) swap { BIN: 111 t HEX: c0 } immediate-1 ;
 
 GENERIC: IMUL2 ( dst src -- )
-M: integer IMUL2 swap dup reg-code t HEX: 69 immediate-1/4 ;
+M: immediate IMUL2 swap dup reg-code t HEX: 68 3array immediate-1/4 ;
 M: operand IMUL2 OCT: 257 extended-opcode (2-operand) ;
 
 : MOVSX ( dst src -- )
@@ -432,11 +446,11 @@ M: operand IMUL2 OCT: 257 extended-opcode (2-operand) ;
 
 ! x87 Floating Point Unit
 
-: FSTPS ( operand -- ) BIN: 011 f HEX: d9 1-operand ;
-: FSTPL ( operand -- ) BIN: 011 f HEX: dd 1-operand ;
+: FSTPS ( operand -- ) { BIN: 011 f HEX: d9 } 1-operand ;
+: FSTPL ( operand -- ) { BIN: 011 f HEX: dd } 1-operand ;
 
-: FLDS ( operand -- ) BIN: 000 f HEX: d9 1-operand ;
-: FLDL ( operand -- ) BIN: 000 f HEX: dd 1-operand ;
+: FLDS ( operand -- ) { BIN: 000 f HEX: d9 } 1-operand ;
+: FLDL ( operand -- ) { BIN: 000 f HEX: dd } 1-operand ;
 
 ! SSE multimedia instructions
 
diff --git a/core/cpu/x86/intrinsics/intrinsics.factor b/core/cpu/x86/intrinsics/intrinsics.factor
index c48f33b765..db303982ba 100755
--- a/core/cpu/x86/intrinsics/intrinsics.factor
+++ b/core/cpu/x86/intrinsics/intrinsics.factor
@@ -63,9 +63,15 @@ IN: cpu.x86.intrinsics
 : generate-write-barrier ( -- )
     #! Mark the card pointed to by vreg.
     "val" get operand-immediate? "obj" get fresh-object? or [
+        ! Mark the card
         "obj" operand card-bits SHR
         "cards_offset" f temp-reg v>operand %alien-global
-        temp-reg v>operand "obj" operand [+] card-mark OR
+        temp-reg v>operand "obj" operand [+] card-mark <byte> OR
+
+        ! Mark the card deck
+        "obj" operand deck-bits card-bits - SHR
+        "decks_offset" f temp-reg v>operand %alien-global
+        temp-reg v>operand "obj" operand [+] card-mark <byte> MOV
     ] unless ;
 
 \ set-slot {
diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor
index b68c98d25d..ff5fc478ca 100755
--- a/core/inference/known-words/known-words.factor
+++ b/core/inference/known-words/known-words.factor
@@ -362,7 +362,7 @@ M: object infer-call
 
 \ gc { } { } <effect> set-primitive-effect
 
-\ gc-time { } { integer } <effect> set-primitive-effect
+\ gc-stats { } { array } <effect> set-primitive-effect
 
 \ save-image { string } { } <effect> set-primitive-effect
 
@@ -372,7 +372,7 @@ M: object infer-call
 t over set-effect-terminated?
 set-primitive-effect
 
-\ data-room { } { integer array } <effect> set-primitive-effect
+\ data-room { } { integer integer array } <effect> set-primitive-effect
 \ data-room make-flushable
 
 \ code-room { } { integer integer integer integer } <effect> set-primitive-effect
diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor
index dd550070a4..ec74bb001e 100755
--- a/core/io/files/files-docs.factor
+++ b/core/io/files/files-docs.factor
@@ -273,11 +273,11 @@ $nl
 
 HELP: append-path
 { $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } }
-{ $description "Concatenates two pathnames." } ;
+{ $description "Appends " { $snippet "str1" } " and " { $snippet "str2" } " to form a pathname." } ;
 
 HELP: prepend-path
 { $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } }
-{ $description "Appends str1 onto str2 to form a pathname." } ;
+{ $description "Appends " { $snippet "str2" } " and " { $snippet "str1" } " to form a pathname." } ;
 
 { append-path prepend-path } related-words
 
diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor
index ddea4da556..2d74dfabd5 100755
--- a/core/io/io-docs.factor
+++ b/core/io/io-docs.factor
@@ -125,7 +125,7 @@ $nl
 ABOUT: "streams"
 
 HELP: stream-readln
-{ $values { "stream" "an input stream" } { "str" string } }
+{ $values { "stream" "an input stream" } { "str/f" "a string or " { $link f } } }
 { $contract "Reads a line of input from the stream. Outputs " { $link f } " on stream exhaustion." }
 { $notes "Most code only works on one stream at a time and should instead use " { $link readln } "; see " { $link "stdio" } "." }
 $io-error ;
@@ -139,7 +139,7 @@ $io-error ;
 HELP: stream-read
 { $values { "n" "a non-negative integer" } { "stream" "an input stream" } { "str/f" "a string or " { $link f } } }
 { $contract "Reads " { $snippet "n" } " characters of input from the stream. Outputs a truncated string or " { $link f } " on stream exhaustion." }
-{ $notes "Most code only works on one stream at a time and should instead use " { $link read1 } "; see " { $link "stdio" } "." }
+{ $notes "Most code only works on one stream at a time and should instead use " { $link read } "; see " { $link "stdio" } "." }
 $io-error ;
 
 HELP: stream-read-until
diff --git a/core/io/io.factor b/core/io/io.factor
index e28fd28fb3..6bad8331db 100755
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -4,7 +4,7 @@ USING: hashtables generic kernel math namespaces sequences
 continuations assocs io.styles ;
 IN: io
 
-GENERIC: stream-readln ( stream -- str )
+GENERIC: stream-readln ( stream -- str/f )
 GENERIC: stream-read1 ( stream -- ch/f )
 GENERIC: stream-read ( n stream -- str/f )
 GENERIC: stream-read-until ( seps stream -- str/f sep/f )
diff --git a/core/memory/memory-docs.factor b/core/memory/memory-docs.factor
index 75876a3c8f..38f39ec588 100755
--- a/core/memory/memory-docs.factor
+++ b/core/memory/memory-docs.factor
@@ -40,10 +40,6 @@ HELP: instances
 HELP: gc ( -- )
 { $description "Performs a full garbage collection." } ;
 
-HELP: gc-time ( -- n )
-{ $values { "n" "a timestamp in milliseconds" } }
-{ $description "Outputs the total time spent in garbage collection during this Factor session." } ;
-
 HELP: data-room ( -- cards generations )
 { $values { "cards" "number of bytes reserved for card marking" } { "generations" "array of free/total bytes pairs" } }
 { $description "Queries the runtime for memory usage information." } ;
diff --git a/extra/benchmark/benchmark.factor b/extra/benchmark/benchmark.factor
index a75251331f..c00087fc9f 100755
--- a/extra/benchmark/benchmark.factor
+++ b/extra/benchmark/benchmark.factor
@@ -6,7 +6,7 @@ continuations debugger ;
 IN: benchmark
 
 : run-benchmark ( vocab -- result )
-  [ [ require ] [ [ run ] benchmark nip ] bi ] curry
+  [ [ require ] [ [ run ] benchmark ] bi ] curry
   [ error. f ] recover ;
 
 : run-benchmarks ( -- assoc )
diff --git a/extra/benchmark/binary-trees/binary-trees.factor b/extra/benchmark/binary-trees/binary-trees.factor
index 6e63877989..bd3d460961 100644
--- a/extra/benchmark/binary-trees/binary-trees.factor
+++ b/extra/benchmark/binary-trees/binary-trees.factor
@@ -53,3 +53,5 @@ M: f item-check drop 0 ;
 
 : binary-trees-main ( -- )
     16 binary-trees ;
+
+MAIN: binary-trees-main
diff --git a/extra/cocoa/application/application-docs.factor b/extra/cocoa/application/application-docs.factor
index ad2f8ffbd9..01a79cf35a 100644
--- a/extra/cocoa/application/application-docs.factor
+++ b/extra/cocoa/application/application-docs.factor
@@ -26,7 +26,7 @@ HELP: with-cocoa
 { $values { "quot" quotation } }
 { $description "Sets up an autorelease pool, initializes the " { $snippet "NSApplication" } " singleton, and calls the quotation." } ;
 
-HELP: do-events
+HELP: do-event
 { $values { "app" "an " { $snippet "NSApplication" } } }
 { $description "Processes any pending events in the queue. Does not block." } ;
 
@@ -49,7 +49,7 @@ ARTICLE: "cocoa-application-utils" "Cocoa application utilities"
 { $subsection NSApp }
 { $subsection with-autorelease-pool }
 { $subsection with-cocoa }
-{ $subsection do-events }
+{ $subsection do-event }
 { $subsection add-observer }
 { $subsection remove-observer }
 { $subsection install-delegate } ;
diff --git a/extra/cocoa/application/application.factor b/extra/cocoa/application/application.factor
index 2ae17a1604..90159c1656 100755
--- a/extra/cocoa/application/application.factor
+++ b/extra/cocoa/application/application.factor
@@ -29,9 +29,6 @@ IN: cocoa.application
 : do-event ( app -- ? )
     dup next-event [ -> sendEvent: t ] [ drop f ] if* ;
 
-: do-events ( app -- )
-    dup do-event [ do-events ] [ drop ] if ;
-
 : add-observer ( observer selector name object -- )
     >r >r >r >r NSNotificationCenter -> defaultCenter
     r> r> sel_registerName
diff --git a/extra/jamshred/deploy.factor b/extra/jamshred/deploy.factor
new file mode 100644
index 0000000000..9a18cf1f9b
--- /dev/null
+++ b/extra/jamshred/deploy.factor
@@ -0,0 +1,12 @@
+USING: tools.deploy.config ;
+V{
+    { deploy-ui? t }
+    { deploy-io 1 }
+    { deploy-reflection 1 }
+    { deploy-compiler? t }
+    { deploy-math? t }
+    { deploy-word-props? f }
+    { deploy-c-types? f }
+    { "stop-after-last-window?" t }
+    { deploy-name "Jamshred" }
+}
diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor
index 3842816f0e..dcb82d1de0 100644
--- a/extra/jamshred/game/game.factor
+++ b/extra/jamshred/game/game.factor
@@ -1,26 +1,31 @@
 ! Copyright (C) 2007 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel opengl arrays sequences jamshred.tunnel
-jamshred.player math.vectors ;
+USING: accessors kernel opengl arrays sequences jamshred.log jamshred.player jamshred.sound jamshred.tunnel math.vectors ;
 IN: jamshred.game
 
-TUPLE: jamshred tunnel players running ;
+TUPLE: jamshred sounds tunnel players running quit ;
 
 : <jamshred> ( -- jamshred )
-    <random-tunnel> "Player 1" <player> 2dup swap play-in-tunnel 1array f
-    jamshred boa ;
+    <sounds> <random-tunnel> "Player 1" pick <player>
+    2dup swap play-in-tunnel 1array f f jamshred boa ;
 
 : jamshred-player ( jamshred -- player )
     ! TODO: support more than one player
-    jamshred-players first ;
+    players>> first ;
 
 : jamshred-update ( jamshred -- )
-    dup jamshred-running [
+    dup running>> [
         jamshred-player update-player
     ] [ drop ] if ;
 
 : toggle-running ( jamshred -- )
-    dup jamshred-running not swap set-jamshred-running ;
+    dup running>> [
+        f >>running drop
+    ] [
+        [ jamshred-player moved ]
+        [ t >>running drop ] bi
+    ] if ;
 
 : mouse-moved ( x-radians y-radians jamshred -- )
     jamshred-player -rot turn-player ;
+
diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor
index 42414b9893..3fb7113fde 100755
--- a/extra/jamshred/jamshred.factor
+++ b/extra/jamshred/jamshred.factor
@@ -1,38 +1,48 @@
 ! Copyright (C) 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alarms arrays calendar jamshred.game jamshred.gl kernel math
-math.constants namespaces sequences ui ui.gadgets ui.gestures ui.render
-math.vectors ;
+USING: accessors alarms arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render math.vectors ;
 IN: jamshred
 
 TUPLE: jamshred-gadget jamshred last-hand-loc alarm ;
 
 : <jamshred-gadget> ( jamshred -- gadget )
-    jamshred-gadget construct-gadget tuck set-jamshred-gadget-jamshred ;
+    jamshred-gadget construct-gadget swap >>jamshred ;
 
-: default-width ( -- x ) 1024 ;
-: default-height ( -- y ) 768 ;
+: default-width ( -- x ) 800 ;
+: default-height ( -- y ) 600 ;
 
 M: jamshred-gadget pref-dim*
     drop default-width default-height 2array ;
 
 M: jamshred-gadget draw-gadget* ( gadget -- )
-    dup jamshred-gadget-jamshred swap rect-dim first2 draw-jamshred ;
+    [ jamshred>> ] [ rect-dim first2 draw-jamshred ] bi ;
 
-: tick ( gadget -- )
-    dup jamshred-gadget-jamshred jamshred-update relayout-1 ;
+: jamshred-loop ( gadget -- )
+    dup jamshred>> quit>> [
+        drop
+    ] [
+        dup [ jamshred>> jamshred-update ]
+        [ relayout-1 ] bi
+        yield jamshred-loop
+    ] if ;
+
+: fullscreen ( gadget -- )
+    find-world t swap set-fullscreen* ;
+
+: no-fullscreen ( gadget -- )
+    find-world f swap set-fullscreen* ;
+
+: toggle-fullscreen ( world -- )
+    [ fullscreen? not ] keep set-fullscreen* ;
 
 M: jamshred-gadget graft* ( gadget -- )
-    [
-        [ tick ] curry 10 milliseconds from-now 10 milliseconds add-alarm
-    ] keep set-jamshred-gadget-alarm ;
+    [ jamshred-loop ] in-thread drop ;
 
 M: jamshred-gadget ungraft* ( gadget -- )
-    [ jamshred-gadget-alarm cancel-alarm f ] keep
-    set-jamshred-gadget-alarm ;
+    jamshred>> t swap (>>quit) ;
 
 : jamshred-restart ( jamshred-gadget -- )
-    <jamshred> swap set-jamshred-gadget-jamshred ;
+    <jamshred> >>jamshred drop ;
 
 : pix>radians ( n m -- theta )
     2 / / pi 2 * * ;
@@ -46,22 +56,31 @@ M: jamshred-gadget ungraft* ( gadget -- )
     rect-dim second pix>radians ;
 
 : (handle-mouse-motion) ( jamshred-gadget mouse-motion -- )
-    over jamshred-gadget-jamshred >r
+    over jamshred>> >r
     [ first swap x>radians ] 2keep second swap y>radians
     r> mouse-moved ;
     
 : handle-mouse-motion ( jamshred-gadget -- )
     hand-loc get [
-        over jamshred-gadget-last-hand-loc [
+        over last-hand-loc>> [
             v- (handle-mouse-motion) 
         ] [ 2drop ] if* 
-    ] 2keep swap set-jamshred-gadget-last-hand-loc ;
+    ] 2keep >>last-hand-loc drop ;
+
+: handle-mouse-scroll ( jamshred-gadget -- )
+    jamshred>> jamshred-player scroll-direction get
+    second neg swap change-player-speed ;
+
+: quit ( gadget -- )
+    [ no-fullscreen ] [ close-window ] bi ;
 
-USE: vocabs.loader
 jamshred-gadget H{
     { T{ key-down f f "r" } [ jamshred-restart ] }
-    { T{ key-down f f " " } [ jamshred-gadget-jamshred toggle-running ] }
+    { T{ key-down f f " " } [ jamshred>> toggle-running ] }
+    { T{ key-down f f "f" } [ find-world toggle-fullscreen ] }
+    { T{ key-down f f "q" } [ quit ] }
     { T{ motion } [ handle-mouse-motion ] }
+    { T{ mouse-scroll } [ handle-mouse-scroll ] }
 } set-gestures
 
 : jamshred-window ( -- )
diff --git a/extra/jamshred/log/log.factor b/extra/jamshred/log/log.factor
new file mode 100644
index 0000000000..33498d8a2e
--- /dev/null
+++ b/extra/jamshred/log/log.factor
@@ -0,0 +1,10 @@
+USING: kernel logging ;
+IN: jamshred.log
+
+LOG: (jamshred-log) DEBUG
+
+: with-jamshred-log ( quot -- )
+    "jamshred" swap with-logging ;
+
+: jamshred-log ( message -- )
+    [ (jamshred-log) ] with-jamshred-log ; ! ugly...
diff --git a/extra/jamshred/oint/oint-tests.factor b/extra/jamshred/oint/oint-tests.factor
new file mode 100644
index 0000000000..401935fd01
--- /dev/null
+++ b/extra/jamshred/oint/oint-tests.factor
@@ -0,0 +1,8 @@
+USING: jamshred.oint tools.test ;
+IN: jamshred.oint-tests
+
+[ { 0 -1 -1 } ] [ { 0 1 -1 } { 0 -1 0 } reflect ] unit-test
+[ { 0 1 0 } ] [ { 1 1 0 } { 1 0 0 } proj-perp ] unit-test
+[ { 1 0 0 } ] [ { 1 1 0 } { 0 1 0 } proj-perp ] unit-test
+[ { 1/2 -1/2 0 } ] [ { 1 0 0 } { 1 1 0 } proj-perp ] unit-test
+[ { -1/2 1/2 0 } ] [ { 0 1 0 } { 1 1 0 } proj-perp ] unit-test
diff --git a/extra/jamshred/oint/oint.factor b/extra/jamshred/oint/oint.factor
index 11a89b314f..e2104b6f41 100644
--- a/extra/jamshred/oint/oint.factor
+++ b/extra/jamshred/oint/oint.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays float-arrays kernel math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
+USING: accessors arrays float-arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
 IN: jamshred.oint
 
 ! An oint is a point with three linearly independent unit vectors
@@ -9,47 +9,25 @@ IN: jamshred.oint
 ! segment's location and orientation are given by an oint.
 
 TUPLE: oint location forward up left ;
-
-: <oint> ( location forward up left -- oint )
-    oint boa ;
-
-! : x-rotation ( theta -- matrix )
-!     #! construct this matrix:
-!     #! { { 1           0          0 }
-!     #!   { 0  cos(theta) sin(theta) }
-!     #!   { 0 -sin(theta) cos(theta) } }
-!     dup sin neg swap cos 2dup 0 -rot 3float-array >r
-!     swap neg 0 -rot 3float-array >r
-!     { 1 0 0 } r> r> 3float-array ;
-! 
-! : y-rotation ( theta -- matrix )
-!     #! costruct this matrix:
-!     #! { { cos(theta) 0 -sin(theta) }
-!     #!   {          0 1           0 }
-!     #!   { sin(theta) 0  cos(theta) } }
-!     dup sin swap cos 2dup
-!     0 swap 3float-array >r
-!     { 0 1 0 } >r
-!     0 rot neg 3float-array r> r> 3float-array ;
-
-: apply-to-oint ( oint quot -- )
-    #! apply quot to each of forward, up, and left, storing the results
-    over oint-forward over call pick set-oint-forward
-    over oint-up over call pick set-oint-up
-    over oint-left swap call swap set-oint-left ;
+C: <oint> oint
 
 : rotation-quaternion ( theta axis -- quaternion )
     swap 2 / dup cos swap sin rot n*v first3 rect> >r rect> r> 2array ;
 
+: rotate-vector ( q qrecip v -- v )
+    v>q swap q* q* q>v ;
+
 : rotate-oint ( oint theta axis -- )
-    rotation-quaternion dup qrecip
-    [ rot v>q swap q* q* q>v ] curry curry apply-to-oint ;
+    rotation-quaternion dup qrecip pick
+    [ forward>> rotate-vector >>forward ]
+    [ up>> rotate-vector >>up ]
+    [ left>> rotate-vector >>left ] 3tri drop ;
 
 : left-pivot ( oint theta -- )
-    over oint-left rotate-oint ;
+    over left>> rotate-oint ;
 
 : up-pivot ( oint theta -- )
-    over oint-up rotate-oint ;
+    over up>> rotate-oint ;
 
 : random-float+- ( n -- m )
     #! find a random float between -n/2 and n/2
@@ -59,10 +37,10 @@ TUPLE: oint location forward up left ;
     2 / 2dup random-float+- left-pivot random-float+- up-pivot ;
 
 : go-forward ( distance oint -- )
-    tuck oint-forward n*v over oint-location v+ swap set-oint-location ;
+    [ forward>> n*v ] [ location>> v+ ] [ (>>location) ] tri ;
 
 : distance-vector ( oint oint -- vector )
-    oint-location swap oint-location v- ;
+    [ location>> ] bi@ swap v- ;
 
 : distance ( oint oint -- distance )
     distance-vector norm ;
@@ -71,6 +49,13 @@ TUPLE: oint location forward up left ;
     #! the scalar projection of v1 onto v2
     tuck v. swap norm / ;
 
+: proj-perp ( u v -- w )
+    dupd proj v- ;
+
 : perpendicular-distance ( oint oint -- distance )
-    tuck distance-vector swap 2dup oint-left scalar-projection abs
-    -rot oint-up scalar-projection abs + ;
+    tuck distance-vector swap 2dup left>> scalar-projection abs
+    -rot up>> scalar-projection abs + ;
+
+:: reflect ( v n -- v' )
+    #! bounce v on a surface with normal n
+    v v n v. n n v. / 2 * n n*v v- ;
diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor
index 17843ef9c2..bea4ab4836 100644
--- a/extra/jamshred/player/player.factor
+++ b/extra/jamshred/player/player.factor
@@ -1,38 +1,68 @@
 ! Copyright (C) 2007 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: colors jamshred.oint jamshred.tunnel kernel
-math math.constants sequences ;
+USING: accessors colors jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel math math.constants math.order math.ranges shuffle sequences system ;
 IN: jamshred.player
 
-TUPLE: player name tunnel nearest-segment ;
+TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ;
 
-: <player> ( name -- player )
-    f f player boa
-    F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } <oint> over set-delegate ;
+! speeds are in GL units / second
+: default-speed ( -- speed ) 1.0 ;
+: max-speed ( -- speed ) 30.0 ;
+
+: <player> ( name sounds -- player )
+    [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] 2dip
+    f f f default-speed player boa ;
 
 : turn-player ( player x-radians y-radians -- )
     >r over r> left-pivot up-pivot ;
 
 : to-tunnel-start ( player -- )
-    dup player-tunnel first dup oint-location pick set-oint-location
-    swap set-player-nearest-segment ;
+    [ tunnel>> first dup location>> ]
+    [ tuck (>>location) (>>nearest-segment) ] bi ;
 
 : play-in-tunnel ( player segments -- )
-    over set-player-tunnel to-tunnel-start ;
+    >>tunnel to-tunnel-start ;
 
 : update-nearest-segment ( player -- )
-    dup player-tunnel over dup player-nearest-segment nearest-segment
-    swap set-player-nearest-segment ;
+    [ tunnel>> ] [ dup nearest-segment>> nearest-segment ]
+    [ (>>nearest-segment) ] tri ;
 
-: max-speed ( -- speed )
-    0.3 ;
+: moved ( player -- ) millis swap (>>last-move) ;
 
-: player-speed ( player -- speed )
-    dup player-nearest-segment fraction-from-wall sq max-speed * ;
+: speed-range ( -- range )
+    max-speed [0,b] ;
+
+: change-player-speed ( inc player -- )
+    [ + speed-range clamp-to-range ] change-speed drop ;
+
+: distance-to-move ( player -- distance )
+    [ speed>> ] [ last-move>> millis dup >r swap - 1000 / * r> ]
+    [ (>>last-move) ] tri ;
+
+DEFER: (move-player)
+
+: ?bounce ( distance-remaining player -- )
+    over 0 > [
+        [ dup nearest-segment>> bounce ] [ sounds>> bang ]
+        [ (move-player) ] tri
+    ] [
+        2drop
+    ] if ;
+
+: move-player-distance ( distance-remaining player distance -- distance-remaining player )
+    pick min tuck over go-forward [ - ] dip ;
+
+: (move-player) ( distance-remaining player -- )
+    over 0 <= [
+        2drop
+    ] [
+        dup dup nearest-segment>> distance-to-collision
+        move-player-distance ?bounce
+    ] if ;
 
 : move-player ( player -- )
-    dup player-speed over go-forward update-nearest-segment ;
+    [ distance-to-move ] [ (move-player) ] [ update-nearest-segment ] tri ;
 
 : update-player ( player -- )
-    dup move-player player-nearest-segment
+    dup move-player nearest-segment>>
     white swap set-segment-color ;
diff --git a/extra/jamshred/sound/bang.wav b/extra/jamshred/sound/bang.wav
new file mode 100644
index 0000000000..b15af141ec
Binary files /dev/null and b/extra/jamshred/sound/bang.wav differ
diff --git a/extra/jamshred/sound/sound.factor b/extra/jamshred/sound/sound.factor
new file mode 100644
index 0000000000..fd1b1127bd
--- /dev/null
+++ b/extra/jamshred/sound/sound.factor
@@ -0,0 +1,13 @@
+USING: accessors io.files kernel openal sequences ;
+IN: jamshred.sound
+
+TUPLE: sounds bang ;
+
+: assign-sound ( source wav-path -- )
+    resource-path create-buffer-from-wav AL_BUFFER swap set-source-param ;
+
+: <sounds> ( -- sounds )
+    init-openal 1 gen-sources first sounds boa
+    dup bang>> "extra/jamshred/sound/bang.wav" assign-sound ;
+
+: bang ( sounds -- ) bang>> source-play check-error ;
diff --git a/extra/jamshred/tunnel/tunnel-tests.factor b/extra/jamshred/tunnel/tunnel-tests.factor
index 8031678896..c6755318e6 100644
--- a/extra/jamshred/tunnel/tunnel-tests.factor
+++ b/extra/jamshred/tunnel/tunnel-tests.factor
@@ -3,8 +3,8 @@
 USING: jamshred.oint jamshred.tunnel kernel sequences tools.test ;
 IN: jamshred.tunnel.tests
 
-[ 0 ] [ T{ segment T{ oint f { 0 0 0 } } 0 }
-        T{ segment T{ oint f { 1 1 1 } } 1 }
+[ 0 ] [ T{ segment f { 0 0 0 } f f f 0 }
+        T{ segment f { 1 1 1 } f f f 1 }
         T{ oint f { 0 0 0.25 } }
         nearer-segment segment-number ] unit-test
 
@@ -15,3 +15,30 @@ IN: jamshred.tunnel.tests
 [ 3 ] [ <straight-tunnel> T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward segment-number ] unit-test
 
 [ F{ 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over first nearest-segment oint-location ] unit-test
+
+: test-segment-oint ( -- oint )
+    { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ;
+
+[ { -1 0 0 } ] [ test-segment-oint { 1 0 0 } vector-to-centre ] unit-test
+[ { 1 0 0 } ] [ test-segment-oint { -1 0 0 } vector-to-centre ] unit-test
+[ { 0 -1 0 } ] [ test-segment-oint { 0 1 0 } vector-to-centre ] unit-test
+[ { 0 1 0 } ] [ test-segment-oint { 0 -1 0 } vector-to-centre ] unit-test
+[ { -1 0 0 } ] [ test-segment-oint { 1 0 -1 } vector-to-centre ] unit-test
+[ { 1 0 0 } ] [ test-segment-oint { -1 0 -1 } vector-to-centre ] unit-test
+[ { 0 -1 0 } ] [ test-segment-oint { 0 1 -1 } vector-to-centre ] unit-test
+[ { 0 1 0 } ] [ test-segment-oint { 0 -1 -1 } vector-to-centre ] unit-test
+
+: simplest-straight-ahead ( -- oint segment )
+    { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint>
+    initial-segment ;
+
+[ { 0 0 0 } ] [ simplest-straight-ahead sideways-heading ] unit-test
+[ { 0 0 0 } ] [ simplest-straight-ahead sideways-relative-location ] unit-test
+
+: simple-collision-up ( -- oint segment )
+    { 0 0 0 } { 0 1 0 } { 0 0 1 } { -1 0 0 } <oint>
+    initial-segment ;
+
+[ { 0 1 0 } ] [ simple-collision-up sideways-heading ] unit-test
+[ { 0 0 0 } ] [ simple-collision-up sideways-relative-location ] unit-test
+[ { 0 1 0 } ] [ simple-collision-up collision-vector ] unit-test
diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor
index c3f6b37fb8..139cdbfb53 100755
--- a/extra/jamshred/tunnel/tunnel.factor
+++ b/extra/jamshred/tunnel/tunnel.factor
@@ -1,23 +1,20 @@
 ! Copyright (C) 2007 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays float-arrays kernel jamshred.oint math math.functions
-math.ranges math.vectors math.constants random sequences vectors ;
+USING: accessors arrays combinators float-arrays kernel jamshred.oint locals math math.functions math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences vectors ;
 IN: jamshred.tunnel
 
 : n-segments ( -- n ) 5000 ; inline
 
-TUPLE: segment number color radius ;
-
-: <segment> ( number color radius location forward up left -- segment )
-    <oint> >r segment boa r> over set-delegate ;
+TUPLE: segment < oint number color radius ;
+C: <segment> segment
 
 : segment-vertex ( theta segment -- vertex )
-     tuck 2dup oint-up swap sin v*n
-     >r oint-left swap cos v*n r> v+
-     swap oint-location v+ ;
+     tuck 2dup up>> swap sin v*n
+     >r left>> swap cos v*n r> v+
+     swap location>> v+ ;
 
 : segment-vertex-normal ( vertex segment -- normal )
-    oint-location swap v- normalize ;
+    location>> swap v- normalize ;
 
 : segment-vertex-and-normal ( segment theta -- vertex normal )
     swap [ segment-vertex ] keep dupd segment-vertex-normal ;
@@ -27,7 +24,7 @@ TUPLE: segment number color radius ;
     dup [ / pi 2 * * ] curry map ;
 
 : segment-number++ ( segment -- )
-    dup segment-number 1+ swap set-segment-number ;
+    [ number>> 1+ ] keep (>>number) ;
 
 : random-color ( -- color )
     { 100 100 100 } [ random 100 / >float ] map { 1.0 } append ;
@@ -50,15 +47,15 @@ TUPLE: segment number color radius ;
 : default-segment-radius ( -- r ) 1 ;
 
 : initial-segment ( -- segment )
-    0 random-color default-segment-radius
-    F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } <segment> ;
+    F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 }
+    0 random-color default-segment-radius <segment> ;
 
 : random-segments ( n -- segments )
     initial-segment 1vector swap (random-segments) ;
 
 : simple-segment ( n -- segment )
-    random-color default-segment-radius pick F{ 0 0 -1 } n*v
-    F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } <segment> ;
+    [ F{ 0 0 -1 } n*v F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] keep
+    random-color default-segment-radius <segment> ;
 
 : simple-segments ( n -- segments )
     [ simple-segment ] map ;
@@ -100,14 +97,54 @@ TUPLE: segment number color radius ;
     [ nearest-segment-forward ] 3keep
     nearest-segment-backward r> nearer-segment ;
 
-: distance-from-centre ( oint segment -- distance )
-    perpendicular-distance ;
+: vector-to-centre ( seg loc -- v )
+    over location>> swap v- swap forward>> proj-perp ;
 
-: distance-from-wall ( oint segment -- distance )
-    tuck distance-from-centre swap segment-radius swap - ;
+: distance-from-centre ( seg loc -- distance )
+    vector-to-centre norm ;
 
-: fraction-from-centre ( oint segment -- fraction )
-    tuck distance-from-centre swap segment-radius / ;
+: wall-normal ( seg oint -- n )
+    location>> vector-to-centre normalize ;
 
-: fraction-from-wall ( oint segment -- fraction )
+: from ( seg loc -- radius d-f-c )
+    dupd location>> distance-from-centre [ radius>> ] dip ;
+
+: distance-from-wall ( seg loc -- distance ) from - ;
+: fraction-from-centre ( seg loc -- fraction ) from / ;
+: fraction-from-wall ( seg loc -- fraction )
     fraction-from-centre 1 swap - ;
+
+:: collision-coefficient ( v w r -- c )
+    [let* | a [ v dup v. ]
+            b [ v w v. 2 * ]
+            c [ w dup v. r sq - ] |
+        c b a quadratic max ] ;
+
+: sideways-heading ( oint segment -- v )
+    [ forward>> ] bi@ proj-perp ;
+
+: sideways-relative-location ( oint segment -- loc )
+    [ [ location>> ] bi@ v- ] keep forward>> proj-perp ;
+
+: collision-vector ( oint segment -- v )
+    [ sideways-heading ] [ sideways-relative-location ] [ radius>> ] 2tri
+    swap [ collision-coefficient ] dip forward>> n*v ;
+
+: distance-to-collision ( oint segment -- distance )
+    collision-vector norm ;
+
+: bounce-forward ( segment oint -- )
+    [ wall-normal ] [ forward>> swap reflect ] [ (>>forward) ] tri ;
+
+: bounce-left ( segment oint -- )
+    #! must be done after forward
+    [ forward>> vneg ] dip [ left>> swap reflect ]
+    [ forward>> proj-perp normalize ] [ (>>left) ] tri ;
+
+: bounce-up ( segment oint -- )
+    #! must be done after forward and left!
+    nip [ forward>> ] [ left>> cross ] [ (>>up) ] tri ;
+
+: bounce ( oint segment -- )
+    swap [ bounce-forward ] [ bounce-left ] [ bounce-up ] 2tri ;
+
diff --git a/extra/optimizer/report/report.factor b/extra/optimizer/report/report.factor
index 70756e81c2..60b83819d5 100755
--- a/extra/optimizer/report/report.factor
+++ b/extra/optimizer/report/report.factor
@@ -20,7 +20,7 @@ IN: optimizer.report
     [
         dup [
             word-dataflow nip 1 count-optimization-passes
-        ] benchmark nip 2array
+        ] benchmark 2array
     ] { } map>assoc
     [ first ] "Worst number of optimizer passes:" results
     [ second ] "Worst compile times:" results ;
diff --git a/extra/project-euler/ave-time/ave-time-docs.factor b/extra/project-euler/ave-time/ave-time-docs.factor
index cc40ae4bf1..d8ee0846b0 100644
--- a/extra/project-euler/ave-time/ave-time-docs.factor
+++ b/extra/project-euler/ave-time/ave-time-docs.factor
@@ -16,9 +16,7 @@ HELP: ave-time
     "This word can be used to compare performance of the non-optimizing and optimizing compilers."
     $nl
     "First, we time a quotation directly; quotations are compiled by the non-optimizing quotation compiler:"
-    { $unchecked-example "[ 1000000 0 [ + ] reduce drop ] 10 ave-time" "1116 ms run / 6 ms GC ave time - 10 trials" }
+    { $unchecked-example "[ 1000000 0 [ + ] reduce drop ] 10 ave-time" "1116 ms run time - 10 trials" }
     "Now we define a word and compile it with the optimizing word compiler. This results is faster execution:"
-    { $unchecked-example ": foo 1000000 0 [ + ] reduce ;" "\\ foo compile" "[ foo drop ] 10 ave-time" "202 ms run / 13 ms GC ave time - 10 trials" }
+    { $unchecked-example ": foo 1000000 0 [ + ] reduce ;" "\\ foo compile" "[ foo drop ] 10 ave-time" "202 ms run time - 10 trials" }
 } ;
-
-{ benchmark collect-benchmarks gc-time millis time ave-time } related-words
diff --git a/extra/project-euler/ave-time/ave-time.factor b/extra/project-euler/ave-time/ave-time.factor
index b908dbd7b0..c8212b4009 100644
--- a/extra/project-euler/ave-time/ave-time.factor
+++ b/extra/project-euler/ave-time/ave-time.factor
@@ -4,20 +4,13 @@ USING: arrays combinators io kernel math math.functions math.parser
     math.statistics namespaces sequences tools.time ;
 IN: project-euler.ave-time
 
-<PRIVATE
-
-: ave-benchmarks ( seq -- pair )
-    flip [ mean round ] map ;
-
-PRIVATE>
-
 : collect-benchmarks ( quot n -- seq )
   [
-    >r >r datastack r> [ benchmark 2array , ] curry tuck
+    >r >r datastack r> [ benchmark , ] curry tuck
     [ with-datastack drop ] 2curry r> swap times call
   ] { } make ;
 
 : ave-time ( quot n -- )
-    [ collect-benchmarks ] keep swap ave-benchmarks [
-        dup second # " ms run / " % first # " ms GC ave time - " % # " trials" %
+    [ collect-benchmarks ] keep swap mean round [
+        # " ms run time - " % # " trials" %
     ] "" make print flush ; inline
diff --git a/extra/reports/optimizer/optimizer.factor b/extra/reports/optimizer/optimizer.factor
index 06e76d0a99..51eae24333 100755
--- a/extra/reports/optimizer/optimizer.factor
+++ b/extra/reports/optimizer/optimizer.factor
@@ -20,7 +20,7 @@ IN: report.optimizer
     [
         dup [
             word-dataflow nip 1 count-optimization-passes
-        ] benchmark nip 2array
+        ] benchmark 2array
     ] { } map>assoc ;
 
 : optimizer-measurements. ( alist -- )
diff --git a/extra/tools/deploy/config/config-docs.factor b/extra/tools/deploy/config/config-docs.factor
index 4af1219daf..2960cf452d 100755
--- a/extra/tools/deploy/config/config-docs.factor
+++ b/extra/tools/deploy/config/config-docs.factor
@@ -96,7 +96,7 @@ HELP: deploy-io
         { "2" "Basic ANSI C streams" }
         { "3" "Non-blocking streams and networking" }
     }
-"The default value is 1, basic ANSI C streams. This enables basic console and file I/O, however more advanced features such are not available." } ;
+"The default value is 2, basic ANSI C streams. This enables basic console and file I/O, however more advanced features such as networking are not available." } ;
 
 HELP: deploy-reflection
 { $description "The level of reflection support required by the deployed image."
diff --git a/extra/tools/memory/memory.factor b/extra/tools/memory/memory.factor
index b8fdcab280..9628b218e9 100644
--- a/extra/tools/memory/memory.factor
+++ b/extra/tools/memory/memory.factor
@@ -36,6 +36,7 @@ IN: tools.memory
         [ first2 ] [ number>string "Generation " prepend ] bi*
         write-total/used/free
     ] 2each
+    "Decks" write-total
     "Cards" write-total ;
 
 : write-labelled-size ( n string -- )
diff --git a/extra/tools/test/test.factor b/extra/tools/test/test.factor
index 854ef7af0e..8ef80c6add 100755
--- a/extra/tools/test/test.factor
+++ b/extra/tools/test/test.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces arrays prettyprint sequences kernel
 vectors quotations words parser assocs combinators
-continuations debugger io io.files vocabs tools.time
+continuations debugger io io.files vocabs
 vocabs.loader source-files compiler.units inspector
 inference effects tools.vocabs ;
 IN: tools.test
@@ -19,7 +19,7 @@ SYMBOL: this-test
 
 : (unit-test) ( what quot -- )
     swap dup . flush this-test set
-    [ time ] curry failures get [
+    failures get [
         [ this-test get failure ] recover
     ] [
         call
diff --git a/extra/tools/time/time-docs.factor b/extra/tools/time/time-docs.factor
index 36ab3c01d4..c0afa920c4 100644
--- a/extra/tools/time/time-docs.factor
+++ b/extra/tools/time/time-docs.factor
@@ -6,9 +6,9 @@ ARTICLE: "timing" "Timing code"
 { $subsection time }
 "A lower-level word puts timings on the stack, intead of printing:"
 { $subsection benchmark }
-"You can also read the system clock and total garbage collection time directly:"
+"You can also read the system clock and garbage collection statistics directly:"
 { $subsection millis } 
-{ $subsection gc-time }
+{ $subsection gc-stats }
 { $see-also "profiling" } ;
 
 ABOUT: "timing"
@@ -20,14 +20,6 @@ HELP: benchmark
 
 HELP: time
 { $values { "quot" "a quotation" } }
-{ $description "Runs a quotation and then prints the total run time and time spent in the garbage collector." }
-{ $examples
-    "This word can be used to compare performance of the non-optimizing and optimizing compilers."
-    $nl
-    "First, we time a quotation directly; quotations are compiled by the non-optimizing quotation compiler:"
-    { $unchecked-example "[ 1000000 0 [ + ] reduce drop ] time" "1116 ms run / 6 ms GC time" }
-    "Now we define a word and compile it with the optimizing word compiler. This results is faster execution:"
-    { $unchecked-example ": foo 1000000 0 [ + ] reduce ;" "\\ foo compile" "[ foo drop ] time" "202 ms run / 13 ms GC time" }
-} ;
+{ $description "Runs a quotation and then prints the total run time and some garbage collection statistics." } ;
 
-{ gc-time benchmark millis time } related-words
+{ benchmark millis time } related-words
diff --git a/extra/tools/time/time.factor b/extra/tools/time/time.factor
index 4862cc2b27..0a0121c74e 100644
--- a/extra/tools/time/time.factor
+++ b/extra/tools/time/time.factor
@@ -1,14 +1,54 @@
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math memory io namespaces system
-math.parser ;
+USING: kernel math math.vectors memory io io.styles prettyprint
+namespaces system sequences splitting assocs strings ;
 IN: tools.time
 
 : benchmark ( quot -- gctime runtime )
-    millis >r gc-time >r call gc-time r> - millis r> - ;
-    inline
+    millis >r call millis r> - ; inline
+
+: simple-table. ( values -- )
+    standard-table-style [
+        [
+            [
+                [
+                    dup string?
+                    [ [ write ] with-cell ]
+                    [ pprint-cell ]
+                    if
+                ] each
+            ] with-row
+        ] each
+    ] tabular-output ;
+
+: time. ( data -- )
+    unclip
+    "==== RUNNING TIME" print nl pprint " ms" print nl
+    4 cut*
+    "==== GARBAGE COLLECTION" print nl
+    [
+        6 group
+        {
+            "GC count:"
+            "Cumulative GC time (ms):"
+            "Longest GC pause (ms):"
+            "Average GC pause (ms):"
+            "Objects copied:"
+            "Bytes copied:"
+        } prefix
+        flip
+        { "" "Nursery" "Aging" "Tenured" } prefix
+        simple-table.
+    ]
+    [
+        nl
+        {
+            "Total GC time (ms):"
+            "Cards scanned:"
+            "Decks scanned:"
+            "Code heap literal scans:"
+        } swap zip simple-table.
+    ] bi* ;
 
 : time ( quot -- )
-    benchmark
-    [ # " ms run / " % # " ms GC time" % ] "" make print flush ;
-    inline
+    gc-reset millis >r call gc-stats millis r> - prefix time. ; inline
diff --git a/extra/ui/cocoa/cocoa.factor b/extra/ui/cocoa/cocoa.factor
index 10980249f3..d1b7f22b41 100755
--- a/extra/ui/cocoa/cocoa.factor
+++ b/extra/ui/cocoa/cocoa.factor
@@ -15,7 +15,12 @@ C: <handle> handle
 SINGLETON: cocoa-ui-backend
 
 M: cocoa-ui-backend do-events ( -- )
-    [ [ NSApp do-events ui-wait ] ui-try ] with-autorelease-pool ;
+    [
+        [
+            NSApp [ dup do-event ] [ ] [ ] while drop
+            ui-wait
+        ] ui-try
+    ] with-autorelease-pool ;
 
 TUPLE: pasteboard handle ;
 
diff --git a/extra/unix/unix.factor b/extra/unix/unix.factor
index 38af4b8695..bc3e3ca162 100755
--- a/extra/unix/unix.factor
+++ b/extra/unix/unix.factor
@@ -80,14 +80,11 @@ FUNCTION: uint ntohl ( uint n ) ;
 FUNCTION: ushort ntohs ( ushort n ) ;
 FUNCTION: char* strerror ( int errno ) ;
 
-TUPLE: open-error path flags prot message ;
+ERROR: open-error path flags prot message ;
 
 : open ( path flags prot -- int )
-  [ ] [ unix.ffi:open ] 3bi
-  dup 0 >=
-    [ nip nip nip ]
-    [ drop err_no strerror open-error boa throw ]
-  if ;
+    3dup unix.ffi:open
+    dup 0 >= [ >r 3drop r> ] [ drop err_no strerror open-error ] if ;
 
 FUNCTION: int pclose ( void* file ) ;
 FUNCTION: int pipe ( int* filedes ) ;
@@ -171,8 +168,6 @@ FUNCTION: int setpriority ( int which, int who, int prio ) ;
 FUNCTION: pid_t wait ( int* status ) ;
 FUNCTION: pid_t waitpid ( pid_t wpid, int* status, int options ) ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;
 
 {
diff --git a/vm/data_gc.c b/vm/data_gc.c
index 5aa47c8c6c..aed2cef4d1 100755
--- a/vm/data_gc.c
+++ b/vm/data_gc.c
@@ -21,10 +21,11 @@ CELL init_zone(F_ZONE *z, CELL size, CELL start)
 	return z->end;
 }
 
-void init_cards_offset(void)
+void init_card_decks(void)
 {
-	cards_offset = (CELL)data_heap->cards
-		- (data_heap->segment->start >> CARD_BITS);
+	CELL start = data_heap->segment->start & ~(DECK_SIZE - 1);
+	cards_offset = (CELL)data_heap->cards - (start >> CARD_BITS);
+	decks_offset = (CELL)data_heap->decks - (start >> DECK_BITS);
 }
 
 F_DATA_HEAP *alloc_data_heap(CELL gens,
@@ -62,10 +63,14 @@ F_DATA_HEAP *alloc_data_heap(CELL gens,
 	data_heap->generations = safe_malloc(sizeof(F_ZONE) * data_heap->gen_count);
 	data_heap->semispaces = safe_malloc(sizeof(F_ZONE) * data_heap->gen_count);
 
-	CELL cards_size = total_size / CARD_SIZE;
+	CELL cards_size = (total_size + DECK_SIZE) / CARD_SIZE;
 	data_heap->cards = safe_malloc(cards_size);
 	data_heap->cards_end = data_heap->cards + cards_size;
 
+	CELL decks_size = (total_size + DECK_SIZE) / DECK_SIZE;
+	data_heap->decks = safe_malloc(decks_size);
+	data_heap->decks_end = data_heap->decks + decks_size;
+
 	CELL alloter = data_heap->segment->start;
 
 	alloter = init_zone(&data_heap->generations[TENURED],tenured_size,alloter);
@@ -105,6 +110,7 @@ void dealloc_data_heap(F_DATA_HEAP *data_heap)
 	free(data_heap->generations);
 	free(data_heap->semispaces);
 	free(data_heap->cards);
+	free(data_heap->decks);
 	free(data_heap);
 }
 
@@ -113,20 +119,38 @@ cleared when a generation has been cleared */
 void clear_cards(CELL from, CELL to)
 {
 	/* NOTE: reverse order due to heap layout. */
+	F_CARD *first_card = ADDR_TO_CARD(data_heap->generations[to].start);
 	F_CARD *last_card = ADDR_TO_CARD(data_heap->generations[from].end);
-	F_CARD *ptr = ADDR_TO_CARD(data_heap->generations[to].start);
-	for(; ptr < last_card; ptr++)
-		clear_card(ptr);
+	F_CARD *ptr;
+	for(ptr = first_card; ptr < last_card; ptr++)
+		*ptr = CARD_BASE_MASK; /* invalid value */
+}
+
+void clear_decks(CELL from, CELL to)
+{
+	/* NOTE: reverse order due to heap layout. */
+	F_CARD *first_deck = ADDR_TO_CARD(data_heap->generations[to].start);
+	F_CARD *last_deck = ADDR_TO_CARD(data_heap->generations[from].end);
+	F_CARD *ptr;
+	for(ptr = first_deck; ptr < last_deck; ptr++)
+		*ptr = 0;
 }
 
 void set_data_heap(F_DATA_HEAP *data_heap_)
 {
 	data_heap = data_heap_;
 	nursery = data_heap->generations[NURSERY];
-	init_cards_offset();
+	init_card_decks();
 	clear_cards(NURSERY,TENURED);
 }
 
+void gc_reset(void)
+{
+	int i;
+	for(i = 0; i < MAX_GEN_COUNT; i++)
+		memset(&gc_stats[i],0,sizeof(F_GC_STATS));
+}
+
 void init_data_heap(CELL gens,
 	CELL young_size,
 	CELL aging_size,
@@ -141,11 +165,13 @@ void init_data_heap(CELL gens,
 	extra_roots_region = alloc_segment(getpagesize());
 	extra_roots = extra_roots_region->start - CELLS;
 
-	gc_time = 0;
-	aging_collections = 0;
-	nursery_collections = 0;
-	cards_scanned = 0;
 	secure_gc = secure_gc_;
+
+	gc_reset();
+
+	cards_scanned = 0;
+	decks_scanned = 0;
+	code_heap_scans = 0;
 }
 
 /* Size of the object pointed to by a tagged pointer */
@@ -228,6 +254,7 @@ DEFINE_PRIMITIVE(data_room)
 	int gen;
 
 	dpush(tag_fixnum((data_heap->cards_end - data_heap->cards) >> 10));
+	dpush(tag_fixnum((data_heap->decks_end - data_heap->decks) >> 10));
 
 	for(gen = 0; gen < data_heap->gen_count; gen++)
 	{
@@ -283,36 +310,61 @@ DEFINE_PRIMITIVE(end_scan)
 }
 
 /* Scan all the objects in the card */
-INLINE void collect_card(F_CARD *ptr, CELL gen, CELL here)
+void collect_card(F_CARD *ptr, CELL gen, CELL here)
 {
 	F_CARD c = *ptr;
 	CELL offset = (c & CARD_BASE_MASK);
 
-	if(offset == CARD_BASE_MASK)
+	if(offset != CARD_BASE_MASK)
 	{
-		if(c == 0xff)
-			critical_error("bad card",(CELL)ptr);
-		else
-			return;
+		CELL card_scan = (CELL)CARD_TO_ADDR(ptr) + offset;
+		CELL card_end = (CELL)CARD_TO_ADDR(ptr + 1);
+	
+		while(card_scan < card_end && card_scan < here)
+			card_scan = collect_next(card_scan);
+	
+		cards_scanned++;
+	}
+}
+
+void collect_card_deck(F_DECK *deck, CELL gen, F_CARD mask, F_CARD unmask)
+{
+	F_CARD *first_card = DECK_TO_CARD(deck);
+	F_CARD *last_card = DECK_TO_CARD(deck + 1);
+
+	CELL here = data_heap->generations[gen].here;
+
+	u32 *quad_ptr;
+	u32 quad_mask = mask | (mask << 8) | (mask << 16) | (mask << 24);
+
+	for(quad_ptr = (u32 *)first_card; quad_ptr < (u32 *)last_card; quad_ptr++)
+	{
+		if(*quad_ptr & quad_mask)
+		{
+			F_CARD *ptr = (F_CARD *)quad_ptr;
+
+			int card;
+			for(card = 0; card < 4; card++)
+			{
+				if(ptr[card] & mask)
+				{
+					collect_card(&ptr[card],gen,here);
+					ptr[card] &= ~unmask;
+				}
+			}
+		}
 	}
 
-	CELL card_scan = (CELL)CARD_TO_ADDR(ptr) + offset;
-	CELL card_end = (CELL)CARD_TO_ADDR(ptr + 1);
-
-	while(card_scan < card_end && card_scan < here)
-		card_scan = collect_next(card_scan);
-
-	cards_scanned++;
+	decks_scanned++;
 }
 
 /* Copy all newspace objects referenced from marked cards to the destination */
-INLINE void collect_gen_cards(CELL gen)
+void collect_gen_cards(CELL gen)
 {
-	F_CARD *ptr = ADDR_TO_CARD(data_heap->generations[gen].start);
-	CELL here = data_heap->generations[gen].here;
-	F_CARD *last_card = ADDR_TO_CARD(here - 1);
+	F_DECK *first_deck = ADDR_TO_DECK(data_heap->generations[gen].start);
+	F_DECK *last_deck = ADDR_TO_DECK(data_heap->generations[gen].end);
 
-	CELL mask, unmask;
+	F_CARD mask, unmask;
 
 	/* if we are collecting the nursery, we care about old->nursery pointers
 	but not old->aging pointers */
@@ -360,11 +412,13 @@ INLINE void collect_gen_cards(CELL gen)
 		return;
 	}
 
-	for(; ptr <= last_card; ptr++)
+	F_DECK *ptr;
+
+	for(ptr = first_deck; ptr < last_deck; ptr++)
 	{
 		if(*ptr & mask)
 		{
-			collect_card(ptr,gen,here);
+			collect_card_deck(ptr,gen,mask,unmask);
 			*ptr &= ~unmask;
 		}
 	}
@@ -454,6 +508,11 @@ INLINE void *copy_untagged_object(void *pointer, CELL size)
 		longjmp(gc_jmp,1);
 	allot_barrier(newspace->here);
 	newpointer = allot_zone(newspace,size);
+
+	F_GC_STATS *s = &gc_stats[collecting_gen];
+	s->object_count++;
+	s->bytes_copied += size;
+
 	memcpy(newpointer,pointer,size);
 	return newpointer;
 }
@@ -584,6 +643,7 @@ CELL collect_next(CELL scan)
 INLINE void reset_generation(CELL i)
 {
 	F_ZONE *z = (i == NURSERY ? &nursery : &data_heap->generations[i]);
+
 	z->here = z->start;
 	if(secure_gc)
 		memset((void*)z->start,69,z->size);
@@ -594,7 +654,9 @@ their allocation pointers and cards reset. */
 void reset_generations(CELL from, CELL to)
 {
 	CELL i;
-	for(i = from; i <= to; i++) reset_generation(i);
+	for(i = from; i <= to; i++)
+		reset_generation(i);
+
 	clear_cards(from,to);
 }
 
@@ -638,8 +700,15 @@ void begin_gc(CELL requested_bytes)
 #endif
 }
 
-void end_gc(void)
+void end_gc(CELL gc_elapsed)
 {
+	F_GC_STATS *s = &gc_stats[collecting_gen];
+
+	s->collections++;
+	s->gc_time += gc_elapsed;
+	if(s->max_gc_time < gc_elapsed)
+		s->max_gc_time = gc_elapsed;
+
 	if(growing_data_heap)
 	{
 		dealloc_data_heap(old_data_heap);
@@ -654,29 +723,12 @@ void end_gc(void)
 		old-school Cheney collector */
 		if(collecting_gen != NURSERY)
 			reset_generations(NURSERY,collecting_gen - 1);
-
-		if(collecting_gen == TENURED)
-		{
-			GC_PRINT(END_AGING_GC,aging_collections,cards_scanned);
-			aging_collections = 0;
-			cards_scanned = 0;
-		}
-		else if(HAVE_AGING_P && collecting_gen == AGING)
-		{
-			aging_collections++;
-
-			GC_PRINT(END_NURSERY_GC,nursery_collections,cards_scanned);
-			nursery_collections = 0;
-			cards_scanned = 0;
-		}
 	}
 	else
 	{
 		/* all generations up to and including the one
 		collected are now empty */
 		reset_generations(NURSERY,collecting_gen);
-
-		nursery_collections++;
 	}
 
 	if(collecting_gen == TENURED)
@@ -758,7 +810,10 @@ void garbage_collection(CELL gen,
 			literals from any code block which gets marked as live.
 			if we are not doing code GC, just consider all literals
 			as roots. */
+			code_heap_scans++;
+
 			collect_literals();
+
 			if(collecting_accumulation_gen_p())
 				last_code_heap_scan = collecting_gen;
 			else
@@ -772,9 +827,8 @@ void garbage_collection(CELL gen,
 	CELL gc_elapsed = (current_millis() - start);
 
 	GC_PRINT(END_GC,gc_elapsed);
-	end_gc();
+	end_gc(gc_elapsed);
 
-	gc_time += gc_elapsed;
 	performing_gc = false;
 }
 
@@ -793,10 +847,38 @@ DEFINE_PRIMITIVE(gc)
 	gc();
 }
 
-/* Push total time spent on GC */
-DEFINE_PRIMITIVE(gc_time)
+DEFINE_PRIMITIVE(gc_stats)
 {
-	box_unsigned_8(gc_time);
+	GROWABLE_ARRAY(stats);
+
+	CELL i;
+	CELL total_gc_time = 0;
+
+	for(i = 0; i < MAX_GEN_COUNT; i++)
+	{
+		F_GC_STATS *s = &gc_stats[i];
+		GROWABLE_ADD(stats,allot_cell(s->collections));
+		GROWABLE_ADD(stats,allot_cell(s->gc_time));
+		GROWABLE_ADD(stats,allot_cell(s->max_gc_time));
+		GROWABLE_ADD(stats,allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections));
+		GROWABLE_ADD(stats,allot_cell(s->object_count));
+		GROWABLE_ADD(stats,tag_bignum(long_long_to_bignum(s->bytes_copied)));
+
+		total_gc_time += s->gc_time;
+	}
+
+	GROWABLE_ADD(stats,allot_cell(total_gc_time));
+	GROWABLE_ADD(stats,tag_bignum(long_long_to_bignum(cards_scanned)));
+	GROWABLE_ADD(stats,tag_bignum(long_long_to_bignum(decks_scanned)));
+	GROWABLE_ADD(stats,allot_cell(code_heap_scans));
+
+	GROWABLE_TRIM(stats);
+	dpush(stats);
+}
+
+DEFINE_PRIMITIVE(gc_reset)
+{
+	gc_reset();
 }
 
 DEFINE_PRIMITIVE(become)
diff --git a/vm/data_gc.h b/vm/data_gc.h
index be9ed159b7..c1023b8043 100755
--- a/vm/data_gc.h
+++ b/vm/data_gc.h
@@ -46,6 +46,9 @@ typedef struct {
 
 	CELL *cards;
 	CELL *cards_end;
+
+	CELL *decks;
+	CELL *decks_end;
 } F_DATA_HEAP;
 
 F_DATA_HEAP *data_heap;
@@ -71,17 +74,27 @@ offset within the card */
 #define CARD_BITS 6
 #define ADDR_CARD_MASK (CARD_SIZE-1)
 
-INLINE void clear_card(F_CARD *c)
-{
-	*c = CARD_BASE_MASK; /* invalid value */
-}
-
 DLLEXPORT CELL cards_offset;
-void init_cards_offset(void);
 
 #define ADDR_TO_CARD(a) (F_CARD*)(((CELL)(a) >> CARD_BITS) + cards_offset)
 #define CARD_TO_ADDR(c) (CELL*)(((CELL)(c) - cards_offset)<<CARD_BITS)
 
+/* A deck is 4 kilobytes or 64 cards. */
+typedef u8 F_DECK;
+
+#define DECK_SIZE (4 * 1024)
+#define DECK_BITS 12
+#define ADDR_DECK_MASK (DECK_SIZE-1)
+
+DLLEXPORT CELL decks_offset;
+
+#define ADDR_TO_DECK(a) (F_DECK*)(((CELL)(a) >> DECK_BITS) + decks_offset)
+#define DECK_TO_ADDR(c) (CELL*)(((CELL)(c) - decks_offset)<<DECK_BITS)
+
+#define DECK_TO_CARD(d) (F_CARD*)((((CELL)(d) - decks_offset) << (DECK_BITS - CARD_BITS)) + cards_offset)
+
+void init_card_decks(void);
+
 /* this is an inefficient write barrier. compiled definitions use a more
 efficient one hand-coded in assembly. the write barrier must be called
 any time we are potentially storing a pointer from an older generation
@@ -89,7 +102,10 @@ to a younger one */
 INLINE void write_barrier(CELL address)
 {
 	F_CARD *c = ADDR_TO_CARD(address);
-	*c |= (CARD_POINTS_TO_NURSERY | CARD_POINTS_TO_AGING);
+	*c |= CARD_MARK_MASK;
+
+	F_DECK *d = ADDR_TO_DECK(address);
+	*d = CARD_MARK_MASK ;
 }
 
 #define SLOT(obj,slot) (UNTAG(obj) + (slot) * CELLS)
@@ -122,6 +138,8 @@ void collect_cards(void);
 /* the oldest generation */
 #define TENURED (data_heap->gen_count-1)
 
+#define MAX_GEN_COUNT 3
+
 /* used during garbage collection only */
 F_ZONE *newspace;
 
@@ -142,10 +160,18 @@ void init_data_heap(CELL gens,
 	bool secure_gc_);
 
 /* statistics */
-s64 gc_time;
-CELL nursery_collections;
-CELL aging_collections;
-CELL cards_scanned;
+typedef struct {
+	CELL collections;
+	CELL gc_time;
+	CELL max_gc_time;
+	CELL object_count;
+	u64 bytes_copied;
+} F_GC_STATS;
+
+F_GC_STATS gc_stats[MAX_GEN_COUNT];
+u64 cards_scanned;
+u64 decks_scanned;
+CELL code_heap_scans;
 
 /* only meaningful during a GC */
 bool performing_gc;
@@ -364,7 +390,8 @@ INLINE void* allot_object(CELL type, CELL a)
 CELL collect_next(CELL scan);
 
 DECLARE_PRIMITIVE(gc);
-DECLARE_PRIMITIVE(gc_time);
+DECLARE_PRIMITIVE(gc_stats);
+DECLARE_PRIMITIVE(gc_reset);
 DECLARE_PRIMITIVE(become);
 
 CELL find_all_words(void);
diff --git a/vm/primitives.c b/vm/primitives.c
index da04870ecd..133ca38567 100755
--- a/vm/primitives.c
+++ b/vm/primitives.c
@@ -91,7 +91,7 @@ void *primitives[] = {
 	primitive_existsp,
 	primitive_read_dir,
 	primitive_gc,
-	primitive_gc_time,
+	primitive_gc_stats,
 	primitive_save_image,
 	primitive_save_image_and_exit,
 	primitive_datastack,
@@ -186,4 +186,5 @@ void *primitives[] = {
 	primitive_resize_float_array,
 	primitive_dll_validp,
 	primitive_unimplemented,
+	primitive_gc_reset,
 };