[MLton-devel] cvs commit: Socket update

Stephen Weeks sweeks@users.sourceforge.net
Thu, 25 Sep 2003 22:21:09 -0700


sweeks      03/09/25 22:21:09

  Modified:    basis-library/misc primitive.sml
               basis-library/net socket.sig socket.sml
               basis-library/posix io.sml
               doc      changelog
               runtime  net-constants.h
  Added:       regression socket.ok socket.sml
  Log:
    - Tracking basis library changes:
      o Socket module datagram functions no longer return amount
        written, since they always write the entire amount or fail.  So,
        send{Arr,Vec}To{,'} now return unit instead of int.
      o Added nonblocking versions of all the send and recv functions,
        as well as accept and connect.  So, we now have:
        acceptNB, connectNB, recv{Arr,Vec}{,From}NB{,'},
        send{Arr,Vec}{,To}NB{,'}
  
  Added socket.sml regression test.

Revision  Changes    Path
1.80      +14 -10    mlton/basis-library/misc/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.79
retrieving revision 1.80
diff -u -r1.79 -r1.80
--- primitive.sml	24 Sep 2003 15:02:53 -0000	1.79
+++ primitive.sml	26 Sep 2003 05:21:08 -0000	1.80
@@ -1030,19 +1030,23 @@
 
 	    type flags = word
 	    val MSG_DONTROUTE = _const "Socket_MSG_DONTROUTE": flags;
+	    val MSG_DONTWAIT = _const "Socket_MSG_DONTWAIT": flags;
 	    val MSG_OOB = _const "Socket_MSG_OOB": flags;
 	    val MSG_PEEK = _const "Socket_MSG_PEEK": flags;
 
-	    val send = _import "Socket_send": sock * word8 vector * 
-                                           int * int * word -> int;
-	    val sendTo = _import "Socket_sendTo": sock * word8 vector * 
-                                               int * int * word *
-                                               sock_addr * int -> int;
-	    val recv = _import "Socket_recv": sock * word8 array * 
-                                           int * int * word -> int;
-	    val recvFrom = _import "Socket_recvFrom": sock * word8 array * 
-	                                           int * int * word *
-                                                   pre_sock_addr * int ref -> int;
+	    val sendArr = _import "Socket_send":
+	       sock * word8 array * int * int * word -> int;
+	    val sendVec = _import "Socket_send":
+	       sock * word8 vector * int * int * word -> int;
+	    val sendToArr = _import "Socket_sendTo":
+	       sock * word8 array * int * int * word * sock_addr * int -> int;
+	    val sendToVec = _import "Socket_sendTo":
+	       sock * word8 vector * int * int * word * sock_addr * int -> int;
+	    val recv = _import "Socket_recv":
+	       sock * word8 array * int * int * word -> int;
+	    val recvFrom = _import "Socket_recvFrom":
+	       sock * word8 array * int * int * word * pre_sock_addr * int ref
+	       -> int;
 
 	    structure GenericSock =
 	       struct



1.4       +179 -163  mlton/basis-library/net/socket.sig

Index: socket.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/net/socket.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- socket.sig	1 Jul 2003 18:43:10 -0000	1.3
+++ socket.sig	26 Sep 2003 05:21:08 -0000	1.4
@@ -1,137 +1,174 @@
-
 signature SOCKET =
-  sig
-     type ('af, 'sock_type) sock
-     val sockToFD: ('af, 'sock_type) sock -> Posix.FileSys.file_desc
-     val fdToSock: Posix.FileSys.file_desc -> ('af, 'sock_type) sock
-     type 'af sock_addr
-     type dgram
-     type 'mode stream
-     type passive
-     type active
-     structure AF: 
-        sig
-	   type addr_family = NetHostDB.addr_family
-	   val list: unit -> (string * addr_family) list
-	   val toString: addr_family -> string
-	   val fromString: string -> addr_family option
-	end
-     structure SOCK: 
-        sig
-	   eqtype sock_type
-           val stream: sock_type
-	   val dgram: sock_type
-	   val list: unit -> (string * sock_type) list
-	   val toString: sock_type -> string
-	   val fromString: string -> sock_type option
-	end
-     structure Ctl: 
-        sig
-	   val getDEBUG: ('af, 'sock_type) sock -> bool
-	   val setDEBUG: ('af, 'sock_type) sock * bool -> unit
-	   val getREUSEADDR: ('af, 'sock_type) sock -> bool
-	   val setREUSEADDR: ('af, 'sock_type) sock * bool -> unit
-	   val getKEEPALIVE: ('af, 'sock_type) sock -> bool
-	   val setKEEPALIVE: ('af, 'sock_type) sock * bool -> unit
-	   val getDONTROUTE: ('af, 'sock_type) sock -> bool
-	   val setDONTROUTE: ('af, 'sock_type) sock * bool -> unit
-	   val getLINGER: ('af, 'sock_type) sock -> Time.time option
-	   val setLINGER: ('af, 'sock_type) sock * Time.time option -> unit
-	   val getBROADCAST: ('af, 'sock_type) sock -> bool
-	   val setBROADCAST: ('af, 'sock_type) sock * bool -> unit
-	   val getOOBINLINE: ('af, 'sock_type) sock -> bool
-	   val setOOBINLINE: ('af, 'sock_type) sock * bool -> unit
-	   val getSNDBUF: ('af, 'sock_type) sock -> int
-	   val setSNDBUF: ('af, 'sock_type) sock * int -> unit
-	   val getRCVBUF: ('af, 'sock_type) sock -> int
-	   val setRCVBUF: ('af, 'sock_type) sock * int -> unit
-	   val getTYPE: ('af, 'sock_type) sock -> SOCK.sock_type
-	   val getERROR: ('af, 'sock_type) sock -> bool
-	   val getPeerName: ('af, 'sock_type) sock -> 'af sock_addr
-	   val getSockName: ('af, 'sock_type) sock -> 'af sock_addr
-	   val setNBIO: ('af, 'sock_type) sock * bool -> unit
-	   val getNREAD: ('af, 'sock_type) sock -> int
-	   val getATMARK: ('af, active stream) sock -> bool
-	end
-     val sameAddr: 'af sock_addr * 'af sock_addr -> bool
-     val familyOfAddr: 'af sock_addr -> AF.addr_family
-     val accept: ('af, passive stream) sock -> ('af, active stream) sock * 'af sock_addr
-     val bind: ('af, 'sock_type) sock * 'af sock_addr -> unit
-     val connect: ('af, 'sock_type) sock * 'af sock_addr -> unit
-     val listen: ('af, passive stream) sock * int -> unit
-     val close: ('af, 'sock_type) sock -> unit
-     datatype shutdown_mode = 
-        NO_RECVS
-      | NO_SENDS
-      | NO_RECVS_OR_SENDS
-     val shutdown: ('af, 'sock_type stream) sock * shutdown_mode -> unit
-     type sock_desc
-     val sockDesc : ('af, 'sock_type) sock -> sock_desc
-     val sameDesc : sock_desc * sock_desc -> bool
-     val select : {rds : sock_desc list,
-		   wrs : sock_desc list,
-		   exs : sock_desc list,
-		   timeout : Time.time option} -> 
-	          {rds : sock_desc list,
-		   wrs : sock_desc list,
-		   exs : sock_desc list}
-     val ioDesc : ('af, 'sock_type) sock -> OS.IO.iodesc
-     type out_flags = {don't_route : bool, oob : bool}
-     type in_flags = {peek : bool, oob : bool}
-     type 'a buf = {buf : 'a, i : int, sz : int option}
-     val sendVec: ('af, active stream) sock * Word8Vector.vector buf -> 
-		  int
-     val sendArr: ('af, active stream) sock * Word8Array.array buf -> 
-		  int
-     val sendVec': ('af, active stream) sock * Word8Vector.vector buf * 
-		   out_flags -> 
-		   int
-     val sendArr': ('af, active stream) sock * Word8Array.array buf * 
-		   out_flags -> 
-		   int
-     val sendVecTo: ('af, dgram) sock * 'af sock_addr * 
-		    Word8Vector.vector buf -> 
-		    int
-     val sendArrTo: ('af, dgram) sock * 'af sock_addr * 
-		    Word8Array.array buf -> 
-		    int
-     val sendVecTo': ('af, dgram) sock * 'af sock_addr * 
-		     Word8Vector.vector buf * 
-		     out_flags -> 
-		     int
-     val sendArrTo': ('af, dgram) sock * 'af sock_addr * 
-		     Word8Array.array buf * 
-		     out_flags -> 
-		     int
-     val recvVec: ('af, active stream) sock * int -> 
-		  Word8Vector.vector
-     val recvArr: ('af, active stream) sock * Word8Array.array buf -> 
-		  int
-     val recvVec': ('af, active stream) sock * int * 
-		   in_flags -> 
-		   Word8Vector.vector
-     val recvArr': ('af, active stream) sock * Word8Array.array buf * 
-		   in_flags -> 
-		   int
-     val recvVecFrom: ('af, dgram) sock * int -> 
-                      Word8Vector.vector * 'sock_type sock_addr
-     val recvArrFrom: ('af, dgram) sock * Word8Array.array buf -> 
-                      int * 'af sock_addr
-     val recvVecFrom': ('af, dgram) sock * int * in_flags -> 
-                       Word8Vector.vector * 'sock_type sock_addr
-     val recvArrFrom': ('af, dgram) sock * Word8Array.array buf * in_flags -> 
-                       int * 'af sock_addr
-  end
+   sig
+      type active
+      type dgram
+      type in_flags = {peek: bool, oob: bool}
+      type out_flags = {don't_route: bool, oob: bool}
+      type passive
+      datatype shutdown_mode =
+	 NO_RECVS
+       | NO_SENDS
+       | NO_RECVS_OR_SENDS
+      type ('af,'sock_type) sock
+      type 'af sock_addr
+      type sock_desc
+      type 'mode stream
+
+      structure AF:
+	 sig
+	    type addr_family = NetHostDB.addr_family
+
+	    val fromString: string -> addr_family option
+	    val list: unit -> (string * addr_family) list
+	    val toString: addr_family -> string
+	 end
+
+      structure SOCK:
+	 sig
+	    eqtype sock_type
+
+	    val dgram: sock_type
+	    val fromString: string -> sock_type option
+	    val list: unit -> (string * sock_type) list
+	    val stream: sock_type
+	    val toString: sock_type -> string
+	 end
+
+      structure Ctl:
+	 sig
+	    val getATMARK: ('af, active stream) sock -> bool
+	    val getBROADCAST: ('af, 'sock_type) sock -> bool
+	    val getDEBUG: ('af, 'sock_type) sock -> bool
+	    val getDONTROUTE: ('af, 'sock_type) sock -> bool
+	    val getERROR: ('af, 'sock_type) sock -> bool
+	    val getKEEPALIVE: ('af, 'sock_type) sock -> bool
+	    val getLINGER: ('af, 'sock_type) sock -> Time.time option
+	    val getNREAD: ('af, 'sock_type) sock -> int
+	    val getOOBINLINE: ('af, 'sock_type) sock -> bool
+	    val getPeerName: ('af, 'sock_type) sock -> 'af sock_addr
+	    val getRCVBUF: ('af, 'sock_type) sock -> int
+	    val getREUSEADDR: ('af, 'sock_type) sock -> bool
+	    val getSNDBUF: ('af, 'sock_type) sock -> int
+	    val getSockName: ('af, 'sock_type) sock -> 'af sock_addr
+	    val getTYPE: ('af, 'sock_type) sock -> SOCK.sock_type
+	    val setBROADCAST: ('af, 'sock_type) sock * bool -> unit
+	    val setDEBUG: ('af, 'sock_type) sock * bool -> unit
+	    val setDONTROUTE: ('af, 'sock_type) sock * bool -> unit
+	    val setKEEPALIVE: ('af, 'sock_type) sock * bool -> unit
+	    val setLINGER: ('af, 'sock_type) sock * Time.time option -> unit
+	    val setOOBINLINE: ('af, 'sock_type) sock * bool -> unit
+	    val setRCVBUF: ('af, 'sock_type) sock * int -> unit
+	    val setREUSEADDR: ('af, 'sock_type) sock * bool -> unit
+	    val setSNDBUF: ('af, 'sock_type) sock * int -> unit
+	 end
+
+      val accept: ('af, passive stream) sock -> (('af, active stream) sock
+						 * 'af sock_addr)
+      val acceptNB: ('af, passive stream) sock -> (('af, active stream) sock
+						   * 'af sock_addr) option
+      val bind: ('af, 'sock_type) sock * 'af sock_addr -> unit
+      val close: ('af, 'sock_type) sock -> unit
+      val connect: ('af, 'sock_type) sock * 'af sock_addr -> unit
+      val connectNB: ('af, 'sock_type) sock * 'af sock_addr -> bool
+      val familyOfAddr: 'af sock_addr -> AF.addr_family
+      val ioDesc: ('af, 'sock_type) sock -> OS.IO.iodesc
+      val listen: ('af, passive stream) sock * int -> unit
+      val recvArr: ('af, active stream) sock * Word8ArraySlice.slice -> int
+      val recvArr': (('af, active stream) sock
+		     * Word8ArraySlice.slice
+		     * in_flags) -> int
+      val recvArrFrom: (('af, dgram) sock * Word8ArraySlice.slice
+			-> int * 'af sock_addr)
+      val recvArrFrom': (('af, dgram) sock * Word8ArraySlice.slice * in_flags
+			 -> int * 'af sock_addr)
+      val recvArrFromNB: (('af, dgram) sock * Word8ArraySlice.slice
+			  -> (int * 'af sock_addr) option)
+      val recvArrFromNB': (('af, dgram) sock * Word8ArraySlice.slice * in_flags
+			   -> (int * 'af sock_addr) option)
+      val recvArrNB: (('af, active stream) sock
+		      * Word8ArraySlice.slice) -> int option
+      val recvArrNB': (('af, active stream) sock
+		       * Word8ArraySlice.slice
+		       * in_flags) -> int option
+      val recvVec: ('af, active stream) sock * int -> Word8Vector.vector
+      val recvVec': (('af, active stream) sock * int * in_flags
+		     -> Word8Vector.vector)
+      val recvVecFrom: (('af, dgram) sock * int
+			-> Word8Vector.vector * 'sock_type sock_addr)
+      val recvVecFrom': (('af, dgram) sock * int * in_flags
+			 -> Word8Vector.vector * 'sock_type sock_addr)
+      val recvVecFromNB: (('af, dgram) sock * int
+			  -> (Word8Vector.vector * 'sock_type sock_addr) option)
+      val recvVecFromNB': (('af, dgram) sock * int * in_flags
+			   -> (Word8Vector.vector * 'sock_type sock_addr) option)
+      val recvVecNB: ('af, active stream) sock * int -> Word8Vector.vector option
+      val recvVecNB': (('af, active stream) sock * int * in_flags
+		       -> Word8Vector.vector option)
+      val sameAddr: 'af sock_addr * 'af sock_addr -> bool
+      val sameDesc: sock_desc * sock_desc -> bool
+      val select: {exs: sock_desc list,
+		   rds: sock_desc list,
+		   timeout: Time.time option,
+		   wrs: sock_desc list} -> {exs: sock_desc list,
+					    rds: sock_desc list,
+					    wrs: sock_desc list}
+      val sendArr: ('af, active stream) sock * Word8ArraySlice.slice -> int
+      val sendArr': (('af, active stream) sock
+		     * Word8ArraySlice.slice
+		     * out_flags) -> int
+      val sendArrNB: (('af, active stream) sock * Word8ArraySlice.slice
+		      -> int option)
+      val sendArrNB': (('af, active stream) sock
+		       * Word8ArraySlice.slice
+		       * out_flags) -> int option
+      val sendArrTo: (('af, dgram) sock
+		      * 'af sock_addr
+		      * Word8ArraySlice.slice) -> unit
+      val sendArrTo': (('af, dgram) sock
+		       * 'af sock_addr
+		       * Word8ArraySlice.slice
+		       * out_flags) -> unit
+      val sendArrToNB: (('af, dgram) sock
+			* 'af sock_addr
+			* Word8ArraySlice.slice) -> bool
+      val sendArrToNB': (('af, dgram) sock
+			 * 'af sock_addr
+			 * Word8ArraySlice.slice
+			 * out_flags) -> bool
+      val sendVec: ('af, active stream) sock * Word8VectorSlice.slice -> int
+      val sendVec': (('af, active stream) sock
+		     * Word8VectorSlice.slice
+		     * out_flags) -> int
+      val sendVecNB: (('af, active stream) sock
+		      * Word8VectorSlice.slice) -> int option
+      val sendVecNB': (('af, active stream) sock
+		       * Word8VectorSlice.slice
+		       * out_flags) -> int option
+      val sendVecTo: (('af, dgram) sock
+		      * 'af sock_addr
+		      * Word8VectorSlice.slice) -> unit
+      val sendVecTo': (('af, dgram) sock
+		       * 'af sock_addr
+		       * Word8VectorSlice.slice
+		       * out_flags) -> unit
+      val sendVecToNB: (('af, dgram) sock
+			* 'af sock_addr
+			* Word8VectorSlice.slice) -> bool
+      val sendVecToNB': (('af, dgram) sock
+			 * 'af sock_addr
+			 * Word8VectorSlice.slice
+			 * out_flags) -> bool
+      val shutdown: ('af, 'mode stream) sock * shutdown_mode -> unit
+      val sockDesc: ('af, 'sock_type) sock -> sock_desc
+   end
 
 signature SOCKET_EXTRA =
   sig
     include SOCKET
     val sockToWord: ('af, 'sock_type) sock -> SysWord.word
     val wordToSock: SysWord.word -> ('af, 'sock_type) sock
-(*
     val sockToFD: ('af, 'sock_type) sock -> Posix.FileSys.file_desc
     val fdToSock: Posix.FileSys.file_desc -> ('af, 'sock_type) sock
-*)
     type pre_sock_addr
     val unpackSockAddr: 'af sock_addr -> Word8Vector.vector
     val new_sock_addr: unit -> (pre_sock_addr * int ref * (unit -> 'af sock_addr))
@@ -142,42 +179,21 @@
 	  type optname = int
 	  type request = int
 
-	  val getSockOptWord : 
-	    level * optname -> 
-	    ('af, 'sock_type) sock -> word
-	  val setSockOptWord :
-	    level * optname ->
-	    ('af, 'sock_type) sock * word -> unit
-	  val getSockOptInt : 
-	    level * optname -> 
-	    ('af, 'sock_type) sock -> int
-	  val setSockOptInt :
-	    level * optname ->
-	    ('af, 'sock_type) sock * int -> unit
-	  val getSockOptBool : 
-	    level * optname -> 
-	    ('af, 'sock_type) sock -> bool
-	  val setSockOptBool :
-	    level * optname ->
-	    ('af, 'sock_type) sock * bool -> unit
-
-	  val getIOCtlWord : 
-	    request -> 
-	    ('af, 'sock_type) sock -> word
-	  val setIOCtlWord :
-	    request ->
-	    ('af, 'sock_type) sock * word -> unit
-	  val getIOCtlInt : 
-	    request -> 
-	    ('af, 'sock_type) sock -> int
-	  val setIOCtlInt :
-	    request ->
-	    ('af, 'sock_type) sock * int -> unit
-	  val getIOCtlBool : 
-	    request -> 
-	    ('af, 'sock_type) sock -> bool
-	  val setIOCtlBool :
-	    request ->
-	    ('af, 'sock_type) sock * bool -> unit
+	  val getSockOptWord: level * optname -> ('af, 'sock_type) sock -> word
+	  val setSockOptWord:
+	     level * optname -> ('af, 'sock_type) sock * word -> unit
+	  val getSockOptInt: level * optname -> ('af, 'sock_type) sock -> int
+	  val setSockOptInt:
+	     level * optname -> ('af, 'sock_type) sock * int -> unit
+	  val getSockOptBool: level * optname -> ('af, 'sock_type) sock -> bool
+	  val setSockOptBool:
+	     level * optname -> ('af, 'sock_type) sock * bool -> unit
+
+	  val getIOCtlWord: request -> ('af, 'sock_type) sock -> word
+	  val setIOCtlWord: request -> ('af, 'sock_type) sock * word -> unit
+	  val getIOCtlInt: request -> ('af, 'sock_type) sock -> int
+	  val setIOCtlInt: request -> ('af, 'sock_type) sock * int -> unit
+	  val getIOCtlBool: request -> ('af, 'sock_type) sock -> bool
+	  val setIOCtlBool: request -> ('af, 'sock_type) sock * bool -> unit
        end
-  end
\ No newline at end of file
+  end



1.5       +522 -493  mlton/basis-library/net/socket.sml

Index: socket.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/net/socket.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- socket.sml	9 Sep 2003 14:48:57 -0000	1.4
+++ socket.sml	26 Sep 2003 05:21:08 -0000	1.5
@@ -1,507 +1,536 @@
-structure Socket : SOCKET_EXTRA =
+structure Socket: SOCKET_EXTRA =
+struct
+
+structure Prim = Primitive.Socket
+structure PE = Posix.Error
+structure PFS = Posix.FileSys
+
+datatype sock = S of Prim.sock
+fun sockToWord (S s) = SysWord.fromInt s
+fun wordToSock s = S (SysWord.toInt s)
+fun sockToFD sock = PFS.wordToFD (sockToWord sock)
+fun fdToSock fd = wordToSock (PFS.fdToWord fd)
+
+type pre_sock_addr = Prim.pre_sock_addr
+datatype sock_addr = SA of Prim.sock_addr
+fun unpackSockAddr (SA sa) = sa
+fun new_sock_addr (): (pre_sock_addr * int ref * (unit -> sock_addr)) = 
+   let
+      val sa = Word8Array.array (Prim.sockAddrLenMax, 0wx0)
+      val salen = ref (Word8Array.length sa)
+      fun finish () =
+	 SA (ArraySlice.vector (ArraySlice.slice (sa, 0, SOME (!salen))))
+   in
+      (sa, salen, finish)
+   end
+datatype dgram = DGRAM
+datatype stream = MODE
+datatype passive = PASSIVE
+datatype active = ACTIVE
+
+structure AF =
    struct
-      structure Prim = Primitive.Socket
-      structure PE = Posix.Error
-      structure PFS = Posix.FileSys
-
-      datatype ('af,'sock_type) sock = S of Prim.sock
-      fun sockToWord (S s) = SysWord.fromInt s
-      fun wordToSock s = S (SysWord.toInt s)
-      fun sockToFD sock = PFS.wordToFD (sockToWord sock)
-      fun fdToSock fd = wordToSock (PFS.fdToWord fd)
-
-      type pre_sock_addr = Prim.pre_sock_addr
-      datatype 'af sock_addr = SA of Prim.sock_addr
-      fun unpackSockAddr (SA sa) = sa
-      fun 'af new_sock_addr () : 
-	  (pre_sock_addr * int ref * (unit -> 'af sock_addr)) = 
-	let
-	  val sa = Word8Array.array (Prim.sockAddrLenMax, 0wx0)
-	  val salen = ref (Word8Array.length sa)
-	  fun finish () =
-	    SA (ArraySlice.vector
-		(ArraySlice.slice (sa, 0, SOME (!salen))))
-	in
-	  (sa, salen, finish)
-	end
-      datatype dgram = DGRAM
-      datatype 'mode stream = MODE
-      datatype passive = PASSIVE
-      datatype active = ACTIVE
-
-      structure AF =
-	 struct
-	    type addr_family = Prim.AF.addr_family
-	    val names = [
-			 ("UNIX", Prim.AF.UNIX),
-			 ("INET", Prim.AF.INET),
-			 ("INET6", Prim.AF.INET6),
-			 ("UNSPEC", Prim.AF.UNSPEC)
-			 ]
-	    fun list () = names
-	    fun toString af' =
-	      case List.find (fn (_, af) => af = af') names of
-		SOME (name, _) => name
-	      | NONE => raise (Fail "Internal error: bogus addr_family")
-	    fun fromString name' =
-	      case List.find (fn (name, _) => name = name') names of
-		SOME (_, af) => SOME af
-	      | NONE => NONE
-	 end
+      type addr_family = Prim.AF.addr_family
+      val names = [
+		   ("UNIX", Prim.AF.UNIX),
+		   ("INET", Prim.AF.INET),
+		   ("INET6", Prim.AF.INET6),
+		   ("UNSPEC", Prim.AF.UNSPEC)
+		   ]
+      fun list () = names
+      fun toString af' =
+	 case List.find (fn (_, af) => af = af') names of
+	    SOME (name, _) => name
+	  | NONE => raise (Fail "Internal error: bogus addr_family")
+      fun fromString name' =
+	 case List.find (fn (name, _) => name = name') names of
+	    SOME (_, af) => SOME af
+	  | NONE => NONE
+   end
 
-      structure SOCK =
-	 struct
-	    type sock_type = Prim.SOCK.sock_type
-	    val stream = Prim.SOCK.STREAM
-	    val dgram = Prim.SOCK.DGRAM
-	    val names = [
-			 ("STREAM", stream),
-			 ("DGRAM", dgram)
-			 ]
-	    fun list () = names
-	    fun toString st' =
-	      case List.find (fn (_, st) => st = st') names of
-		SOME (name, _) => name
-	      | NONE => raise (Fail "Internal error: bogus sock_type")
-	    fun fromString name' =
-	      case List.find (fn (name, _) => name = name') names of
-		SOME (_, st) => SOME st
-	      | NONE => NONE
-	 end
+structure SOCK =
+   struct
+      type sock_type = Prim.SOCK.sock_type
+      val stream = Prim.SOCK.STREAM
+      val dgram = Prim.SOCK.DGRAM
+      val names = [
+		   ("STREAM", stream),
+		   ("DGRAM", dgram)
+		   ]
+      fun list () = names
+      fun toString st' =
+	 case List.find (fn (_, st) => st = st') names of
+	    SOME (name, _) => name
+	  | NONE => raise (Fail "Internal error: bogus sock_type")
+      fun fromString name' =
+	 case List.find (fn (name, _) => name = name') names of
+	    SOME (_, st) => SOME st
+	  | NONE => NONE
+   end
 
-      structure CtlExtra =
-	 struct
-	    type level = Prim.Ctl.level
-	    type optname = Prim.Ctl.optname
-	    type request = Prim.Ctl.request
-	    (* host byte order (LSB) *)
-	    type read_data = Prim.Ctl.read_data
-	    type write_data = Prim.Ctl.write_data
-	    structure PW = PackWord32Little
-
-	    fun ('a, 'af, 'sock_type)
-	        getSockOpt
-		(level: level,
-		 optname: optname,
-		 optlen: int,
-		 unmarshal: write_data * int * int -> 'a)
-		((S s): ('af, 'sock_type) sock): 'a =
-	      let
-		val optval = Word8Array.array (optlen, 0wx0)
-		val optlen = ref optlen
-	      in
-		PE.checkResult
-		(Prim.Ctl.getSockOpt
-		 (s, level, optname, optval, optlen));
-		unmarshal (optval, !optlen, 0)
-	      end
-	    fun ('a, 'af, 'sock_type)
-	        setSockOpt
-		(level: level,
-		 optname: optname,
-		 marshal: 'a -> read_data)
-		((S s): ('af, 'sock_type) sock,
-		 optval: 'a): unit =
-	      let
-		val optval = marshal optval
-		val optlen = Word8Vector.length optval
-	      in
-		PE.checkResult
-		(Prim.Ctl.setSockOpt
-		 (s, level, optname, optval, optlen))
-	      end
-	    fun ('a, 'af, 'sock_type)
-		getIOCtl
-		(request: request,
-		 optlen: int,
-		 unmarshal: write_data * int * int -> 'a)
-		((S s): ('af, 'sock_type) sock): 'a =
-	      let
-		val optval = Word8Array.array (optlen, 0wx0)
-	      in
-		PE.checkResult
-		(Prim.Ctl.getIOCtl
-		 (s, request, optval));
-		unmarshal (optval, optlen, 0)
-	      end
-	    fun ('a, 'af, 'sock_type)
-	        setIOCtl
-		(request: request,
-		 marshal: 'a -> read_data)
-		((S s): ('af, 'sock_type) sock,
-		 optval: 'a): unit =
-	       let
-		 val optval = marshal optval
-		 val optlen = Word8Vector.length optval
-	       in
-		 PE.checkResult
-		 (Prim.Ctl.setIOCtl
-		  (s, request, optval))
-	       end
-
-	    val wordLen = PW.bytesPerElem
-	    fun unmarshalWord (wa, l, s) : word = 
-	      Word.fromLargeWord (PW.subArr (wa, s))
-	    val intLen : int = wordLen
-	    fun unmarshalInt (wa, l, s) : int = 
-	      Word.toIntX (unmarshalWord (wa, l, s))
-	    val boolLen : int = intLen
-	    fun unmarshalBool (wa, l, s) : bool = 
-	      if (unmarshalInt (wa, l, s)) = 0 then false else true
-	    val timeOptLen : int = boolLen + intLen
-	    fun unmarshalTimeOpt (wa, l, s) : Time.time option =
-	      if unmarshalBool (wa, l, s)
-		then SOME (Time.fromSeconds
-			   (LargeInt.fromInt
-			    (unmarshalInt (wa, l, s + boolLen))))
-		else NONE
-
-	    fun marshalWord' (w, wa, s) =
-	      PW.update (wa, s, Word.toLargeWord w)
-	    fun marshalInt' (i, wa, s) =
-	      marshalWord' (Word.fromInt i, wa, s)
-	    fun marshalBool' (b, wa, s) =
-	      marshalInt' (if b then 1 else 0, wa, s)
-	    fun marshalTimeOpt' (t, wa, s) =
-	      case t of
-		NONE => (marshalBool' (false, wa, s);
-			 marshalInt' (0, wa, s + boolLen))
-	      | SOME t => (marshalBool' (true, wa, s);
-			   marshalWord' (Word.fromLargeInt (Time.toSeconds t), 
-					 wa, s + boolLen))
-	    fun 'a marshal (len, f: 'a * Word8Array.array * int -> unit) (x: 'a) =
-	      let
-		val wa = Word8Array.array (len, 0wx0)
-	      in
-		f (x, wa, 0);
-		Word8Array.vector wa
-	      end
-	    fun marshalWord w = marshal (wordLen, marshalWord') w
-	    fun marshalInt i = marshal (intLen, marshalInt') i
-	    fun marshalBool b = marshal (boolLen, marshalBool') b
-	    fun marshalTimeOpt t = marshal (timeOptLen, marshalTimeOpt') t
-
-	    fun ('af, 'sock_type) 
-	        getSockOptWord
-		(level: level,
-		 optname: optname)
-		(sock: ('af, 'sock_type) sock): word =
-	      getSockOpt (level, optname, wordLen, unmarshalWord) sock
-	    fun ('af, 'sock_type) 
-	        getSockOptInt
-		(level: level,
-		 optname: optname)
-		(sock: ('af, 'sock_type) sock): int =
-	      getSockOpt (level, optname, intLen, unmarshalInt) sock
-	    fun ('af, 'sock_type) 
-	        getSockOptBool
-		(level: level,
-		 optname: optname)
-		(sock: ('af, 'sock_type) sock): bool =
-	      getSockOpt (level, optname, boolLen, unmarshalBool) sock
-	    fun ('af, 'sock_type) 
-	        getSockOptTimeOpt
-		(level: level,
-		 optname: optname)
-		(sock: ('af, 'sock_type) sock): Time.time option =
-	      getSockOpt (level, optname, timeOptLen, unmarshalTimeOpt) sock
-	    fun ('af, 'sock_type) 
-	        setSockOptWord
-		(level: level,
-		 optname: optname)
-		(sock: ('af, 'sock_type) sock,
-		 optval: word): unit =
-	      setSockOpt (level, optname, marshalWord) (sock, optval)
-	    fun ('af, 'sock_type) 
-	        setSockOptInt
-		(level: level, 
-		 optname: optname)
-		(sock: ('af, 'sock_type) sock,
-		 optval: int): unit =
-	      setSockOpt (level, optname, marshalInt) (sock, optval)
-	    fun ('af, 'sock_type) 
-	        setSockOptBool
-		(level: level,
-		 optname: optname)
-		(sock: ('af, 'sock_type) sock,
-		 optval: bool): unit =
-	      setSockOpt (level, optname, marshalBool) (sock, optval)
-	    fun ('af, 'sock_type) 
-	        setSockOptTimeOpt
-		(level: level,
-		 optname: optname)
-		(sock: ('af, 'sock_type) sock,
-		 optval: Time.time option): unit =
-	      setSockOpt (level, optname, marshalTimeOpt) (sock, optval)
-
-
-	    fun ('af, 'sock_type) 
-	        getIOCtlWord
-		(request: request)
-		(sock: ('af, 'sock_type) sock): word =
-	      getIOCtl (request, wordLen, unmarshalWord) sock
-	    fun ('af, 'sock_type) 
-	        getIOCtlInt
-		(request: request)
-		(sock: ('af, 'sock_type) sock): int =
-	      getIOCtl (request, intLen, unmarshalInt) sock
-	    fun ('af, 'sock_type) 
-	        getIOCtlBool
-		(request: request)
-		(sock: ('af, 'sock_type) sock): bool =
-	      getIOCtl (request, boolLen, unmarshalBool) sock
-	    fun ('af, 'sock_type) 
-	        setIOCtlWord
-		(request: request)
-		(sock: ('af, 'sock_type) sock,
-		 optval: word): unit =
-	      setIOCtl (request, marshalWord) (sock, optval)
-	    fun ('af, 'sock_type) 
-	        setIOCtlInt
-		(request: request)
-		(sock: ('af, 'sock_type) sock,
-		 optval: int): unit =
-	      setIOCtl (request, marshalInt) (sock, optval)
-	    fun ('af, 'sock_type) 
-	        setIOCtlBool
-		(request: request)
-		(sock: ('af, 'sock_type) sock,
-		 optval: bool): unit =
-	      setIOCtl (request, marshalBool) (sock, optval)
-	 end
+structure CtlExtra =
+   struct
+      type level = Prim.Ctl.level
+      type optname = Prim.Ctl.optname
+      type request = Prim.Ctl.request
+      (* host byte order (LSB) *)
+      type read_data = Prim.Ctl.read_data
+      type write_data = Prim.Ctl.write_data
+      structure PW = PackWord32Little
+
+      val wordLen = PW.bytesPerElem
+      fun unmarshalWord (wa, l, s): word = 
+	 Word.fromLargeWord (PW.subArr (wa, s))
+      val intLen: int = wordLen
+      fun unmarshalInt (wa, l, s): int = 
+	 Word.toIntX (unmarshalWord (wa, l, s))
+      val boolLen: int = intLen
+      fun unmarshalBool (wa, l, s): bool = 
+	 if (unmarshalInt (wa, l, s)) = 0 then false else true
+      val timeOptLen: int = boolLen + intLen
+      fun unmarshalTimeOpt (wa, l, s): Time.time option =
+	 if unmarshalBool (wa, l, s)
+	    then SOME (Time.fromSeconds
+		       (LargeInt.fromInt
+			(unmarshalInt (wa, l, s + boolLen))))
+	 else NONE
+
+      fun marshalWord (w, wa, s) =
+	 PW.update (wa, s, Word.toLargeWord w)
+
+      fun marshalInt (i, wa, s) =
+	 marshalWord (Word.fromInt i, wa, s)
+
+      fun marshalBool (b, wa, s) =
+	 marshalInt (if b then 1 else 0, wa, s)
+
+      fun marshalTimeOpt (t, wa, s) =
+	 case t of
+	    NONE => (marshalBool (false, wa, s)
+		     ; marshalInt (0, wa, s + boolLen))
+	  | SOME t => (marshalBool (true, wa, s)
+		       ; marshalWord (Word.fromLargeInt (Time.toSeconds t), 
+				      wa, s + boolLen))
+
+      local
+	 fun make (optlen: int,
+		   write: 'a * Word8Array.array * int -> unit,
+		   unmarshal: write_data * int * int -> 'a) =
+	    let
+	       fun marshal (x: 'a) =
+		  let
+		     val wa = Word8Array.array (optlen, 0wx0)
+		  in
+		     write (x, wa, 0)
+		     ; Word8Array.vector wa
+		  end
+	       fun getSockOpt (level: level, optname: optname) (S s) =
+		  let
+		     val optval = Word8Array.array (optlen, 0wx0)
+		     val optlen = ref optlen
+		  in
+		     PE.checkResult
+		     (Prim.Ctl.getSockOpt (s, level, optname, optval, optlen))
+		     ; unmarshal (optval, !optlen, 0)
+		  end
+	       fun setSockOpt (level: level, optname: optname) (S s, optval) =
+		  let
+		     val optval = marshal optval
+		     val optlen = Word8Vector.length optval
+		  in
+		     PE.checkResult
+		     (Prim.Ctl.setSockOpt (s, level, optname, optval, optlen))
+		  end
+	       fun getIOCtl (request: request) (S s): 'a =
+		  let
+		     val optval = Word8Array.array (optlen, 0wx0)
+		  in
+		     PE.checkResult (Prim.Ctl.getIOCtl (s, request, optval))
+		     ; unmarshal (optval, optlen, 0)
+		  end
+	       fun setIOCtl (request: request) (S s, optval: 'a): unit =
+		  let
+		     val optval = marshal optval
+		     val optlen = Word8Vector.length optval
+		  in
+		     PE.checkResult (Prim.Ctl.setIOCtl (s, request, optval))
+		  end
+	    in
+	       (getSockOpt, getIOCtl, setSockOpt, setIOCtl)
+	    end
+      in
+	 val (getSockOptWord, getIOCtlWord, setSockOptWord, setIOCtlWord) =
+	    make (wordLen, marshalWord, unmarshalWord)
+	 val (getSockOptInt, getIOCtlInt, setSockOptInt, setIOCtlInt) =
+	    make (intLen, marshalInt, unmarshalInt)
+	 val (getSockOptBool, getIOCtlBool, setSockOptBool, setIOCtlBool) =
+	    make (boolLen, marshalBool, unmarshalBool)
+	 val (getSockOptTimeOpt, getIOCtlTimeOpt, setSockOptTimeOpt,
+	      setIOCtlTimeOpt) =
+	    make (timeOptLen, marshalTimeOpt, unmarshalTimeOpt)
+      end
+   end
+
+structure Ctl =
+   struct
+      open CtlExtra
 
-      structure Ctl =
-	 struct
-	    open CtlExtra
-
-	    fun getDEBUG sock = 
-	      getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DEBUG) sock
-	    fun setDEBUG (sock,optval) = 
-	      setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DEBUG) (sock,optval)
-	    fun getREUSEADDR sock = 
-	      getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.REUSEADDR) sock
-	    fun setREUSEADDR (sock,optval) = 
-	      setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.REUSEADDR) (sock,optval)
-	    fun getKEEPALIVE sock = 
-	      getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.KEEPALIVE) sock
-	    fun setKEEPALIVE (sock,optval) = 
-	      setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.KEEPALIVE) (sock,optval)
-	    fun getDONTROUTE sock = 
-	      getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DONTROUTE) sock
-	    fun setDONTROUTE (sock,optval) = 
-	      setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DONTROUTE) (sock,optval)
-	    fun getBROADCAST sock = 
-	      getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.BROADCAST) sock
-	    fun getLINGER sock =
-	      getSockOptTimeOpt (Prim.Ctl.SOCKET, Prim.Ctl.LINGER) sock
-	    fun setLINGER (sock,optval) =
-	      setSockOptTimeOpt (Prim.Ctl.SOCKET, Prim.Ctl.LINGER) (sock,optval)
-	    fun setBROADCAST (sock,optval) = 
-	      setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.BROADCAST) (sock,optval)
-	    fun getOOBINLINE sock = 
-	      getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.OOBINLINE) sock
-	    fun setOOBINLINE (sock,optval) = 
-	      setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.OOBINLINE) (sock,optval)
-	    fun getSNDBUF sock = 
-	      getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.SNDBUF) sock
-	    fun setSNDBUF (sock,optval) = 
-	      setSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.SNDBUF) (sock,optval)
-	    fun getRCVBUF sock = 
-	      getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.RCVBUF) sock
-	    fun setRCVBUF (sock,optval) = 
-	      setSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.RCVBUF) (sock,optval)
-	    fun getTYPE sock =
-	      getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.TYPE) sock
-	    fun getERROR sock =
-	      getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.ERROR) sock
-	    local
-	      fun getName 
-                  (f: Prim.sock * pre_sock_addr * int ref -> int)
-                  (S s) =
-		let
-		  val (sa, salen, finish) = new_sock_addr ()
-		  val _ = PE.checkResult
-		          (f (s, sa, salen))
-		in
-		  finish ()
-		end
+      val getDEBUG = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DEBUG)
+      val setDEBUG = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DEBUG)
+      val getREUSEADDR = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.REUSEADDR)
+      val setREUSEADDR = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.REUSEADDR)
+      val getKEEPALIVE = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.KEEPALIVE)
+      val setKEEPALIVE = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.KEEPALIVE)
+      val getDONTROUTE = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DONTROUTE)
+      val setDONTROUTE = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.DONTROUTE)
+      val getBROADCAST = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.BROADCAST)
+      val getLINGER = getSockOptTimeOpt (Prim.Ctl.SOCKET, Prim.Ctl.LINGER)
+      val setLINGER = setSockOptTimeOpt (Prim.Ctl.SOCKET, Prim.Ctl.LINGER)
+      val setBROADCAST = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.BROADCAST)
+      val getOOBINLINE = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.OOBINLINE)
+      val setOOBINLINE = setSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.OOBINLINE)
+      val getSNDBUF = getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.SNDBUF)
+      val setSNDBUF = setSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.SNDBUF)
+      val getRCVBUF = getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.RCVBUF)
+      val setRCVBUF = setSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.RCVBUF)
+      val getTYPE = getSockOptInt (Prim.Ctl.SOCKET, Prim.Ctl.TYPE)
+      val getERROR = getSockOptBool (Prim.Ctl.SOCKET, Prim.Ctl.ERROR)
+      local
+	 fun getName 
+	    (f: Prim.sock * pre_sock_addr * int ref -> int)
+	    (S s) =
+	    let
+	       val (sa, salen, finish) = new_sock_addr ()
+	       val _ = PE.checkResult (f (s, sa, salen))
 	    in
-	      fun getPeerName sock = getName Prim.Ctl.getPeerName sock
-	      fun getSockName sock = getName Prim.Ctl.getSockName sock
+	       finish ()
 	    end
-	    fun setNBIO (sock,optval) =
-	      setIOCtlBool Prim.Ctl.NBIO (sock,optval)
-	    fun getNREAD sock =
-	      getIOCtlInt Prim.Ctl.NREAD sock
-	    fun getATMARK sock =
-	      getIOCtlBool Prim.Ctl.ATMARK sock
+      in
+	 fun getPeerName sock = getName Prim.Ctl.getPeerName sock
+	 fun getSockName sock = getName Prim.Ctl.getSockName sock
+      end
+      val getNREAD = getIOCtlInt Prim.Ctl.NREAD
+      val getATMARK = getIOCtlBool Prim.Ctl.ATMARK
+   end
+
+fun sameAddr (SA sa1, SA sa2) = sa1 = sa2
+
+fun familyOfAddr (SA sa) = Prim.familyOfAddr sa
+
+fun bind (S s, SA sa) =
+   PE.checkResult (Prim.bind (s, sa, Word8Vector.length sa))
+
+fun listen (S s, n) = PE.checkResult (Prim.listen (s, n))
+
+fun nonBlock' (res: int, again, no, f) =
+   if ~1 = res
+      then
+	 let
+	    val e = PE.getErrno ()
+	 in
+	    if e = again
+	       then no
+	    else PE.raiseSys e
 	 end
-      fun sameAddr (SA sa1, SA sa2) = sa1 = sa2
-      fun familyOfAddr (SA sa) = Prim.familyOfAddr sa
+   else f res
 
-      fun bind (S s, SA sa) =
-	PE.checkResult
-	(Prim.bind (s, sa, Word8Vector.length sa))
-      fun listen (S s, n) =
-	PE.checkResult
-	(Prim.listen (s, n))
-      fun connect (S s, SA sa) =
-	PE.checkResult
-	(Prim.connect (s, sa, Word8Vector.length sa))
-      fun accept (S s) =
-	let
-	  val (sa, salen, finish) = new_sock_addr ()
-	  val s = PE.checkReturnResult
-	          (Prim.accept (s, sa, salen))
-	in
-	  (S s, finish ())
-	end
-      fun close (S s) =
-	PE.checkResult
-	(Prim.close (s))
-      datatype shutdown_mode = NO_RECVS | NO_SENDS | NO_RECVS_OR_SENDS
-      fun shutdownModeToHow m =
-	case m of
-	  NO_RECVS => Prim.SHUT_RD
-	| NO_SENDS => Prim.SHUT_WR
-	| NO_RECVS_OR_SENDS => Prim.SHUT_RDWR
-      fun shutdown (S s, m) =
-	PE.checkResult
-	(Prim.shutdown (s, shutdownModeToHow m))
-      type sock_desc = OS.IO.iodesc
-      fun sockDesc sock = PFS.fdToIOD (sockToFD sock)
-      fun sameDesc (desc1, desc2) =
-	 OS.IO.compare (desc1, desc2) = EQUAL
-      fun select {rds: sock_desc list, 
-		  wrs: sock_desc list, 
-		  exs: sock_desc list, 
-		  timeout: Time.time option} =
+fun nonBlock (res, no, f) = nonBlock' (res, PE.again, no, f)
+   
+local
+   structure PIO = PosixPrimitive.IO
+in
+   fun withNonBlock (fd, f: unit -> 'a) =
+      let
+	 val flags = PIO.fcntl2 (fd, PIO.F_GETFL)
+	 val _ = PIO.fcntl3 (fd, PIO.F_SETFL,
+			     Word.toIntX
+			     (Word.orb (Word.fromInt flags,
+					PosixPrimitive.FileSys.O.nonblock)))
+      in
+	 DynamicWind.wind (f, fn () => (PIO.fcntl3 (fd, PIO.F_SETFL, flags)
+					; ()))
+      end
+end
+
+fun connect (S s, SA sa) =
+   PE.checkResult (Prim.connect (s, sa, Word8Vector.length sa))
+
+fun connectNB (S s, SA sa) =
+   nonBlock' (withNonBlock (s, fn () =>
+			    Prim.connect (s, sa, Word8Vector.length sa)),
+	      PE.inprogress,
+	      false,
+	      fn _ => true)
+
+fun accept (S s) =
+   let
+      val (sa, salen, finish) = new_sock_addr ()
+      val s = PE.checkReturnResult (Prim.accept (s, sa, salen))
+   in
+      (S s, finish ())
+   end
+
+fun acceptNB (S s) =
+   let
+      val (sa, salen, finish) = new_sock_addr ()
+   in
+      nonBlock (withNonBlock (s, fn () => Prim.accept (s, sa, salen)),
+		NONE,
+		fn s => SOME (S s, finish ()))
+   end
+
+fun close (S s) = PE.checkResult (Prim.close (s))
+
+datatype shutdown_mode = NO_RECVS | NO_SENDS | NO_RECVS_OR_SENDS
+
+fun shutdownModeToHow m =
+   case m of
+      NO_RECVS => Prim.SHUT_RD
+    | NO_SENDS => Prim.SHUT_WR
+    | NO_RECVS_OR_SENDS => Prim.SHUT_RDWR
+
+fun shutdown (S s, m) =
+   PE.checkResult
+   (Prim.shutdown (s, shutdownModeToHow m))
+
+type sock_desc = OS.IO.iodesc
+
+fun sockDesc sock = PFS.fdToIOD (sockToFD sock)
+
+fun sameDesc (desc1, desc2) =
+   OS.IO.compare (desc1, desc2) = EQUAL
+
+fun select {rds: sock_desc list, 
+	    wrs: sock_desc list, 
+	    exs: sock_desc list, 
+	    timeout: Time.time option} =
+   let
+      fun mk poll (sd,pds) =
 	 let
-	    fun mk poll (sd,pds) =
-	       let
-		  val pd = Option.valOf (OS.IO.pollDesc sd)
-		  val pd = poll pd
-	       in
-		  pd::pds
-	       end
-	    val pds =
-	       (List.foldr (mk OS.IO.pollIn)
-		(List.foldr (mk OS.IO.pollOut)
-		 (List.foldr (mk OS.IO.pollPri)
-		  [] exs) wrs) rds)
-	    val pis = OS.IO.poll (pds, timeout)
-	    val {rds, wrs, exs} =
-	       List.foldr
-	       (fn (pi,{rds,wrs,exs}) =>
-		let
-		   fun mk (is,l) =
-		      if is pi
-			 then (OS.IO.pollToIODesc (OS.IO.infoToPollDesc pi))::l
-			 else l
-		in
-		   {rds = mk (OS.IO.isIn, rds),
-		    wrs = mk (OS.IO.isOut, wrs),
-		    exs = mk (OS.IO.isPri, exs)}
-		end) 
-	       {rds = [], wrs = [], exs = []}
-	       pis
+	    val pd = Option.valOf (OS.IO.pollDesc sd)
+	    val pd = poll pd
 	 in
-	    {rds = rds, wrs = wrs, exs = exs}
+	    pd::pds
 	 end
-      val ioDesc = sockDesc
+      val pds =
+	 (List.foldr (mk OS.IO.pollIn)
+	  (List.foldr (mk OS.IO.pollOut)
+	   (List.foldr (mk OS.IO.pollPri)
+	    [] exs) wrs) rds)
+      val pis = OS.IO.poll (pds, timeout)
+      val {rds, wrs, exs} =
+	 List.foldr
+	 (fn (pi,{rds,wrs,exs}) =>
+	  let
+	     fun mk (is,l) =
+		if is pi
+		   then (OS.IO.pollToIODesc (OS.IO.infoToPollDesc pi))::l
+		else l
+	  in
+	     {rds = mk (OS.IO.isIn, rds),
+	      wrs = mk (OS.IO.isOut, wrs),
+	      exs = mk (OS.IO.isPri, exs)}
+	  end) 
+	 {rds = [], wrs = [], exs = []}
+	 pis
+   in
+      {rds = rds, wrs = wrs, exs = exs}
+   end
+
+val ioDesc = sockDesc
  
-      type 'a buf = {buf : 'a, i : int, sz : int option}
+type 'a buf = {buf: 'a, i: int, sz: int option}
 
-      type out_flags = {don't_route : bool, oob : bool}
-      fun mk_out_flags {don't_route, oob} =
-	Word.orb (if don't_route then Prim.MSG_DONTROUTE else 0wx0,
-	Word.orb (if oob then Prim.MSG_OOB else 0wx0,
-		  0wx0))
-      val no_out_flags = {don't_route = false, oob = false}
-
-      fun sendVec' (S s, {buf, i, sz}, out_flags) =
-	let
-	  val max = Vector.checkSlice (buf, i, sz)
-	in
-	  PE.checkReturnResult 
-	  (Prim.send (s, buf, i, max -? i, mk_out_flags out_flags))
-	end
-      fun sendArr' (sock, {buf, i, sz}, out_flags) =
-	sendVec' (sock, 
-		  {buf = Word8Vector.fromArray buf, i = i, sz = sz}, out_flags)
-      fun sendVec (sock, buf) = 
-	sendVec' (sock, buf, no_out_flags)
-      fun sendArr (sock, buf) = 
-	sendArr' (sock, buf, no_out_flags)
-
-      fun sendVecTo' (S s, SA sa, {buf, i, sz}, out_flags) =
-	let
-	  val max = Vector.checkSlice (buf, i, sz)
-	in
-	  PE.checkReturnResult
-	  (Prim.sendTo (s, buf, i, max -? i, mk_out_flags out_flags,
-			sa, Word8Vector.length sa))
-	end
-      fun sendArrTo' (sock, sock_addr, {buf, i, sz}, out_flags) =
-	sendVecTo' (sock, sock_addr, 
-		    {buf = Word8Vector.fromArray buf, i = i, sz = sz}, out_flags)
-      fun sendVecTo (sock, sock_addr, buf) = 
-	sendVecTo' (sock, sock_addr, buf, no_out_flags)
-      fun sendArrTo (sock, sock_addr, buf) = 
-	sendArrTo' (sock, sock_addr, buf, no_out_flags)
-
-      type in_flags = {peek : bool, oob : bool}
-      fun mk_in_flags {peek, oob} =
-	Word.orb (if peek then Prim.MSG_PEEK else 0wx0,
-	Word.orb (if oob then Prim.MSG_OOB else 0wx0,
-		  0wx0))
-      val no_in_flags = {peek = false, oob = false}
-
-      fun recvArr' (S s, {buf, i, sz}, in_flags) =
-	let
-	  val max = Array.checkSlice (buf, i, sz)
-	in
-	  PE.checkReturnResult
-	  (Prim.recv (s, buf, i, max -? i, mk_in_flags in_flags))
-	end
-      fun recvVec' (sock, n, in_flags) =
-	let
-	  val a = Word8Array.rawArray n
-	  val bytesRead = 
-	    recvArr' (sock, {buf = a, i = 0, sz = SOME n}, in_flags)
-	in
-	  if n = bytesRead
-	    then Word8Vector.fromArray a
-	    else Word8Array.extract (a, 0, SOME bytesRead)
-	end
-      fun recvArr (sock, buf) =
-	recvArr' (sock, buf, no_in_flags)
-      fun recvVec (sock, n) =
-	recvVec' (sock, n, no_in_flags)
-
-      fun recvArrFrom' (S s, {buf, i, sz}, in_flags) =
-	let
-	  val max = Array.checkSlice (buf, i, sz)
-	  val (sa, salen, finish) = new_sock_addr ()
-	  val n = PE.checkReturnResult
-	          (Prim.recvFrom (s, buf, i, max -? i, mk_in_flags in_flags,
-				  sa, salen))
-	in
-	  (n, finish ())
-	end
-      fun recvVecFrom' (sock, n, in_flags) =
-	let
-	  val a = Primitive.Array.array n
-	  val (bytesRead, sock_addr) = 
-	    recvArrFrom' (sock, {buf = a, i = 0, sz = SOME n}, in_flags)
-	in
-	  (if n = bytesRead
-	     then Word8Vector.fromArray a
+type out_flags = {don't_route: bool, oob: bool}
+
+fun mk_out_flags {don't_route, oob} =
+   Word.orb (if don't_route then Prim.MSG_DONTROUTE else 0wx0,
+		Word.orb (if oob then Prim.MSG_OOB else 0wx0,
+			     0wx0))
+val no_out_flags = {don't_route = false, oob = false}
+
+local
+   fun make (base, primSend, primSendTo) =
+      let
+	 fun send' (S s, sl, out_flags) =
+	    let
+	       val (buf, i, sz) = base sl
+	    in
+	       PE.checkReturnResult
+	       (primSend (s, buf, i, sz, mk_out_flags out_flags))
+	    end
+	 fun send (sock, buf) = send' (sock, buf, no_out_flags)
+	 fun sendNB' (S s, sl, out_flags) =
+	    let
+	       val (buf, i, sz) = base sl
+	       val res =
+		  primSend
+		  (s, buf, i, sz,
+		   Word.orb (Prim.MSG_DONTWAIT, mk_out_flags out_flags))
+	    in
+	       nonBlock (res, NONE, SOME)
+	    end
+	 fun sendNB (sock, sl) = sendNB' (sock, sl, no_out_flags)
+	 fun sendTo' (S s, SA sa, sl, out_flags) =
+	    let
+	       val (buf, i, sz) = base sl
+	    in
+	       PE.checkResult
+	       (primSendTo (s, buf, i, sz, mk_out_flags out_flags, sa,
+			    Word8Vector.length sa))
+	    end
+	 fun sendTo (sock, sock_addr, sl) =
+	    sendTo' (sock, sock_addr, sl, no_out_flags)
+	 fun sendToNB' (S s, SA sa, sl, out_flags) =
+	    let
+	       val (buf, i, sz) = base sl
+	    in
+	       nonBlock (primSendTo (s, buf, i, sz,
+				     Word.orb (Prim.MSG_DONTWAIT,
+					       mk_out_flags out_flags),
+				     sa, Word8Vector.length sa),
+			 false,
+			 fn _ => true)
+	    end
+	 fun sendToNB (sock, sa, sl) =
+	    sendToNB' (sock, sa, sl, no_out_flags)
+      in
+	 (send, send', sendNB, sendNB', sendTo, sendTo', sendToNB, sendToNB')
+      end
+in
+   
+   val (sendArr, sendArr', sendArrNB, sendArrNB',
+	sendArrTo, sendArrTo', sendArrToNB, sendArrToNB') =
+      make (Word8ArraySlice.base, Prim.sendArr, Prim.sendToArr)
+   val (sendVec, sendVec', sendVecNB, sendVecNB',
+	sendVecTo, sendVecTo', sendVecToNB, sendVecToNB') =
+      make (Word8VectorSlice.base, Prim.sendVec, Prim.sendToVec)
+end
+
+type in_flags = {peek: bool, oob: bool}
+
+val no_in_flags = {peek = false, oob = false}
+	    
+fun mk_in_flags {peek, oob} =
+   Word.orb (if peek then Prim.MSG_PEEK else 0wx0,
+		Word.orb (if oob then Prim.MSG_OOB else 0wx0,
+			     0wx0))
+
+fun recvArr' (S s, sl, in_flags) =
+   let
+      val (buf, i, sz) = Word8ArraySlice.base sl
+   in
+      PE.checkReturnResult
+      (Prim.recv (s, buf, i, sz, mk_in_flags in_flags))
+   end
+
+fun recvVec' (sock, n, in_flags) =
+   let
+      val a = Word8Array.rawArray n
+      val bytesRead =
+	 recvArr' (sock, Word8ArraySlice.full a, in_flags)
+   in
+      if n = bytesRead
+	 then Word8Vector.fromArray a
+      else Word8Array.extract (a, 0, SOME bytesRead)
+   end
+
+fun recvArr (sock, sl) = recvArr' (sock, sl, no_in_flags)
+
+fun recvVec (sock, n) = recvVec' (sock, n, no_in_flags)
+
+fun recvArrFrom' (S s, sl, in_flags) =
+   let
+      val (buf, i, sz) = Word8ArraySlice.base sl
+      val (sa, salen, finish) = new_sock_addr ()
+      val n =
+	 PE.checkReturnResult
+	 (Prim.recvFrom
+	  (s, buf, i, sz, mk_in_flags in_flags, sa, salen))
+   in
+      (n, finish ())
+   end
+
+fun recvVecFrom' (sock, n, in_flags) =
+   let
+      val a = Primitive.Array.array n
+      val (bytesRead, sock_addr) =
+	 recvArrFrom' (sock, Word8ArraySlice.full a, in_flags)
+   in
+      (if n = bytesRead
+	  then Word8Vector.fromArray a
+       else Word8Array.extract (a, 0, SOME bytesRead),
+	  sock_addr)
+   end
+
+fun recvArrFrom (sock, sl) = recvArrFrom' (sock, sl, no_in_flags)
+
+fun recvVecFrom (sock, n) = recvVecFrom' (sock, n, no_in_flags)
+
+fun mk_in_flagsNB z = Word.orb (mk_in_flags z, Prim.MSG_DONTWAIT)
+
+fun recvArrNB' (S s, sl, in_flags) =
+   let
+      val (buf, i, sz) = Word8ArraySlice.base sl
+   in
+      nonBlock (Prim.recv (s, buf, i, sz, mk_in_flagsNB in_flags),
+		NONE,
+		SOME)
+		      
+   end
+
+fun recvVecNB' (S s, n, in_flags) =
+   let
+      val a = Word8Array.rawArray n
+   in
+      nonBlock (Prim.recv (s, a, 0, n, mk_in_flagsNB in_flags),
+		NONE,
+		fn bytesRead =>
+		SOME (if n = bytesRead
+			 then Word8Vector.fromArray a
+		      else Word8Array.extract (a, 0, SOME bytesRead)))
+		      
+   end
+
+fun recvArrNB (sock, sl) = recvArrNB' (sock, sl, no_in_flags)
+
+fun recvVecNB (sock, n) = recvVecNB' (sock, n, no_in_flags)
+
+fun recvArrFromNB' (S s, sl, in_flags) =
+   let
+      val (buf, i, sz) = Word8ArraySlice.base sl
+      val (sa, salen, finish) = new_sock_addr ()
+   in
+      nonBlock
+      (Prim.recvFrom (s, buf, i, sz, mk_in_flagsNB in_flags, sa, salen),
+       NONE,
+       fn n => SOME (n, finish ()))
+   end
+
+fun recvVecFromNB' (S s, n, in_flags) =
+   let
+      val a = Primitive.Array.array n
+      val (sa, salen, finish) = new_sock_addr ()
+   in
+      nonBlock
+      (Prim.recvFrom (s, a, 0, n, mk_in_flagsNB in_flags, sa, salen),
+       NONE,
+       fn bytesRead =>
+       SOME (if n = bytesRead
+		then Word8Vector.fromArray a
 	     else Word8Array.extract (a, 0, SOME bytesRead),
-	   sock_addr)
-	end
-      fun recvArrFrom (sock, buf) =
-	recvArrFrom' (sock, buf, no_in_flags)
-      fun recvVecFrom (sock, n) =
-	recvVecFrom' (sock, n, no_in_flags)
-   end
\ No newline at end of file
+		finish ()))
+   end
+
+fun recvArrFromNB (sock, sl) = recvArrFromNB' (sock, sl, no_in_flags)
+
+fun recvVecFromNB (sock, n) = recvVecFromNB' (sock, n, no_in_flags)
+
+(* Phantom type. *)
+type ('af,'sock_type) sock = sock
+
+type 'af sock_addr = sock_addr
+
+type 'mode stream = stream
+   
+end



1.9       +2 -2      mlton/basis-library/posix/io.sml

Index: io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/io.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- io.sml	26 Sep 2003 00:50:33 -0000	1.8
+++ io.sml	26 Sep 2003 05:21:08 -0000	1.9
@@ -94,7 +94,7 @@
 	 Word.fromInt (checkReturnResult (Prim.fcntl2 (fd, F_GETFD)))
 
       fun setfd (FD fd, flags): unit =
-	 checkResult (Prim.fcntl3 (fd, F_SETFD, Word.toInt flags))
+	 checkResult (Prim.fcntl3 (fd, F_SETFD, Word.toIntX flags))
 			    
       fun getfl (FD fd): O.flags * open_mode =
 	 let val n = Prim.fcntl2 (fd, F_GETFL)
@@ -108,7 +108,7 @@
 	 end
       
       fun setfl (FD fd, flags: O.flags): unit  =
-	 checkResult (Prim.fcntl3 (fd, F_SETFL, Word.toInt flags))
+	 checkResult (Prim.fcntl3 (fd, F_SETFL, Word.toIntX flags))
 	 
       datatype whence = SEEK_SET | SEEK_CUR | SEEK_END
 



1.84      +8 -0      mlton/doc/changelog

Index: changelog
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/changelog,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -r1.83 -r1.84
--- changelog	26 Sep 2003 00:50:33 -0000	1.83
+++ changelog	26 Sep 2003 05:21:08 -0000	1.84
@@ -3,6 +3,14 @@
 * 2003-09-25
   - Fixed Posix.IO.getfl, which had mistakenly called fcntl with
     F_GETFD instead of F_GETFL.
+  - Tracking basis library changes: 
+    o Socket module datagram functions no longer return amount
+      written, since they always write the entire amount or fail.  So,
+      send{Arr,Vec}To{,'} now return unit instead of int.
+    o Added nonblocking versions of all the send and recv functions,
+      as well as accept and connect.  So, we now have:
+      acceptNB, connectNB, recv{Arr,Vec}{,From}NB{,'},
+      send{Arr,Vec}{,To}NB{,'}
 
 * 2003-09-24
   - Tracking basis library changes:



1.1                  mlton/regression/socket.ok

Index: socket.ok
===================================================================
OK
OK
hello, world
NONE
goodbye, world



1.1                  mlton/regression/socket.sml

Index: socket.sml
===================================================================
val addr = INetSock.any 0
val socket = INetSock.TCP.socket ()
val _ = Socket.bind (socket, addr)
val _ = Socket.listen (socket, 5)
val addr = Socket.Ctl.getSockName socket

fun read socket : string =
   Byte.unpackStringVec (Word8VectorSlice.full (Socket.recvVec (socket, 100)))

fun readNB socket : string option =
   Option.map (Byte.unpackStringVec o Word8VectorSlice.full)
   (Socket.recvVecNB (socket, 100))
   
fun write (socket, s: string): unit =
   (Socket.sendVec (socket, Word8VectorSlice.full (Byte.stringToBytes s))
    ; ())

val _ =
   print (case Socket.acceptNB socket of
	     NONE => "OK\n"
	   | SOME _ => "WRONG\n")

val _ =
   case Posix.Process.fork () of
      NONE =>
	 let
	    val _ = Posix.Process.sleep (Time.fromSeconds 1)
	    val (socket, _) = Socket.accept socket
	    val _ = print (read socket)
	    val _ = print (case readNB socket of
			      NONE => "NONE\n"
			    | SOME s => s)
	    val _ = write (socket, "goodbye, world\n");
	    val _ = Socket.close socket
	 in
	    ()
	 end
    | SOME pid => 
	 let
	    val socket' = INetSock.TCP.socket ()
	    val _ =
	       print (if Socket.connectNB (socket', addr)
			 then "WRONG\n"
		      else "OK\n")
	    val _ = Socket.connect (socket', addr)
	    val _ = write (socket', "hello, world\n")
	    val _ = print (read socket')
	    val _ = Socket.close socket'
	    val (pid', status)  = Posix.Process.wait ()
	 in
	    if pid = pid' andalso status = Posix.Process.W_EXITED
	       then ()
	    else print "child failed\n"
	 end



1.4       +1 -0      mlton/runtime/net-constants.h

Index: net-constants.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/net-constants.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- net-constants.h	10 Apr 2003 02:03:10 -0000	1.3
+++ net-constants.h	26 Sep 2003 05:21:09 -0000	1.4
@@ -47,6 +47,7 @@
 #define Socket_SHUT_WR SHUT_WR
 #define Socket_SHUT_RDWR SHUT_RDWR
 #define Socket_MSG_DONTROUTE MSG_DONTROUTE
+#define Socket_MSG_DONTWAIT MSG_DONTWAIT
 #define Socket_MSG_OOB MSG_OOB
 #define Socket_MSG_PEEK MSG_PEEK
 #define Socket_INetSock_TCP_SOL_TCP IPPROTO_TCP




-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Welcome to geek heaven.
http://thinkgeek.com/sf
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel