X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Farray.lisp;h=d3c09c1ac743077806c33723f8bcde56306b9697;hb=dc9d03a1c43398d3a860520c6ea03e8d5838d142;hp=f463c5f8d871f16f2ff6b3c326bd681765dd53bd;hpb=63817d29028c8551cda23f432a3328acd7fdd62f;p=sbcl.git

diff --git a/src/code/array.lisp b/src/code/array.lisp
index f463c5f..d3c09c1 100644
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -91,8 +91,11 @@
     ;; and for all in any reasonable user programs.)
     ((t)
      (values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))
-    ((base-char standard-char character)
+    ((base-char standard-char #!-sb-unicode character)
      (values #.sb!vm:simple-base-string-widetag #.sb!vm:n-byte-bits))
+    #!+sb-unicode
+    ((character)
+     (values #.sb!vm:simple-character-string-widetag #.sb!vm:n-word-bits))
     ((bit)
      (values #.sb!vm:simple-bit-vector-widetag 1))
     ;; OK, we have to wade into SUBTYPEPing after all.
@@ -110,8 +113,11 @@
     ;; Pick off some easy common cases.
     ((t)
      #.sb!vm:complex-vector-widetag)
-    ((base-char character)
+    ((base-char #!-sb-unicode character)
      #.sb!vm:complex-base-string-widetag)
+    #!+sb-unicode
+    ((character)
+     #.sb!vm:complex-character-string-widetag)
     ((nil)
      #.sb!vm:complex-vector-nil-widetag)
     ((bit)
@@ -120,7 +126,12 @@
     (t
      (pick-vector-type type
        (nil #.sb!vm:complex-vector-nil-widetag)
+       #!-sb-unicode
        (character #.sb!vm:complex-base-string-widetag)
+       #!+sb-unicode
+       (base-char #.sb!vm:complex-base-string-widetag)
+       #!+sb-unicode
+       (character #.sb!vm:complex-character-string-widetag)
        (bit #.sb!vm:complex-bit-vector-widetag)
        (t #.sb!vm:complex-vector-widetag)))))
 
@@ -148,11 +159,15 @@
 		 (array (allocate-vector
 			 type
 			 length
-			 (ceiling (* (if (= type sb!vm:simple-base-string-widetag)
-					 (1+ length)
-					 length)
-				     n-bits)
-				  sb!vm:n-word-bits))))
+			 (ceiling
+                          (* (if (or (= type sb!vm:simple-base-string-widetag)
+                                     #!+sb-unicode
+                                     (= type
+                                        sb!vm:simple-character-string-widetag))
+                                 (1+ length)
+                                 length)
+                             n-bits)
+                          sb!vm:n-word-bits))))
 	    (declare (type index length))
 	    (when initial-element-p
 	      (fill array initial-element))
@@ -854,7 +869,9 @@
 	  ,@(map 'list
 		 (lambda (saetp)
 		   `((simple-array ,(sb!vm:saetp-specifier saetp) (*))
-		     ,(if (eq (sb!vm:saetp-specifier saetp) 'character)
+		     ,(if (or (eq (sb!vm:saetp-specifier saetp) 'character)
+                              #!+sb-unicode
+			      (eq (sb!vm:saetp-specifier saetp) 'base-char))
 			  *default-init-char-form*
 			  (sb!vm:saetp-initial-element-default saetp))))
 		 (remove-if-not