1 ;;; -*- Package: ALPHA -*-
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
8 ;;; **********************************************************************
10 ;;; This file contains the support routines for arrays and vectors.
12 ;;; Written by William Lott.
13 ;;; Conversion by Sean Hallgren
18 (define-assembly-routine (allocate-vector
20 (:translate allocate-vector)
21 (:arg-types positive-fixnum
24 ((:arg type any-reg a0-offset)
25 (:arg length any-reg a1-offset)
26 (:arg words any-reg a2-offset)
27 (:res result descriptor-reg a0-offset)
29 (:temp ndescr non-descriptor-reg nl0-offset))
30 ;; This is kinda sleezy, changing words like this. But we can because
31 ;; the vop thinks it is temporary.
32 (inst addq words (+ (1- (ash 1 lowtag-bits))
33 (* vector-data-offset word-bytes))
35 (inst li (lognot lowtag-mask) ndescr)
36 (inst and words ndescr words)
37 (inst srl type word-shift ndescr)
40 (inst bis alloc-tn other-pointer-type result)
41 (inst addq alloc-tn words alloc-tn)
42 (storew ndescr result 0 other-pointer-type)
43 (storew length result vector-length-slot other-pointer-type)))
48 (define-assembly-routine (sxhash-simple-string
49 (:translate %sxhash-simple-string)
51 (:result-types positive-fixnum))
52 ((:arg string descriptor-reg a0-offset)
53 (:res result any-reg a0-offset)
55 (:temp length any-reg a1-offset)
57 (:temp lip interior-reg lip-offset)
58 (:temp accum non-descriptor-reg nl0-offset)
59 (:temp data non-descriptor-reg nl1-offset)
60 (:temp byte non-descriptor-reg nl2-offset)
61 (:temp retaddr non-descriptor-reg nl3-offset)
62 (:temp temp1 non-descriptor-reg nl4-offset))
64 ;; These are needed after we jump into sxhash-simple-substring.
65 (progn result lip accum data byte retaddr)
67 (inst li (make-fixup 'sxhash-simple-substring :assembly-routine) temp1)
68 (loadw length string vector-length-slot other-pointer-type)
69 (inst jmp zero-tn temp1
70 (make-fixup 'sxhash-simple-substring :assembly-routine)))
72 (define-assembly-routine (sxhash-simple-substring
73 (:translate %sxhash-simple-substring)
75 (:arg-types * positive-fixnum)
76 (:result-types positive-fixnum))
77 ((:arg string descriptor-reg a0-offset)
78 (:arg length any-reg a1-offset)
79 (:res result any-reg a0-offset)
81 (:temp lip interior-reg lip-offset)
82 (:temp accum non-descriptor-reg nl0-offset)
83 (:temp data non-descriptor-reg nl1-offset)
84 (:temp byte non-descriptor-reg nl2-offset)
85 (:temp retaddr non-descriptor-reg nl3-offset))
87 ;; Save the return address
88 (inst subq lip code-tn retaddr)
90 ;; Get a pointer to the data.
92 (- (* vector-data-offset word-bytes) other-pointer-type)
95 (inst br zero-tn test)
99 (inst and data #xff byte)
100 (inst xor accum byte accum)
101 (inst sll accum 5 byte)
102 (inst srl accum 27 accum)
103 (inst mskll accum 4 accum)
104 (inst bis accum byte accum)
106 (inst srl data 8 byte)
107 (inst and byte #xff byte)
108 (inst xor accum byte accum)
109 (inst sll accum 5 byte)
110 (inst srl accum 27 accum)
111 (inst mskll accum 4 accum)
112 (inst bis accum byte accum)
114 (inst srl data 16 byte)
115 (inst and byte #xff byte)
116 (inst xor accum byte accum)
117 (inst sll accum 5 byte)
118 (inst srl accum 27 accum)
119 (inst mskll accum 4 accum)
120 (inst bis accum byte accum)
122 (inst srl data 24 byte)
123 (inst xor accum byte accum)
124 (inst sll accum 5 byte)
125 (inst srl accum 27 accum)
126 (inst mskll accum 4 accum)
127 (inst bis accum byte accum)
129 (inst addq lip 4 lip)
133 (inst subq length (fixnum 4) length)
134 (inst ldl data 0 lip)
135 (inst bge length loop)
137 (inst addq length (fixnum 3) length)
138 (inst beq length one-more)
139 (inst subq length (fixnum 1) length)
140 (inst beq length two-more)
141 (inst bne length done)
143 (inst srl data 16 byte)
144 (inst and byte #xff byte)
145 (inst xor accum byte accum)
146 (inst sll accum 5 byte)
147 (inst srl accum 27 accum)
148 (inst mskll accum 4 accum)
149 (inst bis accum byte accum)
150 (inst addq length (fixnum 1) length)
154 (inst subq length (fixnum 1) length)
155 (inst srl data 8 byte)
156 (inst and byte #xff byte)
157 (inst xor accum byte accum)
158 (inst sll accum 5 byte)
159 (inst srl accum 27 accum)
160 (inst mskll accum 4 accum)
161 (inst bis accum byte accum)
162 (inst addq length (fixnum 1) length)
166 (inst subq length (fixnum 1) length)
167 (inst and data #xff byte)
168 (inst xor accum byte accum)
169 (inst sll accum 5 byte)
170 (inst srl accum 27 accum)
171 (inst mskll accum 4 accum)
172 (inst bis accum byte accum)
176 (inst sll accum 5 result)
177 (inst mskll result 4 result)
178 (inst srl result 3 result)
180 ;; Restore the return address.
181 (inst addq code-tn retaddr lip))