]> gitweb.factorcode.org Git - factor.git/blob - basis/io/windows/nt/backend/backend.factor
Merge branch 'master' into experimental (untested!)
[factor.git] / basis / io / windows / nt / backend / backend.factor
1 USING: alien alien.c-types arrays assocs combinators
2 continuations destructors io io.backend io.ports io.timeouts
3 io.windows io.windows.files io.files io.buffers io.streams.c
4 libc kernel math namespaces sequences threads windows
5 windows.errors windows.kernel32 strings splitting qualified
6 ascii system accessors locals ;
7 QUALIFIED: windows.winsock
8 IN: io.windows.nt.backend
9
10 ! Global variable with assoc mapping overlapped to threads
11 SYMBOL: pending-overlapped
12
13 TUPLE: io-callback port thread ;
14
15 C: <io-callback> io-callback
16
17 : (make-overlapped) ( -- overlapped-ext )
18     "OVERLAPPED" malloc-object &free ;
19
20 : make-overlapped ( port -- overlapped-ext )
21     [ (make-overlapped) ] dip
22     handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ;
23
24 : <completion-port> ( handle existing -- handle )
25      f 1 CreateIoCompletionPort dup win32-error=0/f ;
26
27 SYMBOL: master-completion-port
28
29 : <master-completion-port> ( -- handle )
30     INVALID_HANDLE_VALUE f <completion-port> ;
31
32 M: winnt add-completion ( win32-handle -- )
33     handle>> master-completion-port get-global <completion-port> drop ;
34
35 : eof? ( error -- ? )
36     [ ERROR_HANDLE_EOF = ] [ ERROR_BROKEN_PIPE = ] bi or ;
37
38 : twiddle-thumbs ( overlapped port -- bytes-transferred )
39     [
40         drop
41         [ pending-overlapped get-global set-at ] curry "I/O" suspend
42         {
43             { [ dup integer? ] [ ] }
44             { [ dup array? ] [
45                 first dup eof?
46                 [ drop 0 ] [ (win32-error-string) throw ] if
47             ] }
48         } cond
49     ] with-timeout ;
50
51 :: wait-for-overlapped ( us -- bytes-transferred overlapped error? )
52     master-completion-port get-global
53     0 <int> [ ! bytes
54         f <void*> ! key
55         f <void*> [ ! overlapped
56             us [ 1000 /i ] [ INFINITE ] if* ! timeout
57             GetQueuedCompletionStatus zero?
58         ] keep *void*
59     ] keep *int spin ;
60
61 : resume-callback ( result overlapped -- )
62     pending-overlapped get-global delete-at* drop resume-with ;
63
64 : handle-overlapped ( us -- ? )
65     wait-for-overlapped [
66         dup [
67             [ drop GetLastError 1array ] dip resume-callback t
68         ] [ 2drop f ] if
69     ] [ resume-callback t ] if ;
70
71 M: win32-handle cancel-operation
72     [ check-disposed ] [ handle>> CancelIo drop ] bi ;
73
74 M: winnt io-multiplex ( us -- )
75     handle-overlapped [ 0 io-multiplex ] when ;
76
77 M: winnt init-io ( -- )
78     <master-completion-port> master-completion-port set-global
79     H{ } clone pending-overlapped set-global
80     windows.winsock:init-winsock ;
81
82 : file-error? ( n -- eof? )
83     zero? [
84         GetLastError {
85             { [ dup expected-io-error? ] [ drop f ] }
86             { [ dup eof? ] [ drop t ] }
87             [ (win32-error-string) throw ]
88         } cond
89     ] [ f ] if ;
90
91 : wait-for-file ( FileArgs n port -- n )
92     swap file-error?
93     [ 2drop 0 ] [ [ lpOverlapped>> ] dip twiddle-thumbs ] if ;
94
95 : update-file-ptr ( n port -- )
96     handle>> dup ptr>> [ rot + >>ptr drop ] [ 2drop ] if* ;
97
98 : finish-write ( n port -- )
99     [ update-file-ptr ] [ buffer>> buffer-consume ] 2bi ;
100
101 M: winnt (wait-to-write)
102     [
103         [ make-FileArgs dup setup-write WriteFile ]
104         [ wait-for-file ]
105         [ finish-write ]
106         tri
107     ] with-destructors ;
108
109 : finish-read ( n port -- )
110     [ update-file-ptr ] [ buffer>> n>buffer ] 2bi ;
111
112 M: winnt (wait-to-read) ( port -- )
113     [
114         [ make-FileArgs dup setup-read ReadFile ]
115         [ wait-for-file ]
116         [ finish-read ]
117         tri
118     ] with-destructors ;
119
120 M: winnt (init-stdio) init-c-stdio ;