29 |
#include "lisp.h" |
#include "lisp.h" |
30 |
#include "intervals.h" |
#include "intervals.h" |
31 |
#include "buffer.h" |
#include "buffer.h" |
32 |
|
#include "character.h" |
33 |
#include "charset.h" |
#include "charset.h" |
34 |
|
#include "coding.h" |
35 |
#include <epaths.h> |
#include <epaths.h> |
36 |
#include "commands.h" |
#include "commands.h" |
37 |
#include "keyboard.h" |
#include "keyboard.h" |
88 |
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; |
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; |
89 |
Lisp_Object Qinhibit_file_name_operation; |
Lisp_Object Qinhibit_file_name_operation; |
90 |
|
|
91 |
|
/* Used instead of Qget_file_char while loading *.elc files compiled |
92 |
|
by Emacs 21 or older. */ |
93 |
|
static Lisp_Object Qget_emacs_mule_file_char; |
94 |
|
|
95 |
|
static Lisp_Object Qload_force_doc_strings; |
96 |
|
|
97 |
extern Lisp_Object Qevent_symbol_element_mask; |
extern Lisp_Object Qevent_symbol_element_mask; |
98 |
extern Lisp_Object Qfile_exists_p; |
extern Lisp_Object Qfile_exists_p; |
99 |
|
|
137 |
/* Nonzero means read should convert strings to unibyte. */ |
/* Nonzero means read should convert strings to unibyte. */ |
138 |
static int load_convert_to_unibyte; |
static int load_convert_to_unibyte; |
139 |
|
|
140 |
|
/* Nonzero means READCHAR should read bytes one by one (not character) |
141 |
|
when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char. |
142 |
|
This is set to 1 by read1 temporarily while handling #@NUMBER. */ |
143 |
|
static int load_each_byte; |
144 |
|
|
145 |
/* Function to use for loading an Emacs lisp source file (not |
/* Function to use for loading an Emacs lisp source file (not |
146 |
compiled) instead of readevalloop. */ |
compiled) instead of readevalloop. */ |
147 |
Lisp_Object Vload_source_file_function; |
Lisp_Object Vload_source_file_function; |
170 |
static int read_from_string_index_byte; |
static int read_from_string_index_byte; |
171 |
static int read_from_string_limit; |
static int read_from_string_limit; |
172 |
|
|
|
/* Number of bytes left to read in the buffer character |
|
|
that `readchar' has already advanced over. */ |
|
|
static int readchar_backlog; |
|
173 |
/* Number of characters read in the current call to Fread or |
/* Number of characters read in the current call to Fread or |
174 |
Fread_from_string. */ |
Fread_from_string. */ |
175 |
static int readchar_count; |
static int readchar_count; |
213 |
|
|
214 |
static Lisp_Object Vbytecomp_version_regexp; |
static Lisp_Object Vbytecomp_version_regexp; |
215 |
|
|
216 |
static void to_multibyte P_ ((char **, char **, int *)); |
static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object), |
217 |
|
Lisp_Object)); |
218 |
|
|
219 |
static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object, |
static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object, |
220 |
Lisp_Object (*) (), int, |
Lisp_Object (*) (), int, |
221 |
Lisp_Object, Lisp_Object)); |
Lisp_Object, Lisp_Object)); |
223 |
static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object)); |
static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object)); |
224 |
|
|
225 |
|
|
226 |
|
/* Functions that read one byte from the current source READCHARFUN |
227 |
|
or unreads one byte. If the integer argument C is -1, it returns |
228 |
|
one read byte, or -1 when there's no more byte in the source. If C |
229 |
|
is 0 or positive, it unreads C, and the return value is not |
230 |
|
interesting. */ |
231 |
|
|
232 |
|
static int readbyte_for_lambda P_ ((int, Lisp_Object)); |
233 |
|
static int readbyte_from_file P_ ((int, Lisp_Object)); |
234 |
|
static int readbyte_from_string P_ ((int, Lisp_Object)); |
235 |
|
|
236 |
/* Handle unreading and rereading of characters. |
/* Handle unreading and rereading of characters. |
237 |
Write READCHAR to read a character, |
Write READCHAR to read a character, |
238 |
UNREAD(c) to unread c to be read again. |
UNREAD(c) to unread c to be read again. |
239 |
|
|
240 |
The READCHAR and UNREAD macros are meant for reading/unreading a |
These macros correctly read/unread multibyte characters. */ |
|
byte code; they do not handle multibyte characters. The caller |
|
|
should manage them if necessary. |
|
|
|
|
|
[ Actually that seems to be a lie; READCHAR will definitely read |
|
|
multibyte characters from buffer sources, at least. Is the |
|
|
comment just out of date? |
|
|
-- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ] |
|
|
*/ |
|
241 |
|
|
242 |
#define READCHAR readchar (readcharfun) |
#define READCHAR readchar (readcharfun) |
243 |
#define UNREAD(c) unreadchar (readcharfun, c) |
#define UNREAD(c) unreadchar (readcharfun, c) |
244 |
|
|
245 |
|
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char, |
246 |
|
Qlambda, or a cons, we use this to keep an unread character because |
247 |
|
a file stream can't handle multibyte-char unreading. The value -1 |
248 |
|
means that there's no unread character. */ |
249 |
|
static int unread_char; |
250 |
|
|
251 |
static int |
static int |
252 |
readchar (readcharfun) |
readchar (readcharfun) |
253 |
Lisp_Object readcharfun; |
Lisp_Object readcharfun; |
254 |
{ |
{ |
255 |
Lisp_Object tem; |
Lisp_Object tem; |
256 |
register int c; |
register int c; |
257 |
|
int (*readbyte) P_ ((int, Lisp_Object)); |
258 |
|
unsigned char buf[MAX_MULTIBYTE_LENGTH]; |
259 |
|
int i, len; |
260 |
|
int emacs_mule_encoding = 0; |
261 |
|
|
262 |
readchar_count++; |
readchar_count++; |
263 |
|
|
266 |
register struct buffer *inbuffer = XBUFFER (readcharfun); |
register struct buffer *inbuffer = XBUFFER (readcharfun); |
267 |
|
|
268 |
int pt_byte = BUF_PT_BYTE (inbuffer); |
int pt_byte = BUF_PT_BYTE (inbuffer); |
|
int orig_pt_byte = pt_byte; |
|
|
|
|
|
if (readchar_backlog > 0) |
|
|
/* We get the address of the byte just passed, |
|
|
which is the last byte of the character. |
|
|
The other bytes in this character are consecutive with it, |
|
|
because the gap can't be in the middle of a character. */ |
|
|
return *(BUF_BYTE_ADDRESS (inbuffer, BUF_PT_BYTE (inbuffer) - 1) |
|
|
- --readchar_backlog); |
|
269 |
|
|
270 |
if (pt_byte >= BUF_ZV_BYTE (inbuffer)) |
if (pt_byte >= BUF_ZV_BYTE (inbuffer)) |
271 |
return -1; |
return -1; |
272 |
|
|
|
readchar_backlog = -1; |
|
|
|
|
273 |
if (! NILP (inbuffer->enable_multibyte_characters)) |
if (! NILP (inbuffer->enable_multibyte_characters)) |
274 |
{ |
{ |
275 |
/* Fetch the character code from the buffer. */ |
/* Fetch the character code from the buffer. */ |
280 |
else |
else |
281 |
{ |
{ |
282 |
c = BUF_FETCH_BYTE (inbuffer, pt_byte); |
c = BUF_FETCH_BYTE (inbuffer, pt_byte); |
283 |
|
if (! ASCII_BYTE_P (c)) |
284 |
|
c = BYTE8_TO_CHAR (c); |
285 |
pt_byte++; |
pt_byte++; |
286 |
} |
} |
287 |
SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte); |
SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte); |
293 |
register struct buffer *inbuffer = XMARKER (readcharfun)->buffer; |
register struct buffer *inbuffer = XMARKER (readcharfun)->buffer; |
294 |
|
|
295 |
int bytepos = marker_byte_position (readcharfun); |
int bytepos = marker_byte_position (readcharfun); |
|
int orig_bytepos = bytepos; |
|
|
|
|
|
if (readchar_backlog > 0) |
|
|
/* We get the address of the byte just passed, |
|
|
which is the last byte of the character. |
|
|
The other bytes in this character are consecutive with it, |
|
|
because the gap can't be in the middle of a character. */ |
|
|
return *(BUF_BYTE_ADDRESS (inbuffer, XMARKER (readcharfun)->bytepos - 1) |
|
|
- --readchar_backlog); |
|
296 |
|
|
297 |
if (bytepos >= BUF_ZV_BYTE (inbuffer)) |
if (bytepos >= BUF_ZV_BYTE (inbuffer)) |
298 |
return -1; |
return -1; |
299 |
|
|
|
readchar_backlog = -1; |
|
|
|
|
300 |
if (! NILP (inbuffer->enable_multibyte_characters)) |
if (! NILP (inbuffer->enable_multibyte_characters)) |
301 |
{ |
{ |
302 |
/* Fetch the character code from the buffer. */ |
/* Fetch the character code from the buffer. */ |
307 |
else |
else |
308 |
{ |
{ |
309 |
c = BUF_FETCH_BYTE (inbuffer, bytepos); |
c = BUF_FETCH_BYTE (inbuffer, bytepos); |
310 |
|
if (! ASCII_BYTE_P (c)) |
311 |
|
c = BYTE8_TO_CHAR (c); |
312 |
bytepos++; |
bytepos++; |
313 |
} |
} |
314 |
|
|
319 |
} |
} |
320 |
|
|
321 |
if (EQ (readcharfun, Qlambda)) |
if (EQ (readcharfun, Qlambda)) |
322 |
return read_bytecode_char (0); |
{ |
323 |
|
readbyte = readbyte_for_lambda; |
324 |
|
goto read_multibyte; |
325 |
|
} |
326 |
|
|
327 |
if (EQ (readcharfun, Qget_file_char)) |
if (EQ (readcharfun, Qget_file_char)) |
328 |
{ |
{ |
329 |
c = getc (instream); |
readbyte = readbyte_from_file; |
330 |
#ifdef EINTR |
goto read_multibyte; |
|
/* Interrupted reads have been observed while reading over the network */ |
|
|
while (c == EOF && ferror (instream) && errno == EINTR) |
|
|
{ |
|
|
clearerr (instream); |
|
|
c = getc (instream); |
|
|
} |
|
|
#endif |
|
|
return c; |
|
331 |
} |
} |
332 |
|
|
333 |
if (STRINGP (readcharfun)) |
if (STRINGP (readcharfun)) |
342 |
return c; |
return c; |
343 |
} |
} |
344 |
|
|
345 |
|
if (CONSP (readcharfun)) |
346 |
|
{ |
347 |
|
/* This is the case that read_vector is reading from a unibyte |
348 |
|
string that contains a byte sequence previously skipped |
349 |
|
because of #@NUMBER. The car part of readcharfun is that |
350 |
|
string, and the cdr part is a value of readcharfun given to |
351 |
|
read_vector. */ |
352 |
|
readbyte = readbyte_from_string; |
353 |
|
if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char)) |
354 |
|
emacs_mule_encoding = 1; |
355 |
|
goto read_multibyte; |
356 |
|
} |
357 |
|
|
358 |
|
if (EQ (readcharfun, Qget_emacs_mule_file_char)) |
359 |
|
{ |
360 |
|
readbyte = readbyte_from_file; |
361 |
|
emacs_mule_encoding = 1; |
362 |
|
goto read_multibyte; |
363 |
|
} |
364 |
|
|
365 |
tem = call0 (readcharfun); |
tem = call0 (readcharfun); |
366 |
|
|
367 |
if (NILP (tem)) |
if (NILP (tem)) |
368 |
return -1; |
return -1; |
369 |
return XINT (tem); |
return XINT (tem); |
370 |
|
|
371 |
|
read_multibyte: |
372 |
|
if (unread_char >= 0) |
373 |
|
{ |
374 |
|
c = unread_char; |
375 |
|
unread_char = -1; |
376 |
|
return c; |
377 |
|
} |
378 |
|
c = (*readbyte) (-1, readcharfun); |
379 |
|
if (c < 0 || ASCII_BYTE_P (c) || load_each_byte) |
380 |
|
return c; |
381 |
|
if (emacs_mule_encoding) |
382 |
|
return read_emacs_mule_char (c, readbyte, readcharfun); |
383 |
|
i = 0; |
384 |
|
buf[i++] = c; |
385 |
|
len = BYTES_BY_CHAR_HEAD (c); |
386 |
|
while (i < len) |
387 |
|
{ |
388 |
|
c = (*readbyte) (-1, readcharfun); |
389 |
|
if (c < 0 || ! TRAILING_CODE_P (c)) |
390 |
|
{ |
391 |
|
while (--i > 1) |
392 |
|
(*readbyte) (buf[i], readcharfun); |
393 |
|
return BYTE8_TO_CHAR (buf[0]); |
394 |
|
} |
395 |
|
buf[i++] = c; |
396 |
|
} |
397 |
|
return STRING_CHAR (buf, i); |
398 |
} |
} |
399 |
|
|
400 |
/* Unread the character C in the way appropriate for the stream READCHARFUN. |
/* Unread the character C in the way appropriate for the stream READCHARFUN. |
415 |
struct buffer *b = XBUFFER (readcharfun); |
struct buffer *b = XBUFFER (readcharfun); |
416 |
int bytepos = BUF_PT_BYTE (b); |
int bytepos = BUF_PT_BYTE (b); |
417 |
|
|
418 |
if (readchar_backlog >= 0) |
BUF_PT (b)--; |
419 |
readchar_backlog++; |
if (! NILP (b->enable_multibyte_characters)) |
420 |
|
BUF_DEC_POS (b, bytepos); |
421 |
else |
else |
422 |
{ |
bytepos--; |
|
BUF_PT (b)--; |
|
|
if (! NILP (b->enable_multibyte_characters)) |
|
|
BUF_DEC_POS (b, bytepos); |
|
|
else |
|
|
bytepos--; |
|
423 |
|
|
424 |
BUF_PT_BYTE (b) = bytepos; |
BUF_PT_BYTE (b) = bytepos; |
|
} |
|
425 |
} |
} |
426 |
else if (MARKERP (readcharfun)) |
else if (MARKERP (readcharfun)) |
427 |
{ |
{ |
428 |
struct buffer *b = XMARKER (readcharfun)->buffer; |
struct buffer *b = XMARKER (readcharfun)->buffer; |
429 |
int bytepos = XMARKER (readcharfun)->bytepos; |
int bytepos = XMARKER (readcharfun)->bytepos; |
430 |
|
|
431 |
if (readchar_backlog >= 0) |
XMARKER (readcharfun)->charpos--; |
432 |
readchar_backlog++; |
if (! NILP (b->enable_multibyte_characters)) |
433 |
|
BUF_DEC_POS (b, bytepos); |
434 |
else |
else |
435 |
{ |
bytepos--; |
|
XMARKER (readcharfun)->charpos--; |
|
|
if (! NILP (b->enable_multibyte_characters)) |
|
|
BUF_DEC_POS (b, bytepos); |
|
|
else |
|
|
bytepos--; |
|
436 |
|
|
437 |
XMARKER (readcharfun)->bytepos = bytepos; |
XMARKER (readcharfun)->bytepos = bytepos; |
|
} |
|
438 |
} |
} |
439 |
else if (STRINGP (readcharfun)) |
else if (STRINGP (readcharfun)) |
440 |
{ |
{ |
442 |
read_from_string_index_byte |
read_from_string_index_byte |
443 |
= string_char_to_byte (readcharfun, read_from_string_index); |
= string_char_to_byte (readcharfun, read_from_string_index); |
444 |
} |
} |
445 |
|
else if (CONSP (readcharfun)) |
446 |
|
{ |
447 |
|
unread_char = c; |
448 |
|
} |
449 |
else if (EQ (readcharfun, Qlambda)) |
else if (EQ (readcharfun, Qlambda)) |
450 |
read_bytecode_char (1); |
{ |
451 |
else if (EQ (readcharfun, Qget_file_char)) |
unread_char = c; |
452 |
ungetc (c, instream); |
} |
453 |
|
else if (EQ (readcharfun, Qget_file_char) |
454 |
|
|| EQ (readcharfun, Qget_emacs_mule_file_char)) |
455 |
|
{ |
456 |
|
if (load_each_byte) |
457 |
|
ungetc (c, instream); |
458 |
|
else |
459 |
|
unread_char = c; |
460 |
|
} |
461 |
else |
else |
462 |
call1 (readcharfun, make_number (c)); |
call1 (readcharfun, make_number (c)); |
463 |
} |
} |
464 |
|
|
465 |
|
static int |
466 |
|
readbyte_for_lambda (c, readcharfun) |
467 |
|
int c; |
468 |
|
Lisp_Object readcharfun; |
469 |
|
{ |
470 |
|
return read_bytecode_char (c >= 0); |
471 |
|
} |
472 |
|
|
473 |
|
|
474 |
|
static int |
475 |
|
readbyte_from_file (c, readcharfun) |
476 |
|
int c; |
477 |
|
Lisp_Object readcharfun; |
478 |
|
{ |
479 |
|
if (c >= 0) |
480 |
|
{ |
481 |
|
ungetc (c, instream); |
482 |
|
return 0; |
483 |
|
} |
484 |
|
|
485 |
|
c = getc (instream); |
486 |
|
#ifdef EINTR |
487 |
|
/* Interrupted reads have been observed while reading over the network */ |
488 |
|
while (c == EOF && ferror (instream) && errno == EINTR) |
489 |
|
{ |
490 |
|
clearerr (instream); |
491 |
|
c = getc (instream); |
492 |
|
} |
493 |
|
#endif |
494 |
|
return (c == EOF ? -1 : c); |
495 |
|
} |
496 |
|
|
497 |
|
static int |
498 |
|
readbyte_from_string (c, readcharfun) |
499 |
|
int c; |
500 |
|
Lisp_Object readcharfun; |
501 |
|
{ |
502 |
|
Lisp_Object string = XCAR (readcharfun); |
503 |
|
|
504 |
|
if (c >= 0) |
505 |
|
{ |
506 |
|
read_from_string_index--; |
507 |
|
read_from_string_index_byte |
508 |
|
= string_char_to_byte (string, read_from_string_index); |
509 |
|
} |
510 |
|
|
511 |
|
if (read_from_string_index >= read_from_string_limit) |
512 |
|
c = -1; |
513 |
|
else |
514 |
|
FETCH_STRING_CHAR_ADVANCE (c, string, |
515 |
|
read_from_string_index, |
516 |
|
read_from_string_index_byte); |
517 |
|
return c; |
518 |
|
} |
519 |
|
|
520 |
|
|
521 |
|
/* Read one non-ASCII character from INSTREAM. The character is |
522 |
|
encoded in `emacs-mule' and the first byte is already read in |
523 |
|
C. */ |
524 |
|
|
525 |
|
extern char emacs_mule_bytes[256]; |
526 |
|
|
527 |
|
static int |
528 |
|
read_emacs_mule_char (c, readbyte, readcharfun) |
529 |
|
int c; |
530 |
|
int (*readbyte) P_ ((int, Lisp_Object)); |
531 |
|
Lisp_Object readcharfun; |
532 |
|
{ |
533 |
|
/* Emacs-mule coding uses at most 4-byte for one character. */ |
534 |
|
unsigned char buf[4]; |
535 |
|
int len = emacs_mule_bytes[c]; |
536 |
|
struct charset *charset; |
537 |
|
int i; |
538 |
|
unsigned code; |
539 |
|
|
540 |
|
if (len == 1) |
541 |
|
/* C is not a valid leading-code of `emacs-mule'. */ |
542 |
|
return BYTE8_TO_CHAR (c); |
543 |
|
|
544 |
|
i = 0; |
545 |
|
buf[i++] = c; |
546 |
|
while (i < len) |
547 |
|
{ |
548 |
|
c = (*readbyte) (-1, readcharfun); |
549 |
|
if (c < 0xA0) |
550 |
|
{ |
551 |
|
while (--i > 1) |
552 |
|
(*readbyte) (buf[i], readcharfun); |
553 |
|
return BYTE8_TO_CHAR (buf[0]); |
554 |
|
} |
555 |
|
buf[i++] = c; |
556 |
|
} |
557 |
|
|
558 |
|
if (len == 2) |
559 |
|
{ |
560 |
|
charset = emacs_mule_charset[buf[0]]; |
561 |
|
code = buf[1] & 0x7F; |
562 |
|
} |
563 |
|
else if (len == 3) |
564 |
|
{ |
565 |
|
if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11 |
566 |
|
|| buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12) |
567 |
|
{ |
568 |
|
charset = emacs_mule_charset[buf[1]]; |
569 |
|
code = buf[2] & 0x7F; |
570 |
|
} |
571 |
|
else |
572 |
|
{ |
573 |
|
charset = emacs_mule_charset[buf[0]]; |
574 |
|
code = ((buf[1] << 8) | buf[2]) & 0x7F7F; |
575 |
|
} |
576 |
|
} |
577 |
|
else |
578 |
|
{ |
579 |
|
charset = emacs_mule_charset[buf[1]]; |
580 |
|
code = ((buf[2] << 8) | buf[3]) & 0x7F7F; |
581 |
|
} |
582 |
|
c = DECODE_CHAR (charset, code); |
583 |
|
if (c < 0) |
584 |
|
Fsignal (Qinvalid_read_syntax, |
585 |
|
Fcons (build_string ("invalid multibyte form"), Qnil)); |
586 |
|
return c; |
587 |
|
} |
588 |
|
|
589 |
|
|
590 |
static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object, |
static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object, |
591 |
Lisp_Object)); |
Lisp_Object)); |
592 |
static Lisp_Object read0 P_ ((Lisp_Object)); |
static Lisp_Object read0 P_ ((Lisp_Object)); |
594 |
|
|
595 |
static Lisp_Object read_list P_ ((int, Lisp_Object)); |
static Lisp_Object read_list P_ ((int, Lisp_Object)); |
596 |
static Lisp_Object read_vector P_ ((Lisp_Object, int)); |
static Lisp_Object read_vector P_ ((Lisp_Object, int)); |
|
static int read_multibyte P_ ((int, Lisp_Object)); |
|
597 |
|
|
598 |
static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object, |
static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object, |
599 |
Lisp_Object)); |
Lisp_Object)); |
768 |
|
|
769 |
|
|
770 |
|
|
771 |
/* Value is non-zero if the file asswociated with file descriptor FD |
/* Value is a version number of byte compiled code if the file |
772 |
is a compiled Lisp file that's safe to load. Only files compiled |
asswociated with file descriptor FD is a compiled Lisp file that's |
773 |
with Emacs are safe to load. Files compiled with XEmacs can lead |
safe to load. Only files compiled with Emacs are safe to load. |
774 |
to a crash in Fbyte_code because of an incompatible change in the |
Files compiled with XEmacs can lead to a crash in Fbyte_code |
775 |
byte compiler. */ |
because of an incompatible change in the byte compiler. */ |
776 |
|
|
777 |
static int |
static int |
778 |
safe_to_load_p (fd) |
safe_to_load_p (fd) |
781 |
char buf[512]; |
char buf[512]; |
782 |
int nbytes, i; |
int nbytes, i; |
783 |
int safe_p = 1; |
int safe_p = 1; |
784 |
|
int version = 1; |
785 |
|
|
786 |
/* Read the first few bytes from the file, and look for a line |
/* Read the first few bytes from the file, and look for a line |
787 |
specifying the byte compiler version used. */ |
specifying the byte compiler version used. */ |
791 |
buf[nbytes] = '\0'; |
buf[nbytes] = '\0'; |
792 |
|
|
793 |
/* Skip to the next newline, skipping over the initial `ELC' |
/* Skip to the next newline, skipping over the initial `ELC' |
794 |
with NUL bytes following it. */ |
with NUL bytes following it, but note the version. */ |
795 |
for (i = 0; i < nbytes && buf[i] != '\n'; ++i) |
for (i = 0; i < nbytes && buf[i] != '\n'; ++i) |
796 |
; |
if (i == 4) |
797 |
|
version = buf[i]; |
798 |
|
|
799 |
if (i < nbytes |
if (i == nbytes |
800 |
&& fast_c_string_match_ignore_case (Vbytecomp_version_regexp, |
|| fast_c_string_match_ignore_case (Vbytecomp_version_regexp, |
801 |
buf + i) < 0) |
buf + i) < 0) |
802 |
safe_p = 0; |
safe_p = 0; |
803 |
} |
} |
804 |
|
if (safe_p) |
805 |
|
safe_p = version; |
806 |
|
|
807 |
lseek (fd, 0, SEEK_SET); |
lseek (fd, 0, SEEK_SET); |
808 |
return safe_p; |
return safe_p; |
862 |
Lisp_Object handler; |
Lisp_Object handler; |
863 |
int safe_p = 1; |
int safe_p = 1; |
864 |
char *fmode = "r"; |
char *fmode = "r"; |
865 |
|
int version; |
866 |
|
|
867 |
#ifdef DOS_NT |
#ifdef DOS_NT |
868 |
fmode = "rt"; |
fmode = "rt"; |
869 |
#endif /* DOS_NT */ |
#endif /* DOS_NT */ |
979 |
Vloads_in_progress = Fcons (found, Vloads_in_progress); |
Vloads_in_progress = Fcons (found, Vloads_in_progress); |
980 |
} |
} |
981 |
|
|
982 |
|
version = -1; |
983 |
if (!bcmp (SDATA (found) + SBYTES (found) - 4, |
if (!bcmp (SDATA (found) + SBYTES (found) - 4, |
984 |
".elc", 4)) |
".elc", 4) |
985 |
|
|| (version = safe_to_load_p (fd)) > 0) |
986 |
/* Load .elc files directly, but not when they are |
/* Load .elc files directly, but not when they are |
987 |
remote and have no handler! */ |
remote and have no handler! */ |
988 |
{ |
{ |
991 |
struct stat s1, s2; |
struct stat s1, s2; |
992 |
int result; |
int result; |
993 |
|
|
994 |
if (!safe_to_load_p (fd)) |
if (version < 0 |
995 |
|
&& ! (version = safe_to_load_p (fd))) |
996 |
{ |
{ |
997 |
safe_p = 0; |
safe_p = 0; |
998 |
if (!load_dangerous_libraries) |
if (!load_dangerous_libraries) |
1095 |
load_descriptor_list |
load_descriptor_list |
1096 |
= Fcons (make_number (fileno (stream)), load_descriptor_list); |
= Fcons (make_number (fileno (stream)), load_descriptor_list); |
1097 |
load_in_progress++; |
load_in_progress++; |
1098 |
readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil); |
if (! version || version >= 22) |
1099 |
|
readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil); |
1100 |
|
else |
1101 |
|
{ |
1102 |
|
/* We can't handle a file which was compiled with |
1103 |
|
byte-compile-dynamic by older version of Emacs. */ |
1104 |
|
specbind (Qload_force_doc_strings, Qt); |
1105 |
|
readevalloop (Qget_emacs_mule_file_char, stream, file, Feval, 0, |
1106 |
|
Qnil, Qnil); |
1107 |
|
} |
1108 |
unbind_to (count, Qnil); |
unbind_to (count, Qnil); |
1109 |
|
|
1110 |
/* Run any load-hooks for this file. */ |
/* Run any load-hooks for this file. */ |
1510 |
record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil); |
record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil); |
1511 |
load_convert_to_unibyte = !NILP (unibyte); |
load_convert_to_unibyte = !NILP (unibyte); |
1512 |
|
|
|
readchar_backlog = -1; |
|
|
|
|
1513 |
GCPRO1 (sourcename); |
GCPRO1 (sourcename); |
1514 |
|
|
1515 |
LOADHIST_ATTACH (sourcename); |
LOADHIST_ATTACH (sourcename); |
1717 |
{ |
{ |
1718 |
Lisp_Object retval; |
Lisp_Object retval; |
1719 |
|
|
|
readchar_backlog = -1; |
|
1720 |
readchar_count = 0; |
readchar_count = 0; |
1721 |
new_backquote_flag = 0; |
new_backquote_flag = 0; |
1722 |
read_objects = Qnil; |
read_objects = Qnil; |
1724 |
|| EQ (Vread_with_symbol_positions, stream)) |
|| EQ (Vread_with_symbol_positions, stream)) |
1725 |
Vread_symbol_positions_list = Qnil; |
Vread_symbol_positions_list = Qnil; |
1726 |
|
|
1727 |
if (STRINGP (stream)) |
if (STRINGP (stream) |
1728 |
|
|| ((CONSP (stream) && STRINGP (XCAR (stream))))) |
1729 |
{ |
{ |
1730 |
int startval, endval; |
int startval, endval; |
1731 |
|
Lisp_Object string; |
1732 |
|
|
1733 |
|
if (STRINGP (stream)) |
1734 |
|
string = stream; |
1735 |
|
else |
1736 |
|
string = XCAR (stream); |
1737 |
|
|
1738 |
if (NILP (end)) |
if (NILP (end)) |
1739 |
endval = SCHARS (stream); |
endval = SCHARS (string); |
1740 |
else |
else |
1741 |
{ |
{ |
1742 |
CHECK_NUMBER (end); |
CHECK_NUMBER (end); |
1743 |
endval = XINT (end); |
endval = XINT (end); |
1744 |
if (endval < 0 || endval > SCHARS (stream)) |
if (endval < 0 || endval > SCHARS (string)) |
1745 |
args_out_of_range (stream, end); |
args_out_of_range (string, end); |
1746 |
} |
} |
1747 |
|
|
1748 |
if (NILP (start)) |
if (NILP (start)) |
1752 |
CHECK_NUMBER (start); |
CHECK_NUMBER (start); |
1753 |
startval = XINT (start); |
startval = XINT (start); |
1754 |
if (startval < 0 || startval > endval) |
if (startval < 0 || startval > endval) |
1755 |
args_out_of_range (stream, start); |
args_out_of_range (string, start); |
1756 |
} |
} |
1757 |
read_from_string_index = startval; |
read_from_string_index = startval; |
1758 |
read_from_string_index_byte = string_char_to_byte (stream, startval); |
read_from_string_index_byte = string_char_to_byte (string, startval); |
1759 |
read_from_string_limit = endval; |
read_from_string_limit = endval; |
1760 |
} |
} |
1761 |
|
|
1788 |
static int read_buffer_size; |
static int read_buffer_size; |
1789 |
static char *read_buffer; |
static char *read_buffer; |
1790 |
|
|
|
/* Read multibyte form and return it as a character. C is a first |
|
|
byte of multibyte form, and rest of them are read from |
|
|
READCHARFUN. */ |
|
|
|
|
|
static int |
|
|
read_multibyte (c, readcharfun) |
|
|
register int c; |
|
|
Lisp_Object readcharfun; |
|
|
{ |
|
|
/* We need the actual character code of this multibyte |
|
|
characters. */ |
|
|
unsigned char str[MAX_MULTIBYTE_LENGTH]; |
|
|
int len = 0; |
|
|
int bytes; |
|
|
|
|
|
if (c < 0) |
|
|
return c; |
|
|
|
|
|
str[len++] = c; |
|
|
while ((c = READCHAR) >= 0xA0 |
|
|
&& len < MAX_MULTIBYTE_LENGTH) |
|
|
{ |
|
|
str[len++] = c; |
|
|
readchar_count--; |
|
|
} |
|
|
UNREAD (c); |
|
|
if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes)) |
|
|
return STRING_CHAR (str, len); |
|
|
/* The byte sequence is not valid as multibyte. Unread all bytes |
|
|
but the first one, and return the first byte. */ |
|
|
while (--len > 0) |
|
|
UNREAD (str[len]); |
|
|
return str[0]; |
|
|
} |
|
|
|
|
1791 |
/* Read a \-escape sequence, assuming we already read the `\'. |
/* Read a \-escape sequence, assuming we already read the `\'. |
1792 |
If the escape sequence forces unibyte, store 1 into *BYTEREP. |
If the escape sequence forces unibyte, return eight-bit char. */ |
|
If the escape sequence forces multibyte, store 2 into *BYTEREP. |
|
|
Otherwise store 0 into *BYTEREP. */ |
|
1793 |
|
|
1794 |
static int |
static int |
1795 |
read_escape (readcharfun, stringp, byterep) |
read_escape (readcharfun, stringp) |
1796 |
Lisp_Object readcharfun; |
Lisp_Object readcharfun; |
1797 |
int stringp; |
int stringp; |
|
int *byterep; |
|
1798 |
{ |
{ |
1799 |
register int c = READCHAR; |
register int c = READCHAR; |
1800 |
|
|
|
*byterep = 0; |
|
|
|
|
1801 |
switch (c) |
switch (c) |
1802 |
{ |
{ |
1803 |
case -1: |
case -1: |
1834 |
error ("Invalid escape character syntax"); |
error ("Invalid escape character syntax"); |
1835 |
c = READCHAR; |
c = READCHAR; |
1836 |
if (c == '\\') |
if (c == '\\') |
1837 |
c = read_escape (readcharfun, 0, byterep); |
c = read_escape (readcharfun, 0); |
1838 |
return c | meta_modifier; |
return c | meta_modifier; |
1839 |
|
|
1840 |
case 'S': |
case 'S': |
1843 |
error ("Invalid escape character syntax"); |
error ("Invalid escape character syntax"); |
1844 |
c = READCHAR; |
c = READCHAR; |
1845 |
if (c == '\\') |
if (c == '\\') |
1846 |
c = read_escape (readcharfun, 0, byterep); |
c = read_escape (readcharfun, 0); |
1847 |
return c | shift_modifier; |
return c | shift_modifier; |
1848 |
|
|
1849 |
case 'H': |
case 'H': |
1852 |
error ("Invalid escape character syntax"); |
error ("Invalid escape character syntax"); |
1853 |
c = READCHAR; |
c = READCHAR; |
1854 |
if (c == '\\') |
if (c == '\\') |
1855 |
c = read_escape (readcharfun, 0, byterep); |
c = read_escape (readcharfun, 0); |
1856 |
return c | hyper_modifier; |
return c | hyper_modifier; |
1857 |
|
|
1858 |
case 'A': |
case 'A': |
1861 |
error ("Invalid escape character syntax"); |
error ("Invalid escape character syntax"); |
1862 |
c = READCHAR; |
c = READCHAR; |
1863 |
if (c == '\\') |
if (c == '\\') |
1864 |
c = read_escape (readcharfun, 0, byterep); |
c = read_escape (readcharfun, 0); |
1865 |
return c | alt_modifier; |
return c | alt_modifier; |
1866 |
|
|
1867 |
case 's': |
case 's': |
1874 |
} |
} |
1875 |
c = READCHAR; |
c = READCHAR; |
1876 |
if (c == '\\') |
if (c == '\\') |
1877 |
c = read_escape (readcharfun, 0, byterep); |
c = read_escape (readcharfun, 0); |
1878 |
return c | super_modifier; |
return c | super_modifier; |
1879 |
|
|
1880 |
case 'C': |
case 'C': |
1884 |
case '^': |
case '^': |
1885 |
c = READCHAR; |
c = READCHAR; |
1886 |
if (c == '\\') |
if (c == '\\') |
1887 |
c = read_escape (readcharfun, 0, byterep); |
c = read_escape (readcharfun, 0); |
1888 |
if ((c & ~CHAR_MODIFIER_MASK) == '?') |
if ((c & ~CHAR_MODIFIER_MASK) == '?') |
1889 |
return 0177 | (c & CHAR_MODIFIER_MASK); |
return 0177 | (c & CHAR_MODIFIER_MASK); |
1890 |
else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) |
else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) |
1924 |
} |
} |
1925 |
} |
} |
1926 |
|
|
1927 |
*byterep = 1; |
if (i >= 0x80 && i < 0x100) |
1928 |
|
i = BYTE8_TO_CHAR (i); |
1929 |
return i; |
return i; |
1930 |
} |
} |
1931 |
|
|
1933 |
/* A hex escape, as in ANSI C. */ |
/* A hex escape, as in ANSI C. */ |
1934 |
{ |
{ |
1935 |
int i = 0; |
int i = 0; |
1936 |
|
int count = 0; |
1937 |
while (1) |
while (1) |
1938 |
{ |
{ |
1939 |
c = READCHAR; |
c = READCHAR; |
1956 |
UNREAD (c); |
UNREAD (c); |
1957 |
break; |
break; |
1958 |
} |
} |
1959 |
|
count++; |
1960 |
} |
} |
1961 |
|
|
1962 |
*byterep = 2; |
if (count < 3 && i >= 0x80) |
1963 |
|
return BYTE8_TO_CHAR (i); |
1964 |
return i; |
return i; |
1965 |
} |
} |
1966 |
|
|
1967 |
default: |
default: |
|
if (BASE_LEADING_CODE_P (c)) |
|
|
c = read_multibyte (c, readcharfun); |
|
1968 |
return c; |
return c; |
1969 |
} |
} |
1970 |
} |
} |
2036 |
} |
} |
2037 |
|
|
2038 |
|
|
|
/* Convert unibyte text in read_buffer to multibyte. |
|
|
|
|
|
Initially, *P is a pointer after the end of the unibyte text, and |
|
|
the pointer *END points after the end of read_buffer. |
|
|
|
|
|
If read_buffer doesn't have enough room to hold the result |
|
|
of the conversion, reallocate it and adjust *P and *END. |
|
|
|
|
|
At the end, make *P point after the result of the conversion, and |
|
|
return in *NCHARS the number of characters in the converted |
|
|
text. */ |
|
|
|
|
|
static void |
|
|
to_multibyte (p, end, nchars) |
|
|
char **p, **end; |
|
|
int *nchars; |
|
|
{ |
|
|
int nbytes; |
|
|
|
|
|
parse_str_as_multibyte (read_buffer, *p - read_buffer, &nbytes, nchars); |
|
|
if (read_buffer_size < 2 * nbytes) |
|
|
{ |
|
|
int offset = *p - read_buffer; |
|
|
read_buffer_size = 2 * max (read_buffer_size, nbytes); |
|
|
read_buffer = (char *) xrealloc (read_buffer, read_buffer_size); |
|
|
*p = read_buffer + offset; |
|
|
*end = read_buffer + read_buffer_size; |
|
|
} |
|
|
|
|
|
if (nbytes != *nchars) |
|
|
nbytes = str_as_multibyte (read_buffer, read_buffer_size, |
|
|
*p - read_buffer, nchars); |
|
|
|
|
|
*p = read_buffer + nbytes; |
|
|
} |
|
|
|
|
|
|
|
2039 |
/* If the next token is ')' or ']' or '.', we store that character |
/* If the next token is ')' or ']' or '.', we store that character |
2040 |
in *PCH and the return value is not interesting. Else, we store |
in *PCH and the return value is not interesting. Else, we store |
2041 |
zero in *PCH and we read and return one lisp object. |
zero in *PCH and we read and return one lisp object. |
2052 |
int uninterned_symbol = 0; |
int uninterned_symbol = 0; |
2053 |
|
|
2054 |
*pch = 0; |
*pch = 0; |
2055 |
|
load_each_byte = 0; |
2056 |
|
|
2057 |
retry: |
retry: |
2058 |
|
|
2084 |
{ |
{ |
2085 |
Lisp_Object tmp; |
Lisp_Object tmp; |
2086 |
tmp = read_vector (readcharfun, 0); |
tmp = read_vector (readcharfun, 0); |
2087 |
if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS |
if (XVECTOR (tmp)->size != VECSIZE (struct Lisp_Char_Table)) |
|
|| XVECTOR (tmp)->size > CHAR_TABLE_STANDARD_SLOTS + 10) |
|
2088 |
error ("Invalid size char-table"); |
error ("Invalid size char-table"); |
2089 |
XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp)); |
XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp)); |
|
XCHAR_TABLE (tmp)->top = Qt; |
|
2090 |
return tmp; |
return tmp; |
2091 |
} |
} |
2092 |
else if (c == '^') |
else if (c == '^') |
2095 |
if (c == '[') |
if (c == '[') |
2096 |
{ |
{ |
2097 |
Lisp_Object tmp; |
Lisp_Object tmp; |
2098 |
|
int depth, size; |
2099 |
|
|
2100 |
tmp = read_vector (readcharfun, 0); |
tmp = read_vector (readcharfun, 0); |
2101 |
if (XVECTOR (tmp)->size != SUB_CHAR_TABLE_STANDARD_SLOTS) |
if (!INTEGERP (AREF (tmp, 0))) |
2102 |
|
error ("Invalid depth in char-table"); |
2103 |
|
depth = XINT (AREF (tmp, 0)); |
2104 |
|
if (depth < 1 || depth > 3) |
2105 |
|
error ("Invalid depth in char-table"); |
2106 |
|
size = XVECTOR (tmp)->size + 2; |
2107 |
|
if (chartab_size [depth] != size) |
2108 |
error ("Invalid size char-table"); |
error ("Invalid size char-table"); |
2109 |
XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp)); |
XSETSUB_CHAR_TABLE (tmp, XSUB_CHAR_TABLE (tmp)); |
|
XCHAR_TABLE (tmp)->top = Qnil; |
|
2110 |
return tmp; |
return tmp; |
2111 |
} |
} |
2112 |
Fsignal (Qinvalid_read_syntax, |
Fsignal (Qinvalid_read_syntax, |
2127 |
|
|
2128 |
UNREAD (c); |
UNREAD (c); |
2129 |
tmp = read1 (readcharfun, pch, first_in_list); |
tmp = read1 (readcharfun, pch, first_in_list); |
2130 |
if (size_in_chars != SCHARS (tmp) |
if (STRING_MULTIBYTE (tmp) |
2131 |
/* We used to print 1 char too many |
|| (size_in_chars != SCHARS (tmp) |
2132 |
when the number of bits was a multiple of 8. |
/* We used to print 1 char too many |
2133 |
Accept such input in case it came from an old version. */ |
when the number of bits was a multiple of 8. |
2134 |
&& ! (XFASTINT (length) |
Accept such input in case it came from an old |
2135 |
== (SCHARS (tmp) - 1) * BITS_PER_CHAR)) |
version. */ |
2136 |
|
&& ! (XFASTINT (length) |
2137 |
|
== (SCHARS (tmp) - 1) * BITS_PER_CHAR))) |
2138 |
Fsignal (Qinvalid_read_syntax, |
Fsignal (Qinvalid_read_syntax, |
2139 |
Fcons (make_string ("#&...", 5), Qnil)); |
Fcons (make_string ("#&...", 5), Qnil)); |
2140 |
|
|
2200 |
{ |
{ |
2201 |
int i, nskip = 0; |
int i, nskip = 0; |
2202 |
|
|
2203 |
|
load_each_byte = 1; |
2204 |
/* Read a decimal integer. */ |
/* Read a decimal integer. */ |
2205 |
while ((c = READCHAR) >= 0 |
while ((c = READCHAR) >= 0 |
2206 |
&& c >= '0' && c <= '9') |
&& c >= '0' && c <= '9') |
2211 |
if (c >= 0) |
if (c >= 0) |
2212 |
UNREAD (c); |
UNREAD (c); |
2213 |
|
|
2214 |
if (load_force_doc_strings && EQ (readcharfun, Qget_file_char)) |
if (load_force_doc_strings |
2215 |
|
&& (EQ (readcharfun, Qget_file_char) |
2216 |
|
|| EQ (readcharfun, Qget_emacs_mule_file_char))) |
2217 |
{ |
{ |
2218 |
/* If we are supposed to force doc strings into core right now, |
/* If we are supposed to force doc strings into core right now, |
2219 |
record the last string that we skipped, |
record the last string that we skipped, |
2265 |
c = READCHAR; |
c = READCHAR; |
2266 |
} |
} |
2267 |
|
|
2268 |
|
load_each_byte = 0; |
2269 |
goto retry; |
goto retry; |
2270 |
} |
} |
2271 |
if (c == '!') |
if (c == '!') |
2395 |
|
|
2396 |
case '?': |
case '?': |
2397 |
{ |
{ |
2398 |
int discard; |
int modifiers; |
2399 |
int next_char; |
int next_char; |
2400 |
int ok; |
int ok; |
2401 |
|
|
2411 |
return make_number (c); |
return make_number (c); |
2412 |
|
|
2413 |
if (c == '\\') |
if (c == '\\') |
2414 |
c = read_escape (readcharfun, 0, &discard); |
c = read_escape (readcharfun, 0); |
2415 |
else if (BASE_LEADING_CODE_P (c)) |
modifiers = c & CHAR_MODIFIER_MASK; |
2416 |
c = read_multibyte (c, readcharfun); |
c &= ~CHAR_MODIFIER_MASK; |
2417 |
|
if (CHAR_BYTE8_P (c)) |
2418 |
|
c = CHAR_TO_BYTE8 (c); |
2419 |
|
c |= modifiers; |
2420 |
|
|
2421 |
next_char = READCHAR; |
next_char = READCHAR; |
2422 |
if (next_char == '.') |
if (next_char == '.') |
2451 |
char *p = read_buffer; |
char *p = read_buffer; |
2452 |
char *end = read_buffer + read_buffer_size; |
char *end = read_buffer + read_buffer_size; |
2453 |
register int c; |
register int c; |
2454 |
/* 1 if we saw an escape sequence specifying |
/* Nonzero if we saw an escape sequence specifying |
2455 |
a multibyte character, or a multibyte character. */ |
a multibyte character. */ |
2456 |
int force_multibyte = 0; |
int force_multibyte = 0; |
2457 |
/* 1 if we saw an escape sequence specifying |
/* Nonzero if we saw an escape sequence specifying |
2458 |
a single-byte character. */ |
a single-byte character. */ |
2459 |
int force_singlebyte = 0; |
int force_singlebyte = 0; |
|
/* 1 if read_buffer contains multibyte text now. */ |
|
|
int is_multibyte = 0; |
|
2460 |
int cancel = 0; |
int cancel = 0; |
2461 |
int nchars = 0; |
int nchars = 0; |
2462 |
|
|
2474 |
|
|
2475 |
if (c == '\\') |
if (c == '\\') |
2476 |
{ |
{ |
2477 |
int byterep; |
int modifiers; |
2478 |
|
|
2479 |
c = read_escape (readcharfun, 1, &byterep); |
c = read_escape (readcharfun, 1); |
2480 |
|
|
2481 |
/* C is -1 if \ newline has just been seen */ |
/* C is -1 if \ newline has just been seen */ |
2482 |
if (c == -1) |
if (c == -1) |
2486 |
continue; |
continue; |
2487 |
} |
} |
2488 |
|
|
2489 |
if (byterep == 1) |
modifiers = c & CHAR_MODIFIER_MASK; |
2490 |
|
c = c & ~CHAR_MODIFIER_MASK; |
2491 |
|
|
2492 |
|
if (CHAR_BYTE8_P (c)) |
2493 |
force_singlebyte = 1; |
force_singlebyte = 1; |
2494 |
else if (byterep == 2) |
else if (! ASCII_CHAR_P (c)) |
2495 |
force_multibyte = 1; |
force_multibyte = 1; |
2496 |
} |
else /* i.e. ASCII_CHAR_P (c) */ |
2497 |
|
{ |
2498 |
|
/* Allow `\C- ' and `\C-?'. */ |
2499 |
|
if (modifiers == CHAR_CTL) |
2500 |
|
{ |
2501 |
|
if (c == ' ') |
2502 |
|
c = 0, modifiers = 0; |
2503 |
|
else if (c == '?') |
2504 |
|
c = 127, modifiers = 0; |
2505 |
|
} |
2506 |
|
if (modifiers & CHAR_SHIFT) |
2507 |
|
{ |
2508 |
|
/* Shift modifier is valid only with [A-Za-z]. */ |
2509 |
|
if (c >= 'A' && c <= 'Z') |
2510 |
|
modifiers &= ~CHAR_SHIFT; |
2511 |
|
else if (c >= 'a' && c <= 'z') |
2512 |
|
c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT; |
2513 |
|
} |
2514 |
|
|
2515 |
|
if (modifiers & CHAR_META) |
2516 |
|
{ |
2517 |
|
/* Move the meta bit to the right place for a |
2518 |
|
string. */ |
2519 |
|
modifiers &= ~CHAR_META; |
2520 |
|
c = BYTE8_TO_CHAR (c | 0x80); |
2521 |
|
force_singlebyte = 1; |
2522 |
|
} |
2523 |
|
} |
2524 |
|
|
2525 |
/* A character that must be multibyte forces multibyte. */ |
/* Any modifiers remaining are invalid. */ |
2526 |
if (! SINGLE_BYTE_CHAR_P (c & ~CHAR_MODIFIER_MASK)) |
if (modifiers) |
2527 |
force_multibyte = 1; |
error ("Invalid modifier in string"); |
2528 |
|
p += CHAR_STRING (c, (unsigned char *) p); |
|
/* If we just discovered the need to be multibyte, |
|
|
convert the text accumulated thus far. */ |
|
|
if (force_multibyte && ! is_multibyte) |
|
|
{ |
|
|
is_multibyte = 1; |
|
|
to_multibyte (&p, &end, &nchars); |
|
2529 |
} |
} |
2530 |
|
else |
|
/* Allow `\C- ' and `\C-?'. */ |
|
|
if (c == (CHAR_CTL | ' ')) |
|
|
c = 0; |
|
|
else if (c == (CHAR_CTL | '?')) |
|
|
c = 127; |
|
|
|
|
|
if (c & CHAR_SHIFT) |
|
2531 |
{ |
{ |
2532 |
/* Shift modifier is valid only with [A-Za-z]. */ |
p += CHAR_STRING (c, (unsigned char *) p); |
2533 |
if ((c & 0377) >= 'A' && (c & 0377) <= 'Z') |
if (CHAR_BYTE8_P (c)) |
2534 |
c &= ~CHAR_SHIFT; |
force_singlebyte = 1; |
2535 |
else if ((c & 0377) >= 'a' && (c & 0377) <= 'z') |
else if (! ASCII_CHAR_P (c)) |
2536 |
c = (c & ~CHAR_SHIFT) - ('a' - 'A'); |
force_multibyte = 1; |
2537 |
} |
} |
|
|
|
|
if (c & CHAR_META) |
|
|
/* Move the meta bit to the right place for a string. */ |
|
|
c = (c & ~CHAR_META) | 0x80; |
|
|
if (c & CHAR_MODIFIER_MASK) |
|
|
error ("Invalid modifier in string"); |
|
|
|
|
|
if (is_multibyte) |
|
|
p += CHAR_STRING (c, p); |
|
|
else |
|
|
*p++ = c; |
|
|
|
|
2538 |
nchars++; |
nchars++; |
2539 |
} |
} |
2540 |
|
|
2547 |
if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) |
if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) |
2548 |
return make_number (0); |
return make_number (0); |
2549 |
|
|
2550 |
if (is_multibyte || force_singlebyte) |
if (force_multibyte) |
2551 |
|
/* READ_BUFFER already contains valid multibyte forms. */ |
2552 |
; |
; |
2553 |
else if (load_convert_to_unibyte) |
else if (force_singlebyte) |
|
{ |
|
|
Lisp_Object string; |
|
|
to_multibyte (&p, &end, &nchars); |
|
|
if (p - read_buffer != nchars) |
|
|
{ |
|
|
string = make_multibyte_string (read_buffer, nchars, |
|
|
p - read_buffer); |
|
|
return Fstring_make_unibyte (string); |
|
|
} |
|
|
/* We can make a unibyte string directly. */ |
|
|
is_multibyte = 0; |
|
|
} |
|
|
else if (EQ (readcharfun, Qget_file_char) |
|
|
|| EQ (readcharfun, Qlambda)) |
|
2554 |
{ |
{ |
2555 |
/* Nowadays, reading directly from a file is used only for |
nchars = str_as_unibyte (read_buffer, p - read_buffer); |
2556 |
compiled Emacs Lisp files, and those always use the |
p = read_buffer + nchars; |
|
Emacs internal encoding. Meanwhile, Qlambda is used |
|
|
for reading dynamic byte code (compiled with |
|
|
byte-compile-dynamic = t). So make the string multibyte |
|
|
if the string contains any multibyte sequences. |
|
|
(to_multibyte is a no-op if not.) */ |
|
|
to_multibyte (&p, &end, &nchars); |
|
|
is_multibyte = (p - read_buffer) != nchars; |
|
2557 |
} |
} |
2558 |
else |
else |
2559 |
/* In all other cases, if we read these bytes as |
/* Otherwise, READ_BUFFER contains only ASCII. */ |
|
separate characters, treat them as separate characters now. */ |
|
2560 |
; |
; |
2561 |
|
|
2562 |
/* We want readchar_count to be the number of characters, not |
/* We want readchar_count to be the number of characters, not |
2566 |
/* readchar_count -= (p - read_buffer) - nchars; */ |
/* readchar_count -= (p - read_buffer) - nchars; */ |
2567 |
if (read_pure) |
if (read_pure) |
2568 |
return make_pure_string (read_buffer, nchars, p - read_buffer, |
return make_pure_string (read_buffer, nchars, p - read_buffer, |
2569 |
is_multibyte); |
(force_multibyte |
2570 |
|
|| (p - read_buffer != nchars))); |
2571 |
return make_specified_string (read_buffer, nchars, p - read_buffer, |
return make_specified_string (read_buffer, nchars, p - read_buffer, |
2572 |
is_multibyte); |
(force_multibyte |
2573 |
|
|| (p - read_buffer != nchars))); |
2574 |
} |
} |
2575 |
|
|
2576 |
case '.': |
case '.': |
2625 |
quoted = 1; |
quoted = 1; |
2626 |
} |
} |
2627 |
|
|
2628 |
if (! SINGLE_BYTE_CHAR_P (c)) |
p += CHAR_STRING (c, p); |
|
p += CHAR_STRING (c, p); |
|
|
else |
|
|
*p++ = c; |
|
|
|
|
2629 |
c = READCHAR; |
c = READCHAR; |
2630 |
} |
} |
2631 |
|
|
2659 |
{ |
{ |
2660 |
if (p1[-1] == '.') |
if (p1[-1] == '.') |
2661 |
p1[-1] = '\0'; |
p1[-1] = '\0'; |
2662 |
|
/* Fixme: if we have strtol, use that, and check |
2663 |
|
for overflow. */ |
2664 |
if (sizeof (int) == sizeof (EMACS_INT)) |
if (sizeof (int) == sizeof (EMACS_INT)) |
2665 |
XSETINT (val, atoi (read_buffer)); |
XSETINT (val, atoi (read_buffer)); |
2666 |
else if (sizeof (long) == sizeof (EMACS_INT)) |
else if (sizeof (long) == sizeof (EMACS_INT)) |
2964 |
STRING_SET_CHARS (bytestr, SBYTES (bytestr)); |
STRING_SET_CHARS (bytestr, SBYTES (bytestr)); |
2965 |
STRING_SET_UNIBYTE (bytestr); |
STRING_SET_UNIBYTE (bytestr); |
2966 |
|
|
2967 |
item = Fread (bytestr); |
item = Fread (Fcons (bytestr, readcharfun)); |
2968 |
if (!CONSP (item)) |
if (!CONSP (item)) |
2969 |
error ("invalid byte code"); |
error ("invalid byte code"); |
2970 |
|
|
2977 |
/* Now handle the bytecode slot. */ |
/* Now handle the bytecode slot. */ |
2978 |
ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr; |
ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr; |
2979 |
} |
} |
2980 |
|
else if (i == COMPILED_DOC_STRING |
2981 |
|
&& STRINGP (item) |
2982 |
|
&& ! STRING_MULTIBYTE (item)) |
2983 |
|
{ |
2984 |
|
if (EQ (readcharfun, Qget_emacs_mule_file_char)) |
2985 |
|
item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil); |
2986 |
|
else |
2987 |
|
item = Fstring_as_multibyte (item); |
2988 |
|
} |
2989 |
} |
} |
2990 |
ptr[i] = read_pure ? Fpurecopy (item) : item; |
ptr[i] = read_pure ? Fpurecopy (item) : item; |
2991 |
otem = XCONS (tem); |
otem = XCONS (tem); |
3083 |
if (doc_reference == 2) |
if (doc_reference == 2) |
3084 |
{ |
{ |
3085 |
/* Get a doc string from the file we are loading. |
/* Get a doc string from the file we are loading. |
3086 |
If it's in saved_doc_string, get it from there. */ |
If it's in saved_doc_string, get it from there. |
3087 |
|
|
3088 |
|
Here, we don't know if the string is a |
3089 |
|
bytecode string or a doc string. As a |
3090 |
|
bytecode string must be unibyte, we always |
3091 |
|
return a unibyte string. If it is actually a |
3092 |
|
doc string, caller must make it |
3093 |
|
multibyte. */ |
3094 |
|
|
3095 |
int pos = XINT (XCDR (val)); |
int pos = XINT (XCDR (val)); |
3096 |
/* Position is negative for user variables. */ |
/* Position is negative for user variables. */ |
3097 |
if (pos < 0) pos = -pos; |
if (pos < 0) pos = -pos; |
3123 |
saved_doc_string[to++] = c; |
saved_doc_string[to++] = c; |
3124 |
} |
} |
3125 |
|
|
3126 |
return make_string (saved_doc_string + start, |
return make_unibyte_string (saved_doc_string + start, |
3127 |
to - start); |
to - start); |
3128 |
} |
} |
3129 |
/* Look in prev_saved_doc_string the same way. */ |
/* Look in prev_saved_doc_string the same way. */ |
3130 |
else if (pos >= prev_saved_doc_string_position |
else if (pos >= prev_saved_doc_string_position |
3155 |
prev_saved_doc_string[to++] = c; |
prev_saved_doc_string[to++] = c; |
3156 |
} |
} |
3157 |
|
|
3158 |
return make_string (prev_saved_doc_string + start, |
return make_unibyte_string (prev_saved_doc_string |
3159 |
to - start); |
+ start, |
3160 |
|
to - start); |
3161 |
} |
} |
3162 |
else |
else |
3163 |
return get_doc_string (val, 0, 0); |
return get_doc_string (val, 1, 0); |
3164 |
} |
} |
3165 |
|
|
3166 |
return val; |
return val; |
4075 |
Qget_file_char = intern ("get-file-char"); |
Qget_file_char = intern ("get-file-char"); |
4076 |
staticpro (&Qget_file_char); |
staticpro (&Qget_file_char); |
4077 |
|
|
4078 |
|
Qget_emacs_mule_file_char = intern ("get-emacs-mule-file-char"); |
4079 |
|
staticpro (&Qget_emacs_mule_file_char); |
4080 |
|
|
4081 |
|
Qload_force_doc_strings = intern ("load-force-doc-strings"); |
4082 |
|
staticpro (&Qload_force_doc_strings); |
4083 |
|
|
4084 |
Qbackquote = intern ("`"); |
Qbackquote = intern ("`"); |
4085 |
staticpro (&Qbackquote); |
staticpro (&Qbackquote); |
4086 |
Qcomma = intern (","); |
Qcomma = intern (","); |