Miscellaneous enhancements to scratch/correct-warning-pos.

1. Check the type (symbol with position) of the argument given to the native
compiled version of SYMBOL_WITH_POS_SYM.
2. Handle infinite recursion caused by circular lists, etc., in
macroexp-strip-symbol-positions by using hash tables.
3. Read byte compiled functions without giving symbols positions.

* lisp/emacs-lisp/comp.el (comp-finalize-relocs): Add symbol-with-pos-p into
the list of relocated symbols.

* lisp/emacs-lisp/macroexp.el (macroexp--ssp-conses-seen)
(macroexp--ssp-vectors-seen, macroexp--ssp-records-seen): Renamed, and
animated as hash tables.
(macroexp--strip-s-p-2): Optionally tests for the presence of an argument in
one of the above hash tables, so as to handle otherwise infinite recursion.
(byte-compile-strip-s-p-1): Add a condition-case to handle infinite recursion
caused by circular lists etc., using the above hash tables as required.

* src/comp.c (comp_t): New element symbol_with_pos_sym.
(emit_SYMBOL_WITH_POS_SYM): Amend just to call the new SYMBOL_WITH_POS_SYM.
(emit_CHECK_SYMBOL_WITH_POS, define_SYMBOL_WITH_POS_SYM): New functions.
(Fcomp__init_ctxt): Register an emitter for Qsymbol_with_pos_p.
(Fcomp__compile_ctxt_to_file): Call define_SYMBOL_WITH_POS_SYM.
(syms_of_comp): Define Qsymbol_with_pos_p.

* src/data.c (syms_of_data): Define a new error symbol Qrecursion_error, an
error category for the new error symbols Qexcessive_variable_binding and
Qexcessive_lisp_nesting.

* src/eval.c (grow_specpdl): Change the signal_error call to an xsignal0 call
using the new error symbol Qexcessive_variable_binding.
(eval_sub, Ffuncall): Change the `error' calls to xsignal using the new error
symbol Qexcessive_lisp_nesting.

* src/lread.c (read1): When reading a compiled function, read the components
of the vector without giving its symbols a position.

1 files changed, 15 insertions, 1 deletions

diff --git a/src/data.c b/src/data.c
index 1f2af6f4743..6d9c0aef933 100644
--- a/src/data.c
+++ b/src/data.c
@@ -3969,7 +3969,7 @@ A is a bool vector, B is t or nil, and I is an index into A.  */)
 void
 syms_of_data (void)
 {
-  Lisp_Object error_tail, arith_tail;
+  Lisp_Object error_tail, arith_tail, recursion_tail;
 
   DEFSYM (Qquote, "quote");
   DEFSYM (Qlambda, "lambda");
@@ -4004,6 +4004,10 @@ syms_of_data (void)
   DEFSYM (Qmark_inactive, "mark-inactive");
   DEFSYM (Qinhibited_interaction, "inhibited-interaction");
 
+  DEFSYM (Qrecursion_error, "recursion-error");
+  DEFSYM (Qexcessive_variable_binding, "excessive-variable-binding");
+  DEFSYM (Qexcessive_lisp_nesting, "excessive-lisp-nesting");
+
   DEFSYM (Qlistp, "listp");
   DEFSYM (Qconsp, "consp");
   DEFSYM (Qbare_symbol_p, "bare-symbol-p");
@@ -4112,6 +4116,16 @@ syms_of_data (void)
   PUT_ERROR (Qunderflow_error, Fcons (Qrange_error, arith_tail),
              "Arithmetic underflow error");
 
+  recursion_tail = pure_cons (Qrecursion_error, error_tail);
+  Fput (Qrecursion_error, Qerror_conditions, recursion_tail);
+  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'");
+
   /* Types that type-of returns.  */
   DEFSYM (Qinteger, "integer");
   DEFSYM (Qsymbol, "symbol");