/* 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.
/* 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;
{
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});
}
}
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;
}
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;
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,
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;