From 2e653350ec833a43c55517656b8463be2d2823e8 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Sun, 17 Jun 1990 22:23:19 +0000
Subject: [PATCH] Added type assertions around/in %primitives so that fixnums
 get put in any-regs.

---
 code/hash.lisp    | 21 ++++++++++++---------
 code/package.lisp | 12 ++++++++----
 2 files changed, 20 insertions(+), 13 deletions(-)

diff --git a/code/hash.lisp b/code/hash.lisp
index da755ecfa..1d2a44ce2 100644
--- a/code/hash.lisp
+++ b/code/hash.lisp
@@ -44,7 +44,7 @@
   (declare (ignore depth))
   (format stream "#<~A Hash Table {~X}>"
 	  (symbol-name (hash-table-kind structure))
-	  (system:%primitive lisp::make-fixnum structure)))
+	  (system:%primitive make-fixnum structure)))
 
 
 
@@ -55,14 +55,14 @@
 (defmacro eq-hash (object)
   "Gives us a hashing of an object such that (eq a b) implies
    (= (eq-hash a) (eq-hash b))"
-  `(%primitive make-fixnum ,object))
+  `(truly-the (unsigned-byte 24) (%primitive make-fixnum ,object)))
 
 (defmacro eql-hash (object)
   "Gives us a hashing of an object such that (eql a b) implies
    (= (eql-hash a) (eql-hash b))"
   `(if (numberp ,object)
        (logand (truncate ,object) most-positive-fixnum)
-       (%primitive make-fixnum ,object)))
+       (truly-the fixnum (%primitive make-fixnum ,object))))
 
 (defmacro equal-hash (object)
   "Gives us a hashing of an object such that (equal a b) implies
@@ -182,8 +182,9 @@
 	    ,eql-body))))))
 
 (defmacro eq-rehash-if-needed ()
-  `(let ((subtype (%primitive get-vector-subtype vector)))
-     (declare (fixnum subtype))
+  `(let ((subtype (truly-the (unsigned-byte 24)
+			     (%primitive get-vector-subtype vector))))
+     (declare (type (unsigned-byte 24) subtype))
      (cond ((/= subtype valid-hashing)
 	    (rehash hash-table vector size)
 	    (setq vector (hash-table-table hash-table)))
@@ -201,9 +202,11 @@
 	  (setq size (length vector)))))
 
 (defmacro rehash-if-needed ()
-  `(let ((subtype (%primitive get-vector-subtype vector))
+  `(let ((subtype (truly-the (unsigned-byte 24)
+			     (%primitive get-vector-subtype vector)))
 	 (size (length vector)))
-     (declare (fixnum subtype size))
+     (declare (type (unsigned-byte 24) subtype)
+	      (fixnum size))
      (cond ((and (not (eq (hash-table-kind hash-table) 'equal))
 		 (/= subtype valid-hashing))
 	    (rehash hash-table vector size)
@@ -377,7 +380,7 @@
 		     (the fixnum ,place))))))
 
 (defmacro sxhash-simple-string (sequence)
-  `(%primitive sxhash-simple-string ,sequence))
+  `(truly-the index (%primitive sxhash-simple-string ,sequence)))
 
 (defmacro sxhash-string (sequence)
   (let ((data (gensym))
@@ -387,7 +390,7 @@
 		       (,start)
 		       (,end))
        (if (zerop ,start)
-	   (%primitive sxhash-simple-substring ,data ,end)
+	   (truly-the index (%primitive sxhash-simple-substring ,data ,end))
 	   (sxhash-simple-string (coerce (the string ,sequence)
 					 'simple-string))))))
 
diff --git a/code/package.lisp b/code/package.lisp
index f0fe36a07..2a50f9ada 100644
--- a/code/package.lisp
+++ b/code/package.lisp
@@ -208,7 +208,9 @@
   (let* ((vec (package-hashtable-table table))
 	 (hash (package-hashtable-hash table))
 	 (len (length vec))
-	 (sxhash (%primitive sxhash-simple-string (symbol-name symbol)))
+	 (sxhash (truly-the index
+			    (%primitive sxhash-simple-string
+					(symbol-name symbol))))
 	 (h2 (the fixnum (1+ (the fixnum (rem sxhash
 					      (the fixnum (- len 2))))))))
     (declare (simple-vector vec)
@@ -287,7 +289,8 @@
 (defun nuke-symbol (table string)
   (declare (simple-string string))
   (let* ((length (length string))
-	 (hash (%primitive sxhash-simple-string string))
+	 (hash (truly-the index
+			  (%primitive sxhash-simple-string string)))
 	 (ehash (entry-hash length hash)))
     (declare (fixnum length hash))
     (with-symbol (index symbol table string length hash ehash)
@@ -583,7 +586,8 @@
 (defun find-symbol* (string length package)
   (declare (simple-string string)
 	   (fixnum length))
-  (let* ((hash (%primitive sxhash-simple-substring string length))
+  (let* ((hash (truly-the index
+			  (%primitive sxhash-simple-substring string length)))
 	 (ehash (entry-hash length hash)))
     (declare (fixnum hash ehash))
     (with-symbol (found symbol (package-internal-symbols package)
@@ -613,7 +617,7 @@
 (defun find-external-symbol (string package)
   (declare (simple-string string))
   (let* ((length (length string))
-	 (hash (%primitive sxhash-simple-string string))
+	 (hash (truly-the index (%primitive sxhash-simple-string string)))
 	 (ehash (entry-hash length hash)))
     (declare (fixnum length hash))
     (with-symbol (found symbol (package-external-symbols package)
-- 
GitLab