summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-19 13:34:36 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-19 13:34:36 +0100
commit5def05d791dd159b314428f98c3060ae30cdd976 (patch)
treec4355defdea45f8fc6b6d864e87e25fbc105d281
parentfedbfff7c5f7091e5e2b2d29d6ebf1a20349f60f (diff)
Simplify slot access.
darcs-hash:e01b2af67083c4d030aec83dfb1c87e5e2e39b44
-rw-r--r--Lisp/class-definition.lisp31
1 files changed, 16 insertions, 15 deletions
diff --git a/Lisp/class-definition.lisp b/Lisp/class-definition.lisp
index 0d95cc4..938cf50 100644
--- a/Lisp/class-definition.lisp
+++ b/Lisp/class-definition.lisp
@@ -32,6 +32,9 @@
(foreign-slot :initarg :foreign-slot
:initform nil
:accessor slot-definition-foreign-slot)
+ (foreign-offset :initarg :foreign-offset
+ :initform nil
+ :accessor slot-definition-foreign-offset)
#+#:unused
(property :initarg :property
:accessor slot-definition-property-p
@@ -117,6 +120,7 @@
&key foreign-name
foreign-slot
foreign-type
+ foreign-offset
name
class
&allow-other-keys)
@@ -141,22 +145,22 @@
(slot-value slot-definition 'foreign-name) foreign-name)))
(unless foreign-type
(setf (slot-value slot-definition 'foreign-type)
- foreign-slot)))
+ (parse-typespec (objcl-slot-type foreign-slot))))
+ (unless foreign-offset
+ (setf (slot-value slot-definition 'foreign-offset)
+ (%objcl-get-slot-offset foreign-slot))))
(defmethod c2mop:slot-value-using-class ((class objective-c-class)
instance
(effective-slot-definition
foreign-effective-slot-definition))
- (with-slots (foreign-name foreign-type) effective-slot-definition
- (let ((slot-offset
- (%objcl-get-slot-offset
- (%objcl-get-slot (pointer-to class) foreign-name))))
- (convert-from-foreign-value (inc-pointer (pointer-to instance)
- slot-offset)
- foreign-type
- nil
- t))))
+ (with-slots (foreign-name foreign-type foreign-offset) effective-slot-definition
+ (convert-from-foreign-value (inc-pointer (pointer-to instance)
+ foreign-offset)
+ foreign-type
+ nil
+ t)))
(defmethod (setf c2mop:slot-value-using-class) (value
@@ -169,11 +173,8 @@
;; case, do nothing. There may or may not be useful information
;; present in the foreign slot at this time.
(unless (eq value *objcl-foreign-default-initform*)
- (with-slots (foreign-name foreign-type) effective-slot-definition
- (let* ((slot-offset
- (%objcl-get-slot-offset
- (%objcl-get-slot (pointer-to class) foreign-name)))
- (slot-cell (inc-pointer (pointer-to instance) slot-offset)))
+ (with-slots (foreign-name foreign-type foreign-offset) effective-slot-definition
+ (let* ((slot-cell (inc-pointer (pointer-to instance) foreign-offset)))
(case (typespec-primary-type foreign-type)
((struct union array)
(let ((value-pointer (typecase value