Use an array for indexing, instead of a hash-table.

disk.lisp

@@ -70,7 +70,7 @@
 (defgeneric object-size (object))
 
 (defun measure-size ()
-  (let ((result 0))
+  (let ((result +id-length+))
     (map-data (lambda (class objects)
                 (incf result (object-size class))
                 (dolist (object objects)
@@ -79,6 +79,7 @@
     result))
 
 (defun dump-data (stream)
+  (write-n-bytes (last-id *storage*) +id-length+ stream)
   (map-data (lambda (class objects)
               (declare (ignore objects))
               (write-object class stream)))
@@ -322,8 +323,11 @@
 ;;; standard-object
 
 (defun standard-object-size (object)
-  (let ((slots (slot-locations-and-initiforms (class-of object))))
+  (let ((storage *storage*)
+        (slots (slot-locations-and-initiforms (class-of object))))
     (declare (simple-vector slots))
+    (setf (id object) (last-id storage))
+    (incf (last-id storage))
     (+ 1           ;; data type
        1           ;; class id
        +id-length+ ;; id
@@ -362,8 +366,8 @@
 
 (defun get-instance (id class)
   (let ((index (indexes *storage*)))
-    (or (gethash id index)
-        (setf (gethash id index)
+    (or (aref index id)
+        (setf (aref index id)
               (let ((new (allocate-instance class)))
                 (initialize-slots new class)
                 (setf (id new) id)
@@ -380,14 +384,16 @@
           do (setf (standard-instance-access instance
                                              (car (aref slots slot-id)))
                    (read-next-object stream)))
-    (setf (last-id *storage*) (max (last-id *storage*) (id instance)))
     (push instance (objects-of-class class))
     instance))
 
 ;;;
 
 (defun read-file (file)
   (with-io-file (stream file)
+    (setf (indexes *storage*)
+          (make-array (read-n-bytes +id-length+ stream)
+                      :initial-element nil))
     (loop until (stream-end-of-file-p stream)
           do (read-next-object stream))))
 
@@ -401,8 +407,9 @@
 
 (defun save-data (storage &optional file)
   (let ((*storage* storage))
-    (when (storage-data *storage*)
-      (with-io-file (stream (or file (storage-file *storage*))
+    (when (storage-data storage)
+      (setf (last-id storage) 0)
+      (with-io-file (stream (or file (storage-file storage))
                             :direction :output
                             :size (measure-size))
         (dump-data stream)))))

mop.lisp

@@ -11,7 +11,7 @@
    (file :initform nil
          :initarg :file
          :accessor storage-file)
-   (indexes :initform (make-hash-table)
+   (indexes :initform nil
             :accessor indexes)
    (last-id :initform -1
             :accessor last-id)))
@@ -21,6 +21,8 @@
                    :accessor slots-to-store)
    (slot-locations-and-initiforms :initform nil
                    :accessor slot-locations-and-initiforms)
+   (all-slot-locations-and-initiforms :initform nil
+                   :accessor all-slot-locations-and-initiforms)
    (class-id :initform 0
              :accessor class-id)
    (objects :initform nil
@@ -32,9 +34,6 @@
                :initarg :search-key
                :accessor search-key)))
 
-(declaim (ftype (function (t) simple-vector)
-                slots-to-store))
-
 (defun initialize-storable-class (next-method class &rest args
                                   &key direct-superclasses &allow-other-keys)
   (apply next-method class
@@ -136,16 +135,20 @@
     effective-definition))
 
 (defmethod compute-slots :around ((class storable-class))
-  (let* ((slots (call-next-method))
-         (slots-to-store (coerce (remove-if-not #'store-slot-p slots)
-                                 'simple-vector) ))
-    (setf (slot-value class 'slots-to-store) slots-to-store
-          (slot-value class 'slot-locations-and-initiforms)
-          (map 'vector (lambda (slot)
-                         (cons (slot-definition-location slot)
-                               (slot-definition-initform slot))) slots-to-store))
-    (compute-search-key class slots)
-    slots))
+  (flet ((location-and-initform (slot)
+           (cons (slot-definition-location slot)
+                 (slot-definition-initform slot))))
+    (let* ((slots (call-next-method))
+           (slots-to-store (coerce (remove-if-not #'store-slot-p slots)
+                                   'simple-vector) ))
+
+      (setf (slot-value class 'slots-to-store) slots-to-store
+            (slot-value class 'slot-locations-and-initiforms)
+            (map 'vector #'location-and-initform slots-to-store)
+            (slot-value class 'all-slot-locations-and-initiforms)
+            (map 'vector #'location-and-initform slots))
+      (compute-search-key class slots)
+      slots)))
 
 (defun find-slot (slot-name class)
   (find slot-name (class-slots class)

storage.lisp

@@ -25,27 +25,10 @@
 (defmethod relation (object type)
   (getf (relations object) type))
 
-(defmethod initialize-instance :after ((object identifiable)
-                                       &key id)
-  (with-slots (last-id) (class-storage (class-of object))
-    (if (integerp id)
-        (setf last-id (max last-id id))
-        (setf (id object) (incf last-id)))))
-
 ;;;
 
 (defvar *storage* nil)
 
-(defun index-object (object)
-  (setf (gethash (id object)
-                 (indexes (class-storage (class-of object))))
-        object))
-
-(defun object-with-id (id)
-  (gethash id (indexes *storage*)))
-
-;;;
-
 (defvar *read-class-cache* #())
 
 (defun grow-read-cache (id)
@@ -123,7 +106,6 @@
 ;;;
 
 (defun clear-cashes ()
-  (clrhash (indexes *storage*))
   (setf *read-class-cache* #()))
 
 ;;; Data manipulations
@@ -136,7 +118,6 @@
 (defmethod add ((object identifiable) &key)
   (store-object object)
   (storage:interlink-objects object)
-  (index-object object)
   object)
 
 (defun where (&rest clauses)