clean up windows hardware-info for file-systems code
parent
8e4c14f50b
commit
b27941dd01
|
@ -5,7 +5,7 @@ IN: hardware-info.windows.ce
|
|||
: memory-status ( -- MEMORYSTATUS )
|
||||
"MEMORYSTATUS" <c-object>
|
||||
"MEMORYSTATUS" heap-size over set-MEMORYSTATUS-dwLength
|
||||
[ GlobalMemoryStatus ] keep ;
|
||||
dup GlobalMemoryStatus ;
|
||||
|
||||
M: wince cpus ( -- n ) 1 ;
|
||||
|
||||
|
|
|
@ -3,16 +3,13 @@ kernel libc math namespaces hardware-info.backend
|
|||
windows windows.advapi32 windows.kernel32 system ;
|
||||
IN: hardware-info.windows.nt
|
||||
|
||||
: system-info ( -- SYSTEM_INFO )
|
||||
"SYSTEM_INFO" <c-object> [ GetSystemInfo ] keep ;
|
||||
|
||||
M: winnt cpus ( -- n )
|
||||
system-info SYSTEM_INFO-dwNumberOfProcessors ;
|
||||
|
||||
: memory-status ( -- MEMORYSTATUSEX )
|
||||
"MEMORYSTATUSEX" <c-object>
|
||||
"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 )
|
||||
memory-status MEMORYSTATUSEX-dwMemoryLoad ;
|
||||
|
@ -35,21 +32,12 @@ M: winnt total-virtual-mem ( -- n )
|
|||
M: winnt available-virtual-mem ( -- n )
|
||||
memory-status MEMORYSTATUSEX-ullAvailVirtual ;
|
||||
|
||||
: pull-win32-string ( alien -- string )
|
||||
[ utf16n alien>string ] keep free ;
|
||||
|
||||
: computer-name ( -- string )
|
||||
MAX_COMPUTERNAME_LENGTH 1+ [ malloc ] keep
|
||||
<int> dupd GetComputerName zero? [
|
||||
free win32-error f
|
||||
] [
|
||||
pull-win32-string
|
||||
] if ;
|
||||
MAX_COMPUTERNAME_LENGTH 1+
|
||||
[ <byte-array> dup ] keep <uint>
|
||||
GetComputerName win32-error=0/f alien>native-string ;
|
||||
|
||||
: username ( -- string )
|
||||
UNLEN 1+ [ malloc ] keep
|
||||
<int> dupd GetUserName zero? [
|
||||
free win32-error f
|
||||
] [
|
||||
pull-win32-string
|
||||
] if ;
|
||||
UNLEN 1+
|
||||
[ <byte-array> dup ] keep <uint>
|
||||
GetUserName win32-error=0/f alien>native-string ;
|
||||
|
|
|
@ -21,7 +21,7 @@ IN: hardware-info.windows
|
|||
: os-version ( -- os-version )
|
||||
"OSVERSIONINFO" <c-object>
|
||||
"OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
|
||||
[ GetVersionEx ] keep swap zero? [ win32-error ] when ;
|
||||
dup GetVersionEx win32-error=0/f ;
|
||||
|
||||
: windows-major ( -- n )
|
||||
os-version OSVERSIONINFO-dwMajorVersion ;
|
||||
|
@ -36,7 +36,7 @@ IN: hardware-info.windows
|
|||
os-version OSVERSIONINFO-dwPlatformId ;
|
||||
|
||||
: windows-service-pack ( -- string )
|
||||
os-version OSVERSIONINFO-szCSDVersion utf16n alien>string ;
|
||||
os-version OSVERSIONINFO-szCSDVersion alien>native-string ;
|
||||
|
||||
: feature-present? ( n -- ? )
|
||||
IsProcessorFeaturePresent zero? not ;
|
||||
|
@ -51,8 +51,8 @@ IN: hardware-info.windows
|
|||
"ushort" <c-array> ;
|
||||
|
||||
: get-directory ( word -- str )
|
||||
>r MAX_UNICODE_PATH [ <u16-string-object> ] keep dupd r>
|
||||
execute win32-error=0/f utf16n alien>string ; inline
|
||||
[ MAX_UNICODE_PATH [ <u16-string-object> ] keep dupd ] dip
|
||||
execute win32-error=0/f alien>native-string ; inline
|
||||
|
||||
: windows-directory ( -- str )
|
||||
\ GetWindowsDirectory get-directory ;
|
||||
|
|
Loading…
Reference in New Issue