diff options
Diffstat (limited to 'src/data.c')
| -rw-r--r-- | src/data.c | 130 |
1 files changed, 38 insertions, 92 deletions
diff --git a/src/data.c b/src/data.c index 930d476bc3f..8f9ee63e779 100644 --- a/src/data.c +++ b/src/data.c @@ -683,7 +683,7 @@ global value outside of any lexical scope. */) switch (sym->u.s.redirect) { case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break; - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_LOCALIZED: { struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); @@ -843,7 +843,9 @@ the position will be taken. */) } DEFUN ("fset", Ffset, Sfset, 2, 2, 0, - doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. */) + doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. +If the resulting chain of function definitions would contain a loop, +signal a `cyclic-function-indirection' error. */) (register Lisp_Object symbol, Lisp_Object definition) { CHECK_SYMBOL (symbol); @@ -855,6 +857,12 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, eassert (valid_lisp_object_p (definition)); + /* Ensure non-circularity. */ + for (Lisp_Object s = definition; SYMBOLP (s) && !NILP (s); + s = XSYMBOL (s)->u.s.function) + if (EQ (s, symbol)) + xsignal1 (Qcyclic_function_indirection, symbol); + #ifdef HAVE_NATIVE_COMP register Lisp_Object function = XSYMBOL (symbol)->u.s.function; @@ -1081,7 +1089,7 @@ If CMD is not a command, the return value is nil. Value, if non-nil, is a list (interactive SPEC). */) (Lisp_Object cmd) { - Lisp_Object fun = indirect_function (cmd); /* Check cycles. */ + Lisp_Object fun = indirect_function (cmd); bool genfun = false; if (NILP (fun)) @@ -1171,7 +1179,7 @@ If COMMAND is not a command, the return value is nil. The value, if non-nil, is a list of mode name symbols. */) (Lisp_Object command) { - Lisp_Object fun = indirect_function (command); /* Check cycles. */ + Lisp_Object fun = indirect_function (command); if (NILP (fun)) return Qnil; @@ -1241,51 +1249,20 @@ The value, if non-nil, is a list of mode name symbols. */) Getting and Setting Values of Symbols ***********************************************************************/ -/* Return the symbol holding SYMBOL's value. Signal - `cyclic-variable-indirection' if SYMBOL's chain of variable - indirections contains a loop. */ - -struct Lisp_Symbol * -indirect_variable (struct Lisp_Symbol *symbol) -{ - struct Lisp_Symbol *tortoise, *hare; - - hare = tortoise = symbol; - - while (hare->u.s.redirect == SYMBOL_VARALIAS) - { - hare = SYMBOL_ALIAS (hare); - if (hare->u.s.redirect != SYMBOL_VARALIAS) - break; - - hare = SYMBOL_ALIAS (hare); - tortoise = SYMBOL_ALIAS (tortoise); - - if (hare == tortoise) - { - Lisp_Object tem; - XSETSYMBOL (tem, symbol); - xsignal1 (Qcyclic_variable_indirection, tem); - } - } - - return hare; -} - - DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0, doc: /* Return the variable at the end of OBJECT's variable chain. If OBJECT is a symbol, follow its variable indirections (if any), and return the variable at the end of the chain of aliases. See Info node `(elisp)Variable Aliases'. -If OBJECT is not a symbol, just return it. If there is a loop in the -chain of aliases, signal a `cyclic-variable-indirection' error. */) +If OBJECT is not a symbol, just return it. */) (Lisp_Object object) { if (SYMBOLP (object)) { - struct Lisp_Symbol *sym = indirect_variable (XSYMBOL (object)); + struct Lisp_Symbol *sym = XSYMBOL (object); + while (sym->u.s.redirect == SYMBOL_VARALIAS) + sym = SYMBOL_ALIAS (sym); XSETSYMBOL (object, sym); } return object; @@ -1574,7 +1551,7 @@ find_symbol_value (Lisp_Object symbol) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); case SYMBOL_LOCALIZED: { @@ -1663,7 +1640,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return; case SYMBOL_LOCALIZED: { @@ -1917,7 +1894,7 @@ default_value (Lisp_Object symbol) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); case SYMBOL_LOCALIZED: { @@ -2011,7 +1988,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value, start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return; case SYMBOL_LOCALIZED: { @@ -2149,7 +2126,7 @@ See also `defvar-local'. */) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: forwarded = 0; valcontents.value = SYMBOL_VAL (sym); if (BASE_EQ (valcontents.value, Qunbound)) @@ -2217,7 +2194,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: forwarded = 0; valcontents.value = SYMBOL_VAL (sym); break; case SYMBOL_LOCALIZED: @@ -2303,7 +2280,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return variable; case SYMBOL_FORWARDED: { @@ -2370,7 +2347,7 @@ Also see `buffer-local-boundp'.*/) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return Qnil; case SYMBOL_LOCALIZED: { @@ -2420,7 +2397,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return Qnil; case SYMBOL_LOCALIZED: { @@ -2455,7 +2432,7 @@ If the current binding is global (the default), the value is nil. */) start: switch (sym->u.s.redirect) { - case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; + case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start; case SYMBOL_PLAINVAL: return Qnil; case SYMBOL_FORWARDED: { @@ -2485,55 +2462,22 @@ If the current binding is global (the default), the value is nil. */) /* If OBJECT is a symbol, find the end of its function chain and return the value found there. If OBJECT is not a symbol, just - return it. If there is a cycle in the function chain, signal a - cyclic-function-indirection error. - - This is like Findirect_function, except that it doesn't signal an - error if the chain ends up unbound. */ + return it. */ Lisp_Object -indirect_function (register Lisp_Object object) +indirect_function (Lisp_Object object) { - Lisp_Object tortoise, hare; - - hare = tortoise = object; - - for (;;) - { - if (!SYMBOLP (hare) || NILP (hare)) - break; - hare = XSYMBOL (hare)->u.s.function; - if (!SYMBOLP (hare) || NILP (hare)) - break; - hare = XSYMBOL (hare)->u.s.function; - - tortoise = XSYMBOL (tortoise)->u.s.function; - - if (EQ (hare, tortoise)) - xsignal1 (Qcyclic_function_indirection, object); - } - - return hare; + while (SYMBOLP (object) && !NILP (object)) + object = XSYMBOL (object)->u.s.function; + return object; } DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 2, 0, doc: /* Return the function at the end of OBJECT's function chain. If OBJECT is not a symbol, just return it. Otherwise, follow all -function indirections to find the final function binding and return it. -Signal a cyclic-function-indirection error if there is a loop in the -function chain of symbols. */) - (register Lisp_Object object, Lisp_Object noerror) +function indirections to find the final function binding and return it. */) + (Lisp_Object object, Lisp_Object noerror) { - Lisp_Object result; - - /* Optimize for no indirection. */ - result = object; - if (SYMBOLP (result) && !NILP (result) - && (result = XSYMBOL (result)->u.s.function, SYMBOLP (result))) - result = indirect_function (result); - if (!NILP (result)) - return result; - - return Qnil; + return indirect_function (object); } /* Extract and set vector and string elements. */ @@ -2622,6 +2566,7 @@ bool-vector. IDX starts at 0. */) } else if (RECORDP (array)) { + CHECK_IMPURE (array, XVECTOR (array)); if (idxval < 0 || idxval >= PVSIZE (array)) args_out_of_range (array, idx); ASET (array, idxval, newelt); @@ -4241,10 +4186,11 @@ syms_of_data (void) Fput (Qrecursion_error, Qerror_message, build_pure_c_string ("Excessive recursive calling error")); - PUT_ERROR (Qexcessive_variable_binding, recursion_tail, - "Variable binding depth exceeds max-specpdl-size"); PUT_ERROR (Qexcessive_lisp_nesting, recursion_tail, "Lisp nesting exceeds `max-lisp-eval-depth'"); + /* Error obsolete (from 29.1), kept for compatibility. */ + PUT_ERROR (Qexcessive_variable_binding, recursion_tail, + "Variable binding depth exceeds max-specpdl-size"); /* Types that type-of returns. */ DEFSYM (Qinteger, "integer"); |