s/\bthe the\b/the/g *.pod
[p5sagit/p5-mst-13.2.git] / doop.c
1 /*    doop.c
2  *
3  *    Copyright (c) 1991-1997, Larry Wall
4  *
5  *    You may distribute under the terms of either the GNU General Public
6  *    License or the Artistic License, as specified in the README file.
7  *
8  */
9
10 /*
11  * "'So that was the job I felt I had to do when I started,' thought Sam."
12  */
13
14 #include "EXTERN.h"
15 #include "perl.h"
16
17 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
18 #include <signal.h>
19 #endif
20
21 #ifndef PERL_OBJECT
22 static I32 do_trans_CC_simple _((SV *sv));
23 static I32 do_trans_CC_count _((SV *sv));
24 static I32 do_trans_CC_complex _((SV *sv));
25 static I32 do_trans_UU_simple _((SV *sv));
26 static I32 do_trans_UU_count _((SV *sv));
27 static I32 do_trans_UU_complex _((SV *sv));
28 static I32 do_trans_UC_simple _((SV *sv));
29 static I32 do_trans_CU_simple _((SV *sv));
30 static I32 do_trans_UC_trivial _((SV *sv));
31 static I32 do_trans_CU_trivial _((SV *sv));
32 #endif
33
34 STATIC I32
35 do_trans_CC_simple(SV *sv)
36 {
37     dTHR;
38     U8 *s;
39     U8 *send;
40     I32 matches = 0;
41     STRLEN len;
42     short *tbl;
43     I32 ch;
44
45     tbl = (short*)cPVOP->op_pv;
46     if (!tbl)
47         croak("panic: do_trans");
48
49     s = (U8*)SvPV(sv, len);
50     send = s + len;
51
52     while (s < send) {
53         if ((ch = tbl[*s]) >= 0) {
54             matches++;
55             *s = ch;
56         }
57         s++;
58     }
59     SvSETMAGIC(sv);
60
61     return matches;
62 }
63
64 STATIC I32
65 do_trans_CC_count(SV *sv)
66 {
67     dTHR;
68     U8 *s;
69     U8 *send;
70     I32 matches = 0;
71     STRLEN len;
72     short *tbl;
73
74     tbl = (short*)cPVOP->op_pv;
75     if (!tbl)
76         croak("panic: do_trans");
77
78     s = (U8*)SvPV(sv, len);
79     send = s + len;
80
81     while (s < send) {
82         if (tbl[*s] >= 0)
83             matches++;
84         s++;
85     }
86
87     return matches;
88 }
89
90 STATIC I32
91 do_trans_CC_complex(SV *sv)
92 {
93     dTHR;
94     U8 *s;
95     U8 *send;
96     U8 *d;
97     I32 matches = 0;
98     STRLEN len;
99     short *tbl;
100     I32 ch;
101
102     tbl = (short*)cPVOP->op_pv;
103     if (!tbl)
104         croak("panic: do_trans");
105
106     s = (U8*)SvPV(sv, len);
107     send = s + len;
108
109     d = s;
110     if (PL_op->op_private & OPpTRANS_SQUASH) {
111         U8* p = send;
112
113         while (s < send) {
114             if ((ch = tbl[*s]) >= 0) {
115                 *d = ch;
116                 matches++;
117                 if (p == d - 1 && *p == *d)
118                     matches--;
119                 else
120                     p = d++;
121             }
122             else if (ch == -1)          /* -1 is unmapped character */
123                 *d++ = *s;              /* -2 is delete character */
124             s++;
125         }
126     }
127     else {
128         while (s < send) {
129             if ((ch = tbl[*s]) >= 0) {
130                 *d = ch;
131                 matches++;
132                 d++;
133             }
134             else if (ch == -1)          /* -1 is unmapped character */
135                 *d++ = *s;              /* -2 is delete character */
136             s++;
137         }
138     }
139     matches += send - d;        /* account for disappeared chars */
140     *d = '\0';
141     SvCUR_set(sv, d - (U8*)SvPVX(sv));
142     SvSETMAGIC(sv);
143
144     return matches;
145 }
146
147 STATIC I32
148 do_trans_UU_simple(SV *sv)
149 {
150     dTHR;
151     U8 *s;
152     U8 *send;
153     U8 *d;
154     I32 matches = 0;
155     STRLEN len;
156
157     SV* rv = (SV*)cSVOP->op_sv;
158     HV* hv = (HV*)SvRV(rv);
159     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
160     UV none = svp ? SvUV(*svp) : 0x7fffffff;
161     UV extra = none + 1;
162     UV final;
163     UV uv;
164
165     s = (U8*)SvPV(sv, len);
166     send = s + len;
167
168     svp = hv_fetch(hv, "FINAL", 5, FALSE);
169     if (svp)
170         final = SvUV(*svp);
171
172     d = s;
173     while (s < send) {
174         if ((uv = swash_fetch(rv, s)) < none) {
175             s += UTF8SKIP(s);
176             matches++;
177             d = uv_to_utf8(d, uv);
178         }
179         else if (uv == none) {
180             int i;
181             for (i = UTF8SKIP(s); i; i--)
182                 *d++ = *s++;
183         }
184         else if (uv == extra) {
185             s += UTF8SKIP(s);
186             matches++;
187             d = uv_to_utf8(d, final);
188         }
189         else
190             s += UTF8SKIP(s);
191     }
192     *d = '\0';
193     SvCUR_set(sv, d - (U8*)SvPVX(sv));
194     SvSETMAGIC(sv);
195
196     return matches;
197 }
198
199 STATIC I32
200 do_trans_UU_count(SV *sv)
201 {
202     dTHR;
203     U8 *s;
204     U8 *send;
205     I32 matches = 0;
206     STRLEN len;
207
208     SV* rv = (SV*)cSVOP->op_sv;
209     HV* hv = (HV*)SvRV(rv);
210     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
211     UV none = svp ? SvUV(*svp) : 0x7fffffff;
212     UV uv;
213
214     s = (U8*)SvPV(sv, len);
215     send = s + len;
216
217     while (s < send) {
218         if ((uv = swash_fetch(rv, s)) < none)
219             matches++;
220         s += UTF8SKIP(s);
221     }
222
223     return matches;
224 }
225
226 STATIC I32
227 do_trans_UC_simple(SV *sv)
228 {
229     dTHR;
230     U8 *s;
231     U8 *send;
232     U8 *d;
233     I32 matches = 0;
234     STRLEN len;
235
236     SV* rv = (SV*)cSVOP->op_sv;
237     HV* hv = (HV*)SvRV(rv);
238     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
239     UV none = svp ? SvUV(*svp) : 0x7fffffff;
240     UV extra = none + 1;
241     UV final;
242     UV uv;
243
244     s = (U8*)SvPV(sv, len);
245     send = s + len;
246
247     svp = hv_fetch(hv, "FINAL", 5, FALSE);
248     if (svp)
249         final = SvUV(*svp);
250
251     d = s;
252     while (s < send) {
253         if ((uv = swash_fetch(rv, s)) < none) {
254             s += UTF8SKIP(s);
255             matches++;
256             *d++ = (U8)uv;
257         }
258         else if (uv == none) {
259             I32 ulen;
260             uv = utf8_to_uv(s, &ulen);
261             s += ulen;
262             *d++ = (U8)uv;
263         }
264         else if (uv == extra) {
265             s += UTF8SKIP(s);
266             matches++;
267             *d++ = (U8)final;
268         }
269         else
270             s += UTF8SKIP(s);
271     }
272     *d = '\0';
273     SvCUR_set(sv, d - (U8*)SvPVX(sv));
274     SvSETMAGIC(sv);
275
276     return matches;
277 }
278
279 STATIC I32
280 do_trans_CU_simple(SV *sv)
281 {
282     dTHR;
283     U8 *s;
284     U8 *send;
285     U8 *d;
286     U8 *dst;
287     I32 matches = 0;
288     STRLEN len;
289
290     SV* rv = (SV*)cSVOP->op_sv;
291     HV* hv = (HV*)SvRV(rv);
292     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
293     UV none = svp ? SvUV(*svp) : 0x7fffffff;
294     UV extra = none + 1;
295     UV final;
296     UV uv;
297     U8 tmpbuf[10];
298     I32 bits = 16;
299
300     s = (U8*)SvPV(sv, len);
301     send = s + len;
302
303     svp = hv_fetch(hv, "BITS", 4, FALSE);
304     if (svp)
305         bits = (I32)SvIV(*svp);
306
307     svp = hv_fetch(hv, "FINAL", 5, FALSE);
308     if (svp)
309         final = SvUV(*svp);
310
311     Newz(801, d, len * (bits >> 3) + 1, U8);
312     dst = d;
313
314     while (s < send) {
315         uv = *s++;
316         if (uv < 0x80)
317             tmpbuf[0] = uv;
318         else {
319             tmpbuf[0] = (( uv >>  6)         | 0xc0);
320             tmpbuf[1] = (( uv        & 0x3f) | 0x80);
321         }
322
323         if ((uv = swash_fetch(rv, tmpbuf)) < none) {
324             matches++;
325             d = uv_to_utf8(d, uv);
326         }
327         else if (uv == none)
328             d = uv_to_utf8(d, s[-1]);
329         else if (uv == extra) {
330             matches++;
331             d = uv_to_utf8(d, final);
332         }
333     }
334     *d = '\0';
335     sv_usepvn_mg(sv, (char*)dst, d - dst);
336
337     return matches;
338 }
339
340 /* utf-8 to latin-1 */
341
342 STATIC I32
343 do_trans_UC_trivial(SV *sv)
344 {
345     dTHR;
346     U8 *s;
347     U8 *send;
348     U8 *d;
349     STRLEN len;
350
351     s = (U8*)SvPV(sv, len);
352     send = s + len;
353
354     d = s;
355     while (s < send) {
356         if (*s < 0x80)
357             *d++ = *s++;
358         else {
359             I32 ulen;
360             UV uv = utf8_to_uv(s, &ulen);
361             s += ulen;
362             *d++ = (U8)uv;
363         }
364     }
365     *d = '\0';
366     SvCUR_set(sv, d - (U8*)SvPVX(sv));
367     SvSETMAGIC(sv);
368
369     return SvCUR(sv);
370 }
371
372 /* latin-1 to utf-8 */
373
374 STATIC I32
375 do_trans_CU_trivial(SV *sv)
376 {
377     dTHR;
378     U8 *s;
379     U8 *send;
380     U8 *d;
381     U8 *dst;
382     I32 matches;
383     STRLEN len;
384
385     s = (U8*)SvPV(sv, len);
386     send = s + len;
387
388     Newz(801, d, len * 2 + 1, U8);
389     dst = d;
390
391     matches = send - s;
392
393     while (s < send) {
394         if (*s < 0x80)
395             *d++ = *s++;
396         else {
397             UV uv = *s++;
398             *d++ = (( uv >>  6)         | 0xc0);
399             *d++ = (( uv        & 0x3f) | 0x80);
400         }
401     }
402     *d = '\0';
403     sv_usepvn_mg(sv, (char*)dst, d - dst);
404
405     return matches;
406 }
407
408 STATIC I32
409 do_trans_UU_complex(SV *sv)
410 {
411     dTHR;
412     U8 *s;
413     U8 *send;
414     U8 *d;
415     I32 matches = 0;
416     I32 squash   = PL_op->op_private & OPpTRANS_SQUASH;
417     I32 from_utf = PL_op->op_private & OPpTRANS_FROM_UTF;
418     I32 to_utf   = PL_op->op_private & OPpTRANS_TO_UTF;
419     I32 del      = PL_op->op_private & OPpTRANS_DELETE;
420     SV* rv = (SV*)cSVOP->op_sv;
421     HV* hv = (HV*)SvRV(rv);
422     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
423     UV none = svp ? SvUV(*svp) : 0x7fffffff;
424     UV extra = none + 1;
425     UV final;
426     UV uv;
427     STRLEN len;
428     U8 *dst;
429
430     s = (U8*)SvPV(sv, len);
431     send = s + len;
432
433     svp = hv_fetch(hv, "FINAL", 5, FALSE);
434     if (svp)
435         final = SvUV(*svp);
436
437     if (PL_op->op_private & OPpTRANS_GROWS) {
438         I32 bits = 16;
439
440         svp = hv_fetch(hv, "BITS", 4, FALSE);
441         if (svp)
442             bits = (I32)SvIV(*svp);
443
444         Newz(801, d, len * (bits >> 3) + 1, U8);
445         dst = d;
446     }
447     else {
448         d = s;
449         dst = 0;
450     }
451
452     if (squash) {
453         UV puv = 0xfeedface;
454         while (s < send) {
455             if (from_utf) {
456                 uv = swash_fetch(rv, s);
457             }
458             else {
459                 U8 tmpbuf[2];
460                 uv = *s++;
461                 if (uv < 0x80)
462                     tmpbuf[0] = uv;
463                 else {
464                     tmpbuf[0] = (( uv >>  6)         | 0xc0);
465                     tmpbuf[1] = (( uv        & 0x3f) | 0x80);
466                 }
467                 uv = swash_fetch(rv, tmpbuf);
468             }
469             if (uv < none) {
470                 matches++;
471                 if (uv != puv) {
472                     if (uv >= 0x80 && to_utf)
473                         d = uv_to_utf8(d, uv);
474                     else
475                         *d++ = (U8)uv;
476                     puv = uv;
477                 }
478                 if (from_utf)
479                     s += UTF8SKIP(s);
480                 continue;
481             }
482             else if (uv == none) {      /* "none" is unmapped character */
483                 if (from_utf) {
484                     if (*s < 0x80)
485                         *d++ = *s++;
486                     else if (to_utf) {
487                         int i;
488                         for (i = UTF8SKIP(s); i; --i)
489                             *d++ = *s++;
490                     }
491                     else {
492                         I32 ulen;
493                         *d++ = (U8)utf8_to_uv(s, &ulen);
494                         s += ulen;
495                     }
496                 }
497                 else {  /* must be to_utf only */
498                     d = uv_to_utf8(d, s[-1]);
499                 }
500                 puv = 0xfeedface;
501                 continue;
502             }
503             else if (uv == extra && !del) {
504                 matches++;
505                 if (uv != puv) {
506                     if (final >= 0x80 && to_utf)
507                         d = uv_to_utf8(d, final);
508                     else
509                         *d++ = (U8)final;
510                     puv = final;
511                 }
512                 if (from_utf)
513                     s += UTF8SKIP(s);
514                 continue;
515             }
516             matches++;          /* "none+1" is delete character */
517             if (from_utf)
518                 s += UTF8SKIP(s);
519         }
520     }
521     else {
522         while (s < send) {
523             if (from_utf) {
524                 uv = swash_fetch(rv, s);
525             }
526             else {
527                 U8 tmpbuf[2];
528                 uv = *s++;
529                 if (uv < 0x80)
530                     tmpbuf[0] = uv;
531                 else {
532                     tmpbuf[0] = (( uv >>  6)         | 0xc0);
533                     tmpbuf[1] = (( uv        & 0x3f) | 0x80);
534                 }
535                 uv = swash_fetch(rv, tmpbuf);
536             }
537             if (uv < none) {
538                 matches++;
539                 if (uv >= 0x80 && to_utf)
540                     d = uv_to_utf8(d, uv);
541                 else
542                     *d++ = (U8)uv;
543                 if (from_utf)
544                     s += UTF8SKIP(s);
545                 continue;
546             }
547             else if (uv == none) {      /* "none" is unmapped character */
548                 if (from_utf) {
549                     if (*s < 0x80)
550                         *d++ = *s++;
551                     else if (to_utf) {
552                         int i;
553                         for (i = UTF8SKIP(s); i; --i)
554                             *d++ = *s++;
555                     }
556                     else {
557                         I32 ulen;
558                         *d++ = (U8)utf8_to_uv(s, &ulen);
559                         s += ulen;
560                     }
561                 }
562                 else {  /* must be to_utf only */
563                     d = uv_to_utf8(d, s[-1]);
564                 }
565                 continue;
566             }
567             else if (uv == extra && !del) {
568                 matches++;
569                 if (final >= 0x80 && to_utf)
570                     d = uv_to_utf8(d, final);
571                 else
572                     *d++ = (U8)final;
573                 if (from_utf)
574                     s += UTF8SKIP(s);
575                 continue;
576             }
577             matches++;          /* "none+1" is delete character */
578             if (from_utf)
579                 s += UTF8SKIP(s);
580         }
581     }
582     if (dst)
583         sv_usepvn(sv, (char*)dst, d - dst);
584     else {
585         *d = '\0';
586         SvCUR_set(sv, d - (U8*)SvPVX(sv));
587     }
588     SvSETMAGIC(sv);
589
590     return matches;
591 }
592
593 I32
594 do_trans(SV *sv)
595 {
596     dTHR;
597     STRLEN len;
598
599     if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL))
600         croak(PL_no_modify);
601
602     (void)SvPV(sv, len);
603     if (!len)
604         return 0;
605     if (!SvPOKp(sv))
606         (void)SvPV_force(sv, len);
607     (void)SvPOK_only(sv);
608
609     DEBUG_t( deb("2.TBL\n"));
610
611     switch (PL_op->op_private & 63) {
612     case 0:
613         return do_trans_CC_simple(sv);
614
615     case OPpTRANS_FROM_UTF:
616         return do_trans_UC_simple(sv);
617
618     case OPpTRANS_TO_UTF:
619         return do_trans_CU_simple(sv);
620
621     case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF:
622         return do_trans_UU_simple(sv);
623
624     case OPpTRANS_IDENTICAL:
625         return do_trans_CC_count(sv);
626
627     case OPpTRANS_FROM_UTF|OPpTRANS_IDENTICAL:
628         return do_trans_UC_trivial(sv);
629
630     case OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL:
631         return do_trans_CU_trivial(sv);
632
633     case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL:
634         return do_trans_UU_count(sv);
635
636     default:
637         if (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
638             return do_trans_UU_complex(sv); /* could be UC or CU too */
639         else
640             return do_trans_CC_complex(sv);
641     }
642 }
643
644 void
645 do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
646 {
647     SV **oldmark = mark;
648     register I32 items = sp - mark;
649     register STRLEN len;
650     STRLEN delimlen;
651     register char *delim = SvPV(del, delimlen);
652     STRLEN tmplen;
653
654     mark++;
655     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
656     (void)SvUPGRADE(sv, SVt_PV);
657     if (SvLEN(sv) < len + items) {      /* current length is way too short */
658         while (items-- > 0) {
659             if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) {
660                 SvPV(*mark, tmplen);
661                 len += tmplen;
662             }
663             mark++;
664         }
665         SvGROW(sv, len + 1);            /* so try to pre-extend */
666
667         mark = oldmark;
668         items = sp - mark;;
669         ++mark;
670     }
671
672     if (items-- > 0) {
673         char *s;
674
675         if (*mark) {
676             s = SvPV(*mark, tmplen);
677             sv_setpvn(sv, s, tmplen);
678         }
679         else
680             sv_setpv(sv, "");
681         mark++;
682     }
683     else
684         sv_setpv(sv,"");
685     len = delimlen;
686     if (len) {
687         for (; items > 0; items--,mark++) {
688             sv_catpvn(sv,delim,len);
689             sv_catsv(sv,*mark);
690         }
691     }
692     else {
693         for (; items > 0; items--,mark++)
694             sv_catsv(sv,*mark);
695     }
696     SvSETMAGIC(sv);
697 }
698
699 void
700 do_sprintf(SV *sv, I32 len, SV **sarg)
701 {
702     STRLEN patlen;
703     char *pat = SvPV(*sarg, patlen);
704     bool do_taint = FALSE;
705
706     sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
707     SvSETMAGIC(sv);
708     if (do_taint)
709         SvTAINTED_on(sv);
710 }
711
712 void
713 do_vecset(SV *sv)
714 {
715     SV *targ = LvTARG(sv);
716     register I32 offset;
717     register I32 size;
718     register unsigned char *s;
719     register unsigned long lval;
720     I32 mask;
721     STRLEN targlen;
722     STRLEN len;
723
724     if (!targ)
725         return;
726     s = (unsigned char*)SvPV_force(targ, targlen);
727     lval = U_L(SvNV(sv));
728     offset = LvTARGOFF(sv);
729     size = LvTARGLEN(sv);
730     
731     len = (offset + size + 7) / 8;
732     if (len > targlen) {
733         s = (unsigned char*)SvGROW(targ, len + 1);
734         (void)memzero(s + targlen, len - targlen + 1);
735         SvCUR_set(targ, len);
736     }
737     
738     if (size < 8) {
739         mask = (1 << size) - 1;
740         size = offset & 7;
741         lval &= mask;
742         offset >>= 3;
743         s[offset] &= ~(mask << size);
744         s[offset] |= lval << size;
745     }
746     else {
747         offset >>= 3;
748         if (size == 8)
749             s[offset] = lval & 255;
750         else if (size == 16) {
751             s[offset] = (lval >> 8) & 255;
752             s[offset+1] = lval & 255;
753         }
754         else if (size == 32) {
755             s[offset] = (lval >> 24) & 255;
756             s[offset+1] = (lval >> 16) & 255;
757             s[offset+2] = (lval >> 8) & 255;
758             s[offset+3] = lval & 255;
759         }
760     }
761 }
762
763 void
764 do_chop(register SV *astr, register SV *sv)
765 {
766     STRLEN len;
767     char *s;
768     dTHR;
769     
770     if (SvTYPE(sv) == SVt_PVAV) {
771         register I32 i;
772         I32 max;
773         AV* av = (AV*)sv;
774         max = AvFILL(av);
775         for (i = 0; i <= max; i++) {
776             sv = (SV*)av_fetch(av, i, FALSE);
777             if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
778                 do_chop(astr, sv);
779         }
780         return;
781     }
782     if (SvTYPE(sv) == SVt_PVHV) {
783         HV* hv = (HV*)sv;
784         HE* entry;
785         (void)hv_iterinit(hv);
786         /*SUPPRESS 560*/
787         while (entry = hv_iternext(hv))
788             do_chop(astr,hv_iterval(hv,entry));
789         return;
790     }
791     s = SvPV(sv, len);
792     if (len && !SvPOK(sv))
793         s = SvPV_force(sv, len);
794     if (IN_UTF8) {
795         if (s && len) {
796             char *send = s + len;
797             char *start = s;
798             s = send - 1;
799             while ((*s & 0xc0) == 0x80)
800                 --s;
801             if (UTF8SKIP(s) != send - s)
802                 warn("Malformed UTF-8 character");
803             sv_setpvn(astr, s, send - s);
804             *s = '\0';
805             SvCUR_set(sv, s - start);
806             SvNIOK_off(sv);
807         }
808         else
809             sv_setpvn(astr, "", 0);
810     }
811     else
812     if (s && len) {
813         s += --len;
814         sv_setpvn(astr, s, 1);
815         *s = '\0';
816         SvCUR_set(sv, len);
817         SvNIOK_off(sv);
818     }
819     else
820         sv_setpvn(astr, "", 0);
821     SvSETMAGIC(sv);
822
823
824 I32
825 do_chomp(register SV *sv)
826 {
827     dTHR;
828     register I32 count;
829     STRLEN len;
830     char *s;
831
832     if (RsSNARF(PL_rs))
833         return 0;
834     count = 0;
835     if (SvTYPE(sv) == SVt_PVAV) {
836         register I32 i;
837         I32 max;
838         AV* av = (AV*)sv;
839         max = AvFILL(av);
840         for (i = 0; i <= max; i++) {
841             sv = (SV*)av_fetch(av, i, FALSE);
842             if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
843                 count += do_chomp(sv);
844         }
845         return count;
846     }
847     if (SvTYPE(sv) == SVt_PVHV) {
848         HV* hv = (HV*)sv;
849         HE* entry;
850         (void)hv_iterinit(hv);
851         /*SUPPRESS 560*/
852         while (entry = hv_iternext(hv))
853             count += do_chomp(hv_iterval(hv,entry));
854         return count;
855     }
856     s = SvPV(sv, len);
857     if (len && !SvPOKp(sv))
858         s = SvPV_force(sv, len);
859     if (s && len) {
860         s += --len;
861         if (RsPARA(PL_rs)) {
862             if (*s != '\n')
863                 goto nope;
864             ++count;
865             while (len && s[-1] == '\n') {
866                 --len;
867                 --s;
868                 ++count;
869             }
870         }
871         else {
872             STRLEN rslen;
873             char *rsptr = SvPV(PL_rs, rslen);
874             if (rslen == 1) {
875                 if (*s != *rsptr)
876                     goto nope;
877                 ++count;
878             }
879             else {
880                 if (len < rslen - 1)
881                     goto nope;
882                 len -= rslen - 1;
883                 s -= rslen - 1;
884                 if (memNE(s, rsptr, rslen))
885                     goto nope;
886                 count += rslen;
887             }
888         }
889         *s = '\0';
890         SvCUR_set(sv, len);
891         SvNIOK_off(sv);
892     }
893   nope:
894     SvSETMAGIC(sv);
895     return count;
896
897
898 void
899 do_vop(I32 optype, SV *sv, SV *left, SV *right)
900 {
901     dTHR;       /* just for taint */
902 #ifdef LIBERAL
903     register long *dl;
904     register long *ll;
905     register long *rl;
906 #endif
907     register char *dc;
908     STRLEN leftlen;
909     STRLEN rightlen;
910     register char *lc;
911     register char *rc;
912     register I32 len;
913     I32 lensave;
914     char *lsave;
915     char *rsave;
916
917     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
918         sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
919     lsave = lc = SvPV(left, leftlen);
920     rsave = rc = SvPV(right, rightlen);
921     len = leftlen < rightlen ? leftlen : rightlen;
922     lensave = len;
923     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
924         STRLEN n_a;
925         dc = SvPV_force(sv, n_a);
926         if (SvCUR(sv) < len) {
927             dc = SvGROW(sv, len + 1);
928             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
929         }
930     }
931     else {
932         I32 needlen = ((optype == OP_BIT_AND)
933                         ? len : (leftlen > rightlen ? leftlen : rightlen));
934         Newz(801, dc, needlen + 1, char);
935         (void)sv_usepvn(sv, dc, needlen);
936         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
937     }
938     SvCUR_set(sv, len);
939     (void)SvPOK_only(sv);
940 #ifdef LIBERAL
941     if (len >= sizeof(long)*4 &&
942         !((long)dc % sizeof(long)) &&
943         !((long)lc % sizeof(long)) &&
944         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
945     {
946         I32 remainder = len % (sizeof(long)*4);
947         len /= (sizeof(long)*4);
948
949         dl = (long*)dc;
950         ll = (long*)lc;
951         rl = (long*)rc;
952
953         switch (optype) {
954         case OP_BIT_AND:
955             while (len--) {
956                 *dl++ = *ll++ & *rl++;
957                 *dl++ = *ll++ & *rl++;
958                 *dl++ = *ll++ & *rl++;
959                 *dl++ = *ll++ & *rl++;
960             }
961             break;
962         case OP_BIT_XOR:
963             while (len--) {
964                 *dl++ = *ll++ ^ *rl++;
965                 *dl++ = *ll++ ^ *rl++;
966                 *dl++ = *ll++ ^ *rl++;
967                 *dl++ = *ll++ ^ *rl++;
968             }
969             break;
970         case OP_BIT_OR:
971             while (len--) {
972                 *dl++ = *ll++ | *rl++;
973                 *dl++ = *ll++ | *rl++;
974                 *dl++ = *ll++ | *rl++;
975                 *dl++ = *ll++ | *rl++;
976             }
977         }
978
979         dc = (char*)dl;
980         lc = (char*)ll;
981         rc = (char*)rl;
982
983         len = remainder;
984     }
985 #endif
986     {
987         switch (optype) {
988         case OP_BIT_AND:
989             while (len--)
990                 *dc++ = *lc++ & *rc++;
991             break;
992         case OP_BIT_XOR:
993             while (len--)
994                 *dc++ = *lc++ ^ *rc++;
995             goto mop_up;
996         case OP_BIT_OR:
997             while (len--)
998                 *dc++ = *lc++ | *rc++;
999           mop_up:
1000             len = lensave;
1001             if (rightlen > len)
1002                 sv_catpvn(sv, rsave + len, rightlen - len);
1003             else if (leftlen > len)
1004                 sv_catpvn(sv, lsave + len, leftlen - len);
1005             else
1006                 *SvEND(sv) = '\0';
1007             break;
1008         }
1009     }
1010     SvTAINT(sv);
1011 }
1012
1013 OP *
1014 do_kv(ARGSproto)
1015 {
1016     djSP;
1017     HV *hv = (HV*)POPs;
1018     HV *keys;
1019     register HE *entry;
1020     SV *tmpstr;
1021     I32 gimme = GIMME_V;
1022     I32 dokeys =   (PL_op->op_type == OP_KEYS);
1023     I32 dovalues = (PL_op->op_type == OP_VALUES);
1024     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
1025     
1026     if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV) 
1027         dokeys = dovalues = TRUE;
1028
1029     if (!hv) {
1030         if (PL_op->op_flags & OPf_MOD) {        /* lvalue */
1031             dTARGET;            /* make sure to clear its target here */
1032             if (SvTYPE(TARG) == SVt_PVLV)
1033                 LvTARG(TARG) = Nullsv;
1034             PUSHs(TARG);
1035         }
1036         RETURN;
1037     }
1038
1039     keys = realhv ? hv : avhv_keys((AV*)hv);
1040     (void)hv_iterinit(keys);    /* always reset iterator regardless */
1041
1042     if (gimme == G_VOID)
1043         RETURN;
1044
1045     if (gimme == G_SCALAR) {
1046         IV i;
1047         dTARGET;
1048
1049         if (PL_op->op_flags & OPf_MOD) {        /* lvalue */
1050             if (SvTYPE(TARG) < SVt_PVLV) {
1051                 sv_upgrade(TARG, SVt_PVLV);
1052                 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
1053             }
1054             LvTYPE(TARG) = 'k';
1055             if (LvTARG(TARG) != (SV*)keys) {
1056                 if (LvTARG(TARG))
1057                     SvREFCNT_dec(LvTARG(TARG));
1058                 LvTARG(TARG) = SvREFCNT_inc(keys);
1059             }
1060             PUSHs(TARG);
1061             RETURN;
1062         }
1063
1064         if (! SvTIED_mg((SV*)keys, 'P'))
1065             i = HvKEYS(keys);
1066         else {
1067             i = 0;
1068             /*SUPPRESS 560*/
1069             while (hv_iternext(keys)) i++;
1070         }
1071         PUSHi( i );
1072         RETURN;
1073     }
1074
1075     EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
1076
1077     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
1078     while (entry = hv_iternext(keys)) {
1079         SPAGAIN;
1080         if (dokeys)
1081             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
1082         if (dovalues) {
1083             PUTBACK;
1084             tmpstr = realhv ?
1085                      hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry);
1086             DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
1087                             (unsigned long)HeHASH(entry),
1088                             HvMAX(keys)+1,
1089                             (unsigned long)(HeHASH(entry) & HvMAX(keys))));
1090             SPAGAIN;
1091             XPUSHs(tmpstr);
1092         }
1093         PUTBACK;
1094     }
1095     return NORMAL;
1096 }
1097