From 8acd52bba40982b4f3cadc17fb35dc96143605fb Mon Sep 17 00:00:00 2001
From: Mattias Engdegård
Date: Fri, 14 Jul 2023 18:05:32 +0200
Subject: Provide backtrace for byte-ops car, cdr, setcar, setcdr, nth and elt

Include calls to these primitives from byte-compiled code in
backtraces.  For nth and elt, not all errors are covered.
(Bug#64613)

* src/bytecode.c (exec_byte_code): Add error backtrace records for
car, cdr, setcar, setcdr, nth and elt.
* src/data.c (syms_of_data): Add missing defsyms for car, setcar,
setcdr, nth and elt.
* test/lisp/emacs-lisp/bytecomp-tests.el
(bytecomp-tests--error-frame, bytecomp-tests--byte-op-error-cases)
(bytecomp--byte-op-error-backtrace): New test.
---
 src/bytecode.c | 42 ++++++++++++++++++++++++++++++++++++------
 1 file changed, 36 insertions(+), 6 deletions(-)

(limited to 'src/bytecode.c')

diff --git a/src/bytecode.c b/src/bytecode.c
index 4207ff0b71f..2eb53b0428a 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -646,7 +646,10 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
 	  if (CONSP (TOP))
 	    TOP = XCAR (TOP);
 	  else if (!NILP (TOP))
-	    wrong_type_argument (Qlistp, TOP);
+	    {
+	      record_in_backtrace (Qcar, &TOP, 1);
+	      wrong_type_argument (Qlistp, TOP);
+	    }
 	  NEXT;
 
 	CASE (Beq):
@@ -668,7 +671,10 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
 	    if (CONSP (TOP))
 	      TOP = XCDR (TOP);
 	    else if (!NILP (TOP))
-	      wrong_type_argument (Qlistp, TOP);
+	      {
+		record_in_backtrace (Qcdr, &TOP, 1);
+		wrong_type_argument (Qlistp, TOP);
+	      }
 	    NEXT;
 	  }
 
@@ -1032,7 +1038,15 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
 	      {
 		for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--)
 		  v2 = XCDR (v2);
-		TOP = CAR (v2);
+		if (CONSP (v2))
+		  TOP = XCAR (v2);
+		else if (NILP (v2))
+		  TOP = Qnil;
+		else
+		  {
+		    record_in_backtrace (Qnth, &TOP, 2);
+		    wrong_type_argument (Qlistp, v2);
+		  }
 	      }
 	    else
 	      TOP = Fnth (v1, v2);
@@ -1552,7 +1566,15 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
 		/* Like the fast case for Bnth, but with args reversed.  */
 		for (EMACS_INT n = XFIXNUM (v2); 0 < n && CONSP (v1); n--)
 		  v1 = XCDR (v1);
-		TOP = CAR (v1);
+		if (CONSP (v1))
+		  TOP = XCAR (v1);
+		else if (NILP (v1))
+		  TOP = Qnil;
+		else
+		  {
+		    record_in_backtrace (Qelt, &TOP, 2);
+		    wrong_type_argument (Qlistp, v1);
+		  }
 	      }
 	    else
 	      TOP = Felt (v1, v2);
@@ -1581,7 +1603,11 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
 	  {
 	    Lisp_Object newval = POP;
 	    Lisp_Object cell = TOP;
-	    CHECK_CONS (cell);
+	    if (!CONSP (cell))
+	      {
+		record_in_backtrace (Qsetcar, &TOP, 2);
+		wrong_type_argument (Qconsp, cell);
+	      }
 	    CHECK_IMPURE (cell, XCONS (cell));
 	    XSETCAR (cell, newval);
 	    TOP = newval;
@@ -1592,7 +1618,11 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
 	  {
 	    Lisp_Object newval = POP;
 	    Lisp_Object cell = TOP;
-	    CHECK_CONS (cell);
+	    if (!CONSP (cell))
+	      {
+		record_in_backtrace (Qsetcdr, &TOP, 2);
+		wrong_type_argument (Qconsp, cell);
+	      }
 	    CHECK_IMPURE (cell, XCONS (cell));
 	    XSETCDR (cell, newval);
 	    TOP = newval;
-- 
cgit v1.2.1