From 3c677220b3e073fd3cdd79327c60f7474b32ef28 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Fri, 8 May 2026 23:17:21 +0200
Subject: [PATCH] [wip]

---
 src/c/clos/gfun.d     | 8 ++++++++
 src/c/clos/instance.d | 7 +++++++
 src/c/symbols_list.h  | 1 +
 src/clos/standard.lsp | 5 ++---
 src/h/external.h      | 1 +
 5 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/src/c/clos/gfun.d b/src/c/clos/gfun.d
index 98631cc80..46226a182 100644
--- a/src/c/clos/gfun.d
+++ b/src/c/clos/gfun.d
@@ -56,6 +56,14 @@ user_function_dispatch(cl_narg narg, ...)
 cl_object
 clos_set_funcallable_instance_function(cl_object x, cl_object function_or_t)
 {
+  /* XXX the code below leads to crash (!) */
+
+  /* if (ecl_unlikely(ECL_FUNCALLABLE_P(x))) { */
+  /*   FEwrong_type_nth_arg(@[clos::set-funcallable-instance-function], */
+  /*                        1, x, @[clos::funcallable-standard-object]); */
+  /* } */
+
+  /* and this works */
   if (ecl_unlikely(!ECL_INSTANCEP(x)))
     FEwrong_type_nth_arg(@[clos::set-funcallable-instance-function],
                          1, x, @[ext::instance]);
diff --git a/src/c/clos/instance.d b/src/c/clos/instance.d
index 54bb496c0..7e27b9c54 100644
--- a/src/c/clos/instance.d
+++ b/src/c/clos/instance.d
@@ -69,6 +69,13 @@ si_instance_slotds(cl_object x)
   @(return x->instance.slotds);
 }
 
+cl_object
+si_instance_fun_set(cl_object x)
+{
+  x->instance.isgf = ECL_NULL_DISPATCH;
+  @(return x);
+}
+
 cl_object
 si_instance_sig_set(cl_object x)
 {
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index 8efcc8941..b3c90d52b 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1321,6 +1321,7 @@ cl_symbols[] = {
 {SYS_ "INSTANCE-NEW-STAMP" ECL_FUN("si_instance_new_stamp", si_instance_new_stamp, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "INSTANCE-GET-STAMP" ECL_FUN("si_instance_get_stamp", si_instance_get_stamp, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "INSTANCE-SLOTDS" ECL_FUN("si_instance_slotds", si_instance_slotds, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
+{SYS_ "INSTANCE-FUN-SET" ECL_FUN("si_instance_fun_set", si_instance_fun_set, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "INSTANCE-SIG-SET" ECL_FUN("si_instance_sig_set", si_instance_sig_set, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "INSTANCE-CLASS" ECL_FUN("si_instance_class", si_instance_class, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "INSTANCE-CLASS-SET" ECL_FUN("si_instance_class_set", si_instance_class_set, 2) ECL_VAR(SI_ORDINARY, OBJNULL)},
diff --git a/src/clos/standard.lsp b/src/clos/standard.lsp
index 566315858..e8bfc1275 100644
--- a/src/clos/standard.lsp
+++ b/src/clos/standard.lsp
@@ -98,10 +98,9 @@
   ;; the class. -- jd 2021-12-10
   (assert (class-finalized-p class))
   (let ((x (si::allocate-raw-instance nil class (class-size class))))
-    (si::instance-sig-set x)
+    (si:instance-sig-set x)
     (when (subtypep class 'funcallable-standard-class)
-      ;; INV this will initialize (x)->instance.isgf.
-      (set-funcallable-instance-function x nil))
+      (si:instance-fun-set x))
     x))
 
 (defmethod make-instance ((class class) &rest initargs)
diff --git a/src/h/external.h b/src/h/external.h
index a5280aca4..f89059135 100755
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -862,6 +862,7 @@ extern ECL_API cl_object si_instance_obsolete_p(cl_object x);
 extern ECL_API cl_object si_instance_new_stamp(cl_object x);
 extern ECL_API cl_object si_instance_get_stamp(cl_object x);
 extern ECL_API cl_object si_instance_slotds(cl_object x);
+extern ECL_API cl_object si_instance_fun_set(cl_object x);
 extern ECL_API cl_object si_instance_sig_set(cl_object x);
 
 extern ECL_API cl_object ecl_allocate_instance(cl_object clas, cl_index size);