steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

refactor hardware-info a bit

db4
erg 2008-04-03 01:48:29 -05:00
parent 0cf667859a
commit e490e9b636
5 changed files with 44 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
extra/hardware-info/backend/backend.factor
View File

@ -1,8 +1,7 @@
USING: system ;
IN: hardware-info.backend
SYMBOL: os
HOOK: cpus os ( -- n )
HOOK: memory-load os ( -- n )
HOOK: physical-mem os ( -- n )
HOOK: available-mem os ( -- n )

15
extra/hardware-info/hardware-info.factor
View File

@ -1,10 +1,13 @@
USING: alien.syntax kernel math prettyprint
USING: alien.syntax kernel math prettyprint io math.parser
combinators vocabs.loader hardware-info.backend system ;
IN: hardware-info
: kb. ( x -- ) 10 2^ /f . ;
: megs. ( x -- ) 20 2^ /f . ;
: gigs. ( x -- ) 30 2^ /f . ;
: write-unit ( x n str -- )
[ 2^ /i number>string write bl ] [ write ] bi* ;
: kb ( x -- ) 10 "kB" write-unit ;
: megs ( x -- ) 20 "MB" write-unit ;
: gigs ( x -- ) 30 "GB" write-unit ;
<< {
{ [ os windows? ] [ "hardware-info.windows" ] }
@ -12,3 +15,7 @@ IN: hardware-info
{ [ os macosx? ] [ "hardware-info.macosx" ] }
{ [ t ] [ f ] }
} cond [ require ] when* >>
: hardware-report. ( -- )
"CPUs: " write cpus number>string write nl
"Physical RAM: " write physical-mem megs nl ;

28
extra/hardware-info/macosx/macosx.factor
View File

@ -1,10 +1,8 @@
USING: alien alien.c-types alien.syntax byte-arrays kernel
namespaces sequences unix hardware-info.backend ;
namespaces sequences unix hardware-info.backend system
io.unix.backend ;
IN: hardware-info.macosx
TUPLE: macosx ;
T{ macosx } os set-global
! See /usr/include/sys/sysctl.h for constants
LIBRARY: libc
@ -14,14 +12,11 @@ FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, voi
[ <int> ] map concat ;
: (sysctl-query) ( name namelen oldp oldlenp -- oldp error/f )
over >r
f 0 sysctl -1 = [ err_no strerror ] [ f ] if
r> swap ;
over >r f 0 sysctl io-error r> ;
: sysctl-query ( seq n -- byte-array )
>r [ make-int-array ] keep length r>
[ <byte-array> ] keep <uint>
(sysctl-query) [ throw ] when* ;
>r [ make-int-array ] [ length ] bi r>
[ <byte-array> ] [ <uint> ] bi (sysctl-query) ;
: sysctl-query-string ( seq -- n )
4096 sysctl-query alien>char-string ;
@ -36,8 +31,15 @@ FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, voi
: model ( -- str ) { 6 2 } sysctl-query-string ;
M: macosx cpus ( -- n ) { 6 3 } sysctl-query-uint ;
: byte-order ( -- n ) { 6 4 } sysctl-query-uint ;
: user-mem ( -- n ) { 6 4 } sysctl-query-uint ;
M: macosx physical-mem ( -- n ) { 6 5 } sysctl-query-uint ;
: user-mem ( -- n ) { 6 6 } sysctl-query-uint ;
: page-size ( -- n ) { 6 7 } sysctl-query-uint ;
: disknames ( -- n ) { 6 8 } 8 sysctl-query ;
: diskstats ( -- n ) { 6 9 } 8 sysctl-query ;
: epoch ( -- n ) { 6 10 } sysctl-query-uint ;
: floating-point ( -- n ) { 6 11 } sysctl-query-uint ;
: machine-arch ( -- n ) { 6 12 } sysctl-query-string ;
: vector-unit ( -- n ) { 6 13 } sysctl-query-uint ;
: bus-frequency ( -- n ) { 6 14 } sysctl-query-uint ;
: cpu-frequency ( -- n ) { 6 15 } sysctl-query-uint ;
: cacheline-size ( -- n ) { 6 16 } sysctl-query-uint ;
@ -47,7 +49,7 @@ M: macosx cpus ( -- n ) { 6 3 } sysctl-query-uint ;
: l2-cache-size ( -- n ) { 6 20 } sysctl-query-uint ;
: l3-cache-settings ( -- n ) { 6 21 } sysctl-query-uint ;
: l3-cache-size ( -- n ) { 6 22 } sysctl-query-uint ;
: bus-frequency2 ( -- n ) { 6 23 } sysctl-query-uint ;
M: macosx physical-mem ( -- n ) { 6 24 } sysctl-query-ulonglong ;
: tb-frequency ( -- n ) { 6 23 } sysctl-query-uint ;
: mem-size ( -- n ) { 6 24 } sysctl-query-ulonglong ;
: available-cpus ( -- n ) { 6 25 } sysctl-query-uint ;

19
extra/hardware-info/windows/ce/ce.factor
View File

@ -2,33 +2,30 @@ USING: alien.c-types hardware-info kernel math namespaces
windows windows.kernel32 hardware-info.backend ;
IN: hardware-info.windows.ce
TUPLE: wince-os ;
T{ wince-os } os set-global
: memory-status ( -- MEMORYSTATUS )
"MEMORYSTATUS" <c-object>
"MEMORYSTATUS" heap-size over set-MEMORYSTATUS-dwLength
[ GlobalMemoryStatus ] keep ;
M: wince-os cpus ( -- n ) 1 ;
M: wince cpus ( -- n ) 1 ;
M: wince-os memory-load ( -- n )
M: wince memory-load ( -- n )
memory-status MEMORYSTATUS-dwMemoryLoad ;
M: wince-os physical-mem ( -- n )
M: wince physical-mem ( -- n )
memory-status MEMORYSTATUS-dwTotalPhys ;
M: wince-os available-mem ( -- n )
M: wince available-mem ( -- n )
memory-status MEMORYSTATUS-dwAvailPhys ;
M: wince-os total-page-file ( -- n )
M: wince total-page-file ( -- n )
memory-status MEMORYSTATUS-dwTotalPageFile ;
M: wince-os available-page-file ( -- n )
M: wince available-page-file ( -- n )
memory-status MEMORYSTATUS-dwAvailPageFile ;
M: wince-os total-virtual-mem ( -- n )
M: wince total-virtual-mem ( -- n )
memory-status MEMORYSTATUS-dwTotalVirtual ;
M: wince-os available-virtual-mem ( -- n )
M: wince available-virtual-mem ( -- n )
memory-status MEMORYSTATUS-dwAvailVirtual ;

21
extra/hardware-info/windows/nt/nt.factor
View File

@ -1,15 +1,12 @@
USING: alien alien.c-types
kernel libc math namespaces hardware-info.backend
windows windows.advapi32 windows.kernel32 ;
windows windows.advapi32 windows.kernel32 system ;
IN: hardware-info.windows.nt
TUPLE: winnt-os ;
T{ winnt-os } os set-global
: system-info ( -- SYSTEM_INFO )
"SYSTEM_INFO" <c-object> [ GetSystemInfo ] keep ;
M: winnt-os cpus ( -- n )
M: winnt cpus ( -- n )
system-info SYSTEM_INFO-dwNumberOfProcessors ;
: memory-status ( -- MEMORYSTATUSEX )
@ -17,25 +14,25 @@ M: winnt-os cpus ( -- n )
"MEMORYSTATUSEX" heap-size over set-MEMORYSTATUSEX-dwLength
[ GlobalMemoryStatusEx ] keep swap zero? [ win32-error ] when ;
M: winnt-os memory-load ( -- n )
M: winnt memory-load ( -- n )
memory-status MEMORYSTATUSEX-dwMemoryLoad ;
M: winnt-os physical-mem ( -- n )
M: winnt physical-mem ( -- n )
memory-status MEMORYSTATUSEX-ullTotalPhys ;
M: winnt-os available-mem ( -- n )
M: winnt available-mem ( -- n )
memory-status MEMORYSTATUSEX-ullAvailPhys ;
M: winnt-os total-page-file ( -- n )
M: winnt total-page-file ( -- n )
memory-status MEMORYSTATUSEX-ullTotalPageFile ;
M: winnt-os available-page-file ( -- n )
M: winnt available-page-file ( -- n )
memory-status MEMORYSTATUSEX-ullAvailPageFile ;
M: winnt-os total-virtual-mem ( -- n )
M: winnt total-virtual-mem ( -- n )
memory-status MEMORYSTATUSEX-ullTotalVirtual ;
M: winnt-os available-virtual-mem ( -- n )
M: winnt available-virtual-mem ( -- n )
memory-status MEMORYSTATUSEX-ullAvailVirtual ;
: computer-name ( -- string )