]> gitweb.factorcode.org Git - factor.git/blob - extra/system-info/windows/nt/nt.factor
Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...
[factor.git] / extra / system-info / windows / nt / nt.factor
1 ! Copyright (C) 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.c-types alien.strings
4 kernel libc math namespaces system-info.backend
5 system-info.windows windows windows.advapi32
6 windows.kernel32 system byte-arrays windows.errors ;
7 IN: system-info.windows.nt
8
9 M: winnt cpus ( -- n )
10     system-info SYSTEM_INFO-dwNumberOfProcessors ;
11
12 : memory-status ( -- MEMORYSTATUSEX )
13     "MEMORYSTATUSEX" <c-object>
14     "MEMORYSTATUSEX" heap-size over set-MEMORYSTATUSEX-dwLength
15     dup GlobalMemoryStatusEx win32-error=0/f ;
16
17 M: winnt memory-load ( -- n )
18     memory-status MEMORYSTATUSEX-dwMemoryLoad ;
19
20 M: winnt physical-mem ( -- n )
21     memory-status MEMORYSTATUSEX-ullTotalPhys ;
22
23 M: winnt available-mem ( -- n )
24     memory-status MEMORYSTATUSEX-ullAvailPhys ;
25
26 M: winnt total-page-file ( -- n )
27     memory-status MEMORYSTATUSEX-ullTotalPageFile ;
28
29 M: winnt available-page-file ( -- n )
30     memory-status MEMORYSTATUSEX-ullAvailPageFile ;
31
32 M: winnt total-virtual-mem ( -- n )
33     memory-status MEMORYSTATUSEX-ullTotalVirtual ;
34
35 M: winnt available-virtual-mem ( -- n )
36     memory-status MEMORYSTATUSEX-ullAvailVirtual ;
37
38 : computer-name ( -- string )
39     MAX_COMPUTERNAME_LENGTH 1 +
40     [ <byte-array> dup ] keep <uint>
41     GetComputerName win32-error=0/f alien>native-string ;
42  
43 : username ( -- string )
44     UNLEN 1 +
45     [ <byte-array> dup ] keep <uint>
46     GetUserName win32-error=0/f alien>native-string ;