[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