X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcompiler%2Farray-tran.lisp;h=a384a6c0e64234ca22189dc70ec086f4df9d0710;hb=9086ddef369825b92533128f68dc04e0b165ea40;hp=56641aca567a23067f88f55ae42f50a463805ede;hpb=ad613f03c3e077e63ae871a4e1967ac57a4c59c9;p=sbcl.git

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 56641ac..a384a6c 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -187,13 +187,13 @@
 	 ,n-vec))))
 
 ;;; Just convert it into a MAKE-ARRAY.
-(define-source-transform make-string (length &key
-					     (element-type ''base-char)
-					     (initial-element
-					      '#.*default-init-char-form*))
-  `(make-array (the index ,length)
-	       :element-type ,element-type
-	       :initial-element ,initial-element))
+(deftransform make-string ((length &key
+				   (element-type 'base-char)
+				   (initial-element
+				    #.*default-init-char-form*)))
+  '(make-array (the index length)
+               :element-type element-type
+               :initial-element initial-element))
 
 (defstruct (specialized-array-element-type-properties
 	    (:conc-name saetp-)
@@ -227,7 +227,10 @@
 	 (destructuring-bind (type-spec &rest rest) args
 	   (let ((ctype (specifier-type type-spec)))
 	     (apply #'!make-saetp ctype rest))))
-       `((base-char ,(code-char 0) 8 ,sb!vm:simple-string-widetag
+       `(;; Erm.  Yeah.  There aren't a lot of things that make sense
+	 ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07
+	 (nil '#:mu 0 ,sb!vm:simple-array-nil-widetag)
+	 (base-char ,(code-char 0) 8 ,sb!vm:simple-string-widetag
 		    ;; (SIMPLE-STRINGs are stored with an extra trailing
 		    ;; #\NULL for convenience in calling out to C.)
 		    :n-pad-elements 1)
@@ -366,14 +369,17 @@
 				   'length
 				   `(+ length ,n-pad-elements)))
 	   (n-words-form
-	    (if (>= n-bits-per-element sb!vm:n-word-bits)
-		`(* ,padded-length-form
-		    (the fixnum ; i.e., not RATIO
-		      ,(/ n-bits-per-element sb!vm:n-word-bits)))
-		(let ((n-elements-per-word (/ sb!vm:n-word-bits
-					      n-bits-per-element)))
-		  (declare (type index n-elements-per-word)) ; i.e., not RATIO
-		  `(ceiling ,padded-length-form ,n-elements-per-word)))))
+	    (cond
+	      ((= n-bits-per-element 0) 0)
+	      ((>= n-bits-per-element sb!vm:n-word-bits)
+	       `(* ,padded-length-form
+		 (the fixnum ; i.e., not RATIO
+		   ,(/ n-bits-per-element sb!vm:n-word-bits))))
+	      (t
+	       (let ((n-elements-per-word (/ sb!vm:n-word-bits
+					     n-bits-per-element)))
+		 (declare (type index n-elements-per-word)) ; i.e., not RATIO
+		 `(ceiling ,padded-length-form ,n-elements-per-word))))))
       (values
        `(truly-the ,result-type-spec
 	 (allocate-vector ,typecode length ,n-words-form))
@@ -629,14 +635,21 @@
 	      (cond (,end
 		     (unless (or ,unsafe? (<= ,end ,size))
 		       ,(if fail-inline?
-			    `(error "End ~W is greater than total size ~W."
-				    ,end ,size)
+			    `(error 'bounding-indices-bad-error
+			      :datum (cons ,start ,end)
+			      :expected-type `(cons (integer 0 ,',size)
+					            (integer ,',start ,',size))
+			      :object ,array)
 			    `(failed-%with-array-data ,array ,start ,end)))
 		     ,end)
 		    (t ,size))))
        (unless (or ,unsafe? (<= ,start ,defaulted-end))
 	 ,(if fail-inline?
-	      `(error "Start ~W is greater than end ~W." ,start ,defaulted-end)
+	      `(error 'bounding-indices-bad-error
+		:datum (cons ,start ,end)
+		:expected-type `(cons (integer 0 ,',size)
+				      (integer ,',start ,',size))
+		:object ,array)
 	      `(failed-%with-array-data ,array ,start ,end)))
        (do ((,data ,array (%array-data-vector ,data))
 	    (,cumulative-offset 0