From b1ecdd564ac1d6cb93df6e8d3fe5bdd2d1d5dc08 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Wed, 25 Aug 1993 01:15:35 +0000
Subject: [PATCH] Fix compiler warnings.

---
 code/backq.lisp     |  4 ++--
 code/char.lisp      |  4 ++--
 code/error.lisp     | 47 +++++++++++++++++++++++----------------------
 code/globals.lisp   |  4 ++--
 code/hash.lisp      |  8 +++++++-
 code/list.lisp      | 16 ++++++---------
 code/machdef.lisp   |  4 ++--
 code/module.lisp    |  6 +++---
 code/print.lisp     |  5 ++++-
 code/reader.lisp    | 12 ++++++------
 code/seq.lisp       |  4 ++--
 code/setf-funs.lisp |  6 +++---
 code/sort.lisp      |  4 ++--
 code/time.lisp      |  4 ++--
 code/type.lisp      |  4 ++--
 15 files changed, 69 insertions(+), 63 deletions(-)

diff --git a/code/backq.lisp b/code/backq.lisp
index 5b18102a0..01d8ae129 100644
--- a/code/backq.lisp
+++ b/code/backq.lisp
@@ -7,14 +7,14 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/backq.lisp,v 1.8 1993/08/20 00:39:04 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/backq.lisp,v 1.9 1993/08/25 01:12:16 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
 ;;;    BACKQUOTE: Code Spice Lispified by Lee Schumacher.
 ;;;   		  (unparsing by Miles Bader)
 ;;;
-(in-package 'lisp)
+(in-package "LISP")
 
 
 ;;; The flags passed back by BACKQUOTIFY can be interpreted as follows:
diff --git a/code/char.lisp b/code/char.lisp
index 603fe3d30..576a37def 100644
--- a/code/char.lisp
+++ b/code/char.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/char.lisp,v 1.7 1993/02/17 17:27:16 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/char.lisp,v 1.8 1993/08/25 01:12:31 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -24,7 +24,7 @@
 ;;; Hacked up for speed by Scott Fahlman.
 ;;; Font support flushed and type hackery rewritten by Rob MacLachlan.
 ;;;
-(in-package 'lisp)
+(in-package "LISP")
 
 (export '(char-code-limit standard-char-p graphic-char-p 
 	  alpha-char-p upper-case-p lower-case-p both-case-p digit-char-p
diff --git a/code/error.lisp b/code/error.lisp
index f39425369..d056ae76a 100644
--- a/code/error.lisp
+++ b/code/error.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.32 1993/08/19 17:14:40 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.33 1993/08/25 01:13:02 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -513,7 +513,8 @@
 (define-condition serious-condition (condition) ())
 
 (define-condition error (serious-condition)
-  ((function-name nil)))
+  ((function-name :init-form nil
+		  :accessor serious-condition-function-name)))
 
 (define-condition warning (condition) ())
 (define-condition style-warning (warning) ())
@@ -551,21 +552,20 @@
 ;;; the user sees.
 ;;;
 (define-condition simple-warning (warning)
-  (format-control
-   (format-arguments '()))
-  (:conc-name internal-simple-warning-)
+  ((format-control :accessor internal-simple-warning-format-control)
+   (format-arguments :init-form '()
+		     :accessor internal-simple-warning-format-arguments))
   (:report simple-condition-printer))
 ;;;
 (define-condition simple-style-warning (style-warning)
-  (format-control
-   (format-arguments '()))
-  (:conc-name internal-simple-style-warning-)
+  ((format-control :accessor internal-simple-style-warning-format-control)
+   (format-arguments :init-form '()
+		     :accessor internal-simple-style-warning-format-arguments))
   (:report simple-condition-printer))
 
-
 (defun print-simple-error (condition stream)
   (format stream "~&~@<Error in function ~S:  ~3i~:_~?~:>"
-	  (internal-simple-error-function-name condition)
+	  (serious-condition-function-name condition)
 	  (internal-simple-error-format-control condition)
 	  (internal-simple-error-format-arguments condition)))
 
@@ -576,9 +576,9 @@
 ;;; sees.
 ;;;
 (define-condition simple-error (error)
-  (format-control
-   (format-arguments '()))
-  (:conc-name internal-simple-error-)
+  ((format-control :accessor internal-simple-error-format-control)
+   (format-arguments :init-form '()
+		     :accessor internal-simple-error-format-arguments))
   (:report print-simple-error))
 
 
@@ -590,7 +590,7 @@
   (:report
    (lambda (condition stream)
      (format stream "~@<Type-error in ~S:  ~3i~:_~S is not of type ~S~:>"
-	     (type-error-function-name condition)
+	     (serious-condition-function-name condition)
 	     (type-error-datum condition)
 	     (type-error-expected-type condition)))))
 
@@ -601,9 +601,9 @@
 ;;; of bogus multiple inheritance that the user sees.
 ;;;
 (define-condition simple-type-error (type-error)
-  (format-control
-   (format-arguments '()))
-  (:conc-name internal-simple-type-error-)
+  ((format-control :accessor internal-simple-type-error-format-control)
+   (format-arguments :init-form '()
+		     :accessor internal-simple-type-error-format-arguments))
   (:report simple-condition-printer))
 
 (define-condition kernel:layout-invalid (type-error)
@@ -612,7 +612,7 @@
    (lambda (condition stream)
      (format stream "Layout-invalid error in ~S:~@
 		     Type test of class ~S was passed obsolete instance:~%  ~S"
-	     (type-error-function-name condition)
+	     (serious-condition-function-name condition)
 	     (kernel:class-proper-name (type-error-expected-type condition))
 	     (type-error-datum condition)))))
 
@@ -664,13 +664,14 @@
 
 (defun print-control-error (condition stream)
   (format stream "~&~@<Error in function ~S:  ~3i~:_~?~:>"
-	  (control-error-function-name condition)
+	  (serious-condition-function-name condition)
 	  (control-error-format-control condition)
 	  (control-error-format-arguments condition)))
 
 (define-condition control-error (error)
-  (format-control
-   (format-arguments nil))
+  ((format-control :accessor control-error-format-control)
+   (format-arguments :init-form '()
+		     :accessor control-error-format-arguments))
   (:report print-control-error))
 
 
@@ -693,7 +694,7 @@
    (lambda (condition stream)
      (format stream
 	     "Error in ~S:  the variable ~S is unbound."
-	     (cell-error-function-name condition)
+	     (serious-condition-function-name condition)
 	     (cell-error-name condition)))))
   
 (define-condition undefined-function (cell-error) ()
@@ -701,7 +702,7 @@
    (lambda (condition stream)
      (format stream
 	     "Error in ~S:  the function ~S is undefined."
-	     (cell-error-function-name condition)
+	     (serious-condition-function-name condition)
 	     (cell-error-name condition)))))
 
 (define-condition arithmetic-error (error) (operation operands)
diff --git a/code/globals.lisp b/code/globals.lisp
index 8f7df7151..c9ffb357d 100644
--- a/code/globals.lisp
+++ b/code/globals.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/globals.lisp,v 1.6 1992/03/03 18:59:53 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/globals.lisp,v 1.7 1993/08/25 01:13:31 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -19,7 +19,7 @@
 ;;;
 ;;; Written by Rob MacLachlan
 ;;;
-(in-package 'lisp)
+(in-package "LISP")
 
 (proclaim '(special *keyword-package* *lisp-package* *package* *query-io*
 		    *terminal-io* *error-output* *trace-output* *debug-io*
diff --git a/code/hash.lisp b/code/hash.lisp
index d712e95db..0de29ca3d 100644
--- a/code/hash.lisp
+++ b/code/hash.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.25 1993/06/10 16:16:33 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.26 1993/08/25 01:13:34 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -502,6 +502,12 @@
 			   bucket))))))
     #'hash-table-scavenger-hook))
 
+;;; So people can call #'(setf gethash).
+;;;
+(defun (setf gethash) (new-value key table &optional default)
+  (declare (ignore default))
+  (%puthash key table new-value))
+
 ;;; %PUTHASH -- public setf method.
 ;;; 
 (defun %puthash (key hash-table value)
diff --git a/code/list.lisp b/code/list.lisp
index e63d12f57..619e2549a 100644
--- a/code/list.lisp
+++ b/code/list.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/list.lisp,v 1.15 1993/08/06 15:49:50 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/list.lisp,v 1.16 1993/08/25 01:13:52 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -21,7 +21,7 @@
 ;;;
 ;;; **********************************************************************
 ;;;
-(in-package 'lisp)
+(in-package "LISP")
 
 (export '(car cdr caar
 	  cadr cdar cddr caaar caadr cadar caddr cdaar cdadr
@@ -54,7 +54,7 @@
 (in-package "EXTENSIONS")
 (export '(assq memq delq))
 (proclaim '(maybe-inline delq))
-(in-package 'lisp)
+(in-package "LISP")
 
 
 ;;; These functions perform basic list operations:
@@ -965,17 +965,13 @@
   (declare (inline assoc))
   (assoc item alist :test #'eq))
 
-(defun delq (item list &optional (n most-positive-fixnum))
-  (declare (fixnum n))
-  "Returns list with all (up to n) elements with all elements EQ to ITEM
-   deleted"
+(defun delq (item list)
+  "Returns list with all elements with all elements EQ to ITEM deleted."
   (do ((x list (cdr x))
        (splice '()))
       ((endp x) list)
     (cond ((eq item (car x))
 	   (if (null splice) 
 	       (setq list (cdr x))
-	       (rplacd splice (cdr x)))
-	   (setq n (1- n))
-	   (when (zerop n) (return list)))
+	       (rplacd splice (cdr x))))
 	  (T (setq splice x)))))	; move splice along to include element
diff --git a/code/machdef.lisp b/code/machdef.lisp
index 9f8766ff6..05150de4d 100644
--- a/code/machdef.lisp
+++ b/code/machdef.lisp
@@ -7,13 +7,13 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/machdef.lisp,v 1.5 1991/02/08 13:34:05 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/machdef.lisp,v 1.6 1993/08/25 01:14:03 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
 ;;; Record definitions needed for the interface to Mach.
 ;;;
-(in-package 'mach)
+(in-package "MACH")
 
 (export '(msg-simplemsg msg-msgsize msg-msgtype msg-localport msg-remoteport
 			msg-id sigmask with-trap-arg-block))
diff --git a/code/module.lisp b/code/module.lisp
index 52fd1e86c..c27731bf5 100644
--- a/code/module.lisp
+++ b/code/module.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/module.lisp,v 1.2 1992/12/16 12:32:10 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/module.lisp,v 1.3 1993/08/25 01:14:10 ram Exp $")
 ;;;
 ;;; **********************************************************************
 
@@ -18,14 +18,14 @@
 ;;; spliced into the current sources to reflect the last minute deprecated
 ;;; addition of modules to the X3J13 ANSI standard.
 ;;;
-(in-package 'lisp)
+(in-package "LISP")
 
 (export '(*modules* provide require))
 
 
 (in-package "EXTENSIONS")
 (export '(*require-verbose* defmodule))
-(in-package 'lisp)
+(in-package "LISP")
 
 
 
diff --git a/code/print.lisp b/code/print.lisp
index 8cea6930c..7e3cf5046 100644
--- a/code/print.lisp
+++ b/code/print.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.60 1993/08/20 08:19:30 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.61 1993/08/25 01:14:28 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1100,6 +1100,9 @@
     (print-unreadable-object (array stream :type t :identity t))))
 
 
+(declaim (ftype function dylan::%print-dylan-instance
+		dylan::dylan-instance-p))
+
 ;;; Instance Printing.  If it's a structure, call the structure printer.
 ;;; Otherwise, call PCL if it's loaded.  If not, print unreadably.
 
diff --git a/code/reader.lisp b/code/reader.lisp
index b57671771..591c6177a 100644
--- a/code/reader.lisp
+++ b/code/reader.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.17 1993/02/17 16:29:44 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.18 1993/08/25 01:14:41 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -805,7 +805,7 @@
       ;;saw "[sign] {digit}+"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
-      (unless char (return (make-integer stream)))
+      (unless char (return (make-integer)))
       (case (char-class3 char attribute-table)
 	(#.constituent-digit (go LEFTDIGIT))
 	(#.constituent-dot (if possibly-float
@@ -815,7 +815,7 @@
 	(#.constituent-slash (if possibly-rational
 				 (go RATIO)
 				 (go SYMBOL)))
-	(#.delimiter (unread-char char stream) (return (make-integer stream)))
+	(#.delimiter (unread-char char stream) (return (make-integer)))
 	(#.escape (go ESCAPE))
 	(#.multiple-escape (go MULT-ESCAPE))
 	(#.package-delimiter (go COLON))
@@ -825,14 +825,14 @@
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (let ((*read-base* 10))
-			     (make-integer stream))))
+			     (make-integer))))
       (case (char-class char attribute-table)
 	(#.constituent-digit (go RIGHTDIGIT))
 	(#.constituent-expt (go EXPONENT))
 	(#.delimiter
 	 (unread-char char stream)
 	 (return (let ((*read-base* 10))
-		   (make-integer stream))))
+		   (make-integer))))
 	(#.escape (go ESCAPE))
 	(#.multiple-escape (go MULT-ESCAPE))
 	(#.package-delimiter (go COLON))
@@ -1115,7 +1115,7 @@
 	    (expt base digits)))))
 |#
 
-(defun make-integer (stream)
+(defun make-integer ()
   "Minimizes bignum-fixnum multiplies by reading a 'safe' number of digits, 
   then multiplying by a power of the base and adding."
   (let* ((base *read-base*)
diff --git a/code/seq.lisp b/code/seq.lisp
index 0ec7166db..6e0f8abd7 100644
--- a/code/seq.lisp
+++ b/code/seq.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.13 1993/08/17 20:48:00 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.14 1993/08/25 01:15:00 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -21,7 +21,7 @@
 ;;; functions.  If transforms are written for some sequence operation, note
 ;;; how the end argument is handled in other operations with transforms.
 
-(in-package 'lisp)
+(in-package "LISP")
 (export '(elt subseq copy-seq coerce
 	  length reverse nreverse make-sequence concatenate map some every
 	  notany notevery reduce fill replace remove remove-if remove-if-not
diff --git a/code/setf-funs.lisp b/code/setf-funs.lisp
index 5d7e7a3b1..98f135230 100644
--- a/code/setf-funs.lisp
+++ b/code/setf-funs.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/setf-funs.lisp,v 1.3 1993/02/06 15:01:33 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/setf-funs.lisp,v 1.4 1993/08/25 01:15:05 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -56,6 +56,6 @@
 
 (define-setters ("LISP")
   ;; Semantically silly...
-  getf apply ldb mask-field logbitp
+  getf apply ldb mask-field logbitp subseq
   ;; Have explicit redundant definitions...
-  setf bit sbit)
+  setf bit sbit get aref gethash)
diff --git a/code/sort.lisp b/code/sort.lisp
index 10c9e55bf..d44db58f0 100644
--- a/code/sort.lisp
+++ b/code/sort.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sort.lisp,v 1.2 1991/02/08 13:35:46 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sort.lisp,v 1.3 1993/08/25 01:15:11 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -20,7 +20,7 @@
 ;;;
 ;;; *******************************************************************
 
-(in-package 'lisp)
+(in-package "LISP")
 
 (export '(sort stable-sort merge))
 
diff --git a/code/time.lisp b/code/time.lisp
index c7c8b2d0f..aab46aa7e 100644
--- a/code/time.lisp
+++ b/code/time.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.13 1992/08/05 20:08:28 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.14 1993/08/25 01:15:27 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -17,7 +17,7 @@
 ;;;
 ;;;    Written by Rob MacLachlan.
 ;;;
-(in-package 'lisp)
+(in-package "LISP")
 (export '(internal-time-units-per-second get-internal-real-time
 	  get-internal-run-time get-universal-time
 	  get-decoded-time encode-universal-time decode-universal-time))
diff --git a/code/type.lisp b/code/type.lisp
index e73dcf21e..a0e5dbd33 100644
--- a/code/type.lisp
+++ b/code/type.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.13 1993/08/23 12:02:52 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.14 1993/08/25 01:15:35 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -583,7 +583,7 @@
 ;;; is guaranteed that it will be no smaller (more restrictive) than the
 ;;; precise result.
 ;;;
-(defun-cached (values-type-union :hash-<function type-cache-hash
+(defun-cached (values-type-union :hash-function type-cache-hash
 				 :hash-bits 8
 				 :default nil
 				 :init-form cold-load-init)
-- 
GitLab