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