The slot accessors must check that the structures are up-to-date.

src/CHANGELOG

@@ -75,9 +75,13 @@ ECL 9.12.1:
  - FDEFINITION and SYMBOL-FUNCTION caused an incorrect error condition when
    acting on NIL.
 
+* Clos:
+
  - CLOS:SET-FUNCALLABLE-INSTANCE-FUNCTION broke the value if SI:INSTANCE-SIG,
    preventing any further access to the instance slots.
 
+ - The optimized slot accessors check that the instances are up to date.
+
 * Sockets:
 
  - The socket option TCP_NODELAY option has been fixed: it was improperly using

src/clos/boot.lsp

@@ -50,9 +50,9 @@
        (the-t (make-empty-standard-class 'T the-class))
        ;; It does not matter that we pass NIL instead of a class object,
        ;; because CANONICAL-SLOT-TO-DIRECT-SLOT will make simple slots.
-       (class-slots (loop for s in (parse-slots '#.+class-slots+)
+       (class-slots (loop for s in (parse-slots '#.(remove-accessors +class-slots+))
 			  collect (canonical-slot-to-direct-slot nil s)))
-       (standard-slots (loop for s in (parse-slots '#.+standard-class-slots+)
+       (standard-slots (loop for s in (parse-slots '#.(remove-accessors +standard-class-slots+))
 			     collect (canonical-slot-to-direct-slot nil s)))
        (hash-table (make-hash-table :size 24)))
 

src/clos/kernel.lsp

@@ -34,7 +34,6 @@
 	name)	
     (dolist (s slotds `(progn ,@output))
       (when (setf name (getf (cdr s) :accessor))
-	(remf (cdr s) :accessor)
 	(setf output
 	      (append output
 		      `((defun ,name (obj)
@@ -46,6 +45,11 @@
 			  `(si:instance-ref ,obj ,,i))
 			))))
       (incf i))))
+(defun remove-accessors (slotds)
+  (loop for i in slotds
+     for j = (copy-list i)
+     do (remf (cdr j) :accessor)
+     collect j))
 )
 
 ;;; ----------------------------------------------------------------------
@@ -69,7 +73,7 @@
       (sealedp :initarg :sealedp :initform nil :accessor class-sealedp)
       (prototype))))
 
-#.(create-accessors +class-slots+ 'class)
+;#.(create-accessors +class-slots+ 'class)
 
 ;;; ----------------------------------------------------------------------
 ;;; STANDARD-CLASS

src/clos/standard.lsp

@@ -548,6 +548,9 @@ because it contains a reference to the undefined class~%  ~A"
 	       `(si::instance-ref ,slotd #.(position 'location +slot-definition-slots+
 						     :key #'first))))
     (values #'(lambda (self)
+                (declare (optimize (safety 0) (speed 3) (debug 0))
+                         (standard-object self))
+                (ensure-up-to-date-instance self)
 		(let* ((class (si:instance-class self))
 		       (table (slot-table class))
 		       (slotd (gethash slot-name table))
@@ -559,6 +562,9 @@ because it contains a reference to the undefined class~%  ~A"
 		      value
 		      (values (slot-unbound (class-of self) self slot-name)))))
 	    #'(lambda (value self)
+                (declare (optimize (safety 0) (speed 3) (debug 0))
+                         (standard-object self))
+                (ensure-up-to-date-instance self)
 		(let* ((class (si:instance-class self))
 		       (table (slot-table class))
 		       (slotd (gethash slot-name table))
@@ -571,8 +577,14 @@ because it contains a reference to the undefined class~%  ~A"
   (declare (si::c-local)
 	   (fixnum slot-index))
   (values #'(lambda (self)
+              (declare (optimize (safety 0) (speed 3) (debug 0))
+                       (standard-object self))
+              (ensure-up-to-date-instance self)
 	      (safe-instance-ref self index))
 	  #'(lambda (value self)
+              (declare (optimize (safety 0) (speed 3) (debug 0))
+                       (standard-object self))
+              (ensure-up-to-date-instance self)
 	      (si:instance-set self index value))))
 
 (defun std-class-accessors (slot-name)

src/clos/stdmethod.lsp

@@ -25,7 +25,7 @@
   (:metaclass 'funcallable-standard-class))
 
 (defclass standard-generic-function (generic-function)
-  #.+standard-generic-function-slots+
+  #.(remove-accessors +standard-generic-function-slots+)
   (:metaclass 'funcallable-standard-class))
 
 ;;;----------------------------------------------------------------------
@@ -35,7 +35,7 @@
 (defclass method () ())
 
 (defclass standard-method (method)
-  #.+standard-method-slots+)
+  #.(remove-accessors +standard-method-slots+))
 
 
 (defun function-keywords (method)