From b93eff38d8718a6d56d39ae663048eb1253a2a58 Mon Sep 17 00:00:00 2001 From: Didier Verna Date: Thu, 12 Feb 2026 11:32:15 +0100 Subject: [PATCH] Allow the creation of early classes with the correct size. 2026-02-12 Didier Verna * src/clos/boot.lsp (make-empty-standard-class): New argument SIZE. Default it to the length of standard class slots. Pass it on to SI:ALLOCATE-RAW-INSTANCE. * src/clos/hierarchy.lsp (+class-hierarchy+): Set it to the length of structure class slots when creating the STRUCTURE-OBJECT class. --- src/clos/boot.lsp | 12 +++++++----- src/clos/hierarchy.lsp | 3 ++- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/clos/boot.lsp b/src/clos/boot.lsp index 7cf94282a..a8c110594 100644 --- a/src/clos/boot.lsp +++ b/src/clos/boot.lsp @@ -18,13 +18,15 @@ ;;; We cannot use the functions CREATE-STANDARD-CLASS and others because SLOTS, ;;; DIRECT-SLOTS, etc are empty and therefore SLOT-VALUE does not work. -(defun make-empty-standard-class (name &key (metaclass 'standard-class) - direct-superclasses direct-slots index) +(defun make-empty-standard-class + (name &key (metaclass 'standard-class) + direct-superclasses direct-slots index + (size #.(length +standard-class-slots+))) (declare (optimize speed (safety 0))) - (let* ((the-metaclass (and metaclass (gethash metaclass si::*class-name-hash-table*))) + (let* ((the-metaclass + (and metaclass (gethash metaclass si::*class-name-hash-table*))) (class (or (gethash name si::*class-name-hash-table*) - (si:allocate-raw-instance nil the-metaclass - #.(length +standard-class-slots+))))) + (si:allocate-raw-instance nil the-metaclass size)))) (with-early-accessors (+standard-class-slots+) (when (eq name 'standard-class) (defconstant +the-standard-class+ class) diff --git a/src/clos/hierarchy.lsp b/src/clos/hierarchy.lsp index 6c6b9ac0f..76ad51073 100644 --- a/src/clos/hierarchy.lsp +++ b/src/clos/hierarchy.lsp @@ -374,6 +374,7 @@ :direct-slots #.+structure-class-slots+) (structure-object :metaclass structure-class - :direct-superclasses (t)) + :direct-superclasses (t) + :size #.(length +structure-class-slots+)) )))