Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge branch 'master' into threads

  • Loading branch information...
commit d16d7b468f654322e69d872a0fd0931af787d9b5 2 parents 7444d3c + 80137e7
@stassats authored
Showing with 46 additions and 12 deletions.
  1. +12 −4 benchmarks.lisp
  2. +34 −8 disk.lisp
View
16 benchmarks.lisp
@@ -13,12 +13,20 @@
(loop repeat amount
do (write-object object stream)))))
-(defun load-test ()
+(defun gc ()
#+sbcl (sb-ext:gc :full t)
+ #+ccl (progn (ccl:set-lisp-heap-gc-threshold (* 1024 1024 64))
+ (ccl:gc)))
+
+(defmacro time-with-gc (&body body)
+ `(progn (gc)
+ (time (progn ,@body))))
+
+(defun load-test ()
(with-io-file (stream *test-file*)
- (time
- (loop repeat (read-next-object stream)
- do (read-next-object stream)))))
+ (time-with-gc
+ (loop repeat (read-next-object stream)
+ do (read-next-object stream)))))
(defgeneric create-test-object (type &key &allow-other-keys))
View
42 disk.lisp
@@ -9,7 +9,8 @@
string null symbol
storable-class
standard-object
- fixnum bignum ratio)))
+ fixnum bignum ratio
+ list-of-objects)))
(declaim (type simple-vector *codes*))
@@ -304,22 +305,47 @@
(defmethod object-size ((list cons))
(let ((count (+ 1 1))) ;; type + +end+
- (mapc (lambda (x)
- (incf count (object-size x)))
- list)
+ (cond ((list-of-objects-p list)
+ (incf count (+ (* (length list)
+ +id-length+)
+ (1- +sequence-length+)))) ;; sans +end+
+ (t
+ (mapc (lambda (x)
+ (incf count (object-size x)))
+ list)))
count))
(defmethod write-object ((list cons) stream)
- (write-n-bytes #.(type-code 'cons) 1 stream)
- (dolist (item list)
- (write-object item stream))
- (write-n-bytes +end+ 1 stream))
+ (cond ((list-of-objects-p list)
+ (write-list-of-objects list stream))
+ (t
+ (write-n-bytes #.(type-code 'cons) 1 stream)
+ (dolist (item list)
+ (write-object item stream))
+ (write-n-bytes +end+ 1 stream))))
(defreader cons (stream)
(loop for code = (read-n-bytes 1 stream)
until (= code +end+)
collect (call-reader code stream)))
+;;; list-of-objects
+
+(defun list-of-objects-p (list)
+ (loop for i in list
+ always (typep i 'standard-object)))
+
+(defun write-list-of-objects (list stream)
+ (write-n-bytes #.(type-code 'list-of-objects) 1 stream)
+ (write-n-bytes (length list) +sequence-length+ stream)
+ (dolist (object list)
+ (write-n-bytes (id object) +id-length+ stream)))
+
+(defreader list-of-objects (stream)
+ (loop repeat (read-n-bytes +sequence-length+ stream)
+ for id = (read-n-bytes +id-length+ stream)
+ collect (get-instance id)))
+
;;; storable-class
(defmethod object-size ((class storable-class))
Please sign in to comment.
Something went wrong with that request. Please try again.