Hi,
In a heuristic algorithm I use, I need to create arrays of PATH-SPEC
elements of size 7000x7000, which obviously consumes so much memory.
Therefore, first, I tried to issue (sb-ext:gc :full t) calls after
every iteration. While this reduced exhaustive memory usage, caused
program to spent %80 of its execution time in garbage collecting. And
the regreting thing is, this array should only be created once and
reseted while initiating every iteration. Thus, I thought I should
implement an object cache for PATH-SPECs and cache also the related
array, then reset their values after every iteration. Below is the
PATH-SPEC factory I came up with.
[http://paste.lisp.org/display/58191]
(defstruct path-spec
"Struct to store information about paths."
(length 0)
(nodes nil)
(table nil))
(let (storage-array free-slots used-slots extension-size)
(defun initialize-path-spec-store-range (start offset)
"Initializes STORAGE-ARRAY elements between given range."
(loop for index from start below (+ start offset)
do (progn
(setf (aref storage-array index)
(make-path-spec :table (make-hash-table)))
;; Fill EMPTY-SLOTS
list.
(push index free-slots))))
(defun initialize-path-spec-store (size &optional (extension 10))
"Initializes PATH-SPEC store."
;; Initialize
array.
(setf storage-array (make-array size
:element-type 'path-spec
:initial-element (make-path-spec)
:adjustable t
:fill-pointer 0)
extension-size extension)
;; Initialize array-
elements.
(initialize-path-spec-store-range 0 size))
(defun allocate-path-spec (&key (length 0) nodes table-keys)
"Allocate a fresh PATH-SPEC from store."
(assert (arrayp storage-array))
(when (null free-slots)
(assert (numberp extension-size))
;; No more free slots left. Expand the
store.
(let ((current-size (length storage-array)))
(adjust-array storage-array
(+ extension-size current-size)
:fill-pointer current-size)
;; Initialize
extension.
(initialize-path-spec-store-range current-size extension-
size)))
;; Return next available
slot.
(let* ((free-slot (pop free-slots))
(path-spec (aref storage-array free-slot)))
(push free-slot used-slots)
;; Configure LENGTH, NODES and TABLE-
KEYS.
(when length (setf (path-spec-length path-spec) length))
(when nodes (setf (path-spec-nodes path-spec) nodes))
(loop with table = (path-spec-table path-spec)
for key in table-keys
do (setf (gethash key table) t))
path-spec))
(defun reset-path-spec (path-spec)
"Resets supplied PATH-SPEC."
(setf (path-spec-length path-spec) 0
(path-spec-nodes path-spec) nil)
(clrhash (path-spec-table path-spec))
path-spec)
(defun free-path-spec (path-spec)
"Re-places given PATH-SPEC, if missing any."
(unless (null used-slots)
(let ((used-slot (pop used-slots)))
(setf (aref storage-array used-slot) path-spec)
(push used-slot free-slots))))
(defun reset-path-spec-store ()
"Resets whole PATH-SPEC store."
;; Empty USED/FREE-
SLOTS.
(setq used-slots nil
free-slots nil)
;; Reset stored PATH-SPECs and fill FREE-
SLOTS.
(loop with size = (length storage-array)
for index below size
do (progn
(reset-path-spec (aref storage-array index))
(push (- size index 1) free-slots)))
;; Re-Place fill
pointer.
(setf (fill-pointer storage-array) 0)))
I'm not very experienced in how object pointers are handled in Common
Lisp. I don't want to garbage collect PATH-SPECs stored in the USED-
SLOTS, but to have them re-cycled. Could anybody mind checking whether
FREE-PATH-SPEC in the above implementation will work as expected or
not?
Regards.