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

clean up windows hardware-info for file-systems code

db4
Doug Coleman 2008-12-03 20:35:03 -06:00
parent 8e4c14f50b
commit b27941dd01
3 changed files with 12 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,7 +5,7 @@ IN: hardware-info.windows.ce
: memory-status ( -- MEMORYSTATUS ) : memory-status ( -- MEMORYSTATUS )
"MEMORYSTATUS" <c-object> "MEMORYSTATUS" <c-object>
"MEMORYSTATUS" heap-size over set-MEMORYSTATUS-dwLength "MEMORYSTATUS" heap-size over set-MEMORYSTATUS-dwLength
[ GlobalMemoryStatus ] keep ; dup GlobalMemoryStatus ;
M: wince cpus ( -- n ) 1 ; M: wince cpus ( -- n ) 1 ;

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

@ -3,16 +3,13 @@ kernel libc math namespaces hardware-info.backend
windows windows.advapi32 windows.kernel32 system ; windows windows.advapi32 windows.kernel32 system ;
IN: hardware-info.windows.nt IN: hardware-info.windows.nt
: system-info ( -- SYSTEM_INFO )
"SYSTEM_INFO" <c-object> [ GetSystemInfo ] keep ;
M: winnt cpus ( -- n ) M: winnt cpus ( -- n )
system-info SYSTEM_INFO-dwNumberOfProcessors ; system-info SYSTEM_INFO-dwNumberOfProcessors ;
: memory-status ( -- MEMORYSTATUSEX ) : memory-status ( -- MEMORYSTATUSEX )
"MEMORYSTATUSEX" <c-object> "MEMORYSTATUSEX" <c-object>
"MEMORYSTATUSEX" heap-size over set-MEMORYSTATUSEX-dwLength "MEMORYSTATUSEX" heap-size over set-MEMORYSTATUSEX-dwLength
[ GlobalMemoryStatusEx ] keep swap zero? [ win32-error ] when ; dup GlobalMemoryStatusEx win32-error=0/f ;
M: winnt memory-load ( -- n ) M: winnt memory-load ( -- n )
memory-status MEMORYSTATUSEX-dwMemoryLoad ; memory-status MEMORYSTATUSEX-dwMemoryLoad ;
@ -35,21 +32,12 @@ M: winnt total-virtual-mem ( -- n )
M: winnt available-virtual-mem ( -- n ) M: winnt available-virtual-mem ( -- n )
memory-status MEMORYSTATUSEX-ullAvailVirtual ; memory-status MEMORYSTATUSEX-ullAvailVirtual ;
: pull-win32-string ( alien -- string )
[ utf16n alien>string ] keep free ;
: computer-name ( -- string ) : computer-name ( -- string )
MAX_COMPUTERNAME_LENGTH 1+ [ malloc ] keep MAX_COMPUTERNAME_LENGTH 1+
<int> dupd GetComputerName zero? [ [ <byte-array> dup ] keep <uint>
free win32-error f GetComputerName win32-error=0/f alien>native-string ;
] [
pull-win32-string
] if ;
: username ( -- string ) : username ( -- string )
UNLEN 1+ [ malloc ] keep UNLEN 1+
<int> dupd GetUserName zero? [ [ <byte-array> dup ] keep <uint>
free win32-error f GetUserName win32-error=0/f alien>native-string ;
] [
pull-win32-string
] if ;

8
extra/hardware-info/windows/windows.factor
View File

@ -21,7 +21,7 @@ IN: hardware-info.windows
: os-version ( -- os-version ) : os-version ( -- os-version )
"OSVERSIONINFO" <c-object> "OSVERSIONINFO" <c-object>
"OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize "OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
[ GetVersionEx ] keep swap zero? [ win32-error ] when ; dup GetVersionEx win32-error=0/f ;
: windows-major ( -- n ) : windows-major ( -- n )
os-version OSVERSIONINFO-dwMajorVersion ; os-version OSVERSIONINFO-dwMajorVersion ;
@ -36,7 +36,7 @@ IN: hardware-info.windows
os-version OSVERSIONINFO-dwPlatformId ; os-version OSVERSIONINFO-dwPlatformId ;
: windows-service-pack ( -- string ) : windows-service-pack ( -- string )
os-version OSVERSIONINFO-szCSDVersion utf16n alien>string ; os-version OSVERSIONINFO-szCSDVersion alien>native-string ;
: feature-present? ( n -- ? ) : feature-present? ( n -- ? )
IsProcessorFeaturePresent zero? not ; IsProcessorFeaturePresent zero? not ;
@ -51,8 +51,8 @@ IN: hardware-info.windows
"ushort" <c-array> ; "ushort" <c-array> ;
: get-directory ( word -- str ) : get-directory ( word -- str )
>r MAX_UNICODE_PATH [ <u16-string-object> ] keep dupd r> [ MAX_UNICODE_PATH [ <u16-string-object> ] keep dupd ] dip
execute win32-error=0/f utf16n alien>string ; inline execute win32-error=0/f alien>native-string ; inline
: windows-directory ( -- str ) : windows-directory ( -- str )
\ GetWindowsDirectory get-directory ; \ GetWindowsDirectory get-directory ;