Author: hhubner Date: Fri Feb 15 08:41:20 2008 New Revision: 2503 Modified: branches/trunk-reorg/bknr/datastore/src/data/object.lisp Log: Rename and document some things. Modified: branches/trunk-reorg/bknr/datastore/src/data/object.lisp ============================================================================== --- branches/trunk-reorg/bknr/datastore/src/data/object.lisp (original) +++ branches/trunk-reorg/bknr/datastore/src/data/object.lisp Fri Feb 15 08:41:20 2008 @@ -5,8 +5,9 @@ (cl-interpol:enable-interpol-syntax) (defclass store-object-subsystem () - ((id-counter :initform 0 - :accessor id-counter))) + ((next-object-id :initform 0 + :accessor next-object-id + :documentation "Next object ID to assign to a new object"))) (defun store-object-subsystem () (let ((subsystem (find-if (lambda (subsystem) @@ -163,17 +164,16 @@ (anonymous-transaction-transactions *current-transaction*))) (call-next-method))) -(defmethod initialize-instance :after - ((object store-object) &key id &allow-other-keys) +(defmethod initialize-instance :after ((object store-object) &key id &allow-other-keys) (let ((subsystem (store-object-subsystem))) (cond (id ;; during restore, use the given ID - (when (>= id (id-counter subsystem)) - (setf (id-counter subsystem) (1+ id)))) + (when (>= id (next-object-id subsystem)) + (setf (next-object-id subsystem) (1+ id)))) (t ;; normal transaction: assign a new ID - (setf id (id-counter subsystem)) - (incf (id-counter subsystem)) + (setf id (next-object-id subsystem)) + (incf (next-object-id subsystem)) (setf (slot-value object 'id) id))))) (defmethod print-object ((object store-object) stream) @@ -476,9 +476,9 @@ id slot-name (type-of container) (store-object-id container)) (warn "Reference to inexistent object with id ~A from unnamed container, returning NIL." id)) - ;; noch die ID hochzaehlen wenn notwendig - (when (>= id (id-counter (store-object-subsystem))) - (setf (id-counter (store-object-subsystem)) (1+ id))) + ;; Possibly determine new "current object id" + (when (>= id (next-object-id (store-object-subsystem))) + (setf (next-object-id (store-object-subsystem)) (1+ id))) nil) (t (error "Reference to inexistent object with id ~A from slot ~A of object ~A with ID ~A." id slot-name (type-of container) @@ -512,7 +512,7 @@ ;;; check on first instatiation of a class? (dolist (class-name (cons 'store-object (all-store-classes))) (clear-class-indices (find-class class-name))) - (setf (id-counter subsystem) 0) + (setf (next-object-id subsystem) 0) (when (probe-file snapshot) (format *trace-output* "loading snapshot file ~A~%" snapshot) (with-open-file (s snapshot @@ -586,7 +586,7 @@ (execute (make-instance 'transaction :function-symbol 'tx-make-object :args (append (list class-name - :id (id-counter (store-object-subsystem))) + :id (next-object-id (store-object-subsystem))) initargs)))) (defun tx-delete-object (id)