Commit e64adb39 authored by rtoy's avatar rtoy
Browse files

Update read/write-vector to output 1, 2, or 4-bit vectors in the 

"correct" order.  This is an issue because big and little-endian
machines store the bits in a different order in each byte.

code/fd-stream.lisp:
o Recognize 1, 2, and 4-bit vectors and choose an appropriate endian
  swap value (-8, -2, -1), respectively.  This has been tested for
  :network-order, which works.  The :big-endian and :little-endian
  cases have not been tested.  The value is arbitrarily selected so
  that the lowest indexed element is written to the most significant
  part of a byte.

code/stream-vector-io.lisp:
o Perform appropriate bit swapping for 1, 2, and 4-bit vectors.

i18n/unidata.bin:
o Generated new version.  This version can be correctly processed on
  sparc, and all of the normalization tests pass.
parent a773a7e3

code/fd-stream.lisp

+41 −7
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@ 
;;; Carnegie Mellon University, and has been placed in the public domain.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.85.4.1.2.12 2009/05/12 16:31:48 rtoy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.85.4.1.2.13 2009/05/28 18:52:35 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -121,8 +121,22 @@ 


(defun endian-swap-value (vector endian-swap)

  (case endian-swap

    (:network-order #+big-endian 0

		    #+little-endian (1- (vector-elt-width vector)))

    (:network-order

     #+big-endian 0

     ;; This is needed because the little-endian (x86) architectures

     ;; store the lowest indexed element in the least significant part

     ;; of a byte.  On a big-endian machine (sparc, ppc), the lowest

     ;; indexed element is at the most significant part of a byte.

     #+little-endian

     (typecase vector

       ((array (unsigned-byte 4) (*))

	-1)

       ((array (unsigned-byte 2) (*))

	-2)

       ((array (unsigned-byte 1) (*))

	-8)

       (t

	(1- (vector-elt-width vector)))))

    (:byte-8 0)

    (:byte-16 1)

    (:byte-32 3)
@@ -130,9 +144,29 @@ 
    (:byte-128 15)

    ;; additions by Lynn Quam

    (:machine-endian 0)

    (:big-endian #+big-endian 0

		 #+little-endian (1- (vector-elt-width vector)))

    (:little-endian #+big-endian (1- (vector-elt-width vector))

    (:big-endian

     #+big-endian 0

     #+little-endian

     (typecase vector

       ((array (unsigned-byte 4) (*))

	-1)

       ((array (unsigned-byte 2) (*))

	-2)

       ((array (unsigned-byte 1) (*))

	-8)

       (t

	(1- (vector-elt-width vector)))))

    (:little-endian

     #+big-endian

     (typecase vector

       ((array (unsigned-byte 4) (*))

	-1)

       ((array (unsigned-byte 2) (*))

	-2)

       ((array (unsigned-byte 1) (*))

	-8)

       (t

	(1- (vector-elt-width vector))))

     #+little-endian 0)

    (otherwise endian-swap)))

code/stream-vector-io.lisp

+33 −3
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@ 
;;; Carnegie Mellon University, and has been placed in the public domain.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream-vector-io.lisp,v 1.3.6.3 2009/05/25 20:08:28 rtoy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream-vector-io.lisp,v 1.3.6.4 2009/05/28 18:52:35 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -52,8 +52,7 @@ 
  (declare (type simple-array vector))

  (declare (fixnum start end endian-swap ))

  (unless (eql endian-swap 0)

    (when (or (>= endian-swap (vector-elt-width vector))

	      (< endian-swap 0))

    (when (>= endian-swap (vector-elt-width vector))

      (error "endian-swap ~a is illegal for element-type of vector ~a"

	     endian-swap vector))

    (lisp::with-array-data ((data vector) (offset-start start)
@@ -79,6 +78,37 @@ 
	  ;; Not sure that swap-endians-456

	  ((4 5 6) (swap-endians-456 data offset-start offset-end

				     endian-swap))

	  (-1

	   ;; Swap nibbles

	   (loop for i fixnum from start below end

		 do

		 (let ((x (bref data i)))

		   (setf (bref data i) (logior (ash (logand x #x0f) 4)

					       (ash (logand x #xf0) -4))))))

	  (-2

	   ;; Swap pairs

	   (loop for i fixnum from start below end

		 do

		 (let ((x (bref data i)))

		   (declare (type (unsigned-byte 8) x))

		   (setf x (logior (ash (logand x #x33) 2)

				   (ash (logand x #xcc) -2)))

		   (setf x (logior (ash (logand x #x0f) 4)

				   (ash (logand x #xf0) -4)))

		   (setf (bref data i) x))))

	  (-8

	   ;; Swap bits

	   (loop for i fixnum from start below end

		 do

		 (let ((x (bref data i)))

		   (declare (type (unsigned-byte 8) x))

		   (setf x (logior (ash (logand x #x55) 1)

				   (ash (logand x #xaa) -1)))

		   (setf x (logior (ash (logand x #x33) 2)

				   (ash (logand x #xcc) -2)))

		   (setf x (logior (ash (logand x #x0f) 4)

				   (ash (logand x #xf0) -4)))

		   (setf (bref data i) x))))

	  ;;otherwise, do nothing ???

	  )))))

i18n/unidata.bin

(1.13 MiB)

File changed.

No diff preview for this file type.

View original file
View changed file