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