1.0.4.37: Delete some dead code in pack.lisp
[sbcl.git] / src / assembly / alpha / array.lisp
1 ;;;; support routines for arrays and vectors
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!VM")
13
14
15 (define-assembly-routine (allocate-vector
16                           (:policy :fast-safe)
17                           (:translate allocate-vector)
18                           (:arg-types positive-fixnum
19                                       positive-fixnum
20                                       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)
25
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))
31         words)
32   (inst li (lognot lowtag-mask) ndescr)
33   (inst and words ndescr words)
34   (inst srl type word-shift ndescr)
35
36   (pseudo-atomic ()
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)))
41 \f
42 ;;;; hash primitives
43 #|
44 (define-assembly-routine (sxhash-simple-string
45                           (:translate %sxhash-simple-string)
46                           (:policy :fast-safe)
47                           (:result-types positive-fixnum))
48                          ((:arg string descriptor-reg a0-offset)
49                           (:res result any-reg a0-offset)
50
51                           (:temp length any-reg a1-offset)
52
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))
59
60   ;; These are needed after we jump into sxhash-simple-substring.
61   (progn result lip accum data byte  retaddr)
62
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)))
67
68 (define-assembly-routine (sxhash-simple-substring
69                           (:translate %sxhash-simple-substring)
70                           (:policy :fast-safe)
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)
76
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))
82
83   ;; Save the return address
84   (inst subq lip code-tn retaddr)
85
86   ;; Get a pointer to the data.
87   (inst addq string
88         (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
89         lip)
90   (move zero-tn accum)
91   (inst br zero-tn test)
92
93   loop
94
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)
101
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)
109
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)
117
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)
124
125   (inst addq lip 4 lip)
126
127   test
128
129   (inst subq length (fixnum 4) length)
130   (inst ldl data 0 lip)
131   (inst bge length loop)
132
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)
138
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)
147
148   two-more
149
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)
159
160   one-more
161
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)
169
170   done
171
172   (inst sll accum 5 result)
173   (inst mskll result 4 result)
174   (inst srl result 3 result)
175
176   ;; Restore the return address.
177   (inst addq code-tn retaddr lip))
178 |#