X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=c4cf5f5a137c3f4a07760bd96c0fd6b935f86559;hb=2e5263a05f55e2b56a3194ad7853e9ae18ad69af;hp=102a8430e59d507ce574c03a2de5be488631ab1b;hpb=5f466d0621f0cb549b80d48abfa7af8d7dc01a34;p=sbcl.git diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 102a843..c4cf5f5 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -161,38 +161,43 @@ Following options are defined: 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 + 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. + information of functions compiled in within the dynamic extent of BODY. - This SBCL is and specific extension." + Primarily for use by development environments, in order to eg. associate + function definitions with editor-buffers. Can be accessed using + SB-INTROSPECT:DEFINITION-SOURCE-PLIST. + + If an outer WITH-COMPILATION-UNIT form also provide a SOURCE-PLIST, it + is appended to the end of the provided SOURCE-PLIST. Unaffected + by :OVERRIDE. + + This is an SBCL-specific extension. + +Examples: + + ;; Prevent proclamations from the file leaking, and restrict + ;; SAFETY to 3 -- otherwise uses the current global policy. + (with-compilation-unit (:policy '(optimize)) + (restrict-compiler-policy 'safety 3) + (load \"foo.lisp\")) + + ;; 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 + ;; proclamation leaks out from WITH-COMPILATION-UNIT. + (with-compilation-unit (:policy nil) + (declaim (optimize safety)) + (load \"foo.lisp\")) +" `(%with-compilation-unit (lambda () ,@body) ,@options)) (defvar *source-plist* nil) @@ -1092,28 +1097,39 @@ Following options are defined: (source-name (or name '.anonymous.))) (setf (component-name component) (debug-name 'initial-component debug-name-tail) (component-kind component) :initial) - (let* ((locall-fun (let ((*allow-instrumenting* t)) - (funcall #'ir1-convert-lambdalike - lambda-expression - :source-name source-name))) - ;; Convert the XEP using the policy of the real - ;; function. Otherwise the wrong policy will be used for - ;; deciding whether to type-check the parameters of the - ;; real function (via CONVERT-CALL / PROPAGATE-TO-ARGS). - ;; -- JES, 2007-02-27 - (*lexenv* (make-lexenv :policy (lexenv-policy - (functional-lexenv locall-fun)))) - (fun (ir1-convert-lambda (make-xep-lambda-expression locall-fun) + (let* ((fun (let ((*allow-instrumenting* t)) + (funcall #'ir1-convert-lambdalike + lambda-expression + :source-name source-name))) + ;; Convert the XEP using the policy of the real function. Otherwise + ;; the wrong policy will be used for deciding whether to type-check + ;; the parameters of the real function (via CONVERT-CALL / + ;; PROPAGATE-TO-ARGS). -- JES, 2007-02-27 + (*lexenv* (make-lexenv :policy (lexenv-policy (functional-lexenv fun)))) + (xep (ir1-convert-lambda (make-xep-lambda-expression fun) :source-name source-name :debug-name (debug-name 'tl-xep debug-name-tail) :system-lambda t))) (when name - (assert-global-function-definition-type name locall-fun)) - (setf (functional-entry-fun fun) locall-fun - (functional-kind fun) :external - (functional-has-external-references-p locall-fun) t - (functional-has-external-references-p fun) t) - fun))) + (assert-global-function-definition-type name fun)) + (setf (functional-kind xep) :external + (functional-entry-fun xep) fun + (functional-entry-fun fun) xep + (component-reanalyze component) t + (functional-has-external-references-p xep) t) + (reoptimize-component component :maybe) + (locall-analyze-xep-entry-point fun) + ;; Any leftover REFs to FUN outside local calls get replaced with the + ;; XEP. + (substitute-leaf-if (lambda (ref) + (let* ((lvar (ref-lvar ref)) + (dest (when lvar (lvar-dest lvar))) + (kind (when (basic-combination-p dest) + (basic-combination-kind dest)))) + (neq :local kind))) + xep + fun) + xep))) ;;; Compile LAMBDA-EXPRESSION into *COMPILE-OBJECT*, returning a ;;; description of the result. @@ -1229,8 +1245,10 @@ Following options are defined: (*print-level* 2) (*print-pretty* nil)) (with-compiler-io-syntax - (compiler-mumble "~&; ~:[compiling~;converting~] ~S" - *block-compile* form))) + (compiler-mumble + #-sb-xc-host "~&; ~:[compiling~;converting~] ~S" + #+sb-xc-host "~&; ~:[x-compiling~;x-converting~] ~S" + *block-compile* form))) form) ((and finalp (eq :top-level-forms *compile-print*)