86 lines
2.1 KiB
Factor
Executable File
86 lines
2.1 KiB
Factor
Executable File
! 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 ;
|
|
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 mode -- handle )
|
|
FILE_FLAG_OVERLAPPED bitor
|
|
PIPE_TYPE_BYTE
|
|
1
|
|
4096
|
|
4096
|
|
0
|
|
security-attributes-inherit
|
|
CreateNamedPipe
|
|
dup win32-error=0/f
|
|
dup add-completion ;
|
|
|
|
: open-other-end ( name mode -- handle )
|
|
FILE_SHARE_READ FILE_SHARE_WRITE bitor
|
|
security-attributes-inherit
|
|
OPEN_EXISTING
|
|
FILE_FLAG_OVERLAPPED
|
|
f
|
|
CreateFile
|
|
dup win32-error=0/f
|
|
dup add-completion ;
|
|
|
|
TUPLE: pipe in out ;
|
|
|
|
: <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 construct-boa
|
|
] with-destructors ;
|
|
|
|
: close-pipe ( pipe -- )
|
|
dup
|
|
pipe-in CloseHandle drop
|
|
pipe-out CloseHandle drop ;
|
|
|
|
: <incoming-pipe> ( name -- pipe )
|
|
PIPE_ACCESS_INBOUND GENERIC_WRITE <pipe> ;
|
|
|
|
: <outgoing-pipe> ( name -- pipe )
|
|
PIPE_ACCESS_DUPLEX GENERIC_READ <pipe> ;
|
|
|
|
: unique-pipe-name ( -- string )
|
|
[
|
|
"\\\\.\\pipe\\factor-" %
|
|
pipe counter #
|
|
"-" %
|
|
(random) #
|
|
"-" %
|
|
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>
|
|
dup pipe-out CloseHandle drop
|
|
pipe-in ;
|
|
|
|
: null-output ( -- pipe )
|
|
<unique-incoming-pipe>
|
|
dup pipe-in CloseHandle drop
|
|
pipe-out ;
|
|
|
|
: null-pipe ( mode -- pipe )
|
|
{
|
|
{ [ dup GENERIC_READ = ] [ drop null-input ] }
|
|
{ [ dup GENERIC_WRITE = ] [ drop null-output ] }
|
|
} cond ;
|