From 01037c9edf8c9d15574988606b93d4dda3909534 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Fri, 7 May 1993 07:41:46 +0000
Subject: [PATCH] #-gengc'ed allocate-vector 'cause the gengc version is in
 alloc.lisp. Changed sxhash-simple-string to just jump to
 sxhash-simple-substring after loading the length instead of duplicating all
 that code.

---
 assembly/mips/array.lisp | 135 ++++++---------------------------------
 1 file changed, 21 insertions(+), 114 deletions(-)

diff --git a/assembly/mips/array.lisp b/assembly/mips/array.lisp
index 3e159ce58..4eb2ac2ee 100644
--- a/assembly/mips/array.lisp
+++ b/assembly/mips/array.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/mips/array.lisp,v 1.19 1992/07/28 20:42:50 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/mips/array.lisp,v 1.20 1993/05/07 07:41:46 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -17,7 +17,7 @@
 ;;; 
 (in-package "MIPS")
 
-
+#-gengc
 (define-assembly-routine (allocate-vector
 			  (:policy :fast-safe)
 			  (:translate allocate-vector)
@@ -30,22 +30,20 @@
 			  (:res result descriptor-reg a0-offset)
 
 			  (:temp ndescr non-descriptor-reg nl0-offset)
-			  (:temp pa-flag non-descriptor-reg nl4-offset)
-			  (:temp vector descriptor-reg a3-offset))
+			  (:temp pa-flag non-descriptor-reg nl4-offset))
+  ;; This is kinda sleezy, changing words like this.  But we can because
+  ;; the vop thinks it is temporary.
+  (inst addu words (+ (1- (ash 1 lowtag-bits))
+		      (* vector-data-offset word-bytes)))
+  (inst li ndescr (lognot lowtag-mask))
+  (inst and words ndescr)
+  (inst srl ndescr type word-shift)
+
   (pseudo-atomic (pa-flag)
-    (inst or vector alloc-tn other-pointer-type)
-    ;; This is kinda sleezy, changing words like this.  But we can because
-    ;; the vop thinks it is temporary.
-    (inst addu words (+ (1- (ash 1 lowtag-bits))
-			(* vector-data-offset word-bytes)))
-    (inst li ndescr (lognot lowtag-mask))
-    (inst and words ndescr)
+    (inst or result alloc-tn other-pointer-type)
     (inst addu alloc-tn words)
-    (inst srl ndescr type word-shift)
     (storew ndescr vector 0 other-pointer-type)
-    (storew length vector vector-length-slot other-pointer-type))
-  (move result vector))
-
+    (storew length vector vector-length-slot other-pointer-type)))
 
 
 ;;;; Hash primitives
@@ -57,99 +55,15 @@
 			 ((:arg string descriptor-reg a0-offset)
 			  (:res result any-reg a0-offset)
 
+			  (:temp length any-reg a1-offset)
+
 			  (:temp lip interior-reg lip-offset)
-			  (:temp length any-reg a2-offset)
 			  (:temp accum non-descriptor-reg nl0-offset)
 			  (:temp data non-descriptor-reg nl1-offset)
-			  (:temp byte non-descriptor-reg nl2-offset)
-			  (:temp retaddr non-descriptor-reg nl3-offset))
-
-  ;; Save the return address.
-  (inst subu retaddr lip-tn code-tn)
-
-  (loadw length string vector-length-slot other-pointer-type)
-  (inst addu lip string
-	(- (* vector-data-offset word-bytes) other-pointer-type))
-  (inst b test)
-  (move accum zero-tn)
-
-  loop
-
-  (inst and byte data #xff)
-  (inst xor accum accum byte)
-  (inst sll byte accum 5)
-  (inst srl accum accum 27)
-  (inst or accum accum byte)
-
-  (inst srl byte data 8)
-  (inst and byte byte #xff)
-  (inst xor accum accum byte)
-  (inst sll byte accum 5)
-  (inst srl accum accum 27)
-  (inst or accum accum byte)
-
-  (inst srl byte data 16)
-  (inst and byte byte #xff)
-  (inst xor accum accum byte)
-  (inst sll byte accum 5)
-  (inst srl accum accum 27)
-  (inst or accum accum byte)
-
-  (inst srl byte data 24)
-  (inst xor accum accum byte)
-  (inst sll byte accum 5)
-  (inst srl accum accum 27)
-  (inst or accum accum byte)
-
-  (inst addu lip lip 4)
-
-  test
-
-  (inst addu length length (fixnum -4))
-  (inst lw data lip 0)
-  (inst bgez length loop)
-  (inst nop)
-
-  (inst addu length length (fixnum 3))
-  (inst beq length zero-tn one-more)
-  (inst addu length length (fixnum -1))
-  (inst beq length zero-tn two-more)
-  (inst addu length length (fixnum -1))
-  (inst bne length zero-tn done)
-  (inst nop)
-
-  (inst srl byte data 16)
-  (inst and byte byte #xff)
-  (inst xor accum accum byte)
-  (inst sll byte accum 5)
-  (inst srl accum accum 27)
-  (inst or accum accum byte)
-
-  two-more
-
-  (inst srl byte data 8)
-  (inst and byte byte #xff)
-  (inst xor accum accum byte)
-  (inst sll byte accum 5)
-  (inst srl accum accum 27)
-  (inst or accum accum byte)
-
-  one-more
-
-  (inst and byte data #xff)
-  (inst xor accum accum byte)
-  (inst sll byte accum 5)
-  (inst srl accum accum 27)
-  (inst or accum accum byte)
-
-  done
-
-  (inst sll result accum 5)
-  (inst srl result result 3)
-
-  ;; Restore the return address.
-  (inst addu lip-tn retaddr code-tn))
+			  (:temp byte non-descriptor-reg nl2-offset))
 
+  (inst j (make-fixup 'sxhash-simple-substring :assembly-routine))
+  (loadw length string vector-length-slot other-pointer-type))
 
 (define-assembly-routine (sxhash-simple-substring
 			  (:translate %sxhash-simple-substring)
@@ -163,11 +77,8 @@
 			  (:temp lip interior-reg lip-offset)
 			  (:temp accum non-descriptor-reg nl0-offset)
 			  (:temp data non-descriptor-reg nl1-offset)
-			  (:temp byte non-descriptor-reg nl2-offset)
-			  (:temp retaddr non-descriptor-reg nl3-offset))
-  ;; Save the return address.
-  (inst subu retaddr lip-tn code-tn)
-
+			  (:temp byte non-descriptor-reg nl2-offset))
+  ;; Get a pointer to the data.
   (inst addu lip string
 	(- (* vector-data-offset word-bytes) other-pointer-type))
   (inst b test)
@@ -245,8 +156,4 @@
   done
 
   (inst sll result accum 5)
-  (inst srl result result 3)
-
-  ;; Restore the return address.
-  (inst addu lip-tn retaddr code-tn))
-
+  (inst srl result result 3))
-- 
GitLab