/* 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)
-extern double atof ();
+extern double atof (const char *);
#endif /* !atof */
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
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;
-static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object));
+Lisp_Object Qinteractive_form;
+
+static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
Lisp_Object Vmost_positive_fixnum, Vmost_negative_fixnum;
void
-circular_list_error (list)
- Lisp_Object list;
+circular_list_error (Lisp_Object list)
{
xsignal (Qcircular_list, list);
}
Lisp_Object
-wrong_type_argument (predicate, value)
- register Lisp_Object predicate, value;
+wrong_type_argument (register Lisp_Object predicate, register Lisp_Object 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);
}
void
-pure_write_error ()
+pure_write_error (void)
{
error ("Attempt to modify read-only object");
}
void
-args_out_of_range (a1, a2)
- Lisp_Object a1, a2;
+args_out_of_range (Lisp_Object a1, Lisp_Object a2)
{
xsignal2 (Qargs_out_of_range, a1, a2);
}
void
-args_out_of_range_3 (a1, a2, a3)
- Lisp_Object a1, a2, a3;
+args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
{
xsignal3 (Qargs_out_of_range, a1, a2, a3);
}
/* On a few machines, XINT can only be done by calling this. */
int
-sign_extend_lisp_int (num)
- EMACS_INT num;
+sign_extend_lisp_int (EMACS_INT num)
{
if (num & (((EMACS_INT) 1) << (VALBITS - 1)))
return num | (((EMACS_INT) (-1)) << VALBITS);
{
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:
register Lisp_Object symbol;
{
Lisp_Object valcontents;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (symbol);
+ sym = XSYMBOL (symbol);
- valcontents = SYMBOL_VALUE (symbol);
-
- if (BUFFER_LOCAL_VALUEP (valcontents))
- valcontents = swap_in_symval_forwarding (symbol, valcontents);
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break;
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_LOCALIZED:
+ {
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ if (blv->fwd)
+ /* In set_internal, we un-forward vars when their value is
+ set to Qunbound. */
+ return Qt;
+ else
+ {
+ swap_in_symval_forwarding (sym, blv);
+ valcontents = BLV_VALUE (blv);
+ }
+ break;
+ }
+ case SYMBOL_FORWARDED:
+ /* In set_internal, we un-forward vars when their value is
+ set to Qunbound. */
+ return Qt;
+ default: abort ();
+ }
return (EQ (valcontents, Qunbound) ? Qnil : Qt);
}
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
-indirect_variable (symbol)
- Lisp_Object symbol;
+struct Lisp_Symbol *
+indirect_variable (struct Lisp_Symbol *symbol)
{
- Lisp_Object tortoise, hare;
+ struct Lisp_Symbol *tortoise, *hare;
hare = tortoise = symbol;
- while (XSYMBOL (hare)->indirect_variable)
+ while (hare->redirect == SYMBOL_VARALIAS)
{
- hare = XSYMBOL (hare)->value;
- if (!XSYMBOL (hare)->indirect_variable)
+ hare = SYMBOL_ALIAS (hare);
+ if (hare->redirect != SYMBOL_VARALIAS)
break;
- hare = XSYMBOL (hare)->value;
- tortoise = XSYMBOL (tortoise)->value;
+ hare = SYMBOL_ALIAS (hare);
+ tortoise = SYMBOL_ALIAS (tortoise);
- 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;
}
This does not handle buffer-local variables; use
swap_in_symval_forwarding for that. */
+#define do_blv_forwarding(blv) \
+ ((blv)->forwarded ? do_symval_forwarding (BLV_FWD (blv)) : BLV_VALUE (blv))
+
Lisp_Object
-do_symval_forwarding (valcontents)
- register Lisp_Object valcontents;
+do_symval_forwarding (register union Lisp_Fwd *valcontents)
{
register Lisp_Object val;
- if (MISCP (valcontents))
- switch (XMISCTYPE (valcontents))
- {
- case Lisp_Misc_Intfwd:
- XSETINT (val, *XINTFWD (valcontents)->intvar);
- return val;
-
- case Lisp_Misc_Boolfwd:
- return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
-
- case Lisp_Misc_Objfwd:
- return *XOBJFWD (valcontents)->objvar;
-
- case Lisp_Misc_Buffer_Objfwd:
- return PER_BUFFER_VALUE (current_buffer,
- XBUFFER_OBJFWD (valcontents)->offset);
-
- case Lisp_Misc_Kboard_Objfwd:
- /* We used to simply use current_kboard here, but from Lisp
- code, it's value is often unexpected. It seems nicer to
- allow constructions like this to work as intuitively expected:
-
- (with-selected-frame frame
- (define-key local-function-map "\eOP" [f1]))
-
- On the other hand, this affects the semantics of
- last-command and real-last-command, and people may rely on
- that. I took a quick look at the Lisp codebase, and I
- don't think anything will break. --lorentey */
- return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
- + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
- }
- return valcontents;
+ switch (XFWDTYPE (valcontents))
+ {
+ case Lisp_Fwd_Int:
+ XSETINT (val, *XINTFWD (valcontents)->intvar);
+ return val;
+
+ case Lisp_Fwd_Bool:
+ return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
+
+ case Lisp_Fwd_Obj:
+ return *XOBJFWD (valcontents)->objvar;
+
+ case Lisp_Fwd_Buffer_Obj:
+ return PER_BUFFER_VALUE (current_buffer,
+ XBUFFER_OBJFWD (valcontents)->offset);
+
+ case Lisp_Fwd_Kboard_Obj:
+ /* We used to simply use current_kboard here, but from Lisp
+ code, it's value is often unexpected. It seems nicer to
+ allow constructions like this to work as intuitively expected:
+
+ (with-selected-frame frame
+ (define-key local-function-map "\eOP" [f1]))
+
+ On the other hand, this affects the semantics of
+ last-command and real-last-command, and people may rely on
+ that. I took a quick look at the Lisp codebase, and I
+ don't think anything will break. --lorentey */
+ return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
+ + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
+ default: abort ();
+ }
}
/* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
BUF non-zero means set the value in buffer BUF instead of the
current buffer. This only plays a role for per-buffer variables. */
-void
-store_symval_forwarding (symbol, valcontents, newval, buf)
- Lisp_Object symbol;
- register Lisp_Object valcontents, newval;
- struct buffer *buf;
-{
- switch (SWITCH_ENUM_CAST (XTYPE (valcontents)))
+#define store_blv_forwarding(blv, newval, buf) \
+ do { \
+ if ((blv)->forwarded) \
+ store_symval_forwarding (BLV_FWD (blv), (newval), (buf)); \
+ else \
+ SET_BLV_VALUE (blv, newval); \
+ } while (0)
+
+static void
+store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newval, struct buffer *buf)
+ /* struct Lisp_Symbol *symbol; */
+
+
+
+{
+ switch (XFWDTYPE (valcontents))
{
- case Lisp_Misc:
- switch (XMISCTYPE (valcontents))
- {
- case Lisp_Misc_Intfwd:
- CHECK_NUMBER (newval);
- *XINTFWD (valcontents)->intvar = XINT (newval);
- /* This can never happen since intvar points to an EMACS_INT
- which is at least large enough to hold a Lisp_Object.
- if (*XINTFWD (valcontents)->intvar != XINT (newval))
- error ("Value out of range for variable `%s'",
- SDATA (SYMBOL_NAME (symbol))); */
- break;
+ case Lisp_Fwd_Int:
+ CHECK_NUMBER (newval);
+ *XINTFWD (valcontents)->intvar = XINT (newval);
+ break;
- case Lisp_Misc_Boolfwd:
- *XBOOLFWD (valcontents)->boolvar = !NILP (newval);
- break;
+ case Lisp_Fwd_Bool:
+ *XBOOLFWD (valcontents)->boolvar = !NILP (newval);
+ break;
- case Lisp_Misc_Objfwd:
- *XOBJFWD (valcontents)->objvar = newval;
+ case Lisp_Fwd_Obj:
+ *XOBJFWD (valcontents)->objvar = newval;
- /* If this variable is a default for something stored
- in the buffer itself, such as default-fill-column,
- find the buffers that don't have local values for it
- and update them. */
- if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
- && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1))
- {
- int offset = ((char *) XOBJFWD (valcontents)->objvar
- - (char *) &buffer_defaults);
- int idx = PER_BUFFER_IDX (offset);
+ /* If this variable is a default for something stored
+ in the buffer itself, such as default-fill-column,
+ find the buffers that don't have local values for it
+ and update them. */
+ if (XOBJFWD (valcontents)->objvar > (Lisp_Object *) &buffer_defaults
+ && XOBJFWD (valcontents)->objvar < (Lisp_Object *) (&buffer_defaults + 1))
+ {
+ int offset = ((char *) XOBJFWD (valcontents)->objvar
+ - (char *) &buffer_defaults);
+ int idx = PER_BUFFER_IDX (offset);
- Lisp_Object tail;
+ Lisp_Object tail;
- if (idx <= 0)
- break;
+ if (idx <= 0)
+ break;
- for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
- {
- Lisp_Object buf;
- struct buffer *b;
+ for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
+ {
+ Lisp_Object buf;
+ struct buffer *b;
- buf = Fcdr (XCAR (tail));
- if (!BUFFERP (buf)) continue;
- b = XBUFFER (buf);
+ buf = Fcdr (XCAR (tail));
+ if (!BUFFERP (buf)) continue;
+ b = XBUFFER (buf);
- if (! PER_BUFFER_VALUE_P (b, idx))
- PER_BUFFER_VALUE (b, offset) = newval;
- }
+ if (! PER_BUFFER_VALUE_P (b, idx))
+ PER_BUFFER_VALUE (b, offset) = newval;
}
- break;
-
- case Lisp_Misc_Buffer_Objfwd:
- {
- 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 (buf == NULL)
- buf = current_buffer;
- PER_BUFFER_VALUE (buf, offset) = newval;
- }
- break;
+ }
+ break;
- case Lisp_Misc_Kboard_Objfwd:
- {
- char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ());
- char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
- *(Lisp_Object *) p = newval;
- }
- break;
+ case Lisp_Fwd_Buffer_Obj:
+ {
+ int offset = XBUFFER_OBJFWD (valcontents)->offset;
+ Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype;
+
+ 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;
+ PER_BUFFER_VALUE (buf, offset) = newval;
+ }
+ break;
- default:
- goto def;
- }
+ case Lisp_Fwd_Kboard_Obj:
+ {
+ char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ());
+ char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
+ *(Lisp_Object *) p = newval;
+ }
break;
default:
- def:
- valcontents = SYMBOL_VALUE (symbol);
- if (BUFFER_LOCAL_VALUEP (valcontents))
- XBUFFER_LOCAL_VALUE (valcontents)->realvalue = newval;
- else
- SET_SYMBOL_VALUE (symbol, newval);
+ abort (); /* goto def; */
}
}
This makes it safe to alter the status of other bindings. */
void
-swap_in_global_binding (symbol)
- Lisp_Object symbol;
+swap_in_global_binding (struct Lisp_Symbol *symbol)
{
- Lisp_Object valcontents = SYMBOL_VALUE (symbol);
- struct Lisp_Buffer_Local_Value *blv = XBUFFER_LOCAL_VALUE (valcontents);
- Lisp_Object cdr = blv->cdr;
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (symbol);
/* Unload the previously loaded binding. */
- Fsetcdr (XCAR (cdr),
- do_symval_forwarding (blv->realvalue));
+ if (blv->fwd)
+ SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
/* Select the global binding in the symbol. */
- XSETCAR (cdr, cdr);
- store_symval_forwarding (symbol, blv->realvalue, XCDR (cdr), NULL);
+ blv->valcell = blv->defcell;
+ if (blv->fwd)
+ store_symval_forwarding (blv->fwd, XCDR (blv->defcell), NULL);
/* Indicate that the global binding is set up now. */
- blv->frame = Qnil;
- blv->buffer = Qnil;
- blv->found_for_frame = 0;
- blv->found_for_buffer = 0;
+ blv->where = Qnil;
+ SET_BLV_FOUND (blv, 0);
}
/* Set up the buffer-local symbol SYMBOL for validity in the current buffer.
Return the value forwarded one step past the buffer-local stage.
This could be another forwarding pointer. */
-static Lisp_Object
-swap_in_symval_forwarding (symbol, valcontents)
- Lisp_Object symbol, valcontents;
+static void
+swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_Value *blv)
{
register Lisp_Object tem1;
- tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer;
+ eassert (blv == SYMBOL_BLV (symbol));
+
+ tem1 = blv->where;
if (NILP (tem1)
- || current_buffer != XBUFFER (tem1)
- || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame
- && ! EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame)))
+ || (blv->frame_local
+ ? !EQ (selected_frame, tem1)
+ : current_buffer != XBUFFER (tem1)))
{
- if (XSYMBOL (symbol)->indirect_variable)
- symbol = indirect_variable (symbol);
/* Unload the previously loaded binding. */
- tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
- Fsetcdr (tem1,
- do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
+ tem1 = blv->valcell;
+ if (blv->fwd)
+ SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
/* Choose the new binding. */
- tem1 = assq_no_quit (symbol, current_buffer->local_var_alist);
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0;
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
- if (NILP (tem1))
- {
- if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
- tem1 = assq_no_quit (symbol, XFRAME (selected_frame)->param_alist);
- if (! NILP (tem1))
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1;
- else
- tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
- }
- else
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1;
+ {
+ Lisp_Object var;
+ XSETSYMBOL (var, symbol);
+ if (blv->frame_local)
+ {
+ tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist);
+ blv->where = selected_frame;
+ }
+ else
+ {
+ tem1 = assq_no_quit (var, current_buffer->local_var_alist);
+ XSETBUFFER (blv->where, current_buffer);
+ }
+ }
+ if (!(blv->found = !NILP (tem1)))
+ tem1 = blv->defcell;
/* Load the new binding. */
- XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1);
- XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, current_buffer);
- XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame;
- store_symval_forwarding (symbol,
- XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
- Fcdr (tem1), NULL);
+ blv->valcell = tem1;
+ if (blv->fwd)
+ store_symval_forwarding (blv->fwd, BLV_VALUE (blv), NULL);
}
- return XBUFFER_LOCAL_VALUE (valcontents)->realvalue;
}
\f
/* Find the value of a symbol, returning Qunbound if it's not bound.
within this function. Great care is required for this. */
Lisp_Object
-find_symbol_value (symbol)
- Lisp_Object symbol;
+find_symbol_value (Lisp_Object symbol)
{
- register Lisp_Object valcontents;
- register Lisp_Object val;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (symbol);
- valcontents = SYMBOL_VALUE (symbol);
-
- if (BUFFER_LOCAL_VALUEP (valcontents))
- valcontents = swap_in_symval_forwarding (symbol, valcontents);
+ sym = XSYMBOL (symbol);
- return do_symval_forwarding (valcontents);
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
+ case SYMBOL_LOCALIZED:
+ {
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ swap_in_symval_forwarding (sym, blv);
+ return blv->fwd ? do_symval_forwarding (blv->fwd) : BLV_VALUE (blv);
+ }
+ /* FALLTHROUGH */
+ case SYMBOL_FORWARDED:
+ return do_symval_forwarding (SYMBOL_FWD (sym));
+ default: abort ();
+ }
}
DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0,
(symbol, newval)
register Lisp_Object symbol, newval;
{
- return set_internal (symbol, newval, current_buffer, 0);
+ set_internal (symbol, newval, Qnil, 0);
+ return newval;
}
/* Return 1 if SYMBOL currently has a let-binding
which was made in the buffer that is now current. */
static int
-let_shadows_buffer_binding_p (symbol)
- Lisp_Object symbol;
+let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
{
- volatile struct specbinding *p;
+ struct specbinding *p;
for (p = specpdl_ptr - 1; p >= specpdl; 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));
+ eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
+ if (symbol == let_bound_symbol
&& XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
break;
}
return p >= specpdl;
}
+static int
+let_shadows_global_binding_p (Lisp_Object symbol)
+{
+ struct specbinding *p;
+
+ for (p = specpdl_ptr - 1; p >= specpdl; p--)
+ if (p->func == NULL && EQ (p->symbol, symbol))
+ break;
+
+ return p >= specpdl;
+}
+
/* Store the value NEWVAL into SYMBOL.
- If buffer-locality is an issue, BUF specifies which buffer to use.
- (0 stands for the current buffer.)
+ If buffer/frame-locality is an issue, WHERE specifies which context to use.
+ (nil stands for the current buffer/frame).
If BINDFLAG is zero, then if this symbol is supposed to become
local in every buffer where it is set, then we make it local.
If BINDFLAG is nonzero, we don't do that. */
-Lisp_Object
-set_internal (symbol, newval, buf, bindflag)
- register Lisp_Object symbol, newval;
- struct buffer *buf;
- int bindflag;
+void
+set_internal (register Lisp_Object symbol, register Lisp_Object newval, register Lisp_Object where, int bindflag)
{
int voide = EQ (newval, Qunbound);
-
- register Lisp_Object valcontents, innercontents, tem1, current_alist_element;
-
- if (buf == 0)
- buf = current_buffer;
+ struct Lisp_Symbol *sym;
+ Lisp_Object tem1;
/* If restoring in a dead buffer, do nothing. */
- if (NILP (buf->name))
- return newval;
+ /* if (BUFFERP (where) && NILP (XBUFFER (where)->name))
+ return; */
CHECK_SYMBOL (symbol);
- if (SYMBOL_CONSTANT_P (symbol)
- && (NILP (Fkeywordp (symbol))
- || !EQ (newval, SYMBOL_VALUE (symbol))))
- xsignal1 (Qsetting_constant, symbol);
-
- innercontents = valcontents = SYMBOL_VALUE (symbol);
-
- if (BUFFER_OBJFWDP (valcontents))
+ if (SYMBOL_CONSTANT_P (symbol))
{
- int offset = XBUFFER_OBJFWD (valcontents)->offset;
- int idx = PER_BUFFER_IDX (offset);
- if (idx > 0
- && !bindflag
- && !let_shadows_buffer_binding_p (symbol))
- SET_PER_BUFFER_VALUE_P (buf, idx, 1);
+ if (NILP (Fkeywordp (symbol))
+ || !EQ (newval, Fsymbol_value (symbol)))
+ xsignal1 (Qsetting_constant, symbol);
+ else
+ /* Allow setting keywords to their own value. */
+ return;
}
- else if (BUFFER_LOCAL_VALUEP (valcontents))
- {
- /* valcontents is a struct Lisp_Buffer_Local_Value. */
- if (XSYMBOL (symbol)->indirect_variable)
- symbol = indirect_variable (symbol);
-
- /* What binding is loaded right now? */
- current_alist_element
- = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
-
- /* If the current buffer is not the buffer whose binding is
- loaded, or if there may be frame-local bindings and the frame
- isn't the right one, or if it's a Lisp_Buffer_Local_Value and
- the default binding is loaded, the loaded binding may be the
- wrong one. */
- if (!BUFFERP (XBUFFER_LOCAL_VALUE (valcontents)->buffer)
- || buf != XBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer)
- || (XBUFFER_LOCAL_VALUE (valcontents)->check_frame
- && !EQ (selected_frame, XBUFFER_LOCAL_VALUE (valcontents)->frame))
- /* Also unload a global binding (if the var is local_if_set). */
- || (EQ (XCAR (current_alist_element),
- current_alist_element)))
- {
- /* The currently loaded binding is not necessarily valid.
- We need to unload it, and choose a new binding. */
- /* Write out `realvalue' to the old loaded binding. */
- Fsetcdr (current_alist_element,
- do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
+ sym = XSYMBOL (symbol);
- /* Find the new binding. */
- tem1 = Fassq (symbol, buf->local_var_alist);
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 1;
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 0;
-
- if (NILP (tem1))
- {
- /* This buffer still sees the default value. */
-
- /* If the variable is not local_if_set,
- or if this is `let' rather than `set',
- make CURRENT-ALIST-ELEMENT point to itself,
- indicating that we're seeing the default value.
- 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))
- {
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
-
- if (XBUFFER_LOCAL_VALUE (valcontents)->check_frame)
- tem1 = Fassq (symbol,
- XFRAME (selected_frame)->param_alist);
-
- if (! NILP (tem1))
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame = 1;
- else
- tem1 = XBUFFER_LOCAL_VALUE (valcontents)->cdr;
- }
- /* If it's a Lisp_Buffer_Local_Value, being set not bound,
- and we're not within a let that was made for this buffer,
- create a new buffer-local binding for the variable.
- That means, give this buffer a new assoc for a local value
- and load that binding. */
- else
- {
- tem1 = Fcons (symbol, XCDR (current_alist_element));
- buf->local_var_alist
- = Fcons (tem1, buf->local_var_alist);
- }
- }
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
+ case SYMBOL_LOCALIZED:
+ {
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ if (NILP (where))
+ {
+ if (blv->frame_local)
+ where = selected_frame;
+ else
+ XSETBUFFER (where, current_buffer);
+ }
+ /* If the current buffer is not the buffer whose binding is
+ loaded, or if there may be frame-local bindings and the frame
+ isn't the right one, or if it's a Lisp_Buffer_Local_Value and
+ the default binding is loaded, the loaded binding may be the
+ wrong one. */
+ if (!EQ (blv->where, where)
+ /* Also unload a global binding (if the var is local_if_set). */
+ || (EQ (blv->valcell, blv->defcell)))
+ {
+ /* The currently loaded binding is not necessarily valid.
+ We need to unload it, and choose a new binding. */
+
+ /* Write out `realvalue' to the old loaded binding. */
+ if (blv->fwd)
+ SET_BLV_VALUE (blv, do_symval_forwarding (blv->fwd));
+
+ /* Find the new binding. */
+ XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */
+ tem1 = Fassq (symbol,
+ (blv->frame_local
+ ? XFRAME (where)->param_alist
+ : XBUFFER (where)->local_var_alist));
+ blv->where = where;
+ blv->found = 1;
+
+ if (NILP (tem1))
+ {
+ /* This buffer still sees the default value. */
+
+ /* If the variable is a Lisp_Some_Buffer_Local_Value,
+ or if this is `let' rather than `set',
+ make CURRENT-ALIST-ELEMENT point to itself,
+ indicating that we're seeing the default value.
+ Likewise if the variable has been let-bound
+ in the current buffer. */
+ if (bindflag || !blv->local_if_set
+ || let_shadows_buffer_binding_p (sym))
+ {
+ blv->found = 0;
+ tem1 = blv->defcell;
+ }
+ /* If it's a local_if_set, being set not bound,
+ and we're not within a let that was made for this buffer,
+ create a new buffer-local binding for the variable.
+ That means, give this buffer a new assoc for a local value
+ and load that binding. */
+ else
+ {
+ /* local_if_set is only supported for buffer-local
+ bindings, not for frame-local bindings. */
+ eassert (!blv->frame_local);
+ tem1 = Fcons (symbol, XCDR (blv->defcell));
+ XBUFFER (where)->local_var_alist
+ = Fcons (tem1, XBUFFER (where)->local_var_alist);
+ }
+ }
+
+ /* Record which binding is now loaded. */
+ blv->valcell = tem1;
+ }
- /* Record which binding is now loaded. */
- XSETCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, tem1);
+ /* Store the new value in the cons cell. */
+ SET_BLV_VALUE (blv, newval);
- /* Set `buffer' and `frame' slots for the binding now loaded. */
- XSETBUFFER (XBUFFER_LOCAL_VALUE (valcontents)->buffer, buf);
- XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame;
- }
- innercontents = XBUFFER_LOCAL_VALUE (valcontents)->realvalue;
+ if (blv->fwd)
+ {
+ if (voide)
+ /* If storing void (making the symbol void), forward only through
+ buffer-local indicator, not through Lisp_Objfwd, etc. */
+ blv->fwd = NULL;
+ else
+ store_symval_forwarding (blv->fwd, newval,
+ BUFFERP (where)
+ ? XBUFFER (where) : current_buffer);
+ }
+ break;
+ }
+ case SYMBOL_FORWARDED:
+ {
+ struct buffer *buf
+ = BUFFERP (where) ? XBUFFER (where) : current_buffer;
+ union Lisp_Fwd *innercontents = SYMBOL_FWD (sym);
+ if (BUFFER_OBJFWDP (innercontents))
+ {
+ int offset = XBUFFER_OBJFWD (innercontents)->offset;
+ int idx = PER_BUFFER_IDX (offset);
+ if (idx > 0
+ && !bindflag
+ && !let_shadows_buffer_binding_p (sym))
+ SET_PER_BUFFER_VALUE_P (buf, idx, 1);
+ }
- /* Store the new value in the cons-cell. */
- XSETCDR (XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr), newval);
+ if (voide)
+ { /* If storing void (making the symbol void), forward only through
+ buffer-local indicator, not through Lisp_Objfwd, etc. */
+ sym->redirect = SYMBOL_PLAINVAL;
+ SET_SYMBOL_VAL (sym, newval);
+ }
+ else
+ store_symval_forwarding (/* sym, */ innercontents, newval, buf);
+ break;
+ }
+ default: abort ();
}
-
- /* If storing void (making the symbol void), forward only through
- buffer-local indicator, not through Lisp_Objfwd, etc. */
- if (voide)
- store_symval_forwarding (symbol, Qnil, newval, buf);
- else
- store_symval_forwarding (symbol, innercontents, newval, buf);
-
- return newval;
+ return;
}
\f
/* Access or set a buffer-local symbol's default value. */
Return Qunbound if it is void. */
Lisp_Object
-default_value (symbol)
- Lisp_Object symbol;
+default_value (Lisp_Object symbol)
{
- register Lisp_Object valcontents;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (symbol);
- valcontents = SYMBOL_VALUE (symbol);
+ sym = XSYMBOL (symbol);
- /* For a built-in buffer-local variable, get the default value
- rather than letting do_symval_forwarding get the current value. */
- if (BUFFER_OBJFWDP (valcontents))
+ start:
+ switch (sym->redirect)
{
- int offset = XBUFFER_OBJFWD (valcontents)->offset;
- if (PER_BUFFER_IDX (offset) != 0)
- return PER_BUFFER_DEFAULT (offset);
- }
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
+ case SYMBOL_LOCALIZED:
+ {
+ /* If var is set up for a buffer that lacks a local value for it,
+ the current value is nominally the default value.
+ But the `realvalue' slot may be more up to date, since
+ ordinary setq stores just that slot. So use that. */
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ if (blv->fwd && EQ (blv->valcell, blv->defcell))
+ return do_symval_forwarding (blv->fwd);
+ else
+ return XCDR (blv->defcell);
+ }
+ case SYMBOL_FORWARDED:
+ {
+ union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
- /* Handle user-created local variables. */
- if (BUFFER_LOCAL_VALUEP (valcontents))
- {
- /* If var is set up for a buffer that lacks a local value for it,
- the current value is nominally the default value.
- But the `realvalue' slot may be more up to date, since
- ordinary setq stores just that slot. So use that. */
- Lisp_Object current_alist_element, alist_element_car;
- current_alist_element
- = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
- alist_element_car = XCAR (current_alist_element);
- if (EQ (alist_element_car, current_alist_element))
- return do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue);
- else
- return XCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
+ /* For a built-in buffer-local variable, get the default value
+ rather than letting do_symval_forwarding get the current value. */
+ if (BUFFER_OBJFWDP (valcontents))
+ {
+ int offset = XBUFFER_OBJFWD (valcontents)->offset;
+ if (PER_BUFFER_IDX (offset) != 0)
+ return PER_BUFFER_DEFAULT (offset);
+ }
+
+ /* For other variables, get the current value. */
+ return do_symval_forwarding (valcontents);
+ }
+ default: abort ();
}
- /* For other variables, get the current value. */
- return do_symval_forwarding (valcontents);
}
DEFUN ("default-boundp", Fdefault_boundp, Sdefault_boundp, 1, 1, 0,
(symbol, value)
Lisp_Object symbol, value;
{
- register Lisp_Object valcontents, current_alist_element, alist_element_buffer;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (symbol);
- valcontents = SYMBOL_VALUE (symbol);
-
- /* Handle variables like case-fold-search that have special slots
- in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
- variables. */
- if (BUFFER_OBJFWDP (valcontents))
+ if (SYMBOL_CONSTANT_P (symbol))
{
- int offset = XBUFFER_OBJFWD (valcontents)->offset;
- int idx = PER_BUFFER_IDX (offset);
+ if (NILP (Fkeywordp (symbol))
+ || !EQ (value, Fdefault_value (symbol)))
+ xsignal1 (Qsetting_constant, symbol);
+ else
+ /* Allow setting keywords to their own value. */
+ return value;
+ }
+ sym = XSYMBOL (symbol);
- PER_BUFFER_DEFAULT (offset) = value;
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return Fset (symbol, value);
+ case SYMBOL_LOCALIZED:
+ {
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
- /* If this variable is not always local in all buffers,
- set it in the buffers that don't nominally have a local value. */
- if (idx > 0)
- {
- struct buffer *b;
+ /* Store new value into the DEFAULT-VALUE slot. */
+ XSETCDR (blv->defcell, value);
- for (b = all_buffers; b; b = b->next)
- if (!PER_BUFFER_VALUE_P (b, idx))
- PER_BUFFER_VALUE (b, offset) = value;
- }
- return value;
- }
+ /* If the default binding is now loaded, set the REALVALUE slot too. */
+ if (blv->fwd && EQ (blv->defcell, blv->valcell))
+ store_symval_forwarding (blv->fwd, value, NULL);
+ return value;
+ }
+ case SYMBOL_FORWARDED:
+ {
+ union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
- if (!BUFFER_LOCAL_VALUEP (valcontents))
- return Fset (symbol, value);
+ /* Handle variables like case-fold-search that have special slots
+ in the buffer.
+ Make them work apparently like Lisp_Buffer_Local_Value variables. */
+ if (BUFFER_OBJFWDP (valcontents))
+ {
+ int offset = XBUFFER_OBJFWD (valcontents)->offset;
+ int idx = PER_BUFFER_IDX (offset);
- /* Store new value into the DEFAULT-VALUE slot. */
- XSETCDR (XBUFFER_LOCAL_VALUE (valcontents)->cdr, value);
+ PER_BUFFER_DEFAULT (offset) = value;
- /* If the default binding is now loaded, set the REALVALUE slot too. */
- current_alist_element
- = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
- alist_element_buffer = Fcar (current_alist_element);
- if (EQ (alist_element_buffer, current_alist_element))
- store_symval_forwarding (symbol,
- XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
- value, NULL);
+ /* If this variable is not always local in all buffers,
+ set it in the buffers that don't nominally have a local value. */
+ if (idx > 0)
+ {
+ struct buffer *b;
- return value;
+ for (b = all_buffers; b; b = b->next)
+ if (!PER_BUFFER_VALUE_P (b, idx))
+ PER_BUFFER_VALUE (b, offset) = value;
+ }
+ return value;
+ }
+ else
+ return Fset (symbol, value);
+ }
+ default: abort ();
+ }
}
DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0,
\f
/* Lisp functions for creating and removing buffer-local variables. */
+union Lisp_Val_Fwd
+ {
+ Lisp_Object value;
+ union Lisp_Fwd *fwd;
+ };
+
+static struct Lisp_Buffer_Local_Value *
+make_blv (struct Lisp_Symbol *sym, int forwarded, union Lisp_Val_Fwd valcontents)
+{
+ struct Lisp_Buffer_Local_Value *blv
+ = xmalloc (sizeof (struct Lisp_Buffer_Local_Value));
+ Lisp_Object symbol;
+ Lisp_Object tem;
+
+ XSETSYMBOL (symbol, sym);
+ tem = Fcons (symbol, (forwarded
+ ? do_symval_forwarding (valcontents.fwd)
+ : valcontents.value));
+
+ /* Buffer_Local_Values cannot have as realval a buffer-local
+ or keyboard-local forwarding. */
+ eassert (!(forwarded && BUFFER_OBJFWDP (valcontents.fwd)));
+ eassert (!(forwarded && KBOARD_OBJFWDP (valcontents.fwd)));
+ blv->fwd = forwarded ? valcontents.fwd : NULL;
+ blv->where = Qnil;
+ blv->frame_local = 0;
+ blv->local_if_set = 0;
+ blv->defcell = tem;
+ blv->valcell = tem;
+ SET_BLV_FOUND (blv, 0);
+ return blv;
+}
+
DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local,
1, 1, "vMake Variable Buffer Local: ",
doc: /* Make VARIABLE become buffer-local whenever it is set.
(variable)
register Lisp_Object variable;
{
- register Lisp_Object tem, valcontents, newval;
+ struct Lisp_Symbol *sym;
+ struct Lisp_Buffer_Local_Value *blv = NULL;
+ union Lisp_Val_Fwd valcontents;
+ int forwarded;
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
+ sym = XSYMBOL (variable);
- valcontents = SYMBOL_VALUE (variable);
- if (XSYMBOL (variable)->constant || KBOARD_OBJFWDP (valcontents))
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL:
+ forwarded = 0; valcontents.value = SYMBOL_VAL (sym);
+ if (EQ (valcontents.value, Qunbound))
+ valcontents.value = Qnil;
+ break;
+ case SYMBOL_LOCALIZED:
+ blv = SYMBOL_BLV (sym);
+ if (blv->frame_local)
+ error ("Symbol %s may not be buffer-local",
+ SDATA (SYMBOL_NAME (variable)));
+ break;
+ case SYMBOL_FORWARDED:
+ forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym);
+ if (KBOARD_OBJFWDP (valcontents.fwd))
+ error ("Symbol %s may not be buffer-local",
+ SDATA (SYMBOL_NAME (variable)));
+ else if (BUFFER_OBJFWDP (valcontents.fwd))
+ return variable;
+ break;
+ default: abort ();
+ }
+
+ if (sym->constant)
error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
- if (BUFFER_OBJFWDP (valcontents))
- return variable;
- else if (BUFFER_LOCAL_VALUEP (valcontents))
- newval = valcontents;
- else
+ if (!blv)
{
- if (EQ (valcontents, Qunbound))
- SET_SYMBOL_VALUE (variable, 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)->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);
+ blv = make_blv (sym, forwarded, valcontents);
+ sym->redirect = SYMBOL_LOCALIZED;
+ SET_SYMBOL_BLV (sym, blv);
+ {
+ Lisp_Object symbol;
+ XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */
+ if (let_shadows_global_binding_p (symbol))
+ message ("Making %s buffer-local while let-bound!",
+ SDATA (SYMBOL_NAME (variable)));
+ }
}
- XBUFFER_LOCAL_VALUE (newval)->local_if_set = 1;
+
+ blv->local_if_set = 1;
return variable;
}
(variable)
register Lisp_Object variable;
{
- register Lisp_Object tem, valcontents;
+ register Lisp_Object tem;
+ int forwarded;
+ union Lisp_Val_Fwd valcontents;
+ struct Lisp_Symbol *sym;
+ struct Lisp_Buffer_Local_Value *blv = NULL;
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
+ sym = 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)));
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL:
+ forwarded = 0; valcontents.value = SYMBOL_VAL (sym); break;
+ case SYMBOL_LOCALIZED:
+ blv = SYMBOL_BLV (sym);
+ if (blv->frame_local)
+ error ("Symbol %s may not be buffer-local",
+ SDATA (SYMBOL_NAME (variable)));
+ break;
+ case SYMBOL_FORWARDED:
+ forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym);
+ if (KBOARD_OBJFWDP (valcontents.fwd))
+ error ("Symbol %s may not be buffer-local",
+ SDATA (SYMBOL_NAME (variable)));
+ break;
+ default: abort ();
+ }
+
+ if (sym->constant)
+ error ("Symbol %s may not be buffer-local",
+ SDATA (SYMBOL_NAME (variable)));
- if ((BUFFER_LOCAL_VALUEP (valcontents)
- && XBUFFER_LOCAL_VALUE (valcontents)->local_if_set)
- || BUFFER_OBJFWDP (valcontents))
+ if (blv ? blv->local_if_set
+ : (forwarded && BUFFER_OBJFWDP (valcontents.fwd)))
{
tem = Fboundp (variable);
-
/* Make sure the symbol has a local value in this particular buffer,
by setting it to the same value it already has. */
Fset (variable, (EQ (tem, Qt) ? Fsymbol_value (variable) : Qunbound));
return variable;
}
- /* Make sure symbol is set up to hold per-buffer values. */
- if (!BUFFER_LOCAL_VALUEP (valcontents))
+ if (!blv)
{
- Lisp_Object newval;
- tem = Fcons (Qnil, do_symval_forwarding (valcontents));
- 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)->buffer = Qnil;
- XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
- XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0;
- 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);
+ blv = make_blv (sym, forwarded, valcontents);
+ sym->redirect = SYMBOL_LOCALIZED;
+ SET_SYMBOL_BLV (sym, blv);
+ {
+ Lisp_Object symbol;
+ XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */
+ if (let_shadows_global_binding_p (symbol))
+ message ("Making %s local to %s while let-bound!",
+ SDATA (SYMBOL_NAME (variable)),
+ SDATA (current_buffer->name));
+ }
}
+
/* Make sure this buffer has its own value of symbol. */
+ XSETSYMBOL (variable, sym); /* Update in case of aliasing. */
tem = Fassq (variable, current_buffer->local_var_alist);
if (NILP (tem))
{
+ if (let_shadows_buffer_binding_p (sym))
+ message ("Making %s buffer-local while locally let-bound!",
+ SDATA (SYMBOL_NAME (variable)));
+
/* Swap out any local binding for some other buffer, and make
sure the current value is permanently recorded, if it's the
default value. */
find_symbol_value (variable);
current_buffer->local_var_alist
- = Fcons (Fcons (variable, XCDR (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (variable))->cdr)),
+ = Fcons (Fcons (variable, XCDR (blv->defcell)),
current_buffer->local_var_alist);
/* Make sure symbol does not think it is set up for this buffer;
force it to look once again for this buffer's value. */
- {
- Lisp_Object *pvalbuf;
-
- valcontents = SYMBOL_VALUE (variable);
-
- pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
- if (current_buffer == XBUFFER (*pvalbuf))
- *pvalbuf = Qnil;
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
- }
+ if (current_buffer == XBUFFER (blv->where))
+ blv->where = Qnil;
+ /* blv->valcell = blv->defcell;
+ * SET_BLV_FOUND (blv, 0); */
+ blv->found = 0;
}
/* If the symbol forwards into a C variable, then load the binding
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;
- if (INTFWDP (valcontents) || BOOLFWDP (valcontents) || OBJFWDP (valcontents))
- swap_in_symval_forwarding (variable, SYMBOL_VALUE (variable));
+ if (blv->fwd)
+ swap_in_symval_forwarding (sym, blv);
return variable;
}
(variable)
register Lisp_Object variable;
{
- register Lisp_Object tem, valcontents;
+ register Lisp_Object tem;
+ struct Lisp_Buffer_Local_Value *blv;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
-
- valcontents = SYMBOL_VALUE (variable);
+ sym = XSYMBOL (variable);
- if (BUFFER_OBJFWDP (valcontents))
+ start:
+ switch (sym->redirect)
{
- int offset = XBUFFER_OBJFWD (valcontents)->offset;
- int idx = PER_BUFFER_IDX (offset);
-
- if (idx > 0)
- {
- SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
- PER_BUFFER_VALUE (current_buffer, offset)
- = PER_BUFFER_DEFAULT (offset);
- }
- return variable;
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return variable;
+ case SYMBOL_FORWARDED:
+ {
+ union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+ if (BUFFER_OBJFWDP (valcontents))
+ {
+ int offset = XBUFFER_OBJFWD (valcontents)->offset;
+ int idx = PER_BUFFER_IDX (offset);
+
+ if (idx > 0)
+ {
+ SET_PER_BUFFER_VALUE_P (current_buffer, idx, 0);
+ PER_BUFFER_VALUE (current_buffer, offset)
+ = PER_BUFFER_DEFAULT (offset);
+ }
+ }
+ return variable;
+ }
+ case SYMBOL_LOCALIZED:
+ blv = SYMBOL_BLV (sym);
+ if (blv->frame_local)
+ return variable;
+ break;
+ default: abort ();
}
- if (!BUFFER_LOCAL_VALUEP (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
loaded, recompute its value. We have to do it now, or else
forwarded objects won't work right. */
{
- Lisp_Object *pvalbuf, buf;
- valcontents = SYMBOL_VALUE (variable);
- pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
- XSETBUFFER (buf, current_buffer);
- if (EQ (buf, *pvalbuf))
+ Lisp_Object buf; XSETBUFFER (buf, current_buffer);
+ if (EQ (buf, blv->where))
{
- *pvalbuf = Qnil;
- XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
+ blv->where = Qnil;
+ /* blv->valcell = blv->defcell;
+ * SET_BLV_FOUND (blv, 0); */
+ blv->found = 0;
find_symbol_value (variable);
}
}
/* 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;
+ int forwarded;
+ union Lisp_Val_Fwd valcontents;
+ struct Lisp_Symbol *sym;
+ struct Lisp_Buffer_Local_Value *blv = NULL;
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
-
- valcontents = SYMBOL_VALUE (variable);
- if (XSYMBOL (variable)->constant || KBOARD_OBJFWDP (valcontents)
- || BUFFER_OBJFWDP (valcontents))
- error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
+ sym = XSYMBOL (variable);
- if (BUFFER_LOCAL_VALUEP (valcontents))
+ start:
+ switch (sym->redirect)
{
- XBUFFER_LOCAL_VALUE (valcontents)->check_frame = 1;
- return variable;
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL:
+ forwarded = 0; valcontents.value = SYMBOL_VAL (sym);
+ if (EQ (valcontents.value, Qunbound))
+ valcontents.value = Qnil;
+ break;
+ case SYMBOL_LOCALIZED:
+ if (SYMBOL_BLV (sym)->frame_local)
+ return variable;
+ else
+ error ("Symbol %s may not be frame-local",
+ SDATA (SYMBOL_NAME (variable)));
+ case SYMBOL_FORWARDED:
+ forwarded = 1; valcontents.fwd = SYMBOL_FWD (sym);
+ if (KBOARD_OBJFWDP (valcontents.fwd) || BUFFER_OBJFWDP (valcontents.fwd))
+ error ("Symbol %s may not be frame-local",
+ SDATA (SYMBOL_NAME (variable)));
+ break;
+ default: abort ();
}
- if (EQ (valcontents, Qunbound))
- SET_SYMBOL_VALUE (variable, 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)->buffer = Qnil;
- XBUFFER_LOCAL_VALUE (newval)->frame = Qnil;
- XBUFFER_LOCAL_VALUE (newval)->local_if_set = 0;
- XBUFFER_LOCAL_VALUE (newval)->found_for_buffer = 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);
+ if (sym->constant)
+ error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
+
+ blv = make_blv (sym, forwarded, valcontents);
+ blv->frame_local = 1;
+ sym->redirect = SYMBOL_LOCALIZED;
+ SET_SYMBOL_BLV (sym, blv);
+ {
+ Lisp_Object symbol;
+ XSETSYMBOL (symbol, sym); /* In case `variable' is aliased. */
+ if (let_shadows_global_binding_p (symbol))
+ message ("Making %s frame-local while let-bound!",
+ SDATA (SYMBOL_NAME (variable)));
+ }
return variable;
}
(variable, buffer)
register Lisp_Object variable, buffer;
{
- 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 = XSYMBOL (variable);
- valcontents = SYMBOL_VALUE (variable);
- if (BUFFER_LOCAL_VALUEP (valcontents))
+ start:
+ switch (sym->redirect)
{
- Lisp_Object tail, elt;
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return Qnil;
+ case SYMBOL_LOCALIZED:
+ {
+ Lisp_Object tail, elt, tmp;
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ XSETBUFFER (tmp, buf);
- for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
- {
- elt = XCAR (tail);
- if (EQ (variable, XCAR (elt)))
- return Qt;
- }
- }
- if (BUFFER_OBJFWDP (valcontents))
- {
- int offset = XBUFFER_OBJFWD (valcontents)->offset;
- int idx = PER_BUFFER_IDX (offset);
- if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
- return Qt;
+ for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ if (EQ (variable, XCAR (elt)))
+ {
+ eassert (!blv->frame_local);
+ eassert (BLV_FOUND (blv) || !EQ (blv->where, tmp));
+ return Qt;
+ }
+ }
+ eassert (!BLV_FOUND (blv) || !EQ (blv->where, tmp));
+ return Qnil;
+ }
+ case SYMBOL_FORWARDED:
+ {
+ union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+ if (BUFFER_OBJFWDP (valcontents))
+ {
+ int offset = XBUFFER_OBJFWD (valcontents)->offset;
+ int idx = PER_BUFFER_IDX (offset);
+ if (idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
+ return Qt;
+ }
+ return Qnil;
+ }
+ default: abort ();
}
- return Qnil;
}
DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p,
(variable, buffer)
register Lisp_Object variable, buffer;
{
- Lisp_Object valcontents;
- register struct buffer *buf;
-
- if (NILP (buffer))
- buf = current_buffer;
- else
- {
- CHECK_BUFFER (buffer);
- buf = XBUFFER (buffer);
- }
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
+ sym = XSYMBOL (variable);
- valcontents = SYMBOL_VALUE (variable);
-
- if (BUFFER_OBJFWDP (valcontents))
- /* All these slots become local if they are set. */
- return Qt;
- else if (BUFFER_LOCAL_VALUEP (valcontents))
+ start:
+ switch (sym->redirect)
{
- Lisp_Object tail, elt;
- if (XBUFFER_LOCAL_VALUE (valcontents)->local_if_set)
- return Qt;
- for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
- {
- elt = XCAR (tail);
- if (EQ (variable, XCAR (elt)))
- return Qt;
- }
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return Qnil;
+ case SYMBOL_LOCALIZED:
+ {
+ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
+ if (blv->local_if_set)
+ return Qt;
+ XSETSYMBOL (variable, sym); /* Update in case of aliasing. */
+ return Flocal_variable_p (variable, buffer);
+ }
+ case SYMBOL_FORWARDED:
+ /* All BUFFER_OBJFWD slots become local if they are set. */
+ return (BUFFER_OBJFWDP (SYMBOL_FWD (sym)) ? Qt : Qnil);
+ default: abort ();
}
- return Qnil;
}
DEFUN ("variable-binding-locus", Fvariable_binding_locus, Svariable_binding_locus,
(variable)
register Lisp_Object variable;
{
- Lisp_Object valcontents;
+ struct Lisp_Symbol *sym;
CHECK_SYMBOL (variable);
- variable = indirect_variable (variable);
+ sym = XSYMBOL (variable);
/* Make sure the current binding is actually swapped in. */
find_symbol_value (variable);
- valcontents = XSYMBOL (variable)->value;
-
- if (BUFFER_LOCAL_VALUEP (valcontents)
- || BUFFER_OBJFWDP (valcontents))
+ start:
+ switch (sym->redirect)
{
+ case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+ case SYMBOL_PLAINVAL: return Qnil;
+ case SYMBOL_FORWARDED:
+ {
+ union Lisp_Fwd *valcontents = SYMBOL_FWD (sym);
+ if (KBOARD_OBJFWDP (valcontents))
+ return Fframe_terminal (Fselected_frame ());
+ else if (!BUFFER_OBJFWDP (valcontents))
+ return Qnil;
+ }
+ /* FALLTHROUGH */
+ case SYMBOL_LOCALIZED:
/* For a local variable, record both the symbol and which
buffer's or frame's value we are saving. */
if (!NILP (Flocal_variable_p (variable, Qnil)))
return Fcurrent_buffer ();
- else if (BUFFER_LOCAL_VALUEP (valcontents)
- && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
- return XBUFFER_LOCAL_VALUE (valcontents)->frame;
+ else if (sym->redirect == SYMBOL_LOCALIZED
+ && BLV_FOUND (SYMBOL_BLV (sym)))
+ return SYMBOL_BLV (sym)->where;
+ else
+ return Qnil;
+ default: abort ();
}
-
- return Qnil;
}
/* This code is disabled now that we use the selected frame to return
keyboard-local-values. */
#if 0
-extern struct terminal *get_terminal P_ ((Lisp_Object display, int));
+extern struct terminal *get_terminal (Lisp_Object display, int);
DEFUN ("terminal-local-value", Fterminal_local_value, Sterminal_local_value, 2, 2, 0,
doc: /* Return the terminal-local value of SYMBOL on TERMINAL.
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;
This is like Findirect_function, except that it doesn't signal an
error if the chain ends up unbound. */
Lisp_Object
-indirect_function (object)
- register Lisp_Object object;
+indirect_function (register Lisp_Object object)
{
Lisp_Object tortoise, hare;
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))
idxval_byte = string_char_to_byte (array, idxval);
p1 = SDATA (array) + idxval_byte;
- PARSE_MULTIBYTE_SEQ (p1, nbytes - idxval_byte, prev_bytes);
+ prev_bytes = BYTES_BY_CHAR_HEAD (*p1);
new_bytes = CHAR_STRING (XINT (newelt), p0);
if (prev_bytes != new_bytes)
{
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));
}
enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal };
Lisp_Object
-arithcompare (num1, num2, comparison)
- Lisp_Object num1, num2;
- enum comparison comparison;
+arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
{
double f1 = 0, f2 = 0;
int floatp = 0;
when the value fits in one. */
Lisp_Object
-long_to_cons (i)
- unsigned long i;
+long_to_cons (long unsigned int i)
{
unsigned long top = i >> 16;
unsigned int bot = i & 0xFFFF;
}
unsigned long
-cons_to_long (c)
- Lisp_Object c;
+cons_to_long (Lisp_Object c)
{
Lisp_Object top, bot;
if (INTEGERP (c))
}
INLINE static int
-digit_to_number (character, base)
- int character, base;
+digit_to_number (int character, int base)
{
int digit;
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
{
Amin
};
-static Lisp_Object float_arith_driver P_ ((double, int, enum arithop,
- int, Lisp_Object *));
+static Lisp_Object float_arith_driver (double, int, enum arithop,
+ int, Lisp_Object *);
extern Lisp_Object fmod_float ();
Lisp_Object
-arith_driver (code, nargs, args)
- enum arithop code;
- int nargs;
- register Lisp_Object *args;
+arith_driver (enum arithop code, int nargs, register Lisp_Object *args)
{
register Lisp_Object val;
register int argnum;
#define isnan(x) ((x) != (x))
static Lisp_Object
-float_arith_driver (accum, argnum, code, nargs, args)
- double accum;
- register int argnum;
- enum arithop code;
- int nargs;
- register Lisp_Object *args;
+float_arith_driver (double accum, register int argnum, enum arithop code, int nargs, register Lisp_Object *args)
{
register Lisp_Object val;
double next;
\f
void
-syms_of_data ()
+syms_of_data (void)
{
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
-arith_error (signo)
- int signo;
-{
-#if defined(USG) && !defined(POSIX_SIGNALS)
- /* USG systems forget handlers when they are used;
- 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 */
+arith_error (int signo)
+{
sigsetmask (SIGEMPTYMASK);
-#endif /* not BSD4_1 */
SIGNAL_THREAD_CHECK (signo);
xsignal0 (Qarith_error);
}
void
-init_data ()
+init_data (void)
{
/* Don't do this if just dumping out.
We don't want to call `signal' in this case
HCoop / bpt / emacs.git / blobdiff