From: Christophe Rhodes Date: Tue, 25 Jun 2002 15:57:13 +0000 (+0000) Subject: 0.7.5.1: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d75b4eb603f1e9e366997c8e378fe0ae0d79b5d9;p=sbcl.git 0.7.5.1: Alpha build fix ... define the relevant types earlier in the build ... s/INTEGER-WITH-A-BITE-OUT/UNSIGNED-BYTE-WITH-A-BITE-OUT/ Array performance enhancement ... remove the (SAFETY 3) declaration from HAIRY-DATA-VECTOR-{REF,SET} ... write tests for AREF beyond array bounds Buglet fix in pack.lisp ... put FILL arguments the right way round --- diff --git a/TODO b/TODO index d98e480..437746f 100644 --- a/TODO +++ b/TODO @@ -5,6 +5,9 @@ for early 0.7.x: ** (also, while working on INLINE anyway, it might be easy to flush the old MAYBE-INLINE cruft entirely, including e.g. on the man page) +* test file reworking + ** non-x86 ports now pass irrat.pure.lisp + ** sparc and ppc now pass bit-vector.impure-cload.lisp * faster bootstrapping (both make.sh and slam.sh) ** added mechanisms for automatically finding dead code, and used them to remove dead code diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 51c20e1..774f0e8 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -754,8 +754,8 @@ retained, possibly temporariliy, because it might be used internally." "UNSUPPORTED-OPERATOR" ;; ..and DEFTYPEs.. - "INDEX" - + "INDEX" "LOAD/STORE-INDEX" + "UNSIGNED-BYTE-WITH-A-BITE-OUT" ;; ..and type predicates "INSTANCEP" "DOUBLE-FLOATP" diff --git a/src/code/array.lisp b/src/code/array.lisp index 7a8f1b2..0770723 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -319,7 +319,7 @@ (defun hairy-data-vector-ref (array index) (with-array-data ((vector array) (index index) (end)) - (declare (ignore end) (optimize (safety 3))) + (declare (ignore end)) (etypecase vector . #.(mapcar (lambda (type) (let ((atype `(simple-array ,type (*)))) @@ -330,7 +330,7 @@ (defun hairy-data-vector-set (array index new-value) (with-array-data ((vector array) (index index) (end)) - (declare (ignore end) (optimize (safety 3))) + (declare (ignore end) (optimize)) (etypecase vector . #.(mapcar (lambda (type) (let ((atype `(simple-array ,type (*)))) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 0f6fba9..cb48d4e 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -36,6 +36,26 @@ ;;; index leaving the loop range) (def!type index-or-minus-1 () `(integer -1 (,sb!xc:array-dimension-limit))) +;;; A couple of VM-related types that are currently used only on the +;;; alpha platform. -- CSR, 2002-06-24 +(def!type unsigned-byte-with-a-bite-out (s bite) + (cond ((eq s '*) 'integer) + ((and (integerp s) (> s 1)) + (let ((bound (ash 1 s))) + `(integer 0 ,(- bound bite 1)))) + (t + (error "Bad size specified for SIGNED-BYTE type specifier: ~S." s)))) + +(def!type load/store-index (scale lowtag min-offset + &optional (max-offset min-offset)) + `(integer ,(- (truncate (+ (ash 1 16) + (* min-offset sb!vm:n-word-bytes) + (- lowtag)) + scale)) + ,(truncate (- (+ (1- (ash 1 16)) lowtag) + (* max-offset sb!vm:n-word-bytes)) + scale))) + ;;; the default value used for initializing character data. The ANSI ;;; spec says this is arbitrary, so we use the value that falls ;;; through when we just let the low-level consing code initialize diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp index 42af22a..1da0e8c 100644 --- a/src/compiler/alpha/arith.lisp +++ b/src/compiler/alpha/arith.lisp @@ -294,14 +294,6 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:policy :fast-safe)) -(deftype integer-with-a-bite-out (s bite) - (cond ((eq s '*) 'integer) - ((and (integerp s) (> s 1)) - (let ((bound (ash 1 s))) - `(integer 0 ,(- bound bite 1)))) - (t - (error "Bad size specified for SIGNED-BYTE type specifier: ~S." s)))) - (define-vop (fast-conditional/fixnum fast-conditional) (:args (x :scs (any-reg)) (y :scs (any-reg))) @@ -310,7 +302,7 @@ (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum) (:args (x :scs (any-reg))) - (:arg-types tagged-num (:constant (integer-with-a-bite-out 6 4))) + (:arg-types tagged-num (:constant (unsigned-byte-with-a-bite-out 6 4))) (:info target not-p y)) (define-vop (fast-conditional/signed fast-conditional) @@ -321,7 +313,7 @@ (define-vop (fast-conditional-c/signed fast-conditional/signed) (:args (x :scs (signed-reg))) - (:arg-types signed-num (:constant (integer-with-a-bite-out 8 1))) + (:arg-types signed-num (:constant (unsigned-byte-with-a-bite-out 8 1))) (:info target not-p y)) (define-vop (fast-conditional/unsigned fast-conditional) @@ -332,7 +324,7 @@ (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned) (:args (x :scs (unsigned-reg))) - (:arg-types unsigned-num (:constant (integer-with-a-bite-out 8 1))) + (:arg-types unsigned-num (:constant (unsigned-byte-with-a-bite-out 8 1))) (:info target not-p y)) diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp index bb5e3d0..998cec0 100644 --- a/src/compiler/alpha/macros.lisp +++ b/src/compiler/alpha/macros.lisp @@ -261,16 +261,6 @@ ;;;; memory accessor vop generators -(deftype load/store-index (scale lowtag min-offset - &optional (max-offset min-offset)) - `(integer ,(- (truncate (+ (ash 1 16) - (* min-offset n-word-bytes) - (- lowtag)) - scale)) - ,(truncate (- (+ (1- (ash 1 16)) lowtag) - (* max-offset n-word-bytes)) - scale))) - (defmacro define-full-reffer (name type offset lowtag scs el-type &optional translate) `(progn diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp index 77312a5..727db03 100644 --- a/src/compiler/pack.lisp +++ b/src/compiler/pack.lisp @@ -254,7 +254,7 @@ (dolist (sb *backend-sb-list*) (unless (eq (sb-kind sb) :non-packed) (let ((size (sb-size sb))) - (fill nil (finite-sb-always-live sb)) + (fill (finite-sb-always-live sb) nil) (setf (finite-sb-always-live sb) (make-array size :initial-element @@ -265,11 +265,11 @@ ;; until runtime. #+sb-xc (make-array 0 :element-type 'bit))) - (fill nil (finite-sb-conflicts sb)) + (fill (finite-sb-conflicts sb) nil) (setf (finite-sb-conflicts sb) (make-array size :initial-element '#())) - (fill nil (finite-sb-live-tns sb)) + (fill (finite-sb-live-tns sb) nil) (setf (finite-sb-live-tns sb) (make-array size :initial-element nil)))))) (values)) diff --git a/src/compiler/ppc/arith.lisp b/src/compiler/ppc/arith.lisp index aafd5cf..b6559cc 100644 --- a/src/compiler/ppc/arith.lisp +++ b/src/compiler/ppc/arith.lisp @@ -377,14 +377,6 @@ (:affected) (:policy :fast-safe)) -(deftype integer-with-a-bite-out (s bite) - (cond ((eq s '*) 'integer) - ((and (integerp s) (> s 1)) - (let ((bound (ash 1 (1- s)))) - `(integer ,(- bound) ,(- bound bite 1)))) - (t - (error "Bad size specified for SIGNED-BYTE type specifier: ~S." s)))) - (define-vop (fast-conditional/fixnum fast-conditional) (:args (x :scs (any-reg zero)) (y :scs (any-reg zero))) diff --git a/src/compiler/sparc/arith.lisp b/src/compiler/sparc/arith.lisp index cadcdab..de06b78 100644 --- a/src/compiler/sparc/arith.lisp +++ b/src/compiler/sparc/arith.lisp @@ -640,14 +640,6 @@ (:affected) (:policy :fast-safe)) -(deftype integer-with-a-bite-out (s bite) - (cond ((eq s '*) 'integer) - ((and (integerp s) (> s 1)) - (let ((bound (ash 1 (1- s)))) - `(integer ,(- bound) ,(- bound bite 1)))) - (t - (error "Bad size specified for SIGNED-BYTE type specifier: ~S." s)))) - (define-vop (fast-conditional/fixnum fast-conditional) (:args (x :scs (any-reg zero)) (y :scs (any-reg zero))) diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp index aea6827..8a65351 100644 --- a/tests/array.pure.lisp +++ b/tests/array.pure.lisp @@ -16,25 +16,49 @@ (let ((testcases '(;; Bug 126, confusion between high-level default string ;; initial element #\SPACE and low-level default array ;; element #\NULL, is gone. - (#\null (make-array 11 :element-type 'character)) - (#\space (make-string 11 :initial-element #\space)) + (#\null (make-array 11 :element-type 'character) simple-string) + (#\space (make-string 11 :initial-element #\space) string) (#\* (make-string 11 :initial-element #\*)) (#\null (make-string 11)) (#\null (make-string 11 :initial-element #\null)) (#\x (make-string 11 :initial-element #\x)) ;; And the other tweaks made when fixing bug 126 didn't ;; mess things up too badly either. - (0 (make-array 11)) + (0 (make-array 11) simple-vector) (nil (make-array 11 :initial-element nil)) (12 (make-array 11 :initial-element 12)) - (0 (make-array 11 :element-type '(unsigned-byte 4))) + (0 (make-array 11 :element-type '(unsigned-byte 4)) (simple-array (unsigned-byte 4) (*))) (12 (make-array 11 :element-type '(unsigned-byte 4) :initial-element 12))))) (dolist (testcase testcases) - (destructuring-bind (expected-result form) testcase + (destructuring-bind (expected-result form &optional type) testcase (unless (eql expected-result (aref (eval form) 3)) (error "expected ~S in EVAL ~S" expected-result form)) (unless (eql expected-result (aref (funcall (compile nil `(lambda () ,form))) 3)) - (error "expected ~S in FUNCALL COMPILE ~S" expected-result form))))) + (error "expected ~S in FUNCALL COMPILE ~S" expected-result form)) + ;; also do some testing of compilation and verification that + ;; errors are thrown appropriately. + (unless (eql expected-result + (funcall (compile nil `(lambda () (aref ,form 3))))) + (error "expected ~S in COMPILED-AREF ~S" expected-result form)) + (when type + (unless (eql expected-result + (funcall (compile nil `(lambda () (let ((x ,form)) + (declare (type ,type x)) + (aref x 3)))))) + (error "expected ~S in COMPILED-DECLARED-AREF ~S" expected-result form))) + (when (ignore-errors (aref (eval form) 12)) + (error "error not thrown in EVAL ~S" form)) + (when (ignore-errors (aref (funcall (compile nil `(lambda () ,form))) 12)) + (error "error not thrown in FUNCALL COMPILE ~S")) + (when (ignore-errors (funcall (compile nil `(lambda () (aref ,form 12))))) + (error "error not thrown in COMPILED-AREF ~S" form)) + (when type + (when (ignore-errors (funcall + (compile nil `(lambda () (let ((x ,form)) + (declare (type ,type x)) + (aref x 12)))))) + (error "error not thrown in COMPILED-DECLARED-AREF ~S" form)))))) + diff --git a/version.lisp-expr b/version.lisp-expr index ddf7620..1eb9075 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.5" +"0.7.5.1"