From: Nathan Froyd <froydnj@gmail.com>
Date: Thu, 20 Dec 2012 04:27:32 +0000 (-0500)
Subject: factor out ALLOCATE-VECTOR-WITH-WIDETAG function from MAKE-ARRAY
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e32906fedb6a32b0b237e542ce93e5187c88c4ee;p=sbcl.git

factor out ALLOCATE-VECTOR-WITH-WIDETAG function from MAKE-ARRAY
---

diff --git a/src/code/array.lisp b/src/code/array.lisp
index c700d7b..79e7545 100644
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -133,6 +133,21 @@
        (bit #.sb!vm:complex-bit-vector-widetag)
        (t #.sb!vm:complex-vector-widetag)))))
 
+(defun allocate-vector-with-widetag (widetag length n-bits)
+  (declare (type (unsigned-byte 8) widetag)
+           (type index length)
+           (type (integer 0 256) n-bits))
+  (allocate-vector widetag length
+                   (ceiling
+                    (* (if (or (= widetag sb!vm:simple-base-string-widetag)
+                               #!+sb-unicode
+                               (= widetag
+                                  sb!vm:simple-character-string-widetag))
+                           (1+ length)
+                           length)
+                       n-bits)
+                    sb!vm:n-word-bits)))
+
 (defun make-array (dimensions &key
                               (element-type t)
                               (initial-element nil initial-element-p)
@@ -159,18 +174,7 @@
           (declare (type (unsigned-byte 8) type)
                    (type (integer 0 256) n-bits))
           (let* ((length (car dimensions))
-                 (array (allocate-vector
-                         type
-                         length
-                         (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))))
+                 (array (allocate-vector-with-widetag type length n-bits)))
             (declare (type index length))
             (when initial-element-p
               (fill array initial-element))