Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-02-14 23:33:24 -06:00
commit d666b62b1b
6 changed files with 17 additions and 6 deletions

View File

@ -90,6 +90,10 @@ HELP: get-environment
{ $values { "env" "an association" } } { $values { "env" "an association" } }
{ $description "Combines the current environment with the value of " { $link +environment+ } " using " { $link +environment-mode+ } "." } ; { $description "Combines the current environment with the value of " { $link +environment+ } " using " { $link +environment-mode+ } "." } ;
HELP: current-process-handle
{ $values { "handle" "a process handle" } }
{ $description "Returns the handle of the current process." } ;
HELP: run-process* HELP: run-process*
{ $values { "desc" "a launch descriptor" } { "handle" "a process handle" } } { $values { "desc" "a launch descriptor" } { "handle" "a process handle" } }
{ $contract "Launches a process using the launch descriptor." } { $contract "Launches a process using the launch descriptor." }
@ -186,6 +190,8 @@ ARTICLE: "io.launcher" "Launching OS processes"
{ $subsection try-process } { $subsection try-process }
"Stopping processes:" "Stopping processes:"
{ $subsection kill-process } { $subsection kill-process }
"Finding the current process handle:"
{ $subsection current-process-handle }
"Redirecting standard input and output to a pipe:" "Redirecting standard input and output to a pipe:"
{ $subsection <process-stream> } { $subsection <process-stream> }
{ $subsection with-process-stream } { $subsection with-process-stream }

View File

@ -76,6 +76,8 @@ SYMBOL: +append-environment+
{ [ dup assoc? ] [ >hashtable ] } { [ dup assoc? ] [ >hashtable ] }
} cond ; } cond ;
HOOK: current-process-handle io-backend ( -- handle )
HOOK: run-process* io-backend ( desc -- handle ) HOOK: run-process* io-backend ( desc -- handle )
: wait-for-process ( process -- status ) : wait-for-process ( process -- status )

View File

@ -4,7 +4,7 @@ USING: io io.backend io.launcher io.unix.backend io.unix.files
io.nonblocking sequences kernel namespaces math system io.nonblocking sequences kernel namespaces math system
alien.c-types debugger continuations arrays assocs alien.c-types debugger continuations arrays assocs
combinators unix.process parser-combinators memoize combinators unix.process parser-combinators memoize
promises strings threads ; promises strings threads unix ;
IN: io.unix.launcher IN: io.unix.launcher
! Search unix first ! Search unix first
@ -71,6 +71,8 @@ MEMO: 'arguments' ( -- parser )
io-error io-error
] [ error. :c flush ] recover 1 exit ; ] [ error. :c flush ] recover 1 exit ;
M: unix-io current-process-handle ( -- handle ) getpid ;
M: unix-io run-process* ( desc -- pid ) M: unix-io run-process* ( desc -- pid )
[ [
[ spawn-process ] [ ] with-fork <process> [ spawn-process ] [ ] with-fork <process>

View File

@ -102,6 +102,9 @@ M: windows-ce-io fill-redirection ;
fill-lpEnvironment fill-lpEnvironment
fill-startup-info ; fill-startup-info ;
M: windows-io current-process-handle ( -- handle )
GetCurrentProcessId ;
M: windows-io run-process* ( desc -- handle ) M: windows-io run-process* ( desc -- handle )
[ [
[ [

View File

@ -2,8 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io.files io words alien kernel math.parser alien.syntax USING: io.files io words alien kernel math.parser alien.syntax
io.launcher system assocs arrays sequences namespaces qualified io.launcher system assocs arrays sequences namespaces qualified
regexp system math sequences.lib ; regexp system math sequences.lib windows.kernel32 ;
QUALIFIED: unix
IN: tools.disassembler IN: tools.disassembler
: in-file "gdb-in.txt" resource-path ; : in-file "gdb-in.txt" resource-path ;
@ -18,8 +17,7 @@ M: word make-disassemble-cmd
M: pair make-disassemble-cmd M: pair make-disassemble-cmd
in-file [ in-file [
"attach " write "attach " write
unix:getpid number>string print current-process-handle number>string print
"disassemble " write "disassemble " write
[ number>string write bl ] each [ number>string write bl ] each
] with-file-out ; ] with-file-out ;

View File

@ -895,7 +895,7 @@ FUNCTION: DWORD GetConsoleTitleW ( LPWSTR lpConsoleTitle, DWORD nSize ) ;
FUNCTION: BOOL GetCurrentDirectoryW ( DWORD len, LPTSTR buf ) ; FUNCTION: BOOL GetCurrentDirectoryW ( DWORD len, LPTSTR buf ) ;
: GetCurrentDirectory GetCurrentDirectoryW ; inline : GetCurrentDirectory GetCurrentDirectoryW ; inline
FUNCTION: HANDLE GetCurrentProcess ( ) ; FUNCTION: HANDLE GetCurrentProcess ( ) ;
! FUNCTION: GetCurrentProcessId FUNCTION: DWORD GetCurrentProcessId ( ) ;
FUNCTION: HANDLE GetCurrentThread ( ) ; FUNCTION: HANDLE GetCurrentThread ( ) ;
! FUNCTION: GetCurrentThreadId ! FUNCTION: GetCurrentThreadId
! FUNCTION: GetDateFormatA ! FUNCTION: GetDateFormatA