Loading benchmarks.lisp +12 −0 Original line number Diff line number Diff line Loading @@ -28,11 +28,23 @@ (loop repeat (read-next-object stream) do (read-next-object stream))))) (defun identity-test (x &optional (mode :both)) (when (member mode '(:both :write)) (with-io-file (stream *test-file* :direction :output :size (object-size x)) (write-object x stream))) (when (member mode '(:both :read)) (with-io-file (stream *test-file*) (read-next-object stream)))) (defgeneric create-test-object (type &key &allow-other-keys)) (defmethod create-test-object ((type (eql 'cons)) &key object-size) (make-list (or object-size 10000) :initial-element nil)) (defmethod create-test-object ((type (eql 'fixnum)) &key) -1) (defun class-preallocation-test (storage) (loop for class in (storage-data storage) for length = (length (objects-of-class class)) Loading disk.lisp +4 −6 Original line number Diff line number Diff line Loading @@ -166,10 +166,10 @@ (defmethod object-size ((object integer)) (+ 1 ;; tag 1 ;; sign (typecase object (storage-fixnum +fixnum-length+) (t (+ 1 ;; size (t (+ 1 ;; sign 1 ;; size (* (ceiling (integer-length (abs object)) (* +fixnum-length+ 8)) +fixnum-length+)))))) Loading @@ -183,8 +183,7 @@ (defun write-fixnum (n stream) (declare (storage-fixnum n)) (write-n-bytes #.(type-code 'fixnum) 1 stream) (write-n-bytes (sign n) 1 stream) (write-n-bytes (abs n) +fixnum-length+ stream)) (write-n-signed-bytes n +fixnum-length+ stream)) (defun write-bignum (n stream) (declare ((and integer (not storage-fixnum)) n)) Loading Loading @@ -223,8 +222,7 @@ (* sign integer))) (defreader fixnum (stream) (* (read-sign stream) (read-n-bytes +fixnum-length+ stream))) (read-n-signed-bytes +fixnum-length+ stream)) ;;; Ratio Loading io-generic.lisp +13 −4 Original line number Diff line number Diff line Loading @@ -14,13 +14,18 @@ (t form))) (declaim (inline read-n-bytes)) (defun read-n-bytes (bytes stream) (ecase bytes (defun read-n-bytes (n stream) (ecase n (1 (read-byte stream)) (2 (read-2-bytes stream)) (3 (read-3-bytes stream)) (4 (read-4-bytes stream)))) (declaim (inline read-n-signed-bytes)) (defun read-n-signed-bytes (n stream) (let ((byte (read-n-bytes n stream))) (logior byte (- (logand byte (ash 1 (1- (* n 8)))))))) (declaim (inline read-2-bytes read-3-bytes read-4-bytes)) (defun read-2-bytes (stream) (declare (optimize speed)) Loading @@ -44,10 +49,14 @@ (logior (ash 4-byte 24) (ash 3-byte 16) (ash 2-byte 8) 1-byte))) (declaim (inline write-n-bytes)) (defun write-n-bytes (integer bytes stream) (loop for low-bit to (* 8 (1- bytes)) by 8 (defun write-n-bytes (integer n stream) (loop for low-bit to (* 8 (1- n)) by 8 do (write-byte (ldb (byte 8 low-bit) integer) stream))) (declaim (inline write-n-signed-bytes)) (defun write-n-signed-bytes (integer n stream) (write-n-bytes (ldb (byte (* n 8) 0) integer) n stream)) (defmacro with-io-file ((stream file &key (direction :input) size) &body body) (declare (ignore size)) `(with-open-file (,stream ,file Loading io-sbcl.lisp +27 −0 Original line number Diff line number Diff line Loading @@ -84,6 +84,19 @@ (advance-stream n stream) 0)) (declaim (inline read-n-signed-bytes)) (defun read-n-signed-bytes (n stream) (declare (optimize speed) (sb-ext:muffle-conditions sb-ext:compiler-note) (type (integer 1 4) n)) (funcall (ecase n (1 #'sb-sys:signed-sap-ref-8) (2 #'sb-sys:signed-sap-ref-16) ;; (3 ) (4 #'sb-sys:signed-sap-ref-32)) (advance-stream n stream) 0)) (declaim (inline write-n-bytes)) (defun write-n-bytes (value n stream) (declare (optimize speed) Loading @@ -91,6 +104,20 @@ (setf (sb-sys:sap-ref-32 (advance-stream n stream) 0) value) t) (declaim (inline write-n-signed-bytes)) (defun write-n-signed-bytes (value n stream) (declare (optimize speed) (fixnum n)) (ecase n (1 (setf (sb-sys:signed-sap-ref-8 (advance-stream n stream) 0) value)) (2 (setf (sb-sys:signed-sap-ref-16 (advance-stream n stream) 0) value)) ;; (3 ) (4 (setf (sb-sys:signed-sap-ref-32 (advance-stream n stream) 0) value))) t) (declaim (inline copy-mem)) (defun copy-mem (from to length) (loop for i below length by sb-vm:n-word-bytes Loading Loading
benchmarks.lisp +12 −0 Original line number Diff line number Diff line Loading @@ -28,11 +28,23 @@ (loop repeat (read-next-object stream) do (read-next-object stream))))) (defun identity-test (x &optional (mode :both)) (when (member mode '(:both :write)) (with-io-file (stream *test-file* :direction :output :size (object-size x)) (write-object x stream))) (when (member mode '(:both :read)) (with-io-file (stream *test-file*) (read-next-object stream)))) (defgeneric create-test-object (type &key &allow-other-keys)) (defmethod create-test-object ((type (eql 'cons)) &key object-size) (make-list (or object-size 10000) :initial-element nil)) (defmethod create-test-object ((type (eql 'fixnum)) &key) -1) (defun class-preallocation-test (storage) (loop for class in (storage-data storage) for length = (length (objects-of-class class)) Loading
disk.lisp +4 −6 Original line number Diff line number Diff line Loading @@ -166,10 +166,10 @@ (defmethod object-size ((object integer)) (+ 1 ;; tag 1 ;; sign (typecase object (storage-fixnum +fixnum-length+) (t (+ 1 ;; size (t (+ 1 ;; sign 1 ;; size (* (ceiling (integer-length (abs object)) (* +fixnum-length+ 8)) +fixnum-length+)))))) Loading @@ -183,8 +183,7 @@ (defun write-fixnum (n stream) (declare (storage-fixnum n)) (write-n-bytes #.(type-code 'fixnum) 1 stream) (write-n-bytes (sign n) 1 stream) (write-n-bytes (abs n) +fixnum-length+ stream)) (write-n-signed-bytes n +fixnum-length+ stream)) (defun write-bignum (n stream) (declare ((and integer (not storage-fixnum)) n)) Loading Loading @@ -223,8 +222,7 @@ (* sign integer))) (defreader fixnum (stream) (* (read-sign stream) (read-n-bytes +fixnum-length+ stream))) (read-n-signed-bytes +fixnum-length+ stream)) ;;; Ratio Loading
io-generic.lisp +13 −4 Original line number Diff line number Diff line Loading @@ -14,13 +14,18 @@ (t form))) (declaim (inline read-n-bytes)) (defun read-n-bytes (bytes stream) (ecase bytes (defun read-n-bytes (n stream) (ecase n (1 (read-byte stream)) (2 (read-2-bytes stream)) (3 (read-3-bytes stream)) (4 (read-4-bytes stream)))) (declaim (inline read-n-signed-bytes)) (defun read-n-signed-bytes (n stream) (let ((byte (read-n-bytes n stream))) (logior byte (- (logand byte (ash 1 (1- (* n 8)))))))) (declaim (inline read-2-bytes read-3-bytes read-4-bytes)) (defun read-2-bytes (stream) (declare (optimize speed)) Loading @@ -44,10 +49,14 @@ (logior (ash 4-byte 24) (ash 3-byte 16) (ash 2-byte 8) 1-byte))) (declaim (inline write-n-bytes)) (defun write-n-bytes (integer bytes stream) (loop for low-bit to (* 8 (1- bytes)) by 8 (defun write-n-bytes (integer n stream) (loop for low-bit to (* 8 (1- n)) by 8 do (write-byte (ldb (byte 8 low-bit) integer) stream))) (declaim (inline write-n-signed-bytes)) (defun write-n-signed-bytes (integer n stream) (write-n-bytes (ldb (byte (* n 8) 0) integer) n stream)) (defmacro with-io-file ((stream file &key (direction :input) size) &body body) (declare (ignore size)) `(with-open-file (,stream ,file Loading
io-sbcl.lisp +27 −0 Original line number Diff line number Diff line Loading @@ -84,6 +84,19 @@ (advance-stream n stream) 0)) (declaim (inline read-n-signed-bytes)) (defun read-n-signed-bytes (n stream) (declare (optimize speed) (sb-ext:muffle-conditions sb-ext:compiler-note) (type (integer 1 4) n)) (funcall (ecase n (1 #'sb-sys:signed-sap-ref-8) (2 #'sb-sys:signed-sap-ref-16) ;; (3 ) (4 #'sb-sys:signed-sap-ref-32)) (advance-stream n stream) 0)) (declaim (inline write-n-bytes)) (defun write-n-bytes (value n stream) (declare (optimize speed) Loading @@ -91,6 +104,20 @@ (setf (sb-sys:sap-ref-32 (advance-stream n stream) 0) value) t) (declaim (inline write-n-signed-bytes)) (defun write-n-signed-bytes (value n stream) (declare (optimize speed) (fixnum n)) (ecase n (1 (setf (sb-sys:signed-sap-ref-8 (advance-stream n stream) 0) value)) (2 (setf (sb-sys:signed-sap-ref-16 (advance-stream n stream) 0) value)) ;; (3 ) (4 (setf (sb-sys:signed-sap-ref-32 (advance-stream n stream) 0) value))) t) (declaim (inline copy-mem)) (defun copy-mem (from to length) (loop for i below length by sb-vm:n-word-bytes Loading