Mercurial > hg > xemacs-beta

comparison src/lread.c @ 245:51092a27c943 r20-5b21

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b21
author cvs
date Mon, 13 Aug 2007 10:17:54 +0200
parents 41f2f0e326e9
children 83b3d10dcba9
comparison
equal deleted inserted replaced
244:78d4f1140794 245:51092a27c943
116 116
117 Lisp_Object Vload_file_name_internal_the_purecopy; 117 Lisp_Object Vload_file_name_internal_the_purecopy;
118 118
119 /* Function to use for reading, in `load' and friends. */ 119 /* Function to use for reading, in `load' and friends. */
120 Lisp_Object Vload_read_function; 120 Lisp_Object Vload_read_function;
121
122 /* The association list of objects read with the #n=object form.
123 Each member of the list has the form (n . object), and is used to
124 look up the object for the corresponding #n# construct.
125 It must be set to nil before all top-level calls to read0. */
126 Lisp_Object read_objects;
121 127
122 /* Nonzero means load should forcibly load all dynamic doc strings. */ 128 /* Nonzero means load should forcibly load all dynamic doc strings. */
123 /* Note that this always happens (with some special behavior) when 129 /* Note that this always happens (with some special behavior) when
124 purify_flag is set. */ 130 purify_flag is set. */
125 static int load_force_doc_strings; 131 static int load_force_doc_strings;
1358 } 1364 }
1359 else 1365 else
1360 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */ 1366 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
1361 { 1367 {
1362 unreadchar (readcharfun, c); 1368 unreadchar (readcharfun, c);
1369 read_objects = Qnil;
1363 if (NILP (Vload_read_function)) 1370 if (NILP (Vload_read_function))
1364 val = read0 (readcharfun); 1371 val = read0 (readcharfun);
1365 else 1372 else
1366 val = call1 (Vload_read_function, readcharfun); 1373 val = call1 (Vload_read_function, readcharfun);
1367 } 1374 }
1499 if (NILP (stream)) 1506 if (NILP (stream))
1500 stream = Vstandard_input; 1507 stream = Vstandard_input;
1501 if (EQ (stream, Qt)) 1508 if (EQ (stream, Qt))
1502 stream = Qread_char; 1509 stream = Qread_char;
1503 1510
1511 read_objects = Qnil;
1512
1504 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK 1513 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1505 Vcurrent_compiled_function_annotation = Qnil; 1514 Vcurrent_compiled_function_annotation = Qnil;
1506 #endif 1515 #endif
1507 #ifndef standalone 1516 #ifndef standalone
1508 if (EQ (stream, Qread_char)) 1517 if (EQ (stream, Qread_char))
1539 CHECK_STRING (string); 1548 CHECK_STRING (string);
1540 get_string_range_byte (string, start, end, &startval, &endval, 1549 get_string_range_byte (string, start, end, &startval, &endval,
1541 GB_HISTORICAL_STRING_BEHAVIOR); 1550 GB_HISTORICAL_STRING_BEHAVIOR);
1542 lispstream = make_lisp_string_input_stream (string, startval, 1551 lispstream = make_lisp_string_input_stream (string, startval,
1543 endval - startval); 1552 endval - startval);
1553
1554 read_objects = Qnil;
1544 1555
1545 tem = read0 (lispstream); 1556 tem = read0 (lispstream);
1546 /* Yeah, it's ugly. Gonna make something of it? 1557 /* Yeah, it's ugly. Gonna make something of it?
1547 At least our reader is reentrant ... */ 1558 At least our reader is reentrant ... */
1548 tem = 1559 tem =
2411 if (c == '+' && NILP(tem)) goto retry; 2422 if (c == '+' && NILP(tem)) goto retry;
2412 if (c == '-' && !NILP(tem)) goto retry; 2423 if (c == '-' && !NILP(tem)) goto retry;
2413 return obj; 2424 return obj;
2414 } 2425 }
2415 #endif 2426 #endif
2427 case '0': case '1': case '2': case '3': case '4':
2428 case '5': case '6': case '7': case '8': case '9':
2429 /* Reader forms that can reuse previously read objects. */
2430 {
2431 int n = 0;
2432 Lisp_Object found;
2433
2434 /* Using read_integer() here is impossible, because it
2435 chokes on `='. Using parse_integer() is too hard.
2436 So we simply read it in, and ignore overflows, which
2437 is safe. */
2438 while (c >= '0' && c <= '9')
2439 {
2440 n *= 10;
2441 n += c - '0';
2442 c = readchar (readcharfun);
2443 }
2444 found = assq_no_quit (make_int (n), read_objects);
2445 if (c == '=')
2446 {
2447 /* #n=object returns object, but associates it with
2448 n for #n#. */
2449 Lisp_Object obj;
2450 if (CONSP (found))
2451 return Fsignal (Qinvalid_read_syntax,
2452 list2 (build_translated_string
2453 ("Multiply defined symbol label"),
2454 make_int (n)));
2455 obj = read0 (readcharfun);
2456 read_objects = Fcons (Fcons (make_int (n), obj), read_objects);
2457 return obj;
2458 }
2459 else if (c == '#')
2460 {
2461 /* #n# returns a previously read object. */
2462 if (CONSP (found))
2463 return XCDR (found);
2464 else
2465 return Fsignal (Qinvalid_read_syntax,
2466 list2 (build_translated_string
2467 ("Undefined symbol label"),
2468 make_int (n)));
2469 }
2470 return Fsignal (Qinvalid_read_syntax,
2471 list1 (build_string ("#")));
2472 }
2416 default: 2473 default:
2417 { 2474 {
2418 unreadchar (readcharfun, c); 2475 unreadchar (readcharfun, c);
2419 return Fsignal (Qinvalid_read_syntax, 2476 return Fsignal (Qinvalid_read_syntax,
2420 list1 (build_string ("#"))); 2477 list1 (build_string ("#")));
3199 #endif 3256 #endif
3200 3257
3201 #ifdef I18N3 3258 #ifdef I18N3
3202 Vfile_domain = Qnil; 3259 Vfile_domain = Qnil;
3203 #endif 3260 #endif
3204 } 3261
3262 read_objects = Qnil;
3263 staticpro (&read_objects);
3264 }