You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
+/* Tell globals.h to define tables needed by init_obarray. */
+#define DEFINE_SYMBOLS
#include <config.h>
#include "sysstdio.h"
#include <sys/file.h>
#include <errno.h>
#include <limits.h> /* For CHAR_BIT. */
+#include <math.h>
#include <stat-time.h>
#include "lisp.h"
#include "intervals.h"
#define file_tell ftell
#endif
-/* Hash table read constants. */
-static Lisp_Object Qhash_table, Qdata;
-static Lisp_Object Qtest, Qsize;
-static Lisp_Object Qweakness;
-static Lisp_Object Qrehash_size;
-static Lisp_Object Qrehash_threshold;
-
-static Lisp_Object Qread_char, Qget_file_char, Qcurrent_load_list;
-Lisp_Object Qstandard_input;
-Lisp_Object Qvariable_documentation;
-static Lisp_Object Qascii_character, Qload, Qload_file_name;
-Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
-static Lisp_Object Qinhibit_file_name_operation;
-static Lisp_Object Qeval_buffer_list;
-Lisp_Object Qlexical_binding;
-static Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
-
-/* Used instead of Qget_file_char while loading *.elc files compiled
- by Emacs 21 or older. */
-static Lisp_Object Qget_emacs_mule_file_char;
-
-static Lisp_Object Qload_force_doc_strings;
-
-static Lisp_Object Qload_in_progress;
-
/* The association list of objects read with the #n=object form.
Each member of the list has the form (n . object), and is used to
look up the object for the corresponding #n# construct.
Fread initializes this to false, so we need not specbind it
or worry about what happens to it when there is an error. */
static bool new_backquote_flag;
-static Lisp_Object Qold_style_backquotes;
/* A list of file names for files being loaded in Fload. Used to
check for recursive loads. */
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!");
+ CALLN (Fmessage, format, file);
}
}
bool compiled = 0;
Lisp_Object handler;
bool safe_p = 1;
- const char *fmode = "r";
+ const char *fmode = "r" FOPEN_TEXT;
int version;
-#ifdef DOS_NT
- fmode = "rt";
-#endif /* DOS_NT */
-
CHECK_STRING (file);
/* If file name is magic, call the handler. */
{
suffixes = Fget_load_suffixes ();
if (NILP (must_suffix))
- {
- Lisp_Object arg[2];
- arg[0] = suffixes;
- arg[1] = Vload_file_rep_suffixes;
- suffixes = Fappend (2, arg);
- }
+ suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes);
}
fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
compiled = 1;
efound = ENCODE_FILE (found);
-
-#ifdef DOS_NT
- fmode = "rb";
-#endif /* DOS_NT */
+ fmode = "r" FOPEN_BINARY;
/* openp already checked for newness, no point doing it again.
FIXME would be nice to get a message when openp
return file;
}
-static Lisp_Object Qdir_ok;
-
/* Search for a file whose name is STR, looking in directories
in the Lisp list PATH, and trying suffixes from SUFFIX.
On success, return a file descriptor (or 1 or -2 as described below).
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. */
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;
/* We succeeded; return this descriptor and filename. */
if (storeptr)
*storeptr = string;
+ SAFE_FREE ();
UNGCPRO;
return -2;
}
/* We succeeded; return this descriptor and filename. */
if (storeptr)
*storeptr = string;
+ SAFE_FREE ();
UNGCPRO;
return fd;
}
{
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)
{
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 ("#^^");
}
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. */
{
case Lisp_Vectorlike:
{
- ptrdiff_t i, length = 0;
+ ptrdiff_t i = 0, length = 0;
if (BOOL_VECTOR_P (subtree))
return subtree; /* No sub-objects anyway. */
else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
behavior. */
wrong_type_argument (Qsequencep, subtree);
- for (i = 0; i < length; i++)
+ if (SUB_CHAR_TABLE_P (subtree))
+ i = 2;
+ for ( ; i < length; i++)
SUBSTITUTE (AREF (subtree, i),
ASET (subtree, i, true_value));
return subtree;
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);
bool float_syntax = 0;
double value = 0;
- /* Compute NaN and infinities using a variable, to cope with compilers that
- think they are smarter than we are. */
- double zero = 0;
-
/* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
IEEE floating point hosts, and works around a formerly-common bug where
atof ("-0.0") drops the sign. */
{
state |= E_EXP;
cp += 3;
- value = 1.0 / zero;
+ value = INFINITY;
}
else if (cp[-1] == '+'
&& cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
{
state |= E_EXP;
cp += 3;
- value = zero / zero;
-
- /* If that made a "negative" NaN, negate it. */
- {
- int i;
- union { double d; char c[sizeof (double)]; }
- u_data, u_minus_zero;
- u_data.d = value;
- u_minus_zero.d = -0.0;
- for (i = 0; i < sizeof (double); i++)
- if (u_data.c[i] & u_minus_zero.c[i])
- {
- value = -value;
- break;
- }
- }
- /* Now VALUE is a positive NaN. */
+ /* NAN is a "positive" NaN on all known Emacs hosts. */
+ value = NAN;
}
else
cp = ecp;
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 symbol SYM in OBARRAY using bucket INDEX. */
+
+static Lisp_Object
+intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
+{
+ Lisp_Object *ptr;
+
+ XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray)
+ ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
+ : SYMBOL_INTERNED);
+
+ if (SREF (SYMBOL_NAME (sym), 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 (index));
+ set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL);
+ *ptr = sym;
+ return sym;
+}
+
+/* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
+
+Lisp_Object
+intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index)
+{
+ return intern_sym (Fmake_symbol (string), obarray, index);
+}
+
/* 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
+ /* The above `oblookup' was done on the basis of nchars==nbytes, so
+ the string has to be unibyte. */
+ : intern_driver (make_unibyte_string (str, len),
+ obarray, tem));
}
Lisp_Object
Lisp_Object obarray = check_obarray (Vobarray);
Lisp_Object tem = oblookup (obarray, str, len, len);
- if (SYMBOLP (tem))
- return tem;
+ 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, 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 ();
+static void
+define_symbol (Lisp_Object sym, char const *str)
+{
+ ptrdiff_t len = strlen (str);
+ Lisp_Object string = make_pure_c_string (str, len);
+ init_symbol (sym, string);
- return Fintern (make_pure_c_string (str, len), obarray);
+ /* Qunbound is uninterned, so that it's not confused with any symbol
+ 'unbound' created by a Lisp program. */
+ if (! EQ (sym, Qunbound))
+ {
+ Lisp_Object bucket = oblookup (initial_obarray, str, len, len);
+ eassert (INTEGERP (bucket));
+ intern_sym (sym, initial_obarray, bucket);
+ }
}
\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, tem);
+ return tem;
}
DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
initial_obarray = Vobarray;
staticpro (&initial_obarray);
- Qunbound = Fmake_symbol (build_pure_c_string ("unbound"));
- /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
- NILP (Vpurify_flag) check in intern_c_string. */
- Qnil = make_number (-1); Vpurify_flag = make_number (1);
- Qnil = intern_c_string ("nil");
-
- /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
- so those two need to be fixed manually. */
- SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
- set_symbol_function (Qunbound, Qnil);
- set_symbol_plist (Qunbound, Qnil);
+ for (int i = 0; i < ARRAYELTS (lispsym); i++)
+ define_symbol (builtin_lisp_symbol (i), defsym_name[i]);
+
+ DEFSYM (Qunbound, "unbound");
+
+ DEFSYM (Qnil, "nil");
SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
XSYMBOL (Qnil)->constant = 1;
- XSYMBOL (Qnil)->declared_special = 1;
- set_symbol_plist (Qnil, Qnil);
- set_symbol_function (Qnil, Qnil);
+ XSYMBOL (Qnil)->declared_special = true;
- Qt = intern_c_string ("t");
+ DEFSYM (Qt, "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;
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));
}
}
/* Replace nils from EMACSLOADPATH by default. */
while (CONSP (elpath))
{
- Lisp_Object arg[2];
elem = XCAR (elpath);
elpath = XCDR (elpath);
- arg[0] = Vload_path;
- arg[1] = NILP (elem) ? default_lpath : Fcons (elem, Qnil);
- Vload_path = Fappend (2, arg);
+ Vload_path = CALLN (Fappend, Vload_path,
+ NILP (elem) ? default_lpath : list1 (elem));
}
} /* Fmemq (Qnil, Vload_path) */
}
DEFSYM (Qstandard_input, "standard-input");
DEFSYM (Qread_char, "read-char");
DEFSYM (Qget_file_char, "get-file-char");
+
+ /* Used instead of Qget_file_char while loading *.elc files compiled
+ by Emacs 21 or older. */
DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char");
+
DEFSYM (Qload_force_doc_strings, "load-force-doc-strings");
DEFSYM (Qbackquote, "`");