/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000,
- 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <signal.h>
#include <stdio.h>
+#include <setjmp.h>
#include "lisp.h"
#include "puresize.h"
#include "character.h"
#include "frame.h"
#include "syssignal.h"
#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */
+#include "font.h"
#ifdef STDC_HEADERS
#include <float.h>
#endif
#endif
-/* Work around a problem that happens because math.h on hpux 7
- defines two static variables--which, in Emacs, are not really static,
- because `static' is defined as nothing. The problem is that they are
- here, in floatfns.c, and in lread.c.
- These macros prevent the name conflict. */
-#if defined (HPUX) && !defined (HPUX8)
-#define _MAXLDBL data_c_maxldbl
-#define _NMAXLDBL data_c_nmaxldbl
-#endif
-
#include <math.h>
#if !defined (atof)
static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
static Lisp_Object Qsubrp, Qmany, Qunevalled;
+Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
+
+Lisp_Object Qinteractive_form;
static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object));
wrong_type_argument (predicate, value)
register Lisp_Object predicate, value;
{
- /* If VALUE is not even a valid Lisp object, abort here
- where we can get a backtrace showing where it came from. */
- if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
- abort ();
+ /* If VALUE is not even a valid Lisp object, we'd want to abort here
+ where we can get a backtrace showing where it came from. We used
+ to try and do that by checking the tagbits, but nowadays all
+ tagbits are potentially valid. */
+ /* if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
+ * abort (); */
xsignal2 (Qwrong_type_argument, predicate, value);
}
{
switch (XTYPE (object))
{
- case Lisp_Int:
+ case_Lisp_Int:
return Qinteger;
case Lisp_Symbol:
return Qframe;
if (HASH_TABLE_P (object))
return Qhash_table;
+ if (FONT_SPEC_P (object))
+ return Qfont_spec;
+ if (FONT_ENTITY_P (object))
+ return Qfont_entity;
+ if (FONT_OBJECT_P (object))
+ return Qfont_object;
return Qvector;
case Lisp_Float:
fun = cmd;
while (SYMBOLP (fun))
{
- Lisp_Object tmp = Fget (fun, intern ("interactive-form"));
+ Lisp_Object tmp = Fget (fun, Qinteractive_form);
if (!NILP (tmp))
return tmp;
else
`cyclic-variable-indirection' if SYMBOL's chain of variable
indirections contains a loop. */
-Lisp_Object
+struct Lisp_Symbol *
indirect_variable (symbol)
- Lisp_Object symbol;
+ struct Lisp_Symbol *symbol;
{
- Lisp_Object tortoise, hare;
+ struct Lisp_Symbol *tortoise, *hare;
hare = tortoise = symbol;
- while (XSYMBOL (hare)->indirect_variable)
+ while (hare->indirect_variable)
{
- hare = XSYMBOL (hare)->value;
- if (!XSYMBOL (hare)->indirect_variable)
+ hare = XSYMBOL (hare->value);
+ if (!hare->indirect_variable)
break;
- hare = XSYMBOL (hare)->value;
- tortoise = XSYMBOL (tortoise)->value;
+ hare = XSYMBOL (hare->value);
+ tortoise = XSYMBOL (tortoise->value);
- if (EQ (hare, tortoise))
- xsignal1 (Qcyclic_variable_indirection, symbol);
+ if (hare == tortoise)
+ {
+ Lisp_Object tem;
+ XSETSYMBOL (tem, symbol);
+ xsignal1 (Qcyclic_variable_indirection, tem);
+ }
}
return hare;
Lisp_Object object;
{
if (SYMBOLP (object))
- object = indirect_variable (object);
+ XSETSYMBOL (object, indirect_variable (XSYMBOL (object)));
return object;
}
int offset = XBUFFER_OBJFWD (valcontents)->offset;
Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
- if (! NILP (type) && ! NILP (newval)
- && XTYPE (newval) != XINT (type))
- buffer_slot_type_mismatch (symbol, XINT (type));
+ if (!(NILP (type) || NILP (newval)
+ || (XINT (type) == LISP_INT_TAG
+ ? INTEGERP (newval)
+ : XTYPE (newval) == XINT (type))))
+ buffer_slot_type_mismatch (newval, XINT (type));
if (buf == NULL)
buf = current_buffer;
|| (XBUFFER_LOCAL_VALUE (valcontents)->check_frame
&& ! EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame)))
{
- if (XSYMBOL (symbol)->indirect_variable)
- symbol = indirect_variable (symbol);
+ struct Lisp_Symbol *sym = XSYMBOL (symbol);
+ if (sym->indirect_variable)
+ {
+ sym = indirect_variable (sym);
+ XSETSYMBOL (symbol, sym);
+ }
/* Unload the previously loaded binding. */
tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
static int
let_shadows_buffer_binding_p (symbol)
- Lisp_Object symbol;
+ struct Lisp_Symbol *symbol;
{
volatile struct specbinding *p;
if (p->func == NULL
&& CONSP (p->symbol))
{
- Lisp_Object let_bound_symbol = XCAR (p->symbol);
- if ((EQ (symbol, let_bound_symbol)
- || (XSYMBOL (let_bound_symbol)->indirect_variable
- && EQ (symbol, indirect_variable (let_bound_symbol))))
+ struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
+ if ((symbol == let_bound_symbol
+ || (let_bound_symbol->indirect_variable
+ && symbol == indirect_variable (let_bound_symbol)))
&& XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
break;
}
int idx = PER_BUFFER_IDX (offset);
if (idx > 0
&& !bindflag
- && !let_shadows_buffer_binding_p (symbol))
+ && !let_shadows_buffer_binding_p (XSYMBOL (symbol)))
SET_PER_BUFFER_VALUE_P (buf, idx, 1);
}
else if (BUFFER_LOCAL_VALUEP (valcontents))
{
/* valcontents is a struct Lisp_Buffer_Local_Value. */
if (XSYMBOL (symbol)->indirect_variable)
- symbol = indirect_variable (symbol);
+ XSETSYMBOL (symbol, indirect_variable (XSYMBOL (symbol)));
/* What binding is loaded right now? */
current_alist_element
Likewise if the variable has been let-bound
in the current buffer. */
if (bindflag || !XBUFFER_LOCAL_VALUE (valcontents)->local_if_set
- || let_shadows_buffer_binding_p (symbol))
+ || let_shadows_buffer_binding_p (XSYMBOL (symbol)))
{
XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
register Lisp_Object variable;
{
register Lisp_Object tem, valcontents, newval;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
+ sym = indirect_variable (XSYMBOL (variable));
- valcontents = SYMBOL_VALUE (variable);
- if (XSYMBOL (variable)->constant || KBOARD_OBJFWDP (valcontents))
- error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
+ valcontents = sym->value;
+ if (sym->constant || KBOARD_OBJFWDP (valcontents))
+ error ("Symbol %s may not be buffer-local", SDATA (sym->xname));
if (BUFFER_OBJFWDP (valcontents))
return variable;
else if (BUFFER_LOCAL_VALUEP (valcontents))
- newval = valcontents;
+ {
+ if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
+ error ("Symbol %s may not be buffer-local", SDATA (sym->xname));
+ newval = valcontents;
+ }
else
{
if (EQ (valcontents, Qunbound))
- SET_SYMBOL_VALUE (variable, Qnil);
+ sym->value = Qnil;
tem = Fcons (Qnil, Fsymbol_value (variable));
XSETCAR (tem, tem);
newval = allocate_misc ();
XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
- XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable);
+ XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value;
XBUFFER_LOCAL_VALUE (newval)->buffer = Fcurrent_buffer ();
XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 0;
XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
- SET_SYMBOL_VALUE (variable, newval);
+ sym->value = newval;
}
XBUFFER_LOCAL_VALUE (newval)->local_if_set = 1;
return variable;
register Lisp_Object variable;
{
register Lisp_Object tem, valcontents;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
+ sym = indirect_variable (XSYMBOL (variable));
- valcontents = SYMBOL_VALUE (variable);
- if (XSYMBOL (variable)->constant || KBOARD_OBJFWDP (valcontents))
- error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
+ valcontents = sym->value;
+ if (sym->constant || KBOARD_OBJFWDP (valcontents)
+ || (BUFFER_LOCAL_VALUEP (valcontents)
+ && (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)))
+ error ("Symbol %s may not be buffer-local", SDATA (sym->xname));
if ((BUFFER_LOCAL_VALUEP (valcontents)
&& XBUFFER_LOCAL_VALUE (valcontents)->local_if_set)
XSETCAR (tem, tem);
newval = allocate_misc ();
XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
- XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable);
+ XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value;
XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil;
XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0;
XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
XBUFFER_LOCAL_VALUE (newval)->check_frame = 0;
XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
- SET_SYMBOL_VALUE (variable, newval);
+ sym->value = newval;
}
/* Make sure this buffer has its own value of symbol. */
+ XSETSYMBOL (variable, sym); /* Propagate variable indirections. */
tem = Fassq (variable, current_buffer->local_var_alist);
if (NILP (tem))
{
find_symbol_value (variable);
current_buffer->local_var_alist
- = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (variable))->cdr)),
+ = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE (sym->value)->cdr)),
current_buffer->local_var_alist);
/* Make sure symbol does not think it is set up for this buffer;
{
Lisp_Object *pvalbuf;
- valcontents = SYMBOL_VALUE (variable);
+ valcontents = sym->value;
pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
if (current_buffer == XBUFFER (*pvalbuf))
for this buffer now. If C code modifies the variable before we
load the binding in, then that new value will clobber the default
binding the next time we unload it. */
- valcontents = XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (variable))->realvalue;
+ valcontents = XBUFFER_LOCAL_VALUE (sym->value)->realvalue;
if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents))
- swap_in_symval_forwarding (variable, SYMBOL_VALUE (variable));
+ swap_in_symval_forwarding (variable, sym->value);
return variable;
}
register Lisp_Object variable;
{
register Lisp_Object tem, valcontents;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
+ sym = indirect_variable (XSYMBOL (variable));
- valcontents = SYMBOL_VALUE (variable);
+ valcontents = sym->value;
if (BUFFER_OBJFWDP (valcontents))
{
return variable;
/* Get rid of this buffer's alist element, if any. */
-
+ XSETSYMBOL (variable, sym); /* Propagate variable indirection. */
tem = Fassq (variable, current_buffer->local_var_alist);
if (!NILP (tem))
current_buffer->local_var_alist
forwarded objects won't work right. */
{
Lisp_Object *pvalbuf, buf;
- valcontents = SYMBOL_VALUE (variable);
+ valcontents = sym->value;
pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
XSETBUFFER (buf, current_buffer);
if (EQ (buf, *pvalbuf))
/* Lisp functions for creating and removing buffer-local variables. */
+/* Obsolete since 22.2. NB adjust doc of modify-frame-parameters
+ when/if this is removed. */
+
DEFUN ("make-variable-frame-local", Fmake_variable_frame_local, Smake_variable_frame_local,
1, 1, "vMake Variable Frame Local: ",
doc: /* Enable VARIABLE to have frame-local bindings.
is to set the VARIABLE frame parameter of that frame. See
`modify-frame-parameters' for how to set frame parameters.
-Buffer-local bindings take precedence over frame-local bindings. */)
+Note that since Emacs 23.1, variables cannot be both buffer-local and
+frame-local any more (buffer-local bindings used to take precedence over
+frame-local bindings). */)
(variable)
register Lisp_Object variable;
{
register Lisp_Object tem, valcontents, newval;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
+ sym = indirect_variable (XSYMBOL (variable));
- valcontents = SYMBOL_VALUE (variable);
- if (XSYMBOL (variable)->constant || KBOARD_OBJFWDP (valcontents)
+ valcontents = sym->value;
+ if (sym->constant || KBOARD_OBJFWDP (valcontents)
|| BUFFER_OBJFWDP (valcontents))
- error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
+ error ("Symbol %s may not be frame-local", SDATA (sym->xname));
if (BUFFER_LOCAL_VALUEP (valcontents))
{
- XBUFFER_LOCAL_VALUE (valcontents)->check_frame = 1;
+ if (!XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
+ error ("Symbol %s may not be frame-local", SDATA (sym->xname));
return variable;
}
if (EQ (valcontents, Qunbound))
- SET_SYMBOL_VALUE (variable, Qnil);
+ sym->value = Qnil;
tem = Fcons (Qnil, Fsymbol_value (variable));
XSETCAR (tem, tem);
newval = allocate_misc ();
XMISCTYPE (newval) = Lisp_Misc_Buffer_Local_Value;
- XBUFFER_LOCAL_VALUE (newval)->realvalue = SYMBOL_VALUE (variable);
+ XBUFFER_LOCAL_VALUE (newval)->realvalue = sym->value;
XBUFFER_LOCAL_VALUE (newval)->buffer = Qnil;
XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0;
XBUFFER_LOCAL_VALUE (newval)->found_for_frame = 0;
XBUFFER_LOCAL_VALUE (newval)->check_frame = 1;
XBUFFER_LOCAL_VALUE (newval)->cdr = tem;
- SET_SYMBOL_VALUE (variable, newval);
+ sym->value = newval;
return variable;
}
{
Lisp_Object valcontents;
register struct buffer *buf;
+ struct Lisp_Symbol *sym;
if (NILP (buffer))
buf = current_buffer;
}
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
+ sym = indirect_variable (XSYMBOL (variable));
+ XSETSYMBOL (variable, sym);
- valcontents = SYMBOL_VALUE (variable);
+ valcontents = sym->value;
if (BUFFER_LOCAL_VALUEP (valcontents))
{
Lisp_Object tail, elt;
{
Lisp_Object valcontents;
register struct buffer *buf;
+ struct Lisp_Symbol *sym;
if (NILP (buffer))
buf = current_buffer;
}
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
+ sym = indirect_variable (XSYMBOL (variable));
+ XSETSYMBOL (variable, sym);
- valcontents = SYMBOL_VALUE (variable);
+ valcontents = sym->value;
if (BUFFER_OBJFWDP (valcontents))
/* All these slots become local if they are set. */
register Lisp_Object variable;
{
Lisp_Object valcontents;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
+ sym = indirect_variable (XSYMBOL (variable));
/* Make sure the current binding is actually swapped in. */
find_symbol_value (variable);
- valcontents = XSYMBOL (variable)->value;
+ valcontents = sym->value;
if (BUFFER_LOCAL_VALUEP (valcontents)
|| BUFFER_OBJFWDP (valcontents))
If SYMBOL is not a terminal-local variable, then return its normal
value, like `symbol-value'.
-TERMINAL may be a terminal id, a frame, or nil (meaning the
+TERMINAL may be a terminal object, a frame, or nil (meaning the
selected frame's terminal device). */)
(symbol, terminal)
Lisp_Object symbol;
If VARIABLE is not a terminal-local variable, then set its normal
binding, like `set'.
-TERMINAL may be a terminal id, a frame, or nil (meaning the
+TERMINAL may be a terminal object, a frame, or nil (meaning the
selected frame's terminal device). */)
(symbol, terminal, value)
Lisp_Object symbol;
return make_number ((unsigned char) SREF (array, idxval));
idxval_byte = string_char_to_byte (array, idxval);
- c = STRING_CHAR (SDATA (array) + idxval_byte,
- SBYTES (array) - idxval_byte);
+ c = STRING_CHAR (SDATA (array) + idxval_byte);
return make_number (c);
}
else if (BOOL_VECTOR_P (array))
CHECK_NUMBER (newelt);
if (XINT (newelt) >= 0 && ! SINGLE_BYTE_CHAR_P (XINT (newelt)))
- args_out_of_range (array, newelt);
+ {
+ int i;
+
+ for (i = SBYTES (array) - 1; i >= 0; i--)
+ if (SREF (array, i) >= 0x80)
+ args_out_of_range (array, newelt);
+ /* ARRAY is an ASCII string. Convert it to a multibyte
+ string, and try `aset' again. */
+ STRING_SET_MULTIBYTE (array);
+ return Faset (array, idx, newelt);
+ }
SSET (array, idxval, XINT (newelt));
}
DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
doc: /* Parse STRING as a decimal number and return the number.
This parses both integers and floating point numbers.
-It ignores leading spaces and tabs.
+It ignores leading spaces and tabs, and all trailing chars.
If BASE, interpret STRING as a number in that base. If BASE isn't
present, base 10 is used. BASE must be between 2 and 16 (inclusive).
-If the base used is not 10, floating point is not recognized. */)
+If the base used is not 10, STRING is always parsed as integer. */)
(string, base)
register Lisp_Object string, base;
{
else if (*p == '+')
p++;
- if (isfloat_string (p) && b == 10)
+ if (isfloat_string (p, 1) && b == 10)
val = make_float (sign * atof (p));
else
{
{
Lisp_Object error_tail, arith_tail;
- Qquote = intern ("quote");
- Qlambda = intern ("lambda");
- Qsubr = intern ("subr");
- Qerror_conditions = intern ("error-conditions");
- Qerror_message = intern ("error-message");
- Qtop_level = intern ("top-level");
-
- Qerror = intern ("error");
- Qquit = intern ("quit");
- Qwrong_type_argument = intern ("wrong-type-argument");
- Qargs_out_of_range = intern ("args-out-of-range");
- Qvoid_function = intern ("void-function");
- Qcyclic_function_indirection = intern ("cyclic-function-indirection");
- Qcyclic_variable_indirection = intern ("cyclic-variable-indirection");
- Qvoid_variable = intern ("void-variable");
- Qsetting_constant = intern ("setting-constant");
- Qinvalid_read_syntax = intern ("invalid-read-syntax");
-
- Qinvalid_function = intern ("invalid-function");
- Qwrong_number_of_arguments = intern ("wrong-number-of-arguments");
- Qno_catch = intern ("no-catch");
- Qend_of_file = intern ("end-of-file");
- Qarith_error = intern ("arith-error");
- Qbeginning_of_buffer = intern ("beginning-of-buffer");
- Qend_of_buffer = intern ("end-of-buffer");
- Qbuffer_read_only = intern ("buffer-read-only");
- Qtext_read_only = intern ("text-read-only");
- Qmark_inactive = intern ("mark-inactive");
-
- Qlistp = intern ("listp");
- Qconsp = intern ("consp");
- Qsymbolp = intern ("symbolp");
- Qkeywordp = intern ("keywordp");
- Qintegerp = intern ("integerp");
- Qnatnump = intern ("natnump");
- Qwholenump = intern ("wholenump");
- Qstringp = intern ("stringp");
- Qarrayp = intern ("arrayp");
- Qsequencep = intern ("sequencep");
- Qbufferp = intern ("bufferp");
- Qvectorp = intern ("vectorp");
- Qchar_or_string_p = intern ("char-or-string-p");
- Qmarkerp = intern ("markerp");
- Qbuffer_or_string_p = intern ("buffer-or-string-p");
- Qinteger_or_marker_p = intern ("integer-or-marker-p");
- Qboundp = intern ("boundp");
- Qfboundp = intern ("fboundp");
-
- Qfloatp = intern ("floatp");
- Qnumberp = intern ("numberp");
- Qnumber_or_marker_p = intern ("number-or-marker-p");
-
- Qchar_table_p = intern ("char-table-p");
- Qvector_or_char_table_p = intern ("vector-or-char-table-p");
-
- Qsubrp = intern ("subrp");
- Qunevalled = intern ("unevalled");
- Qmany = intern ("many");
-
- Qcdr = intern ("cdr");
+ Qquote = intern_c_string ("quote");
+ Qlambda = intern_c_string ("lambda");
+ Qsubr = intern_c_string ("subr");
+ Qerror_conditions = intern_c_string ("error-conditions");
+ Qerror_message = intern_c_string ("error-message");
+ Qtop_level = intern_c_string ("top-level");
+
+ Qerror = intern_c_string ("error");
+ Qquit = intern_c_string ("quit");
+ Qwrong_type_argument = intern_c_string ("wrong-type-argument");
+ Qargs_out_of_range = intern_c_string ("args-out-of-range");
+ Qvoid_function = intern_c_string ("void-function");
+ Qcyclic_function_indirection = intern_c_string ("cyclic-function-indirection");
+ Qcyclic_variable_indirection = intern_c_string ("cyclic-variable-indirection");
+ Qvoid_variable = intern_c_string ("void-variable");
+ Qsetting_constant = intern_c_string ("setting-constant");
+ Qinvalid_read_syntax = intern_c_string ("invalid-read-syntax");
+
+ Qinvalid_function = intern_c_string ("invalid-function");
+ Qwrong_number_of_arguments = intern_c_string ("wrong-number-of-arguments");
+ Qno_catch = intern_c_string ("no-catch");
+ Qend_of_file = intern_c_string ("end-of-file");
+ Qarith_error = intern_c_string ("arith-error");
+ Qbeginning_of_buffer = intern_c_string ("beginning-of-buffer");
+ Qend_of_buffer = intern_c_string ("end-of-buffer");
+ Qbuffer_read_only = intern_c_string ("buffer-read-only");
+ Qtext_read_only = intern_c_string ("text-read-only");
+ Qmark_inactive = intern_c_string ("mark-inactive");
+
+ Qlistp = intern_c_string ("listp");
+ Qconsp = intern_c_string ("consp");
+ Qsymbolp = intern_c_string ("symbolp");
+ Qkeywordp = intern_c_string ("keywordp");
+ Qintegerp = intern_c_string ("integerp");
+ Qnatnump = intern_c_string ("natnump");
+ Qwholenump = intern_c_string ("wholenump");
+ Qstringp = intern_c_string ("stringp");
+ Qarrayp = intern_c_string ("arrayp");
+ Qsequencep = intern_c_string ("sequencep");
+ Qbufferp = intern_c_string ("bufferp");
+ Qvectorp = intern_c_string ("vectorp");
+ Qchar_or_string_p = intern_c_string ("char-or-string-p");
+ Qmarkerp = intern_c_string ("markerp");
+ Qbuffer_or_string_p = intern_c_string ("buffer-or-string-p");
+ Qinteger_or_marker_p = intern_c_string ("integer-or-marker-p");
+ Qboundp = intern_c_string ("boundp");
+ Qfboundp = intern_c_string ("fboundp");
+
+ Qfloatp = intern_c_string ("floatp");
+ Qnumberp = intern_c_string ("numberp");
+ Qnumber_or_marker_p = intern_c_string ("number-or-marker-p");
+
+ Qchar_table_p = intern_c_string ("char-table-p");
+ Qvector_or_char_table_p = intern_c_string ("vector-or-char-table-p");
+
+ Qsubrp = intern_c_string ("subrp");
+ Qunevalled = intern_c_string ("unevalled");
+ Qmany = intern_c_string ("many");
+
+ Qcdr = intern_c_string ("cdr");
/* Handle automatic advice activation */
- Qad_advice_info = intern ("ad-advice-info");
- Qad_activate_internal = intern ("ad-activate-internal");
+ Qad_advice_info = intern_c_string ("ad-advice-info");
+ Qad_activate_internal = intern_c_string ("ad-activate-internal");
- error_tail = Fcons (Qerror, Qnil);
+ error_tail = pure_cons (Qerror, Qnil);
/* ERROR is used as a signaler for random errors for which nothing else is right */
Fput (Qerror, Qerror_conditions,
error_tail);
Fput (Qerror, Qerror_message,
- build_string ("error"));
+ make_pure_c_string ("error"));
Fput (Qquit, Qerror_conditions,
- Fcons (Qquit, Qnil));
+ pure_cons (Qquit, Qnil));
Fput (Qquit, Qerror_message,
- build_string ("Quit"));
+ make_pure_c_string ("Quit"));
Fput (Qwrong_type_argument, Qerror_conditions,
- Fcons (Qwrong_type_argument, error_tail));
+ pure_cons (Qwrong_type_argument, error_tail));
Fput (Qwrong_type_argument, Qerror_message,
- build_string ("Wrong type argument"));
+ make_pure_c_string ("Wrong type argument"));
Fput (Qargs_out_of_range, Qerror_conditions,
- Fcons (Qargs_out_of_range, error_tail));
+ pure_cons (Qargs_out_of_range, error_tail));
Fput (Qargs_out_of_range, Qerror_message,
- build_string ("Args out of range"));
+ make_pure_c_string ("Args out of range"));
Fput (Qvoid_function, Qerror_conditions,
- Fcons (Qvoid_function, error_tail));
+ pure_cons (Qvoid_function, error_tail));
Fput (Qvoid_function, Qerror_message,
- build_string ("Symbol's function definition is void"));
+ make_pure_c_string ("Symbol's function definition is void"));
Fput (Qcyclic_function_indirection, Qerror_conditions,
- Fcons (Qcyclic_function_indirection, error_tail));
+ pure_cons (Qcyclic_function_indirection, error_tail));
Fput (Qcyclic_function_indirection, Qerror_message,
- build_string ("Symbol's chain of function indirections contains a loop"));
+ make_pure_c_string ("Symbol's chain of function indirections contains a loop"));
Fput (Qcyclic_variable_indirection, Qerror_conditions,
- Fcons (Qcyclic_variable_indirection, error_tail));
+ pure_cons (Qcyclic_variable_indirection, error_tail));
Fput (Qcyclic_variable_indirection, Qerror_message,
- build_string ("Symbol's chain of variable indirections contains a loop"));
+ make_pure_c_string ("Symbol's chain of variable indirections contains a loop"));
- Qcircular_list = intern ("circular-list");
+ Qcircular_list = intern_c_string ("circular-list");
staticpro (&Qcircular_list);
Fput (Qcircular_list, Qerror_conditions,
- Fcons (Qcircular_list, error_tail));
+ pure_cons (Qcircular_list, error_tail));
Fput (Qcircular_list, Qerror_message,
- build_string ("List contains a loop"));
+ make_pure_c_string ("List contains a loop"));
Fput (Qvoid_variable, Qerror_conditions,
- Fcons (Qvoid_variable, error_tail));
+ pure_cons (Qvoid_variable, error_tail));
Fput (Qvoid_variable, Qerror_message,
- build_string ("Symbol's value as variable is void"));
+ make_pure_c_string ("Symbol's value as variable is void"));
Fput (Qsetting_constant, Qerror_conditions,
- Fcons (Qsetting_constant, error_tail));
+ pure_cons (Qsetting_constant, error_tail));
Fput (Qsetting_constant, Qerror_message,
- build_string ("Attempt to set a constant symbol"));
+ make_pure_c_string ("Attempt to set a constant symbol"));
Fput (Qinvalid_read_syntax, Qerror_conditions,
- Fcons (Qinvalid_read_syntax, error_tail));
+ pure_cons (Qinvalid_read_syntax, error_tail));
Fput (Qinvalid_read_syntax, Qerror_message,
- build_string ("Invalid read syntax"));
+ make_pure_c_string ("Invalid read syntax"));
Fput (Qinvalid_function, Qerror_conditions,
- Fcons (Qinvalid_function, error_tail));
+ pure_cons (Qinvalid_function, error_tail));
Fput (Qinvalid_function, Qerror_message,
- build_string ("Invalid function"));
+ make_pure_c_string ("Invalid function"));
Fput (Qwrong_number_of_arguments, Qerror_conditions,
- Fcons (Qwrong_number_of_arguments, error_tail));
+ pure_cons (Qwrong_number_of_arguments, error_tail));
Fput (Qwrong_number_of_arguments, Qerror_message,
- build_string ("Wrong number of arguments"));
+ make_pure_c_string ("Wrong number of arguments"));
Fput (Qno_catch, Qerror_conditions,
- Fcons (Qno_catch, error_tail));
+ pure_cons (Qno_catch, error_tail));
Fput (Qno_catch, Qerror_message,
- build_string ("No catch for tag"));
+ make_pure_c_string ("No catch for tag"));
Fput (Qend_of_file, Qerror_conditions,
- Fcons (Qend_of_file, error_tail));
+ pure_cons (Qend_of_file, error_tail));
Fput (Qend_of_file, Qerror_message,
- build_string ("End of file during parsing"));
+ make_pure_c_string ("End of file during parsing"));
- arith_tail = Fcons (Qarith_error, error_tail);
+ arith_tail = pure_cons (Qarith_error, error_tail);
Fput (Qarith_error, Qerror_conditions,
arith_tail);
Fput (Qarith_error, Qerror_message,
- build_string ("Arithmetic error"));
+ make_pure_c_string ("Arithmetic error"));
Fput (Qbeginning_of_buffer, Qerror_conditions,
- Fcons (Qbeginning_of_buffer, error_tail));
+ pure_cons (Qbeginning_of_buffer, error_tail));
Fput (Qbeginning_of_buffer, Qerror_message,
- build_string ("Beginning of buffer"));
+ make_pure_c_string ("Beginning of buffer"));
Fput (Qend_of_buffer, Qerror_conditions,
- Fcons (Qend_of_buffer, error_tail));
+ pure_cons (Qend_of_buffer, error_tail));
Fput (Qend_of_buffer, Qerror_message,
- build_string ("End of buffer"));
+ make_pure_c_string ("End of buffer"));
Fput (Qbuffer_read_only, Qerror_conditions,
- Fcons (Qbuffer_read_only, error_tail));
+ pure_cons (Qbuffer_read_only, error_tail));
Fput (Qbuffer_read_only, Qerror_message,
- build_string ("Buffer is read-only"));
+ make_pure_c_string ("Buffer is read-only"));
Fput (Qtext_read_only, Qerror_conditions,
- Fcons (Qtext_read_only, error_tail));
+ pure_cons (Qtext_read_only, error_tail));
Fput (Qtext_read_only, Qerror_message,
- build_string ("Text is read-only"));
+ make_pure_c_string ("Text is read-only"));
- Qrange_error = intern ("range-error");
- Qdomain_error = intern ("domain-error");
- Qsingularity_error = intern ("singularity-error");
- Qoverflow_error = intern ("overflow-error");
- Qunderflow_error = intern ("underflow-error");
+ Qrange_error = intern_c_string ("range-error");
+ Qdomain_error = intern_c_string ("domain-error");
+ Qsingularity_error = intern_c_string ("singularity-error");
+ Qoverflow_error = intern_c_string ("overflow-error");
+ Qunderflow_error = intern_c_string ("underflow-error");
Fput (Qdomain_error, Qerror_conditions,
- Fcons (Qdomain_error, arith_tail));
+ pure_cons (Qdomain_error, arith_tail));
Fput (Qdomain_error, Qerror_message,
- build_string ("Arithmetic domain error"));
+ make_pure_c_string ("Arithmetic domain error"));
Fput (Qrange_error, Qerror_conditions,
- Fcons (Qrange_error, arith_tail));
+ pure_cons (Qrange_error, arith_tail));
Fput (Qrange_error, Qerror_message,
- build_string ("Arithmetic range error"));
+ make_pure_c_string ("Arithmetic range error"));
Fput (Qsingularity_error, Qerror_conditions,
- Fcons (Qsingularity_error, Fcons (Qdomain_error, arith_tail)));
+ pure_cons (Qsingularity_error, Fcons (Qdomain_error, arith_tail)));
Fput (Qsingularity_error, Qerror_message,
- build_string ("Arithmetic singularity error"));
+ make_pure_c_string ("Arithmetic singularity error"));
Fput (Qoverflow_error, Qerror_conditions,
- Fcons (Qoverflow_error, Fcons (Qdomain_error, arith_tail)));
+ pure_cons (Qoverflow_error, Fcons (Qdomain_error, arith_tail)));
Fput (Qoverflow_error, Qerror_message,
- build_string ("Arithmetic overflow error"));
+ make_pure_c_string ("Arithmetic overflow error"));
Fput (Qunderflow_error, Qerror_conditions,
- Fcons (Qunderflow_error, Fcons (Qdomain_error, arith_tail)));
+ pure_cons (Qunderflow_error, Fcons (Qdomain_error, arith_tail)));
Fput (Qunderflow_error, Qerror_message,
- build_string ("Arithmetic underflow error"));
+ make_pure_c_string ("Arithmetic underflow error"));
staticpro (&Qrange_error);
staticpro (&Qdomain_error);
staticpro (&Qad_activate_internal);
/* Types that type-of returns. */
- Qinteger = intern ("integer");
- Qsymbol = intern ("symbol");
- Qstring = intern ("string");
- Qcons = intern ("cons");
- Qmarker = intern ("marker");
- Qoverlay = intern ("overlay");
- Qfloat = intern ("float");
- Qwindow_configuration = intern ("window-configuration");
- Qprocess = intern ("process");
- Qwindow = intern ("window");
- /* Qsubr = intern ("subr"); */
- Qcompiled_function = intern ("compiled-function");
- Qbuffer = intern ("buffer");
- Qframe = intern ("frame");
- Qvector = intern ("vector");
- Qchar_table = intern ("char-table");
- Qbool_vector = intern ("bool-vector");
- Qhash_table = intern ("hash-table");
+ Qinteger = intern_c_string ("integer");
+ Qsymbol = intern_c_string ("symbol");
+ Qstring = intern_c_string ("string");
+ Qcons = intern_c_string ("cons");
+ Qmarker = intern_c_string ("marker");
+ Qoverlay = intern_c_string ("overlay");
+ Qfloat = intern_c_string ("float");
+ Qwindow_configuration = intern_c_string ("window-configuration");
+ Qprocess = intern_c_string ("process");
+ Qwindow = intern_c_string ("window");
+ /* Qsubr = intern_c_string ("subr"); */
+ Qcompiled_function = intern_c_string ("compiled-function");
+ Qbuffer = intern_c_string ("buffer");
+ Qframe = intern_c_string ("frame");
+ Qvector = intern_c_string ("vector");
+ Qchar_table = intern_c_string ("char-table");
+ Qbool_vector = intern_c_string ("bool-vector");
+ Qhash_table = intern_c_string ("hash-table");
+
+ DEFSYM (Qfont_spec, "font-spec");
+ DEFSYM (Qfont_entity, "font-entity");
+ DEFSYM (Qfont_object, "font-object");
+
+ DEFSYM (Qinteractive_form, "interactive-form");
staticpro (&Qinteger);
staticpro (&Qsymbol);
DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum,
doc: /* The largest value that is representable in a Lisp integer. */);
Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM);
+ XSYMBOL (intern_c_string ("most-positive-fixnum"))->constant = 1;
DEFVAR_LISP ("most-negative-fixnum", &Vmost_negative_fixnum,
doc: /* The smallest value that is representable in a Lisp integer. */);
Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
+ XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1;
}
SIGTYPE
must reestablish each time */
signal (signo, arith_error);
#endif /* USG */
-#ifdef VMS
- /* VMS systems are like USG. */
- signal (signo, arith_error);
-#endif /* VMS */
-#ifdef BSD4_1
- sigrelse (SIGFPE);
-#else /* not BSD4_1 */
sigsetmask (SIGEMPTYMASK);
-#endif /* not BSD4_1 */
SIGNAL_THREAD_CHECK (signo);
xsignal0 (Qarith_error);