[PATCH] Arena compile: fix ensure-generic-function for arenas

Andreas Franke via Sbcl-devel <[email protected]> Thu, 19 Mar 2026 01:34:45 +0000
Newsgroups gmane.lisp.steel-bank.devel
Message-ID <trinity-9d69aedd-d415-4d42-887e-16ddd2903595-1773884085010@trinity-msg-rest-gmx-gmx-live-6779b97d68-lmkcd>
The attached patch is the final distilled result of an extended llm-assisted work session.
What do you think?

_______________________________________________
Sbcl-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-devel
0001-Arena-compile-fix-ensure-generic-function-for-arenas.patch (text/x-patch, 1.8 KB)
From cf7c5452bedc09e27adb477ce06892232c09baef Mon Sep 17 00:00:00 2001
From: Andreas Franke <[email protected]>
Date: Thu, 19 Mar 2026 01:24:18 +0000
Subject: [PATCH] Arena compile: fix ensure-generic-function for arenas

Wraps ensure-generic-function-using-class in without-arena so the GF
object and its slots land on the main heap when called inside an arena.
---
 src/pcl/boot.lisp       | 5 +++--
 tests/arena.impure.lisp | 8 ++++++++
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index 319782113..239d0f839 100644
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -1977,8 +1977,9 @@ bootstrapping.
            (fmakunbound fun-name)
            (apply #'ensure-generic-function fun-name all-keys))
           (t
-           (apply #'ensure-generic-function-using-class
-                  existing fun-name all-keys)))))
+           (sb-vm::without-arena
+             (apply #'ensure-generic-function-using-class
+                    existing fun-name all-keys))))))
 
 (defun generic-clobbers-function (fun-name)
   (cerror "Replace the function binding"
diff --git a/tests/arena.impure.lisp b/tests/arena.impure.lisp
index 29212d602..b88097da9 100644
--- a/tests/arena.impure.lisp
+++ b/tests/arena.impure.lisp
@@ -511,6 +511,14 @@
     (assert (pathnamep val))
     (assert (not (points-to-arena *condition*)))))
 
+(test-util:with-test (:name :ensure-generic-function-not-in-arena)
+  (let ((a (new-arena 1048576))
+        (name (gensym "ARENA-GF-")))
+    (with-arena (a) (ensure-generic-function name :lambda-list '(x)))
+    (assert (not (c-find-heap->arena a)))
+    (fmakunbound name)
+    (destroy-arena a)))
+
 (test-util:with-test (:name :gc-epoch-not-in-arena)
   (with-arena (*arena*) (gc))
   (assert (heap-allocated-p sb-kernel::*gc-epoch*)))
-- 
2.43.0