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

Get file redirection working in Unix io.launcher

db4
Doug Coleman 2008-01-25 00:21:49 -06:00
parent 35f390e8ca
commit d09bc942ac
2 changed files with 11 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/io/launcher/launcher.factor
View File

@ -67,7 +67,7 @@ GENERIC: >descriptor ( obj -- desc )
M: string >descriptor +command+ associate ; M: string >descriptor +command+ associate ;
M: sequence >descriptor +arguments+ associate ; M: sequence >descriptor +arguments+ associate ;
M: assoc >descriptor ; M: assoc >descriptor >hashtable ;
HOOK: run-process* io-backend ( desc -- handle ) HOOK: run-process* io-backend ( desc -- handle )

19
extra/io/unix/launcher/launcher.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io io.backend io.launcher io.unix.backend io.nonblocking USING: io io.backend io.launcher io.unix.backend io.unix.files
sequences kernel namespaces math system alien.c-types debugger io.nonblocking sequences kernel namespaces math system
continuations arrays assocs combinators unix.process alien.c-types debugger continuations arrays assocs
parser-combinators memoize promises strings threads ; combinators unix.process parser-combinators memoize
promises strings threads ;
IN: io.unix.launcher IN: io.unix.launcher
! Search unix first ! Search unix first
@ -42,21 +43,21 @@ MEMO: 'arguments' ( -- parser )
: assoc>env ( assoc -- env ) : assoc>env ( assoc -- env )
[ "=" swap 3append ] { } assoc>map ; [ "=" swap 3append ] { } assoc>map ;
: (redirect) : (redirect) ( path mode fd -- )
>r file-mode open dup io-error dup >r file-mode open dup io-error dup
r> dup2 io-error close drop ; r> dup2 io-error close ;
: redirect ( obj mode fd -- ) : redirect ( obj mode fd -- )
{ {
{ [ pick not ] [ 3drop ] } { [ pick not ] [ 3drop ] }
{ [ pick +closed+ eq? ] [ close 3drop ] } { [ pick +closed+ eq? ] [ close 2drop ] }
{ [ t ] [ (redirect) ] } { [ pick string? ] [ (redirect) ] }
} cond ; } cond ;
: setup-redirection ( -- ) : setup-redirection ( -- )
+stdin+ get read-flags 0 redirect +stdin+ get read-flags 0 redirect
+stdout+ get write-flags 1 redirect +stdout+ get write-flags 1 redirect
+stderr+ get read-flags 2 redirect ; +stderr+ get write-flags 2 redirect ;
: spawn-process ( -- ) : spawn-process ( -- )
[ [