! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.syntax generic assocs kernel
-kernel.private math io.ports sequences strings sbufs threads
-unix vectors io.buffers io.backend io.encodings math.parser
-continuations system libc namespaces make io.timeouts
-io.encodings.utf8 destructors accessors summary combinators
-locals unix.time fry io.backend.unix.multiplexers ;
+USING: alien alien.c-types alien.data alien.syntax generic
+assocs kernel kernel.private math io.ports sequences strings
+sbufs threads unix unix.ffi unix.stat vectors io.buffers io.backend
+io.encodings math.parser continuations system libc namespaces
+make io.timeouts io.encodings.utf8 destructors
+destructors.private accessors summary combinators locals
+unix.time unix.types fry io.backend.unix.multiplexers
+classes.struct hints ;
QUALIFIED: io
IN: io.backend.unix
GENERIC: handle-fd ( handle -- fd )
-TUPLE: fd fd disposed ;
+TUPLE: fd < disposable fd ;
: init-fd ( fd -- fd )
[
|dispose
- dup fd>> F_SETFL O_NONBLOCK fcntl io-error
- dup fd>> F_SETFD FD_CLOEXEC fcntl io-error
+ dup fd>> F_SETFL O_NONBLOCK [ fcntl ] unix-system-call drop
+ dup fd>> F_SETFD FD_CLOEXEC [ fcntl ] unix-system-call drop
] with-destructors ;
: <fd> ( n -- fd )
- #! We drop the error code rather than calling io-error,
- #! 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 fd boa ;
+ fd new-disposable swap >>fd ;
M: fd dispose
- dup disposed>> [ drop ] [
- [ cancel-operation ]
- [ t >>disposed drop ]
- [ fd>> close-file ]
- tri
- ] if ;
+ [
+ {
+ [ cancel-operation ]
+ [ t >>disposed drop ]
+ [ unregister-disposable ]
+ [ fd>> close-file ]
+ } cleave
+ ] unless-disposed ;
M: fd handle-fd dup check-disposed fd>> ;
M: fd cancel-operation ( fd -- )
- dup disposed>> [ drop ] [
+ [
fd>>
mx get-global
[ remove-input-callbacks [ t swap resume-with ] each ]
[ remove-output-callbacks [ t swap resume-with ] each ]
2bi
- ] if ;
+ ] unless-disposed ;
+
+M: unix tell-handle ( handle -- n )
+ fd>> 0 SEEK_CUR [ lseek ] unix-system-call [ io-error ] [ ] bi ;
M: unix seek-handle ( n seek-type handle -- )
swap {
{ io:seek-end [ SEEK_END ] }
[ io:bad-seek-type ]
} case
- [ fd>> swap ] dip lseek io-error ;
+ [ fd>> swap ] dip [ lseek ] unix-system-call drop ;
+
+M: unix can-seek-handle? ( handle -- ? )
+ fd>> SEEK_CUR 0 lseek -1 = not ;
+
+M: unix handle-length ( handle -- n/f )
+ fd>> \ stat <struct> [ fstat -1 = not ] keep
+ swap [ st_size>> ] [ drop f ] if ;
SYMBOL: +retry+ ! just try the operation again without blocking
SYMBOL: +input+
: wait-for-fd ( handle event -- )
dup +retry+ eq? [ 2drop ] [
- '[
- swap handle-fd mx get-global _ {
- { +input+ [ add-input-callback ] }
- { +output+ [ add-output-callback ] }
- } case
- ] "I/O" suspend nip [ io-timeout ] when
+ [ [ self ] dip handle-fd mx get-global ] dip {
+ { +input+ [ add-input-callback ] }
+ { +output+ [ add-output-callback ] }
+ } case
+ "I/O" suspend [ io-timeout ] when
] if ;
: wait-for-port ( port event -- )
'[ handle>> _ wait-for-fd ] with-timeout ;
! Some general stuff
-CONSTANT: file-mode OCT: 0666
+CONSTANT: file-mode 0o0666
! Readers
: (refill) ( port -- n )
[ (io-error) ]
} cond ;
+HINTS: M\ fd refill
+ { buffered-port fd } ;
+
M: unix (wait-to-read) ( port -- )
dup
dup handle>> dup check-disposed refill dup
! pipe to non-blocking, and read from it instead of the real
! stdin. Very crufty, but it will suffice until we get native
! threading support at the language level.
-TUPLE: stdin control size data disposed ;
+TUPLE: stdin < disposable control size data ;
M: stdin dispose*
[
tri
] with-destructors ;
-: wait-for-stdin ( stdin -- n )
+: wait-for-stdin ( stdin -- size )
[ control>> CHAR: X over io:stream-write1 io:stream-flush ]
- [ size>> "ssize_t" heap-size swap io:stream-read *int ]
+ [ size>> ssize_t heap-size swap io:stream-read ssize_t deref ]
bi ;
:: refill-stdin ( buffer stdin size -- )
] if ;
M: stdin refill
- [ buffer>> ] [ dup wait-for-stdin ] bi* refill-stdin f ;
+ '[
+ buffer>> _ dup wait-for-stdin refill-stdin f
+ ] with-timeout ;
+
+M: stdin cancel-operation
+ [ size>> ] [ control>> ] bi [ cancel-operation ] bi@ ;
-: control-write-fd ( -- fd ) &: control_write *uint ;
+: control-write-fd ( -- fd ) &: control_write uint deref ;
-: size-read-fd ( -- fd ) &: size_read *uint ;
+: size-read-fd ( -- fd ) &: size_read uint deref ;
-: data-read-fd ( -- fd ) &: stdin_read *uint ;
+: data-read-fd ( -- fd ) &: stdin_read uint deref ;
: <stdin> ( -- stdin )
- stdin new
+ stdin new-disposable
control-write-fd <fd> <output-port> >>control
size-read-fd <fd> init-fd <input-port> >>size
data-read-fd <fd> >>data ;
-M: unix (init-stdio)
+SYMBOL: dispatch-signal-hook
+
+dispatch-signal-hook [ [ drop ] ] initialize
+
+: signal-pipe-fd ( -- n )
+ OBJ-SIGNAL-PIPE special-object ; inline
+
+: signal-pipe-loop ( port -- )
+ '[
+ int heap-size _ io:stream-read
+ dup [ int deref dispatch-signal-hook get call( x -- ) ] when*
+ ] loop ;
+
+: start-signal-pipe-thread ( -- )
+ signal-pipe-fd [
+ <fd> init-fd <input-port>
+ '[ _ signal-pipe-loop ] "Signals" spawn drop
+ ] when* ;
+
+M: unix init-stdio
<stdin> <input-port>
1 <fd> <output-port>
- 2 <fd> <output-port> t ;
+ 2 <fd> <output-port>
+ set-stdio ;
! mx io-task for embedding an fd-based mx inside another mx
TUPLE: mx-port < port mx ;
[ drop 0 ] [ (io-error) ] if
] when ;
-: ?flag ( n mask symbol -- n )
- pick rot bitand 0 > [ , ] [ drop ] if ;
+:: ?flag ( n mask symbol -- n )
+ n mask bitand 0 > [ symbol , ] when n ;
projects / factor.git / blobdiff