Update of /cvsroot/sbcl/sbcl/src/code
In directory usw-pr-cvs1:/tmp/cvs-serv15820/src/code
Modified Files:
array.lisp early-extensions.lisp
Log Message:
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
Index: array.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/array.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- array.lisp 31 Jan 2002 16:38:46 -0000 1.25
+++ array.lisp 25 Jun 2002 15:57:14 -0000 1.26
@@ -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 (*))))
Index: early-extensions.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-extensions.lisp,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -d -r1.44 -r1.45
--- early-extensions.lisp 19 May 2002 13:55:31 -0000 1.44
+++ early-extensions.lisp 25 Jun 2002 15:57:14 -0000 1.45
@@ -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
-------------------------------------------------------
This sf.net email is sponsored by: Jabber Inc.
Don't miss the IM event of the season | Special offer for OSDN members!
JabConf 2002, Aug. 20-22, Keystone, CO http://www.jabberconf.com/osdn
|
