From 82fd581e9fdd8fdf214bca1fd671e686e0494b10 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Sun, 13 Jan 2008 10:41:35 -0500
Subject: [PATCH 01/18] Fix circular doc errors

---
 extra/editors/vim/vim-docs.factor            |  4 ++--
 extra/math/statistics/statistics-docs.factor | 21 ++++++++++----------
 2 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/extra/editors/vim/vim-docs.factor b/extra/editors/vim/vim-docs.factor
index 9f141f524f..020117564d 100644
--- a/extra/editors/vim/vim-docs.factor
+++ b/extra/editors/vim/vim-docs.factor
@@ -1,5 +1,5 @@
-USING: definitions editors.vim help help.markup help.syntax io io.files
-editors words ;
+USING: definitions help help.markup help.syntax io io.files editors words ;
+IN: editors.vim
 
 ARTICLE: { "vim" "vim" } "Vim support"
 "This module makes the " { $link edit } " word work with Vim by setting the " { $link edit-hook } " global variable to call " { $link vim-location } ". The " { $link vim-path } " variable contains the name of the vim executable.  The default " { $link vim-path } " is " { $snippet "\"gvim\"" } "."
diff --git a/extra/math/statistics/statistics-docs.factor b/extra/math/statistics/statistics-docs.factor
index bb92178e6d..4787a85aed 100644
--- a/extra/math/statistics/statistics-docs.factor
+++ b/extra/math/statistics/statistics-docs.factor
@@ -1,49 +1,50 @@
-USING: math.statistics help.markup help.syntax debugger ;
+USING: help.markup help.syntax debugger ;
+IN: math.statistics
 
 HELP: geometric-mean
 { $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
 { $description "Computes the geometric mean of all elements in " { $snippet "seq" } ".  The geometric mean measures the central tendency of a data set that minimizes the effects of extreme values." }
-{ $examples { $example "USE: math.statistics" "{ 1 2 3 } geometric-mean ." "1.81712059283214" } } 
+{ $examples { $example "USE: math.statistics" "{ 1 2 3 } geometric-mean ." "1.81712059283214" } }
 { $errors "Throws a " { $link signal-error. } " (square-root of 0) if the sequence is empty." } ;
 
 HELP: harmonic-mean
 { $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
 { $description "Computes the harmonic mean of the elements in " { $snippet "seq" } ".  The harmonic mean is appropriate when the average of rates is desired." }
-{ $examples { $example "USE: math.statistics" "{ 1 2 3 } harmonic-mean ." "6/11" } } 
+{ $examples { $example "USE: math.statistics" "{ 1 2 3 } harmonic-mean ." "6/11" } }
 { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
 
 HELP: mean
 { $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
 { $description "Computes the arithmetic mean of all elements in " { $snippet "seq" } "." }
-{ $examples { $example "USE: math.statistics" "{ 1 2 3 } mean ." "2" } } 
+{ $examples { $example "USE: math.statistics" "{ 1 2 3 } mean ." "2" } }
 { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
 
 HELP: median
 { $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
 { $description "Computes the median of " { $snippet "seq" } " by sorting the sequence from lowest value to highest and outputting the middle one. If there is an even number of elements in the sequence, the median is not unique, so the mean of the two middle values is outputted." }
-{ $examples 
+{ $examples
   { $example "USE: math.statistics" "{ 1 2 3 } median ." "2" }
-  { $example "USE: math.statistics" "{ 1 2 3 4 } median ." "5/2" } } 
+  { $example "USE: math.statistics" "{ 1 2 3 4 } median ." "5/2" } }
 { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ;
 
 HELP: range
 { $values { "seq" "a sequence of numbers" } { "n" "a non-negative real number"} }
 { $description "Computes the distance of the maximum and minimum values in " { $snippet "seq" } "." }
-{ $examples 
+{ $examples
   { $example "USE: math.statistics" "{ 1 2 3 } range ." "2" }
   { $example "USE: math.statistics" "{ 1 2 3 4 } range ." "3" } }  ;
 
 HELP: std
 { $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
 { $description "Computes the standard deviation of " { $snippet "seq" } " by squaring the variance of the sequence.  It measures how widely spread the values in a sequence are about the mean." }
-{ $examples 
+{ $examples
   { $example "USE: math.statistics" "{ 1 2 3 } std ." "1.0" }
   { $example "USE: math.statistics" "{ 1 2 3 4 } std ." "1.290994448735806" } } ;
 
 HELP: ste
   { $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
   { $description "Computes the standard error of the mean for " { $snippet "seq" } ".  It's defined as the standard deviation divided by the square root of the length of the sequence, and measures uncertainty associated with the estimate of the mean." }
-  { $examples 
+  { $examples
     { $example "USE: math.statistics" "{ -2 2 } ste ." "2.0" }
     { $example "USE: math.statistics" "{ -2 2 2 } ste ." "1.333333333333333" } } ;
 
@@ -51,7 +52,7 @@ HELP: var
 { $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} }
 { $description "Computes the variance of " { $snippet "seq" } ".  It's a measurement of the spread of values in a sequence.  The larger the variance, the larger the distance of values from the mean." }
 { $notes "If the number of elements in " { $snippet "seq" } " is 1 or less, it outputs 0." }
-{ $examples 
+{ $examples
   { $example "USE: math.statistics" "{ 1 } var ." "0" }
   { $example "USE: math.statistics" "{ 1 2 3 } var ." "1" }
   { $example "USE: math.statistics" "{ 1 2 3 4 } var ." "5/3" } } ;

From c27d17e1ec7e15672ece8e258c7b82ee0d0e54f2 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jjjj.local>
Date: Sun, 13 Jan 2008 10:33:36 -1000
Subject: [PATCH 02/18] unbreak singleton?

---
 extra/sequences/lib/lib.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index 37b00042d2..e46ce3b107 100755
--- a/extra/sequences/lib/lib.factor
+++ b/extra/sequences/lib/lib.factor
@@ -59,7 +59,7 @@ IN: sequences.lib
     ] { } make ;
 
 : singleton? ( seq -- ? )
-    length 1 = ; foldable
+    length 1 = ;
 
 : delete-random ( seq -- value )
     [ length random ] keep [ nth ] 2keep delete-nth ;

From 952c559b52a52e92a299fcec1bd769a4d9128698 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 13 Jan 2008 17:07:59 -0500
Subject: [PATCH 03/18] Faster compilation of dispatch primitive

---
 core/compiler/test/simple.factor              |  6 ++
 core/cpu/architecture/architecture.factor     | 15 ++++-
 core/cpu/ppc/architecture/architecture.factor | 55 +++++++++++++------
 core/cpu/ppc/intrinsics/intrinsics.factor     | 38 ++++++-------
 core/generator/fixup/fixup.factor             |  7 +++
 core/generator/generator.factor               | 47 +++++++++-------
 core/inference/class/class-tests.factor       | 21 ++++---
 core/optimizer/known-words/known-words.factor |  6 +-
 vm/code_heap.c                                |  2 +
 vm/code_heap.h                                |  4 +-
 10 files changed, 129 insertions(+), 72 deletions(-)

diff --git a/core/compiler/test/simple.factor b/core/compiler/test/simple.factor
index 7ce82c9a1f..9f831bb1f8 100755
--- a/core/compiler/test/simple.factor
+++ b/core/compiler/test/simple.factor
@@ -63,3 +63,9 @@ IN: temporary
 ! Regression
 
 [ ] [ [ callstack ] compile-call drop ] unit-test
+
+! Regression
+
+: empty ;
+
+[ "b" ] [ 1 [ empty { [ "a" ] [ "b" ] } dispatch ] compile-call ] unit-test
diff --git a/core/cpu/architecture/architecture.factor b/core/cpu/architecture/architecture.factor
index 3550dcadc0..2409eafaf0 100755
--- a/core/cpu/architecture/architecture.factor
+++ b/core/cpu/architecture/architecture.factor
@@ -51,19 +51,28 @@ HOOK: %save-dispatch-xt compiler-backend ( -- )
 
 M: object %save-dispatch-xt %save-word-xt ;
 
+! Call C primitive
+HOOK: %call-primitive compiler-backend ( label -- )
+
 ! Call another label
 HOOK: %call-label compiler-backend ( label -- )
 
+! Far jump to C primitive
+HOOK: %jump-primitive compiler-backend ( label -- )
+
 ! Local jump for branches
 HOOK: %jump-label compiler-backend ( label -- )
 
 ! Test if vreg is 'f' or not
 HOOK: %jump-t compiler-backend ( label -- )
 
-! We pass the offset of the jump table start in the world table
-HOOK: %call-dispatch compiler-backend ( word-table# -- )
+HOOK: %call-dispatch compiler-backend ( -- label )
 
-HOOK: %jump-dispatch compiler-backend ( word-table# -- )
+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 e93d092b10..a156c173a1 100755
--- a/core/cpu/ppc/architecture/architecture.factor
+++ b/core/cpu/ppc/architecture/architecture.factor
@@ -97,6 +97,22 @@ M: ppc-backend %epilogue ( n -- )
     1 1 rot ADDI
     0 MTLR ;
 
+: %prepare-primitive ( word -- )
+    #! Save stack pointer to stack_chain->callstack_top, load XT
+    4 1 MR
+    0 11 LOAD32
+    rc-absolute-ppc-2/2 rel-primitive ;
+
+: (%call) 11 MTLR BLRL ;
+
+M: ppc-backend %call-primitive ( word -- )
+    %prepare-primitive (%call) ;
+
+: (%jump) 11 MTCTR BCTR ;
+
+M: ppc-backend %jump-primitive ( word -- )
+    %prepare-primitive (%jump) ;
+
 : %load-dlsym ( symbol dll register -- )
     0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ;
 
@@ -107,26 +123,29 @@ M: ppc-backend %jump-label ( label -- ) B ;
 M: ppc-backend %jump-t ( label -- )
     0 "flag" operand f v>operand CMPI BNE ;
 
-: (%call) 11 MTLR BLRL ;
-
-: dispatch-template ( word-table# quot -- )
-    [
-        >r
-        "offset" operand "n" operand 1 SRAWI
-        0 11 LOAD32 rc-absolute-ppc-2/2 rel-dispatch
-        11 dup "offset" operand LWZX
-        11 dup word-xt-offset LWZ
-        r> call
-    ] H{
-        { +input+ { { f "n" } } }
-        { +scratch+ { { f "offset" } } }
-    } with-template ; inline
+: (%dispatch) ( len -- )
+    0 11 LOAD32 rc-absolute-ppc-2/2 rel-here
+    "offset" operand "n" operand 1 SRAWI
+    11 11 "offset" operand ADD
+    11 dup rot cells LWZ ;
 
 M: ppc-backend %call-dispatch ( word-table# -- )
-    [ (%call) ] dispatch-template ;
+    [ 7 (%dispatch) (%call) <label> dup B ] H{
+        { +input+ { { f "n" } } }
+        { +scratch+ { { f "offset" } } }
+    } with-template ;
 
-M: ppc-backend %jump-dispatch ( word-table# -- )
-    [ %epilogue-later 11 MTCTR BCTR ] dispatch-template ;
+M: ppc-backend %jump-dispatch ( -- )
+    [ %epilogue-later 6 (%dispatch) (%jump) ] H{
+        { +input+ { { f "n" } } }
+        { +scratch+ { { f "offset" } } }
+    } with-template ;
+
+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 ;
 
@@ -271,7 +290,7 @@ M: ppc-backend %cleanup ( alien-node -- ) drop ;
 
 : %tag-fixnum ( src dest -- ) tag-bits get SLWI ;
 
-: %untag-fixnum ( src dest -- ) tag-bits get SRAWI ;
+: %untag-fixnum ( dest src -- ) tag-bits get SRAWI ;
 
 M: ppc-backend value-structs?
     #! On Linux/PPC, value structs are passed in the same way
diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor
index 34197fdef3..0773dae947 100755
--- a/core/cpu/ppc/intrinsics/intrinsics.factor
+++ b/core/cpu/ppc/intrinsics/intrinsics.factor
@@ -23,8 +23,8 @@ IN: cpu.ppc.intrinsics
 
 : %slot-any
     "obj" operand "scratch" operand %untag
-    "n" operand dup 1 SRAWI
-    "scratch" operand "val" operand "n" operand ;
+    "offset" operand "n" operand 1 SRAWI
+    "scratch" operand "val" operand "offset" operand ;
 
 \ slot {
     ! Slot number is literal and the tag is known
@@ -47,9 +47,8 @@ IN: cpu.ppc.intrinsics
     {
         [ %slot-any LWZX ] H{
             { +input+ { { f "obj" } { f "n" } } }
-            { +scratch+ { { f "val" } { f "scratch" } } }
+            { +scratch+ { { f "val" } { f "scratch" } { f "offset" } } }
             { +output+ { "val" } }
-            { +clobber+ { "n" } }
         }
     }
 } define-intrinsics
@@ -88,33 +87,34 @@ IN: cpu.ppc.intrinsics
     {
         [ %slot-any STWX %write-barrier ] H{
             { +input+ { { f "val" } { f "obj" } { f "n" } } }
-            { +scratch+ { { f "scratch" } } }
-            { +clobber+ { "val" "n" } }
+            { +scratch+ { { f "scratch" } { f "offset" } } }
+            { +clobber+ { "val" } }
         }
     }
 } define-intrinsics
 
+: (%char-slot)
+    "offset" operand "n" operand 2 SRAWI
+    "offset" operand dup "obj" operand ADD ;
+
 \ char-slot [
-    "out" operand "obj" operand MR
-    "n" operand dup 2 SRAWI
-    "n" operand "obj" operand "n" operand ADD
-    "out" operand "n" operand string-offset LHZ
+    (%char-slot)
+    "out" operand "offset" operand string-offset LHZ
     "out" operand dup %tag-fixnum
 ] H{
     { +input+ { { f "n" } { f "obj" } } }
-    { +scratch+ { { f "out" } } }
+    { +scratch+ { { f "out" } { f "offset" } } }
     { +output+ { "out" } }
-    { +clobber+ { "n" } }
 } define-intrinsic
 
 \ set-char-slot [
+    (%char-slot)
     "val" operand dup %untag-fixnum
-    "slot" operand dup 2 SRAWI
-    "slot" operand dup "obj" operand ADD
-    "val" operand "slot" operand string-offset STH
+    "val" operand "offset" operand string-offset STH
 ] H{
-    { +input+ { { f "val" } { f "slot" } { f "obj" } } }
-    { +clobber+ { "val" "slot" } }
+    { +input+ { { f "val" } { f "n" } { f "obj" } } }
+    { +scratch+ { { f "offset" } } }
+    { +clobber+ { "val" } }
 } define-intrinsic
 
 : fixnum-register-op ( op -- pair )
@@ -185,10 +185,10 @@ IN: cpu.ppc.intrinsics
     {
         [
             { "positive" "end" } [ define-label ] each
-            "y" operand "out" operand swap %untag-fixnum
+            "out" operand "y" operand %untag-fixnum
             0 "y" operand 0 CMPI
             "positive" get BGE
-            "y" operand dup NEG
+            "out" operand dup NEG
             "out" operand "x" operand "out" operand SRAW
             "end" get B
             "positive" resolve-label
diff --git a/core/generator/fixup/fixup.factor b/core/generator/fixup/fixup.factor
index 78dd3f73df..3a30a51d09 100755
--- a/core/generator/fixup/fixup.factor
+++ b/core/generator/fixup/fixup.factor
@@ -69,6 +69,7 @@ SYMBOL: label-table
 : rt-literal   2 ;
 : rt-dispatch  3 ;
 : rt-xt        4 ;
+: rt-here      5 ;
 : rt-label     6 ;
 
 TUPLE: label-fixup label class ;
@@ -129,12 +130,18 @@ SYMBOL: word-table
 : rel-word ( word class -- )
     >r add-word r> rt-xt rel-fixup ;
 
+: rel-primitive ( word class -- )
+    >r word-def first r> rt-primitive rel-fixup ;
+
 : rel-literal ( literal class -- )
     >r add-literal r> rt-literal rel-fixup ;
 
 : rel-this ( class -- )
     0 swap rt-label rel-fixup ;
 
+: rel-here ( class -- )
+    0 swap rt-here rel-fixup ;
+
 : init-fixup ( -- )
     V{ } clone relocation-table set
     V{ } clone label-table set ;
diff --git a/core/generator/generator.factor b/core/generator/generator.factor
index 888cbdccaf..1c23e51e12 100755
--- a/core/generator/generator.factor
+++ b/core/generator/generator.factor
@@ -104,14 +104,21 @@ UNION: #terminal
 ! node
 M: node generate-node drop iterate-next ;
 
-: %call ( word -- ) %call-label ;
+: %call ( word -- )
+    dup primitive? [ %call-primitive ] [ %call-label ] if ;
 
 : %jump ( word -- )
-    dup compiling-label get eq? [
-        drop current-label-start get %jump-label
-    ] [
-        %epilogue-later %jump-label
-    ] if ;
+    {
+        { [ dup compiling-label get eq? ] [
+            drop current-label-start get %jump-label
+        ] }
+        { [ dup primitive? ] [
+            %epilogue-later %jump-primitive
+        ] }
+        { [ t ] [
+            %epilogue-later %jump-label
+        ] }
+    } cond ;
 
 : generate-call ( label -- next )
     dup maybe-compile
@@ -162,22 +169,22 @@ M: #if generate-node
         ] generate-1
     ] keep ;
 
-: dispatch-branches ( node -- syms )
-    node-children
-    [ compiling-word get dispatch-branch ] map
-    word-table get push-all ;
-
-: %dispatch ( word-table# -- )
-    tail-call? [
-        %jump-dispatch
-    ] [
-        0 frame-required
-        %call-dispatch
-    ] if ;
+: dispatch-branches ( node -- )
+    node-children [
+        compiling-word get dispatch-branch %dispatch-label
+    ] each ;
 
 M: #dispatch generate-node
-    word-table get length %dispatch
-    dispatch-branches init-templates iterate-next ;
+    #! The order here is important, dispatch-branches must
+    #! run after %dispatch, so that each branch gets the
+    #! correct register state
+    tail-call? [
+        %jump-dispatch dispatch-branches
+    ] [
+        0 frame-required
+        %call-dispatch >r dispatch-branches r> %end-dispatch
+    ] if
+    init-templates iterate-next ;
 
 ! #call
 : define-intrinsics ( word intrinsics -- )
diff --git a/core/inference/class/class-tests.factor b/core/inference/class/class-tests.factor
index 16d9fae36a..3bd90a3aca 100755
--- a/core/inference/class/class-tests.factor
+++ b/core/inference/class/class-tests.factor
@@ -3,7 +3,8 @@ USING: arrays math.private kernel math compiler inference
 inference.dataflow optimizer tools.test kernel.private generic
 sequences words inference.class quotations alien
 alien.c-types strings sbufs sequences.private
-slots.private combinators definitions compiler.units ;
+slots.private combinators definitions compiler.units
+system ;
 
 ! Make sure these compile even though this is invalid code
 [ ] [ [ 10 mod 3.0 /i ] dataflow optimize drop ] unit-test
@@ -251,12 +252,14 @@ M: fixnum annotate-entry-test-1 drop ;
     \ fixnum-shift inlined?
 ] unit-test
 
-[ t ] [
-    [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
-    \ shift inlined?
-] unit-test
+cell-bits 32 = [
+    [ t ] [
+        [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
+        \ shift inlined?
+    ] unit-test
 
-[ f ] [
-    [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
-    \ fixnum-shift inlined?
-] unit-test
+    [ f ] [
+        [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
+        \ fixnum-shift inlined?
+    ] unit-test
+] when
diff --git a/core/optimizer/known-words/known-words.factor b/core/optimizer/known-words/known-words.factor
index e9e4c53632..1d8395d667 100755
--- a/core/optimizer/known-words/known-words.factor
+++ b/core/optimizer/known-words/known-words.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: optimizer.known-words
 USING: alien arrays generic hashtables inference.dataflow
@@ -149,6 +149,10 @@ float-arrays combinators.private combinators ;
 
 \ >array { { string vector } } "specializer" set-word-prop
 
+\ >vector { { array vector } } "specializer" set-word-prop
+
+\ >sbuf { string } "specializer" set-word-prop
+
 \ crc32 { string } "specializer" set-word-prop
 
 \ split, { string string } "specializer" set-word-prop
diff --git a/vm/code_heap.c b/vm/code_heap.c
index 7cfdffe8ca..ddd7efb4a0 100755
--- a/vm/code_heap.c
+++ b/vm/code_heap.c
@@ -52,6 +52,8 @@ INLINE CELL compute_code_rel(F_REL *rel,
 		return CREF(words_start,REL_ARGUMENT(rel));
 	case RT_XT:
 		return (CELL)untag_word(get(CREF(words_start,REL_ARGUMENT(rel))))->xt;
+	case RT_HERE:
+		return rel->offset + code_start;
 	case RT_LABEL:
 		return code_start + REL_ARGUMENT(rel);
 	default:
diff --git a/vm/code_heap.h b/vm/code_heap.h
index c8e41d3fbe..d5b361e693 100755
--- a/vm/code_heap.h
+++ b/vm/code_heap.h
@@ -9,8 +9,8 @@ typedef enum {
 	RT_DISPATCH,
 	/* a compiled word reference */
 	RT_XT,
-	/* reserved */
-	RT_RESERVED,
+	/* current offset */
+	RT_HERE,
 	/* a local label */
 	RT_LABEL
 } F_RELTYPE;

From 2f32823690b99ce6ffda24aedb7fd82d882450e0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 13 Jan 2008 17:08:32 -0500
Subject: [PATCH 04/18] flushable declaration wasn't being printed

---
 core/prettyprint/prettyprint-tests.factor | 9 ++++++++-
 core/prettyprint/prettyprint.factor       | 1 +
 2 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/core/prettyprint/prettyprint-tests.factor b/core/prettyprint/prettyprint-tests.factor
index 595dfa88da..9c5ec885ae 100755
--- a/core/prettyprint/prettyprint-tests.factor
+++ b/core/prettyprint/prettyprint-tests.factor
@@ -290,6 +290,14 @@ unit-test
 
 [ ] [ \ effect-in synopsis drop ] unit-test
 
+! Regression
+[ t ] [
+    "IN: temporary\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
+    dup eval
+    "generic-decl-test" "temporary" lookup
+    [ see ] string-out =
+] unit-test
+
 [ [ + ] ] [
     [ \ + (step-into) ] (remove-breakpoints)
 ] unit-test
@@ -313,4 +321,3 @@ unit-test
 [ [ 2 . ] ] [
     [ 2 \ break (step-into) . ] (remove-breakpoints)
 ] unit-test
-
diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor
index 21104de5b6..45ff0c0572 100755
--- a/core/prettyprint/prettyprint.factor
+++ b/core/prettyprint/prettyprint.factor
@@ -207,6 +207,7 @@ M: word declarations.
         POSTPONE: delimiter
         POSTPONE: inline
         POSTPONE: foldable
+        POSTPONE: flushable
     } [ declaration. ] with each ;
 
 : pprint-; \ ; pprint-word ;

From b870bce81d78170f7cb52346b98d1e09ee87e54a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 13 Jan 2008 17:09:01 -0500
Subject: [PATCH 05/18] Add inline declarations

---
 core/sequences/sequences.factor | 2 +-
 core/vectors/vectors.factor     | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index a0c909bf56..151777b0c7 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -199,7 +199,7 @@ TUPLE: slice-error reason ;
 : <slice> ( from to seq -- slice )
     dup slice? [ collapse-slice ] when
     check-slice
-    slice construct-boa ;
+    slice construct-boa ; inline
 
 M: slice virtual-seq slice-seq ;
 M: slice virtual@ [ slice-from + ] keep slice-seq ;
diff --git a/core/vectors/vectors.factor b/core/vectors/vectors.factor
index 661ef9ddc8..8d52b8fa9c 100755
--- a/core/vectors/vectors.factor
+++ b/core/vectors/vectors.factor
@@ -7,7 +7,7 @@ IN: vectors
 
 : <vector> ( n -- vector ) f <array> 0 array>vector ; inline
 
-: >vector ( seq -- vector ) V{ } clone-like ; inline
+: >vector ( seq -- vector ) V{ } clone-like ;
 
 M: vector like
     drop dup vector? [

From 0d166264c89ff818e1ca42d649c63ab3a40c929a Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Sun, 13 Jan 2008 17:28:54 -0500
Subject: [PATCH 06/18] lint on Project Euler solutions

---
 extra/project-euler/006/006.factor | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/extra/project-euler/006/006.factor b/extra/project-euler/006/006.factor
index 2f09912412..fb4fb954fa 100644
--- a/extra/project-euler/006/006.factor
+++ b/extra/project-euler/006/006.factor
@@ -24,14 +24,18 @@ IN: project-euler.006
 ! SOLUTION
 ! --------
 
+<PRIVATE
+
 : sum-of-squares ( seq -- n )
     0 [ sq + ] reduce ;
 
-: square-of-sums ( seq -- n )
-    0 [ + ] reduce sq ;
+: square-of-sum ( seq -- n )
+    sum sq ;
+
+PRIVATE>
 
 : euler006 ( -- answer )
-    1 100 [a,b] dup sum-of-squares swap square-of-sums - abs ;
+    1 100 [a,b] dup sum-of-squares swap square-of-sum - abs ;
 
 ! [ euler006 ] 100 ave-time
 ! 0 ms run / 0 ms GC ave time - 100 trials

From 472cde4f75335f9a5558a89122fb9f7870d6c0ba Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 13 Jan 2008 18:52:14 -0500
Subject: [PATCH 07/18] Add unit test for regression

---
 core/kernel/kernel-tests.factor | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor
index 1c4c529749..2cb308b619 100755
--- a/core/kernel/kernel-tests.factor
+++ b/core/kernel/kernel-tests.factor
@@ -108,3 +108,13 @@ IN: temporary
 
 [ drop foo ] unit-test-fails
 [ ] [ :c ] unit-test
+
+! Regression
+: (loop) ( a b c d -- )
+    >r pick r> swap >r pick r> swap
+    < [ >r >r >r 1+ r> r> r> (loop) ] [ 2drop 2drop ] if ; inline
+
+: loop ( obj obj -- )
+    H{ } values swap >r dup length swap r> 0 -roll (loop) ;
+
+[ loop ] unit-test-fails

From 12b24af9343719b9c1c1b4c8e2c2c7d40654dbf9 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Mon, 14 Jan 2008 02:38:23 -0500
Subject: [PATCH 08/18] Simplify totient in math.primes.factors

---
 extra/math/primes/factors/factors.factor | 30 ++++++++++++------------
 1 file changed, 15 insertions(+), 15 deletions(-)

diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor
index b841d49f7d..66ec748535 100644
--- a/extra/math/primes/factors/factors.factor
+++ b/extra/math/primes/factors/factors.factor
@@ -6,36 +6,36 @@ IN: math.primes.factors
 <PRIVATE
 
 : (factor) ( n d -- n' )
-  2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
+    2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
 
 : (count) ( n d -- n' )
-  [ (factor) ] { } make
-  dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
+    [ (factor) ] { } make
+    dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
 
 : (unique) ( n d -- n' )
-  [ (factor) ] { } make
-  dup empty? [ drop ] [ first , ] if ;
+    [ (factor) ] { } make
+    dup empty? [ drop ] [ first , ] if ;
 
 : (factors) ( quot list n -- )
-  dup 1 > [ swap uncons >r pick call r> swap (factors) ] [ 3drop ] if ;
+    dup 1 > [ swap uncons >r pick call r> swap (factors) ] [ 3drop ] if ;
 
 : (decompose) ( n quot -- seq )
-  [ lprimes rot (factors) ] { } make ;
+    [ lprimes rot (factors) ] { } make ;
 
 PRIVATE>
 
 : factors ( n -- seq )
-  [ (factor) ] (decompose) ; foldable
+    [ (factor) ] (decompose) ; foldable
 
 : count-factors ( n -- seq )
-  [ (count) ] (decompose) ; foldable
+    [ (count) ] (decompose) ; foldable
 
 : unique-factors ( n -- seq )
-  [ (unique) ] (decompose) ; foldable
+    [ (unique) ] (decompose) ; foldable
 
 : totient ( n -- t )
-  dup 2 < [
-    drop 0
-  ] [
-   [ unique-factors dup 1 [ 1- * ] reduce swap product / ] keep *
-  ] if ; foldable
+    dup 2 < [
+        drop 0
+    ] [
+        dup unique-factors dup 1 [ 1- * ] reduce swap product / *
+    ] if ; foldable

From 75774188ea7a1db096bcabf6af19b08b4ca5aa03 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Mon, 14 Jan 2008 02:43:31 -0500
Subject: [PATCH 09/18] Solution to Project Euler problem 26

---
 extra/project-euler/026/026.factor       | 71 ++++++++++++++++++++++++
 extra/project-euler/project-euler.factor |  4 +-
 2 files changed, 73 insertions(+), 2 deletions(-)
 create mode 100644 extra/project-euler/026/026.factor

diff --git a/extra/project-euler/026/026.factor b/extra/project-euler/026/026.factor
new file mode 100644
index 0000000000..d79effed02
--- /dev/null
+++ b/extra/project-euler/026/026.factor
@@ -0,0 +1,71 @@
+! Copyright (c) 2007 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.functions math.primes math.ranges sequences ;
+IN: project-euler.026
+
+! http://projecteuler.net/index.php?section=problems&id=26
+
+! DESCRIPTION
+! -----------
+
+! A unit fraction contains 1 in the numerator. The decimal representation of
+! the unit fractions with denominators 2 to 10 are given:
+
+!     1/2  =  0.5
+!     1/3  =  0.(3)
+!     1/4  =  0.25
+!     1/5  =  0.2
+!     1/6  =  0.1(6)
+!     1/7  =  0.(142857)
+!     1/8  =  0.125
+!     1/9  =  0.(1)
+!     1/10 =  0.1
+
+! Where 0.1(6) means 0.166666..., and has a 1-digit recurring cycle. It can be
+! seen that 1/7 has a 6-digit recurring cycle.
+
+! Find the value of d < 1000 for which 1/d contains the longest recurring cycle
+! in its decimal fraction part.
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: source-026 ( -- seq )
+    1 1000 (a,b) [ prime? ] subset [ 1 swap / ] map ;
+
+: (mult-order) ( n a m -- k )
+    3dup ^ swap mod 1 = [ 2nip ] [ 1+ (mult-order) ] if ;
+
+PRIVATE>
+
+: coprime? ( m n -- ? )
+    gcd 1 = nip ;
+
+: recurring-period? ( a/b -- ? )
+    denominator 10 coprime? ;
+
+! Multiplicative order a.k.a. modulo order
+: mult-order ( a n -- k )
+    swap 1 (mult-order) ;
+
+: period-length ( a/b -- n )
+    dup recurring-period? [ denominator 10 swap mult-order ] [ drop 0 ] if ;
+
+<PRIVATE
+
+: max-period ( seq -- elt n )
+    dup [ period-length ] map dup supremum
+    over index [ swap nth ] curry 2apply ;
+
+PRIVATE>
+
+: euler026 ( -- answer )
+    source-026 max-period drop denominator ;
+
+! [ euler026 ] 100 ave-time
+! 724 ms run / 7 ms GC ave time - 100 trials
+
+MAIN: euler026
diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor
index 038ae3c5b8..6abb056d28 100644
--- a/extra/project-euler/project-euler.factor
+++ b/extra/project-euler/project-euler.factor
@@ -8,8 +8,8 @@ USING: definitions io io.files kernel math.parser sequences vocabs
     project-euler.013 project-euler.014 project-euler.015 project-euler.016
     project-euler.017 project-euler.018 project-euler.019 project-euler.020
     project-euler.021 project-euler.022 project-euler.023 project-euler.024
-    project-euler.025 project-euler.067 project-euler.134 project-euler.169
-    project-euler.173 project-euler.175 ;
+    project-euler.025 project-euler.026 project-euler.067 project-euler.134
+    project-euler.169 project-euler.173 project-euler.175 ;
 IN: project-euler
 
 <PRIVATE

From 15e9575cb69af8c9213ee5094df8fdebefb33277 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <wayo.cavazos@gmail.com>
Date: Mon, 14 Jan 2008 05:19:00 -0600
Subject: [PATCH 10/18] Mortar defined and used parsing words. Refactor this.

---
 extra/factory/factory-menus                    |  2 +-
 extra/factory/factory.factor                   |  2 +-
 extra/mortar/mortar.factor                     | 15 +++++++++++----
 extra/mortar/sugar/sugar.factor                |  6 ++++++
 extra/x/gc/gc.factor                           |  3 ++-
 extra/x/pen/pen.factor                         |  2 +-
 extra/x/widgets/button/button.factor           |  4 ++--
 extra/x/widgets/keymenu/keymenu.factor         |  2 +-
 extra/x/widgets/label/label.factor             |  2 +-
 extra/x/widgets/wm/frame/drag/move/move.factor |  2 +-
 extra/x/widgets/wm/frame/drag/size/size.factor |  2 +-
 extra/x/widgets/wm/frame/frame.factor          |  2 +-
 extra/x/widgets/wm/menu/menu.factor            |  2 +-
 13 files changed, 30 insertions(+), 16 deletions(-)
 create mode 100644 extra/mortar/sugar/sugar.factor

diff --git a/extra/factory/factory-menus b/extra/factory/factory-menus
index dd5dc29378..fa72fa6c9a 100644
--- a/extra/factory/factory-menus
+++ b/extra/factory/factory-menus
@@ -1,6 +1,6 @@
 ! -*-factor-*-
 
-USING: kernel unix vars mortar slot-accessors
+USING: kernel unix vars mortar mortar.sugar slot-accessors
        x.widgets.wm.menu x.widgets.wm.unmapped-frames-menu
        factory.commands factory.load ;
 
diff --git a/extra/factory/factory.factor b/extra/factory/factory.factor
index a5755c2a67..ca534f12c1 100644
--- a/extra/factory/factory.factor
+++ b/extra/factory/factory.factor
@@ -1,6 +1,6 @@
 
 USING: kernel parser io io.files namespaces sequences editors threads vars
-       mortar slot-accessors
+       mortar mortar.sugar slot-accessors
        x
        x.widgets.wm.root
        x.widgets.wm.frame 
diff --git a/extra/mortar/mortar.factor b/extra/mortar/mortar.factor
index c7522e1db6..b7862af7ac 100644
--- a/extra/mortar/mortar.factor
+++ b/extra/mortar/mortar.factor
@@ -128,7 +128,7 @@ over object-class class-methods 1 head* assoc-stack call ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: new* ( class -- object ) <<- create ;
+! : new* ( class -- object ) <<- create ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -136,13 +136,20 @@ IN: slot-accessors
 
 IN: mortar
 
+! : generate-slot-getter ( name -- )
+! "$" over append "slot-accessors" create swap [ slot-value ] curry
+! define-compound ;
+
 : generate-slot-getter ( name -- )
-"$" over append "slot-accessors" create swap [ slot-value ] curry
-define-compound ;
+"$" over append "slot-accessors" create swap [ slot-value ] curry define ;
+
+! : generate-slot-setter ( name -- )
+! ">>" over append "slot-accessors" create swap [ swap set-slot-value ] curry
+! define-compound ;
 
 : generate-slot-setter ( name -- )
 ">>" over append "slot-accessors" create swap [ swap set-slot-value ] curry
-define-compound ;
+define ;
 
 : generate-slot-accessors ( name -- )
 dup
diff --git a/extra/mortar/sugar/sugar.factor b/extra/mortar/sugar/sugar.factor
new file mode 100644
index 0000000000..04d2f6f651
--- /dev/null
+++ b/extra/mortar/sugar/sugar.factor
@@ -0,0 +1,6 @@
+
+USING: mortar ;
+
+IN: mortar.sugar
+
+: new* ( class -- object ) <<- create ;
\ No newline at end of file
diff --git a/extra/x/gc/gc.factor b/extra/x/gc/gc.factor
index 77e5313d00..8db610a1ac 100644
--- a/extra/x/gc/gc.factor
+++ b/extra/x/gc/gc.factor
@@ -1,5 +1,6 @@
 
-USING: kernel namespaces arrays x11.xlib mortar slot-accessors x x.font ;
+USING: kernel namespaces arrays x11.xlib mortar mortar.sugar
+       slot-accessors x x.font ;
 
 IN: x.gc
 
diff --git a/extra/x/pen/pen.factor b/extra/x/pen/pen.factor
index c4fc6cfa9f..59b8aeea44 100644
--- a/extra/x/pen/pen.factor
+++ b/extra/x/pen/pen.factor
@@ -1,5 +1,5 @@
 
-USING: kernel arrays math.vectors mortar x.gc slot-accessors geom.pos ;
+USING: kernel arrays math.vectors mortar mortar.sugar x.gc slot-accessors geom.pos ;
 
 IN: x.pen
 
diff --git a/extra/x/widgets/button/button.factor b/extra/x/widgets/button/button.factor
index b26431c4c2..ea46b62a69 100644
--- a/extra/x/widgets/button/button.factor
+++ b/extra/x/widgets/button/button.factor
@@ -1,6 +1,6 @@
 
 USING: kernel combinators math x11.xlib
-       mortar slot-accessors x.gc x.widgets.label ;
+       mortar mortar.sugar slot-accessors x.gc x.widgets.label ;
 
 IN: x.widgets.button
 
@@ -11,7 +11,7 @@ SYMBOL: <button>
   { "action-1" "action-2" "action-3" } accessors
 define-simple-class
 
-<button> "create" ( <button> -- button ) [
+<button> "create" !( <button> -- button ) [
 new-empty
 <gc> new* >>gc ExposureMask ButtonPressMask bitor >>mask <- init-widget
 ] add-class-method
diff --git a/extra/x/widgets/keymenu/keymenu.factor b/extra/x/widgets/keymenu/keymenu.factor
index 6c2fbb1e5c..b10f8f5593 100644
--- a/extra/x/widgets/keymenu/keymenu.factor
+++ b/extra/x/widgets/keymenu/keymenu.factor
@@ -1,6 +1,6 @@
 
 USING: kernel strings arrays sequences sequences.lib math x11.xlib
-       mortar slot-accessors x x.pen x.widgets ;
+       mortar mortar.sugar slot-accessors x x.pen x.widgets ;
 
 IN: x.widgets.keymenu
 
diff --git a/extra/x/widgets/label/label.factor b/extra/x/widgets/label/label.factor
index 11201ae9fc..39eff20221 100644
--- a/extra/x/widgets/label/label.factor
+++ b/extra/x/widgets/label/label.factor
@@ -1,5 +1,5 @@
 
-USING: kernel x11.xlib mortar slot-accessors x.gc x.widgets ;
+USING: kernel x11.xlib mortar mortar.sugar slot-accessors x.gc x.widgets ;
 
 IN: x.widgets.label
 
diff --git a/extra/x/widgets/wm/frame/drag/move/move.factor b/extra/x/widgets/wm/frame/drag/move/move.factor
index 2ebb5a7286..2a6d61596e 100644
--- a/extra/x/widgets/wm/frame/drag/move/move.factor
+++ b/extra/x/widgets/wm/frame/drag/move/move.factor
@@ -1,6 +1,6 @@
 
 USING: kernel combinators namespaces math.vectors x11.xlib x11.constants 
-       mortar slot-accessors x x.gc x.widgets.wm.frame.drag ;
+       mortar mortar.sugar slot-accessors x x.gc x.widgets.wm.frame.drag ;
 
 IN: x.widgets.wm.frame.drag.move
 
diff --git a/extra/x/widgets/wm/frame/drag/size/size.factor b/extra/x/widgets/wm/frame/drag/size/size.factor
index e98d75259a..5ef28e2a41 100644
--- a/extra/x/widgets/wm/frame/drag/size/size.factor
+++ b/extra/x/widgets/wm/frame/drag/size/size.factor
@@ -1,6 +1,6 @@
 
 USING: kernel combinators namespaces math.vectors x11.xlib x11.constants 
-       mortar slot-accessors geom.rect x x.gc x.widgets.wm.frame.drag ;
+       mortar mortar.sugar slot-accessors geom.rect x x.gc x.widgets.wm.frame.drag ;
 
 IN: x.widgets.wm.frame.drag.size
 
diff --git a/extra/x/widgets/wm/frame/frame.factor b/extra/x/widgets/wm/frame/frame.factor
index 0c0075ed3b..d8f08d8772 100644
--- a/extra/x/widgets/wm/frame/frame.factor
+++ b/extra/x/widgets/wm/frame/frame.factor
@@ -2,7 +2,7 @@
 USING: kernel io combinators namespaces quotations arrays sequences
        math math.vectors
        x11.xlib x11.constants
-       mortar slot-accessors
+       mortar mortar.sugar slot-accessors
        geom.rect
        x x.gc x.widgets
        x.widgets.button
diff --git a/extra/x/widgets/wm/menu/menu.factor b/extra/x/widgets/wm/menu/menu.factor
index e836b21374..ca79b35136 100644
--- a/extra/x/widgets/wm/menu/menu.factor
+++ b/extra/x/widgets/wm/menu/menu.factor
@@ -1,5 +1,5 @@
 
-USING: kernel x11.constants mortar slot-accessors x.widgets.keymenu ;
+USING: kernel x11.constants mortar mortar.sugar slot-accessors x.widgets.keymenu ;
 
 IN: x.widgets.wm.menu
 

From 8bc631f5ed3bbb4f7df8025ec149d6740a2495da Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Mon, 14 Jan 2008 11:33:08 -0500
Subject: [PATCH 11/18] Rename count-factors to group-factors and update docs

---
 extra/math/primes/factors/factors-docs.factor | 25 +++++++++++--------
 .../math/primes/factors/factors-tests.factor  |  2 +-
 extra/math/primes/factors/factors.factor      |  2 +-
 extra/project-euler/common/common.factor      |  2 +-
 4 files changed, 17 insertions(+), 14 deletions(-)

diff --git a/extra/math/primes/factors/factors-docs.factor b/extra/math/primes/factors/factors-docs.factor
index 2238420d32..f5b14b5a5a 100644
--- a/extra/math/primes/factors/factors-docs.factor
+++ b/extra/math/primes/factors/factors-docs.factor
@@ -1,20 +1,23 @@
-USING: help.markup help.syntax ;
+USING: help.markup help.syntax math sequences ;
 IN: math.primes.factors
 
-{ factors count-factors unique-factors } related-words
+{ factors group-factors unique-factors } related-words
 
 HELP: factors
-{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
-{ $description { "Factorize an integer and return an ordered list of factors, possibly repeated." } } ;
+{ $values { "n" "a positive integer" } { "seq" sequence } }
+{ $description { "Return an ordered list of a number's prime factors, possibly repeated." } }
+{ $examples { $example "300 factors ." "{ 2 2 3 5 5 }" } } ;
 
-HELP: count-factors
-{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
-{ $description { "Return a sequence of pairs representing each factor in the number and its corresponding power." } } ;
+HELP: group-factors
+{ $values { "n" "a positive integer" } { "seq" sequence } }
+{ $description { "Return a sequence of pairs representing each prime factor in the number and its corresponding power (multiplicity)." } }
+{ $examples { $example "300 group-factors ." "{ { 2 2 } { 3 1 } { 5 2 } }" } } ;
 
 HELP: unique-factors
-{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
-{ $description { "Return an ordered list of unique prime factors." } } ;
+{ $values { "n" "a positive integer" } { "seq" sequence } }
+{ $description { "Return an ordered list of a number's unique prime factors." } }
+{ $examples { $example "300 unique-factors ." "{ 2 3 5 }" } } ;
 
 HELP: totient
-{ $values { "n" "a positive integer" } { "t" "an integer" } }
-{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " relatively prime to " { $snippet "n" } "." } } ;
+{ $values { "n" "a positive integer" } { "t" integer } }
+{ $description { "Return the number of integers between 1 and " { $snippet "n-1" } " that are relatively prime to " { $snippet "n" } "." } } ;
diff --git a/extra/math/primes/factors/factors-tests.factor b/extra/math/primes/factors/factors-tests.factor
index 71bdd56a81..70b905f4ab 100644
--- a/extra/math/primes/factors/factors-tests.factor
+++ b/extra/math/primes/factors/factors-tests.factor
@@ -1,6 +1,6 @@
 USING: math.primes.factors tools.test ;
 
 { { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test
-{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 count-factors ] unit-test
+{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test
 { { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test
 { 999967000236000612 } [ 999969000187000867 totient ] unit-test
diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor
index 66ec748535..2f70ab24b4 100644
--- a/extra/math/primes/factors/factors.factor
+++ b/extra/math/primes/factors/factors.factor
@@ -27,7 +27,7 @@ PRIVATE>
 : factors ( n -- seq )
     [ (factor) ] (decompose) ; foldable
 
-: count-factors ( n -- seq )
+: group-factors ( n -- seq )
     [ (count) ] (decompose) ; foldable
 
 : unique-factors ( n -- seq )
diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor
index 6279606481..67cce7d31a 100644
--- a/extra/project-euler/common/common.factor
+++ b/extra/project-euler/common/common.factor
@@ -88,7 +88,7 @@ PRIVATE>
 
 ! The divisor function, counts the number of divisors
 : tau ( m -- n )
-    count-factors flip second 1 [ 1+ * ] reduce ;
+    group-factors flip second 1 [ 1+ * ] reduce ;
 
 ! Optimized brute-force, is often faster than prime factorization
 : tau* ( m -- n )

From 76558babf46a7155506cdc560b84177d851cad45 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Mon, 14 Jan 2008 15:04:21 -0500
Subject: [PATCH 12/18] Generalize factor-2s to eliminate special case
 exception

---
 extra/math/miller-rabin/miller-rabin.factor | 6 ++----
 extra/project-euler/common/common.factor    | 7 ++-----
 2 files changed, 4 insertions(+), 9 deletions(-)

diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor
index de5a262268..e2d012ec0a 100644
--- a/extra/math/miller-rabin/miller-rabin.factor
+++ b/extra/math/miller-rabin/miller-rabin.factor
@@ -26,10 +26,8 @@ TUPLE: positive-even-expected n ;
     dup even? [ -1 shift >r 1+ r> (factor-2s) ] when ;
 
 : factor-2s ( n -- r s )
-    #! factor an even number into s * 2 ^ r
-    dup even? over 0 > and [
-        positive-even-expected construct-boa throw
-    ] unless 0 swap (factor-2s) ;
+    #! factor an integer into s * 2^r
+    0 swap (factor-2s) ;
 
 :: (miller-rabin) | n prime?! |
     n 1- factor-2s s set r set
diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor
index 67cce7d31a..2bd2b7ec0b 100644
--- a/extra/project-euler/common/common.factor
+++ b/extra/project-euler/common/common.factor
@@ -34,9 +34,6 @@ IN: project-euler.common
 : propagate ( bottom top -- newtop )
     [ over 1 tail rot first2 max rot + ] map nip ;
 
-: reduce-2s ( n -- r s )
-    dup even? [ factor-2s >r 1+ r> ] [ 1 swap ] if ;
-
 : shift-3rd ( seq obj obj -- seq obj obj )
     rot 1 tail -rot ;
 
@@ -92,7 +89,7 @@ PRIVATE>
 
 ! Optimized brute-force, is often faster than prime factorization
 : tau* ( m -- n )
-    reduce-2s [ perfect-square? -1 0 ? ] keep
+    factor-2s [ 1+ ] dip [ perfect-square? -1 0 ? ] keep
     dup sqrt >fixnum [1,b] [
-        dupd mod zero? [ >r 2 + r> ] when
+        dupd mod zero? [ [ 2 + ] dip ] when
     ] each drop * ;

From 097dad070ae9000067324fe31889830f87534aeb Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jjjj.local>
Date: Mon, 14 Jan 2008 11:42:21 -1000
Subject: [PATCH 13/18] minor tweaks to make these modules load with
 load-everything

---
 extra/channels/channels-docs.factor           |  2 +-
 extra/channels/remote/remote-docs.factor      |  4 ++--
 extra/channels/sniffer/backend/backend.factor |  3 +++
 extra/channels/sniffer/bsd/bsd.factor         |  5 +++--
 extra/channels/sniffer/sniffer.factor         |  4 +---
 extra/coroutines/coroutines-docs.factor       |  5 +++--
 extra/cryptlib/libcl/libcl.factor             |  7 ++-----
 extra/crypto/md5/md5-docs.factor              |  3 ++-
 extra/hardware-info/backend/backend.factor    | 14 +++++++++++++
 extra/hardware-info/hardware-info.factor      | 21 +++++--------------
 extra/hardware-info/macosx/macosx.factor      |  2 +-
 extra/hardware-info/windows/ce/ce.factor      |  5 ++---
 extra/hardware-info/windows/nt/nt.factor      |  2 +-
 extra/hardware-info/windows/windows.factor    |  9 ++++----
 extra/html/parser/utils/utils.factor          |  1 -
 .../basic-authentication-docs.factor          |  5 +++--
 extra/id3/id3-docs.factor                     |  3 ++-
 extra/inverse/inverse-docs.factor             |  3 ++-
 extra/inverse/inverse.factor                  |  4 +++-
 extra/io/sniffer/backend/backend.factor       |  6 ++++++
 extra/io/sniffer/bsd/bsd.factor               |  4 ++--
 .../io/sniffer/filter/backend/backend.factor  | 17 +++++++++++++++
 extra/io/sniffer/filter/bsd/bsd.factor        |  5 +++--
 extra/io/sniffer/filter/filter.factor         | 15 ++-----------
 extra/io/sniffer/sniffer.factor               |  6 ------
 extra/jamshred/game/game.factor               |  2 +-
 extra/jamshred/player/player.factor           |  2 +-
 extra/json/reader/reader-docs.factor          |  5 +++--
 extra/json/writer/writer-docs.factor          |  3 ++-
 extra/json/writer/writer.factor               |  2 +-
 extra/lisp/listener/listener.factor           |  4 ++--
 extra/mad/mad.factor                          |  7 ++-----
 .../simple/simple-docs.factor                 |  4 ++--
 extra/xml-rpc/xml-rpc-docs.factor             |  3 ++-
 34 files changed, 101 insertions(+), 86 deletions(-)
 create mode 100644 extra/channels/sniffer/backend/backend.factor
 create mode 100644 extra/hardware-info/backend/backend.factor
 create mode 100644 extra/io/sniffer/backend/backend.factor
 create mode 100644 extra/io/sniffer/filter/backend/backend.factor

diff --git a/extra/channels/channels-docs.factor b/extra/channels/channels-docs.factor
index 8487d59e7f..521a4a4ae2 100644
--- a/extra/channels/channels-docs.factor
+++ b/extra/channels/channels-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 channels ;
+USING: help.syntax help.markup ;
 IN: channels
 
 HELP: <channel>
diff --git a/extra/channels/remote/remote-docs.factor b/extra/channels/remote/remote-docs.factor
index 5400f147f4..862084e1d9 100644
--- a/extra/channels/remote/remote-docs.factor
+++ b/extra/channels/remote/remote-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 channels channels.remote concurrency.distributed ;
+USING: help.syntax help.markup channels concurrency.distributed ;
 IN: channels.remote
 
 HELP: <remote-channel>
@@ -59,4 +59,4 @@ $nl
 { $snippet "\"myhost.com\" 9001 <node> \"ID123456\" <remote-channel>\n\"hello\" over to" } 
 ;
 
-ABOUT: { "remote-channels" "remote-channels" }
\ No newline at end of file
+ABOUT: { "remote-channels" "remote-channels" }
diff --git a/extra/channels/sniffer/backend/backend.factor b/extra/channels/sniffer/backend/backend.factor
new file mode 100644
index 0000000000..c7c2e420cb
--- /dev/null
+++ b/extra/channels/sniffer/backend/backend.factor
@@ -0,0 +1,3 @@
+USING: io.backend ;
+
+HOOK: sniff-channel io-backend ( -- channel ) 
diff --git a/extra/channels/sniffer/bsd/bsd.factor b/extra/channels/sniffer/bsd/bsd.factor
index ba8e5ceeb9..0ba267bb03 100644
--- a/extra/channels/sniffer/bsd/bsd.factor
+++ b/extra/channels/sniffer/bsd/bsd.factor
@@ -2,8 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 !
 ! Wrap a sniffer in a channel
-USING: kernel channels channels.sniffer concurrency io
-io.sniffer io.sniffer.bsd io.unix.backend ;
+USING: kernel channels channels.sniffer.backend concurrency io
+io.sniffer.backend io.sniffer.bsd io.unix.backend ;
+IN: channels.sniffer.bsd
 
 M: unix-io sniff-channel ( -- channel ) 
   "/dev/bpf0" "en1" <sniffer-spec> <sniffer> <channel> [
diff --git a/extra/channels/sniffer/sniffer.factor b/extra/channels/sniffer/sniffer.factor
index 8edd035cca..1502201225 100755
--- a/extra/channels/sniffer/sniffer.factor
+++ b/extra/channels/sniffer/sniffer.factor
@@ -3,11 +3,9 @@
 !
 ! Wrap a sniffer in a channel
 USING: kernel channels concurrency io io.backend
-io.sniffer system vocabs.loader ;
+io.sniffer io.sniffer.backend system vocabs.loader ;
 
 : (sniff-channel) ( stream channel -- ) 
   4096 pick stream-read-partial over to (sniff-channel) ;
 
-HOOK: sniff-channel io-backend ( -- channel ) 
-
 bsd? [ "channels.sniffer.bsd" require ] when
diff --git a/extra/coroutines/coroutines-docs.factor b/extra/coroutines/coroutines-docs.factor
index ed3788db48..327c60e017 100644
--- a/extra/coroutines/coroutines-docs.factor
+++ b/extra/coroutines/coroutines-docs.factor
@@ -1,5 +1,6 @@
 ! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither.
-USING: help.markup help.syntax coroutines ;
+USING: help.markup help.syntax ;
+IN: coroutines
 
 HELP: cocreate
 { $values { "quot" "a quotation with stack effect ( value -- )" } { "co" "a coroutine" } }
@@ -51,4 +52,4 @@ HELP: coterminate
 HELP: current-coro
 { $description "Variable which contains the currently executing coroutine, or " { $link f } " if none is executing. User code should treat this variable as read-only." }
 { $see-also cocreate coresume coyield }
-;
\ No newline at end of file
+;
diff --git a/extra/cryptlib/libcl/libcl.factor b/extra/cryptlib/libcl/libcl.factor
index 3cc0d50095..38e6817f6c 100644
--- a/extra/cryptlib/libcl/libcl.factor
+++ b/extra/cryptlib/libcl/libcl.factor
@@ -12,14 +12,11 @@ USING: alien kernel system combinators alien.syntax ;
 
 IN: cryptlib.libcl
 
-: load-libcl ( -- )
-    "libcl" {
+<< "libcl" {
         { [ win32? ] [ "cl32.dll" "stdcall" ] }
         { [ macosx? ] [ "libcl.dylib" "cdecl" ] }
         { [ unix? ] [ "libcl.so" "cdecl" ] }
-    } cond add-library ; parsing
-
-load-libcl
+    } cond add-library >>
 
 ! ===============================================
 ! Machine-dependant types
diff --git a/extra/crypto/md5/md5-docs.factor b/extra/crypto/md5/md5-docs.factor
index 53c737554b..fd8bf3f74d 100644
--- a/extra/crypto/md5/md5-docs.factor
+++ b/extra/crypto/md5/md5-docs.factor
@@ -1,5 +1,6 @@
 USING: help.markup help.syntax kernel math sequences quotations
-crypto.common crypto.md5 ;
+crypto.common ;
+IN: crypto.md5
 
 HELP: stream>md5
 { $values { "stream" "a stream" } { "byte-array" "md5 hash" } }
diff --git a/extra/hardware-info/backend/backend.factor b/extra/hardware-info/backend/backend.factor
new file mode 100644
index 0000000000..d79678de0c
--- /dev/null
+++ b/extra/hardware-info/backend/backend.factor
@@ -0,0 +1,14 @@
+IN: hardware-info.backend
+
+SYMBOL: os
+HOOK: cpus os ( -- n )
+
+HOOK: memory-load os ( -- n )
+HOOK: physical-mem os ( -- n )
+HOOK: available-mem os ( -- n )
+HOOK: total-page-file os ( -- n )
+HOOK: available-page-file os ( -- n )
+HOOK: total-virtual-mem os ( -- n )
+HOOK: available-virtual-mem os ( -- n )
+HOOK: available-virtual-extended-mem os ( -- n )
+
diff --git a/extra/hardware-info/hardware-info.factor b/extra/hardware-info/hardware-info.factor
index 9b3c969dc3..0515646a5f 100755
--- a/extra/hardware-info/hardware-info.factor
+++ b/extra/hardware-info/hardware-info.factor
@@ -1,26 +1,15 @@
-USING: alien.syntax math prettyprint system combinators
-vocabs.loader ;
+USING: alien.syntax kernel math prettyprint system
+combinators vocabs.loader hardware-info.backend ;
 IN: hardware-info
 
-SYMBOL: os
-HOOK: cpus os ( -- n )
-
-HOOK: memory-load os ( -- n )
-HOOK: physical-mem os ( -- n )
-HOOK: available-mem os ( -- n )
-HOOK: total-page-file os ( -- n )
-HOOK: available-page-file os ( -- n )
-HOOK: total-virtual-mem os ( -- n )
-HOOK: available-virtual-mem os ( -- n )
-HOOK: available-virtual-extended-mem os ( -- n )
-
 : kb. ( x -- ) 10 2^ /f . ;
 : megs. ( x -- ) 20 2^ /f . ;
 : gigs. ( x -- ) 30 2^ /f . ;
 
-{
+<< {
     { [ windows? ] [ "hardware-info.windows" ] }
     { [ linux? ] [ "hardware-info.linux" ] }
     { [ macosx? ] [ "hardware-info.macosx" ] }
-} cond require
+    { [ t ] [ f ] }
+} cond [ require ] when* >>
 
diff --git a/extra/hardware-info/macosx/macosx.factor b/extra/hardware-info/macosx/macosx.factor
index ad3060944e..c246a95186 100644
--- a/extra/hardware-info/macosx/macosx.factor
+++ b/extra/hardware-info/macosx/macosx.factor
@@ -1,5 +1,5 @@
 USING: alien alien.c-types alien.syntax byte-arrays kernel
-namespaces sequences unix hardware-info ;
+namespaces sequences unix hardware-info.backend ;
 IN: hardware-info.macosx
 
 TUPLE: macosx ;
diff --git a/extra/hardware-info/windows/ce/ce.factor b/extra/hardware-info/windows/ce/ce.factor
index 42fd9e5343..9fb15ef823 100644
--- a/extra/hardware-info/windows/ce/ce.factor
+++ b/extra/hardware-info/windows/ce/ce.factor
@@ -1,5 +1,6 @@
 USING: alien.c-types hardware-info hardware-info.windows
-kernel math namespaces windows windows.kernel32 ;
+kernel math namespaces windows windows.kernel32
+hardware-info.backend ;
 IN: hardware-info.windows.ce
 
 T{ wince } os set-global
@@ -29,5 +30,3 @@ M: wince total-virtual-mem ( -- n )
 
 M: wince available-virtual-mem ( -- n )
     memory-status MEMORYSTATUS-dwAvailVirtual ;
-
-
diff --git a/extra/hardware-info/windows/nt/nt.factor b/extra/hardware-info/windows/nt/nt.factor
index 2b2522e6ee..f412754cdf 100644
--- a/extra/hardware-info/windows/nt/nt.factor
+++ b/extra/hardware-info/windows/nt/nt.factor
@@ -1,5 +1,5 @@
 USING: alien alien.c-types hardware-info hardware-info.windows
-kernel libc math namespaces
+kernel libc math namespaces hardware-info.backend
 windows windows.advapi32 windows.kernel32 ;
 IN: hardware-info.windows.nt
 
diff --git a/extra/hardware-info/windows/windows.factor b/extra/hardware-info/windows/windows.factor
index 5352d64698..a49e4f254a 100755
--- a/extra/hardware-info/windows/windows.factor
+++ b/extra/hardware-info/windows/windows.factor
@@ -1,6 +1,6 @@
 USING: alien alien.c-types kernel libc math namespaces
-windows windows.kernel32 windows.advapi32 hardware-info
-words combinators vocabs.loader ;
+windows windows.kernel32 windows.advapi32
+words combinators vocabs.loader hardware-info.backend ;
 IN: hardware-info.windows
 
 TUPLE: wince ;
@@ -70,7 +70,8 @@ M: windows cpus ( -- n )
 : system-windows-directory ( -- str )
     \ GetSystemWindowsDirectory get-directory ;
 
-{
+<< {
     { [ wince? ] [ "hardware-info.windows.ce" ] }
     { [ winnt? ] [ "hardware-info.windows.nt" ] }
-} cond require
+    { [ t ] [ f ] }
+} cond [ require ] when* >>
diff --git a/extra/html/parser/utils/utils.factor b/extra/html/parser/utils/utils.factor
index febd1716ed..b574799b38 100644
--- a/extra/html/parser/utils/utils.factor
+++ b/extra/html/parser/utils/utils.factor
@@ -2,7 +2,6 @@ USING: assocs circular combinators continuations hashtables
 hashtables.private io kernel math
 namespaces prettyprint quotations sequences splitting
 state-parser strings ;
-USING: html.parser ;
 IN: html.parser.utils
 
 : string-parse-end?
diff --git a/extra/http/basic-authentication/basic-authentication-docs.factor b/extra/http/basic-authentication/basic-authentication-docs.factor
index 9add842db6..68d6e6bf1d 100644
--- a/extra/http/basic-authentication/basic-authentication-docs.factor
+++ b/extra/http/basic-authentication/basic-authentication-docs.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax http.basic-authentication crypto.sha2 ;
+USING: help.markup help.syntax crypto.sha2 ;
+IN: http.basic-authentication
 
 HELP: realms
 { $description 
@@ -65,4 +66,4 @@ $nl
 "it is best to use Basic Authentication with SSL."  ;
 
 IN: http.basic-authentication
-ABOUT: { "http-authentication" "basic-authentication" }
\ No newline at end of file
+ABOUT: { "http-authentication" "basic-authentication" }
diff --git a/extra/id3/id3-docs.factor b/extra/id3/id3-docs.factor
index 47edee7437..8083514c0d 100644
--- a/extra/id3/id3-docs.factor
+++ b/extra/id3/id3-docs.factor
@@ -1,6 +1,7 @@
 ! Coyright (C) 2007 Adam Wendt
 ! See http://factorcode.org/license.txt for BSD license.
-USING: id3 help.syntax help.markup ;
+USING: help.syntax help.markup ;
+IN: id3
 
 ARTICLE: "id3-tags" "ID3 Tags"
 "The " { $vocab-link "id3" } " vocabulary is used to read ID3 tags from MP3 audio streams."
diff --git a/extra/inverse/inverse-docs.factor b/extra/inverse/inverse-docs.factor
index f8ae3bfbdb..8204f7174c 100644
--- a/extra/inverse/inverse-docs.factor
+++ b/extra/inverse/inverse-docs.factor
@@ -1,4 +1,5 @@
-USING: inverse help.syntax help.markup ;
+USING: help.syntax help.markup ;
+IN: inverse
 
 HELP: [undo]
 { $values { "quot" "a quotation" } { "undo" "the inverse of the quotation" } }
diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor
index cade645dde..b97748514c 100644
--- a/extra/inverse/inverse.factor
+++ b/extra/inverse/inverse.factor
@@ -63,7 +63,9 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
     {
         { [ dup word? not over symbol? or ] [ , ] }
         { [ dup explicit-inverse? ] [ , ] }
-        { [ dup compound? over { if dispatch } member? not and ]
+        ! { [ dup compound? over { if dispatch } member? not and ]
+          ! [ word-def [ inline-word ] each ] }
+        { [ dup word? over { if dispatch } member? not and ]
           [ word-def [ inline-word ] each ] }
         { [ drop t ] [ "Quotation is not invertible" throw ] }
     } cond ;
diff --git a/extra/io/sniffer/backend/backend.factor b/extra/io/sniffer/backend/backend.factor
new file mode 100644
index 0000000000..53bf37a290
--- /dev/null
+++ b/extra/io/sniffer/backend/backend.factor
@@ -0,0 +1,6 @@
+USING: io.backend kernel system vocabs.loader ;
+IN: io.sniffer.backend
+
+SYMBOL: sniffer-type
+TUPLE: sniffer ;
+HOOK: <sniffer> io-backend ( obj -- sniffer )
diff --git a/extra/io/sniffer/bsd/bsd.factor b/extra/io/sniffer/bsd/bsd.factor
index 91266b7be3..6a0d092807 100644
--- a/extra/io/sniffer/bsd/bsd.factor
+++ b/extra/io/sniffer/bsd/bsd.factor
@@ -1,9 +1,9 @@
 ! Copyright (C) 2007 Elie Chaftari, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types alien.syntax destructors hexdump io
-io.buffers io.nonblocking io.sniffer io.sockets io.streams.lines
+io.buffers io.nonblocking io.sockets io.streams.lines
 io.unix.backend io.unix.files kernel libc locals math qualified
-sequences ;
+sequences io.sniffer.backend ;
 QUALIFIED: unix
 IN: io.sniffer.bsd
 
diff --git a/extra/io/sniffer/filter/backend/backend.factor b/extra/io/sniffer/filter/backend/backend.factor
new file mode 100644
index 0000000000..dade8bdebf
--- /dev/null
+++ b/extra/io/sniffer/filter/backend/backend.factor
@@ -0,0 +1,17 @@
+USING: byte-arrays combinators io io.backend
+io.sockets.headers io.sniffer.backend kernel
+prettyprint sequences ;
+IN: io.sniffer.filter.backend
+
+HOOK: sniffer-loop io-backend ( stream -- )
+HOOK: packet. io-backend ( string -- )
+
+: (packet.) ( string -- )
+    dup 14 head >byte-array
+    "--Ethernet Header--" print
+        dup etherneth.
+    dup etherneth-type {
+        ! HEX: 800 [ ] ! IP
+        ! HEX: 806 [ ] ! ARP
+        [ "Unknown type: " write .h ]
+    } case 2drop ;
diff --git a/extra/io/sniffer/filter/bsd/bsd.factor b/extra/io/sniffer/filter/bsd/bsd.factor
index c6882352d0..c18cae41e5 100644
--- a/extra/io/sniffer/filter/bsd/bsd.factor
+++ b/extra/io/sniffer/filter/bsd/bsd.factor
@@ -1,7 +1,8 @@
 USING: alien.c-types hexdump io io.backend io.sockets.headers
 io.sockets.headers.bsd kernel io.sniffer io.sniffer.bsd
-io.sniffer.filter io.streams.string io.unix.backend math
-sequences system byte-arrays ;
+io.streams.string io.unix.backend math
+sequences system byte-arrays io.sniffer.filter.backend
+io.sniffer.filter.backend io.sniffer.backend ;
 IN: io.sniffer.filter.bsd
 
 ! http://www.iana.org/assignments/ethernet-numbers
diff --git a/extra/io/sniffer/filter/filter.factor b/extra/io/sniffer/filter/filter.factor
index 3240810e7f..91c0ab5a5c 100755
--- a/extra/io/sniffer/filter/filter.factor
+++ b/extra/io/sniffer/filter/filter.factor
@@ -1,19 +1,8 @@
 USING: alien.c-types byte-arrays combinators hexdump io
 io.backend io.streams.string io.sockets.headers kernel math
-prettyprint io.sniffer sequences system vocabs.loader ;
+prettyprint io.sniffer sequences system vocabs.loader
+io.sniffer.filter.backend ;
 IN: io.sniffer.filter
 
-HOOK: sniffer-loop io-backend ( stream -- )
-HOOK: packet. io-backend ( string -- )
-
-: (packet.) ( string -- )
-    dup 14 head >byte-array
-    "--Ethernet Header--" print
-        dup etherneth.
-    dup etherneth-type {
-        ! HEX: 800 [ ] ! IP
-        ! HEX: 806 [ ] ! ARP
-        [ "Unknown type: " write .h ]
-    } case 2drop ;
 
 bsd? [ "io.sniffer.filter.bsd" require ] when
diff --git a/extra/io/sniffer/sniffer.factor b/extra/io/sniffer/sniffer.factor
index 04491ca709..6fd74f9e1c 100755
--- a/extra/io/sniffer/sniffer.factor
+++ b/extra/io/sniffer/sniffer.factor
@@ -1,10 +1,4 @@
 USING: io.backend kernel system vocabs.loader ;
 IN: io.sniffer
 
-SYMBOL: sniffer-type
-
-TUPLE: sniffer ;
-
-HOOK: <sniffer> io-backend ( obj -- sniffer )
-
 bsd? [ "io.sniffer.bsd" require ] when
diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor
index 667d81aeb4..fe517d68fd 100644
--- a/extra/jamshred/game/game.factor
+++ b/extra/jamshred/game/game.factor
@@ -1,4 +1,4 @@
-USING: kernel opengl arrays sequences jamshred jamshred.tunnel
+USING: kernel opengl arrays sequences jamshred.tunnel
 jamshred.player math.vectors ;
 IN: jamshred.game
 
diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor
index ddbd03eeb9..4daecf29a2 100644
--- a/extra/jamshred/player/player.factor
+++ b/extra/jamshred/player/player.factor
@@ -1,4 +1,4 @@
-USING: colors jamshred.game jamshred.oint jamshred.tunnel kernel
+USING: colors jamshred.oint jamshred.tunnel kernel
 math math.constants sequences ;
 IN: jamshred.player
 
diff --git a/extra/json/reader/reader-docs.factor b/extra/json/reader/reader-docs.factor
index 43edb6c43d..ea4dcbf954 100644
--- a/extra/json/reader/reader-docs.factor
+++ b/extra/json/reader/reader-docs.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax json.reader ;
+USING: help.markup help.syntax ;
+IN: json.reader
 
 HELP: json> "( string -- object )"
 { $values { "string" "a string in JSON format" } { "object" "yhe object deserialized from the JSON string" } }
-{ $description "Deserializes the JSON formatted string into a Factor object. JSON objects are converted to Factor hashtables. All other JSON objects convert to their obvious Factor equivalents." } ;
\ No newline at end of file
+{ $description "Deserializes the JSON formatted string into a Factor object. JSON objects are converted to Factor hashtables. All other JSON objects convert to their obvious Factor equivalents." } ;
diff --git a/extra/json/writer/writer-docs.factor b/extra/json/writer/writer-docs.factor
index cc26f74843..21aa8b2cb5 100644
--- a/extra/json/writer/writer-docs.factor
+++ b/extra/json/writer/writer-docs.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax json.writer ;
+USING: help.markup help.syntax ;
+IN: json.writer
 
 HELP: >json "( obj -- string )"
 { $values { "obj" "an object" } { "string" "the object converted to JSON format" } }
diff --git a/extra/json/writer/writer.factor b/extra/json/writer/writer.factor
index 4370a38411..6c7d6cebb2 100644
--- a/extra/json/writer/writer.factor
+++ b/extra/json/writer/writer.factor
@@ -13,7 +13,7 @@ GENERIC: json-print ( obj -- )
   [ json-print ] string-out ;
 
 M: f json-print ( f -- )
-  "false" write ;
+  drop "false" write ;
 
 M: string json-print ( obj -- )
   CHAR: " write1 "\"" split "\\\"" join CHAR: \r swap remove "\n" split "\\r\\n" join write CHAR: " write1 ;
diff --git a/extra/lisp/listener/listener.factor b/extra/lisp/listener/listener.factor
index 5af44ba362..91f0bb2a8d 100644
--- a/extra/lisp/listener/listener.factor
+++ b/extra/lisp/listener/listener.factor
@@ -5,7 +5,7 @@ USING: kernel parser namespaces io prettyprint math arrays sequences
 
 IN: lisp.listener
 
-: parse-stdio ( -- quot/f ) stdio get parse-interactive ;
+: parse-stdio ( -- quot/f ) stdio get read-quot ;
 
 : stuff? ( -- ? ) datastack length 0 > ;
 
@@ -25,4 +25,4 @@ use [ clone ] change
 { "lisp" "lisp.syntax" } add-use
 ! [ listener-hook get call prompt. lisp-listen ] until-quit
 until-quit
-] with-scope ;
\ No newline at end of file
+] with-scope ;
diff --git a/extra/mad/mad.factor b/extra/mad/mad.factor
index 27b053352b..ce65c066b4 100644
--- a/extra/mad/mad.factor
+++ b/extra/mad/mad.factor
@@ -4,14 +4,11 @@
 USING: alien alien.c-types alien.syntax combinators kernel math system ;
 IN: mad
 
-: load-mad-library ( -- )
-  "mad" {
+<< "mad" {
     { [ macosx? ] [ "libmad.0.dylib" ] }
     { [ unix? ] [ "libmad.so" ] }
     { [ windows? ] [ "mad.dll" ] }
-  } cond "cdecl" add-library ; parsing
-
-load-mad-library
+  } cond "cdecl" add-library >>
 
 LIBRARY: mad
 
diff --git a/extra/parser-combinators/simple/simple-docs.factor b/extra/parser-combinators/simple/simple-docs.factor
index c2cca6e4a0..bba37ca4ca 100755
--- a/extra/parser-combinators/simple/simple-docs.factor
+++ b/extra/parser-combinators/simple/simple-docs.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup parser-combinators
-parser-combinators.simple ;
+USING: help.syntax help.markup parser-combinators ;
+IN: parser-combinators.simple
 
 HELP: 'digit'
 { $values 
diff --git a/extra/xml-rpc/xml-rpc-docs.factor b/extra/xml-rpc/xml-rpc-docs.factor
index 323e103d4c..8c20df1fd0 100644
--- a/extra/xml-rpc/xml-rpc-docs.factor
+++ b/extra/xml-rpc/xml-rpc-docs.factor
@@ -1,4 +1,5 @@
-USING: xml-rpc help.syntax help.markup ;
+USING: help.syntax help.markup ;
+IN: xml-rpc
 
 HELP: send-rpc
 { $values { "rpc" "an RPC data type" } { "xml" "an XML document" } }

From e54b7b10a5cc291aabe68860dcb9871598da797c Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jjjj.local>
Date: Mon, 14 Jan 2008 11:43:33 -1000
Subject: [PATCH 14/18] add a sha1 benchmark

---
 extra/benchmark/sha1/sha1.factor | 7 +++++++
 1 file changed, 7 insertions(+)
 create mode 100644 extra/benchmark/sha1/sha1.factor

diff --git a/extra/benchmark/sha1/sha1.factor b/extra/benchmark/sha1/sha1.factor
new file mode 100644
index 0000000000..614077c673
--- /dev/null
+++ b/extra/benchmark/sha1/sha1.factor
@@ -0,0 +1,7 @@
+USING: crypto.sha1 io.files kernel ;
+IN: benchmark.sha1
+
+: sha1-primes-list ( -- seq )
+    "extra/math/primes/list/list.factor" resource-path file>sha1 ;
+
+MAIN: sha1-primes-list

From 81cd51ae8590efb9da3905a3f5101e41f78b55cc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 14 Jan 2008 19:11:32 -0500
Subject: [PATCH 15/18] multi-methods load fix

---
 extra/multi-methods/multi-methods.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor
index 1f260d94eb..827d64b95f 100755
--- a/extra/multi-methods/multi-methods.factor
+++ b/extra/multi-methods/multi-methods.factor
@@ -3,7 +3,7 @@
 USING: kernel math sequences vectors classes combinators
 arrays words assocs parser namespaces definitions
 prettyprint prettyprint.backend quotations arrays.lib
-debugger io ;
+debugger io compiler.units ;
 IN: multi-methods
 
 TUPLE: method loc def ;
@@ -217,5 +217,5 @@ syntax:M: method-spec synopsis*
     dup definer.
     unclip pprint* pprint* ;
 
-syntax:M: method-spec forget
+syntax:M: method-spec forget*
     unclip [ delete-at ] with-methods ;

From 9e70e6ed3552f09b349c2cdea3e09e648518bbea Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Tue, 15 Jan 2008 23:32:21 -0400
Subject: [PATCH 16/18] Fix x86 backend for dispatch change, clean up assembler

---
 core/cpu/x86/architecture/architecture.factor | 47 +++++----
 core/cpu/x86/assembler/assembler.factor       | 98 ++++++-------------
 2 files changed, 59 insertions(+), 86 deletions(-)

diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor
index 733d756157..96b2dcf1ec 100755
--- a/core/cpu/x86/architecture/architecture.factor
+++ b/core/cpu/x86/architecture/architecture.factor
@@ -70,6 +70,14 @@ M: x86-backend %prepare-alien-invoke
     temp-reg v>operand 2 cells [+] ds-reg MOV
     temp-reg v>operand 3 cells [+] rs-reg MOV ;
 
+M: x86-backend %call-primitive ( word -- )
+    stack-save-reg stack-reg cell neg [+] LEA
+    address-operand CALL ;
+
+M: x86-backend %jump-primitive ( word -- )
+    stack-save-reg stack-reg MOV
+    address-operand JMP ;
+
 M: x86-backend %call-label ( label -- ) CALL ;
 
 M: x86-backend %jump-label ( label -- ) JMP ;
@@ -77,30 +85,31 @@ M: x86-backend %jump-label ( label -- ) JMP ;
 M: x86-backend %jump-t ( label -- )
     "flag" operand f v>operand CMP JNE ;
 
-: (%dispatch) ( word-table# -- )
-    ! Untag and multiply to get a jump table offset
-    "n" operand fixnum>slot@
-    ! Add to jump table base. We use a temporary register
+: (%dispatch) ( -- 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.
-    "scratch" operand HEX: ffffffff MOV rc-absolute-cell rel-dispatch
-    "n" operand "n" operand "scratch" operand [+] MOV
-    "n" operand dup word-xt-offset [+] MOV ;
-
-: dispatch-template ( word-table# quot -- )
-    [
-        >r (%dispatch) "n" operand r> call
-    ] H{
-        { +input+ { { f "n" } } }
-        { +scratch+ { { f "scratch" } } }
-        { +clobber+ { "n" } }
-    } with-template ; inline
+    ! Untag and multiply to get a jump table offset
+    "n" operand fixnum>slot@
+    ! 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 ? [+] ;
 
 M: x86-backend %call-dispatch ( word-table# -- )
-    [ CALL ] dispatch-template ;
+    [ (%dispatch) CALL <label> dup JMP ] H{
+        { +input+ { { f "n" } } }
+        { +scratch+ { { f "offset" } } }
+    } with-template ;
 
-M: x86-backend %jump-dispatch ( word-table# -- )
-    [ %epilogue-later JMP ] dispatch-template ;
+M: x86-backend %jump-dispatch ( -- )
+    [ %epilogue-later (%dispatch) JMP ] H{
+        { +input+ { { f "n" } } }
+        { +scratch+ { { f "offset" } } }
+    } with-template ;
+
+M: x86-backend %dispatch-label ( word -- )
+    0 cell, rc-absolute-cell rel-word ;
 
 M: x86-backend %unbox-float ( dst src -- )
     [ v>operand ] 2apply float-offset [+] MOVSD ;
diff --git a/core/cpu/x86/assembler/assembler.factor b/core/cpu/x86/assembler/assembler.factor
index 17aa6bbb54..2d7ffb762d 100755
--- a/core/cpu/x86/assembler/assembler.factor
+++ b/core/cpu/x86/assembler/assembler.factor
@@ -11,78 +11,42 @@ IN: cpu.x86.assembler
 ! In 64-bit mode, { 1234 } is RIP-relative.
 ! Beware!
 
-! Register operands -- eg, ECX
-: define-register ( symbol num size -- )
-    >r dupd "register" set-word-prop r>
-    "register-size" set-word-prop ;
-
-! x86 registers
-SYMBOL: AL \ AL 0 8 define-register
-SYMBOL: CL \ CL 1 8 define-register
-SYMBOL: DL \ DL 2 8 define-register
-SYMBOL: BL \ BL 3 8 define-register
-
-SYMBOL: AX \ AX 0 16 define-register
-SYMBOL: CX \ CX 1 16 define-register
-SYMBOL: DX \ DX 2 16 define-register
-SYMBOL: BX \ BX 3 16 define-register
-SYMBOL: SP \ SP 4 16 define-register
-SYMBOL: BP \ BP 5 16 define-register
-SYMBOL: SI \ SI 6 16 define-register
-SYMBOL: DI \ DI 7 16 define-register
-
-SYMBOL: EAX \ EAX 0 32 define-register
-SYMBOL: ECX \ ECX 1 32 define-register
-SYMBOL: EDX \ EDX 2 32 define-register
-SYMBOL: EBX \ EBX 3 32 define-register
-SYMBOL: ESP \ ESP 4 32 define-register
-SYMBOL: EBP \ EBP 5 32 define-register
-SYMBOL: ESI \ ESI 6 32 define-register
-SYMBOL: EDI \ EDI 7 32 define-register
-
-SYMBOL: XMM0 \ XMM0 0 128 define-register
-SYMBOL: XMM1 \ XMM1 1 128 define-register
-SYMBOL: XMM2 \ XMM2 2 128 define-register
-SYMBOL: XMM3 \ XMM3 3 128 define-register
-SYMBOL: XMM4 \ XMM4 4 128 define-register
-SYMBOL: XMM5 \ XMM5 5 128 define-register
-SYMBOL: XMM6 \ XMM6 6 128 define-register
-SYMBOL: XMM7 \ XMM7 7 128 define-register
-
-! AMD64 registers
-SYMBOL: RAX \ RAX 0  64 define-register
-SYMBOL: RCX \ RCX 1  64 define-register
-SYMBOL: RDX \ RDX 2  64 define-register
-SYMBOL: RBX \ RBX 3  64 define-register
-SYMBOL: RSP \ RSP 4  64 define-register
-SYMBOL: RBP \ RBP 5  64 define-register
-SYMBOL: RSI \ RSI 6  64 define-register
-SYMBOL: RDI \ RDI 7  64 define-register
-SYMBOL: R8  \ R8  8  64 define-register
-SYMBOL: R9  \ R9  9  64 define-register
-SYMBOL: R10 \ R10 10 64 define-register
-SYMBOL: R11 \ R11 11 64 define-register
-SYMBOL: R12 \ R12 12 64 define-register
-SYMBOL: R13 \ R13 13 64 define-register
-SYMBOL: R14 \ R14 14 64 define-register
-SYMBOL: R15 \ R15 15 64 define-register
-
-SYMBOL: XMM8 \ XMM8 8 128 define-register
-SYMBOL: XMM9 \ XMM9 9 128 define-register
-SYMBOL: XMM10 \ XMM10 10 128 define-register
-SYMBOL: XMM11 \ XMM11 11 128 define-register
-SYMBOL: XMM12 \ XMM12 12 128 define-register
-SYMBOL: XMM13 \ XMM13 13 128 define-register
-SYMBOL: XMM14 \ XMM14 14 128 define-register
-SYMBOL: XMM15 \ XMM15 15 128 define-register
-
-<PRIVATE
-
 : n, >le % ; inline
 : 4, 4 n, ; inline
 : 2, 2 n, ; inline
 : cell, bootstrap-cell n, ; inline
 
+! Register operands -- eg, ECX
+<<
+
+: define-register ( name num size -- )
+    >r >r "cpu.x86.assembler" create dup define-symbol r> r>
+    >r dupd "register" set-word-prop r>
+    "register-size" set-word-prop ;
+
+: define-registers ( names size -- )
+    >r dup length r> [ define-register ] curry 2each ;
+
+: REGISTERS:
+    scan-word ";" parse-tokens swap define-registers ; parsing
+
+>>
+
+REGISTERS: 8 AL CL DL BL ;
+
+REGISTERS: 16 AX CX DX BX SP BP SI DI ;
+
+REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI ;
+
+REGISTERS: 64
+RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ;
+
+REGISTERS: 128
+XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
+XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ;
+
+<PRIVATE
+
 #! Extended AMD64 registers (R8-R15) return true.
 GENERIC: extended? ( op -- ? )
 

From 123b3da7bfe484502ddfb4b17abb12052b994b51 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Tue, 15 Jan 2008 23:35:03 -0400
Subject: [PATCH 17/18] More versatile << >>

---
 core/syntax/syntax.factor | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index b0a7ea19bd..7616f6e64b 100755
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.factor
@@ -170,5 +170,8 @@ IN: bootstrap.syntax
 
     "MAIN:" [ scan-word in get vocab set-vocab-main ] define-syntax
 
-    "<<" [ \ >> parse-until >quotation call ] define-syntax
+    "<<" [
+        [ \ >> parse-until >quotation ] with-compilation-unit
+        call
+    ] define-syntax
 ] with-compilation-unit

From 112c37b990bde2c97070546e801c07f20b9b5345 Mon Sep 17 00:00:00 2001
From: Slava <slava@emu.(none)>
Date: Wed, 16 Jan 2008 01:16:53 -0500
Subject: [PATCH 18/18] Fix Linux and FreeBSD signal handling on x86

---
 vm/os-freebsd-x86.32.h | 8 ++++++++
 vm/os-linux-x86-32.h   | 8 ++++++++
 vm/os-unix.c           | 7 ++++++-
 vm/platform.h          | 2 --
 4 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/vm/os-freebsd-x86.32.h b/vm/os-freebsd-x86.32.h
index 34299691bc..a04755e9dd 100644
--- a/vm/os-freebsd-x86.32.h
+++ b/vm/os-freebsd-x86.32.h
@@ -1 +1,9 @@
+#include <ucontext.h>
+
+INLINE void *ucontext_stack_pointer(void *uap)
+{
+        ucontext_t *ucontext = (ucontext_t *)uap;
+        return (void *)ucontext->uc_mcontext.mc_esp;
+}
+
 #define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)(ucontext))->uc_mcontext.mc_eip)
diff --git a/vm/os-linux-x86-32.h b/vm/os-linux-x86-32.h
index e12133966d..b458fcbe21 100644
--- a/vm/os-linux-x86-32.h
+++ b/vm/os-linux-x86-32.h
@@ -1,2 +1,10 @@
+#include <ucontext.h>
+
+INLINE void *ucontext_stack_pointer(void *uap)
+{
+        ucontext_t *ucontext = (ucontext_t *)uap;
+        return (void *)ucontext->uc_mcontext.gregs[7];
+}
+
 #define UAP_PROGRAM_COUNTER(ucontext) \
 	(((ucontext_t *)(ucontext))->uc_mcontext.gregs[14])
diff --git a/vm/os-unix.c b/vm/os-unix.c
index 55d55f312b..41dbe9cabf 100755
--- a/vm/os-unix.c
+++ b/vm/os-unix.c
@@ -192,7 +192,12 @@ INLINE F_STACK_FRAME *uap_stack_pointer(void *uap)
 	from Factor to C is a sign of things seriously gone wrong, not just
 	a divide by zero or stack underflow in the listener */
 	if(in_code_heap_p(UAP_PROGRAM_COUNTER(uap)))
-		return ucontext_stack_pointer(uap);
+	{
+		F_STACK_FRAME *ptr = ucontext_stack_pointer(uap);
+		if(!ptr)
+			critical_error("Invalid uap",(CELL)uap);
+		return ptr;
+	}
 	else
 		return NULL;
 }
diff --git a/vm/platform.h b/vm/platform.h
index d5687b849d..40324cc330 100644
--- a/vm/platform.h
+++ b/vm/platform.h
@@ -41,7 +41,6 @@
 		#ifdef __FreeBSD__
 			#define FACTOR_OS_STRING "freebsd"
 			#include "os-freebsd.h"
-			#include "os-unix-ucontext.h"
 			
 			#if defined(FACTOR_X86)
 				#include "os-freebsd-x86.32.h"
@@ -64,7 +63,6 @@
 			#include "os-linux.h"
 
 			#if defined(FACTOR_X86)
-				#include "os-unix-ucontext.h"
 				#include "os-linux-x86-32.h"
 			#elif defined(FACTOR_PPC)
 				#include "os-unix-ucontext.h"