2009-05-02 14:45:38 -04:00
|
|
|
! Copyright (C) 2007, 2009 Slava Pestov.
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2007-11-12 23:18:29 -05:00
|
|
|
USING: kernel kernel.private sequences math namespaces
|
2008-04-02 17:32:58 -04:00
|
|
|
init splitting assocs system.private layouts words ;
|
2009-05-02 14:45:38 -04:00
|
|
|
IN: system
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-05-02 14:45:38 -04:00
|
|
|
SINGLETONS: x86.32 x86.64 arm ppc ;
|
2008-04-02 17:32:58 -04:00
|
|
|
|
2008-04-02 18:07:38 -04:00
|
|
|
UNION: x86 x86.32 x86.64 ;
|
|
|
|
|
2008-10-02 06:15:05 -04:00
|
|
|
: cpu ( -- class ) \ cpu get-global ; foldable
|
2008-04-02 17:32:58 -04:00
|
|
|
|
2009-05-02 14:45:38 -04:00
|
|
|
SINGLETONS: winnt wince ;
|
2008-04-02 19:25:33 -04:00
|
|
|
|
|
|
|
UNION: windows winnt wince ;
|
|
|
|
|
2009-05-02 14:45:38 -04:00
|
|
|
SINGLETONS: freebsd netbsd openbsd solaris macosx linux ;
|
2008-04-02 19:25:33 -04:00
|
|
|
|
2009-02-28 16:01:28 -05:00
|
|
|
SINGLETON: haiku
|
|
|
|
|
2008-04-02 19:25:33 -04:00
|
|
|
UNION: bsd freebsd netbsd openbsd macosx ;
|
2008-04-02 17:32:58 -04:00
|
|
|
|
2009-02-28 16:01:28 -05:00
|
|
|
UNION: unix bsd solaris linux haiku ;
|
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
|
|
|
|
2010-03-01 16:32:07 -05:00
|
|
|
: vm-compiler ( -- string ) \ vm-compiler get-global ; foldable
|
|
|
|
|
2008-04-02 18:07:38 -04:00
|
|
|
<PRIVATE
|
|
|
|
|
|
|
|
: string>cpu ( str -- class )
|
|
|
|
H{
|
|
|
|
{ "x86.32" x86.32 }
|
|
|
|
{ "x86.64" x86.64 }
|
|
|
|
{ "arm" arm }
|
|
|
|
{ "ppc" ppc }
|
|
|
|
} at ;
|
|
|
|
|
2008-04-02 19:25:33 -04:00
|
|
|
: string>os ( str -- class )
|
|
|
|
H{
|
|
|
|
{ "winnt" winnt }
|
|
|
|
{ "wince" wince }
|
|
|
|
{ "freebsd" freebsd }
|
|
|
|
{ "netbsd" netbsd }
|
|
|
|
{ "openbsd" openbsd }
|
|
|
|
{ "solaris" solaris }
|
|
|
|
{ "macosx" macosx }
|
|
|
|
{ "linux" linux }
|
2009-02-28 16:01:28 -05:00
|
|
|
{ "haiku" haiku }
|
2008-04-02 19:25:33 -04:00
|
|
|
} at ;
|
2008-04-02 18:07:38 -04:00
|
|
|
|
2008-04-02 19:25:33 -04:00
|
|
|
PRIVATE>
|
2008-04-02 17:32:58 -04:00
|
|
|
|
2008-09-18 23:08:12 -04:00
|
|
|
: image ( -- path ) \ image get-global ;
|
|
|
|
|
|
|
|
: vm ( -- path ) \ vm get-global ;
|
|
|
|
|
2010-01-13 00:08:18 -05:00
|
|
|
: embedded? ( -- ? ) 15 special-object ;
|
2008-11-19 02:50:05 -05:00
|
|
|
|
2009-10-20 00:28:18 -04:00
|
|
|
: exit ( n -- ) do-shutdown-hooks (exit) ;
|