This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
0c9bb4fcb28c516425fc6a81bb04d772424d5b5e
[perl5.git] / doop.c
1 /*    doop.c
2  *
3  *    Copyright (c) 1991-1999, 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     else 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     else if (SvREADONLY(sv))
792         croak(PL_no_modify);
793     s = SvPV(sv, len);
794     if (len && !SvPOK(sv))
795         s = SvPV_force(sv, len);
796     if (IN_UTF8) {
797         if (s && len) {
798             char *send = s + len;
799             char *start = s;
800             s = send - 1;
801             while ((*s & 0xc0) == 0x80)
802                 --s;
803             if (UTF8SKIP(s) != send - s)
804                 warn("Malformed UTF-8 character");
805             sv_setpvn(astr, s, send - s);
806             *s = '\0';
807             SvCUR_set(sv, s - start);
808             SvNIOK_off(sv);
809         }
810         else
811             sv_setpvn(astr, "", 0);
812     }
813     else
814     if (s && len) {
815         s += --len;
816         sv_setpvn(astr, s, 1);
817         *s = '\0';
818         SvCUR_set(sv, len);
819         SvNIOK_off(sv);
820     }
821     else
822         sv_setpvn(astr, "", 0);
823     SvSETMAGIC(sv);
824
825
826 I32
827 do_chomp(register SV *sv)
828 {
829     dTHR;
830     register I32 count;
831     STRLEN len;
832     char *s;
833
834     if (RsSNARF(PL_rs))
835         return 0;
836     if (RsRECORD(PL_rs))
837       return 0;
838     count = 0;
839     if (SvTYPE(sv) == SVt_PVAV) {
840         register I32 i;
841         I32 max;
842         AV* av = (AV*)sv;
843         max = AvFILL(av);
844         for (i = 0; i <= max; i++) {
845             sv = (SV*)av_fetch(av, i, FALSE);
846             if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
847                 count += do_chomp(sv);
848         }
849         return count;
850     }
851     else if (SvTYPE(sv) == SVt_PVHV) {
852         HV* hv = (HV*)sv;
853         HE* entry;
854         (void)hv_iterinit(hv);
855         /*SUPPRESS 560*/
856         while (entry = hv_iternext(hv))
857             count += do_chomp(hv_iterval(hv,entry));
858         return count;
859     }
860     else if (SvREADONLY(sv))
861         croak(PL_no_modify);
862     s = SvPV(sv, len);
863     if (len && !SvPOKp(sv))
864         s = SvPV_force(sv, len);
865     if (s && len) {
866         s += --len;
867         if (RsPARA(PL_rs)) {
868             if (*s != '\n')
869                 goto nope;
870             ++count;
871             while (len && s[-1] == '\n') {
872                 --len;
873                 --s;
874                 ++count;
875             }
876         }
877         else {
878             STRLEN rslen;
879             char *rsptr = SvPV(PL_rs, rslen);
880             if (rslen == 1) {
881                 if (*s != *rsptr)
882                     goto nope;
883                 ++count;
884             }
885             else {
886                 if (len < rslen - 1)
887                     goto nope;
888                 len -= rslen - 1;
889                 s -= rslen - 1;
890                 if (memNE(s, rsptr, rslen))
891                     goto nope;
892                 count += rslen;
893             }
894         }
895         *s = '\0';
896         SvCUR_set(sv, len);
897         SvNIOK_off(sv);
898     }
899   nope:
900     SvSETMAGIC(sv);
901     return count;
902
903
904 void
905 do_vop(I32 optype, SV *sv, SV *left, SV *right)
906 {
907     dTHR;       /* just for taint */
908 #ifdef LIBERAL
909     register long *dl;
910     register long *ll;
911     register long *rl;
912 #endif
913     register char *dc;
914     STRLEN leftlen;
915     STRLEN rightlen;
916     register char *lc;
917     register char *rc;
918     register I32 len;
919     I32 lensave;
920     char *lsave;
921     char *rsave;
922
923     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
924         sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
925     lsave = lc = SvPV(left, leftlen);
926     rsave = rc = SvPV(right, rightlen);
927     len = leftlen < rightlen ? leftlen : rightlen;
928     lensave = len;
929     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
930         STRLEN n_a;
931         dc = SvPV_force(sv, n_a);
932         if (SvCUR(sv) < len) {
933             dc = SvGROW(sv, len + 1);
934             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
935         }
936     }
937     else {
938         I32 needlen = ((optype == OP_BIT_AND)
939                         ? len : (leftlen > rightlen ? leftlen : rightlen));
940         Newz(801, dc, needlen + 1, char);
941         (void)sv_usepvn(sv, dc, needlen);
942         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
943     }
944     SvCUR_set(sv, len);
945     (void)SvPOK_only(sv);
946 #ifdef LIBERAL
947     if (len >= sizeof(long)*4 &&
948         !((long)dc % sizeof(long)) &&
949         !((long)lc % sizeof(long)) &&
950         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
951     {
952         I32 remainder = len % (sizeof(long)*4);
953         len /= (sizeof(long)*4);
954
955         dl = (long*)dc;
956         ll = (long*)lc;
957         rl = (long*)rc;
958
959         switch (optype) {
960         case OP_BIT_AND:
961             while (len--) {
962                 *dl++ = *ll++ & *rl++;
963                 *dl++ = *ll++ & *rl++;
964                 *dl++ = *ll++ & *rl++;
965                 *dl++ = *ll++ & *rl++;
966             }
967             break;
968         case OP_BIT_XOR:
969             while (len--) {
970                 *dl++ = *ll++ ^ *rl++;
971                 *dl++ = *ll++ ^ *rl++;
972                 *dl++ = *ll++ ^ *rl++;
973                 *dl++ = *ll++ ^ *rl++;
974             }
975             break;
976         case OP_BIT_OR:
977             while (len--) {
978                 *dl++ = *ll++ | *rl++;
979                 *dl++ = *ll++ | *rl++;
980                 *dl++ = *ll++ | *rl++;
981                 *dl++ = *ll++ | *rl++;
982             }
983         }
984
985         dc = (char*)dl;
986         lc = (char*)ll;
987         rc = (char*)rl;
988
989         len = remainder;
990     }
991 #endif
992     {
993         switch (optype) {
994         case OP_BIT_AND:
995             while (len--)
996                 *dc++ = *lc++ & *rc++;
997             break;
998         case OP_BIT_XOR:
999             while (len--)
1000                 *dc++ = *lc++ ^ *rc++;
1001             goto mop_up;
1002         case OP_BIT_OR:
1003             while (len--)
1004                 *dc++ = *lc++ | *rc++;
1005           mop_up:
1006             len = lensave;
1007             if (rightlen > len)
1008                 sv_catpvn(sv, rsave + len, rightlen - len);
1009             else if (leftlen > len)
1010                 sv_catpvn(sv, lsave + len, leftlen - len);
1011             else
1012                 *SvEND(sv) = '\0';
1013             break;
1014         }
1015     }
1016     SvTAINT(sv);
1017 }
1018
1019 OP *
1020 do_kv(ARGSproto)
1021 {
1022     djSP;
1023     HV *hv = (HV*)POPs;
1024     HV *keys;
1025     register HE *entry;
1026     SV *tmpstr;
1027     I32 gimme = GIMME_V;
1028     I32 dokeys =   (PL_op->op_type == OP_KEYS);
1029     I32 dovalues = (PL_op->op_type == OP_VALUES);
1030     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
1031     
1032     if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV) 
1033         dokeys = dovalues = TRUE;
1034
1035     if (!hv) {
1036         if (PL_op->op_flags & OPf_MOD) {        /* lvalue */
1037             dTARGET;            /* make sure to clear its target here */
1038             if (SvTYPE(TARG) == SVt_PVLV)
1039                 LvTARG(TARG) = Nullsv;
1040             PUSHs(TARG);
1041         }
1042         RETURN;
1043     }
1044
1045     keys = realhv ? hv : avhv_keys((AV*)hv);
1046     (void)hv_iterinit(keys);    /* always reset iterator regardless */
1047
1048     if (gimme == G_VOID)
1049         RETURN;
1050
1051     if (gimme == G_SCALAR) {
1052         IV i;
1053         dTARGET;
1054
1055         if (PL_op->op_flags & OPf_MOD) {        /* lvalue */
1056             if (SvTYPE(TARG) < SVt_PVLV) {
1057                 sv_upgrade(TARG, SVt_PVLV);
1058                 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
1059             }
1060             LvTYPE(TARG) = 'k';
1061             if (LvTARG(TARG) != (SV*)keys) {
1062                 if (LvTARG(TARG))
1063                     SvREFCNT_dec(LvTARG(TARG));
1064                 LvTARG(TARG) = SvREFCNT_inc(keys);
1065             }
1066             PUSHs(TARG);
1067             RETURN;
1068         }
1069
1070         if (! SvTIED_mg((SV*)keys, 'P'))
1071             i = HvKEYS(keys);
1072         else {
1073             i = 0;
1074             /*SUPPRESS 560*/
1075             while (hv_iternext(keys)) i++;
1076         }
1077         PUSHi( i );
1078         RETURN;
1079     }
1080
1081     EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
1082
1083     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
1084     while (entry = hv_iternext(keys)) {
1085         SPAGAIN;
1086         if (dokeys)
1087             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
1088         if (dovalues) {
1089             PUTBACK;
1090             tmpstr = realhv ?
1091                      hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry);
1092             DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
1093                             (unsigned long)HeHASH(entry),
1094                             HvMAX(keys)+1,
1095                             (unsigned long)(HeHASH(entry) & HvMAX(keys))));
1096             SPAGAIN;
1097             XPUSHs(tmpstr);
1098         }
1099         PUTBACK;
1100     }
1101     return NORMAL;
1102 }
1103