/[cmucl]/src/assembly/sparc/array.lisp
ViewVC logotype

Contents of /src/assembly/sparc/array.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (show annotations)
Thu Jun 11 16:03:56 2009 UTC (4 years, 10 months ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, merged-unicode-utf16-extfmt-2009-06-11, intl-branch-working-2010-02-19-1000, unicode-string-buffer-impl-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, intl-2-branch-base, GIT-CONVERSION, cross-sol-x86-merged, intl-branch-working-2010-02-11-1000, RELEASE_20b, release-20a-base, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, pre-merge-intl-branch, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, snapshot-2010-08, cross-sol-x86-2010-12-20, intl-branch-2010-03-18-1300, RELEASE_20a, release-20a-pre1, snapshot-2009-11, snapshot-2009-12, portable-clx-import-2009-06-16, cross-sparc-branch-base, intl-branch-base, portable-clx-base, snapshot-2009-08, snapshot-2009-07, HEAD
Branch point for: portable-clx-branch, cross-sparc-branch, RELEASE-20B-BRANCH, unicode-string-buffer-branch, sparc-tramp-assem-branch, RELEASE-20A-BRANCH, amd64-dd-branch, unicode-string-buffer-impl-branch, intl-branch, cross-sol-x86-branch, intl-2-branch
Changes since 1.10: +5 -2 lines
Merge Unicode work to trunk.  From label
unicode-utf16-extfmt-2009-06-11.
1 ;;; -*- Package: SPARC -*-
2 ;;;
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.
6 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/assembly/sparc/array.lisp,v 1.11 2009/06/11 16:03:56 rtoy Rel $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; $Header: /tiger/var/lib/cvsroots/cmucl/src/assembly/sparc/array.lisp,v 1.11 2009/06/11 16:03:56 rtoy Rel $
13 ;;;
14 ;;; This file contains the support routines for arrays and vectors.
15 ;;;
16 ;;; Written by William Lott.
17 ;;;
18 (in-package "SPARC")
19
20
21 (define-assembly-routine (allocate-vector
22 (:policy :fast-safe)
23 (:translate allocate-vector)
24 (:arg-types positive-fixnum
25 positive-fixnum
26 positive-fixnum))
27 ((:arg type any-reg a0-offset)
28 (:arg length any-reg a1-offset)
29 (:arg words any-reg a2-offset)
30 (:res result descriptor-reg a0-offset)
31
32 (:temp ndescr non-descriptor-reg nl0-offset)
33 (:temp gc-temp non-descriptor-reg nl1-offset)
34 (:temp vector descriptor-reg a3-offset))
35 (pseudo-atomic ()
36 (inst add ndescr words (* (1+ vm:vector-data-offset) vm:word-bytes))
37 (inst andn ndescr vm:lowtag-mask)
38 (allocation vector ndescr other-pointer-type :temp-tn gc-temp)
39 #+gencgc
40 (progn
41 ;; ndescr points to one word past the end of the allocated
42 ;; space. Fill the last word with a zero.
43 (inst add ndescr vector)
44 (storew zero-tn ndescr -1 vm:other-pointer-type))
45 (inst srl ndescr type vm:word-shift)
46 (storew ndescr vector 0 vm:other-pointer-type)
47 (storew length vector vm:vector-length-slot vm:other-pointer-type))
48 ;; This makes sure the zero byte at the end of a string is paged in so
49 ;; the kernel doesn't bitch if we pass it the string.
50 ;;
51 ;; This used to write to the word after the last allocated word. I
52 ;; (RLT) made it write to the last allocated word, which is where
53 ;; the zero-byte of the string is. Look at the deftransform for
54 ;; make-array in array-tran.lisp. For strings we always allocate
55 ;; enough space to hold the zero-byte.
56 #-gencgc
57 (storew zero-tn alloc-tn -1)
58 (move result vector))
59
60
61
62 ;;;; Hash primitives
63
64 #+assembler
65 (defparameter sxhash-simple-substring-entry (gen-label))
66
67 (define-assembly-routine (sxhash-simple-string
68 (:translate %sxhash-simple-string)
69 (:policy :fast-safe)
70 (:result-types positive-fixnum))
71 ((:arg string descriptor-reg a0-offset)
72 (:res result any-reg a0-offset)
73
74 (:temp length any-reg a1-offset)
75 (:temp accum non-descriptor-reg nl0-offset)
76 (:temp data non-descriptor-reg nl1-offset)
77 (:temp temp non-descriptor-reg nl2-offset)
78 (:temp offset non-descriptor-reg nl3-offset))
79
80 (declare (ignore result accum data temp offset))
81
82 (inst b sxhash-simple-substring-entry)
83 (loadw length string vm:vector-length-slot vm:other-pointer-type))
84
85
86 ;; Implement the one-at-a-time algorithm designed by Bob Jenkins
87 ;; (see <http://burtleburtle.net/bob/hash/doobs.html> for some
88 ;; more information).
89 ;;
90 ;; For completeness, here is the hash function, in C, from that web
91 ;; page. ub4 is an unsigned 32-bit integer.
92
93 #||
94 ub4 one_at_a_time(char *key, ub4 len)
95 {
96 ub4 hash, i;
97 for (hash=0, i=0; i<len; ++i)
98 {
99 hash += key[i];
100 hash += (hash << 10);
101 hash ^= (hash >> 6);
102 }
103 hash += (hash << 3);
104 hash ^= (hash >> 11);
105 hash += (hash << 15);
106 return (hash & mask);
107 }
108
109 ||#
110
111
112 (define-assembly-routine (sxhash-simple-substring
113 (:translate %sxhash-simple-substring)
114 (:policy :fast-safe)
115 (:arg-types * positive-fixnum)
116 (:result-types positive-fixnum))
117 ((:arg string descriptor-reg a0-offset)
118 (:arg length any-reg a1-offset)
119 (:res result any-reg a0-offset)
120
121 (:temp accum non-descriptor-reg nl0-offset)
122 (:temp data non-descriptor-reg nl1-offset)
123 (:temp temp non-descriptor-reg nl2-offset)
124 (:temp offset non-descriptor-reg nl3-offset))
125 (emit-label sxhash-simple-substring-entry)
126
127 #+unicode
128 (inst sll length 1) ; Number of bytes = twice the length
129
130 (inst li offset (- (* vector-data-offset word-bytes) other-pointer-type))
131 (inst b test)
132 (move accum zero-tn)
133
134 LOOP
135
136 ;; hash += key[i]
137 (inst add accum data)
138 ;; hash += (hash << 10)
139 (inst slln temp accum 10)
140 (inst add accum temp)
141 ;; hash ^= (hash >> 6)
142 (inst srln temp accum 6)
143 (inst xor accum temp)
144 (inst add offset 1)
145
146 TEST
147
148 (inst subcc length (fixnumize 1))
149 (inst b :ge loop)
150 (inst ldub data string offset)
151
152 ;; hash += (hash << 3)
153 (inst slln temp accum 3)
154 (inst add accum temp)
155 ;; hash ^= (hash >> 11)
156 (inst srln temp accum 11)
157 (inst xor accum temp)
158 ;; hash += (hash << 15)
159 (inst slln temp accum 15)
160 (inst add accum temp)
161
162 ;;(inst li temp most-positive-fixnum)
163 ;;(inst and accum temp)
164 ;; Make it a fixnum result
165
166 ;; Make the result a positive fixnum. Shifting it left, then right
167 ;; does what we want, and extracts the bits we need.
168 (inst slln accum (1+ vm:fixnum-tag-bits))
169 (inst srln result accum 1))

  ViewVC Help
Powered by ViewVC 1.1.5