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

db4
Slava Pestov 2008-05-06 02:52:21 -05:00
commit 68d65685e6
7 changed files with 66 additions and 106 deletions

View File

@ -184,8 +184,12 @@ HELP: +unknown+
{ $description "A unknown file type." } ;
HELP: <file-reader>
{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" { "stream" "an input stream" } }
{ "stream" "an input stream" } }
{
$values
{ "path" "a pathname string" }
{ "encoding" "an encoding descriptor" }
{ "stream" "an input stream" }
}
{ $description "Outputs an input stream for reading from the specified pathname using the given encoding." }
{ $errors "Throws an error if the file is unreadable." } ;

2
extra/io/pipes/pipes-tests.factor Normal file → Executable file
View File

@ -14,7 +14,7 @@ IN: io.pipes.tests
[ { f } ] [ { [ f ] } run-pipeline ] unit-test
[ { "Hello" } ] [
"Hello" [
{ [ input-stream [ utf8 <decoder> ] change readln ] } with-pipeline
{ [ input-stream [ utf8 <decoder> ] change readln ] } run-pipeline
] with-string-reader
] unit-test

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays continuations destructors io
io.windows libc io.nonblocking windows.types
io.windows libc io.nonblocking io.pipes windows.types
math windows.kernel32 windows namespaces io.launcher kernel
sequences windows.errors assocs splitting system strings
io.windows.launcher io.windows.nt.pipes io.backend io.files
@ -19,15 +19,25 @@ IN: io.windows.nt.launcher
DuplicateHandle win32-error=0/f
] keep *void* ;
! /dev/null simulation
: null-input ( -- pipe )
(pipe) [ in>> handle>> ] [ out>> close-handle ] bi ;
: null-output ( -- pipe )
(pipe) [ in>> close-handle ] [ out>> handle>> ] bi ;
: null-pipe ( mode -- pipe )
{
{ GENERIC_READ [ null-input ] }
{ GENERIC_WRITE [ null-output ] }
} case ;
! The below code is based on the example given in
! http://msdn2.microsoft.com/en-us/library/ms682499.aspx
: redirect-default ( default obj access-mode create-mode -- handle )
3drop ;
: redirect-inherit ( default obj access-mode create-mode -- handle )
4drop f ;
: redirect-closed ( default obj access-mode create-mode -- handle )
drop 2nip null-pipe ;
@ -44,21 +54,25 @@ IN: io.windows.nt.launcher
: set-inherit ( handle ? -- )
>r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ;
: redirect-stream ( default stream access-mode create-mode -- handle )
: redirect-handle ( default handle access-mode create-mode -- handle )
2drop nip
underlying-handle win32-file-handle
duplicate-handle dup t set-inherit ;
handle>> duplicate-handle dup t set-inherit ;
: redirect-stream ( default stream access-mode create-mode -- handle )
>r >r underlying-handle r> r> redirect-handle ;
: redirect ( default obj access-mode create-mode -- handle )
{
{ [ pick not ] [ redirect-default ] }
{ [ pick +closed+ eq? ] [ redirect-closed ] }
{ [ pick string? ] [ redirect-file ] }
{ [ pick appender? ] [ redirect-file ] }
{ [ pick win32-file? ] [ redirect-handle ] }
[ redirect-stream ]
} cond ;
: default-stdout ( args -- handle )
stdout-pipe>> dup [ pipe-out ] when ;
stdout-pipe>> dup [ out>> ] when ;
: redirect-stdout ( process args -- handle )
default-stdout
@ -84,7 +98,7 @@ IN: io.windows.nt.launcher
] if ;
: default-stdin ( args -- handle )
stdin-pipe>> dup [ pipe-in ] when ;
stdin-pipe>> dup [ in>> ] when ;
: redirect-stdin ( process args -- handle )
default-stdin
@ -94,46 +108,8 @@ IN: io.windows.nt.launcher
redirect
STD_INPUT_HANDLE GetStdHandle or ;
: add-pipe-dtors ( pipe -- )
dup
in>> close-later
out>> close-later ;
: fill-stdout-pipe ( args -- args )
<unique-incoming-pipe>
dup add-pipe-dtors
dup pipe-in f set-inherit
>>stdout-pipe ;
: fill-stdin-pipe ( args -- args )
<unique-outgoing-pipe>
dup add-pipe-dtors
dup pipe-out f set-inherit
>>stdin-pipe ;
M: winnt fill-redirection ( process args -- )
[ 2dup redirect-stdout ] keep lpStartupInfo>> set-STARTUPINFO-hStdOutput
[ 2dup redirect-stderr ] keep lpStartupInfo>> set-STARTUPINFO-hStdError
[ 2dup redirect-stdin ] keep lpStartupInfo>> set-STARTUPINFO-hStdInput
2drop ;
M: winnt (process-stream)
[
current-directory get (normalize-path) cd
dup make-CreateProcess-args
fill-stdout-pipe
fill-stdin-pipe
tuck fill-redirection
dup call-CreateProcess
dup stdin-pipe>> pipe-in CloseHandle drop
dup stdout-pipe>> pipe-out CloseHandle drop
dup lpProcessInformation>>
over stdout-pipe>> in>> f <win32-file>
rot stdin-pipe>> out>> f <win32-file>
] with-destructors ;

View File

@ -2,4 +2,4 @@ USE: io
USE: namespaces
"output" write flush
"error" stderr get stream-write stderr get stream-flush
"error" error-stream get stream-write error-stream get stream-flush

View File

@ -3,9 +3,9 @@
USING: alien alien.c-types libc destructors locals
kernel math assocs namespaces continuations sequences hashtables
sorting arrays combinators math.bitfields strings system
accessors threads
io.backend io.windows io.windows.nt.backend io.monitors
io.nonblocking io.buffers io.files io.timeouts io
accessors threads splitting
io.backend io.windows io.windows.nt.backend io.windows.nt.files
io.monitors io.nonblocking io.buffers io.files io.timeouts io
windows windows.kernel32 windows.types ;
IN: io.windows.nt.monitors
@ -79,9 +79,12 @@ TUPLE: win32-monitor < monitor port ;
: file-notify-records ( buffer -- seq )
[ (file-notify-records) drop ] { } make ;
: parse-notify-records ( monitor buffer -- )
file-notify-records
[ parse-notify-record rot queue-change ] with each ;
:: parse-notify-records ( monitor buffer -- )
buffer file-notify-records [
parse-notify-record
[ monitor path>> prepend-path normalize-path ] dip
monitor queue-change
] each ;
: fill-queue ( monitor -- )
dup port>> check-closed

View File

@ -1,16 +1,16 @@
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays destructors io io.windows libc
windows.types math windows.kernel32 windows namespaces kernel
sequences windows.errors assocs math.parser system random
combinators accessors io.pipes ;
windows.types math.bitfields windows.kernel32 windows namespaces
kernel sequences windows.errors assocs math.parser system random
combinators accessors io.pipes io.nonblocking ;
IN: io.windows.nt.pipes
! This code is based on
! http://twistedmatrix.com/trac/browser/trunk/twisted/internet/iocpreactor/process.py
: create-named-pipe ( name in-mode -- handle )
FILE_FLAG_OVERLAPPED bitor
: create-named-pipe ( name -- handle )
{ PIPE_ACCESS_INBOUND FILE_FLAG_OVERLAPPED } flags
PIPE_TYPE_BYTE
1
4096
@ -19,30 +19,20 @@ IN: io.windows.nt.pipes
security-attributes-inherit
CreateNamedPipe
dup win32-error=0/f
dup add-completion ;
dup add-completion
f <win32-file> ;
: open-other-end ( name out-mode -- handle )
FILE_SHARE_READ FILE_SHARE_WRITE bitor
: open-other-end ( name -- handle )
GENERIC_WRITE
{ FILE_SHARE_READ FILE_SHARE_WRITE } flags
security-attributes-inherit
OPEN_EXISTING
FILE_FLAG_OVERLAPPED
f
CreateFile
dup win32-error=0/f
dup add-completion ;
: <pipe> ( name in-mode out-mode -- pipe )
[
>r over >r create-named-pipe dup close-later
r> r> open-other-end dup close-later
pipe boa
] with-destructors ;
: <incoming-pipe> ( name -- pipe )
PIPE_ACCESS_INBOUND GENERIC_WRITE <pipe> ;
: <outgoing-pipe> ( name -- pipe )
PIPE_ACCESS_OUTBOUND GENERIC_READ <pipe> ;
dup add-completion
f <win32-file> ;
: unique-pipe-name ( -- string )
[
@ -54,23 +44,10 @@ IN: io.windows.nt.pipes
millis #
] "" make ;
: <unique-incoming-pipe> ( -- pipe )
unique-pipe-name <incoming-pipe> ;
: <unique-outgoing-pipe> ( -- pipe )
unique-pipe-name <outgoing-pipe> ;
! /dev/null simulation
: null-input ( -- pipe )
<unique-outgoing-pipe>
[ in>> ] [ out>> CloseHandle drop ] bi ;
: null-output ( -- pipe )
<unique-incoming-pipe>
[ in>> CloseHandle drop ] [ out>> ] bi ;
: null-pipe ( mode -- pipe )
{
{ GENERIC_READ [ null-input ] }
{ GENERIC_WRITE [ null-output ] }
} case ;
M: winnt (pipe) ( -- pipe )
[
unique-pipe-name
[ create-named-pipe dup close-later ]
[ open-other-end dup close-later ]
bi pipe boa
] with-destructors ;

View File

@ -13,9 +13,9 @@ IN: tools.vocabs.monitor
dup ".factor" tail? [ parent-directory ] when ;
: chop-vocab-root ( path -- path' )
"resource:" prepend-path (normalize-path)
"resource:" prepend-path normalize-path
dup vocab-roots get
[ (normalize-path) ] map
[ normalize-path ] map
[ head? ] with find nip
?head drop ;
@ -29,17 +29,17 @@ IN: tools.vocabs.monitor
reset-cache
monitor-loop ;
: add-monitor-for-path ( path -- )
normalize-path dup exists? [ t my-mailbox (monitor) ] when drop ;
: add-monitor-for-path ( path -- )
dup exists? [ t my-mailbox (monitor) ] when drop ;
: monitor-thread ( -- )
[
[
vocab-roots get prune [ add-monitor-for-path ] each
H{ } clone changed-vocabs set-global
vocabs [ changed-vocab ] each
monitor-loop
] with-monitors
] ignore-errors ;