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, 27 insertions, 13 deletions

diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index dafd5497639..11204f7f7fb 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -32,11 +32,11 @@
 ;; macros defined by `defmacro'.
 (defvar macroexpand-all-environment nil)
 
-(defvar byte-compile--ssp-conses-seen nil
+(defvar macroexp--ssp-conses-seen nil
   "Which conses have been processed in a strip-symbol-positions operation?")
-(defvar byte-compile--ssp-vectors-seen nil
+(defvar macroexp--ssp-vectors-seen nil
   "Which vectors have been processed in a strip-symbol-positions operation?")
-(defvar byte-compile--ssp-records-seen nil
+(defvar macroexp--ssp-records-seen nil
   "Which records have been processed in a strip-symbol-positions operation?")
 
 (defun macroexp--strip-s-p-2 (arg)
@@ -46,8 +46,10 @@ Return the modified ARG."
    ((symbolp arg)
     (bare-symbol arg))
    ((consp arg)
-    (unless (memq arg byte-compile--ssp-conses-seen)
-      ;; (push arg byte-compile--ssp-conses-seen)
+    (unless (and macroexp--ssp-conses-seen
+                 (gethash arg macroexp--ssp-conses-seen))
+      (if macroexp--ssp-conses-seen
+          (puthash arg t macroexp--ssp-conses-seen))
       (let ((a arg))
         (while (consp (cdr a))
           (setcar a (macroexp--strip-s-p-2 (car a)))
@@ -58,8 +60,10 @@ Return the modified ARG."
           (setcdr a (macroexp--strip-s-p-2 (cdr a))))))
     arg)
    ((vectorp arg)
-    (unless (memq arg byte-compile--ssp-vectors-seen)
-      (push arg byte-compile--ssp-vectors-seen)
+    (unless (and macroexp--ssp-vectors-seen
+                 (gethash arg macroexp--ssp-vectors-seen))
+      (if macroexp--ssp-vectors-seen
+          (puthash arg t macroexp--ssp-vectors-seen))
       (let ((i 0)
 	    (len (length arg)))
         (while (< i len)
@@ -67,8 +71,10 @@ Return the modified ARG."
 	  (setq i (1+ i)))))
     arg)
    ((recordp arg)
-    (unless (memq arg byte-compile--ssp-records-seen)
-      (push arg byte-compile--ssp-records-seen)
+    (unless (and macroexp--ssp-records-seen
+                 (gethash arg macroexp--ssp-records-seen))
+      (if macroexp--ssp-records-seen
+          (puthash arg t macroexp--ssp-records-seen))
       (let ((i 0)
 	    (len (length arg)))
         (while (< i len)
@@ -80,10 +86,18 @@ Return the modified ARG."
 (defun byte-compile-strip-s-p-1 (arg)
   "Strip all positions from symbols in ARG, destructively modifying ARG.
 Return the modified ARG."
-  (setq byte-compile--ssp-conses-seen nil)
-  (setq byte-compile--ssp-vectors-seen nil)
-  (setq byte-compile--ssp-records-seen nil)
-  (macroexp--strip-s-p-2 arg))
+  (condition-case err
+      (progn
+        (setq macroexp--ssp-conses-seen nil)
+        (setq macroexp--ssp-vectors-seen nil)
+        (setq macroexp--ssp-records-seen nil)
+        (macroexp--strip-s-p-2 arg))
+    (recursion-error
+     (dolist (tab '(macroexp--ssp-conses-seen macroexp--ssp-vectors-seen
+                                              macroexp--ssp-records-seen))
+       (set tab (make-hash-table :test 'eq)))
+     (macroexp--strip-s-p-2 arg))
+    (error (signal (car err) (cdr err)))))
 
 (defun macroexp-strip-symbol-positions (arg)
   "Strip all positions from symbols (recursively) in ARG.  Don't modify ARG."