lib/os_io.c

   1 /* File: "os_io.c" */
   2
   3 /* Copyright (c) 1994-2012 by Marc Feeley, All Rights Reserved. */
   4
   5 /*
   6  * This module implements the operating system specific routines
   7  * related to I/O.
   8  */
   9
  10 #define ___INCLUDED_FROM_OS_IO
  11 #define ___VERSION 406003
  12 #include "gambit.h"
  13
  14 #include "os_base.h"
  15 #include "os_io.h"
  16 #include "os_tty.h"
  17 #include "os_files.h"
  18 #include "setup.h"
  19 #include "c_intf.h"
  20
  21 /*---------------------------------------------------------------------------*/
  22
  23
  24 ___io_module ___io_mod =
  25 {
  26   0,
  27   0
  28
  29 #ifdef ___IO_MODULE_INIT
  30   ___IO_MODULE_INIT
  31 #endif
  32 };
  33
  34
  35 /*---------------------------------------------------------------------------*/
  36
  37 /* Device groups. */
  38
  39
  40 ___SCMOBJ ___device_group_setup
  41    ___P((___device_group **dgroup),
  42         (dgroup)
  43 ___device_group **dgroup;)
  44 {
  45   ___SCMOBJ e;
  46   ___device_group *g;
  47
  48   g = ___CAST(___device_group*,
  49               ___alloc_mem (sizeof (___device_group)));
  50
  51   if (g == NULL)
  52     return ___FIX(___HEAP_OVERFLOW_ERR);
  53
  54   g->list = NULL;
  55
  56   *dgroup = g;
  57
  58   return ___FIX(___NO_ERR);
  59 }
  60
  61
  62 void ___device_group_cleanup
  63    ___P((___device_group *dgroup),
  64         (dgroup)
  65 ___device_group *dgroup;)
  66 {
  67   while (dgroup->list != NULL)
  68     if (___device_cleanup (dgroup->list) != ___FIX(___NO_ERR))
  69       break;
  70
  71   ___free_mem (dgroup);
  72 }
  73
  74
  75 void ___device_add_to_group
  76    ___P((___device_group *dgroup,
  77          ___device *dev),
  78         (dgroup,
  79          dev)
  80 ___device_group *dgroup;
  81 ___device *dev;)
  82 {
  83   ___device *head = dgroup->list;
  84
  85   dev->group = dgroup;
  86
  87   if (head == NULL)
  88     {
  89       dev->next = dev;
  90       dev->prev = dev;
  91       dgroup->list = dev;
  92     }
  93   else
  94     {
  95       ___device *tail = head->prev;
  96       dev->next = head;
  97       dev->prev = tail;
  98       tail->next = dev;
  99       head->prev = dev;
 100     }
 101 }
 102
 103 void ___device_remove_from_group
 104    ___P((___device *dev),
 105         (dev)
 106 ___device *dev;)
 107 {
 108   ___device_group *dgroup = dev->group;
 109   ___device *prev = dev->prev;
 110   ___device *next = dev->next;
 111
 112   if (prev == dev)
 113     dgroup->list = NULL;
 114   else
 115     {
 116       if (dgroup->list == dev)
 117         dgroup->list = next;
 118       prev->next = next;
 119       next->prev = prev;
 120       dev->next = dev;
 121       dev->prev = dev;
 122     }
 123
 124   dev->group = NULL;
 125 }
 126
 127 ___device_group *___global_device_group ___PVOID
 128 {
 129   return ___io_mod.dgroup;
 130 }
 131
 132
 133 /*---------------------------------------------------------------------------*/
 134
 135 /* Nonblocking pipes */
 136
 137 #ifdef USE_PUMPS
 138
 139 ___HIDDEN ___SCMOBJ ___nonblocking_pipe_setup
 140    ___P((___nonblocking_pipe *pipe,
 141          int size),
 142         (pipe,
 143          size)
 144 ___nonblocking_pipe *pipe;
 145 int size;)
 146 {
 147   ___U8 *buffer;
 148   HANDLE mutex;
 149   HANDLE revent;
 150   HANDLE wevent;
 151
 152   buffer = ___CAST(___U8*,
 153                    ___alloc_mem (size));
 154
 155   if (buffer == NULL)
 156     return ___FIX(___HEAP_OVERFLOW_ERR);
 157
 158   mutex = CreateMutex (NULL,  /* can't inherit */
 159                        FALSE, /* unlocked */
 160                        NULL); /* no name */
 161
 162   if (mutex == NULL)
 163     {
 164       ___SCMOBJ e = err_code_from_GetLastError ();
 165       ___free_mem (buffer);
 166       return e;
 167     }
 168
 169   revent = CreateEvent (NULL,  /* can't inherit */
 170                         TRUE,  /* manual reset */
 171                         FALSE, /* not signaled */
 172                         NULL); /* no name */
 173
 174   if (revent == NULL)
 175     {
 176       ___SCMOBJ e = err_code_from_GetLastError ();
 177       CloseHandle (mutex); /* ignore error */
 178       ___free_mem (buffer);
 179       return e;
 180     }
 181
 182   wevent = CreateEvent (NULL,  /* can't inherit */
 183                         TRUE,  /* manual reset */
 184                         FALSE, /* not signaled */
 185                         NULL); /* no name */
 186
 187   if (wevent == NULL)
 188     {
 189       ___SCMOBJ e = err_code_from_GetLastError ();
 190       CloseHandle (revent); /* ignore error */
 191       CloseHandle (mutex); /* ignore error */
 192       ___free_mem (buffer);
 193       return e;
 194     }
 195
 196   pipe->mutex = mutex;
 197   pipe->revent = revent;
 198   pipe->wevent = wevent;
 199   pipe->rerr = ___FIX(___NO_ERR);
 200   pipe->werr = ___FIX(___NO_ERR);
 201   pipe->oob = 0;
 202   pipe->rd = 0;
 203   pipe->wr = 0;
 204   pipe->size = size;
 205   pipe->buffer = buffer;
 206
 207   return ___FIX(___NO_ERR);
 208 }
 209
 210 ___HIDDEN ___SCMOBJ ___nonblocking_pipe_cleanup
 211    ___P((___nonblocking_pipe *pipe),
 212         (pipe)
 213 ___nonblocking_pipe *pipe;)
 214 {
 215   CloseHandle (pipe->wevent); /* ignore error */
 216   CloseHandle (pipe->revent); /* ignore error */
 217   CloseHandle (pipe->mutex); /* ignore error */
 218   ___free_mem (pipe->buffer);
 219
 220   return ___FIX(___NO_ERR);
 221 }
 222
 223 ___HIDDEN ___SCMOBJ ___nonblocking_pipe_set_reader_err
 224    ___P((___nonblocking_pipe *pipe,
 225          ___SCMOBJ err),
 226         (pipe,
 227          err)
 228 ___nonblocking_pipe *pipe;
 229 ___SCMOBJ err;)
 230 {
 231   if (WaitForSingleObject (pipe->mutex, INFINITE) == WAIT_FAILED)
 232     return err_code_from_GetLastError ();
 233
 234   /* note: the reader error indicator may get overwritten */
 235
 236   pipe->rerr = err;
 237
 238   SetEvent (pipe->wevent); /* ignore error */
 239
 240   if (pipe->werr == ___FIX(___NO_ERR))
 241     ResetEvent (pipe->revent); /* ignore error */
 242
 243   ReleaseMutex (pipe->mutex); /* ignore error */
 244
 245   return ___FIX(___NO_ERR);
 246 }
 247
 248 ___HIDDEN ___SCMOBJ ___nonblocking_pipe_set_writer_err
 249    ___P((___nonblocking_pipe *pipe,
 250          ___SCMOBJ err),
 251         (pipe,
 252          err)
 253 ___nonblocking_pipe *pipe;
 254 ___SCMOBJ err;)
 255 {
 256   if (WaitForSingleObject (pipe->mutex, INFINITE) == WAIT_FAILED)
 257     return err_code_from_GetLastError ();
 258
 259   /* note: the writer error indicator may get overwritten */
 260
 261   pipe->werr = err;
 262
 263   SetEvent (pipe->revent); /* ignore error */
 264
 265   if (pipe->rerr == ___FIX(___NO_ERR))
 266     ResetEvent (pipe->wevent); /* ignore error */
 267
 268   ReleaseMutex (pipe->mutex); /* ignore error */
 269
 270   return ___FIX(___NO_ERR);
 271 }
 272
 273 ___HIDDEN ___SCMOBJ ___nonblocking_pipe_write_oob
 274    ___P((___nonblocking_pipe *pipe,
 275          ___nonblocking_pipe_oob_msg *oob_msg),
 276         (pipe,
 277          oob_msg)
 278 ___nonblocking_pipe *pipe;
 279 ___nonblocking_pipe_oob_msg *oob_msg;)
 280 {
 281   if (WaitForSingleObject (pipe->mutex, INFINITE) == WAIT_FAILED)
 282     return err_code_from_GetLastError ();
 283
 284   if (pipe->werr != ___FIX(___NO_ERR) || pipe->oob)
 285     {
 286       ReleaseMutex (pipe->mutex); /* ignore error */
 287       return ___ERR_CODE_EAGAIN;
 288     }
 289
 290   pipe->oob = 1;
 291   pipe->oob_msg = *oob_msg;
 292
 293   if (pipe->rerr == ___FIX(___NO_ERR))
 294     {
 295       SetEvent (pipe->revent); /* ignore error */
 296       ResetEvent (pipe->wevent); /* ignore error */
 297     }
 298
 299   ReleaseMutex (pipe->mutex); /* ignore error */
 300
 301   return ___FIX(___NO_ERR);
 302 }
 303
 304 ___HIDDEN ___SCMOBJ ___nonblocking_pipe_read_ready_wait
 305    ___P((___nonblocking_pipe *pipe),
 306         (pipe)
 307 ___nonblocking_pipe *pipe;)
 308 {
 309   ___SCMOBJ werr;
 310
 311   if (WaitForSingleObject (pipe->revent, INFINITE) == WAIT_FAILED ||
 312       WaitForSingleObject (pipe->mutex, INFINITE) == WAIT_FAILED)
 313     return err_code_from_GetLastError ();
 314
 315   werr = pipe->werr;
 316
 317   if (werr != ___FIX(___NO_ERR))
 318     {
 319       pipe->werr = ___FIX(___NO_ERR);
 320
 321       if (pipe->rerr != ___FIX(___NO_ERR) ||
 322           (pipe->rd == pipe->wr && !pipe->oob))
 323         ResetEvent (pipe->revent); /* ignore error */
 324     }
 325
 326   ReleaseMutex (pipe->mutex); /* ignore error */
 327
 328   return werr;
 329 }
 330
 331 ___HIDDEN ___SCMOBJ ___nonblocking_pipe_write_ready_wait
 332    ___P((___nonblocking_pipe *pipe),
 333         (pipe)
 334 ___nonblocking_pipe *pipe;)
 335 {
 336   ___SCMOBJ rerr;
 337
 338   if (WaitForSingleObject (pipe->wevent, INFINITE) == WAIT_FAILED ||
 339       WaitForSingleObject (pipe->mutex, INFINITE) == WAIT_FAILED)
 340     return err_code_from_GetLastError ();
 341
 342   rerr = pipe->rerr;
 343
 344   if (rerr != ___FIX(___NO_ERR))
 345     {
 346       pipe->rerr = ___FIX(___NO_ERR);
 347
 348       ResetEvent (pipe->wevent); /* ignore error */
 349     }
 350
 351   ReleaseMutex (pipe->mutex); /* ignore error */
 352
 353   return rerr;
 354 }
 355
 356 ___HIDDEN ___SCMOBJ ___nonblocking_pipe_read
 357    ___P((___nonblocking_pipe *pipe,
 358          ___U8 *buf,
 359          ___stream_index len,
 360          ___stream_index *len_done,
 361          ___nonblocking_pipe_oob_msg *oob_msg),
 362         (pipe,
 363          buf,
 364          len,
 365          len_done,
 366          oob_msg)
 367 ___nonblocking_pipe *pipe;
 368 ___U8 *buf;
 369 ___stream_index len;
 370 ___stream_index *len_done;
 371 ___nonblocking_pipe_oob_msg *oob_msg;)
 372 {
 373   ___SCMOBJ rerr;
 374   ___SCMOBJ werr;
 375   DWORD rd;
 376   DWORD wr;
 377   ___U8 *p;
 378   DWORD end;
 379   DWORD n;
 380   DWORD i;
 381
 382   if (len <= 0)
 383     return ___FIX(___UNKNOWN_ERR);
 384
 385   if (WaitForSingleObject (pipe->mutex, INFINITE) == WAIT_FAILED)
 386     return err_code_from_GetLastError ();
 387
 388   rerr = pipe->rerr;
 389   werr = pipe->werr;
 390   rd = pipe->rd;
 391   wr = pipe->wr;
 392
 393   if (rerr != ___FIX(___NO_ERR))
 394     {
 395       /* there is a reader error */
 396
 397       if (werr == ___FIX(___NO_ERR))
 398         werr = ___ERR_CODE_EAGAIN;
 399       else
 400         {
 401           pipe->werr = ___FIX(___NO_ERR);
 402           ResetEvent (pipe->revent); /* ignore error */
 403         }
 404       ReleaseMutex (pipe->mutex); /* ignore error */
 405       return werr;
 406     }
 407
 408   /* there is no reader error */
 409
 410   if (rd == wr)
 411     {
 412       /* no bytes in FIFO buffer */
 413
 414       if (pipe->oob)
 415         {
 416           /* out-of-band present */
 417
 418           *oob_msg = pipe->oob_msg;
 419           pipe->oob = 0;
 420           if (werr == ___FIX(___NO_ERR))
 421             {
 422               ResetEvent (pipe->revent); /* ignore error */
 423 #if 0
 424               /******************zzzzzzzzzzzzzz****/
 425               SetEvent (pipe->wevent); /* ignore error */
 426 #endif
 427             }
 428           ReleaseMutex (pipe->mutex); /* ignore error */
 429           *len_done = 0;
 430           return ___FIX(___NO_ERR);
 431         }
 432
 433       /* out-of-band not present */
 434
 435       if (werr != ___FIX(___NO_ERR))
 436         {
 437           /* there is a writer error */
 438
 439           pipe->werr = ___FIX(___NO_ERR);
 440
 441           ResetEvent (pipe->revent); /* ignore error */
 442           ReleaseMutex (pipe->mutex); /* ignore error */
 443           return werr;
 444         }
 445
 446       /* there is no writer error */
 447
 448       SetEvent (pipe->wevent); /* ignore error */
 449       ReleaseMutex (pipe->mutex); /* ignore error */
 450       return ___ERR_CODE_EAGAIN;
 451     }
 452
 453   /* at least one byte in FIFO buffer */
 454
 455   end = pipe->size - rd; /* number of bytes from rd to end */
 456
 457   n = wr + end; /* number of bytes available */
 458   if (n >= pipe->size)
 459     n -= pipe->size;
 460
 461   if (n > ___CAST(DWORD,len)) /* don't transfer more than len */
 462     n = len;
 463
 464   *len_done = n;
 465
 466   p = pipe->buffer + rd; /* prepare transfer source */
 467
 468   rd = rd + n;
 469   if (rd >= pipe->size)
 470     rd -= pipe->size;
 471
 472   pipe->rd = rd;
 473
 474   if (werr == ___FIX(___NO_ERR) && !pipe->oob)
 475     {
 476       /* there is no writer error and out-of-band not present */
 477
 478       if (rd == wr) /* the FIFO will be empty? */
 479         ResetEvent (pipe->revent); /* ignore error */
 480
 481       /* the FIFO will not be full */
 482
 483       SetEvent (pipe->wevent); /* ignore error */
 484     }
 485
 486   if (n <= end)
 487     {
 488       /* only need to transfer n bytes starting from original rd */
 489
 490       for (i=n; i>0; i--)
 491         *buf++ = *p++;
 492     }
 493   else
 494     {
 495       /* need to transfer end bytes starting from original rd */
 496
 497       for (i=end; i>0; i--)
 498         *buf++ = *p++;
 499
 500       /* and to transfer n-end bytes starting from 0 */
 501
 502       p = pipe->buffer;
 503
 504       for (i=n-end; i>0; i--)
 505         *buf++ = *p++;
 506     }
 507
 508   ReleaseMutex (pipe->mutex); /* ignore error */
 509
 510   return ___FIX(___NO_ERR);
 511 }
 512
 513 ___HIDDEN ___SCMOBJ ___nonblocking_pipe_write
 514    ___P((___nonblocking_pipe *pipe,
 515          ___U8 *buf,
 516          ___stream_index len,
 517          ___stream_index *len_done),
 518         (pipe,
 519          buf,
 520          len,
 521          len_done)
 522 ___nonblocking_pipe *pipe;
 523 ___U8 *buf;
 524 ___stream_index len;
 525 ___stream_index *len_done;)
 526 {
 527   ___SCMOBJ rerr;
 528   ___SCMOBJ werr;
 529   DWORD rd;
 530   DWORD wr;
 531   ___U8 *p;
 532   DWORD end;
 533   DWORD n;
 534   DWORD i;
 535
 536   if (len <= 0)
 537     return ___FIX(___UNKNOWN_ERR);
 538
 539   if (WaitForSingleObject (pipe->mutex, INFINITE) == WAIT_FAILED)
 540     return err_code_from_GetLastError ();
 541
 542   rerr = pipe->rerr;
 543   werr = pipe->werr;
 544   rd = pipe->rd;
 545   wr = pipe->wr;
 546
 547   if (werr != ___FIX(___NO_ERR))
 548     {
 549       /* there is a writer error */
 550
 551       if (rerr == ___FIX(___NO_ERR))
 552         rerr = ___ERR_CODE_EAGAIN;
 553       else
 554         {
 555           pipe->rerr = ___FIX(___NO_ERR);
 556           ResetEvent (pipe->wevent); /* ignore error */
 557         }
 558       ReleaseMutex (pipe->mutex); /* ignore error */
 559       return rerr;
 560     }
 561
 562   /* there is no writer error */
 563
 564   if (rerr != ___FIX(___NO_ERR))
 565     {
 566       /* there is a reader error */
 567
 568       pipe->rerr = ___FIX(___NO_ERR);
 569
 570       if (rd != wr || pipe->oob) /* FIFO is not empty */
 571         SetEvent (pipe->revent); /* ignore error */
 572
 573       ResetEvent (pipe->wevent); /* ignore error */
 574       ReleaseMutex (pipe->mutex); /* ignore error */
 575       return rerr;
 576     }
 577
 578   /* there is no reader error */
 579
 580   if (wr + 1 - rd == 0 || wr + 1 - rd == pipe->size || pipe->oob)
 581     {
 582       /* FIFO buffer is full or out-of-band present */
 583
 584       ReleaseMutex (pipe->mutex); /* ignore error */
 585       return ___ERR_CODE_EAGAIN;
 586     }
 587
 588   /* FIFO buffer is not full and out-of-band not present */
 589
 590   end = pipe->size - wr; /* number of bytes from wr to end */
 591
 592   n = rd + end - 1; /* number of bytes available */
 593   if (n >= pipe->size)
 594     n -= pipe->size;
 595
 596   if (n > ___CAST(DWORD,len)) /* don't transfer more than len */
 597     n = len;
 598
 599   *len_done = n;
 600
 601   p = pipe->buffer + wr; /* prepare transfer source */
 602
 603   wr = wr + n;
 604   if (wr >= pipe->size)
 605     wr -= pipe->size;
 606
 607   pipe->wr = wr;
 608
 609   if (wr + 1 - rd == 0 || wr + 1 - rd == pipe->size) /* FIFO will be full? */
 610     ResetEvent (pipe->wevent); /* ignore error */
 611
 612   /* FIFO will not be empty */
 613
 614   SetEvent (pipe->revent); /* ignore error */
 615
 616   if (n <= end)
 617     {
 618       /* only need to transfer n bytes starting from original wr */
 619
 620       for (i=n; i>0; i--)
 621         *p++ = *buf++;
 622     }
 623   else
 624     {
 625       /* need to transfer end bytes starting from original wr */
 626
 627       for (i=end; i>0; i--)
 628         *p++ = *buf++;
 629
 630       /* and to transfer n-end bytes starting from 0 */
 631
 632       p = pipe->buffer;
 633
 634       for (i=n-end; i>0; i--)
 635         *p++ = *buf++;
 636     }
 637
 638   ReleaseMutex (pipe->mutex); /* ignore error */
 639
 640   return ___FIX(___NO_ERR);
 641 }
 642
 643 #endif
 644
 645
 646 /*---------------------------------------------------------------------------*/
 647
 648 /* Operations on I/O devices. */
 649
 650 /* Miscellaneous utility functions. */
 651
 652 #ifdef USE_POSIX
 653
 654
 655 #ifdef USE_sigaction
 656 typedef sigset_t sigset_type;
 657 #else
 658 typedef int sigset_type;
 659 #endif
 660
 661
 662 ___HIDDEN sigset_type block_signal
 663    ___P((int signum),
 664         (signum)
 665 int signum;)
 666 {
 667   sigset_type oldmask;
 668
 669 #ifdef USE_sigaction
 670
 671   sigset_type toblock;
 672
 673   sigemptyset (&toblock);
 674   sigaddset (&toblock, signum);
 675   sigprocmask (SIG_BLOCK, &toblock, &oldmask);
 676
 677 #endif
 678
 679 #ifdef USE_signal
 680
 681   oldmask = sigblock (sigmask (signum));
 682
 683 #endif
 684
 685   return oldmask;
 686 }
 687
 688
 689 ___HIDDEN void restore_sigmask
 690    ___P((sigset_type oldmask),
 691         (oldmask)
 692 sigset_type oldmask;)
 693 {
 694 #ifdef USE_sigaction
 695
 696   sigprocmask (SIG_SETMASK, &oldmask, 0);
 697
 698 #endif
 699
 700 #ifdef USE_signal
 701
 702   sigsetmask (oldmask);
 703
 704 #endif
 705 }
 706
 707
 708 /*
 709  * Some system calls can be interrupted by a signal and fail with
 710  * errno == EINTR.  The following functions are wrappers for system
 711  * calls which may be interrupted.  They simply ignore the EINTR and
 712  * retry the operation.
 713  *
 714  * TODO: add wrappers for all the system calls which can fail
 715  * with EINTR.  Also, move these functions to a central place.
 716  */
 717
 718 pid_t waitpid_no_EINTR
 719    ___P((pid_t pid,
 720          int *stat_loc,
 721          int options),
 722         (pid,
 723          stat_loc,
 724          options)
 725 pid_t pid;
 726 int *stat_loc;
 727 int options;)
 728 {
 729   pid_t result;
 730
 731   for (;;)
 732     {
 733       result = waitpid (pid, stat_loc, options);
 734       if (result >= 0 || errno != EINTR)
 735         break;
 736     }
 737
 738   return result;
 739 }
 740
 741
 742 ssize_t read_no_EINTR
 743    ___P((int fd,
 744          void *buf,
 745          size_t len),
 746         (fd,
 747          buf,
 748          len)
 749 int fd;
 750 void *buf;
 751 size_t len;)
 752 {
 753   char *p = ___CAST(char*,buf);
 754   ssize_t result = 0;
 755   int n;
 756
 757   while (result < len)
 758     {
 759       n = read (fd, p+result, len-result);
 760       if (n > 0)
 761         result += n;
 762       else if (n == 0)
 763         break;
 764       else if (errno != EINTR)
 765         return n; /* this forgets that some bytes were transferred */
 766     }
 767
 768   return result;
 769 }
 770
 771
 772 int close_no_EINTR
 773    ___P((int fd),
 774         (fd)
 775 int fd;)
 776 {
 777   int result;
 778
 779   for (;;)
 780     {
 781       result = close (fd);
 782       if (result >= 0 || errno != EINTR)
 783         break;
 784     }
 785
 786   return result;
 787 }
 788
 789
 790 int dup_no_EINTR
 791    ___P((int fd),
 792         (fd)
 793 int fd;)
 794 {
 795   int result;
 796
 797   for (;;)
 798     {
 799       result = dup (fd);
 800       if (result >= 0 || errno != EINTR)
 801         break;
 802     }
 803
 804   return result;
 805 }
 806
 807
 808 int dup2_no_EINTR
 809    ___P((int fd,
 810          int fd2),
 811         (fd,
 812          fd2)
 813 int fd;
 814 int fd2;)
 815 {
 816   int result;
 817
 818   for (;;)
 819     {
 820       result = dup2 (fd, fd2);
 821       if (result >= 0 || errno != EINTR)
 822         break;
 823     }
 824
 825   return result;
 826 }
 827
 828
 829 int set_fd_blocking_mode
 830    ___P((int fd,
 831          ___BOOL blocking),
 832         (fd,
 833          blocking)
 834 int fd;
 835 ___BOOL blocking;)
 836 {
 837   int fl;
 838
 839   if ((fl = fcntl (fd, F_GETFL, 0)) >= 0)
 840     fl = fcntl (fd,
 841                 F_SETFL,
 842                 blocking ? (fl & ~O_NONBLOCK) : (fl | O_NONBLOCK));
 843
 844   return fl;
 845 }
 846
 847 #endif
 848
 849
 850 /*---------------------------------------------------------------------------*/
 851
 852 /* Generic device operations. */
 853
 854 ___SCMOBJ ___device_select
 855    ___P((___device **devs,
 856          int nb_read_devs,
 857          int nb_write_devs,
 858          ___time timeout),
 859         (devs,
 860          nb_read_devs,
 861          nb_write_devs,
 862          timeout)
 863 ___device **devs;
 864 int nb_read_devs;
 865 int nb_write_devs;
 866 ___time timeout;)
 867 {
 868   int nb_devs;
 869   ___device_select_state state;
 870   int pass;
 871   int dev_list;
 872   int i;
 873   int prev;
 874   ___time delta;
 875
 876   nb_devs = nb_read_devs + nb_write_devs;
 877
 878   state.devs = devs;
 879
 880   state.timeout = timeout;
 881   state.relative_timeout = POS_INFINITY;
 882
 883 #ifdef USE_select
 884
 885   state.highest_fd_plus_1 = 0;
 886
 887   FD_ZERO(&state.readfds);
 888   FD_ZERO(&state.writefds);
 889   FD_ZERO(&state.exceptfds);
 890
 891 #endif
 892
 893 #ifdef USE_MsgWaitForMultipleObjects
 894
 895   state.message_queue_mask = 0;
 896   state.message_queue_dev_pos = -1;
 897
 898   state.wait_objs_buffer[0] = ___io_mod.abort_select;
 899   state.wait_objs_buffer[1] = ___time_mod.heartbeat_thread;
 900
 901   state.nb_wait_objs = 2;
 902
 903 #endif
 904
 905   if (nb_devs > 0)
 906     {
 907       state.devs_next[nb_devs-1] = -1;
 908
 909       for (i=nb_devs-2; i>=0; i--)
 910         state.devs_next[i] = i+1;
 911
 912       dev_list = 0;
 913     }
 914   else
 915     dev_list = -1;
 916
 917   pass = ___SELECT_PASS_1;
 918
 919   while (dev_list != -1)
 920     {
 921       i = dev_list;
 922       prev = -1;
 923
 924       while (i != -1)
 925         {
 926           ___SCMOBJ e;
 927           ___device *d = devs[i];
 928           if ((e = ___device_select_virt
 929                      (d,
 930                       i>=nb_read_devs,
 931                       i,
 932                       pass,
 933                       &state))
 934               == ___FIX(___NO_ERR))
 935             {
 936               prev = i;
 937               i = state.devs_next[i];
 938             }
 939           else
 940             {
 941               int j;
 942               if (e != ___FIX(___SELECT_SETUP_DONE))
 943                 return e;
 944               j = state.devs_next[i];
 945               if (prev == -1)
 946                 dev_list = j;
 947               else
 948                 state.devs_next[prev] = j;
 949 #ifdef USE_MsgWaitForMultipleObjects
 950               state.devs_next[i] = -1;
 951 #endif
 952               i = j;
 953             }
 954         }
 955
 956       pass++;
 957     }
 958
 959   ___absolute_time_to_relative_time (state.timeout, &delta);
 960
 961   if (___time_less (state.relative_timeout, delta))
 962     {
 963       delta = state.relative_timeout;
 964       state.timeout = ___time_mod.time_neg_infinity;
 965     }
 966   else
 967     state.relative_timeout = NEG_INFINITY;
 968
 969 #ifdef USE_select
 970
 971   {
 972     struct timeval delta_tv_struct;
 973     struct timeval *delta_tv = &delta_tv_struct;
 974     int result;
 975
 976     ___absolute_time_to_nonnegative_timeval (delta, &delta_tv);
 977
 978     if (delta_tv != NULL &&
 979         state.highest_fd_plus_1 == 0)
 980       {
 981         /*
 982          * ___device_select is only being called for sleeping until a
 983          * certain timeout or interrupt occurs.  This is a case that
 984          * can be optimized.
 985          */
 986
 987         if (delta_tv->tv_sec < 0 ||
 988             (delta_tv->tv_sec == 0 &&
 989              delta_tv->tv_usec == 0))
 990           {
 991             /*
 992              * The timeout has already passed, so we don't need to
 993              * sleep.  This simple optimization avoids doing a system
 994              * call to the select or nanosleep functions (which can be
 995              * expensive on some operating systems).
 996              */
 997
 998             result = 0;
 999
1000             goto select_done;
1001           }
1002 #ifdef USE_nanosleep
1003         else
1004           {
1005
1006             /*
1007              * For better timeout resolution, the nanosleep function
1008              * is used instead of the select function.  On some
1009              * operating systems (e.g. OpenBSD 4.5) the nanosleep
1010              * function can be more expensive than a call to select,
1011              * but the better timeout resolution outweighs the run
1012              * time cost.
1013              */
1014
1015             struct timespec delta_ts_struct;
1016             delta_ts_struct.tv_sec = delta_tv->tv_sec;
1017             delta_ts_struct.tv_nsec = delta_tv->tv_usec * 1000;
1018             result = nanosleep (&delta_ts_struct, NULL);
1019
1020             goto select_done;
1021           }
1022 #endif
1023       }
1024
1025     /*
1026      * Heartbeat interrupts must be disabled in case they are based on the
1027      * real-time timer.  This is needed to bypass issues in two buggy
1028      * operating systems:
1029      *
1030      * - On MacOS X, the virtual-time timer does not fire at the correct
1031      *   rate (apparently this happens only on machines with more than
1032      *   one core).
1033      *
1034      * - On CYGWIN, the select system call can be interrupted by the
1035      *   timer and in some cases the error "No child processes" will
1036      *   be returned by select.
1037      */
1038
1039     ___disable_heartbeat_interrupts ();
1040
1041     result =
1042       select (state.highest_fd_plus_1,
1043               &state.readfds,
1044               &state.writefds,
1045               &state.exceptfds,
1046               delta_tv);
1047
1048     ___enable_heartbeat_interrupts ();
1049
1050   select_done:
1051
1052     if (result < 0)
1053       return err_code_from_errno ();
1054
1055     state.timeout_reached = (result == 0);
1056   }
1057
1058 #endif
1059
1060 #ifdef USE_MsgWaitForMultipleObjects
1061
1062   {
1063     DWORD delta_msecs;
1064     int first_iteration = TRUE;
1065
1066     ___absolute_time_to_nonnegative_msecs (delta, &delta_msecs);
1067
1068     state.timeout_reached = 0;
1069
1070     while (state.nb_wait_objs > 0 || state.message_queue_mask != 0)
1071       {
1072         DWORD n;
1073
1074         n = MsgWaitForMultipleObjects
1075               (state.nb_wait_objs,
1076                state.wait_objs_buffer,
1077                FALSE,
1078                delta_msecs,
1079                state.message_queue_mask);
1080
1081         if (n == WAIT_FAILED)
1082           return err_code_from_GetLastError ();
1083
1084         if ((n - WAIT_OBJECT_0) <= WAIT_OBJECT_0 + state.nb_wait_objs)
1085           n -= WAIT_OBJECT_0;
1086         else if (n >= WAIT_ABANDONED_0 &&
1087                  n <= WAIT_ABANDONED_0+state.nb_wait_objs-1)
1088           n -= WAIT_ABANDONED_0;
1089         else
1090           {
1091             /* n == WAIT_TIMEOUT */
1092
1093             /*
1094              * The call to MsgWaitForMultipleObjects timed out.  Mark
1095              * the appropriate device "ready".
1096              */
1097
1098             if (first_iteration)
1099               {
1100                 /* first call to MsgWaitForMultipleObjects */
1101
1102                 state.timeout_reached = 1;
1103               }
1104
1105             break;
1106           }
1107
1108         if (n == state.nb_wait_objs)
1109           {
1110             /*
1111              * The message queue contains a message that is of interest.
1112              * Mark the appropriate device "ready".
1113              */
1114
1115             i = state.message_queue_dev_pos;
1116             if (i >= 0)
1117               state.devs_next[i] = 0;
1118
1119             /*
1120              * Don't check if other devices are ready because this might
1121              * cause an infinite loop.
1122              */
1123
1124             break;
1125           }
1126         else if (n == 0)
1127           {
1128             /*
1129              * The call to ___device_select must be aborted because the
1130              * abort_select event is set.  This occurs when an interrupt
1131              * (such as a CTRL-C user interrupt) needs to be serviced
1132              * promptly by the main program.
1133              */
1134
1135             ResetEvent (___io_mod.abort_select); /* ignore error */
1136
1137             return ___FIX(___ERRNO_ERR(EINTR));
1138           }
1139         else if (n == 1)
1140           {
1141             /*
1142              * The heartbeat thread has died.  This is normally due to
1143              * the program being terminated abruptly by the user (for
1144              * example by using the thread manager or the "shutdown"
1145              * item in the start menu).  When this happens we must
1146              * initiate a clean termination of the program.
1147              */
1148
1149             return ___FIX(___UNKNOWN_ERR);
1150           }
1151         else
1152           {
1153             /* Mark the appropriate device "ready". */
1154
1155             i = state.wait_obj_to_dev_pos[n];
1156             if (i >= 0)
1157               state.devs_next[i] = 0;
1158
1159             /* Prepare to check remaining devices. */
1160
1161             state.nb_wait_objs--;
1162
1163             state.wait_objs_buffer[n] =
1164               state.wait_objs_buffer[state.nb_wait_objs];
1165
1166             state.wait_obj_to_dev_pos[n] =
1167               state.wait_obj_to_dev_pos[state.nb_wait_objs];
1168           }
1169
1170         first_iteration = FALSE;
1171         delta_msecs = 0; /* next MsgWaitForMultipleObjects will only poll */
1172       }
1173   }
1174
1175 #endif
1176
1177   for (i=nb_devs-1; i>=0; i--)
1178     {
1179       ___SCMOBJ e;
1180       ___device *d = devs[i];
1181       if (d != NULL)
1182         if ((e = ___device_select_virt
1183                    (d,
1184                     i>=nb_read_devs,
1185                     i,
1186                     ___SELECT_PASS_CHECK,
1187                     &state))
1188             != ___FIX(___NO_ERR))
1189           return e;
1190     }
1191
1192   return ___FIX(___NO_ERR);
1193 }
1194
1195
1196 void ___device_select_add_relative_timeout
1197    ___P((___device_select_state *state,
1198          int i,
1199          ___F64 seconds),
1200         (state,
1201          i,
1202          seconds)
1203 ___device_select_state *state;
1204 int i;
1205 ___F64 seconds;)
1206 {
1207   if (seconds < state->relative_timeout)
1208     state->relative_timeout = seconds;
1209 }
1210
1211
1212 void ___device_select_add_timeout
1213    ___P((___device_select_state *state,
1214          int i,
1215          ___time timeout),
1216         (state,
1217          i,
1218          timeout)
1219 ___device_select_state *state;
1220 int i;
1221 ___time timeout;)
1222 {
1223   if (___time_less (timeout, state->timeout))
1224     state->timeout = timeout;
1225 }
1226
1227
1228 #ifdef USE_select
1229
1230 void ___device_select_add_fd
1231    ___P((___device_select_state *state,
1232          int fd,
1233          ___BOOL for_writing),
1234         (state,
1235          fd,
1236          for_writing)
1237 ___device_select_state *state;
1238 int fd;
1239 ___BOOL for_writing;)
1240 {
1241   if (for_writing)
1242     FD_SET(fd, &state->writefds);
1243   else
1244     FD_SET(fd, &state->readfds);
1245
1246   if (fd >= state->highest_fd_plus_1)
1247     state->highest_fd_plus_1 = fd+1;
1248 }
1249
1250 #endif
1251
1252
1253 #ifdef USE_MsgWaitForMultipleObjects
1254
1255 void ___device_select_add_wait_obj
1256    ___P((___device_select_state *state,
1257          int i,
1258          HANDLE wait_obj),
1259         (state,
1260          i,
1261          wait_obj)
1262 ___device_select_state *state;
1263 int i;
1264 HANDLE wait_obj;)
1265 {
1266   DWORD j = state->nb_wait_objs;
1267
1268   if (j < MAXIMUM_WAIT_OBJECTS)
1269     {
1270       state->wait_objs_buffer[j] = wait_obj;
1271       state->wait_obj_to_dev_pos[j] = i;
1272       state->nb_wait_objs = j+1;
1273     }
1274 }
1275
1276 #endif
1277
1278
1279 ___SCMOBJ ___device_force_output
1280    ___P((___device *self,
1281          int level),
1282         (self,
1283          level)
1284 ___device *self;
1285 int level;)
1286 {
1287   return ___device_force_output_virt (self, level);
1288 }
1289
1290 ___SCMOBJ ___device_close
1291    ___P((___device *self,
1292          int direction),
1293         (self,
1294          direction)
1295 ___device *self;
1296 int direction;)
1297 {
1298   return ___device_close_virt (self, direction);
1299 }
1300
1301 ___HIDDEN void device_transfer_close_responsibility
1302    ___P((___device *self),
1303         (self)
1304 ___device *self;)
1305 {
1306   /*
1307    * Transfer responsibility for closing device to the runtime system.
1308    */
1309
1310   self->close_direction = self->direction;
1311 }
1312
1313 ___HIDDEN void device_add_ref
1314    ___P((___device *self),
1315         (self)
1316 ___device *self;)
1317 {
1318 #ifdef USE_PUMPS
1319   InterlockedIncrement (&self->refcount);
1320 #else
1321   self->refcount++;
1322 #endif
1323 }
1324
1325 ___SCMOBJ ___device_release
1326    ___P((___device *self),
1327         (self)
1328 ___device *self;)
1329 {
1330   ___SCMOBJ e = ___FIX(___NO_ERR);
1331
1332   if (
1333 #ifdef USE_PUMPS
1334       InterlockedDecrement (&self->refcount) == 0
1335 #else
1336       --self->refcount == 0
1337 #endif
1338       )
1339     {
1340       e = ___device_release_virt (self);
1341       ___free_mem (self);
1342     }
1343
1344   return e;
1345 }
1346
1347 ___SCMOBJ ___device_cleanup
1348    ___P((___device *self),
1349         (self)
1350 ___device *self;)
1351 {
1352   ___SCMOBJ e;
1353   ___device *devs[1];
1354
1355   if (self->group == NULL)
1356     return ___FIX(___UNKNOWN_ERR);
1357
1358   ___device_remove_from_group (self);
1359
1360   for (;;)
1361     {
1362       e = ___device_close (self, ___DIRECTION_RD);
1363       if (e == ___FIX(___NO_ERR))
1364         break;
1365       if (e != ___ERR_CODE_EAGAIN)
1366         return e;
1367
1368       devs[0] = self;
1369       e = ___device_select (devs, 1, 0, ___time_mod.time_pos_infinity);
1370       if (e != ___FIX(___NO_ERR))
1371         return e;
1372     }
1373
1374   for (;;)
1375     {
1376       e = ___device_close (self, ___DIRECTION_WR);
1377       if (e == ___FIX(___NO_ERR))
1378         break;
1379       if (e != ___ERR_CODE_EAGAIN)
1380         return e;
1381
1382       devs[0] = self;
1383       e = ___device_select (devs, 0, 1, ___time_mod.time_pos_infinity);
1384       if (e != ___FIX(___NO_ERR))
1385         return e;
1386     }
1387
1388   return ___device_release (self);
1389 }
1390
1391
1392 /*
1393  * Procedure called by the Scheme runtime when a device is no longer
1394  * reachable.
1395  */
1396
1397 ___SCMOBJ ___device_cleanup_from_ptr
1398    ___P((void *ptr),
1399         (ptr)
1400 void *ptr;)
1401 {
1402   return ___device_cleanup (___CAST(___device*,ptr));
1403 }
1404
1405
1406 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
1407
1408 /* Timer device. */
1409
1410 /*
1411  * Timer devices are not particularly useful, given that the scheduler
1412  * implements timeouts.  Use this as an example.
1413  */
1414
1415 ___HIDDEN int device_timer_kind
1416    ___P((___device *self),
1417         (self)
1418 ___device *self;)
1419 {
1420   return ___TIMER_KIND;
1421 }
1422
1423 ___HIDDEN ___SCMOBJ device_timer_select_virt
1424    ___P((___device *self,
1425          ___BOOL for_writing,
1426          int i,
1427          int pass,
1428          ___device_select_state *state),
1429         (self,
1430          for_writing,
1431          i,
1432          pass,
1433          state)
1434 ___device *self;
1435 ___BOOL for_writing;
1436 int i;
1437 int pass;
1438 ___device_select_state *state;)
1439 {
1440   ___device_timer *d = ___CAST(___device_timer*,self);
1441
1442   if (pass == ___SELECT_PASS_1)
1443     {
1444       if (___time_less (d->expiry, state->timeout))
1445         state->timeout = d->expiry;
1446       return ___FIX(___SELECT_SETUP_DONE);
1447     }
1448
1449   /* pass == ___SELECT_PASS_CHECK */
1450
1451   if (state->timeout_reached)
1452     {
1453       if (___time_equal (d->expiry, state->timeout))
1454         state->devs[i] = NULL;
1455     }
1456
1457   return ___FIX(___NO_ERR);
1458 }
1459
1460 ___HIDDEN ___SCMOBJ device_timer_release_virt
1461    ___P((___device *self),
1462         (self)
1463 ___device *self;)
1464 {
1465   return ___FIX(___NO_ERR);
1466 }
1467
1468 ___HIDDEN ___SCMOBJ device_timer_force_output_virt
1469    ___P((___device *self,
1470          int level),
1471         (self,
1472          level)
1473 ___device *self;
1474 int level;)
1475 {
1476   return ___FIX(___NO_ERR);
1477 }
1478
1479 ___HIDDEN ___SCMOBJ device_timer_close_virt
1480    ___P((___device *self,
1481          int direction),
1482         (self,
1483          direction)
1484 ___device *self;
1485 int direction;)
1486 {
1487   return ___FIX(___NO_ERR);
1488 }
1489
1490 ___HIDDEN ___device_timer_vtbl ___device_timer_table =
1491 {
1492   {
1493     device_timer_kind,
1494     device_timer_select_virt,
1495     device_timer_release_virt,
1496     device_timer_force_output_virt,
1497     device_timer_close_virt
1498   }
1499 };
1500
1501 ___SCMOBJ ___device_timer_setup
1502    ___P((___device_timer **dev,
1503          ___device_group *dgroup),
1504         (dev,
1505          dgroup)
1506 ___device_timer **dev;
1507 ___device_group *dgroup;)
1508 {
1509   ___device_timer *d;
1510
1511   d = ___CAST(___device_timer*,
1512               ___alloc_mem (sizeof (___device_timer)));
1513
1514   if (d == NULL)
1515     return ___FIX(___HEAP_OVERFLOW_ERR);
1516
1517   d->base.vtbl = &___device_timer_table;
1518   d->base.refcount = 1;
1519   d->base.direction = ___DIRECTION_RD | ___DIRECTION_WR;
1520   d->base.close_direction = 0; /* prevent closing on errors */
1521   d->base.read_stage = ___STAGE_OPEN;
1522   d->base.write_stage = ___STAGE_OPEN;
1523
1524   d->expiry = ___time_mod.time_pos_infinity;
1525
1526   *dev = d;
1527
1528   ___device_add_to_group (dgroup, &d->base);
1529
1530   return ___FIX(___NO_ERR);
1531 }
1532
1533 void ___device_timer_set_expiry
1534    ___P((___device_timer *dev,
1535          ___time expiry),
1536         (dev,
1537          expiry)
1538 ___device_timer *dev;
1539 ___time expiry;)
1540 {
1541   dev->expiry = expiry;
1542 }
1543
1544 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
1545
1546 /* Byte stream devices. */
1547
1548 #ifdef USE_PUMPS
1549
1550 ___HIDDEN ___SCMOBJ ___device_stream_pump_setup
1551    ___P((___device_stream_pump **pump,
1552          DWORD committed_stack_size,
1553          LPTHREAD_START_ROUTINE proc,
1554          LPVOID arg),
1555         (pump,
1556          committed_stack_size,
1557          proc,
1558          arg)
1559 ___device_stream_pump **pump;
1560 DWORD committed_stack_size;
1561 LPTHREAD_START_ROUTINE proc;
1562 LPVOID arg;)
1563 {
1564   ___SCMOBJ e;
1565   ___device_stream_pump *p;
1566   HANDLE thread_handle;
1567   DWORD thread_id;
1568
1569   p = ___CAST(___device_stream_pump*,
1570               ___alloc_mem (sizeof (___device_stream_pump)));
1571
1572   if (p == NULL)
1573     return ___FIX(___HEAP_OVERFLOW_ERR);
1574
1575   e = ___nonblocking_pipe_setup (&p->pipe, PIPE_BUFFER_SIZE+1);
1576
1577   if (e != ___FIX(___NO_ERR))
1578     {
1579       ___free_mem (p);
1580       return e;
1581     }
1582
1583   *pump = p; /* set before thread created to avoid race condition */
1584
1585   thread_handle =
1586     CreateThread (NULL,                 /* no security attributes       */
1587                   committed_stack_size, /* committed stack size         */
1588                   proc,                 /* thread procedure             */
1589                   arg,                  /* argument to thread procedure */
1590                   0,                    /* use default creation flags   */
1591                   &thread_id);
1592
1593   if (thread_handle == NULL ||
1594       !SetThreadPriority (thread_handle, PUMP_PRIORITY))
1595     {
1596       e = err_code_from_GetLastError ();
1597       ___nonblocking_pipe_cleanup (&p->pipe);
1598       ___free_mem (p);
1599       *pump = NULL; /* make sure caller does not think a pump was created */
1600       return e;
1601     }
1602
1603   p->thread = thread_handle;
1604
1605   return ___FIX(___NO_ERR);
1606 }
1607
1608 ___HIDDEN ___SCMOBJ ___device_stream_pump_reader_kill
1609    ___P((___device_stream_pump *pump),
1610         (pump)
1611 ___device_stream_pump *pump;)
1612 {
1613   return ___nonblocking_pipe_set_reader_err
1614            (&pump->pipe,
1615             ___FIX(___KILL_PUMP));
1616 }
1617
1618 ___HIDDEN ___SCMOBJ ___device_stream_pump_writer_kill
1619    ___P((___device_stream_pump *pump),
1620         (pump)
1621 ___device_stream_pump *pump;)
1622 {
1623   return ___nonblocking_pipe_set_writer_err
1624            (&pump->pipe,
1625             ___FIX(___KILL_PUMP));
1626 }
1627
1628 ___HIDDEN ___SCMOBJ ___device_stream_pump_wait
1629    ___P((___device_stream_pump *pump),
1630         (pump)
1631 ___device_stream_pump *pump;)
1632 {
1633   DWORD code;
1634
1635   code = WaitForSingleObject (pump->thread, 0);
1636
1637   if (code == WAIT_FAILED)
1638     return err_code_from_GetLastError ();
1639
1640   if (code == WAIT_TIMEOUT)
1641     return ___ERR_CODE_EAGAIN;
1642
1643   return ___FIX(___NO_ERR);
1644 }
1645
1646 ___HIDDEN ___SCMOBJ ___device_stream_pump_cleanup
1647    ___P((___device_stream_pump *pump),
1648         (pump)
1649 ___device_stream_pump *pump;)
1650 {
1651   CloseHandle (pump->thread); /* ignore error */
1652   ___nonblocking_pipe_cleanup (&pump->pipe); /* ignore error */
1653   ___free_mem (pump);
1654
1655   return ___FIX(___NO_ERR);
1656 }
1657
1658 #endif
1659
1660 ___SCMOBJ ___device_stream_select_virt
1661    ___P((___device *self,
1662          ___BOOL for_writing,
1663          int i,
1664          int pass,
1665          ___device_select_state *state),
1666         (self,
1667          for_writing,
1668          i,
1669          pass,
1670          state)
1671 ___device *self;
1672 ___BOOL for_writing;
1673 int i;
1674 int pass;
1675 ___device_select_state *state;)
1676 {
1677   ___device_stream *d = ___CAST(___device_stream*,self);
1678
1679 #ifdef USE_PUMPS
1680
1681   int stage = (for_writing
1682                ? d->base.write_stage
1683                : d->base.read_stage);
1684   ___device_stream_pump *p = (for_writing
1685                               ? d->write_pump
1686                               : d->read_pump);
1687
1688   if (p != NULL)
1689     {
1690       if (pass == ___SELECT_PASS_1)
1691         {
1692           HANDLE wait_obj;
1693
1694           if (stage != ___STAGE_OPEN)
1695             wait_obj = p->thread;
1696           else
1697             {
1698               if (for_writing)
1699                 wait_obj = p->pipe.wevent;
1700               else
1701                 wait_obj = p->pipe.revent;
1702             }
1703
1704           ___device_select_add_wait_obj (state, i, wait_obj);
1705
1706           return ___FIX(___SELECT_SETUP_DONE);
1707         }
1708
1709       /* pass == ___SELECT_PASS_CHECK */
1710
1711       if (stage != ___STAGE_OPEN)
1712         state->devs[i] = NULL;
1713       else
1714         {
1715           if (state->devs_next[i] != -1)
1716             state->devs[i] = NULL;
1717         }
1718
1719       return ___FIX(___NO_ERR);
1720     }
1721
1722 #endif
1723
1724   return ___device_stream_select_raw_virt
1725            (d,
1726             for_writing,
1727             i,
1728             pass,
1729             state);
1730 }
1731
1732
1733 ___SCMOBJ ___device_stream_release_virt
1734    ___P((___device *self),
1735         (self)
1736 ___device *self;)
1737 {
1738   ___SCMOBJ e;
1739   ___device_stream *d = ___CAST(___device_stream*,self);
1740
1741   e = ___device_stream_release_raw_virt (d);
1742
1743 #ifdef USE_PUMPS
1744
1745   {
1746     ___device_stream_pump *p;
1747
1748     p = d->read_pump;
1749     if (p != NULL)
1750       ___device_stream_pump_cleanup (p); /* ignore error */
1751
1752     p = d->write_pump;
1753     if (p != NULL)
1754       ___device_stream_pump_cleanup (p); /* ignore error */
1755   }
1756
1757 #endif
1758
1759   return e;
1760 }
1761
1762
1763 ___SCMOBJ ___device_stream_force_output_virt
1764    ___P((___device *self,
1765          int level),
1766         (self,
1767          level)
1768 ___device *self;
1769 int level;)
1770 {
1771   ___device_stream *d = ___CAST(___device_stream*,self);
1772
1773 #ifdef USE_PUMPS
1774
1775   {
1776     ___device_stream_pump *p = d->write_pump;
1777
1778     if (p != NULL)
1779       {
1780         ___nonblocking_pipe_oob_msg oob_msg;
1781
1782         oob_msg.op = OOB_FORCE_OUTPUT0 + level;
1783
1784         return ___nonblocking_pipe_write_oob (&p->pipe, &oob_msg);
1785       }
1786   }
1787
1788 #endif
1789
1790   return ___device_stream_force_output_raw_virt (d, level);
1791 }
1792
1793
1794 ___SCMOBJ ___device_stream_close_virt
1795    ___P((___device *self,
1796          int direction),
1797         (self,
1798          direction)
1799 ___device *self;
1800 int direction;)
1801 {
1802   ___device_stream *d = ___CAST(___device_stream*,self);
1803
1804 #ifdef USE_PUMPS
1805
1806   if (direction & ___DIRECTION_RD)
1807     {
1808       ___device_stream_pump *p = d->read_pump;
1809
1810       if (p != NULL)
1811         ___device_stream_pump_reader_kill (p);
1812     }
1813
1814   if (direction & ___DIRECTION_WR)
1815     {
1816       ___device_stream_pump *p = d->write_pump;
1817
1818       if (p != NULL)
1819         ___device_stream_pump_writer_kill (p);
1820     }
1821
1822 #endif
1823
1824   return ___device_stream_close_raw_virt (d, direction);
1825 }
1826
1827
1828 ___SCMOBJ ___device_stream_seek
1829    ___P((___device_stream *self,
1830          ___stream_index *pos,
1831          int whence),
1832         (self,
1833          pos,
1834          whence)
1835 ___device_stream *self;
1836 ___stream_index *pos;
1837 int whence;)
1838 {
1839 #ifdef USE_PUMPS
1840
1841   {
1842     ___device_stream_pump *p = self->write_pump;
1843
1844     if (p != NULL)
1845       {
1846         ___nonblocking_pipe_oob_msg oob_msg;
1847
1848         oob_msg.op = OOB_SEEK_ABS + whence;
1849         oob_msg.stream_index_param = *pos;
1850
1851         return ___nonblocking_pipe_write_oob (&p->pipe, &oob_msg);
1852       }
1853   }
1854
1855 #endif
1856
1857   return ___device_stream_seek_raw_virt (self, pos, whence);
1858 }
1859
1860 ___SCMOBJ ___device_stream_read
1861    ___P((___device_stream *self,
1862          ___U8 *buf,
1863          ___stream_index len,
1864          ___stream_index *len_done),
1865         (self,
1866          buf,
1867          len,
1868          len_done)
1869 ___device_stream *self;
1870 ___U8 *buf;
1871 ___stream_index len;
1872 ___stream_index *len_done;)
1873 {
1874 #ifdef USE_PUMPS
1875
1876   {
1877     ___device_stream_pump *p = self->read_pump;
1878
1879     if (p != NULL)
1880       {
1881         ___nonblocking_pipe_oob_msg oob_msg;
1882         return ___nonblocking_pipe_read
1883                  (&p->pipe,
1884                   buf,
1885                   len,
1886                   len_done,
1887                   &oob_msg);
1888       }
1889   }
1890
1891 #endif
1892
1893   return ___device_stream_read_raw_virt (self, buf, len, len_done);
1894 }
1895
1896 ___SCMOBJ ___device_stream_write
1897    ___P((___device_stream *self,
1898          ___U8 *buf,
1899          ___stream_index len,
1900          ___stream_index *len_done),
1901         (self,
1902          buf,
1903          len,
1904          len_done)
1905 ___device_stream *self;
1906 ___U8 *buf;
1907 ___stream_index len;
1908 ___stream_index *len_done;)
1909 {
1910 #ifdef USE_PUMPS
1911
1912   {
1913     ___device_stream_pump *p = self->write_pump;
1914
1915     if (p != NULL)
1916       return ___nonblocking_pipe_write (&p->pipe, buf, len, len_done);
1917   }
1918
1919 #endif
1920
1921   return ___device_stream_write_raw_virt (self, buf, len, len_done);
1922 }
1923
1924 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1925
1926 #ifdef USE_PUMPS
1927
1928 ___HIDDEN DWORD WINAPI ___device_stream_read_pump_proc
1929    ___P((LPVOID param),
1930         (param)
1931 LPVOID param;)
1932 {
1933   ___device_stream *dev = ___CAST(___device_stream*,param);
1934   ___nonblocking_pipe *p = &dev->read_pump->pipe;
1935   ___SCMOBJ e;
1936   ___stream_index len;
1937   ___stream_index n;
1938   ___stream_index i;
1939   ___U8 buf[PIPE_BUFFER_SIZE];
1940   ___nonblocking_pipe_oob_msg oob_msg;
1941
1942   for (;;)
1943     {
1944       /* wait until the reader needs some data */
1945
1946       e = ___nonblocking_pipe_write_ready_wait (p);
1947
1948       /* read some characters from device */
1949
1950       if (e == ___FIX(___NO_ERR))
1951         e = ___device_stream_read_raw_virt (dev, buf, PIPE_BUFFER_SIZE, &len);
1952
1953       if (e == ___FIX(___NO_ERR))
1954         {
1955           if (len == 0)
1956             {
1957               /* we reached the end-of-stream */
1958
1959               oob_msg.op = OOB_EOS;
1960
1961               while ((e = ___nonblocking_pipe_write_oob (p, &oob_msg))
1962                      == ___ERR_CODE_EAGAIN)
1963                 {
1964                   /* suspend thread until operation can be performed */
1965
1966                   e = ___nonblocking_pipe_write_ready_wait (p);
1967                   if (e != ___FIX(___NO_ERR))
1968                     break;
1969                 }
1970               if (e != ___FIX(___NO_ERR))
1971                 break;
1972             }
1973           else
1974             {
1975               /* write to the pipe the bytes that were read */
1976
1977               i = 0;
1978
1979               while (i < len)
1980                 {
1981                   while ((e = ___nonblocking_pipe_write (p, buf+i, len-i, &n))
1982                          == ___ERR_CODE_EAGAIN)
1983                     {
1984                       /* suspend thread until operation can be performed */
1985
1986                       e = ___nonblocking_pipe_write_ready_wait (p);
1987                       if (e != ___FIX(___NO_ERR))
1988                         break;
1989                     }
1990                   if (e != ___FIX(___NO_ERR))
1991                     break;
1992                   i += n;
1993                 }
1994             }
1995         }
1996
1997       if (e != ___FIX(___NO_ERR))
1998         {
1999           if (e == ___FIX(___KILL_PUMP)) /* terminate? */
2000             break;
2001
2002           if (e == ___ERR_CODE_EAGAIN)
2003             continue;
2004
2005           /* report the failure back through the pipe */
2006
2007           e = ___nonblocking_pipe_set_writer_err (p, e);
2008
2009           if (e != ___FIX(___NO_ERR))
2010             {
2011               /*
2012                * The failure could not be reported. To avoid an
2013                * infinite loop the thread is terminated.
2014                */
2015
2016               ExitThread (0);
2017             }
2018         }
2019     }
2020
2021   ___device_release (&dev->base); /* ignore error */
2022
2023   return 0;
2024 }
2025
2026 ___HIDDEN DWORD WINAPI ___device_stream_write_pump_proc
2027    ___P((LPVOID param),
2028         (param)
2029 LPVOID param;)
2030 {
2031   ___device_stream *dev = ___CAST(___device_stream*,param);
2032   ___nonblocking_pipe *p = &dev->write_pump->pipe;
2033   ___SCMOBJ e;
2034   ___stream_index len;
2035   ___stream_index n;
2036   ___stream_index i;
2037   ___U8 buf[PIPE_BUFFER_SIZE];
2038   ___nonblocking_pipe_oob_msg oob_msg;
2039
2040   for (;;)
2041     {
2042       /* get from the pipe some bytes to write to the device */
2043
2044       while ((e = ___nonblocking_pipe_read
2045                     (p,
2046                      buf,
2047                      PIPE_BUFFER_SIZE,
2048                      &len,
2049                      &oob_msg))
2050              == ___ERR_CODE_EAGAIN)
2051         {
2052           /* suspend thread until operation can be performed */
2053
2054           e = ___nonblocking_pipe_read_ready_wait (p);
2055           if (e != ___FIX(___NO_ERR))
2056             break;
2057         }
2058
2059       if (e == ___FIX(___NO_ERR))
2060         {
2061           if (len > 0)
2062             {
2063               /* write to the device the bytes that were read from the pipe */
2064
2065               i = 0;
2066
2067               while (i < len)
2068                 {
2069                   e = ___device_stream_write_raw_virt (dev, buf+i, len-i, &n);
2070                   if (e != ___FIX(___NO_ERR))
2071                     break;
2072                   i += n;
2073                 }
2074             }
2075           else
2076             {
2077               switch (oob_msg.op)
2078                 {
2079                 case OOB_FORCE_OUTPUT0:
2080                 case OOB_FORCE_OUTPUT1:
2081                 case OOB_FORCE_OUTPUT2:
2082                 case OOB_FORCE_OUTPUT3:
2083 #ifdef ___DEBUG
2084                   ___printf ("***** got OOB_FORCE_OUTPUT%d\n",
2085                              oob_msg.op - OOB_FORCE_OUTPUT0);
2086 #endif
2087                   e = ___device_stream_force_output_raw_virt (dev, oob_msg.op - OOB_FORCE_OUTPUT0);
2088                   break;
2089                 case OOB_SEEK_ABS:
2090                 case OOB_SEEK_REL:
2091                 case OOB_SEEK_REL_END:
2092 #ifdef ___DEBUG
2093                   ___printf ("***** got OOB_SEEK %d %d\n",
2094                              oob_msg.stream_index_param,
2095                              oob_msg.op - OOB_SEEK_ABS);
2096 #endif
2097                   e = ___device_stream_seek_raw_virt
2098                         (dev,
2099                          &oob_msg.stream_index_param,
2100                          oob_msg.op - OOB_SEEK_ABS);
2101                   break;
2102                 case OOB_EOS:
2103 #ifdef ___DEBUG
2104                   ___printf ("***** got OOB_EOS\n");
2105 #endif
2106                   break;
2107                 }
2108             }
2109         }
2110
2111       if (e != ___FIX(___NO_ERR))
2112         {
2113           if (e == ___FIX(___KILL_PUMP)) /* terminate? */
2114             break;
2115
2116           /* report the failure back through the pipe */
2117
2118           e = ___nonblocking_pipe_set_reader_err (p, e);
2119
2120           if (e != ___FIX(___NO_ERR))
2121             {
2122               /*
2123                * The failure could not be reported. To avoid an
2124                * infinite loop the thread is terminated.
2125                */
2126
2127               ExitThread (0);
2128             }
2129         }
2130     }
2131
2132   ___device_release (&dev->base); /* ignore error */
2133
2134   return 0;
2135 }
2136
2137 #endif
2138
2139 ___SCMOBJ ___device_stream_setup
2140    ___P((___device_stream *dev,
2141          ___device_group *dgroup,
2142          int direction,
2143          int pumps_on),
2144         (dev,
2145          dgroup,
2146          direction,
2147          pumps_on)/*********************/
2148 ___device_stream *dev;
2149 ___device_group *dgroup;
2150 int direction;
2151 int pumps_on;)
2152 {
2153   dev->base.refcount = 1;
2154   dev->base.direction = direction;
2155   dev->base.close_direction = 0; /* prevent closing on errors */
2156   dev->base.read_stage = ___STAGE_CLOSED;
2157   dev->base.write_stage = ___STAGE_CLOSED;
2158
2159 #ifdef USE_PUMPS
2160   dev->read_pump = NULL;
2161   dev->write_pump = NULL;
2162 #endif
2163
2164   ___device_add_to_group (dgroup, &dev->base);
2165
2166   if (direction & ___DIRECTION_RD)
2167     {
2168       dev->base.read_stage = ___STAGE_OPEN;
2169
2170 #ifdef USE_PUMPS
2171
2172       if (pumps_on & ___DIRECTION_RD)
2173         {
2174           ___SCMOBJ e;
2175
2176           device_add_ref (&dev->base);
2177
2178           if ((e = ___device_stream_pump_setup
2179                      (&dev->read_pump,
2180                       65536,
2181                       ___device_stream_read_pump_proc,
2182                       dev))
2183               != ___FIX(___NO_ERR))
2184             {
2185               ___device_release (&dev->base); /* ignore error */
2186               ___device_cleanup (&dev->base); /* ignore error */
2187               return e;
2188             }
2189         }
2190
2191 #endif
2192     }
2193
2194   if (direction & ___DIRECTION_WR)
2195     {
2196       dev->base.write_stage = ___STAGE_OPEN;
2197
2198 #ifdef USE_PUMPS
2199
2200       if (pumps_on & ___DIRECTION_WR)
2201         {
2202           ___SCMOBJ e;
2203
2204           device_add_ref (&dev->base);
2205
2206           if ((e = ___device_stream_pump_setup
2207                      (&dev->write_pump,
2208                       65536,
2209                       ___device_stream_write_pump_proc,
2210                       dev))
2211               != ___FIX(___NO_ERR))
2212             {
2213               ___device_release (&dev->base); /* ignore error */
2214               ___device_cleanup (&dev->base); /* ignore error */
2215               return e;
2216             }
2217         }
2218
2219 #endif
2220     }
2221
2222   return ___FIX(___NO_ERR);
2223 }
2224
2225
2226 /*---------------------------------------------------------------------------*/
2227
2228 /* Serial stream device */
2229
2230 #ifdef USE_WIN32
2231
2232 typedef struct ___device_serial_struct
2233   {
2234     ___device_stream base;
2235     HANDLE h;
2236   } ___device_serial;
2237
2238 typedef struct ___device_serial_vtbl_struct
2239   {
2240     ___device_stream_vtbl base;
2241   } ___device_serial_vtbl;
2242
2243 ___HIDDEN int ___device_serial_kind
2244    ___P((___device *self),
2245         (self)
2246 ___device *self;)
2247 {
2248   return ___SERIAL_DEVICE_KIND;
2249 }
2250
2251 ___HIDDEN ___SCMOBJ ___device_serial_close_raw_virt
2252    ___P((___device_stream *self,
2253          int direction),
2254         (self,
2255          direction)
2256 ___device_stream *self;
2257 int direction;)
2258 {
2259   ___device_serial *d = ___CAST(___device_serial*,self);
2260   int is_not_closed = 0;
2261
2262   if (d->base.base.read_stage != ___STAGE_CLOSED)
2263     is_not_closed |= ___DIRECTION_RD;
2264
2265   if (d->base.base.write_stage != ___STAGE_CLOSED)
2266     is_not_closed |= ___DIRECTION_WR;
2267
2268   if (is_not_closed == 0)
2269     return ___FIX(___NO_ERR);
2270
2271   if (is_not_closed == (___DIRECTION_RD|___DIRECTION_WR))
2272     {
2273       d->base.base.read_stage = ___STAGE_CLOSED;
2274       d->base.base.write_stage = ___STAGE_CLOSED;
2275
2276       if ((d->base.base.close_direction & (___DIRECTION_RD|___DIRECTION_WR))
2277           == (___DIRECTION_RD|___DIRECTION_WR))
2278         {
2279           if (!CloseHandle (d->h))
2280             return err_code_from_GetLastError ();
2281         }
2282     }
2283
2284   return ___FIX(___NO_ERR);
2285 }
2286
2287 ___HIDDEN ___SCMOBJ ___device_serial_select_raw_virt
2288    ___P((___device_stream *self,
2289          ___BOOL for_writing,
2290          int i,
2291          int pass,
2292          ___device_select_state *state),
2293         (self,
2294          for_writing,
2295          i,
2296          pass,
2297          state)
2298 ___device_stream *self;
2299 ___BOOL for_writing;
2300 int i;
2301 int pass;
2302 ___device_select_state *state;)
2303 {
2304   ___device_serial *d = ___CAST(___device_serial*,self);
2305   int stage = (for_writing
2306                ? d->base.base.write_stage
2307                : d->base.base.read_stage);
2308
2309   if (pass == ___SELECT_PASS_1)
2310     {
2311       if (stage != ___STAGE_OPEN)
2312         state->timeout = ___time_mod.time_neg_infinity;
2313       return ___FIX(___SELECT_SETUP_DONE);
2314     }
2315
2316   /* pass == ___SELECT_PASS_CHECK */
2317
2318   if (stage != ___STAGE_OPEN)
2319     state->devs[i] = NULL;
2320   else
2321     {
2322       if (state->devs_next[i] != -1)
2323         state->devs[i] = NULL;
2324     }
2325
2326   return ___FIX(___NO_ERR);
2327 }
2328
2329 ___HIDDEN ___SCMOBJ ___device_serial_release_raw_virt
2330    ___P((___device_stream *self),
2331         (self)
2332 ___device_stream *self;)
2333 {
2334   return ___FIX(___NO_ERR);
2335 }
2336
2337 ___HIDDEN ___SCMOBJ ___device_serial_force_output_raw_virt
2338    ___P((___device_stream *self,
2339          int level),
2340         (self,
2341          level)
2342 ___device_stream *self;
2343 int level;)
2344 {
2345   ___device_serial *d = ___CAST(___device_serial*,self);
2346
2347   if (d->base.base.write_stage == ___STAGE_OPEN)
2348     {
2349       if (level > 0)
2350         {
2351           if (!FlushFileBuffers (d->h))
2352             return err_code_from_GetLastError ();
2353         }
2354     }
2355
2356   return ___FIX(___NO_ERR);
2357 }
2358
2359 ___HIDDEN ___SCMOBJ ___device_serial_seek_raw_virt
2360    ___P((___device_stream *self,
2361          ___stream_index *pos,
2362          int whence),
2363         (self,
2364          pos,
2365          whence)
2366 ___device_stream *self;
2367 ___stream_index *pos;
2368 int whence;)
2369 {
2370   return ___FIX(___INVALID_OP_ERR);
2371 }
2372
2373 ___HIDDEN ___SCMOBJ ___device_serial_read_raw_virt
2374    ___P((___device_stream *self,
2375          ___U8 *buf,
2376          ___stream_index len,
2377          ___stream_index *len_done),
2378         (self,
2379          buf,
2380          len,
2381          len_done)
2382 ___device_stream *self;
2383 ___U8 *buf;
2384 ___stream_index len;
2385 ___stream_index *len_done;)
2386 {
2387   ___device_serial *d = ___CAST(___device_serial*,self);
2388
2389   if (d->base.base.read_stage != ___STAGE_OPEN)
2390     return ___FIX(___CLOSED_DEVICE_ERR);
2391
2392   {
2393     DWORD n;
2394
2395     if (!ReadFile (d->h, buf, len, &n, NULL))
2396       return err_code_from_GetLastError ();
2397
2398     if (n == 0)
2399       return ___ERR_CODE_EAGAIN;
2400
2401     *len_done = n;
2402   }
2403
2404   return ___FIX(___NO_ERR);
2405 }
2406
2407 ___HIDDEN ___SCMOBJ ___device_serial_write_raw_virt
2408    ___P((___device_stream *self,
2409          ___U8 *buf,
2410          ___stream_index len,
2411          ___stream_index *len_done),
2412         (self,
2413          buf,
2414          len,
2415          len_done)
2416 ___device_stream *self;
2417 ___U8 *buf;
2418 ___stream_index len;
2419 ___stream_index *len_done;)
2420 {
2421   ___device_serial *d = ___CAST(___device_serial*,self);
2422
2423   if (d->base.base.write_stage != ___STAGE_OPEN)
2424     return ___FIX(___CLOSED_DEVICE_ERR);
2425
2426   {
2427     DWORD n;
2428
2429     if (!WriteFile (d->h, buf, len, &n, NULL))
2430       {
2431         /*
2432          * Even though WriteFile has reported a failure, the operation
2433          * was executed correctly (i.e. len_done contains the number
2434          * of bytes written) if GetLastError returns ERROR_SUCCESS.
2435          */
2436
2437         if (GetLastError () != ERROR_SUCCESS)
2438           return err_code_from_GetLastError ();
2439       }
2440
2441     *len_done = n;
2442   }
2443
2444   return ___FIX(___NO_ERR);
2445 }
2446
2447 ___HIDDEN ___SCMOBJ ___device_serial_width_virt
2448    ___P((___device_stream *self),
2449         (self)
2450 ___device_stream *self;)
2451 {
2452   return ___FIX(80);
2453 }
2454
2455 ___HIDDEN ___SCMOBJ ___device_serial_default_options_virt
2456    ___P((___device_stream *self),
2457         (self)
2458 ___device_stream *self;)
2459 {
2460   int char_encoding_errors = ___CHAR_ENCODING_ERRORS_ON;
2461   int char_encoding = ___CHAR_ENCODING_ISO_8859_1;
2462   int eol_encoding = ___EOL_ENCODING_LF;
2463   int buffering = ___FULL_BUFFERING;
2464
2465   return ___FIX(___STREAM_OPTIONS(char_encoding_errors,
2466                                   char_encoding,
2467                                   eol_encoding,
2468                                   buffering,
2469                                   char_encoding_errors,
2470                                   char_encoding,
2471                                   eol_encoding,
2472                                   buffering));
2473 }
2474
2475
2476 ___HIDDEN ___SCMOBJ ___device_serial_options_set_virt
2477    ___P((___device_stream *self,
2478          ___SCMOBJ options),
2479         (self,
2480          options)
2481 ___device_stream *self;
2482 ___SCMOBJ options;)
2483 {
2484   return ___FIX(___NO_ERR);
2485 }
2486
2487
2488 ___HIDDEN ___device_serial_vtbl ___device_serial_table =
2489 {
2490   {
2491     {
2492       ___device_serial_kind,
2493       ___device_stream_select_virt,
2494       ___device_stream_release_virt,
2495       ___device_stream_force_output_virt,
2496       ___device_stream_close_virt
2497     },
2498     ___device_serial_select_raw_virt,
2499     ___device_serial_release_raw_virt,
2500     ___device_serial_force_output_raw_virt,
2501     ___device_serial_close_raw_virt,
2502     ___device_serial_seek_raw_virt,
2503     ___device_serial_read_raw_virt,
2504     ___device_serial_write_raw_virt,
2505     ___device_serial_width_virt,
2506     ___device_serial_default_options_virt,
2507     ___device_serial_options_set_virt
2508   }
2509 };
2510
2511
2512 ___HIDDEN ___SCMOBJ ___device_serial_set_comm_state
2513    ___P((___device_serial *dev,
2514          LPCTSTR def),
2515         (dev,
2516          def)
2517 ___device_serial *dev;
2518 LPCTSTR def;)
2519 {
2520   DCB dcb;
2521
2522   FillMemory (&dcb, sizeof (dcb), 0);
2523
2524   if (!GetCommState (dev->h, &dcb) ||
2525       !BuildCommDCB (def, &dcb) ||
2526       !SetCommState (dev->h, &dcb))
2527     return err_code_from_GetLastError ();
2528
2529   return ___FIX(___NO_ERR);
2530 }
2531
2532 ___SCMOBJ ___device_serial_setup_from_handle
2533    ___P((___device_serial **dev,
2534          ___device_group *dgroup,
2535          HANDLE h,
2536          int direction),
2537         (dev,
2538          dgroup,
2539          h,
2540          direction)
2541 ___device_serial **dev;
2542 ___device_group *dgroup;
2543 HANDLE h;
2544 int direction;)
2545 {
2546   ___device_serial *d;
2547   ___SCMOBJ e;
2548   COMMTIMEOUTS cto;
2549
2550   d = ___CAST(___device_serial*,
2551               ___alloc_mem (sizeof (___device_serial)));
2552
2553   if (d == NULL)
2554     return ___FIX(___HEAP_OVERFLOW_ERR);
2555
2556   d->base.base.vtbl = &___device_serial_table;
2557   d->h = h;
2558
2559   *dev = d;
2560
2561   e = ___device_serial_set_comm_state (d, _T("baud=38400 parity=N data=8 stop=1"));
2562
2563   if (e != ___FIX(___NO_ERR))
2564     {
2565       ___free_mem (d);
2566       return e;
2567     }
2568
2569   /*
2570    * Setup serial device so that ReadFile will return as soon as a
2571    * character is available.
2572    */
2573
2574   cto.ReadIntervalTimeout         = MAXDWORD;
2575   cto.ReadTotalTimeoutMultiplier  = MAXDWORD;
2576   cto.ReadTotalTimeoutConstant    = 1; /* wait no more than 1 ms */
2577   cto.WriteTotalTimeoutMultiplier = 0;
2578   cto.WriteTotalTimeoutConstant   = 0;
2579
2580   if (!SetCommTimeouts (h, &cto)
2581 #ifdef USE_BIG_SERIAL_BUFFERS
2582       || !SetupComm (h, 65536, 65536))
2583 #endif
2584      )
2585     {
2586       e = err_code_from_GetLastError ();
2587       ___free_mem (d);
2588       return e;
2589     }
2590
2591   return ___device_stream_setup
2592            (&d->base,
2593             dgroup,
2594             direction,
2595             ___DIRECTION_RD|___DIRECTION_WR);
2596 }
2597
2598 #endif
2599
2600
2601 /*---------------------------------------------------------------------------*/
2602
2603 /* Pipe stream device */
2604
2605 /*
2606  * Pipes may be unidirectional or bidirectional.  Bidirectional pipes
2607  * are implemented with 2 OS pipes: a "write" pipe and a "read" pipe.
2608  */
2609
2610 typedef struct ___device_pipe_struct
2611   {
2612     ___device_stream base;
2613
2614 #ifdef USE_POSIX
2615     int fd_wr;  /* file descriptor for "write" pipe (-1 if none) */
2616     int fd_rd;  /* file descriptor for "read" pipe (-1 if none) */
2617 #endif
2618
2619 #ifdef USE_WIN32
2620     HANDLE h_wr;  /* handle for "write" pipe (NULL if none) */
2621     HANDLE h_rd;  /* handle for "read" pipe (NULL if none) */
2622     int poll_interval_nsecs;  /* interval between read attempts */
2623 #endif
2624   } ___device_pipe;
2625
2626
2627 typedef struct ___device_pipe_vtbl_struct
2628   {
2629     ___device_stream_vtbl base;
2630   } ___device_pipe_vtbl;
2631
2632 ___HIDDEN int ___device_pipe_kind
2633    ___P((___device *self),
2634         (self)
2635 ___device *self;)
2636 {
2637   return ___PIPE_DEVICE_KIND;
2638 }
2639
2640 ___SCMOBJ ___device_pipe_cleanup
2641    ___P((___device_pipe *dev),
2642         (dev)
2643 ___device_pipe *dev;)
2644 {
2645   return ___FIX(___NO_ERR);
2646 }
2647
2648
2649 ___HIDDEN ___SCMOBJ ___device_pipe_close_raw_virt
2650    ___P((___device_stream *self,
2651          int direction),
2652         (self,
2653          direction)
2654 ___device_stream *self;
2655 int direction;)
2656 {
2657   ___device_pipe *d = ___CAST(___device_pipe*,self);
2658   int is_not_closed = 0;
2659
2660   if (d->base.base.read_stage != ___STAGE_CLOSED)
2661     is_not_closed |= ___DIRECTION_RD;
2662
2663   if (d->base.base.write_stage != ___STAGE_CLOSED)
2664     is_not_closed |= ___DIRECTION_WR;
2665
2666   if (is_not_closed == 0)
2667     return ___FIX(___NO_ERR);
2668
2669   if (is_not_closed & direction & ___DIRECTION_RD)
2670     {
2671       /* Close "read" pipe */
2672
2673       d->base.base.read_stage = ___STAGE_CLOSED;
2674
2675       if ((d->base.base.close_direction & ___DIRECTION_RD)
2676           == ___DIRECTION_RD)
2677         {
2678 #ifdef USE_POSIX
2679           if (d->fd_rd >= 0 &&
2680               d->fd_rd != d->fd_wr &&
2681               close_no_EINTR (d->fd_rd) < 0)
2682             return err_code_from_errno ();
2683 #endif
2684
2685 #ifdef USE_WIN32
2686           if (d->h_rd != NULL &&
2687               d->h_rd != d->h_wr)
2688             CloseHandle (d->h_rd); /* ignore error */
2689 #endif
2690         }
2691     }
2692
2693   if (is_not_closed & direction & ___DIRECTION_WR)
2694     {
2695       /* Close "write" pipe */
2696
2697       d->base.base.write_stage = ___STAGE_CLOSED;
2698
2699       if ((d->base.base.close_direction & ___DIRECTION_WR)
2700           == ___DIRECTION_WR)
2701         {
2702 #ifdef USE_POSIX
2703           if (d->fd_wr >= 0 &&
2704               close_no_EINTR (d->fd_wr) < 0)
2705             return err_code_from_errno ();
2706 #endif
2707
2708 #ifdef USE_WIN32
2709           if (d->h_wr != NULL)
2710             CloseHandle (d->h_wr); /* ignore error */
2711 #endif
2712         }
2713     }
2714
2715   return ___FIX(___NO_ERR);
2716 }
2717
2718 ___HIDDEN ___SCMOBJ ___device_pipe_select_raw_virt
2719    ___P((___device_stream *self,
2720          ___BOOL for_writing,
2721          int i,
2722          int pass,
2723          ___device_select_state *state),
2724         (self,
2725          for_writing,
2726          i,
2727          pass,
2728          state)
2729 ___device_stream *self;
2730 ___BOOL for_writing;
2731 int i;
2732 int pass;
2733 ___device_select_state *state;)
2734 {
2735   ___device_pipe *d = ___CAST(___device_pipe*,self);
2736   int stage = (for_writing
2737                ? d->base.base.write_stage
2738                : d->base.base.read_stage);
2739
2740   if (pass == ___SELECT_PASS_1)
2741     {
2742       if (stage != ___STAGE_OPEN)
2743         state->timeout = ___time_mod.time_neg_infinity;
2744       else
2745         {
2746 #ifdef USE_POSIX
2747           if (for_writing)
2748             {
2749               if (d->fd_wr >= 0)
2750                 ___device_select_add_fd (state, d->fd_wr, 1);
2751             }
2752           else
2753             {
2754               if (d->fd_rd >= 0)
2755                 ___device_select_add_fd (state, d->fd_rd, 0);
2756             }
2757 #endif
2758
2759 #ifdef USE_WIN32
2760           if (for_writing)
2761             {
2762               if (d->h_wr != NULL)
2763                 ___device_select_add_wait_obj (state, i, d->h_wr);
2764             }
2765           else
2766             {
2767               if (d->h_rd != NULL)
2768                 {
2769                   int interval = d->poll_interval_nsecs * 6 / 5;
2770                   if (interval < 1000000)
2771                     interval = 1000000; /* min interval = 0.001 secs */
2772                   else if (interval > 200000000)
2773                     interval = 200000000; /* max interval = 0.2 sec */
2774                   d->poll_interval_nsecs = interval;
2775                   ___device_select_add_relative_timeout (state, i, interval * 1e-9);
2776                 }
2777             }
2778 #endif
2779         }
2780       return ___FIX(___SELECT_SETUP_DONE);
2781     }
2782
2783   /* pass == ___SELECT_PASS_CHECK */
2784
2785   if (stage != ___STAGE_OPEN)
2786     state->devs[i] = NULL;
2787   else
2788     {
2789 #ifdef USE_POSIX
2790
2791       if (for_writing)
2792         {
2793           if (d->fd_wr < 0 || FD_ISSET(d->fd_wr, &state->writefds))
2794             state->devs[i] = NULL;
2795         }
2796       else
2797         {
2798           if (d->fd_rd < 0 || FD_ISSET(d->fd_rd, &state->readfds))
2799             state->devs[i] = NULL;
2800         }
2801
2802 #endif
2803
2804 #ifdef USE_WIN32
2805
2806       if (for_writing)
2807         {
2808           if (d->h_wr != NULL && state->devs_next[i] != -1)
2809             state->devs[i] = NULL;
2810         }
2811       else
2812         {
2813           if (d->h_rd != NULL)
2814             state->devs[i] = NULL;
2815         }
2816
2817 #endif
2818     }
2819
2820   return ___FIX(___NO_ERR);
2821 }
2822
2823 ___HIDDEN ___SCMOBJ ___device_pipe_release_raw_virt
2824    ___P((___device_stream *self),
2825         (self)
2826 ___device_stream *self;)
2827 {
2828   return ___FIX(___NO_ERR);
2829 }
2830
2831 ___HIDDEN ___SCMOBJ ___device_pipe_force_output_raw_virt
2832    ___P((___device_stream *self,
2833          int level),
2834         (self,
2835          level)
2836 ___device_stream *self;
2837 int level;)
2838 {
2839   return ___FIX(___NO_ERR);
2840 }
2841
2842 ___HIDDEN ___SCMOBJ ___device_pipe_seek_raw_virt
2843    ___P((___device_stream *self,
2844          ___stream_index *pos,
2845          int whence),
2846         (self,
2847          pos,
2848          whence)
2849 ___device_stream *self;
2850 ___stream_index *pos;
2851 int whence;)
2852 {
2853   return ___FIX(___INVALID_OP_ERR);
2854 }
2855
2856 ___HIDDEN ___SCMOBJ ___device_pipe_read_raw_virt
2857    ___P((___device_stream *self,
2858          ___U8 *buf,
2859          ___stream_index len,
2860          ___stream_index *len_done),
2861         (self,
2862          buf,
2863          len,
2864          len_done)
2865 ___device_stream *self;
2866 ___U8 *buf;
2867 ___stream_index len;
2868 ___stream_index *len_done;)
2869 {
2870   ___device_pipe *d = ___CAST(___device_pipe*,self);
2871   ___SCMOBJ e = ___FIX(___NO_ERR);
2872
2873   if (d->base.base.read_stage != ___STAGE_OPEN)
2874     return ___FIX(___CLOSED_DEVICE_ERR);
2875
2876 #ifdef USE_POSIX
2877
2878   if (d->fd_rd < 0)
2879     *len_done = 0;
2880   else
2881     {
2882       int n = 0;
2883
2884       if ((n = read (d->fd_rd, buf, len)) < 0)
2885         {
2886 #if 0
2887           if (errno == EIO) errno = EAGAIN;
2888 #else
2889           if (errno == EIO) /* on linux, treating EIO as EAGAIN gives an infinite loop */
2890             n = 0;
2891           else
2892 #endif
2893             e = err_code_from_errno ();
2894         }
2895
2896       *len_done = n;
2897     }
2898
2899 #endif
2900
2901 #ifdef USE_WIN32
2902
2903   if (d->h_rd == NULL)
2904     *len_done = 0;
2905   else
2906     {
2907       DWORD n = 0;
2908
2909       if (!PeekNamedPipe (d->h_rd, NULL, 0, NULL, &n, NULL))
2910         e = err_code_from_GetLastError ();
2911       else if (n == 0)
2912         e = ___ERR_CODE_EAGAIN;
2913       else
2914         {
2915           if (len > n)
2916             len = n;
2917
2918           if (!ReadFile (d->h_rd, buf, len, &n, NULL))
2919             e = err_code_from_GetLastError ();
2920           else
2921             d->poll_interval_nsecs = 0;
2922         }
2923
2924       if (e == ___FIX(___WIN32_ERR(ERROR_BROKEN_PIPE)))
2925         e = ___FIX(___NO_ERR); /* generate end-of-file on broken pipe */
2926
2927       *len_done = n;
2928     }
2929
2930 #endif
2931
2932   return e;
2933 }
2934
2935 ___HIDDEN ___SCMOBJ ___device_pipe_write_raw_virt
2936    ___P((___device_stream *self,
2937          ___U8 *buf,
2938          ___stream_index len,
2939          ___stream_index *len_done),
2940         (self,
2941          buf,
2942          len,
2943          len_done)
2944 ___device_stream *self;
2945 ___U8 *buf;
2946 ___stream_index len;
2947 ___stream_index *len_done;)
2948 {
2949   ___device_pipe *d = ___CAST(___device_pipe*,self);
2950
2951   if (d->base.base.write_stage != ___STAGE_OPEN)
2952     return ___FIX(___CLOSED_DEVICE_ERR);
2953
2954 #ifdef USE_POSIX
2955
2956   if (d->fd_wr < 0)
2957     *len_done = len;
2958   else
2959     {
2960       int n;
2961
2962       if ((n = write (d->fd_wr, buf, len)) < 0)
2963         return err_code_from_errno ();
2964
2965       *len_done = n;
2966     }
2967
2968 #endif
2969
2970 #ifdef USE_WIN32
2971
2972   if (d->h_wr == NULL)
2973     *len_done = len;
2974   else
2975     {
2976       DWORD n;
2977
2978       if (!WriteFile (d->h_wr, buf, len, &n, NULL))
2979         return err_code_from_GetLastError ();
2980
2981       *len_done = n;
2982     }
2983
2984 #endif
2985
2986   return ___FIX(___NO_ERR);
2987 }
2988
2989 ___HIDDEN ___SCMOBJ ___device_pipe_width_virt
2990    ___P((___device_stream *self),
2991         (self)
2992 ___device_stream *self;)
2993 {
2994   return ___FIX(80);
2995 }
2996
2997 ___HIDDEN ___SCMOBJ ___device_pipe_default_options_virt
2998    ___P((___device_stream *self),
2999         (self)
3000 ___device_stream *self;)
3001 {
3002   int char_encoding_errors = ___CHAR_ENCODING_ERRORS_ON;
3003   int char_encoding = ___CHAR_ENCODING_ISO_8859_1;
3004   int eol_encoding = ___EOL_ENCODING_LF;
3005   int buffering = ___FULL_BUFFERING;
3006
3007   return ___FIX(___STREAM_OPTIONS(char_encoding_errors,
3008                                   char_encoding,
3009                                   eol_encoding,
3010                                   buffering,
3011                                   char_encoding_errors,
3012                                   char_encoding,
3013                                   eol_encoding,
3014                                   buffering));
3015 }
3016
3017
3018 ___HIDDEN ___SCMOBJ ___device_pipe_options_set_virt
3019    ___P((___device_stream *self,
3020          ___SCMOBJ options),
3021         (self,
3022          options)
3023 ___device_stream *self;
3024 ___SCMOBJ options;)
3025 {
3026   return ___FIX(___NO_ERR);
3027 }
3028
3029
3030 ___HIDDEN ___device_pipe_vtbl ___device_pipe_table =
3031 {
3032   {
3033     {
3034       ___device_pipe_kind,
3035       ___device_stream_select_virt,
3036       ___device_stream_release_virt,
3037       ___device_stream_force_output_virt,
3038       ___device_stream_close_virt
3039     },
3040     ___device_pipe_select_raw_virt,
3041     ___device_pipe_release_raw_virt,
3042     ___device_pipe_force_output_raw_virt,
3043     ___device_pipe_close_raw_virt,
3044     ___device_pipe_seek_raw_virt,
3045     ___device_pipe_read_raw_virt,
3046     ___device_pipe_write_raw_virt,
3047     ___device_pipe_width_virt,
3048     ___device_pipe_default_options_virt,
3049     ___device_pipe_options_set_virt
3050   }
3051 };
3052
3053
3054 #ifdef USE_POSIX
3055
3056 ___HIDDEN ___SCMOBJ ___device_pipe_setup_from_fd
3057    ___P((___device_pipe **dev,
3058          ___device_group *dgroup,
3059          int fd_rd,
3060          int fd_wr,
3061          int direction),
3062         (dev,
3063          dgroup,
3064          fd_rd,
3065          fd_wr,
3066          direction)
3067 ___device_pipe **dev;
3068 ___device_group *dgroup;
3069 int fd_rd;
3070 int fd_wr;
3071 int direction;)
3072 {
3073   ___device_pipe *d;
3074
3075   d = ___CAST(___device_pipe*,
3076               ___alloc_mem (sizeof (___device_pipe)));
3077
3078   if (d == NULL)
3079     return ___FIX(___HEAP_OVERFLOW_ERR);
3080
3081   d->base.base.vtbl = &___device_pipe_table;
3082   d->fd_rd = fd_rd;
3083   d->fd_wr = fd_wr;
3084
3085   *dev = d;
3086
3087   return ___device_stream_setup
3088            (&d->base,
3089             dgroup,
3090             direction,
3091             0);
3092 }
3093
3094 #endif
3095
3096
3097 #ifdef USE_WIN32
3098
3099 ___HIDDEN ___SCMOBJ ___device_pipe_setup_from_handle
3100    ___P((___device_pipe **dev,
3101          ___device_group *dgroup,
3102          HANDLE h_rd,
3103          HANDLE h_wr,
3104          int direction,
3105          int pumps_on),
3106         (dev,
3107          dgroup,
3108          h_rd,
3109          h_wr,
3110          direction,
3111          pumps_on)
3112 ___device_pipe **dev;
3113 ___device_group *dgroup;
3114 HANDLE h_rd;
3115 HANDLE h_wr;
3116 int direction;
3117 int pumps_on;)
3118 {
3119   ___device_pipe *d;
3120
3121   d = ___CAST(___device_pipe*,
3122               ___alloc_mem (sizeof (___device_pipe)));
3123
3124   if (d == NULL)
3125     return ___FIX(___HEAP_OVERFLOW_ERR);
3126
3127   d->base.base.vtbl = &___device_pipe_table;
3128   d->h_rd = h_rd;
3129   d->h_wr = h_wr;
3130   d->poll_interval_nsecs = 0;
3131
3132   *dev = d;
3133
3134   return ___device_stream_setup
3135            (&d->base,
3136             dgroup,
3137             direction,
3138             pumps_on);
3139 }
3140
3141 #endif
3142
3143
3144 /*---------------------------------------------------------------------------*/
3145
3146 /* Process stream device */
3147
3148 typedef struct ___device_process_struct
3149   {
3150     ___device_pipe base;
3151
3152 #ifdef USE_POSIX
3153     pid_t pid;  /* pid of the process */
3154 #endif
3155
3156 #ifdef USE_WIN32
3157     PROCESS_INFORMATION pi;  /* process information */
3158 #endif
3159
3160     int status;          /* process status */
3161     ___BOOL got_status;  /* was the status retrieved? */
3162     ___BOOL cleanuped;   /* has process been cleaned-up? */
3163   } ___device_process;
3164
3165 typedef struct ___device_process_vtbl_struct
3166   {
3167     ___device_stream_vtbl base;
3168   } ___device_process_vtbl;
3169
3170 ___HIDDEN int ___device_process_kind
3171    ___P((___device *self),
3172         (self)
3173 ___device *self;)
3174 {
3175   return ___PROCESS_DEVICE_KIND;
3176 }
3177
3178 ___SCMOBJ ___device_process_cleanup
3179    ___P((___device_process *dev),
3180         (dev)
3181 ___device_process *dev;)
3182 {
3183   if (!dev->cleanuped)
3184     {
3185       dev->cleanuped = 1;
3186
3187 #ifdef USE_POSIX
3188 #endif
3189
3190 #ifdef USE_WIN32
3191
3192       CloseHandle (dev->pi.hProcess); /* ignore error */
3193       CloseHandle (dev->pi.hThread); /* ignore error */
3194
3195 #endif
3196     }
3197
3198   return ___FIX(___NO_ERR);
3199 }
3200
3201
3202 ___SCMOBJ ___device_process_status_set
3203    ___P((___device_process *dev,
3204          int status),
3205         (dev,
3206          status)
3207 ___device_process *dev;
3208 int status;)
3209 {
3210   ___SCMOBJ e = ___FIX(___NO_ERR);
3211
3212   if (!dev->got_status)
3213     {
3214       dev->status = status;
3215       dev->got_status = 1;
3216       e = ___device_process_cleanup (dev); /* ignore error */
3217     }
3218
3219   return e;
3220 }
3221
3222
3223 ___SCMOBJ ___device_process_status_poll
3224    ___P((___device_process *dev),
3225         (dev)
3226 ___device_process *dev;)
3227 {
3228   if (!dev->got_status)
3229     {
3230 #ifdef USE_POSIX
3231
3232       /*
3233        * The process status is updated asynchronously by
3234        * sigchld_signal_handler.
3235        */
3236
3237 #endif
3238
3239 #ifdef USE_WIN32
3240
3241       DWORD status;
3242
3243       if (!GetExitCodeProcess (dev->pi.hProcess, &status))
3244         return err_code_from_GetLastError ();
3245
3246       if (status != STILL_ACTIVE)
3247         ___device_process_status_set (dev, status << 8); /* ignore error */
3248
3249 #endif
3250     }
3251
3252   return ___FIX(___NO_ERR);
3253 }
3254
3255 ___HIDDEN ___SCMOBJ ___device_process_close_raw_virt
3256    ___P((___device_stream *self,
3257          int direction),
3258         (self,
3259          direction)
3260 ___device_stream *self;
3261 int direction;)
3262 {
3263   ___device_process *d = ___CAST(___device_process*,self);
3264   ___SCMOBJ e = ___device_pipe_close_raw_virt (self, direction);
3265
3266   if (e == ___FIX(___NO_ERR))
3267     {
3268       if (d->base.base.base.read_stage == ___STAGE_CLOSED &&
3269           d->base.base.base.write_stage == ___STAGE_CLOSED)
3270         ___device_process_status_poll (d); /* ignore error */
3271     }
3272
3273   return e;
3274 }
3275
3276 ___HIDDEN ___SCMOBJ ___device_process_select_raw_virt
3277    ___P((___device_stream *self,
3278          ___BOOL for_writing,
3279          int i,
3280          int pass,
3281          ___device_select_state *state),
3282         (self,
3283          for_writing,
3284          i,
3285          pass,
3286          state)
3287 ___device_stream *self;
3288 ___BOOL for_writing;
3289 int i;
3290 int pass;
3291 ___device_select_state *state;)
3292 {
3293   return ___device_pipe_select_raw_virt (self, for_writing, i, pass, state);
3294 }
3295
3296 ___HIDDEN ___SCMOBJ ___device_process_release_raw_virt
3297    ___P((___device_stream *self),
3298         (self)
3299 ___device_stream *self;)
3300 {
3301   ___device_process *d = ___CAST(___device_process*,self);
3302   ___SCMOBJ e1 = ___device_pipe_release_raw_virt (self);
3303   ___SCMOBJ e2 = ___device_process_cleanup (d);
3304   if (e1 == ___FIX(___NO_ERR))
3305     e1 = e2;
3306   return e1;
3307 }
3308
3309 ___HIDDEN ___SCMOBJ ___device_process_force_output_raw_virt
3310    ___P((___device_stream *self,
3311          int level),
3312         (self,
3313          level)
3314 ___device_stream *self;
3315 int level;)
3316 {
3317   return ___device_pipe_force_output_raw_virt (self, level);
3318 }
3319
3320 ___HIDDEN ___SCMOBJ ___device_process_seek_raw_virt
3321    ___P((___device_stream *self,
3322          ___stream_index *pos,
3323          int whence),
3324         (self,
3325          pos,
3326          whence)
3327 ___device_stream *self;
3328 ___stream_index *pos;
3329 int whence;)
3330 {
3331   return ___device_pipe_seek_raw_virt (self, pos, whence);
3332 }
3333
3334 ___HIDDEN ___SCMOBJ ___device_process_read_raw_virt
3335    ___P((___device_stream *self,
3336          ___U8 *buf,
3337          ___stream_index len,
3338          ___stream_index *len_done),
3339         (self,
3340          buf,
3341          len,
3342          len_done)
3343 ___device_stream *self;
3344 ___U8 *buf;
3345 ___stream_index len;
3346 ___stream_index *len_done;)
3347 {
3348   return ___device_pipe_read_raw_virt (self, buf, len, len_done);
3349 }
3350
3351 ___HIDDEN ___SCMOBJ ___device_process_write_raw_virt
3352    ___P((___device_stream *self,
3353          ___U8 *buf,
3354          ___stream_index len,
3355          ___stream_index *len_done),
3356         (self,
3357          buf,
3358          len,
3359          len_done)
3360 ___device_stream *self;
3361 ___U8 *buf;
3362 ___stream_index len;
3363 ___stream_index *len_done;)
3364 {
3365   return ___device_pipe_write_raw_virt (self, buf, len, len_done);
3366 }
3367
3368 ___HIDDEN ___SCMOBJ ___device_process_width_virt
3369    ___P((___device_stream *self),
3370         (self)
3371 ___device_stream *self;)
3372 {
3373   return ___FIX(80);
3374 }
3375
3376 ___HIDDEN ___SCMOBJ ___device_process_default_options_virt
3377    ___P((___device_stream *self),
3378         (self)
3379 ___device_stream *self;)
3380 {
3381   return ___device_pipe_default_options_virt (self);
3382 }
3383
3384
3385 ___HIDDEN ___SCMOBJ ___device_process_options_set_virt
3386    ___P((___device_stream *self,
3387          ___SCMOBJ options),
3388         (self,
3389          options)
3390 ___device_stream *self;
3391 ___SCMOBJ options;)
3392 {
3393   return ___device_pipe_options_set_virt (self, options);
3394 }
3395
3396
3397 ___HIDDEN ___device_process_vtbl ___device_process_table =
3398 {
3399   {
3400     {
3401       ___device_process_kind,
3402       ___device_stream_select_virt,
3403       ___device_stream_release_virt,
3404       ___device_stream_force_output_virt,
3405       ___device_stream_close_virt
3406     },
3407     ___device_process_select_raw_virt,
3408     ___device_process_release_raw_virt,
3409     ___device_process_force_output_raw_virt,
3410     ___device_process_close_raw_virt,
3411     ___device_process_seek_raw_virt,
3412     ___device_process_read_raw_virt,
3413     ___device_process_write_raw_virt,
3414     ___device_process_width_virt,
3415     ___device_process_default_options_virt,
3416     ___device_process_options_set_virt
3417   }
3418 };
3419
3420 #ifdef USE_POSIX
3421
3422 ___SCMOBJ ___device_process_setup_from_pid
3423    ___P((___device_process **dev,
3424          ___device_group *dgroup,
3425          pid_t pid,
3426          int fd_stdin,
3427          int fd_stdout,
3428          int direction),
3429         (dev,
3430          dgroup,
3431          pid,
3432          fd_stdin,
3433          fd_stdout,
3434          direction)
3435 ___device_process **dev;
3436 ___device_group *dgroup;
3437 pid_t pid;
3438 int fd_stdin;
3439 int fd_stdout;
3440 int direction;)
3441 {
3442   ___device_process *d;
3443
3444   d = ___CAST(___device_process*,
3445               ___alloc_mem (sizeof (___device_process)));
3446
3447   if (d == NULL)
3448     return ___FIX(___HEAP_OVERFLOW_ERR);
3449
3450   /*
3451    * Setup file descriptors to perform nonblocking I/O.
3452    */
3453
3454   if ((fd_stdout >= 0 &&
3455        (direction & ___DIRECTION_RD) &&
3456        (set_fd_blocking_mode (fd_stdout, 0) < 0)) ||
3457       (fd_stdin >= 0 &&
3458        (direction & ___DIRECTION_WR) &&
3459        (set_fd_blocking_mode (fd_stdin, 0) < 0)))
3460     {
3461       ___SCMOBJ e = err_code_from_errno ();
3462       ___free_mem (d);
3463       return e;
3464     }
3465
3466   d->base.base.base.vtbl = &___device_process_table;
3467   d->base.fd_rd = fd_stdout;
3468   d->base.fd_wr = fd_stdin;
3469   d->pid = pid;
3470   d->status = -1;
3471   d->got_status = 0;
3472   d->cleanuped = 0;
3473
3474   *dev = d;
3475
3476   return ___device_stream_setup
3477            (&d->base.base,
3478             dgroup,
3479             direction,
3480             0);
3481 }
3482
3483 #endif
3484
3485 #ifdef USE_WIN32
3486
3487 ___SCMOBJ ___device_process_setup_from_process
3488    ___P((___device_process **dev,
3489          ___device_group *dgroup,
3490          PROCESS_INFORMATION pi,
3491          HANDLE hstdin,
3492          HANDLE hstdout,
3493          int direction),
3494         (dev,
3495          dgroup,
3496          pi,
3497          hstdin,
3498          hstdout,
3499          direction)
3500 ___device_process **dev;
3501 ___device_group *dgroup;
3502 PROCESS_INFORMATION pi;
3503 HANDLE hstdin;
3504 HANDLE hstdout;
3505 int direction;)
3506 {
3507   ___device_process *d;
3508
3509   d = ___CAST(___device_process*,
3510               ___alloc_mem (sizeof (___device_process)));
3511
3512   if (d == NULL)
3513     return ___FIX(___HEAP_OVERFLOW_ERR);
3514
3515   d->base.base.base.vtbl = &___device_process_table;
3516   d->base.h_rd = hstdout;
3517   d->base.h_wr = hstdin;
3518   d->pi = pi;
3519   d->status = -1;
3520   d->got_status = 0;
3521   d->cleanuped = 0;
3522
3523   *dev = d;
3524
3525   return ___device_stream_setup
3526            (&d->base.base,
3527             dgroup,
3528             direction,
3529             0);
3530 }
3531
3532 #endif
3533
3534
3535 /*---------------------------------------------------------------------------*/
3536
3537 #ifdef USE_NETWORKING
3538
3539 /* Socket utilities */
3540
3541 #ifdef USE_POSIX
3542 #define SOCKET_TYPE int
3543 #define SOCKET_CALL_ERROR(s) ((s) < 0)
3544 #define SOCKET_CALL_ERROR2(s) ((s) < 0)
3545 #define CONNECT_IN_PROGRESS (errno == EINPROGRESS)
3546 #define CONNECT_WOULD_BLOCK (errno == EAGAIN)
3547 #define NOT_CONNECTED(e) ((e) == ___FIX(___ERRNO_ERR(ENOTCONN)))
3548 #define CLOSE_SOCKET(s) close_no_EINTR (s)
3549 #define ERR_CODE_FROM_SOCKET_CALL err_code_from_errno ()
3550 #define IOCTL_SOCKET(s,cmd,argp) ioctl (s,cmd,argp)
3551 #define SOCKET_LEN_TYPE socklen_t
3552 #endif
3553
3554 #ifdef USE_WIN32
3555 #define SOCKET_TYPE SOCKET
3556 #define SOCKET_CALL_ERROR(s) ((s) == SOCKET_ERROR)
3557 #define SOCKET_CALL_ERROR2(s) ((s) == INVALID_SOCKET)
3558 #define CONNECT_IN_PROGRESS ((WSAGetLastError () == WSAEALREADY) || \
3559 (WSAGetLastError () == WSAEISCONN))
3560 #define CONNECT_WOULD_BLOCK ((WSAGetLastError () == WSAEWOULDBLOCK) || \
3561 (WSAGetLastError () == WSAEINVAL))
3562 #define NOT_CONNECTED(e) ((e) == ___FIX(___WIN32_ERR(WSAENOTCONN)))
3563 #define CLOSE_SOCKET(s) closesocket (s)
3564 #define ERR_CODE_FROM_SOCKET_CALL err_code_from_WSAGetLastError ()
3565 #define IOCTL_SOCKET(s,cmd,argp) ioctlsocket (s,cmd,argp)
3566 #define SOCKET_LEN_TYPE int
3567 #endif
3568
3569 #ifdef SHUT_RD
3570 #define SHUTDOWN_RD SHUT_RD
3571 #else
3572 #ifdef SD_RECEIVE
3573 #define SHUTDOWN_RD SD_RECEIVE
3574 #else
3575 #define SHUTDOWN_RD 0
3576 #endif
3577 #endif
3578
3579 #ifdef SHUT_WR
3580 #define SHUTDOWN_WR SHUT_WR
3581 #else
3582 #ifdef SD_SEND
3583 #define SHUTDOWN_WR SD_SEND
3584 #else
3585 #define SHUTDOWN_WR 1
3586 #endif
3587 #endif
3588
3589 #endif
3590
3591
3592 /*---------------------------------------------------------------------------*/
3593
3594 #ifdef USE_NETWORKING
3595
3596 /* TCP client stream device */
3597
3598 typedef struct ___device_tcp_client_struct
3599   {
3600     ___device_stream base;
3601     SOCKET_TYPE s;
3602     struct sockaddr server_addr;
3603     SOCKET_LEN_TYPE server_addrlen;
3604     int try_connect_again;
3605     int connect_done;
3606
3607 #ifdef USE_POSIX
3608
3609     int try_connect_interval_nsecs;
3610
3611 #endif
3612
3613 #ifdef USE_WIN32
3614
3615     long io_events;   /* used by ___device_tcp_client_select_raw_virt */
3616     HANDLE io_event;  /* used by ___device_tcp_client_select_raw_virt */
3617
3618 #endif
3619   } ___device_tcp_client;
3620
3621
3622 typedef struct ___device_tcp_client_vtbl_struct
3623   {
3624     ___device_stream_vtbl base;
3625   } ___device_tcp_client_vtbl;
3626
3627
3628 ___HIDDEN int try_connect
3629    ___P((___device_tcp_client *dev),
3630         (dev)
3631 ___device_tcp_client *dev;)
3632 {
3633   if (!SOCKET_CALL_ERROR(connect (dev->s,
3634                                   &dev->server_addr,
3635                                   dev->server_addrlen)) ||
3636       CONNECT_IN_PROGRESS || /* establishing connection in background */
3637       dev->try_connect_again == 2) /* last connect attempt? */
3638     {
3639       dev->try_connect_again = 0; /* we're done waiting */
3640       return 0;
3641     }
3642
3643   if (CONNECT_WOULD_BLOCK) /* connect can't be performed now */
3644     return 0;
3645
3646   return -1;
3647 }
3648
3649 ___HIDDEN int ___device_tcp_client_kind
3650    ___P((___device *self),
3651         (self)
3652 ___device *self;)
3653 {
3654   return ___TCP_CLIENT_DEVICE_KIND;
3655 }
3656
3657
3658 ___HIDDEN ___SCMOBJ ___device_tcp_client_close_raw_virt
3659    ___P((___device_stream *self,
3660          int direction),
3661         (self,
3662          direction)
3663 ___device_stream *self;
3664 int direction;)
3665 {
3666   ___device_tcp_client *d = ___CAST(___device_tcp_client*,self);
3667   int is_not_closed = 0;
3668
3669   if (d->base.base.read_stage != ___STAGE_CLOSED)
3670     is_not_closed |= ___DIRECTION_RD;
3671
3672   if (d->base.base.write_stage != ___STAGE_CLOSED)
3673     is_not_closed |= ___DIRECTION_WR;
3674
3675   if (is_not_closed == 0)
3676     return ___FIX(___NO_ERR);
3677
3678   if ((is_not_closed & ~direction) == 0)
3679     {
3680       /* Close socket when both sides are closed. */
3681
3682       d->base.base.read_stage = ___STAGE_CLOSED; /* avoid multiple closes */
3683       d->base.base.write_stage = ___STAGE_CLOSED;
3684
3685 #ifdef USE_WIN32
3686
3687       if (d->io_event != NULL)
3688         CloseHandle (d->io_event); /* ignore error */
3689
3690 #endif
3691
3692       if ((d->base.base.close_direction & (___DIRECTION_RD|___DIRECTION_WR))
3693           == (___DIRECTION_RD|___DIRECTION_WR))
3694         {
3695           if (CLOSE_SOCKET(d->s) != 0)
3696             return ERR_CODE_FROM_SOCKET_CALL;
3697         }
3698     }
3699   else if (is_not_closed & direction & ___DIRECTION_RD)
3700     {
3701       /* Shutdown receiving side. */
3702
3703       if ((d->base.base.close_direction & ___DIRECTION_RD)
3704           == ___DIRECTION_RD)
3705         {
3706           if (shutdown (d->s, SHUTDOWN_RD) != 0)
3707             {
3708               ___SCMOBJ e = ERR_CODE_FROM_SOCKET_CALL;
3709               if (!NOT_CONNECTED(e))
3710                 return e;
3711             }
3712         }
3713
3714       d->base.base.read_stage = ___STAGE_CLOSED;
3715     }
3716   else if (is_not_closed & direction & ___DIRECTION_WR)
3717     {
3718       /* Shutdown sending side. */
3719
3720       if ((d->base.base.close_direction & ___DIRECTION_WR)
3721           == ___DIRECTION_WR)
3722         {
3723           if (shutdown (d->s, SHUTDOWN_WR) != 0)
3724             {
3725               ___SCMOBJ e = ERR_CODE_FROM_SOCKET_CALL;
3726               if (!NOT_CONNECTED(e))
3727                 return e;
3728             }
3729         }
3730
3731       d->base.base.write_stage = ___STAGE_CLOSED;
3732     }
3733
3734   return ___FIX(___NO_ERR);
3735 }
3736
3737 ___HIDDEN ___SCMOBJ ___device_tcp_client_select_raw_virt
3738    ___P((___device_stream *self,
3739          ___BOOL for_writing,
3740          int i,
3741          int pass,
3742          ___device_select_state *state),
3743         (self,
3744          for_writing,
3745          i,
3746          pass,
3747          state)
3748 ___device_stream *self;
3749 ___BOOL for_writing;
3750 int i;
3751 int pass;
3752 ___device_select_state *state;)
3753 {
3754   ___device_tcp_client *d = ___CAST(___device_tcp_client*,self);
3755   int stage = (for_writing
3756                ? d->base.base.write_stage
3757                : d->base.base.read_stage);
3758
3759   if (pass == ___SELECT_PASS_1)
3760     {
3761       if (stage != ___STAGE_OPEN)
3762         {
3763           state->timeout = ___time_mod.time_neg_infinity;
3764           return ___FIX(___SELECT_SETUP_DONE);
3765         }
3766       else
3767         {
3768 #ifdef USE_POSIX
3769
3770           if (d->try_connect_again != 0)
3771             {
3772               int interval = d->try_connect_interval_nsecs * 6 / 5;
3773               if (interval > 200000000) /* max interval = 0.2 sec */
3774                 interval = 200000000;
3775               d->try_connect_interval_nsecs = interval;
3776               ___device_select_add_relative_timeout (state, i, interval * 1e-9);
3777             }
3778           else
3779             ___device_select_add_fd (state, d->s, for_writing);
3780
3781           return ___FIX(___SELECT_SETUP_DONE);
3782
3783 #endif
3784
3785 #ifdef USE_WIN32
3786
3787           d->io_events = 0;
3788
3789           return ___FIX(___NO_ERR);
3790
3791 #endif
3792         }
3793     }
3794
3795 #ifdef USE_WIN32
3796
3797   else if (pass == ___SELECT_PASS_2)
3798     {
3799       if (d->try_connect_again != 0)
3800         d->io_events = (FD_CONNECT | FD_CLOSE);
3801       else if (for_writing)
3802         d->io_events |= (FD_WRITE | FD_CLOSE);
3803       else
3804         d->io_events |= (FD_READ | FD_CLOSE);
3805
3806       return ___FIX(___NO_ERR);
3807     }
3808   else if (pass == ___SELECT_PASS_3)
3809     {
3810       HANDLE wait_obj = d->io_event;
3811
3812       ResetEvent (wait_obj); /* ignore error */
3813
3814       WSAEventSelect (d->s, wait_obj, d->io_events);
3815
3816       ___device_select_add_wait_obj (state, i, wait_obj);
3817
3818       return ___FIX(___SELECT_SETUP_DONE);
3819     }
3820
3821 #endif
3822
3823   /* pass == ___SELECT_PASS_CHECK */
3824
3825   if (stage != ___STAGE_OPEN)
3826     state->devs[i] = NULL;
3827   else
3828     {
3829 #ifdef USE_POSIX
3830
3831       if (d->try_connect_again != 0 ||
3832           (for_writing
3833            ? FD_ISSET(d->s, &state->writefds)
3834            : FD_ISSET(d->s, &state->readfds)))
3835         {
3836           d->connect_done = 1;
3837           state->devs[i] = NULL;
3838         }
3839
3840 #endif
3841
3842 #ifdef USE_WIN32
3843
3844       if (state->devs_next[i] != -1)
3845         {
3846           state->devs[i] = NULL;
3847           if (d->try_connect_again != 0)
3848             {
3849               d->connect_done = 1;
3850               d->try_connect_again = 2;
3851             }
3852         }
3853
3854 #endif
3855     }
3856
3857   return ___FIX(___NO_ERR);
3858 }
3859
3860 ___HIDDEN ___SCMOBJ ___device_tcp_client_release_raw_virt
3861    ___P((___device_stream *self),
3862         (self)
3863 ___device_stream *self;)
3864 {
3865   return ___FIX(___NO_ERR);
3866 }
3867
3868 ___HIDDEN ___SCMOBJ ___device_tcp_client_force_output_raw_virt
3869    ___P((___device_stream *self,
3870          int level),
3871         (self,
3872          level)
3873 ___device_stream *self;
3874 int level;)
3875 {
3876   return ___FIX(___NO_ERR);
3877 }
3878
3879 ___HIDDEN ___SCMOBJ ___device_tcp_client_seek_raw_virt
3880    ___P((___device_stream *self,
3881          ___stream_index *pos,
3882          int whence),
3883         (self,
3884          pos,
3885          whence)
3886 ___device_stream *self;
3887 ___stream_index *pos;
3888 int whence;)
3889 {
3890   return ___FIX(___INVALID_OP_ERR);
3891 }
3892
3893 ___HIDDEN ___SCMOBJ ___device_tcp_client_read_raw_virt
3894    ___P((___device_stream *self,
3895          ___U8 *buf,
3896          ___stream_index len,
3897          ___stream_index *len_done),
3898         (self,
3899          buf,
3900          len,
3901          len_done)
3902 ___device_stream *self;
3903 ___U8 *buf;
3904 ___stream_index len;
3905 ___stream_index *len_done;)
3906 {
3907   ___device_tcp_client *d = ___CAST(___device_tcp_client*,self);
3908   int n;
3909
3910   if (d->base.base.read_stage != ___STAGE_OPEN)
3911     return ___FIX(___CLOSED_DEVICE_ERR);
3912
3913   if (d->try_connect_again != 0)
3914     {
3915       if (try_connect (d) == 0)
3916         {
3917           if (d->try_connect_again != 0)
3918             return ___ERR_CODE_EAGAIN;
3919         }
3920       else
3921         return ERR_CODE_FROM_SOCKET_CALL;
3922     }
3923
3924   if (SOCKET_CALL_ERROR(n = recv (d->s, ___CAST(char*,buf), len, 0)))
3925     {
3926       ___SCMOBJ e = ERR_CODE_FROM_SOCKET_CALL;
3927       if (NOT_CONNECTED(e) && !d->connect_done)
3928         e = ___ERR_CODE_EAGAIN;
3929       return e;
3930     }
3931
3932   *len_done = n;
3933
3934   return ___FIX(___NO_ERR);
3935 }
3936
3937
3938 ___HIDDEN ___SCMOBJ ___device_tcp_client_write_raw_virt
3939    ___P((___device_stream *self,
3940          ___U8 *buf,
3941          ___stream_index len,
3942          ___stream_index *len_done),
3943         (self,
3944          buf,
3945          len,
3946          len_done)
3947 ___device_stream *self;
3948 ___U8 *buf;
3949 ___stream_index len;
3950 ___stream_index *len_done;)
3951 {
3952   ___device_tcp_client *d = ___CAST(___device_tcp_client*,self);
3953   int n;
3954
3955   if (d->base.base.write_stage != ___STAGE_OPEN)
3956     return ___FIX(___CLOSED_DEVICE_ERR);
3957
3958   if (d->try_connect_again != 0)
3959     {
3960       if (try_connect (d) == 0)
3961         {
3962           if (d->try_connect_again != 0)
3963             return ___ERR_CODE_EAGAIN;
3964         }
3965       else
3966         return ERR_CODE_FROM_SOCKET_CALL;
3967     }
3968
3969   if (SOCKET_CALL_ERROR(n = send (d->s, ___CAST(char*,buf), len, 0)))
3970     {
3971       ___SCMOBJ e = ERR_CODE_FROM_SOCKET_CALL;
3972       if (NOT_CONNECTED(e) && !d->connect_done)
3973         e = ___ERR_CODE_EAGAIN;
3974       return e;
3975     }
3976
3977   *len_done = n;
3978
3979   return ___FIX(___NO_ERR);
3980 }
3981
3982
3983 ___HIDDEN ___SCMOBJ ___device_tcp_client_width_virt
3984    ___P((___device_stream *self),
3985         (self)
3986 ___device_stream *self;)
3987 {
3988   return ___FIX(80);
3989 }
3990
3991
3992 ___HIDDEN ___SCMOBJ ___device_tcp_client_default_options_virt
3993    ___P((___device_stream *self),
3994         (self)
3995 ___device_stream *self;)
3996 {
3997   int char_encoding_errors = ___CHAR_ENCODING_ERRORS_ON;
3998   int char_encoding = ___CHAR_ENCODING_ISO_8859_1;
3999   int eol_encoding = ___EOL_ENCODING_LF;
4000   int buffering = ___FULL_BUFFERING;
4001
4002   return ___FIX(___STREAM_OPTIONS(char_encoding_errors,
4003                                   char_encoding,
4004                                   eol_encoding,
4005                                   buffering,
4006                                   char_encoding_errors,
4007                                   char_encoding,
4008                                   eol_encoding,
4009                                   buffering));
4010 }
4011
4012
4013 ___HIDDEN ___SCMOBJ ___device_tcp_client_options_set_virt
4014    ___P((___device_stream *self,
4015          ___SCMOBJ options),
4016         (self,
4017          options)
4018 ___device_stream *self;
4019 ___SCMOBJ options;)
4020 {
4021   return ___FIX(___NO_ERR);
4022 }
4023
4024
4025 ___HIDDEN ___device_tcp_client_vtbl ___device_tcp_client_table =
4026 {
4027   {
4028     {
4029       ___device_tcp_client_kind,
4030       ___device_stream_select_virt,
4031       ___device_stream_release_virt,
4032       ___device_stream_force_output_virt,
4033       ___device_stream_close_virt
4034     },
4035     ___device_tcp_client_select_raw_virt,
4036     ___device_tcp_client_release_raw_virt,
4037     ___device_tcp_client_force_output_raw_virt,
4038     ___device_tcp_client_close_raw_virt,
4039     ___device_tcp_client_seek_raw_virt,
4040     ___device_tcp_client_read_raw_virt,
4041     ___device_tcp_client_write_raw_virt,
4042     ___device_tcp_client_width_virt,
4043     ___device_tcp_client_default_options_virt,
4044     ___device_tcp_client_options_set_virt
4045   }
4046 };
4047
4048
4049 #define ___SOCK_KEEPALIVE_FLAG(options) (((options) & 1) != 0)
4050 #define ___SOCK_NO_COALESCE_FLAG(options) (((options) & 2) != 0)
4051 #define ___SOCK_REUSE_ADDRESS_FLAG(options) (((options) & 2048) != 0)
4052
4053
4054 ___HIDDEN ___SCMOBJ create_tcp_socket
4055    ___P((SOCKET_TYPE *sock,
4056          int options),
4057         (sock,
4058          options)
4059 SOCKET_TYPE *sock;
4060 int options;)
4061 {
4062   int keepalive_flag = ___SOCK_KEEPALIVE_FLAG(options);
4063   int no_coalesce_flag = ___SOCK_NO_COALESCE_FLAG(options);
4064   int reuse_address_flag = ___SOCK_REUSE_ADDRESS_FLAG(options);
4065   SOCKET_TYPE s;
4066
4067   if (SOCKET_CALL_ERROR2(s = socket (AF_INET, SOCK_STREAM, 0)))
4068     return ERR_CODE_FROM_SOCKET_CALL;
4069
4070 #ifndef TCP_NODELAY
4071 #define TCP_NODELAY 1
4072 #endif
4073
4074   if ((keepalive_flag != 0 &&
4075        setsockopt (s, /* keep connection alive or not */
4076                    SOL_SOCKET,
4077                    SO_KEEPALIVE,
4078                    ___CAST(char*,&keepalive_flag),
4079                    sizeof (keepalive_flag)) != 0) ||
4080       (reuse_address_flag != 0 &&
4081        setsockopt (s, /* allow reusing the same address */
4082                    SOL_SOCKET,
4083                    SO_REUSEADDR,
4084                    ___CAST(char*,&reuse_address_flag),
4085                    sizeof (reuse_address_flag)) != 0) ||
4086       (no_coalesce_flag != 0 &&
4087        setsockopt (s, /* enable or disable packet coalescing algorithm */
4088                    IPPROTO_TCP,
4089                    TCP_NODELAY,
4090                    ___CAST(char*,&no_coalesce_flag),
4091                    sizeof (no_coalesce_flag)) != 0))
4092     {
4093       ___SCMOBJ e = ERR_CODE_FROM_SOCKET_CALL;
4094       CLOSE_SOCKET(s); /* ignore error */
4095       return e;
4096     }
4097
4098   *sock = s;
4099
4100   return ___FIX(___NO_ERR);
4101 }
4102
4103
4104 ___HIDDEN int set_socket_non_blocking
4105    ___P((SOCKET_TYPE s),
4106         (s)
4107 SOCKET_TYPE s;)
4108 {
4109 #ifndef USE_ioctl
4110 #undef FIONBIO
4111 #endif
4112
4113 #ifdef FIONBIO
4114
4115   unsigned long param = 1;
4116
4117   return SOCKET_CALL_ERROR(IOCTL_SOCKET(s, FIONBIO, &param));
4118
4119 #else
4120
4121   return set_fd_blocking_mode (s, 0);
4122
4123 #endif
4124 }
4125
4126
4127 ___SCMOBJ ___device_tcp_client_setup_from_socket
4128    ___P((___device_tcp_client **dev,
4129          ___device_group *dgroup,
4130          SOCKET_TYPE s,
4131          struct sockaddr *server_addr,
4132          SOCKET_LEN_TYPE server_addrlen,
4133          int try_connect_again,
4134          int direction),
4135         (dev,
4136          dgroup,
4137          s,
4138          server_addr,
4139          server_addrlen,
4140          try_connect_again,
4141          direction)
4142 ___device_tcp_client **dev;
4143 ___device_group *dgroup;
4144 SOCKET_TYPE s;
4145 struct sockaddr *server_addr;
4146 SOCKET_LEN_TYPE server_addrlen;
4147 int try_connect_again;
4148 int direction;)
4149 {
4150   ___SCMOBJ e;
4151   ___device_tcp_client *d;
4152
4153   d = ___CAST(___device_tcp_client*,
4154               ___alloc_mem (sizeof (___device_tcp_client)));
4155
4156   if (d == NULL)
4157     return ___FIX(___HEAP_OVERFLOW_ERR);
4158
4159   /*
4160    * Setup socket to perform nonblocking I/O.
4161    */
4162
4163   if (set_socket_non_blocking (s) != 0) /* set nonblocking mode */
4164     {
4165       e = ERR_CODE_FROM_SOCKET_CALL;
4166       ___free_mem (d);
4167       return e;
4168     }
4169
4170   d->base.base.vtbl = &___device_tcp_client_table;
4171   d->s = s;
4172   d->server_addr = *server_addr;
4173   d->server_addrlen = server_addrlen;
4174   d->try_connect_again = try_connect_again;
4175   d->connect_done = 0;
4176
4177 #ifdef USE_POSIX
4178
4179   d->try_connect_interval_nsecs = 1000000; /* 0.001 secs */
4180
4181 #endif
4182
4183 #ifdef USE_WIN32
4184
4185   d->io_event =
4186     CreateEvent (NULL,  /* can't inherit */
4187                  TRUE,  /* manual reset */
4188                  FALSE, /* not signaled */
4189                  NULL); /* no name */
4190
4191   if (d->io_event == NULL)
4192     {
4193       e = err_code_from_GetLastError ();
4194       ___free_mem (d);
4195       return e;
4196     }
4197
4198 #endif
4199
4200   *dev = d;
4201
4202   return ___device_stream_setup
4203            (&d->base,
4204             dgroup,
4205             direction,
4206             0);
4207 }
4208
4209
4210 ___SCMOBJ ___device_tcp_client_setup_from_sockaddr
4211    ___P((___device_tcp_client **dev,
4212          ___device_group *dgroup,
4213          struct sockaddr *server_addr,
4214          SOCKET_LEN_TYPE server_addrlen,
4215          int options,
4216          int direction),
4217         (dev,
4218          dgroup,
4219          server_addr,
4220          server_addrlen,
4221          options,
4222          direction)
4223 ___device_tcp_client **dev;
4224 ___device_group *dgroup;
4225 struct sockaddr *server_addr;
4226 SOCKET_LEN_TYPE server_addrlen;
4227 int options;
4228 int direction;)
4229 {
4230   ___SCMOBJ e;
4231   SOCKET_TYPE s;
4232   ___device_tcp_client *d;
4233
4234   if ((e = create_tcp_socket (&s, options)) != ___FIX(___NO_ERR))
4235     return e;
4236
4237   if ((e = ___device_tcp_client_setup_from_socket
4238              (&d,
4239               dgroup,
4240               s,
4241               server_addr,
4242               server_addrlen,
4243               1,
4244               direction))
4245       != ___FIX(___NO_ERR))
4246     {
4247       CLOSE_SOCKET(s); /* ignore error */
4248       return e;
4249     }
4250
4251   device_transfer_close_responsibility (___CAST(___device*,d));
4252
4253   *dev = d;
4254
4255   if (try_connect (d) != 0)
4256     {
4257       e = ERR_CODE_FROM_SOCKET_CALL;
4258       ___device_cleanup (&d->base.base); /* ignore error */
4259       return e;
4260     }
4261
4262   return ___FIX(___NO_ERR);
4263 }
4264
4265 #endif
4266
4267
4268 /*---------------------------------------------------------------------------*/
4269
4270 #ifdef USE_NETWORKING
4271
4272 /* TCP server device. */
4273
4274 typedef struct ___device_tcp_server_struct
4275   {
4276     ___device base;
4277     SOCKET_TYPE s;
4278
4279 #ifdef USE_WIN32
4280
4281     HANDLE io_event;  /* used by ___device_tcp_server_select_raw_virt */
4282
4283 #endif
4284   } ___device_tcp_server;
4285
4286 typedef struct ___device_tcp_server_vtbl_struct
4287   {
4288     ___device_vtbl base;
4289   } ___device_tcp_server_vtbl;
4290
4291 ___HIDDEN int ___device_tcp_server_kind
4292    ___P((___device *self),
4293         (self)
4294 ___device *self;)
4295 {
4296   return ___TCP_SERVER_DEVICE_KIND;
4297 }
4298
4299 ___HIDDEN ___SCMOBJ ___device_tcp_server_close_virt
4300    ___P((___device *self,
4301          int direction),
4302         (self,
4303          direction)
4304 ___device *self;
4305 int direction;)
4306 {
4307   ___device_tcp_server *d = ___CAST(___device_tcp_server*,self);
4308
4309   if (d->base.read_stage == ___STAGE_CLOSED)
4310     return ___FIX(___NO_ERR);
4311
4312   if (direction & ___DIRECTION_RD)
4313     {
4314       d->base.read_stage = ___STAGE_CLOSED; /* avoid multiple closes */
4315
4316 #ifdef USE_WIN32
4317
4318       if (d->io_event != NULL)
4319         CloseHandle (d->io_event); /* ignore error */
4320
4321 #endif
4322
4323       if ((d->base.close_direction & ___DIRECTION_RD)
4324           == ___DIRECTION_RD)
4325         {
4326           if (CLOSE_SOCKET(d->s) != 0)
4327             return ERR_CODE_FROM_SOCKET_CALL;
4328         }
4329     }
4330
4331   return ___FIX(___NO_ERR);
4332 }
4333
4334 ___HIDDEN ___SCMOBJ ___device_tcp_server_select_virt
4335    ___P((___device *self,
4336          ___BOOL for_writing,
4337          int i,
4338          int pass,
4339          ___device_select_state *state),
4340         (self,
4341          for_writing,
4342          i,
4343          pass,
4344          state)
4345 ___device *self;
4346 ___BOOL for_writing;
4347 int i;
4348 int pass;
4349 ___device_select_state *state;)
4350 {
4351   ___device_tcp_server *d = ___CAST(___device_tcp_server*,self);
4352   int stage = (for_writing
4353                ? d->base.write_stage
4354                : d->base.read_stage);
4355
4356   if (pass == ___SELECT_PASS_1)
4357     {
4358       if (stage != ___STAGE_OPEN)
4359         state->timeout = ___time_mod.time_neg_infinity;
4360       else
4361         {
4362 #ifdef USE_POSIX
4363           ___device_select_add_fd (state, d->s, for_writing);
4364 #endif
4365
4366 #ifdef USE_WIN32
4367
4368           HANDLE wait_obj = d->io_event;
4369
4370           ResetEvent (wait_obj); /* ignore error */
4371
4372           WSAEventSelect (d->s, wait_obj, FD_ACCEPT);
4373
4374           ___device_select_add_wait_obj (state, i, wait_obj);
4375
4376 #endif
4377         }
4378
4379       return ___FIX(___SELECT_SETUP_DONE);
4380     }
4381
4382   /* pass == ___SELECT_PASS_CHECK */
4383
4384   if (stage != ___STAGE_OPEN)
4385     state->devs[i] = NULL;
4386   else
4387     {
4388 #ifdef USE_POSIX
4389
4390       if (FD_ISSET(d->s, &state->readfds))
4391         state->devs[i] = NULL;
4392
4393 #endif
4394
4395 #ifdef USE_WIN32
4396
4397       if (state->devs_next[i] != -1)
4398         state->devs[i] = NULL;
4399
4400 #endif
4401     }
4402
4403   return ___FIX(___NO_ERR);
4404 }
4405
4406 ___HIDDEN ___SCMOBJ ___device_tcp_server_release_virt
4407    ___P((___device *self),
4408         (self)
4409 ___device *self;)
4410 {
4411   return ___FIX(___NO_ERR);
4412 }
4413
4414 ___HIDDEN ___SCMOBJ ___device_tcp_server_force_output_virt
4415    ___P((___device *self,
4416          int level),
4417         (self,
4418          level)
4419 ___device *self;
4420 int level;)
4421 {
4422   return ___FIX(___NO_ERR);
4423 }
4424
4425 ___HIDDEN ___device_tcp_server_vtbl ___device_tcp_server_table =
4426 {
4427   {
4428     ___device_tcp_server_kind,
4429     ___device_tcp_server_select_virt,
4430     ___device_tcp_server_release_virt,
4431     ___device_tcp_server_force_output_virt,
4432     ___device_tcp_server_close_virt
4433   }
4434 };
4435
4436
4437 ___SCMOBJ ___device_tcp_server_setup
4438    ___P((___device_tcp_server **dev,
4439          ___device_group *dgroup,
4440          struct sockaddr *server_addr,
4441          SOCKET_LEN_TYPE server_addrlen,
4442          int backlog,
4443          int options),
4444         (dev,
4445          dgroup,
4446          server_addr,
4447          server_addrlen,
4448          backlog,
4449          options)
4450 ___device_tcp_server **dev;
4451 ___device_group *dgroup;
4452 struct sockaddr *server_addr;
4453 SOCKET_LEN_TYPE server_addrlen;
4454 int backlog;
4455 int options;)
4456 {
4457   ___SCMOBJ e;
4458   SOCKET_TYPE s;
4459   ___device_tcp_server *d;
4460
4461   if ((e = create_tcp_socket (&s, options)) != ___FIX(___NO_ERR))
4462     return e;
4463
4464   if (set_socket_non_blocking (s) != 0 || /* set nonblocking mode */
4465       bind (s, server_addr, server_addrlen) != 0 ||
4466       listen (s, backlog) != 0)
4467     {
4468       e = ERR_CODE_FROM_SOCKET_CALL;
4469       CLOSE_SOCKET(s); /* ignore error */
4470       return e;
4471     }
4472
4473   d = ___CAST(___device_tcp_server*,
4474               ___alloc_mem (sizeof (___device_tcp_server)));
4475
4476   if (d == NULL)
4477     {
4478       CLOSE_SOCKET(s); /* ignore error */
4479       return ___FIX(___HEAP_OVERFLOW_ERR);
4480     }
4481
4482   d->base.vtbl = &___device_tcp_server_table;
4483   d->base.refcount = 1;
4484   d->base.direction = ___DIRECTION_RD;
4485   d->base.close_direction = 0; /* prevent closing on errors */
4486   d->base.read_stage = ___STAGE_OPEN;
4487   d->base.write_stage = ___STAGE_CLOSED;
4488
4489 #ifdef USE_WIN32
4490
4491   d->io_event =
4492     CreateEvent (NULL,  /* can't inherit */
4493                  TRUE,  /* manual reset */
4494                  FALSE, /* not signaled */
4495                  NULL); /* no name */
4496
4497   if (d->io_event == NULL)
4498     {
4499       ___SCMOBJ e = err_code_from_GetLastError ();
4500       CLOSE_SOCKET(s); /* ignore error */
4501       ___free_mem (d);
4502       return e;
4503     }
4504
4505 #endif
4506
4507   d->s = s;
4508
4509   device_transfer_close_responsibility (___CAST(___device*,d));
4510
4511   *dev = d;
4512
4513   ___device_add_to_group (dgroup, &d->base);
4514
4515   return ___FIX(___NO_ERR);
4516 }
4517
4518
4519 ___SCMOBJ ___device_tcp_server_read
4520    ___P((___device_tcp_server *dev,
4521          ___device_group *dgroup,
4522          ___device_tcp_client **client),
4523         (dev,
4524          dgroup,
4525          client)
4526 ___device_tcp_server *dev;
4527 ___device_group *dgroup;
4528 ___device_tcp_client **client;)
4529 {
4530   ___SCMOBJ e;
4531   struct sockaddr_in addr;
4532   SOCKET_LEN_TYPE addrlen;
4533   SOCKET_TYPE s;
4534
4535   if (dev->base.read_stage != ___STAGE_OPEN)
4536     return ___FIX(___CLOSED_DEVICE_ERR);
4537
4538   addrlen = sizeof (addr);
4539
4540   if (SOCKET_CALL_ERROR2(s = accept (dev->s,
4541                                      ___CAST(struct sockaddr*,&addr),
4542                                      &addrlen)))
4543     return ERR_CODE_FROM_SOCKET_CALL;
4544
4545   if ((e = ___device_tcp_client_setup_from_socket
4546              (client,
4547               dgroup,
4548               s,
4549               ___CAST(struct sockaddr*,&addr),
4550               addrlen,
4551               0,
4552               ___DIRECTION_RD|___DIRECTION_WR))
4553       != ___FIX(___NO_ERR))
4554     {
4555       CLOSE_SOCKET(s); /* ignore error */
4556       return e;
4557     }
4558
4559   device_transfer_close_responsibility (___CAST(___device*,*client));
4560
4561   return ___FIX(___NO_ERR);
4562 }
4563
4564 #endif
4565
4566
4567 /*---------------------------------------------------------------------------*/
4568
4569 /* Directory device. */
4570
4571 typedef struct ___device_directory_struct
4572   {
4573     ___device base;
4574
4575     int ignore_hidden;
4576
4577 #ifdef USE_opendir
4578     DIR *dir;
4579 #endif
4580
4581 #ifdef USE_FindFirstFile
4582     HANDLE h;
4583     WIN32_FIND_DATA fdata;
4584     ___BOOL first_file;
4585 #endif
4586   } ___device_directory;
4587
4588 typedef struct ___device_directory_vtbl_struct
4589   {
4590     ___device_vtbl base;
4591   } ___device_directory_vtbl;
4592
4593 ___HIDDEN int ___device_directory_kind
4594    ___P((___device *self),
4595         (self)
4596 ___device *self;)
4597 {
4598   return ___DIRECTORY_KIND;
4599 }
4600
4601 ___HIDDEN ___SCMOBJ ___device_directory_close_virt
4602    ___P((___device *self,
4603          int direction),
4604         (self,
4605          direction)
4606 ___device *self;
4607 int direction;)
4608 {
4609   ___device_directory *d = ___CAST(___device_directory*,self);
4610
4611   if (d->base.read_stage == ___STAGE_CLOSED)
4612     return ___FIX(___NO_ERR);
4613
4614   if (direction & ___DIRECTION_RD)
4615     {
4616       d->base.read_stage = ___STAGE_CLOSED; /* avoid multiple closes */
4617
4618       if ((d->base.close_direction & ___DIRECTION_RD)
4619           == ___DIRECTION_RD)
4620         {
4621
4622 #ifdef USE_opendir
4623           if (closedir (d->dir) < 0)
4624             return err_code_from_errno ();
4625 #endif
4626
4627 #ifdef USE_FindFirstFile
4628           if (!FindClose (d->h))
4629             return err_code_from_GetLastError ();
4630 #endif
4631         }
4632     }
4633
4634   return ___FIX(___NO_ERR);
4635 }
4636
4637 ___HIDDEN ___SCMOBJ ___device_directory_select_virt
4638    ___P((___device *self,
4639          ___BOOL for_writing,
4640          int i,
4641          int pass,
4642          ___device_select_state *state),
4643         (self,
4644          for_writing,
4645          i,
4646          pass,
4647          state)
4648 ___device *self;
4649 ___BOOL for_writing;
4650 int i;
4651 int pass;
4652 ___device_select_state *state;)
4653 {
4654   if (pass == ___SELECT_PASS_1)
4655     {
4656       state->timeout = ___time_mod.time_neg_infinity;
4657       return ___FIX(___SELECT_SETUP_DONE);
4658     }
4659
4660   /* pass == ___SELECT_PASS_CHECK */
4661
4662   state->devs[i] = NULL;
4663
4664   return ___FIX(___NO_ERR);
4665 }
4666
4667 ___HIDDEN ___SCMOBJ ___device_directory_release_virt
4668    ___P((___device *self),
4669         (self)
4670 ___device *self;)
4671 {
4672   return ___FIX(___NO_ERR);
4673 }
4674
4675 ___HIDDEN ___SCMOBJ ___device_directory_force_output_virt
4676    ___P((___device *self,
4677          int level),
4678         (self,
4679          level)
4680 ___device *self;
4681 int level;)
4682 {
4683   return ___FIX(___NO_ERR);
4684 }
4685
4686 ___HIDDEN ___device_directory_vtbl ___device_directory_table =
4687 {
4688   {
4689     ___device_directory_kind,
4690     ___device_directory_select_virt,
4691     ___device_directory_release_virt,
4692     ___device_directory_force_output_virt,
4693     ___device_directory_close_virt
4694   }
4695 };
4696
4697
4698 #ifdef USE_opendir
4699 #define ___DIR_OPEN_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
4700 #endif
4701
4702 #ifdef USE_FindFirstFile
4703 #ifdef _UNICODE
4704 #define ___DIR_OPEN_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
4705 #else
4706 #define ___DIR_OPEN_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
4707 #endif
4708 #endif
4709
4710
4711 #ifdef ___DIR_OPEN_PATH_CE_SELECT
4712
4713 ___SCMOBJ ___device_directory_setup
4714    ___P((___device_directory **dev,
4715          ___device_group *dgroup,
4716          ___STRING_TYPE(___DIR_OPEN_PATH_CE_SELECT) path,
4717          int ignore_hidden),
4718         (dev,
4719          dgroup,
4720          path,
4721          ignore_hidden)
4722 ___device_directory **dev;
4723 ___device_group *dgroup;
4724 ___STRING_TYPE(___DIR_OPEN_PATH_CE_SELECT) path;
4725 int ignore_hidden;)
4726 {
4727   ___device_directory *d;
4728
4729   d = ___CAST(___device_directory*,
4730               ___alloc_mem (sizeof (___device_directory)));
4731
4732   if (d == NULL)
4733     return ___FIX(___HEAP_OVERFLOW_ERR);
4734
4735   d->base.vtbl = &___device_directory_table;
4736   d->base.refcount = 1;
4737   d->base.direction = ___DIRECTION_RD;
4738   d->base.close_direction = 0; /* prevent closing on errors */
4739   d->base.read_stage = ___STAGE_OPEN;
4740   d->base.write_stage = ___STAGE_CLOSED;
4741
4742 #ifdef USE_opendir
4743
4744   d->ignore_hidden = ignore_hidden;
4745
4746   d->dir = opendir (path);
4747
4748   if (d->dir == NULL)
4749     {
4750       ___SCMOBJ e = fnf_or_err_code_from_errno ();
4751       ___free_mem (d);
4752       return e;
4753     }
4754
4755 #endif
4756
4757 #ifdef USE_FindFirstFile
4758
4759   {
4760     ___CHAR_TYPE(___DIR_OPEN_PATH_CE_SELECT) dir[___PATH_MAX_LENGTH+2+1];
4761     int i = 0;
4762
4763     while (path[i] != '\0' && i < ___PATH_MAX_LENGTH)
4764       {
4765         dir[i] = path[i];
4766         i++;
4767       }
4768
4769     if (i == 0 || (dir[i-1] != '\\' && dir[i-1] != '/'))
4770       dir[i++] = '\\';
4771
4772     dir[i++] = '*';
4773     dir[i++] = '\0';
4774
4775     d->ignore_hidden = ignore_hidden;
4776     d->first_file = 1;
4777
4778     d->h = FindFirstFile (dir, &d->fdata);
4779
4780     if (d->h == INVALID_HANDLE_VALUE)
4781       {
4782         ___SCMOBJ e = fnf_or_err_code_from_GetLastError ();
4783         ___free_mem (d);
4784         return e;
4785       }
4786   }
4787
4788 #endif
4789
4790   device_transfer_close_responsibility (___CAST(___device*,d));
4791
4792   *dev = d;
4793
4794   ___device_add_to_group (dgroup, &d->base);
4795
4796   return ___FIX(___NO_ERR);
4797 }
4798
4799 ___SCMOBJ ___device_directory_read
4800    ___P((___device_directory *dev,
4801          ___STRING_TYPE(___DIR_OPEN_PATH_CE_SELECT) *name),
4802         (dev,
4803          name)
4804 ___device_directory *dev;
4805 ___STRING_TYPE(___DIR_OPEN_PATH_CE_SELECT) *name;)
4806 {
4807   ___SCMOBJ e;
4808
4809   if (dev->base.read_stage != ___STAGE_OPEN)
4810     return ___FIX(___CLOSED_DEVICE_ERR);
4811
4812   for (;;)
4813     {
4814       ___STRING_TYPE(___DIR_OPEN_PATH_CE_SELECT) temp;
4815
4816 #ifdef USE_opendir
4817
4818       struct dirent *de = readdir (dev->dir);
4819
4820       if (de == NULL)
4821         {
4822 #if 0
4823           /* this seems to be broken, at least under Linux */
4824           if (errno != 0)
4825             return err_code_from_errno ();
4826 #endif
4827           *name = NULL;
4828           e = ___FIX(___NO_ERR);
4829           break;
4830         }
4831
4832       temp = de->d_name;
4833
4834       switch (dev->ignore_hidden)
4835         {
4836         default:
4837         case 2:
4838           if (temp[0] == '.')
4839             break;
4840
4841         case 1:
4842           if (temp[0] == '.' &&
4843               (temp[1] == '\0' ||
4844                (temp[1] == '.' && (temp[2] == '\0'))))
4845             break;
4846
4847         case 0:
4848           *name = temp;
4849           return ___FIX(___NO_ERR);
4850         }
4851
4852 #endif
4853
4854 #ifdef USE_FindFirstFile
4855
4856       if (dev->first_file)
4857         dev->first_file = 0;
4858       else if (!FindNextFile (dev->h, &dev->fdata))
4859         {
4860           e = err_code_from_GetLastError ();
4861           *name = NULL;
4862           if (e == ___FIX(___WIN32_ERR(ERROR_NO_MORE_FILES)))
4863             e = ___FIX(___NO_ERR);
4864           break;
4865         }
4866
4867       temp = dev->fdata.cFileName;
4868
4869       if (temp[0] == '\0')
4870         temp = dev->fdata.cAlternateFileName; /* use 8.3 name */
4871
4872       switch (dev->ignore_hidden)
4873         {
4874         default:
4875         case 2:
4876           if (dev->fdata.dwFileAttributes & FILE_ATTRIBUTE_HIDDEN)
4877             break;
4878
4879         case 1:
4880           if (temp[0] == '.' &&
4881               (temp[1] == '\0' ||
4882                (temp[1] == '.' && (temp[2] == '\0'))))
4883             break;
4884
4885         case 0:
4886           *name = temp;
4887           return ___FIX(___NO_ERR);
4888         }
4889
4890 #endif
4891     }
4892
4893   return e;
4894 }
4895
4896 #endif
4897
4898
4899 /*---------------------------------------------------------------------------*/
4900
4901 /* Event-queue device. */
4902
4903 typedef struct ___device_event_queue_struct
4904   {
4905     ___device base;
4906
4907     int index;
4908
4909 #ifdef USE_WIN32
4910
4911     DWORD event_mask;
4912
4913 #endif
4914   } ___device_event_queue;
4915
4916 typedef struct ___device_event_queue_vtbl_struct
4917   {
4918     ___device_vtbl base;
4919   } ___device_event_queue_vtbl;
4920
4921 ___HIDDEN int ___device_event_queue_kind
4922    ___P((___device *self),
4923         (self)
4924 ___device *self;)
4925 {
4926   return ___EVENT_QUEUE_KIND;
4927 }
4928
4929 ___HIDDEN ___SCMOBJ ___device_event_queue_close_virt
4930    ___P((___device *self,
4931          int direction),
4932         (self,
4933          direction)
4934 ___device *self;
4935 int direction;)
4936 {
4937   ___device_event_queue *d = ___CAST(___device_event_queue*,self);
4938
4939   if (d->base.read_stage == ___STAGE_CLOSED)
4940     return ___FIX(___NO_ERR);
4941
4942   if (direction & ___DIRECTION_RD)
4943     {
4944       d->base.read_stage = ___STAGE_CLOSED; /* avoid multiple closes */
4945     }
4946
4947   return ___FIX(___NO_ERR);
4948 }
4949
4950 ___HIDDEN ___SCMOBJ ___device_event_queue_select_virt
4951    ___P((___device *self,
4952          ___BOOL for_writing,
4953          int i,
4954          int pass,
4955          ___device_select_state *state),
4956         (self,
4957          for_writing,
4958          i,
4959          pass,
4960          state)
4961 ___device *self;
4962 ___BOOL for_writing;
4963 int i;
4964 int pass;
4965 ___device_select_state *state;)
4966 {
4967   ___device_event_queue *d = ___CAST(___device_event_queue*,self);
4968   int stage = (for_writing
4969                ? d->base.write_stage
4970                : d->base.read_stage);
4971
4972   if (pass == ___SELECT_PASS_1)
4973     {
4974       if (stage != ___STAGE_OPEN)
4975         state->timeout = ___time_mod.time_neg_infinity;
4976       else
4977         {
4978 #ifdef USE_WIN32
4979
4980           state->message_queue_mask = d->event_mask;
4981           state->message_queue_dev_pos = i;
4982
4983 #endif
4984         }
4985
4986       return ___FIX(___SELECT_SETUP_DONE);
4987     }
4988
4989   /* pass == ___SELECT_PASS_CHECK */
4990
4991   if (stage != ___STAGE_OPEN)
4992     state->devs[i] = NULL;
4993   else
4994     {
4995 #ifdef USE_WIN32
4996
4997       if (state->devs_next[i] != -1)
4998         state->devs[i] = NULL;
4999
5000 #endif
5001     }
5002
5003   return ___FIX(___NO_ERR);
5004 }
5005
5006 ___HIDDEN ___SCMOBJ ___device_event_queue_release_virt
5007    ___P((___device *self),
5008         (self)
5009 ___device *self;)
5010 {
5011   return ___FIX(___NO_ERR);
5012 }
5013
5014 ___HIDDEN ___SCMOBJ ___device_event_queue_force_output_virt
5015    ___P((___device *self,
5016          int level),
5017         (self,
5018          level)
5019 ___device *self;
5020 int level;)
5021 {
5022   return ___FIX(___NO_ERR);
5023 }
5024
5025 ___HIDDEN ___device_event_queue_vtbl ___device_event_queue_table =
5026 {
5027   {
5028     ___device_event_queue_kind,
5029     ___device_event_queue_select_virt,
5030     ___device_event_queue_release_virt,
5031     ___device_event_queue_force_output_virt,
5032     ___device_event_queue_close_virt
5033   }
5034 };
5035
5036
5037 ___SCMOBJ ___device_event_queue_setup
5038    ___P((___device_event_queue **dev,
5039          ___device_group *dgroup,
5040          ___SCMOBJ selector),
5041         (dev,
5042          dgroup,
5043          selector)
5044 ___device_event_queue **dev;
5045 ___device_group *dgroup;
5046 ___SCMOBJ selector;)
5047 {
5048   ___device_event_queue *d;
5049
5050   d = ___CAST(___device_event_queue*,
5051               ___alloc_mem (sizeof (___device_event_queue)));
5052
5053   if (d == NULL)
5054     return ___FIX(___HEAP_OVERFLOW_ERR);
5055
5056   d->base.vtbl = &___device_event_queue_table;
5057   d->base.refcount = 1;
5058   d->base.direction = ___DIRECTION_RD;
5059   d->base.close_direction = 0; /* prevent closing on errors */
5060   d->base.read_stage = ___STAGE_OPEN;
5061   d->base.write_stage = ___STAGE_CLOSED;
5062
5063 #ifdef USE_WIN32
5064
5065   d->event_mask = ___INT(selector);
5066
5067 #endif
5068
5069   *dev = d;
5070
5071   ___device_add_to_group (dgroup, &d->base);
5072
5073   return ___FIX(___NO_ERR);
5074 }
5075
5076
5077 ___HIDDEN ___SCMOBJ ___release_event
5078    ___P((void *x),
5079         (x)
5080 void *x;)
5081 {
5082   ___release_rc (x);
5083   return ___FIX(___NO_ERR);
5084 }
5085
5086
5087 ___SCMOBJ ___device_event_queue_read
5088    ___P((___device_event_queue *dev,
5089          ___SCMOBJ *event),
5090         (dev,
5091          event)
5092 ___device_event_queue *dev;
5093 ___SCMOBJ *event;)
5094 {
5095   if (dev->base.read_stage != ___STAGE_OPEN)
5096     return ___FIX(___CLOSED_DEVICE_ERR);
5097
5098 #ifdef USE_WIN32
5099
5100   {
5101     MSG *msg = ___CAST(MSG*, ___alloc_rc (sizeof (MSG)));
5102
5103     if (msg == 0)
5104       return ___FIX(___STOC_HEAP_OVERFLOW_ERR+___RETURN_POS);
5105
5106     if (GetQueueStatus (dev->event_mask) != 0 &&
5107         PeekMessage (msg,
5108                      NULL,        /* retrieve messages for window and thread */
5109                      0,           /* no constraint on the message type */
5110                      0,
5111                      PM_REMOVE))  /* remove message */
5112       return ___NONNULLPOINTER_to_SCMOBJ
5113               (___CAST(void*,msg),
5114                ___FAL,
5115                ___release_event,
5116                event,
5117                ___RETURN_POS);
5118
5119     ___release_rc (msg);
5120   }
5121
5122 #endif
5123
5124   return ___ERR_CODE_EAGAIN;
5125 }
5126
5127
5128 /*---------------------------------------------------------------------------*/
5129
5130 /* File stream device */
5131
5132 typedef struct ___device_file_struct
5133   {
5134     ___device_stream base;
5135
5136 #ifndef USE_POSIX
5137 #ifndef USE_WIN32
5138
5139     ___FILE *stream;
5140
5141 #endif
5142 #endif
5143
5144 #ifdef USE_POSIX
5145     int fd;
5146 #endif
5147
5148 #ifdef USE_WIN32
5149     HANDLE h;
5150     int flags;
5151 #endif
5152   } ___device_file;
5153
5154 typedef struct ___device_file_vtbl_struct
5155   {
5156     ___device_stream_vtbl base;
5157   } ___device_file_vtbl;
5158
5159 ___HIDDEN int ___device_file_kind
5160    ___P((___device *self),
5161         (self)
5162 ___device *self;)
5163 {
5164   return ___FILE_DEVICE_KIND;
5165 }
5166
5167 #if 0
5168
5169 ___HIDDEN void ___device_file_restore_initial_mode
5170    ___P((___device_file *d),
5171         (d)
5172 ___device_file *d;)
5173 {
5174 #ifdef USE_POSIX
5175
5176   /* set blocking mode */
5177
5178   set_fd_blocking_mode (d->fd, 1); /* ignore error */
5179
5180 #endif
5181 }
5182
5183 #endif
5184
5185 ___HIDDEN ___SCMOBJ ___device_file_close_raw_virt
5186    ___P((___device_stream *self,
5187          int direction),
5188         (self,
5189          direction)
5190 ___device_stream *self;
5191 int direction;)
5192 {
5193   ___device_file *d = ___CAST(___device_file*,self);
5194   int is_not_closed = 0;
5195
5196   if (d->base.base.read_stage != ___STAGE_CLOSED)
5197     is_not_closed |= ___DIRECTION_RD;
5198
5199   if (d->base.base.write_stage != ___STAGE_CLOSED)
5200     is_not_closed |= ___DIRECTION_WR;
5201
5202   if (is_not_closed == 0)
5203     return ___FIX(___NO_ERR);
5204
5205   if ((is_not_closed & ~direction) == 0)
5206     {
5207       /* Close file when both sides are closed. */
5208
5209       d->base.base.read_stage = ___STAGE_CLOSED; /* avoid multiple closes */
5210       d->base.base.write_stage = ___STAGE_CLOSED;
5211
5212       if ((d->base.base.close_direction & d->base.base.direction)
5213           == d->base.base.direction)
5214         {
5215 #if 0
5216           ___device_file_restore_initial_mode (d);
5217 #endif
5218
5219 #ifndef USE_POSIX
5220 #ifndef USE_WIN32
5221
5222           if (d->stream != 0)
5223             if (___fclose (d->stream) != 0)
5224               return err_code_from_errno ();
5225
5226 #endif
5227 #endif
5228
5229 #ifdef USE_POSIX
5230           if (close_no_EINTR (d->fd) < 0)
5231             return err_code_from_errno ();
5232 #endif
5233
5234 #ifdef USE_WIN32
5235           if (!CloseHandle (d->h))
5236             return err_code_from_GetLastError ();
5237 #endif
5238         }
5239     }
5240   else if (is_not_closed & direction & ___DIRECTION_RD)
5241     d->base.base.read_stage = ___STAGE_CLOSED;
5242   else if (is_not_closed & direction & ___DIRECTION_WR)
5243     d->base.base.write_stage = ___STAGE_CLOSED;
5244
5245   return ___FIX(___NO_ERR);
5246 }
5247
5248 ___HIDDEN ___SCMOBJ ___device_file_select_raw_virt
5249    ___P((___device_stream *self,
5250          ___BOOL for_writing,
5251          int i,
5252          int pass,
5253          ___device_select_state *state),
5254         (self,
5255          for_writing,
5256          i,
5257          pass,
5258          state)
5259 ___device_stream *self;
5260 ___BOOL for_writing;
5261 int i;
5262 int pass;
5263 ___device_select_state *state;)
5264 {
5265   ___device_file *d = ___CAST(___device_file*,self);
5266   int stage = (for_writing
5267                ? d->base.base.write_stage
5268                : d->base.base.read_stage);
5269
5270   if (pass == ___SELECT_PASS_1)
5271     {
5272       if (stage != ___STAGE_OPEN)
5273         state->timeout = ___time_mod.time_neg_infinity;
5274       else
5275         {
5276 #ifndef USE_POSIX
5277 #ifndef USE_WIN32
5278
5279         state->timeout = ___time_mod.time_neg_infinity;
5280
5281 #endif
5282 #endif
5283
5284 #ifdef USE_POSIX
5285           ___device_select_add_fd (state, d->fd, for_writing);
5286 #endif
5287         }
5288       return ___FIX(___SELECT_SETUP_DONE);
5289     }
5290
5291   /* pass == ___SELECT_PASS_CHECK */
5292
5293   if (stage != ___STAGE_OPEN)
5294     state->devs[i] = NULL;
5295   else
5296     {
5297 #ifndef USE_POSIX
5298 #ifndef USE_WIN32
5299
5300       state->devs[i] = NULL;
5301
5302 #endif
5303 #endif
5304
5305 #ifdef USE_POSIX
5306
5307       if (for_writing
5308            ? FD_ISSET(d->fd, &state->writefds)
5309            : FD_ISSET(d->fd, &state->readfds))
5310         state->devs[i] = NULL;
5311
5312 #endif
5313
5314 #ifdef USE_WIN32
5315
5316       if (state->devs_next[i] != -1)
5317         state->devs[i] = NULL;
5318
5319 #endif
5320     }
5321
5322   return ___FIX(___NO_ERR);
5323 }
5324
5325 ___HIDDEN ___SCMOBJ ___device_file_release_raw_virt
5326    ___P((___device_stream *self),
5327         (self)
5328 ___device_stream *self;)
5329 {
5330 #if 0
5331
5332   ___device_file *d = ___CAST(___device_file*,self);
5333
5334   if (d->base.base.read_stage != ___STAGE_CLOSED ||
5335       d->base.base.write_stage != ___STAGE_CLOSED)
5336     ___device_file_restore_initial_mode (d);
5337
5338 #endif
5339
5340   return ___FIX(___NO_ERR);
5341 }
5342
5343 ___HIDDEN ___SCMOBJ ___device_file_force_output_raw_virt
5344    ___P((___device_stream *self,
5345          int level),
5346         (self,
5347          level)
5348 ___device_stream *self;
5349 int level;)
5350 {
5351   ___device_file *d = ___CAST(___device_file*,self);
5352
5353   if (d->base.base.write_stage == ___STAGE_OPEN)
5354     {
5355 #ifndef USE_POSIX
5356 #ifndef USE_WIN32
5357
5358       if (level > 0)
5359         {
5360           ___FILE *stream = d->stream;
5361
5362           if (stream == 0)
5363             stream = ___stdout;
5364
5365           ___fflush (stream); /* ignore error */
5366         }
5367
5368 #endif
5369 #endif
5370
5371 #ifdef USE_POSIX
5372
5373       switch (level)
5374         {
5375         case 2:
5376         case 3:
5377
5378 #ifdef F_FULLFSYNC
5379
5380           if (fcntl (d->fd, F_FULLFSYNC, 0) < 0)
5381             return err_code_from_errno ();
5382           break;
5383
5384 #endif
5385
5386         case 1:
5387
5388           if (fsync (d->fd) < 0)
5389             return err_code_from_errno ();
5390           break;
5391
5392         }
5393
5394 #endif
5395     }
5396
5397   return ___FIX(___NO_ERR);
5398 }
5399
5400 ___HIDDEN ___SCMOBJ ___device_file_seek_raw_virt
5401    ___P((___device_stream *self,
5402          ___stream_index *pos,
5403          int whence),
5404         (self,
5405          pos,
5406          whence)
5407 ___device_stream *self;
5408 ___stream_index *pos;
5409 int whence;)
5410 {
5411   ___device_file *d = ___CAST(___device_file*,self);
5412
5413   if (d->base.base.read_stage == ___STAGE_OPEN ||
5414       d->base.base.write_stage == ___STAGE_OPEN)
5415     {
5416 #ifndef USE_POSIX
5417 #ifndef USE_WIN32
5418
5419       int new_pos;
5420       ___FILE *stream = d->stream;
5421
5422       if (stream == 0)
5423         stream = ___stdout;
5424
5425       if (fseek (stream, *pos, whence) < 0 ||
5426           (new_pos = ftell (stream)) < 0)
5427         return err_code_from_errno ();
5428
5429       *pos = new_pos;
5430
5431 #endif
5432 #endif
5433
5434 #ifdef USE_POSIX
5435
5436       int new_pos;
5437
5438       if ((new_pos = lseek (d->fd, *pos, whence)) < 0)
5439         return err_code_from_errno ();
5440
5441       *pos = new_pos;
5442
5443 #endif
5444
5445 #ifdef USE_WIN32
5446
5447       LARGE_INTEGER new_pos;
5448
5449       new_pos.QuadPart = *pos;
5450
5451       new_pos.LowPart = SetFilePointer (d->h,
5452                                         new_pos.LowPart,
5453                                         &new_pos.HighPart,
5454                                         whence);
5455
5456       if (new_pos.LowPart == 0xFFFFFFFF
5457           && GetLastError () != NO_ERROR)
5458         return err_code_from_GetLastError ();
5459
5460       *pos = new_pos.LowPart;  /************* incomplete... support large offsets */
5461
5462 #endif
5463     }
5464
5465   return ___FIX(___NO_ERR);
5466 }
5467
5468 ___HIDDEN ___SCMOBJ ___device_file_read_raw_virt
5469    ___P((___device_stream *self,
5470          ___U8 *buf,
5471          ___stream_index len,
5472          ___stream_index *len_done),
5473         (self,
5474          buf,
5475          len,
5476          len_done)
5477 ___device_stream *self;
5478 ___U8 *buf;
5479 ___stream_index len;
5480 ___stream_index *len_done;)
5481 {
5482   ___device_file *d = ___CAST(___device_file*,self);
5483
5484   if (d->base.base.read_stage != ___STAGE_OPEN)
5485     return ___FIX(___CLOSED_DEVICE_ERR);
5486
5487 #ifndef USE_POSIX
5488 #ifndef USE_WIN32
5489
5490   {
5491     int n;
5492     ___FILE *stream = d->stream;
5493
5494     if (stream == 0)
5495       stream = ___stdin;
5496
5497     if (stream == ___stdin)
5498       len = 1; /* only read 1 byte at a time to prevent blocking on tty */
5499
5500     if ((n = fread (buf, 1, len, stream)) == 0)
5501       {
5502         if (ferror (stream))
5503           {
5504             clearerr (stream);
5505             return ___FIX(___UNKNOWN_ERR);
5506           }
5507         clearerr (stream);
5508       }
5509
5510     *len_done = n;
5511   }
5512
5513 #endif
5514 #endif
5515
5516 #ifdef USE_POSIX
5517
5518   {
5519     int n;
5520
5521     if ((n = read (d->fd, buf, len)) < 0)
5522       return err_code_from_errno ();
5523
5524     *len_done = n;
5525   }
5526
5527 #endif
5528
5529 #ifdef USE_WIN32
5530
5531   {
5532     DWORD n;
5533
5534     if (!ReadFile (d->h, buf, len, &n, NULL))
5535       return err_code_from_GetLastError ();
5536
5537     *len_done = n;
5538   }
5539
5540 #endif
5541
5542   return ___FIX(___NO_ERR);
5543 }
5544
5545 ___HIDDEN ___SCMOBJ ___device_file_write_raw_virt
5546    ___P((___device_stream *self,
5547          ___U8 *buf,
5548          ___stream_index len,
5549          ___stream_index *len_done),
5550         (self,
5551          buf,
5552          len,
5553          len_done)
5554 ___device_stream *self;
5555 ___U8 *buf;
5556 ___stream_index len;
5557 ___stream_index *len_done;)
5558 {
5559   ___device_file *d = ___CAST(___device_file*,self);
5560
5561   if (d->base.base.write_stage != ___STAGE_OPEN)
5562     return ___FIX(___CLOSED_DEVICE_ERR);
5563
5564 #ifndef USE_POSIX
5565 #ifndef USE_WIN32
5566
5567   {
5568     int n;
5569     ___FILE *stream = d->stream;
5570
5571     if (stream == 0)
5572       stream = ___stdout;
5573
5574     if ((n = fwrite (buf, 1, len, stream)) == 0)
5575       {
5576         if (ferror (stream))
5577           {
5578             clearerr (stream);
5579             return ___FIX(___UNKNOWN_ERR);
5580           }
5581       }
5582
5583     *len_done = n;
5584   }
5585
5586 #endif
5587 #endif
5588
5589 #ifdef USE_POSIX
5590
5591   {
5592     int n;
5593
5594     if ((n = write (d->fd, buf, len)) < 0)
5595       return err_code_from_errno ();
5596
5597     *len_done = n;
5598   }
5599
5600 #endif
5601
5602 #ifdef USE_WIN32
5603
5604   {
5605     DWORD n;
5606
5607     if (d->flags & (1 << 3))
5608       {
5609         ___stream_index pos = 0; /* end of file */
5610         ___SCMOBJ e = ___device_file_seek_raw_virt (self, &pos, FILE_END);
5611         if (e != ___FIX(___NO_ERR))
5612           return e;
5613       }
5614
5615     if (!WriteFile (d->h, buf, len, &n, NULL))
5616       return err_code_from_GetLastError ();
5617
5618     *len_done = n;
5619   }
5620
5621 #endif
5622
5623   return ___FIX(___NO_ERR);
5624 }
5625
5626
5627 ___HIDDEN ___SCMOBJ ___device_file_width_virt
5628    ___P((___device_stream *self),
5629         (self)
5630 ___device_stream *self;)
5631 {
5632   return ___FIX(80);
5633 }
5634
5635
5636 ___HIDDEN ___SCMOBJ ___device_file_default_options_virt
5637    ___P((___device_stream *self),
5638         (self)
5639 ___device_stream *self;)
5640 {
5641   int settings = ___setup_params.file_settings;
5642   int char_encoding_errors = ___CHAR_ENCODING_ERRORS(settings);
5643   int char_encoding = ___CHAR_ENCODING(settings);
5644   int eol_encoding = ___EOL_ENCODING(settings);
5645   int buffering = ___BUFFERING(settings);
5646
5647   if (char_encoding_errors == 0)
5648     char_encoding_errors = ___CHAR_ENCODING_ERRORS_ON;
5649
5650   if (char_encoding == 0)
5651     char_encoding = ___CHAR_ENCODING_ISO_8859_1;
5652
5653   if (eol_encoding == 0)
5654     eol_encoding = ___EOL_ENCODING_LF;
5655
5656 #ifdef USE_WIN32
5657
5658   if (buffering == 0)
5659     {
5660       ___device_file *d = ___CAST(___device_file*,self);
5661
5662       if (GetFileType (d->h) == FILE_TYPE_PIPE)
5663         buffering = ___NO_BUFFERING;
5664       else
5665         buffering = ___FULL_BUFFERING;
5666     }
5667
5668 #else
5669
5670   if (buffering == 0)
5671     buffering = ___FULL_BUFFERING;
5672
5673 #endif
5674
5675 #ifdef ___DEBUG
5676
5677   ___printf ("file char_encoding_errors=%d   char_encoding=%d   eol_encoding=%d   buffering=%d\n",
5678              char_encoding_errors,
5679              char_encoding,
5680              eol_encoding,
5681              buffering);
5682
5683 #endif
5684
5685   return ___FIX(___STREAM_OPTIONS(char_encoding_errors,
5686                                   char_encoding,
5687                                   eol_encoding,
5688                                   buffering,
5689                                   char_encoding_errors,
5690                                   char_encoding,
5691                                   eol_encoding,
5692                                   buffering));
5693 }
5694
5695
5696 ___HIDDEN ___SCMOBJ ___device_file_options_set_virt
5697    ___P((___device_stream *self,
5698          ___SCMOBJ options),
5699         (self,
5700          options)
5701 ___device_stream *self;
5702 ___SCMOBJ options;)
5703 {
5704   return ___FIX(___NO_ERR);
5705 }
5706
5707
5708 ___HIDDEN ___device_file_vtbl ___device_file_table =
5709 {
5710   {
5711     {
5712       ___device_file_kind,
5713       ___device_stream_select_virt,
5714       ___device_stream_release_virt,
5715       ___device_stream_force_output_virt,
5716       ___device_stream_close_virt
5717     },
5718     ___device_file_select_raw_virt,
5719     ___device_file_release_raw_virt,
5720     ___device_file_force_output_raw_virt,
5721     ___device_file_close_raw_virt,
5722     ___device_file_seek_raw_virt,
5723     ___device_file_read_raw_virt,
5724     ___device_file_write_raw_virt,
5725     ___device_file_width_virt,
5726     ___device_file_default_options_virt,
5727     ___device_file_options_set_virt
5728   }
5729 };
5730
5731
5732 #ifndef USE_POSIX
5733 #ifndef USE_WIN32
5734
5735 ___HIDDEN ___SCMOBJ ___device_file_setup_from_stream
5736    ___P((___device_file **dev,
5737          ___device_group *dgroup,
5738          ___FILE *stream,
5739          int direction),
5740         (dev,
5741          dgroup,
5742          stream,
5743          direction)
5744 ___device_file **dev;
5745 ___device_group *dgroup;
5746 ___FILE *stream;
5747 int direction;)
5748 {
5749   ___device_file *d;
5750
5751   d = ___CAST(___device_file*,
5752               ___alloc_mem (sizeof (___device_file)));
5753
5754   if (d == NULL)
5755     return ___FIX(___HEAP_OVERFLOW_ERR);
5756
5757   d->base.base.vtbl = &___device_file_table;
5758   d->stream = stream;
5759
5760   *dev = d;
5761
5762   return ___device_stream_setup
5763            (&d->base,
5764             dgroup,
5765             direction,
5766             0);
5767 }
5768
5769 #endif
5770 #endif
5771
5772
5773 #ifdef USE_POSIX
5774
5775 ___HIDDEN ___SCMOBJ ___device_file_setup_from_fd
5776    ___P((___device_file **dev,
5777          ___device_group *dgroup,
5778          int fd,
5779          int direction),
5780         (dev,
5781          dgroup,
5782          fd,
5783          direction)
5784 ___device_file **dev;
5785 ___device_group *dgroup;
5786 int fd;
5787 int direction;)
5788 {
5789   ___device_file *d;
5790
5791   d = ___CAST(___device_file*,
5792               ___alloc_mem (sizeof (___device_file)));
5793
5794   if (d == NULL)
5795     return ___FIX(___HEAP_OVERFLOW_ERR);
5796
5797   d->base.base.vtbl = &___device_file_table;
5798   d->fd = fd;
5799
5800   *dev = d;
5801
5802   return ___device_stream_setup
5803            (&d->base,
5804             dgroup,
5805             direction,
5806             0);
5807 }
5808
5809 #endif
5810
5811
5812 #ifdef USE_WIN32
5813
5814 ___HIDDEN ___SCMOBJ ___device_file_setup_from_handle
5815    ___P((___device_file **dev,
5816          ___device_group *dgroup,
5817          HANDLE h,
5818          int flags,
5819          int direction,
5820          int pumps_on),
5821         (dev,
5822          dgroup,
5823          h,
5824          flags,
5825          direction,
5826          pumps_on)
5827 ___device_file **dev;
5828 ___device_group *dgroup;
5829 HANDLE h;
5830 int flags;
5831 int direction;
5832 int pumps_on;)
5833 {
5834   ___device_file *d;
5835
5836   d = ___CAST(___device_file*,
5837               ___alloc_mem (sizeof (___device_file)));
5838
5839   if (d == NULL)
5840     return ___FIX(___HEAP_OVERFLOW_ERR);
5841
5842   d->base.base.vtbl = &___device_file_table;
5843   d->h = h;
5844   d->flags = flags;
5845
5846   *dev = d;
5847
5848   return ___device_stream_setup
5849            (&d->base,
5850             dgroup,
5851             direction,
5852             pumps_on);
5853 }
5854
5855 #endif
5856
5857
5858 /*---------------------------------------------------------------------------*/
5859
5860 #ifndef USE_POSIX
5861 #ifndef USE_WIN32
5862
5863 ___SCMOBJ ___device_stream_setup_from_stream
5864    ___P((___device_stream **dev,
5865          ___device_group *dgroup,
5866          ___FILE *stream,
5867          int kind,
5868          int direction),
5869         (dev,
5870          dgroup,
5871          ___FILE *stream,
5872          kind,
5873          direction)
5874 ___device_stream **dev;
5875 ___device_group *dgroup;
5876 ___FILE *stream;
5877 int kind;
5878 int direction;)
5879 {
5880   ___SCMOBJ e;
5881   ___device_file *d;
5882
5883   if ((e = ___device_file_setup_from_stream
5884              (&d,
5885               dgroup,
5886               stream,
5887               direction))
5888       == ___FIX(___NO_ERR))
5889     *dev = ___CAST(___device_stream*,d);
5890
5891   return e;
5892 }
5893
5894
5895 ___HIDDEN void device_translate_flags
5896    ___P((int flags,
5897          char **mode,
5898          int *direction),
5899         (flags,
5900          mode,
5901          direction)
5902 int flags;
5903 char **mode;
5904 int *direction;)
5905 {
5906   switch ((flags >> 4) & 3)
5907     {
5908     default:
5909     case 1:
5910       *mode = "rb";
5911       *direction = ___DIRECTION_RD;
5912       break;
5913     case 2:
5914       *mode = "wb";
5915       *direction = ___DIRECTION_WR;
5916       break;
5917     case 3:
5918       *mode = "w+b";
5919       *direction = ___DIRECTION_RD|___DIRECTION_WR;
5920       break;
5921     }
5922 }
5923
5924 #endif
5925 #endif
5926
5927
5928 #ifdef USE_POSIX
5929
5930 ___HIDDEN int ___device_stream_kind_from_fd
5931    ___P((int fd),
5932         (fd)
5933 int fd;)
5934 {
5935   /*
5936    * Determine what kind of device is attached to the file descriptor
5937    * (tty, socket, or regular file).
5938    */
5939
5940   if (isatty (fd))
5941     return ___TTY_DEVICE_KIND;
5942
5943 #ifdef USE_stat
5944
5945   {
5946     ___struct_stat s;
5947
5948     if (___fstat (fd, &s) < 0)
5949       return ___NONE_KIND;
5950
5951     if (S_ISREG(s.st_mode))
5952       return ___FILE_DEVICE_KIND;
5953
5954 #if 0
5955
5956     if (S_ISDIR(s.st_mode))
5957       return ???;
5958
5959     if (S_ISLNK(s.st_mode))
5960       return ???;
5961
5962 #endif
5963
5964     if (S_ISCHR(s.st_mode))
5965       return ___FILE_DEVICE_KIND;
5966
5967     if (S_ISBLK(s.st_mode))
5968       return ___FILE_DEVICE_KIND;
5969
5970     if (S_ISFIFO(s.st_mode))
5971       return ___FILE_DEVICE_KIND;
5972
5973 #ifdef USE_NETWORKING
5974     if (S_ISSOCK(s.st_mode))
5975       return ___TCP_CLIENT_DEVICE_KIND;
5976 #endif
5977   }
5978
5979   return ___NONE_KIND;
5980
5981 #else
5982
5983   return ___FILE_DEVICE_KIND;
5984
5985 #endif
5986 }
5987
5988
5989 ___HIDDEN int ___device_stream_direction_from_fd
5990    ___P((int fd),
5991         (fd)
5992 int fd;)
5993 {
5994   int direction = ___DIRECTION_RD|___DIRECTION_WR;
5995   char buf[1];
5996
5997   /*
5998    * A "read" and "write" of 0 bytes is attempted to tell which
5999    * directions the file descriptor supports.
6000    */
6001
6002   if (read (fd, buf, 0) < 0)
6003     direction &= ~___DIRECTION_RD;
6004
6005   if (write (fd, buf, 0) < 0)
6006     direction &= ~___DIRECTION_WR;
6007
6008   /*
6009    * It is likely that on some systems a zero length "read" and
6010    * "write" will return an error, regardless of the possible
6011    * operations.  In this case assume that both operations are
6012    * possible.
6013    */
6014
6015   if (direction == 0)
6016     direction = ___DIRECTION_RD|___DIRECTION_WR;
6017
6018   return direction;
6019 }
6020
6021
6022 ___SCMOBJ ___device_stream_setup_from_fd
6023    ___P((___device_stream **dev,
6024          ___device_group *dgroup,
6025          int fd,
6026          int kind,
6027          int direction),
6028         (dev,
6029          dgroup,
6030          fd,
6031          kind,
6032          direction)
6033 ___device_stream **dev;
6034 ___device_group *dgroup;
6035 int fd;
6036 int kind;
6037 int direction;)
6038 {
6039   ___SCMOBJ e = ___FIX(___UNKNOWN_ERR);
6040
6041   if (kind == ___NONE_KIND)
6042     kind = ___device_stream_kind_from_fd (fd);
6043
6044   if (direction == 0)
6045     direction = ___device_stream_direction_from_fd (fd);
6046
6047 #ifdef ___DEBUG
6048   ___printf ("fd=%d kind=%d direction=%d\n", fd, kind, direction);
6049 #endif
6050
6051   if (kind == ___TTY_DEVICE_KIND)
6052     {
6053       /*
6054        * No need to setup the file descriptor to perform nonblocking
6055        * I/O because that is done by os_tty.c in a way that restores
6056        * the blocking mode to its original mode when the process
6057        * exits.  Restoring the original mode avoids some issues when
6058        * running under a shell in emacs (which gives a "Process
6059        * shell finished" error when the program terminates).
6060        */
6061
6062       ___device_tty *d;
6063
6064       if ((e = ___device_tty_setup_from_fd
6065                  (&d,
6066                   dgroup,
6067                   fd,
6068                   direction))
6069           == ___FIX(___NO_ERR))
6070         *dev = ___CAST(___device_stream*,d);
6071     }
6072   else
6073     {
6074       /*
6075        * Setup file descriptor to perform nonblocking I/O.
6076        */
6077
6078       if (set_fd_blocking_mode (fd, 0) != 0) /* set nonblocking mode */
6079         return err_code_from_errno ();
6080
6081       switch (kind)
6082         {
6083
6084 #ifdef USE_NETWORKING
6085
6086         case ___TCP_CLIENT_DEVICE_KIND:
6087           {
6088             ___device_tcp_client *d;
6089             struct sockaddr server_addr;
6090             if ((e = ___device_tcp_client_setup_from_socket
6091                        (&d,
6092                         dgroup,
6093                         fd,
6094                         &server_addr,
6095                         0,
6096                         0,
6097                         direction))
6098                 == ___FIX(___NO_ERR))
6099               *dev = ___CAST(___device_stream*,d);
6100             break;
6101           }
6102
6103 #endif
6104
6105         case ___FILE_DEVICE_KIND:
6106           {
6107             ___device_file *d;
6108             if ((e = ___device_file_setup_from_fd
6109                        (&d,
6110                         dgroup,
6111                         fd,
6112                         direction))
6113                 == ___FIX(___NO_ERR))
6114               *dev = ___CAST(___device_stream*,d);
6115             break;
6116           }
6117
6118         default:
6119           {
6120             e = ___FIX(___UNKNOWN_ERR);
6121             break;
6122           }
6123         }
6124     }
6125
6126   return e;
6127 }
6128
6129
6130 ___HIDDEN void device_translate_flags
6131    ___P((int flags,
6132          int *fl,
6133          int *direction),
6134         (flags,
6135          fl,
6136          direction)
6137 int flags;
6138 int *fl;
6139 int *direction;)
6140 {
6141   int f;
6142
6143   switch ((flags >> 4) & 3)
6144     {
6145     default:
6146     case 1:
6147       f = O_RDONLY;
6148       *direction = ___DIRECTION_RD;
6149       break;
6150     case 2:
6151       f = O_WRONLY;
6152       *direction = ___DIRECTION_WR;
6153       break;
6154     case 3:
6155       f = O_RDWR;
6156       *direction = ___DIRECTION_RD|___DIRECTION_WR;
6157       break;
6158     }
6159
6160   if (flags & (1 << 3))
6161     f |= O_APPEND;
6162
6163   switch ((flags >> 1) & 3)
6164     {
6165     default:
6166     case 0: break;
6167     case 1: f |= O_CREAT; break;
6168     case 2: f |= O_CREAT|O_EXCL; break;
6169     }
6170
6171   if (flags & 1)
6172     f |= O_TRUNC;
6173
6174   /*
6175    * The O_NONBLOCK flag is not needed here because the file
6176    * descriptor will be set to nonblocking mode later on.  But we do
6177    * it anyway so there is no moment in time when it is in blocking
6178    * mode.
6179    */
6180
6181   f |= O_NONBLOCK;
6182
6183   *fl = f;
6184 }
6185
6186 #endif
6187
6188
6189 #ifdef USE_WIN32
6190
6191 ___HIDDEN int ___device_stream_kind_from_handle
6192    ___P((HANDLE h),
6193         (h)
6194 HANDLE h;)
6195 {
6196   DWORD n;
6197   CONSOLE_CURSOR_INFO cinfo;
6198   DCB dcb;
6199   BY_HANDLE_FILE_INFORMATION finfo;
6200
6201 #ifdef ___DEBUG
6202   ___printf ("GetFileType -> %d\n", ___CAST(int,GetFileType (h)));
6203 #endif
6204
6205   if (GetNumberOfConsoleInputEvents (h, &n))
6206     return ___TTY_DEVICE_KIND;
6207
6208   if (GetConsoleCursorInfo (h, &cinfo))
6209     return ___TTY_DEVICE_KIND;
6210
6211   if (GetCommState (h, &dcb))
6212     return ___SERIAL_DEVICE_KIND;
6213
6214   if (GetFileType (h) == FILE_TYPE_PIPE)
6215     return ___PIPE_DEVICE_KIND;
6216
6217   if (GetFileInformationByHandle (h, &finfo))
6218     return ___FILE_DEVICE_KIND;
6219
6220   return ___NONE_KIND;
6221 }
6222
6223
6224 ___HIDDEN int ___device_stream_direction_from_handle
6225    ___P((HANDLE h),
6226         (h)
6227 HANDLE h;)
6228 {
6229   DWORD n;
6230   int direction = ___DIRECTION_RD|___DIRECTION_WR;
6231
6232   /*
6233    * A "ReadFile" and "WriteFile" of 0 bytes is attempted to tell which
6234    * directions the file handle supports.
6235    */
6236
6237   if (!ReadFile (h, NULL, 0, &n, NULL))
6238     direction &= ~___DIRECTION_RD;
6239
6240   if (!WriteFile (h, NULL, 0, &n, NULL))
6241     direction &= ~___DIRECTION_WR;
6242
6243   /*
6244    * It is likely that on some systems a zero length "ReadFile" and
6245    * "WriteFile" will return an error, regardless of the possible
6246    * operations.  In this case assume that both operations are
6247    * possible.
6248    */
6249
6250   if (direction == 0)
6251     direction = ___DIRECTION_RD|___DIRECTION_WR;
6252
6253   return direction;
6254 }
6255
6256
6257 ___SCMOBJ ___device_stream_setup_from_handle
6258    ___P((___device_stream **dev,
6259          ___device_group *dgroup,
6260          HANDLE h,
6261          int flags,
6262          int kind,
6263          int direction),
6264         (dev,
6265          dgroup,
6266          h,
6267          flags,
6268          kind,
6269          direction)
6270 ___device_stream **dev;
6271 ___device_group *dgroup;
6272 HANDLE h;
6273 int flags;
6274 int kind;
6275 int direction;)
6276 {
6277   ___SCMOBJ e = ___FIX(___UNKNOWN_ERR);
6278
6279   if (kind == ___NONE_KIND)
6280     kind = ___device_stream_kind_from_handle (h);
6281
6282   if (direction == 0)
6283     direction = ___device_stream_direction_from_handle (h);
6284
6285 #ifdef ___DEBUG
6286   ___printf ("kind=%d direction=%d\n", kind, direction);
6287 #endif
6288
6289   switch (kind)
6290     {
6291     case ___TTY_DEVICE_KIND:
6292       {
6293         ___device_tty *d;
6294         if ((e = ___device_tty_setup_from_console
6295                    (&d,
6296                     dgroup,
6297                     direction))
6298             == ___FIX(___NO_ERR))
6299           *dev = ___CAST(___device_stream*,d);
6300         break;
6301       }
6302
6303     case ___SERIAL_DEVICE_KIND:
6304       {
6305         ___device_serial *d;
6306         if ((e = ___device_serial_setup_from_handle
6307                    (&d,
6308                     dgroup,
6309                     h,
6310                     direction))
6311             == ___FIX(___NO_ERR))
6312           *dev = ___CAST(___device_stream*,d);
6313         break;
6314       }
6315
6316     case ___FILE_DEVICE_KIND:
6317       {
6318         ___device_file *d;
6319         if ((e = ___device_file_setup_from_handle
6320                    (&d,
6321                     dgroup,
6322                     h,
6323                     flags,
6324                     direction,
6325                     0))
6326             == ___FIX(___NO_ERR))
6327           *dev = ___CAST(___device_stream*,d);
6328         break;
6329       }
6330
6331     case ___PIPE_DEVICE_KIND:
6332       {
6333         ___device_pipe *d;
6334         if ((e = ___device_pipe_setup_from_handle
6335                    (&d,
6336                     dgroup,
6337                     h,
6338                     h,
6339                     direction,
6340                     0))
6341             == ___FIX(___NO_ERR))
6342           *dev = ___CAST(___device_stream*,d);
6343         break;
6344       }
6345
6346     default:
6347       {
6348         e = ___FIX(___UNKNOWN_ERR);
6349         break;
6350       }
6351     }
6352
6353   if (e == ___FIX(___NO_ERR))
6354     device_transfer_close_responsibility (___CAST(___device*,*dev));
6355
6356   return e;
6357 }
6358
6359
6360 ___HIDDEN void device_translate_flags
6361    ___P((int flags,
6362          DWORD *access_mode,
6363          DWORD *share_mode,
6364          DWORD *creation_mode,
6365          DWORD *attributes,
6366          int *direction),
6367         (flags,
6368          access_mode,
6369          share_mode,
6370          creation_mode,
6371          attributes,
6372          direction)
6373 int flags;
6374 DWORD *access_mode;
6375 DWORD *share_mode;
6376 DWORD *creation_mode;
6377 DWORD *attributes;
6378 int *direction;)
6379 {
6380   DWORD am;
6381   DWORD cm;
6382
6383   switch ((flags >> 4) & 3)
6384     {
6385     default:
6386     case 1:
6387       am = GENERIC_READ;
6388       *direction = ___DIRECTION_RD;
6389       break;
6390     case 2:
6391       am = GENERIC_WRITE;
6392       *direction = ___DIRECTION_WR;
6393       break;
6394     case 3:
6395       am = GENERIC_READ|GENERIC_WRITE;
6396       *direction = ___DIRECTION_RD|___DIRECTION_WR;
6397       break;
6398     }
6399
6400   switch ((flags >> 1) & 3)
6401     {
6402     default:
6403     case 0:
6404       if (flags & 1)
6405         cm = TRUNCATE_EXISTING;
6406       else
6407         cm = OPEN_EXISTING;
6408       break;
6409
6410     case 1:
6411       if (flags & 1)
6412         cm = CREATE_ALWAYS;
6413       else
6414         cm = OPEN_ALWAYS;
6415       break;
6416
6417     case 2:
6418       cm = CREATE_NEW;
6419       break;
6420     }
6421
6422   *access_mode = am;
6423   *share_mode = FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE;
6424   *creation_mode = cm;
6425   *attributes = FILE_ATTRIBUTE_NORMAL;
6426 }
6427
6428 #endif
6429
6430
6431 /*---------------------------------------------------------------------------*/
6432
6433 #ifdef USE_execvp
6434 #define ___STREAM_OPEN_PROCESS_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
6435 #ifndef USE_openpty
6436 #ifndef USE_ptsname
6437 #undef ___STREAM_OPEN_PROCESS_CE_SELECT
6438 #endif
6439 #endif
6440 #endif
6441
6442 #ifdef USE_CreateProcess
6443 #ifdef _UNICODE
6444 #define ___STREAM_OPEN_PROCESS_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
6445 #define CP_ENV_FLAGS CREATE_UNICODE_ENVIRONMENT
6446 #else
6447 #define ___STREAM_OPEN_PROCESS_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
6448 #define CP_ENV_FLAGS 0
6449 #endif
6450 #endif
6451
6452
6453 #ifdef ___STREAM_OPEN_PROCESS_CE_SELECT
6454
6455 #ifdef USE_execvp
6456
6457 /**********************************/
6458 #define USE_pipe
6459
6460 typedef struct half_duplex_pipe
6461   {
6462     int reading_fd;
6463     int writing_fd;
6464   } half_duplex_pipe;
6465
6466 typedef struct full_duplex_pipe
6467   {
6468     half_duplex_pipe input;
6469     half_duplex_pipe output;
6470   } full_duplex_pipe;
6471
6472
6473 ___HIDDEN int open_half_duplex_pipe
6474    ___P((half_duplex_pipe *hdp),
6475         (hdp)
6476 half_duplex_pipe *hdp;)
6477 {
6478   int fds[2];
6479
6480 #ifdef USE_pipe
6481   if (pipe (fds) < 0)
6482     return -1;
6483 #endif
6484
6485 #ifdef USE_socketpair
6486   if (socketpair (AF_UNIX, SOCK_STREAM, 0, fds) < 0)
6487     return -1;
6488 #endif
6489
6490   hdp->reading_fd = fds[0];
6491   hdp->writing_fd = fds[1];
6492
6493   return 0;
6494 }
6495
6496 ___HIDDEN void close_half_duplex_pipe
6497    ___P((half_duplex_pipe *hdp,
6498          int end),
6499         (hdp,
6500          end)
6501 half_duplex_pipe *hdp;
6502 int end;)
6503 {
6504   if (end != 1 && hdp->reading_fd >= 0)
6505     {
6506       close_no_EINTR (hdp->reading_fd); /* ignore error */
6507       hdp->reading_fd = -1;
6508     }
6509
6510   if (end != 0 && hdp->writing_fd >= 0)
6511     {
6512       close_no_EINTR (hdp->writing_fd); /* ignore error */
6513       hdp->writing_fd = -1;
6514     }
6515 }
6516
6517 ___HIDDEN int open_pseudo_terminal_master
6518    ___P((int *master_fd_ptr,
6519          int *slave_fd_ptr),
6520         (master_fd_ptr,
6521          slave_fd_ptr)
6522 int *master_fd_ptr;
6523 int *slave_fd_ptr;)
6524 {
6525 #ifdef USE_openpty
6526
6527   return openpty (master_fd_ptr, slave_fd_ptr, NULL, NULL, NULL);
6528
6529 #else
6530 #ifdef USE_getpt
6531
6532   *slave_fd_ptr = -1;
6533   return *master_fd_ptr = getpt ();
6534
6535 #else
6536
6537   *slave_fd_ptr = -1;
6538   return *master_fd_ptr = open ("/dev/ptmx", O_RDWR | O_NOCTTY);
6539
6540 #endif
6541 #endif
6542 }
6543
6544
6545 #if 0
6546 #ifndef USE_openpty
6547 /***************************/
6548 #define __USE_XOPEN
6549 #define __USE_GNU
6550 #include <stdlib.h>
6551 #include <stropts.h>
6552 extern char *ptsname (int __fd);
6553 #endif
6554 #endif
6555
6556 ___HIDDEN int setup_terminal_slave
6557    ___P((int slave_fd),
6558         (slave_fd)
6559 int slave_fd;)
6560 {
6561   struct termios tios;
6562
6563   if (tcgetattr (slave_fd, &tios) >= 0)
6564     {
6565       tios.c_lflag &= ~(ECHO | ECHOCTL | ICANON | IEXTEN | ISIG);
6566       tios.c_iflag &= ~(BRKINT | INLCR | ICRNL | INPCK | ISTRIP | IXON | IXOFF);
6567       tios.c_cflag &= ~(CSIZE | PARENB | CLOCAL);
6568       tios.c_cflag |= (CS8 | HUPCL);
6569 #ifndef OCRNL
6570 #define OCRNL 0
6571 #endif
6572       tios.c_oflag &= ~(OPOST | ONLCR | OCRNL);
6573
6574       if (tcsetattr (slave_fd, TCSANOW, &tios) >= 0)
6575         return 0;
6576     }
6577
6578   return -1;
6579 }
6580
6581
6582 ___HIDDEN int open_pseudo_terminal_slave
6583    ___P((int master_fd,
6584          int *slave_fd),
6585         (master_fd,
6586          slave_fd)
6587 int master_fd;
6588 int *slave_fd;)
6589 {
6590 #ifndef USE_openpty
6591 #ifndef USE_ptsname
6592
6593   errno = xxx;/********************/
6594   return -1;
6595
6596 #endif
6597 #endif
6598
6599 #ifdef USE_openpty
6600
6601   return 0;
6602
6603 #endif
6604
6605 #ifdef USE_ptsname
6606
6607   int fd;
6608   char *name;
6609
6610   if (grantpt (master_fd) >= 0 &&
6611       unlockpt (master_fd) >= 0 &&
6612       (name = ptsname (master_fd)) != NULL &&
6613       (fd = open (name, O_RDWR)) >= 0)
6614     {
6615       int tmp;
6616
6617       if (
6618 #ifndef HAVE_isastream
6619           1
6620 #else
6621           !isastream (fd)
6622 #ifdef I_PUSH
6623           || (ioctl (fd, I_PUSH, "ptem") >= 0 &&
6624               ioctl (fd, I_PUSH, "ldterm") >= 0)
6625 #endif
6626 #endif
6627          )
6628         {
6629           *slave_fd = fd;
6630           return 0;
6631         }
6632
6633       tmp = errno;
6634       close_no_EINTR (fd); /* ignore error */
6635       errno = tmp;
6636     }
6637
6638   return -1;
6639
6640 #endif
6641 }
6642
6643
6644 ___HIDDEN int open_full_duplex_pipe1
6645    ___P((full_duplex_pipe *fdp,
6646          ___BOOL use_pty),
6647         (fdp,
6648          use_pty)
6649 full_duplex_pipe *fdp;
6650 ___BOOL use_pty;)
6651 {
6652   fdp->input.reading_fd = -1;
6653   fdp->input.writing_fd = -1;
6654   fdp->output.reading_fd = -1;
6655   fdp->output.writing_fd = -1;
6656
6657   if (use_pty)
6658     {
6659       int master_fd;
6660       int slave_fd;
6661       if (open_pseudo_terminal_master (&master_fd, &slave_fd) >= 0)
6662         {
6663           int master_fd_dup;
6664           int tmp;
6665           if ((master_fd_dup = dup_no_EINTR (master_fd)) >= 0)
6666             {
6667               fdp->input.writing_fd = master_fd;
6668               fdp->output.reading_fd = master_fd_dup;
6669               fdp->input.reading_fd = slave_fd;
6670               return 0;
6671             }
6672           tmp = errno;
6673           close_no_EINTR (master_fd); /* ignore error */
6674           if (slave_fd >= 0)
6675             close_no_EINTR (slave_fd); /* ignore error */
6676           errno = tmp;
6677         }
6678     }
6679   else
6680     {
6681       if (open_half_duplex_pipe (&fdp->input) >= 0)
6682         {
6683           if (open_half_duplex_pipe (&fdp->output) >= 0)
6684             return 0;
6685           close_half_duplex_pipe (&fdp->input, 2);
6686         }
6687     }
6688
6689   return -1;
6690 }
6691
6692
6693 ___HIDDEN int open_full_duplex_pipe2
6694    ___P((full_duplex_pipe *fdp,
6695          ___BOOL use_pty),
6696         (fdp,
6697          use_pty)
6698 full_duplex_pipe *fdp;
6699 ___BOOL use_pty;)
6700 {
6701   if (use_pty)
6702     {
6703       if (setsid () >= 0 &&
6704 #ifdef TIOCSCTTY
6705           ioctl (fdp->input.reading_fd, TIOCSCTTY, 0) >= 0 &&
6706 #endif
6707           open_pseudo_terminal_slave (fdp->input.writing_fd,
6708                                       &fdp->input.reading_fd) >= 0)
6709         {
6710           int tmp;
6711           if (setup_terminal_slave (fdp->input.reading_fd) >= 0 &&
6712               (fdp->output.writing_fd = dup_no_EINTR (fdp->input.reading_fd)) >= 0)
6713             return 0;
6714           tmp = errno;
6715           close_no_EINTR (fdp->input.reading_fd); /* ignore error */
6716           errno = tmp;
6717         }
6718     }
6719   else
6720     return 0;
6721
6722   return -1;
6723 }
6724
6725 #endif
6726
6727
6728 #ifdef USE_CreateProcess
6729
6730 #define ___ESCAPE_PROCESS_ARGS
6731
6732 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) argv_to_ccmd
6733    ___P((___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *argv),
6734         (argv)
6735 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *argv;)
6736 {
6737   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) ccmd;
6738   int ccmd_len = 0;
6739   int i = 0;
6740   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) arg;
6741
6742   while ((arg = argv[i]) != NULL)
6743     {
6744       int j = 0;
6745
6746       while (arg[j] != ___UNICODE_NUL)
6747         j++;
6748
6749       ccmd_len += j + 1;
6750
6751 #ifdef ___ESCAPE_PROCESS_ARGS
6752
6753       {
6754         ___BOOL double_backslash = TRUE;
6755
6756         while (--j >= 0)
6757           {
6758             ___CHAR_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) c = arg[j];
6759             if (c == ___UNICODE_DOUBLEQUOTE ||
6760                 (double_backslash && c == ___UNICODE_BACKSLASH))
6761               {
6762                 double_backslash = TRUE;
6763                 ccmd_len++;
6764               }
6765             else
6766               double_backslash = FALSE;
6767           }
6768
6769         ccmd_len += 2;
6770       }
6771
6772 #endif
6773
6774       i++;
6775     }
6776
6777   ccmd = ___CAST(___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT),
6778                  ___alloc_mem (ccmd_len * sizeof (*ccmd)));
6779
6780   if (ccmd != NULL)
6781     {
6782       ccmd[--ccmd_len] = ___UNICODE_NUL;
6783
6784       while (--i >= 0)
6785         {
6786           int j = 0;
6787
6788           arg = argv[i];
6789
6790           while (arg[j] != ___UNICODE_NUL)
6791             j++;
6792
6793 #ifdef ___ESCAPE_PROCESS_ARGS
6794
6795           {
6796             ___BOOL double_backslash = TRUE;
6797
6798             ccmd[--ccmd_len] = ___UNICODE_DOUBLEQUOTE;
6799
6800             while (--j >= 0)
6801               {
6802                 ___CHAR_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) c = arg[j];
6803                 ccmd[--ccmd_len] = c;
6804                 if (c == ___UNICODE_DOUBLEQUOTE ||
6805                     (double_backslash && c == ___UNICODE_BACKSLASH))
6806                   {
6807                     ccmd[--ccmd_len] = ___UNICODE_BACKSLASH;
6808                     double_backslash = TRUE;
6809                   }
6810                 else
6811                   double_backslash = FALSE;
6812               }
6813
6814             ccmd[--ccmd_len] = ___UNICODE_DOUBLEQUOTE;
6815           }
6816
6817 #else
6818
6819           while (--j >= 0)
6820             {
6821               ___CHAR_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) c = arg[j];
6822               ccmd[--ccmd_len] = c;
6823             }
6824
6825 #endif
6826
6827           if (i > 0)
6828             ccmd[--ccmd_len] = ___UNICODE_SPACE;
6829         }
6830     }
6831
6832   return ccmd;
6833 }
6834
6835 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) env_to_cenv
6836    ___P((___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *env),
6837         (env)
6838 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *env;)
6839 {
6840   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) cenv;
6841   int cenv_len = 0;
6842   int i = 0;
6843   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) varval;
6844
6845   while ((varval = env[i++]) != NULL)
6846     {
6847       int j = 0;
6848       while (varval[j++] != ___UNICODE_NUL)
6849         ;
6850       cenv_len += j;
6851     }
6852
6853   cenv_len++;
6854
6855   cenv = ___CAST(___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT),
6856                  ___alloc_mem (cenv_len * sizeof (*cenv)));
6857
6858   if (cenv != NULL)
6859     {
6860       ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) p = cenv;
6861       i = 0;
6862
6863       while ((varval = env[i++]) != NULL)
6864         {
6865           int j = 0;
6866           while ((*p++ = varval[j++]) != ___UNICODE_NUL)
6867             ;
6868         }
6869
6870       *p++ = ___UNICODE_NUL;
6871     }
6872
6873   return cenv;
6874 }
6875
6876 #endif
6877
6878
6879 ___SCMOBJ ___device_stream_setup_from_process
6880    ___P((___device_stream **dev,
6881          ___device_group *dgroup,
6882          ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *argv,
6883          ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *env,
6884          ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) dir,
6885          int options),
6886         (dev,
6887          dgroup,
6888          argv,
6889          env,
6890          dir,
6891          options)
6892 ___device_stream **dev;
6893 ___device_group *dgroup;
6894 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *argv;
6895 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *env;
6896 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) dir;
6897 int options;)
6898 {
6899 #define STDIN_REDIR  1
6900 #define STDOUT_REDIR 2
6901 #define STDERR_REDIR 4
6902 #define PSEUDO_TERM  8
6903 #define SHOW_CONSOLE 16
6904
6905 #ifdef USE_execvp
6906
6907   ___SCMOBJ e = ___FIX(___NO_ERR);
6908   int direction;
6909   ___device_process *d;
6910   pid_t pid = 0;
6911   half_duplex_pipe hdp_errno;
6912   full_duplex_pipe fdp;
6913   int execvp_errno;
6914   int n;
6915
6916   /*
6917    * Block SIGCHLD so that if the process is created the
6918    * sigchld_signal_handler will find it in the device group.
6919    */
6920
6921   sigset_type oldmask = block_signal (SIGCHLD);
6922
6923   fdp.input.writing_fd = -1;
6924   fdp.output.reading_fd = -1;
6925
6926   if (open_half_duplex_pipe (&hdp_errno) < 0)
6927     e = err_code_from_errno ();
6928   else
6929     {
6930       if ((options & (STDIN_REDIR | STDOUT_REDIR | STDERR_REDIR)) &&
6931           open_full_duplex_pipe1 (&fdp, options & PSEUDO_TERM) < 0)
6932         e = err_code_from_errno ();
6933       else
6934         {
6935           ___disable_os_interrupts ();
6936
6937           if ((pid = fork ()) < 0)
6938             {
6939               e = err_code_from_errno ();
6940               if (options & (STDIN_REDIR | STDOUT_REDIR | STDERR_REDIR))
6941                 {
6942                   close_half_duplex_pipe (&fdp.input, 2);
6943                   close_half_duplex_pipe (&fdp.output, 2);
6944                 }
6945             }
6946
6947           if (pid > 0)
6948             ___enable_os_interrupts ();
6949         }
6950
6951       if (e != ___FIX(___NO_ERR))
6952         close_half_duplex_pipe (&hdp_errno, 2);
6953     }
6954
6955   if (e == ___FIX(___NO_ERR))
6956     {
6957       if (pid == 0)
6958         {
6959           /* child process */
6960
6961           restore_sigmask (oldmask);
6962
6963           ___cleanup_os_interrupt_handling ();
6964
6965           if (options & (STDIN_REDIR | STDOUT_REDIR | STDERR_REDIR))
6966             {
6967               if (open_full_duplex_pipe2 (&fdp, options & PSEUDO_TERM) < 0 ||
6968                   ((options & STDIN_REDIR) &&
6969                    dup2_no_EINTR (fdp.input.reading_fd, STDIN_FILENO) < 0) ||
6970                   ((options & STDOUT_REDIR) &&
6971                    dup2_no_EINTR (fdp.output.writing_fd, STDOUT_FILENO) < 0) ||
6972                   ((options & (STDERR_REDIR | PSEUDO_TERM)) &&
6973                    dup2_no_EINTR (fdp.output.writing_fd, STDERR_FILENO) < 0))
6974                 goto return_errno;
6975             }
6976
6977           if (fcntl (hdp_errno.writing_fd, F_SETFD, FD_CLOEXEC) < 0)
6978             goto return_errno;
6979
6980           close_half_duplex_pipe (&fdp.input, 1);
6981           close_half_duplex_pipe (&fdp.output, 0);
6982           close_half_duplex_pipe (&hdp_errno, 0);
6983
6984           {
6985             /* Close all file descriptors that aren't used. */
6986
6987             int fd = sysconf (_SC_OPEN_MAX) - 1;
6988
6989             while (fd >= 0)
6990               {
6991                 if (fd != STDIN_FILENO &&
6992                     fd != STDOUT_FILENO &&
6993                     fd != STDERR_FILENO &&
6994                     fd != hdp_errno.writing_fd)
6995                   close_no_EINTR (fd); /* ignore error */
6996                 fd--;
6997               }
6998           }
6999
7000           if (dir == NULL || chdir (dir) == 0)
7001             {
7002 #ifdef USE_environ
7003               if (env != NULL)
7004                 environ = env;
7005 #endif
7006               execvp (argv[0], argv);
7007               /* the exec failed, errno will be returned to parent */
7008             }
7009
7010         return_errno:
7011
7012           /* return the errno to the parent process */
7013
7014           execvp_errno = errno;
7015
7016           write (hdp_errno.writing_fd, &execvp_errno, sizeof (execvp_errno));
7017
7018           close_half_duplex_pipe (&fdp.input, 0);
7019           close_half_duplex_pipe (&fdp.output, 1);
7020           close_half_duplex_pipe (&hdp_errno, 1);
7021
7022           _exit (1);
7023         }
7024
7025       /* parent process */
7026
7027       if (options & (STDIN_REDIR | STDOUT_REDIR | STDERR_REDIR))
7028         {
7029           close_half_duplex_pipe (&fdp.input, 0);
7030           close_half_duplex_pipe (&fdp.output, 1);
7031         }
7032
7033       close_half_duplex_pipe (&hdp_errno, 1);
7034
7035       /*
7036        * The following call to read has been known to fail with EINTR,
7037        * in particular on OpenBSD 4.5.  This is probably because the
7038        * child process that is started terminates before the parent
7039        * process doing the read has time to wakeup.  So the parent
7040        * process receives a SIGCHLD signal which interrupts the read.
7041        */
7042
7043       n = read_no_EINTR (hdp_errno.reading_fd,
7044                          &execvp_errno,
7045                          sizeof (execvp_errno));
7046
7047       if (n < 0)
7048         e = err_code_from_errno ();
7049       else if (n == sizeof (execvp_errno))
7050         {
7051           errno = execvp_errno;
7052           e = err_code_from_errno ();
7053         }
7054       else if (n != 0)
7055         e = ___FIX(___UNKNOWN_ERR);
7056       else
7057         {
7058           direction = ___DIRECTION_RD|___DIRECTION_WR;
7059
7060           e = ___device_process_setup_from_pid
7061                 (&d,
7062                  dgroup,
7063                  pid,
7064                  fdp.input.writing_fd,
7065                  fdp.output.reading_fd,
7066                  direction);
7067
7068           *dev = ___CAST(___device_stream*,d);
7069
7070           if (e == ___FIX(___NO_ERR))
7071             device_transfer_close_responsibility (___CAST(___device*,d));
7072         }
7073
7074       if (e != ___FIX(___NO_ERR))
7075         if (options & (STDIN_REDIR | STDOUT_REDIR | STDERR_REDIR))
7076           {
7077             close_half_duplex_pipe (&fdp.input, 1);
7078             close_half_duplex_pipe (&fdp.output, 0);
7079           }
7080
7081       close_half_duplex_pipe (&hdp_errno, 0);
7082     }
7083
7084   restore_sigmask (oldmask);
7085
7086   return e;
7087
7088 #endif
7089
7090 #ifdef USE_CreateProcess
7091
7092   ___SCMOBJ e;
7093   int direction;
7094   ___device_process *d;
7095
7096   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) ccmd;
7097   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) cenv = NULL;
7098
7099   HANDLE hstdin_rd = NULL;
7100   HANDLE hstdin_wr = NULL;
7101   HANDLE hstdout_rd = NULL;
7102   HANDLE hstdout_wr = NULL;
7103
7104   SECURITY_ATTRIBUTES sa;
7105   PROCESS_INFORMATION pi;
7106   STARTUPINFO si;
7107
7108   sa.nLength = sizeof (SECURITY_ATTRIBUTES);
7109   sa.bInheritHandle = TRUE;
7110   sa.lpSecurityDescriptor = NULL;
7111
7112   if ((ccmd = argv_to_ccmd (argv)) == NULL ||
7113       (env != NULL && (cenv = env_to_cenv (env)) == NULL))
7114     e = ___FIX(___HEAP_OVERFLOW_ERR);
7115   else
7116     {
7117       ZeroMemory (&pi, sizeof (pi));
7118
7119       ZeroMemory (&si, sizeof (si));
7120       si.cb = sizeof (si);
7121
7122       si.hStdInput  = GetStdHandle (STD_INPUT_HANDLE);
7123       si.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE);
7124       si.hStdError  = GetStdHandle (STD_ERROR_HANDLE);
7125
7126       if (options & STDIN_REDIR)
7127         {
7128           if (!CreatePipe (&hstdin_rd, &hstdin_wr, &sa, 0))
7129             e = err_code_from_GetLastError ();
7130           else
7131             {
7132               SetHandleInformation (hstdin_wr, HANDLE_FLAG_INHERIT, 0);
7133               si.hStdInput = hstdin_rd;
7134             }
7135         }
7136
7137       if (options & (STDOUT_REDIR | STDERR_REDIR))
7138         {
7139           if (!CreatePipe (&hstdout_rd, &hstdout_wr, &sa, 0))
7140             e = err_code_from_GetLastError ();
7141           else
7142             {
7143               SetHandleInformation (hstdout_rd, HANDLE_FLAG_INHERIT, 0);
7144               if (options & STDOUT_REDIR)
7145                 si.hStdOutput = hstdout_wr;
7146               if (options & STDERR_REDIR)
7147                 si.hStdError = hstdout_wr;
7148             }
7149         }
7150
7151       si.dwFlags |= STARTF_USESTDHANDLES;
7152
7153 #if 0
7154       if (hstdin_wr != NULL)
7155         {
7156           HANDLE h_wr;
7157           if (DuplicateHandle (GetCurrentProcess (),
7158                                hstdin_wr,
7159                                GetCurrentProcess (),
7160                                &h_wr,
7161                                0,
7162                                FALSE,
7163                                DUPLICATE_SAME_ACCESS))
7164             {
7165               CloseHandle (hstdin_wr);
7166               hstdin_wr = h_wr;
7167             }
7168         }
7169
7170       if (hstdout_rd != NULL)
7171         {
7172           HANDLE h_rd;
7173           if (DuplicateHandle (GetCurrentProcess (),
7174                                hstdout_rd,
7175                                GetCurrentProcess (),
7176                                &h_rd,
7177                                0,
7178                                FALSE,
7179                                DUPLICATE_SAME_ACCESS))
7180             {
7181               CloseHandle (hstdout_rd);
7182               hstdout_rd = h_rd;
7183             }
7184         }
7185 #endif
7186
7187       if (si.hStdError == INVALID_HANDLE_VALUE ||
7188           !CreateProcess
7189              (NULL, /* module name                              */
7190               ccmd, /* command line                             */
7191               NULL, /* process handle not inheritable           */
7192               NULL, /* thread handle not inheritable            */
7193               TRUE, /* set handle inheritance to TRUE           */
7194               (CP_ENV_FLAGS | ((options & SHOW_CONSOLE) ? 0 : CREATE_NO_WINDOW)), /* creation flags */
7195               cenv, /* child's environment                      */
7196               dir,  /* child's starting directory               */
7197               &si,  /* pointer to STARTUPINFO structure         */
7198               &pi)) /* pointer to PROCESS_INFORMATION structure */
7199         e = err_code_from_GetLastError ();
7200       else
7201         {
7202           direction = ___DIRECTION_RD|___DIRECTION_WR;
7203
7204           e = ___device_process_setup_from_process
7205                 (&d,
7206                  dgroup,
7207                  pi,
7208                  hstdin_wr,
7209                  hstdout_rd,
7210                  direction);
7211
7212           *dev = ___CAST(___device_stream*,d);
7213
7214           if (e == ___FIX(___NO_ERR))
7215             device_transfer_close_responsibility (___CAST(___device*,d));
7216         }
7217     }
7218
7219   if (hstdout_rd != NULL)
7220     CloseHandle (hstdout_wr); /* ignore error */
7221
7222   if (hstdin_rd != NULL)
7223     CloseHandle (hstdin_rd); /* ignore error */
7224
7225   if (e != ___FIX(___NO_ERR))
7226     {
7227       if (hstdout_rd != NULL)
7228         CloseHandle (hstdout_rd); /* ignore error */
7229
7230       if (hstdin_rd != NULL)
7231         CloseHandle (hstdin_wr); /* ignore error */
7232     }
7233
7234   if (cenv != NULL)
7235     ___free_mem (cenv);
7236
7237   if (ccmd != NULL)
7238     ___free_mem (ccmd);
7239
7240   return e;
7241
7242 #endif
7243 }
7244
7245 #endif
7246
7247
7248 ___SCMOBJ ___os_device_process_pid
7249    ___P((___SCMOBJ dev),
7250         (dev)
7251 ___SCMOBJ dev;)
7252 {
7253   ___device_process *d =
7254     ___CAST(___device_process*,___FIELD(dev,___FOREIGN_PTR));
7255
7256 #ifndef USE_POSIX
7257 #ifndef USE_WIN32
7258
7259   return ___FIX(0);
7260
7261 #endif
7262 #endif
7263
7264 #ifdef USE_POSIX
7265
7266   return ___FIX(d->pid);
7267
7268 #endif
7269
7270 #ifdef USE_WIN32
7271
7272   return ___FIX(d->pi.dwProcessId);
7273
7274 #endif
7275 }
7276
7277
7278 ___SCMOBJ ___os_device_process_status
7279    ___P((___SCMOBJ dev),
7280         (dev)
7281 ___SCMOBJ dev;)
7282 {
7283   ___device_process *d =
7284     ___CAST(___device_process*,___FIELD(dev,___FOREIGN_PTR));
7285   ___SCMOBJ e;
7286
7287   if ((e = ___device_process_status_poll (d)) != ___FIX(___NO_ERR))
7288     return e;
7289
7290   if (!d->got_status)
7291     return ___FAL;
7292
7293   return ___FIX(d->status);
7294 }
7295
7296
7297 /*---------------------------------------------------------------------------*/
7298
7299 #ifndef USE_POSIX
7300 #ifndef USE_WIN32
7301 #define ___STREAM_OPEN_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
7302 #endif
7303 #endif
7304
7305 #ifdef USE_POSIX
7306 #define ___STREAM_OPEN_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
7307 #endif
7308
7309 #ifdef USE_WIN32
7310 #ifdef _UNICODE
7311 #define ___STREAM_OPEN_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
7312 #else
7313 #define ___STREAM_OPEN_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
7314 #endif
7315 #endif
7316
7317
7318 #ifdef ___STREAM_OPEN_PATH_CE_SELECT
7319
7320 ___SCMOBJ ___device_stream_setup_from_path
7321    ___P((___device_stream **dev,
7322          ___device_group *dgroup,
7323          ___STRING_TYPE(___STREAM_OPEN_PATH_CE_SELECT) path,
7324          int flags,
7325          int mode),
7326         (dev,
7327          dgroup,
7328          path,
7329          flags,
7330          mode)
7331 ___device_stream **dev;
7332 ___device_group *dgroup;
7333 ___STRING_TYPE(___STREAM_OPEN_PATH_CE_SELECT) path;
7334 int flags;
7335 int mode;)
7336 {
7337   ___SCMOBJ e;
7338
7339 #ifndef USE_POSIX
7340 #ifndef USE_WIN32
7341
7342   char *mod;
7343   int direction;
7344   ___FILE *stream;
7345
7346   device_translate_flags (flags,
7347                           &mod,
7348                           &direction);
7349
7350 #ifdef ___DEBUG
7351   ___printf ("path=\"%s\" mode=%s\n", path, mod);
7352 #endif
7353
7354   if ((stream = ___fopen (path, mod)) == 0)
7355     return fnf_or_err_code_from_errno ();
7356
7357   if ((e = ___device_stream_setup_from_stream
7358              (dev,
7359               dgroup,
7360               stream,
7361               ___NONE_KIND,
7362               direction))
7363       != ___FIX(___NO_ERR))
7364     ___fclose (stream); /* ignore error */
7365
7366 #endif
7367 #endif
7368
7369 #ifdef USE_POSIX
7370
7371   int fl;
7372   int direction;
7373   int fd;
7374
7375   device_translate_flags (flags,
7376                           &fl,
7377                           &direction);
7378
7379 #ifdef ___DEBUG
7380   ___printf ("path=\"%s\" fl=%d\n", path, fl);
7381 #endif
7382
7383   if ((fd = open (path,
7384                   fl,
7385 #ifdef O_BINARY
7386                   O_BINARY|
7387 #endif
7388                   mode))
7389       < 0)
7390     return fnf_or_err_code_from_errno ();
7391
7392   if ((e = ___device_stream_setup_from_fd
7393              (dev,
7394               dgroup,
7395               fd,
7396               ___NONE_KIND,
7397               direction))
7398       != ___FIX(___NO_ERR))
7399     close_no_EINTR (fd); /* ignore error */
7400
7401 #endif
7402
7403 #ifdef USE_WIN32
7404
7405   DWORD access_mode;
7406   DWORD share_mode;
7407   DWORD creation_mode;
7408   DWORD attributes;
7409   int direction;
7410   HANDLE h;
7411
7412   device_translate_flags (flags,
7413                           &access_mode,
7414                           &share_mode,
7415                           &creation_mode,
7416                           &attributes,
7417                           &direction);
7418
7419   h = CreateFile (path,
7420                   access_mode,
7421                   share_mode,
7422                   NULL,
7423                   creation_mode,
7424                   attributes,
7425                   NULL);
7426
7427   if (h == INVALID_HANDLE_VALUE)
7428     return fnf_or_err_code_from_GetLastError ();
7429
7430   if ((e = ___device_stream_setup_from_handle
7431              (dev,
7432               dgroup,
7433               h,
7434               flags,
7435               ___NONE_KIND,
7436               direction))
7437       != ___FIX(___NO_ERR))
7438     CloseHandle (h); /* ignore error */
7439
7440 #endif
7441
7442   if (e == ___FIX(___NO_ERR))
7443     device_transfer_close_responsibility (___CAST(___device*,*dev));
7444
7445   return e;
7446 }
7447
7448 #endif
7449
7450
7451 /*---------------------------------------------------------------------------*/
7452
7453 /* Device operations. */
7454
7455 ___SCMOBJ ___os_device_kind
7456    ___P((___SCMOBJ dev),
7457         (dev)
7458 ___SCMOBJ dev;)
7459 {
7460   ___device *d = ___CAST(___device*,___FIELD(dev,___FOREIGN_PTR));
7461
7462   return ___FIX(___device_kind (d));
7463 }
7464
7465
7466 ___SCMOBJ ___os_device_force_output
7467    ___P((___SCMOBJ dev,
7468          ___SCMOBJ level),
7469         (dev,
7470          level)
7471 ___SCMOBJ dev;
7472 ___SCMOBJ level;)
7473 {
7474   ___device *d = ___CAST(___device*,___FIELD(dev,___FOREIGN_PTR));
7475
7476   return ___device_force_output (d, ___INT(level));
7477 }
7478
7479
7480 ___SCMOBJ ___os_device_close
7481    ___P((___SCMOBJ dev,
7482          ___SCMOBJ direction),
7483         (dev,
7484          direction)
7485 ___SCMOBJ dev;
7486 ___SCMOBJ direction;)
7487 {
7488   ___device *d = ___CAST(___device*,___FIELD(dev,___FOREIGN_PTR));
7489
7490   return ___device_close (d, ___INT(direction));
7491 }
7492
7493
7494 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
7495
7496 /* Stream device operations. */
7497
7498 ___SCMOBJ ___os_device_stream_seek
7499    ___P((___SCMOBJ dev,
7500          ___SCMOBJ pos,
7501          ___SCMOBJ whence),
7502         (dev,
7503          pos,
7504          whence)
7505 ___SCMOBJ dev;
7506 ___SCMOBJ pos;
7507 ___SCMOBJ whence;)
7508 {
7509   ___device_stream *d =
7510     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7511   ___S32 p;
7512   ___SCMOBJ e;
7513   ___SCMOBJ result;
7514
7515   if ((e = ___SCMOBJ_to_S32 (pos, &p, 2)) == ___FIX(___NO_ERR))
7516     e = ___device_stream_seek (d, &p, ___INT(whence));
7517
7518   if (e != ___FIX(___NO_ERR) ||
7519       (e = ___S32_to_SCMOBJ (p, &result, ___RETURN_POS)) != ___FIX(___NO_ERR))
7520     result = e;
7521
7522   return result;
7523 }
7524
7525
7526 ___SCMOBJ ___os_device_stream_read
7527    ___P((___SCMOBJ dev,
7528          ___SCMOBJ buffer,
7529          ___SCMOBJ lo,
7530          ___SCMOBJ hi),
7531         (dev,
7532          buffer,
7533          lo,
7534          hi)
7535 ___SCMOBJ dev;
7536 ___SCMOBJ buffer;
7537 ___SCMOBJ lo;
7538 ___SCMOBJ hi;)
7539 {
7540   ___device_stream *d =
7541     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7542   ___stream_index len_done;
7543   ___SCMOBJ e;
7544
7545   if ((e = ___device_stream_read
7546              (d,
7547               ___CAST(___U8*,___BODY_AS(buffer,___tSUBTYPED)) + ___INT(lo),
7548               ___INT(hi) - ___INT(lo),
7549               &len_done))
7550       == ___FIX(___NO_ERR))
7551     return ___FIX(len_done);
7552
7553   return e;
7554 }
7555
7556
7557 ___SCMOBJ ___os_device_stream_write
7558    ___P((___SCMOBJ dev,
7559          ___SCMOBJ buffer,
7560          ___SCMOBJ lo,
7561          ___SCMOBJ hi),
7562         (dev,
7563          buffer,
7564          lo,
7565          hi)
7566 ___SCMOBJ dev;
7567 ___SCMOBJ buffer;
7568 ___SCMOBJ lo;
7569 ___SCMOBJ hi;)
7570 {
7571   ___device_stream *d =
7572     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7573   ___stream_index len_done;
7574   ___SCMOBJ e;
7575
7576   if ((e = ___device_stream_write
7577              (d,
7578               ___CAST(___U8*,___BODY_AS(buffer,___tSUBTYPED)) + ___INT(lo),
7579               ___INT(hi) - ___INT(lo),
7580               &len_done))
7581       == ___FIX(___NO_ERR))
7582     return ___FIX(len_done);
7583
7584   return e;
7585 }
7586
7587
7588 ___SCMOBJ ___os_device_stream_width
7589    ___P((___SCMOBJ dev),
7590         (dev)
7591 ___SCMOBJ dev;)
7592 {
7593   ___device_stream *d =
7594     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7595
7596   return ___device_stream_width (d);
7597 }
7598
7599
7600 ___SCMOBJ ___os_device_stream_default_options
7601    ___P((___SCMOBJ dev),
7602         (dev)
7603 ___SCMOBJ dev;)
7604 {
7605   ___device_stream *d =
7606     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7607
7608   return ___device_stream_default_options (d);
7609 }
7610
7611
7612 ___SCMOBJ ___os_device_stream_options_set
7613    ___P((___SCMOBJ dev,
7614          ___SCMOBJ options),
7615         (dev,
7616          options)
7617 ___SCMOBJ dev;
7618 ___SCMOBJ options;)
7619 {
7620   ___device_stream *d =
7621     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7622
7623   return ___device_stream_options_set (d, options);
7624 }
7625
7626
7627 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
7628
7629 /* Opening a predefined device (stdin, stdout, stderr, console, etc). */
7630
7631 ___SCMOBJ ___os_device_stream_open_predefined
7632    ___P((___SCMOBJ index,
7633          ___SCMOBJ flags),
7634         (index,
7635          flags)
7636 ___SCMOBJ index;
7637 ___SCMOBJ flags;)
7638 {
7639   /*
7640    * The parameter "index" identifies the stream which is to be
7641    * associated with the returned device.  The stream must be
7642    * currently open.  The responsibility for closing the stream is not
7643    * transferred to the runtime system because the client may have to
7644    * do I/O on the stream after the runtime system terminates (for
7645    * example output on stdout).
7646    */
7647
7648   ___SCMOBJ e;
7649   ___device_stream *dev;
7650   ___SCMOBJ result;
7651
7652 #ifndef USE_POSIX
7653 #ifndef USE_WIN32
7654
7655   char *mode;
7656   int direction;
7657   ___FILE *stream;
7658
7659   device_translate_flags (___INT(flags),
7660                           &mode,
7661                           &direction);
7662
7663   switch (___INT(index))
7664     {
7665     default:
7666       {
7667         switch (___INT(index))
7668           {
7669           case -1:
7670             stream = ___stdin;
7671             break;
7672           case -2:
7673             stream = ___stdout;
7674             break;
7675           case -3:
7676             stream = ___stderr;
7677             break;
7678           case -4:
7679             stream = 0;
7680             break;
7681           default:
7682             stream = fdopen (___INT(index), mode);
7683             break;
7684           }
7685
7686         if ((e = ___device_stream_setup_from_stream
7687                    (&dev,
7688                     ___global_device_group (),
7689                     stream,
7690                     ___NONE_KIND,
7691                     direction))
7692             != ___FIX(___NO_ERR))
7693           return e;
7694
7695         break;
7696       }
7697     }
7698
7699 #endif
7700 #endif
7701
7702 #ifdef USE_POSIX
7703
7704   int fl;
7705   int direction;
7706   int fd;
7707
7708   device_translate_flags (___INT(flags),
7709                           &fl,
7710                           &direction);
7711
7712   switch (___INT(index))
7713     {
7714     case -4:
7715       {
7716         ___device_tty *d;
7717
7718         if ((e = ___device_tty_setup_console
7719                    (&d,
7720                     ___global_device_group (),
7721                     direction))
7722             != ___FIX(___NO_ERR))
7723           return e;
7724
7725         dev = ___CAST(___device_stream*,d);
7726
7727         break;
7728       }
7729
7730     default:
7731       {
7732         switch (___INT(index))
7733           {
7734           case -1:
7735             fd = STDIN_FILENO;
7736             break;
7737           case -2:
7738             fd = STDOUT_FILENO;
7739             break;
7740           case -3:
7741             fd = STDERR_FILENO;
7742             break;
7743           default:
7744             fd = ___INT(index);
7745             break;
7746           }
7747
7748         if ((e = ___device_stream_setup_from_fd
7749                    (&dev,
7750                     ___global_device_group (),
7751                     fd,
7752                     ___NONE_KIND,
7753                     direction))
7754             != ___FIX(___NO_ERR))
7755           return e;
7756
7757         break;
7758       }
7759     }
7760
7761 #endif
7762
7763 #ifdef USE_WIN32
7764
7765   DWORD access_mode;
7766   DWORD share_mode;
7767   DWORD creation_mode;
7768   DWORD attributes;
7769   int direction;
7770   HANDLE h;
7771
7772   device_translate_flags (___INT(flags),
7773                           &access_mode,
7774                           &share_mode,
7775                           &creation_mode,
7776                           &attributes,
7777                           &direction);
7778
7779   switch (___INT(index))
7780     {
7781     case -4:
7782     open_console:
7783       {
7784         ___device_tty *d;
7785
7786         if ((e = ___device_tty_setup_console
7787                    (&d,
7788                     ___global_device_group (),
7789                     direction))
7790             != ___FIX(___NO_ERR))
7791           return e;
7792
7793         dev = ___CAST(___device_stream*,d);
7794
7795         break;
7796       }
7797
7798     default:
7799       {
7800         switch (___INT(index))
7801           {
7802           default:
7803           case -1:
7804             h = GetStdHandle (STD_INPUT_HANDLE);
7805             break;
7806           case -2:
7807             h = GetStdHandle (STD_OUTPUT_HANDLE);
7808             break;
7809           case -3:
7810             h = GetStdHandle (STD_ERROR_HANDLE);
7811             break;
7812           }
7813
7814         if (h == INVALID_HANDLE_VALUE)
7815           return err_code_from_GetLastError ();
7816
7817         if (GetFileType (h) == FILE_TYPE_UNKNOWN)
7818           goto open_console;
7819
7820         if ((e = ___device_stream_setup_from_handle
7821                    (&dev,
7822                     ___global_device_group (),
7823                     h,
7824                     0,
7825                     ___NONE_KIND,
7826                     direction))
7827             != ___FIX(___NO_ERR))
7828           return e;
7829
7830         break;
7831       }
7832     }
7833
7834 #endif
7835
7836   e = ___NONNULLPOINTER_to_SCMOBJ
7837         (dev,
7838          ___FAL,
7839          ___device_cleanup_from_ptr,
7840          &result,
7841          ___RETURN_POS);
7842
7843   if (e != ___FIX(___NO_ERR))
7844     {
7845       ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
7846       return e;
7847     }
7848
7849   ___release_scmobj (result);
7850
7851   return result;
7852 }
7853
7854
7855 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
7856
7857 /* Opening a path. */
7858
7859 ___SCMOBJ ___os_device_stream_open_path
7860    ___P((___SCMOBJ path,
7861          ___SCMOBJ flags,
7862          ___SCMOBJ mode),
7863         (path,
7864          flags,
7865          mode)
7866 ___SCMOBJ path;
7867 ___SCMOBJ flags;
7868 ___SCMOBJ mode;)
7869 {
7870 #ifndef ___STREAM_OPEN_PATH_CE_SELECT
7871
7872   return ___FIX(___UNIMPL_ERR);
7873
7874 #else
7875
7876   ___SCMOBJ e;
7877   ___SCMOBJ result;
7878   ___device_stream *dev;
7879   void *cpath;
7880
7881   if ((e = ___SCMOBJ_to_NONNULLSTRING
7882              (path,
7883               &cpath,
7884               1,
7885               ___CE(___STREAM_OPEN_PATH_CE_SELECT),
7886               0))
7887       != ___FIX(___NO_ERR))
7888     result = e;
7889   else
7890     {
7891       ___STRING_TYPE(___STREAM_OPEN_PATH_CE_SELECT) p =
7892         ___CAST(___STRING_TYPE(___STREAM_OPEN_PATH_CE_SELECT),cpath);
7893
7894       if ((e = ___device_stream_setup_from_path
7895                  (&dev,
7896                   ___global_device_group (),
7897                   p,
7898                   ___INT(flags),
7899                   ___INT(mode)))
7900           != ___FIX(___NO_ERR))
7901         result = e;
7902       else
7903         {
7904           if ((e = ___NONNULLPOINTER_to_SCMOBJ
7905                      (dev,
7906                       ___FAL,
7907                       ___device_cleanup_from_ptr,
7908                       &result,
7909                       ___RETURN_POS))
7910               != ___FIX(___NO_ERR))
7911             {
7912               ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
7913               result = e;
7914             }
7915         }
7916
7917       ___release_string (cpath);
7918     }
7919
7920   ___release_scmobj (result);
7921
7922   return result;
7923
7924 #endif
7925 }
7926
7927
7928 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
7929
7930 /* Opening a process. */
7931
7932 ___SCMOBJ ___os_device_stream_open_process
7933    ___P((___SCMOBJ path_and_args,
7934          ___SCMOBJ environment,
7935          ___SCMOBJ directory,
7936          ___SCMOBJ options),
7937         (path_and_args,
7938          environment,
7939          directory,
7940          options)
7941 ___SCMOBJ path_and_args;
7942 ___SCMOBJ environment;
7943 ___SCMOBJ directory;
7944 ___SCMOBJ options;)
7945 {
7946 #ifndef ___STREAM_OPEN_PROCESS_CE_SELECT
7947
7948   return ___FIX(___UNIMPL_ERR);
7949
7950 #else
7951
7952   ___SCMOBJ e;
7953   ___device_stream *dev;
7954   ___SCMOBJ result;
7955   void *argv = NULL;
7956   void *env = NULL;
7957   void *dir = NULL;
7958
7959   if ((e = ___SCMOBJ_to_NONNULLSTRINGLIST
7960              (path_and_args,
7961               &argv,
7962               1,
7963               ___CE(___STREAM_OPEN_PROCESS_CE_SELECT)))
7964       != ___FIX(___NO_ERR) ||
7965       (environment != ___FAL &&
7966        (e = ___SCMOBJ_to_NONNULLSTRINGLIST
7967               (environment,
7968                &env,
7969                2,
7970                ___CE(___STREAM_OPEN_PROCESS_CE_SELECT)))
7971        != ___FIX(___NO_ERR)) ||
7972       (directory != ___FAL &&
7973        (e = ___SCMOBJ_to_NONNULLSTRING
7974               (directory,
7975                &dir,
7976                3,
7977                ___CE(___STREAM_OPEN_PROCESS_CE_SELECT),
7978                0))
7979        != ___FIX(___NO_ERR)) ||
7980       (e = ___device_stream_setup_from_process
7981              (&dev,
7982               ___global_device_group (),
7983               ___CAST(___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT)*,argv),
7984               ___CAST(___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT)*,env),
7985               ___CAST(___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT),dir),
7986               ___INT(options)))
7987       != ___FIX(___NO_ERR))
7988     result = e;
7989   else
7990     {
7991       if ((e = ___NONNULLPOINTER_to_SCMOBJ
7992                  (dev,
7993                   ___FAL,
7994                   ___device_cleanup_from_ptr,
7995                   &result,
7996                   ___RETURN_POS))
7997           == ___FIX(___NO_ERR))
7998         ___release_scmobj (result);
7999     }
8000
8001   if (argv != NULL)
8002     ___release_string_list (argv);
8003
8004   if (env != NULL)
8005     ___release_string_list (env);
8006
8007   if (dir != NULL)
8008     ___release_string (dir);
8009
8010   return result;
8011
8012 #endif
8013 }
8014
8015
8016 #ifdef USE_POSIX
8017
8018 ___HIDDEN void sigchld_signal_handler
8019    ___P((int sig),
8020         (sig)
8021 int sig;)
8022 {
8023 #ifdef USE_signal
8024   ___set_signal_handler (SIGCHLD, sigchld_signal_handler);
8025 #endif
8026
8027   /*
8028    * A SIGCHLD signal indicates that at least one child has changed
8029    * status.  There may be more than one because signals are not
8030    * queued.  For example during a period when the SIGCHLD signal is
8031    * blocked several child processes can terminate and only one call
8032    * to the SIGCHLD handler will occur when the SIGCHLD signal is
8033    * unblocked.  For this reason we must call waitpid in a loop, until
8034    * the last call indicates that no other child process is available.
8035    */
8036
8037   for (;;)
8038     {
8039       int status;
8040       ___device *head;
8041       pid_t pid = waitpid_no_EINTR (-1, &status, WNOHANG);
8042
8043       if (pid <= 0)
8044         break;
8045
8046       /*
8047        * Find the process device structure for the process which
8048        * terminated, and save the exit status with the process device.
8049        */
8050
8051       head = ___global_device_group ()->list;
8052
8053       if (head != NULL)
8054         {
8055           ___device *d = head->prev;
8056
8057           do
8058             {
8059               if (___device_kind (d) == ___PROCESS_DEVICE_KIND)
8060                 {
8061                   ___device_process *dev = ___CAST(___device_process*,d);
8062
8063                   if (dev->pid == pid)
8064                     {
8065                       if (WIFEXITED(status) || WIFSIGNALED(status))
8066                         ___device_process_status_set (dev, status); /* ignore error */
8067                       break;
8068                     }
8069                 }
8070               d = d->prev;
8071             } while  (d != head);
8072         }
8073     }
8074 }
8075
8076 #endif
8077
8078
8079 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8080
8081 /* Opening a TCP client. */
8082
8083 ___SCMOBJ ___os_device_tcp_client_open
8084    ___P((___SCMOBJ server_addr,
8085          ___SCMOBJ port_num,
8086          ___SCMOBJ options),
8087         (server_addr,
8088          port_num,
8089          options)
8090 ___SCMOBJ server_addr;
8091 ___SCMOBJ port_num;
8092 ___SCMOBJ options;)
8093 {
8094 #ifndef USE_NETWORKING
8095
8096   return ___FIX(___UNIMPL_ERR);
8097
8098 #else
8099
8100   ___SCMOBJ e;
8101   ___device_tcp_client *dev;
8102   ___SCMOBJ result;
8103   struct sockaddr sa;
8104   int salen;
8105
8106   if ((e = ___SCMOBJ_to_sockaddr (server_addr, port_num, &sa, &salen, 1))
8107       != ___FIX(___NO_ERR))
8108     return e;
8109
8110   if ((e = ___device_tcp_client_setup_from_sockaddr
8111              (&dev,
8112               ___global_device_group (),
8113               &sa,
8114               salen,
8115               ___INT(options),
8116               ___DIRECTION_RD|___DIRECTION_WR))
8117       != ___FIX(___NO_ERR))
8118     return e;
8119
8120   if ((e = ___NONNULLPOINTER_to_SCMOBJ
8121              (dev,
8122               ___FAL,
8123               ___device_cleanup_from_ptr,
8124               &result,
8125               ___RETURN_POS))
8126       != ___FIX(___NO_ERR))
8127     {
8128       ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
8129       return e;
8130     }
8131
8132   ___release_scmobj (result);
8133
8134   return result;
8135
8136 #endif
8137 }
8138
8139
8140 ___SCMOBJ ___os_device_tcp_client_socket_info
8141    ___P((___SCMOBJ dev,
8142          ___SCMOBJ peer),
8143         (dev,
8144          peer)
8145 ___SCMOBJ dev;
8146 ___SCMOBJ peer;)
8147 {
8148 #ifndef USE_NETWORKING
8149
8150   return ___FIX(___UNIMPL_ERR);
8151
8152 #else
8153
8154   ___device_tcp_client *d =
8155     ___CAST(___device_tcp_client*,___FIELD(dev,___FOREIGN_PTR));
8156   struct sockaddr sa;
8157   SOCKET_LEN_TYPE salen;
8158
8159   if (d->try_connect_again != 0)
8160     {
8161       if (try_connect (d) == 0)
8162         {
8163           if (d->try_connect_again != 0)
8164             return ___ERR_CODE_EAGAIN;
8165         }
8166       else
8167         return ERR_CODE_FROM_SOCKET_CALL;
8168     }
8169
8170   salen = sizeof (sa);
8171
8172   if (((peer == ___FAL)
8173        ? getsockname (d->s, &sa, &salen)
8174        : getpeername (d->s, &sa, &salen)) < 0)
8175     {
8176       ___SCMOBJ e = ERR_CODE_FROM_SOCKET_CALL;
8177       if (NOT_CONNECTED(e) && !d->connect_done)
8178         e = ___ERR_CODE_EAGAIN;
8179       return e;
8180     }
8181
8182   return ___sockaddr_to_SCMOBJ (&sa, salen, ___RETURN_POS);
8183
8184 #endif
8185 }
8186
8187
8188 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8189
8190 /* Opening and reading a TCP server. */
8191
8192 ___SCMOBJ ___os_device_tcp_server_open
8193    ___P((___SCMOBJ server_addr,
8194          ___SCMOBJ port_num,
8195          ___SCMOBJ backlog,
8196          ___SCMOBJ options),
8197         (server_addr,
8198          port_num,
8199          backlog,
8200          options)
8201 ___SCMOBJ server_addr;
8202 ___SCMOBJ port_num;
8203 ___SCMOBJ backlog;
8204 ___SCMOBJ options;)
8205 {
8206 #ifndef USE_NETWORKING
8207
8208   return ___FIX(___UNIMPL_ERR);
8209
8210 #else
8211
8212   ___SCMOBJ e;
8213   ___device_tcp_server *dev;
8214   ___SCMOBJ result;
8215   struct sockaddr sa;
8216   int salen;
8217
8218   if ((e = ___SCMOBJ_to_sockaddr (server_addr, port_num, &sa, &salen, 1))
8219       != ___FIX(___NO_ERR))
8220     return e;
8221
8222   e = ___device_tcp_server_setup
8223         (&dev,
8224          ___global_device_group (),
8225          &sa,
8226          salen,
8227          ___INT(backlog),
8228          ___INT(options));
8229
8230   if (e != ___FIX(___NO_ERR))
8231     return e;
8232
8233   e = ___NONNULLPOINTER_to_SCMOBJ
8234         (dev,
8235          ___FAL,
8236          ___device_cleanup_from_ptr,
8237          &result,
8238          ___RETURN_POS);
8239
8240   if (e != ___FIX(___NO_ERR))
8241     {
8242       ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
8243       return e;
8244     }
8245
8246   ___release_scmobj (result);
8247
8248   return result;
8249
8250 #endif
8251 }
8252
8253
8254 ___SCMOBJ ___os_device_tcp_server_read
8255    ___P((___SCMOBJ dev),
8256         (dev)
8257 ___SCMOBJ dev;)
8258 {
8259 #ifndef USE_NETWORKING
8260
8261   return ___FIX(___UNIMPL_ERR);
8262
8263 #else
8264
8265   ___device_tcp_server *d =
8266     ___CAST(___device_tcp_server*,___FIELD(dev,___FOREIGN_PTR));
8267   ___SCMOBJ e;
8268   ___device_tcp_client *client;
8269   ___SCMOBJ result;
8270
8271   if ((e = ___device_tcp_server_read (d, ___global_device_group (), &client))
8272       != ___FIX(___NO_ERR))
8273     return e;
8274
8275   e = ___NONNULLPOINTER_to_SCMOBJ
8276         (client,
8277          ___FAL,
8278          ___device_cleanup_from_ptr,
8279          &result,
8280          ___RETURN_POS);
8281
8282   if (e != ___FIX(___NO_ERR))
8283     {
8284       ___device_cleanup (___CAST(___device*,d)); /* ignore error */
8285       return e;
8286     }
8287
8288   ___release_scmobj (result);
8289
8290   return result;
8291
8292 #endif
8293 }
8294
8295
8296 ___SCMOBJ ___os_device_tcp_server_socket_info
8297    ___P((___SCMOBJ dev),
8298         (dev)
8299 ___SCMOBJ dev;)
8300 {
8301 #ifndef USE_NETWORKING
8302
8303   return ___FIX(___UNIMPL_ERR);
8304
8305 #else
8306
8307   ___device_tcp_server *d =
8308     ___CAST(___device_tcp_server*,___FIELD(dev,___FOREIGN_PTR));
8309   struct sockaddr sa;
8310   SOCKET_LEN_TYPE salen;
8311
8312   salen = sizeof (sa);
8313
8314   if (getsockname (d->s, &sa, &salen) < 0)
8315     return ERR_CODE_FROM_SOCKET_CALL;
8316
8317   return ___sockaddr_to_SCMOBJ (&sa, salen, ___RETURN_POS);
8318
8319 #endif
8320 }
8321
8322
8323 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8324
8325 /* Opening and reading a directory. */
8326
8327 ___SCMOBJ ___os_device_directory_open_path
8328    ___P((___SCMOBJ path,
8329          ___SCMOBJ ignore_hidden),
8330         (path,
8331          ignore_hidden)
8332 ___SCMOBJ path;
8333 ___SCMOBJ ignore_hidden;)
8334 {
8335 #ifndef ___DIR_OPEN_PATH_CE_SELECT
8336
8337   return ___FIX(___UNIMPL_ERR);
8338
8339 #else
8340
8341   ___SCMOBJ e;
8342   ___SCMOBJ result;
8343   ___device_directory *dev;
8344   void *cpath;
8345
8346   if ((e = ___SCMOBJ_to_NONNULLSTRING
8347              (path,
8348               &cpath,
8349               1,
8350               ___CE(___DIR_OPEN_PATH_CE_SELECT),
8351               0))
8352       != ___FIX(___NO_ERR))
8353     result = e;
8354   else
8355     {
8356       ___STRING_TYPE(___DIR_OPEN_PATH_CE_SELECT) p =
8357         ___CAST(___STRING_TYPE(___DIR_OPEN_PATH_CE_SELECT),cpath);
8358
8359       if ((e = ___device_directory_setup
8360                  (&dev,
8361                   ___global_device_group (),
8362                   p,
8363                   ___INT(ignore_hidden)))
8364           != ___FIX(___NO_ERR))
8365         result = e;
8366       else
8367         {
8368           if ((e = ___NONNULLPOINTER_to_SCMOBJ
8369                      (dev,
8370                       ___FAL,
8371                       ___device_cleanup_from_ptr,
8372                       &result,
8373                       ___RETURN_POS))
8374               != ___FIX(___NO_ERR))
8375             {
8376               ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
8377               result = e;
8378             }
8379         }
8380
8381       ___release_string (cpath);
8382     }
8383
8384   ___release_scmobj (result);
8385
8386   return result;
8387
8388 #endif
8389 }
8390
8391
8392 ___SCMOBJ ___os_device_directory_read
8393    ___P((___SCMOBJ dev),
8394         (dev)
8395 ___SCMOBJ dev;)
8396 {
8397 #ifndef ___DIR_OPEN_PATH_CE_SELECT
8398
8399   return ___FIX(___UNIMPL_ERR);
8400
8401 #else
8402
8403   ___device_directory *d =
8404     ___CAST(___device_directory*,___FIELD(dev,___FOREIGN_PTR));
8405   ___SCMOBJ e;
8406   ___STRING_TYPE(___DIR_OPEN_PATH_CE_SELECT) name;
8407   ___SCMOBJ result;
8408
8409   if ((e = ___device_directory_read (d, &name)) != ___FIX(___NO_ERR))
8410     return e;
8411
8412   if (name == NULL)
8413     return ___EOF;
8414
8415   if ((e = ___STRING_to_SCMOBJ (name, &result, ___RETURN_POS, ___CE(___DIR_OPEN_PATH_CE_SELECT) ))
8416       != ___FIX(___NO_ERR))
8417     return e;
8418
8419   ___release_scmobj (result);
8420
8421   return result;
8422
8423 #endif
8424 }
8425
8426
8427 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8428
8429 /* Opening an event-queue. */
8430
8431 ___SCMOBJ ___os_device_event_queue_open
8432    ___P((___SCMOBJ selector),
8433         (selector)
8434 ___SCMOBJ selector;)
8435 {
8436   ___SCMOBJ e;
8437   ___SCMOBJ result;
8438   ___device_event_queue *dev;
8439
8440   if ((e = ___device_event_queue_setup
8441              (&dev,
8442               ___global_device_group (),
8443               selector))
8444       != ___FIX(___NO_ERR))
8445     result = e;
8446   else
8447     {
8448       if ((e = ___NONNULLPOINTER_to_SCMOBJ
8449                  (dev,
8450                   ___FAL,
8451                   ___device_cleanup_from_ptr,
8452                   &result,
8453                   ___RETURN_POS))
8454           != ___FIX(___NO_ERR))
8455         {
8456           ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
8457           result = e;
8458         }
8459     }
8460
8461   ___release_scmobj (result);
8462
8463   return result;
8464 }
8465
8466
8467 ___SCMOBJ ___os_device_event_queue_read
8468    ___P((___SCMOBJ dev),
8469         (dev)
8470 ___SCMOBJ dev;)
8471 {
8472   ___device_event_queue *d =
8473     ___CAST(___device_event_queue*,___FIELD(dev,___FOREIGN_PTR));
8474   ___SCMOBJ e;
8475   ___SCMOBJ result;
8476
8477   if ((e = ___device_event_queue_read (d, &result)) != ___FIX(___NO_ERR))
8478     return e;
8479
8480   ___release_scmobj (result);
8481
8482   return result;
8483 }
8484
8485
8486 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8487
8488 /* Waiting for I/O to become possible on a set of devices. */
8489
8490 ___SCMOBJ ___os_condvar_select
8491    ___P((___SCMOBJ run_queue,
8492          ___SCMOBJ timeout),
8493         (run_queue,
8494          timeout)
8495 ___SCMOBJ run_queue;
8496 ___SCMOBJ timeout;)
8497 {
8498 /******************/
8499 #define ___BTQ_DEQ_NEXT 1
8500 #define ___BTQ_DEQ_PREV 2
8501 #define ___BTQ_COLOR    3
8502 #define ___BTQ_PARENT   4
8503 #define ___BTQ_LEFT     5
8504 #define ___BTQ_RIGHT    6
8505 #define ___BTQ_LEFTMOST 6
8506 #define ___BTQ_OWNER    7
8507 #define ___CONDVAR_NAME 8
8508
8509   ___SCMOBJ e;
8510   ___time to;
8511   ___device *devs[MAX_CONDVARS];
8512   ___SCMOBJ condvars[MAX_CONDVARS];
8513   int read_pos;
8514   int write_pos;
8515   ___SCMOBJ condvar;
8516   int i;
8517   int j;
8518
8519   if (timeout == ___FAL)
8520     to = ___time_mod.time_neg_infinity;
8521   else if (timeout == ___TRU)
8522     to = ___time_mod.time_pos_infinity;
8523   else
8524     ___time_from_seconds (&to, ___F64VECTORREF(timeout,___FIX(0)));
8525
8526   read_pos = 0;
8527   write_pos = MAX_CONDVARS;
8528   condvar = ___FIELD(run_queue,___BTQ_DEQ_NEXT);
8529
8530   while (condvar != run_queue)
8531     {
8532       ___SCMOBJ owner = ___FIELD(condvar,___BTQ_OWNER);
8533       if (read_pos < write_pos)
8534         {
8535           if (owner & ___FIX(2))
8536             condvars[--write_pos] = condvar;
8537           else
8538             condvars[read_pos++] = condvar;
8539           ___FIELD(condvar,___BTQ_OWNER) = owner & ~___FIX(1);
8540         }
8541       else
8542         {
8543           to = ___time_mod.time_neg_infinity;
8544           ___FIELD(condvar,___BTQ_OWNER) = owner | ___FIX(1);
8545         }
8546       condvar = ___FIELD(condvar,___BTQ_DEQ_NEXT);
8547     }
8548
8549   i = 0;
8550
8551   while (i < read_pos)
8552     {
8553       devs[i] = ___CAST(___device*,
8554                         ___FIELD(___FIELD(condvars[i],___CONDVAR_NAME),
8555                                  ___FOREIGN_PTR));
8556       i++;
8557     }
8558
8559   j = MAX_CONDVARS;
8560
8561   while (j > write_pos)
8562     {
8563       j--;
8564       devs[i] = ___CAST(___device*,
8565                         ___FIELD(___FIELD(condvars[j],___CONDVAR_NAME),
8566                                  ___FOREIGN_PTR));
8567       i++;
8568     }
8569
8570   e = ___device_select (devs, read_pos, MAX_CONDVARS-write_pos, to);
8571
8572   i = 0;
8573
8574   while (i < read_pos)
8575     {
8576       if (devs[i] == NULL)
8577         {
8578           condvar = condvars[i];
8579           ___FIELD(condvar,___BTQ_OWNER) |= ___FIX(1);
8580         }
8581       i++;
8582     }
8583
8584   j = MAX_CONDVARS;
8585
8586   while (j > write_pos)
8587     {
8588       j--;
8589       if (devs[i] == NULL)
8590         {
8591           condvar = condvars[j];
8592           ___FIELD(condvar,___BTQ_OWNER) |= ___FIX(1);
8593         }
8594       i++;
8595     }
8596
8597   return e;
8598 }
8599
8600
8601 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8602
8603 /*
8604  * Decoding and encoding of a buffer of Scheme characters to a buffer
8605  * of bytes.
8606  */
8607
8608 /*
8609  * The following definitions must match the structure of ports defined
8610  * in _io#.scm .
8611  */
8612
8613 #define ___PORT_MUTEX                1
8614 #define ___PORT_RKIND                2
8615 #define ___PORT_WKIND                3
8616 #define ___PORT_NAME                 4
8617 #define ___PORT_READ_DATUM           5
8618 #define ___PORT_WRITE_DATUM          6
8619 #define ___PORT_NEWLINE              7
8620 #define ___PORT_FORCE_OUTPUT         8
8621 #define ___PORT_CLOSE                9
8622 #define ___PORT_ROPTIONS             10
8623 #define ___PORT_RTIMEOUT             11
8624 #define ___PORT_RTIMEOUT_THUNK       12
8625 #define ___PORT_SET_RTIMEOUT         13
8626 #define ___PORT_WOPTIONS             14
8627 #define ___PORT_WTIMEOUT             15
8628 #define ___PORT_WTIMEOUT_THUNK       16
8629 #define ___PORT_SET_WTIMEOUT         17
8630
8631 #define ___PORT_OBJECT_OTHER1        18
8632 #define ___PORT_OBJECT_OTHER2        19
8633 #define ___PORT_OBJECT_OTHER3        20
8634
8635 #define ___PORT_CHAR_RBUF            18
8636 #define ___PORT_CHAR_RLO             19
8637 #define ___PORT_CHAR_RHI             20
8638 #define ___PORT_CHAR_RCHARS          21
8639 #define ___PORT_CHAR_RLINES          22
8640 #define ___PORT_CHAR_RCURLINE        23
8641 #define ___PORT_CHAR_RBUF_FILL       24
8642 #define ___PORT_CHAR_PEEK_EOFP       25
8643
8644 #define ___PORT_CHAR_WBUF            26
8645 #define ___PORT_CHAR_WLO             27
8646 #define ___PORT_CHAR_WHI             28
8647 #define ___PORT_CHAR_WCHARS          29
8648 #define ___PORT_CHAR_WLINES          30
8649 #define ___PORT_CHAR_WCURLINE        31
8650 #define ___PORT_CHAR_WBUF_DRAIN      32
8651 #define ___PORT_INPUT_READTABLE      33
8652 #define ___PORT_OUTPUT_READTABLE     34
8653 #define ___PORT_OUTPUT_WIDTH         35
8654
8655 #define ___PORT_CHAR_OTHER1          36
8656 #define ___PORT_CHAR_OTHER2          37
8657 #define ___PORT_CHAR_OTHER3          38
8658 #define ___PORT_CHAR_OTHER4          39
8659 #define ___PORT_CHAR_OTHER5          40
8660
8661 #define ___PORT_BYTE_RBUF            36
8662 #define ___PORT_BYTE_RLO             37
8663 #define ___PORT_BYTE_RHI             38
8664 #define ___PORT_BYTE_RBUF_FILL       39
8665
8666 #define ___PORT_BYTE_WBUF            40
8667 #define ___PORT_BYTE_WLO             41
8668 #define ___PORT_BYTE_WHI             42
8669 #define ___PORT_BYTE_WBUF_DRAIN      43
8670
8671 #define ___PORT_BYTE_OTHER1          44
8672 #define ___PORT_BYTE_OTHER2          45
8673
8674 #define ___PORT_RDEVICE_CONDVAR      44
8675 #define ___PORT_WDEVICE_CONDVAR      45
8676
8677 #define ___PORT_DEVICE_OTHER1        46
8678 #define ___PORT_DEVICE_OTHER2        47
8679
8680 #define ___C ___CS_SELECT(___U8,___U16,___U32)
8681
8682 ___SCMOBJ ___os_port_decode_chars
8683    ___P((___SCMOBJ port,
8684          ___SCMOBJ want,
8685          ___SCMOBJ eof),
8686         (port,
8687          want,
8688          eof)
8689 ___SCMOBJ port;
8690 ___SCMOBJ want;
8691 ___SCMOBJ eof;)
8692 {
8693   ___SCMOBJ e = ___FIX(___NO_ERR);
8694   ___SCMOBJ cbuf = ___FIELD(port,___PORT_CHAR_RBUF);
8695   int chi = ___INT(___FIELD(port,___PORT_CHAR_RHI));
8696   int cend = ___INT(___STRINGLENGTH(cbuf));
8697   ___SCMOBJ bbuf = ___FIELD(port,___PORT_BYTE_RBUF);
8698   int blo = ___INT(___FIELD(port,___PORT_BYTE_RLO));
8699   int bhi = ___INT(___FIELD(port,___PORT_BYTE_RHI));
8700   int options = ___INT(___FIELD(port,___PORT_ROPTIONS));
8701   ___C *cbuf_ptr = ___CAST(___C*,___BODY_AS(cbuf,___tSUBTYPED));
8702   ___U8 *bbuf_ptr = ___CAST(___U8*,___BODY_AS(bbuf,___tSUBTYPED));
8703   int cbuf_avail;
8704   int bbuf_avail;
8705   int code;
8706
8707   if (want != ___FAL)
8708     {
8709       int w = ___INT(want);
8710       if (chi+w < cend)
8711         cend = chi+w;
8712     }
8713
8714   cbuf_avail = cend - chi;
8715   bbuf_avail = bhi - blo;
8716
8717   code = chars_from_bytes (cbuf_ptr + chi,
8718                            &cbuf_avail,
8719                            bbuf_ptr + blo,
8720                            &bbuf_avail,
8721                            &options);
8722
8723   /*
8724    * either the character buffer is full (cbuf_avail == 0) or no more
8725    * characters can be extracted from the byte buffer either because
8726    * the remaining bytes are not long enough to form a character or
8727    * don't form a valid character.
8728    */
8729
8730   if (cbuf_avail == cend - chi)
8731     {
8732       if (code == ___INCOMPLETE_CHAR && eof != ___FAL)
8733         {
8734           bbuf_avail = 0; /* skip bytes up to end-of-file */
8735           code = ___ILLEGAL_CHAR;
8736         }
8737
8738       if (code == ___ILLEGAL_CHAR)
8739         {
8740           if (___CHAR_ENCODING_ERRORS(options) != ___CHAR_ENCODING_ERRORS_OFF)
8741             e = err_code_from_char_encoding (___CHAR_ENCODING(options), 1, 0, 0);
8742           else
8743             {
8744               if (___CHAR_ENCODING_SUPPORTS_BMP(___CHAR_ENCODING(options)))
8745                 cbuf_ptr[chi] = ___UNICODE_REPLACEMENT;
8746               else
8747                 cbuf_ptr[chi] = ___UNICODE_QUESTION;
8748
8749               cbuf_avail--;
8750             }
8751         }
8752     }
8753
8754   ___FIELD(port,___PORT_CHAR_RHI) = ___FIX(cend - cbuf_avail);
8755   ___FIELD(port,___PORT_BYTE_RLO) = ___FIX(bhi - bbuf_avail);
8756   ___FIELD(port,___PORT_ROPTIONS) = ___FIX(options);
8757
8758   return e;
8759 }
8760
8761
8762 ___SCMOBJ ___os_port_encode_chars
8763    ___P((___SCMOBJ port),
8764         (port)
8765 ___SCMOBJ port;)
8766 {
8767   ___SCMOBJ e = ___FIX(___NO_ERR);
8768   ___SCMOBJ cbuf = ___FIELD(port,___PORT_CHAR_WBUF);
8769   int clo = ___INT(___FIELD(port,___PORT_CHAR_WLO));
8770   int chi = ___INT(___FIELD(port,___PORT_CHAR_WHI));
8771   ___SCMOBJ bbuf = ___FIELD(port,___PORT_BYTE_WBUF);
8772   int bhi = ___INT(___FIELD(port,___PORT_BYTE_WHI));
8773   int bend = ___INT(___U8VECTORLENGTH(bbuf));
8774   int options = ___INT(___FIELD(port,___PORT_WOPTIONS));
8775   ___C *cbuf_ptr = ___CAST(___C*,___BODY_AS(cbuf,___tSUBTYPED));
8776   ___U8 *bbuf_ptr = ___CAST(___U8*,___BODY_AS(bbuf,___tSUBTYPED));
8777   int cbuf_avail;
8778   int bbuf_avail;
8779   int code;
8780
8781   cbuf_avail = chi - clo;
8782   bbuf_avail = bend - bhi;
8783
8784   code = chars_to_bytes (cbuf_ptr + clo,
8785                          &cbuf_avail,
8786                          bbuf_ptr + bhi,
8787                          &bbuf_avail,
8788                          &options);
8789
8790   /*
8791    * either the character buffer is empty (cbuf_avail == 0) or there
8792    * is not enough space left in the byte buffer for encoding the next
8793    * character, or the next character is illegal for the given
8794    * encoding.
8795    */
8796
8797   if (cbuf_avail == chi - clo)
8798     if (code == ___ILLEGAL_CHAR)
8799       {
8800         if (___CHAR_ENCODING_ERRORS(options) != ___CHAR_ENCODING_ERRORS_OFF)
8801           {
8802             cbuf_avail--; /* skip illegal char */
8803             e = err_code_from_char_encoding (___CHAR_ENCODING(options), 0, 0, 0);
8804           }
8805         else
8806           {
8807             ___C replacement_cbuf[1];
8808             int replacement_cbuf_avail = 1;
8809
8810             if (___CHAR_ENCODING_SUPPORTS_BMP(___CHAR_ENCODING(options)))
8811               replacement_cbuf[0] = ___UNICODE_REPLACEMENT;
8812             else
8813               replacement_cbuf[0] = ___UNICODE_QUESTION;
8814
8815             code = chars_to_bytes (replacement_cbuf,
8816                                    &replacement_cbuf_avail,
8817                                    bbuf_ptr + bend - bbuf_avail,
8818                                    &bbuf_avail,
8819                                    &options);
8820
8821             /*
8822              * skip over the illegal character if the replacement
8823              * character was encoded
8824              */
8825
8826             cbuf_avail = cbuf_avail - 1 + replacement_cbuf_avail;
8827           }
8828       }
8829
8830   ___FIELD(port,___PORT_CHAR_WLO) = ___FIX(chi - cbuf_avail);
8831   ___FIELD(port,___PORT_BYTE_WHI) = ___FIX(bend - bbuf_avail);
8832   ___FIELD(port,___PORT_WOPTIONS) = ___FIX(options);
8833
8834   return e;
8835 }
8836
8837
8838 /*---------------------------------------------------------------------------*/
8839
8840 /* I/O module initialization/finalization. */
8841
8842
8843 ___HIDDEN ___SCMOBJ io_module_setup ___PVOID
8844 {
8845   ___SCMOBJ e;
8846
8847   if ((e = ___device_group_setup (&___io_mod.dgroup)) == ___FIX(___NO_ERR))
8848     {
8849 #ifdef USE_POSIX
8850
8851       ___set_signal_handler (SIGCHLD, sigchld_signal_handler);
8852
8853 #endif
8854
8855 #ifdef USE_WIN32
8856
8857 #define WINSOCK_MAJOR 1
8858 #define WINSOCK_MINOR 1
8859
8860       WSADATA winsock_data;
8861
8862       if (!WSAStartup (MAKEWORD(WINSOCK_MAJOR, WINSOCK_MINOR), &winsock_data))
8863         {
8864           if (LOBYTE(winsock_data.wVersion) == WINSOCK_MINOR &&
8865               HIBYTE(winsock_data.wVersion) == WINSOCK_MAJOR)
8866             return ___FIX(___NO_ERR);
8867           WSACleanup (); /* ignore error */
8868         }
8869
8870       e = ___FIX(___UNKNOWN_ERR);
8871
8872       ___device_group_cleanup (___io_mod.dgroup);
8873
8874 #endif
8875     }
8876
8877   return e;
8878 }
8879
8880
8881 ___HIDDEN void io_module_cleanup ___PVOID
8882 {
8883 #ifdef USE_POSIX
8884
8885   ___set_signal_handler (SIGCHLD, SIG_DFL);
8886
8887 #endif
8888
8889 #ifdef USE_WIN32
8890
8891   WSACleanup (); /* ignore error */
8892
8893 #endif
8894
8895   ___device_group_cleanup (___io_mod.dgroup);
8896 }
8897
8898
8899
8900 ___SCMOBJ ___setup_io_module ___PVOID
8901 {
8902   if (!___io_mod.setup)
8903     {
8904 #ifdef USE_WIN32
8905
8906       ___SCMOBJ e = ___FIX(___NO_ERR);
8907
8908       ___io_mod.always_signaled = NULL;
8909       ___io_mod.abort_select = NULL;
8910
8911       ___io_mod.always_signaled =
8912         CreateEvent (NULL,  /* can't inherit */
8913                      TRUE,  /* manual reset */
8914                      TRUE,  /* signaled */
8915                      NULL); /* no name */
8916
8917       if (___io_mod.always_signaled == NULL)
8918         e = err_code_from_GetLastError ();
8919       else
8920         {
8921           ___io_mod.abort_select =
8922             CreateEvent (NULL,  /* can't inherit */
8923                          TRUE,  /* manual reset */
8924                          FALSE, /* not signaled */
8925                          NULL); /* no name */
8926
8927           if (___io_mod.abort_select == NULL)
8928             {
8929               CloseHandle (___io_mod.always_signaled); /* ignore error */
8930               e = err_code_from_GetLastError ();
8931             }
8932         }
8933
8934 #endif
8935
8936       io_module_setup ();/*****************************/
8937       ___io_mod.setup = 1;
8938       return ___FIX(___NO_ERR);
8939     }
8940
8941   return ___FIX(___UNKNOWN_ERR);
8942 }
8943
8944
8945 void ___cleanup_io_module ___PVOID
8946 {
8947   if (___io_mod.setup)
8948     {
8949       io_module_cleanup ();/*****************************/
8950 #ifdef USE_WIN32
8951       CloseHandle (___io_mod.abort_select); /* ignore error */
8952       CloseHandle (___io_mod.always_signaled); /* ignore error */
8953 #endif
8954       ___io_mod.setup = 0;
8955     }
8956 }
8957
8958
8959 /*---------------------------------------------------------------------------*/