X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Farray.lisp;h=d3c09c1ac743077806c33723f8bcde56306b9697;hb=b36697e233ff1ef1cc3ad2e687581520656d4755;hp=1399a42e97fb92ae01e5739d6e6f93ded78f8cf1;hpb=771b864c8f32af7734bc0550aeaf1539fc4df194;p=sbcl.git diff --git a/src/code/array.lisp b/src/code/array.lisp index 1399a42..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) + ((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) + ((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) 'base-char) + ,(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