pp.c

   1 /*    pp.c
   2  *
   3  *    Copyright (c) 1991-1994, 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  * "It's a big house this, and very peculiar.  Always a bit more to discover,
  12  * and no knowing what you'll find around a corner.  And Elves, sir!" --Samwise
  13  */
  14
  15 #include "EXTERN.h"
  16 #include "perl.h"
  17
  18 /*
  19  * Types used in bitwise operations.
  20  *
  21  * Normally we'd just use IV and UV.  However, some hardware and
  22  * software combinations (e.g. Alpha and current OSF/1) don't have a
  23  * floating-point type to use for NV that has adequate bits to fully
  24  * hold an IV/UV.  (In other words, sizeof(long) == sizeof(double).)
  25  *
  26  * It just so happens that "int" is the right size everywhere, at
  27  * least today.
  28  */
  29 typedef int IBW;
  30 typedef unsigned UBW;
  31
  32 static void doencodes _((SV *sv, char *s, I32 len));
  33
  34 /* variations on pp_null */
  35
  36 PP(pp_stub)
  37 {
  38     dSP;
  39     if (GIMME != G_ARRAY) {
  40         XPUSHs(&sv_undef);
  41     }
  42     RETURN;
  43 }
  44
  45 PP(pp_scalar)
  46 {
  47     return NORMAL;
  48 }
  49
  50 /* Pushy stuff. */
  51
  52 PP(pp_padav)
  53 {
  54     dSP; dTARGET;
  55     if (op->op_private & OPpLVAL_INTRO)
  56         SAVECLEARSV(curpad[op->op_targ]);
  57     EXTEND(SP, 1);
  58     if (op->op_flags & OPf_REF) {
  59         PUSHs(TARG);
  60         RETURN;
  61     }
  62     if (GIMME == G_ARRAY) {
  63         I32 maxarg = AvFILL((AV*)TARG) + 1;
  64         EXTEND(SP, maxarg);
  65         Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
  66         SP += maxarg;
  67     }
  68     else {
  69         SV* sv = sv_newmortal();
  70         I32 maxarg = AvFILL((AV*)TARG) + 1;
  71         sv_setiv(sv, maxarg);
  72         PUSHs(sv);
  73     }
  74     RETURN;
  75 }
  76
  77 PP(pp_padhv)
  78 {
  79     dSP; dTARGET;
  80     XPUSHs(TARG);
  81     if (op->op_private & OPpLVAL_INTRO)
  82         SAVECLEARSV(curpad[op->op_targ]);
  83     if (op->op_flags & OPf_REF)
  84         RETURN;
  85     if (GIMME == G_ARRAY) { /* array wanted */
  86         RETURNOP(do_kv(ARGS));
  87     }
  88     else {
  89         SV* sv = sv_newmortal();
  90         if (HvFILL((HV*)TARG)) {
  91             sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
  92             sv_setpv(sv, buf);
  93         }
  94         else
  95             sv_setiv(sv, 0);
  96         SETs(sv);
  97         RETURN;
  98     }
  99 }
 100
 101 PP(pp_padany)
 102 {
 103     DIE("NOT IMPL LINE %d",__LINE__);
 104 }
 105
 106 /* Translations. */
 107
 108 PP(pp_rv2gv)
 109 {
 110     dSP; dTOPss;
 111
 112     if (SvROK(sv)) {
 113       wasref:
 114         sv = SvRV(sv);
 115         if (SvTYPE(sv) == SVt_PVIO) {
 116             GV *gv = (GV*) sv_newmortal();
 117             gv_init(gv, 0, "", 0, 0);
 118             GvIOp(gv) = (IO *)sv;
 119             SvREFCNT_inc(sv);
 120             sv = (SV*) gv;
 121         } else if (SvTYPE(sv) != SVt_PVGV)
 122             DIE("Not a GLOB reference");
 123     }
 124     else {
 125         if (SvTYPE(sv) != SVt_PVGV) {
 126             char *sym;
 127
 128             if (SvGMAGICAL(sv)) {
 129                 mg_get(sv);
 130                 if (SvROK(sv))
 131                     goto wasref;
 132             }
 133             if (!SvOK(sv)) {
 134                 if (op->op_flags & OPf_REF ||
 135                     op->op_private & HINT_STRICT_REFS)
 136                     DIE(no_usym, "a symbol");
 137                 RETSETUNDEF;
 138             }
 139             sym = SvPV(sv, na);
 140             if (op->op_private & HINT_STRICT_REFS)
 141                 DIE(no_symref, sym, "a symbol");
 142             sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
 143         }
 144     }
 145     if (op->op_private & OPpLVAL_INTRO)
 146         save_gp((GV*)sv, !(op->op_flags & OPf_SPECIAL));
 147     SETs(sv);
 148     RETURN;
 149 }
 150
 151 PP(pp_rv2sv)
 152 {
 153     dSP; dTOPss;
 154
 155     if (SvROK(sv)) {
 156       wasref:
 157         sv = SvRV(sv);
 158         switch (SvTYPE(sv)) {
 159         case SVt_PVAV:
 160         case SVt_PVHV:
 161         case SVt_PVCV:
 162             DIE("Not a SCALAR reference");
 163         }
 164     }
 165     else {
 166         GV *gv = (GV*)sv;
 167         char *sym;
 168
 169         if (SvTYPE(gv) != SVt_PVGV) {
 170             if (SvGMAGICAL(sv)) {
 171                 mg_get(sv);
 172                 if (SvROK(sv))
 173                     goto wasref;
 174             }
 175             if (!SvOK(sv)) {
 176                 if (op->op_flags & OPf_REF ||
 177                     op->op_private & HINT_STRICT_REFS)
 178                     DIE(no_usym, "a SCALAR");
 179                 RETSETUNDEF;
 180             }
 181             sym = SvPV(sv, na);
 182             if (op->op_private & HINT_STRICT_REFS)
 183                 DIE(no_symref, sym, "a SCALAR");
 184             gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
 185         }
 186         sv = GvSV(gv);
 187     }
 188     if (op->op_flags & OPf_MOD) {
 189         if (op->op_private & OPpLVAL_INTRO)
 190             sv = save_scalar((GV*)TOPs);
 191         else if (op->op_private & OPpDEREF)
 192             provide_ref(op, sv);
 193     }
 194     SETs(sv);
 195     RETURN;
 196 }
 197
 198 PP(pp_av2arylen)
 199 {
 200     dSP;
 201     AV *av = (AV*)TOPs;
 202     SV *sv = AvARYLEN(av);
 203     if (!sv) {
 204         AvARYLEN(av) = sv = NEWSV(0,0);
 205         sv_upgrade(sv, SVt_IV);
 206         sv_magic(sv, (SV*)av, '#', Nullch, 0);
 207     }
 208     SETs(sv);
 209     RETURN;
 210 }
 211
 212 PP(pp_pos)
 213 {
 214     dSP; dTARGET; dPOPss;
 215
 216     if (op->op_flags & OPf_MOD) {
 217         if (SvTYPE(TARG) < SVt_PVLV) {
 218             sv_upgrade(TARG, SVt_PVLV);
 219             sv_magic(TARG, Nullsv, '.', Nullch, 0);
 220         }
 221
 222         LvTYPE(TARG) = '.';
 223         LvTARG(TARG) = sv;
 224         PUSHs(TARG);    /* no SvSETMAGIC */
 225         RETURN;
 226     }
 227     else {
 228         MAGIC* mg;
 229
 230         if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
 231             mg = mg_find(sv, 'g');
 232             if (mg && mg->mg_len >= 0) {
 233                 PUSHi(mg->mg_len + curcop->cop_arybase);
 234                 RETURN;
 235             }
 236         }
 237         RETPUSHUNDEF;
 238     }
 239 }
 240
 241 PP(pp_rv2cv)
 242 {
 243     dSP;
 244     GV *gv;
 245     HV *stash;
 246
 247     /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
 248     /* (But not in defined().) */
 249     CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
 250
 251     if (!cv)
 252         cv = (CV*)&sv_undef;
 253     SETs((SV*)cv);
 254     RETURN;
 255 }
 256
 257 PP(pp_prototype)
 258 {
 259     dSP;
 260     CV *cv;
 261     HV *stash;
 262     GV *gv;
 263     SV *ret;
 264
 265     ret = &sv_undef;
 266     cv = sv_2cv(TOPs, &stash, &gv, FALSE);
 267     if (cv && SvPOK(cv))
 268         ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv)));
 269     SETs(ret);
 270     RETURN;
 271 }
 272
 273 PP(pp_anoncode)
 274 {
 275     dSP;
 276     CV* cv = (CV*)curpad[op->op_targ];
 277     if (CvCLONE(cv))
 278         cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
 279     EXTEND(SP,1);
 280     PUSHs((SV*)cv);
 281     RETURN;
 282 }
 283
 284 PP(pp_srefgen)
 285 {
 286     dSP; dTOPss;
 287     SV* rv;
 288     rv = sv_newmortal();
 289     sv_upgrade(rv, SVt_RV);
 290     if (SvPADTMP(sv))
 291         sv = newSVsv(sv);
 292     else {
 293         SvTEMP_off(sv);
 294         (void)SvREFCNT_inc(sv);
 295     }
 296     SvRV(rv) = sv;
 297     SvROK_on(rv);
 298     SETs(rv);
 299     RETURN;
 300 }
 301
 302 PP(pp_refgen)
 303 {
 304     dSP; dMARK;
 305     SV* sv;
 306     SV* rv;
 307     if (GIMME != G_ARRAY) {
 308         MARK[1] = *SP;
 309         SP = MARK + 1;
 310     }
 311     EXTEND_MORTAL(SP - MARK);
 312     while (MARK < SP) {
 313         sv = *++MARK;
 314         rv = sv_newmortal();
 315         sv_upgrade(rv, SVt_RV);
 316         if (SvPADTMP(sv))
 317             sv = newSVsv(sv);
 318         else {
 319             SvTEMP_off(sv);
 320             (void)SvREFCNT_inc(sv);
 321         }
 322         SvRV(rv) = sv;
 323         SvROK_on(rv);
 324         *MARK = rv;
 325     }
 326     RETURN;
 327 }
 328
 329 PP(pp_ref)
 330 {
 331     dSP; dTARGET;
 332     SV *sv;
 333     char *pv;
 334
 335     sv = POPs;
 336
 337     if (sv && SvGMAGICAL(sv))
 338         mg_get(sv);
 339
 340     if (!sv || !SvROK(sv))
 341         RETPUSHNO;
 342
 343     sv = SvRV(sv);
 344     pv = sv_reftype(sv,TRUE);
 345     PUSHp(pv, strlen(pv));
 346     RETURN;
 347 }
 348
 349 PP(pp_bless)
 350 {
 351     dSP;
 352     HV *stash;
 353
 354     if (MAXARG == 1)
 355         stash = curcop->cop_stash;
 356     else
 357         stash = gv_stashsv(POPs, TRUE);
 358
 359     (void)sv_bless(TOPs, stash);
 360     RETURN;
 361 }
 362
 363 /* Pattern matching */
 364
 365 PP(pp_study)
 366 {
 367     dSP; dPOPss;
 368     register unsigned char *s;
 369     register I32 pos;
 370     register I32 ch;
 371     register I32 *sfirst;
 372     register I32 *snext;
 373     I32 retval;
 374     STRLEN len;
 375
 376     s = (unsigned char*)(SvPV(sv, len));
 377     pos = len;
 378     if (sv == lastscream)
 379         SvSCREAM_off(sv);
 380     else {
 381         if (lastscream) {
 382             SvSCREAM_off(lastscream);
 383             SvREFCNT_dec(lastscream);
 384         }
 385         lastscream = SvREFCNT_inc(sv);
 386     }
 387     if (pos <= 0) {
 388         retval = 0;
 389         goto ret;
 390     }
 391     if (pos > maxscream) {
 392         if (maxscream < 0) {
 393             maxscream = pos + 80;
 394             New(301, screamfirst, 256, I32);
 395             New(302, screamnext, maxscream, I32);
 396         }
 397         else {
 398             maxscream = pos + pos / 4;
 399             Renew(screamnext, maxscream, I32);
 400         }
 401     }
 402
 403     sfirst = screamfirst;
 404     snext = screamnext;
 405
 406     if (!sfirst || !snext)
 407         DIE("do_study: out of memory");
 408
 409     for (ch = 256; ch; --ch)
 410         *sfirst++ = -1;
 411     sfirst -= 256;
 412
 413     while (--pos >= 0) {
 414         ch = s[pos];
 415         if (sfirst[ch] >= 0)
 416             snext[pos] = sfirst[ch] - pos;
 417         else
 418             snext[pos] = -pos;
 419         sfirst[ch] = pos;
 420     }
 421
 422     SvSCREAM_on(sv);
 423     sv_magic(sv, Nullsv, 'g', Nullch, 0);       /* piggyback on m//g magic */
 424     retval = 1;
 425   ret:
 426     XPUSHs(sv_2mortal(newSViv((I32)retval)));
 427     RETURN;
 428 }
 429
 430 PP(pp_trans)
 431 {
 432     dSP; dTARG;
 433     SV *sv;
 434
 435     if (op->op_flags & OPf_STACKED)
 436         sv = POPs;
 437     else {
 438         sv = GvSV(defgv);
 439         EXTEND(SP,1);
 440     }
 441     TARG = sv_newmortal();
 442     PUSHi(do_trans(sv, op));
 443     RETURN;
 444 }
 445
 446 /* Lvalue operators. */
 447
 448 PP(pp_schop)
 449 {
 450     dSP; dTARGET;
 451     do_chop(TARG, TOPs);
 452     SETTARG;
 453     RETURN;
 454 }
 455
 456 PP(pp_chop)
 457 {
 458     dSP; dMARK; dTARGET;
 459     while (SP > MARK)
 460         do_chop(TARG, POPs);
 461     PUSHTARG;
 462     RETURN;
 463 }
 464
 465 PP(pp_schomp)
 466 {
 467     dSP; dTARGET;
 468     SETi(do_chomp(TOPs));
 469     RETURN;
 470 }
 471
 472 PP(pp_chomp)
 473 {
 474     dSP; dMARK; dTARGET;
 475     register I32 count = 0;
 476
 477     while (SP > MARK)
 478         count += do_chomp(POPs);
 479     PUSHi(count);
 480     RETURN;
 481 }
 482
 483 PP(pp_defined)
 484 {
 485     dSP;
 486     register SV* sv;
 487
 488     sv = POPs;
 489     if (!sv || !SvANY(sv))
 490         RETPUSHNO;
 491     switch (SvTYPE(sv)) {
 492     case SVt_PVAV:
 493         if (AvMAX(sv) >= 0 || SvRMAGICAL(sv))
 494             RETPUSHYES;
 495         break;
 496     case SVt_PVHV:
 497         if (HvARRAY(sv) || SvRMAGICAL(sv))
 498             RETPUSHYES;
 499         break;
 500     case SVt_PVCV:
 501         if (CvROOT(sv) || CvXSUB(sv))
 502             RETPUSHYES;
 503         break;
 504     default:
 505         if (SvGMAGICAL(sv))
 506             mg_get(sv);
 507         if (SvOK(sv))
 508             RETPUSHYES;
 509     }
 510     RETPUSHNO;
 511 }
 512
 513 PP(pp_undef)
 514 {
 515     dSP;
 516     SV *sv;
 517
 518     if (!op->op_private)
 519         RETPUSHUNDEF;
 520
 521     sv = POPs;
 522     if (!sv)
 523         RETPUSHUNDEF;
 524
 525     if (SvTHINKFIRST(sv)) {
 526         if (SvREADONLY(sv))
 527             RETPUSHUNDEF;
 528         if (SvROK(sv))
 529             sv_unref(sv);
 530     }
 531
 532     switch (SvTYPE(sv)) {
 533     case SVt_NULL:
 534         break;
 535     case SVt_PVAV:
 536         av_undef((AV*)sv);
 537         break;
 538     case SVt_PVHV:
 539         hv_undef((HV*)sv);
 540         break;
 541     case SVt_PVCV:
 542         cv_undef((CV*)sv);
 543         sub_generation++;
 544         break;
 545     case SVt_PVGV:
 546         if (SvFAKE(sv)) {
 547             sv_setsv(sv, &sv_undef);
 548             break;
 549         }
 550     default:
 551         if (SvPOK(sv) && SvLEN(sv)) {
 552             (void)SvOOK_off(sv);
 553             Safefree(SvPVX(sv));
 554             SvPV_set(sv, Nullch);
 555             SvLEN_set(sv, 0);
 556         }
 557         (void)SvOK_off(sv);
 558         SvSETMAGIC(sv);
 559     }
 560
 561     RETPUSHUNDEF;
 562 }
 563
 564 PP(pp_predec)
 565 {
 566     dSP;
 567     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
 568         SvIVX(TOPs) != IV_MIN)
 569     {
 570         --SvIVX(TOPs);
 571         SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
 572     }
 573     else
 574         sv_dec(TOPs);
 575     SvSETMAGIC(TOPs);
 576     return NORMAL;
 577 }
 578
 579 PP(pp_postinc)
 580 {
 581     dSP; dTARGET;
 582     sv_setsv(TARG, TOPs);
 583     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
 584         SvIVX(TOPs) != IV_MAX)
 585     {
 586         ++SvIVX(TOPs);
 587         SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
 588     }
 589     else
 590         sv_inc(TOPs);
 591     SvSETMAGIC(TOPs);
 592     if (!SvOK(TARG))
 593         sv_setiv(TARG, 0);
 594     SETs(TARG);
 595     return NORMAL;
 596 }
 597
 598 PP(pp_postdec)
 599 {
 600     dSP; dTARGET;
 601     sv_setsv(TARG, TOPs);
 602     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
 603         SvIVX(TOPs) != IV_MIN)
 604     {
 605         --SvIVX(TOPs);
 606         SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
 607     }
 608     else
 609         sv_dec(TOPs);
 610     SvSETMAGIC(TOPs);
 611     SETs(TARG);
 612     return NORMAL;
 613 }
 614
 615 /* Ordinary operators. */
 616
 617 PP(pp_pow)
 618 {
 619     dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
 620     {
 621       dPOPTOPnnrl;
 622       SETn( pow( left, right) );
 623       RETURN;
 624     }
 625 }
 626
 627 PP(pp_multiply)
 628 {
 629     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
 630     {
 631       dPOPTOPnnrl;
 632       SETn( left * right );
 633       RETURN;
 634     }
 635 }
 636
 637 PP(pp_divide)
 638 {
 639     dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
 640     {
 641       dPOPnv;
 642       if (value == 0.0)
 643         DIE("Illegal division by zero");
 644 #ifdef SLOPPYDIVIDE
 645       /* insure that 20./5. == 4. */
 646       {
 647         double x;
 648         I32    k;
 649         x =  POPn;
 650         if ((double)I_32(x)     == x &&
 651             (double)I_32(value) == value &&
 652             (k = I_32(x)/I_32(value))*I_32(value) == I_32(x)) {
 653             value = k;
 654         } else {
 655             value = x/value;
 656         }
 657       }
 658 #else
 659       value = POPn / value;
 660 #endif
 661       PUSHn( value );
 662       RETURN;
 663     }
 664 }
 665
 666 PP(pp_modulo)
 667 {
 668     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
 669     {
 670       register UV right;
 671
 672       right = POPu;
 673       if (!right)
 674         DIE("Illegal modulus zero");
 675
 676       if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
 677         register IV left = SvIVX(TOPs);
 678         if (left < 0)
 679           SETu( (right - ((UV)(-left) - 1) % right) - 1 );
 680         else
 681           SETi( left % right );
 682       }
 683       else {
 684         register double left = TOPn;
 685         if (left < 0.0)
 686           SETu( (right - (U_V(-left) - 1) % right) - 1 );
 687         else
 688           SETu( U_V(left) % right );
 689       }
 690       RETURN;
 691     }
 692 }
 693
 694 PP(pp_repeat)
 695 {
 696   dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
 697   {
 698     register I32 count = POPi;
 699     if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
 700         dMARK;
 701         I32 items = SP - MARK;
 702         I32 max;
 703
 704         max = items * count;
 705         MEXTEND(MARK, max);
 706         if (count > 1) {
 707             while (SP > MARK) {
 708                 if (*SP)
 709                     SvTEMP_off((*SP));
 710                 SP--;
 711             }
 712             MARK++;
 713             repeatcpy((char*)(MARK + items), (char*)MARK,
 714                 items * sizeof(SV*), count - 1);
 715             SP += max;
 716         }
 717         else if (count <= 0)
 718             SP -= items;
 719     }
 720     else {      /* Note: mark already snarfed by pp_list */
 721         SV *tmpstr;
 722         STRLEN len;
 723
 724         tmpstr = POPs;
 725         if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
 726             if (SvREADONLY(tmpstr) && curcop != &compiling)
 727                 DIE("Can't x= to readonly value");
 728             if (SvROK(tmpstr))
 729                 sv_unref(tmpstr);
 730         }
 731         SvSetSV(TARG, tmpstr);
 732         SvPV_force(TARG, len);
 733         if (count >= 1) {
 734             SvGROW(TARG, (count * len) + 1);
 735             if (count > 1)
 736                 repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
 737             SvCUR(TARG) *= count;
 738             *SvEND(TARG) = '\0';
 739             (void)SvPOK_only(TARG);
 740         }
 741         else
 742             sv_setsv(TARG, &sv_no);
 743         PUSHTARG;
 744     }
 745     RETURN;
 746   }
 747 }
 748
 749 PP(pp_subtract)
 750 {
 751     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
 752     {
 753       dPOPTOPnnrl;
 754       SETn( left - right );
 755       RETURN;
 756     }
 757 }
 758
 759 PP(pp_left_shift)
 760 {
 761     dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
 762     {
 763       IBW shift = POPi;
 764       if (op->op_private & HINT_INTEGER) {
 765         IBW i = TOPi;
 766         SETi( i << shift );
 767       }
 768       else {
 769         UBW u = TOPu;
 770         SETu( u << shift );
 771       }
 772       RETURN;
 773     }
 774 }
 775
 776 PP(pp_right_shift)
 777 {
 778     dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
 779     {
 780       IBW shift = POPi;
 781       if (op->op_private & HINT_INTEGER) {
 782         IBW i = TOPi;
 783         SETi( i >> shift );
 784       }
 785       else {
 786         UBW u = TOPu;
 787         SETu( u >> shift );
 788       }
 789       RETURN;
 790     }
 791 }
 792
 793 PP(pp_lt)
 794 {
 795     dSP; tryAMAGICbinSET(lt,0);
 796     {
 797       dPOPnv;
 798       SETs((TOPn < value) ? &sv_yes : &sv_no);
 799       RETURN;
 800     }
 801 }
 802
 803 PP(pp_gt)
 804 {
 805     dSP; tryAMAGICbinSET(gt,0);
 806     {
 807       dPOPnv;
 808       SETs((TOPn > value) ? &sv_yes : &sv_no);
 809       RETURN;
 810     }
 811 }
 812
 813 PP(pp_le)
 814 {
 815     dSP; tryAMAGICbinSET(le,0);
 816     {
 817       dPOPnv;
 818       SETs((TOPn <= value) ? &sv_yes : &sv_no);
 819       RETURN;
 820     }
 821 }
 822
 823 PP(pp_ge)
 824 {
 825     dSP; tryAMAGICbinSET(ge,0);
 826     {
 827       dPOPnv;
 828       SETs((TOPn >= value) ? &sv_yes : &sv_no);
 829       RETURN;
 830     }
 831 }
 832
 833 PP(pp_ne)
 834 {
 835     dSP; tryAMAGICbinSET(ne,0);
 836     {
 837       dPOPnv;
 838       SETs((TOPn != value) ? &sv_yes : &sv_no);
 839       RETURN;
 840     }
 841 }
 842
 843 PP(pp_ncmp)
 844 {
 845     dSP; dTARGET; tryAMAGICbin(ncmp,0);
 846     {
 847       dPOPTOPnnrl;
 848       I32 value;
 849
 850       if (left > right)
 851         value = 1;
 852       else if (left < right)
 853         value = -1;
 854       else
 855         value = 0;
 856       SETi(value);
 857       RETURN;
 858     }
 859 }
 860
 861 PP(pp_slt)
 862 {
 863     dSP; tryAMAGICbinSET(slt,0);
 864     {
 865       dPOPTOPssrl;
 866       int cmp = ((op->op_private & OPpLOCALE)
 867                  ? sv_cmp_locale(left, right)
 868                  : sv_cmp(left, right));
 869       SETs( cmp < 0 ? &sv_yes : &sv_no );
 870       RETURN;
 871     }
 872 }
 873
 874 PP(pp_sgt)
 875 {
 876     dSP; tryAMAGICbinSET(sgt,0);
 877     {
 878       dPOPTOPssrl;
 879       int cmp = ((op->op_private & OPpLOCALE)
 880                  ? sv_cmp_locale(left, right)
 881                  : sv_cmp(left, right));
 882       SETs( cmp > 0 ? &sv_yes : &sv_no );
 883       RETURN;
 884     }
 885 }
 886
 887 PP(pp_sle)
 888 {
 889     dSP; tryAMAGICbinSET(sle,0);
 890     {
 891       dPOPTOPssrl;
 892       int cmp = ((op->op_private & OPpLOCALE)
 893                  ? sv_cmp_locale(left, right)
 894                  : sv_cmp(left, right));
 895       SETs( cmp <= 0 ? &sv_yes : &sv_no );
 896       RETURN;
 897     }
 898 }
 899
 900 PP(pp_sge)
 901 {
 902     dSP; tryAMAGICbinSET(sge,0);
 903     {
 904       dPOPTOPssrl;
 905       int cmp = ((op->op_private & OPpLOCALE)
 906                  ? sv_cmp_locale(left, right)
 907                  : sv_cmp(left, right));
 908       SETs( cmp >= 0 ? &sv_yes : &sv_no );
 909       RETURN;
 910     }
 911 }
 912
 913 PP(pp_seq)
 914 {
 915     dSP; tryAMAGICbinSET(seq,0);
 916     {
 917       dPOPTOPssrl;
 918       SETs( sv_eq(left, right) ? &sv_yes : &sv_no );
 919       RETURN;
 920     }
 921 }
 922
 923 PP(pp_sne)
 924 {
 925     dSP; tryAMAGICbinSET(sne,0);
 926     {
 927       dPOPTOPssrl;
 928       SETs( !sv_eq(left, right) ? &sv_yes : &sv_no );
 929       RETURN;
 930     }
 931 }
 932
 933 PP(pp_scmp)
 934 {
 935     dSP; dTARGET;  tryAMAGICbin(scmp,0);
 936     {
 937       dPOPTOPssrl;
 938       int cmp = ((op->op_private & OPpLOCALE)
 939                  ? sv_cmp_locale(left, right)
 940                  : sv_cmp(left, right));
 941       SETi( cmp );
 942       RETURN;
 943     }
 944 }
 945
 946 PP(pp_bit_and)
 947 {
 948     dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
 949     {
 950       dPOPTOPssrl;
 951       if (SvNIOKp(left) || SvNIOKp(right)) {
 952         if (op->op_private & HINT_INTEGER) {
 953           IBW value = SvIV(left) & SvIV(right);
 954           SETi( value );
 955         }
 956         else {
 957           UBW value = SvUV(left) & SvUV(right);
 958           SETu( value );
 959         }
 960       }
 961       else {
 962         do_vop(op->op_type, TARG, left, right);
 963         SETTARG;
 964       }
 965       RETURN;
 966     }
 967 }
 968
 969 PP(pp_bit_xor)
 970 {
 971     dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
 972     {
 973       dPOPTOPssrl;
 974       if (SvNIOKp(left) || SvNIOKp(right)) {
 975         if (op->op_private & HINT_INTEGER) {
 976           IBW value = SvIV(left) ^ SvIV(right);
 977           SETi( value );
 978         }
 979         else {
 980           UBW value = SvUV(left) ^ SvUV(right);
 981           SETu( value );
 982         }
 983       }
 984       else {
 985         do_vop(op->op_type, TARG, left, right);
 986         SETTARG;
 987       }
 988       RETURN;
 989     }
 990 }
 991
 992 PP(pp_bit_or)
 993 {
 994     dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
 995     {
 996       dPOPTOPssrl;
 997       if (SvNIOKp(left) || SvNIOKp(right)) {
 998         if (op->op_private & HINT_INTEGER) {
 999           IBW value = SvIV(left) | SvIV(right);
1000           SETi( value );
1001         }
1002         else {
1003           UBW value = SvUV(left) | SvUV(right);
1004           SETu( value );
1005         }
1006       }
1007       else {
1008         do_vop(op->op_type, TARG, left, right);
1009         SETTARG;
1010       }
1011       RETURN;
1012     }
1013 }
1014
1015 PP(pp_negate)
1016 {
1017     dSP; dTARGET; tryAMAGICun(neg);
1018     {
1019         dTOPss;
1020         if (SvGMAGICAL(sv))
1021             mg_get(sv);
1022         if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN)
1023             SETi(-SvIVX(sv));
1024         else if (SvNIOKp(sv))
1025             SETn(-SvNV(sv));
1026         else if (SvPOKp(sv)) {
1027             STRLEN len;
1028             char *s = SvPV(sv, len);
1029             if (isIDFIRST(*s)) {
1030                 sv_setpvn(TARG, "-", 1);
1031                 sv_catsv(TARG, sv);
1032             }
1033             else if (*s == '+' || *s == '-') {
1034                 sv_setsv(TARG, sv);
1035                 *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
1036             }
1037             else
1038                 sv_setnv(TARG, -SvNV(sv));
1039             SETTARG;
1040         }
1041         else
1042             SETn(-SvNV(sv));
1043     }
1044     RETURN;
1045 }
1046
1047 PP(pp_not)
1048 {
1049 #ifdef OVERLOAD
1050     dSP; tryAMAGICunSET(not);
1051 #endif /* OVERLOAD */
1052     *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
1053     return NORMAL;
1054 }
1055
1056 PP(pp_complement)
1057 {
1058     dSP; dTARGET; tryAMAGICun(compl);
1059     {
1060       dTOPss;
1061       if (SvNIOKp(sv)) {
1062         if (op->op_private & HINT_INTEGER) {
1063           IBW value = ~SvIV(sv);
1064           SETi( value );
1065         }
1066         else {
1067           UBW value = ~SvUV(sv);
1068           SETu( value );
1069         }
1070       }
1071       else {
1072         register char *tmps;
1073         register long *tmpl;
1074         register I32 anum;
1075         STRLEN len;
1076
1077         SvSetSV(TARG, sv);
1078         tmps = SvPV_force(TARG, len);
1079         anum = len;
1080 #ifdef LIBERAL
1081         for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
1082             *tmps = ~*tmps;
1083         tmpl = (long*)tmps;
1084         for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
1085             *tmpl = ~*tmpl;
1086         tmps = (char*)tmpl;
1087 #endif
1088         for ( ; anum > 0; anum--, tmps++)
1089             *tmps = ~*tmps;
1090
1091         SETs(TARG);
1092       }
1093       RETURN;
1094     }
1095 }
1096
1097 /* integer versions of some of the above */
1098
1099 PP(pp_i_multiply)
1100 {
1101     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
1102     {
1103       dPOPTOPiirl;
1104       SETi( left * right );
1105       RETURN;
1106     }
1107 }
1108
1109 PP(pp_i_divide)
1110 {
1111     dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
1112     {
1113       dPOPiv;
1114       if (value == 0)
1115         DIE("Illegal division by zero");
1116       value = POPi / value;
1117       PUSHi( value );
1118       RETURN;
1119     }
1120 }
1121
1122 PP(pp_i_modulo)
1123 {
1124     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
1125     {
1126       dPOPTOPiirl;
1127       SETi( left % right );
1128       RETURN;
1129     }
1130 }
1131
1132 PP(pp_i_add)
1133 {
1134     dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
1135     {
1136       dPOPTOPiirl;
1137       SETi( left + right );
1138       RETURN;
1139     }
1140 }
1141
1142 PP(pp_i_subtract)
1143 {
1144     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
1145     {
1146       dPOPTOPiirl;
1147       SETi( left - right );
1148       RETURN;
1149     }
1150 }
1151
1152 PP(pp_i_lt)
1153 {
1154     dSP; tryAMAGICbinSET(lt,0);
1155     {
1156       dPOPTOPiirl;
1157       SETs((left < right) ? &sv_yes : &sv_no);
1158       RETURN;
1159     }
1160 }
1161
1162 PP(pp_i_gt)
1163 {
1164     dSP; tryAMAGICbinSET(gt,0);
1165     {
1166       dPOPTOPiirl;
1167       SETs((left > right) ? &sv_yes : &sv_no);
1168       RETURN;
1169     }
1170 }
1171
1172 PP(pp_i_le)
1173 {
1174     dSP; tryAMAGICbinSET(le,0);
1175     {
1176       dPOPTOPiirl;
1177       SETs((left <= right) ? &sv_yes : &sv_no);
1178       RETURN;
1179     }
1180 }
1181
1182 PP(pp_i_ge)
1183 {
1184     dSP; tryAMAGICbinSET(ge,0);
1185     {
1186       dPOPTOPiirl;
1187       SETs((left >= right) ? &sv_yes : &sv_no);
1188       RETURN;
1189     }
1190 }
1191
1192 PP(pp_i_eq)
1193 {
1194     dSP; tryAMAGICbinSET(eq,0);
1195     {
1196       dPOPTOPiirl;
1197       SETs((left == right) ? &sv_yes : &sv_no);
1198       RETURN;
1199     }
1200 }
1201
1202 PP(pp_i_ne)
1203 {
1204     dSP; tryAMAGICbinSET(ne,0);
1205     {
1206       dPOPTOPiirl;
1207       SETs((left != right) ? &sv_yes : &sv_no);
1208       RETURN;
1209     }
1210 }
1211
1212 PP(pp_i_ncmp)
1213 {
1214     dSP; dTARGET; tryAMAGICbin(ncmp,0);
1215     {
1216       dPOPTOPiirl;
1217       I32 value;
1218
1219       if (left > right)
1220         value = 1;
1221       else if (left < right)
1222         value = -1;
1223       else
1224         value = 0;
1225       SETi(value);
1226       RETURN;
1227     }
1228 }
1229
1230 PP(pp_i_negate)
1231 {
1232     dSP; dTARGET; tryAMAGICun(neg);
1233     SETi(-TOPi);
1234     RETURN;
1235 }
1236
1237 /* High falutin' math. */
1238
1239 PP(pp_atan2)
1240 {
1241     dSP; dTARGET; tryAMAGICbin(atan2,0);
1242     {
1243       dPOPTOPnnrl;
1244       SETn(atan2(left, right));
1245       RETURN;
1246     }
1247 }
1248
1249 PP(pp_sin)
1250 {
1251     dSP; dTARGET; tryAMAGICun(sin);
1252     {
1253       double value;
1254       value = POPn;
1255       value = sin(value);
1256       XPUSHn(value);
1257       RETURN;
1258     }
1259 }
1260
1261 PP(pp_cos)
1262 {
1263     dSP; dTARGET; tryAMAGICun(cos);
1264     {
1265       double value;
1266       value = POPn;
1267       value = cos(value);
1268       XPUSHn(value);
1269       RETURN;
1270     }
1271 }
1272
1273 PP(pp_rand)
1274 {
1275     dSP; dTARGET;
1276     double value;
1277     if (MAXARG < 1)
1278         value = 1.0;
1279     else
1280         value = POPn;
1281     if (value == 0.0)
1282         value = 1.0;
1283 #if RANDBITS == 31
1284     value = rand() * value / 2147483648.0;
1285 #else
1286 #if RANDBITS == 16
1287     value = rand() * value / 65536.0;
1288 #else
1289 #if RANDBITS == 15
1290     value = rand() * value / 32768.0;
1291 #else
1292     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1293 #endif
1294 #endif
1295 #endif
1296     XPUSHn(value);
1297     RETURN;
1298 }
1299
1300 PP(pp_srand)
1301 {
1302     dSP;
1303     I32 anum;
1304
1305     if (MAXARG < 1) {
1306 #ifdef VMS
1307 #  include <starlet.h>
1308         unsigned int when[2];
1309         _ckvmssts(sys$gettim(when));
1310         anum = when[0] ^ when[1];
1311 #else
1312 #  ifdef HAS_GETTIMEOFDAY
1313         struct timeval when;
1314         gettimeofday(&when,(struct timezone *) 0);
1315         anum = when.tv_sec ^ when.tv_usec;
1316 #  else
1317         Time_t when;
1318         (void)time(&when);
1319         anum = when;
1320 #  endif
1321 #endif
1322 #if !defined(PLAN9) /* XXX Plan9 assembler chokes on this; fix coming soon  */
1323                     /*     17-Jul-1996  bailey@genetics.upenn.edu           */
1324         /* What is a good hashing algorithm here? */
1325         anum ^= (  (  269 * (U32)getpid())
1326                  ^ (26107 * (U32)&when)
1327                  ^ (73819 * (U32)stack_sp));
1328 #endif
1329     }
1330     else
1331         anum = POPi;
1332     (void)srand(anum);
1333     EXTEND(SP, 1);
1334     RETPUSHYES;
1335 }
1336
1337 PP(pp_exp)
1338 {
1339     dSP; dTARGET; tryAMAGICun(exp);
1340     {
1341       double value;
1342       value = POPn;
1343       value = exp(value);
1344       XPUSHn(value);
1345       RETURN;
1346     }
1347 }
1348
1349 PP(pp_log)
1350 {
1351     dSP; dTARGET; tryAMAGICun(log);
1352     {
1353       double value;
1354       value = POPn;
1355       if (value <= 0.0) {
1356         SET_NUMERIC_STANDARD();
1357         DIE("Can't take log of %g", value);
1358       }
1359       value = log(value);
1360       XPUSHn(value);
1361       RETURN;
1362     }
1363 }
1364
1365 PP(pp_sqrt)
1366 {
1367     dSP; dTARGET; tryAMAGICun(sqrt);
1368     {
1369       double value;
1370       value = POPn;
1371       if (value < 0.0) {
1372         SET_NUMERIC_STANDARD();
1373         DIE("Can't take sqrt of %g", value);
1374       }
1375       value = sqrt(value);
1376       XPUSHn(value);
1377       RETURN;
1378     }
1379 }
1380
1381 PP(pp_int)
1382 {
1383     dSP; dTARGET;
1384     double value;
1385     value = POPn;
1386     if (value >= 0.0)
1387         (void)modf(value, &value);
1388     else {
1389         (void)modf(-value, &value);
1390         value = -value;
1391     }
1392     XPUSHn(value);
1393     RETURN;
1394 }
1395
1396 PP(pp_abs)
1397 {
1398     dSP; dTARGET; tryAMAGICun(abs);
1399     {
1400       double value;
1401       value = POPn;
1402
1403       if (value < 0.0)
1404         value = -value;
1405
1406       XPUSHn(value);
1407       RETURN;
1408     }
1409 }
1410
1411 PP(pp_hex)
1412 {
1413     dSP; dTARGET;
1414     char *tmps;
1415     I32 argtype;
1416
1417     tmps = POPp;
1418     XPUSHu(scan_hex(tmps, 99, &argtype));
1419     RETURN;
1420 }
1421
1422 PP(pp_oct)
1423 {
1424     dSP; dTARGET;
1425     UV value;
1426     I32 argtype;
1427     char *tmps;
1428
1429     tmps = POPp;
1430     while (*tmps && isSPACE(*tmps))
1431         tmps++;
1432     if (*tmps == '0')
1433         tmps++;
1434     if (*tmps == 'x')
1435         value = scan_hex(++tmps, 99, &argtype);
1436     else
1437         value = scan_oct(tmps, 99, &argtype);
1438     XPUSHu(value);
1439     RETURN;
1440 }
1441
1442 /* String stuff. */
1443
1444 PP(pp_length)
1445 {
1446     dSP; dTARGET;
1447     SETi( sv_len(TOPs) );
1448     RETURN;
1449 }
1450
1451 PP(pp_substr)
1452 {
1453     dSP; dTARGET;
1454     SV *sv;
1455     I32 len;
1456     STRLEN curlen;
1457     I32 pos;
1458     I32 rem;
1459     I32 lvalue = op->op_flags & OPf_MOD;
1460     char *tmps;
1461     I32 arybase = curcop->cop_arybase;
1462
1463     if (MAXARG > 2)
1464         len = POPi;
1465     pos = POPi - arybase;
1466     sv = POPs;
1467     tmps = SvPV(sv, curlen);
1468     if (pos < 0)
1469         pos += curlen + arybase;
1470     if (pos < 0 || pos > curlen) {
1471         if (dowarn || lvalue)
1472             warn("substr outside of string");
1473         RETPUSHUNDEF;
1474     }
1475     else {
1476         if (MAXARG < 3)
1477             len = curlen;
1478         else if (len < 0) {
1479             len += curlen - pos;
1480             if (len < 0)
1481                 len = 0;
1482         }
1483         tmps += pos;
1484         rem = curlen - pos;     /* rem=how many bytes left*/
1485         if (rem > len)
1486             rem = len;
1487         sv_setpvn(TARG, tmps, rem);
1488         if (lvalue) {                   /* it's an lvalue! */
1489             if (!SvGMAGICAL(sv)) {
1490                 if (SvROK(sv)) {
1491                     SvPV_force(sv,na);
1492                     if (dowarn)
1493                         warn("Attempt to use reference as lvalue in substr");
1494                 }
1495                 if (SvOK(sv))           /* is it defined ? */
1496                     (void)SvPOK_only(sv);
1497                 else
1498                     sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
1499             }
1500
1501             if (SvTYPE(TARG) < SVt_PVLV) {
1502                 sv_upgrade(TARG, SVt_PVLV);
1503                 sv_magic(TARG, Nullsv, 'x', Nullch, 0);
1504             }
1505
1506             LvTYPE(TARG) = 'x';
1507             LvTARG(TARG) = sv;
1508             LvTARGOFF(TARG) = pos;
1509             LvTARGLEN(TARG) = rem;
1510         }
1511     }
1512     PUSHs(TARG);                /* avoid SvSETMAGIC here */
1513     RETURN;
1514 }
1515
1516 PP(pp_vec)
1517 {
1518     dSP; dTARGET;
1519     register I32 size = POPi;
1520     register I32 offset = POPi;
1521     register SV *src = POPs;
1522     I32 lvalue = op->op_flags & OPf_MOD;
1523     STRLEN srclen;
1524     unsigned char *s = (unsigned char*)SvPV(src, srclen);
1525     unsigned long retnum;
1526     I32 len;
1527
1528     offset *= size;             /* turn into bit offset */
1529     len = (offset + size + 7) / 8;
1530     if (offset < 0 || size < 1)
1531         retnum = 0;
1532     else {
1533         if (lvalue) {                      /* it's an lvalue! */
1534             if (SvTYPE(TARG) < SVt_PVLV) {
1535                 sv_upgrade(TARG, SVt_PVLV);
1536                 sv_magic(TARG, Nullsv, 'v', Nullch, 0);
1537             }
1538
1539             LvTYPE(TARG) = 'v';
1540             LvTARG(TARG) = src;
1541             LvTARGOFF(TARG) = offset;
1542             LvTARGLEN(TARG) = size;
1543         }
1544         if (len > srclen) {
1545             if (size <= 8)
1546                 retnum = 0;
1547             else {
1548                 offset >>= 3;
1549                 if (size == 16) {
1550                     if (offset >= srclen)
1551                         retnum = 0;
1552                     else
1553                         retnum = (unsigned long) s[offset] << 8;
1554                 }
1555                 else if (size == 32) {
1556                     if (offset >= srclen)
1557                         retnum = 0;
1558                     else if (offset + 1 >= srclen)
1559                         retnum = (unsigned long) s[offset] << 24;
1560                     else if (offset + 2 >= srclen)
1561                         retnum = ((unsigned long) s[offset] << 24) +
1562                             ((unsigned long) s[offset + 1] << 16);
1563                     else
1564                         retnum = ((unsigned long) s[offset] << 24) +
1565                             ((unsigned long) s[offset + 1] << 16) +
1566                             (s[offset + 2] << 8);
1567                 }
1568             }
1569         }
1570         else if (size < 8)
1571             retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1572         else {
1573             offset >>= 3;
1574             if (size == 8)
1575                 retnum = s[offset];
1576             else if (size == 16)
1577                 retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
1578             else if (size == 32)
1579                 retnum = ((unsigned long) s[offset] << 24) +
1580                         ((unsigned long) s[offset + 1] << 16) +
1581                         (s[offset + 2] << 8) + s[offset+3];
1582         }
1583     }
1584
1585     sv_setiv(TARG, (I32)retnum);
1586     PUSHs(TARG);
1587     RETURN;
1588 }
1589
1590 PP(pp_index)
1591 {
1592     dSP; dTARGET;
1593     SV *big;
1594     SV *little;
1595     I32 offset;
1596     I32 retval;
1597     char *tmps;
1598     char *tmps2;
1599     STRLEN biglen;
1600     I32 arybase = curcop->cop_arybase;
1601
1602     if (MAXARG < 3)
1603         offset = 0;
1604     else
1605         offset = POPi - arybase;
1606     little = POPs;
1607     big = POPs;
1608     tmps = SvPV(big, biglen);
1609     if (offset < 0)
1610         offset = 0;
1611     else if (offset > biglen)
1612         offset = biglen;
1613     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
1614       (unsigned char*)tmps + biglen, little)))
1615         retval = -1 + arybase;
1616     else
1617         retval = tmps2 - tmps + arybase;
1618     PUSHi(retval);
1619     RETURN;
1620 }
1621
1622 PP(pp_rindex)
1623 {
1624     dSP; dTARGET;
1625     SV *big;
1626     SV *little;
1627     STRLEN blen;
1628     STRLEN llen;
1629     SV *offstr;
1630     I32 offset;
1631     I32 retval;
1632     char *tmps;
1633     char *tmps2;
1634     I32 arybase = curcop->cop_arybase;
1635
1636     if (MAXARG >= 3)
1637         offstr = POPs;
1638     little = POPs;
1639     big = POPs;
1640     tmps2 = SvPV(little, llen);
1641     tmps = SvPV(big, blen);
1642     if (MAXARG < 3)
1643         offset = blen;
1644     else
1645         offset = SvIV(offstr) - arybase + llen;
1646     if (offset < 0)
1647         offset = 0;
1648     else if (offset > blen)
1649         offset = blen;
1650     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
1651                           tmps2, tmps2 + llen)))
1652         retval = -1 + arybase;
1653     else
1654         retval = tmps2 - tmps + arybase;
1655     PUSHi(retval);
1656     RETURN;
1657 }
1658
1659 PP(pp_sprintf)
1660 {
1661     dSP; dMARK; dORIGMARK; dTARGET;
1662 #ifdef USE_LOCALE_NUMERIC
1663     if (op->op_private & OPpLOCALE)
1664         SET_NUMERIC_LOCAL();
1665     else
1666         SET_NUMERIC_STANDARD();
1667 #endif
1668     do_sprintf(TARG, SP-MARK, MARK+1);
1669     TAINT_IF(SvTAINTED(TARG));
1670     SP = ORIGMARK;
1671     PUSHTARG;
1672     RETURN;
1673 }
1674
1675 PP(pp_ord)
1676 {
1677     dSP; dTARGET;
1678     I32 value;
1679     char *tmps;
1680
1681 #ifndef I286
1682     tmps = POPp;
1683     value = (I32) (*tmps & 255);
1684 #else
1685     I32 anum;
1686     tmps = POPp;
1687     anum = (I32) *tmps;
1688     value = (I32) (anum & 255);
1689 #endif
1690     XPUSHi(value);
1691     RETURN;
1692 }
1693
1694 PP(pp_chr)
1695 {
1696     dSP; dTARGET;
1697     char *tmps;
1698
1699     (void)SvUPGRADE(TARG,SVt_PV);
1700     SvGROW(TARG,2);
1701     SvCUR_set(TARG, 1);
1702     tmps = SvPVX(TARG);
1703     *tmps++ = POPi;
1704     *tmps = '\0';
1705     (void)SvPOK_only(TARG);
1706     XPUSHs(TARG);
1707     RETURN;
1708 }
1709
1710 PP(pp_crypt)
1711 {
1712     dSP; dTARGET; dPOPTOPssrl;
1713 #ifdef HAS_CRYPT
1714     char *tmps = SvPV(left, na);
1715 #ifdef FCRYPT
1716     sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
1717 #else
1718     sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
1719 #endif
1720 #else
1721     DIE(
1722       "The crypt() function is unimplemented due to excessive paranoia.");
1723 #endif
1724     SETs(TARG);
1725     RETURN;
1726 }
1727
1728 PP(pp_ucfirst)
1729 {
1730     dSP;
1731     SV *sv = TOPs;
1732     register char *s;
1733
1734     if (!SvPADTMP(sv)) {
1735         dTARGET;
1736         sv_setsv(TARG, sv);
1737         sv = TARG;
1738         SETs(sv);
1739     }
1740     s = SvPV_force(sv, na);
1741     if (*s) {
1742         if (op->op_private & OPpLOCALE) {
1743             TAINT;
1744             SvTAINTED_on(sv);
1745             *s = toUPPER_LC(*s);
1746         }
1747         else
1748             *s = toUPPER(*s);
1749     }
1750
1751     RETURN;
1752 }
1753
1754 PP(pp_lcfirst)
1755 {
1756     dSP;
1757     SV *sv = TOPs;
1758     register char *s;
1759
1760     if (!SvPADTMP(sv)) {
1761         dTARGET;
1762         sv_setsv(TARG, sv);
1763         sv = TARG;
1764         SETs(sv);
1765     }
1766     s = SvPV_force(sv, na);
1767     if (*s) {
1768         if (op->op_private & OPpLOCALE) {
1769             TAINT;
1770             SvTAINTED_on(sv);
1771             *s = toLOWER_LC(*s);
1772         }
1773         else
1774             *s = toLOWER(*s);
1775     }
1776
1777     SETs(sv);
1778     RETURN;
1779 }
1780
1781 PP(pp_uc)
1782 {
1783     dSP;
1784     SV *sv = TOPs;
1785     register char *s;
1786     STRLEN len;
1787
1788     if (!SvPADTMP(sv)) {
1789         dTARGET;
1790         sv_setsv(TARG, sv);
1791         sv = TARG;
1792         SETs(sv);
1793     }
1794
1795     s = SvPV_force(sv, len);
1796     if (len) {
1797         register char *send = s + len;
1798
1799         if (op->op_private & OPpLOCALE) {
1800             TAINT;
1801             SvTAINTED_on(sv);
1802             for (; s < send; s++)
1803                 *s = toUPPER_LC(*s);
1804         }
1805         else {
1806             for (; s < send; s++)
1807                 *s = toUPPER(*s);
1808         }
1809     }
1810     RETURN;
1811 }
1812
1813 PP(pp_lc)
1814 {
1815     dSP;
1816     SV *sv = TOPs;
1817     register char *s;
1818     STRLEN len;
1819
1820     if (!SvPADTMP(sv)) {
1821         dTARGET;
1822         sv_setsv(TARG, sv);
1823         sv = TARG;
1824         SETs(sv);
1825     }
1826
1827     s = SvPV_force(sv, len);
1828     if (len) {
1829         register char *send = s + len;
1830
1831         if (op->op_private & OPpLOCALE) {
1832             TAINT;
1833             SvTAINTED_on(sv);
1834             for (; s < send; s++)
1835                 *s = toLOWER_LC(*s);
1836         }
1837         else {
1838             for (; s < send; s++)
1839                 *s = toLOWER(*s);
1840         }
1841     }
1842     RETURN;
1843 }
1844
1845 PP(pp_quotemeta)
1846 {
1847     dSP; dTARGET;
1848     SV *sv = TOPs;
1849     STRLEN len;
1850     register char *s = SvPV(sv,len);
1851     register char *d;
1852
1853     if (len) {
1854         (void)SvUPGRADE(TARG, SVt_PV);
1855         SvGROW(TARG, (len * 2) + 1);
1856         d = SvPVX(TARG);
1857         while (len--) {
1858             if (!isALNUM(*s))
1859                 *d++ = '\\';
1860             *d++ = *s++;
1861         }
1862         *d = '\0';
1863         SvCUR_set(TARG, d - SvPVX(TARG));
1864         (void)SvPOK_only(TARG);
1865     }
1866     else
1867         sv_setpvn(TARG, s, len);
1868     SETs(TARG);
1869     RETURN;
1870 }
1871
1872 /* Arrays. */
1873
1874 PP(pp_aslice)
1875 {
1876     dSP; dMARK; dORIGMARK;
1877     register SV** svp;
1878     register AV* av = (AV*)POPs;
1879     register I32 lval = op->op_flags & OPf_MOD;
1880     I32 arybase = curcop->cop_arybase;
1881     I32 elem;
1882
1883     if (SvTYPE(av) == SVt_PVAV) {
1884         if (lval && op->op_private & OPpLVAL_INTRO) {
1885             I32 max = -1;
1886             for (svp = mark + 1; svp <= sp; svp++) {
1887                 elem = SvIVx(*svp);
1888                 if (elem > max)
1889                     max = elem;
1890             }
1891             if (max > AvMAX(av))
1892                 av_extend(av, max);
1893         }
1894         while (++MARK <= SP) {
1895             elem = SvIVx(*MARK);
1896
1897             if (elem > 0)
1898                 elem -= arybase;
1899             svp = av_fetch(av, elem, lval);
1900             if (lval) {
1901                 if (!svp || *svp == &sv_undef)
1902                     DIE(no_aelem, elem);
1903                 if (op->op_private & OPpLVAL_INTRO)
1904                     save_svref(svp);
1905             }
1906             *MARK = svp ? *svp : &sv_undef;
1907         }
1908     }
1909     if (GIMME != G_ARRAY) {
1910         MARK = ORIGMARK;
1911         *++MARK = *SP;
1912         SP = MARK;
1913     }
1914     RETURN;
1915 }
1916
1917 /* Associative arrays. */
1918
1919 PP(pp_each)
1920 {
1921     dSP; dTARGET;
1922     HV *hash = (HV*)POPs;
1923     HE *entry;
1924
1925     PUTBACK;
1926     entry = hv_iternext(hash);                        /* might clobber stack_sp */
1927     SPAGAIN;
1928
1929     EXTEND(SP, 2);
1930     if (entry) {
1931         PUSHs(hv_iterkeysv(entry));                   /* won't clobber stack_sp */
1932         if (GIMME == G_ARRAY) {
1933             PUTBACK;
1934             sv_setsv(TARG, hv_iterval(hash, entry));  /* might clobber stack_sp */
1935             SPAGAIN;
1936             PUSHs(TARG);
1937         }
1938     }
1939     else if (GIMME == G_SCALAR)
1940         RETPUSHUNDEF;
1941
1942     RETURN;
1943 }
1944
1945 PP(pp_values)
1946 {
1947     return do_kv(ARGS);
1948 }
1949
1950 PP(pp_keys)
1951 {
1952     return do_kv(ARGS);
1953 }
1954
1955 PP(pp_delete)
1956 {
1957     dSP;
1958     SV *sv;
1959     HV *hv;
1960
1961     if (op->op_private & OPpSLICE) {
1962         dMARK; dORIGMARK;
1963         hv = (HV*)POPs;
1964         if (SvTYPE(hv) != SVt_PVHV)
1965             DIE("Not a HASH reference");
1966         while (++MARK <= SP) {
1967             sv = hv_delete_ent(hv, *MARK,
1968                         (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0);
1969             *MARK = sv ? sv : &sv_undef;
1970         }
1971         if (GIMME != G_ARRAY) {
1972             MARK = ORIGMARK;
1973             *++MARK = *SP;
1974             SP = MARK;
1975         }
1976     }
1977     else {
1978         SV *keysv = POPs;
1979         hv = (HV*)POPs;
1980         if (SvTYPE(hv) != SVt_PVHV)
1981             DIE("Not a HASH reference");
1982         sv = hv_delete_ent(hv, keysv,
1983                         (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0);
1984         if (!sv)
1985             sv = &sv_undef;
1986         PUSHs(sv);
1987     }
1988     RETURN;
1989 }
1990
1991 PP(pp_exists)
1992 {
1993     dSP;
1994     SV *tmpsv = POPs;
1995     HV *hv = (HV*)POPs;
1996     STRLEN len;
1997     if (SvTYPE(hv) != SVt_PVHV) {
1998         DIE("Not a HASH reference");
1999     }
2000     if (hv_exists_ent(hv, tmpsv, 0))
2001         RETPUSHYES;
2002     RETPUSHNO;
2003 }
2004
2005 PP(pp_hslice)
2006 {
2007     dSP; dMARK; dORIGMARK;
2008     register HE *he;
2009     register HV *hv = (HV*)POPs;
2010     register I32 lval = op->op_flags & OPf_MOD;
2011
2012     if (SvTYPE(hv) == SVt_PVHV) {
2013         while (++MARK <= SP) {
2014             SV *keysv = *MARK;
2015
2016             he = hv_fetch_ent(hv, keysv, lval, 0);
2017             if (lval) {
2018                 if (!he || HeVAL(he) == &sv_undef)
2019                     DIE(no_helem, SvPV(keysv, na));
2020                 if (op->op_private & OPpLVAL_INTRO)
2021                     save_svref(&HeVAL(he));
2022             }
2023             *MARK = he ? HeVAL(he) : &sv_undef;
2024         }
2025     }
2026     if (GIMME != G_ARRAY) {
2027         MARK = ORIGMARK;
2028         *++MARK = *SP;
2029         SP = MARK;
2030     }
2031     RETURN;
2032 }
2033
2034 /* List operators. */
2035
2036 PP(pp_list)
2037 {
2038     dSP; dMARK;
2039     if (GIMME != G_ARRAY) {
2040         if (++MARK <= SP)
2041             *MARK = *SP;                /* unwanted list, return last item */
2042         else
2043             *MARK = &sv_undef;
2044         SP = MARK;
2045     }
2046     RETURN;
2047 }
2048
2049 PP(pp_lslice)
2050 {
2051     dSP;
2052     SV **lastrelem = stack_sp;
2053     SV **lastlelem = stack_base + POPMARK;
2054     SV **firstlelem = stack_base + POPMARK + 1;
2055     register SV **firstrelem = lastlelem + 1;
2056     I32 arybase = curcop->cop_arybase;
2057     I32 lval = op->op_flags & OPf_MOD;
2058     I32 is_something_there = lval;
2059
2060     register I32 max = lastrelem - lastlelem;
2061     register SV **lelem;
2062     register I32 ix;
2063
2064     if (GIMME != G_ARRAY) {
2065         ix = SvIVx(*lastlelem);
2066         if (ix < 0)
2067             ix += max;
2068         else
2069             ix -= arybase;
2070         if (ix < 0 || ix >= max)
2071             *firstlelem = &sv_undef;
2072         else
2073             *firstlelem = firstrelem[ix];
2074         SP = firstlelem;
2075         RETURN;
2076     }
2077
2078     if (max == 0) {
2079         SP = firstlelem - 1;
2080         RETURN;
2081     }
2082
2083     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
2084         ix = SvIVx(*lelem);
2085         if (ix < 0) {
2086             ix += max;
2087             if (ix < 0)
2088                 *lelem = &sv_undef;
2089             else if (!(*lelem = firstrelem[ix]))
2090                 *lelem = &sv_undef;
2091         }
2092         else {
2093             ix -= arybase;
2094             if (ix >= max || !(*lelem = firstrelem[ix]))
2095                 *lelem = &sv_undef;
2096         }
2097         if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem)))
2098             is_something_there = TRUE;
2099     }
2100     if (is_something_there)
2101         SP = lastlelem;
2102     else
2103         SP = firstlelem - 1;
2104     RETURN;
2105 }
2106
2107 PP(pp_anonlist)
2108 {
2109     dSP; dMARK;
2110     I32 items = SP - MARK;
2111     SP = MARK;
2112     XPUSHs((SV*)sv_2mortal((SV*)av_make(items, MARK+1)));
2113     RETURN;
2114 }
2115
2116 PP(pp_anonhash)
2117 {
2118     dSP; dMARK; dORIGMARK;
2119     HV* hv = (HV*)sv_2mortal((SV*)newHV());
2120
2121     while (MARK < SP) {
2122         SV* key = *++MARK;
2123         SV *val = NEWSV(46, 0);
2124         if (MARK < SP)
2125             sv_setsv(val, *++MARK);
2126         else
2127             warn("Odd number of elements in hash list");
2128         (void)hv_store_ent(hv,key,val,0);
2129     }
2130     SP = ORIGMARK;
2131     XPUSHs((SV*)hv);
2132     RETURN;
2133 }
2134
2135 PP(pp_splice)
2136 {
2137     dSP; dMARK; dORIGMARK;
2138     register AV *ary = (AV*)*++MARK;
2139     register SV **src;
2140     register SV **dst;
2141     register I32 i;
2142     register I32 offset;
2143     register I32 length;
2144     I32 newlen;
2145     I32 after;
2146     I32 diff;
2147     SV **tmparyval = 0;
2148
2149     SP++;
2150
2151     if (++MARK < SP) {
2152         offset = SvIVx(*MARK);
2153         if (offset < 0)
2154             offset += AvFILL(ary) + 1;
2155         else
2156             offset -= curcop->cop_arybase;
2157         if (++MARK < SP) {
2158             length = SvIVx(*MARK++);
2159             if (length < 0)
2160                 length = 0;
2161         }
2162         else
2163             length = AvMAX(ary) + 1;            /* close enough to infinity */
2164     }
2165     else {
2166         offset = 0;
2167         length = AvMAX(ary) + 1;
2168     }
2169     if (offset < 0) {
2170         length += offset;
2171         offset = 0;
2172         if (length < 0)
2173             length = 0;
2174     }
2175     if (offset > AvFILL(ary) + 1)
2176         offset = AvFILL(ary) + 1;
2177     after = AvFILL(ary) + 1 - (offset + length);
2178     if (after < 0) {                            /* not that much array */
2179         length += after;                        /* offset+length now in array */
2180         after = 0;
2181         if (!AvALLOC(ary))
2182             av_extend(ary, 0);
2183     }
2184
2185     /* At this point, MARK .. SP-1 is our new LIST */
2186
2187     newlen = SP - MARK;
2188     diff = newlen - length;
2189
2190     if (diff < 0) {                             /* shrinking the area */
2191         if (newlen) {
2192             New(451, tmparyval, newlen, SV*);   /* so remember insertion */
2193             Copy(MARK, tmparyval, newlen, SV*);
2194         }
2195
2196         MARK = ORIGMARK + 1;
2197         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
2198             MEXTEND(MARK, length);
2199             Copy(AvARRAY(ary)+offset, MARK, length, SV*);
2200             if (AvREAL(ary)) {
2201                 EXTEND_MORTAL(length);
2202                 for (i = length, dst = MARK; i; i--) {
2203                     if (!SvIMMORTAL(*dst))
2204                         sv_2mortal(*dst);       /* free them eventualy */
2205                     dst++;
2206                 }
2207             }
2208             MARK += length - 1;
2209         }
2210         else {
2211             *MARK = AvARRAY(ary)[offset+length-1];
2212             if (AvREAL(ary)) {
2213                 if (!SvIMMORTAL(*MARK))
2214                     sv_2mortal(*MARK);
2215                 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
2216                     SvREFCNT_dec(*dst++);       /* free them now */
2217             }
2218         }
2219         AvFILL(ary) += diff;
2220
2221         /* pull up or down? */
2222
2223         if (offset < after) {                   /* easier to pull up */
2224             if (offset) {                       /* esp. if nothing to pull */
2225                 src = &AvARRAY(ary)[offset-1];
2226                 dst = src - diff;               /* diff is negative */
2227                 for (i = offset; i > 0; i--)    /* can't trust Copy */
2228                     *dst-- = *src--;
2229             }
2230             dst = AvARRAY(ary);
2231             SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
2232             AvMAX(ary) += diff;
2233         }
2234         else {
2235             if (after) {                        /* anything to pull down? */
2236                 src = AvARRAY(ary) + offset + length;
2237                 dst = src + diff;               /* diff is negative */
2238                 Move(src, dst, after, SV*);
2239             }
2240             dst = &AvARRAY(ary)[AvFILL(ary)+1];
2241                                                 /* avoid later double free */
2242         }
2243         i = -diff;
2244         while (i)
2245             dst[--i] = &sv_undef;
2246
2247         if (newlen) {
2248             for (src = tmparyval, dst = AvARRAY(ary) + offset;
2249               newlen; newlen--) {
2250                 *dst = NEWSV(46, 0);
2251                 sv_setsv(*dst++, *src++);
2252             }
2253             Safefree(tmparyval);
2254         }
2255     }
2256     else {                                      /* no, expanding (or same) */
2257         if (length) {
2258             New(452, tmparyval, length, SV*);   /* so remember deletion */
2259             Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
2260         }
2261
2262         if (diff > 0) {                         /* expanding */
2263
2264             /* push up or down? */
2265
2266             if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
2267                 if (offset) {
2268                     src = AvARRAY(ary);
2269                     dst = src - diff;
2270                     Move(src, dst, offset, SV*);
2271                 }
2272                 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
2273                 AvMAX(ary) += diff;
2274                 AvFILL(ary) += diff;
2275             }
2276             else {
2277                 if (AvFILL(ary) + diff >= AvMAX(ary))   /* oh, well */
2278                     av_extend(ary, AvFILL(ary) + diff);
2279                 AvFILL(ary) += diff;
2280
2281                 if (after) {
2282                     dst = AvARRAY(ary) + AvFILL(ary);
2283                     src = dst - diff;
2284                     for (i = after; i; i--) {
2285                         *dst-- = *src--;
2286                     }
2287                 }
2288             }
2289         }
2290
2291         for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
2292             *dst = NEWSV(46, 0);
2293             sv_setsv(*dst++, *src++);
2294         }
2295         MARK = ORIGMARK + 1;
2296         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
2297             if (length) {
2298                 Copy(tmparyval, MARK, length, SV*);
2299                 if (AvREAL(ary)) {
2300                     EXTEND_MORTAL(length);
2301                     for (i = length, dst = MARK; i; i--) {
2302                         if (!SvIMMORTAL(*dst))
2303                             sv_2mortal(*dst);   /* free them eventualy */
2304                         dst++;
2305                     }
2306                 }
2307                 Safefree(tmparyval);
2308             }
2309             MARK += length - 1;
2310         }
2311         else if (length--) {
2312             *MARK = tmparyval[length];
2313             if (AvREAL(ary)) {
2314                 if (!SvIMMORTAL(*MARK))
2315                     sv_2mortal(*MARK);
2316                 while (length-- > 0)
2317                     SvREFCNT_dec(tmparyval[length]);
2318             }
2319             Safefree(tmparyval);
2320         }
2321         else
2322             *MARK = &sv_undef;
2323     }
2324     SP = MARK;
2325     RETURN;
2326 }
2327
2328 PP(pp_push)
2329 {
2330     dSP; dMARK; dORIGMARK; dTARGET;
2331     register AV *ary = (AV*)*++MARK;
2332     register SV *sv = &sv_undef;
2333
2334     for (++MARK; MARK <= SP; MARK++) {
2335         sv = NEWSV(51, 0);
2336         if (*MARK)
2337             sv_setsv(sv, *MARK);
2338         av_push(ary, sv);
2339     }
2340     SP = ORIGMARK;
2341     PUSHi( AvFILL(ary) + 1 );
2342     RETURN;
2343 }
2344
2345 PP(pp_pop)
2346 {
2347     dSP;
2348     AV *av = (AV*)POPs;
2349     SV *sv = av_pop(av);
2350     if (!SvIMMORTAL(sv) && AvREAL(av))
2351         (void)sv_2mortal(sv);
2352     PUSHs(sv);
2353     RETURN;
2354 }
2355
2356 PP(pp_shift)
2357 {
2358     dSP;
2359     AV *av = (AV*)POPs;
2360     SV *sv = av_shift(av);
2361     EXTEND(SP, 1);
2362     if (!sv)
2363         RETPUSHUNDEF;
2364     if (!SvIMMORTAL(sv) && AvREAL(av))
2365         (void)sv_2mortal(sv);
2366     PUSHs(sv);
2367     RETURN;
2368 }
2369
2370 PP(pp_unshift)
2371 {
2372     dSP; dMARK; dORIGMARK; dTARGET;
2373     register AV *ary = (AV*)*++MARK;
2374     register SV *sv;
2375     register I32 i = 0;
2376
2377     av_unshift(ary, SP - MARK);
2378     while (MARK < SP) {
2379         sv = NEWSV(27, 0);
2380         sv_setsv(sv, *++MARK);
2381         (void)av_store(ary, i++, sv);
2382     }
2383
2384     SP = ORIGMARK;
2385     PUSHi( AvFILL(ary) + 1 );
2386     RETURN;
2387 }
2388
2389 PP(pp_reverse)
2390 {
2391     dSP; dMARK;
2392     register SV *tmp;
2393     SV **oldsp = SP;
2394
2395     if (GIMME == G_ARRAY) {
2396         MARK++;
2397         while (MARK < SP) {
2398             tmp = *MARK;
2399             *MARK++ = *SP;
2400             *SP-- = tmp;
2401         }
2402         SP = oldsp;
2403     }
2404     else {
2405         register char *up;
2406         register char *down;
2407         register I32 tmp;
2408         dTARGET;
2409         STRLEN len;
2410
2411         if (SP - MARK > 1)
2412             do_join(TARG, &sv_no, MARK, SP);
2413         else
2414             sv_setsv(TARG, *SP);
2415         up = SvPV_force(TARG, len);
2416         if (len > 1) {
2417             down = SvPVX(TARG) + len - 1;
2418             while (down > up) {
2419                 tmp = *up;
2420                 *up++ = *down;
2421                 *down-- = tmp;
2422             }
2423             (void)SvPOK_only(TARG);
2424         }
2425         SP = MARK + 1;
2426         SETTARG;
2427     }
2428     RETURN;
2429 }
2430
2431 static SV      *
2432 mul128(sv, m)
2433      SV             *sv;
2434      U8              m;
2435 {
2436   STRLEN          len;
2437   char           *s = SvPV(sv, len);
2438   char           *t;
2439   U32             i = 0;
2440
2441   if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
2442     SV             *new = newSVpv("0000000000", 10);
2443
2444     sv_catsv(new, sv);
2445     SvREFCNT_dec(sv);           /* free old sv */
2446     sv = new;
2447     s = SvPV(sv, len);
2448   }
2449   t = s + len - 1;
2450   while (!*t)                   /* trailing '\0'? */
2451     t--;
2452   while (t > s) {
2453     i = ((*t - '0') << 7) + m;
2454     *(t--) = '0' + (i % 10);
2455     m = i / 10;
2456   }
2457   return (sv);
2458 }
2459
2460 /* Explosives and implosives. */
2461
2462 PP(pp_unpack)
2463 {
2464     dSP;
2465     dPOPPOPssrl;
2466     SV **oldsp = sp;
2467     SV *sv;
2468     STRLEN llen;
2469     STRLEN rlen;
2470     register char *pat = SvPV(left, llen);
2471     register char *s = SvPV(right, rlen);
2472     char *strend = s + rlen;
2473     char *strbeg = s;
2474     register char *patend = pat + llen;
2475     I32 datumtype;
2476     register I32 len;
2477     register I32 bits;
2478
2479     /* These must not be in registers: */
2480     I16 ashort;
2481     int aint;
2482     I32 along;
2483 #ifdef HAS_QUAD
2484     Quad_t aquad;
2485 #endif
2486     U16 aushort;
2487     unsigned int auint;
2488     U32 aulong;
2489 #ifdef HAS_QUAD
2490     unsigned Quad_t auquad;
2491 #endif
2492     char *aptr;
2493     float afloat;
2494     double adouble;
2495     I32 checksum = 0;
2496     register U32 culong;
2497     double cdouble;
2498     static char* bitcount = 0;
2499
2500     if (GIMME != G_ARRAY) {             /* arrange to do first one only */
2501         /*SUPPRESS 530*/
2502         for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
2503         if (strchr("aAbBhHP", *patend) || *pat == '%') {
2504             patend++;
2505             while (isDIGIT(*patend) || *patend == '*')
2506                 patend++;
2507         }
2508         else
2509             patend++;
2510     }
2511     while (pat < patend) {
2512       reparse:
2513         datumtype = *pat++;
2514         if (pat >= patend)
2515             len = 1;
2516         else if (*pat == '*') {
2517             len = strend - strbeg;      /* long enough */
2518             pat++;
2519         }
2520         else if (isDIGIT(*pat)) {
2521             len = *pat++ - '0';
2522             while (isDIGIT(*pat))
2523                 len = (len * 10) + (*pat++ - '0');
2524         }
2525         else
2526             len = (datumtype != '@');
2527         switch(datumtype) {
2528         default:
2529             break;
2530         case '%':
2531             if (len == 1 && pat[-1] != '1')
2532                 len = 16;
2533             checksum = len;
2534             culong = 0;
2535             cdouble = 0;
2536             if (pat < patend)
2537                 goto reparse;
2538             break;
2539         case '@':
2540             if (len > strend - strbeg)
2541                 DIE("@ outside of string");
2542             s = strbeg + len;
2543             break;
2544         case 'X':
2545             if (len > s - strbeg)
2546                 DIE("X outside of string");
2547             s -= len;
2548             break;
2549         case 'x':
2550             if (len > strend - s)
2551                 DIE("x outside of string");
2552             s += len;
2553             break;
2554         case 'A':
2555         case 'a':
2556             if (len > strend - s)
2557                 len = strend - s;
2558             if (checksum)
2559                 goto uchar_checksum;
2560             sv = NEWSV(35, len);
2561             sv_setpvn(sv, s, len);
2562             s += len;
2563             if (datumtype == 'A') {
2564                 aptr = s;       /* borrow register */
2565                 s = SvPVX(sv) + len - 1;
2566                 while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
2567                     s--;
2568                 *++s = '\0';
2569                 SvCUR_set(sv, s - SvPVX(sv));
2570                 s = aptr;       /* unborrow register */
2571             }
2572             XPUSHs(sv_2mortal(sv));
2573             break;
2574         case 'B':
2575         case 'b':
2576             if (pat[-1] == '*' || len > (strend - s) * 8)
2577                 len = (strend - s) * 8;
2578             if (checksum) {
2579                 if (!bitcount) {
2580                     Newz(601, bitcount, 256, char);
2581                     for (bits = 1; bits < 256; bits++) {
2582                         if (bits & 1)   bitcount[bits]++;
2583                         if (bits & 2)   bitcount[bits]++;
2584                         if (bits & 4)   bitcount[bits]++;
2585                         if (bits & 8)   bitcount[bits]++;
2586                         if (bits & 16)  bitcount[bits]++;
2587                         if (bits & 32)  bitcount[bits]++;
2588                         if (bits & 64)  bitcount[bits]++;
2589                         if (bits & 128) bitcount[bits]++;
2590                     }
2591                 }
2592                 while (len >= 8) {
2593                     culong += bitcount[*(unsigned char*)s++];
2594                     len -= 8;
2595                 }
2596                 if (len) {
2597                     bits = *s;
2598                     if (datumtype == 'b') {
2599                         while (len-- > 0) {
2600                             if (bits & 1) culong++;
2601                             bits >>= 1;
2602                         }
2603                     }
2604                     else {
2605                         while (len-- > 0) {
2606                             if (bits & 128) culong++;
2607                             bits <<= 1;
2608                         }
2609                     }
2610                 }
2611                 break;
2612             }
2613             sv = NEWSV(35, len + 1);
2614             SvCUR_set(sv, len);
2615             SvPOK_on(sv);
2616             aptr = pat;                 /* borrow register */
2617             pat = SvPVX(sv);
2618             if (datumtype == 'b') {
2619                 aint = len;
2620                 for (len = 0; len < aint; len++) {
2621                     if (len & 7)                /*SUPPRESS 595*/
2622                         bits >>= 1;
2623                     else
2624                         bits = *s++;
2625                     *pat++ = '0' + (bits & 1);
2626                 }
2627             }
2628             else {
2629                 aint = len;
2630                 for (len = 0; len < aint; len++) {
2631                     if (len & 7)
2632                         bits <<= 1;
2633                     else
2634                         bits = *s++;
2635                     *pat++ = '0' + ((bits & 128) != 0);
2636                 }
2637             }
2638             *pat = '\0';
2639             pat = aptr;                 /* unborrow register */
2640             XPUSHs(sv_2mortal(sv));
2641             break;
2642         case 'H':
2643         case 'h':
2644             if (pat[-1] == '*' || len > (strend - s) * 2)
2645                 len = (strend - s) * 2;
2646             sv = NEWSV(35, len + 1);
2647             SvCUR_set(sv, len);
2648             SvPOK_on(sv);
2649             aptr = pat;                 /* borrow register */
2650             pat = SvPVX(sv);
2651             if (datumtype == 'h') {
2652                 aint = len;
2653                 for (len = 0; len < aint; len++) {
2654                     if (len & 1)
2655                         bits >>= 4;
2656                     else
2657                         bits = *s++;
2658                     *pat++ = hexdigit[bits & 15];
2659                 }
2660             }
2661             else {
2662                 aint = len;
2663                 for (len = 0; len < aint; len++) {
2664                     if (len & 1)
2665                         bits <<= 4;
2666                     else
2667                         bits = *s++;
2668                     *pat++ = hexdigit[(bits >> 4) & 15];
2669                 }
2670             }
2671             *pat = '\0';
2672             pat = aptr;                 /* unborrow register */
2673             XPUSHs(sv_2mortal(sv));
2674             break;
2675         case 'c':
2676             if (len > strend - s)
2677                 len = strend - s;
2678             if (checksum) {
2679                 while (len-- > 0) {
2680                     aint = *s++;
2681                     if (aint >= 128)    /* fake up signed chars */
2682                         aint -= 256;
2683                     culong += aint;
2684                 }
2685             }
2686             else {
2687                 EXTEND(SP, len);
2688                 EXTEND_MORTAL(len);
2689                 while (len-- > 0) {
2690                     aint = *s++;
2691                     if (aint >= 128)    /* fake up signed chars */
2692                         aint -= 256;
2693                     sv = NEWSV(36, 0);
2694                     sv_setiv(sv, (I32)aint);
2695                     PUSHs(sv_2mortal(sv));
2696                 }
2697             }
2698             break;
2699         case 'C':
2700             if (len > strend - s)
2701                 len = strend - s;
2702             if (checksum) {
2703               uchar_checksum:
2704                 while (len-- > 0) {
2705                     auint = *s++ & 255;
2706                     culong += auint;
2707                 }
2708             }
2709             else {
2710                 EXTEND(SP, len);
2711                 EXTEND_MORTAL(len);
2712                 while (len-- > 0) {
2713                     auint = *s++ & 255;
2714                     sv = NEWSV(37, 0);
2715                     sv_setiv(sv, (I32)auint);
2716                     PUSHs(sv_2mortal(sv));
2717                 }
2718             }
2719             break;
2720         case 's':
2721             along = (strend - s) / sizeof(I16);
2722             if (len > along)
2723                 len = along;
2724             if (checksum) {
2725                 while (len-- > 0) {
2726                     Copy(s, &ashort, 1, I16);
2727                     s += sizeof(I16);
2728                     culong += ashort;
2729                 }
2730             }
2731             else {
2732                 EXTEND(SP, len);
2733                 EXTEND_MORTAL(len);
2734                 while (len-- > 0) {
2735                     Copy(s, &ashort, 1, I16);
2736                     s += sizeof(I16);
2737                     sv = NEWSV(38, 0);
2738                     sv_setiv(sv, (I32)ashort);
2739                     PUSHs(sv_2mortal(sv));
2740                 }
2741             }
2742             break;
2743         case 'v':
2744         case 'n':
2745         case 'S':
2746             along = (strend - s) / sizeof(U16);
2747             if (len > along)
2748                 len = along;
2749             if (checksum) {
2750                 while (len-- > 0) {
2751                     Copy(s, &aushort, 1, U16);
2752                     s += sizeof(U16);
2753 #ifdef HAS_NTOHS
2754                     if (datumtype == 'n')
2755                         aushort = ntohs(aushort);
2756 #endif
2757 #ifdef HAS_VTOHS
2758                     if (datumtype == 'v')
2759                         aushort = vtohs(aushort);
2760 #endif
2761                     culong += aushort;
2762                 }
2763             }
2764             else {
2765                 EXTEND(SP, len);
2766                 EXTEND_MORTAL(len);
2767                 while (len-- > 0) {
2768                     Copy(s, &aushort, 1, U16);
2769                     s += sizeof(U16);
2770                     sv = NEWSV(39, 0);
2771 #ifdef HAS_NTOHS
2772                     if (datumtype == 'n')
2773                         aushort = ntohs(aushort);
2774 #endif
2775 #ifdef HAS_VTOHS
2776                     if (datumtype == 'v')
2777                         aushort = vtohs(aushort);
2778 #endif
2779                     sv_setiv(sv, (I32)aushort);
2780                     PUSHs(sv_2mortal(sv));
2781                 }
2782             }
2783             break;
2784         case 'i':
2785             along = (strend - s) / sizeof(int);
2786             if (len > along)
2787                 len = along;
2788             if (checksum) {
2789                 while (len-- > 0) {
2790                     Copy(s, &aint, 1, int);
2791                     s += sizeof(int);
2792                     if (checksum > 32)
2793                         cdouble += (double)aint;
2794                     else
2795                         culong += aint;
2796                 }
2797             }
2798             else {
2799                 EXTEND(SP, len);
2800                 EXTEND_MORTAL(len);
2801                 while (len-- > 0) {
2802                     Copy(s, &aint, 1, int);
2803                     s += sizeof(int);
2804                     sv = NEWSV(40, 0);
2805                     sv_setiv(sv, (I32)aint);
2806                     PUSHs(sv_2mortal(sv));
2807                 }
2808             }
2809             break;
2810         case 'I':
2811             along = (strend - s) / sizeof(unsigned int);
2812             if (len > along)
2813                 len = along;
2814             if (checksum) {
2815                 while (len-- > 0) {
2816                     Copy(s, &auint, 1, unsigned int);
2817                     s += sizeof(unsigned int);
2818                     if (checksum > 32)
2819                         cdouble += (double)auint;
2820                     else
2821                         culong += auint;
2822                 }
2823             }
2824             else {
2825                 EXTEND(SP, len);
2826                 EXTEND_MORTAL(len);
2827                 while (len-- > 0) {
2828                     Copy(s, &auint, 1, unsigned int);
2829                     s += sizeof(unsigned int);
2830                     sv = NEWSV(41, 0);
2831                     if (auint <= I32_MAX)
2832                         sv_setiv(sv, (I32)auint);
2833                     else
2834                         sv_setnv(sv, (double)auint);
2835                     PUSHs(sv_2mortal(sv));
2836                 }
2837             }
2838             break;
2839         case 'l':
2840             along = (strend - s) / sizeof(I32);
2841             if (len > along)
2842                 len = along;
2843             if (checksum) {
2844                 while (len-- > 0) {
2845                     Copy(s, &along, 1, I32);
2846                     s += sizeof(I32);
2847                     if (checksum > 32)
2848                         cdouble += (double)along;
2849                     else
2850                         culong += along;
2851                 }
2852             }
2853             else {
2854                 EXTEND(SP, len);
2855                 EXTEND_MORTAL(len);
2856                 while (len-- > 0) {
2857                     Copy(s, &along, 1, I32);
2858                     s += sizeof(I32);
2859                     sv = NEWSV(42, 0);
2860                     sv_setiv(sv, (I32)along);
2861                     PUSHs(sv_2mortal(sv));
2862                 }
2863             }
2864             break;
2865         case 'V':
2866         case 'N':
2867         case 'L':
2868             along = (strend - s) / sizeof(U32);
2869             if (len > along)
2870                 len = along;
2871             if (checksum) {
2872                 while (len-- > 0) {
2873                     Copy(s, &aulong, 1, U32);
2874                     s += sizeof(U32);
2875 #ifdef HAS_NTOHL
2876                     if (datumtype == 'N')
2877                         aulong = ntohl(aulong);
2878 #endif
2879 #ifdef HAS_VTOHL
2880                     if (datumtype == 'V')
2881                         aulong = vtohl(aulong);
2882 #endif
2883                     if (checksum > 32)
2884                         cdouble += (double)aulong;
2885                     else
2886                         culong += aulong;
2887                 }
2888             }
2889             else {
2890                 EXTEND(SP, len);
2891                 EXTEND_MORTAL(len);
2892                 while (len-- > 0) {
2893                     Copy(s, &aulong, 1, U32);
2894                     s += sizeof(U32);
2895                     sv = NEWSV(43, 0);
2896 #ifdef HAS_NTOHL
2897                     if (datumtype == 'N')
2898                         aulong = ntohl(aulong);
2899 #endif
2900 #ifdef HAS_VTOHL
2901                     if (datumtype == 'V')
2902                         aulong = vtohl(aulong);
2903 #endif
2904                     sv_setnv(sv, (double)aulong);
2905                     PUSHs(sv_2mortal(sv));
2906                 }
2907             }
2908             break;
2909         case 'p':
2910             along = (strend - s) / sizeof(char*);
2911             if (len > along)
2912                 len = along;
2913             EXTEND(SP, len);
2914             EXTEND_MORTAL(len);
2915             while (len-- > 0) {
2916                 if (sizeof(char*) > strend - s)
2917                     break;
2918                 else {
2919                     Copy(s, &aptr, 1, char*);
2920                     s += sizeof(char*);
2921                 }
2922                 sv = NEWSV(44, 0);
2923                 if (aptr)
2924                     sv_setpv(sv, aptr);
2925                 PUSHs(sv_2mortal(sv));
2926             }
2927             break;
2928         case 'w':
2929             EXTEND(SP, len);
2930             EXTEND_MORTAL(len);
2931             {
2932                 UV auv = 0;
2933                 U32 bytes = 0;
2934
2935                 while ((len > 0) && (s < strend)) {
2936                     auv = (auv << 7) | (*s & 0x7f);
2937                     if (!(*s++ & 0x80)) {
2938                         bytes = 0;
2939                         sv = NEWSV(40, 0);
2940                         sv_setuv(sv, auv);
2941                         PUSHs(sv_2mortal(sv));
2942                         len--;
2943                         auv = 0;
2944                     }
2945                     else if (++bytes >= sizeof(UV)) {   /* promote to string */
2946                         char decn[sizeof(UV) * 3 + 1];
2947                         char *t;
2948
2949                         (void) sprintf(decn, "%0*ld", sizeof(decn) - 1, auv);
2950                         sv = newSVpv(decn, 0);
2951                         while (s < strend) {
2952                             sv = mul128(sv, *s & 0x7f);
2953                             if (!(*s++ & 0x80)) {
2954                                 bytes = 0;
2955                                 break;
2956                             }
2957                         }
2958                         t = SvPV(sv, na);
2959                         while (*t == '0')
2960                             t++;
2961                         sv_chop(sv, t);
2962                         PUSHs(sv_2mortal(sv));
2963                         len--;
2964                         auv = 0;
2965                     }
2966                 }
2967                 if ((s >= strend) && bytes)
2968                     croak("Unterminated compressed integer");
2969             }
2970             break;
2971         case 'P':
2972             EXTEND(SP, 1);
2973             if (sizeof(char*) > strend - s)
2974                 break;
2975             else {
2976                 Copy(s, &aptr, 1, char*);
2977                 s += sizeof(char*);
2978             }
2979             sv = NEWSV(44, 0);
2980             if (aptr)
2981                 sv_setpvn(sv, aptr, len);
2982             PUSHs(sv_2mortal(sv));
2983             break;
2984 #ifdef HAS_QUAD
2985         case 'q':
2986             EXTEND(SP, len);
2987             EXTEND_MORTAL(len);
2988             while (len-- > 0) {
2989                 if (s + sizeof(Quad_t) > strend)
2990                     aquad = 0;
2991                 else {
2992                     Copy(s, &aquad, 1, Quad_t);
2993                     s += sizeof(Quad_t);
2994                 }
2995                 sv = NEWSV(42, 0);
2996                 sv_setiv(sv, (IV)aquad);
2997                 PUSHs(sv_2mortal(sv));
2998             }
2999             break;
3000         case 'Q':
3001             EXTEND(SP, len);
3002             EXTEND_MORTAL(len);
3003             while (len-- > 0) {
3004                 if (s + sizeof(unsigned Quad_t) > strend)
3005                     auquad = 0;
3006                 else {
3007                     Copy(s, &auquad, 1, unsigned Quad_t);
3008                     s += sizeof(unsigned Quad_t);
3009                 }
3010                 sv = NEWSV(43, 0);
3011                 sv_setiv(sv, (IV)auquad);
3012                 PUSHs(sv_2mortal(sv));
3013             }
3014             break;
3015 #endif
3016         /* float and double added gnb@melba.bby.oz.au 22/11/89 */
3017         case 'f':
3018         case 'F':
3019             along = (strend - s) / sizeof(float);
3020             if (len > along)
3021                 len = along;
3022             if (checksum) {
3023                 while (len-- > 0) {
3024                     Copy(s, &afloat, 1, float);
3025                     s += sizeof(float);
3026                     cdouble += afloat;
3027                 }
3028             }
3029             else {
3030                 EXTEND(SP, len);
3031                 EXTEND_MORTAL(len);
3032                 while (len-- > 0) {
3033                     Copy(s, &afloat, 1, float);
3034                     s += sizeof(float);
3035                     sv = NEWSV(47, 0);
3036                     sv_setnv(sv, (double)afloat);
3037                     PUSHs(sv_2mortal(sv));
3038                 }
3039             }
3040             break;
3041         case 'd':
3042         case 'D':
3043             along = (strend - s) / sizeof(double);
3044             if (len > along)
3045                 len = along;
3046             if (checksum) {
3047                 while (len-- > 0) {
3048                     Copy(s, &adouble, 1, double);
3049                     s += sizeof(double);
3050                     cdouble += adouble;
3051                 }
3052             }
3053             else {
3054                 EXTEND(SP, len);
3055                 EXTEND_MORTAL(len);
3056                 while (len-- > 0) {
3057                     Copy(s, &adouble, 1, double);
3058                     s += sizeof(double);
3059                     sv = NEWSV(48, 0);
3060                     sv_setnv(sv, (double)adouble);
3061                     PUSHs(sv_2mortal(sv));
3062                 }
3063             }
3064             break;
3065         case 'u':
3066             along = (strend - s) * 3 / 4;
3067             sv = NEWSV(42, along);
3068             if (along)
3069                 SvPOK_on(sv);
3070             while (s < strend && *s > ' ' && *s < 'a') {
3071                 I32 a, b, c, d;
3072                 char hunk[4];
3073
3074                 hunk[3] = '\0';
3075                 len = (*s++ - ' ') & 077;
3076                 while (len > 0) {
3077                     if (s < strend && *s >= ' ')
3078                         a = (*s++ - ' ') & 077;
3079                     else
3080                         a = 0;
3081                     if (s < strend && *s >= ' ')
3082                         b = (*s++ - ' ') & 077;
3083                     else
3084                         b = 0;
3085                     if (s < strend && *s >= ' ')
3086                         c = (*s++ - ' ') & 077;
3087                     else
3088                         c = 0;
3089                     if (s < strend && *s >= ' ')
3090                         d = (*s++ - ' ') & 077;
3091                     else
3092                         d = 0;
3093                     hunk[0] = a << 2 | b >> 4;
3094                     hunk[1] = b << 4 | c >> 2;
3095                     hunk[2] = c << 6 | d;
3096                     sv_catpvn(sv, hunk, len > 3 ? 3 : len);
3097                     len -= 3;
3098                 }
3099                 if (*s == '\n')
3100                     s++;
3101                 else if (s[1] == '\n')          /* possible checksum byte */
3102                     s += 2;
3103             }
3104             XPUSHs(sv_2mortal(sv));
3105             break;
3106         }
3107         if (checksum) {
3108             sv = NEWSV(42, 0);
3109             if (strchr("fFdD", datumtype) ||
3110               (checksum > 32 && strchr("iIlLN", datumtype)) ) {
3111                 double trouble;
3112
3113                 adouble = 1.0;
3114                 while (checksum >= 16) {
3115                     checksum -= 16;
3116                     adouble *= 65536.0;
3117                 }
3118                 while (checksum >= 4) {
3119                     checksum -= 4;
3120                     adouble *= 16.0;
3121                 }
3122                 while (checksum--)
3123                     adouble *= 2.0;
3124                 along = (1 << checksum) - 1;
3125                 while (cdouble < 0.0)
3126                     cdouble += adouble;
3127                 cdouble = modf(cdouble / adouble, &trouble) * adouble;
3128                 sv_setnv(sv, cdouble);
3129             }
3130             else {
3131                 if (checksum < 32) {
3132                     along = (1 << checksum) - 1;
3133                     culong &= (U32)along;
3134                 }
3135                 sv_setnv(sv, (double)culong);
3136             }
3137             XPUSHs(sv_2mortal(sv));
3138             checksum = 0;
3139         }
3140     }
3141     if (sp == oldsp && GIMME != G_ARRAY)
3142         PUSHs(&sv_undef);
3143     RETURN;
3144 }
3145
3146 static void
3147 doencodes(sv, s, len)
3148 register SV *sv;
3149 register char *s;
3150 register I32 len;
3151 {
3152     char hunk[5];
3153
3154     *hunk = len + ' ';
3155     sv_catpvn(sv, hunk, 1);
3156     hunk[4] = '\0';
3157     while (len > 0) {
3158         hunk[0] = ' ' + (077 & (*s >> 2));
3159         hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
3160         hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
3161         hunk[3] = ' ' + (077 & (s[2] & 077));
3162         sv_catpvn(sv, hunk, 4);
3163         s += 3;
3164         len -= 3;
3165     }
3166     for (s = SvPVX(sv); *s; s++) {
3167         if (*s == ' ')
3168             *s = '`';
3169     }
3170     sv_catpvn(sv, "\n", 1);
3171 }
3172
3173 static SV      *
3174 is_an_int(s, l)
3175      char           *s;
3176      STRLEN          l;
3177 {
3178   SV             *result = newSVpv("", l);
3179   char           *result_c = SvPV(result, na);  /* convenience */
3180   char           *out = result_c;
3181   bool            skip = 1;
3182   bool            ignore = 0;
3183
3184   while (*s) {
3185     switch (*s) {
3186     case ' ':
3187       break;
3188     case '+':
3189       if (!skip) {
3190         SvREFCNT_dec(result);
3191         return (NULL);
3192       }
3193       break;
3194     case '0':
3195     case '1':
3196     case '2':
3197     case '3':
3198     case '4':
3199     case '5':
3200     case '6':
3201     case '7':
3202     case '8':
3203     case '9':
3204       skip = 0;
3205       if (!ignore) {
3206         *(out++) = *s;
3207       }
3208       break;
3209     case '.':
3210       ignore = 1;
3211       break;
3212     default:
3213       SvREFCNT_dec(result);
3214       return (NULL);
3215     }
3216     s++;
3217   }
3218   *(out++) = '\0';
3219   SvCUR_set(result, out - result_c);
3220   return (result);
3221 }
3222
3223 static int
3224 div128(pnum, done)
3225      SV             *pnum;                  /* must be '\0' terminated */
3226      bool           *done;
3227 {
3228   STRLEN          len;
3229   char           *s = SvPV(pnum, len);
3230   int             m = 0;
3231   int             r = 0;
3232   char           *t = s;
3233
3234   *done = 1;
3235   while (*t) {
3236     int             i;
3237
3238     i = m * 10 + (*t - '0');
3239     m = i & 0x7F;
3240     r = (i >> 7);               /* r < 10 */
3241     if (r) {
3242       *done = 0;
3243     }
3244     *(t++) = '0' + r;
3245   }
3246   *(t++) = '\0';
3247   SvCUR_set(pnum, (STRLEN) (t - s));
3248   return (m);
3249 }
3250
3251
3252 PP(pp_pack)
3253 {
3254     dSP; dMARK; dORIGMARK; dTARGET;
3255     register SV *cat = TARG;
3256     register I32 items;
3257     STRLEN fromlen;
3258     register char *pat = SvPVx(*++MARK, fromlen);
3259     register char *patend = pat + fromlen;
3260     register I32 len;
3261     I32 datumtype;
3262     SV *fromstr;
3263     /*SUPPRESS 442*/
3264     static char null10[] = {0,0,0,0,0,0,0,0,0,0};
3265     static char *space10 = "          ";
3266
3267     /* These must not be in registers: */
3268     char achar;
3269     I16 ashort;
3270     int aint;
3271     unsigned int auint;
3272     I32 along;
3273     U32 aulong;
3274 #ifdef HAS_QUAD
3275     Quad_t aquad;
3276     unsigned Quad_t auquad;
3277 #endif
3278     char *aptr;
3279     float afloat;
3280     double adouble;
3281
3282     items = SP - MARK;
3283     MARK++;
3284     sv_setpvn(cat, "", 0);
3285     while (pat < patend) {
3286 #define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
3287         datumtype = *pat++;
3288         if (*pat == '*') {
3289             len = strchr("@Xxu", datumtype) ? 0 : items;
3290             pat++;
3291         }
3292         else if (isDIGIT(*pat)) {
3293             len = *pat++ - '0';
3294             while (isDIGIT(*pat))
3295                 len = (len * 10) + (*pat++ - '0');
3296         }
3297         else
3298             len = 1;
3299         switch(datumtype) {
3300         default:
3301             break;
3302         case '%':
3303             DIE("%% may only be used in unpack");
3304         case '@':
3305             len -= SvCUR(cat);
3306             if (len > 0)
3307                 goto grow;
3308             len = -len;
3309             if (len > 0)
3310                 goto shrink;
3311             break;
3312         case 'X':
3313           shrink:
3314             if (SvCUR(cat) < len)
3315                 DIE("X outside of string");
3316             SvCUR(cat) -= len;
3317             *SvEND(cat) = '\0';
3318             break;
3319         case 'x':
3320           grow:
3321             while (len >= 10) {
3322                 sv_catpvn(cat, null10, 10);
3323                 len -= 10;
3324             }
3325             sv_catpvn(cat, null10, len);
3326             break;
3327         case 'A':
3328         case 'a':
3329             fromstr = NEXTFROM;
3330             aptr = SvPV(fromstr, fromlen);
3331             if (pat[-1] == '*')
3332                 len = fromlen;
3333             if (fromlen > len)
3334                 sv_catpvn(cat, aptr, len);
3335             else {
3336                 sv_catpvn(cat, aptr, fromlen);
3337                 len -= fromlen;
3338                 if (datumtype == 'A') {
3339                     while (len >= 10) {
3340                         sv_catpvn(cat, space10, 10);
3341                         len -= 10;
3342                     }
3343                     sv_catpvn(cat, space10, len);
3344                 }
3345                 else {
3346                     while (len >= 10) {
3347                         sv_catpvn(cat, null10, 10);
3348                         len -= 10;
3349                     }
3350                     sv_catpvn(cat, null10, len);
3351                 }
3352             }
3353             break;
3354         case 'B':
3355         case 'b':
3356             {
3357                 char *savepat = pat;
3358                 I32 saveitems;
3359
3360                 fromstr = NEXTFROM;
3361                 saveitems = items;
3362                 aptr = SvPV(fromstr, fromlen);
3363                 if (pat[-1] == '*')
3364                     len = fromlen;
3365                 pat = aptr;
3366                 aint = SvCUR(cat);
3367                 SvCUR(cat) += (len+7)/8;
3368                 SvGROW(cat, SvCUR(cat) + 1);
3369                 aptr = SvPVX(cat) + aint;
3370                 if (len > fromlen)
3371                     len = fromlen;
3372                 aint = len;
3373                 items = 0;
3374                 if (datumtype == 'B') {
3375                     for (len = 0; len++ < aint;) {
3376                         items |= *pat++ & 1;
3377                         if (len & 7)
3378                             items <<= 1;
3379                         else {
3380                             *aptr++ = items & 0xff;
3381                             items = 0;
3382                         }
3383                     }
3384                 }
3385                 else {
3386                     for (len = 0; len++ < aint;) {
3387                         if (*pat++ & 1)
3388                             items |= 128;
3389                         if (len & 7)
3390                             items >>= 1;
3391                         else {
3392                             *aptr++ = items & 0xff;
3393                             items = 0;
3394                         }
3395                     }
3396                 }
3397                 if (aint & 7) {
3398                     if (datumtype == 'B')
3399                         items <<= 7 - (aint & 7);
3400                     else
3401                         items >>= 7 - (aint & 7);
3402                     *aptr++ = items & 0xff;
3403                 }
3404                 pat = SvPVX(cat) + SvCUR(cat);
3405                 while (aptr <= pat)
3406                     *aptr++ = '\0';
3407
3408                 pat = savepat;
3409                 items = saveitems;
3410             }
3411             break;
3412         case 'H':
3413         case 'h':
3414             {
3415                 char *savepat = pat;
3416                 I32 saveitems;
3417
3418                 fromstr = NEXTFROM;
3419                 saveitems = items;
3420                 aptr = SvPV(fromstr, fromlen);
3421                 if (pat[-1] == '*')
3422                     len = fromlen;
3423                 pat = aptr;
3424                 aint = SvCUR(cat);
3425                 SvCUR(cat) += (len+1)/2;
3426                 SvGROW(cat, SvCUR(cat) + 1);
3427                 aptr = SvPVX(cat) + aint;
3428                 if (len > fromlen)
3429                     len = fromlen;
3430                 aint = len;
3431                 items = 0;
3432                 if (datumtype == 'H') {
3433                     for (len = 0; len++ < aint;) {
3434                         if (isALPHA(*pat))
3435                             items |= ((*pat++ & 15) + 9) & 15;
3436                         else
3437                             items |= *pat++ & 15;
3438                         if (len & 1)
3439                             items <<= 4;
3440                         else {
3441                             *aptr++ = items & 0xff;
3442                             items = 0;
3443                         }
3444                     }
3445                 }
3446                 else {
3447                     for (len = 0; len++ < aint;) {
3448                         if (isALPHA(*pat))
3449                             items |= (((*pat++ & 15) + 9) & 15) << 4;
3450                         else
3451                             items |= (*pat++ & 15) << 4;
3452                         if (len & 1)
3453                             items >>= 4;
3454                         else {
3455                             *aptr++ = items & 0xff;
3456                             items = 0;
3457                         }
3458                     }
3459                 }
3460                 if (aint & 1)
3461                     *aptr++ = items & 0xff;
3462                 pat = SvPVX(cat) + SvCUR(cat);
3463                 while (aptr <= pat)
3464                     *aptr++ = '\0';
3465
3466                 pat = savepat;
3467                 items = saveitems;
3468             }
3469             break;
3470         case 'C':
3471         case 'c':
3472             while (len-- > 0) {
3473                 fromstr = NEXTFROM;
3474                 aint = SvIV(fromstr);
3475                 achar = aint;
3476                 sv_catpvn(cat, &achar, sizeof(char));
3477             }
3478             break;
3479         /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
3480         case 'f':
3481         case 'F':
3482             while (len-- > 0) {
3483                 fromstr = NEXTFROM;
3484                 afloat = (float)SvNV(fromstr);
3485                 sv_catpvn(cat, (char *)&afloat, sizeof (float));
3486             }
3487             break;
3488         case 'd':
3489         case 'D':
3490             while (len-- > 0) {
3491                 fromstr = NEXTFROM;
3492                 adouble = (double)SvNV(fromstr);
3493                 sv_catpvn(cat, (char *)&adouble, sizeof (double));
3494             }
3495             break;
3496         case 'n':
3497             while (len-- > 0) {
3498                 fromstr = NEXTFROM;
3499                 ashort = (I16)SvIV(fromstr);
3500 #ifdef HAS_HTONS
3501                 ashort = htons(ashort);
3502 #endif
3503                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3504             }
3505             break;
3506         case 'v':
3507             while (len-- > 0) {
3508                 fromstr = NEXTFROM;
3509                 ashort = (I16)SvIV(fromstr);
3510 #ifdef HAS_HTOVS
3511                 ashort = htovs(ashort);
3512 #endif
3513                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3514             }
3515             break;
3516         case 'S':
3517         case 's':
3518             while (len-- > 0) {
3519                 fromstr = NEXTFROM;
3520                 ashort = (I16)SvIV(fromstr);
3521                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3522             }
3523             break;
3524         case 'I':
3525             while (len-- > 0) {
3526                 fromstr = NEXTFROM;
3527                 auint = U_I(SvNV(fromstr));
3528                 sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
3529             }
3530             break;
3531         case 'w':
3532             while (len-- > 0) {
3533                 fromstr = NEXTFROM;
3534                 adouble = floor(SvNV(fromstr));
3535
3536                 if (adouble < 0)
3537                     croak("Cannot compress negative numbers");
3538
3539                 if (adouble <= UV_MAX) {
3540                     char   buf[1 + sizeof(UV)];
3541                     char  *in = buf + sizeof(buf);
3542                     UV     auv = U_V(adouble);;
3543
3544                     do {
3545                         *--in = (auv & 0x7f) | 0x80;
3546                         auv >>= 7;
3547                     } while (auv);
3548                     buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
3549                     sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
3550                 }
3551                 else if (SvPOKp(fromstr)) {  /* decimal string arithmetics */
3552                     char           *from, *result, *in;
3553                     SV             *norm;
3554                     STRLEN          len;
3555                     bool            done;
3556
3557                     /* Copy string and check for compliance */
3558                     from = SvPV(fromstr, len);
3559                     if ((norm = is_an_int(from, len)) == NULL)
3560                         croak("can compress only unsigned integer");
3561
3562                     New('w', result, len, char);
3563                     in = result + len;
3564                     done = FALSE;
3565                     while (!done)
3566                         *--in = div128(norm, &done) | 0x80;
3567                     result[len - 1] &= 0x7F; /* clear continue bit */
3568                     sv_catpvn(cat, in, (result + len) - in);
3569                     Safefree(result);
3570                     SvREFCNT_dec(norm); /* free norm */
3571                 }
3572                 else if (SvNOKp(fromstr)) {
3573                     char   buf[sizeof(double) * 2];     /* 8/7 <= 2 */
3574                     char  *in = buf + sizeof(buf);
3575
3576                     do {
3577                         double next = floor(adouble / 128);
3578                         *--in = (unsigned char)(adouble - (next * 128)) | 0x80;
3579                         if (--in < buf)  /* this cannot happen ;-) */
3580                             croak ("Cannot compress integer");
3581                         adouble = next;
3582                     } while (adouble > 0);
3583                     buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
3584                     sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
3585                 }
3586                 else
3587                     croak("Cannot compress non integer");
3588             }
3589             break;
3590         case 'i':
3591             while (len-- > 0) {
3592                 fromstr = NEXTFROM;
3593                 aint = SvIV(fromstr);
3594                 sv_catpvn(cat, (char*)&aint, sizeof(int));
3595             }
3596             break;
3597         case 'N':
3598             while (len-- > 0) {
3599                 fromstr = NEXTFROM;
3600                 aulong = U_L(SvNV(fromstr));
3601 #ifdef HAS_HTONL
3602                 aulong = htonl(aulong);
3603 #endif
3604                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3605             }
3606             break;
3607         case 'V':
3608             while (len-- > 0) {
3609                 fromstr = NEXTFROM;
3610                 aulong = U_L(SvNV(fromstr));
3611 #ifdef HAS_HTOVL
3612                 aulong = htovl(aulong);
3613 #endif
3614                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3615             }
3616             break;
3617         case 'L':
3618             while (len-- > 0) {
3619                 fromstr = NEXTFROM;
3620                 aulong = U_L(SvNV(fromstr));
3621                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3622             }
3623             break;
3624         case 'l':
3625             while (len-- > 0) {
3626                 fromstr = NEXTFROM;
3627                 along = SvIV(fromstr);
3628                 sv_catpvn(cat, (char*)&along, sizeof(I32));
3629             }
3630             break;
3631 #ifdef HAS_QUAD
3632         case 'Q':
3633             while (len-- > 0) {
3634                 fromstr = NEXTFROM;
3635                 auquad = (unsigned Quad_t)SvIV(fromstr);
3636                 sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
3637             }
3638             break;
3639         case 'q':
3640             while (len-- > 0) {
3641                 fromstr = NEXTFROM;
3642                 aquad = (Quad_t)SvIV(fromstr);
3643                 sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
3644             }
3645             break;
3646 #endif /* HAS_QUAD */
3647         case 'P':
3648             len = 1;            /* assume SV is correct length */
3649             /* FALL THROUGH */
3650         case 'p':
3651             while (len-- > 0) {
3652                 fromstr = NEXTFROM;
3653                 aptr = SvPV_force(fromstr, na); /* XXX Error if TEMP? */
3654                 sv_catpvn(cat, (char*)&aptr, sizeof(char*));
3655             }
3656             break;
3657         case 'u':
3658             fromstr = NEXTFROM;
3659             aptr = SvPV(fromstr, fromlen);
3660             SvGROW(cat, fromlen * 4 / 3);
3661             if (len <= 1)
3662                 len = 45;
3663             else
3664                 len = len / 3 * 3;
3665             while (fromlen > 0) {
3666                 I32 todo;
3667
3668                 if (fromlen > len)
3669                     todo = len;
3670                 else
3671                     todo = fromlen;
3672                 doencodes(cat, aptr, todo);
3673                 fromlen -= todo;
3674                 aptr += todo;
3675             }
3676             break;
3677         }
3678     }
3679     SvSETMAGIC(cat);
3680     SP = ORIGMARK;
3681     PUSHs(cat);
3682     RETURN;
3683 }
3684 #undef NEXTFROM
3685
3686 PP(pp_split)
3687 {
3688     dSP; dTARG;
3689     AV *ary;
3690     register I32 limit = POPi;                  /* note, negative is forever */
3691     SV *sv = POPs;
3692     STRLEN len;
3693     register char *s = SvPV(sv, len);
3694     char *strend = s + len;
3695     register PMOP *pm = (PMOP*)POPs;
3696     register SV *dstr;
3697     register char *m;
3698     I32 iters = 0;
3699     I32 maxiters = (strend - s) + 10;
3700     I32 i;
3701     char *orig;
3702     I32 origlimit = limit;
3703     I32 realarray = 0;
3704     I32 base;
3705     AV *oldstack = curstack;
3706     register REGEXP *rx = pm->op_pmregexp;
3707     I32 gimme = GIMME;
3708     I32 oldsave = savestack_ix;
3709
3710     if (!pm || !s)
3711         DIE("panic: do_split");
3712
3713     TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
3714              (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
3715
3716     if (pm->op_pmreplroot)
3717         ary = GvAVn((GV*)pm->op_pmreplroot);
3718     else if (gimme != G_ARRAY)
3719         ary = GvAVn(defgv);
3720     else
3721         ary = Nullav;
3722     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
3723         realarray = 1;
3724         if (!AvREAL(ary)) {
3725             AvREAL_on(ary);
3726             for (i = AvFILL(ary); i >= 0; i--)
3727                 AvARRAY(ary)[i] = &sv_undef;    /* don't free mere refs */
3728         }
3729         av_extend(ary,0);
3730         av_clear(ary);
3731         /* temporarily switch stacks */
3732         SWITCHSTACK(curstack, ary);
3733     }
3734     base = SP - stack_base;
3735     orig = s;
3736     if (pm->op_pmflags & PMf_SKIPWHITE) {
3737         if (pm->op_pmflags & PMf_LOCALE) {
3738             while (isSPACE_LC(*s))
3739                 s++;
3740         }
3741         else {
3742             while (isSPACE(*s))
3743                 s++;
3744         }
3745     }
3746     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
3747         SAVEINT(multiline);
3748         multiline = pm->op_pmflags & PMf_MULTILINE;
3749     }
3750
3751     if (!limit)
3752         limit = maxiters + 2;
3753     if (pm->op_pmflags & PMf_WHITE) {
3754         while (--limit) {
3755             m = s;
3756             while (m < strend &&
3757                    !((pm->op_pmflags & PMf_LOCALE)
3758                      ? isSPACE_LC(*m) : isSPACE(*m)))
3759                 ++m;
3760             if (m >= strend)
3761                 break;
3762
3763             dstr = NEWSV(30, m-s);
3764             sv_setpvn(dstr, s, m-s);
3765             if (!realarray)
3766                 sv_2mortal(dstr);
3767             XPUSHs(dstr);
3768
3769             s = m + 1;
3770             while (s < strend &&
3771                    ((pm->op_pmflags & PMf_LOCALE)
3772                     ? isSPACE_LC(*s) : isSPACE(*s)))
3773                 ++s;
3774         }
3775     }
3776     else if (strEQ("^", rx->precomp)) {
3777         while (--limit) {
3778             /*SUPPRESS 530*/
3779             for (m = s; m < strend && *m != '\n'; m++) ;
3780             m++;
3781             if (m >= strend)
3782                 break;
3783             dstr = NEWSV(30, m-s);
3784             sv_setpvn(dstr, s, m-s);
3785             if (!realarray)
3786                 sv_2mortal(dstr);
3787             XPUSHs(dstr);
3788             s = m;
3789         }
3790     }
3791     else if (pm->op_pmshort) {
3792         i = SvCUR(pm->op_pmshort);
3793         if (i == 1) {
3794             i = *SvPVX(pm->op_pmshort);
3795             while (--limit) {
3796                 /*SUPPRESS 530*/
3797                 for (m = s; m < strend && *m != i; m++) ;
3798                 if (m >= strend)
3799                     break;
3800                 dstr = NEWSV(30, m-s);
3801                 sv_setpvn(dstr, s, m-s);
3802                 if (!realarray)
3803                     sv_2mortal(dstr);
3804                 XPUSHs(dstr);
3805                 s = m + 1;
3806             }
3807         }
3808         else {
3809 #ifndef lint
3810             while (s < strend && --limit &&
3811               (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
3812                     pm->op_pmshort)) )
3813 #endif
3814             {
3815                 dstr = NEWSV(31, m-s);
3816                 sv_setpvn(dstr, s, m-s);
3817                 if (!realarray)
3818                     sv_2mortal(dstr);
3819                 XPUSHs(dstr);
3820                 s = m + i;
3821             }
3822         }
3823     }
3824     else {
3825         maxiters += (strend - s) * rx->nparens;
3826         while (s < strend && --limit &&
3827                pregexec(rx, s, strend, orig, 1, Nullsv, TRUE))
3828         {
3829             TAINT_IF(rx->exec_tainted);
3830             if (rx->subbase
3831               && rx->subbase != orig) {
3832                 m = s;
3833                 s = orig;
3834                 orig = rx->subbase;
3835                 s = orig + (m - s);
3836                 strend = s + (strend - m);
3837             }
3838             m = rx->startp[0];
3839             dstr = NEWSV(32, m-s);
3840             sv_setpvn(dstr, s, m-s);
3841             if (!realarray)
3842                 sv_2mortal(dstr);
3843             XPUSHs(dstr);
3844             if (rx->nparens) {
3845                 for (i = 1; i <= rx->nparens; i++) {
3846                     s = rx->startp[i];
3847                     m = rx->endp[i];
3848                     if (m && s) {
3849                         dstr = NEWSV(33, m-s);
3850                         sv_setpvn(dstr, s, m-s);
3851                     }
3852                     else
3853                         dstr = NEWSV(33, 0);
3854                     if (!realarray)
3855                         sv_2mortal(dstr);
3856                     XPUSHs(dstr);
3857                 }
3858             }
3859             s = rx->endp[0];
3860         }
3861     }
3862     LEAVE_SCOPE(oldsave);
3863     iters = (SP - stack_base) - base;
3864     if (iters > maxiters)
3865         DIE("Split loop");
3866
3867     /* keep field after final delim? */
3868     if (s < strend || (iters && origlimit)) {
3869         dstr = NEWSV(34, strend-s);
3870         sv_setpvn(dstr, s, strend-s);
3871         if (!realarray)
3872             sv_2mortal(dstr);
3873         XPUSHs(dstr);
3874         iters++;
3875     }
3876     else if (!origlimit) {
3877         while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
3878             iters--, SP--;
3879     }
3880     if (realarray) {
3881         SWITCHSTACK(ary, oldstack);
3882         if (gimme == G_ARRAY) {
3883             EXTEND(SP, iters);
3884             Copy(AvARRAY(ary), SP + 1, iters, SV*);
3885             SP += iters;
3886             RETURN;
3887         }
3888     }
3889     else {
3890         if (gimme == G_ARRAY)
3891             RETURN;
3892     }
3893     if (iters || !pm->op_pmreplroot) {
3894         GETTARGET;
3895         PUSHi(iters);
3896         RETURN;
3897     }
3898     RETPUSHUNDEF;
3899 }
3900