io.ports: stream-seekable? and stream-length
io.files.windows, io.backend.unix: platform-specific backends for those methodsdb4
parent
5627492f9b
commit
863ab575e3
|
@ -2,11 +2,12 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.data alien.syntax generic
|
USING: alien alien.c-types alien.data alien.syntax generic
|
||||||
assocs kernel kernel.private math io.ports sequences strings
|
assocs kernel kernel.private math io.ports sequences strings
|
||||||
sbufs threads unix unix.ffi vectors io.buffers io.backend
|
sbufs threads unix unix.ffi unix.stat vectors io.buffers io.backend
|
||||||
io.encodings math.parser continuations system libc namespaces
|
io.encodings math.parser continuations system libc namespaces
|
||||||
make io.timeouts io.encodings.utf8 destructors
|
make io.timeouts io.encodings.utf8 destructors
|
||||||
destructors.private accessors summary combinators locals
|
destructors.private accessors summary combinators locals
|
||||||
unix.time unix.types fry io.backend.unix.multiplexers ;
|
unix.time unix.types fry io.backend.unix.multiplexers
|
||||||
|
classes.struct ;
|
||||||
QUALIFIED: io
|
QUALIFIED: io
|
||||||
IN: io.backend.unix
|
IN: io.backend.unix
|
||||||
|
|
||||||
|
@ -57,6 +58,12 @@ M: unix seek-handle ( n seek-type handle -- )
|
||||||
} case
|
} case
|
||||||
[ fd>> swap ] dip [ lseek ] unix-system-call drop ;
|
[ 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: +retry+ ! just try the operation again without blocking
|
||||||
SYMBOL: +input+
|
SYMBOL: +input+
|
||||||
SYMBOL: +output+
|
SYMBOL: +output+
|
||||||
|
|
|
@ -151,6 +151,12 @@ M: windows seek-handle ( n seek-type handle -- )
|
||||||
[ bad-seek-type ]
|
[ bad-seek-type ]
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
|
M: windows can-seek-handle? ( handle -- ? )
|
||||||
|
handle>file-size zero? not ;
|
||||||
|
|
||||||
|
M: windows handle-length ( handle -- n/f )
|
||||||
|
handle>file-size [ f ] when-zero ;
|
||||||
|
|
||||||
: file-error? ( n -- eof? )
|
: file-error? ( n -- eof? )
|
||||||
zero? [
|
zero? [
|
||||||
GetLastError {
|
GetLastError {
|
||||||
|
|
|
@ -143,18 +143,21 @@ HOOK: (wait-to-write) io-backend ( port -- )
|
||||||
dup buffer>> buffer-empty?
|
dup buffer>> buffer-empty?
|
||||||
[ drop ] [ dup (wait-to-write) port-flush ] if ;
|
[ drop ] [ dup (wait-to-write) port-flush ] if ;
|
||||||
|
|
||||||
M: output-port stream-flush ( port -- )
|
M: output-port stream-flush
|
||||||
[ check-disposed ] [ port-flush ] bi ;
|
[ check-disposed ] [ port-flush ] bi ;
|
||||||
|
|
||||||
HOOK: tell-handle os ( handle -- n )
|
HOOK: tell-handle os ( handle -- n )
|
||||||
|
|
||||||
HOOK: seek-handle os ( n seek-type handle -- )
|
HOOK: seek-handle os ( n seek-type handle -- )
|
||||||
|
|
||||||
M: input-port stream-tell ( stream -- n )
|
HOOK: can-seek-handle? os ( handle -- ? )
|
||||||
|
HOOK: handle-length os ( handle -- n/f )
|
||||||
|
|
||||||
|
M: input-port stream-tell
|
||||||
[ check-disposed ]
|
[ check-disposed ]
|
||||||
[ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi - ] bi ;
|
[ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi - ] bi ;
|
||||||
|
|
||||||
M: output-port stream-tell ( stream -- n )
|
M: output-port stream-tell
|
||||||
[ check-disposed ]
|
[ check-disposed ]
|
||||||
[ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi + ] bi ;
|
[ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi + ] bi ;
|
||||||
|
|
||||||
|
@ -165,18 +168,28 @@ M: output-port stream-tell ( stream -- n )
|
||||||
[ n stream stream-tell + seek-absolute ] [ n seek-type ] if
|
[ n stream stream-tell + seek-absolute ] [ n seek-type ] if
|
||||||
stream ;
|
stream ;
|
||||||
|
|
||||||
M: input-port stream-seek ( n seek-type stream -- )
|
M: input-port stream-seek
|
||||||
do-seek-relative
|
do-seek-relative
|
||||||
[ check-disposed ]
|
[ check-disposed ]
|
||||||
[ buffer>> 0 swap buffer-reset ]
|
[ buffer>> 0 swap buffer-reset ]
|
||||||
[ handle>> seek-handle ] tri ;
|
[ handle>> seek-handle ] tri ;
|
||||||
|
|
||||||
M: output-port stream-seek ( n seek-type stream -- )
|
M: output-port stream-seek
|
||||||
do-seek-relative
|
do-seek-relative
|
||||||
[ check-disposed ]
|
[ check-disposed ]
|
||||||
[ stream-flush ]
|
[ stream-flush ]
|
||||||
[ handle>> seek-handle ] tri ;
|
[ handle>> seek-handle ] tri ;
|
||||||
|
|
||||||
|
M: input-port stream-seekable?
|
||||||
|
handle>> can-seek-handle? ;
|
||||||
|
M: output-port stream-seekable?
|
||||||
|
handle>> can-seek-handle? ;
|
||||||
|
|
||||||
|
M: input-port stream-length
|
||||||
|
handle>> handle-length ;
|
||||||
|
M: output-port stream-length
|
||||||
|
handle>> handle-length ;
|
||||||
|
|
||||||
GENERIC: shutdown ( handle -- )
|
GENERIC: shutdown ( handle -- )
|
||||||
|
|
||||||
M: object shutdown drop ;
|
M: object shutdown drop ;
|
||||||
|
|
Loading…
Reference in New Issue