Merge branch 'master' of git://factorcode.org/git/factor into couchdb

2008-10-28 22:55:18 +11:00 · 2008-10-28 22:55:18 +11:00 · 7186c67354
parent 33e53275e5 89db7676c4
commit 7186c67354
171 changed files with 3064 additions and 1484 deletions
--- a/basis/calendar/unix/unix.factor
+++ b/basis/calendar/unix/unix.factor
@ -4,13 +4,19 @@ USING: alien alien.c-types alien.syntax arrays calendar
 kernel math unix unix.time namespaces system ;
 IN: calendar.unix

-: timeval>unix-time ( timeval -- timestamp )
+: timeval>seconds ( timeval -- seconds )
    [ timeval-sec seconds ] [ timeval-usec microseconds ] bi
-    time+ since-1970 ;
+    time+ ;

-: timespec>unix-time ( timeval -- timestamp )
+: timeval>unix-time ( timeval -- timestamp )
+    timeval>seconds since-1970 ;
+
+: timespec>seconds ( timespec -- seconds )
    [ timespec-sec seconds ] [ timespec-nsec nanoseconds ] bi
-    time+ since-1970 ;
+    time+ ;
+
+: timespec>unix-time ( timespec -- timestamp )
+    timespec>seconds since-1970 ;

 : get-time ( -- alien )
    f time <uint> localtime ;
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@ -3,9 +3,8 @@
 USING: accessors alien alien.c-types alien.strings arrays assocs
 combinators compiler kernel math namespaces make parser
 prettyprint prettyprint.sections quotations sequences strings
-words cocoa.runtime io macros memoize debugger
-io.encodings.ascii effects compiler.generator libc libc.private
-parser lexer init core-foundation ;
+words cocoa.runtime io macros memoize debugger fry
+io.encodings.ascii effects compiler.generator libc libc.private ;
 IN: cocoa.messages

 : make-sender ( method function -- quot )
@ -108,22 +107,34 @@ H{
    { "c" "char" }
    { "i" "int" }
    { "s" "short" }
-    { "l" "long" }
-    { "q" "longlong" }
    { "C" "uchar" }
    { "I" "uint" }
    { "S" "ushort" }
-    { "L" "ulong" }
-    { "Q" "ulonglong" }
    { "f" "float" }
    { "d" "double" }
    { "B" "bool" }
    { "v" "void" }
    { "*" "char*" }
+    { "?" "unknown_type" }
    { "@" "id" }
-    { "#" "id" }
+    { "#" "Class" }
    { ":" "SEL" }
-} objc>alien-types set-global
+}
+"ptrdiff_t" heap-size {
+    { 4 [ H{
+        { "l" "long" }
+        { "q" "longlong" }
+        { "L" "ulong" }
+        { "Q" "ulonglong" }
+    } ] }
+    { 8 [ H{
+        { "l" "long32" }
+        { "q" "long" }
+        { "L" "ulong32" }
+        { "Q" "ulong" }
+    } ] }
+} case
+assoc-union objc>alien-types set-global

 ! The transpose of the above map
 SYMBOL: alien>objc-types
@ -133,15 +144,21 @@ objc>alien-types get [ swap ] assoc-map
 "ptrdiff_t" heap-size {
    { 4 [ H{
        { "NSPoint"    "{_NSPoint=ff}" }
-        { "NSRect" "{_NSRect=ffff}" }
+        { "NSRect"     "{_NSRect={_NSPoint=ff}{_NSSize=ff}}" }
        { "NSSize"     "{_NSSize=ff}" }
        { "NSRange"    "{_NSRange=II}" }
+        { "NSInteger"  "i" }
+        { "NSUInteger" "I" }
+        { "CGFloat"    "f" }
    } ] }
    { 8 [ H{
-        { "NSPoint" "{_NSPoint=dd}" }
-        { "NSRect" "{_NSRect=dddd}" }
-        { "NSSize" "{_NSSize=dd}" }
+        { "NSPoint"    "{CGPoint=dd}" }
+        { "NSRect"     "{CGRect={CGPoint=dd}{CGSize=dd}}" }
+        { "NSSize"     "{CGSize=dd}" }
        { "NSRange"    "{_NSRange=QQ}" }
+        { "NSInteger"  "q" }
+        { "NSUInteger" "Q" }
+        { "CGFloat"    "d" }
    } ] }
 } case
 assoc-union alien>objc-types set-global
@ -184,12 +201,23 @@ assoc-union alien>objc-types set-global
    swap method_getName sel_getName
    objc-methods get set-at ;

-: (register-objc-methods) ( methods count -- methods )
-    over [ void*-nth register-objc-method ] curry each ;
+: each-method-in-class ( class quot -- )
+    [ 0 <uint> [ class_copyMethodList ] keep *uint over ] dip
+    '[ _ void*-nth @ ] each (free) ; inline

 : register-objc-methods ( class -- )
-    0 <uint> [ class_copyMethodList ] keep *uint 
-    (register-objc-methods) (free) ;
+    [ register-objc-method ] each-method-in-class ;
+
+: method. ( method -- )
+    {
+        [ method_getName sel_getName ]
+        [ method-return-type ]
+        [ method-arg-types ]
+        [ method_getImplementation ]
+    } cleave 4array . ;
+
+: methods. ( class -- )
+    [ method. ] each-method-in-class ;

 : class-exists? ( string -- class ) objc_getClass >boolean ;

--- a/basis/cocoa/runtime/runtime.factor
+++ b/basis/cocoa/runtime/runtime.factor
@ -9,7 +9,7 @@ TYPEDEF: void* id

 FUNCTION: char* sel_getName ( SEL aSelector ) ;

-FUNCTION: bool sel_isMapped ( SEL aSelector ) ;
+FUNCTION: char sel_isMapped ( SEL aSelector ) ;

 FUNCTION: SEL sel_registerName ( char* str ) ;

@ -54,6 +54,8 @@ FUNCTION: Method* class_copyMethodList ( Class class, uint* outCount ) ;

 FUNCTION: Class class_getSuperclass ( Class cls ) ;

+FUNCTION: char* class_getName ( Class cls ) ;
+
 FUNCTION: char class_addMethod ( Class class, SEL name, void* imp, void* types ) ;

 FUNCTION: char class_addProtocol ( Class class, Protocol protocol ) ;
@ -73,5 +75,6 @@ FUNCTION: void* method_getTypeEncoding ( Method method ) ;
 FUNCTION: SEL method_getName ( Method method ) ;

 FUNCTION: void* method_setImplementation ( Method method, void* imp ) ; 
+FUNCTION: void* method_getImplementation ( Method method ) ; 

 FUNCTION: Class object_getClass ( id object ) ;
--- a/basis/cocoa/subclassing/subclassing.factor
+++ b/basis/cocoa/subclassing/subclassing.factor
@ -12,12 +12,17 @@ IN: cocoa.subclassing
    [ sel_registerName ] [ execute ] [ ascii string>alien ]
    tri* ;

+: throw-if-false ( YES/NO -- )
+    zero? [ "Failed to add method or protocol to class" throw ]
+    when ;
+
 : add-methods ( methods class -- )
    swap
-    [ init-method class_addMethod drop ] with each ;
+    [ init-method class_addMethod throw-if-false ] with each ;

 : add-protocols ( protocols class -- )
-    swap [ objc-protocol class_addProtocol drop ] with each ;
+    swap [ objc-protocol class_addProtocol throw-if-false ]
+    with each ;

 : (define-objc-class) ( protocols superclass name imeth -- )
    -rot
--- a/basis/cocoa/types/types.factor
+++ b/basis/cocoa/types/types.factor
@ -10,25 +10,6 @@ TYPEDEF: ulong NSUInteger
    { 8 [ "double" ] }
 } case "CGFloat" typedef >>

-C-STRUCT: NSRect
-    { "CGFloat" "x" }
-    { "CGFloat" "y" }
-    { "CGFloat" "w" }
-    { "CGFloat" "h" } ;
-
-TYPEDEF: NSRect _NSRect
-TYPEDEF: NSRect CGRect
-
-: <NSRect> ( x y w h -- rect )
-    "NSRect" <c-object>
-    [ set-NSRect-h ] keep
-    [ set-NSRect-w ] keep
-    [ set-NSRect-y ] keep
-    [ set-NSRect-x ] keep ;
-
-: NSRect-x-y ( alien -- origin-x origin-y )
-    [ NSRect-x ] keep NSRect-y ;
-
 C-STRUCT: NSPoint
    { "CGFloat" "x" }
    { "CGFloat" "y" } ;
@ -47,19 +28,58 @@ C-STRUCT: NSSize

 TYPEDEF: NSSize _NSSize
 TYPEDEF: NSSize CGSize
-TYPEDEF: NSPoint CGPoint

 : <NSSize> ( w h -- size )
    "NSSize" <c-object>
    [ set-NSSize-h ] keep
    [ set-NSSize-w ] keep ;

+C-STRUCT: NSRect
+    { "NSPoint" "origin" }
+    { "NSSize"  "size"   } ;
+
+TYPEDEF: NSRect _NSRect
+TYPEDEF: NSRect CGRect
+
+: NSRect-x ( NSRect -- x )
+    NSRect-origin NSPoint-x ; inline
+: NSRect-y ( NSRect -- y )
+    NSRect-origin NSPoint-y ; inline
+: NSRect-w ( NSRect -- w )
+    NSRect-size NSSize-w ; inline
+: NSRect-h ( NSRect -- h )
+    NSRect-size NSSize-h ; inline
+
+: set-NSRect-x ( x NSRect -- )
+    NSRect-origin set-NSPoint-x ; inline
+: set-NSRect-y ( y NSRect -- )
+    NSRect-origin set-NSPoint-y ; inline
+: set-NSRect-w ( w NSRect -- )
+    NSRect-size set-NSSize-w ; inline
+: set-NSRect-h ( h NSRect -- )
+    NSRect-size set-NSSize-h ; inline
+
+: <NSRect> ( x y w h -- rect )
+    "NSRect" <c-object>
+    [ set-NSRect-h ] keep
+    [ set-NSRect-w ] keep
+    [ set-NSRect-y ] keep
+    [ set-NSRect-x ] keep ;
+
+: NSRect-x-y ( alien -- origin-x origin-y )
+    [ NSRect-x ] keep NSRect-y ;
+
 C-STRUCT: NSRange
    { "NSUInteger" "location" }
    { "NSUInteger" "length" } ;

 TYPEDEF: NSRange _NSRange

+! The "lL" type encodings refer to 32-bit values even in 64-bit mode
+TYPEDEF: int long32
+TYPEDEF: uint ulong32
+TYPEDEF: void* unknown_type
+
 : <NSRange> ( length location -- size )
    "NSRange" <c-object>
    [ set-NSRange-length ] keep
--- a/basis/cpu/x86/assembler/assembler-tests.factor
+++ b/basis/cpu/x86/assembler/assembler-tests.factor
@ -4,9 +4,9 @@ IN: cpu.x86.assembler.tests
 [ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test
 [ { HEX: 49 HEX: 8b HEX: 06 } ] [ [ RAX R14 [] MOV ] { } make ] unit-test

-! [ { HEX: 89 HEX: ca } ] [ [ EDX ECX MOV ] { } make ] unit-test
-! [ { HEX: 4c HEX: 89 HEX: e2 } ] [ [ RDX R12 MOV ] { } make ] unit-test
-! [ { HEX: 49 HEX: 89 HEX: d4 } ] [ [ R12 RDX MOV ] { } make ] unit-test
+[ { HEX: 89 HEX: ca } ] [ [ EDX ECX MOV ] { } make ] unit-test
+[ { HEX: 4c HEX: 89 HEX: e2 } ] [ [ RDX R12 MOV ] { } make ] unit-test
+[ { HEX: 49 HEX: 89 HEX: d4 } ] [ [ R12 RDX MOV ] { } make ] unit-test

 [ { HEX: f2 HEX: 0f HEX: 2c HEX: c0 } ] [ [ EAX XMM0 CVTTSD2SI ] { } make ] unit-test
 [ { HEX: f2 HEX: 48 HEX: 0f HEX: 2c HEX: c0 } ] [ [ RAX XMM0 CVTTSD2SI ] { } make ] unit-test
@ -39,3 +39,21 @@ IN: cpu.x86.assembler.tests

 [ { HEX: 80 HEX: 08 HEX: 05 } ] [ [ EAX [] 5 <byte> OR ] { } make ] unit-test
 [ { HEX: c6 HEX: 00 HEX: 05 } ] [ [ EAX [] 5 <byte> MOV ] { } make ] unit-test
+
+[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1a } ] [ [ R10 RBX [+] RAX MOV ] { } make ] unit-test
+[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1b } ] [ [ R11 RBX [+] RAX MOV ] { } make ] unit-test
+
+[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1c } ] [ [ R12 RBX [+] RAX MOV ] { } make ] unit-test
+[ { HEX: 48 HEX: 89 HEX: 04 HEX: 1c } ] [ [ RSP RBX [+] RAX MOV ] { } make ] unit-test
+
+[ { HEX: 49 HEX: 89 HEX: 44 HEX: 1d HEX: 00 } ] [ [ R13 RBX [+] RAX MOV ] { } make ] unit-test
+[ { HEX: 48 HEX: 89 HEX: 44 HEX: 1d HEX: 00 } ] [ [ RBP RBX [+] RAX MOV ] { } make ] unit-test
+
+[ { HEX: 4a HEX: 89 HEX: 04 HEX: 23 } ] [ [ RBX R12 [+] RAX MOV ] { } make ] unit-test
+[ { HEX: 4a HEX: 89 HEX: 04 HEX: 2b } ] [ [ RBX R13 [+] RAX MOV ] { } make ] unit-test
+
+[ { HEX: 4b HEX: 89 HEX: 44 HEX: 25 HEX: 00 } ] [ [ R13 R12 [+] RAX MOV ] { } make ] unit-test
+[ { HEX: 4b HEX: 89 HEX: 04 HEX: 2c } ] [ [ R12 R13 [+] RAX MOV ] { } make ] unit-test
+
+[ { HEX: 49 HEX: 89 HEX: 04 HEX: 2c } ] [ [ R12 RBP [+] RAX MOV ] { } make ] unit-test
+[ [ R12 RSP [+] RAX MOV ] { } make ] must-fail
--- a/basis/cpu/x86/assembler/assembler.factor
+++ b/basis/cpu/x86/assembler/assembler.factor
@ -64,18 +64,18 @@ M: indirect extended? base>> extended? ;

 : canonicalize-EBP ( indirect -- indirect )
    #! { EBP } ==> { EBP 0 }
-    dup base>> { EBP RBP R13 } member? [
-        dup displacement>> [ 0 >>displacement ] unless
-    ] when ;
+    dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and
+    [ 0 >>displacement ] when ;

-: canonicalize-ESP ( indirect -- indirect )
-    #! { ESP } ==> { ESP ESP }
-    dup base>> { ESP RSP R12 } member? [ ESP >>index ] when ;
+ERROR: bad-index indirect ;
+
+: check-ESP ( indirect -- indirect )
+    dup index>> { ESP RSP } memq? [ bad-index ] when ;

 : canonicalize ( indirect -- indirect )
    #! Modify the indirect to work around certain addressing mode
    #! quirks.
-    canonicalize-EBP canonicalize-ESP ;
+    canonicalize-EBP check-ESP ;

 : <indirect> ( base index scale displacement -- indirect )
    indirect boa canonicalize ;
@ -91,7 +91,7 @@ M: indirect extended? base>> extended? ;
 GENERIC: sib-present? ( op -- ? )

 M: indirect sib-present?
-    [ base>> { ESP RSP } member? ] [ index>> ] [ scale>> ] tri or or ;
+    [ base>> { ESP RSP R12 } member? ] [ index>> ] [ scale>> ] tri or or ;

 M: register sib-present? drop f ;

@ -254,7 +254,8 @@ M: object operand-64? drop f ;
    reg-code swap addressing ;

 : direction-bit ( dst src op -- dst' src' op' )
-    pick register? [ BIN: 10 opcode-or swapd ] when ;
+    pick register? pick register? not and
+    [ BIN: 10 opcode-or swapd ] when ;

 : operand-size-bit ( dst src op -- dst' src' op' )
    over register-8? [ BIN: 1 opcode-or ] unless ;
--- a/basis/db/queries/queries.factor
+++ b/basis/db/queries/queries.factor
@ -166,9 +166,11 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
    swap 3append ;

 : do-group ( tuple groups -- )
+    dup string? [ 1array ] when
    [ ", " join " group by " splice ] curry change-sql drop ;

 : do-order ( tuple order -- )
+    dup string? [ 1array ] when
    [ ", " join " order by " splice ] curry change-sql drop ;

 : do-offset ( tuple n -- )
--- a/basis/db/sqlite/lib/lib.factor
+++ b/basis/db/sqlite/lib/lib.factor
@ -5,7 +5,7 @@ namespaces sequences db.sqlite.ffi db combinators
 continuations db.types calendar.format serialize
 io.streams.byte-array byte-arrays io.encodings.binary
 io.backend db.errors present urls io.encodings.utf8
-io.encodings.string accessors ;
+io.encodings.string accessors shuffle ;
 IN: db.sqlite.lib

 ERROR: sqlite-error < db-error n string ;
@ -79,6 +79,9 @@ ERROR: sqlite-sql-error < sql-error n string ;
 : sqlite-bind-uint64-by-name ( handle name int64 -- )
    parameter-index sqlite-bind-uint64 ;

+: sqlite-bind-boolean-by-name ( handle name obj -- )
+    >boolean 1 0 ? parameter-index sqlite-bind-int ;
+
 : sqlite-bind-double-by-name ( handle name double -- )
    parameter-index sqlite-bind-double ;

@ -88,14 +91,14 @@ ERROR: sqlite-sql-error < sql-error n string ;
 : sqlite-bind-null-by-name ( handle name obj -- )
    parameter-index drop sqlite-bind-null ;

-: sqlite-bind-type ( handle key value type -- )
-    over [ drop NULL ] unless
+: (sqlite-bind-type) ( handle key value type -- )
    dup array? [ first ] when
    {
        { INTEGER [ sqlite-bind-int-by-name ] }
        { BIG-INTEGER [ sqlite-bind-int64-by-name ] }
        { SIGNED-BIG-INTEGER [ sqlite-bind-int64-by-name ] }
        { UNSIGNED-BIG-INTEGER [ sqlite-bind-uint64-by-name ] }
+        { BOOLEAN [ sqlite-bind-boolean-by-name ] }
        { TEXT [ sqlite-bind-text-by-name ] }
        { VARCHAR [ sqlite-bind-text-by-name ] }
        { DOUBLE [ sqlite-bind-double-by-name ] }
@ -104,10 +107,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
        { DATETIME [ timestamp>ymdhms sqlite-bind-text-by-name ] }
        { TIMESTAMP [ timestamp>ymdhms sqlite-bind-text-by-name ] }
        { BLOB [ sqlite-bind-blob-by-name ] }
-        { FACTOR-BLOB [
-            object>bytes
-            sqlite-bind-blob-by-name
-        ] }
+        { FACTOR-BLOB [ object>bytes sqlite-bind-blob-by-name ] }
        { URL [ present sqlite-bind-text-by-name ] }
        { +db-assigned-id+ [ sqlite-bind-int-by-name ] }
        { +random-id+ [ sqlite-bind-int64-by-name ] }
@ -115,6 +115,14 @@ ERROR: sqlite-sql-error < sql-error n string ;
        [ no-sql-type ]
    } case ;

+: sqlite-bind-type ( handle key value type -- )
+    #! null and empty values need to be set by sqlite-bind-null-by-name
+    over [
+        NULL = [ 2drop NULL NULL ] when
+    ] [
+        drop NULL 
+    ] if* (sqlite-bind-type) ;
+
 : sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ;
 : sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
 : sqlite-clear-bindings ( handle -- )
@ -141,6 +149,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
        { BIG-INTEGER [ sqlite3_column_int64 ] }
        { SIGNED-BIG-INTEGER [ sqlite3_column_int64 ] }
        { UNSIGNED-BIG-INTEGER [ sqlite3-column-uint64 ] }
+        { BOOLEAN [ sqlite3_column_int 1 = ] }
        { DOUBLE [ sqlite3_column_double ] }
        { TEXT [ sqlite3_column_text ] }
        { VARCHAR [ sqlite3_column_text ] }
@ -150,11 +159,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
        { DATETIME [ sqlite3_column_text dup [ ymdhms>timestamp ] when ] }
        { BLOB [ sqlite-column-blob ] }
        { URL [ sqlite3_column_text dup [ >url ] when ] }
-        { FACTOR-BLOB [
-            sqlite-column-blob
-            dup [ bytes>object ] when
-        ] }
-        ! { NULL [ 2drop f ] }
+        { FACTOR-BLOB [ sqlite-column-blob dup [ bytes>object ] when ] }
        [ no-sql-type ]
    } case ;

--- a/basis/db/sqlite/sqlite.factor
+++ b/basis/db/sqlite/sqlite.factor
@ -185,6 +185,7 @@ M: sqlite-db persistent-table ( -- assoc )
        { +set-null+ { f f "set null" } }
        { +set-default+ { f f "set default" } }

+        { BOOLEAN { "boolean" "boolean" f } }
        { INTEGER { "integer" "integer" f } }
        { BIG-INTEGER { "bigint" "bigint" f } }
        { SIGNED-BIG-INTEGER { "bigint" "bigint" f } }
--- a/basis/debugger/debugger-docs.factor
+++ b/basis/debugger/debugger-docs.factor
@ -1,7 +1,6 @@
 USING: alien arrays generic generic.math help.markup help.syntax
 kernel math memory strings sbufs vectors io io.files classes
-help generic.standard continuations system io.files.private
-listener ;
+help generic.standard continuations io.files.private listener ;
 IN: debugger

 ARTICLE: "debugger" "The debugger"
@ -144,5 +143,4 @@ HELP: memory-error.
 { $notes "This can be a result of incorrect usage of C library interface words, a bug in the compiler, or a bug in the VM." } ;

 HELP: primitive-error.
-{ $error-description "Thrown by the Factor VM if an unsupported primitive word is called." }
-{ $notes "This word is only ever thrown on Windows CE, where the " { $link cwd } ", " { $link cd } ", and " { $link os-env } " primitives are unsupported." } ;
+{ $error-description "Thrown by the Factor VM if an unsupported primitive word is called." } ;
--- a/basis/editors/editors.factor
+++ b/basis/editors/editors.factor
@ -27,7 +27,8 @@ SYMBOL: edit-hook

 : edit-location ( file line -- )
    >r (normalize-path) r>
-    edit-hook get [ call ] [ no-edit-hook edit-location ] if* ;
+    edit-hook get-global
+    [ call ] [ no-edit-hook edit-location ] if* ;

 : edit ( defspec -- )
    where [ first2 edit-location ] when* ;
--- a/basis/environment/authors.txt
+++ b/basis/environment/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/environment/environment-docs.factor
+++ b/basis/environment/environment-docs.factor
@ -0,0 +1,68 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs help.markup help.syntax io.streams.string sequences strings ;
+IN: environment
+
+HELP: (os-envs)
+{ $values
+    
+     { "seq" sequence } }
+{ $description "" } ;
+
+HELP: (set-os-envs)
+{ $values
+     { "seq" sequence } }
+{ $description "" } ;
+
+
+HELP: os-env ( key -- value )
+{ $values { "key" string } { "value" string } }
+{ $description "Looks up the value of a shell environment variable." }
+{ $examples
+    "This is an operating system-specific feature. On Unix, you can do:"
+    { $unchecked-example "\"USER\" os-env print" "jane" }
+} ;
+
+HELP: os-envs
+{ $values { "assoc" "an association mapping strings to strings" } }
+{ $description "Outputs the current set of environment variables." }
+{ $notes
+    "Names and values of environment variables are operating system-specific."
+} ;
+
+HELP: set-os-envs
+{ $values { "assoc" "an association mapping strings to strings" } }
+{ $description "Replaces the current set of environment variables." }
+{ $notes
+    "Names and values of environment variables are operating system-specific. Windows NT allows values up to 32766 characters in length."
+} ;
+
+HELP: set-os-env ( value key -- )
+{ $values { "value" string } { "key" string } }
+{ $description "Set an environment variable." }
+{ $notes
+    "Names and values of environment variables are operating system-specific."
+} ;
+
+HELP: unset-os-env ( key -- )
+{ $values { "key" string } }
+{ $description "Unset an environment variable." }
+{ $notes
+    "Names and values of environment variables are operating system-specific."
+} ;
+
+{ os-env os-envs set-os-env unset-os-env set-os-envs } related-words
+
+
+ARTICLE: "environment" "Environment variables"
+"The " { $vocab-link "environment" } " vocabulary interfaces to the platform-dependent mechanism for setting environment variables." $nl
+"Windows CE has no concept of environment variables, so these words are undefined on that platform." $nl
+"Reading environment variables:"
+{ $subsection os-env }
+{ $subsection os-envs }
+"Writing environment variables:"
+{ $subsection set-os-env }
+{ $subsection unset-os-env }
+{ $subsection set-os-envs } ;
+
+ABOUT: "environment"
--- a/basis/environment/environment-tests.factor
+++ b/basis/environment/environment-tests.factor
@ -0,0 +1,29 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces prettyprint system tools.test
+environment strings sequences ;
+IN: environment.tests
+
+os wince? [
+    [ ] [ os-envs . ] unit-test
+
+    os unix? [
+        [ ] [ os-envs "envs" set ] unit-test
+        [ ] [ { { "A" "B" } } set-os-envs ] unit-test
+        [ "B" ] [ "A" os-env ] unit-test
+        [ ] [ "envs" get set-os-envs ] unit-test
+        [ t ] [ os-envs "envs" get = ] unit-test
+    ] when
+
+    [ ] [ "factor-test-key-1" unset-os-env ] unit-test
+    [ ] [ "ps3" "factor-test-key-1" set-os-env ] unit-test
+    [ "ps3" ] [ "factor-test-key-1" os-env ] unit-test
+    [ ] [ "factor-test-key-1" unset-os-env ] unit-test
+    [ f ] [ "factor-test-key-1" os-env ] unit-test
+
+    [ ] [
+        32766 CHAR: a <string> "factor-test-key-long" set-os-env
+    ] unit-test
+    [ 32766 ] [ "factor-test-key-long" os-env length ] unit-test
+    [ ] [ "factor-test-key-long" unset-os-env ] unit-test
+] unless
--- a/basis/environment/environment.factor
+++ b/basis/environment/environment.factor
@ -0,0 +1,27 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs combinators kernel sequences splitting system
+vocabs.loader ;
+IN: environment
+
+HOOK: os-env os ( key -- value )
+
+HOOK: set-os-env os ( value key -- )
+
+HOOK: unset-os-env os ( key -- )
+
+HOOK: (os-envs) os ( -- seq )
+
+HOOK: (set-os-envs) os ( seq -- )
+
+: os-envs ( -- assoc )
+    (os-envs) [ "=" split1 ] H{ } map>assoc ;
+
+: set-os-envs ( assoc -- )
+    [ "=" swap 3append ] { } assoc>map (set-os-envs) ;
+
+{
+    { [ os unix? ] [ "environment.unix" require ] }
+    { [ os winnt? ] [ "environment.winnt" require ] }
+    { [ os wince? ] [ ] }
+} cond
--- a/basis/environment/summary.txt
+++ b/basis/environment/summary.txt
@ -0,0 +1 @@
+Environment variables
--- a/basis/environment/unix/authors.txt
+++ b/basis/environment/unix/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/environment/unix/macosx/authors.txt
+++ b/basis/environment/unix/macosx/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/environment/unix/macosx/macosx.factor
+++ b/basis/environment/unix/macosx/macosx.factor
@ -0,0 +1,8 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax system environment.unix ;
+IN: environment.unix.macosx
+
+FUNCTION: void* _NSGetEnviron ( ) ;
+
+M: macosx environ _NSGetEnviron ;
--- a/basis/environment/unix/macosx/tags.txt
+++ b/basis/environment/unix/macosx/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/environment/unix/tags.txt
+++ b/basis/environment/unix/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/environment/unix/unix.factor
+++ b/basis/environment/unix/unix.factor
@ -0,0 +1,29 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types alien.strings alien.syntax kernel
+layouts sequences system unix environment io.encodings.utf8
+unix.utilities vocabs.loader combinators alien.accessors ;
+IN: environment.unix
+
+HOOK: environ os ( -- void* )
+
+M: unix environ ( -- void* ) "environ" f dlsym ;
+
+M: unix os-env ( key -- value ) getenv ;
+
+M: unix set-os-env ( value key -- ) swap 1 setenv io-error ;
+
+M: unix unset-os-env ( key -- ) unsetenv io-error ;
+
+M: unix (os-envs) ( -- seq )
+    environ *void* utf8 alien>strings ;
+
+: set-void* ( value alien -- ) 0 set-alien-cell ;
+
+M: unix (set-os-envs) ( seq -- )
+    utf8 strings>alien malloc-byte-array environ set-void* ;
+
+os {
+    { macosx [ "environment.unix.macosx" require ] }
+    [ drop ]
+} case
--- a/basis/environment/winnt/authors.txt
+++ b/basis/environment/winnt/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/environment/winnt/tags.txt
+++ b/basis/environment/winnt/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/environment/winnt/winnt.factor
+++ b/basis/environment/winnt/winnt.factor
@ -0,0 +1,33 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.strings fry io.encodings.utf16 kernel
+splitting windows windows.kernel32 system environment
+alien.c-types sequences windows.errors io.streams.memory
+io.encodings io ;
+IN: environment.winnt
+
+M: winnt os-env ( key -- value )
+    MAX_UNICODE_PATH "TCHAR" <c-array>
+    [ dup length GetEnvironmentVariable ] keep over 0 = [
+        2drop f
+    ] [
+        nip utf16n alien>string
+    ] if ;
+
+M: winnt set-os-env ( value key -- )
+    swap SetEnvironmentVariable win32-error=0/f ;
+
+M: winnt unset-os-env ( key -- )
+    f SetEnvironmentVariable 0 = [
+        GetLastError ERROR_ENVVAR_NOT_FOUND =
+        [ win32-error ] unless
+    ] when ;
+
+M: winnt (os-envs) ( -- seq )
+    GetEnvironmentStrings [
+        <memory-stream> [
+            utf16n decode-input
+            [ "\0" read-until drop dup empty? not ]
+            [ ] [ drop ] produce
+        ] with-input-stream*
+    ] [ FreeEnvironmentStrings win32-error=0/f ] bi ;
--- a/basis/http/http-tests.factor
+++ b/basis/http/http-tests.factor
@ -192,15 +192,17 @@ test-db [
    init-furnace-tables
 ] with-db

-: test-httpd ( -- )
-    #! Return as soon as server is running.
+: test-httpd ( responder -- )
+    [
+        main-responder set
        <http-server>
-        1237 >>insecure
+            0 >>insecure
            f >>secure
-    start-server* ;
+        dup start-server*
+        sockets>> first addr>> port>>
+    ] with-scope "port" set ;

 [ ] [
-    [
    <dispatcher>
        add-quit-action
        <dispatcher>
@ -209,49 +211,46 @@ test-db [
        <action>
            [ URL" redirect-loop" <temporary-redirect> ] >>display
        "redirect-loop" add-responder
-        main-responder set

    test-httpd
-    ] with-scope
 ] unit-test

+: add-port ( url -- url' )
+    >url clone "port" get >>port ;
+
 [ t ] [
    "resource:basis/http/test/foo.html" ascii file-contents
-    "http://localhost:1237/nested/foo.html" http-get nip =
+    "http://localhost/nested/foo.html" add-port http-get nip =
 ] unit-test

-[ "http://localhost:1237/redirect-loop" http-get nip ]
+[ "http://localhost/redirect-loop" add-port http-get nip ]
 [ too-many-redirects? ] must-fail-with

 [ "Goodbye" ] [
-    "http://localhost:1237/quit" http-get nip
+    "http://localhost/quit" add-port http-get nip
 ] unit-test

 ! HTTP client redirect bug
 [ ] [
-    [
    <dispatcher>
        add-quit-action
        <action> [ "quit" <temporary-redirect> ] >>display
        "redirect" add-responder
-        main-responder set

    test-httpd
-    ] with-scope
 ] unit-test

 [ "Goodbye" ] [
-    "http://localhost:1237/redirect" http-get nip
+    "http://localhost/redirect" add-port http-get nip
 ] unit-test


 [ ] [
-    [ "http://localhost:1237/quit" http-get 2drop ] ignore-errors
+    [ "http://localhost/quit" add-port http-get 2drop ] ignore-errors
 ] unit-test

 ! Dispatcher bugs
 [ ] [
-    [
    <dispatcher>
        <action> <protected>
        "Test" <login-realm>
@ -262,24 +261,21 @@ test-db [
            <action> "" add-responder
        "d" add-responder
    test-db <db-persistence>
-        main-responder set

    test-httpd
-    ] with-scope
 ] unit-test

 : 404? [ download-failed? ] [ response>> code>> 404 = ] bi and ;

 ! This should give a 404 not an infinite redirect loop
-[ "http://localhost:1237/d/blah" http-get nip ] [ 404? ] must-fail-with
+[ "http://localhost/d/blah" add-port http-get nip ] [ 404? ] must-fail-with

 ! This should give a 404 not an infinite redirect loop
-[ "http://localhost:1237/blah/" http-get nip ] [ 404? ] must-fail-with
+[ "http://localhost/blah/" add-port http-get nip ] [ 404? ] must-fail-with

-[ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test
+[ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test

 [ ] [
-    [
    <dispatcher>
        <action> [ [ "Hi" write ] "text/plain" <content> ] >>display
        "Test" <login-realm>
@ -287,15 +283,13 @@ test-db [
        "" add-responder
        add-quit-action
    test-db <db-persistence>
-        main-responder set

    test-httpd
-    ] with-scope
 ] unit-test

-[ "Hi" ] [ "http://localhost:1237/" http-get nip ] unit-test
+[ "Hi" ] [ "http://localhost/" add-port http-get nip ] unit-test

-[ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test
+[ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test

 USING: html.components html.elements html.forms
 xml xml.utilities validators
@ -304,7 +298,6 @@ furnace furnace.conversations ;
 SYMBOL: a

 [ ] [
-    [
    <dispatcher>
        <action>
            [ a get-global "a" set-value ] >>init
@ -316,10 +309,8 @@ SYMBOL: a
        >>default
        add-quit-action
    test-db <db-persistence>
-        main-responder set

    test-httpd
-    ] with-scope
 ] unit-test

 3 a set-global
@ -327,27 +318,35 @@ SYMBOL: a
 : test-a string>xml "input" tag-named "value" swap at ;

 [ "3" ] [
-    "http://localhost:1237/" http-get
+    "http://localhost/" add-port http-get
    swap dup cookies>> "cookies" set session-id-key get-cookie
    value>> "session-id" set test-a
 ] unit-test

 [ "4" ] [
-    H{ { "a" "4" } { "__u" "http://localhost:1237/" } } "session-id" get session-id-key associate assoc-union
-    "http://localhost:1237/" <post-request> "cookies" get >>cookies http-request nip test-a
+    [
+        "4" "a" set
+        "http://localhost" add-port "__u" set
+        "session-id" get session-id-key set
+    ] H{ } make-assoc
+    "http://localhost/" add-port <post-request> "cookies" get >>cookies http-request nip test-a
 ] unit-test

 [ 4 ] [ a get-global ] unit-test

 ! Test flash scope
 [ "xyz" ] [
-    H{ { "a" "xyz" } { "__u" "http://localhost:1237/" } } "session-id" get session-id-key associate assoc-union
-    "http://localhost:1237/" <post-request> "cookies" get >>cookies http-request nip test-a
+    [
+        "xyz" "a" set
+        "http://localhost" add-port "__u" set
+        "session-id" get session-id-key set
+    ] H{ } make-assoc
+    "http://localhost/" add-port <post-request> "cookies" get >>cookies http-request nip test-a
 ] unit-test

 [ 4 ] [ a get-global ] unit-test

-[ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test
+[ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test

 ! Test cloning
 [ f ] [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test
--- a/basis/http/server/static/static.factor
+++ b/basis/http/server/static/static.factor
@ -59,8 +59,8 @@ TUPLE: file-responder root hook special allow-listings ;

 \ serve-file NOTICE add-input-logging

-: file. ( name dirp -- )
-    [ "/" append ] when
+: file. ( name -- )
+    dup link-info directory? [ "/" append ] when
    dup <a =href a> escape-string write </a> ;

 : directory. ( path -- )
@ -68,8 +68,7 @@ TUPLE: file-responder root hook special allow-listings ;
        [ <h1> file-name escape-string write </h1> ]
        [
            <ul>
-                directory sort-keys
-                [ <li> file. </li> ] assoc-each
+                directory-files [ <li> file. </li> ] each
            </ul>
        ] bi
    ] simple-page ;
--- a/basis/io/launcher/launcher.factor
+++ b/basis/io/launcher/launcher.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: system kernel namespaces strings hashtables sequences 
 assocs combinators vocabs.loader init threads continuations
-math accessors concurrency.flags destructors
+math accessors concurrency.flags destructors environment
 io io.backend io.timeouts io.pipes io.pipes.private io.encodings
 io.streams.duplex io.ports debugger prettyprint summary ;
 IN: io.launcher
@ -58,8 +58,6 @@ SYMBOL: +realtime-priority+
 ! Non-blocking process exit notification facility
 SYMBOL: processes

-[ H{ } clone processes set-global ] "io.launcher" add-init-hook
-
 HOOK: wait-for-processes io-backend ( -- ? )

 SYMBOL: wait-flag
@ -73,7 +71,10 @@ SYMBOL: wait-flag
    <flag> wait-flag set-global
    [ wait-loop t ] "Process wait" spawn-server drop ;

-[ start-wait-thread ] "io.launcher" add-init-hook
+[
+    H{ } clone processes set-global
+    start-wait-thread
+] "io.launcher" add-init-hook

 : process-started ( process handle -- )
    >>handle
--- a/basis/io/monitors/recursive/recursive.factor
+++ b/basis/io/monitors/recursive/recursive.factor
@ -19,11 +19,14 @@ DEFER: add-child-monitor

 : add-child-monitors ( path -- )
    #! We yield since this directory scan might take a while.
-    directory* [ first add-child-monitor ] each yield ;
+    dup [
+        [ append-path ] with map
+        [ add-child-monitor ] each yield
+    ] with-directory-files ;

 : add-child-monitor ( path -- )
    notify? [ dup { +add-file+ } monitor tget queue-change ] when
-    qualify-path dup link-info type>> +directory+ eq? [
+    qualify-path dup link-info directory? [
        [ add-child-monitors ]
        [
            [
--- a/basis/io/servers/connection/connection-tests.factor
+++ b/basis/io/servers/connection/connection-tests.factor
@ -27,25 +27,12 @@ concurrency.promises io.encodings.ascii io threads calendar ;
    init-server semaphore>> count>> 
 ] unit-test

-[ ] [ <promise> "p" set ] unit-test
-
 [ ] [
    <threaded-server>
        5 >>max-connections
-        1237 >>insecure
+        0 >>insecure
        [ "Hello world." write stop-this-server ] >>handler
-    "server" set
+    dup start-server* sockets>> first addr>> port>> "port" set
 ] unit-test

-[ ] [
-    [
-        "server" get start-server
-        t "p" get fulfill
-    ] in-thread
-] unit-test
-
-[ ] [ "server" get wait-for-server ] unit-test
-
-[ "Hello world." ] [ "localhost" 1237 <inet> ascii <client> drop contents ] unit-test
-
-[ t ] [ "p" get 2 seconds ?promise-timeout ] unit-test
+[ "Hello world." ] [ "localhost" "port" get <inet> ascii <client> drop contents ] unit-test
--- a/basis/io/unix/files/bsd/bsd.factor
+++ b/basis/io/unix/files/bsd/bsd.factor
@ -13,5 +13,8 @@ M: bsd stat>file-info ( stat -- file-info )
    {
        [ stat-st_flags >>flags ]
        [ stat-st_gen >>gen ]
-        [ stat-st_birthtimespec timespec>unix-time >>birth-time ]
+        [
+            stat-st_birthtimespec timespec>unix-time
+            >>birth-time
+        ]
    } cleave ;
--- a/basis/io/unix/files/files-docs.factor
+++ b/basis/io/unix/files/files-docs.factor
@ -36,39 +36,39 @@ HELP: file-user-id

 HELP: group-execute?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "group execute" } " bit is set on a file." } ;
+{ $description "Tests whether the " { $snippet "group execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 HELP: group-read?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string, file-info object, or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file." } ;
+{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 HELP: group-write?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string, file-info object, or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file." } ;
+{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 HELP: other-execute?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string, file-info object, or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file." } ;
+{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 HELP: other-read?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string, file-info object, or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file." } ;
+{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 HELP: other-write?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string, file-info object, or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file." } ;
+{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 HELP: set-file-access-time
 { $values
@ -124,9 +124,9 @@ HELP: set-gid

 HELP: gid?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string, file-info object, or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file." } ;
+{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 HELP: set-group-execute
 { $values
@ -165,9 +165,9 @@ HELP: set-sticky

 HELP: sticky?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string, file-info object, or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "sticky" } " bit of a file is set." } ;
+{ $description "Tests whether the " { $snippet "sticky" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 HELP: set-uid
 { $values
@ -176,9 +176,9 @@ HELP: set-uid

 HELP: uid?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string, file-info object, or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "uid" } " bit of a file is set." } ;
+{ $description "Tests whether the " { $snippet "uid" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 HELP: set-user-execute
 { $values
@ -197,21 +197,21 @@ HELP: set-user-write

 HELP: user-execute?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string, file-info object, or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file." } ;
+{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 HELP: user-read?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string, file-info object, or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file." } ;
+{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 HELP: user-write?
 { $values
-     { "path" "a pathname string" }
+     { "obj" "a pathname string, file-info object, or an integer" }
     { "?" "a boolean" } }
-{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file." } ;
+{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file, " { $link file-info } ", or an integer." } ;

 ARTICLE: "unix-file-permissions" "Unix file permissions"
 "Reading all file permissions:"
--- a/basis/io/unix/files/files-tests.factor
+++ b/basis/io/unix/files/files-tests.factor
@ -55,32 +55,32 @@ prepare-test-file
 [ t ] [ test-file other-write? ] unit-test
 [ t ] [ test-file other-execute? ] unit-test

-[ t ]
-[ test-file f set-other-execute perms OCT: 776 = ] unit-test
+[ t ] [ test-file f set-other-execute perms OCT: 776 = ] unit-test
+[ f ] [ test-file file-info other-execute? ] unit-test

-[ t ]
-[ test-file f set-other-write perms OCT: 774 = ] unit-test
+[ t ] [ test-file f set-other-write perms OCT: 774 = ] unit-test
+[ f ] [ test-file file-info other-write? ] unit-test

-[ t ]
-[ test-file f set-other-read perms OCT: 770 = ] unit-test
+[ t ] [ test-file f set-other-read perms OCT: 770 = ] unit-test
+[ f ] [ test-file file-info other-read? ] unit-test

-[ t ]
-[ test-file f set-group-execute perms OCT: 760 = ] unit-test
+[ t ] [ test-file f set-group-execute perms OCT: 760 = ] unit-test
+[ f ] [ test-file file-info group-execute? ] unit-test

-[ t ]
-[ test-file f set-group-write perms OCT: 740 = ] unit-test
+[ t ] [ test-file f set-group-write perms OCT: 740 = ] unit-test
+[ f ] [ test-file file-info group-write? ] unit-test

-[ t ]
-[ test-file f set-group-read perms OCT: 700 = ] unit-test
+[ t ] [ test-file f set-group-read perms OCT: 700 = ] unit-test
+[ f ] [ test-file file-info group-read? ] unit-test

-[ t ]
-[ test-file f set-user-execute perms OCT: 600 = ] unit-test
+[ t ] [ test-file f set-user-execute perms OCT: 600 = ] unit-test
+[ f ] [ test-file file-info other-execute? ] unit-test

-[ t ]
-[ test-file f set-user-write perms OCT: 400 = ] unit-test
+[ t ] [ test-file f set-user-write perms OCT: 400 = ] unit-test
+[ f ] [ test-file file-info other-write? ] unit-test

-[ t ]
-[ test-file f set-user-read perms OCT: 000 = ] unit-test
+[ t ] [ test-file f set-user-read perms OCT: 000 = ] unit-test
+[ f ] [ test-file file-info other-read? ] unit-test

 [ t ]
 [ test-file { USER-ALL GROUP-ALL OTHER-EXECUTE } flags set-file-permissions perms OCT: 771 = ] unit-test
@ -135,3 +135,29 @@ prepare-test-file

 [ ]
 [ test-file f f set-file-ids ] unit-test
+
+[ t ] [ OCT: 4000 uid? ] unit-test
+[ t ] [ OCT: 2000 gid? ] unit-test
+[ t ] [ OCT: 1000 sticky? ] unit-test
+[ t ] [ OCT: 400 user-read? ] unit-test
+[ t ] [ OCT: 200 user-write? ] unit-test
+[ t ] [ OCT: 100 user-execute? ] unit-test
+[ t ] [ OCT: 040 group-read? ] unit-test
+[ t ] [ OCT: 020 group-write? ] unit-test
+[ t ] [ OCT: 010 group-execute? ] unit-test
+[ t ] [ OCT: 004 other-read? ] unit-test
+[ t ] [ OCT: 002 other-write? ] unit-test
+[ t ] [ OCT: 001 other-execute? ] unit-test
+
+[ f ] [ 0 uid? ] unit-test
+[ f ] [ 0 gid? ] unit-test
+[ f ] [ 0 sticky? ] unit-test
+[ f ] [ 0 user-read? ] unit-test
+[ f ] [ 0 user-write? ] unit-test
+[ f ] [ 0 user-execute? ] unit-test
+[ f ] [ 0 group-read? ] unit-test
+[ f ] [ 0 group-write? ] unit-test
+[ f ] [ 0 group-execute? ] unit-test
+[ f ] [ 0 other-read? ] unit-test
+[ f ] [ 0 other-write? ] unit-test
+[ f ] [ 0 other-execute? ] unit-test
--- a/basis/io/unix/files/files.factor
+++ b/basis/io/unix/files/files.factor
@ -5,7 +5,8 @@ unix unix.stat unix.time kernel math continuations
 math.bitwise byte-arrays alien combinators calendar
 io.encodings.binary accessors sequences strings system
 io.files.private destructors vocabs.loader calendar.unix
-unix.stat alien.c-types arrays unix.users unix.groups ;
+unix.stat alien.c-types arrays unix.users unix.groups
+environment fry io.encodings.utf8 alien.strings unix.statfs ;
 IN: io.unix.files

 M: unix cwd ( -- path )
@ -137,6 +138,27 @@ os {
    { linux [ ] }
 } case

+: with-unix-directory ( path quot -- )
+    [ opendir dup [ (io-error) ] unless ] dip
+    dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
+
+: find-next-file ( DIR* -- byte-array )
+    "dirent" <c-object>
+    f <void*>
+    [ readdir_r 0 = [ (io-error) ] unless ] 2keep
+    *void* [ drop f ] unless ;
+
+M: unix >directory-entry ( byte-array -- directory-entry )
+    [ dirent-d_name utf8 alien>string ]
+    [ dirent-d_type ] bi directory-entry boa ;
+
+M: unix (directory-entries) ( path -- seq )
+    [
+        '[ _ find-next-file dup ]
+        [ >directory-entry ]
+        [ drop ] produce
+    ] with-unix-directory ;
+
 <PRIVATE

 : stat-mode ( path -- mode )
@ -166,18 +188,57 @@ PRIVATE>
 : OTHER-WRITE   OCT: 0000002 ; inline  
 : OTHER-EXECUTE OCT: 0000001 ; inline    

-: uid? ( path -- ? ) UID file-mode? ;
-: gid? ( path -- ? ) GID file-mode? ;
-: sticky? ( path -- ? ) STICKY file-mode? ;
-: user-read? ( path -- ? ) USER-READ file-mode? ;
-: user-write? ( path -- ? ) USER-WRITE file-mode? ;
-: user-execute? ( path -- ? ) USER-EXECUTE file-mode? ;
-: group-read? ( path -- ? ) GROUP-READ file-mode? ;
-: group-write? ( path -- ? ) GROUP-WRITE file-mode? ;
-: group-execute? ( path -- ? ) GROUP-EXECUTE file-mode? ;
-: other-read? ( path -- ? ) OTHER-READ file-mode? ;
-: other-write? ( path -- ? ) OTHER-WRITE file-mode? ; 
-: other-execute? ( path -- ? ) OTHER-EXECUTE file-mode? ;
+GENERIC: uid? ( obj -- ? )
+GENERIC: gid? ( obj -- ? )
+GENERIC: sticky? ( obj -- ? )
+GENERIC: user-read? ( obj -- ? )
+GENERIC: user-write? ( obj -- ? )
+GENERIC: user-execute? ( obj -- ? )
+GENERIC: group-read? ( obj -- ? )
+GENERIC: group-write? ( obj -- ? )
+GENERIC: group-execute? ( obj -- ? )
+GENERIC: other-read? ( obj -- ? )
+GENERIC: other-write? ( obj -- ? )
+GENERIC: other-execute? ( obj -- ? )
+
+M: integer uid? ( integer -- ? ) UID mask? ;
+M: integer gid? ( integer -- ? ) GID mask? ;
+M: integer sticky? ( integer -- ? ) STICKY mask? ;
+M: integer user-read? ( integer -- ? ) USER-READ mask? ;
+M: integer user-write? ( integer -- ? ) USER-WRITE mask? ;
+M: integer user-execute? ( integer -- ? ) USER-EXECUTE mask? ;
+M: integer group-read? ( integer -- ? ) GROUP-READ mask? ;
+M: integer group-write? ( integer -- ? ) GROUP-WRITE mask? ;
+M: integer group-execute? ( integer -- ? ) GROUP-EXECUTE mask? ;
+M: integer other-read? ( integer -- ? ) OTHER-READ mask? ;
+M: integer other-write? ( integer -- ? ) OTHER-WRITE mask? ; 
+M: integer other-execute? ( integer -- ? ) OTHER-EXECUTE mask? ;
+
+M: file-info uid? ( file-info -- ? ) permissions>> uid? ;
+M: file-info gid? ( file-info -- ? ) permissions>> gid? ;
+M: file-info sticky? ( file-info -- ? ) permissions>> sticky? ;
+M: file-info user-read? ( file-info -- ? ) permissions>> user-read? ;
+M: file-info user-write? ( file-info -- ? ) permissions>> user-write? ;
+M: file-info user-execute? ( file-info -- ? ) permissions>> user-execute? ;
+M: file-info group-read? ( file-info -- ? ) permissions>> group-read? ;
+M: file-info group-write? ( file-info -- ? ) permissions>> group-write? ;
+M: file-info group-execute? ( file-info -- ? ) permissions>> group-execute? ;
+M: file-info other-read? ( file-info -- ? ) permissions>> other-read? ;
+M: file-info other-write? ( file-info -- ? ) permissions>> other-write? ;
+M: file-info other-execute? ( file-info -- ? ) permissions>> other-execute? ;
+
+M: string uid? ( path -- ? ) UID file-mode? ;
+M: string gid? ( path -- ? ) GID file-mode? ;
+M: string sticky? ( path -- ? ) STICKY file-mode? ;
+M: string user-read? ( path -- ? ) USER-READ file-mode? ;
+M: string user-write? ( path -- ? ) USER-WRITE file-mode? ;
+M: string user-execute? ( path -- ? ) USER-EXECUTE file-mode? ;
+M: string group-read? ( path -- ? ) GROUP-READ file-mode? ;
+M: string group-write? ( path -- ? ) GROUP-WRITE file-mode? ;
+M: string group-execute? ( path -- ? ) GROUP-EXECUTE file-mode? ;
+M: string other-read? ( path -- ? ) OTHER-READ file-mode? ;
+M: string other-write? ( path -- ? ) OTHER-WRITE file-mode? ; 
+M: string other-execute? ( path -- ? ) OTHER-EXECUTE file-mode? ;

 : set-uid ( path ? -- ) UID swap chmod-set-bit ;
 : set-gid ( path ? -- ) GID swap chmod-set-bit ;
@ -255,3 +316,5 @@ M: string set-file-group ( path string -- )

 : file-group-name ( path -- string )
    file-group-id group-name ;
+
+M: unix home "HOME" os-env ;
--- a/basis/io/unix/launcher/launcher.factor
+++ b/basis/io/unix/launcher/launcher.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces math system sequences debugger
 continuations arrays assocs combinators alien.c-types strings
-threads accessors
+threads accessors environment
 io io.backend io.launcher io.ports io.files
 io.files.private io.unix.files io.unix.backend
 io.unix.launcher.parser
--- a/basis/io/windows/files/files.factor
+++ b/basis/io/windows/files/files.factor
@ -1,10 +1,11 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types io.binary io.backend io.files io.buffers
-io.windows kernel math splitting
+io.windows kernel math splitting fry alien.strings
 windows windows.kernel32 windows.time calendar combinators
 math.functions sequences namespaces make words symbols system
-io.ports destructors accessors math.bitwise ;
+io.ports destructors accessors math.bitwise continuations
+windows.errors arrays byte-arrays ;
 IN: io.windows.files

 : open-file ( path access-mode create-mode flags -- handle )
@ -113,8 +114,35 @@ M: windows delete-directory ( path -- )
    normalize-path
    RemoveDirectory win32-error=0/f ;

-M: windows normalize-directory ( string -- string )
-    normalize-path "\\" ?tail drop "\\*" append ;
+M: windows >directory-entry ( byte-array -- directory-entry )
+    [ WIN32_FIND_DATA-cFileName utf16n alien>string ]
+    [ WIN32_FIND_DATA-dwFileAttributes ]
+    bi directory-entry boa ;
+
+: find-first-file ( path -- WIN32_FIND_DATA handle )
+    "WIN32_FIND_DATA" <c-object> tuck
+    FindFirstFile
+    [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep ;
+
+: find-next-file ( path -- WIN32_FIND_DATA/f )
+    "WIN32_FIND_DATA" <c-object> tuck
+    FindNextFile 0 = [
+        GetLastError ERROR_NO_MORE_FILES = [
+            win32-error
+        ] unless drop f
+    ] when ;
+
+M: windows (directory-entries) ( path -- seq )
+    "\\" ?tail drop "\\*" append
+    find-first-file [ >directory-entry ] dip
+    [
+        '[
+            [ _ find-next-file dup ]
+            [ >directory-entry ]
+            [ drop ] produce
+            over name>> "." = [ nip ] [ swap prefix ] if
+        ]
+    ] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ;

 SYMBOLS: +read-only+ +hidden+ +system+
 +archive+ +device+ +normal+ +temporary+
@ -218,6 +246,58 @@ M: winnt file-info ( path -- info )
 M: winnt link-info ( path -- info )
    file-info ;

+HOOK: root-directory os ( string -- string' )
+
+TUPLE: winnt-file-system-info < file-system-info
+total-bytes total-free-bytes ;
+
+: file-system-type ( normalized-path -- str )
+    MAX_PATH 1+ <byte-array>
+    MAX_PATH 1+
+    "DWORD" <c-object> "DWORD" <c-object> "DWORD" <c-object>
+    MAX_PATH 1+ <byte-array>
+    MAX_PATH 1+
+    [ GetVolumeInformation win32-error=0/f ] 2keep drop
+    utf16n alien>string ;
+
+: file-system-space ( normalized-path -- free-space total-bytes total-free-bytes )
+    "ULARGE_INTEGER" <c-object>
+    "ULARGE_INTEGER" <c-object>
+    "ULARGE_INTEGER" <c-object>
+    [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ;
+
+M: winnt file-system-info ( path -- file-system-info )
+    normalize-path root-directory
+    dup [ file-system-type ] [ file-system-space ] bi
+    \ winnt-file-system-info new
+        swap *ulonglong >>total-free-bytes
+        swap *ulonglong >>total-bytes
+        swap *ulonglong >>free-space
+        swap >>type
+        swap >>mount-point ;
+
+: find-first-volume ( word -- string handle )
+    MAX_PATH 1+ <byte-array> dup length
+    dupd
+    FindFirstVolume dup win32-error=0/f
+    [ utf16n alien>string ] dip ;
+
+: find-next-volume ( handle -- string )
+    MAX_PATH 1+ <byte-array> dup length
+    [ FindNextVolume win32-error=0/f ] 2keep drop
+    utf16n alien>string ;
+
+: mounted ( -- array )
+    find-first-volume
+    [
+        '[
+            [ _ find-next-volume dup ]
+            [ ]
+            [ drop ] produce
+            swap prefix
+        ]
+    ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ;
+
 : file-times ( path -- timestamp timestamp timestamp )
    [
        normalize-path open-existing &dispose handle>>
--- a/basis/io/windows/files/unique/unique.factor
+++ b/basis/io/windows/files/unique/unique.factor
@ -1,6 +1,6 @@
 USING: kernel system io.files.unique.backend
 windows.kernel32 io.windows io.windows.files io.ports windows
-destructors ;
+destructors environment ;
 IN: io.windows.files.unique

 M: windows (make-unique-file) ( path -- )
--- a/basis/io/windows/nt/files/files.factor
+++ b/basis/io/windows/nt/files/files.factor
@ -1,7 +1,7 @@
 USING: continuations destructors io.buffers io.files io.backend
 io.timeouts io.ports io.windows io.windows.files
 io.windows.nt.backend windows windows.kernel32
-kernel libc math threads system
+kernel libc math threads system environment
 alien.c-types alien.arrays alien.strings sequences combinators
 combinators.short-circuit ascii splitting alien strings
 assocs namespaces make io.files.private accessors tr ;
@ -31,12 +31,13 @@ M: winnt root-directory? ( path -- ? )

 ERROR: not-absolute-path ;

-: root-directory ( string -- string' )
+M: winnt root-directory ( string -- string' )
+    unicode-prefix ?head drop
    dup {
        [ length 2 >= ]
        [ second CHAR: : = ]
        [ first Letter? ]
-    } 1&& [ 2 head ] [ not-absolute-path ] if ;
+    } 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ;

 : prepend-prefix ( string -- string' )
    dup unicode-prefix head? [
@ -59,3 +60,5 @@ M: winnt FileArgs-overlapped ( port -- overlapped )
 M: winnt open-append
    [ dup file-info size>> ] [ drop 0 ] recover
    >r (open-append) r> >>ptr ;
+
+M: winnt home "USERPROFILE" os-env ;
--- a/basis/io/windows/nt/launcher/launcher-tests.factor
+++ b/basis/io/windows/nt/launcher/launcher-tests.factor
@ -1,7 +1,7 @@
-IN: io.windows.launcher.nt.tests
-USING: io.launcher tools.test calendar accessors
+USING: io.launcher tools.test calendar accessors environment
 namespaces kernel system arrays io io.files io.encodings.ascii
 sequences parser assocs hashtables math continuations eval ;
+IN: io.windows.launcher.nt.tests

 [ ] [
    <process>
--- a/basis/io/windows/nt/launcher/test/env.factor
+++ b/basis/io/windows/nt/launcher/test/env.factor
@ -1,3 +1,4 @@
 USE: system
 USE: prettyprint
+USE: environment
 os-envs .
--- a/basis/locals/locals-tests.factor
+++ b/basis/locals/locals-tests.factor
@ -1,7 +1,7 @@
 USING: locals math sequences tools.test hashtables words kernel
 namespaces arrays strings prettyprint io.streams.string parser
 accessors generic eval combinators combinators.short-circuit
-combinators.short-circuit.smart math.order ;
+combinators.short-circuit.smart math.order math.functions ;
 IN: locals.tests

 :: foo ( a b -- a a ) a a ;
@ -305,17 +305,29 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
 [ f ] [ 8 &&-test ] unit-test
 [ t ] [ 12 &&-test ] unit-test

-:: wlet-&&-test ( a -- ? )
-    [wlet | is-integer? [ a integer? ]
-            is-even? [ a even? ]
-            >10? [ a 10 > ] |
-        { [ is-integer? ] [ is-even? ] [ >10? ] } &&
+:: let-and-cond-test-1 ( -- a )
+    [let | a [ 10 ] |
+        [let | a [ 20 ] |
+            {
+                { [ t ] [ [let | c [ 30 ] | a ] ] }
+            } cond
+        ]
    ] ;

-! [ f ] [ 1.5 wlet-&&-test ] unit-test
-! [ f ] [ 3 wlet-&&-test ] unit-test
-! [ f ] [ 8 wlet-&&-test ] unit-test
-! [ t ] [ 12 wlet-&&-test ] unit-test
+\ let-and-cond-test-1 must-infer
+
+[ 20 ] [ let-and-cond-test-1 ] unit-test
+
+:: let-and-cond-test-2 ( -- pair )
+    [let | A [ 10 ] |
+        [let | B [ 20 ] |
+            { { [ t ] [ { A B } ] } } cond
+        ]
+    ] ;
+
+\ let-and-cond-test-2 must-infer
+
+[ { 10 20 } ] [ let-and-cond-test-2 ] unit-test

 [ { 10       } ] [ 10       [| a     | { a     } ] call ] unit-test
 [ { 10 20    } ] [ 10 20    [| a b   | { a b   } ] call ] unit-test
@ -333,6 +345,16 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;

 { 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as

+
+:: literal-identity-test ( -- a b )
+    { } V{ } ;
+
+[ t f ] [
+    literal-identity-test
+    literal-identity-test
+    swapd [ eq? ] [ eq? ] 2bi*
+] unit-test
+
 :: compare-case ( obj1 obj2 lt-quot eq-quot gt-quot -- )
    obj1 obj2 <=> {
        { +lt+ [ lt-quot call ] }
@ -341,3 +363,29 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
    } case ; inline

 [ [ ] [ ] [ ] compare-case ] must-infer
+
+:: big-case-test ( a -- b )
+    a {
+        { 0 [ a 1 + ] }
+        { 1 [ a 1 - ] }
+        { 2 [ a 1 swap / ] }
+        { 3 [ a dup * ] }
+        { 4 [ a sqrt ] }
+        { 5 [ a a ^ ] }
+    } case ;
+
+\ big-case-test must-infer
+
+[ 9 ] [ 3 big-case-test ] unit-test
+
+! :: wlet-&&-test ( a -- ? )
+!     [wlet | is-integer? [ a integer? ]
+!             is-even? [ a even? ]
+!             >10? [ a 10 > ] |
+!         { [ is-integer? ] [ is-even? ] [ >10? ] } &&
+!     ] ;
+
+! [ f ] [ 1.5 wlet-&&-test ] unit-test
+! [ f ] [ 3 wlet-&&-test ] unit-test
+! [ f ] [ 8 wlet-&&-test ] unit-test
+! [ t ] [ 12 wlet-&&-test ] unit-test
--- a/basis/locals/locals.factor
+++ b/basis/locals/locals.factor
@ -35,11 +35,15 @@ C: <wlet> wlet

 M: lambda expand-macros clone [ expand-macros ] change-body ;

+M: lambda expand-macros* expand-macros literal ;
+
 M: binding-form expand-macros
    clone
        [ [ expand-macros ] assoc-map ] change-bindings
        [ expand-macros ] change-body ;

+M: binding-form expand-macros* expand-macros literal ;
+
 PREDICATE: local < word "local?" word-prop ;

 : <local> ( name -- word )
@ -195,6 +199,20 @@ M: block lambda-rewrite*
        swap point-free ,
    ] keep length \ curry <repetition> % ;

+GENERIC: rewrite-literal? ( obj -- ? )
+
+M: special rewrite-literal? drop t ;
+
+M: array rewrite-literal? [ rewrite-literal? ] contains? ;
+
+M: hashtable rewrite-literal? drop t ;
+
+M: vector rewrite-literal? drop t ;
+
+M: tuple rewrite-literal? drop t ;
+
+M: object rewrite-literal? drop f ;
+
 GENERIC: rewrite-element ( obj -- )

 : rewrite-elements ( seq -- )
@ -203,7 +221,8 @@ GENERIC: rewrite-element ( obj -- )
 : rewrite-sequence ( seq -- )
    [ rewrite-elements ] [ length , ] [ , ] tri \ nsequence , ;

-M: array rewrite-element rewrite-sequence ;
+M: array rewrite-element
+    dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;

 M: vector rewrite-element rewrite-sequence ;

@ -441,7 +460,7 @@ M: lambda-memoized definition
    "lambda" word-prop body>> ;

 M: lambda-memoized reset-word
-    [ f "lambda" set-word-prop ] [ call-next-method ] bi ;
+    [ call-next-method ] [ f "lambda" set-word-prop ] bi ;

 : method-stack-effect ( method -- effect )
    dup "lambda" word-prop vars>>
--- a/basis/logging/server/server.factor
+++ b/basis/logging/server/server.factor
@ -83,7 +83,7 @@ SYMBOL: log-files

 : (rotate-logs) ( -- )
    (close-logs)
-    log-root directory [ drop rotate-log ] assoc-each ;
+    log-root directory-files [ rotate-log ] each ;

 : log-server-loop ( -- )
    receive unclip {
--- a/basis/macros/expander/expander.factor
+++ b/basis/macros/expander/expander.factor
@ -1,14 +1,12 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences namespaces make quotations accessors
-words continuations vectors effects math
-stack-checker.transforms ;
+USING: kernel sequences sequences.private namespaces make
+quotations accessors words continuations vectors effects math
+generalizations stack-checker.transforms fry ;
 IN: macros.expander

 GENERIC: expand-macros ( quot -- quot' )

-<PRIVATE
-
 SYMBOL: stack

 : begin ( -- ) V{ } clone stack set ;
@ -28,6 +26,17 @@ GENERIC: expand-macros* ( obj -- )

 M: wrapper expand-macros* wrapped>> literal ;

+: expand-dispatch? ( word -- ? )
+    \ dispatch eq? stack get length 1 >= and ;
+
+: expand-dispatch ( -- )
+    stack get pop end
+    [ [ expand-macros ] [ ] map-as '[ _ dip ] % ]
+    [
+        length [ <reversed> ] keep
+        [ '[ _ ndrop _ nnip call ] [ ] like ] 2map , \ dispatch ,
+    ] bi ;
+
 : expand-macro ( quot -- )
    stack [ swap with-datastack >vector ] change
    stack get pop >quotation end (expand-macros) ;
@ -38,8 +47,14 @@ M: wrapper expand-macros* wrapped>> literal ;
        stack get length <=
    ] [ 2drop f f ] if ;

+: word, ( word -- ) end , ;
+
 M: word expand-macros*
-    dup expand-macro? [ nip expand-macro ] [ drop end , ] if ;
+    dup expand-dispatch? [ drop expand-dispatch ] [
+        dup expand-macro? [ nip expand-macro ] [
+            drop word,
+        ] if
+    ] if ;

 M: object expand-macros* literal ;

@ -48,5 +63,3 @@ M: callable expand-macros*

 M: callable expand-macros ( quot -- quot' )
    [ begin (expand-macros) end ] [ ] make ;
-
-PRIVATE>
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@ -396,8 +396,6 @@ do-primitive alien-invoke alien-indirect alien-callback

 \ (exists?) { string } { object } define-primitive

-\ (directory) { string } { array } define-primitive
-
 \ gc { } { } define-primitive

 \ gc-stats { } { array } define-primitive
@ -412,8 +410,6 @@ do-primitive alien-invoke alien-indirect alien-callback
 \ code-room { } { integer integer integer integer } define-primitive
 \ code-room  make-flushable

-\ os-env { string } { object } define-primitive
-
 \ millis { } { integer } define-primitive
 \ millis make-flushable

@ -590,14 +586,6 @@ do-primitive alien-invoke alien-indirect alien-callback

 \ set-innermost-frame-quot { quotation callstack } { } define-primitive

-\ (os-envs) { } { array } define-primitive
-
-\ set-os-env { string string } { } define-primitive
-
-\ unset-os-env { string } { } define-primitive
-
-\ (set-os-envs) { array } { } define-primitive
-
 \ dll-valid? { object } { object } define-primitive

 \ modify-code-heap { array object } { } define-primitive
--- a/basis/tools/deploy/deploy-tests.factor
+++ b/basis/tools/deploy/deploy-tests.factor
@ -1,7 +1,8 @@
 IN: tools.deploy.tests
 USING: tools.test system io.files kernel tools.deploy.config
 tools.deploy.backend math sequences io.launcher arrays
-namespaces continuations layouts accessors ;
+namespaces continuations layouts accessors io.encodings.ascii
+urls math.parser ;

 : shake-and-bake ( vocab -- )
    [ "test.image" temp-file delete-file ] ignore-errors
@ -38,7 +39,7 @@ namespaces continuations layouts accessors ;
 ! [ ] [ "tetris" shake-and-bake ] unit-test
 ! 
 ! [ t ] [ 1500000 small-enough? ] unit-test
-! 
+
 [ ] [ "bunny" shake-and-bake ] unit-test

 [ t ] [ 2500000 small-enough? ] unit-test
@ -71,22 +72,24 @@ M: quit-responder call-responder*
 : add-quot-responder ( responder -- responder )
    quit-responder "quit" add-responder ;

-: test-httpd ( -- )
-    #! Return as soon as server is running.
+: test-httpd ( responder -- )
+    [
+        main-responder set
        <http-server>
-        1237 >>insecure
+            0 >>insecure
            f >>secure
-    start-server* ;
+        dup start-server*
+        sockets>> first addr>> port>>
+        dup number>string "resource:temp/port-number" ascii set-file-contents
+    ] with-scope
+    "port" set ;

 [ ] [
-    [
    <dispatcher>
        add-quot-responder
        "resource:basis/http/test" <static> >>default
-        main-responder set

    test-httpd
-    ] with-scope
 ] unit-test

 [ ] [
@ -94,7 +97,10 @@ M: quit-responder call-responder*
    run-temp-image
 ] unit-test

-[ ] [ "http://localhost:1237/quit" http-get 2drop ] unit-test
+: add-port ( url -- url' )
+    >url clone "port" get >>port ;
+
+[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test

 [ ] [
    "tools.deploy.test.6" shake-and-bake
--- a/basis/tools/deploy/test/5/5.factor
+++ b/basis/tools/deploy/test/5/5.factor
@ -1,7 +1,10 @@
 IN: tools.deploy.test.5
-USING: http.client kernel ;
+USING: accessors urls io.encodings.ascii io.files math.parser
+http.client kernel ;

 : deploy-test-5 ( -- )
-    "http://localhost:1237/foo.html" http-get 2drop ;
+    URL" http://localhost/foo.html" clone
+    "resource:port-number" ascii file-contents string>number >>port
+    http-get 2drop ;

 MAIN: deploy-test-5
--- a/basis/tools/scaffold/scaffold.factor
+++ b/basis/tools/scaffold/scaffold.factor
@ -16,13 +16,18 @@ ERROR: vocab-name-contains-dot path ;
 ERROR: no-vocab vocab ;

 <PRIVATE
-: root? ( string -- ? )
-    vocab-roots get member?  ;
+
+: root? ( string -- ? ) vocab-roots get member?  ;
+
+: length-changes? ( seq quot -- ? )
+    dupd call [ length ] bi@ = not ; inline

 : check-vocab-name ( string -- string )
-    dup dup [ CHAR: . = ] trim [ length ] bi@ =
-    [ vocab-name-contains-dot ] unless
+    dup [ [ CHAR: . = ] trim ] length-changes?
+    [ vocab-name-contains-dot ] when
+
    ".." over subseq? [ vocab-name-contains-dot ] when
+
    dup [ path-separator? ] contains?
    [ vocab-name-contains-separator ] when ;

@ -43,8 +48,11 @@ ERROR: no-vocab vocab ;
 : scaffolding ( path -- )
    "Creating scaffolding for " write <pathname> . ;

+: (scaffold-path) ( path string -- path )
+    dupd [ file-name ] dip append append-path ;
+
 : scaffold-path ( path string -- path ? )
-    dupd [ file-name ] dip append append-path
+    (scaffold-path)
    dup exists? [ dup not-scaffolding f ] [ dup scaffolding t ] if ;

 : scaffold-copyright ( -- )
@ -205,14 +213,15 @@ ERROR: no-vocab vocab ;

 : check-vocab ( vocab -- vocab )
    dup find-vocab-root [ no-vocab ] unless ;
+
 PRIVATE>

 : link-vocab ( vocab -- )
    check-vocab
    "Edit documentation: " write
-    [ find-vocab-root ] keep
-    [ append-path ] keep "-docs.factor" append append-path
-    <pathname> . ;
+    [ find-vocab-root ]
+    [ vocab>scaffold-path ] bi
+    "-docs.factor" (scaffold-path) <pathname> . ;

 : help. ( word -- )
    [ (help.) ] [ nl vocabulary>> link-vocab ] bi ;
--- a/basis/tools/test/test.factor
+++ b/basis/tools/test/test.factor
@ -12,6 +12,7 @@ SYMBOL: failures
    error-continuation get 3array ;

 : failure ( error what -- )
+    "--> test failed!" print
    <failure> failures get push ;

 SYMBOL: this-test
--- a/basis/tools/vocabs/vocabs.factor
+++ b/basis/tools/vocabs/vocabs.factor
@ -14,8 +14,7 @@ IN: tools.vocabs
 : vocab-tests-dir ( vocab -- paths )
    dup vocab-dir "tests" append-path vocab-append-path dup [
        dup exists? [
-            dup directory keys
-            [ ".factor" tail? ] filter
+            dup directory-files [ ".factor" tail? ] filter
            [ append-path ] with map
        ] [ drop f ] if
    ] [ drop f ] if ;
@ -208,11 +207,15 @@ M: vocab-link summary vocab-summary ;
    dup vocab-authors-path set-vocab-file-contents ;

 : subdirs ( dir -- dirs )
-    directory [ second ] filter keys natural-sort ;
+    [
+        [ link-info directory? ] filter
+    ] with-directory-files natural-sort ;

 : (all-child-vocabs) ( root name -- vocabs )
-    [ vocab-dir append-path subdirs ] keep
    [
+        vocab-dir append-path dup exists?
+        [ subdirs ] [ drop { } ] if
+    ] keep [
        swap [ "." swap 3append ] with map
    ] unless-empty ;

--- a/basis/ui/cocoa/views/views.factor
+++ b/basis/ui/cocoa/views/views.factor
@ -128,12 +128,12 @@ CLASS: {
 }

 ! Rendering
-{ "drawRect:" "void" { "id" "SEL" "id" "NSRect" }
-    [ 3drop window relayout-1 ]
+{ "drawRect:" "void" { "id" "SEL" "NSRect" }
+    [ 2drop window relayout-1 ]
 }

 ! Events
-{ "acceptsFirstMouse:" "bool" { "id" "SEL" "id" }
+{ "acceptsFirstMouse:" "char" { "id" "SEL" "id" }
    [ 3drop 1 ]
 }

@ -251,7 +251,7 @@ CLASS: {

 ! "rotateWithEvent:" "void" { "id" "SEL" "id" }}

-{ "acceptsFirstResponder" "bool" { "id" "SEL" }
+{ "acceptsFirstResponder" "char" { "id" "SEL" }
    [ 2drop 1 ]
 }

@ -264,26 +264,26 @@ CLASS: {
    ]
 }

-{ "writeSelectionToPasteboard:types:" "bool" { "id" "SEL" "id" "id" }
+{ "writeSelectionToPasteboard:types:" "char" { "id" "SEL" "id" "id" }
    [
        CF>string-array NSStringPboardType swap member? [
            >r drop window-focus gadget-selection dup [
-                r> set-pasteboard-string t
+                r> set-pasteboard-string 1
            ] [
-                r> 2drop f
+                r> 2drop 0
            ] if
        ] [
-            3drop f
+            3drop 0
        ] if
    ]
 }

-{ "readSelectionFromPasteboard:" "bool" { "id" "SEL" "id" }
+{ "readSelectionFromPasteboard:" "char" { "id" "SEL" "id" }
    [
        pasteboard-string dup [
-            >r drop window-focus r> swap user-input t
+            >r drop window-focus r> swap user-input 1
        ] [
-            3drop f
+            3drop 0
        ] if
    ]
 }
@ -293,7 +293,7 @@ CLASS: {
    [ [ nip send-user-input ] ui-try ]
 }

-{ "hasMarkedText" "bool" { "id" "SEL" }
+{ "hasMarkedText" "char" { "id" "SEL" }
    [ 2drop 0 ]
 }

@ -321,7 +321,7 @@ CLASS: {
    [ 3drop f ]
 }

-{ "characterIndexForPoint:" "uint" { "id" "SEL" "NSPoint" }
+{ "characterIndexForPoint:" "NSUInteger" { "id" "SEL" "NSPoint" }
    [ 3drop 0 ]
 }

@ -329,7 +329,7 @@ CLASS: {
    [ 3drop 0 0 0 0 <NSRect> ]
 }

-{ "conversationIdentifier" "long" { "id" "SEL" }
+{ "conversationIdentifier" "NSInteger" { "id" "SEL" }
    [ drop alien-address ]
 }

@ -394,9 +394,9 @@ CLASS: {
    ]
 }

-{ "windowShouldClose:" "bool" { "id" "SEL" "id" }
+{ "windowShouldClose:" "char" { "id" "SEL" "id" }
    [
-        3drop t
+        3drop 1
    ]
 }

--- a/basis/ui/tools/listener/listener-tests.factor
+++ b/basis/ui/tools/listener/listener-tests.factor
@ -2,7 +2,7 @@ USING: continuations documents ui.tools.interactor
 ui.tools.listener hashtables kernel namespaces parser sequences
 tools.test ui.commands ui.gadgets ui.gadgets.editors
 ui.gadgets.panes vocabs words tools.test.ui slots.private
-threads arrays generic threads accessors listener ;
+threads arrays generic threads accessors listener math ;
 IN: ui.tools.listener.tests

 [ f ] [ "word" source-editor command-map commands>> empty? ] unit-test
@ -51,3 +51,5 @@ IN: ui.tools.listener.tests

    [ ] [ "listener" get com-end ] unit-test
 ] with-grafted-gadget
+
+[ ] [ \ + <pane> <interactor> interactor-use use-if-necessary ] unit-test
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@ -101,8 +101,8 @@ M: engine-word word-completion-string
    "engine-generic" word-prop word-completion-string ;

 : use-if-necessary ( word seq -- )
-    over vocabulary>> [
-        2dup assoc-stack pick = [ 2drop ] [
+    over vocabulary>> over and [
+        2dup [ assoc-stack ] keep = [ 2drop ] [
            >r vocabulary>> vocab-words r> push
        ] if
    ] [ 2drop ] if ;
@ -114,9 +114,10 @@ M: engine-word word-completion-string
    2bi ;

 : quot-action ( interactor -- lines )
-    dup control-value
-    dup "\n" join pick add-interactor-history
-    swap select-all ;
+    [ control-value ] keep
+    [ [ "\n" join ] dip add-interactor-history ]
+    [ select-all ]
+    2bi ;

 TUPLE: stack-display < track ;

--- a/basis/ui/tools/tools.factor
+++ b/basis/ui/tools/tools.factor
@ -40,11 +40,11 @@ IN: ui.tools

 : resize-workspace ( workspace -- )
    dup sizes>> over control-value zero? [
-        1/5 1 pick set-nth
-        4/5 2 rot set-nth
+        1/5 over set-second
+        4/5 swap set-third
    ] [
-        2/3 1 pick set-nth
-        1/3 2 rot set-nth
+        2/3 over set-second
+        1/3 swap set-third
    ] if relayout ;

 M: workspace model-changed
--- a/basis/ui/x11/x11.factor
+++ b/basis/ui/x11/x11.factor
@ -6,8 +6,8 @@ assocs kernel math namespaces opengl sequences strings x11.xlib
 x11.events x11.xim x11.glx x11.clipboard x11.constants
 x11.windows io.encodings.string io.encodings.ascii
 io.encodings.utf8 combinators debugger command-line qualified
-math.vectors classes.tuple opengl.gl threads math.geometry.rect ;
-QUALIFIED: system
+math.vectors classes.tuple opengl.gl threads math.geometry.rect
+environment ;
 IN: ui.x11

 SINGLETON: x11-ui-backend
@ -262,5 +262,5 @@ M: x11-ui-backend beep ( -- )

 x11-ui-backend ui-backend set-global

-[ "DISPLAY" system:os-env "ui" "listener" ? ]
+[ "DISPLAY" os-env "ui" "listener" ? ]
 main-vocab-hook set-global
--- a/basis/unix/bsd/bsd.factor
+++ b/basis/unix/bsd/bsd.factor
@ -3,8 +3,6 @@
 USING: alien.syntax combinators system vocabs.loader ;
 IN: unix

-! FreeBSD
-
 : MAXPATHLEN 1024 ; inline

 : O_RDONLY   HEX: 0000 ; inline
@ -85,6 +83,16 @@ C-STRUCT: passwd
 : SEEK_CUR 1 ; inline
 : SEEK_END 2 ; inline

+: DT_UNKNOWN   0 ; inline
+: DT_FIFO      1 ; inline
+: DT_CHR       2 ; inline
+: DT_DIR       4 ; inline
+: DT_BLK       6 ; inline
+: DT_REG       8 ; inline
+: DT_LNK      10 ; inline
+: DT_SOCK     12 ; inline
+: DT_WHT      14 ; inline
+
 os {
    { macosx  [ "unix.bsd.macosx"  require ] }
    { freebsd [ "unix.bsd.freebsd" require ] }
--- a/basis/unix/bsd/freebsd/freebsd.factor
+++ b/basis/unix/bsd/freebsd/freebsd.factor
@ -13,6 +13,13 @@ C-STRUCT: addrinfo
    { "void*" "addr" }
    { "addrinfo*" "next" } ;

+C-STRUCT: dirent
+    { "u_int32_t" "d_fileno" }
+    { "u_int16_t" "d_reclen" }
+    { "u_int8_t"  "d_type" }
+    { "u_int8_t"  "d_namlen" }
+    { { "char" 256 } "d_name" } ;
+
 : EPERM 1 ; inline
 : ENOENT 2 ; inline
 : ESRCH 3 ; inline
--- a/basis/unix/bsd/macosx/macosx.factor
+++ b/basis/unix/bsd/macosx/macosx.factor
@ -13,6 +13,32 @@ C-STRUCT: addrinfo
    { "void*" "addr" }
    { "addrinfo*" "next" } ;

+: _UTX_USERSIZE 256 ; inline
+: _UTX_LINESIZE 32 ; inline
+: _UTX_IDSIZE 4 ; inline
+: _UTX_HOSTSIZE 256 ; inline
+    
+C-STRUCT: utmpx
+    { { "char" _UTX_USERSIZE } "ut_user" }
+    { { "char" _UTX_IDSIZE } "ut_id" }
+    { { "char" _UTX_LINESIZE } "ut_line" }
+    { "pid_t" "ut_pid" }
+    { "short" "ut_type" }
+    { "timeval" "ut_tv" }
+    { { "char" _UTX_HOSTSIZE } "ut_host" }
+    { { "uint" 16 } "ut_pad" } ;
+
+: __DARWIN_MAXPATHLEN 1024 ; inline
+: __DARWIN_MAXNAMELEN 255 ; inline
+: __DARWIN_MAXNAMELEN+1 255 ; inline
+
+C-STRUCT: dirent
+    { "ino_t" "d_ino" }
+    { "__uint16_t" "d_reclen" }
+    { "__uint8_t"  "d_type" }
+    { "__uint8_t"  "d_namlen" }
+    { { "char" __DARWIN_MAXNAMELEN+1 } "d_name" } ;
+
 : EPERM 1 ; inline
 : ENOENT 2 ; inline
 : ESRCH 3 ; inline
@ -117,18 +143,3 @@ C-STRUCT: addrinfo
 : ETIME 101 ; inline
 : EOPNOTSUPP 102 ; inline
 : ENOPOLICY 103 ; inline
-
-: _UTX_USERSIZE 256 ; inline
-: _UTX_LINESIZE 32 ; inline
-: _UTX_IDSIZE 4 ; inline
-: _UTX_HOSTSIZE 256 ; inline
-    
-C-STRUCT: utmpx
-    { { "char" _UTX_USERSIZE } "ut_user" }
-    { { "char" _UTX_IDSIZE } "ut_id" }
-    { { "char" _UTX_LINESIZE } "ut_line" }
-    { "pid_t" "ut_pid" }
-    { "short" "ut_type" }
-    { "timeval" "ut_tv" }
-    { { "char" _UTX_HOSTSIZE } "ut_host" }
-    { { "uint" 16 } "ut_pad" } ;
--- a/basis/unix/bsd/netbsd/netbsd.factor
+++ b/basis/unix/bsd/netbsd/netbsd.factor
@ -13,6 +13,13 @@ C-STRUCT: addrinfo
    { "void*" "addr" }
    { "addrinfo*" "next" } ;

+C-STRUCT: dirent
+    { "__uint32_t" "d_fileno" }
+    { "__uint16_t" "d_reclen" }
+    { "__uint8_t"  "d_type" }
+    { "__uint8_t"  "d_namlen" }
+    { { "char" 256 } "d_name" } ;
+
 : EPERM 1 ; inline
 : ENOENT 2 ; inline
 : ESRCH 3 ; inline
--- a/basis/unix/bsd/openbsd/openbsd.factor
+++ b/basis/unix/bsd/openbsd/openbsd.factor
@ -13,6 +13,13 @@ C-STRUCT: addrinfo
    { "char*" "canonname" }
    { "addrinfo*" "next" } ;

+C-STRUCT: dirent
+    { "__uint32_t" "d_fileno" }
+    { "__uint16_t" "d_reclen" }
+    { "__uint8_t"  "d_type" }
+    { "__uint8_t"  "d_namlen" }
+    { { "char" 256 } "d_name" } ;
+
 : EPERM 1 ; inline
 : ENOENT 2 ; inline
 : ESRCH 3 ; inline
--- a/basis/unix/groups/groups.factor
+++ b/basis/unix/groups/groups.factor
@ -4,7 +4,7 @@ USING: alien alien.c-types alien.strings io.encodings.utf8
 io.unix.backend kernel math sequences splitting unix strings
 combinators.short-circuit byte-arrays combinators qualified
 accessors math.parser fry assocs namespaces continuations
-unix.users ;
+unix.users unix.utilities ;
 IN: unix.groups

 QUALIFIED: grouping
@ -18,12 +18,7 @@ GENERIC: group-struct ( obj -- group )
 <PRIVATE

 : group-members ( group-struct -- seq )
-    group-gr_mem
-    [ dup { [ ] [ *void* ] } 1&& ]
-    [
-        dup *void* utf8 alien>string
-        [ alien-address "char**" heap-size + <alien> ] dip
-    ] [ ] produce nip ;
+    group-gr_mem utf8 alien>strings ;

 : (group-struct) ( id -- group-struct id group-struct byte-array length void* )
    "group" <c-object> tuck 4096
--- a/basis/unix/linux/fs/fs.factor
+++ b/basis/unix/linux/fs/fs.factor
@ -1,6 +1,4 @@
-
 USING: alien.syntax ;
-
 IN: unix.linux.fs

 : MS_RDONLY             1    ; ! Mount read-only.
--- a/basis/unix/linux/linux.factor
+++ b/basis/unix/linux/linux.factor
@ -92,6 +92,13 @@ C-STRUCT: passwd
    { "char*"  "pw_dir" }
    { "char*"  "pw_shell" } ;

+C-STRUCT: dirent
+    { "__ino_t" "d_ino" }
+    { "__off_t" "d_off" }
+    { "ushort" "d_reclen" }
+    { "uchar" "d_type" }
+    { { "char" 256 } "d_name" } ;
+
 : EPERM 1 ; inline
 : ENOENT 2 ; inline
 : ESRCH 3 ; inline
--- a/basis/unix/process/process.factor
+++ b/basis/unix/process/process.factor
@ -1,6 +1,6 @@
 USING: kernel alien.c-types alien.strings sequences math alien.syntax unix
 vectors kernel namespaces continuations threads assocs vectors
-       io.unix.backend io.encodings.utf8 ;
+io.unix.backend io.encodings.utf8 unix.utilities ;
 IN: unix.process

 ! Low-level Unix process launching utilities. These are used
@ -15,17 +15,16 @@ FUNCTION: int execv ( char* path, char** argv ) ;
 FUNCTION: int execvp ( char* path, char** argv ) ;
 FUNCTION: int execve ( char* path, char** argv, char** envp ) ;

-: >argv ( seq -- alien )
-    [ utf8 malloc-string ] map f suffix >c-void*-array ;
-
 : exec ( pathname argv -- int )
-    [ utf8 malloc-string ] [ >argv ] bi* execv ;
+    [ utf8 malloc-string ] [ utf8 strings>alien ] bi* execv ;

 : exec-with-path ( filename argv -- int )
-    [ utf8 malloc-string ] [ >argv ] bi* execvp ;
+    [ utf8 malloc-string ] [ utf8 strings>alien ] bi* execvp ;

 : exec-with-env ( filename argv envp -- int )
-    [ utf8 malloc-string ] [ >argv ] [ >argv ] tri* execve ;
+    [ utf8 malloc-string ]
+    [ utf8 strings>alien ]
+    [ utf8 strings>alien ] tri* execve ;

 : exec-args ( seq -- int )
    [ first ] [ ] bi exec ;
--- a/basis/unix/stat/linux/32/32.factor
+++ b/basis/unix/stat/linux/32/32.factor
@ -1,6 +1,4 @@
-
 USING: kernel alien.syntax math ;
-
 IN: unix.stat

 ! Ubuntu 8.04 32-bit
@ -24,8 +22,6 @@ C-STRUCT: stat
    { "ulong"     "unused4" }
    { "ulong"     "unused5" } ;

-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 FUNCTION: int __xstat  ( int ver, char* pathname, stat* buf ) ;
 FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;

--- a/basis/unix/stat/linux/64/64.factor
+++ b/basis/unix/stat/linux/64/64.factor
@ -1,6 +1,5 @@
-
-USING: kernel alien.syntax math ;
-
+USING: kernel alien.syntax math sequences unix
+alien.c-types arrays accessors combinators ;
 IN: unix.stat

 ! Ubuntu 7.10 64-bit
--- a/basis/unix/stat/linux/linux.factor
+++ b/basis/unix/stat/linux/linux.factor
@ -1,11 +1,8 @@
-
-USING: layouts combinators vocabs.loader ;
-
+USING: alien.syntax layouts combinators vocabs.loader ;
 IN: unix.stat

 cell-bits
 {
    { 32 [ "unix.stat.linux.32" require ] }
    { 64 [ "unix.stat.linux.64" require ] }
-  }
-case
+} case
--- a/basis/unix/stat/macosx/macosx.factor
+++ b/basis/unix/stat/macosx/macosx.factor
@ -1,4 +1,5 @@
-USING: kernel alien.syntax math ;
+USING: kernel alien.syntax math unix math.bitwise
+alien.c-types alien sequences grouping accessors combinators ;
 IN: unix.stat

 ! Mac OS X ppc
--- a/basis/unix/stat/netbsd/netbsd.factor
+++ b/basis/unix/stat/netbsd/netbsd.factor
@ -1,4 +1,4 @@
-USING: layouts combinators vocabs.loader ;
+USING: layouts combinators vocabs.loader alien.syntax ;
 IN: unix.stat

 cell-bits {
--- a/basis/unix/stat/stat.factor
+++ b/basis/unix/stat/stat.factor
@ -18,6 +18,12 @@ FUNCTION: int chmod ( char* path, mode_t mode ) ;
 FUNCTION: int fchmod ( int fd, mode_t mode ) ;
 FUNCTION: int mkdir ( char* path, mode_t mode ) ;

+C-STRUCT: fsid
+    { { "int" 2 } "__val" } ;
+
+    TYPEDEF: fsid __fsid_t
+    TYPEDEF: fsid fsid_t
+
 << os {
    { linux   [ "unix.stat.linux"   require ] }
    { macosx  [ "unix.stat.macosx"  require ] }
@ -27,11 +33,7 @@ FUNCTION: int mkdir ( char* path, mode_t mode ) ;
 } case >>

 : file-status ( pathname -- stat )
-    "stat" <c-object> [
-        [ stat ] unix-system-call drop
-    ] keep ;
+    "stat" <c-object> [ [ stat ] unix-system-call drop ] keep ;

 : link-status ( pathname -- stat )
-    "stat" <c-object> [
-        [ lstat ] unix-system-call drop
-    ] keep ;
+    "stat" <c-object> [ [ lstat ] unix-system-call drop ] keep ;
--- a/basis/unix/statfs/authors.txt
+++ b/basis/unix/statfs/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/unix/statfs/freebsd/authors.txt
+++ b/basis/unix/statfs/freebsd/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/unix/statfs/freebsd/freebsd.factor
+++ b/basis/unix/statfs/freebsd/freebsd.factor
@ -0,0 +1,53 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel unix math accessors
+combinators system io.backend alien.c-types unix.statfs 
+io.files ;
+IN: unix.statfs.freebsd
+
+: ST_RDONLY       1 ; inline
+: ST_NOSUID       2 ; inline
+
+C-STRUCT: statvfs               
+    { "fsblkcnt_t" "f_bavail" }
+    { "fsblkcnt_t" "f_bfree" }
+    { "fsblkcnt_t" "f_blocks" }
+    { "fsfilcnt_t" "f_favail" }
+    { "fsfilcnt_t" "f_ffree" }
+    { "fsfilcnt_t" "f_files" }
+    { "ulong" "f_bsize" }
+    { "ulong" "f_flag" }
+    { "ulong" "f_frsize" }
+    { "ulong" "f_fsid" }
+    { "ulong" "f_namemax" } ;
+
+FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
+
+TUPLE: freebsd-file-system-info < file-system-info
+bavail bfree blocks favail ffree files
+bsize flag frsize fsid namemax ;
+
+M: freebsd >file-system-info ( struct -- statfs )
+    [ \ freebsd-file-system-info new ] dip
+    {
+        [
+            [ statvfs-f_bsize ]
+            [ statvfs-f_bavail ] bi * >>free-space
+        ]
+        [ statvfs-f_bavail >>bavail ]
+        [ statvfs-f_bfree >>bfree ]
+        [ statvfs-f_blocks >>blocks ]
+        [ statvfs-f_favail >>favail ]
+        [ statvfs-f_ffree >>ffree ]
+        [ statvfs-f_files >>files ]
+        [ statvfs-f_bsize >>bsize ]
+        [ statvfs-f_flag >>flag ]
+        [ statvfs-f_frsize >>frsize ]
+        [ statvfs-f_fsid >>fsid ]
+        [ statvfs-f_namemax >>namemax ]
+    } cleave ;
+
+M: freebsd file-system-info ( path -- byte-array )
+    normalize-path
+    "statvfs" <c-object> tuck statvfs io-error
+    >file-system-info ;
--- a/basis/unix/statfs/freebsd/tags.txt
+++ b/basis/unix/statfs/freebsd/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/unix/statfs/linux/32/32.factor
+++ b/basis/unix/statfs/linux/32/32.factor
@ -0,0 +1,46 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types combinators kernel unix.stat
+math accessors system unix io.backend layouts vocabs.loader
+alien.syntax unix.statfs io.files ;
+IN: unix.statfs.linux
+
+C-STRUCT: statfs
+    { "long"    "f_type" }
+    { "long"    "f_bsize" }
+    { "long"    "f_blocks" }
+    { "long"    "f_bfree" }
+    { "long"    "f_bavail" }
+    { "long"    "f_files" }
+    { "long"    "f_ffree" }
+    { "fsid_t"  "f_fsid" }
+    { "long"    "f_namelen" } ;
+
+FUNCTION: int statfs ( char* path, statfs* buf ) ;
+
+TUPLE: linux32-file-system-info < file-system-info
+type bsize blocks bfree bavail files ffree fsid
+namelen frsize spare ;
+
+M: linux >file-system-info ( struct -- statfs )
+    [ \ linux32-file-system-info new ] dip
+    {
+        [
+            [ statfs-f_bsize ]
+            [ statfs-f_bavail ] bi * >>free-space
+        ]
+        [ statfs-f_type >>type ]
+        [ statfs-f_bsize >>bsize ]
+        [ statfs-f_blocks >>blocks ]
+        [ statfs-f_bfree >>bfree ]
+        [ statfs-f_bavail >>bavail ]
+        [ statfs-f_files >>files ]
+        [ statfs-f_ffree >>ffree ]
+        [ statfs-f_fsid >>fsid ]
+        [ statfs-f_namelen >>namelen ]
+    } cleave ;
+
+M: linux file-system-info ( path -- byte-array )
+    normalize-path
+    "statfs" <c-object> tuck statfs io-error
+    >file-system-info ;
--- a/basis/unix/statfs/linux/32/authors.txt
+++ b/basis/unix/statfs/linux/32/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/unix/statfs/linux/32/tags.txt
+++ b/basis/unix/statfs/linux/32/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/unix/statfs/linux/64/64.factor
+++ b/basis/unix/statfs/linux/64/64.factor
@ -0,0 +1,50 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types combinators kernel unix.stat
+math accessors system unix io.backend layouts vocabs.loader
+alien.syntax unix.statfs io.files ;
+IN: unix.statfs.linux
+
+C-STRUCT: statfs64
+    { "__SWORD_TYPE" "f_type" }
+    { "__SWORD_TYPE" "f_bsize" }
+    { "__fsblkcnt64_t" "f_blocks" }
+    { "__fsblkcnt64_t" "f_bfree" }
+    { "__fsblkcnt64_t" "f_bavail" }
+    { "__fsfilcnt64_t" "f_files" }
+    { "__fsfilcnt64_t" "f_ffree" }
+    { "__fsid_t" "f_fsid" }
+    { "__SWORD_TYPE" "f_namelen" }
+    { "__SWORD_TYPE" "f_frsize" }
+    { { "__SWORD_TYPE" 5 } "f_spare" } ;
+
+FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
+
+TUPLE: linux64-file-system-info < file-system-info
+type bsize blocks bfree bavail files ffree fsid
+namelen frsize spare ;
+
+M: linux >file-system-info ( struct -- statfs )
+    [ \ linux64-file-system-info new ] dip
+    {
+        [
+            [ statfs64-f_bsize ]
+            [ statfs64-f_bavail ] bi * >>free-space
+        ]
+        [ statfs64-f_type >>type ]
+        [ statfs64-f_bsize >>bsize ]
+        [ statfs64-f_blocks >>blocks ]
+        [ statfs64-f_bfree >>bfree ]
+        [ statfs64-f_bavail >>bavail ]
+        [ statfs64-f_files >>files ]
+        [ statfs64-f_ffree >>ffree ]
+        [ statfs64-f_fsid >>fsid ]
+        [ statfs64-f_namelen >>namelen ]
+        [ statfs64-f_frsize >>frsize ]
+        [ statfs64-f_spare >>spare ]
+    } cleave ;
+
+M: linux file-system-info ( path -- byte-array )
+    normalize-path
+    "statfs64" <c-object> tuck statfs64 io-error
+    >file-system-info ;
--- a/basis/unix/statfs/linux/64/authors.txt
+++ b/basis/unix/statfs/linux/64/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/unix/statfs/linux/64/tags.txt
+++ b/basis/unix/statfs/linux/64/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/unix/statfs/linux/authors.txt
+++ b/basis/unix/statfs/linux/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/unix/statfs/linux/linux.factor
+++ b/basis/unix/statfs/linux/linux.factor
@ -0,0 +1,43 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types combinators kernel io.files unix.stat
+math accessors system unix io.backend layouts vocabs.loader
+sequences csv io.streams.string io.encodings.utf8 namespaces
+unix.statfs io.files ;
+IN: unix.statfs.linux
+
+cell-bits {
+    { 32 [ "unix.statfs.linux.32" require ] }
+    { 64 [ "unix.statfs.linux.64" require ] }
+} case
+
+TUPLE: mtab-entry file-system-name mount-point type options
+frequency pass-number ;
+
+: mtab-csv>mtab-entry ( csv -- mtab-entry )
+    [ mtab-entry new ] dip
+    {
+        [ first >>file-system-name ]
+        [ second >>mount-point ]
+        [ third >>type ]
+        [ fourth <string-reader> csv first >>options ]
+        [ 4 swap nth >>frequency ]
+        [ 5 swap nth >>pass-number ]
+    } cleave ;
+
+: parse-mtab ( -- array )
+    [
+        "/etc/mtab" utf8 <file-reader>
+        CHAR: \s delimiter set csv
+    ] with-scope
+    [ mtab-csv>mtab-entry ] map ;
+
+M: linux mounted
+    parse-mtab [
+        [ mount-point>> file-system-info ] keep
+        {
+            [ file-system-name>> >>device-name ]
+            [ mount-point>> >>mount-point ]
+            [ type>> >>type ]
+        } cleave
+    ] map ;
--- a/basis/unix/statfs/linux/tags.txt
+++ b/basis/unix/statfs/linux/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/unix/statfs/macosx/authors.txt
+++ b/basis/unix/statfs/macosx/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/unix/statfs/macosx/macosx.factor
+++ b/basis/unix/statfs/macosx/macosx.factor
@ -0,0 +1,165 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types io.encodings.utf8 io.encodings.string
+kernel sequences unix.stat accessors unix combinators math
+grouping system unix.statfs io.files io.backend alien.strings
+math.bitwise alien.syntax ;
+IN: unix.statfs.macosx
+
+: MNT_RDONLY  HEX: 00000001 ; inline
+: MNT_SYNCHRONOUS HEX: 00000002 ; inline
+: MNT_NOEXEC  HEX: 00000004 ; inline
+: MNT_NOSUID  HEX: 00000008 ; inline
+: MNT_NODEV   HEX: 00000010 ; inline
+: MNT_UNION   HEX: 00000020 ; inline
+: MNT_ASYNC   HEX: 00000040 ; inline
+: MNT_EXPORTED HEX: 00000100 ; inline
+: MNT_QUARANTINE  HEX: 00000400 ; inline
+: MNT_LOCAL   HEX: 00001000 ; inline
+: MNT_QUOTA   HEX: 00002000 ; inline
+: MNT_ROOTFS  HEX: 00004000 ; inline
+: MNT_DOVOLFS HEX: 00008000 ; inline
+: MNT_DONTBROWSE  HEX: 00100000 ; inline
+: MNT_IGNORE_OWNERSHIP HEX: 00200000 ; inline
+: MNT_AUTOMOUNTED HEX: 00400000 ; inline
+: MNT_JOURNALED   HEX: 00800000 ; inline
+: MNT_NOUSERXATTR HEX: 01000000 ; inline
+: MNT_DEFWRITE    HEX: 02000000 ; inline
+: MNT_MULTILABEL  HEX: 04000000 ; inline
+: MNT_NOATIME HEX: 10000000 ; inline
+: MNT_UNKNOWNPERMISSIONS MNT_IGNORE_OWNERSHIP ; inline
+
+: MNT_VISFLAGMASK ( -- n )
+    {
+        MNT_RDONLY MNT_SYNCHRONOUS MNT_NOEXEC
+        MNT_NOSUID MNT_NODEV MNT_UNION
+        MNT_ASYNC MNT_EXPORTED MNT_QUARANTINE
+        MNT_LOCAL MNT_QUOTA
+        MNT_ROOTFS MNT_DOVOLFS MNT_DONTBROWSE
+        MNT_IGNORE_OWNERSHIP MNT_AUTOMOUNTED MNT_JOURNALED
+        MNT_NOUSERXATTR MNT_DEFWRITE MNT_MULTILABEL MNT_NOATIME
+    } flags ; inline
+
+: MNT_UPDATE  HEX: 00010000 ; inline
+: MNT_RELOAD  HEX: 00040000 ; inline
+: MNT_FORCE   HEX: 00080000 ; inline
+: MNT_CMDFLAGS { MNT_UPDATE MNT_RELOAD MNT_FORCE } flags ; inline
+
+: VFS_GENERIC 0 ; inline
+: VFS_NUMMNTOPS 1 ; inline
+: VFS_MAXTYPENUM 1 ; inline
+: VFS_CONF 2 ; inline
+: VFS_SET_PACKAGE_EXTS 3 ; inline
+
+: MNT_WAIT    1 ; inline
+: MNT_NOWAIT  2 ; inline
+
+: VFS_CTL_VERS1   HEX: 01 ; inline
+
+: VFS_CTL_STATFS  HEX: 00010001 ; inline
+: VFS_CTL_UMOUNT  HEX: 00010002 ; inline
+: VFS_CTL_QUERY   HEX: 00010003 ; inline
+: VFS_CTL_NEWADDR HEX: 00010004 ; inline
+: VFS_CTL_TIMEO   HEX: 00010005 ; inline
+: VFS_CTL_NOLOCKS HEX: 00010006 ; inline
+
+C-STRUCT: vfsquery
+    { "uint32_t" "vq_flags" }
+    { { "uint32_t" 31 } "vq_spare" } ;
+
+: VQ_NOTRESP  HEX: 0001 ; inline
+: VQ_NEEDAUTH HEX: 0002 ; inline
+: VQ_LOWDISK  HEX: 0004 ; inline
+: VQ_MOUNT    HEX: 0008 ; inline
+: VQ_UNMOUNT  HEX: 0010 ; inline
+: VQ_DEAD     HEX: 0020 ; inline
+: VQ_ASSIST   HEX: 0040 ; inline
+: VQ_NOTRESPLOCK  HEX: 0080 ; inline
+: VQ_UPDATE   HEX: 0100 ; inline
+: VQ_FLAG0200 HEX: 0200 ; inline
+: VQ_FLAG0400 HEX: 0400 ; inline
+: VQ_FLAG0800 HEX: 0800 ; inline
+: VQ_FLAG1000 HEX: 1000 ; inline
+: VQ_FLAG2000 HEX: 2000 ; inline
+: VQ_FLAG4000 HEX: 4000 ; inline
+: VQ_FLAG8000 HEX: 8000 ; inline
+
+: NFSV4_MAX_FH_SIZE 128 ; inline
+: NFSV3_MAX_FH_SIZE 64 ; inline
+: NFSV2_MAX_FH_SIZE 32 ; inline
+: NFS_MAX_FH_SIZE NFSV4_MAX_FH_SIZE ; inline
+
+: MFSNAMELEN 15 ; inline
+: MNAMELEN 90 ; inline
+: MFSTYPENAMELEN 16 ; inline
+
+C-STRUCT: fsid_t
+    { { "int32_t" 2 } "val" } ;
+
+C-STRUCT: statfs64
+    { "uint32_t"        "f_bsize" }
+    { "int32_t"         "f_iosize" }
+    { "uint64_t"        "f_blocks" }
+    { "uint64_t"        "f_bfree" }
+    { "uint64_t"        "f_bavail" }
+    { "uint64_t"        "f_files" }
+    { "uint64_t"        "f_ffree" }
+    { "fsid_t"          "f_fsid" }
+    { "uid_t"           "f_owner" }
+    { "uint32_t"        "f_type" }
+    { "uint32_t"        "f_flags" }
+    { "uint32_t"        "f_fssubtype" }
+    { { "char" MFSTYPENAMELEN } "f_fstypename" }
+    { { "char" MAXPATHLEN } "f_mntonname" }
+    { { "char" MAXPATHLEN } "f_mntfromname" }
+    { { "uint32_t" 8 } "f_reserved" } ;
+
+FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
+FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ;
+
+
+TUPLE: macosx-file-system-info < file-system-info
+block-size io-size blocks blocks-free blocks-available files
+files-free file-system-id owner type-id flags filesystem-subtype ;
+
+M: macosx mounted ( -- array )
+    f <void*> dup 0 getmntinfo64 dup io-error
+    [ *void* ] dip
+    "statfs64" heap-size [ * memory>byte-array ] keep group
+    [ >file-system-info ] map ;
+
+M: macosx >file-system-info ( byte-array -- file-system-info )
+    [ \ macosx-file-system-info new ] dip
+    {
+        [
+            [ statfs64-f_bavail ] [ statfs64-f_bsize ] bi *
+            >>free-space
+        ]
+        [ statfs64-f_mntonname utf8 alien>string >>mount-point ]
+        [ statfs64-f_bsize >>block-size ]
+
+        [ statfs64-f_iosize >>io-size ]
+        [ statfs64-f_blocks >>blocks ]
+        [ statfs64-f_bfree >>blocks-free ]
+        [ statfs64-f_bavail >>blocks-available ]
+        [ statfs64-f_files >>files ]
+        [ statfs64-f_ffree >>files-free ]
+        [ statfs64-f_fsid >>file-system-id ]
+        [ statfs64-f_owner >>owner ]
+        [ statfs64-f_type >>type-id ]
+        [ statfs64-f_flags >>flags ]
+        [ statfs64-f_fssubtype >>filesystem-subtype ]
+        [
+            statfs64-f_fstypename utf8 alien>string
+            >>type
+        ]
+        [
+            statfs64-f_mntfromname
+            utf8 alien>string >>device-name
+        ]
+    } cleave ;
+
+M: macosx file-system-info ( path -- file-system-info )
+    normalize-path
+    "statfs64" <c-object> tuck statfs64 io-error
+    >file-system-info ;
--- a/basis/unix/statfs/macosx/tags.txt
+++ b/basis/unix/statfs/macosx/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/unix/statfs/netbsd/authors.txt
+++ b/basis/unix/statfs/netbsd/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/unix/statfs/netbsd/netbsd.factor
+++ b/basis/unix/statfs/netbsd/netbsd.factor
@ -0,0 +1,78 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel unix.stat math unix
+combinators system io.backend accessors alien.c-types
+io.encodings.utf8 alien.strings unix.types unix.statfs io.files ;
+IN: unix.statfs.netbsd
+
+: _VFS_NAMELEN    32   ; inline
+: _VFS_MNAMELEN   1024 ; inline
+
+C-STRUCT: statvfs
+    { "ulong"   "f_flag" }   
+    { "ulong"   "f_bsize" }
+    { "ulong"   "f_frsize" }  
+    { "ulong"   "f_iosize" }  
+    { "fsblkcnt_t" "f_blocks" }       
+    { "fsblkcnt_t" "f_bfree" } 
+    { "fsblkcnt_t" "f_bavail" }       
+    { "fsblkcnt_t" "f_bresvd" }       
+    { "fsfilcnt_t" "f_files" }
+    { "fsfilcnt_t" "f_ffree" }
+    { "fsfilcnt_t" "f_favail" }       
+    { "fsfilcnt_t" "f_fresvd" }       
+    { "uint64_t"   "f_syncreads" }    
+    { "uint64_t"   "f_syncwrites" }   
+    { "uint64_t"   "f_asyncreads" }   
+    { "uint64_t"   "f_asyncwrites" }  
+    { "fsid_t"    "f_fsidx" }
+    { "ulong"   "f_fsid" }
+    { "ulong"   "f_namemax" }      
+    { "uid_t"   "f_owner" }
+    { { "uint32_t" 4 } "f_spare" }     
+    { { "char" _VFS_NAMELEN } "f_fstypename" }
+    { { "char" _VFS_NAMELEN } "f_mntonname" }
+    { { "char" _VFS_NAMELEN } "f_mntfromname" } ;
+
+FUNCTION: int statvfs ( char* path, statvfs *buf ) ;
+
+TUPLE: netbsd-file-system-info < file-system-info
+flag bsize frsize io-size
+blocks blocks-free blocks-available blocks-reserved
+files ffree sync-reads sync-writes async-reads async-writes
+fsidx fsid namemax owner spare fstype mnotonname mntfromname
+file-system-type-name mount-from ;
+
+M: netbsd >file-system-info ( byte-array -- netbsd-file-system-info )
+    [ \ netbsd-file-system-info new ] dip
+    {
+        [
+            [ statvfs-f_bsize ]
+            [ statvfs-f_bavail ] bi * >>free-space
+        ]
+        [ statvfs-f_flag >>flag ]
+        [ statvfs-f_bsize >>bsize ]
+        [ statvfs-f_frsize >>frsize ]
+        [ statvfs-f_iosize >>io-size ]
+        [ statvfs-f_blocks >>blocks ]
+        [ statvfs-f_bfree >>blocks-free ]
+        [ statvfs-f_favail >>blocks-available ]
+        [ statvfs-f_fresvd >>blocks-reserved ]
+        [ statvfs-f_files >>files ]
+        [ statvfs-f_ffree >>ffree ]
+        [ statvfs-f_syncreads >>sync-reads ]
+        [ statvfs-f_syncwrites >>sync-writes ]
+        [ statvfs-f_asyncreads >>async-reads ]
+        [ statvfs-f_asyncwrites >>async-writes ]
+        [ statvfs-f_fsidx >>fsidx ]
+        [ statvfs-f_namemax >>namemax ]
+        [ statvfs-f_owner >>owner ]
+        [ statvfs-f_spare >>spare ]
+        [ statvfs-f_fstypename utf8 alien>string >>file-system-type-name ]
+        [ statvfs-f_mntonname utf8 alien>string >>mount-point ]
+        [ statvfs-f_mntfromname utf8 alien>string >>mount-from ]
+    } cleave ;
+
+M: netbsd file-system-info
+    normalize-path "statvfs" <c-object> tuck statvfs io-error 
+    >file-system-info ;
--- a/basis/unix/statfs/netbsd/tags.txt
+++ b/basis/unix/statfs/netbsd/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/unix/statfs/openbsd/32/32.factor
+++ b/basis/unix/statfs/openbsd/32/32.factor
@ -0,0 +1,26 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel unix ; 
+IN: unix.statfs.openbsd.32
+
+: MFSNAMELEN 16 ; inline
+: MNAMELEN 90 ; inline
+
+C-STRUCT: statfs
+    { "u_int32_t"  "f_flags" }
+    { "int32_t"    "f_bsize" }
+    { "u_int32_t"  "f_iosize" }
+    { "u_int32_t"  "f_blocks" }
+    { "u_int32_t"  "f_bfree" }
+    { "int32_t"    "f_bavail" }
+    { "u_int32_t"  "f_files" }
+    { "u_int32_t"  "f_ffree" }
+    { "fsid_t"     "f_fsid" }
+    { "uid_t"      "f_owner" }
+    { "u_int32_t"  "f_syncwrites" }
+    { "u_int32_t"  "f_asyncwrites" }
+    { "u_int32_t"  "f_ctime" }
+    { { "u_int32_t" 3 }  "f_spare" }
+    { { "char" MFSNAMELEN } "f_fstypename" }
+    { { "char" MNAMELEN }   "f_mntonname" }  
+    { { "char" MNAMELEN }   "f_mntfromname" } ;
--- a/basis/unix/statfs/openbsd/32/authors.txt
+++ b/basis/unix/statfs/openbsd/32/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/unix/statfs/openbsd/32/tags.txt
+++ b/basis/unix/statfs/openbsd/32/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/unix/statfs/openbsd/64/64.factor
+++ b/basis/unix/statfs/openbsd/64/64.factor
@ -0,0 +1,32 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax unix ;
+IN: unix.statfs.openbsd.64
+
+: MFSNAMELEN 16 ; inline
+: MNAMELEN 90 ; inline
+
+C-STRUCT: statfss
+    { "u_int32_t"      "f_flags" }
+    { "u_int32_t"      "f_bsize" }
+    { "u_int32_t"      "f_iosize" }
+    { "u_int64_t"      "f_blocks" }
+    { "u_int64_t"      "f_bfree" }
+    { "int64_t"        "f_bavail" }
+    { "u_int64_t"      "f_files" }
+    { "u_int64_t"      "f_ffree" }
+    { "int64_t"        "f_favail" }
+    { "u_int64_t"      "f_syncwrites" }
+    { "u_int64_t"      "f_syncreads" }
+    { "u_int64_t"      "f_asyncwrites" }
+    { "u_int64_t"      "f_asyncreads" }
+    { "fsid_t"         "f_fsid" }
+    { "u_int32_t"      "f_namemax" }
+    { "uid_t"          "f_owner" }
+    { "u_int32_t"      "f_ctime" }
+    { { "u_int32_t" 3 } " f_spare" }
+    { { "char" MFSNAMELEN } "f_fstypename" }
+    { { "char" MNAMELEN } "f_mntonname" }
+    { { "char" MNAMELEN } "f_mntfromname" }
+    { { "char" 512 } "mount_info" } ;
+    ! { "mount_info" "mount_info" } ;                                        
--- a/basis/unix/statfs/openbsd/64/authors.txt
+++ b/basis/unix/statfs/openbsd/64/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/unix/statfs/openbsd/64/tags.txt
+++ b/basis/unix/statfs/openbsd/64/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/unix/statfs/openbsd/authors.txt
+++ b/basis/unix/statfs/openbsd/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/unix/statfs/openbsd/openbsd.factor
+++ b/basis/unix/statfs/openbsd/openbsd.factor
@ -0,0 +1,53 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax accessors combinators kernel
+unix.types math system io.backend alien.c-types unix
+unix.statfs io.files ;
+IN: unix.statfs.openbsd
+
+C-STRUCT: statvfs
+    { "ulong" "f_bsize" }
+    { "ulong" "f_frsize" }
+    { "fsblkcnt_t" "f_blocks" }
+    { "fsblkcnt_t" "f_bfree" }
+    { "fsblkcnt_t" "f_bavail" }
+    { "fsfilcnt_t" "f_files" }
+    { "fsfilcnt_t" "f_ffree" }
+    { "fsfilcnt_t" "f_favail" }
+    { "ulong" "f_fsid" }
+    { "ulong" "f_flag" }
+    { "ulong" "f_namemax" } ;
+
+: ST_RDONLY       1 ; inline
+: ST_NOSUID       2 ; inline
+
+FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
+
+TUPLE: openbsd-file-system-info < file-system-info
+bsize frsize blocks bfree bavail files ffree favail
+fsid flag namemax ;
+
+M: openbsd >file-system-info ( struct -- statfs )
+    [ \ openbsd-file-system-info new ] dip
+    {
+        [
+            [ statvfs-f_bsize ]
+            [ statvfs-f_bavail ] bi * >>free-space
+        ]
+        [ statvfs-f_bsize >>bsize ]
+        [ statvfs-f_frsize >>frsize ]
+        [ statvfs-f_blocks >>blocks ]
+        [ statvfs-f_bfree >>bfree ]
+        [ statvfs-f_bavail >>bavail ]
+        [ statvfs-f_files >>files ]
+        [ statvfs-f_ffree >>ffree ]
+        [ statvfs-f_favail >>favail ]
+        [ statvfs-f_fsid >>fsid ]
+        [ statvfs-f_flag >>flag ]
+        [ statvfs-f_namemax >>namemax ]
+    } cleave ;
+
+M: openbsd file-system-info ( path -- byte-array )
+    normalize-path
+    "statvfs" <c-object> tuck statvfs io-error
+    >file-system-info ;
--- a/basis/unix/statfs/openbsd/tags.txt
+++ b/basis/unix/statfs/openbsd/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/unix/statfs/statfs-tests.factor
+++ b/basis/unix/statfs/statfs-tests.factor
@ -0,0 +1,4 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test unix.statfs ;
+IN: unix.statfs.tests
--- a/Show More
+++ b/Show More