Changeset 102

Timestamp:

Dec 10, 2003, 12:22:43 AM (21 years ago)

Author:

Gary Byers

Message:

SLOT-ID stuff.

File:

• trunk/ccl/level-1/l1-clos-boot.lisp (modified) (4 diffs)

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

@@ -20 +20 @@
 ; l1-clos-boot.lisp
 
+
 (in-package :ccl)
 
@@ -149 +150 @@
 ;;; Map slot-names (symbols) to SLOT-ID objects (which contain unique indices).
 (let* ((slot-id-lock (make-lock))
-       (next-slot-index 0)
+       (next-slot-index 1)              ; 0 is never a valid slot-index
        (slot-id-hash (make-hash-table :test #'eq :weak t)))
   (defun ensure-slot-id (slot-name)
@@ -156 +157 @@
       (or (gethash slot-name slot-id-hash)
           (setf (gethash slot-name slot-id-hash)
-                (%istruct 'slot-id slot-name (incf next-slot-index))))))
+                (%istruct 'slot-id slot-name (prog1
+                                                 next-slot-index
+                                               (incf next-slot-index)))))))
   (defun current-slot-index () next-slot-index)
   )
+
+
+(defun %slot-id-lookup-obsolete (instance slot-id)
+  (update-obsolete-instance instance)
+  (funcall (%wrapper-slot-id->slotd (instance.class-wrapper instance))
+           instance slot-id))
+(defun slot-id-lookup-no-slots (instance slot-id)
+  (declare (ignore instance slot-id)))
+
+(defun %slot-id-ref-obsolete (instance slot-id)
+  (update-obsolete-instance instance)
+  (funcall (%wrapper-slot-id-value (instance.class-wrapper instance))
+           instance slot-id))
+(defun %slot-id-ref-missing (instance slot-id)
+  (slot-missing (class-of instance) instance (slot-id.name slot-id) 'slot-value))
+
+(defun %slot-id-set-obsolete (instance slot-id new-value)
+  (update-obsolete-instance instance)
+  (funcall (%wrapper-set-slot-id-value (instance.class-wrapper instance))
+           instance slot-id new-value))
+
+(defun %slot-id-set-missing (instance slot-id new-value)
+  (slot-missing (class-of instance) instance (slot-id.name slot-id) '(setf slot-value) new-value))
 
 
@@ -2299 +2325 @@
     (find-slotd name slots)))
 
-;;; Stupid, temporary definitions that miss the point completely:
+
 (defun slot-id-value (instance slot-id)
-  (slot-value instance (slot-id.name slot-id)))
+  (let* ((wrapper (if (eq (typecode instance) ppc32::subtag-instance)
+                    (instance.class-wrapper instance)
+                    (%class.own-wrapper (class-of instance)))))
+    (funcall (%wrapper-slot-id-value wrapper) instance slot-id)))
 
 (defun set-slot-id-value (instance slot-id value)
-  (set-slot-value instance (slot-id.name slot-id) value))
+  (let* ((wrapper (if (eq (typecode instance) ppc32::subtag-instance)
+                    (instance.class-wrapper instance)
+                    (%class.own-wrapper (class-of instance)))))
+    (funcall (%wrapper-set-slot-id-value wrapper) instance slot-id value)))
 
 ; returns nil if (apply gf args) wil cause an error because of the