Merge branch 'master' into new_codegen

basis/cpu/ppc/architecture/architecture.factor

@@ -96,9 +96,9 @@ M: ppc %epilogue ( n -- )
     1 1 rot ADDI
     0 MTLR ;
 
-: (%call) ( -- ) 11 MTLR BLRL ;
+: (%call) ( reg -- ) MTLR BLRL ;
 
-: (%jump) ( -- ) 11 MTCTR BCTR ;
+: (%jump) ( reg -- ) MTCTR BCTR ;
 
 : %load-dlsym ( symbol dll register -- )
     0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ;
@@ -117,7 +117,7 @@ M: ppc %dispatch ( -- )
         "offset" operand "n" operand 1 SRAWI
         11 11 "offset" operand ADD
         11 dup 6 cells LWZ
-        (%jump)
+        11 (%jump)
     ] H{
         { +input+ { { f "n" } } }
         { +scratch+ { { f "offset" } } }
@@ -244,17 +244,17 @@ M: ppc %prepare-alien-invoke
     rs-reg 11 12 STW ;
 
 M: ppc %alien-invoke ( symbol dll -- )
-    11 %load-dlsym (%call) ;
+    11 %load-dlsym 11 (%call) ;
 
 M: ppc %alien-callback ( quot -- )
     3 load-indirect "c_to_factor" f %alien-invoke ;
 
 M: ppc %prepare-alien-indirect ( -- )
     "unbox_alien" f %alien-invoke
-    3 11 MR ;
+    13 3 MR ;
 
 M: ppc %alien-indirect ( -- )
-    (%call) ;
+    13 (%call) ;
 
 M: ppc %callback-value ( ctype -- )
      ! Save top of data stack

basis/db/db-docs.factor

@@ -172,7 +172,7 @@ HELP: sql-row-typed
 HELP: with-db
 { $values
      { "db" db } { "quot" quotation } }
-{ $description "Calls the quotation with a database bound to the " { $link db } " symbol. The database called is based on the " { $snippet "class" } " with the " } ;
+{ $description "Calls the quotation with a database bound to the " { $link db } " symbol. See " { $link "db-custom-database-combinators" } " for help setting up database access." } ;
 
 HELP: with-transaction
 { $values

basis/io/unix/files/files-docs.factor

@@ -0,0 +1,277 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: classes help.markup help.syntax io.streams.string
+strings math calendar io.files ;
+IN: io.unix.files
+
+HELP: file-group-id
+{ $values
+     { "path" "a pathname string" }
+     { "gid" integer } }
+{ $description "Returns the group id for a given file." } ;
+
+HELP: file-group-name
+{ $values
+     { "path" "a pathname string" }
+     { "string" string } }
+{ $description "Returns the group name for a given file." } ;
+
+HELP: file-permissions
+{ $values
+     { "path" "a pathname string" }
+     { "n" integer } }
+{ $description "Returns the Unix file permissions for a given file." } ;
+
+HELP: file-username
+{ $values
+     { "path" "a pathname string" }
+     { "string" string } }
+{ $description "Returns the username for a given file." } ;
+
+HELP: file-user-id
+{ $values
+     { "path" "a pathname string" }
+     { "uid" integer } }
+{ $description "Returns the user id for a given file." } ;
+
+HELP: group-execute?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "group execute" } " bit is set on a file." } ;
+
+HELP: group-read?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file." } ;
+
+HELP: group-write?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file." } ;
+
+HELP: other-execute?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file." } ;
+
+HELP: other-read?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file." } ;
+
+HELP: other-write?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file." } ;
+
+HELP: set-file-access-time
+{ $values
+     { "path" "a pathname string" } { "timestamp" timestamp } }
+{ $description "Sets a file's last access timestamp." } ;
+
+HELP: set-file-group
+{ $values
+     { "path" "a pathname string" } { "string/id" "a string or a group id" } }
+{ $description "Sets a file's group id from the given group id or group name." } ;
+
+HELP: set-file-ids
+{ $values
+     { "path" "a pathname string" } { "uid" integer } { "gid" integer } }
+{ $description "Sets the user id and group id of a file with a single library call." } ;
+
+HELP: set-file-permissions
+{ $values
+     { "path" "a pathname string" } { "n" "an integer, interepreted as a string of bits" } }
+{ $description "Sets the file permissions for a given file with the supplied Unix permissions integer. Supplying an octal number with " { $link POSTPONE: OCT: } " is recommended." }
+{ $examples "Using the tradidional octal value:"
+    { $unchecked-example "USING: io.unix.files kernel ;"
+        "\"resource:license.txt\" OCT: 755 set-file-permissions"
+        ""
+    }
+    "Higher-level, setting named bits:"
+    { $unchecked-example "USING: io.unix.files kernel math.bitwise ;"
+    "\"resource:license.txt\""
+    "{ USER-ALL GROUP-READ GROUP-EXECUTE OTHER-READ OTHER-EXECUTE }"
+    "flags set-file-permissions"
+    "" }
+} ;
+
+HELP: set-file-times
+{ $values
+     { "path" "a pathname string" } { "timestamps" "an array of two timestamps" } }
+{ $description "Sets the access and write timestamps for a file as provided in the input array. A value of " { $link f } " provided for either of the timestamps will not change that timestamp." } ;
+
+HELP: set-file-user
+{ $values
+     { "path" "a pathname string" } { "string/id" "a string or a user id" } }
+{ $description "Sets a file's user id from the given user id or username." } ;
+
+HELP: set-file-modified-time
+{ $values
+     { "path" "a pathname string" } { "timestamp" timestamp } }
+{ $description "Sets a file's last modified timestamp, or write timestamp." } ;
+
+HELP: set-gid
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "gid" } " bit of a file to true or false." } ;
+
+HELP: gid?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file." } ;
+
+HELP: set-group-execute
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "group execute" } " bit of a file to true or false." } ;
+
+HELP: set-group-read
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "group read" } " bit of a file to true or false." } ;
+
+HELP: set-group-write
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "group write" } " bit of a file to true or false." } ;
+
+HELP: set-other-execute
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "other execute" } " bit of a file to true or false." } ;
+
+HELP: set-other-read
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "other read" } " bit of a file to true or false." } ;
+
+HELP: set-other-write
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "other execute" } " bit of a file to true or false." } ;
+
+HELP: set-sticky
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "sticky" } " bit of a file to true or false." } ;
+
+HELP: sticky?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "sticky" } " bit of a file is set." } ;
+
+HELP: set-uid
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "uid" } " bit of a file to true or false." } ;
+
+HELP: uid?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "uid" } " bit of a file is set." } ;
+
+HELP: set-user-execute
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "user execute" } " bit of a file to true or false." } ;
+
+HELP: set-user-read
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "user read" } " bit of a file to true or false." } ;
+
+HELP: set-user-write
+{ $values
+     { "path" "a pathname string" } { "?" "a boolean" } }
+{ $description "Sets the " { $snippet "user write" } " bit of a file to true or false." } ;
+
+HELP: user-execute?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file." } ;
+
+HELP: user-read?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file." } ;
+
+HELP: user-write?
+{ $values
+     { "path" "a pathname string" }
+     { "?" "a boolean" } }
+{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file." } ;
+
+ARTICLE: "unix-file-permissions" "Unix file permissions"
+"Reading all file permissions:"
+{ $subsection file-permissions }
+"Reading individual file permissions:"
+{ $subsection uid? }
+{ $subsection gid? }
+{ $subsection sticky? }
+{ $subsection user-read? }
+{ $subsection user-write? }
+{ $subsection user-execute? }
+{ $subsection group-read? }
+{ $subsection group-write? }
+{ $subsection group-execute? }
+{ $subsection other-read? }
+{ $subsection other-write? }
+{ $subsection other-execute? }
+"Writing all file permissions:"
+{ $subsection set-file-permissions }
+"Writing individual file permissions:"
+{ $subsection set-uid }
+{ $subsection set-gid }
+{ $subsection set-sticky }
+{ $subsection set-user-read }
+{ $subsection set-user-write }
+{ $subsection set-user-execute }
+{ $subsection set-group-read }
+{ $subsection set-group-write }
+{ $subsection set-group-execute }
+{ $subsection set-other-read }
+{ $subsection set-other-write }
+{ $subsection set-other-execute } ;
+
+ARTICLE: "unix-file-timestamps" "Unix file timestamps"
+"To read file times, use the accessors on the object returned by the " { $link file-info } " word." $nl
+"Setting multiple file times:"
+{ $subsection set-file-times }
+"Setting just the last access time:"
+{ $subsection set-file-access-time }
+"Setting just the last modified time:"
+{ $subsection set-file-modified-time } ;
+
+
+ARTICLE: "unix-file-ids" "Unix file user and group ids"
+"Reading file user data:"
+{ $subsection file-user-id }
+{ $subsection file-username }
+"Setting file user data:"
+{ $subsection set-file-user }
+"Reading file group data:"
+{ $subsection file-group-id }
+{ $subsection file-group-name }
+"Setting file group data:"
+{ $subsection set-file-group } ;
+
+
+ARTICLE: "io.unix.files" "Unix file attributes"
+"The " { $vocab-link "io.unix.files" } " vocabulary implements the Unix backend for opening files and provides a high-level way to set permissions, timestamps, and user and group ids for files."
+{ $subsection "unix-file-permissions" }
+{ $subsection "unix-file-timestamps" }
+{ $subsection "unix-file-ids" } ;
+
+ABOUT: "io.unix.files"

basis/io/unix/files/files-tests.factor

@@ -1,4 +1,6 @@
-USING: tools.test io.files ;
+USING: tools.test io.files continuations kernel io.unix.files
+math.bitwise calendar accessors math.functions math unix.users
+unix.groups arrays sequences ;
 IN: io.unix.files.tests
 
 [ "/usr/libexec/" ] [ "/usr/libexec/awk/" parent-directory ] unit-test
@@ -27,3 +29,109 @@ IN: io.unix.files.tests
 [ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test
 [ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test
 [ t ] [ "/foo" absolute-path? ] unit-test
+
+: test-file ( -- path )
+    "permissions" temp-file ;
+
+: prepare-test-file ( -- )
+    [ test-file delete-file ] ignore-errors
+    test-file touch-file ;
+
+: perms ( -- n )
+    test-file file-permissions OCT: 7777 mask ;
+
+prepare-test-file
+
+[ t ]
+[ test-file { USER-ALL GROUP-ALL OTHER-ALL } flags set-file-permissions perms OCT: 777 = ] unit-test
+
+[ t ] [ test-file user-read? ] unit-test
+[ t ] [ test-file user-write? ] unit-test
+[ t ] [ test-file user-execute? ] unit-test
+[ t ] [ test-file group-read? ] unit-test
+[ t ] [ test-file group-write? ] unit-test
+[ t ] [ test-file group-execute? ] unit-test
+[ t ] [ test-file other-read? ] unit-test
+[ 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-write perms OCT: 774 = ] unit-test
+
+[ t ]
+[ test-file f set-other-read perms OCT: 770 = ] unit-test
+
+[ t ]
+[ test-file f set-group-execute perms OCT: 760 = ] unit-test
+
+[ t ]
+[ test-file f set-group-write perms OCT: 740 = ] unit-test
+
+[ t ]
+[ test-file f set-group-read perms OCT: 700 = ] unit-test
+
+[ t ]
+[ test-file f set-user-execute perms OCT: 600 = ] unit-test
+
+[ t ]
+[ test-file f set-user-write perms OCT: 400 = ] unit-test
+
+[ t ]
+[ test-file f set-user-read perms OCT: 000 = ] unit-test
+
+[ t ]
+[ test-file { USER-ALL GROUP-ALL OTHER-EXECUTE } flags set-file-permissions perms OCT: 771 = ] unit-test
+
+prepare-test-file
+
+[ t ]
+[
+    test-file now
+    [ set-file-access-time ] 2keep
+    [ file-info accessed>> ]
+    [ [ [ truncate >integer ] change-second ] bi@ ] bi* =
+] unit-test
+
+[ t ]
+[
+    test-file now
+    [ set-file-modified-time ] 2keep
+    [ file-info modified>> ]
+    [ [ [ truncate >integer ] change-second ] bi@ ] bi* =
+] unit-test
+
+[ t ]
+[
+    test-file now [ dup 2array set-file-times ] 2keep
+    [ file-info [ modified>> ] [ accessed>> ] bi ] dip
+    3array
+    [ [ truncate >integer ] change-second ] map all-equal?
+] unit-test
+
+[ ] [ test-file f now 2array set-file-times ] unit-test
+[ ] [ test-file now f 2array set-file-times ] unit-test
+[ ] [ test-file f f 2array set-file-times ] unit-test
+
+
+[ ] [ test-file real-username set-file-user ] unit-test
+[ ] [ test-file real-user-id set-file-user ] unit-test
+[ ] [ test-file real-group-name set-file-group ] unit-test
+[ ] [ test-file real-group-id set-file-group ] unit-test
+
+[ t ] [ test-file file-username real-username = ] unit-test
+[ t ] [ test-file file-group-name real-group-name = ] unit-test
+
+[ ]
+[ test-file real-user-id real-group-id set-file-ids ] unit-test
+
+[ ]
+[ test-file f real-group-id set-file-ids ] unit-test
+
+[ ]
+[ test-file real-user-id f set-file-ids ] unit-test
+
+[ ]
+[ test-file f f set-file-ids ] unit-test

basis/io/unix/files/files.factor

@@ -1,11 +1,11 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.backend io.ports io.unix.backend io.files io
 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 ;
+io.files.private destructors vocabs.loader calendar.unix
-
+unix.stat alien.c-types arrays unix.users unix.groups ;
 IN: io.unix.files
 
 M: unix cwd ( -- path )
@@ -136,3 +136,122 @@ os {
     { freebsd  [ "io.unix.files.bsd" require ] }
     { linux [ ] }
 } case
+
+<PRIVATE
+
+: stat-mode ( path -- mode )
+    normalize-path file-status stat-st_mode ;
+    
+: chmod-set-bit ( path mask ? -- ) 
+    [ dup stat-mode ] 2dip 
+    [ bitor ] [ unmask ] if chmod io-error ;
+
+: file-mode? ( path mask -- ? ) [ stat-mode ] dip mask? ;
+
+PRIVATE>
+
+: UID           OCT: 0004000 ; inline
+: GID           OCT: 0002000 ; inline
+: STICKY        OCT: 0001000 ; inline
+: USER-ALL      OCT: 0000700 ; inline
+: USER-READ     OCT: 0000400 ; inline
+: USER-WRITE    OCT: 0000200 ; inline 
+: USER-EXECUTE  OCT: 0000100 ; inline   
+: GROUP-ALL     OCT: 0000070 ; inline
+: GROUP-READ    OCT: 0000040 ; inline 
+: GROUP-WRITE   OCT: 0000020 ; inline  
+: GROUP-EXECUTE OCT: 0000010 ; inline    
+: OTHER-ALL     OCT: 0000007 ; inline
+: OTHER-READ    OCT: 0000004 ; inline
+: 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? ;
+
+: set-uid ( path ? -- ) UID swap chmod-set-bit ;
+: set-gid ( path ? -- ) GID swap chmod-set-bit ;
+: set-sticky ( path ? -- ) STICKY swap chmod-set-bit ;
+: set-user-read ( path ? -- ) USER-READ swap chmod-set-bit ;
+: set-user-write ( path ? -- ) USER-WRITE swap chmod-set-bit ; 
+: set-user-execute ( path ? -- ) USER-EXECUTE swap chmod-set-bit ;
+: set-group-read ( path ? -- ) GROUP-READ swap chmod-set-bit ;
+: set-group-write ( path ? -- ) GROUP-WRITE swap chmod-set-bit ; 
+: set-group-execute ( path ? -- ) GROUP-EXECUTE swap chmod-set-bit ;
+: set-other-read ( path ? -- ) OTHER-READ swap chmod-set-bit ;
+: set-other-write ( path ? -- ) OTHER-WRITE swap chmod-set-bit ; 
+: set-other-execute ( path ? -- ) OTHER-EXECUTE swap chmod-set-bit ;
+
+: set-file-permissions ( path n -- )
+    [ normalize-path ] dip chmod io-error ;
+
+: file-permissions ( path -- n )
+    normalize-path file-info permissions>> ;
+
+<PRIVATE
+
+: make-timeval-array ( array -- byte-array )
+    [ length "timeval" <c-array> ] keep
+    dup length [ over [ pick set-timeval-nth ] [ 2drop ] if ] 2each ;
+
+: timestamp>timeval ( timestamp -- timeval )
+    unix-1970 time- duration>milliseconds make-timeval ;
+
+: timestamps>byte-array ( timestamps -- byte-array )
+    [ dup [ timestamp>timeval ] when ] map make-timeval-array ;
+
+PRIVATE>
+
+: set-file-times ( path timestamps -- )
+    #! set access, write
+    [ normalize-path ] dip
+    timestamps>byte-array utimes io-error ;
+
+: set-file-access-time ( path timestamp -- )
+    f 2array set-file-times ;
+
+: set-file-modified-time ( path timestamp -- )
+    f swap 2array set-file-times ;
+
+: set-file-ids ( path uid gid -- )
+    [ normalize-path ] 2dip
+    [ [ -1 ] unless* ] bi@ chown io-error ;
+
+GENERIC: set-file-user ( path string/id -- )
+
+GENERIC: set-file-group ( path string/id -- )
+
+M: integer set-file-user ( path uid -- )
+    f set-file-ids ;
+
+M: string set-file-user ( path string -- )
+    user-id f set-file-ids ;
+    
+M: integer set-file-group ( path gid -- )
+    f swap set-file-ids ;
+    
+M: string set-file-group ( path string -- )
+    group-id
+    f swap set-file-ids ;
+
+: file-user-id ( path -- uid )
+    normalize-path file-info uid>> ;
+
+: file-username ( path -- string )
+    file-user-id username ;
+
+: file-group-id ( path -- gid )
+    normalize-path file-info gid>> ;
+
+: file-group-name ( path -- string )
+    file-group-id group-name ;

basis/locals/locals.factor

@@ -421,7 +421,7 @@ M: lambda-macro definition
     "lambda" word-prop body>> ;
 
 M: lambda-macro reset-word
-    [ f "lambda" set-word-prop ] [ call-next-method ] bi ;
+    [ call-next-method ] [ f "lambda" set-word-prop ] bi ;
 
 INTERSECTION: lambda-method method-body lambda-word ;
 

basis/ui/windows/windows.factor

@@ -420,15 +420,25 @@ M: windows-ui-backend do-events
     style 0 ex-style AdjustWindowRectEx win32-error=0/f ;
 
 : make-RECT ( world -- RECT )
-    dup window-loc>> { 40 40 } vmax dup rot rect-dim v+
+    dup window-loc>> dup rot rect-dim v+
     "RECT" <c-object>
     over first over set-RECT-right
     swap second over set-RECT-bottom
     over first over set-RECT-left
     swap second over set-RECT-top ;
 
+: default-position-RECT ( RECT -- )
+    dup get-RECT-dimensions [ 2drop ] 2dip
+    CW_USEDEFAULT + pick set-RECT-bottom
+    CW_USEDEFAULT + over set-RECT-right
+    CW_USEDEFAULT over set-RECT-left
+    CW_USEDEFAULT swap set-RECT-top ;
+
 : make-adjusted-RECT ( rect -- RECT )
-    make-RECT dup adjust-RECT ;
+    make-RECT
+    dup get-RECT-top-left [ zero? ] both? swap
+    dup adjust-RECT
+    swap [ dup default-position-RECT ] when ;
 
 : create-window ( rect -- hwnd )
     make-adjusted-RECT

basis/unix/bsd/bsd.factor

@@ -48,6 +48,19 @@ C-STRUCT: sockaddr-un
     { "uchar" "family" }
     { { "char" 104 } "path" } ;
 
+C-STRUCT: passwd
+    { "char*"  "pw_name" }
+    { "char*"  "pw_passwd" }
+    { "uid_t"  "pw_uid" }
+    { "gid_t"  "pw_gid" }
+    { "time_t" "pw_change" }
+    { "char*"  "pw_class" }
+    { "char*"  "pw_gecos" }
+    { "char*"  "pw_dir" }
+    { "char*"  "pw_shell" }
+    { "time_t" "pw_expire" }
+    { "int"    "pw_fields" } ;
+
 : max-un-path 104 ; inline
 
 : SOCK_STREAM 1 ; inline

basis/unix/bsd/macosx/macosx.factor

@@ -1,4 +1,4 @@
-USING: alien.syntax ;
+USING: alien.syntax unix.time ;
 IN: unix
 
 : FD_SETSIZE 1024 ; inline
@@ -13,19 +13,6 @@ C-STRUCT: addrinfo
     { "void*" "addr" }
     { "addrinfo*" "next" } ;
 
-C-STRUCT: passwd
-    { "char*"  "pw_name" }
-    { "char*"  "pw_passwd" }
-    { "uid_t"  "pw_uid" }
-    { "gid_t"  "pw_gid" }
-    { "time_t" "pw_change" }
-    { "char*"  "pw_class" }
-    { "char*"  "pw_gecos" }
-    { "char*"  "pw_dir" }
-    { "char*"  "pw_shell" }
-    { "time_t" "pw_expire" }
-    { "int"    "pw_fields" } ;
-
 : EPERM 1 ; inline
 : ENOENT 2 ; inline
 : ESRCH 3 ; inline
@@ -130,3 +117,18 @@ C-STRUCT: passwd
 : 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" } ;

basis/unix/bsd/netbsd/netbsd.factor

@@ -1,4 +1,4 @@
-USING: alien.syntax ;
+USING: alien.syntax alien.c-types math vocabs.loader ;
 IN: unix
 
 : FD_SETSIZE 256 ; inline
@@ -111,3 +111,24 @@ C-STRUCT: addrinfo
 : ENOLINK 95 ; inline
 : EPROTO 96 ; inline
 : ELAST 96 ; inline
+
+TYPEDEF: __uint8_t sa_family_t
+
+: _UTX_USERSIZE   32 ; inline
+: _UTX_LINESIZE   32 ; inline
+: _UTX_IDSIZE     4 ; inline
+: _UTX_HOSTSIZE   256 ; inline
+
+: _SS_MAXSIZE ( -- n )
+    128 ; inline
+
+: _SS_ALIGNSIZE ( -- n )
+    "__int64_t" heap-size ; inline
+    
+: _SS_PAD1SIZE ( -- n )
+    _SS_ALIGNSIZE 2 - ; inline
+    
+: _SS_PAD2SIZE ( -- n )
+    _SS_MAXSIZE 2 - _SS_PAD1SIZE - _SS_ALIGNSIZE - ; inline
+
+"unix.bsd.netbsd.structs" require

basis/unix/bsd/netbsd/structs/structs.factor

@@ -0,0 +1,29 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax unix.time ;
+IN: unix
+
+C-STRUCT: sockaddr_storage
+    { "__uint8_t" "ss_len" }
+    { "sa_family_t" "ss_family" }
+    { { "char" _SS_PAD1SIZE } "__ss_pad1" }
+    { "__int64_t" "__ss_align" }
+    { { "char" _SS_PAD2SIZE } "__ss_pad2" } ;
+
+C-STRUCT: exit_struct
+    { "uint16_t" "e_termination" }
+    { "uint16_t" "e_exit" } ;
+
+C-STRUCT: utmpx
+    { { "char" _UTX_USERSIZE } "ut_user" }
+    { { "char" _UTX_IDSIZE } "ut_id" }
+    { { "char" _UTX_LINESIZE } "ut_line" }
+    { { "char" _UTX_HOSTSIZE } "ut_host" }
+    { "uint16_t" "ut_session" }
+    { "uint16_t" "ut_type" }
+    { "pid_t" "ut_pid" }
+    { "exit_struct" "ut_exit" }
+    { "sockaddr_storage" "ut_ss" }
+    { "timeval" "ut_tv" }
+    { { "uint32_t" 10 } "ut_pad" } ;
+

basis/unix/bsd/netbsd/structs/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/groups/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/groups/groups-docs.factor

@@ -0,0 +1,108 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax io.streams.string kernel quotations sequences strings math ;
+IN: unix.groups
+
+HELP: all-groups
+{ $values
+    
+     { "seq" sequence } }
+{ $description "Returns a sequence of " { $link group } " tuples that are platform-dependent and field for field complete with the Unix " { $link group } " structure." } ;
+
+HELP: effective-group-id
+{ $values
+    
+     { "string" string } }
+{ $description "Returns the effective group id for the current user." } ;
+
+HELP: effective-group-name
+{ $values
+    
+     { "string" string } }
+{ $description "Returns the effective group name for the current user." } ;
+
+HELP: group
+{ $description "A platform-specific tuple corresponding to every field from the Unix group struct including the group name, the group id, the group passwd, and a list of users in each group." } ;
+
+HELP: group-cache
+{ $description "A symbol containing a cache of groups returned from " { $link all-groups } " and indexed by group id. Can be more efficient than using the system call words for many group lookups." } ;
+
+HELP: group-id
+{ $values
+     { "string" string }
+     { "id" integer } }
+{ $description "Returns the group id given a group name." } ;
+
+HELP: group-name
+{ $values
+     { "id" integer }
+     { "string" string } }
+{ $description "Returns the group name given a group id." } ;
+
+HELP: group-struct
+{ $values
+     { "obj" object }
+     { "group" "a group struct" } }
+{ $description "Returns an alien group struct to be turned into a group tuple by calling subsequent words." } ;
+
+HELP: real-group-id
+{ $values
+    
+     { "id" integer } }
+{ $description "Returns the real group id for the current user." } ;
+
+HELP: real-group-name
+{ $values
+    
+     { "string" string } }
+{ $description "Returns the real group name for the current user." } ;
+
+HELP: set-effective-group
+{ $values
+     { "obj" object } }
+{ $description "Sets the effective group id for the current user." } ;
+
+HELP: set-real-group
+{ $values
+     { "obj" object } }
+{ $description "Sets the real group id for the current user." } ;
+
+HELP: user-groups
+{ $values
+     { "string/id" "a string or a group id" }
+     { "seq" sequence } }
+{ $description "Returns the sequence of groups to which the user belongs." } ;
+
+HELP: with-effective-group
+{ $values
+     { "string/id" "a string or a group id" } { "quot" quotation } }
+{ $description "Sets the effective group name and calls the quotation. Restors the effective group name on success or on error after the call." } ;
+
+HELP: with-group-cache
+{ $values
+     { "quot" quotation } }
+{ $description "Iterates over the group file using library calls and creates a cache in the " { $link group-cache } " symbol. The cache is a hashtable indexed by group id. When looking up many groups, this approach is much faster than calling system calls." } ;
+
+HELP: with-real-group
+{ $values
+     { "string/id" "a string or a group id" } { "quot" quotation } }
+{ $description "Sets the real group name and calls the quotation. Restores the current group name on success or on error after the call." } ;
+
+ARTICLE: "unix.groups" "unix.groups"
+"The " { $vocab-link "unix.groups" } " vocabulary contains words that return information about Unix groups."
+"Listing all groups:"
+{ $subsection all-groups }
+"Returning a passwd tuple:"
+"Real groups:"
+{ $subsection real-group-name }
+{ $subsection real-group-id }
+{ $subsection set-real-group }
+"Effective groups:"
+{ $subsection effective-group-name }
+{ $subsection effective-group-id }
+{ $subsection set-effective-group }
+"Combinators to change groups:"
+{ $subsection with-real-group }
+{ $subsection with-effective-group } ;
+
+ABOUT: "unix.groups"

basis/unix/groups/groups-tests.factor

@@ -0,0 +1,24 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test unix.groups kernel strings math ;
+IN: unix.groups.tests
+
+
+[ ] [ all-groups drop ] unit-test
+
+\ all-groups must-infer
+
+[ t ] [ real-group-name string? ] unit-test
+[ t ] [ effective-group-name string? ] unit-test
+
+[ t ] [ real-group-id integer? ] unit-test
+[ t ] [ effective-group-id integer? ] unit-test
+
+[ ] [ real-group-id set-real-group ] unit-test
+[ ] [ effective-group-id set-effective-group ] unit-test
+
+[ ] [ real-group-name [ ] with-real-group ] unit-test
+[ ] [ real-group-id [ ] with-real-group ] unit-test
+
+[ ] [ effective-group-name [ ] with-effective-group ] unit-test
+[ ] [ effective-group-id [ ] with-effective-group ] unit-test

basis/unix/groups/groups.factor

@@ -0,0 +1,132 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+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 ;
+IN: unix.groups
+
+QUALIFIED: grouping
+
+TUPLE: group id name passwd members ;
+
+SYMBOL: group-cache
+
+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-struct) ( id -- group-struct id group-struct byte-array length void* )
+    "group" <c-object> tuck 4096
+    [ <byte-array> ] keep f <void*> ;
+
+M: integer group-struct ( id -- group )
+    (group-struct) getgrgid_r io-error ;
+
+M: string group-struct ( string -- group )
+    (group-struct) getgrnam_r 0 = [ (io-error) ] unless ;
+
+: group-struct>group ( group-struct -- group )
+    [ \ group new ] dip
+    {
+        [ group-gr_name >>name ]
+        [ group-gr_passwd >>passwd ]
+        [ group-gr_gid >>id ]
+        [ group-members >>members ]
+    } cleave ;
+
+PRIVATE>
+
+: group-name ( id -- string )
+    dup group-cache get [
+        at
+    ] [
+        group-struct group-gr_name
+    ] if*
+    [ nip ] [ number>string ] if* ;
+
+: group-id ( string -- id )
+    group-struct group-gr_gid ;
+
+<PRIVATE
+
+: >groups ( byte-array n -- groups )
+    [ 4 grouping:group ] dip head-slice [ *uint group-name ] map ;
+
+: (user-groups) ( string -- seq )
+    #! first group is -1337, legacy unix code
+    -1337 NGROUPS_MAX [ 4 * <byte-array> ] keep
+    <int> [ getgrouplist io-error ] 2keep
+    [ 4 tail-slice ] [ *int 1- ] bi* >groups ;
+
+PRIVATE>
+    
+GENERIC: user-groups ( string/id -- seq )
+
+M: string user-groups ( string -- seq )
+    (user-groups) ; 
+
+M: integer user-groups ( id -- seq )
+    username (user-groups) ;
+    
+: all-groups ( -- seq )
+    [ getgrent dup ] [ group-struct>group ] [ drop ] produce ;
+
+: with-group-cache ( quot -- )
+    all-groups [ [ id>> ] keep ] H{ } map>assoc
+    group-cache rot with-variable ; inline
+
+: real-group-id ( -- id )
+    getgid ; inline
+
+: real-group-name ( -- string )
+    real-group-id group-name ; inline
+
+: effective-group-id ( -- string )
+    getegid ; inline
+
+: effective-group-name ( -- string )
+    effective-group-id group-name ; inline
+
+GENERIC: set-real-group ( obj -- )
+
+GENERIC: set-effective-group ( obj -- )
+
+: with-real-group ( string/id quot -- )
+    '[ _ set-real-group @ ]
+    real-group-id '[ _ set-real-group ] [ ] cleanup ; inline
+
+: with-effective-group ( string/id quot -- )
+    '[ _ set-effective-group @ ]
+    effective-group-id '[ _ set-effective-group ] [ ] cleanup ; inline
+
+<PRIVATE
+
+: (set-real-group) ( id -- )
+    setgid io-error ; inline
+
+: (set-effective-group) ( id -- )
+    setegid io-error ; inline
+
+PRIVATE>
+    
+M: string set-real-group ( string -- )
+    group-id (set-real-group) ;
+
+M: integer set-real-group ( id -- )
+    (set-real-group) ;
+
+M: integer set-effective-group ( id -- )    
+    (set-effective-group) ;
+
+M: string set-effective-group ( string -- )
+    group-id (set-effective-group) ;

basis/unix/groups/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/stat/macosx/macosx.factor

@@ -8,7 +8,7 @@ C-STRUCT: stat
     { "dev_t"      "st_dev" }
     { "mode_t"     "st_mode" }
     { "nlink_t"    "st_nlink" }
-    { "ino_t"      "st_ino" }
+    { "ino64_t"    "st_ino" }
     { "uid_t"      "st_uid" }
     { "gid_t"      "st_gid" }
     { "dev_t"      "st_rdev" }

basis/unix/stat/stat.factor

@@ -1,12 +1,8 @@
-
 USING: kernel system combinators alien.syntax alien.c-types
-       math io.unix.backend vocabs.loader unix ;
+math io.unix.backend vocabs.loader unix ;
-
 IN: unix.stat
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! File Types
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : S_IFMT   OCT: 170000 ; ! These bits determine file type.
 
@@ -18,54 +14,24 @@ IN: unix.stat
 : S_IFLNK  OCT: 120000 ; inline   ! Symbolic link.
 : S_IFSOCK OCT: 140000 ; inline   ! Socket.
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! File Access Permissions
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! Read, write, execute/search by owner
-: S_IRWXU OCT: 0000700 ; inline    ! rwx mask owner
-: S_IRUSR OCT: 0000400 ; inline    ! r owner
-: S_IWUSR OCT: 0000200 ; inline    ! w owner
-: S_IXUSR OCT: 0000100 ; inline    ! x owner
-! Read, write, execute/search by group
-: S_IRWXG OCT: 0000070 ; inline    ! rwx mask group
-: S_IRGRP OCT: 0000040 ; inline    ! r group
-: S_IWGRP OCT: 0000020 ; inline    ! w group
-: S_IXGRP OCT: 0000010 ; inline    ! x group
-! Read, write, execute/search by others
-: S_IRWXO OCT: 0000007 ; inline    ! rwx mask other
-: S_IROTH OCT: 0000004 ; inline    ! r other
-: S_IWOTH OCT: 0000002 ; inline    ! w other
-: S_IXOTH OCT: 0000001 ; inline    ! x other
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 FUNCTION: int chmod ( char* path, mode_t mode ) ;
-
 FUNCTION: int fchmod ( int fd, mode_t mode ) ;
-
 FUNCTION: int mkdir ( char* path, mode_t mode ) ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+<< os {
-<<
-  os
-  {
     { linux   [ "unix.stat.linux"   require ] }
     { macosx  [ "unix.stat.macosx"  require ] }
     { freebsd [ "unix.stat.freebsd" require ] }
     { netbsd  [ "unix.stat.netbsd"  require ] }
     { openbsd [ "unix.stat.openbsd" require ] }
-  }
+} case >>
-  case
->>
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : file-status ( pathname -- stat )
-    "stat" <c-object> dup >r
+    "stat" <c-object> [
         [ stat ] unix-system-call drop
-    r> ;
+    ] keep ;
 
 : link-status ( pathname -- stat )
-    "stat" <c-object> dup >r
+    "stat" <c-object> [
         [ lstat ] unix-system-call drop
-    r> ;
+    ] keep ;

basis/unix/types/macosx/macosx.factor

@@ -22,6 +22,7 @@ TYPEDEF: __uint32_t uid_t
 TYPEDEF: __uint32_t gid_t
 TYPEDEF: __int64_t  off_t
 TYPEDEF: __int64_t  blkcnt_t
+TYPEDEF: __int64_t  ino64_t
 TYPEDEF: __int32_t  blksize_t
 TYPEDEF: long       ssize_t
 TYPEDEF: __int32_t  pid_t

basis/unix/types/types.factor

@@ -3,6 +3,29 @@ system ;
 IN: unix.types
 
 TYPEDEF: void* caddr_t
+TYPEDEF: uint in_addr_t
+TYPEDEF: uint socklen_t
+
+TYPEDEF: char int8_t
+TYPEDEF: short int16_t
+TYPEDEF: int int32_t
+TYPEDEF: longlong int64_t
+
+TYPEDEF: uchar uint8_t
+TYPEDEF: ushort uint16_t
+TYPEDEF: uint uint32_t
+TYPEDEF: ulonglong uint64_t
+
+TYPEDEF: char __int8_t
+TYPEDEF: short __int16_t
+TYPEDEF: int __int32_t
+TYPEDEF: longlong __int64_t
+
+TYPEDEF: uchar __uint8_t
+TYPEDEF: ushort __uint16_t
+TYPEDEF: uint __uint32_t
+TYPEDEF: ulonglong __uint64_t
+
 
 os {
     { linux   [ "unix.types.linux"   require ] }

basis/unix/unix.factor

@@ -7,9 +7,6 @@ stack-checker macros locals generalizations unix.types
 debugger io prettyprint ;
 IN: unix
 
-TYPEDEF: uint in_addr_t
-TYPEDEF: uint socklen_t
-
 : PROT_NONE   0 ; inline
 : PROT_READ   1 ; inline
 : PROT_WRITE  2 ; inline
@@ -78,6 +75,8 @@ MACRO:: unix-system-call ( quot -- )
 FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ;
 FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ;
 FUNCTION: int chdir ( char* path ) ;
+FUNCTION: int chmod ( char* path, mode_t mode ) ;
+FUNCTION: int fchmod ( int fd, mode_t mode ) ;
 FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
 FUNCTION: int chroot ( char* path ) ;
 
@@ -91,6 +90,7 @@ FUNCTION: int dup2 ( int oldd, int newd ) ;
 : _exit ( status -- * )
     #! We throw to give this a terminating stack effect.
     "int" f "_exit" { "int" } alien-invoke "Exit failed" throw ;
+FUNCTION: void endpwent ( ) ;
 FUNCTION: int fchdir ( int fd ) ;
 FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ;
 FUNCTION: int fcntl ( int fd, int cmd, int arg ) ;
@@ -108,6 +108,8 @@ FUNCTION: gid_t getgid ;
 FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ;
 FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ;
 FUNCTION: passwd* getpwent ( ) ;
+FUNCTION: passwd* getpwuid ( uid_t uid ) ;
+FUNCTION: passwd* getpwnam ( char* login ) ;
 FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ;
 FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ;
 FUNCTION: int getgrouplist ( char* name, int basegid, int* groups, int* ngroups ) ;

basis/unix/users/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/users/bsd/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/users/bsd/bsd.factor

@@ -0,0 +1,19 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators accessors kernel unix unix.users
+system ;
+IN: unix.users.bsd
+
+TUPLE: bsd-passwd < passwd change class expire fields ;
+
+M: bsd new-passwd ( -- bsd-passwd ) bsd-passwd new ;
+
+M: bsd passwd>new-passwd ( passwd -- bsd-passwd )
+    [ call-next-method ] keep
+    {
+        [ passwd-pw_change >>change ]
+        [ passwd-pw_class >>class ]
+        [ passwd-pw_shell >>shell ]
+        [ passwd-pw_expire >>expire ]
+        [ passwd-pw_fields >>fields ]
+    } cleave ;

basis/unix/users/bsd/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/users/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/users/users-docs.factor

@@ -0,0 +1,120 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax io.streams.string kernel quotations sequences strings math ;
+IN: unix.users
+
+HELP: all-users
+{ $values
+    
+     { "seq" sequence } }
+{ $description "Returns a sequence of high-level " { $link passwd } " tuples that are platform-dependent and field for field complete with the Unix " { $link passwd } " structure." } ;
+
+HELP: effective-username
+{ $values
+    
+     { "string" string } }
+{ $description "Returns the effective username for the current user." } ;
+
+HELP: effective-user-id
+{ $values
+    
+     { "id" integer } }
+{ $description "Returns the effective username id for the current user." } ;
+
+HELP: new-passwd
+{ $values
+    
+     { "passwd" passwd } }
+{ $description "Creates a new passwd tuple dependent on the operating system." } ;
+
+HELP: passwd
+{ $description "A platform-specific tuple correspding to every field from the Unix passwd struct. BSD passwd structures have four extra slots: " { $slot "change" } ", " { $slot "class" } "," { $slot "expire" } ", " { $slot "fields" } "." } ;
+
+HELP: passwd-cache
+{ $description "A symbol storing passwd structures indexed by user-ids when within a " { $link with-passwd-cache } "." } ;
+
+HELP: passwd>new-passwd
+{ $values
+     { "passwd" "a passwd struct" }
+     { "new-passwd" "a passwd tuple" } }
+{ $description "A platform-specific conversion routine from a passwd structure to a passwd tuple." } ;
+
+HELP: real-username
+{ $values
+    
+     { "string" string } }
+{ $description "The real username of the current user." } ;
+
+HELP: real-user-id
+{ $values
+    
+     { "id" integer } }
+{ $description "The real user id of the current user." } ;
+
+HELP: set-effective-user
+{ $values
+     { "string/id" "a string or a user id" } }
+{ $description "Sets the current effective user given a username or a user id." } ;
+
+HELP: set-real-user
+{ $values
+     { "string/id" "a string or a user id" } }
+{ $description "Sets the current real user given a username or a user id." } ;
+
+HELP: user-passwd
+{ $values
+     { "obj" object }
+     { "passwd" passwd } }
+{ $description "Returns the passwd tuple given a username string or user id." } ;
+
+HELP: username
+{ $values
+     { "id" integer }
+     { "string" string } }
+{ $description "Returns the username associated with the user id." } ;
+
+HELP: user-id
+{ $values
+     { "string" string }
+     { "id" integer } }
+{ $description "Returns the user id associated with the username." } ;
+
+HELP: with-effective-user
+{ $values
+     { "string/id" "a string or a uid" } { "quot" quotation } }
+{ $description "Sets the effective username and calls the quotation. Restores the current username on success or on error after the call." } ;
+
+HELP: with-passwd-cache
+{ $values
+     { "quot" quotation } }
+{ $description "Iterates over the password file using library calls and creates a cache in the " { $link passwd-cache } " symbol. The cache is a hashtable indexed by user id. When looking up many users, this approach is much faster than calling system calls." } ;
+
+HELP: with-real-user
+{ $values
+     { "string/id" "a string or a uid" } { "quot" quotation } }
+{ $description "Sets the real username and calls the quotation. Restores the current username on success or on error after the call." } ;
+
+{
+    real-username real-user-id set-real-user
+    effective-username effective-user-id          
+    set-effective-user
+} related-words
+
+ARTICLE: "unix.users" "unix.users"
+"The " { $vocab-link "unix.users" } " vocabulary contains words that return information about Unix users."
+"Listing all users:"
+{ $subsection all-users }
+"Returning a passwd tuple:"
+"Real user:"
+{ $subsection real-username }
+{ $subsection real-user-id }
+{ $subsection set-real-user }
+"Effective user:"
+{ $subsection effective-username }
+{ $subsection effective-user-id }
+{ $subsection set-effective-user }
+"Combinators to change users:"
+{ $subsection with-real-user }
+{ $subsection with-effective-user } ;
+
+ABOUT: "unix.users"

basis/unix/users/users-tests.factor

@@ -0,0 +1,24 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test unix.users kernel strings math ;
+IN: unix.users.tests
+
+
+[ ] [ all-users drop ] unit-test
+
+\ all-users must-infer
+
+[ t ] [ real-username string? ] unit-test
+[ t ] [ effective-username string? ] unit-test
+
+[ t ] [ real-user-id integer? ] unit-test
+[ t ] [ effective-user-id integer? ] unit-test
+
+[ ] [ real-user-id set-real-user ] unit-test
+[ ] [ effective-user-id set-effective-user ] unit-test
+
+[ ] [ real-username [ ] with-real-user ] unit-test
+[ ] [ real-user-id [ ] with-real-user ] unit-test
+
+[ ] [ effective-username [ ] with-effective-user ] unit-test
+[ ] [ effective-user-id [ ] with-effective-user ] unit-test

basis/unix/users/users.factor

@@ -0,0 +1,114 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types alien.strings io.encodings.utf8
+io.unix.backend kernel math sequences splitting unix strings
+combinators.short-circuit grouping byte-arrays combinators
+accessors math.parser fry assocs namespaces continuations
+vocabs.loader system ;
+IN: unix.users
+
+TUPLE: passwd username password uid gid gecos dir shell ;
+
+HOOK: new-passwd os ( -- passwd )
+HOOK: passwd>new-passwd os ( passwd -- new-passwd )
+
+<PRIVATE
+
+M: unix new-passwd ( -- passwd )
+    passwd new ;
+
+M: unix passwd>new-passwd ( passwd -- seq )
+    [ new-passwd ] dip
+    {
+        [ passwd-pw_name >>username ]
+        [ passwd-pw_passwd >>password ]
+        [ passwd-pw_uid >>uid ]
+        [ passwd-pw_gid >>gid ]
+        [ passwd-pw_gecos >>gecos ]
+        [ passwd-pw_dir >>dir ]
+        [ passwd-pw_shell >>shell ]
+    } cleave ;
+
+: with-pwent ( quot -- )
+    [ endpwent ] [ ] cleanup ; inline
+
+PRIVATE>
+
+: all-users ( -- seq )
+    [
+        [ getpwent dup ] [ passwd>new-passwd ] [ drop ] produce
+    ] with-pwent ;
+
+SYMBOL: passwd-cache
+
+: with-passwd-cache ( quot -- )
+    all-users [ [ uid>> ] keep ] H{ } map>assoc
+    passwd-cache swap with-variable ; inline
+
+GENERIC: user-passwd ( obj -- passwd )
+
+M: integer user-passwd ( id -- passwd/f )
+    passwd-cache get
+    [ at ] [ getpwuid passwd>new-passwd ] if* ;
+
+M: string user-passwd ( string -- passwd/f )
+    getpwnam dup [ passwd>new-passwd ] when ;
+
+: username ( id -- string )
+    user-passwd username>> ;
+
+: user-id ( string -- id )
+    user-passwd uid>> ;
+
+: real-user-id ( -- id )
+    getuid ; inline
+
+: real-username ( -- string )
+    real-user-id username ; inline
+
+: effective-user-id ( -- id )
+    geteuid ; inline
+
+: effective-username ( -- string )
+    effective-user-id username ; inline
+
+GENERIC: set-real-user ( string/id -- )
+
+GENERIC: set-effective-user ( string/id -- )
+
+: with-real-user ( string/id quot -- )
+    '[ _ set-real-user @ ]
+    real-user-id '[ _ set-real-user ]
+    [ ] cleanup ; inline
+
+: with-effective-user ( string/id quot -- )
+    '[ _ set-effective-user @ ]
+    effective-user-id '[ _ set-effective-user ]
+    [ ] cleanup ; inline
+
+<PRIVATE
+
+: (set-real-user) ( id -- )
+    setuid io-error ; inline
+
+: (set-effective-user) ( id -- )
+    seteuid io-error ; inline
+
+PRIVATE>
+
+M: string set-real-user ( string -- )
+    user-id (set-real-user) ;
+
+M: integer set-real-user ( id -- )
+    (set-real-user) ;
+
+M: integer set-effective-user ( id -- )
+    (set-effective-user) ; 
+
+M: string set-effective-user ( string -- )
+    user-id (set-effective-user) ;
+
+os {
+    { [ dup bsd? ] [ drop "unix.users.bsd" require ] }
+    { [ dup linux? ] [ drop ] }
+} cond

basis/unix/utmpx/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/utmpx/macosx/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/utmpx/macosx/macosx-tests.factor

@@ -0,0 +1,4 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test unix.utmpx.macosx ;
+IN: unix.utmpx.macosx.tests

basis/unix/utmpx/macosx/macosx.factor

@@ -0,0 +1,6 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax unix.bsd.macosx ;
+IN: unix.utmpx.macosx
+
+! empty

basis/unix/utmpx/macosx/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/utmpx/netbsd/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/utmpx/netbsd/netbsd-tests.factor

@@ -0,0 +1,4 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test unix.utmpx.netbsd ;
+IN: unix.utmpx.netbsd.tests

basis/unix/utmpx/netbsd/netbsd.factor

@@ -0,0 +1,22 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax unix.utmpx unix.bsd.netbsd accessors
+unix.utmpx system kernel unix combinators ;
+IN: unix.utmpx.netbsd
+
+TUPLE: netbsd-utmpx-record < utmpx-record termination exit
+sockaddr ;
+    
+M: netbsd new-utmpx-record ( -- utmpx-record )
+    netbsd-utmpx-record new ; 
+    
+M: netbsd utmpx>utmpx-record ( utmpx -- record )
+    [ new-utmpx-record ] keep
+    {
+        [
+            utmpx-ut_exit
+            [ exit_struct-e_termination >>termination ]
+            [ exit_struct-e_exit >>exit ] bi
+        ]
+        [ utmpx-ut_ss >>sockaddr ]
+    } cleave ;

basis/unix/utmpx/netbsd/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/utmpx/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/utmpx/utmpx.factor

@@ -0,0 +1,66 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.syntax combinators continuations
+io.encodings.string io.encodings.utf8 kernel sequences strings
+unix calendar system accessors unix.time calendar.unix
+vocabs.loader ;
+IN: unix.utmpx
+
+: EMPTY 0 ; inline
+: RUN_LVL 1 ; inline
+: BOOT_TIME 2 ; inline
+: OLD_TIME 3 ; inline
+: NEW_TIME 4 ; inline
+: INIT_PROCESS 5 ; inline
+: LOGIN_PROCESS 6 ; inline
+: USER_PROCESS 7 ; inline
+: DEAD_PROCESS 8 ; inline
+: ACCOUNTING 9 ; inline
+: SIGNATURE 10 ; inline
+: SHUTDOWN_TIME 11 ; inline
+
+FUNCTION: void setutxent ( ) ;
+FUNCTION: void endutxent ( ) ;
+FUNCTION: utmpx* getutxent ( ) ;
+FUNCTION: utmpx* getutxid ( utmpx* id ) ;
+FUNCTION: utmpx* getutxline ( utmpx* line ) ;
+FUNCTION: utmpx* pututxline ( utmpx* utx ) ;
+
+TUPLE: utmpx-record user id line pid type timestamp host ;
+
+HOOK: new-utmpx-record os ( -- utmpx-record )
+
+HOOK: utmpx>utmpx-record os ( utmpx -- utmpx-record )
+
+: memory>string ( alien n -- string )
+    memory>byte-array utf8 decode [ 0 = ] trim-right ;
+
+M: unix new-utmpx-record
+    utmpx-record new ;
+    
+M: unix utmpx>utmpx-record ( utmpx -- utmpx-record )
+    [ new-utmpx-record ] dip
+    {
+        [ utmpx-ut_user _UTX_USERSIZE memory>string >>user ]
+        [ utmpx-ut_id _UTX_IDSIZE memory>string >>id ]
+        [ utmpx-ut_line _UTX_LINESIZE memory>string >>line ]
+        [ utmpx-ut_pid >>pid ]
+        [ utmpx-ut_type >>type ]
+        [ utmpx-ut_tv timeval>unix-time >>timestamp ]
+        [ utmpx-ut_host _UTX_HOSTSIZE memory>string >>host ]
+    } cleave ;
+
+: with-utmpx ( quot -- )
+    setutxent [ endutxent ] [ ] cleanup ; inline
+
+: all-utmpx ( -- seq )
+    [
+        [ getutxent dup ]
+        [ utmpx>utmpx-record ]
+        [ drop ] produce
+    ] with-utmpx ;
+    
+os {
+    { macosx [ "unix.utmpx.macosx" require ] }
+    { netbsd [ "unix.utmpx.netbsd" require ] }
+} case

core/classes/tuple/parser/parser-tests.factor

@@ -96,3 +96,16 @@ TUPLE: syntax-test bar baz ;
 [ T{ syntax-test } ] [ T{ syntax-test } ] unit-test
 [ T{ syntax-test f { 2 3 } { 4 { 5 } } } ]
 [ T{ syntax-test { bar { 2 3 } } { baz { 4 { 5 } } } } ] unit-test
+
+! Corner case
+TUPLE: parsing-corner-case x ;
+
+[ T{ parsing-corner-case f 3 } ] [
+    {
+        "USE: classes.tuple.parser.tests"
+        "T{ parsing-corner-case"
+        "    f"
+        "    3"
+        "}"
+    } "\n" join eval
+] unit-test

core/classes/tuple/parser/parser.factor

@@ -86,6 +86,7 @@ ERROR: bad-literal-tuple ;
 
 : parse-tuple-literal ( -- tuple )
     scan-word scan {
+        { f [ unexpected-eof ] }
         { "f" [ \ } parse-until boa>tuple ] }
         { "{" [ parse-slot-values assoc>tuple ] }
         { "}" [ new ] }

unmaintained/io/io.factor

@@ -1,8 +0,0 @@
-USING: calendar io io-internals kernel math namespaces
-nonblocking-io prettyprint quotations sequences ;
-IN: libs-io
-
-: bit-set? ( m n -- ? ) [ bitand ] keep = ; 
-: set-bit ( m bit -- n ) bitor ;
-: clear-bit ( m bit -- n ) bitnot bitand ;
-

unmaintained/io/os-unix.factor

@@ -11,219 +11,6 @@ IN: libs-io
 : SEEK_END 2 ; inline
 : EEXIST 17 ; inline
 
-FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ;
-: append-mode
-    O_WRONLY O_APPEND O_CREAT bitor bitor ; foldable
-
-: open-append ( path -- fd )
-    append-mode file-mode open dup io-error
-    [ 0 SEEK_END lseek io-error ] keep ;
-
-: touch-mode
-    O_WRONLY O_APPEND O_CREAT O_EXCL bitor bitor bitor ; foldable    
-
-: open-touch ( path -- fd )
-    touch-mode file-mode open
-    [ io-error close t ]
-    [ 2drop err_no EEXIST = [ err_no io-error ] unless -1 ] recover ;
-    
-: <file-appender> ( path -- stream ) open-append <writer> ;
-
-FUNCTION: int unlink ( char* path ) ;
-: delete-file ( path -- )
-    unlink io-error ;
-
-FUNCTION: int mkdir ( char* path, mode_t mode ) ;
-
-: (create-directory) ( path mode -- )
-    mkdir io-error ;
-
-: create-directory ( path -- )
-    0 (create-directory) ;
-
-FUNCTION: int rmdir ( char* path ) ;
-
-: delete-directory ( path -- )
-    rmdir io-error ;
-
-FUNCTION: int chroot ( char* path ) ;
-FUNCTION: int chdir ( char* path ) ;
-FUNCTION: int fchdir ( int fd ) ;
-
-FUNCTION: int utimes ( char* path, timeval[2] times ) ;
-FUNCTION: int futimes ( int id, timeval[2] times ) ;
-
-TYPEDEF: longlong blkcnt_t
-TYPEDEF: int blksize_t
-TYPEDEF: int dev_t
-TYPEDEF: uint ino_t
-TYPEDEF: ushort mode_t
-TYPEDEF: ushort nlink_t
-TYPEDEF: uint uid_t
-TYPEDEF: uint gid_t
-TYPEDEF: longlong quad_t
-TYPEDEF: ulong u_long
-
-FUNCTION: int stat ( char* path, stat* sb ) ;
-
-C-STRUCT: stat
-    { "dev_t"     "dev" }       ! device inode resides on
-    { "ino_t"     "ino" }       ! inode's number
-    { "mode_t"    "mode" }      ! inode protection mode
-    { "nlink_t"   "nlink" }     ! number or hard links to the file
-    { "uid_t"     "uid" }       ! user-id of owner
-    { "gid_t"     "gid" }       ! group-id of owner
-    { "dev_t"     "rdev" }      ! device type, for special file inode
-    { "timespec"  "atime" }     ! time of last access
-    { "timespec"  "mtime" }     ! time of last data modification
-    { "timespec"  "ctime" }     ! time of last file status change
-    { "off_t"     "size" }      ! file size, in bytes
-    { "blkcnt_t"  "blocks" }    ! blocks allocated for file
-    { "blksize_t" "blksize" }   ! optimal file sys I/O ops blocksize
-    { "u_long"    "flags" }     ! user defined flags for file
-    { "u_long"    "gen" } ;     ! file generation number
-
-: stat* ( path -- byte-array )
-    "stat" <c-object> [ stat io-error ] keep ;
-
-: make-timeval-array ( array -- byte-array )
-    [ length "timeval" <c-array> ] keep
-    dup length [ over [ pick set-timeval-nth ] [ 2drop ] if ] 2each ;
-
-: (set-file-times) ( timestamp timestamp -- alien )
-    [ [ timestamp>timeval ] [ f ] if* ] 2apply 2array
-    make-timeval-array ;
-
-: set-file-times ( path timestamp timestamp -- )
-    #! set access, write
-    (set-file-times) utimes io-error ;
-
-: set-file-times* ( fd timestamp timestamp -- )
-    (set-file-times) futimes io-error ;
-
-
-: set-file-access-time ( path timestamp -- )
-    f set-file-times ;
-
-: set-file-write-time ( path timestamp -- )
-    >r f r> set-file-times ;
-
-
-: file-write-time ( path -- timestamp )
-    stat* stat-mtime timespec>timestamp ;
-
-: file-access-time ( path -- timestamp )
-    stat* stat-atime timespec>timestamp ;
-
-! File type
-: S_IFMT    OCT: 0170000 ; inline ! type of file
-: S_IFIFO   OCT: 0010000 ; inline ! named pipe (fifo)
-: S_IFCHR   OCT: 0020000 ; inline ! character special
-: S_IFDIR   OCT: 0040000 ; inline ! directory
-: S_IFBLK   OCT: 0060000 ; inline ! block special
-: S_IFREG   OCT: 0100000 ; inline ! regular
-: S_IFLNK   OCT: 0120000 ; inline ! symbolic link
-: S_IFSOCK  OCT: 0140000 ; inline ! socket
-: S_IFWHT   OCT: 0160000 ; inline ! whiteout
-: S_IFXATTR OCT: 0200000 ; inline ! extended attribute
-
-! File mode
-! Read, write, execute/search by owner
-: S_IRWXU OCT: 0000700 ; inline    ! rwx mask owner
-: S_IRUSR OCT: 0000400 ; inline    ! r owner
-: S_IWUSR OCT: 0000200 ; inline    ! w owner
-: S_IXUSR OCT: 0000100 ; inline    ! x owner
-! Read, write, execute/search by group
-: S_IRWXG OCT: 0000070 ; inline    ! rwx mask group
-: S_IRGRP OCT: 0000040 ; inline    ! r group
-: S_IWGRP OCT: 0000020 ; inline    ! w group
-: S_IXGRP OCT: 0000010 ; inline    ! x group
-! Read, write, execute/search by others
-: S_IRWXO OCT: 0000007 ; inline    ! rwx mask other
-: S_IROTH OCT: 0000004 ; inline    ! r other
-: S_IWOTH OCT: 0000002 ; inline    ! w other
-: S_IXOTH OCT: 0000001 ; inline    ! x other
-
-: S_ISUID OCT: 0004000 ; inline    ! set user id on execution
-: S_ISGID OCT: 0002000 ; inline    ! set group id on execution
-: S_ISVTX OCT: 0001000 ; inline    ! sticky bit
-
-FUNCTION: uid_t getuid ;
-FUNCTION: uid_t geteuid ;
-
-FUNCTION: gid_t getgid ;
-FUNCTION: gid_t getegid ;
-
-FUNCTION: int setuid ( uid_t uid ) ;
-FUNCTION: int seteuid ( uid_t euid ) ;
-FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ;
-
-FUNCTION: int setgid ( gid_t gid ) ;
-FUNCTION: int setegid ( gid_t egid ) ;
-FUNCTION: int setregid ( gid_t rgid, gid_t egid ) ;
-
-FUNCTION: int issetugid ;
-
-FUNCTION: int chmod ( char* path, mode_t mode ) ;
-FUNCTION: int fchmod ( int fd, mode_t mode ) ;
-
-FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
-FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ;
-#! lchown does not follow symbolic links
-FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ;
-
-FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ;
-FUNCTION: int setgroups ( int ngroups, gid_t* gidset ) ;
-
-FUNCTION: int flock ( int fd, int operation ) ;
-! FUNCTION: int dup ( int oldd ) ;
-! FUNCTION: int dup2 ( int oldd, int newd ) ;
-
-FUNCTION: int fcntl ( int fd, int cmd, int arg ) ;
-FUNCTION: int getdtablesize ;
-
-: file-mode? ( path mask -- ? )
-    >r stat* stat-mode r> bit-set? ;
-
-: user-read? ( path -- ? ) S_IRUSR file-mode? ;
-: user-write? ( path -- ? ) S_IWUSR file-mode? ;
-: user-execute? ( path -- ? ) S_IXUSR file-mode? ;
-
-: group-read? ( path -- ? ) S_IRGRP file-mode? ;
-: group-write? ( path -- ? ) S_IWGRP file-mode? ;
-: group-execute? ( path -- ? ) S_IXGRP file-mode? ;
-
-: other-read? ( path -- ? ) S_IROTH file-mode? ;
-: other-write? ( path -- ? ) S_IWOTH file-mode? ;
-: other-execute? ( path -- ? ) S_IXOTH file-mode? ;
-
-: set-uid? ( path -- ? ) S_ISUID bit-set? ;
-: set-gid? ( path -- ? ) S_ISGID bit-set? ;
-: set-sticky? ( path -- ? ) S_ISVTX bit-set? ;
-
-: chmod* ( path mask ? -- )
-    >r >r dup stat* stat-mode r> r> [
-        set-bit
-    ] [
-        clear-bit
-    ] if chmod io-error ;
-
-: set-user-read ( path ? -- ) >r S_IRUSR r> chmod* ;
-: set-user-write ( path ? -- ) >r S_IWUSR r> chmod* ;
-: set-user-execute ( path ? -- ) >r S_IXUSR r> chmod* ;
-
-: set-group-read ( path ? -- ) >r S_IRGRP r> chmod* ;
-: set-group-write ( path ? -- ) >r S_IWGRP r> chmod* ;
-: set-group-execute ( path ? -- ) >r S_IXGRP r> chmod* ;
-
-: set-other-read ( path ? -- ) >r S_IROTH r> chmod* ;
-: set-other-write ( path ? -- ) >r S_IWOTH r> chmod* ;
-: set-other-execute ( path ? -- ) >r S_IXOTH r> chmod* ;
-
-: set-uid ( path ? -- ) >r S_ISUID r> chmod* ;
-: set-gid ( path ? -- ) >r S_ISGID r> chmod* ;
-: set-sticky ( path ? -- ) >r S_ISVTX r> chmod* ;
-
 : mode>symbol ( mode -- ch )
     S_IFMT bitand
     {

vm/debug.c

@@ -325,6 +325,12 @@ void find_code_references(CELL look_for_)
 
 void factorbug(void)
 {
+	if(fep_disabled)
+	{
+		printf("Low level debugger disabled\n");
+		exit(1);
+	}
+
 	open_console();
 
 	printf("Starting low level debugger...\n");
@@ -366,6 +372,8 @@ void factorbug(void)
 				dump stacks. This is useful for builder and
 				other cases where Factor is run with stdin
 				redirected to /dev/null */
+				fep_disabled = true;
+
 				print_datastack();
 				print_retainstack();
 				print_callstack();

vm/debug.h

@@ -4,4 +4,6 @@ void dump_generations(void);
 void factorbug(void);
 void dump_zone(F_ZONE *z);
 
+bool fep_disabled;
+
 DECLARE_PRIMITIVE(die);

vm/errors.c

@@ -57,10 +57,10 @@ void throw_error(CELL error, F_STACK_FRAME *callstack_top)
 	crash. */
 	else
 	{
-		fprintf(stderr,"You have triggered a bug in Factor. Please report.\n");
+		printf("You have triggered a bug in Factor. Please report.\n");
-		fprintf(stderr,"early_error: ");
+		printf("early_error: ");
 		print_obj(error);
-		fprintf(stderr,"\n");
+		printf("\n");
 		factorbug();
 	}
 }