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/pre-sock.sml
ViewVC logotype

Annotation of /sml/trunk/src/cml/src/Sockets/pre-sock.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 2 (* pre-sock.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Research.
4 :     *
5 :     * Provide some utility operations for CML sockets.
6 :     *)
7 :    
8 :     structure PreSock : sig
9 :    
10 :     datatype socket_state
11 :     = Unconnected (* initial state *)
12 :     | Connecting (* when waiting for a connect to complete *)
13 :     | Connected (* when connected *)
14 :     | Accepting (* when waiting for an accept to complete *)
15 :     | WaitingOnIO (* when waiting on an input and/or output operation *)
16 :     | Closed
17 :    
18 :     datatype ('a, 'b) sock = CMLSock of {
19 :     state : socket_state SyncVar.mvar,
20 :     sock : ('a, 'b) Socket.sock
21 :     }
22 :    
23 :     val mkSock : ('a, 'b) Socket.sock -> ('a, 'b) sock
24 :    
25 :     val wouldBlock : ('a -> 'b) -> 'a -> 'b option
26 :     (* attempt the system call; return SOME x, if it succeeds with x, return
27 :     * NONE, if it fails because it would have blocked.
28 :     *)
29 :    
30 :     val inEvt : ('a, 'b) sock -> unit CML.event
31 :     val outEvt : ('a, 'b) sock -> unit CML.event
32 :    
33 :     end = struct
34 :    
35 :     datatype socket_state
36 :     = Unconnected (* initial state *)
37 :     | Connecting (* when waiting for a connect to complete *)
38 :     | Connected (* when connected *)
39 :     | Accepting (* when waiting for an accept to complete *)
40 :     | WaitingOnIO (* when waiting on an input and/or output operation *)
41 :     | Closed
42 :    
43 :     datatype ('a, 'b) sock = CMLSock of {
44 :     state : socket_state SyncVar.mvar,
45 :     sock : ('a, 'b) Socket.sock
46 :     }
47 :    
48 :     (* given an SML socket, return a CML socket (which is non-blocking) *)
49 :     fun mkSock s = (
50 :     Socket.Ctl.setNBIO(s, true);
51 :     CMLSock{
52 :     state = SyncVar.mVarInit Unconnected,
53 :     sock = s
54 :     })
55 :    
56 :     val blockErrors = (case Posix.Error.syserror "wouldblock"
57 :     of NONE => [Posix.Error.again, Posix.Error.inprogress]
58 :     | (SOME e) => [e, Posix.Error.again, Posix.Error.inprogress]
59 :     (* end case *))
60 :    
61 :     fun blockErr (OS.SysErr(_, SOME err)) = let
62 :     fun isErr [] = false
63 :     | isErr (e::r) = (e = err) orelse isErr r
64 :     in
65 :     isErr blockErrors
66 :     end
67 :    
68 :     fun wouldBlock f x = SOME(f x)
69 :     handle ex => if (blockErr ex) then NONE else raise ex
70 :    
71 :     fun inEvt (CMLSock{sock, ...}) =
72 :     CML.wrap(IOManager.ioEvt(OS.IO.pollIn(Socket.pollDesc sock)), ignore)
73 :     fun outEvt (CMLSock{sock, ...}) =
74 :     CML.wrap(IOManager.ioEvt(OS.IO.pollOut(Socket.pollDesc sock)), ignore)
75 :    
76 :     end;

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