1 ;;;; compiler optimization policy stuff
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 ;;; a value for an optimization declaration
15 (def!type policy-quality () '(rational 0 3))
17 ;;; CMU CL used a special STRUCTURE-OBJECT type POLICY to represent
18 ;;; the state of optimization policy at any point in compilation. This
19 ;;; was a natural choice, but in SBCL it became a little troublesome
20 ;;; because of stupid technicalities involving the cold initialization
21 ;;; of structure LAYOUTs and structure accessors, so now we just use
23 (def!type policy () 'list)
25 ;;; names of recognized optimization qualities which don't have
26 ;;; special defaulting behavior
27 (defvar *policy-basic-qualities*) ; (initialized at cold init)
29 ;;; FIXME: I'd like to get rid of DECLAIM OPTIMIZE-INTERFACE in favor
30 ;;; of e.g. (DECLAIM (OPTIMIZE (INTERFACE-SPEED 2) (INTERFACE-SAFETY 3))).
32 ;;; a list of conses (DEFAULTING-QUALITY . DEFAULT-QUALITY) of qualities
33 ;;; which default to other qualities when undefined, e.g. interface
34 ;;; speed defaulting to basic speed
35 (defvar *policy-defaulting-qualities*)
38 (defun optimization-quality-p (name)
39 (or (member name *policy-basic-qualities*)
40 ;; FIXME: Uncomment this when OPTIMIZE-INTERFACE goes away.
41 #|(member name *policy-defaulting-qualities* :key #'car)|#))
43 ;;; *POLICY* holds the current global compiler policy information, as
44 ;;; an alist mapping from optimization quality name to quality value.
45 ;;; Inside the scope of declarations, new entries are added at the
46 ;;; head of the alist.
48 ;;; *INTERFACE-POLICY* holds global interface policy, represented the
49 ;;; same way as in *DEFAULT-POLICY*.
50 (declaim (type policy *policy* *interface-policy*))
51 (defvar *policy*) ; initialized in cold init
52 (defvar *interface-policy*) ; initialized in cold init
54 ;;; This is to be called early in cold init to set things up, and may
55 ;;; also be called again later in cold init in order to reset default
56 ;;; optimization policy back to default values after toplevel PROCLAIM
57 ;;; OPTIMIZE forms have messed with it.
58 (defun !policy-cold-init-or-resanify ()
59 (setf *policy-basic-qualities*
60 '(;; ANSI standard qualities
68 ;; FIXME: INHIBIT-WARNINGS is a misleading name for this.
69 ;; Perhaps BREVITY would be better. But the ideal name would
70 ;; have connotations of suppressing not warnings but only
71 ;; optimization-related notes, which is already mostly the
72 ;; behavior, and should probably become the exact behavior.
73 ;; Perhaps INHIBIT-NOTES?
76 (setf *policy-defaulting-qualities*
77 '((interface-speed . speed)
78 (interface-safety . safety)))
81 (mapcar (lambda (name)
82 ;; CMU CL didn't use 1 as the default for everything,
83 ;; but since ANSI says 1 is the ordinary value, we do.
85 *policy-basic-qualities*))
86 (setf *interface-policy*
88 ;;; On the cross-compilation host, we initialize immediately (not
89 ;;; waiting for "cold init", since cold init doesn't exist on
90 ;;; cross-compilation host).
91 #+sb-xc-host (!policy-cold-init-or-resanify)
93 ;;; Is X the name of an optimization quality?
94 (defun policy-quality-name-p (x)
95 (memq x *policy-basic-qualities*))
97 ;;; Look up a named optimization quality in POLICY. This is only
98 ;;; called by compiler code for known-valid QUALITY-NAMEs, e.g. SPEED;
99 ;;; it's an error if it's called for a quality which isn't defined.
101 ;;; FIXME: After this is debugged, it should get a DEFKNOWN.
102 #+nil (declaim (ftype (function (policy symbol) policy-quality)))
103 (defun policy-quality (policy quality-name)
104 (let ((acons (assoc quality-name policy)))
106 (error "Argh! no such optimization quality ~S in~% ~S"
107 quality-name policy))
108 (let ((result (cdr acons)))
109 (unless (typep result '(rational 0 3))
110 (error "Argh! bogus optimization quality ~S" acons))
113 ;;; Return a list of symbols naming the optimization qualities which
115 (defun policy-qualities-used-by (expr)
117 (labels ((recurse (x)
119 (map nil #'recurse x)
120 (when (policy-quality-name-p x)
121 (pushnew x result)))))
125 ;;; syntactic sugar for querying optimization policy qualities
127 ;;; Evaluate EXPR in terms of the current optimization policy for
128 ;;; NODE, or if NODE is NIL, in terms of the current policy as defined
129 ;;; by *POLICY*. (Using NODE=NIL is only well-defined during
132 ;;; EXPR is a form which accesses the policy values by referring to
133 ;;; them by name, e.g. (> SPEED SPACE).
134 (defmacro policy (node expr)
135 (let* ((n-policy (gensym))
136 (used-qualities (policy-qualities-used-by expr))
137 (binds (mapcar (lambda (name)
138 `(,name (policy-quality ,n-policy ',name)))
140 `(let* ((,n-policy (lexenv-policy ,(if node