-(deftype-method translate-to-alien vector (type-spec vector &optional copy)
- (declare (ignore copy))
- (destructuring-bind (element-type &optional (length '*))
- (cdr (type-expand-to 'vector type-spec))
- (let ((element-size (size-of element-type)))
- `(let ((vector ,vector))
- (let ((c-vector
- (allocate-memory
- ,(if (eq length '*)
- `(* ,element-size (length vector))
- (* element-size length)))))
- (dotimes (i ,(if (eq length '*) '(length vector) length) c-vector)
- (setf
- (,(sap-ref-fname element-type) c-vector (* i ,element-size))
- ,(translate-to-alien element-type '(aref vector i) :copy))))))))
-
-(deftype-method translate-from-alien
- vector (type-spec sap &optional (alloc :reference))
- (destructuring-bind (element-type &optional (length '*))
- (cdr (type-expand-to 'vector type-spec))
- (when (eq length '*)
- (error "Can't use vectors of variable length as return type"))
- (let ((element-size (size-of element-type)))
- `(let ((sap ,sap)
- (vector (make-array ,length :element-type ',element-type)))
- (dotimes (i ,length vector)
- (setf
- (aref vector i)
- ,(translate-to-alien
- element-type
- `(,(sap-ref-fname element-type) sap (* i ,element-size))
- alloc)))))))
-
-
-(deftype-method cleanup-alien vector (type-spec sap &optional copied)
- (declare (ignore type-spec copied))
- ;; The individual elements also have to be cleaned up to avoid memory leaks,
- ;; but this is currently not possible because we can't always tell the
- ;; length of the vector
- `(deallocate-memory ,sap))
+(defmethod to-alien-form (vector (type (eql 'vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type &optional (length '*)) args
+ (if (eq length '*)
+ `(let* ((vector ,vector)
+ (location (sap+
+ (allocate-memory (+ ,+size-of-int+
+ (* ,(size-of element-type)
+ (length vector))))
+ ,+size-of-int+)))
+ (make-c-vector ',element-type (length vector) vector location)
+ (setf (sap-ref-32 location ,(- +size-of-int+)) (length vector))
+ location)
+ `(make-c-vector ',element-type ,length ,vector))))
+
+(defmethod from-alien-form (location (type (eql 'vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type &optional (length '*)) args
+ (if (eq length '*)
+ (error "Can't use vector of variable size as return type")
+ `(map-c-vector 'vector #'identity ',element-type ',length ,location))))
+
+(defmethod cleanup-form (location (type (eql 'vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type &optional (length '*)) args
+ `(let* ((location ,location)
+ (length ,(if (eq length '*)
+ `(sap-ref-32 location ,(- +size-of-int+))
+ length)))
+ (loop
+ with destroy = (destroy-function ',element-type)
+ for i from 0 below length
+ as offset = 0 then (+ offset ,(size-of element-type))
+ do (funcall destroy location offset))
+ (deallocate-memory ,(if (eq length '*)
+ `(sap+ location ,(- +size-of-int+))
+ 'location)))))