diff options
Diffstat (limited to 'src/lread.c')
| -rw-r--r-- | src/lread.c | 101 |
1 files changed, 48 insertions, 53 deletions
diff --git a/src/lread.c b/src/lread.c index 6463e1051b5..324052462fe 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -18,6 +18,8 @@ GNU General Public License for more details. | |||
| 18 | You should have received a copy of the GNU General Public License | 18 | You should have received a copy of the GNU General Public License |
| 19 | along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | 19 | along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 20 | 20 | ||
| 21 | /* Tell globals.h to define tables needed by init_obarray. */ | ||
| 22 | #define DEFINE_SYMBOLS | ||
| 21 | 23 | ||
| 22 | #include <config.h> | 24 | #include <config.h> |
| 23 | #include "sysstdio.h" | 25 | #include "sysstdio.h" |
| @@ -64,32 +66,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 64 | #define file_tell ftell | 66 | #define file_tell ftell |
| 65 | #endif | 67 | #endif |
| 66 | 68 | ||
| 67 | /* Hash table read constants. */ | ||
| 68 | static Lisp_Object Qhash_table, Qdata; | ||
| 69 | static Lisp_Object Qtest; | ||
| 70 | Lisp_Object Qsize; | ||
| 71 | static Lisp_Object Qweakness; | ||
| 72 | static Lisp_Object Qrehash_size; | ||
| 73 | static Lisp_Object Qrehash_threshold; | ||
| 74 | |||
| 75 | static Lisp_Object Qread_char, Qget_file_char, Qcurrent_load_list; | ||
| 76 | Lisp_Object Qstandard_input; | ||
| 77 | Lisp_Object Qvariable_documentation; | ||
| 78 | static Lisp_Object Qascii_character, Qload, Qload_file_name; | ||
| 79 | Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; | ||
| 80 | static Lisp_Object Qinhibit_file_name_operation; | ||
| 81 | static Lisp_Object Qeval_buffer_list; | ||
| 82 | Lisp_Object Qlexical_binding; | ||
| 83 | static Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */ | ||
| 84 | |||
| 85 | /* Used instead of Qget_file_char while loading *.elc files compiled | ||
| 86 | by Emacs 21 or older. */ | ||
| 87 | static Lisp_Object Qget_emacs_mule_file_char; | ||
| 88 | |||
| 89 | static Lisp_Object Qload_force_doc_strings; | ||
| 90 | |||
| 91 | static Lisp_Object Qload_in_progress; | ||
| 92 | |||
| 93 | /* The association list of objects read with the #n=object form. | 69 | /* The association list of objects read with the #n=object form. |
| 94 | Each member of the list has the form (n . object), and is used to | 70 | Each member of the list has the form (n . object), and is used to |
| 95 | look up the object for the corresponding #n# construct. | 71 | look up the object for the corresponding #n# construct. |
| @@ -133,7 +109,6 @@ static file_offset prev_saved_doc_string_position; | |||
| 133 | Fread initializes this to false, so we need not specbind it | 109 | Fread initializes this to false, so we need not specbind it |
| 134 | or worry about what happens to it when there is an error. */ | 110 | or worry about what happens to it when there is an error. */ |
| 135 | static bool new_backquote_flag; | 111 | static bool new_backquote_flag; |
| 136 | static Lisp_Object Qold_style_backquotes; | ||
| 137 | 112 | ||
| 138 | /* A list of file names for files being loaded in Fload. Used to | 113 | /* A list of file names for files being loaded in Fload. Used to |
| 139 | check for recursive loads. */ | 114 | check for recursive loads. */ |
| @@ -1430,8 +1405,6 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) | |||
| 1430 | return file; | 1405 | return file; |
| 1431 | } | 1406 | } |
| 1432 | 1407 | ||
| 1433 | static Lisp_Object Qdir_ok; | ||
| 1434 | |||
| 1435 | /* Search for a file whose name is STR, looking in directories | 1408 | /* Search for a file whose name is STR, looking in directories |
| 1436 | in the Lisp list PATH, and trying suffixes from SUFFIX. | 1409 | in the Lisp list PATH, and trying suffixes from SUFFIX. |
| 1437 | On success, return a file descriptor (or 1 or -2 as described below). | 1410 | On success, return a file descriptor (or 1 or -2 as described below). |
| @@ -3792,30 +3765,38 @@ check_obarray (Lisp_Object obarray) | |||
| 3792 | return obarray; | 3765 | return obarray; |
| 3793 | } | 3766 | } |
| 3794 | 3767 | ||
| 3795 | /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */ | 3768 | /* Intern symbol SYM in OBARRAY using bucket INDEX. */ |
| 3796 | 3769 | ||
| 3797 | Lisp_Object | 3770 | static Lisp_Object |
| 3798 | intern_driver (Lisp_Object string, Lisp_Object obarray, ptrdiff_t index) | 3771 | intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) |
| 3799 | { | 3772 | { |
| 3800 | Lisp_Object *ptr, sym = Fmake_symbol (string); | 3773 | Lisp_Object *ptr; |
| 3801 | 3774 | ||
| 3802 | XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray) | 3775 | XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray) |
| 3803 | ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY | 3776 | ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY |
| 3804 | : SYMBOL_INTERNED); | 3777 | : SYMBOL_INTERNED); |
| 3805 | 3778 | ||
| 3806 | if ((SREF (string, 0) == ':') && EQ (obarray, initial_obarray)) | 3779 | if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray)) |
| 3807 | { | 3780 | { |
| 3808 | XSYMBOL (sym)->constant = 1; | 3781 | XSYMBOL (sym)->constant = 1; |
| 3809 | XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; | 3782 | XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; |
| 3810 | SET_SYMBOL_VAL (XSYMBOL (sym), sym); | 3783 | SET_SYMBOL_VAL (XSYMBOL (sym), sym); |
| 3811 | } | 3784 | } |
| 3812 | 3785 | ||
| 3813 | ptr = aref_addr (obarray, index); | 3786 | ptr = aref_addr (obarray, XINT (index)); |
| 3814 | set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL); | 3787 | set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL); |
| 3815 | *ptr = sym; | 3788 | *ptr = sym; |
| 3816 | return sym; | 3789 | return sym; |
| 3817 | } | 3790 | } |
| 3818 | 3791 | ||
| 3792 | /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */ | ||
| 3793 | |||
| 3794 | Lisp_Object | ||
| 3795 | intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index) | ||
| 3796 | { | ||
| 3797 | return intern_sym (Fmake_symbol (string), obarray, index); | ||
| 3798 | } | ||
| 3799 | |||
| 3819 | /* Intern the C string STR: return a symbol with that name, | 3800 | /* Intern the C string STR: return a symbol with that name, |
| 3820 | interned in the current obarray. */ | 3801 | interned in the current obarray. */ |
| 3821 | 3802 | ||
| @@ -3826,7 +3807,7 @@ intern_1 (const char *str, ptrdiff_t len) | |||
| 3826 | Lisp_Object tem = oblookup (obarray, str, len, len); | 3807 | Lisp_Object tem = oblookup (obarray, str, len, len); |
| 3827 | 3808 | ||
| 3828 | return SYMBOLP (tem) ? tem : intern_driver (make_string (str, len), | 3809 | return SYMBOLP (tem) ? tem : intern_driver (make_string (str, len), |
| 3829 | obarray, XINT (tem)); | 3810 | obarray, tem); |
| 3830 | } | 3811 | } |
| 3831 | 3812 | ||
| 3832 | Lisp_Object | 3813 | Lisp_Object |
| @@ -3840,10 +3821,27 @@ intern_c_string_1 (const char *str, ptrdiff_t len) | |||
| 3840 | /* Creating a non-pure string from a string literal not implemented yet. | 3821 | /* Creating a non-pure string from a string literal not implemented yet. |
| 3841 | We could just use make_string here and live with the extra copy. */ | 3822 | We could just use make_string here and live with the extra copy. */ |
| 3842 | eassert (!NILP (Vpurify_flag)); | 3823 | eassert (!NILP (Vpurify_flag)); |
| 3843 | tem = intern_driver (make_pure_c_string (str, len), obarray, XINT (tem)); | 3824 | tem = intern_driver (make_pure_c_string (str, len), obarray, tem); |
| 3844 | } | 3825 | } |
| 3845 | return tem; | 3826 | return tem; |
| 3846 | } | 3827 | } |
| 3828 | |||
| 3829 | static void | ||
| 3830 | define_symbol (Lisp_Object sym, char const *str) | ||
| 3831 | { | ||
| 3832 | ptrdiff_t len = strlen (str); | ||
| 3833 | Lisp_Object string = make_pure_c_string (str, len); | ||
| 3834 | init_symbol (sym, string); | ||
| 3835 | |||
| 3836 | /* Qunbound is uninterned, so that it's not confused with any symbol | ||
| 3837 | 'unbound' created by a Lisp program. */ | ||
| 3838 | if (! EQ (sym, Qunbound)) | ||
| 3839 | { | ||
| 3840 | Lisp_Object bucket = oblookup (initial_obarray, str, len, len); | ||
| 3841 | eassert (INTEGERP (bucket)); | ||
| 3842 | intern_sym (sym, initial_obarray, bucket); | ||
| 3843 | } | ||
| 3844 | } | ||
| 3847 | 3845 | ||
| 3848 | DEFUN ("intern", Fintern, Sintern, 1, 2, 0, | 3846 | DEFUN ("intern", Fintern, Sintern, 1, 2, 0, |
| 3849 | doc: /* Return the canonical symbol whose name is STRING. | 3847 | doc: /* Return the canonical symbol whose name is STRING. |
| @@ -3859,8 +3857,8 @@ it defaults to the value of `obarray'. */) | |||
| 3859 | 3857 | ||
| 3860 | tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); | 3858 | tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); |
| 3861 | if (!SYMBOLP (tem)) | 3859 | if (!SYMBOLP (tem)) |
| 3862 | tem = intern_driver (NILP (Vpurify_flag) ? string | 3860 | tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string), |
| 3863 | : Fpurecopy (string), obarray, XINT (tem)); | 3861 | obarray, tem); |
| 3864 | return tem; | 3862 | return tem; |
| 3865 | } | 3863 | } |
| 3866 | 3864 | ||
| @@ -4059,24 +4057,17 @@ init_obarray (void) | |||
| 4059 | initial_obarray = Vobarray; | 4057 | initial_obarray = Vobarray; |
| 4060 | staticpro (&initial_obarray); | 4058 | staticpro (&initial_obarray); |
| 4061 | 4059 | ||
| 4062 | Qunbound = Fmake_symbol (build_pure_c_string ("unbound")); | 4060 | for (int i = 0; i < ARRAYELTS (lispsym); i++) |
| 4063 | /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the | 4061 | define_symbol (make_lisp_symbol (&lispsym[i]), defsym_name[i]); |
| 4064 | NILP (Vpurify_flag) check in intern_c_string. */ | 4062 | |
| 4065 | Qnil = make_number (-1); Vpurify_flag = make_number (1); | 4063 | DEFSYM (Qunbound, "unbound"); |
| 4066 | Qnil = intern_c_string ("nil"); | 4064 | |
| 4067 | 4065 | DEFSYM (Qnil, "nil"); | |
| 4068 | /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil, | ||
| 4069 | so those two need to be fixed manually. */ | ||
| 4070 | SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound); | ||
| 4071 | set_symbol_function (Qunbound, Qnil); | ||
| 4072 | set_symbol_plist (Qunbound, Qnil); | ||
| 4073 | SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); | 4066 | SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); |
| 4074 | XSYMBOL (Qnil)->constant = 1; | 4067 | XSYMBOL (Qnil)->constant = 1; |
| 4075 | XSYMBOL (Qnil)->declared_special = true; | 4068 | XSYMBOL (Qnil)->declared_special = true; |
| 4076 | set_symbol_plist (Qnil, Qnil); | ||
| 4077 | set_symbol_function (Qnil, Qnil); | ||
| 4078 | 4069 | ||
| 4079 | Qt = intern_c_string ("t"); | 4070 | DEFSYM (Qt, "t"); |
| 4080 | SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); | 4071 | SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); |
| 4081 | XSYMBOL (Qt)->constant = 1; | 4072 | XSYMBOL (Qt)->constant = 1; |
| 4082 | XSYMBOL (Qt)->declared_special = true; | 4073 | XSYMBOL (Qt)->declared_special = true; |
| @@ -4729,7 +4720,11 @@ that are loaded before your customizations are read! */); | |||
| 4729 | DEFSYM (Qstandard_input, "standard-input"); | 4720 | DEFSYM (Qstandard_input, "standard-input"); |
| 4730 | DEFSYM (Qread_char, "read-char"); | 4721 | DEFSYM (Qread_char, "read-char"); |
| 4731 | DEFSYM (Qget_file_char, "get-file-char"); | 4722 | DEFSYM (Qget_file_char, "get-file-char"); |
| 4723 | |||
| 4724 | /* Used instead of Qget_file_char while loading *.elc files compiled | ||
| 4725 | by Emacs 21 or older. */ | ||
| 4732 | DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char"); | 4726 | DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char"); |
| 4727 | |||
| 4733 | DEFSYM (Qload_force_doc_strings, "load-force-doc-strings"); | 4728 | DEFSYM (Qload_force_doc_strings, "load-force-doc-strings"); |
| 4734 | 4729 | ||
| 4735 | DEFSYM (Qbackquote, "`"); | 4730 | DEFSYM (Qbackquote, "`"); |