X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3acf58eec890249179b6f992c59f9adcf05b8ca8..bf90e9ac7caec15b0f111e0bb67e311233f3a795:/src/lread.c diff --git a/src/lread.c b/src/lread.c index 25c3503d86..6463e1051b 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1,6 +1,6 @@ /* Lisp parsing and input streams. -Copyright (C) 1985-1989, 1993-1995, 1997-2014 Free Software Foundation, +Copyright (C) 1985-1989, 1993-1995, 1997-2015 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -66,7 +66,8 @@ along with GNU Emacs. If not, see . */ /* Hash table read constants. */ static Lisp_Object Qhash_table, Qdata; -static Lisp_Object Qtest, Qsize; +static Lisp_Object Qtest; +Lisp_Object Qsize; static Lisp_Object Qweakness; static Lisp_Object Qrehash_size; static Lisp_Object Qrehash_threshold; @@ -970,10 +971,8 @@ load_warn_old_style_backquotes (Lisp_Object file) { if (!NILP (Vold_style_backquotes)) { - Lisp_Object args[2]; - args[0] = build_string ("Loading `%s': old-style backquotes detected!"); - args[1] = file; - Fmessage (2, args); + AUTO_STRING (format, "Loading `%s': old-style backquotes detected!"); + Fmessage (2, (Lisp_Object []) {format, file}); } } @@ -1473,6 +1472,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, ptrdiff_t max_suffix_len = 0; int last_errno = ENOENT; int save_fd = -1; + USE_SAFE_ALLOCA; /* The last-modified time of the newest matching file found. Initialize it to something less than all valid timestamps. */ @@ -1513,7 +1513,10 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, this path element/specified file name and any possible suffix. */ want_length = max_suffix_len + SBYTES (filename); if (fn_size <= want_length) - fn = alloca (fn_size = 100 + want_length); + { + fn_size = 100 + want_length; + fn = SAFE_ALLOCA (fn_size); + } /* Loop over suffixes. */ for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes; @@ -1579,6 +1582,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, /* We succeeded; return this descriptor and filename. */ if (storeptr) *storeptr = string; + SAFE_FREE (); UNGCPRO; return -2; } @@ -1651,6 +1655,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, /* We succeeded; return this descriptor and filename. */ if (storeptr) *storeptr = string; + SAFE_FREE (); UNGCPRO; return fd; } @@ -1661,6 +1666,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, { if (storeptr) *storeptr = save_string; + SAFE_FREE (); UNGCPRO; return save_fd; } @@ -1670,6 +1676,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, break; } + SAFE_FREE (); UNGCPRO; errno = last_errno; return -1; @@ -1774,15 +1781,17 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand) val = call2 (macroexpand, val, Qnil); if (EQ (CAR_SAFE (val), Qprogn)) { + struct gcpro gcpro1; Lisp_Object subforms = XCDR (val); - val = Qnil; - for (; CONSP (subforms); subforms = XCDR (subforms)) + + GCPRO1 (subforms); + for (val = Qnil; CONSP (subforms); subforms = XCDR (subforms)) val = readevalloop_eager_expand_eval (XCAR (subforms), macroexpand); + UNGCPRO; } else val = eval_sub (call2 (macroexpand, val, Qt)); - return val; } @@ -2088,9 +2097,10 @@ DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0, doc: /* Read one Lisp expression which is represented as text by STRING. Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX). FINAL-STRING-INDEX is an integer giving the position of the next - remaining character in STRING. -START and END optionally delimit a substring of STRING from which to read; - they default to 0 and (length STRING) respectively. */) +remaining character in STRING. START and END optionally delimit +a substring of STRING from which to read; they default to 0 and +(length STRING) respectively. Negative values are counted from +the end of STRING. */) (Lisp_Object string, Lisp_Object start, Lisp_Object end) { Lisp_Object ret; @@ -2101,10 +2111,9 @@ START and END optionally delimit a substring of STRING from which to read; } /* Function to set up the global context we need in toplevel read - calls. */ + calls. START and END only used when STREAM is a string. */ static Lisp_Object read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) -/* `start', `end' only used when stream is a string. */ { Lisp_Object retval; @@ -2126,25 +2135,9 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) else string = XCAR (stream); - if (NILP (end)) - endval = SCHARS (string); - else - { - CHECK_NUMBER (end); - if (! (0 <= XINT (end) && XINT (end) <= SCHARS (string))) - args_out_of_range (string, end); - endval = XINT (end); - } + validate_subarray (string, start, end, SCHARS (string), + &startval, &endval); - if (NILP (start)) - startval = 0; - else - { - CHECK_NUMBER (start); - if (! (0 <= XINT (start) && XINT (start) <= endval)) - args_out_of_range (string, start); - startval = XINT (start); - } read_from_string_index = startval; read_from_string_index_byte = string_char_to_byte (string, startval); read_from_string_limit = endval; @@ -2747,7 +2740,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) while ((c = READCHAR) >= 0 && c >= '0' && c <= '9') { - if (nskip >= (STRING_BYTES_BOUND - extra) / 10) + if ((STRING_BYTES_BOUND - extra) / 10 <= nskip) string_overflow (); digits++; nskip *= 10; @@ -2861,8 +2854,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* Read a non-negative integer. */ while (c >= '0' && c <= '9') { - if (n > MOST_POSITIVE_FIXNUM / 10 - || n * 10 + c - '0' > MOST_POSITIVE_FIXNUM) + if (MOST_POSITIVE_FIXNUM / 10 < n + || MOST_POSITIVE_FIXNUM < n * 10 + c - '0') n = MOST_POSITIVE_FIXNUM + 1; else n = n * 10 + c - '0'; @@ -2881,11 +2874,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == '=') { /* Make a placeholder for #n# to use temporarily. */ - Lisp_Object placeholder; - Lisp_Object cell; - - placeholder = Fcons (Qnil, Qnil); - cell = Fcons (make_number (n), placeholder); + AUTO_CONS (placeholder, Qnil, Qnil); + Lisp_Object cell = Fcons (make_number (n), placeholder); read_objects = Fcons (cell, read_objects); /* Read the object itself. */ @@ -3058,7 +3048,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (end - p < MAX_MULTIBYTE_LENGTH) { ptrdiff_t offset = p - read_buffer; - if (read_buffer_size > min (PTRDIFF_MAX, SIZE_MAX) / 2) + if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size) memory_full (SIZE_MAX); read_buffer = xrealloc (read_buffer, read_buffer_size * 2); read_buffer_size *= 2; @@ -3192,7 +3182,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (end - p < MAX_MULTIBYTE_LENGTH) { ptrdiff_t offset = p - read_buffer; - if (read_buffer_size > min (PTRDIFF_MAX, SIZE_MAX) / 2) + if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size) memory_full (SIZE_MAX); read_buffer = xrealloc (read_buffer, read_buffer_size * 2); read_buffer_size *= 2; @@ -3222,7 +3212,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (p == end) { ptrdiff_t offset = p - read_buffer; - if (read_buffer_size > min (PTRDIFF_MAX, SIZE_MAX) / 2) + if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size) memory_full (SIZE_MAX); read_buffer = xrealloc (read_buffer, read_buffer_size * 2); read_buffer_size *= 2; @@ -3364,7 +3354,7 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj substitute_in_interval contains part of the logic. */ INTERVAL root_interval = string_intervals (subtree); - Lisp_Object arg = Fcons (object, placeholder); + AUTO_CONS (arg, object, placeholder); traverse_intervals_noorder (root_interval, &substitute_in_interval, arg); @@ -3671,8 +3661,10 @@ read_list (bool flag, Lisp_Object readcharfun) in the installed Lisp directory. We don't use Fexpand_file_name because that would make the directory absolute now. */ - elt = concat2 (build_string ("../lisp/"), - Ffile_name_nondirectory (elt)); + { + AUTO_STRING (dot_dot_lisp, "../lisp/"); + elt = concat2 (dot_dot_lisp, Ffile_name_nondirectory (elt)); + } } else if (EQ (elt, Vload_file_name) && ! NILP (elt) @@ -3800,6 +3792,30 @@ check_obarray (Lisp_Object obarray) return obarray; } +/* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */ + +Lisp_Object +intern_driver (Lisp_Object string, Lisp_Object obarray, ptrdiff_t index) +{ + Lisp_Object *ptr, sym = Fmake_symbol (string); + + XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray) + ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY + : SYMBOL_INTERNED); + + if ((SREF (string, 0) == ':') && EQ (obarray, initial_obarray)) + { + XSYMBOL (sym)->constant = 1; + XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; + SET_SYMBOL_VAL (XSYMBOL (sym), sym); + } + + ptr = aref_addr (obarray, index); + set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL); + *ptr = sym; + return sym; +} + /* Intern the C string STR: return a symbol with that name, interned in the current obarray. */ @@ -3809,7 +3825,8 @@ intern_1 (const char *str, ptrdiff_t len) Lisp_Object obarray = check_obarray (Vobarray); Lisp_Object tem = oblookup (obarray, str, len, len); - return SYMBOLP (tem) ? tem : Fintern (make_string (str, len), obarray); + return SYMBOLP (tem) ? tem : intern_driver (make_string (str, len), + obarray, XINT (tem)); } Lisp_Object @@ -3818,16 +3835,14 @@ intern_c_string_1 (const char *str, ptrdiff_t len) Lisp_Object obarray = check_obarray (Vobarray); Lisp_Object tem = oblookup (obarray, str, len, len); - if (SYMBOLP (tem)) - return tem; - - if (NILP (Vpurify_flag)) - /* Creating a non-pure string from a string literal not - implemented yet. We could just use make_string here and live - with the extra copy. */ - emacs_abort (); - - return Fintern (make_pure_c_string (str, len), obarray); + if (!SYMBOLP (tem)) + { + /* Creating a non-pure string from a string literal not implemented yet. + We could just use make_string here and live with the extra copy. */ + eassert (!NILP (Vpurify_flag)); + tem = intern_driver (make_pure_c_string (str, len), obarray, XINT (tem)); + } + return tem; } DEFUN ("intern", Fintern, Sintern, 1, 2, 0, @@ -3837,43 +3852,16 @@ A second optional argument specifies the obarray to use; it defaults to the value of `obarray'. */) (Lisp_Object string, Lisp_Object obarray) { - register Lisp_Object tem, sym, *ptr; - - if (NILP (obarray)) obarray = Vobarray; - obarray = check_obarray (obarray); + Lisp_Object tem; + obarray = check_obarray (NILP (obarray) ? Vobarray : obarray); CHECK_STRING (string); - tem = oblookup (obarray, SSDATA (string), - SCHARS (string), - SBYTES (string)); - if (!INTEGERP (tem)) - return tem; - - if (!NILP (Vpurify_flag)) - string = Fpurecopy (string); - sym = Fmake_symbol (string); - - if (EQ (obarray, initial_obarray)) - XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY; - else - XSYMBOL (sym)->interned = SYMBOL_INTERNED; - - if ((SREF (string, 0) == ':') - && EQ (obarray, initial_obarray)) - { - XSYMBOL (sym)->constant = 1; - XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; - SET_SYMBOL_VAL (XSYMBOL (sym), sym); - } - - ptr = aref_addr (obarray, XINT (tem)); - if (SYMBOLP (*ptr)) - set_symbol_next (sym, XSYMBOL (*ptr)); - else - set_symbol_next (sym, NULL); - *ptr = sym; - return sym; + tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); + if (!SYMBOLP (tem)) + tem = intern_driver (NILP (Vpurify_flag) ? string + : Fpurecopy (string), obarray, XINT (tem)); + return tem; } DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0, @@ -4084,14 +4072,14 @@ init_obarray (void) set_symbol_plist (Qunbound, Qnil); SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); XSYMBOL (Qnil)->constant = 1; - XSYMBOL (Qnil)->declared_special = 1; + XSYMBOL (Qnil)->declared_special = true; set_symbol_plist (Qnil, Qnil); set_symbol_function (Qnil, Qnil); Qt = intern_c_string ("t"); SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); - XSYMBOL (Qnil)->declared_special = 1; XSYMBOL (Qt)->constant = 1; + XSYMBOL (Qt)->declared_special = true; /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ Vpurify_flag = Qt; @@ -4213,7 +4201,7 @@ load_path_check (Lisp_Object lpath) if (STRINGP (dirfile)) { dirfile = Fdirectory_file_name (dirfile); - if (! file_accessible_directory_p (SSDATA (dirfile))) + if (! file_accessible_directory_p (dirfile)) dir_warning ("Lisp directory", XCAR (path_tail)); } }