[Sbcl-commits] CVS: sbcl/src/compiler early-backend.lisp,NONE,1.1 backend.lisp,1.17,1.18 early-c.lisp,1.26,1.27 main.lisp,1.83,1.84

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28225/src/compiler

Modified Files:
	backend.lisp early-c.lisp main.lisp 
Added Files:
	early-backend.lisp 
Log Message:
0.8.8.21:
	Make unknown variables signal a compile-time warning.
	... slightly hacky (if (eq kind :variable) ...) in the
		warning logic itself;
	... rearrange bits of the build to eliminate technically
		undefined forward references;
	... fix for multiple *CURRENT-CATCH-BLOCK* and
		*CURRENT-UNWIND-PROTECT-BLOCK*: we now have one and
		only one of each variable, rather than three


--- NEW FILE: early-backend.lisp ---
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.

(in-package "SB!C")

;;; the maximum number of bytes per page on this system (used by GENESIS)
(defvar *backend-page-size* 0)
(declaim (type index *backend-page-size*))

Index: backend.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/backend.lisp,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -d -r1.17 -r1.18
--- backend.lisp	15 Sep 2002 18:18:12 -0000	1.17
+++ backend.lisp	9 Mar 2004 12:08:40 -0000	1.18
@@ -133,10 +133,6 @@
 ;;; they haven't been installed yet
 (defvar *backend-internal-errors* nil)
 (declaim (type (or simple-vector null) *backend-internal-errors*))
-
-;;; the maximum number of bytes per page on this system (used by GENESIS)
-(defvar *backend-page-size* 0)
-(declaim (type index *backend-page-size*))
 
 ;;;; VM support routines
 

Index: early-c.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/early-c.lisp,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- early-c.lisp	20 Dec 2003 12:08:10 -0000	1.26
+++ early-c.lisp	9 Mar 2004 12:08:40 -0000	1.27
@@ -116,6 +116,11 @@
 (defvar *undefined-warnings*)
 (defvar *warnings-p*)
 
+;;; This lock is seized in the compiler, and related areas: the
+;;; compiler is not presently thread-safe
+(defvar *big-compiler-lock*
+  (sb!thread:make-mutex :name "big compiler lock"))
+
 ;;; unique ID for the next object created (to let us track object
 ;;; identity even across GC, useful for understanding weird compiler
 ;;; bugs where something is supposed to be unique but is instead

Index: main.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/main.lisp,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -d -r1.83 -r1.84
--- main.lisp	20 Dec 2003 12:08:10 -0000	1.83
+++ main.lisp	9 Mar 2004 12:08:40 -0000	1.84
@@ -91,11 +91,6 @@
 ;;; normally causes nested uses to be no-ops).
 (defvar *in-compilation-unit* nil)
 
-;;; This lock is siezed in the same situation: the compiler is not
-;;; presently thread-safe
-(defvar *big-compiler-lock*
-  (sb!thread:make-mutex :name "big compiler lock"))
-
 ;;; Count of the number of compilation units dynamically enclosed by
 ;;; the current active WITH-COMPILATION-UNIT that were unwound out of.
 (defvar *aborted-compilation-unit-count*)
@@ -205,23 +200,34 @@
                        defined later, the code doing so would not be ~
                        portable.~:@>"
 		      kind name)))
-                  (compiler-style-warn "undefined ~(~A~): ~S" kind name)))
+		  (if (eq kind :variable)
+		      (compiler-warn "undefined ~(~A~): ~S" kind name)
+		      (compiler-style-warn "undefined ~(~A~): ~S" kind name))))
 	    (let ((warn-count (length warnings)))
 	      (when (and warnings (> undefined-warning-count warn-count))
 		(let ((more (- undefined-warning-count warn-count)))
-		  (compiler-style-warn
-		   "~W more use~:P of undefined ~(~A~) ~S"
-		   more kind name))))))
+		  (if (eq kind :variable)
+		      (compiler-warn
+		       "~W more use~:P of undefined ~(~A~) ~S"
+		       more kind name)
+		      (compiler-style-warn
+		       "~W more use~:P of undefined ~(~A~) ~S"
+		       more kind name)))))))
 
 	(dolist (kind '(:variable :function :type))
 	  (let ((summary (mapcar #'undefined-warning-name
 				 (remove kind undefs :test-not #'eq
 					 :key #'undefined-warning-kind))))
 	    (when summary
-	      (compiler-style-warn
-	       "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
-		~%  ~{~<~%  ~1:;~S~>~^ ~}"
-	       (cdr summary) kind summary)))))))
+	      (if (eq kind :variable)
+		  (compiler-warn
+		   "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
+		    ~%  ~{~<~%  ~1:;~S~>~^ ~}"
+		   (cdr summary) kind summary)
+		  (compiler-style-warn
+		   "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
+		   ~%  ~{~<~%  ~1:;~S~>~^ ~}"
+		   (cdr summary) kind summary))))))))
 
   (unless (and (not abort-p)
 	       (zerop *aborted-compilation-unit-count*)