]> gitweb.factorcode.org Git - factor.git/commitdiff
system-info: implement system-info.freebsd via sysctl
authorAlex Maestas <git-factor@se30.xyz>
Sun, 13 Feb 2022 04:47:21 +0000 (04:47 +0000)
committerJohn Benediktsson <mrjbq7@gmail.com>
Sun, 13 Feb 2022 06:16:40 +0000 (22:16 -0800)
This commit also moves the sysctl interface into unix.sysctl to share
it between OS X and FreeBSD.

basis/system-info/freebsd/authors.txt [new file with mode: 0644]
basis/system-info/freebsd/freebsd.factor [new file with mode: 0644]
basis/system-info/freebsd/platforms.txt [new file with mode: 0644]
basis/system-info/macosx/macosx.factor
basis/unix/sysctl/platforms.txt [new file with mode: 0644]
basis/unix/sysctl/sysctl.factor [new file with mode: 0644]

diff --git a/basis/system-info/freebsd/authors.txt b/basis/system-info/freebsd/authors.txt
new file mode 100644 (file)
index 0000000..d514ff4
--- /dev/null
@@ -0,0 +1 @@
+Alex Maestas
diff --git a/basis/system-info/freebsd/freebsd.factor b/basis/system-info/freebsd/freebsd.factor
new file mode 100644 (file)
index 0000000..0a434ac
--- /dev/null
@@ -0,0 +1,45 @@
+! Copyright (C) 2022 Alex Maestas
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.syntax byte-arrays grouping kernel
+libc math sequences splitting strings system system-info
+unix.sysctl unix.users ;
+IN: system-info.freebsd
+
+! From /usr/include/sys/utsname.h and as of FreeBSD-13, struct utsname
+! is a block of 5 names; __xuname accepts a base length for each item,
+! so we can allocate a precise buffer.
+
+CONSTANT: SYS_NMLN 256
+CONSTANT: utsname-items 5
+
+<PRIVATE
+
+FUNCTION-ALIAS: (xuname)
+    int __xuname ( uint nmln, char *buf )
+
+: (uname) ( nmln -- utsname-seq )
+    dup utsname-items * <byte-array>
+    [ (xuname) io-error ] keep ;
+
+PRIVATE>
+
+: uname ( -- seq )
+     SYS_NMLN [ (uname) ] [ group ] bi
+     dup length utsname-items assert=
+     [ >string [ zero? ] trim-tail ] map ;
+
+: sysname ( -- string ) 0 uname nth ;
+: nodename ( -- string ) 1 uname nth ;
+: release ( -- string ) 2 uname nth ;
+: version ( -- string ) 3 uname nth ;
+: machine ( -- string ) 4 uname nth ;
+
+M: freebsd os-version release ;
+M: freebsd cpus { 6 3 } sysctl-query-uint ;
+M: freebsd physical-mem { 6 5 } sysctl-query-ulonglong ;
+M: freebsd computer-name nodename ;
+M: freebsd username real-user-name ;
+
+M: freebsd cpu-mhz
+    "dev.cpu.0.freq" sysctl-name-query-uint
+    1000 1000 * * ;
diff --git a/basis/system-info/freebsd/platforms.txt b/basis/system-info/freebsd/platforms.txt
new file mode 100644 (file)
index 0000000..edfe860
--- /dev/null
@@ -0,0 +1 @@
+freebsd
index 61fb79ee8bf9dd510fe38fb36a11f3bfa48115a0..95f15d98bf9fdfdf14420b38014d77535702c85f 100644 (file)
@@ -1,10 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman, John Benediktsson.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.data alien.strings alien.syntax
-arrays assocs byte-arrays core-foundation endian
-io.encodings.utf8 kernel libc sequences specialized-arrays
-splitting system system-info unix.users ;
-SPECIALIZED-ARRAY: int
+USING: alien.c-types alien.data alien.strings alien.syntax arrays
+assocs byte-arrays core-foundation endian io.encodings.utf8 kernel
+libc sequences splitting system system-info unix.sysctl unix.users ;
 IN: system-info.macosx
 
 <PRIVATE
@@ -57,25 +55,6 @@ M: macosx os-version
 
 ! See /usr/include/sys/sysctl.h for constants
 
-LIBRARY: libc
-FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, void* newp, size_t newlen )
-
-: (sysctl-query) ( name namelen oldp oldlenp -- oldp )
-    over [ f 0 sysctl io-error ] dip ;
-
-: sysctl-query ( seq n -- byte-array )
-    [ [ int >c-array ] [ length ] bi ] dip
-    [ <byte-array> ] [ uint <ref> ] bi (sysctl-query) ;
-
-: sysctl-query-string ( seq -- n )
-    4096 sysctl-query utf8 alien>string ;
-
-: sysctl-query-uint ( seq -- n )
-    4 sysctl-query uint deref ;
-
-: sysctl-query-ulonglong ( seq -- n )
-    8 sysctl-query ulonglong deref ;
-
 : machine ( -- str ) { 6 1 } sysctl-query-string ;
 : model ( -- str ) { 6 2 } sysctl-query-string ;
 M: macosx cpus { 6 3 } sysctl-query-uint ;
diff --git a/basis/unix/sysctl/platforms.txt b/basis/unix/sysctl/platforms.txt
new file mode 100644 (file)
index 0000000..8f05f5e
--- /dev/null
@@ -0,0 +1,2 @@
+macosx
+freebsd
diff --git a/basis/unix/sysctl/sysctl.factor b/basis/unix/sysctl/sysctl.factor
new file mode 100644 (file)
index 0000000..12494f0
--- /dev/null
@@ -0,0 +1,43 @@
+! Copyright (C) 2008 Doug Coleman, John Benediktsson.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.data alien.strings alien.syntax
+byte-arrays io.encodings.utf8 kernel libc sequences
+specialized-arrays ;
+IN: unix.sysctl
+
+SPECIALIZED-ARRAY: int
+
+LIBRARY: libc
+FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, void* newp, size_t newlen )
+FUNCTION: int sysctlbyname ( c-string name, void* oldp, size_t* oldlenp, void* newp, size_t newlen )
+
+: (sysctl-query) ( name namelen oldp oldlenp -- oldp )
+    over [ f 0 sysctl io-error ] dip ;
+
+: (sysctl-name-query) ( name oldp oldlenp -- oldp )
+    over [ f 0 sysctlbyname io-error ] dip ;
+
+: sysctl-query ( seq n -- byte-array )
+    [ [ int >c-array ] [ length ] bi ] dip
+    [ <byte-array> ] [ uint <ref> ] bi (sysctl-query) ;
+
+: sysctl-name-query ( name n -- byte-array )
+    [ <byte-array> ] [ uint <ref> ] bi (sysctl-name-query) ;
+
+: sysctl-query-string ( seq -- n )
+    4096 sysctl-query utf8 alien>string ;
+
+: sysctl-name-query-string ( str -- n )
+    4096 sysctl-name-query utf8 alien>string ;
+
+: sysctl-query-uint ( seq -- n )
+    4 sysctl-query uint deref ;
+
+: sysctl-name-query-uint ( str -- n )
+    4 sysctl-name-query uint deref ;
+
+: sysctl-query-ulonglong ( seq -- n )
+    8 sysctl-query ulonglong deref ;
+
+: sysctl-name-query-ulonglong ( str -- n )
+    8 sysctl-name-query ulonglong deref ;