From f1ae5a121f73dbc9b51052a177991d891c7a124e Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Fri, 23 Nov 1990 16:21:05 +0000 Subject: [PATCH] Changed the make-array transform to simplify the nwords computation as much as possible instead of relying on (nonexistent) optimizers to simpilfy it later down the line. Also fixed a spelling error. --- compiler/array-tran.lisp | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/compiler/array-tran.lisp b/compiler/array-tran.lisp index 7a60fa008..eb9effc30 100644 --- a/compiler/array-tran.lisp +++ b/compiler/array-tran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.5 1990/11/16 06:01:07 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.6 1990/11/23 16:21:05 wlott Exp $ ;;; ;;; This file contains array specific optimizers and transforms. ;;; @@ -196,18 +196,18 @@ (give-up "Cannot open-code creation of ~S" spec)) (when (csubtypep eltype-type (specifier-type (car info))) (return (values-list (cdr info))))) - (let ((constructor - `(truly-the - ,spec - (allocate-vector - ,typecode - length - (truncate (+ (* ,(if (eq 'vm:simple-string-type typecode) - '(1+ length) - 'length) - ,element-size) - (1- vm:word-bits)) - vm:word-bits))))) + (let* ((nwords-form + (if (>= element-size vm:word-bits) + `(* length ,(/ element-size vm:word-bits)) + (let ((elements-per-word (/ 32 element-size))) + `(truncate (+ length + ,(if (eq 'vm:simple-string-type typecode) + elements-per-word + (1- elements-per-word))) + ,elements-per-word)))) + (constructor + `(truly-the ,spec + (allocate-vector ,typecode length ,nwords-form)))) (values (if (and default-initial-element (or (null initial-element) @@ -231,7 +231,7 @@ (give-up "Dimension list not constant; cannot open code array creation")) (let ((dims (continuation-value dims))) (unless (every #'integerp dims) - (give-up "Dimension list contains sometime other than an integer: ~S" + (give-up "Dimension list contains something other than an integer: ~S" dims)) (if (= (length dims) 1) `(make-array ',(car dims) -- GitLab