1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
6 /* */
7 /* Copyright 1996 Institut National de Recherche en Informatique et */
8 /* en Automatique. */
9 /* */
10 /* All rights reserved. This file is distributed under the terms of */
11 /* the GNU Lesser General Public License version 2.1, with the */
12 /* special exception on linking described in the file LICENSE. */
13 /* */
14 /**************************************************************************/
15
16 #include <caml/mlvalues.h>
17 #include <caml/alloc.h>
18 #include <caml/fail.h>
19 #include "unixsupport.h"
20
21 #ifdef HAS_TERMIOS
22
23 #include <termios.h>
24 #include <errno.h>
25
26 static struct termios terminal_status;
27
28 enum { Bool, Enum, Speed, Char, End };
29
30 enum { Input, Output };
31
32 #define iflags ((long)(&terminal_status.c_iflag))
33 #define oflags ((long)(&terminal_status.c_oflag))
34 #define cflags ((long)(&terminal_status.c_cflag))
35 #define lflags ((long)(&terminal_status.c_lflag))
36
37 /* Number of fields in the terminal_io record field. Cf. unix.mli */
38
39 #define NFIELDS 38
40
41 /* Structure of the terminal_io record. Cf. unix.mli */
42
43 static long terminal_io_descr[] = {
44 /* Input modes */
45 Bool, iflags, IGNBRK,
46 Bool, iflags, BRKINT,
47 Bool, iflags, IGNPAR,
48 Bool, iflags, PARMRK,
49 Bool, iflags, INPCK,
50 Bool, iflags, ISTRIP,
51 Bool, iflags, INLCR,
52 Bool, iflags, IGNCR,
53 Bool, iflags, ICRNL,
54 Bool, iflags, IXON,
55 Bool, iflags, IXOFF,
56 /* Output modes */
57 Bool, oflags, OPOST,
58 /* Control modes */
59 Speed, Output,
60 Speed, Input,
61 Enum, cflags, 5, 4, CSIZE, CS5, CS6, CS7, CS8,
62 Enum, cflags, 1, 2, CSTOPB, 0, CSTOPB,
63 Bool, cflags, CREAD,
64 Bool, cflags, PARENB,
65 Bool, cflags, PARODD,
66 Bool, cflags, HUPCL,
67 Bool, cflags, CLOCAL,
68 /* Local modes */
69 Bool, lflags, ISIG,
70 Bool, lflags, ICANON,
71 Bool, lflags, NOFLSH,
72 Bool, lflags, ECHO,
73 Bool, lflags, ECHOE,
74 Bool, lflags, ECHOK,
75 Bool, lflags, ECHONL,
76 /* Control characters */
77 Char, VINTR,
78 Char, VQUIT,
79 Char, VERASE,
80 Char, VKILL,
81 Char, VEOF,
82 Char, VEOL,
83 Char, VMIN,
84 Char, VTIME,
85 Char, VSTART,
86 Char, VSTOP,
87 End
88 };
89
90 #undef iflags
91 #undef oflags
92 #undef cflags
93 #undef lflags
94
95 static struct {
96 speed_t speed;
97 int baud;
98 } speedtable[] = {
99
100 /* standard speeds */
101 {B0, 0},
102 {B50, 50},
103 {B75, 75},
104 {B110, 110},
105 {B134, 134},
106 {B150, 150},
107 #ifdef B200
108 /* Shouldn't need to be ifdef'd but I'm not sure it's available everywhere. */
109 {B200, 200},
110 #endif
111 {B300, 300},
112 {B600, 600},
113 {B1200, 1200},
114 {B1800, 1800},
115 {B2400, 2400},
116 {B4800, 4800},
117 {B9600, 9600},
118 {B19200, 19200},
119 {B38400, 38400},
120
121 /* usual extensions */
122 #ifdef B57600
123 {B57600, 57600},
124 #endif
125 #ifdef B115200
126 {B115200, 115200},
127 #endif
128 #ifdef B230400
129 {B230400, 230400},
130 #endif
131
132 /* Linux extensions */
133 #ifdef B460800
134 {B460800, 460800},
135 #endif
136 #ifdef B500000
137 {B500000, 500000},
138 #endif
139 #ifdef B576000
140 {B576000, 576000},
141 #endif
142 #ifdef B921600
143 {B921600, 921600},
144 #endif
145 #ifdef B1000000
146 {B1000000, 1000000},
147 #endif
148 #ifdef B1152000
149 {B1152000, 1152000},
150 #endif
151 #ifdef B1500000
152 {B1500000, 1500000},
153 #endif
154 #ifdef B2000000
155 {B2000000, 2000000},
156 #endif
157 #ifdef B2500000
158 {B2500000, 2500000},
159 #endif
160 #ifdef B3000000
161 {B3000000, 3000000},
162 #endif
163 #ifdef B3500000
164 {B3500000, 3500000},
165 #endif
166 #ifdef B4000000
167 {B4000000, 4000000},
168 #endif
169
170 /* MacOS extensions */
171 #ifdef B7200
172 {B7200, 7200},
173 #endif
174 #ifdef B14400
175 {B14400, 14400},
176 #endif
177 #ifdef B28800
178 {B28800, 28800},
179 #endif
180 #ifdef B76800
181 {B76800, 76800},
182 #endif
183
184 /* Cygwin extensions (in addition to the Linux ones) */
185 #ifdef B128000
186 {B128000, 128000},
187 #endif
188 #ifdef B256000
189 {B256000, 256000},
190 #endif
191 };
192
193 #define NSPEEDS (sizeof(speedtable) / sizeof(speedtable[0]))
194
encode_terminal_status(value * dst)195 static void encode_terminal_status(value *dst)
196 {
197 long * pc;
198 int i;
199
200 for(pc = terminal_io_descr; *pc != End; dst++) {
201 switch(*pc++) {
202 case Bool:
203 { int * src = (int *) (*pc++);
204 int msk = *pc++;
205 *dst = Val_bool(*src & msk);
206 break; }
207 case Enum:
208 { int * src = (int *) (*pc++);
209 int ofs = *pc++;
210 int num = *pc++;
211 int msk = *pc++;
212 for (i = 0; i < num; i++) {
213 if ((*src & msk) == pc[i]) {
214 *dst = Val_int(i + ofs);
215 break;
216 }
217 }
218 pc += num;
219 break; }
220 case Speed:
221 { int which = *pc++;
222 speed_t speed = 0;
223 *dst = Val_int(9600); /* in case no speed in speedtable matches */
224 switch (which) {
225 case Output:
226 speed = cfgetospeed(&terminal_status); break;
227 case Input:
228 speed = cfgetispeed(&terminal_status); break;
229 }
230 for (i = 0; i < NSPEEDS; i++) {
231 if (speed == speedtable[i].speed) {
232 *dst = Val_int(speedtable[i].baud);
233 break;
234 }
235 }
236 break; }
237 case Char:
238 { int which = *pc++;
239 *dst = Val_int(terminal_status.c_cc[which]);
240 break; }
241 }
242 }
243 }
244
decode_terminal_status(value * src)245 static void decode_terminal_status(value *src)
246 {
247 long * pc;
248 int i;
249
250 for (pc = terminal_io_descr; *pc != End; src++) {
251 switch(*pc++) {
252 case Bool:
253 { int * dst = (int *) (*pc++);
254 int msk = *pc++;
255 if (Bool_val(*src))
256 *dst |= msk;
257 else
258 *dst &= ~msk;
259 break; }
260 case Enum:
261 { int * dst = (int *) (*pc++);
262 int ofs = *pc++;
263 int num = *pc++;
264 int msk = *pc++;
265 i = Int_val(*src) - ofs;
266 if (i >= 0 && i < num) {
267 *dst = (*dst & ~msk) | pc[i];
268 } else {
269 unix_error(EINVAL, "tcsetattr", Nothing);
270 }
271 pc += num;
272 break; }
273 case Speed:
274 { int which = *pc++;
275 int baud = Int_val(*src);
276 int res = 0;
277 for (i = 0; i < NSPEEDS; i++) {
278 if (baud == speedtable[i].baud) {
279 switch (which) {
280 case Output:
281 res = cfsetospeed(&terminal_status, speedtable[i].speed); break;
282 case Input:
283 res = cfsetispeed(&terminal_status, speedtable[i].speed); break;
284 }
285 if (res == -1) uerror("tcsetattr", Nothing);
286 goto ok;
287 }
288 }
289 unix_error(EINVAL, "tcsetattr", Nothing);
290 ok:
291 break; }
292 case Char:
293 { int which = *pc++;
294 terminal_status.c_cc[which] = Int_val(*src);
295 break; }
296 }
297 }
298 }
299
unix_tcgetattr(value fd)300 CAMLprim value unix_tcgetattr(value fd)
301 {
302 value res;
303
304 if (tcgetattr(Int_val(fd), &terminal_status) == -1)
305 uerror("tcgetattr", Nothing);
306 res = caml_alloc_tuple(NFIELDS);
307 encode_terminal_status(&Field(res, 0));
308 return res;
309 }
310
311 static int when_flag_table[] = {
312 TCSANOW, TCSADRAIN, TCSAFLUSH
313 };
314
unix_tcsetattr(value fd,value when,value arg)315 CAMLprim value unix_tcsetattr(value fd, value when, value arg)
316 {
317 if (tcgetattr(Int_val(fd), &terminal_status) == -1)
318 uerror("tcsetattr", Nothing);
319 decode_terminal_status(&Field(arg, 0));
320 if (tcsetattr(Int_val(fd),
321 when_flag_table[Int_val(when)],
322 &terminal_status) == -1)
323 uerror("tcsetattr", Nothing);
324 return Val_unit;
325 }
326
unix_tcsendbreak(value fd,value delay)327 CAMLprim value unix_tcsendbreak(value fd, value delay)
328 {
329 if (tcsendbreak(Int_val(fd), Int_val(delay)) == -1)
330 uerror("tcsendbreak", Nothing);
331 return Val_unit;
332 }
333
334 #if defined(__ANDROID__)
unix_tcdrain(value fd)335 CAMLprim value unix_tcdrain(value fd)
336 { caml_invalid_argument("tcdrain not implemented"); }
337 #else
unix_tcdrain(value fd)338 CAMLprim value unix_tcdrain(value fd)
339 {
340 if (tcdrain(Int_val(fd)) == -1) uerror("tcdrain", Nothing);
341 return Val_unit;
342 }
343 #endif
344
345 static int queue_flag_table[] = {
346 TCIFLUSH, TCOFLUSH, TCIOFLUSH
347 };
348
unix_tcflush(value fd,value queue)349 CAMLprim value unix_tcflush(value fd, value queue)
350 {
351 if (tcflush(Int_val(fd), queue_flag_table[Int_val(queue)]) == -1)
352 uerror("tcflush", Nothing);
353 return Val_unit;
354 }
355
356 static int action_flag_table[] = {
357 TCOOFF, TCOON, TCIOFF, TCION
358 };
359
unix_tcflow(value fd,value action)360 CAMLprim value unix_tcflow(value fd, value action)
361 {
362 if (tcflow(Int_val(fd), action_flag_table[Int_val(action)]) == -1)
363 uerror("tcflow", Nothing);
364 return Val_unit;
365 }
366
367 #else
368
unix_tcgetattr(value fd)369 CAMLprim value unix_tcgetattr(value fd)
370 { caml_invalid_argument("tcgetattr not implemented"); }
371
unix_tcsetattr(value fd,value when,value arg)372 CAMLprim value unix_tcsetattr(value fd, value when, value arg)
373 { caml_invalid_argument("tcsetattr not implemented"); }
374
unix_tcsendbreak(value fd,value delay)375 CAMLprim value unix_tcsendbreak(value fd, value delay)
376 { caml_invalid_argument("tcsendbreak not implemented"); }
377
unix_tcdrain(value fd)378 CAMLprim value unix_tcdrain(value fd)
379 { caml_invalid_argument("tcdrain not implemented"); }
380
unix_tcflush(value fd,value queue)381 CAMLprim value unix_tcflush(value fd, value queue)
382 { caml_invalid_argument("tcflush not implemented"); }
383
unix_tcflow(value fd,value action)384 CAMLprim value unix_tcflow(value fd, value action)
385 { caml_invalid_argument("tcflow not implemented"); }
386
387 #endif
388