diff --git a/pcl/braid.lisp b/pcl/braid.lisp index cb53b76899cbbe1afa8adc5b47f2113b9b9ce9b8..06a2ec5f8cc017c5ea9ed027f8cbe447bcc8190a 100644 --- a/pcl/braid.lisp +++ b/pcl/braid.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.50 2007/09/13 13:27:25 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.51 2008/05/24 14:41:39 rtoy Rel $") ;;; ;;; Bootstrapping the meta-braid. @@ -286,6 +286,7 @@ class) spec)) (set-slot 'class-precedence-list (classes cpl)) + (set-slot 'cpl-available-p t) (set-slot 'can-precede-list (classes (cdr cpl))) (set-slot 'incompatible-superclass-list nil) (set-slot 'direct-superclasses (classes direct-supers)) diff --git a/pcl/defs.lisp b/pcl/defs.lisp index 8e43fb4ca3b7e0e32c9303ca7ef1d24e3fdf7e0c..17152a071a01a68e7557742566952c84c85a7032 100644 --- a/pcl/defs.lisp +++ b/pcl/defs.lisp @@ -482,6 +482,9 @@ (defclass pcl-class (class) ((class-precedence-list :reader class-precedence-list) + (cpl-available-p + :reader cpl-available-p + :initform nil) (can-precede-list :initform () :reader class-can-precede-list) diff --git a/pcl/dfun.lisp b/pcl/dfun.lisp index cc7ec2c0e909dc3e51b5b89747abdd6d7d16b5b7..f4d63faa29b77a2d93e8c4160af751cdaa74f213 100644 --- a/pcl/dfun.lisp +++ b/pcl/dfun.lisp @@ -25,7 +25,7 @@ ;;; ************************************************************************* (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.38 2005/08/18 16:55:00 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.39 2008/05/24 14:41:39 rtoy Rel $") (in-package :pcl) @@ -1291,7 +1291,7 @@ And so, we are saved. ;;; (defun cpl-or-nil (class) (if (eq *boot-state* 'complete) - (when (class-finalized-p class) + (when (cpl-available-p class) (class-precedence-list class)) (early-class-precedence-list class))) diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp index 60f492ad1eb16a6782ad9074ca19d34250007b63..fd6be9cf6e0e3c8ff36328a2405daf29284e92ef 100644 --- a/pcl/std-class.lisp +++ b/pcl/std-class.lisp @@ -26,7 +26,7 @@ ;;; (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.82 2006/11/30 15:49:30 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.83 2008/05/24 14:41:39 rtoy Exp $") (in-package :pcl) @@ -714,6 +714,7 @@ (add-direct-subclasses class direct-superclasses) (setf (slot-value class 'class-precedence-list) (compute-class-precedence-list class)) + (setf (slot-value class 'cpl-available-p) t) (setf (slot-value class 'slots) (compute-slots class)) (let ((lclass (kernel::find-class (class-name class)))) (setf (kernel:%class-pcl-class lclass) class) @@ -860,8 +861,11 @@ ;; Need to have the cpl setup before update-lisp-class-layout ;; is called on CMUCL. (setf (slot-value class 'class-precedence-list) cpl) + (setf (slot-value class 'cpl-available-p) t) (force-cache-flushes class)) - (setf (slot-value class 'class-precedence-list) cpl)) + (progn + (setf (slot-value class 'class-precedence-list) cpl) + (setf (slot-value class 'cpl-available-p) t))) (update-class-can-precede-p cpl)) (defun update-class-can-precede-p (cpl) @@ -1655,7 +1659,8 @@ &key direct-slots direct-superclasses) (declare (ignore slot-names)) (let ((kernel-class (kernel::find-class (class-name class)))) - (with-slots (wrapper class-precedence-list prototype predicate-name + (with-slots (wrapper class-precedence-list cpl-available-p + prototype predicate-name (direct-supers direct-superclasses)) class (setf (slot-value class 'direct-slots) @@ -1666,6 +1671,7 @@ (setq direct-supers direct-superclasses) (setq wrapper (kernel:%class-layout kernel-class)) (setq class-precedence-list (compute-class-precedence-list class)) + (setq cpl-available-p t) (add-direct-subclasses class direct-superclasses) (setq predicate-name (make-class-predicate-name (class-name class))) (make-class-predicate class predicate-name)