/* 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.
/* 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;
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++;
}
else
{
c = BUF_FETCH_BYTE (inbuffer, bytepos);
- if (! ASCII_BYTE_P (c))
+ if (! ASCII_CHAR_P (c))
c = BYTE8_TO_CHAR (c);
bytepos++;
}
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);
{
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});
}
}
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'.
(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;
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);
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))
{
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;
{
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;
}
}
/* We succeeded; return this descriptor and filename. */
if (storeptr)
*storeptr = string;
+ SAFE_FREE ();
UNGCPRO;
return -2;
}
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;
}
break;
}
+ SAFE_FREE ();
UNGCPRO;
errno = last_errno;
return -1;
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'.
/* 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)
{
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: "));
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;
}
/* 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;
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;
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 ("#^^");
}
/* 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;
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. */
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);
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)
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. */
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
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;
}
\f
DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
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,
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;
\f
/* 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. */
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));
}
}
#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"))
}
} /* Fmemq (Qnil, Vload_path) */
}
- else /* Vpurify_flag || !EMACSLOADPATH */
+ else
{
Vload_path = load_path_default ();
sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
}
- } /* !Vpurify_flag && EMACSLOADPATH */
+ }
Vvalues = Qnil;
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;