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     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     if (RsRECORD(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         STRLEN n_a;
 927         dc = SvPV_force(sv, n_a);
 928         if (SvCUR(sv) < len) {
 929             dc = SvGROW(sv, len + 1);
 930             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
 931         }
 932     }
 933     else {
 934         I32 needlen = ((optype == OP_BIT_AND)
 935                         ? len : (leftlen > rightlen ? leftlen : rightlen));
 936         Newz(801, dc, needlen + 1, char);
 937         (void)sv_usepvn(sv, dc, needlen);
 938         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
 939     }
 940     SvCUR_set(sv, len);
 941     (void)SvPOK_only(sv);
 942 #ifdef LIBERAL
 943     if (len >= sizeof(long)*4 &&
 944         !((long)dc % sizeof(long)) &&
 945         !((long)lc % sizeof(long)) &&
 946         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
 947     {
 948         I32 remainder = len % (sizeof(long)*4);
 949         len /= (sizeof(long)*4);
 950
 951         dl = (long*)dc;
 952         ll = (long*)lc;
 953         rl = (long*)rc;
 954
 955         switch (optype) {
 956         case OP_BIT_AND:
 957             while (len--) {
 958                 *dl++ = *ll++ & *rl++;
 959                 *dl++ = *ll++ & *rl++;
 960                 *dl++ = *ll++ & *rl++;
 961                 *dl++ = *ll++ & *rl++;
 962             }
 963             break;
 964         case OP_BIT_XOR:
 965             while (len--) {
 966                 *dl++ = *ll++ ^ *rl++;
 967                 *dl++ = *ll++ ^ *rl++;
 968                 *dl++ = *ll++ ^ *rl++;
 969                 *dl++ = *ll++ ^ *rl++;
 970             }
 971             break;
 972         case OP_BIT_OR:
 973             while (len--) {
 974                 *dl++ = *ll++ | *rl++;
 975                 *dl++ = *ll++ | *rl++;
 976                 *dl++ = *ll++ | *rl++;
 977                 *dl++ = *ll++ | *rl++;
 978             }
 979         }
 980
 981         dc = (char*)dl;
 982         lc = (char*)ll;
 983         rc = (char*)rl;
 984
 985         len = remainder;
 986     }
 987 #endif
 988     {
 989         switch (optype) {
 990         case OP_BIT_AND:
 991             while (len--)
 992                 *dc++ = *lc++ & *rc++;
 993             break;
 994         case OP_BIT_XOR:
 995             while (len--)
 996                 *dc++ = *lc++ ^ *rc++;
 997             goto mop_up;
 998         case OP_BIT_OR:
 999             while (len--)
1000                 *dc++ = *lc++ | *rc++;
1001           mop_up:
1002             len = lensave;
1003             if (rightlen > len)
1004                 sv_catpvn(sv, rsave + len, rightlen - len);
1005             else if (leftlen > len)
1006                 sv_catpvn(sv, lsave + len, leftlen - len);
1007             else
1008                 *SvEND(sv) = '\0';
1009             break;
1010         }
1011     }
1012     SvTAINT(sv);
1013 }
1014
1015 OP *
1016 do_kv(ARGSproto)
1017 {
1018     djSP;
1019     HV *hv = (HV*)POPs;
1020     HV *keys;
1021     register HE *entry;
1022     SV *tmpstr;
1023     I32 gimme = GIMME_V;
1024     I32 dokeys =   (PL_op->op_type == OP_KEYS);
1025     I32 dovalues = (PL_op->op_type == OP_VALUES);
1026     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
1027
1028     if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV)
1029         dokeys = dovalues = TRUE;
1030
1031     if (!hv) {
1032         if (PL_op->op_flags & OPf_MOD) {        /* lvalue */
1033             dTARGET;            /* make sure to clear its target here */
1034             if (SvTYPE(TARG) == SVt_PVLV)
1035                 LvTARG(TARG) = Nullsv;
1036             PUSHs(TARG);
1037         }
1038         RETURN;
1039     }
1040
1041     keys = realhv ? hv : avhv_keys((AV*)hv);
1042     (void)hv_iterinit(keys);    /* always reset iterator regardless */
1043
1044     if (gimme == G_VOID)
1045         RETURN;
1046
1047     if (gimme == G_SCALAR) {
1048         IV i;
1049         dTARGET;
1050
1051         if (PL_op->op_flags & OPf_MOD) {        /* lvalue */
1052             if (SvTYPE(TARG) < SVt_PVLV) {
1053                 sv_upgrade(TARG, SVt_PVLV);
1054                 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
1055             }
1056             LvTYPE(TARG) = 'k';
1057             if (LvTARG(TARG) != (SV*)keys) {
1058                 if (LvTARG(TARG))
1059                     SvREFCNT_dec(LvTARG(TARG));
1060                 LvTARG(TARG) = SvREFCNT_inc(keys);
1061             }
1062             PUSHs(TARG);
1063             RETURN;
1064         }
1065
1066         if (! SvTIED_mg((SV*)keys, 'P'))
1067             i = HvKEYS(keys);
1068         else {
1069             i = 0;
1070             /*SUPPRESS 560*/
1071             while (hv_iternext(keys)) i++;
1072         }
1073         PUSHi( i );
1074         RETURN;
1075     }
1076
1077     EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
1078
1079     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
1080     while (entry = hv_iternext(keys)) {
1081         SPAGAIN;
1082         if (dokeys)
1083             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
1084         if (dovalues) {
1085             PUTBACK;
1086             tmpstr = realhv ?
1087                      hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry);
1088             DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
1089                             (unsigned long)HeHASH(entry),
1090                             HvMAX(keys)+1,
1091                             (unsigned long)(HeHASH(entry) & HvMAX(keys))));
1092             SPAGAIN;
1093             XPUSHs(tmpstr);
1094         }
1095         PUTBACK;
1096     }
1097     return NORMAL;
1098 }
1099