basis-library/system/io.sml

   1 (* modified from SML/NJ sources by Stephen Weeks 1998-06-25 *)
   2 (* modified by Matthew Fluet 2002-10-11 *)
   3 (* modified by Matthew Fluet 2002-11-21 *)
   4 (* modified by Matthew Fluet 2006-04-30 *)
   5 (* modified by Matthew Fluet 2008-04-06 *)
   6 (* modified by Matthew Fluet 2013-06-18 *)
   7
   8 (* os-io.sml
   9  *
  10  * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
  11  *
  12  * NOTE: this interface has been proposed, but not yet adopted by the
  13  * Standard basis committee.
  14  *
  15  *)
  16
  17 structure OS_IO: OS_IO =
  18   struct
  19      structure Error = PosixError
  20
  21   (* an iodesc is an abstract descriptor for an OS object that
  22    * supports I/O (e.g., file, tty device, socket, ...).
  23    *)
  24      type iodesc = PreOS.IODesc.t
  25
  26     datatype iodesc_kind = K of string
  27
  28     val iodToFd = PrePosix.FileDesc.fromRep o PreOS.IODesc.toRep
  29     val fdToIod = PreOS.IODesc.fromRep o PrePosix.FileDesc.toRep
  30
  31     val iodescToWord = C_Fd.castToSysWord o PreOS.IODesc.toRep
  32
  33   (* return a hash value for the I/O descriptor. *)
  34     val hash = SysWord.toWord o iodescToWord
  35
  36   (* compare two I/O descriptors *)
  37     fun compare (i, i') = SysWord.compare (iodescToWord i, iodescToWord i')
  38
  39     structure Kind =
  40       struct
  41         val file = K "FILE"
  42         val dir = K "DIR"
  43         val symlink = K "LINK"
  44         val tty = K "TTY"
  45         val pipe = K "PIPE"
  46         val socket = K "SOCK"
  47         val device = K "DEV"
  48       end
  49
  50   (* return the kind of I/O descriptor *)
  51     fun kind (iod) = let
  52           val stat = Posix.FileSys.fstat (iodToFd iod)
  53           in
  54             if      (Posix.FileSys.ST.isReg stat) then Kind.file
  55             else if (Posix.FileSys.ST.isDir stat) then Kind.dir
  56             else if (Posix.FileSys.ST.isChr stat) then Kind.tty
  57             else if (Posix.FileSys.ST.isBlk stat) then Kind.device (* ?? *)
  58             else if (Posix.FileSys.ST.isLink stat) then Kind.symlink
  59             else if (Posix.FileSys.ST.isFIFO stat) then Kind.pipe
  60             else if (Posix.FileSys.ST.isSock stat) then Kind.socket
  61             else K "UNKNOWN"
  62           end
  63
  64     type poll_flags = {rd: bool, wr: bool, pri: bool}
  65     datatype poll_desc = PollDesc of iodesc * poll_flags
  66     datatype poll_info = PollInfo of iodesc * poll_flags
  67
  68   (* create a polling operation on the given descriptor; note that
  69    * not all I/O devices support polling, but for the time being, we
  70    * don't test for this.
  71    *)
  72     fun pollDesc iod = SOME (PollDesc (iod, {rd=false, wr=false, pri=false}))
  73
  74   (* return the I/O descriptor that is being polled *)
  75     fun pollToIODesc (PollDesc (iod, _)) = iod
  76
  77     exception Poll
  78
  79   (* set polling events; if the polling operation is not appropriate
  80    * for the underlying I/O device, then the Poll exception is raised.
  81    *)
  82     fun pollIn (PollDesc (iod, {wr, pri, ...}: poll_flags)) =
  83           PollDesc (iod, {rd=true, wr=wr, pri=pri})
  84     fun pollOut (PollDesc (iod, {rd, pri, ...}: poll_flags)) =
  85           PollDesc (iod, {rd=rd, wr=true, pri=pri})
  86     fun pollPri (PollDesc (iod, {rd, wr, ...}: poll_flags)) =
  87           PollDesc (iod, {rd=rd, wr=wr, pri=true})
  88
  89   (* polling function *)
  90     local
  91       structure Prim = PrimitiveFFI.OS.IO
  92       fun join (false, _, w) = w
  93         | join (true, b, w) = C_Short.orb(w, b)
  94       fun test (w, b) = (C_Short.andb(w, b) <> 0)
  95       val rdBit = PrimitiveFFI.OS.IO.POLLIN
  96       and wrBit = PrimitiveFFI.OS.IO.POLLOUT
  97       and priBit = PrimitiveFFI.OS.IO.POLLPRI
  98       fun fromPollDesc (PollDesc (iod, {rd, wr, pri})) =
  99             ( iodToFd iod,
 100               join (rd, rdBit,
 101               join (wr, wrBit,
 102               join (pri, priBit, 0)))
 103             )
 104       fun toPollInfo (fd, i) =
 105             PollInfo (fdToIod fd, {
 106               rd = test(i, rdBit),
 107               wr = test(i, wrBit),
 108               pri = test(i, priBit)
 109             })
 110     in
 111     fun poll (pds, timeOut) = let
 112           val (fds, events) = ListPair.unzip (List.map fromPollDesc pds)
 113           val fds = Vector.fromList fds
 114           val n = Vector.length fds
 115           val events = Vector.fromList events
 116           val timeOut =
 117              case timeOut of
 118                 NONE => ~1
 119               | SOME t =>
 120                    if Time.< (t, Time.zeroTime)
 121                       then Error.raiseSys Error.inval
 122                    else (C_Int.fromLarge (Time.toMilliseconds t)
 123                          handle Overflow => Error.raiseSys Error.inval)
 124           val revents = Array.array (n, 0: C_Short.t)
 125           val _ = Posix.Error.SysCall.simpleRestart
 126                   (fn () => Prim.poll (PrePosix.FileDesc.vectorToRep fds,
 127                                        events,
 128                                        C_NFds.fromInt n,
 129                                        timeOut,
 130                                        revents))
 131           in
 132             Array.foldri
 133             (fn (i, w, l) =>
 134              if w <> 0
 135                then (toPollInfo (Vector.sub (fds, i), w))::l
 136                else l)
 137             []
 138             revents
 139           end
 140     end (* local *)
 141
 142   (* check for conditions *)
 143     fun isIn (PollInfo(_, flgs)) = #rd flgs
 144     fun isOut (PollInfo(_, flgs)) = #wr flgs
 145     fun isPri (PollInfo(_, flgs)) = #pri flgs
 146     fun infoToPollDesc (PollInfo arg) = PollDesc arg
 147   end (* OS_IO *)
 148
 149
 150 (*
 151  * $Log: os-io.sml, v $
 152  * Revision 1.4  1997/07/31 17:25:26  jhr
 153  *   We are now using 32-bit ints to represent the seconds portion of a
 154  *   time value.  This was required to handle the change in the type of
 155  *   Time.{to, from}{Seconds, Milliseconds, Microseconds}.
 156  *
 157  * Revision 1.3  1997/06/07  15:27:51  jhr
 158  *   SML'97 Basis Library changes (phase 3; Posix changes)
 159  *
 160  * Revision 1.2  1997/06/02  19:16:19  jhr
 161  *   SML'97 Basis Library changes (phase 2)
 162  *
 163  * Revision 1.1.1.1  1997/01/14  01:38:25  george
 164  *   Version 109.24
 165  *
 166  *)