From e15c3cc901d69ff7e29c6861b1fe8ebd30531b12 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 15 Dec 2008 01:32:21 -0600 Subject: [PATCH] Updating Windows I/O backend for recent changes --- basis/io/directories/windows/windows.factor | 56 +++ basis/io/files/info/windows/nt/nt.factor | 13 + basis/io/files/info/windows/windows.factor | 190 +++++++++ basis/io/files/windows/files.factor | 378 ------------------ .../{files-tests.factor => nt-tests.factor} | 0 .../windows/nt/{files.factor => nt.factor} | 10 - basis/io/files/windows/windows.factor | 139 +++++++ 7 files changed, 398 insertions(+), 388 deletions(-) create mode 100644 basis/io/directories/windows/windows.factor create mode 100644 basis/io/files/info/windows/nt/nt.factor create mode 100644 basis/io/files/info/windows/windows.factor delete mode 100755 basis/io/files/windows/files.factor rename basis/io/files/windows/nt/{files-tests.factor => nt-tests.factor} (100%) rename basis/io/files/windows/nt/{files.factor => nt.factor} (86%) create mode 100755 basis/io/files/windows/windows.factor diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor new file mode 100644 index 0000000000..6520602b7e --- /dev/null +++ b/basis/io/directories/windows/windows.factor @@ -0,0 +1,56 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +IN: io.directories.windows + +M: windows move-file ( from to -- ) + [ normalize-path ] bi@ MoveFile win32-error=0/f ; + +M: windows delete-file ( path -- ) + normalize-path DeleteFile win32-error=0/f ; + +M: windows copy-file ( from to -- ) + dup parent-directory make-directories + [ normalize-path ] bi@ 0 CopyFile win32-error=0/f ; + +M: windows make-directory ( path -- ) + normalize-path + f CreateDirectory win32-error=0/f ; + +M: windows delete-directory ( path -- ) + normalize-path + RemoveDirectory win32-error=0/f ; + +: find-first-file ( path -- WIN32_FIND_DATA handle ) + "WIN32_FIND_DATA" tuck + FindFirstFile + [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ; + +: find-next-file ( path -- WIN32_FIND_DATA/f ) + "WIN32_FIND_DATA" tuck + FindNextFile 0 = [ + GetLastError ERROR_NO_MORE_FILES = [ + win32-error + ] unless drop f + ] when ; + +TUPLE: windows-directory-entry < directory-entry attributes ; + +M: windows >directory-entry ( byte-array -- directory-entry ) + [ WIN32_FIND_DATA-cFileName utf16n alien>string ] + [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ] + [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ] + tri + dupd remove windows-directory-entry boa ; + +M: windows (directory-entries) ( path -- seq ) + "\\" ?tail drop "\\*" append + find-first-file [ >directory-entry ] dip + [ + '[ + [ _ find-next-file dup ] + [ >directory-entry ] + [ drop ] produce + over name>> "." = [ nip ] [ swap prefix ] if + ] + ] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ; + diff --git a/basis/io/files/info/windows/nt/nt.factor b/basis/io/files/info/windows/nt/nt.factor new file mode 100644 index 0000000000..e1b8062016 --- /dev/null +++ b/basis/io/files/info/windows/nt/nt.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +IN: io.files.info.windows.nt + +ERROR: not-absolute-path ; + +M: winnt root-directory ( string -- string' ) + unicode-prefix ?head drop + dup { + [ length 2 >= ] + [ second CHAR: : = ] + [ first Letter? ] + } 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ; diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor new file mode 100644 index 0000000000..c3068dbafa --- /dev/null +++ b/basis/io/files/info/windows/windows.factor @@ -0,0 +1,190 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +IN: io.files.info.windows + +TUPLE: windows-file-info < file-info attributes ; + +: WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info ) + [ \ windows-file-info new ] dip + { + [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ] + [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes >>attributes ] + [ + [ WIN32_FIND_DATA-nFileSizeLow ] + [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size + ] + [ WIN32_FIND_DATA-dwFileAttributes >>permissions ] + [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp >>created ] + [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp >>modified ] + [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp >>accessed ] + } cleave ; + +: find-first-file-stat ( path -- WIN32_FIND_DATA ) + "WIN32_FIND_DATA" [ + FindFirstFile + [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep + FindClose win32-error=0/f + ] keep ; + +: BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info ) + [ \ windows-file-info new ] dip + { + [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type >>type ] + [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes >>attributes ] + [ + [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ] + [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size + ] + [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes >>permissions ] + [ + BY_HANDLE_FILE_INFORMATION-ftCreationTime + FILETIME>timestamp >>created + ] + [ + BY_HANDLE_FILE_INFORMATION-ftLastWriteTime + FILETIME>timestamp >>modified + ] + [ + BY_HANDLE_FILE_INFORMATION-ftLastAccessTime + FILETIME>timestamp >>accessed + ] + ! [ BY_HANDLE_FILE_INFORMATION-nNumberOfLinks ] + ! [ + ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexLow ] + ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexHigh ] bi >64bit + ! ] + } cleave ; + +: get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION ) + [ + "BY_HANDLE_FILE_INFORMATION" + [ GetFileInformationByHandle win32-error=0/f ] keep + ] keep CloseHandle win32-error=0/f ; + +: get-file-information-stat ( path -- BY_HANDLE_FILE_INFORMATION ) + dup + GENERIC_READ FILE_SHARE_READ f + OPEN_EXISTING FILE_FLAG_BACKUP_SEMANTICS f + CreateFileW dup INVALID_HANDLE_VALUE = [ + drop find-first-file-stat WIN32_FIND_DATA>file-info + ] [ + nip + get-file-information BY_HANDLE_FILE_INFORMATION>file-info + ] if ; + +M: winnt file-info ( path -- info ) + normalize-path get-file-information-stat ; + +M: winnt link-info ( path -- info ) + file-info ; + +: volume-information ( normalized-path -- volume-name volume-serial max-component flags type ) + MAX_PATH 1+ [ ] keep + "DWORD" + "DWORD" + "DWORD" + MAX_PATH 1+ [ ] keep + [ GetVolumeInformation win32-error=0/f ] 7 nkeep + drop 5 nrot drop + [ utf16n alien>string ] 4 ndip + utf16n alien>string ; + +: file-system-space ( normalized-path -- available-space total-space free-space ) + "ULARGE_INTEGER" + "ULARGE_INTEGER" + "ULARGE_INTEGER" + [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ; + +: calculate-file-system-info ( file-system-info -- file-system-info' ) + { + [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] + [ ] + } cleave ; + +TUPLE: win32-file-system-info < file-system-info max-component flags device-serial ; + +HOOK: root-directory os ( string -- string' ) + +M: winnt file-system-info ( path -- file-system-info ) + normalize-path root-directory + dup [ volume-information ] [ file-system-space ] bi + \ win32-file-system-info new + swap *ulonglong >>free-space + swap *ulonglong >>total-space + swap *ulonglong >>available-space + swap >>type + swap *uint >>flags + swap *uint >>max-component + swap *uint >>device-serial + swap >>device-name + swap >>mount-point + calculate-file-system-info ; + +: volume>paths ( string -- array ) + 16384 "ushort" tuck dup length + 0 dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [ + win32-error-string throw + ] [ + *uint "ushort" heap-size * head + utf16n alien>string CHAR: \0 split + ] if ; + +: find-first-volume ( -- string handle ) + MAX_PATH 1+ [ ] keep + dupd + FindFirstVolume dup win32-error=0/f + [ utf16n alien>string ] dip ; + +: find-next-volume ( handle -- string/f ) + MAX_PATH 1+ [ tuck ] keep + FindNextVolume 0 = [ + GetLastError ERROR_NO_MORE_FILES = + [ drop f ] [ win32-error-string throw ] if + ] [ + utf16n alien>string + ] if ; + +: find-volumes ( -- array ) + find-first-volume + [ + '[ + [ _ find-next-volume dup ] + [ ] + [ drop ] produce + swap prefix + ] + ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ; + +M: winnt file-systems ( -- array ) + find-volumes [ volume>paths ] map + concat [ + [ file-system-info ] + [ drop \ file-system-info new swap >>mount-point ] recover + ] map ; + +: file-times ( path -- timestamp timestamp timestamp ) + [ + normalize-path open-existing &dispose handle>> + "FILETIME" + "FILETIME" + "FILETIME" + [ GetFileTime win32-error=0/f ] 3keep + [ FILETIME>timestamp >local-time ] tri@ + ] with-destructors ; + +: set-file-times ( path timestamp/f timestamp/f timestamp/f -- ) + #! timestamp order: creation access write + [ + [ + normalize-path open-existing &dispose handle>> + ] 3dip (set-file-times) + ] with-destructors ; + +: set-file-create-time ( path timestamp -- ) + f f set-file-times ; + +: set-file-access-time ( path timestamp -- ) + [ f ] dip f set-file-times ; + +: set-file-write-time ( path timestamp -- ) + [ f f ] dip set-file-times ; diff --git a/basis/io/files/windows/files.factor b/basis/io/files/windows/files.factor deleted file mode 100755 index 76105c5fe6..0000000000 --- a/basis/io/files/windows/files.factor +++ /dev/null @@ -1,378 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types io.binary io.backend io.files io.buffers -io.encodings.utf16n io.ports io.backend.windows kernel math splitting -fry alien.strings windows windows.kernel32 windows.time calendar -combinators math.functions sequences namespaces make words -symbols system destructors accessors math.bitwise continuations -windows.errors arrays byte-arrays generalizations ; -IN: io.files.windows - -: open-file ( path access-mode create-mode flags -- handle ) - [ - [ share-mode default-security-attributes ] 2dip - CreateFile-flags f CreateFile opened-file - ] with-destructors ; - -: open-pipe-r/w ( path -- win32-file ) - { GENERIC_READ GENERIC_WRITE } flags - OPEN_EXISTING 0 open-file ; - -: open-read ( path -- win32-file ) - GENERIC_READ OPEN_EXISTING 0 open-file 0 >>ptr ; - -: open-write ( path -- win32-file ) - GENERIC_WRITE CREATE_ALWAYS 0 open-file 0 >>ptr ; - -: (open-append) ( path -- win32-file ) - GENERIC_WRITE OPEN_ALWAYS 0 open-file ; - -: open-existing ( path -- win32-file ) - { GENERIC_READ GENERIC_WRITE } flags - share-mode - f - OPEN_EXISTING - FILE_FLAG_BACKUP_SEMANTICS - f CreateFileW dup win32-error=0/f ; - -: maybe-create-file ( path -- win32-file ? ) - #! return true if file was just created - { GENERIC_READ GENERIC_WRITE } flags - share-mode - f - OPEN_ALWAYS - 0 CreateFile-flags - f CreateFileW dup win32-error=0/f - GetLastError ERROR_ALREADY_EXISTS = not ; - -: set-file-pointer ( handle length method -- ) - [ dupd d>w/w ] dip SetFilePointer - INVALID_SET_FILE_POINTER = [ - CloseHandle "SetFilePointer failed" throw - ] when drop ; - -HOOK: open-append os ( path -- win32-file ) - -TUPLE: FileArgs - hFile lpBuffer nNumberOfBytesToRead - lpNumberOfBytesRet lpOverlapped ; - -C: FileArgs - -: make-FileArgs ( port -- ) - { - [ handle>> check-disposed ] - [ handle>> handle>> ] - [ buffer>> ] - [ buffer>> buffer-length ] - [ drop "DWORD" ] - [ FileArgs-overlapped ] - } cleave ; - -: setup-read ( -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped ) - { - [ hFile>> ] - [ lpBuffer>> buffer-end ] - [ lpBuffer>> buffer-capacity ] - [ lpNumberOfBytesRet>> ] - [ lpOverlapped>> ] - } cleave ; - -: setup-write ( -- hFile lpBuffer nNumberOfBytesToWrite lpNumberOfBytesWritten lpOverlapped ) - { - [ hFile>> ] - [ lpBuffer>> buffer@ ] - [ lpBuffer>> buffer-length ] - [ lpNumberOfBytesRet>> ] - [ lpOverlapped>> ] - } cleave ; - -M: windows (file-reader) ( path -- stream ) - open-read ; - -M: windows (file-writer) ( path -- stream ) - open-write ; - -M: windows (file-appender) ( path -- stream ) - open-append ; - -M: windows move-file ( from to -- ) - [ normalize-path ] bi@ MoveFile win32-error=0/f ; - -M: windows delete-file ( path -- ) - normalize-path DeleteFile win32-error=0/f ; - -M: windows copy-file ( from to -- ) - dup parent-directory make-directories - [ normalize-path ] bi@ 0 CopyFile win32-error=0/f ; - -M: windows make-directory ( path -- ) - normalize-path - f CreateDirectory win32-error=0/f ; - -M: windows delete-directory ( path -- ) - normalize-path - RemoveDirectory win32-error=0/f ; - -: find-first-file ( path -- WIN32_FIND_DATA handle ) - "WIN32_FIND_DATA" tuck - FindFirstFile - [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ; - -: find-next-file ( path -- WIN32_FIND_DATA/f ) - "WIN32_FIND_DATA" tuck - FindNextFile 0 = [ - GetLastError ERROR_NO_MORE_FILES = [ - win32-error - ] unless drop f - ] when ; - -M: windows (directory-entries) ( path -- seq ) - "\\" ?tail drop "\\*" append - find-first-file [ >directory-entry ] dip - [ - '[ - [ _ find-next-file dup ] - [ >directory-entry ] - [ drop ] produce - over name>> "." = [ nip ] [ swap prefix ] if - ] - ] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ; - -SYMBOLS: +read-only+ +hidden+ +system+ -+archive+ +device+ +normal+ +temporary+ -+sparse-file+ +reparse-point+ +compressed+ +offline+ -+not-content-indexed+ +encrypted+ ; - -TUPLE: windows-file-info < file-info attributes ; - -: win32-file-attribute ( n attr symbol -- ) - rot mask? [ , ] [ drop ] if ; - -: win32-file-attributes ( n -- seq ) - [ - { - [ +read-only+ FILE_ATTRIBUTE_READONLY win32-file-attribute ] - [ +hidden+ FILE_ATTRIBUTE_HIDDEN win32-file-attribute ] - [ +system+ FILE_ATTRIBUTE_SYSTEM win32-file-attribute ] - [ +directory+ FILE_ATTRIBUTE_DIRECTORY win32-file-attribute ] - [ +archive+ FILE_ATTRIBUTE_ARCHIVE win32-file-attribute ] - [ +device+ FILE_ATTRIBUTE_DEVICE win32-file-attribute ] - [ +normal+ FILE_ATTRIBUTE_NORMAL win32-file-attribute ] - [ +temporary+ FILE_ATTRIBUTE_TEMPORARY win32-file-attribute ] - [ +sparse-file+ FILE_ATTRIBUTE_SPARSE_FILE win32-file-attribute ] - [ +reparse-point+ FILE_ATTRIBUTE_REPARSE_POINT win32-file-attribute ] - [ +compressed+ FILE_ATTRIBUTE_COMPRESSED win32-file-attribute ] - [ +offline+ FILE_ATTRIBUTE_OFFLINE win32-file-attribute ] - [ +not-content-indexed+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED win32-file-attribute ] - [ +encrypted+ FILE_ATTRIBUTE_ENCRYPTED win32-file-attribute ] - } cleave - ] { } make ; - -: win32-file-type ( n -- symbol ) - FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ; - -TUPLE: windows-directory-entry < directory-entry attributes ; - -M: windows >directory-entry ( byte-array -- directory-entry ) - [ WIN32_FIND_DATA-cFileName utf16n alien>string ] - [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ] - [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ] - tri - dupd remove windows-directory-entry boa ; - -: WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info ) - [ \ windows-file-info new ] dip - { - [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ] - [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes >>attributes ] - [ - [ WIN32_FIND_DATA-nFileSizeLow ] - [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size - ] - [ WIN32_FIND_DATA-dwFileAttributes >>permissions ] - [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp >>created ] - [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp >>modified ] - [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp >>accessed ] - } cleave ; - -: find-first-file-stat ( path -- WIN32_FIND_DATA ) - "WIN32_FIND_DATA" [ - FindFirstFile - [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep - FindClose win32-error=0/f - ] keep ; - -: BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info ) - [ \ windows-file-info new ] dip - { - [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type >>type ] - [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes >>attributes ] - [ - [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ] - [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size - ] - [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes >>permissions ] - [ - BY_HANDLE_FILE_INFORMATION-ftCreationTime - FILETIME>timestamp >>created - ] - [ - BY_HANDLE_FILE_INFORMATION-ftLastWriteTime - FILETIME>timestamp >>modified - ] - [ - BY_HANDLE_FILE_INFORMATION-ftLastAccessTime - FILETIME>timestamp >>accessed - ] - ! [ BY_HANDLE_FILE_INFORMATION-nNumberOfLinks ] - ! [ - ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexLow ] - ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexHigh ] bi >64bit - ! ] - } cleave ; - -: get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION ) - [ - "BY_HANDLE_FILE_INFORMATION" - [ GetFileInformationByHandle win32-error=0/f ] keep - ] keep CloseHandle win32-error=0/f ; - -: get-file-information-stat ( path -- BY_HANDLE_FILE_INFORMATION ) - dup - GENERIC_READ FILE_SHARE_READ f - OPEN_EXISTING FILE_FLAG_BACKUP_SEMANTICS f - CreateFileW dup INVALID_HANDLE_VALUE = [ - drop find-first-file-stat WIN32_FIND_DATA>file-info - ] [ - nip - get-file-information BY_HANDLE_FILE_INFORMATION>file-info - ] if ; - -M: winnt file-info ( path -- info ) - normalize-path get-file-information-stat ; - -M: winnt link-info ( path -- info ) - file-info ; - -HOOK: root-directory os ( string -- string' ) - -: volume-information ( normalized-path -- volume-name volume-serial max-component flags type ) - MAX_PATH 1+ [ ] keep - "DWORD" - "DWORD" - "DWORD" - MAX_PATH 1+ [ ] keep - [ GetVolumeInformation win32-error=0/f ] 7 nkeep - drop 5 nrot drop - [ utf16n alien>string ] 4 ndip - utf16n alien>string ; - -: file-system-space ( normalized-path -- available-space total-space free-space ) - "ULARGE_INTEGER" - "ULARGE_INTEGER" - "ULARGE_INTEGER" - [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ; - -: calculate-file-system-info ( file-system-info -- file-system-info' ) - { - [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] - [ ] - } cleave ; - -TUPLE: win32-file-system-info < file-system-info max-component flags device-serial ; - -M: winnt file-system-info ( path -- file-system-info ) - normalize-path root-directory - dup [ volume-information ] [ file-system-space ] bi - \ win32-file-system-info new - swap *ulonglong >>free-space - swap *ulonglong >>total-space - swap *ulonglong >>available-space - swap >>type - swap *uint >>flags - swap *uint >>max-component - swap *uint >>device-serial - swap >>device-name - swap >>mount-point - calculate-file-system-info ; - -: volume>paths ( string -- array ) - 16384 "ushort" tuck dup length - 0 dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [ - win32-error-string throw - ] [ - *uint "ushort" heap-size * head - utf16n alien>string CHAR: \0 split - ] if ; - -: find-first-volume ( -- string handle ) - MAX_PATH 1+ [ ] keep - dupd - FindFirstVolume dup win32-error=0/f - [ utf16n alien>string ] dip ; - -: find-next-volume ( handle -- string/f ) - MAX_PATH 1+ [ tuck ] keep - FindNextVolume 0 = [ - GetLastError ERROR_NO_MORE_FILES = - [ drop f ] [ win32-error-string throw ] if - ] [ - utf16n alien>string - ] if ; - -: find-volumes ( -- array ) - find-first-volume - [ - '[ - [ _ find-next-volume dup ] - [ ] - [ drop ] produce - swap prefix - ] - ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ; - -M: winnt file-systems ( -- array ) - find-volumes [ volume>paths ] map - concat [ - [ file-system-info ] - [ drop \ file-system-info new swap >>mount-point ] recover - ] map ; - -: file-times ( path -- timestamp timestamp timestamp ) - [ - normalize-path open-existing &dispose handle>> - "FILETIME" - "FILETIME" - "FILETIME" - [ GetFileTime win32-error=0/f ] 3keep - [ FILETIME>timestamp >local-time ] tri@ - ] with-destructors ; - -: (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- ) - [ timestamp>FILETIME ] tri@ - SetFileTime win32-error=0/f ; - -: set-file-times ( path timestamp/f timestamp/f timestamp/f -- ) - #! timestamp order: creation access write - [ - [ - normalize-path open-existing &dispose handle>> - ] 3dip (set-file-times) - ] with-destructors ; - -: set-file-create-time ( path timestamp -- ) - f f set-file-times ; - -: set-file-access-time ( path timestamp -- ) - [ f ] dip f set-file-times ; - -: set-file-write-time ( path timestamp -- ) - [ f f ] dip set-file-times ; - -M: winnt touch-file ( path -- ) - [ - normalize-path - maybe-create-file [ &dispose ] dip - [ drop ] [ handle>> f now dup (set-file-times) ] if - ] with-destructors ; diff --git a/basis/io/files/windows/nt/files-tests.factor b/basis/io/files/windows/nt/nt-tests.factor similarity index 100% rename from basis/io/files/windows/nt/files-tests.factor rename to basis/io/files/windows/nt/nt-tests.factor diff --git a/basis/io/files/windows/nt/files.factor b/basis/io/files/windows/nt/nt.factor similarity index 86% rename from basis/io/files/windows/nt/files.factor rename to basis/io/files/windows/nt/nt.factor index b50b4cfa3d..f3a534388a 100755 --- a/basis/io/files/windows/nt/files.factor +++ b/basis/io/files/windows/nt/nt.factor @@ -29,16 +29,6 @@ M: winnt root-directory? ( path -- ? ) [ drop f ] } cond ; -ERROR: not-absolute-path ; - -M: winnt root-directory ( string -- string' ) - unicode-prefix ?head drop - dup { - [ length 2 >= ] - [ second CHAR: : = ] - [ first Letter? ] - } 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ; - : prepend-prefix ( string -- string' ) dup unicode-prefix head? [ unicode-prefix prepend diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor new file mode 100755 index 0000000000..30915f8c71 --- /dev/null +++ b/basis/io/files/windows/windows.factor @@ -0,0 +1,139 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types io.binary io.backend io.files io.buffers +io.encodings.utf16n io.ports io.backend.windows kernel math splitting +fry alien.strings windows windows.kernel32 windows.time calendar +combinators math.functions sequences namespaces make words +symbols system destructors accessors math.bitwise continuations +windows.errors arrays byte-arrays generalizations ; +IN: io.files.windows + +: open-file ( path access-mode create-mode flags -- handle ) + [ + [ share-mode default-security-attributes ] 2dip + CreateFile-flags f CreateFile opened-file + ] with-destructors ; + +: open-pipe-r/w ( path -- win32-file ) + { GENERIC_READ GENERIC_WRITE } flags + OPEN_EXISTING 0 open-file ; + +: open-read ( path -- win32-file ) + GENERIC_READ OPEN_EXISTING 0 open-file 0 >>ptr ; + +: open-write ( path -- win32-file ) + GENERIC_WRITE CREATE_ALWAYS 0 open-file 0 >>ptr ; + +: (open-append) ( path -- win32-file ) + GENERIC_WRITE OPEN_ALWAYS 0 open-file ; + +: open-existing ( path -- win32-file ) + { GENERIC_READ GENERIC_WRITE } flags + share-mode + f + OPEN_EXISTING + FILE_FLAG_BACKUP_SEMANTICS + f CreateFileW dup win32-error=0/f ; + +: maybe-create-file ( path -- win32-file ? ) + #! return true if file was just created + { GENERIC_READ GENERIC_WRITE } flags + share-mode + f + OPEN_ALWAYS + 0 CreateFile-flags + f CreateFileW dup win32-error=0/f + GetLastError ERROR_ALREADY_EXISTS = not ; + +: set-file-pointer ( handle length method -- ) + [ dupd d>w/w ] dip SetFilePointer + INVALID_SET_FILE_POINTER = [ + CloseHandle "SetFilePointer failed" throw + ] when drop ; + +HOOK: open-append os ( path -- win32-file ) + +TUPLE: FileArgs + hFile lpBuffer nNumberOfBytesToRead + lpNumberOfBytesRet lpOverlapped ; + +C: FileArgs + +: make-FileArgs ( port -- ) + { + [ handle>> check-disposed ] + [ handle>> handle>> ] + [ buffer>> ] + [ buffer>> buffer-length ] + [ drop "DWORD" ] + [ FileArgs-overlapped ] + } cleave ; + +: setup-read ( -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped ) + { + [ hFile>> ] + [ lpBuffer>> buffer-end ] + [ lpBuffer>> buffer-capacity ] + [ lpNumberOfBytesRet>> ] + [ lpOverlapped>> ] + } cleave ; + +: setup-write ( -- hFile lpBuffer nNumberOfBytesToWrite lpNumberOfBytesWritten lpOverlapped ) + { + [ hFile>> ] + [ lpBuffer>> buffer@ ] + [ lpBuffer>> buffer-length ] + [ lpNumberOfBytesRet>> ] + [ lpOverlapped>> ] + } cleave ; + +M: windows (file-reader) ( path -- stream ) + open-read ; + +M: windows (file-writer) ( path -- stream ) + open-write ; + +M: windows (file-appender) ( path -- stream ) + open-append ; + +SYMBOLS: +read-only+ +hidden+ +system+ ++archive+ +device+ +normal+ +temporary+ ++sparse-file+ +reparse-point+ +compressed+ +offline+ ++not-content-indexed+ +encrypted+ ; + +: win32-file-attribute ( n attr symbol -- ) + rot mask? [ , ] [ drop ] if ; + +: win32-file-attributes ( n -- seq ) + [ + { + [ +read-only+ FILE_ATTRIBUTE_READONLY win32-file-attribute ] + [ +hidden+ FILE_ATTRIBUTE_HIDDEN win32-file-attribute ] + [ +system+ FILE_ATTRIBUTE_SYSTEM win32-file-attribute ] + [ +directory+ FILE_ATTRIBUTE_DIRECTORY win32-file-attribute ] + [ +archive+ FILE_ATTRIBUTE_ARCHIVE win32-file-attribute ] + [ +device+ FILE_ATTRIBUTE_DEVICE win32-file-attribute ] + [ +normal+ FILE_ATTRIBUTE_NORMAL win32-file-attribute ] + [ +temporary+ FILE_ATTRIBUTE_TEMPORARY win32-file-attribute ] + [ +sparse-file+ FILE_ATTRIBUTE_SPARSE_FILE win32-file-attribute ] + [ +reparse-point+ FILE_ATTRIBUTE_REPARSE_POINT win32-file-attribute ] + [ +compressed+ FILE_ATTRIBUTE_COMPRESSED win32-file-attribute ] + [ +offline+ FILE_ATTRIBUTE_OFFLINE win32-file-attribute ] + [ +not-content-indexed+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED win32-file-attribute ] + [ +encrypted+ FILE_ATTRIBUTE_ENCRYPTED win32-file-attribute ] + } cleave + ] { } make ; + +: win32-file-type ( n -- symbol ) + FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ; + +: (set-file-times) ( handle timestamp/f timestamp/f timestamp/f -- ) + [ timestamp>FILETIME ] tri@ + SetFileTime win32-error=0/f ; + +M: winnt touch-file ( path -- ) + [ + normalize-path + maybe-create-file [ &dispose ] dip + [ drop ] [ handle>> f now dup (set-file-times) ] if + ] with-destructors ;