- (when size
- (setf (slot-value class 'size) (first size))))
-
-
- (defmethod shared-initialize :after ((class proxy-class) names
- &rest initargs &key)
- (declare (ignore initargs names))
- (let* ((super (most-specific-proxy-superclass class))
- (actual-size
- (if (eq (class-name super) 'proxy)
- 0
- (proxy-class-instance-size super))))
- (dolist (slotd (class-slots class))
- (when (eq (slot-definition-allocation slotd) :alien)
- (with-slots (offset type) slotd
- (setq actual-size (max actual-size (+ offset (size-of type)))))))
- (cond
- ((not (slot-boundp class 'size))
- (setf (slot-value class 'size) actual-size))
- ((> actual-size (slot-value class 'size))
- (warn "The actual size of class ~A is lager than specified" class)))))
+ (cond
+ (size (setf (slot-value class 'size) (first size)))
+ ((slot-boundp class 'size) (slot-makunbound class 'size)))
+ (cond
+ (copy (setf (slot-value class 'copy) (first copy)))
+ ((slot-boundp class 'copy) (slot-makunbound class 'copy)))
+ (cond
+ (free (setf (slot-value class 'free) (first free)))
+ ((slot-boundp class 'free) (slot-makunbound class 'free))))