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*))
(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*)
;; 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))
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
;;; 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)
;;; *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)))))
;;; 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
#+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)
;;; 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
;; 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
'((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).
;;;
;;; 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).
;;; 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)
(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
(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)
;;; 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"
projects / sbcl.git / commitdiff