Hash Function Change - Murmur hash and true per process hash seed
[perl.git] / ext / Hash-Util / Util.xs
1 #define PERL_NO_GET_CONTEXT
2
3 #include "EXTERN.h"
4 #include "perl.h"
5 #include "XSUB.h"
6
7 MODULE = Hash::Util             PACKAGE = Hash::Util
8
9 void
10 all_keys(hash,keys,placeholder)
11         HV *hash
12         AV *keys
13         AV *placeholder
14     PROTOTYPE: \%\@\@
15     PREINIT:
16         SV *key;
17         HE *he;
18     PPCODE:
19         av_clear(keys);
20         av_clear(placeholder);
21
22         (void)hv_iterinit(hash);
23         while((he = hv_iternext_flags(hash, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
24             key=hv_iterkeysv(he);
25             av_push(HeVAL(he) == &PL_sv_placeholder ? placeholder : keys,
26                     SvREFCNT_inc(key));
27         }
28         XSRETURN(1);
29
30 void
31 hidden_ref_keys(hash)
32         HV *hash
33     ALIAS:
34         Hash::Util::legal_ref_keys = 1
35     PREINIT:
36         SV *key;
37         HE *he;
38     PPCODE:
39         (void)hv_iterinit(hash);
40         while((he = hv_iternext_flags(hash, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
41             key=hv_iterkeysv(he);
42             if (ix || HeVAL(he) == &PL_sv_placeholder) {
43                 XPUSHs( key );
44             }
45         }
46
47 void
48 hv_store(hash, key, val)
49         HV *hash
50         SV* key
51         SV* val
52     PROTOTYPE: \%$$
53     CODE:
54     {
55         SvREFCNT_inc(val);
56         if (!hv_store_ent(hash, key, val, 0)) {
57             SvREFCNT_dec(val);
58             XSRETURN_NO;
59         } else {
60             XSRETURN_YES;
61         }
62     }
63
64 void
65 hash_seed()
66     PROTOTYPE:
67     PPCODE:
68     mXPUSHs(newSVpvn((char *)PERL_HASH_SEED,PERL_HASH_SEED_BYTES));
69     XSRETURN(1);
70
71 void
72 hash_value(string)
73         SV* string
74     PROTOTYPE: $
75     PPCODE:
76     STRLEN len;
77     char *pv;
78     UV uv;
79
80     pv= SvPV(string,len);
81     PERL_HASH(uv,pv,len);
82     XSRETURN_UV(uv);
83
84
85 void
86 bucket_info(rhv)
87         SV* rhv
88     PPCODE:
89 {
90     /*
91
92     Takes a non-magical hash ref as an argument and returns a list of
93     statistics about the hash. The number and keys and the size of the
94     array will always be reported as the first two values. If the array is
95     actually allocated (they are lazily allocated), then additionally
96     will return a list of counts of bucket lengths. In other words in
97
98         ($keys, $buckets, $used, @length_count)= hash::bucket_info(\%hash);
99
100     $length_count[0] is the number of empty buckets, and $length_count[1]
101     is the number of buckets with only one key in it, $buckets - $length_count[0]
102     gives the number of used buckets, and @length_count-1 is the maximum
103     bucket depth.
104
105     If the argument is not a hash ref, or if it is magical, then returns
106     nothing (the empty list).
107
108     */
109     if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
110         const HV * const hv = (const HV *) SvRV(rhv);
111         U32 max_bucket_index= HvMAX(hv);
112         U32 total_keys= HvUSEDKEYS(hv);
113         HE **bucket_array= HvARRAY(hv);
114         mXPUSHi(total_keys);
115         mXPUSHi(max_bucket_index+1);
116         mXPUSHi(0); /* for the number of used buckets */
117 #define BUCKET_INFO_ITEMS_ON_STACK 3
118         if (!bucket_array) {
119             XSRETURN(BUCKET_INFO_ITEMS_ON_STACK);
120         } else {
121             /* we use chain_length to index the stack - we eliminate an add
122              * by initializing things with the number of items already on the stack.
123              * If we have 2 items then ST(2+0) (the third stack item) will be the counter
124              * for empty chains, ST(2+1) will be for chains with one element,  etc.
125              */
126             I32 max_chain_length= BUCKET_INFO_ITEMS_ON_STACK - 1; /* so we do not have to do an extra push for the 0 index */
127             HE *he;
128             U32 bucket_index;
129             for ( bucket_index= 0; bucket_index <= max_bucket_index; bucket_index++ ) {
130                 I32 chain_length= BUCKET_INFO_ITEMS_ON_STACK;
131                 for (he= bucket_array[bucket_index]; he; he= HeNEXT(he) ) {
132                     chain_length++;
133                 }
134                 while ( max_chain_length < chain_length ) {
135                     mXPUSHi(0);
136                     max_chain_length++;
137                 }
138                 SvIVX( ST( chain_length ) )++;
139             }
140             /* now set the number of used buckets */
141             SvIVX( ST( BUCKET_INFO_ITEMS_ON_STACK - 1 ) ) = max_bucket_index - SvIVX( ST( BUCKET_INFO_ITEMS_ON_STACK ) ) + 1;
142             XSRETURN( max_chain_length + 1 ); /* max_chain_length is the index of the last item on the stack, so we add 1 */
143         }
144 #undef BUCKET_INFO_ITEMS_ON_STACK
145     }
146     XSRETURN(0);
147 }
148
149 void
150 bucket_array(rhv)
151         SV* rhv
152     PPCODE:
153 {
154     /* Returns an array of arrays representing key/bucket mappings.
155      * Each element of the array contains either an integer or a reference
156      * to an array of keys. A plain integer represents K empty buckets. An
157      * array ref represents a single bucket, with each element being a key in
158      * the hash. (Note this treats a placeholder as a normal key.)
159      *
160      * This allows one to "see" the keyorder. Note the "insert first" nature
161      * of the hash store, combined with regular remappings means that relative
162      * order of keys changes each remap.
163      */
164     if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
165         const HV * const hv = (const HV *) SvRV(rhv);
166         HE **he_ptr= HvARRAY(hv);
167         if (!he_ptr) {
168             XSRETURN(0);
169         } else {
170             U32 i, max;
171             AV *info_av;
172             HE *he;
173             I32 empty_count=0;
174             if (SvMAGICAL(hv)) {
175                 Perl_croak(aTHX_ "hash::bucket_array only works on 'normal' hashes");
176             }
177             info_av= newAV();
178             max= HvMAX(hv);
179             mXPUSHs(newRV_noinc((SV*)info_av));
180             for ( i= 0; i <= max; i++ ) {
181                 AV *key_av= NULL;
182                 for (he= he_ptr[i]; he; he= HeNEXT(he) ) {
183                     SV *key_sv;
184                     char *str;
185                     STRLEN len;
186                     char mode;
187                     if (!key_av) {
188                         key_av= newAV();
189                         if (empty_count) {
190                             av_push(info_av, newSViv(empty_count));
191                             empty_count= 0;
192                         }
193                         av_push(info_av, (SV *)newRV_noinc((SV *)key_av));
194                     }
195                     if (HeKLEN(he) == HEf_SVKEY) {
196                         SV *sv= HeSVKEY(he);
197                         SvGETMAGIC(sv);
198                         str= SvPV(sv, len);
199                         mode= SvUTF8(sv) ? 1 : 0;
200                     } else {
201                         str= HeKEY(he);
202                         len= HeKLEN(he);
203                         mode= HeKUTF8(he) ? 1 : 0;
204                     }
205                     key_sv= newSVpvn(str,len);
206                     av_push(key_av,key_sv);
207                     if (mode) {
208                         SvUTF8_on(key_sv);
209                     }
210                 }
211                 if (!key_av)
212                     empty_count++;
213             }
214             if (empty_count) {
215                 av_push(info_av, newSViv(empty_count));
216                 empty_count++;
217             }
218         }
219         XSRETURN(1);
220     }
221     XSRETURN(0);
222 }