From e6ceaa1cc3f3f8ad02a4a224059b16e7e5ba1702 Mon Sep 17 00:00:00 2001 From: pmai <pmai> Date: Thu, 2 May 2002 03:35:44 +0000 Subject: [PATCH] This merges the fix in SBCL for overflows in the index calculations of the bit-operations deftransforms, which occurred for bit-vectors of sizes near the ARRAY-DIMENSION-LIMIT. The fix is based on the corresponding changes by Christophe Rhodes in version 0.7.3.5 of the corresponding file in the SBCL CVS repository. --- compiler/generic/vm-tran.lisp | 72 +++++++++++++++++++++++------------ 1 file changed, 48 insertions(+), 24 deletions(-) diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp index b86068cf8..62dcb1a87 100644 --- a/compiler/generic/vm-tran.lisp +++ b/compiler/generic/vm-tran.lisp @@ -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/compiler/generic/vm-tran.lisp,v 1.43 2001/06/05 13:58:59 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.44 2002/05/02 03:35:44 pmai Exp $") ;;; ;;; ********************************************************************** ;;; @@ -318,18 +318,32 @@ (error "Argument and/or result bit arrays not the same length:~ ~% ~S~% ~S ~% ~S" bit-array-1 bit-array-2 result-bit-array)))) - (do ((index vm:vector-data-offset (1+ index)) - (end (+ vm:vector-data-offset - (truncate (the index - (+ (length bit-array-1) - vm:word-bits -1)) - vm:word-bits)))) - ((= index end) result-bit-array) - (declare (optimize (speed 3) (safety 0)) - (type index index end)) - (setf (%raw-bits result-bit-array index) - (,wordfun (%raw-bits bit-array-1 index) - (%raw-bits bit-array-2 index)))))))) + (let ((length (length result-bit-array))) + (if (= length 0) + ;; We avoid doing anything to 0-length + ;; bit-vectors, or rather, the memory that + ;; follows them. Other divisible-by-32 cases + ;; are handled by the (1- length), below. + ;; CSR, 2002-04-24 + result-bit-array + (do ((index vm:vector-data-offset (1+ index)) + (end-1 (+ vm:vector-data-offset + ;; bit-vectors of length 1-32 + ;; need precisely one (SETF + ;; %RAW-BITS), done in the + ;; epilogue. - CSR, 2002-04-24 + (truncate (truly-the index (1- length)) + vm:word-bits)))) + ((= index end-1) + (setf (%raw-bits result-bit-array index) + (,wordfun (%raw-bits bit-array-1 index) + (%raw-bits bit-array-2 index))) + result-bit-array) + (declare (optimize (speed 3) (safety 0)) + (type index index end-1)) + (setf (%raw-bits result-bit-array index) + (,wordfun (%raw-bits bit-array-1 index) + (%raw-bits bit-array-2 index)))))))))) (deftransform bit-not ((bit-array result-bit-array) @@ -342,17 +356,27 @@ (error "Argument and result bit arrays not the same length:~ ~% ~S~% ~S" bit-array result-bit-array)))) - (do ((index vm:vector-data-offset (1+ index)) - (end (+ vm:vector-data-offset - (truncate (the index - (+ (length bit-array) - (1- vm:word-bits))) - vm:word-bits)))) - ((= index end) result-bit-array) - (declare (optimize (speed 3) (safety 0)) - (type index index end)) - (setf (%raw-bits result-bit-array index) - (32bit-logical-not (%raw-bits bit-array index)))))) + (let ((length (length result-bit-array))) + (if (= length 0) + ;; We avoid doing anything to 0-length bit-vectors, or + ;; rather, the memory that follows them. Other + ;; divisible-by-32 cases are handled by the (1- length), + ;; below. CSR, 2002-04-24 + result-bit-array + (do ((index vm:vector-data-offset (1+ index)) + (end-1 (+ vm:vector-data-offset + ;; bit-vectors of length 1-32 need precisely + ;; one (SETF %RAW-BITS), done in the epilogue. + (truncate (truly-the index (1- length)) + vm:word-bits)))) + ((= index end-1) + (setf (%raw-bits result-bit-array index) + (32bit-logical-not (%raw-bits bit-array index))) + result-bit-array) + (declare (optimize (speed 3) (safety 0)) + (type index index end-1)) + (setf (%raw-bits result-bit-array index) + (32bit-logical-not (%raw-bits bit-array index)))))))) ;;;; Primitive translator for byte-blt -- GitLab