1 ;;;; support routines for arrays and vectors
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
15 (define-assembly-routine (allocate-vector
17 (:translate allocate-vector
)
18 (:arg-types positive-fixnum
21 ((:arg type any-reg a0-offset
)
22 (:arg length any-reg a1-offset
)
23 (:arg words any-reg a2-offset
)
24 (:res result descriptor-reg a0-offset
)
26 (:temp ndescr non-descriptor-reg nl0-offset
))
27 ;; This is kinda sleezy, changing words like this. But we can because
28 ;; the vop thinks it is temporary.
29 (inst addq words
(+ (1- (ash 1 n-lowtag-bits
))
30 (* vector-data-offset n-word-bytes
))
32 (inst li
(lognot lowtag-mask
) ndescr
)
33 (inst and words ndescr words
)
34 (inst srl type word-shift ndescr
)
37 (inst bis alloc-tn other-pointer-lowtag result
)
38 (inst addq alloc-tn words alloc-tn
)
39 (storew ndescr result
0 other-pointer-lowtag
)
40 (storew length result vector-length-slot other-pointer-lowtag
)))
44 (define-assembly-routine (sxhash-simple-string
45 (:translate %sxhash-simple-string
)
47 (:result-types positive-fixnum
))
48 ((:arg string descriptor-reg a0-offset
)
49 (:res result any-reg a0-offset
)
51 (:temp length any-reg a1-offset
)
53 (:temp lip interior-reg lip-offset
)
54 (:temp accum non-descriptor-reg nl0-offset
)
55 (:temp data non-descriptor-reg nl1-offset
)
56 (:temp byte non-descriptor-reg nl2-offset
)
57 (:temp retaddr non-descriptor-reg nl3-offset
)
58 (:temp temp1 non-descriptor-reg nl4-offset
))
60 ;; These are needed after we jump into sxhash-simple-substring.
61 (progn result lip accum data byte retaddr
)
63 (inst li
(make-fixup 'sxhash-simple-substring
:assembly-routine
) temp1
)
64 (loadw length string vector-length-slot other-pointer-lowtag
)
65 (inst jmp zero-tn temp1
66 (make-fixup 'sxhash-simple-substring
:assembly-routine
)))
68 (define-assembly-routine (sxhash-simple-substring
69 (:translate %sxhash-simple-substring
)
71 (:arg-types
* positive-fixnum
)
72 (:result-types positive-fixnum
))
73 ((:arg string descriptor-reg a0-offset
)
74 (:arg length any-reg a1-offset
)
75 (:res result any-reg a0-offset
)
77 (:temp lip interior-reg lip-offset
)
78 (:temp accum non-descriptor-reg nl0-offset
)
79 (:temp data non-descriptor-reg nl1-offset
)
80 (:temp byte non-descriptor-reg nl2-offset
)
81 (:temp retaddr non-descriptor-reg nl3-offset
))
83 ;; Save the return address
84 (inst subq lip code-tn retaddr
)
86 ;; Get a pointer to the data.
88 (- (* vector-data-offset n-word-bytes
) other-pointer-lowtag
)
91 (inst br zero-tn test
)
95 (inst and data
#xff byte
)
96 (inst xor accum byte accum
)
97 (inst sll accum
5 byte
)
98 (inst srl accum
27 accum
)
99 (inst mskll accum
4 accum
)
100 (inst bis accum byte accum
)
102 (inst srl data
8 byte
)
103 (inst and byte
#xff byte
)
104 (inst xor accum byte accum
)
105 (inst sll accum
5 byte
)
106 (inst srl accum
27 accum
)
107 (inst mskll accum
4 accum
)
108 (inst bis accum byte accum
)
110 (inst srl data
16 byte
)
111 (inst and byte
#xff byte
)
112 (inst xor accum byte accum
)
113 (inst sll accum
5 byte
)
114 (inst srl accum
27 accum
)
115 (inst mskll accum
4 accum
)
116 (inst bis accum byte accum
)
118 (inst srl data
24 byte
)
119 (inst xor accum byte accum
)
120 (inst sll accum
5 byte
)
121 (inst srl accum
27 accum
)
122 (inst mskll accum
4 accum
)
123 (inst bis accum byte accum
)
125 (inst addq lip
4 lip
)
129 (inst subq length
(fixnum 4) length
)
130 (inst ldl data
0 lip
)
131 (inst bge length loop
)
133 (inst addq length
(fixnum 3) length
)
134 (inst beq length one-more
)
135 (inst subq length
(fixnum 1) length
)
136 (inst beq length two-more
)
137 (inst bne length done
)
139 (inst srl data
16 byte
)
140 (inst and byte
#xff byte
)
141 (inst xor accum byte accum
)
142 (inst sll accum
5 byte
)
143 (inst srl accum
27 accum
)
144 (inst mskll accum
4 accum
)
145 (inst bis accum byte accum
)
146 (inst addq length
(fixnum 1) length
)
150 (inst subq length
(fixnum 1) length
)
151 (inst srl data
8 byte
)
152 (inst and byte
#xff byte
)
153 (inst xor accum byte accum
)
154 (inst sll accum
5 byte
)
155 (inst srl accum
27 accum
)
156 (inst mskll accum
4 accum
)
157 (inst bis accum byte accum
)
158 (inst addq length
(fixnum 1) length
)
162 (inst subq length
(fixnum 1) length
)
163 (inst and data
#xff byte
)
164 (inst xor accum byte accum
)
165 (inst sll accum
5 byte
)
166 (inst srl accum
27 accum
)
167 (inst mskll accum
4 accum
)
168 (inst bis accum byte accum
)
172 (inst sll accum
5 result
)
173 (inst mskll result
4 result
)
174 (inst srl result
3 result
)
176 ;; Restore the return address.
177 (inst addq code-tn retaddr lip
))
