Can now count the patches committed with --thanks-applied.
[perl.git] / doop.c
1 /*    doop.c
2  *
3  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4  *    2000, 2001, 2002, 2004, 2005, 2006, by Larry Wall and others
5  *
6  *    You may distribute under the terms of either the GNU General Public
7  *    License or the Artistic License, as specified in the README file.
8  *
9  */
10
11 /*
12  * "'So that was the job I felt I had to do when I started,' thought Sam."
13  */
14
15 /* This file contains some common functions needed to carry out certain
16  * ops. For example both pp_schomp() and pp_chomp() - scalar and array
17  * chomp operations - call the function do_chomp() found in this file.
18  */
19
20 #include "EXTERN.h"
21 #define PERL_IN_DOOP_C
22 #include "perl.h"
23
24 #ifndef PERL_MICRO
25 #include <signal.h>
26 #endif
27
28 STATIC I32
29 S_do_trans_simple(pTHX_ SV *sv)
30 {
31     dVAR;
32     U8 *s;
33     U8 *d;
34     const U8 *send;
35     U8 *dstart;
36     I32 matches = 0;
37     const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
38     STRLEN len;
39
40     const short * const tbl = (short*)cPVOP->op_pv;
41     if (!tbl)
42         Perl_croak(aTHX_ "panic: do_trans_simple line %d",__LINE__);
43
44     s = (U8*)SvPV(sv, len);
45     send = s + len;
46
47     /* First, take care of non-UTF-8 input strings, because they're easy */
48     if (!SvUTF8(sv)) {
49         while (s < send) {
50             const I32 ch = tbl[*s];
51             if (ch >= 0) {
52                 matches++;
53                 *s = (U8)ch;
54             }
55             s++;
56         }
57         SvSETMAGIC(sv);
58         return matches;
59     }
60
61     /* Allow for expansion: $_="a".chr(400); tr/a/\xFE/, FE needs encoding */
62     if (grows)
63         Newx(d, len*2+1, U8);
64     else
65         d = s;
66     dstart = d;
67     while (s < send) {
68         STRLEN ulen;
69         I32 ch;
70
71         /* Need to check this, otherwise 128..255 won't match */
72         const UV c = utf8n_to_uvchr(s, send - s, &ulen, 0);
73         if (c < 0x100 && (ch = tbl[c]) >= 0) {
74             matches++;
75             d = uvchr_to_utf8(d, ch);
76             s += ulen;
77         }
78         else { /* No match -> copy */
79             Move(s, d, ulen, U8);
80             d += ulen;
81             s += ulen;
82         }
83     }
84     if (grows) {
85         sv_setpvn(sv, (char*)dstart, d - dstart);
86         Safefree(dstart);
87     }
88     else {
89         *d = '\0';
90         SvCUR_set(sv, d - dstart);
91     }
92     SvUTF8_on(sv);
93     SvSETMAGIC(sv);
94     return matches;
95 }
96
97 STATIC I32
98 S_do_trans_count(pTHX_ SV *sv)
99 {
100     dVAR;
101     const U8 *s;
102     const U8 *send;
103     I32 matches = 0;
104     STRLEN len;
105
106     const short * const tbl = (short*)cPVOP->op_pv;
107     if (!tbl)
108         Perl_croak(aTHX_ "panic: do_trans_count line %d",__LINE__);
109
110     s = (const U8*)SvPV_const(sv, len);
111     send = s + len;
112
113     if (!SvUTF8(sv))
114         while (s < send) {
115             if (tbl[*s++] >= 0)
116                 matches++;
117         }
118     else {
119         const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
120         while (s < send) {
121             STRLEN ulen;
122             const UV c = utf8n_to_uvchr(s, send - s, &ulen, 0);
123             if (c < 0x100) {
124                 if (tbl[c] >= 0)
125                     matches++;
126             } else if (complement)
127                 matches++;
128             s += ulen;
129         }
130     }
131
132     return matches;
133 }
134
135 STATIC I32
136 S_do_trans_complex(pTHX_ SV *sv)
137 {
138     dVAR;
139     U8 *s;
140     U8 *send;
141     U8 *d;
142     U8 *dstart;
143     I32 isutf8;
144     I32 matches = 0;
145     STRLEN len, rlen = 0;
146
147     const short * const tbl = (short*)cPVOP->op_pv;
148     if (!tbl)
149         Perl_croak(aTHX_ "panic: do_trans_complex line %d",__LINE__);
150
151     s = (U8*)SvPV(sv, len);
152     isutf8 = SvUTF8(sv);
153     send = s + len;
154
155     if (!isutf8) {
156         dstart = d = s;
157         if (PL_op->op_private & OPpTRANS_SQUASH) {
158             const U8* p = send;
159             while (s < send) {
160                 const I32 ch = tbl[*s];
161                 if (ch >= 0) {
162                     *d = (U8)ch;
163                     matches++;
164                     if (p != d - 1 || *p != *d)
165                         p = d++;
166                 }
167                 else if (ch == -1)      /* -1 is unmapped character */
168                     *d++ = *s;  
169                 else if (ch == -2)      /* -2 is delete character */
170                     matches++;
171                 s++;
172             }
173         }
174         else {
175             while (s < send) {
176                 const I32 ch = tbl[*s];
177                 if (ch >= 0) {
178                     matches++;
179                     *d++ = (U8)ch;
180                 }
181                 else if (ch == -1)      /* -1 is unmapped character */
182                     *d++ = *s;
183                 else if (ch == -2)      /* -2 is delete character */
184                     matches++;
185                 s++;
186             }
187         }
188         *d = '\0';
189         SvCUR_set(sv, d - dstart);
190     }
191     else { /* isutf8 */
192         const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
193         const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
194         const I32 del = PL_op->op_private & OPpTRANS_DELETE;
195
196         if (grows)
197             Newx(d, len*2+1, U8);
198         else
199             d = s;
200         dstart = d;
201         if (complement && !del)
202             rlen = tbl[0x100];
203
204 #ifdef MACOS_TRADITIONAL
205 #define comp CoMP   /* "comp" is a keyword in some compilers ... */
206 #endif
207
208         if (PL_op->op_private & OPpTRANS_SQUASH) {
209             UV pch = 0xfeedface;
210             while (s < send) {
211                 STRLEN len;
212                 const UV comp = utf8_to_uvchr(s, &len);
213                 I32 ch;
214
215                 if (comp > 0xff) {
216                     if (!complement) {
217                         Copy(s, d, len, U8);
218                         d += len;
219                     }
220                     else {
221                         matches++;
222                         if (!del) {
223                             ch = (rlen == 0) ? comp :
224                                 (comp - 0x100 < rlen) ?
225                                 tbl[comp+1] : tbl[0x100+rlen];
226                             if ((UV)ch != pch) {
227                                 d = uvchr_to_utf8(d, ch);
228                                 pch = (UV)ch;
229                             }
230                             s += len;
231                             continue;
232                         }
233                     }
234                 }
235                 else if ((ch = tbl[comp]) >= 0) {
236                     matches++;
237                     if ((UV)ch != pch) {
238                         d = uvchr_to_utf8(d, ch);
239                         pch = (UV)ch;
240                     }
241                     s += len;
242                     continue;
243                 }
244                 else if (ch == -1) {    /* -1 is unmapped character */
245                     Copy(s, d, len, U8);
246                     d += len;
247                 }
248                 else if (ch == -2)      /* -2 is delete character */
249                     matches++;
250                 s += len;
251                 pch = 0xfeedface;
252             }
253         }
254         else {
255             while (s < send) {
256                 STRLEN len;
257                 const UV comp = utf8_to_uvchr(s, &len);
258                 I32 ch;
259                 if (comp > 0xff) {
260                     if (!complement) {
261                         Move(s, d, len, U8);
262                         d += len;
263                     }
264                     else {
265                         matches++;
266                         if (!del) {
267                             if (comp - 0x100 < rlen)
268                                 d = uvchr_to_utf8(d, tbl[comp+1]);
269                             else
270                                 d = uvchr_to_utf8(d, tbl[0x100+rlen]);
271                         }
272                     }
273                 }
274                 else if ((ch = tbl[comp]) >= 0) {
275                     d = uvchr_to_utf8(d, ch);
276                     matches++;
277                 }
278                 else if (ch == -1) {    /* -1 is unmapped character */
279                     Copy(s, d, len, U8);
280                     d += len;
281                 }
282                 else if (ch == -2)      /* -2 is delete character */
283                     matches++;
284                 s += len;
285             }
286         }
287         if (grows) {
288             sv_setpvn(sv, (char*)dstart, d - dstart);
289             Safefree(dstart);
290         }
291         else {
292             *d = '\0';
293             SvCUR_set(sv, d - dstart);
294         }
295         SvUTF8_on(sv);
296     }
297     SvSETMAGIC(sv);
298     return matches;
299 }
300
301 STATIC I32
302 S_do_trans_simple_utf8(pTHX_ SV *sv)
303 {
304     dVAR;
305     U8 *s;
306     U8 *send;
307     U8 *d;
308     U8 *start;
309     U8 *dstart, *dend;
310     I32 matches = 0;
311     const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
312     STRLEN len;
313
314     SV* const  rv = (SV*)cSVOP->op_sv;
315     HV* const  hv = (HV*)SvRV(rv);
316     SV* const * svp = hv_fetchs(hv, "NONE", FALSE);
317     const UV none = svp ? SvUV(*svp) : 0x7fffffff;
318     const UV extra = none + 1;
319     UV final = 0;
320     I32 isutf8;
321     U8 hibit = 0;
322
323     s = (U8*)SvPV(sv, len);
324     isutf8 = SvUTF8(sv);
325     if (!isutf8) {
326         const U8 *t = s;
327         const U8 * const e = s + len;
328         while (t < e) {
329             const U8 ch = *t++;
330             hibit = !NATIVE_IS_INVARIANT(ch);
331             if (hibit) {
332                 s = bytes_to_utf8(s, &len);
333                 break;
334             }
335         }
336     }
337     send = s + len;
338     start = s;
339
340     svp = hv_fetchs(hv, "FINAL", FALSE);
341     if (svp)
342         final = SvUV(*svp);
343
344     if (grows) {
345         /* d needs to be bigger than s, in case e.g. upgrading is required */
346         Newx(d, len * 3 + UTF8_MAXBYTES, U8);
347         dend = d + len * 3;
348         dstart = d;
349     }
350     else {
351         dstart = d = s;
352         dend = d + len;
353     }
354
355     while (s < send) {
356         const UV uv = swash_fetch(rv, s, TRUE);
357         if (uv < none) {
358             s += UTF8SKIP(s);
359             matches++;
360             d = uvuni_to_utf8(d, uv);
361         }
362         else if (uv == none) {
363             const int i = UTF8SKIP(s);
364             Move(s, d, i, U8);
365             d += i;
366             s += i;
367         }
368         else if (uv == extra) {
369             s += UTF8SKIP(s);
370             matches++;
371             d = uvuni_to_utf8(d, final);
372         }
373         else
374             s += UTF8SKIP(s);
375
376         if (d > dend) {
377             const STRLEN clen = d - dstart;
378             const STRLEN nlen = dend - dstart + len + UTF8_MAXBYTES;
379             if (!grows)
380                 Perl_croak(aTHX_ "panic: do_trans_simple_utf8 line %d",__LINE__);
381             Renew(dstart, nlen + UTF8_MAXBYTES, U8);
382             d = dstart + clen;
383             dend = dstart + nlen;
384         }
385     }
386     if (grows || hibit) {
387         sv_setpvn(sv, (char*)dstart, d - dstart);
388         Safefree(dstart);
389         if (grows && hibit)
390             Safefree(start);
391     }
392     else {
393         *d = '\0';
394         SvCUR_set(sv, d - dstart);
395     }
396     SvSETMAGIC(sv);
397     SvUTF8_on(sv);
398
399     return matches;
400 }
401
402 STATIC I32
403 S_do_trans_count_utf8(pTHX_ SV *sv)
404 {
405     dVAR;
406     const U8 *s;
407     const U8 *start = NULL;
408     const U8 *send;
409     I32 matches = 0;
410     STRLEN len;
411
412     SV* const rv = (SV*)cSVOP->op_sv;
413     HV* const hv = (HV*)SvRV(rv);
414     SV* const * const svp = hv_fetchs(hv, "NONE", FALSE);
415     const UV none = svp ? SvUV(*svp) : 0x7fffffff;
416     const UV extra = none + 1;
417     U8 hibit = 0;
418
419     s = (const U8*)SvPV_const(sv, len);
420     if (!SvUTF8(sv)) {
421         const U8 *t = s;
422         const U8 * const e = s + len;
423         while (t < e) {
424             const U8 ch = *t++;
425             hibit = !NATIVE_IS_INVARIANT(ch);
426             if (hibit) {
427                 start = s = bytes_to_utf8(s, &len);
428                 break;
429             }
430         }
431     }
432     send = s + len;
433
434     while (s < send) {
435         const UV uv = swash_fetch(rv, s, TRUE);
436         if (uv < none || uv == extra)
437             matches++;
438         s += UTF8SKIP(s);
439     }
440     if (hibit)
441         Safefree(start);
442
443     return matches;
444 }
445
446 STATIC I32
447 S_do_trans_complex_utf8(pTHX_ SV *sv)
448 {
449     dVAR;
450     U8 *start, *send;
451     U8 *d;
452     I32 matches = 0;
453     const I32 squash   = PL_op->op_private & OPpTRANS_SQUASH;
454     const I32 del      = PL_op->op_private & OPpTRANS_DELETE;
455     const I32 grows    = PL_op->op_private & OPpTRANS_GROWS;
456     SV * const rv = (SV*)cSVOP->op_sv;
457     HV * const hv = (HV*)SvRV(rv);
458     SV * const *svp = hv_fetchs(hv, "NONE", FALSE);
459     const UV none = svp ? SvUV(*svp) : 0x7fffffff;
460     const UV extra = none + 1;
461     UV final = 0;
462     bool havefinal = FALSE;
463     STRLEN len;
464     U8 *dstart, *dend;
465     U8 hibit = 0;
466
467     U8 *s = (U8*)SvPV(sv, len);
468     const I32 isutf8 = SvUTF8(sv);
469     if (!isutf8) {
470         const U8 *t = s;
471         const U8 * const e = s + len;
472         while (t < e) {
473             const U8 ch = *t++;
474             hibit = !NATIVE_IS_INVARIANT(ch);
475             if (hibit) {
476                 s = bytes_to_utf8(s, &len);
477                 break;
478             }
479         }
480     }
481     send = s + len;
482     start = s;
483
484     svp = hv_fetchs(hv, "FINAL", FALSE);
485     if (svp) {
486         final = SvUV(*svp);
487         havefinal = TRUE;
488     }
489
490     if (grows) {
491         /* d needs to be bigger than s, in case e.g. upgrading is required */
492         Newx(d, len * 3 + UTF8_MAXBYTES, U8);
493         dend = d + len * 3;
494         dstart = d;
495     }
496     else {
497         dstart = d = s;
498         dend = d + len;
499     }
500
501     if (squash) {
502         UV puv = 0xfeedface;
503         while (s < send) {
504             UV uv = swash_fetch(rv, s, TRUE);
505         
506             if (d > dend) {
507                 const STRLEN clen = d - dstart;
508                 const STRLEN nlen = dend - dstart + len + UTF8_MAXBYTES;
509                 if (!grows)
510                     Perl_croak(aTHX_ "panic: do_trans_complex_utf8 line %d",__LINE__);
511                 Renew(dstart, nlen + UTF8_MAXBYTES, U8);
512                 d = dstart + clen;
513                 dend = dstart + nlen;
514             }
515             if (uv < none) {
516                 matches++;
517                 s += UTF8SKIP(s);
518                 if (uv != puv) {
519                     d = uvuni_to_utf8(d, uv);
520                     puv = uv;
521                 }
522                 continue;
523             }
524             else if (uv == none) {      /* "none" is unmapped character */
525                 const int i = UTF8SKIP(s);
526                 Move(s, d, i, U8);
527                 d += i;
528                 s += i;
529                 puv = 0xfeedface;
530                 continue;
531             }
532             else if (uv == extra && !del) {
533                 matches++;
534                 if (havefinal) {
535                     s += UTF8SKIP(s);
536                     if (puv != final) {
537                         d = uvuni_to_utf8(d, final);
538                         puv = final;
539                     }
540                 }
541                 else {
542                     STRLEN len;
543                     uv = utf8_to_uvuni(s, &len);
544                     if (uv != puv) {
545                         Move(s, d, len, U8);
546                         d += len;
547                         puv = uv;
548                     }
549                     s += len;
550                 }
551                 continue;
552             }
553             matches++;                  /* "none+1" is delete character */
554             s += UTF8SKIP(s);
555         }
556     }
557     else {
558         while (s < send) {
559             const UV uv = swash_fetch(rv, s, TRUE);
560             if (d > dend) {
561                 const STRLEN clen = d - dstart;
562                 const STRLEN nlen = dend - dstart + len + UTF8_MAXBYTES;
563                 if (!grows)
564                     Perl_croak(aTHX_ "panic: do_trans_complex_utf8 line %d",__LINE__);
565                 Renew(dstart, nlen + UTF8_MAXBYTES, U8);
566                 d = dstart + clen;
567                 dend = dstart + nlen;
568             }
569             if (uv < none) {
570                 matches++;
571                 s += UTF8SKIP(s);
572                 d = uvuni_to_utf8(d, uv);
573                 continue;
574             }
575             else if (uv == none) {      /* "none" is unmapped character */
576                 const int i = UTF8SKIP(s);
577                 Move(s, d, i, U8);
578                 d += i;
579                 s += i;
580                 continue;
581             }
582             else if (uv == extra && !del) {
583                 matches++;
584                 s += UTF8SKIP(s);
585                 d = uvuni_to_utf8(d, final);
586                 continue;
587             }
588             matches++;                  /* "none+1" is delete character */
589             s += UTF8SKIP(s);
590         }
591     }
592     if (grows || hibit) {
593         sv_setpvn(sv, (char*)dstart, d - dstart);
594         Safefree(dstart);
595         if (grows && hibit)
596             Safefree(start);
597     }
598     else {
599         *d = '\0';
600         SvCUR_set(sv, d - dstart);
601     }
602     SvUTF8_on(sv);
603     SvSETMAGIC(sv);
604
605     return matches;
606 }
607
608 I32
609 Perl_do_trans(pTHX_ SV *sv)
610 {
611     dVAR;
612     STRLEN len;
613     const I32 hasutf = (PL_op->op_private &
614                     (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF));
615
616     if (SvREADONLY(sv)) {
617         if (SvIsCOW(sv))
618             sv_force_normal_flags(sv, 0);
619         if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL))
620             Perl_croak(aTHX_ PL_no_modify);
621     }
622     (void)SvPV_const(sv, len);
623     if (!len)
624         return 0;
625     if (!(PL_op->op_private & OPpTRANS_IDENTICAL)) {
626         if (!SvPOKp(sv))
627             (void)SvPV_force(sv, len);
628         (void)SvPOK_only_UTF8(sv);
629     }
630
631     DEBUG_t( Perl_deb(aTHX_ "2.TBL\n"));
632
633     switch (PL_op->op_private & ~hasutf & (
634                 OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL|
635                 OPpTRANS_SQUASH|OPpTRANS_DELETE|OPpTRANS_COMPLEMENT)) {
636     case 0:
637         if (hasutf)
638             return do_trans_simple_utf8(sv);
639         else
640             return do_trans_simple(sv);
641
642     case OPpTRANS_IDENTICAL:
643     case OPpTRANS_IDENTICAL|OPpTRANS_COMPLEMENT:
644         if (hasutf)
645             return do_trans_count_utf8(sv);
646         else
647             return do_trans_count(sv);
648
649     default:
650         if (hasutf)
651             return do_trans_complex_utf8(sv);
652         else
653             return do_trans_complex(sv);
654     }
655 }
656
657 void
658 Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **sp)
659 {
660     dVAR;
661     SV ** const oldmark = mark;
662     register I32 items = sp - mark;
663     register STRLEN len;
664     STRLEN delimlen;
665
666     (void) SvPV_const(del, delimlen); /* stringify and get the delimlen */
667     /* SvCUR assumes it's SvPOK() and woe betide you if it's not. */
668
669     mark++;
670     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
671     SvUPGRADE(sv, SVt_PV);
672     if (SvLEN(sv) < len + items) {      /* current length is way too short */
673         while (items-- > 0) {
674             if (*mark && !SvGAMAGIC(*mark) && SvOK(*mark)) {
675                 STRLEN tmplen;
676                 SvPV_const(*mark, tmplen);
677                 len += tmplen;
678             }
679             mark++;
680         }
681         SvGROW(sv, len + 1);            /* so try to pre-extend */
682
683         mark = oldmark;
684         items = sp - mark;
685         ++mark;
686     }
687
688     sv_setpvn(sv, "", 0);
689     /* sv_setpv retains old UTF8ness [perl #24846] */
690     SvUTF8_off(sv);
691
692     if (PL_tainting && SvMAGICAL(sv))
693         SvTAINTED_off(sv);
694
695     if (items-- > 0) {
696         if (*mark)
697             sv_catsv(sv, *mark);
698         mark++;
699     }
700
701     if (delimlen) {
702         for (; items > 0; items--,mark++) {
703             sv_catsv(sv,del);
704             sv_catsv(sv,*mark);
705         }
706     }
707     else {
708         for (; items > 0; items--,mark++)
709             sv_catsv(sv,*mark);
710     }
711     SvSETMAGIC(sv);
712 }
713
714 void
715 Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
716 {
717     dVAR;
718     STRLEN patlen;
719     const char * const pat = SvPV_const(*sarg, patlen);
720     bool do_taint = FALSE;
721
722     SvUTF8_off(sv);
723     if (DO_UTF8(*sarg))
724         SvUTF8_on(sv);
725     sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
726     SvSETMAGIC(sv);
727     if (do_taint)
728         SvTAINTED_on(sv);
729 }
730
731 /* currently converts input to bytes if possible, but doesn't sweat failure */
732 UV
733 Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
734 {
735     dVAR;
736     STRLEN srclen, len;
737     const unsigned char *s = (const unsigned char *) SvPV_const(sv, srclen);
738     UV retnum = 0;
739
740     if (offset < 0)
741         return retnum;
742     if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */
743         Perl_croak(aTHX_ "Illegal number of bits in vec");
744
745     if (SvUTF8(sv))
746         (void) Perl_sv_utf8_downgrade(aTHX_ sv, TRUE);
747
748     offset *= size;     /* turn into bit offset */
749     len = (offset + size + 7) / 8;      /* required number of bytes */
750     if (len > srclen) {
751         if (size <= 8)
752             retnum = 0;
753         else {
754             offset >>= 3;       /* turn into byte offset */
755             if (size == 16) {
756                 if ((STRLEN)offset >= srclen)
757                     retnum = 0;
758                 else
759                     retnum = (UV) s[offset] <<  8;
760             }
761             else if (size == 32) {
762                 if ((STRLEN)offset >= srclen)
763                     retnum = 0;
764                 else if ((STRLEN)(offset + 1) >= srclen)
765                     retnum =
766                         ((UV) s[offset    ] << 24);
767                 else if ((STRLEN)(offset + 2) >= srclen)
768                     retnum =
769                         ((UV) s[offset    ] << 24) +
770                         ((UV) s[offset + 1] << 16);
771                 else
772                     retnum =
773                         ((UV) s[offset    ] << 24) +
774                         ((UV) s[offset + 1] << 16) +
775                         (     s[offset + 2] <<  8);
776             }
777 #ifdef UV_IS_QUAD
778             else if (size == 64) {
779                 if (ckWARN(WARN_PORTABLE))
780                     Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
781                                 "Bit vector size > 32 non-portable");
782                 if (offset >= srclen)
783                     retnum = 0;
784                 else if (offset + 1 >= srclen)
785                     retnum =
786                         (UV) s[offset     ] << 56;
787                 else if (offset + 2 >= srclen)
788                     retnum =
789                         ((UV) s[offset    ] << 56) +
790                         ((UV) s[offset + 1] << 48);
791                 else if (offset + 3 >= srclen)
792                     retnum =
793                         ((UV) s[offset    ] << 56) +
794                         ((UV) s[offset + 1] << 48) +
795                         ((UV) s[offset + 2] << 40);
796                 else if (offset + 4 >= srclen)
797                     retnum =
798                         ((UV) s[offset    ] << 56) +
799                         ((UV) s[offset + 1] << 48) +
800                         ((UV) s[offset + 2] << 40) +
801                         ((UV) s[offset + 3] << 32);
802                 else if (offset + 5 >= srclen)
803                     retnum =
804                         ((UV) s[offset    ] << 56) +
805                         ((UV) s[offset + 1] << 48) +
806                         ((UV) s[offset + 2] << 40) +
807                         ((UV) s[offset + 3] << 32) +
808                         (     s[offset + 4] << 24);
809                 else if (offset + 6 >= srclen)
810                     retnum =
811                         ((UV) s[offset    ] << 56) +
812                         ((UV) s[offset + 1] << 48) +
813                         ((UV) s[offset + 2] << 40) +
814                         ((UV) s[offset + 3] << 32) +
815                         ((UV) s[offset + 4] << 24) +
816                         ((UV) s[offset + 5] << 16);
817                 else
818                     retnum =
819                         ((UV) s[offset    ] << 56) +
820                         ((UV) s[offset + 1] << 48) +
821                         ((UV) s[offset + 2] << 40) +
822                         ((UV) s[offset + 3] << 32) +
823                         ((UV) s[offset + 4] << 24) +
824                         ((UV) s[offset + 5] << 16) +
825                         (     s[offset + 6] <<  8);
826             }
827 #endif
828         }
829     }
830     else if (size < 8)
831         retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
832     else {
833         offset >>= 3;   /* turn into byte offset */
834         if (size == 8)
835             retnum = s[offset];
836         else if (size == 16)
837             retnum =
838                 ((UV) s[offset] <<      8) +
839                       s[offset + 1];
840         else if (size == 32)
841             retnum =
842                 ((UV) s[offset    ] << 24) +
843                 ((UV) s[offset + 1] << 16) +
844                 (     s[offset + 2] <<  8) +
845                       s[offset + 3];
846 #ifdef UV_IS_QUAD
847         else if (size == 64) {
848             if (ckWARN(WARN_PORTABLE))
849                 Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
850                             "Bit vector size > 32 non-portable");
851             retnum =
852                 ((UV) s[offset    ] << 56) +
853                 ((UV) s[offset + 1] << 48) +
854                 ((UV) s[offset + 2] << 40) +
855                 ((UV) s[offset + 3] << 32) +
856                 ((UV) s[offset + 4] << 24) +
857                 ((UV) s[offset + 5] << 16) +
858                 (     s[offset + 6] <<  8) +
859                       s[offset + 7];
860         }
861 #endif
862     }
863
864     return retnum;
865 }
866
867 /* currently converts input to bytes if possible but doesn't sweat failures,
868  * although it does ensure that the string it clobbers is not marked as
869  * utf8-valid any more
870  */
871 void
872 Perl_do_vecset(pTHX_ SV *sv)
873 {
874     dVAR;
875     register I32 offset;
876     register I32 size;
877     register unsigned char *s;
878     register UV lval;
879     I32 mask;
880     STRLEN targlen;
881     STRLEN len;
882     SV * const targ = LvTARG(sv);
883
884     if (!targ)
885         return;
886     s = (unsigned char*)SvPV_force(targ, targlen);
887     if (SvUTF8(targ)) {
888         /* This is handled by the SvPOK_only below...
889         if (!Perl_sv_utf8_downgrade(aTHX_ targ, TRUE))
890             SvUTF8_off(targ);
891          */
892         (void) Perl_sv_utf8_downgrade(aTHX_ targ, TRUE);
893     }
894
895     (void)SvPOK_only(targ);
896     lval = SvUV(sv);
897     offset = LvTARGOFF(sv);
898     if (offset < 0)
899         Perl_croak(aTHX_ "Negative offset to vec in lvalue context");
900     size = LvTARGLEN(sv);
901     if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */
902         Perl_croak(aTHX_ "Illegal number of bits in vec");
903
904     offset *= size;                     /* turn into bit offset */
905     len = (offset + size + 7) / 8;      /* required number of bytes */
906     if (len > targlen) {
907         s = (unsigned char*)SvGROW(targ, len + 1);
908         (void)memzero((char *)(s + targlen), len - targlen + 1);
909         SvCUR_set(targ, len);
910     }
911
912     if (size < 8) {
913         mask = (1 << size) - 1;
914         size = offset & 7;
915         lval &= mask;
916         offset >>= 3;                   /* turn into byte offset */
917         s[offset] &= ~(mask << size);
918         s[offset] |= lval << size;
919     }
920     else {
921         offset >>= 3;                   /* turn into byte offset */
922         if (size == 8)
923             s[offset  ] = (U8)( lval        & 0xff);
924         else if (size == 16) {
925             s[offset  ] = (U8)((lval >>  8) & 0xff);
926             s[offset+1] = (U8)( lval        & 0xff);
927         }
928         else if (size == 32) {
929             s[offset  ] = (U8)((lval >> 24) & 0xff);
930             s[offset+1] = (U8)((lval >> 16) & 0xff);
931             s[offset+2] = (U8)((lval >>  8) & 0xff);
932             s[offset+3] = (U8)( lval        & 0xff);
933         }
934 #ifdef UV_IS_QUAD
935         else if (size == 64) {
936             if (ckWARN(WARN_PORTABLE))
937                 Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
938                             "Bit vector size > 32 non-portable");
939             s[offset  ] = (U8)((lval >> 56) & 0xff);
940             s[offset+1] = (U8)((lval >> 48) & 0xff);
941             s[offset+2] = (U8)((lval >> 40) & 0xff);
942             s[offset+3] = (U8)((lval >> 32) & 0xff);
943             s[offset+4] = (U8)((lval >> 24) & 0xff);
944             s[offset+5] = (U8)((lval >> 16) & 0xff);
945             s[offset+6] = (U8)((lval >>  8) & 0xff);
946             s[offset+7] = (U8)( lval        & 0xff);
947         }
948 #endif
949     }
950     SvSETMAGIC(targ);
951 }
952
953 void
954 Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
955 {
956     dVAR;
957     STRLEN len;
958     char *s;
959
960     if (SvTYPE(sv) == SVt_PVAV) {
961         register I32 i;
962         AV* const av = (AV*)sv;
963         const I32 max = AvFILL(av);
964
965         for (i = 0; i <= max; i++) {
966             sv = (SV*)av_fetch(av, i, FALSE);
967             if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
968                 do_chop(astr, sv);
969         }
970         return;
971     }
972     else if (SvTYPE(sv) == SVt_PVHV) {
973         HV* const hv = (HV*)sv;
974         HE* entry;
975         (void)hv_iterinit(hv);
976         while ((entry = hv_iternext(hv)))
977             do_chop(astr,hv_iterval(hv,entry));
978         return;
979     }
980     else if (SvREADONLY(sv)) {
981         if (SvFAKE(sv)) {
982             /* SV is copy-on-write */
983             sv_force_normal_flags(sv, 0);
984         }
985         if (SvREADONLY(sv))
986             Perl_croak(aTHX_ PL_no_modify);
987     }
988
989     if (PL_encoding && !SvUTF8(sv)) {
990         /* like in do_chomp(), utf8-ize the sv as a side-effect
991          * if we're using encoding. */
992         sv_recode_to_utf8(sv, PL_encoding);
993     }
994
995     s = SvPV(sv, len);
996     if (len && !SvPOK(sv))
997         s = SvPV_force(sv, len);
998     if (DO_UTF8(sv)) {
999         if (s && len) {
1000             char * const send = s + len;
1001             char * const start = s;
1002             s = send - 1;
1003             while (s > start && UTF8_IS_CONTINUATION(*s))
1004                 s--;
1005             if (is_utf8_string((U8*)s, send - s)) {
1006                 sv_setpvn(astr, s, send - s);
1007                 *s = '\0';
1008                 SvCUR_set(sv, s - start);
1009                 SvNIOK_off(sv);
1010                 SvUTF8_on(astr);
1011             }
1012         }
1013         else
1014             sv_setpvn(astr, "", 0);
1015     }
1016     else if (s && len) {
1017         s += --len;
1018         sv_setpvn(astr, s, 1);
1019         *s = '\0';
1020         SvCUR_set(sv, len);
1021         SvUTF8_off(sv);
1022         SvNIOK_off(sv);
1023     }
1024     else
1025         sv_setpvn(astr, "", 0);
1026     SvSETMAGIC(sv);
1027 }
1028
1029 I32
1030 Perl_do_chomp(pTHX_ register SV *sv)
1031 {
1032     dVAR;
1033     register I32 count;
1034     STRLEN len;
1035     char *s;
1036     char *temp_buffer = NULL;
1037     SV* svrecode = Nullsv;
1038
1039     if (RsSNARF(PL_rs))
1040         return 0;
1041     if (RsRECORD(PL_rs))
1042       return 0;
1043     count = 0;
1044     if (SvTYPE(sv) == SVt_PVAV) {
1045         register I32 i;
1046         AV* const av = (AV*)sv;
1047         const I32 max = AvFILL(av);
1048
1049         for (i = 0; i <= max; i++) {
1050             sv = (SV*)av_fetch(av, i, FALSE);
1051             if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
1052                 count += do_chomp(sv);
1053         }
1054         return count;
1055     }
1056     else if (SvTYPE(sv) == SVt_PVHV) {
1057         HV* const hv = (HV*)sv;
1058         HE* entry;
1059         (void)hv_iterinit(hv);
1060         while ((entry = hv_iternext(hv)))
1061             count += do_chomp(hv_iterval(hv,entry));
1062         return count;
1063     }
1064     else if (SvREADONLY(sv)) {
1065         if (SvFAKE(sv)) {
1066             /* SV is copy-on-write */
1067             sv_force_normal_flags(sv, 0);
1068         }
1069         if (SvREADONLY(sv))
1070             Perl_croak(aTHX_ PL_no_modify);
1071     }
1072
1073     if (PL_encoding) {
1074         if (!SvUTF8(sv)) {
1075         /* XXX, here sv is utf8-ized as a side-effect!
1076            If encoding.pm is used properly, almost string-generating
1077            operations, including literal strings, chr(), input data, etc.
1078            should have been utf8-ized already, right?
1079         */
1080             sv_recode_to_utf8(sv, PL_encoding);
1081         }
1082     }
1083
1084     s = SvPV(sv, len);
1085     if (s && len) {
1086         s += --len;
1087         if (RsPARA(PL_rs)) {
1088             if (*s != '\n')
1089                 goto nope;
1090             ++count;
1091             while (len && s[-1] == '\n') {
1092                 --len;
1093                 --s;
1094                 ++count;
1095             }
1096         }
1097         else {
1098             STRLEN rslen, rs_charlen;
1099             const char *rsptr = SvPV_const(PL_rs, rslen);
1100
1101             rs_charlen = SvUTF8(PL_rs)
1102                 ? sv_len_utf8(PL_rs)
1103                 : rslen;
1104
1105             if (SvUTF8(PL_rs) != SvUTF8(sv)) {
1106                 /* Assumption is that rs is shorter than the scalar.  */
1107                 if (SvUTF8(PL_rs)) {
1108                     /* RS is utf8, scalar is 8 bit.  */
1109                     bool is_utf8 = TRUE;
1110                     temp_buffer = (char*)bytes_from_utf8((U8*)rsptr,
1111                                                          &rslen, &is_utf8);
1112                     if (is_utf8) {
1113                         /* Cannot downgrade, therefore cannot possibly match
1114                          */
1115                         assert (temp_buffer == rsptr);
1116                         temp_buffer = NULL;
1117                         goto nope;
1118                     }
1119                     rsptr = temp_buffer;
1120                 }
1121                 else if (PL_encoding) {
1122                     /* RS is 8 bit, encoding.pm is used.
1123                      * Do not recode PL_rs as a side-effect. */
1124                    svrecode = newSVpvn(rsptr, rslen);
1125                    sv_recode_to_utf8(svrecode, PL_encoding);
1126                    rsptr = SvPV_const(svrecode, rslen);
1127                    rs_charlen = sv_len_utf8(svrecode);
1128                 }
1129                 else {
1130                     /* RS is 8 bit, scalar is utf8.  */
1131                     temp_buffer = (char*)bytes_to_utf8((U8*)rsptr, &rslen);
1132                     rsptr = temp_buffer;
1133                 }
1134             }
1135             if (rslen == 1) {
1136                 if (*s != *rsptr)
1137                     goto nope;
1138                 ++count;
1139             }
1140             else {
1141                 if (len < rslen - 1)
1142                     goto nope;
1143                 len -= rslen - 1;
1144                 s -= rslen - 1;
1145                 if (memNE(s, rsptr, rslen))
1146                     goto nope;
1147                 count += rs_charlen;
1148             }
1149         }
1150         s = SvPV_force_nolen(sv);
1151         SvCUR_set(sv, len);
1152         *SvEND(sv) = '\0';
1153         SvNIOK_off(sv);
1154         SvSETMAGIC(sv);
1155     }
1156   nope:
1157
1158     if (svrecode)
1159          SvREFCNT_dec(svrecode);
1160
1161     Safefree(temp_buffer);
1162     return count;
1163 }
1164
1165 void
1166 Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
1167 {
1168     dVAR;
1169 #ifdef LIBERAL
1170     register long *dl;
1171     register long *ll;
1172     register long *rl;
1173 #endif
1174     register char *dc;
1175     STRLEN leftlen;
1176     STRLEN rightlen;
1177     register const char *lc;
1178     register const char *rc;
1179     register I32 len;
1180     I32 lensave;
1181     const char *lsave;
1182     const char *rsave;
1183     const bool left_utf = DO_UTF8(left);
1184     const bool right_utf = DO_UTF8(right);
1185     I32 needlen = 0;
1186
1187     if (left_utf && !right_utf)
1188         sv_utf8_upgrade(right);
1189     else if (!left_utf && right_utf)
1190         sv_utf8_upgrade(left);
1191
1192     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
1193         sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
1194     lsave = lc = SvPV_nomg_const(left, leftlen);
1195     rsave = rc = SvPV_nomg_const(right, rightlen);
1196     len = leftlen < rightlen ? leftlen : rightlen;
1197     lensave = len;
1198     if ((left_utf || right_utf) && (sv == left || sv == right)) {
1199         needlen = optype == OP_BIT_AND ? len : leftlen + rightlen;
1200         Newxz(dc, needlen + 1, char);
1201     }
1202     else if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
1203         dc = SvPV_force_nomg_nolen(sv);
1204         if (SvLEN(sv) < (STRLEN)(len + 1)) {
1205             dc = SvGROW(sv, (STRLEN)(len + 1));
1206             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
1207         }
1208         if (optype != OP_BIT_AND && (left_utf || right_utf))
1209             dc = SvGROW(sv, leftlen + rightlen + 1);
1210     }
1211     else {
1212         needlen = ((optype == OP_BIT_AND)
1213                     ? len : (leftlen > rightlen ? leftlen : rightlen));
1214         Newxz(dc, needlen + 1, char);
1215         (void)sv_usepvn(sv, dc, needlen);
1216         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
1217     }
1218     SvCUR_set(sv, len);
1219     (void)SvPOK_only(sv);
1220     if (left_utf || right_utf) {
1221         UV duc, luc, ruc;
1222         char * const dcsave = dc;
1223         STRLEN lulen = leftlen;
1224         STRLEN rulen = rightlen;
1225         STRLEN ulen;
1226
1227         switch (optype) {
1228         case OP_BIT_AND:
1229             while (lulen && rulen) {
1230                 luc = utf8n_to_uvchr((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
1231                 lc += ulen;
1232                 lulen -= ulen;
1233                 ruc = utf8n_to_uvchr((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
1234                 rc += ulen;
1235                 rulen -= ulen;
1236                 duc = luc & ruc;
1237                 dc = (char*)uvchr_to_utf8((U8*)dc, duc);
1238             }
1239             if (sv == left || sv == right)
1240                 (void)sv_usepvn(sv, dcsave, needlen);
1241             SvCUR_set(sv, dc - dcsave);
1242             break;
1243         case OP_BIT_XOR:
1244             while (lulen && rulen) {
1245                 luc = utf8n_to_uvchr((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
1246                 lc += ulen;
1247                 lulen -= ulen;
1248                 ruc = utf8n_to_uvchr((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
1249                 rc += ulen;
1250                 rulen -= ulen;
1251                 duc = luc ^ ruc;
1252                 dc = (char*)uvchr_to_utf8((U8*)dc, duc);
1253             }
1254             goto mop_up_utf;
1255         case OP_BIT_OR:
1256             while (lulen && rulen) {
1257                 luc = utf8n_to_uvchr((U8*)lc, lulen, &ulen, UTF8_ALLOW_ANYUV);
1258                 lc += ulen;
1259                 lulen -= ulen;
1260                 ruc = utf8n_to_uvchr((U8*)rc, rulen, &ulen, UTF8_ALLOW_ANYUV);
1261                 rc += ulen;
1262                 rulen -= ulen;
1263                 duc = luc | ruc;
1264                 dc = (char*)uvchr_to_utf8((U8*)dc, duc);
1265             }
1266           mop_up_utf:
1267             if (sv == left || sv == right)
1268                 (void)sv_usepvn(sv, dcsave, needlen);
1269             SvCUR_set(sv, dc - dcsave);
1270             if (rulen)
1271                 sv_catpvn(sv, rc, rulen);
1272             else if (lulen)
1273                 sv_catpvn(sv, lc, lulen);
1274             else
1275                 *SvEND(sv) = '\0';
1276             break;
1277         }
1278         SvUTF8_on(sv);
1279         goto finish;
1280     }
1281     else
1282 #ifdef LIBERAL
1283     if (len >= sizeof(long)*4 &&
1284         !((long)dc % sizeof(long)) &&
1285         !((long)lc % sizeof(long)) &&
1286         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
1287     {
1288         const I32 remainder = len % (sizeof(long)*4);
1289         len /= (sizeof(long)*4);
1290
1291         dl = (long*)dc;
1292         ll = (long*)lc;
1293         rl = (long*)rc;
1294
1295         switch (optype) {
1296         case OP_BIT_AND:
1297             while (len--) {
1298                 *dl++ = *ll++ & *rl++;
1299                 *dl++ = *ll++ & *rl++;
1300                 *dl++ = *ll++ & *rl++;
1301                 *dl++ = *ll++ & *rl++;
1302             }
1303             break;
1304         case OP_BIT_XOR:
1305             while (len--) {
1306                 *dl++ = *ll++ ^ *rl++;
1307                 *dl++ = *ll++ ^ *rl++;
1308                 *dl++ = *ll++ ^ *rl++;
1309                 *dl++ = *ll++ ^ *rl++;
1310             }
1311             break;
1312         case OP_BIT_OR:
1313             while (len--) {
1314                 *dl++ = *ll++ | *rl++;
1315                 *dl++ = *ll++ | *rl++;
1316                 *dl++ = *ll++ | *rl++;
1317                 *dl++ = *ll++ | *rl++;
1318             }
1319         }
1320
1321         dc = (char*)dl;
1322         lc = (char*)ll;
1323         rc = (char*)rl;
1324
1325         len = remainder;
1326     }
1327 #endif
1328     {
1329         switch (optype) {
1330         case OP_BIT_AND:
1331             while (len--)
1332                 *dc++ = *lc++ & *rc++;
1333             *dc = '\0';
1334             break;
1335         case OP_BIT_XOR:
1336             while (len--)
1337                 *dc++ = *lc++ ^ *rc++;
1338             goto mop_up;
1339         case OP_BIT_OR:
1340             while (len--)
1341                 *dc++ = *lc++ | *rc++;
1342           mop_up:
1343             len = lensave;
1344             if (rightlen > (STRLEN)len)
1345                 sv_catpvn(sv, rsave + len, rightlen - len);
1346             else if (leftlen > (STRLEN)len)
1347                 sv_catpvn(sv, lsave + len, leftlen - len);
1348             else
1349                 *SvEND(sv) = '\0';
1350             break;
1351         }
1352     }
1353 finish:
1354     SvTAINT(sv);
1355 }
1356
1357 OP *
1358 Perl_do_kv(pTHX)
1359 {
1360     dVAR;
1361     dSP;
1362     HV * const hv = (HV*)POPs;
1363     HV *keys;
1364     register HE *entry;
1365     const I32 gimme = GIMME_V;
1366     const I32 dokv =     (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV);
1367     const I32 dokeys =   dokv || (PL_op->op_type == OP_KEYS);
1368     const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES);
1369
1370     if (!hv) {
1371         if (PL_op->op_flags & OPf_MOD || LVRET) {       /* lvalue */
1372             dTARGET;            /* make sure to clear its target here */
1373             if (SvTYPE(TARG) == SVt_PVLV)
1374                 LvTARG(TARG) = Nullsv;
1375             PUSHs(TARG);
1376         }
1377         RETURN;
1378     }
1379
1380     keys = hv;
1381     (void)hv_iterinit(keys);    /* always reset iterator regardless */
1382
1383     if (gimme == G_VOID)
1384         RETURN;
1385
1386     if (gimme == G_SCALAR) {
1387         IV i;
1388         dTARGET;
1389
1390         if (PL_op->op_flags & OPf_MOD || LVRET) {       /* lvalue */
1391             if (SvTYPE(TARG) < SVt_PVLV) {
1392                 sv_upgrade(TARG, SVt_PVLV);
1393                 sv_magic(TARG, Nullsv, PERL_MAGIC_nkeys, Nullch, 0);
1394             }
1395             LvTYPE(TARG) = 'k';
1396             if (LvTARG(TARG) != (SV*)keys) {
1397                 if (LvTARG(TARG))
1398                     SvREFCNT_dec(LvTARG(TARG));
1399                 LvTARG(TARG) = SvREFCNT_inc(keys);
1400             }
1401             PUSHs(TARG);
1402             RETURN;
1403         }
1404
1405         if (! SvTIED_mg((SV*)keys, PERL_MAGIC_tied))
1406             i = HvKEYS(keys);
1407         else {
1408             i = 0;
1409             while (hv_iternext(keys)) i++;
1410         }
1411         PUSHi( i );
1412         RETURN;
1413     }
1414
1415     EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
1416
1417     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
1418     while ((entry = hv_iternext(keys))) {
1419         SPAGAIN;
1420         if (dokeys) {
1421             SV* const sv = hv_iterkeysv(entry);
1422             XPUSHs(sv); /* won't clobber stack_sp */
1423         }
1424         if (dovalues) {
1425             SV *tmpstr;
1426             PUTBACK;
1427             tmpstr = hv_iterval(hv,entry);
1428             DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu",
1429                             (unsigned long)HeHASH(entry),
1430                             (int)HvMAX(keys)+1,
1431                             (unsigned long)(HeHASH(entry) & HvMAX(keys))));
1432             SPAGAIN;
1433             XPUSHs(tmpstr);
1434         }
1435         PUTBACK;
1436     }
1437     return NORMAL;
1438 }
1439
1440 /*
1441  * Local variables:
1442  * c-indentation-style: bsd
1443  * c-basic-offset: 4
1444  * indent-tabs-mode: t
1445  * End:
1446  *
1447  * ex: set ts=8 sts=4 sw=4 noet:
1448  */