From 3b3086ad5ad36a66302e1e6c5b7c8246c7963462 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sun, 17 Apr 2005 09:08:34 +0000 Subject: [PATCH] 0.8.21.48: * As suggested by CSR, when (> SAFETY 0) allocate vector on stack only when it provably fits in one page. * Properly order *POLICY-DEPENDENT-QUALITIES*: later qualities may refer earlier. --- src/compiler/policies.lisp | 6 ++++++ src/compiler/policy.lisp | 3 ++- src/compiler/x86/alloc.lisp | 14 ++++++++++++-- version.lisp-expr | 2 +- 4 files changed, 21 insertions(+), 4 deletions(-) diff --git a/src/compiler/policies.lisp b/src/compiler/policies.lisp index 2264f6d..d79a230 100644 --- a/src/compiler/policies.lisp +++ b/src/compiler/policies.lisp @@ -61,6 +61,12 @@ 0) ("no" "maybe" "yes" "yes")) +(define-optimization-quality stack-allocate-vector + (cond ((= stack-allocate-dynamic-extent 0) 0) + ((= safety 0) 3) + (t 2)) + ("no" "maybe" "one page" "yes")) + (define-optimization-quality float-accuracy 3 ("degraded" "full" "full" "full")) diff --git a/src/compiler/policy.lisp b/src/compiler/policy.lisp index d3bfe86..bef5b88 100644 --- a/src/compiler/policy.lisp +++ b/src/compiler/policy.lisp @@ -125,5 +125,6 @@ :values-documentation ',documentation))) (if acons (setf (cdr acons) item) - (push `(,',name . ,item) *policy-dependent-qualities*))) + (setf *policy-dependent-qualities* + (nconc *policy-dependent-qualities* (list `(,',name . ,item)))))) ',name)) diff --git a/src/compiler/x86/alloc.lisp b/src/compiler/x86/alloc.lisp index 88c7af9..8d88174 100644 --- a/src/compiler/x86/alloc.lisp +++ b/src/compiler/x86/alloc.lisp @@ -72,8 +72,18 @@ (:variant t)) ;;;; special-purpose inline allocators -(defoptimizer (allocate-vector stack-allocate-result) ((type length words)) - t) +(defoptimizer (allocate-vector stack-allocate-result) + ((type length words) node) + (ecase (policy node sb!c::stack-allocate-vector) + (0 nil) + ((1 2) + ;; a vector object should fit in one page + (values-subtypep (sb!c::lvar-derived-type words) + (load-time-value + (specifier-type `(integer 0 ,(- (/ *backend-page-size* + n-word-bytes) + vector-data-offset)))))) + (3 t))) (define-vop (allocate-vector) (:args (type :scs (unsigned-reg)) diff --git a/version.lisp-expr b/version.lisp-expr index d3be083..d9ecf0e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.21.47" +"0.8.21.48" -- 1.7.10.4