From e32906fedb6a32b0b237e542ce93e5187c88c4ee Mon Sep 17 00:00:00 2001 From: Nathan Froyd Date: Wed, 19 Dec 2012 23:27:32 -0500 Subject: [PATCH] factor out ALLOCATE-VECTOR-WITH-WIDETAG function from MAKE-ARRAY --- src/code/array.lisp | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) 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)) -- 1.7.10.4