basis/system-info/windows/windows.factor

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