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

io.launcher.windows: include launch descriptor in error thrown when launching a process fails

db4
Slava Pestov 2010-02-01 12:39:29 -06:00
parent e7de95e72b
commit 2022c2a83e
1 changed files with 20 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
basis/io/launcher/windows/windows.factor Normal file → Executable file
View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays continuations io USING: alien alien.c-types arrays continuations io
io.backend.windows io.pipes.windows.nt io.pathnames libc 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 io.launcher kernel sequences windows.errors splitting system
threads init strings combinators io.backend accessors threads init strings combinators io.backend accessors
concurrency.flags io.files assocs io.files.private windows 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: ushort
SPECIALIZED-ARRAY: void* SPECIALIZED-ARRAY: void*
IN: io.launcher.windows IN: io.launcher.windows
@ -127,15 +128,25 @@ M: wince fill-redirection 2drop ;
M: windows current-process-handle ( -- handle ) M: windows current-process-handle ( -- handle )
GetCurrentProcessId ; 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 ) M: windows run-process* ( process -- handle )
[ [
current-directory get absolute-path cd [
current-directory get absolute-path cd
dup make-CreateProcess-args
[ fill-redirection ] keep dup make-CreateProcess-args
dup call-CreateProcess [ fill-redirection ] keep
lpProcessInformation>> dup call-CreateProcess
] with-destructors ; lpProcessInformation>>
] with-destructors
] [ launch-error ] recover ;
M: windows kill-process* ( handle -- ) M: windows kill-process* ( handle -- )
hProcess>> 255 TerminateProcess win32-error=0/f ; hProcess>> 255 TerminateProcess win32-error=0/f ;