Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cml/src/Sockets/cml-socket.sml
ViewVC logotype

Annotation of /sml/trunk/src/cml/src/Sockets/cml-socket.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* cml-socket.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Research.
4 :     *)
5 :    
6 :     structure CML_Socket : CML_SOCKET =
7 :     struct
8 :     structure PS = PreSock
9 :    
10 :     type 'a event = 'a CML.event
11 :    
12 :     (* sockets are polymorphic; the instantiation of the type variables
13 :     * provides a way to distinguish between different kinds of sockets.
14 :     *)
15 :     type ('af, 'sock) sock = ('af, 'sock) PS.sock
16 :     type 'af sock_addr = 'af Socket.sock_addr
17 :    
18 :     (* witness types for the socket parameter *)
19 :     type dgram = Socket.dgram
20 :     type 'a stream = 'a Socket.stream
21 :     type passive = Socket.passive
22 :     type active = Socket.active
23 :    
24 :     (* address families *)
25 :     structure AF = Socket.AF
26 :    
27 :     (* socket types *)
28 :     structure SOCK = Socket.SOCK
29 :    
30 :     (* socket control operations *)
31 :     structure Ctl =
32 :     struct
33 :     fun wrapSet f (PS.CMLSock{sock, ...}, v) = f(sock, v)
34 :     fun wrapGet f (PS.CMLSock{sock, ...}) = f sock
35 :    
36 :     (* get/set socket options *)
37 :     fun getDEBUG arg = wrapGet Socket.Ctl.getDEBUG arg
38 :     fun setDEBUG arg = wrapSet Socket.Ctl.setDEBUG arg
39 :     fun getREUSEADDR arg = wrapGet Socket.Ctl.getREUSEADDR arg
40 :     fun setREUSEADDR arg = wrapSet Socket.Ctl.setREUSEADDR arg
41 :     fun getKEEPALIVE arg = wrapGet Socket.Ctl.getKEEPALIVE arg
42 :     fun setKEEPALIVE arg = wrapSet Socket.Ctl.setKEEPALIVE arg
43 :     fun getDONTROUTE arg = wrapGet Socket.Ctl.getDONTROUTE arg
44 :     fun setDONTROUTE arg = wrapSet Socket.Ctl.setDONTROUTE arg
45 :     fun getLINGER arg = wrapGet Socket.Ctl.getLINGER arg
46 :     fun setLINGER arg = wrapSet Socket.Ctl.setLINGER arg
47 :     fun getBROADCAST arg = wrapGet Socket.Ctl.getBROADCAST arg
48 :     fun setBROADCAST arg = wrapSet Socket.Ctl.setBROADCAST arg
49 :     fun getOOBINLINE arg = wrapGet Socket.Ctl.getOOBINLINE arg
50 :     fun setOOBINLINE arg = wrapSet Socket.Ctl.setOOBINLINE arg
51 :     fun getSNDBUF arg = wrapGet Socket.Ctl.getSNDBUF arg
52 :     fun setSNDBUF arg = wrapSet Socket.Ctl.setSNDBUF arg
53 :     fun getRCVBUF arg = wrapGet Socket.Ctl.getRCVBUF arg
54 :     fun setRCVBUF arg = wrapSet Socket.Ctl.setRCVBUF arg
55 :     fun getTYPE arg = wrapGet Socket.Ctl.getTYPE arg
56 :     fun getERROR arg = wrapGet Socket.Ctl.getERROR arg
57 :     fun getPeerName arg = wrapGet Socket.Ctl.getPeerName arg
58 :     fun getSockName arg = wrapGet Socket.Ctl.getSockName arg
59 :     fun setNBIO _ = () (* all CML sockets are non-blocking *)
60 :     fun getNREAD arg = wrapGet Socket.Ctl.getNREAD arg
61 :     fun getATMARK arg = wrapGet Socket.Ctl.getATMARK arg
62 :     end (* Ctl *)
63 :    
64 :     (* socket address operations *)
65 :     val sameAddr = Socket.sameAddr
66 :     val familyOfAddr = Socket.familyOfAddr
67 :    
68 :     (* socket management *)
69 :     local
70 :     fun accept' sock = let val (sock', addr) = Socket.accept sock
71 :     in
72 :     (PreSock.mkSock sock', addr)
73 :     end
74 :     in
75 :     fun acceptEvt (s as PS.CMLSock{sock, ...}) = CML.guard (fn () =>
76 :     case PS.wouldBlock accept' sock
77 :     of (SOME res) => CML.alwaysEvt res
78 :     | NONE => CML.wrap((PreSock.inEvt s), fn _ => accept' sock)
79 :     (* end case *))
80 :    
81 :     fun accept (s as PS.CMLSock{sock, ...}) = (
82 :     case PS.wouldBlock accept' sock
83 :     of (SOME res) => res
84 :     | NONE => (CML.sync(PreSock.inEvt s); accept' sock)
85 :     (* end case *))
86 :     end (* local *)
87 :    
88 :     fun bind (PS.CMLSock{sock, ...}, addr) = Socket.bind(sock, addr)
89 :    
90 :     fun connectEvt (s as PS.CMLSock{sock, ...}, addr) = CML.guard (fn () =>
91 :     case PS.wouldBlock Socket.connect (sock, addr)
92 :     of (SOME res) => CML.alwaysEvt res
93 :     | NONE => PreSock.outEvt s
94 :     (* end case *))
95 :    
96 :     fun connect (s as PS.CMLSock{sock, ...}, addr) = (
97 :     case PS.wouldBlock Socket.connect (sock, addr)
98 :     of (SOME res) => res
99 :     | NONE => CML.sync(PreSock.outEvt s)
100 :     (* end case *))
101 :    
102 :     fun listen (PS.CMLSock{sock, ...}, n) = Socket.listen(sock, n)
103 :    
104 :     fun close (PS.CMLSock{sock, state}) = (
105 :     case (SyncVar.mTake state)
106 :     of PS.Closed => SyncVar.mPut(state, PS.Closed)
107 :     | _ => Socket.close sock
108 :     (* end case *);
109 :     SyncVar.mPut(state, PS.Closed))
110 :    
111 :     (*
112 :     datatype shutdown_mode = datatype Socket.shutdown_mode
113 :     *)
114 :     structure S' : sig
115 :     datatype shutdown_mode = NO_RECVS | NO_SENDS | NO_RECVS_OR_SENDS
116 :     end = Socket
117 :     open S'
118 :     fun shutdown (PS.CMLSock{sock, ...}, how) = Socket.shutdown(sock, how)
119 :    
120 :     fun pollDesc (PS.CMLSock{sock, ...}) = Socket.pollDesc sock
121 :    
122 :     (* Sock I/O option types *)
123 :     type out_flags = {don't_route : bool, oob : bool}
124 :     type in_flags = {peek : bool, oob : bool}
125 :    
126 :     type 'a buf = {buf : 'a, i : int, sz : int option}
127 :    
128 :     (* Sock output operations *)
129 :     fun sendVec (s as PS.CMLSock{sock, ...}, buf) = (
130 :     case PS.wouldBlock Socket.sendVec (sock, buf)
131 :     of (SOME res) => res
132 :     | NONE => (CML.sync(PS.outEvt s); Socket.sendVec (sock, buf))
133 :     (* end case *))
134 :     fun sendArr (s as PS.CMLSock{sock, ...}, buf) = (
135 :     case PS.wouldBlock Socket.sendArr (sock, buf)
136 :     of (SOME res) => res
137 :     | NONE => (CML.sync(PS.outEvt s); Socket.sendArr (sock, buf))
138 :     (* end case *))
139 :     fun sendVec' (s as PS.CMLSock{sock, ...}, buf, flgs) = (
140 :     case PS.wouldBlock Socket.sendVec' (sock, buf, flgs)
141 :     of (SOME res) => res
142 :     | NONE => (CML.sync(PS.outEvt s); Socket.sendVec' (sock, buf, flgs))
143 :     (* end case *))
144 :     fun sendArr' (s as PS.CMLSock{sock, ...}, buf, flgs) = (
145 :     case PS.wouldBlock Socket.sendArr' (sock, buf, flgs)
146 :     of (SOME res) => res
147 :     | NONE => (CML.sync(PS.outEvt s); Socket.sendArr' (sock, buf, flgs))
148 :     (* end case *))
149 :     fun sendVecTo (s as PS.CMLSock{sock, ...}, addr, buf) = (
150 :     case PS.wouldBlock Socket.sendVecTo (sock, addr, buf)
151 :     of (SOME res) => res
152 :     | NONE => (CML.sync(PS.outEvt s); Socket.sendVecTo (sock, addr, buf))
153 :     (* end case *))
154 :     fun sendArrTo (s as PS.CMLSock{sock, ...}, addr, buf) = (
155 :     case PS.wouldBlock Socket.sendArrTo (sock, addr, buf)
156 :     of (SOME res) => res
157 :     | NONE => (CML.sync(PS.outEvt s); Socket.sendArrTo (sock, addr, buf))
158 :     (* end case *))
159 :     fun sendVecTo' (s as PS.CMLSock{sock, ...}, addr, buf, flgs) = (
160 :     case PS.wouldBlock Socket.sendVecTo' (sock, addr, buf, flgs)
161 :     of (SOME res) => res
162 :     | NONE => (
163 :     CML.sync(PS.outEvt s); Socket.sendVecTo' (sock, addr, buf, flgs))
164 :     (* end case *))
165 :     fun sendArrTo' (s as PS.CMLSock{sock, ...}, addr, buf, flgs) = (
166 :     case PS.wouldBlock Socket.sendArrTo' (sock, addr, buf, flgs)
167 :     of (SOME res) => res
168 :     | NONE => (
169 :     CML.sync(PS.outEvt s); Socket.sendArrTo' (sock, addr, buf, flgs))
170 :     (* end case *))
171 :    
172 :     (* Sock input operations *)
173 :     fun recvVec (s as PS.CMLSock{sock, ...}, n) = (
174 :     case PS.wouldBlock Socket.recvVec (sock, n)
175 :     of (SOME res) => res
176 :     | NONE => (CML.sync(PS.inEvt s); Socket.recvVec (sock, n))
177 :     (* end case *))
178 :     fun recvArr (s as PS.CMLSock{sock, ...}, buf) = (
179 :     case PS.wouldBlock Socket.recvArr (sock, buf)
180 :     of (SOME res) => res
181 :     | NONE => (CML.sync(PS.inEvt s); Socket.recvArr (sock, buf))
182 :     (* end case *))
183 :     fun recvVec' (s as PS.CMLSock{sock, ...}, n, flgs) = (
184 :     case PS.wouldBlock Socket.recvVec' (sock, n, flgs)
185 :     of (SOME res) => res
186 :     | NONE => (CML.sync(PS.inEvt s); Socket.recvVec' (sock, n, flgs))
187 :     (* end case *))
188 :     fun recvArr' (s as PS.CMLSock{sock, ...}, buf, flgs) = (
189 :     case PS.wouldBlock Socket.recvArr' (sock, buf, flgs)
190 :     of (SOME res) => res
191 :     | NONE => (CML.sync(PS.inEvt s); Socket.recvArr' (sock, buf, flgs))
192 :     (* end case *))
193 :     fun recvVecFrom (s as PS.CMLSock{sock, ...}, n) = (
194 :     case PS.wouldBlock Socket.recvVecFrom (sock, n)
195 :     of (SOME res) => res
196 :     | NONE => (CML.sync(PS.inEvt s); Socket.recvVecFrom (sock, n))
197 :     (* end case *))
198 :     fun recvArrFrom (s as PS.CMLSock{sock, ...}, buf) = (
199 :     case PS.wouldBlock Socket.recvArrFrom (sock, buf)
200 :     of (SOME res) => res
201 :     | NONE => (CML.sync(PS.inEvt s); Socket.recvArrFrom (sock, buf))
202 :     (* end case *))
203 :     fun recvVecFrom' (s as PS.CMLSock{sock, ...}, n, flgs) = (
204 :     case PS.wouldBlock Socket.recvVecFrom' (sock, n, flgs)
205 :     of (SOME res) => res
206 :     | NONE => (CML.sync(PS.inEvt s); Socket.recvVecFrom' (sock, n, flgs))
207 :     (* end case *))
208 :     fun recvArrFrom' (s as PS.CMLSock{sock, ...}, buf, flgs) = (
209 :     case PS.wouldBlock Socket.recvArrFrom' (sock, buf, flgs)
210 :     of (SOME res) => res
211 :     | NONE => (CML.sync(PS.inEvt s); Socket.recvArrFrom' (sock, buf, flgs))
212 :     (* end case *))
213 :    
214 :     (* Sock input event constructors *)
215 :     fun recvVecEvt (s as PS.CMLSock{sock, ...}, n) = CML.guard (fn () =>
216 :     case PS.wouldBlock Socket.recvVec (sock, n)
217 :     of (SOME res) => CML.alwaysEvt res
218 :     | NONE => CML.wrap(PS.inEvt s, fn _ => Socket.recvVec (sock, n))
219 :     (* end case *))
220 :     fun recvArrEvt (s as PS.CMLSock{sock, ...}, buf) = CML.guard (fn () =>
221 :     case PS.wouldBlock Socket.recvArr (sock, buf)
222 :     of (SOME res) => CML.alwaysEvt res
223 :     | NONE => CML.wrap(PS.inEvt s, fn _ => Socket.recvArr (sock, buf))
224 :     (* end case *))
225 :     fun recvVecEvt' (s as PS.CMLSock{sock, ...}, n, flgs) = CML.guard (fn () =>
226 :     case PS.wouldBlock Socket.recvVec' (sock, n, flgs)
227 :     of (SOME res) => CML.alwaysEvt res
228 :     | NONE => CML.wrap(PS.inEvt s, fn _ => Socket.recvVec' (sock, n, flgs))
229 :     (* end case *))
230 :     fun recvArrEvt' (s as PS.CMLSock{sock, ...}, buf, flgs) = CML.guard (fn () =>
231 :     case PS.wouldBlock Socket.recvArr' (sock, buf, flgs)
232 :     of (SOME res) => CML.alwaysEvt res
233 :     | NONE => CML.wrap(PS.inEvt s, fn _ => Socket.recvArr' (sock, buf, flgs))
234 :     (* end case *))
235 :     fun recvVecFromEvt (s as PS.CMLSock{sock, ...}, n) = CML.guard (fn () =>
236 :     case PS.wouldBlock Socket.recvVecFrom (sock, n)
237 :     of (SOME res) => CML.alwaysEvt res
238 :     | NONE => CML.wrap(PS.inEvt s, fn _ => Socket.recvVecFrom (sock, n))
239 :     (* end case *))
240 :     fun recvArrFromEvt (s as PS.CMLSock{sock, ...}, buf) = CML.guard (fn () =>
241 :     case PS.wouldBlock Socket.recvArrFrom (sock, buf)
242 :     of (SOME res) => CML.alwaysEvt res
243 :     | NONE => CML.wrap(PS.inEvt s, fn _ => Socket.recvArrFrom (sock, buf))
244 :     (* end case *))
245 :     fun recvVecFromEvt' (s as PS.CMLSock{sock, ...}, n, flgs) = CML.guard (fn () =>
246 :     case PS.wouldBlock Socket.recvVecFrom' (sock, n, flgs)
247 :     of (SOME res) => CML.alwaysEvt res
248 :     | NONE =>
249 :     CML.wrap(PS.inEvt s, fn _ => Socket.recvVecFrom' (sock, n, flgs))
250 :     (* end case *))
251 :     fun recvArrFromEvt' (s as PS.CMLSock{sock, ...}, buf, flgs) = CML.guard (fn () =>
252 :     case PS.wouldBlock Socket.recvArrFrom' (sock, buf, flgs)
253 :     of (SOME res) => CML.alwaysEvt res
254 :     | NONE =>
255 :     CML.wrap(PS.inEvt s, fn _ => Socket.recvArrFrom' (sock, buf, flgs))
256 :     (* end case *))
257 :    
258 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0