+
+(defmacro def-cached-vector (name element-type)
+ (let ((get-name (concat-symbol "get-" name "-vector"))
+ (release-name (concat-symbol "release-" name "-vector"))
+ (table-name (concat-symbol "*cached-" name "-table*"))
+ (lock-name (concat-symbol "*cached-" name "-lock*")))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar ,table-name (make-hash-table :test 'equal))
+ (defvar ,lock-name (kmrcl::make-lock ,name))
+
+ (defun ,get-name (size)
+ (kmrcl::with-lock-held (,lock-name)
+ (let ((buffers (gethash (cons size ,element-type) ,table-name)))
+ (if buffers
+ (let ((buffer (pop buffers)))
+ (setf (gethash (cons size ,element-type) ,table-name) buffers)
+ buffer)
+ (make-array size :element-type ,element-type)))))
+
+ (defun ,release-name (buffer)
+ (kmrcl::with-lock-held (,lock-name)
+ (let ((buffers (gethash (cons (array-total-size buffer)
+ ,element-type)
+ ,table-name)))
+ (setf (gethash (cons (array-total-size buffer)
+ ,element-type) ,table-name)
+ (cons buffer buffers))))))))
+
+(defmacro def-cached-instance (name)
+ (let* ((new-name (concat-symbol "new-" name "-instance"))
+ (release-name (concat-symbol "release-" name "-instance"))
+ (cache-name (concat-symbol "*cached-" name "-instance-table*"))
+ (lock-name (concat-symbol "*cached-" name "-instance-lock*")))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar ,cache-name nil)
+ (defvar ,lock-name (kmrcl::make-lock ',name))
+
+ (defun ,new-name ()
+ (kmrcl::with-lock-held (,lock-name)
+ (if ,cache-name
+ (pop ,cache-name)
+ (make-instance ',name))))
+
+ (defun ,release-name (instance)
+ (kmrcl::with-lock-held (,lock-name)
+ (push instance ,cache-name))))))