]> gitweb.factorcode.org Git - factor.git/blob - basis/system-info/macosx/macosx.factor
basis: removing unnecessary method stack effects.
[factor.git] / basis / system-info / macosx / macosx.factor
1 ! Copyright (C) 2008 Doug Coleman, John Benediktsson.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien.c-types alien.data alien.strings alien.syntax
4 arrays assocs byte-arrays core-foundation io.binary
5 io.encodings.utf8 kernel libc sequences specialized-arrays
6 splitting system system-info ;
7 SPECIALIZED-ARRAY: int
8 IN: system-info.macosx
9
10 <PRIVATE
11
12 TYPEDEF: SInt16 OSErr
13 TYPEDEF: UInt32 OSType
14 FUNCTION: OSErr Gestalt ( OSType selector, SInt32* response )
15
16 : gestalt ( selector -- response )
17     { SInt32 } [ Gestalt 0 assert= ] with-out-parameters ;
18
19 : system-version ( -- n ) "sysv" be> gestalt ;
20 : system-version-major ( -- n ) "sys1" be> gestalt ;
21 : system-version-minor ( -- n ) "sys2" be> gestalt ;
22 : system-version-bugfix ( -- n ) "sys3" be> gestalt ;
23
24 CONSTANT: system-code-names H{
25     { { 11 0 } "Big Sur" }
26     { { 10 15 } "Catalina" }
27     { { 10 14 } "Mojave" }
28     { { 10 13 } "High Sierra" }
29     { { 10 12 } "Sierra" }
30     { { 10 11 } "El Capitan" }
31     { { 10 10 } "Yosemite" }
32     { { 10 9 } "Mavericks" }
33     { { 10 8 } "Mountain Lion" }
34     { { 10 7 } "Lion" }
35     { { 10 6 } "Snow Leopard" }
36     { { 10 5 } "Leopard" }
37     { { 10 4 } "Tiger" }
38     { { 10 3 } "Panther" }
39     { { 10 2 } "Jaguar" }
40     { { 10 1 } "Puma" }
41     { { 10 0 } "Cheetah" }
42 }
43
44 : system-code-name ( -- str/f )
45     system-version-major system-version-minor 2array
46     system-code-names at ;
47
48 PRIVATE>
49
50 M: macosx os-version
51     system-version-major
52     system-version-minor
53     system-version-bugfix 3array ;
54
55 ! See /usr/include/sys/sysctl.h for constants
56
57 LIBRARY: libc
58 FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, void* newp, size_t newlen )
59
60 : (sysctl-query) ( name namelen oldp oldlenp -- oldp )
61     over [ f 0 sysctl io-error ] dip ;
62
63 : sysctl-query ( seq n -- byte-array )
64     [ [ int >c-array ] [ length ] bi ] dip
65     [ <byte-array> ] [ uint <ref> ] bi (sysctl-query) ;
66
67 : sysctl-query-string ( seq -- n )
68     4096 sysctl-query utf8 alien>string ;
69
70 : sysctl-query-uint ( seq -- n )
71     4 sysctl-query uint deref ;
72
73 : sysctl-query-ulonglong ( seq -- n )
74     8 sysctl-query ulonglong deref ;
75
76 : machine ( -- str ) { 6 1 } sysctl-query-string ;
77 : model ( -- str ) { 6 2 } sysctl-query-string ;
78 M: macosx cpus { 6 3 } sysctl-query-uint ;
79 : byte-order ( -- n ) { 6 4 } sysctl-query-uint ;
80
81 ! Only an int, not large enough. Deprecated.
82 ! M: macosx physical-mem { 6 5 } sysctl-query-int ;
83 ! : user-mem ( -- n ) { 6 6 } sysctl-query-uint ;
84
85 : page-size ( -- n ) { 6 7 } sysctl-query-uint ;
86 : disknames ( -- n ) { 6 8 } 8 sysctl-query ;
87 : diskstats ( -- n ) { 6 9 } 8 sysctl-query ;
88 : epoch ( -- n ) { 6 10 } sysctl-query-uint ;
89 : floating-point ( -- n ) { 6 11 } sysctl-query-uint ;
90 : machine-arch ( -- n ) { 6 12 } sysctl-query-string ;
91 : vector-unit ( -- n ) { 6 13 } sysctl-query-uint ;
92 : bus-frequency ( -- n ) { 6 14 } sysctl-query-uint ;
93 M: macosx cpu-mhz { 6 15 } sysctl-query-uint ;
94 : cacheline-size ( -- n ) { 6 16 } sysctl-query-uint ;
95 : l1-icache-size ( -- n ) { 6 17 } sysctl-query-uint ;
96 : l1-dcache-size ( -- n ) { 6 18 } sysctl-query-uint ;
97 : l2-cache-settings ( -- n ) { 6 19 } sysctl-query-uint ;
98 : l2-cache-size ( -- n ) { 6 20 } sysctl-query-uint ;
99 : l3-cache-settings ( -- n ) { 6 21 } sysctl-query-uint ;
100 : l3-cache-size ( -- n ) { 6 22 } sysctl-query-uint ;
101 : tb-frequency ( -- n ) { 6 23 } sysctl-query-uint ;
102 M: macosx physical-mem { 6 24 } sysctl-query-ulonglong ;
103 : available-cpus ( -- n ) { 6 25 } sysctl-query-uint ;
104
105 M: macosx computer-name { 1 10 } sysctl-query-string "." split1 drop ;