Permalink
Browse files

Optimize class definition storage some more.

  • Loading branch information...
1 parent f1d31f2 commit 5207c384010b47705e735f0842e67f81064be193 @stassats committed Aug 18, 2012
Showing with 16 additions and 15 deletions.
  1. +14 −15 disk.lisp
  2. +2 −0 mop.lisp
View
@@ -129,7 +129,7 @@
+sequence-length+ stream)
(map-all-data
(lambda (class objects)
- (write-object class stream)
+ (write-storable-class class stream)
(write-n-bytes (length objects)
+id-length+ stream))))
@@ -643,8 +643,18 @@
;;; storable-class
-(defmethod write-object ((class storable-class) stream)
- (write-n-bytes #.(type-code 'storable-class) 1 stream)
+(defun prepare-classes (stream)
+ (loop repeat (read-n-bytes +sequence-length+ stream)
+ for class = (read-storable-class stream)
+ for length = (read-n-bytes +id-length+ stream)
+ collect (cons class length) into info
+ sum length into array-length
+ finally
+ (let ((array (make-array array-length)))
+ (preallocate-objects array info)
+ (return (values array info)))))
+
+(defun write-storable-class (class stream)
(write-object (class-name class) stream)
(unless (class-finalized-p class)
(finalize-inheritance class))
@@ -654,7 +664,7 @@
do (write-object (slot-definition-name slot)
stream))))
-(defreader storable-class (stream)
+(defun read-storable-class (stream)
(let ((class (find-class (read-next-object stream))))
(unless (class-finalized-p class)
(finalize-inheritance class))
@@ -784,17 +794,6 @@
(setf (aref array index) instance)
(incf index)))))
-(defun prepare-classes (stream)
- (loop repeat (read-n-bytes +sequence-length+ stream)
- for class = (read-next-object stream)
- for length = (read-n-bytes +id-length+ stream)
- collect (cons class length) into info
- sum length into array-length
- finally
- (let ((array (make-array array-length)))
- (preallocate-objects array info)
- (return (values array info)))))
-
(defun read-file (file)
(with-io-file (stream file)
(multiple-value-bind (array info) (prepare-classes stream)
View
@@ -137,6 +137,8 @@
(ceiling (length slots-to-store) 8))
(setf (slot-locations-and-initforms class)
(make-slots-cache slots-to-store))
+ (setf (slot-locations-and-initforms-read class)
+ (copy-seq (slot-locations-and-initforms class)))
(setf (all-slot-locations-and-initforms class)
(make-slots-cache slots))
(setf (class-initforms class)

0 comments on commit 5207c38

Please sign in to comment.