Subject: bug#75322: SAFE_ALLOCA assumed to root Lisp_Objects/SSDATA(string)

From: Gerd Möllmann <[email-masked]>
Date: Sun, 05 Jan 2025 07:59:32 +0100

Gerd Möllmann <[email-masked]> writes:

> Just want to add that all SAFE_NALLOC uses should be checked in
> scratch/igc. For example, set_overlays_multibyte uses it to store
> itree_node *, and itree_node is in MPS.
>
> I think I'll just make it allocate a root in my Emacs. That's the least
> work.

Please find attached what I'm using now in my Emacs, in addition to your
xstrdup commit.

>From c364d3199a1b3b1a9ec0f9afe421110d46a77769 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gerd=20M=C3=B6llmann?= <[email-masked]>
Date: Sat, 4 Jan 2025 19:42:50 +0100
Subject: [PATCH 1/2] Don't use SAFE_NALLOCA for Lisp_Objects

* src/callproc.c (call_process, create_temp_file): Use SAFE_ALLOCA_LISP
instead of SAFE_NALLCA.
---
 src/callproc.c | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/callproc.c b/src/callproc.c
index 459ddbeb4f3..6f358f939de 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -423,7 +423,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
 	  val = Qraw_text;
 	else
 	  {
-	    SAFE_NALLOCA (args2, 1, nargs + 1);
+	    SAFE_ALLOCA_LISP (args2, nargs + 1);
 	    args2[0] = Qcall_process;
 	    for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
 	    coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
@@ -741,7 +741,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
 	    {
 	      ptrdiff_t i;
 
-	      SAFE_NALLOCA (args2, 1, nargs + 1);
+	      SAFE_ALLOCA_LISP (args2, nargs + 1);
 	      args2[0] = Qcall_process;
 	      for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
 	      coding_systems
@@ -1033,7 +1033,7 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
       Lisp_Object coding_systems;
       Lisp_Object *args2;
       USE_SAFE_ALLOCA;
-      SAFE_NALLOCA (args2, 1, nargs + 1);
+      SAFE_ALLOCA_LISP (args2, nargs + 1);
       args2[0] = Qcall_process_region;
       memcpy (args2 + 1, args, nargs * sizeof *args);
       coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
-- 
2.47.1

>From 5b0a46390dfb5407cb7585bcbb1b7491d81885ea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gerd=20M=C3=B6llmann?= <[email-masked]>
Date: Sun, 5 Jan 2025 07:45:51 +0100
Subject: [PATCH 2/2] Make SAFE_NALLOCA allocate an ambiguous root

* src/igc.c (igc_xnmalloc_ambig): New function.
* src/igc.h: Declare it.
* src/lisp.h (SAFE_NALLOCA): Use it.
---
 src/igc.c  |  6 ++++++
 src/igc.h  |  1 +
 src/lisp.h | 19 +++++++++++++++++++
 3 files changed, 26 insertions(+)

diff --git a/src/igc.c b/src/igc.c
index 54131d5fcf3..10f74c66d8f 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -3144,6 +3144,12 @@ igc_xzalloc_ambig (size_t size)
   return p;
 }
 
+void *
+igc_xnmalloc_ambig (ptrdiff_t nitems, ptrdiff_t item_size)
+{
+  return igc_xzalloc_ambig (nitems * item_size);
+}
+
 void *
 igc_realloc_ambig (void *block, size_t size)
 {
diff --git a/src/igc.h b/src/igc.h
index 2a9bcda58b2..656a384aacf 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -86,6 +86,7 @@ #define EMACS_IGC_H
 struct Lisp_Buffer_Local_Value *igc_alloc_blv (void);
 void *igc_alloc_handler (void);
 void *igc_xzalloc_ambig (size_t size);
+void *igc_xnmalloc_ambig (ptrdiff_t nitems, ptrdiff_t item_size);
 void *igc_realloc_ambig (void *block, size_t size);
 void igc_xfree (void *p);
 Lisp_Object *igc_xalloc_lisp_objs_exact (size_t n);
diff --git a/src/lisp.h b/src/lisp.h
index 67b574a67b7..32e2886561c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -6109,6 +6109,23 @@ #define SAFE_ALLOCA(size) ((size) <= sa_avail				\
    NITEMS items, each of the same type as *BUF.  MULTIPLIER must
    positive.  The code is tuned for MULTIPLIER being a constant.  */
 
+# ifdef HAVE_MPS
+void *igc_xnmalloc_ambig (ptrdiff_t nitems, ptrdiff_t item_size);
+void igc_xfree (void *p);
+
+#define SAFE_NALLOCA(buf, multiplier, nitems)				\
+  do {									\
+    if ((nitems) <= sa_avail / sizeof *(buf) / (multiplier))		\
+      (buf) = AVAIL_ALLOCA (sizeof *(buf) * (multiplier) * (nitems));	\
+    else								\
+      {									\
+	(buf) = igc_xnmalloc_ambig (nitems, sizeof *(buf) * (multiplier)); \
+	record_unwind_protect_ptr (igc_xfree, buf);			\
+      }									\
+  } while (false)
+
+#else
+
 #define SAFE_NALLOCA(buf, multiplier, nitems)			 \
   do {								 \
     if ((nitems) <= sa_avail / sizeof *(buf) / (multiplier))	 \
@@ -6120,6 +6137,8 @@ #define SAFE_NALLOCA(buf, multiplier, nitems)			 \
       }								 \
   } while (false)
 
+#endif
+
 /* SAFE_ALLOCA_STRING allocates a C copy of a Lisp string.  */
 
 #define SAFE_ALLOCA_STRING(ptr, string)			\
-- 
2.47.1