2008-12-06 23:58:19 -05:00
|
|
|
! Copyright (C) 2008 Doug Coleman.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-04-20 06:15:46 -04:00
|
|
|
USING: alien alien.c-types alien.strings
|
2008-12-06 23:58:19 -05:00
|
|
|
kernel libc math namespaces system-info.backend
|
|
|
|
system-info.windows windows windows.advapi32
|
2009-08-25 19:19:34 -04:00
|
|
|
windows.kernel32 system byte-arrays windows.errors
|
2009-08-28 06:38:29 -04:00
|
|
|
classes classes.struct accessors ;
|
2008-12-06 23:58:19 -05:00
|
|
|
IN: system-info.windows.nt
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-04-03 02:48:29 -04:00
|
|
|
M: winnt cpus ( -- n )
|
2009-08-28 06:38:29 -04:00
|
|
|
system-info dwNumberOfProcessors>> ;
|
2008-01-30 03:46:39 -05:00
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
: memory-status ( -- MEMORYSTATUSEX )
|
2010-05-22 22:23:45 -04:00
|
|
|
MEMORYSTATUSEX <struct>
|
2010-05-23 03:07:47 -04:00
|
|
|
MEMORYSTATUSEX heap-size >>dwLength
|
2008-12-03 21:35:03 -05:00
|
|
|
dup GlobalMemoryStatusEx win32-error=0/f ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-04-03 02:48:29 -04:00
|
|
|
M: winnt memory-load ( -- n )
|
2009-08-25 19:19:34 -04:00
|
|
|
memory-status dwMemoryLoad>> ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-04-03 02:48:29 -04:00
|
|
|
M: winnt physical-mem ( -- n )
|
2009-08-25 19:19:34 -04:00
|
|
|
memory-status ullTotalPhys>> ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-04-03 02:48:29 -04:00
|
|
|
M: winnt available-mem ( -- n )
|
2009-08-25 19:19:34 -04:00
|
|
|
memory-status ullAvailPhys>> ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-04-03 02:48:29 -04:00
|
|
|
M: winnt total-page-file ( -- n )
|
2009-08-25 19:19:34 -04:00
|
|
|
memory-status ullTotalPageFile>> ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-04-03 02:48:29 -04:00
|
|
|
M: winnt available-page-file ( -- n )
|
2009-08-25 19:19:34 -04:00
|
|
|
memory-status ullAvailPageFile>> ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-04-03 02:48:29 -04:00
|
|
|
M: winnt total-virtual-mem ( -- n )
|
2009-08-25 19:19:34 -04:00
|
|
|
memory-status ullTotalVirtual>> ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-04-03 02:48:29 -04:00
|
|
|
M: winnt available-virtual-mem ( -- n )
|
2009-08-25 19:19:34 -04:00
|
|
|
memory-status ullAvailVirtual>> ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: computer-name ( -- string )
|
2009-08-13 20:21:44 -04:00
|
|
|
MAX_COMPUTERNAME_LENGTH 1 +
|
2008-12-03 21:35:03 -05:00
|
|
|
[ <byte-array> dup ] keep <uint>
|
|
|
|
GetComputerName win32-error=0/f alien>native-string ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: username ( -- string )
|
2009-04-30 11:25:59 -04:00
|
|
|
UNLEN 1 +
|
2008-12-03 21:35:03 -05:00
|
|
|
[ <byte-array> dup ] keep <uint>
|
|
|
|
GetUserName win32-error=0/f alien>native-string ;
|