From 7d1ddc9e1d8c978420c82424f5f7ae8f3f32b192 Mon Sep 17 00:00:00 2001 Message-Id: <7d1ddc9e1d8c978420c82424f5f7ae8f3f32b192.1714767116.git.mdw@distorted.org.uk> From: Mark Wooding Date: Thu, 28 Oct 2004 19:29:00 +0000 Subject: [PATCH] Code for virtual alien slots moved from proxy-class to virtual-slot-class Organization: Straylight/Edgeware From: espen --- glib/proxy.lisp | 40 ++++++++++++++-------------------------- 1 file changed, 14 insertions(+), 26 deletions(-) diff --git a/glib/proxy.lisp b/glib/proxy.lisp index fa1e518..7195f14 100644 --- a/glib/proxy.lisp +++ b/glib/proxy.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: proxy.lisp,v 1.8 2004-10-27 14:59:00 espen Exp $ +;; $Id: proxy.lisp,v 1.9 2004-10-28 19:29:00 espen Exp $ (in-package "GLIB") @@ -75,7 +75,12 @@ (defmethod initialize-internal-slot-functions ((slotd effective-virtual-slot-def (declare (ignore object)) (error "Can't read slot: ~A" (slot-definition-name slotd)))) (symbol #'(lambda (object) - (funcall getter object)))))) + (funcall getter object))) + (string (let ((reader (mkbinding-late getter + (slot-definition-type slotd) 'pointer))) + (setf (slot-value slotd 'reader-function) + #'(lambda (object) + (funcall reader (proxy-location object))))))))) (unless (slot-boundp slotd 'writer-function) (setf @@ -86,7 +91,13 @@ (defmethod initialize-internal-slot-functions ((slotd effective-virtual-slot-def (declare (ignore object)) (error "Can't set slot: ~A" (slot-definition-name slotd)))) ((or symbol cons) #'(lambda (value object) - (funcall (fdefinition setter) value object)))))) + (funcall (fdefinition setter) value object))) + (string + (let ((writer (mkbinding-late setter 'nil 'pointer + (slot-definition-type slotd)))) + (setf (slot-value slotd 'writer-function) + #'(lambda (value object) + (funcall writer (proxy-location object) value)))))))) (unless (slot-boundp slotd 'boundp-function) (setf @@ -228,8 +239,6 @@ (deftype-method unreference-alien proxy (type-spec location) `(,free ',type-spec ,location) `(funcall ',free ',type-spec ,location)))) -;; (defun proxy-instance-size (proxy) -;; (proxy-class-size (class-of proxy))) ;;;; Metaclass used for subclasses of proxy @@ -245,9 +254,6 @@ (defclass direct-alien-slot-definition (direct-virtual-slot-definition) (defclass effective-alien-slot-definition (effective-virtual-slot-definition) ((offset :reader slot-definition-offset :initarg :offset))) - - (defclass effective-virtual-alien-slot-definition (effective-virtual-slot-definition) - ()) (defmethod most-specific-proxy-superclass ((class proxy-class)) @@ -276,8 +282,6 @@ (defmethod shared-initialize ((class proxy-class) names (free (setf (slot-value class 'free) (first free))) ((slot-boundp class 'free) (slot-makunbound class 'free)))) -;; (defmethod finalize-inheritance ((class proxy-class)) -;; (call-next-method) (defmethod shared-initialize :after ((class proxy-class) names &rest initargs) (let ((super (most-specific-proxy-superclass class))) (unless (or (not super) (eq super (find-class 'proxy))) @@ -294,7 +298,6 @@ (defmethod direct-slot-definition-class ((class proxy-class) &rest initargs) (defmethod effective-slot-definition-class ((class proxy-class) &rest initargs) (case (getf initargs :allocation) (:alien (find-class 'effective-alien-slot-definition)) - (:virtual (find-class 'effective-virtual-alien-slot-definition)) (t (call-next-method)))) @@ -335,21 +338,6 @@ (defmethod initialize-internal-slot-functions ((slotd effective-alien-slot-def (call-next-method)) - (defmethod initialize-internal-slot-functions ((slotd effective-virtual-alien-slot-definition)) - (with-slots (getter setter type) slotd - (when (and (not (slot-boundp slotd 'reader-function)) (stringp getter)) - (let ((reader (mkbinding-late getter type 'pointer))) - (setf (slot-value slotd 'reader-function) - #'(lambda (object) - (funcall reader (proxy-location object)))))) - - (when (and (not (slot-boundp slotd 'writer-function)) (stringp setter)) - (let ((writer (mkbinding-late setter 'nil 'pointer type))) - (setf (slot-value slotd 'writer-function) - #'(lambda (value object) - (funcall writer (proxy-location object) value)))))) - (call-next-method)) - ;; TODO: call some C code to detect this a compile time (defconstant +struct-alignmen+ 4) -- [mdw]