1 /* -*-C-*-
2 
3 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
4     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5     2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts
6     Institute of Technology
7 
8 This file is part of MIT/GNU Scheme.
9 
10 MIT/GNU Scheme is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2 of the License, or (at
13 your option) any later version.
14 
15 MIT/GNU Scheme is distributed in the hope that it will be useful, but
16 WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18 General Public License for more details.
19 
20 You should have received a copy of the GNU General Public License
21 along with MIT/GNU Scheme; if not, write to the Free Software
22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
23 USA.
24 
25 */
26 
27 #include "scheme.h"
28 #include "prims.h"
29 #include "nt.h"
30 #include "ntio.h"
31 #include "ntgui.h"
32 #include "osterm.h"
33 #include "osfile.h"
34 #include "osproc.h"
35 #include "ostty.h"
36 #include "outf.h"
37 #include "ossig.h"
38 #include "intrpt.h"
39 #include "ntscreen.h"
40 
41 #undef TRACE_NTIO
42 #ifdef TRACE_NTIO
43 extern FILE * trace_file;
44 #endif
45 
46 extern HANDLE master_tty_window;
47 
48 channel_class_t * NT_channel_class_generic;
49 channel_class_t * NT_channel_class_file;
50 channel_class_t * NT_channel_class_screen;
51 channel_class_t * NT_channel_class_anonymous_pipe;
52 channel_class_t * NT_channel_class_named_pipe;
53 
54 static Tchannel channel_allocate (void);
55 static long cooked_channel_write (Tchannel, const void *, unsigned long) ;
56 static int wait_on_multiple_objects (struct select_registry_s *);
57 static int test_multiple_objects (struct select_registry_s *);
58 static int wait_on_single_object (Tchannel, unsigned int);
59 static int test_single_object (Tchannel, unsigned int);
60 static unsigned int test_single_object_1 (Tchannel, unsigned int);
61 static int test_for_pending_event (void);
62 
63 #ifndef NT_DEFAULT_CHANNEL_TABLE_SIZE
64 #define NT_DEFAULT_CHANNEL_TABLE_SIZE 1024
65 #endif
66 
67 Tchannel OS_channel_table_size;
68 struct channel * NT_channel_table;
69 
70 Tchannel
NT_make_channel(HANDLE handle,channel_class_t * class)71 NT_make_channel (HANDLE handle, channel_class_t * class)
72 {
73   Tchannel channel;
74   transaction_begin ();
75   NT_handle_close_on_abort (handle);
76   channel = (channel_allocate ());
77   (CHANNEL_CLASS (channel)) = class;
78   (CHANNEL_HANDLE (channel)) = handle;
79   (CHANNEL_INTERNAL (channel)) = 0;
80   (CHANNEL_NONBLOCKING (channel)) = 0;
81   (CHANNEL_BUFFERED (channel)) = 1;
82   (CHANNEL_COOKED (channel)) = 0;
83   transaction_commit ();
84   return (channel);
85 }
86 
87 channel_class_t *
NT_handle_channel_class(HANDLE handle)88 NT_handle_channel_class (HANDLE handle)
89 {
90   if (Screen_IsScreenHandle (handle))
91     return (NT_channel_class_screen);
92   /* If GetFileType returns FILE_TYPE_PIPE, assume that it is a named
93      pipe.  This procedure won't be called with an anonymous-pipe
94      handle.  */
95   switch (GetFileType (handle))
96     {
97     case FILE_TYPE_DISK: return (NT_channel_class_file);
98     case FILE_TYPE_CHAR: return (NT_channel_class_generic);
99     case FILE_TYPE_PIPE: return (NT_channel_class_named_pipe);
100     default: return (NT_channel_class_generic);
101     }
102 }
103 
104 Tchannel
NT_open_handle(HANDLE handle)105 NT_open_handle (HANDLE handle)
106 {
107   Tchannel channel
108     = (NT_make_channel (handle, (NT_handle_channel_class (handle))));
109   /* Like Unix, all terminals initialize to cooked mode.  */
110   if ((CHANNEL_TYPE (channel)) == channel_type_terminal)
111     (CHANNEL_COOKED (channel)) = 1;
112   return (channel);
113 }
114 
115 long
OS_channel_read(Tchannel channel,void * buffer,size_t n_bytes)116 OS_channel_read (Tchannel channel, void * buffer, size_t n_bytes)
117 {
118   return
119     ((n_bytes == 0)
120      ? 0
121      : ((* (CHANNEL_CLASS_OP_READ (CHANNEL_CLASS (channel))))
122 	(channel, buffer, n_bytes)));
123 }
124 
125 long
OS_channel_write(Tchannel channel,const void * buffer,size_t n_bytes)126 OS_channel_write (Tchannel channel, const void * buffer, size_t n_bytes)
127 {
128   return
129     ((n_bytes == 0)
130      ? 0
131      : (CHANNEL_COOKED (channel))
132      ? (cooked_channel_write (channel, buffer, n_bytes))
133      : ((* (CHANNEL_CLASS_OP_WRITE (CHANNEL_CLASS (channel))))
134 	(channel, buffer, n_bytes)));
135 }
136 
137 void
OS_channel_close(Tchannel channel)138 OS_channel_close (Tchannel channel)
139 {
140   if (! ((CHANNEL_CLOSED_P (channel)) || (CHANNEL_INTERNAL (channel))))
141     {
142       (* (CHANNEL_CLASS_OP_CLOSE (CHANNEL_CLASS (channel)))) (channel, 1);
143       MARK_CHANNEL_CLOSED (channel);
144     }
145 }
146 
147 void
OS_channel_close_noerror(Tchannel channel)148 OS_channel_close_noerror (Tchannel channel)
149 {
150   if (! ((CHANNEL_CLOSED_P (channel)) || (CHANNEL_INTERNAL (channel))))
151     {
152       (* (CHANNEL_CLASS_OP_CLOSE (CHANNEL_CLASS (channel)))) (channel, 0);
153       MARK_CHANNEL_CLOSED (channel);
154     }
155 }
156 
157 long
NT_channel_n_read(Tchannel channel)158 NT_channel_n_read (Tchannel channel)
159 {
160   if (CHANNEL_CLOSED_P (channel))
161     return (0);
162   return ((* (CHANNEL_CLASS_OP_N_READ (CHANNEL_CLASS (channel)))) (channel));
163 }
164 
165 static void
NT_channel_close_all(void)166 NT_channel_close_all (void)
167 {
168   Tchannel channel;
169   for (channel = 0; (channel < OS_channel_table_size); channel += 1)
170     if (CHANNEL_OPEN_P (channel))
171       OS_channel_close_noerror (channel);
172 }
173 
174 static Tchannel
channel_allocate(void)175 channel_allocate (void)
176 {
177   Tchannel channel = 0;
178   while (1)
179   {
180     if (channel == OS_channel_table_size)
181       error_out_of_channels ();
182     if (CHANNEL_CLOSED_P (channel))
183       return (channel);
184     channel += 1;
185   }
186 }
187 
188 int
OS_channel_open_p(Tchannel channel)189 OS_channel_open_p (Tchannel channel)
190 {
191   return (CHANNEL_OPEN_P (channel));
192 }
193 
194 static void
channel_close_on_abort_1(void * cp)195 channel_close_on_abort_1 (void * cp)
196 {
197   OS_channel_close (* ((Tchannel *) cp));
198 }
199 
200 void
OS_channel_close_on_abort(Tchannel channel)201 OS_channel_close_on_abort (Tchannel channel)
202 {
203   Tchannel * cp = ((Tchannel *) (dstack_alloc (sizeof (Tchannel))));
204   (*cp) = (channel);
205   transaction_record_action (tat_abort, channel_close_on_abort_1, cp);
206 }
207 
208 static void
NT_handle_close_on_abort_1(void * hp)209 NT_handle_close_on_abort_1 (void * hp)
210 {
211   (void) CloseHandle (* ((HANDLE *) hp));
212 }
213 
214 void
NT_handle_close_on_abort(HANDLE h)215 NT_handle_close_on_abort (HANDLE h)
216 {
217   HANDLE * hp = (dstack_alloc (sizeof (HANDLE)));
218   (*hp) = h;
219   transaction_record_action (tat_abort, NT_handle_close_on_abort_1, hp);
220 }
221 
222 enum channel_type
OS_channel_type(Tchannel channel)223 OS_channel_type (Tchannel channel)
224 {
225   return (CHANNEL_TYPE (channel));
226 }
227 
228 void
OS_channel_synchronize(Tchannel channel)229 OS_channel_synchronize (Tchannel channel)
230 {
231 }
232 
233 static void
generic_channel_close(Tchannel channel,int errorp)234 generic_channel_close (Tchannel channel, int errorp)
235 {
236   if ((!CloseHandle (CHANNEL_HANDLE (channel))) && errorp)
237     NT_error_api_call ((GetLastError ()), apicall_CloseHandle);
238 }
239 
240 static long
generic_channel_read(Tchannel channel,void * buffer,unsigned long n_bytes)241 generic_channel_read (Tchannel channel, void * buffer, unsigned long n_bytes)
242 {
243   DWORD bytes_read;
244   if ((!ReadFile ((CHANNEL_HANDLE (channel)),
245 		  buffer, n_bytes, (&bytes_read), 0))
246       && (bytes_read > 0))
247     NT_error_api_call ((GetLastError ()), apicall_ReadFile);
248   return (bytes_read);
249 }
250 
251 static long
generic_channel_write(Tchannel channel,const void * buffer,unsigned long n_bytes)252 generic_channel_write (Tchannel channel, const void * buffer,
253 		       unsigned long n_bytes)
254 {
255   DWORD n_written;
256   STD_BOOL_API_CALL
257     (WriteFile,
258      ((CHANNEL_HANDLE (channel)), ((LPCVOID) buffer), n_bytes, (&n_written),
259       0));
260   return (n_written);
261 }
262 
263 static long
generic_channel_n_read(Tchannel channel)264 generic_channel_n_read (Tchannel channel)
265 {
266   return (CHANNEL_N_READ_UNKNOWN);
267 }
268 
269 static void
initialize_channel_class_generic(void)270 initialize_channel_class_generic (void)
271 {
272   channel_class_t * class = (OS_malloc (sizeof (channel_class_t)));
273   (CHANNEL_CLASS_TYPE (class)) = channel_type_unknown;
274   (CHANNEL_CLASS_OP_READ (class)) = generic_channel_read;
275   (CHANNEL_CLASS_OP_WRITE (class)) = generic_channel_write;
276   (CHANNEL_CLASS_OP_CLOSE (class)) = generic_channel_close;
277   (CHANNEL_CLASS_OP_N_READ (class)) = generic_channel_n_read;
278   NT_channel_class_generic = class;
279 }
280 
281 static long
file_channel_n_read(Tchannel channel)282 file_channel_n_read (Tchannel channel)
283 {
284   DWORD length = (GetFileSize ((CHANNEL_HANDLE (channel)), 0));
285   off_t position;
286   if (length == 0xFFFFFFFF)
287     return (0);
288   position = (OS_file_position (channel));
289   return ((position < ((off_t) length)) ? (((off_t) length) - position) : 0);
290 }
291 
292 static void
initialize_channel_class_file(void)293 initialize_channel_class_file (void)
294 {
295   channel_class_t * class = (OS_malloc (sizeof (channel_class_t)));
296   (*class) = (*NT_channel_class_generic);
297   (CHANNEL_CLASS_TYPE (class)) = channel_type_file;
298   (CHANNEL_CLASS_OP_N_READ (class)) = file_channel_n_read;
299   NT_channel_class_file = class;
300 }
301 
302 static long
screen_channel_read(Tchannel channel,void * buffer,unsigned long n_bytes)303 screen_channel_read (Tchannel channel, void * buffer, unsigned long n_bytes)
304 {
305   DWORD bytes_read
306     = (Screen_Read ((CHANNEL_HANDLE (channel)),
307 		    ((BOOL) (CHANNEL_BUFFERED (channel))),
308 		    buffer,
309 		    n_bytes));
310   if (bytes_read == 0xFFFFFFFF)
311     {
312       /* For pleasantness give up rest of this timeslice.  */
313       Sleep (0);
314       REQUEST_INTERRUPT (INT_Global_1);	/* windows polling */
315       return (-1);
316     }
317   return (bytes_read);
318 }
319 
320 static long
screen_channel_write(Tchannel channel,const void * buffer,unsigned long n_bytes)321 screen_channel_write (Tchannel channel, const void * buffer,
322 		      unsigned long n_bytes)
323 {
324   HANDLE h = (CHANNEL_HANDLE (channel));
325   SendMessage (h, SCREEN_WRITE, ((WPARAM) n_bytes), ((LPARAM) buffer));
326   if (h == master_tty_window)
327     SendMessage (h, WM_PAINT, 0, 0);
328   return (n_bytes);
329 }
330 
331 static long
screen_channel_n_read(Tchannel channel)332 screen_channel_n_read (Tchannel channel)
333 {
334   /* This is incorrect.  However, it's a pain to do the right thing.
335      Furthermore, NT_channel_n_read is only used by "select", and for
336      that particular case, this is the correct value.  */
337   return (CHANNEL_N_READ_WOULD_BLOCK);
338 }
339 
340 static void
initialize_channel_class_screen(void)341 initialize_channel_class_screen (void)
342 {
343   channel_class_t * class = (OS_malloc (sizeof (channel_class_t)));
344   (CHANNEL_CLASS_TYPE (class)) = channel_type_terminal;
345   (CHANNEL_CLASS_OP_READ (class)) = screen_channel_read;
346   (CHANNEL_CLASS_OP_WRITE (class)) = screen_channel_write;
347   (CHANNEL_CLASS_OP_CLOSE (class)) = 0;
348   (CHANNEL_CLASS_OP_N_READ (class)) = screen_channel_n_read;
349   NT_channel_class_screen = class;
350 }
351 
352 void
OS_make_pipe(Tchannel * readerp,Tchannel * writerp)353 OS_make_pipe (Tchannel * readerp, Tchannel * writerp)
354 {
355   HANDLE hread;
356   HANDLE hwrite;
357   STD_BOOL_API_CALL (CreatePipe, ((&hread), (&hwrite), 0, 0));
358   transaction_begin ();
359   NT_handle_close_on_abort (hwrite);
360   (*readerp) = (NT_make_channel (hread, NT_channel_class_anonymous_pipe));
361   transaction_commit ();
362   transaction_begin ();
363   OS_channel_close_on_abort (*readerp);
364   (*writerp) = (NT_make_channel (hwrite, NT_channel_class_anonymous_pipe));
365   transaction_commit ();
366 }
367 
368 static long
pipe_channel_read(Tchannel channel,void * buffer,unsigned long n_bytes)369 pipe_channel_read (Tchannel channel, void * buffer, unsigned long n_bytes)
370 {
371 #ifdef TRACE_NTIO
372   fprintf (trace_file, "pipe_channel_read: channel=%d blocking=%s\n",
373 	   channel,
374 	   ((CHANNEL_NONBLOCKING (channel)) ? "no" : "yes"));
375   fflush (trace_file);
376 #endif
377   if (CHANNEL_NONBLOCKING (channel))
378     {
379       long n = (NT_channel_n_read (channel));
380 #ifdef TRACE_NTIO
381       fprintf (trace_file, "pipe_channel_read: n=%d\n", n);
382       fflush (trace_file);
383 #endif
384       if (n <= 0)
385 	return (n);
386     }
387   return (generic_channel_read (channel, buffer, n_bytes));
388 }
389 
390 static long
pipe_channel_n_read(Tchannel channel)391 pipe_channel_n_read (Tchannel channel)
392 {
393   DWORD n;
394 #ifdef TRACE_NTIO
395   fprintf (trace_file, "pipe_channel_n_read: channel=%d\n", channel);
396   fflush (trace_file);
397 #endif
398   if (!PeekNamedPipe ((CHANNEL_HANDLE (channel)), 0, 0, 0, (&n), 0))
399     {
400       DWORD code = (GetLastError ());
401       if ((code == ERROR_INVALID_HANDLE)
402 	  || (code == ERROR_BROKEN_PIPE))
403 	/* ERROR_BROKEN_PIPE means the other end of the pipe has been
404 	   closed, so return zero which means "end of file".  */
405 	return (0);
406       NT_error_api_call (code, apicall_PeekNamedPipe);
407     }
408 #ifdef TRACE_NTIO
409   fprintf (trace_file, "pipe_channel_n_read: n=%d\n", n);
410   fflush (trace_file);
411 #endif
412   return ((n == 0) ? CHANNEL_N_READ_WOULD_BLOCK : n);
413 }
414 
415 static void
initialize_channel_class_anonymous_pipe(void)416 initialize_channel_class_anonymous_pipe (void)
417 {
418   channel_class_t * class = (OS_malloc (sizeof (channel_class_t)));
419   (CHANNEL_CLASS_TYPE (class)) = channel_type_win32_anonymous_pipe;
420   (CHANNEL_CLASS_OP_READ (class)) = pipe_channel_read;
421   (CHANNEL_CLASS_OP_WRITE (class)) = generic_channel_write;
422   (CHANNEL_CLASS_OP_CLOSE (class)) = generic_channel_close;
423   (CHANNEL_CLASS_OP_N_READ (class)) = pipe_channel_n_read;
424   NT_channel_class_anonymous_pipe = class;
425 }
426 
427 static void
initialize_channel_class_named_pipe(void)428 initialize_channel_class_named_pipe (void)
429 {
430   channel_class_t * class = (OS_malloc (sizeof (channel_class_t)));
431   (*class) = (*NT_channel_class_anonymous_pipe);
432   (CHANNEL_CLASS_TYPE (class)) = channel_type_win32_named_pipe;
433   NT_channel_class_named_pipe = class;
434 }
435 
436 static long
cooked_channel_write(Tchannel channel,const void * buffer,unsigned long n_bytes)437 cooked_channel_write (Tchannel channel, const void * buffer,
438 		      unsigned long n_bytes)
439 {
440   /* Map LF to CR/LF */
441   static const unsigned char crlf [] = {CARRIAGE_RETURN, LINEFEED};
442   const unsigned char * bstart = buffer;
443   const unsigned char * start = bstart;
444   const unsigned char * end = (start + n_bytes);
445   while (start < end)
446     {
447       const unsigned char * scan = start;
448       while ((scan < end) && ((*scan) != LINEFEED))
449 	scan += 1;
450       if (scan > start)
451 	{
452 	  unsigned int n_bytes = (scan - start);
453 	  long n_written
454 	    = ((* (CHANNEL_CLASS_OP_WRITE (CHANNEL_CLASS (channel))))
455 	       (channel, start, n_bytes));
456 	  if (n_written < 0)
457 	    return (start - bstart);
458 	  if (((unsigned int) n_written) < n_bytes)
459 	    return ((start - bstart) + n_written);
460 	}
461       if (scan < end)
462 	{
463 	  unsigned int n_bytes = (sizeof (crlf));
464 	  long n_written
465 	    = ((* (CHANNEL_CLASS_OP_WRITE (CHANNEL_CLASS (channel))))
466 	       (channel, crlf, n_bytes));
467 	  if (n_written < ((long) n_bytes))
468 	    /* This backs out incorrectly if only CR is written out.  */
469 	    return (scan - bstart);
470 	}
471       start = (scan + 1);
472     }
473   return (n_bytes);
474 }
475 
476 size_t
OS_channel_read_load_file(Tchannel channel,void * buffer,size_t nbytes)477 OS_channel_read_load_file (Tchannel channel, void * buffer, size_t nbytes)
478 {
479   DWORD scr;
480   return ((ReadFile (CHANNEL_HANDLE (channel), buffer, nbytes, &scr, 0))
481 	  ? scr : 0);
482 }
483 
484 size_t
OS_channel_write_dump_file(Tchannel channel,const void * buffer,size_t nbytes)485 OS_channel_write_dump_file (Tchannel channel, const void * buffer,
486 			    size_t nbytes)
487 {
488   DWORD  scr;
489   return ((WriteFile (CHANNEL_HANDLE (channel), ((LPCVOID) buffer), nbytes,
490 		      &scr, 0))
491 	  ? scr : 0);
492 }
493 
494 void
OS_channel_write_string(Tchannel channel,const char * string)495 OS_channel_write_string (Tchannel channel, const char * string)
496 {
497   long length = (strlen (string));
498   if ((OS_channel_write (channel, string, length)) != length)
499     error_external_return ();
500 }
501 
502 int
OS_channel_nonblocking_p(Tchannel channel)503 OS_channel_nonblocking_p (Tchannel channel)
504 {
505   return (CHANNEL_NONBLOCKING (channel));
506 }
507 
508 void
OS_channel_nonblocking(Tchannel channel)509 OS_channel_nonblocking (Tchannel channel)
510 {
511   (CHANNEL_NONBLOCKING (channel)) = 1;
512 }
513 
514 void
OS_channel_blocking(Tchannel channel)515 OS_channel_blocking (Tchannel channel)
516 {
517   (CHANNEL_NONBLOCKING (channel)) = 0;
518 }
519 
520 int
OS_terminal_buffered_p(Tchannel channel)521 OS_terminal_buffered_p (Tchannel channel)
522 {
523   return (CHANNEL_BUFFERED (channel));
524 }
525 
526 void
OS_terminal_buffered(Tchannel channel)527 OS_terminal_buffered (Tchannel channel)
528 {
529   (CHANNEL_BUFFERED (channel)) = 1;
530 }
531 
532 void
OS_terminal_nonbuffered(Tchannel channel)533 OS_terminal_nonbuffered (Tchannel channel)
534 {
535   (CHANNEL_BUFFERED (channel)) = 0;
536 }
537 
538 int
OS_terminal_cooked_output_p(Tchannel channel)539 OS_terminal_cooked_output_p (Tchannel channel)
540 {
541   return (CHANNEL_COOKED (channel));
542 }
543 
544 void
OS_terminal_cooked_output(Tchannel channel)545 OS_terminal_cooked_output (Tchannel channel)
546 {
547   CHANNEL_COOKED (channel) = 1;
548 }
549 
550 void
OS_terminal_raw_output(Tchannel channel)551 OS_terminal_raw_output (Tchannel channel)
552 {
553   CHANNEL_COOKED (channel) = 0;
554 }
555 
556 void
OS_terminal_flush_input(Tchannel channel)557 OS_terminal_flush_input (Tchannel channel)
558 {
559 }
560 
561 void
OS_terminal_flush_output(Tchannel channel)562 OS_terminal_flush_output (Tchannel channel)
563 {
564 }
565 
566 void
OS_terminal_drain_output(Tchannel channel)567 OS_terminal_drain_output (Tchannel channel)
568 {
569 }
570 
571 unsigned int
arg_baud_index(unsigned int argument)572 arg_baud_index (unsigned int argument)
573 {
574   return (arg_index_integer (argument, 1));
575 }
576 
577 unsigned int
OS_terminal_get_ispeed(Tchannel channel)578 OS_terminal_get_ispeed (Tchannel channel)
579 {
580   return (0);
581 }
582 
583 unsigned int
OS_terminal_get_ospeed(Tchannel channel)584 OS_terminal_get_ospeed (Tchannel channel)
585 {
586   return (0);
587 }
588 
589 void
OS_terminal_set_ispeed(Tchannel channel,unsigned int baud)590 OS_terminal_set_ispeed (Tchannel channel, unsigned int baud)
591 {
592 }
593 
594 void
OS_terminal_set_ospeed(Tchannel channel,unsigned int baud)595 OS_terminal_set_ospeed (Tchannel channel, unsigned int baud)
596 {
597 }
598 
599 unsigned int
OS_baud_index_to_rate(unsigned int index)600 OS_baud_index_to_rate (unsigned int index)
601 {
602   return (9600);
603 }
604 
605 int
OS_baud_rate_to_index(unsigned int rate)606 OS_baud_rate_to_index (unsigned int rate)
607 {
608   return ((rate == 9600) ? 0 : -1);
609 }
610 
611 unsigned int
OS_terminal_state_size(void)612 OS_terminal_state_size (void)
613 {
614   return (3);
615 }
616 
617 void
OS_terminal_get_state(Tchannel channel,void * state_ptr)618 OS_terminal_get_state (Tchannel channel, void * state_ptr)
619 {
620   unsigned char * statep = ((unsigned char *) state_ptr);
621   (*statep++) = (CHANNEL_NONBLOCKING (channel));
622   (*statep++) = (CHANNEL_BUFFERED (channel));
623   (*statep)   = (CHANNEL_COOKED (channel));
624 }
625 
626 void
OS_terminal_set_state(Tchannel channel,void * state_ptr)627 OS_terminal_set_state (Tchannel channel, void * state_ptr)
628 {
629   unsigned char * statep = ((unsigned char *) state_ptr);
630   (CHANNEL_NONBLOCKING (channel)) = (*statep++);
631   (CHANNEL_BUFFERED (channel))    = (*statep++);
632   (CHANNEL_COOKED (channel))      = (*statep);
633 }
634 
635 int
OS_job_control_p(void)636 OS_job_control_p (void)
637 {
638   return (0);
639 }
640 
641 int
OS_have_ptys_p(void)642 OS_have_ptys_p (void)
643 {
644   return (0);
645 }
646 
647 /* Initialization/Termination code. */
648 
649 int OS_have_select_p = 0;
650 
651 extern HANDLE master_tty_window;
652 extern void NT_initialize_channels (void);
653 extern void NT_reset_channels (void);
654 extern void NT_restore_channels (void);
655 
656 void
NT_reset_channels(void)657 NT_reset_channels (void)
658 {
659   OS_free (NT_channel_table);
660   NT_channel_table = 0;
661   OS_channel_table_size = 0;
662 }
663 
664 void
NT_restore_channels(void)665 NT_restore_channels (void)
666 {
667   if (master_tty_window != ((HANDLE) NULL))
668     Screen_Destroy (TRUE, master_tty_window);
669   master_tty_window = ((HANDLE) NULL);
670 }
671 
672 void
NT_initialize_channels(void)673 NT_initialize_channels (void)
674 {
675   master_tty_window = (Screen_Create (NULL, "MIT/GNU Scheme", SW_SHOWNORMAL));
676   if (win32_under_win32s_p ())
677     OS_have_select_p = 0;
678   else
679     OS_have_select_p = 1;
680   /* The following API call boosts the number of available handles to
681      its maximum value.  This has no effect under NT, which does not
682      place a limit on the number of handles.  */
683   (void) SetHandleCount (255);
684   OS_channel_table_size = NT_DEFAULT_CHANNEL_TABLE_SIZE;
685   NT_channel_table
686     = (OS_malloc (OS_channel_table_size * (sizeof (struct channel))));
687   {
688     Tchannel channel;
689     for (channel = 0; (channel < OS_channel_table_size); channel += 1)
690       MARK_CHANNEL_CLOSED (channel);
691   }
692   add_reload_cleanup (NT_channel_close_all);
693   initialize_channel_class_generic ();
694   initialize_channel_class_file ();
695   initialize_channel_class_screen ();
696   initialize_channel_class_anonymous_pipe ();
697   initialize_channel_class_named_pipe ();
698 }
699 
700 struct select_registry_s
701 {
702   unsigned int n_channels;
703   unsigned int length;
704   Tchannel * channels;
705   unsigned char * qmodes;
706   unsigned char * rmodes;
707 };
708 
709 select_registry_t
OS_allocate_select_registry(void)710 OS_allocate_select_registry (void)
711 {
712   struct select_registry_s * r
713     = (OS_malloc (sizeof (struct select_registry_s)));
714   (r -> n_channels) = 0;
715   (r -> length) = 16;
716   (r -> channels) = (OS_malloc ((sizeof (Tchannel)) * (r -> length)));
717   (r -> qmodes) = (OS_malloc ((sizeof (unsigned char)) * (r -> length)));
718   (r -> rmodes) = (OS_malloc ((sizeof (unsigned char)) * (r -> length)));
719   return (r);
720 }
721 
722 void
OS_deallocate_select_registry(select_registry_t registry)723 OS_deallocate_select_registry (select_registry_t registry)
724 {
725   struct select_registry_s * r = registry;
726   OS_free (r -> rmodes);
727   OS_free (r -> qmodes);
728   OS_free (r -> channels);
729   OS_free (r);
730 }
731 
732 static void
resize_select_registry(struct select_registry_s * r,int growp)733 resize_select_registry (struct select_registry_s * r, int growp)
734 {
735   if (growp)
736     (r -> length) *= 2;
737   else
738     (r -> length) /= 2;
739   (r -> channels)
740     = (OS_realloc ((r -> channels),
741 		   ((sizeof (Tchannel)) * (r -> length))));
742   (r -> qmodes)
743     = (OS_realloc ((r -> qmodes),
744 		   ((sizeof (unsigned char)) * (r -> length))));
745   (r -> rmodes)
746     = (OS_realloc ((r -> rmodes),
747 		   ((sizeof (unsigned char)) * (r -> length))));
748 }
749 
750 void
OS_add_to_select_registry(select_registry_t registry,int fd,unsigned int mode)751 OS_add_to_select_registry (select_registry_t registry, int fd,
752 			   unsigned int mode)
753 {
754   struct select_registry_s * r = registry;
755   Tchannel channel = fd;
756   unsigned int i = 0;
757 
758   while (i < (r -> n_channels))
759     {
760       if (((r -> channels) [i]) == channel)
761 	{
762 	  ((r -> qmodes) [i]) |= mode;
763 	  return;
764 	}
765       i += 1;
766     }
767   if (i == (r -> length))
768     resize_select_registry (r, 1);
769   ((r -> channels) [i]) = channel;
770   ((r -> qmodes) [i]) = mode;
771   (r -> n_channels) += 1;
772 }
773 
774 void
OS_remove_from_select_registry(select_registry_t registry,int fd,unsigned int mode)775 OS_remove_from_select_registry (select_registry_t registry, int fd,
776 				unsigned int mode)
777 {
778   struct select_registry_s * r = registry;
779   Tchannel channel = fd;
780   unsigned int i = 0;
781 
782   while (1)
783     {
784       if (i == (r -> n_channels))
785 	return;
786       if (((r -> channels) [i]) == channel)
787 	{
788 	  ((r -> qmodes) [i]) &=~ mode;
789 	  if (((r -> qmodes) [i]) == 0)
790 	    break;
791 	  else
792 	    return;
793 	}
794       i += 1;
795     }
796   while (i < (r -> n_channels))
797     {
798       ((r -> channels) [i]) = ((r -> channels) [(i + 1)]);
799       ((r -> qmodes) [i]) = ((r -> qmodes) [(i + 1)]);
800       i += 1;
801     }
802   (r -> n_channels) -= 1;
803 
804   if (((r -> length) > 16) && ((r -> n_channels) < ((r -> length) / 2)))
805     resize_select_registry (r, 0);
806 }
807 
808 unsigned int
OS_select_registry_length(select_registry_t registry)809 OS_select_registry_length (select_registry_t registry)
810 {
811   struct select_registry_s * r = registry;
812   return (r -> n_channels);
813 }
814 
815 void
OS_select_registry_result(select_registry_t registry,unsigned int index,int * fd_r,unsigned int * mode_r)816 OS_select_registry_result (select_registry_t registry, unsigned int index,
817 			   int * fd_r, unsigned int * mode_r)
818 {
819   struct select_registry_s * r = registry;
820   (*fd_r) = ((r -> channels) [index]);
821   (*mode_r) = ((r -> rmodes) [index]);
822 }
823 
824 int
OS_test_select_registry(select_registry_t registry,int blockp)825 OS_test_select_registry (select_registry_t registry, int blockp)
826 {
827   struct select_registry_s * r = registry;
828   if (win32_trace_level > 1)
829     {
830       fprintf (win32_trace_file, "OS_test_select_registry: ");
831       fprintf (win32_trace_file, "n_channels=%d blockp=%d\n",
832 	       (r -> n_channels), blockp);
833       fflush (win32_trace_file);
834     }
835   {
836     int result
837       = (blockp
838 	 ? (wait_on_multiple_objects (r))
839 	 : (test_multiple_objects (r)));
840     if (win32_trace_level > 1)
841       {
842 	fprintf (win32_trace_file, "OS_test_select_registry: ");
843 	fprintf (win32_trace_file, "result=%d\n", result);
844 	fflush (win32_trace_file);
845       }
846     return (result);
847   }
848 }
849 
850 int
OS_pause(void)851 OS_pause (void)
852 {
853   /* Wait-for-io must spin. */
854   return
855     ((OS_process_any_status_change ())
856      ? SELECT_PROCESS_STATUS_CHANGE
857      : SELECT_INTERRUPT);
858 }
859 
860 static int
wait_on_multiple_objects(struct select_registry_s * r)861 wait_on_multiple_objects (struct select_registry_s * r)
862 {
863   while (1)
864     {
865       {
866 	int result = (test_multiple_objects (r));
867 	if (result != 0)
868 	  return (result);
869       }
870       /* Block waiting for a message to arrive.  The asynchronous
871 	 interrupt thread guarantees that a message will arrive in a
872 	 reasonable amount of time.  */
873       if ((MsgWaitForMultipleObjects (0, 0, FALSE, INFINITE, QS_ALLINPUT))
874 	  == WAIT_FAILED)
875 	NT_error_api_call
876 	  ((GetLastError ()), apicall_MsgWaitForMultipleObjects);
877     }
878 }
879 
880 static int
test_multiple_objects(struct select_registry_s * r)881 test_multiple_objects (struct select_registry_s * r)
882 {
883   unsigned int i;
884   unsigned int j;
885 
886   j = 0;
887   for (i = 0; (i < (r -> n_channels)); i += 1)
888     {
889       ((r -> rmodes) [i])
890 	= (test_single_object_1 (((r -> channels) [i]),
891 				 ((r -> qmodes) [i])));
892       if (((r -> rmodes) [i]) != 0)
893 	j += 1;
894     }
895   return
896     ((j > 0)
897      ? j
898      : (pending_interrupts_p ())
899      ? SELECT_INTERRUPT
900      : (OS_process_any_status_change ())
901      ? SELECT_PROCESS_STATUS_CHANGE
902      : 0);
903 }
904 
905 int
OS_test_select_descriptor(int fd,int blockp,unsigned int qmode)906 OS_test_select_descriptor (int fd, int blockp, unsigned int qmode)
907 {
908   Tchannel channel = fd;
909   return
910     (blockp
911      ? (wait_on_single_object (channel, qmode))
912      : (test_single_object (channel, qmode)));
913 }
914 
915 static int
wait_on_single_object(Tchannel channel,unsigned int qmode)916 wait_on_single_object (Tchannel channel, unsigned int qmode)
917 {
918   while (1)
919     {
920       int result = (test_single_object (channel, qmode));
921       if (result != 0)
922 	return (result);
923 
924       /* Block waiting for a message to arrive.  The asynchronous
925 	 interrupt thread guarantees that a message will arrive in a
926 	 reasonable amount of time.  */
927       if ((MsgWaitForMultipleObjects (0, 0, FALSE, INFINITE, QS_ALLINPUT))
928 	  == WAIT_FAILED)
929 	NT_error_api_call
930 	  ((GetLastError ()), apicall_MsgWaitForMultipleObjects);
931     }
932 }
933 
934 static int
test_single_object(Tchannel channel,unsigned int qmode)935 test_single_object (Tchannel channel, unsigned int qmode)
936 {
937   unsigned int rmode = (test_single_object_1 (channel, qmode));
938   return
939     ((rmode > 0)
940      ? rmode
941      : (pending_interrupts_p ())
942      ? SELECT_INTERRUPT
943      : (OS_process_any_status_change ())
944      ? SELECT_PROCESS_STATUS_CHANGE
945      : 0);
946 }
947 
948 
949 static unsigned int
test_single_object_1(Tchannel channel,unsigned int qmode)950 test_single_object_1 (Tchannel channel, unsigned int qmode)
951 {
952   unsigned int rmode = (qmode & SELECT_MODE_WRITE);
953   if (((qmode & SELECT_MODE_READ) != 0)
954       && ((channel == (OS_tty_input_channel ()))
955 	  ? (test_for_pending_event ())
956 	  : ((NT_channel_n_read (channel)) > 0)))
957     rmode |= SELECT_MODE_READ;
958   return (rmode);
959 }
960 
961 static int
test_for_pending_event(void)962 test_for_pending_event (void)
963 {
964   MSG m;
965   while (PeekMessage ((&m), 0, 0, 0, PM_REMOVE))
966     DispatchMessage (&m);
967   return (Screen_pending_events_p ());
968 }
969