From 62da111c412394c9099cc8d35cd6dc06c5bf867b Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 4 Feb 2008 15:40:32 +0000
Subject: [PATCH] 1.0.14.16: add explicit CHECK-CONSTANT-MODIFICATION policy

 * Allows using SB-COVER with (RESTRICT-COMPILER-POLICY 'SAFETY 3).
---
 src/compiler/ir1opt.lisp   | 2 +-
 src/compiler/ir1tran.lisp  | 3 ++-
 src/compiler/policies.lisp | 6 ++++++
 version.lisp-expr          | 2 +-
 4 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 3a495b496..e0c4a7218 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -697,7 +697,7 @@
          (when (and fun
                     ;; If somebody is really sure that they want to modify
                     ;; constants, let them.
-                    (policy node (> safety 0)))
+                    (policy node (> check-constant-modification 0)))
            (let ((destroyed-constant-args (funcall fun args)))
              (when destroyed-constant-args
                (let ((*compiler-error-context* node))
diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 18619b03a..903a0a673 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -876,7 +876,8 @@
                              `(locally
                                   (declare (optimize speed
                                                      (safety 0)
-                                                     (debug 0)))
+                                                     (debug 0)
+                                                     (check-constant-modification 0)))
                                 ;; We're being naughty here, and
                                 ;; modifying constant data. That's ok,
                                 ;; we know what we're doing.
diff --git a/src/compiler/policies.lisp b/src/compiler/policies.lisp
index 1ee4f1034..9164e6b0c 100644
--- a/src/compiler/policies.lisp
+++ b/src/compiler/policies.lisp
@@ -11,6 +11,12 @@
 
 (in-package "SB!C")
 
+(define-optimization-quality check-constant-modification
+    safety
+  ("no" "maybe" "yes" "yes")
+  "Control whether the compiler should check for constant
+modification. Defaults to SAFETY.")
+
 (define-optimization-quality type-check
     ;; FIXME: grepping the tree for "policy.*safety" yields some
     ;; places which might want to use this instead -- or
diff --git a/version.lisp-expr b/version.lisp-expr
index 91549705e..cc445fd75 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".)
-"1.0.14.15"
+"1.0.14.16"
-- 
2.11.4.GIT