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