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 UNION: bsd freebsd netbsd openbsd macosx ;
  29
  30 UNION: unix bsd solaris linux ;
  31
  32 : os ( -- class ) \ os get-global ; foldable
  33
  34 <PRIVATE
  35
  36 : string>cpu ( str -- class )
  37     H{
  38         { "x86.32" x86.32 }
  39         { "x86.64" x86.64 }
  40         { "arm" arm }
  41         { "ppc" ppc }
  42     } at ;
  43
  44 : string>os ( str -- class )
  45     H{
  46         { "winnt" winnt }
  47         { "wince" wince }
  48         { "freebsd" freebsd }
  49         { "netbsd" netbsd }
  50         { "openbsd" openbsd }
  51         { "solaris" solaris }
  52         { "macosx" macosx }
  53         { "linux" linux }
  54     } at ;
  55
  56 PRIVATE>
  57
  58 : image ( -- path ) \ image get-global ;
  59
  60 : vm ( -- path ) \ vm get-global ;
  61
  62 [
  63     8 getenv string>cpu \ cpu set-global
  64     9 getenv string>os \ os set-global
  65 ] "system" add-init-hook
  66
  67 : embedded? ( -- ? ) 15 getenv ;
  68
  69 : os-envs ( -- assoc )
  70     (os-envs) [ "=" split1 ] H{ } map>assoc ;
  71
  72 : set-os-envs ( assoc -- )
  73     [ "=" swap 3append ] { } assoc>map (set-os-envs) ;