3 (define-assembly-routine (allocate-vector
5 (:translate allocate-vector)
6 (:arg-types positive-fixnum
9 ((:arg type any-reg a0-offset)
10 (:arg length any-reg a1-offset)
11 (:arg words any-reg a2-offset)
12 (:res result descriptor-reg a0-offset)
14 (:temp ndescr non-descriptor-reg nl0-offset)
15 (:temp pa-flag non-descriptor-reg nl4-offset))
16 ;; This is kinda sleezy, changing words like this. But we can because
17 ;; the vop thinks it is temporary.
18 (inst addu words (+ (1- (ash 1 n-lowtag-bits))
19 (* vector-data-offset n-word-bytes)))
20 (inst li ndescr (lognot lowtag-mask))
21 (inst and words ndescr)
22 (inst srl ndescr type word-shift)
24 (pseudo-atomic (pa-flag)
25 (inst or result alloc-tn other-pointer-lowtag)
26 (inst addu alloc-tn words)
27 (storew ndescr result 0 other-pointer-lowtag)
28 (storew length result vector-length-slot other-pointer-lowtag)))
33 (define-assembly-routine (sxhash-simple-string
34 (:translate %sxhash-simple-string)
36 (:result-types positive-fixnum))
37 ((:arg string descriptor-reg a0-offset)
38 (:res result any-reg a0-offset)
40 (:temp length any-reg a1-offset)
42 (:temp lip interior-reg lip-offset)
43 (:temp accum non-descriptor-reg nl0-offset)
44 (:temp data non-descriptor-reg nl1-offset)
45 (:temp byte non-descriptor-reg nl2-offset)
46 (:temp retaddr non-descriptor-reg nl3-offset))
48 ;; These are needed after we jump into sxhash-simple-substring.
50 ;; FIXME: *BOGGLE* -- CSR, 2002-08-22
51 (progn result lip accum data byte retaddr)
53 (inst j (make-fixup 'sxhash-simple-substring :assembly-routine))
54 (loadw length string vector-length-slot other-pointer-lowtag))
56 (define-assembly-routine (sxhash-simple-substring
57 (:translate %sxhash-simple-substring)
59 (:arg-types * positive-fixnum)
60 (:result-types positive-fixnum))
61 ((:arg string descriptor-reg a0-offset)
62 (:arg length any-reg a1-offset)
63 (:res result any-reg a0-offset)
65 (:temp lip interior-reg lip-offset)
66 (:temp accum non-descriptor-reg nl0-offset)
67 (:temp data non-descriptor-reg nl1-offset)
68 (:temp byte non-descriptor-reg nl2-offset)
69 (:temp retaddr non-descriptor-reg nl3-offset))
71 ;; Save the return address
72 (inst subu retaddr lip code-tn)
74 ;; Get a pointer to the data.
76 (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))
82 (inst and byte data #xff)
83 (inst xor accum accum byte)
84 (inst sll byte accum 5)
85 (inst srl accum accum 27)
86 (inst or accum accum byte)
88 (inst srl byte data 8)
89 (inst and byte byte #xff)
90 (inst xor accum accum byte)
91 (inst sll byte accum 5)
92 (inst srl accum accum 27)
93 (inst or accum accum byte)
95 (inst srl byte data 16)
96 (inst and byte byte #xff)
97 (inst xor accum accum byte)
98 (inst sll byte accum 5)
99 (inst srl accum accum 27)
100 (inst or accum accum byte)
102 (inst srl byte data 24)
103 (inst xor accum accum byte)
104 (inst sll byte accum 5)
105 (inst srl accum accum 27)
106 (inst or accum accum byte)
108 (inst addu lip lip 4)
112 (inst addu length length (fixnumize -4))
114 (inst bgez length loop)
117 (inst addu length length (fixnumize 3))
118 (inst beq length zero-tn one-more)
119 (inst addu length length (fixnumize -1))
120 (inst beq length zero-tn two-more)
121 (inst addu length length (fixnumize -1))
122 (inst bne length zero-tn done)
125 (ecase *backend-byte-order*
126 (:big-endian (inst srl byte data 8))
127 (:little-endian (inst srl byte data 16)))
128 (inst and byte byte #xff)
129 (inst xor accum accum byte)
130 (inst sll byte accum 5)
131 (inst srl accum accum 27)
132 (inst or accum accum byte)
136 (ecase *backend-byte-order*
137 (:big-endian (inst srl byte data 16))
138 (:little-endian (inst srl byte data 8)))
139 (inst and byte byte #xff)
140 (inst xor accum accum byte)
141 (inst sll byte accum 5)
142 (inst srl accum accum 27)
143 (inst or accum accum byte)
147 (when (eq *backend-byte-order* :big-endian)
148 (inst srl data data 24))
149 (inst and byte data #xff)
150 (inst xor accum accum byte)
151 (inst sll byte accum 5)
152 (inst srl accum accum 27)
153 (inst or accum accum byte)
157 (inst sll result accum 5)
158 (inst srl result result 3)
160 ;; Restore the return address.
161 (inst addu lip code-tn retaddr))