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

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