Loading src/elephant/collections.lisp +23 −21 Original line number Diff line number Diff line Loading @@ -61,7 +61,7 @@ (defmethod drop-instance ((bt btree)) "The standard method for reclaiming storage of persistent objects" (ensure-transaction (:store-controller *store-controller*) (ensure-transaction (:store-controller (get-con bt)) (drop-btree bt) (call-next-method))) Loading Loading @@ -118,13 +118,6 @@ existing primary entries (may be expensive!)")) (ifret (get-index ibt idxname) (add-index ibt :index-name idxname :key-form key-form :populate populate))) (defmethod drop-btree ((bt indexed-btree)) (map-indices (lambda (name index) (declare (ignore index)) (remove-index bt name)) bt) (call-next-method)) ;; ;; Secondary Indices ;; Loading @@ -140,11 +133,6 @@ existing primary entries (may be expensive!)")) (:metaclass persistent-metaclass) (:documentation "Secondary index to an indexed-btree.")) (defmethod drop-btree ((index btree-index)) "Btree indices don't need to have values removed, this happens on the primary when remove-kv is called" nil) (define-condition invalid-keyform (error) ((key-form :reader key-form-of :initarg :key-form)) (:report (lambda (c s) Loading Loading @@ -427,14 +415,6 @@ not), evaluates the forms, then closes the cursor." (progn ,@body) (cursor-close ,var)))) (defmethod drop-btree ((bt btree)) (ensure-transaction (:store-controller *store-controller*) (with-btree-cursor (cur bt) (loop for (exists? key) = (multiple-value-list (cursor-first cur)) then (multiple-value-list (cursor-next cur)) while exists? do (remove-kv key bt))))) (defmethod remove-kv-pair (key value (dbt dup-btree)) "Too bad there isn't a direct way to do this, but with ordered duplicates this should be reasonably efficient" Loading @@ -447,6 +427,27 @@ not), evaluates the forms, then closes the cursor." (when exists? (cursor-delete cur))))))) (defmethod drop-btree ((bt btree)) (ensure-transaction (:store-controller (get-con bt)) (with-btree-cursor (cur bt) (loop for (exists? key) = (multiple-value-list (cursor-first cur)) then (multiple-value-list (cursor-next cur)) while exists? do (remove-kv key bt))))) (defmethod drop-btree ((bt indexed-btree)) (with-transaction (:store-controller (get-con bt)) (map-indices (lambda (name index) (declare (ignore index)) (remove-index bt name)) bt) (call-next-method))) (defmethod drop-btree ((index btree-index)) "Btree indices don't need to have values removed, this happens on the primary when remove-kv is called" nil) ;; ======================================= ;; Generic Mapping Functions ;; ======================================= Loading Loading @@ -700,6 +701,7 @@ not), evaluates the forms, then closes the cursor." (defmethod map-index (fn (index btree-index) &rest args &key start end (value nil value-set-p) from-end collect &allow-other-keys) (declare (ignore args)) (validate-map-call start end) (cond (value-set-p (map-index-values fn index value collect)) (from-end (map-index-from-end fn index start end collect)) Loading src/elephant/gc.lisp +31 −31 Original line number Diff line number Diff line Loading @@ -55,23 +55,15 @@ (setf *mark-table* (make-btree sc)) (setf *max-oid* (oid *mark-table*)) ;; Clean up stale memory references #+sbcl (sb-ext:gc :full t) #-sbcl (cl-user::gc)) ;; Core of GC (mark-all sc) (sweep-all sc test) (sweep-all-classes sc test) ;; Drop mark table rather than reset? (unless test (drop-instance *mark-table*) (setf *mark-table* nil)) (setf *mark-table* nil)))) ;; Final GC to clean up stale mem refs to collections ;; were reclaimed #+sbcl (sb-ext:gc) #-sbcl (cl-user::gc)) ;; MARK Loading @@ -89,17 +81,23 @@ ;; SWEEP (defun sweep-all (sc &optional test (chunk-size 100)) (declare (ignore chunk-size)) (defun sweep-all-classes (sc &optional test (step 5)) "For each unindexed class, sweep all instances that are not on the mark list. One txn per class for now" (dolist (class (unindexed-classes sc)) (let ((cid (class-schema-id sc class))) (map-index (lambda (k v pk) (declare (ignore k v)) (if test (sweep-debug sc pk) (sweep-instance sc pk))) (controller-instance-class-index sc) :value cid)))) (sweep-class sc cid step test)))) (defun sweep-class (sc cid step &optional test) "Sweep over the class and reclaim instances" (declare (ignore step)) (map-index (lambda (k v pk) (declare (ignore k v)) (if test (sweep-debug sc pk) (sweep-instance sc pk))) (controller-instance-class-index sc) :value cid)) (defun sweep-instance (sc oid) (unless (get-value oid *mark-table*) Loading Loading @@ -144,7 +142,7 @@ (walk-heap v)) obj)) (defmethod walk-btree ((obj indexed-btree)) (defmethod walk-heap ((obj indexed-btree)) "Key values of indices can be persistent objects" (map-indices (lambda (name index) (declare (ignore name)) Loading Loading @@ -222,22 +220,24 @@ collect (find-class (default-class-id-type i sc)))) ;; Garbage collection thread ;; ;; Pre-packaged garbage collection thread ;; (defvar gc-step-size 100 "Number of OIDs to mark per invocation") ;; (defvar gc-step-size 100 ;; "Number of OIDs to mark per invocation") (defvar gc-step-interval 500 "Number of ms to wait between chunk executions") ;; (defvar gc-step-interval 500 ;; "Number of ms to wait between chunk executions") (defvar gc-oid-interval 1000 "Number of OIDs to allocate ") ;; (defvar gc-oid-interval 1000 ;; "Number of OIDs to allocate ") (defvar gc-pass-check-interval 10000 "Number of ms to wait between checking for a new pass") ;; (defvar gc-pass-check-interval 10000 ;; "Number of ms to wait between checking for a new pass") (defvar gc-drop-undefined-classes nil "Drop all instances of classes that do not exist in the image") ;; (defvar gc-drop-undefined-classes nil ;; "Drop all instances of classes that do not exist in the image") ;;(defun gc-loop () ;; (loop Loading src/elephant/metaclasses.lisp +2 −2 Original line number Diff line number Diff line Loading @@ -74,10 +74,10 @@ (defmethod class-indexing-enabled-p ((class persistent-metaclass)) (and (not (subtypep (class-name class) 'persistent-collection)) (%class-indexing class) t)) (%class-indexing class))) (defun migrate-class-index-p (class) (%class-indexing class) t) (%class-indexing class)) ;; ;; Top level defclass form - hide metaclass option Loading Loading
src/elephant/collections.lisp +23 −21 Original line number Diff line number Diff line Loading @@ -61,7 +61,7 @@ (defmethod drop-instance ((bt btree)) "The standard method for reclaiming storage of persistent objects" (ensure-transaction (:store-controller *store-controller*) (ensure-transaction (:store-controller (get-con bt)) (drop-btree bt) (call-next-method))) Loading Loading @@ -118,13 +118,6 @@ existing primary entries (may be expensive!)")) (ifret (get-index ibt idxname) (add-index ibt :index-name idxname :key-form key-form :populate populate))) (defmethod drop-btree ((bt indexed-btree)) (map-indices (lambda (name index) (declare (ignore index)) (remove-index bt name)) bt) (call-next-method)) ;; ;; Secondary Indices ;; Loading @@ -140,11 +133,6 @@ existing primary entries (may be expensive!)")) (:metaclass persistent-metaclass) (:documentation "Secondary index to an indexed-btree.")) (defmethod drop-btree ((index btree-index)) "Btree indices don't need to have values removed, this happens on the primary when remove-kv is called" nil) (define-condition invalid-keyform (error) ((key-form :reader key-form-of :initarg :key-form)) (:report (lambda (c s) Loading Loading @@ -427,14 +415,6 @@ not), evaluates the forms, then closes the cursor." (progn ,@body) (cursor-close ,var)))) (defmethod drop-btree ((bt btree)) (ensure-transaction (:store-controller *store-controller*) (with-btree-cursor (cur bt) (loop for (exists? key) = (multiple-value-list (cursor-first cur)) then (multiple-value-list (cursor-next cur)) while exists? do (remove-kv key bt))))) (defmethod remove-kv-pair (key value (dbt dup-btree)) "Too bad there isn't a direct way to do this, but with ordered duplicates this should be reasonably efficient" Loading @@ -447,6 +427,27 @@ not), evaluates the forms, then closes the cursor." (when exists? (cursor-delete cur))))))) (defmethod drop-btree ((bt btree)) (ensure-transaction (:store-controller (get-con bt)) (with-btree-cursor (cur bt) (loop for (exists? key) = (multiple-value-list (cursor-first cur)) then (multiple-value-list (cursor-next cur)) while exists? do (remove-kv key bt))))) (defmethod drop-btree ((bt indexed-btree)) (with-transaction (:store-controller (get-con bt)) (map-indices (lambda (name index) (declare (ignore index)) (remove-index bt name)) bt) (call-next-method))) (defmethod drop-btree ((index btree-index)) "Btree indices don't need to have values removed, this happens on the primary when remove-kv is called" nil) ;; ======================================= ;; Generic Mapping Functions ;; ======================================= Loading Loading @@ -700,6 +701,7 @@ not), evaluates the forms, then closes the cursor." (defmethod map-index (fn (index btree-index) &rest args &key start end (value nil value-set-p) from-end collect &allow-other-keys) (declare (ignore args)) (validate-map-call start end) (cond (value-set-p (map-index-values fn index value collect)) (from-end (map-index-from-end fn index start end collect)) Loading
src/elephant/gc.lisp +31 −31 Original line number Diff line number Diff line Loading @@ -55,23 +55,15 @@ (setf *mark-table* (make-btree sc)) (setf *max-oid* (oid *mark-table*)) ;; Clean up stale memory references #+sbcl (sb-ext:gc :full t) #-sbcl (cl-user::gc)) ;; Core of GC (mark-all sc) (sweep-all sc test) (sweep-all-classes sc test) ;; Drop mark table rather than reset? (unless test (drop-instance *mark-table*) (setf *mark-table* nil)) (setf *mark-table* nil)))) ;; Final GC to clean up stale mem refs to collections ;; were reclaimed #+sbcl (sb-ext:gc) #-sbcl (cl-user::gc)) ;; MARK Loading @@ -89,17 +81,23 @@ ;; SWEEP (defun sweep-all (sc &optional test (chunk-size 100)) (declare (ignore chunk-size)) (defun sweep-all-classes (sc &optional test (step 5)) "For each unindexed class, sweep all instances that are not on the mark list. One txn per class for now" (dolist (class (unindexed-classes sc)) (let ((cid (class-schema-id sc class))) (map-index (lambda (k v pk) (declare (ignore k v)) (if test (sweep-debug sc pk) (sweep-instance sc pk))) (controller-instance-class-index sc) :value cid)))) (sweep-class sc cid step test)))) (defun sweep-class (sc cid step &optional test) "Sweep over the class and reclaim instances" (declare (ignore step)) (map-index (lambda (k v pk) (declare (ignore k v)) (if test (sweep-debug sc pk) (sweep-instance sc pk))) (controller-instance-class-index sc) :value cid)) (defun sweep-instance (sc oid) (unless (get-value oid *mark-table*) Loading Loading @@ -144,7 +142,7 @@ (walk-heap v)) obj)) (defmethod walk-btree ((obj indexed-btree)) (defmethod walk-heap ((obj indexed-btree)) "Key values of indices can be persistent objects" (map-indices (lambda (name index) (declare (ignore name)) Loading Loading @@ -222,22 +220,24 @@ collect (find-class (default-class-id-type i sc)))) ;; Garbage collection thread ;; ;; Pre-packaged garbage collection thread ;; (defvar gc-step-size 100 "Number of OIDs to mark per invocation") ;; (defvar gc-step-size 100 ;; "Number of OIDs to mark per invocation") (defvar gc-step-interval 500 "Number of ms to wait between chunk executions") ;; (defvar gc-step-interval 500 ;; "Number of ms to wait between chunk executions") (defvar gc-oid-interval 1000 "Number of OIDs to allocate ") ;; (defvar gc-oid-interval 1000 ;; "Number of OIDs to allocate ") (defvar gc-pass-check-interval 10000 "Number of ms to wait between checking for a new pass") ;; (defvar gc-pass-check-interval 10000 ;; "Number of ms to wait between checking for a new pass") (defvar gc-drop-undefined-classes nil "Drop all instances of classes that do not exist in the image") ;; (defvar gc-drop-undefined-classes nil ;; "Drop all instances of classes that do not exist in the image") ;;(defun gc-loop () ;; (loop Loading
src/elephant/metaclasses.lisp +2 −2 Original line number Diff line number Diff line Loading @@ -74,10 +74,10 @@ (defmethod class-indexing-enabled-p ((class persistent-metaclass)) (and (not (subtypep (class-name class) 'persistent-collection)) (%class-indexing class) t)) (%class-indexing class))) (defun migrate-class-index-p (class) (%class-indexing class) t) (%class-indexing class)) ;; ;; Top level defclass form - hide metaclass option Loading