Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/compiler array-tran.lisp, 1.79, 1.80 fndb.lisp, 1.140, 1.141 seqtran.lisp, 1.82, 1.83
|
From: Nikodemus S. <de...@us...> - 2007-11-30 14:18:41
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv12801/src/compiler Modified Files: array-tran.lisp fndb.lisp seqtran.lisp Log Message: 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. Index: array-tran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/array-tran.lisp,v retrieving revision 1.79 retrieving revision 1.80 diff -u -d -r1.79 -r1.80 --- array-tran.lisp 29 Nov 2007 17:30:20 -0000 1.79 +++ array-tran.lisp 30 Nov 2007 14:18:33 -0000 1.80 @@ -569,22 +569,6 @@ ;;;; 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 Index: fndb.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/fndb.lisp,v retrieving revision 1.140 retrieving revision 1.141 diff -u -d -r1.140 -r1.141 --- fndb.lisp 29 Nov 2007 17:30:20 -0000 1.140 +++ fndb.lisp 30 Nov 2007 14:18:33 -0000 1.141 @@ -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)) Index: seqtran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/seqtran.lisp,v retrieving revision 1.82 retrieving revision 1.83 diff -u -d -r1.82 -r1.83 --- seqtran.lisp 30 Nov 2007 13:12:23 -0000 1.82 +++ seqtran.lisp 30 Nov 2007 14:18:33 -0000 1.83 @@ -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))) |