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             s += UTF8SKIP(s);
 220             matches++;
 221         }
 222     }
 223
 224     return matches;
 225 }
 226
 227 STATIC I32
 228 do_trans_UC_simple(SV *sv)
 229 {
 230     dTHR;
 231     U8 *s;
 232     U8 *send;
 233     U8 *d;
 234     I32 matches = 0;
 235     STRLEN len;
 236
 237     SV* rv = (SV*)cSVOP->op_sv;
 238     HV* hv = (HV*)SvRV(rv);
 239     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
 240     UV none = svp ? SvUV(*svp) : 0x7fffffff;
 241     UV extra = none + 1;
 242     UV final;
 243     UV uv;
 244
 245     s = (U8*)SvPV(sv, len);
 246     send = s + len;
 247
 248     svp = hv_fetch(hv, "FINAL", 5, FALSE);
 249     if (svp)
 250         final = SvUV(*svp);
 251
 252     d = s;
 253     while (s < send) {
 254         if ((uv = swash_fetch(rv, s)) < none) {
 255             s += UTF8SKIP(s);
 256             matches++;
 257             *d++ = (U8)uv;
 258         }
 259         else if (uv == none) {
 260             I32 ulen;
 261             uv = utf8_to_uv(s, &ulen);
 262             s += ulen;
 263             *d++ = (U8)uv;
 264         }
 265         else if (uv == extra) {
 266             s += UTF8SKIP(s);
 267             matches++;
 268             *d++ = (U8)final;
 269         }
 270         else
 271             s += UTF8SKIP(s);
 272     }
 273     *d = '\0';
 274     SvCUR_set(sv, d - (U8*)SvPVX(sv));
 275     SvSETMAGIC(sv);
 276
 277     return matches;
 278 }
 279
 280 STATIC I32
 281 do_trans_CU_simple(SV *sv)
 282 {
 283     dTHR;
 284     U8 *s;
 285     U8 *send;
 286     U8 *d;
 287     U8 *dst;
 288     I32 matches = 0;
 289     STRLEN len;
 290
 291     SV* rv = (SV*)cSVOP->op_sv;
 292     HV* hv = (HV*)SvRV(rv);
 293     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
 294     UV none = svp ? SvUV(*svp) : 0x7fffffff;
 295     UV extra = none + 1;
 296     UV final;
 297     UV uv;
 298     U8 tmpbuf[10];
 299     I32 bits = 16;
 300
 301     s = (U8*)SvPV(sv, len);
 302     send = s + len;
 303
 304     svp = hv_fetch(hv, "BITS", 4, FALSE);
 305     if (svp)
 306         bits = (I32)SvIV(*svp);
 307
 308     svp = hv_fetch(hv, "FINAL", 5, FALSE);
 309     if (svp)
 310         final = SvUV(*svp);
 311
 312     Newz(801, d, len * (bits >> 3) + 1, U8);
 313     dst = d;
 314
 315     while (s < send) {
 316         uv = *s++;
 317         if (uv < 0x80)
 318             tmpbuf[0] = uv;
 319         else {
 320             tmpbuf[0] = (( uv >>  6)         | 0xc0);
 321             tmpbuf[1] = (( uv        & 0x3f) | 0x80);
 322         }
 323
 324         if ((uv = swash_fetch(rv, tmpbuf)) < none) {
 325             matches++;
 326             d = uv_to_utf8(d, uv);
 327         }
 328         else if (uv == none)
 329             d = uv_to_utf8(d, s[-1]);
 330         else if (uv == extra) {
 331             matches++;
 332             d = uv_to_utf8(d, final);
 333         }
 334     }
 335     *d = '\0';
 336     sv_usepvn_mg(sv, (char*)dst, d - dst);
 337
 338     return matches;
 339 }
 340
 341 /* utf-8 to latin-1 */
 342
 343 STATIC I32
 344 do_trans_UC_trivial(SV *sv)
 345 {
 346     dTHR;
 347     U8 *s;
 348     U8 *send;
 349     U8 *d;
 350     STRLEN len;
 351
 352     s = (U8*)SvPV(sv, len);
 353     send = s + len;
 354
 355     d = s;
 356     while (s < send) {
 357         if (*s < 0x80)
 358             *d++ = *s++;
 359         else {
 360             I32 ulen;
 361             UV uv = utf8_to_uv(s, &ulen);
 362             s += ulen;
 363             *d++ = (U8)uv;
 364         }
 365     }
 366     *d = '\0';
 367     SvCUR_set(sv, d - (U8*)SvPVX(sv));
 368     SvSETMAGIC(sv);
 369
 370     return SvCUR(sv);
 371 }
 372
 373 /* latin-1 to utf-8 */
 374
 375 STATIC I32
 376 do_trans_CU_trivial(SV *sv)
 377 {
 378     dTHR;
 379     U8 *s;
 380     U8 *send;
 381     U8 *d;
 382     U8 *dst;
 383     I32 matches;
 384     STRLEN len;
 385
 386     s = (U8*)SvPV(sv, len);
 387     send = s + len;
 388
 389     Newz(801, d, len * 2 + 1, U8);
 390     dst = d;
 391
 392     matches = send - s;
 393
 394     while (s < send) {
 395         if (*s < 0x80)
 396             *d++ = *s++;
 397         else {
 398             UV uv = *s++;
 399             *d++ = (( uv >>  6)         | 0xc0);
 400             *d++ = (( uv        & 0x3f) | 0x80);
 401         }
 402     }
 403     *d = '\0';
 404     sv_usepvn_mg(sv, (char*)dst, d - dst);
 405
 406     return matches;
 407 }
 408
 409 STATIC I32
 410 do_trans_UU_complex(SV *sv)
 411 {
 412     dTHR;
 413     U8 *s;
 414     U8 *send;
 415     U8 *d;
 416     I32 matches = 0;
 417     I32 squash   = PL_op->op_private & OPpTRANS_SQUASH;
 418     I32 from_utf = PL_op->op_private & OPpTRANS_FROM_UTF;
 419     I32 to_utf   = PL_op->op_private & OPpTRANS_TO_UTF;
 420     I32 del      = PL_op->op_private & OPpTRANS_DELETE;
 421     SV* rv = (SV*)cSVOP->op_sv;
 422     HV* hv = (HV*)SvRV(rv);
 423     SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
 424     UV none = svp ? SvUV(*svp) : 0x7fffffff;
 425     UV extra = none + 1;
 426     UV final;
 427     UV uv;
 428     STRLEN len;
 429     U8 *dst;
 430
 431     s = (U8*)SvPV(sv, len);
 432     send = s + len;
 433
 434     svp = hv_fetch(hv, "FINAL", 5, FALSE);
 435     if (svp)
 436         final = SvUV(*svp);
 437
 438     if (PL_op->op_private & OPpTRANS_GROWS) {
 439         I32 bits = 16;
 440
 441         svp = hv_fetch(hv, "BITS", 4, FALSE);
 442         if (svp)
 443             bits = (I32)SvIV(*svp);
 444
 445         Newz(801, d, len * (bits >> 3) + 1, U8);
 446         dst = d;
 447     }
 448     else {
 449         d = s;
 450         dst = 0;
 451     }
 452
 453     if (squash) {
 454         UV puv = 0xfeedface;
 455         while (s < send) {
 456             if (from_utf) {
 457                 uv = swash_fetch(rv, s);
 458             }
 459             else {
 460                 U8 tmpbuf[2];
 461                 uv = *s++;
 462                 if (uv < 0x80)
 463                     tmpbuf[0] = uv;
 464                 else {
 465                     tmpbuf[0] = (( uv >>  6)         | 0xc0);
 466                     tmpbuf[1] = (( uv        & 0x3f) | 0x80);
 467                 }
 468                 uv = swash_fetch(rv, tmpbuf);
 469             }
 470             if (uv < none) {
 471                 matches++;
 472                 if (uv != puv) {
 473                     if (uv >= 0x80 && to_utf)
 474                         d = uv_to_utf8(d, uv);
 475                     else
 476                         *d++ = (U8)uv;
 477                     puv = uv;
 478                 }
 479                 if (from_utf)
 480                     s += UTF8SKIP(s);
 481                 continue;
 482             }
 483             else if (uv == none) {      /* "none" is unmapped character */
 484                 if (from_utf) {
 485                     if (*s < 0x80)
 486                         *d++ = *s++;
 487                     else if (to_utf) {
 488                         int i;
 489                         for (i = UTF8SKIP(s); i; --i)
 490                             *d++ = *s++;
 491                     }
 492                     else {
 493                         I32 ulen;
 494                         *d++ = (U8)utf8_to_uv(s, &ulen);
 495                         s += ulen;
 496                     }
 497                 }
 498                 else {  /* must be to_utf only */
 499                     d = uv_to_utf8(d, s[-1]);
 500                 }
 501                 puv = 0xfeedface;
 502                 continue;
 503             }
 504             else if (uv == extra && !del) {
 505                 matches++;
 506                 if (uv != puv) {
 507                     if (final >= 0x80 && to_utf)
 508                         d = uv_to_utf8(d, final);
 509                     else
 510                         *d++ = (U8)final;
 511                     puv = final;
 512                 }
 513                 if (from_utf)
 514                     s += UTF8SKIP(s);
 515                 continue;
 516             }
 517             matches++;          /* "none+1" is delete character */
 518             if (from_utf)
 519                 s += UTF8SKIP(s);
 520         }
 521     }
 522     else {
 523         while (s < send) {
 524             if (from_utf) {
 525                 uv = swash_fetch(rv, s);
 526             }
 527             else {
 528                 U8 tmpbuf[2];
 529                 uv = *s++;
 530                 if (uv < 0x80)
 531                     tmpbuf[0] = uv;
 532                 else {
 533                     tmpbuf[0] = (( uv >>  6)         | 0xc0);
 534                     tmpbuf[1] = (( uv        & 0x3f) | 0x80);
 535                 }
 536                 uv = swash_fetch(rv, tmpbuf);
 537             }
 538             if (uv < none) {
 539                 matches++;
 540                 if (uv >= 0x80 && to_utf)
 541                     d = uv_to_utf8(d, uv);
 542                 else
 543                     *d++ = (U8)uv;
 544                 if (from_utf)
 545                     s += UTF8SKIP(s);
 546                 continue;
 547             }
 548             else if (uv == none) {      /* "none" is unmapped character */
 549                 if (from_utf) {
 550                     if (*s < 0x80)
 551                         *d++ = *s++;
 552                     else if (to_utf) {
 553                         int i;
 554                         for (i = UTF8SKIP(s); i; --i)
 555                             *d++ = *s++;
 556                     }
 557                     else {
 558                         I32 ulen;
 559                         *d++ = (U8)utf8_to_uv(s, &ulen);
 560                         s += ulen;
 561                     }
 562                 }
 563                 else {  /* must be to_utf only */
 564                     d = uv_to_utf8(d, s[-1]);
 565                 }
 566                 continue;
 567             }
 568             else if (uv == extra && !del) {
 569                 matches++;
 570                 if (final >= 0x80 && to_utf)
 571                     d = uv_to_utf8(d, final);
 572                 else
 573                     *d++ = (U8)final;
 574                 if (from_utf)
 575                     s += UTF8SKIP(s);
 576                 continue;
 577             }
 578             matches++;          /* "none+1" is delete character */
 579             if (from_utf)
 580                 s += UTF8SKIP(s);
 581         }
 582     }
 583     if (dst)
 584         sv_usepvn(sv, (char*)dst, d - dst);
 585     else {
 586         *d = '\0';
 587         SvCUR_set(sv, d - (U8*)SvPVX(sv));
 588     }
 589     SvSETMAGIC(sv);
 590
 591     return matches;
 592 }
 593
 594 I32
 595 do_trans(SV *sv)
 596 {
 597     dTHR;
 598     STRLEN len;
 599
 600     if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL))
 601         croak(no_modify);
 602
 603     (void)SvPV(sv, len);
 604     if (!len)
 605         return 0;
 606     if (!SvPOKp(sv))
 607         (void)SvPV_force(sv, len);
 608     (void)SvPOK_only(sv);
 609
 610     DEBUG_t( deb("2.TBL\n"));
 611
 612     switch (PL_op->op_private & 63) {
 613     case 0:
 614         return do_trans_CC_simple(sv);
 615
 616     case OPpTRANS_FROM_UTF:
 617         return do_trans_UC_simple(sv);
 618
 619     case OPpTRANS_TO_UTF:
 620         return do_trans_CU_simple(sv);
 621
 622     case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF:
 623         return do_trans_UU_simple(sv);
 624
 625     case OPpTRANS_IDENTICAL:
 626         return do_trans_CC_count(sv);
 627
 628     case OPpTRANS_FROM_UTF|OPpTRANS_IDENTICAL:
 629         return do_trans_UC_trivial(sv);
 630
 631     case OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL:
 632         return do_trans_CU_trivial(sv);
 633
 634     case OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL:
 635         return do_trans_UU_count(sv);
 636
 637     default:
 638         if (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
 639             return do_trans_UU_complex(sv); /* could be UC or CU too */
 640         else
 641             return do_trans_CC_complex(sv);
 642     }
 643 }
 644
 645 void
 646 do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
 647 {
 648     SV **oldmark = mark;
 649     register I32 items = sp - mark;
 650     register STRLEN len;
 651     STRLEN delimlen;
 652     register char *delim = SvPV(del, delimlen);
 653     STRLEN tmplen;
 654
 655     mark++;
 656     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
 657     if (SvTYPE(sv) < SVt_PV)
 658         sv_upgrade(sv, SVt_PV);
 659     if (SvLEN(sv) < len + items) {      /* current length is way too short */
 660         while (items-- > 0) {
 661             if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) {
 662                 SvPV(*mark, tmplen);
 663                 len += tmplen;
 664             }
 665             mark++;
 666         }
 667         SvGROW(sv, len + 1);            /* so try to pre-extend */
 668
 669         mark = oldmark;
 670         items = sp - mark;;
 671         ++mark;
 672     }
 673
 674     if (items-- > 0) {
 675         char *s;
 676
 677         if (*mark) {
 678             s = SvPV(*mark, tmplen);
 679             sv_setpvn(sv, s, tmplen);
 680         }
 681         else
 682             sv_setpv(sv, "");
 683         mark++;
 684     }
 685     else
 686         sv_setpv(sv,"");
 687     len = delimlen;
 688     if (len) {
 689         for (; items > 0; items--,mark++) {
 690             sv_catpvn(sv,delim,len);
 691             sv_catsv(sv,*mark);
 692         }
 693     }
 694     else {
 695         for (; items > 0; items--,mark++)
 696             sv_catsv(sv,*mark);
 697     }
 698     SvSETMAGIC(sv);
 699 }
 700
 701 void
 702 do_sprintf(SV *sv, I32 len, SV **sarg)
 703 {
 704     STRLEN patlen;
 705     char *pat = SvPV(*sarg, patlen);
 706     bool do_taint = FALSE;
 707
 708     sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
 709     SvSETMAGIC(sv);
 710     if (do_taint)
 711         SvTAINTED_on(sv);
 712 }
 713
 714 void
 715 do_vecset(SV *sv)
 716 {
 717     SV *targ = LvTARG(sv);
 718     register I32 offset;
 719     register I32 size;
 720     register unsigned char *s;
 721     register unsigned long lval;
 722     I32 mask;
 723     STRLEN targlen;
 724     STRLEN len;
 725
 726     if (!targ)
 727         return;
 728     s = (unsigned char*)SvPV_force(targ, targlen);
 729     lval = U_L(SvNV(sv));
 730     offset = LvTARGOFF(sv);
 731     size = LvTARGLEN(sv);
 732
 733     len = (offset + size + 7) / 8;
 734     if (len > targlen) {
 735         s = (unsigned char*)SvGROW(targ, len + 1);
 736         (void)memzero(s + targlen, len - targlen + 1);
 737         SvCUR_set(targ, len);
 738     }
 739
 740     if (size < 8) {
 741         mask = (1 << size) - 1;
 742         size = offset & 7;
 743         lval &= mask;
 744         offset >>= 3;
 745         s[offset] &= ~(mask << size);
 746         s[offset] |= lval << size;
 747     }
 748     else {
 749         offset >>= 3;
 750         if (size == 8)
 751             s[offset] = lval & 255;
 752         else if (size == 16) {
 753             s[offset] = (lval >> 8) & 255;
 754             s[offset+1] = lval & 255;
 755         }
 756         else if (size == 32) {
 757             s[offset] = (lval >> 24) & 255;
 758             s[offset+1] = (lval >> 16) & 255;
 759             s[offset+2] = (lval >> 8) & 255;
 760             s[offset+3] = lval & 255;
 761         }
 762     }
 763 }
 764
 765 void
 766 do_chop(register SV *astr, register SV *sv)
 767 {
 768     STRLEN len;
 769     char *s;
 770     dTHR;
 771
 772     if (SvTYPE(sv) == SVt_PVAV) {
 773         register I32 i;
 774         I32 max;
 775         AV* av = (AV*)sv;
 776         max = AvFILL(av);
 777         for (i = 0; i <= max; i++) {
 778             sv = (SV*)av_fetch(av, i, FALSE);
 779             if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
 780                 do_chop(astr, sv);
 781         }
 782         return;
 783     }
 784     if (SvTYPE(sv) == SVt_PVHV) {
 785         HV* hv = (HV*)sv;
 786         HE* entry;
 787         (void)hv_iterinit(hv);
 788         /*SUPPRESS 560*/
 789         while (entry = hv_iternext(hv))
 790             do_chop(astr,hv_iterval(hv,entry));
 791         return;
 792     }
 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     count = 0;
 837     if (SvTYPE(sv) == SVt_PVAV) {
 838         register I32 i;
 839         I32 max;
 840         AV* av = (AV*)sv;
 841         max = AvFILL(av);
 842         for (i = 0; i <= max; i++) {
 843             sv = (SV*)av_fetch(av, i, FALSE);
 844             if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
 845                 count += do_chomp(sv);
 846         }
 847         return count;
 848     }
 849     if (SvTYPE(sv) == SVt_PVHV) {
 850         HV* hv = (HV*)sv;
 851         HE* entry;
 852         (void)hv_iterinit(hv);
 853         /*SUPPRESS 560*/
 854         while (entry = hv_iternext(hv))
 855             count += do_chomp(hv_iterval(hv,entry));
 856         return count;
 857     }
 858     s = SvPV(sv, len);
 859     if (len && !SvPOKp(sv))
 860         s = SvPV_force(sv, len);
 861     if (s && len) {
 862         s += --len;
 863         if (RsPARA(PL_rs)) {
 864             if (*s != '\n')
 865                 goto nope;
 866             ++count;
 867             while (len && s[-1] == '\n') {
 868                 --len;
 869                 --s;
 870                 ++count;
 871             }
 872         }
 873         else {
 874             STRLEN rslen;
 875             char *rsptr = SvPV(PL_rs, rslen);
 876             if (rslen == 1) {
 877                 if (*s != *rsptr)
 878                     goto nope;
 879                 ++count;
 880             }
 881             else {
 882                 if (len < rslen - 1)
 883                     goto nope;
 884                 len -= rslen - 1;
 885                 s -= rslen - 1;
 886                 if (memNE(s, rsptr, rslen))
 887                     goto nope;
 888                 count += rslen;
 889             }
 890         }
 891         *s = '\0';
 892         SvCUR_set(sv, len);
 893         SvNIOK_off(sv);
 894     }
 895   nope:
 896     SvSETMAGIC(sv);
 897     return count;
 898 }
 899
 900 void
 901 do_vop(I32 optype, SV *sv, SV *left, SV *right)
 902 {
 903     dTHR;       /* just for taint */
 904 #ifdef LIBERAL
 905     register long *dl;
 906     register long *ll;
 907     register long *rl;
 908 #endif
 909     register char *dc;
 910     STRLEN leftlen;
 911     STRLEN rightlen;
 912     register char *lc;
 913     register char *rc;
 914     register I32 len;
 915     I32 lensave;
 916     char *lsave;
 917     char *rsave;
 918
 919     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
 920         sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
 921     lsave = lc = SvPV(left, leftlen);
 922     rsave = rc = SvPV(right, rightlen);
 923     len = leftlen < rightlen ? leftlen : rightlen;
 924     lensave = len;
 925     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
 926         dc = SvPV_force(sv, PL_na);
 927         if (SvCUR(sv) < len) {
 928             dc = SvGROW(sv, len + 1);
 929             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
 930         }
 931     }
 932     else {
 933         I32 needlen = ((optype == OP_BIT_AND)
 934                         ? len : (leftlen > rightlen ? leftlen : rightlen));
 935         Newz(801, dc, needlen + 1, char);
 936         (void)sv_usepvn(sv, dc, needlen);
 937         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
 938     }
 939     SvCUR_set(sv, len);
 940     (void)SvPOK_only(sv);
 941 #ifdef LIBERAL
 942     if (len >= sizeof(long)*4 &&
 943         !((long)dc % sizeof(long)) &&
 944         !((long)lc % sizeof(long)) &&
 945         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
 946     {
 947         I32 remainder = len % (sizeof(long)*4);
 948         len /= (sizeof(long)*4);
 949
 950         dl = (long*)dc;
 951         ll = (long*)lc;
 952         rl = (long*)rc;
 953
 954         switch (optype) {
 955         case OP_BIT_AND:
 956             while (len--) {
 957                 *dl++ = *ll++ & *rl++;
 958                 *dl++ = *ll++ & *rl++;
 959                 *dl++ = *ll++ & *rl++;
 960                 *dl++ = *ll++ & *rl++;
 961             }
 962             break;
 963         case OP_BIT_XOR:
 964             while (len--) {
 965                 *dl++ = *ll++ ^ *rl++;
 966                 *dl++ = *ll++ ^ *rl++;
 967                 *dl++ = *ll++ ^ *rl++;
 968                 *dl++ = *ll++ ^ *rl++;
 969             }
 970             break;
 971         case OP_BIT_OR:
 972             while (len--) {
 973                 *dl++ = *ll++ | *rl++;
 974                 *dl++ = *ll++ | *rl++;
 975                 *dl++ = *ll++ | *rl++;
 976                 *dl++ = *ll++ | *rl++;
 977             }
 978         }
 979
 980         dc = (char*)dl;
 981         lc = (char*)ll;
 982         rc = (char*)rl;
 983
 984         len = remainder;
 985     }
 986 #endif
 987     {
 988         switch (optype) {
 989         case OP_BIT_AND:
 990             while (len--)
 991                 *dc++ = *lc++ & *rc++;
 992             break;
 993         case OP_BIT_XOR:
 994             while (len--)
 995                 *dc++ = *lc++ ^ *rc++;
 996             goto mop_up;
 997         case OP_BIT_OR:
 998             while (len--)
 999                 *dc++ = *lc++ | *rc++;
1000           mop_up:
1001             len = lensave;
1002             if (rightlen > len)
1003                 sv_catpvn(sv, rsave + len, rightlen - len);
1004             else if (leftlen > len)
1005                 sv_catpvn(sv, lsave + len, leftlen - len);
1006             else
1007                 *SvEND(sv) = '\0';
1008             break;
1009         }
1010     }
1011     SvTAINT(sv);
1012 }
1013
1014 OP *
1015 do_kv(ARGSproto)
1016 {
1017     djSP;
1018     HV *hv = (HV*)POPs;
1019     HV *keys;
1020     register HE *entry;
1021     SV *tmpstr;
1022     I32 gimme = GIMME_V;
1023     I32 dokeys =   (PL_op->op_type == OP_KEYS);
1024     I32 dovalues = (PL_op->op_type == OP_VALUES);
1025     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
1026
1027     if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV)
1028         dokeys = dovalues = TRUE;
1029
1030     if (!hv) {
1031         if (PL_op->op_flags & OPf_MOD) {        /* lvalue */
1032             dTARGET;            /* make sure to clear its target here */
1033             if (SvTYPE(TARG) == SVt_PVLV)
1034                 LvTARG(TARG) = Nullsv;
1035             PUSHs(TARG);
1036         }
1037         RETURN;
1038     }
1039
1040     keys = realhv ? hv : avhv_keys((AV*)hv);
1041     (void)hv_iterinit(keys);    /* always reset iterator regardless */
1042
1043     if (gimme == G_VOID)
1044         RETURN;
1045
1046     if (gimme == G_SCALAR) {
1047         IV i;
1048         dTARGET;
1049
1050         if (PL_op->op_flags & OPf_MOD) {        /* lvalue */
1051             if (SvTYPE(TARG) < SVt_PVLV) {
1052                 sv_upgrade(TARG, SVt_PVLV);
1053                 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
1054             }
1055             LvTYPE(TARG) = 'k';
1056             if (LvTARG(TARG) != (SV*)keys) {
1057                 if (LvTARG(TARG))
1058                     SvREFCNT_dec(LvTARG(TARG));
1059                 LvTARG(TARG) = SvREFCNT_inc(keys);
1060             }
1061             PUSHs(TARG);
1062             RETURN;
1063         }
1064
1065         if (!SvRMAGICAL(keys) || !mg_find((SV*)keys,'P'))
1066             i = HvKEYS(keys);
1067         else {
1068             i = 0;
1069             /*SUPPRESS 560*/
1070             while (hv_iternext(keys)) i++;
1071         }
1072         PUSHi( i );
1073         RETURN;
1074     }
1075
1076     EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
1077
1078     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
1079     while (entry = hv_iternext(keys)) {
1080         SPAGAIN;
1081         if (dokeys)
1082             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
1083         if (dovalues) {
1084             PUTBACK;
1085             tmpstr = realhv ?
1086                      hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry);
1087             DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
1088                             (unsigned long)HeHASH(entry),
1089                             HvMAX(keys)+1,
1090                             (unsigned long)(HeHASH(entry) & HvMAX(keys))));
1091             SPAGAIN;
1092             XPUSHs(tmpstr);
1093         }
1094         PUTBACK;
1095     }
1096     return NORMAL;
1097 }
1098