io.encodings.utf16: add a utf16n word for native utf16 type.

[factor.git] / basis / tools / ps / windows / windows.factor

diff --git a/basis/tools/ps/windows/windows.factor b/basis/tools/ps/windows/windows.factor
index 6076b9fb5640c916e8391d7d2bbe9eb4fa9f6d4e..00f93f0efacd595e2561906e64b3b2df33d99620 100644 (file)
--- a/basis/tools/ps/windows/windows.factor
+++ b/basis/tools/ps/windows/windows.factor
@@ -1,9 +1,9 @@
 USING: accessors alien alien.c-types alien.data alien.syntax
-arrays byte-arrays classes.struct destructors fry io
-io.encodings.string io.encodings.utf16n kernel literals locals
-math nested-comments sequences strings system tools.ps
-windows.errors windows.handles windows.kernel32 windows.ntdll
-windows.types ;
+arrays byte-arrays classes.struct combinators.short-circuit
+continuations destructors fry io io.encodings.string
+io.encodings.utf16 kernel literals locals math sequences
+strings system tools.ps windows.errors windows.handles
+windows.kernel32 windows.ntdll windows.types ;
 IN: tools.ps.windows
 
 : do-snapshot ( snapshot-type -- handle )
@@ -33,7 +33,7 @@ IN: tools.ps.windows
         f
         NtQueryInformationProcess drop
     ] keep ;
-    
+
 :: read-process-memory ( HANDLE alien offset len -- byte-array )
     HANDLE
     offset alien <displaced-alien>
@@ -53,15 +53,12 @@ IN: tools.ps.windows
         [ dup query-information-process PebBaseAddress>> read-peb ] bi
     ] with-destructors ;
 
-: slot-offset-by-name ( struct-class name -- value/f )
-    [ struct-slots ] dip '[ name>> _ = ] find swap [ offset>> ] when ;
-
 :: read-args ( handle -- string/f )
     handle <win32-handle> &dispose drop
     handle query-information-process :> process-basic-information
     handle process-basic-information PebBaseAddress>>
     [
-        PEB "ProcessParameters" slot-offset-by-name
+        "ProcessParameters" PEB offset-of
         PVOID heap-size
         read-process-memory
         PVOID deref :> args-offset
@@ -70,7 +67,7 @@ IN: tools.ps.windows
         ] [
             handle
             args-offset
-            RTL_USER_PROCESS_PARAMETERS "CommandLine" slot-offset-by-name
+            "CommandLine" RTL_USER_PROCESS_PARAMETERS offset-of
             UNICODE_STRING heap-size
             read-process-memory
             [ handle ] dip
@@ -78,7 +75,7 @@ IN: tools.ps.windows
             utf16n decode
         ] if
     ] [ drop f ] if* ;
-    
+
 : process-list ( -- assoc )
     [
         TH32CS_SNAPALL do-snapshot
@@ -86,10 +83,16 @@ IN: tools.ps.windows
         [ first-process ]
         [ '[ drop _ next-process ] follow ] tri
         [
-            [ th32ProcessID>> ]
-            [ th32ProcessID>> open-process-read dup [ read-args ] when ]
-            [ szExeFile>> [ 0 = ] trim-tail >string or ] tri 2array
-        ] map
+            [
+                [ th32ProcessID>> ]
+                [ th32ProcessID>> open-process-read dup [ read-args ] when ]
+                [ szExeFile>> [ 0 = ] trim-tail >string or ] tri 2array
+            ] [
+                ! Reading the arguments can fail
+                ! Win32 error 0x12b: Only part of a ReadProcessMemory or WriteProcessMemory request was completed.
+                dup { [ windows-error? ] [ n>> 0x12b = ] } 1&& [ 2drop f ] [ rethrow ] if
+            ] recover
+        ] map sift
     ] with-destructors ;
 
 M: windows ps ( -- assoc ) process-list ;