-(defmethod shared-initialize ((class ginstance-class) names
- &rest initargs &key name alien-name
- size ref unref)
- (declare (ignore initargs names))
- (let* ((class-name (or name (class-name class)))
- (type-number
- (find-type-number
- (or (first alien-name) (default-alien-type-name class-name)) t)))
- (register-type class-name type-number)
- (let ((size (or size (type-instance-size type-number))))
- (declare (special size))
- (call-next-method)))
-
- (when ref
- (let ((ref (mkbinding (first ref) 'pointer 'pointer)))
- (setf
- (slot-value class 'copy)
- #'(lambda (type location)
- (declare (ignore type))
- (funcall ref location)))))
- (when unref
- (let ((unref (mkbinding (first unref) 'nil 'pointer)))
- (setf
- (slot-value class 'free)
- #'(lambda (type location)
- (declare (ignore type))
- (funcall unref location))))))
-
-
-(defmethod validate-superclass
- ((class ginstance-class) (super pcl::standard-class))
- (subtypep (class-name super) 'ginstance))
+(defun %type-number-of-ginstance (location)
+ (let ((class (sap-ref-sap location 0)))
+ (sap-ref-32 class 0)))
+
+(defmethod make-proxy-instance :around ((class ginstance-class) location &rest initargs)
+ (declare (ignore class))
+ (let ((class (labels ((find-known-class (type-number)
+ (or
+ (find-class (type-from-number type-number) nil)
+ (unless (zerop type-number)
+ (find-known-class (type-parent type-number))))))
+ (find-known-class (%type-number-of-ginstance location)))))
+ ;; Note that chancing the class argument must not alter "the
+ ;; ordered set of applicable methods" as specified in the
+ ;; Hyperspec
+ (if class
+ (apply #'call-next-method class location initargs)
+ (error "Object at ~A has an unkown type number: ~A"
+ location (%type-number-of-ginstance location)))))
+
+(defmethod make-proxy-instance ((class ginstance-class) location &rest initargs)
+ (declare (ignore initargs))
+ (reference-foreign class location)
+ ;; Since we make an explicit reference to the foreign object, we
+ ;; always have to release it when the proxy is garbage collected
+ ;; and therefor ignore the weak-p argument.
+ (call-next-method class location :weak nil))
+
+(defmethod invalidate-instance ((instance ginstance))
+ (declare (ignore instance))
+ ;; A ginstance should never be invalidated since it is ref counted
+ nil)
+
+(defmethod callback-from-alien-form (form (class ginstance-class) &rest args)
+ (declare (ignore args))
+ (from-alien-form form class))
+
+(defmethod copy-from-alien-form (location (class ginstance-class) &rest args)
+ (declare (ignore location class args))
+ (error "Doing copy-from-alien on a ref. counted class is most certainly an error, but if it really is what you want you should use REFERENCE-FOREIGN on the returned instance instead."))
+
+(defmethod copy-from-alien-function ((class ginstance-class) &rest args)
+ (declare (ignore class args))
+ (error "Doing copy-from-alien on a ref. counted class is most certainly an error, but if it really is what you want you should use REFERENCE-FOREIGN on the returned instance instead."))
+
+(defmethod reader-function ((class ginstance-class) &rest args)
+ (declare (ignore args))
+ #'(lambda (location &optional (offset 0) weak-p)
+ (declare (ignore weak-p))
+ (ensure-proxy-instance class (sap-ref-sap location offset))))