Changeset 180

Timestamp:

Jan 3, 2004, 11:41:15 AM (21 years ago)

Author:

Gary Byers

Message:

Move FOREIGN-OBJECT-DOMAIN accessors elsewhere. Make slot accessors work
on pointer-based instances.

File:

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

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

@@ -1708 +1708 @@
 
 
-(def-accessors (foreign-object-domain) %svref
-  nil                                   ; foreign-object-domain
-  foreign-object-domain-index           ; 1..n
-  foreign-object-domain-name            ;
-  foreign-object-domain-recognize       ; function: is object one of ours ?
-  foreign-object-domain-class-of        ; function: returns class of object
-  foreign-object-domain-classp          ; function: true if object is a class
-  foreign-object-domain-instance-class-wrapper ; function: returns wrapper of object's class
-  foreign-object-domain-class-own-wrapper ; function: returns class own wrapper if class
-  foreign-object-domain-slots-vector    ; returns slots vector of object or nil
-  )
+
 
 (defun make-foreign-object-domain (&key index name recognize class-of classp
@@ -2162 +2152 @@
 
 
+(declaim (inline instance-slots))
+(defun instance-slots (instance)
+  (let* ((typecode (typecode instance)))
+    (cond ((eql typecode ppc32::subtag-instance) (instance.slots instance))
+          ((eql typecode ppc32::subtag-macptr) (foreign-slots-vector instance))
+          (t (error "Don't know how to find slots of ~s" instance)))))
+
 
 (defmethod copy-instance ((instance standard-object))
@@ -2218 +2215 @@
                                    instance
                                    (slotd standard-effective-slot-definition))
-  (%std-slot-vector-value (instance.slots instance) slotd))
+  (%std-slot-vector-value (instance-slots instance) slotd))
 
 (defun %maybe-std-slot-value-using-class (class instance slotd)
@@ -2226 +2223 @@
                (instance.class-wrapper slotd))
            (eq *standard-class-wrapper* (instance.class-wrapper class)))
-    (%std-slot-vector-value (instance.slots instance) slotd)
+    (%std-slot-vector-value (instance-slots instance) slotd)
     (slot-value-using-class class instance slotd)))
 
@@ -2254 +2251 @@
      instance
      (slotd standard-effective-slot-definition))
-  (%set-std-slot-vector-value (instance.slots instance) slotd new))
+  (%set-std-slot-vector-value (instance-slots instance) slotd new))
 
 
@@ -2263 +2260 @@
                (instance.class-wrapper slotd))
            (eq *standard-class-wrapper* (instance.class-wrapper class)))
-    (%set-std-slot-vector-value (instance.slots instance) slotd new)
+    (%set-std-slot-vector-value (instance-slots instance) slotd new)
     (setf (slot-value-using-class class instance slotd) new)))
 
@@ -2334 +2331 @@
                                     instance
                                     (slotd standard-effective-slot-definition))
-  (%std-slot-vector-boundp (instance.slots instance) slotd))
+  (%std-slot-vector-boundp (instance-slots instance) slotd))
 
 (defmethod slot-boundp-using-class ((class funcallable-standard-class)
@@ -2655 +2652 @@
     (unless index
       (error "Unknown initialization function: ~s." (car functions)))
-    (let ((initvect (%svref (instance.slots class) index)))
+    (let ((initvect (%svref (instance-slots class) index)))
       (unless initvect
-        (setf (%svref (instance.slots class) index) 
+        (setf (%svref (instance-slots class) index) 
               (setq initvect (compute-initargs-vector instance class functions))))
       initvect)))