From: Nikodemus Siivola Date: Thu, 11 Mar 2010 13:53:49 +0000 (+0000) Subject: 1.0.36.19: WITH-COMPILATION-UNIT :POLICY X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=5f466d0621f0cb549b80d48abfa7af8d7dc01a34;p=sbcl.git 1.0.36.19: WITH-COMPILATION-UNIT :POLICY * Allows binding *POLICY* and *POLICY-RESTRICTIONS*. Read the docstring and weep. * Document both RESTRICT-COMPILER-POLICY and WITH-COMPILER-POLICY in the manual. * Also make DECLARATION-INFORMATION heed *POLICY-RESTRICTIONS*. Based on patch by: Tobias C. Rittweiler Fixes Launchpad bug #313337. --- diff --git a/NEWS b/NEWS index 1ed9aa5..8137cca 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,8 @@ changes relative to sbcl-1.0.36: * enhancement: Backtrace from THROW to uncaught tag on x86oids now shows stack frame thrown from. + * enhancement: WITH-COMPILATION-UNIT :POLICY allows restricting changes to + compiler optimization qualities inside dynamic extent of its body. * optimization: SLOT-VALUE and (SETF SLOT-VALUE) take advantage of constraint propgation, allowing better compilation eg. when used to access structures with WITH-SLOTS. (lp#520366) @@ -31,6 +33,8 @@ changes relative to sbcl-1.0.36: threads started during profiling. (lp#472499) * bug fix: SB-INTROSPECT test failure when building without SB-EVAL feature. (lp#535658) + * bug fix: SB-CLTL2:DECLARATION-INFORMATION did not take + SB-EXT:RESTRICT-COMPILER-POLICY into account. (lp#313337) changes in sbcl-1.0.36 relative to sbcl-1.0.35: * new feature: SB-EXT:TYPEXPAND-1, SB-EXT:TYPEXPAND, and diff --git a/contrib/sb-cltl2/env.lisp b/contrib/sb-cltl2/env.lisp index 52152d9..0bd6c1b 100644 --- a/contrib/sb-cltl2/env.lisp +++ b/contrib/sb-cltl2/env.lisp @@ -389,7 +389,7 @@ the condition types that have been muffled." (let ((policy (sb-c::lexenv-policy env))) (collect ((res)) (dolist (name sb-c::*policy-qualities*) - (res (list name (cdr (assoc name policy))))) + (res (list name (sb-c::policy-quality policy name)))) (loop for (name . nil) in sb-c::*policy-dependent-qualities* do (res (list name (sb-c::policy-quality policy name)))) (res)))) diff --git a/contrib/sb-cltl2/tests.lisp b/contrib/sb-cltl2/tests.lisp index f813117..e32a20a 100644 --- a/contrib/sb-cltl2/tests.lisp +++ b/contrib/sb-cltl2/tests.lisp @@ -65,6 +65,8 @@ (macroexpand-all '(symbol-macrolet ((srlt '(nil zool))) (testr))) (symbol-macrolet ((srlt '(nil zool))) 'zool)) +;;;; DECLARATION-INFORMATION + (defmacro dinfo (thing &environment env) `',(declaration-information thing env)) @@ -90,6 +92,27 @@ (def compilation-speed) (def space)) + +(deftest declaration-information.restrict-compiler-policy.1 + (with-compilation-unit (:policy '(optimize) :override t) + (restrict-compiler-policy 'speed 3) + (eval '(cadr (assoc 'speed (dinfo optimize))))) + 3) + +(deftest declaration-information.restrict-compiler-policy.2 + (with-compilation-unit (:policy '(optimize) :override t) + (restrict-compiler-policy 'speed 3) + (locally (declare (optimize (speed 2))) + (cadr (assoc 'speed (dinfo optimize))))) + 2) + +(deftest declaration-information.restrict-compiler-policy.3 + (locally (declare (optimize (speed 2))) + (with-compilation-unit (:policy '(optimize) :override t) + (restrict-compiler-policy 'speed 3) + (cadr (assoc 'speed (dinfo optimize))))) + 2) + (deftest declaration-information.muffle-conditions.default (dinfo sb-ext:muffle-conditions) nil) diff --git a/doc/manual/compiler.texinfo b/doc/manual/compiler.texinfo index 0c03d98..685acd0 100644 --- a/doc/manual/compiler.texinfo +++ b/doc/manual/compiler.texinfo @@ -924,6 +924,10 @@ is to slow the program by causing cache misses or even swapping. @c _(end of section on compiler policy) @c _--> +@include fun-sb-ext-describe-compiler-policy.texinfo +@include fun-sb-ext-restrict-compiler-policy.texinfo +@include macro-common-lisp-with-compilation-unit.texinfo + @node Compiler Errors @comment node-name, next, previous, up @section Compiler Errors diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index c74674d..959d43e 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -689,6 +689,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." ;; ..and inspector of compiler policy "DESCRIBE-COMPILER-POLICY" "RESTRICT-COMPILER-POLICY" + "WITH-COMPILER-POLICY" ;; a special form for breaking out of our "declarations ;; are assertions" default diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 993bd7f..102a843 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -136,60 +136,102 @@ (defmacro sb!xc:with-compilation-unit (options &body body) #!+sb-doc - "WITH-COMPILATION-UNIT ({Key Value}*) Form* - This form affects compilations that take place within its dynamic extent. It - is intended to be wrapped around the compilation of all files in the same - system. These keywords are defined: - - :OVERRIDE Boolean-Form - One of the effects of this form is to delay undefined warnings - until the end of the form, instead of giving them at the end of each - compilation. If OVERRIDE is NIL (the default), then the outermost - WITH-COMPILATION-UNIT form grabs the undefined warnings. Specifying - OVERRIDE true causes that form to grab any enclosed warnings, even if - it is enclosed by another WITH-COMPILATION-UNIT. - - :SOURCE-PLIST Plist-Form - Attaches the value returned by the Plist-Form to internal debug-source - information of functions compiled in within the dynamic contour. - Primarily for use by development environments, in order to eg. associate - function definitions with editor-buffers. Can be accessed as - SB-INTROSPECT:DEFINITION-SOURCE-PLIST. If multiple, nested - WITH-COMPILATION-UNITs provide :SOURCE-PLISTs, they are appended - togather, innermost left. If Unaffected by :OVERRIDE." + "Affects compilations that take place within its dynamic extent. It is +intended to be eg. wrapped around the compilation of all files in the same system. + +Following options are defined: + + :OVERRIDE Boolean-Form + One of the effects of this form is to delay undefined warnings until the + end of the form, instead of giving them at the end of each compilation. + If OVERRIDE is NIL (the default), then the outermost + WITH-COMPILATION-UNIT form grabs the undefined warnings. Specifying + OVERRIDE true causes that form to grab any enclosed warnings, even if it + is enclosed by another WITH-COMPILATION-UNIT. + + :POLICY Optimize-Declaration-Form + Provides dynamic scoping for global compiler optimization qualities and + restrictions, limiting effects of subsequent OPTIMIZE proclamations and + calls to SB-EXT:RESTRICT-COMPILER-POLICY to the dynamic scope of BODY. + + If OVERRIDE is false, specified POLICY is merged with current global + policy. If OVERRIDE is true, current global policy, including any + restrictions, is discarded in favor of the specified POLICY. + + Supplying POLICY NIL is equivalent to the option not being supplied at + all, ie. dynamic scoping of policy does not take place. + + This option is an SBCL specific EXPERIMENTAL extension: Interface + subject to change. + + Examples: + + ;; Prevent OPTIMIZE proclamations from file leaking, and + ;; restrict SAFETY to 3 for the LOAD -- otherwise uses the + ;; current global policy. + (with-compilation-unit (:policy '(optimize)) + (restrict-compiler-policy 'safety 3) + (load \"foo.lisp\")) + + ;; Load using default policy instead of the current global one, except + ;; for DEBUG 3. + (with-compilation-unit (:policy '(optimize debug) :override t) + (load \"foo.lisp\")) + + ;; Same as if :POLICY had not been specified at all: SAFETY 3 + ;; leaks outside WITH-COMPILATION-UNIT. + (with-compilation-unit (:policy nil) + (declaim (optimize safety))) + + :SOURCE-PLIST Plist-Form + Attaches the value returned by the Plist-Form to internal debug-source + information of functions compiled in within the dynamic contour. + Primarily for use by development environments, in order to eg. associate + function definitions with editor-buffers. Can be accessed as + SB-INTROSPECT:DEFINITION-SOURCE-PLIST. If multiple, nested + WITH-COMPILATION-UNITs provide :SOURCE-PLISTs, they are appended + togather, innermost left. Unaffected by :OVERRIDE. + + This SBCL is and specific extension." `(%with-compilation-unit (lambda () ,@body) ,@options)) (defvar *source-plist* nil) -(defun %with-compilation-unit (fn &key override source-plist) +(defun %with-compilation-unit (fn &key override policy source-plist) (declare (type function fn)) - (let ((succeeded-p nil) - (*source-plist* (append source-plist *source-plist*))) - (if (and *in-compilation-unit* (not override)) - ;; Inside another WITH-COMPILATION-UNIT, a WITH-COMPILATION-UNIT is - ;; ordinarily (unless OVERRIDE) basically a no-op. - (unwind-protect - (multiple-value-prog1 (funcall fn) (setf succeeded-p t)) - (unless succeeded-p - (incf *aborted-compilation-unit-count*))) - (let ((*aborted-compilation-unit-count* 0) - (*compiler-error-count* 0) - (*compiler-warning-count* 0) - (*compiler-style-warning-count* 0) - (*compiler-note-count* 0) - (*undefined-warnings* nil) - (*in-compilation-unit* t)) - (with-world-lock () - (handler-bind ((parse-unknown-type - (lambda (c) - (note-undefined-reference - (parse-unknown-type-specifier c) - :type)))) - (unwind-protect - (multiple-value-prog1 (funcall fn) (setf succeeded-p t)) - (unless succeeded-p - (incf *aborted-compilation-unit-count*)) - (summarize-compilation-unit (not succeeded-p))))))))) + (flet ((with-it () + (let ((succeeded-p nil) + (*source-plist* (append source-plist *source-plist*))) + (if (and *in-compilation-unit* (not override)) + ;; Inside another WITH-COMPILATION-UNIT, a WITH-COMPILATION-UNIT is + ;; ordinarily (unless OVERRIDE) basically a no-op. + (unwind-protect + (multiple-value-prog1 (funcall fn) (setf succeeded-p t)) + (unless succeeded-p + (incf *aborted-compilation-unit-count*))) + (let ((*aborted-compilation-unit-count* 0) + (*compiler-error-count* 0) + (*compiler-warning-count* 0) + (*compiler-style-warning-count* 0) + (*compiler-note-count* 0) + (*undefined-warnings* nil) + (*in-compilation-unit* t)) + (with-world-lock () + (handler-bind ((parse-unknown-type + (lambda (c) + (note-undefined-reference + (parse-unknown-type-specifier c) + :type)))) + (unwind-protect + (multiple-value-prog1 (funcall fn) (setf succeeded-p t)) + (unless succeeded-p + (incf *aborted-compilation-unit-count*)) + (summarize-compilation-unit (not succeeded-p)))))))))) + (if policy + (let ((*policy* (process-optimize-decl policy (unless override *policy*))) + (*policy-restrictions* (unless override *policy-restrictions*))) + (with-it)) + (with-it)))) ;;; Is NAME something that no conforming program can rely on ;;; defining? diff --git a/src/compiler/policy.lisp b/src/compiler/policy.lisp index 37ba0a7..34b027d 100644 --- a/src/compiler/policy.lisp +++ b/src/compiler/policy.lisp @@ -36,6 +36,8 @@ was MIN instead. This is intended to be used interactively, to facilitate recompiling large bodies of code with eg. a known minimum safety. +See also :POLICY option in WITH-COMPILATION-UNIT. + EXPERIMENTAL INTERFACE: Subject to change." (declare (type policy-quality min)) (when quality diff --git a/version.lisp-expr b/version.lisp-expr index 7034605..97e21db 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.36.18" +"1.0.36.19"