Merge git://factorcode.org/git/factor

Makefile

@@ -140,7 +140,7 @@ factor: $(DLL_OBJS) $(EXE_OBJS)
 
 clean:
 	rm -f vm/*.o
-	rm -f libfactor.a
+	rm -f factor*.dll libfactor*.*
 
 vm/resources.o:
 	windres vm/factor.rs vm/resources.o

core/alien/c-types/c-types.factor

@@ -358,4 +358,7 @@ M: long-long-type box-return ( type -- )
     "ushort*" define-primitive-type
 
     [ string>u16-alien ] "ushort*" c-type set-c-type-prep
+    
+    win64? "longlong" "long" ? "ptrdiff_t" typedef
+    
 ] with-compilation-unit

core/alien/syntax/syntax-docs.factor

@@ -1,5 +1,6 @@
-USING: alien alien.c-types alien.structs alien.syntax
+IN: alien.syntax
-alien.syntax.private help.markup help.syntax ;
+USING: alien alien.c-types alien.structs alien.syntax.private
+help.markup help.syntax ;
 
 HELP: DLL"
 { $syntax "DLL\" path\"" }
@@ -50,7 +51,13 @@ $nl
 HELP: TYPEDEF:
 { $syntax "TYPEDEF: old new" }
 { $values { "old" "a C type" } { "new" "a C type" } }
-{ $description "Alises the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
+{ $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } " if ." }
+{ $notes "This word differs from " { $link typedef } " in that it runs at parse time, to ensure correct ordering of operations when loading source files. Words defined in source files are compiled before top-level forms are run, so if a source file defines C binding words and uses " { $link typedef } ", the type alias won't be available at compile time." } ;
+
+HELP: TYPEDEF-IF:
+{ $syntax "TYPEDEF-IF: word old new" }
+{ $values { "word" "a word with stack effect " { $snippet "( -- ? )" } } { "old" "a C type" } { "new" "a C type" } }
+{ $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } " if " { $snippet "word" } " evaluates to a true value." }
 { $notes "This word differs from " { $link typedef } " in that it runs at parse time, to ensure correct ordering of operations when loading source files. Words defined in source files are compiled before top-level forms are run, so if a source file defines C binding words and uses " { $link typedef } ", the type alias won't be available at compile time." } ;
 
 HELP: C-STRUCT:
@@ -81,7 +88,9 @@ HELP: typedef
 { $description "Alises the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
 { $notes "Using this word in the same source file which defines C bindings can cause problems, because words are compiled before top-level forms are run. Use the " { $link POSTPONE: TYPEDEF: } " word instead." } ;
 
-{ typedef POSTPONE: TYPEDEF: } related-words
+{ typedef POSTPONE: TYPEDEF: POSTPONE: TYPEDEF-IF: } related-words
+{ POSTPONE: TYPEDEF: typedef POSTPONE: TYPEDEF-IF: } related-words
+{ POSTPONE: TYPEDEF-IF: POSTPONE: TYPEDEF: typedef } related-words
 
 HELP: c-struct?
 { $values { "type" "a string" } { "?" "a boolean" } }

core/alien/syntax/syntax.factor

@@ -23,6 +23,15 @@ IN: alien.syntax
 
 PRIVATE>
 
+: indirect-quot ( function-ptr-quot return types abi -- quot )
+    [ alien-indirect ] 3curry compose ;
+
+: define-indirect ( abi return function-ptr-quot function-name parameters -- )
+    >r pick r> parse-arglist
+    rot create-in dup reset-generic
+    >r >r swapd roll indirect-quot r> r>
+    -rot define-declared ;
+
 : DLL" skip-blank parse-string dlopen parsed ; parsing
 
 : ALIEN: scan string>number <alien> parsed ; parsing
@@ -37,6 +46,9 @@ PRIVATE>
 : TYPEDEF:
     scan scan typedef ; parsing
 
+: TYPEDEF-IF:
+    scan-word execute scan scan rot [ typedef ] [ 2drop ] if ; parsing
+
 : C-STRUCT:
     scan in get
     parse-definition

core/compiler/constants/constants.factor

@@ -19,4 +19,4 @@ IN: compiler.constants
 : class-hash-offset bootstrap-cell object tag-number - ;
 : word-xt-offset 8 bootstrap-cells object tag-number - ;
 : word-code-offset 9 bootstrap-cells object tag-number - ;
-: compiled-header-size 8 bootstrap-cells ;
+: compiled-header-size 4 bootstrap-cells ;

core/compiler/test/redefine.factor

@@ -17,7 +17,7 @@ DEFER: x-2
 
         { x-1 } compile
 
-        \ x-2 word-xt eq?
+        \ x-2 word-xt =
     ] unit-test
 ] with-variable
 
@@ -115,7 +115,7 @@ DEFER: g-test-3
 
     "IN: temporary USE: math GENERIC: g-test-1 ( x -- y ) M: integer g-test-1 3 + ;" eval
 
-    \ g-test-3 word-xt eq?
+    \ g-test-3 word-xt =
 ] unit-test
 
 DEFER: g-test-5

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

core/compiler/test/templates-early.factor

@@ -44,7 +44,7 @@ words kernel math effects definitions compiler.units ;
 [
     [ ] [ init-templates ] unit-test
 
-    [ ] [ \ + init-generator ] unit-test
+    [ ] [ init-generator ] unit-test
 
     [ t ] [ [ end-basic-block ] { } make empty? ] unit-test
 

core/cpu/architecture/architecture.factor

@@ -51,8 +51,8 @@ HOOK: %save-dispatch-xt compiler-backend ( -- )
 
 M: object %save-dispatch-xt %save-word-xt ;
 
-! Call another label
+! Call another word
-HOOK: %call-label compiler-backend ( label -- )
+HOOK: %call compiler-backend ( word -- )
 
 ! Local jump for branches
 HOOK: %jump-label compiler-backend ( label -- )
@@ -60,10 +60,11 @@ 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 ( -- label )
-HOOK: %call-dispatch compiler-backend ( word-table# -- )
 
-HOOK: %jump-dispatch compiler-backend ( word-table# -- )
+HOOK: %jump-dispatch compiler-backend ( -- )
+
+HOOK: %dispatch-label compiler-backend ( word -- )
 
 ! Return to caller
 HOOK: %return compiler-backend ( -- )

core/cpu/ppc/architecture/architecture.factor

@@ -97,36 +97,40 @@ M: ppc-backend %epilogue ( n -- )
     1 1 rot ADDI
     0 MTLR ;
 
+: (%call) 11 MTLR BLRL ;
+
+: (%jump) 11 MTCTR BCTR ;
+
 : %load-dlsym ( symbol dll register -- )
     0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ;
 
-M: ppc-backend %call-label ( label -- ) BL ;
+M: ppc-backend %call ( label -- ) BL ;
 
 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) ( len -- )
-
+    0 11 LOAD32 rc-absolute-ppc-2/2 rel-here
-: dispatch-template ( word-table# quot -- )
+    "offset" operand "n" operand 1 SRAWI
-    [
+    11 11 "offset" operand ADD
-        >r
+    11 dup rot cells LWZ ;
-        "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
 
 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# -- )
+M: ppc-backend %jump-dispatch ( -- )
-    [ %epilogue-later 11 MTCTR BCTR ] dispatch-template ;
+    [ %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 %return ( -- ) %epilogue-later BLR ;
 
@@ -271,7 +275,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

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
+    "offset" operand "n" operand 1 SRAWI
-    "scratch" operand "val" operand "n" operand ;
+    "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" } } }
+            { +scratch+ { { f "scratch" } { f "offset" } } }
-            { +clobber+ { "val" "n" } }
+            { +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
+    (%char-slot)
-    "n" operand dup 2 SRAWI
+    "out" operand "offset" operand string-offset LHZ
-    "n" operand "obj" operand "n" operand ADD
-    "out" operand "n" 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
+    "val" operand "offset" operand string-offset STH
-    "slot" operand dup "obj" operand ADD
-    "val" operand "slot" operand string-offset STH
 ] H{
-    { +input+ { { f "val" } { f "slot" } { f "obj" } } }
+    { +input+ { { f "val" } { f "n" } { f "obj" } } }
-    { +clobber+ { "val" "slot" } }
+    { +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

core/cpu/x86/architecture/architecture.factor

@@ -70,37 +70,40 @@ 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-label ( label -- ) CALL ;
+M: x86-backend %call ( label -- ) CALL ;
 
 M: x86-backend %jump-label ( label -- ) JMP ;
 
 M: x86-backend %jump-t ( label -- )
     "flag" operand f v>operand CMP JNE ;
 
-: (%dispatch) ( word-table# -- )
+: (%dispatch) ( n -- operand )
-    ! Untag and multiply to get a jump table offset
+    ! Load jump table base. We use a temporary register
-    "n" operand fixnum>slot@
-    ! Add to 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
+    ! Untag and multiply to get a jump table offset
-    "n" operand "n" operand "scratch" operand [+] MOV
+    "n" operand fixnum>slot@
-    "n" operand dup word-xt-offset [+] MOV ;
+    ! Add jump table base
-
+    "offset" operand HEX: ffffffff MOV rc-absolute-cell rel-here
-: dispatch-template ( word-table# quot -- )
+    "n" operand "offset" operand ADD
-    [
+    "n" operand swap bootstrap-cell 8 = 14 9 ? + [+] ;
-        >r (%dispatch) "n" operand r> call
-    ] H{
-        { +input+ { { f "n" } } }
-        { +scratch+ { { f "scratch" } } }
-        { +clobber+ { "n" } }
-    } with-template ; inline
 
 M: x86-backend %call-dispatch ( word-table# -- )
-    [ CALL ] dispatch-template ;
+    [ 5 (%dispatch) CALL <label> dup JMP ] H{
+        { +input+ { { f "n" } } }
+        { +scratch+ { { f "offset" } } }
+        { +clobber+ { "n" } }
+    } with-template ;
 
-M: x86-backend %jump-dispatch ( word-table# -- )
+M: x86-backend %jump-dispatch ( -- )
-    [ %epilogue-later JMP ] dispatch-template ;
+    [ %epilogue-later 0 (%dispatch) JMP ] H{
+        { +input+ { { f "n" } } }
+        { +scratch+ { { f "offset" } } }
+        { +clobber+ { "n" } }
+    } 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 ;

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 -- ? )
 

core/generator/fixup/fixup-docs.factor

@@ -13,13 +13,6 @@ HELP: add-literal
 { $values { "obj" object } { "n" integer } }
 { $description "Adds a literal to the " { $link literal-table } ", if it is not already there, and outputs the index of the literal in the table. This literal can then be used as an argument for a " { $link rt-literal } " relocation with " { $link rel-fixup } "." } ;
 
-HELP: word-table
-{ $var-description "Holds a vector of words called from the currently compiling word." } ;
-
-HELP: add-word
-{ $values { "word" word } { "n" integer } }
-{ $description "Adds a word to the " { $link word-table } ", if it is not already there, and outputs the index of the word in the table. This literal can then be used as an argument for a " { $link rt-xt } " relocation with " { $link rel-fixup } "." } ;
-
 HELP: string>symbol
 { $values { "str" string } { "alien" alien } }
 { $description "Converts the string to a format which is a valid symbol name for the Factor VM's compiled code linker. By performing this conversion ahead of time, the image loader can run without allocating memory."

core/generator/fixup/fixup.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic assocs hashtables
 kernel kernel.private math namespaces sequences words
@@ -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 ;
@@ -109,10 +110,6 @@ SYMBOL: literal-table
 
 : add-literal ( obj -- n ) literal-table get push-new* ;
 
-SYMBOL: word-table
-
-: add-word ( word -- n ) word-table get push-new* ;
-
 : string>symbol ( str -- alien )
     wince? [ string>u16-alien ] [ string>char-alien ] if ;
 
@@ -124,10 +121,11 @@ SYMBOL: word-table
     add-dlsym-literals
     r> r> rt-dlsym rel-fixup ;
 
-: rel-dispatch ( word-table# class -- ) rt-dispatch rel-fixup ;
-
 : rel-word ( word class -- )
-    >r add-word r> rt-xt rel-fixup ;
+    >r add-literal r> rt-xt rel-fixup ;
+
+: rel-primitive ( word class -- )
+    >r word-def first r> rt-primitive rel-fixup ;
 
 : rel-literal ( literal class -- )
     >r add-literal r> rt-literal rel-fixup ;
@@ -135,6 +133,9 @@ SYMBOL: word-table
 : 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 ;

core/generator/generator.factor

@@ -1,22 +1,20 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes combinators cpu.architecture
 effects generator.fixup generator.registers generic hashtables
 inference inference.backend inference.dataflow io kernel
 kernel.private layouts math namespaces optimizer prettyprint
-quotations sequences system threads words ;
+quotations sequences system threads words vectors ;
 IN: generator
 
 SYMBOL: compile-queue
 SYMBOL: compiled
 
-: 5array 3array >r 2array r> append ;
-
 : begin-compiling ( word -- )
     f swap compiled get set-at ;
 
-: finish-compiling ( word literals words relocation labels code -- )
+: finish-compiling ( word literals relocation labels code -- )
-    5array swap compiled get set-at ;
+    4array swap compiled get set-at ;
 
 : queue-compile ( word -- )
     {
@@ -38,20 +36,18 @@ SYMBOL: current-label-start
 
 : compiled-stack-traces? ( -- ? ) 36 getenv ;
 
-: init-generator ( compiling -- )
+: init-generator ( -- )
-    V{ } clone literal-table set
+    compiled-stack-traces?
-    V{ } clone word-table set
+    compiling-word get  f ?
-    compiled-stack-traces? swap f ?
+    1vector literal-table set ;
-    literal-table get push ;
 
 : generate-1 ( word label node quot -- )
     pick begin-compiling [
         roll compiling-word set
         pick compiling-label set
-        compiling-word get init-generator
+        init-generator
         call
         literal-table get >array
-        word-table get >array
     ] { } make fixup finish-compiling ;
 
 GENERIC: generate-node ( node -- next )
@@ -104,14 +100,10 @@ UNION: #terminal
 ! node
 M: node generate-node drop iterate-next ;
 
-: %call ( word -- ) %call-label ;
-
 : %jump ( word -- )
-    dup compiling-label get eq? [
+    dup compiling-label get eq?
-        drop current-label-start get %jump-label
+    [ drop current-label-start get ] [ %epilogue-later ] if
-    ] [
+    %jump-label ;
-        %epilogue-later %jump-label
-    ] if ;
 
 : generate-call ( label -- next )
     dup maybe-compile
@@ -162,22 +154,22 @@ M: #if generate-node
         ] generate-1
     ] keep ;
 
-: dispatch-branches ( node -- syms )
+: dispatch-branches ( node -- )
-    node-children
+    node-children [
-    [ compiling-word get dispatch-branch ] map
+        compiling-word get dispatch-branch %dispatch-label
-    word-table get push-all ;
+    ] each ;
-
-: %dispatch ( word-table# -- )
-    tail-call? [
-        %jump-dispatch
-    ] [
-        0 frame-required
-        %call-dispatch
-    ] if ;
 
 M: #dispatch generate-node
-    word-table get length %dispatch
+    #! The order here is important, dispatch-branches must
-    dispatch-branches init-templates iterate-next ;
+    #! 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> resolve-label
+    ] if
+    init-templates iterate-next ;
 
 ! #call
 : define-intrinsics ( word intrinsics -- )

core/generic/standard/standard.factor

@@ -139,7 +139,8 @@ TUPLE: no-method object generic ;
 
 M: standard-combination perform-combination
     standard-combination-# (dispatch#) [
-        standard-methods single-combination
+        [ standard-methods ] keep "inline" word-prop
+        [ small-generic ] [ single-combination ] if
     ] with-variable ;
 
 : default-hook-method ( word -- pair )

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 ] [
+cell-bits 32 = [
-    [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
+    [ t ] [
-    \ shift inlined?
+        [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
-] unit-test
+        \ shift inlined?
+    ] unit-test
 
-[ f ] [
+    [ f ] [
-    [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
+        [ { fixnum fixnum } declare 1 swap 31 bitand shift ]
-    \ fixnum-shift inlined?
+        \ fixnum-shift inlined?
-] unit-test
+    ] unit-test
+] when

core/inference/transforms/transforms-tests.factor

@@ -1,6 +1,6 @@
 IN: temporary
 USING: sequences inference.transforms tools.test math kernel
-quotations ;
+quotations tools.test.inference ;
 
 : compose-n-quot <repetition> >quotation ;
 : compose-n compose-n-quot call ;
@@ -18,3 +18,5 @@ quotations ;
 [ 268 ] [ 1 { 8 { 3 2 } } bitfield-quot call ] unit-test
 
 [ 512 ] [ 1 { { 1+ 8 } } bitfield-quot call ] unit-test
+
+\ construct-empty must-infer

core/inference/transforms/transforms.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel words sequences generic math namespaces
 quotations assocs combinators math.bitfields inference.backend
-inference.dataflow inference.state tuples.private ;
+inference.dataflow inference.state tuples.private effects ;
 IN: inference.transforms
 
 : pop-literals ( n -- rstate seq )
@@ -61,11 +61,21 @@ M: pair (bitfield-quot) ( spec -- quot )
 
 \ set-slots [ <reversed> [get-slots] ] 1 define-transform
 
-: [construct] ( word quot -- newquot )
+\ construct-boa [
-    >r dup +inlined+ depends-on dup tuple-size r> 2curry ;
+    dup +inlined+ depends-on
+    dup tuple-size [ <tuple-boa> ] 2curry
+] 1 define-transform
 
-\ construct-boa
+\ construct-empty [
-[ [ <tuple-boa> ] [construct] ] 1 define-transform
+    1 ensure-values
+    peek-d value? [
+        pop-literal
+        dup +inlined+ depends-on
+        dup tuple-size [ <tuple> ] 2curry
+        swap infer-quot
+    ] [
+        \ construct-empty declared-infer
+    ] if
+] "infer" set-word-prop
 
-\ construct-empty
+\ construct-empty 1 1 <effect> "inferred-effect" set-word-prop
-[ [ <tuple> ] [construct] ] 1 define-transform

core/io/io.factor

@@ -35,6 +35,9 @@ GENERIC: stream-write-table ( table-cells style stream -- )
 ! Default stream
 SYMBOL: stdio
 
+! Default error stream
+SYMBOL: stderr
+
 : close ( -- ) stdio get stream-close ;
 
 : readln ( -- str/f ) stdio get stream-readln ;

core/io/streams/c/c-docs.factor

@@ -14,9 +14,10 @@ ARTICLE: "io.streams.c" "ANSI C streams"
 { $subsection fclose }
 { $subsection fgetc }
 { $subsection fread }
-"Two standard file handles:"
+"The three standard file handles:"
-{ $subsection stdin }
+{ $subsection stdin-handle }
-{ $subsection stdout } ;
+{ $subsection stdout-handle }
+{ $subsection stderr-handle } ;
 
 ABOUT: "io.streams.c"
 
@@ -64,10 +65,14 @@ HELP: fread ( n alien -- str/f )
 { $description "Reads a sequence of characters from a C FILE* handle, and outputs " { $link f } " on end of file." }
 { $errors "Throws an error if the input operation failed." } ;
 
-HELP: stdin
+HELP: stdin-handle
 { $values { "in" "a C FILE* handle" } }
 { $description "Outputs the console standard input file handle." } ;
 
-HELP: stdout
+HELP: stdout-handle
 { $values { "out" "a C FILE* handle" } }
 { $description "Outputs the console standard output file handle." } ;
+
+HELP: stderr-handle
+{ $values { "out" "a C FILE* handle" } }
+{ $description "Outputs the console standard error file handle." } ;

core/io/streams/c/c.factor

@@ -56,12 +56,13 @@ M: c-reader stream-close
 
 M: object init-io ;
 
-: stdin 11 getenv ;
+: stdin-handle 11 getenv ;
-
+: stdout-handle 12 getenv ;
-: stdout 12 getenv ;
+: stderr-handle 38 getenv ;
 
 M: object init-stdio
-    stdin stdout <duplex-c-stream> stdio set-global ;
+    stdin-handle stdout-handle <duplex-c-stream> stdio set-global
+    stderr-handle <c-writer> <plain-writer> stderr set-global ;
 
 M: object io-multiplex (sleep) ;
 

core/kernel/kernel-docs.factor

@@ -49,7 +49,7 @@ ARTICLE: "basic-combinators" "Basic combinators"
 { $subsection execute }
 "These words are used to implement " { $emphasis "combinators" } ", which are words that take code from the stack. Note that combinator definitions must be followed by the " { $link POSTPONE: inline } " declaration in order to compile in the optimizing compiler; for example:"
 { $code
-    ": keep ( x quot -- x | quot: x -- )"
+    ": keep ( x quot -- x )"
     "    over >r call r> ; inline"
 }
 "Word inlining is documented in " { $link "declarations" } "."
@@ -557,7 +557,7 @@ HELP: dip
 
 HELP: while
 { $values { "pred" "a quotation with stack effect " { $snippet "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
-{ $description "Repeatedly calls " { $snippet "pred" } ". If it yields " { $link f } ", iteration stops, otherwise " { $snippet "quot" } " is called. After iteration stops, " { $snippet "tail" } " is called." }
+{ $description "Repeatedly calls " { $snippet "pred" } ". If it yields " { $link f } ", iteration stops, otherwise " { $snippet "body" } " is called. After iteration stops, " { $snippet "tail" } " is called." }
 { $notes "In most cases, tail recursion should be used, because it is simpler both in terms of implementation and conceptually. However in some cases this combinator expresses intent better and should be used."
 $nl
 "Strictly speaking, the " { $snippet "tail" } " is not necessary, since the following are equivalent:"

core/kernel/kernel-tests.factor

@@ -1,6 +1,6 @@
 USING: arrays byte-arrays kernel kernel.private math memory
 namespaces sequences tools.test math.private quotations
-continuations prettyprint io.streams.string debugger ;
+continuations prettyprint io.streams.string debugger assocs ;
 IN: temporary
 
 [ 0 ] [ f size ] unit-test
@@ -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

core/namespaces/namespaces.factor

@@ -15,16 +15,16 @@ IN: namespaces
 PRIVATE>
 
 : namespace ( -- namespace ) namestack* peek ;
-: namestack ( -- namestack ) namestack* clone ; inline
+: namestack ( -- namestack ) namestack* clone ;
-: set-namestack ( namestack -- ) >vector 0 setenv ; inline
+: set-namestack ( namestack -- ) >vector 0 setenv ;
 : global ( -- g ) 21 getenv { hashtable } declare ; inline
 : init-namespaces ( -- ) global 1array set-namestack ;
 : get ( variable -- value ) namestack* assoc-stack ; flushable
 : set ( value variable -- ) namespace set-at ;
 : on ( variable -- ) t swap set ; inline
 : off ( variable -- ) f swap set ; inline
-: get-global ( variable -- value ) global at ; inline
+: get-global ( variable -- value ) global at ;
-: set-global ( value variable -- ) global set-at ; inline
+: set-global ( value variable -- ) global set-at ;
 
 : change ( variable quot -- )
     >r dup get r> rot slip set ; inline

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
@@ -14,8 +14,8 @@ float-arrays combinators.private combinators ;
 ! its second-to-last input
 { <tuple> <tuple-boa> } [
     [
-        node-in-d dup length 2 - swap nth dup value?
+        dup node-in-d dup length 2 - swap nth node-literal
-        [ value-literal ] [ drop tuple ] if 1array f
+        dup class? [ drop tuple ] unless 1array f
     ] "output-classes" set-word-prop
 ] each
 
@@ -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

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
-

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 ;

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 ;

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

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? [

extra/balloon-bomber/balloon-bomber-docs.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup cpu.8080 ;
+USING: help.syntax help.markup cpu.8080.emulator ;
 IN: balloon-bomber
 
 HELP: run 

extra/benchmark/sha1/sha1.factor

@@ -0,0 +1,7 @@
+USING: crypto.sha1 io.files kernel ;
+IN: benchmark.sha1
+
+: sha1-primes-list ( -- )
+    "extra/math/primes/list/list.factor" resource-path file>sha1 drop ;
+
+MAIN: sha1-primes-list

extra/cel-shading/authors.txt

@@ -0,0 +1 @@
+Joe Groff

extra/cel-shading/cel-shading.factor

@@ -0,0 +1,152 @@
+USING: arrays bunny io io.files kernel
+       math math.functions math.vectors multiline
+       namespaces
+       opengl opengl.gl
+       prettyprint
+       sequences ui ui.gadgets ui.gestures ui.render ;
+IN: cel-shading
+
+: NEAR-PLANE 1.0 64.0 / ; inline
+: FAR-PLANE 4.0 ; inline
+: FOV 2.0 sqrt 1+ ; inline
+: MOUSE-MOTION-SCALE 0.5 ; inline
+: MOUSE-DISTANCE-SCALE 1.0 64.0 / ; inline
+: KEY-ROTATE-STEP 1.0 ; inline
+: KEY-DISTANCE-STEP 1.0 64.0 / ; inline
+: DIMS { 640 480 } ; inline
+
+: FOV-RATIO ( -- fov ) DIMS dup first2 min v/n ;
+
+SYMBOL: last-drag-loc
+
+TUPLE: cel-shading-gadget yaw pitch distance model program ;
+
+: <cel-shading-gadget> ( -- cel-shading-gadget )
+    cel-shading-gadget construct-gadget
+    0.0 over set-cel-shading-gadget-yaw
+    0.0 over set-cel-shading-gadget-pitch
+    0.375 over set-cel-shading-gadget-distance
+    maybe-download read-model over set-cel-shading-gadget-model ;
+
+: yaw-cel-shading-gadget ( yaw gadget -- )
+    [ [ cel-shading-gadget-yaw + ] keep set-cel-shading-gadget-yaw ] keep relayout-1 ;
+
+: pitch-cel-shading-gadget ( pitch gadget -- )
+    [ [ cel-shading-gadget-pitch + ] keep set-cel-shading-gadget-pitch ] keep relayout-1 ;
+
+: zoom-cel-shading-gadget ( distance gadget -- )
+    [ [ cel-shading-gadget-distance + ] keep set-cel-shading-gadget-distance ] keep relayout-1 ;
+
+M: cel-shading-gadget pref-dim* ( gadget -- dim )
+    drop DIMS ;
+
+: -+ ( x -- -x x )
+    dup neg swap ;
+
+: cel-shading-frustum ( -- -x x -y y near far )
+    FOV-RATIO NEAR-PLANE FOV / v*n
+    first2 [ -+ ] 2apply NEAR-PLANE FAR-PLANE ;
+
+STRING: cel-shading-vertex-shader-source
+varying vec3 position, normal;
+
+void
+main()
+{
+    gl_Position = ftransform();
+    
+    position = gl_Vertex.xyz;
+    normal = gl_Normal;
+}
+
+;
+
+STRING: cel-shading-fragment-shader-source
+varying vec3 position, normal;
+uniform vec3 light_direction;
+uniform vec4 color;
+uniform vec4 ambient, diffuse;
+
+float
+smooth_modulate(vec3 direction, vec3 normal)
+{
+    return clamp(dot(direction, normal), 0.0, 1.0);
+}
+
+float
+modulate(vec3 direction, vec3 normal)
+{
+    float m = smooth_modulate(direction, normal);
+    return smoothstep(0.0, 0.01, m) * 0.4 + smoothstep(0.49, 0.5, m) * 0.5;
+}
+
+void
+main()
+{
+    vec3 direction = normalize(light_direction - position);
+    gl_FragColor = ambient + diffuse * color * vec4(vec3(modulate(direction, normal)), 1); 
+}
+
+;
+
+: cel-shading-program ( -- program )
+    cel-shading-vertex-shader-source <vertex-shader> check-gl-shader
+    cel-shading-fragment-shader-source <fragment-shader> check-gl-shader
+    2array <gl-program> check-gl-program ;
+
+M: cel-shading-gadget graft* ( gadget -- )
+    0.0 0.0 0.0 1.0 glClearColor
+    GL_CULL_FACE glEnable
+    GL_DEPTH_TEST glEnable
+    cel-shading-program swap set-cel-shading-gadget-program ;
+
+M: cel-shading-gadget ungraft* ( gadget -- )
+    cel-shading-gadget-program delete-gl-program ;
+
+: cel-shading-draw-setup ( gadget -- gadget )
+    GL_PROJECTION glMatrixMode
+    glLoadIdentity
+    cel-shading-frustum glFrustum
+    GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
+    GL_MODELVIEW glMatrixMode
+    glLoadIdentity
+    [ >r 0.0 0.0 r> cel-shading-gadget-distance neg glTranslatef ] keep
+    [ cel-shading-gadget-pitch 1.0 0.0 0.0 glRotatef ] keep
+    [ cel-shading-gadget-yaw   0.0 1.0 0.0 glRotatef ] keep
+    [ cel-shading-gadget-program [ "light_direction" glGetUniformLocation -25.0 45.0 80.0 glUniform3f ] keep
+                                   [ "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f ] keep
+                                   [ "ambient" glGetUniformLocation 0.2 0.2 0.2 0.2 glUniform4f ] keep
+                                   "diffuse" glGetUniformLocation 0.8 0.8 0.8 0.8 glUniform4f ] keep ;
+
+M: cel-shading-gadget draw-gadget* ( gadget -- )
+    dup cel-shading-gadget-program [
+        cel-shading-draw-setup
+        0.0 -0.12 0.0 glTranslatef
+        cel-shading-gadget-model first3 draw-bunny
+    ] with-gl-program ;
+
+: reset-last-drag-rel ( -- )
+    { 0 0 } last-drag-loc set ;
+: last-drag-rel ( -- rel )
+    drag-loc [ last-drag-loc get v- ] keep last-drag-loc set ;
+
+: drag-yaw-pitch ( -- yaw pitch )
+    last-drag-rel MOUSE-MOTION-SCALE v*n first2 ;
+
+cel-shading-gadget H{
+    { T{ key-down f f "LEFT"  } [ KEY-ROTATE-STEP neg swap yaw-cel-shading-gadget ] }
+    { T{ key-down f f "RIGHT" } [ KEY-ROTATE-STEP     swap yaw-cel-shading-gadget ] }
+    { T{ key-down f f "DOWN"  } [ KEY-ROTATE-STEP neg swap pitch-cel-shading-gadget ] }
+    { T{ key-down f f "UP"    } [ KEY-ROTATE-STEP     swap pitch-cel-shading-gadget ] }
+    { T{ key-down f f "="     } [ KEY-DISTANCE-STEP neg swap zoom-cel-shading-gadget ] }
+    { T{ key-down f f "-"     } [ KEY-DISTANCE-STEP     swap zoom-cel-shading-gadget ] }
+    
+    { T{ button-down f f 1 }    [ drop reset-last-drag-rel ] }
+    { T{ drag f 1 }             [ drag-yaw-pitch rot [ pitch-cel-shading-gadget ] keep yaw-cel-shading-gadget ] }
+    { T{ mouse-scroll }         [ scroll-direction get second MOUSE-DISTANCE-SCALE * swap zoom-cel-shading-gadget ] }
+} set-gestures
+
+: cel-shading-window ( -- )
+    [ <cel-shading-gadget> "Cel Shading" open-window ] with-ui ;
+    
+MAIN: cel-shading-window

extra/cel-shading/summary.txt

@@ -0,0 +1 @@
+Stanford Bunny rendered with a cel-shading GLSL program

extra/cel-shading/tags.txt

@@ -0,0 +1,3 @@
+demos
+opengl
+glsl

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>

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>

extra/channels/sniffer/backend/backend.factor

@@ -0,0 +1,3 @@
+USING: io.backend ;
+
+HOOK: sniff-channel io-backend ( -- channel ) 

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
+USING: kernel channels channels.sniffer.backend concurrency io
-io.sniffer io.sniffer.bsd io.unix.backend ;
+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> [

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

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" } }

extra/cpu/8080/8080-docs.factor

@@ -1,39 +1,8 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax sequences strings ;
+USING: help.markup help.syntax sequences strings cpu.8080.emulator ;
 IN: cpu.8080
 
-HELP: load-rom 
-{ $values { "filename" string } { "cpu" cpu } }
-{ $description 
-"Read the ROM file into the cpu's memory starting at address 0000. " 
-"The filename is relative to the path stored in the " { $link rom-root }
-" variable. An exception is thrown if this variable is not set."
-}
-{ $see-also load-rom* } ;
-
-HELP: load-rom*
-{ $values { "seq" sequence } { "cpu" cpu } }
-{ $description 
-"Loads one or more ROM files into the cpu's memory. Each file is "
-"loaded at a particular starting address. 'seq' is a sequence of "
-"2 element arrays. The first element is the address and the second "
-"element is the file to load at that address." $nl
-"The filenames are relative to the path stored in the " { $link rom-root }
-" variable. An exception is thrown if this variable is not set."
-}
-{ $examples
-  { $code "{ { HEX: 0000 \"invaders.rom\" } } <cpu> load-rom*" }
-}
-{ $see-also load-rom } ;
-
-HELP: rom-root
-{ $description 
-"Holds the path where the ROM files are stored. Used for expanding "
-"the relative filenames passed to " { $link load-rom } " and "
-{ $link load-rom* } "."
-}
-{ $see-also load-rom load-rom* } ;
 
 ARTICLE: { "cpu-8080" "cpu-8080" } "Intel 8080 CPU Emulator"
 "The cpu-8080 library provides an emulator for the Intel 8080 CPU"

extra/cpu/8080/authors.txt

@@ -0,0 +1 @@
+Chris Double

extra/cpu/8080/emulator/authors.txt

@@ -0,0 +1 @@
+Chris Double

extra/cpu/8080/emulator/emulator-docs.factor

@@ -0,0 +1,36 @@
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax sequences strings ;
+IN: cpu.8080.emulator
+
+HELP: load-rom 
+{ $values { "filename" string } { "cpu" cpu } }
+{ $description 
+"Read the ROM file into the cpu's memory starting at address 0000. " 
+"The filename is relative to the path stored in the " { $link rom-root }
+" variable. An exception is thrown if this variable is not set."
+}
+{ $see-also load-rom* } ;
+
+HELP: load-rom*
+{ $values { "seq" sequence } { "cpu" cpu } }
+{ $description 
+"Loads one or more ROM files into the cpu's memory. Each file is "
+"loaded at a particular starting address. 'seq' is a sequence of "
+"2 element arrays. The first element is the address and the second "
+"element is the file to load at that address." $nl
+"The filenames are relative to the path stored in the " { $link rom-root }
+" variable. An exception is thrown if this variable is not set."
+}
+{ $examples
+  { $code "{ { HEX: 0000 \"invaders.rom\" } } <cpu> load-rom*" }
+}
+{ $see-also load-rom } ;
+
+HELP: rom-root
+{ $description 
+"Holds the path where the ROM files are stored. Used for expanding "
+"the relative filenames passed to " { $link load-rom } " and "
+{ $link load-rom* } "."
+}
+{ $see-also load-rom load-rom* } ;

extra/cpu/8080/emulator/summary.txt

@@ -0,0 +1 @@
+Intel 8080 CPU Emulator

extra/cpu/8080/emulator/tags.txt

@@ -0,0 +1 @@
+emulator

extra/cpu/8080/instructions/instructions.factor

@@ -1,250 +0,0 @@
-! Copyright (C) 2006 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-USING: cpu.8080 ;
-IN: cpu.8080.instructions
-
-INSTRUCTION: NOP          ; opcode 00 cycles 04 
-INSTRUCTION: LD   BC,nn   ; opcode 01 cycles 10 
-INSTRUCTION: LD   (BC),A  ; opcode 02 cycles 07 
-INSTRUCTION: INC  BC      ; opcode 03 cycles 06 
-INSTRUCTION: INC  B       ; opcode 04 cycles 05 
-INSTRUCTION: DEC  B       ; opcode 05 cycles 05 
-INSTRUCTION: LD   B,n     ; opcode 06 cycles 07 
-INSTRUCTION: RLCA         ; opcode 07 cycles 04 
-! INSTRUCTION: NOP          ; opcode 08 cycles 04 
-INSTRUCTION: ADD  HL,BC   ; opcode 09 cycles 11 
-INSTRUCTION: LD   A,(BC)  ; opcode 0A cycles 07 
-INSTRUCTION: DEC  BC      ; opcode 0B cycles 06 
-INSTRUCTION: INC  C       ; opcode 0C cycles 05 
-INSTRUCTION: DEC  C       ; opcode 0D cycles 05 
-INSTRUCTION: LD   C,n     ; opcode 0E cycles 07 
-INSTRUCTION: RRCA         ; opcode 0F cycles 04 
-INSTRUCTION: LD   DE,nn   ; opcode 11 cycles 10 
-INSTRUCTION: LD   (DE),A  ; opcode 12 cycles 07 
-INSTRUCTION: INC  DE      ; opcode 13 cycles 06 
-INSTRUCTION: INC  D       ; opcode 14 cycles 05 
-INSTRUCTION: DEC  D       ; opcode 15 cycles 05 
-INSTRUCTION: LD   D,n     ; opcode 16 cycles 07 
-INSTRUCTION: RLA          ; opcode 17 cycles 04 
-INSTRUCTION: ADD  HL,DE   ; opcode 19 cycles 11 
-INSTRUCTION: LD   A,(DE)  ; opcode 1A cycles 07 
-INSTRUCTION: DEC  DE      ; opcode 1B cycles 06 
-INSTRUCTION: INC  E       ; opcode 1C cycles 05 
-INSTRUCTION: DEC  E       ; opcode 1D cycles 05 
-INSTRUCTION: LD   E,n     ; opcode 1E cycles 07 
-INSTRUCTION: RRA          ; opcode 1F cycles 04 
-INSTRUCTION: LD   HL,nn   ; opcode 21 cycles 10 
-INSTRUCTION: LD   (nn),HL ; opcode 22 cycles 16 
-INSTRUCTION: INC  HL      ; opcode 23 cycles 06 
-INSTRUCTION: INC  H       ; opcode 24 cycles 05 
-INSTRUCTION: DEC  H       ; opcode 25 cycles 05 
-INSTRUCTION: LD   H,n     ; opcode 26 cycles 07 
-INSTRUCTION: DAA          ; opcode 27 cycles 04 
-INSTRUCTION: ADD  HL,HL   ; opcode 29 cycles 11 
-INSTRUCTION: LD   HL,(nn) ; opcode 2A cycles 16 
-INSTRUCTION: DEC  HL      ; opcode 2B cycles 06 
-INSTRUCTION: INC  L       ; opcode 2C cycles 05 
-INSTRUCTION: DEC  L       ; opcode 2D cycles 05 
-INSTRUCTION: LD   L,n     ; opcode 2E cycles 07 
-INSTRUCTION: CPL          ; opcode 2F cycles 04 
-INSTRUCTION: LD   SP,nn   ; opcode 31 cycles 10 
-INSTRUCTION: LD   (nn),A  ; opcode 32 cycles 13 
-INSTRUCTION: INC  SP      ; opcode 33 cycles 06 
-INSTRUCTION: INC  (HL)    ; opcode 34 cycles 10 
-INSTRUCTION: DEC  (HL)    ; opcode 35 cycles 10 
-INSTRUCTION: LD   (HL),n  ; opcode 36 cycles 10 
-INSTRUCTION: SCF          ; opcode 37 cycles 04 
-INSTRUCTION: ADD  HL,SP   ; opcode 39 cycles 11 
-INSTRUCTION: LD   A,(nn)  ; opcode 3A cycles 13 
-INSTRUCTION: DEC  SP      ; opcode 3B cycles 06 
-INSTRUCTION: INC  A       ; opcode 3C cycles 05 
-INSTRUCTION: DEC  A       ; opcode 3D cycles 05 
-INSTRUCTION: LD   A,n     ; opcode 3E cycles 07 
-INSTRUCTION: CCF          ; opcode 3F cycles 04 
-INSTRUCTION: LD   B,B     ; opcode 40 cycles 05 
-INSTRUCTION: LD   B,C     ; opcode 41 cycles 05 
-INSTRUCTION: LD   B,D     ; opcode 42 cycles 05 
-INSTRUCTION: LD   B,E     ; opcode 43 cycles 05 
-INSTRUCTION: LD   B,H     ; opcode 44 cycles 05 
-INSTRUCTION: LD   B,L     ; opcode 45 cycles 05 
-INSTRUCTION: LD   B,(HL)  ; opcode 46 cycles 07 
-INSTRUCTION: LD   B,A     ; opcode 47 cycles 05 
-INSTRUCTION: LD   C,B     ; opcode 48 cycles 05 
-INSTRUCTION: LD   C,C     ; opcode 49 cycles 05 
-INSTRUCTION: LD   C,D     ; opcode 4A cycles 05 
-INSTRUCTION: LD   C,E     ; opcode 4B cycles 05 
-INSTRUCTION: LD   C,H     ; opcode 4C cycles 05 
-INSTRUCTION: LD   C,L     ; opcode 4D cycles 05 
-INSTRUCTION: LD   C,(HL)  ; opcode 4E cycles 07 
-INSTRUCTION: LD   C,A     ; opcode 4F cycles 05 
-INSTRUCTION: LD   D,B     ; opcode 50 cycles 05 
-INSTRUCTION: LD   D,C     ; opcode 51 cycles 05 
-INSTRUCTION: LD   D,D     ; opcode 52 cycles 05 
-INSTRUCTION: LD   D,E     ; opcode 53 cycles 05 
-INSTRUCTION: LD   D,H     ; opcode 54 cycles 05 
-INSTRUCTION: LD   D,L     ; opcode 55 cycles 05 
-INSTRUCTION: LD   D,(HL)  ; opcode 56 cycles 07 
-INSTRUCTION: LD   D,A     ; opcode 57 cycles 05 
-INSTRUCTION: LD   E,B     ; opcode 58 cycles 05 
-INSTRUCTION: LD   E,C     ; opcode 59 cycles 05 
-INSTRUCTION: LD   E,D     ; opcode 5A cycles 05 
-INSTRUCTION: LD   E,E     ; opcode 5B cycles 05 
-INSTRUCTION: LD   E,H     ; opcode 5C cycles 05 
-INSTRUCTION: LD   E,L     ; opcode 5D cycles 05 
-INSTRUCTION: LD   E,(HL)  ; opcode 5E cycles 07 
-INSTRUCTION: LD   E,A     ; opcode 5F cycles 05 
-INSTRUCTION: LD   H,B     ; opcode 60 cycles 05 
-INSTRUCTION: LD   H,C     ; opcode 61 cycles 05 
-INSTRUCTION: LD   H,D     ; opcode 62 cycles 05 
-INSTRUCTION: LD   H,E     ; opcode 63 cycles 05 
-INSTRUCTION: LD   H,H     ; opcode 64 cycles 05 
-INSTRUCTION: LD   H,L     ; opcode 65 cycles 05 
-INSTRUCTION: LD   H,(HL)  ; opcode 66 cycles 07 
-INSTRUCTION: LD   H,A     ; opcode 67 cycles 05 
-INSTRUCTION: LD   L,B     ; opcode 68 cycles 05 
-INSTRUCTION: LD   L,C     ; opcode 69 cycles 05 
-INSTRUCTION: LD   L,D     ; opcode 6A cycles 05 
-INSTRUCTION: LD   L,E     ; opcode 6B cycles 05 
-INSTRUCTION: LD   L,H     ; opcode 6C cycles 05 
-INSTRUCTION: LD   L,L     ; opcode 6D cycles 05 
-INSTRUCTION: LD   L,(HL)  ; opcode 6E cycles 07 
-INSTRUCTION: LD   L,A     ; opcode 6F cycles 05 
-INSTRUCTION: LD   (HL),B  ; opcode 70 cycles 07 
-INSTRUCTION: LD   (HL),C  ; opcode 71 cycles 07 
-INSTRUCTION: LD   (HL),D  ; opcode 72 cycles 07 
-INSTRUCTION: LD   (HL),E  ; opcode 73 cycles 07 
-INSTRUCTION: LD   (HL),H  ; opcode 74 cycles 07 
-INSTRUCTION: LD   (HL),L  ; opcode 75 cycles 07 
-INSTRUCTION: HALT         ; opcode 76 cycles 07 
-INSTRUCTION: LD   (HL),A  ; opcode 77 cycles 07 
-INSTRUCTION: LD   A,B     ; opcode 78 cycles 05 
-INSTRUCTION: LD   A,C     ; opcode 79 cycles 05 
-INSTRUCTION: LD   A,D     ; opcode 7A cycles 05 
-INSTRUCTION: LD   A,E     ; opcode 7B cycles 05 
-INSTRUCTION: LD   A,H     ; opcode 7C cycles 05 
-INSTRUCTION: LD   A,L     ; opcode 7D cycles 05 
-INSTRUCTION: LD   A,(HL)  ; opcode 7E cycles 07 
-INSTRUCTION: LD   A,A     ; opcode 7F cycles 05 
-INSTRUCTION: ADD  A,B     ; opcode 80 cycles 04 
-INSTRUCTION: ADD  A,C     ; opcode 81 cycles 04 
-INSTRUCTION: ADD  A,D     ; opcode 82 cycles 04 
-INSTRUCTION: ADD  A,E     ; opcode 83 cycles 04 
-INSTRUCTION: ADD  A,H     ; opcode 84 cycles 04 
-INSTRUCTION: ADD  A,L     ; opcode 85 cycles 04 
-INSTRUCTION: ADD  A,(HL)  ; opcode 86 cycles 07 
-INSTRUCTION: ADD  A,A     ; opcode 87 cycles 04 
-INSTRUCTION: ADC  A,B     ; opcode 88 cycles 04 
-INSTRUCTION: ADC  A,C     ; opcode 89 cycles 04 
-INSTRUCTION: ADC  A,D     ; opcode 8A cycles 04 
-INSTRUCTION: ADC  A,E     ; opcode 8B cycles 04 
-INSTRUCTION: ADC  A,H     ; opcode 8C cycles 04 
-INSTRUCTION: ADC  A,L     ; opcode 8D cycles 04 
-INSTRUCTION: ADC  A,(HL)  ; opcode 8E cycles 07 
-INSTRUCTION: ADC  A,A     ; opcode 8F cycles 04 
-INSTRUCTION: SUB  B       ; opcode 90 cycles 04 
-INSTRUCTION: SUB  C       ; opcode 91 cycles 04 
-INSTRUCTION: SUB  D       ; opcode 92 cycles 04 
-INSTRUCTION: SUB  E       ; opcode 93 cycles 04 
-INSTRUCTION: SUB  H       ; opcode 94 cycles 04 
-INSTRUCTION: SUB  L       ; opcode 95 cycles 04 
-INSTRUCTION: SUB  (HL)    ; opcode 96 cycles 07 
-INSTRUCTION: SUB  A       ; opcode 97 cycles 04 
-INSTRUCTION: SBC  A,B     ; opcode 98 cycles 04 
-INSTRUCTION: SBC  A,C     ; opcode 99 cycles 04 
-INSTRUCTION: SBC  A,D     ; opcode 9A cycles 04 
-INSTRUCTION: SBC  A,E     ; opcode 9B cycles 04 
-INSTRUCTION: SBC  A,H     ; opcode 9C cycles 04 
-INSTRUCTION: SBC  A,L     ; opcode 9D cycles 04 
-INSTRUCTION: SBC  A,(HL)  ; opcode 9E cycles 07 
-INSTRUCTION: SBC  A,A     ; opcode 9F cycles 04 
-INSTRUCTION: AND  B       ; opcode A0 cycles 04 
-INSTRUCTION: AND  C       ; opcode A1 cycles 04 
-INSTRUCTION: AND  D       ; opcode A2 cycles 04 
-INSTRUCTION: AND  E       ; opcode A3 cycles 04 
-INSTRUCTION: AND  H       ; opcode A4 cycles 04 
-INSTRUCTION: AND  L       ; opcode A5 cycles 04 
-INSTRUCTION: AND  (HL)    ; opcode A6 cycles 07 
-INSTRUCTION: AND  A       ; opcode A7 cycles 04 
-INSTRUCTION: XOR  B       ; opcode A8 cycles 04 
-INSTRUCTION: XOR  C       ; opcode A9 cycles 04 
-INSTRUCTION: XOR  D       ; opcode AA cycles 04 
-INSTRUCTION: XOR  E       ; opcode AB cycles 04 
-INSTRUCTION: XOR  H       ; opcode AC cycles 04 
-INSTRUCTION: XOR  L       ; opcode AD cycles 04 
-INSTRUCTION: XOR  (HL)    ; opcode AE cycles 07 
-INSTRUCTION: XOR  A       ; opcode AF cycles 04 
-INSTRUCTION: OR   B       ; opcode B0 cycles 04 
-INSTRUCTION: OR   C       ; opcode B1 cycles 04 
-INSTRUCTION: OR   D       ; opcode B2 cycles 04 
-INSTRUCTION: OR   E       ; opcode B3 cycles 04 
-INSTRUCTION: OR   H       ; opcode B4 cycles 04 
-INSTRUCTION: OR   L       ; opcode B5 cycles 04 
-INSTRUCTION: OR   (HL)    ; opcode B6 cycles 07 
-INSTRUCTION: OR   A       ; opcode B7 cycles 04 
-INSTRUCTION: CP   B       ; opcode B8 cycles 04 
-INSTRUCTION: CP   C       ; opcode B9 cycles 04 
-INSTRUCTION: CP   D       ; opcode BA cycles 04 
-INSTRUCTION: CP   E       ; opcode BB cycles 04 
-INSTRUCTION: CP   H       ; opcode BC cycles 04 
-INSTRUCTION: CP   L       ; opcode BD cycles 04 
-INSTRUCTION: CP   (HL)    ; opcode BE cycles 07 
-INSTRUCTION: CP   A       ; opcode BF cycles 04 
-INSTRUCTION: RET  NZ      ; opcode C0 cycles 05 
-INSTRUCTION: POP  BC      ; opcode C1 cycles 10 
-INSTRUCTION: JP   NZ,nn   ; opcode C2 cycles 10 
-INSTRUCTION: JP   nn      ; opcode C3 cycles 10 
-INSTRUCTION: CALL NZ,nn   ; opcode C4 cycles 11 
-INSTRUCTION: PUSH BC      ; opcode C5 cycles 11 
-INSTRUCTION: ADD  A,n     ; opcode C6 cycles 07 
-INSTRUCTION: RST  0       ; opcode C7 cycles 11 
-INSTRUCTION: RET  Z       ; opcode C8 cycles 05 
-INSTRUCTION: RET  nn      ; opcode C9 cycles 10 
-INSTRUCTION: JP   Z,nn    ; opcode CA cycles 10 
-INSTRUCTION: CALL Z,nn    ; opcode CC cycles 11 
-INSTRUCTION: CALL nn      ; opcode CD cycles 17 
-INSTRUCTION: ADC  A,n     ; opcode CE cycles 07 
-INSTRUCTION: RST  8       ; opcode CF cycles 11 
-INSTRUCTION: RET  NC      ; opcode D0 cycles 05 
-INSTRUCTION: POP  DE      ; opcode D1 cycles 10 
-INSTRUCTION: JP   NC,nn   ; opcode D2 cycles 10 
-INSTRUCTION: OUT  (n),A   ; opcode D3 cycles 10 
-INSTRUCTION: CALL NC,nn   ; opcode D4 cycles 11 
-INSTRUCTION: PUSH DE      ; opcode D5 cycles 11 
-INSTRUCTION: SUB  n       ; opcode D6 cycles 07 
-INSTRUCTION: RST  10H     ; opcode D7 cycles 11 
-INSTRUCTION: RET  C       ; opcode D8 cycles 05 
-INSTRUCTION: JP   C,nn    ; opcode DA cycles 10 
-INSTRUCTION: IN   A,(n)   ; opcode DB cycles 10 
-INSTRUCTION: CALL C,nn    ; opcode DC cycles 11 
-INSTRUCTION: SBC  A,n     ; opcode DE cycles 07 
-INSTRUCTION: RST  18H     ; opcode DF cycles 11 
-INSTRUCTION: RET  PO      ; opcode E0 cycles 05 
-INSTRUCTION: POP  HL      ; opcode E1 cycles 10 
-INSTRUCTION: JP   PO,nn   ; opcode E2 cycles 10 
-INSTRUCTION: EX   (SP),HL ; opcode E3 cycles 04 
-INSTRUCTION: CALL PO,nn   ; opcode E4 cycles 11 
-INSTRUCTION: PUSH HL      ; opcode E5 cycles 11 
-INSTRUCTION: AND  n       ; opcode E6 cycles 07 
-INSTRUCTION: RST  20H     ; opcode E7 cycles 11 
-INSTRUCTION: RET  PE      ; opcode E8 cycles 05 
-INSTRUCTION: JP   (HL)    ; opcode E9 cycles 04 
-INSTRUCTION: JP   PE,nn   ; opcode EA cycles 10 
-INSTRUCTION: EX   DE,HL   ; opcode EB cycles 04 
-INSTRUCTION: CALL PE,nn   ; opcode EC cycles 11 
-INSTRUCTION: XOR  n       ; opcode EE cycles 07 
-INSTRUCTION: RST  28H     ; opcode EF cycles 11 
-INSTRUCTION: RET  P       ; opcode F0 cycles 05 
-INSTRUCTION: POP  AF      ; opcode F1 cycles 10 
-INSTRUCTION: JP   P,nn    ; opcode F2 cycles 10 
-INSTRUCTION: DI           ; opcode F3 cycles 04 
-INSTRUCTION: CALL P,nn    ; opcode F4 cycles 11 
-INSTRUCTION: PUSH AF      ; opcode F5 cycles 11 
-INSTRUCTION: OR   n       ; opcode F6 cycles 07 
-INSTRUCTION: RST  30H     ; opcode F7 cycles 11 
-INSTRUCTION: RET  M       ; opcode F8 cycles 05 
-INSTRUCTION: LD   SP,HL   ; opcode F9 cycles 06 
-INSTRUCTION: JP   M,nn    ; opcode FA cycles 10 
-INSTRUCTION: EI           ; opcode FB cycles 04 
-INSTRUCTION: CALL M,nn    ; opcode FC cycles 11 
-INSTRUCTION: CP   n       ; opcode FE cycles 07 
-INSTRUCTION: RST  38H     ; opcode FF cycles 11 

extra/cpu/8080/summary.txt

@@ -0,0 +1 @@
+Intel 8080 CPU Emulator

extra/cpu/8080/tags.txt

@@ -0,0 +1 @@
+emulator

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
+    } cond add-library >>
-
-load-libcl
 
 ! ===============================================
 ! Machine-dependant types

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" } }

extra/crypto/sha1/sha1.factor

@@ -78,7 +78,7 @@ SYMBOL: K
         K get nth ,
         A get 5 bitroll-32 ,
         E get ,
-    ] { } make sum 4294967295 bitand ; inline
+    ] { } make sum >32-bit ; inline
 
 : set-vars ( temp -- )
     ! E = D;  D = C;  C = S^30(B);  B = A; A = TEMP;

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 ;
 

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 

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 )
+

extra/hardware-info/hardware-info.factor

@@ -1,26 +1,15 @@
-USING: alien.syntax math prettyprint system combinators
+USING: alien.syntax kernel math prettyprint system
-vocabs.loader ;
+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* >>
 

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 ;

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 ;
-
-

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
 

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
+windows windows.kernel32 windows.advapi32
-words combinators vocabs.loader ;
+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* >>

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?

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 

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."

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" } }

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 ;

extra/io/launcher/launcher-docs.factor

@@ -85,7 +85,7 @@ HELP: run-detached
 
 HELP: <process-stream>
 { $values { "obj" object } { "stream" "a bidirectional stream" } }
-{ $description "Launches a process and redirects its input and output via a paper of pipes which may be read and written as a stream." }
+{ $description "Launches a process and redirects its input and output via a pair of pipes which may be read and written as a stream." }
 { $notes "Closing the stream will block until the process exits." } ;
 
 { run-process run-detached <process-stream> } related-words

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 )

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
 
@@ -17,7 +17,7 @@ TUPLE: sniffer-spec path ifname ;
 C: <sniffer-spec> sniffer-spec
 
 : IOCPARM_MASK   HEX: 1fff ; inline
-: IOCPARM_MAX    IOCPARM_MASK 1 + ; inline
+: IOCPARM_MAX    IOCPARM_MASK 1+ ; inline
 : IOC_VOID       HEX: 20000000 ; inline
 : IOC_OUT        HEX: 40000000 ; inline
 : IOC_IN         HEX: 80000000 ; inline

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 ;

extra/io/sniffer/filter/bsd/bsd.factor

@@ -1,14 +1,15 @@
 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
+io.streams.string io.unix.backend math
-sequences system byte-arrays ;
+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
 
 : bpf-align ( n -- n' )
     #! Align to next higher word size
-    "long" heap-size 1- [ + ] keep bitnot bitand ;
+    "long" heap-size align ;
 
 M: unix-io packet. ( string -- )
     18 cut swap >byte-array bpfh.

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

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

extra/io/unix/backend/backend.factor

@@ -1,21 +1,24 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien bit-arrays generic assocs io kernel
+USING: alien generic assocs kernel kernel.private math
-kernel.private math io.nonblocking sequences strings structs
+io.nonblocking sequences strings structs sbufs threads unix
-sbufs threads unix vectors io.buffers io.backend
+vectors io.buffers io.backend io.streams.duplex math.parser
-io.streams.duplex math.parser continuations system libc ;
+continuations system libc qualified namespaces ;
+QUALIFIED: io
 IN: io.unix.backend
 
+! Multiplexer protocol
+SYMBOL: unix-io-backend
+
+HOOK: init-unix-io unix-io-backend ( -- )
+HOOK: register-io-task unix-io-backend ( task -- )
+HOOK: unregister-io-task unix-io-backend ( task -- )
+HOOK: unix-io-multiplex unix-io-backend ( timeval -- )
+
 TUPLE: unix-io ;
 
-! We want namespaces::bind to shadow the bind system call from
-! unix
-USING: namespaces ;
-
 ! Global variables
-SYMBOL: read-fdset
 SYMBOL: read-tasks
-SYMBOL: write-fdset
 SYMBOL: write-tasks
 
 ! Some general stuff
@@ -53,9 +56,9 @@ M: integer close-handle ( fd -- )
 ! port to finish I/O
 TUPLE: io-task port callbacks ;
 
-: <io-task> ( port class -- task )
+: <io-task> ( port continuation class -- task )
-    >r V{ } clone io-task construct-boa
+    >r 1vector io-task construct-boa r> construct-delegate ;
-    { set-delegate } r> construct ; inline
+    inline
 
 ! Multiplexer
 GENERIC: do-io-task ( task -- ? )
@@ -63,58 +66,30 @@ GENERIC: task-container ( task -- vector )
 
 : io-task-fd io-task-port port-handle ;
 
-: add-io-task ( callback task -- )
+: check-io-task ( task -- )
-    [ io-task-callbacks push ] keep
+    dup io-task-fd swap task-container at [
-    dup io-task-fd over task-container 2dup at [
         "Cannot perform multiple reads from the same port" throw
-    ] when set-at ;
+    ] when ;
+
+: add-io-task ( task -- )
+    dup check-io-task
+    dup register-io-task
+    dup io-task-fd over task-container set-at ;
 
 : remove-io-task ( task -- )
-    dup io-task-fd swap task-container delete-at ;
+    dup io-task-fd over task-container delete-at
+    unregister-io-task ;
 
 : pop-callbacks ( task -- )
-    dup io-task-callbacks swap remove-io-task
+    dup remove-io-task
-    [ schedule-thread ] each ;
+    io-task-callbacks [ schedule-thread ] each ;
 
 : handle-fd ( task -- )
     dup io-task-port touch-port
     dup do-io-task [ pop-callbacks ] [ drop ] if ;
 
-: handle-fdset ( fdset tasks -- )
+: handle-timeout ( task -- )
-    swap [
+    "Timeout" over io-task-port report-error pop-callbacks ;
-        swap dup io-task-port timeout? [
-            dup io-task-port "Timeout" swap report-error
-            nip pop-callbacks
-        ] [
-            tuck io-task-fd swap nth
-            [ handle-fd ] [ drop ] if
-        ] if drop
-    ] curry assoc-each ;
-
-: init-fdset ( fdset tasks -- )
-    swap dup clear-bits
-    [ >r drop t swap r> set-nth ] curry assoc-each ;
-
-: read-fdset/tasks
-    read-fdset get-global read-tasks get-global ;
-
-: write-fdset/tasks
-    write-fdset get-global write-tasks get-global ;
-
-: init-fdsets ( -- read write except )
-    read-fdset/tasks dupd init-fdset
-    write-fdset/tasks dupd init-fdset
-    f ;
-
-: (io-multiplex) ( ms -- )
-    >r FD_SETSIZE init-fdsets r> make-timeval select 0 < [
-        err_no ignorable-error? [ (io-error) ] unless
-    ] when ;
-
-M: unix-io io-multiplex ( ms -- )
-    (io-multiplex)
-    read-fdset/tasks handle-fdset
-    write-fdset/tasks handle-fdset ;
 
 ! Readers
 : reader-eof ( reader -- )
@@ -137,17 +112,18 @@ M: unix-io io-multiplex ( ms -- )
 
 TUPLE: read-task ;
 
-: <read-task> ( port -- task ) read-task <io-task> ;
+: <read-task> ( port continuation -- task )
+    read-task <io-task> ;
 
 M: read-task do-io-task
     io-task-port dup refill
     [ [ reader-eof ] [ drop ] if ] keep ;
 
-M: read-task task-container drop read-tasks get-global ;
+M: read-task task-container
+    drop read-tasks get-global ;
 
 M: input-port (wait-to-read)
-    [ swap <read-task> add-io-task stop ] callcc0
+    [ <read-task> add-io-task stop ] callcc0 pending-error ;
-    pending-error ;
 
 ! Writers
 : write-step ( port -- ? )
@@ -156,35 +132,38 @@ M: input-port (wait-to-read)
 
 TUPLE: write-task ;
 
-: <write-task> ( port -- task ) write-task <io-task> ;
+: <write-task> ( port continuation -- task )
+    write-task <io-task> ;
 
 M: write-task do-io-task
     io-task-port dup buffer-empty? over port-error or
     [ 0 swap buffer-reset t ] [ write-step ] if ;
 
-M: write-task task-container drop write-tasks get-global ;
+M: write-task task-container
+    drop write-tasks get-global ;
 
-: add-write-io-task ( callback task -- )
+: add-write-io-task ( port continuation -- )
-    dup io-task-fd write-tasks get-global at
+    over port-handle write-tasks get-global at
-    [ io-task-callbacks push ] [ add-io-task ] ?if ;
+    [ io-task-callbacks push drop ]
+    [ <write-task> add-io-task ] if* ;
 
 : (wait-to-write) ( port -- )
-    [ swap <write-task> add-write-io-task stop ] callcc0 drop ;
+    [ add-write-io-task stop ] callcc0 drop ;
 
 M: port port-flush ( port -- )
     dup buffer-empty? [ drop ] [ (wait-to-write) ] if ;
 
-USE: io
+M: unix-io io-multiplex ( ms -- )
+    unix-io-multiplex ;
 
 M: unix-io init-io ( -- )
-    #! Should only be called on startup. Calling this at any
+    H{ } clone read-tasks set-global
-    #! other time can have unintended consequences.
+    H{ } clone write-tasks set-global
-    global [
+    init-unix-io ;
-        H{ } clone read-tasks set
-        FD_SETSIZE 8 * <bit-array> read-fdset set
-        H{ } clone write-tasks set
-        FD_SETSIZE 8 * <bit-array> write-fdset set
-    ] bind ;
 
 M: unix-io init-stdio ( -- )
-    0 1 handle>duplex-stream stdio set-global ;
+    0 1 handle>duplex-stream io:stdio set-global
+    2 <writer> io:stderr set-global ;
+
+: multiplexer-error ( n -- )
+    0 < [ err_no ignorable-error? [ (io-error) ] unless ] when ;

extra/io/unix/backend/kqueue/kqueue.factor

@@ -0,0 +1,106 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types kernel io.nonblocking io.unix.backend
+io.unix.sockets sequences assocs unix unix.kqueue math
+namespaces classes combinators ;
+IN: io.unix.backend.kqueue
+
+TUPLE: unix-kqueue-io ;
+
+! Global variables
+SYMBOL: kqueue-fd
+SYMBOL: kqueue-added
+SYMBOL: kqueue-deleted
+SYMBOL: kqueue-events
+
+: max-events ( -- n )
+    #! We read up to 256 events at a time. This is an arbitrary
+    #! constant...
+    256 ; inline
+
+M: unix-kqueue-io init-unix-io ( -- )
+    H{ } clone kqueue-added set-global
+    H{ } clone kqueue-deleted set-global
+    max-events "kevent" <c-array> kqueue-events set-global
+    kqueue dup io-error kqueue-fd set-global ;
+
+M: unix-kqueue-io register-io-task ( task -- )
+    dup io-task-fd kqueue-added get-global key? [ drop ] [
+        dup io-task-fd kqueue-deleted get-global key? [
+            io-task-fd kqueue-deleted get-global delete-at
+        ] [
+            dup io-task-fd kqueue-added get-global set-at
+        ] if
+    ] if ;
+
+M: unix-kqueue-io unregister-io-task ( task -- )
+    dup io-task-fd kqueue-deleted get-global key? [ drop ] [
+        dup io-task-fd kqueue-added get-global key? [
+            io-task-fd kqueue-added get-global delete-at
+        ] [
+            dup io-task-fd kqueue-deleted get-global set-at
+        ] if
+    ] if ;
+
+: io-task-filter ( task -- n )
+    class {
+        { read-task    [ EVFILT_READ  ] }
+        { accept-task  [ EVFILT_READ  ] }
+        { receive-task [ EVFILT_READ  ] }
+        { write-task   [ EVFILT_WRITE ] }
+        { connect-task [ EVFILT_WRITE ] }
+        { send-task    [ EVFILT_WRITE ] }
+    } case ;
+
+: make-kevent ( task -- event )
+    "kevent" <c-object>
+    over io-task-fd over set-kevent-ident
+    swap io-task-filter over set-kevent-filter ;
+
+: make-add-kevent ( task -- event )
+    make-kevent
+    EV_ADD over set-kevent-flags ;
+
+: make-delete-kevent ( task -- event )
+    make-kevent
+    EV_DELETE over set-kevent-flags ;
+
+: kqueue-additions ( -- kevents )
+    kqueue-added get-global
+    dup clear-assoc values
+    [ make-add-kevent ] map ;
+
+: kqueue-deletions ( -- kevents )
+    kqueue-deleted get-global
+    dup clear-assoc values
+    [ make-delete-kevent ] map ;
+
+: kqueue-changelist ( -- byte-array n )
+    kqueue-additions kqueue-deletions append
+    dup concat f like swap length ;
+
+: kqueue-eventlist ( -- byte-array n )
+    kqueue-events get-global max-events ;
+
+: do-kevent ( timespec -- n )
+    >r
+    kqueue-fd get-global
+    kqueue-changelist
+    kqueue-eventlist
+    r> kevent dup multiplexer-error ;
+
+: kevent-task ( kevent -- task )
+    dup kevent-ident swap kevent-filter {
+        { [ dup EVFILT_READ = ] [ read-tasks ] }
+        { [ dup EVFILT_WRITE = ] [ write-tasks ] }
+    } cond nip get at ;
+
+: handle-kevents ( n eventlist -- )
+    [ kevent-nth kevent-task handle-fd ] curry each ;
+
+M: unix-kqueue-io unix-io-multiplex ( ms -- )
+    make-timespec
+    do-kevent
+    kqueue-events get-global handle-kevents ;
+
+T{ unix-kqueue-io } unix-io-backend set-global

extra/io/unix/backend/select/select.factor

@@ -0,0 +1,52 @@
+! Copyright (C) 2004, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel io.nonblocking io.unix.backend
+bit-arrays sequences assocs unix math namespaces ;
+IN: io.unix.backend.select
+
+TUPLE: unix-select-io ;
+
+! Global variables
+SYMBOL: read-fdset
+SYMBOL: write-fdset
+
+M: unix-select-io init-unix-io ( -- )
+    FD_SETSIZE 8 * <bit-array> read-fdset set-global
+    FD_SETSIZE 8 * <bit-array> write-fdset set-global ;
+
+: handle-fdset ( fdset tasks -- )
+    swap [
+        swap dup io-task-port timeout? [
+            nip handle-timeout
+        ] [
+            tuck io-task-fd swap nth
+            [ handle-fd ] [ drop ] if
+        ] if drop
+    ] curry assoc-each ;
+
+: init-fdset ( fdset tasks -- )
+    swap dup clear-bits
+    [ >r drop t swap r> set-nth ] curry assoc-each ;
+
+: read-fdset/tasks
+    read-fdset get-global read-tasks get-global ;
+
+: write-fdset/tasks
+    write-fdset get-global write-tasks get-global ;
+
+: init-fdsets ( -- read write except )
+    read-fdset/tasks dupd init-fdset
+    write-fdset/tasks dupd init-fdset
+    f ;
+
+M: unix-select-io register-io-task ( task -- ) drop ;
+
+M: unix-select-io unregister-io-task ( task -- ) drop ;
+
+M: unix-select-io unix-io-multiplex ( timeval -- )
+    make-timeval >r FD_SETSIZE init-fdsets r>
+    select multiplexer-error
+    read-fdset/tasks handle-fdset
+    write-fdset/tasks handle-fdset ;
+
+T{ unix-select-io } unix-io-backend set-global

extra/io/unix/sockets/sockets.factor

@@ -33,7 +33,8 @@ M: unix-io addrinfo-error ( n -- )
 
 TUPLE: connect-task ;
 
-: <connect-task> ( port -- task ) connect-task <io-task> ;
+: <connect-task> ( port continuation -- task )
+    connect-task <io-task> ;
 
 M: connect-task do-io-task
     io-task-port dup port-handle f 0 write
@@ -42,7 +43,7 @@ M: connect-task do-io-task
 M: connect-task task-container drop write-tasks get-global ;
 
 : wait-to-connect ( port -- )
-    [ swap <connect-task> add-io-task stop ] callcc0 drop ;
+    [ <connect-task> add-io-task stop ] callcc0 drop ;
 
 M: unix-io (client) ( addrspec -- stream )
     dup make-sockaddr/size >r >r
@@ -66,7 +67,8 @@ USE: unix
 
 TUPLE: accept-task ;
 
-: <accept-task> ( port -- task ) accept-task <io-task> ;
+: <accept-task> ( port continuation  -- task )
+    accept-task <io-task> ;
 
 M: accept-task task-container drop read-tasks get ;
 
@@ -85,7 +87,7 @@ M: accept-task do-io-task
     over 0 >= [ do-accept t ] [ 2drop defer-error ] if ;
 
 : wait-to-accept ( server -- )
-    [ swap <accept-task> add-io-task stop ] callcc0 drop ;
+    [ <accept-task> add-io-task stop ] callcc0 drop ;
 
 USE: io.sockets
 
@@ -136,7 +138,8 @@ packet-size <byte-array> receive-buffer set-global
 
 TUPLE: receive-task ;
 
-: <receive-task> ( stream -- task ) receive-task <io-task> ;
+: <receive-task> ( stream continuation  -- task )
+    receive-task <io-task> ;
 
 M: receive-task do-io-task
     io-task-port
@@ -152,7 +155,7 @@ M: receive-task do-io-task
 M: receive-task task-container drop read-tasks get ;
 
 : wait-receive ( stream -- )
-    [ swap <receive-task> add-io-task stop ] callcc0 drop ;
+    [ <receive-task> add-io-task stop ] callcc0 drop ;
 
 M: unix-io receive ( datagram -- packet addrspec )
     dup check-datagram-port
@@ -166,7 +169,7 @@ M: unix-io receive ( datagram -- packet addrspec )
 
 TUPLE: send-task packet sockaddr len ;
 
-: <send-task> ( packet sockaddr len port -- task )
+: <send-task> ( packet sockaddr len stream continuation -- task )
     send-task <io-task> [
         {
             set-send-task-packet
@@ -185,8 +188,7 @@ M: send-task do-io-task
 M: send-task task-container drop write-tasks get ;
 
 : wait-send ( packet sockaddr len stream -- )
-    [ >r <send-task> r> swap add-io-task stop ] callcc0
+    [ <send-task> add-io-task stop ] callcc0 2drop 2drop ;
-    2drop 2drop ;
 
 M: unix-io send ( packet addrspec datagram -- )
     3dup check-datagram-send

extra/io/unix/unix.factor

@@ -1,9 +1,12 @@
-USE: io.unix.backend
+USING: io.unix.backend io.unix.files io.unix.sockets
-USE: io.unix.files
+io.unix.launcher io.unix.mmap io.backend combinators namespaces
-USE: io.unix.sockets
+system vocabs.loader ;
-USE: io.unix.launcher
+
-USE: io.unix.mmap
+{
-USE: io.backend
+    ! kqueue is a work in progress
-USE: namespaces
+    ! { [ macosx? ] [ "io.unix.backend.kqueue" ] }
+    ! { [ bsd? ] [ "io.unix.backend.kqueue" ] }
+    { [ unix? ] [ "io.unix.backend.select" ] }
+} cond require
 
 T{ unix-io } io-backend set-global

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
 

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
 

extra/json/reader/reader-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.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" } }

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" } }

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 ;

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 > ;
 

extra/lunar-rescue/lunar-rescue-docs.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup cpu.8080 ;
+USING: help.syntax help.markup cpu.8080.emulator ;
 IN: lunar-rescue 
 
 HELP: run 

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
+  } cond "cdecl" add-library >>
-
-load-mad-library
 
 LIBRARY: mad
 

extra/match/match.factor

@@ -3,7 +3,7 @@
 !
 ! Based on pattern matching code from Paul Graham's book 'On Lisp'.
 USING: parser kernel words namespaces sequences tuples
-combinators macros assocs ;
+combinators macros assocs math ;
 IN: match
 
 SYMBOL: _
@@ -54,6 +54,7 @@ MACRO: match-cond ( assoc -- )
 
 : replace-patterns ( object -- result )
     {
+	{ [ dup number? ] [ ] }
         { [ dup match-var? ] [ get ] }
         { [ dup sequence? ] [ [ replace-patterns ] map ] }
         { [ dup tuple? ] [ tuple>array replace-patterns >tuple ] }

extra/math/polynomials/polynomials.factor

@@ -1,5 +1,5 @@
 USING: arrays kernel sequences vectors math math.vectors namespaces
-shuffle splitting ;
+shuffle splitting sequences.lib ;
 IN: math.polynomials
 
 ! Polynomials are vectors with the highest powers on the right:
@@ -22,7 +22,7 @@ PRIVATE>
 : p= ( p p -- ? ) pextend = ;
 
 : ptrim ( p -- p )
-    dup length 1 = [ [ zero? ] right-trim ] unless ;
+    dup singleton? [ [ zero? ] right-trim ] unless ;
 
 : 2ptrim ( p p -- p p ) [ ptrim ] 2apply ;
 : p+ ( p p -- p ) pextend v+ ;

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
+"$" over append "slot-accessors" create swap [ slot-value ] curry define ;
-define-compound ;
+
+! : 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

extra/mortar/sugar/sugar.factor

@@ -0,0 +1,6 @@
+
+USING: mortar ;
+
+IN: mortar.sugar
+
+: new* ( class -- object ) <<- create ;

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 ;

extra/multiline/multiline-docs.factor

@@ -1,4 +1,5 @@
-USING: help.markup help.syntax multiline ;
+USING: help.markup help.syntax ;
+IN: multiline
 
 HELP: STRING:
 { $syntax "STRING: name\nfoo\n;" }

extra/multiline/multiline.factor

@@ -16,7 +16,7 @@ IN: multiline
 
 : STRING:
     CREATE dup reset-generic
-    parse-here 1quotation define-compound ; parsing
+    parse-here 1quotation define ; parsing
 
 : (parse-multiline-string) ( start-index end-text -- end-index )
     lexer get line-text 2dup start

extra/odbc/odbc-docs.factor

@@ -1,6 +1,8 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.syntax help.markup odbc threads ;
+USING: help.syntax help.markup threads ;
+
+IN: odbc
 
 HELP: odbc-init 
 { $values { "env" "an ODBC environment handle" } }