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