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

[gb at clozure.com]

Author: gb
Date: Wed Aug  6 07:40:25 2008
New Revision: 10376

Log:
INSTANCE-CLASS-WRAPPER: non-generic, split into standard, non-standard
instance cases.




Modified:
    trunk/source/level-1/l1-clos-boot.lisp
    trunk/source/level-1/l1-clos.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 Wed Aug  6 07:40:25 2008
@@ -1171,6 +1171,27 @@
 =

                         =

 ;;;;;;;;;;;;;;;;;;;;;;;;  Instances and classes ;;;;;;;;;;;;;;;;;;;;;;;;;;=
;;;;
+
+(declaim (inline non-standard-instance-class-wrapper))
+
+(defun non-standard-instance-class-wrapper (instance)
+  (let* ((typecode (typecode instance)))
+    (declare (type (unsigned-byte 8) typecode))
+    (cond ((eql typecode target::subtag-istruct)
+           (istruct-cell-info (%svref instance 0)))
+          ((eql typecode target::subtag-basic-stream)
+           (%class.own-wrapper (basic-stream.class instance)))
+          ((typep instance 'funcallable-standard-object)
+           (gf.instance.class-wrapper instance))
+          ((eql typecode target::subtag-macptr)
+           (foreign-instance-class-wrapper instance))
+          (t (%class.own-wrapper (class-of instance))))))
+
+(defun instance-class-wrapper (instance)
+  (if (=3D (typecode instance) target::subtag-instance)
+    (instance.class-wrapper instance)
+    (non-standard-instance-class-wrapper instance)))
+
 =

 (defvar %find-classes% (make-hash-table :test 'eq))
 =

@@ -3535,21 +3556,7 @@
 =

 (setf (fdefinition '%do-remove-direct-method) #'remove-direct-method)
 =

-(defmethod instance-class-wrapper (x)
-  (%class.own-wrapper (class-of x)))
-
-(defmethod instance-class-wrapper ((instance standard-object))
-  (if (%standard-instance-p instance)
-    (instance.class-wrapper instance)
-    (if (typep instance 'macptr)
-      (foreign-instance-class-wrapper instance)
-      (%class.own-wrapper (class-of instance)))))
-
-(defmethod instance-class-wrapper ((instance standard-generic-function))
-  (gf.instance.class-wrapper  instance))
-
-
-				   =

+
 =

 (defun generic-function-wrapper (gf)
   (unless (inherits-from-standard-generic-function-p (class-of gf))

Modified: trunk/source/level-1/l1-clos.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.lisp (original)
+++ trunk/source/level-1/l1-clos.lisp Wed Aug  6 07:40:25 2008
@@ -1713,8 +1713,7 @@
 =

 =

 =

-(defmethod instance-class-wrapper ((instance funcallable-standard-object))
-  (gf.instance.class-wrapper  instance))
+
 =

 (defun set-funcallable-instance-function (funcallable-instance function)
   (unless (typep funcallable-instance 'funcallable-standard-object)