diff --git a/code/defstruct.lisp b/code/defstruct.lisp
index 64bab9c885e0468d557302f303ab87912c3c1f59..69ac4021f446112af4877021fca4849c30a63e1f 100644
--- a/code/defstruct.lisp
+++ b/code/defstruct.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.61 1998/03/21 08:11:53 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.62 1998/04/20 11:32:50 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -564,7 +564,9 @@
 		spec))
 	spec))
     (when (find name (dd-slots defstruct) :test #'string= :key #'dsd-%name)
-      (error "Duplicate slot name ~S." name))
+      (error 'program-error
+	     :format-control "Duplicate slot name ~S."
+	     :format-arguments (list name)))
     (setf (dsd-%name islot) (string name))
     (setf (dd-slots defstruct) (nconc (dd-slots defstruct) (list islot)))
 
diff --git a/code/error.lisp b/code/error.lisp
index a10c32e08f39680b9f89932007f00df72c8016f9..a3bfce1988cff13c1ff3227f9edac8b83b20e214 100644
--- a/code/error.lisp
+++ b/code/error.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.46 1997/02/05 16:15:41 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.47 1998/04/20 11:32:50 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -815,8 +815,48 @@
 
 
 ;;;; Condition definitions.
+;;; 4/18/98 pw wants to make format-control and format-arguments
+;;; slots in the condition class so this facility is available
+;;; for all conditions internally -- however, that presents an
+;;; un-nice bootstrap problem. So, for now, lets have 
+;;; serious-condition-xxx so they are easy to grep and get the
+;;; new stuff working, then change to just condition-format-control etc.
+;;;
+;;; On the other hand, we have these two classes serious-condition
+;;; and simple-condition so that default report schemes can be different
+;;; if desired.
+
+(defun serious-condition-printer (condition stream)
+  (apply #'format stream (serious-condition-format-control condition)
+	 		 (serious-condition-format-arguments condition)))
+
+;;; The CLHS 9.1.3.1.5 says that the name of the containing function
+;;; should generally not be mentioned in report printers assuming that
+;;; the debugger will make that info available when appropriate. I (pw)
+;;; do so here because many CMUCL error conditions were previously signaled
+;;; using (error "format-string" (format-args..)) and thus invoking
+;;; the simple-error system. Now that we are changing to providing
+;;; the correct condition type, using this default reporter retains
+;;; the familiar behavior. It is a candidate for change some day.
+;;; Perhaps better would be do define subtypes of file-error and
+;;; package-error with their own :report functions as is done in
+;;; other places (debug-int format ...)
+
+(defun print-serious-condition (condition stream)
+  (format stream "~&~@<Error in function ~S:  ~3i~:_~?~:>"
+	  (condition-function-name condition)
+	  (serious-condition-format-control condition)
+	  (serious-condition-format-arguments condition)))
+
+(define-condition serious-condition (condition)
+  ((format-control :reader serious-condition-format-control
+		   :initarg :format-control
+		   :initform "")
+   (format-arguments :reader serious-condition-format-arguments
+		     :initarg :format-arguments
+		     :initform '()))
+  (:report print-serious-condition))
 
-(define-condition serious-condition (condition) ())
 
 (define-condition error (serious-condition) ())
 
@@ -845,6 +885,8 @@
 	  (simple-condition-format-arguments condition)))
 
 (define-condition simple-error (simple-condition error) ()
+  ;; This is the condition type used by error and cerror when
+  ;; a format-control string is supplied as the first argument.
   (:report print-simple-error))
 
 (define-condition storage-condition (serious-condition) ())
@@ -883,9 +925,9 @@
 
 
 (define-condition program-error (error) ())
-(define-condition parse-error (error) ())
-(define-condition control-error (simple-error) ())
-(define-condition stream-error (error)
+(define-condition parse-error   (error) ())
+(define-condition control-error (error) ())
+(define-condition stream-error  (error)
   ((stream :reader stream-error-stream :initarg :stream)))
 
 (define-condition end-of-file (stream-error) ()
diff --git a/code/filesys.lisp b/code/filesys.lisp
index 2d1c14158ccbbe9935cf1ebeb162d696c4be1010..6aad47383d6521b25fccf607b2b3bd6a3c180206 100644
--- a/code/filesys.lisp
+++ b/code/filesys.lisp
@@ -6,7 +6,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.46 1998/03/01 21:46:05 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.47 1998/04/20 11:32:51 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -661,11 +661,19 @@
 ;;;
 (defun truename (pathname)
   "Return the pathname for the actual file described by the pathname
-  An error is signalled if no such file exists."
-  (let ((result (probe-file pathname)))
-    (unless result
-      (error "The file ~S does not exist." (namestring pathname)))
-    result))
+  An error of type file-error is signalled if no such file exists,
+  or the pathname is wild."
+  (if (wild-pathname-p pathname)
+      (error 'file-error
+	     :format-control "Bad place for a wild pathname."
+	     :pathname pathname)
+      (let ((result (probe-file pathname)))
+	(unless result
+	  (error 'file-error
+		 :pathname pathname
+		 :format-control "The file ~S does not exist."
+		 :format-arguments (list (namestring pathname))))
+	result)))
 
 ;;; Probe-File  --  Public
 ;;;
@@ -673,15 +681,19 @@
 ;;;
 (defun probe-file (pathname)
   "Return a pathname which is the truename of the file if it exists, NIL
-  otherwise."
-  (let ((namestring (unix-namestring pathname t)))
-    (when (and namestring (unix:unix-file-kind namestring))
-      (let ((truename (unix:unix-resolve-links
-		       (unix:unix-maybe-prepend-current-directory
-			namestring))))
-	(when truename
-	  (let ((*ignore-wildcards* t))
-	    (pathname (unix:unix-simplify-pathname truename))))))))
+  otherwise. An error of type file-error is signaled if pathname is wild."
+  (if (wild-pathname-p pathname)
+      (error 'file-error 
+	     :pathname pathname
+	     :format-control "Bad place for a wild pathname.")
+      (let ((namestring (unix-namestring pathname t)))
+	(when (and namestring (unix:unix-file-kind namestring))
+	  (let ((truename (unix:unix-resolve-links
+			   (unix:unix-maybe-prepend-current-directory
+			    namestring))))
+	    (when truename
+	      (let ((*ignore-wildcards* t))
+		(pathname (unix:unix-simplify-pathname truename)))))))))
 
 
 ;;;; Other random operations.
@@ -696,13 +708,19 @@
 	 (new-name (merge-pathnames new-name original))
 	 (new-namestring (unix-namestring new-name nil)))
     (unless new-namestring
-      (error "~S can't be created." new-name))
+      (error 'file-error
+	     :pathname new-name
+	     :format-control "~S can't be created."
+	     :format-arguments (list new-name)))
     (multiple-value-bind (res error)
 			 (unix:unix-rename original-namestring
 					   new-namestring)
       (unless res
-	(error "Failed to rename ~A to ~A: ~A"
-	       original new-name (unix:get-unix-error-msg error)))
+	(error 'file-error
+	       :pathname new-name
+	       :format-control "Failed to rename ~A to ~A: ~A"
+	       :format-arguments (list original new-name
+				       (unix:get-unix-error-msg error))))
       (when (streamp file)
 	(file-name file new-namestring))
       (values new-name original (truename new-name)))))
@@ -717,13 +735,18 @@
     (when (streamp file)
       (close file :abort t))
     (unless namestring
-      (error "~S doesn't exist." file))
+      (error 'file-error
+	     :pathname file
+	     :format-control "~S doesn't exist."
+	     :format-arguments (list file)))
 
     (multiple-value-bind (res err) (unix:unix-unlink namestring)
       (unless res
-	(error "Could not delete ~A: ~A."
-	       namestring
-	       (unix:get-unix-error-msg err)))))
+	(error 'file-error
+	       :pathname namestring
+	       :format-control "Could not delete ~A: ~A."
+	       :format-arguments (list namestring
+				       (unix:get-unix-error-msg err))))))
   t)
 
 
@@ -740,29 +763,41 @@
 ;;; File-Write-Date  --  Public
 ;;;
 (defun file-write-date (file)
-  "Return file's creation date, or NIL if it doesn't exist."
-  (let ((name (unix-namestring file t)))
-    (when name
-      (multiple-value-bind
-	  (res dev ino mode nlink uid gid rdev size atime mtime)
-	  (unix:unix-stat name)
-	(declare (ignore dev ino mode nlink uid gid rdev size atime))
-	(when res
-	  (+ unix-to-universal-time mtime))))))
+  "Return file's creation date, or NIL if it doesn't exist.
+ An error of type file-error is signaled if file is a wild pathname"
+  (if (wild-pathname-p file)
+      (error 'file-error 
+	     :pathname file
+	     :format-control "Bad place for a wild pathname.")
+      (let ((name (unix-namestring file t)))
+	(when name
+	  (multiple-value-bind
+	      (res dev ino mode nlink uid gid rdev size atime mtime)
+	      (unix:unix-stat name)
+	    (declare (ignore dev ino mode nlink uid gid rdev size atime))
+	    (when res
+	      (+ unix-to-universal-time mtime)))))))
 
 ;;; File-Author  --  Public
 ;;;
 (defun file-author (file)
   "Returns the file author as a string, or nil if the author cannot be
-   determined.  Signals an error if file doesn't exist."
-  (let ((name (unix-namestring (pathname file) t)))
-    (unless name
-      (error "~S doesn't exist." file))
-    (multiple-value-bind (winp dev ino mode nlink uid)
-			 (unix:unix-stat name)
-      (declare (ignore dev ino mode nlink))
-      (if winp (lookup-login-name uid)))))
-
+ determined.  Signals an error of type file-error if file doesn't exist,
+ or file is a wild pathname."
+  (if (wild-pathname-p file)
+      (error 'file-error
+	     :pathname file
+	     "Bad place for a wild pathname.")
+      (let ((name (unix-namestring (pathname file) t)))
+	(unless name
+	  (error 'file-error
+		 :pathname file
+		 :format-control "~S doesn't exist."
+		 :format-arguments (list file)))
+	(multiple-value-bind (winp dev ino mode nlink uid)
+			     (unix:unix-stat name)
+	  (declare (ignore dev ino mode nlink))
+	  (if winp (lookup-login-name uid))))))
 
 
 ;;;; DIRECTORY.
@@ -1181,7 +1216,9 @@
 		       pathname))
 	 (created-p nil))
     (when (wild-pathname-p pathname)
-      (error (make-condition 'file-error :pathname pathspec)))
+      (error 'file-error
+	     :format-control "Bad place for a wild pathname."
+	     :pathname pathspec))
     (enumerate-search-list (pathname pathname)
        (let ((dir (pathname-directory pathname)))
 	 (loop for i from 1 upto (length dir)
@@ -1196,8 +1233,10 @@
 				  namestring))
 			(unix:unix-mkdir namestring mode)
 			(unless (probe-file namestring)
-			  (error (make-condition 'file-error
-						 :pathname pathspec)))
+			  (error 'file-error
+				 :pathname pathspec
+				 :format-control "Can't create directory ~A."
+				 :format-arguments (list namestring))))
 			(setf created-p t)))))
 	 ;; Only the first path in a search-list is considered.
 	 (return (values pathname created-p))))))
diff --git a/code/package.lisp b/code/package.lisp
index 4445aed36867e213603ca50c128b0c79869ca304..1ffdd556c7ecb679c9cbebd0964a9fca49f42752 100644
--- a/code/package.lisp
+++ b/code/package.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/package.lisp,v 1.41 1998/03/01 21:46:13 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/package.lisp,v 1.42 1998/04/20 11:32:52 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -507,18 +507,24 @@
 		 (:internal
 		  `(let ((,symbols (package-internal-symbols
 				    (car ,',packages))))
-		     (setf ,',vector (package-hashtable-table ,symbols))
-		     (setf ,',hash-vector (package-hashtable-hash ,symbols))))
+		     (when ,symbols
+		       (setf ,',vector (package-hashtable-table ,symbols))
+		       (setf ,',hash-vector (package-hashtable-hash ,symbols)))))
 		 (:external
 		  `(let ((,symbols (package-external-symbols
 				    (car ,',packages))))
-		     (setf ,',vector (package-hashtable-table ,symbols))
-		     (setf ,',hash-vector (package-hashtable-hash ,symbols))))
+		     (when ,symbols
+		       (setf ,',vector (package-hashtable-table ,symbols))
+		       (setf ,',hash-vector
+			     (package-hashtable-hash ,symbols)))))
 		 (:inherited
-		  `(let ((,symbols (package-external-symbols
-				    (car ,',package-use-list))))
-		     (setf ,',vector (package-hashtable-table ,symbols))
-		     (setf ,',hash-vector (package-hashtable-hash ,symbols))))))))
+		  `(let ((,symbols (and ,',package-use-list
+					(package-external-symbols
+					 (car ,',package-use-list)))))
+		     (when ,symbols
+		       (setf ,',vector (package-hashtable-table ,symbols))
+		       (setf ,',hash-vector
+			     (package-hashtable-hash ,symbols)))))))))
 		  (,end-test-macro (this-kind)
 		     `,(let ((next-kind (cadr (member this-kind
 						      ',ordered-types))))
@@ -529,12 +535,16 @@
 				  (,',init-macro ,(car ',ordered-types)))))))
 	 (when ,packages
 	   ,(when (null symbol-types)
-	      (error "Must supply at least one of :internal, :external, or ~
-	      :inherited."))
+	      (error 'program-error
+		     :format-control
+		     "Must supply at least one of :internal, :external, or ~
+		      :inherited."))
 	   ,(dolist (symbol symbol-types)
 	      (unless (member symbol '(:internal :external :inherited))
-		(error "~S is not one of :internal, :external, or :inherited."
-		       symbol)))
+		(error 'program-error
+		       :format-control
+		       "~S is not one of :internal, :external, or :inherited."
+		       :format-argument symbol)))
 	   (,init-macro ,(car ordered-types))
 	   (flet ((,real-symbol-p (number)
 		    (> number 1)))
@@ -592,7 +602,6 @@
 					 (t (,',init-macro :inherited)
 					    (setf ,',counter nil)))))))))))))
 	       ,@body)))))))
-
 
 ;;;; DEFPACKAGE:
 
@@ -608,7 +617,7 @@
      (:INTERN {symbol-name}*)
      (:EXPORT {symbol-name}*)
      (:DOCUMENTATION doc-string)
-   All options except :SIZE can be used multiple times."
+   All options except :SIZE and :DOCUMENTATION can be used multiple times."
   (let ((nicknames nil)
 	(size nil)
 	(shadows nil)
@@ -623,20 +632,25 @@
 	(doc nil))
     (dolist (option options)
       (unless (consp option)
-	(error "Bogus DEFPACKAGE option: ~S" option))
+	(error 'program-error
+	       :format-control "Bogus DEFPACKAGE option: ~S"
+	       :format-arguments (list option)))
       (case (car option)
 	(:nicknames
 	 (let ((new (stringify-names (cdr option) "package")))
 	   (setf nicknames (append-unique new nicknames :nicknames))))
 	(:size
 	 (cond (size
-		(error "Can't specify :SIZE twice."))
+		(error 'program-error
+		       :format-control "Can't specify :SIZE twice."))
 	       ((and (consp (cdr option))
 		     (typep (second option) 'unsigned-byte))
 		(setf size (second option)))
 	       (t
-		(error "Bogus :SIZE, must be a positive integer: ~S"
-		       (second option)))))
+		(error
+		 'program-error
+		 :format-control "Bogus :SIZE, must be a positive integer: ~S"
+		 :format-arguments (list (second option))))))
 	(:shadow
 	 (let ((new (stringify-names (cdr option) "symbol")))
 	   (setf incomming (append-unique new incomming :shadow))
@@ -674,9 +688,14 @@
 	   (setf outgoing (append-unique new outgoing :export))
 	   (setf exports (append exports new))))
 	(:documentation
+	 (when doc
+	   (error 'program-error
+		  :format-control "Can't specify :DOCUMENTATION twice."))
 	 (setf doc (coerce (second option) 'simple-string)))
 	(t
-	 (error "Bogus DEFPACKAGE option: ~S" option))))
+	 (error 'program-error
+		:format-control "Bogus DEFPACKAGE option: ~S"
+		:format-arguments (list option)))))
     `(eval-when (compile load eval)
        (%defpackage ,(stringify-name package "package") ',nicknames ',size
 		    ',shadows ',shadowing-imports ',(if use-p use :default)
@@ -719,8 +738,10 @@
 				     :internal-symbols (or size 10)
 				     :external-symbols (length exports))))))
     (unless (string= (the string (package-name package)) name)
-      (error "~A is a nick-name for the package ~A"
-	     name (package-name name)))
+      (error 'package-error
+	     :package name
+	     :format-control "~A is a nick-name for the package ~A"
+	     :format-arguments (list name (package-name name))))
     (enter-new-nicknames package nicknames)
     ;; Shadows and Shadowing-imports.
     (let ((old-shadows (package-%shadowing-symbols package)))
@@ -825,6 +846,7 @@
   estimates for the number of internal and external symbols which
   will ultimately be present in the package."
   (when (find-package name)
+    ;; @@@ this is supposed to be a correctable error @@@
     (error "A package named ~S already exists" name))
   (let* ((name (package-namify name))
 	 (package (internal-make-package
@@ -1140,9 +1162,15 @@
 		(pushnew p cpackages))))))
       (when cset
 	(restart-case
-	    (error "Exporting these symbols from the ~A package:~%~S~%~
-		    results in name conflicts with these packages:~%~{~A ~}"
-		   (package-%name package) cset (mapcar #'package-%name cpackages))
+	    (error
+	     '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)
@@ -1186,8 +1214,10 @@
     (dolist (sym (symbol-listify symbols))
       (multiple-value-bind (s w) (find-symbol (symbol-name sym) package)
 	(cond ((or (not w) (not (eq s sym)))
-	       (error "~S is not accessible in the ~A package."
-		      sym (package-%name package)))
+	       (error 'package-error
+		      :package package
+		      :format-control "~S is not accessible in the ~A package."
+		      :format-arguments (list sym (package-%name package))))
 	      ((eq w :external) (pushnew sym syms)))))
 
     (let ((internal (package-internal-symbols package))