factor/extra/io/unix/launcher/launcher.factor

94 lines
2.6 KiB
Factor
Raw Normal View History

2007-09-20 18:09:08 -04:00
USING: io io.launcher io.unix.backend io.nonblocking
sequences kernel namespaces math system alien.c-types
2007-11-09 02:24:37 -05:00
debugger continuations combinators.lib threads ;
2007-09-20 18:09:08 -04:00
IN: io.unix.launcher
2007-09-20 18:09:08 -04:00
! Search unix first
USE: unix
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Factor friendly versions of the exec functions
: >argv ( seq -- alien ) [ malloc-char-string ] map f add >c-void*-array ;
: execv* ( pathname argv -- int ) [ malloc-char-string ] [ >argv ] bi* execv ;
: execvp* ( filename argv -- int ) [ malloc-char-string ] [ >argv ] bi* execvp ;
: execve* ( pathname argv envp -- int )
[ malloc-char-string ] [ >argv ] [ >argv ] tri* execve ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Wait for a pid to finish without freezing up all the Factor threads.
! Need to find a less kludgy way to do this.
: wait-for-pid ( pid -- )
dup "int" <c-object> WNOHANG waitpid
0 = [ 100 sleep wait-for-pid ] [ drop ] if ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2007-11-09 03:18:37 -05:00
: with-fork ( child parent -- pid )
2007-09-20 18:09:08 -04:00
fork [ zero? -rot if ] keep ; inline
: prepare-execvp ( args -- cmd args )
2007-09-20 18:09:08 -04:00
#! Doesn't free any memory, so we only call this word
#! after forking.
[ malloc-char-string ] map
[ first ] keep
f add >c-void*-array ;
2007-09-20 18:09:08 -04:00
: (spawn-process) ( args -- )
[ prepare-execvp execvp ] catch 1 exit ;
2007-09-20 18:09:08 -04:00
: spawn-process ( args -- pid )
[ (spawn-process) ] [ drop ] with-fork ;
: wait-for-process ( pid -- )
0 <int> 0 waitpid drop ;
: shell-command ( string -- args )
{ "/bin/sh" "-c" } swap add ;
M: unix-io run-process ( string -- )
shell-command spawn-process wait-for-process ;
: detached-shell-command ( string -- args )
shell-command "&" add ;
M: unix-io run-detached ( string -- )
detached-shell-command spawn-process wait-for-process ;
: open-pipe ( -- pair )
2 "int" <c-array> dup pipe zero?
[ 2 c-int-array> ] [ drop f ] if ;
: setup-stdio-pipe ( stdin stdout -- )
2dup first close second close
>r first 0 dup2 drop r> second 1 dup2 drop ;
: spawn-process-stream ( args -- in out pid )
open-pipe open-pipe [
setup-stdio-pipe
(spawn-process)
] [
2dup second close first close
rot drop
] with-fork >r first swap second r> ;
TUPLE: pipe-stream pid ;
: <pipe-stream> ( in out pid -- stream )
pipe-stream construct-boa
-rot handle>duplex-stream over set-delegate ;
M: pipe-stream stream-close
dup delegate stream-close
pipe-stream-pid wait-for-process ;
M: unix-io <process-stream>
shell-command spawn-process-stream <pipe-stream> ;