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

Unix FFI I/O tested and known to work in single-threaded case

cvs
Slava Pestov 2005-04-16 02:28:37 +00:00
parent e1a6166079
commit 427c1ba898
5 changed files with 141 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
TODO.FACTOR.txt
View File

@ -8,6 +8,7 @@
- powerpc has weird callstack residue
- make-vector and make-string should not need a reverse step
- console with presentations
+ plugin:
- extract word: if selection empty, move caret to new word after
@ -26,7 +27,6 @@
+ ffi:
- replace alien-address, local-alien? primitives with colon defs
- auto-generate box/unbox, and alien accessors
- box/unbox_signed/unsigned_8
- ffi unicode strings: null char security hole
@ -40,6 +40,7 @@
+ compiler:
- alien primitives need a more general input type
- linux? bsd? words
- [ [ dup call ] dup call ] infer hangs
- more accurate types for various words
@ -63,9 +64,9 @@
index? subseq?
- index and index* are very slow with lists
- list map, subset, project, append: not tail recursive
- non-consing sequence=
- tuple =
- decide what to do with sbuf-append and index-of
- : , sequence get push ; : % sequence get nappend ;
- phase out sbuf-append
- decide what to do with index-of
- GENERIC: map
- list impl same as now
- sequence impl: clone sequence and call nmap

10
library/io/stream-impl.factor
View File

@ -67,16 +67,6 @@ M: fd-stream stream-close ( stream -- )
#! Open a file path relative to the Factor source code root.
resource-path swap path+ <file-reader> ;
! Think '/dev/null'.
TUPLE: null-stream ;
M: null-stream stream-flush drop ;
M: null-stream stream-auto-flush drop ;
M: null-stream stream-read 2drop f ;
M: null-stream stream-readln drop f ;
M: null-stream stream-write-attr 3drop ;
M: null-stream stream-close drop ;
: init-stdio ( -- )
#! Opens file descriptors 0, 1.
stdin stdout <fd-stream> <stdio-stream> stdio set ;

21
library/io/stream.factor
View File

@ -5,6 +5,7 @@ DEFER: stdio
IN: streams
USING: errors generic kernel lists math namespaces strings ;
! Stream protocol.
GENERIC: stream-flush ( stream -- )
GENERIC: stream-auto-flush ( stream -- )
GENERIC: stream-readln ( stream -- string )
@ -24,6 +25,15 @@ GENERIC: stream-close ( stream -- )
[ "\n" swap stream-write ] keep
stream-auto-flush ;
! Think '/dev/null'.
TUPLE: null-stream ;
M: null-stream stream-flush drop ;
M: null-stream stream-auto-flush drop ;
M: null-stream stream-readln drop f ;
M: null-stream stream-read 2drop f ;
M: null-stream stream-write-attr 3drop ;
M: null-stream stream-close drop ;
! A stream that builds a string of all text written to it.
TUPLE: string-output buf ;
@ -54,6 +64,17 @@ C: wrapper-stream ( stream -- stream )
set-wrapper-stream-scope
] keep ;
! Combine an input and output stream into one, and flush the
! stream more often.
TUPLE: talk-stream in out ;
M: talk-stream stream-flush talk-stream-out stream-flush ;
M: talk-stream stream-auto-flush talk-stream-out stream-flush ;
M: talk-stream stream-readln talk-stream-in stream-readln ;
M: talk-stream stream-read talk-stream-in stream-read ;
M: talk-stream stream-write-attr talk-stream-out stream-write-attr ;
M: talk-stream stream-close talk-stream-out stream-close ;
! Reading lines and counting line numbers.
SYMBOL: line-number
SYMBOL: parser-stream

94
library/unix/io.factor
View File

@ -37,6 +37,9 @@ C: port ( handle buffer -- port )
: pending-error ( reader -- ) port-error throw ;
: postpone-error ( reader -- )
errno strerror swap set-port-error ;
! Associates a port with a list of continuations waiting on the
! port to finish I/O
TUPLE: io-task port callbacks ;
@ -72,11 +75,11 @@ SYMBOL: io-tasks
drop swap remove-io-task
] ifte ;
: handle-fd ( fd -- )
: handle-fd ( fd -- quot )
io-tasks get hash dup do-io-task [
pop-callback call
pop-callback
] [
drop
drop f
] ifte ;
: do-io-tasks ( pollfds n -- )
@ -84,7 +87,7 @@ SYMBOL: io-tasks
dup pick pollfd-nth dup pollfd-revents 0 = [
drop
] [
pollfd-fd handle-fd
pollfd-fd handle-fd [ call ] when*
] ifte
] repeat drop ;
@ -101,7 +104,7 @@ SYMBOL: io-tasks
] keep ;
: io-multiplex ( -- )
make-pollfds 2dup 0 sys-poll drop do-io-tasks ;
make-pollfds 2dup -1 sys-poll drop do-io-tasks ;
! Readers
@ -113,6 +116,21 @@ TUPLE: reader line ready? ;
C: reader ( handle -- reader )
[ >r buffered-port r> set-delegate ] keep ;
: pop-line ( reader -- str )
dup reader-line dup [ sbuf>string ] when >r
f over set-reader-line
f swap set-reader-ready? r> ;
: read-fin ( reader -- str )
dup pending-error dup reader-ready? [
pop-line
] [
"reader not ready" throw
] ifte ;
M: reader stream-close ( stream -- ) port-handle sys-close ;
! Reading lines
: read-line-loop ( line buffer -- ? )
dup buffer-length 0 = [
2drop f
@ -144,17 +162,13 @@ C: reader ( handle -- reader )
drop
] ifte t swap set-reader-ready? ;
: read-step ( port -- ? )
: read-step ( port -- )
>port<
tuck dup buffer-end swap buffer-capacity sys-read
dup 0 >= [ swap n>buffer t ] [ 2drop f ] ifte ;
dup 0 >= [ swap n>buffer ] [ drop postpone-error ] ifte ;
: refill ( reader -- )
dup buffer-length 0 = [
read-step drop
] [
drop
] ifte ;
dup buffer-length 0 = [ read-step ] [ drop ] ifte ;
: eof? ( buffer -- ? ) buffer-fill 0 = ;
@ -163,7 +177,7 @@ TUPLE: read-line-task ;
C: read-line-task ( port -- task )
[ >r <io-task> r> set-delegate ] keep ;
M: read-line-task do-io-task
M: read-line-task do-io-task ( task -- ? )
io-task-port dup refill dup eof? [
reader-eof t
] [
@ -173,6 +187,19 @@ M: read-line-task do-io-task
M: read-line-task io-task-events ( task -- events )
drop read-events ;
: wait-to-read-line ( port -- )
dup can-read-line? [
drop
] [
[
swap <read-line-task> add-io-task io-multiplex
] callcc0 drop
] ifte ;
M: reader stream-readln ( stream -- line )
dup wait-to-read-line read-fin ;
! Reading character counts
: read-count-step ( count reader -- ? )
dup reader-line -rot >r over length - r>
2dup buffer-fill <= [
@ -194,8 +221,10 @@ TUPLE: read-task count ;
C: read-task ( port -- task )
[ >r <io-task> r> set-delegate ] keep ;
: >read-task< dup read-task-count swap io-task-port ;
M: read-task do-io-task
io-task-port dup refill dup eof? [
>read-task< dup refill dup eof? [
nip reader-eof t
] [
read-count-step
@ -204,30 +233,6 @@ M: read-task do-io-task
M: read-task io-task-events ( task -- events )
drop read-events ;
: pop-line ( reader -- str )
dup reader-line dup [ sbuf>string ] when >r
f over set-reader-line
f swap set-reader-ready? r> ;
: read-fin ( reader -- str )
dup pending-error dup reader-ready? [
pop-line
] [
"reader not ready" throw
] ifte ;
: wait-to-read-line ( port -- )
dup can-read-line? [
drop
] [
[
swap <read-line-task> add-io-task io-multiplex
] callcc0 drop
] ifte ;
M: reader stream-readln ( stream -- line )
dup wait-to-read-line read-fin ;
: wait-to-read ( count port -- )
2dup can-read-count? [
2drop
@ -240,8 +245,6 @@ M: reader stream-readln ( stream -- line )
M: reader stream-read ( count stream -- string )
2dup wait-to-read read-fin ;
M: reader stream-close ( stream -- ) port-handle sys-close ;
! Writers
: open-write ( path -- fd )
@ -253,9 +256,12 @@ TUPLE: writer ;
C: writer ( fd -- writer )
[ >r buffered-port r> set-delegate ] keep ;
: write-step ( fd buffer -- ? )
tuck dup buffer@ swap buffer-length sys-write
dup 0 >= [ swap buffer-consume t ] [ 2drop f ] ifte ;
: write-step ( fd buffer -- )
tuck dup buffer@ swap buffer-length sys-write dup 0 >= [
swap buffer-consume
] [
drop postpone-error
] ifte ;
: can-write? ( len writer -- ? )
#! If the buffer is empty and the string is too long,
@ -276,7 +282,7 @@ M: write-task do-io-task
io-task-port dup buffer-length 0 = over port-error or [
0 swap buffer-reset t
] [
>port< write-step
>port< write-step f
] ifte ;
M: write-task io-task-events ( task -- events )

65
library/unix/syscalls.factor
View File

@ -3,9 +3,12 @@
IN: io-internals
USING: alien errors kernel math namespaces ;
! Alien wrappers for various Unix libc functions.
ALIAS: ulonglong off_t
ALIAS: long ssize_t
ALIAS: ulong size_t
ALIAS: uint socklen_t
BEGIN-STRUCT: stat
FIELD: uint dev
@ -59,6 +62,8 @@ BEGIN-STRUCT: string-box
FIELD: uchar256 value
END-STRUCT
: EINPROGRESS 36 ;
: errno ( -- n )
"int" "libc" "errno" alien-global ;
@ -116,3 +121,63 @@ END-STRUCT
: sys-poll ( pollfds nfds timeout -- n )
"int" "libc" "poll" [ "pollfd*" "uint" "int" ] alien-invoke ;
BEGIN-STRUCT: hostent
FIELD: char* name
FIELD: void* aliases ( really char**)
FIELD: int addrtype
FIELD: int length
FIELD: void* addr-list ( really char**)
END-STRUCT
: sys-gethostbyname ( name -- hostent )
"hostent*" "libc" "gethostbyname" [ "char*" ] alien-invoke ;
BEGIN-STRUCT: sockaddr-in
FIELD: uchar len;
FIELD: uchar family;
FIELD: ushort port;
! FIELD: struct in_addr sin_addr;
! FIELD: char sin_zero[8];
END-STRUCT
: AF_INET 2 ;
: PF_INET AF_INET ;
: SOCK_STREAM 1 ;
: sys-socket ( domain type protocol -- n )
"int" "libc" "socket" [ "int" "int" "int" ] alien-invoke ;
: SOL_SOCKET HEX: ffff ; ! options for socket level
: SO_REUSEADDR HEX: 4 ; ! allow local address reuse
: INADDR_ANY 0 ;
: sys-setsockopt ( s level optname optval optlen -- n )
"int" "libc" "setsockopt" [ "int" "int" "int" "void*" "socklen_t" ] alien-invoke ;
: sys-connect ( s name namelen -- n )
"int" "libc" "connect" [ "int" "sockaddr-in" "socklen_t" ] alien-invoke ;
: sys-bind ( s sockaddr socklen -- n )
"int" "libc" "bind" [ "int" "sockaddr-in" "socklen_t" ] alien-invoke ;
: sys-listen ( s backlog -- n )
"int" "libc" "listen" [ "int" "int" ] alien-invoke ;
: sys-accept ( s sockaddr socklen -- n )
"int" "libc" "accept" [ "int" "sockaddr-in" "socklen_t" ] alien-invoke ;
: sys-inet-ntoa ( sockaddr -- string )
"char*" "libc" "inet_ntoa" [ "sockaddr-in" ] alien-invoke ;
: htonl ( n -- n )
"uint" "libc" "htonl" [ "uint" ] alien-invoke ;
: htons ( n -- n )
"ushort" "libc" "htons" [ "ushort" ] alien-invoke ;
: ntohl ( n -- n )
"uint" "libc" "ntohl" [ "uint" ] alien-invoke ;
: ntohs ( n -- n )
"ushort" "libc" "ntohs" [ "ushort" ] alien-invoke ;