l4/pkg/ocaml/ocaml/contrib/otherlibs/unix/select.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../../LICENSE.  */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: select.c 6824 2005-03-24 17:20:54Z doligez $ */
  15
  16 #include <mlvalues.h>
  17 #include <alloc.h>
  18 #include <fail.h>
  19 #include <memory.h>
  20 #include <signals.h>
  21 #include "unixsupport.h"
  22
  23 #ifdef HAS_SELECT
  24
  25 #include <sys/types.h>
  26 #include <sys/time.h>
  27 #ifdef HAS_SYS_SELECT_H
  28 #include <sys/select.h>
  29 #endif
  30 #include <string.h>
  31 #include <unistd.h>
  32
  33 typedef fd_set file_descr_set;
  34
  35 static void fdlist_to_fdset(value fdlist, fd_set *fdset, int *maxfd)
  36 {
  37   value l;
  38   FD_ZERO(fdset);
  39   for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
  40     int fd = Int_val(Field(l, 0));
  41     FD_SET(fd, fdset);
  42     if (fd > *maxfd) *maxfd = fd;
  43   }
  44 }
  45
  46 static value fdset_to_fdlist(value fdlist, fd_set *fdset)
  47 {
  48   value l;
  49   value res = Val_int(0);
  50
  51   Begin_roots2(l, res);
  52     for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
  53       int fd = Int_val(Field(l, 0));
  54       if (FD_ISSET(fd, fdset)) {
  55         value newres = alloc_small(2, 0);
  56         Field(newres, 0) = Val_int(fd);
  57         Field(newres, 1) = res;
  58         res = newres;
  59       }
  60     }
  61   End_roots();
  62   return res;
  63 }
  64
  65 CAMLprim value unix_select(value readfds, value writefds, value exceptfds,
  66                            value timeout)
  67 {
  68   fd_set read, write, except;
  69   int maxfd;
  70   double tm;
  71   struct timeval tv;
  72   struct timeval * tvp;
  73   int retcode;
  74   value res;
  75
  76   Begin_roots3 (readfds, writefds, exceptfds);
  77     maxfd = -1;
  78     fdlist_to_fdset(readfds, &read, &maxfd);
  79     fdlist_to_fdset(writefds, &write, &maxfd);
  80     fdlist_to_fdset(exceptfds, &except, &maxfd);
  81     tm = Double_val(timeout);
  82     if (tm < 0.0)
  83       tvp = (struct timeval *) NULL;
  84     else {
  85       tv.tv_sec = (int) tm;
  86       tv.tv_usec = (int) (1e6 * (tm - tv.tv_sec));
  87       tvp = &tv;
  88     }
  89     enter_blocking_section();
  90     retcode = select(maxfd + 1, &read, &write, &except, tvp);
  91     leave_blocking_section();
  92     if (retcode == -1) uerror("select", Nothing);
  93     readfds = fdset_to_fdlist(readfds, &read);
  94     writefds = fdset_to_fdlist(writefds, &write);
  95     exceptfds = fdset_to_fdlist(exceptfds, &except);
  96     res = alloc_small(3, 0);
  97     Field(res, 0) = readfds;
  98     Field(res, 1) = writefds;
  99     Field(res, 2) = exceptfds;
 100   End_roots();
 101   return res;
 102 }
 103
 104 #else
 105
 106 CAMLprim value unix_select(value readfds, value writefds, value exceptfds,
 107                            value timeout)
 108 { invalid_argument("select not implemented"); }
 109
 110 #endif