common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

0.7.5.1:

Browse source 
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
This commit is contained in:
Christophe Rhodes 2002-06-25 15:57:13 +00:00
parent f596910da4
commit d75b4eb603
11 changed files with 64 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
TODO
View file

@ -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

4
package-data-list.lisp-expr
View file

@ -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"

4
src/code/array.lisp
View file

@ -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 (*))))

20
src/code/early-extensions.lisp
View file

@ -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

14
src/compiler/alpha/arith.lisp
View file

@ -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))

10
src/compiler/alpha/macros.lisp
View file

@ -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

6
src/compiler/pack.lisp
View file

@ -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))

8
src/compiler/ppc/arith.lisp
View file

@ -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)))

8
src/compiler/sparc/arith.lisp
View file

@ -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)))

36
tests/array.pure.lisp
View file

@ -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))))))

2
version.lisp-expr
View file

@ -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"