1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
20
21
22 #include <config.h>
23 #include <stdio.h>
24 #include <sys/types.h>
25 #include <sys/stat.h>
26 #include <sys/file.h>
27 #include <errno.h>
28 #include <setjmp.h>
29 #include "lisp.h"
30 #include "intervals.h"
31 #include "buffer.h"
32 #include "character.h"
33 #include "charset.h"
34 #include "coding.h"
35 #include <epaths.h>
36 #include "commands.h"
37 #include "keyboard.h"
38 #include "frame.h"
39 #include "termhooks.h"
40 #include "coding.h"
41 #include "blockinput.h"
42
43 #ifdef MSDOS
44 #include "msdos.h"
45 #endif
46
47 #ifdef HAVE_UNISTD_H
48 #include <unistd.h>
49 #endif
50
51 #ifndef X_OK
52 #define X_OK 01
53 #endif
54
55 #include <math.h>
56
57 #ifdef HAVE_SETLOCALE
58 #include <locale.h>
59 #endif
60
61 #ifdef HAVE_FCNTL_H
62 #include <fcntl.h>
63 #endif
64 #ifndef O_RDONLY
65 #define O_RDONLY 0
66 #endif
67
68 #ifdef HAVE_FSEEKO
69 #define file_offset off_t
70 #define file_tell ftello
71 #else
72 #define file_offset long
73 #define file_tell ftell
74 #endif
75
76
77 Lisp_Object Qhash_table, Qdata;
78 Lisp_Object Qtest, Qsize;
79 Lisp_Object Qweakness;
80 Lisp_Object Qrehash_size;
81 Lisp_Object Qrehash_threshold;
82 extern Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
83
84 Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
85 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
86 Lisp_Object Qascii_character, Qload, Qload_file_name;
87 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
88 Lisp_Object Qinhibit_file_name_operation;
89 Lisp_Object Qeval_buffer_list, Veval_buffer_list;
90 Lisp_Object Qfile_truename, Qdo_after_load_evaluation;
91
92 93
94 static Lisp_Object Qget_emacs_mule_file_char;
95
96 static Lisp_Object Qload_force_doc_strings;
97
98 extern Lisp_Object Qevent_symbol_element_mask;
99 extern Lisp_Object Qfile_exists_p;
100
101
102 int load_in_progress;
103 static Lisp_Object Qload_in_progress;
104
105
106 Lisp_Object Vsource_directory;
107
108
109 Lisp_Object Vload_path, Vload_suffixes, Vload_file_rep_suffixes;
110
111
112 Lisp_Object Vuser_init_file;
113
114 115
116 Lisp_Object Vload_history;
117
118
119 Lisp_Object Vcurrent_load_list;
120
121
122 Lisp_Object Vpreloaded_file_list;
123
124
125 Lisp_Object Vload_file_name;
126
127
128 Lisp_Object Vload_read_function;
129
130
131 Lisp_Object Vread_circle;
132
133 134 135 136
137 Lisp_Object read_objects;
138
139
140 static int load_force_doc_strings;
141
142
143 static int load_convert_to_unibyte;
144
145 146 147
148 static int load_each_byte;
149
150 151
152 Lisp_Object Vload_source_file_function;
153
154
155 Lisp_Object Vbyte_boolean_vars;
156
157 158
159 Lisp_Object Vread_with_symbol_positions;
160
161
162 Lisp_Object Vread_symbol_positions_list;
163
164
165 static Lisp_Object load_descriptor_list;
166
167
168 static FILE *instream;
169
170
171 static int read_pure;
172
173
174 static int read_from_string_index;
175 static int read_from_string_index_byte;
176 static int read_from_string_limit;
177
178 179
180 static int readchar_count;
181
182
183 static char *saved_doc_string;
184
185 static int saved_doc_string_size;
186
187 static int saved_doc_string_length;
188
189 static file_offset saved_doc_string_position;
190
191 192 193
194 static char *prev_saved_doc_string;
195
196 static int prev_saved_doc_string_size;
197
198 static int prev_saved_doc_string_length;
199
200 static file_offset prev_saved_doc_string_position;
201
202 203 204 205
206 static int new_backquote_flag;
207 static Lisp_Object Vold_style_backquotes, Qold_style_backquotes;
208
209 210
211
212 static Lisp_Object Vloads_in_progress;
213
214
215
216 int load_dangerous_libraries;
217
218
219
220 int force_load_messages;
221
222
223
224 static Lisp_Object Vbytecomp_version_regexp;
225
226 static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object),
227 Lisp_Object));
228
229 static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
230 Lisp_Object (*) (), int,
231 Lisp_Object, Lisp_Object,
232 Lisp_Object, Lisp_Object));
233 static Lisp_Object load_unwind P_ ((Lisp_Object));
234 static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
235
236 static void invalid_syntax P_ ((const char *, int)) NO_RETURN;
237 static void end_of_file_error P_ (()) NO_RETURN;
238
239
240 241 242 243 244
245
246 static int readbyte_for_lambda P_ ((int, Lisp_Object));
247 static int readbyte_from_file P_ ((int, Lisp_Object));
248 static int readbyte_from_string P_ ((int, Lisp_Object));
249
250 251 252 253 254
255
256 #define READCHAR readchar (readcharfun, NULL)
257 #define UNREAD(c) unreadchar (readcharfun, c)
258
259
260 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
261
262 263 264 265
266 static int unread_char;
267
268 static int
269 readchar (readcharfun, multibyte)
270 Lisp_Object readcharfun;
271 int *multibyte;
272 {
273 Lisp_Object tem;
274 register int c;
275 int (*readbyte) P_ ((int, Lisp_Object));
276 unsigned char buf[MAX_MULTIBYTE_LENGTH];
277 int i, len;
278 int emacs_mule_encoding = 0;
279
280 if (multibyte)
281 *multibyte = 0;
282
283 readchar_count++;
284
285 if (BUFFERP (readcharfun))
286 {
287 register struct buffer *inbuffer = XBUFFER (readcharfun);
288
289 int pt_byte = BUF_PT_BYTE (inbuffer);
290
291 if (pt_byte >= BUF_ZV_BYTE (inbuffer))
292 return -1;
293
294 if (! NILP (inbuffer->enable_multibyte_characters))
295 {
296
297 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
298 BUF_INC_POS (inbuffer, pt_byte);
299 c = STRING_CHAR (p);
300 if (multibyte)
301 *multibyte = 1;
302 }
303 else
304 {
305 c = BUF_FETCH_BYTE (inbuffer, pt_byte);
306 if (! ASCII_BYTE_P (c))
307 c = BYTE8_TO_CHAR (c);
308 pt_byte++;
309 }
310 SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
311
312 return c;
313 }
314 if (MARKERP (readcharfun))
315 {
316 register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
317
318 int bytepos = marker_byte_position (readcharfun);
319
320 if (bytepos >= BUF_ZV_BYTE (inbuffer))
321 return -1;
322
323 if (! NILP (inbuffer->enable_multibyte_characters))
324 {
325
326 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
327 BUF_INC_POS (inbuffer, bytepos);
328 c = STRING_CHAR (p);
329 if (multibyte)
330 *multibyte = 1;
331 }
332 else
333 {
334 c = BUF_FETCH_BYTE (inbuffer, bytepos);
335 if (! ASCII_BYTE_P (c))
336 c = BYTE8_TO_CHAR (c);
337 bytepos++;
338 }
339
340 XMARKER (readcharfun)->bytepos = bytepos;
341 XMARKER (readcharfun)->charpos++;
342
343 return c;
344 }
345
346 if (EQ (readcharfun, Qlambda))
347 {
348 readbyte = readbyte_for_lambda;
349 goto read_multibyte;
350 }
351
352 if (EQ (readcharfun, Qget_file_char))
353 {
354 readbyte = readbyte_from_file;
355 goto read_multibyte;
356 }
357
358 if (STRINGP (readcharfun))
359 {
360 if (read_from_string_index >= read_from_string_limit)
361 c = -1;
362 else if (STRING_MULTIBYTE (readcharfun))
363 {
364 if (multibyte)
365 *multibyte = 1;
366 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
367 read_from_string_index,
368 read_from_string_index_byte);
369 }
370 else
371 {
372 c = SREF (readcharfun, read_from_string_index_byte);
373 read_from_string_index++;
374 read_from_string_index_byte++;
375 }
376 return c;
377 }
378
379 if (CONSP (readcharfun))
380 {
381 382 383 384 385
386 readbyte = readbyte_from_string;
387 if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
388 emacs_mule_encoding = 1;
389 goto read_multibyte;
390 }
391
392 if (EQ (readcharfun, Qget_emacs_mule_file_char))
393 {
394 readbyte = readbyte_from_file;
395 emacs_mule_encoding = 1;
396 goto read_multibyte;
397 }
398
399 tem = call0 (readcharfun);
400
401 if (NILP (tem))
402 return -1;
403 return XINT (tem);
404
405 read_multibyte:
406 if (unread_char >= 0)
407 {
408 c = unread_char;
409 unread_char = -1;
410 return c;
411 }
412 c = (*readbyte) (-1, readcharfun);
413 if (c < 0 || load_each_byte)
414 return c;
415 if (multibyte)
416 *multibyte = 1;
417 if (ASCII_BYTE_P (c))
418 return c;
419 if (emacs_mule_encoding)
420 return read_emacs_mule_char (c, readbyte, readcharfun);
421 i = 0;
422 buf[i++] = c;
423 len = BYTES_BY_CHAR_HEAD (c);
424 while (i < len)
425 {
426 c = (*readbyte) (-1, readcharfun);
427 if (c < 0 || ! TRAILING_CODE_P (c))
428 {
429 while (--i > 1)
430 (*readbyte) (buf[i], readcharfun);
431 return BYTE8_TO_CHAR (buf[0]);
432 }
433 buf[i++] = c;
434 }
435 return STRING_CHAR (buf);
436 }
437
438 439
440
441 static void
442 unreadchar (readcharfun, c)
443 Lisp_Object readcharfun;
444 int c;
445 {
446 readchar_count--;
447 if (c == -1)
448 449
450 ;
451 else if (BUFFERP (readcharfun))
452 {
453 struct buffer *b = XBUFFER (readcharfun);
454 int bytepos = BUF_PT_BYTE (b);
455
456 BUF_PT (b)--;
457 if (! NILP (b->enable_multibyte_characters))
458 BUF_DEC_POS (b, bytepos);
459 else
460 bytepos--;
461
462 BUF_PT_BYTE (b) = bytepos;
463 }
464 else if (MARKERP (readcharfun))
465 {
466 struct buffer *b = XMARKER (readcharfun)->buffer;
467 int bytepos = XMARKER (readcharfun)->bytepos;
468
469 XMARKER (readcharfun)->charpos--;
470 if (! NILP (b->enable_multibyte_characters))
471 BUF_DEC_POS (b, bytepos);
472 else
473 bytepos--;
474
475 XMARKER (readcharfun)->bytepos = bytepos;
476 }
477 else if (STRINGP (readcharfun))
478 {
479 read_from_string_index--;
480 read_from_string_index_byte
481 = string_char_to_byte (readcharfun, read_from_string_index);
482 }
483 else if (CONSP (readcharfun))
484 {
485 unread_char = c;
486 }
487 else if (EQ (readcharfun, Qlambda))
488 {
489 unread_char = c;
490 }
491 else if (EQ (readcharfun, Qget_file_char)
492 || EQ (readcharfun, Qget_emacs_mule_file_char))
493 {
494 if (load_each_byte)
495 {
496 BLOCK_INPUT;
497 ungetc (c, instream);
498 UNBLOCK_INPUT;
499 }
500 else
501 unread_char = c;
502 }
503 else
504 call1 (readcharfun, make_number (c));
505 }
506
507 static int
508 readbyte_for_lambda (c, readcharfun)
509 int c;
510 Lisp_Object readcharfun;
511 {
512 return read_bytecode_char (c >= 0);
513 }
514
515
516 static int
517 readbyte_from_file (c, readcharfun)
518 int c;
519 Lisp_Object readcharfun;
520 {
521 if (c >= 0)
522 {
523 BLOCK_INPUT;
524 ungetc (c, instream);
525 UNBLOCK_INPUT;
526 return 0;
527 }
528
529 BLOCK_INPUT;
530 c = getc (instream);
531
532 #ifdef EINTR
533
534 while (c == EOF && ferror (instream) && errno == EINTR)
535 {
536 UNBLOCK_INPUT;
537 QUIT;
538 BLOCK_INPUT;
539 clearerr (instream);
540 c = getc (instream);
541 }
542 #endif
543
544 UNBLOCK_INPUT;
545
546 return (c == EOF ? -1 : c);
547 }
548
549 static int
550 readbyte_from_string (c, readcharfun)
551 int c;
552 Lisp_Object readcharfun;
553 {
554 Lisp_Object string = XCAR (readcharfun);
555
556 if (c >= 0)
557 {
558 read_from_string_index--;
559 read_from_string_index_byte
560 = string_char_to_byte (string, read_from_string_index);
561 }
562
563 if (read_from_string_index >= read_from_string_limit)
564 c = -1;
565 else
566 FETCH_STRING_CHAR_ADVANCE (c, string,
567 read_from_string_index,
568 read_from_string_index_byte);
569 return c;
570 }
571
572
573 574 575
576
577 extern char emacs_mule_bytes[256];
578
579 static int
580 read_emacs_mule_char (c, readbyte, readcharfun)
581 int c;
582 int (*readbyte) P_ ((int, Lisp_Object));
583 Lisp_Object readcharfun;
584 {
585
586 unsigned char buf[4];
587 int len = emacs_mule_bytes[c];
588 struct charset *charset;
589 int i;
590 unsigned code;
591
592 if (len == 1)
593
594 return BYTE8_TO_CHAR (c);
595
596 i = 0;
597 buf[i++] = c;
598 while (i < len)
599 {
600 c = (*readbyte) (-1, readcharfun);
601 if (c < 0xA0)
602 {
603 while (--i > 1)
604 (*readbyte) (buf[i], readcharfun);
605 return BYTE8_TO_CHAR (buf[0]);
606 }
607 buf[i++] = c;
608 }
609
610 if (len == 2)
611 {
612 charset = emacs_mule_charset[buf[0]];
613 code = buf[1] & 0x7F;
614 }
615 else if (len == 3)
616 {
617 if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
618 || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
619 {
620 charset = emacs_mule_charset[buf[1]];
621 code = buf[2] & 0x7F;
622 }
623 else
624 {
625 charset = emacs_mule_charset[buf[0]];
626 code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
627 }
628 }
629 else
630 {
631 charset = emacs_mule_charset[buf[1]];
632 code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
633 }
634 c = DECODE_CHAR (charset, code);
635 if (c < 0)
636 Fsignal (Qinvalid_read_syntax,
637 Fcons (build_string ("invalid multibyte form"), Qnil));
638 return c;
639 }
640
641
642 static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
643 Lisp_Object));
644 static Lisp_Object read0 P_ ((Lisp_Object));
645 static Lisp_Object read1 P_ ((Lisp_Object, int *, int));
646
647 static Lisp_Object read_list P_ ((int, Lisp_Object));
648 static Lisp_Object read_vector P_ ((Lisp_Object, int));
649
650 static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
651 Lisp_Object));
652 static void substitute_object_in_subtree P_ ((Lisp_Object,
653 Lisp_Object));
654 static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
655
656
657
658
659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678
679
680 Lisp_Object
681 read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
682 input_method, seconds)
683 int no_switch_frame, ascii_required, error_nonascii, input_method;
684 Lisp_Object seconds;
685 {
686 Lisp_Object val, delayed_switch_frame;
687 EMACS_TIME end_time;
688
689 #ifdef HAVE_WINDOW_SYSTEM
690 if (display_hourglass_p)
691 cancel_hourglass ();
692 #endif
693
694 delayed_switch_frame = Qnil;
695
696
697 if (NUMBERP (seconds))
698 {
699 EMACS_TIME wait_time;
700 int sec, usec;
701 double duration = extract_float (seconds);
702
703 sec = (int) duration;
704 usec = (duration - sec) * 1000000;
705 EMACS_GET_TIME (end_time);
706 EMACS_SET_SECS_USECS (wait_time, sec, usec);
707 EMACS_ADD_TIME (end_time, end_time, wait_time);
708 }
709
710
711 retry:
712 do
713 val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
714 NUMBERP (seconds) ? &end_time : NULL);
715 while (INTEGERP (val) && XINT (val) == -2);
716
717 if (BUFFERP (val))
718 goto retry;
719
720 721 722 723 724
725 if (no_switch_frame
726 && EVENT_HAS_PARAMETERS (val)
727 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
728 {
729 delayed_switch_frame = val;
730 goto retry;
731 }
732
733 if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
734 {
735
736 if (SYMBOLP (val))
737 {
738 Lisp_Object tem, tem1;
739 tem = Fget (val, Qevent_symbol_element_mask);
740 if (!NILP (tem))
741 {
742 tem1 = Fget (Fcar (tem), Qascii_character);
743 744
745 if (!NILP (tem1))
746 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
747 }
748 }
749
750
751 if (!INTEGERP (val))
752 {
753 if (error_nonascii)
754 {
755 Vunread_command_events = Fcons (val, Qnil);
756 error ("Non-character input-event");
757 }
758 else
759 goto retry;
760 }
761 }
762
763 if (! NILP (delayed_switch_frame))
764 unread_switch_frame = delayed_switch_frame;
765
766 #if 0
767
768 #ifdef HAVE_WINDOW_SYSTEM
769 if (display_hourglass_p)
770 start_hourglass ();
771 #endif
772
773 #endif
774
775 return val;
776 }
777
778 DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
779 doc: 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 )
799 (prompt, inherit_input_method, seconds)
800 Lisp_Object prompt, inherit_input_method, seconds;
801 {
802 Lisp_Object val;
803
804 if (! NILP (prompt))
805 message_with_string ("%s", prompt, 0);
806 val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
807
808 return (NILP (val) ? Qnil
809 : make_number (char_resolve_modifier_mask (XINT (val))));
810 }
811
812 DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
813 doc: 814 815 816 817 818 819 820 821 )
822 (prompt, inherit_input_method, seconds)
823 Lisp_Object prompt, inherit_input_method, seconds;
824 {
825 if (! NILP (prompt))
826 message_with_string ("%s", prompt, 0);
827 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
828 }
829
830 DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
831 doc: 832 833 834 835 836 837 838 839 840 841 842 843 )
844 (prompt, inherit_input_method, seconds)
845 Lisp_Object prompt, inherit_input_method, seconds;
846 {
847 Lisp_Object val;
848
849 if (! NILP (prompt))
850 message_with_string ("%s", prompt, 0);
851
852 val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
853
854 return (NILP (val) ? Qnil
855 : make_number (char_resolve_modifier_mask (XINT (val))));
856 }
857
858 DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
859 doc: )
860 ()
861 {
862 register Lisp_Object val;
863 BLOCK_INPUT;
864 XSETINT (val, getc (instream));
865 UNBLOCK_INPUT;
866 return val;
867 }
868
869
870
871 872 873 874 875
876
877 static int
878 safe_to_load_p (fd)
879 int fd;
880 {
881 char buf[512];
882 int nbytes, i;
883 int safe_p = 1;
884 int version = 1;
885
886 887
888 nbytes = emacs_read (fd, buf, sizeof buf - 1);
889 if (nbytes > 0)
890 {
891 buf[nbytes] = '\0';
892
893 894
895 for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
896 if (i == 4)
897 version = buf[i];
898
899 if (i == nbytes
900 || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
901 buf + i) < 0)
902 safe_p = 0;
903 }
904 if (safe_p)
905 safe_p = version;
906
907 lseek (fd, 0, SEEK_SET);
908 return safe_p;
909 }
910
911
912 913
914
915 static Lisp_Object
916 record_load_unwind (old)
917 Lisp_Object old;
918 {
919 return Vloads_in_progress = old;
920 }
921
922
923
924 static Lisp_Object
925 load_error_handler (data)
926 Lisp_Object data;
927 {
928 return Qnil;
929 }
930
931 static Lisp_Object
932 load_warn_old_style_backquotes (file)
933 Lisp_Object file;
934 {
935 if (!NILP (Vold_style_backquotes))
936 {
937 Lisp_Object args[2];
938 args[0] = build_string ("Loading `%s': old-style backquotes detected!");
939 args[1] = file;
940 Fmessage (2, args);
941 }
942 return Qnil;
943 }
944
945 DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
946 doc: 947 948 )
949 ()
950 {
951 Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
952 while (CONSP (suffixes))
953 {
954 Lisp_Object exts = Vload_file_rep_suffixes;
955 suffix = XCAR (suffixes);
956 suffixes = XCDR (suffixes);
957 while (CONSP (exts))
958 {
959 ext = XCAR (exts);
960 exts = XCDR (exts);
961 lst = Fcons (concat2 (suffix, ext), lst);
962 }
963 }
964 return Fnreverse (lst);
965 }
966
967 DEFUN ("load", Fload, Sload, 1, 5, 0,
968 doc: 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 )
1004 (file, noerror, nomessage, nosuffix, must_suffix)
1005 Lisp_Object file, noerror, nomessage, nosuffix, must_suffix;
1006 {
1007 register FILE *stream;
1008 register int fd = -1;
1009 int count = SPECPDL_INDEX ();
1010 struct gcpro gcpro1, gcpro2, gcpro3;
1011 Lisp_Object found, efound, hist_file_name;
1012
1013 int newer = 0;
1014
1015 int compiled = 0;
1016 Lisp_Object handler;
1017 int safe_p = 1;
1018 char *fmode = "r";
1019 Lisp_Object tmp[2];
1020 int version;
1021
1022 #ifdef DOS_NT
1023 fmode = "rt";
1024 #endif
1025
1026 CHECK_STRING (file);
1027
1028
1029 1030 1031 1032
1033
1034 1035 1036 1037 1038 1039 1040 1041
1042 if (! NILP (noerror))
1043 {
1044 file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
1045 Qt, load_error_handler);
1046 if (NILP (file))
1047 return Qnil;
1048 }
1049 else
1050 file = Fsubstitute_in_file_name (file);
1051
1052
1053 1054
1055 if (SCHARS (file) > 0)
1056 {
1057 int size = SBYTES (file);
1058
1059 found = Qnil;
1060 GCPRO2 (file, found);
1061
1062 if (! NILP (must_suffix))
1063 {
1064
1065 if (size > 3
1066 && !strcmp (SDATA (file) + size - 3, ".el"))
1067 must_suffix = Qnil;
1068 else if (size > 4
1069 && !strcmp (SDATA (file) + size - 4, ".elc"))
1070 must_suffix = Qnil;
1071 1072
1073 else if (! NILP (Ffile_name_directory (file)))
1074 must_suffix = Qnil;
1075 }
1076
1077 fd = openp (Vload_path, file,
1078 (!NILP (nosuffix) ? Qnil
1079 : !NILP (must_suffix) ? Fget_load_suffixes ()
1080 : Fappend (2, (tmp[0] = Fget_load_suffixes (),
1081 tmp[1] = Vload_file_rep_suffixes,
1082 tmp))),
1083 &found, Qnil);
1084 UNGCPRO;
1085 }
1086
1087 if (fd == -1)
1088 {
1089 if (NILP (noerror))
1090 xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
1091 return Qnil;
1092 }
1093
1094
1095 if (EQ (Qt, Vuser_init_file))
1096 Vuser_init_file = found;
1097
1098
1099 if (fd == -2)
1100 {
1101 if (NILP (Fequal (found, file)))
1102 1103 1104
1105 handler = Ffind_file_name_handler (found, Qt);
1106 else
1107 handler = Ffind_file_name_handler (found, Qload);
1108 if (! NILP (handler))
1109 return call5 (handler, Qload, found, noerror, nomessage, Qt);
1110 }
1111
1112 1113 1114 1115 1116 1117 1118 1119 1120 1121
1122 {
1123 int count = 0;
1124 Lisp_Object tem;
1125 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
1126 if (!NILP (Fequal (found, XCAR (tem))) && (++count > 3))
1127 {
1128 if (fd >= 0)
1129 emacs_close (fd);
1130 signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
1131 }
1132 record_unwind_protect (record_load_unwind, Vloads_in_progress);
1133 Vloads_in_progress = Fcons (found, Vloads_in_progress);
1134 }
1135
1136
1137 hist_file_name = (! NILP (Vpurify_flag)
1138 ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
1139 tmp[1] = Ffile_name_nondirectory (found),
1140 tmp))
1141 : found) ;
1142
1143 version = -1;
1144
1145
1146 specbind (Qold_style_backquotes, Qnil);
1147 record_unwind_protect (load_warn_old_style_backquotes, file);
1148
1149 if (!bcmp (SDATA (found) + SBYTES (found) - 4,
1150 ".elc", 4)
1151 || (fd >= 0 && (version = safe_to_load_p (fd)) > 0))
1152 1153
1154 {
1155 if (fd != -2)
1156 {
1157 struct stat s1, s2;
1158 int result;
1159
1160 GCPRO3 (file, found, hist_file_name);
1161
1162 if (version < 0
1163 && ! (version = safe_to_load_p (fd)))
1164 {
1165 safe_p = 0;
1166 if (!load_dangerous_libraries)
1167 {
1168 if (fd >= 0)
1169 emacs_close (fd);
1170 error ("File `%s' was not compiled in Emacs",
1171 SDATA (found));
1172 }
1173 else if (!NILP (nomessage) && !force_load_messages)
1174 message_with_string ("File `%s' not compiled in Emacs", found, 1);
1175 }
1176
1177 compiled = 1;
1178
1179 efound = ENCODE_FILE (found);
1180
1181 #ifdef DOS_NT
1182 fmode = "rb";
1183 #endif
1184 stat ((char *)SDATA (efound), &s1);
1185 SSET (efound, SBYTES (efound) - 1, 0);
1186 result = stat ((char *)SDATA (efound), &s2);
1187 SSET (efound, SBYTES (efound) - 1, 'c');
1188
1189 if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
1190 {
1191
1192 newer = 1;
1193
1194
1195 if (!NILP (nomessage) && !force_load_messages)
1196 {
1197 Lisp_Object msg_file;
1198 msg_file = Fsubstring (found, make_number (0), make_number (-1));
1199 message_with_string ("Source file `%s' newer than byte-compiled file",
1200 msg_file, 1);
1201 }
1202 }
1203 UNGCPRO;
1204 }
1205 }
1206 else
1207 {
1208
1209 if (!NILP (Vload_source_file_function))
1210 {
1211 Lisp_Object val;
1212
1213 if (fd >= 0)
1214 emacs_close (fd);
1215 val = call4 (Vload_source_file_function, found, hist_file_name,
1216 NILP (noerror) ? Qnil : Qt,
1217 (NILP (nomessage) || force_load_messages) ? Qnil : Qt);
1218 return unbind_to (count, val);
1219 }
1220 }
1221
1222 GCPRO3 (file, found, hist_file_name);
1223
1224 #ifdef WINDOWSNT
1225 emacs_close (fd);
1226 efound = ENCODE_FILE (found);
1227 stream = fopen ((char *) SDATA (efound), fmode);
1228 #else
1229 stream = fdopen (fd, fmode);
1230 #endif
1231 if (stream == 0)
1232 {
1233 emacs_close (fd);
1234 error ("Failure to create stdio stream for %s", SDATA (file));
1235 }
1236
1237 if (! NILP (Vpurify_flag))
1238 Vpreloaded_file_list = Fcons (Fpurecopy(file), Vpreloaded_file_list);
1239
1240 if (NILP (nomessage) || force_load_messages)
1241 {
1242 if (!safe_p)
1243 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1244 file, 1);
1245 else if (!compiled)
1246 message_with_string ("Loading %s (source)...", file, 1);
1247 else if (newer)
1248 message_with_string ("Loading %s (compiled; note, source file is newer)...",
1249 file, 1);
1250 else
1251 message_with_string ("Loading %s...", file, 1);
1252 }
1253
1254 record_unwind_protect (load_unwind, make_save_value (stream, 0));
1255 record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
1256 specbind (Qload_file_name, found);
1257 specbind (Qinhibit_file_name_operation, Qnil);
1258 load_descriptor_list
1259 = Fcons (make_number (fileno (stream)), load_descriptor_list);
1260 specbind (Qload_in_progress, Qt);
1261 if (! version || version >= 22)
1262 readevalloop (Qget_file_char, stream, hist_file_name,
1263 Feval, 0, Qnil, Qnil, Qnil, Qnil);
1264 else
1265 {
1266 1267
1268 specbind (Qload_force_doc_strings, Qt);
1269 readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval,
1270 0, Qnil, Qnil, Qnil, Qnil);
1271 }
1272 unbind_to (count, Qnil);
1273
1274
1275 if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
1276 call1 (Qdo_after_load_evaluation, hist_file_name) ;
1277
1278 UNGCPRO;
1279
1280 xfree (saved_doc_string);
1281 saved_doc_string = 0;
1282 saved_doc_string_size = 0;
1283
1284 xfree (prev_saved_doc_string);
1285 prev_saved_doc_string = 0;
1286 prev_saved_doc_string_size = 0;
1287
1288 if (!noninteractive && (NILP (nomessage) || force_load_messages))
1289 {
1290 if (!safe_p)
1291 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1292 file, 1);
1293 else if (!compiled)
1294 message_with_string ("Loading %s (source)...done", file, 1);
1295 else if (newer)
1296 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1297 file, 1);
1298 else
1299 message_with_string ("Loading %s...done", file, 1);
1300 }
1301
1302 return Qt;
1303 }
1304
1305 static Lisp_Object
1306 load_unwind (arg)
1307 Lisp_Object arg;
1308 {
1309 FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
1310 if (stream != NULL)
1311 {
1312 BLOCK_INPUT;
1313 fclose (stream);
1314 UNBLOCK_INPUT;
1315 }
1316 return Qnil;
1317 }
1318
1319 static Lisp_Object
1320 load_descriptor_unwind (oldlist)
1321 Lisp_Object oldlist;
1322 {
1323 load_descriptor_list = oldlist;
1324 return Qnil;
1325 }
1326
1327 1328
1329
1330 void
1331 close_load_descs ()
1332 {
1333 #ifndef WINDOWSNT
1334 Lisp_Object tail;
1335 for (tail = load_descriptor_list; CONSP (tail); tail = XCDR (tail))
1336 emacs_close (XFASTINT (XCAR (tail)));
1337 #endif
1338 }
1339
1340 static int
1341 complete_filename_p (pathname)
1342 Lisp_Object pathname;
1343 {
1344 register const unsigned char *s = SDATA (pathname);
1345 return (IS_DIRECTORY_SEP (s[0])
1346 || (SCHARS (pathname) > 2
1347 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])));
1348 }
1349
1350 DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
1351 doc: 1352 1353 1354 1355 1356 1357 )
1358 (filename, path, suffixes, predicate)
1359 Lisp_Object filename, path, suffixes, predicate;
1360 {
1361 Lisp_Object file;
1362 int fd = openp (path, filename, suffixes, &file, predicate);
1363 if (NILP (predicate) && fd > 0)
1364 close (fd);
1365 return file;
1366 }
1367
1368
1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387
1388
1389 int
1390 openp (path, str, suffixes, storeptr, predicate)
1391 Lisp_Object path, str;
1392 Lisp_Object suffixes;
1393 Lisp_Object *storeptr;
1394 Lisp_Object predicate;
1395 {
1396 register int fd;
1397 int fn_size = 100;
1398 char buf[100];
1399 register char *fn = buf;
1400 int absolute = 0;
1401 int want_size;
1402 Lisp_Object filename;
1403 struct stat st;
1404 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1405 Lisp_Object string, tail, encoded_fn;
1406 int max_suffix_len = 0;
1407
1408 CHECK_STRING (str);
1409
1410 for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
1411 {
1412 CHECK_STRING_CAR (tail);
1413 max_suffix_len = max (max_suffix_len,
1414 SBYTES (XCAR (tail)));
1415 }
1416
1417 string = filename = encoded_fn = Qnil;
1418 GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
1419
1420 if (storeptr)
1421 *storeptr = Qnil;
1422
1423 if (complete_filename_p (str))
1424 absolute = 1;
1425
1426 for (; CONSP (path); path = XCDR (path))
1427 {
1428 filename = Fexpand_file_name (str, XCAR (path));
1429 if (!complete_filename_p (filename))
1430
1431 1432
1433 {
1434 filename = Fexpand_file_name (filename, current_buffer->directory);
1435 if (!complete_filename_p (filename))
1436
1437 continue;
1438 }
1439
1440 1441
1442 want_size = max_suffix_len + SBYTES (filename) + 1;
1443 if (fn_size < want_size)
1444 fn = (char *) alloca (fn_size = 100 + want_size);
1445
1446
1447 for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
1448 CONSP (tail); tail = XCDR (tail))
1449 {
1450 int lsuffix = SBYTES (XCAR (tail));
1451 Lisp_Object handler;
1452 int exists;
1453
1454 1455
1456 if (SCHARS (filename) > 2
1457 && SREF (filename, 0) == '/'
1458 && SREF (filename, 1) == ':')
1459 {
1460 strncpy (fn, SDATA (filename) + 2,
1461 SBYTES (filename) - 2);
1462 fn[SBYTES (filename) - 2] = 0;
1463 }
1464 else
1465 {
1466 strncpy (fn, SDATA (filename),
1467 SBYTES (filename));
1468 fn[SBYTES (filename)] = 0;
1469 }
1470
1471 if (lsuffix != 0)
1472 strncat (fn, SDATA (XCAR (tail)), lsuffix);
1473
1474
1475 1476 1477 1478 1479 1480 1481
1482 string = build_string (fn);
1483 handler = Ffind_file_name_handler (string, Qfile_exists_p);
1484 if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
1485 {
1486 if (NILP (predicate))
1487 exists = !NILP (Ffile_readable_p (string));
1488 else
1489 exists = !NILP (call1 (predicate, string));
1490 if (exists && !NILP (Ffile_directory_p (string)))
1491 exists = 0;
1492
1493 if (exists)
1494 {
1495
1496 if (storeptr)
1497 *storeptr = string;
1498 UNGCPRO;
1499 return -2;
1500 }
1501 }
1502 else
1503 {
1504 const char *pfn;
1505
1506 encoded_fn = ENCODE_FILE (string);
1507 pfn = SDATA (encoded_fn);
1508 exists = (stat (pfn, &st) >= 0
1509 && (st.st_mode & S_IFMT) != S_IFDIR);
1510 if (exists)
1511 {
1512
1513 if (NATNUMP (predicate))
1514 fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
1515 else
1516 fd = emacs_open (pfn, O_RDONLY, 0);
1517
1518 if (fd >= 0)
1519 {
1520
1521 if (storeptr)
1522 *storeptr = string;
1523 UNGCPRO;
1524 return fd;
1525 }
1526 }
1527 }
1528 }
1529 if (absolute)
1530 break;
1531 }
1532
1533 UNGCPRO;
1534 return -1;
1535 }
1536
1537
1538 1539 1540 1541 1542 1543
1544
1545 static void
1546 build_load_history (filename, entire)
1547 Lisp_Object filename;
1548 int entire;
1549 {
1550 register Lisp_Object tail, prev, newelt;
1551 register Lisp_Object tem, tem2;
1552 register int foundit = 0;
1553
1554 tail = Vload_history;
1555 prev = Qnil;
1556
1557 while (CONSP (tail))
1558 {
1559 tem = XCAR (tail);
1560
1561
1562 if (!NILP (Fequal (filename, Fcar (tem))))
1563 {
1564 foundit = 1;
1565
1566
1567 if (entire)
1568 {
1569 if (NILP (prev))
1570 Vload_history = XCDR (tail);
1571 else
1572 Fsetcdr (prev, XCDR (tail));
1573 }
1574
1575
1576 else
1577 {
1578 tem2 = Vcurrent_load_list;
1579
1580 while (CONSP (tem2))
1581 {
1582 newelt = XCAR (tem2);
1583
1584 if (NILP (Fmember (newelt, tem)))
1585 Fsetcar (tail, Fcons (XCAR (tem),
1586 Fcons (newelt, XCDR (tem))));
1587
1588 tem2 = XCDR (tem2);
1589 QUIT;
1590 }
1591 }
1592 }
1593 else
1594 prev = tail;
1595 tail = XCDR (tail);
1596 QUIT;
1597 }
1598
1599 1600 1601
1602 if (entire || !foundit)
1603 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1604 Vload_history);
1605 }
1606
1607 Lisp_Object
1608 unreadpure (junk)
1609 Lisp_Object junk;
1610 {
1611 read_pure = 0;
1612 return Qnil;
1613 }
1614
1615 static Lisp_Object
1616 readevalloop_1 (old)
1617 Lisp_Object old;
1618 {
1619 load_convert_to_unibyte = ! NILP (old);
1620 return Qnil;
1621 }
1622
1623 1624
1625
1626 static void
1627 end_of_file_error ()
1628 {
1629 if (STRINGP (Vload_file_name))
1630 xsignal1 (Qend_of_file, Vload_file_name);
1631
1632 xsignal0 (Qend_of_file);
1633 }
1634
1635 1636 1637 1638 1639 1640
1641
1642 static void
1643 readevalloop (readcharfun, stream, sourcename, evalfun,
1644 printflag, unibyte, readfun, start, end)
1645 Lisp_Object readcharfun;
1646 FILE *stream;
1647 Lisp_Object sourcename;
1648 Lisp_Object (*evalfun) ();
1649 int printflag;
1650 Lisp_Object unibyte, readfun;
1651 Lisp_Object start, end;
1652 {
1653 register int c;
1654 register Lisp_Object val;
1655 int count = SPECPDL_INDEX ();
1656 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1657 struct buffer *b = 0;
1658 int continue_reading_p;
1659
1660 int whole_buffer = 0;
1661
1662 int first_sexp = 1;
1663
1664 if (MARKERP (readcharfun))
1665 {
1666 if (NILP (start))
1667 start = readcharfun;
1668 }
1669
1670 if (BUFFERP (readcharfun))
1671 b = XBUFFER (readcharfun);
1672 else if (MARKERP (readcharfun))
1673 b = XMARKER (readcharfun)->buffer;
1674
1675
1676 if (! NILP (start) && !b)
1677 abort ();
1678
1679 specbind (Qstandard_input, readcharfun);
1680 specbind (Qcurrent_load_list, Qnil);
1681 record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
1682 load_convert_to_unibyte = !NILP (unibyte);
1683
1684 GCPRO4 (sourcename, readfun, start, end);
1685
1686
1687 if (NILP (Vpurify_flag)
1688 && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
1689 && !NILP (Ffboundp (Qfile_truename)))
1690 sourcename = call1 (Qfile_truename, sourcename) ;
1691
1692 LOADHIST_ATTACH (sourcename);
1693
1694 continue_reading_p = 1;
1695 while (continue_reading_p)
1696 {
1697 int count1 = SPECPDL_INDEX ();
1698
1699 if (b != 0 && NILP (b->name))
1700 error ("Reading from killed buffer");
1701
1702 if (!NILP (start))
1703 {
1704
1705 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1706 set_buffer_internal (b);
1707
1708
1709 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1710
1711 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1712
1713
1714
1715 Fgoto_char (start);
1716 if (!NILP (end))
1717 Fnarrow_to_region (make_number (BEGV), end);
1718
1719 1720
1721 if (INTEGERP (end))
1722 end = Fpoint_max_marker ();
1723 }
1724
1725 1726
1727 if (b && first_sexp)
1728 whole_buffer = (PT == BEG && ZV == Z);
1729
1730 instream = stream;
1731 read_next:
1732 c = READCHAR;
1733 if (c == ';')
1734 {
1735 while ((c = READCHAR) != '\n' && c != -1);
1736 goto read_next;
1737 }
1738 if (c < 0)
1739 {
1740 unbind_to (count1, Qnil);
1741 break;
1742 }
1743
1744
1745 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
1746 || c == 0x8a0)
1747 goto read_next;
1748
1749 if (!NILP (Vpurify_flag) && c == '(')
1750 {
1751 record_unwind_protect (unreadpure, Qnil);
1752 val = read_list (-1, readcharfun);
1753 }
1754 else
1755 {
1756 UNREAD (c);
1757 read_objects = Qnil;
1758 if (!NILP (readfun))
1759 {
1760 val = call1 (readfun, readcharfun);
1761
1762 1763 1764
1765 if (BUFFERP (readcharfun))
1766 {
1767 struct buffer *b = XBUFFER (readcharfun);
1768 if (BUF_PT (b) == BUF_ZV (b))
1769 continue_reading_p = 0;
1770 }
1771 }
1772 else if (! NILP (Vload_read_function))
1773 val = call1 (Vload_read_function, readcharfun);
1774 else
1775 val = read_internal_start (readcharfun, Qnil, Qnil);
1776 }
1777
1778 if (!NILP (start) && continue_reading_p)
1779 start = Fpoint_marker ();
1780
1781
1782 unbind_to (count1, Qnil);
1783
1784
1785 val = (*evalfun) (val);
1786
1787 if (printflag)
1788 {
1789 Vvalues = Fcons (val, Vvalues);
1790 if (EQ (Vstandard_output, Qt))
1791 Fprin1 (val, Qnil);
1792 else
1793 Fprint (val, Qnil);
1794 }
1795
1796 first_sexp = 0;
1797 }
1798
1799 build_load_history (sourcename,
1800 stream || whole_buffer);
1801
1802 UNGCPRO;
1803
1804 unbind_to (count, Qnil);
1805 }
1806
1807 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
1808 doc: 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 )
1821 (buffer, printflag, filename, unibyte, do_allow_print)
1822 Lisp_Object buffer, printflag, filename, unibyte, do_allow_print;
1823 {
1824 int count = SPECPDL_INDEX ();
1825 Lisp_Object tem, buf;
1826
1827 if (NILP (buffer))
1828 buf = Fcurrent_buffer ();
1829 else
1830 buf = Fget_buffer (buffer);
1831 if (NILP (buf))
1832 error ("No such buffer");
1833
1834 if (NILP (printflag) && NILP (do_allow_print))
1835 tem = Qsymbolp;
1836 else
1837 tem = printflag;
1838
1839 if (NILP (filename))
1840 filename = XBUFFER (buf)->filename;
1841
1842 specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
1843 specbind (Qstandard_output, tem);
1844 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1845 BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1846 readevalloop (buf, 0, filename, Feval,
1847 !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
1848 unbind_to (count, Qnil);
1849
1850 return Qnil;
1851 }
1852
1853 DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
1854 doc: 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 )
1865 (start, end, printflag, read_function)
1866 Lisp_Object start, end, printflag, read_function;
1867 {
1868 int count = SPECPDL_INDEX ();
1869 Lisp_Object tem, cbuf;
1870
1871 cbuf = Fcurrent_buffer ();
1872
1873 if (NILP (printflag))
1874 tem = Qsymbolp;
1875 else
1876 tem = printflag;
1877 specbind (Qstandard_output, tem);
1878 specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
1879
1880
1881 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
1882 !NILP (printflag), Qnil, read_function,
1883 start, end);
1884
1885 return unbind_to (count, Qnil);
1886 }
1887
1888
1889 DEFUN ("read", Fread, Sread, 0, 1, 0,
1890 doc: 1891 1892 1893 1894 1895 1896 1897 1898 1899 )
1900 (stream)
1901 Lisp_Object stream;
1902 {
1903 if (NILP (stream))
1904 stream = Vstandard_input;
1905 if (EQ (stream, Qt))
1906 stream = Qread_char;
1907 if (EQ (stream, Qread_char))
1908 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
1909
1910 return read_internal_start (stream, Qnil, Qnil);
1911 }
1912
1913 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
1914 doc: 1915 1916 1917 )
1918 (string, start, end)
1919 Lisp_Object string, start, end;
1920 {
1921 Lisp_Object ret;
1922 CHECK_STRING (string);
1923
1924 ret = read_internal_start (string, start, end);
1925 return Fcons (ret, make_number (read_from_string_index));
1926 }
1927
1928 1929
1930 static Lisp_Object
1931 read_internal_start (stream, start, end)
1932 Lisp_Object stream;
1933 Lisp_Object start;
1934 Lisp_Object end;
1935 {
1936 Lisp_Object retval;
1937
1938 readchar_count = 0;
1939 new_backquote_flag = 0;
1940 read_objects = Qnil;
1941 if (EQ (Vread_with_symbol_positions, Qt)
1942 || EQ (Vread_with_symbol_positions, stream))
1943 Vread_symbol_positions_list = Qnil;
1944
1945 if (STRINGP (stream)
1946 || ((CONSP (stream) && STRINGP (XCAR (stream)))))
1947 {
1948 int startval, endval;
1949 Lisp_Object string;
1950
1951 if (STRINGP (stream))
1952 string = stream;
1953 else
1954 string = XCAR (stream);
1955
1956 if (NILP (end))
1957 endval = SCHARS (string);
1958 else
1959 {
1960 CHECK_NUMBER (end);
1961 endval = XINT (end);
1962 if (endval < 0 || endval > SCHARS (string))
1963 args_out_of_range (string, end);
1964 }
1965
1966 if (NILP (start))
1967 startval = 0;
1968 else
1969 {
1970 CHECK_NUMBER (start);
1971 startval = XINT (start);
1972 if (startval < 0 || startval > endval)
1973 args_out_of_range (string, start);
1974 }
1975 read_from_string_index = startval;
1976 read_from_string_index_byte = string_char_to_byte (string, startval);
1977 read_from_string_limit = endval;
1978 }
1979
1980 retval = read0 (stream);
1981 if (EQ (Vread_with_symbol_positions, Qt)
1982 || EQ (Vread_with_symbol_positions, stream))
1983 Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
1984 return retval;
1985 }
1986
1987
1988 1989
1990
1991 static void
1992 invalid_syntax (s, n)
1993 const char *s;
1994 int n;
1995 {
1996 if (!n)
1997 n = strlen (s);
1998 xsignal1 (Qinvalid_read_syntax, make_string (s, n));
1999 }
2000
2001
2002 2003
2004
2005 static Lisp_Object
2006 read0 (readcharfun)
2007 Lisp_Object readcharfun;
2008 {
2009 register Lisp_Object val;
2010 int c;
2011
2012 val = read1 (readcharfun, &c, 0);
2013 if (!c)
2014 return val;
2015
2016 xsignal1 (Qinvalid_read_syntax,
2017 Fmake_string (make_number (1), make_number (c)));
2018 }
2019
2020 static int read_buffer_size;
2021 static char *read_buffer;
2022
2023 2024
2025
2026 static int
2027 read_escape (readcharfun, stringp)
2028 Lisp_Object readcharfun;
2029 int stringp;
2030 {
2031 register int c = READCHAR;
2032 2033
2034 int unicode_hex_count = 4;
2035
2036 switch (c)
2037 {
2038 case -1:
2039 end_of_file_error ();
2040
2041 case 'a':
2042 return '\007';
2043 case 'b':
2044 return '\b';
2045 case 'd':
2046 return 0177;
2047 case 'e':
2048 return 033;
2049 case 'f':
2050 return '\f';
2051 case 'n':
2052 return '\n';
2053 case 'r':
2054 return '\r';
2055 case 't':
2056 return '\t';
2057 case 'v':
2058 return '\v';
2059 case '\n':
2060 return -1;
2061 case ' ':
2062 if (stringp)
2063 return -1;
2064 return ' ';
2065
2066 case 'M':
2067 c = READCHAR;
2068 if (c != '-')
2069 error ("Invalid escape character syntax");
2070 c = READCHAR;
2071 if (c == '\\')
2072 c = read_escape (readcharfun, 0);
2073 return c | meta_modifier;
2074
2075 case 'S':
2076 c = READCHAR;
2077 if (c != '-')
2078 error ("Invalid escape character syntax");
2079 c = READCHAR;
2080 if (c == '\\')
2081 c = read_escape (readcharfun, 0);
2082 return c | shift_modifier;
2083
2084 case 'H':
2085 c = READCHAR;
2086 if (c != '-')
2087 error ("Invalid escape character syntax");
2088 c = READCHAR;
2089 if (c == '\\')
2090 c = read_escape (readcharfun, 0);
2091 return c | hyper_modifier;
2092
2093 case 'A':
2094 c = READCHAR;
2095 if (c != '-')
2096 error ("Invalid escape character syntax");
2097 c = READCHAR;
2098 if (c == '\\')
2099 c = read_escape (readcharfun, 0);
2100 return c | alt_modifier;
2101
2102 case 's':
2103 c = READCHAR;
2104 if (stringp || c != '-')
2105 {
2106 UNREAD (c);
2107 return ' ';
2108 }
2109 c = READCHAR;
2110 if (c == '\\')
2111 c = read_escape (readcharfun, 0);
2112 return c | super_modifier;
2113
2114 case 'C':
2115 c = READCHAR;
2116 if (c != '-')
2117 error ("Invalid escape character syntax");
2118 case '^':
2119 c = READCHAR;
2120 if (c == '\\')
2121 c = read_escape (readcharfun, 0);
2122 if ((c & ~CHAR_MODIFIER_MASK) == '?')
2123 return 0177 | (c & CHAR_MODIFIER_MASK);
2124 else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
2125 return c | ctrl_modifier;
2126 2127
2128 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
2129 return (c & (037 | ~0177));
2130 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
2131 return (c & (037 | ~0177));
2132 else
2133 return c | ctrl_modifier;
2134
2135 case '0':
2136 case '1':
2137 case '2':
2138 case '3':
2139 case '4':
2140 case '5':
2141 case '6':
2142 case '7':
2143
2144 {
2145 register int i = c - '0';
2146 register int count = 0;
2147 while (++count < 3)
2148 {
2149 if ((c = READCHAR) >= '0' && c <= '7')
2150 {
2151 i *= 8;
2152 i += c - '0';
2153 }
2154 else
2155 {
2156 UNREAD (c);
2157 break;
2158 }
2159 }
2160
2161 if (i >= 0x80 && i < 0x100)
2162 i = BYTE8_TO_CHAR (i);
2163 return i;
2164 }
2165
2166 case 'x':
2167
2168 {
2169 int i = 0;
2170 int count = 0;
2171 while (1)
2172 {
2173 c = READCHAR;
2174 if (c >= '0' && c <= '9')
2175 {
2176 i *= 16;
2177 i += c - '0';
2178 }
2179 else if ((c >= 'a' && c <= 'f')
2180 || (c >= 'A' && c <= 'F'))
2181 {
2182 i *= 16;
2183 if (c >= 'a' && c <= 'f')
2184 i += c - 'a' + 10;
2185 else
2186 i += c - 'A' + 10;
2187 }
2188 else
2189 {
2190 UNREAD (c);
2191 break;
2192 }
2193 count++;
2194 }
2195
2196 if (count < 3 && i >= 0x80)
2197 return BYTE8_TO_CHAR (i);
2198 return i;
2199 }
2200
2201 case 'U':
2202
2203 unicode_hex_count = 8;
2204 case 'u':
2205
2206 2207
2208 {
2209 unsigned int i = 0;
2210 int count = 0;
2211
2212 while (++count <= unicode_hex_count)
2213 {
2214 c = READCHAR;
2215 2216
2217 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
2218 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
2219 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
2220 else
2221 {
2222 error ("Non-hex digit used for Unicode escape");
2223 break;
2224 }
2225 }
2226 if (i > 0x10FFFF)
2227 error ("Non-Unicode character: 0x%x", i);
2228 return i;
2229 }
2230
2231 default:
2232 return c;
2233 }
2234 }
2235
2236 2237 2238 2239 2240
2241
2242 static Lisp_Object
2243 read_integer (readcharfun, radix)
2244 Lisp_Object readcharfun;
2245 int radix;
2246 {
2247 int ndigits = 0, invalid_p, c, sign = 0;
2248
2249 double number = 0;
2250
2251 if (radix < 2 || radix > 36)
2252 invalid_p = 1;
2253 else
2254 {
2255 number = ndigits = invalid_p = 0;
2256 sign = 1;
2257
2258 c = READCHAR;
2259 if (c == '-')
2260 {
2261 c = READCHAR;
2262 sign = -1;
2263 }
2264 else if (c == '+')
2265 c = READCHAR;
2266
2267 while (c >= 0)
2268 {
2269 int digit;
2270
2271 if (c >= '0' && c <= '9')
2272 digit = c - '0';
2273 else if (c >= 'a' && c <= 'z')
2274 digit = c - 'a' + 10;
2275 else if (c >= 'A' && c <= 'Z')
2276 digit = c - 'A' + 10;
2277 else
2278 {
2279 UNREAD (c);
2280 break;
2281 }
2282
2283 if (digit < 0 || digit >= radix)
2284 invalid_p = 1;
2285
2286 number = radix * number + digit;
2287 ++ndigits;
2288 c = READCHAR;
2289 }
2290 }
2291
2292 if (ndigits == 0 || invalid_p)
2293 {
2294 char buf[50];
2295 sprintf (buf, "integer, radix %d", radix);
2296 invalid_syntax (buf, 0);
2297 }
2298
2299 return make_fixnum_or_float (sign * number);
2300 }
2301
2302
2303 2304 2305 2306 2307
2308
2309 static Lisp_Object
2310 read1 (readcharfun, pch, first_in_list)
2311 register Lisp_Object readcharfun;
2312 int *pch;
2313 int first_in_list;
2314 {
2315 register int c;
2316 int uninterned_symbol = 0;
2317 int multibyte;
2318
2319 *pch = 0;
2320 load_each_byte = 0;
2321
2322 retry:
2323
2324 c = READCHAR_REPORT_MULTIBYTE (&multibyte);
2325 if (c < 0)
2326 end_of_file_error ();
2327
2328 switch (c)
2329 {
2330 case '(':
2331 return read_list (0, readcharfun);
2332
2333 case '[':
2334 return read_vector (readcharfun, 0);
2335
2336 case ')':
2337 case ']':
2338 {
2339 *pch = c;
2340 return Qnil;
2341 }
2342
2343 case '#':
2344 c = READCHAR;
2345 if (c == 's')
2346 {
2347 c = READCHAR;
2348 if (c == '(')
2349 {
2350 2351 2352
2353 Lisp_Object tmp = read_list (0, readcharfun);
2354 Lisp_Object head = CAR_SAFE (tmp);
2355 Lisp_Object data = Qnil;
2356 Lisp_Object val = Qnil;
2357 2358
2359 Lisp_Object params[10];
2360 Lisp_Object ht;
2361 Lisp_Object key = Qnil;
2362 int param_count = 0;
2363
2364 if (!EQ (head, Qhash_table))
2365 error ("Invalid extended read marker at head of #s list "
2366 "(only hash-table allowed)");
2367
2368 tmp = CDR_SAFE (tmp);
2369
2370
2371 params[param_count] = QCsize;
2372 params[param_count+1] = Fplist_get (tmp, Qsize);
2373 if (!NILP (params[param_count+1]))
2374 param_count+=2;
2375
2376 params[param_count] = QCtest;
2377 params[param_count+1] = Fplist_get (tmp, Qtest);
2378 if (!NILP (params[param_count+1]))
2379 param_count+=2;
2380
2381 params[param_count] = QCweakness;
2382 params[param_count+1] = Fplist_get (tmp, Qweakness);
2383 if (!NILP (params[param_count+1]))
2384 param_count+=2;
2385
2386 params[param_count] = QCrehash_size;
2387 params[param_count+1] = Fplist_get (tmp, Qrehash_size);
2388 if (!NILP (params[param_count+1]))
2389 param_count+=2;
2390
2391 params[param_count] = QCrehash_threshold;
2392 params[param_count+1] = Fplist_get (tmp, Qrehash_threshold);
2393 if (!NILP (params[param_count+1]))
2394 param_count+=2;
2395
2396
2397 data = Fplist_get (tmp, Qdata);
2398
2399
2400 ht = Fmake_hash_table (param_count, params);
2401
2402 while (CONSP (data))
2403 {
2404 key = XCAR (data);
2405 data = XCDR (data);
2406 if (!CONSP (data))
2407 error ("Odd number of elements in hashtable data");
2408 val = XCAR (data);
2409 data = XCDR (data);
2410 Fputhash (key, val, ht);
2411 }
2412
2413 return ht;
2414 }
2415 }
2416 if (c == '^')
2417 {
2418 c = READCHAR;
2419 if (c == '[')
2420 {
2421 Lisp_Object tmp;
2422 tmp = read_vector (readcharfun, 0);
2423 if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS)
2424 error ("Invalid size char-table");
2425 XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
2426 return tmp;
2427 }
2428 else if (c == '^')
2429 {
2430 c = READCHAR;
2431 if (c == '[')
2432 {
2433 Lisp_Object tmp;
2434 int depth, size;
2435
2436 tmp = read_vector (readcharfun, 0);
2437 if (!INTEGERP (AREF (tmp, 0)))
2438 error ("Invalid depth in char-table");
2439 depth = XINT (AREF (tmp, 0));
2440 if (depth < 1 || depth > 3)
2441 error ("Invalid depth in char-table");
2442 size = XVECTOR (tmp)->size - 2;
2443 if (chartab_size [depth] != size)
2444 error ("Invalid size char-table");
2445 XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
2446 return tmp;
2447 }
2448 invalid_syntax ("#^^", 3);
2449 }
2450 invalid_syntax ("#^", 2);
2451 }
2452 if (c == '&')
2453 {
2454 Lisp_Object length;
2455 length = read1 (readcharfun, pch, first_in_list);
2456 c = READCHAR;
2457 if (c == '"')
2458 {
2459 Lisp_Object tmp, val;
2460 int size_in_chars
2461 = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
2462 / BOOL_VECTOR_BITS_PER_CHAR);
2463
2464 UNREAD (c);
2465 tmp = read1 (readcharfun, pch, first_in_list);
2466 if (STRING_MULTIBYTE (tmp)
2467 || (size_in_chars != SCHARS (tmp)
2468 2469 2470 2471
2472 && ! (XFASTINT (length)
2473 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
2474 invalid_syntax ("#&...", 5);
2475
2476 val = Fmake_bool_vector (length, Qnil);
2477 bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
2478 size_in_chars);
2479
2480 if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
2481 XBOOL_VECTOR (val)->data[size_in_chars - 1]
2482 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2483 return val;
2484 }
2485 invalid_syntax ("#&...", 5);
2486 }
2487 if (c == '[')
2488 {
2489 2490
2491 Lisp_Object tmp;
2492 tmp = read_vector (readcharfun, 1);
2493 return Fmake_byte_code (XVECTOR (tmp)->size,
2494 XVECTOR (tmp)->contents);
2495 }
2496 if (c == '(')
2497 {
2498 Lisp_Object tmp;
2499 struct gcpro gcpro1;
2500 int ch;
2501
2502
2503 tmp = read1 (readcharfun, &ch, 0);
2504 if (ch != 0 || !STRINGP (tmp))
2505 invalid_syntax ("#", 1);
2506 GCPRO1 (tmp);
2507
2508 while (1)
2509 {
2510 Lisp_Object beg, end, plist;
2511
2512 beg = read1 (readcharfun, &ch, 0);
2513 end = plist = Qnil;
2514 if (ch == ')')
2515 break;
2516 if (ch == 0)
2517 end = read1 (readcharfun, &ch, 0);
2518 if (ch == 0)
2519 plist = read1 (readcharfun, &ch, 0);
2520 if (ch)
2521 invalid_syntax ("Invalid string property list", 0);
2522 Fset_text_properties (beg, end, plist, tmp);
2523 }
2524 UNGCPRO;
2525 return tmp;
2526 }
2527
2528 2529 2530
2531 if (c == '@')
2532 {
2533 int i, nskip = 0;
2534
2535 load_each_byte = 1;
2536
2537 while ((c = READCHAR) >= 0
2538 && c >= '0' && c <= '9')
2539 {
2540 nskip *= 10;
2541 nskip += c - '0';
2542 }
2543 if (c >= 0)
2544 UNREAD (c);
2545
2546 if (load_force_doc_strings
2547 && (EQ (readcharfun, Qget_file_char)
2548 || EQ (readcharfun, Qget_emacs_mule_file_char)))
2549 {
2550 2551 2552
2553
2554 2555
2556 {
2557 char *temp = saved_doc_string;
2558 int temp_size = saved_doc_string_size;
2559 file_offset temp_pos = saved_doc_string_position;
2560 int temp_len = saved_doc_string_length;
2561
2562 saved_doc_string = prev_saved_doc_string;
2563 saved_doc_string_size = prev_saved_doc_string_size;
2564 saved_doc_string_position = prev_saved_doc_string_position;
2565 saved_doc_string_length = prev_saved_doc_string_length;
2566
2567 prev_saved_doc_string = temp;
2568 prev_saved_doc_string_size = temp_size;
2569 prev_saved_doc_string_position = temp_pos;
2570 prev_saved_doc_string_length = temp_len;
2571 }
2572
2573 if (saved_doc_string_size == 0)
2574 {
2575 saved_doc_string_size = nskip + 100;
2576 saved_doc_string = (char *) xmalloc (saved_doc_string_size);
2577 }
2578 if (nskip > saved_doc_string_size)
2579 {
2580 saved_doc_string_size = nskip + 100;
2581 saved_doc_string = (char *) xrealloc (saved_doc_string,
2582 saved_doc_string_size);
2583 }
2584
2585 saved_doc_string_position = file_tell (instream);
2586
2587
2588 for (i = 0; i < nskip && c >= 0; i++)
2589 saved_doc_string[i] = c = READCHAR;
2590
2591 saved_doc_string_length = i;
2592 }
2593 else
2594 {
2595
2596 for (i = 0; i < nskip && c >= 0; i++)
2597 c = READCHAR;
2598 }
2599
2600 load_each_byte = 0;
2601 goto retry;
2602 }
2603 if (c == '!')
2604 {
2605 2606
2607 while (c != '\n' && c >= 0)
2608 c = READCHAR;
2609 goto retry;
2610 }
2611 if (c == '$')
2612 return Vload_file_name;
2613 if (c == '\'')
2614 return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
2615
2616 if (c == ':')
2617 {
2618 uninterned_symbol = 1;
2619 c = READCHAR;
2620 goto default_label;
2621 }
2622
2623 if (c >= '0' && c <= '9')
2624 {
2625 int n = 0;
2626 Lisp_Object tem;
2627
2628
2629 while (c >= '0' && c <= '9')
2630 {
2631 n *= 10;
2632 n += c - '0';
2633 c = READCHAR;
2634 }
2635
2636 if (c == '=' && !NILP (Vread_circle))
2637 {
2638
2639 Lisp_Object placeholder;
2640 Lisp_Object cell;
2641
2642 placeholder = Fcons (Qnil, Qnil);
2643 cell = Fcons (make_number (n), placeholder);
2644 read_objects = Fcons (cell, read_objects);
2645
2646
2647 tem = read0 (readcharfun);
2648
2649
2650 substitute_object_in_subtree (tem, placeholder);
2651
2652
2653 Fsetcdr (cell, tem);
2654
2655 return tem;
2656 }
2657
2658 if (c == '#' && !NILP (Vread_circle))
2659 {
2660 tem = Fassq (make_number (n), read_objects);
2661 if (CONSP (tem))
2662 return XCDR (tem);
2663
2664 }
2665 else if (c == 'r' || c == 'R')
2666 return read_integer (readcharfun, n);
2667
2668
2669 }
2670 else if (c == 'x' || c == 'X')
2671 return read_integer (readcharfun, 16);
2672 else if (c == 'o' || c == 'O')
2673 return read_integer (readcharfun, 8);
2674 else if (c == 'b' || c == 'B')
2675 return read_integer (readcharfun, 2);
2676
2677 UNREAD (c);
2678 invalid_syntax ("#", 1);
2679
2680 case ';':
2681 while ((c = READCHAR) >= 0 && c != '\n');
2682 goto retry;
2683
2684 case '\'':
2685 {
2686 return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
2687 }
2688
2689 case '`':
2690 if (first_in_list)
2691 {
2692 Vold_style_backquotes = Qt;
2693 goto default_label;
2694 }
2695 else
2696 {
2697 Lisp_Object value;
2698
2699 new_backquote_flag++;
2700 value = read0 (readcharfun);
2701 new_backquote_flag--;
2702
2703 return Fcons (Qbackquote, Fcons (value, Qnil));
2704 }
2705
2706 case ',':
2707 if (new_backquote_flag)
2708 {
2709 Lisp_Object comma_type = Qnil;
2710 Lisp_Object value;
2711 int ch = READCHAR;
2712
2713 if (ch == '@')
2714 comma_type = Qcomma_at;
2715 else if (ch == '.')
2716 comma_type = Qcomma_dot;
2717 else
2718 {
2719 if (ch >= 0) UNREAD (ch);
2720 comma_type = Qcomma;
2721 }
2722
2723 new_backquote_flag--;
2724 value = read0 (readcharfun);
2725 new_backquote_flag++;
2726 return Fcons (comma_type, Fcons (value, Qnil));
2727 }
2728 else
2729 {
2730 Vold_style_backquotes = Qt;
2731 goto default_label;
2732 }
2733
2734 case '?':
2735 {
2736 int modifiers;
2737 int next_char;
2738 int ok;
2739
2740 c = READCHAR;
2741 if (c < 0)
2742 end_of_file_error ();
2743
2744 2745 2746 2747
2748 if (c == ' ' || c == '\t')
2749 return make_number (c);
2750
2751 if (c == '\\')
2752 c = read_escape (readcharfun, 0);
2753 modifiers = c & CHAR_MODIFIER_MASK;
2754 c &= ~CHAR_MODIFIER_MASK;
2755 if (CHAR_BYTE8_P (c))
2756 c = CHAR_TO_BYTE8 (c);
2757 c |= modifiers;
2758
2759 next_char = READCHAR;
2760 if (next_char == '.')
2761 {
2762
2763 int next_next_char = READCHAR;
2764 UNREAD (next_next_char);
2765
2766 ok = (next_next_char <= 040
2767 || (next_next_char < 0200
2768 && (index ("\"';([#?", next_next_char)
2769 || (!first_in_list && next_next_char == '`')
2770 || (new_backquote_flag && next_next_char == ','))));
2771 }
2772 else
2773 {
2774 ok = (next_char <= 040
2775 || (next_char < 0200
2776 && (index ("\"';()[]#?", next_char)
2777 || (!first_in_list && next_char == '`')
2778 || (new_backquote_flag && next_char == ','))));
2779 }
2780 UNREAD (next_char);
2781 if (ok)
2782 return make_number (c);
2783
2784 invalid_syntax ("?", 1);
2785 }
2786
2787 case '"':
2788 {
2789 char *p = read_buffer;
2790 char *end = read_buffer + read_buffer_size;
2791 register int c;
2792 2793
2794 int force_multibyte = 0;
2795 2796
2797 int force_singlebyte = 0;
2798 int cancel = 0;
2799 int nchars = 0;
2800
2801 while ((c = READCHAR) >= 0
2802 && c != '\"')
2803 {
2804 if (end - p < MAX_MULTIBYTE_LENGTH)
2805 {
2806 int offset = p - read_buffer;
2807 read_buffer = (char *) xrealloc (read_buffer,
2808 read_buffer_size *= 2);
2809 p = read_buffer + offset;
2810 end = read_buffer + read_buffer_size;
2811 }
2812
2813 if (c == '\\')
2814 {
2815 int modifiers;
2816
2817 c = read_escape (readcharfun, 1);
2818
2819
2820 if (c == -1)
2821 {
2822 if (p == read_buffer)
2823 cancel = 1;
2824 continue;
2825 }
2826
2827 modifiers = c & CHAR_MODIFIER_MASK;
2828 c = c & ~CHAR_MODIFIER_MASK;
2829
2830 if (CHAR_BYTE8_P (c))
2831 force_singlebyte = 1;
2832 else if (! ASCII_CHAR_P (c))
2833 force_multibyte = 1;
2834 else
2835 {
2836
2837 if (modifiers == CHAR_CTL)
2838 {
2839 if (c == ' ')
2840 c = 0, modifiers = 0;
2841 else if (c == '?')
2842 c = 127, modifiers = 0;
2843 }
2844 if (modifiers & CHAR_SHIFT)
2845 {
2846
2847 if (c >= 'A' && c <= 'Z')
2848 modifiers &= ~CHAR_SHIFT;
2849 else if (c >= 'a' && c <= 'z')
2850 c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
2851 }
2852
2853 if (modifiers & CHAR_META)
2854 {
2855 2856
2857 modifiers &= ~CHAR_META;
2858 c = BYTE8_TO_CHAR (c | 0x80);
2859 force_singlebyte = 1;
2860 }
2861 }
2862
2863
2864 if (modifiers)
2865 error ("Invalid modifier in string");
2866 p += CHAR_STRING (c, (unsigned char *) p);
2867 }
2868 else
2869 {
2870 p += CHAR_STRING (c, (unsigned char *) p);
2871 if (CHAR_BYTE8_P (c))
2872 force_singlebyte = 1;
2873 else if (! ASCII_CHAR_P (c))
2874 force_multibyte = 1;
2875 }
2876 nchars++;
2877 }
2878
2879 if (c < 0)
2880 end_of_file_error ();
2881
2882 2883 2884
2885 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
2886 return make_number (0);
2887
2888 if (force_multibyte)
2889
2890 ;
2891 else if (force_singlebyte)
2892 {
2893 nchars = str_as_unibyte (read_buffer, p - read_buffer);
2894 p = read_buffer + nchars;
2895 }
2896 else
2897
2898 ;
2899
2900 2901 2902 2903
2904
2905 if (read_pure)
2906 return make_pure_string (read_buffer, nchars, p - read_buffer,
2907 (force_multibyte
2908 || (p - read_buffer != nchars)));
2909 return make_specified_string (read_buffer, nchars, p - read_buffer,
2910 (force_multibyte
2911 || (p - read_buffer != nchars)));
2912 }
2913
2914 case '.':
2915 {
2916 int next_char = READCHAR;
2917 UNREAD (next_char);
2918
2919 if (next_char <= 040
2920 || (next_char < 0200
2921 && (index ("\"';([#?", next_char)
2922 || (!first_in_list && next_char == '`')
2923 || (new_backquote_flag && next_char == ','))))
2924 {
2925 *pch = c;
2926 return Qnil;
2927 }
2928
2929 2930 2931
2932 }
2933 default:
2934 default_label:
2935 if (c <= 040) goto retry;
2936 if (c == 0x8a0)
2937 goto retry;
2938 {
2939 char *p = read_buffer;
2940 int quoted = 0;
2941
2942 {
2943 char *end = read_buffer + read_buffer_size;
2944
2945 while (c > 040
2946 && c != 0x8a0
2947 && (c >= 0200
2948 || (!index ("\"';()[]#", c)
2949 && !(!first_in_list && c == '`')
2950 && !(new_backquote_flag && c == ','))))
2951 {
2952 if (end - p < MAX_MULTIBYTE_LENGTH)
2953 {
2954 int offset = p - read_buffer;
2955 read_buffer = (char *) xrealloc (read_buffer,
2956 read_buffer_size *= 2);
2957 p = read_buffer + offset;
2958 end = read_buffer + read_buffer_size;
2959 }
2960
2961 if (c == '\\')
2962 {
2963 c = READCHAR;
2964 if (c == -1)
2965 end_of_file_error ();
2966 quoted = 1;
2967 }
2968
2969 if (multibyte)
2970 p += CHAR_STRING (c, p);
2971 else
2972 *p++ = c;
2973 c = READCHAR;
2974 }
2975
2976 if (p == end)
2977 {
2978 int offset = p - read_buffer;
2979 read_buffer = (char *) xrealloc (read_buffer,
2980 read_buffer_size *= 2);
2981 p = read_buffer + offset;
2982 end = read_buffer + read_buffer_size;
2983 }
2984 *p = 0;
2985 if (c >= 0)
2986 UNREAD (c);
2987 }
2988
2989 if (!quoted && !uninterned_symbol)
2990 {
2991 register char *p1;
2992 p1 = read_buffer;
2993 if (*p1 == '+' || *p1 == '-') p1++;
2994
2995 if (p1 != p)
2996 {
2997 while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
2998
2999 if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
3000 if (p1 == p)
3001
3002 {
3003 if (p1[-1] == '.')
3004 p1[-1] = '\0';
3005 {
3006
3007 char *endptr = NULL;
3008 EMACS_INT n = (errno = 0,
3009 strtol (read_buffer, &endptr, 10));
3010 if (errno == ERANGE && endptr)
3011 {
3012 Lisp_Object args
3013 = Fcons (make_string (read_buffer,
3014 endptr - read_buffer),
3015 Qnil);
3016 xsignal (Qoverflow_error, args);
3017 }
3018 return make_fixnum_or_float (n);
3019 }
3020 }
3021 }
3022 if (isfloat_string (read_buffer, 0))
3023 {
3024 3025 3026
3027 double zero = 0.0;
3028
3029 double value;
3030
3031 3032 3033 3034
3035 int negative = read_buffer[0] == '-';
3036
3037 3038
3039 switch (p[-1])
3040 {
3041 case 'F':
3042 value = 1.0 / zero;
3043 break;
3044 case 'N':
3045 value = zero / zero;
3046
3047
3048
3049 {
3050 int i;
3051 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
3052
3053 u_data.d = value;
3054 u_minus_zero.d = - 0.0;
3055 for (i = 0; i < sizeof (double); i++)
3056 if (u_data.c[i] & u_minus_zero.c[i])
3057 {
3058 value = - value;
3059 break;
3060 }
3061 }
3062
3063 break;
3064 default:
3065 value = atof (read_buffer + negative);
3066 break;
3067 }
3068
3069 return make_float (negative ? - value : value);
3070 }
3071 }
3072 {
3073 Lisp_Object name, result;
3074 EMACS_INT nbytes = p - read_buffer;
3075 EMACS_INT nchars
3076 = (multibyte ? multibyte_chars_in_text (read_buffer, nbytes)
3077 : nbytes);
3078
3079 if (uninterned_symbol && ! NILP (Vpurify_flag))
3080 name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
3081 else
3082 name = make_specified_string (read_buffer, nchars, nbytes,multibyte);
3083 result = (uninterned_symbol ? Fmake_symbol (name)
3084 : Fintern (name, Qnil));
3085
3086 if (EQ (Vread_with_symbol_positions, Qt)
3087 || EQ (Vread_with_symbol_positions, readcharfun))
3088 Vread_symbol_positions_list =
3089 3090 3091
3092 Fcons (Fcons (result,
3093 make_number (readchar_count
3094 - XFASTINT (Flength (Fsymbol_name (result))))),
3095 Vread_symbol_positions_list);
3096 return result;
3097 }
3098 }
3099 }
3100 }
3101
3102
3103
3104 static Lisp_Object seen_list;
3105
3106 static void
3107 substitute_object_in_subtree (object, placeholder)
3108 Lisp_Object object;
3109 Lisp_Object placeholder;
3110 {
3111 Lisp_Object check_object;
3112
3113
3114 seen_list = Qnil;
3115
3116
3117 check_object
3118 = substitute_object_recurse (object, placeholder, object);
3119
3120
3121 seen_list = Qnil;
3122
3123 3124
3125 if (!EQ (check_object, object))
3126 error ("Unexpected mutation error in reader");
3127 }
3128
3129
3130 #define SUBSTITUTE(get_val, set_val) \
3131 do { \
3132 Lisp_Object old_value = get_val; \
3133 Lisp_Object true_value \
3134 = substitute_object_recurse (object, placeholder, \
3135 old_value); \
3136 \
3137 if (!EQ (old_value, true_value)) \
3138 { \
3139 set_val; \
3140 } \
3141 } while (0)
3142
3143 static Lisp_Object
3144 substitute_object_recurse (object, placeholder, subtree)
3145 Lisp_Object object;
3146 Lisp_Object placeholder;
3147 Lisp_Object subtree;
3148 {
3149
3150 if (EQ (placeholder, subtree))
3151 return object;
3152
3153
3154 if (!EQ (Qnil, Fmemq (subtree, seen_list)))
3155 return subtree;
3156
3157 3158 3159 3160
3161 if (!EQ (Qnil, Frassq (subtree, read_objects)))
3162 seen_list = Fcons (subtree, seen_list);
3163
3164 3165
3166 switch (XTYPE (subtree))
3167 {
3168 case Lisp_Vectorlike:
3169 {
3170 int i, length = 0;
3171 if (BOOL_VECTOR_P (subtree))
3172 return subtree;
3173 else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
3174 || COMPILEDP (subtree))
3175 length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK;
3176 else if (VECTORP (subtree))
3177 length = ASIZE (subtree);
3178 else
3179 3180 3181 3182
3183 wrong_type_argument (Qsequencep, subtree);
3184
3185 for (i = 0; i < length; i++)
3186 SUBSTITUTE (AREF (subtree, i),
3187 ASET (subtree, i, true_value));
3188 return subtree;
3189 }
3190
3191 case Lisp_Cons:
3192 {
3193 SUBSTITUTE (XCAR (subtree),
3194 XSETCAR (subtree, true_value));
3195 SUBSTITUTE (XCDR (subtree),
3196 XSETCDR (subtree, true_value));
3197 return subtree;
3198 }
3199
3200 case Lisp_String:
3201 {
3202 3203
3204
3205 INTERVAL root_interval = STRING_INTERVALS (subtree);
3206 Lisp_Object arg = Fcons (object, placeholder);
3207
3208 traverse_intervals_noorder (root_interval,
3209 &substitute_in_interval, arg);
3210
3211 return subtree;
3212 }
3213
3214
3215 default:
3216 return subtree;
3217 }
3218 }
3219
3220
3221 static void
3222 substitute_in_interval (interval, arg)
3223 INTERVAL interval;
3224 Lisp_Object arg;
3225 {
3226 Lisp_Object object = Fcar (arg);
3227 Lisp_Object placeholder = Fcdr (arg);
3228
3229 SUBSTITUTE (interval->plist, interval->plist = true_value);
3230 }
3231
3232
3233 #define LEAD_INT 1
3234 #define DOT_CHAR 2
3235 #define TRAIL_INT 4
3236 #define E_CHAR 8
3237 #define EXP_INT 16
3238
3239 int
3240 isfloat_string (cp, ignore_trailing)
3241 register char *cp;
3242 int ignore_trailing;
3243 {
3244 register int state;
3245
3246 char *start = cp;
3247
3248 state = 0;
3249 if (*cp == '+' || *cp == '-')
3250 cp++;
3251
3252 if (*cp >= '0' && *cp <= '9')
3253 {
3254 state |= LEAD_INT;
3255 while (*cp >= '0' && *cp <= '9')
3256 cp++;
3257 }
3258 if (*cp == '.')
3259 {
3260 state |= DOT_CHAR;
3261 cp++;
3262 }
3263 if (*cp >= '0' && *cp <= '9')
3264 {
3265 state |= TRAIL_INT;
3266 while (*cp >= '0' && *cp <= '9')
3267 cp++;
3268 }
3269 if (*cp == 'e' || *cp == 'E')
3270 {
3271 state |= E_CHAR;
3272 cp++;
3273 if (*cp == '+' || *cp == '-')
3274 cp++;
3275 }
3276
3277 if (*cp >= '0' && *cp <= '9')
3278 {
3279 state |= EXP_INT;
3280 while (*cp >= '0' && *cp <= '9')
3281 cp++;
3282 }
3283 else if (cp == start)
3284 ;
3285 else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
3286 {
3287 state |= EXP_INT;
3288 cp += 3;
3289 }
3290 else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
3291 {
3292 state |= EXP_INT;
3293 cp += 3;
3294 }
3295
3296 return ((ignore_trailing
3297 || (*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f'))
3298 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
3299 || state == (DOT_CHAR|TRAIL_INT)
3300 || state == (LEAD_INT|E_CHAR|EXP_INT)
3301 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
3302 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
3303 }
3304
3305
3306 static Lisp_Object
3307 read_vector (readcharfun, bytecodeflag)
3308 Lisp_Object readcharfun;
3309 int bytecodeflag;
3310 {
3311 register int i;
3312 register int size;
3313 register Lisp_Object *ptr;
3314 register Lisp_Object tem, item, vector;
3315 register struct Lisp_Cons *otem;
3316 Lisp_Object len;
3317
3318 tem = read_list (1, readcharfun);
3319 len = Flength (tem);
3320 vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
3321
3322 size = XVECTOR (vector)->size;
3323 ptr = XVECTOR (vector)->contents;
3324 for (i = 0; i < size; i++)
3325 {
3326 item = Fcar (tem);
3327 3328 3329 3330
3331 if (bytecodeflag && load_force_doc_strings)
3332 {
3333 if (i == COMPILED_BYTECODE)
3334 {
3335 if (!STRINGP (item))
3336 error ("Invalid byte code");
3337
3338 3339 3340
3341 ptr[COMPILED_CONSTANTS] = item;
3342 item = Qnil;
3343 }
3344 else if (i == COMPILED_CONSTANTS)
3345 {
3346 Lisp_Object bytestr = ptr[COMPILED_CONSTANTS];
3347
3348 if (NILP (item))
3349 {
3350 3351 3352
3353 STRING_SET_CHARS (bytestr, SBYTES (bytestr));
3354 STRING_SET_UNIBYTE (bytestr);
3355
3356 item = Fread (Fcons (bytestr, readcharfun));
3357 if (!CONSP (item))
3358 error ("Invalid byte code");
3359
3360 otem = XCONS (item);
3361 bytestr = XCAR (item);
3362 item = XCDR (item);
3363 free_cons (otem);
3364 }
3365
3366
3367 ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
3368 }
3369 else if (i == COMPILED_DOC_STRING
3370 && STRINGP (item)
3371 && ! STRING_MULTIBYTE (item))
3372 {
3373 if (EQ (readcharfun, Qget_emacs_mule_file_char))
3374 item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
3375 else
3376 item = Fstring_as_multibyte (item);
3377 }
3378 }
3379 ptr[i] = read_pure ? Fpurecopy (item) : item;
3380 otem = XCONS (tem);
3381 tem = Fcdr (tem);
3382 free_cons (otem);
3383 }
3384 return vector;
3385 }
3386
3387 3388 3389
3390
3391 static Lisp_Object
3392 read_list (flag, readcharfun)
3393 int flag;
3394 register Lisp_Object readcharfun;
3395 {
3396 3397 3398
3399 int defunflag = flag < 0 ? -1 : 0;
3400 Lisp_Object val, tail;
3401 register Lisp_Object elt, tem;
3402 struct gcpro gcpro1, gcpro2;
3403 3404 3405
3406 int doc_reference = 0;
3407
3408
3409 int first_in_list = flag <= 0;
3410
3411 val = Qnil;
3412 tail = Qnil;
3413
3414 while (1)
3415 {
3416 int ch;
3417 GCPRO2 (val, tail);
3418 elt = read1 (readcharfun, &ch, first_in_list);
3419 UNGCPRO;
3420
3421 first_in_list = 0;
3422
3423
3424 if (EQ (elt, Vload_file_name)
3425 && ! NILP (elt)
3426 && !NILP (Vpurify_flag))
3427 {
3428 if (NILP (Vdoc_file_name))
3429 3430 3431 3432
3433 doc_reference = 1;
3434 else
3435 3436 3437 3438 3439
3440 elt = concat2 (build_string ("../lisp/"),
3441 Ffile_name_nondirectory (elt));
3442 }
3443 else if (EQ (elt, Vload_file_name)
3444 && ! NILP (elt)
3445 && load_force_doc_strings)
3446 doc_reference = 2;
3447
3448 if (ch)
3449 {
3450 if (flag > 0)
3451 {
3452 if (ch == ']')
3453 return val;
3454 invalid_syntax (") or . in a vector", 18);
3455 }
3456 if (ch == ')')
3457 return val;
3458 if (ch == '.')
3459 {
3460 GCPRO2 (val, tail);
3461 if (!NILP (tail))
3462 XSETCDR (tail, read0 (readcharfun));
3463 else
3464 val = read0 (readcharfun);
3465 read1 (readcharfun, &ch, 0);
3466 UNGCPRO;
3467 if (ch == ')')
3468 {
3469 if (doc_reference == 1)
3470 return make_number (0);
3471 if (doc_reference == 2)
3472 {
3473 3474 3475 3476 3477 3478 3479 3480 3481
3482
3483 int pos = XINT (XCDR (val));
3484
3485 if (pos < 0) pos = -pos;
3486 if (pos >= saved_doc_string_position
3487 && pos < (saved_doc_string_position
3488 + saved_doc_string_length))
3489 {
3490 int start = pos - saved_doc_string_position;
3491 int from, to;
3492
3493 3494 3495
3496 for (from = start, to = start;
3497 saved_doc_string[from] != 037;)
3498 {
3499 int c = saved_doc_string[from++];
3500 if (c == 1)
3501 {
3502 c = saved_doc_string[from++];
3503 if (c == 1)
3504 saved_doc_string[to++] = c;
3505 else if (c == '0')
3506 saved_doc_string[to++] = 0;
3507 else if (c == '_')
3508 saved_doc_string[to++] = 037;
3509 }
3510 else
3511 saved_doc_string[to++] = c;
3512 }
3513
3514 return make_unibyte_string (saved_doc_string + start,
3515 to - start);
3516 }
3517
3518 else if (pos >= prev_saved_doc_string_position
3519 && pos < (prev_saved_doc_string_position
3520 + prev_saved_doc_string_length))
3521 {
3522 int start = pos - prev_saved_doc_string_position;
3523 int from, to;
3524
3525 3526 3527
3528 for (from = start, to = start;
3529 prev_saved_doc_string[from] != 037;)
3530 {
3531 int c = prev_saved_doc_string[from++];
3532 if (c == 1)
3533 {
3534 c = prev_saved_doc_string[from++];
3535 if (c == 1)
3536 prev_saved_doc_string[to++] = c;
3537 else if (c == '0')
3538 prev_saved_doc_string[to++] = 0;
3539 else if (c == '_')
3540 prev_saved_doc_string[to++] = 037;
3541 }
3542 else
3543 prev_saved_doc_string[to++] = c;
3544 }
3545
3546 return make_unibyte_string (prev_saved_doc_string
3547 + start,
3548 to - start);
3549 }
3550 else
3551 return get_doc_string (val, 1, 0);
3552 }
3553
3554 return val;
3555 }
3556 invalid_syntax (". in wrong context", 18);
3557 }
3558 invalid_syntax ("] in a list", 11);
3559 }
3560 tem = (read_pure && flag <= 0
3561 ? pure_cons (elt, Qnil)
3562 : Fcons (elt, Qnil));
3563 if (!NILP (tail))
3564 XSETCDR (tail, tem);
3565 else
3566 val = tem;
3567 tail = tem;
3568 if (defunflag < 0)
3569 defunflag = EQ (elt, Qdefun);
3570 else if (defunflag > 0)
3571 read_pure = 1;
3572 }
3573 }
3574
3575 Lisp_Object Vobarray;
3576 Lisp_Object initial_obarray;
3577
3578
3579
3580 int oblookup_last_bucket_number;
3581
3582 static int hash_string ();
3583
3584 3585
3586
3587 Lisp_Object
3588 check_obarray (obarray)
3589 Lisp_Object obarray;
3590 {
3591 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3592 {
3593
3594 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
3595 wrong_type_argument (Qvectorp, obarray);
3596 }
3597 return obarray;
3598 }
3599
3600 3601
3602
3603 Lisp_Object
3604 intern (str)
3605 const char *str;
3606 {
3607 Lisp_Object tem;
3608 int len = strlen (str);
3609 Lisp_Object obarray;
3610
3611 obarray = Vobarray;
3612 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3613 obarray = check_obarray (obarray);
3614 tem = oblookup (obarray, str, len, len);
3615 if (SYMBOLP (tem))
3616 return tem;
3617 return Fintern (make_string (str, len), obarray);
3618 }
3619
3620 Lisp_Object
3621 intern_c_string (const char *str)
3622 {
3623 Lisp_Object tem;
3624 int len = strlen (str);
3625 Lisp_Object obarray;
3626
3627 obarray = Vobarray;
3628 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3629 obarray = check_obarray (obarray);
3630 tem = oblookup (obarray, str, len, len);
3631 if (SYMBOLP (tem))
3632 return tem;
3633
3634 if (NILP (Vpurify_flag))
3635 3636 3637
3638 abort ();
3639
3640 return Fintern (make_pure_c_string (str), obarray);
3641 }
3642
3643
3644
3645 Lisp_Object
3646 make_symbol (str)
3647 char *str;
3648 {
3649 int len = strlen (str);
3650
3651 return Fmake_symbol ((!NILP (Vpurify_flag)
3652 ? make_pure_string (str, len, len, 0)
3653 : make_string (str, len)));
3654 }
3655
3656 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
3657 doc: 3658 3659 3660 )
3661 (string, obarray)
3662 Lisp_Object string, obarray;
3663 {
3664 register Lisp_Object tem, sym, *ptr;
3665
3666 if (NILP (obarray)) obarray = Vobarray;
3667 obarray = check_obarray (obarray);
3668
3669 CHECK_STRING (string);
3670
3671 tem = oblookup (obarray, SDATA (string),
3672 SCHARS (string),
3673 SBYTES (string));
3674 if (!INTEGERP (tem))
3675 return tem;
3676
3677 if (!NILP (Vpurify_flag))
3678 string = Fpurecopy (string);
3679 sym = Fmake_symbol (string);
3680
3681 if (EQ (obarray, initial_obarray))
3682 XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3683 else
3684 XSYMBOL (sym)->interned = SYMBOL_INTERNED;
3685
3686 if ((SREF (string, 0) == ':')
3687 && EQ (obarray, initial_obarray))
3688 {
3689 XSYMBOL (sym)->constant = 1;
3690 XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
3691 SET_SYMBOL_VAL (XSYMBOL (sym), sym);
3692 }
3693
3694 ptr = &XVECTOR (obarray)->contents[XINT (tem)];
3695 if (SYMBOLP (*ptr))
3696 XSYMBOL (sym)->next = XSYMBOL (*ptr);
3697 else
3698 XSYMBOL (sym)->next = 0;
3699 *ptr = sym;
3700 return sym;
3701 }
3702
3703 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
3704 doc: 3705 3706 3707 3708 )
3709 (name, obarray)
3710 Lisp_Object name, obarray;
3711 {
3712 register Lisp_Object tem, string;
3713
3714 if (NILP (obarray)) obarray = Vobarray;
3715 obarray = check_obarray (obarray);
3716
3717 if (!SYMBOLP (name))
3718 {
3719 CHECK_STRING (name);
3720 string = name;
3721 }
3722 else
3723 string = SYMBOL_NAME (name);
3724
3725 tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string));
3726 if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
3727 return Qnil;
3728 else
3729 return tem;
3730 }
3731
3732 DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
3733 doc: 3734 3735 3736 3737 )
3738 (name, obarray)
3739 Lisp_Object name, obarray;
3740 {
3741 register Lisp_Object string, tem;
3742 int hash;
3743
3744 if (NILP (obarray)) obarray = Vobarray;
3745 obarray = check_obarray (obarray);
3746
3747 if (SYMBOLP (name))
3748 string = SYMBOL_NAME (name);
3749 else
3750 {
3751 CHECK_STRING (name);
3752 string = name;
3753 }
3754
3755 tem = oblookup (obarray, SDATA (string),
3756 SCHARS (string),
3757 SBYTES (string));
3758 if (INTEGERP (tem))
3759 return Qnil;
3760
3761 if (SYMBOLP (name) && !EQ (name, tem))
3762 return Qnil;
3763
3764 3765 3766 3767
3768 3769
3770
3771 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
3772
3773 hash = oblookup_last_bucket_number;
3774
3775 if (EQ (XVECTOR (obarray)->contents[hash], tem))
3776 {
3777 if (XSYMBOL (tem)->next)
3778 XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
3779 else
3780 XSETINT (XVECTOR (obarray)->contents[hash], 0);
3781 }
3782 else
3783 {
3784 Lisp_Object tail, following;
3785
3786 for (tail = XVECTOR (obarray)->contents[hash];
3787 XSYMBOL (tail)->next;
3788 tail = following)
3789 {
3790 XSETSYMBOL (following, XSYMBOL (tail)->next);
3791 if (EQ (following, tem))
3792 {
3793 XSYMBOL (tail)->next = XSYMBOL (following)->next;
3794 break;
3795 }
3796 }
3797 }
3798
3799 return Qt;
3800 }
3801
3802 3803 3804 3805 3806
3807
3808 Lisp_Object
3809 oblookup (obarray, ptr, size, size_byte)
3810 Lisp_Object obarray;
3811 register const char *ptr;
3812 int size, size_byte;
3813 {
3814 int hash;
3815 int obsize;
3816 register Lisp_Object tail;
3817 Lisp_Object bucket, tem;
3818
3819 if (!VECTORP (obarray)
3820 || (obsize = XVECTOR (obarray)->size) == 0)
3821 {
3822 obarray = check_obarray (obarray);
3823 obsize = XVECTOR (obarray)->size;
3824 }
3825
3826 obsize &= ~ARRAY_MARK_FLAG;
3827 hash = hash_string (ptr, size_byte) % obsize;
3828 bucket = XVECTOR (obarray)->contents[hash];
3829 oblookup_last_bucket_number = hash;
3830 if (EQ (bucket, make_number (0)))
3831 ;
3832 else if (!SYMBOLP (bucket))
3833 error ("Bad data in guts of obarray");
3834 else
3835 for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
3836 {
3837 if (SBYTES (SYMBOL_NAME (tail)) == size_byte
3838 && SCHARS (SYMBOL_NAME (tail)) == size
3839 && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
3840 return tail;
3841 else if (XSYMBOL (tail)->next == 0)
3842 break;
3843 }
3844 XSETINT (tem, hash);
3845 return tem;
3846 }
3847
3848 static int
3849 hash_string (ptr, len)
3850 const unsigned char *ptr;
3851 int len;
3852 {
3853 register const unsigned char *p = ptr;
3854 register const unsigned char *end = p + len;
3855 register unsigned char c;
3856 register int hash = 0;
3857
3858 while (p != end)
3859 {
3860 c = *p++;
3861 if (c >= 0140) c -= 40;
3862 hash = ((hash<<3) + (hash>>28) + c);
3863 }
3864 return hash & 07777777777;
3865 }
3866
3867 void
3868 map_obarray (obarray, fn, arg)
3869 Lisp_Object obarray;
3870 void (*fn) P_ ((Lisp_Object, Lisp_Object));
3871 Lisp_Object arg;
3872 {
3873 register int i;
3874 register Lisp_Object tail;
3875 CHECK_VECTOR (obarray);
3876 for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
3877 {
3878 tail = XVECTOR (obarray)->contents[i];
3879 if (SYMBOLP (tail))
3880 while (1)
3881 {
3882 (*fn) (tail, arg);
3883 if (XSYMBOL (tail)->next == 0)
3884 break;
3885 XSETSYMBOL (tail, XSYMBOL (tail)->next);
3886 }
3887 }
3888 }
3889
3890 void
3891 mapatoms_1 (sym, function)
3892 Lisp_Object sym, function;
3893 {
3894 call1 (function, sym);
3895 }
3896
3897 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
3898 doc: 3899 )
3900 (function, obarray)
3901 Lisp_Object function, obarray;
3902 {
3903 if (NILP (obarray)) obarray = Vobarray;
3904 obarray = check_obarray (obarray);
3905
3906 map_obarray (obarray, mapatoms_1, function);
3907 return Qnil;
3908 }
3909
3910 #define OBARRAY_SIZE 1511
3911
3912 void
3913 init_obarray ()
3914 {
3915 Lisp_Object oblength;
3916
3917 XSETFASTINT (oblength, OBARRAY_SIZE);
3918
3919 Vobarray = Fmake_vector (oblength, make_number (0));
3920 initial_obarray = Vobarray;
3921 staticpro (&initial_obarray);
3922
3923 Qunbound = Fmake_symbol (make_pure_c_string ("unbound"));
3924 3925
3926 Qnil = make_number (-1); Vpurify_flag = make_number (1);
3927 Qnil = intern_c_string ("nil");
3928
3929 3930
3931 SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
3932 XSYMBOL (Qunbound)->function = Qunbound;
3933 XSYMBOL (Qunbound)->plist = Qnil;
3934
3935 SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
3936 XSYMBOL (Qnil)->constant = 1;
3937 XSYMBOL (Qnil)->plist = Qnil;
3938
3939 Qt = intern_c_string ("t");
3940 SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
3941 XSYMBOL (Qt)->constant = 1;
3942
3943
3944 Vpurify_flag = Qt;
3945
3946 Qvariable_documentation = intern_c_string ("variable-documentation");
3947 staticpro (&Qvariable_documentation);
3948
3949 read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
3950 read_buffer = (char *) xmalloc (read_buffer_size);
3951 }
3952
3953 void
3954 defsubr (sname)
3955 struct Lisp_Subr *sname;
3956 {
3957 Lisp_Object sym;
3958 sym = intern_c_string (sname->symbol_name);
3959 XSETPVECTYPE (sname, PVEC_SUBR);
3960 XSETSUBR (XSYMBOL (sym)->function, sname);
3961 }
3962
3963 #ifdef NOTDEF
3964 void
3965 defalias (sname, string)
3966 struct Lisp_Subr *sname;
3967 char *string;
3968 {
3969 Lisp_Object sym;
3970 sym = intern (string);
3971 XSETSUBR (XSYMBOL (sym)->function, sname);
3972 }
3973 #endif
3974
3975 3976 3977
3978 void
3979 defvar_int (struct Lisp_Intfwd *i_fwd,
3980 const char *namestring, EMACS_INT *address)
3981 {
3982 Lisp_Object sym;
3983 sym = intern_c_string (namestring);
3984 i_fwd->type = Lisp_Fwd_Int;
3985 i_fwd->intvar = address;
3986 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
3987 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
3988 }
3989
3990 3991
3992 void
3993 defvar_bool (struct Lisp_Boolfwd *b_fwd,
3994 const char *namestring, int *address)
3995 {
3996 Lisp_Object sym;
3997 sym = intern_c_string (namestring);
3998 b_fwd->type = Lisp_Fwd_Bool;
3999 b_fwd->boolvar = address;
4000 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4001 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
4002 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
4003 }
4004
4005 4006 4007 4008 4009
4010 void
4011 defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
4012 const char *namestring, Lisp_Object *address)
4013 {
4014 Lisp_Object sym;
4015 sym = intern_c_string (namestring);
4016 o_fwd->type = Lisp_Fwd_Obj;
4017 o_fwd->objvar = address;
4018 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4019 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
4020 }
4021
4022 void
4023 defvar_lisp (struct Lisp_Objfwd *o_fwd,
4024 const char *namestring, Lisp_Object *address)
4025 {
4026 defvar_lisp_nopro (o_fwd, namestring, address);
4027 staticpro (address);
4028 }
4029
4030 4031
4032
4033 void
4034 defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
4035 const char *namestring, int offset)
4036 {
4037 Lisp_Object sym;
4038 sym = intern_c_string (namestring);
4039 ko_fwd->type = Lisp_Fwd_Kboard_Obj;
4040 ko_fwd->offset = offset;
4041 XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4042 SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
4043 }
4044
4045 4046
4047 static Lisp_Object dump_path;
4048
4049 void
4050 init_lread ()
4051 {
4052 char *normal;
4053 int turn_off_warning = 0;
4054
4055
4056 #ifdef CANNOT_DUMP
4057 normal = PATH_LOADSEARCH;
4058 Vload_path = decode_env_path (0, normal);
4059 #else
4060 if (NILP (Vpurify_flag))
4061 normal = PATH_LOADSEARCH;
4062 else
4063 normal = PATH_DUMPLOADSEARCH;
4064
4065 4066 4067 4068 4069
4070 if (initialized)
4071 {
4072 if (! NILP (Fequal (dump_path, Vload_path)))
4073 {
4074 Vload_path = decode_env_path (0, normal);
4075 if (!NILP (Vinstallation_directory))
4076 {
4077 Lisp_Object tem, tem1, sitelisp;
4078
4079 4080 4081
4082 sitelisp = Qnil;
4083 while (1)
4084 {
4085 tem = Fcar (Vload_path);
4086 tem1 = Fstring_match (build_string ("site-lisp"),
4087 tem, Qnil);
4088 if (!NILP (tem1))
4089 {
4090 Vload_path = Fcdr (Vload_path);
4091 sitelisp = Fcons (tem, sitelisp);
4092 }
4093 else
4094 break;
4095 }
4096
4097 4098
4099 tem = Fexpand_file_name (build_string ("lisp"),
4100 Vinstallation_directory);
4101 tem1 = Ffile_exists_p (tem);
4102 if (!NILP (tem1))
4103 {
4104 if (NILP (Fmember (tem, Vload_path)))
4105 {
4106 turn_off_warning = 1;
4107 Vload_path = Fcons (tem, Vload_path);
4108 }
4109 }
4110 else
4111 4112
4113 Vload_path = nconc2 (Vload_path, dump_path);
4114
4115
4116 tem = Fexpand_file_name (build_string ("leim"),
4117 Vinstallation_directory);
4118 tem1 = Ffile_exists_p (tem);
4119 if (!NILP (tem1))
4120 {
4121 if (NILP (Fmember (tem, Vload_path)))
4122 Vload_path = Fcons (tem, Vload_path);
4123 }
4124
4125
4126 tem = Fexpand_file_name (build_string ("site-lisp"),
4127 Vinstallation_directory);
4128 tem1 = Ffile_exists_p (tem);
4129 if (!NILP (tem1))
4130 {
4131 if (NILP (Fmember (tem, Vload_path)))
4132 Vload_path = Fcons (tem, Vload_path);
4133 }
4134
4135 4136 4137
4138
4139 if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
4140 {
4141 Lisp_Object tem2;
4142
4143 tem = Fexpand_file_name (build_string ("src/Makefile"),
4144 Vinstallation_directory);
4145 tem1 = Ffile_exists_p (tem);
4146
4147 4148 4149 4150
4151 tem = Fexpand_file_name (build_string ("src/Makefile.in"),
4152 Vinstallation_directory);
4153 tem2 = Ffile_exists_p (tem);
4154 if (!NILP (tem1) && NILP (tem2))
4155 {
4156 tem = Fexpand_file_name (build_string ("lisp"),
4157 Vsource_directory);
4158
4159 if (NILP (Fmember (tem, Vload_path)))
4160 Vload_path = Fcons (tem, Vload_path);
4161
4162 tem = Fexpand_file_name (build_string ("leim"),
4163 Vsource_directory);
4164
4165 if (NILP (Fmember (tem, Vload_path)))
4166 Vload_path = Fcons (tem, Vload_path);
4167
4168 tem = Fexpand_file_name (build_string ("site-lisp"),
4169 Vsource_directory);
4170
4171 if (NILP (Fmember (tem, Vload_path)))
4172 Vload_path = Fcons (tem, Vload_path);
4173 }
4174 }
4175 if (!NILP (sitelisp))
4176 Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
4177 }
4178 }
4179 }
4180 else
4181 {
4182
4183 4184 4185 4186
4187 Vload_path = decode_env_path (0, normal);
4188 dump_path = Vload_path;
4189 }
4190 #endif
4191
4192 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4193 4194 4195 4196
4197
4198
4199 if (!turn_off_warning)
4200 {
4201 Lisp_Object path_tail;
4202
4203 for (path_tail = Vload_path;
4204 !NILP (path_tail);
4205 path_tail = XCDR (path_tail))
4206 {
4207 Lisp_Object dirfile;
4208 dirfile = Fcar (path_tail);
4209 if (STRINGP (dirfile))
4210 {
4211 dirfile = Fdirectory_file_name (dirfile);
4212 if (access (SDATA (dirfile), 0) < 0)
4213 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4214 XCAR (path_tail));
4215 }
4216 }
4217 }
4218 #endif
4219
4220 4221
4222 #ifndef CANNOT_DUMP
4223 if (NILP (Vpurify_flag)
4224 && egetenv ("EMACSLOADPATH"))
4225 #endif
4226 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
4227
4228 Vvalues = Qnil;
4229
4230 load_in_progress = 0;
4231 Vload_file_name = Qnil;
4232
4233 load_descriptor_list = Qnil;
4234
4235 Vstandard_input = Qt;
4236 Vloads_in_progress = Qnil;
4237 }
4238
4239 4240
4241
4242 void
4243 dir_warning (format, dirname)
4244 char *format;
4245 Lisp_Object dirname;
4246 {
4247 char *buffer
4248 = (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
4249
4250 fprintf (stderr, format, SDATA (dirname));
4251 sprintf (buffer, format, SDATA (dirname));
4252
4253 if (initialized)
4254 message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));
4255 }
4256
4257 void
4258 syms_of_lread ()
4259 {
4260 defsubr (&Sread);
4261 defsubr (&Sread_from_string);
4262 defsubr (&Sintern);
4263 defsubr (&Sintern_soft);
4264 defsubr (&Sunintern);
4265 defsubr (&Sget_load_suffixes);
4266 defsubr (&Sload);
4267 defsubr (&Seval_buffer);
4268 defsubr (&Seval_region);
4269 defsubr (&Sread_char);
4270 defsubr (&Sread_char_exclusive);
4271 defsubr (&Sread_event);
4272 defsubr (&Sget_file_char);
4273 defsubr (&Smapatoms);
4274 defsubr (&Slocate_file_internal);
4275
4276 DEFVAR_LISP ("obarray", &Vobarray,
4277 doc: 4278 4279 4280 );
4281
4282 DEFVAR_LISP ("values", &Vvalues,
4283 doc: 4284 );
4285
4286 DEFVAR_LISP ("standard-input", &Vstandard_input,
4287 doc: 4288 );
4289 Vstandard_input = Qt;
4290
4291 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
4292 doc: 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 );
4303 Vread_with_symbol_positions = Qnil;
4304
4305 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
4306 doc: 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 );
4318 Vread_symbol_positions_list = Qnil;
4319
4320 DEFVAR_LISP ("read-circle", &Vread_circle,
4321 doc: );
4322 Vread_circle = Qt;
4323
4324 DEFVAR_LISP ("load-path", &Vload_path,
4325 doc: 4326 4327 4328 );
4329
4330 DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
4331 doc: 4332 4333 4334 );
4335 Vload_suffixes = Fcons (make_pure_c_string (".elc"),
4336 Fcons (make_pure_c_string (".el"), Qnil));
4337 DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes,
4338 doc: 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 );
4350 Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil);
4351
4352 DEFVAR_BOOL ("load-in-progress", &load_in_progress,
4353 doc: );
4354 Qload_in_progress = intern_c_string ("load-in-progress");
4355 staticpro (&Qload_in_progress);
4356
4357 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
4358 doc: 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 );
4370 Vafter_load_alist = Qnil;
4371
4372 DEFVAR_LISP ("load-history", &Vload_history,
4373 doc: 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 );
4390 Vload_history = Qnil;
4391
4392 DEFVAR_LISP ("load-file-name", &Vload_file_name,
4393 doc: );
4394 Vload_file_name = Qnil;
4395
4396 DEFVAR_LISP ("user-init-file", &Vuser_init_file,
4397 doc: 4398 4399 4400 4401 4402 );
4403 Vuser_init_file = Qnil;
4404
4405 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
4406 doc: );
4407 Vcurrent_load_list = Qnil;
4408
4409 DEFVAR_LISP ("load-read-function", &Vload_read_function,
4410 doc: 4411 );
4412 Vload_read_function = Qnil;
4413
4414 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function,
4415 doc: 4416 4417 4418 4419 4420 );
4421 Vload_source_file_function = Qnil;
4422
4423 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings,
4424 doc: 4425 );
4426 load_force_doc_strings = 0;
4427
4428 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte,
4429 doc: 4430 4431 );
4432 load_convert_to_unibyte = 0;
4433
4434 DEFVAR_LISP ("source-directory", &Vsource_directory,
4435 doc: 4436 );
4437 Vsource_directory
4438 = Fexpand_file_name (build_string ("../"),
4439 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
4440
4441 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list,
4442 doc: );
4443 Vpreloaded_file_list = Qnil;
4444
4445 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars,
4446 doc: );
4447 Vbyte_boolean_vars = Qnil;
4448
4449 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries,
4450 doc: 4451 4452 4453 );
4454 load_dangerous_libraries = 0;
4455
4456 DEFVAR_BOOL ("force-load-messages", &force_load_messages,
4457 doc: 4458 );
4459 force_load_messages = 0;
4460
4461 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp,
4462 doc: 4463 4464 4465 4466 );
4467 Vbytecomp_version_regexp
4468 = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4469
4470 DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
4471 doc: );
4472 Veval_buffer_list = Qnil;
4473
4474 DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes,
4475 doc: );
4476 Vold_style_backquotes = Qnil;
4477 Qold_style_backquotes = intern_c_string ("old-style-backquotes");
4478 staticpro (&Qold_style_backquotes);
4479
4480
4481
4482 load_descriptor_list = Qnil;
4483 staticpro (&load_descriptor_list);
4484
4485 Qcurrent_load_list = intern_c_string ("current-load-list");
4486 staticpro (&Qcurrent_load_list);
4487
4488 Qstandard_input = intern_c_string ("standard-input");
4489 staticpro (&Qstandard_input);
4490
4491 Qread_char = intern_c_string ("read-char");
4492 staticpro (&Qread_char);
4493
4494 Qget_file_char = intern_c_string ("get-file-char");
4495 staticpro (&Qget_file_char);
4496
4497 Qget_emacs_mule_file_char = intern_c_string ("get-emacs-mule-file-char");
4498 staticpro (&Qget_emacs_mule_file_char);
4499
4500 Qload_force_doc_strings = intern_c_string ("load-force-doc-strings");
4501 staticpro (&Qload_force_doc_strings);
4502
4503 Qbackquote = intern_c_string ("`");
4504 staticpro (&Qbackquote);
4505 Qcomma = intern_c_string (",");
4506 staticpro (&Qcomma);
4507 Qcomma_at = intern_c_string (",@");
4508 staticpro (&Qcomma_at);
4509 Qcomma_dot = intern_c_string (",.");
4510 staticpro (&Qcomma_dot);
4511
4512 Qinhibit_file_name_operation = intern_c_string ("inhibit-file-name-operation");
4513 staticpro (&Qinhibit_file_name_operation);
4514
4515 Qascii_character = intern_c_string ("ascii-character");
4516 staticpro (&Qascii_character);
4517
4518 Qfunction = intern_c_string ("function");
4519 staticpro (&Qfunction);
4520
4521 Qload = intern_c_string ("load");
4522 staticpro (&Qload);
4523
4524 Qload_file_name = intern_c_string ("load-file-name");
4525 staticpro (&Qload_file_name);
4526
4527 Qeval_buffer_list = intern_c_string ("eval-buffer-list");
4528 staticpro (&Qeval_buffer_list);
4529
4530 Qfile_truename = intern_c_string ("file-truename");
4531 staticpro (&Qfile_truename) ;
4532
4533 Qdo_after_load_evaluation = intern_c_string ("do-after-load-evaluation");
4534 staticpro (&Qdo_after_load_evaluation) ;
4535
4536 staticpro (&dump_path);
4537
4538 staticpro (&read_objects);
4539 read_objects = Qnil;
4540 staticpro (&seen_list);
4541 seen_list = Qnil;
4542
4543 Vloads_in_progress = Qnil;
4544 staticpro (&Vloads_in_progress);
4545
4546 Qhash_table = intern_c_string ("hash-table");
4547 staticpro (&Qhash_table);
4548 Qdata = intern_c_string ("data");
4549 staticpro (&Qdata);
4550 Qtest = intern_c_string ("test");
4551 staticpro (&Qtest);
4552 Qsize = intern_c_string ("size");
4553 staticpro (&Qsize);
4554 Qweakness = intern_c_string ("weakness");
4555 staticpro (&Qweakness);
4556 Qrehash_size = intern_c_string ("rehash-size");
4557 staticpro (&Qrehash_size);
4558 Qrehash_threshold = intern_c_string ("rehash-threshold");
4559 staticpro (&Qrehash_threshold);
4560 }
4561
4562 4563