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