Commit e3fe869c authored by ram's avatar ram
Browse files

Fix compiler warnings.

parent af30308e
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.16 1993/05/12 11:10:18 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.17 1993/08/25 00:14:32 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -577,4 +577,4 @@
;;;
(deftransform bit-not ((bit-array-1 result-bit-array)
(bit-vector (constant-argument t)))
'(bit-not bit-array-1 bit-array-1)))
'(bit-not bit-array-1 bit-array-1))
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/bit-util.lisp,v 1.5 1993/08/12 17:32:09 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/bit-util.lisp,v 1.6 1993/08/25 00:14:43 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -16,7 +16,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package "C")
(declaim (inline clear-bit-vector set-bit-vector bit-vector-replace
bit-vector-copy))
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/checkgen.lisp,v 1.22 1992/09/07 15:34:20 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/checkgen.lisp,v 1.23 1993/08/25 00:14:48 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -433,7 +433,7 @@
(what (when (and (combination-p dest)
(eq (combination-kind dest) :local))
(let ((lambda (combination-lambda dest))
(pos (position cont (combination-args dest))))
(pos (eposition cont (combination-args dest))))
(format nil "~:[A possible~;The~] binding of ~S"
(and (continuation-use cont)
(eq (functional-kind lambda) :let))
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/constraint.lisp,v 1.13 1992/06/03 20:03:37 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/constraint.lisp,v 1.14 1993/08/25 00:14:53 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -16,7 +16,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package "C")
(defstruct (constraint
(:include sset-element)
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/control.lisp,v 1.12 1993/05/08 00:47:17 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/control.lisp,v 1.13 1993/08/25 00:14:57 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -22,7 +22,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package "C")
;;; Add-To-Emit-Order -- Interface
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/copyprop.lisp,v 1.6 1991/02/20 14:56:55 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/copyprop.lisp,v 1.7 1993/08/25 00:14:58 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -17,7 +17,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package "C")
;;; In copy propagation, we manipulate sets of TNs. We only consider TNs whose
;;; sole write is by a MOVE VOP. This allows us to use a degenerate version of
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ctype.lisp,v 1.26 1993/01/14 18:04:00 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ctype.lisp,v 1.27 1993/08/25 00:14:59 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -17,7 +17,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package "C")
;;; These are the functions that are to be called when a problem is detected.
;;; They are passed format arguments. If null, we don't do anything. The
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug-dump.lisp,v 1.37 1993/08/17 22:38:55 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug-dump.lisp,v 1.38 1993/08/25 00:15:01 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -118,7 +118,7 @@
(type hash-table var-locs) (type (or vop null) vop))
(vector-push-extend
(dpb (position kind compiled-code-location-kinds)
(dpb (eposition kind compiled-code-location-kinds)
compiled-code-location-kind-byte
0)
*byte-buffer*)
......@@ -667,7 +667,7 @@
(let ((options 0))
(setf (ldb minimal-debug-function-name-style-byte options) name-rep)
(setf (ldb minimal-debug-function-kind-byte options)
(position (compiled-debug-function-kind dfun)
(eposition (compiled-debug-function-kind dfun)
minimal-debug-function-kinds))
(setf (ldb minimal-debug-function-returns-byte options)
(etypecase (compiled-debug-function-returns dfun)
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/entry.lisp,v 1.9 1991/05/16 00:24:38 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/entry.lisp,v 1.10 1993/08/25 00:15:16 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -17,7 +17,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package "C")
;;; Entry-Analyze -- Interface
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/envanal.lisp,v 1.24 1993/05/13 11:35:26 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/envanal.lisp,v 1.25 1993/08/25 00:15:19 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -18,7 +18,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package "C")
;;; Environment-Analyze -- Interface
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval.lisp,v 1.24 1993/08/24 23:43:05 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/eval.lisp,v 1.25 1993/08/25 00:15:24 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -734,7 +734,7 @@
((member ,info '(:multiple :return) :test #'eq)
(eval-stack-push (list ,value)))
(t (assert (eq ,info :single))
(eval-stack-push ,value))))))
(eval-stack-push ,value))))
(defun maybe-trace-nodes (node)
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.19 1993/08/21 08:16:28 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.20 1993/08/25 00:15:29 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -160,7 +160,7 @@
(defknown integer-decode-double-float (double-float)
(values double-float-significand double-float-int-exponent (integer -1 1))
(movable foldable flushable)))
(movable foldable flushable))
(defknown scale-single-float (single-float fixnum) single-float
(movable foldable flushable))
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.58 1993/08/20 18:46:37 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.59 1993/08/25 00:15:31 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -60,7 +60,7 @@
(export '(%caller-frame-and-pc %with-array-data))
(in-package 'c)
(in-package "C")
;;;; Information for known functions:
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/gtn.lisp,v 1.13 1992/04/01 15:30:08 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/gtn.lisp,v 1.14 1993/08/25 00:15:37 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -17,7 +17,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package "C")
;;; GTN-Analyze -- Interface
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.70 1993/08/24 02:12:13 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.71 1993/08/25 00:15:48 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -1472,7 +1472,7 @@
(declare (type lambda-var var))
(let ((fun (lambda-var-home var)))
(elt (combination-args (let-combination fun))
(position var (lambda-vars fun)))))
(eposition var (lambda-vars fun)))))
;;; COMBINATION-LAMBDA -- Interface
......@@ -1998,8 +1998,7 @@
(cerror "replace form with call to ERROR."
'compiler-error :format-control format-string
:format-arguments format-args)
(funcall *compiler-error-bailout*)
(error "*Compiler-Error-Bailout* returned?"))
(funcall *compiler-error-bailout*))
;;;
(defun compiler-error-message (format-string &rest format-args)
(cerror "ignore it."
......@@ -2076,106 +2075,6 @@
(return-from careful-call (values nil nil))))))
t))
;;;; Generic list (?) functions:
(proclaim '(inline find-in position-in map-in))
;;; Find-In -- Interface
;;;
(defun find-in (next element list &key (key #'identity)
(test #'eql test-p) (test-not nil not-p))
"Find Element in a null-terminated List linked by the accessor function
Next. Key, Test and Test-Not are the same as for generic sequence
functions."
(when (and test-p not-p)
(error "Silly to supply both :Test and :Test-Not."))
(if not-p
(do ((current list (funcall next current)))
((null current) nil)
(unless (funcall test-not (funcall key current) element)
(return current)))
(do ((current list (funcall next current)))
((null current) nil)
(when (funcall test (funcall key current) element)
(return current)))))
;;; Position-In -- Interface
;;;
(defun position-in (next element list &key (key #'identity)
(test #'eql test-p) (test-not nil not-p))
"Return the position of Element (or NIL if absent) in a null-terminated List
linked by the accessor function Next. Key, Test and Test-Not are the same as
for generic sequence functions."
(when (and test-p not-p)
(error "Silly to supply both :Test and :Test-Not."))
(if not-p
(do ((current list (funcall next current))
(i 0 (1+ i)))
((null current) nil)
(unless (funcall test-not (funcall key current) element)
(return i)))
(do ((current list (funcall next current))
(i 0 (1+ i)))
((null current) nil)
(when (funcall test (funcall key current) element)
(return i)))))
;;; Map-In -- Interface
;;;
(defun map-in (next function list)
"Map Function over the elements in a null-terminated List linked by the
accessor function Next, returning a list of the results."
(collect ((res))
(do ((current list (funcall next current)))
((null current))
(res (funcall function current)))
(res)))
;;; Deletef-In -- Interface
;;;
(defmacro deletef-in (next place item &environment env)
"Deletef-In Next Place Item
Delete Item from a null-terminated list linked by the accessor function Next
that is stored in Place. Item must appear exactly once in the list."
(multiple-value-bind
(temps vals stores store access)
(get-setf-method place env)
(let ((n-item (gensym))
(n-place (gensym))
(n-current (gensym))
(n-prev (gensym)))
`(let* (,@(mapcar #'list temps vals)
(,n-place ,access)
(,n-item ,item))
(if (eq ,n-place ,n-item)
(let ((,(first stores) (,next ,n-place)))
,store)
(do ((,n-prev ,n-place ,n-current)
(,n-current (,next ,n-place)
(,next ,n-current)))
((eq ,n-current ,n-item)
(setf (,next ,n-prev)
(,next ,n-current)))))
(undefined-value)))))
;;; Push-In -- Interface
;;;
(defmacro push-in (next item place &environment env)
"Push Item onto a list linked by the accessor function Next that is stored in
Place."
(multiple-value-bind
(temps vals stores store access)
(get-setf-method place env)
`(let (,@(mapcar #'list temps vals)
(,(first stores) ,item))
(setf (,next ,(first stores)) ,access)
,store
(undefined-value))))
;;;; Utilities used at run-time for parsing keyword args in IR1:
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/life.lisp,v 1.21 1992/08/14 15:20:19 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/life.lisp,v 1.22 1993/08/25 00:15:59 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -15,7 +15,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package "C")
;;;; Utilities:
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/macros.lisp,v 1.39 1993/08/24 02:12:18 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/macros.lisp,v 1.40 1993/08/25 00:16:09 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -27,6 +27,10 @@
(proclaim '(special *wild-type* *universal-type* *compiler-error-context*))
(declaim (ftype function (setf dylan::value-datum) dylan::find-module
dylan::lookup-varinfo-value
dylan::parse-and-convert dylan::value-datum))
;;;; Deftypes:
;;;
......@@ -1106,3 +1110,110 @@
(setf (event-info-count v) 0))
*event-info*)
(values))
;;;; Generic list (?) functions:
(proclaim '(inline find-in position-in map-in))
;;; Find-In -- Interface
;;;
(defun find-in (next element list &key (key #'identity)
(test #'eql test-p) (test-not nil not-p))
"Find Element in a null-terminated List linked by the accessor function
Next. Key, Test and Test-Not are the same as for generic sequence
functions."
(when (and test-p not-p)
(error "Silly to supply both :Test and :Test-Not."))
(if not-p
(do ((current list (funcall next current)))
((null current) nil)
(unless (funcall test-not (funcall key current) element)
(return current)))
(do ((current list (funcall next current)))
((null current) nil)
(when (funcall test (funcall key current) element)
(return current)))))
;;; Position-In -- Interface
;;;
(defun position-in (next element list &key (key #'identity)
(test #'eql test-p) (test-not nil not-p))
"Return the position of Element (or NIL if absent) in a null-terminated List
linked by the accessor function Next. Key, Test and Test-Not are the same as
for generic sequence functions."
(when (and test-p not-p)
(error "Silly to supply both :Test and :Test-Not."))
(if not-p
(do ((current list (funcall next current))
(i 0 (1+ i)))
((null current) nil)
(unless (funcall test-not (funcall key current) element)
(return i)))
(do ((current list (funcall next current))
(i 0 (1+ i)))
((null current) nil)
(when (funcall test (funcall key current) element)
(return i)))))
;;; Map-In -- Interface
;;;
(defun map-in (next function list)
"Map Function over the elements in a null-terminated List linked by the
accessor function Next, returning a list of the results."
(collect ((res))
(do ((current list (funcall next current)))
((null current))
(res (funcall function current)))
(res)))
;;; Deletef-In -- Interface
;;;
(defmacro deletef-in (next place item &environment env)
"Deletef-In Next Place Item
Delete Item from a null-terminated list linked by the accessor function Next
that is stored in Place. Item must appear exactly once in the list."
(multiple-value-bind
(temps vals stores store access)
(get-setf-method place env)
(let ((n-item (gensym))
(n-place (gensym))
(n-current (gensym))
(n-prev (gensym)))
`(let* (,@(mapcar #'list temps vals)
(,n-place ,access)
(,n-item ,item))
(if (eq ,n-place ,n-item)
(let ((,(first stores) (,next ,n-place)))
,store)
(do ((,n-prev ,n-place ,n-current)
(,n-current (,next ,n-place)
(,next ,n-current)))
((eq ,n-current ,n-item)
(setf (,next ,n-prev)
(,next ,n-current)))))
(undefined-value)))))
;;; Push-In -- Interface
;;;
(defmacro push-in (next item place &environment env)
"Push Item onto a list linked by the accessor function Next that is stored in
Place."
(multiple-value-bind
(temps vals stores store access)
(get-setf-method place env)
`(let (,@(mapcar #'list temps vals)
(,(first stores) ,item))
(setf (,next ,(first stores)) ,access)
,store
(undefined-value))))
;;; EPOSITION -- Interface
;;;
(defmacro eposition (&rest args)
`(or (position ,@args)
(error "Shouldn't happen?")))
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/meta-vmdef.lisp,v 1.5 1993/08/20 00:12:39 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/meta-vmdef.lisp,v 1.6 1993/08/25 00:16:15 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -720,10 +720,10 @@
(targets (+ (* index max-vop-tn-refs)
(ecase (operand-parse-kind target)
(:result
(+ (position target (vop-parse-results parse))
(+ (eposition target (vop-parse-results parse))
num-args))
(:temporary
(+ (* (position target (vop-parse-temps parse)) 2)
(+ (* (eposition target (vop-parse-temps parse)) 2)
num-args num-results)))))))
(let ((born (operand-parse-born op))
(dies (operand-parse-dies op)))
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/pseudo-vops.lisp,v 1.7 1992/06/04 16:13:14 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/pseudo-vops.lisp,v 1.8 1993/08/25 00:16:28 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -16,7 +16,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package "C")
;;; Notes the place at which the environment is properly initialized, for
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/represent.lisp,v 1.32 1992/02/24 05:50:28 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/represent.lisp,v 1.33 1993/08/25 00:16:29 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -18,7 +18,7 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package "C")
;;;; Error routines:
......
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