X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=4b3aaf3a2a1fa54cddab8281568b6e8e0badb6be;hb=dfa55a883f94470267b626dae77ce7e7dfac3df6;hp=ab01bce7df1177ab342c5ceea1c7f464470f988b;hpb=d147d512602d761a2dcdfded506dd1a8f9a140dc;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index ab01bce..4b3aaf3 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -273,21 +273,21 @@
   #!-sb-fluid (declare (inline node-home-lambda))
   (lambda-environment (node-home-lambda (block-last block))))
 
-;;; Return the Top Level Form number of path, i.e. the ordinal number of
-;;; its orignal source's top-level form in its compilation unit.
+;;; Return the Top Level Form number of path, i.e. the ordinal number
+;;; of its original source's top-level form in its compilation unit.
 (defun source-path-tlf-number (path)
   (declare (list path))
   (car (last path)))
 
-;;; Return the (reversed) list for the path in the orignal source (with the
-;;; TLF number last.)
+;;; Return the (reversed) list for the path in the original source
+;;; (with the Top Level Form number last).
 (defun source-path-original-source (path)
   (declare (list path) (inline member))
   (cddr (member 'original-source-start path :test #'eq)))
 
-;;; Return the Form Number of Path's orignal source inside the Top Level
-;;; Form that contains it. This is determined by the order that we walk the
-;;; subforms of the top level source form.
+;;; Return the Form Number of Path's original source inside the Top
+;;; Level Form that contains it. This is determined by the order that
+;;; we walk the subforms of the top level source form.
 (defun source-path-form-number (path)
   (declare (list path) (inline member))
   (cadr (member 'original-source-start path :test #'eq)))
@@ -323,8 +323,7 @@
 			 options
 			 (lambda (lexenv-lambda default))
 			 (cleanup (lexenv-cleanup default))
-			 (policy (lexenv-policy default))
-			 (interface-policy (lexenv-interface-policy default)))
+			 (policy (lexenv-policy default)))
   (macrolet ((frob (var slot)
 	       `(let ((old (,slot default)))
 		  (if ,var
@@ -336,21 +335,8 @@
      (frob blocks lexenv-blocks)
      (frob tags lexenv-tags)
      (frob type-restrictions lexenv-type-restrictions)
-     lambda cleanup policy interface-policy
+     lambda cleanup policy 
      (frob options lexenv-options))))
-
-;;; Return a POLICY that defaults any unsupplied optimize qualities in
-;;; the INTERFACE-POLICY with the corresponding ones from the POLICY.
-(defun make-interface-policy (lexenv)
-  (declare (type lexenv lexenv))
-  (let ((ipolicy (lexenv-interface-policy lexenv))
-	(policy (lexenv-policy lexenv)))
-    (let ((result policy))
-      (dolist (quality '(speed safety space))
-	(let ((iquality-entry (assoc quality ipolicy)))
-	  (when iquality-entry
-	    (push iquality-entry result))))
-      result)))
 
 ;;;; flow/DFO/component hackery
 
@@ -1644,7 +1630,7 @@
 (defun compiler-note (format-string &rest format-args)
   (unless (if *compiler-error-context*
 	      (policy *compiler-error-context* (= inhibit-warnings 3))
-	      (policy nil (= inhibit-warnings 3)))
+	      (policy *lexenv* (= inhibit-warnings 3)))
     (incf *compiler-note-count*)
     (print-compiler-message (format nil "note: ~A" format-string)
 			    format-args))
@@ -1745,9 +1731,8 @@
 ;;; the compiler, hence the BOUNDP check.
 (defun note-undefined-reference (name kind)
   (unless (and
-	   ;; (POLICY NIL ..) isn't well-defined except in IR1
-	   ;; conversion. This BOUNDP test seems to be a test for
-	   ;; whether IR1 conversion is going on.
+	   ;; Check for boundness so we don't blow up if we're called
+	   ;; when IR1 conversion isn't going on.
 	   (boundp '*lexenv*)
 	   ;; FIXME: I'm pretty sure the INHIBIT-WARNINGS test below
 	   ;; isn't a good idea; we should have INHIBIT-WARNINGS
@@ -1755,7 +1740,7 @@
 	   ;; sure what the BOUNDP '*LEXENV* test above is for; it's
 	   ;; likely a good idea, but it probably deserves an
 	   ;; explanatory comment.
-	   (policy nil (= inhibit-warnings 3)))
+	   (policy *lexenv* (= inhibit-warnings 3)))
     (let* ((found (dolist (warning *undefined-warnings* nil)
 		    (when (and (equal (undefined-warning-name warning) name)
 			       (eq (undefined-warning-kind warning) kind))
@@ -1836,9 +1821,8 @@
 (defun %event (info node)
   (incf (event-info-count info))
   (when (and (>= (event-info-level info) *event-note-threshold*)
-	     (if node
-		 (policy node (= inhibit-warnings 0))
-		 (policy nil (= inhibit-warnings 0))))
+	     (policy (or node *lexenv*)
+		     (= inhibit-warnings 0)))
     (let ((*compiler-error-context* node))
       (compiler-note (event-info-description info))))