X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fpolicy.lisp;h=bef5b88cc17cc01ebef50745518b1d9f0e59fe2e;hb=2253ebaef8a0a1527d2282a1c10f48c62e0d4a83;hp=ff543cc5b2bbd0fedfef172825b85680bec47ad1;hpb=a74b0bdb483504f6faddf8089f848f61ed94b92a;p=sbcl.git

diff --git a/src/compiler/policy.lisp b/src/compiler/policy.lisp
index ff543cc..bef5b88 100644
--- a/src/compiler/policy.lisp
+++ b/src/compiler/policy.lisp
@@ -22,17 +22,15 @@
 ;;; alists instead.
 (def!type policy () 'list)
 
-(eval-when (#-sb-xc-host :compile-toplevel :load-toplevel :execute)
-  (defstruct policy-dependent-quality
-    name
-    expression
-    getter
-    values-documentation))
+(defstruct policy-dependent-quality
+  name
+  expression
+  getter
+  values-documentation)
 
 ;;; names of recognized optimization policy qualities
 (defvar *policy-qualities*) ; (initialized at cold init)
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defvar *policy-dependent-qualities* nil)) ; alist of POLICY-DEPENDENT-QUALITYs
+(defvar *policy-dependent-qualities* nil) ; alist of POLICY-DEPENDENT-QUALITYs
 
 ;;; Is X the name of an optimization policy quality?
 (defun policy-quality-name-p (x)
@@ -69,10 +67,15 @@
 	  inhibit-warnings))
   (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.
+		  ;; 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-qualities*)))
+		*policy-qualities*))
+  ;; not actually POLICY, but very similar
+  (setf *handled-conditions* nil
+	*disabled-package-locks* nil))
+
 ;;; On the cross-compilation host, we initialize immediately (not
 ;;; waiting for "cold init", since cold init doesn't exist on
 ;;; cross-compilation host).
@@ -82,6 +85,7 @@
 ;;; called by compiler code for known-valid QUALITY-NAMEs, e.g. SPEED;
 ;;; it's an error if it's called for a quality which isn't defined.
 (defun policy-quality (policy quality-name)
+  (aver (policy-quality-name-p quality-name))
   (let* ((acons (assoc quality-name policy))
          (result (or (cdr acons) 1)))
     result))
@@ -121,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))