From 8c5ceb8b0c7c3c6ef1f9e40b7dd2a78a624988d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Wed, 16 Oct 2013 14:11:31 +0200 Subject: [PATCH] io.files.windows: new generic words drain and refill, like in io.backend.unix The purpose of these words is to abstract out the pushing of the bytes to the ports so that you can insert the ssl layer in between. Exactly like how drain and refill are specialized on ssl-handle in io.sockets.secure.unix. --- basis/io/files/windows/windows.factor | 110 ++++++++++++-------------- 1 file changed, 49 insertions(+), 61 deletions(-) diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 3617a126f7..7f222b732c 100755 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -14,8 +14,6 @@ SPECIALIZED-ARRAY: ushort IN: io.files.windows HOOK: CreateFile-flags io-backend ( DWORD -- DWORD ) -HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f ) -HOOK: add-completion io-backend ( port -- port ) HOOK: open-append os ( path -- win32-file ) TUPLE: win32-file < win32-handle ptr ; @@ -25,9 +23,6 @@ TUPLE: win32-file < win32-handle ptr ; M: win32-file dispose [ cancel-operation ] [ call-next-method ] bi ; - -: opened-file ( handle -- win32-file ) - check-invalid-handle |dispose add-completion ; CONSTANT: share-mode flags{ @@ -35,7 +30,7 @@ CONSTANT: share-mode FILE_SHARE_WRITE FILE_SHARE_DELETE } - + : default-security-attributes ( -- obj ) SECURITY_ATTRIBUTES SECURITY_ATTRIBUTES heap-size >>nLength ; @@ -46,16 +41,6 @@ TUPLE: FileArgs C: FileArgs -: make-FileArgs ( port -- ) - { - [ handle>> check-disposed ] - [ handle>> handle>> ] - [ buffer>> ] - [ buffer>> buffer-length ] - [ drop 0 DWORD ] - [ FileArgs-overlapped ] - } cleave ; - ! Global variable with assoc mapping overlapped to threads SYMBOL: pending-overlapped @@ -63,30 +48,20 @@ TUPLE: io-callback port thread ; C: io-callback -: (make-overlapped) ( -- overlapped-ext ) - OVERLAPPED malloc-struct &free ; - -: make-overlapped ( port -- overlapped-ext ) - [ (make-overlapped) ] dip - handle>> ptr>> [ - [ 32 bits >>offset ] - [ -32 shift >>offset-high ] bi - ] when* ; - -M: windows FileArgs-overlapped ( port -- overlapped ) - make-overlapped ; - : ( handle existing -- handle ) f 1 CreateIoCompletionPort dup win32-error=0/f ; -SYMBOL: master-completion-port - : ( -- handle ) INVALID_HANDLE_VALUE f ; -M: windows add-completion ( win32-handle -- win32-handle ) +SYMBOL: master-completion-port + +: add-completion ( win32-handle -- win32-handle ) dup handle>> master-completion-port get-global drop ; +: opened-file ( handle -- win32-file ) + check-invalid-handle |dispose add-completion ; + : eof? ( error -- ? ) { [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] } 1|| ; @@ -143,7 +118,7 @@ ERROR: invalid-file-size n ; GetLastError ERROR_INVALID_FUNCTION = [ f ] [ throw-win32-error ] if ] unless* ; - + ERROR: seek-before-start n ; : set-seek-ptr ( n handle -- ) @@ -182,45 +157,58 @@ M: windows handle-length ( handle -- n/f ) : update-file-ptr ( n port -- ) handle>> dup ptr>> [ rot + >>ptr drop ] [ 2drop ] if* ; -: finish-write ( n port -- ) - [ update-file-ptr ] [ buffer>> buffer-consume ] 2bi ; +: (make-overlapped) ( -- overlapped-ext ) + OVERLAPPED malloc-struct &free ; -: setup-read ( -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped ) - { - [ hFile>> ] - [ lpBuffer>> buffer-end ] - [ lpBuffer>> buffer-capacity ] - [ lpNumberOfBytesRet>> ] - [ lpOverlapped>> ] - } cleave ; +: make-overlapped ( handle -- overlapped-ext ) + (make-overlapped) swap + ptr>> [ [ 32 bits >>offset ] [ -32 shift >>offset-high ] bi ] when* ; + +: make-FileArgs ( port handle -- ) + [ nip dup check-disposed handle>> ] + [ + [ buffer>> dup buffer-length 0 DWORD ] dip make-overlapped + ] 2bi ; + +GENERIC: drain ( port handle -- ) : setup-write ( -- hFile lpBuffer nNumberOfBytesToWrite lpNumberOfBytesWritten lpOverlapped ) { [ hFile>> ] - [ lpBuffer>> buffer@ ] - [ lpBuffer>> buffer-length ] + [ lpBuffer>> [ buffer@ ] [ buffer-length ] bi ] + [ lpNumberOfBytesRet>> ] + [ lpOverlapped>> ] + } cleave ; + +: finish-write ( n port -- ) + [ update-file-ptr ] [ buffer>> buffer-consume ] 2bi ; + +M: object drain ( port handle -- ) + [ make-FileArgs dup setup-write WriteFile ] + [ drop [ wait-for-file ] [ finish-write ] bi ] 2bi ; + +GENERIC: refill ( port handle -- ) + +: setup-read ( -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped ) + { + [ hFile>> ] + [ lpBuffer>> [ buffer-end ] [ buffer-capacity ] bi ] [ lpNumberOfBytesRet>> ] [ lpOverlapped>> ] } cleave ; - -M: windows (wait-to-write) - [ - [ make-FileArgs dup setup-write WriteFile ] - [ wait-for-file ] - [ finish-write ] - tri - ] with-destructors ; : finish-read ( n port -- ) [ update-file-ptr ] [ buffer>> n>buffer ] 2bi ; +M: object refill ( port handle -- ) + [ make-FileArgs dup setup-read ReadFile ] + [ drop [ wait-for-file ] [ finish-read ] bi ] 2bi ; + +M: windows (wait-to-write) + [ dup handle>> drain ] with-destructors ; + M: windows (wait-to-read) ( port -- ) - [ - [ make-FileArgs dup setup-read ReadFile ] - [ wait-for-file ] - [ finish-read ] - tri - ] with-destructors ; + [ dup handle>> refill ] with-destructors ; : console-app? ( -- ? ) GetConsoleWindow >boolean ; @@ -288,10 +276,10 @@ SLOT: attributes : read-only? ( file-info -- ? ) attributes>> +read-only+ swap member? ; - + : set-file-attributes ( path flags -- ) SetFileAttributes win32-error=0/f ; - + : set-file-normal-attribute ( path -- ) FILE_ATTRIBUTE_NORMAL set-file-attributes ;