1.0.12.8: refactor bounding index error signalling functions

* We need two variants: one that uses ARRAY-TOTAL-SIZE for
  the limit, other othat uses LENGTH. Call them ARRAY- and
  SEQUENCE-BOUNDING-INDICES-BAD-ERROR.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 6b7eab4..989ae2e 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -837,6 +837,10 @@ possibly temporariliy, because it might be used internally."
                "SIMPLE-STYLE-WARNING"
                "TRY-RESTART"
 
+               ;; error-signalling facilities
+               "ARRAY-BOUNDING-INDICES-BAD-ERROR"
+               "SEQUENCE-BOUNDING-INDICES-BAD-ERROR"
+
                "SPECIAL-FORM-FUNCTION"
                "STYLE-WARN" "SIMPLE-COMPILER-NOTE"
 

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 98df2d4..9a7ce72 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -1234,7 +1234,7 @@
           (declare (type index start end))
           (synchronize-stream-output stream)
           (unless (<= 0 start end (length string))
-            (signal-bounding-indices-bad-error string start end))
+            (sequence-bounding-indices-bad-error string start end))
           (do ()
               ((= end start))
             (let ((obuf (fd-stream-obuf stream)))
@@ -1411,7 +1411,7 @@
           (declare (type index start end))
           (synchronize-stream-output stream)
           (unless (<= 0 start end (length string))
-            (signal-bounding-indices-bad-error string start end))
+            (sequence-bounding-indices-bad string start end))
           (do ()
               ((= end start))
             (let ((obuf (fd-stream-obuf stream)))

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index c5c6bd8..eba8389 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -41,8 +41,7 @@
                      nil
                      (if (<= 0 ,start ,length)
                          ,start
-                         (signal-bounding-indices-bad-error ,sequence
-                                                            ,start ,end))
+                         (sequence-bounding-indices-bad-error ,sequence ,start ,end))
                      index)
                   `(,end
                     nil
@@ -55,8 +54,7 @@
                         ;; FIXME: defend against non-number non-NIL
                         ;; stuff?
                         ,end
-                        (signal-bounding-indices-bad-error ,sequence
-                                                           ,start ,end))
+                        (sequence-bounding-indices-bad-error ,sequence ,start ,end))
                     (or null index)))))
               '((start end length sequence)
                 (start1 end1 length1 sequence1)
@@ -220,13 +218,21 @@
                               ;; This seems silly, is there something better?
                               '(integer 0 (0))))))
 
-(defun signal-bounding-indices-bad-error (sequence start end)
-  (let ((length (length sequence)))
+(defun sequence-bounding-indices-bad-error (sequence start end)
+  (let ((size (length sequence)))
     (error 'bounding-indices-bad-error
            :datum (cons start end)
-           :expected-type `(cons (integer 0 ,length)
-                                 (or null (integer ,start ,length)))
+           :expected-type `(cons (integer 0 ,size)
+                                 (integer ,start ,size))
            :object sequence)))
+
+(defun array-bounding-indices-bad-error (array start end)
+  (let ((size (array-total-size array)))
+    (error 'bounding-indices-bad-error
+           :datum (cons start end)
+           :expected-type `(cons (integer 0 ,size)
+                                 (integer ,start ,size))
+           :object array)))
 \f
 (defun elt (sequence index)
   #!+sb-doc "Return the element of SEQUENCE specified by INDEX."
@@ -359,7 +365,7 @@
   (when (null end)
     (setf end (length sequence)))
   (unless (<= 0 start end (length sequence))
-    (signal-bounding-indices-bad-error sequence start end))
+    (sequence-bounding-indices-bad-error sequence start end))
   (do ((old-index start (1+ old-index))
        (new-index 0 (1+ new-index))
        (copy (%make-sequence-like sequence (- end start))))
@@ -373,7 +379,7 @@
            (type unsigned-byte start)
            (type (or null unsigned-byte) end))
   (flet ((oops ()
-           (signal-bounding-indices-bad-error sequence start end)))
+           (sequence-bounding-indices-bad-error sequence start end)))
     (let ((pointer sequence))
       (unless (zerop start)
         ;; If START > 0 the list cannot be empty. So CDR down to

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 2026bb2..5224134 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -569,22 +569,6 @@
 \f
 ;;;; WITH-ARRAY-DATA
 
-(defun bounding-index-error (array start end)
-  (let ((size (array-total-size array)))
-    (error 'bounding-indices-bad-error
-           :datum (cons start end)
-           :expected-type `(cons (integer 0 ,size)
-                                 (integer ,start ,size))
-           :object array)))
-
-(defun bounding-index-error/fp (array start end)
-  (let ((size (length array)))
-    (error 'bounding-indices-bad-error
-           :datum (cons start end)
-           :expected-type `(cons (integer 0 ,size)
-                                 (integer ,start ,size))
-           :object array)))
-
 ;;; This checks to see whether the array is simple and the start and
 ;;; end are in bounds. If so, it proceeds with those values.
 ;;; Otherwise, it calls %WITH-ARRAY-DATA. Note that %WITH-ARRAY-DATA
@@ -633,8 +617,8 @@
                                  `(if (<= ,n-svalue ,n-end ,n-len)
                                       (values ,n-array ,n-svalue ,n-end 0)
                                       ,(if check-fill-pointer
-                                           `(bounding-index-error/fp ,n-array ,n-svalue ,n-evalue)
-                                           `(bounding-index-error ,n-array ,n-svalue ,n-evalue))))))
+                                           `(sequence-bounding-indices-bad-error ,n-array ,n-svalue ,n-evalue)
+                                           `(array-bounding-indices-bad-error ,n-array ,n-svalue ,n-evalue))))))
                ,(if force-inline
                     `(%with-array-data-macro ,n-array ,n-svalue ,n-evalue
                                              :check-bounds ,check-bounds
@@ -661,8 +645,8 @@
        ,@(when check-bounds
                `((unless (<= ,start ,defaulted-end ,size)
                    ,(if check-fill-pointer
-                        `(bounding-index-error/fp ,array ,start ,end)
-                        `(bounding-index-error ,array ,start ,end)))))
+                        `(sequence-bounding-indices-bad-error ,array ,start ,end)
+                        `(array-bounding-indices-bad-error ,array ,start ,end)))))
        (do ((,data ,array (%array-data-vector ,data))
             (,cumulative-offset 0
                                 (+ ,cumulative-offset

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index e845ec7..30fe77d 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1459,8 +1459,8 @@
 (defknown %set-symbol-package (symbol t) t (unsafe))
 (defknown %coerce-name-to-fun ((or symbol cons)) function (flushable))
 (defknown %coerce-callable-to-fun (callable) function (flushable))
-(defknown bounding-index-error (t t t) nil)
-(defknown bounding-index-error/fp (t t t) nil)
+(defknown array-bounding-indices-bad-error (t t t) nil)
+(defknown sequence-bounding-indices-bad-error (t t t) nil)
 (defknown %find-position
   (t sequence t index sequence-end function function)
   (values t (or index null))

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index eafa639..9cd3e8a 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -289,7 +289,7 @@
       '(let ((length (length vector)))
          (if (<= 0 start (or end length) length)
              (or end length)
-             (sb!impl::signal-bounding-indices-bad-error vector start end)))))
+             (sequence-bounding-indices-bad-error vector start end)))))
 
 (defun specialized-list-seek-function-name (function-name key-functions)
   (or (find-symbol (with-output-to-string (s)
@@ -617,9 +617,9 @@
           ,(unless (policy node (= safety 0))
              `(progn
                  (unless (<= 0 start1 end1 len1)
-                   (sb!impl::signal-bounding-indices-bad-error seq1 start1 end1))
+                   (sequence-bounding-indices-bad-error seq1 start1 end1))
                  (unless (<= 0 start2 end2 len2)
-                   (sb!impl::signal-bounding-indices-bad-error seq2 start2 end2))))
+                   (sequence-bounding-indices-bad-error seq2 start2 end2))))
           ,',(cond
               ((and saetp (valid-bit-bash-saetp-p saetp))
                (let* ((n-element-bits (sb!vm:saetp-n-bits saetp))
@@ -793,7 +793,7 @@
          ,(unless (policy node (= safety 0))
                   '(progn
                     (unless (<= 0 start end length)
-                      (sb!impl::signal-bounding-indices-bad-error seq start end))))
+                      (sequence-bounding-indices-bad-error seq start end))))
          (let* ((size (- end start))
                 (result (make-array size :element-type ',element-type)))
            ,(maybe-expand-copy-loop-inline 'seq (if (constant-lvar-p start)
@@ -837,7 +837,7 @@
         (check-bounds-p (policy node (plusp insert-array-bounds-checks))))
     `(block search
        (flet ((oops (vector start end)
-                (bounding-index-error vector start end)))
+                (sequence-bounding-indices-bad-error vector start end)))
          (let* ((len1 (length pattern))
                 (len2 (length text))
                 (end1 (or end1 len1))
@@ -997,7 +997,7 @@
                    (declare (type index index))
                    (dolist (i sequence
                             (if (and end (> end index))
-                                (sb!impl::signal-bounding-indices-bad-error
+                                (sequence-bounding-indices-bad-error
                                  sequence start end)
                                 (values find position)))
                      (let ((key-i (funcall key i)))

diff --git a/version.lisp-expr b/version.lisp-expr
index cbfce67..15217fe 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.12.7"
+"1.0.12.8"