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/branches/primop-branch/src/system/Basis/Implementation/Posix/posix-tty.sml
ViewVC logotype

Annotation of /sml/branches/primop-branch/src/system/Basis/Implementation/Posix/posix-tty.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1372 - (view) (download)

1 : monnier 416 (* posix-tty.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * Structure for POSIX 1003.1 operations on terminal devices
6 :     *
7 :     *)
8 :    
9 :     local
10 :     structure SysWord = SysWordImp
11 :     in
12 :     structure POSIX_TTY =
13 :     struct
14 :    
15 :     structure FS = POSIX_FileSys
16 :     structure P = POSIX_Process
17 :    
18 :     type pid = POSIX_Process.pid
19 :     type file_desc = POSIX_FileSys.file_desc
20 :    
21 :     type word = SysWord.word
22 :     type s_int = SysInt.int
23 :    
24 :     val ++ = SysWord.orb
25 :     val & = SysWord.andb
26 :     infix ++ &
27 :    
28 :     fun cfun x = CInterface.c_function "POSIX-TTY" x
29 :     val osval : string -> s_int = cfun "osval"
30 :     val w_osval = SysWord.fromInt o osval
31 :    
32 :     structure I =
33 :     struct
34 :     datatype flags = F of word
35 :    
36 :     fun fromWord w = F w
37 :     fun toWord (F w) = w
38 :    
39 :     fun flags ms = F(List.foldl (fn (F m,acc) => m ++ acc) 0w0 ms)
40 :     fun anySet (F m, F m') = (m & m') <> 0w0
41 :     fun allSet (F m, F m') = (m & m') = m
42 :    
43 :     val brkint = F (w_osval "BRKINT")
44 :     val icrnl = F (w_osval "ICRNL")
45 :     val ignbrk = F (w_osval "IGNBRK")
46 :     val igncr = F (w_osval "IGNCR")
47 :     val ignpar = F (w_osval "IGNPAR")
48 :     val inlcr = F (w_osval "INLCR")
49 :     val inpck = F (w_osval "INPCK")
50 :     val istrip = F (w_osval "ISTRIP")
51 :     val ixoff = F (w_osval "IXOFF")
52 :     val ixon = F (w_osval "IXON")
53 :     val parmrk = F (w_osval "PARMRK")
54 :     end
55 :    
56 :     structure O =
57 :     struct
58 :     datatype flags = F of word
59 :    
60 :     fun fromWord w = F w
61 :     fun toWord (F w) = w
62 :    
63 :     fun flags ms = F(List.foldl (fn (F m,acc) => m ++ acc) 0w0 ms)
64 :     fun anySet (F m, F m') = (m & m') <> 0w0
65 :     fun allSet (F m, F m') = (m & m') = m
66 :    
67 :     val opost = F (w_osval "OPOST")
68 :     end
69 :    
70 :     structure C =
71 :     struct
72 :     datatype flags = F of word
73 :    
74 :     fun fromWord w = F w
75 :     fun toWord (F w) = w
76 :    
77 :     fun flags ms = F(List.foldl (fn (F m,acc) => m ++ acc) 0w0 ms)
78 :     fun anySet (F m, F m') = (m & m') <> 0w0
79 :     fun allSet (F m, F m') = (m & m') = m
80 :    
81 :     val clocal = F (w_osval "CLOCAL")
82 :     val cread = F (w_osval "CREAD")
83 :     val csize = F (w_osval "CSIZE")
84 :     val cs5 = F (w_osval "CS5")
85 :     val cs6 = F (w_osval "CS6")
86 :     val cs7 = F (w_osval "CS7")
87 :     val cs8 = F (w_osval "CS8")
88 :     val cstopb = F (w_osval "CSTOPB")
89 :     val hupcl = F (w_osval "HUPCL")
90 :     val parenb = F (w_osval "PARENB")
91 :     val parodd = F (w_osval "PARODD")
92 :     end
93 :    
94 :     structure L =
95 :     struct
96 :     datatype flags = F of word
97 :    
98 :     fun fromWord w = F w
99 :     fun toWord (F w) = w
100 :    
101 :     fun flags ms = F(List.foldl (fn (F m,acc) => m ++ acc) 0w0 ms)
102 :     fun anySet (F m, F m') = (m & m') <> 0w0
103 :     fun allSet (F m, F m') = (m & m') = m
104 :    
105 :     val echo = F (w_osval "ECHO")
106 :     val echoe = F (w_osval "ECHOE")
107 :     val echok = F (w_osval "ECHOK")
108 :     val echonl = F (w_osval "ECHONL")
109 :     val icanon = F (w_osval "ICANON")
110 :     val iexten = F (w_osval "IEXTEN")
111 :     val isig = F (w_osval "ISIG")
112 :     val noflsh = F (w_osval "NOFLSH")
113 :     val tostop = F (w_osval "TOSTOP")
114 :     end
115 :    
116 :     structure V =
117 :     struct
118 :     structure WV = Word8Vector
119 :     structure WA = Word8Array
120 :     structure B = Byte
121 :    
122 :     val nccs = osval "NCCS"
123 :    
124 :     val eof = (osval "EOF")
125 :     val eol = (osval "EOL")
126 :     val erase = (osval "ERASE")
127 :     val intr = (osval "INTR")
128 :     val kill = (osval "KILL")
129 :     val min = (osval "MIN")
130 :     val quit = (osval "QUIT")
131 :     val susp = (osval "SUSP")
132 :     val time = (osval "TIME")
133 :     val start = (osval "START")
134 :     val stop = (osval "STOP")
135 :    
136 :     datatype cc = CC of WV.vector
137 :    
138 :     fun mkCC (arr, l) = let
139 :     fun update (i, c) = WA.update(arr, i, B.charToByte c)
140 :     in
141 :     List.app update l;
142 : mblume 1350 CC (WA.vector arr)
143 : monnier 416 end
144 :    
145 :     fun cc vals = mkCC (WA.array(nccs, 0w0), vals)
146 :     fun update (CC v, vals) =
147 :     mkCC (WA.tabulate (nccs, fn i => WV.sub(v,i)), vals)
148 :     fun sub (CC v, i) = B.byteToChar (WV.sub(v,i))
149 :     end
150 :    
151 :     datatype speed = B of word
152 :     fun compareSpeed (B w, B w') =
153 :     if SysWord.<(w, w') then LESS
154 :     else if w = w' then EQUAL
155 :     else GREATER
156 :     fun speedToWord (B w) = w
157 :     fun wordToSpeed w = B w
158 :     val b0 = B (w_osval "B0")
159 :     val b50 = B (w_osval "B50")
160 :     val b75 = B (w_osval "B75")
161 :     val b110 = B (w_osval "B110")
162 :     val b134 = B (w_osval "B134")
163 :     val b150 = B (w_osval "B150")
164 :     val b200 = B (w_osval "B200")
165 :     val b300 = B (w_osval "B300")
166 :     val b600 = B (w_osval "B600")
167 :     val b1200 = B (w_osval "B1200")
168 :     val b1800 = B (w_osval "B1800")
169 :     val b2400 = B (w_osval "B2400")
170 :     val b4800 = B (w_osval "B4800")
171 :     val b9600 = B (w_osval "B9600")
172 :     val b19200 = B (w_osval "B19200")
173 :     val b38400 = B (w_osval "B38400")
174 :    
175 :     datatype termios = TIOS of {
176 :     iflag : I.flags,
177 :     oflag : O.flags,
178 :     cflag : C.flags,
179 :     lflag : L.flags,
180 :     cc : V.cc,
181 :     ispeed : speed,
182 :     ospeed : speed
183 :     }
184 :    
185 :     fun termios arg = TIOS arg
186 :     fun fieldsOf (TIOS arg) = arg
187 :     fun getiflag (TIOS{iflag, ...}) = iflag
188 :     fun getoflag (TIOS{oflag, ...}) = oflag
189 :     fun getcflag (TIOS{cflag, ...}) = cflag
190 :     fun getlflag (TIOS{lflag, ...}) = lflag
191 :     fun getcc (TIOS{cc,...}) = cc
192 :    
193 :     fun getospeed (TIOS{ospeed,...}) = ospeed
194 :     fun getispeed (TIOS{ispeed,...}) = ispeed
195 :    
196 :     fun setospeed (TIOS r, ospeed) =
197 :     TIOS {
198 :     iflag = #iflag r,
199 :     oflag = #oflag r,
200 :     cflag = #cflag r,
201 :     lflag = #lflag r,
202 :     cc = #cc r,
203 :     ispeed = #ispeed r,
204 :     ospeed = ospeed
205 :     }
206 :     fun setispeed (TIOS r, ispeed) =
207 :     TIOS {
208 :     iflag = #iflag r,
209 :     oflag = #oflag r,
210 :     cflag = #cflag r,
211 :     lflag = #lflag r,
212 :     cc = #cc r,
213 :     ispeed = ispeed,
214 :     ospeed = #ospeed r
215 :     }
216 :    
217 :     structure TC =
218 :     struct
219 :     datatype set_action = SA of s_int
220 :    
221 :     val sanow = SA (osval "TCSANOW")
222 :     val sadrain = SA (osval "TCSADRAIN")
223 :     val saflush = SA (osval "TCSAFLUSH")
224 :    
225 :     datatype flow_action = FA of s_int
226 :    
227 :     val ooff = FA (osval "TCOOFF")
228 :     val oon = FA (osval "TCOON")
229 :     val ioff = FA (osval "TCIOFF")
230 :     val ion = FA (osval "TCION")
231 :    
232 :     datatype queue_sel = QS of s_int
233 :    
234 :     val iflush = QS (osval "TCIFLUSH")
235 :     val oflush = QS (osval "TCOFLUSH")
236 :     val ioflush = QS (osval "TCIOFLUSH")
237 :     end
238 :    
239 :     type termio_rep = (
240 :     word * (* iflags *)
241 :     word * (* oflags *)
242 :     word * (* cflags *)
243 :     word * (* lflags *)
244 :     V.WV.vector * (* cc *)
245 :     word * (* inspeed *)
246 :     word (* outspeed *)
247 :     )
248 :    
249 :     val tcgetattr : int -> termio_rep = cfun "tcgetattr"
250 :     fun getattr fd = let
251 :     val (ifs,ofs,cfs,lfs,cc,isp,osp) = tcgetattr (FS.intOf fd)
252 :     in
253 :     TIOS {
254 :     iflag = I.F ifs,
255 :     oflag = O.F ofs,
256 :     cflag = C.F cfs,
257 :     lflag = L.F lfs,
258 :     cc = V.CC cc,
259 :     ispeed = B isp,
260 :     ospeed = B osp
261 :     }
262 :     end
263 :    
264 :     val tcsetattr : int * s_int * termio_rep -> unit = cfun "tcsetattr"
265 :     fun setattr (fd, TC.SA sa, TIOS tios) = let
266 :     val (I.F iflag) = #iflag tios
267 :     val (O.F oflag) = #oflag tios
268 :     val (C.F cflag) = #cflag tios
269 :     val (L.F lflag) = #lflag tios
270 :     val (V.CC cc) = #cc tios
271 :     val (B ispeed) = #ispeed tios
272 :     val (B ospeed) = #ospeed tios
273 :     val trep = (iflag,oflag,cflag,lflag,cc,ispeed,ospeed)
274 :     in
275 :     tcsetattr (FS.intOf fd, sa, trep)
276 :     end
277 :    
278 :     val tcsendbreak : int * int -> unit = cfun "tcsendbreak"
279 :     fun sendbreak (fd, duration) = tcsendbreak (FS.intOf fd, duration)
280 :    
281 :     val tcdrain : int -> unit = cfun "tcdrain"
282 :     fun drain fd = tcdrain (FS.intOf fd)
283 :    
284 :     val tcflush : int * s_int -> unit = cfun "tcflush"
285 :     fun flush (fd, TC.QS qs) = tcflush (FS.intOf fd, qs)
286 :    
287 :     val tcflow : int * s_int -> unit = cfun "tcflow"
288 :     fun flow (fd, TC.FA action) = tcflow (FS.intOf fd, action)
289 :    
290 :     val tcgetpgrp : int -> s_int = cfun "tcgetpgrp"
291 :     fun getpgrp fd = P.PID(tcgetpgrp(FS.intOf fd))
292 :    
293 :     val tcsetpgrp : int * s_int -> unit = cfun "tcsetpgrp"
294 :     fun setpgrp (fd, P.PID pid) = tcsetpgrp(FS.intOf fd, pid)
295 :    
296 :     end (* structure POSIX_TTY *)
297 :     end
298 :    

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