Updating code to use with-out-parameters

[factor.git] / basis / io / launcher / windows / windows.factor

diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor
index 0497754aa226ffe8827a19ee5a30154df8241f8d..cee6f3d60e0ac19feb1129f25f9bbeb1830a83f1 100755 (executable)
--- a/basis/io/launcher/windows/windows.factor
+++ b/basis/io/launcher/windows/windows.factor
@@ -1,13 +1,15 @@
-! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
+! Copyright (C) 2007, 2010 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays continuations io
-io.backend.windows io.pipes.windows.nt io.pathnames libc io.ports
-windows.types math windows.kernel32
-namespaces make io.launcher kernel sequences windows.errors
-splitting system threads init strings combinators
-io.backend accessors concurrency.flags io.files assocs
-io.files.private windows destructors specialized-arrays.ushort
-specialized-arrays.alien ;
+io.backend.windows io.pipes.windows.nt io.pathnames libc
+io.ports windows.types math windows.kernel32 namespaces make
+io.launcher kernel sequences windows.errors splitting system
+threads init strings combinators io.backend accessors
+concurrency.flags io.files assocs io.files.private windows
+destructors classes classes.struct specialized-arrays
+debugger prettyprint ;
+SPECIALIZED-ARRAY: ushort
+SPECIALIZED-ARRAY: void*
 IN: io.launcher.windows
 
 TUPLE: CreateProcess-args
@@ -24,9 +26,10 @@ TUPLE: CreateProcess-args
 
 : default-CreateProcess-args ( -- obj )
     CreateProcess-args new
-    "STARTUPINFO" <c-object>
-    "STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo
-    "PROCESS_INFORMATION" <c-object> >>lpProcessInformation
+        STARTUPINFO <struct>
+        dup class heap-size >>cb
+    >>lpStartupInfo
+    PROCESS_INFORMATION <struct> >>lpProcessInformation
     TRUE >>bInheritHandles
     0 >>dwCreateFlags ;
 
@@ -47,7 +50,7 @@ TUPLE: CreateProcess-args
 
 : count-trailing-backslashes ( str n -- str n )
     [ "\\" ?tail ] dip swap [
-        1+ count-trailing-backslashes
+        1 + count-trailing-backslashes
     ] when ;
 
 : fix-trailing-backslashes ( str -- str' )
@@ -103,12 +106,12 @@ TUPLE: CreateProcess-args
             over get-environment
             [ swap % "=" % % "\0" % ] assoc-each
             "\0" %
-        ] ushort-array{ } make underlying>>
+        ] ushort-array{ } make
         >>lpEnvironment
     ] when ;
 
 : fill-startup-info ( process args -- process args )
-    STARTF_USESTDHANDLES over lpStartupInfo>> set-STARTUPINFO-dwFlags ;
+    dup lpStartupInfo>> STARTF_USESTDHANDLES >>dwFlags drop ;
 
 HOOK: fill-redirection io-backend ( process args -- )
 
@@ -125,29 +128,38 @@ M: wince fill-redirection 2drop ;
 M: windows current-process-handle ( -- handle )
     GetCurrentProcessId ;
 
+ERROR: launch-error process error ;
+
+M: launch-error error.
+    "Launching failed with error:" print
+    dup error>> error. nl
+    "Launch descriptor:" print nl
+    process>> . ;
+
 M: windows run-process* ( process -- handle )
     [
-        current-directory get (normalize-path) cd
-
-        dup make-CreateProcess-args
-        tuck fill-redirection
-        dup call-CreateProcess
-        lpProcessInformation>>
-    ] with-destructors ;
+        [
+            current-directory get absolute-path cd
+    
+            dup make-CreateProcess-args
+            [ fill-redirection ] keep
+            dup call-CreateProcess
+            lpProcessInformation>>
+        ] with-destructors
+    ] [ launch-error ] recover ;
 
 M: windows kill-process* ( handle -- )
-    PROCESS_INFORMATION-hProcess
-    255 TerminateProcess win32-error=0/f ;
+    hProcess>> 255 TerminateProcess win32-error=0/f ;
 
 : dispose-process ( process-information -- )
     #! From MSDN: "Handles in PROCESS_INFORMATION must be closed
     #! with CloseHandle when they are no longer needed."
-    dup PROCESS_INFORMATION-hProcess [ CloseHandle drop ] when*
-    PROCESS_INFORMATION-hThread [ CloseHandle drop ] when* ;
+    [ hProcess>> [ CloseHandle drop ] when* ]
+    [ hThread>> [ CloseHandle drop ] when* ] bi ;
 
 : exit-code ( process -- n )
-    PROCESS_INFORMATION-hProcess
-    0 <ulong> [ GetExitCodeProcess ] keep *ulong
+    hProcess>>
+    { DWORD } [ GetExitCodeProcess ] [ ] with-out-parameters
     swap win32-error=0/f ;
 
 : process-exited ( process -- )
@@ -157,8 +169,8 @@ M: windows kill-process* ( handle -- )
 
 M: windows wait-for-processes ( -- ? )
     processes get keys dup
-    [ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as
-    [ length ] [ underlying>> ] bi 0 0
+    [ handle>> hProcess>> ] void*-array{ } map-as
+    [ length ] keep 0 0
     WaitForMultipleObjects
     dup HEX: ffffffff = [ win32-error ] when
     dup WAIT_TIMEOUT = [ 2drop t ] [ swap nth process-exited f ] if ;