core/system/system.factor

   1 ! Copyright (C) 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: system
   4 USING: kernel kernel.private sequences math namespaces
   5 init splitting assocs system.private layouts words ;
   6
   7 SINGLETON: x86.32
   8 SINGLETON: x86.64
   9 SINGLETON: arm
  10 SINGLETON: ppc
  11
  12 UNION: x86 x86.32 x86.64 ;
  13
  14 : cpu ( -- class ) \ cpu get-global ; foldable
  15
  16 SINGLETON: winnt
  17 SINGLETON: wince
  18
  19 UNION: windows winnt wince ;
  20
  21 SINGLETON: freebsd
  22 SINGLETON: netbsd
  23 SINGLETON: openbsd
  24 SINGLETON: solaris
  25 SINGLETON: macosx
  26 SINGLETON: linux
  27
  28 SINGLETON: haiku
  29
  30 UNION: bsd freebsd netbsd openbsd macosx ;
  31
  32 UNION: unix bsd solaris linux haiku ;
  33
  34 : os ( -- class ) \ os get-global ; foldable
  35
  36 <PRIVATE
  37
  38 : string>cpu ( str -- class )
  39     H{
  40         { "x86.32" x86.32 }
  41         { "x86.64" x86.64 }
  42         { "arm" arm }
  43         { "ppc" ppc }
  44     } at ;
  45
  46 : string>os ( str -- class )
  47     H{
  48         { "winnt" winnt }
  49         { "wince" wince }
  50         { "freebsd" freebsd }
  51         { "netbsd" netbsd }
  52         { "openbsd" openbsd }
  53         { "solaris" solaris }
  54         { "macosx" macosx }
  55         { "linux" linux }
  56         { "haiku" haiku }
  57     } at ;
  58
  59 PRIVATE>
  60
  61 : image ( -- path ) \ image get-global ;
  62
  63 : vm ( -- path ) \ vm get-global ;
  64
  65 [
  66     8 getenv string>cpu \ cpu set-global
  67     9 getenv string>os \ os set-global
  68 ] "system" add-init-hook
  69
  70 : embedded? ( -- ? ) 15 getenv ;
  71
  72 : millis ( -- ms ) micros 1000 /i ;