2016-04-14 19:59:08 -04:00
|
|
|
! Copyright (c) 2007, 2010 slava pestov.
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2016-08-11 11:32:02 -04:00
|
|
|
USING: accessors assocs continuations init io kernel kernel.private make
|
2016-04-14 19:59:08 -04:00
|
|
|
math math.parser namespaces sequences ;
|
2009-05-02 14:45:38 -04:00
|
|
|
IN: system
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2015-06-25 21:02:03 -04:00
|
|
|
PRIMITIVE: (exit) ( n -- * )
|
2016-11-01 20:16:11 -04:00
|
|
|
PRIMITIVE: disable-ctrl-break ( -- )
|
|
|
|
PRIMITIVE: enable-ctrl-break ( -- )
|
2015-06-25 21:02:03 -04:00
|
|
|
PRIMITIVE: nano-count ( -- ns )
|
|
|
|
|
2011-05-20 18:11:50 -04:00
|
|
|
SINGLETONS: x86.32 x86.64 arm ppc.32 ppc.64 ;
|
2008-04-02 17:32:58 -04:00
|
|
|
|
2008-04-02 18:07:38 -04:00
|
|
|
UNION: x86 x86.32 x86.64 ;
|
2011-05-20 18:11:50 -04:00
|
|
|
UNION: ppc ppc.32 ppc.64 ;
|
2008-04-02 18:07:38 -04:00
|
|
|
|
2008-10-02 06:15:05 -04:00
|
|
|
: cpu ( -- class ) \ cpu get-global ; foldable
|
2008-04-02 17:32:58 -04:00
|
|
|
|
2011-11-02 20:13:31 -04:00
|
|
|
SINGLETONS: windows macosx linux ;
|
2008-04-02 19:25:33 -04:00
|
|
|
|
2011-11-02 20:13:31 -04:00
|
|
|
UNION: unix macosx linux ;
|
2008-04-02 17:32:58 -04:00
|
|
|
|
2008-10-02 06:15:05 -04:00
|
|
|
: os ( -- class ) \ os get-global ; foldable
|
2008-04-02 17:32:58 -04:00
|
|
|
|
2016-03-16 11:18:23 -04:00
|
|
|
: vm-version ( -- string ) \ vm-version get-global ;
|
2013-08-19 11:34:29 -04:00
|
|
|
|
2016-03-16 11:18:23 -04:00
|
|
|
: vm-git-label ( -- string ) \ vm-git-label get-global ;
|
2013-08-19 11:34:29 -04:00
|
|
|
|
2016-04-14 19:59:08 -04:00
|
|
|
: vm-git-ref ( -- string )
|
|
|
|
vm-git-label CHAR: - over last-index head ;
|
2015-08-04 19:57:19 -04:00
|
|
|
|
2016-04-14 19:59:08 -04:00
|
|
|
: vm-git-id ( -- string )
|
|
|
|
vm-git-label CHAR: - over last-index 1 + tail ;
|
2015-08-04 19:57:19 -04:00
|
|
|
|
2016-03-16 11:18:23 -04:00
|
|
|
: vm-compiler ( -- string ) \ vm-compiler get-global ;
|
2010-03-01 16:32:07 -05:00
|
|
|
|
2016-03-16 11:18:23 -04:00
|
|
|
: vm-compile-time ( -- string ) \ vm-compile-time get-global ;
|
2013-08-19 11:34:29 -04:00
|
|
|
|
2015-07-20 03:17:09 -04:00
|
|
|
: image-path ( -- path ) \ image-path get-global ;
|
2008-09-18 23:08:12 -04:00
|
|
|
|
2015-07-20 03:03:00 -04:00
|
|
|
: vm-path ( -- path ) \ vm-path get-global ;
|
2008-09-18 23:08:12 -04:00
|
|
|
|
2014-09-19 10:31:14 -04:00
|
|
|
: embedded? ( -- ? ) OBJ-EMBEDDED special-object ;
|
2013-08-19 11:34:29 -04:00
|
|
|
|
|
|
|
: version-info ( -- str )
|
|
|
|
! formatting vocab not available in this context.
|
2013-08-25 11:41:39 -04:00
|
|
|
[
|
2014-11-11 19:44:00 -05:00
|
|
|
"Factor " % vm-version %
|
2016-08-11 11:32:02 -04:00
|
|
|
" " % cpu name>> %
|
2015-08-04 19:57:19 -04:00
|
|
|
" (" % build # ", " %
|
2016-04-14 19:59:08 -04:00
|
|
|
vm-git-ref % "-" %
|
|
|
|
vm-git-id 10 short head % ", " %
|
2014-11-13 12:58:20 -05:00
|
|
|
vm-compile-time % ")\n[" %
|
2016-08-11 11:32:02 -04:00
|
|
|
vm-compiler % "] on " % os name>> %
|
2013-08-25 11:41:39 -04:00
|
|
|
] "" make ;
|
2014-09-19 10:31:14 -04:00
|
|
|
|
|
|
|
: exit ( n -- * )
|
|
|
|
[ do-shutdown-hooks (exit) ] ignore-errors
|
|
|
|
[ "Unexpected error during shutdown!" print ] ignore-errors
|
|
|
|
255 (exit) ;
|