diff --git a/contrib/sb-concurrency/tests/test-mailbox.lisp b/contrib/sb-concurrency/tests/test-mailbox.lisp index 14a9dadef..7bebd4867 100644 --- a/contrib/sb-concurrency/tests/test-mailbox.lisp +++ b/contrib/sb-concurrency/tests/test-mailbox.lisp @@ -215,8 +215,8 @@ ;; receivers (or only senders) are shot ;; dead, there's still one that survives to ;; properly end the test. - (loop repeat 99 - for victim = (nth (random n) threads) + (loop for victim = (nth (random n) threads) + repeat 99 do (kill-thread victim) (sleep (random 0.0001))))) (values diff --git a/src/assembly/x86-64/tramps.lisp b/src/assembly/x86-64/tramps.lisp index 31e8eb7cf..2ba323974 100644 --- a/src/assembly/x86-64/tramps.lisp +++ b/src/assembly/x86-64/tramps.lisp @@ -28,8 +28,8 @@ (inst mov rax-tn 7) (zeroize rdx-tn) ;; Zero the header - (loop repeat 8 - for i from (+ 512 24) by 8 + (loop for i from (+ 512 24) by 8 + repeat 8 do (inst mov (ea i rsp-tn) rdx-tn)) (inst xsave (ea 24 rsp-tn)) diff --git a/src/code/arm64-vm.lisp b/src/code/arm64-vm.lisp index 357861302..e46241d12 100644 --- a/src/code/arm64-vm.lisp +++ b/src/code/arm64-vm.lisp @@ -82,8 +82,8 @@ (zerop length)) (decf length)) (setf pc (sap+ pc 4)) - (let ((args (loop repeat length - with index = 0 + (let ((args (loop with index = 0 + repeat length collect (sb-c:sap-read-var-integerf pc index)))) (values error-number (if (= first-offset zr-offset) diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp index de76300a6..93ba86a82 100644 --- a/src/code/target-error.lisp +++ b/src/code/target-error.lisp @@ -26,7 +26,8 @@ (let ((length (error-length error-number))) (declare (type (unsigned-byte 8) length)) (values error-number - (loop repeat length with index = 0 + (loop with index = 0 + repeat length collect (sb-c:sap-read-var-integerf sap index)) trap-number)))) diff --git a/src/code/win32-foreign-load.lisp b/src/code/win32-foreign-load.lisp index 690fd1590..08332cfa6 100644 --- a/src/code/win32-foreign-load.lisp +++ b/src/code/win32-foreign-load.lisp @@ -106,8 +106,8 @@ (n-names (sap-ref-32 export-data 24)) (functions-sap (sap+ image-base (sap-ref-32 export-data 28))) (names-sap (sap+ image-base (sap-ref-32 export-data 32)))) - (loop repeat (min n-functions n-names) - for offset from 0 by #.sb-vm::n-word-bytes + (loop for offset from 0 by #.sb-vm::n-word-bytes + repeat (min n-functions n-names) collect (cons (sap-int (sap+ image-base (sap-ref-32 functions-sap offset))) diff --git a/src/compiler/mips/c-call.lisp b/src/compiler/mips/c-call.lisp index d5ce148ab..28815bfe5 100644 --- a/src/compiler/mips/c-call.lisp +++ b/src/compiler/mips/c-call.lisp @@ -361,8 +361,9 @@ and a pointer to the arguments." (incf words-processed) (incf offset n-word-bytes)) (when gprs - (loop repeat words + (loop for gpr = (pop gprs) + repeat words when gpr do (inst sw gpr nsp-tn offset) do diff --git a/src/compiler/ppc/c-call.lisp b/src/compiler/ppc/c-call.lisp index 521953564..464ce441e 100644 --- a/src/compiler/ppc/c-call.lisp +++ b/src/compiler/ppc/c-call.lisp @@ -536,10 +536,10 @@ ) (t (loop with gprs = (mapcar #'make-gpr '(3 4)) - repeat n-return-area-words for gpr = (pop gprs) for offset from (- return-area-pos) by n-word-bytes + repeat n-return-area-words do (unless gpr (bug "Out of return registers in alien-callback trampoline.")) diff --git a/src/compiler/ppc64/c-call.lisp b/src/compiler/ppc64/c-call.lisp index 99ca5833c..a16143a82 100644 --- a/src/compiler/ppc64/c-call.lisp +++ b/src/compiler/ppc64/c-call.lisp @@ -447,10 +447,10 @@ ) (t (loop with gprs = (mapcar #'make-gpr '(3 4)) - repeat n-return-area-words for gpr = (pop gprs) for offset from (- return-area-pos) by n-word-bytes + repeat n-return-area-words do (unless gpr (bug "Out of return registers in alien-callback trampoline.")) diff --git a/src/pcl/call-next-method.lisp b/src/pcl/call-next-method.lisp index c01abeaf8..41e336a56 100644 --- a/src/pcl/call-next-method.lisp +++ b/src/pcl/call-next-method.lisp @@ -127,9 +127,9 @@ (declare (dynamic-extent args)) ;; Construct the concatenation of the required arguments in ;; ORIG-ARGS and CNM-ARGS in ARGS. - (loop repeat nreq - for rest1 on args + (loop for rest1 on args for arg in orig-args + repeat nreq do (setf (car rest1) arg) finally (loop for rest2 on (rest rest1) for arg in cnm-args diff --git a/tests/avltree.pure.lisp b/tests/avltree.pure.lisp index d75d81f14..04e68cacb 100644 --- a/tests/avltree.pure.lisp +++ b/tests/avltree.pure.lisp @@ -52,7 +52,7 @@ node [shape=record];~%") (let (tree (prev-op :delete)) (setf (fill-pointer keys) 0) (loop - repeat n-ops for event from 0 do + for event from 0 repeat n-ops do (assert (= (avl-count tree) (length keys))) (let ((op (if (< (random 10) 5) diff --git a/tests/bad-code.pure.lisp b/tests/bad-code.pure.lisp index 36676cdb6..a003f5a51 100644 --- a/tests/bad-code.pure.lisp +++ b/tests/bad-code.pure.lisp @@ -270,8 +270,8 @@ (macrolet ((macro () `((lambda (x) (declare (number x)) - ',@ (loop repeat 10000 - for cons = (list 1) then (list cons) + ',@ (loop for cons = (list 1) then (list cons) + repeat 10000 finally (return cons))) t))) (macro))) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 06a2a4844..fcfdf2725 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -3877,8 +3877,8 @@ (let* ((start (get-internal-run-time)) (iterations 0) (fun (if times - (loop repeat times - for result = (checked-compile lambda) + (loop for result = (checked-compile lambda) + repeat times finally (return result)) (loop for result = (checked-compile lambda) do (incf iterations) diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp index 4e15b5f85..ee7f8d8fc 100644 --- a/tests/filesys.pure.lisp +++ b/tests/filesys.pure.lisp @@ -230,8 +230,7 @@ (if p (canon (concatenate 'string (subseq s 0 p) (subseq s (1+ p)))) s)))) - (loop repeat 1000 - for length = (random 32) + (loop for length = (random 32) for native-namestring = (coerce (loop repeat length collect @@ -240,11 +239,11 @@ 'simple-base-string) for pathname = (native-pathname native-namestring) for nnn = (native-namestring pathname) + repeat 1000 do (setf native-namestring (canon native-namestring)) (unless (string= nnn native-namestring) (error "1: wanted ~S, got ~S" native-namestring nnn))) - (loop repeat 1000 - for native-namestring = (with-output-to-string (s) + (loop for native-namestring = (with-output-to-string (s) (write-string "mu" s) (loop (let ((r (random 1.0))) @@ -262,6 +261,7 @@ s)))))) for pathname = (native-pathname native-namestring) for tricky-nnn = (native-namestring pathname) + repeat 1000 do (setf native-namestring (canon native-namestring)) (unless (string= tricky-nnn native-namestring) (error "2: wanted ~S, got ~S" native-namestring tricky-nnn)))))) diff --git a/tests/info.impure.lisp b/tests/info.impure.lisp index 6243b04b4..533d5e4d1 100644 --- a/tests/info.impure.lisp +++ b/tests/info.impure.lisp @@ -598,8 +598,8 @@ for val = (info :variable :macro-expansion name) do (assert (eql (or val 0) count)))))) ;; Try it when names are symbols or "simple" 2-list names - (run (coerce (loop repeat 50 - for sym = (gensym) + (run (coerce (loop for sym = (gensym) + repeat 50 nconc (list `(setf ,sym) sym)) 'vector)) ;; For hairy names, the tricky piece is in the rehash algorithm, diff --git a/tests/lockfree-list.impure.lisp b/tests/lockfree-list.impure.lisp index d3998303f..1c2abc674 100644 --- a/tests/lockfree-list.impure.lisp +++ b/tests/lockfree-list.impure.lisp @@ -245,7 +245,7 @@ (defparameter *l* nil) (defun construct (n) (setq *l* (make-ordered-list :key-type 'fixnum)) - (loop repeat n for key from 10 by 10 do (lfl-insert *l* key (make-foo :a key)))) + (loop for key from 10 by 10 repeat n do (lfl-insert *l* key (make-foo :a key)))) (defun scan-lfl-gens (deletep &aux page-indices) (do ((node (get-next (list-head *l*)) ; can't delete the dummy node (list head) diff --git a/tests/loop.pure.lisp b/tests/loop.pure.lisp index 7f3e8bcc5..16ecf849a 100644 --- a/tests/loop.pure.lisp +++ b/tests/loop.pure.lisp @@ -428,7 +428,7 @@ (assert-no-signal (compile nil '(lambda () (declare (optimize speed)) - (loop repeat (+ 1 5) for baz = 'this then 'that + (loop for baz = 'this then 'that repeat (+ 1 5) do (print baz)))))) (with-test (:name :loop-default-init-type) diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp index 215a01d40..ae6e159dc 100644 --- a/tests/print.impure.lisp +++ b/tests/print.impure.lisp @@ -601,15 +601,15 @@ (oops)) (loop for f = most-positive-single-float then (/ f 2.0) while (> f 0.0) - do (loop repeat 10 - for fr = (random f) + do (loop for fr = (random f) + repeat 10 do (unless (eql fr (read-from-string (prin1-to-string fr))) (push fr oops) (return)))) (loop for f = most-negative-single-float then (/ f 2.0) while (< f -0.0) - do (loop repeat 10 - for fr = (- (random (- f))) + do (loop for fr = (- (random (- f))) + repeat 10 do (unless (eql fr (read-from-string (prin1-to-string fr))) (push fr oops) (return)))) @@ -625,16 +625,16 @@ ;; FIXME skipping denormalized floats due to bug 793774. (loop for f = most-positive-double-float then (/ f 2d0) while (> f 0d0) - do (loop repeat 10 - for fr = (random f) + do (loop for fr = (random f) + repeat 10 do (unless (float-denormalized-p fr) (unless (eql fr (read-from-string (prin1-to-string fr))) (push fr oops) (return))))) (loop for f = most-negative-double-float then (/ f 2d0) while (< f -0d0) - do (loop repeat 10 - for fr = (- (random (- f))) + do (loop for fr = (- (random (- f))) + repeat 10 do (unless (float-denormalized-p fr) (unless (eql fr (read-from-string (prin1-to-string fr))) (push fr oops) diff --git a/tools-for-build/wxs.lisp b/tools-for-build/wxs.lisp index 904a0b17b..af2a5840a 100644 --- a/tools-for-build/wxs.lisp +++ b/tools-for-build/wxs.lisp @@ -59,11 +59,10 @@ "Turns something like 0.pre7.14.flaky4.13 (see version.lisp-expr) into an acceptable form for WIX (up to four dot-separated numbers)." (with-output-to-string (output) - (loop repeat 4 - with position = 0 + (loop with position = 0 for separator = "" then "." - for next-digit = (position-if #'digit-char-p horrible-thing - :start position) + for next-digit = (position-if #'digit-char-p horrible-thing :start position) + repeat 4 while next-digit do (multiple-value-bind (number end) (parse-integer horrible-thing :start next-digit :junk-allowed t)