steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
erg 2008-05-21 16:09:47 -05:00
parent 5b0d7bb3b7 ebc860ec4b
commit 15ac39bc7b
24 changed files with 732 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/io/launcher/launcher.factor
View File

@ -147,7 +147,7 @@ M: process timeout timeout>> ;
M: process set-timeout set-process-timeout ;
M: process timed-out kill-process ;
M: process cancel-operation kill-process ;
M: object run-pipeline-element
[ >process swap >>stdout swap >>stdin run-detached ]

13
extra/io/pipes/pipes-tests.factor
View File

@ -1,6 +1,7 @@
USING: io io.pipes io.streams.string io.encodings.utf8
io.streams.duplex io.encodings io.timeouts namespaces
continuations tools.test kernel calendar destructors ;
continuations tools.test kernel calendar destructors
accessors debugger math ;
IN: io.pipes.tests
[ "Hello" ] [
@ -31,3 +32,13 @@ IN: io.pipes.tests
stream-readln
] with-disposal
] must-fail
[ ] [
1000 [
utf8 <pipe> [
[ in>> dispose ]
[ out>> "hi" over stream-write dispose ]
bi
] curry ignore-errors
] times
] unit-test

24
extra/io/ports/ports.factor
View File

@ -100,6 +100,10 @@ M: output-port stream-write
HOOK: (wait-to-write) io-backend ( port -- )
GENERIC: shutdown ( handle -- )
M: object shutdown drop ;
: port-flush ( port -- )
dup buffer>> buffer-empty?
[ drop ] [ dup (wait-to-write) port-flush ] if ;
@ -108,21 +112,23 @@ M: output-port stream-flush ( port -- )
[ check-disposed ] [ port-flush ] bi ;
M: output-port dispose*
[ port-flush ] [ call-next-method ] bi ;
[
[ handle>> &dispose drop ]
[ port-flush ]
[ handle>> shutdown ]
tri
] with-destructors ;
M: buffered-port dispose*
[ call-next-method ]
[ [ [ buffer-free ] when* f ] change-buffer drop ]
bi ;
GENERIC: cancel-io ( handle -- )
M: port cancel-operation handle>> cancel-operation ;
M: port timed-out handle>> cancel-io ;
M: port dispose* handle>> [ cancel-io ] [ dispose ] bi ;
: <ports> ( read-handle write-handle -- input-port output-port )
M: port dispose*
[
[ <input-port> |dispose ]
[ <output-port> |dispose ] bi*
[ handle>> &dispose drop ]
[ handle>> shutdown ]
bi
] with-destructors ;

6
extra/io/sockets/secure/secure.factor
View File

@ -1,9 +1,13 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel symbols namespaces continuations
destructors io.sockets sequences inspector ;
destructors io.sockets sequences inspector calendar ;
IN: io.sockets.secure
SYMBOL: secure-socket-timeout
1 minutes secure-socket-timeout set-global
SYMBOL: secure-socket-backend
SINGLETONS: SSLv2 SSLv23 SSLv3 TLSv1 ;

9
extra/io/sockets/sockets.factor
View File

@ -161,6 +161,11 @@ GENERIC: (get-remote-address) ( handle remote -- sockaddr )
: get-remote-address ( handle local -- remote )
[ (get-remote-address) ] keep parse-sockaddr ;
: <ports> ( handle -- input-port output-port )
[
[ <input-port> |dispose ] [ <output-port> |dispose ] bi
] with-destructors ;
GENERIC: establish-connection ( client-out remote -- )
GENERIC: ((client)) ( remote -- handle )
@ -173,7 +178,7 @@ M: object (client) ( remote -- client-in client-out local )
[
[ ((client)) ] keep
[
>r dup <ports> [ |dispose ] bi@ dup r>
>r <ports> [ |dispose ] bi@ dup r>
establish-connection
]
[ get-local-address ]
@ -210,7 +215,7 @@ GENERIC: (accept) ( server addrspec -- handle sockaddr )
dup addr>>
[ (accept) ] keep
parse-sockaddr swap
dup <ports>
<ports>
] keep encoding>> <encoder-duplex> swap ;
TUPLE: datagram-port < port addr ;

6
extra/io/timeouts/timeouts-docs.factor
View File

@ -9,20 +9,20 @@ HELP: set-timeout
{ $values { "dt/f" "a " { $link duration } " or " { $link f } } { "obj" object } }
{ $contract "Sets an object's timeout." } ;
HELP: timed-out
HELP: cancel-operation
{ $values { "obj" object } }
{ $contract "Handles a timeout, usually by waking up all threads waiting on the object." } ;
HELP: with-timeout
{ $values { "obj" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } }
{ $description "Applies the quotation to the object. If the object's timeout expires before the quotation returns, " { $link timed-out } " is called on the object." } ;
{ $description "Applies the quotation to the object. If the object's timeout expires before the quotation returns, " { $link cancel-operation } " is called on the object." } ;
ARTICLE: "io.timeouts" "I/O timeout protocol"
"Streams, processes and monitors support optional timeouts, which impose an upper bound on the length of time for which an operation on these objects can block. Timeouts are used in network servers to prevent malicious clients from holding onto connections forever, and to ensure that runaway processes get killed."
{ $subsection timeout }
{ $subsection set-timeout }
"The I/O timeout protocol can be implemented by any class wishing to support timeouts on blocking operations."
{ $subsection timed-out }
{ $subsection cancel-operation }
"A combinator to be used in operations which can time out:"
{ $subsection with-timeout }
{ $see-also "stream-protocol" "io.launcher" "io.monitors" } ;

15
extra/io/timeouts/timeouts.factor
View File

@ -11,17 +11,18 @@ M: decoder set-timeout stream>> set-timeout ;
M: encoder set-timeout stream>> set-timeout ;
GENERIC: timed-out ( obj -- )
GENERIC: cancel-operation ( obj -- )
: queue-timeout ( obj timeout -- alarm )
>r [ timed-out ] curry r> later ;
>r [ cancel-operation ] curry r> later ;
: with-timeout* ( obj timeout quot -- )
3dup drop queue-timeout >r nip call r> cancel-alarm ;
inline
: with-timeout ( obj quot -- )
over dup timeout dup [
queue-timeout slip cancel-alarm
] [
2drop call
] if ; inline
over timeout [ >r dup timeout r> with-timeout* ] [ call ] if ;
inline
: timeouts ( dt -- )
[ input-stream get set-timeout ]

44
extra/io/unix/backend/backend.factor
View File

@ -8,7 +8,6 @@ io.encodings.utf8 destructors accessors inspector combinators ;
QUALIFIED: io
IN: io.unix.backend
! I/O tasks
GENERIC: handle-fd ( handle -- fd )
TUPLE: fd fd disposed ;
@ -18,12 +17,15 @@ TUPLE: fd fd disposed ;
#! since on OS X 10.3, this operation fails from init-io
#! when running the Factor.app (presumably because fd 0 and
#! 1 are closed).
[ F_SETFL O_NONBLOCK fcntl drop ]
[ F_SETFD FD_CLOEXEC fcntl drop ]
[ f fd boa ]
tri ;
fd new
swap
[ F_SETFL O_NONBLOCK fcntl drop ]
[ F_SETFD FD_CLOEXEC fcntl drop ]
[ >>fd ]
tri ;
M: fd dispose* fd>> close-file ;
M: fd dispose*
[ cancel-operation ] [ fd>> close-file ] bi ;
M: fd handle-fd dup check-disposed fd>> ;
@ -62,7 +64,7 @@ GENERIC: wait-for-events ( ms mx -- )
: output-available ( fd mx -- )
remove-output-callbacks [ resume ] each ;
M: fd cancel-io ( fd -- )
M: fd cancel-operation ( fd -- )
dup disposed>> [ drop ] [
fd>>
mx get-global
@ -75,8 +77,12 @@ SYMBOL: +retry+ ! just try the operation again without blocking
SYMBOL: +input+
SYMBOL: +output+
: wait-for-fd ( handle event -- timeout? )
dup +retry+ eq? [ 2drop f ] [
ERROR: io-timeout ;
M: io-timeout summary drop "I/O operation timed out" ;
: wait-for-fd ( handle event -- )
dup +retry+ eq? [ 2drop ] [
[
>r
swap handle-fd
@ -85,30 +91,14 @@ SYMBOL: +output+
{ +input+ [ add-input-callback ] }
{ +output+ [ add-output-callback ] }
} case
] curry "I/O" suspend nip
] curry "I/O" suspend nip [ io-timeout ] when
] if ;
ERROR: io-timeout ;
M: io-timeout summary drop "I/O operation timed out" ;
: wait-for-port ( port event -- )
[
>r handle>> r> wait-for-fd
[ io-timeout ] when
] curry with-timeout ;
[ >r handle>> r> wait-for-fd ] curry with-timeout ;
! Some general stuff
: file-mode OCT: 0666 ;
: (io-error) ( -- * ) err_no strerror throw ;
: check-errno ( -- )
err_no dup zero? [ drop ] [ strerror throw ] if ;
: check-null ( n -- ) zero? [ (io-error) ] when ;
: io-error ( n -- ) 0 < [ (io-error) ] when ;
! Readers
: (refill) ( port -- n )

89
extra/io/unix/sockets/secure/secure-tests.factor
View File

@ -1,8 +1,8 @@
IN: io.sockets.secure.tests
USING: accessors kernel namespaces io io.sockets
io.sockets.secure io.encodings.ascii io.streams.duplex
classes words destructors threads tools.test
concurrency.promises byte-arrays locals ;
io.unix.backend classes words destructors threads tools.test
concurrency.promises byte-arrays locals calendar io.timeouts ;
\ <secure-config> must-infer
{ 1 0 } [ [ ] with-secure-context ] must-infer-as
@ -63,3 +63,88 @@ concurrency.promises byte-arrays locals ;
<client> drop dispose
] with-secure-context
] [ certificate-verify-error? ] must-fail-with
! Client-side handshake timeout
[ ] [ <promise> "port" set ] unit-test
[ ] [
[
"127.0.0.1" 0 <inet4> ascii <server> [
dup addr>> port>> "port" get fulfill
accept drop 1 minutes sleep dispose
] with-disposal
] "Silly server" spawn drop
] unit-test
[
1 seconds secure-socket-timeout [
client-test
] with-variable
] [ io-timeout? ] must-fail-with
! Server-side handshake timeout
[ ] [ <promise> "port" set ] unit-test
[ ] [
[
"127.0.0.1" "port" get ?promise
<inet4> ascii <client> drop 1 minutes sleep dispose
] "Silly client" spawn drop
] unit-test
[
1 seconds secure-socket-timeout [
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop dispose
] with-disposal
] with-test-context
] with-variable
] [ io-timeout? ] must-fail-with
! Client socket shutdown timeout
[ ] [ <promise> "port" set ] unit-test
[ ] [
[
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop 1 minutes sleep dispose
] with-disposal
] with-test-context
] "Silly server" spawn drop
] unit-test
[
1 seconds secure-socket-timeout [
<secure-config> [
"127.0.0.1" "port" get ?promise <inet4> <secure>
ascii <client> drop dispose
] with-secure-context
] with-variable
] [ io-timeout? ] must-fail-with
! Server socket shutdown timeout
[ ] [ <promise> "port" set ] unit-test
[ ] [
[
[
"127.0.0.1" "port" get ?promise
<inet4> <secure> ascii <client> drop 1 minutes sleep dispose
] with-test-context
] "Silly client" spawn drop
] unit-test
[
1 seconds secure-socket-timeout [
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop dispose
] with-disposal
] with-test-context
] with-variable
] [ io-timeout? ] must-fail-with

48
extra/io/unix/sockets/secure/secure.factor
View File

@ -1,12 +1,12 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays kernel debugger sequences namespaces math
USING: accessors unix byte-arrays kernel debugger sequences namespaces math
math.order combinators init alien alien.c-types alien.strings libc
continuations destructors
openssl openssl.libcrypto openssl.libssl
io.files io.ports io.unix.backend io.unix.sockets
io.encodings.ascii io.buffers io.sockets io.sockets.secure
unix system inspector ;
io.timeouts system inspector ;
IN: io.unix.sockets.secure
M: ssl-handle handle-fd file>> handle-fd ;
@ -15,7 +15,7 @@ M: ssl-handle handle-fd file>> handle-fd ;
ERR_get_error dup zero? [
drop
{
{ -1 [ (io-error) ] }
{ -1 [ err_no ECONNRESET = [ premature-close ] [ (io-error) ] if ] }
{ 0 [ premature-close ] }
} case
] [
@ -64,8 +64,11 @@ M: ssl-handle drain
SSL_write
check-write-response ;
M: ssl-handle cancel-io
file>> cancel-io ;
M: ssl-handle cancel-operation
file>> cancel-operation ;
M: ssl-handle timeout
drop secure-socket-timeout get ;
! Client sockets
: <ssl-socket> ( fd -- ssl )
@ -79,8 +82,8 @@ M: secure parse-sockaddr addrspec>> parse-sockaddr <secure> ;
M: secure (get-local-address) addrspec>> (get-local-address) ;
: check-connect-response ( port r -- event )
check-response
: check-connect-response ( ssl-handle r -- event )
over handle>> over SSL_get_error
{
{ SSL_ERROR_NONE [ 2drop f ] }
{ SSL_ERROR_WANT_READ [ 2drop +input+ ] }
@ -89,16 +92,18 @@ M: secure (get-local-address) addrspec>> (get-local-address) ;
{ SSL_ERROR_SSL [ (ssl-error) ] }
} case ;
: do-ssl-connect ( port -- )
dup dup handle>> handle>> SSL_connect
check-connect-response dup
[ dupd wait-for-port do-ssl-connect ] [ 2drop ] if ;
: do-ssl-connect ( ssl-handle -- )
dup dup handle>> SSL_connect check-connect-response dup
[ dupd wait-for-fd do-ssl-connect ] [ 2drop ] if ;
M: secure establish-connection ( client-out remote -- )
[ addrspec>> establish-connection ]
[ drop do-ssl-connect ]
[ drop handle>> t >>connected drop ]
2tri ;
[
drop handle>>
[ [ do-ssl-connect ] with-timeout ]
[ t >>connected drop ]
bi
] 2bi ;
M: secure (server) addrspec>> (server) ;
@ -114,13 +119,13 @@ M: secure (server) addrspec>> (server) ;
: do-ssl-accept ( ssl-handle -- )
dup dup handle>> SSL_accept check-accept-response dup
[ >r dup file>> r> wait-for-fd drop do-ssl-accept ] [ 2drop ] if ;
[ >r dup file>> r> wait-for-fd do-ssl-accept ] [ 2drop ] if ;
M: secure (accept)
[
addrspec>> (accept) >r
|dispose <ssl-socket> t >>connected |dispose
dup do-ssl-accept r>
dup [ do-ssl-accept ] with-timeout r>
] with-destructors ;
: check-shutdown-response ( handle r -- event )
@ -130,7 +135,7 @@ M: secure (accept)
{ 0 [
dup handle>> dup f 0 SSL_read 2dup SSL_get_error
{
{ SSL_ERROR_ZERO_RETURN [ 2drop dup handle>> SSL_shutdown check-shutdown-response ] }
{ SSL_ERROR_ZERO_RETURN [ 3drop +retry+ ] }
{ SSL_ERROR_WANT_READ [ 3drop +input+ ] }
{ SSL_ERROR_WANT_WRITE [ 3drop +output+ ] }
{ SSL_ERROR_SYSCALL [ syscall-error ] }
@ -148,8 +153,11 @@ M: secure (accept)
] }
} case ;
M: unix ssl-shutdown
: (shutdown) ( handle -- )
dup dup handle>> SSL_shutdown check-shutdown-response
dup [ dupd wait-for-fd (shutdown) ] [ 2drop ] if ;
M: ssl-handle shutdown
dup connected>> [
dup dup handle>> SSL_shutdown check-shutdown-response
dup [ dupd wait-for-fd drop ssl-shutdown ] [ 2drop ] if
f >>connected [ (shutdown) ] with-timeout
] [ drop ] if ;

2
extra/io/windows/nt/backend/backend.factor
View File

@ -71,7 +71,7 @@ M: winnt add-completion ( win32-handle -- )
resume-callback t
] if ;
M: win32-handle cancel-io
M: win32-handle cancel-operation
handle>> CancelIo drop ;
M: winnt io-multiplex ( ms -- )

3
extra/io/windows/windows.factor
View File

@ -24,6 +24,9 @@ TUPLE: win32-file < win32-handle ptr ;
: <win32-file> ( handle -- win32-file )
win32-file new-win32-handle ;
M: win32-file dispose*
[ cancel-operation ] [ call-next-method ] bi ;
HOOK: CreateFile-flags io-backend ( DWORD -- DWORD )
HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
HOOK: add-completion io-backend ( port -- )

11
extra/openssl/libcrypto/libcrypto.factor
View File

@ -10,11 +10,12 @@ USING: alien alien.syntax combinators kernel system ;
IN: openssl.libcrypto
<<
"libcrypto" {
{ [ os winnt? ] [ "libeay32.dll" "cdecl" ] }
{ [ os macosx? ] [ "libcrypto.dylib" "cdecl" ] }
{ [ os unix? ] [ "libcrypto.so" "cdecl" ] }
} cond add-library
{
{ [ os openbsd? ] [ ] } ! VM is linked with it
{ [ os winnt? ] [ "libcrypto" "libeay32.dll" "cdecl" add-library ] }
{ [ os macosx? ] [ "libcrypto" "libcrypto.dylib" "cdecl" add-library ] }
{ [ os unix? ] [ "libcrypto" "libcrypto.so" "cdecl" add-library ] }
} cond
>>
C-STRUCT: bio-method

11
extra/openssl/libssl/libssl.factor
View File

@ -10,11 +10,12 @@ assocs parser sequences words quotations ;
IN: openssl.libssl
<< "libssl" {
{ [ os winnt? ] [ "ssleay32.dll" "cdecl" ] }
{ [ os macosx? ] [ "libssl.dylib" "cdecl" ] }
{ [ os unix? ] [ "libssl.so" "cdecl" ] }
} cond add-library >>
<< {
{ [ os openbsd? ] [ ] } ! VM is linked with it
{ [ os winnt? ] [ "libssl" "ssleay32.dll" "cdecl" add-library ] }
{ [ os macosx? ] [ "libssl" "libssl.dylib" "cdecl" add-library ] }
{ [ os unix? ] [ "libssl" "libssl.so" "cdecl" add-library ] }
} cond >>
: X509_FILETYPE_PEM 1 ; inline
: X509_FILETYPE_ASN1 2 ; inline

27
extra/openssl/openssl.factor
View File

@ -5,7 +5,8 @@ math.order combinators init alien alien.c-types alien.strings libc
continuations destructors debugger inspector
locals unicode.case
openssl.libcrypto openssl.libssl
io.backend io.ports io.files io.encodings.8-bit io.sockets.secure ;
io.backend io.ports io.files io.encodings.8-bit io.sockets.secure
io.timeouts ;
IN: openssl
! This code is based on http://www.rtfm.com/openssl-examples/
@ -158,20 +159,26 @@ ERROR: no-secure-context ;
M: no-secure-context summary
drop "Secure socket operations must be wrapped in calls to with-secure-context" ;
: current-ssl-context ( -- ctx )
secure-context get [ no-secure-context ] unless* ;
SYMBOL: default-secure-context
: context-expired? ( context -- ? )
dup [ handle>> expired? ] [ drop t ] if ;
: current-secure-context ( -- ctx )
secure-context get [
default-secure-context get dup context-expired? [
drop
<secure-config> <secure-context> default-secure-context set-global
current-secure-context
] when
] unless* ;
: <ssl-handle> ( fd -- ssl )
current-ssl-context handle>> SSL_new dup ssl-error
current-secure-context handle>> SSL_new dup ssl-error
f f ssl-handle boa ;
HOOK: ssl-shutdown io-backend ( handle -- )
M: ssl-handle dispose*
[ ssl-shutdown ]
[ handle>> SSL_free ]
[ file>> dispose ]
tri ;
[ handle>> SSL_free ] [ file>> dispose ] bi ;
: check-verify-result ( ssl-handle -- )
SSL_get_verify_result dup X509_V_OK =

5
extra/ui/gadgets/panes/panes.factor
View File

@ -9,7 +9,7 @@ quotations math opengl combinators math.vectors
sorting splitting io.streams.nested assocs
ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids
ui.gadgets.grid-lines classes.tuple models continuations
destructors ;
destructors accessors ;
IN: ui.gadgets.panes
TUPLE: pane output current prototype scrolls?
@ -114,6 +114,9 @@ GENERIC: write-gadget ( gadget stream -- )
M: pane-stream write-gadget
pane-stream-pane pane-current add-gadget ;
M: style-stream write-gadget
stream>> write-gadget ;
: print-gadget ( gadget stream -- )
tuck write-gadget stream-nl ;

4
extra/unix/bsd/bsd.factor
View File

@ -48,10 +48,6 @@ C-STRUCT: sockaddr-un
: max-un-path 104 ; inline
: EINTR HEX: 4 ; inline
: EAGAIN HEX: 23 ; inline
: EINPROGRESS HEX: 24 ; inline
: SOCK_STREAM 1 ; inline
: SOCK_DGRAM 2 ; inline

95
extra/unix/bsd/freebsd/freebsd.factor
View File

@ -12,3 +12,98 @@ C-STRUCT: addrinfo
{ "char*" "canonname" }
{ "void*" "addr" }
{ "addrinfo*" "next" } ;
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline
: EINTR 4 ; inline
: EIO 5 ; inline
: ENXIO 6 ; inline
: E2BIG 7 ; inline
: ENOEXEC 8 ; inline
: EBADF 9 ; inline
: ECHILD 10 ; inline
: EDEADLK 11 ; inline
: ENOMEM 12 ; inline
: EACCES 13 ; inline
: EFAULT 14 ; inline
: ENOTBLK 15 ; inline
: EBUSY 16 ; inline
: EEXIST 17 ; inline
: EXDEV 18 ; inline
: ENODEV 19 ; inline
: ENOTDIR 20 ; inline
: EISDIR 21 ; inline
: EINVAL 22 ; inline
: ENFILE 23 ; inline
: EMFILE 24 ; inline
: ENOTTY 25 ; inline
: ETXTBSY 26 ; inline
: EFBIG 27 ; inline
: ENOSPC 28 ; inline
: ESPIPE 29 ; inline
: EROFS 30 ; inline
: EMLINK 31 ; inline
: EPIPE 32 ; inline
: EDOM 33 ; inline
: ERANGE 34 ; inline
: EAGAIN 35 ; inline
: EWOULDBLOCK EAGAIN ; inline
: EINPROGRESS 36 ; inline
: EALREADY 37 ; inline
: ENOTSOCK 38 ; inline
: EDESTADDRREQ 39 ; inline
: EMSGSIZE 40 ; inline
: EPROTOTYPE 41 ; inline
: ENOPROTOOPT 42 ; inline
: EPROTONOSUPPORT 43 ; inline
: ESOCKTNOSUPPORT 44 ; inline
: EOPNOTSUPP 45 ; inline
: ENOTSUP EOPNOTSUPP ; inline
: EPFNOSUPPORT 46 ; inline
: EAFNOSUPPORT 47 ; inline
: EADDRINUSE 48 ; inline
: EADDRNOTAVAIL 49 ; inline
: ENETDOWN 50 ; inline
: ENETUNREACH 51 ; inline
: ENETRESET 52 ; inline
: ECONNABORTED 53 ; inline
: ECONNRESET 54 ; inline
: ENOBUFS 55 ; inline
: EISCONN 56 ; inline
: ENOTCONN 57 ; inline
: ESHUTDOWN 58 ; inline
: ETOOMANYREFS 59 ; inline
: ETIMEDOUT 60 ; inline
: ECONNREFUSED 61 ; inline
: ELOOP 62 ; inline
: ENAMETOOLONG 63 ; inline
: EHOSTDOWN 64 ; inline
: EHOSTUNREACH 65 ; inline
: ENOTEMPTY 66 ; inline
: EPROCLIM 67 ; inline
: EUSERS 68 ; inline
: EDQUOT 69 ; inline
: ESTALE 70 ; inline
: EREMOTE 71 ; inline
: EBADRPC 72 ; inline
: ERPCMISMATCH 73 ; inline
: EPROGUNAVAIL 74 ; inline
: EPROGMISMATCH 75 ; inline
: EPROCUNAVAIL 76 ; inline
: ENOLCK 77 ; inline
: ENOSYS 78 ; inline
: EFTYPE 79 ; inline
: EAUTH 80 ; inline
: ENEEDAUTH 81 ; inline
: EIDRM 82 ; inline
: ENOMSG 83 ; inline
: EOVERFLOW 84 ; inline
: ECANCELED 85 ; inline
: EILSEQ 86 ; inline
: ENOATTR 87 ; inline
: EDOOFUS 88 ; inline
: EBADMSG 89 ; inline
: EMULTIHOP 90 ; inline
: ENOLINK 91 ; inline
: EPROTO 92 ; inline

105
extra/unix/bsd/macosx/macosx.factor
View File

@ -25,3 +25,108 @@ C-STRUCT: passwd
{ "char*" "pw_shell" }
{ "time_t" "pw_expire" }
{ "int" "pw_fields" } ;
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline
: EINTR 4 ; inline
: EIO 5 ; inline
: ENXIO 6 ; inline
: E2BIG 7 ; inline
: ENOEXEC 8 ; inline
: EBADF 9 ; inline
: ECHILD 10 ; inline
: EDEADLK 11 ; inline
: ENOMEM 12 ; inline
: EACCES 13 ; inline
: EFAULT 14 ; inline
: ENOTBLK 15 ; inline
: EBUSY 16 ; inline
: EEXIST 17 ; inline
: EXDEV 18 ; inline
: ENODEV 19 ; inline
: ENOTDIR 20 ; inline
: EISDIR 21 ; inline
: EINVAL 22 ; inline
: ENFILE 23 ; inline
: EMFILE 24 ; inline
: ENOTTY 25 ; inline
: ETXTBSY 26 ; inline
: EFBIG 27 ; inline
: ENOSPC 28 ; inline
: ESPIPE 29 ; inline
: EROFS 30 ; inline
: EMLINK 31 ; inline
: EPIPE 32 ; inline
: EDOM 33 ; inline
: ERANGE 34 ; inline
: EAGAIN 35 ; inline
: EWOULDBLOCK EAGAIN ; inline
: EINPROGRESS 36 ; inline
: EALREADY 37 ; inline
: ENOTSOCK 38 ; inline
: EDESTADDRREQ 39 ; inline
: EMSGSIZE 40 ; inline
: EPROTOTYPE 41 ; inline
: ENOPROTOOPT 42 ; inline
: EPROTONOSUPPORT 43 ; inline
: ESOCKTNOSUPPORT 44 ; inline
: ENOTSUP 45 ; inline
: EPFNOSUPPORT 46 ; inline
: EAFNOSUPPORT 47 ; inline
: EADDRINUSE 48 ; inline
: EADDRNOTAVAIL 49 ; inline
: ENETDOWN 50 ; inline
: ENETUNREACH 51 ; inline
: ENETRESET 52 ; inline
: ECONNABORTED 53 ; inline
: ECONNRESET 54 ; inline
: ENOBUFS 55 ; inline
: EISCONN 56 ; inline
: ENOTCONN 57 ; inline
: ESHUTDOWN 58 ; inline
: ETOOMANYREFS 59 ; inline
: ETIMEDOUT 60 ; inline
: ECONNREFUSED 61 ; inline
: ELOOP 62 ; inline
: ENAMETOOLONG 63 ; inline
: EHOSTDOWN 64 ; inline
: EHOSTUNREACH 65 ; inline
: ENOTEMPTY 66 ; inline
: EPROCLIM 67 ; inline
: EUSERS 68 ; inline
: EDQUOT 69 ; inline
: ESTALE 70 ; inline
: EREMOTE 71 ; inline
: EBADRPC 72 ; inline
: ERPCMISMATCH 73 ; inline
: EPROGUNAVAIL 74 ; inline
: EPROGMISMATCH 75 ; inline
: EPROCUNAVAIL 76 ; inline
: ENOLCK 77 ; inline
: ENOSYS 78 ; inline
: EFTYPE 79 ; inline
: EAUTH 80 ; inline
: ENEEDAUTH 81 ; inline
: EPWROFF 82 ; inline
: EDEVERR 83 ; inline
: EOVERFLOW 84 ; inline
: EBADEXEC 85 ; inline
: EBADARCH 86 ; inline
: ESHLIBVERS 87 ; inline
: EBADMACHO 88 ; inline
: ECANCELED 89 ; inline
: EIDRM 90 ; inline
: ENOMSG 91 ; inline
: EILSEQ 92 ; inline
: ENOATTR 93 ; inline
: EBADMSG 94 ; inline
: EMULTIHOP 95 ; inline
: ENODATA 96 ; inline
: ENOLINK 97 ; inline
: ENOSR 98 ; inline
: ENOSTR 99 ; inline
: EPROTO 100 ; inline
: ETIME 101 ; inline
: EOPNOTSUPP 102 ; inline
: ENOPOLICY 103 ; inline

99
extra/unix/bsd/netbsd/netbsd.factor
View File

@ -12,3 +12,102 @@ C-STRUCT: addrinfo
{ "char*" "canonname" }
{ "void*" "addr" }
{ "addrinfo*" "next" } ;
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline
: EINTR 4 ; inline
: EIO 5 ; inline
: ENXIO 6 ; inline
: E2BIG 7 ; inline
: ENOEXEC 8 ; inline
: EBADF 9 ; inline
: ECHILD 10 ; inline
: EDEADLK 11 ; inline
: ENOMEM 12 ; inline
: EACCES 13 ; inline
: EFAULT 14 ; inline
: ENOTBLK 15 ; inline
: EBUSY 16 ; inline
: EEXIST 17 ; inline
: EXDEV 18 ; inline
: ENODEV 19 ; inline
: ENOTDIR 20 ; inline
: EISDIR 21 ; inline
: EINVAL 22 ; inline
: ENFILE 23 ; inline
: EMFILE 24 ; inline
: ENOTTY 25 ; inline
: ETXTBSY 26 ; inline
: EFBIG 27 ; inline
: ENOSPC 28 ; inline
: ESPIPE 29 ; inline
: EROFS 30 ; inline
: EMLINK 31 ; inline
: EPIPE 32 ; inline
: EDOM 33 ; inline
: ERANGE 34 ; inline
: EAGAIN 35 ; inline
: EWOULDBLOCK EAGAIN ; inline
: EINPROGRESS 36 ; inline
: EALREADY 37 ; inline
: ENOTSOCK 38 ; inline
: EDESTADDRREQ 39 ; inline
: EMSGSIZE 40 ; inline
: EPROTOTYPE 41 ; inline
: ENOPROTOOPT 42 ; inline
: EPROTONOSUPPORT 43 ; inline
: ESOCKTNOSUPPORT 44 ; inline
: EOPNOTSUPP 45 ; inline
: EPFNOSUPPORT 46 ; inline
: EAFNOSUPPORT 47 ; inline
: EADDRINUSE 48 ; inline
: EADDRNOTAVAIL 49 ; inline
: ENETDOWN 50 ; inline
: ENETUNREACH 51 ; inline
: ENETRESET 52 ; inline
: ECONNABORTED 53 ; inline
: ECONNRESET 54 ; inline
: ENOBUFS 55 ; inline
: EISCONN 56 ; inline
: ENOTCONN 57 ; inline
: ESHUTDOWN 58 ; inline
: ETOOMANYREFS 59 ; inline
: ETIMEDOUT 60 ; inline
: ECONNREFUSED 61 ; inline
: ELOOP 62 ; inline
: ENAMETOOLONG 63 ; inline
: EHOSTDOWN 64 ; inline
: EHOSTUNREACH 65 ; inline
: ENOTEMPTY 66 ; inline
: EPROCLIM 67 ; inline
: EUSERS 68 ; inline
: EDQUOT 69 ; inline
: ESTALE 70 ; inline
: EREMOTE 71 ; inline
: EBADRPC 72 ; inline
: ERPCMISMATCH 73 ; inline
: EPROGUNAVAIL 74 ; inline
: EPROGMISMATCH 75 ; inline
: EPROCUNAVAIL 76 ; inline
: ENOLCK 77 ; inline
: ENOSYS 78 ; inline
: EFTYPE 79 ; inline
: EAUTH 80 ; inline
: ENEEDAUTH 81 ; inline
: EIDRM 82 ; inline
: ENOMSG 83 ; inline
: EOVERFLOW 84 ; inline
: EILSEQ 85 ; inline
: ENOTSUP 86 ; inline
: ECANCELED 87 ; inline
: EBADMSG 88 ; inline
: ENODATA 89 ; inline
: ENOSR 90 ; inline
: ENOSTR 91 ; inline
: ETIME 92 ; inline
: ENOATTR 93 ; inline
: EMULTIHOP 94 ; inline
: ENOLINK 95 ; inline
: EPROTO 96 ; inline
: ELAST 96 ; inline

90
extra/unix/bsd/openbsd/openbsd.factor
View File

@ -12,3 +12,93 @@ C-STRUCT: addrinfo
{ "void*" "addr" }
{ "char*" "canonname" }
{ "addrinfo*" "next" } ;
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline
: EINTR 4 ; inline
: EIO 5 ; inline
: ENXIO 6 ; inline
: E2BIG 7 ; inline
: ENOEXEC 8 ; inline
: EBADF 9 ; inline
: ECHILD 10 ; inline
: EDEADLK 11 ; inline
: ENOMEM 12 ; inline
: EACCES 13 ; inline
: EFAULT 14 ; inline
: ENOTBLK 15 ; inline
: EBUSY 16 ; inline
: EEXIST 17 ; inline
: EXDEV 18 ; inline
: ENODEV 19 ; inline
: ENOTDIR 20 ; inline
: EISDIR 21 ; inline
: EINVAL 22 ; inline
: ENFILE 23 ; inline
: EMFILE 24 ; inline
: ENOTTY 25 ; inline
: ETXTBSY 26 ; inline
: EFBIG 27 ; inline
: ENOSPC 28 ; inline
: ESPIPE 29 ; inline
: EROFS 30 ; inline
: EMLINK 31 ; inline
: EPIPE 32 ; inline
: EDOM 33 ; inline
: ERANGE 34 ; inline
: EAGAIN 35 ; inline
: EWOULDBLOCK EAGAIN ; inline
: EINPROGRESS 36 ; inline
: EALREADY 37 ; inline
: ENOTSOCK 38 ; inline
: EDESTADDRREQ 39 ; inline
: EMSGSIZE 40 ; inline
: EPROTOTYPE 41 ; inline
: ENOPROTOOPT 42 ; inline
: EPROTONOSUPPORT 43 ; inline
: ESOCKTNOSUPPORT 44 ; inline
: EOPNOTSUPP 45 ; inline
: EPFNOSUPPORT 46 ; inline
: EAFNOSUPPORT 47 ; inline
: EADDRINUSE 48 ; inline
: EADDRNOTAVAIL 49 ; inline
: ENETDOWN 50 ; inline
: ENETUNREACH 51 ; inline
: ENETRESET 52 ; inline
: ECONNABORTED 53 ; inline
: ECONNRESET 54 ; inline
: ENOBUFS 55 ; inline
: EISCONN 56 ; inline
: ENOTCONN 57 ; inline
: ESHUTDOWN 58 ; inline
: ETOOMANYREFS 59 ; inline
: ETIMEDOUT 60 ; inline
: ECONNREFUSED 61 ; inline
: ELOOP 62 ; inline
: ENAMETOOLONG 63 ; inline
: EHOSTDOWN 64 ; inline
: EHOSTUNREACH 65 ; inline
: ENOTEMPTY 66 ; inline
: EPROCLIM 67 ; inline
: EUSERS 68 ; inline
: EDQUOT 69 ; inline
: ESTALE 70 ; inline
: EREMOTE 71 ; inline
: EBADRPC 72 ; inline
: ERPCMISMATCH 73 ; inline
: EPROGUNAVAIL 74 ; inline
: EPROGMISMATCH 75 ; inline
: EPROCUNAVAIL 76 ; inline
: ENOLCK 77 ; inline
: ENOSYS 78 ; inline
: EFTYPE 79 ; inline
: EAUTH 80 ; inline
: ENEEDAUTH 81 ; inline
: EIPSEC 82 ; inline
: ENOATTR 83 ; inline
: EILSEQ 84 ; inline
: ENOMEDIUM 85 ; inline
: EMEDIUMTYPE 86 ; inline
: EOVERFLOW 87 ; inline
: ECANCELED 88 ; inline

102
extra/unix/linux/linux.factor
View File

@ -59,10 +59,6 @@ C-STRUCT: sockaddr-un
{ "ushort" "family" }
{ { "char" max-un-path } "path" } ;
: EINTR HEX: 4 ; inline
: EAGAIN HEX: b ; inline
: EINPROGRESS HEX: 73 ; inline
: SOCK_STREAM 1 ; inline
: SOCK_DGRAM 2 ; inline
@ -93,3 +89,101 @@ C-STRUCT: passwd
{ "char*" "pw_gecos" }
{ "char*" "pw_dir" }
{ "char*" "pw_shell" } ;
: EDEADLK 35 ; inline
: ENAMETOOLONG 36 ; inline
: ENOLCK 37 ; inline
: ENOSYS 38 ; inline
: ENOTEMPTY 39 ; inline
: ELOOP 40 ; inline
: EWOULDBLOCK EAGAIN ; inline
: ENOMSG 42 ; inline
: EIDRM 43 ; inline
: ECHRNG 44 ; inline
: EL2NSYNC 45 ; inline
: EL3HLT 46 ; inline
: EL3RST 47 ; inline
: ELNRNG 48 ; inline
: EUNATCH 49 ; inline
: ENOCSI 50 ; inline
: EL2HLT 51 ; inline
: EBADE 52 ; inline
: EBADR 53 ; inline
: EXFULL 54 ; inline
: ENOANO 55 ; inline
: EBADRQC 56 ; inline
: EBADSLT 57 ; inline
: EDEADLOCK EDEADLK ; inline
: EBFONT 59 ; inline
: ENOSTR 60 ; inline
: ENODATA 61 ; inline
: ETIME 62 ; inline
: ENOSR 63 ; inline
: ENONET 64 ; inline
: ENOPKG 65 ; inline
: EREMOTE 66 ; inline
: ENOLINK 67 ; inline
: EADV 68 ; inline
: ESRMNT 69 ; inline
: ECOMM 70 ; inline
: EPROTO 71 ; inline
: EMULTIHOP 72 ; inline
: EDOTDOT 73 ; inline
: EBADMSG 74 ; inline
: EOVERFLOW 75 ; inline
: ENOTUNIQ 76 ; inline
: EBADFD 77 ; inline
: EREMCHG 78 ; inline
: ELIBACC 79 ; inline
: ELIBBAD 80 ; inline
: ELIBSCN 81 ; inline
: ELIBMAX 82 ; inline
: ELIBEXEC 83 ; inline
: EILSEQ 84 ; inline
: ERESTART 85 ; inline
: ESTRPIPE 86 ; inline
: EUSERS 87 ; inline
: ENOTSOCK 88 ; inline
: EDESTADDRREQ 89 ; inline
: EMSGSIZE 90 ; inline
: EPROTOTYPE 91 ; inline
: ENOPROTOOPT 92 ; inline
: EPROTONOSUPPORT 93 ; inline
: ESOCKTNOSUPPORT 94 ; inline
: EOPNOTSUPP 95 ; inline
: EPFNOSUPPORT 96 ; inline
: EAFNOSUPPORT 97 ; inline
: EADDRINUSE 98 ; inline
: EADDRNOTAVAIL 99 ; inline
: ENETDOWN 100 ; inline
: ENETUNREACH 101 ; inline
: ENETRESET 102 ; inline
: ECONNABORTED 103 ; inline
: ECONNRESET 104 ; inline
: ENOBUFS 105 ; inline
: EISCONN 106 ; inline
: ENOTCONN 107 ; inline
: ESHUTDOWN 108 ; inline
: ETOOMANYREFS 109 ; inline
: ETIMEDOUT 110 ; inline
: ECONNREFUSED 111 ; inline
: EHOSTDOWN 112 ; inline
: EHOSTUNREACH 113 ; inline
: EALREADY 114 ; inline
: EINPROGRESS 115 ; inline
: ESTALE 116 ; inline
: EUCLEAN 117 ; inline
: ENOTNAM 118 ; inline
: ENAVAIL 119 ; inline
: EISNAM 120 ; inline
: EREMOTEIO 121 ; inline
: EDQUOT 122 ; inline
: ENOMEDIUM 123 ; inline
: EMEDIUMTYPE 124 ; inline
: ECANCELED 125 ; inline
: ENOKEY 126 ; inline
: EKEYEXPIRED 127 ; inline
: EKEYREVOKED 128 ; inline
: EKEYREJECTED 129 ; inline
: EOWNERDEAD 130 ; inline
: ENOTRECOVERABLE 131 ; inline

31
extra/unix/unix.factor
View File

@ -5,7 +5,7 @@ USING: alien alien.c-types alien.syntax kernel libc structs sequences
continuations byte-arrays strings
math namespaces system combinators vocabs.loader qualified
accessors inference macros locals shuffle arrays.lib
unix.types ;
unix.types debugger io prettyprint ;
IN: unix
@ -23,9 +23,6 @@ TYPEDEF: uint socklen_t
: MAP_FAILED -1 <alien> ; inline
: ESRCH 3 ; inline
: EEXIST 17 ; inline
: NGROUPS_MAX 16 ; inline
C-STRUCT: group
@ -41,10 +38,30 @@ FUNCTION: int err_no ( ) ;
LIBRARY: libc
ERROR: unix-system-call-error args message word ;
FUNCTION: char* strerror ( int errno ) ;
ERROR: unix-error errno message ;
M: unix-error error.
"Unix system call failed:" print
nl
dup message>> write " (" write errno>> pprint ")" print ;
: (io-error) ( -- * ) err_no dup strerror unix-error ;
: io-error ( n -- ) 0 < [ (io-error) ] when ;
ERROR: unix-system-call-error args errno message word ;
M: unix-system-call-error error.
"Unix system call ``" write dup word>> pprint "'' failed:" print
nl
dup message>> write " (" write dup errno>> pprint ")" print
nl
"It was called with the following arguments:" print
nl
args>> stack. ;
MACRO:: unix-system-call ( quot -- )
[let | n [ quot infer in>> ]
word [ quot first ] |
@ -52,7 +69,7 @@ MACRO:: unix-system-call ( quot -- )
n ndup quot call dup 0 < [
drop
n narray
err_no strerror
err_no dup strerror
word unix-system-call-error
] [
n nnip

2
vm/Config.openbsd
View File

@ -2,4 +2,4 @@ include vm/Config.unix
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o
CC = egcc
CFLAGS += -export-dynamic
LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz
LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto