core/system/system.factor

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