From d0ea1fcaac8f0a0919c704c0300a3ba9f9343ede Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Wed, 6 Jun 1990 03:57:36 +0000
Subject: [PATCH] Finished bit, (unsigned-byte 2), and (unsigned-byte 4)
 data-vector-{ref,set}.

---
 compiler/generic/vm-tran.lisp | 45 ++++++++++++++++-------------------
 1 file changed, 21 insertions(+), 24 deletions(-)

diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp
index 232051b22..094b78630 100644
--- a/compiler/generic/vm-tran.lisp
+++ b/compiler/generic/vm-tran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.10 1990/05/27 14:58:13 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.11 1990/06/06 03:57:36 wlott Exp $
 ;;;
 ;;;    This file contains impelemtentation-dependent transforms.
 ;;;
@@ -130,31 +130,28 @@
 
 ;;; Transforms for getting at arrays of unsigned-byte n when n < 8.
 
-#+nil
 (macrolet
     ((frob (type bits)
-       `(progn
-	  (deftransform data-vector-ref ((vector index)
-					 (,type *))
-	    `(multiple-value-bind (word bit)
-				  (floor index ,(truncate 16 ,bits))
-	       (ldb ,(ecase vm:target-byte-order
-		       (:little-endian '(byte ,bits bit))
-		       (:big-endian '(byte 1 (- 16 ,bits bit))))
-		    (%raw-bits vector (+ (* word 16)
-					 (* vm:vector-data-offset
-					    vm:word-bits))))))
-	  (deftransform data-vector-set ((vector index new-value)
-					 (,type * *))
-	    `(multiple-value-bind (word bit)
-				  (floor index ,(truncate 16 ,bits))
-	       (setf (ldb ,(ecase vm:target-byte-order
-			     (:little-endian '(byte ,bits bit))
-			     (:big-endian '(byte 1 (- 16 ,bits bit))))
-			  (%raw-bits vector (+ (* word 16)
-					       (* vm:vector-data-offset
-						  vm:word-bits))))
-		     new-value))))))
+       (let ((elements-per-word (truncate vm:word-bits bits)))
+	 `(progn
+	    (deftransform data-vector-ref ((vector index)
+					   (,type *))
+	      `(multiple-value-bind (word bit)
+				    (floor index ,',elements-per-word)
+		 (ldb ,(ecase vm:target-byte-order
+			 (:little-endian '(byte ,bits bit))
+			 (:big-endian '(byte 1 (- vm:word-bits ,bits bit))))
+		      (%raw-bits vector (+ word vm:vector-data-offset)))))
+	    (deftransform data-vector-set ((vector index new-value)
+					   (,type * *))
+	      `(multiple-value-bind (word bit)
+				    (floor index ,',elements-per-word)
+		 (setf (ldb ,(ecase vm:target-byte-order
+			       (:little-endian '(byte ,bits bit))
+			       (:big-endian
+				'(byte 1 (- vm:word-bits ,bits bit))))
+			    (%raw-bits vector (+ word vm:vector-data-offset)))
+		       new-value)))))))
   (frob simple-bit-vector 1)
   (frob (simple-array (unsigned-byte 2) (*)) 2)
   (frob (simple-array (unsigned-byte 4) (*)) 4))
-- 
GitLab