From 50a99dcce6305904dcf92adae78b575c8b4e9132 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 29 Aug 2009 17:41:08 -0500 Subject: [PATCH] guid, system-info --- basis/calendar/windows/windows.factor | 2 +- basis/windows/kernel32/kernel32.factor | 24 +++---- basis/windows/ole32/ole32.factor | 79 ++++++++---------------- basis/windows/winsock/winsock.factor | 11 ++-- extra/system-info/windows/windows.factor | 14 ++--- 5 files changed, 51 insertions(+), 79 deletions(-) diff --git a/basis/calendar/windows/windows.factor b/basis/calendar/windows/windows.factor index 65c922f119..265a58507c 100644 --- a/basis/calendar/windows/windows.factor +++ b/basis/calendar/windows/windows.factor @@ -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 ) diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 1adb07cf1e..2182088efe 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -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; diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor index 639a9ba637..37a3a90d3b 100755 --- a/basis/windows/ole32/ole32.factor +++ b/basis/windows/ole32/ole32.factor @@ -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" [ - { - [ 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 ; : 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 - 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 ; : winsock-expected-error? ( n -- ? ) ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING 3array member? ; diff --git a/extra/system-info/windows/windows.factor b/extra/system-info/windows/windows.factor index e68f6ce62f..8e0dc60e25 100755 --- a/extra/system-info/windows/windows.factor +++ b/extra/system-info/windows/windows.factor @@ -21,24 +21,24 @@ IN: system-info.windows system-info dwOemId>> HEX: ffff0000 bitand ; : os-version ( -- os-version ) - "OSVERSIONINFO" - "OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize + OSVERSIONINFO + 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 ; -- 2.34.1