1 ! Copyright (C) 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.data alien.strings
4 arrays byte-arrays classes.struct combinators kernel math
5 namespaces specialized-arrays system
6 vocabs.loader windows windows.advapi32
7 windows.errors windows.kernel32 words system-info ;
8 SPECIALIZED-ARRAY: ushort
9 IN: system-info.windows
11 : system-info ( -- SYSTEM_INFO )
12 SYSTEM_INFO <struct> [ GetSystemInfo ] keep ;
15 system-info dwPageSize>> ;
17 ! 386, 486, 586, 2200 (IA64), 8664 (AMD_X8664)
18 : processor-type ( -- n )
19 system-info dwProcessorType>> ;
21 ! 0 = x86, 6 = Intel Itanium, 9 = x64 (AMD or Intel), 10 = WOW64, 0xffff = Unk
22 : processor-architecture ( -- n )
23 system-info dwOemId>> 0xffff0000 bitand ;
25 : os-version-struct ( -- os-version )
26 OSVERSIONINFO <struct>
27 OSVERSIONINFO heap-size >>dwOSVersionInfoSize
28 dup GetVersionEx win32-error=0/f ;
30 : windows-major ( -- n )
31 os-version-struct dwMajorVersion>> ;
33 : windows-minor ( -- n )
34 os-version-struct dwMinorVersion>> ;
36 M: windows os-version ( -- obj )
37 os-version-struct [ dwMajorVersion>> ] [ dwMinorVersion>> ] bi 2array ;
39 : windows-build# ( -- n )
40 os-version-struct dwBuildNumber>> ;
42 : windows-platform-id ( -- n )
43 os-version-struct dwPlatformId>> ;
45 : windows-service-pack ( -- string )
46 os-version-struct szCSDVersion>> alien>native-string ;
48 : feature-present? ( n -- ? )
49 IsProcessorFeaturePresent zero? not ;
52 PF_XMMI64_INSTRUCTIONS_AVAILABLE feature-present? ;
55 PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ;
57 : get-directory ( word -- str )
58 [ MAX_UNICODE_PATH [ ushort <c-array> ] keep dupd ] dip
59 execute win32-error=0/f alien>native-string ; inline
61 : windows-directory ( -- str )
62 \ GetWindowsDirectory get-directory ;
64 : system-directory ( -- str )
65 \ GetSystemDirectory get-directory ;
67 : system-windows-directory ( -- str )
68 \ GetSystemWindowsDirectory get-directory ;
70 M: windows cpus ( -- n )
71 system-info dwNumberOfProcessors>> ;
73 : memory-status ( -- MEMORYSTATUSEX )
74 MEMORYSTATUSEX <struct>
75 MEMORYSTATUSEX heap-size >>dwLength
76 dup GlobalMemoryStatusEx win32-error=0/f ;
78 M: windows memory-load ( -- n )
79 memory-status dwMemoryLoad>> ;
81 M: windows physical-mem ( -- n )
82 memory-status ullTotalPhys>> ;
84 M: windows available-mem ( -- n )
85 memory-status ullAvailPhys>> ;
87 M: windows total-page-file ( -- n )
88 memory-status ullTotalPageFile>> ;
90 M: windows available-page-file ( -- n )
91 memory-status ullAvailPageFile>> ;
93 M: windows total-virtual-mem ( -- n )
94 memory-status ullTotalVirtual>> ;
96 M: windows available-virtual-mem ( -- n )
97 memory-status ullAvailVirtual>> ;
99 : computer-name ( -- string )
100 MAX_COMPUTERNAME_LENGTH 1 +
101 [ <byte-array> dup ] keep uint <ref>
102 GetComputerName win32-error=0/f alien>native-string ;
104 : username ( -- string )
106 [ <byte-array> dup ] keep uint <ref>
107 GetUserName win32-error=0/f alien>native-string ;