Changeset 151

Timestamp:

Dec 20, 2003, 4:17:07 AM (21 years ago)

Author:

Gary Byers

Message:

Punt on primary accessor methods.

Location:

trunk/ccl/level-1

Files:

• l1-clos-boot.lisp (modified) (2 diffs)
• l1-clos.lisp (modified) (4 diffs)

trunk/ccl/level-1/l1-clos-boot.lisp

@@ -1483 +1483 @@
 (defvar *accessor-method-class* (make-standard-class 'standard-accessor-method *standard-method-class*))
 (defvar *standard-reader-method-class* (make-standard-class 'standard-reader-method *accessor-method-class*))
-(defvar *primary-reader-method-class* (make-standard-class 'primary-reader-method *standard-reader-method-class*))
 (defvar *standard-writer-method-class* (make-standard-class 'standard-writer-method *accessor-method-class*))
-(defvar *primary-writer-method-class* (make-standard-class 'primary-writer-method *standard-writer-method-class*))
 (defvar *method-function-class* (make-standard-class 'method-function *function-class*))
 (defvar *interpreted-method-function-class* 
@@ -1982 +1980 @@
            (dpb 2 $lfbits-numreq (ash 1 $lfbits-method-bit))))
 
-(defmethod create-reader-method-function ((class std-class)
-                                          (reader-method-class primary-reader-method)
-                                          (dslotd standard-direct-slot-definition))
-  (let* ((offset
-          (primary-class-slot-offset class (%slot-definition-name dslotd)))
-         (f (nfunction primary-reader-method (lambda (i)
-                (when (eql (%wrapper-hash-index (instance.class-wrapper i)) 0)
-                  (update-obsolete-instance i))
-                (standard-instance-instance-location-access i offset)))))
-    (inner-lfun-bits f
-                     (logior (ash 1 $lfbits-method-bit)
-                             (the fixnum (inner-lfun-bits f))))
-    f))
-
-(defmethod create-writer-method-function ((class std-class)
-                                          (writer-method-class primary-writer-method)
-                                          (dslotd standard-direct-slot-definition))
-  (let* ((offset (primary-class-slot-offset class
-                                            (%slot-definition-name dslotd)))
-         (f
-          (nfunction primary-writer-method
-                     (lambda (new i)
-                       (when (eql
-                              (%wrapper-hash-index
-                               (instance.class-wrapper i))
-                              0)
-                         (update-obsolete-instance i))
-                       (setf
-                        (standard-instance-instance-location-access i offset)
-                        new)))))
-    (inner-lfun-bits f
-                     (logior (ash 1 $lfbits-method-bit)
-                             (the fixnum (inner-lfun-bits f))))
-    f))
-                     
-
-
 
 

trunk/ccl/level-1/l1-clos.lisp

@@ -737 +737 @@
                                 &rest initargs)
   (declare (ignore initargs))
-  (if (primary-class-slot-offset class (%slot-definition-name dslotd))
-    *primary-reader-method-class*
-    *standard-reader-method-class*))
+  *standard-reader-method-class*)
 
 (defmethod reader-method-class ((class funcallable-standard-class)
@@ -745 +743 @@
                                 &rest initargs)
   (declare (ignore  initargs))
-  (if (primary-class-slot-offset class (%slot-definition-name dslotd))
-    *primary-reader-method-class*
-    *standard-reader-method-class*))
+  *standard-reader-method-class*)
 
 (defmethod add-reader-method ((class std-class) gf dslotd)
@@ -774 +770 @@
                                 &rest initargs)
   (declare (ignore initargs))
-  (if (primary-class-slot-offset class (%slot-definition-name dslotd))
-    *primary-writer-method-class*
-    *standard-writer-method-class*))
+  *standard-writer-method-class*)
 
 (defmethod writer-method-class ((class funcallable-standard-class)
@@ -782 +776 @@
                                 &rest initargs)
   (declare (ignore initargs))
-  (if (primary-class-slot-offset class (%slot-definition-name dslotd))
-    *primary-writer-method-class*
-    *standard-writer-method-class*))
+  *standard-writer-method-class*)