From b4693ec24f185935cd8b24fe4f74b9f8f310913d Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Thu, 6 Jul 2000 05:41:28 +0000
Subject: [PATCH] When asserting a single value from truncate etc, rather than
 using a single value type assertion following values '(the index (values
 ...)), use a multiple values types assertion '(the (values index t) ...),
 which is simpler for the compiler.

---
 code/hash-new.lisp    | 4 ++--
 code/hash.lisp        | 7 +++----
 code/room.lisp        | 6 +++---
 code/serve-event.lisp | 4 ++--
 4 files changed, 10 insertions(+), 11 deletions(-)

diff --git a/code/hash-new.lisp b/code/hash-new.lisp
index 79ef7584c..1b5012ae6 100644
--- a/code/hash-new.lisp
+++ b/code/hash-new.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.13 2000/07/06 04:34:02 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.14 2000/07/06 05:41:27 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -313,7 +313,7 @@
 	      (fixnum
 	       (+ rehash-size old-size))
 	      (float
-	       (the index (values (round (* rehash-size old-size))))))))
+	       (the (values index t) (round (* rehash-size old-size)))))))
 	 (new-kv-vector (make-array (* 2 new-size) :initial-element :empty))
 	 (new-next-vector (make-array new-size
 				      :element-type '(unsigned-byte 32)
diff --git a/code/hash.lisp b/code/hash.lisp
index 7caae1845..cc6d93e4e 100644
--- a/code/hash.lisp
+++ b/code/hash.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.37 2000/07/06 04:34:03 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.38 2000/07/06 05:41:27 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -350,7 +350,7 @@
 		  (fixnum
 		   (+ rehash-size old-length))
 		  (float
-		   (the index (values (round (* rehash-size old-length)))))))
+		   (the (values index t) (round (* rehash-size old-length))))))
 	      old-length))
 	 (new-vector (make-array new-length :initial-element nil))
 	 #-gengc (weak-p (hash-table-weak-p table)))
@@ -456,8 +456,7 @@
 		       (weak-pointer-value (hash-table-bucket-key bucket))
 		     (assert valid)
 		     (when (eq key bucket-key)
-		       (return (values (hash-table-bucket-value bucket)
-				       t))))))
+		       (return (values (hash-table-bucket-value bucket) t))))))
 	       (do ((bucket (svref vector index)
 			    (hash-table-bucket-next bucket)))
 		   ((null bucket) (values default nil))
diff --git a/code/room.lisp b/code/room.lisp
index 5dee644c6..f385d2ea7 100644
--- a/code/room.lisp
+++ b/code/room.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.28 2000/07/06 04:37:43 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.29 2000/07/06 05:41:28 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -639,8 +639,8 @@
 		   (return-from print-allocated-objects (values)))
 		 
 		 (unless count
-		   (let ((this-page (* (the (unsigned-byte 32)
-					    (values (truncate addr pagesize)))
+		   (let ((this-page (* (the (values (unsigned-byte 32) t)
+					    (truncate addr pagesize))
 				       pagesize)))
 		     (declare (type (unsigned-byte 32) this-page))
 		     (when (/= this-page last-page)
diff --git a/code/serve-event.lisp b/code/serve-event.lisp
index 3e2513dfb..ab7d5e1a3 100644
--- a/code/serve-event.lisp
+++ b/code/serve-event.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/serve-event.lisp,v 1.24 2000/07/06 04:31:17 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/serve-event.lisp,v 1.25 2000/07/06 05:41:28 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -265,7 +265,7 @@
      (multiple-value-bind (q r)
 			  (truncate (coerce timeout 'single-float))
        (declare (type index q) (single-float r))
-       (values q (the index (values (truncate (* r 1f6)))))))
+       (values q (the (values index t) (truncate (* r 1f6))))))
     (t
      (error "Timeout is not a real number or NIL: ~S" timeout))))
 
-- 
GitLab