Mercurial > hg > xemacs-beta
annotate src/event-unixoid.c @ 5593:4218b56833b3
Give the label name when warning or erroring, bytecomp.el
2011-11-02 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-lambda):
Accept a new NAME argument here, have byte-compile-current-form
reflect that if it's specified.
* bytecomp.el (byte-compile-initial-macro-environment):
Specify the label name when byte-compiling it, so warning and
errors are more helpful.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 02 Nov 2011 17:50:39 +0000 |
| parents | 308d34e9f07d |
| children | a216b3c2b09e |
| rev | line source |
|---|---|
| 428 | 1 /* Code shared between all event loops that use select() and have a |
| 2 different input descriptor for each device. | |
| 3 Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. | |
| 4 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
| 5 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 1268 | 6 Copyright (C) 1995, 1996, 2001, 2002, 2003 Ben Wing. |
| 428 | 7 |
| 8 This file is part of XEmacs. | |
| 9 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5016
diff
changeset
|
10 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 11 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5016
diff
changeset
|
12 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5016
diff
changeset
|
13 option) any later version. |
| 428 | 14 |
| 15 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 18 for more details. | |
| 19 | |
| 20 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5016
diff
changeset
|
21 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 22 |
| 23 /* Synched up with: Not in FSF. */ | |
| 24 | |
| 25 /* This file has been Mule-ized. */ | |
| 26 | |
| 27 #include <config.h> | |
| 28 #include "lisp.h" | |
| 29 | |
| 872 | 30 #include "console-stream-impl.h" |
| 31 #include "console-tty-impl.h" | |
| 1204 | 32 #include "device-impl.h" |
| 428 | 33 #include "events.h" |
| 34 #include "lstream.h" | |
| 35 #include "process.h" | |
| 36 | |
| 37 #include "sysdep.h" | |
| 38 #include "sysfile.h" | |
| 39 #include "sysproc.h" /* select stuff */ | |
| 40 #include "systime.h" | |
| 41 | |
| 42 /* Mask of bits indicating the descriptors that we wait for input on. | |
| 43 These work as follows: | |
| 44 | |
| 1268 | 45 In event-tty.c we call select() directly on this |
| 46 to retrieve an event. In event-Xt.c we use | |
| 47 XtAppAddInput() and the call to select() is down in | |
| 48 the guts of Xt, but we still use the masks when checking for pending input, even in event-Xt.c. (We can't use XtAppPending() because of the presence of the signal event pipe.) | |
| 49 | |
| 428 | 50 input_wait_mask == mask of all file descriptors we select() on, |
| 51 including TTY/stream console descriptors, | |
| 52 process descriptors, and the signal event pipe. | |
| 53 | |
| 54 non_fake_input_wait_mask == same as input_wait_mask but minus the | |
| 55 signal event pipe. Also only used in | |
| 56 event-tty.c. | |
| 57 | |
| 58 process_only_mask == only the process descriptors. | |
| 59 | |
| 60 tty_only_mask == only the TTY/stream console descriptors. | |
| 61 */ | |
| 62 SELECT_TYPE input_wait_mask, non_fake_input_wait_mask; | |
| 63 SELECT_TYPE process_only_mask, tty_only_mask; | |
| 64 | |
| 65 /* This is used to terminate the select(), when an event came in | |
| 66 through a signal (e.g. window-change or C-g on controlling TTY). */ | |
| 67 int signal_event_pipe[2]; | |
| 68 | |
| 69 int signal_event_pipe_initialized; | |
| 70 | |
| 71 int fake_event_occurred; | |
| 72 | |
| 1204 | 73 struct console * |
| 74 find_tty_or_stream_console_from_fd (int fd) | |
| 75 { | |
| 76 Lisp_Object concons; | |
| 77 | |
| 78 CONSOLE_LOOP (concons) | |
| 79 { | |
| 80 struct console *c; | |
| 81 | |
| 82 c = XCONSOLE (XCAR (concons)); | |
| 83 if ((CONSOLE_TTY_P (c) && CONSOLE_TTY_DATA (c)->infd == fd) || | |
| 84 (CONSOLE_STREAM_P (c) && fileno (CONSOLE_STREAM_DATA (c)->in) == fd)) | |
| 85 return c; | |
| 86 } | |
| 87 | |
| 88 return 0; | |
| 89 } | |
| 90 | |
| 428 | 91 int |
| 771 | 92 read_event_from_tty_or_stream_desc (Lisp_Event *event, struct console *con) |
| 428 | 93 { |
| 867 | 94 Ichar ch; |
| 793 | 95 Lisp_Object console = wrap_console (con); |
| 428 | 96 |
| 771 | 97 if (CONSOLE_TTY_P (con)) |
| 867 | 98 ch = Lstream_get_ichar (XLSTREAM (CONSOLE_TTY_DATA (con)->instream)); |
| 771 | 99 else |
| 100 { | |
|
5016
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4954
diff
changeset
|
101 Ibyte ibyte; |
| 771 | 102 /* #### Definitely something strange here. We should be setting |
| 103 the stdio handle unbuffered and reading from it instead of mixing | |
| 104 stdio and raw io calls. */ | |
|
4954
70e8a00896e9
fix an obscure crash reading from stream devices
Ben Wing <ben@xemacs.org>
parents:
4780
diff
changeset
|
105 int nread = retry_read (fileno (CONSOLE_STREAM_DATA (con)->in), |
|
5016
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4954
diff
changeset
|
106 &ibyte, 1); |
| 771 | 107 if (nread <= 0) |
| 108 ch = -1; | |
|
4954
70e8a00896e9
fix an obscure crash reading from stream devices
Ben Wing <ben@xemacs.org>
parents:
4780
diff
changeset
|
109 else |
|
5016
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4954
diff
changeset
|
110 ch = ibyte; |
| 771 | 111 } |
| 112 | |
| 113 if (ch < 0) | |
| 428 | 114 { |
| 115 /* deleting the console might not be safe right now ... */ | |
| 116 enqueue_magic_eval_event (io_error_delete_console, console); | |
| 117 /* but we definitely need to unselect it to avoid infinite | |
| 118 loops reading EOF's */ | |
| 119 Fconsole_disable_input (console); | |
| 120 } | |
| 121 else | |
| 122 { | |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4031
diff
changeset
|
123 character_to_event (ch, event, con, use_console_meta_flag, 1); |
| 428 | 124 event->channel = console; |
| 125 return 1; | |
| 126 } | |
| 127 return 0; | |
| 128 } | |
| 129 | |
| 130 void | |
| 131 signal_fake_event (void) | |
| 132 { | |
|
5016
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4954
diff
changeset
|
133 Rawbyte rbyte = 0; |
| 428 | 134 /* We do the write always. Formerly I tried to "optimize" this |
| 135 by setting a flag indicating whether we're blocking and only | |
| 136 doing the write in that case, but there is a race condition | |
| 137 if the signal occurs after we've checked for the signal | |
| 138 occurrence (which could occur in many places throughout | |
| 139 an iteration of the command loop, e.g. in status_notify()), | |
| 140 but before we set the blocking flag. | |
| 141 | |
| 771 | 142 This should be OK as long as write() is reentrant, which I'm fairly |
| 143 sure it is since it's a system call. */ | |
| 428 | 144 |
| 145 if (signal_event_pipe_initialized) | |
| 146 /* In case a signal comes through while we're dumping */ | |
| 147 { | |
| 148 int old_errno = errno; | |
|
5016
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4954
diff
changeset
|
149 retry_write (signal_event_pipe[1], &rbyte, 1); |
| 428 | 150 errno = old_errno; |
| 151 } | |
| 152 } | |
| 153 | |
| 154 void | |
| 155 drain_signal_event_pipe (void) | |
| 156 { | |
|
5016
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4954
diff
changeset
|
157 Rawbyte chars[128]; |
| 428 | 158 /* The input end of the pipe has been set to non-blocking. */ |
| 771 | 159 while (retry_read (signal_event_pipe[0], chars, sizeof (chars)) > 0) |
| 428 | 160 ; |
| 161 } | |
| 162 | |
| 1204 | 163 void |
| 164 drain_tty_devices (void) | |
| 165 { | |
| 166 Lisp_Object devcons, concons; | |
| 167 CONSOLE_LOOP (concons) | |
| 168 { | |
| 169 struct console *con = XCONSOLE (XCAR (concons)); | |
| 170 if (!con->input_enabled) | |
| 171 continue; | |
| 172 | |
| 173 CONSOLE_DEVICE_LOOP (devcons, con) | |
| 174 { | |
| 175 struct device *d = XDEVICE (XCAR (devcons)); | |
| 176 if (DEVICE_TTY_P (d)) | |
| 177 { | |
| 178 SELECT_TYPE temp_mask; | |
| 179 int infd = DEVICE_INFD (d); | |
| 180 | |
| 181 FD_ZERO (&temp_mask); | |
| 182 FD_SET (infd, &temp_mask); | |
| 183 | |
| 184 while (1) | |
| 185 { | |
| 186 Lisp_Object event; | |
| 187 | |
| 188 if (!poll_fds_for_input (temp_mask)) | |
| 189 break; | |
| 190 | |
| 191 event = Fmake_event (Qnil, Qnil); | |
| 192 if (!read_event_from_tty_or_stream_desc (XEVENT (event), | |
| 193 con)) | |
| 194 /* EOF, or something ... */ | |
| 195 break; | |
| 196 | |
| 197 /* queue the read event to be read for real later. */ | |
| 198 enqueue_dispatch_event (event); | |
| 199 } | |
| 200 } | |
| 201 } | |
| 202 } | |
| 203 } | |
| 204 | |
| 428 | 205 int |
| 206 event_stream_unixoid_select_console (struct console *con) | |
| 207 { | |
| 208 int infd; | |
| 209 | |
| 210 if (CONSOLE_STREAM_P (con)) | |
| 211 infd = fileno (CONSOLE_STREAM_DATA (con)->in); | |
| 212 else | |
| 213 { | |
| 214 assert (CONSOLE_TTY_P (con)); | |
| 215 infd = CONSOLE_TTY_DATA (con)->infd; | |
| 216 } | |
| 217 | |
| 218 assert (infd >= 0); | |
| 219 | |
| 220 FD_SET (infd, &input_wait_mask); | |
| 221 FD_SET (infd, &non_fake_input_wait_mask); | |
| 222 FD_SET (infd, &tty_only_mask); | |
| 223 return infd; | |
| 224 } | |
| 225 | |
| 226 int | |
| 227 event_stream_unixoid_unselect_console (struct console *con) | |
| 228 { | |
| 229 int infd; | |
| 230 | |
| 231 if (CONSOLE_STREAM_P (con)) | |
| 232 infd = fileno (CONSOLE_STREAM_DATA (con)->in); | |
| 233 else | |
| 234 { | |
| 235 assert (CONSOLE_TTY_P (con)); | |
| 236 infd = CONSOLE_TTY_DATA (con)->infd; | |
| 237 } | |
| 238 | |
| 239 assert (infd >= 0); | |
| 240 | |
| 241 FD_CLR (infd, &input_wait_mask); | |
| 242 FD_CLR (infd, &non_fake_input_wait_mask); | |
| 243 FD_CLR (infd, &tty_only_mask); | |
| 244 return infd; | |
| 245 } | |
| 246 | |
| 247 static int | |
| 440 | 248 get_process_infd (Lisp_Process *p) |
| 428 | 249 { |
| 853 | 250 Lisp_Object instr, outstr, errstr; |
| 251 get_process_streams (p, &instr, &outstr, &errstr); | |
| 428 | 252 assert (!NILP (instr)); |
| 253 return filedesc_stream_fd (XLSTREAM (instr)); | |
| 254 } | |
| 255 | |
| 853 | 256 static int |
| 257 get_process_errfd (Lisp_Process *p) | |
| 428 | 258 { |
| 853 | 259 Lisp_Object instr, outstr, errstr; |
| 260 get_process_streams (p, &instr, &outstr, &errstr); | |
| 261 if (!NILP (errstr)) | |
| 262 return filedesc_stream_fd (XLSTREAM (errstr)); | |
| 263 else | |
| 264 return -1; | |
| 428 | 265 } |
| 266 | |
| 853 | 267 void |
| 268 event_stream_unixoid_select_process (Lisp_Process *proc, int doin, int doerr, | |
| 269 int *infd, int *errfd) | |
| 428 | 270 { |
| 853 | 271 if (doin) |
| 272 { | |
| 273 *infd = get_process_infd (proc); | |
| 274 FD_SET (*infd, &input_wait_mask); | |
| 275 FD_SET (*infd, &non_fake_input_wait_mask); | |
| 276 FD_SET (*infd, &process_only_mask); | |
| 277 } | |
| 278 | |
| 279 if (doerr) | |
| 280 { | |
| 281 *errfd = get_process_errfd (proc); | |
| 428 | 282 |
| 853 | 283 if (*errfd >= 0) |
| 284 { | |
| 285 FD_SET (*errfd, &input_wait_mask); | |
| 286 FD_SET (*errfd, &non_fake_input_wait_mask); | |
| 287 FD_SET (*errfd, &process_only_mask); | |
| 288 } | |
| 289 } | |
| 290 } | |
| 291 | |
| 292 void | |
| 293 event_stream_unixoid_unselect_process (Lisp_Process *proc, int doin, int doerr, | |
| 294 int *infd, int *errfd) | |
| 295 { | |
| 296 if (doin) | |
| 297 { | |
| 298 *infd = get_process_infd (proc); | |
| 299 FD_CLR (*infd, &input_wait_mask); | |
| 300 FD_CLR (*infd, &non_fake_input_wait_mask); | |
| 301 FD_CLR (*infd, &process_only_mask); | |
| 302 } | |
| 303 | |
| 304 if (doerr) | |
| 305 { | |
| 306 *errfd = get_process_errfd (proc); | |
| 307 | |
| 308 if (*errfd >= 0) | |
| 309 { | |
| 310 FD_CLR (*errfd, &input_wait_mask); | |
| 311 FD_CLR (*errfd, &non_fake_input_wait_mask); | |
| 312 FD_CLR (*errfd, &process_only_mask); | |
| 313 } | |
| 314 } | |
| 428 | 315 } |
| 316 | |
| 317 int | |
| 318 poll_fds_for_input (SELECT_TYPE mask) | |
| 319 { | |
| 320 EMACS_TIME sometime; | |
| 321 EMACS_SELECT_TIME select_time; | |
| 322 SELECT_TYPE temp_mask; | |
| 323 int retval; | |
| 324 | |
| 325 while (1) | |
| 326 { | |
| 327 EMACS_SET_SECS_USECS (sometime, 0, 0); | |
| 328 EMACS_TIME_TO_SELECT_TIME (sometime, select_time); | |
| 329 temp_mask = mask; | |
| 330 /* To effect a poll, tell select() to block for zero seconds. */ | |
| 331 retval = select (MAXDESC, &temp_mask, 0, 0, &select_time); | |
| 332 if (retval >= 0) | |
| 333 return retval; | |
| 334 if (errno != EINTR) | |
| 335 { | |
| 336 /* Something went seriously wrong; don't abort since maybe | |
| 337 the TTY just died at the wrong time. */ | |
| 442 | 338 stderr_out ("xemacs: select failed: errno = %d\n", errno); |
| 428 | 339 return 0; |
| 340 } | |
| 341 /* else, we got interrupted by a signal, so try again. */ | |
| 342 } | |
| 343 | |
| 1204 | 344 RETURN_NOT_REACHED (0); |
| 428 | 345 } |
| 346 | |
| 347 /****************************************************************************/ | |
| 348 /* Unixoid (file descriptors based) process I/O streams routines */ | |
| 349 /****************************************************************************/ | |
| 350 | |
| 853 | 351 void |
| 352 event_stream_unixoid_create_io_streams (void* inhandle, void* outhandle, | |
| 353 void *errhandle, Lisp_Object* instream, | |
| 354 Lisp_Object* outstream, | |
| 355 Lisp_Object* errstream, | |
| 356 USID* in_usid, | |
| 357 USID* err_usid, | |
| 358 int flags) | |
| 428 | 359 { |
| 853 | 360 int infd, outfd, errfd; |
| 428 | 361 /* Decode inhandle and outhandle. Their meaning depends on |
| 362 the process implementation being used. */ | |
| 4031 | 363 /* We are passed plain old file descs, which are ints, so */ |
| 364 /* if sizeof(EMACS_INT) > sizeof(int) it's OK. */ | |
| 365 infd = (EMACS_INT) inhandle; | |
| 366 outfd = (EMACS_INT) outhandle; | |
| 367 errfd = (EMACS_INT) errhandle; | |
| 428 | 368 |
| 369 *instream = (infd >= 0 | |
| 370 ? make_filedesc_input_stream (infd, 0, -1, 0) | |
| 371 : Qnil); | |
| 372 | |
| 373 *outstream = (outfd >= 0 | |
| 374 ? make_filedesc_output_stream (outfd, 0, -1, LSTR_BLOCKED_OK) | |
| 375 : Qnil); | |
| 376 | |
| 853 | 377 *errstream = (errfd >= 0 |
| 378 ? make_filedesc_input_stream (errfd, 0, -1, 0) | |
| 379 : Qnil); | |
| 380 | |
| 428 | 381 /* FLAGS is process->pty_flag for UNIX_PROCESSES */ |
| 382 if ((flags & STREAM_PTY_FLUSHING) && outfd >= 0) | |
| 383 { | |
| 867 | 384 Ibyte eof_char = get_eof_char (outfd); |
| 428 | 385 int pty_max_bytes = get_pty_max_bytes (outfd); |
| 853 | 386 filedesc_stream_set_pty_flushing (XLSTREAM (*outstream), pty_max_bytes, |
| 387 eof_char); | |
| 428 | 388 } |
| 389 | |
| 853 | 390 *in_usid = FD_TO_USID (infd); |
| 391 *err_usid = FD_TO_USID (errfd); | |
| 428 | 392 } |
| 393 | |
| 853 | 394 void |
| 395 event_stream_unixoid_delete_io_streams (Lisp_Object instream, | |
| 396 Lisp_Object outstream, | |
| 397 Lisp_Object errstream, | |
| 398 USID *in_usid, | |
| 399 USID *err_usid) | |
| 428 | 400 { |
| 853 | 401 int in = (NILP (instream) ? -1 |
| 428 | 402 : filedesc_stream_fd (XLSTREAM (instream))); |
| 853 | 403 int out = (NILP (outstream) ? -1 |
| 428 | 404 : filedesc_stream_fd (XLSTREAM (outstream))); |
| 853 | 405 int err = (NILP (errstream) ? -1 |
| 406 : filedesc_stream_fd (XLSTREAM (errstream))); | |
| 428 | 407 |
| 408 if (in >= 0) | |
| 771 | 409 retry_close (in); |
| 428 | 410 if (out != in && out >= 0) |
| 771 | 411 retry_close (out); |
| 853 | 412 if (err != in && err != out && err >= 0) |
| 413 retry_close (err); | |
| 428 | 414 |
| 853 | 415 *in_usid = FD_TO_USID (in); |
| 416 *err_usid = FD_TO_USID (err); | |
| 428 | 417 } |
| 418 | |
| 419 | |
| 420 void | |
| 421 init_event_unixoid (void) | |
| 422 { | |
| 423 /* Do this first; the init_event_*_late() functions | |
| 424 pay attention to it. */ | |
| 425 if (pipe (signal_event_pipe) < 0) | |
| 426 { | |
| 427 perror ("XEmacs: can't open pipe"); | |
| 428 exit (-1); | |
| 429 } | |
| 430 signal_event_pipe_initialized = 1; | |
| 431 | |
| 432 /* Set it non-blocking so we can drain its output. */ | |
| 433 set_descriptor_non_blocking (signal_event_pipe[0]); | |
| 434 | |
| 435 /* Also set the write descriptor non-blocking so we don't | |
| 436 hang in case a long time passes between times when | |
| 437 we drain the pipe. */ | |
| 438 set_descriptor_non_blocking (signal_event_pipe[1]); | |
| 439 | |
| 440 /* WARNING: In order for the signal-event pipe to work correctly | |
| 441 and not cause lockups, the following need to be followed: | |
| 442 | |
| 443 1) event_pending_p() must ignore input on the signal-event pipe. | |
| 444 2) As soon as next_event() notices input on the signal-event | |
| 445 pipe, it must drain it. */ | |
| 446 FD_ZERO (&input_wait_mask); | |
| 447 FD_ZERO (&non_fake_input_wait_mask); | |
| 448 FD_ZERO (&process_only_mask); | |
| 449 FD_ZERO (&tty_only_mask); | |
| 450 | |
| 451 FD_SET (signal_event_pipe[0], &input_wait_mask); | |
| 452 } |