[Openmcl-cvs-notifications] r8533 - /trunk/source/level-1/l1-clos-boot.lisp

gb at clozure.com gb at clozure.com
Thu Feb 21 04:29:39 EST 2008


Author: gb
Date: Thu Feb 21 04:29:38 2008
New Revision: 8533

Log:
"early" SET-FIND-CLASS: don't call %CLASS-NAME on NIL.
"late" SET-FIND-CLASS: pass T (not class ???) to FIND-CLASS-CELL.

Modified:
    trunk/source/level-1/l1-clos-boot.lisp

Modified: trunk/source/level-1/l1-clos-boot.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-clos-boot.lisp (original)
+++ trunk/source/level-1/l1-clos-boot.lisp Thu Feb 21 04:29:38 2008
@@ -1234,8 +1234,9 @@
   (clear-type-cache)
   (let ((cell (find-class-cell name class)))
     (when cell
-      (if (eq name (%class.name class))
-        (setf (info-type-kind name) :instance))
+      (when class
+        (if (eq name (%class.name class))
+          (setf (info-type-kind name) :instance)))
       (setf (class-cell-class cell) class))
     class))
 =

@@ -1284,7 +1285,7 @@
 (queue-fixup
  (defun set-find-class (name class)
    (setq name (require-type name 'symbol))
-   (let ((cell (find-class-cell name class)))
+   (let ((cell (find-class-cell name t)))
      (declare (type class-cell cell))
        (let ((old-class (class-cell-class cell)))
          (when old-class



More information about the Openmcl-cvs-notifications mailing list