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 PRIMITIVE: (exit) ( n -- * )
   8 PRIMITIVE: nano-count ( -- ns )
   9
  10 SINGLETONS: x86.32 x86.64 arm ppc.32 ppc.64 ;
  11
  12 UNION: x86 x86.32 x86.64 ;
  13 UNION: ppc ppc.32 ppc.64 ;
  14
  15 : cpu ( -- class ) \ cpu get-global ; foldable
  16
  17 SINGLETONS: windows macosx linux ;
  18
  19 UNION: unix macosx linux ;
  20
  21 : os ( -- class ) \ os get-global ; foldable
  22
  23 : vm-version ( -- string ) \ vm-version get-global ; foldable
  24
  25 : vm-git-label ( -- string ) \ vm-git-label get-global ; foldable
  26
  27 : vm-compiler ( -- string ) \ vm-compiler get-global ; foldable
  28
  29 : vm-compile-time ( -- string ) \ vm-compile-time get-global ; foldable
  30
  31 <PRIVATE
  32
  33 CONSTANT: string>cpu-hash H{
  34     { "x86.32" x86.32 }
  35     { "x86.64" x86.64 }
  36     { "arm" arm }
  37     { "ppc.32" ppc.32 }
  38     { "ppc.64" ppc.64 }
  39 }
  40
  41 CONSTANT: string>os-hash H{
  42     { "windows" windows }
  43     { "macosx" macosx }
  44     { "linux" linux }
  45 }
  46
  47 : key-for-value ( key hash -- val )
  48     >alist [ second = ] with find nip first ;
  49
  50 : string>cpu ( str -- class )
  51     string>cpu-hash at ;
  52
  53 : cpu>string ( class -- str )
  54     string>cpu-hash key-for-value ;
  55
  56 : string>os ( str -- class )
  57     string>os-hash at ;
  58
  59 : os>string ( class -- str )
  60     string>os-hash key-for-value ;
  61
  62 PRIVATE>
  63
  64 : image ( -- path ) \ image get-global ;
  65
  66 : vm ( -- path ) \ vm get-global ;
  67
  68 : embedded? ( -- ? ) OBJ-EMBEDDED special-object ;
  69
  70 : version-info ( -- str )
  71     ! formatting vocab not available in this context.
  72     [
  73         "Factor " % vm-version %
  74         " " % cpu cpu>string %
  75         " (" % build # ", " % vm-git-label % ", " %
  76         vm-compile-time % ")\n[" %
  77         vm-compiler % "] on " % os os>string %
  78     ] "" make ;
  79
  80 : exit ( n -- * )
  81     [ do-shutdown-hooks (exit) ] ignore-errors
  82     [ "Unexpected error during shutdown!" print ] ignore-errors
  83     255 (exit) ;