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.
Doug Coleman 2012-06-21 08:32:53 -07:00
parent 47a977277a
commit bbf5cfbc4d
12 changed files with 45 additions and 42 deletions

View 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 -- )

View File

@ -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>> ;

View 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

View 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

View File

@ -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 )

View 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>

View File

@ -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 ;

View 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* ;

View File

@ -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

View File

@ -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 ;

View 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 ;

View 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>