Squashed commit of the following:

[factor.git] / basis / system-info / windows / windows.factor

diff --git a/basis/system-info/windows/windows.factor b/basis/system-info/windows/windows.factor
index 07cbcc41b331e4d9fb8903edfc24b99be1878b1e..0aba5eeff161bbe14ecaa8040516f9ea91cb0a13 100644 (file)
--- a/basis/system-info/windows/windows.factor
+++ b/basis/system-info/windows/windows.factor
@@ -1,9 +1,10 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types classes.struct accessors kernel
-math namespaces windows windows.kernel32 windows.advapi32 words
-combinators vocabs.loader system-info.backend system
-alien.strings windows.errors specialized-arrays ;
+USING: accessors alien alien.c-types alien.strings byte-arrays
+classes.struct combinators kernel math namespaces
+specialized-arrays system
+system-info.backend vocabs.loader windows windows.advapi32
+windows.errors windows.kernel32 words ;
 SPECIALIZED-ARRAY: ushort
 IN: system-info.windows
 
@@ -63,8 +64,41 @@ IN: system-info.windows
 : system-windows-directory ( -- str )
     \ GetSystemWindowsDirectory get-directory ;
 
-<<
-{
-    { [ os wince? ] [ "system-info.windows.ce" ] }
-    { [ os winnt? ] [ "system-info.windows.nt" ] }
-} cond require >>
+M: winnt cpus ( -- n )
+    system-info dwNumberOfProcessors>> ;
+
+: memory-status ( -- MEMORYSTATUSEX )
+    MEMORYSTATUSEX <struct>
+    MEMORYSTATUSEX heap-size >>dwLength
+    dup GlobalMemoryStatusEx win32-error=0/f ;
+
+M: winnt memory-load ( -- n )
+    memory-status dwMemoryLoad>> ;
+
+M: winnt physical-mem ( -- n )
+    memory-status ullTotalPhys>> ;
+
+M: winnt available-mem ( -- n )
+    memory-status ullAvailPhys>> ;
+
+M: winnt total-page-file ( -- n )
+    memory-status ullTotalPageFile>> ;
+
+M: winnt available-page-file ( -- n )
+    memory-status ullAvailPageFile>> ;
+
+M: winnt total-virtual-mem ( -- n )
+    memory-status ullTotalVirtual>> ;
+
+M: winnt available-virtual-mem ( -- n )
+    memory-status ullAvailVirtual>> ;
+
+: computer-name ( -- string )
+    MAX_COMPUTERNAME_LENGTH 1 +
+    [ <byte-array> dup ] keep <uint>
+    GetComputerName win32-error=0/f alien>native-string ;
+ 
+: username ( -- string )
+    UNLEN 1 +
+    [ <byte-array> dup ] keep <uint>
+    GetUserName win32-error=0/f alien>native-string ;