From e02fb7ea04d098bda0b95ef1b69ccfe691efbc5f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Fri, 8 May 2026 20:53:30 +0200
Subject: [PATCH] clos: ensure that funcallables are treated as functions

The fact taht gfdef is null does not mean that the funcallable is not a
function. We distinguish funcallables from non-funcallables by checking the
header flag x->instance.isgf -- when it is 0, then the instance is not
funcallable.

In this commit we are still lenient towards the behavior, that any instance may
become a funcallable by a mere action of assigning the function -- initially we
set assign the function (for funcallables) to nil, ensuring that .isgf is not
ECL_NOT_FUNCALLABLE (but rather ECL_NULL_DISPATCH - a new state flag).

This assignment is at this moment performed in the only method ALLOCATE-INSTANCE
specialized to classes (and we verify the actual class using subtypep).

A more strict implementation would:
- assign isgf when the instance is allocated
- refus to assign new function to instances that are not funcallables

This commit is enough to fix the test MOP.0030, BUT NOT MOP.0031.
---
 src/c/clos/gfun.d           | 2 +-
 src/clos/standard.lsp       | 3 +++
 src/clos/std-slot-value.lsp | 3 +--
 src/h/object.h              | 1 +
 4 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/src/c/clos/gfun.d b/src/c/clos/gfun.d
index ac3b29ad6..a8cea2aa1 100644
--- a/src/c/clos/gfun.d
+++ b/src/c/clos/gfun.d
@@ -67,7 +67,7 @@ clos_set_funcallable_instance_function(cl_object x, cl_object function_or_t)
     x->instance.isgf = ECL_RESTRICTED_DISPATCH;
     x->instance.entry = generic_function_dispatch_vararg;
   } else if (function_or_t == ECL_NIL) {
-    x->instance.isgf = ECL_NOT_FUNCALLABLE;
+    x->instance.isgf = ECL_NULL_DISPATCH;
     x->instance.entry = FEnot_funcallable_vararg;
   } else if (function_or_t == @'clos::standard-optimized-reader-method') {
     x->instance.isgf = ECL_READER_DISPATCH;
diff --git a/src/clos/standard.lsp b/src/clos/standard.lsp
index 155b27c5e..566315858 100644
--- a/src/clos/standard.lsp
+++ b/src/clos/standard.lsp
@@ -99,6 +99,9 @@
   (assert (class-finalized-p class))
   (let ((x (si::allocate-raw-instance nil class (class-size class))))
     (si::instance-sig-set x)
+    (when (subtypep class 'funcallable-standard-class)
+      ;; INV this will initialize (x)->instance.isgf.
+      (set-funcallable-instance-function x nil))
     x))
 
 (defmethod make-instance ((class class) &rest initargs)
diff --git a/src/clos/std-slot-value.lsp b/src/clos/std-slot-value.lsp
index 12db1bdf4..40c6f26cb 100644
--- a/src/clos/std-slot-value.lsp
+++ b/src/clos/std-slot-value.lsp
@@ -80,8 +80,7 @@
     (when (symbolp slots)
       (setf slots (symbol-value slots)))
     `(let* ((%class ,class)
-            (,object (si::allocate-raw-instance nil %class
-                                                ,(length slots))))
+            (,object (si:allocate-raw-instance nil %class ,(length slots))))
        (declare (type standard-object ,object))
        ,@(flet ((initializerp (name list)
                   (not (eq (getf list name 'wrong) 'wrong))))
diff --git a/src/h/object.h b/src/h/object.h
index 13bbe800d..a45a4fc6d 100644
--- a/src/h/object.h
+++ b/src/h/object.h
@@ -1093,6 +1093,7 @@ struct ecl_condition_variable {
 #define ECL_READER_DISPATCH     3
 #define ECL_WRITER_DISPATCH     4
 #define ECL_USER_DISPATCH       5
+#define ECL_NULL_DISPATCH       6 /* funcallable, but gfdef is null */
 
 struct ecl_instance {            /* -- instance header -- */
         _ECL_HDR1(isgf);         /*  gf type              */