Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cmucl
cmucl
Commits
b1ecdd56
Commit
b1ecdd56
authored
Aug 25, 1993
by
ram
Browse files
Fix compiler warnings.
parent
afc97d4d
Changes
15
Hide whitespace changes
Inline
Side-by-side
code/backq.lisp
View file @
b1ecdd56
...
...
@@ -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/2
0
0
0:39:04
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/backq.lisp,v 1.
9
1993/08/2
5
0
1: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:
...
...
code/char.lisp
View file @
b1ecdd56
...
...
@@ -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/0
2/17 17:27:16
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/char.lisp,v 1.
8
1993/0
8/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
...
...
code/error.lisp
View file @
b1ecdd56
...
...
@@ -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.3
2
1993/08/
19 17:14:40
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.3
3
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
)
...
...
code/globals.lisp
View file @
b1ecdd56
...
...
@@ -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
199
2
/0
3/03 18:59:53 wlott
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/globals.lisp,v 1.
7
199
3
/0
8/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*
...
...
code/hash.lisp
View file @
b1ecdd56
...
...
@@ -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.2
5
1993/0
6/10 16
:1
6
:3
3 wlott
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.2
6
1993/0
8/25 01
:1
3
:3
4 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
)
...
...
code/list.lisp
View file @
b1ecdd56
...
...
@@ -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.1
5
1993/08/
06 15:49
:5
0
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/list.lisp,v 1.1
6
1993/08/
25 01:13
:5
2
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
code/machdef.lisp
View file @
b1ecdd56
...
...
@@ -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
199
1/02/08 13:3
4:0
5
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/machdef.lisp,v 1.
6
199
3/08/25 01:1
4:0
3
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
))
...
...
code/module.lisp
View file @
b1ecdd56
...
...
@@ -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
199
2/12/16 12:32
:10 ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/module.lisp,v 1.
3
199
3/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"
)
...
...
code/print.lisp
View file @
b1ecdd56
...
...
@@ -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.6
0
1993/08/2
0
0
8
:1
9:30
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.6
1
1993/08/2
5
0
1
:1
4: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.
...
...
code/reader.lisp
View file @
b1ecdd56
...
...
@@ -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.1
7
1993/0
2/17 16:29:44
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.1
8
1993/0
8/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*
)
...
...
code/seq.lisp
View file @
b1ecdd56
...
...
@@ -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.1
3
1993/08/
17 20:48
:00 ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.1
4
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
...
...
code/setf-funs.lisp
View file @
b1ecdd56
...
...
@@ -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/0
2/06 15:01:33
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/setf-funs.lisp,v 1.
4
1993/0
8/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
)
code/sort.lisp
View file @
b1ecdd56
...
...
@@ -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
199
1
/0
2/08 13:35:46
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sort.lisp,v 1.
3
199
3
/0
8/25 01:15:11
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -20,7 +20,7 @@
;;;
;;; *******************************************************************
(
in-package
'lisp
)
(
in-package
"LISP"
)
(
export
'
(
sort
stable-sort
merge
))
...
...
code/time.lisp
View file @
b1ecdd56
...
...
@@ -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.1
3
199
2
/08/
0
5
20:08
:2
8
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.1
4
199
3
/08/
2
5
01:15
:2
7
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
))
...
...
code/type.lisp
View file @
b1ecdd56
...
...
@@ -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.1
3
1993/08/2
3 12:02:52
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.1
4
1993/08/2
5 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
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment