X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/0e46275b4d2f06f8d60302db2e94083d66349cbc..9f62b5dd0e873f6048630e1e59a371112bdcf720:/src/lread.c diff --git a/src/lread.c b/src/lread.c index 4990d25eda..033fa72581 100644 --- a/src/lread.c +++ b/src/lread.c @@ -213,7 +213,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte) else { c = BUF_FETCH_BYTE (inbuffer, pt_byte); - if (! ASCII_BYTE_P (c)) + if (! ASCII_CHAR_P (c)) c = BYTE8_TO_CHAR (c); pt_byte++; } @@ -242,7 +242,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte) else { c = BUF_FETCH_BYTE (inbuffer, bytepos); - if (! ASCII_BYTE_P (c)) + if (! ASCII_CHAR_P (c)) c = BYTE8_TO_CHAR (c); bytepos++; } @@ -324,7 +324,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte) return c; if (multibyte) *multibyte = 1; - if (ASCII_BYTE_P (c)) + if (ASCII_CHAR_P (c)) return c; if (emacs_mule_encoding) return read_emacs_mule_char (c, readbyte, readcharfun); @@ -1046,9 +1046,8 @@ Return t if the file exists and loads successfully. */) (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix) { - FILE *stream; + FILE *stream = NULL; int fd; - int fd_index; ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object found, efound, hist_file_name; @@ -1179,15 +1178,10 @@ Return t if the file exists and loads successfully. */) #endif } - if (fd < 0) - { - /* Pacify older GCC with --enable-gcc-warnings. */ - IF_LINT (fd_index = 0); - } - else + if (fd >= 0) { - fd_index = SPECPDL_INDEX (); - record_unwind_protect_int (close_file_unwind, fd); + record_unwind_protect_ptr (close_file_ptr_unwind, &fd); + record_unwind_protect_ptr (fclose_ptr_unwind, &stream); } /* Check if we're stuck in a recursive load cycle. @@ -1300,7 +1294,7 @@ Return t if the file exists and loads successfully. */) if (fd >= 0) { emacs_close (fd); - clear_unwind_protect (fd_index); + fd = -1; } val = call4 (Vload_source_file_function, found, hist_file_name, NILP (noerror) ? Qnil : Qt, @@ -1323,7 +1317,7 @@ Return t if the file exists and loads successfully. */) { #ifdef WINDOWSNT emacs_close (fd); - clear_unwind_protect (fd_index); + fd = -1; efound = ENCODE_FILE (found); stream = emacs_fopen (SSDATA (efound), fmode); #else @@ -1332,7 +1326,6 @@ Return t if the file exists and loads successfully. */) } if (! stream) report_file_error ("Opening stdio stream", file); - set_unwind_protect_ptr (fd_index, fclose_unwind, stream); if (! NILP (Vpurify_flag)) Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list); @@ -1763,6 +1756,29 @@ end_of_file_error (void) xsignal0 (Qend_of_file); } +static Lisp_Object +readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand) +{ + /* If we macroexpand the toplevel form non-recursively and it ends + up being a `progn' (or if it was a progn to start), treat each + form in the progn as a top-level form. This way, if one form in + the progn defines a macro, that macro is in effect when we expand + the remaining forms. See similar code in bytecomp.el. */ + val = call2 (macroexpand, val, Qnil); + if (EQ (CAR_SAFE (val), Qprogn)) + { + Lisp_Object subforms = XCDR (val); + val = Qnil; + for (; CONSP (subforms); subforms = XCDR (subforms)) + val = readevalloop_eager_expand_eval (XCAR (subforms), + macroexpand); + } + else + val = eval_sub (call2 (macroexpand, val, Qt)); + + return val; +} + /* UNIBYTE specifies how to set load_convert_to_unibyte for this invocation. READFUN, if non-nil, is used instead of `read'. @@ -1930,8 +1946,9 @@ readevalloop (Lisp_Object readcharfun, /* Now eval what we just read. */ if (!NILP (macroexpand)) - val = call1 (macroexpand, val); - val = eval_sub (val); + val = readevalloop_eager_expand_eval (val, macroexpand); + else + val = eval_sub (val); if (printflag) { @@ -2611,7 +2628,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE); return tmp; } - invalid_syntax ("#^^"); + invalid_syntax ("#^" "^"); } invalid_syntax ("#^"); } @@ -2754,7 +2771,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (saved_doc_string_size == 0) { - saved_doc_string = xmalloc (nskip + extra); + saved_doc_string = xmalloc_atomic (nskip + extra); saved_doc_string_size = nskip + extra; } if (nskip > saved_doc_string_size) @@ -3283,58 +3300,52 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj /* Recurse according to subtree's type. Every branch must return a Lisp_Object. */ - switch (XTYPE (subtree)) + if (VECTORLIKEP (subtree)) { - case Lisp_Vectorlike: - { - ptrdiff_t i, length = 0; - if (BOOL_VECTOR_P (subtree)) - return subtree; /* No sub-objects anyway. */ - else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree) - || COMPILEDP (subtree) || HASH_TABLE_P (subtree)) - length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK; - else if (VECTORP (subtree)) - length = ASIZE (subtree); - else - /* An unknown pseudovector may contain non-Lisp fields, so we - can't just blindly traverse all its fields. We used to call - `Flength' which signaled `sequencep', so I just preserved this - behavior. */ - wrong_type_argument (Qsequencep, subtree); - - for (i = 0; i < length; i++) - SUBSTITUTE (AREF (subtree, i), - ASET (subtree, i, true_value)); - return subtree; - } - - case Lisp_Cons: - { - SUBSTITUTE (XCAR (subtree), - XSETCAR (subtree, true_value)); - SUBSTITUTE (XCDR (subtree), - XSETCDR (subtree, true_value)); - return subtree; - } - - case Lisp_String: - { - /* Check for text properties in each interval. - substitute_in_interval contains part of the logic. */ - - INTERVAL root_interval = string_intervals (subtree); - Lisp_Object arg = Fcons (object, placeholder); + ptrdiff_t i, length = 0; + if (BOOL_VECTOR_P (subtree)) + return subtree; /* No sub-objects anyway. */ + else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree) + || COMPILEDP (subtree) || HASH_TABLE_P (subtree)) + length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK; + else if (VECTORP (subtree)) + length = ASIZE (subtree); + else + /* An unknown pseudovector may contain non-Lisp fields, so we + can't just blindly traverse all its fields. We used to call + `Flength' which signaled `sequencep', so I just preserved this + behavior. */ + wrong_type_argument (Qsequencep, subtree); + + for (i = 0; i < length; i++) + SUBSTITUTE (AREF (subtree, i), + ASET (subtree, i, true_value)); + return subtree; + } + else if (CONSP (subtree)) + { + SUBSTITUTE (XCAR (subtree), + XSETCAR (subtree, true_value)); + SUBSTITUTE (XCDR (subtree), + XSETCDR (subtree, true_value)); + return subtree; + } + else if (STRINGP (subtree)) + { + /* Check for text properties in each interval. + substitute_in_interval contains part of the logic. */ - traverse_intervals_noorder (root_interval, - &substitute_in_interval, arg); + INTERVAL root_interval = string_intervals (subtree); + Lisp_Object arg = Fcons (object, placeholder); - return subtree; - } + traverse_intervals_noorder (root_interval, + &substitute_in_interval, arg); - /* Other types don't recurse any further. */ - default: return subtree; } + else + /* Other types don't recurse any further. */ + return subtree; } /* Helper function for substitute_object_recurse. */ @@ -3513,7 +3524,6 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag) ptrdiff_t i, size; Lisp_Object *ptr; Lisp_Object tem, item, vector; - struct Lisp_Cons *otem; Lisp_Object len; tem = read_list (1, readcharfun); @@ -3558,10 +3568,8 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag) if (!CONSP (item)) error ("Invalid byte code"); - otem = XCONS (item); bytestr = XCAR (item); item = XCDR (item); - free_cons (otem); } /* Now handle the bytecode slot. */ @@ -3578,9 +3586,7 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag) } } ASET (vector, i, item); - otem = XCONS (tem); tem = Fcdr (tem); - free_cons (otem); } return vector; } @@ -3826,7 +3832,7 @@ it defaults to the value of `obarray'. */) SET_SYMBOL_VAL (XSYMBOL (sym), sym); } - ptr = aref_addr (obarray, XINT(tem)); + ptr = aref_addr (obarray, XINT (tem)); if (SYMBOLP (*ptr)) set_symbol_next (sym, XSYMBOL (*ptr)); else @@ -3954,9 +3960,6 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff obarray = check_obarray (obarray); obsize = ASIZE (obarray); - - /* This is sometimes needed in the middle of GC. */ - obsize &= ~ARRAY_MARK_FLAG; hash = hash_string (ptr, size_byte) % obsize; bucket = AREF (obarray, hash); oblookup_last_bucket_number = hash; @@ -4057,7 +4060,7 @@ init_obarray (void) DEFSYM (Qvariable_documentation, "variable-documentation"); - read_buffer = xmalloc (size); + read_buffer = xmalloc_atomic (size); read_buffer_size = size; } @@ -4066,21 +4069,12 @@ defsubr (struct Lisp_Subr *sname) { Lisp_Object sym, tem; sym = intern_c_string (sname->symbol_name); + SCM_NEWSMOB (sname->header.self, lisp_vectorlike_tag, sname); XSETPVECTYPE (sname, PVEC_SUBR); XSETSUBR (tem, sname); set_symbol_function (sym, tem); } -#ifdef NOTDEF /* Use fset in subr.el now! */ -void -defalias (struct Lisp_Subr *sname, char *string) -{ - Lisp_Object sym; - sym = intern (string); - XSETSUBR (XSYMBOL (sym)->function, sname); -} -#endif /* NOTDEF */ - /* Define an "integer variable"; a symbol whose value is forwarded to a C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile): DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */ @@ -4447,21 +4441,7 @@ dir_warning (char const *use, Lisp_Object dirname) void syms_of_lread (void) { - defsubr (&Sread); - defsubr (&Sread_from_string); - defsubr (&Sintern); - defsubr (&Sintern_soft); - defsubr (&Sunintern); - defsubr (&Sget_load_suffixes); - defsubr (&Sload); - defsubr (&Seval_buffer); - defsubr (&Seval_region); - defsubr (&Sread_char); - defsubr (&Sread_char_exclusive); - defsubr (&Sread_event); - defsubr (&Sget_file_char); - defsubr (&Smapatoms); - defsubr (&Slocate_file_internal); +#include "lread.x" DEFVAR_LISP ("obarray", Vobarray, doc: /* Symbol table for use by `intern' and `read'.