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

Check if streams are seekable in Windows

db4
Doug Coleman 2011-10-19 01:16:53 -07:00
parent c5cca8a6c6
commit 55790cc6e4
1 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
basis/io/files/windows/windows.factor
View File

@ -9,7 +9,7 @@ io.streams.c io.streams.null io.timeouts kernel libc literals
locals make math math.bitwise namespaces sequences locals make math math.bitwise namespaces sequences
specialized-arrays system threads tr windows windows.errors specialized-arrays system threads tr windows windows.errors
windows.handles windows.kernel32 windows.shell32 windows.time windows.handles windows.kernel32 windows.shell32 windows.time
windows.types ; windows.types fry ;
SPECIALIZED-ARRAY: ushort SPECIALIZED-ARRAY: ushort
IN: io.files.windows IN: io.files.windows
@ -133,9 +133,14 @@ M: windows init-io ( -- )
ERROR: invalid-file-size n ; ERROR: invalid-file-size n ;
: handle>file-size ( handle -- n ) : (handle>file-size) ( handle -- n )
0 ulonglong <ref> [ GetFileSizeEx win32-error=0/f ] keep ulonglong deref ; 0 ulonglong <ref> [ GetFileSizeEx win32-error=0/f ] keep ulonglong deref ;
! Returns T{ windows-error f 1 "Incorrect function." } if stream is not seekable
: handle>file-size ( handle -- n/f )
'[ _ (handle>file-size) ]
[ dup n>> 1 = [ drop f ] [ rethrow ] if ] recover ;
ERROR: seek-before-start n ; ERROR: seek-before-start n ;
: set-seek-ptr ( n handle -- ) : set-seek-ptr ( n handle -- )
@ -152,10 +157,11 @@ M: windows seek-handle ( n seek-type handle -- )
} case ; } case ;
M: windows can-seek-handle? ( handle -- ? ) M: windows can-seek-handle? ( handle -- ? )
handle>> handle>file-size zero? not ; handle>> handle>file-size >boolean ;
M: windows handle-length ( handle -- n/f ) M: windows handle-length ( handle -- n/f )
handle>> handle>file-size [ f ] when-zero ; handle>> handle>file-size
dup { 0 f } member? [ drop f ] when ;
: file-error? ( n -- eof? ) : file-error? ( n -- eof? )
zero? [ zero? [