From: Nathan F. <nf...@us...> - 2012-12-20 04:57:29
|
The branch "master" has been updated in SBCL: via e32906fedb6a32b0b237e542ce93e5187c88c4ee (commit) from daa1d24e742eaabd0c5ce8af3a591779a85e4d2c (commit) - Log ----------------------------------------------------------------- commit e32906fedb6a32b0b237e542ce93e5187c88c4ee Author: Nathan Froyd <fr...@gm...> Date: Wed Dec 19 23:27:32 2012 -0500 factor out ALLOCATE-VECTOR-WITH-WIDETAG function from MAKE-ARRAY --- src/code/array.lisp | 28 ++++++++++++++++------------ 1 files 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)) ----------------------------------------------------------------------- hooks/post-receive -- SBCL |