[MLton-commit] r4433
Matthew Fluet
MLton@mlton.org
Mon, 1 May 2006 18:46:57 -0700
Refactored Socket
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/basis-extra.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/generic-sock.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-02 01:46:55 UTC (rev 4433)
@@ -304,13 +304,13 @@
../net/net-serv-db.sig
../net/net-serv-db.sml
../net/socket.sig
- (* ../net/socket.sml *)
- (* ../net/generic-sock.sig *)
- (* ../net/generic-sock.sml *)
- (* ../net/inet-sock.sig *)
- (* ../net/inet-sock.sml *)
- (* ../net/unix-sock.sig *)
- (* ../net/unix-sock.sml *)
+ ../net/socket.sml
+ ../net/generic-sock.sig
+ ../net/generic-sock.sml
+ ../net/inet-sock.sig
+ ../net/inet-sock.sml
+ ../net/unix-sock.sig
+ ../net/unix-sock.sml
../mlton/array.sig
../mlton/cont.sig
@@ -359,19 +359,4 @@
../sml-nj/sml-nj.sml
../sml-nj/unsafe.sig
../sml-nj/unsafe.sml
-
-(*
- top-level/basis.sig
- ann
- "allowRebindEquals true"
- in
- top-level/basis.sml
- end
- in
- structure BasisExtra
- top-level/basis-sigs.sml
- top-level/basis-funs.sml
- top-level/top-level.sml
- end
-*)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -131,4 +131,3 @@
structure C_MPLimb = struct open Word32 type t = word end
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -131,4 +131,3 @@
structure C_MPLimb = struct open Word32 type t = word end
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -131,4 +131,3 @@
structure C_MPLimb = struct open Word64 type t = word end
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
-
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -131,4 +131,3 @@
structure C_MPLimb = struct open Word16 type t = word end
functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
-
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/basis-extra.mlb 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/basis-extra.mlb 2006-05-02 01:46:55 UTC (rev 4433)
@@ -12,250 +12,8 @@
"warnUnused false" "forceUsed"
in
local
- ../../primitive/primitive.mlb
- (* Common basis implementation. *)
- ../../top-level/infixes.sml
- ../../misc/basic.sml
- ../../misc/dynamic-wind.sig
- ../../misc/dynamic-wind.sml
- ../../general/general.sig
- ../../general/general.sml
- ../../misc/util.sml
- ../../general/option.sig
- ../../general/option.sml
- ../../list/list.sig
- ../../list/list.sml
- ../../list/list-pair.sig
- ../../list/list-pair.sml
- ../../arrays-and-vectors/slice.sig
- ../../arrays-and-vectors/sequence.sig
- ../../arrays-and-vectors/sequence.fun
- ../../arrays-and-vectors/vector-slice.sig
- ../../arrays-and-vectors/vector.sig
- ../../arrays-and-vectors/vector.sml
- ../../arrays-and-vectors/array-slice.sig
- ../../arrays-and-vectors/array.sig
- ../../arrays-and-vectors/array.sml
- ../../arrays-and-vectors/array2.sig
- ../../arrays-and-vectors/array2.sml
- ../../arrays-and-vectors/mono-vector-slice.sig
- ../../arrays-and-vectors/mono-vector.sig
- ../../arrays-and-vectors/mono-vector.fun
- ../../arrays-and-vectors/mono-array-slice.sig
- ../../arrays-and-vectors/mono-array.sig
- ../../arrays-and-vectors/mono-array.fun
- ../../arrays-and-vectors/mono-array2.sig
- ../../arrays-and-vectors/mono-array2.fun
- ../../arrays-and-vectors/mono.sml
- ../../text/string0.sml
- ../../text/char0.sml
- ../../misc/reader.sig
- ../../misc/reader.sml
- ../../text/string-cvt.sig
- ../../text/string-cvt.sml
- ../../general/bool.sig
- ../../general/bool.sml
- ../../integer/integer.sig
- ../../integer/int.sml
- ../../text/char.sig
- ../../text/char.sml
- ../../text/substring.sig
- ../../text/substring.sml
- ../../text/string.sig
- ../../text/string.sml
- ../../misc/C.sig
- ../../misc/C.sml
- ../../integer/word.sig
- ../../integer/word.sml
- ../../integer/int-inf.sig
- ../../integer/int-inf.sml
- ../../real/IEEE-real.sig
- ../../real/IEEE-real.sml
- ../../real/math.sig
- ../../real/real.sig
- ../../real/real.fun
- ../../integer/pack-word.sig
- ../../integer/pack-word32.sml
- ../../text/byte.sig
- ../../text/byte.sml
- ../../text/text.sig
- ../../text/text.sml
- ../../real/pack-real.sig
- ../../real/pack-real.sml
- ../../real/real32.sml
- ../../real/real64.sml
- ../../integer/patch.sml
- ../../integer/embed-int.sml
- ../../integer/embed-word.sml
- ann "forceUsed" in
- ../../config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml
- end
+ ../../build/sources.mlb
- ../../top-level/arithmetic.sml
-
- (* misc/unique-id.sig *)
- (* misc/unique-id.fun *)
- ../../misc/cleaner.sig
- ../../misc/cleaner.sml
-
- ../../system/pre-os.sml
- ../../system/time.sig
- ../../system/time.sml
- ../../system/date.sig
- ../../system/date.sml
-
- ../../io/io.sig
- ../../io/io.sml
- ../../io/prim-io.sig
- ../../io/prim-io.fun
- ../../io/bin-prim-io.sml
- ../../io/text-prim-io.sml
-
- ../../posix/error.sig
- ../../posix/error.sml
- ../../posix/stub-mingw.sml
- ../../posix/flags.sig
- ../../posix/flags.sml
- ../../posix/signal.sig
- ../../posix/signal.sml
- ../../posix/proc-env.sig
- ../../posix/proc-env.sml
- ../../posix/file-sys.sig
- ../../posix/file-sys.sml
- ../../posix/io.sig
- ../../posix/io.sml
- ../../posix/process.sig
- ../../posix/process.sml
- ../../posix/sys-db.sig
- ../../posix/sys-db.sml
- ../../posix/tty.sig
- ../../posix/tty.sml
- ../../posix/posix.sig
- ../../posix/posix.sml
-
- ../../platform/cygwin.sml
-
- ../../io/stream-io.sig
- ../../io/stream-io.fun
- ../../io/imperative-io.sig
- ../../io/imperative-io.fun
- ../../io/bin-stream-io.sig
- ../../io/bin-io.sig
- ../../io/bin-io.sml
- ../../io/text-stream-io.sig
- ../../io/text-io.sig
- ../../io/text-io.sml
-
- ../../system/path.sig
- ../../system/path.sml
- ../../system/file-sys.sig
- ../../system/file-sys.sml
- ../../system/command-line.sig
- ../../system/command-line.sml
-
- ../../general/sml90.sig
- ../../general/sml90.sml
-
- ../../mlton/pointer.sig
- ../../mlton/pointer.sml
- ../../mlton/call-stack.sig
- ../../mlton/call-stack.sml
- ../../mlton/exit.sml
- ../../mlton/exn.sig
- ../../mlton/exn.sml
- ../../mlton/thread.sig
- ../../mlton/thread.sml
- ../../mlton/signal.sig
- ../../mlton/signal.sml
- ../../mlton/process.sig
- ../../mlton/process.sml
- ../../mlton/gc.sig
- ../../mlton/gc.sml
- ../../mlton/rusage.sig
- ../../mlton/rusage.sml
-
- ../../system/process.sig
- ../../system/process.sml
- ../../system/io.sig
- ../../system/io.sml
- ../../system/os.sig
- ../../system/os.sml
- ../../system/unix.sig
- ../../system/unix.sml
- ../../system/timer.sig
- ../../system/timer.sml
-
- ../../net/net.sig
- ../../net/net.sml
- ../../net/net-host-db.sig
- ../../net/net-host-db.sml
- ../../net/net-prot-db.sig
- ../../net/net-prot-db.sml
- ../../net/net-serv-db.sig
- ../../net/net-serv-db.sml
- ../../net/socket.sig
- ../../net/socket.sml
- ../../net/generic-sock.sig
- ../../net/generic-sock.sml
- ../../net/inet-sock.sig
- ../../net/inet-sock.sml
- ../../net/unix-sock.sig
- ../../net/unix-sock.sml
-
- ../../mlton/array.sig
- ../../mlton/cont.sig
- ../../mlton/cont.sml
- ../../mlton/random.sig
- ../../mlton/random.sml
- ../../mlton/io.sig
- ../../mlton/io.fun
- ../../mlton/text-io.sig
- ../../mlton/bin-io.sig
- ../../mlton/itimer.sig
- ../../mlton/itimer.sml
- ../../mlton/ffi.sig
- ann
- "ffiStr MLtonFFI"
- in
- ../../mlton/ffi.sml
- end
- ../../mlton/int-inf.sig
- ../../mlton/platform.sig
- ../../mlton/platform.sml
- ../../mlton/proc-env.sig
- ../../mlton/proc-env.sml
- ../../mlton/profile.sig
- ../../mlton/profile.sml
- (*
- # mlton/ptrace.sig
- # mlton/ptrace.sml
- *)
- ../../mlton/rlimit.sig
- ../../mlton/rlimit.sml
- ../../mlton/socket.sig
- ../../mlton/socket.sml
- ../../mlton/syslog.sig
- ann
- "allowFFI true"
- in
- ../../mlton/syslog.sml
- end
- ../../mlton/vector.sig
- ../../mlton/weak.sig
- ../../mlton/weak.sml
- ../../mlton/finalizable.sig
- ../../mlton/finalizable.sml
- ../../mlton/word.sig
- ../../mlton/world.sig
- ../../mlton/world.sml
- ../../mlton/mlton.sig
- ../../mlton/mlton.sml
-
- ../../sml-nj/sml-nj.sig
- ../../sml-nj/sml-nj.sml
- ../../sml-nj/unsafe.sig
- ../../sml-nj/unsafe.sml
-
top-level/basis.sig
ann
"allowRebindEquals true"
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/generic-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/generic-sock.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/generic-sock.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -11,27 +11,19 @@
structure PE = Posix.Error
structure PESC = PE.SysCall
- fun intToSock i = Socket.wordToSock (SysWord.fromInt i)
-
fun socket' (af, st, p) =
- PESC.syscall
- (fn () =>
- let val n = Prim.socket (NetHostDB.addrFamilyToInt af, st, p)
- in (n, fn () => intToSock n)
- end)
+ PESC.simpleResult
+ (fn () => Prim.socket (af, st, C_Int.fromInt p))
fun socketPair' (af, st, p) =
let
val a = Array.array (2, 0)
in
PESC.syscall
- (fn () =>
- let val n = Prim.socketPair (NetHostDB.addrFamilyToInt af, st, p, a)
- in (n, fn () => (intToSock (Array.sub (a, 0)),
- intToSock (Array.sub (a, 1))))
- end)
+ (fn () => (Prim.socketPair (af, st, C_Int.fromInt p, a), fn _ =>
+ (Array.sub (a, 0), Array.sub (a, 1))))
end
-
+
fun socket (af, st) = socket' (af, st, 0)
fun socketPair (af, st) = socketPair' (af, st, 0)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/inet-sock.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -15,29 +15,26 @@
type dgram_sock = Socket.dgram sock
type sock_addr = inet Socket.sock_addr
- val inetAF = NetHostDB.intToAddrFamily PrimitiveFFI.Socket.AF.INET
+ val inetAF = PrimitiveFFI.Socket.AF.INET
fun toAddr (in_addr, port) =
- let val port = Net.htonl port
- in
if port < 0 orelse port >= 0x10000
then PosixError.raiseSys PosixError.inval
- else
- let
- val (sa, salen, finish) = Socket.new_sock_addr ()
- val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
- port, sa, salen)
- in
- finish ()
- end
- end
+ else let
+ val port = Net.C_Int.hton (C_Int.fromInt port)
+ val (sa, salen, finish) = Socket.new_sock_addr ()
+ val _ = Prim.toAddr (NetHostDB.inAddrToWord8Vector in_addr,
+ port, sa, salen)
+ in
+ finish ()
+ end
fun any port = toAddr (NetHostDB.any (), port)
fun fromAddr sa =
let
- val _ = Prim.fromAddr (Word8Vector.toPoly (Socket.unpackSockAddr sa))
- val port = Net.ntohl (Prim.getPort ())
+ val _ = Prim.fromAddr (Socket.unpackSockAddr sa)
+ val port = C_Int.toInt (Net.C_Int.ntoh (Prim.getPort ()))
val (ia, finish) = NetHostDB.new_in_addr ()
val _ = Prim.getInAddr (NetHostDB.preInAddrToWord8Array ia)
in
@@ -46,27 +43,23 @@
structure UDP =
struct
- fun socket' prot =
- GenericSock.socket' (inetAF, Socket.SOCK.dgram, prot)
-
+ fun socket' prot = GenericSock.socket' (inetAF, Socket.SOCK.dgram, prot)
fun socket () = socket' 0
end
structure TCP =
struct
structure Prim = Prim.Ctl
-
- fun socket' prot =
- GenericSock.socket' (inetAF, Socket.SOCK.stream, prot)
+ fun socket' prot = GenericSock.socket' (inetAF, Socket.SOCK.stream, prot)
fun socket () = socket' 0
-
+
fun getNODELAY sock =
- Socket.CtlExtra.getSockOptBool
- (Prim.IPPROTO_TCP, Prim.TCP_NODELAY) sock
-
- fun setNODELAY (sock,optval) =
- Socket.CtlExtra.setSockOptBool
- (Prim.IPPROTO_TCP, Prim.TCP_NODELAY) (sock,optval)
+ Socket.CtlExtra.getSockOptBool
+ (Prim.IPPROTO_TCP, Prim.TCP_NODELAY) sock
+
+ fun setNODELAY (sock, optval) =
+ Socket.CtlExtra.setSockOptBool
+ (Prim.IPPROTO_TCP, Prim.TCP_NODELAY) (sock,optval)
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig 2006-05-02 01:46:55 UTC (rev 4433)
@@ -22,18 +22,8 @@
include NET_HOST_DB
type pre_in_addr
- val addrFamilyToInt: addr_family -> int
-(*
val any: unit -> in_addr
-*)
val inAddrToWord8Vector: in_addr -> Word8.word vector
-(*
- val inAddrToWord: in_addr -> word
-*)
- val intToAddrFamily: int -> addr_family
val new_in_addr: unit -> pre_in_addr * (unit -> in_addr)
val preInAddrToWord8Array: pre_in_addr -> Word8.word array
-(*
- val wordToInAddr: word -> in_addr
-*)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -5,42 +5,45 @@
* See the file MLton-LICENSE for details.
*)
-structure NetHostDB:> NET_HOST_DB_EXTRA =
+structure NetHostDB: NET_HOST_DB_EXTRA =
struct
structure Prim = PrimitiveFFI.NetHostDB
- (* network byte order (MSB) *)
+ (* network byte order (big-endian) *)
type pre_in_addr = Word8.word array
type in_addr = Word8.word vector
val preInAddrToWord8Array = fn a => a
val inAddrToWord8Vector = fn v => v
- structure PW = PackWord32Big
+ val inAddrLen = C_Size.toInt Prim.inAddrSize
fun new_in_addr () =
let
- val inAddrLen = C_Size.toInt Prim.inAddrSize
val ia: pre_in_addr = Array.array (inAddrLen, 0wx0: Word8.word)
fun finish () = Array.vector ia
in
(ia, finish)
end
-(*
- fun inAddrToWord (ia: in_addr) =
- Word.fromLargeWord (PW.subVec (Word8Vector.fromPoly ia, 0))
- fun wordToInAddr w =
- let
- val (ia, finish) = new_in_addr ()
- val _ = PW.update (Word8Array.fromPoly ia, 0, Word.toLargeWord w)
- in
- finish ()
- end
- fun any () = wordToInAddr (Word.fromInt Prim.INADDR_ANY)
-*)
+ fun any () =
+ let
+ val (wa, finish) = new_in_addr ()
+ fun loop (i, acc) =
+ if i >= inAddrLen
+ then ()
+ else let
+ val w = Word8.fromSysWord (C_Int.toSysWord acc)
+ val () =
+ Array.update
+ (wa, (inAddrLen - 1) - i, w)
+ in
+ loop (i + 1, C_Int.>> (acc, 0w4))
+ end
+ in
+ loop (0, Prim.INADDR_ANY)
+ ; finish ()
+ end
type addr_family = C_Int.t
- val intToAddrFamily = C_Int.fromInt
- val addrFamilyToInt = C_Int.toInt
datatype entry = T of {name: string,
aliases: string list,
@@ -80,10 +83,8 @@
if C_Int.< (n, numAddrs)
then let
val addr = Word8Array.array (C_Int.toInt length, 0wx0)
- val _ =
- Prim.getEntryAddrsN (n, Word8Array.toPoly addr)
- val addr =
- Word8Vector.toPoly (Word8Array.vector addr)
+ val _ = Prim.getEntryAddrsN (n, Word8Array.toPoly addr)
+ val addr = Word8Vector.toPoly (Word8Array.vector addr)
in
fill (C_Int.+ (n, 1), addr::addrs)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -30,8 +30,7 @@
fun fill (n, aliases) =
if C_Int.< (n, numAliases)
then let
- val alias =
- CUtil.C_String.toString (Prim.getEntryAliasesN n)
+ val alias = CUtil.C_String.toString (Prim.getEntryAliasesN n)
in
fill (C_Int.+ (n, 1), alias::aliases)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -32,8 +32,7 @@
fun fill (n, aliases) =
if C_Int.< (n, numAliases)
then let
- val alias =
- CUtil.C_String.toString (Prim.getEntryAliasesN n)
+ val alias = CUtil.C_String.toString (Prim.getEntryAliasesN n)
in
fill (C_Int.+ (n, 1), alias::aliases)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig 2006-05-02 01:46:55 UTC (rev 4433)
@@ -170,7 +170,7 @@
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 unpackSockAddr: 'af sock_addr -> Word8.word vector
val new_sock_addr: unit -> (pre_sock_addr * C_Socklen.t ref * (unit -> 'af sock_addr))
structure CtlExtra:
@@ -179,18 +179,14 @@
type optname = C_Int.int
type request = C_Int.int
- (* val getSockOptWord: level * optname -> ('af, 'sock_type) sock -> word *)
- (* val setSockOptWord: level * optname -> ('af, 'sock_type) sock * word -> unit *)
val getERROR: ('af, 'sock_type) sock -> (string * Posix.Error.syserror option) option
- val getSockOptInt: level * optname -> ('af, 'sock_type) sock -> int
- val setSockOptInt: level * optname -> ('af, 'sock_type) sock * int -> unit
+ val getSockOptInt: level * optname -> ('af, 'sock_type) sock -> C_Int.int
+ val setSockOptInt: level * optname -> ('af, 'sock_type) sock * C_Int.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 getIOCtlInt: request -> ('af, 'sock_type) sock -> C_Int.int
+ (* val setIOCtlInt: request -> ('af, 'sock_type) sock * C_Int.int -> unit *)
val getIOCtlBool: request -> ('af, 'sock_type) sock -> bool
(* val setIOCtlBool: request -> ('af, 'sock_type) sock * bool -> unit *)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -5,9 +5,7 @@
* See the file MLton-LICENSE for details.
*)
-structure Socket:> SOCKET_EXTRA
- where type SOCK.sock_type = C_Int.t
- where type pre_sock_addr = Word8.word array =
+structure Socket : SOCKET_EXTRA =
struct
structure Prim = PrimitiveFFI.Socket
@@ -16,22 +14,22 @@
structure FileSys = Posix.FileSys
type sock = C_Sock.t
-val sockToWord = SysWord.fromInt o C_Sock.toInt
-val wordToSock = C_Sock.fromInt o SysWord.toInt
-fun sockToFD sock = FileSys.wordToFD (sockToWord sock)
-fun fdToSock fd = wordToSock (FileSys.fdToWord fd)
+val sockToWord = C_Sock.toSysWord
+val wordToSock = C_Sock.fromSysWord
+val sockToFD = fn x => x
+val fdToSock = fn x => x
type pre_sock_addr = Word8.word array
datatype sock_addr = SA of Word8.word vector
-fun unpackSockAddr (SA sa) = Word8Vector.fromPoly sa
+fun unpackSockAddr (SA sa) = sa
fun new_sock_addr (): (pre_sock_addr * C_Socklen.t ref * (unit -> sock_addr)) =
let
val salen = C_Size.toInt Prim.sockAddrStorageLen
val sa = Array.array (salen, 0wx0)
val salenRef = ref (C_Socklen.fromInt salen)
- fun finish () =
- SA (ArraySlice.vector (ArraySlice.slice
- (sa, 0, SOME (C_Socklen.toInt (!salenRef)))))
+ fun finish () =
+ SA (ArraySlice.vector
+ (ArraySlice.slice (sa, 0, SOME (C_Socklen.toInt (!salenRef)))))
in
(sa, salenRef, finish)
end
@@ -43,12 +41,12 @@
structure AF =
struct
type addr_family = NetHostDB.addr_family
- val names = [
- ("UNIX", Prim.AF.UNIX),
- ("INET", Prim.AF.INET),
- ("INET6", Prim.AF.INET6),
- ("UNSPEC", Prim.AF.UNSPEC)
- ]
+ val names : (string * addr_family) list =
+ ("UNIX", Prim.AF.UNIX) ::
+ ("INET", Prim.AF.INET) ::
+ ("INET6", Prim.AF.INET6) ::
+ ("UNSPEC", Prim.AF.UNSPEC) ::
+ nil
fun list () = names
fun toString af' =
case List.find (fn (_, af) => af = af') names of
@@ -65,10 +63,10 @@
type sock_type = C_Int.t
val stream = Prim.SOCK.STREAM
val dgram = Prim.SOCK.DGRAM
- val names = [
- ("STREAM", stream),
- ("DGRAM", dgram)
- ]
+ val names : (string * sock_type) list =
+ ("STREAM", stream) ::
+ ("DGRAM", dgram) ::
+ nil
fun list () = names
fun toString st' =
case List.find (fn (_, st) => st = st') names of
@@ -85,99 +83,216 @@
type level = C_Int.t
type optname = C_Int.t
type request = C_Int.t
-
+
(* host byte order *)
- structure PW = PackWord32Host
+ type optvalVec = Word8.word vector
+ type optvalArr = Word8.word array
- val wordLen = PW.bytesPerElem
- fun unmarshalWord (wa, _, 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 + 1))))
- 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 + 1))
- | SOME t =>
- (marshalBool (true, wa, s)
- ; marshalWord (Word.fromLargeInt (Time.toSeconds t)
- handle Overflow => Error.raiseSys Error.inval,
- wa, s + 1))
-
+ val isBigEndian = Primitive.MLton.Platform.Arch.hostIsBigEndian
+ val intLen = Int.quot (C_Int.precision', 4)
+ fun unmarshalInt (wa: optvalArr) : C_Int.int =
+ let
+ fun loop (i, acc) =
+ if i >= intLen
+ then acc
+ else let
+ val w =
+ Array.sub
+ (wa, if isBigEndian
+ then i
+ else (intLen - 1) - i)
+ val w = C_Int.fromSysWord (Word8.toSysWord w)
+ in
+ loop (i + 1, C_Int.andb (w, C_Int.<< (acc, 0w4)))
+ end
+ in
+ loop (0, 0)
+ end
+ fun marshalInt (i: C_Int.int) : optvalVec =
+ let
+ val wa = Array.array (intLen, 0wx0)
+ fun loop (i, acc) =
+ if i >= intLen
+ then ()
+ else let
+ val w = Word8.fromSysWord (C_Int.toSysWord acc)
+ val () =
+ Array.update
+ (wa, if isBigEndian
+ then (intLen - 1) - i
+ else i, w)
+ in
+ loop (i + 1, C_Int.>> (acc, 0w4))
+ end
+ in
+ loop (0, i)
+ ; Array.vector wa
+ end
+ val boolLen = intLen
+ fun unmarshalBool (wa: optvalArr) : bool =
+ if (unmarshalInt wa) = 0 then false else true
+ fun marshalBool (b: bool) : optvalVec =
+ marshalInt (if b then 1 else 0)
+ val sizeLen = Int.quot (C_Size.wordSize, 4)
+ fun unmarshalSize (wa: optvalArr) : int =
+ let
+ fun loop (i, acc) =
+ if i >= sizeLen
+ then acc
+ else let
+ val w =
+ Array.sub
+ (wa, if isBigEndian
+ then i
+ else (sizeLen - 1) - i)
+ val w = C_Size.fromSysWord (Word8.toSysWord w)
+ in
+ loop (i + 1, C_Size.andb (w, C_Size.<< (acc, 0w4)))
+ end
+ in
+ C_Size.toInt (loop (0, 0wx0))
+ end
+ fun marshalSize (i: int) : optvalVec =
+ let
+ val wa = Array.array (sizeLen, 0wx0)
+ fun loop (i, acc) =
+ if i >= sizeLen
+ then ()
+ else let
+ val w = Word8.fromSysWord (C_Size.toSysWord acc)
+ val () =
+ Array.update
+ (wa, if isBigEndian
+ then (sizeLen - 1) - i
+ else i, w)
+ in
+ loop (i + 1, C_Size.>> (acc, 0w4))
+ end
+ in
+ loop (0, C_Size.fromInt i)
+ ; Array.vector wa
+ end
+ (* Assume 'struct linger' has no padding. *)
+ val optTimeLen: int = intLen + intLen
+ fun unmarshalOptTime (wa: optvalArr) : Time.time option =
+ let
+ fun loopBool (i, acc) =
+ if i >= intLen
+ then acc
+ else let
+ val w =
+ Array.sub
+ (wa, if isBigEndian
+ then i
+ else (intLen - 1) - i)
+ val w = C_Int.fromSysWord (Word8.toSysWord w)
+ in
+ loopBool (i + 1, C_Int.andb (w, C_Int.<< (acc, 0w4)))
+ end
+ fun loopInt (i, acc) =
+ if i >= intLen
+ then acc
+ else let
+ val w =
+ Array.sub
+ (wa, intLen + (if isBigEndian
+ then i
+ else (intLen - 1) - i))
+ val w = C_Int.fromSysWord (Word8.toSysWord w)
+ in
+ loopInt (i + 1, C_Int.andb (w, C_Int.<< (acc, 0w4)))
+ end
+ in
+ if loopBool (0, 0) = 0
+ then NONE
+ else SOME (Time.fromSeconds (C_Int.toLarge (loopInt (0, 0))))
+ end
+ fun marshalOptTime (to: Time.time option) : optvalVec =
+ let
+ val wa = Array.array (optTimeLen, 0wx0)
+ fun loopBool (i, acc) =
+ if i >= intLen
+ then ()
+ else let
+ val w = Word8.fromSysWord (C_Int.toSysWord acc)
+ val () =
+ Array.update
+ (wa, if isBigEndian
+ then (intLen - 1) - i
+ else i, w)
+ in
+ loopBool (i + 1, C_Int.>> (acc, 0w4))
+ end
+ fun loopInt (i, acc) =
+ if i >= intLen
+ then ()
+ else let
+ val w = Word8.fromSysWord (C_Int.toSysWord acc)
+ val () =
+ Array.update
+ (wa, intLen + (if isBigEndian
+ then (intLen - 1) - i
+ else i), w)
+ in
+ loopInt (i + 1, C_Int.>> (acc, 0w4))
+ end
+ in
+ case to of
+ NONE => (loopBool (0, 0); loopInt (0, 0))
+ | SOME t => (loopBool (0, 1); loopInt (0, C_Int.fromLarge (Time.toSeconds t)))
+ ; Array.vector wa
+ end
+
local
fun make (optlen: int,
- write: 'a * Word8Array.array * int -> unit,
- unmarshal: Word8Array.array * int * int -> 'a) =
+ marshal: 'a -> optvalVec,
+ unmarshal: optvalArr -> 'a) =
let
- fun marshal (x: 'a): Word8Vector.vector =
+ fun getSockOpt (level: level, optname: optname) s : 'a =
let
- val wa = Word8Array.array (optlen, 0wx0)
+ val optval = Array.array (optlen, 0wx0)
+ val optlen' = ref (C_Socklen.fromInt optlen)
+ val () =
+ Syscall.simple
+ (fn () =>
+ Prim.Ctl.getSockOpt (s, level, optname, optval, optlen'))
+ val () =
+ if C_Socklen.toInt (!optlen') <> optlen
+ then raise (Fail "Socket.Ctl.getSockOpt: optlen' <> optlen")
+ else ()
in
- write (x, wa, 0)
- ; Word8Array.vector wa
+ unmarshal optval
end
- fun getSockOpt (level: level, optname: optname) s =
+ fun setSockOpt (level: level, optname: optname) (s, optval: 'a) : unit =
let
- val optval = Word8Array.array (optlen, 0wx0)
- val optlen = ref (C_Socklen.fromInt optlen)
- in
- Syscall.simple
- (fn () =>
- Prim.Ctl.getSockOpt (s, level, optname,
- Word8Array.toPoly optval,
- optlen))
- ; unmarshal (optval, C_Socklen.toInt (!optlen), 0)
- end
- fun setSockOpt (level: level, optname: optname) (s, optval) =
- let
val optval = marshal optval
- val optlen = Word8Vector.length optval
+ val optlen' = C_Socklen.fromInt optlen
+ val () =
+ Syscall.simple
+ (fn () =>
+ Prim.Ctl.setSockOpt (s, level, optname, optval, optlen'))
in
- Syscall.simple
- (fn () =>
- Prim.Ctl.setSockOpt (s, level, optname,
- Word8Vector.toPoly optval,
- C_Socklen.fromInt optlen))
+ ()
end
fun getIOCtl (request: request) s : 'a =
let
- val optval = Word8Array.array (optlen, 0wx0)
+ val optval = Array.array (optlen, 0wx0)
+ val () =
+ Syscall.simple
+ (fn () =>
+ Prim.Ctl.getIOCtl (s, request, optval))
in
- Syscall.simple
- (fn () =>
- Prim.Ctl.getIOCtl
- (s, request, Word8Array.toPoly optval))
- ; unmarshal (optval, optlen, 0)
+ unmarshal optval
end
- fun setIOCtl (request: request) (s, optval: 'a): unit =
+ fun setIOCtl (request: request) (s, optval: 'a) : unit =
let
val optval = marshal optval
+ val () =
+ Syscall.simple
+ (fn () =>
+ Prim.Ctl.setIOCtl (s, request, optval))
in
- Syscall.simple
- (fn () =>
- Prim.Ctl.setIOCtl
- (s, request, Word8Vector.toPoly optval))
+ ()
end
in
(getSockOpt, getIOCtl, setSockOpt, setIOCtl)
@@ -187,8 +302,10 @@
make (intLen, marshalInt, unmarshalInt)
val (getSockOptBool, getIOCtlBool, setSockOptBool, _) =
make (boolLen, marshalBool, unmarshalBool)
- val (getSockOptTimeOpt, _, setSockOptTimeOpt, _) =
- make (timeOptLen, marshalTimeOpt, unmarshalTimeOpt)
+ val (getSockOptSize, getIOCtlSize, setSockOptSize, _) =
+ make (sizeLen, marshalSize, unmarshalSize)
+ val (getSockOptOptTime, getIOCtlOptTime, setSockOptOptTime, _) =
+ make (optTimeLen, marshalOptTime, unmarshalOptTime)
end
val getDEBUG = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DEBUG)
@@ -199,16 +316,16 @@
val setKEEPALIVE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_KEEPALIVE)
val getDONTROUTE = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DONTROUTE)
val setDONTROUTE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DONTROUTE)
+ val getLINGER = getSockOptOptTime (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
+ val setLINGER = setSockOptOptTime (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
val getBROADCAST = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_BROADCAST)
- val getLINGER = getSockOptTimeOpt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
- val setLINGER = setSockOptTimeOpt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER)
val setBROADCAST = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_BROADCAST)
val getOOBINLINE = getSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_OOBINLINE)
val setOOBINLINE = setSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_OOBINLINE)
- val getSNDBUF = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
- val setSNDBUF = setSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
- val getRCVBUF = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
- val setRCVBUF = setSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
+ val getSNDBUF = getSockOptSize (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
+ val setSNDBUF = setSockOptSize (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF)
+ val getRCVBUF = getSockOptSize (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
+ val setRCVBUF = setSockOptSize (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF)
fun getTYPE s = getSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_TYPE) s
fun getERROR s =
let
@@ -216,10 +333,10 @@
in
if 0 = se
then NONE
- else SOME (Posix.Error.errorMsg se, SOME se)
+ else SOME (Posix.Error.errorMsg se, SOME se)
end handle Error.SysErr z => SOME z
local
- fun getName (s, f: sock * pre_sock_addr * C_Socklen.t ref -> int) =
+ fun getName (s, f: sock * pre_sock_addr * C_Socklen.t ref -> C_Int.int C_Errno.t) =
let
val (sa, salen, finish) = new_sock_addr ()
val () = Syscall.simple (fn () => f (s, sa, salen))
@@ -230,7 +347,7 @@
fun getPeerName s = getName (s, Prim.Ctl.getPeerName)
fun getSockName s = getName (s, Prim.Ctl.getSockName)
end
- val getNREAD = getIOCtlInt Prim.Ctl.FIONREAD
+ val getNREAD = getIOCtlSize Prim.Ctl.FIONREAD
val getATMARK = getIOCtlBool Prim.Ctl.SIOCATMARK
end
@@ -243,27 +360,24 @@
fun sameAddr (SA sa1, SA sa2) = sa1 = sa2
-fun familyOfAddr (SA sa) = NetHostDB.intToAddrFamily (Prim.familyOfAddr sa)
+fun familyOfAddr (SA sa) = Prim.familyOfAddr sa
fun bind (s, SA sa) =
Syscall.simple (fn () => Prim.bind (s, sa, C_Socklen.fromInt (Vector.length sa)))
fun listen (s, n) =
- Syscall.simple (fn () => Prim.listen (s, n))
+ Syscall.simple (fn () => Prim.listen (s, C_Int.fromInt n))
fun nonBlock' ({restart: bool},
- f : unit -> int, post : int -> 'a, again, no : 'a) =
+ errVal : ''a, f : unit -> ''a C_Errno.t, post : ''a -> 'b, again, no : 'b) =
Syscall.syscallErr
- ({clear = false, restart = restart},
- fn () => let val res = f ()
- in
- {return = res,
- post = fn () => post res,
- handlers = [(again, fn () => no)]}
- end)
+ ({clear = false, restart = restart, errVal = errVal}, fn () =>
+ {return = f (),
+ post = post,
+ handlers = [(again, fn () => no)]})
-fun nonBlock (f, post, no) =
- nonBlock' ({restart = true}, f, post, Error.again, no)
+fun nonBlock (errVal, f, post, no) =
+ nonBlock' ({restart = true}, errVal, f, post, Error.again, no)
local
structure PIO = PrimitiveFFI.Posix.IO
@@ -273,17 +387,15 @@
val fd = s
val flags =
Syscall.simpleResultRestart (fn () => PIO.fcntl2 (fd, PIO.F_GETFL))
- val _ =
- Syscall.simpleResultRestart
+ val () =
+ Syscall.simpleRestart
(fn () =>
PIO.fcntl3 (fd, PIO.F_SETFL,
- Word.toIntX
- (Word.orb (Word.fromInt flags,
- SysWord.fromInt PrimitiveFFI.Posix.FileSys.O.NONBLOCK))))
+ C_Int.orb (flags, PrimitiveFFI.Posix.FileSys.O.NONBLOCK)))
in
DynamicWind.wind
(f, fn () =>
- Syscall.simple (fn () => PIO.fcntl3 (fd, PIO.F_SETFL, flags)))
+ Syscall.simpleRestart (fn () => PIO.fcntl3 (fd, PIO.F_SETFL, flags)))
end
end
@@ -292,7 +404,7 @@
fun connectNB (s, SA sa) =
nonBlock'
- ({restart = false}, fn () =>
+ ({restart = false}, C_Int.fromInt ~1, fn () =>
withNonBlock (s, fn () => Prim.connect (s, sa, C_Socklen.fromInt (Vector.length sa))),
fn _ => true,
Error.inprogress, false)
@@ -310,7 +422,8 @@
val (sa, salen, finish) = new_sock_addr ()
in
nonBlock
- (fn () => withNonBlock (s, fn () => Prim.accept (s, sa, salen)),
+ (C_Int.fromInt ~1,
+ fn () => withNonBlock (s, fn () => Prim.accept (s, sa, salen)),
fn s => SOME (s, finish ()),
NONE)
end
@@ -378,25 +491,27 @@
type out_flags = {don't_route: bool, oob: bool}
-fun mk_out_flags {don't_route, oob} =
- Word.orb (if don't_route then Word.fromInt Prim.MSG_DONTROUTE else 0wx0,
- Word.orb (if oob then Word.fromInt Prim.MSG_OOB else 0wx0,
- 0wx0))
val no_out_flags = {don't_route = false, oob = false}
+fun mk_out_flags {don't_route, oob} =
+ C_Int.orb (if don't_route then Prim.MSG_DONTROUTE else 0x0,
+ C_Int.orb (if oob then Prim.MSG_OOB else 0x0,
+ 0x0))
+
local
- fun make (base, toPoly, primSend, primSendTo) =
+ fun make (base, primSend, primSendTo) =
let
val base = fn sl => let val (buf, i, sz) = base sl
- in (toPoly buf, i, sz)
+ in (buf, i, sz)
end
fun send' (s, sl, out_flags) =
let
val (buf, i, sz) = base sl
in
- Syscall.simpleResultRestart
- (fn () => primSend (s, buf, i, C_Size.fromInt sz,
- Word.toInt (mk_out_flags out_flags)))
+ (C_SSize.toInt o Syscall.simpleResultRestart')
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ primSend (s, buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_out_flags out_flags))
end
fun send (sock, buf) = send' (sock, buf, no_out_flags)
fun sendNB' (s, sl, out_flags) =
@@ -404,12 +519,11 @@
val (buf, i, sz) = base sl
in
nonBlock
- (fn () =>
- primSend (s, buf, i, C_Size.fromInt sz,
- Word.toInt (
- Word.orb (Word.fromInt Prim.MSG_DONTWAIT,
- mk_out_flags out_flags))),
- SOME,
+ (C_SSize.fromInt ~1,
+ fn () =>
+ primSend (s, buf, C_Int.fromInt i, C_Size.fromInt sz,
+ C_Int.orb (Prim.MSG_DONTWAIT, mk_out_flags out_flags)),
+ SOME o C_SSize.toInt,
NONE)
end
fun sendNB (sock, sl) = sendNB' (sock, sl, no_out_flags)
@@ -417,10 +531,10 @@
let
val (buf, i, sz) = base sl
in
- Syscall.simpleRestart
- (fn () =>
- primSendTo (s, buf, i, C_Size.fromInt sz,
- Word.toInt (mk_out_flags out_flags),
+ Syscall.simpleRestart'
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ primSendTo (s, buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_out_flags out_flags,
sa, C_Socklen.fromInt (Vector.length sa)))
end
fun sendTo (sock, sock_addr, sl) =
@@ -430,11 +544,10 @@
val (buf, i, sz) = base sl
in
nonBlock
- (fn () =>
- primSendTo (s, buf, i, C_Size.fromInt sz,
- Word.toInt (
- Word.orb (Word.fromInt Prim.MSG_DONTWAIT,
- mk_out_flags out_flags)),
+ (C_SSize.fromInt ~1,
+ fn () =>
+ primSendTo (s, buf, C_Int.fromInt i, C_Size.fromInt sz,
+ C_Int.orb (Prim.MSG_DONTWAIT, mk_out_flags out_flags),
sa, C_Socklen.fromInt (Vector.length sa)),
fn _ => true,
false)
@@ -447,12 +560,10 @@
in
val (sendArr, sendArr', sendArrNB, sendArrNB',
sendArrTo, sendArrTo', sendArrToNB, sendArrToNB') =
- make (Word8ArraySlice.base, Word8Array.toPoly,
- Prim.sendArr, Prim.sendArrTo)
+ make (Word8ArraySlice.base, Prim.sendArr, Prim.sendArrTo)
val (sendVec, sendVec', sendVecNB, sendVecNB',
sendVecTo, sendVecTo', sendVecToNB, sendVecToNB') =
- make (Word8VectorSlice.base, Word8Vector.toPoly,
- Prim.sendVec, Prim.sendVecTo)
+ make (Word8VectorSlice.base, Prim.sendVec, Prim.sendVecTo)
end
type in_flags = {peek: bool, oob: bool}
@@ -460,17 +571,18 @@
val no_in_flags = {peek = false, oob = false}
fun mk_in_flags {peek, oob} =
- Word.orb (if peek then Word.fromInt Prim.MSG_PEEK else 0wx0,
- Word.orb (if oob then Word.fromInt Prim.MSG_OOB else 0wx0,
- 0wx0))
+ C_Int.orb (if peek then Prim.MSG_PEEK else 0x0,
+ C_Int.orb (if oob then Prim.MSG_OOB else 0x0,
+ 0x0))
fun recvArr' (s, sl, in_flags) =
let
val (buf, i, sz) = Word8ArraySlice.base sl
in
- Syscall.simpleResultRestart
- (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
- Word.toInt (mk_in_flags in_flags)))
+ (C_SSize.toInt o Syscall.simpleResultRestart')
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ Prim.recv (s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_in_flags in_flags))
end
fun getVec (a, n, bytesRead) =
@@ -480,7 +592,7 @@
fun recvVec' (sock, n, in_flags) =
let
- val a = Word8Array.rawArray n
+ val a = Word8Array.arrayUninit n
val bytesRead =
recvArr' (sock, Word8ArraySlice.full a, in_flags)
in
@@ -496,17 +608,18 @@
val (buf, i, sz) = Word8ArraySlice.base sl
val (sa, salen, finish) = new_sock_addr ()
val n =
- Syscall.simpleResultRestart
- (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
- Word.toInt (mk_in_flags in_flags),
- sa, salen))
+ (C_SSize.toInt o Syscall.simpleResultRestart')
+ ({errVal = C_SSize.fromInt ~1}, fn () =>
+ Prim.recvFrom (s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_in_flags in_flags,
+ sa, salen))
in
(n, finish ())
end
fun recvVecFrom' (sock, n, in_flags) =
let
- val a = Word8Array.fromPoly (Primitive.Array.array n)
+ val a = Word8Array.arrayUninit n
val (bytesRead, sock_addr) =
recvArrFrom' (sock, Word8ArraySlice.full a, in_flags)
in
@@ -517,27 +630,29 @@
fun recvVecFrom (sock, n) = recvVecFrom' (sock, n, no_in_flags)
-fun mk_in_flagsNB z = Word.orb (mk_in_flags z, Word.fromInt Prim.MSG_DONTWAIT)
+fun mk_in_flagsNB in_flags = C_Int.orb (mk_in_flags in_flags, Prim.MSG_DONTWAIT)
fun recvArrNB' (s, sl, in_flags) =
let
val (buf, i, sz) = Word8ArraySlice.base sl
in
nonBlock
- (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
- Word.toInt (mk_in_flagsNB in_flags)),
- SOME,
+ (C_SSize.fromInt ~1,
+ fn () => Prim.recv (s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_in_flagsNB in_flags),
+ SOME o C_SSize.toInt,
NONE)
end
fun recvVecNB' (s, n, in_flags) =
let
- val a = Word8Array.rawArray n
+ val a = Word8Array.arrayUninit n
in
nonBlock
- (fn () => Prim.recv (s, Word8Array.toPoly a, 0, C_Size.fromInt n,
- Word.toInt (mk_in_flagsNB in_flags)),
- fn bytesRead => SOME (getVec (a, n, bytesRead)),
+ (C_SSize.fromInt ~1,
+ fn () => Prim.recv (s, Word8Array.toPoly a, 0, C_Size.fromInt n,
+ mk_in_flagsNB in_flags),
+ fn bytesRead => SOME (getVec (a, n, C_SSize.toInt bytesRead)),
NONE)
end
@@ -551,21 +666,23 @@
val (sa, salen, finish) = new_sock_addr ()
in
nonBlock
- (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
- Word.toInt (mk_in_flagsNB in_flags), sa, salen),
- fn n => SOME (n, finish ()),
+ (C_SSize.fromInt ~1,
+ fn () => Prim.recvFrom (s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz,
+ mk_in_flagsNB in_flags, sa, salen),
+ fn n => SOME (C_SSize.toInt n, finish ()),
NONE)
end
fun recvVecFromNB' (s, n, in_flags) =
let
- val a = Word8Array.fromPoly (Primitive.Array.array n)
+ val a = Word8Array.arrayUninit n
val (sa, salen, finish) = new_sock_addr ()
in
nonBlock
- (fn () => Prim.recvFrom (s, Word8Array.toPoly a, 0, C_Size.fromInt n,
- Word.toInt (mk_in_flagsNB in_flags), sa, salen),
- fn bytesRead => SOME (getVec (a, n, bytesRead), finish ()),
+ (C_SSize.fromInt ~1,
+ fn () => Prim.recvFrom (s, Word8Array.toPoly a, 0, C_Size.fromInt n,
+ mk_in_flagsNB in_flags, sa, salen),
+ fn bytesRead => SOME (getVec (a, n, C_SSize.toInt bytesRead), finish ()),
NONE)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml 2006-05-02 01:46:55 UTC (rev 4433)
@@ -14,7 +14,7 @@
type 'mode stream_sock = 'mode Socket.stream sock
type dgram_sock = Socket.dgram sock
type sock_addr = unix Socket.sock_addr
- val unixAF = NetHostDB.intToAddrFamily PrimitiveFFI.Socket.AF.UNIX
+ val unixAF = PrimitiveFFI.Socket.AF.UNIX
fun toAddr s =
let
@@ -29,7 +29,6 @@
fun fromAddr sa =
let
val sa = Socket.unpackSockAddr sa
- val sa = Word8Vector.toPoly sa
val len = Prim.pathLen sa
val a = CharArray.array (C_Size.toInt len, #"\000")
val _ = Prim.fromAddr (sa, CharArray.toPoly a, len)
@@ -40,13 +39,11 @@
structure Strm =
struct
fun socket () = GenericSock.socket (unixAF, Socket.SOCK.stream)
- fun socketPair () =
- GenericSock.socketPair (unixAF, Socket.SOCK.stream)
+ fun socketPair () = GenericSock.socketPair (unixAF, Socket.SOCK.stream)
end
structure DGrm =
struct
fun socket () = GenericSock.socket (unixAF, Socket.SOCK.dgram)
- fun socketPair () =
- GenericSock.socketPair (unixAF, Socket.SOCK.dgram)
+ fun socketPair () = GenericSock.socketPair (unixAF, Socket.SOCK.dgram)
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Net/NetHostDB.c 2006-05-02 01:46:55 UTC (rev 4433)
@@ -30,7 +30,7 @@
return num;
}
-void NetHostDB_getEntryAddrsN(C_Int_t n, Array(C_Char_t) addr) {
+void NetHostDB_getEntryAddrsN(C_Int_t n, Array(Word8_t) addr) {
int i;
for (i = 0; i < hostent->h_length; i++) {
((char*)addr)[i] = hostent->h_addr_list[n][i];
@@ -38,13 +38,13 @@
return;
}
-Bool_t NetHostDB_getByAddress(Vector(C_Char_t) addr, C_Socklen_t len) {
- hostent = gethostbyaddr((void*)addr, len, AF_INET);
+Bool_t NetHostDB_getByAddress(Vector(Word8_t) addr, C_Socklen_t len) {
+ hostent = gethostbyaddr((const char*)addr, len, AF_INET);
return (hostent != NULL and hostent->h_name != NULL);
}
Bool_t NetHostDB_getByName(NullString8_t name) {
- hostent = gethostbyname((char*)name);
+ hostent = gethostbyname((const char*)name);
return (hostent != NULL and hostent->h_name != NULL);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-05-01 02:06:27 UTC (rev 4432)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-05-02 01:46:55 UTC (rev 4433)
@@ -257,13 +257,11 @@
} while (0)
static char* mlTypesHSuffix[] = {
- "",
"#endif /* _MLTON_MLTYPES_H_ */",
NULL
};
static char* cTypesHSuffix[] = {
- "",
"#define C_Errno_t(t) t",
"",
"#endif /* _MLTON_CTYPES_H_ */",
@@ -271,7 +269,6 @@
};
static char* cTypesSMLSuffix[] = {
- "",
NULL
};