Mercurial > hg > xemacs-beta
annotate src/event-unixoid.c @ 5307:c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
src/ChangeLog addition:
2010-11-20 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.c (Fexpand_abbrev):
* alloc.c:
* alloc.c (Fmake_list):
* alloc.c (Fmake_vector):
* alloc.c (Fmake_bit_vector):
* alloc.c (Fmake_byte_code):
* alloc.c (Fmake_string):
* alloc.c (vars_of_alloc):
* bytecode.c (UNUSED):
* bytecode.c (Fbyte_code):
* chartab.c (decode_char_table_range):
* cmds.c (Fself_insert_command):
* data.c (check_integer_range):
* data.c (Fnatnump):
* data.c (Fnonnegativep):
* data.c (Fstring_to_number):
* elhash.c (hash_table_size_validate):
* elhash.c (decode_hash_table_size):
* eval.c (Fbacktrace_frame):
* event-stream.c (lisp_number_to_milliseconds):
* event-stream.c (Faccept_process_output):
* event-stream.c (Frecent_keys):
* event-stream.c (Fdispatch_event):
* events.c (Fmake_event):
* events.c (Fevent_timestamp):
* events.c (Fevent_timestamp_lessp):
* events.h:
* events.h (struct command_builder):
* file-coding.c (gzip_putprop):
* fns.c:
* fns.c (check_sequence_range):
* fns.c (Frandom):
* fns.c (Fnthcdr):
* fns.c (Flast):
* fns.c (Fnbutlast):
* fns.c (Fbutlast):
* fns.c (Fmember):
* fns.c (Ffill):
* fns.c (Freduce):
* fns.c (replace_string_range_1):
* fns.c (Freplace):
* font-mgr.c (Ffc_pattern_get):
* frame-msw.c (msprinter_set_frame_properties):
* glyphs.c (check_valid_xbm_inline):
* indent.c (Fmove_to_column):
* intl-win32.c (mswindows_multibyte_to_unicode_putprop):
* lisp.h:
* lisp.h (ARRAY_DIMENSION_LIMIT):
* lread.c (decode_mode_1):
* mule-ccl.c (ccl_get_compiled_code):
* number.h:
* process-unix.c (unix_open_multicast_group):
* process.c (Fset_process_window_size):
* profile.c (Fstart_profiling):
* unicode.c (Funicode_to_char):
Change NATNUMP to return 1 for positive bignums; changes uses of
it and of CHECK_NATNUM appropriately, usually by checking for an
integer in an appropriate range.
Add array-dimension-limit and use it in #'make-vector,
#'make-string. Add array-total-size-limit, array-rank-limit while
we're at it, for the sake of any Common Lisp-oriented code that
uses these limits.
Rename check_int_range to check_integer_range, have it take
Lisp_Objects (and thus bignums) instead.
Remove bignum_butlast(), just set int_n to an appropriately large
integer if N is a bignum.
Accept bignums in check_sequence_range(), change the functions
that use check_sequence_range() appropriately.
Move the definition of NATNUMP() to number.h; document why it's a
reasonable name, contradicting an old comment.
tests/ChangeLog addition:
2010-11-20 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
* automated/lisp-tests.el (featurep):
* automated/lisp-tests.el (wrong-type-argument):
* automated/mule-tests.el (featurep):
Check for args-out-of-range errors instead of wrong-type-argument
errors in various places when code is handed a large bignum
instead of a fixnum.
Also check for the wrong-type-argument errors when giving the same
code a non-integer value.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sat, 20 Nov 2010 16:49:11 +0000 |
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 } |