diff --git a/pcl/boot.lisp b/pcl/boot.lisp index b6e43b52a110667b365b5e89b5fcf1f0a6f9a70d..324efd65203b7ffc46b768a59a3c0bebaa3fc93d 100644 --- a/pcl/boot.lisp +++ b/pcl/boot.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.31 2002/08/27 19:01:37 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.32 2002/09/07 13:16:47 pmai Exp $") (in-package :pcl) @@ -651,6 +651,7 @@ work during bootstrapping. (*enable-emf-call-tracing-p* nil)) (format t "~&(The oldest entries are printed first)~%") (dotimes (i *emf-call-trace-size*) + (declare (fixnum i)) (let ((ct (aref *emf-call-trace* j))) (when ct (print ct))) (incf j) diff --git a/pcl/cache.lisp b/pcl/cache.lisp index a788ea7eae2e526913ee1b2df51e6f7210f579df..7ef3eac62b805d142b96a3d91d647e4181af8ca5 100644 --- a/pcl/cache.lisp +++ b/pcl/cache.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.16 2002/08/27 19:01:37 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.17 2002/09/07 13:16:48 pmai Exp $") ;;; ;;; The basics of the PCL wrapper cache mechanism. ;;; @@ -575,6 +575,7 @@ (new-vector (get-cache-vector size))) (declare (simple-vector old-vector new-vector)) (dotimes (i size) + (declare (fixnum i)) (setf (svref new-vector i) (svref old-vector i))) (setf (cache-vector new-cache) new-vector) new-cache)) @@ -690,6 +691,7 @@ (declare (type field-type field) (fixnum result mask nkeys) (simple-vector cache-vector)) (dotimes (i nkeys) + (declare (fixnum i)) (let* ((wrapper (cache-vector-ref cache-vector (+ i from-location))) (wcn (wrapper-cache-number-vector-ref wrapper field))) (declare (fixnum wcn)) @@ -940,6 +942,7 @@ (vector (vector))) (declare (simple-vector vector)) (dotimes (i (nkeys) list) + (declare (fixnum i)) (setf (nth i list) (cache-vector-ref vector (+ location i))))))) ;; ;; Given a line number, return true IFF the line's @@ -957,6 +960,7 @@ (if (= (nkeys) 1) (eq wrappers (cache-vector-ref cache-vector loc)) (dotimes (i (nkeys) t) + (declare (fixnum i)) (unless (eq (pop wrappers) (cache-vector-ref cache-vector (+ loc i))) (return nil)))))) ;; @@ -997,6 +1001,7 @@ (wrappers-mismatch-p (null wrappers))) (declare (simple-vector cache-vector)) (dotimes (i (nkeys) wrappers-mismatch-p) + (declare (fixnum i)) (let ((wrapper (cache-vector-ref cache-vector (+ loc i)))) (when (or (null wrapper) (invalid-wrapper-p wrapper)) @@ -1108,6 +1113,7 @@ (let ((location (if (= (nkeys) 1) 0 1)) (limit (funcall (limit-fn) (nlines)))) (dotimes (i (nlines) cache) + (declare (fixnum i)) (when (and (not (location-reserved-p location)) (line-full-p i)) (let* ((home-loc (compute-primary-cache-location-from-location @@ -1132,6 +1138,7 @@ (when (location-reserved-p location) (setq location (next-location location))) (dotimes (i (1+ limit)) + (declare (fixnum i)) (when (location-matches-wrappers-p location wrappers) (return-from probe-cache (or (not (valuep)) (location-value location)))) @@ -1146,6 +1153,7 @@ (with-local-cache-functions (cache) (let ((set-p (and set-p (valuep)))) (dotimes (i (nlines) cache) + (declare (fixnum i)) (unless (or (line-reserved-p i) (not (line-valid-p i nil))) (let ((value (funcall function (line-wrappers i) (line-value i)))) (when set-p @@ -1162,6 +1170,7 @@ (let ((count 0)) (declare (fixnum count)) (dotimes (i (nlines) count) + (declare (fixnum i)) (unless (line-reserved-p i) (when (line-full-p i) (incf count))))))) @@ -1170,6 +1179,7 @@ (declare (ignore value)) (with-local-cache-functions (cache) (dotimes (i (nlines)) + (declare (fixnum i)) (unless (line-reserved-p i) (when (equal (line-wrappers i) wrappers) (return t)))))) @@ -1235,6 +1245,7 @@ (declare (fixnum from-loc to-loc)) (modify-cache to-cache-vector (dotimes (i (line-size)) + (declare (fixnum i)) (setf (cache-vector-ref to-cache-vector (+ to-loc i)) (cache-vector-ref from-cache-vector @@ -1263,6 +1274,7 @@ (try-one-fill (wrappers value) (fill-cache-p nil ncache wrappers value))) (if (and (dotimes (i (nlines) t) + (declare (fixnum i)) (when (and (null (line-reserved-p i)) (line-valid-p i wrappers)) (unless (try-one-fill-from-line i) (return nil)))) @@ -1291,6 +1303,7 @@ (try-one-fill (wrappers value) (fill-cache-p nil ncache wrappers value))) (dotimes (i (nlines)) + (declare (fixnum i)) (when (and (null (line-reserved-p i)) (line-valid-p i wrappers)) (do-one-fill-from-line i))) @@ -1365,6 +1378,7 @@ (declare (fixnum from-loc to-loc) (simple-vector cache-vector)) (modify-cache cache-vector (dotimes (i (line-size)) + (declare (fixnum i)) (setf (cache-vector-ref cache-vector (+ to-loc i)) (cache-vector-ref cache-vector (+ from-loc i))) (setf (cache-vector-ref cache-vector (+ from-loc i)) diff --git a/pcl/dfun.lisp b/pcl/dfun.lisp index d58f920bd274c60ee6b80a3c2131d16ef913339a..2d6fc466f7930e0319992becbc6d5ee829a02415 100644 --- a/pcl/dfun.lisp +++ b/pcl/dfun.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.14 2002/08/26 02:23:12 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.15 2002/09/07 13:16:48 pmai Exp $") ;;; (in-package :pcl) @@ -1312,8 +1312,12 @@ And so, we are saved. (defun compute-precedence (lambda-list nreq argument-precedence-order) (if (null argument-precedence-order) - (let ((list nil))(dotimes (i nreq list) (push (- (1- nreq) i) list))) - (mapcar (lambda (x) (position x lambda-list)) argument-precedence-order))) + (let ((list nil)) + (dotimes (i nreq list) + (declare (fixnum i)) + (push (- (1- nreq) i) list))) + (mapcar (lambda (x) (position x lambda-list)) + argument-precedence-order))) (defun saut-and (specl type) (let ((applicable nil) diff --git a/pcl/fast-init.lisp b/pcl/fast-init.lisp index 7fc4983c20e5ebc82cee7a1b123b5b6199d8a19e..44f100580aab8261d57363a69fd2e6f27b4e1458 100644 --- a/pcl/fast-init.lisp +++ b/pcl/fast-init.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/fast-init.lisp,v 1.9 2002/08/27 19:01:38 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/fast-init.lisp,v 1.10 2002/09/07 13:16:48 pmai Exp $") ;;; ;;; This file defines the optimized make-instance functions. ;;; @@ -795,6 +795,7 @@ pv slots (cadr form) (slot-boundp-using-class class instance (caddr form))) (dotimes (i (cadddr form)) + (declare (fixnum i)) (pop form-list)))) (update-initialize-info-cache (when (consp initargs) @@ -874,7 +875,8 @@ (t :default)))) ,@(let ((sforms (cons nil nil))) (dotimes (i (cadddr form) (car sforms)) - (add-forms (first-form-to-lisp forms cvector pv) sforms))))))) + (add-forms (first-form-to-lisp forms cvector pv) + sforms))))))) (update-initialize-info-cache `((when (consp initargs) (setq initargs (cons (car initargs) (cdr initargs)))) diff --git a/pcl/low.lisp b/pcl/low.lisp index 4259556433063b4dfc724cfdd5be4c0df5ab4764..ca8556c43acd0fad8969cfe3380679a363b25ca8 100644 --- a/pcl/low.lisp +++ b/pcl/low.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.15 2001/09/22 13:57:42 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.16 2002/09/07 13:16:48 pmai Exp $") ;;; ;;; This file contains optimized low-level constructs for PCL. @@ -44,11 +44,6 @@ declaration.") ;;; Various macros that include necessary declarations for maximum ;;; performance. -(defmacro dotimes ((var count &optional (result nil)) &body body) - `(lisp:dotimes (,var (the fixnum ,count) ,result) - (declare (fixnum ,var)) - ,@body)) - (defmacro %svref (vector index) `(locally (declare #.*optimize-speed* (inline svref)) diff --git a/pcl/pkg.lisp b/pcl/pkg.lisp index 13e027f7396c3c7e89819ea63ebd979c630bf6df..0a9aa32cdeda7244e0e0ea6732c68f73d50e8f10 100644 --- a/pcl/pkg.lisp +++ b/pcl/pkg.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/pkg.lisp,v 1.20 2002/08/26 02:23:15 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/pkg.lisp,v 1.21 2002/09/07 13:16:48 pmai Exp $") ;;; ;;; CMUCL 18a: Jan-1998 -- Changing to DEFPACKAGE. @@ -46,7 +46,6 @@ (:shadow "FIND-CLASS" "CLASS-NAME" "CLASS-OF" "CLASS" "BUILT-IN-CLASS" "STRUCTURE-CLASS" "STANDARD-CLASS") - (:shadow "DOTIMES") (:import-from :kernel "FUNCALLABLE-INSTANCE-P" "SIMPLE-PROGRAM-ERROR") (:shadow "DOCUMENTATION") diff --git a/pcl/vector.lisp b/pcl/vector.lisp index 2a0e6efad0aa92b31090b8f3045392976ed71cc7..798c8341660dba5888003cec34cc2c9f39f4a816 100644 --- a/pcl/vector.lisp +++ b/pcl/vector.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/vector.lisp,v 1.17 2002/08/26 02:23:16 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/vector.lisp,v 1.18 2002/09/07 13:16:49 pmai Exp $") ;;; ;;; Permutation vectors. ;;; @@ -332,6 +332,7 @@ (new-intern-p t)) (if (atom wrappers) (dotimes (i pv-size) + (declare (fixnum i)) (when (consp (let ((map (svref pv-map i))) (if map (setf (pvref new-pv i) (cdr map)) @@ -341,6 +342,7 @@ (dolist (wrapper wrappers) (when (eq wrapper cwrapper) (dotimes (i pv-size) + (declare (fixnum i)) (when (consp (let ((map (svref pv-map i))) (if (and map (= (car map) param)) (setf (pvref new-pv i) (cdr map))