]> gitweb.factorcode.org Git - factor.git/blob - basis/system-info/windows/windows.factor
Switch to https urls
[factor.git] / basis / system-info / windows / windows.factor
1 ! Copyright (C) 2008 Doug Coleman.
2 ! See https://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 sequences specialized-arrays system
6 system-info vocabs.loader windows windows.advapi32
7 windows.errors windows.kernel32 windows.powrprof words ;
8 SPECIALIZED-ARRAY: ushort
9 IN: system-info.windows
10
11 : system-info ( -- SYSTEM_INFO )
12     SYSTEM_INFO new [ GetSystemInfo ] keep ;
13
14 : page-size ( -- n )
15     system-info dwPageSize>> ;
16
17 ! 386, 486, 586, 2200 (IA64), 8664 (AMD_X8664)
18 : processor-type ( -- n )
19     system-info dwProcessorType>> ;
20
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 ;
24
25 : os-version-struct ( -- os-version )
26     OSVERSIONINFO new
27         OSVERSIONINFO heap-size >>dwOSVersionInfoSize
28     dup GetVersionEx win32-error=0/f ;
29
30 : windows-major ( -- n )
31     os-version-struct dwMajorVersion>> ;
32
33 : windows-minor ( -- n )
34     os-version-struct dwMinorVersion>> ;
35
36 M: windows os-version
37     os-version-struct [ dwMajorVersion>> ] [ dwMinorVersion>> ] bi 2array ;
38
39 : windows-build# ( -- n )
40     os-version-struct dwBuildNumber>> ;
41
42 : windows-platform-id ( -- n )
43     os-version-struct dwPlatformId>> ;
44
45 : windows-service-pack ( -- string )
46     os-version-struct szCSDVersion>> alien>native-string ;
47
48 : feature-present? ( n -- ? )
49     IsProcessorFeaturePresent zero? not ;
50
51 : sse2? ( -- ? )
52     PF_XMMI64_INSTRUCTIONS_AVAILABLE feature-present? ;
53
54 : sse3? ( -- ? )
55     PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ;
56
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
60
61 : windows-directory ( -- str )
62     \ GetWindowsDirectory get-directory ;
63
64 : system-directory ( -- str )
65     \ GetSystemDirectory get-directory ;
66
67 : system-windows-directory ( -- str )
68     \ GetSystemWindowsDirectory get-directory ;
69
70 M: windows cpus
71     system-info dwNumberOfProcessors>> ;
72
73 M: windows cpu-mhz
74     get-processor-power-information first MaxMhz>> 1,000,000 * ;
75
76 : memory-status ( -- MEMORYSTATUSEX )
77     MEMORYSTATUSEX new
78     MEMORYSTATUSEX heap-size >>dwLength
79     dup GlobalMemoryStatusEx win32-error=0/f ;
80
81 M: windows memory-load
82     memory-status dwMemoryLoad>> ;
83
84 M: windows physical-mem
85     memory-status ullTotalPhys>> ;
86
87 M: windows available-mem
88     memory-status ullAvailPhys>> ;
89
90 M: windows total-page-file
91     memory-status ullTotalPageFile>> ;
92
93 M: windows available-page-file
94     memory-status ullAvailPageFile>> ;
95
96 M: windows total-virtual-mem
97     memory-status ullTotalVirtual>> ;
98
99 M: windows available-virtual-mem
100     memory-status ullAvailVirtual>> ;
101
102 M: windows computer-name
103     MAX_COMPUTERNAME_LENGTH 1 +
104     [ <byte-array> dup ] keep uint <ref>
105     GetComputerName win32-error=0/f alien>native-string ;
106
107 M: windows username ( -- string )
108     UNLEN 1 +
109     [ <byte-array> dup ] keep uint <ref>
110     GetUserName win32-error=0/f alien>native-string ;