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