- ((not (constant-continuation-p element-type))
- (give-up-ir1-transform
- "ELEMENT-TYPE is not constant."))
- (t
- (continuation-value element-type))))
- (len (if (constant-continuation-p length)
- (continuation-value length)
- '*))
- (spec `(simple-array ,eltype (,len)))
- (eltype-type (specifier-type eltype)))
- (multiple-value-bind (default-initial-element element-size typecode)
- (dovector (info *array-info*
- (give-up-ir1-transform
- "cannot open-code creation of ~S" spec))
- (when (csubtypep eltype-type (specifier-type (car info)))
- (return (values-list (cdr info)))))
- (let* ((nwords-form
- (if (>= element-size sb!vm:word-bits)
- `(* length ,(/ element-size sb!vm:word-bits))
- (let ((elements-per-word (/ 32 element-size)))
- `(truncate (+ length
- ,(if (eq 'sb!vm:simple-string-type typecode)
- ;; (Simple strings are stored with an
- ;; extra trailing null for convenience
- ;; in calling out to C.)
- elements-per-word
- (1- elements-per-word)))
- ,elements-per-word))))
- (constructor
- `(truly-the ,spec
- (allocate-vector ,typecode length ,nwords-form))))
- (values
- (cond ((and default-initial-element
- (or (null initial-element)
- (and (constant-continuation-p initial-element)
- (eql (continuation-value initial-element)
- default-initial-element))))
- (unless (csubtypep (ctype-of default-initial-element)
- eltype-type)
- ;; This situation arises e.g. in
- ;; (MAKE-ARRAY 4 :ELEMENT-TYPE '(INTEGER 1 5))
- ;; ANSI's definition of MAKE-ARRAY says "If
- ;; INITIAL-ELEMENT is not supplied, the consequences
- ;; of later reading an uninitialized element of
- ;; new-array are undefined," so this could be legal
- ;; code as long as the user plans to write before he
- ;; reads, and if he doesn't we're free to do
- ;; anything we like. But in case the user doesn't
- ;; know to write before he reads, we'll signal a
- ;; STYLE-WARNING in case he didn't realize this.
- ;;
- ;; FIXME: should be STYLE-WARNING, not note
- (compiler-note "The default initial element ~S is not a ~S."
- default-initial-element
- eltype))
- constructor)
- (t
- `(truly-the ,spec (fill ,constructor initial-element))))
- '((declare (type index length))))))))
+ ((not (constant-lvar-p element-type))
+ (give-up-ir1-transform
+ "ELEMENT-TYPE is not constant."))
+ (t
+ (lvar-value element-type))))
+ (len (if (constant-lvar-p length)
+ (lvar-value length)
+ '*))
+ (eltype-type (ir1-transform-specifier-type eltype))
+ (result-type-spec
+ `(simple-array
+ ,(if (unknown-type-p eltype-type)
+ (give-up-ir1-transform
+ "ELEMENT-TYPE is an unknown type: ~S" eltype)
+ (sb!xc:upgraded-array-element-type eltype))
+ (,len)))
+ (saetp (find-if (lambda (saetp)
+ (csubtypep eltype-type (sb!vm:saetp-ctype saetp)))
+ sb!vm:*specialized-array-element-type-properties*)))
+ (unless saetp
+ (give-up-ir1-transform
+ "cannot open-code creation of ~S" result-type-spec))
+ #-sb-xc-host
+ (unless (ctypep (sb!vm:saetp-initial-element-default saetp) eltype-type)
+ ;; This situation arises e.g. in (MAKE-ARRAY 4 :ELEMENT-TYPE
+ ;; '(INTEGER 1 5)) ANSI's definition of MAKE-ARRAY says "If
+ ;; INITIAL-ELEMENT is not supplied, the consequences of later
+ ;; reading an uninitialized element of new-array are undefined,"
+ ;; so this could be legal code as long as the user plans to
+ ;; write before he reads, and if he doesn't we're free to do
+ ;; anything we like. But in case the user doesn't know to write
+ ;; elements before he reads elements (or to read manuals before
+ ;; he writes code:-), we'll signal a STYLE-WARNING in case he
+ ;; didn't realize this.
+ (compiler-style-warn "The default initial element ~S is not a ~S."
+ (sb!vm:saetp-initial-element-default saetp)
+ eltype))
+ (let* ((n-bits-per-element (sb!vm:saetp-n-bits saetp))
+ (typecode (sb!vm:saetp-typecode saetp))
+ (n-pad-elements (sb!vm:saetp-n-pad-elements saetp))
+ (padded-length-form (if (zerop n-pad-elements)
+ 'length
+ `(+ length ,n-pad-elements)))
+ (n-words-form
+ (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))
+ '((declare (type index length)))))))