Commit b1ecdd56 authored by ram's avatar ram
Browse files

Fix compiler warnings.

parent afc97d4d
......@@ -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:
......
......@@ -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
......
......@@ -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)
......
......@@ -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*
......
......@@ -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)
......
......@@ -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
......@@ -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))
......
......@@ -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")
......
......@@ -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.
......
......@@ -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*)
......
......@@ -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
......
......@@ -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)
......@@ -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))
......
......@@ -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))
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment