From fa8962d732057015fbb9a2f8a08ea8d5299b50dd Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Tue, 2 Jan 2001 00:44:30 +0000 Subject: [PATCH] 0.6.9.17: deleted *INITIAL-POLICY* and *INITIAL-INTERFACE-POLICY*, since they seem irrelevant in the ANSI world of 1 source file per compile command deleted *INITIAL-PACKAGE* for the same reason renamed *DEFAULT-POLICY* and *DEFAULT-INTERFACE-POLICY* to *POLICY* and *INTERFACE-POLICY* made PROCESS-OPTIMIZE-DECL remove duplicate alist entries --- src/code/target-load.lisp | 4 ++-- src/compiler/early-c.lisp | 4 ++-- src/compiler/lexenv.lisp | 4 ++-- src/compiler/main.lisp | 57 ++++++++++++++++++-------------------------- src/compiler/policy.lisp | 35 ++++++++++++++------------- src/compiler/proclaim.lisp | 14 +++++++---- version.lisp-expr | 2 +- 7 files changed, 58 insertions(+), 62 deletions(-) diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index 5667e03..17a69b7 100644 --- a/src/code/target-load.lisp +++ b/src/code/target-load.lisp @@ -170,8 +170,8 @@ source, the result of evaluating each top-level form is printed. The default is *LOAD-PRINT*." - (let ((sb!c::*default-policy* sb!c::*default-policy*) - (sb!c::*default-interface-policy* sb!c::*default-interface-policy*) + (let ((sb!c::*policy* sb!c::*policy*) + (sb!c::*interface-policy* sb!c::*interface-policy*) (*package* (sane-package)) (*readtable* *readtable*) (*load-depth* (1+ *load-depth*)) diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp index 205eccb..62b7329 100644 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -77,8 +77,8 @@ (defvar *count-vop-usages*) (defvar *current-path*) (defvar *current-component*) -(defvar *default-policy*) -(defvar *default-interface-policy*) +(defvar *policy*) +(defvar *interface-policy*) (defvar *dynamic-counts-tn*) (defvar *elsewhere*) (defvar *event-info*) diff --git a/src/compiler/lexenv.lisp b/src/compiler/lexenv.lisp index ae3ffba..7d95e9f 100644 --- a/src/compiler/lexenv.lisp +++ b/src/compiler/lexenv.lisp @@ -62,11 +62,11 @@ ;; to get CLEANUP defined in time for the cross-compiler. (cleanup nil) ;; the current OPTIMIZE policy - (policy *default-policy* :type policy) + (policy *policy* :type policy) ;; the policy that takes effect in XEPs and related syntax parsing ;; functions. Slots in this policy may be null to indicate that the ;; normal value in effect. - (interface-policy *default-interface-policy* :type policy) + (interface-policy *interface-policy* :type policy) ;; an alist of miscellaneous options that are associated with the ;; lexical environment (options nil :type list)) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 5fb8f4d..d1c14a3 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -101,18 +101,13 @@ sb!xc:*compile-file-pathname* sb!xc:*compile-file-truename*)) -;;; the values of *PACKAGE* and policy when compilation started -(defvar *initial-package*) -(defvar *initial-policy*) -(defvar *initial-interface-policy*) - -;;; The source-info structure for the current compilation. This is null -;;; globally to indicate that we aren't currently in any identifiable -;;; compilation. +;;; the SOURCE-INFO structure for the current compilation. This is +;;; null globally to indicate that we aren't currently in any +;;; identifiable compilation. (defvar *source-info* nil) -;;; True if we are within a WITH-COMPILATION-UNIT form (which normally -;;; causes nested uses to be no-ops). +;;; This is true if we are within a WITH-COMPILATION-UNIT form (which +;;; normally causes nested uses to be no-ops). (defvar *in-compilation-unit* nil) ;;; Count of the number of compilation units dynamically enclosed by @@ -806,15 +801,13 @@ ;;; rebinding around each file. ;;; ;;; FIXME: Since we now do the standard ANSI thing of only one file -;;; per compile (unlike the CMU CL extended COMPILE-FILE) can't this -;;; complexity (including ADVANCE-SOURCE-FILE) go away? +;;; per compile (unlike the CMU CL extended COMPILE-FILE) this code is +;;; becoming stale, and the remaining bits of it (and the related code +;;; in ADVANCE-SOURCE-FILE) can go away. (defun get-source-stream (info) (declare (type source-info info)) (cond ((source-info-stream info)) (t - (setf *package* *initial-package* - *default-policy* *initial-policy* - *default-interface-policy* *initial-interface-policy*) (let* ((finfo (first (source-info-current-file info))) (name (file-info-name finfo))) (setq sb!xc:*compile-file-truename* name) @@ -892,8 +885,8 @@ ;;; *TOP-LEVEL-LAMBDAS* instead. (defun convert-and-maybe-compile (form path) (declare (list path)) - (let* ((*lexenv* (make-lexenv :policy *default-policy* - :interface-policy *default-interface-policy*)) + (let* ((*lexenv* (make-lexenv :policy *policy* + :interface-policy *interface-policy*)) (tll (ir1-top-level form path nil))) (cond ((eq *block-compile* t) (push tll *top-level-lambdas*)) (t (compile-top-level (list tll) nil))))) @@ -915,23 +908,22 @@ ;;; Process a top-level use of LOCALLY. We parse declarations and then ;;; recursively process the body. -;;; -;;; Binding *DEFAULT-xxx-POLICY* is pretty much of a hack, since it -;;; causes LOCALLY to "capture" enclosed proclamations. It is -;;; necessary because CONVERT-AND-MAYBE-COMPILE uses the value of -;;; *DEFAULT-POLICY* as the policy. The need for this hack is due to -;;; the quirk that there is no way to represent in a POLICY that an -;;; optimize quality came from the default. -;;; FIXME: Ideally, something should be done so that DECLAIM inside LOCALLY -;;; works OK. Failing that, at least we could issue a warning instead -;;; of silently screwing up. (defun process-top-level-locally (form path) (declare (list path)) (multiple-value-bind (forms decls) (sb!sys:parse-body (cdr form) nil) (let* ((*lexenv* (process-decls decls nil nil (make-continuation))) - (*default-policy* (lexenv-policy *lexenv*)) - (*default-interface-policy* (lexenv-interface-policy *lexenv*))) + ;; Binding *xxx-POLICY* is pretty much of a hack, since it + ;; causes LOCALLY to "capture" enclosed proclamations. It + ;; is necessary because CONVERT-AND-MAYBE-COMPILE uses the + ;; value of *POLICY* as the policy. The need for this hack + ;; is due to the quirk that there is no way to represent in + ;; a POLICY that an optimize quality came from the default. + ;; FIXME: Ideally, something should be done so that DECLAIM + ;; inside LOCALLY works OK. Failing that, at least we could + ;; issue a warning instead of silently screwing up. + (*policy* (lexenv-policy *lexenv*)) + (*interface-policy* (lexenv-interface-policy *lexenv*))) (process-top-level-progn forms path)))) ;;; Force any pending top-level forms to be compiled and dumped so @@ -1356,11 +1348,8 @@ #+nil (*compiler-note-count* 0) (*block-compile* *block-compile-argument*) (*package* (sane-package)) - (*initial-package* (sane-package)) - (*initial-policy* *default-policy*) - (*initial-interface-policy* *default-interface-policy*) - (*default-policy* *initial-policy*) - (*default-interface-policy* *initial-interface-policy*) + (*policy* *policy*) + (*interface-policy* *interface-policy*) (*lexenv* (make-null-lexenv)) (*converting-for-interpreter* nil) (*source-info* info) diff --git a/src/compiler/policy.lisp b/src/compiler/policy.lisp index aa2bb64..9cd204a 100644 --- a/src/compiler/policy.lisp +++ b/src/compiler/policy.lisp @@ -16,9 +16,10 @@ ;;; CMU CL used a special STRUCTURE-OBJECT type POLICY to represent ;;; the state of optimization policy at any point in compilation. This -;;; became a little unwieldy, especially because of cold init issues -;;; for structures and structure accessors, so in SBCL we use an alist -;;; instead. +;;; was a natural choice, but in SBCL it became a little troublesome +;;; because of stupid technicalities involving the cold initialization +;;; of structure LAYOUTs and structure accessors, so now we just use +;;; alists instead. (def!type policy () 'list) ;;; names of recognized optimization qualities which don't have @@ -39,16 +40,16 @@ ;; FIXME: Uncomment this when OPTIMIZE-INTERFACE goes away. #|(member name *policy-defaulting-qualities* :key #'car)|#)) -;;; *DEFAULT-POLICY* holds the current global compiler policy -;;; information, as an alist mapping from optimization quality name to -;;; quality value. Inside the scope of declarations, new entries are -;;; added at the head of the alist. +;;; *POLICY* holds the current global compiler policy information, as +;;; an alist mapping from optimization quality name to quality value. +;;; Inside the scope of declarations, new entries are added at the +;;; head of the alist. ;;; -;;; *DEFAULT-INTERFACE-POLICY* holds any values specified by an -;;; OPTIMIZE-INTERFACE declaration. -(declaim (type policy *default-policy* *default-interface-policy*)) -(defvar *default-policy*) ; initialized in cold init -(defvar *default-interface-policy*) ; initialized in cold init +;;; *INTERFACE-POLICY* holds global interface policy, represented the +;;; same way as in *DEFAULT-POLICY*. +(declaim (type policy *policy* *interface-policy*)) +(defvar *policy*) ; initialized in cold init +(defvar *interface-policy*) ; initialized in cold init ;;; This is to be called early in cold init to set things up, and may ;;; also be called again later in cold init in order to reset default @@ -76,14 +77,14 @@ '((interface-speed . speed) (interface-safety . safety))) |# - (setf *default-policy* + (setf *policy* (mapcar (lambda (name) ;; CMU CL didn't use 1 as the default for everything, ;; but since ANSI says 1 is the ordinary value, we do. (cons name 1)) *policy-basic-qualities*)) - (setf *default-interface-policy* - *default-policy*)) + (setf *interface-policy* + *policy*)) ;;; On the cross-compilation host, we initialize immediately (not ;;; waiting for "cold init", since cold init doesn't exist on ;;; cross-compilation host). @@ -125,8 +126,8 @@ ;;; ;;; Evaluate EXPR in terms of the current optimization policy for ;;; NODE, or if NODE is NIL, in terms of the current policy as defined -;;; by *DEFAULT-POLICY* and *CURRENT-POLICY*. (Using NODE=NIL is only -;;; well-defined during IR1 conversion.) +;;; by *POLICY*. (Using NODE=NIL is only well-defined during +;;; IR1 conversion.) ;;; ;;; EXPR is a form which accesses the policy values by referring to ;;; them by name, e.g. (> SPEED SPACE). diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp index 792c37c..e2be4a2 100644 --- a/src/compiler/proclaim.lisp +++ b/src/compiler/proclaim.lisp @@ -71,7 +71,8 @@ ;;; defaulted from the POLICY argument. (declaim (ftype (function (list policy) policy) process-optimize-decl)) (defun process-optimize-decl (spec policy) - (let ((result policy)) ; may have new entries pushed on it below + (let ((result nil)) + ;; Add new entries from SPEC. (dolist (q-and-v-or-just-q (cdr spec)) (multiple-value-bind (quality raw-value) (if (atom q-and-v-or-just-q) @@ -88,6 +89,11 @@ (t (push (cons quality (rational raw-value)) result))))) + ;; Add any nonredundant entries from old POLICY. + (dolist (old-entry policy) + (unless (assq (car old-entry) result) + (push old-entry result))) + ;; Voila. result)) ;;; ANSI defines the declaration (FOO X Y) to be equivalent to @@ -211,10 +217,10 @@ (declare (ignore layout)) (setf (class-state subclass) :sealed)))))))) (optimize - (setq *default-policy* (process-optimize-decl form *default-policy*))) + (setq *policy* (process-optimize-decl form *policy*))) (optimize-interface - (setq *default-interface-policy* - (process-optimize-decl form *default-interface-policy*))) + (setq *interface-policy* + (process-optimize-decl form *interface-policy*))) ((inline notinline maybe-inline) (dolist (name args) (proclaim-as-function-name name) diff --git a/version.lisp-expr b/version.lisp-expr index 3ab67ce..9e9adf0 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.9.16" +"0.6.9.17" -- 1.7.10.4