1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
(* modified from SML/NJ sources by Stephen Weeks 1998-06-25 *)
(* modified by Matthew Fluet 2002-10-11 *)
(* modified by Matthew Fluet 2002-11-21 *)
(* modified by Matthew Fluet 2006-04-30 *)
(* modified by Matthew Fluet 2008-04-06 *)
(* modified by Matthew Fluet 2013-06-18 *)
(* modified by Matthew Fluet 2019-11-05 *)
(* os-io.sml
*
* COPYRIGHT (c) 1995 AT&T Bell Laboratories.
*
* NOTE: this interface has been proposed, but not yet adopted by the
* Standard basis committee.
*
*)
structure OS_IO: OS_IO =
struct
structure Error = PosixError
(* an iodesc is an abstract descriptor for an OS object that
* supports I/O (e.g., file, tty device, socket, ...).
*)
type iodesc = PreOS.IODesc.t
datatype iodesc_kind = K of string
val iodToFd = PrePosix.FileDesc.fromRep o PreOS.IODesc.toRep
val fdToIod = PreOS.IODesc.fromRep o PrePosix.FileDesc.toRep
val iodescToWord = C_Fd.castToSysWord o PreOS.IODesc.toRep
(* return a hash value for the I/O descriptor. *)
val hash = SysWord.toWord o iodescToWord
(* compare two I/O descriptors *)
fun compare (i, i') = SysWord.compare (iodescToWord i, iodescToWord i')
structure Kind =
struct
val file = K "FILE"
val dir = K "DIR"
val symlink = K "LINK"
val tty = K "TTY"
val pipe = K "PIPE"
val socket = K "SOCK"
val device = K "DEV"
end
(* return the kind of I/O descriptor *)
fun kind (iod) = let
val stat = Posix.FileSys.fstat (iodToFd iod)
in
if (Posix.FileSys.ST.isReg stat) then Kind.file
else if (Posix.FileSys.ST.isDir stat) then Kind.dir
else if (Posix.FileSys.ST.isChr stat) then Kind.tty
else if (Posix.FileSys.ST.isBlk stat) then Kind.device (* ?? *)
else if (Posix.FileSys.ST.isLink stat) then Kind.symlink
else if (Posix.FileSys.ST.isFIFO stat) then Kind.pipe
else if (Posix.FileSys.ST.isSock stat) then Kind.socket
else K "UNKNOWN"
end
type poll_flags = {rd: bool, wr: bool, pri: bool}
datatype poll_desc = PollDesc of iodesc * poll_flags
datatype poll_info = PollInfo of iodesc * poll_flags
(* create a polling operation on the given descriptor; note that
* not all I/O devices support polling, but for the time being, we
* don't test for this.
*)
fun pollDesc iod = SOME (PollDesc (iod, {rd=false, wr=false, pri=false}))
(* return the I/O descriptor that is being polled *)
fun pollToIODesc (PollDesc (iod, _)) = iod
exception Poll
(* set polling events; if the polling operation is not appropriate
* for the underlying I/O device, then the Poll exception is raised.
*)
fun pollIn (PollDesc (iod, {wr, pri, ...}: poll_flags)) =
PollDesc (iod, {rd=true, wr=wr, pri=pri})
fun pollOut (PollDesc (iod, {rd, pri, ...}: poll_flags)) =
PollDesc (iod, {rd=rd, wr=true, pri=pri})
fun pollPri (PollDesc (iod, {rd, wr, ...}: poll_flags)) =
PollDesc (iod, {rd=rd, wr=wr, pri=true})
(* polling function *)
local
structure Prim = PrimitiveFFI.OS.IO
fun join (false, _, w) = w
| join (true, b, w) = C_Short.orb(w, b)
fun test (w, b) = (C_Short.andb(w, b) <> 0)
val rdBit = PrimitiveFFI.OS.IO.POLLIN
and wrBit = PrimitiveFFI.OS.IO.POLLOUT
and priBit = PrimitiveFFI.OS.IO.POLLPRI
fun fromPollDesc (PollDesc (iod, {rd, wr, pri})) =
( iodToFd iod,
join (rd, rdBit,
join (wr, wrBit,
join (pri, priBit, 0)))
)
fun toPollInfo (fd, i) =
PollInfo (fdToIod fd, {
rd = test(i, rdBit),
wr = test(i, wrBit),
pri = test(i, priBit)
})
in
fun poll (pds, timeOut) = let
val (fds, events) = ListPair.unzip (List.map fromPollDesc pds)
val fds = Vector.fromList fds
val n = Vector.length fds
val events = Vector.fromList events
val timeOut =
case timeOut of
NONE => ~1
| SOME t =>
if Time.< (t, Time.zeroTime)
then Error.raiseSys Error.inval
else (C_Int.fromLarge (Time.toMilliseconds t)
handle Overflow => Error.raiseSys Error.inval)
val revents = Array.array (n, 0: C_Short.t)
val _ = Posix.Error.SysCall.simple
(fn () => Prim.poll (PrePosix.FileDesc.vectorToRep fds,
events,
C_NFds.fromInt n,
timeOut,
revents))
in
Array.foldri
(fn (i, w, l) =>
if w <> 0
then (toPollInfo (Vector.sub (fds, i), w))::l
else l)
[]
revents
end
end (* local *)
(* check for conditions *)
fun isIn (PollInfo(_, flgs)) = #rd flgs
fun isOut (PollInfo(_, flgs)) = #wr flgs
fun isPri (PollInfo(_, flgs)) = #pri flgs
fun infoToPollDesc (PollInfo arg) = PollDesc arg
end (* OS_IO *)
(*
* $Log: os-io.sml, v $
* Revision 1.4 1997/07/31 17:25:26 jhr
* We are now using 32-bit ints to represent the seconds portion of a
* time value. This was required to handle the change in the type of
* Time.{to, from}{Seconds, Milliseconds, Microseconds}.
*
* Revision 1.3 1997/06/07 15:27:51 jhr
* SML'97 Basis Library changes (phase 3; Posix changes)
*
* Revision 1.2 1997/06/02 19:16:19 jhr
* SML'97 Basis Library changes (phase 2)
*
* Revision 1.1.1.1 1997/01/14 01:38:25 george
* Version 109.24
*
*)
|
