core/system/system.factor

   1 ! copyright (c) 2007, 2010 slava pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs continuations init io kernel kernel.private make
   4 math.parser namespaces sequences ;
   5 IN: system
   6
   7 SINGLETONS: x86.32 x86.64 arm ppc.32 ppc.64 ;
   8
   9 UNION: x86 x86.32 x86.64 ;
  10 UNION: ppc ppc.32 ppc.64 ;
  11
  12 : cpu ( -- class ) \ cpu get-global ; foldable
  13
  14 SINGLETONS: windows macosx linux ;
  15
  16 UNION: unix macosx linux ;
  17
  18 : os ( -- class ) \ os get-global ; foldable
  19
  20 : vm-version ( -- string ) \ vm-version get-global ; foldable
  21
  22 : vm-git-label ( -- string ) \ vm-git-label get-global ; foldable
  23
  24 : vm-compiler ( -- string ) \ vm-compiler get-global ; foldable
  25
  26 : vm-compile-time ( -- string ) \ vm-compile-time get-global ; foldable
  27
  28 <PRIVATE
  29
  30 CONSTANT: string>cpu-hash H{
  31     { "x86.32" x86.32 }
  32     { "x86.64" x86.64 }
  33     { "arm" arm }
  34     { "ppc.32" ppc.32 }
  35     { "ppc.64" ppc.64 }
  36 }
  37
  38 CONSTANT: string>os-hash H{
  39     { "windows" windows }
  40     { "macosx" macosx }
  41     { "linux" linux }
  42 }
  43
  44 : key-for-value ( key hash -- val )
  45     >alist [ second = ] with find nip first ;
  46
  47 : string>cpu ( str -- class )
  48     string>cpu-hash at ;
  49
  50 : cpu>string ( class -- str )
  51     string>cpu-hash key-for-value ;
  52
  53 : string>os ( str -- class )
  54     string>os-hash at ;
  55
  56 : os>string ( class -- str )
  57     string>os-hash key-for-value ;
  58
  59 PRIVATE>
  60
  61 : image ( -- path ) \ image get-global ;
  62
  63 : vm ( -- path ) \ vm get-global ;
  64
  65 : embedded? ( -- ? ) OBJ-EMBEDDED special-object ;
  66
  67 : version-info ( -- str )
  68     ! formatting vocab not available in this context.
  69     [
  70         "Factor " % vm-version %
  71         " " % cpu cpu>string %
  72         " (" % build # ", " % vm-git-label % ", " %
  73         vm-compile-time % ")\n[" %
  74         vm-compiler % "] on " % os os>string %
  75     ] "" make ;
  76
  77 : exit ( n -- * )
  78     [ do-shutdown-hooks (exit) ] ignore-errors
  79     [ "Unexpected error during shutdown!" print ] ignore-errors
  80     255 (exit) ;