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