diff options
| author | Stefan Monnier | 2012-05-25 14:06:13 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2012-05-25 14:06:13 -0400 |
| commit | 48def666f155f3a102594f3a7d800ae549c36313 (patch) | |
| tree | e5a3f17b3f6c6fd2fc3e9929f9ea12fdd7ce569a /src | |
| parent | a8d3cbf75d219d7a249fc0623219511179e959da (diff) | |
| download | emacs-48def666f155f3a102594f3a7d800ae549c36313.tar.gz emacs-48def666f155f3a102594f3a7d800ae549c36313.zip | |
* src/lread.c: Remove `read_pure' which makes no difference.
(read_pure): Remove var.
(unreadpure): Remove function.
(readevalloop): Don't call read_list with -1 flag.
(read1, read_vector): Don't test read_pure any more.
(read_list): Simplify.
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/lread.c | 141 |
2 files changed, 64 insertions, 84 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 911354b7a61..f211bd4c939 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,5 +1,12 @@ | |||
| 1 | 2012-05-25 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2012-05-25 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 2 | ||
| 3 | * lread.c: Remove `read_pure' which makes no difference. | ||
| 4 | (read_pure): Remove var. | ||
| 5 | (unreadpure): Remove function. | ||
| 6 | (readevalloop): Don't call read_list with -1 flag. | ||
| 7 | (read1, read_vector): Don't test read_pure any more. | ||
| 8 | (read_list): Simplify. | ||
| 9 | |||
| 3 | * fileio.c, character.h: Minor style tweaks. | 10 | * fileio.c, character.h: Minor style tweaks. |
| 4 | 11 | ||
| 5 | 2012-05-24 Dmitry Antipov <dmantipov@yandex.ru> | 12 | 2012-05-24 Dmitry Antipov <dmantipov@yandex.ru> |
diff --git a/src/lread.c b/src/lread.c index 6b657f61ed0..37ccb16a626 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -61,7 +61,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 61 | #define file_tell ftell | 61 | #define file_tell ftell |
| 62 | #endif | 62 | #endif |
| 63 | 63 | ||
| 64 | /* hash table read constants */ | 64 | /* Hash table read constants. */ |
| 65 | static Lisp_Object Qhash_table, Qdata; | 65 | static Lisp_Object Qhash_table, Qdata; |
| 66 | static Lisp_Object Qtest, Qsize; | 66 | static Lisp_Object Qtest, Qsize; |
| 67 | static Lisp_Object Qweakness; | 67 | static Lisp_Object Qweakness; |
| @@ -105,16 +105,13 @@ static Lisp_Object load_descriptor_list; | |||
| 105 | /* File for get_file_char to read from. Use by load. */ | 105 | /* File for get_file_char to read from. Use by load. */ |
| 106 | static FILE *instream; | 106 | static FILE *instream; |
| 107 | 107 | ||
| 108 | /* When nonzero, read conses in pure space */ | ||
| 109 | static int read_pure; | ||
| 110 | |||
| 111 | /* For use within read-from-string (this reader is non-reentrant!!) */ | 108 | /* For use within read-from-string (this reader is non-reentrant!!) */ |
| 112 | static EMACS_INT read_from_string_index; | 109 | static EMACS_INT read_from_string_index; |
| 113 | static EMACS_INT read_from_string_index_byte; | 110 | static EMACS_INT read_from_string_index_byte; |
| 114 | static EMACS_INT read_from_string_limit; | 111 | static EMACS_INT read_from_string_limit; |
| 115 | 112 | ||
| 116 | /* Number of characters read in the current call to Fread or | 113 | /* Number of characters read in the current call to Fread or |
| 117 | Fread_from_string. */ | 114 | Fread_from_string. */ |
| 118 | static EMACS_INT readchar_count; | 115 | static EMACS_INT readchar_count; |
| 119 | 116 | ||
| 120 | /* This contains the last string skipped with #@. */ | 117 | /* This contains the last string skipped with #@. */ |
| @@ -187,7 +184,7 @@ static int readbyte_from_string (int, Lisp_Object); | |||
| 187 | /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char, | 184 | /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char, |
| 188 | Qlambda, or a cons, we use this to keep an unread character because | 185 | Qlambda, or a cons, we use this to keep an unread character because |
| 189 | a file stream can't handle multibyte-char unreading. The value -1 | 186 | a file stream can't handle multibyte-char unreading. The value -1 |
| 190 | means that there's no unread character. */ | 187 | means that there's no unread character. */ |
| 191 | static int unread_char; | 188 | static int unread_char; |
| 192 | 189 | ||
| 193 | static int | 190 | static int |
| @@ -447,7 +444,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun) | |||
| 447 | c = getc (instream); | 444 | c = getc (instream); |
| 448 | 445 | ||
| 449 | #ifdef EINTR | 446 | #ifdef EINTR |
| 450 | /* Interrupted reads have been observed while reading over the network */ | 447 | /* Interrupted reads have been observed while reading over the network. */ |
| 451 | while (c == EOF && ferror (instream) && errno == EINTR) | 448 | while (c == EOF && ferror (instream) && errno == EINTR) |
| 452 | { | 449 | { |
| 453 | UNBLOCK_INPUT; | 450 | UNBLOCK_INPUT; |
| @@ -1067,7 +1064,7 @@ Return t if the file exists and loads successfully. */) | |||
| 1067 | 1064 | ||
| 1068 | 1065 | ||
| 1069 | /* Avoid weird lossage with null string as arg, | 1066 | /* Avoid weird lossage with null string as arg, |
| 1070 | since it would try to load a directory as a Lisp file */ | 1067 | since it would try to load a directory as a Lisp file. */ |
| 1071 | if (SBYTES (file) > 0) | 1068 | if (SBYTES (file) > 0) |
| 1072 | { | 1069 | { |
| 1073 | ptrdiff_t size = SBYTES (file); | 1070 | ptrdiff_t size = SBYTES (file); |
| @@ -1171,7 +1168,7 @@ Return t if the file exists and loads successfully. */) | |||
| 1171 | Vload_source_file_function. */ | 1168 | Vload_source_file_function. */ |
| 1172 | specbind (Qlexical_binding, Qnil); | 1169 | specbind (Qlexical_binding, Qnil); |
| 1173 | 1170 | ||
| 1174 | /* Get the name for load-history. */ | 1171 | /* Get the name for load-history. */ |
| 1175 | hist_file_name = (! NILP (Vpurify_flag) | 1172 | hist_file_name = (! NILP (Vpurify_flag) |
| 1176 | ? Fconcat (2, (tmp[0] = Ffile_name_directory (file), | 1173 | ? Fconcat (2, (tmp[0] = Ffile_name_directory (file), |
| 1177 | tmp[1] = Ffile_name_nondirectory (found), | 1174 | tmp[1] = Ffile_name_nondirectory (found), |
| @@ -1324,7 +1321,7 @@ Return t if the file exists and loads successfully. */) | |||
| 1324 | } | 1321 | } |
| 1325 | unbind_to (count, Qnil); | 1322 | unbind_to (count, Qnil); |
| 1326 | 1323 | ||
| 1327 | /* Run any eval-after-load forms for this file */ | 1324 | /* Run any eval-after-load forms for this file. */ |
| 1328 | if (!NILP (Ffboundp (Qdo_after_load_evaluation))) | 1325 | if (!NILP (Ffboundp (Qdo_after_load_evaluation))) |
| 1329 | call1 (Qdo_after_load_evaluation, hist_file_name) ; | 1326 | call1 (Qdo_after_load_evaluation, hist_file_name) ; |
| 1330 | 1327 | ||
| @@ -1356,7 +1353,7 @@ Return t if the file exists and loads successfully. */) | |||
| 1356 | } | 1353 | } |
| 1357 | 1354 | ||
| 1358 | static Lisp_Object | 1355 | static Lisp_Object |
| 1359 | load_unwind (Lisp_Object arg) /* used as unwind-protect function in load */ | 1356 | load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */ |
| 1360 | { | 1357 | { |
| 1361 | FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; | 1358 | FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; |
| 1362 | if (stream != NULL) | 1359 | if (stream != NULL) |
| @@ -1475,13 +1472,13 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto | |||
| 1475 | { | 1472 | { |
| 1476 | filename = Fexpand_file_name (str, XCAR (path)); | 1473 | filename = Fexpand_file_name (str, XCAR (path)); |
| 1477 | if (!complete_filename_p (filename)) | 1474 | if (!complete_filename_p (filename)) |
| 1478 | /* If there are non-absolute elts in PATH (eg ".") */ | 1475 | /* If there are non-absolute elts in PATH (eg "."). */ |
| 1479 | /* Of course, this could conceivably lose if luser sets | 1476 | /* Of course, this could conceivably lose if luser sets |
| 1480 | default-directory to be something non-absolute... */ | 1477 | default-directory to be something non-absolute... */ |
| 1481 | { | 1478 | { |
| 1482 | filename = Fexpand_file_name (filename, BVAR (current_buffer, directory)); | 1479 | filename = Fexpand_file_name (filename, BVAR (current_buffer, directory)); |
| 1483 | if (!complete_filename_p (filename)) | 1480 | if (!complete_filename_p (filename)) |
| 1484 | /* Give up on this path element! */ | 1481 | /* Give up on this path element! */ |
| 1485 | continue; | 1482 | continue; |
| 1486 | } | 1483 | } |
| 1487 | 1484 | ||
| @@ -1606,12 +1603,12 @@ build_load_history (Lisp_Object filename, int entire) | |||
| 1606 | { | 1603 | { |
| 1607 | tem = XCAR (tail); | 1604 | tem = XCAR (tail); |
| 1608 | 1605 | ||
| 1609 | /* Find the feature's previous assoc list... */ | 1606 | /* Find the feature's previous assoc list... */ |
| 1610 | if (!NILP (Fequal (filename, Fcar (tem)))) | 1607 | if (!NILP (Fequal (filename, Fcar (tem)))) |
| 1611 | { | 1608 | { |
| 1612 | foundit = 1; | 1609 | foundit = 1; |
| 1613 | 1610 | ||
| 1614 | /* If we're loading the entire file, remove old data. */ | 1611 | /* If we're loading the entire file, remove old data. */ |
| 1615 | if (entire) | 1612 | if (entire) |
| 1616 | { | 1613 | { |
| 1617 | if (NILP (prev)) | 1614 | if (NILP (prev)) |
| @@ -1653,13 +1650,6 @@ build_load_history (Lisp_Object filename, int entire) | |||
| 1653 | } | 1650 | } |
| 1654 | 1651 | ||
| 1655 | static Lisp_Object | 1652 | static Lisp_Object |
| 1656 | unreadpure (Lisp_Object junk) /* Used as unwind-protect function in readevalloop */ | ||
| 1657 | { | ||
| 1658 | read_pure = 0; | ||
| 1659 | return Qnil; | ||
| 1660 | } | ||
| 1661 | |||
| 1662 | static Lisp_Object | ||
| 1663 | readevalloop_1 (Lisp_Object old) | 1653 | readevalloop_1 (Lisp_Object old) |
| 1664 | { | 1654 | { |
| 1665 | load_convert_to_unibyte = ! NILP (old); | 1655 | load_convert_to_unibyte = ! NILP (old); |
| @@ -1735,7 +1725,7 @@ readevalloop (Lisp_Object readcharfun, | |||
| 1735 | 1725 | ||
| 1736 | GCPRO4 (sourcename, readfun, start, end); | 1726 | GCPRO4 (sourcename, readfun, start, end); |
| 1737 | 1727 | ||
| 1738 | /* Try to ensure sourcename is a truename, except whilst preloading. */ | 1728 | /* Try to ensure sourcename is a truename, except whilst preloading. */ |
| 1739 | if (NILP (Vpurify_flag) | 1729 | if (NILP (Vpurify_flag) |
| 1740 | && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename)) | 1730 | && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename)) |
| 1741 | && !NILP (Ffboundp (Qfile_truename))) | 1731 | && !NILP (Ffboundp (Qfile_truename))) |
| @@ -1800,8 +1790,7 @@ readevalloop (Lisp_Object readcharfun, | |||
| 1800 | 1790 | ||
| 1801 | if (!NILP (Vpurify_flag) && c == '(') | 1791 | if (!NILP (Vpurify_flag) && c == '(') |
| 1802 | { | 1792 | { |
| 1803 | record_unwind_protect (unreadpure, Qnil); | 1793 | val = read_list (0, readcharfun); |
| 1804 | val = read_list (-1, readcharfun); | ||
| 1805 | } | 1794 | } |
| 1806 | else | 1795 | else |
| 1807 | { | 1796 | { |
| @@ -1929,7 +1918,7 @@ This function does not move point. */) | |||
| 1929 | specbind (Qstandard_output, tem); | 1918 | specbind (Qstandard_output, tem); |
| 1930 | specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); | 1919 | specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); |
| 1931 | 1920 | ||
| 1932 | /* readevalloop calls functions which check the type of start and end. */ | 1921 | /* `readevalloop' calls functions which check the type of start and end. */ |
| 1933 | readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename), | 1922 | readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename), |
| 1934 | !NILP (printflag), Qnil, read_function, | 1923 | !NILP (printflag), Qnil, read_function, |
| 1935 | start, end); | 1924 | start, end); |
| @@ -1972,16 +1961,16 @@ START and END optionally delimit a substring of STRING from which to read; | |||
| 1972 | { | 1961 | { |
| 1973 | Lisp_Object ret; | 1962 | Lisp_Object ret; |
| 1974 | CHECK_STRING (string); | 1963 | CHECK_STRING (string); |
| 1975 | /* read_internal_start sets read_from_string_index. */ | 1964 | /* `read_internal_start' sets `read_from_string_index'. */ |
| 1976 | ret = read_internal_start (string, start, end); | 1965 | ret = read_internal_start (string, start, end); |
| 1977 | return Fcons (ret, make_number (read_from_string_index)); | 1966 | return Fcons (ret, make_number (read_from_string_index)); |
| 1978 | } | 1967 | } |
| 1979 | 1968 | ||
| 1980 | /* Function to set up the global context we need in toplevel read | 1969 | /* Function to set up the global context we need in toplevel read |
| 1981 | calls. */ | 1970 | calls. */ |
| 1982 | static Lisp_Object | 1971 | static Lisp_Object |
| 1983 | read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) | 1972 | read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) |
| 1984 | /* start, end only used when stream is a string. */ | 1973 | /* `start', `end' only used when stream is a string. */ |
| 1985 | { | 1974 | { |
| 1986 | Lisp_Object retval; | 1975 | Lisp_Object retval; |
| 1987 | 1976 | ||
| @@ -2046,7 +2035,7 @@ invalid_syntax (const char *s) | |||
| 2046 | 2035 | ||
| 2047 | 2036 | ||
| 2048 | /* Use this for recursive reads, in contexts where internal tokens | 2037 | /* Use this for recursive reads, in contexts where internal tokens |
| 2049 | are not allowed. */ | 2038 | are not allowed. */ |
| 2050 | 2039 | ||
| 2051 | static Lisp_Object | 2040 | static Lisp_Object |
| 2052 | read0 (Lisp_Object readcharfun) | 2041 | read0 (Lisp_Object readcharfun) |
| @@ -2073,7 +2062,7 @@ read_escape (Lisp_Object readcharfun, int stringp) | |||
| 2073 | { | 2062 | { |
| 2074 | register int c = READCHAR; | 2063 | register int c = READCHAR; |
| 2075 | /* \u allows up to four hex digits, \U up to eight. Default to the | 2064 | /* \u allows up to four hex digits, \U up to eight. Default to the |
| 2076 | behavior for \u, and change this value in the case that \U is seen. */ | 2065 | behavior for \u, and change this value in the case that \U is seen. */ |
| 2077 | int unicode_hex_count = 4; | 2066 | int unicode_hex_count = 4; |
| 2078 | 2067 | ||
| 2079 | switch (c) | 2068 | switch (c) |
| @@ -2259,8 +2248,8 @@ read_escape (Lisp_Object readcharfun, int stringp) | |||
| 2259 | while (++count <= unicode_hex_count) | 2248 | while (++count <= unicode_hex_count) |
| 2260 | { | 2249 | { |
| 2261 | c = READCHAR; | 2250 | c = READCHAR; |
| 2262 | /* isdigit and isalpha may be locale-specific, which we don't | 2251 | /* `isdigit' and `isalpha' may be locale-specific, which we don't |
| 2263 | want. */ | 2252 | want. */ |
| 2264 | if (c >= '0' && c <= '9') i = (i << 4) + (c - '0'); | 2253 | if (c >= '0' && c <= '9') i = (i << 4) + (c - '0'); |
| 2265 | else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10; | 2254 | else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10; |
| 2266 | else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10; | 2255 | else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10; |
| @@ -2414,13 +2403,13 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) | |||
| 2414 | { | 2403 | { |
| 2415 | /* Accept extended format for hashtables (extensible to | 2404 | /* Accept extended format for hashtables (extensible to |
| 2416 | other types), e.g. | 2405 | other types), e.g. |
| 2417 | #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ | 2406 | #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ |
| 2418 | Lisp_Object tmp = read_list (0, readcharfun); | 2407 | Lisp_Object tmp = read_list (0, readcharfun); |
| 2419 | Lisp_Object head = CAR_SAFE (tmp); | 2408 | Lisp_Object head = CAR_SAFE (tmp); |
| 2420 | Lisp_Object data = Qnil; | 2409 | Lisp_Object data = Qnil; |
| 2421 | Lisp_Object val = Qnil; | 2410 | Lisp_Object val = Qnil; |
| 2422 | /* The size is 2 * number of allowed keywords to | 2411 | /* The size is 2 * number of allowed keywords to |
| 2423 | make-hash-table. */ | 2412 | make-hash-table. */ |
| 2424 | Lisp_Object params[10]; | 2413 | Lisp_Object params[10]; |
| 2425 | Lisp_Object ht; | 2414 | Lisp_Object ht; |
| 2426 | Lisp_Object key = Qnil; | 2415 | Lisp_Object key = Qnil; |
| @@ -2432,36 +2421,36 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) | |||
| 2432 | 2421 | ||
| 2433 | tmp = CDR_SAFE (tmp); | 2422 | tmp = CDR_SAFE (tmp); |
| 2434 | 2423 | ||
| 2435 | /* This is repetitive but fast and simple. */ | 2424 | /* This is repetitive but fast and simple. */ |
| 2436 | params[param_count] = QCsize; | 2425 | params[param_count] = QCsize; |
| 2437 | params[param_count+1] = Fplist_get (tmp, Qsize); | 2426 | params[param_count + 1] = Fplist_get (tmp, Qsize); |
| 2438 | if (!NILP (params[param_count + 1])) | 2427 | if (!NILP (params[param_count + 1])) |
| 2439 | param_count += 2; | 2428 | param_count += 2; |
| 2440 | 2429 | ||
| 2441 | params[param_count] = QCtest; | 2430 | params[param_count] = QCtest; |
| 2442 | params[param_count+1] = Fplist_get (tmp, Qtest); | 2431 | params[param_count + 1] = Fplist_get (tmp, Qtest); |
| 2443 | if (!NILP (params[param_count + 1])) | 2432 | if (!NILP (params[param_count + 1])) |
| 2444 | param_count += 2; | 2433 | param_count += 2; |
| 2445 | 2434 | ||
| 2446 | params[param_count] = QCweakness; | 2435 | params[param_count] = QCweakness; |
| 2447 | params[param_count+1] = Fplist_get (tmp, Qweakness); | 2436 | params[param_count + 1] = Fplist_get (tmp, Qweakness); |
| 2448 | if (!NILP (params[param_count + 1])) | 2437 | if (!NILP (params[param_count + 1])) |
| 2449 | param_count += 2; | 2438 | param_count += 2; |
| 2450 | 2439 | ||
| 2451 | params[param_count] = QCrehash_size; | 2440 | params[param_count] = QCrehash_size; |
| 2452 | params[param_count+1] = Fplist_get (tmp, Qrehash_size); | 2441 | params[param_count + 1] = Fplist_get (tmp, Qrehash_size); |
| 2453 | if (!NILP (params[param_count + 1])) | 2442 | if (!NILP (params[param_count + 1])) |
| 2454 | param_count += 2; | 2443 | param_count += 2; |
| 2455 | 2444 | ||
| 2456 | params[param_count] = QCrehash_threshold; | 2445 | params[param_count] = QCrehash_threshold; |
| 2457 | params[param_count+1] = Fplist_get (tmp, Qrehash_threshold); | 2446 | params[param_count + 1] = Fplist_get (tmp, Qrehash_threshold); |
| 2458 | if (!NILP (params[param_count + 1])) | 2447 | if (!NILP (params[param_count + 1])) |
| 2459 | param_count += 2; | 2448 | param_count += 2; |
| 2460 | 2449 | ||
| 2461 | /* This is the hashtable data. */ | 2450 | /* This is the hashtable data. */ |
| 2462 | data = Fplist_get (tmp, Qdata); | 2451 | data = Fplist_get (tmp, Qdata); |
| 2463 | 2452 | ||
| 2464 | /* Now use params to make a new hashtable and fill it. */ | 2453 | /* Now use params to make a new hashtable and fill it. */ |
| 2465 | ht = Fmake_hash_table (param_count, params); | 2454 | ht = Fmake_hash_table (param_count, params); |
| 2466 | 2455 | ||
| 2467 | while (CONSP (data)) | 2456 | while (CONSP (data)) |
| @@ -2728,7 +2717,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) | |||
| 2728 | n for #n#. */ | 2717 | n for #n#. */ |
| 2729 | if (c == '=') | 2718 | if (c == '=') |
| 2730 | { | 2719 | { |
| 2731 | /* Make a placeholder for #n# to use temporarily */ | 2720 | /* Make a placeholder for #n# to use temporarily. */ |
| 2732 | Lisp_Object placeholder; | 2721 | Lisp_Object placeholder; |
| 2733 | Lisp_Object cell; | 2722 | Lisp_Object cell; |
| 2734 | 2723 | ||
| @@ -2736,10 +2725,10 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) | |||
| 2736 | cell = Fcons (make_number (n), placeholder); | 2725 | cell = Fcons (make_number (n), placeholder); |
| 2737 | read_objects = Fcons (cell, read_objects); | 2726 | read_objects = Fcons (cell, read_objects); |
| 2738 | 2727 | ||
| 2739 | /* Read the object itself. */ | 2728 | /* Read the object itself. */ |
| 2740 | tem = read0 (readcharfun); | 2729 | tem = read0 (readcharfun); |
| 2741 | 2730 | ||
| 2742 | /* Now put it everywhere the placeholder was... */ | 2731 | /* Now put it everywhere the placeholder was... */ |
| 2743 | substitute_object_in_subtree (tem, placeholder); | 2732 | substitute_object_in_subtree (tem, placeholder); |
| 2744 | 2733 | ||
| 2745 | /* ...and #n# will use the real value from now on. */ | 2734 | /* ...and #n# will use the real value from now on. */ |
| @@ -2922,7 +2911,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) | |||
| 2922 | 2911 | ||
| 2923 | ch = read_escape (readcharfun, 1); | 2912 | ch = read_escape (readcharfun, 1); |
| 2924 | 2913 | ||
| 2925 | /* CH is -1 if \ newline has just been seen */ | 2914 | /* CH is -1 if \ newline has just been seen. */ |
| 2926 | if (ch == -1) | 2915 | if (ch == -1) |
| 2927 | { | 2916 | { |
| 2928 | if (p == read_buffer) | 2917 | if (p == read_buffer) |
| @@ -2937,7 +2926,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) | |||
| 2937 | force_singlebyte = 1; | 2926 | force_singlebyte = 1; |
| 2938 | else if (! ASCII_CHAR_P (ch)) | 2927 | else if (! ASCII_CHAR_P (ch)) |
| 2939 | force_multibyte = 1; | 2928 | force_multibyte = 1; |
| 2940 | else /* i.e. ASCII_CHAR_P (ch) */ | 2929 | else /* I.e. ASCII_CHAR_P (ch). */ |
| 2941 | { | 2930 | { |
| 2942 | /* Allow `\C- ' and `\C-?'. */ | 2931 | /* Allow `\C- ' and `\C-?'. */ |
| 2943 | if (modifiers == CHAR_CTL) | 2932 | if (modifiers == CHAR_CTL) |
| @@ -3005,10 +2994,6 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) | |||
| 3005 | /* Otherwise, READ_BUFFER contains only ASCII. */ | 2994 | /* Otherwise, READ_BUFFER contains only ASCII. */ |
| 3006 | } | 2995 | } |
| 3007 | 2996 | ||
| 3008 | if (read_pure) | ||
| 3009 | return make_pure_string (read_buffer, nchars, p - read_buffer, | ||
| 3010 | (force_multibyte | ||
| 3011 | || (p - read_buffer != nchars))); | ||
| 3012 | return make_specified_string (read_buffer, nchars, p - read_buffer, | 2997 | return make_specified_string (read_buffer, nchars, p - read_buffer, |
| 3013 | (force_multibyte | 2998 | (force_multibyte |
| 3014 | || (p - read_buffer != nchars))); | 2999 | || (p - read_buffer != nchars))); |
| @@ -3128,7 +3113,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) | |||
| 3128 | } | 3113 | } |
| 3129 | 3114 | ||
| 3130 | 3115 | ||
| 3131 | /* List of nodes we've seen during substitute_object_in_subtree. */ | 3116 | /* List of nodes we've seen during substitute_object_in_subtree. */ |
| 3132 | static Lisp_Object seen_list; | 3117 | static Lisp_Object seen_list; |
| 3133 | 3118 | ||
| 3134 | static void | 3119 | static void |
| @@ -3136,23 +3121,23 @@ substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder) | |||
| 3136 | { | 3121 | { |
| 3137 | Lisp_Object check_object; | 3122 | Lisp_Object check_object; |
| 3138 | 3123 | ||
| 3139 | /* We haven't seen any objects when we start. */ | 3124 | /* We haven't seen any objects when we start. */ |
| 3140 | seen_list = Qnil; | 3125 | seen_list = Qnil; |
| 3141 | 3126 | ||
| 3142 | /* Make all the substitutions. */ | 3127 | /* Make all the substitutions. */ |
| 3143 | check_object | 3128 | check_object |
| 3144 | = substitute_object_recurse (object, placeholder, object); | 3129 | = substitute_object_recurse (object, placeholder, object); |
| 3145 | 3130 | ||
| 3146 | /* Clear seen_list because we're done with it. */ | 3131 | /* Clear seen_list because we're done with it. */ |
| 3147 | seen_list = Qnil; | 3132 | seen_list = Qnil; |
| 3148 | 3133 | ||
| 3149 | /* The returned object here is expected to always eq the | 3134 | /* The returned object here is expected to always eq the |
| 3150 | original. */ | 3135 | original. */ |
| 3151 | if (!EQ (check_object, object)) | 3136 | if (!EQ (check_object, object)) |
| 3152 | error ("Unexpected mutation error in reader"); | 3137 | error ("Unexpected mutation error in reader"); |
| 3153 | } | 3138 | } |
| 3154 | 3139 | ||
| 3155 | /* Feval doesn't get called from here, so no gc protection is needed. */ | 3140 | /* Feval doesn't get called from here, so no gc protection is needed. */ |
| 3156 | #define SUBSTITUTE(get_val, set_val) \ | 3141 | #define SUBSTITUTE(get_val, set_val) \ |
| 3157 | do { \ | 3142 | do { \ |
| 3158 | Lisp_Object old_value = get_val; \ | 3143 | Lisp_Object old_value = get_val; \ |
| @@ -3169,11 +3154,11 @@ substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder) | |||
| 3169 | static Lisp_Object | 3154 | static Lisp_Object |
| 3170 | substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree) | 3155 | substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree) |
| 3171 | { | 3156 | { |
| 3172 | /* If we find the placeholder, return the target object. */ | 3157 | /* If we find the placeholder, return the target object. */ |
| 3173 | if (EQ (placeholder, subtree)) | 3158 | if (EQ (placeholder, subtree)) |
| 3174 | return object; | 3159 | return object; |
| 3175 | 3160 | ||
| 3176 | /* If we've been to this node before, don't explore it again. */ | 3161 | /* If we've been to this node before, don't explore it again. */ |
| 3177 | if (!EQ (Qnil, Fmemq (subtree, seen_list))) | 3162 | if (!EQ (Qnil, Fmemq (subtree, seen_list))) |
| 3178 | return subtree; | 3163 | return subtree; |
| 3179 | 3164 | ||
| @@ -3223,7 +3208,7 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj | |||
| 3223 | case Lisp_String: | 3208 | case Lisp_String: |
| 3224 | { | 3209 | { |
| 3225 | /* Check for text properties in each interval. | 3210 | /* Check for text properties in each interval. |
| 3226 | substitute_in_interval contains part of the logic. */ | 3211 | substitute_in_interval contains part of the logic. */ |
| 3227 | 3212 | ||
| 3228 | INTERVAL root_interval = STRING_INTERVALS (subtree); | 3213 | INTERVAL root_interval = STRING_INTERVALS (subtree); |
| 3229 | Lisp_Object arg = Fcons (object, placeholder); | 3214 | Lisp_Object arg = Fcons (object, placeholder); |
| @@ -3234,7 +3219,7 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj | |||
| 3234 | return subtree; | 3219 | return subtree; |
| 3235 | } | 3220 | } |
| 3236 | 3221 | ||
| 3237 | /* Other types don't recurse any further. */ | 3222 | /* Other types don't recurse any further. */ |
| 3238 | default: | 3223 | default: |
| 3239 | return subtree; | 3224 | return subtree; |
| 3240 | } | 3225 | } |
| @@ -3421,7 +3406,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) | |||
| 3421 | 3406 | ||
| 3422 | tem = read_list (1, readcharfun); | 3407 | tem = read_list (1, readcharfun); |
| 3423 | len = Flength (tem); | 3408 | len = Flength (tem); |
| 3424 | vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil)); | 3409 | vector = Fmake_vector (len, Qnil); |
| 3425 | 3410 | ||
| 3426 | size = ASIZE (vector); | 3411 | size = ASIZE (vector); |
| 3427 | ptr = XVECTOR (vector)->contents; | 3412 | ptr = XVECTOR (vector)->contents; |
| @@ -3468,7 +3453,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) | |||
| 3468 | } | 3453 | } |
| 3469 | 3454 | ||
| 3470 | /* Now handle the bytecode slot. */ | 3455 | /* Now handle the bytecode slot. */ |
| 3471 | ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr; | 3456 | ptr[COMPILED_BYTECODE] = bytestr; |
| 3472 | } | 3457 | } |
| 3473 | else if (i == COMPILED_DOC_STRING | 3458 | else if (i == COMPILED_DOC_STRING |
| 3474 | && STRINGP (item) | 3459 | && STRINGP (item) |
| @@ -3480,7 +3465,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) | |||
| 3480 | item = Fstring_as_multibyte (item); | 3465 | item = Fstring_as_multibyte (item); |
| 3481 | } | 3466 | } |
| 3482 | } | 3467 | } |
| 3483 | ptr[i] = read_pure ? Fpurecopy (item) : item; | 3468 | ptr[i] = item; |
| 3484 | otem = XCONS (tem); | 3469 | otem = XCONS (tem); |
| 3485 | tem = Fcdr (tem); | 3470 | tem = Fcdr (tem); |
| 3486 | free_cons (otem); | 3471 | free_cons (otem); |
| @@ -3488,17 +3473,11 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) | |||
| 3488 | return vector; | 3473 | return vector; |
| 3489 | } | 3474 | } |
| 3490 | 3475 | ||
| 3491 | /* FLAG = 1 means check for ] to terminate rather than ) and . | 3476 | /* FLAG = 1 means check for ] to terminate rather than ) and . */ |
| 3492 | FLAG = -1 means check for starting with defun | ||
| 3493 | and make structure pure. */ | ||
| 3494 | 3477 | ||
| 3495 | static Lisp_Object | 3478 | static Lisp_Object |
| 3496 | read_list (int flag, register Lisp_Object readcharfun) | 3479 | read_list (int flag, register Lisp_Object readcharfun) |
| 3497 | { | 3480 | { |
| 3498 | /* -1 means check next element for defun, | ||
| 3499 | 0 means don't check, | ||
| 3500 | 1 means already checked and found defun. */ | ||
| 3501 | int defunflag = flag < 0 ? -1 : 0; | ||
| 3502 | Lisp_Object val, tail; | 3481 | Lisp_Object val, tail; |
| 3503 | register Lisp_Object elt, tem; | 3482 | register Lisp_Object elt, tem; |
| 3504 | struct gcpro gcpro1, gcpro2; | 3483 | struct gcpro gcpro1, gcpro2; |
| @@ -3660,24 +3639,18 @@ read_list (int flag, register Lisp_Object readcharfun) | |||
| 3660 | } | 3639 | } |
| 3661 | invalid_syntax ("] in a list"); | 3640 | invalid_syntax ("] in a list"); |
| 3662 | } | 3641 | } |
| 3663 | tem = (read_pure && flag <= 0 | 3642 | tem = Fcons (elt, Qnil); |
| 3664 | ? pure_cons (elt, Qnil) | ||
| 3665 | : Fcons (elt, Qnil)); | ||
| 3666 | if (!NILP (tail)) | 3643 | if (!NILP (tail)) |
| 3667 | XSETCDR (tail, tem); | 3644 | XSETCDR (tail, tem); |
| 3668 | else | 3645 | else |
| 3669 | val = tem; | 3646 | val = tem; |
| 3670 | tail = tem; | 3647 | tail = tem; |
| 3671 | if (defunflag < 0) | ||
| 3672 | defunflag = EQ (elt, Qdefun); | ||
| 3673 | else if (defunflag > 0) | ||
| 3674 | read_pure = 1; | ||
| 3675 | } | 3648 | } |
| 3676 | } | 3649 | } |
| 3677 | 3650 | ||
| 3678 | static Lisp_Object initial_obarray; | 3651 | static Lisp_Object initial_obarray; |
| 3679 | 3652 | ||
| 3680 | /* oblookup stores the bucket number here, for the sake of Funintern. */ | 3653 | /* `oblookup' stores the bucket number here, for the sake of Funintern. */ |
| 3681 | 3654 | ||
| 3682 | static size_t oblookup_last_bucket_number; | 3655 | static size_t oblookup_last_bucket_number; |
| 3683 | 3656 | ||
| @@ -3909,7 +3882,7 @@ oblookup (Lisp_Object obarray, register const char *ptr, EMACS_INT size, EMACS_I | |||
| 3909 | if (EQ (bucket, make_number (0))) | 3882 | if (EQ (bucket, make_number (0))) |
| 3910 | ; | 3883 | ; |
| 3911 | else if (!SYMBOLP (bucket)) | 3884 | else if (!SYMBOLP (bucket)) |
| 3912 | error ("Bad data in guts of obarray"); /* Like CADR error message */ | 3885 | error ("Bad data in guts of obarray"); /* Like CADR error message. */ |
| 3913 | else | 3886 | else |
| 3914 | for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next)) | 3887 | for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next)) |
| 3915 | { | 3888 | { |
| @@ -4016,7 +3989,7 @@ defsubr (struct Lisp_Subr *sname) | |||
| 4016 | XSETSUBR (XSYMBOL (sym)->function, sname); | 3989 | XSETSUBR (XSYMBOL (sym)->function, sname); |
| 4017 | } | 3990 | } |
| 4018 | 3991 | ||
| 4019 | #ifdef NOTDEF /* use fset in subr.el now */ | 3992 | #ifdef NOTDEF /* Use fset in subr.el now! */ |
| 4020 | void | 3993 | void |
| 4021 | defalias (struct Lisp_Subr *sname, char *string) | 3994 | defalias (struct Lisp_Subr *sname, char *string) |
| 4022 | { | 3995 | { |
| @@ -4361,7 +4334,7 @@ dir_warning (const char *format, Lisp_Object dirname) | |||
| 4361 | { | 4334 | { |
| 4362 | fprintf (stderr, format, SDATA (dirname)); | 4335 | fprintf (stderr, format, SDATA (dirname)); |
| 4363 | 4336 | ||
| 4364 | /* Don't log the warning before we've initialized!! */ | 4337 | /* Don't log the warning before we've initialized!! */ |
| 4365 | if (initialized) | 4338 | if (initialized) |
| 4366 | { | 4339 | { |
| 4367 | char *buffer; | 4340 | char *buffer; |