[MLton-devel] cvs commit: Basis2002 networking functionality
Matthew Fluet
fluet@users.sourceforge.net
Sat, 28 Dec 2002 17:23:01 -0800
fluet 02/12/28 17:23:01
Modified: basis-library notes.txt
basis-library/libs build
basis-library/libs/basis-2002/top-level basis-sigs.sml
basis.sig basis.sml
basis-library/misc primitive.sml
basis-library/mlton cont.sml exn.sml gc.sml io.fun
itimer.sml mlton.sml proc-env.sml process.sml
profile-alloc.sml profile-data.sig profile-time.sml
profile.fun profile.sig ptrace.sml random.sml
rlimit.sml rusage.sml signal.sig signal.sml
socket.sml syslog.sml thread.sml world.sig
world.sml
basis-library/net net-host-db.sig net-host-db.sml
net-serv-db.sml socket.sig
basis-library/posix file-sys.sml
basis-library/sml-nj sml-nj.sml
basis-library/system process.sml timer.sml unix.sml
bin check-basis
doc/user-guide basis.tex extensions.tex
mlton/main main.sml
runtime Makefile basis-constants.h libmlton.h mlton-basis.h
runtime/Posix/IO write.c
runtime/basis/Net NetHostDB.c
Added: basis-library/net generic-sock.sml inet-sock.sml net.sig
net.sml socket.sml unix-sock.sml
regression echo.ok echo.sml
runtime net-constants.h
runtime/basis/Net Net.c
runtime/basis/Net/Socket Ctl.c INetSock.c Socket.c
UnixSock.c accept.c bind.c close.c connect.c
listen.c recv.c recvFrom.c send.c sendTo.c
shutdown.c socket.c socketPair.c
Removed: basis-library/mlton text-io.sml
runtime/basis/Socket Host.c accept.c connect.c listen.c
shutdown.c
Log:
Implemented Socket, GenericSock, INetSock, and UnixSock as described
in Basis 2002. Remimplemented MLton.Socket in terms of the basis
structures. Added echo.sml from the computer language shootout to
regressions as a networking test.
Revision Changes Path
1.3 +10 -0 mlton/basis-library/notes.txt
Index: notes.txt
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/notes.txt,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- notes.txt 24 Nov 2002 01:19:34 -0000 1.2
+++ notes.txt 29 Dec 2002 01:22:57 -0000 1.3
@@ -350,6 +350,16 @@
******************************************************************************
******************************************************************************
+Doing host/network byte order conversions on ML side.
+
+Socket.Ctl
+* Semantics of setNBIO, getNREAD, getATMARK are unclear;
+ Don't seem to be accessible via {get,set}sockopt;
+ Instead, using ioctl.
+
+******************************************************************************
+******************************************************************************
+
Posix.FileSys:
* Within structure S, the type mode is constrained equal to flags,
but flags is an eqtype.
1.7 +42 -31 mlton/basis-library/libs/build
Index: build
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/build,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- build 5 Dec 2002 01:25:15 -0000 1.6
+++ build 29 Dec 2002 01:22:57 -0000 1.7
@@ -145,36 +145,59 @@
general/sml90.sig
general/sml90.sml
-mlton/array.sig
-mlton/vector.sig
mlton/process.sig
mlton/process.sml
mlton/exn.sig
mlton/exn.sml
-mlton/itimer.sig
-mlton/itimer.sml
mlton/thread.sig
mlton/thread.sml
mlton/signal.sig
mlton/signal.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/ptrace.sig
-mlton/ptrace.sml
-mlton/world.sig
-mlton/world.sml
-mlton/socket.sig
-mlton/socket.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/gc.sig
mlton/gc.sml
mlton/int-inf.sig
-mlton/word.sig
mlton/proc-env.sig
mlton/proc-env.sml
mlton/profile-data.sig
@@ -182,32 +205,20 @@
mlton/profile.fun
mlton/profile-alloc.sml
mlton/profile-time.sml
+mlton/ptrace.sig
+mlton/ptrace.sml
mlton/rlimit.sig
mlton/rlimit.sml
-mlton/rusage.sig
-mlton/rusage.sml
+mlton/socket.sig
+mlton/socket.sml
mlton/syslog.sig
mlton/syslog.sml
+mlton/vector.sig
+mlton/word.sig
+mlton/world.sig
+mlton/world.sml
mlton/mlton.sig
mlton/mlton.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-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
sml-nj/sml-nj.sig
sml-nj/sml-nj.sml
1.4 +1 -5 mlton/basis-library/libs/basis-2002/top-level/basis-sigs.sml
Index: basis-sigs.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis-sigs.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- basis-sigs.sml 4 Dec 2002 00:29:01 -0000 1.3
+++ basis-sigs.sml 29 Dec 2002 01:22:57 -0000 1.4
@@ -44,10 +44,8 @@
(* Optional signatures *)
signature ARRAY2 = ARRAY2
signature BIT_FLAGS = BIT_FLAGS
-(*
signature GENERIC_SOCK = GENERIC_SOCK
signature INET_SOCK = INET_SOCK
-*)
signature INT_INF = INT_INF
signature MONO_ARRAY2 = MONO_ARRAY2
signature NET_HOST_DB = NET_HOST_DB
@@ -64,11 +62,9 @@
signature POSIX_SIGNAL = POSIX_SIGNAL
signature POSIX_SYS_DB = POSIX_SYS_DB
signature POSIX_TTY = POSIX_TTY
-(*
signature SOCKET = SOCKET
-*)
signature UNIX = UNIX
-(*
signature UNIX_SOCK = UNIX_SOCK
+(*
signature WINDOWS = WINDOWS
*)
1.5 +0 -6 mlton/basis-library/libs/basis-2002/top-level/basis.sig
Index: basis.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sig,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- basis.sig 5 Dec 2002 01:25:15 -0000 1.4
+++ basis.sig 29 Dec 2002 01:22:58 -0000 1.5
@@ -136,10 +136,8 @@
structure BoolVectorSlice : MONO_VECTOR_SLICE
structure CharArray2 : MONO_ARRAY2
structure FixedInt : INTEGER
-(*
structure GenericSock : GENERIC_SOCK
structure INetSock : INET_SOCK
-*)
structure IntArray : MONO_ARRAY
structure IntArray2 : MONO_ARRAY2
structure IntArraySlice : MONO_ARRAY_SLICE
@@ -177,13 +175,9 @@
structure Real64 : REAL
structure Real64Vector : MONO_VECTOR
structure Real64VectorSlice : MONO_VECTOR_SLICE
-(*
structure Socket : SOCKET
-*)
structure SysWord : WORD
-(*
structure UnixSock : UNIX_SOCK
-*)
structure Unix : UNIX
(*
structure WideCharArray : MONO_ARRAY
1.5 +0 -6 mlton/basis-library/libs/basis-2002/top-level/basis.sml
Index: basis.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-2002/top-level/basis.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- basis.sml 5 Dec 2002 01:25:15 -0000 1.4
+++ basis.sml 29 Dec 2002 01:22:58 -0000 1.5
@@ -55,10 +55,8 @@
structure BoolArray2 = BoolArray2
structure CharArray2 = CharArray2
structure FixedInt = FixedInt
-(*
structure GenericSock = GenericSock
structure INetSock = INetSock
-*)
structure IntArray = IntArray
structure IntArraySlice = IntArraySlice
structure IntVector = IntVector
@@ -96,13 +94,9 @@
structure Real64Vector = Real64Vector
structure Real64VectorSlice = Real64VectorSlice
structure Real64Array2 = Real64Array2
-(*
structure Socket = Socket
-*)
structure SysWord = SysWord
-(*
structure UnixSock = UnixSock
-*)
structure Unix = Unix
(*
structure WideCharArray = WideCharArray
1.43 +167 -38 mlton/basis-library/misc/primitive.sml
Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -r1.42 -r1.43
--- primitive.sml 7 Dec 2002 02:21:50 -0000 1.42
+++ primitive.sml 29 Dec 2002 01:22:58 -0000 1.43
@@ -410,24 +410,38 @@
_ffi "MLton_Process_spawnp"
: nullString * nullString array -> int;
end
-
+
(* val deserialize = _prim "MLton_deserialize": Word8Vector.vector -> 'a ref; *)
(* val serialize = _prim "MLton_serialize": 'a ref -> Word8Vector.vector; *)
val size = fn x => _prim "MLton_size": 'a ref -> int; x
end
+ structure Net =
+ struct
+ val htonl = _ffi "Net_htonl": int -> int;
+ val ntohl = _ffi "Net_ntohl": int -> int;
+ val htons = _ffi "Net_htons": int -> int;
+ val ntohs = _ffi "Net_ntohs": int -> int;
+ end
+
structure NetHostDB =
struct
+ (* network byte order (MSB) *)
+ type pre_in_addr = word8 array
+ type in_addr = word8 vector
+ val inAddrLen = _const "NetHostDB_inAddrLen": int;
+ val INADDR_ANY = _const "NetHostDB_INADDR_ANY": int;
+ type addr_family = int
val entryName = _ffi "NetHostDB_Entry_name": unit -> cstring;
val entryNumAliases = _ffi "NetHostDB_Entry_numAliases": unit -> int;
val entryAliasesN = _ffi "NetHostDB_Entry_aliasesN": int -> cstring;
val entryAddrType = _ffi "NetHostDB_Entry_addrType": unit -> int;
val entryLength = _ffi "NetHostDB_Entry_length": unit -> int;
val entryNumAddrs = _ffi "NetHostDB_Entry_numAddrs": unit -> int;
- val entryAddrsN = _ffi "NetHostDB_Entry_addrsN": int * word8 array -> unit;
- val getByAddress = _ffi "NetHostDB_getByAddress": word8 vector * int -> bool;
- val getByName = _ffi "NetHostDB_getByName": string -> bool;
+ val entryAddrsN = _ffi "NetHostDB_Entry_addrsN": int * pre_in_addr -> unit;
+ val getByAddress = _ffi "NetHostDB_getByAddress": in_addr * int -> bool;
+ val getByName = _ffi "NetHostDB_getByName": nullString -> bool;
val getHostName = _ffi "NetHostDB_getHostName": char array * int -> int;
end
@@ -437,7 +451,7 @@
val entryNumAliases = _ffi "NetProtDB_Entry_numAliases": unit -> int;
val entryAliasesN = _ffi "NetProtDB_Entry_aliasesN": int -> cstring;
val entryProtocol = _ffi "NetProtDB_Entry_protocol": unit -> int;
- val getByName = _ffi "NetProtDB_getByName": string -> bool;
+ val getByName = _ffi "NetProtDB_getByName": nullString -> bool;
val getByNumber = _ffi "NetProtDB_getByNumber": int -> bool;
end
@@ -448,9 +462,9 @@
val entryAliasesN = _ffi "NetServDB_Entry_aliasesN": int -> cstring;
val entryPort = _ffi "NetServDB_Entry_port": unit -> int;
val entryProtocol = _ffi "NetServDB_Entry_protocol": unit -> cstring;
- val getByName = _ffi "NetServDB_getByName": string * string -> bool;
- val getByNameNull = _ffi "NetServDB_getByNameNull": string -> bool;
- val getByPort = _ffi "NetServDB_getByPort": int * string -> bool;
+ val getByName = _ffi "NetServDB_getByName": nullString * nullString -> bool;
+ val getByNameNull = _ffi "NetServDB_getByNameNull": nullString -> bool;
+ val getByPort = _ffi "NetServDB_getByPort": int * nullString -> bool;
val getByPortNull = _ffi "NetServDB_getByPortNull": int -> bool;
end
@@ -470,8 +484,7 @@
structure PackReal =
struct
val subVec = _ffi "PackReal_subVec": word8 vector * int -> real;
- val update =
- _ffi "PackReal_update": word8 array * int * real -> unit;
+ val update = _ffi "PackReal_update": word8 array * int * real -> unit;
end
structure Ptrace =
@@ -570,34 +583,150 @@
structure Socket =
struct
- type fd = int
- type socket = int
- type port = int
- type address = word
-
- structure Addr =
- struct
- val address = _ffi "Socket_Addr_address": unit -> address;
- val port = _ffi "Socket_Addr_port": unit -> port;
- end
-
- structure Host =
- struct
- val name = _ffi "Socket_Host_name": unit -> cstring;
- val getByAddress =
- _ffi "Socket_Host_getByAddress": address -> bool;
- val getByName =
- _ffi "Socket_Host_getByName": nullString -> bool;
- end
-
- val accept = _ffi "Socket_accept": socket -> fd;
- val connect = _ffi "Socket_connect": string * port -> socket;
- val listen = _ffi "Socket_listen": port ref * socket ref -> int;
- type how = int;
- val shutdownRead = _const "Socket_shutdownRead": how;
- val shutdownWrite = _const "Socket_shutdownWrite": how;
- val shutdownReadWrite = _const "Socket_shutdownReadWrite": how;
- val shutdown = _ffi "Socket_shutdown": fd * how -> int;
+ type sock = int
+ type pre_sock_addr = word8 array
+ type sock_addr = word8 vector
+ val sockAddrLenMax = _const "Socket_sockAddrLenMax": int;
+ structure AF =
+ struct
+ type addr_family = int
+ val UNIX = _const "Socket_AF_UNIX": addr_family;
+ val INET = _const "Socket_AF_INET": addr_family;
+ val INET6 = _const "Socket_AF_INET6": addr_family;
+ val UNSPEC = _const "Socket_AF_UNSPEC": addr_family;
+ end
+ structure SOCK =
+ struct
+ type sock_type = int
+ val STREAM = _const "Socket_SOCK_STREAM": sock_type;
+ val DGRAM = _const "Socket_SOCK_DGRAM": sock_type;
+ end
+ structure CtlExtra =
+ struct
+ type level = int
+ type optname = int
+ type request = int
+ (* host byte order (LSB) *)
+ type read_data = word8 vector
+ type write_data = word8 array
+
+ val setSockOpt =
+ _ffi "Socket_Ctl_setSockOpt": sock * level * optname *
+ read_data * int ->
+ int;
+ val getSockOpt =
+ _ffi "Socket_Ctl_getSockOpt": sock * level * optname *
+ write_data * int ref ->
+ int;
+ val setIOCtl =
+ _ffi "Socket_Ctl_getsetIOCtl": sock * request *
+ read_data ->
+ int;
+ val getIOCtl =
+ _ffi "Socket_Ctl_getsetIOCtl": sock * request *
+ write_data ->
+ int;
+ end
+ structure Ctl =
+ struct
+ open CtlExtra
+ val SOCKET = _const "Socket_Ctl_SOL_SOCKET": level;
+ val DEBUG = _const "Socket_Ctl_SO_DEBUG": optname;
+ val REUSEADDR = _const "Socket_Ctl_SO_REUSEADDR": optname;
+ val KEEPALIVE = _const "Socket_Ctl_SO_KEEPALIVE": optname;
+ val DONTROUTE = _const "Socket_Ctl_SO_DONTROUTE": optname;
+ val LINGER = _const "Socket_Ctl_SO_LINGER": optname;
+ val BROADCAST = _const "Socket_Ctl_SO_BROADCAST": optname;
+ val OOBINLINE = _const "Socket_Ctl_SO_OOBINLINE": optname;
+ val SNDBUF = _const "Socket_Ctl_SO_SNDBUF": optname;
+ val RCVBUF = _const "Socket_Ctl_SO_RCVBUF": optname;
+ val TYPE = _const "Socket_Ctl_SO_TYPE": optname;
+ val ERROR = _const "Socket_Ctl_SO_ERROR": optname;
+
+ val getPeerName =
+ _ffi "Socket_Ctl_getPeerName": sock * pre_sock_addr * int ref -> int;
+ val getSockName =
+ _ffi "Socket_Ctl_getSockName": sock * pre_sock_addr * int ref -> int;
+
+ val NBIO = _const "Socket_Ctl_FIONBIO": request;
+ val NREAD = _const "Socket_Ctl_FIONREAD": request;
+ val ATMARK = _const "Socket_Ctl_SIOCATMARK": request;
+ end
+
+ val familyOfAddr = _ffi "Socket_familyOfAddr": sock_addr -> AF.addr_family;
+ val bind = _ffi "Socket_bind": sock * sock_addr * int -> int;
+ val listen = _ffi "Socket_listen": sock * int -> int;
+ val connect = _ffi "Socket_connect": sock * sock_addr * int -> int;
+ val accept = _ffi "Socket_accept": sock * pre_sock_addr * int ref -> int;
+ val close = _ffi "Socket_close": sock -> int;
+
+ type how = int
+ val SHUT_RD = _const "Socket_SHUT_RD": how;
+ val SHUT_WR = _const "Socket_SHUT_WR": how;
+ val SHUT_RDWR = _const "Socket_SHUT_RDWR": how;
+ val shutdown = _ffi "Socket_shutdown": sock * how -> int;
+
+ type flags = word
+ val MSG_DONTROUTE = _const "Socket_MSG_DONTROUTE": flags;
+ val MSG_OOB = _const "Socket_MSG_OOB": flags;
+ val MSG_PEEK = _const "Socket_MSG_PEEK": flags;
+
+ val send = _ffi "Socket_send": sock * word8 vector *
+ int * int * word -> int;
+ val sendTo = _ffi "Socket_sendTo": sock * word8 vector *
+ int * int * word *
+ sock_addr * int -> int;
+ val recv = _ffi "Socket_recv": sock * word8 array *
+ int * int * word -> int;
+ val recvFrom = _ffi "Socket_recvFrom": sock * word8 array *
+ int * int * word *
+ pre_sock_addr * int ref -> int;
+
+ structure GenericSock =
+ struct
+ val socket =
+ _ffi "GenericSock_socket": AF.addr_family *
+ SOCK.sock_type *
+ int -> int;
+ val socketPair =
+ _ffi "GenericSock_socketPair": AF.addr_family *
+ SOCK.sock_type *
+ int *
+ int ref * int ref -> int;
+ end
+
+ structure INetSock =
+ struct
+ val toAddr = _ffi "INetSock_toAddr": NetHostDB.in_addr * int *
+ pre_sock_addr * int ref -> unit;
+ val fromAddr = _ffi "INetSock_fromAddr": sock_addr -> unit;
+ val getInAddr = _ffi "INetSock_getInAddr": NetHostDB.pre_in_addr ->
+ unit;
+ val getPort = _ffi "INetSock_getPort": unit -> int;
+ structure UDP =
+ struct
+ end
+ structure TCP =
+ struct
+ open CtlExtra
+ val TCP = _const "Socket_INetSock_TCP_SOL_TCP": level;
+ val NODELAY = _const "Socket_INetSock_TCP_SO_NODELAY": optname;
+ end
+ end
+ structure UnixSock =
+ struct
+ val toAddr = _ffi "UnixSock_toAddr": nullString * int *
+ pre_sock_addr * int ref -> unit;
+ val pathLen = _ffi "UnixSock_pathLen": sock_addr -> int;
+ val fromAddr = _ffi "UnixSock_fromAddr": sock_addr *
+ char array * int -> unit;
+ structure Strm =
+ struct
+ end
+ structure DGrm =
+ struct
+ end
+ end
end
structure Stdio =
1.10 +2 -2 mlton/basis-library/mlton/cont.sml
Index: cont.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/cont.sml,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- cont.sml 22 Jul 2002 01:56:52 -0000 1.9
+++ cont.sml 29 Dec 2002 01:22:58 -0000 1.10
@@ -1,7 +1,7 @@
-structure Cont:> MLTON_CONT =
+structure MLtonCont:> MLTON_CONT =
struct
-structure Thread' = Thread
+structure Thread' = MLtonThread
structure Thread = Primitive.Thread
(* This mess with dummy is so that if callcc is ever used anywhere in the
1.5 +2 -2 mlton/basis-library/mlton/exn.sml
Index: exn.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/exn.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- exn.sml 24 Nov 2002 01:19:39 -0000 1.4
+++ exn.sml 29 Dec 2002 01:22:58 -0000 1.5
@@ -1,4 +1,4 @@
-structure Exn: MLTON_EXN =
+structure MLtonExn: MLTON_EXN =
struct
open Primitive.Exn
@@ -42,7 +42,7 @@
; (List.app
(fn s => (message "\t"; message s; message "\n"))
l)))
- ; Process.exit 1)
+ ; MLtonProcess.exit 1)
handle _ => (message "Toplevel handler raised exception.\n"
; Primitive.halt 1)
end
1.4 +1 -1 mlton/basis-library/mlton/gc.sml
Index: gc.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/gc.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- gc.sml 6 Jul 2002 16:39:40 -0000 1.3
+++ gc.sml 29 Dec 2002 01:22:58 -0000 1.4
@@ -1,4 +1,4 @@
-structure GC =
+structure MLtonGC =
struct
open Primitive.GC
end
1.2 +1 -1 mlton/basis-library/mlton/io.fun
Index: io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/io.fun,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- io.fun 17 Jun 2002 06:28:56 -0000 1.1
+++ io.fun 29 Dec 2002 01:22:58 -0000 1.2
@@ -7,7 +7,7 @@
let
fun loop () =
let
- val name = concat [prefix, Random.alphaNumString 6, suffix]
+ val name = concat [prefix, MLtonRandom.alphaNumString 6, suffix]
open Posix.FileSys
in
(name,
1.6 +1 -1 mlton/basis-library/mlton/itimer.sml
Index: itimer.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/itimer.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- itimer.sml 2 Nov 2002 03:37:34 -0000 1.5
+++ itimer.sml 29 Dec 2002 01:22:58 -0000 1.6
@@ -1,4 +1,4 @@
-structure Itimer =
+structure MLtonItimer =
struct
structure Prim = Primitive.Itimer
1.16 +17 -17 mlton/basis-library/mlton/mlton.sml
Index: mlton.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/mlton.sml,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- mlton.sml 2 Nov 2002 03:37:34 -0000 1.15
+++ mlton.sml 29 Dec 2002 01:22:58 -0000 1.16
@@ -50,26 +50,26 @@
val stdOut = stdOut
end
end
-structure Cont = Cont
-structure Exn = Exn
-structure GC = GC
+structure Cont = MLtonCont
+structure Exn = MLtonExn
+structure GC = MLtonGC
structure IntInf = IntInf
-structure Itimer = Itimer
-structure ProcEnv = ProcEnv
-structure Process = Process
-structure Ptrace = Ptrace
-structure ProfileAlloc = ProfileAlloc
-structure ProfileTime = ProfileTime
-structure Random = Random
-structure Rlimit = Rlimit
-structure Rusage = Rusage
-structure Signal = Signal
-structure Socket = Socket
-structure Syslog = Syslog
+structure Itimer = MLtonItimer
+structure ProcEnv = MLtonProcEnv
+structure Process = MLtonProcess
+structure Ptrace = MLtonPtrace
+structure ProfileAlloc = MLtonProfileAlloc
+structure ProfileTime = MLtonProfileTime
+structure Random = MLtonRandom
+structure Rlimit = MLtonRlimit
+structure Rusage = MLtonRusage
+structure Signal = MLtonSignal
+structure Socket = MLtonSocket
+structure Syslog = MLtonSyslog
structure TextIO = MLtonIO (TextIO)
-structure Thread = Thread
+structure Thread = MLtonThread
structure Vector = Vector
-structure World = World
+structure World = MLtonWorld
structure Word = Primitive.Word32
structure Word8 = Primitive.Word8
1.2 +1 -1 mlton/basis-library/mlton/proc-env.sml
Index: proc-env.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/proc-env.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- proc-env.sml 18 Jul 2001 05:51:02 -0000 1.1
+++ proc-env.sml 29 Dec 2002 01:22:58 -0000 1.2
@@ -1,4 +1,4 @@
-structure ProcEnv: MLTON_PROC_ENV =
+structure MLtonProcEnv: MLTON_PROC_ENV =
struct
fun setenv {name, value} =
PosixError.checkResult
1.4 +1 -1 mlton/basis-library/mlton/process.sml
Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/process.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- process.sml 26 Mar 2002 17:27:30 -0000 1.3
+++ process.sml 29 Dec 2002 01:22:58 -0000 1.4
@@ -1,4 +1,4 @@
-structure Process =
+structure MLtonProcess: MLTON_PROCESS =
struct
structure Prim = Primitive.MLton.Process
structure Error = PosixError
1.6 +2 -2 mlton/basis-library/mlton/profile-alloc.sml
Index: profile-alloc.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/profile-alloc.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- profile-alloc.sml 22 Nov 2002 23:08:34 -0000 1.5
+++ profile-alloc.sml 29 Dec 2002 01:22:58 -0000 1.6
@@ -1,7 +1,7 @@
-structure ProfileAlloc: MLTON_PROFILE =
+structure MLtonProfileAlloc: MLTON_PROFILE =
struct
-structure P = Profile (open Primitive.MLton.ProfileAlloc)
+structure P = MLtonProfile (open Primitive.MLton.ProfileAlloc)
open P
val _ =
1.3 +1 -1 mlton/basis-library/mlton/profile-data.sig
Index: profile-data.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/profile-data.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- profile-data.sig 2 Nov 2002 03:37:34 -0000 1.2
+++ profile-data.sig 29 Dec 2002 01:22:58 -0000 1.3
@@ -1,4 +1,4 @@
-signature PROFILE_DATA =
+signature MLTON_PROFILE_DATA =
sig
type t
1.5 +3 -3 mlton/basis-library/mlton/profile-time.sml
Index: profile-time.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/profile-time.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- profile-time.sml 22 Nov 2002 22:46:15 -0000 1.4
+++ profile-time.sml 29 Dec 2002 01:22:58 -0000 1.5
@@ -1,8 +1,8 @@
-structure ProfileTime: MLTON_PROFILE =
+structure MLtonProfileTime: MLTON_PROFILE =
struct
structure Prim = Primitive.MLton.ProfileTime
-structure P = Profile (open Prim)
+structure P = MLtonProfile (open Prim)
open P
val _ =
@@ -11,7 +11,7 @@
else
let
fun setItimer (t: Time.time): unit =
- Itimer.set' (Itimer.Prof, {interval = t, value = t})
+ MLtonItimer.set' (MLtonItimer.Prof, {interval = t, value = t})
fun init () =
(Prim.init ()
; setCurrent (Data.malloc ())
1.6 +20 -20 mlton/basis-library/mlton/profile.fun
Index: profile.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/profile.fun,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- profile.fun 22 Nov 2002 23:08:34 -0000 1.5
+++ profile.fun 29 Dec 2002 01:22:58 -0000 1.6
@@ -1,24 +1,24 @@
-functor Profile (S:
- sig
- val isOn: bool
- structure Data:
- sig
- type t (* = pointer *)
+functor MLtonProfile (S:
+ sig
+ val isOn: bool
+ structure Data:
+ sig
+ type t (* = pointer *)
- val dummy: t
- val free: t -> unit
- val malloc: unit -> t
- val reset: t -> unit
- val write: t * word (* fd *) -> unit
- end
- val current: unit -> Data.t
- val setCurrent: Data.t -> unit
- end): sig
- include MLTON_PROFILE
- val cleanAtExit: unit -> unit
- val cleanAtLoadWorld: unit -> unit
- val init: unit -> unit
- end =
+ val dummy: t
+ val free: t -> unit
+ val malloc: unit -> t
+ val reset: t -> unit
+ val write: t * word (* fd *) -> unit
+ end
+ val current: unit -> Data.t
+ val setCurrent: Data.t -> unit
+ end): sig
+ include MLTON_PROFILE
+ val cleanAtExit: unit -> unit
+ val cleanAtLoadWorld: unit -> unit
+ val init: unit -> unit
+ end =
struct
open S
1.4 +1 -1 mlton/basis-library/mlton/profile.sig
Index: profile.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/profile.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- profile.sig 2 Nov 2002 03:37:34 -0000 1.3
+++ profile.sig 29 Dec 2002 01:22:58 -0000 1.4
@@ -3,7 +3,7 @@
signature MLTON_PROFILE =
sig
- structure Data: PROFILE_DATA
+ structure Data: MLTON_PROFILE_DATA
val current: unit -> Data.t
val isOn: bool (* a compile-time constant *)
1.2 +1 -1 mlton/basis-library/mlton/ptrace.sml
Index: ptrace.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/ptrace.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- ptrace.sml 18 Jul 2001 05:51:02 -0000 1.1
+++ ptrace.sml 29 Dec 2002 01:22:58 -0000 1.2
@@ -1,4 +1,4 @@
-structure Ptrace: MLTON_PTRACE =
+structure MLtonPtrace: MLTON_PTRACE =
struct
open Primitive.Ptrace
1.2 +1 -1 mlton/basis-library/mlton/random.sml
Index: random.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/random.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- random.sml 18 Jul 2001 05:51:02 -0000 1.1
+++ random.sml 29 Dec 2002 01:22:58 -0000 1.2
@@ -1,4 +1,4 @@
-structure Random: MLTON_RANDOM =
+structure MLtonRandom: MLTON_RANDOM =
struct
(* Linux specific. Uses /dev/random and /dev/urandom to get a
* random word.
1.2 +1 -1 mlton/basis-library/mlton/rlimit.sml
Index: rlimit.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/rlimit.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- rlimit.sml 18 Jul 2001 05:51:02 -0000 1.1
+++ rlimit.sml 29 Dec 2002 01:22:58 -0000 1.2
@@ -1,4 +1,4 @@
-structure Rlimit =
+structure MLtonRlimit: MLTON_RLIMIT =
struct
open Primitive.MLton.Rlimit
1.2 +1 -1 mlton/basis-library/mlton/rusage.sml
Index: rusage.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/rusage.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- rusage.sml 18 Jul 2001 05:51:02 -0000 1.1
+++ rusage.sml 29 Dec 2002 01:22:58 -0000 1.2
@@ -1,4 +1,4 @@
-structure Rusage =
+structure MLtonRusage: MLTON_RUSAGE =
struct
open Primitive.MLton.Rusage
1.6 +2 -2 mlton/basis-library/mlton/signal.sig
Index: signal.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/signal.sig,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- signal.sig 10 Apr 2002 07:54:35 -0000 1.5
+++ signal.sig 29 Dec 2002 01:22:58 -0000 1.6
@@ -26,7 +26,7 @@
type t
val default: t
- val handler: (unit Thread.t -> unit Thread.t) -> t
+ val handler: (unit MLtonThread.t -> unit MLtonThread.t) -> t
val ignore: t
val isDefault: t -> bool
val isIgnore: t -> bool
@@ -41,7 +41,7 @@
* Thread.prepend). This is to avoid the possibility of
* aynchronous exceptions.
*)
- val handleWith': t * (unit Thread.t -> unit Thread.t) -> unit
+ val handleWith': t * (unit MLtonThread.t -> unit MLtonThread.t) -> unit
val handleWith: t * (unit -> unit) -> unit
val ignore: t -> unit
val setHandler: t * Handler.t -> unit
1.16 +4 -4 mlton/basis-library/mlton/signal.sml
Index: signal.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/signal.sml,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- signal.sml 24 Nov 2002 01:19:39 -0000 1.15
+++ signal.sml 29 Dec 2002 01:22:58 -0000 1.16
@@ -5,7 +5,7 @@
* MLton is released under the GNU General Public License (GPL).
* Please see the file MLton-LICENSE for license information.
*)
-structure Signal: MLTON_SIGNAL =
+structure MLtonSignal: MLTON_SIGNAL =
struct
open Posix.Signal
@@ -62,7 +62,7 @@
struct
datatype t =
Default
- | Handler of unit Thread.t -> unit Thread.t
+ | Handler of unit MLtonThread.t -> unit MLtonThread.t
| Ignore
end
@@ -139,7 +139,7 @@
* the topLevelHandler, which is installed in thread.sml.
*)
val () =
- Thread.setHandler
+ MLtonThread.setHandler
(fn t =>
Array.foldli
(fn (s, h, t) =>
@@ -176,6 +176,6 @@
fun suspend m =
(Mask.create m
; Prim.suspend ()
- ; Thread.switchToHandler ())
+ ; MLtonThread.switchToHandler ())
end
1.3 +63 -38 mlton/basis-library/mlton/socket.sml
Index: socket.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/socket.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- socket.sml 8 Aug 2001 05:26:31 -0000 1.2
+++ socket.sml 29 Dec 2002 01:22:58 -0000 1.3
@@ -1,12 +1,9 @@
-structure Socket: MLTON_SOCKET =
+structure MLtonSocket: MLTON_SOCKET =
struct
-structure Prim = Primitive.Socket
-open Prim
-
structure Port =
struct
- type t = port
+ type t = int
end
structure Address =
@@ -16,66 +13,94 @@
structure Host =
struct
- structure Prim = Prim.Host
-
type t = {name: string}
- fun get (b: bool): t option =
- if b
- then SOME {name = C.CS.toString (Prim.name ())}
- else NONE
+ val get: NetHostDB.entry option -> t option =
+ Option.map (fn entry => {name = NetHostDB.name entry})
- val getByAddress = get o Prim.getByAddress
- val getByName = get o Prim.getByName o String.nullTerm
+ val getByAddress = get o NetHostDB.getByAddr o NetHostDB.wordToInAddr
+ val getByName = get o NetHostDB.getByName
end
-type t = socket
+type passive_socket = (INetSock.inet, Socket.passive Socket.stream) Socket.sock
+type active_socket = (INetSock.inet, Socket.active Socket.stream) Socket.sock
+type t = passive_socket
-val listen: unit -> port * socket =
+val listen: unit -> Port.t * passive_socket =
fn () =>
let
- val port = ref 0
- val socket = ref 0
- val _ = Posix.Error.checkResult (Prim.listen (port, socket))
- in (!port, !socket)
+ val sl : (INetSock.inet, Socket.passive Socket.stream) Socket.sock =
+ INetSock.TCP.socket ()
+ val _ = Socket.Ctl.setREUSEADDR (sl, true)
+ val addr : INetSock.inet Socket.sock_addr =
+ INetSock.any 0
+ val _ = Socket.bind (sl, addr)
+ val _ = Socket.listen (sl, 5)
+ val addr : INetSock.inet Socket.sock_addr =
+ Socket.Ctl.getSockName sl
+ val (in_addr : NetHostDB.in_addr,
+ port : int) =
+ INetSock.fromAddr addr
+ in
+ (port, sl)
end
-val listenAt: port -> socket =
+val listenAt: Port.t -> passive_socket =
fn port =>
let
- val socket = ref 0
- val _ = Posix.Error.checkResult (Prim.listen (ref port, socket))
- in !socket
+ val sl : (INetSock.inet, Socket.passive Socket.stream) Socket.sock =
+ INetSock.TCP.socket ()
+ val _ = Socket.Ctl.setREUSEADDR (sl, true)
+ val addr : INetSock.inet Socket.sock_addr =
+ INetSock.any port
+ val _ = Socket.bind (sl, addr)
+ val _ = Socket.listen (sl, 5)
+ in
+ sl
end
-fun fdToIO fd =
+fun sockToIO sock =
let
- val _ = Posix.Error.checkResult fd
- val fd = Posix.FileSys.wordToFD (SysWord.fromInt fd)
+ val fd = Socket.sockToFD sock
val ins = TextIO.newIn fd
val out = TextIO.newOut (Posix.IO.dup fd)
in (ins, out)
end
fun accept s =
- let val (ins, out) = fdToIO (Prim.accept s)
- in (Prim.Addr.address (),
- Prim.Addr.port (),
- ins,
- out)
+ let
+ val (sock : (INetSock.inet, Socket.active Socket.stream) Socket.sock,
+ addr : INetSock.inet Socket.sock_addr) =
+ Socket.accept s
+ val (in_addr : NetHostDB.in_addr,
+ port : int) =
+ INetSock.fromAddr addr
+ val (ins, out) = sockToIO sock
+ in
+ (NetHostDB.inAddrToWord in_addr, port, ins, out)
end
fun connect (host, port) =
- fdToIO (Prim.connect (String.nullTerm host, port))
+ let
+ val hp : NetHostDB.entry =
+ valOf (NetHostDB.getByName host)
+ val res : (INetSock.inet, Socket.active Socket.stream) Socket.sock =
+ INetSock.TCP.socket ()
+ val addr : INetSock.inet Socket.sock_addr =
+ INetSock.toAddr (NetHostDB.addr hp, port)
+ val _ = Socket.connect (res, addr)
+ val (ins, out) = sockToIO res
+ in
+ (ins, out)
+ end
-fun shutdown (PosixPrimitive.FD n, how: int): unit =
- PosixError.checkResult (Prim.shutdown (n, how))
+fun shutdown (fd: Posix.IO.file_desc,
+ mode: Socket.shutdown_mode): unit =
+ Socket.shutdown (Socket.fdToSock fd, mode)
fun shutdownRead ins =
- shutdown (TextIO.inFd ins, Prim.shutdownRead)
-
+ shutdown (TextIO.inFd ins, Socket.NO_RECVS)
fun shutdownWrite out =
(TextIO.flushOut out
- ; shutdown (TextIO.outFd out, Prim.shutdownWrite))
-
+ ; shutdown (TextIO.outFd out, Socket.NO_SENDS))
end
1.3 +1 -1 mlton/basis-library/mlton/syslog.sml
Index: syslog.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/syslog.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- syslog.sml 28 Feb 2002 18:29:49 -0000 1.2
+++ syslog.sml 29 Dec 2002 01:22:58 -0000 1.3
@@ -3,7 +3,7 @@
* This will only work in MLton.
*)
-structure Syslog :> MLTON_SYSLOG =
+structure MLtonSyslog :> MLTON_SYSLOG =
struct
type openflag = int
1.14 +3 -3 mlton/basis-library/mlton/thread.sml
Index: thread.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/thread.sml,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- thread.sml 22 Jul 2002 03:37:31 -0000 1.13
+++ thread.sml 29 Dec 2002 01:22:58 -0000 1.14
@@ -1,4 +1,4 @@
-structure Thread:> MLTON_THREAD_EXTRA =
+structure MLtonThread:> MLTON_THREAD_EXTRA =
struct
structure Prim = Primitive.Thread
@@ -50,7 +50,7 @@
(func := NONE
(* Close the atomicBegin of the thread that switched to me. *)
; atomicEnd ()
- ; (x () handle e => Exn.topLevelHandler e)
+ ; (x () handle e => MLtonExn.topLevelHandler e)
; die "Thread didn't exit properly.\n")))
val switching = ref false
in
@@ -139,7 +139,7 @@
loop ()
end
val p =
- toPrimitive (new (fn () => loop () handle e => Exn.topLevelHandler e))
+ toPrimitive (new (fn () => loop () handle e => MLtonExn.topLevelHandler e))
val _ = signalHandler := SOME p
in
Prim.setHandler p
1.3 +1 -1 mlton/basis-library/mlton/world.sig
Index: world.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/world.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- world.sig 26 Mar 2002 17:27:30 -0000 1.2
+++ world.sig 29 Dec 2002 01:22:58 -0000 1.3
@@ -6,5 +6,5 @@
(* Save the world to resume with the current thread. *)
val save: string -> status
(* Save the world to resume with the given thread. *)
- val saveThread: string * unit Thread.t -> unit
+ val saveThread: string * unit MLtonThread.t -> unit
end
1.8 +4 -4 mlton/basis-library/mlton/world.sml
Index: world.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/world.sml,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- world.sml 22 Jul 2002 01:56:52 -0000 1.7
+++ world.sml 29 Dec 2002 01:22:58 -0000 1.8
@@ -1,4 +1,4 @@
-structure World: MLTON_WORLD =
+structure MLtonWorld: MLTON_WORLD =
struct
structure Prim = Primitive.World
@@ -35,13 +35,13 @@
; Clone)
end
- fun saveThread (file: string, t: unit Thread.t): unit =
+ fun saveThread (file: string, t: unit MLtonThread.t): unit =
case save' file of
- Clone => Thread.switch (fn _ => (t, ()))
+ Clone => MLtonThread.switch (fn _ => (t, ()))
| Original => ()
fun save (file: string): status =
- if Thread.amInSignalHandler ()
+ if MLtonThread.amInSignalHandler ()
then raise Fail "cannot call MLton.World.save within signal handler"
else save' file
1.2 +10 -0 mlton/basis-library/net/net-host-db.sig
Index: net-host-db.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/net/net-host-db.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- net-host-db.sig 4 Dec 2002 00:29:01 -0000 1.1
+++ net-host-db.sig 29 Dec 2002 01:22:59 -0000 1.2
@@ -14,4 +14,14 @@
val scan: (char, 'a) StringCvt.reader -> (in_addr, 'a) StringCvt.reader
val fromString: string -> in_addr option
val toString: in_addr -> string
+ end
+
+signature NET_HOST_DB_EXTRA =
+ sig
+ include NET_HOST_DB
+ type pre_in_addr
+ val new_in_addr: unit -> (pre_in_addr * (unit -> in_addr))
+ val inAddrToWord: in_addr -> word
+ val wordToInAddr: word -> in_addr
+ val any: unit -> in_addr
end
1.2 +24 -7 mlton/basis-library/net/net-host-db.sml
Index: net-host-db.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/net/net-host-db.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- net-host-db.sml 4 Dec 2002 00:29:01 -0000 1.1
+++ net-host-db.sml 29 Dec 2002 01:22:59 -0000 1.2
@@ -1,9 +1,29 @@
-structure NetHostDB: NET_HOST_DB =
+structure NetHostDB: NET_HOST_DB_EXTRA =
struct
structure Prim = Primitive.NetHostDB
-
- type in_addr = Word8Vector.vector
- type addr_family = int (* AF_INET *)
+
+ (* network byte order (MSB) *)
+ type pre_in_addr = Prim.pre_in_addr
+ type in_addr = Prim.in_addr
+ structure PW = Pack32Big
+ fun new_in_addr () =
+ let
+ val ia = Word8Array.array (Prim.inAddrLen, 0wx0)
+ fun finish () = Word8Array.vector ia
+ in
+ (ia, finish)
+ end
+ fun inAddrToWord ia =
+ Word.fromLargeWord (PW.subVec (ia, 0))
+ fun wordToInAddr w =
+ let
+ val (ia, finish) = new_in_addr ()
+ val _ = PW.update (ia, 0, Word.toLargeWord w)
+ in
+ finish ()
+ end
+ fun any () = wordToInAddr (Word.fromInt Prim.INADDR_ANY)
+ type addr_family = Prim.addr_family
datatype entry = T of {name: string,
aliases: string list,
addrType: addr_family,
@@ -171,9 +191,6 @@
try l
end
-(*
- val scan = fn _ => raise (Fail "NetHostDB.scan unimplemented")
-*)
fun fromString s = StringCvt.scanString scan s
fun toString in_addr =
String.concatWith "."
1.2 +8 -4 mlton/basis-library/net/net-serv-db.sml
Index: net-serv-db.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/net/net-serv-db.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- net-serv-db.sml 5 Dec 2002 01:25:15 -0000 1.1
+++ net-serv-db.sml 29 Dec 2002 01:22:59 -0000 1.2
@@ -32,7 +32,7 @@
end
else List.rev aliases
val aliases = fill (0, [])
- val port = Prim.entryPort ()
+ val port = Net.ntohs (Prim.entryPort ())
val protocol = C.CS.toString (Prim.entryProtocol ())
in
SOME (T {name = name,
@@ -48,8 +48,12 @@
String.nullTerm proto))
| NONE => get (Prim.getByNameNull (String.nullTerm name))
fun getByPort (port, proto) =
- case proto of
- SOME proto => get (Prim.getByPort (port, String.nullTerm proto))
- | NONE => get (Prim.getByPortNull port)
+ let
+ val port = Net.htons port
+ in
+ case proto of
+ SOME proto => get (Prim.getByPort (port, String.nullTerm proto))
+ | NONE => get (Prim.getByPortNull port)
+ end
end
end
1.2 +64 -2 mlton/basis-library/net/socket.sig
Index: socket.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/net/socket.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- socket.sig 4 Dec 2002 00:29:01 -0000 1.1
+++ socket.sig 29 Dec 2002 01:22:59 -0000 1.2
@@ -1,6 +1,9 @@
+
signature SOCKET =
sig
- type ('af,'sock_type) sock
+ 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
@@ -65,7 +68,7 @@
val pollDesc: ('af, 'sock_type) sock -> OS.IO.poll_desc
type out_flags = {don't_route : bool, oob : bool}
type in_flags = {peek : bool, oob : bool}
- type 'a buf = {buf : 'af, i : int, sz : int option}
+ 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 ->
@@ -108,4 +111,63 @@
Word8Vector.vector * 'sock_type sock_addr
val recvArrFrom': ('af, dgram) sock * Word8Array.array buf * in_flags ->
int * 'af sock_addr
+ 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))
+
+ structure CtlExtra:
+ sig
+ type level = int
+ 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
+ end
end
1.1 mlton/basis-library/net/generic-sock.sml
Index: generic-sock.sml
===================================================================
structure GenericSock : GENERIC_SOCK =
struct
structure Prim = Primitive.Socket.GenericSock
structure PE = Posix.Error
fun intToSock i = Socket.wordToSock (SysWord.fromInt i)
fun socket' (af, st, p) =
intToSock (PE.checkReturnResult (Prim.socket (af, st, p)))
fun socketPair' (af, st, p) =
let
val s1 = ref 0
val s2 = ref 0
val _ = PE.checkResult (Prim.socketPair (af, st, p, s1, s2))
in
(intToSock (!s1), intToSock (!s2))
end
fun socket (af, st) = socket' (af, st, 0)
fun socketPair (af, st) = socketPair' (af, st, 0)
end
1.1 mlton/basis-library/net/inet-sock.sml
Index: inet-sock.sml
===================================================================
structure INetSock : INET_SOCK =
struct
structure Prim = Primitive.Socket.INetSock
datatype inet = INET
type 'sock_type sock = (inet, 'sock_type) Socket.sock
type 'mode stream_sock = 'mode Socket.stream sock
type dgram_sock = Socket.dgram sock
type sock_addr = inet Socket.sock_addr
val inetAF = Primitive.Socket.AF.INET
fun toAddr (in_addr, port) =
let
val (sa, salen, finish) = Socket.new_sock_addr ()
val _ = Prim.toAddr (in_addr, Net.htons port, sa, salen)
in
finish ()
end
fun any port = toAddr (NetHostDB.any (), port)
fun fromAddr sa =
let
val _ = Prim.fromAddr (Socket.unpackSockAddr sa)
val port = Net.ntohs (Prim.getPort ())
val (ia, finish) = NetHostDB.new_in_addr ()
val _ = Prim.getInAddr ia
in
(finish (), port)
end
structure UDP =
struct
structure Prim = Prim.UDP
fun socket' prot = GenericSock.socket' (inetAF, Socket.SOCK.dgram, prot)
fun socket () = socket' 0
end
structure TCP =
struct
structure Prim = Prim.TCP
fun socket' prot = GenericSock.socket' (inetAF, Socket.SOCK.stream, prot)
fun socket () = socket' 0
fun getNODELAY sock =
Socket.CtlExtra.getSockOptBool
(Prim.TCP, Prim.NODELAY) sock
fun setNODELAY (sock,optval) =
Socket.CtlExtra.setSockOptBool
(Prim.TCP, Prim.NODELAY) (sock,optval)
end
end
1.1 mlton/basis-library/net/net.sig
Index: net.sig
===================================================================
signature NET =
sig
val htonl: int -> int
val ntohl: int -> int
val htons: int -> int
val ntohs: int -> int
end
1.1 mlton/basis-library/net/net.sml
Index: net.sml
===================================================================
structure Net : NET =
struct
structure Prim = Primitive.Net
val htonl = Prim.htonl
val ntohl = Prim.ntohl
val htons = Prim.htons
val ntohs = Prim.ntohs
end
1.1 mlton/basis-library/net/socket.sml
Index: socket.sml
===================================================================
structure Socket : SOCKET_EXTRA =
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
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 = Pack32Little
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 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
in
fun getPeerName sock = getName Prim.Ctl.getPeerName sock
fun getSockName sock = getName Prim.Ctl.getSockName sock
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
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 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))
fun pollDesc sock =
Option.valOf (OS.IO.pollDesc (sockToFD sock))
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 = Primitive.Array.array 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
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
1.1 mlton/basis-library/net/unix-sock.sml
Index: unix-sock.sml
===================================================================
structure UnixSock : UNIX_SOCK =
struct
structure Prim = Primitive.Socket.UnixSock
datatype unix = UNIX
type 'sock_type sock = (unix, 'sock_type) Socket.sock
type 'mode stream_sock = 'mode Socket.stream sock
type dgram_sock = Socket.dgram sock
type sock_addr = unix Socket.sock_addr
val unixAF = Primitive.Socket.AF.UNIX
fun toAddr s =
let
val (sa, salen, finish) = Socket.new_sock_addr ()
val _ = Prim.toAddr (s, String.size s, sa, salen)
in
finish ()
end
fun fromAddr sa =
let
val sa = Socket.unpackSockAddr sa
val len = Prim.pathLen sa
val a = CharArray.array (len, #"\000")
val _ = Prim.fromAddr (sa, a, len)
in
CharArray.extract (a, 0, SOME len)
end
structure Strm =
struct
structure Prim = Prim.Strm
fun socket () = GenericSock.socket (unixAF, Socket.SOCK.stream)
fun socketPair () = GenericSock.socketPair (unixAF, Socket.SOCK.stream)
end
structure DGrm =
struct
structure Prim = Prim.DGrm
fun socket () = GenericSock.socket (unixAF, Socket.SOCK.dgram)
fun socketPair () = GenericSock.socketPair (unixAF, Socket.SOCK.dgram)
end
end
1.5 +13 -14 mlton/basis-library/posix/file-sys.sml
Index: file-sys.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/file-sys.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- file-sys.sml 24 Nov 2002 01:19:39 -0000 1.4
+++ file-sys.sml 29 Dec 2002 01:22:59 -0000 1.5
@@ -24,6 +24,7 @@
structure Flags = BitFlags
val checkResult = Error.checkResult
+ val checkReturnResult = Error.checkReturnResult
datatype file_desc = datatype Prim.file_desc
type uid = Prim.uid
@@ -151,26 +152,24 @@
| O_WRONLY => o_wronly
| O_RDWR => o_rdwr
- val error = PosixError.error
-
fun createf (pathname, openMode, flags, mode) =
let
val fd =
- Prim.openn (String.nullTerm pathname,
- Flags.flags [openModeToWord openMode, flags, O.creat],
- mode)
- in if fd = ~1
- then error ()
- else FD fd
+ checkReturnResult
+ (Prim.openn (String.nullTerm pathname,
+ Flags.flags [openModeToWord openMode, flags, O.creat],
+ mode))
+ in FD fd
end
fun openf (pathname, openMode, flags) =
- let val fd = Prim.openn (String.nullTerm pathname,
- Flags.flags [openModeToWord openMode, flags],
- Flags.empty)
- in if fd = ~1
- then error ()
- else FD fd
+ let
+ val fd =
+ checkReturnResult
+ (Prim.openn (String.nullTerm pathname,
+ Flags.flags [openModeToWord openMode, flags],
+ Flags.empty))
+ in FD fd
end
fun creat (s, m) = createf (s, O_WRONLY, O.trunc, m)
1.6 +5 -5 mlton/basis-library/sml-nj/sml-nj.sml
Index: sml-nj.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/sml-nj/sml-nj.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- sml-nj.sml 16 Sep 2002 18:22:56 -0000 1.5
+++ sml-nj.sml 29 Dec 2002 01:22:59 -0000 1.6
@@ -9,7 +9,7 @@
struct
structure Cont =
struct
- structure C = MLton.Cont
+ structure C = MLtonCont
type 'a cont = 'a C.t
val callcc = C.callcc
@@ -47,19 +47,19 @@
fun getAllArgs () = getCmdName () :: getArgs ()
- val exnHistory = MLton.Exn.history
+ val exnHistory = MLtonExn.history
- structure World = MLton.World
+ structure World = MLtonWorld
fun exportFn (file: string, f) =
- let open MLton.World OS.Process
+ let open MLtonWorld OS.Process
in case save (file ^ ".mlton") of
Original => exit success
| Clone => exit (f (getCmdName (), getArgs ()) handle _ => failure)
end
fun exportML (f: string): bool =
- let open MLton.World
+ let open MLtonWorld
in case save (f ^ ".mlton") of
Clone => true
| Original => false
1.8 +4 -4 mlton/basis-library/system/process.sml
Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/process.sml,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- process.sml 24 Nov 2002 01:19:40 -0000 1.7
+++ process.sml 29 Dec 2002 01:22:59 -0000 1.8
@@ -15,7 +15,7 @@
struct
open Posix.Process
- structure Signal = MLton.Signal
+ structure Signal = MLtonSignal
type status = PreOS.Process.status
val success: status = 0
@@ -33,8 +33,8 @@
fun system cmd =
let
val pid =
- MLton.Process.spawn {path = "/bin/sh",
- args = ["sh", "-c", cmd]}
+ MLtonProcess.spawn {path = "/bin/sh",
+ args = ["sh", "-c", cmd]}
val old =
List.map (fn s =>
let
@@ -50,7 +50,7 @@
fun atExit f = Cleaner.addNew (Cleaner.atExit, f)
- val exit = MLton.Process.exit
+ val exit = MLtonProcess.exit
fun terminate x = Posix.Process.exit (Word8.fromInt x)
1.3 +1 -1 mlton/basis-library/system/timer.sml
Index: timer.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/timer.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- timer.sml 24 Nov 2002 01:19:40 -0000 1.2
+++ timer.sml 29 Dec 2002 01:22:59 -0000 1.3
@@ -8,7 +8,7 @@
let
val {gc = {utime = gcu, stime = gcs},
self = {utime = selfu, stime = selfs}, ...} =
- MLton.Rusage.rusage ()
+ MLtonRusage.rusage ()
in
{gc = Time.+ (gcu, gcs),
sys = selfs,
1.3 +1 -1 mlton/basis-library/system/unix.sml
Index: unix.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/unix.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- unix.sml 24 Nov 2002 01:19:40 -0000 1.2
+++ unix.sml 29 Dec 2002 01:22:59 -0000 1.3
@@ -27,7 +27,7 @@
datatype exit_status = datatype Posix.Process.exit_status
val fromStatus = Posix.Process.fromStatus
- structure Mask = MLton.Signal.Mask
+ structure Mask = MLtonSignal.Mask
fun ('a, 'b) protect(f: 'a -> 'b) (x: 'a): 'b =
let val _ = Mask.block Mask.all
1.12 +8 -0 mlton/bin/check-basis
Index: check-basis
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/check-basis,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- check-basis 4 Dec 2002 00:29:01 -0000 1.11
+++ check-basis 29 Dec 2002 01:22:59 -0000 1.12
@@ -284,6 +284,14 @@
structure NetProtDB = struct end
signature NET_SERV_DB = sig end
structure NetServDB = struct end
+ signature SOCKET = sig end
+ structure Socket = struct end
+ signature GENERIC_SOCK = sig end
+ structure GenericSock = struct end
+ signature INET_SOCK = sig end
+ structure INetSock = struct end
+ signature UNIX_SOCK = sig end
+ structure UnixSock = struct end
nonfix * / mod div ^ + - := o > < >= <= = <> :: @ before
open Types
1.13 +4 -0 mlton/doc/user-guide/basis.tex
Index: basis.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/basis.tex,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- basis.tex 5 Dec 2002 01:25:15 -0000 1.12
+++ basis.tex 29 Dec 2002 01:22:59 -0000 1.13
@@ -66,8 +66,10 @@
\fullmodule{Date}{DATE}
\fullmodule{FixedInt}{INTEGER}
\fullmodule{General}{GENERAL}
+\fullmodule{GenericSock}{GENERIC\_SOCK}
\fullmodule{IEEEReal}{IEEE\_REAL}
\fullmodule{IO}{IO}
+\fullmodule{INetSock}{INET\_SOCK}
\fullmodule{Int}{INTEGER}
\fullmodule{IntArray}{MONO\_ARRAY}
\fullmodule{IntArraySlice}{MONO\_ARRAY\_SLICE}
@@ -120,6 +122,7 @@
\fullmodule{Real64Vector}{MONO\_VECTOR}
\fullmodule{Real64VectorSlice}{MONO\_VECTOR\_SLICE}
\fullmodule{Real64Array2}{MONO\_ARRAY2}
+\fullmodule{Socket}{SOCKET}
\fullmodule{String}{STRING}
\fullmodule{StringCvt}{STRING\_CVT}
\fullmodule{Substring}{SUBSTRING}
@@ -150,6 +153,7 @@
\fullmodule{Time}{TIME}
\fullmodule{Timer}{TIMER}
\fullmodule{Unix}{UNIX}
+\fullmodule{UnixSock}{UNIX\_SOCK}
\fullmodule{Vector}{VECTOR}
\fullmodule{VectorSlice}{VECTOR\_SLICE}
\fullmodule{Word}{WORD}
1.34 +12 -12 mlton/doc/user-guide/extensions.tex
Index: extensions.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/extensions.tex,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- extensions.tex 14 Dec 2002 03:12:53 -0000 1.33
+++ extensions.tex 29 Dec 2002 01:23:00 -0000 1.34
@@ -15,10 +15,10 @@
\subsection{The {\tt MLton} structure}
-The remainder of this section describes the modules {\mlton} makes available
-that are not part of the standard basis library. As a warning, please keep in
-mind that the {\tt MLton} structure and its substructures do change from release
-to release of {\mlton}.
+The remainder of this section describes the modules {\mlton} makes
+available that are not part of the Standard ML Basis Library. As a
+warning, please keep in mind that the {\tt MLton} structure and its
+substructures do change from release to release of {\mlton}.
\begin{verbatim}
structure MLton:
@@ -405,7 +405,8 @@
\begin{description}
\entry{profile}
-a compile-time constant that is true when compiling {\tt -profile time}.
+a compile-time constant that is true when compiling {\tt -profile
+time} or {\tt -profile alloc}.
\entry{type Data.t} the type of a unit of profiling data.
@@ -430,9 +431,9 @@
\entry{\tt write (x, f)}
writes the accumulated ticks in the unit of profiling data {\tt x} to
file {\tt f}. It is an error to write a previously freed unit of
-profiling data. Note: a program compiled with {\tt -profile true}
-will always write the current unit of profiling data at program exit
-to a file named {\tt mlmon.out}.
+profiling data. Note: a program compiled with {\tt -profile time} or
+{\tt -profile alloc} will always write the current unit of profiling
+data at program exit to a file named {\tt mlmon.out}.
\entry{current}
returns the current unit of profiling data.
@@ -657,10 +658,9 @@
\end{description}
\subsubsection{{\tt MLton.Socket}}
-This module contains a bare minimum of functionality to do TCP/IP programming.
-This module may disappear after the {\tt Socket} module of the standard basis
-library becomes available. Or, it may remain and be implemented on top of that
-module.
+This module contains a bare minimum of functionality to do TCP/IP
+programming. This module is implemetned on top of the {\tt Socket}
+module of the Standard Basis Library.
\begin{verbatim}
signature MLTON_SOCKET =
sig
1.104 +6 -4 mlton/mlton/main/main.sml
Index: main.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/main.sml,v
retrieving revision 1.103
retrieving revision 1.104
diff -u -r1.103 -r1.104
--- main.sml 19 Dec 2002 23:43:35 -0000 1.103
+++ main.sml 29 Dec 2002 01:23:00 -0000 1.104
@@ -471,13 +471,15 @@
:: !libs),
linkWithGmp]
datatype debugFormat =
- Dwarf | Dwarf2 | Stabs
- val debugFormat = Stabs
+ Dwarf | DwarfPlus | Dwarf2 | Stabs | StabsPlus
+ val debugFormat = StabsPlus
val (gccDebug, asDebug) =
case debugFormat of
Dwarf => (["-gdwarf", "-g2"], "-Wa,--gdwarf2")
- | Dwarf2 => (["-gdwarf-2"], "-Wa,--gdwarf2")
- | Stabs => (["-g"], "-Wa,--gstabs")
+ | DwarfPlus => (["-gdwarf+", "-g2"], "-Wa,--gdwarf2")
+ | Dwarf2 => (["-gdwarf-2", "-g2"], "-Wa,--gdwarf2")
+ | Stabs => (["-gstabs", "-g2"], "-Wa,--gstabs")
+ | StabsPlus => (["-gstabs+", "-g2"], "-Wa,--gstabs")
fun compileO (inputs: File.t list) =
let
val output = maybeOut ""
1.1 mlton/regression/echo.ok
Index: echo.ok
===================================================================
server processed 1900 bytes
1.1 mlton/regression/echo.sml
Index: echo.sml
===================================================================
(* -*- mode: sml -*-
* $Id: echo.sml,v 1.1 2002/12/29 01:23:00 fluet Exp $
* http://www.bagley.org/~doug/shootout/
* from Tom 7
*)
exception Error of string
val data = "Hello there sailor\n"
val num = 100
val (port, listener) =
MLton.Socket.listen ()
handle _ => raise Error ("Can't listen...\n")
fun server () =
let val (_, _, ins, outs) = MLton.Socket.accept listener
fun s b =
case TextIO.inputLine ins of
"" => let in
Posix.Process.wait ();
print (concat ["server processed ",
Int.toString b,
" bytes\n"])
end
| i => let in
TextIO.output(outs, i);
TextIO.flushOut outs;
s (b + 19)
end
in s 0
end
fun client () =
let
val (ins, outs) = MLton.Socket.connect ("127.0.0.1", port)
fun c 0 = let in
TextIO.closeOut outs;
TextIO.closeIn ins
end
| c n = let in
TextIO.output(outs, data);
TextIO.flushOut outs;
TextIO.inputLine ins = data
orelse raise Error "Didn't receive the same data";
c (n - 1)
end
in
c num
end
val _ = case Posix.Process.fork () of
SOME pid => server ()
| NONE => client ()
1.45 +39 -14 mlton/runtime/Makefile
Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Makefile,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- Makefile 20 Dec 2002 17:17:20 -0000 1.44
+++ Makefile 29 Dec 2002 01:23:00 -0000 1.45
@@ -6,10 +6,11 @@
AR = $(HOST)-ar rc
HOSTFLAGS = -b $(HOST)
endif
-CC = gcc -Wall -I. -mcpu=pentiumpro -malign-loops=2 -malign-jumps=2 -malign-functions=5 -fomit-frame-pointer $(HOSTFLAGS)
+CC = gcc -Wall -I. -mcpu=pentiumpro -falign-loops=2 -falign-jumps=2 -falign-functions=5 -fomit-frame-pointer $(HOSTFLAGS)
# Can't use more optimization than -O1 because gcc doesn't correctly compile
# Real_class in basis/Real.c
-CFLAGS = -O1
+CFLAGS = -O1
+DEBUGFLAGS = -gstabs+ -g2
OBJS = \
basis/Array/numElements.o \
@@ -40,9 +41,26 @@
basis/MLton/spawnp.o \
basis/MLton/size.o \
basis/MLton/world.o \
+ basis/Net/Net.o \
basis/Net/NetHostDB.o \
basis/Net/NetProtDB.o \
basis/Net/NetServDB.o \
+ basis/Net/Socket/Ctl.o \
+ basis/Net/Socket/Socket.o \
+ basis/Net/Socket/bind.o \
+ basis/Net/Socket/listen.o \
+ basis/Net/Socket/connect.o \
+ basis/Net/Socket/accept.o \
+ basis/Net/Socket/close.o \
+ basis/Net/Socket/shutdown.o \
+ basis/Net/Socket/send.o \
+ basis/Net/Socket/sendTo.o \
+ basis/Net/Socket/recv.o \
+ basis/Net/Socket/recvFrom.o \
+ basis/Net/Socket/socket.o \
+ basis/Net/Socket/socketPair.o \
+ basis/Net/Socket/INetSock.o \
+ basis/Net/Socket/UnixSock.o \
basis/OS/FileSys/tmpnam.o \
basis/OS/IO/poll.o \
basis/PackReal/subVec.o \
@@ -51,11 +69,6 @@
basis/Ptrace/ptrace4.o \
basis/Real.o \
basis/Real_const.o \
- basis/Socket/Host.o \
- basis/Socket/accept.o \
- basis/Socket/connect.o \
- basis/Socket/listen.o \
- basis/Socket/shutdown.o \
basis/Stdio.o \
basis/Thread.o \
basis/Time.o \
@@ -190,9 +203,26 @@
basis/MLton/spawnp-gdb.o \
basis/MLton/size-gdb.o \
basis/MLton/world-gdb.o \
+ basis/Net/Net-gdb.o \
basis/Net/NetHostDB-gdb.o \
basis/Net/NetProtDB-gdb.o \
basis/Net/NetServDB-gdb.o \
+ basis/Net/Socket/Ctl-gdb.o \
+ basis/Net/Socket/Socket-gdb.o \
+ basis/Net/Socket/bind-gdb.o \
+ basis/Net/Socket/listen-gdb.o \
+ basis/Net/Socket/connect-gdb.o \
+ basis/Net/Socket/accept-gdb.o \
+ basis/Net/Socket/close-gdb.o \
+ basis/Net/Socket/shutdown-gdb.o \
+ basis/Net/Socket/send-gdb.o \
+ basis/Net/Socket/sendTo-gdb.o \
+ basis/Net/Socket/recv-gdb.o \
+ basis/Net/Socket/recvFrom-gdb.o \
+ basis/Net/Socket/socket-gdb.o \
+ basis/Net/Socket/socketPair-gdb.o \
+ basis/Net/Socket/INetSock-gdb.o \
+ basis/Net/Socket/UnixSock-gdb.o \
basis/OS/FileSys/tmpnam-gdb.o \
basis/OS/IO/poll-gdb.o \
basis/PackReal/subVec-gdb.o \
@@ -201,11 +231,6 @@
basis/Ptrace/ptrace4-gdb.o \
basis/Real-gdb.o \
basis/Real_const-gdb.o \
- basis/Socket/Host-gdb.o \
- basis/Socket/accept-gdb.o \
- basis/Socket/connect-gdb.o \
- basis/Socket/listen-gdb.o \
- basis/Socket/shutdown-gdb.o \
basis/Stdio-gdb.o \
basis/Thread-gdb.o \
basis/Time-gdb.o \
@@ -312,13 +337,13 @@
my-lib-gdb.o
%-gdb.o: %.c
- $(CC) -g -DASSERT=1 -c -o $@ $<
+ $(CC) $(DEBUGFLAGS) -DASSERT=1 -c -o $@ $<
%.o: %.c
$(CC) $(CFLAGS) -c -o $@ $<
%-gdb.o: %.S
- $(CC) -g -c -o $@ $<
+ $(CC) $(DEBUGFLAGS) -c -o $@ $<
%.o: %.S
$(CC) $(CFLAGS) -c -o $@ $<
1.10 +0 -8 mlton/runtime/basis-constants.h
Index: basis-constants.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis-constants.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- basis-constants.h 30 Sep 2002 21:55:25 -0000 1.9
+++ basis-constants.h 29 Dec 2002 01:23:00 -0000 1.10
@@ -89,12 +89,4 @@
#define Ptrace_SETFPREGS PTRACE_SETFPREGS
#define Ptrace_SYSCALL PTRACE_SYSCALL
-/* ------------------------------------------------- */
-/* Socket */
-/* ------------------------------------------------- */
-
-#define Socket_shutdownRead SHUT_RD
-#define Socket_shutdownWrite SHUT_WR
-#define Socket_shutdownReadWrite SHUT_RDWR
-
#endif /* #ifndef _BASIS_CONSTANTS_H_ */
1.5 +1 -0 mlton/runtime/libmlton.h
Index: libmlton.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/libmlton.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- libmlton.h 27 Jul 2002 20:52:05 -0000 1.4
+++ libmlton.h 29 Dec 2002 01:23:00 -0000 1.5
@@ -17,6 +17,7 @@
#include "mlton-basis.h"
#include "mlton-posix.h"
#include "my-lib.h"
+#include "net-constants.h"
#include "posix-constants.h"
/* initialize the machine */
1.18 +0 -14 mlton/runtime/mlton-basis.h
Index: mlton-basis.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/mlton-basis.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- mlton-basis.h 2 Nov 2002 03:37:41 -0000 1.17
+++ mlton-basis.h 29 Dec 2002 01:23:00 -0000 1.18
@@ -235,20 +235,6 @@
Int MLton_Rlimit_set(Resource r, Rlimit hard, Rlimit soft);
/* ------------------------------------------------- */
-/* Socket */
-/* ------------------------------------------------- */
-
-Word Socket_Addr_address();
-Int Socket_Addr_port();
-Cstring Socket_Host_name();
-Int Socket_Host_getByAddress(Word addr);
-Int Socket_Host_getByName(Cstring name);
-Int Socket_accept(Int sl);
-Int Socket_connect(Pointer host, Int port);
-Int Socket_listen(Pointer port, Pointer resultSocket);
-Int Socket_Shutdown(Int fd, Int how);
-
-/* ------------------------------------------------- */
/* Stdio */
/* ------------------------------------------------- */
1.1 mlton/runtime/net-constants.h
Index: net-constants.h
===================================================================
#ifndef _NET_CONSTANTS_H_
#define _NET_CONSTANTS_H_
#include <stdlib.h>
#include <errno.h>
#include <sys/ioctl.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <sys/un.h>
#include <netinet/in.h>
#include <netinet/tcp.h>
#include <netinet/udp.h>
#if (defined (__linux__))
#define NetHostDB_inAddrLen sizeof(struct in_addr)
#define NetHostDB_INADDR_ANY INADDR_ANY
#define max(x,y) (((x) > (y)) ? (x) : (y))
#define Socket_sockAddrLenMax max(sizeof(struct sockaddr), \
max(sizeof(struct sockaddr_un), \
max(sizeof(struct sockaddr_in), \
sizeof(struct sockaddr_in6))))
#define Socket_AF_UNIX PF_UNIX
#define Socket_AF_INET PF_INET
#define Socket_AF_INET6 PF_INET6
#define Socket_AF_UNSPEC PF_UNSPEC
#define Socket_SOCK_STREAM SOCK_STREAM
#define Socket_SOCK_DGRAM SOCK_DGRAM
#define Socket_Ctl_SOL_SOCKET SOL_SOCKET
#define Socket_Ctl_SO_DEBUG SO_DEBUG
#define Socket_Ctl_SO_REUSEADDR SO_REUSEADDR
#define Socket_Ctl_SO_KEEPALIVE SO_KEEPALIVE
#define Socket_Ctl_SO_DONTROUTE SO_DONTROUTE
#define Socket_Ctl_SO_LINGER SO_LINGER
#define Socket_Ctl_SO_BROADCAST SO_BROADCAST
#define Socket_Ctl_SO_OOBINLINE SO_OOBINLINE
#define Socket_Ctl_SO_SNDBUF SO_SNDBUF
#define Socket_Ctl_SO_RCVBUF SO_RCVBUF
#define Socket_Ctl_SO_TYPE SO_TYPE
#define Socket_Ctl_SO_ERROR SO_ERROR
#define Socket_Ctl_FIONBIO FIONBIO
#define Socket_Ctl_FIONREAD FIONREAD
#define Socket_Ctl_SIOCATMARK SIOCATMARK
#define Socket_SHUT_RD SHUT_RD
#define Socket_SHUT_WR SHUT_WR
#define Socket_SHUT_RDWR SHUT_RDWR
#define Socket_MSG_DONTROUTE MSG_DONTROUTE
#define Socket_MSG_OOB MSG_OOB
#define Socket_MSG_PEEK MSG_PEEK
#define Socket_INetSock_TCP_SOL_TCP SOL_TCP
#define Socket_INetSock_TCP_SO_NODELAY TCP_NODELAY
#endif
#endif /* #ifndef _NET_CONSTANTS_H_ */
1.2 +1 -0 mlton/runtime/Posix/IO/write.c
Index: write.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Posix/IO/write.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- write.c 18 Jul 2001 05:51:06 -0000 1.1
+++ write.c 29 Dec 2002 01:23:00 -0000 1.2
@@ -1,3 +1,4 @@
+
#include <unistd.h>
#include "mlton-posix.h"
1.2 +0 -1 mlton/runtime/basis/Net/NetHostDB.c
Index: NetHostDB.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/Net/NetHostDB.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- NetHostDB.c 4 Dec 2002 00:29:02 -0000 1.1
+++ NetHostDB.c 29 Dec 2002 01:23:00 -0000 1.2
@@ -41,7 +41,6 @@
return;
}
-
Int NetHostDB_getByAddress(Pointer addr, Int len) {
hostent = gethostbyaddr(addr, len, AF_INET);
return (hostent != NULL and hostent->h_name != NULL);
1.1 mlton/runtime/basis/Net/Net.c
Index: Net.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Net_htonl(Int i) {
return htonl(i);
}
Int Net_ntohl(Int i) {
return ntohl(i);
}
Int Net_htons(Int i) {
return htons(i);
}
Int Net_ntohs(Int i) {
return ntohs(i);
}
1.1 mlton/runtime/basis/Net/Socket/Ctl.c
Index: Ctl.c
===================================================================
#include <sys/ioctl.h>
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_Ctl_getSockOpt(Int s, Int level, Int optname, Char *optval, Int *optlen) {
return getsockopt(s, level, optname, (void*)optval, (socklen_t*)optlen);
}
Int Socket_Ctl_setSockOpt(Int s, Int level, Int optname, Char *optval, Int optlen) {
return setsockopt(s, level, optname, (void*)optval, (socklen_t)optlen);
}
Int Socket_Ctl_getsetIOCtl(Int s, Int request, Char* argp) {
return ioctl(s, request, argp);
}
Int Socket_Ctl_getPeerName(Int s, Char *name, Int *namelen) {
return getpeername(s, (struct sockaddr*)name, (socklen_t*)namelen);
}
Int Socket_Ctl_getSockName(Int s, Char *name, Int *namelen) {
return getsockname(s, (struct sockaddr*)name, (socklen_t*)namelen);
}
1.1 mlton/runtime/basis/Net/Socket/INetSock.c
Index: INetSock.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include "mlton-basis.h"
#include "my-lib.h"
void INetSock_toAddr (Pointer in_addr, Int port, Char* addr, Int *addrlen) {
struct sockaddr_in *sa = (struct sockaddr_in*)addr;
sa->sin_family = AF_INET;
sa->sin_port = port;
sa->sin_addr = *(struct in_addr*)in_addr;
*addrlen = sizeof(struct sockaddr_in);
}
static int port;
static struct in_addr in_addr;
void INetSock_fromAddr (Char* addr) {
struct sockaddr_in *sa = (struct sockaddr_in*)addr;
assert(sa->sin_family == AF_INET);
port = sa->sin_port;
in_addr = sa->sin_addr;
}
Int INetSock_getPort () {
return port;
}
void INetSock_getInAddr (Pointer addr) {
*(struct in_addr*)addr = in_addr;
}
1.1 mlton/runtime/basis/Net/Socket/Socket.c
Index: Socket.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_familyOfAddr(Char *addr) {
return ((struct sockaddr*)addr)->sa_family;
}
1.1 mlton/runtime/basis/Net/Socket/UnixSock.c
Index: UnixSock.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include <sys/un.h>
#include "mlton-basis.h"
#include "my-lib.h"
#define UNIX_PATH_MAX 108
void UnixSock_toAddr (Char* path, Int pathlen, Char* addr, Int *addrlen) {
int i;
struct sockaddr_un *sa = (struct sockaddr_un*)addr;
sa->sun_family = AF_UNIX;
i = 0;
if (pathlen <= UNIX_PATH_MAX) {
for (i = 0; i < pathlen; i++) {
sa->sun_path[i] = path[i];
}
} else {
for (i = 0; i < UNIX_PATH_MAX-1; i++) {
sa->sun_path[i] = path[i];
}
sa->sun_path[UNIX_PATH_MAX-1] = '\000';
}
*addrlen = sizeof(struct sockaddr_un);
}
Int UnixSock_pathLen (Char* addr) {
int i;
struct sockaddr_un *sa = (struct sockaddr_un*)addr;
i = 0;
if (sa->sun_path[i] == '\000') {
return UNIX_PATH_MAX;
} else {
while (i < UNIX_PATH_MAX && sa->sun_path[i] != '\000') i++;
return i;
}
}
void UnixSock_fromAddr (Char* addr, Char* path, Int pathlen) {
int i;
struct sockaddr_un *sa = (struct sockaddr_un*)addr;
assert(sa->sun_family == AF_UNIX);
for (i = 0; i < pathlen; i++) {
path[i] = sa->sun_path[i];
}
}
1.1 mlton/runtime/basis/Net/Socket/accept.c
Index: accept.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_accept(Int s, Char *addr, Int *addrlen) {
return accept(s, (struct sockaddr*)addr, (socklen_t*)addrlen);
}
1.1 mlton/runtime/basis/Net/Socket/bind.c
Index: bind.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_bind(Int s, Char *addr, Int addrlen) {
return bind(s, (struct sockaddr*)addr, (socklen_t)addrlen);
}
1.1 mlton/runtime/basis/Net/Socket/close.c
Index: close.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_close(Int s) {
return close(s);
}
1.1 mlton/runtime/basis/Net/Socket/connect.c
Index: connect.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_connect(Int s, Char *addr, Int addrlen) {
return connect(s, (struct sockaddr*)addr, (socklen_t)addrlen);
}
1.1 mlton/runtime/basis/Net/Socket/listen.c
Index: listen.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_listen(Int s, Int backlog) {
return listen(s, backlog);
}
1.1 mlton/runtime/basis/Net/Socket/recv.c
Index: recv.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_recv(Int s, Char *msg, Int start, Int len, Word flags) {
return recv(s, (void*)((char *)msg + start), (size_t)len, flags);
}
1.1 mlton/runtime/basis/Net/Socket/recvFrom.c
Index: recvFrom.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_recvFrom(Int s, Char *msg, Int start, Int len, Word flags,
Char* addr, Int *addrlen) {
return recvfrom(s, (void*)((char *)msg + start), (size_t)len, flags,
(struct sockaddr*)addr, (socklen_t*)addrlen);
}
1.1 mlton/runtime/basis/Net/Socket/send.c
Index: send.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_send(Int s, Char *msg, Int start, Int len, Word flags) {
return send(s, (void*)((char *)msg + start), (size_t)len, flags);
}
1.1 mlton/runtime/basis/Net/Socket/sendTo.c
Index: sendTo.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_sendTo(Int s, Char *msg, Int start, Int len, Word flags,
Char* addr, Int addrlen) {
return sendto(s, (void*)((char *)msg + start), (size_t)len, flags,
(struct sockaddr*)addr, (socklen_t)addrlen);
}
1.1 mlton/runtime/basis/Net/Socket/shutdown.c
Index: shutdown.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_shutdown(Int s, Int how) {
return shutdown(s, how);
}
1.1 mlton/runtime/basis/Net/Socket/socket.c
Index: socket.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int GenericSock_socket(Int domain, Int type, Int protocol) {
return socket(domain, type, protocol);
}
1.1 mlton/runtime/basis/Net/Socket/socketPair.c
Index: socketPair.c
===================================================================
#include <sys/types.h>
#include <sys/socket.h>
#include "mlton-basis.h"
#include "my-lib.h"
Int Socket_socketPair(Int domain, Int type, Int protocol, Int sv[2]) {
return socketpair(domain, type, protocol, sv);
}
-------------------------------------------------------
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