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