pp.c

   1 /***********************************************************
   2  *
   3  * $Header: /usr/src/local/lwall/perl5/RCS/pp.c, v 4.1 92/08/07 18:26:21 lwall Exp Locker: lwall $
   4  *
   5  * Description:
   6  *      Push/Pop code.
   7  *
   8  * Standards:
   9  *
  10  * Created:
  11  *      Mon Jun 15 16:45:59 1992
  12  *
  13  * Author:
  14  *      Larry Wall <lwall@netlabs.com>
  15  *
  16  * $Log:        pp.c, v $
  17  * Revision 4.1  92/08/07  18:26:21  lwall
  18  *
  19  *
  20  **********************************************************/
  21
  22 #include "EXTERN.h"
  23 #include "perl.h"
  24
  25 #ifdef HAS_SOCKET
  26 # include <sys/socket.h>
  27 # include <netdb.h>
  28 # ifndef ENOTSOCK
  29 #  ifdef I_NET_ERRNO
  30 #   include <net/errno.h>
  31 #  endif
  32 # endif
  33 #endif
  34
  35 #ifdef HAS_SELECT
  36 #ifdef I_SYS_SELECT
  37 #ifndef I_SYS_TIME
  38 #include <sys/select.h>
  39 #endif
  40 #endif
  41 #endif
  42
  43 #ifdef HOST_NOT_FOUND
  44 extern int h_errno;
  45 #endif
  46
  47 #ifdef HAS_PASSWD
  48 # ifdef I_PWD
  49 #  include <pwd.h>
  50 # else
  51     struct passwd *getpwnam P((char *));
  52     struct passwd *getpwuid P((Uid_t));
  53 # endif
  54   struct passwd *getpwent();
  55 #endif
  56
  57 #ifdef HAS_GROUP
  58 # ifdef I_GRP
  59 #  include <grp.h>
  60 # else
  61     struct group *getgrnam P((char *));
  62     struct group *getgrgid P((Gid_t));
  63 # endif
  64     struct group *getgrent();
  65 #endif
  66
  67 #ifdef I_UTIME
  68 #include <utime.h>
  69 #endif
  70 #ifdef I_FCNTL
  71 #include <fcntl.h>
  72 #endif
  73 #ifdef I_SYS_FILE
  74 #include <sys/file.h>
  75 #endif
  76
  77 #ifdef HAS_GETPGRP2
  78 #   define getpgrp getpgrp2
  79 #endif
  80
  81 #ifdef HAS_SETPGRP2
  82 #   define setpgrp setpgrp2
  83 #endif
  84
  85 #ifdef HAS_GETPGRP2
  86 #   define getpgrp getpgrp2
  87 #endif
  88
  89 #ifdef HAS_SETPGRP2
  90 #   define setpgrp setpgrp2
  91 #endif
  92
  93 #ifdef HAS_GETPGRP2
  94 #   define getpgrp getpgrp2
  95 #endif
  96
  97 #ifdef HAS_SETPGRP2
  98 #   define setpgrp setpgrp2
  99 #endif
 100
 101 static I32 dopoptosub P((I32 startingblock));
 102
 103 /* Nothing. */
 104
 105 PP(pp_null)
 106 {
 107     return NORMAL;
 108 }
 109
 110 PP(pp_stub)
 111 {
 112     dSP;
 113     if (GIMME != G_ARRAY) {
 114         XPUSHs(&sv_undef);
 115     }
 116     RETURN;
 117 }
 118
 119 PP(pp_scalar)
 120 {
 121     return NORMAL;
 122 }
 123
 124 /* Pushy stuff. */
 125
 126 PP(pp_pushmark)
 127 {
 128     if (++markstack_ptr == markstack_max) {
 129         I32 oldmax = markstack_max - markstack;
 130         I32 newmax = oldmax * 3 / 2;
 131
 132         Renew(markstack, newmax, I32);
 133         markstack_ptr = markstack + oldmax;
 134         markstack_max = markstack + newmax;
 135     }
 136     *markstack_ptr = stack_sp - stack_base;
 137     return NORMAL;
 138 }
 139
 140 PP(pp_wantarray)
 141 {
 142     dSP;
 143     I32 cxix;
 144     EXTEND(SP, 1);
 145
 146     cxix = dopoptosub(cxstack_ix);
 147     if (cxix < 0)
 148         RETPUSHUNDEF;
 149
 150     if (cxstack[cxix].blk_gimme == G_ARRAY)
 151         RETPUSHYES;
 152     else
 153         RETPUSHNO;
 154 }
 155
 156 PP(pp_const)
 157 {
 158     dSP;
 159     XPUSHs(cSVOP->op_sv);
 160     RETURN;
 161 }
 162
 163 static void
 164 ucase(s,send)
 165 register char *s;
 166 register char *send;
 167 {
 168     while (s < send) {
 169         if (isLOWER(*s))
 170             *s = toupper(*s);
 171         s++;
 172     }
 173 }
 174
 175 static void
 176 lcase(s,send)
 177 register char *s;
 178 register char *send;
 179 {
 180     while (s < send) {
 181         if (isUPPER(*s))
 182             *s = tolower(*s);
 183         s++;
 184     }
 185 }
 186
 187 PP(pp_interp)
 188 {
 189     DIE("panic: pp_interp");
 190 }
 191
 192 PP(pp_gvsv)
 193 {
 194     dSP;
 195     EXTEND(sp,1);
 196     if (op->op_flags & OPf_INTRO)
 197         PUSHs(save_scalar(cGVOP->op_gv));
 198     else
 199         PUSHs(GvSV(cGVOP->op_gv));
 200     RETURN;
 201 }
 202
 203 PP(pp_gv)
 204 {
 205     dSP;
 206     XPUSHs((SV*)cGVOP->op_gv);
 207     RETURN;
 208 }
 209
 210 PP(pp_padsv)
 211 {
 212     dSP; dTARGET;
 213     XPUSHs(TARG);
 214     if (op->op_flags & OPf_INTRO)
 215         SAVECLEARSV(curpad[op->op_targ]);
 216     RETURN;
 217 }
 218
 219 PP(pp_padav)
 220 {
 221     dSP; dTARGET;
 222     if (op->op_flags & OPf_INTRO)
 223         SAVECLEARSV(curpad[op->op_targ]);
 224     EXTEND(SP, 1);
 225     if (op->op_flags & OPf_LVAL) {
 226         PUSHs(TARG);
 227         RETURN;
 228     }
 229     if (GIMME == G_ARRAY) {
 230         I32 maxarg = AvFILL((AV*)TARG) + 1;
 231         EXTEND(SP, maxarg);
 232         Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
 233         SP += maxarg;
 234     }
 235     else {
 236         SV* sv = sv_newmortal();
 237         I32 maxarg = AvFILL((AV*)TARG) + 1;
 238         sv_setiv(sv, maxarg);
 239         PUSHs(sv);
 240     }
 241     RETURN;
 242 }
 243
 244 PP(pp_padhv)
 245 {
 246     dSP; dTARGET;
 247     XPUSHs(TARG);
 248     if (op->op_flags & OPf_INTRO)
 249         SAVECLEARSV(curpad[op->op_targ]);
 250     if (op->op_flags & OPf_LVAL)
 251         RETURN;
 252     if (GIMME == G_ARRAY) { /* array wanted */
 253         return do_kv(ARGS);
 254     }
 255     else {
 256         SV* sv = sv_newmortal();
 257         if (HvFILL((HV*)TARG)) {
 258             sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
 259             sv_setpv(sv, buf);
 260         }
 261         else
 262             sv_setiv(sv, 0);
 263         SETs(sv);
 264         RETURN;
 265     }
 266 }
 267
 268 PP(pp_padany)
 269 {
 270     DIE("NOT IMPL LINE %d",__LINE__);
 271 }
 272
 273 PP(pp_pushre)
 274 {
 275     dSP;
 276     XPUSHs((SV*)op);
 277     RETURN;
 278 }
 279
 280 /* Translations. */
 281
 282 PP(pp_rv2gv)
 283 {
 284     dSP; dTOPss;
 285     if (SvROK(sv)) {
 286         sv = SvRV(sv);
 287         if (SvTYPE(sv) != SVt_PVGV)
 288             DIE("Not a symbol reference");
 289     }
 290     else {
 291         if (SvTYPE(sv) != SVt_PVGV) {
 292             if (!SvOK(sv))
 293                 DIE(no_usym, "a symbol");
 294             if (op->op_private & HINT_STRICT_REFS)
 295                 DIE(no_hardref, "a symbol");
 296             sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVGV);
 297         }
 298     }
 299     if (op->op_flags & OPf_INTRO) {
 300         GP *ogp = GvGP(sv);
 301
 302         SSCHECK(3);
 303         SSPUSHPTR(sv);
 304         SSPUSHPTR(ogp);
 305         SSPUSHINT(SAVEt_GP);
 306
 307         if (op->op_flags & OPf_SPECIAL)
 308             GvGP(sv)->gp_refcnt++;              /* will soon be assigned */
 309         else {
 310             GP *gp;
 311             Newz(602,gp, 1, GP);
 312             GvGP(sv) = gp;
 313             GvREFCNT(sv) = 1;
 314             GvSV(sv) = NEWSV(72,0);
 315             GvLINE(sv) = curcop->cop_line;
 316             GvEGV(sv) = sv;
 317         }
 318     }
 319     SETs(sv);
 320     RETURN;
 321 }
 322
 323 PP(pp_sv2len)
 324 {
 325     dSP; dTARGET;
 326     dPOPss;
 327     PUSHi(sv_len(sv));
 328     RETURN;
 329 }
 330
 331 PP(pp_rv2sv)
 332 {
 333     dSP; dTOPss;
 334
 335     if (SvROK(sv)) {
 336         sv = SvRV(sv);
 337         switch (SvTYPE(sv)) {
 338         case SVt_PVAV:
 339         case SVt_PVHV:
 340         case SVt_PVCV:
 341             DIE("Not a scalar reference");
 342         }
 343     }
 344     else {
 345         GV *gv = sv;
 346         if (SvTYPE(gv) != SVt_PVGV) {
 347             if (!SvOK(sv))
 348                 DIE(no_usym, "a scalar");
 349             if (op->op_private & HINT_STRICT_REFS)
 350                 DIE(no_hardref, "a scalar");
 351             gv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PV);
 352         }
 353         sv = GvSV(gv);
 354         if (op->op_private & (OPpDEREF_AV|OPpDEREF_HV)) {
 355             if (op->op_private & OPpDEREF_HV &&
 356               (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVHV)) {
 357                 if (op->op_private & HINT_STRICT_REFS && !SvROK(sv) && SvOK(sv))
 358                     DIE(no_hardref, "a hash");
 359                 SvREFCNT_dec(sv);
 360                 sv = NEWSV(0,0);
 361                 sv_upgrade(sv, SVt_RV);
 362                 SvRV(sv) = SvREFCNT_inc(newHV());
 363                 SvROK_on(sv);
 364                 ++sv_rvcount;
 365                 GvSV(gv) = sv;
 366             }
 367             else if (op->op_private & OPpDEREF_AV &&
 368               (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV)) {
 369                 if (op->op_private & HINT_STRICT_REFS && !SvROK(sv) && SvOK(sv))
 370                     DIE(no_hardref, "an array");
 371                 SvREFCNT_dec(sv);
 372                 sv = NEWSV(0,0);
 373                 sv_upgrade(sv, SVt_RV);
 374                 SvRV(sv) = SvREFCNT_inc(newAV());
 375                 SvROK_on(sv);
 376                 ++sv_rvcount;
 377                 GvSV(gv) = sv;
 378             }
 379         }
 380     }
 381     if (op->op_flags & OPf_INTRO)
 382         SETs(save_scalar((GV*)TOPs));
 383     else
 384         SETs(sv);
 385     RETURN;
 386 }
 387
 388 PP(pp_av2arylen)
 389 {
 390     dSP;
 391     AV *av = (AV*)TOPs;
 392     SV *sv = AvARYLEN(av);
 393     if (!sv) {
 394         AvARYLEN(av) = sv = NEWSV(0,0);
 395         sv_upgrade(sv, SVt_IV);
 396         sv_magic(sv, (SV*)av, '#', Nullch, 0);
 397     }
 398     SETs(sv);
 399     RETURN;
 400 }
 401
 402 PP(pp_rv2cv)
 403 {
 404     dSP;
 405     SV *sv;
 406     GV *gv;
 407     HV *stash;
 408
 409     /* We always try to add a non-existent subroutine in case of AUTOLOAD. */
 410     CV *cv = sv_2cv(TOPs, &stash, &gv, TRUE);
 411
 412     SETs((SV*)cv);
 413     RETURN;
 414 }
 415
 416 PP(pp_refgen)
 417 {
 418     dSP; dTOPss;
 419     SV* rv;
 420     if (!sv)
 421         RETSETUNDEF;
 422     rv = sv_newmortal();
 423     sv_upgrade(rv, SVt_RV);
 424     SvRV(rv) = SvREFCNT_inc(sv);
 425     SvROK_on(rv);
 426     ++sv_rvcount;
 427     SETs(rv);
 428     RETURN;
 429 }
 430
 431 PP(pp_ref)
 432 {
 433     dSP; dTARGET;
 434     SV *sv;
 435     char *pv;
 436
 437     if (MAXARG < 1) {
 438         sv = GvSV(defgv);
 439         EXTEND(SP, 1);
 440     }
 441     else
 442         sv = POPs;
 443     if (!SvROK(sv))
 444         RETPUSHUNDEF;
 445
 446     sv = SvRV(sv);
 447     if (SvOBJECT(sv))
 448         pv = HvNAME(SvSTASH(sv));
 449     else {
 450         switch (SvTYPE(sv)) {
 451         case SVt_NULL:
 452         case SVt_IV:
 453         case SVt_NV:
 454         case SVt_RV:
 455         case SVt_PV:
 456         case SVt_PVIV:
 457         case SVt_PVNV:
 458         case SVt_PVMG:
 459         case SVt_PVBM:
 460                                 if (SvROK(sv))
 461                                     pv = "REF";
 462                                 else
 463                                     pv = "SCALAR";
 464                                 break;
 465         case SVt_PVLV:          pv = "LVALUE";          break;
 466         case SVt_PVAV:          pv = "ARRAY";           break;
 467         case SVt_PVHV:          pv = "HASH";            break;
 468         case SVt_PVCV:          pv = "CODE";            break;
 469         case SVt_PVGV:          pv = "GLOB";            break;
 470         case SVt_PVFM:          pv = "FORMLINE";        break;
 471         default:                pv = "UNKNOWN";         break;
 472         }
 473     }
 474     PUSHp(pv, strlen(pv));
 475     RETURN;
 476 }
 477
 478 PP(pp_bless)
 479 {
 480     dSP;
 481     register SV* ref;
 482     SV *sv;
 483     HV *stash;
 484
 485     if (MAXARG == 1)
 486         stash = curcop->cop_stash;
 487     else
 488         stash = fetch_stash(POPs, TRUE);
 489
 490     sv = TOPs;
 491     if (!SvROK(sv))
 492         DIE("Can't bless non-reference value");
 493     ref = SvRV(sv);
 494     SvOBJECT_on(ref);
 495     SvUPGRADE(ref, SVt_PVMG);
 496     SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
 497     RETURN;
 498 }
 499
 500 /* Pushy I/O. */
 501
 502 PP(pp_backtick)
 503 {
 504     dSP; dTARGET;
 505     FILE *fp;
 506     char *tmps = POPp;
 507     TAINT_PROPER("``");
 508     fp = my_popen(tmps, "r");
 509     if (fp) {
 510         sv_setpv(TARG, "");     /* note that this preserves previous buffer */
 511         if (GIMME == G_SCALAR) {
 512             while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
 513                 /*SUPPRESS 530*/
 514                 ;
 515             XPUSHs(TARG);
 516         }
 517         else {
 518             SV *sv;
 519
 520             for (;;) {
 521                 sv = NEWSV(56, 80);
 522                 if (sv_gets(sv, fp, 0) == Nullch) {
 523                     SvREFCNT_dec(sv);
 524                     break;
 525                 }
 526                 XPUSHs(sv_2mortal(sv));
 527                 if (SvLEN(sv) - SvCUR(sv) > 20) {
 528                     SvLEN_set(sv, SvCUR(sv)+1);
 529                     Renew(SvPVX(sv), SvLEN(sv), char);
 530                 }
 531             }
 532         }
 533         statusvalue = my_pclose(fp);
 534     }
 535     else {
 536         statusvalue = -1;
 537         if (GIMME == G_SCALAR)
 538             RETPUSHUNDEF;
 539     }
 540
 541     RETURN;
 542 }
 543
 544 OP *
 545 do_readline()
 546 {
 547     dSP; dTARGETSTACKED;
 548     register SV *sv;
 549     STRLEN tmplen;
 550     STRLEN offset;
 551     FILE *fp;
 552     register IO *io = GvIO(last_in_gv);
 553     register I32 type = op->op_type;
 554
 555     fp = Nullfp;
 556     if (io) {
 557         fp = IoIFP(io);
 558         if (!fp) {
 559             if (IoFLAGS(io) & IOf_ARGV) {
 560                 if (IoFLAGS(io) & IOf_START) {
 561                     IoFLAGS(io) &= ~IOf_START;
 562                     IoLINES(io) = 0;
 563                     if (av_len(GvAVn(last_in_gv)) < 0) {
 564                         SV *tmpstr = newSVpv("-", 1); /* assume stdin */
 565                         (void)av_push(GvAVn(last_in_gv), tmpstr);
 566                     }
 567                 }
 568                 fp = nextargv(last_in_gv);
 569                 if (!fp) { /* Note: fp != IoIFP(io) */
 570                     (void)do_close(last_in_gv, FALSE); /* now it does*/
 571                     IoFLAGS(io) |= IOf_START;
 572                 }
 573             }
 574             else if (type == OP_GLOB) {
 575                 SV *tmpcmd = NEWSV(55, 0);
 576                 SV *tmpglob = POPs;
 577                 ENTER;
 578                 SAVEFREESV(tmpcmd);
 579 #ifdef DOSISH
 580                 sv_setpv(tmpcmd, "perlglob ");
 581                 sv_catsv(tmpcmd, tmpglob);
 582                 sv_catpv(tmpcmd, " |");
 583 #else
 584 #ifdef CSH
 585                 sv_setpvn(tmpcmd, cshname, cshlen);
 586                 sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
 587                 sv_catsv(tmpcmd, tmpglob);
 588                 sv_catpv(tmpcmd, "'|");
 589 #else
 590                 sv_setpv(tmpcmd, "echo ");
 591                 sv_catsv(tmpcmd, tmpglob);
 592                 sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
 593 #endif /* !CSH */
 594 #endif /* !MSDOS */
 595                 (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd));
 596                 fp = IoIFP(io);
 597                 LEAVE;
 598             }
 599         }
 600         else if (type == OP_GLOB)
 601             SP--;
 602     }
 603     if (!fp) {
 604         if (dowarn)
 605             warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
 606         if (GIMME == G_SCALAR)
 607             RETPUSHUNDEF;
 608         RETURN;
 609     }
 610     if (GIMME == G_ARRAY) {
 611         sv = sv_2mortal(NEWSV(57, 80));
 612         offset = 0;
 613     }
 614     else {
 615         sv = TARG;
 616         SvUPGRADE(sv, SVt_PV);
 617         tmplen = SvLEN(sv);     /* remember if already alloced */
 618         if (!tmplen)
 619             Sv_Grow(sv, 80);    /* try short-buffering it */
 620         if (type == OP_RCATLINE)
 621             offset = SvCUR(sv);
 622         else
 623             offset = 0;
 624     }
 625     for (;;) {
 626         if (!sv_gets(sv, fp, offset)) {
 627             clearerr(fp);
 628             if (IoFLAGS(io) & IOf_ARGV) {
 629                 fp = nextargv(last_in_gv);
 630                 if (fp)
 631                     continue;
 632                 (void)do_close(last_in_gv, FALSE);
 633                 IoFLAGS(io) |= IOf_START;
 634             }
 635             else if (type == OP_GLOB) {
 636                 (void)do_close(last_in_gv, FALSE);
 637             }
 638             if (GIMME == G_SCALAR)
 639                 RETPUSHUNDEF;
 640             RETURN;
 641         }
 642         IoLINES(io)++;
 643         XPUSHs(sv);
 644         if (tainting) {
 645             tainted = TRUE;
 646             SvTAINT(sv); /* Anything from the outside world...*/
 647         }
 648         if (type == OP_GLOB) {
 649             char *tmps;
 650
 651             if (SvCUR(sv) > 0)
 652                 SvCUR(sv)--;
 653             if (*SvEND(sv) == rschar)
 654                 *SvEND(sv) = '\0';
 655             else
 656                 SvCUR(sv)++;
 657             for (tmps = SvPVX(sv); *tmps; tmps++)
 658                 if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
 659                     strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
 660                         break;
 661             if (*tmps && stat(SvPVX(sv), &statbuf) < 0) {
 662                 POPs;           /* Unmatched wildcard?  Chuck it... */
 663                 continue;
 664             }
 665         }
 666         if (GIMME == G_ARRAY) {
 667             if (SvLEN(sv) - SvCUR(sv) > 20) {
 668                 SvLEN_set(sv, SvCUR(sv)+1);
 669                 Renew(SvPVX(sv), SvLEN(sv), char);
 670             }
 671             sv = sv_2mortal(NEWSV(58, 80));
 672             continue;
 673         }
 674         else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
 675             /* try to reclaim a bit of scalar space (only on 1st alloc) */
 676             if (SvCUR(sv) < 60)
 677                 SvLEN_set(sv, 80);
 678             else
 679                 SvLEN_set(sv, SvCUR(sv)+40);    /* allow some slop */
 680             Renew(SvPVX(sv), SvLEN(sv), char);
 681         }
 682         RETURN;
 683     }
 684 }
 685
 686 PP(pp_glob)
 687 {
 688     OP *result;
 689     ENTER;
 690     SAVEINT(rschar);
 691     SAVEINT(rslen);
 692
 693     SAVESPTR(last_in_gv);       /* We don't want this to be permanent. */
 694     last_in_gv = (GV*)*stack_sp--;
 695
 696     rslen = 1;
 697 #ifdef DOSISH
 698     rschar = 0;
 699 #else
 700 #ifdef CSH
 701     rschar = 0;
 702 #else
 703     rschar = '\n';
 704 #endif  /* !CSH */
 705 #endif  /* !MSDOS */
 706     result = do_readline();
 707     LEAVE;
 708     return result;
 709 }
 710
 711 PP(pp_readline)
 712 {
 713     last_in_gv = (GV*)(*stack_sp--);
 714     return do_readline();
 715 }
 716
 717 PP(pp_indread)
 718 {
 719     last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
 720     return do_readline();
 721 }
 722
 723 PP(pp_rcatline)
 724 {
 725     last_in_gv = cGVOP->op_gv;
 726     return do_readline();
 727 }
 728
 729 PP(pp_regcmaybe)
 730 {
 731     return NORMAL;
 732 }
 733
 734 PP(pp_regcomp) {
 735     dSP;
 736     register PMOP *pm = (PMOP*)cLOGOP->op_other;
 737     register char *t;
 738     SV *tmpstr;
 739     STRLEN len;
 740
 741     tmpstr = POPs;
 742     t = SvPV(tmpstr, len);
 743
 744     if (pm->op_pmregexp) {
 745         regfree(pm->op_pmregexp);
 746         pm->op_pmregexp = Null(REGEXP*);        /* crucial if regcomp aborts */
 747     }
 748
 749     pm->op_pmregexp = regcomp(t, t + len, pm->op_pmflags & PMf_FOLD);
 750
 751     if (!pm->op_pmregexp->prelen && curpm)
 752         pm = curpm;
 753     else if (strEQ("\\s+", pm->op_pmregexp->precomp))
 754         pm->op_pmflags |= PMf_WHITE;
 755
 756     if (pm->op_pmflags & PMf_KEEP) {
 757         if (!(pm->op_pmflags & PMf_FOLD))
 758             scan_prefix(pm, pm->op_pmregexp->precomp,
 759                 pm->op_pmregexp->prelen);
 760         pm->op_pmflags &= ~PMf_RUNTIME; /* no point compiling again */
 761         hoistmust(pm);
 762         cLOGOP->op_first->op_next = op->op_next;
 763         /* XXX delete push code? */
 764     }
 765     RETURN;
 766 }
 767
 768 PP(pp_match)
 769 {
 770     dSP; dTARG;
 771     register PMOP *pm = cPMOP;
 772     register char *t;
 773     register char *s;
 774     char *strend;
 775     SV *tmpstr;
 776     I32 global;
 777     I32 safebase;
 778     char *truebase;
 779     register REGEXP *rx = pm->op_pmregexp;
 780     I32 gimme = GIMME;
 781     STRLEN len;
 782
 783     if (op->op_flags & OPf_STACKED)
 784         TARG = POPs;
 785     else {
 786         TARG = GvSV(defgv);
 787         EXTEND(SP,1);
 788     }
 789     s = SvPV(TARG, len);
 790     strend = s + len;
 791     if (!s)
 792         DIE("panic: do_match");
 793
 794     if (pm->op_pmflags & PMf_USED) {
 795         if (gimme == G_ARRAY)
 796             RETURN;
 797         RETPUSHNO;
 798     }
 799
 800     if (!rx->prelen && curpm) {
 801         pm = curpm;
 802         rx = pm->op_pmregexp;
 803     }
 804     truebase = t = s;
 805     if (global = pm->op_pmflags & PMf_GLOBAL) {
 806         rx->startp[0] = 0;
 807         if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
 808             MAGIC* mg = mg_find(TARG, 'g');
 809             if (mg && mg->mg_ptr) {
 810                 rx->startp[0] = mg->mg_ptr;
 811                 rx->endp[0] = mg->mg_ptr + mg->mg_len;
 812             }
 813         }
 814     }
 815     safebase = (gimme == G_ARRAY) || global;
 816
 817 play_it_again:
 818     if (global && rx->startp[0]) {
 819         t = s = rx->endp[0];
 820         if (s == rx->startp[0])
 821             s++, t++;
 822         if (s > strend)
 823             goto nope;
 824     }
 825     if (pm->op_pmshort) {
 826         if (pm->op_pmflags & PMf_SCANFIRST) {
 827             if (SvSCREAM(TARG)) {
 828                 if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
 829                     goto nope;
 830                 else if (!(s = screaminstr(TARG, pm->op_pmshort)))
 831                     goto nope;
 832                 else if (pm->op_pmflags & PMf_ALL)
 833                     goto yup;
 834             }
 835             else if (!(s = fbm_instr((unsigned char*)s,
 836               (unsigned char*)strend, pm->op_pmshort)))
 837                 goto nope;
 838             else if (pm->op_pmflags & PMf_ALL)
 839                 goto yup;
 840             if (s && rx->regback >= 0) {
 841                 ++BmUSEFUL(pm->op_pmshort);
 842                 s -= rx->regback;
 843                 if (s < t)
 844                     s = t;
 845             }
 846             else
 847                 s = t;
 848         }
 849         else if (!multiline) {
 850             if (*SvPVX(pm->op_pmshort) != *s ||
 851               bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
 852                 if (pm->op_pmflags & PMf_FOLD) {
 853                     if (ibcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) )
 854                         goto nope;
 855                 }
 856                 else
 857                     goto nope;
 858             }
 859         }
 860         if (--BmUSEFUL(pm->op_pmshort) < 0) {
 861             SvREFCNT_dec(pm->op_pmshort);
 862             pm->op_pmshort = Nullsv;    /* opt is being useless */
 863         }
 864     }
 865     if (!rx->nparens && !global) {
 866         gimme = G_SCALAR;                       /* accidental array context? */
 867         safebase = FALSE;
 868     }
 869     if (regexec(rx, s, strend, truebase, 0,
 870       SvSCREAM(TARG) ? TARG : Nullsv,
 871       safebase)) {
 872         curpm = pm;
 873         if (pm->op_pmflags & PMf_ONCE)
 874             pm->op_pmflags |= PMf_USED;
 875         goto gotcha;
 876     }
 877     else
 878         goto ret_no;
 879     /*NOTREACHED*/
 880
 881   gotcha:
 882     if (gimme == G_ARRAY) {
 883         I32 iters, i, len;
 884
 885         iters = rx->nparens;
 886         if (global && !iters)
 887             i = 1;
 888         else
 889             i = 0;
 890         EXTEND(SP, iters + i);
 891         for (i = !i; i <= iters; i++) {
 892             PUSHs(sv_newmortal());
 893             /*SUPPRESS 560*/
 894             if (s = rx->startp[i]) {
 895                 len = rx->endp[i] - s;
 896                 if (len > 0)
 897                     sv_setpvn(*SP, s, len);
 898             }
 899         }
 900         if (global) {
 901             truebase = rx->subbeg;
 902             goto play_it_again;
 903         }
 904         RETURN;
 905     }
 906     else {
 907         if (global) {
 908             MAGIC* mg = 0;
 909             if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
 910                 mg = mg_find(TARG, 'g');
 911             if (!mg) {
 912                 sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
 913                 mg = mg_find(TARG, 'g');
 914             }
 915             mg->mg_ptr = rx->startp[0];
 916             mg->mg_len = rx->endp[0] - rx->startp[0];
 917         }
 918         RETPUSHYES;
 919     }
 920
 921 yup:
 922     ++BmUSEFUL(pm->op_pmshort);
 923     curpm = pm;
 924     if (pm->op_pmflags & PMf_ONCE)
 925         pm->op_pmflags |= PMf_USED;
 926     if (global) {
 927         rx->subbeg = truebase;
 928         rx->subend = strend;
 929         rx->startp[0] = s;
 930         rx->endp[0] = s + SvCUR(pm->op_pmshort);
 931         goto gotcha;
 932     }
 933     if (sawampersand) {
 934         char *tmps;
 935
 936         if (rx->subbase)
 937             Safefree(rx->subbase);
 938         tmps = rx->subbase = nsavestr(t, strend-t);
 939         rx->subbeg = tmps;
 940         rx->subend = tmps + (strend-t);
 941         tmps = rx->startp[0] = tmps + (s - t);
 942         rx->endp[0] = tmps + SvCUR(pm->op_pmshort);
 943     }
 944     RETPUSHYES;
 945
 946 nope:
 947     if (pm->op_pmshort)
 948         ++BmUSEFUL(pm->op_pmshort);
 949
 950 ret_no:
 951     if (global) {
 952         if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
 953             MAGIC* mg = mg_find(TARG, 'g');
 954             if (mg) {
 955                 mg->mg_ptr = 0;
 956                 mg->mg_len = 0;
 957             }
 958         }
 959     }
 960     if (gimme == G_ARRAY)
 961         RETURN;
 962     RETPUSHNO;
 963 }
 964
 965 PP(pp_subst)
 966 {
 967     dSP; dTARG;
 968     register PMOP *pm = cPMOP;
 969     PMOP *rpm = pm;
 970     register SV *dstr;
 971     register char *s;
 972     char *strend;
 973     register char *m;
 974     char *c;
 975     register char *d;
 976     STRLEN clen;
 977     I32 iters = 0;
 978     I32 maxiters;
 979     register I32 i;
 980     bool once;
 981     char *orig;
 982     I32 safebase;
 983     register REGEXP *rx = pm->op_pmregexp;
 984     STRLEN len;
 985
 986     if (pm->op_pmflags & PMf_CONST)     /* known replacement string? */
 987         dstr = POPs;
 988     if (op->op_flags & OPf_STACKED)
 989         TARG = POPs;
 990     else {
 991         TARG = GvSV(defgv);
 992         EXTEND(SP,1);
 993     }
 994     s = SvPV(TARG, len);
 995     if (!pm || !s)
 996         DIE("panic: do_subst");
 997
 998     strend = s + len;
 999     maxiters = (strend - s) + 10;
1000
1001     if (!rx->prelen && curpm) {
1002         pm = curpm;
1003         rx = pm->op_pmregexp;
1004     }
1005     safebase = ((!rx || !rx->nparens) && !sawampersand);
1006     orig = m = s;
1007     if (pm->op_pmshort) {
1008         if (pm->op_pmflags & PMf_SCANFIRST) {
1009             if (SvSCREAM(TARG)) {
1010                 if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
1011                     goto nope;
1012                 else if (!(s = screaminstr(TARG, pm->op_pmshort)))
1013                     goto nope;
1014             }
1015             else if (!(s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
1016               pm->op_pmshort)))
1017                 goto nope;
1018             if (s && rx->regback >= 0) {
1019                 ++BmUSEFUL(pm->op_pmshort);
1020                 s -= rx->regback;
1021                 if (s < m)
1022                     s = m;
1023             }
1024             else
1025                 s = m;
1026         }
1027         else if (!multiline) {
1028             if (*SvPVX(pm->op_pmshort) != *s ||
1029               bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
1030                 if (pm->op_pmflags & PMf_FOLD) {
1031                     if (ibcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) )
1032                         goto nope;
1033                 }
1034                 else
1035                     goto nope;
1036             }
1037         }
1038         if (--BmUSEFUL(pm->op_pmshort) < 0) {
1039             SvREFCNT_dec(pm->op_pmshort);
1040             pm->op_pmshort = Nullsv;    /* opt is being useless */
1041         }
1042     }
1043     once = !(rpm->op_pmflags & PMf_GLOBAL);
1044     if (rpm->op_pmflags & PMf_CONST) {  /* known replacement string? */
1045         c = SvPV(dstr, clen);
1046         if (clen <= rx->minlen) {
1047                                         /* can do inplace substitution */
1048             if (regexec(rx, s, strend, orig, 0,
1049               SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
1050                 if (rx->subbase)        /* oops, no we can't */
1051                     goto long_way;
1052                 d = s;
1053                 curpm = pm;
1054                 SvSCREAM_off(TARG);     /* disable possible screamer */
1055                 if (once) {
1056                     m = rx->startp[0];
1057                     d = rx->endp[0];
1058                     s = orig;
1059                     if (m - s > strend - d) {   /* faster to shorten from end */
1060                         if (clen) {
1061                             Copy(c, m, clen, char);
1062                             m += clen;
1063                         }
1064                         i = strend - d;
1065                         if (i > 0) {
1066                             Move(d, m, i, char);
1067                             m += i;
1068                         }
1069                         *m = '\0';
1070                         SvCUR_set(TARG, m - s);
1071                         SvPOK_only(TARG);
1072                         SvSETMAGIC(TARG);
1073                         PUSHs(&sv_yes);
1074                         RETURN;
1075                     }
1076                     /*SUPPRESS 560*/
1077                     else if (i = m - s) {       /* faster from front */
1078                         d -= clen;
1079                         m = d;
1080                         sv_chop(TARG, d-i);
1081                         s += i;
1082                         while (i--)
1083                             *--d = *--s;
1084                         if (clen)
1085                             Copy(c, m, clen, char);
1086                         SvPOK_only(TARG);
1087                         SvSETMAGIC(TARG);
1088                         PUSHs(&sv_yes);
1089                         RETURN;
1090                     }
1091                     else if (clen) {
1092                         d -= clen;
1093                         sv_chop(TARG, d);
1094                         Copy(c, d, clen, char);
1095                         SvPOK_only(TARG);
1096                         SvSETMAGIC(TARG);
1097                         PUSHs(&sv_yes);
1098                         RETURN;
1099                     }
1100                     else {
1101                         sv_chop(TARG, d);
1102                         SvPOK_only(TARG);
1103                         SvSETMAGIC(TARG);
1104                         PUSHs(&sv_yes);
1105                         RETURN;
1106                     }
1107                     /* NOTREACHED */
1108                 }
1109                 do {
1110                     if (iters++ > maxiters)
1111                         DIE("Substitution loop");
1112                     m = rx->startp[0];
1113                     /*SUPPRESS 560*/
1114                     if (i = m - s) {
1115                         if (s != d)
1116                             Move(s, d, i, char);
1117                         d += i;
1118                     }
1119                     if (clen) {
1120                         Copy(c, d, clen, char);
1121                         d += clen;
1122                     }
1123                     s = rx->endp[0];
1124                 } while (regexec(rx, s, strend, orig, s == m,
1125                     Nullsv, TRUE));     /* (don't match same null twice) */
1126                 if (s != d) {
1127                     i = strend - s;
1128                     SvCUR_set(TARG, d - SvPVX(TARG) + i);
1129                     Move(s, d, i+1, char);              /* include the Null */
1130                 }
1131                 SvPOK_only(TARG);
1132                 SvSETMAGIC(TARG);
1133                 PUSHs(sv_2mortal(newSViv((I32)iters)));
1134                 RETURN;
1135             }
1136             PUSHs(&sv_no);
1137             RETURN;
1138         }
1139     }
1140     else
1141         c = Nullch;
1142     if (regexec(rx, s, strend, orig, 0,
1143       SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
1144     long_way:
1145         dstr = NEWSV(25, sv_len(TARG));
1146         sv_setpvn(dstr, m, s-m);
1147         curpm = pm;
1148         if (!c) {
1149             register CONTEXT *cx;
1150             PUSHSUBST(cx);
1151             RETURNOP(cPMOP->op_pmreplroot);
1152         }
1153         do {
1154             if (iters++ > maxiters)
1155                 DIE("Substitution loop");
1156             if (rx->subbase && rx->subbase != orig) {
1157                 m = s;
1158                 s = orig;
1159                 orig = rx->subbase;
1160                 s = orig + (m - s);
1161                 strend = s + (strend - m);
1162             }
1163             m = rx->startp[0];
1164             sv_catpvn(dstr, s, m-s);
1165             s = rx->endp[0];
1166             if (clen)
1167                 sv_catpvn(dstr, c, clen);
1168             if (once)
1169                 break;
1170         } while (regexec(rx, s, strend, orig, s == m, Nullsv,
1171             safebase));
1172         sv_catpvn(dstr, s, strend - s);
1173         sv_replace(TARG, dstr);
1174         SvPOK_only(TARG);
1175         SvSETMAGIC(TARG);
1176         PUSHs(sv_2mortal(newSViv((I32)iters)));
1177         RETURN;
1178     }
1179     PUSHs(&sv_no);
1180     RETURN;
1181
1182 nope:
1183     ++BmUSEFUL(pm->op_pmshort);
1184     PUSHs(&sv_no);
1185     RETURN;
1186 }
1187
1188 PP(pp_substcont)
1189 {
1190     dSP;
1191     register PMOP *pm = (PMOP*) cLOGOP->op_other;
1192     register CONTEXT *cx = &cxstack[cxstack_ix];
1193     register SV *dstr = cx->sb_dstr;
1194     register char *s = cx->sb_s;
1195     register char *m = cx->sb_m;
1196     char *orig = cx->sb_orig;
1197     register REGEXP *rx = pm->op_pmregexp;
1198
1199     if (cx->sb_iters++) {
1200         if (cx->sb_iters > cx->sb_maxiters)
1201             DIE("Substitution loop");
1202
1203         sv_catsv(dstr, POPs);
1204         if (rx->subbase)
1205             Safefree(rx->subbase);
1206         rx->subbase = cx->sb_subbase;
1207
1208         /* Are we done */
1209         if (cx->sb_once || !regexec(rx, s, cx->sb_strend, orig,
1210                                 s == m, Nullsv, cx->sb_safebase))
1211         {
1212             SV *targ = cx->sb_targ;
1213             sv_catpvn(dstr, s, cx->sb_strend - s);
1214             sv_replace(targ, dstr);
1215             SvPOK_only(targ);
1216             SvSETMAGIC(targ);
1217             PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
1218             POPSUBST(cx);
1219             RETURNOP(pm->op_next);
1220         }
1221     }
1222     if (rx->subbase && rx->subbase != orig) {
1223         m = s;
1224         s = orig;
1225         cx->sb_orig = orig = rx->subbase;
1226         s = orig + (m - s);
1227         cx->sb_strend = s + (cx->sb_strend - m);
1228     }
1229     cx->sb_m = m = rx->startp[0];
1230     sv_catpvn(dstr, s, m-s);
1231     cx->sb_s = rx->endp[0];
1232     cx->sb_subbase = rx->subbase;
1233
1234     rx->subbase = Nullch;       /* so recursion works */
1235     RETURNOP(pm->op_pmreplstart);
1236 }
1237
1238 PP(pp_trans)
1239 {
1240     dSP; dTARG;
1241     SV *sv;
1242
1243     if (op->op_flags & OPf_STACKED)
1244         sv = POPs;
1245     else {
1246         sv = GvSV(defgv);
1247         EXTEND(SP,1);
1248     }
1249     TARG = NEWSV(27,0);
1250     PUSHi(do_trans(sv, op));
1251     RETURN;
1252 }
1253
1254 /* Lvalue operators. */
1255
1256 PP(pp_sassign)
1257 {
1258     dSP; dPOPTOPssrl;
1259     if (tainting && tainted && (!SvRMAGICAL(lstr) || !mg_find(lstr, 't'))) {
1260         TAINT_NOT;
1261     }
1262     SvSetSV(rstr, lstr);
1263     SvSETMAGIC(rstr);
1264     SETs(rstr);
1265     RETURN;
1266 }
1267
1268 PP(pp_aassign)
1269 {
1270     dSP;
1271     SV **lastlelem = stack_sp;
1272     SV **lastrelem = stack_base + POPMARK;
1273     SV **firstrelem = stack_base + POPMARK + 1;
1274     SV **firstlelem = lastrelem + 1;
1275
1276     register SV **relem;
1277     register SV **lelem;
1278
1279     register SV *sv;
1280     register AV *ary;
1281
1282     HV *hash;
1283     I32 i;
1284     int magic;
1285
1286     delaymagic = DM_DELAY;              /* catch simultaneous items */
1287
1288     /* If there's a common identifier on both sides we have to take
1289      * special care that assigning the identifier on the left doesn't
1290      * clobber a value on the right that's used later in the list.
1291      */
1292     if (op->op_private & OPpASSIGN_COMMON) {
1293         for (relem = firstrelem; relem <= lastrelem; relem++) {
1294             /*SUPPRESS 560*/
1295             if (sv = *relem)
1296                 *relem = sv_mortalcopy(sv);
1297         }
1298     }
1299
1300     relem = firstrelem;
1301     lelem = firstlelem;
1302     ary = Null(AV*);
1303     hash = Null(HV*);
1304     while (lelem <= lastlelem) {
1305         sv = *lelem++;
1306         switch (SvTYPE(sv)) {
1307         case SVt_PVAV:
1308             ary = (AV*)sv;
1309             magic = SvSMAGICAL(ary) != 0;
1310             AvREAL_on(ary);
1311             AvFILL(ary) = -1;
1312             i = 0;
1313             while (relem <= lastrelem) {        /* gobble up all the rest */
1314                 sv = NEWSV(28,0);
1315                 if (*relem)
1316                     sv_setsv(sv,*relem);
1317                 *(relem++) = sv;
1318                 (void)av_store(ary,i++,sv);
1319                 if (magic)
1320                     mg_set(sv);
1321             }
1322             break;
1323         case SVt_PVHV: {
1324                 char *tmps;
1325                 SV *tmpstr;
1326
1327                 hash = (HV*)sv;
1328                 magic = SvSMAGICAL(hash) != 0;
1329                 hv_clear(hash);
1330
1331                 while (relem < lastrelem) {     /* gobble up all the rest */
1332                     STRLEN len;
1333                     if (*relem)
1334                         sv = *(relem++);
1335                     else
1336                         sv = &sv_no, relem++;
1337                     tmps = SvPV(sv, len);
1338                     tmpstr = NEWSV(29,0);
1339                     if (*relem)
1340                         sv_setsv(tmpstr,*relem);        /* value */
1341                     *(relem++) = tmpstr;
1342                     (void)hv_store(hash,tmps,len,tmpstr,0);
1343                     if (magic)
1344                         mg_set(tmpstr);
1345                 }
1346             }
1347             break;
1348         default:
1349             if (SvTHINKFIRST(sv)) {
1350                 if (SvREADONLY(sv) && curcop != &compiling) {
1351                     if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
1352                         DIE(no_modify);
1353                     if (relem <= lastrelem)
1354                         relem++;
1355                     break;
1356                 }
1357                 if (SvROK(sv))
1358                     sv_unref(sv);
1359             }
1360             if (relem <= lastrelem) {
1361                 sv_setsv(sv, *relem);
1362                 *(relem++) = sv;
1363             }
1364             else
1365                 sv_setsv(sv, &sv_undef);
1366             SvSETMAGIC(sv);
1367             break;
1368         }
1369     }
1370     if (delaymagic & ~DM_DELAY) {
1371         if (delaymagic & DM_UID) {
1372 #ifdef HAS_SETRESUID
1373             (void)setresuid(uid,euid,(Uid_t)-1);
1374 #else /* not HAS_SETRESUID */
1375 #ifdef HAS_SETREUID
1376             (void)setreuid(uid,euid);
1377 #else /* not HAS_SETREUID */
1378 #ifdef HAS_SETRUID
1379             if ((delaymagic & DM_UID) == DM_RUID) {
1380                 (void)setruid(uid);
1381                 delaymagic =~ DM_RUID;
1382             }
1383 #endif /* HAS_SETRUID */
1384 #endif /* HAS_SETRESUID */
1385 #ifdef HAS_SETEUID
1386             if ((delaymagic & DM_UID) == DM_EUID) {
1387                 (void)seteuid(uid);
1388                 delaymagic =~ DM_EUID;
1389             }
1390 #endif /* HAS_SETEUID */
1391             if (delaymagic & DM_UID) {
1392                 if (uid != euid)
1393                     DIE("No setreuid available");
1394                 (void)setuid(uid);
1395             }
1396 #endif /* not HAS_SETREUID */
1397             uid = (int)getuid();
1398             euid = (int)geteuid();
1399         }
1400         if (delaymagic & DM_GID) {
1401 #ifdef HAS_SETRESGID
1402             (void)setresgid(gid,egid,(Gid_t)-1);
1403 #else /* not HAS_SETREGID */
1404 #ifdef HAS_SETREGID
1405             (void)setregid(gid,egid);
1406 #else /* not HAS_SETREGID */
1407 #endif /* not HAS_SETRESGID */
1408 #ifdef HAS_SETRGID
1409             if ((delaymagic & DM_GID) == DM_RGID) {
1410                 (void)setrgid(gid);
1411                 delaymagic =~ DM_RGID;
1412             }
1413 #endif /* HAS_SETRGID */
1414 #ifdef HAS_SETRESGID
1415             (void)setresgid(gid,egid,(Gid_t)-1);
1416 #else /* not HAS_SETREGID */
1417 #ifdef HAS_SETEGID
1418             if ((delaymagic & DM_GID) == DM_EGID) {
1419                 (void)setegid(gid);
1420                 delaymagic =~ DM_EGID;
1421             }
1422 #endif /* HAS_SETEGID */
1423             if (delaymagic & DM_GID) {
1424                 if (gid != egid)
1425                     DIE("No setregid available");
1426                 (void)setgid(gid);
1427             }
1428 #endif /* not HAS_SETRESGID */
1429 #endif /* not HAS_SETREGID */
1430             gid = (int)getgid();
1431             egid = (int)getegid();
1432         }
1433         tainting |= (euid != uid || egid != gid);
1434     }
1435     delaymagic = 0;
1436     if (GIMME == G_ARRAY) {
1437         if (ary || hash)
1438             SP = lastrelem;
1439         else
1440             SP = firstrelem + (lastlelem - firstlelem);
1441         RETURN;
1442     }
1443     else {
1444         dTARGET;
1445         SP = firstrelem;
1446         SETi(lastrelem - firstrelem + 1);
1447         RETURN;
1448     }
1449 }
1450
1451 PP(pp_schop)
1452 {
1453     dSP; dTARGET;
1454     SV *sv;
1455
1456     if (MAXARG < 1)
1457         sv = GvSV(defgv);
1458     else
1459         sv = POPs;
1460     do_chop(TARG, sv);
1461     PUSHTARG;
1462     RETURN;
1463 }
1464
1465 PP(pp_chop)
1466 {
1467     dSP; dMARK; dTARGET;
1468     while (SP > MARK)
1469         do_chop(TARG, POPs);
1470     PUSHTARG;
1471     RETURN;
1472 }
1473
1474 PP(pp_defined)
1475 {
1476     dSP;
1477     register SV* sv;
1478
1479     if (MAXARG < 1) {
1480         sv = GvSV(defgv);
1481         EXTEND(SP, 1);
1482     }
1483     else
1484         sv = POPs;
1485     if (!sv || !SvANY(sv))
1486         RETPUSHNO;
1487     switch (SvTYPE(sv)) {
1488     case SVt_PVAV:
1489         if (AvMAX(sv) >= 0)
1490             RETPUSHYES;
1491         break;
1492     case SVt_PVHV:
1493         if (HvARRAY(sv))
1494             RETPUSHYES;
1495         break;
1496     case SVt_PVCV:
1497         if (CvROOT(sv))
1498             RETPUSHYES;
1499         break;
1500     default:
1501         if (SvOK(sv))
1502             RETPUSHYES;
1503     }
1504     RETPUSHNO;
1505 }
1506
1507 PP(pp_undef)
1508 {
1509     dSP;
1510     SV *sv;
1511
1512     if (!op->op_private)
1513         RETPUSHUNDEF;
1514
1515     sv = POPs;
1516     if (!sv)
1517         RETPUSHUNDEF;
1518
1519     if (SvTHINKFIRST(sv)) {
1520         if (SvREADONLY(sv))
1521             RETPUSHUNDEF;
1522         if (SvROK(sv))
1523             sv_unref(sv);
1524     }
1525
1526     switch (SvTYPE(sv)) {
1527     case SVt_NULL:
1528         break;
1529     case SVt_PVAV:
1530         av_undef((AV*)sv);
1531         break;
1532     case SVt_PVHV:
1533         hv_undef((HV*)sv);
1534         break;
1535     case SVt_PVCV:
1536         sub_generation++;
1537         cv_undef((CV*)sv);
1538         break;
1539     default:
1540         if (sv != GvSV(defgv)) {
1541             if (SvPOK(sv) && SvLEN(sv)) {
1542                 SvOOK_off(sv);
1543                 Safefree(SvPVX(sv));
1544                 SvPV_set(sv, Nullch);
1545                 SvLEN_set(sv, 0);
1546             }
1547             SvOK_off(sv);
1548             SvSETMAGIC(sv);
1549         }
1550     }
1551
1552     RETPUSHUNDEF;
1553 }
1554
1555 PP(pp_study)
1556 {
1557     dSP; dTARGET;
1558     register unsigned char *s;
1559     register I32 pos;
1560     register I32 ch;
1561     register I32 *sfirst;
1562     register I32 *snext;
1563     I32 retval;
1564     STRLEN len;
1565
1566     s = (unsigned char*)(SvPV(TARG, len));
1567     pos = len;
1568     if (lastscream)
1569         SvSCREAM_off(lastscream);
1570     lastscream = TARG;
1571     if (pos <= 0) {
1572         retval = 0;
1573         goto ret;
1574     }
1575     if (pos > maxscream) {
1576         if (maxscream < 0) {
1577             maxscream = pos + 80;
1578             New(301, screamfirst, 256, I32);
1579             New(302, screamnext, maxscream, I32);
1580         }
1581         else {
1582             maxscream = pos + pos / 4;
1583             Renew(screamnext, maxscream, I32);
1584         }
1585     }
1586
1587     sfirst = screamfirst;
1588     snext = screamnext;
1589
1590     if (!sfirst || !snext)
1591         DIE("do_study: out of memory");
1592
1593     for (ch = 256; ch; --ch)
1594         *sfirst++ = -1;
1595     sfirst -= 256;
1596
1597     while (--pos >= 0) {
1598         ch = s[pos];
1599         if (sfirst[ch] >= 0)
1600             snext[pos] = sfirst[ch] - pos;
1601         else
1602             snext[pos] = -pos;
1603         sfirst[ch] = pos;
1604
1605         /* If there were any case insensitive searches, we must assume they
1606          * all are.  This speeds up insensitive searches much more than
1607          * it slows down sensitive ones.
1608          */
1609         if (sawi)
1610             sfirst[fold[ch]] = pos;
1611     }
1612
1613     SvSCREAM_on(TARG);
1614     retval = 1;
1615   ret:
1616     XPUSHs(sv_2mortal(newSViv((I32)retval)));
1617     RETURN;
1618 }
1619
1620 PP(pp_preinc)
1621 {
1622     dSP;
1623     sv_inc(TOPs);
1624     SvSETMAGIC(TOPs);
1625     return NORMAL;
1626 }
1627
1628 PP(pp_predec)
1629 {
1630     dSP;
1631     sv_dec(TOPs);
1632     SvSETMAGIC(TOPs);
1633     return NORMAL;
1634 }
1635
1636 PP(pp_postinc)
1637 {
1638     dSP; dTARGET;
1639     sv_setsv(TARG, TOPs);
1640     sv_inc(TOPs);
1641     SvSETMAGIC(TOPs);
1642     if (!SvOK(TARG))
1643         sv_setiv(TARG, 0);
1644     SETs(TARG);
1645     return NORMAL;
1646 }
1647
1648 PP(pp_postdec)
1649 {
1650     dSP; dTARGET;
1651     sv_setsv(TARG, TOPs);
1652     sv_dec(TOPs);
1653     SvSETMAGIC(TOPs);
1654     SETs(TARG);
1655     return NORMAL;
1656 }
1657
1658 /* Ordinary operators. */
1659
1660 PP(pp_pow)
1661 {
1662     dSP; dATARGET; dPOPTOPnnrl;
1663     SETn( pow( left, right) );
1664     RETURN;
1665 }
1666
1667 PP(pp_multiply)
1668 {
1669     dSP; dATARGET; dPOPTOPnnrl;
1670     SETn( left * right );
1671     RETURN;
1672 }
1673
1674 PP(pp_divide)
1675 {
1676     dSP; dATARGET; dPOPnv;
1677     if (value == 0.0)
1678         DIE("Illegal division by zero");
1679 #ifdef SLOPPYDIVIDE
1680     /* insure that 20./5. == 4. */
1681     {
1682         double x;
1683         I32    k;
1684         x =  POPn;
1685         if ((double)(I32)x     == x &&
1686             (double)(I32)value == value &&
1687             (k = (I32)x/(I32)value)*(I32)value == (I32)x) {
1688             value = k;
1689         } else {
1690             value = x/value;
1691         }
1692     }
1693 #else
1694     value = POPn / value;
1695 #endif
1696     PUSHn( value );
1697     RETURN;
1698 }
1699
1700 PP(pp_modulo)
1701 {
1702     dSP; dATARGET;
1703     register unsigned long tmpulong;
1704     register long tmplong;
1705     I32 value;
1706
1707     tmpulong = (unsigned long) POPn;
1708     if (tmpulong == 0L)
1709         DIE("Illegal modulus zero");
1710     value = TOPn;
1711     if (value >= 0.0)
1712         value = (I32)(((unsigned long)value) % tmpulong);
1713     else {
1714         tmplong = (long)value;
1715         value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
1716     }
1717     SETi(value);
1718     RETURN;
1719 }
1720
1721 PP(pp_repeat)
1722 {
1723     dSP; dATARGET;
1724     register I32 count = POPi;
1725     if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
1726         dMARK;
1727         I32 items = SP - MARK;
1728         I32 max;
1729
1730         max = items * count;
1731         MEXTEND(MARK, max);
1732         if (count > 1) {
1733             while (SP > MARK) {
1734                 if (*SP)
1735                     SvTEMP_off((*SP));
1736                 SP--;
1737             }
1738             MARK++;
1739             repeatcpy((char*)(MARK + items), (char*)MARK,
1740                 items * sizeof(SV*), count - 1);
1741         }
1742         SP += max;
1743     }
1744     else {      /* Note: mark already snarfed by pp_list */
1745         SV *tmpstr;
1746         char *tmps;
1747
1748         tmpstr = POPs;
1749         if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
1750             if (SvREADONLY(tmpstr) && curcop != &compiling)
1751                 DIE("Can't x= to readonly value");
1752             if (SvROK(tmpstr))
1753                 sv_unref(tmpstr);
1754         }
1755         SvSetSV(TARG, tmpstr);
1756         if (count >= 1) {
1757             STRLEN len;
1758             STRLEN tlen;
1759             tmpstr = NEWSV(50, 0);
1760             tmps = SvPV(TARG, len);
1761             sv_setpvn(tmpstr, tmps, len);
1762             tmps = SvPV(tmpstr, tlen);  /* force to be string */
1763             SvGROW(TARG, (count * len) + 1);
1764             repeatcpy((char*)SvPVX(TARG), tmps, tlen, count);
1765             SvCUR(TARG) *= count;
1766             *SvEND(TARG) = '\0';
1767             SvPOK_only(TARG);
1768             SvREFCNT_dec(tmpstr);
1769         }
1770         else
1771             sv_setsv(TARG, &sv_no);
1772         PUSHTARG;
1773     }
1774     RETURN;
1775 }
1776
1777 PP(pp_add)
1778 {
1779     dSP; dATARGET; dPOPTOPnnrl;
1780     SETn( left + right );
1781     RETURN;
1782 }
1783
1784 PP(pp_subtract)
1785 {
1786     dSP; dATARGET; dPOPTOPnnrl;
1787     SETn( left - right );
1788     RETURN;
1789 }
1790
1791 PP(pp_concat)
1792 {
1793     dSP; dATARGET; dPOPTOPssrl;
1794     STRLEN len;
1795     char *s;
1796     if (TARG != lstr) {
1797         s = SvPV(lstr,len);
1798         sv_setpvn(TARG,s,len);
1799     }
1800     s = SvPV(rstr,len);
1801     sv_catpvn(TARG,s,len);
1802     SETTARG;
1803     RETURN;
1804 }
1805
1806 PP(pp_left_shift)
1807 {
1808     dSP; dATARGET; dPOPTOPiirl;
1809     SETi( left << right );
1810     RETURN;
1811 }
1812
1813 PP(pp_right_shift)
1814 {
1815     dSP; dATARGET; dPOPTOPiirl;
1816     SETi( left >> right );
1817     RETURN;
1818 }
1819
1820 PP(pp_lt)
1821 {
1822     dSP; dPOPnv;
1823     SETs((TOPn < value) ? &sv_yes : &sv_no);
1824     RETURN;
1825 }
1826
1827 PP(pp_gt)
1828 {
1829     dSP; dPOPnv;
1830     SETs((TOPn > value) ? &sv_yes : &sv_no);
1831     RETURN;
1832 }
1833
1834 PP(pp_le)
1835 {
1836     dSP; dPOPnv;
1837     SETs((TOPn <= value) ? &sv_yes : &sv_no);
1838     RETURN;
1839 }
1840
1841 PP(pp_ge)
1842 {
1843     dSP; dPOPnv;
1844     SETs((TOPn >= value) ? &sv_yes : &sv_no);
1845     RETURN;
1846 }
1847
1848 PP(pp_eq)
1849 {
1850     dSP; dPOPnv;
1851     SETs((TOPn == value) ? &sv_yes : &sv_no);
1852     RETURN;
1853 }
1854
1855 PP(pp_ne)
1856 {
1857     dSP; dPOPnv;
1858     SETs((TOPn != value) ? &sv_yes : &sv_no);
1859     RETURN;
1860 }
1861
1862 PP(pp_ncmp)
1863 {
1864     dSP; dTARGET; dPOPTOPnnrl;
1865     I32 value;
1866
1867     if (left > right)
1868         value = 1;
1869     else if (left < right)
1870         value = -1;
1871     else
1872         value = 0;
1873     SETi(value);
1874     RETURN;
1875 }
1876
1877 PP(pp_slt)
1878 {
1879     dSP; dPOPTOPssrl;
1880     SETs( sv_cmp(lstr, rstr) < 0 ? &sv_yes : &sv_no );
1881     RETURN;
1882 }
1883
1884 PP(pp_sgt)
1885 {
1886     dSP; dPOPTOPssrl;
1887     SETs( sv_cmp(lstr, rstr) > 0 ? &sv_yes : &sv_no );
1888     RETURN;
1889 }
1890
1891 PP(pp_sle)
1892 {
1893     dSP; dPOPTOPssrl;
1894     SETs( sv_cmp(lstr, rstr) <= 0 ? &sv_yes : &sv_no );
1895     RETURN;
1896 }
1897
1898 PP(pp_sge)
1899 {
1900     dSP; dPOPTOPssrl;
1901     SETs( sv_cmp(lstr, rstr) >= 0 ? &sv_yes : &sv_no );
1902     RETURN;
1903 }
1904
1905 PP(pp_seq)
1906 {
1907     dSP; dPOPTOPssrl;
1908     SETs( sv_eq(lstr, rstr) ? &sv_yes : &sv_no );
1909     RETURN;
1910 }
1911
1912 PP(pp_sne)
1913 {
1914     dSP; dPOPTOPssrl;
1915     SETs( !sv_eq(lstr, rstr) ? &sv_yes : &sv_no );
1916     RETURN;
1917 }
1918
1919 PP(pp_scmp)
1920 {
1921     dSP; dTARGET;
1922     dPOPTOPssrl;
1923     SETi( sv_cmp(lstr, rstr) );
1924     RETURN;
1925 }
1926
1927 PP(pp_bit_and) {
1928     dSP; dATARGET; dPOPTOPssrl;
1929     if (SvNIOK(lstr) || SvNIOK(rstr)) {
1930         unsigned long value = U_L(SvNV(lstr));
1931         value = value & U_L(SvNV(rstr));
1932         SETn((double)value);
1933     }
1934     else {
1935         do_vop(op->op_type, TARG, lstr, rstr);
1936         SETTARG;
1937     }
1938     RETURN;
1939 }
1940
1941 PP(pp_xor)
1942 {
1943     dSP; dATARGET; dPOPTOPssrl;
1944     if (SvNIOK(lstr) || SvNIOK(rstr)) {
1945         unsigned long value = U_L(SvNV(lstr));
1946         value = value ^ U_L(SvNV(rstr));
1947         SETn((double)value);
1948     }
1949     else {
1950         do_vop(op->op_type, TARG, lstr, rstr);
1951         SETTARG;
1952     }
1953     RETURN;
1954 }
1955
1956 PP(pp_bit_or)
1957 {
1958     dSP; dATARGET; dPOPTOPssrl;
1959     if (SvNIOK(lstr) || SvNIOK(rstr)) {
1960         unsigned long value = U_L(SvNV(lstr));
1961         value = value | U_L(SvNV(rstr));
1962         SETn((double)value);
1963     }
1964     else {
1965         do_vop(op->op_type, TARG, lstr, rstr);
1966         SETTARG;
1967     }
1968     RETURN;
1969 }
1970
1971 PP(pp_negate)
1972 {
1973     dSP; dTARGET;
1974     SETn(-TOPn);
1975     RETURN;
1976 }
1977
1978 PP(pp_not)
1979 {
1980     *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
1981     return NORMAL;
1982 }
1983
1984 PP(pp_complement)
1985 {
1986     dSP; dTARGET; dTOPss;
1987     register I32 anum;
1988
1989     if (SvNIOK(sv)) {
1990         SETi(  ~SvIV(sv) );
1991     }
1992     else {
1993         register char *tmps;
1994         register long *tmpl;
1995         STRLEN len;
1996
1997         SvSetSV(TARG, sv);
1998         tmps = SvPV(TARG, len);
1999         anum = len;
2000 #ifdef LIBERAL
2001         for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
2002             *tmps = ~*tmps;
2003         tmpl = (long*)tmps;
2004         for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
2005             *tmpl = ~*tmpl;
2006         tmps = (char*)tmpl;
2007 #endif
2008         for ( ; anum > 0; anum--, tmps++)
2009             *tmps = ~*tmps;
2010
2011         SETs(TARG);
2012     }
2013     RETURN;
2014 }
2015
2016 /* integer versions of some of the above */
2017
2018 PP(pp_i_preinc)
2019 {
2020     dSP; dTOPiv;
2021     sv_setiv(TOPs, value + 1);
2022     SvSETMAGIC(TOPs);
2023     return NORMAL;
2024 }
2025
2026 PP(pp_i_predec)
2027 {
2028     dSP; dTOPiv;
2029     sv_setiv(TOPs, value - 1);
2030     SvSETMAGIC(TOPs);
2031     return NORMAL;
2032 }
2033
2034 PP(pp_i_postinc)
2035 {
2036     dSP; dTARGET;
2037     sv_setsv(TARG, TOPs);
2038     sv_setiv(TOPs, SvIV(TOPs) + 1);
2039     SvSETMAGIC(TOPs);
2040     if (!SvOK(TARG))
2041         sv_setiv(TARG, 0);
2042     SETs(TARG);
2043     return NORMAL;
2044 }
2045
2046 PP(pp_i_postdec)
2047 {
2048     dSP; dTARGET;
2049     sv_setsv(TARG, TOPs);
2050     sv_setiv(TOPs, SvIV(TOPs) - 1);
2051     SvSETMAGIC(TOPs);
2052     SETs(TARG);
2053     return NORMAL;
2054 }
2055
2056 PP(pp_i_multiply)
2057 {
2058     dSP; dATARGET; dPOPTOPiirl;
2059     SETi( left * right );
2060     RETURN;
2061 }
2062
2063 PP(pp_i_divide)
2064 {
2065     dSP; dATARGET; dPOPiv;
2066     if (value == 0)
2067         DIE("Illegal division by zero");
2068     value = POPi / value;
2069     PUSHi( value );
2070     RETURN;
2071 }
2072
2073 PP(pp_i_modulo)
2074 {
2075     dSP; dATARGET; dPOPTOPiirl;
2076     SETi( left % right );
2077     RETURN;
2078 }
2079
2080 PP(pp_i_add)
2081 {
2082     dSP; dATARGET; dPOPTOPiirl;
2083     SETi( left + right );
2084     RETURN;
2085 }
2086
2087 PP(pp_i_subtract)
2088 {
2089     dSP; dATARGET; dPOPTOPiirl;
2090     SETi( left - right );
2091     RETURN;
2092 }
2093
2094 PP(pp_i_lt)
2095 {
2096     dSP; dPOPTOPiirl;
2097     SETs((left < right) ? &sv_yes : &sv_no);
2098     RETURN;
2099 }
2100
2101 PP(pp_i_gt)
2102 {
2103     dSP; dPOPTOPiirl;
2104     SETs((left > right) ? &sv_yes : &sv_no);
2105     RETURN;
2106 }
2107
2108 PP(pp_i_le)
2109 {
2110     dSP; dPOPTOPiirl;
2111     SETs((left <= right) ? &sv_yes : &sv_no);
2112     RETURN;
2113 }
2114
2115 PP(pp_i_ge)
2116 {
2117     dSP; dPOPTOPiirl;
2118     SETs((left >= right) ? &sv_yes : &sv_no);
2119     RETURN;
2120 }
2121
2122 PP(pp_i_eq)
2123 {
2124     dSP; dPOPTOPiirl;
2125     SETs((left == right) ? &sv_yes : &sv_no);
2126     RETURN;
2127 }
2128
2129 PP(pp_i_ne)
2130 {
2131     dSP; dPOPTOPiirl;
2132     SETs((left != right) ? &sv_yes : &sv_no);
2133     RETURN;
2134 }
2135
2136 PP(pp_i_ncmp)
2137 {
2138     dSP; dTARGET; dPOPTOPiirl;
2139     I32 value;
2140
2141     if (left > right)
2142         value = 1;
2143     else if (left < right)
2144         value = -1;
2145     else
2146         value = 0;
2147     SETi(value);
2148     RETURN;
2149 }
2150
2151 PP(pp_i_negate)
2152 {
2153     dSP; dTARGET;
2154     SETi(-TOPi);
2155     RETURN;
2156 }
2157
2158 /* High falutin' math. */
2159
2160 PP(pp_atan2)
2161 {
2162     dSP; dTARGET; dPOPTOPnnrl;
2163     SETn(atan2(left, right));
2164     RETURN;
2165 }
2166
2167 PP(pp_sin)
2168 {
2169     dSP; dTARGET;
2170     double value;
2171     if (MAXARG < 1)
2172         value = SvNVx(GvSV(defgv));
2173     else
2174         value = POPn;
2175     value = sin(value);
2176     XPUSHn(value);
2177     RETURN;
2178 }
2179
2180 PP(pp_cos)
2181 {
2182     dSP; dTARGET;
2183     double value;
2184     if (MAXARG < 1)
2185         value = SvNVx(GvSV(defgv));
2186     else
2187         value = POPn;
2188     value = cos(value);
2189     XPUSHn(value);
2190     RETURN;
2191 }
2192
2193 PP(pp_rand)
2194 {
2195     dSP; dTARGET;
2196     double value;
2197     if (MAXARG < 1)
2198         value = 1.0;
2199     else
2200         value = POPn;
2201     if (value == 0.0)
2202         value = 1.0;
2203 #if RANDBITS == 31
2204     value = rand() * value / 2147483648.0;
2205 #else
2206 #if RANDBITS == 16
2207     value = rand() * value / 65536.0;
2208 #else
2209 #if RANDBITS == 15
2210     value = rand() * value / 32768.0;
2211 #else
2212     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
2213 #endif
2214 #endif
2215 #endif
2216     XPUSHn(value);
2217     RETURN;
2218 }
2219
2220 PP(pp_srand)
2221 {
2222     dSP;
2223     I32 anum;
2224     Time_t when;
2225
2226     if (MAXARG < 1) {
2227         (void)time(&when);
2228         anum = when;
2229     }
2230     else
2231         anum = POPi;
2232     (void)srand(anum);
2233     EXTEND(SP, 1);
2234     RETPUSHYES;
2235 }
2236
2237 PP(pp_exp)
2238 {
2239     dSP; dTARGET;
2240     double value;
2241     if (MAXARG < 1)
2242         value = SvNVx(GvSV(defgv));
2243     else
2244         value = POPn;
2245     value = exp(value);
2246     XPUSHn(value);
2247     RETURN;
2248 }
2249
2250 PP(pp_log)
2251 {
2252     dSP; dTARGET;
2253     double value;
2254     if (MAXARG < 1)
2255         value = SvNVx(GvSV(defgv));
2256     else
2257         value = POPn;
2258     if (value <= 0.0)
2259         DIE("Can't take log of %g", value);
2260     value = log(value);
2261     XPUSHn(value);
2262     RETURN;
2263 }
2264
2265 PP(pp_sqrt)
2266 {
2267     dSP; dTARGET;
2268     double value;
2269     if (MAXARG < 1)
2270         value = SvNVx(GvSV(defgv));
2271     else
2272         value = POPn;
2273     if (value < 0.0)
2274         DIE("Can't take sqrt of %g", value);
2275     value = sqrt(value);
2276     XPUSHn(value);
2277     RETURN;
2278 }
2279
2280 PP(pp_int)
2281 {
2282     dSP; dTARGET;
2283     double value;
2284     if (MAXARG < 1)
2285         value = SvNVx(GvSV(defgv));
2286     else
2287         value = POPn;
2288     if (value >= 0.0)
2289         (void)modf(value, &value);
2290     else {
2291         (void)modf(-value, &value);
2292         value = -value;
2293     }
2294     XPUSHn(value);
2295     RETURN;
2296 }
2297
2298 PP(pp_abs)
2299 {
2300     dSP; dTARGET;
2301     double value;
2302     if (MAXARG < 1)
2303         value = SvNVx(GvSV(defgv));
2304     else
2305         value = POPn;
2306
2307     if (value < 0.0)
2308         value = -value;
2309
2310     XPUSHn(value);
2311     RETURN;
2312 }
2313
2314 PP(pp_hex)
2315 {
2316     dSP; dTARGET;
2317     char *tmps;
2318     I32 argtype;
2319
2320     if (MAXARG < 1)
2321         tmps = SvPVx(GvSV(defgv), na);
2322     else
2323         tmps = POPp;
2324     XPUSHi( scan_hex(tmps, 99, &argtype) );
2325     RETURN;
2326 }
2327
2328 PP(pp_oct)
2329 {
2330     dSP; dTARGET;
2331     I32 value;
2332     I32 argtype;
2333     char *tmps;
2334
2335     if (MAXARG < 1)
2336         tmps = SvPVx(GvSV(defgv), na);
2337     else
2338         tmps = POPp;
2339     while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
2340         tmps++;
2341     if (*tmps == 'x')
2342         value = (I32)scan_hex(++tmps, 99, &argtype);
2343     else
2344         value = (I32)scan_oct(tmps, 99, &argtype);
2345     XPUSHi(value);
2346     RETURN;
2347 }
2348
2349 /* String stuff. */
2350
2351 PP(pp_length)
2352 {
2353     dSP; dTARGET;
2354     if (MAXARG < 1) {
2355         XPUSHi( sv_len(GvSV(defgv)) );
2356     }
2357     else
2358         SETi( sv_len(TOPs) );
2359     RETURN;
2360 }
2361
2362 PP(pp_substr)
2363 {
2364     dSP; dTARGET;
2365     SV *sv;
2366     I32 len;
2367     STRLEN curlen;
2368     I32 pos;
2369     I32 rem;
2370     I32 lvalue = op->op_flags & OPf_LVAL;
2371     char *tmps;
2372
2373     if (MAXARG > 2)
2374         len = POPi;
2375     pos = POPi - arybase;
2376     sv = POPs;
2377     tmps = SvPV(sv, curlen);            /* force conversion to string */
2378     if (pos < 0)
2379         pos += curlen + arybase;
2380     if (pos < 0 || pos > curlen) {
2381         if (dowarn)
2382             warn("substr outside of string");
2383         RETPUSHUNDEF;
2384     }
2385     else {
2386         if (MAXARG < 3)
2387             len = curlen;
2388         if (len < 0)
2389             len = 0;
2390         tmps += pos;
2391         rem = curlen - pos;     /* rem=how many bytes left*/
2392         if (rem > len)
2393             rem = len;
2394         sv_setpvn(TARG, tmps, rem);
2395         if (lvalue) {                   /* it's an lvalue! */
2396             if (SvTHINKFIRST(sv)) {
2397                 if (SvREADONLY(sv) && curcop != &compiling)
2398                     DIE(no_modify);
2399                 if (SvROK(sv))
2400                     DIE("Can't modify substr of a reference");
2401             }
2402             LvTYPE(TARG) = 's';
2403             LvTARG(TARG) = sv;
2404             LvTARGOFF(TARG) = tmps - SvPV(sv, na);
2405             LvTARGLEN(TARG) = rem;
2406         }
2407     }
2408     PUSHs(TARG);                /* avoid SvSETMAGIC here */
2409     RETURN;
2410 }
2411
2412 PP(pp_vec)
2413 {
2414     dSP; dTARGET;
2415     register I32 size = POPi;
2416     register I32 offset = POPi;
2417     register SV *src = POPs;
2418     I32 lvalue = op->op_flags & OPf_LVAL;
2419     STRLEN srclen;
2420     unsigned char *s = (unsigned char*)SvPV(src, srclen);
2421     unsigned long retnum;
2422     I32 len;
2423
2424     offset *= size;             /* turn into bit offset */
2425     len = (offset + size + 7) / 8;
2426     if (offset < 0 || size < 1)
2427         retnum = 0;
2428     else if (!lvalue && len > srclen)
2429         retnum = 0;
2430     else {
2431         if (len > srclen) {
2432             SvGROW(src, len);
2433             (void)memzero(SvPVX(src) + srclen, len - srclen);
2434             SvCUR_set(src, len);
2435         }
2436         s = (unsigned char*)SvPV(src, na);
2437         if (size < 8)
2438             retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
2439         else {
2440             offset >>= 3;
2441             if (size == 8)
2442                 retnum = s[offset];
2443             else if (size == 16)
2444                 retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
2445             else if (size == 32)
2446                 retnum = ((unsigned long) s[offset] << 24) +
2447                         ((unsigned long) s[offset + 1] << 16) +
2448                         (s[offset + 2] << 8) + s[offset+3];
2449         }
2450
2451         if (lvalue) {                      /* it's an lvalue! */
2452             if (SvTHINKFIRST(src)) {
2453                 if (SvREADONLY(src) && curcop != &compiling)
2454                     DIE(no_modify);
2455                 if (SvROK(src))
2456                     DIE("Can't modify vec of a reference");
2457             }
2458             LvTYPE(TARG) = 'v';
2459             LvTARG(TARG) = src;
2460             LvTARGOFF(TARG) = offset;
2461             LvTARGLEN(TARG) = size;
2462         }
2463     }
2464
2465     sv_setiv(TARG, (I32)retnum);
2466     PUSHs(TARG);
2467     RETURN;
2468 }
2469
2470 PP(pp_index)
2471 {
2472     dSP; dTARGET;
2473     SV *big;
2474     SV *little;
2475     I32 offset;
2476     I32 retval;
2477     char *tmps;
2478     char *tmps2;
2479     STRLEN biglen;
2480
2481     if (MAXARG < 3)
2482         offset = 0;
2483     else
2484         offset = POPi - arybase;
2485     little = POPs;
2486     big = POPs;
2487     tmps = SvPV(big, biglen);
2488     if (offset < 0)
2489         offset = 0;
2490     else if (offset > biglen)
2491         offset = biglen;
2492     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
2493       (unsigned char*)tmps + biglen, little)))
2494         retval = -1 + arybase;
2495     else
2496         retval = tmps2 - tmps + arybase;
2497     PUSHi(retval);
2498     RETURN;
2499 }
2500
2501 PP(pp_rindex)
2502 {
2503     dSP; dTARGET;
2504     SV *big;
2505     SV *little;
2506     STRLEN blen;
2507     STRLEN llen;
2508     SV *offstr;
2509     I32 offset;
2510     I32 retval;
2511     char *tmps;
2512     char *tmps2;
2513
2514     if (MAXARG == 3)
2515         offstr = POPs;
2516     little = POPs;
2517     big = POPs;
2518     tmps2 = SvPV(little, llen);
2519     tmps = SvPV(big, blen);
2520     if (MAXARG < 3)
2521         offset = blen;
2522     else
2523         offset = SvIV(offstr) - arybase + llen;
2524     if (offset < 0)
2525         offset = 0;
2526     else if (offset > blen)
2527         offset = blen;
2528     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
2529                           tmps2, tmps2 + llen)))
2530         retval = -1 + arybase;
2531     else
2532         retval = tmps2 - tmps + arybase;
2533     PUSHi(retval);
2534     RETURN;
2535 }
2536
2537 PP(pp_sprintf)
2538 {
2539     dSP; dMARK; dORIGMARK; dTARGET;
2540     do_sprintf(TARG, SP-MARK, MARK+1);
2541     SP = ORIGMARK;
2542     PUSHTARG;
2543     RETURN;
2544 }
2545
2546 static void
2547 doparseform(sv)
2548 SV *sv;
2549 {
2550     STRLEN len;
2551     register char *s = SvPV(sv, len);
2552     register char *send = s + len;
2553     register char *base;
2554     register I32 skipspaces = 0;
2555     bool noblank;
2556     bool repeat;
2557     bool postspace = FALSE;
2558     U16 *fops;
2559     register U16 *fpc;
2560     U16 *linepc;
2561     register I32 arg;
2562     bool ischop;
2563
2564     New(804, fops, send - s, U16);      /* Almost certainly too long... */
2565     fpc = fops;
2566
2567     if (s < send) {
2568         linepc = fpc;
2569         *fpc++ = FF_LINEMARK;
2570         noblank = repeat = FALSE;
2571         base = s;
2572     }
2573
2574     while (s <= send) {
2575         switch (*s++) {
2576         default:
2577             skipspaces = 0;
2578             continue;
2579
2580         case '~':
2581             if (*s == '~') {
2582                 repeat = TRUE;
2583                 *s = ' ';
2584             }
2585             noblank = TRUE;
2586             s[-1] = ' ';
2587             /* FALL THROUGH */
2588         case ' ': case '\t':
2589             skipspaces++;
2590             continue;
2591
2592         case '\n': case 0:
2593             arg = s - base;
2594             skipspaces++;
2595             arg -= skipspaces;
2596             if (arg) {
2597                 if (postspace) {
2598                     *fpc++ = FF_SPACE;
2599                     postspace = FALSE;
2600                 }
2601                 *fpc++ = FF_LITERAL;
2602                 *fpc++ = arg;
2603             }
2604             if (s <= send)
2605                 skipspaces--;
2606             if (skipspaces) {
2607                 *fpc++ = FF_SKIP;
2608                 *fpc++ = skipspaces;
2609             }
2610             skipspaces = 0;
2611             if (s <= send)
2612                 *fpc++ = FF_NEWLINE;
2613             if (noblank) {
2614                 *fpc++ = FF_BLANK;
2615                 if (repeat)
2616                     arg = fpc - linepc + 1;
2617                 else
2618                     arg = 0;
2619                 *fpc++ = arg;
2620             }
2621             if (s < send) {
2622                 linepc = fpc;
2623                 *fpc++ = FF_LINEMARK;
2624                 noblank = repeat = FALSE;
2625                 base = s;
2626             }
2627             else
2628                 s++;
2629             continue;
2630
2631         case '@':
2632         case '^':
2633             ischop = s[-1] == '^';
2634
2635             if (postspace) {
2636                 *fpc++ = FF_SPACE;
2637                 postspace = FALSE;
2638             }
2639             arg = (s - base) - 1;
2640             if (arg) {
2641                 *fpc++ = FF_LITERAL;
2642                 *fpc++ = arg;
2643             }
2644
2645             base = s - 1;
2646             *fpc++ = FF_FETCH;
2647             if (*s == '*') {
2648                 s++;
2649                 *fpc++ = 0;
2650                 *fpc++ = FF_LINEGLOB;
2651             }
2652             else if (*s == '#' || (*s == '.' && s[1] == '#')) {
2653                 arg = ischop ? 512 : 0;
2654                 base = s - 1;
2655                 while (*s == '#')
2656                     s++;
2657                 if (*s == '.') {
2658                     char *f;
2659                     s++;
2660                     f = s;
2661                     while (*s == '#')
2662                         s++;
2663                     arg |= 256 + (s - f);
2664                 }
2665                 *fpc++ = s - base;              /* fieldsize for FETCH */
2666                 *fpc++ = FF_DECIMAL;
2667                 *fpc++ = arg;
2668             }
2669             else {
2670                 I32 prespace = 0;
2671                 bool ismore = FALSE;
2672
2673                 if (*s == '>') {
2674                     while (*++s == '>') ;
2675                     prespace = FF_SPACE;
2676                 }
2677                 else if (*s == '|') {
2678                     while (*++s == '|') ;
2679                     prespace = FF_HALFSPACE;
2680                     postspace = TRUE;
2681                 }
2682                 else {
2683                     if (*s == '<')
2684                         while (*++s == '<') ;
2685                     postspace = TRUE;
2686                 }
2687                 if (*s == '.' && s[1] == '.' && s[2] == '.') {
2688                     s += 3;
2689                     ismore = TRUE;
2690                 }
2691                 *fpc++ = s - base;              /* fieldsize for FETCH */
2692
2693                 *fpc++ = ischop ? FF_CHECKCHOP : FF_CHECKNL;
2694
2695                 if (prespace)
2696                     *fpc++ = prespace;
2697                 *fpc++ = FF_ITEM;
2698                 if (ismore)
2699                     *fpc++ = FF_MORE;
2700                 if (ischop)
2701                     *fpc++ = FF_CHOP;
2702             }
2703             base = s;
2704             skipspaces = 0;
2705             continue;
2706         }
2707     }
2708     *fpc++ = FF_END;
2709
2710     arg = fpc - fops;
2711     SvGROW(sv, SvCUR(sv) + arg * sizeof(U16) + 4);
2712
2713     s = SvPVX(sv) + SvCUR(sv);
2714     s += 2 + (SvCUR(sv) & 1);
2715
2716     Copy(fops, s, arg, U16);
2717     Safefree(fops);
2718 }
2719
2720 PP(pp_formline)
2721 {
2722     dSP; dMARK; dORIGMARK;
2723     register SV *form = *++MARK;
2724     register U16 *fpc;
2725     register char *t;
2726     register char *f;
2727     register char *s;
2728     register char *send;
2729     register I32 arg;
2730     register SV *sv;
2731     char *item;
2732     I32 itemsize;
2733     I32 fieldsize;
2734     I32 lines = 0;
2735     bool chopspace = (strchr(chopset, ' ') != Nullch);
2736     char *chophere;
2737     char *linemark;
2738     char *formmark;
2739     SV **markmark;
2740     double value;
2741     bool gotsome;
2742     STRLEN len;
2743
2744     if (!SvCOMPILED(form)) {
2745         SvREADONLY_off(form);
2746         doparseform(form);
2747     }
2748
2749     SvUPGRADE(formtarget, SVt_PV);
2750     SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1);
2751     t = SvPV(formtarget, len);
2752     t += len;
2753     f = SvPV(form, len);
2754
2755     s = f + len;
2756     s += 2 + (len & 1);
2757
2758     fpc = (U16*)s;
2759
2760     for (;;) {
2761         DEBUG_f( {
2762             char *name = "???";
2763             arg = -1;
2764             switch (*fpc) {
2765             case FF_LITERAL:    arg = fpc[1]; name = "LITERAL"; break;
2766             case FF_BLANK:      arg = fpc[1]; name = "BLANK";   break;
2767             case FF_SKIP:       arg = fpc[1]; name = "SKIP";    break;
2768             case FF_FETCH:      arg = fpc[1]; name = "FETCH";   break;
2769             case FF_DECIMAL:    arg = fpc[1]; name = "DECIMAL"; break;
2770
2771             case FF_CHECKNL:    name = "CHECKNL";       break;
2772             case FF_CHECKCHOP:  name = "CHECKCHOP";     break;
2773             case FF_SPACE:      name = "SPACE";         break;
2774             case FF_HALFSPACE:  name = "HALFSPACE";     break;
2775             case FF_ITEM:       name = "ITEM";          break;
2776             case FF_CHOP:       name = "CHOP";          break;
2777             case FF_LINEGLOB:   name = "LINEGLOB";      break;
2778             case FF_NEWLINE:    name = "NEWLINE";       break;
2779             case FF_MORE:       name = "MORE";          break;
2780             case FF_LINEMARK:   name = "LINEMARK";      break;
2781             case FF_END:        name = "END";           break;
2782             }
2783             if (arg >= 0)
2784                 fprintf(stderr, "%-16s%d\n", name, arg);
2785             else
2786                 fprintf(stderr, "%-16s\n", name);
2787         } )
2788         switch (*fpc++) {
2789         case FF_LINEMARK:
2790             linemark = t;
2791             formmark = f;
2792             markmark = MARK;
2793             lines++;
2794             gotsome = FALSE;
2795             break;
2796
2797         case FF_LITERAL:
2798             arg = *fpc++;
2799             while (arg--)
2800                 *t++ = *f++;
2801             break;
2802
2803         case FF_SKIP:
2804             f += *fpc++;
2805             break;
2806
2807         case FF_FETCH:
2808             arg = *fpc++;
2809             f += arg;
2810             fieldsize = arg;
2811
2812             if (MARK < SP)
2813                 sv = *++MARK;
2814             else {
2815                 sv = &sv_no;
2816                 if (dowarn)
2817                     warn("Not enough format arguments");
2818             }
2819             break;
2820
2821         case FF_CHECKNL:
2822             item = s = SvPV(sv, len);
2823             itemsize = len;
2824             if (itemsize > fieldsize)
2825                 itemsize = fieldsize;
2826             send = chophere = s + itemsize;
2827             while (s < send) {
2828                 if (*s & ~31)
2829                     gotsome = TRUE;
2830                 else if (*s == '\n')
2831                     break;
2832                 s++;
2833             }
2834             itemsize = s - item;
2835             break;
2836
2837         case FF_CHECKCHOP:
2838             item = s = SvPV(sv, len);
2839             itemsize = len;
2840             if (itemsize <= fieldsize) {
2841                 send = chophere = s + itemsize;
2842                 while (s < send) {
2843                     if (*s == '\r') {
2844                         itemsize = s - item;
2845                         break;
2846                     }
2847                     if (*s++ & ~31)
2848                         gotsome = TRUE;
2849                 }
2850             }
2851             else {
2852                 itemsize = fieldsize;
2853                 send = chophere = s + itemsize;
2854                 while (s < send || (s == send && isSPACE(*s))) {
2855                     if (isSPACE(*s)) {
2856                         if (chopspace)
2857                             chophere = s;
2858                         if (*s == '\r')
2859                             break;
2860                     }
2861                     else {
2862                         if (*s & ~31)
2863                             gotsome = TRUE;
2864                         if (strchr(chopset, *s))
2865                             chophere = s + 1;
2866                     }
2867                     s++;
2868                 }
2869                 itemsize = chophere - item;
2870             }
2871             break;
2872
2873         case FF_SPACE:
2874             arg = fieldsize - itemsize;
2875             if (arg) {
2876                 fieldsize -= arg;
2877                 while (arg-- > 0)
2878                     *t++ = ' ';
2879             }
2880             break;
2881
2882         case FF_HALFSPACE:
2883             arg = fieldsize - itemsize;
2884             if (arg) {
2885                 arg /= 2;
2886                 fieldsize -= arg;
2887                 while (arg-- > 0)
2888                     *t++ = ' ';
2889             }
2890             break;
2891
2892         case FF_ITEM:
2893             arg = itemsize;
2894             s = item;
2895             while (arg--) {
2896                 if ((*t++ = *s++) < ' ')
2897                     t[-1] = ' ';
2898             }
2899             break;
2900
2901         case FF_CHOP:
2902             s = chophere;
2903             if (chopspace) {
2904                 while (*s && isSPACE(*s))
2905                     s++;
2906             }
2907             sv_chop(sv,s);
2908             break;
2909
2910         case FF_LINEGLOB:
2911             item = s = SvPV(sv, len);
2912             itemsize = len;
2913             if (itemsize) {
2914                 gotsome = TRUE;
2915                 send = s + itemsize;
2916                 while (s < send) {
2917                     if (*s++ == '\n') {
2918                         if (s == send)
2919                             itemsize--;
2920                         else
2921                             lines++;
2922                     }
2923                 }
2924                 SvCUR_set(formtarget, t - SvPVX(formtarget));
2925                 sv_catpvn(formtarget, item, itemsize);
2926                 SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1);
2927                 t = SvPVX(formtarget) + SvCUR(formtarget);
2928             }
2929             break;
2930
2931         case FF_DECIMAL:
2932             /* If the field is marked with ^ and the value is undefined,
2933                blank it out. */
2934             arg = *fpc++;
2935             if ((arg & 512) && !SvOK(sv)) {
2936                 arg = fieldsize;
2937                 while (arg--)
2938                     *t++ = ' ';
2939                 break;
2940             }
2941             gotsome = TRUE;
2942             value = SvNV(sv);
2943             if (arg & 256) {
2944                 sprintf(t, "%#*.*f", fieldsize, arg & 255, value);
2945             } else {
2946                 sprintf(t, "%*.0f", fieldsize, value);
2947             }
2948             t += fieldsize;
2949             break;
2950
2951         case FF_NEWLINE:
2952             f++;
2953             while (t-- > linemark && *t == ' ') ;
2954             t++;
2955             *t++ = '\n';
2956             break;
2957
2958         case FF_BLANK:
2959             arg = *fpc++;
2960             if (gotsome) {
2961                 if (arg) {              /* repeat until fields exhausted? */
2962                     fpc -= arg;
2963                     f = formmark;
2964                     MARK = markmark;
2965                     if (lines == 200) {
2966                         arg = t - linemark;
2967                         if (strnEQ(linemark, linemark - arg, arg))
2968                             DIE("Runaway format");
2969                     }
2970                     arg = t - SvPVX(formtarget);
2971                     SvGROW(formtarget,
2972                         (t - SvPVX(formtarget)) + (f - formmark) + 1);
2973                     t = SvPVX(formtarget) + arg;
2974                 }
2975             }
2976             else {
2977                 t = linemark;
2978                 lines--;
2979             }
2980             break;
2981
2982         case FF_MORE:
2983             if (itemsize) {
2984                 arg = fieldsize - itemsize;
2985                 if (arg) {
2986                     fieldsize -= arg;
2987                     while (arg-- > 0)
2988                         *t++ = ' ';
2989                 }
2990                 s = t - 3;
2991                 if (strnEQ(s,"   ",3)) {
2992                     while (s > SvPVX(formtarget) && isSPACE(s[-1]))
2993                         s--;
2994                 }
2995                 *s++ = '.';
2996                 *s++ = '.';
2997                 *s++ = '.';
2998             }
2999             break;
3000
3001         case FF_END:
3002             *t = '\0';
3003             SvCUR_set(formtarget, t - SvPVX(formtarget));
3004             FmLINES(formtarget) += lines;
3005             SP = ORIGMARK;
3006             RETPUSHYES;
3007         }
3008     }
3009 }
3010
3011 PP(pp_ord)
3012 {
3013     dSP; dTARGET;
3014     I32 value;
3015     char *tmps;
3016     I32 anum;
3017
3018     if (MAXARG < 1)
3019         tmps = SvPVx(GvSV(defgv), na);
3020     else
3021         tmps = POPp;
3022 #ifndef I286
3023     value = (I32) (*tmps & 255);
3024 #else
3025     anum = (I32) *tmps;
3026     value = (I32) (anum & 255);
3027 #endif
3028     XPUSHi(value);
3029     RETURN;
3030 }
3031
3032 PP(pp_chr)
3033 {
3034     dSP; dTARGET;
3035     char *tmps;
3036
3037     if (SvTYPE(TARG) == SVt_NULL) {
3038         sv_upgrade(TARG,SVt_PV);
3039         SvGROW(TARG,1);
3040     }
3041     SvCUR_set(TARG, 1);
3042     tmps = SvPVX(TARG);
3043     if (MAXARG < 1)
3044         *tmps = SvIVx(GvSV(defgv));
3045     else
3046         *tmps = POPi;
3047     SvPOK_only(TARG);
3048     XPUSHs(TARG);
3049     RETURN;
3050 }
3051
3052 PP(pp_crypt)
3053 {
3054     dSP; dTARGET; dPOPTOPssrl;
3055 #ifdef HAS_CRYPT
3056     char *tmps = SvPV(lstr, na);
3057 #ifdef FCRYPT
3058     sv_setpv(TARG, fcrypt(tmps, SvPV(rstr, na)));
3059 #else
3060     sv_setpv(TARG, crypt(tmps, SvPV(rstr, na)));
3061 #endif
3062 #else
3063     DIE(
3064       "The crypt() function is unimplemented due to excessive paranoia.");
3065 #endif
3066     SETs(TARG);
3067     RETURN;
3068 }
3069
3070 PP(pp_ucfirst)
3071 {
3072     dSP;
3073     SV *sv = TOPs;
3074     register char *s;
3075
3076     if (!SvPADTMP(sv)) {
3077         dTARGET;
3078         sv_setsv(TARG, sv);
3079         sv = TARG;
3080         SETs(sv);
3081     }
3082     s = SvPV(sv, na);
3083     if (isascii(*s) && islower(*s))
3084         *s = toupper(*s);
3085
3086     RETURN;
3087 }
3088
3089 PP(pp_lcfirst)
3090 {
3091     dSP;
3092     SV *sv = TOPs;
3093     register char *s;
3094
3095     if (!SvPADTMP(sv)) {
3096         dTARGET;
3097         sv_setsv(TARG, sv);
3098         sv = TARG;
3099         SETs(sv);
3100     }
3101     s = SvPV(sv, na);
3102     if (isascii(*s) && isupper(*s))
3103         *s = tolower(*s);
3104
3105     SETs(sv);
3106     RETURN;
3107 }
3108
3109 PP(pp_uc)
3110 {
3111     dSP;
3112     SV *sv = TOPs;
3113     register char *s;
3114     register char *send;
3115     STRLEN len;
3116
3117     if (!SvPADTMP(sv)) {
3118         dTARGET;
3119         sv_setsv(TARG, sv);
3120         sv = TARG;
3121         SETs(sv);
3122     }
3123     s = SvPV(sv, len);
3124     send = s + len;
3125     while (s < send) {
3126         if (isascii(*s) && islower(*s))
3127             *s = toupper(*s);
3128         s++;
3129     }
3130     RETURN;
3131 }
3132
3133 PP(pp_lc)
3134 {
3135     dSP;
3136     SV *sv = TOPs;
3137     register char *s;
3138     register char *send;
3139     STRLEN len;
3140
3141     if (!SvPADTMP(sv)) {
3142         dTARGET;
3143         sv_setsv(TARG, sv);
3144         sv = TARG;
3145         SETs(sv);
3146     }
3147     s = SvPV(sv, len);
3148     send = s + len;
3149     while (s < send) {
3150         if (isascii(*s) && isupper(*s))
3151             *s = tolower(*s);
3152         s++;
3153     }
3154     RETURN;
3155 }
3156
3157 /* Arrays. */
3158
3159 PP(pp_rv2av)
3160 {
3161     dSP; dPOPss;
3162
3163     AV *av;
3164
3165     if (SvROK(sv)) {
3166         av = (AV*)SvRV(sv);
3167         if (SvTYPE(av) != SVt_PVAV)
3168             DIE("Not an array reference");
3169         if (op->op_flags & OPf_LVAL) {
3170             if (op->op_flags & OPf_INTRO)
3171                 av = (AV*)save_svref((SV**)sv);
3172             PUSHs((SV*)av);
3173             RETURN;
3174         }
3175     }
3176     else {
3177         if (SvTYPE(sv) == SVt_PVAV) {
3178             av = (AV*)sv;
3179             if (op->op_flags & OPf_LVAL) {
3180                 PUSHs((SV*)av);
3181                 RETURN;
3182             }
3183         }
3184         else {
3185             if (SvTYPE(sv) != SVt_PVGV) {
3186                 if (!SvOK(sv))
3187                     DIE(no_usym, "an array");
3188                 if (op->op_private & HINT_STRICT_REFS)
3189                     DIE(no_hardref, "an array");
3190                 sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVAV);
3191             }
3192             av = GvAVn(sv);
3193             if (op->op_flags & OPf_LVAL) {
3194                 if (op->op_flags & OPf_INTRO)
3195                     av = save_ary(sv);
3196                 PUSHs((SV*)av);
3197                 RETURN;
3198             }
3199         }
3200     }
3201
3202     if (GIMME == G_ARRAY) {
3203         I32 maxarg = AvFILL(av) + 1;
3204         EXTEND(SP, maxarg);
3205         Copy(AvARRAY(av), SP+1, maxarg, SV*);
3206         SP += maxarg;
3207     }
3208     else {
3209         dTARGET;
3210         I32 maxarg = AvFILL(av) + 1;
3211         PUSHi(maxarg);
3212     }
3213     RETURN;
3214 }
3215
3216 PP(pp_aelemfast)
3217 {
3218     dSP;
3219     AV *av = GvAV((GV*)cSVOP->op_sv);
3220     SV** svp = av_fetch(av, op->op_private - arybase, op->op_flags & OPf_LVAL);
3221     PUSHs(svp ? *svp : &sv_undef);
3222     RETURN;
3223 }
3224
3225 PP(pp_aelem)
3226 {
3227     dSP;
3228     SV** svp;
3229     I32 elem = POPi - arybase;
3230     AV *av = (AV*)POPs;
3231
3232     if (op->op_flags & OPf_LVAL) {
3233         svp = av_fetch(av, elem, TRUE);
3234         if (!svp || *svp == &sv_undef)
3235             DIE(no_aelem, elem);
3236         if (op->op_flags & OPf_INTRO)
3237             save_svref(svp);
3238         else if (!SvOK(*svp)) {
3239             if (op->op_private & OPpDEREF_HV) {
3240                 SvREFCNT_dec(*svp);
3241                 *svp = NEWSV(0,0);
3242                 sv_upgrade(*svp, SVt_RV);
3243                 SvRV(*svp) = SvREFCNT_inc(newHV());
3244                 SvROK_on(*svp);
3245                 ++sv_rvcount;
3246             }
3247             else if (op->op_private & OPpDEREF_AV) {
3248                 SvREFCNT_dec(*svp);
3249                 *svp = NEWSV(0,0);
3250                 sv_upgrade(*svp, SVt_RV);
3251                 SvRV(*svp) = SvREFCNT_inc(newAV());
3252                 SvROK_on(*svp);
3253                 ++sv_rvcount;
3254             }
3255         }
3256     }
3257     else
3258         svp = av_fetch(av, elem, FALSE);
3259     PUSHs(svp ? *svp : &sv_undef);
3260     RETURN;
3261 }
3262
3263 PP(pp_aslice)
3264 {
3265     dSP; dMARK; dORIGMARK;
3266     register SV** svp;
3267     register AV* av = (AV*)POPs;
3268     register I32 lval = op->op_flags & OPf_LVAL;
3269     I32 is_something_there = lval;
3270
3271     while (++MARK <= SP) {
3272         I32 elem = SvIVx(*MARK);
3273
3274         if (lval) {
3275             svp = av_fetch(av, elem, TRUE);
3276             if (!svp || *svp == &sv_undef)
3277                 DIE(no_aelem, elem);
3278             if (op->op_flags & OPf_INTRO)
3279                 save_svref(svp);
3280         }
3281         else {
3282             svp = av_fetch(av, elem, FALSE);
3283             if (!is_something_there && svp && SvOK(*svp))
3284                 is_something_there = TRUE;
3285         }
3286         *MARK = svp ? *svp : &sv_undef;
3287     }
3288     if (!is_something_there)
3289         SP = ORIGMARK;
3290     RETURN;
3291 }
3292
3293 /* Associative arrays. */
3294
3295 PP(pp_each)
3296 {
3297     dSP; dTARGET;
3298     HV *hash = (HV*)POPs;
3299     HE *entry = hv_iternext(hash);
3300     I32 i;
3301     char *tmps;
3302
3303     EXTEND(SP, 2);
3304     if (entry) {
3305         tmps = hv_iterkey(entry, &i);
3306         if (!i)
3307             tmps = "";
3308         PUSHs(sv_2mortal(newSVpv(tmps, i)));
3309         if (GIMME == G_ARRAY) {
3310             sv_setsv(TARG, hv_iterval(hash, entry));
3311             PUSHs(TARG);
3312         }
3313     }
3314     else if (GIMME == G_SCALAR)
3315         RETPUSHUNDEF;
3316
3317     RETURN;
3318 }
3319
3320 PP(pp_values)
3321 {
3322     return do_kv(ARGS);
3323 }
3324
3325 PP(pp_keys)
3326 {
3327     return do_kv(ARGS);
3328 }
3329
3330 PP(pp_delete)
3331 {
3332     dSP;
3333     SV *sv;
3334     SV *tmpsv = POPs;
3335     HV *hv = (HV*)POPs;
3336     char *tmps;
3337     STRLEN len;
3338     if (!hv) {
3339         DIE("Not an associative array reference");
3340     }
3341     tmps = SvPV(tmpsv, len);
3342     sv = hv_delete(hv, tmps, len);
3343     if (!sv)
3344         RETPUSHUNDEF;
3345     PUSHs(sv);
3346     RETURN;
3347 }
3348
3349 PP(pp_rv2hv)
3350 {
3351
3352     dSP; dTOPss;
3353
3354     HV *hv;
3355
3356     if (SvROK(sv)) {
3357         hv = (HV*)SvRV(sv);
3358         if (SvTYPE(hv) != SVt_PVHV)
3359             DIE("Not an associative array reference");
3360         if (op->op_flags & OPf_LVAL) {
3361             if (op->op_flags & OPf_INTRO)
3362                 hv = (HV*)save_svref((SV**)sv);
3363             SETs((SV*)hv);
3364             RETURN;
3365         }
3366     }
3367     else {
3368         if (SvTYPE(sv) == SVt_PVHV) {
3369             hv = (HV*)sv;
3370             if (op->op_flags & OPf_LVAL) {
3371                 SETs((SV*)hv);
3372                 RETURN;
3373             }
3374         }
3375         else {
3376             if (SvTYPE(sv) != SVt_PVGV) {
3377                 if (!SvOK(sv))
3378                     DIE(no_usym, "a hash");
3379                 if (op->op_private & HINT_STRICT_REFS)
3380                     DIE(no_hardref, "a hash");
3381                 sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVHV);
3382             }
3383             hv = GvHVn(sv);
3384             if (op->op_flags & OPf_LVAL) {
3385                 if (op->op_flags & OPf_INTRO)
3386                     hv = save_hash(sv);
3387                 SETs((SV*)hv);
3388                 RETURN;
3389             }
3390         }
3391     }
3392
3393     if (GIMME == G_ARRAY) { /* array wanted */
3394         *stack_sp = (SV*)hv;
3395         return do_kv(ARGS);
3396     }
3397     else {
3398         dTARGET;
3399         if (HvFILL(hv)) {
3400             sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
3401             sv_setpv(TARG, buf);
3402         }
3403         else
3404             sv_setiv(TARG, 0);
3405         SETTARG;
3406         RETURN;
3407     }
3408 }
3409
3410 PP(pp_helem)
3411 {
3412     dSP;
3413     SV** svp;
3414     SV *keysv = POPs;
3415     STRLEN keylen;
3416     char *key = SvPV(keysv, keylen);
3417     HV *hv = (HV*)POPs;
3418
3419     if (op->op_flags & OPf_LVAL) {
3420         svp = hv_fetch(hv, key, keylen, TRUE);
3421         if (!svp || *svp == &sv_undef)
3422             DIE(no_helem, key);
3423         if (op->op_flags & OPf_INTRO)
3424             save_svref(svp);
3425         else if (!SvOK(*svp)) {
3426             if (op->op_private & OPpDEREF_HV) {
3427                 SvREFCNT_dec(*svp);
3428                 *svp = NEWSV(0,0);
3429                 sv_upgrade(*svp, SVt_RV);
3430                 SvRV(*svp) = SvREFCNT_inc(newHV());
3431                 SvROK_on(*svp);
3432                 ++sv_rvcount;
3433             }
3434             else if (op->op_private & OPpDEREF_AV) {
3435                 SvREFCNT_dec(*svp);
3436                 *svp = NEWSV(0,0);
3437                 sv_upgrade(*svp, SVt_RV);
3438                 SvRV(*svp) = SvREFCNT_inc(newAV());
3439                 SvROK_on(*svp);
3440                 ++sv_rvcount;
3441             }
3442         }
3443     }
3444     else
3445         svp = hv_fetch(hv, key, keylen, FALSE);
3446     PUSHs(svp ? *svp : &sv_undef);
3447     RETURN;
3448 }
3449
3450 PP(pp_hslice)
3451 {
3452     dSP; dMARK; dORIGMARK;
3453     register SV **svp;
3454     register HV *hv = (HV*)POPs;
3455     register I32 lval = op->op_flags & OPf_LVAL;
3456     I32 is_something_there = lval;
3457
3458     while (++MARK <= SP) {
3459         STRLEN keylen;
3460         char *key = SvPV(*MARK, keylen);
3461
3462         if (lval) {
3463             svp = hv_fetch(hv, key, keylen, TRUE);
3464             if (!svp || *svp == &sv_undef)
3465                 DIE(no_helem, key);
3466             if (op->op_flags & OPf_INTRO)
3467                 save_svref(svp);
3468         }
3469         else {
3470             svp = hv_fetch(hv, key, keylen, FALSE);
3471             if (!is_something_there && svp && SvOK(*svp))
3472                 is_something_there = TRUE;
3473         }
3474         *MARK = svp ? *svp : &sv_undef;
3475     }
3476     if (!is_something_there)
3477         SP = ORIGMARK;
3478     RETURN;
3479 }
3480
3481 /* Explosives and implosives. */
3482
3483 PP(pp_unpack)
3484 {
3485     dSP;
3486     dPOPPOPssrl;
3487     SV *sv;
3488     STRLEN llen;
3489     STRLEN rlen;
3490     register char *pat = SvPV(lstr, llen);
3491     register char *s = SvPV(rstr, rlen);
3492     char *strend = s + rlen;
3493     char *strbeg = s;
3494     register char *patend = pat + llen;
3495     I32 datumtype;
3496     register I32 len;
3497     register I32 bits;
3498
3499     /* These must not be in registers: */
3500     I16 ashort;
3501     int aint;
3502     I32 along;
3503 #ifdef QUAD
3504     quad aquad;
3505 #endif
3506     U16 aushort;
3507     unsigned int auint;
3508     U32 aulong;
3509 #ifdef QUAD
3510     unsigned quad auquad;
3511 #endif
3512     char *aptr;
3513     float afloat;
3514     double adouble;
3515     I32 checksum = 0;
3516     register U32 culong;
3517     double cdouble;
3518     static char* bitcount = 0;
3519
3520     if (GIMME != G_ARRAY) {             /* arrange to do first one only */
3521         /*SUPPRESS 530*/
3522         for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
3523         if (strchr("aAbBhH", *patend) || *pat == '%') {
3524             patend++;
3525             while (isDIGIT(*patend) || *patend == '*')
3526                 patend++;
3527         }
3528         else
3529             patend++;
3530     }
3531     while (pat < patend) {
3532       reparse:
3533         datumtype = *pat++;
3534         if (pat >= patend)
3535             len = 1;
3536         else if (*pat == '*') {
3537             len = strend - strbeg;      /* long enough */
3538             pat++;
3539         }
3540         else if (isDIGIT(*pat)) {
3541             len = *pat++ - '0';
3542             while (isDIGIT(*pat))
3543                 len = (len * 10) + (*pat++ - '0');
3544         }
3545         else
3546             len = (datumtype != '@');
3547         switch(datumtype) {
3548         default:
3549             break;
3550         case '%':
3551             if (len == 1 && pat[-1] != '1')
3552                 len = 16;
3553             checksum = len;
3554             culong = 0;
3555             cdouble = 0;
3556             if (pat < patend)
3557                 goto reparse;
3558             break;
3559         case '@':
3560             if (len > strend - strbeg)
3561                 DIE("@ outside of string");
3562             s = strbeg + len;
3563             break;
3564         case 'X':
3565             if (len > s - strbeg)
3566                 DIE("X outside of string");
3567             s -= len;
3568             break;
3569         case 'x':
3570             if (len > strend - s)
3571                 DIE("x outside of string");
3572             s += len;
3573             break;
3574         case 'A':
3575         case 'a':
3576             if (len > strend - s)
3577                 len = strend - s;
3578             if (checksum)
3579                 goto uchar_checksum;
3580             sv = NEWSV(35, len);
3581             sv_setpvn(sv, s, len);
3582             s += len;
3583             if (datumtype == 'A') {
3584                 aptr = s;       /* borrow register */
3585                 s = SvPVX(sv) + len - 1;
3586                 while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
3587                     s--;
3588                 *++s = '\0';
3589                 SvCUR_set(sv, s - SvPVX(sv));
3590                 s = aptr;       /* unborrow register */
3591             }
3592             XPUSHs(sv_2mortal(sv));
3593             break;
3594         case 'B':
3595         case 'b':
3596             if (pat[-1] == '*' || len > (strend - s) * 8)
3597                 len = (strend - s) * 8;
3598             if (checksum) {
3599                 if (!bitcount) {
3600                     Newz(601, bitcount, 256, char);
3601                     for (bits = 1; bits < 256; bits++) {
3602                         if (bits & 1)   bitcount[bits]++;
3603                         if (bits & 2)   bitcount[bits]++;
3604                         if (bits & 4)   bitcount[bits]++;
3605                         if (bits & 8)   bitcount[bits]++;
3606                         if (bits & 16)  bitcount[bits]++;
3607                         if (bits & 32)  bitcount[bits]++;
3608                         if (bits & 64)  bitcount[bits]++;
3609                         if (bits & 128) bitcount[bits]++;
3610                     }
3611                 }
3612                 while (len >= 8) {
3613                     culong += bitcount[*(unsigned char*)s++];
3614                     len -= 8;
3615                 }
3616                 if (len) {
3617                     bits = *s;
3618                     if (datumtype == 'b') {
3619                         while (len-- > 0) {
3620                             if (bits & 1) culong++;
3621                             bits >>= 1;
3622                         }
3623                     }
3624                     else {
3625                         while (len-- > 0) {
3626                             if (bits & 128) culong++;
3627                             bits <<= 1;
3628                         }
3629                     }
3630                 }
3631                 break;
3632             }
3633             sv = NEWSV(35, len + 1);
3634             SvCUR_set(sv, len);
3635             SvPOK_on(sv);
3636             aptr = pat;                 /* borrow register */
3637             pat = SvPVX(sv);
3638             if (datumtype == 'b') {
3639                 aint = len;
3640                 for (len = 0; len < aint; len++) {
3641                     if (len & 7)                /*SUPPRESS 595*/
3642                         bits >>= 1;
3643                     else
3644                         bits = *s++;
3645                     *pat++ = '0' + (bits & 1);
3646                 }
3647             }
3648             else {
3649                 aint = len;
3650                 for (len = 0; len < aint; len++) {
3651                     if (len & 7)
3652                         bits <<= 1;
3653                     else
3654                         bits = *s++;
3655                     *pat++ = '0' + ((bits & 128) != 0);
3656                 }
3657             }
3658             *pat = '\0';
3659             pat = aptr;                 /* unborrow register */
3660             XPUSHs(sv_2mortal(sv));
3661             break;
3662         case 'H':
3663         case 'h':
3664             if (pat[-1] == '*' || len > (strend - s) * 2)
3665                 len = (strend - s) * 2;
3666             sv = NEWSV(35, len + 1);
3667             SvCUR_set(sv, len);
3668             SvPOK_on(sv);
3669             aptr = pat;                 /* borrow register */
3670             pat = SvPVX(sv);
3671             if (datumtype == 'h') {
3672                 aint = len;
3673                 for (len = 0; len < aint; len++) {
3674                     if (len & 1)
3675                         bits >>= 4;
3676                     else
3677                         bits = *s++;
3678                     *pat++ = hexdigit[bits & 15];
3679                 }
3680             }
3681             else {
3682                 aint = len;
3683                 for (len = 0; len < aint; len++) {
3684                     if (len & 1)
3685                         bits <<= 4;
3686                     else
3687                         bits = *s++;
3688                     *pat++ = hexdigit[(bits >> 4) & 15];
3689                 }
3690             }
3691             *pat = '\0';
3692             pat = aptr;                 /* unborrow register */
3693             XPUSHs(sv_2mortal(sv));
3694             break;
3695         case 'c':
3696             if (len > strend - s)
3697                 len = strend - s;
3698             if (checksum) {
3699                 while (len-- > 0) {
3700                     aint = *s++;
3701                     if (aint >= 128)    /* fake up signed chars */
3702                         aint -= 256;
3703                     culong += aint;
3704                 }
3705             }
3706             else {
3707                 EXTEND(SP, len);
3708                 while (len-- > 0) {
3709                     aint = *s++;
3710                     if (aint >= 128)    /* fake up signed chars */
3711                         aint -= 256;
3712                     sv = NEWSV(36, 0);
3713                     sv_setiv(sv, (I32)aint);
3714                     PUSHs(sv_2mortal(sv));
3715                 }
3716             }
3717             break;
3718         case 'C':
3719             if (len > strend - s)
3720                 len = strend - s;
3721             if (checksum) {
3722               uchar_checksum:
3723                 while (len-- > 0) {
3724                     auint = *s++ & 255;
3725                     culong += auint;
3726                 }
3727             }
3728             else {
3729                 EXTEND(SP, len);
3730                 while (len-- > 0) {
3731                     auint = *s++ & 255;
3732                     sv = NEWSV(37, 0);
3733                     sv_setiv(sv, (I32)auint);
3734                     PUSHs(sv_2mortal(sv));
3735                 }
3736             }
3737             break;
3738         case 's':
3739             along = (strend - s) / sizeof(I16);
3740             if (len > along)
3741                 len = along;
3742             if (checksum) {
3743                 while (len-- > 0) {
3744                     Copy(s, &ashort, 1, I16);
3745                     s += sizeof(I16);
3746                     culong += ashort;
3747                 }
3748             }
3749             else {
3750                 EXTEND(SP, len);
3751                 while (len-- > 0) {
3752                     Copy(s, &ashort, 1, I16);
3753                     s += sizeof(I16);
3754                     sv = NEWSV(38, 0);
3755                     sv_setiv(sv, (I32)ashort);
3756                     PUSHs(sv_2mortal(sv));
3757                 }
3758             }
3759             break;
3760         case 'v':
3761         case 'n':
3762         case 'S':
3763             along = (strend - s) / sizeof(U16);
3764             if (len > along)
3765                 len = along;
3766             if (checksum) {
3767                 while (len-- > 0) {
3768                     Copy(s, &aushort, 1, U16);
3769                     s += sizeof(U16);
3770 #ifdef HAS_NTOHS
3771                     if (datumtype == 'n')
3772                         aushort = ntohs(aushort);
3773 #endif
3774 #ifdef HAS_VTOHS
3775                     if (datumtype == 'v')
3776                         aushort = vtohs(aushort);
3777 #endif
3778                     culong += aushort;
3779                 }
3780             }
3781             else {
3782                 EXTEND(SP, len);
3783                 while (len-- > 0) {
3784                     Copy(s, &aushort, 1, U16);
3785                     s += sizeof(U16);
3786                     sv = NEWSV(39, 0);
3787 #ifdef HAS_NTOHS
3788                     if (datumtype == 'n')
3789                         aushort = ntohs(aushort);
3790 #endif
3791 #ifdef HAS_VTOHS
3792                     if (datumtype == 'v')
3793                         aushort = vtohs(aushort);
3794 #endif
3795                     sv_setiv(sv, (I32)aushort);
3796                     PUSHs(sv_2mortal(sv));
3797                 }
3798             }
3799             break;
3800         case 'i':
3801             along = (strend - s) / sizeof(int);
3802             if (len > along)
3803                 len = along;
3804             if (checksum) {
3805                 while (len-- > 0) {
3806                     Copy(s, &aint, 1, int);
3807                     s += sizeof(int);
3808                     if (checksum > 32)
3809                         cdouble += (double)aint;
3810                     else
3811                         culong += aint;
3812                 }
3813             }
3814             else {
3815                 EXTEND(SP, len);
3816                 while (len-- > 0) {
3817                     Copy(s, &aint, 1, int);
3818                     s += sizeof(int);
3819                     sv = NEWSV(40, 0);
3820                     sv_setiv(sv, (I32)aint);
3821                     PUSHs(sv_2mortal(sv));
3822                 }
3823             }
3824             break;
3825         case 'I':
3826             along = (strend - s) / sizeof(unsigned int);
3827             if (len > along)
3828                 len = along;
3829             if (checksum) {
3830                 while (len-- > 0) {
3831                     Copy(s, &auint, 1, unsigned int);
3832                     s += sizeof(unsigned int);
3833                     if (checksum > 32)
3834                         cdouble += (double)auint;
3835                     else
3836                         culong += auint;
3837                 }
3838             }
3839             else {
3840                 EXTEND(SP, len);
3841                 while (len-- > 0) {
3842                     Copy(s, &auint, 1, unsigned int);
3843                     s += sizeof(unsigned int);
3844                     sv = NEWSV(41, 0);
3845                     sv_setiv(sv, (I32)auint);
3846                     PUSHs(sv_2mortal(sv));
3847                 }
3848             }
3849             break;
3850         case 'l':
3851             along = (strend - s) / sizeof(I32);
3852             if (len > along)
3853                 len = along;
3854             if (checksum) {
3855                 while (len-- > 0) {
3856                     Copy(s, &along, 1, I32);
3857                     s += sizeof(I32);
3858                     if (checksum > 32)
3859                         cdouble += (double)along;
3860                     else
3861                         culong += along;
3862                 }
3863             }
3864             else {
3865                 EXTEND(SP, len);
3866                 while (len-- > 0) {
3867                     Copy(s, &along, 1, I32);
3868                     s += sizeof(I32);
3869                     sv = NEWSV(42, 0);
3870                     sv_setiv(sv, (I32)along);
3871                     PUSHs(sv_2mortal(sv));
3872                 }
3873             }
3874             break;
3875         case 'V':
3876         case 'N':
3877         case 'L':
3878             along = (strend - s) / sizeof(U32);
3879             if (len > along)
3880                 len = along;
3881             if (checksum) {
3882                 while (len-- > 0) {
3883                     Copy(s, &aulong, 1, U32);
3884                     s += sizeof(U32);
3885 #ifdef HAS_NTOHL
3886                     if (datumtype == 'N')
3887                         aulong = ntohl(aulong);
3888 #endif
3889 #ifdef HAS_VTOHL
3890                     if (datumtype == 'V')
3891                         aulong = vtohl(aulong);
3892 #endif
3893                     if (checksum > 32)
3894                         cdouble += (double)aulong;
3895                     else
3896                         culong += aulong;
3897                 }
3898             }
3899             else {
3900                 EXTEND(SP, len);
3901                 while (len-- > 0) {
3902                     Copy(s, &aulong, 1, U32);
3903                     s += sizeof(U32);
3904                     sv = NEWSV(43, 0);
3905 #ifdef HAS_NTOHL
3906                     if (datumtype == 'N')
3907                         aulong = ntohl(aulong);
3908 #endif
3909 #ifdef HAS_VTOHL
3910                     if (datumtype == 'V')
3911                         aulong = vtohl(aulong);
3912 #endif
3913                     sv_setnv(sv, (double)aulong);
3914                     PUSHs(sv_2mortal(sv));
3915                 }
3916             }
3917             break;
3918         case 'p':
3919             along = (strend - s) / sizeof(char*);
3920             if (len > along)
3921                 len = along;
3922             EXTEND(SP, len);
3923             while (len-- > 0) {
3924                 if (sizeof(char*) > strend - s)
3925                     break;
3926                 else {
3927                     Copy(s, &aptr, 1, char*);
3928                     s += sizeof(char*);
3929                 }
3930                 sv = NEWSV(44, 0);
3931                 if (aptr)
3932                     sv_setpv(sv, aptr);
3933                 PUSHs(sv_2mortal(sv));
3934             }
3935             break;
3936         case 'P':
3937             EXTEND(SP, 1);
3938             if (sizeof(char*) > strend - s)
3939                 break;
3940             else {
3941                 Copy(s, &aptr, 1, char*);
3942                 s += sizeof(char*);
3943             }
3944             sv = NEWSV(44, 0);
3945             if (aptr)
3946                 sv_setpvn(sv, aptr, len);
3947             PUSHs(sv_2mortal(sv));
3948             break;
3949 #ifdef QUAD
3950         case 'q':
3951             EXTEND(SP, len);
3952             while (len-- > 0) {
3953                 if (s + sizeof(quad) > strend)
3954                     aquad = 0;
3955                 else {
3956                     Copy(s, &aquad, 1, quad);
3957                     s += sizeof(quad);
3958                 }
3959                 sv = NEWSV(42, 0);
3960                 sv_setnv(sv, (double)aquad);
3961                 PUSHs(sv_2mortal(sv));
3962             }
3963             break;
3964         case 'Q':
3965             EXTEND(SP, len);
3966             while (len-- > 0) {
3967                 if (s + sizeof(unsigned quad) > strend)
3968                     auquad = 0;
3969                 else {
3970                     Copy(s, &auquad, 1, unsigned quad);
3971                     s += sizeof(unsigned quad);
3972                 }
3973                 sv = NEWSV(43, 0);
3974                 sv_setnv(sv, (double)auquad);
3975                 PUSHs(sv_2mortal(sv));
3976             }
3977             break;
3978 #endif
3979         /* float and double added gnb@melba.bby.oz.au 22/11/89 */
3980         case 'f':
3981         case 'F':
3982             along = (strend - s) / sizeof(float);
3983             if (len > along)
3984                 len = along;
3985             if (checksum) {
3986                 while (len-- > 0) {
3987                     Copy(s, &afloat, 1, float);
3988                     s += sizeof(float);
3989                     cdouble += afloat;
3990                 }
3991             }
3992             else {
3993                 EXTEND(SP, len);
3994                 while (len-- > 0) {
3995                     Copy(s, &afloat, 1, float);
3996                     s += sizeof(float);
3997                     sv = NEWSV(47, 0);
3998                     sv_setnv(sv, (double)afloat);
3999                     PUSHs(sv_2mortal(sv));
4000                 }
4001             }
4002             break;
4003         case 'd':
4004         case 'D':
4005             along = (strend - s) / sizeof(double);
4006             if (len > along)
4007                 len = along;
4008             if (checksum) {
4009                 while (len-- > 0) {
4010                     Copy(s, &adouble, 1, double);
4011                     s += sizeof(double);
4012                     cdouble += adouble;
4013                 }
4014             }
4015             else {
4016                 EXTEND(SP, len);
4017                 while (len-- > 0) {
4018                     Copy(s, &adouble, 1, double);
4019                     s += sizeof(double);
4020                     sv = NEWSV(48, 0);
4021                     sv_setnv(sv, (double)adouble);
4022                     PUSHs(sv_2mortal(sv));
4023                 }
4024             }
4025             break;
4026         case 'u':
4027             along = (strend - s) * 3 / 4;
4028             sv = NEWSV(42, along);
4029             while (s < strend && *s > ' ' && *s < 'a') {
4030                 I32 a, b, c, d;
4031                 char hunk[4];
4032
4033                 hunk[3] = '\0';
4034                 len = (*s++ - ' ') & 077;
4035                 while (len > 0) {
4036                     if (s < strend && *s >= ' ')
4037                         a = (*s++ - ' ') & 077;
4038                     else
4039                         a = 0;
4040                     if (s < strend && *s >= ' ')
4041                         b = (*s++ - ' ') & 077;
4042                     else
4043                         b = 0;
4044                     if (s < strend && *s >= ' ')
4045                         c = (*s++ - ' ') & 077;
4046                     else
4047                         c = 0;
4048                     if (s < strend && *s >= ' ')
4049                         d = (*s++ - ' ') & 077;
4050                     else
4051                         d = 0;
4052                     hunk[0] = a << 2 | b >> 4;
4053                     hunk[1] = b << 4 | c >> 2;
4054                     hunk[2] = c << 6 | d;
4055                     sv_catpvn(sv, hunk, len > 3 ? 3 : len);
4056                     len -= 3;
4057                 }
4058                 if (*s == '\n')
4059                     s++;
4060                 else if (s[1] == '\n')          /* possible checksum byte */
4061                     s += 2;
4062             }
4063             XPUSHs(sv_2mortal(sv));
4064             break;
4065         }
4066         if (checksum) {
4067             sv = NEWSV(42, 0);
4068             if (strchr("fFdD", datumtype) ||
4069               (checksum > 32 && strchr("iIlLN", datumtype)) ) {
4070                 double modf();
4071                 double trouble;
4072
4073                 adouble = 1.0;
4074                 while (checksum >= 16) {
4075                     checksum -= 16;
4076                     adouble *= 65536.0;
4077                 }
4078                 while (checksum >= 4) {
4079                     checksum -= 4;
4080                     adouble *= 16.0;
4081                 }
4082                 while (checksum--)
4083                     adouble *= 2.0;
4084                 along = (1 << checksum) - 1;
4085                 while (cdouble < 0.0)
4086                     cdouble += adouble;
4087                 cdouble = modf(cdouble / adouble, &trouble) * adouble;
4088                 sv_setnv(sv, cdouble);
4089             }
4090             else {
4091                 if (checksum < 32) {
4092                     along = (1 << checksum) - 1;
4093                     culong &= (U32)along;
4094                 }
4095                 sv_setnv(sv, (double)culong);
4096             }
4097             XPUSHs(sv_2mortal(sv));
4098             checksum = 0;
4099         }
4100     }
4101     RETURN;
4102 }
4103
4104 static void
4105 doencodes(sv, s, len)
4106 register SV *sv;
4107 register char *s;
4108 register I32 len;
4109 {
4110     char hunk[5];
4111
4112     *hunk = len + ' ';
4113     sv_catpvn(sv, hunk, 1);
4114     hunk[4] = '\0';
4115     while (len > 0) {
4116         hunk[0] = ' ' + (077 & (*s >> 2));
4117         hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
4118         hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
4119         hunk[3] = ' ' + (077 & (s[2] & 077));
4120         sv_catpvn(sv, hunk, 4);
4121         s += 3;
4122         len -= 3;
4123     }
4124     for (s = SvPVX(sv); *s; s++) {
4125         if (*s == ' ')
4126             *s = '`';
4127     }
4128     sv_catpvn(sv, "\n", 1);
4129 }
4130
4131 PP(pp_pack)
4132 {
4133     dSP; dMARK; dORIGMARK; dTARGET;
4134     register SV *cat = TARG;
4135     register I32 items;
4136     STRLEN fromlen;
4137     register char *pat = SvPVx(*++MARK, fromlen);
4138     register char *patend = pat + fromlen;
4139     register I32 len;
4140     I32 datumtype;
4141     SV *fromstr;
4142     /*SUPPRESS 442*/
4143     static char null10[] = {0,0,0,0,0,0,0,0,0,0};
4144     static char *space10 = "          ";
4145
4146     /* These must not be in registers: */
4147     char achar;
4148     I16 ashort;
4149     int aint;
4150     unsigned int auint;
4151     I32 along;
4152     U32 aulong;
4153 #ifdef QUAD
4154     quad aquad;
4155     unsigned quad auquad;
4156 #endif
4157     char *aptr;
4158     float afloat;
4159     double adouble;
4160
4161     items = SP - MARK;
4162     MARK++;
4163     sv_setpvn(cat, "", 0);
4164     while (pat < patend) {
4165 #define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
4166         datumtype = *pat++;
4167         if (*pat == '*') {
4168             len = strchr("@Xxu", datumtype) ? 0 : items;
4169             pat++;
4170         }
4171         else if (isDIGIT(*pat)) {
4172             len = *pat++ - '0';
4173             while (isDIGIT(*pat))
4174                 len = (len * 10) + (*pat++ - '0');
4175         }
4176         else
4177             len = 1;
4178         switch(datumtype) {
4179         default:
4180             break;
4181         case '%':
4182             DIE("%% may only be used in unpack");
4183         case '@':
4184             len -= SvCUR(cat);
4185             if (len > 0)
4186                 goto grow;
4187             len = -len;
4188             if (len > 0)
4189                 goto shrink;
4190             break;
4191         case 'X':
4192           shrink:
4193             if (SvCUR(cat) < len)
4194                 DIE("X outside of string");
4195             SvCUR(cat) -= len;
4196             *SvEND(cat) = '\0';
4197             break;
4198         case 'x':
4199           grow:
4200             while (len >= 10) {
4201                 sv_catpvn(cat, null10, 10);
4202                 len -= 10;
4203             }
4204             sv_catpvn(cat, null10, len);
4205             break;
4206         case 'A':
4207         case 'a':
4208             fromstr = NEXTFROM;
4209             aptr = SvPV(fromstr, fromlen);
4210             if (pat[-1] == '*')
4211                 len = fromlen;
4212             if (fromlen > len)
4213                 sv_catpvn(cat, aptr, len);
4214             else {
4215                 sv_catpvn(cat, aptr, fromlen);
4216                 len -= fromlen;
4217                 if (datumtype == 'A') {
4218                     while (len >= 10) {
4219                         sv_catpvn(cat, space10, 10);
4220                         len -= 10;
4221                     }
4222                     sv_catpvn(cat, space10, len);
4223                 }
4224                 else {
4225                     while (len >= 10) {
4226                         sv_catpvn(cat, null10, 10);
4227                         len -= 10;
4228                     }
4229                     sv_catpvn(cat, null10, len);
4230                 }
4231             }
4232             break;
4233         case 'B':
4234         case 'b':
4235             {
4236                 char *savepat = pat;
4237                 I32 saveitems;
4238
4239                 fromstr = NEXTFROM;
4240                 saveitems = items;
4241                 aptr = SvPV(fromstr, fromlen);
4242                 if (pat[-1] == '*')
4243                     len = fromlen;
4244                 pat = aptr;
4245                 aint = SvCUR(cat);
4246                 SvCUR(cat) += (len+7)/8;
4247                 SvGROW(cat, SvCUR(cat) + 1);
4248                 aptr = SvPVX(cat) + aint;
4249                 if (len > fromlen)
4250                     len = fromlen;
4251                 aint = len;
4252                 items = 0;
4253                 if (datumtype == 'B') {
4254                     for (len = 0; len++ < aint;) {
4255                         items |= *pat++ & 1;
4256                         if (len & 7)
4257                             items <<= 1;
4258                         else {
4259                             *aptr++ = items & 0xff;
4260                             items = 0;
4261                         }
4262                     }
4263                 }
4264                 else {
4265                     for (len = 0; len++ < aint;) {
4266                         if (*pat++ & 1)
4267                             items |= 128;
4268                         if (len & 7)
4269                             items >>= 1;
4270                         else {
4271                             *aptr++ = items & 0xff;
4272                             items = 0;
4273                         }
4274                     }
4275                 }
4276                 if (aint & 7) {
4277                     if (datumtype == 'B')
4278                         items <<= 7 - (aint & 7);
4279                     else
4280                         items >>= 7 - (aint & 7);
4281                     *aptr++ = items & 0xff;
4282                 }
4283                 pat = SvPVX(cat) + SvCUR(cat);
4284                 while (aptr <= pat)
4285                     *aptr++ = '\0';
4286
4287                 pat = savepat;
4288                 items = saveitems;
4289             }
4290             break;
4291         case 'H':
4292         case 'h':
4293             {
4294                 char *savepat = pat;
4295                 I32 saveitems;
4296
4297                 fromstr = NEXTFROM;
4298                 saveitems = items;
4299                 aptr = SvPV(fromstr, fromlen);
4300                 if (pat[-1] == '*')
4301                     len = fromlen;
4302                 pat = aptr;
4303                 aint = SvCUR(cat);
4304                 SvCUR(cat) += (len+1)/2;
4305                 SvGROW(cat, SvCUR(cat) + 1);
4306                 aptr = SvPVX(cat) + aint;
4307                 if (len > fromlen)
4308                     len = fromlen;
4309                 aint = len;
4310                 items = 0;
4311                 if (datumtype == 'H') {
4312                     for (len = 0; len++ < aint;) {
4313                         if (isALPHA(*pat))
4314                             items |= ((*pat++ & 15) + 9) & 15;
4315                         else
4316                             items |= *pat++ & 15;
4317                         if (len & 1)
4318                             items <<= 4;
4319                         else {
4320                             *aptr++ = items & 0xff;
4321                             items = 0;
4322                         }
4323                     }
4324                 }
4325                 else {
4326                     for (len = 0; len++ < aint;) {
4327                         if (isALPHA(*pat))
4328                             items |= (((*pat++ & 15) + 9) & 15) << 4;
4329                         else
4330                             items |= (*pat++ & 15) << 4;
4331                         if (len & 1)
4332                             items >>= 4;
4333                         else {
4334                             *aptr++ = items & 0xff;
4335                             items = 0;
4336                         }
4337                     }
4338                 }
4339                 if (aint & 1)
4340                     *aptr++ = items & 0xff;
4341                 pat = SvPVX(cat) + SvCUR(cat);
4342                 while (aptr <= pat)
4343                     *aptr++ = '\0';
4344
4345                 pat = savepat;
4346                 items = saveitems;
4347             }
4348             break;
4349         case 'C':
4350         case 'c':
4351             while (len-- > 0) {
4352                 fromstr = NEXTFROM;
4353                 aint = SvIV(fromstr);
4354                 achar = aint;
4355                 sv_catpvn(cat, &achar, sizeof(char));
4356             }
4357             break;
4358         /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
4359         case 'f':
4360         case 'F':
4361             while (len-- > 0) {
4362                 fromstr = NEXTFROM;
4363                 afloat = (float)SvNV(fromstr);
4364                 sv_catpvn(cat, (char *)&afloat, sizeof (float));
4365             }
4366             break;
4367         case 'd':
4368         case 'D':
4369             while (len-- > 0) {
4370                 fromstr = NEXTFROM;
4371                 adouble = (double)SvNV(fromstr);
4372                 sv_catpvn(cat, (char *)&adouble, sizeof (double));
4373             }
4374             break;
4375         case 'n':
4376             while (len-- > 0) {
4377                 fromstr = NEXTFROM;
4378                 ashort = (I16)SvIV(fromstr);
4379 #ifdef HAS_HTONS
4380                 ashort = htons(ashort);
4381 #endif
4382                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
4383             }
4384             break;
4385         case 'v':
4386             while (len-- > 0) {
4387                 fromstr = NEXTFROM;
4388                 ashort = (I16)SvIV(fromstr);
4389 #ifdef HAS_HTOVS
4390                 ashort = htovs(ashort);
4391 #endif
4392                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
4393             }
4394             break;
4395         case 'S':
4396         case 's':
4397             while (len-- > 0) {
4398                 fromstr = NEXTFROM;
4399                 ashort = (I16)SvIV(fromstr);
4400                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
4401             }
4402             break;
4403         case 'I':
4404             while (len-- > 0) {
4405                 fromstr = NEXTFROM;
4406                 auint = U_I(SvNV(fromstr));
4407                 sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
4408             }
4409             break;
4410         case 'i':
4411             while (len-- > 0) {
4412                 fromstr = NEXTFROM;
4413                 aint = SvIV(fromstr);
4414                 sv_catpvn(cat, (char*)&aint, sizeof(int));
4415             }
4416             break;
4417         case 'N':
4418             while (len-- > 0) {
4419                 fromstr = NEXTFROM;
4420                 aulong = U_L(SvNV(fromstr));
4421 #ifdef HAS_HTONL
4422                 aulong = htonl(aulong);
4423 #endif
4424                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
4425             }
4426             break;
4427         case 'V':
4428             while (len-- > 0) {
4429                 fromstr = NEXTFROM;
4430                 aulong = U_L(SvNV(fromstr));
4431 #ifdef HAS_HTOVL
4432                 aulong = htovl(aulong);
4433 #endif
4434                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
4435             }
4436             break;
4437         case 'L':
4438             while (len-- > 0) {
4439                 fromstr = NEXTFROM;
4440                 aulong = U_L(SvNV(fromstr));
4441                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
4442             }
4443             break;
4444         case 'l':
4445             while (len-- > 0) {
4446                 fromstr = NEXTFROM;
4447                 along = SvIV(fromstr);
4448                 sv_catpvn(cat, (char*)&along, sizeof(I32));
4449             }
4450             break;
4451 #ifdef QUAD
4452         case 'Q':
4453             while (len-- > 0) {
4454                 fromstr = NEXTFROM;
4455                 auquad = (unsigned quad)SvNV(fromstr);
4456                 sv_catpvn(cat, (char*)&auquad, sizeof(unsigned quad));
4457             }
4458             break;
4459         case 'q':
4460             while (len-- > 0) {
4461                 fromstr = NEXTFROM;
4462                 aquad = (quad)SvNV(fromstr);
4463                 sv_catpvn(cat, (char*)&aquad, sizeof(quad));
4464             }
4465             break;
4466 #endif /* QUAD */
4467         case 'P':
4468             len = 1;            /* assume SV is correct length */
4469             /* FALL THROUGH */
4470         case 'p':
4471             while (len-- > 0) {
4472                 fromstr = NEXTFROM;
4473                 aptr = SvPV(fromstr, na);
4474                 sv_catpvn(cat, (char*)&aptr, sizeof(char*));
4475             }
4476             break;
4477         case 'u':
4478             fromstr = NEXTFROM;
4479             aptr = SvPV(fromstr, fromlen);
4480             SvGROW(cat, fromlen * 4 / 3);
4481             if (len <= 1)
4482                 len = 45;
4483             else
4484                 len = len / 3 * 3;
4485             while (fromlen > 0) {
4486                 I32 todo;
4487
4488                 if (fromlen > len)
4489                     todo = len;
4490                 else
4491                     todo = fromlen;
4492                 doencodes(cat, aptr, todo);
4493                 fromlen -= todo;
4494                 aptr += todo;
4495             }
4496             break;
4497         }
4498     }
4499     SvSETMAGIC(cat);
4500     SP = ORIGMARK;
4501     PUSHs(cat);
4502     RETURN;
4503 }
4504 #undef NEXTFROM
4505
4506 PP(pp_split)
4507 {
4508     dSP; dTARG;
4509     AV *ary;
4510     register I32 limit = POPi;                  /* note, negative is forever */
4511     SV *sv = POPs;
4512     STRLEN len;
4513     register char *s = SvPV(sv, len);
4514     char *strend = s + len;
4515     register PMOP *pm = (PMOP*)POPs;
4516     register SV *dstr;
4517     register char *m;
4518     I32 iters = 0;
4519     I32 maxiters = (strend - s) + 10;
4520     I32 i;
4521     char *orig;
4522     I32 origlimit = limit;
4523     I32 realarray = 0;
4524     I32 base;
4525     AV *oldstack;
4526     register REGEXP *rx = pm->op_pmregexp;
4527     I32 gimme = GIMME;
4528
4529     if (!pm || !s)
4530         DIE("panic: do_split");
4531     if (pm->op_pmreplroot)
4532         ary = GvAVn((GV*)pm->op_pmreplroot);
4533     else if (gimme != G_ARRAY)
4534         ary = GvAVn(defgv);
4535     else
4536         ary = Nullav;
4537     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
4538         realarray = 1;
4539         if (!AvREAL(ary)) {
4540             AvREAL_on(ary);
4541             for (i = AvFILL(ary); i >= 0; i--)
4542                 AvARRAY(ary)[i] = Nullsv;       /* don't free mere refs */
4543         }
4544         av_fill(ary,0);         /* force allocation */
4545         av_fill(ary,-1);
4546         /* temporarily switch stacks */
4547         oldstack = stack;
4548         SWITCHSTACK(stack, ary);
4549     }
4550     base = SP - stack_base;
4551     orig = s;
4552     if (pm->op_pmflags & PMf_SKIPWHITE) {
4553         while (isSPACE(*s))
4554             s++;
4555     }
4556     if (!limit)
4557         limit = maxiters + 2;
4558     if (pm->op_pmflags & PMf_WHITE) {
4559         while (--limit) {
4560             /*SUPPRESS 530*/
4561             for (m = s; m < strend && !isSPACE(*m); m++) ;
4562             if (m >= strend)
4563                 break;
4564             dstr = NEWSV(30, m-s);
4565             sv_setpvn(dstr, s, m-s);
4566             if (!realarray)
4567                 sv_2mortal(dstr);
4568             XPUSHs(dstr);
4569             /*SUPPRESS 530*/
4570             for (s = m + 1; s < strend && isSPACE(*s); s++) ;
4571         }
4572     }
4573     else if (strEQ("^", rx->precomp)) {
4574         while (--limit) {
4575             /*SUPPRESS 530*/
4576             for (m = s; m < strend && *m != '\n'; m++) ;
4577             m++;
4578             if (m >= strend)
4579                 break;
4580             dstr = NEWSV(30, m-s);
4581             sv_setpvn(dstr, s, m-s);
4582             if (!realarray)
4583                 sv_2mortal(dstr);
4584             XPUSHs(dstr);
4585             s = m;
4586         }
4587     }
4588     else if (pm->op_pmshort) {
4589         i = SvCUR(pm->op_pmshort);
4590         if (i == 1) {
4591             I32 fold = (pm->op_pmflags & PMf_FOLD);
4592             i = *SvPVX(pm->op_pmshort);
4593             if (fold && isUPPER(i))
4594                 i = tolower(i);
4595             while (--limit) {
4596                 if (fold) {
4597                     for ( m = s;
4598                           m < strend && *m != i &&
4599                             (!isUPPER(*m) || tolower(*m) != i);
4600                           m++)                  /*SUPPRESS 530*/
4601                         ;
4602                 }
4603                 else                            /*SUPPRESS 530*/
4604                     for (m = s; m < strend && *m != i; m++) ;
4605                 if (m >= strend)
4606                     break;
4607                 dstr = NEWSV(30, m-s);
4608                 sv_setpvn(dstr, s, m-s);
4609                 if (!realarray)
4610                     sv_2mortal(dstr);
4611                 XPUSHs(dstr);
4612                 s = m + 1;
4613             }
4614         }
4615         else {
4616 #ifndef lint
4617             while (s < strend && --limit &&
4618               (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
4619                     pm->op_pmshort)) )
4620 #endif
4621             {
4622                 dstr = NEWSV(31, m-s);
4623                 sv_setpvn(dstr, s, m-s);
4624                 if (!realarray)
4625                     sv_2mortal(dstr);
4626                 XPUSHs(dstr);
4627                 s = m + i;
4628             }
4629         }
4630     }
4631     else {
4632         maxiters += (strend - s) * rx->nparens;
4633         while (s < strend && --limit &&
4634             regexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
4635             if (rx->subbase
4636               && rx->subbase != orig) {
4637                 m = s;
4638                 s = orig;
4639                 orig = rx->subbase;
4640                 s = orig + (m - s);
4641                 strend = s + (strend - m);
4642             }
4643             m = rx->startp[0];
4644             dstr = NEWSV(32, m-s);
4645             sv_setpvn(dstr, s, m-s);
4646             if (!realarray)
4647                 sv_2mortal(dstr);
4648             XPUSHs(dstr);
4649             if (rx->nparens) {
4650                 for (i = 1; i <= rx->nparens; i++) {
4651                     s = rx->startp[i];
4652                     m = rx->endp[i];
4653                     dstr = NEWSV(33, m-s);
4654                     sv_setpvn(dstr, s, m-s);
4655                     if (!realarray)
4656                         sv_2mortal(dstr);
4657                     XPUSHs(dstr);
4658                 }
4659             }
4660             s = rx->endp[0];
4661         }
4662     }
4663     iters = (SP - stack_base) - base;
4664     if (iters > maxiters)
4665         DIE("Split loop");
4666     if (s < strend || origlimit) {      /* keep field after final delim? */
4667         dstr = NEWSV(34, strend-s);
4668         sv_setpvn(dstr, s, strend-s);
4669         if (!realarray)
4670             sv_2mortal(dstr);
4671         XPUSHs(dstr);
4672         iters++;
4673     }
4674     else {
4675         while (iters > 0 && SvCUR(TOPs) == 0)
4676             iters--, SP--;
4677     }
4678     if (realarray) {
4679         SWITCHSTACK(ary, oldstack);
4680         if (gimme == G_ARRAY) {
4681             EXTEND(SP, iters);
4682             Copy(AvARRAY(ary), SP + 1, iters, SV*);
4683             SP += iters;
4684             RETURN;
4685         }
4686     }
4687     else {
4688         if (gimme == G_ARRAY)
4689             RETURN;
4690     }
4691     GETTARGET;
4692     PUSHi(iters);
4693     RETURN;
4694 }
4695
4696 PP(pp_join)
4697 {
4698     dSP; dMARK; dTARGET;
4699     MARK++;
4700     do_join(TARG, *MARK, MARK, SP);
4701     SP = MARK;
4702     SETs(TARG);
4703     RETURN;
4704 }
4705
4706 /* List operators. */
4707
4708 PP(pp_list)
4709 {
4710     dSP; dMARK;
4711     if (GIMME != G_ARRAY) {
4712         if (++MARK <= SP)
4713             *MARK = *SP;                /* unwanted list, return last item */
4714         else
4715             *MARK = &sv_undef;
4716         SP = MARK;
4717     }
4718     RETURN;
4719 }
4720
4721 PP(pp_lslice)
4722 {
4723     dSP;
4724     SV **lastrelem = stack_sp;
4725     SV **lastlelem = stack_base + POPMARK;
4726     SV **firstlelem = stack_base + POPMARK + 1;
4727     register SV **firstrelem = lastlelem + 1;
4728     I32 lval = op->op_flags & OPf_LVAL;
4729     I32 is_something_there = lval;
4730
4731     register I32 max = lastrelem - lastlelem;
4732     register SV **lelem;
4733     register I32 ix;
4734
4735     if (GIMME != G_ARRAY) {
4736         ix = SvIVx(*lastlelem) - arybase;
4737         if (ix < 0 || ix >= max)
4738             *firstlelem = &sv_undef;
4739         else
4740             *firstlelem = firstrelem[ix];
4741         SP = firstlelem;
4742         RETURN;
4743     }
4744
4745     if (max == 0) {
4746         SP = firstlelem - 1;
4747         RETURN;
4748     }
4749
4750     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
4751         ix = SvIVx(*lelem) - arybase;
4752         if (ix < 0) {
4753             ix += max;
4754             if (ix < 0)
4755                 *lelem = &sv_undef;
4756             else if (!(*lelem = firstrelem[ix]))
4757                 *lelem = &sv_undef;
4758         }
4759         else if (ix >= max || !(*lelem = firstrelem[ix]))
4760             *lelem = &sv_undef;
4761         if (!is_something_there && SvOK(*lelem))
4762             is_something_there = TRUE;
4763     }
4764     if (is_something_there)
4765         SP = lastlelem;
4766     else
4767         SP = firstlelem - 1;
4768     RETURN;
4769 }
4770
4771 PP(pp_anonlist)
4772 {
4773     dSP; dMARK;
4774     I32 items = SP - MARK;
4775     SP = MARK;
4776     XPUSHs((SV*)av_make(items, MARK+1));
4777     RETURN;
4778 }
4779
4780 PP(pp_anonhash)
4781 {
4782     dSP; dMARK; dORIGMARK;
4783     STRLEN len;
4784     HV* hv = newHV();
4785
4786     SvREFCNT(hv) = 0;
4787     while (MARK < SP) {
4788         SV* key = *++MARK;
4789         char *tmps;
4790         SV *val = NEWSV(46, 0);
4791         if (MARK < SP)
4792             sv_setsv(val, *++MARK);
4793         tmps = SvPV(key,len);
4794         (void)hv_store(hv,tmps,len,val,0);
4795     }
4796     SP = ORIGMARK;
4797     SvOK_on(hv);
4798     XPUSHs((SV*)hv);
4799     RETURN;
4800 }
4801
4802 PP(pp_splice)
4803 {
4804     dSP; dMARK; dORIGMARK;
4805     register AV *ary = (AV*)*++MARK;
4806     register SV **src;
4807     register SV **dst;
4808     register I32 i;
4809     register I32 offset;
4810     register I32 length;
4811     I32 newlen;
4812     I32 after;
4813     I32 diff;
4814     SV **tmparyval;
4815
4816     SP++;
4817
4818     if (++MARK < SP) {
4819         offset = SvIVx(*MARK);
4820         if (offset < 0)
4821             offset += AvFILL(ary) + 1;
4822         else
4823             offset -= arybase;
4824         if (++MARK < SP) {
4825             length = SvIVx(*MARK++);
4826             if (length < 0)
4827                 length = 0;
4828         }
4829         else
4830             length = AvMAX(ary) + 1;            /* close enough to infinity */
4831     }
4832     else {
4833         offset = 0;
4834         length = AvMAX(ary) + 1;
4835     }
4836     if (offset < 0) {
4837         length += offset;
4838         offset = 0;
4839         if (length < 0)
4840             length = 0;
4841     }
4842     if (offset > AvFILL(ary) + 1)
4843         offset = AvFILL(ary) + 1;
4844     after = AvFILL(ary) + 1 - (offset + length);
4845     if (after < 0) {                            /* not that much array */
4846         length += after;                        /* offset+length now in array */
4847         after = 0;
4848         if (!AvALLOC(ary)) {
4849             av_fill(ary, 0);
4850             av_fill(ary, -1);
4851         }
4852     }
4853
4854     /* At this point, MARK .. SP-1 is our new LIST */
4855
4856     newlen = SP - MARK;
4857     diff = newlen - length;
4858
4859     if (diff < 0) {                             /* shrinking the area */
4860         if (newlen) {
4861             New(451, tmparyval, newlen, SV*);   /* so remember insertion */
4862             Copy(MARK, tmparyval, newlen, SV*);
4863         }
4864
4865         MARK = ORIGMARK + 1;
4866         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
4867             MEXTEND(MARK, length);
4868             Copy(AvARRAY(ary)+offset, MARK, length, SV*);
4869             if (AvREAL(ary)) {
4870                 for (i = length, dst = MARK; i; i--)
4871                     sv_2mortal(*dst++); /* free them eventualy */
4872             }
4873             MARK += length - 1;
4874         }
4875         else {
4876             *MARK = AvARRAY(ary)[offset+length-1];
4877             if (AvREAL(ary)) {
4878                 sv_2mortal(*MARK);
4879                 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
4880                     SvREFCNT_dec(*dst++);       /* free them now */
4881             }
4882         }
4883         AvFILL(ary) += diff;
4884
4885         /* pull up or down? */
4886
4887         if (offset < after) {                   /* easier to pull up */
4888             if (offset) {                       /* esp. if nothing to pull */
4889                 src = &AvARRAY(ary)[offset-1];
4890                 dst = src - diff;               /* diff is negative */
4891                 for (i = offset; i > 0; i--)    /* can't trust Copy */
4892                     *dst-- = *src--;
4893             }
4894             Zero(AvARRAY(ary), -diff, SV*);
4895             SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
4896             AvMAX(ary) += diff;
4897         }
4898         else {
4899             if (after) {                        /* anything to pull down? */
4900                 src = AvARRAY(ary) + offset + length;
4901                 dst = src + diff;               /* diff is negative */
4902                 Move(src, dst, after, SV*);
4903             }
4904             Zero(&AvARRAY(ary)[AvFILL(ary)+1], -diff, SV*);
4905                                                 /* avoid later double free */
4906         }
4907         if (newlen) {
4908             for (src = tmparyval, dst = AvARRAY(ary) + offset;
4909               newlen; newlen--) {
4910                 *dst = NEWSV(46, 0);
4911                 sv_setsv(*dst++, *src++);
4912             }
4913             Safefree(tmparyval);
4914         }
4915     }
4916     else {                                      /* no, expanding (or same) */
4917         if (length) {
4918             New(452, tmparyval, length, SV*);   /* so remember deletion */
4919             Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
4920         }
4921
4922         if (diff > 0) {                         /* expanding */
4923
4924             /* push up or down? */
4925
4926             if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
4927                 if (offset) {
4928                     src = AvARRAY(ary);
4929                     dst = src - diff;
4930                     Move(src, dst, offset, SV*);
4931                 }
4932                 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
4933                 AvMAX(ary) += diff;
4934                 AvFILL(ary) += diff;
4935             }
4936             else {
4937                 if (AvFILL(ary) + diff >= AvMAX(ary))   /* oh, well */
4938                     av_store(ary, AvFILL(ary) + diff, Nullsv);
4939                 else
4940                     AvFILL(ary) += diff;
4941                 dst = AvARRAY(ary) + AvFILL(ary);
4942                 for (i = diff; i > 0; i--) {
4943                     if (*dst)                   /* stuff was hanging around */
4944                         SvREFCNT_dec(*dst);             /*  after $#foo */
4945                     dst--;
4946                 }
4947                 if (after) {
4948                     dst = AvARRAY(ary) + AvFILL(ary);
4949                     src = dst - diff;
4950                     for (i = after; i; i--) {
4951                         *dst-- = *src--;
4952                     }
4953                 }
4954             }
4955         }
4956
4957         for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
4958             *dst = NEWSV(46, 0);
4959             sv_setsv(*dst++, *src++);
4960         }
4961         MARK = ORIGMARK + 1;
4962         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
4963             if (length) {
4964                 Copy(tmparyval, MARK, length, SV*);
4965                 if (AvREAL(ary)) {
4966                     for (i = length, dst = MARK; i; i--)
4967                         sv_2mortal(*dst++);     /* free them eventualy */
4968                 }
4969                 Safefree(tmparyval);
4970             }
4971             MARK += length - 1;
4972         }
4973         else if (length--) {
4974             *MARK = tmparyval[length];
4975             if (AvREAL(ary)) {
4976                 sv_2mortal(*MARK);
4977                 while (length-- > 0)
4978                     SvREFCNT_dec(tmparyval[length]);
4979             }
4980             Safefree(tmparyval);
4981         }
4982         else
4983             *MARK = &sv_undef;
4984     }
4985     SP = MARK;
4986     RETURN;
4987 }
4988
4989 PP(pp_push)
4990 {
4991     dSP; dMARK; dORIGMARK; dTARGET;
4992     register AV *ary = (AV*)*++MARK;
4993     register SV *sv = &sv_undef;
4994
4995     for (++MARK; MARK <= SP; MARK++) {
4996         sv = NEWSV(51, 0);
4997         if (*MARK)
4998             sv_setsv(sv, *MARK);
4999         (void)av_push(ary, sv);
5000     }
5001     SP = ORIGMARK;
5002     PUSHi( AvFILL(ary) + 1 );
5003     RETURN;
5004 }
5005
5006 PP(pp_pop)
5007 {
5008     dSP;
5009     AV *av = (AV*)POPs;
5010     SV *sv = av_pop(av);
5011     if (!sv)
5012         RETPUSHUNDEF;
5013     if (AvREAL(av))
5014         (void)sv_2mortal(sv);
5015     PUSHs(sv);
5016     RETURN;
5017 }
5018
5019 PP(pp_shift)
5020 {
5021     dSP;
5022     AV *av = (AV*)POPs;
5023     SV *sv = av_shift(av);
5024     EXTEND(SP, 1);
5025     if (!sv)
5026         RETPUSHUNDEF;
5027     if (AvREAL(av))
5028         (void)sv_2mortal(sv);
5029     PUSHs(sv);
5030     RETURN;
5031 }
5032
5033 PP(pp_unshift)
5034 {
5035     dSP; dMARK; dORIGMARK; dTARGET;
5036     register AV *ary = (AV*)*++MARK;
5037     register SV *sv;
5038     register I32 i = 0;
5039
5040     av_unshift(ary, SP - MARK);
5041     while (MARK < SP) {
5042         sv = NEWSV(27, 0);
5043         sv_setsv(sv, *++MARK);
5044         (void)av_store(ary, i++, sv);
5045     }
5046
5047     SP = ORIGMARK;
5048     PUSHi( AvFILL(ary) + 1 );
5049     RETURN;
5050 }
5051
5052 PP(pp_grepstart)
5053 {
5054     dSP;
5055     SV *src;
5056
5057     if (stack_base + *markstack_ptr == sp) {
5058         POPMARK;
5059         RETURNOP(op->op_next->op_next);
5060     }
5061     stack_sp = stack_base + *markstack_ptr + 1;
5062     pp_pushmark();                              /* push dst */
5063     pp_pushmark();                              /* push src */
5064     ENTER;                                      /* enter outer scope */
5065
5066     SAVETMPS;
5067     SAVESPTR(GvSV(defgv));
5068
5069     ENTER;                                      /* enter inner scope */
5070     SAVESPTR(curpm);
5071
5072     if (src = stack_base[*markstack_ptr]) {
5073         SvTEMP_off(src);
5074         GvSV(defgv) = src;
5075     }
5076     else
5077         GvSV(defgv) = sv_newmortal();
5078
5079     RETURNOP(((LOGOP*)op->op_next)->op_other);
5080 }
5081
5082 PP(pp_grepwhile)
5083 {
5084     dSP;
5085
5086     if (SvTRUEx(POPs))
5087         stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
5088     ++*markstack_ptr;
5089     LEAVE;                                      /* exit inner scope */
5090
5091     /* All done yet? */
5092     if (stack_base + *markstack_ptr > sp) {
5093         I32 items;
5094
5095         LEAVE;                                  /* exit outer scope */
5096         POPMARK;                                /* pop src */
5097         items = --*markstack_ptr - markstack_ptr[-1];
5098         POPMARK;                                /* pop dst */
5099         SP = stack_base + POPMARK;              /* pop original mark */
5100         if (GIMME != G_ARRAY) {
5101             dTARGET;
5102             XPUSHi(items);
5103             RETURN;
5104         }
5105         SP += items;
5106         RETURN;
5107     }
5108     else {
5109         SV *src;
5110
5111         ENTER;                                  /* enter inner scope */
5112         SAVESPTR(curpm);
5113
5114         if (src = stack_base[*markstack_ptr]) {
5115             SvTEMP_off(src);
5116             GvSV(defgv) = src;
5117         }
5118         else
5119             GvSV(defgv) = sv_newmortal();
5120
5121         RETURNOP(cLOGOP->op_other);
5122     }
5123 }
5124
5125 static int sortcmp();
5126 static int sortcv();
5127
5128 PP(pp_sort)
5129 {
5130     dSP; dMARK; dORIGMARK;
5131     register SV **up;
5132     SV **myorigmark = ORIGMARK;
5133     register I32 max;
5134     register I32 i;
5135     HV *stash;
5136     SV *sortcvvar;
5137     GV *gv;
5138     CV *cv;
5139
5140     if (GIMME != G_ARRAY) {
5141         SP = MARK;
5142         RETPUSHUNDEF;
5143     }
5144
5145     if (op->op_flags & OPf_STACKED) {
5146         ENTER;
5147         if (op->op_flags & OPf_SPECIAL) {
5148             OP *kid = cLISTOP->op_first->op_sibling;    /* pass pushmark */
5149             kid = kUNOP->op_first;                      /* pass rv2gv */
5150             kid = kUNOP->op_first;                      /* pass leave */
5151             sortcop = kid->op_next;
5152             stash = curcop->cop_stash;
5153         }
5154         else {
5155             cv = sv_2cv(*++MARK, &stash, &gv, 0);
5156             if (!(cv && CvROOT(cv))) {
5157                 if (gv) {
5158                     SV *tmpstr = sv_newmortal();
5159                     gv_efullname(tmpstr, gv);
5160                     if (CvUSERSUB(cv))
5161                         DIE("Usersub \"%s\" called in sort", SvPVX(tmpstr));
5162                     DIE("Undefined sort subroutine \"%s\" called",
5163                         SvPVX(tmpstr));
5164                 }
5165                 if (cv) {
5166                     if (CvUSERSUB(cv))
5167                         DIE("Usersub called in sort");
5168                     DIE("Undefined subroutine in sort");
5169                 }
5170                 DIE("Not a subroutine reference in sort");
5171             }
5172             sortcop = CvSTART(cv);
5173             SAVESPTR(CvROOT(cv)->op_ppaddr);
5174             CvROOT(cv)->op_ppaddr = ppaddr[OP_NULL];
5175
5176             SAVESPTR(curpad);
5177             curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
5178         }
5179     }
5180     else {
5181         sortcop = Nullop;
5182         stash = curcop->cop_stash;
5183     }
5184
5185     up = myorigmark + 1;
5186     while (MARK < SP) { /* This may or may not shift down one here. */
5187         /*SUPPRESS 560*/
5188         if (*up = *++MARK) {                    /* Weed out nulls. */
5189             if (!SvPOK(*up))
5190                 (void)sv_2pv(*up, &na);
5191             else
5192                 SvTEMP_off(*up);
5193             up++;
5194         }
5195     }
5196     max = --up - myorigmark;
5197     if (max > 1) {
5198         if (sortcop) {
5199             AV *oldstack;
5200
5201             SAVETMPS;
5202             SAVESPTR(op);
5203
5204             oldstack = stack;
5205             if (!sortstack) {
5206                 sortstack = newAV();
5207                 av_store(sortstack, 32, Nullsv);
5208                 av_clear(sortstack);
5209                 AvREAL_off(sortstack);
5210             }
5211             SWITCHSTACK(stack, sortstack);
5212             if (sortstash != stash) {
5213                 firstgv = gv_fetchpv("a", TRUE, SVt_PV);
5214                 secondgv = gv_fetchpv("b", TRUE, SVt_PV);
5215                 sortstash = stash;
5216             }
5217
5218             SAVESPTR(GvSV(firstgv));
5219             SAVESPTR(GvSV(secondgv));
5220
5221             qsort((char*)(myorigmark+1), max, sizeof(SV*), sortcv);
5222
5223             SWITCHSTACK(sortstack, oldstack);
5224
5225             LEAVE;
5226         }
5227         else {
5228             MEXTEND(SP, 20);    /* Can't afford stack realloc on signal. */
5229             qsort((char*)(ORIGMARK+1), max, sizeof(SV*), sortcmp);
5230         }
5231     }
5232     SP = ORIGMARK + max;
5233     RETURN;
5234 }
5235
5236 PP(pp_reverse)
5237 {
5238     dSP; dMARK;
5239     register SV *tmp;
5240     SV **oldsp = SP;
5241
5242     if (GIMME == G_ARRAY) {
5243         MARK++;
5244         while (MARK < SP) {
5245             tmp = *MARK;
5246             *MARK++ = *SP;
5247             *SP-- = tmp;
5248         }
5249         SP = oldsp;
5250     }
5251     else {
5252         register char *up;
5253         register char *down;
5254         register I32 tmp;
5255         dTARGET;
5256         STRLEN len;
5257
5258         if (SP - MARK > 1)
5259             do_join(TARG, &sv_no, MARK, SP);
5260         else
5261             sv_setsv(TARG, *SP);
5262         up = SvPV(TARG, len);
5263         if (len > 1) {
5264             down = SvPVX(TARG) + len - 1;
5265             while (down > up) {
5266                 tmp = *up;
5267                 *up++ = *down;
5268                 *down-- = tmp;
5269             }
5270             SvPOK_only(TARG);
5271         }
5272         SP = MARK + 1;
5273         SETTARG;
5274     }
5275     RETURN;
5276 }
5277
5278 /* Range stuff. */
5279
5280 PP(pp_range)
5281 {
5282     if (GIMME == G_ARRAY)
5283         return cCONDOP->op_true;
5284     return SvTRUEx(PAD_SV(op->op_targ)) ? cCONDOP->op_false : cCONDOP->op_true;
5285 }
5286
5287 PP(pp_flip)
5288 {
5289     dSP;
5290
5291     if (GIMME == G_ARRAY) {
5292         RETURNOP(((CONDOP*)cUNOP->op_first)->op_false);
5293     }
5294     else {
5295         dTOPss;
5296         SV *targ = PAD_SV(op->op_targ);
5297
5298         if ((op->op_private & OPpFLIP_LINENUM)
5299           ? last_in_gv && SvIV(sv) == IoLINES(GvIO(last_in_gv))
5300           : SvTRUE(sv) ) {
5301             sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1);
5302             if (op->op_flags & OPf_SPECIAL) {
5303                 sv_setiv(targ, 1);
5304                 RETURN;
5305             }
5306             else {
5307                 sv_setiv(targ, 0);
5308                 sp--;
5309                 RETURNOP(((CONDOP*)cUNOP->op_first)->op_false);
5310             }
5311         }
5312         sv_setpv(TARG, "");
5313         SETs(targ);
5314         RETURN;
5315     }
5316 }
5317
5318 PP(pp_flop)
5319 {
5320     dSP;
5321
5322     if (GIMME == G_ARRAY) {
5323         dPOPPOPssrl;
5324         register I32 i;
5325         register SV *sv;
5326         I32 max;
5327
5328         if (SvNIOK(lstr) || !SvPOK(lstr) ||
5329           (looks_like_number(lstr) && *SvPVX(lstr) != '0') ) {
5330             i = SvIV(lstr);
5331             max = SvIV(rstr);
5332             if (max > i)
5333                 EXTEND(SP, max - i + 1);
5334             while (i <= max) {
5335                 sv = sv_mortalcopy(&sv_no);
5336                 sv_setiv(sv,i++);
5337                 PUSHs(sv);
5338             }
5339         }
5340         else {
5341             SV *final = sv_mortalcopy(rstr);
5342             STRLEN len;
5343             char *tmps = SvPV(final, len);
5344
5345             sv = sv_mortalcopy(lstr);
5346             while (!SvNIOK(sv) && SvCUR(sv) <= len &&
5347                 strNE(SvPVX(sv),tmps) ) {
5348                 XPUSHs(sv);
5349                 sv = sv_2mortal(newSVsv(sv));
5350                 sv_inc(sv);
5351             }
5352             if (strEQ(SvPVX(sv),tmps))
5353                 XPUSHs(sv);
5354         }
5355     }
5356     else {
5357         dTOPss;
5358         SV *targ = PAD_SV(cUNOP->op_first->op_targ);
5359         sv_inc(targ);
5360         if ((op->op_private & OPpFLIP_LINENUM)
5361           ? last_in_gv && SvIV(sv) == IoLINES(GvIO(last_in_gv))
5362           : SvTRUE(sv) ) {
5363             sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0);
5364             sv_catpv(targ, "E0");
5365         }
5366         SETs(targ);
5367     }
5368
5369     RETURN;
5370 }
5371
5372 /* Control. */
5373
5374 static I32
5375 dopoptolabel(label)
5376 char *label;
5377 {
5378     register I32 i;
5379     register CONTEXT *cx;
5380
5381     for (i = cxstack_ix; i >= 0; i--) {
5382         cx = &cxstack[i];
5383         switch (cx->cx_type) {
5384         case CXt_SUBST:
5385             if (dowarn)
5386                 warn("Exiting substitution via %s", op_name[op->op_type]);
5387             break;
5388         case CXt_SUB:
5389             if (dowarn)
5390                 warn("Exiting subroutine via %s", op_name[op->op_type]);
5391             break;
5392         case CXt_EVAL:
5393             if (dowarn)
5394                 warn("Exiting eval via %s", op_name[op->op_type]);
5395             break;
5396         case CXt_LOOP:
5397             if (!cx->blk_loop.label ||
5398               strNE(label, cx->blk_loop.label) ) {
5399                 DEBUG_l(deb("(Skipping label #%d %s)\n",
5400                         i, cx->blk_loop.label));
5401                 continue;
5402             }
5403             DEBUG_l( deb("(Found label #%d %s)\n", i, label));
5404             return i;
5405         }
5406     }
5407 }
5408
5409 static I32
5410 dopoptosub(startingblock)
5411 I32 startingblock;
5412 {
5413     I32 i;
5414     register CONTEXT *cx;
5415     for (i = startingblock; i >= 0; i--) {
5416         cx = &cxstack[i];
5417         switch (cx->cx_type) {
5418         default:
5419             continue;
5420         case CXt_EVAL:
5421         case CXt_SUB:
5422             DEBUG_l( deb("(Found sub #%d)\n", i));
5423             return i;
5424         }
5425     }
5426     return i;
5427 }
5428
5429 I32
5430 dopoptoeval(startingblock)
5431 I32 startingblock;
5432 {
5433     I32 i;
5434     register CONTEXT *cx;
5435     for (i = startingblock; i >= 0; i--) {
5436         cx = &cxstack[i];
5437         switch (cx->cx_type) {
5438         default:
5439             continue;
5440         case CXt_EVAL:
5441             DEBUG_l( deb("(Found eval #%d)\n", i));
5442             return i;
5443         }
5444     }
5445     return i;
5446 }
5447
5448 static I32
5449 dopoptoloop(startingblock)
5450 I32 startingblock;
5451 {
5452     I32 i;
5453     register CONTEXT *cx;
5454     for (i = startingblock; i >= 0; i--) {
5455         cx = &cxstack[i];
5456         switch (cx->cx_type) {
5457         case CXt_SUBST:
5458             if (dowarn)
5459                 warn("Exiting substitition via %s", op_name[op->op_type]);
5460             break;
5461         case CXt_SUB:
5462             if (dowarn)
5463                 warn("Exiting subroutine via %s", op_name[op->op_type]);
5464             break;
5465         case CXt_EVAL:
5466             if (dowarn)
5467                 warn("Exiting eval via %s", op_name[op->op_type]);
5468             break;
5469         case CXt_LOOP:
5470             DEBUG_l( deb("(Found loop #%d)\n", i));
5471             return i;
5472         }
5473     }
5474     return i;
5475 }
5476
5477 static void
5478 dounwind(cxix)
5479 I32 cxix;
5480 {
5481     register CONTEXT *cx;
5482     SV **newsp;
5483     I32 optype;
5484
5485     while (cxstack_ix > cxix) {
5486         cx = &cxstack[cxstack_ix--];
5487         DEBUG_l(fprintf(stderr, "Unwinding block %d, type %s\n", cxstack_ix+1,
5488                     block_type[cx->cx_type]));
5489         /* Note: we don't need to restore the base context info till the end. */
5490         switch (cx->cx_type) {
5491         case CXt_SUB:
5492             POPSUB(cx);
5493             break;
5494         case CXt_EVAL:
5495             POPEVAL(cx);
5496             break;
5497         case CXt_LOOP:
5498             POPLOOP(cx);
5499             break;
5500         case CXt_SUBST:
5501             break;
5502         }
5503     }
5504 }
5505
5506 #ifdef STANDARD_C
5507 OP *
5508 die(char* pat, ...)
5509 #else
5510 /*VARARGS0*/
5511 OP *
5512 die(pat, va_alist)
5513     char *pat;
5514     va_dcl
5515 #endif
5516 {
5517     va_list args;
5518     char *tmps;
5519     char *message;
5520     OP *retop;
5521
5522 #ifdef STANDARD_C
5523     va_start(args, pat);
5524 #else
5525     va_start(args);
5526 #endif
5527     message = mess(pat, &args);
5528     va_end(args);
5529     restartop = die_where(message);
5530     if (stack != mainstack)
5531         longjmp(top_env, 3);
5532     return restartop;
5533 }
5534
5535 OP *
5536 die_where(message)
5537 char *message;
5538 {
5539     if (in_eval) {
5540         I32 cxix;
5541         register CONTEXT *cx;
5542         I32 gimme;
5543         SV **newsp;
5544
5545         sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),message);
5546         cxix = dopoptoeval(cxstack_ix);
5547         if (cxix >= 0) {
5548             I32 optype;
5549
5550             if (cxix < cxstack_ix)
5551                 dounwind(cxix);
5552
5553             POPBLOCK(cx);
5554             if (cx->cx_type != CXt_EVAL) {
5555                 fprintf(stderr, "panic: die %s", message);
5556                 my_exit(1);
5557             }
5558             POPEVAL(cx);
5559
5560             if (gimme == G_SCALAR)
5561                 *++newsp = &sv_undef;
5562             stack_sp = newsp;
5563
5564             LEAVE;
5565             if (optype == OP_REQUIRE)
5566                 DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
5567             return pop_return();
5568         }
5569     }
5570     fputs(message, stderr);
5571     (void)fflush(stderr);
5572     if (e_fp)
5573         (void)UNLINK(e_tmpname);
5574     statusvalue >>= 8;
5575     my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
5576     return 0;
5577 }
5578
5579 PP(pp_and)
5580 {
5581     dSP;
5582     if (!SvTRUE(TOPs))
5583         RETURN;
5584     else {
5585         --SP;
5586         RETURNOP(cLOGOP->op_other);
5587     }
5588 }
5589
5590 PP(pp_or)
5591 {
5592     dSP;
5593     if (SvTRUE(TOPs))
5594         RETURN;
5595     else {
5596         --SP;
5597         RETURNOP(cLOGOP->op_other);
5598     }
5599 }
5600
5601 PP(pp_cond_expr)
5602 {
5603     dSP;
5604     if (SvTRUEx(POPs))
5605         RETURNOP(cCONDOP->op_true);
5606     else
5607         RETURNOP(cCONDOP->op_false);
5608 }
5609
5610 PP(pp_andassign)
5611 {
5612     dSP;
5613     if (!SvTRUE(TOPs))
5614         RETURN;
5615     else
5616         RETURNOP(cLOGOP->op_other);
5617 }
5618
5619 PP(pp_orassign)
5620 {
5621     dSP;
5622     if (SvTRUE(TOPs))
5623         RETURN;
5624     else
5625         RETURNOP(cLOGOP->op_other);
5626 }
5627
5628 PP(pp_method)
5629 {
5630     dSP; dPOPss;
5631     SV* ob;
5632     GV* gv;
5633
5634     EXTEND(sp,2);
5635
5636     gv = 0;
5637     if (SvROK(sv))
5638         ob = SvRV(sv);
5639     else {
5640         GV* iogv;
5641         IO* io;
5642
5643         if (!SvOK(sv) ||
5644             !(iogv = gv_fetchpv(SvPVX(sv), FALSE, SVt_PVIO)) ||
5645             !(ob=(SV*)GvIO(iogv)))
5646         {
5647             char *name = SvPVX(((SVOP*)cLOGOP->op_other)->op_sv);
5648             char tmpbuf[256];
5649             char* packname = SvPV(sv, na);
5650             HV *stash;
5651             if (!isALPHA(*packname))
5652 DIE("Can't call method \"%s\" without a package or object reference", name);
5653             if (!(stash = fetch_stash(sv, FALSE)))
5654                 DIE("Can't call method \"%s\" in empty package \"%s\"",
5655                     name, packname);
5656             gv = gv_fetchmethod(stash,name);
5657             if (!gv)
5658                 DIE("Can't locate object method \"%s\" via package \"%s\"",
5659                     name, packname);
5660             PUSHs(gv);
5661             PUSHs(sv);
5662             RETURN;
5663         }
5664     }
5665
5666     if (!ob || !SvOBJECT(ob)) {
5667         char *name = SvPVX(((SVOP*)cLOGOP->op_other)->op_sv);
5668         DIE("Can't call method \"%s\" on unblessed reference", name);
5669     }
5670
5671     if (!gv) {          /* nothing cached */
5672         char *name = SvPVX(((SVOP*)cLOGOP->op_other)->op_sv);
5673         gv = gv_fetchmethod(SvSTASH(ob),name);
5674         if (!gv)
5675             DIE("Can't locate object method \"%s\" via package \"%s\"",
5676                 name, HvNAME(SvSTASH(ob)));
5677     }
5678
5679     PUSHs(gv);
5680     PUSHs(sv);
5681     RETURN;
5682 }
5683
5684 PP(pp_entersubr)
5685 {
5686     dSP; dMARK;
5687     SV *sv = *++MARK;
5688     GV *gv;
5689     HV *stash;
5690     register CV *cv;
5691     register I32 items = SP - MARK;
5692     I32 hasargs = (op->op_flags & OPf_STACKED) != 0;
5693     register CONTEXT *cx;
5694
5695     if (!sv)
5696         DIE("Not a subroutine reference");
5697     switch (SvTYPE(sv)) {
5698     default:
5699         if (!SvROK(sv)) {
5700             if (!SvOK(sv))
5701                 DIE(no_usym, "a subroutine");
5702             if (op->op_private & HINT_STRICT_REFS)
5703                 DIE(no_hardref, "a subroutine");
5704             gv = gv_fetchpv(SvPV(sv, na), FALSE, SVt_PVCV);
5705             if (!gv)
5706                 cv = 0;
5707             else
5708                 cv = GvCV(gv);
5709             break;
5710         }
5711         /* FALL THROUGH */
5712     case SVt_RV:
5713         cv = (CV*)SvRV(sv);
5714         if (SvTYPE(cv) == SVt_PVCV)
5715             break;
5716         /* FALL THROUGH */
5717     case SVt_PVHV:
5718     case SVt_PVAV:
5719         DIE("Not a subroutine reference");
5720     case SVt_PVCV:
5721         cv = (CV*)sv;
5722         break;
5723     case SVt_PVGV:
5724         if (!(cv = GvCV((GV*)sv)))
5725             cv = sv_2cv(sv, &stash, &gv, TRUE);
5726         break;
5727     }
5728
5729     ENTER;
5730     SAVETMPS;
5731
5732   retry:
5733     if (!cv)
5734         DIE("Not a subroutine reference");
5735
5736     if (!CvROOT(cv) && !CvUSERSUB(cv)) {
5737         if (gv = CvGV(cv)) {
5738             SV *tmpstr = sv_newmortal();
5739             GV *ngv;
5740             gv_efullname(tmpstr, gv);
5741             ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD");
5742             if (ngv && ngv != gv && (cv = GvCV(ngv))) { /* One more chance... */
5743                 gv = ngv;
5744                 sv_setsv(GvSV(gv), tmpstr);
5745                 goto retry;
5746             }
5747             else
5748                 DIE("Undefined subroutine &%s called",SvPVX(tmpstr));
5749         }
5750         DIE("Undefined subroutine called");
5751     }
5752
5753     if ((op->op_private & OPpDEREF_DB) && !CvUSERSUB(cv)) {
5754         sv = GvSV(DBsub);
5755         save_item(sv);
5756         gv = CvGV(cv);
5757         gv_efullname(sv,gv);
5758         cv = GvCV(DBsub);
5759         if (!cv)
5760             DIE("No DBsub routine");
5761     }
5762
5763     if (CvUSERSUB(cv)) {
5764         items = (*CvUSERSUB(cv))(CvUSERINDEX(cv), MARK - stack_base, items);
5765         sp = stack_base + items;
5766         LEAVE;
5767         RETURN;
5768     }
5769     else {
5770         I32 gimme = GIMME;
5771         AV* padlist = CvPADLIST(cv);
5772         SV** svp = AvARRAY(padlist);
5773         push_return(op->op_next);
5774         PUSHBLOCK(cx, CXt_SUB, MARK - 1);
5775         PUSHSUB(cx);
5776         CvDEPTH(cv)++;
5777         if (CvDEPTH(cv) >= 2) { /* save temporaries on recursion? */
5778             if (CvDEPTH(cv) == 100 && dowarn)
5779                 warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv)));
5780             if (CvDEPTH(cv) > AvFILL(padlist)) {
5781                 AV *newpad = newAV();
5782                 I32 ix = AvFILL((AV*)svp[1]);
5783                 svp = AvARRAY(svp[0]);
5784                 while (ix > 0) {
5785                     if (svp[ix]) {
5786                         char *name = SvPVX(svp[ix]);    /* XXX */
5787                         if (*name == '@')
5788                             av_store(newpad, ix--, (SV*)newAV());
5789                         else if (*name == '%')
5790                             av_store(newpad, ix--, (SV*)newHV());
5791                         else
5792                             av_store(newpad, ix--, NEWSV(0,0));
5793                     }
5794                     else
5795                         av_store(newpad, ix--, NEWSV(0,0));
5796                 }
5797                 if (hasargs) {
5798                     AV* av = newAV();
5799                     av_store(av, 0, Nullsv);
5800                     av_store(newpad, 0, (SV*)av);
5801                     SvOK_on(av);
5802                     AvREAL_off(av);
5803                 }
5804                 av_store(padlist, CvDEPTH(cv), (SV*)newpad);
5805                 AvFILL(padlist) = CvDEPTH(cv);
5806                 svp = AvARRAY(padlist);
5807             }
5808         }
5809         SAVESPTR(curpad);
5810         curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
5811         if (hasargs) {
5812             AV* av = (AV*)curpad[0];
5813             SV** ary;
5814
5815             cx->blk_sub.savearray = GvAV(defgv);
5816             cx->blk_sub.argarray = av;
5817             GvAV(defgv) = cx->blk_sub.argarray;
5818             ++MARK;
5819
5820             if (items >= AvMAX(av)) {
5821                 ary = AvALLOC(av);
5822                 if (AvARRAY(av) != ary) {
5823                     AvMAX(av) += AvARRAY(av) - AvALLOC(av);
5824                     SvPVX(av) = (char*)ary;
5825                 }
5826                 if (items >= AvMAX(av)) {
5827                     AvMAX(av) = items - 1;
5828                     Renew(ary,items+1,SV*);
5829                     AvALLOC(av) = ary;
5830                     SvPVX(av) = (char*)ary;
5831                 }
5832             }
5833             Copy(MARK,AvARRAY(av),items,SV*);
5834             AvFILL(av) = items - 1;
5835             while (items--) {
5836                 if (*MARK)
5837                     SvTEMP_off(*MARK);
5838                 MARK++;
5839             }
5840         }
5841         RETURNOP(CvSTART(cv));
5842     }
5843 }
5844
5845 PP(pp_leavesubr)
5846 {
5847     dSP;
5848     SV **mark;
5849     SV **newsp;
5850     I32 gimme;
5851     register CONTEXT *cx;
5852
5853     POPBLOCK(cx);
5854     POPSUB(cx);
5855
5856     if (gimme == G_SCALAR) {
5857         MARK = newsp + 1;
5858         if (MARK <= SP)
5859             if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
5860                 *MARK = TOPs;
5861             else
5862                 *MARK = sv_mortalcopy(TOPs);
5863         else {
5864             MEXTEND(mark,0);
5865             *MARK = &sv_undef;
5866         }
5867         SP = MARK;
5868     }
5869     else {
5870         for (mark = newsp + 1; mark <= SP; mark++)
5871             if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
5872                 *mark = sv_mortalcopy(*mark);
5873                 /* in case LEAVE wipes old return values */
5874     }
5875
5876     LEAVE;
5877     PUTBACK;
5878     return pop_return();
5879 }
5880
5881 PP(pp_done)
5882 {
5883     return pop_return();
5884 }
5885
5886 PP(pp_caller)
5887 {
5888     dSP;
5889     register I32 cxix = dopoptosub(cxstack_ix);
5890     I32 nextcxix;
5891     register CONTEXT *cx;
5892     SV *sv;
5893     I32 count = 0;
5894
5895     if (MAXARG)
5896         count = POPi;
5897     EXTEND(SP, 6);
5898     for (;;) {
5899         if (cxix < 0) {
5900             if (GIMME != G_ARRAY)
5901                 RETPUSHUNDEF;
5902             RETURN;
5903         }
5904         nextcxix = dopoptosub(cxix - 1);
5905         if (DBsub && nextcxix >= 0 &&
5906                 cxstack[nextcxix].blk_sub.cv == GvCV(DBsub))
5907             count++;
5908         if (!count--)
5909             break;
5910         cxix = nextcxix;
5911     }
5912     cx = &cxstack[cxix];
5913     if (GIMME != G_ARRAY) {
5914         dTARGET;
5915
5916         sv_setpv(TARG, HvNAME(cx->blk_oldcop->cop_stash));
5917         PUSHs(TARG);
5918         RETURN;
5919     }
5920
5921     PUSHs(sv_2mortal(newSVpv(HvNAME(cx->blk_oldcop->cop_stash), 0)));
5922     PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0)));
5923     PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
5924     if (!MAXARG)
5925         RETURN;
5926     if (cx->cx_type == CXt_SUB) {
5927         sv = NEWSV(49, 0);
5928         gv_efullname(sv, CvGV(cx->blk_sub.cv));
5929         PUSHs(sv_2mortal(sv));
5930         PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
5931     }
5932     else {
5933         PUSHs(sv_2mortal(newSVpv("(eval)",0)));
5934         PUSHs(sv_2mortal(newSViv(0)));
5935     }
5936     PUSHs(sv_2mortal(newSViv((I32)cx->blk_gimme)));
5937     if (cx->blk_sub.hasargs && curstash == debstash) {
5938         AV *ary = cx->blk_sub.argarray;
5939
5940         if (!dbargs) {
5941             GV* tmpgv;
5942             dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE,
5943                                 SVt_PVAV)));
5944             SvMULTI_on(tmpgv);
5945             AvREAL_off(dbargs);
5946         }
5947         if (AvMAX(dbargs) < AvFILL(ary))
5948             av_store(dbargs, AvFILL(ary), Nullsv);
5949         Copy(AvARRAY(ary), AvARRAY(dbargs), AvFILL(ary)+1, SV*);
5950         AvFILL(dbargs) = AvFILL(ary);
5951     }
5952     RETURN;
5953 }
5954
5955 static I32
5956 sortcv(str1, str2)
5957 SV **str1;
5958 SV **str2;
5959 {
5960     I32 oldscopeix = scopestack_ix;
5961     I32 result;
5962     GvSV(firstgv) = *str1;
5963     GvSV(secondgv) = *str2;
5964     stack_sp = stack_base;
5965     op = sortcop;
5966     run();
5967     result = SvIVx(AvARRAY(stack)[1]);
5968     while (scopestack_ix > oldscopeix) {
5969         LEAVE;
5970     }
5971     return result;
5972 }
5973
5974 static I32
5975 sortcmp(strp1, strp2)
5976 SV **strp1;
5977 SV **strp2;
5978 {
5979     register SV *str1 = *strp1;
5980     register SV *str2 = *strp2;
5981     I32 retval;
5982
5983     if (SvCUR(str1) < SvCUR(str2)) {
5984         /*SUPPRESS 560*/
5985         if (retval = memcmp(SvPVX(str1), SvPVX(str2), SvCUR(str1)))
5986             return retval;
5987         else
5988             return -1;
5989     }
5990     /*SUPPRESS 560*/
5991     else if (retval = memcmp(SvPVX(str1), SvPVX(str2), SvCUR(str2)))
5992         return retval;
5993     else if (SvCUR(str1) == SvCUR(str2))
5994         return 0;
5995     else
5996         return 1;
5997 }
5998
5999 PP(pp_warn)
6000 {
6001     dSP; dMARK;
6002     char *tmps;
6003     if (SP - MARK != 1) {
6004         dTARGET;
6005         do_join(TARG, &sv_no, MARK, SP);
6006         tmps = SvPV(TARG, na);
6007         SP = MARK + 1;
6008     }
6009     else {
6010         tmps = SvPV(TOPs, na);
6011     }
6012     if (!tmps || !*tmps) {
6013         SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
6014         SvUPGRADE(error, SVt_PV);
6015         if (SvPOK(error) && SvCUR(error))
6016             sv_catpv(error, "\t...caught");
6017         tmps = SvPV(error, na);
6018     }
6019     if (!tmps || !*tmps)
6020         tmps = "Warning: something's wrong";
6021     warn("%s", tmps);
6022     RETSETYES;
6023 }
6024
6025 PP(pp_die)
6026 {
6027     dSP; dMARK;
6028     char *tmps;
6029     if (SP - MARK != 1) {
6030         dTARGET;
6031         do_join(TARG, &sv_no, MARK, SP);
6032         tmps = SvPV(TARG, na);
6033         SP = MARK + 1;
6034     }
6035     else {
6036         tmps = SvPV(TOPs, na);
6037     }
6038     if (!tmps || !*tmps) {
6039         SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
6040         SvUPGRADE(error, SVt_PV);
6041         if (SvPOK(error) && SvCUR(error))
6042             sv_catpv(error, "\t...propagated");
6043         tmps = SvPV(error, na);
6044     }
6045     if (!tmps || !*tmps)
6046         tmps = "Died";
6047     DIE("%s", tmps);
6048 }
6049
6050 PP(pp_reset)
6051 {
6052     dSP;
6053     double value;
6054     char *tmps;
6055
6056     if (MAXARG < 1)
6057         tmps = "";
6058     else
6059         tmps = POPp;
6060     sv_reset(tmps, curcop->cop_stash);
6061     PUSHs(&sv_yes);
6062     RETURN;
6063 }
6064
6065 PP(pp_lineseq)
6066 {
6067     return NORMAL;
6068 }
6069
6070 PP(pp_nextstate)
6071 {
6072     curcop = (COP*)op;
6073     TAINT_NOT;          /* Each statement is presumed innocent */
6074     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
6075     FREE_TMPS();
6076     return NORMAL;
6077 }
6078
6079 PP(pp_dbstate)
6080 {
6081     curcop = (COP*)op;
6082     TAINT_NOT;          /* Each statement is presumed innocent */
6083     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
6084     FREE_TMPS();
6085
6086     if (op->op_private || SvIV(DBsingle) || SvIV(DBsignal) || SvIV(DBtrace))
6087     {
6088         SV **sp;
6089         register CV *cv;
6090         register CONTEXT *cx;
6091         I32 gimme = GIMME;
6092         I32 hasargs;
6093         GV *gv;
6094
6095         ENTER;
6096         SAVETMPS;
6097
6098         SAVEI32(debug);
6099         debug = 0;
6100         hasargs = 0;
6101         gv = DBgv;
6102         cv = GvCV(gv);
6103         sp = stack_sp;
6104         *++sp = Nullsv;
6105
6106         if (!cv)
6107             DIE("No DB::DB routine defined");
6108
6109         if (CvDEPTH(cv) >= 1)           /* don't do recursive DB::DB call */
6110             return NORMAL;
6111         push_return(op->op_next);
6112         PUSHBLOCK(cx, CXt_SUB, sp - 1);
6113         PUSHSUB(cx);
6114         CvDEPTH(cv)++;
6115         SAVESPTR(curpad);
6116         curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE));
6117         RETURNOP(CvSTART(cv));
6118     }
6119     else
6120         return NORMAL;
6121 }
6122
6123 PP(pp_unstack)
6124 {
6125     I32 oldsave;
6126     TAINT_NOT;          /* Each statement is presumed innocent */
6127     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
6128     FREE_TMPS();
6129     oldsave = scopestack[scopestack_ix - 1];
6130     LEAVE_SCOPE(oldsave);
6131     return NORMAL;
6132 }
6133
6134 PP(pp_enter)
6135 {
6136     dSP;
6137     register CONTEXT *cx;
6138     I32 gimme;
6139
6140     /*
6141      * We don't just use the GIMME macro here because it assumes there's
6142      * already a context, which ain't necessarily so at initial startup.
6143      */
6144
6145     if (op->op_flags & OPf_KNOW)
6146         gimme = op->op_flags & OPf_LIST;
6147     else if (cxstack_ix >= 0)
6148         gimme = cxstack[cxstack_ix].blk_gimme;
6149     else
6150         gimme = G_SCALAR;
6151
6152     ENTER;
6153
6154     SAVETMPS;
6155     PUSHBLOCK(cx, CXt_BLOCK, sp);
6156
6157     RETURN;
6158 }
6159
6160 PP(pp_leave)
6161 {
6162     dSP;
6163     register CONTEXT *cx;
6164     register SV **mark;
6165     SV **newsp;
6166     I32 gimme;
6167
6168     POPBLOCK(cx);
6169
6170     if (op->op_flags & OPf_KNOW)
6171         gimme = op->op_flags & OPf_LIST;
6172     else if (cxstack_ix >= 0)
6173         gimme = cxstack[cxstack_ix].blk_gimme;
6174     else
6175         gimme = G_SCALAR;
6176
6177     if (gimme == G_SCALAR) {
6178         MARK = newsp + 1;
6179         if (MARK <= SP)
6180             if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
6181                 *MARK = TOPs;
6182             else
6183                 *MARK = sv_mortalcopy(TOPs);
6184         else {
6185             MEXTEND(mark,0);
6186             *MARK = &sv_undef;
6187         }
6188         SP = MARK;
6189     }
6190     else {
6191         for (mark = newsp + 1; mark <= SP; mark++)
6192             if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
6193                 *mark = sv_mortalcopy(*mark);
6194                 /* in case LEAVE wipes old return values */
6195     }
6196
6197     LEAVE;
6198
6199     RETURN;
6200 }
6201
6202 PP(pp_scope)
6203 {
6204     return NORMAL;
6205 }
6206
6207 PP(pp_enteriter)
6208 {
6209     dSP; dMARK;
6210     register CONTEXT *cx;
6211     I32 gimme = GIMME;
6212     SV **svp;
6213
6214     if (op->op_targ)
6215         svp = &curpad[op->op_targ];             /* "my" variable */
6216     else
6217         svp = &GvSV((GV*)POPs);                 /* symbol table variable */
6218
6219     ENTER;
6220     SAVETMPS;
6221     ENTER;
6222
6223     PUSHBLOCK(cx, CXt_LOOP, SP);
6224     PUSHLOOP(cx, svp, MARK);
6225     cx->blk_loop.iterary = stack;
6226     cx->blk_loop.iterix = MARK - stack_base;
6227
6228     RETURN;
6229 }
6230
6231 PP(pp_iter)
6232 {
6233     dSP;
6234     register CONTEXT *cx;
6235     SV *sv;
6236
6237     EXTEND(sp, 1);
6238     cx = &cxstack[cxstack_ix];
6239     if (cx->cx_type != CXt_LOOP)
6240         DIE("panic: pp_iter");
6241
6242     if (cx->blk_loop.iterix >= cx->blk_oldsp)
6243         RETPUSHNO;
6244
6245     if (sv = AvARRAY(cx->blk_loop.iterary)[++cx->blk_loop.iterix]) {
6246         SvTEMP_off(sv);
6247         *cx->blk_loop.itervar = sv;
6248     }
6249     else
6250         *cx->blk_loop.itervar = &sv_undef;
6251
6252     RETPUSHYES;
6253 }
6254
6255 PP(pp_enterloop)
6256 {
6257     dSP;
6258     register CONTEXT *cx;
6259     I32 gimme = GIMME;
6260
6261     ENTER;
6262     SAVETMPS;
6263     ENTER;
6264
6265     PUSHBLOCK(cx, CXt_LOOP, SP);
6266     PUSHLOOP(cx, 0, SP);
6267
6268     RETURN;
6269 }
6270
6271 PP(pp_leaveloop)
6272 {
6273     dSP;
6274     register CONTEXT *cx;
6275     I32 gimme;
6276     SV **newsp;
6277     SV **mark;
6278
6279     POPBLOCK(cx);
6280     mark = newsp;
6281     POPLOOP(cx);
6282     if (gimme == G_SCALAR) {
6283         if (mark < SP)
6284             *++newsp = sv_mortalcopy(*SP);
6285         else
6286             *++newsp = &sv_undef;
6287     }
6288     else {
6289         while (mark < SP)
6290             *++newsp = sv_mortalcopy(*++mark);
6291     }
6292     sp = newsp;
6293     LEAVE;
6294     LEAVE;
6295
6296     RETURN;
6297 }
6298
6299 PP(pp_return)
6300 {
6301     dSP; dMARK;
6302     I32 cxix;
6303     register CONTEXT *cx;
6304     I32 gimme;
6305     SV **newsp;
6306     I32 optype = 0;
6307
6308     if (stack == sortstack) {
6309         AvARRAY(stack)[1] = *SP;
6310         return 0;
6311     }
6312
6313     cxix = dopoptosub(cxstack_ix);
6314     if (cxix < 0)
6315         DIE("Can't return outside a subroutine");
6316     if (cxix < cxstack_ix)
6317         dounwind(cxix);
6318
6319     POPBLOCK(cx);
6320     switch (cx->cx_type) {
6321     case CXt_SUB:
6322         POPSUB(cx);
6323         break;
6324     case CXt_EVAL:
6325         POPEVAL(cx);
6326         break;
6327     default:
6328         DIE("panic: return");
6329         break;
6330     }
6331
6332     if (gimme == G_SCALAR) {
6333         if (MARK < SP)
6334             *++newsp = sv_mortalcopy(*SP);
6335         else
6336             *++newsp = &sv_undef;
6337         if (optype == OP_REQUIRE && !SvTRUE(*newsp))
6338             DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
6339     }
6340     else {
6341         if (optype == OP_REQUIRE && MARK == SP)
6342             DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
6343         while (MARK < SP)
6344             *++newsp = sv_mortalcopy(*++MARK);
6345     }
6346     stack_sp = newsp;
6347
6348     LEAVE;
6349     return pop_return();
6350 }
6351
6352 PP(pp_last)
6353 {
6354     dSP;
6355     I32 cxix;
6356     register CONTEXT *cx;
6357     I32 gimme;
6358     I32 optype;
6359     OP *nextop;
6360     SV **newsp;
6361     SV **mark = stack_base + cxstack[cxstack_ix].blk_oldsp;
6362     /* XXX The sp is probably not right yet... */
6363
6364     if (op->op_flags & OPf_SPECIAL) {
6365         cxix = dopoptoloop(cxstack_ix);
6366         if (cxix < 0)
6367             DIE("Can't \"last\" outside a block");
6368     }
6369     else {
6370         cxix = dopoptolabel(cPVOP->op_pv);
6371         if (cxix < 0)
6372             DIE("Label not found for \"last %s\"", cPVOP->op_pv);
6373     }
6374     if (cxix < cxstack_ix)
6375         dounwind(cxix);
6376
6377     POPBLOCK(cx);
6378     switch (cx->cx_type) {
6379     case CXt_LOOP:
6380         POPLOOP(cx);
6381         nextop = cx->blk_loop.last_op->op_next;
6382         LEAVE;
6383         break;
6384     case CXt_EVAL:
6385         POPEVAL(cx);
6386         nextop = pop_return();
6387         break;
6388     case CXt_SUB:
6389         POPSUB(cx);
6390         nextop = pop_return();
6391         break;
6392     default:
6393         DIE("panic: last");
6394         break;
6395     }
6396
6397     if (gimme == G_SCALAR) {
6398         if (mark < SP)
6399             *++newsp = sv_mortalcopy(*SP);
6400         else
6401             *++newsp = &sv_undef;
6402     }
6403     else {
6404         while (mark < SP)
6405             *++newsp = sv_mortalcopy(*++mark);
6406     }
6407     sp = newsp;
6408
6409     LEAVE;
6410     RETURNOP(nextop);
6411 }
6412
6413 PP(pp_next)
6414 {
6415     dSP;
6416     I32 cxix;
6417     register CONTEXT *cx;
6418     I32 oldsave;
6419
6420     if (op->op_flags & OPf_SPECIAL) {
6421         cxix = dopoptoloop(cxstack_ix);
6422         if (cxix < 0)
6423             DIE("Can't \"next\" outside a block");
6424     }
6425     else {
6426         cxix = dopoptolabel(cPVOP->op_pv);
6427         if (cxix < 0)
6428             DIE("Label not found for \"next %s\"", cPVOP->op_pv);
6429     }
6430     if (cxix < cxstack_ix)
6431         dounwind(cxix);
6432
6433     TOPBLOCK(cx);
6434     oldsave = scopestack[scopestack_ix - 1];
6435     LEAVE_SCOPE(oldsave);
6436     return cx->blk_loop.next_op;
6437 }
6438
6439 PP(pp_redo)
6440 {
6441     dSP;
6442     I32 cxix;
6443     register CONTEXT *cx;
6444     I32 oldsave;
6445
6446     if (op->op_flags & OPf_SPECIAL) {
6447         cxix = dopoptoloop(cxstack_ix);
6448         if (cxix < 0)
6449             DIE("Can't \"redo\" outside a block");
6450     }
6451     else {
6452         cxix = dopoptolabel(cPVOP->op_pv);
6453         if (cxix < 0)
6454             DIE("Label not found for \"redo %s\"", cPVOP->op_pv);
6455     }
6456     if (cxix < cxstack_ix)
6457         dounwind(cxix);
6458
6459     TOPBLOCK(cx);
6460     oldsave = scopestack[scopestack_ix - 1];
6461     LEAVE_SCOPE(oldsave);
6462     return cx->blk_loop.redo_op;
6463 }
6464
6465 static OP* lastgotoprobe;
6466
6467 OP *
6468 dofindlabel(op,label,opstack)
6469 OP *op;
6470 char *label;
6471 OP **opstack;
6472 {
6473     OP *kid;
6474     OP **ops = opstack;
6475
6476     if (op->op_type == OP_LEAVE ||
6477         op->op_type == OP_SCOPE ||
6478         op->op_type == OP_LEAVELOOP ||
6479         op->op_type == OP_LEAVETRY)
6480             *ops++ = cUNOP->op_first;
6481     *ops = 0;
6482     if (op->op_flags & OPf_KIDS) {
6483         /* First try all the kids at this level, since that's likeliest. */
6484         for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
6485             if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
6486                     kCOP->cop_label && strEQ(kCOP->cop_label, label))
6487                 return kid;
6488         }
6489         for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
6490             if (kid == lastgotoprobe)
6491                 continue;
6492             if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
6493                 if (ops > opstack &&
6494                   (ops[-1]->op_type == OP_NEXTSTATE ||
6495                    ops[-1]->op_type == OP_DBSTATE))
6496                     *ops = kid;
6497                 else
6498                     *ops++ = kid;
6499             }
6500             if (op = dofindlabel(kid,label,ops))
6501                 return op;
6502         }
6503     }
6504     *ops = 0;
6505     return 0;
6506 }
6507
6508 PP(pp_dump)
6509 {
6510     return pp_goto(ARGS);
6511     /*NOTREACHED*/
6512 }
6513
6514 PP(pp_goto)
6515 {
6516     dSP;
6517     OP *retop = 0;
6518     I32 ix;
6519     register CONTEXT *cx;
6520     I32 entering = 0;
6521     OP *enterops[64];
6522     char *label;
6523
6524     label = 0;
6525     if (op->op_flags & OPf_STACKED) {
6526         SV *sv = POPs;
6527
6528         /* This egregious kludge implements goto &subroutine */
6529         if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
6530             I32 cxix;
6531             register CONTEXT *cx;
6532             CV* cv = (CV*)SvRV(sv);
6533             SV** mark;
6534             I32 items = 0;
6535             I32 oldsave;
6536
6537             /* First do some returnish stuff. */
6538             cxix = dopoptosub(cxstack_ix);
6539             if (cxix < 0)
6540                 DIE("Can't goto subroutine outside a subroutine");
6541             if (cxix < cxstack_ix)
6542                 dounwind(cxix);
6543             TOPBLOCK(cx);
6544             mark = ++stack_sp;
6545             *stack_sp = (SV*)cv;
6546             if (cx->blk_sub.hasargs) {   /* put @_ back onto stack */
6547                 items = AvFILL(cx->blk_sub.argarray) + 1;
6548                 Copy(AvARRAY(cx->blk_sub.argarray), ++stack_sp, items, SV*);
6549                 stack_sp += items;
6550                 GvAV(defgv) = cx->blk_sub.savearray;
6551             }
6552             if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) {
6553                 if (CvDELETED(cx->blk_sub.cv))
6554                     SvREFCNT_dec(cx->blk_sub.cv);
6555             }
6556             oldsave = scopestack[scopestack_ix - 1];
6557             LEAVE_SCOPE(oldsave);
6558
6559             /* Now do some callish stuff. */
6560             if (CvUSERSUB(cv)) {
6561                 items = (*CvUSERSUB(cv))(CvUSERINDEX(cv),
6562                                             mark - stack_base, items);
6563                 sp = stack_base + items;
6564                 LEAVE;
6565                 return pop_return();
6566             }
6567             else {
6568                 AV* padlist = CvPADLIST(cv);
6569                 SV** svp = AvARRAY(padlist);
6570                 cx->blk_sub.cv = cv;
6571                 cx->blk_sub.olddepth = CvDEPTH(cv);
6572                 CvDEPTH(cv)++;
6573                 if (CvDEPTH(cv) >= 2) { /* save temporaries on recursion? */
6574                     if (CvDEPTH(cv) == 100 && dowarn)
6575                         warn("Deep recursion on subroutine \"%s\"",
6576                             GvENAME(CvGV(cv)));
6577                     if (CvDEPTH(cv) > AvFILL(padlist)) {
6578                         AV *newpad = newAV();
6579                         I32 ix = AvFILL((AV*)svp[1]);
6580                         svp = AvARRAY(svp[0]);
6581                         while (ix > 0) {
6582                             if (svp[ix]) {
6583                                 char *name = SvPVX(svp[ix]);    /* XXX */
6584                                 if (*name == '@')
6585                                     av_store(newpad, ix--, (SV*)newAV());
6586                                 else if (*name == '%')
6587                                     av_store(newpad, ix--, (SV*)newHV());
6588                                 else
6589                                     av_store(newpad, ix--, NEWSV(0,0));
6590                             }
6591                             else
6592                                 av_store(newpad, ix--, NEWSV(0,0));
6593                         }
6594                         if (cx->blk_sub.hasargs) {
6595                             AV* av = newAV();
6596                             av_store(av, 0, Nullsv);
6597                             av_store(newpad, 0, (SV*)av);
6598                             SvOK_on(av);
6599                             AvREAL_off(av);
6600                         }
6601                         av_store(padlist, CvDEPTH(cv), (SV*)newpad);
6602                         AvFILL(padlist) = CvDEPTH(cv);
6603                         svp = AvARRAY(padlist);
6604                     }
6605                 }
6606                 SAVESPTR(curpad);
6607                 curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
6608                 if (cx->blk_sub.hasargs) {
6609                     AV* av = (AV*)curpad[0];
6610                     SV** ary;
6611
6612                     cx->blk_sub.savearray = GvAV(defgv);
6613                     cx->blk_sub.argarray = av;
6614                     GvAV(defgv) = cx->blk_sub.argarray;
6615                     ++mark;
6616
6617                     if (items >= AvMAX(av)) {
6618                         ary = AvALLOC(av);
6619                         if (AvARRAY(av) != ary) {
6620                             AvMAX(av) += AvARRAY(av) - AvALLOC(av);
6621                             SvPVX(av) = (char*)ary;
6622                         }
6623                         if (items >= AvMAX(av)) {
6624                             AvMAX(av) = items - 1;
6625                             Renew(ary,items+1,SV*);
6626                             AvALLOC(av) = ary;
6627                             SvPVX(av) = (char*)ary;
6628                         }
6629                     }
6630                     Copy(mark,AvARRAY(av),items,SV*);
6631                     AvFILL(av) = items - 1;
6632                     while (items--) {
6633                         if (*mark)
6634                             SvTEMP_off(*mark);
6635                         mark++;
6636                     }
6637                 }
6638                 RETURNOP(CvSTART(cv));
6639             }
6640         }
6641         else
6642             label = SvPV(sv,na);
6643     }
6644     else if (op->op_flags & OPf_SPECIAL) {
6645         if (op->op_type != OP_DUMP)
6646             DIE("goto must have label");
6647     }
6648     else
6649         label = cPVOP->op_pv;
6650
6651     if (label && *label) {
6652         OP *gotoprobe;
6653
6654         /* find label */
6655
6656         lastgotoprobe = 0;
6657         *enterops = 0;
6658         for (ix = cxstack_ix; ix >= 0; ix--) {
6659             cx = &cxstack[ix];
6660             switch (cx->cx_type) {
6661             case CXt_SUB:
6662                 gotoprobe = CvROOT(cx->blk_sub.cv);
6663                 break;
6664             case CXt_EVAL:
6665                 gotoprobe = eval_root; /* XXX not good for nested eval */
6666                 break;
6667             case CXt_LOOP:
6668                 gotoprobe = cx->blk_oldcop->op_sibling;
6669                 break;
6670             case CXt_SUBST:
6671                 continue;
6672             case CXt_BLOCK:
6673                 if (ix)
6674                     gotoprobe = cx->blk_oldcop->op_sibling;
6675                 else
6676                     gotoprobe = main_root;
6677                 break;
6678             default:
6679                 if (ix)
6680                     DIE("panic: goto");
6681                 else
6682                     gotoprobe = main_root;
6683                 break;
6684             }
6685             retop = dofindlabel(gotoprobe, label, enterops);
6686             if (retop)
6687                 break;
6688             lastgotoprobe = gotoprobe;
6689         }
6690         if (!retop)
6691             DIE("Can't find label %s", label);
6692
6693         /* pop unwanted frames */
6694
6695         if (ix < cxstack_ix) {
6696             I32 oldsave;
6697
6698             if (ix < 0)
6699                 ix = 0;
6700             dounwind(ix);
6701             TOPBLOCK(cx);
6702             oldsave = scopestack[scopestack_ix - 1];
6703             LEAVE_SCOPE(oldsave);
6704         }
6705
6706         /* push wanted frames */
6707
6708         if (*enterops) {
6709             OP *oldop = op;
6710             for (ix = 0 + (gotoprobe == main_root); enterops[ix]; ix++) {
6711                 op = enterops[ix];
6712                 (*op->op_ppaddr)();
6713             }
6714             op = oldop;
6715         }
6716     }
6717
6718     if (op->op_type == OP_DUMP) {
6719         restartop = retop;
6720         do_undump = TRUE;
6721
6722         my_unexec();
6723
6724         restartop = 0;          /* hmm, must be GNU unexec().. */
6725         do_undump = FALSE;
6726     }
6727
6728     RETURNOP(retop);
6729 }
6730
6731 PP(pp_exit)
6732 {
6733     dSP;
6734     I32 anum;
6735
6736     if (MAXARG < 1)
6737         anum = 0;
6738     else
6739         anum = SvIVx(POPs);
6740     my_exit(anum);
6741     PUSHs(&sv_undef);
6742     RETURN;
6743 }
6744
6745 PP(pp_nswitch)
6746 {
6747     dSP;
6748     double value = SvNVx(GvSV(cCOP->cop_gv));
6749     register I32 match = (I32)value;
6750
6751     if (value < 0.0) {
6752         if (((double)match) > value)
6753             --match;            /* was fractional--truncate other way */
6754     }
6755     match -= cCOP->uop.scop.scop_offset;
6756     if (match < 0)
6757         match = 0;
6758     else if (match > cCOP->uop.scop.scop_max)
6759         match = cCOP->uop.scop.scop_max;
6760     op = cCOP->uop.scop.scop_next[match];
6761     RETURNOP(op);
6762 }
6763
6764 PP(pp_cswitch)
6765 {
6766     dSP;
6767     register I32 match;
6768
6769     if (multiline)
6770         op = op->op_next;                       /* can't assume anything */
6771     else {
6772         match = *(SvPVx(GvSV(cCOP->cop_gv), na)) & 255;
6773         match -= cCOP->uop.scop.scop_offset;
6774         if (match < 0)
6775             match = 0;
6776         else if (match > cCOP->uop.scop.scop_max)
6777             match = cCOP->uop.scop.scop_max;
6778         op = cCOP->uop.scop.scop_next[match];
6779     }
6780     RETURNOP(op);
6781 }
6782
6783 /* I/O. */
6784
6785 PP(pp_open)
6786 {
6787     dSP; dTARGET;
6788     GV *gv;
6789     SV *sv;
6790     char *tmps;
6791     STRLEN len;
6792
6793     if (MAXARG > 1)
6794         sv = POPs;
6795     else
6796         sv = GvSV(TOPs);
6797     gv = (GV*)POPs;
6798     tmps = SvPV(sv, len);
6799     if (do_open(gv, tmps, len)) {
6800         IoLINES(GvIO(gv)) = 0;
6801         PUSHi( (I32)forkprocess );
6802     }
6803     else if (forkprocess == 0)          /* we are a new child */
6804         PUSHi(0);
6805     else
6806         RETPUSHUNDEF;
6807     RETURN;
6808 }
6809
6810 PP(pp_close)
6811 {
6812     dSP;
6813     GV *gv;
6814
6815     if (MAXARG == 0)
6816         gv = defoutgv;
6817     else
6818         gv = (GV*)POPs;
6819     EXTEND(SP, 1);
6820     PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no );
6821     RETURN;
6822 }
6823
6824 PP(pp_pipe_op)
6825 {
6826     dSP;
6827 #ifdef HAS_PIPE
6828     GV *rgv;
6829     GV *wgv;
6830     register IO *rstio;
6831     register IO *wstio;
6832     int fd[2];
6833
6834     wgv = (GV*)POPs;
6835     rgv = (GV*)POPs;
6836
6837     if (!rgv || !wgv)
6838         goto badexit;
6839
6840     rstio = GvIOn(rgv);
6841     wstio = GvIOn(wgv);
6842
6843     if (IoIFP(rstio))
6844         do_close(rgv, FALSE);
6845     if (IoIFP(wstio))
6846         do_close(wgv, FALSE);
6847
6848     if (pipe(fd) < 0)
6849         goto badexit;
6850
6851     IoIFP(rstio) = fdopen(fd[0], "r");
6852     IoOFP(wstio) = fdopen(fd[1], "w");
6853     IoIFP(wstio) = IoOFP(wstio);
6854     IoTYPE(rstio) = '<';
6855     IoTYPE(wstio) = '>';
6856
6857     if (!IoIFP(rstio) || !IoOFP(wstio)) {
6858         if (IoIFP(rstio)) fclose(IoIFP(rstio));
6859         else close(fd[0]);
6860         if (IoOFP(wstio)) fclose(IoOFP(wstio));
6861         else close(fd[1]);
6862         goto badexit;
6863     }
6864
6865     RETPUSHYES;
6866
6867 badexit:
6868     RETPUSHUNDEF;
6869 #else
6870     DIE(no_func, "pipe");
6871 #endif
6872 }
6873
6874 PP(pp_fileno)
6875 {
6876     dSP; dTARGET;
6877     GV *gv;
6878     IO *io;
6879     FILE *fp;
6880     if (MAXARG < 1)
6881         RETPUSHUNDEF;
6882     gv = (GV*)POPs;
6883     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
6884         RETPUSHUNDEF;
6885     PUSHi(fileno(fp));
6886     RETURN;
6887 }
6888
6889 PP(pp_umask)
6890 {
6891     dSP; dTARGET;
6892     int anum;
6893
6894 #ifdef HAS_UMASK
6895     if (MAXARG < 1) {
6896         anum = umask(0);
6897         (void)umask(anum);
6898     }
6899     else
6900         anum = umask(POPi);
6901     TAINT_PROPER("umask");
6902     XPUSHi(anum);
6903 #else
6904     DIE(no_func, "Unsupported function umask");
6905 #endif
6906     RETURN;
6907 }
6908
6909 PP(pp_binmode)
6910 {
6911     dSP;
6912     GV *gv;
6913     IO *io;
6914     FILE *fp;
6915
6916     if (MAXARG < 1)
6917         RETPUSHUNDEF;
6918
6919     gv = (GV*)POPs;
6920
6921     EXTEND(SP, 1);
6922     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
6923         RETSETUNDEF;
6924
6925 #ifdef DOSISH
6926 #ifdef atarist
6927     if (!fflush(fp) && (fp->_flag |= _IOBIN))
6928         RETPUSHYES;
6929     else
6930         RETPUSHUNDEF;
6931 #else
6932     if (setmode(fileno(fp), OP_BINARY) != -1)
6933         RETPUSHYES;
6934     else
6935         RETPUSHUNDEF;
6936 #endif
6937 #else
6938     RETPUSHYES;
6939 #endif
6940 }
6941
6942 PP(pp_tie)
6943 {
6944     dSP;
6945     SV *varsv;
6946     HV* stash;
6947     GV *gv;
6948     BINOP myop;
6949     SV *sv;
6950     SV **mark = stack_base + *markstack_ptr + 1;        /* reuse in entersubr */
6951
6952     varsv = mark[0];
6953
6954     stash = fetch_stash(mark[1], FALSE);
6955     if (!stash || !(gv = gv_fetchmethod(stash, "new")) || !GvCV(gv))
6956         DIE("Can't tie to package %s", SvPV(mark[1],na));
6957
6958     Zero(&myop, 1, BINOP);
6959     myop.op_last = (OP *) &myop;
6960     myop.op_next = Nullop;
6961     myop.op_flags = OPf_STACKED;
6962
6963     ENTER;
6964     SAVESPTR(op);
6965     op = (OP *) &myop;
6966
6967     mark[0] = gv;
6968     PUTBACK;
6969
6970     if (op = pp_entersubr())
6971         run();
6972     SPAGAIN;
6973
6974     if (!sv_isobject(TOPs))
6975         DIE("new didn't return an object");
6976     sv = TOPs;
6977     if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV)
6978         sv_magic(varsv, sv, 'P', 0, 0);
6979     else
6980         sv_magic(varsv, sv, 'p', 0, -1);
6981     LEAVE;
6982     SPAGAIN;
6983     RETURN;
6984 }
6985
6986 PP(pp_untie)
6987 {
6988     dSP;
6989     if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV)
6990         sv_unmagic(TOPs, 'P');
6991     else
6992         sv_unmagic(TOPs, 'p');
6993     RETSETYES;
6994 }
6995
6996 PP(pp_dbmopen)
6997 {
6998     dSP;
6999     HV *hv;
7000     dPOPPOPssrl;
7001     HV* stash;
7002     GV *gv;
7003     BINOP myop;
7004     SV *sv;
7005
7006     hv = (HV*)POPs;
7007
7008     sv = sv_mortalcopy(&sv_no);
7009     sv_setpv(sv, "Any_DBM_File");
7010     stash = fetch_stash(sv, FALSE);
7011     if (!stash || !(gv = gv_fetchmethod(stash, "new")) || !GvCV(gv))
7012         DIE("No dbm on this machine");
7013
7014     Zero(&myop, 1, BINOP);
7015     myop.op_last = (OP *) &myop;
7016     myop.op_next = Nullop;
7017     myop.op_flags = OPf_STACKED;
7018
7019     ENTER;
7020     SAVESPTR(op);
7021     op = (OP *) &myop;
7022     PUTBACK;
7023     pp_pushmark();
7024
7025     EXTEND(sp, 5);
7026     PUSHs(gv);
7027     PUSHs(sv);
7028     PUSHs(lstr);
7029     if (SvIV(rstr))
7030         PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT)));
7031     else
7032         PUSHs(sv_2mortal(newSViv(O_RDWR)));
7033     PUSHs(rstr);
7034     PUTBACK;
7035
7036     if (op = pp_entersubr())
7037         run();
7038     LEAVE;
7039     SPAGAIN;
7040
7041     sv = TOPs;
7042     sv_magic((SV*)hv, sv, 'P', 0, 0);
7043     RETURN;
7044 }
7045
7046 PP(pp_dbmclose)
7047 {
7048     return pp_untie(ARGS);
7049 }
7050
7051 PP(pp_sselect)
7052 {
7053     dSP; dTARGET;
7054 #ifdef HAS_SELECT
7055     register I32 i;
7056     register I32 j;
7057     register char *s;
7058     register SV *sv;
7059     double value;
7060     I32 maxlen = 0;
7061     I32 nfound;
7062     struct timeval timebuf;
7063     struct timeval *tbuf = &timebuf;
7064     I32 growsize;
7065     char *fd_sets[4];
7066 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
7067         I32 masksize;
7068         I32 offset;
7069         I32 k;
7070
7071 #   if BYTEORDER & 0xf0000
7072 #       define ORDERBYTE (0x88888888 - BYTEORDER)
7073 #   else
7074 #       define ORDERBYTE (0x4444 - BYTEORDER)
7075 #   endif
7076
7077 #endif
7078
7079     SP -= 4;
7080     for (i = 1; i <= 3; i++) {
7081         if (!SvPOK(SP[i]))
7082             continue;
7083         j = SvCUR(SP[i]);
7084         if (maxlen < j)
7085             maxlen = j;
7086     }
7087
7088 #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
7089     growsize = maxlen;          /* little endians can use vecs directly */
7090 #else
7091 #ifdef NFDBITS
7092
7093 #ifndef NBBY
7094 #define NBBY 8
7095 #endif
7096
7097     masksize = NFDBITS / NBBY;
7098 #else
7099     masksize = sizeof(long);    /* documented int, everyone seems to use long */
7100 #endif
7101     growsize = maxlen + (masksize - (maxlen % masksize));
7102     Zero(&fd_sets[0], 4, char*);
7103 #endif
7104
7105     sv = SP[4];
7106     if (SvOK(sv)) {
7107         value = SvNV(sv);
7108         if (value < 0.0)
7109             value = 0.0;
7110         timebuf.tv_sec = (long)value;
7111         value -= (double)timebuf.tv_sec;
7112         timebuf.tv_usec = (long)(value * 1000000.0);
7113     }
7114     else
7115         tbuf = Null(struct timeval*);
7116
7117     for (i = 1; i <= 3; i++) {
7118         sv = SP[i];
7119         if (!SvPOK(sv)) {
7120             fd_sets[i] = 0;
7121             continue;
7122         }
7123         j = SvLEN(sv);
7124         if (j < growsize) {
7125             Sv_Grow(sv, growsize);
7126             s = SvPV(sv, na) + j;
7127             while (++j <= growsize) {
7128                 *s++ = '\0';
7129             }
7130         }
7131 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
7132         s = SvPVX(sv);
7133         New(403, fd_sets[i], growsize, char);
7134         for (offset = 0; offset < growsize; offset += masksize) {
7135             for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
7136                 fd_sets[i][j+offset] = s[(k % masksize) + offset];
7137         }
7138 #else
7139         fd_sets[i] = SvPVX(sv);
7140 #endif
7141     }
7142
7143     nfound = select(
7144         maxlen * 8,
7145         fd_sets[1],
7146         fd_sets[2],
7147         fd_sets[3],
7148         tbuf);
7149 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
7150     for (i = 1; i <= 3; i++) {
7151         if (fd_sets[i]) {
7152             sv = SP[i];
7153             s = SvPVX(sv);
7154             for (offset = 0; offset < growsize; offset += masksize) {
7155                 for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
7156                     s[(k % masksize) + offset] = fd_sets[i][j+offset];
7157             }
7158             Safefree(fd_sets[i]);
7159         }
7160     }
7161 #endif
7162
7163     PUSHi(nfound);
7164     if (GIMME == G_ARRAY && tbuf) {
7165         value = (double)(timebuf.tv_sec) +
7166                 (double)(timebuf.tv_usec) / 1000000.0;
7167         PUSHs(sv = sv_mortalcopy(&sv_no));
7168         sv_setnv(sv, value);
7169     }
7170     RETURN;
7171 #else
7172     DIE("select not implemented");
7173 #endif
7174 }
7175
7176 PP(pp_select)
7177 {
7178     dSP; dTARGET;
7179     GV *oldgv = defoutgv;
7180     if (op->op_private > 0) {
7181         defoutgv = (GV*)POPs;
7182         if (!GvIO(defoutgv))
7183             GvIO(defoutgv) = newIO();
7184         curoutgv = defoutgv;
7185     }
7186     gv_efullname(TARG, oldgv);
7187     XPUSHTARG;
7188     RETURN;
7189 }
7190
7191 PP(pp_getc)
7192 {
7193     dSP; dTARGET;
7194     GV *gv;
7195
7196     if (MAXARG <= 0)
7197         gv = stdingv;
7198     else
7199         gv = (GV*)POPs;
7200     if (!gv)
7201         gv = argvgv;
7202     if (!gv || do_eof(gv)) /* make sure we have fp with something */
7203         RETPUSHUNDEF;
7204     TAINT_IF(1);
7205     sv_setpv(TARG, " ");
7206     *SvPVX(TARG) = getc(IoIFP(GvIO(gv))); /* should never be EOF */
7207     PUSHTARG;
7208     RETURN;
7209 }
7210
7211 PP(pp_read)
7212 {
7213     return pp_sysread(ARGS);
7214 }
7215
7216 static OP *
7217 doform(cv,gv,retop)
7218 CV *cv;
7219 GV *gv;
7220 OP *retop;
7221 {
7222     register CONTEXT *cx;
7223     I32 gimme = GIMME;
7224     ENTER;
7225     SAVETMPS;
7226
7227     push_return(retop);
7228     PUSHBLOCK(cx, CXt_SUB, stack_sp);
7229     PUSHFORMAT(cx);
7230     defoutgv = gv;              /* locally select filehandle so $% et al work */
7231     return CvSTART(cv);
7232 }
7233
7234 PP(pp_enterwrite)
7235 {
7236     dSP;
7237     register GV *gv;
7238     register IO *io;
7239     GV *fgv;
7240     FILE *fp;
7241     CV *cv;
7242
7243     if (MAXARG == 0)
7244         gv = defoutgv;
7245     else {
7246         gv = (GV*)POPs;
7247         if (!gv)
7248             gv = defoutgv;
7249     }
7250     EXTEND(SP, 1);
7251     io = GvIO(gv);
7252     if (!io) {
7253         RETPUSHNO;
7254     }
7255     curoutgv = gv;
7256     if (IoFMT_GV(io))
7257         fgv = IoFMT_GV(io);
7258     else
7259         fgv = gv;
7260
7261     cv = GvFORM(fgv);
7262
7263     if (!cv) {
7264         if (fgv) {
7265             SV *tmpstr = sv_newmortal();
7266             gv_efullname(tmpstr, gv);
7267             DIE("Undefined format \"%s\" called",SvPVX(tmpstr));
7268         }
7269         DIE("Not a format reference");
7270     }
7271
7272     return doform(cv,gv,op->op_next);
7273 }
7274
7275 PP(pp_leavewrite)
7276 {
7277     dSP;
7278     GV *gv = cxstack[cxstack_ix].blk_sub.gv;
7279     register IO *io = GvIO(gv);
7280     FILE *ofp = IoOFP(io);
7281     FILE *fp;
7282     SV **mark;
7283     SV **newsp;
7284     I32 gimme;
7285     register CONTEXT *cx;
7286
7287     DEBUG_f(fprintf(stderr,"left=%ld, todo=%ld\n",
7288           (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
7289     if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
7290         formtarget != toptarget)
7291     {
7292         if (!IoTOP_GV(io)) {
7293             GV *topgv;
7294             char tmpbuf[256];
7295
7296             if (!IoTOP_NAME(io)) {
7297                 if (!IoFMT_NAME(io))
7298                     IoFMT_NAME(io) = savestr(GvNAME(gv));
7299                 sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
7300                 topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
7301                 if (topgv && GvFORM(topgv))
7302                     IoTOP_NAME(io) = savestr(tmpbuf);
7303                 else
7304                     IoTOP_NAME(io) = savestr("top");
7305             }
7306             topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM);
7307             if (!topgv || !GvFORM(topgv)) {
7308                 IoLINES_LEFT(io) = 100000000;
7309                 goto forget_top;
7310             }
7311             IoTOP_GV(io) = topgv;
7312         }
7313         if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
7314             fwrite(SvPVX(formfeed), SvCUR(formfeed), 1, ofp);
7315         IoLINES_LEFT(io) = IoPAGE_LEN(io);
7316         IoPAGE(io)++;
7317         formtarget = toptarget;
7318         return doform(GvFORM(IoTOP_GV(io)),gv,op);
7319     }
7320
7321   forget_top:
7322     POPBLOCK(cx);
7323     POPFORMAT(cx);
7324     LEAVE;
7325
7326     fp = IoOFP(io);
7327     if (!fp) {
7328         if (dowarn) {
7329             if (IoIFP(io))
7330                 warn("Filehandle only opened for input");
7331             else
7332                 warn("Write on closed filehandle");
7333         }
7334         PUSHs(&sv_no);
7335     }
7336     else {
7337         if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) {
7338             if (dowarn)
7339                 warn("page overflow");
7340         }
7341         if (!fwrite(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) ||
7342                 ferror(fp))
7343             PUSHs(&sv_no);
7344         else {
7345             FmLINES(formtarget) = 0;
7346             SvCUR_set(formtarget, 0);
7347             if (IoFLAGS(io) & IOf_FLUSH)
7348                 (void)fflush(fp);
7349             PUSHs(&sv_yes);
7350         }
7351     }
7352     formtarget = bodytarget;
7353     PUTBACK;
7354     return pop_return();
7355 }
7356
7357 PP(pp_prtf)
7358 {
7359     dSP; dMARK; dORIGMARK;
7360     GV *gv;
7361     IO *io;
7362     FILE *fp;
7363     SV *sv = NEWSV(0,0);
7364
7365     if (op->op_flags & OPf_STACKED)
7366         gv = (GV*)*++MARK;
7367     else
7368         gv = defoutgv;
7369     if (!(io = GvIO(gv))) {
7370         if (dowarn)
7371             warn("Filehandle %s never opened", GvNAME(gv));
7372         errno = EBADF;
7373         goto just_say_no;
7374     }
7375     else if (!(fp = IoOFP(io))) {
7376         if (dowarn)  {
7377             if (IoIFP(io))
7378                 warn("Filehandle %s opened only for input", GvNAME(gv));
7379             else
7380                 warn("printf on closed filehandle %s", GvNAME(gv));
7381         }
7382         errno = EBADF;
7383         goto just_say_no;
7384     }
7385     else {
7386         do_sprintf(sv, SP - MARK, MARK + 1);
7387         if (!do_print(sv, fp))
7388             goto just_say_no;
7389
7390         if (IoFLAGS(io) & IOf_FLUSH)
7391             if (fflush(fp) == EOF)
7392                 goto just_say_no;
7393     }
7394     SvREFCNT_dec(sv);
7395     SP = ORIGMARK;
7396     PUSHs(&sv_yes);
7397     RETURN;
7398
7399   just_say_no:
7400     SvREFCNT_dec(sv);
7401     SP = ORIGMARK;
7402     PUSHs(&sv_undef);
7403     RETURN;
7404 }
7405
7406 PP(pp_print)
7407 {
7408     dSP; dMARK; dORIGMARK;
7409     GV *gv;
7410     IO *io;
7411     register FILE *fp;
7412
7413     if (op->op_flags & OPf_STACKED)
7414         gv = (GV*)*++MARK;
7415     else
7416         gv = defoutgv;
7417     if (!(io = GvIO(gv))) {
7418         if (dowarn)
7419             warn("Filehandle %s never opened", GvNAME(gv));
7420         errno = EBADF;
7421         goto just_say_no;
7422     }
7423     else if (!(fp = IoOFP(io))) {
7424         if (dowarn)  {
7425             if (IoIFP(io))
7426                 warn("Filehandle %s opened only for input", GvNAME(gv));
7427             else
7428                 warn("print on closed filehandle %s", GvNAME(gv));
7429         }
7430         errno = EBADF;
7431         goto just_say_no;
7432     }
7433     else {
7434         MARK++;
7435         if (ofslen) {
7436             while (MARK <= SP) {
7437                 if (!do_print(*MARK, fp))
7438                     break;
7439                 MARK++;
7440                 if (MARK <= SP) {
7441                     if (fwrite(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
7442                         MARK--;
7443                         break;
7444                     }
7445                 }
7446             }
7447         }
7448         else {
7449             while (MARK <= SP) {
7450                 if (!do_print(*MARK, fp))
7451                     break;
7452                 MARK++;
7453             }
7454         }
7455         if (MARK <= SP)
7456             goto just_say_no;
7457         else {
7458             if (orslen)
7459                 if (fwrite(ors, 1, orslen, fp) == 0 || ferror(fp))
7460                     goto just_say_no;
7461
7462             if (IoFLAGS(io) & IOf_FLUSH)
7463                 if (fflush(fp) == EOF)
7464                     goto just_say_no;
7465         }
7466     }
7467     SP = ORIGMARK;
7468     PUSHs(&sv_yes);
7469     RETURN;
7470
7471   just_say_no:
7472     SP = ORIGMARK;
7473     PUSHs(&sv_undef);
7474     RETURN;
7475 }
7476
7477 PP(pp_sysread)
7478 {
7479     dSP; dMARK; dORIGMARK; dTARGET;
7480     int offset;
7481     GV *gv;
7482     IO *io;
7483     char *buffer;
7484     int length;
7485     int bufsize;
7486     SV *bufstr;
7487     STRLEN blen;
7488
7489     gv = (GV*)*++MARK;
7490     if (!gv)
7491         goto say_undef;
7492     bufstr = *++MARK;
7493     buffer = SvPV(bufstr, blen);
7494     length = SvIVx(*++MARK);
7495     if (SvTHINKFIRST(bufstr)) {
7496         if (SvREADONLY(bufstr) && curcop != &compiling)
7497             DIE(no_modify);
7498         if (SvROK(bufstr))
7499             sv_unref(bufstr);
7500     }
7501     errno = 0;
7502     if (MARK < SP)
7503         offset = SvIVx(*++MARK);
7504     else
7505         offset = 0;
7506     if (MARK < SP)
7507         warn("Too many args on read");
7508     io = GvIO(gv);
7509     if (!io || !IoIFP(io))
7510         goto say_undef;
7511 #ifdef HAS_SOCKET
7512     if (op->op_type == OP_RECV) {
7513         bufsize = sizeof buf;
7514         SvGROW(bufstr, length+1), (buffer = SvPV(bufstr, blen));  /* sneaky */
7515         length = recvfrom(fileno(IoIFP(io)), buffer, length, offset,
7516             (struct sockaddr *)buf, &bufsize);
7517         if (length < 0)
7518             RETPUSHUNDEF;
7519         SvCUR_set(bufstr, length);
7520         *SvEND(bufstr) = '\0';
7521         SvPOK_only(bufstr);
7522         if (tainting)
7523             sv_magic(bufstr, 0, 't', 0, 0);
7524         SP = ORIGMARK;
7525         sv_setpvn(TARG, buf, bufsize);
7526         PUSHs(TARG);
7527         RETURN;
7528     }
7529 #else
7530     if (op->op_type == OP_RECV)
7531         DIE(no_sock_func, "recv");
7532 #endif
7533     SvGROW(bufstr, length+offset+1), (buffer = SvPV(bufstr, blen));  /* sneaky */
7534     if (op->op_type == OP_SYSREAD) {
7535         length = read(fileno(IoIFP(io)), buffer+offset, length);
7536     }
7537     else
7538 #ifdef HAS_SOCKET
7539     if (IoTYPE(io) == 's') {
7540         bufsize = sizeof buf;
7541         length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0,
7542             (struct sockaddr *)buf, &bufsize);
7543     }
7544     else
7545 #endif
7546         length = fread(buffer+offset, 1, length, IoIFP(io));
7547     if (length < 0)
7548         goto say_undef;
7549     SvCUR_set(bufstr, length+offset);
7550     *SvEND(bufstr) = '\0';
7551     SvPOK_only(bufstr);
7552     if (tainting)
7553         sv_magic(bufstr, 0, 't', 0, 0);
7554     SP = ORIGMARK;
7555     PUSHi(length);
7556     RETURN;
7557
7558   say_undef:
7559     SP = ORIGMARK;
7560     RETPUSHUNDEF;
7561 }
7562
7563 PP(pp_syswrite)
7564 {
7565     return pp_send(ARGS);
7566 }
7567
7568 PP(pp_send)
7569 {
7570     dSP; dMARK; dORIGMARK; dTARGET;
7571     GV *gv;
7572     IO *io;
7573     int offset;
7574     SV *bufstr;
7575     char *buffer;
7576     int length;
7577     STRLEN blen;
7578
7579     gv = (GV*)*++MARK;
7580     if (!gv)
7581         goto say_undef;
7582     bufstr = *++MARK;
7583     buffer = SvPV(bufstr, blen);
7584     length = SvIVx(*++MARK);
7585     errno = 0;
7586     io = GvIO(gv);
7587     if (!io || !IoIFP(io)) {
7588         length = -1;
7589         if (dowarn) {
7590             if (op->op_type == OP_SYSWRITE)
7591                 warn("Syswrite on closed filehandle");
7592             else
7593                 warn("Send on closed socket");
7594         }
7595     }
7596     else if (op->op_type == OP_SYSWRITE) {
7597         if (MARK < SP)
7598             offset = SvIVx(*++MARK);
7599         else
7600             offset = 0;
7601         if (MARK < SP)
7602             warn("Too many args on syswrite");
7603         length = write(fileno(IoIFP(io)), buffer+offset, length);
7604     }
7605 #ifdef HAS_SOCKET
7606     else if (SP >= MARK) {
7607         STRLEN mlen;
7608         if (SP > MARK)
7609             warn("Too many args on send");
7610         buffer = SvPVx(*++MARK, mlen);
7611         length = sendto(fileno(IoIFP(io)), buffer, blen, length,
7612                                 (struct sockaddr *)buffer, mlen);
7613     }
7614     else
7615         length = send(fileno(IoIFP(io)), buffer, blen, length);
7616 #else
7617     else
7618         DIE(no_sock_func, "send");
7619 #endif
7620     if (length < 0)
7621         goto say_undef;
7622     SP = ORIGMARK;
7623     PUSHi(length);
7624     RETURN;
7625
7626   say_undef:
7627     SP = ORIGMARK;
7628     RETPUSHUNDEF;
7629 }
7630
7631 PP(pp_recv)
7632 {
7633     return pp_sysread(ARGS);
7634 }
7635
7636 PP(pp_eof)
7637 {
7638     dSP;
7639     GV *gv;
7640
7641     if (MAXARG <= 0)
7642         gv = last_in_gv;
7643     else
7644         gv = last_in_gv = (GV*)POPs;
7645     PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no);
7646     RETURN;
7647 }
7648
7649 PP(pp_tell)
7650 {
7651     dSP; dTARGET;
7652     GV *gv;
7653
7654     if (MAXARG <= 0)
7655         gv = last_in_gv;
7656     else
7657         gv = last_in_gv = (GV*)POPs;
7658     PUSHi( do_tell(gv) );
7659     RETURN;
7660 }
7661
7662 PP(pp_seek)
7663 {
7664     dSP;
7665     GV *gv;
7666     int whence = POPi;
7667     long offset = POPl;
7668
7669     gv = last_in_gv = (GV*)POPs;
7670     PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no );
7671     RETURN;
7672 }
7673
7674 PP(pp_truncate)
7675 {
7676     dSP;
7677     Off_t len = (Off_t)POPn;
7678     int result = 1;
7679     GV *tmpgv;
7680
7681     errno = 0;
7682 #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE)
7683 #ifdef HAS_TRUNCATE
7684     if (op->op_flags & OPf_SPECIAL) {
7685         tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
7686         if (!tmpgv || !GvIO(tmpgv) || !IoIFP(GvIO(tmpgv)) ||
7687           ftruncate(fileno(IoIFP(GvIO(tmpgv))), len) < 0)
7688             result = 0;
7689     }
7690     else if (truncate(POPp, len) < 0)
7691         result = 0;
7692 #else
7693     if (op->op_flags & OPf_SPECIAL) {
7694         tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
7695         if (!tmpgv || !GvIO(tmpgv) || !IoIFP(GvIO(tmpgv)) ||
7696           chsize(fileno(IoIFP(GvIO(tmpgv))), len) < 0)
7697             result = 0;
7698     }
7699     else {
7700         int tmpfd;
7701
7702         if ((tmpfd = open(POPp, 0)) < 0)
7703             result = 0;
7704         else {
7705             if (chsize(tmpfd, len) < 0)
7706                 result = 0;
7707             close(tmpfd);
7708         }
7709     }
7710 #endif
7711
7712     if (result)
7713         RETPUSHYES;
7714     if (!errno)
7715         errno = EBADF;
7716     RETPUSHUNDEF;
7717 #else
7718     DIE("truncate not implemented");
7719 #endif
7720 }
7721
7722 PP(pp_fcntl)
7723 {
7724     return pp_ioctl(ARGS);
7725 }
7726
7727 PP(pp_ioctl)
7728 {
7729     dSP; dTARGET;
7730     SV *argstr = POPs;
7731     unsigned int func = U_I(POPn);
7732     int optype = op->op_type;
7733     char *s;
7734     int retval;
7735     GV *gv = (GV*)POPs;
7736     IO *io = GvIOn(gv);
7737
7738     if (!io || !argstr || !IoIFP(io)) {
7739         errno = EBADF;  /* well, sort of... */
7740         RETPUSHUNDEF;
7741     }
7742
7743     if (SvPOK(argstr) || !SvNIOK(argstr)) {
7744         STRLEN len = 0;
7745         if (!SvPOK(argstr))
7746             s = SvPV(argstr, len);
7747         retval = IOCPARM_LEN(func);
7748         if (len < retval) {
7749             Sv_Grow(argstr, retval+1);
7750             SvCUR_set(argstr, retval);
7751         }
7752
7753         s = SvPVX(argstr);
7754         s[SvCUR(argstr)] = 17;  /* a little sanity check here */
7755     }
7756     else {
7757         retval = SvIV(argstr);
7758 #ifdef DOSISH
7759         s = (char*)(long)retval;        /* ouch */
7760 #else
7761         s = (char*)retval;              /* ouch */
7762 #endif
7763     }
7764
7765     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
7766
7767     if (optype == OP_IOCTL)
7768         retval = ioctl(fileno(IoIFP(io)), func, s);
7769     else
7770 #ifdef DOSISH
7771         DIE("fcntl is not implemented");
7772 #else
7773 #   ifdef HAS_FCNTL
7774         retval = fcntl(fileno(IoIFP(io)), func, s);
7775 #   else
7776         DIE("fcntl is not implemented");
7777 #   endif
7778 #endif
7779
7780     if (SvPOK(argstr)) {
7781         if (s[SvCUR(argstr)] != 17)
7782             DIE("Possible memory corruption: %s overflowed 3rd argument",
7783                 op_name[optype]);
7784         s[SvCUR(argstr)] = 0;           /* put our null back */
7785     }
7786
7787     if (retval == -1)
7788         RETPUSHUNDEF;
7789     if (retval != 0) {
7790         PUSHi(retval);
7791     }
7792     else {
7793         PUSHp("0 but true", 10);
7794     }
7795     RETURN;
7796 }
7797
7798 PP(pp_flock)
7799 {
7800     dSP; dTARGET;
7801     I32 value;
7802     int argtype;
7803     GV *gv;
7804     FILE *fp;
7805 #ifdef HAS_FLOCK
7806     argtype = POPi;
7807     if (MAXARG <= 0)
7808         gv = last_in_gv;
7809     else
7810         gv = (GV*)POPs;
7811     if (gv && GvIO(gv))
7812         fp = IoIFP(GvIO(gv));
7813     else
7814         fp = Nullfp;
7815     if (fp) {
7816         value = (I32)(flock(fileno(fp), argtype) >= 0);
7817     }
7818     else
7819         value = 0;
7820     PUSHi(value);
7821     RETURN;
7822 #else
7823     DIE(no_func, "flock()");
7824 #endif
7825 }
7826
7827 /* Sockets. */
7828
7829 PP(pp_socket)
7830 {
7831     dSP;
7832 #ifdef HAS_SOCKET
7833     GV *gv;
7834     register IO *io;
7835     int protocol = POPi;
7836     int type = POPi;
7837     int domain = POPi;
7838     int fd;
7839
7840     gv = (GV*)POPs;
7841
7842     if (!gv) {
7843         errno = EBADF;
7844         RETPUSHUNDEF;
7845     }
7846
7847     io = GvIOn(gv);
7848     if (IoIFP(io))
7849         do_close(gv, FALSE);
7850
7851     TAINT_PROPER("socket");
7852     fd = socket(domain, type, protocol);
7853     if (fd < 0)
7854         RETPUSHUNDEF;
7855     IoIFP(io) = fdopen(fd, "r");        /* stdio gets confused about sockets */
7856     IoOFP(io) = fdopen(fd, "w");
7857     IoTYPE(io) = 's';
7858     if (!IoIFP(io) || !IoOFP(io)) {
7859         if (IoIFP(io)) fclose(IoIFP(io));
7860         if (IoOFP(io)) fclose(IoOFP(io));
7861         if (!IoIFP(io) && !IoOFP(io)) close(fd);
7862         RETPUSHUNDEF;
7863     }
7864
7865     RETPUSHYES;
7866 #else
7867     DIE(no_sock_func, "socket");
7868 #endif
7869 }
7870
7871 PP(pp_sockpair)
7872 {
7873     dSP;
7874 #ifdef HAS_SOCKETPAIR
7875     GV *gv1;
7876     GV *gv2;
7877     register IO *io1;
7878     register IO *io2;
7879     int protocol = POPi;
7880     int type = POPi;
7881     int domain = POPi;
7882     int fd[2];
7883
7884     gv2 = (GV*)POPs;
7885     gv1 = (GV*)POPs;
7886     if (!gv1 || !gv2)
7887         RETPUSHUNDEF;
7888
7889     io1 = GvIOn(gv1);
7890     io2 = GvIOn(gv2);
7891     if (IoIFP(io1))
7892         do_close(gv1, FALSE);
7893     if (IoIFP(io2))
7894         do_close(gv2, FALSE);
7895
7896     TAINT_PROPER("socketpair");
7897     if (socketpair(domain, type, protocol, fd) < 0)
7898         RETPUSHUNDEF;
7899     IoIFP(io1) = fdopen(fd[0], "r");
7900     IoOFP(io1) = fdopen(fd[0], "w");
7901     IoTYPE(io1) = 's';
7902     IoIFP(io2) = fdopen(fd[1], "r");
7903     IoOFP(io2) = fdopen(fd[1], "w");
7904     IoTYPE(io2) = 's';
7905     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
7906         if (IoIFP(io1)) fclose(IoIFP(io1));
7907         if (IoOFP(io1)) fclose(IoOFP(io1));
7908         if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
7909         if (IoIFP(io2)) fclose(IoIFP(io2));
7910         if (IoOFP(io2)) fclose(IoOFP(io2));
7911         if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
7912         RETPUSHUNDEF;
7913     }
7914
7915     RETPUSHYES;
7916 #else
7917     DIE(no_sock_func, "socketpair");
7918 #endif
7919 }
7920
7921 PP(pp_bind)
7922 {
7923     dSP;
7924 #ifdef HAS_SOCKET
7925     SV *addrstr = POPs;
7926     char *addr;
7927     GV *gv = (GV*)POPs;
7928     register IO *io = GvIOn(gv);
7929     STRLEN len;
7930
7931     if (!io || !IoIFP(io))
7932         goto nuts;
7933
7934     addr = SvPV(addrstr, len);
7935     TAINT_PROPER("bind");
7936     if (bind(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
7937         RETPUSHYES;
7938     else
7939         RETPUSHUNDEF;
7940
7941 nuts:
7942     if (dowarn)
7943         warn("bind() on closed fd");
7944     errno = EBADF;
7945     RETPUSHUNDEF;
7946 #else
7947     DIE(no_sock_func, "bind");
7948 #endif
7949 }
7950
7951 PP(pp_connect)
7952 {
7953     dSP;
7954 #ifdef HAS_SOCKET
7955     SV *addrstr = POPs;
7956     char *addr;
7957     GV *gv = (GV*)POPs;
7958     register IO *io = GvIOn(gv);
7959     STRLEN len;
7960
7961     if (!io || !IoIFP(io))
7962         goto nuts;
7963
7964     addr = SvPV(addrstr, len);
7965     TAINT_PROPER("connect");
7966     if (connect(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
7967         RETPUSHYES;
7968     else
7969         RETPUSHUNDEF;
7970
7971 nuts:
7972     if (dowarn)
7973         warn("connect() on closed fd");
7974     errno = EBADF;
7975     RETPUSHUNDEF;
7976 #else
7977     DIE(no_sock_func, "connect");
7978 #endif
7979 }
7980
7981 PP(pp_listen)
7982 {
7983     dSP;
7984 #ifdef HAS_SOCKET
7985     int backlog = POPi;
7986     GV *gv = (GV*)POPs;
7987     register IO *io = GvIOn(gv);
7988
7989     if (!io || !IoIFP(io))
7990         goto nuts;
7991
7992     if (listen(fileno(IoIFP(io)), backlog) >= 0)
7993         RETPUSHYES;
7994     else
7995         RETPUSHUNDEF;
7996
7997 nuts:
7998     if (dowarn)
7999         warn("listen() on closed fd");
8000     errno = EBADF;
8001     RETPUSHUNDEF;
8002 #else
8003     DIE(no_sock_func, "listen");
8004 #endif
8005 }
8006
8007 PP(pp_accept)
8008 {
8009     dSP; dTARGET;
8010 #ifdef HAS_SOCKET
8011     GV *ngv;
8012     GV *ggv;
8013     register IO *nstio;
8014     register IO *gstio;
8015     int len = sizeof buf;
8016     int fd;
8017
8018     ggv = (GV*)POPs;
8019     ngv = (GV*)POPs;
8020
8021     if (!ngv)
8022         goto badexit;
8023     if (!ggv)
8024         goto nuts;
8025
8026     gstio = GvIO(ggv);
8027     if (!gstio || !IoIFP(gstio))
8028         goto nuts;
8029
8030     nstio = GvIOn(ngv);
8031     if (IoIFP(nstio))
8032         do_close(ngv, FALSE);
8033
8034     fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)buf, &len);
8035     if (fd < 0)
8036         goto badexit;
8037     IoIFP(nstio) = fdopen(fd, "r");
8038     IoOFP(nstio) = fdopen(fd, "w");
8039     IoTYPE(nstio) = 's';
8040     if (!IoIFP(nstio) || !IoOFP(nstio)) {
8041         if (IoIFP(nstio)) fclose(IoIFP(nstio));
8042         if (IoOFP(nstio)) fclose(IoOFP(nstio));
8043         if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
8044         goto badexit;
8045     }
8046
8047     PUSHp(buf, len);
8048     RETURN;
8049
8050 nuts:
8051     if (dowarn)
8052         warn("accept() on closed fd");
8053     errno = EBADF;
8054
8055 badexit:
8056     RETPUSHUNDEF;
8057
8058 #else
8059     DIE(no_sock_func, "accept");
8060 #endif
8061 }
8062
8063 PP(pp_shutdown)
8064 {
8065     dSP; dTARGET;
8066 #ifdef HAS_SOCKET
8067     int how = POPi;
8068     GV *gv = (GV*)POPs;
8069     register IO *io = GvIOn(gv);
8070
8071     if (!io || !IoIFP(io))
8072         goto nuts;
8073
8074     PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 );
8075     RETURN;
8076
8077 nuts:
8078     if (dowarn)
8079         warn("shutdown() on closed fd");
8080     errno = EBADF;
8081     RETPUSHUNDEF;
8082 #else
8083     DIE(no_sock_func, "shutdown");
8084 #endif
8085 }
8086
8087 PP(pp_gsockopt)
8088 {
8089 #ifdef HAS_SOCKET
8090     return pp_ssockopt(ARGS);
8091 #else
8092     DIE(no_sock_func, "getsockopt");
8093 #endif
8094 }
8095
8096 PP(pp_ssockopt)
8097 {
8098     dSP;
8099 #ifdef HAS_SOCKET
8100     int optype = op->op_type;
8101     SV *sv;
8102     int fd;
8103     unsigned int optname;
8104     unsigned int lvl;
8105     GV *gv;
8106     register IO *io;
8107
8108     if (optype == OP_GSOCKOPT)
8109         sv = sv_2mortal(NEWSV(22, 257));
8110     else
8111         sv = POPs;
8112     optname = (unsigned int) POPi;
8113     lvl = (unsigned int) POPi;
8114
8115     gv = (GV*)POPs;
8116     io = GvIOn(gv);
8117     if (!io || !IoIFP(io))
8118         goto nuts;
8119
8120     fd = fileno(IoIFP(io));
8121     switch (optype) {
8122     case OP_GSOCKOPT:
8123         SvCUR_set(sv, 256);
8124         SvPOK_only(sv);
8125         if (getsockopt(fd, lvl, optname, SvPVX(sv), (int*)&SvCUR(sv)) < 0)
8126             goto nuts2;
8127         PUSHs(sv);
8128         break;
8129     case OP_SSOCKOPT:
8130         if (setsockopt(fd, lvl, optname, SvPVX(sv), SvCUR(sv)) < 0)
8131             goto nuts2;
8132         PUSHs(&sv_yes);
8133         break;
8134     }
8135     RETURN;
8136
8137 nuts:
8138     if (dowarn)
8139         warn("[gs]etsockopt() on closed fd");
8140     errno = EBADF;
8141 nuts2:
8142     RETPUSHUNDEF;
8143
8144 #else
8145     DIE(no_sock_func, "setsockopt");
8146 #endif
8147 }
8148
8149 PP(pp_getsockname)
8150 {
8151 #ifdef HAS_SOCKET
8152     return pp_getpeername(ARGS);
8153 #else
8154     DIE(no_sock_func, "getsockname");
8155 #endif
8156 }
8157
8158 PP(pp_getpeername)
8159 {
8160     dSP;
8161 #ifdef HAS_SOCKET
8162     int optype = op->op_type;
8163     SV *sv;
8164     int fd;
8165     GV *gv = (GV*)POPs;
8166     register IO *io = GvIOn(gv);
8167
8168     if (!io || !IoIFP(io))
8169         goto nuts;
8170
8171     sv = sv_2mortal(NEWSV(22, 257));
8172     SvCUR_set(sv, 256);
8173     SvPOK_on(sv);
8174     fd = fileno(IoIFP(io));
8175     switch (optype) {
8176     case OP_GETSOCKNAME:
8177         if (getsockname(fd, (struct sockaddr *)SvPVX(sv), (int*)&SvCUR(sv)) < 0)
8178             goto nuts2;
8179         break;
8180     case OP_GETPEERNAME:
8181         if (getpeername(fd, (struct sockaddr *)SvPVX(sv), (int*)&SvCUR(sv)) < 0)
8182             goto nuts2;
8183         break;
8184     }
8185     PUSHs(sv);
8186     RETURN;
8187
8188 nuts:
8189     if (dowarn)
8190         warn("get{sock, peer}name() on closed fd");
8191     errno = EBADF;
8192 nuts2:
8193     RETPUSHUNDEF;
8194
8195 #else
8196     DIE(no_sock_func, "getpeername");
8197 #endif
8198 }
8199
8200 /* Stat calls. */
8201
8202 PP(pp_lstat)
8203 {
8204     return pp_stat(ARGS);
8205 }
8206
8207 PP(pp_stat)
8208 {
8209     dSP;
8210     GV *tmpgv;
8211     I32 max = 13;
8212
8213     if (op->op_flags & OPf_SPECIAL) {
8214         tmpgv = cGVOP->op_gv;
8215         if (tmpgv != defgv) {
8216             laststype = OP_STAT;
8217             statgv = tmpgv;
8218             sv_setpv(statname, "");
8219             if (!GvIO(tmpgv) || !IoIFP(GvIO(tmpgv)) ||
8220               fstat(fileno(IoIFP(GvIO(tmpgv))), &statcache) < 0) {
8221                 max = 0;
8222                 laststatval = -1;
8223             }
8224         }
8225         else if (laststatval < 0)
8226             max = 0;
8227     }
8228     else {
8229         sv_setpv(statname, POPp);
8230         statgv = Nullgv;
8231 #ifdef HAS_LSTAT
8232         laststype = op->op_type;
8233         if (op->op_type == OP_LSTAT)
8234             laststatval = lstat(SvPV(statname, na), &statcache);
8235         else
8236 #endif
8237             laststatval = stat(SvPV(statname, na), &statcache);
8238         if (laststatval < 0) {
8239             if (dowarn && strchr(SvPV(statname, na), '\n'))
8240                 warn(warn_nl, "stat");
8241             max = 0;
8242         }
8243     }
8244
8245     EXTEND(SP, 13);
8246     if (GIMME != G_ARRAY) {
8247         if (max)
8248             RETPUSHYES;
8249         else
8250             RETPUSHUNDEF;
8251     }
8252     if (max) {
8253         PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
8254         PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
8255         PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
8256         PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
8257         PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
8258         PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
8259         PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
8260         PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
8261         PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime)));
8262         PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
8263         PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime)));
8264 #ifdef USE_STAT_BLOCKS
8265         PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
8266         PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
8267 #else
8268         PUSHs(sv_2mortal(newSVpv("", 0)));
8269         PUSHs(sv_2mortal(newSVpv("", 0)));
8270 #endif
8271     }
8272     RETURN;
8273 }
8274
8275 PP(pp_ftrread)
8276 {
8277     I32 result = my_stat(ARGS);
8278     dSP;
8279     if (result < 0)
8280         RETPUSHUNDEF;
8281     if (cando(S_IRUSR, 0, &statcache))
8282         RETPUSHYES;
8283     RETPUSHNO;
8284 }
8285
8286 PP(pp_ftrwrite)
8287 {
8288     I32 result = my_stat(ARGS);
8289     dSP;
8290     if (result < 0)
8291         RETPUSHUNDEF;
8292     if (cando(S_IWUSR, 0, &statcache))
8293         RETPUSHYES;
8294     RETPUSHNO;
8295 }
8296
8297 PP(pp_ftrexec)
8298 {
8299     I32 result = my_stat(ARGS);
8300     dSP;
8301     if (result < 0)
8302         RETPUSHUNDEF;
8303     if (cando(S_IXUSR, 0, &statcache))
8304         RETPUSHYES;
8305     RETPUSHNO;
8306 }
8307
8308 PP(pp_fteread)
8309 {
8310     I32 result = my_stat(ARGS);
8311     dSP;
8312     if (result < 0)
8313         RETPUSHUNDEF;
8314     if (cando(S_IRUSR, 1, &statcache))
8315         RETPUSHYES;
8316     RETPUSHNO;
8317 }
8318
8319 PP(pp_ftewrite)
8320 {
8321     I32 result = my_stat(ARGS);
8322     dSP;
8323     if (result < 0)
8324         RETPUSHUNDEF;
8325     if (cando(S_IWUSR, 1, &statcache))
8326         RETPUSHYES;
8327     RETPUSHNO;
8328 }
8329
8330 PP(pp_fteexec)
8331 {
8332     I32 result = my_stat(ARGS);
8333     dSP;
8334     if (result < 0)
8335         RETPUSHUNDEF;
8336     if (cando(S_IXUSR, 1, &statcache))
8337         RETPUSHYES;
8338     RETPUSHNO;
8339 }
8340
8341 PP(pp_ftis)
8342 {
8343     I32 result = my_stat(ARGS);
8344     dSP;
8345     if (result < 0)
8346         RETPUSHUNDEF;
8347     RETPUSHYES;
8348 }
8349
8350 PP(pp_fteowned)
8351 {
8352     return pp_ftrowned(ARGS);
8353 }
8354
8355 PP(pp_ftrowned)
8356 {
8357     I32 result = my_stat(ARGS);
8358     dSP;
8359     if (result < 0)
8360         RETPUSHUNDEF;
8361     if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
8362         RETPUSHYES;
8363     RETPUSHNO;
8364 }
8365
8366 PP(pp_ftzero)
8367 {
8368     I32 result = my_stat(ARGS);
8369     dSP;
8370     if (result < 0)
8371         RETPUSHUNDEF;
8372     if (!statcache.st_size)
8373         RETPUSHYES;
8374     RETPUSHNO;
8375 }
8376
8377 PP(pp_ftsize)
8378 {
8379     I32 result = my_stat(ARGS);
8380     dSP; dTARGET;
8381     if (result < 0)
8382         RETPUSHUNDEF;
8383     PUSHi(statcache.st_size);
8384     RETURN;
8385 }
8386
8387 PP(pp_ftmtime)
8388 {
8389     I32 result = my_stat(ARGS);
8390     dSP; dTARGET;
8391     if (result < 0)
8392         RETPUSHUNDEF;
8393     PUSHn( (basetime - statcache.st_mtime) / 86400.0 );
8394     RETURN;
8395 }
8396
8397 PP(pp_ftatime)
8398 {
8399     I32 result = my_stat(ARGS);
8400     dSP; dTARGET;
8401     if (result < 0)
8402         RETPUSHUNDEF;
8403     PUSHn( (basetime - statcache.st_atime) / 86400.0 );
8404     RETURN;
8405 }
8406
8407 PP(pp_ftctime)
8408 {
8409     I32 result = my_stat(ARGS);
8410     dSP; dTARGET;
8411     if (result < 0)
8412         RETPUSHUNDEF;
8413     PUSHn( (basetime - statcache.st_ctime) / 86400.0 );
8414     RETURN;
8415 }
8416
8417 PP(pp_ftsock)
8418 {
8419     I32 result = my_stat(ARGS);
8420     dSP;
8421     if (result < 0)
8422         RETPUSHUNDEF;
8423     if (S_ISSOCK(statcache.st_mode))
8424         RETPUSHYES;
8425     RETPUSHNO;
8426 }
8427
8428 PP(pp_ftchr)
8429 {
8430     I32 result = my_stat(ARGS);
8431     dSP;
8432     if (result < 0)
8433         RETPUSHUNDEF;
8434     if (S_ISCHR(statcache.st_mode))
8435         RETPUSHYES;
8436     RETPUSHNO;
8437 }
8438
8439 PP(pp_ftblk)
8440 {
8441     I32 result = my_stat(ARGS);
8442     dSP;
8443     if (result < 0)
8444         RETPUSHUNDEF;
8445     if (S_ISBLK(statcache.st_mode))
8446         RETPUSHYES;
8447     RETPUSHNO;
8448 }
8449
8450 PP(pp_ftfile)
8451 {
8452     I32 result = my_stat(ARGS);
8453     dSP;
8454     if (result < 0)
8455         RETPUSHUNDEF;
8456     if (S_ISREG(statcache.st_mode))
8457         RETPUSHYES;
8458     RETPUSHNO;
8459 }
8460
8461 PP(pp_ftdir)
8462 {
8463     I32 result = my_stat(ARGS);
8464     dSP;
8465     if (result < 0)
8466         RETPUSHUNDEF;
8467     if (S_ISDIR(statcache.st_mode))
8468         RETPUSHYES;
8469     RETPUSHNO;
8470 }
8471
8472 PP(pp_ftpipe)
8473 {
8474     I32 result = my_stat(ARGS);
8475     dSP;
8476     if (result < 0)
8477         RETPUSHUNDEF;
8478     if (S_ISFIFO(statcache.st_mode))
8479         RETPUSHYES;
8480     RETPUSHNO;
8481 }
8482
8483 PP(pp_ftlink)
8484 {
8485     I32 result = my_lstat(ARGS);
8486     dSP;
8487     if (result < 0)
8488         RETPUSHUNDEF;
8489     if (S_ISLNK(statcache.st_mode))
8490         RETPUSHYES;
8491     RETPUSHNO;
8492 }
8493
8494 PP(pp_ftsuid)
8495 {
8496     dSP;
8497 #ifdef S_ISUID
8498     I32 result = my_stat(ARGS);
8499     SPAGAIN;
8500     if (result < 0)
8501         RETPUSHUNDEF;
8502     if (statcache.st_mode & S_ISUID)
8503         RETPUSHYES;
8504 #endif
8505     RETPUSHNO;
8506 }
8507
8508 PP(pp_ftsgid)
8509 {
8510     dSP;
8511 #ifdef S_ISGID
8512     I32 result = my_stat(ARGS);
8513     SPAGAIN;
8514     if (result < 0)
8515         RETPUSHUNDEF;
8516     if (statcache.st_mode & S_ISGID)
8517         RETPUSHYES;
8518 #endif
8519     RETPUSHNO;
8520 }
8521
8522 PP(pp_ftsvtx)
8523 {
8524     dSP;
8525 #ifdef S_ISVTX
8526     I32 result = my_stat(ARGS);
8527     SPAGAIN;
8528     if (result < 0)
8529         RETPUSHUNDEF;
8530     if (statcache.st_mode & S_ISVTX)
8531         RETPUSHYES;
8532 #endif
8533     RETPUSHNO;
8534 }
8535
8536 PP(pp_fttty)
8537 {
8538     dSP;
8539     int fd;
8540     GV *gv;
8541     char *tmps;
8542     if (op->op_flags & OPf_SPECIAL) {
8543         gv = cGVOP->op_gv;
8544         tmps = "";
8545     }
8546     else
8547         gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
8548     if (gv && GvIO(gv) && IoIFP(GvIO(gv)))
8549         fd = fileno(IoIFP(GvIO(gv)));
8550     else if (isDIGIT(*tmps))
8551         fd = atoi(tmps);
8552     else
8553         RETPUSHUNDEF;
8554     if (isatty(fd))
8555         RETPUSHYES;
8556     RETPUSHNO;
8557 }
8558
8559 PP(pp_fttext)
8560 {
8561     dSP;
8562     I32 i;
8563     I32 len;
8564     I32 odd = 0;
8565     STDCHAR tbuf[512];
8566     register STDCHAR *s;
8567     register IO *io;
8568     SV *sv;
8569
8570     if (op->op_flags & OPf_SPECIAL) {
8571         EXTEND(SP, 1);
8572         if (cGVOP->op_gv == defgv) {
8573             if (statgv)
8574                 io = GvIO(statgv);
8575             else {
8576                 sv = statname;
8577                 goto really_filename;
8578             }
8579         }
8580         else {
8581             statgv = cGVOP->op_gv;
8582             sv_setpv(statname, "");
8583             io = GvIO(statgv);
8584         }
8585         if (io && IoIFP(io)) {
8586 #if defined(USE_STD_STDIO) || defined(atarist) /* this will work with atariST */
8587             fstat(fileno(IoIFP(io)), &statcache);
8588             if (S_ISDIR(statcache.st_mode))     /* handle NFS glitch */
8589                 if (op->op_type == OP_FTTEXT)
8590                     RETPUSHNO;
8591                 else
8592                     RETPUSHYES;
8593             if (IoIFP(io)->_cnt <= 0) {
8594                 i = getc(IoIFP(io));
8595                 if (i != EOF)
8596                     (void)ungetc(i, IoIFP(io));
8597             }
8598             if (IoIFP(io)->_cnt <= 0)   /* null file is anything */
8599                 RETPUSHYES;
8600             len = IoIFP(io)->_cnt + (IoIFP(io)->_ptr - IoIFP(io)->_base);
8601             s = IoIFP(io)->_base;
8602 #else
8603             DIE("-T and -B not implemented on filehandles");
8604 #endif
8605         }
8606         else {
8607             if (dowarn)
8608                 warn("Test on unopened file <%s>",
8609                   GvENAME(cGVOP->op_gv));
8610             errno = EBADF;
8611             RETPUSHUNDEF;
8612         }
8613     }
8614     else {
8615         sv = POPs;
8616         statgv = Nullgv;
8617         sv_setpv(statname, SvPV(sv, na));
8618       really_filename:
8619         i = open(SvPV(sv, na), 0);
8620         if (i < 0) {
8621             if (dowarn && strchr(SvPV(sv, na), '\n'))
8622                 warn(warn_nl, "open");
8623             RETPUSHUNDEF;
8624         }
8625         fstat(i, &statcache);
8626         len = read(i, tbuf, 512);
8627         (void)close(i);
8628         if (len <= 0) {
8629             if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
8630                 RETPUSHNO;              /* special case NFS directories */
8631             RETPUSHYES;         /* null file is anything */
8632         }
8633         s = tbuf;
8634     }
8635
8636     /* now scan s to look for textiness */
8637
8638     for (i = 0; i < len; i++, s++) {
8639         if (!*s) {                      /* null never allowed in text */
8640             odd += len;
8641             break;
8642         }
8643         else if (*s & 128)
8644             odd++;
8645         else if (*s < 32 &&
8646           *s != '\n' && *s != '\r' && *s != '\b' &&
8647           *s != '\t' && *s != '\f' && *s != 27)
8648             odd++;
8649     }
8650
8651     if ((odd * 10 > len) == (op->op_type == OP_FTTEXT)) /* allow 10% odd */
8652         RETPUSHNO;
8653     else
8654         RETPUSHYES;
8655 }
8656
8657 PP(pp_ftbinary)
8658 {
8659     return pp_fttext(ARGS);
8660 }
8661
8662 /* File calls. */
8663
8664 PP(pp_chdir)
8665 {
8666     dSP; dTARGET;
8667     double value;
8668     char *tmps;
8669     SV **svp;
8670
8671     if (MAXARG < 1)
8672         tmps = Nullch;
8673     else
8674         tmps = POPp;
8675     if (!tmps || !*tmps) {
8676         svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE);
8677         if (svp)
8678             tmps = SvPV(*svp, na);
8679     }
8680     if (!tmps || !*tmps) {
8681         svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE);
8682         if (svp)
8683             tmps = SvPV(*svp, na);
8684     }
8685     TAINT_PROPER("chdir");
8686     PUSHi( chdir(tmps) >= 0 );
8687     RETURN;
8688 }
8689
8690 PP(pp_chown)
8691 {
8692     dSP; dMARK; dTARGET;
8693     I32 value;
8694 #ifdef HAS_CHOWN
8695     value = (I32)apply(op->op_type, MARK, SP);
8696     SP = MARK;
8697     PUSHi(value);
8698     RETURN;
8699 #else
8700     DIE(no_func, "Unsupported function chown");
8701 #endif
8702 }
8703
8704 PP(pp_chroot)
8705 {
8706     dSP; dTARGET;
8707     char *tmps;
8708 #ifdef HAS_CHROOT
8709     if (MAXARG < 1)
8710         tmps = SvPVx(GvSV(defgv), na);
8711     else
8712         tmps = POPp;
8713     TAINT_PROPER("chroot");
8714     PUSHi( chroot(tmps) >= 0 );
8715     RETURN;
8716 #else
8717     DIE(no_func, "chroot");
8718 #endif
8719 }
8720
8721 PP(pp_unlink)
8722 {
8723     dSP; dMARK; dTARGET;
8724     I32 value;
8725     value = (I32)apply(op->op_type, MARK, SP);
8726     SP = MARK;
8727     PUSHi(value);
8728     RETURN;
8729 }
8730
8731 PP(pp_chmod)
8732 {
8733     dSP; dMARK; dTARGET;
8734     I32 value;
8735     value = (I32)apply(op->op_type, MARK, SP);
8736     SP = MARK;
8737     PUSHi(value);
8738     RETURN;
8739 }
8740
8741 PP(pp_utime)
8742 {
8743     dSP; dMARK; dTARGET;
8744     I32 value;
8745     value = (I32)apply(op->op_type, MARK, SP);
8746     SP = MARK;
8747     PUSHi(value);
8748     RETURN;
8749 }
8750
8751 PP(pp_rename)
8752 {
8753     dSP; dTARGET;
8754     int anum;
8755
8756     char *tmps2 = POPp;
8757     char *tmps = SvPV(TOPs, na);
8758     TAINT_PROPER("rename");
8759 #ifdef HAS_RENAME
8760     anum = rename(tmps, tmps2);
8761 #else
8762     if (same_dirent(tmps2, tmps))       /* can always rename to same name */
8763         anum = 1;
8764     else {
8765         if (euid || stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
8766             (void)UNLINK(tmps2);
8767         if (!(anum = link(tmps, tmps2)))
8768             anum = UNLINK(tmps);
8769     }
8770 #endif
8771     SETi( anum >= 0 );
8772     RETURN;
8773 }
8774
8775 PP(pp_link)
8776 {
8777     dSP; dTARGET;
8778 #ifdef HAS_LINK
8779     char *tmps2 = POPp;
8780     char *tmps = SvPV(TOPs, na);
8781     TAINT_PROPER("link");
8782     SETi( link(tmps, tmps2) >= 0 );
8783 #else
8784     DIE(no_func, "Unsupported function link");
8785 #endif
8786     RETURN;
8787 }
8788
8789 PP(pp_symlink)
8790 {
8791     dSP; dTARGET;
8792 #ifdef HAS_SYMLINK
8793     char *tmps2 = POPp;
8794     char *tmps = SvPV(TOPs, na);
8795     TAINT_PROPER("symlink");
8796     SETi( symlink(tmps, tmps2) >= 0 );
8797     RETURN;
8798 #else
8799     DIE(no_func, "symlink");
8800 #endif
8801 }
8802
8803 PP(pp_readlink)
8804 {
8805     dSP; dTARGET;
8806 #ifdef HAS_SYMLINK
8807     char *tmps;
8808     int len;
8809     if (MAXARG < 1)
8810         tmps = SvPVx(GvSV(defgv), na);
8811     else
8812         tmps = POPp;
8813     len = readlink(tmps, buf, sizeof buf);
8814     EXTEND(SP, 1);
8815     if (len < 0)
8816         RETPUSHUNDEF;
8817     PUSHp(buf, len);
8818     RETURN;
8819 #else
8820     EXTEND(SP, 1);
8821     RETSETUNDEF;                /* just pretend it's a normal file */
8822 #endif
8823 }
8824
8825 #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
8826 static void
8827 dooneliner(cmd, filename)
8828 char *cmd;
8829 char *filename;
8830 {
8831     char mybuf[8192];
8832     char *s;
8833     int anum = 1;
8834     FILE *myfp;
8835
8836     strcpy(mybuf, cmd);
8837     strcat(mybuf, " ");
8838     for (s = mybuf+strlen(mybuf); *filename; ) {
8839         *s++ = '\\';
8840         *s++ = *filename++;
8841     }
8842     strcpy(s, " 2>&1");
8843     myfp = my_popen(mybuf, "r");
8844     if (myfp) {
8845         *mybuf = '\0';
8846         s = fgets(mybuf, sizeof mybuf, myfp);
8847         (void)my_pclose(myfp);
8848         if (s != Nullch) {
8849             for (errno = 1; errno < sys_nerr; errno++) {
8850                 if (instr(mybuf, sys_errlist[errno]))   /* you don't see this */
8851                     return 0;
8852             }
8853             errno = 0;
8854 #ifndef EACCES
8855 #define EACCES EPERM
8856 #endif
8857             if (instr(mybuf, "cannot make"))
8858                 errno = EEXIST;
8859             else if (instr(mybuf, "existing file"))
8860                 errno = EEXIST;
8861             else if (instr(mybuf, "ile exists"))
8862                 errno = EEXIST;
8863             else if (instr(mybuf, "non-exist"))
8864                 errno = ENOENT;
8865             else if (instr(mybuf, "does not exist"))
8866                 errno = ENOENT;
8867             else if (instr(mybuf, "not empty"))
8868                 errno = EBUSY;
8869             else if (instr(mybuf, "cannot access"))
8870                 errno = EACCES;
8871             else
8872                 errno = EPERM;
8873             return 0;
8874         }
8875         else {  /* some mkdirs return no failure indication */
8876             tmps = SvPVx(st[1], na);
8877             anum = (stat(tmps, &statbuf) >= 0);
8878             if (op->op_type == OP_RMDIR)
8879                 anum = !anum;
8880             if (anum)
8881                 errno = 0;
8882             else
8883                 errno = EACCES; /* a guess */
8884         }
8885         return anum;
8886     }
8887     else
8888         return 0;
8889 }
8890 #endif
8891
8892 PP(pp_mkdir)
8893 {
8894     dSP; dTARGET;
8895     int mode = POPi;
8896     int oldumask;
8897     char *tmps = SvPV(TOPs, na);
8898
8899     TAINT_PROPER("mkdir");
8900 #ifdef HAS_MKDIR
8901     SETi( mkdir(tmps, mode) >= 0 );
8902 #else
8903     SETi( dooneliner("mkdir", tmps) );
8904     oldumask = umask(0)
8905     umask(oldumask);
8906     chmod(tmps, (mode & ~oldumask) & 0777);
8907 #endif
8908     RETURN;
8909 }
8910
8911 PP(pp_rmdir)
8912 {
8913     dSP; dTARGET;
8914     char *tmps;
8915
8916     if (MAXARG < 1)
8917         tmps = SvPVx(GvSV(defgv), na);
8918     else
8919         tmps = POPp;
8920     TAINT_PROPER("rmdir");
8921 #ifdef HAS_RMDIR
8922     XPUSHi( rmdir(tmps) >= 0 );
8923 #else
8924     XPUSHi( dooneliner("rmdir", tmps) );
8925 #endif
8926     RETURN;
8927 }
8928
8929 /* Directory calls. */
8930
8931 PP(pp_open_dir)
8932 {
8933     dSP;
8934 #if defined(DIRENT) && defined(HAS_READDIR)
8935     char *dirname = POPp;
8936     GV *gv = (GV*)POPs;
8937     register IO *io = GvIOn(gv);
8938
8939     if (!io)
8940         goto nope;
8941
8942     if (IoDIRP(io))
8943         closedir(IoDIRP(io));
8944     if (!(IoDIRP(io) = opendir(dirname)))
8945         goto nope;
8946
8947     RETPUSHYES;
8948 nope:
8949     if (!errno)
8950         errno = EBADF;
8951     RETPUSHUNDEF;
8952 #else
8953     DIE(no_dir_func, "opendir");
8954 #endif
8955 }
8956
8957 PP(pp_readdir)
8958 {
8959     dSP;
8960 #if defined(DIRENT) && defined(HAS_READDIR)
8961 #ifndef I_DIRENT
8962     struct DIRENT *readdir P((DIR *)); /* XXX is this *ever* needed? */
8963 #endif
8964     register struct DIRENT *dp;
8965     GV *gv = (GV*)POPs;
8966     register IO *io = GvIOn(gv);
8967
8968     if (!io || !IoDIRP(io))
8969         goto nope;
8970
8971     if (GIMME == G_ARRAY) {
8972         /*SUPPRESS 560*/
8973         while (dp = (struct DIRENT *)readdir(IoDIRP(io))) {
8974 #ifdef DIRNAMLEN
8975             XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
8976 #else
8977             XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
8978 #endif
8979         }
8980     }
8981     else {
8982         if (!(dp = (struct DIRENT *)readdir(IoDIRP(io))))
8983             goto nope;
8984 #ifdef DIRNAMLEN
8985         XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
8986 #else
8987         XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
8988 #endif
8989     }
8990     RETURN;
8991
8992 nope:
8993     if (!errno)
8994         errno = EBADF;
8995     if (GIMME == G_ARRAY)
8996         RETURN;
8997     else
8998         RETPUSHUNDEF;
8999 #else
9000     DIE(no_dir_func, "readdir");
9001 #endif
9002 }
9003
9004 PP(pp_telldir)
9005 {
9006     dSP; dTARGET;
9007 #if defined(HAS_TELLDIR) || defined(telldir)
9008 #ifndef telldir
9009     long telldir();
9010 #endif
9011     GV *gv = (GV*)POPs;
9012     register IO *io = GvIOn(gv);
9013
9014     if (!io || !IoDIRP(io))
9015         goto nope;
9016
9017     PUSHi( telldir(IoDIRP(io)) );
9018     RETURN;
9019 nope:
9020     if (!errno)
9021         errno = EBADF;
9022     RETPUSHUNDEF;
9023 #else
9024     DIE(no_dir_func, "telldir");
9025 #endif
9026 }
9027
9028 PP(pp_seekdir)
9029 {
9030     dSP;
9031 #if defined(HAS_SEEKDIR) || defined(seekdir)
9032     long along = POPl;
9033     GV *gv = (GV*)POPs;
9034     register IO *io = GvIOn(gv);
9035
9036     if (!io || !IoDIRP(io))
9037         goto nope;
9038
9039     (void)seekdir(IoDIRP(io), along);
9040
9041     RETPUSHYES;
9042 nope:
9043     if (!errno)
9044         errno = EBADF;
9045     RETPUSHUNDEF;
9046 #else
9047     DIE(no_dir_func, "seekdir");
9048 #endif
9049 }
9050
9051 PP(pp_rewinddir)
9052 {
9053     dSP;
9054 #if defined(HAS_REWINDDIR) || defined(rewinddir)
9055     GV *gv = (GV*)POPs;
9056     register IO *io = GvIOn(gv);
9057
9058     if (!io || !IoDIRP(io))
9059         goto nope;
9060
9061     (void)rewinddir(IoDIRP(io));
9062     RETPUSHYES;
9063 nope:
9064     if (!errno)
9065         errno = EBADF;
9066     RETPUSHUNDEF;
9067 #else
9068     DIE(no_dir_func, "rewinddir");
9069 #endif
9070 }
9071
9072 PP(pp_closedir)
9073 {
9074     dSP;
9075 #if defined(DIRENT) && defined(HAS_READDIR)
9076     GV *gv = (GV*)POPs;
9077     register IO *io = GvIOn(gv);
9078
9079     if (!io || !IoDIRP(io))
9080         goto nope;
9081
9082     if (closedir(IoDIRP(io)) < 0)
9083         goto nope;
9084     IoDIRP(io) = 0;
9085
9086     RETPUSHYES;
9087 nope:
9088     if (!errno)
9089         errno = EBADF;
9090     RETPUSHUNDEF;
9091 #else
9092     DIE(no_dir_func, "closedir");
9093 #endif
9094 }
9095
9096 /* Process control. */
9097
9098 PP(pp_fork)
9099 {
9100     dSP; dTARGET;
9101     int childpid;
9102     GV *tmpgv;
9103
9104     EXTEND(SP, 1);
9105 #ifdef HAS_FORK
9106     childpid = fork();
9107     if (childpid < 0)
9108         RETSETUNDEF;
9109     if (!childpid) {
9110         /*SUPPRESS 560*/
9111         if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
9112             sv_setiv(GvSV(tmpgv), (I32)getpid());
9113         hv_clear(pidstatus);    /* no kids, so don't wait for 'em */
9114     }
9115     PUSHi(childpid);
9116     RETURN;
9117 #else
9118     DIE(no_func, "Unsupported function fork");
9119 #endif
9120 }
9121
9122 PP(pp_wait)
9123 {
9124     dSP; dTARGET;
9125     int childpid;
9126     int argflags;
9127     I32 value;
9128
9129     EXTEND(SP, 1);
9130 #ifdef HAS_WAIT
9131     childpid = wait(&argflags);
9132     if (childpid > 0)
9133         pidgone(childpid, argflags);
9134     value = (I32)childpid;
9135     statusvalue = (U16)argflags;
9136     PUSHi(value);
9137     RETURN;
9138 #else
9139     DIE(no_func, "Unsupported function wait");
9140 #endif
9141 }
9142
9143 PP(pp_waitpid)
9144 {
9145     dSP; dTARGET;
9146     int childpid;
9147     int optype;
9148     int argflags;
9149     I32 value;
9150
9151 #ifdef HAS_WAIT
9152     optype = POPi;
9153     childpid = TOPi;
9154     childpid = wait4pid(childpid, &argflags, optype);
9155     value = (I32)childpid;
9156     statusvalue = (U16)argflags;
9157     SETi(value);
9158     RETURN;
9159 #else
9160     DIE(no_func, "Unsupported function wait");
9161 #endif
9162 }
9163
9164 PP(pp_system)
9165 {
9166     dSP; dMARK; dORIGMARK; dTARGET;
9167     I32 value;
9168     int childpid;
9169     int result;
9170     int status;
9171     VOIDRET (*ihand)();     /* place to save signal during system() */
9172     VOIDRET (*qhand)();     /* place to save signal during system() */
9173
9174 #ifdef HAS_FORK
9175     if (SP - MARK == 1) {
9176         if (tainting) {
9177             char *junk = SvPV(TOPs, na);
9178             TAINT_ENV();
9179             TAINT_PROPER("system");
9180         }
9181     }
9182     while ((childpid = vfork()) == -1) {
9183         if (errno != EAGAIN) {
9184             value = -1;
9185             SP = ORIGMARK;
9186             PUSHi(value);
9187             RETURN;
9188         }
9189         sleep(5);
9190     }
9191     if (childpid > 0) {
9192         ihand = signal(SIGINT, SIG_IGN);
9193         qhand = signal(SIGQUIT, SIG_IGN);
9194         result = wait4pid(childpid, &status, 0);
9195         (void)signal(SIGINT, ihand);
9196         (void)signal(SIGQUIT, qhand);
9197         statusvalue = (U16)status;
9198         if (result < 0)
9199             value = -1;
9200         else {
9201             value = (I32)((unsigned int)status & 0xffff);
9202         }
9203         do_execfree();  /* free any memory child malloced on vfork */
9204         SP = ORIGMARK;
9205         PUSHi(value);
9206         RETURN;
9207     }
9208     if (op->op_flags & OPf_STACKED) {
9209         SV *really = *++MARK;
9210         value = (I32)do_aexec(really, MARK, SP);
9211     }
9212     else if (SP - MARK != 1)
9213         value = (I32)do_aexec(Nullsv, MARK, SP);
9214     else {
9215         value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
9216     }
9217     _exit(-1);
9218 #else /* ! FORK */
9219     if ((op[1].op_type & A_MASK) == A_GV)
9220         value = (I32)do_aspawn(st[1], arglast);
9221     else if (arglast[2] - arglast[1] != 1)
9222         value = (I32)do_aspawn(Nullsv, arglast);
9223     else {
9224         value = (I32)do_spawn(SvPVx(sv_mortalcopy(st[2]), na));
9225     }
9226     PUSHi(value);
9227 #endif /* FORK */
9228     RETURN;
9229 }
9230
9231 PP(pp_exec)
9232 {
9233     dSP; dMARK; dORIGMARK; dTARGET;
9234     I32 value;
9235
9236     if (op->op_flags & OPf_STACKED) {
9237         SV *really = *++MARK;
9238         value = (I32)do_aexec(really, MARK, SP);
9239     }
9240     else if (SP - MARK != 1)
9241         value = (I32)do_aexec(Nullsv, MARK, SP);
9242     else {
9243         if (tainting) {
9244             char *junk = SvPV(*SP, na);
9245             TAINT_ENV();
9246             TAINT_PROPER("exec");
9247         }
9248         value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
9249     }
9250     SP = ORIGMARK;
9251     PUSHi(value);
9252     RETURN;
9253 }
9254
9255 PP(pp_kill)
9256 {
9257     dSP; dMARK; dTARGET;
9258     I32 value;
9259 #ifdef HAS_KILL
9260     value = (I32)apply(op->op_type, MARK, SP);
9261     SP = MARK;
9262     PUSHi(value);
9263     RETURN;
9264 #else
9265     DIE(no_func, "Unsupported function kill");
9266 #endif
9267 }
9268
9269 PP(pp_getppid)
9270 {
9271 #ifdef HAS_GETPPID
9272     dSP; dTARGET;
9273     XPUSHi( getppid() );
9274     RETURN;
9275 #else
9276     DIE(no_func, "getppid");
9277 #endif
9278 }
9279
9280 PP(pp_getpgrp)
9281 {
9282 #ifdef HAS_GETPGRP
9283     dSP; dTARGET;
9284     int pid;
9285     I32 value;
9286
9287     if (MAXARG < 1)
9288         pid = 0;
9289     else
9290         pid = SvIVx(POPs);
9291 #ifdef _POSIX_SOURCE
9292     if (pid != 0)
9293         DIE("POSIX getpgrp can't take an argument");
9294     value = (I32)getpgrp();
9295 #else
9296     value = (I32)getpgrp(pid);
9297 #endif
9298     XPUSHi(value);
9299     RETURN;
9300 #else
9301     DIE(no_func, "getpgrp()");
9302 #endif
9303 }
9304
9305 PP(pp_setpgrp)
9306 {
9307 #ifdef HAS_SETPGRP
9308     dSP; dTARGET;
9309     int pgrp = POPi;
9310     int pid = TOPi;
9311
9312     TAINT_PROPER("setpgrp");
9313     SETi( setpgrp(pid, pgrp) >= 0 );
9314     RETURN;
9315 #else
9316     DIE(no_func, "setpgrp()");
9317 #endif
9318 }
9319
9320 PP(pp_getpriority)
9321 {
9322     dSP; dTARGET;
9323     int which;
9324     int who;
9325 #ifdef HAS_GETPRIORITY
9326     who = POPi;
9327     which = TOPi;
9328     SETi( getpriority(which, who) );
9329     RETURN;
9330 #else
9331     DIE(no_func, "getpriority()");
9332 #endif
9333 }
9334
9335 PP(pp_setpriority)
9336 {
9337     dSP; dTARGET;
9338     int which;
9339     int who;
9340     int niceval;
9341 #ifdef HAS_SETPRIORITY
9342     niceval = POPi;
9343     who = POPi;
9344     which = TOPi;
9345     TAINT_PROPER("setpriority");
9346     SETi( setpriority(which, who, niceval) >= 0 );
9347     RETURN;
9348 #else
9349     DIE(no_func, "setpriority()");
9350 #endif
9351 }
9352
9353 /* Time calls. */
9354
9355 PP(pp_time)
9356 {
9357     dSP; dTARGET;
9358     XPUSHi( time(Null(Time_t*)) );
9359     RETURN;
9360 }
9361
9362 #ifndef HZ
9363 #define HZ 60
9364 #endif
9365
9366 PP(pp_tms)
9367 {
9368     dSP;
9369
9370 #if defined(MSDOS) || !defined(HAS_TIMES)
9371     DIE("times not implemented");
9372 #else
9373     EXTEND(SP, 4);
9374
9375     (void)times(&timesbuf);
9376
9377     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
9378     if (GIMME == G_ARRAY) {
9379         PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
9380         PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
9381         PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
9382     }
9383     RETURN;
9384 #endif /* MSDOS */
9385 }
9386
9387 PP(pp_localtime)
9388 {
9389     return pp_gmtime(ARGS);
9390 }
9391
9392 PP(pp_gmtime)
9393 {
9394     dSP;
9395     Time_t when;
9396     struct tm *tmbuf;
9397     static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
9398     static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
9399                               "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
9400
9401     if (MAXARG < 1)
9402         (void)time(&when);
9403     else
9404         when = (Time_t)SvIVx(POPs);
9405
9406     if (op->op_type == OP_LOCALTIME)
9407         tmbuf = localtime(&when);
9408     else
9409         tmbuf = gmtime(&when);
9410
9411     EXTEND(SP, 9);
9412     if (GIMME != G_ARRAY) {
9413         dTARGET;
9414         char mybuf[30];
9415         if (!tmbuf)
9416             RETPUSHUNDEF;
9417         sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
9418             dayname[tmbuf->tm_wday],
9419             monname[tmbuf->tm_mon],
9420             tmbuf->tm_mday,
9421             tmbuf->tm_hour,
9422             tmbuf->tm_min,
9423             tmbuf->tm_sec,
9424             tmbuf->tm_year + 1900);
9425         PUSHp(mybuf, strlen(mybuf));
9426     }
9427     else if (tmbuf) {
9428         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
9429         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
9430         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
9431         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
9432         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
9433         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
9434         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
9435         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
9436         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
9437     }
9438     RETURN;
9439 }
9440
9441 PP(pp_alarm)
9442 {
9443     dSP; dTARGET;
9444     int anum;
9445 #ifdef HAS_ALARM
9446     if (MAXARG < 1)
9447         anum = SvIVx(GvSV(defgv));
9448     else
9449         anum = POPi;
9450     anum = alarm((unsigned int)anum);
9451     EXTEND(SP, 1);
9452     if (anum < 0)
9453         RETPUSHUNDEF;
9454     PUSHi((I32)anum);
9455     RETURN;
9456 #else
9457     DIE(no_func, "Unsupported function alarm");
9458     break;
9459 #endif
9460 }
9461
9462 PP(pp_sleep)
9463 {
9464     dSP; dTARGET;
9465     char *tmps;
9466     I32 duration;
9467     Time_t lasttime;
9468     Time_t when;
9469
9470     (void)time(&lasttime);
9471     if (MAXARG < 1)
9472         pause();
9473     else {
9474         duration = POPi;
9475         sleep((unsigned int)duration);
9476     }
9477     (void)time(&when);
9478     XPUSHi(when - lasttime);
9479     RETURN;
9480 }
9481
9482 /* Shared memory. */
9483
9484 PP(pp_shmget)
9485 {
9486     return pp_semget(ARGS);
9487 }
9488
9489 PP(pp_shmctl)
9490 {
9491     return pp_semctl(ARGS);
9492 }
9493
9494 PP(pp_shmread)
9495 {
9496     return pp_shmwrite(ARGS);
9497 }
9498
9499 PP(pp_shmwrite)
9500 {
9501 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
9502     dSP; dMARK; dTARGET;
9503     I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
9504     SP = MARK;
9505     PUSHi(value);
9506     RETURN;
9507 #else
9508     pp_semget(ARGS);
9509 #endif
9510 }
9511
9512 /* Message passing. */
9513
9514 PP(pp_msgget)
9515 {
9516     return pp_semget(ARGS);
9517 }
9518
9519 PP(pp_msgctl)
9520 {
9521     return pp_semctl(ARGS);
9522 }
9523
9524 PP(pp_msgsnd)
9525 {
9526 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
9527     dSP; dMARK; dTARGET;
9528     I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
9529     SP = MARK;
9530     PUSHi(value);
9531     RETURN;
9532 #else
9533     pp_semget(ARGS);
9534 #endif
9535 }
9536
9537 PP(pp_msgrcv)
9538 {
9539 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
9540     dSP; dMARK; dTARGET;
9541     I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
9542     SP = MARK;
9543     PUSHi(value);
9544     RETURN;
9545 #else
9546     pp_semget(ARGS);
9547 #endif
9548 }
9549
9550 /* Semaphores. */
9551
9552 PP(pp_semget)
9553 {
9554 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
9555     dSP; dMARK; dTARGET;
9556     int anum = do_ipcget(op->op_type, MARK, SP);
9557     SP = MARK;
9558     if (anum == -1)
9559         RETPUSHUNDEF;
9560     PUSHi(anum);
9561     RETURN;
9562 #else
9563     DIE("System V IPC is not implemented on this machine");
9564 #endif
9565 }
9566
9567 PP(pp_semctl)
9568 {
9569 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
9570     dSP; dMARK; dTARGET;
9571     int anum = do_ipcctl(op->op_type, MARK, SP);
9572     SP = MARK;
9573     if (anum == -1)
9574         RETSETUNDEF;
9575     if (anum != 0) {
9576         PUSHi(anum);
9577     }
9578     else {
9579         PUSHp("0 but true",10);
9580     }
9581     RETURN;
9582 #else
9583     pp_semget(ARGS);
9584 #endif
9585 }
9586
9587 PP(pp_semop)
9588 {
9589 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
9590     dSP; dMARK; dTARGET;
9591     I32 value = (I32)(do_semop(MARK, SP) >= 0);
9592     SP = MARK;
9593     PUSHi(value);
9594     RETURN;
9595 #else
9596     pp_semget(ARGS);
9597 #endif
9598 }
9599
9600 /* Eval. */
9601
9602 static void
9603 save_lines(array, sv)
9604 AV *array;
9605 SV *sv;
9606 {
9607     register char *s = SvPVX(sv);
9608     register char *send = SvPVX(sv) + SvCUR(sv);
9609     register char *t;
9610     register I32 line = 1;
9611
9612     while (s && s < send) {
9613         SV *tmpstr = NEWSV(85,0);
9614
9615         sv_upgrade(tmpstr, SVt_PVMG);
9616         t = strchr(s, '\n');
9617         if (t)
9618             t++;
9619         else
9620             t = send;
9621
9622         sv_setpvn(tmpstr, s, t - s);
9623         av_store(array, line++, tmpstr);
9624         s = t;
9625     }
9626 }
9627
9628 OP *
9629 doeval()
9630 {
9631     dSP;
9632     OP *saveop = op;
9633     HV *newstash;
9634
9635     in_eval = 1;
9636
9637     /* set up a scratch pad */
9638
9639     SAVEINT(padix);
9640     SAVESPTR(curpad);
9641     SAVESPTR(comppad);
9642     SAVESPTR(comppad_name);
9643     SAVEINT(comppad_name_fill);
9644     SAVEINT(min_intro_pending);
9645     SAVEINT(max_intro_pending);
9646     comppad = newAV();
9647     comppad_name = newAV();
9648     comppad_name_fill = 0;
9649     min_intro_pending = 0;
9650     av_push(comppad, Nullsv);
9651     curpad = AvARRAY(comppad);
9652     padix = 0;
9653
9654     /* make sure we compile in the right package */
9655
9656     newstash = curcop->cop_stash;
9657     if (curstash != newstash) {
9658         SAVESPTR(curstash);
9659         curstash = newstash;
9660     }
9661     SAVESPTR(beginav);
9662     beginav = 0;
9663
9664     /* try to compile it */
9665
9666     eval_root = Nullop;
9667     error_count = 0;
9668     curcop = &compiling;
9669     rs = "\n";
9670     rslen = 1;
9671     rschar = '\n';
9672     rspara = 0;
9673     if (yyparse() || error_count || !eval_root) {
9674         SV **newsp;
9675         I32 gimme;
9676         CONTEXT *cx;
9677         I32 optype;
9678
9679         op = saveop;
9680         if (eval_root) {
9681             op_free(eval_root);
9682             eval_root = Nullop;
9683         }
9684         POPBLOCK(cx);
9685         POPEVAL(cx);
9686         pop_return();
9687         lex_end();
9688         LEAVE;
9689         if (optype == OP_REQUIRE)
9690             DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
9691         rs = nrs;
9692         rslen = nrslen;
9693         rschar = nrschar;
9694         rspara = (nrslen == 2);
9695         RETPUSHUNDEF;
9696     }
9697     rs = nrs;
9698     rslen = nrslen;
9699     rschar = nrschar;
9700     rspara = (nrslen == 2);
9701     compiling.cop_line = 0;
9702     SAVEFREESV(comppad_name);
9703     SAVEFREESV(comppad);
9704     SAVEFREEOP(eval_root);
9705
9706     DEBUG_x(dump_eval());
9707
9708     /* compiled okay, so do it */
9709
9710     sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
9711     RETURNOP(eval_start);
9712 }
9713
9714 PP(pp_require)
9715 {
9716     dSP;
9717     register CONTEXT *cx;
9718     SV *sv;
9719     char *name;
9720     char *tmpname;
9721     SV** svp;
9722     I32 gimme = G_SCALAR;
9723     FILE *tryrsfp = 0;
9724
9725     if (MAXARG < 1) {
9726         sv = GvSV(defgv);
9727         EXTEND(SP, 1);
9728     }
9729     else
9730         sv = POPs;
9731     if (SvNIOK(sv) && !SvPOKp(sv)) {
9732         if (SvNV(sv) > atof(patchlevel) + 0.000999)
9733             DIE("Perl %3.3f required--this is only version %s, stopped",
9734                 SvNV(sv),patchlevel);
9735         RETPUSHYES;
9736     }
9737     name = SvPV(sv, na);
9738     if (op->op_type == OP_REQUIRE &&
9739       (svp = hv_fetch(GvHVn(incgv), name, SvCUR(sv), 0)) &&
9740       *svp != &sv_undef)
9741         RETPUSHYES;
9742
9743     /* prepare to compile file */
9744
9745     tmpname = savestr(name);
9746     if (*tmpname == '/' ||
9747         (*tmpname == '.' &&
9748             (tmpname[1] == '/' ||
9749              (tmpname[1] == '.' && tmpname[2] == '/'))))
9750     {
9751         tryrsfp = fopen(tmpname,"r");
9752     }
9753     else {
9754         AV *ar = GvAVn(incgv);
9755         I32 i;
9756
9757         for (i = 0; i <= AvFILL(ar); i++) {
9758             (void)sprintf(buf, "%s/%s",
9759                 SvPVx(*av_fetch(ar, i, TRUE), na), name);
9760             tryrsfp = fopen(buf, "r");
9761             if (tryrsfp) {
9762                 char *s = buf;
9763
9764                 if (*s == '.' && s[1] == '/')
9765                     s += 2;
9766                 Safefree(tmpname);
9767                 tmpname = savestr(s);
9768                 break;
9769             }
9770         }
9771     }
9772     compiling.cop_filegv = gv_fetchfile(tmpname);
9773     Safefree(tmpname);
9774     tmpname = Nullch;
9775     if (!tryrsfp) {
9776         if (op->op_type == OP_REQUIRE) {
9777             sprintf(tokenbuf,"Can't locate %s in @INC", name);
9778             if (instr(tokenbuf,".h "))
9779                 strcat(tokenbuf," (change .h to .ph maybe?)");
9780             if (instr(tokenbuf,".ph "))
9781                 strcat(tokenbuf," (did you run h2ph?)");
9782             DIE("%s",tokenbuf);
9783         }
9784
9785         RETPUSHUNDEF;
9786     }
9787
9788     /* Assume success here to prevent recursive requirement. */
9789     (void)hv_store(GvHVn(incgv), name, strlen(name),
9790         newSVsv(GvSV(compiling.cop_filegv)), 0 );
9791
9792     ENTER;
9793     SAVETMPS;
9794     lex_start(sv_2mortal(newSVpv("",0)));
9795     rsfp = tryrsfp;
9796     name = savestr(name);
9797     SAVEFREEPV(name);
9798
9799     /* switch to eval mode */
9800
9801     push_return(op->op_next);
9802     PUSHBLOCK(cx, CXt_EVAL, SP);
9803     PUSHEVAL(cx, name, compiling.cop_filegv);
9804
9805     compiling.cop_line = 0;
9806
9807     PUTBACK;
9808     return doeval();
9809 }
9810
9811 PP(pp_dofile)
9812 {
9813     return pp_require(ARGS);
9814 }
9815
9816 PP(pp_entereval)
9817 {
9818     dSP;
9819     register CONTEXT *cx;
9820     dPOPss;
9821     I32 gimme = GIMME;
9822     char tmpbuf[32];
9823
9824     ENTER;
9825     SAVETMPS;
9826     lex_start(sv);
9827
9828     /* switch to eval mode */
9829
9830     sprintf(tmpbuf, "_<(eval %d)", ++evalseq);
9831     compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
9832     compiling.cop_line = 1;
9833     SAVEDELETE(defstash, savestr(tmpbuf), strlen(tmpbuf));
9834
9835     push_return(op->op_next);
9836     PUSHBLOCK(cx, CXt_EVAL, SP);
9837     PUSHEVAL(cx, 0, compiling.cop_filegv);
9838
9839     /* prepare to compile string */
9840
9841     if (perldb && curstash != debstash)
9842         save_lines(GvAV(compiling.cop_filegv), linestr);
9843     PUTBACK;
9844     return doeval();
9845 }
9846
9847 PP(pp_leaveeval)
9848 {
9849     dSP;
9850     register SV **mark;
9851     SV **newsp;
9852     I32 gimme;
9853     register CONTEXT *cx;
9854     OP *retop;
9855     I32 optype;
9856     OP *eroot = eval_root;
9857
9858     POPBLOCK(cx);
9859     POPEVAL(cx);
9860     retop = pop_return();
9861
9862     if (gimme == G_SCALAR) {
9863         MARK = newsp + 1;
9864         if (MARK <= SP) {
9865             if (SvFLAGS(TOPs) & SVs_TEMP)
9866                 *MARK = TOPs;
9867             else
9868                 *MARK = sv_mortalcopy(TOPs);
9869         }
9870         else {
9871             MEXTEND(mark,0);
9872             *MARK = &sv_undef;
9873         }
9874         SP = MARK;
9875     }
9876     else {
9877         for (mark = newsp + 1; mark <= SP; mark++)
9878             if (!(SvFLAGS(TOPs) & SVs_TEMP))
9879                 *mark = sv_mortalcopy(*mark);
9880                 /* in case LEAVE wipes old return values */
9881     }
9882
9883     if (optype != OP_ENTEREVAL) {
9884         char *name = cx->blk_eval.old_name;
9885
9886         if (!(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) {
9887             /* Unassume the success we assumed earlier. */
9888             (void)hv_delete(GvHVn(incgv), name, strlen(name));
9889
9890             if (optype == OP_REQUIRE)
9891                 retop = die("%s did not return a true value", name);
9892         }
9893     }
9894
9895     lex_end();
9896     LEAVE;
9897     sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
9898
9899     RETURNOP(retop);
9900 }
9901
9902 PP(pp_evalonce)
9903 {
9904     dSP;
9905 #ifdef NOTDEF
9906     SP = do_eval(st[1], OP_EVAL, curcop->cop_stash, TRUE,
9907         GIMME, arglast);
9908     if (eval_root) {
9909         SvREFCNT_dec(cSVOP->op_sv);
9910         op[1].arg_ptr.arg_cmd = eval_root;
9911         op[1].op_type = (A_CMD|A_DONT);
9912         op[0].op_type = OP_TRY;
9913     }
9914     RETURN;
9915
9916 #endif
9917     RETURN;
9918 }
9919
9920 PP(pp_entertry)
9921 {
9922     dSP;
9923     register CONTEXT *cx;
9924     I32 gimme = GIMME;
9925
9926     ENTER;
9927     SAVETMPS;
9928
9929     push_return(cLOGOP->op_other->op_next);
9930     PUSHBLOCK(cx, CXt_EVAL, SP);
9931     PUSHEVAL(cx, 0, 0);
9932     eval_root = op;             /* Only needed so that goto works right. */
9933
9934     in_eval = 1;
9935     sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
9936     RETURN;
9937 }
9938
9939 PP(pp_leavetry)
9940 {
9941     dSP;
9942     register SV **mark;
9943     SV **newsp;
9944     I32 gimme;
9945     register CONTEXT *cx;
9946     I32 optype;
9947
9948     POPBLOCK(cx);
9949     POPEVAL(cx);
9950     pop_return();
9951
9952     if (gimme == G_SCALAR) {
9953         MARK = newsp + 1;
9954         if (MARK <= SP) {
9955             if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
9956                 *MARK = TOPs;
9957             else
9958                 *MARK = sv_mortalcopy(TOPs);
9959         }
9960         else {
9961             MEXTEND(mark,0);
9962             *MARK = &sv_undef;
9963         }
9964         SP = MARK;
9965     }
9966     else {
9967         for (mark = newsp + 1; mark <= SP; mark++)
9968             if (!(SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)))
9969                 *mark = sv_mortalcopy(*mark);
9970                 /* in case LEAVE wipes old return values */
9971     }
9972
9973     LEAVE;
9974     sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
9975     RETURN;
9976 }
9977
9978 /* Get system info. */
9979
9980 PP(pp_ghbyname)
9981 {
9982 #ifdef HAS_SOCKET
9983     return pp_ghostent(ARGS);
9984 #else
9985     DIE(no_sock_func, "gethostbyname");
9986 #endif
9987 }
9988
9989 PP(pp_ghbyaddr)
9990 {
9991 #ifdef HAS_SOCKET
9992     return pp_ghostent(ARGS);
9993 #else
9994     DIE(no_sock_func, "gethostbyaddr");
9995 #endif
9996 }
9997
9998 PP(pp_ghostent)
9999 {
10000     dSP;
10001 #ifdef HAS_SOCKET
10002     I32 which = op->op_type;
10003     register char **elem;
10004     register SV *sv;
10005     struct hostent *gethostbyname();
10006     struct hostent *gethostbyaddr();
10007 #ifdef HAS_GETHOSTENT
10008     struct hostent *gethostent();
10009 #endif
10010     struct hostent *hent;
10011     unsigned long len;
10012
10013     EXTEND(SP, 10);
10014     if (which == OP_GHBYNAME) {
10015         hent = gethostbyname(POPp);
10016     }
10017     else if (which == OP_GHBYADDR) {
10018         int addrtype = POPi;
10019         SV *addrstr = POPs;
10020         char *addr = SvPV(addrstr, na);
10021
10022         hent = gethostbyaddr(addr, SvCUR(addrstr), addrtype);
10023     }
10024     else
10025 #ifdef HAS_GETHOSTENT
10026         hent = gethostent();
10027 #else
10028         DIE("gethostent not implemented");
10029 #endif
10030
10031 #ifdef HOST_NOT_FOUND
10032     if (!hent)
10033         statusvalue = (U16)h_errno & 0xffff;
10034 #endif
10035
10036     if (GIMME != G_ARRAY) {
10037         PUSHs(sv = sv_newmortal());
10038         if (hent) {
10039             if (which == OP_GHBYNAME) {
10040                 sv_setpvn(sv, hent->h_addr, hent->h_length);
10041             }
10042             else
10043                 sv_setpv(sv, hent->h_name);
10044         }
10045         RETURN;
10046     }
10047
10048     if (hent) {
10049         PUSHs(sv = sv_mortalcopy(&sv_no));
10050         sv_setpv(sv, hent->h_name);
10051         PUSHs(sv = sv_mortalcopy(&sv_no));
10052         for (elem = hent->h_aliases; *elem; elem++) {
10053             sv_catpv(sv, *elem);
10054             if (elem[1])
10055                 sv_catpvn(sv, " ", 1);
10056         }
10057         PUSHs(sv = sv_mortalcopy(&sv_no));
10058         sv_setiv(sv, (I32)hent->h_addrtype);
10059         PUSHs(sv = sv_mortalcopy(&sv_no));
10060         len = hent->h_length;
10061         sv_setiv(sv, (I32)len);
10062 #ifdef h_addr
10063         for (elem = hent->h_addr_list; *elem; elem++) {
10064             XPUSHs(sv = sv_mortalcopy(&sv_no));
10065             sv_setpvn(sv, *elem, len);
10066         }
10067 #else
10068         PUSHs(sv = sv_mortalcopy(&sv_no));
10069         sv_setpvn(sv, hent->h_addr, len);
10070 #endif /* h_addr */
10071     }
10072     RETURN;
10073 #else
10074     DIE(no_sock_func, "gethostent");
10075 #endif
10076 }
10077
10078 PP(pp_gnbyname)
10079 {
10080 #ifdef HAS_SOCKET
10081     return pp_gnetent(ARGS);
10082 #else
10083     DIE(no_sock_func, "getnetbyname");
10084 #endif
10085 }
10086
10087 PP(pp_gnbyaddr)
10088 {
10089 #ifdef HAS_SOCKET
10090     return pp_gnetent(ARGS);
10091 #else
10092     DIE(no_sock_func, "getnetbyaddr");
10093 #endif
10094 }
10095
10096 PP(pp_gnetent)
10097 {
10098     dSP;
10099 #ifdef HAS_SOCKET
10100     I32 which = op->op_type;
10101     register char **elem;
10102     register SV *sv;
10103     struct netent *getnetbyname();
10104     struct netent *getnetbyaddr();
10105     struct netent *getnetent();
10106     struct netent *nent;
10107
10108     if (which == OP_GNBYNAME)
10109         nent = getnetbyname(POPp);
10110     else if (which == OP_GNBYADDR) {
10111         int addrtype = POPi;
10112         unsigned long addr = U_L(POPn);
10113         nent = getnetbyaddr((long)addr, addrtype);
10114     }
10115     else
10116         nent = getnetent();
10117
10118     EXTEND(SP, 4);
10119     if (GIMME != G_ARRAY) {
10120         PUSHs(sv = sv_newmortal());
10121         if (nent) {
10122             if (which == OP_GNBYNAME)
10123                 sv_setiv(sv, (I32)nent->n_net);
10124             else
10125                 sv_setpv(sv, nent->n_name);
10126         }
10127         RETURN;
10128     }
10129
10130     if (nent) {
10131         PUSHs(sv = sv_mortalcopy(&sv_no));
10132         sv_setpv(sv, nent->n_name);
10133         PUSHs(sv = sv_mortalcopy(&sv_no));
10134         for (elem = nent->n_aliases; *elem; elem++) {
10135             sv_catpv(sv, *elem);
10136             if (elem[1])
10137                 sv_catpvn(sv, " ", 1);
10138         }
10139         PUSHs(sv = sv_mortalcopy(&sv_no));
10140         sv_setiv(sv, (I32)nent->n_addrtype);
10141         PUSHs(sv = sv_mortalcopy(&sv_no));
10142         sv_setiv(sv, (I32)nent->n_net);
10143     }
10144
10145     RETURN;
10146 #else
10147     DIE(no_sock_func, "getnetent");
10148 #endif
10149 }
10150
10151 PP(pp_gpbyname)
10152 {
10153 #ifdef HAS_SOCKET
10154     return pp_gprotoent(ARGS);
10155 #else
10156     DIE(no_sock_func, "getprotobyname");
10157 #endif
10158 }
10159
10160 PP(pp_gpbynumber)
10161 {
10162 #ifdef HAS_SOCKET
10163     return pp_gprotoent(ARGS);
10164 #else
10165     DIE(no_sock_func, "getprotobynumber");
10166 #endif
10167 }
10168
10169 PP(pp_gprotoent)
10170 {
10171     dSP;
10172 #ifdef HAS_SOCKET
10173     I32 which = op->op_type;
10174     register char **elem;
10175     register SV *sv;
10176     struct protoent *getprotobyname();
10177     struct protoent *getprotobynumber();
10178     struct protoent *getprotoent();
10179     struct protoent *pent;
10180
10181     if (which == OP_GPBYNAME)
10182         pent = getprotobyname(POPp);
10183     else if (which == OP_GPBYNUMBER)
10184         pent = getprotobynumber(POPi);
10185     else
10186         pent = getprotoent();
10187
10188     EXTEND(SP, 3);
10189     if (GIMME != G_ARRAY) {
10190         PUSHs(sv = sv_newmortal());
10191         if (pent) {
10192             if (which == OP_GPBYNAME)
10193                 sv_setiv(sv, (I32)pent->p_proto);
10194             else
10195                 sv_setpv(sv, pent->p_name);
10196         }
10197         RETURN;
10198     }
10199
10200     if (pent) {
10201         PUSHs(sv = sv_mortalcopy(&sv_no));
10202         sv_setpv(sv, pent->p_name);
10203         PUSHs(sv = sv_mortalcopy(&sv_no));
10204         for (elem = pent->p_aliases; *elem; elem++) {
10205             sv_catpv(sv, *elem);
10206             if (elem[1])
10207                 sv_catpvn(sv, " ", 1);
10208         }
10209         PUSHs(sv = sv_mortalcopy(&sv_no));
10210         sv_setiv(sv, (I32)pent->p_proto);
10211     }
10212
10213     RETURN;
10214 #else
10215     DIE(no_sock_func, "getprotoent");
10216 #endif
10217 }
10218
10219 PP(pp_gsbyname)
10220 {
10221 #ifdef HAS_SOCKET
10222     return pp_gservent(ARGS);
10223 #else
10224     DIE(no_sock_func, "getservbyname");
10225 #endif
10226 }
10227
10228 PP(pp_gsbyport)
10229 {
10230 #ifdef HAS_SOCKET
10231     return pp_gservent(ARGS);
10232 #else
10233     DIE(no_sock_func, "getservbyport");
10234 #endif
10235 }
10236
10237 PP(pp_gservent)
10238 {
10239     dSP;
10240 #ifdef HAS_SOCKET
10241     I32 which = op->op_type;
10242     register char **elem;
10243     register SV *sv;
10244     struct servent *getservbyname();
10245     struct servent *getservbynumber();
10246     struct servent *getservent();
10247     struct servent *sent;
10248
10249     if (which == OP_GSBYNAME) {
10250         char *proto = POPp;
10251         char *name = POPp;
10252
10253         if (proto && !*proto)
10254             proto = Nullch;
10255
10256         sent = getservbyname(name, proto);
10257     }
10258     else if (which == OP_GSBYPORT) {
10259         char *proto = POPp;
10260         int port = POPi;
10261
10262         sent = getservbyport(port, proto);
10263     }
10264     else
10265         sent = getservent();
10266
10267     EXTEND(SP, 4);
10268     if (GIMME != G_ARRAY) {
10269         PUSHs(sv = sv_newmortal());
10270         if (sent) {
10271             if (which == OP_GSBYNAME) {
10272 #ifdef HAS_NTOHS
10273                 sv_setiv(sv, (I32)ntohs(sent->s_port));
10274 #else
10275                 sv_setiv(sv, (I32)(sent->s_port));
10276 #endif
10277             }
10278             else
10279                 sv_setpv(sv, sent->s_name);
10280         }
10281         RETURN;
10282     }
10283
10284     if (sent) {
10285         PUSHs(sv = sv_mortalcopy(&sv_no));
10286         sv_setpv(sv, sent->s_name);
10287         PUSHs(sv = sv_mortalcopy(&sv_no));
10288         for (elem = sent->s_aliases; *elem; elem++) {
10289             sv_catpv(sv, *elem);
10290             if (elem[1])
10291                 sv_catpvn(sv, " ", 1);
10292         }
10293         PUSHs(sv = sv_mortalcopy(&sv_no));
10294 #ifdef HAS_NTOHS
10295         sv_setiv(sv, (I32)ntohs(sent->s_port));
10296 #else
10297         sv_setiv(sv, (I32)(sent->s_port));
10298 #endif
10299         PUSHs(sv = sv_mortalcopy(&sv_no));
10300         sv_setpv(sv, sent->s_proto);
10301     }
10302
10303     RETURN;
10304 #else
10305     DIE(no_sock_func, "getservent");
10306 #endif
10307 }
10308
10309 PP(pp_shostent)
10310 {
10311     dSP;
10312 #ifdef HAS_SOCKET
10313     sethostent(TOPi);
10314     RETSETYES;
10315 #else
10316     DIE(no_sock_func, "sethostent");
10317 #endif
10318 }
10319
10320 PP(pp_snetent)
10321 {
10322     dSP;
10323 #ifdef HAS_SOCKET
10324     setnetent(TOPi);
10325     RETSETYES;
10326 #else
10327     DIE(no_sock_func, "setnetent");
10328 #endif
10329 }
10330
10331 PP(pp_sprotoent)
10332 {
10333     dSP;
10334 #ifdef HAS_SOCKET
10335     setprotoent(TOPi);
10336     RETSETYES;
10337 #else
10338     DIE(no_sock_func, "setprotoent");
10339 #endif
10340 }
10341
10342 PP(pp_sservent)
10343 {
10344     dSP;
10345 #ifdef HAS_SOCKET
10346     setservent(TOPi);
10347     RETSETYES;
10348 #else
10349     DIE(no_sock_func, "setservent");
10350 #endif
10351 }
10352
10353 PP(pp_ehostent)
10354 {
10355     dSP;
10356 #ifdef HAS_SOCKET
10357     endhostent();
10358     EXTEND(sp,1);
10359     RETPUSHYES;
10360 #else
10361     DIE(no_sock_func, "endhostent");
10362 #endif
10363 }
10364
10365 PP(pp_enetent)
10366 {
10367     dSP;
10368 #ifdef HAS_SOCKET
10369     endnetent();
10370     EXTEND(sp,1);
10371     RETPUSHYES;
10372 #else
10373     DIE(no_sock_func, "endnetent");
10374 #endif
10375 }
10376
10377 PP(pp_eprotoent)
10378 {
10379     dSP;
10380 #ifdef HAS_SOCKET
10381     endprotoent();
10382     EXTEND(sp,1);
10383     RETPUSHYES;
10384 #else
10385     DIE(no_sock_func, "endprotoent");
10386 #endif
10387 }
10388
10389 PP(pp_eservent)
10390 {
10391     dSP;
10392 #ifdef HAS_SOCKET
10393     endservent();
10394     EXTEND(sp,1);
10395     RETPUSHYES;
10396 #else
10397     DIE(no_sock_func, "endservent");
10398 #endif
10399 }
10400
10401 PP(pp_gpwnam)
10402 {
10403 #ifdef HAS_PASSWD
10404     return pp_gpwent(ARGS);
10405 #else
10406     DIE(no_func, "getpwnam");
10407 #endif
10408 }
10409
10410 PP(pp_gpwuid)
10411 {
10412 #ifdef HAS_PASSWD
10413     return pp_gpwent(ARGS);
10414 #else
10415     DIE(no_func, "getpwuid");
10416 #endif
10417 }
10418
10419 PP(pp_gpwent)
10420 {
10421     dSP;
10422 #ifdef HAS_PASSWD
10423     I32 which = op->op_type;
10424     register AV *ary = stack;
10425     register SV *sv;
10426     struct passwd *pwent;
10427
10428     if (which == OP_GPWNAM)
10429         pwent = getpwnam(POPp);
10430     else if (which == OP_GPWUID)
10431         pwent = getpwuid(POPi);
10432     else
10433         pwent = (struct passwd *)getpwent();
10434
10435     EXTEND(SP, 10);
10436     if (GIMME != G_ARRAY) {
10437         PUSHs(sv = sv_newmortal());
10438         if (pwent) {
10439             if (which == OP_GPWNAM)
10440                 sv_setiv(sv, (I32)pwent->pw_uid);
10441             else
10442                 sv_setpv(sv, pwent->pw_name);
10443         }
10444         RETURN;
10445     }
10446
10447     if (pwent) {
10448         PUSHs(sv = sv_mortalcopy(&sv_no));
10449         sv_setpv(sv, pwent->pw_name);
10450         PUSHs(sv = sv_mortalcopy(&sv_no));
10451         sv_setpv(sv, pwent->pw_passwd);
10452         PUSHs(sv = sv_mortalcopy(&sv_no));
10453         sv_setiv(sv, (I32)pwent->pw_uid);
10454         PUSHs(sv = sv_mortalcopy(&sv_no));
10455         sv_setiv(sv, (I32)pwent->pw_gid);
10456         PUSHs(sv = sv_mortalcopy(&sv_no));
10457 #ifdef PWCHANGE
10458         sv_setiv(sv, (I32)pwent->pw_change);
10459 #else
10460 #ifdef PWQUOTA
10461         sv_setiv(sv, (I32)pwent->pw_quota);
10462 #else
10463 #ifdef PWAGE
10464         sv_setpv(sv, pwent->pw_age);
10465 #endif
10466 #endif
10467 #endif
10468         PUSHs(sv = sv_mortalcopy(&sv_no));
10469 #ifdef PWCLASS
10470         sv_setpv(sv, pwent->pw_class);
10471 #else
10472 #ifdef PWCOMMENT
10473         sv_setpv(sv, pwent->pw_comment);
10474 #endif
10475 #endif
10476         PUSHs(sv = sv_mortalcopy(&sv_no));
10477         sv_setpv(sv, pwent->pw_gecos);
10478         PUSHs(sv = sv_mortalcopy(&sv_no));
10479         sv_setpv(sv, pwent->pw_dir);
10480         PUSHs(sv = sv_mortalcopy(&sv_no));
10481         sv_setpv(sv, pwent->pw_shell);
10482 #ifdef PWEXPIRE
10483         PUSHs(sv = sv_mortalcopy(&sv_no));
10484         sv_setiv(sv, (I32)pwent->pw_expire);
10485 #endif
10486     }
10487     RETURN;
10488 #else
10489     DIE(no_func, "getpwent");
10490 #endif
10491 }
10492
10493 PP(pp_spwent)
10494 {
10495     dSP; dTARGET;
10496 #ifdef HAS_PASSWD
10497     setpwent();
10498     RETPUSHYES;
10499 #else
10500     DIE(no_func, "setpwent");
10501 #endif
10502 }
10503
10504 PP(pp_epwent)
10505 {
10506     dSP; dTARGET;
10507 #ifdef HAS_PASSWD
10508     endpwent();
10509     RETPUSHYES;
10510 #else
10511     DIE(no_func, "endpwent");
10512 #endif
10513 }
10514
10515 PP(pp_ggrnam)
10516 {
10517 #ifdef HAS_GROUP
10518     return pp_ggrent(ARGS);
10519 #else
10520     DIE(no_func, "getgrnam");
10521 #endif
10522 }
10523
10524 PP(pp_ggrgid)
10525 {
10526 #ifdef HAS_GROUP
10527     return pp_ggrent(ARGS);
10528 #else
10529     DIE(no_func, "getgrgid");
10530 #endif
10531 }
10532
10533 PP(pp_ggrent)
10534 {
10535     dSP;
10536 #ifdef HAS_GROUP
10537     I32 which = op->op_type;
10538     register char **elem;
10539     register SV *sv;
10540     struct group *grent;
10541
10542     if (which == OP_GGRNAM)
10543         grent = getgrnam(POPp);
10544     else if (which == OP_GGRGID)
10545         grent = getgrgid(POPi);
10546     else
10547         grent = (struct group *)getgrent();
10548
10549     EXTEND(SP, 4);
10550     if (GIMME != G_ARRAY) {
10551         PUSHs(sv = sv_newmortal());
10552         if (grent) {
10553             if (which == OP_GGRNAM)
10554                 sv_setiv(sv, (I32)grent->gr_gid);
10555             else
10556                 sv_setpv(sv, grent->gr_name);
10557         }
10558         RETURN;
10559     }
10560
10561     if (grent) {
10562         PUSHs(sv = sv_mortalcopy(&sv_no));
10563         sv_setpv(sv, grent->gr_name);
10564         PUSHs(sv = sv_mortalcopy(&sv_no));
10565         sv_setpv(sv, grent->gr_passwd);
10566         PUSHs(sv = sv_mortalcopy(&sv_no));
10567         sv_setiv(sv, (I32)grent->gr_gid);
10568         PUSHs(sv = sv_mortalcopy(&sv_no));
10569         for (elem = grent->gr_mem; *elem; elem++) {
10570             sv_catpv(sv, *elem);
10571             if (elem[1])
10572                 sv_catpvn(sv, " ", 1);
10573         }
10574     }
10575
10576     RETURN;
10577 #else
10578     DIE(no_func, "getgrent");
10579 #endif
10580 }
10581
10582 PP(pp_sgrent)
10583 {
10584     dSP; dTARGET;
10585 #ifdef HAS_GROUP
10586     setgrent();
10587     RETPUSHYES;
10588 #else
10589     DIE(no_func, "setgrent");
10590 #endif
10591 }
10592
10593 PP(pp_egrent)
10594 {
10595     dSP; dTARGET;
10596 #ifdef HAS_GROUP
10597     endgrent();
10598     RETPUSHYES;
10599 #else
10600     DIE(no_func, "endgrent");
10601 #endif
10602 }
10603
10604 PP(pp_getlogin)
10605 {
10606     dSP; dTARGET;
10607 #ifdef HAS_GETLOGIN
10608     char *tmps;
10609     EXTEND(SP, 1);
10610     if (!(tmps = getlogin()))
10611         RETPUSHUNDEF;
10612     PUSHp(tmps, strlen(tmps));
10613     RETURN;
10614 #else
10615     DIE(no_func, "getlogin");
10616 #endif
10617 }
10618
10619 /* Miscellaneous. */
10620
10621 PP(pp_syscall)
10622 {
10623 #ifdef HAS_SYSCALL
10624     dSP; dMARK; dORIGMARK; dTARGET;
10625     register I32 items = SP - MARK;
10626     unsigned long a[20];
10627     register I32 i = 0;
10628     I32 retval = -1;
10629
10630     if (tainting) {
10631         while (++MARK <= SP) {
10632             if (SvRMAGICAL(*MARK) && mg_find(*MARK, 't'))
10633                 tainted = TRUE;
10634         }
10635         MARK = ORIGMARK;
10636         TAINT_PROPER("syscall");
10637     }
10638
10639     /* This probably won't work on machines where sizeof(long) != sizeof(int)
10640      * or where sizeof(long) != sizeof(char*).  But such machines will
10641      * not likely have syscall implemented either, so who cares?
10642      */
10643     while (++MARK <= SP) {
10644         if (SvNIOK(*MARK) || !i)
10645             a[i++] = SvIV(*MARK);
10646         else
10647             a[i++] = (unsigned long)SvPVX(*MARK);
10648         if (i > 15)
10649             break;
10650     }
10651     switch (items) {
10652     default:
10653         DIE("Too many args to syscall");
10654     case 0:
10655         DIE("Too few args to syscall");
10656     case 1:
10657         retval = syscall(a[0]);
10658         break;
10659     case 2:
10660         retval = syscall(a[0],a[1]);
10661         break;
10662     case 3:
10663         retval = syscall(a[0],a[1],a[2]);
10664         break;
10665     case 4:
10666         retval = syscall(a[0],a[1],a[2],a[3]);
10667         break;
10668     case 5:
10669         retval = syscall(a[0],a[1],a[2],a[3],a[4]);
10670         break;
10671     case 6:
10672         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]);
10673         break;
10674     case 7:
10675         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]);
10676         break;
10677     case 8:
10678         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
10679         break;
10680 #ifdef atarist
10681     case 9:
10682         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
10683         break;
10684     case 10:
10685         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
10686         break;
10687     case 11:
10688         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
10689           a[10]);
10690         break;
10691     case 12:
10692         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
10693           a[10],a[11]);
10694         break;
10695     case 13:
10696         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
10697           a[10],a[11],a[12]);
10698         break;
10699     case 14:
10700         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
10701           a[10],a[11],a[12],a[13]);
10702         break;
10703 #endif /* atarist */
10704     }
10705     SP = ORIGMARK;
10706     PUSHi(retval);
10707     RETURN;
10708 #else
10709     DIE(no_func, "syscall");
10710 #endif
10711 }
10712