]> gitweb.factorcode.org Git - factor.git/commitdiff
io.files.info.windows: Fix file-systems word in two ways. First, don't
authorDoug Coleman <doug.coleman@gmail.com>
Thu, 21 Jun 2012 15:32:53 +0000 (08:32 -0700)
committerDoug Coleman <doug.coleman@gmail.com>
Thu, 21 Jun 2012 15:32:53 +0000 (08:32 -0700)
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.

12 files changed:
basis/environment/windows/windows.factor
basis/game/input/dinput/dinput.factor
basis/game/input/xinput/xinput.factor
basis/io/directories/windows/windows.factor
basis/io/files/info/windows/windows.factor
basis/io/files/temp/windows/windows.factor
basis/io/files/windows/windows.factor
basis/tools/deploy/libraries/windows/windows.factor
basis/ui/backend/windows/windows.factor
basis/windows/errors/errors.factor
basis/windows/shell32/shell32.factor
extra/io/files/trash/windows/windows.factor

index dbadff376196e9e0f9e509679f1e0b08df86e188..d3a4a3f4372c912aac30f3d285b98ebb037d42eb 100644 (file)
@@ -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 -- )
index b883e24e77c05bd82edb33a718fe2defdf017d6c..98f8a681f4bf09c0c30ba29a8e92b2ea58b5d08a 100755 (executable)
@@ -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>> ;
index 034c9490856eac081447b71fe47117900a41f106..70b5e14fa2ddb4d98cf99602822d305ad728d3ef 100644 (file)
@@ -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
index 68c7a5bd079d945ab7836a1ed26193e88e8e1e40..46ce2ec44101d979f76bba8b63308049c369c7f5 100644 (file)
@@ -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
index 417a2353c2331f2dd5ac6226874a4d7b3e768a4c..3b349403d0fe9132c06ba453f365435e6515aff4 100755 (executable)
@@ -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 <ref>
+        [ 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 )
index 66e9e94bf7d44bdd07782a735345b1b63135ec5a..3d1a66a824ac690370e332fa6fb1ebd126d6c2b8 100644 (file)
@@ -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 <c-array> [ 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 <c-array>
     [ SHGetFolderPath ] keep
     swap ole32-error
-    utf16n alien>string ;
+    alien>native-string ;
 
 PRIVATE>
 
index 269865fb723ffe0b5597ebf1e9a8b634337f5e13..3617a126f7a01a9b8f71553be23570b6bd967394 100755 (executable)
@@ -327,8 +327,7 @@ SLOT: attributes
 
 M: windows cwd
     MAX_UNICODE_PATH dup ushort <c-array>
-    [ 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 ;
index 82fd5179fa154bd30c666a65c1e0e5921bea710c..4d56b48418581408bd36440598c6f28090781594 100644 (file)
@@ -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* ;
 
index 215da172d13a9dd6a2159ce382a15a22e21979b6..c3ff0b50f22e13bcdaebc761e9ccb58a98d771b5 100755 (executable)
@@ -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
index 6d8f0e29079e42c8dc39963bd3a6a4febe031b35..d59315a3c71135e617d1731ae03cb69fa5cac6e4 100755 (executable)
@@ -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 ;
index 4f83de503f5b2085d39a39af5b526f847dce999a..6bb7dea69d02b64cf1c4f2e028485339844d3fc2 100644 (file)
@@ -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 <c-array>
-    [ SHGetFolderPath drop ] keep utf16n alien>string ;
+    [ SHGetFolderPath drop ] keep alien>native-string ;
 
 : desktop ( -- str )
     CSIDL_DESKTOPDIRECTORY shell32-directory ;
index 1e198d3c9ab020d892766ee3878195b67f9b0bfd..788eb3a84d22698d56984116da80995532b0a50e 100644 (file)
@@ -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 <struct>