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