Steel Bank Common Lisp

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

Modified Files:
	array.lisp class.lisp cross-char.lisp debug-int.lisp 
	debug.lisp defboot.lisp defpackage.lisp defstruct.lisp 
	deftypes-for-target.lisp early-pprint.lisp early-setf.lisp 
	error.lisp fd-stream.lisp late-format.lisp loop.lisp 
	macros.lisp numbers.lisp package.lisp pprint.lisp print.lisp 
	query.lisp stream.lisp target-alieneval.lisp 
	target-format.lisp target-load.lisp target-pathname.lisp 
	time.lisp 
Log Message:
0.8.16.6:
	Untabification
	... tabs in source code in general are Evil Bad and Wrong, but in
		strings they are especially so in the context of portable
		ANSI Common Lisp, since #\Tab is not a standard character.
	... remove all tabs in strings in the source code, and write some
		defensive code to prevent them from creeping back in again.
	... one or two other whitespacey changes.

	(this patch was brought to you by character_branch)


Index: array.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/array.lisp,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -d -r1.45 -r1.46
--- array.lisp	31 May 2004 00:21:29 -0000	1.45
+++ array.lisp	26 Oct 2004 17:51:12 -0000	1.46
@@ -158,13 +158,13 @@
 	      (fill array initial-element))
 	    (when initial-contents-p
 	      (when initial-element-p
-		(error "can't specify both :INITIAL-ELEMENT and ~
-		:INITIAL-CONTENTS"))
-	      (unless (= length (length initial-contents))
-		(error "There are ~W elements in the :INITIAL-CONTENTS, but ~
-		       the vector length is ~W."
-		       (length initial-contents)
-		       length))
+                (error "can't specify both :INITIAL-ELEMENT and ~
+                       :INITIAL-CONTENTS"))
+              (unless (= length (length initial-contents))
+                (error "There are ~W elements in the :INITIAL-CONTENTS, but ~
+                       the vector length is ~W."
+                       (length initial-contents)
+                       length))
 	      (replace array initial-contents))
 	    array))
 	;; it's either a complex array or a multidimensional array.
@@ -205,7 +205,7 @@
 	  (cond (displaced-to
 		 (when (or initial-element-p initial-contents-p)
 		   (error "Neither :INITIAL-ELEMENT nor :INITIAL-CONTENTS ~
-		   can be specified along with :DISPLACED-TO"))
+                   can be specified along with :DISPLACED-TO"))
 		 (let ((offset (or displaced-index-offset 0)))
 		   (when (> (+ offset total-size)
 			    (array-total-size displaced-to))
@@ -229,7 +229,7 @@
                                initial-element initial-element-p)
   (when (and initial-contents-p initial-element-p)
     (error "cannot supply both :INITIAL-CONTENTS and :INITIAL-ELEMENT to
-	    either MAKE-ARRAY or ADJUST-ARRAY."))
+            either MAKE-ARRAY or ADJUST-ARRAY."))
   (let ((data (if initial-element-p
 		  (make-array total-size
 			      :element-type element-type
@@ -254,13 +254,13 @@
 		      (incf index))
 		     (t
 		      (unless (typep contents 'sequence)
-			(error "malformed :INITIAL-CONTENTS: ~S is not a ~
-				sequence, but ~W more layer~:P needed."
+                        (error "malformed :INITIAL-CONTENTS: ~S is not a ~
+                                sequence, but ~W more layer~:P needed."
 			       contents
 			       (- (length dimensions) axis)))
 		      (unless (= (length contents) (car dims))
-			(error "malformed :INITIAL-CONTENTS: Dimension of ~
-				axis ~W is ~W, but ~S is ~W long."
+                        (error "malformed :INITIAL-CONTENTS: Dimension of ~
+                                axis ~W is ~W, but ~S is ~W long."
 			       axis (car dims) contents (length contents)))
 		      (if (listp contents)
 			  (dolist (content contents)
@@ -708,8 +708,8 @@
       (cond (initial-contents-p
 	     ;; array former contents replaced by INITIAL-CONTENTS
 	     (if (or initial-element-p displaced-to)
-		 (error "INITIAL-CONTENTS may not be specified with ~
-		 the :INITIAL-ELEMENT or :DISPLACED-TO option."))
+                 (error "INITIAL-CONTENTS may not be specified with ~
+                         the :INITIAL-ELEMENT or :DISPLACED-TO option."))
 	     (let* ((array-size (apply #'* dimensions))
 		    (array-data (data-vector-from-inits
 				 dimensions array-size element-type
@@ -729,11 +729,11 @@
 	    (displaced-to
 	     ;; We already established that no INITIAL-CONTENTS was supplied.
 	     (when initial-element
-	       (error "The :INITIAL-ELEMENT option may not be specified ~
-	              with :DISPLACED-TO."))
-	     (unless (subtypep element-type (array-element-type displaced-to))
-	       (error "can't displace an array of type ~S into another of ~
-		       type ~S"
+               (error "The :INITIAL-ELEMENT option may not be specified ~
+                       with :DISPLACED-TO."))
+             (unless (subtypep element-type (array-element-type displaced-to))
+               (error "can't displace an array of type ~S into another of ~
+                       type ~S"
 		      element-type (array-element-type displaced-to)))
 	     (let ((displacement (or displaced-index-offset 0))
 		   (array-size (apply #'* dimensions)))
@@ -813,19 +813,19 @@
 	 (when (array-has-fill-pointer-p old-array)
 	   (when (> (%array-fill-pointer old-array) new-array-size)
 	     (error "cannot ADJUST-ARRAY an array (~S) to a size (~S) that is ~
-		    smaller than its fill pointer (~S)"
+                     smaller than its fill pointer (~S)"
 		    old-array new-array-size (fill-pointer old-array)))
 	   (%array-fill-pointer old-array)))
 	((not (array-has-fill-pointer-p old-array))
 	 (error "cannot supply a non-NIL value (~S) for :FILL-POINTER ~
-		in ADJUST-ARRAY unless the array (~S) was originally ~
- 		created with a fill pointer"
+                 in ADJUST-ARRAY unless the array (~S) was originally ~
+                 created with a fill pointer"
 		fill-pointer
 		old-array))
 	((numberp fill-pointer)
 	 (when (> fill-pointer new-array-size)
 	   (error "can't supply a value for :FILL-POINTER (~S) that is larger ~
-		  than the new length of the vector (~S)"
+                   than the new length of the vector (~S)"
 		  fill-pointer new-array-size))
 	 fill-pointer)
 	((eq fill-pointer t)
@@ -995,10 +995,10 @@
      #!+sb-doc
      ,(format nil
 	      "Perform a bit-wise ~A on the elements of BIT-ARRAY-1 and ~
-	      BIT-ARRAY-2,~%  putting the results in RESULT-BIT-ARRAY. ~
-	      If RESULT-BIT-ARRAY is T,~%  BIT-ARRAY-1 is used. If ~
-	      RESULT-BIT-ARRAY is NIL or omitted, a new array is~%  created. ~
-	      All the arrays must have the same rank and dimensions."
+               BIT-ARRAY-2,~%  putting the results in RESULT-BIT-ARRAY. ~
+               If RESULT-BIT-ARRAY is T,~%  BIT-ARRAY-1 is used. If ~
+               RESULT-BIT-ARRAY is NIL or omitted, a new array is~%  created. ~
+               All the arrays must have the same rank and dimensions."
 	      (symbol-name function))
      (declare (type (array bit) bit-array-1 bit-array-2)
 	      (type (or (array bit) (member t nil)) result-bit-array))

Index: class.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/class.lisp,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -d -r1.52 -r1.53
--- class.lisp	26 Oct 2004 14:49:11 -0000	1.52
+++ class.lisp	26 Oct 2004 17:51:12 -0000	1.53
@@ -358,8 +358,8 @@
 			      inherits
 			      :key #'layout-proper-name)
 		(warn "change in superclasses of class ~S:~%  ~
-		       ~A superclasses: ~S~%  ~
-		       ~A superclasses: ~S"
+                       ~A superclasses: ~S~%  ~
+                       ~A superclasses: ~S"
 		      name
 		      old-context
 		      (map 'list #'layout-proper-name old-inherits)
@@ -370,8 +370,8 @@
 		(when diff
 		  (warn
 		   "in class ~S:~%  ~
-		    ~:(~A~) definition of superclass ~S is incompatible with~%  ~
-		    ~A definition."
+                    ~:(~A~) definition of superclass ~S is incompatible with~%  ~
+                    ~A definition."
 		   name
 		   old-context
 		   (layout-proper-name (svref old-inherits diff))
@@ -380,15 +380,15 @@
 	(let ((old-length (layout-length old-layout)))
 	  (unless (= old-length length)
 	    (warn "change in instance length of class ~S:~%  ~
-		   ~A length: ~W~%  ~
-		   ~A length: ~W"
+                   ~A length: ~W~%  ~
+                   ~A length: ~W"
 		  name
 		  old-context old-length
 		  context length)
 	    t))
 	(unless (= (layout-depthoid old-layout) depthoid)
 	  (warn "change in the inheritance structure of class ~S~%  ~
-		 between the ~A definition and the ~A definition"
+                 between the ~A definition and the ~A definition"
 		name old-context context)
 	  t))))
 
@@ -415,7 +415,7 @@
     ;; system from scratch, so we no longer need this functionality in
     ;; order to maintain the SBCL system by modifying running images.
     (error "The class ~S was not changed, and there's no guarantee that~@
-	    the loaded code (which expected another layout) will work."
+            the loaded code (which expected another layout) will work."
 	   (layout-proper-name layout)))
   (values))
 

Index: cross-char.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/cross-char.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- cross-char.lisp	2 Jul 2003 08:36:57 -0000	1.1
+++ cross-char.lisp	26 Oct 2004 17:51:12 -0000	1.2
@@ -20,7 +20,6 @@
 	(char ascii-standard-chars (- x 32))))
   (defun sb!xc:char-code (character)
     (declare (type standard-char character))
-    ;; FIXME: MacOS X?
     (if (char= character #\Newline)
 	10
 	(+ (position character ascii-standard-chars) 32))))

Index: debug-int.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/debug-int.lisp,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -d -r1.84 -r1.85
--- debug-int.lisp	9 Sep 2004 12:10:13 -0000	1.84
+++ debug-int.lisp	26 Oct 2004 17:51:12 -0000	1.85
@@ -64,8 +64,8 @@
 			 (no-debug-fun-returns-debug-fun condition))))
 	       (format stream
 		       "~&Cannot return values from ~:[frame~;~:*~S~] since ~
-			the debug information lacks details about returning ~
-			values here."
+                        the debug information lacks details about returning ~
+                        values here."
 		       fun)))))
 
 (define-condition no-debug-blocks (debug-condition)
@@ -2816,7 +2816,7 @@
 		     (compiled-debug-fun-compiler-debug-fun what))
 		    :standard)
 	  (error ":FUN-END breakpoints are currently unsupported ~
-		  for the known return convention."))
+                  for the known return convention."))
 
 	(let* ((bpt (%make-breakpoint hook-fun what kind info))
 	       (starter (compiled-debug-fun-end-starter what)))

Index: debug.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/debug.lisp,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -d -r1.70 -r1.71
--- debug.lisp	13 Sep 2004 07:14:41 -0000	1.70
+++ debug.lisp	26 Oct 2004 17:51:12 -0000	1.71
@@ -699,7 +699,7 @@
 				    ;; and output on T seems broken.
 				    (format t
 					    "~&error flushed (because ~
-					     ~S is set)"
+                                             ~S is set)"
 					    '*flush-debug-errors*)
 				    (/show0 "throwing DEBUG-LOOP-CATCHER")
 				    (throw 'debug-loop-catcher nil)))))
@@ -1160,11 +1160,11 @@
 	  (cond
 	   ((not any-p)
 	    (format t "There are no local variables ~@[starting with ~A ~]~
-		       in the function."
+                       in the function."
 		    prefix))
 	   ((not any-valid-p)
 	    (format t "All variables ~@[starting with ~A ~]currently ~
-		       have invalid values."
+                       have invalid values."
 		    prefix))))
 	(write-line "There is no variable information available."))))
 
@@ -1264,7 +1264,7 @@
       (file-position *cached-source-stream* char-offset))
      (t
       (format t "~%; File has been modified since compilation:~%;   ~A~@
-		 ; Using form offset instead of character position.~%"
+                 ; Using form offset instead of character position.~%"
 	      (namestring name))
       (file-position *cached-source-stream* 0)
       (let ((*read-suppress* t))

Index: defboot.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/defboot.lisp,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -d -r1.45 -r1.46
--- defboot.lisp	26 Oct 2004 11:43:50 -0000	1.45
+++ defboot.lisp	26 Oct 2004 17:51:13 -0000	1.46
@@ -378,7 +378,7 @@
 						 binding
 						 :test #'eq))
 			       (warn "Unnamed restart does not have a ~
-					report function: ~S"
+                                      report function: ~S"
 				     binding))
 			     `(make-restart :name ',(car binding)
 					    :function ,(cadr binding)

Index: defpackage.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/defpackage.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- defpackage.lisp	29 Jun 2004 08:50:58 -0000	1.8
+++ defpackage.lisp	26 Oct 2004 17:51:13 -0000	1.9
@@ -154,7 +154,7 @@
       for z = (remove-duplicates (intersection (cdr x)(cdr y) :test #'string=))
       when z do (error 'simple-program-error
 		       :format-control "Parameters ~S and ~S must be disjoint ~
-					but have common elements ~%   ~S"
+                                        but have common elements ~%   ~S"
 		       :format-arguments (list (car x)(car y) z)))))
 
 (defun stringify-name (name kind)

Index: defstruct.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/defstruct.lisp,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -d -r1.70 -r1.71
--- defstruct.lisp	29 Jun 2004 08:50:58 -0000	1.70
+++ defstruct.lisp	26 Oct 2004 17:51:13 -0000	1.71
@@ -614,7 +614,7 @@
 	(symbol
 	 (when (keywordp spec)
 	   (style-warn "Keyword slot name indicates probable syntax ~
-		        error in DEFSTRUCT: ~S."
+                        error in DEFSTRUCT: ~S."
 		       spec))
 	 spec)
 	(cons
@@ -1092,10 +1092,10 @@
       (when (or moved retyped deleted)
 	(warn
 	 "incompatibly redefining slots of structure class ~S~@
-	  Make sure any uses of affected accessors are recompiled:~@
-	  ~@[  These slots were moved to new positions:~%    ~S~%~]~
-	  ~@[  These slots have new incompatible types:~%    ~S~%~]~
-	  ~@[  These slots were deleted:~%    ~S~%~]"
+          Make sure any uses of affected accessors are recompiled:~@
+          ~@[  These slots were moved to new positions:~%    ~S~%~]~
+          ~@[  These slots have new incompatible types:~%    ~S~%~]~
+          ~@[  These slots were deleted:~%    ~S~%~]"
 	 name moved retyped deleted)
 	t))))
 

Index: deftypes-for-target.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/deftypes-for-target.lisp,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- deftypes-for-target.lisp	1 Mar 2004 20:30:24 -0000	1.20
+++ deftypes-for-target.lisp	26 Oct 2004 17:51:13 -0000	1.21
@@ -69,9 +69,9 @@
   #!+sb-doc
   "Type corresponding to the characters required by the standard."
   '(member
-    #\NEWLINE #\SPACE #\! #\" #\# #\$ #\% #\& #\' #\( #\) #\* #\+ #\,
+    #\Newline #\Space #\! #\" #\# #\$ #\% #\& #\' #\( #\) #\* #\+ #\,
     #\- #\. #\/ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\: #\; #\< #\=
-    #\> #\?  #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
+    #\> #\? #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
     #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z #\[ #\\ #\]
     #\^ #\_ #\` #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
     #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z #\{

Index: early-pprint.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-pprint.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- early-pprint.lisp	14 Sep 2004 14:07:10 -0000	1.5
+++ early-pprint.lisp	26 Oct 2004 17:51:13 -0000	1.6
@@ -152,7 +152,7 @@
    PPRINT-LOGICAL-BLOCK, and only when the LIST argument to
    PPRINT-LOGICAL-BLOCK is supplied."
   (error "PPRINT-EXIT-IF-LIST-EXHAUSTED must be lexically inside ~
-	  PPRINT-LOGICAL-BLOCK."))
+          PPRINT-LOGICAL-BLOCK."))
 
 (defmacro pprint-pop ()
   #!+sb-doc

Index: early-setf.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-setf.lisp,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- early-setf.lisp	29 Jun 2004 08:50:58 -0000	1.23
+++ early-setf.lisp	26 Oct 2004 17:51:13 -0000	1.24
@@ -85,7 +85,7 @@
       (sb!xc:get-setf-expansion form environment)
     (when (cdr store-vars)
       (error "GET-SETF-METHOD used for a form with multiple store ~
-	      variables:~%  ~S"
+              variables:~%  ~S"
 	     form))
     (values temps value-forms store-vars store-form access-form)))
 
@@ -342,7 +342,7 @@
     (cond ((gethash name sb!c:*setf-assumed-fboundp*)
 	   (warn
 	    "defining setf macro for ~S when ~S was previously ~
-	     treated as a function"
+             treated as a function"
 	    name
 	    `(setf ,name)))
 	  ((not (fboundp `(setf ,name)))

Index: error.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/error.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- error.lisp	4 Jul 2004 22:30:03 -0000	1.18
+++ error.lisp	26 Oct 2004 17:51:13 -0000	1.19
@@ -32,7 +32,7 @@
 		     :datum arguments
 		     :expected-type 'null
 		     :format-control "You may not supply additional arguments ~
-				     when giving ~S to ~S."
+                                      when giving ~S to ~S."
 		     :format-arguments (list datum fun-name)))
 	 datum)
 	((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
@@ -75,8 +75,8 @@
    (source :initarg :source :reader program-error-source))
   (:report (lambda (condition stream)
 	     (format stream "Execution of a form compiled with errors.~%~
-                            Form:~%  ~A~%~
-                            Compile-time-error:~%  ~A"
+                             Form:~%  ~A~%~
+                             Compile-time-error:~%  ~A"
 		       (program-error-source condition)
 		       (program-error-message condition)))))
 

Index: fd-stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/fd-stream.lisp,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -d -r1.48 -r1.49
--- fd-stream.lisp	30 Sep 2004 20:20:27 -0000	1.48
+++ fd-stream.lisp	26 Oct 2004 17:51:13 -0000	1.49
@@ -1197,7 +1197,7 @@
    :DIRECTION - one of :INPUT, :OUTPUT, :IO, or :PROBE
    :ELEMENT-TYPE - the type of object to read or write, default BASE-CHAR
    :IF-EXISTS - one of :ERROR, :NEW-VERSION, :RENAME, :RENAME-AND-DELETE,
-		       :OVERWRITE, :APPEND, :SUPERSEDE or NIL
+                       :OVERWRITE, :APPEND, :SUPERSEDE or NIL
    :IF-DOES-NOT-EXIST - one of :ERROR, :CREATE or NIL
   See the manual for details."
 

Index: late-format.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/late-format.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- late-format.lisp	15 Sep 2004 19:48:33 -0000	1.25
+++ late-format.lisp	26 Oct 2004 17:51:13 -0000	1.26
@@ -685,7 +685,7 @@
 		 (setf args (nthcdr ,posn orig-args))
 		 (error 'format-error
 			:complaint "Index ~W out of bounds. Should have been ~
-				    between 0 and ~W."
+                                    between 0 and ~W."
 			:args (list ,posn (length orig-args))
 			:offset ,(1- end)))))
       (if colonp
@@ -702,7 +702,7 @@
 			(error 'format-error
 			       :complaint
 			       "Index ~W is out of bounds; should have been ~
-				between 0 and ~W."
+                                between 0 and ~W."
 			       :args (list new-posn (length orig-args))
 			       :offset ,(1- end)))))))
 	  (if params
@@ -1059,8 +1059,8 @@
 		   (if directive
 		       (error 'format-error
 			      :complaint
-			      "cannot include format directives inside the ~
-			       ~:[suffix~;prefix~] segment of ~~<...~~:>"
+                              "cannot include format directives inside the ~
+                               ~:[suffix~;prefix~] segment of ~~<...~~:>"
 			      :args (list prefix-p)
 			      :offset (1- (format-directive-end directive))
                               :references

Index: loop.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/loop.lisp,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- loop.lisp	11 Sep 2004 12:54:27 -0000	1.37
+++ loop.lisp	26 Oct 2004 17:51:14 -0000	1.38
@@ -1190,12 +1190,12 @@
 	    (t (unless (eq (loop-collector-class cruft) class)
 		 (loop-error
 		   "incompatible kinds of LOOP value accumulation specified for collecting~@
-		    ~:[as the value of the LOOP~;~:*INTO ~S~]: ~S and ~S"
+                    ~:[as the value of the LOOP~;~:*INTO ~S~]: ~S and ~S"
 		   name (car (loop-collector-history cruft)) collector))
 	       (unless (equal dtype (loop-collector-dtype cruft))
 		 (loop-warn
 		   "unequal datatypes specified in different LOOP value accumulations~@
-		   into ~S: ~S and ~S"
+                   into ~S: ~S and ~S"
 		   name dtype (loop-collector-dtype cruft))
 		 (when (eq (loop-collector-dtype cruft) t)
 		   (setf (loop-collector-dtype cruft) dtype)))
@@ -1664,7 +1664,7 @@
 		 (if (setq tem (loop-tassoc (car z) *loop-named-vars*))
 		     (loop-error
 		       "The variable substitution for ~S occurs twice in a USING phrase,~@
-			with ~S and ~S."
+                        with ~S and ~S."
 		       (car z) (cadr z) (cadr tem))
 		     (push (cons (car z) (cadr z)) *loop-named-vars*)))
 	       (when (or (null *loop-source-code*)
@@ -1742,7 +1742,7 @@
 		 nil t)))
 	   (t (loop-error
 		 "~S invalid preposition in sequencing or sequence path;~@
-	      maybe invalid prepositions were specified in iteration path descriptor?"
+              maybe invalid prepositions were specified in iteration path descriptor?"
 		 prep)))
 	 (when (and odir dir (not (eq dir odir)))
 	   (loop-error "conflicting stepping directions in LOOP sequencing path"))

Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/macros.lisp,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -d -r1.40 -r1.41
--- macros.lisp	29 Jun 2004 08:50:59 -0000	1.40
+++ macros.lisp	26 Oct 2004 17:51:14 -0000	1.41
@@ -37,7 +37,7 @@
 
 (defun assert-prompt (name value)
   (cond ((y-or-n-p "The old value of ~S is ~S.~
-		  ~%Do you want to supply a new value? "
+                    ~%Do you want to supply a new value? "
 		   name value)
 	 (format *query-io* "~&Type a form to be evaluated:~%")
 	 (flet ((read-it () (eval (read *query-io*))))

Index: numbers.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/numbers.lisp,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -d -r1.36 -r1.37
--- numbers.lisp	15 Jun 2004 17:00:48 -0000	1.36
+++ numbers.lisp	26 Oct 2004 17:51:14 -0000	1.37
@@ -1236,22 +1236,22 @@
 (defun boole (op integer1 integer2)
   #!+sb-doc
   "Bit-wise boolean function on two integers. Function chosen by OP:
-	0	BOOLE-CLR
-	1	BOOLE-SET
-	2	BOOLE-1
-  	3	BOOLE-2
-	4	BOOLE-C1
-	5	BOOLE-C2
-	6	BOOLE-AND
-	7	BOOLE-IOR
- 	8	BOOLE-XOR
-	9	BOOLE-EQV
-	10	BOOLE-NAND
-	11	BOOLE-NOR
-	12	BOOLE-ANDC1
-	13	BOOLE-ANDC2
-	14	BOOLE-ORC1
-	15	BOOLE-ORC2"
+        0       BOOLE-CLR
+        1       BOOLE-SET
+        2       BOOLE-1
+        3       BOOLE-2
+        4       BOOLE-C1
+        5       BOOLE-C2
+        6       BOOLE-AND
+        7       BOOLE-IOR
+        8       BOOLE-XOR
+        9       BOOLE-EQV
+        10      BOOLE-NAND
+        11      BOOLE-NOR
+        12      BOOLE-ANDC1
+        13      BOOLE-ANDC2
+        14      BOOLE-ORC1
+        15      BOOLE-ORC2"
   (case op
     (0 (boole 0 integer1 integer2))
     (1 (boole 1 integer1 integer2))

Index: package.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/package.lisp,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -d -r1.17 -r1.18
--- package.lisp	29 Jun 2004 08:50:59 -0000	1.17
+++ package.lisp	26 Oct 2004 17:51:14 -0000	1.18
@@ -290,7 +290,7 @@
 	      (error 'simple-program-error
 		     :format-control
 		     "At least one of :INTERNAL, :EXTERNAL, or ~
-		      :INHERITED must be supplied."))
+                      :INHERITED must be supplied."))
 	   ,(dolist (symbol symbol-types)
 	      (unless (member symbol '(:internal :external :inherited))
 		(error 'program-error

Index: pprint.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/pprint.lisp,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -d -r1.28 -r1.29
--- pprint.lisp	6 Oct 2004 17:01:06 -0000	1.28
+++ pprint.lisp	26 Oct 2004 17:51:14 -0000	1.29
@@ -662,15 +662,15 @@
    *STANDARD-OUTPUT*) if it is a pretty-printing stream, and do
    nothing if not. KIND can be one of:
      :LINEAR - A line break is inserted if and only if the immediatly
-	containing section cannot be printed on one line.
+        containing section cannot be printed on one line.
      :MISER - Same as LINEAR, but only if ``miser-style'' is in effect.
-	(See *PRINT-MISER-WIDTH*.)
+        (See *PRINT-MISER-WIDTH*.)
      :FILL - A line break is inserted if and only if either:
        (a) the following section cannot be printed on the end of the
-	   current line,
+           current line,
        (b) the preceding section was not printed on a single line, or
        (c) the immediately containing section cannot be printed on one
-	   line and miser-style is in effect.
+           line and miser-style is in effect.
      :MANDATORY - A line break is always inserted.
    When a line break is inserted by any type of conditional newline, any
    blanks that immediately precede the conditional newline are ommitted
@@ -694,7 +694,7 @@
    and do nothing if not. (See PPRINT-LOGICAL-BLOCK.)  N is the indentation
    to use (in ems, the width of an ``m'') and RELATIVE-TO can be either:
      :BLOCK - Indent relative to the column the current logical block
-	started on.
+        started on.
      :CURRENT - Indent relative to the current column.
    The new indentation value does not take effect until the following line
    break."

Index: print.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/print.lisp,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -d -r1.53 -r1.54
--- print.lisp	10 Aug 2004 14:25:39 -0000	1.53
+++ print.lisp	26 Oct 2004 17:51:14 -0000	1.54
@@ -75,26 +75,26 @@
   #!+sb-doc
   "Bind the reader and printer control variables to values that enable READ
    to reliably read the results of PRINT. These values are:
-       *PACKAGE*			the COMMON-LISP-USER package
-       *PRINT-ARRAY*			T
-       *PRINT-BASE*			10
-       *PRINT-CASE*			:UPCASE
-       *PRINT-CIRCLE*			NIL
-       *PRINT-ESCAPE*			T
-       *PRINT-GENSYM*			T
-       *PRINT-LENGTH*			NIL
-       *PRINT-LEVEL*			NIL
-       *PRINT-LINES*			NIL
-       *PRINT-MISER-WIDTH*		NIL
-       *PRINT-PRETTY*			NIL
-       *PRINT-RADIX*			NIL
-       *PRINT-READABLY*			T
-       *PRINT-RIGHT-MARGIN*		NIL
-       *READ-BASE*			10
-       *READ-DEFAULT-FLOAT-FORMAT* 	SINGLE-FLOAT
-       *READ-EVAL*			T
-       *READ-SUPPRESS*			NIL
-       *READTABLE*			the standard readtable"
+       *PACKAGE*                        the COMMON-LISP-USER package
+       *PRINT-ARRAY*                    T
+       *PRINT-BASE*                     10
+       *PRINT-CASE*                     :UPCASE
+       *PRINT-CIRCLE*                   NIL
+       *PRINT-ESCAPE*                   T
+       *PRINT-GENSYM*                   T
+       *PRINT-LENGTH*                   NIL
+       *PRINT-LEVEL*                    NIL
+       *PRINT-LINES*                    NIL
+       *PRINT-MISER-WIDTH*              NIL
+       *PRINT-PRETTY*                   NIL
+       *PRINT-RADIX*                    NIL
+       *PRINT-READABLY*                 T
+       *PRINT-RIGHT-MARGIN*             NIL
+       *READ-BASE*                      10
+       *READ-DEFAULT-FLOAT-FORMAT*      SINGLE-FLOAT
+       *READ-EVAL*                      T
+       *READ-SUPPRESS*                  NIL
+       *READTABLE*                      the standard readtable"
   `(%with-standard-io-syntax (lambda () ,@body)))
 
 (defun %with-standard-io-syntax (function)
@@ -360,7 +360,7 @@
      ;; Someone forgot to initiate circularity detection.
      (let ((*print-circle* nil))
        (error "trying to use CHECK-FOR-CIRCULARITY when ~
-	       circularity checking isn't initiated")))
+               circularity checking isn't initiated")))
     ((t)
      ;; It's a second (or later) reference to the object while we are
      ;; just looking. So don't bother groveling it again.

Index: query.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/query.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- query.lisp	27 May 2003 16:17:27 -0000	1.6
+++ query.lisp	26 Oct 2004 17:51:14 -0000	1.7
@@ -18,8 +18,7 @@
 
 (defun query-read-line ()
   (force-output *query-io*)
-  (string-trim #.(concatenate 'string '(#\Space #\Tab))
-	       (read-line *query-io*)))
+  (string-trim " " (read-line *query-io*)))
 
 (defun maybe-print-query (hint format-string &rest format-args)
   (fresh-line *query-io*)

Index: stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/stream.lisp,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -d -r1.65 -r1.66
--- stream.lisp	10 Aug 2004 11:16:15 -0000	1.65
+++ stream.lisp	26 Oct 2004 17:51:14 -0000	1.66
@@ -1399,7 +1399,7 @@
 	(indentation (indenting-stream-indentation ,stream)))
        ((>= i indentation))
      (%write-string
-      "							    "
+      #.(make-string 60 :initial-element #\Space)
       ,sub-stream
       0
       (min 60 (- indentation i)))))
@@ -1472,12 +1472,12 @@
   #!+sb-doc
   "Return a stream that sends all output to the stream TARGET, but modifies
    the case of letters, depending on KIND, which should be one of:
-     :upcase - convert to upper case.
-     :downcase - convert to lower case.
-     :capitalize - convert the first letter of words to upper case and the
-	rest of the word to lower case.
-     :capitalize-first - convert the first letter of the first word to upper
-	case and everything else to lower case."
+     :UPCASE - convert to upper case.
+     :DOWNCASE - convert to lower case.
+     :CAPITALIZE - convert the first letter of words to upper case and the
+        rest of the word to lower case.
+     :CAPITALIZE-FIRST - convert the first letter of the first word to upper
+        case and everything else to lower case."
   (declare (type stream target)
 	   (type (member :upcase :downcase :capitalize :capitalize-first)
 		 kind)

Index: target-alieneval.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-alieneval.lisp,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- target-alieneval.lisp	9 Sep 2004 12:10:14 -0000	1.26
+++ target-alieneval.lisp	26 Oct 2004 17:51:14 -0000	1.27
@@ -607,25 +607,25 @@
   way that the argument is passed.
 
   :IN
-	An :IN argument is simply passed by value. The value to be passed is
-	obtained from argument(s) to the interface function. No values are
-	returned for :In arguments. This is the default mode.
+        An :IN argument is simply passed by value. The value to be passed is
+        obtained from argument(s) to the interface function. No values are
+        returned for :In arguments. This is the default mode.
 
   :OUT
-	The specified argument type must be a pointer to a fixed sized object.
-	A pointer to a preallocated object is passed to the routine, and the
-	the object is accessed on return, with the value being returned from
-	the interface function. :OUT and :IN-OUT cannot be used with pointers
-	to arrays, records or functions.
+        The specified argument type must be a pointer to a fixed sized object.
+        A pointer to a preallocated object is passed to the routine, and the
+        the object is accessed on return, with the value being returned from
+        the interface function. :OUT and :IN-OUT cannot be used with pointers
+        to arrays, records or functions.
 
   :COPY
-	This is similar to :IN, except that the argument values are stored
+        This is similar to :IN, except that the argument values are stored
         on the stack, and a pointer to the object is passed instead of
-	the value itself.
+        the value itself.
 
   :IN-OUT
-	This is a combination of :OUT and :COPY. A pointer to the argument is
-        passed,	with the object being initialized from the supplied argument
+        This is a combination of :OUT and :COPY. A pointer to the argument is
+        passed, with the object being initialized from the supplied argument
         and the return value being determined by accessing the object on
         return."
   (multiple-value-bind (lisp-name alien-name)

Index: target-format.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-format.lisp,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- target-format.lisp	6 Oct 2004 22:55:59 -0000	1.22
+++ target-format.lisp	26 Oct 2004 17:51:15 -0000	1.23
@@ -835,7 +835,7 @@
 		(setf args (nthcdr posn orig-args))
 		(error 'format-error
 		       :complaint "Index ~W is out of bounds. (It should ~
-				   have been between 0 and ~W.)"
+                                   have been between 0 and ~W.)"
 		       :args (list posn (length orig-args))))))
       (if colonp
 	  (interpret-bind-defaults ((n 1)) params
@@ -848,7 +848,7 @@
 		       (error 'format-error
 			      :complaint
 			      "Index ~W is out of bounds. (It should 
-			       have been between 0 and ~W.)"
+                               have been between 0 and ~W.)"
 			      :args
 			      (list new-posn (length orig-args))))))))
 	  (interpret-bind-defaults ((n 1)) params

Index: target-load.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-load.lisp,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -d -r1.35 -r1.36
--- target-load.lisp	9 Sep 2004 12:10:14 -0000	1.35
+++ target-load.lisp	26 Oct 2004 17:51:15 -0000	1.36
@@ -126,7 +126,7 @@
 	     (> (file-write-date src-tn) (file-write-date obj-tn)))
 	(restart-case
 	 (error "The object file ~A is~@
-		older than the presumed source:~%  ~A."
+                 older than the presumed source:~%  ~A."
 		(namestring obj-tn)
 		(namestring src-tn))
 	 ;; FIXME: In CMU CL one of these was a CONTINUE case.

Index: target-pathname.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-pathname.lisp,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -d -r1.44 -r1.45
--- target-pathname.lisp	1 Jun 2004 15:27:26 -0000	1.44
+++ target-pathname.lisp	26 Oct 2004 17:51:15 -0000	1.45
@@ -48,7 +48,7 @@
 	(print-unreadable-object (pathname stream :type t)
 	  (format stream
 		  "~@<(with no namestring) ~_:HOST ~S ~_:DEVICE ~S ~_:DIRECTORY ~S ~
-		  ~_:NAME ~S ~_:TYPE ~S ~_:VERSION ~S~:>"
+                  ~_:NAME ~S ~_:TYPE ~S ~_:VERSION ~S~:>"
 		  (%pathname-host pathname)
 		  (%pathname-device pathname)
 		  (%pathname-directory pathname)
@@ -692,7 +692,7 @@
 		  :expected-type 'null
 		  :format-control
 		  "The host in the namestring, ~S,~@
-		    does not match the explicit HOST argument, ~S."
+                   does not match the explicit HOST argument, ~S."
 		  :format-arguments (list new-host host)))
 	 (let ((pn-host (or new-host host (pathname-host defaults))))
 	   (values (%make-maybe-logical-pathname
@@ -816,7 +816,7 @@
       (let ((host (%pathname-host pathname)))
 	(unless host
 	  (error "can't determine the namestring for pathnames with no ~
-		  host:~%  ~S" pathname))
+                  host:~%  ~S" pathname))
 	(funcall (host-unparse host) pathname)))))
 
 (defun host-namestring (pathname)
@@ -937,7 +937,7 @@
 	     (setf in-wildcard t)
 	     (unless subs
 	       (error "not enough wildcards in FROM pattern to match ~
-		       TO pattern:~%  ~S"
+                       TO pattern:~%  ~S"
 		      pattern))
 	     (let ((sub (pop subs)))
 	       (typecase sub
@@ -952,7 +952,7 @@
 		  (push sub strings))
 		 (t
 		  (error "can't substitute this into the middle of a word:~
-			  ~%  ~S"
+                          ~%  ~S"
 			 sub)))))))
 
     (when strings
@@ -969,7 +969,7 @@
 ;;; Called when we can't see how source and from matched.
 (defun didnt-match-error (source from)
   (error "Pathname components from SOURCE and FROM args to TRANSLATE-PATHNAME~@
-	  did not match:~%  ~S ~S"
+          did not match:~%  ~S ~S"
 	 source from))
 
 ;;; Do TRANSLATE-COMPONENT for all components except host, directory
@@ -1082,14 +1082,14 @@
 	       (let ((match (pop subs-left)))
 		 (when (listp match)
 		   (error ":WILD-INFERIORS is not paired in from and to ~
-			   patterns:~%  ~S ~S" from to))
+                           patterns:~%  ~S ~S" from to))
 		 (res (maybe-diddle-case match diddle-case))))
 	      ((member :wild-inferiors)
 	       (aver subs-left)
 	       (let ((match (pop subs-left)))
 		 (unless (listp match)
 		   (error ":WILD-INFERIORS not paired in from and to ~
-			   patterns:~%  ~S ~S" from to))
+                           patterns:~%  ~S ~S" from to))
 		 (dolist (x match)
 		   (res (maybe-diddle-case x diddle-case)))))
 	      (pattern
@@ -1160,7 +1160,7 @@
 	(unless (or (alpha-char-p ch) (digit-char-p ch) (char= ch #\-))
 	  (error 'namestring-parse-error
 		 :complaint "logical namestring character which ~
-			     is not alphanumeric or hyphen:~%  ~S"
+                             is not alphanumeric or hyphen:~%  ~S"
 		 :args (list ch)
 		 :namestring word :offset i))))
     word))
@@ -1213,7 +1213,7 @@
 		(when (pattern)
 		  (error 'namestring-parse-error
 			 :complaint "double asterisk inside of logical ~
-				     word: ~S"
+                                     word: ~S"
 			 :args (list chunk)
 			 :namestring namestring
 			 :offset (+ (cdar chunks) pos)))
@@ -1332,7 +1332,7 @@
 		       (unless (and res (plusp res))
 			 (error 'namestring-parse-error
 				:complaint "expected a positive integer, ~
-					    got ~S"
+                                            got ~S"
 				:args (list str)
 				:namestring namestr
 				:offset (+ pos (cdar chunks))))

Index: time.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/time.lisp,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- time.lisp	6 May 2004 21:15:57 -0000	1.23
+++ time.lisp	26 Oct 2004 17:51:15 -0000	1.24
@@ -357,12 +357,12 @@
       (let ((gc-run-time (max (- *gc-run-time* start-gc-run-time) 0)))
 	(format *trace-output*
 		"~&Evaluation took:~%  ~
-		 ~S second~:P of real time~%  ~
-		 ~S second~:P of user run time~%  ~
-		 ~S second~:P of system run time~%  ~
+                 ~S second~:P of real time~%  ~
+                 ~S second~:P of user run time~%  ~
+                 ~S second~:P of system run time~%  ~
 ~@[                 [Run times include ~S second~:P GC run time.]~%  ~]~
-		 ~S page fault~:P and~%  ~
-		 ~:D bytes consed.~%"
+                 ~S page fault~:P and~%  ~
+                 ~:D bytes consed.~%"
 		(max (/ (- new-real-time old-real-time)
 			(float sb!xc:internal-time-units-per-second))
 		     0.0)

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

Modified Files:
	shebang.lisp 
Log Message:
0.8.16.6:
	Untabification
	... tabs in source code in general are Evil Bad and Wrong, but in
		strings they are especially so in the context of portable
		ANSI Common Lisp, since #\Tab is not a standard character.
	... remove all tabs in strings in the source code, and write some
		defensive code to prevent them from creeping back in again.
	... one or two other whitespacey changes.

	(this patch was brought to you by character_branch)


Index: shebang.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/cold/shebang.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- shebang.lisp	14 Mar 2002 15:10:45 -0000	1.5
+++ shebang.lisp	26 Oct 2004 17:51:15 -0000	1.6
@@ -73,6 +73,17 @@
 (declaim (type list *shebang-features*))
 (defvar *shebang-backend-subfeatures*)
 
+;;;; string checker, for catching non-portability early
+(defun make-quote-reader (standard-quote-reader)
+  (lambda (stream char)
+    (let ((result (funcall standard-quote-reader stream char)))
+      (unless (every (lambda (x) (typep x 'standard-char)) result)
+        (warn "Found non-STANDARD-CHAR in ~S" result))
+      result)))
+(compile 'make-quote-reader)
+
+(set-macro-character #\" (make-quote-reader (get-macro-character #\" nil)))
+
 ;;;; FIXME: Would it be worth implementing this?
 #|
 ;;;; readmacro syntax to remove spaces from FORMAT strings at compile time

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

Modified Files:
	version.lisp-expr 
Log Message:
0.8.16.6:
	Untabification
	... tabs in source code in general are Evil Bad and Wrong, but in
		strings they are especially so in the context of portable
		ANSI Common Lisp, since #\Tab is not a standard character.
	... remove all tabs in strings in the source code, and write some
		defensive code to prevent them from creeping back in again.
	... one or two other whitespacey changes.

	(this patch was brought to you by character_branch)


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1868
retrieving revision 1.1869
diff -u -d -r1.1868 -r1.1869
--- version.lisp-expr	26 Oct 2004 14:49:11 -0000	1.1868
+++ version.lisp-expr	26 Oct 2004 17:51:11 -0000	1.1869
@@ -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".)
-"0.8.16.5"
+"0.8.16.6"

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

Modified Files:
	array-tran.lisp assem.lisp backend.lisp ctype.lisp dump.lisp 
	gtn.lisp ir1-translators.lisp ir1final.lisp ir1opt.lisp 
	ir1tran.lisp ir1util.lisp locall.lisp main.lisp 
	meta-vmdef.lisp pack.lisp represent.lisp target-disassem.lisp 
	typetran.lisp 
Log Message:
0.8.16.6:
	Untabification
	... tabs in source code in general are Evil Bad and Wrong, but in
		strings they are especially so in the context of portable
		ANSI Common Lisp, since #\Tab is not a standard character.
	... remove all tabs in strings in the source code, and write some
		defensive code to prevent them from creeping back in again.
	... one or two other whitespacey changes.

	(this patch was brought to you by character_branch)


Index: array-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/array-tran.lisp,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -d -r1.64 -r1.65
--- array-tran.lisp	29 Sep 2004 19:34:40 -0000	1.64
+++ array-tran.lisp	26 Oct 2004 17:51:16 -0000	1.65
@@ -523,7 +523,7 @@
 	    ((:maybe)
 	     (give-up-ir1-transform
 	      "The array type is ambiguous; must call ~
-	      ARRAY-HAS-FILL-POINTER-P at runtime.")))))))
+               ARRAY-HAS-FILL-POINTER-P at runtime.")))))))
 
 ;;; Primitive used to verify indices into arrays. If we can tell at
 ;;; compile-time or we are generating unsafe code, don't bother with

Index: assem.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/assem.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- assem.lisp	14 Jul 2004 20:29:51 -0000	1.25
+++ assem.lisp	26 Oct 2004 17:51:16 -0000	1.26
@@ -953,7 +953,7 @@
 		    (when (< (find-alignment additional-delta)
 			     (chooser-alignment note))
 		      (error "~S shrunk by ~W bytes, but claimed that it ~
-			      preserves ~W bits of alignment."
+                              preserves ~W bits of alignment."
 			     note additional-delta (chooser-alignment note)))
 		    (incf delta additional-delta)
 		    (emit-filler segment additional-delta))
@@ -995,7 +995,7 @@
 			 (additional-delta (- old-size size)))
 		    (when (minusp additional-delta)
 		      (error "Alignment ~S needs more space now?  It was ~W, ~
-			    and is ~W now."
+                              and is ~W now."
 			     note old-size size))
 		    (when (plusp additional-delta)
 		      (emit-filler segment additional-delta)
@@ -1387,7 +1387,7 @@
 	       (arg (gensym (format nil "~:@(ARG-FOR-~S-~)" byte-spec-expr))))
 	  (when (ldb-test (byte byte-size byte-posn) overall-mask)
 	    (error "The byte spec ~S either overlaps another byte spec, or ~
-		    extends past the end."
+                    extends past the end."
 		   byte-spec-expr))
 	  (setf (ldb byte-spec overall-mask) -1)
 	  (arg-names arg)
@@ -1650,7 +1650,7 @@
 	     (setf (segment-postits ,segment-name) nil)
 	     (macrolet ((%%current-segment%% ()
 			  (error "You can't use INST without an ~
-				  ASSEMBLE inside emitters.")))
+                                  ASSEMBLE inside emitters.")))
                ;; KLUDGE: Some host lisps (CMUCL 18e Sparc at least)
                ;; can't deal with this declaration, so disable it on host
                ;; Ditto for earlier ENABLE-PACKAGE-LOCKS %%C-S%% %%C-V%%

Index: backend.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/backend.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- backend.lisp	9 Mar 2004 12:08:40 -0000	1.18
+++ backend.lisp	26 Oct 2004 17:51:16 -0000	1.19
@@ -157,7 +157,7 @@
 						  name)
 				    *backend-support-routines*)
 				   (error "machine-specific support ~S ~
-					    routine undefined"
+                                           routine undefined"
 					  ',name))
 			       args)))
 		   routines))))

Index: ctype.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ctype.lisp,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- ctype.lisp	27 May 2004 16:06:48 -0000	1.30
+++ ctype.lisp	26 Oct 2004 17:51:16 -0000	1.31
@@ -212,7 +212,7 @@
        (multiple-value-bind (res win) (ctypep val type)
 	 (cond ((not win)
 		(note-unwinnage "can't tell whether the ~:R argument is a ~
-			        constant ~S:~%  ~S"
+                                 constant ~S:~%  ~S"
 				n (type-specifier type) val)
 		nil)
 	       ((not res)
@@ -253,7 +253,7 @@
        ((not (check-arg-type k (specifier-type 'symbol) n)))
        ((not (constant-lvar-p k))
 	(note-unwinnage "The ~:R argument (in keyword position) is not a ~
-                        constant."
+                         constant."
 			n))
        (t
 	(let* ((name (lvar-value k))
@@ -554,7 +554,7 @@
 	       ((eq int *empty-type*)
 		(note-lossage
 		 "Definition's declared type for variable ~A:~%  ~S~@
-		  conflicts with this type from ~A:~%  ~S"
+                  conflicts with this type from ~A:~%  ~S"
 		 (leaf-debug-name var) (type-specifier vtype)
 		 where (type-specifier type))
 		(return-from try-type-intersections (values nil nil)))
@@ -606,7 +606,7 @@
 	     (unless (eq x y)
 	       (note-lossage
 		"The definition ~:[doesn't have~;has~] ~A, but ~
-		~A ~:[doesn't~;does~]."
+                 ~A ~:[doesn't~;does~]."
 		x what where y))))
       (frob (optional-dispatch-keyp od) (fun-type-keyp type)
 	    "&KEY arguments")
@@ -739,7 +739,7 @@
                                                             type-returns)))
            (note-lossage
             "The result type from ~A:~%  ~S~@
-	   conflicts with the definition's result type:~%  ~S"
+             conflicts with the definition's result type:~%  ~S"
             where (type-specifier type-returns) (type-specifier dtype))
            nil)
           (*lossage-detected* nil)
@@ -755,8 +755,8 @@
                                    (not (csubtypep (leaf-type var) type)))
                           (funcall unwinnage-fun
                                    "Assignment to argument: ~S~%  ~
-			       prevents use of assertion from function ~
-			       type ~A:~%  ~S~%"
+                                    prevents use of assertion from function ~
+                                    type ~A:~%  ~S~%"
                                    (leaf-debug-name var)
                                    where
                                    (type-specifier type))))

Index: dump.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/dump.lisp,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -d -r1.46 -r1.47
--- dump.lisp	29 Sep 2004 19:34:40 -0000	1.46
+++ dump.lisp	26 Oct 2004 17:51:16 -0000	1.47
@@ -33,7 +33,7 @@
   ;; can get them from the table rather than dumping them again. The
   ;; EQUAL-TABLE is used for lists and strings, and the EQ-TABLE is
   ;; used for everything else. We use a separate EQ table to avoid
-  ;; performance patholigies with objects for which EQUAL degnerates
+  ;; performance pathologies with objects for which EQUAL degenerates
   ;; to EQL. Everything entered in the EQUAL table is also entered in
   ;; the EQ table.
   (equal-table (make-hash-table :test 'equal) :type hash-table)
@@ -280,17 +280,19 @@
     ;; character code.
     (fasl-write-string
      (with-standard-io-syntax
-       (format nil
-	       "~%  ~
-	        compiled from ~S~%  ~
-	        at ~A~%  ~
-	        on ~A~%  ~
-	        using ~A version ~A~%"
-	        where
-	        (format-universal-time nil (get-universal-time))
-	        (machine-instance)
-	        (sb!xc:lisp-implementation-type)
-	        (sb!xc:lisp-implementation-version)))
+       (let ((*print-readably* nil)
+	     (*print-pretty* nil))
+	 (format nil
+		 "~%  ~
+                  compiled from ~S~%  ~
+                  at ~A~%  ~
+                  on ~A~%  ~
+                  using ~A version ~A~%"
+	 where
+		 (format-universal-time nil (get-universal-time))
+		 (machine-instance)
+		 (sb!xc:lisp-implementation-type)
+		 (sb!xc:lisp-implementation-version))))
      stream)
     (dump-byte +fasl-header-string-stop-char-code+ res)
 

Index: gtn.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/gtn.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- gtn.lisp	16 Sep 2003 07:45:08 -0000	1.13
+++ gtn.lisp	26 Oct 2004 17:51:17 -0000	1.14
@@ -137,8 +137,8 @@
 		   (let ((*compiler-error-context* (lambda-bind (first funs))))
 		     (compiler-notify
 		      "Return value count mismatch prevents known return ~
-		       from these functions:~
-		       ~{~%  ~A~}"
+                       from these functions:~
+                       ~{~%  ~A~}"
 		      (mapcar #'leaf-source-name
 			      (remove-if-not #'leaf-has-source-name-p funs)))))
 	(let ((ret (lambda-return fun)))
@@ -150,7 +150,7 @@
 		  (let ((*compiler-error-context* (lambda-bind fun)))
 		    (compiler-notify
 		     "Return type not fixed values, so can't use known return ~
-		      convention:~%  ~S"
+                      convention:~%  ~S"
 		     (type-specifier rtype)))
 		  (return)))))))))
   (values))

Index: ir1-translators.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1-translators.lisp,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -d -r1.61 -r1.62
--- ir1-translators.lisp	2 Oct 2004 07:48:33 -0000	1.61
+++ ir1-translators.lisp	26 Oct 2004 17:51:17 -0000	1.62
@@ -399,7 +399,7 @@
     (if (template-more-args-type template)
 	(when (< nargs min)
 	  (bug "Primitive ~A was called with ~R argument~:P, ~
-	    	but wants at least ~R."
+                but wants at least ~R."
 	       name
 	       nargs
 	       min))

Index: ir1final.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1final.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- ir1final.lisp	20 May 2004 15:55:49 -0000	1.25
+++ ir1final.lisp	26 Oct 2004 17:51:17 -0000	1.26
@@ -42,7 +42,7 @@
 	      (compiler-notify "~@<unable to ~
                                 ~2I~_~A ~
                                 ~I~_due to type uncertainty: ~
-			        ~2I~_~{~?~^~@:_~}~:>"
+                                ~2I~_~{~?~^~@:_~}~:>"
 			     note (messages))))
 	   ;; As best I can guess, it's OK to fall off the end here
 	   ;; because if it's not a VALID-FUNCTION-USE, the user

Index: ir1opt.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1opt.lisp,v
retrieving revision 1.99
retrieving revision 1.100
diff -u -d -r1.99 -r1.100
--- ir1opt.lisp	2 Oct 2004 07:48:33 -0000	1.99
+++ ir1opt.lisp	26 Oct 2004 17:51:17 -0000	1.100
@@ -164,7 +164,7 @@
 	    (let ((*compiler-error-context* node))
 	      (compiler-warn
 	       "New inferred type ~S conflicts with old type:~
-		~%  ~S~%*** possible internal error? Please report this."
+                ~%  ~S~%*** possible internal error? Please report this."
 	       (type-specifier rtype) (type-specifier node-type))))
 	  (setf (node-derived-type node) int)
           ;; If the new type consists of only one object, replace the
@@ -1590,14 +1590,14 @@
 	  (when (and min (< total-nvals min))
 	    (compiler-warn
 	     "MULTIPLE-VALUE-CALL with ~R values when the function expects ~
-	     at least ~R."
+              at least ~R."
 	     total-nvals min)
 	    (setf (basic-combination-kind node) :error)
 	    (return-from ir1-optimize-mv-call))
 	  (when (and max (> total-nvals max))
 	    (compiler-warn
 	     "MULTIPLE-VALUE-CALL with ~R values when the function expects ~
-	     at most ~R."
+              at most ~R."
 	     total-nvals max)
 	    (setf (basic-combination-kind node) :error)
 	    (return-from ir1-optimize-mv-call)))

Index: ir1tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran.lisp,v
retrieving revision 1.127
retrieving revision 1.128
diff -u -d -r1.127 -r1.128
--- ir1tran.lisp	18 Oct 2004 12:16:36 -0000	1.127
+++ ir1tran.lisp	26 Oct 2004 17:51:17 -0000	1.128
@@ -1067,7 +1067,7 @@
 		(functional
 		 (when (policy *lexenv* (>= speed inhibit-warnings))
 		   (compiler-notify "ignoring ~A declaration not at ~
-				     definition of local function:~%  ~S"
+                                     definition of local function:~%  ~S"
 				    sense name)))
 		(global-var
 		 (push (cons name (make-new-inlinep found sense))

Index: ir1util.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1util.lisp,v
retrieving revision 1.97
retrieving revision 1.98
diff -u -d -r1.97 -r1.98
--- ir1util.lisp	2 Oct 2004 07:48:34 -0000	1.97
+++ ir1util.lisp	26 Oct 2004 17:51:17 -0000	1.98
@@ -1612,8 +1612,8 @@
 	   ;; arbitrarily huge blocks of code. -- WHN)
 	   (let ((*compiler-error-context* node))
 	     (compiler-notify "*INLINE-EXPANSION-LIMIT* (~W) was exceeded, ~
-			       probably trying to~%  ~
-			       inline a recursive function."
+                               probably trying to~%  ~
+                               inline a recursive function."
 			      *inline-expansion-limit*))
 	   nil)
 	  (t t))))

Index: locall.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/locall.lisp,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -d -r1.66 -r1.67
--- locall.lisp	13 Sep 2004 15:56:15 -0000	1.66
+++ locall.lisp	26 Oct 2004 17:51:17 -0000	1.67
@@ -392,8 +392,8 @@
           (cond (losing-local-functional
                  (let ((*compiler-error-context* call))
                    (compiler-notify "couldn't inline expand because expansion ~
-		                   calls this LET-converted local function:~
-		                   ~%  ~S"
+                                     calls this LET-converted local function:~
+                                     ~%  ~S"
                                     (leaf-debug-name losing-local-functional)))
                  (loop for block = (block-next pred) then (block-next block)
                        until (eq block end)
@@ -627,8 +627,7 @@
       (when (optional-dispatch-keyp fun)
 	(when (oddp (length more))
 	  (compiler-warn "function called with odd number of ~
-  		          arguments in keyword portion")
-
+                          arguments in keyword portion")
 	  (setf (basic-combination-kind call) :error)
 	  (return-from convert-more-call))
 

Index: main.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/main.lisp,v
retrieving revision 1.98
retrieving revision 1.99
diff -u -d -r1.98 -r1.99
--- main.lisp	13 Oct 2004 18:05:36 -0000	1.98
+++ main.lisp	26 Oct 2004 17:51:17 -0000	1.99
@@ -120,12 +120,12 @@
   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."
+        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."
   `(%with-compilation-unit (lambda () ,@body) ,@options))
 
 (defun %with-compilation-unit (fn &key override)
@@ -225,12 +225,12 @@
 	    (when summary
 	      (if (eq kind :variable)
 		  (compiler-warn
-		   "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
-		    ~%  ~{~<~%  ~1:;~S~>~^ ~}"
+                   "~:[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~>~^ ~}"
+                   "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
+                   ~%  ~{~<~%  ~1:;~S~>~^ ~}"
 		   (cdr summary) kind summary))))))))
 
   (unless (and (not abort-p)

Index: meta-vmdef.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/meta-vmdef.lisp,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- meta-vmdef.lisp	12 Oct 2004 22:01:42 -0000	1.33
+++ meta-vmdef.lisp	26 Oct 2004 17:51:17 -0000	1.34
@@ -754,13 +754,13 @@
 				(rassoc name (funs)))))
 		(unless name
 		  (error "no move function defined to ~:[save~;load~] SC ~S ~
-			  ~:[to~;from~] from SC ~S"
+                          ~:[to~;from~] from SC ~S"
 			 load-p sc-name load-p (sc-name alt)))
 		
 		(cond (found
 		       (unless (eq (cdr found) name)
 			 (error "can't tell whether to ~:[save~;load~]~@
-				 with ~S or ~S when operand is in SC ~S"
+                                 with ~S or ~S when operand is in SC ~S"
 				load-p name (cdr found) (sc-name alt)))
 		       (pushnew alt (car found)))
 		      (t
@@ -768,7 +768,7 @@
 	 ((member (sb-kind (sc-sb sc)) '(:non-packed :unbounded)))
 	 (t
 	  (error "SC ~S has no alternate~:[~; or constant~] SCs, yet it is~@
-		  mentioned in the restriction for operand ~S"
+                  mentioned in the restriction for operand ~S"
 		 sc-name load-p (operand-parse-name op))))))
     (funs)))
 
@@ -804,7 +804,7 @@
 		 ,form)))
 	`(when ,load-tn
 	   (error "load TN allocated, but no move function?~@
-		   VM definition is inconsistent, recompile and try again.")))))
+                   VM definition is inconsistent, recompile and try again.")))))
 
 ;;; Return the TN that we should bind to the operand's var in the
 ;;; generator body. In general, this involves evaluating the :LOAD-IF
@@ -1172,7 +1172,7 @@
 			   (aref (sc-load-costs op-sc) load-scn))))
 	    (unless load
 	      (error "no move function defined to move ~:[from~;to~] SC ~
-		      ~S~%~:[to~;from~] alternate or constant SC ~S"
+                      ~S~%~:[to~;from~] alternate or constant SC ~S"
 		     load-p sc-name load-p (sc-name op-sc)))
 
 	    (let ((op-cost (svref costs op-scn)))
@@ -1273,7 +1273,7 @@
 				 (let ((alias (parse-operand-type alias)))
 				   (unless (eq (car alias) :or)
 				     (error "can't include primitive-type ~
-					     alias ~S in an :OR restriction: ~S"
+                                             alias ~S in an :OR restriction: ~S"
 					    item spec))
 				   (dolist (x (cdr alias))
 				     (results x)))
@@ -1312,10 +1312,10 @@
 			       nil)
 		    (when (svref load-scs rep) (return t)))
 	    (error "In the ~A ~:[result~;argument~] to VOP ~S,~@
-		    none of the SCs allowed by the operand type ~S can ~
-		    directly be loaded~@
-		    into any of the restriction's SCs:~%  ~S~:[~;~@
-		    [* type operand must allow T's SCs.]~]"
+                    none of the SCs allowed by the operand type ~S can ~
+                    directly be loaded~@
+                    into any of the restriction's SCs:~%  ~S~:[~;~@
+                    [* type operand must allow T's SCs.]~]"
 		   (operand-parse-name op) load-p (vop-parse-name parse)
 		   ptype
 		   scs (eq type '*)))))
@@ -1328,8 +1328,8 @@
 			     (meta-primitive-type-or-lose ptype))
 			(return t))))
 	  (warn "~:[Result~;Argument~] ~A to VOP ~S~@
-		 has SC restriction ~S which is ~
-		 not allowed by the operand type:~%  ~S"
+                 has SC restriction ~S which is ~
+                 not allowed by the operand type:~%  ~S"
 		load-p (operand-parse-name op) (vop-parse-name parse)
 		sc type)))))
 

Index: pack.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/pack.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- pack.lisp	12 Oct 2004 22:01:42 -0000	1.18
+++ pack.lisp	26 Oct 2004 17:51:17 -0000	1.19
@@ -280,23 +280,23 @@
     (cond ((eq (sb-kind (sc-sb src-sc)) :non-packed)
 	   (unless (member src-sc (sc-constant-scs dest-sc))
 	     (error "loading from an invalid constant SC?~@
-		     VM definition inconsistent, try recompiling."))
+                     VM definition inconsistent, try recompiling."))
 	   (error "no load function defined to load SC ~S ~
-		   from its constant SC ~S"
+                   from its constant SC ~S"
 		  dest-name src-name))
 	  ((member src-sc (sc-alternate-scs dest-sc))
 	   (error "no load function defined to load SC ~S from its ~
-		   alternate SC ~S"
+                   alternate SC ~S"
 		  dest-name src-name))
 	  ((member dest-sc (sc-alternate-scs src-sc))
 	   (error "no load function defined to save SC ~S in its ~
-		   alternate SC ~S"
+                   alternate SC ~S"
 		  src-name dest-name))
 	  (t
 	   ;; FIXME: "VM definition is inconsistent" shouldn't be a
 	   ;; possibility in SBCL.
 	   (error "loading to/from SCs that aren't alternates?~@
-		   VM definition is inconsistent, try recompiling.")))))
+                   VM definition is inconsistent, try recompiling.")))))
 
 ;;; Called when we failed to pack TN. If RESTRICTED is true, then we
 ;;; are restricted to pack TN in its SC.
@@ -316,7 +316,7 @@
 	 (ptype
 	  (aver (member (sc-number sc) (primitive-type-scs ptype)))
 	  (error "SC ~S doesn't have any :UNBOUNDED alternate SCs, but is~@
-		  a SC for primitive-type ~S."
+                  a SC for primitive-type ~S."
 		 (sc-name sc) (primitive-type-name ptype)))
 	 (t
 	  (error "SC ~S doesn't have any :UNBOUNDED alternate SCs."
@@ -388,13 +388,13 @@
       (declare (ignore costs load-scs))
 	(aver (not more-p))
 	(error "unable to pack a Load-TN in SC ~{~A~#[~^~;, or ~:;,~]~} ~
-		for the ~:R ~:[result~;argument~] to~@
-		the ~S VOP,~@
-		~:[since all SC elements are in use:~:{~%~@?~}~%~;~
-		~:*but these SC elements are not in use:~%  ~S~%Bug?~*~]~
-		~:[~;~@
-		Current cost info inconsistent with that in effect at compile ~
-		time. Recompile.~%Compilation order may be incorrect.~]"
+                for the ~:R ~:[result~;argument~] to~@
+                the ~S VOP,~@
+                ~:[since all SC elements are in use:~:{~%~@?~}~%~;~
+                ~:*but these SC elements are not in use:~%  ~S~%Bug?~*~]~
+                ~:[~;~@
+                Current cost info inconsistent with that in effect at compile ~
+                time. Recompile.~%Compilation order may be incorrect.~]"
 	       (mapcar #'sc-name scs)
 	       n arg-p
 	       (vop-info-name (vop-info (tn-ref-vop op)))
@@ -412,12 +412,12 @@
       (declare (ignore costs))
       (aver (not more-p))
       (error "~S is not valid as the ~:R ~:[result~;argument~] to VOP:~
-	      ~%  ~S,~@
-	      since the TN's primitive type ~S doesn't allow any of the SCs~@
-	      allowed by the operand restriction:~%  ~S~
-	      ~:[~;~@
-	      Current cost info inconsistent with that in effect at compile ~
-	      time. Recompile.~%Compilation order may be incorrect.~]"
+              ~%  ~S,~@
+              since the TN's primitive type ~S doesn't allow any of the SCs~@
+              allowed by the operand restriction:~%  ~S~
+              ~:[~;~@
+              Current cost info inconsistent with that in effect at compile ~
+              time. Recompile.~%Compilation order may be incorrect.~]"
 	     tn pos arg-p
 	     (template-name (vop-info (tn-ref-vop ref)))
 	     (primitive-type-name ptype)
@@ -1428,12 +1428,12 @@
     (when (and (not (eq (tn-kind tn) :specified-save))
 	       (conflicts-in-sc original sc offset))
 	  (format t "~&* Pack-wired-tn possible conflict:~%  ~
-		     tn: ~S; tn-kind: ~S~%  ~
-		     sc: ~S~%  ~
-		     sb: ~S; sb-name: ~S; sb-kind: ~S~%  ~
-		     offset: ~S; end: ~S~%  ~
-		     original ~S~%  ~
-		     tn-save-tn: ~S; tn-kind of tn-save-tn: ~S~%"
+                     tn: ~S; tn-kind: ~S~%  ~
+                     sc: ~S~%  ~
+                     sb: ~S; sb-name: ~S; sb-kind: ~S~%  ~
+                     offset: ~S; end: ~S~%  ~
+                     original ~S~%  ~
+                     tn-save-tn: ~S; tn-kind of tn-save-tn: ~S~%"
 		  tn (tn-kind tn) sc
 		  sb (sb-name sb) (sb-kind sb)
 		  offset end

Index: represent.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/represent.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- represent.lisp	16 Jun 2003 14:18:17 -0000	1.15
+++ represent.lisp	26 Oct 2004 17:51:18 -0000	1.16
@@ -100,14 +100,14 @@
 
 	(unless (losers)
 	  (error "Representation selection flamed out for no obvious reason.~@
-		  Try again after recompiling the VM definition."))
+                  Try again after recompiling the VM definition."))
 	
 	(error "~S is not valid as the ~:R ~:[result~;argument~] to the~@
-		~S VOP, since the TN's primitive type ~S allows SCs:~%  ~S~@
-		~:[which cannot be coerced or loaded into the allowed SCs:~
-		~%  ~S~;~*~]~:[~;~@
-		Current cost info inconsistent with that in effect at compile ~
-		time. Recompile.~%Compilation order may be incorrect.~]"
+                ~S VOP, since the TN's primitive type ~S allows SCs:~%  ~S~@
+                ~:[which cannot be coerced or loaded into the allowed SCs:~
+                ~%  ~S~;~*~]~:[~;~@
+                Current cost info inconsistent with that in effect at compile ~
+                time. Recompile.~%Compilation order may be incorrect.~]"
 	       tn pos arg-p
 	       (template-name (vop-info (tn-ref-vop ref)))
 	       (primitive-type-name ptype)
@@ -147,23 +147,23 @@
 			   (no-move-scs i-sc))))
 		    (t
 		     (error "Representation selection flamed out for no ~
-			     obvious reason."))))))
+                             obvious reason."))))))
 	
 	(unless (or (load-lose) (no-move-scs) (move-lose))
 	  (error "Representation selection flamed out for no obvious reason.~@
-		  Try again after recompiling the VM definition."))
+                  Try again after recompiling the VM definition."))
 
 	(error "~S is not valid as the ~:R ~:[result~;argument~] to VOP:~
-		~%  ~S~%Primitive type: ~S~@
-		SC restrictions:~%  ~S~@
-		~@[The primitive type disallows these loadable SCs:~%  ~S~%~]~
-		~@[No move VOPs are defined to coerce to these allowed SCs:~
-		~%  ~S~%~]~
-		~@[These move VOPs couldn't be used due to operand type ~
-		restrictions:~%  ~S~%~]~
-		~:[~;~@
-		Current cost info inconsistent with that in effect at compile ~
-		time. Recompile.~%Compilation order may be incorrect.~]"
+                ~%  ~S~%Primitive type: ~S~@
+                SC restrictions:~%  ~S~@
+                ~@[The primitive type disallows these loadable SCs:~%  ~S~%~]~
+                ~@[No move VOPs are defined to coerce to these allowed SCs:~
+                ~%  ~S~%~]~
+                ~@[These move VOPs couldn't be used due to operand type ~
+                restrictions:~%  ~S~%~]~
+                ~:[~;~@
+                Current cost info inconsistent with that in effect at compile ~
+                time. Recompile.~%Compilation order may be incorrect.~]"
 	       op-tn pos arg-p
 	       (template-name (vop-info (tn-ref-vop op)))
 	       (primitive-type-name ptype)
@@ -176,7 +176,7 @@
 (defun bad-move-arg-error (val pass)
   (declare (type tn val pass))
   (error "no :MOVE-ARG VOP defined to move ~S (SC ~S) to ~
-	  ~S (SC ~S)"
+          ~S (SC ~S)"
 	 val (sc-name (tn-sc val))
 	 pass (sc-name (tn-sc pass))))
 
@@ -194,17 +194,17 @@
 	  (dolist (const (sc-constant-scs sc))
 	    (unless (svref moves (sc-number const))
 	      (warn "no move function defined to load SC ~S from constant ~
-		     SC ~S"
+                     SC ~S"
 		    (sc-name sc) (sc-name const))))
 
 	  (dolist (alt (sc-alternate-scs sc))
 	    (unless (svref moves (sc-number alt))
 	      (warn "no move function defined to load SC ~S from alternate ~
-		     SC ~S"
+                     SC ~S"
 		    (sc-name sc) (sc-name alt)))
 	    (unless (svref (sc-move-funs alt) i)
 	      (warn "no move function defined to save SC ~S to alternate ~
-		     SC ~S"
+                     SC ~S"
 		    (sc-name sc) (sc-name alt)))))))))
 
 ;;;; representation selection
@@ -372,7 +372,7 @@
 			       (error "couldn't find op? bug!")))))
 	     (compiler-notify
 	      "doing ~A (cost ~W)~:[~2*~; ~:[to~;from~] ~S~], for:~%~6T~
-	       the ~:R ~:[result~;argument~] of ~A"
+               the ~:R ~:[result~;argument~] of ~A"
 	      note cost name arg-p name
 	      pos arg-p op-note)))
 	  (t

Index: target-disassem.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/target-disassem.lisp,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -d -r1.44 -r1.45
--- target-disassem.lisp	9 Sep 2004 12:10:15 -0000	1.44
+++ target-disassem.lisp	26 Oct 2004 17:51:18 -0000	1.45
@@ -949,7 +949,7 @@
 				  (file-position f char-offset))
 				 (t
 				  (warn "Source file ~S has been modified; ~@
-					 using form offset instead of ~
+                                         using form offset instead of ~
                                          file index."
 					name)
 				  (let ((*read-suppress* t))
@@ -995,7 +995,7 @@
 	   nil)
 	  ((> form-number (length mapping-table))
 	   (warn "bogus form-number in form!  The source file has probably ~@
-		  been changed too much to cope with.")
+                  been changed too much to cope with.")
 	   (when cache
 	     ;; Disable future warnings.
 	     (setf (sfcache-toplevel-form cache) nil))

Index: typetran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/typetran.lisp,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -d -r1.41 -r1.42
--- typetran.lisp	13 Apr 2004 10:30:39 -0000	1.41
+++ typetran.lisp	26 Oct 2004 17:51:18 -0000	1.42
@@ -371,7 +371,7 @@
       ;; If not properly named, error.
       ((not (and name (eq (find-classoid name) class)))
        (compiler-error "can't compile TYPEP of anonymous or undefined ~
-			class:~%  ~S"
+                        class:~%  ~S"
 		       class))
       (t
         ;; Delay the type transform to give type propagation a chance.

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

Modified Files:
	early-type-vops.lisp genesis.lisp vm-tran.lisp 
Log Message:
0.8.16.6:
	Untabification
	... tabs in source code in general are Evil Bad and Wrong, but in
		strings they are especially so in the context of portable
		ANSI Common Lisp, since #\Tab is not a standard character.
	... remove all tabs in strings in the source code, and write some
		defensive code to prevent them from creeping back in again.
	... one or two other whitespacey changes.

	(this patch was brought to you by character_branch)


Index: early-type-vops.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/early-type-vops.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- early-type-vops.lisp	10 Oct 2003 07:33:33 -0000	1.4
+++ early-type-vops.lisp	26 Oct 2004 17:51:18 -0000	1.5
@@ -57,7 +57,7 @@
 			 (if (subsetp headers *fun-header-widetags*)
 			     t
 			     (error "can't test for mix of function subtypes ~
-				     and normal header types"))
+                                     and normal header types"))
 			 nil)))
     (unless type-codes
       (error "At least one type must be supplied for TEST-TYPE."))

Index: genesis.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/genesis.lisp,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -d -r1.90 -r1.91
--- genesis.lisp	10 Sep 2004 15:36:17 -0000	1.90
+++ genesis.lisp	26 Oct 2004 17:51:19 -0000	1.91
@@ -34,10 +34,10 @@
 
 ;;; a magic number used to identify our core files
 (defconstant core-magic
-  (logior (ash (char-code #\S) 24)
-	  (ash (char-code #\B) 16)
-	  (ash (char-code #\C) 8)
-	  (char-code #\L)))
+  (logior (ash (sb!xc:char-code #\S) 24)
+	  (ash (sb!xc:char-code #\B) 16)
+	  (ash (sb!xc:char-code #\C) 8)
+	  (sb!xc:char-code #\L)))
 
 ;;; the current version of SBCL core files
 ;;;
@@ -626,14 +626,7 @@
 		       (make-fixnum-descriptor length))
     (dotimes (i length)
       (setf (bvref bytes (+ offset i))
-	    ;; KLUDGE: There's no guarantee that the character
-	    ;; encoding here will be the same as the character
-	    ;; encoding on the target machine, so using CHAR-CODE as
-	    ;; we do, or a bitwise copy as CMU CL code did, is sleazy.
-	    ;; (To make this more portable, perhaps we could use
-	    ;; indices into the sequence which is used to test whether
-	    ;; a character is a STANDARD-CHAR?) -- WHN 19990817
-	    (char-code (aref string i))))
+	    (sb!xc:char-code (aref string i))))
     (setf (bvref bytes (+ offset length))
 	  0) ; null string-termination character for C
     des))
@@ -1998,21 +1991,21 @@
 	      (depthoid (descriptor-fixnum depthoid-des)))
 	  (unless (= length old-length)
 	    (error "cold loading a reference to class ~S when the compile~%~
-		   time length was ~S and current length is ~S"
+                    time length was ~S and current length is ~S"
 		   name
 		   length
 		   old-length))
 	  (unless (equal inherits-list old-inherits-list)
 	    (error "cold loading a reference to class ~S when the compile~%~
-		   time inherits were ~S~%~
-		   and current inherits are ~S"
+                    time inherits were ~S~%~
+                    and current inherits are ~S"
 		   name
 		   inherits-list
 		   old-inherits-list))
 	  (unless (= depthoid old-depthoid)
 	    (error "cold loading a reference to class ~S when the compile~%~
-		   time inheritance depthoid was ~S and current inheritance~%~
-		   depthoid is ~S"
+                    time inheritance depthoid was ~S and current inheritance~%~
+                    depthoid is ~S"
 		   name
 		   depthoid
 		   old-depthoid)))
@@ -2989,7 +2982,7 @@
 	  ;; (We write each character as a word in order to avoid
 	  ;; having to think about word alignment issues in the
 	  ;; sbcl-0.7.8 version of coreparse.c.)
-	  (write-word (char-code char))))
+	  (write-word (sb!xc:char-code char))))
 
       ;; Write the New Directory entry header.
       (write-word new-directory-core-entry-type-code)

Index: vm-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-tran.lisp,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -d -r1.56 -r1.57
--- vm-tran.lisp	16 Aug 2004 22:52:00 -0000	1.56
+++ vm-tran.lisp	26 Oct 2004 17:51:19 -0000	1.57
@@ -228,7 +228,7 @@
 					  (length bit-array-2)
                                           (length result-bit-array))
                                  (error "Argument and/or result bit arrays are not the same length:~
-			 ~%  ~S~%  ~S  ~%  ~S"
+                         ~%  ~S~%  ~S  ~%  ~S"
                                         bit-array-1
 					bit-array-2
 					result-bit-array))))
@@ -278,7 +278,7 @@
 	 '((unless (= (length bit-array)
 		      (length result-bit-array))
 	     (error "Argument and result bit arrays are not the same length:~
-	     	     ~%  ~S~%  ~S"
+                     ~%  ~S~%  ~S"
 		    bit-array result-bit-array))))
     (let ((length (length result-bit-array)))
       (if (= length 0)

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21327/tests

Modified Files:
	pathnames.impure.lisp seq.impure.lisp 
Log Message:
0.8.16.6:
	Untabification
	... tabs in source code in general are Evil Bad and Wrong, but in
		strings they are especially so in the context of portable
		ANSI Common Lisp, since #\Tab is not a standard character.
	... remove all tabs in strings in the source code, and write some
		defensive code to prevent them from creeping back in again.
	... one or two other whitespacey changes.

	(this patch was brought to you by character_branch)


Index: pathnames.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/pathnames.impure.lisp,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- pathnames.impure.lisp	18 Aug 2004 17:23:18 -0000	1.22
+++ pathnames.impure.lisp	26 Oct 2004 17:51:19 -0000	1.23
@@ -309,6 +309,7 @@
 		  (parse-namestring "SCRATCH:FOO.TXT.NEWEST")
 		  (parse-namestring "SCRATCH:FOO.TXT"))))
   (dolist (p pathnames)
+    (print p)
     (handler-case
 	(let ((*print-readably* t))
 	  (assert (equal (read-from-string (format nil "~S" p)) p)))

Index: seq.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/seq.impure.lisp,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- seq.impure.lisp	29 Jun 2004 08:51:02 -0000	1.22
+++ seq.impure.lisp	26 Oct 2004 17:51:20 -0000	1.23
@@ -395,7 +395,7 @@
 
 ;;; Function COUNT, COUNT-IF, COUNT-IF-NOT
 (sequence-bounding-indices-test
- (format t "~&/Function COUNT, COUNT-IF, COUNT-IF-NOT")
+ (format t "~&/Function COUNT, COUNT-IF, COUNT-IF-NOT") 
  (assert (= (count #\a string :start 0 :end nil) 5))
  (assert (= (count #\a string :start 0 :end 5) 5))
  (assert (raises-error? (count #\a string :start 0 :end 6)))
@@ -425,7 +425,7 @@
 
 ;;; Function FILL
 (sequence-bounding-indices-test
- (format t "~&/Function FILL~%")
+ (format t "~&/Function FILL") 
  (assert (string= (fill string #\b :start 0 :end 5) "bbbbb"))
  (assert (string= (fill string #\c :start 0 :end nil) "ccccc"))
  (assert (raises-error? (fill string #\d :start 0 :end 6)))
@@ -435,7 +435,7 @@
 
 ;;; Function FIND, FIND-IF, FIND-IF-NOT
 (sequence-bounding-indices-test
- (format t "~&/Function FIND, FIND-IF, FIND-IF-NOT~%")
+ (format t "~&/Function FIND, FIND-IF, FIND-IF-NOT") 
  (assert (char= (find #\a string :start 0 :end nil) #\a))
  (assert (char= (find #\a string :start 0 :end 5) #\a))
  (assert (raises-error? (find #\a string :start 0 :end 6)))
@@ -465,7 +465,7 @@
 
 ;;; Function MISMATCH
 (sequence-bounding-indices-test
- (format t "~&/Function MISMATCH~%")
+ (format t "~&/Function MISMATCH") 
  (assert (null (mismatch string "aaaaa" :start1 0 :end1 nil)))
  (assert (= (mismatch "aaab" string :start2 0 :end2 4) 3))
  (assert (raises-error? (mismatch "aaaaaa" string :start2 0 :end2 6)))
@@ -475,7 +475,7 @@
 
 ;;; Function PARSE-INTEGER
 (sequence-bounding-indices-test
- (format t "~&/Function PARSE-INTEGER~%")
+ (format t "~&/Function PARSE-INTEGER") 
  (setf (fill-pointer string) 10)
  (setf (subseq string 0 10) "1234567890")
  (setf (fill-pointer string) 5)
@@ -488,7 +488,7 @@
 
 ;;; Function PARSE-NAMESTRING
 (sequence-bounding-indices-test
- (format t "~&/Function PARSE-NAMESTRING~%")
+ (format t "~&/Function PARSE-NAMESTRING") 
  (setf (fill-pointer string) 10)
  (setf (subseq string 0 10) "/dev/ /tmp")
  (setf (fill-pointer string) 5)
@@ -511,7 +511,8 @@
 
 ;;; Function POSITION, POSITION-IF, POSITION-IF-NOT
 (sequence-bounding-indices-test
- (format t "~&/Function POSITION, POSITION-IF, POSITION-IF-NOT~%")
+ (format t "~&/Function POSITION, POSITION-IF, POSITION-IF-NOT")
+ 
  (assert (= (position #\a string :start 0 :end nil) 0))
  (assert (= (position #\a string :start 0 :end 5) 0))
  (assert (raises-error? (position #\a string :start 0 :end 6)))
@@ -541,7 +542,7 @@
 
 ;;; Function READ-FROM-STRING
 (sequence-bounding-indices-test
- (format t "~&/Function READ-FROM-STRING~%")
+ (format t "~&/Function READ-FROM-STRING") 
  (setf (subseq string 0 5) "(a b)")
  (assert (equal (read-from-string string nil nil :start 0 :end 5) '(a b)))
  (assert (equal (read-from-string string nil nil :start 0 :end nil) '(a b)))
@@ -552,7 +553,7 @@
 
 ;;; Function REDUCE
 (sequence-bounding-indices-test
- (format t "~&/Function REDUCE~%")
+ (format t "~&/Function REDUCE") 
  (setf (subseq string 0 5) "abcde")
  (assert (equal (reduce #'list* string :from-end t :start 0 :end nil)
 		'(#\a #\b #\c #\d . #\e)))
@@ -566,7 +567,7 @@
 ;;; Function REMOVE, REMOVE-IF, REMOVE-IF-NOT, DELETE, DELETE-IF,
 ;;; DELETE-IF-NOT
 (sequence-bounding-indices-test
- (format t "~&/Function REMOVE, REMOVE-IF, REMOVE-IF-NOT, ...~%")
+ (format t "~&/Function REMOVE, REMOVE-IF, REMOVE-IF-NOT, ...") 
  (assert (equal (remove #\a string :start 0 :end nil) ""))
  (assert (equal (remove #\a string :start 0 :end 5) ""))
  (assert (raises-error? (remove #\a string :start 0 :end 6)))
@@ -596,7 +597,7 @@
  (assert (raises-error?
 	  (remove-if-not #'alpha-char-p string :start 6 :end 9))))
 (sequence-bounding-indices-test
- (format t "~&/... DELETE, DELETE-IF, DELETE-IF-NOT")
+ (format t "~&/... DELETE, DELETE-IF, DELETE-IF-NOT") 
  (assert (equal (delete #\a string :start 0 :end nil) ""))
  (reset)
  (assert (equal (delete #\a string :start 0 :end 5) ""))
@@ -645,7 +646,7 @@
 
 ;;; Function REMOVE-DUPLICATES, DELETE-DUPLICATES
 (sequence-bounding-indices-test
- (format t "~&/Function REMOVE-DUPLICATES, DELETE-DUPLICATES~%")
+ (format t "~&/Function REMOVE-DUPLICATES, DELETE-DUPLICATES") 
  (assert (string= (remove-duplicates string :start 0 :end 5) "a"))
  (assert (string= (remove-duplicates string :start 0 :end nil) "a"))
  (assert (raises-error? (remove-duplicates string :start 0 :end 6)))
@@ -666,7 +667,7 @@
 
 ;;; Function REPLACE
 (sequence-bounding-indices-test
- (format t "~&/Function REPLACE~%")
+ (format t "~&/Function REPLACE") 
  (assert (string= (replace string "bbbbb" :start1 0 :end1 5) "bbbbb"))
  (assert (string= (replace (copy-seq "ccccc")
 			   string
@@ -678,7 +679,7 @@
 
 ;;; Function SEARCH
 (sequence-bounding-indices-test
- (format t "~&/Function SEARCH~%")
+ (format t "~&/Function SEARCH") 
  (assert (= (search "aa" string :start2 0 :end2 5) 0))
  (assert (null (search string "aa" :start1 0 :end2 nil)))
  (assert (raises-error? (search "aa" string :start2 0 :end2 6)))
@@ -696,11 +697,11 @@
     (assert (raises-error? (,fn string :start 6 :end 9)))))
   
 (sequence-bounding-indices-test
- (format t "~&/Function STRING-UPCASE, STRING-DOWNCASE, STRING-CAPITALIZE, ...~%")
+ (format t "~&/Function STRING-UPCASE, STRING-DOWNCASE, STRING-CAPITALIZE, ...")
  (string-case-frob string-upcase)
  (string-case-frob string-downcase)
  (string-case-frob string-capitalize)
- (format t "~&/... NSTRING-UPCASE, NSTRING-DOWNCASE, NSTRING-CAPITALIZE~%")
+ (format t "~&/... NSTRING-UPCASE, NSTRING-DOWNCASE, NSTRING-CAPITALIZE")
  (string-case-frob nstring-upcase)
  (string-case-frob nstring-downcase)
  (string-case-frob nstring-capitalize))
@@ -728,12 +729,12 @@
  (string-predicate-frob string<=)
  (string-predicate-frob string>=))
 (sequence-bounding-indices-test
- (format t "~&/... STRING-EQUAL, STRING-NOT-EQUAL, STRING-LESSP, ...~%")
+ (format t "~&/... STRING-EQUAL, STRING-NOT-EQUAL, STRING-LESSP, ...")
  (string-predicate-frob string-equal)
  (string-predicate-frob string-not-equal)
  (string-predicate-frob string-lessp))
 (sequence-bounding-indices-test
- (format t "~&/... STRING-GREATERP, STRING-NOT-GREATERP, STRING-NOT-LESSP~%")
+ (format t "~&/... STRING-GREATERP, STRING-NOT-GREATERP, STRING-NOT-LESSP")
  (string-predicate-frob string-greaterp)
  (string-predicate-frob string-not-greaterp)
  (string-predicate-frob string-not-lessp))
@@ -741,7 +742,7 @@
 ;;; Function SUBSTITUTE, SUBSTITUTE-IF, SUBSTITUTE-IF-NOT,
 ;;; NSUBSTITUTE, NSUBSTITUTE-IF, NSUBSTITUTE-IF-NOT
 (sequence-bounding-indices-test
- (format t "~&/Function SUBSTITUTE, SUBSTITUTE-IF, SUBSTITUTE-IF-NOT, ...~%")
+ (format t "~&/Function SUBSTITUTE, SUBSTITUTE-IF, SUBSTITUTE-IF-NOT, ...")
  (assert (string= (substitute #\b #\a string :start 0 :end 5) "bbbbb"))
  (assert (string= (substitute #\c #\a string :start 0 :end nil)
 		  "ccccc"))
@@ -778,7 +779,7 @@
  (assert (raises-error? (substitute-if-not #\b #'alpha-char-p string
 					   :start 6 :end 9))))
 (sequence-bounding-indices-test
- (format t "~&/... NSUBSTITUTE, NSUBSTITUTE-IF, NSUBSTITUTE-IF-NOT~%")
+ (format t "~&/... NSUBSTITUTE, NSUBSTITUTE-IF, NSUBSTITUTE-IF-NOT")
  (assert (string= (nsubstitute #\b #\a string :start 0 :end 5) "bbbbb"))
  (reset)
  (assert (string= (nsubstitute #\c #\a string :start 0 :end nil)
@@ -833,7 +834,7 @@
 					    :start 6 :end 9))))
 ;;; Function WRITE-STRING, WRITE-LINE
 (sequence-bounding-indices-test
- (format t "~&/Function WRITE-STRING, WRITE-LINE~%")
+ (format t "~&/Function WRITE-STRING, WRITE-LINE")
  (write-string string *standard-output* :start 0 :end 5)
  (write-string string *standard-output* :start 0 :end nil)
  (assert (raises-error? (write-string string *standard-output*
@@ -857,7 +858,7 @@
 
 ;;; Macro WITH-INPUT-FROM-STRING
 (sequence-bounding-indices-test
- (format t "~&/Macro WITH-INPUT-FROM-STRING~%")
+ (format t "~&/Macro WITH-INPUT-FROM-STRING")
  (with-input-from-string (s string :start 0 :end 5)
    (assert (char= (read-char s) #\a)))
  (with-input-from-string (s string :start 0 :end nil)

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

Modified Files:
	walk.lisp 
Log Message:
0.8.16.6:
	Untabification
	... tabs in source code in general are Evil Bad and Wrong, but in
		strings they are especially so in the context of portable
		ANSI Common Lisp, since #\Tab is not a standard character.
	... remove all tabs in strings in the source code, and write some
		defensive code to prevent them from creeping back in again.
	... one or two other whitespacey changes.

	(this patch was brought to you by character_branch)


Index: walk.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/walk.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- walk.lisp	8 Jul 2004 18:29:54 -0000	1.25
+++ walk.lisp	26 Oct 2004 17:51:19 -0000	1.26
@@ -540,12 +540,8 @@
 (defun walk-template-handle-repeat (form template stop-form context env)
   (if (eq form stop-form)
       (walk-template form (cdr template) context env)
-      (walk-template-handle-repeat-1 form
-				     template
-				     (car template)
-				     stop-form
-				     context
-				     env)))
+      (walk-template-handle-repeat-1
+       form template (car template) stop-form context env)))
 
 (defun walk-template-handle-repeat-1 (form template repeat-template
 					   stop-form context env)
@@ -554,7 +550,7 @@
 	 (if (null repeat-template)
 	     (walk-template stop-form (cdr template) context env)
 	     (error "while handling code walker REPEAT:
-		     ~%ran into STOP while still in REPEAT template")))
+                     ~%ran into STOP while still in REPEAT template")))
 	((null repeat-template)
 	 (walk-template-handle-repeat-1
 	   form template (car template) stop-form context env))

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

Modified Files:
	class.lisp condition.lisp reader.lisp 
Log Message:
0.8.16.5: deoopsification
          * Fix paths going thru READ-MAYBE-NOTHING that 0.8.16.1
             broke -- discovered by SB-ACLREPL breaking. Also
             add a regression test for the same.
          * Better TYPE-ERRORs from ERROR: ones that actually have
             expected-type and datum slots filled.


Index: class.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/class.lisp,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -d -r1.51 -r1.52
--- class.lisp	26 Oct 2004 10:24:55 -0000	1.51
+++ class.lisp	26 Oct 2004 14:49:11 -0000	1.52
@@ -709,6 +709,8 @@
     (if (or res (not errorp))
 	res
 	(error 'simple-type-error
+               :datum nil
+               :expected-type 'class
                :format-control "class not yet defined:~%  ~S" 
                :format-arguments (list name)))))
 (defun (setf find-classoid) (new-value name)

Index: condition.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/condition.lisp,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -d -r1.54 -r1.55
--- condition.lisp	15 Sep 2004 19:48:33 -0000	1.54
+++ condition.lisp	26 Oct 2004 14:49:11 -0000	1.55
@@ -233,8 +233,7 @@
   "Make an instance of a condition object using the specified initargs."
   ;; Note: ANSI specifies no exceptional situations in this function.
   ;; signalling simple-type-error would not be wrong.
-  (let* ((thing (if (symbolp thing)
-		    (find-classoid thing)
+  (let* ((thing (or (and (symbolp thing) (find-classoid thing nil))
 		    thing))
 	 (class (typecase thing
 		  (condition-classoid thing)

Index: reader.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/reader.lisp,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -d -r1.34 -r1.35
--- reader.lisp	26 Oct 2004 09:50:38 -0000	1.34
+++ reader.lisp	26 Oct 2004 14:49:12 -0000	1.35
@@ -431,8 +431,7 @@
 		 (funcall (get-coerced-cmt-entry char *readtable*)
 			  stream
 			  char))))
-    (when (and retval (not *read-suppress*))
-      (rplacd retval nil))))
+    (if retval (rplacd retval nil))))
 
 (defun read (&optional (stream *standard-input*)
 		       (eof-error-p t)
@@ -465,7 +464,7 @@
   (do ((char (flush-whitespace input-stream)
 	     (flush-whitespace input-stream))
        (retlist ()))
-      ((char= char endchar) (nreverse retlist))
+      ((char= char endchar) (unless *read-suppress* (nreverse retlist)))
     (setq retlist (nconc (read-maybe-nothing input-stream char) retlist))))
 
 ;;;; basic readmacro definitions

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3664/tests

Modified Files:
	condition.pure.lisp reader.pure.lisp 
Log Message:
0.8.16.5: deoopsification
          * Fix paths going thru READ-MAYBE-NOTHING that 0.8.16.1
             broke -- discovered by SB-ACLREPL breaking. Also
             add a regression test for the same.
          * Better TYPE-ERRORs from ERROR: ones that actually have
             expected-type and datum slots filled.


Index: condition.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/condition.pure.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- condition.pure.lisp	26 Oct 2004 10:24:56 -0000	1.7
+++ condition.pure.lisp	26 Oct 2004 14:49:12 -0000	1.8
@@ -130,10 +130,13 @@
          (multiple-value-bind (res err) 
              (ignore-errors (apply #'error args))
            (assert (not res))
-           (assert (typep err 'type-error)))))
+           (assert (typep err 'type-error))
+           (assert (not (nth-value 1 (ignore-errors 
+                                       (type-error-datum err)))))
+           (assert (not (nth-value 1 (ignore-errors 
+                                       (type-error-expected-type err))))))))
   (test '#:no-such-condition)
   (test nil)
   (test t)
   (test 42)
   (test (make-instance 'standard-object)))
-

Index: reader.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/reader.pure.lisp,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- reader.pure.lisp	26 Oct 2004 09:50:39 -0000	1.12
+++ reader.pure.lisp	26 Oct 2004 14:49:12 -0000	1.13
@@ -224,3 +224,7 @@
 (multiple-value-bind (res err) (ignore-errors (read-from-string ""))
   (assert (not res))
   (assert (typep err 'end-of-file)))
+
+(assert (equal '((0 . "A") (1 . "B"))
+               (coerce (read-from-string "#((0 . \"A\") (1 . \"B\"))") 
+                       'list)))

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

Modified Files:
	version.lisp-expr 
Log Message:
0.8.16.5: deoopsification
          * Fix paths going thru READ-MAYBE-NOTHING that 0.8.16.1
             broke -- discovered by SB-ACLREPL breaking. Also
             add a regression test for the same.
          * Better TYPE-ERRORs from ERROR: ones that actually have
             expected-type and datum slots filled.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1867
retrieving revision 1.1868
diff -u -d -r1.1867 -r1.1868
--- version.lisp-expr	26 Oct 2004 11:43:49 -0000	1.1867
+++ version.lisp-expr	26 Oct 2004 14:49:11 -0000	1.1868
@@ -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".)
-"0.8.16.4"
+"0.8.16.5"

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

Modified Files:
      Tag: character_branch
	char.lisp 
Log Message:
0.8.13.77.character.44:
	"Don't let your imagination run away with you"

	Fix for antifuchs #lisp-reported problem with merge to HEAD: the
	MOVE-TO-CHARACTER VOP could fail if Python wants both the arg and
	the result to be on the stack.
	... change it around a bit to deal only with registers, and play
		with :LOAD-IF to achieve hopefully the same efficiency


Index: char.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/char.lisp,v
retrieving revision 1.5.26.2
retrieving revision 1.5.26.3
diff -u -d -r1.5.26.2 -r1.5.26.3
--- char.lisp	23 Sep 2004 11:37:04 -0000	1.5.26.2
+++ char.lisp	26 Oct 2004 13:12:44 -0000	1.5.26.3
@@ -15,18 +15,20 @@
 
 ;;; Move a tagged char to an untagged representation.
 (define-vop (move-to-character)
-  (:args (x :scs (any-reg control-stack) :target y))
-  (:results (y :scs (character-reg character-stack)))
+  (:args (x :scs (any-reg descriptor-reg) :target y
+            :load-if (not (location= x y))))
+  (:results (y :scs (character-reg)
+               :load-if (not (location= x y))))
   (:note "character untagging")
   (:generator 1
     (move y x)
     (inst shr y n-widetag-bits)))
 (define-move-vop move-to-character :move
-  (any-reg control-stack) (character-reg character-stack))
+  (any-reg descriptor-reg) (character-reg))
 
 ;;; Move an untagged char to a tagged representation.
 (define-vop (move-from-character)
-  (:args (x :scs (character-reg character-stack)))
+  (:args (x :scs (character-reg)))
   (:results (y :scs (any-reg descriptor-reg)))
   (:note "character tagging")
   (:generator 1
@@ -38,7 +40,7 @@
     (inst imul y x (ash 1 n-widetag-bits))
     (inst or y character-widetag)))
 (define-move-vop move-from-character :move
-  (character-reg character-stack) (any-reg descriptor-reg control-stack))
+  (character-reg) (any-reg descriptor-reg))
 
 ;;; Move untagged character values.
 (define-vop (character-move)

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

Modified Files:
      Tag: character_branch
	version.lisp-expr 
Log Message:
0.8.13.77.character.44:
	"Don't let your imagination run away with you"

	Fix for antifuchs #lisp-reported problem with merge to HEAD: the
	MOVE-TO-CHARACTER VOP could fail if Python wants both the arg and
	the result to be on the stack.
	... change it around a bit to deal only with registers, and play
		with :LOAD-IF to achieve hopefully the same efficiency


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1806.2.43
retrieving revision 1.1806.2.44
diff -u -d -r1.1806.2.43 -r1.1806.2.44
--- version.lisp-expr	25 Oct 2004 16:31:07 -0000	1.1806.2.43
+++ version.lisp-expr	26 Oct 2004 13:12:43 -0000	1.1806.2.44
@@ -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".)
-"0.8.13.77.character.43"
+"0.8.13.77.character.44"

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

Modified Files:
	defboot.lisp target-package.lisp 
Log Message:
0.8.16.4:
	Fix for bug reported by Bruno Haible cmucl-imp 2004-10-19:
	... be more clear about when situations are name conflicts
	... signal symbol-by-symbol rather than all at once, so that...
	... a restart can be offered to resolve the conflicts in favour
		of any of the conflicting symbols
	... document the condition type, symbol list accessor and restart
	... also frob the docstrings a little for sbcl house style


Index: defboot.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/defboot.lisp,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -d -r1.44 -r1.45
--- defboot.lisp	29 Jun 2004 08:50:58 -0000	1.44
+++ defboot.lisp	26 Oct 2004 11:43:50 -0000	1.45
@@ -352,9 +352,8 @@
 (defmacro-mundanely with-condition-restarts
     (condition-form restarts-form &body body)
   #!+sb-doc
-  "WITH-CONDITION-RESTARTS Condition-Form Restarts-Form Form*
-   Evaluates the Forms in a dynamic environment where the restarts in the list
-   Restarts-Form are associated with the condition returned by Condition-Form.
+  "Evaluates the BODY in a dynamic environment where the restarts in the list
+   RESTARTS-FORM are associated with the condition returned by CONDITION-FORM.
    This allows FIND-RESTART, etc., to recognize restarts that are not related
    to the error currently being debugged. See also RESTART-CASE."
   (let ((n-cond (gensym)))

Index: target-package.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-package.lisp,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -d -r1.28 -r1.29
--- target-package.lisp	4 Jul 2004 13:03:27 -0000	1.28
+++ target-package.lisp	26 Oct 2004 11:43:50 -0000	1.29
@@ -477,20 +477,15 @@
 	     (push n (package-%nicknames package)))
 	    ((eq found package))
 	    ((string= (the string (package-%name found)) n)
-	     ;; FIXME: This and the next error needn't have restarts.
-	     (with-simple-restart (continue "Ignore this nickname.")
-	       (error 'simple-package-error
-		      :package package
-		      :format-control "~S is a package name, so it cannot be a nickname for ~S."
-		      :format-arguments (list n (package-%name package)))))
+             (error 'simple-package-error
+                    :package package
+                    :format-control "~S is a package name, so it cannot be a nickname for ~S."
+                    :format-arguments (list n (package-%name package))))
 	    (t
-	     (with-simple-restart (continue "Redefine this nickname.")
-	       (error 'simple-package-error
-		      :package package
-		      :format-control "~S is already a nickname for ~S."
-		      :format-arguments (list n (package-%name found))))
-	     (setf (gethash n *package-names*) package)
-	     (push n (package-%nicknames package)))))))
+             (error 'simple-package-error
+                    :package package
+                    :format-control "~S is already a nickname for ~S."
+                    :format-arguments (list n (package-%name found))))))))
 
 (defun make-package (name &key
 			  (use '#.*default-package-use-list*)
@@ -575,19 +570,23 @@
       (enter-new-nicknames package nicknames))
     package))
 
-(defun delete-package (package-or-name)
+(defun delete-package (package-designator)
   #!+sb-doc
-  "Delete the package-or-name from the package system data structures."
-  (let ((package (if (packagep package-or-name)
-		     package-or-name
-		     (find-package package-or-name))))
+  "Delete the package designated by PACKAGE-DESIGNATOR from the package
+  system data structures."
+  (let ((package (if (packagep package-designator)
+		     package-designator
+		     (find-package package-designator))))
     (cond ((not package)
 	   ;; This continuable error is required by ANSI.
-	   (with-simple-restart (continue "Return NIL")
-	     (error 'simple-package-error
-		    :package package-or-name
-		    :format-control "There is no package named ~S."
-		    :format-arguments (list package-or-name))))
+           (cerror
+            "Return ~S."
+            (make-condition
+             'simple-package-error
+             :package package-designator
+             :format-control "There is no package named ~S."
+             :format-arguments (list package-designator))
+            nil))
 	  ((not (package-name package)) ; already deleted
 	   nil)
 	  (t
@@ -596,15 +595,16 @@
 	     (let ((use-list (package-used-by-list package)))
 	       (when use-list
 		 ;; This continuable error is specified by ANSI.
-		 (with-simple-restart
-		     (continue "Remove dependency in other packages.")
-		   (error 'simple-package-error
-			  :package package
-			  :format-control
-			  "Package ~S is used by package(s):~%  ~S"
-			  :format-arguments
-			  (list (package-name package)
-				(mapcar #'package-name use-list))))
+                 (cerror
+                  "Remove dependency in other packages."
+                  (make-condition
+                   'simple-package-error
+                   :package package
+                   :format-control
+                   "~@<Package ~S is used by package~P:~2I~_~S~@:>"
+                   :format-arguments (list (package-name package)
+                                           (length use-list)
+                                           (mapcar #'package-name use-list))))
 		 (dolist (p use-list)
 		   (unuse-package package p))))
 	     (dolist (used (package-use-list package))
@@ -642,7 +642,8 @@
 
 (defun intern (name &optional (package (sane-package)))
   #!+sb-doc
-  "Return a symbol having the specified name, creating it if necessary."
+  "Return a symbol in PACKAGE having the specified NAME, creating it
+  if necessary."
   ;; We just simple-stringify the name and call INTERN*, where the real
   ;; logic is.
   (let ((name (if (simple-string-p name)
@@ -656,8 +657,8 @@
 
 (defun find-symbol (name &optional (package (sane-package)))
   #!+sb-doc
-  "Return the symbol named String in Package. If such a symbol is found
-  then the second value is :internal, :external or :inherited to indicate
+  "Return the symbol named STRING in PACKAGE. If such a symbol is found
+  then the second value is :INTERNAL, :EXTERNAL or :INHERITED to indicate
   how the symbol is accessible. If no symbol is found then both values
   are NIL."
   ;; We just simple-stringify the name and call FIND-SYMBOL*, where the
@@ -715,7 +716,7 @@
 	      (shiftf (cdr prev) (cdr table) (cdr head) table))
 	    (return-from find-symbol* (values symbol :inherited))))))))
 
-;;; Similar to Find-Symbol, but only looks for an external symbol.
+;;; Similar to FIND-SYMBOL, but only looks for an external symbol.
 ;;; This is used for fast name-conflict checking in this file and symbol
 ;;; printing in the printer.
 (defun find-external-symbol (string package)
@@ -728,12 +729,145 @@
 			string length hash ehash)
       (values symbol found))))
 
+(define-condition name-conflict (reference-condition package-error)
+  ((function :initarg :function :reader name-conflict-function)
+   (datum :initarg :datum :reader name-conflict-datum)
+   (symbols :initarg :symbols :reader name-conflict-symbols))
+  (:default-initargs :references (list '(:ansi-cl :section (11 1 1 2 5))))
+  (:report
+   (lambda (c s)
+     (format s "~@<~S ~S causes name-conflicts in ~S between the ~
+                following symbols:~2I~@:_~{~S~^, ~}~:@>"
+             (name-conflict-function c)
+             (name-conflict-datum c)
+             (package-error-package c)
+             (name-conflict-symbols c)))))
+
+(defun name-conflict (package function datum &rest symbols)
+  (restart-case
+      (error 'name-conflict :package package :symbols symbols
+             :function function :datum datum)
+    (resolve-conflict (s)
+      :report "Resolve conflict."
+      :interactive
+      (lambda ()
+        (let* ((len (length symbols))
+               (nlen (length (write-to-string len :base 10))))
+          (format *query-io* "~&~@<Select a symbol to be made accessible in ~
+                              package ~A:~2I~@:_~{~{~V,' D. ~S~}~@:_~}~@:>"
+                (package-name package)
+                (loop for s in symbols
+                      for i upfrom 1
+                      collect (list nlen i s)))
+          (loop
+           (format *query-io* "~&Enter an integer (between 1 and ~D): " len)
+           (finish-output *query-io*)
+           (let ((i (parse-integer (read-line *query-io*) :junk-allowed t)))
+             (when (and i (<= 1 i len))
+               (return (list (nth (1- i) symbols))))))))
+      (multiple-value-bind (symbol status)
+          (find-symbol (symbol-name s) package)
+        (declare (ignore status)) ; FIXME: is that true?
+        (case function
+          ((export)
+           (if (eq symbol s)
+               (shadow symbol package)
+               (unintern symbol package)))
+          ((unintern)
+           (shadowing-import s package))
+          ((import)
+           (if (eq symbol s)
+               nil ; do nothing
+               (shadowing-import s package)))
+          ((use-package)
+           (if (eq symbol s)
+               (shadow s package)
+               (shadowing-import s package))))))))
+
+#+nil ; this solution gives a variable number of restarts instead, but
+      ; no good way of programmatically choosing between them.
+(defun name-conflict (package function datum &rest symbols)
+  (let ((condition (make-condition 'name-conflict
+                                   :package package :symbols symbols
+                                   :function function :datum datum)))
+    ;; this is a gross violation of modularity, but I can't see any
+    ;; other way to have a variable number of restarts.
+    (let ((*restart-clusters*
+           (cons
+            (mapcan
+             (lambda (s)
+               (multiple-value-bind (accessible-symbol status)
+                   (find-symbol (symbol-name s) package)
+                 (cond
+                   ;; difficult case
+                   ((eq s accessible-symbol)
+                    (ecase status
+                      ((:inherited)
+                       (list (make-restart
+                              :name (make-symbol "SHADOWING-IMPORT")
+                              :function (lambda ()
+                                          (shadowing-import s package)
+                                          (return-from name-conflict))
+                              :report-function
+                              (lambda (stream)
+                                (format stream "Shadowing-import ~S into ~A."
+                                        s (package-%name package))))))
+                      ((:internal :external)
+                       (aver (= (length symbols) 2))
+                       ;; ARGH! FIXME: this unintern restart can
+                       ;; _still_ leave the system in an
+                       ;; unsatisfactory state: if the symbol is a
+                       ;; external symbol of a package which is
+                       ;; already used by this package, and has also
+                       ;; been imported, then uninterning it from this
+                       ;; package will still leave it visible!
+                       ;;
+                       ;; (DEFPACKAGE "FOO" (:EXPORT "SYM"))
+                       ;; (DEFPACKAGE "BAR" (:EXPORT "SYM"))
+                       ;; (DEFPACKAGE "BAZ" (:USE "FOO"))
+                       ;; (IMPORT 'FOO:SYM "BAZ")
+                       ;; (USE-PACKAGE "BAR" "BAZ")
+                       ;;
+                       ;; Now (UNINTERN 'FOO:SYM "BAZ") doesn't
+                       ;; resolve the conflict. :-(
+                       ;;
+                       ;; -- CSR, 2004-10-20
+                       (list (make-restart
+                              :name (make-symbol "UNINTERN")
+                              :function (lambda ()
+                                          (unintern s package)
+                                          (import
+                                           (find s symbols :test-not #'eq)
+                                           package)
+                                          (return-from name-conflict))
+                              :report-function
+                              (lambda (stream)
+                                (format stream
+                                        "Unintern ~S from ~A and import ~S."
+                                        s
+                                        (package-%name package)
+                                        (find s symbols :test-not #'eq))))))))
+                   (t (list (make-restart
+                             :name (make-symbol "SHADOWING-IMPORT")
+                             :function (lambda ()
+                                         (shadowing-import s package)
+                                         (return-from name-conflict))
+                             :report-function
+                             (lambda (stream)
+                               (format stream "Shadowing-import ~S into ~A."
+                                       s (package-%name package)))))))))
+             symbols)
+            *restart-clusters*)))
+      (with-condition-restarts condition (car *restart-clusters*)
+        (with-simple-restart (abort "Leave action undone.")
+          (error condition))))))
+
 ;;; If we are uninterning a shadowing symbol, then a name conflict can
 ;;; result, otherwise just nuke the symbol.
 (defun unintern (symbol &optional (package (sane-package)))
   #!+sb-doc
-  "Makes Symbol no longer present in Package. If Symbol was present
-  then T is returned, otherwise NIL. If Package is Symbol's home
+  "Makes SYMBOL no longer present in PACKAGE. If SYMBOL was present
+  then T is returned, otherwise NIL. If PACKAGE is SYMBOL's home
   package, then it is made uninterned."
   (let* ((package (find-undeleted-package-or-lose package))
 	 (name (symbol-name symbol))
@@ -744,29 +878,16 @@
       (when (find-symbol name package)
 	(assert-package-unlocked package "uninterning ~A" name))
       
-      ;; If a name conflict is revealed, give use a chance to shadowing-import
-      ;; one of the accessible symbols.
+      ;; If a name conflict is revealed, give us a chance to
+      ;; shadowing-import one of the accessible symbols.
       (when (member symbol shadowing-symbols)
 	(let ((cset ()))
 	  (dolist (p (package-%use-list package))
 	    (multiple-value-bind (s w) (find-external-symbol name p)
 	      (when w (pushnew s cset))))
 	  (when (cdr cset)
-	    (loop
-	     (cerror
-	      "Prompt for a symbol to SHADOWING-IMPORT."
-	      "Uninterning symbol ~S causes name conflict among these symbols:~%~S"
-	      symbol cset)
-	     (write-string "Symbol to shadowing-import: " *query-io*)
-	     (let ((sym (read *query-io*)))
-	       (cond
-		 ((not (symbolp sym))
-		  (format *query-io* "~S is not a symbol." sym))
-		 ((not (member sym cset))
-		  (format *query-io* "~S is not one of the conflicting symbols." sym))
-		 (t
-		  (shadowing-import sym package)
-		  (return-from unintern t)))))))
+            (apply #'name-conflict package 'unintern symbol cset)
+            (return-from unintern t)))
 	(setf (package-%shadowing-symbols package)
 	      (remove symbol shadowing-symbols)))
 
@@ -817,7 +938,7 @@
 
 (defun export (symbols &optional (package (sane-package)))
   #!+sb-doc
-  "Exports Symbols from Package, checking that no name conflicts result."
+  "Exports SYMBOLS from PACKAGE, checking that no name conflicts result."
   (let ((package (find-undeleted-package-or-lose package))
 	(syms ()))
     ;; Punt any symbols that are already external.
@@ -833,36 +954,20 @@
 				 (length syms) syms))
       ;; Find symbols and packages with conflicts.
       (let ((used-by (package-%used-by-list package))
-	    (cpackages ())
 	    (cset ()))
 	(dolist (sym syms)
 	  (let ((name (symbol-name sym)))
 	    (dolist (p used-by)
 	      (multiple-value-bind (s w) (find-symbol name p)
-		(when (and w (not (eq s sym))
+		(when (and w
+                           (not (eq s sym))
 			   (not (member s (package-%shadowing-symbols p))))
-		  (pushnew sym cset)
-		  (pushnew p cpackages))))))
+                  ;; Beware: the name conflict is in package P, not in
+                  ;; PACKAGE.
+                  (name-conflict p 'export sym sym s)
+                  (pushnew sym cset))))))
 	(when cset
-	  (restart-case
-	      (error
-	       'simple-package-error
-	       :package package
-	       :format-control
-	       "Exporting these symbols from the ~A package:~%~S~%~
-	        results in name conflicts with these packages:~%~{~A ~}"
-	       :format-arguments
-	       (list (package-%name package) cset
-		     (mapcar #'package-%name cpackages)))
-	    (unintern-conflicting-symbols ()
-	      :report "Unintern conflicting symbols."
-	      (dolist (p cpackages)
-		(dolist (sym cset)
-		  (moby-unintern sym p))))
-	    (skip-exporting-these-symbols ()
-	      :report "Skip exporting conflicting symbols."
-	      (setq syms (nset-difference syms cset))))))
-
+          (setq syms (set-difference syms cset))))
       ;; Check that all symbols are accessible. If not, ask to import them.
       (let ((missing ())
 	    (imports ()))
@@ -873,15 +978,14 @@
 		  ((eq w :inherited)
 		   (push sym imports)))))
 	(when missing
-	  (with-simple-restart
-	      (continue "Import these symbols into the ~A package."
-			(package-%name package))
-	    (error 'simple-package-error
-		   :package package
-		   :format-control
-		   "These symbols are not accessible in the ~A package:~%~S"
-		   :format-arguments
-		   (list (package-%name package) missing)))
+          (cerror
+           "~S these symbols into the ~A package."
+           (make-condition
+            'simple-package-error
+            :package package
+            :format-control
+            "~@<These symbols are not accessible in the ~A package:~2I~_~S~@:>"
+            :format-arguments (list (package-%name package) missing)))
 	  (import missing package))
 	(import imports package))
 
@@ -896,7 +1000,7 @@
 ;;; Check that all symbols are accessible, then move from external to internal.
 (defun unexport (symbols &optional (package (sane-package)))
   #!+sb-doc
-  "Makes Symbols no longer exported from Package."
+  "Makes SYMBOLS no longer exported from PACKAGE."
   (let ((package (find-undeleted-package-or-lose package))
 	(syms ()))
     (dolist (sym (symbol-listify symbols))
@@ -922,55 +1026,44 @@
 ;;; shadowing-import if there is.
 (defun import (symbols &optional (package (sane-package)))
   #!+sb-doc
-  "Make Symbols accessible as internal symbols in Package. If a symbol
+  "Make SYMBOLS accessible as internal symbols in PACKAGE. If a symbol
   is already accessible then it has no effect. If a name conflict
   would result from the importation, then a correctable error is signalled."
   (let* ((package (find-undeleted-package-or-lose package))
 	 (symbols (symbol-listify symbols))
 	 (homeless (remove-if #'symbol-package symbols))
-	 (syms ())
-	 (cset ()))
-    (dolist (sym symbols)
-      (multiple-value-bind (s w) (find-symbol (symbol-name sym) package)
-	(cond ((not w)
-	       (let ((found (member sym syms :test #'string=)))
-		 (if found
-		     (when (not (eq (car found) sym))
-		       (push sym cset))
-		     (push sym syms))))
-	      ((not (eq s sym)) (push sym cset))
-	      ((eq w :inherited) (push sym syms)))))
+	 (syms ()))
     (with-single-package-locked-error ()
-      (when (or homeless syms cset)
-	(let ((union (delete-duplicates (append homeless syms cset))))
+      (dolist (sym symbols)
+        (multiple-value-bind (s w) (find-symbol (symbol-name sym) package)
+          (cond ((not w)
+                 (let ((found (member sym syms :test #'string=)))
+                   (if found
+                       (when (not (eq (car found) sym))
+                         (name-conflict package 'import sym sym (car found)))
+                       (push sym syms))))
+                ((not (eq s sym))
+                 (name-conflict package 'import sym sym s))
+                ((eq w :inherited) (push sym syms)))))
+      (when (or homeless syms)
+	(let ((union (delete-duplicates (append homeless syms))))
 	  (assert-package-unlocked package "importing symbol~P ~{~A~^, ~}" 
 				   (length union) union)))
-      (when cset
-	;; ANSI specifies that this error is correctable.
-	(with-simple-restart
-	    (continue "Import these symbols with Shadowing-Import.")
-	  (error 'simple-package-error
-		 :package package
-		 :format-control
-		 "Importing these symbols into the ~A package ~
-		causes a name conflict:~%~S"
-		 :format-arguments (list (package-%name package) cset))))
       ;; Add the new symbols to the internal hashtable.
       (let ((internal (package-internal-symbols package)))
 	(dolist (sym syms)
 	  (add-symbol internal sym)))
-      ;; If any of the symbols are uninterned, make them be owned by Package.
+      ;; If any of the symbols are uninterned, make them be owned by PACKAGE.
       (dolist (sym homeless)
 	(%set-symbol-package sym package))
-      (shadowing-import cset package))))
+      t)))
 
 ;;; If a conflicting symbol is present, unintern it, otherwise just
 ;;; stick the symbol in.
 (defun shadowing-import (symbols &optional (package (sane-package)))
   #!+sb-doc
-  "Import Symbols into package, disregarding any name conflict. If
-  a symbol of the same name is present, then it is uninterned.
-  The symbols are added to the Package-Shadowing-Symbols."
+  "Import SYMBOLS into package, disregarding any name conflict. If
+  a symbol of the same name is present, then it is uninterned."
   (let* ((package (find-undeleted-package-or-lose package))
 	 (internal (package-internal-symbols package))
 	 (symbols (symbol-listify symbols))
@@ -996,11 +1089,10 @@
 
 (defun shadow (symbols &optional (package (sane-package)))
   #!+sb-doc
-  "Make an internal symbol in Package with the same name as each of the
-  specified symbols, adding the new symbols to the Package-Shadowing-Symbols.
-  If a symbol with the given name is already present in Package, then
-  the existing symbol is placed in the shadowing symbols list if it is
-  not already present."
+  "Make an internal symbol in PACKAGE with the same name as each of
+  the specified SYMBOLS. If a symbol with the given name is already
+  present in PACKAGE, then the existing symbol is placed in the
+  shadowing symbols list if it is not already present."
   (let* ((package (find-undeleted-package-or-lose package))
 	 (internal (package-internal-symbols package))
 	 (symbols (string-listify symbols))
@@ -1026,9 +1118,9 @@
 ;;; Do stuff to use a package, with all kinds of fun name-conflict checking.
 (defun use-package (packages-to-use &optional (package (sane-package)))
   #!+sb-doc
-  "Add all the Packages-To-Use to the use list for Package so that
+  "Add all the PACKAGES-TO-USE to the use list for PACKAGE so that
   the external symbols of the used packages are accessible as internal
-  symbols in Package."
+  symbols in PACKAGE."
   (let ((packages (package-listify packages-to-use))
 	(package (find-undeleted-package-or-lose package)))
 
@@ -1038,14 +1130,14 @@
 	(unless (member pkg (package-%use-list package))
 	  (assert-package-unlocked package "using package~P ~{~A~^, ~}"
 				   (length packages) packages)
-	  (let ((cset ())
-		(shadowing-symbols (package-%shadowing-symbols package))
+	  (let ((shadowing-symbols (package-%shadowing-symbols package))
 		(use-list (package-%use-list package)))
 	  
-	    ;;   If the number of symbols already accessible is less than the
-	    ;; number to be inherited then it is faster to run the test the
-	    ;; other way. This is particularly valuable in the case of
-	    ;; a new package USEing Lisp.
+	    ;; If the number of symbols already accessible is less
+	    ;; than the number to be inherited then it is faster to
+	    ;; run the test the other way. This is particularly
+	    ;; valuable in the case of a new package USEing
+	    ;; COMMON-LISP.
 	    (cond
 	      ((< (+ (package-internal-symbol-count package)
 		     (package-external-symbol-count package)
@@ -1056,34 +1148,29 @@
 	       (do-symbols (sym package)
 		 (multiple-value-bind (s w)
 		     (find-external-symbol (symbol-name sym) pkg)
-		   (when (and w (not (eq s sym))
+		   (when (and w
+                              (not (eq s sym))
 			      (not (member sym shadowing-symbols)))
-		     (push sym cset))))
+                     (name-conflict package 'use-package pkg sym s))))
 	       (dolist (p use-list)
 		 (do-external-symbols (sym p)
 		   (multiple-value-bind (s w)
 		       (find-external-symbol (symbol-name sym) pkg)
-		     (when (and w (not (eq s sym))
-				(not (member (find-symbol (symbol-name sym)
-							  package)
-					     shadowing-symbols)))
-		       (push sym cset))))))
+		     (when (and w
+                                (not (eq s sym))
+				(not (member
+                                      (find-symbol (symbol-name sym) package)
+                                      shadowing-symbols)))
+                       (name-conflict package 'use-package pkg sym s))))))
 	      (t
 	       (do-external-symbols (sym pkg)
 		 (multiple-value-bind (s w)
 		     (find-symbol (symbol-name sym) package)
-		   (when (and w (not (eq s sym))
+		   (when (and w
+                              (not (eq s sym))
 			      (not (member s shadowing-symbols)))
-		     (push s cset))))))
-
-	    (when cset
-	      (cerror
-	       "Unintern the conflicting symbols in the ~2*~A package."
-	       "Using package ~A results in name conflicts for these symbols:~%~
-                ~S"
-	       (package-%name pkg) cset (package-%name package))
-	      (dolist (s cset) (moby-unintern s package))))
-
+                     (name-conflict package 'use-package pkg sym s)))))))
+          
 	  (push pkg (package-%use-list package))
 	  (push (package-external-symbols pkg) (cdr (package-tables package)))
 	  (push package (package-%used-by-list pkg))))))

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

Modified Files:
	NEWS package-data-list.lisp-expr version.lisp-expr 
Log Message:
0.8.16.4:
	Fix for bug reported by Bruno Haible cmucl-imp 2004-10-19:
	... be more clear about when situations are name conflicts
	... signal symbol-by-symbol rather than all at once, so that...
	... a restart can be offered to resolve the conflicts in favour
		of any of the conflicting symbols
	... document the condition type, symbol list accessor and restart
	... also frob the docstrings a little for sbcl house style


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.641
retrieving revision 1.642
diff -u -d -r1.641 -r1.642
--- NEWS	26 Oct 2004 10:24:54 -0000	1.641
+++ NEWS	26 Oct 2004 11:43:49 -0000	1.642
@@ -1,11 +1,17 @@
 changes in sbcl-0.8.17 relative to sbcl-0.8.16:
   * bug fix: READ, READ-PRESERVING-WHITESPACE, READ-DELIMITED-LIST,
     and READ-FROM-STRING all now return a primary value of NIL if
-    *READ-SUPPRESS* is true. (reported by Bruno Haible for CMUCL)
+    *READ-SUPPRESS* is true.  (reported by Bruno Haible for CMUCL)
   * bug fix: Default value of EOF-ERROR-P in READ-FROM-STRING is true.
     (reported by Bruno Haible for CMUCL)
   * bug fix: ERROR now signals a TYPE-ERROR if the arguments to ERROR
-    do not designate a condition. (reported by Bruno Haible for CMUCL)
+    do not designate a condition.  (reported by Bruno Haible for
+    CMUCL)
+  * bug fix: UNINTERN, USE-PACKAGE, IMPORT and EXPORT all signal an
+    SB-EXT:NAME-CONFLICT condition (subtype of PACKAGE-ERROR) in the
+    name conflict situations in CLHS 11.1.1.2.5, and provide a restart
+    permitting resolution in favour of any of the conflicting symbols.
+    (reported by Bruno Haible for CMUCL)
 
 changes in sbcl-0.8.16 relative to sbcl-0.8.15:
   * enhancement: saving cores with foreign code loaded is now

Index: package-data-list.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/package-data-list.lisp-expr,v
retrieving revision 1.290
retrieving revision 1.291
diff -u -d -r1.290 -r1.291
--- package-data-list.lisp-expr	13 Sep 2004 07:14:38 -0000	1.290
+++ package-data-list.lisp-expr	26 Oct 2004 11:43:49 -0000	1.291
@@ -866,6 +866,10 @@
 	       "FORMAT-ARGS-MISMATCH" "FORMAT-TOO-FEW-ARGS-WARNING"
 	       "FORMAT-TOO-MANY-ARGS-WARNING" "EXTENSION-FAILURE"
 
+               "NAME-CONFLICT" "NAME-CONFLICT-FUNCTION"
+               "NAME-CONFLICT-DATUM" "NAME-CONFLICT-SYMBOLS"
+               "RESOLVE-CONFLICT"
+               
 	       ;; ..and DEFTYPEs..
 	       "INDEX" "LOAD/STORE-INDEX"
 	       "SIGNED-BYTE-WITH-A-BITE-OUT"

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1866
retrieving revision 1.1867
diff -u -d -r1.1866 -r1.1867
--- version.lisp-expr	26 Oct 2004 11:01:20 -0000	1.1866
+++ version.lisp-expr	26 Oct 2004 11:43:49 -0000	1.1867
@@ -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".)
-"0.8.16.3"
+"0.8.16.4"

Update of /cvsroot/sbcl/sbcl/doc/manual
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20271/doc/manual

Modified Files:
	beyond-ansi.texinfo 
Log Message:
0.8.16.4:
	Fix for bug reported by Bruno Haible cmucl-imp 2004-10-19:
	... be more clear about when situations are name conflicts
	... signal symbol-by-symbol rather than all at once, so that...
	... a restart can be offered to resolve the conflicts in favour
		of any of the conflicting symbols
	... document the condition type, symbol list accessor and restart
	... also frob the docstrings a little for sbcl house style


Index: beyond-ansi.texinfo
===================================================================
RCS file: /cvsroot/sbcl/sbcl/doc/manual/beyond-ansi.texinfo,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- beyond-ansi.texinfo	14 Sep 2004 06:51:13 -0000	1.16
+++ beyond-ansi.texinfo	26 Oct 2004 11:43:49 -0000	1.17
@@ -11,6 +11,7 @@
 * Support For Unix::            
 * Customization Hooks for Users::  
 * Tools To Help Developers::    
+* Resolution of Name Conflicts::
 * Stale Extensions::            
 * Efficiency Hacks::            
 @end menu
@@ -92,7 +93,7 @@
 @include fun-common-lisp-ed.texinfo
 @include var-sb-ext-star-ed-functions-star.texinfo
 
-@...  Tools To Help Developers
+@node Tools To Help Developers
 @comment  node-name,  next,  previous,  up
 @section Tools To Help Developers
 
@@ -105,6 +106,17 @@
 Documentation for @code{inspect} is accessed by typing @kbd{help} at
 the @code{inspect} prompt.
 
+@node Resolution of Name Conflicts
+@section Resolution of Name Conflicts
+
+The ANSI standard (section 11.1.1.2.5) requires that name conflicts in
+packages be resolvable in favour of any of the conflicting symbols.  In
+the interactive debugger, this is achieved by prompting for the symbol
+in whose favour the conflict should be resolved; for programmatic use,
+the @code{sb-ext:resolve-conflict} restart should be invoked with one
+argument, which should be a member of the list returned by the condition
+accessor @code{sb-ext:name-conflict-symbols}.
+
 @node Stale Extensions
 @comment  node-name,  next,  previous,  up
 @section Stale Extensions

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

Modified Files:
	version.lisp-expr 
Log Message:
0.8.16.3:
	Unlock packages in chill.lisp


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1865
retrieving revision 1.1866
diff -u -d -r1.1865 -r1.1866
--- version.lisp-expr	26 Oct 2004 10:24:54 -0000	1.1865
+++ version.lisp-expr	26 Oct 2004 11:01:20 -0000	1.1866
@@ -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".)
-"0.8.16.2"
+"0.8.16.3"

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

Modified Files:
	chill.lisp 
Log Message:
0.8.16.3:
	Unlock packages in chill.lisp


Index: chill.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/cold/chill.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- chill.lisp	10 Feb 2003 12:32:08 -0000	1.5
+++ chill.lisp	26 Oct 2004 11:01:21 -0000	1.6
@@ -29,19 +29,23 @@
 ;;; Just in case we want to play with the initial value of
 ;;; backend-subfeatures
 (setf sb-cold:*shebang-backend-subfeatures* sb-c:*backend-subfeatures*)
-;;; The nickname SB!XC now refers to the CL package.
-(rename-package "COMMON-LISP"
-		"COMMON-LISP"
-		(cons "SB!XC" (package-nicknames "CL")))
 
-;;; Any other name SB!FOO refers to the package now called SB-FOO.
-(dolist (package (list-all-packages))
-  (let ((name (package-name package))
-	(nicknames (package-nicknames package))
-	(warm-name-prefix "SB-")
-	(cold-name-prefix "SB!"))
-    (when (and (> (length name) (length warm-name-prefix))
-	       (string= name warm-name-prefix :end1 (length warm-name-prefix)))
-      (let* ((stem (subseq name (length cold-name-prefix)))
-	     (cold-name (concatenate 'simple-string cold-name-prefix stem)))
-	(rename-package package name (cons cold-name nicknames))))))
+(handler-bind ((sb-ext:package-locked-error #'continue))
+  ;; The nickname SB!XC now refers to the CL package.
+  (rename-package "COMMON-LISP" "COMMON-LISP"
+                  (cons "SB!XC" (package-nicknames "CL")))
+  (sb-ext:unlock-package "CL")
+
+  ;; Any other name SB!FOO refers to the package now called SB-FOO.
+  (dolist (package (list-all-packages))
+    (let ((name (package-name package))
+          (nicknames (package-nicknames package))
+          (warm-name-prefix "SB-")
+          (cold-name-prefix "SB!"))
+      (when (and (> (length name) (length warm-name-prefix))
+                 (string= name warm-name-prefix
+                          :end1 (length warm-name-prefix)))
+        (let* ((stem (subseq name (length cold-name-prefix)))
+               (cold-name (concatenate 'simple-string cold-name-prefix stem)))
+          (rename-package package name (cons cold-name nicknames)))
+        (sb-ext:unlock-package package)))))

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

Modified Files:
	class.lisp 
Log Message:
0.8.16.2: TYPE-ERROR for ERROR
           * ANSI sayeth that we should signal a TYPE-ERROR
              if arguments to ERROR are silly. Make it so.


Index: class.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/class.lisp,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -d -r1.50 -r1.51
--- class.lisp	10 Aug 2004 00:20:45 -0000	1.50
+++ class.lisp	26 Oct 2004 10:24:55 -0000	1.51
@@ -702,13 +702,15 @@
 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
 (defun find-classoid (name &optional (errorp t) environment)
   #!+sb-doc
-  "Return the class with the specified NAME. If ERRORP is false, then NIL is
-   returned when no such class exists."
+  "Return the class with the specified NAME. If ERRORP is false, then
+NIL is returned when no such class exists."
   (declare (type symbol name) (ignore environment))
   (let ((res (classoid-cell-classoid (find-classoid-cell name))))
     (if (or res (not errorp))
 	res
-	(error "class not yet defined:~%  ~S" name))))
+	(error 'simple-type-error
+               :format-control "class not yet defined:~%  ~S" 
+               :format-arguments (list name)))))
 (defun (setf find-classoid) (new-value name)
   #-sb-xc (declare (type (or null classoid) new-value))
   (cond

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

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.16.2: TYPE-ERROR for ERROR
           * ANSI sayeth that we should signal a TYPE-ERROR
              if arguments to ERROR are silly. Make it so.


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.640
retrieving revision 1.641
diff -u -d -r1.640 -r1.641
--- NEWS	26 Oct 2004 09:50:38 -0000	1.640
+++ NEWS	26 Oct 2004 10:24:54 -0000	1.641
@@ -4,6 +4,8 @@
     *READ-SUPPRESS* is true. (reported by Bruno Haible for CMUCL)
   * bug fix: Default value of EOF-ERROR-P in READ-FROM-STRING is true.
     (reported by Bruno Haible for CMUCL)
+  * bug fix: ERROR now signals a TYPE-ERROR if the arguments to ERROR
+    do not designate a condition. (reported by Bruno Haible for CMUCL)
 
 changes in sbcl-0.8.16 relative to sbcl-0.8.15:
   * enhancement: saving cores with foreign code loaded is now

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1864
retrieving revision 1.1865
diff -u -d -r1.1864 -r1.1865
--- version.lisp-expr	26 Oct 2004 09:50:38 -0000	1.1864
+++ version.lisp-expr	26 Oct 2004 10:24:54 -0000	1.1865
@@ -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".)
-"0.8.16.1"
+"0.8.16.2"

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1662/tests

Modified Files:
	condition.pure.lisp 
Log Message:
0.8.16.2: TYPE-ERROR for ERROR
           * ANSI sayeth that we should signal a TYPE-ERROR
              if arguments to ERROR are silly. Make it so.


Index: condition.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/condition.pure.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- condition.pure.lisp	26 Jun 2004 14:33:42 -0000	1.6
+++ condition.pure.lisp	26 Oct 2004 10:24:56 -0000	1.7
@@ -122,3 +122,18 @@
 		 (subtypep 'fixnum (type-error-expected-type c))))
     (assert (eq (type-error-datum c) t)))
   (:no-error (&rest rest) (error "no error: ~S" rest)))
+
+;;; ANSI specifies TYPE-ERROR if datum and arguments of ERROR are not
+;;; designators for a condition. Reported by Bruno Haible on cmucl-imp
+;;; 2004-10-12.
+(flet ((test (&rest args)
+         (multiple-value-bind (res err) 
+             (ignore-errors (apply #'error args))
+           (assert (not res))
+           (assert (typep err 'type-error)))))
+  (test '#:no-such-condition)
+  (test nil)
+  (test t)
+  (test 42)
+  (test (make-instance 'standard-object)))
+

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

Modified Files:
	reader.lisp 
Log Message:
0.8.16.1: reader ANSI fixes
           * Return primary value NIL for various READ-FOO when
              *READ-SUPPRESS* is NIL.
           * Eof-error-p in READ-FROM-STRING defaults true.

          HEALTH WARNING: These changes will probably break Slime,
           or at least parts thereof. Slime patch forthcoming.


Index: reader.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/reader.lisp,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- reader.lisp	26 Jun 2004 14:43:51 -0000	1.33
+++ reader.lisp	26 Oct 2004 09:50:38 -0000	1.34
@@ -407,18 +407,19 @@
   "Read from STREAM and return the value read, preserving any whitespace
    that followed the object."
   (if recursivep
-    ;; a loop for repeating when a macro returns nothing
-    (loop
-      (let ((char (read-char stream eof-error-p *eof-object*)))
-	(cond ((eofp char) (return eof-value))
-	      ((whitespacep char))
-	      (t
-	       (let* ((macrofun (get-coerced-cmt-entry char *readtable*))
-		      (result (multiple-value-list
-			       (funcall macrofun stream char))))
-		 ;; Repeat if macro returned nothing.
-		  (if result (return (car result))))))))
-    (let ((*sharp-equal-alist* nil))
+      ;; a loop for repeating when a macro returns nothing
+      (loop
+       (let ((char (read-char stream eof-error-p *eof-object*)))
+         (cond ((eofp char) (return eof-value))
+               ((whitespacep char))
+               (t
+                (let* ((macrofun (get-coerced-cmt-entry char *readtable*))
+                       (result (multiple-value-list
+                                (funcall macrofun stream char))))
+                  ;; Repeat if macro returned nothing.
+		  (when result 
+                    (return (unless *read-suppress* (car result)))))))))
+      (let ((*sharp-equal-alist* nil))
 	(read-preserving-whitespace stream eof-error-p eof-value t))))
 
 ;;; Return NIL or a list with one thing, depending.
@@ -430,7 +431,8 @@
 		 (funcall (get-coerced-cmt-entry char *readtable*)
 			  stream
 			  char))))
-    (if retval (rplacd retval nil))))
+    (when (and retval (not *read-suppress*))
+      (rplacd retval nil))))
 
 (defun read (&optional (stream *standard-input*)
 		       (eof-error-p t)
@@ -442,9 +444,9 @@
 					    eof-error-p
 					    eof-value
 					    recursivep)))
-    ;; (This function generally discards trailing whitespace. If you
+    ;; This function generally discards trailing whitespace. If you
     ;; don't want to discard trailing whitespace, call
-    ;; CL:READ-PRESERVING-WHITESPACE instead.)
+    ;; CL:READ-PRESERVING-WHITESPACE instead.
     (unless (or (eql result eof-value) recursivep)
       (let ((next-char (read-char stream nil nil)))
 	(unless (or (null next-char)
@@ -1419,7 +1421,7 @@
   #!+sb-doc
   "A resource of string streams for Read-From-String.")
 
-(defun read-from-string (string &optional eof-error-p eof-value
+(defun read-from-string (string &optional (eof-error-p t) eof-value
 				&key (start 0) end
 				preserve-whitespace)
   #!+sb-doc

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27356/tests

Modified Files:
	reader.pure.lisp 
Log Message:
0.8.16.1: reader ANSI fixes
           * Return primary value NIL for various READ-FOO when
              *READ-SUPPRESS* is NIL.
           * Eof-error-p in READ-FROM-STRING defaults true.

          HEALTH WARNING: These changes will probably break Slime,
           or at least parts thereof. Slime patch forthcoming.


Index: reader.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/reader.pure.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- reader.pure.lisp	26 Jun 2004 14:43:58 -0000	1.11
+++ reader.pure.lisp	26 Oct 2004 09:50:39 -0000	1.12
@@ -207,3 +207,20 @@
 		(unless fun (list char)))))))
     (let ((*readtable* (copy-readtable nil)))
       (assert (null (loop for c across standard-chars append (frob c)))))))
+
+;;; All these must return a primary value of NIL when *read-suppress* is T
+;;; Reported by Bruno Haible on cmucl-imp 2004-10-25.
+(let ((*read-suppress* t))
+  (assert (null (read-from-string "(1 2 3)")))
+  (assert (null (with-input-from-string (s "abc xyz)")
+                  (read-delimited-list #\) s))))
+  (assert (null (with-input-from-string (s "(1 2 3)")
+                  (read-preserving-whitespace s))))
+  (assert (null (with-input-from-string (s "(1 2 3)")
+                 (read s)))))
+
+;;; EOF-ERROR-P defaults to true. Reported by Bruno Haible on
+;;; cmucl-imp 2004-10-18.
+(multiple-value-bind (res err) (ignore-errors (read-from-string ""))
+  (assert (not res))
+  (assert (typep err 'end-of-file)))

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

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.16.1: reader ANSI fixes
           * Return primary value NIL for various READ-FOO when
              *READ-SUPPRESS* is NIL.
           * Eof-error-p in READ-FROM-STRING defaults true.

          HEALTH WARNING: These changes will probably break Slime,
           or at least parts thereof. Slime patch forthcoming.


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.639
retrieving revision 1.640
diff -u -d -r1.639 -r1.640
--- NEWS	21 Oct 2004 13:00:22 -0000	1.639
+++ NEWS	26 Oct 2004 09:50:38 -0000	1.640
@@ -1,3 +1,10 @@
+changes in sbcl-0.8.17 relative to sbcl-0.8.16:
+  * bug fix: READ, READ-PRESERVING-WHITESPACE, READ-DELIMITED-LIST,
+    and READ-FROM-STRING all now return a primary value of NIL if
+    *READ-SUPPRESS* is true. (reported by Bruno Haible for CMUCL)
+  * bug fix: Default value of EOF-ERROR-P in READ-FROM-STRING is true.
+    (reported by Bruno Haible for CMUCL)
+
 changes in sbcl-0.8.16 relative to sbcl-0.8.15:
   * enhancement: saving cores with foreign code loaded is now
     supported on x86/NetBSD and sparc/Linux in addition to the previously

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1863
retrieving revision 1.1864
diff -u -d -r1.1863 -r1.1864
--- version.lisp-expr	25 Oct 2004 19:42:41 -0000	1.1863
+++ version.lisp-expr	26 Oct 2004 09:50:38 -0000	1.1864
@@ -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".)
-"0.8.16"
+"0.8.16.1"