- `(,(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))
+ `(,(sap-ref-fname element-type) c-array (* i ,element-size))
+ weak-ref)))
+ ,(unless weak-ref
+ '(deallocate-memory c-vector))
+ vector))))
+
+
+(deftype-method cleanup-alien vector (type-spec c-vector &optional weak-ref)
+ (when weak-ref
+ (unreference-alien type-spec c-vector)))
+
+(deftype-method unreference-alien vector (type-spec c-vector)
+ (destructuring-bind (element-type &optional (length '*))
+ (cdr (type-expand-to 'vector type-spec))
+ `(let ((c-vector ,c-vector))
+ (unless (null-pointer-p c-vector)
+ ,(unless (atomic-type-p element-type)
+ (let ((element-size (size-of element-type)))
+ (if (not (eq length '*))
+ `(dotimes (i ,length)
+ (unreference-alien
+ element-type (sap-ref-sap c-vector (* i ,element-size))))
+ `(do ((offset 0 (+ offset ,element-size))
+ ((sap=
+ (sap-ref-sap c-vector offset)
+ *magic-end-of-array*)))
+ ,(unreference-alien
+ element-type '(sap-ref-sap c-vector offset))))))
+ (deallocate-memory c-vector)))))
+
+
+(defun map-c-array (seqtype function location element-type length)
+ (let ((reader (intern-reader-function element-type))
+ (size (size-of element-type)))
+ (case seqtype
+ ((nil)
+ (dotimes (i length)
+ (funcall function (funcall reader location (* i size)))))
+ (list
+ (let ((list nil))
+ (dotimes (i length)
+ (push (funcall function (funcall reader location (* i size))) list))
+ (nreverse list)))
+ (t
+ (let ((sequence (make-sequence seqtype length)))
+ (dotimes (i length)
+ (setf
+ (elt sequence i)
+ (funcall function (funcall reader location (* i size)))))
+ sequence)))))
+
\ No newline at end of file