Merge branch 'master' of git://factorcode.org/git/factor
Joe Groff
commit
c3002ed0f0
|
|
@ -3,7 +3,7 @@ destructors io io.backend io.ports io.timeouts io.backend.windows
|
|||
io.files.windows io.files.windows.nt io.files io.pathnames io.buffers
|
||||
io.streams.c io.streams.null libc kernel math namespaces sequences
|
||||
threads windows windows.errors windows.kernel32 strings splitting
|
||||
ascii system accessors locals ;
|
||||
ascii system accessors locals classes.struct combinators.short-circuit ;
|
||||
QUALIFIED: windows.winsock
|
||||
IN: io.backend.windows.nt
|
||||
|
||||
|
|
@ -36,7 +36,7 @@ M: winnt add-completion ( win32-handle -- )
|
|||
handle>> master-completion-port get-global <completion-port> drop ;
|
||||
|
||||
: eof? ( error -- ? )
|
||||
[ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] bi or ;
|
||||
{ [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] } 1|| ;
|
||||
|
||||
: twiddle-thumbs ( overlapped port -- bytes-transferred )
|
||||
[
|
||||
|
|
@ -66,9 +66,9 @@ M: winnt add-completion ( win32-handle -- )
|
|||
|
||||
: handle-overlapped ( us -- ? )
|
||||
wait-for-overlapped [
|
||||
dup [
|
||||
[
|
||||
[ drop GetLastError 1array ] dip resume-callback t
|
||||
] [ 2drop f ] if
|
||||
] [ drop f ] if*
|
||||
] [ resume-callback t ] if ;
|
||||
|
||||
M: win32-handle cancel-operation
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@ USING: alien alien.c-types arrays destructors io io.backend
|
|||
io.buffers io.files io.ports io.binary io.timeouts system
|
||||
strings kernel math namespaces sequences windows.errors
|
||||
windows.kernel32 windows.shell32 windows.types windows.winsock
|
||||
splitting continuations math.bitwise accessors init sets assocs ;
|
||||
splitting continuations math.bitwise accessors init sets assocs
|
||||
classes.struct classes ;
|
||||
IN: io.backend.windows
|
||||
|
||||
TUPLE: win32-handle < disposable handle ;
|
||||
|
|
@ -50,6 +51,5 @@ HOOK: add-completion io-backend ( port -- )
|
|||
} flags ; foldable
|
||||
|
||||
: default-security-attributes ( -- obj )
|
||||
"SECURITY_ATTRIBUTES" <c-object>
|
||||
"SECURITY_ATTRIBUTES" heap-size
|
||||
over set-SECURITY_ATTRIBUTES-nLength ;
|
||||
SECURITY_ATTRIBUTES <struct>
|
||||
dup class heap-size >>nLength ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test io.files.info.windows system kernel ;
|
||||
IN: io.files.info.windows.tests
|
||||
|
||||
[ ] [ vm file-times 3drop ] unit-test
|
||||
|
|
@ -5,7 +5,7 @@ io.files.windows io.files.windows.nt kernel windows.kernel32
|
|||
windows.time windows accessors alien.c-types combinators
|
||||
generalizations system alien.strings io.encodings.utf16n
|
||||
sequences splitting windows.errors fry continuations destructors
|
||||
calendar ascii combinators.short-circuit locals ;
|
||||
calendar ascii combinators.short-circuit locals classes.struct ;
|
||||
IN: io.files.info.windows
|
||||
|
||||
:: round-up-to ( n multiple -- n' )
|
||||
|
|
@ -57,35 +57,26 @@ TUPLE: windows-file-info < file-info attributes ;
|
|||
: 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 ]
|
||||
[ dwFileAttributes>> win32-file-type >>type ]
|
||||
[ dwFileAttributes>> win32-file-attributes >>attributes ]
|
||||
[
|
||||
[ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ]
|
||||
[ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size
|
||||
[ nFileSizeLow>> ]
|
||||
[ 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 ]
|
||||
[ dwFileAttributes>> >>permissions ]
|
||||
[ ftCreationTime>> FILETIME>timestamp >>created ]
|
||||
[ ftLastWriteTime>> FILETIME>timestamp >>modified ]
|
||||
[ ftLastAccessTime>> FILETIME>timestamp >>accessed ]
|
||||
! [ nNumberOfLinks>> ]
|
||||
! [
|
||||
! [ BY_HANDLE_FILE_INFORMATION-nFileIndexLow ]
|
||||
! [ BY_HANDLE_FILE_INFORMATION-nFileIndexHigh ] bi >64bit
|
||||
! [ nFileIndexLow>> ]
|
||||
! [ nFileIndexHigh>> ] bi >64bit
|
||||
! ]
|
||||
} cleave ;
|
||||
|
||||
: get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION )
|
||||
[
|
||||
"BY_HANDLE_FILE_INFORMATION" <c-object>
|
||||
BY_HANDLE_FILE_INFORMATION <struct>
|
||||
[ GetFileInformationByHandle win32-error=0/f ] keep
|
||||
] keep CloseHandle win32-error=0/f ;
|
||||
|
||||
|
|
@ -197,10 +188,10 @@ M: winnt file-systems ( -- array )
|
|||
|
||||
: file-times ( path -- timestamp timestamp timestamp )
|
||||
[
|
||||
normalize-path open-existing &dispose handle>>
|
||||
"FILETIME" <c-object>
|
||||
"FILETIME" <c-object>
|
||||
"FILETIME" <c-object>
|
||||
normalize-path open-read &dispose handle>>
|
||||
FILETIME <struct>
|
||||
FILETIME <struct>
|
||||
FILETIME <struct>
|
||||
[ GetFileTime win32-error=0/f ] 3keep
|
||||
[ FILETIME>timestamp >local-time ] tri@
|
||||
] with-destructors ;
|
||||
|
|
|
|||
|
|
@ -85,7 +85,7 @@ IN: io.launcher.windows.nt
|
|||
: redirect-stderr ( process args -- handle )
|
||||
over stderr>> +stdout+ eq? [
|
||||
nip
|
||||
lpStartupInfo>> STARTUPINFO-hStdOutput
|
||||
lpStartupInfo>> hStdOutput>>
|
||||
] [
|
||||
drop
|
||||
stderr>>
|
||||
|
|
@ -104,7 +104,7 @@ IN: io.launcher.windows.nt
|
|||
STD_INPUT_HANDLE GetStdHandle or ;
|
||||
|
||||
M: winnt fill-redirection ( process args -- )
|
||||
[ 2dup redirect-stdout ] keep lpStartupInfo>> set-STARTUPINFO-hStdOutput
|
||||
[ 2dup redirect-stderr ] keep lpStartupInfo>> set-STARTUPINFO-hStdError
|
||||
[ 2dup redirect-stdin ] keep lpStartupInfo>> set-STARTUPINFO-hStdInput
|
||||
2drop ;
|
||||
dup lpStartupInfo>>
|
||||
[ [ redirect-stdout ] dip (>>hStdOutput) ]
|
||||
[ [ redirect-stderr ] dip (>>hStdError) ]
|
||||
[ [ redirect-stdin ] dip (>>hStdInput) ] 3tri ;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ namespaces make io.launcher kernel sequences windows.errors
|
|||
splitting system threads init strings combinators
|
||||
io.backend accessors concurrency.flags io.files assocs
|
||||
io.files.private windows destructors specialized-arrays.ushort
|
||||
specialized-arrays.alien ;
|
||||
specialized-arrays.alien classes classes.struct ;
|
||||
IN: io.launcher.windows
|
||||
|
||||
TUPLE: CreateProcess-args
|
||||
|
|
@ -24,9 +24,10 @@ TUPLE: CreateProcess-args
|
|||
|
||||
: default-CreateProcess-args ( -- obj )
|
||||
CreateProcess-args new
|
||||
"STARTUPINFO" <c-object>
|
||||
"STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo
|
||||
"PROCESS_INFORMATION" <c-object> >>lpProcessInformation
|
||||
STARTUPINFO <struct>
|
||||
dup class heap-size >>cb
|
||||
>>lpStartupInfo
|
||||
PROCESS_INFORMATION <struct> >>lpProcessInformation
|
||||
TRUE >>bInheritHandles
|
||||
0 >>dwCreateFlags ;
|
||||
|
||||
|
|
@ -108,7 +109,7 @@ TUPLE: CreateProcess-args
|
|||
] when ;
|
||||
|
||||
: fill-startup-info ( process args -- process args )
|
||||
STARTF_USESTDHANDLES over lpStartupInfo>> set-STARTUPINFO-dwFlags ;
|
||||
dup lpStartupInfo>> STARTF_USESTDHANDLES >>dwFlags drop ;
|
||||
|
||||
HOOK: fill-redirection io-backend ( process args -- )
|
||||
|
||||
|
|
@ -136,17 +137,16 @@ M: windows run-process* ( process -- handle )
|
|||
] with-destructors ;
|
||||
|
||||
M: windows kill-process* ( handle -- )
|
||||
PROCESS_INFORMATION-hProcess
|
||||
255 TerminateProcess win32-error=0/f ;
|
||||
hProcess>> 255 TerminateProcess win32-error=0/f ;
|
||||
|
||||
: dispose-process ( process-information -- )
|
||||
#! From MSDN: "Handles in PROCESS_INFORMATION must be closed
|
||||
#! with CloseHandle when they are no longer needed."
|
||||
dup PROCESS_INFORMATION-hProcess [ CloseHandle drop ] when*
|
||||
PROCESS_INFORMATION-hThread [ CloseHandle drop ] when* ;
|
||||
[ hProcess>> [ CloseHandle drop ] when* ]
|
||||
[ hThread>> [ CloseHandle drop ] when* ] bi ;
|
||||
|
||||
: exit-code ( process -- n )
|
||||
PROCESS_INFORMATION-hProcess
|
||||
hProcess>>
|
||||
0 <ulong> [ GetExitCodeProcess ] keep *ulong
|
||||
swap win32-error=0/f ;
|
||||
|
||||
|
|
@ -157,7 +157,7 @@ M: windows kill-process* ( handle -- )
|
|||
|
||||
M: windows wait-for-processes ( -- ? )
|
||||
processes get keys dup
|
||||
[ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as
|
||||
[ handle>> hProcess>> ] void*-array{ } map-as
|
||||
[ length ] keep 0 0
|
||||
WaitForMultipleObjects
|
||||
dup HEX: ffffffff = [ win32-error ] when
|
||||
|
|
|
|||
|
|
@ -1,12 +1,13 @@
|
|||
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays accessors io.backend io.streams.c init fry namespaces
|
||||
math make assocs kernel parser parser.notes lexer strings.parser
|
||||
vocabs sequences sequences.private words memory kernel.private
|
||||
continuations io vocabs.loader system strings sets vectors quotations
|
||||
byte-arrays sorting compiler.units definitions generic
|
||||
generic.standard generic.single tools.deploy.config combinators
|
||||
classes classes.builtin slots.private grouping ;
|
||||
USING: arrays accessors io.backend io.streams.c init fry
|
||||
namespaces math make assocs kernel parser parser.notes lexer
|
||||
strings.parser vocabs sequences sequences.deep sequences.private
|
||||
words memory kernel.private continuations io vocabs.loader
|
||||
system strings sets vectors quotations byte-arrays sorting
|
||||
compiler.units definitions generic generic.standard
|
||||
generic.single tools.deploy.config combinators classes
|
||||
classes.builtin slots.private grouping ;
|
||||
QUALIFIED: bootstrap.stage2
|
||||
QUALIFIED: command-line
|
||||
QUALIFIED: compiler.errors
|
||||
|
|
@ -120,6 +121,7 @@ IN: tools.deploy.shaker
|
|||
"combination"
|
||||
"compiled-generic-uses"
|
||||
"compiled-uses"
|
||||
"constant"
|
||||
"constraints"
|
||||
"custom-inlining"
|
||||
"decision-tree"
|
||||
|
|
@ -145,6 +147,7 @@ IN: tools.deploy.shaker
|
|||
"local-writer"
|
||||
"local-writer?"
|
||||
"local?"
|
||||
"low-order"
|
||||
"macro"
|
||||
"members"
|
||||
"memo-quot"
|
||||
|
|
@ -456,11 +459,13 @@ SYMBOL: deploy-vocab
|
|||
[ "method-generic" word-prop ] bi
|
||||
next-method ;
|
||||
|
||||
: calls-next-method? ( method -- ? )
|
||||
def>> flatten \ (call-next-method) swap memq? ;
|
||||
|
||||
: compute-next-methods ( -- )
|
||||
[ standard-generic? ] instances [
|
||||
"methods" word-prop [
|
||||
nip dup next-method* "next-method" set-word-prop
|
||||
] assoc-each
|
||||
"methods" word-prop values [ calls-next-method? ] filter
|
||||
[ dup next-method* "next-method" set-word-prop ] each
|
||||
] each
|
||||
"vocab:tools/deploy/shaker/next-methods.factor" run-file ;
|
||||
|
||||
|
|
|
|||
|
|
@ -8,3 +8,7 @@ IN: libc
|
|||
: calloc ( size count -- newalien ) (calloc) check-ptr ;
|
||||
|
||||
: free ( alien -- ) (free) ;
|
||||
|
||||
FORGET: malloc-ptr
|
||||
|
||||
FORGET: <malloc-ptr>
|
||||
|
|
|
|||
|
|
@ -11,7 +11,9 @@ IN: tools.deploy.test
|
|||
] with-directory ;
|
||||
|
||||
: small-enough? ( n -- ? )
|
||||
[ "test.image" temp-file file-info size>> ] [ cell 4 / * ] bi* <= ;
|
||||
[ "test.image" temp-file file-info size>> ]
|
||||
[ cell 4 / * cpu ppc? [ 100000 + ] when ] bi*
|
||||
<= ;
|
||||
|
||||
: run-temp-image ( -- )
|
||||
os macosx?
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ threads libc combinators fry combinators.short-circuit continuations
|
|||
command-line shuffle opengl ui.render math.bitwise locals
|
||||
accessors math.rectangles math.order calendar ascii sets
|
||||
io.encodings.utf16n windows.errors literals ui.pixel-formats
|
||||
ui.pixel-formats.private memoize classes struct-arrays ;
|
||||
ui.pixel-formats.private memoize classes struct-arrays classes.struct ;
|
||||
IN: ui.backend.windows
|
||||
|
||||
SINGLETON: windows-ui-backend
|
||||
|
|
@ -89,26 +89,27 @@ CONSTANT: pfd-flag-map H{
|
|||
[ value>> ] [ 0 ] if* ;
|
||||
|
||||
: >pfd ( attributes -- pfd )
|
||||
"PIXELFORMATDESCRIPTOR" <c-object>
|
||||
"PIXELFORMATDESCRIPTOR" heap-size over set-PIXELFORMATDESCRIPTOR-nSize
|
||||
1 over set-PIXELFORMATDESCRIPTOR-nVersion
|
||||
over >pfd-flags over set-PIXELFORMATDESCRIPTOR-dwFlags
|
||||
PFD_TYPE_RGBA over set-PIXELFORMATDESCRIPTOR-iPixelType
|
||||
over color-bits attr-value over set-PIXELFORMATDESCRIPTOR-cColorBits
|
||||
over red-bits attr-value over set-PIXELFORMATDESCRIPTOR-cRedBits
|
||||
over green-bits attr-value over set-PIXELFORMATDESCRIPTOR-cGreenBits
|
||||
over blue-bits attr-value over set-PIXELFORMATDESCRIPTOR-cBlueBits
|
||||
over alpha-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAlphaBits
|
||||
over accum-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumBits
|
||||
over accum-red-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumRedBits
|
||||
over accum-green-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumGreenBits
|
||||
over accum-blue-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumBlueBits
|
||||
over accum-alpha-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumAlphaBits
|
||||
over depth-bits attr-value over set-PIXELFORMATDESCRIPTOR-cDepthBits
|
||||
over stencil-bits attr-value over set-PIXELFORMATDESCRIPTOR-cStencilBits
|
||||
over aux-buffers attr-value over set-PIXELFORMATDESCRIPTOR-cAuxBuffers
|
||||
PFD_MAIN_PLANE over set-PIXELFORMATDESCRIPTOR-dwLayerMask
|
||||
nip ;
|
||||
[ PIXELFORMATDESCRIPTOR <struct> ] dip
|
||||
{
|
||||
[ drop PIXELFORMATDESCRIPTOR heap-size >>nSize ]
|
||||
[ drop 1 >>nVersion ]
|
||||
[ >pfd-flags >>dwFlags ]
|
||||
[ drop PFD_TYPE_RGBA >>iPixelType ]
|
||||
[ color-bits attr-value >>cColorBits ]
|
||||
[ red-bits attr-value >>cRedBits ]
|
||||
[ green-bits attr-value >>cGreenBits ]
|
||||
[ blue-bits attr-value >>cBlueBits ]
|
||||
[ alpha-bits attr-value >>cAlphaBits ]
|
||||
[ accum-bits attr-value >>cAccumBits ]
|
||||
[ accum-red-bits attr-value >>cAccumRedBits ]
|
||||
[ accum-green-bits attr-value >>cAccumGreenBits ]
|
||||
[ accum-blue-bits attr-value >>cAccumBlueBits ]
|
||||
[ accum-alpha-bits attr-value >>cAccumAlphaBits ]
|
||||
[ depth-bits attr-value >>cDepthBits ]
|
||||
[ stencil-bits attr-value >>cStencilBits ]
|
||||
[ aux-buffers attr-value >>cAuxBuffers ]
|
||||
[ drop PFD_MAIN_PLANE >>dwLayerMask ]
|
||||
} cleave ;
|
||||
|
||||
: pfd-make-pixel-format ( world attributes -- pf )
|
||||
[ handle>> hDC>> ] [ >pfd ] bi*
|
||||
|
|
@ -116,12 +117,12 @@ CONSTANT: pfd-flag-map H{
|
|||
|
||||
: get-pfd ( pixel-format -- pfd )
|
||||
[ world>> handle>> hDC>> ] [ handle>> ] bi
|
||||
"PIXELFORMATDESCRIPTOR" heap-size
|
||||
"PIXELFORMATDESCRIPTOR" <c-object>
|
||||
PIXELFORMATDESCRIPTOR heap-size
|
||||
PIXELFORMATDESCRIPTOR <struct>
|
||||
[ DescribePixelFormat win32-error=0/f ] keep ;
|
||||
|
||||
: pfd-flag? ( pfd flag -- ? )
|
||||
[ PIXELFORMATDESCRIPTOR-dwFlags ] dip bitand c-bool> ;
|
||||
[ dwFlags>> ] dip bitand c-bool> ;
|
||||
|
||||
: (pfd-pixel-format-attribute) ( pfd attribute -- value )
|
||||
{
|
||||
|
|
@ -131,19 +132,19 @@ CONSTANT: pfd-flag-map H{
|
|||
{ fullscreen [ PFD_DRAW_TO_WINDOW pfd-flag? ] }
|
||||
{ windowed [ PFD_DRAW_TO_WINDOW pfd-flag? ] }
|
||||
{ software-rendered [ PFD_GENERIC_FORMAT pfd-flag? ] }
|
||||
{ color-bits [ PIXELFORMATDESCRIPTOR-cColorBits ] }
|
||||
{ red-bits [ PIXELFORMATDESCRIPTOR-cRedBits ] }
|
||||
{ green-bits [ PIXELFORMATDESCRIPTOR-cGreenBits ] }
|
||||
{ blue-bits [ PIXELFORMATDESCRIPTOR-cBlueBits ] }
|
||||
{ alpha-bits [ PIXELFORMATDESCRIPTOR-cAlphaBits ] }
|
||||
{ accum-bits [ PIXELFORMATDESCRIPTOR-cAccumBits ] }
|
||||
{ accum-red-bits [ PIXELFORMATDESCRIPTOR-cAccumRedBits ] }
|
||||
{ accum-green-bits [ PIXELFORMATDESCRIPTOR-cAccumGreenBits ] }
|
||||
{ accum-blue-bits [ PIXELFORMATDESCRIPTOR-cAccumBlueBits ] }
|
||||
{ accum-alpha-bits [ PIXELFORMATDESCRIPTOR-cAccumAlphaBits ] }
|
||||
{ depth-bits [ PIXELFORMATDESCRIPTOR-cDepthBits ] }
|
||||
{ stencil-bits [ PIXELFORMATDESCRIPTOR-cStencilBits ] }
|
||||
{ aux-buffers [ PIXELFORMATDESCRIPTOR-cAuxBuffers ] }
|
||||
{ color-bits [ cColorBits>> ] }
|
||||
{ red-bits [ cRedBits>> ] }
|
||||
{ green-bits [ cGreenBits>> ] }
|
||||
{ blue-bits [ cBlueBits>> ] }
|
||||
{ alpha-bits [ cAlphaBits>> ] }
|
||||
{ accum-bits [ cAccumBits>> ] }
|
||||
{ accum-red-bits [ cAccumRedBits>> ] }
|
||||
{ accum-green-bits [ cAccumGreenBits>> ] }
|
||||
{ accum-blue-bits [ cAccumBlueBits>> ] }
|
||||
{ accum-alpha-bits [ cAccumAlphaBits>> ] }
|
||||
{ depth-bits [ cDepthBits>> ] }
|
||||
{ stencil-bits [ cStencilBits>> ] }
|
||||
{ aux-buffers [ cAuxBuffers>> ] }
|
||||
[ 2drop f ]
|
||||
} case ;
|
||||
|
||||
|
|
@ -663,7 +664,7 @@ M: windows-ui-backend do-events
|
|||
|
||||
: set-pixel-format ( pixel-format hdc -- )
|
||||
swap handle>>
|
||||
"PIXELFORMATDESCRIPTOR" <c-object> SetPixelFormat win32-error=0/f ;
|
||||
PIXELFORMATDESCRIPTOR <struct> SetPixelFormat win32-error=0/f ;
|
||||
|
||||
: setup-gl ( world -- )
|
||||
[ get-dc ] keep
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.syntax kernel windows.types multiline ;
|
||||
USING: alien alien.syntax kernel windows.types multiline
|
||||
classes.struct ;
|
||||
IN: windows.kernel32
|
||||
|
||||
CONSTANT: MAX_PATH 260
|
||||
|
|
@ -215,15 +216,15 @@ C-STRUCT: OVERLAPPED
|
|||
{ "DWORD" "offset-high" }
|
||||
{ "HANDLE" "event" } ;
|
||||
|
||||
C-STRUCT: SYSTEMTIME
|
||||
{ "WORD" "wYear" }
|
||||
{ "WORD" "wMonth" }
|
||||
{ "WORD" "wDayOfWeek" }
|
||||
{ "WORD" "wDay" }
|
||||
{ "WORD" "wHour" }
|
||||
{ "WORD" "wMinute" }
|
||||
{ "WORD" "wSecond" }
|
||||
{ "WORD" "wMilliseconds" } ;
|
||||
STRUCT: SYSTEMTIME
|
||||
{ wYear WORD }
|
||||
{ wMonth WORD }
|
||||
{ wDayOfWeek WORD }
|
||||
{ wDay WORD }
|
||||
{ wHour WORD }
|
||||
{ wMinute WORD }
|
||||
{ wSecond WORD }
|
||||
{ wMilliseconds WORD } ;
|
||||
|
||||
C-STRUCT: TIME_ZONE_INFORMATION
|
||||
{ "LONG" "Bias" }
|
||||
|
|
@ -234,74 +235,74 @@ C-STRUCT: TIME_ZONE_INFORMATION
|
|||
{ "SYSTEMTIME" "DaylightDate" }
|
||||
{ "LONG" "DaylightBias" } ;
|
||||
|
||||
C-STRUCT: FILETIME
|
||||
{ "DWORD" "dwLowDateTime" }
|
||||
{ "DWORD" "dwHighDateTime" } ;
|
||||
STRUCT: FILETIME
|
||||
{ dwLowDateTime DWORD }
|
||||
{ dwHighDateTime DWORD } ;
|
||||
|
||||
C-STRUCT: STARTUPINFO
|
||||
{ "DWORD" "cb" }
|
||||
{ "LPTSTR" "lpReserved" }
|
||||
{ "LPTSTR" "lpDesktop" }
|
||||
{ "LPTSTR" "lpTitle" }
|
||||
{ "DWORD" "dwX" }
|
||||
{ "DWORD" "dwY" }
|
||||
{ "DWORD" "dwXSize" }
|
||||
{ "DWORD" "dwYSize" }
|
||||
{ "DWORD" "dwXCountChars" }
|
||||
{ "DWORD" "dwYCountChars" }
|
||||
{ "DWORD" "dwFillAttribute" }
|
||||
{ "DWORD" "dwFlags" }
|
||||
{ "WORD" "wShowWindow" }
|
||||
{ "WORD" "cbReserved2" }
|
||||
{ "LPBYTE" "lpReserved2" }
|
||||
{ "HANDLE" "hStdInput" }
|
||||
{ "HANDLE" "hStdOutput" }
|
||||
{ "HANDLE" "hStdError" } ;
|
||||
STRUCT: STARTUPINFO
|
||||
{ cb DWORD }
|
||||
{ lpReserved LPTSTR }
|
||||
{ lpDesktop LPTSTR }
|
||||
{ lpTitle LPTSTR }
|
||||
{ dwX DWORD }
|
||||
{ dwY DWORD }
|
||||
{ dwXSize DWORD }
|
||||
{ dwYSize DWORD }
|
||||
{ dwXCountChars DWORD }
|
||||
{ dwYCountChars DWORD }
|
||||
{ dwFillAttribute DWORD }
|
||||
{ dwFlags DWORD }
|
||||
{ wShowWindow WORD }
|
||||
{ cbReserved2 WORD }
|
||||
{ lpReserved2 LPBYTE }
|
||||
{ hStdInput HANDLE }
|
||||
{ hStdOutput HANDLE }
|
||||
{ hStdError HANDLE } ;
|
||||
|
||||
TYPEDEF: void* LPSTARTUPINFO
|
||||
|
||||
C-STRUCT: PROCESS_INFORMATION
|
||||
{ "HANDLE" "hProcess" }
|
||||
{ "HANDLE" "hThread" }
|
||||
{ "DWORD" "dwProcessId" }
|
||||
{ "DWORD" "dwThreadId" } ;
|
||||
STRUCT: PROCESS_INFORMATION
|
||||
{ hProcess HANDLE }
|
||||
{ hThread HANDLE }
|
||||
{ dwProcessId DWORD }
|
||||
{ dwThreadId DWORD } ;
|
||||
|
||||
C-STRUCT: SYSTEM_INFO
|
||||
{ "DWORD" "dwOemId" }
|
||||
{ "DWORD" "dwPageSize" }
|
||||
{ "LPVOID" "lpMinimumApplicationAddress" }
|
||||
{ "LPVOID" "lpMaximumApplicationAddress" }
|
||||
{ "DWORD_PTR" "dwActiveProcessorMask" }
|
||||
{ "DWORD" "dwNumberOfProcessors" }
|
||||
{ "DWORD" "dwProcessorType" }
|
||||
{ "DWORD" "dwAllocationGranularity" }
|
||||
{ "WORD" "wProcessorLevel" }
|
||||
{ "WORD" "wProcessorRevision" } ;
|
||||
STRUCT: SYSTEM_INFO
|
||||
{ dwOemId DWORD }
|
||||
{ dwPageSize DWORD }
|
||||
{ lpMinimumApplicationAddress LPVOID }
|
||||
{ lpMaximumApplicationAddress LPVOID }
|
||||
{ dwActiveProcessorMask DWORD_PTR }
|
||||
{ dwNumberOfProcessors DWORD }
|
||||
{ dwProcessorType DWORD }
|
||||
{ dwAllocationGranularity DWORD }
|
||||
{ wProcessorLevel WORD }
|
||||
{ wProcessorRevision WORD } ;
|
||||
|
||||
TYPEDEF: void* LPSYSTEM_INFO
|
||||
|
||||
C-STRUCT: MEMORYSTATUS
|
||||
{ "DWORD" "dwLength" }
|
||||
{ "DWORD" "dwMemoryLoad" }
|
||||
{ "SIZE_T" "dwTotalPhys" }
|
||||
{ "SIZE_T" "dwAvailPhys" }
|
||||
{ "SIZE_T" "dwTotalPageFile" }
|
||||
{ "SIZE_T" "dwAvailPageFile" }
|
||||
{ "SIZE_T" "dwTotalVirtual" }
|
||||
{ "SIZE_T" "dwAvailVirtual" } ;
|
||||
STRUCT: MEMORYSTATUS
|
||||
{ dwLength DWORD }
|
||||
{ dwMemoryLoad DWORD }
|
||||
{ dwTotalPhys SIZE_T }
|
||||
{ dwAvailPhys SIZE_T }
|
||||
{ dwTotalPageFile SIZE_T }
|
||||
{ dwAvailPageFile SIZE_T }
|
||||
{ dwTotalVirtual SIZE_T }
|
||||
{ dwAvailVirtual SIZE_T } ;
|
||||
|
||||
TYPEDEF: void* LPMEMORYSTATUS
|
||||
|
||||
C-STRUCT: MEMORYSTATUSEX
|
||||
{ "DWORD" "dwLength" }
|
||||
{ "DWORD" "dwMemoryLoad" }
|
||||
{ "DWORDLONG" "ullTotalPhys" }
|
||||
{ "DWORDLONG" "ullAvailPhys" }
|
||||
{ "DWORDLONG" "ullTotalPageFile" }
|
||||
{ "DWORDLONG" "ullAvailPageFile" }
|
||||
{ "DWORDLONG" "ullTotalVirtual" }
|
||||
{ "DWORDLONG" "ullAvailVirtual" }
|
||||
{ "DWORDLONG" "ullAvailExtendedVirtual" } ;
|
||||
STRUCT: MEMORYSTATUSEX
|
||||
{ dwLength DWORD }
|
||||
{ dwMemoryLoad DWORD }
|
||||
{ ullTotalPhys DWORDLONG }
|
||||
{ ullAvailPhys DWORDLONG }
|
||||
{ ullTotalPageFile DWORDLONG }
|
||||
{ ullAvailPageFile DWORDLONG }
|
||||
{ ullTotalVirtual DWORDLONG }
|
||||
{ ullAvailVirtual DWORDLONG }
|
||||
{ ullAvailExtendedVirtual DWORDLONG } ;
|
||||
|
||||
TYPEDEF: void* LPMEMORYSTATUSEX
|
||||
|
||||
|
|
@ -707,17 +708,17 @@ C-STRUCT: WIN32_FIND_DATA
|
|||
{ { "TCHAR" 260 } "cFileName" }
|
||||
{ { "TCHAR" 14 } "cAlternateFileName" } ;
|
||||
|
||||
C-STRUCT: BY_HANDLE_FILE_INFORMATION
|
||||
{ "DWORD" "dwFileAttributes" }
|
||||
{ "FILETIME" "ftCreationTime" }
|
||||
{ "FILETIME" "ftLastAccessTime" }
|
||||
{ "FILETIME" "ftLastWriteTime" }
|
||||
{ "DWORD" "dwVolumeSerialNumber" }
|
||||
{ "DWORD" "nFileSizeHigh" }
|
||||
{ "DWORD" "nFileSizeLow" }
|
||||
{ "DWORD" "nNumberOfLinks" }
|
||||
{ "DWORD" "nFileIndexHigh" }
|
||||
{ "DWORD" "nFileIndexLow" } ;
|
||||
STRUCT: BY_HANDLE_FILE_INFORMATION
|
||||
{ dwFileAttributes DWORD }
|
||||
{ ftCreationTime FILETIME }
|
||||
{ ftLastAccessTime FILETIME }
|
||||
{ ftLastWriteTime FILETIME }
|
||||
{ dwVolumeSerialNumber DWORD }
|
||||
{ nFileSizeHigh DWORD }
|
||||
{ nFileSizeLow DWORD }
|
||||
{ nNumberOfLinks DWORD }
|
||||
{ nFileIndexHigh DWORD }
|
||||
{ nFileIndexLow DWORD } ;
|
||||
|
||||
TYPEDEF: WIN32_FIND_DATA* PWIN32_FIND_DATA
|
||||
TYPEDEF: WIN32_FIND_DATA* LPWIN32_FIND_DATA
|
||||
|
|
@ -737,10 +738,10 @@ TYPEDEF: PFILETIME LPFILETIME
|
|||
|
||||
TYPEDEF: int GET_FILEEX_INFO_LEVELS
|
||||
|
||||
C-STRUCT: SECURITY_ATTRIBUTES
|
||||
{ "DWORD" "nLength" }
|
||||
{ "LPVOID" "lpSecurityDescriptor" }
|
||||
{ "BOOL" "bInheritHandle" } ;
|
||||
STRUCT: SECURITY_ATTRIBUTES
|
||||
{ nLength DWORD }
|
||||
{ lpSecurityDescriptor LPVOID }
|
||||
{ bInheritHandle BOOL } ;
|
||||
|
||||
CONSTANT: HANDLE_FLAG_INHERIT 1
|
||||
CONSTANT: HANDLE_FLAG_PROTECT_FROM_CLOSE 2
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2007 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types kernel math windows.errors
|
||||
windows.kernel32 namespaces calendar math.bitwise ;
|
||||
windows.kernel32 namespaces calendar math.bitwise accessors
|
||||
classes.struct ;
|
||||
IN: windows.time
|
||||
|
||||
: >64bit ( lo hi -- n )
|
||||
|
|
@ -11,15 +12,13 @@ IN: windows.time
|
|||
1601 1 1 0 0 0 instant <timestamp> ;
|
||||
|
||||
: FILETIME>windows-time ( FILETIME -- n )
|
||||
[ FILETIME-dwLowDateTime ]
|
||||
[ FILETIME-dwHighDateTime ]
|
||||
bi >64bit ;
|
||||
[ dwLowDateTime>> ] [ dwHighDateTime>> ] bi >64bit ;
|
||||
|
||||
: windows-time>timestamp ( n -- timestamp )
|
||||
10000000 /i seconds windows-1601 swap time+ ;
|
||||
|
||||
: windows-time ( -- n )
|
||||
"FILETIME" <c-object> [ GetSystemTimeAsFileTime ] keep
|
||||
FILETIME <struct> [ GetSystemTimeAsFileTime ] keep
|
||||
FILETIME>windows-time ;
|
||||
|
||||
: timestamp>windows-time ( timestamp -- n )
|
||||
|
|
@ -27,11 +26,8 @@ IN: windows.time
|
|||
>gmt windows-1601 (time-) 10000000 * >integer ;
|
||||
|
||||
: windows-time>FILETIME ( n -- FILETIME )
|
||||
"FILETIME" <c-object>
|
||||
[
|
||||
[ [ 32 bits ] dip set-FILETIME-dwLowDateTime ]
|
||||
[ [ -32 shift ] dip set-FILETIME-dwHighDateTime ] 2bi
|
||||
] keep ;
|
||||
[ FILETIME <struct> ] dip
|
||||
[ 32 bits >>dwLowDateTime ] [ -32 shift >>dwHighDateTime ] bi ;
|
||||
|
||||
: timestamp>FILETIME ( timestamp -- FILETIME/f )
|
||||
dup [ >gmt timestamp>windows-time windows-time>FILETIME ] when ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.syntax namespaces kernel words
|
||||
sequences math math.bitwise math.vectors colors
|
||||
io.encodings.utf16n ;
|
||||
io.encodings.utf16n classes.struct ;
|
||||
IN: windows.types
|
||||
|
||||
TYPEDEF: char CHAR
|
||||
|
|
@ -301,33 +301,33 @@ C-STRUCT: MSG
|
|||
|
||||
TYPEDEF: MSG* LPMSG
|
||||
|
||||
C-STRUCT: PIXELFORMATDESCRIPTOR
|
||||
{ "WORD" "nSize" }
|
||||
{ "WORD" "nVersion" }
|
||||
{ "DWORD" "dwFlags" }
|
||||
{ "BYTE" "iPixelType" }
|
||||
{ "BYTE" "cColorBits" }
|
||||
{ "BYTE" "cRedBits" }
|
||||
{ "BYTE" "cRedShift" }
|
||||
{ "BYTE" "cGreenBits" }
|
||||
{ "BYTE" "cGreenShift" }
|
||||
{ "BYTE" "cBlueBits" }
|
||||
{ "BYTE" "cBlueShift" }
|
||||
{ "BYTE" "cAlphaBits" }
|
||||
{ "BYTE" "cAlphaShift" }
|
||||
{ "BYTE" "cAccumBits" }
|
||||
{ "BYTE" "cAccumRedBits" }
|
||||
{ "BYTE" "cAccumGreenBits" }
|
||||
{ "BYTE" "cAccumBlueBits" }
|
||||
{ "BYTE" "cAccumAlphaBits" }
|
||||
{ "BYTE" "cDepthBits" }
|
||||
{ "BYTE" "cStencilBits" }
|
||||
{ "BYTE" "cAuxBuffers" }
|
||||
{ "BYTE" "iLayerType" }
|
||||
{ "BYTE" "bReserved" }
|
||||
{ "DWORD" "dwLayerMask" }
|
||||
{ "DWORD" "dwVisibleMask" }
|
||||
{ "DWORD" "dwDamageMask" } ;
|
||||
STRUCT: PIXELFORMATDESCRIPTOR
|
||||
{ nSize WORD }
|
||||
{ nVersion WORD }
|
||||
{ dwFlags DWORD }
|
||||
{ iPixelType BYTE }
|
||||
{ cColorBits BYTE }
|
||||
{ cRedBits BYTE }
|
||||
{ cRedShift BYTE }
|
||||
{ cGreenBits BYTE }
|
||||
{ cGreenShift BYTE }
|
||||
{ cBlueBits BYTE }
|
||||
{ cBlueShift BYTE }
|
||||
{ cAlphaBits BYTE }
|
||||
{ cAlphaShift BYTE }
|
||||
{ cAccumBits BYTE }
|
||||
{ cAccumRedBits BYTE }
|
||||
{ cAccumGreenBits BYTE }
|
||||
{ cAccumBlueBits BYTE }
|
||||
{ cAccumAlphaBits BYTE }
|
||||
{ cDepthBits BYTE }
|
||||
{ cStencilBits BYTE }
|
||||
{ cAuxBuffers BYTE }
|
||||
{ iLayerType BYTE }
|
||||
{ bReserved BYTE }
|
||||
{ dwLayerMask DWORD }
|
||||
{ dwVisibleMask DWORD }
|
||||
{ dwDamageMask DWORD } ;
|
||||
|
||||
C-STRUCT: RECT
|
||||
{ "LONG" "left" }
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.syntax parser namespaces kernel math
|
||||
windows.types generalizations math.bitwise ;
|
||||
windows.types generalizations math.bitwise classes.struct ;
|
||||
IN: windows.user32
|
||||
|
||||
! HKL for ActivateKeyboardLayout
|
||||
|
|
|
|||
|
|
@ -3,37 +3,38 @@
|
|||
USING: alien alien.c-types alien.strings
|
||||
kernel libc math namespaces system-info.backend
|
||||
system-info.windows windows windows.advapi32
|
||||
windows.kernel32 system byte-arrays windows.errors ;
|
||||
windows.kernel32 system byte-arrays windows.errors
|
||||
classes classes.struct ;
|
||||
IN: system-info.windows.nt
|
||||
|
||||
M: winnt cpus ( -- n )
|
||||
system-info SYSTEM_INFO-dwNumberOfProcessors ;
|
||||
|
||||
: memory-status ( -- MEMORYSTATUSEX )
|
||||
"MEMORYSTATUSEX" <c-object>
|
||||
"MEMORYSTATUSEX" heap-size over set-MEMORYSTATUSEX-dwLength
|
||||
"MEMORYSTATUSEX" <struct>
|
||||
dup class heap-size >>dwLength
|
||||
dup GlobalMemoryStatusEx win32-error=0/f ;
|
||||
|
||||
M: winnt memory-load ( -- n )
|
||||
memory-status MEMORYSTATUSEX-dwMemoryLoad ;
|
||||
memory-status dwMemoryLoad>> ;
|
||||
|
||||
M: winnt physical-mem ( -- n )
|
||||
memory-status MEMORYSTATUSEX-ullTotalPhys ;
|
||||
memory-status ullTotalPhys>> ;
|
||||
|
||||
M: winnt available-mem ( -- n )
|
||||
memory-status MEMORYSTATUSEX-ullAvailPhys ;
|
||||
memory-status ullAvailPhys>> ;
|
||||
|
||||
M: winnt total-page-file ( -- n )
|
||||
memory-status MEMORYSTATUSEX-ullTotalPageFile ;
|
||||
memory-status ullTotalPageFile>> ;
|
||||
|
||||
M: winnt available-page-file ( -- n )
|
||||
memory-status MEMORYSTATUSEX-ullAvailPageFile ;
|
||||
memory-status ullAvailPageFile>> ;
|
||||
|
||||
M: winnt total-virtual-mem ( -- n )
|
||||
memory-status MEMORYSTATUSEX-ullTotalVirtual ;
|
||||
memory-status ullTotalVirtual>> ;
|
||||
|
||||
M: winnt available-virtual-mem ( -- n )
|
||||
memory-status MEMORYSTATUSEX-ullAvailVirtual ;
|
||||
memory-status ullAvailVirtual>> ;
|
||||
|
||||
: computer-name ( -- string )
|
||||
MAX_COMPUTERNAME_LENGTH 1 +
|
||||
|
|
|
|||
|
|
@ -7,18 +7,18 @@ system alien.strings windows.errors ;
|
|||
IN: system-info.windows
|
||||
|
||||
: system-info ( -- SYSTEM_INFO )
|
||||
"SYSTEM_INFO" <c-object> [ GetSystemInfo ] keep ;
|
||||
SYSTEM_INFO <struct> [ GetSystemInfo ] keep ;
|
||||
|
||||
: page-size ( -- n )
|
||||
system-info SYSTEM_INFO-dwPageSize ;
|
||||
system-info dwPageSize>> ;
|
||||
|
||||
! 386, 486, 586, 2200 (IA64), 8664 (AMD_X8664)
|
||||
: processor-type ( -- n )
|
||||
system-info SYSTEM_INFO-dwProcessorType ;
|
||||
system-info dwProcessorType>> ;
|
||||
|
||||
! 0 = x86, 6 = Intel Itanium, 9 = x64 (AMD or Intel), 10 = WOW64, 0xffff = Unk
|
||||
: processor-architecture ( -- n )
|
||||
system-info SYSTEM_INFO-dwOemId HEX: ffff0000 bitand ;
|
||||
system-info dwOemId>> HEX: ffff0000 bitand ;
|
||||
|
||||
: os-version ( -- os-version )
|
||||
"OSVERSIONINFO" <c-object>
|
||||
|
|
|
|||
Loading…
Reference in New Issue