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 6cae50bd9e107272d7369eb45480f1ceaa2bcf0d..cee6f3d60e0ac19feb1129f25f9bbeb1830a83f1 100755 (executable)
--- a/basis/io/launcher/windows/windows.factor
+++ b/basis/io/launcher/windows/windows.factor
@@ -1,4 +1,4 @@
-! 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
@@ -6,7 +6,8 @@ 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 ;
+destructors classes classes.struct specialized-arrays
+debugger prettyprint ;
 SPECIALIZED-ARRAY: ushort
 SPECIALIZED-ARRAY: void*
 IN: io.launcher.windows
@@ -127,15 +128,25 @@ 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 absolute-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 -- )
     hProcess>> 255 TerminateProcess win32-error=0/f ;
@@ -148,7 +159,7 @@ M: windows kill-process* ( handle -- )
 
 : exit-code ( process -- n )
     hProcess>>
-    0 <ulong> [ GetExitCodeProcess ] keep *ulong
+    { DWORD } [ GetExitCodeProcess ] [ ] with-out-parameters
     swap win32-error=0/f ;
 
 : process-exited ( process -- )