anchor.diff:    ;; that doesn't already have one.
     (check-vector-has-fill-pointer vector)
     (unless (<= 0 new-value (array-dimension vector 0))
  -    (error "New fill-pointer ~S exceeds vector bounds. Should be non-negative and <=~S."
  +    (error "New fill-pointer ~S exceeds vector bounds. Should be non-negative and <= ~S."
              new-value (array-dimension vector 0)))
     (setf (%complex-array-fill-pointer vector) new-value))
   
  
positive.code:          (let ((array (make-simple-array-1 dimensions info area)))
             (when (not (eql initial-element (fifth info)))
               (fill array initial-element))
             array))
          (t
           (make-array dimensions
                       :element-type element-type
                       :initial-element initial-element
                       :area area))))
  
  (defun make-array (dimensions &key
  
negative.code:          whole)
          (t
           (let ((array-sym (gensym "ARRAY"))
                 (area-sym (gensym "AREA"))
                 (info (upgraded-array-info (if (consp element-type)
                                                (second element-type)
                                                element-type))))
             (when (not (second info))
               (return-from make-array whole))
             `(let* ((,area-sym ,area)
                     (,array-sym (make-array-with-known-element-type
                                  ,dimensions ,element-type ',info ,area-sym
                                  ,(if initial-element-p
                                       initial-element
                                       `',(fifth info))
                                  ',adjustable
                                  ',fill-pointer)))
                ,@(when initial-contents-p
                    `((initialize-from-initial-contents ,array-sym ,initial-contents)))
                ,array-sym)))))
  
  (defun make-array-with-known-element-type (dimensions element-type info area initial-element adjustable fill-pointer)
    (when (and (consp dimensions)
               (integerp (first dimensions))
               (endp (rest dimensions)))
  