Mercurial > hg > xemacs-beta

comparison src/lread.c @ 4990:8f0cf4fd3d2c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Automatic merge
author Ben Wing <ben@xemacs.org>
date Sat, 06 Feb 2010 04:01:46 -0600
parents cbe181529c34
children 2ade80e8c640
comparison
equal deleted inserted replaced
4989:d2ec55325515 4990:8f0cf4fd3d2c
1 /* Lisp parsing and input streams. 1 /* Lisp parsing and input streams.
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc. 2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Tinker Systems. 3 Copyright (C) 1995 Tinker Systems.
4 Copyright (C) 1996, 2001, 2002, 2003 Ben Wing. 4 Copyright (C) 1996, 2001, 2002, 2003, 2010 Ben Wing.
5 5
6 This file is part of XEmacs. 6 This file is part of XEmacs.
7 7
8 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the 9 under the terms of the GNU General Public License as published by the
145 problems with recursive loading. */ 145 problems with recursive loading. */
146 static Lisp_Object Vload_force_doc_string_list; 146 static Lisp_Object Vload_force_doc_string_list;
147 147
148 /* A resizing-buffer stream used to temporarily hold data while reading */ 148 /* A resizing-buffer stream used to temporarily hold data while reading */
149 static Lisp_Object Vread_buffer_stream; 149 static Lisp_Object Vread_buffer_stream;
150
151 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
152 Lisp_Object Vcurrent_compiled_function_annotation;
153 #endif
154 150
155 static int load_byte_code_version; 151 static int load_byte_code_version;
156 152
157 /* An array describing all known built-in structure types */ 153 /* An array describing all known built-in structure types */
158 static structure_type_dynarr *the_structure_type_dynarr; 154 static structure_type_dynarr *the_structure_type_dynarr;
591 Ibyte *foundstr; 587 Ibyte *foundstr;
592 int foundlen; 588 int foundlen;
593 589
594 fd = locate_file (Vload_path, file, 590 fd = locate_file (Vload_path, file,
595 ((!NILP (nosuffix)) ? Qnil : 591 ((!NILP (nosuffix)) ? Qnil :
596 build_string (load_ignore_elc_files ? ".el:" : 592 build_ascstring (load_ignore_elc_files ? ".el:" :
597 ".elc:.el:")), 593 ".elc:.el:")),
598 &found, 594 &found,
599 -1); 595 -1);
600 596
601 if (fd < 0) 597 if (fd < 0)
1095 { 1091 {
1096 if (!check_if_suppressed (fn, Qnil)) 1092 if (!check_if_suppressed (fn, Qnil))
1097 { 1093 {
1098 /* We succeeded; return this descriptor and filename. */ 1094 /* We succeeded; return this descriptor and filename. */
1099 if (closure->storeptr) 1095 if (closure->storeptr)
1100 *closure->storeptr = build_intstring (fn); 1096 *closure->storeptr = build_istring (fn);
1101 1097
1102 return 1; 1098 return 1;
1103 } 1099 }
1104 } 1100 }
1105 } 1101 }
1179 1175
1180 static int 1176 static int
1181 locate_file_construct_suffixed_files_mapper (Ibyte *fn, void *arg) 1177 locate_file_construct_suffixed_files_mapper (Ibyte *fn, void *arg)
1182 { 1178 {
1183 Lisp_Object *tail = (Lisp_Object *) arg; 1179 Lisp_Object *tail = (Lisp_Object *) arg;
1184 *tail = Fcons (build_intstring (fn), *tail); 1180 *tail = Fcons (build_istring (fn), *tail);
1185 return 0; 1181 return 0;
1186 } 1182 }
1187 1183
1188 /* Construct a list of all files to search for. 1184 /* Construct a list of all files to search for.
1189 It makes sense to have this despite locate_file_map_suffixes() 1185 It makes sense to have this despite locate_file_map_suffixes()
1269 if (storeptr) 1265 if (storeptr)
1270 *storeptr = Qnil; 1266 *storeptr = Qnil;
1271 1267
1272 /* Is it really necessary to gcpro path and str? It shouldn't be 1268 /* Is it really necessary to gcpro path and str? It shouldn't be
1273 unless some caller has fucked up. There are known instances that 1269 unless some caller has fucked up. There are known instances that
1274 call us with build_string("foo:bar") as SUFFIXES, though. */ 1270 call us with build_ascstring("foo:bar") as SUFFIXES, though. */
1275 GCPRO4 (path, str, suffixes, suffixtab); 1271 GCPRO4 (path, str, suffixes, suffixtab);
1276 1272
1277 /* if this filename has directory components, it's too complicated 1273 /* if this filename has directory components, it's too complicated
1278 to try and use the hash tables. */ 1274 to try and use the hash tables. */
1279 if (!NILP (Ffile_name_directory (str))) 1275 if (!NILP (Ffile_name_directory (str)))
1449 READCHARFUN (which can be a stream) to Lisp. --hniksic */ 1445 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1450 /*specbind (Qstandard_input, readcharfun);*/ 1446 /*specbind (Qstandard_input, readcharfun);*/
1451 1447
1452 internal_bind_lisp_object (&Vcurrent_load_list, Qnil); 1448 internal_bind_lisp_object (&Vcurrent_load_list, Qnil);
1453 1449
1454 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1455 Vcurrent_compiled_function_annotation = Qnil;
1456 #endif
1457 GCPRO2 (val, sourcename); 1450 GCPRO2 (val, sourcename);
1458 1451
1459 LOADHIST_ATTACH (sourcename); 1452 LOADHIST_ATTACH (sourcename);
1460 1453
1461 while (1) 1454 while (1)
1617 if (EQ (stream, Qt)) 1610 if (EQ (stream, Qt))
1618 stream = Qread_char; 1611 stream = Qread_char;
1619 1612
1620 Vread_objects = Qnil; 1613 Vread_objects = Qnil;
1621 1614
1622 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1623 Vcurrent_compiled_function_annotation = Qnil;
1624 #endif
1625 if (EQ (stream, Qread_char)) 1615 if (EQ (stream, Qread_char))
1626 { 1616 {
1627 Lisp_Object val = call1 (Qread_from_minibuffer, 1617 Lisp_Object val = call1 (Qread_from_minibuffer,
1628 build_msg_string ("Lisp expression: ")); 1618 build_msg_string ("Lisp expression: "));
1629 return Fcar (Fread_from_string (val, Qnil, Qnil)); 1619 return Fcar (Fread_from_string (val, Qnil, Qnil));
1646 Bytecount startval, endval; 1636 Bytecount startval, endval;
1647 Lisp_Object tem; 1637 Lisp_Object tem;
1648 Lisp_Object lispstream = Qnil; 1638 Lisp_Object lispstream = Qnil;
1649 struct gcpro gcpro1; 1639 struct gcpro gcpro1;
1650 1640
1651 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1652 Vcurrent_compiled_function_annotation = Qnil;
1653 #endif
1654 GCPRO1 (lispstream); 1641 GCPRO1 (lispstream);
1655 CHECK_STRING (string); 1642 CHECK_STRING (string);
1656 get_string_range_byte (string, start, end, &startval, &endval, 1643 get_string_range_byte (string, start, end, &startval, &endval,
1657 GB_HISTORICAL_STRING_BEHAVIOR); 1644 GB_HISTORICAL_STRING_BEHAVIOR);
1658 lispstream = make_lisp_string_input_stream (string, startval, 1645 lispstream = make_lisp_string_input_stream (string, startval,
1870 1857
1871 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0'); 1858 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
1872 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10; 1859 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
1873 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10; 1860 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
1874 1861
1875 args[0] = build_string ("?\\x%x"); 1862 args[0] = build_ascstring ("?\\x%x");
1876 args[1] = make_int (i); 1863 args[1] = make_int (i);
1877 syntax_error ("Overlong hex character escape", 1864 syntax_error ("Overlong hex character escape",
1878 Fformat (2, args)); 1865 Fformat (2, args));
1879 } 1866 }
1880 unreadchar (readcharfun, c); 1867 unreadchar (readcharfun, c);
2127 break; 2114 break;
2128 } 2115 }
2129 Dynarr_add (dyn, bit); 2116 Dynarr_add (dyn, bit);
2130 } 2117 }
2131 2118
2132 val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0), 2119 val = make_bit_vector_from_byte_vector (Dynarr_begin (dyn),
2133 Dynarr_length (dyn)); 2120 Dynarr_length (dyn));
2134 Dynarr_free (dyn); 2121 Dynarr_free (dyn);
2135 2122
2136 return val; 2123 return val;
2137 } 2124 }
2392 read_raw_string (Lisp_Object readcharfun) 2379 read_raw_string (Lisp_Object readcharfun)
2393 { 2380 {
2394 Ichar c; 2381 Ichar c;
2395 Ichar permit_unicode = 0; 2382 Ichar permit_unicode = 0;
2396 2383
2397 do { 2384 do
2398 c = reader_nextchar(readcharfun); 2385 {
2399 switch (c) { 2386 c = reader_nextchar (readcharfun);
2400 /* #r:engine"my sexy raw string" -- raw string w/ flags*/ 2387 switch (c)
2401 /* case ':': */ 2388 {
2402 /* #ru"Hi there\u20AC \U000020AC" -- raw string, honouring Unicode. */ 2389 /* #r:engine"my sexy raw string" -- raw string w/ flags*/
2403 case 'u': 2390 /* case ':': */
2404 case 'U': 2391 /* #ru"Hi there\u20AC \U000020AC" -- raw string, honouring Unicode. */
2405 permit_unicode = c; 2392 case 'u':
2406 continue; 2393 case 'U':
2407 2394 permit_unicode = c;
2408 /* #r"my raw string" -- raw string */ 2395 continue;
2409 case '\"': 2396
2410 return read_string(readcharfun, '\"', 1, permit_unicode); 2397 /* #r"my raw string" -- raw string */
2411 /* invalid syntax */ 2398 case '\"':
2412 default: 2399 return read_string (readcharfun, '\"', 1, permit_unicode);
2413 { 2400 /* invalid syntax */
2414 if (permit_unicode) 2401 default:
2415 { 2402 {
2416 unreadchar(readcharfun, permit_unicode); 2403 if (permit_unicode)
2404 {
2405 unreadchar (readcharfun, permit_unicode);
2406 }
2407 unreadchar (readcharfun, c);
2408 return Fsignal (Qinvalid_read_syntax,
2409 list1 (build_msg_string
2410 ("unrecognized raw string syntax")));
2417 } 2411 }
2418 unreadchar(readcharfun, c); 2412 }
2419 return Fsignal(Qinvalid_read_syntax, 2413 } while (1);
2420 list1(build_string
2421 ("unrecognized raw string syntax")));
2422 }
2423 }
2424 } while (1);
2425 } 2414 }
2426 2415
2427 /* Read the next Lisp object from the stream READCHARFUN and return it. 2416 /* Read the next Lisp object from the stream READCHARFUN and return it.
2428 If the return value is a cons whose car is Qunbound, then read1() 2417 If the return value is a cons whose car is Qunbound, then read1()
2429 encountered a misplaced token (e.g. a right bracket, right paren, 2418 encountered a misplaced token (e.g. a right bracket, right paren,
2578 if (!STRINGP (tmp)) 2567 if (!STRINGP (tmp))
2579 { 2568 {
2580 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp))) 2569 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
2581 free_cons (tmp); 2570 free_cons (tmp);
2582 return Fsignal (Qinvalid_read_syntax, 2571 return Fsignal (Qinvalid_read_syntax,
2583 list1 (build_string ("#"))); 2572 list1 (build_ascstring ("#")));
2584 } 2573 }
2585 GCPRO1 (tmp); 2574 GCPRO1 (tmp);
2586 /* Read the intervals and their properties. */ 2575 /* Read the intervals and their properties. */
2587 while (1) 2576 while (1)
2588 { 2577 {
2736 list2 (build_msg_string 2725 list2 (build_msg_string
2737 ("Undefined symbol label"), 2726 ("Undefined symbol label"),
2738 make_int (n))); 2727 make_int (n)));
2739 } 2728 }
2740 return Fsignal (Qinvalid_read_syntax, 2729 return Fsignal (Qinvalid_read_syntax,
2741 list1 (build_string ("#"))); 2730 list1 (build_ascstring ("#")));
2742 } 2731 }
2743 default: 2732 default:
2744 { 2733 {
2745 unreadchar (readcharfun, c); 2734 unreadchar (readcharfun, c);
2746 return Fsignal (Qinvalid_read_syntax, 2735 return Fsignal (Qinvalid_read_syntax,
2747 list1 (build_string ("#"))); 2736 list1 (build_ascstring ("#")));
2748 } 2737 }
2749 } 2738 }
2750 } 2739 }
2751 2740
2752 /* Quote */ 2741 /* Quote */
3007 } 2996 }
3008 read_syntax_error (". in wrong context"); 2997 read_syntax_error (". in wrong context");
3009 } 2998 }
3010 } 2999 }
3011 3000
3012 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3013 if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
3014 {
3015 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
3016 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
3017 else
3018 Vcurrent_compiled_function_annotation = elt;
3019 }
3020 #endif
3021
3022 elt = Fcons (elt, Qnil); 3001 elt = Fcons (elt, Qnil);
3023 if (!NILP (s->tail)) 3002 if (!NILP (s->tail))
3024 XCDR (s->tail) = elt; 3003 XCDR (s->tail) = elt;
3025 else 3004 else
3026 s->head = elt; 3005 s->head = elt;
3052 int allow_dotted_lists, 3031 int allow_dotted_lists,
3053 int check_for_doc_references) 3032 int check_for_doc_references)
3054 { 3033 {
3055 struct read_list_state s; 3034 struct read_list_state s;
3056 struct gcpro gcpro1, gcpro2; 3035 struct gcpro gcpro1, gcpro2;
3057 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3058 Lisp_Object old_compiled_function_annotation =
3059 Vcurrent_compiled_function_annotation;
3060 #endif
3061 3036
3062 s.head = Qnil; 3037 s.head = Qnil;
3063 s.tail = Qnil; 3038 s.tail = Qnil;
3064 s.length = 0; 3039 s.length = 0;
3065 s.allow_dotted_lists = allow_dotted_lists; 3040 s.allow_dotted_lists = allow_dotted_lists;
3066 s.terminator = terminator; 3041 s.terminator = terminator;
3067 GCPRO2 (s.head, s.tail); 3042 GCPRO2 (s.head, s.tail);
3068 3043
3069 sequence_reader (readcharfun, terminator, &s, read_list_conser); 3044 sequence_reader (readcharfun, terminator, &s, read_list_conser);
3070 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3071 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
3072 #endif
3073 3045
3074 if ((purify_flag || load_force_doc_strings) && check_for_doc_references) 3046 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
3075 { 3047 {
3076 /* check now for any doc string references and record them 3048 /* check now for any doc string references and record them
3077 for later. */ 3049 for later. */
3118 can be found properly in the installed Lisp 3090 can be found properly in the installed Lisp
3119 directory. We don't use Fexpand_file_name 3091 directory. We don't use Fexpand_file_name
3120 because that would make the directory absolute 3092 because that would make the directory absolute
3121 now. */ 3093 now. */
3122 XCAR (XCAR (holding_cons)) = 3094 XCAR (XCAR (holding_cons)) =
3123 concat2 (build_string ("../lisp/"), 3095 concat2 (build_ascstring ("../lisp/"),
3124 Ffile_name_nondirectory 3096 Ffile_name_nondirectory
3125 (Vload_file_name_internal)); 3097 (Vload_file_name_internal));
3126 } 3098 }
3127 else 3099 else
3128 /* Not pure. Just add to Vload_force_doc_string_list, 3100 /* Not pure. Just add to Vload_force_doc_string_list,
3212 /* same as in read_list(). */ 3184 /* same as in read_list(). */
3213 if (NILP (Vinternal_doc_file_name)) 3185 if (NILP (Vinternal_doc_file_name))
3214 make_byte_code_args[iii] = Qzero; 3186 make_byte_code_args[iii] = Qzero;
3215 else 3187 else
3216 XCAR (make_byte_code_args[iii]) = 3188 XCAR (make_byte_code_args[iii]) =
3217 concat2 (build_string ("../lisp/"), 3189 concat2 (build_ascstring ("../lisp/"),
3218 Ffile_name_nondirectory 3190 Ffile_name_nondirectory
3219 (Vload_file_name_internal)); 3191 (Vload_file_name_internal));
3220 } 3192 }
3221 else 3193 else
3222 saw_a_doc_ref = 1; 3194 saw_a_doc_ref = 1;
3253 Vload_descriptor_list = Qnil; 3225 Vload_descriptor_list = Qnil;
3254 3226
3255 /* kludge: locate-file does not work for a null load-path, even if 3227 /* kludge: locate-file does not work for a null load-path, even if
3256 the file name is absolute. */ 3228 the file name is absolute. */
3257 3229
3258 Vload_path = Fcons (build_string (""), Qnil); 3230 Vload_path = Fcons (build_ascstring (""), Qnil);
3259 3231
3260 /* This used to get initialized in init_lread because all streams 3232 /* This used to get initialized in init_lread because all streams
3261 got closed when dumping occurs. This is no longer true -- 3233 got closed when dumping occurs. This is no longer true --
3262 Vread_buffer_stream is a resizing output stream, and there is no 3234 Vread_buffer_stream is a resizing output stream, and there is no
3263 reason to close it at dump-time. 3235 reason to close it at dump-time.
3403 *Whether `load' should ignore out-of-date `.elc' files when no suffix is given. 3375 *Whether `load' should ignore out-of-date `.elc' files when no suffix is given.
3404 This is normally used when compiling packages of elisp files that may have 3376 This is normally used when compiling packages of elisp files that may have
3405 complex dependencies. Ignoring all elc files with `load-ignore-elc-files' 3377 complex dependencies. Ignoring all elc files with `load-ignore-elc-files'
3406 would also be safe, but much slower. 3378 would also be safe, but much slower.
3407 */ ); 3379 */ );
3408 load_ignore_out_of_date_elc_files = 0; 3380 load_ignore_out_of_date_elc_files = 1;
3409 3381
3410 DEFVAR_BOOL ("load-always-display-messages", 3382 DEFVAR_BOOL ("load-always-display-messages",
3411 &load_always_display_messages /* 3383 &load_always_display_messages /*
3412 *Whether `load' should always display loading messages. 3384 *Whether `load' should always display loading messages.
3413 If this is true, every file loaded will be shown, regardless of the setting 3385 If this is true, every file loaded will be shown, regardless of the setting
3475 staticpro (&Vload_force_doc_string_list); 3447 staticpro (&Vload_force_doc_string_list);
3476 3448
3477 Vload_file_name_internal = Qnil; 3449 Vload_file_name_internal = Qnil;
3478 staticpro (&Vload_file_name_internal); 3450 staticpro (&Vload_file_name_internal);
3479 3451
3480 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3481 Vcurrent_compiled_function_annotation = Qnil;
3482 staticpro (&Vcurrent_compiled_function_annotation);
3483 #endif
3484
3485 /* So that early-early stuff will work */ 3452 /* So that early-early stuff will work */
3486 Ffset (Qload, Qload_internal); 3453 Ffset (Qload, Qload_internal);
3487 3454
3488 #ifdef FEATUREP_SYNTAX 3455 #ifdef FEATUREP_SYNTAX
3489 DEFSYMBOL (Qfeaturep); 3456 DEFSYMBOL (Qfeaturep);