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

guid, system-info

db4
Doug Coleman 2009-08-29 17:41:08 -05:00
parent 0c37990f53
commit 50a99dcce6
5 changed files with 51 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/calendar/windows/windows.factor
View File

@ -1,6 +1,6 @@
USING: calendar namespaces alien.c-types system
windows.kernel32 kernel math combinators windows.errors
classes.struct accessors ;
accessors classes.struct ;
IN: calendar.windows
M: windows gmt-offset ( -- hours minutes seconds )

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

@ -307,13 +307,13 @@ STRUCT: MEMORYSTATUSEX
TYPEDEF: void* LPMEMORYSTATUSEX
C-STRUCT: OSVERSIONINFO
{ "DWORD" "dwOSVersionInfoSize" }
{ "DWORD" "dwMajorVersion" }
{ "DWORD" "dwMinorVersion" }
{ "DWORD" "dwBuildNumber" }
{ "DWORD" "dwPlatformId" }
{ { "WCHAR" 128 } "szCSDVersion" } ;
STRUCT: OSVERSIONINFO
{ dwOSVersionInfoSize DWORD }
{ dwMajorVersion DWORD }
{ dwMinorVersion DWORD }
{ dwBuildNumber DWORD }
{ dwPlatformId DWORD }
{ szCSDVersion WCHAR[128] } ;
TYPEDEF: void* LPOSVERSIONINFO
@ -326,11 +326,11 @@ C-STRUCT: MEMORY_BASIC_INFORMATION
{ "DWORD" "protect" }
{ "DWORD" "type" } ;
C-STRUCT: GUID
{ "ULONG" "Data1" }
{ "WORD" "Data2" }
{ "WORD" "Data3" }
{ { "UCHAR" 8 } "Data4" } ;
STRUCT: GUID
{ Data1 ULONG }
{ Data2 WORD }
{ Data3 WORD }
{ Data4 UCHAR[8] } ;
/*
fBinary :1;

79
basis/windows/ole32/ole32.factor
View File

@ -1,7 +1,8 @@
USING: alien alien.syntax alien.c-types alien.strings math
kernel sequences windows.errors windows.types io
accessors math.order namespaces make math.parser windows.kernel32
combinators locals specialized-arrays.direct.uchar ;
combinators locals specialized-arrays.direct.uchar
literals splitting grouping classes.struct combinators.smart ;
IN: windows.ole32
LIBRARY: ole32
@ -130,60 +131,34 @@ TUPLE: ole32-error code message ;
: guid= ( a b -- ? )
[ 16 memory>byte-array ] bi@ = ;
: GUID-STRING-LENGTH ( -- n )
"{01234567-89ab-cdef-0123-456789abcdef}" length ; inline
:: (guid-section>guid) ( string guid start end quot -- )
start end string subseq hex> guid quot call ; inline
:: (guid-byte>guid) ( string guid start end byte -- )
start end string subseq hex> byte guid set-nth ; inline
CONSTANT: GUID-STRING-LENGTH
$[ "{01234567-89ab-cdef-0123-456789abcdef}" length ]
: string>guid ( string -- guid )
"GUID" <c-object> [
{
[ 1 9 [ set-GUID-Data1 ] (guid-section>guid) ]
[ 10 14 [ set-GUID-Data2 ] (guid-section>guid) ]
[ 15 19 [ set-GUID-Data3 ] (guid-section>guid) ]
[ ]
} 2cleave
GUID-Data4 {
[ 20 22 0 (guid-byte>guid) ]
[ 22 24 1 (guid-byte>guid) ]
[ 25 27 2 (guid-byte>guid) ]
[ 27 29 3 (guid-byte>guid) ]
[ 29 31 4 (guid-byte>guid) ]
[ 31 33 5 (guid-byte>guid) ]
[ 33 35 6 (guid-byte>guid) ]
[ 35 37 7 (guid-byte>guid) ]
} 2cleave
] keep ;
: (guid-section%) ( guid quot len -- )
[ call >hex ] dip CHAR: 0 pad-head % ; inline
: (guid-byte%) ( guid byte -- )
swap nth >hex 2 CHAR: 0 pad-head % ; inline
"{-}" split harvest
[ first3 [ hex> ] tri@ ]
[ 3 tail concat 2 group [ hex> ] B{ } map-as ] bi
GUID <struct-boa> ;
: guid>string ( guid -- string )
[
"{" % {
[ [ GUID-Data1 ] 8 (guid-section%) "-" % ]
[ [ GUID-Data2 ] 4 (guid-section%) "-" % ]
[ [ GUID-Data3 ] 4 (guid-section%) "-" % ]
[ ]
[ "{" ] dip {
[ Data1>> >hex "-" ]
[ Data2>> >hex "-" ]
[ Data3>> >hex "-" ]
[
Data4>> [
{
[ >hex 2 CHAR: 0 pad-head ]
[ >hex 2 CHAR: 0 pad-head "-" ]
[ >hex 2 CHAR: 0 pad-head ]
[ >hex 2 CHAR: 0 pad-head ]
[ >hex 2 CHAR: 0 pad-head ]
[ >hex 2 CHAR: 0 pad-head ]
[ >hex 2 CHAR: 0 pad-head ]
[ >hex 2 CHAR: 0 pad-head ]
} spread
] input<sequence "}"
]
} cleave
GUID-Data4 {
[ 0 (guid-byte%) ]
[ 1 (guid-byte%) "-" % ]
[ 2 (guid-byte%) ]
[ 3 (guid-byte%) ]
[ 4 (guid-byte%) ]
[ 5 (guid-byte%) ]
[ 6 (guid-byte%) ]
[ 7 (guid-byte%) "}" % ]
} cleave
] "" make ;
] "" append-outputs-as ;

11
basis/windows/winsock/winsock.factor
View File

@ -377,8 +377,6 @@ FUNCTION: DWORD WSAWaitForMultipleEvents ( DWORD cEvents,
BOOL fAlertable ) ;
LIBRARY: mswsock
! Not in Windows CE
@ -388,14 +386,13 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
: WSAID_CONNECTEX ( -- GUID )
"GUID" <c-object>
HEX: 25a207b9 over set-GUID-Data1
HEX: ddf3 over set-GUID-Data2
HEX: 4660 over set-GUID-Data3
HEX: 25a207b9
HEX: ddf3
HEX: 4660
B{
HEX: 8e HEX: e9 HEX: 76 HEX: e5
HEX: 8c HEX: 74 HEX: 06 HEX: 3e
} over set-GUID-Data4 ;
} GUID <struct-boa> ;
: winsock-expected-error? ( n -- ? )
ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING 3array member? ;

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

@ -21,24 +21,24 @@ IN: system-info.windows
system-info dwOemId>> HEX: ffff0000 bitand ;
: os-version ( -- os-version )
"OSVERSIONINFO" <c-object>
"OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
OSVERSIONINFO <struct>
OSVERSIONINFO heap-size >>dwOSVersionInfoSize
dup GetVersionEx win32-error=0/f ;
: windows-major ( -- n )
os-version OSVERSIONINFO-dwMajorVersion ;
os-version dwMajorVersion>> ;
: windows-minor ( -- n )
os-version OSVERSIONINFO-dwMinorVersion ;
os-version dwMinorVersion>> ;
: windows-build# ( -- n )
os-version OSVERSIONINFO-dwBuildNumber ;
os-version dwBuildNumber>> ;
: windows-platform-id ( -- n )
os-version OSVERSIONINFO-dwPlatformId ;
os-version dwPlatformId>> ;
: windows-service-pack ( -- string )
os-version OSVERSIONINFO-szCSDVersion alien>native-string ;
os-version szCSDVersion>> alien>native-string ;
: feature-present? ( n -- ? )
IsProcessorFeaturePresent zero? not ;