From: Doug Coleman Date: Thu, 21 Jun 2012 15:32:53 +0000 (-0700) Subject: io.files.info.windows: Fix file-systems word in two ways. First, don't X-Git-Tag: 0.97~2992 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=eccf5a82ae6acae657942be2819294eff1242810 io.files.info.windows: Fix file-systems word in two ways. First, don't allocate 32k on the local alloc stack (which causes a 'double fault.') Second, if the volume doesnt look up to a real path, don't make a dummy object for that. volume Use alien>native-string and native-string>alien wherever possible instead of utf16n for Windows. --- diff --git a/basis/environment/windows/windows.factor b/basis/environment/windows/windows.factor index dbadff3761..d3a4a3f437 100644 --- a/basis/environment/windows/windows.factor +++ b/basis/environment/windows/windows.factor @@ -12,7 +12,7 @@ M: windows os-env ( key -- value ) [ dup length GetEnvironmentVariable ] keep over 0 = [ 2drop f ] [ - nip utf16n alien>string + nip alien>native-string ] if ; M: windows set-os-env ( value key -- ) diff --git a/basis/game/input/dinput/dinput.factor b/basis/game/input/dinput/dinput.factor index b883e24e77..98f8a681f4 100755 --- a/basis/game/input/dinput/dinput.factor +++ b/basis/game/input/dinput/dinput.factor @@ -1,7 +1,7 @@ USING: accessors alien alien.c-types alien.data alien.strings arrays assocs byte-arrays combinators combinators.short-circuit continuations game.input game.input.dinput.keys-array -io.encodings.utf16 io.encodings.utf16n kernel locals math +io.encodings.utf16n kernel locals math math.bitwise math.rectangles namespaces parser sequences shuffle specialized-arrays ui.backend.windows vectors windows.com windows.directx.dinput windows.directx.dinput.constants @@ -259,7 +259,7 @@ M: dinput-game-input-backend get-controllers M: dinput-game-input-backend product-string handle>> device-info tszProductName>> - utf16n alien>string ; + alien>native-string ; M: dinput-game-input-backend product-id handle>> device-info guidProduct>> ; diff --git a/basis/game/input/xinput/xinput.factor b/basis/game/input/xinput/xinput.factor index 034c949085..70b5e14fa2 100644 --- a/basis/game/input/xinput/xinput.factor +++ b/basis/game/input/xinput/xinput.factor @@ -1,7 +1,7 @@ USING: game.input math math.order kernel macros fry sequences quotations arrays windows.directx.xinput combinators accessors windows.types game.input.dinput sequences.private namespaces classes.struct -windows.errors windows.com.syntax io.encodings.utf16n alien.strings ; +windows.errors windows.com.syntax alien.strings ; IN: game.input.xinput SINGLETON: xinput-game-input-backend @@ -98,7 +98,7 @@ M: xinput-game-input-backend get-controllers M: xinput-game-input-backend product-string dup number? [ drop "Controller (Xbox 360 Wireless Receiver for Windows)" ] - [ handle>> device-info tszProductName>> utf16n alien>string ] + [ handle>> device-info tszProductName>> alien>native-string ] if ; M: xinput-game-input-backend product-id diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor index 68c7a5bd07..46ce2ec441 100644 --- a/basis/io/directories/windows/windows.factor +++ b/basis/io/directories/windows/windows.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: system io.directories io.encodings.utf16n alien.strings +USING: system io.directories alien.strings io.pathnames io.backend io.files.windows destructors kernel accessors calendar windows windows.errors windows.kernel32 alien.c-types sequences splitting @@ -64,7 +64,7 @@ M: windows delete-directory ( path -- ) TUPLE: windows-directory-entry < directory-entry attributes ; M: windows >directory-entry ( byte-array -- directory-entry ) - [ cFileName>> utf16n alien>string ] + [ cFileName>> alien>native-string ] [ dwFileAttributes>> [ win32-file-type ] [ win32-file-attributes ] bi diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index 417a2353c2..3b349403d0 100755 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -4,11 +4,12 @@ USING: byte-arrays math io.backend io.files.info io.files.windows kernel windows.kernel32 windows.time windows.types windows accessors alien.c-types combinators generalizations system alien.strings -io.encodings.utf16n sequences splitting windows.errors fry +sequences splitting windows.errors fry continuations destructors calendar ascii combinators.short-circuit literals locals classes.struct -specialized-arrays alien.data ; +specialized-arrays alien.data libc ; SPECIALIZED-ARRAY: ushort +QUALIFIED: sequences IN: io.files.info.windows :: round-up-to ( n multiple -- n' ) @@ -101,7 +102,7 @@ CONSTANT: path-length $[ MAX_PATH 1 + ] { { ushort path-length } DWORD DWORD DWORD { ushort path-length } } [ [ path-length ] 4dip path-length GetVolumeInformation win32-error=0/f ] with-out-parameters - [ utf16n alien>string ] 4dip utf16n alien>string ; + [ alien>native-string ] 4dip alien>native-string ; : file-system-space ( normalized-path -- available-space total-space free-space ) { ULARGE_INTEGER ULARGE_INTEGER ULARGE_INTEGER } @@ -146,16 +147,10 @@ M: windows file-system-info ( path -- file-system-info ) CONSTANT: names-buf-length 16384 -: volume>paths ( string -- array ) - { { ushort names-buf-length } uint } - [ [ names-buf-length ] dip GetVolumePathNamesForVolumeName win32-error=0/f ] - with-out-parameters - head utf16n alien>string { CHAR: \0 } split ; - : find-first-volume ( -- string handle ) { { ushort path-length } } [ path-length FindFirstVolume dup win32-error=0/f ] - with-out-parameters utf16n alien>string swap ; + with-out-parameters alien>native-string swap ; : find-next-volume ( handle -- string/f ) { { ushort path-length } } @@ -163,7 +158,7 @@ CONSTANT: names-buf-length 16384 swap 0 = [ GetLastError ERROR_NO_MORE_FILES = [ drop f ] [ win32-error-string throw ] if - ] [ utf16n alien>string ] if ; + ] [ alien>native-string ] if ; : find-volumes ( -- array ) find-first-volume @@ -174,11 +169,22 @@ CONSTANT: names-buf-length 16384 ] ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ; +! Windows may return a volume which looks up to path "" +! For now, treat it like there is not a volume here +: volume>paths ( string -- array ) + [ + names-buf-length + [ ushort malloc-array &free ] keep + 0 uint + [ GetVolumePathNamesForVolumeName win32-error=0/f ] 3keep nip + uint deref head but-last-slice + { 0 } split* + [ { } ] [ [ alien>native-string ] map ] if-empty + ] with-destructors ; + M: windows file-systems ( -- array ) - find-volumes [ volume>paths ] map - concat [ - [ (file-system-info) ] - [ drop \ file-system-info new swap >>mount-point ] recover + find-volumes [ volume>paths ] map concat [ + (file-system-info) ] map ; : file-times ( path -- timestamp timestamp timestamp ) diff --git a/basis/io/files/temp/windows/windows.factor b/basis/io/files/temp/windows/windows.factor index 66e9e94bf7..3d1a66a824 100644 --- a/basis/io/files/temp/windows/windows.factor +++ b/basis/io/files/temp/windows/windows.factor @@ -1,6 +1,6 @@ ! (c)2012 Joe Groff bsd license USING: alien.data alien.strings io.directories -io.encodings.utf16n io.files.temp io.pathnames kernel math +io.files.temp io.pathnames kernel math memoize specialized-arrays system windows.errors windows.kernel32 windows.ole32 windows.shell32 windows.types ; @@ -12,7 +12,7 @@ IN: io.files.temp.windows : (get-temp-directory) ( -- path ) MAX_PATH 1 + dup WCHAR [ GetTempPath ] keep swap win32-error=0/f - utf16n alien>string ; + alien>native-string ; : (get-appdata-directory) ( -- path ) f @@ -22,7 +22,7 @@ IN: io.files.temp.windows MAX_PATH 1 + WCHAR [ SHGetFolderPath ] keep swap ole32-error - utf16n alien>string ; + alien>native-string ; PRIVATE> diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 269865fb72..3617a126f7 100755 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -327,8 +327,7 @@ SLOT: attributes M: windows cwd MAX_UNICODE_PATH dup ushort - [ GetCurrentDirectory win32-error=0/f ] keep - utf16n alien>string ; + [ GetCurrentDirectory win32-error=0/f ] keep alien>native-string ; M: windows cd SetCurrentDirectory win32-error=0/f ; diff --git a/basis/tools/deploy/libraries/windows/windows.factor b/basis/tools/deploy/libraries/windows/windows.factor index 82fd5179fa..4d56b48418 100644 --- a/basis/tools/deploy/libraries/windows/windows.factor +++ b/basis/tools/deploy/libraries/windows/windows.factor @@ -1,5 +1,5 @@ ! (c)2010 Joe Groff bsd license -USING: alien.data alien.strings byte-arrays io.encodings.utf16n +USING: alien.data alien.strings byte-arrays kernel specialized-arrays system tools.deploy.libraries windows.kernel32 windows.types ; FROM: alien.c-types => ushort ; @@ -10,7 +10,7 @@ M: windows find-library-file f DONT_RESOLVE_DLL_REFERENCES LoadLibraryEx [ [ 32768 ushort (c-array) [ 32768 GetModuleFileName drop ] keep - utf16n alien>string + alien>native-string ] [ FreeLibrary drop ] bi ] [ f ] if* ; diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 215da172d1..c3ff0b50f2 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -201,14 +201,14 @@ PRIVATE> CF_UNICODETEXT GetClipboardData dup win32-error=0/f dup GlobalLock dup win32-error=0/f GlobalUnlock win32-error=0/f - utf16n alien>string + alien>native-string ] if ] with-clipboard crlf>lf ; : copy ( str -- ) lf>crlf [ - utf16n string>alien + native-string>alien EmptyClipboard win32-error=0/f GMEM_MOVEABLE over length 1 + GlobalAlloc dup win32-error=0/f @@ -642,7 +642,7 @@ M: windows-ui-backend do-events 0 >>cbClsExtra 0 >>cbWndExtra f GetModuleHandle >>hInstance - f GetModuleHandle "APPICON" utf16n string>alien LoadIcon >>hIcon + f GetModuleHandle "APPICON" native-string>alien LoadIcon >>hIcon f IDC_ARROW LoadCursor >>hCursor class-name-ptr >>lpszClassName diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index 6d8f0e2907..d59315a3c7 100755 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -1,8 +1,7 @@ USING: alien.data kernel locals math math.bitwise windows.kernel32 sequences byte-arrays unicode.categories -io.encodings.string io.encodings.utf16n alien.strings -arrays literals windows.types specialized-arrays -math.parser ; +io.encodings.string alien.strings arrays literals +windows.types specialized-arrays math.parser ; SPECIALIZED-ARRAY: TCHAR IN: windows.errors @@ -716,7 +715,7 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK 0x000000FF f pick [ FormatMessage ] dip swap zero? [ drop "Unknown error 0x" id 0xffff,ffff bitand >hex append ] - [ utf16n alien>string [ blank? ] trim ] if ; + [ alien>native-string [ blank? ] trim ] if ; : win32-error-string ( -- str ) GetLastError n>win32-error-string ; diff --git a/basis/windows/shell32/shell32.factor b/basis/windows/shell32/shell32.factor index 4f83de503f..6bb7dea69d 100644 --- a/basis/windows/shell32/shell32.factor +++ b/basis/windows/shell32/shell32.factor @@ -1,10 +1,9 @@ ! Copyright (C) 2006, 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.data alien.strings alien.syntax -classes.struct combinators io.encodings.utf16n io.files -io.pathnames kernel windows.errors windows.com -windows.com.syntax windows.types windows.user32 -windows.ole32 windows specialized-arrays ; +classes.struct combinators io.files io.pathnames kernel +windows.errors windows.com windows.com.syntax windows.types +windows.user32 windows.ole32 windows specialized-arrays ; SPECIALIZED-ARRAY: ushort IN: windows.shell32 @@ -90,7 +89,7 @@ ALIAS: ShellExecute ShellExecuteW : shell32-directory ( n -- str ) f swap f SHGFP_TYPE_DEFAULT MAX_UNICODE_PATH ushort - [ SHGetFolderPath drop ] keep utf16n alien>string ; + [ SHGetFolderPath drop ] keep alien>native-string ; : desktop ( -- str ) CSIDL_DESKTOPDIRECTORY shell32-directory ; diff --git a/extra/io/files/trash/windows/windows.factor b/extra/io/files/trash/windows/windows.factor index 1e198d3c9a..788eb3a84d 100644 --- a/extra/io/files/trash/windows/windows.factor +++ b/extra/io/files/trash/windows/windows.factor @@ -52,7 +52,7 @@ PRIVATE> M: windows send-to-trash ( path -- ) [ - utf16n string>alien B{ 0 0 } append + native-string>alien B{ 0 0 } append malloc-byte-array &free SHFILEOPSTRUCTW