+
+
+;;; Counted vector
+
+(defun make-counted-vector (type content)
+ (let* ((size-of-type (size-of type))
+ (length (length content))
+ (location
+ (allocate-memory (+ +size-of-int+ (* size-of-type length)))))
+ (setf (sap-ref-32 location 0) length)
+ (make-c-vector type length content (sap+ location +size-of-int+))))
+
+(defun map-counted-vector (seqtype function location element-type)
+ (let ((length (sap-ref-32 location 0)))
+ (map-c-vector
+ seqtype function (sap+ location +size-of-int+)
+ element-type length)))
+
+(defun destroy-counted-vector (location element-type)
+ (loop
+ with destroy = (destroy-function element-type)
+ with element-size = (size-of element-type)
+ for i from 0 below (sap-ref-32 location 0)
+ as offset = +size-of-int+ then (+ offset element-size)
+ do (funcall destroy location offset))
+ (deallocate-memory location))
+
+
+(deftype counted-vector (element-type) `(vector ,element-type))
+
+(defmethod alien-type ((type (eql 'counted-vector)) &rest args)
+ (declare (ignore type args))
+ (alien-type 'pointer))
+
+(defmethod size-of ((type (eql 'counted-vector)) &rest args)
+ (declare (ignore type args))
+ (size-of 'pointer))
+
+(defmethod to-alien-form (vector (type (eql 'counted-vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type) args
+ `(make-counted-vector ',element-type ,vector)))
+
+(defmethod from-alien-form (c-vector (type (eql 'counted-vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type) args
+ `(let ((c-vector ,c-vector))
+ (prog1
+ (map-counted-vector 'vector #'identity c-vector ',element-type)
+ (destroy-counted-vector c-vector ',element-type)))))
+
+(defmethod copy-from-alien-form (c-vector (type (eql 'counted-vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type) args
+ `(map-counted-vector 'vector #'identity ,c-vector ',element-type)))
+
+(defmethod copy-from-alien-function ((type (eql 'counted-vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type) args
+ #'(lambda (c-vector)
+ (map-counted-vector 'vector #'identity c-vector element-type))))
+
+(defmethod cleanup-form (location (type (eql 'counted-vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type) args
+ `(destroy-counted-vector ,location ',element-type)))
+
+(defmethod writer-function ((type (eql 'counted-vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type) args
+ #'(lambda (vector location &optional (offset 0))
+ (setf
+ (sap-ref-sap location offset)
+ (make-counted-vector element-type vector)))))
+
+(defmethod reader-function ((type (eql 'counted-vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type) args
+ #'(lambda (location &optional (offset 0))
+ (unless (null-pointer-p (sap-ref-sap location offset))
+ (map-counted-vector 'vector #'identity
+ (sap-ref-sap location offset) element-type)))))
+
+(defmethod destroy-function ((type (eql 'counted-vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type) args
+ #'(lambda (location &optional (offset 0))
+ (unless (null-pointer-p (sap-ref-sap location offset))
+ (destroy-counted-vector
+ (sap-ref-sap location offset) element-type)
+ (setf (sap-ref-sap location offset) (make-pointer 0))))))