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       switch (kind)
6075         {
6076
6077 #ifdef USE_NETWORKING
6078
6079         case ___TCP_CLIENT_DEVICE_KIND:
6080           {
6081             ___device_tcp_client *d;
6082             struct sockaddr server_addr;
6083
6084             if ((e = ___device_tcp_client_setup_from_socket
6085                        (&d,
6086                         dgroup,
6087                         fd,
6088                         &server_addr,
6089                         0,
6090                         0,
6091                         direction))
6092                 == ___FIX(___NO_ERR))
6093               *dev = ___CAST(___device_stream*,d);
6094
6095             break;
6096           }
6097
6098 #endif
6099
6100         case ___FILE_DEVICE_KIND:
6101           {
6102             ___device_file *d;
6103
6104 #ifdef USE_NONBLOCKING_FILE_IO
6105
6106             /*
6107              * Setup file descriptor to perform nonblocking I/O.
6108              */
6109
6110             if (set_fd_blocking_mode (fd, 0) != 0) /* set nonblocking mode */
6111               return err_code_from_errno ();
6112
6113 #endif
6114
6115             if ((e = ___device_file_setup_from_fd
6116                        (&d,
6117                         dgroup,
6118                         fd,
6119                         direction))
6120                 == ___FIX(___NO_ERR))
6121               *dev = ___CAST(___device_stream*,d);
6122
6123             break;
6124           }
6125
6126         default:
6127           {
6128             e = ___FIX(___UNKNOWN_ERR);
6129             break;
6130           }
6131         }
6132     }
6133
6134   return e;
6135 }
6136
6137
6138 ___HIDDEN void device_translate_flags
6139    ___P((int flags,
6140          int *fl,
6141          int *direction),
6142         (flags,
6143          fl,
6144          direction)
6145 int flags;
6146 int *fl;
6147 int *direction;)
6148 {
6149   int f;
6150
6151   switch ((flags >> 4) & 3)
6152     {
6153     default:
6154     case 1:
6155       f = O_RDONLY;
6156       *direction = ___DIRECTION_RD;
6157       break;
6158     case 2:
6159       f = O_WRONLY;
6160       *direction = ___DIRECTION_WR;
6161       break;
6162     case 3:
6163       f = O_RDWR;
6164       *direction = ___DIRECTION_RD|___DIRECTION_WR;
6165       break;
6166     }
6167
6168   if (flags & (1 << 3))
6169     f |= O_APPEND;
6170
6171   switch ((flags >> 1) & 3)
6172     {
6173     default:
6174     case 0: break;
6175     case 1: f |= O_CREAT; break;
6176     case 2: f |= O_CREAT|O_EXCL; break;
6177     }
6178
6179   if (flags & 1)
6180     f |= O_TRUNC;
6181
6182   /*
6183    * The O_NONBLOCK flag is not needed here because the file
6184    * descriptor will be set to nonblocking mode later on.  But we do
6185    * it anyway so there is no moment in time when it is in blocking
6186    * mode.
6187    */
6188
6189   f |= O_NONBLOCK;
6190
6191   *fl = f;
6192 }
6193
6194 #endif
6195
6196
6197 #ifdef USE_WIN32
6198
6199 ___HIDDEN int ___device_stream_kind_from_handle
6200    ___P((HANDLE h),
6201         (h)
6202 HANDLE h;)
6203 {
6204   DWORD n;
6205   CONSOLE_CURSOR_INFO cinfo;
6206   DCB dcb;
6207   BY_HANDLE_FILE_INFORMATION finfo;
6208
6209 #ifdef ___DEBUG
6210   ___printf ("GetFileType -> %d\n", ___CAST(int,GetFileType (h)));
6211 #endif
6212
6213   if (GetNumberOfConsoleInputEvents (h, &n))
6214     return ___TTY_DEVICE_KIND;
6215
6216   if (GetConsoleCursorInfo (h, &cinfo))
6217     return ___TTY_DEVICE_KIND;
6218
6219   if (GetCommState (h, &dcb))
6220     return ___SERIAL_DEVICE_KIND;
6221
6222   if (GetFileType (h) == FILE_TYPE_PIPE)
6223     return ___PIPE_DEVICE_KIND;
6224
6225   if (GetFileInformationByHandle (h, &finfo))
6226     return ___FILE_DEVICE_KIND;
6227
6228   return ___NONE_KIND;
6229 }
6230
6231
6232 ___HIDDEN int ___device_stream_direction_from_handle
6233    ___P((HANDLE h),
6234         (h)
6235 HANDLE h;)
6236 {
6237   DWORD n;
6238   int direction = ___DIRECTION_RD|___DIRECTION_WR;
6239
6240   /*
6241    * A "ReadFile" and "WriteFile" of 0 bytes is attempted to tell which
6242    * directions the file handle supports.
6243    */
6244
6245   if (!ReadFile (h, NULL, 0, &n, NULL))
6246     direction &= ~___DIRECTION_RD;
6247
6248   if (!WriteFile (h, NULL, 0, &n, NULL))
6249     direction &= ~___DIRECTION_WR;
6250
6251   /*
6252    * It is likely that on some systems a zero length "ReadFile" and
6253    * "WriteFile" will return an error, regardless of the possible
6254    * operations.  In this case assume that both operations are
6255    * possible.
6256    */
6257
6258   if (direction == 0)
6259     direction = ___DIRECTION_RD|___DIRECTION_WR;
6260
6261   return direction;
6262 }
6263
6264
6265 ___SCMOBJ ___device_stream_setup_from_handle
6266    ___P((___device_stream **dev,
6267          ___device_group *dgroup,
6268          HANDLE h,
6269          int flags,
6270          int kind,
6271          int direction),
6272         (dev,
6273          dgroup,
6274          h,
6275          flags,
6276          kind,
6277          direction)
6278 ___device_stream **dev;
6279 ___device_group *dgroup;
6280 HANDLE h;
6281 int flags;
6282 int kind;
6283 int direction;)
6284 {
6285   ___SCMOBJ e = ___FIX(___UNKNOWN_ERR);
6286
6287   if (kind == ___NONE_KIND)
6288     kind = ___device_stream_kind_from_handle (h);
6289
6290   if (direction == 0)
6291     direction = ___device_stream_direction_from_handle (h);
6292
6293 #ifdef ___DEBUG
6294   ___printf ("kind=%d direction=%d\n", kind, direction);
6295 #endif
6296
6297   switch (kind)
6298     {
6299     case ___TTY_DEVICE_KIND:
6300       {
6301         ___device_tty *d;
6302         if ((e = ___device_tty_setup_from_console
6303                    (&d,
6304                     dgroup,
6305                     direction))
6306             == ___FIX(___NO_ERR))
6307           *dev = ___CAST(___device_stream*,d);
6308         break;
6309       }
6310
6311     case ___SERIAL_DEVICE_KIND:
6312       {
6313         ___device_serial *d;
6314         if ((e = ___device_serial_setup_from_handle
6315                    (&d,
6316                     dgroup,
6317                     h,
6318                     direction))
6319             == ___FIX(___NO_ERR))
6320           *dev = ___CAST(___device_stream*,d);
6321         break;
6322       }
6323
6324     case ___FILE_DEVICE_KIND:
6325       {
6326         ___device_file *d;
6327         if ((e = ___device_file_setup_from_handle
6328                    (&d,
6329                     dgroup,
6330                     h,
6331                     flags,
6332                     direction,
6333                     0))
6334             == ___FIX(___NO_ERR))
6335           *dev = ___CAST(___device_stream*,d);
6336         break;
6337       }
6338
6339     case ___PIPE_DEVICE_KIND:
6340       {
6341         ___device_pipe *d;
6342         if ((e = ___device_pipe_setup_from_handle
6343                    (&d,
6344                     dgroup,
6345                     h,
6346                     h,
6347                     direction,
6348                     0))
6349             == ___FIX(___NO_ERR))
6350           *dev = ___CAST(___device_stream*,d);
6351         break;
6352       }
6353
6354     default:
6355       {
6356         e = ___FIX(___UNKNOWN_ERR);
6357         break;
6358       }
6359     }
6360
6361   if (e == ___FIX(___NO_ERR))
6362     device_transfer_close_responsibility (___CAST(___device*,*dev));
6363
6364   return e;
6365 }
6366
6367
6368 ___HIDDEN void device_translate_flags
6369    ___P((int flags,
6370          DWORD *access_mode,
6371          DWORD *share_mode,
6372          DWORD *creation_mode,
6373          DWORD *attributes,
6374          int *direction),
6375         (flags,
6376          access_mode,
6377          share_mode,
6378          creation_mode,
6379          attributes,
6380          direction)
6381 int flags;
6382 DWORD *access_mode;
6383 DWORD *share_mode;
6384 DWORD *creation_mode;
6385 DWORD *attributes;
6386 int *direction;)
6387 {
6388   DWORD am;
6389   DWORD cm;
6390
6391   switch ((flags >> 4) & 3)
6392     {
6393     default:
6394     case 1:
6395       am = GENERIC_READ;
6396       *direction = ___DIRECTION_RD;
6397       break;
6398     case 2:
6399       am = GENERIC_WRITE;
6400       *direction = ___DIRECTION_WR;
6401       break;
6402     case 3:
6403       am = GENERIC_READ|GENERIC_WRITE;
6404       *direction = ___DIRECTION_RD|___DIRECTION_WR;
6405       break;
6406     }
6407
6408   switch ((flags >> 1) & 3)
6409     {
6410     default:
6411     case 0:
6412       if (flags & 1)
6413         cm = TRUNCATE_EXISTING;
6414       else
6415         cm = OPEN_EXISTING;
6416       break;
6417
6418     case 1:
6419       if (flags & 1)
6420         cm = CREATE_ALWAYS;
6421       else
6422         cm = OPEN_ALWAYS;
6423       break;
6424
6425     case 2:
6426       cm = CREATE_NEW;
6427       break;
6428     }
6429
6430   *access_mode = am;
6431   *share_mode = FILE_SHARE_READ|FILE_SHARE_WRITE|FILE_SHARE_DELETE;
6432   *creation_mode = cm;
6433   *attributes = FILE_ATTRIBUTE_NORMAL;
6434 }
6435
6436 #endif
6437
6438
6439 /*---------------------------------------------------------------------------*/
6440
6441 #ifdef USE_execvp
6442 #define ___STREAM_OPEN_PROCESS_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
6443 #ifndef USE_openpty
6444 #ifndef USE_ptsname
6445 #undef ___STREAM_OPEN_PROCESS_CE_SELECT
6446 #endif
6447 #endif
6448 #endif
6449
6450 #ifdef USE_CreateProcess
6451 #ifdef _UNICODE
6452 #define ___STREAM_OPEN_PROCESS_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
6453 #define CP_ENV_FLAGS CREATE_UNICODE_ENVIRONMENT
6454 #else
6455 #define ___STREAM_OPEN_PROCESS_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
6456 #define CP_ENV_FLAGS 0
6457 #endif
6458 #endif
6459
6460
6461 #ifdef ___STREAM_OPEN_PROCESS_CE_SELECT
6462
6463 #ifdef USE_execvp
6464
6465 /**********************************/
6466 #define USE_pipe
6467
6468 typedef struct half_duplex_pipe
6469   {
6470     int reading_fd;
6471     int writing_fd;
6472   } half_duplex_pipe;
6473
6474 typedef struct full_duplex_pipe
6475   {
6476     half_duplex_pipe input;
6477     half_duplex_pipe output;
6478   } full_duplex_pipe;
6479
6480
6481 ___HIDDEN int open_half_duplex_pipe
6482    ___P((half_duplex_pipe *hdp),
6483         (hdp)
6484 half_duplex_pipe *hdp;)
6485 {
6486   int fds[2];
6487
6488 #ifdef USE_pipe
6489   if (pipe (fds) < 0)
6490     return -1;
6491 #endif
6492
6493 #ifdef USE_socketpair
6494   if (socketpair (AF_UNIX, SOCK_STREAM, 0, fds) < 0)
6495     return -1;
6496 #endif
6497
6498   hdp->reading_fd = fds[0];
6499   hdp->writing_fd = fds[1];
6500
6501   return 0;
6502 }
6503
6504 ___HIDDEN void close_half_duplex_pipe
6505    ___P((half_duplex_pipe *hdp,
6506          int end),
6507         (hdp,
6508          end)
6509 half_duplex_pipe *hdp;
6510 int end;)
6511 {
6512   if (end != 1 && hdp->reading_fd >= 0)
6513     {
6514       close_no_EINTR (hdp->reading_fd); /* ignore error */
6515       hdp->reading_fd = -1;
6516     }
6517
6518   if (end != 0 && hdp->writing_fd >= 0)
6519     {
6520       close_no_EINTR (hdp->writing_fd); /* ignore error */
6521       hdp->writing_fd = -1;
6522     }
6523 }
6524
6525 ___HIDDEN int open_pseudo_terminal_master
6526    ___P((int *master_fd_ptr,
6527          int *slave_fd_ptr),
6528         (master_fd_ptr,
6529          slave_fd_ptr)
6530 int *master_fd_ptr;
6531 int *slave_fd_ptr;)
6532 {
6533 #ifdef USE_openpty
6534
6535   return openpty (master_fd_ptr, slave_fd_ptr, NULL, NULL, NULL);
6536
6537 #else
6538 #ifdef USE_getpt
6539
6540   *slave_fd_ptr = -1;
6541   return *master_fd_ptr = getpt ();
6542
6543 #else
6544
6545   *slave_fd_ptr = -1;
6546   return *master_fd_ptr = open ("/dev/ptmx", O_RDWR | O_NOCTTY);
6547
6548 #endif
6549 #endif
6550 }
6551
6552
6553 #if 0
6554 #ifndef USE_openpty
6555 /***************************/
6556 #define __USE_XOPEN
6557 #define __USE_GNU
6558 #include <stdlib.h>
6559 #include <stropts.h>
6560 extern char *ptsname (int __fd);
6561 #endif
6562 #endif
6563
6564 ___HIDDEN int setup_terminal_slave
6565    ___P((int slave_fd),
6566         (slave_fd)
6567 int slave_fd;)
6568 {
6569   struct termios tios;
6570
6571   if (tcgetattr (slave_fd, &tios) >= 0)
6572     {
6573       tios.c_lflag &= ~(ECHO | ECHOCTL | ICANON | IEXTEN | ISIG);
6574       tios.c_iflag &= ~(BRKINT | INLCR | ICRNL | INPCK | ISTRIP | IXON | IXOFF);
6575       tios.c_cflag &= ~(CSIZE | PARENB | CLOCAL);
6576       tios.c_cflag |= (CS8 | HUPCL);
6577 #ifndef OCRNL
6578 #define OCRNL 0
6579 #endif
6580       tios.c_oflag &= ~(OPOST | ONLCR | OCRNL);
6581
6582       if (tcsetattr (slave_fd, TCSANOW, &tios) >= 0)
6583         return 0;
6584     }
6585
6586   return -1;
6587 }
6588
6589
6590 ___HIDDEN int open_pseudo_terminal_slave
6591    ___P((int master_fd,
6592          int *slave_fd),
6593         (master_fd,
6594          slave_fd)
6595 int master_fd;
6596 int *slave_fd;)
6597 {
6598 #ifndef USE_openpty
6599 #ifndef USE_ptsname
6600
6601   errno = xxx;/********************/
6602   return -1;
6603
6604 #endif
6605 #endif
6606
6607 #ifdef USE_openpty
6608
6609   return 0;
6610
6611 #endif
6612
6613 #ifdef USE_ptsname
6614
6615   int fd;
6616   char *name;
6617
6618   if (grantpt (master_fd) >= 0 &&
6619       unlockpt (master_fd) >= 0 &&
6620       (name = ptsname (master_fd)) != NULL &&
6621       (fd = open (name, O_RDWR)) >= 0)
6622     {
6623       int tmp;
6624
6625       if (
6626 #ifndef HAVE_isastream
6627           1
6628 #else
6629           !isastream (fd)
6630 #ifdef I_PUSH
6631           || (ioctl (fd, I_PUSH, "ptem") >= 0 &&
6632               ioctl (fd, I_PUSH, "ldterm") >= 0)
6633 #endif
6634 #endif
6635          )
6636         {
6637           *slave_fd = fd;
6638           return 0;
6639         }
6640
6641       tmp = errno;
6642       close_no_EINTR (fd); /* ignore error */
6643       errno = tmp;
6644     }
6645
6646   return -1;
6647
6648 #endif
6649 }
6650
6651
6652 ___HIDDEN int open_full_duplex_pipe1
6653    ___P((full_duplex_pipe *fdp,
6654          ___BOOL use_pty),
6655         (fdp,
6656          use_pty)
6657 full_duplex_pipe *fdp;
6658 ___BOOL use_pty;)
6659 {
6660   fdp->input.reading_fd = -1;
6661   fdp->input.writing_fd = -1;
6662   fdp->output.reading_fd = -1;
6663   fdp->output.writing_fd = -1;
6664
6665   if (use_pty)
6666     {
6667       int master_fd;
6668       int slave_fd;
6669       if (open_pseudo_terminal_master (&master_fd, &slave_fd) >= 0)
6670         {
6671           int master_fd_dup;
6672           int tmp;
6673           if ((master_fd_dup = dup_no_EINTR (master_fd)) >= 0)
6674             {
6675               fdp->input.writing_fd = master_fd;
6676               fdp->output.reading_fd = master_fd_dup;
6677               fdp->input.reading_fd = slave_fd;
6678               return 0;
6679             }
6680           tmp = errno;
6681           close_no_EINTR (master_fd); /* ignore error */
6682           if (slave_fd >= 0)
6683             close_no_EINTR (slave_fd); /* ignore error */
6684           errno = tmp;
6685         }
6686     }
6687   else
6688     {
6689       if (open_half_duplex_pipe (&fdp->input) >= 0)
6690         {
6691           if (open_half_duplex_pipe (&fdp->output) >= 0)
6692             return 0;
6693           close_half_duplex_pipe (&fdp->input, 2);
6694         }
6695     }
6696
6697   return -1;
6698 }
6699
6700
6701 ___HIDDEN int open_full_duplex_pipe2
6702    ___P((full_duplex_pipe *fdp,
6703          ___BOOL use_pty),
6704         (fdp,
6705          use_pty)
6706 full_duplex_pipe *fdp;
6707 ___BOOL use_pty;)
6708 {
6709   if (use_pty)
6710     {
6711       if (setsid () >= 0 &&
6712 #ifdef TIOCSCTTY
6713           ioctl (fdp->input.reading_fd, TIOCSCTTY, 0) >= 0 &&
6714 #endif
6715           open_pseudo_terminal_slave (fdp->input.writing_fd,
6716                                       &fdp->input.reading_fd) >= 0)
6717         {
6718           int tmp;
6719           if (setup_terminal_slave (fdp->input.reading_fd) >= 0 &&
6720               (fdp->output.writing_fd = dup_no_EINTR (fdp->input.reading_fd)) >= 0)
6721             return 0;
6722           tmp = errno;
6723           close_no_EINTR (fdp->input.reading_fd); /* ignore error */
6724           errno = tmp;
6725         }
6726     }
6727   else
6728     return 0;
6729
6730   return -1;
6731 }
6732
6733 #endif
6734
6735
6736 #ifdef USE_CreateProcess
6737
6738 #define ___ESCAPE_PROCESS_ARGS
6739
6740 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) argv_to_ccmd
6741    ___P((___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *argv),
6742         (argv)
6743 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *argv;)
6744 {
6745   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) ccmd;
6746   int ccmd_len = 0;
6747   int i = 0;
6748   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) arg;
6749
6750   while ((arg = argv[i]) != NULL)
6751     {
6752       int j = 0;
6753
6754       while (arg[j] != ___UNICODE_NUL)
6755         j++;
6756
6757       ccmd_len += j + 1;
6758
6759 #ifdef ___ESCAPE_PROCESS_ARGS
6760
6761       {
6762         ___BOOL double_backslash = TRUE;
6763
6764         while (--j >= 0)
6765           {
6766             ___CHAR_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) c = arg[j];
6767             if (c == ___UNICODE_DOUBLEQUOTE ||
6768                 (double_backslash && c == ___UNICODE_BACKSLASH))
6769               {
6770                 double_backslash = TRUE;
6771                 ccmd_len++;
6772               }
6773             else
6774               double_backslash = FALSE;
6775           }
6776
6777         ccmd_len += 2;
6778       }
6779
6780 #endif
6781
6782       i++;
6783     }
6784
6785   ccmd = ___CAST(___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT),
6786                  ___alloc_mem (ccmd_len * sizeof (*ccmd)));
6787
6788   if (ccmd != NULL)
6789     {
6790       ccmd[--ccmd_len] = ___UNICODE_NUL;
6791
6792       while (--i >= 0)
6793         {
6794           int j = 0;
6795
6796           arg = argv[i];
6797
6798           while (arg[j] != ___UNICODE_NUL)
6799             j++;
6800
6801 #ifdef ___ESCAPE_PROCESS_ARGS
6802
6803           {
6804             ___BOOL double_backslash = TRUE;
6805
6806             ccmd[--ccmd_len] = ___UNICODE_DOUBLEQUOTE;
6807
6808             while (--j >= 0)
6809               {
6810                 ___CHAR_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) c = arg[j];
6811                 ccmd[--ccmd_len] = c;
6812                 if (c == ___UNICODE_DOUBLEQUOTE ||
6813                     (double_backslash && c == ___UNICODE_BACKSLASH))
6814                   {
6815                     ccmd[--ccmd_len] = ___UNICODE_BACKSLASH;
6816                     double_backslash = TRUE;
6817                   }
6818                 else
6819                   double_backslash = FALSE;
6820               }
6821
6822             ccmd[--ccmd_len] = ___UNICODE_DOUBLEQUOTE;
6823           }
6824
6825 #else
6826
6827           while (--j >= 0)
6828             {
6829               ___CHAR_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) c = arg[j];
6830               ccmd[--ccmd_len] = c;
6831             }
6832
6833 #endif
6834
6835           if (i > 0)
6836             ccmd[--ccmd_len] = ___UNICODE_SPACE;
6837         }
6838     }
6839
6840   return ccmd;
6841 }
6842
6843 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) env_to_cenv
6844    ___P((___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *env),
6845         (env)
6846 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *env;)
6847 {
6848   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) cenv;
6849   int cenv_len = 0;
6850   int i = 0;
6851   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) varval;
6852
6853   while ((varval = env[i++]) != NULL)
6854     {
6855       int j = 0;
6856       while (varval[j++] != ___UNICODE_NUL)
6857         ;
6858       cenv_len += j;
6859     }
6860
6861   cenv_len++;
6862
6863   cenv = ___CAST(___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT),
6864                  ___alloc_mem (cenv_len * sizeof (*cenv)));
6865
6866   if (cenv != NULL)
6867     {
6868       ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) p = cenv;
6869       i = 0;
6870
6871       while ((varval = env[i++]) != NULL)
6872         {
6873           int j = 0;
6874           while ((*p++ = varval[j++]) != ___UNICODE_NUL)
6875             ;
6876         }
6877
6878       *p++ = ___UNICODE_NUL;
6879     }
6880
6881   return cenv;
6882 }
6883
6884 #endif
6885
6886
6887 ___SCMOBJ ___device_stream_setup_from_process
6888    ___P((___device_stream **dev,
6889          ___device_group *dgroup,
6890          ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *argv,
6891          ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *env,
6892          ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) dir,
6893          int options),
6894         (dev,
6895          dgroup,
6896          argv,
6897          env,
6898          dir,
6899          options)
6900 ___device_stream **dev;
6901 ___device_group *dgroup;
6902 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *argv;
6903 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) *env;
6904 ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) dir;
6905 int options;)
6906 {
6907 #define STDIN_REDIR  1
6908 #define STDOUT_REDIR 2
6909 #define STDERR_REDIR 4
6910 #define PSEUDO_TERM  8
6911 #define SHOW_CONSOLE 16
6912
6913 #ifdef USE_execvp
6914
6915   ___SCMOBJ e = ___FIX(___NO_ERR);
6916   int direction;
6917   ___device_process *d;
6918   pid_t pid = 0;
6919   half_duplex_pipe hdp_errno;
6920   full_duplex_pipe fdp;
6921   int execvp_errno;
6922   int n;
6923
6924   /*
6925    * Block SIGCHLD so that if the process is created the
6926    * sigchld_signal_handler will find it in the device group.
6927    */
6928
6929   sigset_type oldmask = block_signal (SIGCHLD);
6930
6931   fdp.input.writing_fd = -1;
6932   fdp.output.reading_fd = -1;
6933
6934   if (open_half_duplex_pipe (&hdp_errno) < 0)
6935     e = err_code_from_errno ();
6936   else
6937     {
6938       if ((options & (STDIN_REDIR | STDOUT_REDIR | STDERR_REDIR)) &&
6939           open_full_duplex_pipe1 (&fdp, options & PSEUDO_TERM) < 0)
6940         e = err_code_from_errno ();
6941       else
6942         {
6943           ___disable_os_interrupts ();
6944
6945           if ((pid = fork ()) < 0)
6946             {
6947               e = err_code_from_errno ();
6948               if (options & (STDIN_REDIR | STDOUT_REDIR | STDERR_REDIR))
6949                 {
6950                   close_half_duplex_pipe (&fdp.input, 2);
6951                   close_half_duplex_pipe (&fdp.output, 2);
6952                 }
6953             }
6954
6955           if (pid > 0)
6956             ___enable_os_interrupts ();
6957         }
6958
6959       if (e != ___FIX(___NO_ERR))
6960         close_half_duplex_pipe (&hdp_errno, 2);
6961     }
6962
6963   if (e == ___FIX(___NO_ERR))
6964     {
6965       if (pid == 0)
6966         {
6967           /* child process */
6968
6969           restore_sigmask (oldmask);
6970
6971           ___cleanup_os_interrupt_handling ();
6972
6973           if (options & (STDIN_REDIR | STDOUT_REDIR | STDERR_REDIR))
6974             {
6975               if (open_full_duplex_pipe2 (&fdp, options & PSEUDO_TERM) < 0 ||
6976                   ((options & STDIN_REDIR) &&
6977                    dup2_no_EINTR (fdp.input.reading_fd, STDIN_FILENO) < 0) ||
6978                   ((options & STDOUT_REDIR) &&
6979                    dup2_no_EINTR (fdp.output.writing_fd, STDOUT_FILENO) < 0) ||
6980                   ((options & (STDERR_REDIR | PSEUDO_TERM)) &&
6981                    dup2_no_EINTR (fdp.output.writing_fd, STDERR_FILENO) < 0))
6982                 goto return_errno;
6983             }
6984
6985           if (fcntl (hdp_errno.writing_fd, F_SETFD, FD_CLOEXEC) < 0)
6986             goto return_errno;
6987
6988           close_half_duplex_pipe (&fdp.input, 1);
6989           close_half_duplex_pipe (&fdp.output, 0);
6990           close_half_duplex_pipe (&hdp_errno, 0);
6991
6992           {
6993             /* Close all file descriptors that aren't used. */
6994
6995             int fd = sysconf (_SC_OPEN_MAX) - 1;
6996
6997             while (fd >= 0)
6998               {
6999                 if (fd != STDIN_FILENO &&
7000                     fd != STDOUT_FILENO &&
7001                     fd != STDERR_FILENO &&
7002                     fd != hdp_errno.writing_fd)
7003                   close_no_EINTR (fd); /* ignore error */
7004                 fd--;
7005               }
7006           }
7007
7008           if (dir == NULL || chdir (dir) == 0)
7009             {
7010 #ifdef USE_environ
7011               if (env != NULL)
7012                 environ = env;
7013 #endif
7014               execvp (argv[0], argv);
7015               /* the exec failed, errno will be returned to parent */
7016             }
7017
7018         return_errno:
7019
7020           /* return the errno to the parent process */
7021
7022           execvp_errno = errno;
7023
7024           write (hdp_errno.writing_fd, &execvp_errno, sizeof (execvp_errno));
7025
7026           close_half_duplex_pipe (&fdp.input, 0);
7027           close_half_duplex_pipe (&fdp.output, 1);
7028           close_half_duplex_pipe (&hdp_errno, 1);
7029
7030           _exit (1);
7031         }
7032
7033       /* parent process */
7034
7035       if (options & (STDIN_REDIR | STDOUT_REDIR | STDERR_REDIR))
7036         {
7037           close_half_duplex_pipe (&fdp.input, 0);
7038           close_half_duplex_pipe (&fdp.output, 1);
7039         }
7040
7041       close_half_duplex_pipe (&hdp_errno, 1);
7042
7043       /*
7044        * The following call to read has been known to fail with EINTR,
7045        * in particular on OpenBSD 4.5.  This is probably because the
7046        * child process that is started terminates before the parent
7047        * process doing the read has time to wakeup.  So the parent
7048        * process receives a SIGCHLD signal which interrupts the read.
7049        */
7050
7051       n = read_no_EINTR (hdp_errno.reading_fd,
7052                          &execvp_errno,
7053                          sizeof (execvp_errno));
7054
7055       if (n < 0)
7056         e = err_code_from_errno ();
7057       else if (n == sizeof (execvp_errno))
7058         {
7059           errno = execvp_errno;
7060           e = err_code_from_errno ();
7061         }
7062       else if (n != 0)
7063         e = ___FIX(___UNKNOWN_ERR);
7064       else
7065         {
7066           direction = ___DIRECTION_RD|___DIRECTION_WR;
7067
7068           e = ___device_process_setup_from_pid
7069                 (&d,
7070                  dgroup,
7071                  pid,
7072                  fdp.input.writing_fd,
7073                  fdp.output.reading_fd,
7074                  direction);
7075
7076           *dev = ___CAST(___device_stream*,d);
7077
7078           if (e == ___FIX(___NO_ERR))
7079             device_transfer_close_responsibility (___CAST(___device*,d));
7080         }
7081
7082       if (e != ___FIX(___NO_ERR))
7083         if (options & (STDIN_REDIR | STDOUT_REDIR | STDERR_REDIR))
7084           {
7085             close_half_duplex_pipe (&fdp.input, 1);
7086             close_half_duplex_pipe (&fdp.output, 0);
7087           }
7088
7089       close_half_duplex_pipe (&hdp_errno, 0);
7090     }
7091
7092   restore_sigmask (oldmask);
7093
7094   return e;
7095
7096 #endif
7097
7098 #ifdef USE_CreateProcess
7099
7100   ___SCMOBJ e;
7101   int direction;
7102   ___device_process *d;
7103
7104   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) ccmd;
7105   ___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT) cenv = NULL;
7106
7107   HANDLE hstdin_rd = NULL;
7108   HANDLE hstdin_wr = NULL;
7109   HANDLE hstdout_rd = NULL;
7110   HANDLE hstdout_wr = NULL;
7111
7112   SECURITY_ATTRIBUTES sa;
7113   PROCESS_INFORMATION pi;
7114   STARTUPINFO si;
7115
7116   sa.nLength = sizeof (SECURITY_ATTRIBUTES);
7117   sa.bInheritHandle = TRUE;
7118   sa.lpSecurityDescriptor = NULL;
7119
7120   if ((ccmd = argv_to_ccmd (argv)) == NULL ||
7121       (env != NULL && (cenv = env_to_cenv (env)) == NULL))
7122     e = ___FIX(___HEAP_OVERFLOW_ERR);
7123   else
7124     {
7125       ZeroMemory (&pi, sizeof (pi));
7126
7127       ZeroMemory (&si, sizeof (si));
7128       si.cb = sizeof (si);
7129
7130       si.hStdInput  = GetStdHandle (STD_INPUT_HANDLE);
7131       si.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE);
7132       si.hStdError  = GetStdHandle (STD_ERROR_HANDLE);
7133
7134       if (options & STDIN_REDIR)
7135         {
7136           if (!CreatePipe (&hstdin_rd, &hstdin_wr, &sa, 0))
7137             e = err_code_from_GetLastError ();
7138           else
7139             {
7140               SetHandleInformation (hstdin_wr, HANDLE_FLAG_INHERIT, 0);
7141               si.hStdInput = hstdin_rd;
7142             }
7143         }
7144
7145       if (options & (STDOUT_REDIR | STDERR_REDIR))
7146         {
7147           if (!CreatePipe (&hstdout_rd, &hstdout_wr, &sa, 0))
7148             e = err_code_from_GetLastError ();
7149           else
7150             {
7151               SetHandleInformation (hstdout_rd, HANDLE_FLAG_INHERIT, 0);
7152               if (options & STDOUT_REDIR)
7153                 si.hStdOutput = hstdout_wr;
7154               if (options & STDERR_REDIR)
7155                 si.hStdError = hstdout_wr;
7156             }
7157         }
7158
7159       si.dwFlags |= STARTF_USESTDHANDLES;
7160
7161 #if 0
7162       if (hstdin_wr != NULL)
7163         {
7164           HANDLE h_wr;
7165           if (DuplicateHandle (GetCurrentProcess (),
7166                                hstdin_wr,
7167                                GetCurrentProcess (),
7168                                &h_wr,
7169                                0,
7170                                FALSE,
7171                                DUPLICATE_SAME_ACCESS))
7172             {
7173               CloseHandle (hstdin_wr);
7174               hstdin_wr = h_wr;
7175             }
7176         }
7177
7178       if (hstdout_rd != NULL)
7179         {
7180           HANDLE h_rd;
7181           if (DuplicateHandle (GetCurrentProcess (),
7182                                hstdout_rd,
7183                                GetCurrentProcess (),
7184                                &h_rd,
7185                                0,
7186                                FALSE,
7187                                DUPLICATE_SAME_ACCESS))
7188             {
7189               CloseHandle (hstdout_rd);
7190               hstdout_rd = h_rd;
7191             }
7192         }
7193 #endif
7194
7195       if (si.hStdError == INVALID_HANDLE_VALUE ||
7196           !CreateProcess
7197              (NULL, /* module name                              */
7198               ccmd, /* command line                             */
7199               NULL, /* process handle not inheritable           */
7200               NULL, /* thread handle not inheritable            */
7201               TRUE, /* set handle inheritance to TRUE           */
7202               (CP_ENV_FLAGS | ((options & SHOW_CONSOLE) ? 0 : CREATE_NO_WINDOW)), /* creation flags */
7203               cenv, /* child's environment                      */
7204               dir,  /* child's starting directory               */
7205               &si,  /* pointer to STARTUPINFO structure         */
7206               &pi)) /* pointer to PROCESS_INFORMATION structure */
7207         e = err_code_from_GetLastError ();
7208       else
7209         {
7210           direction = ___DIRECTION_RD|___DIRECTION_WR;
7211
7212           e = ___device_process_setup_from_process
7213                 (&d,
7214                  dgroup,
7215                  pi,
7216                  hstdin_wr,
7217                  hstdout_rd,
7218                  direction);
7219
7220           *dev = ___CAST(___device_stream*,d);
7221
7222           if (e == ___FIX(___NO_ERR))
7223             device_transfer_close_responsibility (___CAST(___device*,d));
7224         }
7225     }
7226
7227   if (hstdout_rd != NULL)
7228     CloseHandle (hstdout_wr); /* ignore error */
7229
7230   if (hstdin_rd != NULL)
7231     CloseHandle (hstdin_rd); /* ignore error */
7232
7233   if (e != ___FIX(___NO_ERR))
7234     {
7235       if (hstdout_rd != NULL)
7236         CloseHandle (hstdout_rd); /* ignore error */
7237
7238       if (hstdin_rd != NULL)
7239         CloseHandle (hstdin_wr); /* ignore error */
7240     }
7241
7242   if (cenv != NULL)
7243     ___free_mem (cenv);
7244
7245   if (ccmd != NULL)
7246     ___free_mem (ccmd);
7247
7248   return e;
7249
7250 #endif
7251 }
7252
7253 #endif
7254
7255
7256 ___SCMOBJ ___os_device_process_pid
7257    ___P((___SCMOBJ dev),
7258         (dev)
7259 ___SCMOBJ dev;)
7260 {
7261   ___device_process *d =
7262     ___CAST(___device_process*,___FIELD(dev,___FOREIGN_PTR));
7263
7264 #ifndef USE_POSIX
7265 #ifndef USE_WIN32
7266
7267   return ___FIX(0);
7268
7269 #endif
7270 #endif
7271
7272 #ifdef USE_POSIX
7273
7274   return ___FIX(d->pid);
7275
7276 #endif
7277
7278 #ifdef USE_WIN32
7279
7280   return ___FIX(d->pi.dwProcessId);
7281
7282 #endif
7283 }
7284
7285
7286 ___SCMOBJ ___os_device_process_status
7287    ___P((___SCMOBJ dev),
7288         (dev)
7289 ___SCMOBJ dev;)
7290 {
7291   ___device_process *d =
7292     ___CAST(___device_process*,___FIELD(dev,___FOREIGN_PTR));
7293   ___SCMOBJ e;
7294
7295   if ((e = ___device_process_status_poll (d)) != ___FIX(___NO_ERR))
7296     return e;
7297
7298   if (!d->got_status)
7299     return ___FAL;
7300
7301   return ___FIX(d->status);
7302 }
7303
7304
7305 /*---------------------------------------------------------------------------*/
7306
7307 #ifndef USE_POSIX
7308 #ifndef USE_WIN32
7309 #define ___STREAM_OPEN_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
7310 #endif
7311 #endif
7312
7313 #ifdef USE_POSIX
7314 #define ___STREAM_OPEN_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
7315 #endif
7316
7317 #ifdef USE_WIN32
7318 #ifdef _UNICODE
7319 #define ___STREAM_OPEN_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) ucs2
7320 #else
7321 #define ___STREAM_OPEN_PATH_CE_SELECT(latin1,utf8,ucs2,ucs4,wchar,native) native
7322 #endif
7323 #endif
7324
7325
7326 #ifdef ___STREAM_OPEN_PATH_CE_SELECT
7327
7328 ___SCMOBJ ___device_stream_setup_from_path
7329    ___P((___device_stream **dev,
7330          ___device_group *dgroup,
7331          ___STRING_TYPE(___STREAM_OPEN_PATH_CE_SELECT) path,
7332          int flags,
7333          int mode),
7334         (dev,
7335          dgroup,
7336          path,
7337          flags,
7338          mode)
7339 ___device_stream **dev;
7340 ___device_group *dgroup;
7341 ___STRING_TYPE(___STREAM_OPEN_PATH_CE_SELECT) path;
7342 int flags;
7343 int mode;)
7344 {
7345   ___SCMOBJ e;
7346
7347 #ifndef USE_POSIX
7348 #ifndef USE_WIN32
7349
7350   char *mod;
7351   int direction;
7352   ___FILE *stream;
7353
7354   device_translate_flags (flags,
7355                           &mod,
7356                           &direction);
7357
7358 #ifdef ___DEBUG
7359   ___printf ("path=\"%s\" mode=%s\n", path, mod);
7360 #endif
7361
7362   if ((stream = ___fopen (path, mod)) == 0)
7363     return fnf_or_err_code_from_errno ();
7364
7365   if ((e = ___device_stream_setup_from_stream
7366              (dev,
7367               dgroup,
7368               stream,
7369               ___NONE_KIND,
7370               direction))
7371       != ___FIX(___NO_ERR))
7372     ___fclose (stream); /* ignore error */
7373
7374 #endif
7375 #endif
7376
7377 #ifdef USE_POSIX
7378
7379   int fl;
7380   int direction;
7381   int fd;
7382
7383   device_translate_flags (flags,
7384                           &fl,
7385                           &direction);
7386
7387 #ifdef ___DEBUG
7388   ___printf ("path=\"%s\" fl=%d\n", path, fl);
7389 #endif
7390
7391   if ((fd = open (path,
7392                   fl,
7393 #ifdef O_BINARY
7394                   O_BINARY|
7395 #endif
7396                   mode))
7397       < 0)
7398     return fnf_or_err_code_from_errno ();
7399
7400   if ((e = ___device_stream_setup_from_fd
7401              (dev,
7402               dgroup,
7403               fd,
7404               ___NONE_KIND,
7405               direction))
7406       != ___FIX(___NO_ERR))
7407     close_no_EINTR (fd); /* ignore error */
7408
7409 #endif
7410
7411 #ifdef USE_WIN32
7412
7413   DWORD access_mode;
7414   DWORD share_mode;
7415   DWORD creation_mode;
7416   DWORD attributes;
7417   int direction;
7418   HANDLE h;
7419
7420   device_translate_flags (flags,
7421                           &access_mode,
7422                           &share_mode,
7423                           &creation_mode,
7424                           &attributes,
7425                           &direction);
7426
7427   h = CreateFile (path,
7428                   access_mode,
7429                   share_mode,
7430                   NULL,
7431                   creation_mode,
7432                   attributes,
7433                   NULL);
7434
7435   if (h == INVALID_HANDLE_VALUE)
7436     return fnf_or_err_code_from_GetLastError ();
7437
7438   if ((e = ___device_stream_setup_from_handle
7439              (dev,
7440               dgroup,
7441               h,
7442               flags,
7443               ___NONE_KIND,
7444               direction))
7445       != ___FIX(___NO_ERR))
7446     CloseHandle (h); /* ignore error */
7447
7448 #endif
7449
7450   if (e == ___FIX(___NO_ERR))
7451     device_transfer_close_responsibility (___CAST(___device*,*dev));
7452
7453   return e;
7454 }
7455
7456 #endif
7457
7458
7459 /*---------------------------------------------------------------------------*/
7460
7461 /* Device operations. */
7462
7463 ___SCMOBJ ___os_device_kind
7464    ___P((___SCMOBJ dev),
7465         (dev)
7466 ___SCMOBJ dev;)
7467 {
7468   ___device *d = ___CAST(___device*,___FIELD(dev,___FOREIGN_PTR));
7469
7470   return ___FIX(___device_kind (d));
7471 }
7472
7473
7474 ___SCMOBJ ___os_device_force_output
7475    ___P((___SCMOBJ dev,
7476          ___SCMOBJ level),
7477         (dev,
7478          level)
7479 ___SCMOBJ dev;
7480 ___SCMOBJ level;)
7481 {
7482   ___device *d = ___CAST(___device*,___FIELD(dev,___FOREIGN_PTR));
7483
7484   return ___device_force_output (d, ___INT(level));
7485 }
7486
7487
7488 ___SCMOBJ ___os_device_close
7489    ___P((___SCMOBJ dev,
7490          ___SCMOBJ direction),
7491         (dev,
7492          direction)
7493 ___SCMOBJ dev;
7494 ___SCMOBJ direction;)
7495 {
7496   ___device *d = ___CAST(___device*,___FIELD(dev,___FOREIGN_PTR));
7497
7498   return ___device_close (d, ___INT(direction));
7499 }
7500
7501
7502 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
7503
7504 /* Stream device operations. */
7505
7506 ___SCMOBJ ___os_device_stream_seek
7507    ___P((___SCMOBJ dev,
7508          ___SCMOBJ pos,
7509          ___SCMOBJ whence),
7510         (dev,
7511          pos,
7512          whence)
7513 ___SCMOBJ dev;
7514 ___SCMOBJ pos;
7515 ___SCMOBJ whence;)
7516 {
7517   ___device_stream *d =
7518     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7519   ___S32 p;
7520   ___SCMOBJ e;
7521   ___SCMOBJ result;
7522
7523   if ((e = ___SCMOBJ_to_S32 (pos, &p, 2)) == ___FIX(___NO_ERR))
7524     e = ___device_stream_seek (d, &p, ___INT(whence));
7525
7526   if (e != ___FIX(___NO_ERR) ||
7527       (e = ___S32_to_SCMOBJ (p, &result, ___RETURN_POS)) != ___FIX(___NO_ERR))
7528     result = e;
7529
7530   return result;
7531 }
7532
7533
7534 ___SCMOBJ ___os_device_stream_read
7535    ___P((___SCMOBJ dev,
7536          ___SCMOBJ buffer,
7537          ___SCMOBJ lo,
7538          ___SCMOBJ hi),
7539         (dev,
7540          buffer,
7541          lo,
7542          hi)
7543 ___SCMOBJ dev;
7544 ___SCMOBJ buffer;
7545 ___SCMOBJ lo;
7546 ___SCMOBJ hi;)
7547 {
7548   ___device_stream *d =
7549     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7550   ___stream_index len_done;
7551   ___SCMOBJ e;
7552
7553   if ((e = ___device_stream_read
7554              (d,
7555               ___CAST(___U8*,___BODY_AS(buffer,___tSUBTYPED)) + ___INT(lo),
7556               ___INT(hi) - ___INT(lo),
7557               &len_done))
7558       == ___FIX(___NO_ERR))
7559     return ___FIX(len_done);
7560
7561   return e;
7562 }
7563
7564
7565 ___SCMOBJ ___os_device_stream_write
7566    ___P((___SCMOBJ dev,
7567          ___SCMOBJ buffer,
7568          ___SCMOBJ lo,
7569          ___SCMOBJ hi),
7570         (dev,
7571          buffer,
7572          lo,
7573          hi)
7574 ___SCMOBJ dev;
7575 ___SCMOBJ buffer;
7576 ___SCMOBJ lo;
7577 ___SCMOBJ hi;)
7578 {
7579   ___device_stream *d =
7580     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7581   ___stream_index len_done;
7582   ___SCMOBJ e;
7583
7584   if ((e = ___device_stream_write
7585              (d,
7586               ___CAST(___U8*,___BODY_AS(buffer,___tSUBTYPED)) + ___INT(lo),
7587               ___INT(hi) - ___INT(lo),
7588               &len_done))
7589       == ___FIX(___NO_ERR))
7590     return ___FIX(len_done);
7591
7592   return e;
7593 }
7594
7595
7596 ___SCMOBJ ___os_device_stream_width
7597    ___P((___SCMOBJ dev),
7598         (dev)
7599 ___SCMOBJ dev;)
7600 {
7601   ___device_stream *d =
7602     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7603
7604   return ___device_stream_width (d);
7605 }
7606
7607
7608 ___SCMOBJ ___os_device_stream_default_options
7609    ___P((___SCMOBJ dev),
7610         (dev)
7611 ___SCMOBJ dev;)
7612 {
7613   ___device_stream *d =
7614     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7615
7616   return ___device_stream_default_options (d);
7617 }
7618
7619
7620 ___SCMOBJ ___os_device_stream_options_set
7621    ___P((___SCMOBJ dev,
7622          ___SCMOBJ options),
7623         (dev,
7624          options)
7625 ___SCMOBJ dev;
7626 ___SCMOBJ options;)
7627 {
7628   ___device_stream *d =
7629     ___CAST(___device_stream*,___FIELD(dev,___FOREIGN_PTR));
7630
7631   return ___device_stream_options_set (d, options);
7632 }
7633
7634
7635 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
7636
7637 /* Opening a predefined device (stdin, stdout, stderr, console, etc). */
7638
7639 ___SCMOBJ ___os_device_stream_open_predefined
7640    ___P((___SCMOBJ index,
7641          ___SCMOBJ flags),
7642         (index,
7643          flags)
7644 ___SCMOBJ index;
7645 ___SCMOBJ flags;)
7646 {
7647   /*
7648    * The parameter "index" identifies the stream which is to be
7649    * associated with the returned device.  The stream must be
7650    * currently open.  The responsibility for closing the stream is not
7651    * transferred to the runtime system because the client may have to
7652    * do I/O on the stream after the runtime system terminates (for
7653    * example output on stdout).
7654    */
7655
7656   ___SCMOBJ e;
7657   ___device_stream *dev;
7658   ___SCMOBJ result;
7659
7660 #ifndef USE_POSIX
7661 #ifndef USE_WIN32
7662
7663   char *mode;
7664   int direction;
7665   ___FILE *stream;
7666
7667   device_translate_flags (___INT(flags),
7668                           &mode,
7669                           &direction);
7670
7671   switch (___INT(index))
7672     {
7673     default:
7674       {
7675         switch (___INT(index))
7676           {
7677           case -1:
7678             stream = ___stdin;
7679             break;
7680           case -2:
7681             stream = ___stdout;
7682             break;
7683           case -3:
7684             stream = ___stderr;
7685             break;
7686           case -4:
7687             stream = 0;
7688             break;
7689           default:
7690             stream = fdopen (___INT(index), mode);
7691             break;
7692           }
7693
7694         if ((e = ___device_stream_setup_from_stream
7695                    (&dev,
7696                     ___global_device_group (),
7697                     stream,
7698                     ___NONE_KIND,
7699                     direction))
7700             != ___FIX(___NO_ERR))
7701           return e;
7702
7703         break;
7704       }
7705     }
7706
7707 #endif
7708 #endif
7709
7710 #ifdef USE_POSIX
7711
7712   int fl;
7713   int direction;
7714   int fd;
7715
7716   device_translate_flags (___INT(flags),
7717                           &fl,
7718                           &direction);
7719
7720   switch (___INT(index))
7721     {
7722     case -4:
7723       {
7724         ___device_tty *d;
7725
7726         if ((e = ___device_tty_setup_console
7727                    (&d,
7728                     ___global_device_group (),
7729                     direction))
7730             != ___FIX(___NO_ERR))
7731           return e;
7732
7733         dev = ___CAST(___device_stream*,d);
7734
7735         break;
7736       }
7737
7738     default:
7739       {
7740         switch (___INT(index))
7741           {
7742           case -1:
7743             fd = STDIN_FILENO;
7744             break;
7745           case -2:
7746             fd = STDOUT_FILENO;
7747             break;
7748           case -3:
7749             fd = STDERR_FILENO;
7750             break;
7751           default:
7752             fd = ___INT(index);
7753             break;
7754           }
7755
7756         if ((e = ___device_stream_setup_from_fd
7757                    (&dev,
7758                     ___global_device_group (),
7759                     fd,
7760                     ___NONE_KIND,
7761                     direction))
7762             != ___FIX(___NO_ERR))
7763           return e;
7764
7765         break;
7766       }
7767     }
7768
7769 #endif
7770
7771 #ifdef USE_WIN32
7772
7773   DWORD access_mode;
7774   DWORD share_mode;
7775   DWORD creation_mode;
7776   DWORD attributes;
7777   int direction;
7778   HANDLE h;
7779
7780   device_translate_flags (___INT(flags),
7781                           &access_mode,
7782                           &share_mode,
7783                           &creation_mode,
7784                           &attributes,
7785                           &direction);
7786
7787   switch (___INT(index))
7788     {
7789     case -4:
7790     open_console:
7791       {
7792         ___device_tty *d;
7793
7794         if ((e = ___device_tty_setup_console
7795                    (&d,
7796                     ___global_device_group (),
7797                     direction))
7798             != ___FIX(___NO_ERR))
7799           return e;
7800
7801         dev = ___CAST(___device_stream*,d);
7802
7803         break;
7804       }
7805
7806     default:
7807       {
7808         switch (___INT(index))
7809           {
7810           default:
7811           case -1:
7812             h = GetStdHandle (STD_INPUT_HANDLE);
7813             break;
7814           case -2:
7815             h = GetStdHandle (STD_OUTPUT_HANDLE);
7816             break;
7817           case -3:
7818             h = GetStdHandle (STD_ERROR_HANDLE);
7819             break;
7820           }
7821
7822         if (h == INVALID_HANDLE_VALUE)
7823           return err_code_from_GetLastError ();
7824
7825         if (GetFileType (h) == FILE_TYPE_UNKNOWN)
7826           goto open_console;
7827
7828         if ((e = ___device_stream_setup_from_handle
7829                    (&dev,
7830                     ___global_device_group (),
7831                     h,
7832                     0,
7833                     ___NONE_KIND,
7834                     direction))
7835             != ___FIX(___NO_ERR))
7836           return e;
7837
7838         break;
7839       }
7840     }
7841
7842 #endif
7843
7844   e = ___NONNULLPOINTER_to_SCMOBJ
7845         (dev,
7846          ___FAL,
7847          ___device_cleanup_from_ptr,
7848          &result,
7849          ___RETURN_POS);
7850
7851   if (e != ___FIX(___NO_ERR))
7852     {
7853       ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
7854       return e;
7855     }
7856
7857   ___release_scmobj (result);
7858
7859   return result;
7860 }
7861
7862
7863 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
7864
7865 /* Opening a path. */
7866
7867 ___SCMOBJ ___os_device_stream_open_path
7868    ___P((___SCMOBJ path,
7869          ___SCMOBJ flags,
7870          ___SCMOBJ mode),
7871         (path,
7872          flags,
7873          mode)
7874 ___SCMOBJ path;
7875 ___SCMOBJ flags;
7876 ___SCMOBJ mode;)
7877 {
7878 #ifndef ___STREAM_OPEN_PATH_CE_SELECT
7879
7880   return ___FIX(___UNIMPL_ERR);
7881
7882 #else
7883
7884   ___SCMOBJ e;
7885   ___SCMOBJ result;
7886   ___device_stream *dev;
7887   void *cpath;
7888
7889   if ((e = ___SCMOBJ_to_NONNULLSTRING
7890              (path,
7891               &cpath,
7892               1,
7893               ___CE(___STREAM_OPEN_PATH_CE_SELECT),
7894               0))
7895       != ___FIX(___NO_ERR))
7896     result = e;
7897   else
7898     {
7899       ___STRING_TYPE(___STREAM_OPEN_PATH_CE_SELECT) p =
7900         ___CAST(___STRING_TYPE(___STREAM_OPEN_PATH_CE_SELECT),cpath);
7901
7902       if ((e = ___device_stream_setup_from_path
7903                  (&dev,
7904                   ___global_device_group (),
7905                   p,
7906                   ___INT(flags),
7907                   ___INT(mode)))
7908           != ___FIX(___NO_ERR))
7909         result = e;
7910       else
7911         {
7912           if ((e = ___NONNULLPOINTER_to_SCMOBJ
7913                      (dev,
7914                       ___FAL,
7915                       ___device_cleanup_from_ptr,
7916                       &result,
7917                       ___RETURN_POS))
7918               != ___FIX(___NO_ERR))
7919             {
7920               ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
7921               result = e;
7922             }
7923         }
7924
7925       ___release_string (cpath);
7926     }
7927
7928   ___release_scmobj (result);
7929
7930   return result;
7931
7932 #endif
7933 }
7934
7935
7936 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
7937
7938 /* Opening a process. */
7939
7940 ___SCMOBJ ___os_device_stream_open_process
7941    ___P((___SCMOBJ path_and_args,
7942          ___SCMOBJ environment,
7943          ___SCMOBJ directory,
7944          ___SCMOBJ options),
7945         (path_and_args,
7946          environment,
7947          directory,
7948          options)
7949 ___SCMOBJ path_and_args;
7950 ___SCMOBJ environment;
7951 ___SCMOBJ directory;
7952 ___SCMOBJ options;)
7953 {
7954 #ifndef ___STREAM_OPEN_PROCESS_CE_SELECT
7955
7956   return ___FIX(___UNIMPL_ERR);
7957
7958 #else
7959
7960   ___SCMOBJ e;
7961   ___device_stream *dev;
7962   ___SCMOBJ result;
7963   void *argv = NULL;
7964   void *env = NULL;
7965   void *dir = NULL;
7966
7967   if ((e = ___SCMOBJ_to_NONNULLSTRINGLIST
7968              (path_and_args,
7969               &argv,
7970               1,
7971               ___CE(___STREAM_OPEN_PROCESS_CE_SELECT)))
7972       != ___FIX(___NO_ERR) ||
7973       (environment != ___FAL &&
7974        (e = ___SCMOBJ_to_NONNULLSTRINGLIST
7975               (environment,
7976                &env,
7977                2,
7978                ___CE(___STREAM_OPEN_PROCESS_CE_SELECT)))
7979        != ___FIX(___NO_ERR)) ||
7980       (directory != ___FAL &&
7981        (e = ___SCMOBJ_to_NONNULLSTRING
7982               (directory,
7983                &dir,
7984                3,
7985                ___CE(___STREAM_OPEN_PROCESS_CE_SELECT),
7986                0))
7987        != ___FIX(___NO_ERR)) ||
7988       (e = ___device_stream_setup_from_process
7989              (&dev,
7990               ___global_device_group (),
7991               ___CAST(___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT)*,argv),
7992               ___CAST(___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT)*,env),
7993               ___CAST(___STRING_TYPE(___STREAM_OPEN_PROCESS_CE_SELECT),dir),
7994               ___INT(options)))
7995       != ___FIX(___NO_ERR))
7996     result = e;
7997   else
7998     {
7999       if ((e = ___NONNULLPOINTER_to_SCMOBJ
8000                  (dev,
8001                   ___FAL,
8002                   ___device_cleanup_from_ptr,
8003                   &result,
8004                   ___RETURN_POS))
8005           == ___FIX(___NO_ERR))
8006         ___release_scmobj (result);
8007     }
8008
8009   if (argv != NULL)
8010     ___release_string_list (argv);
8011
8012   if (env != NULL)
8013     ___release_string_list (env);
8014
8015   if (dir != NULL)
8016     ___release_string (dir);
8017
8018   return result;
8019
8020 #endif
8021 }
8022
8023
8024 #ifdef USE_POSIX
8025
8026 ___HIDDEN void sigchld_signal_handler
8027    ___P((int sig),
8028         (sig)
8029 int sig;)
8030 {
8031 #ifdef USE_signal
8032   ___set_signal_handler (SIGCHLD, sigchld_signal_handler);
8033 #endif
8034
8035   /*
8036    * A SIGCHLD signal indicates that at least one child has changed
8037    * status.  There may be more than one because signals are not
8038    * queued.  For example during a period when the SIGCHLD signal is
8039    * blocked several child processes can terminate and only one call
8040    * to the SIGCHLD handler will occur when the SIGCHLD signal is
8041    * unblocked.  For this reason we must call waitpid in a loop, until
8042    * the last call indicates that no other child process is available.
8043    */
8044
8045   for (;;)
8046     {
8047       int status;
8048       ___device *head;
8049       pid_t pid = waitpid_no_EINTR (-1, &status, WNOHANG);
8050
8051       if (pid <= 0)
8052         break;
8053
8054       /*
8055        * Find the process device structure for the process which
8056        * terminated, and save the exit status with the process device.
8057        */
8058
8059       head = ___global_device_group ()->list;
8060
8061       if (head != NULL)
8062         {
8063           ___device *d = head->prev;
8064
8065           do
8066             {
8067               if (___device_kind (d) == ___PROCESS_DEVICE_KIND)
8068                 {
8069                   ___device_process *dev = ___CAST(___device_process*,d);
8070
8071                   if (dev->pid == pid)
8072                     {
8073                       if (WIFEXITED(status) || WIFSIGNALED(status))
8074                         ___device_process_status_set (dev, status); /* ignore error */
8075                       break;
8076                     }
8077                 }
8078               d = d->prev;
8079             } while  (d != head);
8080         }
8081     }
8082 }
8083
8084 #endif
8085
8086
8087 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8088
8089 /* Opening a TCP client. */
8090
8091 ___SCMOBJ ___os_device_tcp_client_open
8092    ___P((___SCMOBJ server_addr,
8093          ___SCMOBJ port_num,
8094          ___SCMOBJ options),
8095         (server_addr,
8096          port_num,
8097          options)
8098 ___SCMOBJ server_addr;
8099 ___SCMOBJ port_num;
8100 ___SCMOBJ options;)
8101 {
8102 #ifndef USE_NETWORKING
8103
8104   return ___FIX(___UNIMPL_ERR);
8105
8106 #else
8107
8108   ___SCMOBJ e;
8109   ___device_tcp_client *dev;
8110   ___SCMOBJ result;
8111   struct sockaddr sa;
8112   int salen;
8113
8114   if ((e = ___SCMOBJ_to_sockaddr (server_addr, port_num, &sa, &salen, 1))
8115       != ___FIX(___NO_ERR))
8116     return e;
8117
8118   if ((e = ___device_tcp_client_setup_from_sockaddr
8119              (&dev,
8120               ___global_device_group (),
8121               &sa,
8122               salen,
8123               ___INT(options),
8124               ___DIRECTION_RD|___DIRECTION_WR))
8125       != ___FIX(___NO_ERR))
8126     return e;
8127
8128   if ((e = ___NONNULLPOINTER_to_SCMOBJ
8129              (dev,
8130               ___FAL,
8131               ___device_cleanup_from_ptr,
8132               &result,
8133               ___RETURN_POS))
8134       != ___FIX(___NO_ERR))
8135     {
8136       ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
8137       return e;
8138     }
8139
8140   ___release_scmobj (result);
8141
8142   return result;
8143
8144 #endif
8145 }
8146
8147
8148 ___SCMOBJ ___os_device_tcp_client_socket_info
8149    ___P((___SCMOBJ dev,
8150          ___SCMOBJ peer),
8151         (dev,
8152          peer)
8153 ___SCMOBJ dev;
8154 ___SCMOBJ peer;)
8155 {
8156 #ifndef USE_NETWORKING
8157
8158   return ___FIX(___UNIMPL_ERR);
8159
8160 #else
8161
8162   ___device_tcp_client *d =
8163     ___CAST(___device_tcp_client*,___FIELD(dev,___FOREIGN_PTR));
8164   struct sockaddr sa;
8165   SOCKET_LEN_TYPE salen;
8166
8167   if (d->try_connect_again != 0)
8168     {
8169       if (try_connect (d) == 0)
8170         {
8171           if (d->try_connect_again != 0)
8172             return ___ERR_CODE_EAGAIN;
8173         }
8174       else
8175         return ERR_CODE_FROM_SOCKET_CALL;
8176     }
8177
8178   salen = sizeof (sa);
8179
8180   if (((peer == ___FAL)
8181        ? getsockname (d->s, &sa, &salen)
8182        : getpeername (d->s, &sa, &salen)) < 0)
8183     {
8184       ___SCMOBJ e = ERR_CODE_FROM_SOCKET_CALL;
8185       if (NOT_CONNECTED(e) && !d->connect_done)
8186         e = ___ERR_CODE_EAGAIN;
8187       return e;
8188     }
8189
8190   return ___sockaddr_to_SCMOBJ (&sa, salen, ___RETURN_POS);
8191
8192 #endif
8193 }
8194
8195
8196 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8197
8198 /* Opening and reading a TCP server. */
8199
8200 ___SCMOBJ ___os_device_tcp_server_open
8201    ___P((___SCMOBJ server_addr,
8202          ___SCMOBJ port_num,
8203          ___SCMOBJ backlog,
8204          ___SCMOBJ options),
8205         (server_addr,
8206          port_num,
8207          backlog,
8208          options)
8209 ___SCMOBJ server_addr;
8210 ___SCMOBJ port_num;
8211 ___SCMOBJ backlog;
8212 ___SCMOBJ options;)
8213 {
8214 #ifndef USE_NETWORKING
8215
8216   return ___FIX(___UNIMPL_ERR);
8217
8218 #else
8219
8220   ___SCMOBJ e;
8221   ___device_tcp_server *dev;
8222   ___SCMOBJ result;
8223   struct sockaddr sa;
8224   int salen;
8225
8226   if ((e = ___SCMOBJ_to_sockaddr (server_addr, port_num, &sa, &salen, 1))
8227       != ___FIX(___NO_ERR))
8228     return e;
8229
8230   e = ___device_tcp_server_setup
8231         (&dev,
8232          ___global_device_group (),
8233          &sa,
8234          salen,
8235          ___INT(backlog),
8236          ___INT(options));
8237
8238   if (e != ___FIX(___NO_ERR))
8239     return e;
8240
8241   e = ___NONNULLPOINTER_to_SCMOBJ
8242         (dev,
8243          ___FAL,
8244          ___device_cleanup_from_ptr,
8245          &result,
8246          ___RETURN_POS);
8247
8248   if (e != ___FIX(___NO_ERR))
8249     {
8250       ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
8251       return e;
8252     }
8253
8254   ___release_scmobj (result);
8255
8256   return result;
8257
8258 #endif
8259 }
8260
8261
8262 ___SCMOBJ ___os_device_tcp_server_read
8263    ___P((___SCMOBJ dev),
8264         (dev)
8265 ___SCMOBJ dev;)
8266 {
8267 #ifndef USE_NETWORKING
8268
8269   return ___FIX(___UNIMPL_ERR);
8270
8271 #else
8272
8273   ___device_tcp_server *d =
8274     ___CAST(___device_tcp_server*,___FIELD(dev,___FOREIGN_PTR));
8275   ___SCMOBJ e;
8276   ___device_tcp_client *client;
8277   ___SCMOBJ result;
8278
8279   if ((e = ___device_tcp_server_read (d, ___global_device_group (), &client))
8280       != ___FIX(___NO_ERR))
8281     return e;
8282
8283   e = ___NONNULLPOINTER_to_SCMOBJ
8284         (client,
8285          ___FAL,
8286          ___device_cleanup_from_ptr,
8287          &result,
8288          ___RETURN_POS);
8289
8290   if (e != ___FIX(___NO_ERR))
8291     {
8292       ___device_cleanup (___CAST(___device*,d)); /* ignore error */
8293       return e;
8294     }
8295
8296   ___release_scmobj (result);
8297
8298   return result;
8299
8300 #endif
8301 }
8302
8303
8304 ___SCMOBJ ___os_device_tcp_server_socket_info
8305    ___P((___SCMOBJ dev),
8306         (dev)
8307 ___SCMOBJ dev;)
8308 {
8309 #ifndef USE_NETWORKING
8310
8311   return ___FIX(___UNIMPL_ERR);
8312
8313 #else
8314
8315   ___device_tcp_server *d =
8316     ___CAST(___device_tcp_server*,___FIELD(dev,___FOREIGN_PTR));
8317   struct sockaddr sa;
8318   SOCKET_LEN_TYPE salen;
8319
8320   salen = sizeof (sa);
8321
8322   if (getsockname (d->s, &sa, &salen) < 0)
8323     return ERR_CODE_FROM_SOCKET_CALL;
8324
8325   return ___sockaddr_to_SCMOBJ (&sa, salen, ___RETURN_POS);
8326
8327 #endif
8328 }
8329
8330
8331 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8332
8333 /* Opening and reading a directory. */
8334
8335 ___SCMOBJ ___os_device_directory_open_path
8336    ___P((___SCMOBJ path,
8337          ___SCMOBJ ignore_hidden),
8338         (path,
8339          ignore_hidden)
8340 ___SCMOBJ path;
8341 ___SCMOBJ ignore_hidden;)
8342 {
8343 #ifndef ___DIR_OPEN_PATH_CE_SELECT
8344
8345   return ___FIX(___UNIMPL_ERR);
8346
8347 #else
8348
8349   ___SCMOBJ e;
8350   ___SCMOBJ result;
8351   ___device_directory *dev;
8352   void *cpath;
8353
8354   if ((e = ___SCMOBJ_to_NONNULLSTRING
8355              (path,
8356               &cpath,
8357               1,
8358               ___CE(___DIR_OPEN_PATH_CE_SELECT),
8359               0))
8360       != ___FIX(___NO_ERR))
8361     result = e;
8362   else
8363     {
8364       ___STRING_TYPE(___DIR_OPEN_PATH_CE_SELECT) p =
8365         ___CAST(___STRING_TYPE(___DIR_OPEN_PATH_CE_SELECT),cpath);
8366
8367       if ((e = ___device_directory_setup
8368                  (&dev,
8369                   ___global_device_group (),
8370                   p,
8371                   ___INT(ignore_hidden)))
8372           != ___FIX(___NO_ERR))
8373         result = e;
8374       else
8375         {
8376           if ((e = ___NONNULLPOINTER_to_SCMOBJ
8377                      (dev,
8378                       ___FAL,
8379                       ___device_cleanup_from_ptr,
8380                       &result,
8381                       ___RETURN_POS))
8382               != ___FIX(___NO_ERR))
8383             {
8384               ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
8385               result = e;
8386             }
8387         }
8388
8389       ___release_string (cpath);
8390     }
8391
8392   ___release_scmobj (result);
8393
8394   return result;
8395
8396 #endif
8397 }
8398
8399
8400 ___SCMOBJ ___os_device_directory_read
8401    ___P((___SCMOBJ dev),
8402         (dev)
8403 ___SCMOBJ dev;)
8404 {
8405 #ifndef ___DIR_OPEN_PATH_CE_SELECT
8406
8407   return ___FIX(___UNIMPL_ERR);
8408
8409 #else
8410
8411   ___device_directory *d =
8412     ___CAST(___device_directory*,___FIELD(dev,___FOREIGN_PTR));
8413   ___SCMOBJ e;
8414   ___STRING_TYPE(___DIR_OPEN_PATH_CE_SELECT) name;
8415   ___SCMOBJ result;
8416
8417   if ((e = ___device_directory_read (d, &name)) != ___FIX(___NO_ERR))
8418     return e;
8419
8420   if (name == NULL)
8421     return ___EOF;
8422
8423   if ((e = ___STRING_to_SCMOBJ (name, &result, ___RETURN_POS, ___CE(___DIR_OPEN_PATH_CE_SELECT) ))
8424       != ___FIX(___NO_ERR))
8425     return e;
8426
8427   ___release_scmobj (result);
8428
8429   return result;
8430
8431 #endif
8432 }
8433
8434
8435 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8436
8437 /* Opening an event-queue. */
8438
8439 ___SCMOBJ ___os_device_event_queue_open
8440    ___P((___SCMOBJ selector),
8441         (selector)
8442 ___SCMOBJ selector;)
8443 {
8444   ___SCMOBJ e;
8445   ___SCMOBJ result;
8446   ___device_event_queue *dev;
8447
8448   if ((e = ___device_event_queue_setup
8449              (&dev,
8450               ___global_device_group (),
8451               selector))
8452       != ___FIX(___NO_ERR))
8453     result = e;
8454   else
8455     {
8456       if ((e = ___NONNULLPOINTER_to_SCMOBJ
8457                  (dev,
8458                   ___FAL,
8459                   ___device_cleanup_from_ptr,
8460                   &result,
8461                   ___RETURN_POS))
8462           != ___FIX(___NO_ERR))
8463         {
8464           ___device_cleanup (___CAST(___device*,dev)); /* ignore error */
8465           result = e;
8466         }
8467     }
8468
8469   ___release_scmobj (result);
8470
8471   return result;
8472 }
8473
8474
8475 ___SCMOBJ ___os_device_event_queue_read
8476    ___P((___SCMOBJ dev),
8477         (dev)
8478 ___SCMOBJ dev;)
8479 {
8480   ___device_event_queue *d =
8481     ___CAST(___device_event_queue*,___FIELD(dev,___FOREIGN_PTR));
8482   ___SCMOBJ e;
8483   ___SCMOBJ result;
8484
8485   if ((e = ___device_event_queue_read (d, &result)) != ___FIX(___NO_ERR))
8486     return e;
8487
8488   ___release_scmobj (result);
8489
8490   return result;
8491 }
8492
8493
8494 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8495
8496 /* Waiting for I/O to become possible on a set of devices. */
8497
8498 ___SCMOBJ ___os_condvar_select
8499    ___P((___SCMOBJ run_queue,
8500          ___SCMOBJ timeout),
8501         (run_queue,
8502          timeout)
8503 ___SCMOBJ run_queue;
8504 ___SCMOBJ timeout;)
8505 {
8506 /******************/
8507 #define ___BTQ_DEQ_NEXT 1
8508 #define ___BTQ_DEQ_PREV 2
8509 #define ___BTQ_COLOR    3
8510 #define ___BTQ_PARENT   4
8511 #define ___BTQ_LEFT     5
8512 #define ___BTQ_RIGHT    6
8513 #define ___BTQ_LEFTMOST 6
8514 #define ___BTQ_OWNER    7
8515 #define ___CONDVAR_NAME 8
8516
8517   ___SCMOBJ e;
8518   ___time to;
8519   ___device *devs[MAX_CONDVARS];
8520   ___SCMOBJ condvars[MAX_CONDVARS];
8521   int read_pos;
8522   int write_pos;
8523   ___SCMOBJ condvar;
8524   int i;
8525   int j;
8526
8527   if (timeout == ___FAL)
8528     to = ___time_mod.time_neg_infinity;
8529   else if (timeout == ___TRU)
8530     to = ___time_mod.time_pos_infinity;
8531   else
8532     ___time_from_seconds (&to, ___F64VECTORREF(timeout,___FIX(0)));
8533
8534   read_pos = 0;
8535   write_pos = MAX_CONDVARS;
8536   condvar = ___FIELD(run_queue,___BTQ_DEQ_NEXT);
8537
8538   while (condvar != run_queue)
8539     {
8540       ___SCMOBJ owner = ___FIELD(condvar,___BTQ_OWNER);
8541       if (read_pos < write_pos)
8542         {
8543           if (owner & ___FIX(2))
8544             condvars[--write_pos] = condvar;
8545           else
8546             condvars[read_pos++] = condvar;
8547           ___FIELD(condvar,___BTQ_OWNER) = owner & ~___FIX(1);
8548         }
8549       else
8550         {
8551           to = ___time_mod.time_neg_infinity;
8552           ___FIELD(condvar,___BTQ_OWNER) = owner | ___FIX(1);
8553         }
8554       condvar = ___FIELD(condvar,___BTQ_DEQ_NEXT);
8555     }
8556
8557   i = 0;
8558
8559   while (i < read_pos)
8560     {
8561       devs[i] = ___CAST(___device*,
8562                         ___FIELD(___FIELD(condvars[i],___CONDVAR_NAME),
8563                                  ___FOREIGN_PTR));
8564       i++;
8565     }
8566
8567   j = MAX_CONDVARS;
8568
8569   while (j > write_pos)
8570     {
8571       j--;
8572       devs[i] = ___CAST(___device*,
8573                         ___FIELD(___FIELD(condvars[j],___CONDVAR_NAME),
8574                                  ___FOREIGN_PTR));
8575       i++;
8576     }
8577
8578   e = ___device_select (devs, read_pos, MAX_CONDVARS-write_pos, to);
8579
8580   i = 0;
8581
8582   while (i < read_pos)
8583     {
8584       if (devs[i] == NULL)
8585         {
8586           condvar = condvars[i];
8587           ___FIELD(condvar,___BTQ_OWNER) |= ___FIX(1);
8588         }
8589       i++;
8590     }
8591
8592   j = MAX_CONDVARS;
8593
8594   while (j > write_pos)
8595     {
8596       j--;
8597       if (devs[i] == NULL)
8598         {
8599           condvar = condvars[j];
8600           ___FIELD(condvar,___BTQ_OWNER) |= ___FIX(1);
8601         }
8602       i++;
8603     }
8604
8605   return e;
8606 }
8607
8608
8609 /*   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   -   */
8610
8611 /*
8612  * Decoding and encoding of a buffer of Scheme characters to a buffer
8613  * of bytes.
8614  */
8615
8616 /*
8617  * The following definitions must match the structure of ports defined
8618  * in _io#.scm .
8619  */
8620
8621 #define ___PORT_MUTEX                1
8622 #define ___PORT_RKIND                2
8623 #define ___PORT_WKIND                3
8624 #define ___PORT_NAME                 4
8625 #define ___PORT_READ_DATUM           5
8626 #define ___PORT_WRITE_DATUM          6
8627 #define ___PORT_NEWLINE              7
8628 #define ___PORT_FORCE_OUTPUT         8
8629 #define ___PORT_CLOSE                9
8630 #define ___PORT_ROPTIONS             10
8631 #define ___PORT_RTIMEOUT             11
8632 #define ___PORT_RTIMEOUT_THUNK       12
8633 #define ___PORT_SET_RTIMEOUT         13
8634 #define ___PORT_WOPTIONS             14
8635 #define ___PORT_WTIMEOUT             15
8636 #define ___PORT_WTIMEOUT_THUNK       16
8637 #define ___PORT_SET_WTIMEOUT         17
8638
8639 #define ___PORT_OBJECT_OTHER1        18
8640 #define ___PORT_OBJECT_OTHER2        19
8641 #define ___PORT_OBJECT_OTHER3        20
8642
8643 #define ___PORT_CHAR_RBUF            18
8644 #define ___PORT_CHAR_RLO             19
8645 #define ___PORT_CHAR_RHI             20
8646 #define ___PORT_CHAR_RCHARS          21
8647 #define ___PORT_CHAR_RLINES          22
8648 #define ___PORT_CHAR_RCURLINE        23
8649 #define ___PORT_CHAR_RBUF_FILL       24
8650 #define ___PORT_CHAR_PEEK_EOFP       25
8651
8652 #define ___PORT_CHAR_WBUF            26
8653 #define ___PORT_CHAR_WLO             27
8654 #define ___PORT_CHAR_WHI             28
8655 #define ___PORT_CHAR_WCHARS          29
8656 #define ___PORT_CHAR_WLINES          30
8657 #define ___PORT_CHAR_WCURLINE        31
8658 #define ___PORT_CHAR_WBUF_DRAIN      32
8659 #define ___PORT_INPUT_READTABLE      33
8660 #define ___PORT_OUTPUT_READTABLE     34
8661 #define ___PORT_OUTPUT_WIDTH         35
8662
8663 #define ___PORT_CHAR_OTHER1          36
8664 #define ___PORT_CHAR_OTHER2          37
8665 #define ___PORT_CHAR_OTHER3          38
8666 #define ___PORT_CHAR_OTHER4          39
8667 #define ___PORT_CHAR_OTHER5          40
8668
8669 #define ___PORT_BYTE_RBUF            36
8670 #define ___PORT_BYTE_RLO             37
8671 #define ___PORT_BYTE_RHI             38
8672 #define ___PORT_BYTE_RBUF_FILL       39
8673
8674 #define ___PORT_BYTE_WBUF            40
8675 #define ___PORT_BYTE_WLO             41
8676 #define ___PORT_BYTE_WHI             42
8677 #define ___PORT_BYTE_WBUF_DRAIN      43
8678
8679 #define ___PORT_BYTE_OTHER1          44
8680 #define ___PORT_BYTE_OTHER2          45
8681
8682 #define ___PORT_RDEVICE_CONDVAR      44
8683 #define ___PORT_WDEVICE_CONDVAR      45
8684
8685 #define ___PORT_DEVICE_OTHER1        46
8686 #define ___PORT_DEVICE_OTHER2        47
8687
8688 #define ___C ___CS_SELECT(___U8,___U16,___U32)
8689
8690 ___SCMOBJ ___os_port_decode_chars
8691    ___P((___SCMOBJ port,
8692          ___SCMOBJ want,
8693          ___SCMOBJ eof),
8694         (port,
8695          want,
8696          eof)
8697 ___SCMOBJ port;
8698 ___SCMOBJ want;
8699 ___SCMOBJ eof;)
8700 {
8701   ___SCMOBJ e = ___FIX(___NO_ERR);
8702   ___SCMOBJ cbuf = ___FIELD(port,___PORT_CHAR_RBUF);
8703   int chi = ___INT(___FIELD(port,___PORT_CHAR_RHI));
8704   int cend = ___INT(___STRINGLENGTH(cbuf));
8705   ___SCMOBJ bbuf = ___FIELD(port,___PORT_BYTE_RBUF);
8706   int blo = ___INT(___FIELD(port,___PORT_BYTE_RLO));
8707   int bhi = ___INT(___FIELD(port,___PORT_BYTE_RHI));
8708   int options = ___INT(___FIELD(port,___PORT_ROPTIONS));
8709   ___C *cbuf_ptr = ___CAST(___C*,___BODY_AS(cbuf,___tSUBTYPED));
8710   ___U8 *bbuf_ptr = ___CAST(___U8*,___BODY_AS(bbuf,___tSUBTYPED));
8711   int cbuf_avail;
8712   int bbuf_avail;
8713   int code;
8714
8715   if (want != ___FAL)
8716     {
8717       int w = ___INT(want);
8718       if (chi+w < cend)
8719         cend = chi+w;
8720     }
8721
8722   cbuf_avail = cend - chi;
8723   bbuf_avail = bhi - blo;
8724
8725   code = chars_from_bytes (cbuf_ptr + chi,
8726                            &cbuf_avail,
8727                            bbuf_ptr + blo,
8728                            &bbuf_avail,
8729                            &options);
8730
8731   /*
8732    * either the character buffer is full (cbuf_avail == 0) or no more
8733    * characters can be extracted from the byte buffer either because
8734    * the remaining bytes are not long enough to form a character or
8735    * don't form a valid character.
8736    */
8737
8738   if (cbuf_avail == cend - chi)
8739     {
8740       if (code == ___INCOMPLETE_CHAR && eof != ___FAL)
8741         {
8742           bbuf_avail = 0; /* skip bytes up to end-of-file */
8743           code = ___ILLEGAL_CHAR;
8744         }
8745
8746       if (code == ___ILLEGAL_CHAR)
8747         {
8748           if (___CHAR_ENCODING_ERRORS(options) != ___CHAR_ENCODING_ERRORS_OFF)
8749             e = err_code_from_char_encoding (___CHAR_ENCODING(options), 1, 0, 0);
8750           else
8751             {
8752               if (___CHAR_ENCODING_SUPPORTS_BMP(___CHAR_ENCODING(options)))
8753                 cbuf_ptr[chi] = ___UNICODE_REPLACEMENT;
8754               else
8755                 cbuf_ptr[chi] = ___UNICODE_QUESTION;
8756
8757               cbuf_avail--;
8758             }
8759         }
8760     }
8761
8762   ___FIELD(port,___PORT_CHAR_RHI) = ___FIX(cend - cbuf_avail);
8763   ___FIELD(port,___PORT_BYTE_RLO) = ___FIX(bhi - bbuf_avail);
8764   ___FIELD(port,___PORT_ROPTIONS) = ___FIX(options);
8765
8766   return e;
8767 }
8768
8769
8770 ___SCMOBJ ___os_port_encode_chars
8771    ___P((___SCMOBJ port),
8772         (port)
8773 ___SCMOBJ port;)
8774 {
8775   ___SCMOBJ e = ___FIX(___NO_ERR);
8776   ___SCMOBJ cbuf = ___FIELD(port,___PORT_CHAR_WBUF);
8777   int clo = ___INT(___FIELD(port,___PORT_CHAR_WLO));
8778   int chi = ___INT(___FIELD(port,___PORT_CHAR_WHI));
8779   ___SCMOBJ bbuf = ___FIELD(port,___PORT_BYTE_WBUF);
8780   int bhi = ___INT(___FIELD(port,___PORT_BYTE_WHI));
8781   int bend = ___INT(___U8VECTORLENGTH(bbuf));
8782   int options = ___INT(___FIELD(port,___PORT_WOPTIONS));
8783   ___C *cbuf_ptr = ___CAST(___C*,___BODY_AS(cbuf,___tSUBTYPED));
8784   ___U8 *bbuf_ptr = ___CAST(___U8*,___BODY_AS(bbuf,___tSUBTYPED));
8785   int cbuf_avail;
8786   int bbuf_avail;
8787   int code;
8788
8789   cbuf_avail = chi - clo;
8790   bbuf_avail = bend - bhi;
8791
8792   code = chars_to_bytes (cbuf_ptr + clo,
8793                          &cbuf_avail,
8794                          bbuf_ptr + bhi,
8795                          &bbuf_avail,
8796                          &options);
8797
8798   /*
8799    * either the character buffer is empty (cbuf_avail == 0) or there
8800    * is not enough space left in the byte buffer for encoding the next
8801    * character, or the next character is illegal for the given
8802    * encoding.
8803    */
8804
8805   if (cbuf_avail == chi - clo)
8806     if (code == ___ILLEGAL_CHAR)
8807       {
8808         if (___CHAR_ENCODING_ERRORS(options) != ___CHAR_ENCODING_ERRORS_OFF)
8809           {
8810             cbuf_avail--; /* skip illegal char */
8811             e = err_code_from_char_encoding (___CHAR_ENCODING(options), 0, 0, 0);
8812           }
8813         else
8814           {
8815             ___C replacement_cbuf[1];
8816             int replacement_cbuf_avail = 1;
8817
8818             if (___CHAR_ENCODING_SUPPORTS_BMP(___CHAR_ENCODING(options)))
8819               replacement_cbuf[0] = ___UNICODE_REPLACEMENT;
8820             else
8821               replacement_cbuf[0] = ___UNICODE_QUESTION;
8822
8823             code = chars_to_bytes (replacement_cbuf,
8824                                    &replacement_cbuf_avail,
8825                                    bbuf_ptr + bend - bbuf_avail,
8826                                    &bbuf_avail,
8827                                    &options);
8828
8829             /*
8830              * skip over the illegal character if the replacement
8831              * character was encoded
8832              */
8833
8834             cbuf_avail = cbuf_avail - 1 + replacement_cbuf_avail;
8835           }
8836       }
8837
8838   ___FIELD(port,___PORT_CHAR_WLO) = ___FIX(chi - cbuf_avail);
8839   ___FIELD(port,___PORT_BYTE_WHI) = ___FIX(bend - bbuf_avail);
8840   ___FIELD(port,___PORT_WOPTIONS) = ___FIX(options);
8841
8842   return e;
8843 }
8844
8845
8846 /*---------------------------------------------------------------------------*/
8847
8848 /* I/O module initialization/finalization. */
8849
8850
8851 ___HIDDEN ___SCMOBJ io_module_setup ___PVOID
8852 {
8853   ___SCMOBJ e;
8854
8855   if ((e = ___device_group_setup (&___io_mod.dgroup)) == ___FIX(___NO_ERR))
8856     {
8857 #ifdef USE_POSIX
8858
8859       ___set_signal_handler (SIGCHLD, sigchld_signal_handler);
8860
8861 #endif
8862
8863 #ifdef USE_WIN32
8864
8865 #define WINSOCK_MAJOR 1
8866 #define WINSOCK_MINOR 1
8867
8868       WSADATA winsock_data;
8869
8870       if (!WSAStartup (MAKEWORD(WINSOCK_MAJOR, WINSOCK_MINOR), &winsock_data))
8871         {
8872           if (LOBYTE(winsock_data.wVersion) == WINSOCK_MINOR &&
8873               HIBYTE(winsock_data.wVersion) == WINSOCK_MAJOR)
8874             return ___FIX(___NO_ERR);
8875           WSACleanup (); /* ignore error */
8876         }
8877
8878       e = ___FIX(___UNKNOWN_ERR);
8879
8880       ___device_group_cleanup (___io_mod.dgroup);
8881
8882 #endif
8883     }
8884
8885   return e;
8886 }
8887
8888
8889 ___HIDDEN void io_module_cleanup ___PVOID
8890 {
8891 #ifdef USE_POSIX
8892
8893   ___set_signal_handler (SIGCHLD, SIG_DFL);
8894
8895 #endif
8896
8897 #ifdef USE_WIN32
8898
8899   WSACleanup (); /* ignore error */
8900
8901 #endif
8902
8903   ___device_group_cleanup (___io_mod.dgroup);
8904 }
8905
8906
8907
8908 ___SCMOBJ ___setup_io_module ___PVOID
8909 {
8910   if (!___io_mod.setup)
8911     {
8912 #ifdef USE_WIN32
8913
8914       ___SCMOBJ e = ___FIX(___NO_ERR);
8915
8916       ___io_mod.always_signaled = NULL;
8917       ___io_mod.abort_select = NULL;
8918
8919       ___io_mod.always_signaled =
8920         CreateEvent (NULL,  /* can't inherit */
8921                      TRUE,  /* manual reset */
8922                      TRUE,  /* signaled */
8923                      NULL); /* no name */
8924
8925       if (___io_mod.always_signaled == NULL)
8926         e = err_code_from_GetLastError ();
8927       else
8928         {
8929           ___io_mod.abort_select =
8930             CreateEvent (NULL,  /* can't inherit */
8931                          TRUE,  /* manual reset */
8932                          FALSE, /* not signaled */
8933                          NULL); /* no name */
8934
8935           if (___io_mod.abort_select == NULL)
8936             {
8937               CloseHandle (___io_mod.always_signaled); /* ignore error */
8938               e = err_code_from_GetLastError ();
8939             }
8940         }
8941
8942 #endif
8943
8944       io_module_setup ();/*****************************/
8945       ___io_mod.setup = 1;
8946       return ___FIX(___NO_ERR);
8947     }
8948
8949   return ___FIX(___UNKNOWN_ERR);
8950 }
8951
8952
8953 void ___cleanup_io_module ___PVOID
8954 {
8955   if (___io_mod.setup)
8956     {
8957       io_module_cleanup ();/*****************************/
8958 #ifdef USE_WIN32
8959       CloseHandle (___io_mod.abort_select); /* ignore error */
8960       CloseHandle (___io_mod.always_signaled); /* ignore error */
8961 #endif
8962       ___io_mod.setup = 0;
8963     }
8964 }
8965
8966
8967 /*---------------------------------------------------------------------------*/