X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/09af58633c2a83b61dee86bcf3794122b101671a..873bc1329fe303cff442efbfe3a25c62ef67099e:/src/lread.c diff --git a/src/lread.c b/src/lread.c index b8b9189719..6f71ff5f46 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1,6 +1,7 @@ /* Lisp parsing and input streams. -Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation, Inc. +Copyright (C) 1985-1989, 1993-1995, 1997-2014 Free Software Foundation, +Inc. This file is part of GNU Emacs. @@ -65,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; @@ -212,7 +214,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++; } @@ -241,7 +243,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++; } @@ -323,7 +325,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); @@ -969,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}); } } @@ -1029,6 +1029,10 @@ in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the return value of `get-load-suffixes' is used, i.e. the file name is required to have a non-empty suffix. +When searching suffixes, this function normally stops at the first +one that exists. If the option `load-prefer-newer' is non-nil, +however, it tries all suffixes, and uses whichever file is the newest. + Loading a file records its definitions, and its `provide' and `require' calls, in an element of `load-history' whose car is the file name loaded. See `load-history'. @@ -1420,7 +1424,7 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate) { Lisp_Object file; - int fd = openp (path, filename, suffixes, &file, predicate, 0); + int fd = openp (path, filename, suffixes, &file, predicate, false); if (NILP (predicate) && fd >= 0) emacs_close (fd); return file; @@ -1450,24 +1454,29 @@ static Lisp_Object Qdir_ok; but store the found remote file name in *STOREPTR. If NEWER is true, try all SUFFIXes and return the result for the - newest file that exists. Does not apply to remote files. */ + newest file that exists. Does not apply to remote files, + or if PREDICATE is specified. */ int openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, - Lisp_Object *storeptr, Lisp_Object predicate, int newer) + Lisp_Object *storeptr, Lisp_Object predicate, bool newer) { ptrdiff_t fn_size = 100; char buf[100]; char *fn = buf; - bool absolute = 0; + bool absolute; ptrdiff_t want_length; Lisp_Object filename; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6, gcpro7; Lisp_Object string, tail, encoded_fn, save_string; ptrdiff_t max_suffix_len = 0; int last_errno = ENOENT; - struct timespec save_mtime; - int save_fd = 0; + 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. */ + struct timespec save_mtime = make_timespec (TYPE_MINIMUM (time_t), -1); CHECK_STRING (str); @@ -1478,14 +1487,13 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, SBYTES (XCAR (tail))); } - string = filename = encoded_fn = Qnil; - GCPRO6 (str, string, filename, path, suffixes, encoded_fn); + string = filename = encoded_fn = save_string = Qnil; + GCPRO7 (str, string, save_string, filename, path, suffixes, encoded_fn); if (storeptr) *storeptr = Qnil; - if (complete_filename_p (str)) - absolute = 1; + absolute = complete_filename_p (str); for (; CONSP (path); path = XCDR (path)) { @@ -1505,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; @@ -1555,13 +1566,13 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, { Lisp_Object tmp = call1 (predicate, string); if (NILP (tmp)) - exists = 0; + exists = false; else if (EQ (tmp, Qdir_ok) || NILP (Ffile_directory_p (string))) - exists = 1; + exists = true; else { - exists = 0; + exists = false; last_errno = EISDIR; } } @@ -1571,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; } @@ -1623,34 +1635,38 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, if (fd >= 0) { - if (newer) + if (newer && !NATNUMP (predicate)) { struct timespec mtime = get_stat_mtime (&st); - if (!save_fd || timespec_cmp (save_mtime, mtime) < 0) + if (timespec_cmp (mtime, save_mtime) <= 0) + emacs_close (fd); + else { - if (save_fd) emacs_close (save_fd); + if (0 <= save_fd) + emacs_close (save_fd); save_fd = fd; save_mtime = mtime; save_string = string; } - else emacs_close (fd); } else { /* We succeeded; return this descriptor and filename. */ if (storeptr) *storeptr = string; + SAFE_FREE (); UNGCPRO; return fd; } } /* No more suffixes. Return the newest. */ - if (newer && save_fd && ! CONSP (XCDR (tail))) + if (0 <= save_fd && ! CONSP (XCDR (tail))) { if (storeptr) *storeptr = save_string; + SAFE_FREE (); UNGCPRO; return save_fd; } @@ -1660,6 +1676,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, break; } + SAFE_FREE (); UNGCPRO; errno = last_errno; return -1; @@ -1753,6 +1770,31 @@ 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)) + { + struct gcpro gcpro1; + Lisp_Object subforms = XCDR (val); + + 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; +} + /* UNIBYTE specifies how to set load_convert_to_unibyte for this invocation. READFUN, if non-nil, is used instead of `read'. @@ -1920,8 +1962,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) { @@ -2043,7 +2086,7 @@ STREAM or the value of `standard-input' may be: if (EQ (stream, Qt)) stream = Qread_char; if (EQ (stream, Qread_char)) - /* FIXME: ¿¡ When is this used !? */ + /* FIXME: ?! When is this used !? */ return call1 (intern ("read-minibuffer"), build_string ("Lisp expression: ")); @@ -2054,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; @@ -2067,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; @@ -2092,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; @@ -2585,21 +2612,38 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) c = READCHAR; if (c == '[') { - Lisp_Object tmp; - int depth; - ptrdiff_t size; + /* Sub char-table can't be read as a regular + vector because of a two C integer fields. */ + Lisp_Object tbl, tmp = read_list (1, readcharfun); + ptrdiff_t size = XINT (Flength (tmp)); + int i, depth, min_char; + struct Lisp_Cons *cell; - tmp = read_vector (readcharfun, 0); - size = ASIZE (tmp); if (size == 0) - error ("Invalid size char-table"); - if (! RANGED_INTEGERP (1, AREF (tmp, 0), 3)) - error ("Invalid depth in char-table"); - depth = XINT (AREF (tmp, 0)); + error ("Zero-sized sub char-table"); + + if (! RANGED_INTEGERP (1, XCAR (tmp), 3)) + error ("Invalid depth in sub char-table"); + depth = XINT (XCAR (tmp)); if (chartab_size[depth] != size - 2) - error ("Invalid size char-table"); - XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE); - return tmp; + error ("Invalid size in sub char-table"); + cell = XCONS (tmp), tmp = XCDR (tmp), size--; + free_cons (cell); + + if (! RANGED_INTEGERP (0, XCAR (tmp), MAX_CHAR)) + error ("Invalid minimum character in sub-char-table"); + min_char = XINT (XCAR (tmp)); + cell = XCONS (tmp), tmp = XCDR (tmp), size--; + free_cons (cell); + + tbl = make_uninit_sub_char_table (depth, min_char); + for (i = 0; i < size; i++) + { + XSUB_CHAR_TABLE (tbl)->contents[i] = XCAR (tmp); + cell = XCONS (tmp), tmp = XCDR (tmp); + free_cons (cell); + } + return tbl; } invalid_syntax ("#^^"); } @@ -2644,9 +2688,10 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* Accept compiled functions at read-time so that we don't have to build them using function calls. */ Lisp_Object tmp; + struct Lisp_Vector *vec; tmp = read_vector (readcharfun, 1); - struct Lisp_Vector* vec = XVECTOR (tmp); - if (vec->header.size==0) + vec = XVECTOR (tmp); + if (vec->header.size == 0) invalid_syntax ("Empty byte-code object"); make_byte_code (vec); return tmp; @@ -2829,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. */ @@ -3312,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); @@ -3619,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) @@ -3748,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. */ @@ -3757,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 @@ -3766,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, @@ -3785,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, @@ -3857,7 +3897,8 @@ DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0, The value is t if a symbol was found and deleted, nil otherwise. NAME may be a string or a symbol. If it is a symbol, that symbol is deleted, if it belongs to OBARRAY--no other symbol is deleted. -OBARRAY defaults to the value of the variable `obarray'. */) +OBARRAY, if nil, defaults to the value of the variable `obarray'. +usage: (unintern NAME OBARRAY) */) (Lisp_Object name, Lisp_Object obarray) { register Lisp_Object string, tem; @@ -3927,7 +3968,8 @@ OBARRAY defaults to the value of the variable `obarray'. */) /* Return the symbol in OBARRAY whose names matches the string of SIZE characters (SIZE_BYTE bytes) at PTR. - If there is no such symbol in OBARRAY, return nil. + If there is no such symbol, return the integer bucket number of + where the symbol would be if it were present. Also store the bucket number in oblookup_last_bucket_number. */ @@ -4159,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)); } } @@ -4334,7 +4376,7 @@ init_lread (void) #ifdef CANNOT_DUMP bool use_loadpath = true; #else - bool use_loadpath = !NILP (Vpurify_flag); + bool use_loadpath = NILP (Vpurify_flag); #endif if (use_loadpath && egetenv ("EMACSLOADPATH")) @@ -4377,7 +4419,7 @@ init_lread (void) } } /* Fmemq (Qnil, Vload_path) */ } - else /* Vpurify_flag || !EMACSLOADPATH */ + else { Vload_path = load_path_default (); @@ -4394,7 +4436,7 @@ init_lread (void) sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0); if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path); } - } /* !Vpurify_flag && EMACSLOADPATH */ + } Vvalues = Qnil; @@ -4674,8 +4716,9 @@ variables, this must be set in the first line of a file. */); This applies when a filename suffix is not explicitly specified and `load' is trying various possible suffixes (see `load-suffixes' and `load-file-rep-suffixes'). Normally, it stops at the first file -that exists. If this option is non-nil, it checks all suffixes and -uses whichever file is newest. +that exists unless you explicitly specify one or the other. If this +option is non-nil, it checks all suffixes and uses whichever file is +newest. Note that if you customize this, obviously it will not affect files that are loaded before your customizations are read! */); load_prefer_newer = 0;