steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-08-27 20:29:28 -05:00
parent f1b4d94f2f ee418a75d9
commit 37403b28a9
14 changed files with 179 additions and 164 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -780,6 +780,10 @@ M: f whatever2 ; inline
[ t ] [ [ 1 whatever2 at ] { at* hashcode* } inlined? ] unit-test [ t ] [ [ 1 whatever2 at ] { at* hashcode* } inlined? ] unit-test
[ f ] [ [ whatever2 at ] { at* hashcode* } inlined? ] unit-test [ f ] [ [ whatever2 at ] { at* hashcode* } inlined? ] unit-test
SYMBOL: not-an-assoc
[ f ] [ [ not-an-assoc at ] { at* } inlined? ] unit-test
[ t ] [ [ { 1 2 3 } member? ] { member? } inlined? ] unit-test [ t ] [ [ { 1 2 3 } member? ] { member? } inlined? ] unit-test
[ f ] [ [ { 1 2 3 } swap member? ] { member? } inlined? ] unit-test [ f ] [ [ { 1 2 3 } swap member? ] { member? } inlined? ] unit-test

14
basis/compiler/tree/propagation/transforms/transforms.factor
View File

@ -207,12 +207,14 @@ CONSTANT: lookup-table-at-max 256
] ; ] ;
: at-quot ( assoc -- quot ) : at-quot ( assoc -- quot )
dup lookup-table-at? [ dup assoc? [
dup fast-lookup-table-at? [ dup lookup-table-at? [
fast-lookup-table-quot dup fast-lookup-table-at? [
] [ fast-lookup-table-quot
lookup-table-quot ] [
] if lookup-table-quot
] if
] [ drop f ] if
] [ drop f ] if ; ] [ drop f ] if ;
\ at* [ at-quot ] 1 define-partial-eval \ at* [ at-quot ] 1 define-partial-eval

2
basis/io/backend/windows/nt/nt.factor
View File

@ -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.files.windows io.files.windows.nt io.files io.pathnames io.buffers
io.streams.c io.streams.null libc kernel math namespaces sequences io.streams.c io.streams.null libc kernel math namespaces sequences
threads windows windows.errors windows.kernel32 strings splitting threads windows windows.errors windows.kernel32 strings splitting
ascii system accessors locals ; ascii system accessors locals classes.struct ;
QUALIFIED: windows.winsock QUALIFIED: windows.winsock
IN: io.backend.windows.nt IN: io.backend.windows.nt

8
basis/io/backend/windows/windows.factor
View File

@ -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 io.buffers io.files io.ports io.binary io.timeouts system
strings kernel math namespaces sequences windows.errors strings kernel math namespaces sequences windows.errors
windows.kernel32 windows.shell32 windows.types windows.winsock 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 IN: io.backend.windows
TUPLE: win32-handle < disposable handle ; TUPLE: win32-handle < disposable handle ;
@ -50,6 +51,5 @@ HOOK: add-completion io-backend ( port -- )
} flags ; foldable } flags ; foldable
: default-security-attributes ( -- obj ) : default-security-attributes ( -- obj )
"SECURITY_ATTRIBUTES" <c-object> SECURITY_ATTRIBUTES <struct>
"SECURITY_ATTRIBUTES" heap-size dup class heap-size >>nLength ;
over set-SECURITY_ATTRIBUTES-nLength ;

6
basis/io/files/info/windows/windows-tests.factor Executable file
View File

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

43
basis/io/files/info/windows/windows.factor
View File

@ -5,7 +5,7 @@ io.files.windows io.files.windows.nt kernel windows.kernel32
windows.time windows accessors alien.c-types combinators windows.time windows accessors alien.c-types combinators
generalizations system alien.strings io.encodings.utf16n generalizations system alien.strings io.encodings.utf16n
sequences splitting windows.errors fry continuations destructors 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 IN: io.files.info.windows
:: round-up-to ( n multiple -- n' ) :: 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 ) : BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info )
[ \ windows-file-info new ] dip [ \ windows-file-info new ] dip
{ {
[ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type >>type ] [ dwFileAttributes>> win32-file-type >>type ]
[ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes >>attributes ] [ dwFileAttributes>> win32-file-attributes >>attributes ]
[ [
[ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ] [ nFileSizeLow>> ]
[ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size [ nFileSizeHigh>> ] bi >64bit >>size
] ]
[ BY_HANDLE_FILE_INFORMATION-dwFileAttributes >>permissions ] [ dwFileAttributes>> >>permissions ]
[ [ ftCreationTime>> FILETIME>timestamp >>created ]
BY_HANDLE_FILE_INFORMATION-ftCreationTime [ ftLastWriteTime>> FILETIME>timestamp >>modified ]
FILETIME>timestamp >>created [ ftLastAccessTime>> FILETIME>timestamp >>accessed ]
] ! [ nNumberOfLinks>> ]
[
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 ] ! [ nFileIndexLow>> ]
! [ BY_HANDLE_FILE_INFORMATION-nFileIndexHigh ] bi >64bit ! [ nFileIndexHigh>> ] bi >64bit
! ] ! ]
} cleave ; } cleave ;
: get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION ) : 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 [ GetFileInformationByHandle win32-error=0/f ] keep
] keep CloseHandle win32-error=0/f ; ] keep CloseHandle win32-error=0/f ;
@ -197,10 +188,10 @@ M: winnt file-systems ( -- array )
: file-times ( path -- timestamp timestamp timestamp ) : file-times ( path -- timestamp timestamp timestamp )
[ [
normalize-path open-existing &dispose handle>> normalize-path open-read &dispose handle>>
"FILETIME" <c-object> FILETIME <struct>
"FILETIME" <c-object> FILETIME <struct>
"FILETIME" <c-object> FILETIME <struct>
[ GetFileTime win32-error=0/f ] 3keep [ GetFileTime win32-error=0/f ] 3keep
[ FILETIME>timestamp >local-time ] tri@ [ FILETIME>timestamp >local-time ] tri@
] with-destructors ; ] with-destructors ;

10
basis/io/launcher/windows/nt/nt.factor
View File

@ -85,7 +85,7 @@ IN: io.launcher.windows.nt
: redirect-stderr ( process args -- handle ) : redirect-stderr ( process args -- handle )
over stderr>> +stdout+ eq? [ over stderr>> +stdout+ eq? [
nip nip
lpStartupInfo>> STARTUPINFO-hStdOutput lpStartupInfo>> hStdOutput>>
] [ ] [
drop drop
stderr>> stderr>>
@ -104,7 +104,7 @@ IN: io.launcher.windows.nt
STD_INPUT_HANDLE GetStdHandle or ; STD_INPUT_HANDLE GetStdHandle or ;
M: winnt fill-redirection ( process args -- ) M: winnt fill-redirection ( process args -- )
[ 2dup redirect-stdout ] keep lpStartupInfo>> set-STARTUPINFO-hStdOutput dup lpStartupInfo>>
[ 2dup redirect-stderr ] keep lpStartupInfo>> set-STARTUPINFO-hStdError [ [ redirect-stdout ] dip (>>hStdOutput) ]
[ 2dup redirect-stdin ] keep lpStartupInfo>> set-STARTUPINFO-hStdInput [ [ redirect-stderr ] dip (>>hStdError) ]
2drop ; [ [ redirect-stdin ] dip (>>hStdInput) ] 3tri ;

22
basis/io/launcher/windows/windows.factor
View File

@ -7,7 +7,7 @@ namespaces make io.launcher kernel sequences windows.errors
splitting system threads init strings combinators splitting system threads init strings combinators
io.backend accessors concurrency.flags io.files assocs io.backend accessors concurrency.flags io.files assocs
io.files.private windows destructors specialized-arrays.ushort io.files.private windows destructors specialized-arrays.ushort
specialized-arrays.alien ; specialized-arrays.alien classes classes.struct ;
IN: io.launcher.windows IN: io.launcher.windows
TUPLE: CreateProcess-args TUPLE: CreateProcess-args
@ -24,9 +24,10 @@ TUPLE: CreateProcess-args
: default-CreateProcess-args ( -- obj ) : default-CreateProcess-args ( -- obj )
CreateProcess-args new CreateProcess-args new
"STARTUPINFO" <c-object> STARTUPINFO <struct>
"STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo dup class heap-size >>cb
"PROCESS_INFORMATION" <c-object> >>lpProcessInformation >>lpStartupInfo
PROCESS_INFORMATION <struct> >>lpProcessInformation
TRUE >>bInheritHandles TRUE >>bInheritHandles
0 >>dwCreateFlags ; 0 >>dwCreateFlags ;
@ -108,7 +109,7 @@ TUPLE: CreateProcess-args
] when ; ] when ;
: fill-startup-info ( process args -- process args ) : 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 -- ) HOOK: fill-redirection io-backend ( process args -- )
@ -136,17 +137,16 @@ M: windows run-process* ( process -- handle )
] with-destructors ; ] with-destructors ;
M: windows kill-process* ( handle -- ) M: windows kill-process* ( handle -- )
PROCESS_INFORMATION-hProcess hProcess>> 255 TerminateProcess win32-error=0/f ;
255 TerminateProcess win32-error=0/f ;
: dispose-process ( process-information -- ) : dispose-process ( process-information -- )
#! From MSDN: "Handles in PROCESS_INFORMATION must be closed #! From MSDN: "Handles in PROCESS_INFORMATION must be closed
#! with CloseHandle when they are no longer needed." #! with CloseHandle when they are no longer needed."
dup PROCESS_INFORMATION-hProcess [ CloseHandle drop ] when* [ hProcess>> [ CloseHandle drop ] when* ]
PROCESS_INFORMATION-hThread [ CloseHandle drop ] when* ; [ hThread>> [ CloseHandle drop ] when* ] bi ;
: exit-code ( process -- n ) : exit-code ( process -- n )
PROCESS_INFORMATION-hProcess hProcess>>
0 <ulong> [ GetExitCodeProcess ] keep *ulong 0 <ulong> [ GetExitCodeProcess ] keep *ulong
swap win32-error=0/f ; swap win32-error=0/f ;
@ -157,7 +157,7 @@ M: windows kill-process* ( handle -- )
M: windows wait-for-processes ( -- ? ) M: windows wait-for-processes ( -- ? )
processes get keys dup processes get keys dup
[ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as [ handle>> hProcess>> ] void*-array{ } map-as
[ length ] keep 0 0 [ length ] keep 0 0
WaitForMultipleObjects WaitForMultipleObjects
dup HEX: ffffffff = [ win32-error ] when dup HEX: ffffffff = [ win32-error ] when

2
basis/ui/backend/cocoa/views/views.factor
View File

@ -149,7 +149,7 @@ CLASS: {
! Rendering ! Rendering
{ "drawRect:" "void" { "id" "SEL" "NSRect" } { "drawRect:" "void" { "id" "SEL" "NSRect" }
[ 2drop window relayout-1 ] [ 2drop window relayout-1 yield ]
} }
! Events ! Events

165
basis/windows/kernel32/kernel32.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2005, 2006 Doug Coleman. ! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: windows.kernel32
CONSTANT: MAX_PATH 260 CONSTANT: MAX_PATH 260
@ -215,15 +216,15 @@ C-STRUCT: OVERLAPPED
{ "DWORD" "offset-high" } { "DWORD" "offset-high" }
{ "HANDLE" "event" } ; { "HANDLE" "event" } ;
C-STRUCT: SYSTEMTIME STRUCT: SYSTEMTIME
{ "WORD" "wYear" } { wYear WORD }
{ "WORD" "wMonth" } { wMonth WORD }
{ "WORD" "wDayOfWeek" } { wDayOfWeek WORD }
{ "WORD" "wDay" } { wDay WORD }
{ "WORD" "wHour" } { wHour WORD }
{ "WORD" "wMinute" } { wMinute WORD }
{ "WORD" "wSecond" } { wSecond WORD }
{ "WORD" "wMilliseconds" } ; { wMilliseconds WORD } ;
C-STRUCT: TIME_ZONE_INFORMATION C-STRUCT: TIME_ZONE_INFORMATION
{ "LONG" "Bias" } { "LONG" "Bias" }
@ -234,74 +235,74 @@ C-STRUCT: TIME_ZONE_INFORMATION
{ "SYSTEMTIME" "DaylightDate" } { "SYSTEMTIME" "DaylightDate" }
{ "LONG" "DaylightBias" } ; { "LONG" "DaylightBias" } ;
C-STRUCT: FILETIME STRUCT: FILETIME
{ "DWORD" "dwLowDateTime" } { dwLowDateTime DWORD }
{ "DWORD" "dwHighDateTime" } ; { dwHighDateTime DWORD } ;
C-STRUCT: STARTUPINFO STRUCT: STARTUPINFO
{ "DWORD" "cb" } { cb DWORD }
{ "LPTSTR" "lpReserved" } { lpReserved LPTSTR }
{ "LPTSTR" "lpDesktop" } { lpDesktop LPTSTR }
{ "LPTSTR" "lpTitle" } { lpTitle LPTSTR }
{ "DWORD" "dwX" } { dwX DWORD }
{ "DWORD" "dwY" } { dwY DWORD }
{ "DWORD" "dwXSize" } { dwXSize DWORD }
{ "DWORD" "dwYSize" } { dwYSize DWORD }
{ "DWORD" "dwXCountChars" } { dwXCountChars DWORD }
{ "DWORD" "dwYCountChars" } { dwYCountChars DWORD }
{ "DWORD" "dwFillAttribute" } { dwFillAttribute DWORD }
{ "DWORD" "dwFlags" } { dwFlags DWORD }
{ "WORD" "wShowWindow" } { wShowWindow WORD }
{ "WORD" "cbReserved2" } { cbReserved2 WORD }
{ "LPBYTE" "lpReserved2" } { lpReserved2 LPBYTE }
{ "HANDLE" "hStdInput" } { hStdInput HANDLE }
{ "HANDLE" "hStdOutput" } { hStdOutput HANDLE }
{ "HANDLE" "hStdError" } ; { hStdError HANDLE } ;
TYPEDEF: void* LPSTARTUPINFO TYPEDEF: void* LPSTARTUPINFO
C-STRUCT: PROCESS_INFORMATION STRUCT: PROCESS_INFORMATION
{ "HANDLE" "hProcess" } { hProcess HANDLE }
{ "HANDLE" "hThread" } { hThread HANDLE }
{ "DWORD" "dwProcessId" } { dwProcessId DWORD }
{ "DWORD" "dwThreadId" } ; { dwThreadId DWORD } ;
C-STRUCT: SYSTEM_INFO STRUCT: SYSTEM_INFO
{ "DWORD" "dwOemId" } { dwOemId DWORD }
{ "DWORD" "dwPageSize" } { dwPageSize DWORD }
{ "LPVOID" "lpMinimumApplicationAddress" } { lpMinimumApplicationAddress LPVOID }
{ "LPVOID" "lpMaximumApplicationAddress" } { lpMaximumApplicationAddress LPVOID }
{ "DWORD_PTR" "dwActiveProcessorMask" } { dwActiveProcessorMask DWORD_PTR }
{ "DWORD" "dwNumberOfProcessors" } { dwNumberOfProcessors DWORD }
{ "DWORD" "dwProcessorType" } { dwProcessorType DWORD }
{ "DWORD" "dwAllocationGranularity" } { dwAllocationGranularity DWORD }
{ "WORD" "wProcessorLevel" } { wProcessorLevel WORD }
{ "WORD" "wProcessorRevision" } ; { wProcessorRevision WORD } ;
TYPEDEF: void* LPSYSTEM_INFO TYPEDEF: void* LPSYSTEM_INFO
C-STRUCT: MEMORYSTATUS STRUCT: MEMORYSTATUS
{ "DWORD" "dwLength" } { dwLength DWORD }
{ "DWORD" "dwMemoryLoad" } { dwMemoryLoad DWORD }
{ "SIZE_T" "dwTotalPhys" } { dwTotalPhys SIZE_T }
{ "SIZE_T" "dwAvailPhys" } { dwAvailPhys SIZE_T }
{ "SIZE_T" "dwTotalPageFile" } { dwTotalPageFile SIZE_T }
{ "SIZE_T" "dwAvailPageFile" } { dwAvailPageFile SIZE_T }
{ "SIZE_T" "dwTotalVirtual" } { dwTotalVirtual SIZE_T }
{ "SIZE_T" "dwAvailVirtual" } ; { dwAvailVirtual SIZE_T } ;
TYPEDEF: void* LPMEMORYSTATUS TYPEDEF: void* LPMEMORYSTATUS
C-STRUCT: MEMORYSTATUSEX STRUCT: MEMORYSTATUSEX
{ "DWORD" "dwLength" } { dwLength DWORD }
{ "DWORD" "dwMemoryLoad" } { dwMemoryLoad DWORD }
{ "DWORDLONG" "ullTotalPhys" } { ullTotalPhys DWORDLONG }
{ "DWORDLONG" "ullAvailPhys" } { ullAvailPhys DWORDLONG }
{ "DWORDLONG" "ullTotalPageFile" } { ullTotalPageFile DWORDLONG }
{ "DWORDLONG" "ullAvailPageFile" } { ullAvailPageFile DWORDLONG }
{ "DWORDLONG" "ullTotalVirtual" } { ullTotalVirtual DWORDLONG }
{ "DWORDLONG" "ullAvailVirtual" } { ullAvailVirtual DWORDLONG }
{ "DWORDLONG" "ullAvailExtendedVirtual" } ; { ullAvailExtendedVirtual DWORDLONG } ;
TYPEDEF: void* LPMEMORYSTATUSEX TYPEDEF: void* LPMEMORYSTATUSEX
@ -707,17 +708,17 @@ C-STRUCT: WIN32_FIND_DATA
{ { "TCHAR" 260 } "cFileName" } { { "TCHAR" 260 } "cFileName" }
{ { "TCHAR" 14 } "cAlternateFileName" } ; { { "TCHAR" 14 } "cAlternateFileName" } ;
C-STRUCT: BY_HANDLE_FILE_INFORMATION STRUCT: BY_HANDLE_FILE_INFORMATION
{ "DWORD" "dwFileAttributes" } { dwFileAttributes DWORD }
{ "FILETIME" "ftCreationTime" } { ftCreationTime FILETIME }
{ "FILETIME" "ftLastAccessTime" } { ftLastAccessTime FILETIME }
{ "FILETIME" "ftLastWriteTime" } { ftLastWriteTime FILETIME }
{ "DWORD" "dwVolumeSerialNumber" } { dwVolumeSerialNumber DWORD }
{ "DWORD" "nFileSizeHigh" } { nFileSizeHigh DWORD }
{ "DWORD" "nFileSizeLow" } { nFileSizeLow DWORD }
{ "DWORD" "nNumberOfLinks" } { nNumberOfLinks DWORD }
{ "DWORD" "nFileIndexHigh" } { nFileIndexHigh DWORD }
{ "DWORD" "nFileIndexLow" } ; { nFileIndexLow DWORD } ;
TYPEDEF: WIN32_FIND_DATA* PWIN32_FIND_DATA TYPEDEF: WIN32_FIND_DATA* PWIN32_FIND_DATA
TYPEDEF: WIN32_FIND_DATA* LPWIN32_FIND_DATA TYPEDEF: WIN32_FIND_DATA* LPWIN32_FIND_DATA
@ -737,10 +738,10 @@ TYPEDEF: PFILETIME LPFILETIME
TYPEDEF: int GET_FILEEX_INFO_LEVELS TYPEDEF: int GET_FILEEX_INFO_LEVELS
C-STRUCT: SECURITY_ATTRIBUTES STRUCT: SECURITY_ATTRIBUTES
{ "DWORD" "nLength" } { nLength DWORD }
{ "LPVOID" "lpSecurityDescriptor" } { lpSecurityDescriptor LPVOID }
{ "BOOL" "bInheritHandle" } ; { bInheritHandle BOOL } ;
CONSTANT: HANDLE_FLAG_INHERIT 1 CONSTANT: HANDLE_FLAG_INHERIT 1
CONSTANT: HANDLE_FLAG_PROTECT_FROM_CLOSE 2 CONSTANT: HANDLE_FLAG_PROTECT_FROM_CLOSE 2

16
basis/windows/time/time.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2007 Doug Coleman. ! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types kernel math windows.errors 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 IN: windows.time
: >64bit ( lo hi -- n ) : >64bit ( lo hi -- n )
@ -11,15 +12,13 @@ IN: windows.time
1601 1 1 0 0 0 instant <timestamp> ; 1601 1 1 0 0 0 instant <timestamp> ;
: FILETIME>windows-time ( FILETIME -- n ) : FILETIME>windows-time ( FILETIME -- n )
[ FILETIME-dwLowDateTime ] [ dwLowDateTime>> ] [ dwHighDateTime>> ] bi >64bit ;
[ FILETIME-dwHighDateTime ]
bi >64bit ;
: windows-time>timestamp ( n -- timestamp ) : windows-time>timestamp ( n -- timestamp )
10000000 /i seconds windows-1601 swap time+ ; 10000000 /i seconds windows-1601 swap time+ ;
: windows-time ( -- n ) : windows-time ( -- n )
"FILETIME" <c-object> [ GetSystemTimeAsFileTime ] keep FILETIME <struct> [ GetSystemTimeAsFileTime ] keep
FILETIME>windows-time ; FILETIME>windows-time ;
: timestamp>windows-time ( timestamp -- n ) : timestamp>windows-time ( timestamp -- n )
@ -27,11 +26,8 @@ IN: windows.time
>gmt windows-1601 (time-) 10000000 * >integer ; >gmt windows-1601 (time-) 10000000 * >integer ;
: windows-time>FILETIME ( n -- FILETIME ) : windows-time>FILETIME ( n -- FILETIME )
"FILETIME" <c-object> [ FILETIME <struct> ] dip
[ [ 32 bits >>dwLowDateTime ] [ -32 shift >>dwHighDateTime ] bi ;
[ [ 32 bits ] dip set-FILETIME-dwLowDateTime ]
[ [ -32 shift ] dip set-FILETIME-dwHighDateTime ] 2bi
] keep ;
: timestamp>FILETIME ( timestamp -- FILETIME/f ) : timestamp>FILETIME ( timestamp -- FILETIME/f )
dup [ >gmt timestamp>windows-time windows-time>FILETIME ] when ; dup [ >gmt timestamp>windows-time windows-time>FILETIME ] when ;

22
extra/images/viewer/viewer.factor
View File

@ -1,8 +1,9 @@
! Copyright (C) 2007, 2009 Doug Coleman. ! Copyright (C) 2007, 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors images images.loader io.pathnames kernel namespaces USING: accessors images images.loader io.pathnames kernel
opengl opengl.gl opengl.textures sequences strings ui ui.gadgets models namespaces opengl opengl.gl opengl.textures sequences
ui.gadgets.panes ui.render ui.images ; strings ui ui.gadgets ui.gadgets.panes ui.images ui.render
constructors ;
IN: images.viewer IN: images.viewer
TUPLE: image-gadget < gadget image texture ; TUPLE: image-gadget < gadget image texture ;
@ -13,7 +14,20 @@ M: image-gadget pref-dim* image>> dim>> ;
dup texture>> [ ] [ dup image>> { 0 0 } <texture> >>texture texture>> ] ?if ; dup texture>> [ ] [ dup image>> { 0 0 } <texture> >>texture texture>> ] ?if ;
M: image-gadget draw-gadget* ( gadget -- ) M: image-gadget draw-gadget* ( gadget -- )
[ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture ; dup image>> [
[ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture
] [
drop
] if ;
TUPLE: image-control < image-gadget ;
CONSTRUCTOR: image-control ( model -- image-control ) ;
M: image-control pref-dim* image>> [ dim>> ] [ { 640 480 } ] if* ;
M: image-control model-changed
swap value>> >>image relayout ;
! Todo: delete texture on ungraft ! Todo: delete texture on ungraft

21
extra/system-info/windows/nt/nt.factor
View File

@ -3,37 +3,38 @@
USING: alien alien.c-types alien.strings USING: alien alien.c-types alien.strings
kernel libc math namespaces system-info.backend kernel libc math namespaces system-info.backend
system-info.windows windows windows.advapi32 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 IN: system-info.windows.nt
M: winnt cpus ( -- n ) M: winnt cpus ( -- n )
system-info SYSTEM_INFO-dwNumberOfProcessors ; system-info SYSTEM_INFO-dwNumberOfProcessors ;
: memory-status ( -- MEMORYSTATUSEX ) : memory-status ( -- MEMORYSTATUSEX )
"MEMORYSTATUSEX" <c-object> "MEMORYSTATUSEX" <struct>
"MEMORYSTATUSEX" heap-size over set-MEMORYSTATUSEX-dwLength dup class heap-size >>dwLength
dup GlobalMemoryStatusEx win32-error=0/f ; dup GlobalMemoryStatusEx win32-error=0/f ;
M: winnt memory-load ( -- n ) M: winnt memory-load ( -- n )
memory-status MEMORYSTATUSEX-dwMemoryLoad ; memory-status dwMemoryLoad>> ;
M: winnt physical-mem ( -- n ) M: winnt physical-mem ( -- n )
memory-status MEMORYSTATUSEX-ullTotalPhys ; memory-status ullTotalPhys>> ;
M: winnt available-mem ( -- n ) M: winnt available-mem ( -- n )
memory-status MEMORYSTATUSEX-ullAvailPhys ; memory-status ullAvailPhys>> ;
M: winnt total-page-file ( -- n ) M: winnt total-page-file ( -- n )
memory-status MEMORYSTATUSEX-ullTotalPageFile ; memory-status ullTotalPageFile>> ;
M: winnt available-page-file ( -- n ) M: winnt available-page-file ( -- n )
memory-status MEMORYSTATUSEX-ullAvailPageFile ; memory-status ullAvailPageFile>> ;
M: winnt total-virtual-mem ( -- n ) M: winnt total-virtual-mem ( -- n )
memory-status MEMORYSTATUSEX-ullTotalVirtual ; memory-status ullTotalVirtual>> ;
M: winnt available-virtual-mem ( -- n ) M: winnt available-virtual-mem ( -- n )
memory-status MEMORYSTATUSEX-ullAvailVirtual ; memory-status ullAvailVirtual>> ;
: computer-name ( -- string ) : computer-name ( -- string )
MAX_COMPUTERNAME_LENGTH 1 + MAX_COMPUTERNAME_LENGTH 1 +

8
extra/system-info/windows/windows.factor
View File

@ -7,18 +7,18 @@ system alien.strings windows.errors ;
IN: system-info.windows IN: system-info.windows
: system-info ( -- SYSTEM_INFO ) : system-info ( -- SYSTEM_INFO )
"SYSTEM_INFO" <c-object> [ GetSystemInfo ] keep ; SYSTEM_INFO <struct> [ GetSystemInfo ] keep ;
: page-size ( -- n ) : page-size ( -- n )
system-info SYSTEM_INFO-dwPageSize ; system-info dwPageSize>> ;
! 386, 486, 586, 2200 (IA64), 8664 (AMD_X8664) ! 386, 486, 586, 2200 (IA64), 8664 (AMD_X8664)
: processor-type ( -- n ) : 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 ! 0 = x86, 6 = Intel Itanium, 9 = x64 (AMD or Intel), 10 = WOW64, 0xffff = Unk
: processor-architecture ( -- n ) : processor-architecture ( -- n )
system-info SYSTEM_INFO-dwOemId HEX: ffff0000 bitand ; system-info dwOemId>> HEX: ffff0000 bitand ;
: os-version ( -- os-version ) : os-version ( -- os-version )
"OSVERSIONINFO" <c-object> "OSVERSIONINFO" <c-object>