diff --git a/extra/hardware-info/backend/backend.factor b/extra/hardware-info/backend/backend.factor index 17794c196d..95a56da2d2 100644 --- a/extra/hardware-info/backend/backend.factor +++ b/extra/hardware-info/backend/backend.factor @@ -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 ) diff --git a/extra/hardware-info/hardware-info.factor b/extra/hardware-info/hardware-info.factor index ecdcc42cb5..6d27cf5252 100755 --- a/extra/hardware-info/hardware-info.factor +++ b/extra/hardware-info/hardware-info.factor @@ -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 ; diff --git a/extra/hardware-info/macosx/macosx.factor b/extra/hardware-info/macosx/macosx.factor index c246a95186..dac052a1de 100644 --- a/extra/hardware-info/macosx/macosx.factor +++ b/extra/hardware-info/macosx/macosx.factor @@ -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 [ ] 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> - [ ] keep - (sysctl-query) [ throw ] when* ; + >r [ make-int-array ] [ length ] bi r> + [ ] [ ] 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 ; diff --git a/extra/hardware-info/windows/ce/ce.factor b/extra/hardware-info/windows/ce/ce.factor index f671ea9426..55c2ac6c0d 100755 --- a/extra/hardware-info/windows/ce/ce.factor +++ b/extra/hardware-info/windows/ce/ce.factor @@ -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" "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 ; diff --git a/extra/hardware-info/windows/nt/nt.factor b/extra/hardware-info/windows/nt/nt.factor index 8bdb75fe6a..ba9c1d74b5 100755 --- a/extra/hardware-info/windows/nt/nt.factor +++ b/extra/hardware-info/windows/nt/nt.factor @@ -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" [ 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 )