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