Commit ffada140 authored by Stas Boukarev's avatar Stas Boukarev
Browse files

Use two's complement for storing fixnums.

parent 80137e77
Loading
Loading
Loading
Loading
+12 −0
Original line number Diff line number Diff line
@@ -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))
+4 −6
Original line number Diff line number Diff line
@@ -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+))))))
@@ -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))
@@ -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

+13 −4
Original line number Diff line number Diff line
@@ -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))
@@ -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
+27 −0
Original line number Diff line number Diff line
@@ -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)
@@ -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