Skip to content
Snippets Groups Projects
Commit d0ea1fca authored by wlott's avatar wlott
Browse files

Finished bit, (unsigned-byte 2), and (unsigned-byte 4) data-vector-{ref,set}.

parent 1a2909b8
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; 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. ;;; This file contains impelemtentation-dependent transforms.
;;; ;;;
...@@ -130,31 +130,28 @@ ...@@ -130,31 +130,28 @@
;;; Transforms for getting at arrays of unsigned-byte n when n < 8. ;;; Transforms for getting at arrays of unsigned-byte n when n < 8.
#+nil
(macrolet (macrolet
((frob (type bits) ((frob (type bits)
`(progn (let ((elements-per-word (truncate vm:word-bits bits)))
(deftransform data-vector-ref ((vector index) `(progn
(,type *)) (deftransform data-vector-ref ((vector index)
`(multiple-value-bind (word bit) (,type *))
(floor index ,(truncate 16 ,bits)) `(multiple-value-bind (word bit)
(ldb ,(ecase vm:target-byte-order (floor index ,',elements-per-word)
(:little-endian '(byte ,bits bit)) (ldb ,(ecase vm:target-byte-order
(:big-endian '(byte 1 (- 16 ,bits bit)))) (:little-endian '(byte ,bits bit))
(%raw-bits vector (+ (* word 16) (:big-endian '(byte 1 (- vm:word-bits ,bits bit))))
(* vm:vector-data-offset (%raw-bits vector (+ word vm:vector-data-offset)))))
vm:word-bits)))))) (deftransform data-vector-set ((vector index new-value)
(deftransform data-vector-set ((vector index new-value) (,type * *))
(,type * *)) `(multiple-value-bind (word bit)
`(multiple-value-bind (word bit) (floor index ,',elements-per-word)
(floor index ,(truncate 16 ,bits)) (setf (ldb ,(ecase vm:target-byte-order
(setf (ldb ,(ecase vm:target-byte-order (:little-endian '(byte ,bits bit))
(:little-endian '(byte ,bits bit)) (:big-endian
(:big-endian '(byte 1 (- 16 ,bits bit)))) '(byte 1 (- vm:word-bits ,bits bit))))
(%raw-bits vector (+ (* word 16) (%raw-bits vector (+ word vm:vector-data-offset)))
(* vm:vector-data-offset new-value)))))))
vm:word-bits))))
new-value))))))
(frob simple-bit-vector 1) (frob simple-bit-vector 1)
(frob (simple-array (unsigned-byte 2) (*)) 2) (frob (simple-array (unsigned-byte 2) (*)) 2)
(frob (simple-array (unsigned-byte 4) (*)) 4)) (frob (simple-array (unsigned-byte 4) (*)) 4))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment