X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/94f15c3c3cc7b65dd194b6c10bad3b19a3e31f53..7479d92c2e0ee576d0d376bbbbb72a9dcb948e4b:/glib/proxy.lisp

diff --git a/glib/proxy.lisp b/glib/proxy.lisp
index f4c5a59..b4ff7a3 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.1 2001-04-29 20:19:25 espen Exp $
+;; $Id: proxy.lisp,v 1.2 2001-04-30 11:25:25 espen Exp $
 
 (in-package "GLIB")
 
@@ -278,43 +278,19 @@   (defmethod compute-virtual-slot-location
       ((class proxy-class)
        (slotd effective-virtual-alien-slot-definition)
        direct-slotds)
-    (let ((location (call-next-method)))
+    (let ((location (call-next-method))
+	  (class-name (class-name class)))
       (if (or (stringp location) (consp location))
 	  (destructuring-bind (reader &optional writer) (mklist location)
 	    (with-slots (type) slotd
               (list
 	       (if (stringp reader)
-		   (let* ((alien-type (translate-type-spec type))
-			  (alien
-			   (alien::%heap-alien
-			    (alien::make-heap-alien-info
-			     :type (alien::parse-alien-type
-				    `(function ,alien-type system-area-pointer))
-			     :sap-form (system:foreign-symbol-address reader))))
-			  (translate-return-value
-			   (intern-return-value-translator type)))
-		     #'(lambda (object)
-			 (funcall
-			  translate-return-value
-			  (alien-funcall
-			   alien (proxy-location object)))))
+		   (mkbinding reader type class-name)
 		 reader)
 	       (if (stringp writer)
-		   (let* ((alien-type (translate-type-spec type))
-			  (alien
-			   (alien::%heap-alien
-			    (alien::make-heap-alien-info
-			     :type (alien::parse-alien-type
-				    `(function
-				      void system-area-pointer ,alien-type))
-			     :sap-form (system:foreign-symbol-address writer))))
-			  (translate-argument (intern-argument-translator type))
-			  (cleanup (intern-cleanup-function type)))
+		   (let ((writer (mkbinding writer 'nil class-name type)))
 		     #'(lambda (value object)
-			 (let ((tmp (funcall translate-argument value))
-			       (location (proxy-location object)))
-			   (alien-funcall alien location tmp)
-			   (funcall cleanup tmp))))
+			 (funcall writer object value)))
 		 writer))))
 	location)))