extra/system-info/windows/windows.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.c-types kernel libc math namespaces
   4 windows windows.kernel32 windows.advapi32
   5 words combinators vocabs.loader system-info.backend
   6 system alien.strings ;
   7 IN: system-info.windows
   8
   9 : system-info ( -- SYSTEM_INFO )
  10     "SYSTEM_INFO" <c-object> [ GetSystemInfo ] keep ;
  11
  12 : page-size ( -- n )
  13     system-info SYSTEM_INFO-dwPageSize ;
  14
  15 ! 386, 486, 586, 2200 (IA64), 8664 (AMD_X8664)
  16 : processor-type ( -- n )
  17     system-info SYSTEM_INFO-dwProcessorType ;
  18
  19 ! 0 = x86, 6 = Intel Itanium, 9 = x64 (AMD or Intel), 10 = WOW64, 0xffff = Unk
  20 : processor-architecture ( -- n )
  21     system-info SYSTEM_INFO-dwOemId HEX: ffff0000 bitand ;
  22
  23 : os-version ( -- os-version )
  24     "OSVERSIONINFO" <c-object>
  25     "OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
  26     dup GetVersionEx win32-error=0/f ;
  27
  28 : windows-major ( -- n )
  29     os-version OSVERSIONINFO-dwMajorVersion ;
  30
  31 : windows-minor ( -- n )
  32     os-version OSVERSIONINFO-dwMinorVersion ;
  33
  34 : windows-build# ( -- n )
  35     os-version OSVERSIONINFO-dwBuildNumber ;
  36
  37 : windows-platform-id ( -- n )
  38     os-version OSVERSIONINFO-dwPlatformId ;
  39
  40 : windows-service-pack ( -- string )
  41     os-version OSVERSIONINFO-szCSDVersion alien>native-string ;
  42
  43 : feature-present? ( n -- ? )
  44     IsProcessorFeaturePresent zero? not ;
  45
  46 : sse2? ( -- ? )
  47     PF_XMMI64_INSTRUCTIONS_AVAILABLE feature-present? ;
  48
  49 : sse3? ( -- ? )
  50     PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ;
  51
  52 : <u16-string-object> ( n -- obj )
  53     "ushort" <c-array> ;
  54
  55 : get-directory ( word -- str )
  56     [ MAX_UNICODE_PATH [ <u16-string-object> ] keep dupd ] dip
  57     execute win32-error=0/f alien>native-string ; inline
  58
  59 : windows-directory ( -- str )
  60     \ GetWindowsDirectory get-directory ;
  61
  62 : system-directory ( -- str )
  63     \ GetSystemDirectory get-directory ;
  64
  65 : system-windows-directory ( -- str )
  66     \ GetSystemWindowsDirectory get-directory ;
  67
  68 <<
  69 {
  70     { [ os wince? ] [ "system-info.windows.ce" ] }
  71     { [ os winnt? ] [ "system-info.windows.nt" ] }
  72 } cond require >>