pp_sys.c

   1 /*    pp_sys.c
   2  *
   3  *    Copyright (c) 1991-1994, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * But only a short way ahead its floor and the walls on either side were
  12  * cloven by a great fissure, out of which the red glare came, now leaping
  13  * up, now dying down into darkness; and all the while far below there was
  14  * a rumour and a trouble as of great engines throbbing and labouring.
  15  */
  16
  17 #include "EXTERN.h"
  18 #include "perl.h"
  19
  20 /* Omit this -- it causes too much grief on mixed systems.
  21 #ifdef I_UNISTD
  22 #include <unistd.h>
  23 #endif
  24 */
  25
  26 /* Put this after #includes because fork and vfork prototypes may
  27    conflict.
  28 */
  29 #ifndef HAS_VFORK
  30 #   define vfork fork
  31 #endif
  32
  33 #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
  34 # include <sys/socket.h>
  35 # include <netdb.h>
  36 # ifndef ENOTSOCK
  37 #  ifdef I_NET_ERRNO
  38 #   include <net/errno.h>
  39 #  endif
  40 # endif
  41 #endif
  42
  43 #ifdef HAS_SELECT
  44 #ifdef I_SYS_SELECT
  45 #ifndef I_SYS_TIME
  46 #include <sys/select.h>
  47 #endif
  48 #endif
  49 #endif
  50
  51 #ifdef HOST_NOT_FOUND
  52 extern int h_errno;
  53 #endif
  54
  55 #ifdef HAS_PASSWD
  56 # ifdef I_PWD
  57 #  include <pwd.h>
  58 # else
  59     struct passwd *getpwnam _((char *));
  60     struct passwd *getpwuid _((Uid_t));
  61 # endif
  62   struct passwd *getpwent _((void));
  63 #endif
  64
  65 #ifdef HAS_GROUP
  66 # ifdef I_GRP
  67 #  include <grp.h>
  68 # else
  69     struct group *getgrnam _((char *));
  70     struct group *getgrgid _((Gid_t));
  71 # endif
  72     struct group *getgrent _((void));
  73 #endif
  74
  75 #ifdef I_UTIME
  76 #include <utime.h>
  77 #endif
  78 #ifdef I_FCNTL
  79 #include <fcntl.h>
  80 #endif
  81 #ifdef I_SYS_FILE
  82 #include <sys/file.h>
  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 #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  94 static int dooneliner _((char *cmd, char *filename));
  95 #endif
  96 /* Pushy I/O. */
  97
  98 PP(pp_backtick)
  99 {
 100     dSP; dTARGET;
 101     FILE *fp;
 102     char *tmps = POPp;
 103     TAINT_PROPER("``");
 104     fp = my_popen(tmps, "r");
 105     if (fp) {
 106         sv_setpv(TARG, "");     /* note that this preserves previous buffer */
 107         if (GIMME == G_SCALAR) {
 108             while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
 109                 /*SUPPRESS 530*/
 110                 ;
 111             XPUSHs(TARG);
 112         }
 113         else {
 114             SV *sv;
 115
 116             for (;;) {
 117                 sv = NEWSV(56, 80);
 118                 if (sv_gets(sv, fp, 0) == Nullch) {
 119                     SvREFCNT_dec(sv);
 120                     break;
 121                 }
 122                 XPUSHs(sv_2mortal(sv));
 123                 if (SvLEN(sv) - SvCUR(sv) > 20) {
 124                     SvLEN_set(sv, SvCUR(sv)+1);
 125                     Renew(SvPVX(sv), SvLEN(sv), char);
 126                 }
 127             }
 128         }
 129         statusvalue = my_pclose(fp);
 130     }
 131     else {
 132         statusvalue = -1;
 133         if (GIMME == G_SCALAR)
 134             RETPUSHUNDEF;
 135     }
 136
 137     RETURN;
 138 }
 139
 140 PP(pp_glob)
 141 {
 142     OP *result;
 143     ENTER;
 144     SAVEINT(rschar);
 145     SAVEINT(rslen);
 146
 147     SAVESPTR(last_in_gv);       /* We don't want this to be permanent. */
 148     last_in_gv = (GV*)*stack_sp--;
 149
 150     rslen = 1;
 151 #ifdef DOSISH
 152     rschar = 0;
 153 #else
 154 #ifdef CSH
 155     rschar = 0;
 156 #else
 157     rschar = '\n';
 158 #endif  /* !CSH */
 159 #endif  /* !MSDOS */
 160     result = do_readline();
 161     LEAVE;
 162     return result;
 163 }
 164
 165 PP(pp_indread)
 166 {
 167     last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
 168     return do_readline();
 169 }
 170
 171 PP(pp_rcatline)
 172 {
 173     last_in_gv = cGVOP->op_gv;
 174     return do_readline();
 175 }
 176
 177 PP(pp_warn)
 178 {
 179     dSP; dMARK;
 180     char *tmps;
 181     if (SP - MARK != 1) {
 182         dTARGET;
 183         do_join(TARG, &sv_no, MARK, SP);
 184         tmps = SvPV(TARG, na);
 185         SP = MARK + 1;
 186     }
 187     else {
 188         tmps = SvPV(TOPs, na);
 189     }
 190     if (!tmps || !*tmps) {
 191         SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
 192         (void)SvUPGRADE(error, SVt_PV);
 193         if (SvPOK(error) && SvCUR(error))
 194             sv_catpv(error, "\t...caught");
 195         tmps = SvPV(error, na);
 196     }
 197     if (!tmps || !*tmps)
 198         tmps = "Warning: something's wrong";
 199     warn("%s", tmps);
 200     RETSETYES;
 201 }
 202
 203 PP(pp_die)
 204 {
 205     dSP; dMARK;
 206     char *tmps;
 207     if (SP - MARK != 1) {
 208         dTARGET;
 209         do_join(TARG, &sv_no, MARK, SP);
 210         tmps = SvPV(TARG, na);
 211         SP = MARK + 1;
 212     }
 213     else {
 214         tmps = SvPV(TOPs, na);
 215     }
 216     if (!tmps || !*tmps) {
 217         SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
 218         (void)SvUPGRADE(error, SVt_PV);
 219         if (SvPOK(error) && SvCUR(error))
 220             sv_catpv(error, "\t...propagated");
 221         tmps = SvPV(error, na);
 222     }
 223     if (!tmps || !*tmps)
 224         tmps = "Died";
 225     DIE("%s", tmps);
 226 }
 227
 228 /* I/O. */
 229
 230 PP(pp_open)
 231 {
 232     dSP; dTARGET;
 233     GV *gv;
 234     SV *sv;
 235     char *tmps;
 236     STRLEN len;
 237
 238     if (MAXARG > 1)
 239         sv = POPs;
 240     else
 241         sv = GvSV(TOPs);
 242     gv = (GV*)POPs;
 243     tmps = SvPV(sv, len);
 244     if (do_open(gv, tmps, len,Nullfp)) {
 245         IoLINES(GvIOp(gv)) = 0;
 246         PUSHi( (I32)forkprocess );
 247     }
 248     else if (forkprocess == 0)          /* we are a new child */
 249         PUSHi(0);
 250     else
 251         RETPUSHUNDEF;
 252     RETURN;
 253 }
 254
 255 PP(pp_close)
 256 {
 257     dSP;
 258     GV *gv;
 259
 260     if (MAXARG == 0)
 261         gv = defoutgv;
 262     else
 263         gv = (GV*)POPs;
 264     EXTEND(SP, 1);
 265     PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no );
 266     RETURN;
 267 }
 268
 269 PP(pp_pipe_op)
 270 {
 271     dSP;
 272 #ifdef HAS_PIPE
 273     GV *rgv;
 274     GV *wgv;
 275     register IO *rstio;
 276     register IO *wstio;
 277     int fd[2];
 278
 279     wgv = (GV*)POPs;
 280     rgv = (GV*)POPs;
 281
 282     if (!rgv || !wgv)
 283         goto badexit;
 284
 285     rstio = GvIOn(rgv);
 286     wstio = GvIOn(wgv);
 287
 288     if (IoIFP(rstio))
 289         do_close(rgv, FALSE);
 290     if (IoIFP(wstio))
 291         do_close(wgv, FALSE);
 292
 293     if (pipe(fd) < 0)
 294         goto badexit;
 295
 296     IoIFP(rstio) = fdopen(fd[0], "r");
 297     IoOFP(wstio) = fdopen(fd[1], "w");
 298     IoIFP(wstio) = IoOFP(wstio);
 299     IoTYPE(rstio) = '<';
 300     IoTYPE(wstio) = '>';
 301
 302     if (!IoIFP(rstio) || !IoOFP(wstio)) {
 303         if (IoIFP(rstio)) fclose(IoIFP(rstio));
 304         else close(fd[0]);
 305         if (IoOFP(wstio)) fclose(IoOFP(wstio));
 306         else close(fd[1]);
 307         goto badexit;
 308     }
 309
 310     RETPUSHYES;
 311
 312 badexit:
 313     RETPUSHUNDEF;
 314 #else
 315     DIE(no_func, "pipe");
 316 #endif
 317 }
 318
 319 PP(pp_fileno)
 320 {
 321     dSP; dTARGET;
 322     GV *gv;
 323     IO *io;
 324     FILE *fp;
 325     if (MAXARG < 1)
 326         RETPUSHUNDEF;
 327     gv = (GV*)POPs;
 328     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
 329         RETPUSHUNDEF;
 330     PUSHi(fileno(fp));
 331     RETURN;
 332 }
 333
 334 PP(pp_umask)
 335 {
 336     dSP; dTARGET;
 337     int anum;
 338
 339 #ifdef HAS_UMASK
 340     if (MAXARG < 1) {
 341         anum = umask(0);
 342         (void)umask(anum);
 343     }
 344     else
 345         anum = umask(POPi);
 346     TAINT_PROPER("umask");
 347     XPUSHi(anum);
 348 #else
 349     DIE(no_func, "Unsupported function umask");
 350 #endif
 351     RETURN;
 352 }
 353
 354 PP(pp_binmode)
 355 {
 356     dSP;
 357     GV *gv;
 358     IO *io;
 359     FILE *fp;
 360
 361     if (MAXARG < 1)
 362         RETPUSHUNDEF;
 363
 364     gv = (GV*)POPs;
 365
 366     EXTEND(SP, 1);
 367     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
 368         RETSETUNDEF;
 369
 370 #ifdef DOSISH
 371 #ifdef atarist
 372     if (!fflush(fp) && (fp->_flag |= _IOBIN))
 373         RETPUSHYES;
 374     else
 375         RETPUSHUNDEF;
 376 #else
 377     if (setmode(fileno(fp), OP_BINARY) != -1)
 378         RETPUSHYES;
 379     else
 380         RETPUSHUNDEF;
 381 #endif
 382 #else
 383     RETPUSHYES;
 384 #endif
 385 }
 386
 387 PP(pp_tie)
 388 {
 389     dSP;
 390     SV *varsv;
 391     HV* stash;
 392     GV *gv;
 393     BINOP myop;
 394     SV *sv;
 395     SV **mark = stack_base + ++*markstack_ptr;  /* reuse in entersub */
 396     I32 markoff = mark - stack_base - 1;
 397     char *methname;
 398
 399     varsv = mark[0];
 400     if (SvTYPE(varsv) == SVt_PVHV)
 401         methname = "TIEHASH";
 402     else if (SvTYPE(varsv) == SVt_PVAV)
 403         methname = "TIEARRAY";
 404     else if (SvTYPE(varsv) == SVt_PVGV)
 405         methname = "TIEHANDLE";
 406     else
 407         methname = "TIESCALAR";
 408
 409     stash = gv_stashsv(mark[1], FALSE);
 410     if (!stash || !(gv = gv_fetchmethod(stash, methname)) || !GvCV(gv))
 411         DIE("Can't locate object method \"%s\" via package \"%s\"",
 412                 methname, SvPV(mark[1],na));
 413
 414     Zero(&myop, 1, BINOP);
 415     myop.op_last = (OP *) &myop;
 416     myop.op_next = Nullop;
 417     myop.op_flags = OPf_KNOW|OPf_STACKED;
 418
 419     ENTER;
 420     SAVESPTR(op);
 421     op = (OP *) &myop;
 422
 423     XPUSHs(gv);
 424     PUTBACK;
 425
 426     if (op = pp_entersub())
 427         run();
 428     SPAGAIN;
 429
 430     sv = TOPs;
 431     if (sv_isobject(sv)) {
 432         if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
 433             sv_unmagic(varsv, 'P');
 434             sv_magic(varsv, sv, 'P', Nullch, 0);
 435         }
 436         else {
 437             sv_unmagic(varsv, 'q');
 438             sv_magic(varsv, sv, 'q', Nullch, 0);
 439         }
 440     }
 441     LEAVE;
 442     SP = stack_base + markoff;
 443     PUSHs(sv);
 444     RETURN;
 445 }
 446
 447 PP(pp_untie)
 448 {
 449     dSP;
 450     if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV)
 451         sv_unmagic(TOPs, 'P');
 452     else
 453         sv_unmagic(TOPs, 'q');
 454     RETSETYES;
 455 }
 456
 457 PP(pp_dbmopen)
 458 {
 459     dSP;
 460     HV *hv;
 461     dPOPPOPssrl;
 462     HV* stash;
 463     GV *gv;
 464     BINOP myop;
 465     SV *sv;
 466
 467     hv = (HV*)POPs;
 468
 469     sv = sv_mortalcopy(&sv_no);
 470     sv_setpv(sv, "AnyDBM_File");
 471     stash = gv_stashsv(sv, FALSE);
 472     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
 473         PUTBACK;
 474         perl_requirepv("AnyDBM_File.pm");
 475         SPAGAIN;
 476         if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
 477             DIE("No dbm on this machine");
 478     }
 479
 480     Zero(&myop, 1, BINOP);
 481     myop.op_last = (OP *) &myop;
 482     myop.op_next = Nullop;
 483     myop.op_flags = OPf_KNOW|OPf_STACKED;
 484
 485     ENTER;
 486     SAVESPTR(op);
 487     op = (OP *) &myop;
 488     PUTBACK;
 489     pp_pushmark();
 490
 491     EXTEND(sp, 5);
 492     PUSHs(sv);
 493     PUSHs(left);
 494     if (SvIV(right))
 495         PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT)));
 496     else
 497         PUSHs(sv_2mortal(newSViv(O_RDWR)));
 498     PUSHs(right);
 499     PUSHs(gv);
 500     PUTBACK;
 501
 502     if (op = pp_entersub())
 503         run();
 504     SPAGAIN;
 505
 506     if (!sv_isobject(TOPs)) {
 507         sp--;
 508         op = (OP *) &myop;
 509         PUTBACK;
 510         pp_pushmark();
 511
 512         PUSHs(sv);
 513         PUSHs(left);
 514         PUSHs(sv_2mortal(newSViv(O_RDONLY)));
 515         PUSHs(right);
 516         PUSHs(gv);
 517         PUTBACK;
 518
 519         if (op = pp_entersub())
 520             run();
 521         SPAGAIN;
 522     }
 523
 524     if (sv_isobject(TOPs))
 525         sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
 526     LEAVE;
 527     RETURN;
 528 }
 529
 530 PP(pp_dbmclose)
 531 {
 532     return pp_untie(ARGS);
 533 }
 534
 535 PP(pp_sselect)
 536 {
 537     dSP; dTARGET;
 538 #ifdef HAS_SELECT
 539     register I32 i;
 540     register I32 j;
 541     register char *s;
 542     register SV *sv;
 543     double value;
 544     I32 maxlen = 0;
 545     I32 nfound;
 546     struct timeval timebuf;
 547     struct timeval *tbuf = &timebuf;
 548     I32 growsize;
 549     char *fd_sets[4];
 550 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
 551         I32 masksize;
 552         I32 offset;
 553         I32 k;
 554
 555 #   if BYTEORDER & 0xf0000
 556 #       define ORDERBYTE (0x88888888 - BYTEORDER)
 557 #   else
 558 #       define ORDERBYTE (0x4444 - BYTEORDER)
 559 #   endif
 560
 561 #endif
 562
 563     SP -= 4;
 564     for (i = 1; i <= 3; i++) {
 565         if (!SvPOK(SP[i]))
 566             continue;
 567         j = SvCUR(SP[i]);
 568         if (maxlen < j)
 569             maxlen = j;
 570     }
 571
 572 #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
 573     growsize = maxlen;          /* little endians can use vecs directly */
 574 #else
 575 #ifdef NFDBITS
 576
 577 #ifndef NBBY
 578 #define NBBY 8
 579 #endif
 580
 581     masksize = NFDBITS / NBBY;
 582 #else
 583     masksize = sizeof(long);    /* documented int, everyone seems to use long */
 584 #endif
 585     growsize = maxlen + (masksize - (maxlen % masksize));
 586     Zero(&fd_sets[0], 4, char*);
 587 #endif
 588
 589     sv = SP[4];
 590     if (SvOK(sv)) {
 591         value = SvNV(sv);
 592         if (value < 0.0)
 593             value = 0.0;
 594         timebuf.tv_sec = (long)value;
 595         value -= (double)timebuf.tv_sec;
 596         timebuf.tv_usec = (long)(value * 1000000.0);
 597     }
 598     else
 599         tbuf = Null(struct timeval*);
 600
 601     for (i = 1; i <= 3; i++) {
 602         sv = SP[i];
 603         if (!SvOK(sv)) {
 604             fd_sets[i] = 0;
 605             continue;
 606         }
 607         else if (!SvPOK(sv))
 608             SvPV_force(sv,na);  /* force string conversion */
 609         j = SvLEN(sv);
 610         if (j < growsize) {
 611             Sv_Grow(sv, growsize);
 612             s = SvPVX(sv) + j;
 613             while (++j <= growsize) {
 614                 *s++ = '\0';
 615             }
 616         }
 617 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
 618         s = SvPVX(sv);
 619         New(403, fd_sets[i], growsize, char);
 620         for (offset = 0; offset < growsize; offset += masksize) {
 621             for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
 622                 fd_sets[i][j+offset] = s[(k % masksize) + offset];
 623         }
 624 #else
 625         fd_sets[i] = SvPVX(sv);
 626 #endif
 627     }
 628
 629     nfound = select(
 630         maxlen * 8,
 631         (Select_fd_set_t) fd_sets[1],
 632         (Select_fd_set_t) fd_sets[2],
 633         (Select_fd_set_t) fd_sets[3],
 634         tbuf);
 635     for (i = 1; i <= 3; i++) {
 636         if (fd_sets[i]) {
 637             sv = SP[i];
 638 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
 639             s = SvPVX(sv);
 640             for (offset = 0; offset < growsize; offset += masksize) {
 641                 for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
 642                     s[(k % masksize) + offset] = fd_sets[i][j+offset];
 643             }
 644             Safefree(fd_sets[i]);
 645 #endif
 646             SvSETMAGIC(sv);
 647         }
 648     }
 649
 650     PUSHi(nfound);
 651     if (GIMME == G_ARRAY && tbuf) {
 652         value = (double)(timebuf.tv_sec) +
 653                 (double)(timebuf.tv_usec) / 1000000.0;
 654         PUSHs(sv = sv_mortalcopy(&sv_no));
 655         sv_setnv(sv, value);
 656     }
 657     RETURN;
 658 #else
 659     DIE("select not implemented");
 660 #endif
 661 }
 662
 663 PP(pp_select)
 664 {
 665     dSP; dTARGET;
 666     GV *oldgv = defoutgv;
 667     if (op->op_private > 0) {
 668         defoutgv = (GV*)POPs;
 669         if (!GvIO(defoutgv))
 670             gv_IOadd(defoutgv);
 671     }
 672     gv_efullname(TARG, oldgv);
 673     XPUSHTARG;
 674     RETURN;
 675 }
 676
 677 PP(pp_getc)
 678 {
 679     dSP; dTARGET;
 680     GV *gv;
 681
 682     if (MAXARG <= 0)
 683         gv = stdingv;
 684     else
 685         gv = (GV*)POPs;
 686     if (!gv)
 687         gv = argvgv;
 688     if (!gv || do_eof(gv)) /* make sure we have fp with something */
 689         RETPUSHUNDEF;
 690     TAINT_IF(1);
 691     sv_setpv(TARG, " ");
 692     *SvPVX(TARG) = getc(IoIFP(GvIOp(gv))); /* should never be EOF */
 693     PUSHTARG;
 694     RETURN;
 695 }
 696
 697 PP(pp_read)
 698 {
 699     return pp_sysread(ARGS);
 700 }
 701
 702 static OP *
 703 doform(cv,gv,retop)
 704 CV *cv;
 705 GV *gv;
 706 OP *retop;
 707 {
 708     register CONTEXT *cx;
 709     I32 gimme = GIMME;
 710     AV* padlist = CvPADLIST(cv);
 711     SV** svp = AvARRAY(padlist);
 712
 713     ENTER;
 714     SAVETMPS;
 715
 716     push_return(retop);
 717     PUSHBLOCK(cx, CXt_SUB, stack_sp);
 718     PUSHFORMAT(cx);
 719     SAVESPTR(curpad);
 720     curpad = AvARRAY((AV*)svp[1]);
 721
 722     defoutgv = gv;              /* locally select filehandle so $% et al work */
 723     return CvSTART(cv);
 724 }
 725
 726 PP(pp_enterwrite)
 727 {
 728     dSP;
 729     register GV *gv;
 730     register IO *io;
 731     GV *fgv;
 732     CV *cv;
 733
 734     if (MAXARG == 0)
 735         gv = defoutgv;
 736     else {
 737         gv = (GV*)POPs;
 738         if (!gv)
 739             gv = defoutgv;
 740     }
 741     EXTEND(SP, 1);
 742     io = GvIO(gv);
 743     if (!io) {
 744         RETPUSHNO;
 745     }
 746     if (IoFMT_GV(io))
 747         fgv = IoFMT_GV(io);
 748     else
 749         fgv = gv;
 750
 751     cv = GvFORM(fgv);
 752
 753     if (!cv) {
 754         if (fgv) {
 755             SV *tmpsv = sv_newmortal();
 756             gv_efullname(tmpsv, gv);
 757             DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
 758         }
 759         DIE("Not a format reference");
 760     }
 761     IoFLAGS(io) &= ~IOf_DIDTOP;
 762
 763     return doform(cv,gv,op->op_next);
 764 }
 765
 766 PP(pp_leavewrite)
 767 {
 768     dSP;
 769     GV *gv = cxstack[cxstack_ix].blk_sub.gv;
 770     register IO *io = GvIOp(gv);
 771     FILE *ofp = IoOFP(io);
 772     FILE *fp;
 773     SV **newsp;
 774     I32 gimme;
 775     register CONTEXT *cx;
 776
 777     DEBUG_f(fprintf(stderr,"left=%ld, todo=%ld\n",
 778           (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
 779     if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
 780         formtarget != toptarget)
 781     {
 782         if (!IoTOP_GV(io)) {
 783             GV *topgv;
 784             char tmpbuf[256];
 785
 786             if (!IoTOP_NAME(io)) {
 787                 if (!IoFMT_NAME(io))
 788                     IoFMT_NAME(io) = savepv(GvNAME(gv));
 789                 sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
 790                 topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
 791                 if ((topgv && GvFORM(topgv)) ||
 792                   !gv_fetchpv("top",FALSE,SVt_PVFM))
 793                     IoTOP_NAME(io) = savepv(tmpbuf);
 794                 else
 795                     IoTOP_NAME(io) = savepv("top");
 796             }
 797             topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM);
 798             if (!topgv || !GvFORM(topgv)) {
 799                 IoLINES_LEFT(io) = 100000000;
 800                 goto forget_top;
 801             }
 802             IoTOP_GV(io) = topgv;
 803         }
 804         if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear.  It still doesn't fit. */
 805             I32 lines = IoLINES_LEFT(io);
 806             char *s = SvPVX(formtarget);
 807             while (lines-- > 0) {
 808                 s = strchr(s, '\n');
 809                 if (!s)
 810                     break;
 811                 s++;
 812             }
 813             if (s) {
 814                 fwrite1(SvPVX(formtarget), s - SvPVX(formtarget), 1, ofp);
 815                 sv_chop(formtarget, s);
 816                 FmLINES(formtarget) -= IoLINES_LEFT(io);
 817             }
 818         }
 819         if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
 820             fwrite1(SvPVX(formfeed), SvCUR(formfeed), 1, ofp);
 821         IoLINES_LEFT(io) = IoPAGE_LEN(io);
 822         IoPAGE(io)++;
 823         formtarget = toptarget;
 824         IoFLAGS(io) |= IOf_DIDTOP;
 825         return doform(GvFORM(IoTOP_GV(io)),gv,op);
 826     }
 827
 828   forget_top:
 829     POPBLOCK(cx,curpm);
 830     POPFORMAT(cx);
 831     LEAVE;
 832
 833     fp = IoOFP(io);
 834     if (!fp) {
 835         if (dowarn) {
 836             if (IoIFP(io))
 837                 warn("Filehandle only opened for input");
 838             else
 839                 warn("Write on closed filehandle");
 840         }
 841         PUSHs(&sv_no);
 842     }
 843     else {
 844         if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) {
 845             if (dowarn)
 846                 warn("page overflow");
 847         }
 848         if (!fwrite1(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) ||
 849                 ferror(fp))
 850             PUSHs(&sv_no);
 851         else {
 852             FmLINES(formtarget) = 0;
 853             SvCUR_set(formtarget, 0);
 854             *SvEND(formtarget) = '\0';
 855             if (IoFLAGS(io) & IOf_FLUSH)
 856                 (void)fflush(fp);
 857             PUSHs(&sv_yes);
 858         }
 859     }
 860     formtarget = bodytarget;
 861     PUTBACK;
 862     return pop_return();
 863 }
 864
 865 PP(pp_prtf)
 866 {
 867     dSP; dMARK; dORIGMARK;
 868     GV *gv;
 869     IO *io;
 870     FILE *fp;
 871     SV *sv = NEWSV(0,0);
 872
 873     if (op->op_flags & OPf_STACKED)
 874         gv = (GV*)*++MARK;
 875     else
 876         gv = defoutgv;
 877     if (!(io = GvIO(gv))) {
 878         if (dowarn) {
 879             gv_fullname(sv,gv);
 880             warn("Filehandle %s never opened", SvPV(sv,na));
 881         }
 882         SETERRNO(EBADF,RMS$_IFI);
 883         goto just_say_no;
 884     }
 885     else if (!(fp = IoOFP(io))) {
 886         if (dowarn)  {
 887             gv_fullname(sv,gv);
 888             if (IoIFP(io))
 889                 warn("Filehandle %s opened only for input", SvPV(sv,na));
 890             else
 891                 warn("printf on closed filehandle %s", SvPV(sv,na));
 892         }
 893         SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
 894         goto just_say_no;
 895     }
 896     else {
 897         do_sprintf(sv, SP - MARK, MARK + 1);
 898         if (!do_print(sv, fp))
 899             goto just_say_no;
 900
 901         if (IoFLAGS(io) & IOf_FLUSH)
 902             if (fflush(fp) == EOF)
 903                 goto just_say_no;
 904     }
 905     SvREFCNT_dec(sv);
 906     SP = ORIGMARK;
 907     PUSHs(&sv_yes);
 908     RETURN;
 909
 910   just_say_no:
 911     SvREFCNT_dec(sv);
 912     SP = ORIGMARK;
 913     PUSHs(&sv_undef);
 914     RETURN;
 915 }
 916
 917 PP(pp_sysread)
 918 {
 919     dSP; dMARK; dORIGMARK; dTARGET;
 920     int offset;
 921     GV *gv;
 922     IO *io;
 923     char *buffer;
 924     int length;
 925     int bufsize;
 926     SV *bufsv;
 927     STRLEN blen;
 928
 929     gv = (GV*)*++MARK;
 930     if (!gv)
 931         goto say_undef;
 932     bufsv = *++MARK;
 933     buffer = SvPV_force(bufsv, blen);
 934     length = SvIVx(*++MARK);
 935     if (length < 0)
 936         DIE("Negative length");
 937     SETERRNO(0,0);
 938     if (MARK < SP)
 939         offset = SvIVx(*++MARK);
 940     else
 941         offset = 0;
 942     io = GvIO(gv);
 943     if (!io || !IoIFP(io))
 944         goto say_undef;
 945 #ifdef HAS_SOCKET
 946     if (op->op_type == OP_RECV) {
 947         bufsize = sizeof buf;
 948         buffer = SvGROW(bufsv, length+1);
 949         length = recvfrom(fileno(IoIFP(io)), buffer, length, offset,
 950             (struct sockaddr *)buf, &bufsize);
 951         if (length < 0)
 952             RETPUSHUNDEF;
 953         SvCUR_set(bufsv, length);
 954         *SvEND(bufsv) = '\0';
 955         (void)SvPOK_only(bufsv);
 956         SvSETMAGIC(bufsv);
 957         if (tainting)
 958             sv_magic(bufsv, Nullsv, 't', Nullch, 0);
 959         SP = ORIGMARK;
 960         sv_setpvn(TARG, buf, bufsize);
 961         PUSHs(TARG);
 962         RETURN;
 963     }
 964 #else
 965     if (op->op_type == OP_RECV)
 966         DIE(no_sock_func, "recv");
 967 #endif
 968     buffer = SvGROW(bufsv, length+offset+1);
 969     if (op->op_type == OP_SYSREAD) {
 970         length = read(fileno(IoIFP(io)), buffer+offset, length);
 971     }
 972     else
 973 #ifdef HAS_SOCKET__bad_code_maybe
 974     if (IoTYPE(io) == 's') {
 975         bufsize = sizeof buf;
 976         length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0,
 977             (struct sockaddr *)buf, &bufsize);
 978     }
 979     else
 980 #endif
 981         length = fread(buffer+offset, 1, length, IoIFP(io));
 982     if (length < 0)
 983         goto say_undef;
 984     SvCUR_set(bufsv, length+offset);
 985     *SvEND(bufsv) = '\0';
 986     (void)SvPOK_only(bufsv);
 987     SvSETMAGIC(bufsv);
 988     if (tainting)
 989         sv_magic(bufsv, Nullsv, 't', Nullch, 0);
 990     SP = ORIGMARK;
 991     PUSHi(length);
 992     RETURN;
 993
 994   say_undef:
 995     SP = ORIGMARK;
 996     RETPUSHUNDEF;
 997 }
 998
 999 PP(pp_syswrite)
1000 {
1001     return pp_send(ARGS);
1002 }
1003
1004 PP(pp_send)
1005 {
1006     dSP; dMARK; dORIGMARK; dTARGET;
1007     GV *gv;
1008     IO *io;
1009     int offset;
1010     SV *bufsv;
1011     char *buffer;
1012     int length;
1013     STRLEN blen;
1014
1015     gv = (GV*)*++MARK;
1016     if (!gv)
1017         goto say_undef;
1018     bufsv = *++MARK;
1019     buffer = SvPV(bufsv, blen);
1020     length = SvIVx(*++MARK);
1021     if (length < 0)
1022         DIE("Negative length");
1023     SETERRNO(0,0);
1024     io = GvIO(gv);
1025     if (!io || !IoIFP(io)) {
1026         length = -1;
1027         if (dowarn) {
1028             if (op->op_type == OP_SYSWRITE)
1029                 warn("Syswrite on closed filehandle");
1030             else
1031                 warn("Send on closed socket");
1032         }
1033     }
1034     else if (op->op_type == OP_SYSWRITE) {
1035         if (MARK < SP)
1036             offset = SvIVx(*++MARK);
1037         else
1038             offset = 0;
1039         if (length > blen - offset)
1040             length = blen - offset;
1041         length = write(fileno(IoIFP(io)), buffer+offset, length);
1042     }
1043 #ifdef HAS_SOCKET
1044     else if (SP > MARK) {
1045         char *sockbuf;
1046         STRLEN mlen;
1047         sockbuf = SvPVx(*++MARK, mlen);
1048         length = sendto(fileno(IoIFP(io)), buffer, blen, length,
1049                                 (struct sockaddr *)sockbuf, mlen);
1050     }
1051     else
1052         length = send(fileno(IoIFP(io)), buffer, blen, length);
1053 #else
1054     else
1055         DIE(no_sock_func, "send");
1056 #endif
1057     if (length < 0)
1058         goto say_undef;
1059     SP = ORIGMARK;
1060     PUSHi(length);
1061     RETURN;
1062
1063   say_undef:
1064     SP = ORIGMARK;
1065     RETPUSHUNDEF;
1066 }
1067
1068 PP(pp_recv)
1069 {
1070     return pp_sysread(ARGS);
1071 }
1072
1073 PP(pp_eof)
1074 {
1075     dSP;
1076     GV *gv;
1077
1078     if (MAXARG <= 0)
1079         gv = last_in_gv;
1080     else
1081         gv = last_in_gv = (GV*)POPs;
1082     PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no);
1083     RETURN;
1084 }
1085
1086 PP(pp_tell)
1087 {
1088     dSP; dTARGET;
1089     GV *gv;
1090
1091     if (MAXARG <= 0)
1092         gv = last_in_gv;
1093     else
1094         gv = last_in_gv = (GV*)POPs;
1095     PUSHi( do_tell(gv) );
1096     RETURN;
1097 }
1098
1099 PP(pp_seek)
1100 {
1101     dSP;
1102     GV *gv;
1103     int whence = POPi;
1104     long offset = POPl;
1105
1106     gv = last_in_gv = (GV*)POPs;
1107     PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no );
1108     RETURN;
1109 }
1110
1111 PP(pp_truncate)
1112 {
1113     dSP;
1114     Off_t len = (Off_t)POPn;
1115     int result = 1;
1116     GV *tmpgv;
1117
1118     SETERRNO(0,0);
1119 #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
1120 #ifdef HAS_TRUNCATE
1121     if (op->op_flags & OPf_SPECIAL) {
1122         tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
1123         if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
1124           ftruncate(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
1125             result = 0;
1126     }
1127     else if (truncate(POPp, len) < 0)
1128         result = 0;
1129 #else
1130     if (op->op_flags & OPf_SPECIAL) {
1131         tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
1132         if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
1133           chsize(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
1134             result = 0;
1135     }
1136     else {
1137         int tmpfd;
1138
1139         if ((tmpfd = open(POPp, 0)) < 0)
1140             result = 0;
1141         else {
1142             if (chsize(tmpfd, len) < 0)
1143                 result = 0;
1144             close(tmpfd);
1145         }
1146     }
1147 #endif
1148
1149     if (result)
1150         RETPUSHYES;
1151     if (!errno)
1152         SETERRNO(EBADF,RMS$_IFI);
1153     RETPUSHUNDEF;
1154 #else
1155     DIE("truncate not implemented");
1156 #endif
1157 }
1158
1159 PP(pp_fcntl)
1160 {
1161     return pp_ioctl(ARGS);
1162 }
1163
1164 PP(pp_ioctl)
1165 {
1166     dSP; dTARGET;
1167     SV *argsv = POPs;
1168     unsigned int func = U_I(POPn);
1169     int optype = op->op_type;
1170     char *s;
1171     int retval;
1172     GV *gv = (GV*)POPs;
1173     IO *io = GvIOn(gv);
1174
1175     if (!io || !argsv || !IoIFP(io)) {
1176         SETERRNO(EBADF,RMS$_IFI);       /* well, sort of... */
1177         RETPUSHUNDEF;
1178     }
1179
1180     if (SvPOK(argsv) || !SvNIOK(argsv)) {
1181         STRLEN len;
1182         s = SvPV_force(argsv, len);
1183         retval = IOCPARM_LEN(func);
1184         if (len < retval) {
1185             s = Sv_Grow(argsv, retval+1);
1186             SvCUR_set(argsv, retval);
1187         }
1188
1189         s[SvCUR(argsv)] = 17;   /* a little sanity check here */
1190     }
1191     else {
1192         retval = SvIV(argsv);
1193 #ifdef DOSISH
1194         s = (char*)(long)retval;        /* ouch */
1195 #else
1196         s = (char*)retval;              /* ouch */
1197 #endif
1198     }
1199
1200     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
1201
1202     if (optype == OP_IOCTL)
1203 #ifdef HAS_IOCTL
1204         retval = ioctl(fileno(IoIFP(io)), func, s);
1205 #else
1206         DIE("ioctl is not implemented");
1207 #endif
1208     else
1209 #ifdef DOSISH
1210         DIE("fcntl is not implemented");
1211 #else
1212 #   ifdef HAS_FCNTL
1213         retval = fcntl(fileno(IoIFP(io)), func, s);
1214 #   else
1215         DIE("fcntl is not implemented");
1216 #   endif
1217 #endif
1218
1219     if (SvPOK(argsv)) {
1220         if (s[SvCUR(argsv)] != 17)
1221             DIE("Possible memory corruption: %s overflowed 3rd argument",
1222                 op_name[optype]);
1223         s[SvCUR(argsv)] = 0;            /* put our null back */
1224         SvSETMAGIC(argsv);              /* Assume it has changed */
1225     }
1226
1227     if (retval == -1)
1228         RETPUSHUNDEF;
1229     if (retval != 0) {
1230         PUSHi(retval);
1231     }
1232     else {
1233         PUSHp("0 but true", 10);
1234     }
1235     RETURN;
1236 }
1237
1238 PP(pp_flock)
1239 {
1240     dSP; dTARGET;
1241     I32 value;
1242     int argtype;
1243     GV *gv;
1244     FILE *fp;
1245 #ifdef HAS_FLOCK
1246     argtype = POPi;
1247     if (MAXARG <= 0)
1248         gv = last_in_gv;
1249     else
1250         gv = (GV*)POPs;
1251     if (gv && GvIO(gv))
1252         fp = IoIFP(GvIOp(gv));
1253     else
1254         fp = Nullfp;
1255     if (fp) {
1256         value = (I32)(flock(fileno(fp), argtype) >= 0);
1257     }
1258     else
1259         value = 0;
1260     PUSHi(value);
1261     RETURN;
1262 #else
1263 # ifdef HAS_LOCKF
1264     DIE(no_func, "flock()"); /* XXX emulate flock() with lockf()? */
1265 # else
1266     DIE(no_func, "flock()");
1267 # endif
1268 #endif
1269 }
1270
1271 /* Sockets. */
1272
1273 PP(pp_socket)
1274 {
1275     dSP;
1276 #ifdef HAS_SOCKET
1277     GV *gv;
1278     register IO *io;
1279     int protocol = POPi;
1280     int type = POPi;
1281     int domain = POPi;
1282     int fd;
1283
1284     gv = (GV*)POPs;
1285
1286     if (!gv) {
1287         SETERRNO(EBADF,LIB$_INVARG);
1288         RETPUSHUNDEF;
1289     }
1290
1291     io = GvIOn(gv);
1292     if (IoIFP(io))
1293         do_close(gv, FALSE);
1294
1295     TAINT_PROPER("socket");
1296     fd = socket(domain, type, protocol);
1297     if (fd < 0)
1298         RETPUSHUNDEF;
1299     IoIFP(io) = fdopen(fd, "r");        /* stdio gets confused about sockets */
1300     IoOFP(io) = fdopen(fd, "w");
1301     IoTYPE(io) = 's';
1302     if (!IoIFP(io) || !IoOFP(io)) {
1303         if (IoIFP(io)) fclose(IoIFP(io));
1304         if (IoOFP(io)) fclose(IoOFP(io));
1305         if (!IoIFP(io) && !IoOFP(io)) close(fd);
1306         RETPUSHUNDEF;
1307     }
1308
1309     RETPUSHYES;
1310 #else
1311     DIE(no_sock_func, "socket");
1312 #endif
1313 }
1314
1315 PP(pp_sockpair)
1316 {
1317     dSP;
1318 #ifdef HAS_SOCKETPAIR
1319     GV *gv1;
1320     GV *gv2;
1321     register IO *io1;
1322     register IO *io2;
1323     int protocol = POPi;
1324     int type = POPi;
1325     int domain = POPi;
1326     int fd[2];
1327
1328     gv2 = (GV*)POPs;
1329     gv1 = (GV*)POPs;
1330     if (!gv1 || !gv2)
1331         RETPUSHUNDEF;
1332
1333     io1 = GvIOn(gv1);
1334     io2 = GvIOn(gv2);
1335     if (IoIFP(io1))
1336         do_close(gv1, FALSE);
1337     if (IoIFP(io2))
1338         do_close(gv2, FALSE);
1339
1340     TAINT_PROPER("socketpair");
1341     if (socketpair(domain, type, protocol, fd) < 0)
1342         RETPUSHUNDEF;
1343     IoIFP(io1) = fdopen(fd[0], "r");
1344     IoOFP(io1) = fdopen(fd[0], "w");
1345     IoTYPE(io1) = 's';
1346     IoIFP(io2) = fdopen(fd[1], "r");
1347     IoOFP(io2) = fdopen(fd[1], "w");
1348     IoTYPE(io2) = 's';
1349     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
1350         if (IoIFP(io1)) fclose(IoIFP(io1));
1351         if (IoOFP(io1)) fclose(IoOFP(io1));
1352         if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
1353         if (IoIFP(io2)) fclose(IoIFP(io2));
1354         if (IoOFP(io2)) fclose(IoOFP(io2));
1355         if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
1356         RETPUSHUNDEF;
1357     }
1358
1359     RETPUSHYES;
1360 #else
1361     DIE(no_sock_func, "socketpair");
1362 #endif
1363 }
1364
1365 PP(pp_bind)
1366 {
1367     dSP;
1368 #ifdef HAS_SOCKET
1369     SV *addrsv = POPs;
1370     char *addr;
1371     GV *gv = (GV*)POPs;
1372     register IO *io = GvIOn(gv);
1373     STRLEN len;
1374
1375     if (!io || !IoIFP(io))
1376         goto nuts;
1377
1378     addr = SvPV(addrsv, len);
1379     TAINT_PROPER("bind");
1380     if (bind(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
1381         RETPUSHYES;
1382     else
1383         RETPUSHUNDEF;
1384
1385 nuts:
1386     if (dowarn)
1387         warn("bind() on closed fd");
1388     SETERRNO(EBADF,SS$_IVCHAN);
1389     RETPUSHUNDEF;
1390 #else
1391     DIE(no_sock_func, "bind");
1392 #endif
1393 }
1394
1395 PP(pp_connect)
1396 {
1397     dSP;
1398 #ifdef HAS_SOCKET
1399     SV *addrsv = POPs;
1400     char *addr;
1401     GV *gv = (GV*)POPs;
1402     register IO *io = GvIOn(gv);
1403     STRLEN len;
1404
1405     if (!io || !IoIFP(io))
1406         goto nuts;
1407
1408     addr = SvPV(addrsv, len);
1409     TAINT_PROPER("connect");
1410     if (connect(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
1411         RETPUSHYES;
1412     else
1413         RETPUSHUNDEF;
1414
1415 nuts:
1416     if (dowarn)
1417         warn("connect() on closed fd");
1418     SETERRNO(EBADF,SS$_IVCHAN);
1419     RETPUSHUNDEF;
1420 #else
1421     DIE(no_sock_func, "connect");
1422 #endif
1423 }
1424
1425 PP(pp_listen)
1426 {
1427     dSP;
1428 #ifdef HAS_SOCKET
1429     int backlog = POPi;
1430     GV *gv = (GV*)POPs;
1431     register IO *io = GvIOn(gv);
1432
1433     if (!io || !IoIFP(io))
1434         goto nuts;
1435
1436     if (listen(fileno(IoIFP(io)), backlog) >= 0)
1437         RETPUSHYES;
1438     else
1439         RETPUSHUNDEF;
1440
1441 nuts:
1442     if (dowarn)
1443         warn("listen() on closed fd");
1444     SETERRNO(EBADF,SS$_IVCHAN);
1445     RETPUSHUNDEF;
1446 #else
1447     DIE(no_sock_func, "listen");
1448 #endif
1449 }
1450
1451 PP(pp_accept)
1452 {
1453     struct sockaddr_in saddr;   /* use a struct to avoid alignment problems */
1454     dSP; dTARGET;
1455 #ifdef HAS_SOCKET
1456     GV *ngv;
1457     GV *ggv;
1458     register IO *nstio;
1459     register IO *gstio;
1460     int len = sizeof saddr;
1461     int fd;
1462
1463     ggv = (GV*)POPs;
1464     ngv = (GV*)POPs;
1465
1466     if (!ngv)
1467         goto badexit;
1468     if (!ggv)
1469         goto nuts;
1470
1471     gstio = GvIO(ggv);
1472     if (!gstio || !IoIFP(gstio))
1473         goto nuts;
1474
1475     nstio = GvIOn(ngv);
1476     if (IoIFP(nstio))
1477         do_close(ngv, FALSE);
1478
1479     fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
1480     if (fd < 0)
1481         goto badexit;
1482     IoIFP(nstio) = fdopen(fd, "r");
1483     IoOFP(nstio) = fdopen(fd, "w");
1484     IoTYPE(nstio) = 's';
1485     if (!IoIFP(nstio) || !IoOFP(nstio)) {
1486         if (IoIFP(nstio)) fclose(IoIFP(nstio));
1487         if (IoOFP(nstio)) fclose(IoOFP(nstio));
1488         if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
1489         goto badexit;
1490     }
1491
1492     PUSHp((char *)&saddr, len);
1493     RETURN;
1494
1495 nuts:
1496     if (dowarn)
1497         warn("accept() on closed fd");
1498     SETERRNO(EBADF,SS$_IVCHAN);
1499
1500 badexit:
1501     RETPUSHUNDEF;
1502
1503 #else
1504     DIE(no_sock_func, "accept");
1505 #endif
1506 }
1507
1508 PP(pp_shutdown)
1509 {
1510     dSP; dTARGET;
1511 #ifdef HAS_SOCKET
1512     int how = POPi;
1513     GV *gv = (GV*)POPs;
1514     register IO *io = GvIOn(gv);
1515
1516     if (!io || !IoIFP(io))
1517         goto nuts;
1518
1519     PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 );
1520     RETURN;
1521
1522 nuts:
1523     if (dowarn)
1524         warn("shutdown() on closed fd");
1525     SETERRNO(EBADF,SS$_IVCHAN);
1526     RETPUSHUNDEF;
1527 #else
1528     DIE(no_sock_func, "shutdown");
1529 #endif
1530 }
1531
1532 PP(pp_gsockopt)
1533 {
1534 #ifdef HAS_SOCKET
1535     return pp_ssockopt(ARGS);
1536 #else
1537     DIE(no_sock_func, "getsockopt");
1538 #endif
1539 }
1540
1541 PP(pp_ssockopt)
1542 {
1543     dSP;
1544 #ifdef HAS_SOCKET
1545     int optype = op->op_type;
1546     SV *sv;
1547     int fd;
1548     unsigned int optname;
1549     unsigned int lvl;
1550     GV *gv;
1551     register IO *io;
1552     int aint;
1553
1554     if (optype == OP_GSOCKOPT)
1555         sv = sv_2mortal(NEWSV(22, 257));
1556     else
1557         sv = POPs;
1558     optname = (unsigned int) POPi;
1559     lvl = (unsigned int) POPi;
1560
1561     gv = (GV*)POPs;
1562     io = GvIOn(gv);
1563     if (!io || !IoIFP(io))
1564         goto nuts;
1565
1566     fd = fileno(IoIFP(io));
1567     switch (optype) {
1568     case OP_GSOCKOPT:
1569         SvGROW(sv, 257);
1570         (void)SvPOK_only(sv);
1571         SvCUR_set(sv,256);
1572         *SvEND(sv) ='\0';
1573         aint = SvCUR(sv);
1574         if (getsockopt(fd, lvl, optname, SvPVX(sv), &aint) < 0)
1575             goto nuts2;
1576         SvCUR_set(sv,aint);
1577         *SvEND(sv) ='\0';
1578         PUSHs(sv);
1579         break;
1580     case OP_SSOCKOPT: {
1581             STRLEN len = 0;
1582             char *buf = 0;
1583             if (SvPOKp(sv))
1584                 buf = SvPV(sv, len);
1585             else if (SvOK(sv)) {
1586                 aint = (int)SvIV(sv);
1587                 buf = (char*)&aint;
1588                 len = sizeof(int);
1589             }
1590             if (setsockopt(fd, lvl, optname, buf, (int)len) < 0)
1591                 goto nuts2;
1592             PUSHs(&sv_yes);
1593         }
1594         break;
1595     }
1596     RETURN;
1597
1598 nuts:
1599     if (dowarn)
1600         warn("[gs]etsockopt() on closed fd");
1601     SETERRNO(EBADF,SS$_IVCHAN);
1602 nuts2:
1603     RETPUSHUNDEF;
1604
1605 #else
1606     DIE(no_sock_func, "setsockopt");
1607 #endif
1608 }
1609
1610 PP(pp_getsockname)
1611 {
1612 #ifdef HAS_SOCKET
1613     return pp_getpeername(ARGS);
1614 #else
1615     DIE(no_sock_func, "getsockname");
1616 #endif
1617 }
1618
1619 PP(pp_getpeername)
1620 {
1621     dSP;
1622 #ifdef HAS_SOCKET
1623     int optype = op->op_type;
1624     SV *sv;
1625     int fd;
1626     GV *gv = (GV*)POPs;
1627     register IO *io = GvIOn(gv);
1628     int aint;
1629
1630     if (!io || !IoIFP(io))
1631         goto nuts;
1632
1633     sv = sv_2mortal(NEWSV(22, 257));
1634     (void)SvPOK_only(sv);
1635     SvCUR_set(sv,256);
1636     *SvEND(sv) ='\0';
1637     aint = SvCUR(sv);
1638     fd = fileno(IoIFP(io));
1639     switch (optype) {
1640     case OP_GETSOCKNAME:
1641         if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
1642             goto nuts2;
1643         break;
1644     case OP_GETPEERNAME:
1645         if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
1646             goto nuts2;
1647         break;
1648     }
1649     SvCUR_set(sv,aint);
1650     *SvEND(sv) ='\0';
1651     PUSHs(sv);
1652     RETURN;
1653
1654 nuts:
1655     if (dowarn)
1656         warn("get{sock, peer}name() on closed fd");
1657     SETERRNO(EBADF,SS$_IVCHAN);
1658 nuts2:
1659     RETPUSHUNDEF;
1660
1661 #else
1662     DIE(no_sock_func, "getpeername");
1663 #endif
1664 }
1665
1666 /* Stat calls. */
1667
1668 PP(pp_lstat)
1669 {
1670     return pp_stat(ARGS);
1671 }
1672
1673 PP(pp_stat)
1674 {
1675     dSP;
1676     GV *tmpgv;
1677     I32 max = 13;
1678
1679     if (op->op_flags & OPf_REF) {
1680         tmpgv = cGVOP->op_gv;
1681       do_fstat:
1682         if (tmpgv != defgv) {
1683             laststype = OP_STAT;
1684             statgv = tmpgv;
1685             sv_setpv(statname, "");
1686             if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
1687               Fstat(fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) {
1688                 max = 0;
1689                 laststatval = -1;
1690             }
1691         }
1692         else if (laststatval < 0)
1693             max = 0;
1694     }
1695     else {
1696         SV* sv = POPs;
1697         if (SvTYPE(sv) == SVt_PVGV) {
1698             tmpgv = (GV*)sv;
1699             goto do_fstat;
1700         }
1701         else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
1702             tmpgv = (GV*)SvRV(sv);
1703             goto do_fstat;
1704         }
1705         sv_setpv(statname, SvPV(sv,na));
1706         statgv = Nullgv;
1707 #ifdef HAS_LSTAT
1708         laststype = op->op_type;
1709         if (op->op_type == OP_LSTAT)
1710             laststatval = lstat(SvPV(statname, na), &statcache);
1711         else
1712 #endif
1713             laststatval = Stat(SvPV(statname, na), &statcache);
1714         if (laststatval < 0) {
1715             if (dowarn && strchr(SvPV(statname, na), '\n'))
1716                 warn(warn_nl, "stat");
1717             max = 0;
1718         }
1719     }
1720
1721     EXTEND(SP, 13);
1722     if (GIMME != G_ARRAY) {
1723         if (max)
1724             RETPUSHYES;
1725         else
1726             RETPUSHUNDEF;
1727     }
1728     if (max) {
1729         PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
1730         PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
1731         PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
1732         PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
1733         PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
1734         PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
1735         PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
1736         PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
1737         PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime)));
1738         PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
1739         PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime)));
1740 #ifdef USE_STAT_BLOCKS
1741         PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
1742         PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
1743 #else
1744         PUSHs(sv_2mortal(newSVpv("", 0)));
1745         PUSHs(sv_2mortal(newSVpv("", 0)));
1746 #endif
1747     }
1748     RETURN;
1749 }
1750
1751 PP(pp_ftrread)
1752 {
1753     I32 result = my_stat(ARGS);
1754     dSP;
1755     if (result < 0)
1756         RETPUSHUNDEF;
1757     if (cando(S_IRUSR, 0, &statcache))
1758         RETPUSHYES;
1759     RETPUSHNO;
1760 }
1761
1762 PP(pp_ftrwrite)
1763 {
1764     I32 result = my_stat(ARGS);
1765     dSP;
1766     if (result < 0)
1767         RETPUSHUNDEF;
1768     if (cando(S_IWUSR, 0, &statcache))
1769         RETPUSHYES;
1770     RETPUSHNO;
1771 }
1772
1773 PP(pp_ftrexec)
1774 {
1775     I32 result = my_stat(ARGS);
1776     dSP;
1777     if (result < 0)
1778         RETPUSHUNDEF;
1779     if (cando(S_IXUSR, 0, &statcache))
1780         RETPUSHYES;
1781     RETPUSHNO;
1782 }
1783
1784 PP(pp_fteread)
1785 {
1786     I32 result = my_stat(ARGS);
1787     dSP;
1788     if (result < 0)
1789         RETPUSHUNDEF;
1790     if (cando(S_IRUSR, 1, &statcache))
1791         RETPUSHYES;
1792     RETPUSHNO;
1793 }
1794
1795 PP(pp_ftewrite)
1796 {
1797     I32 result = my_stat(ARGS);
1798     dSP;
1799     if (result < 0)
1800         RETPUSHUNDEF;
1801     if (cando(S_IWUSR, 1, &statcache))
1802         RETPUSHYES;
1803     RETPUSHNO;
1804 }
1805
1806 PP(pp_fteexec)
1807 {
1808     I32 result = my_stat(ARGS);
1809     dSP;
1810     if (result < 0)
1811         RETPUSHUNDEF;
1812     if (cando(S_IXUSR, 1, &statcache))
1813         RETPUSHYES;
1814     RETPUSHNO;
1815 }
1816
1817 PP(pp_ftis)
1818 {
1819     I32 result = my_stat(ARGS);
1820     dSP;
1821     if (result < 0)
1822         RETPUSHUNDEF;
1823     RETPUSHYES;
1824 }
1825
1826 PP(pp_fteowned)
1827 {
1828     return pp_ftrowned(ARGS);
1829 }
1830
1831 PP(pp_ftrowned)
1832 {
1833     I32 result = my_stat(ARGS);
1834     dSP;
1835     if (result < 0)
1836         RETPUSHUNDEF;
1837     if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
1838         RETPUSHYES;
1839     RETPUSHNO;
1840 }
1841
1842 PP(pp_ftzero)
1843 {
1844     I32 result = my_stat(ARGS);
1845     dSP;
1846     if (result < 0)
1847         RETPUSHUNDEF;
1848     if (!statcache.st_size)
1849         RETPUSHYES;
1850     RETPUSHNO;
1851 }
1852
1853 PP(pp_ftsize)
1854 {
1855     I32 result = my_stat(ARGS);
1856     dSP; dTARGET;
1857     if (result < 0)
1858         RETPUSHUNDEF;
1859     PUSHi(statcache.st_size);
1860     RETURN;
1861 }
1862
1863 PP(pp_ftmtime)
1864 {
1865     I32 result = my_stat(ARGS);
1866     dSP; dTARGET;
1867     if (result < 0)
1868         RETPUSHUNDEF;
1869     PUSHn( (basetime - statcache.st_mtime) / 86400.0 );
1870     RETURN;
1871 }
1872
1873 PP(pp_ftatime)
1874 {
1875     I32 result = my_stat(ARGS);
1876     dSP; dTARGET;
1877     if (result < 0)
1878         RETPUSHUNDEF;
1879     PUSHn( (basetime - statcache.st_atime) / 86400.0 );
1880     RETURN;
1881 }
1882
1883 PP(pp_ftctime)
1884 {
1885     I32 result = my_stat(ARGS);
1886     dSP; dTARGET;
1887     if (result < 0)
1888         RETPUSHUNDEF;
1889     PUSHn( (basetime - statcache.st_ctime) / 86400.0 );
1890     RETURN;
1891 }
1892
1893 PP(pp_ftsock)
1894 {
1895     I32 result = my_stat(ARGS);
1896     dSP;
1897     if (result < 0)
1898         RETPUSHUNDEF;
1899     if (S_ISSOCK(statcache.st_mode))
1900         RETPUSHYES;
1901     RETPUSHNO;
1902 }
1903
1904 PP(pp_ftchr)
1905 {
1906     I32 result = my_stat(ARGS);
1907     dSP;
1908     if (result < 0)
1909         RETPUSHUNDEF;
1910     if (S_ISCHR(statcache.st_mode))
1911         RETPUSHYES;
1912     RETPUSHNO;
1913 }
1914
1915 PP(pp_ftblk)
1916 {
1917     I32 result = my_stat(ARGS);
1918     dSP;
1919     if (result < 0)
1920         RETPUSHUNDEF;
1921     if (S_ISBLK(statcache.st_mode))
1922         RETPUSHYES;
1923     RETPUSHNO;
1924 }
1925
1926 PP(pp_ftfile)
1927 {
1928     I32 result = my_stat(ARGS);
1929     dSP;
1930     if (result < 0)
1931         RETPUSHUNDEF;
1932     if (S_ISREG(statcache.st_mode))
1933         RETPUSHYES;
1934     RETPUSHNO;
1935 }
1936
1937 PP(pp_ftdir)
1938 {
1939     I32 result = my_stat(ARGS);
1940     dSP;
1941     if (result < 0)
1942         RETPUSHUNDEF;
1943     if (S_ISDIR(statcache.st_mode))
1944         RETPUSHYES;
1945     RETPUSHNO;
1946 }
1947
1948 PP(pp_ftpipe)
1949 {
1950     I32 result = my_stat(ARGS);
1951     dSP;
1952     if (result < 0)
1953         RETPUSHUNDEF;
1954     if (S_ISFIFO(statcache.st_mode))
1955         RETPUSHYES;
1956     RETPUSHNO;
1957 }
1958
1959 PP(pp_ftlink)
1960 {
1961     I32 result = my_lstat(ARGS);
1962     dSP;
1963     if (result < 0)
1964         RETPUSHUNDEF;
1965     if (S_ISLNK(statcache.st_mode))
1966         RETPUSHYES;
1967     RETPUSHNO;
1968 }
1969
1970 PP(pp_ftsuid)
1971 {
1972     dSP;
1973 #ifdef S_ISUID
1974     I32 result = my_stat(ARGS);
1975     SPAGAIN;
1976     if (result < 0)
1977         RETPUSHUNDEF;
1978     if (statcache.st_mode & S_ISUID)
1979         RETPUSHYES;
1980 #endif
1981     RETPUSHNO;
1982 }
1983
1984 PP(pp_ftsgid)
1985 {
1986     dSP;
1987 #ifdef S_ISGID
1988     I32 result = my_stat(ARGS);
1989     SPAGAIN;
1990     if (result < 0)
1991         RETPUSHUNDEF;
1992     if (statcache.st_mode & S_ISGID)
1993         RETPUSHYES;
1994 #endif
1995     RETPUSHNO;
1996 }
1997
1998 PP(pp_ftsvtx)
1999 {
2000     dSP;
2001 #ifdef S_ISVTX
2002     I32 result = my_stat(ARGS);
2003     SPAGAIN;
2004     if (result < 0)
2005         RETPUSHUNDEF;
2006     if (statcache.st_mode & S_ISVTX)
2007         RETPUSHYES;
2008 #endif
2009     RETPUSHNO;
2010 }
2011
2012 PP(pp_fttty)
2013 {
2014     dSP;
2015     int fd;
2016     GV *gv;
2017     char *tmps;
2018     if (op->op_flags & OPf_REF) {
2019         gv = cGVOP->op_gv;
2020         tmps = "";
2021     }
2022     else
2023         gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
2024     if (GvIO(gv) && IoIFP(GvIOp(gv)))
2025         fd = fileno(IoIFP(GvIOp(gv)));
2026     else if (isDIGIT(*tmps))
2027         fd = atoi(tmps);
2028     else
2029         RETPUSHUNDEF;
2030     if (isatty(fd))
2031         RETPUSHYES;
2032     RETPUSHNO;
2033 }
2034
2035 #if defined(USE_STD_STDIO) || defined(atarist) /* this will work with atariST */
2036 # define FBASE(f) ((f)->_base)
2037 # define FSIZE(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
2038 # define FPTR(f) ((f)->_ptr)
2039 # define FCOUNT(f) ((f)->_cnt)
2040 #else
2041 # if defined(USE_LINUX_STDIO)
2042 #   define FBASE(f) ((f)->_IO_read_base)
2043 #   define FSIZE(f) ((f)->_IO_read_end - FBASE(f))
2044 #   define FPTR(f) ((f)->_IO_read_ptr)
2045 #   define FCOUNT(f) ((f)->_IO_read_end - FPTR(f))
2046 # endif
2047 #endif
2048
2049 PP(pp_fttext)
2050 {
2051     dSP;
2052     I32 i;
2053     I32 len;
2054     I32 odd = 0;
2055     STDCHAR tbuf[512];
2056     register STDCHAR *s;
2057     register IO *io;
2058     SV *sv;
2059
2060     if (op->op_flags & OPf_REF) {
2061         EXTEND(SP, 1);
2062         if (cGVOP->op_gv == defgv) {
2063             if (statgv)
2064                 io = GvIO(statgv);
2065             else {
2066                 sv = statname;
2067                 goto really_filename;
2068             }
2069         }
2070         else {
2071             statgv = cGVOP->op_gv;
2072             sv_setpv(statname, "");
2073             io = GvIO(statgv);
2074         }
2075         if (io && IoIFP(io)) {
2076 #ifdef FBASE
2077             Fstat(fileno(IoIFP(io)), &statcache);
2078             if (S_ISDIR(statcache.st_mode))     /* handle NFS glitch */
2079                 if (op->op_type == OP_FTTEXT)
2080                     RETPUSHNO;
2081                 else
2082                     RETPUSHYES;
2083             if (FCOUNT(IoIFP(io)) <= 0) {
2084                 i = getc(IoIFP(io));
2085                 if (i != EOF)
2086                     (void)ungetc(i, IoIFP(io));
2087             }
2088             if (FCOUNT(IoIFP(io)) <= 0) /* null file is anything */
2089                 RETPUSHYES;
2090             len = FSIZE(IoIFP(io));
2091             s = FBASE(IoIFP(io));
2092 #else
2093             DIE("-T and -B not implemented on filehandles");
2094 #endif
2095         }
2096         else {
2097             if (dowarn)
2098                 warn("Test on unopened file <%s>",
2099                   GvENAME(cGVOP->op_gv));
2100             SETERRNO(EBADF,RMS$_IFI);
2101             RETPUSHUNDEF;
2102         }
2103     }
2104     else {
2105         sv = POPs;
2106         statgv = Nullgv;
2107         sv_setpv(statname, SvPV(sv, na));
2108       really_filename:
2109 #ifdef HAS_OPEN3
2110         i = open(SvPV(sv, na), O_RDONLY, 0);
2111 #else
2112         i = open(SvPV(sv, na), 0);
2113 #endif
2114         if (i < 0) {
2115             if (dowarn && strchr(SvPV(sv, na), '\n'))
2116                 warn(warn_nl, "open");
2117             RETPUSHUNDEF;
2118         }
2119         Fstat(i, &statcache);
2120         len = read(i, tbuf, 512);
2121         (void)close(i);
2122         if (len <= 0) {
2123             if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
2124                 RETPUSHNO;              /* special case NFS directories */
2125             RETPUSHYES;         /* null file is anything */
2126         }
2127         s = tbuf;
2128     }
2129
2130     /* now scan s to look for textiness */
2131
2132     for (i = 0; i < len; i++, s++) {
2133         if (!*s) {                      /* null never allowed in text */
2134             odd += len;
2135             break;
2136         }
2137         else if (*s & 128)
2138             odd++;
2139         else if (*s < 32 &&
2140           *s != '\n' && *s != '\r' && *s != '\b' &&
2141           *s != '\t' && *s != '\f' && *s != 27)
2142             odd++;
2143     }
2144
2145     if ((odd * 30 > len) == (op->op_type == OP_FTTEXT)) /* allow 30% odd */
2146         RETPUSHNO;
2147     else
2148         RETPUSHYES;
2149 }
2150
2151 PP(pp_ftbinary)
2152 {
2153     return pp_fttext(ARGS);
2154 }
2155
2156 /* File calls. */
2157
2158 PP(pp_chdir)
2159 {
2160     dSP; dTARGET;
2161     char *tmps;
2162     SV **svp;
2163
2164     if (MAXARG < 1)
2165         tmps = Nullch;
2166     else
2167         tmps = POPp;
2168     if (!tmps || !*tmps) {
2169         svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE);
2170         if (svp)
2171             tmps = SvPV(*svp, na);
2172     }
2173     if (!tmps || !*tmps) {
2174         svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE);
2175         if (svp)
2176             tmps = SvPV(*svp, na);
2177     }
2178     TAINT_PROPER("chdir");
2179     PUSHi( chdir(tmps) >= 0 );
2180 #ifdef VMS
2181     /* Clear the DEFAULT element of ENV so we'll get the new value
2182      * in the future. */
2183     hv_delete(GvHVn(envgv),"DEFAULT",7);
2184 #endif
2185     RETURN;
2186 }
2187
2188 PP(pp_chown)
2189 {
2190     dSP; dMARK; dTARGET;
2191     I32 value;
2192 #ifdef HAS_CHOWN
2193     value = (I32)apply(op->op_type, MARK, SP);
2194     SP = MARK;
2195     PUSHi(value);
2196     RETURN;
2197 #else
2198     DIE(no_func, "Unsupported function chown");
2199 #endif
2200 }
2201
2202 PP(pp_chroot)
2203 {
2204     dSP; dTARGET;
2205     char *tmps;
2206 #ifdef HAS_CHROOT
2207     tmps = POPp;
2208     TAINT_PROPER("chroot");
2209     PUSHi( chroot(tmps) >= 0 );
2210     RETURN;
2211 #else
2212     DIE(no_func, "chroot");
2213 #endif
2214 }
2215
2216 PP(pp_unlink)
2217 {
2218     dSP; dMARK; dTARGET;
2219     I32 value;
2220     value = (I32)apply(op->op_type, MARK, SP);
2221     SP = MARK;
2222     PUSHi(value);
2223     RETURN;
2224 }
2225
2226 PP(pp_chmod)
2227 {
2228     dSP; dMARK; dTARGET;
2229     I32 value;
2230     value = (I32)apply(op->op_type, MARK, SP);
2231     SP = MARK;
2232     PUSHi(value);
2233     RETURN;
2234 }
2235
2236 PP(pp_utime)
2237 {
2238     dSP; dMARK; dTARGET;
2239     I32 value;
2240     value = (I32)apply(op->op_type, MARK, SP);
2241     SP = MARK;
2242     PUSHi(value);
2243     RETURN;
2244 }
2245
2246 PP(pp_rename)
2247 {
2248     dSP; dTARGET;
2249     int anum;
2250
2251     char *tmps2 = POPp;
2252     char *tmps = SvPV(TOPs, na);
2253     TAINT_PROPER("rename");
2254 #ifdef HAS_RENAME
2255     anum = rename(tmps, tmps2);
2256 #else
2257     if (same_dirent(tmps2, tmps))       /* can always rename to same name */
2258         anum = 1;
2259     else {
2260         if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
2261             (void)UNLINK(tmps2);
2262         if (!(anum = link(tmps, tmps2)))
2263             anum = UNLINK(tmps);
2264     }
2265 #endif
2266     SETi( anum >= 0 );
2267     RETURN;
2268 }
2269
2270 PP(pp_link)
2271 {
2272     dSP; dTARGET;
2273 #ifdef HAS_LINK
2274     char *tmps2 = POPp;
2275     char *tmps = SvPV(TOPs, na);
2276     TAINT_PROPER("link");
2277     SETi( link(tmps, tmps2) >= 0 );
2278 #else
2279     DIE(no_func, "Unsupported function link");
2280 #endif
2281     RETURN;
2282 }
2283
2284 PP(pp_symlink)
2285 {
2286     dSP; dTARGET;
2287 #ifdef HAS_SYMLINK
2288     char *tmps2 = POPp;
2289     char *tmps = SvPV(TOPs, na);
2290     TAINT_PROPER("symlink");
2291     SETi( symlink(tmps, tmps2) >= 0 );
2292     RETURN;
2293 #else
2294     DIE(no_func, "symlink");
2295 #endif
2296 }
2297
2298 PP(pp_readlink)
2299 {
2300     dSP; dTARGET;
2301 #ifdef HAS_SYMLINK
2302     char *tmps;
2303     int len;
2304     tmps = POPp;
2305     len = readlink(tmps, buf, sizeof buf);
2306     EXTEND(SP, 1);
2307     if (len < 0)
2308         RETPUSHUNDEF;
2309     PUSHp(buf, len);
2310     RETURN;
2311 #else
2312     EXTEND(SP, 1);
2313     RETSETUNDEF;                /* just pretend it's a normal file */
2314 #endif
2315 }
2316
2317 #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
2318 static int
2319 dooneliner(cmd, filename)
2320 char *cmd;
2321 char *filename;
2322 {
2323     char mybuf[8192];
2324     char *s,
2325          *save_filename = filename;
2326     int anum = 1;
2327     FILE *myfp;
2328
2329     strcpy(mybuf, cmd);
2330     strcat(mybuf, " ");
2331     for (s = mybuf+strlen(mybuf); *filename; ) {
2332         *s++ = '\\';
2333         *s++ = *filename++;
2334     }
2335     strcpy(s, " 2>&1");
2336     myfp = my_popen(mybuf, "r");
2337     if (myfp) {
2338         *mybuf = '\0';
2339         s = fgets(mybuf, sizeof mybuf, myfp);
2340         (void)my_pclose(myfp);
2341         if (s != Nullch) {
2342             for (errno = 1; errno < sys_nerr; errno++) {
2343 #ifdef HAS_SYS_ERRLIST
2344                 if (instr(mybuf, sys_errlist[errno]))   /* you don't see this */
2345                     return 0;
2346 #else
2347                 char *errmsg;                           /* especially if it isn't there */
2348
2349                 if (instr(mybuf,
2350                           (errmsg = strerror(errno)) ? errmsg : "NoErRoR"))
2351                     return 0;
2352 #endif
2353             }
2354             SETERRNO(0,0);
2355 #ifndef EACCES
2356 #define EACCES EPERM
2357 #endif
2358             if (instr(mybuf, "cannot make"))
2359                 SETERRNO(EEXIST,RMS$_FEX);
2360             else if (instr(mybuf, "existing file"))
2361                 SETERRNO(EEXIST,RMS$_FEX);
2362             else if (instr(mybuf, "ile exists"))
2363                 SETERRNO(EEXIST,RMS$_FEX);
2364             else if (instr(mybuf, "non-exist"))
2365                 SETERRNO(ENOENT,RMS$_FNF);
2366             else if (instr(mybuf, "does not exist"))
2367                 SETERRNO(ENOENT,RMS$_FNF);
2368             else if (instr(mybuf, "not empty"))
2369                 SETERRNO(EBUSY,SS$_DEVOFFLINE);
2370             else if (instr(mybuf, "cannot access"))
2371                 SETERRNO(EACCES,RMS$_PRV);
2372             else
2373                 SETERRNO(EPERM,RMS$_PRV);
2374             return 0;
2375         }
2376         else {  /* some mkdirs return no failure indication */
2377             anum = (Stat(save_filename, &statbuf) >= 0);
2378             if (op->op_type == OP_RMDIR)
2379                 anum = !anum;
2380             if (anum)
2381                 SETERRNO(0,0);
2382             else
2383                 SETERRNO(EACCES,RMS$_PRV);      /* a guess */
2384         }
2385         return anum;
2386     }
2387     else
2388         return 0;
2389 }
2390 #endif
2391
2392 PP(pp_mkdir)
2393 {
2394     dSP; dTARGET;
2395     int mode = POPi;
2396 #ifndef HAS_MKDIR
2397     int oldumask;
2398 #endif
2399     char *tmps = SvPV(TOPs, na);
2400
2401     TAINT_PROPER("mkdir");
2402 #ifdef HAS_MKDIR
2403     SETi( mkdir(tmps, mode) >= 0 );
2404 #else
2405     SETi( dooneliner("mkdir", tmps) );
2406     oldumask = umask(0);
2407     umask(oldumask);
2408     chmod(tmps, (mode & ~oldumask) & 0777);
2409 #endif
2410     RETURN;
2411 }
2412
2413 PP(pp_rmdir)
2414 {
2415     dSP; dTARGET;
2416     char *tmps;
2417
2418     tmps = POPp;
2419     TAINT_PROPER("rmdir");
2420 #ifdef HAS_RMDIR
2421     XPUSHi( rmdir(tmps) >= 0 );
2422 #else
2423     XPUSHi( dooneliner("rmdir", tmps) );
2424 #endif
2425     RETURN;
2426 }
2427
2428 /* Directory calls. */
2429
2430 PP(pp_open_dir)
2431 {
2432     dSP;
2433 #if defined(Direntry_t) && defined(HAS_READDIR)
2434     char *dirname = POPp;
2435     GV *gv = (GV*)POPs;
2436     register IO *io = GvIOn(gv);
2437
2438     if (!io)
2439         goto nope;
2440
2441     if (IoDIRP(io))
2442         closedir(IoDIRP(io));
2443     if (!(IoDIRP(io) = opendir(dirname)))
2444         goto nope;
2445
2446     RETPUSHYES;
2447 nope:
2448     if (!errno)
2449         SETERRNO(EBADF,RMS$_DIR);
2450     RETPUSHUNDEF;
2451 #else
2452     DIE(no_dir_func, "opendir");
2453 #endif
2454 }
2455
2456 PP(pp_readdir)
2457 {
2458     dSP;
2459 #if defined(Direntry_t) && defined(HAS_READDIR)
2460 #ifndef I_DIRENT
2461     Direntry_t *readdir _((DIR *));
2462 #endif
2463     register Direntry_t *dp;
2464     GV *gv = (GV*)POPs;
2465     register IO *io = GvIOn(gv);
2466
2467     if (!io || !IoDIRP(io))
2468         goto nope;
2469
2470     if (GIMME == G_ARRAY) {
2471         /*SUPPRESS 560*/
2472         while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
2473 #ifdef DIRNAMLEN
2474             XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
2475 #else
2476             XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
2477 #endif
2478         }
2479     }
2480     else {
2481         if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
2482             goto nope;
2483 #ifdef DIRNAMLEN
2484         XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
2485 #else
2486         XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
2487 #endif
2488     }
2489     RETURN;
2490
2491 nope:
2492     if (!errno)
2493         SETERRNO(EBADF,RMS$_ISI);
2494     if (GIMME == G_ARRAY)
2495         RETURN;
2496     else
2497         RETPUSHUNDEF;
2498 #else
2499     DIE(no_dir_func, "readdir");
2500 #endif
2501 }
2502
2503 PP(pp_telldir)
2504 {
2505     dSP; dTARGET;
2506 #if defined(HAS_TELLDIR) || defined(telldir)
2507 #if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE)
2508     long telldir _((DIR *));
2509 #endif
2510     GV *gv = (GV*)POPs;
2511     register IO *io = GvIOn(gv);
2512
2513     if (!io || !IoDIRP(io))
2514         goto nope;
2515
2516     PUSHi( telldir(IoDIRP(io)) );
2517     RETURN;
2518 nope:
2519     if (!errno)
2520         SETERRNO(EBADF,RMS$_ISI);
2521     RETPUSHUNDEF;
2522 #else
2523     DIE(no_dir_func, "telldir");
2524 #endif
2525 }
2526
2527 PP(pp_seekdir)
2528 {
2529     dSP;
2530 #if defined(HAS_SEEKDIR) || defined(seekdir)
2531     long along = POPl;
2532     GV *gv = (GV*)POPs;
2533     register IO *io = GvIOn(gv);
2534
2535     if (!io || !IoDIRP(io))
2536         goto nope;
2537
2538     (void)seekdir(IoDIRP(io), along);
2539
2540     RETPUSHYES;
2541 nope:
2542     if (!errno)
2543         SETERRNO(EBADF,RMS$_ISI);
2544     RETPUSHUNDEF;
2545 #else
2546     DIE(no_dir_func, "seekdir");
2547 #endif
2548 }
2549
2550 PP(pp_rewinddir)
2551 {
2552     dSP;
2553 #if defined(HAS_REWINDDIR) || defined(rewinddir)
2554     GV *gv = (GV*)POPs;
2555     register IO *io = GvIOn(gv);
2556
2557     if (!io || !IoDIRP(io))
2558         goto nope;
2559
2560     (void)rewinddir(IoDIRP(io));
2561     RETPUSHYES;
2562 nope:
2563     if (!errno)
2564         SETERRNO(EBADF,RMS$_ISI);
2565     RETPUSHUNDEF;
2566 #else
2567     DIE(no_dir_func, "rewinddir");
2568 #endif
2569 }
2570
2571 PP(pp_closedir)
2572 {
2573     dSP;
2574 #if defined(Direntry_t) && defined(HAS_READDIR)
2575     GV *gv = (GV*)POPs;
2576     register IO *io = GvIOn(gv);
2577
2578     if (!io || !IoDIRP(io))
2579         goto nope;
2580
2581 #ifdef VOID_CLOSEDIR
2582     closedir(IoDIRP(io));
2583 #else
2584     if (closedir(IoDIRP(io)) < 0) {
2585         IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */
2586         goto nope;
2587     }
2588 #endif
2589     IoDIRP(io) = 0;
2590
2591     RETPUSHYES;
2592 nope:
2593     if (!errno)
2594         SETERRNO(EBADF,RMS$_IFI);
2595     RETPUSHUNDEF;
2596 #else
2597     DIE(no_dir_func, "closedir");
2598 #endif
2599 }
2600
2601 /* Process control. */
2602
2603 PP(pp_fork)
2604 {
2605     dSP; dTARGET;
2606     int childpid;
2607     GV *tmpgv;
2608
2609     EXTEND(SP, 1);
2610 #ifdef HAS_FORK
2611     childpid = fork();
2612     if (childpid < 0)
2613         RETSETUNDEF;
2614     if (!childpid) {
2615         /*SUPPRESS 560*/
2616         if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
2617             sv_setiv(GvSV(tmpgv), (I32)getpid());
2618         hv_clear(pidstatus);    /* no kids, so don't wait for 'em */
2619     }
2620     PUSHi(childpid);
2621     RETURN;
2622 #else
2623     DIE(no_func, "Unsupported function fork");
2624 #endif
2625 }
2626
2627 PP(pp_wait)
2628 {
2629     dSP; dTARGET;
2630     int childpid;
2631     int argflags;
2632     I32 value;
2633
2634     EXTEND(SP, 1);
2635 #ifdef HAS_WAIT
2636     childpid = wait(&argflags);
2637     if (childpid > 0)
2638         pidgone(childpid, argflags);
2639     value = (I32)childpid;
2640     statusvalue = FIXSTATUS(argflags);
2641     PUSHi(value);
2642     RETURN;
2643 #else
2644     DIE(no_func, "Unsupported function wait");
2645 #endif
2646 }
2647
2648 PP(pp_waitpid)
2649 {
2650     dSP; dTARGET;
2651     int childpid;
2652     int optype;
2653     int argflags;
2654     I32 value;
2655
2656 #ifdef HAS_WAIT
2657     optype = POPi;
2658     childpid = TOPi;
2659     childpid = wait4pid(childpid, &argflags, optype);
2660     value = (I32)childpid;
2661     statusvalue = FIXSTATUS(argflags);
2662     SETi(value);
2663     RETURN;
2664 #else
2665     DIE(no_func, "Unsupported function wait");
2666 #endif
2667 }
2668
2669 PP(pp_system)
2670 {
2671     dSP; dMARK; dORIGMARK; dTARGET;
2672     I32 value;
2673     int childpid;
2674     int result;
2675     int status;
2676     Signal_t (*ihand)();     /* place to save signal during system() */
2677     Signal_t (*qhand)();     /* place to save signal during system() */
2678
2679 #if defined(HAS_FORK) && !defined(VMS)
2680     if (SP - MARK == 1) {
2681         if (tainting) {
2682             char *junk = SvPV(TOPs, na);
2683             TAINT_ENV();
2684             TAINT_PROPER("system");
2685         }
2686     }
2687     while ((childpid = vfork()) == -1) {
2688         if (errno != EAGAIN) {
2689             value = -1;
2690             SP = ORIGMARK;
2691             PUSHi(value);
2692             RETURN;
2693         }
2694         sleep(5);
2695     }
2696     if (childpid > 0) {
2697         ihand = signal(SIGINT, SIG_IGN);
2698         qhand = signal(SIGQUIT, SIG_IGN);
2699         do {
2700             result = wait4pid(childpid, &status, 0);
2701         } while (result == -1 && errno == EINTR);
2702         (void)signal(SIGINT, ihand);
2703         (void)signal(SIGQUIT, qhand);
2704         statusvalue = FIXSTATUS(status);
2705         if (result < 0)
2706             value = -1;
2707         else {
2708             value = (I32)((unsigned int)status & 0xffff);
2709         }
2710         do_execfree();  /* free any memory child malloced on vfork */
2711         SP = ORIGMARK;
2712         PUSHi(value);
2713         RETURN;
2714     }
2715     if (op->op_flags & OPf_STACKED) {
2716         SV *really = *++MARK;
2717         value = (I32)do_aexec(really, MARK, SP);
2718     }
2719     else if (SP - MARK != 1)
2720         value = (I32)do_aexec(Nullsv, MARK, SP);
2721     else {
2722         value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
2723     }
2724     _exit(-1);
2725 #else /* ! FORK or VMS */
2726     if (op->op_flags & OPf_STACKED) {
2727         SV *really = *++MARK;
2728         value = (I32)do_aspawn(really, MARK, SP);
2729     }
2730     else if (SP - MARK != 1)
2731         value = (I32)do_aspawn(Nullsv, MARK, SP);
2732     else {
2733         value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
2734     }
2735     do_execfree();
2736     SP = ORIGMARK;
2737     PUSHi(value);
2738 #endif /* !FORK or VMS */
2739     RETURN;
2740 }
2741
2742 PP(pp_exec)
2743 {
2744     dSP; dMARK; dORIGMARK; dTARGET;
2745     I32 value;
2746
2747     if (op->op_flags & OPf_STACKED) {
2748         SV *really = *++MARK;
2749         value = (I32)do_aexec(really, MARK, SP);
2750     }
2751     else if (SP - MARK != 1)
2752 #ifdef VMS
2753         value = (I32)vms_do_aexec(Nullsv, MARK, SP);
2754 #else
2755         value = (I32)do_aexec(Nullsv, MARK, SP);
2756 #endif
2757     else {
2758         if (tainting) {
2759             char *junk = SvPV(*SP, na);
2760             TAINT_ENV();
2761             TAINT_PROPER("exec");
2762         }
2763 #ifdef VMS
2764         value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
2765 #else
2766         value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
2767 #endif
2768     }
2769     SP = ORIGMARK;
2770     PUSHi(value);
2771     RETURN;
2772 }
2773
2774 PP(pp_kill)
2775 {
2776     dSP; dMARK; dTARGET;
2777     I32 value;
2778 #ifdef HAS_KILL
2779     value = (I32)apply(op->op_type, MARK, SP);
2780     SP = MARK;
2781     PUSHi(value);
2782     RETURN;
2783 #else
2784     DIE(no_func, "Unsupported function kill");
2785 #endif
2786 }
2787
2788 PP(pp_getppid)
2789 {
2790 #ifdef HAS_GETPPID
2791     dSP; dTARGET;
2792     XPUSHi( getppid() );
2793     RETURN;
2794 #else
2795     DIE(no_func, "getppid");
2796 #endif
2797 }
2798
2799 PP(pp_getpgrp)
2800 {
2801 #ifdef HAS_GETPGRP
2802     dSP; dTARGET;
2803     int pid;
2804     I32 value;
2805
2806     if (MAXARG < 1)
2807         pid = 0;
2808     else
2809         pid = SvIVx(POPs);
2810 #ifdef USE_BSDPGRP
2811     value = (I32)getpgrp(pid);
2812 #else
2813     if (pid != 0)
2814         DIE("POSIX getpgrp can't take an argument");
2815     value = (I32)getpgrp();
2816 #endif
2817     XPUSHi(value);
2818     RETURN;
2819 #else
2820     DIE(no_func, "getpgrp()");
2821 #endif
2822 }
2823
2824 PP(pp_setpgrp)
2825 {
2826 #ifdef HAS_SETPGRP
2827     dSP; dTARGET;
2828     int pgrp;
2829     int pid;
2830     if (MAXARG < 2) {
2831         pgrp = 0;
2832         pid = 0;
2833     }
2834     else {
2835         pgrp = POPi;
2836         pid = TOPi;
2837     }
2838
2839     TAINT_PROPER("setpgrp");
2840 #ifdef USE_BSDPGRP
2841     SETi( setpgrp(pid, pgrp) >= 0 );
2842 #else
2843     if ((pgrp != 0) || (pid != 0)) {
2844         DIE("POSIX setpgrp can't take an argument");
2845     }
2846     SETi( setpgrp() >= 0 );
2847 #endif /* USE_BSDPGRP */
2848     RETURN;
2849 #else
2850     DIE(no_func, "setpgrp()");
2851 #endif
2852 }
2853
2854 PP(pp_getpriority)
2855 {
2856     dSP; dTARGET;
2857     int which;
2858     int who;
2859 #ifdef HAS_GETPRIORITY
2860     who = POPi;
2861     which = TOPi;
2862     SETi( getpriority(which, who) );
2863     RETURN;
2864 #else
2865     DIE(no_func, "getpriority()");
2866 #endif
2867 }
2868
2869 PP(pp_setpriority)
2870 {
2871     dSP; dTARGET;
2872     int which;
2873     int who;
2874     int niceval;
2875 #ifdef HAS_SETPRIORITY
2876     niceval = POPi;
2877     who = POPi;
2878     which = TOPi;
2879     TAINT_PROPER("setpriority");
2880     SETi( setpriority(which, who, niceval) >= 0 );
2881     RETURN;
2882 #else
2883     DIE(no_func, "setpriority()");
2884 #endif
2885 }
2886
2887 /* Time calls. */
2888
2889 PP(pp_time)
2890 {
2891     dSP; dTARGET;
2892     XPUSHi( time(Null(Time_t*)) );
2893     RETURN;
2894 }
2895
2896 #ifndef HZ
2897 #define HZ 60
2898 #endif
2899
2900 PP(pp_tms)
2901 {
2902     dSP;
2903
2904 #if defined(MSDOS) || !defined(HAS_TIMES)
2905     DIE("times not implemented");
2906 #else
2907     EXTEND(SP, 4);
2908
2909 #ifndef VMS
2910     (void)times(&timesbuf);
2911 #else
2912     (void)times((tbuffer_t *)&timesbuf);  /* time.h uses different name for */
2913                                           /* struct tms, though same data   */
2914                                           /* is returned.                   */
2915 #endif
2916
2917     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
2918     if (GIMME == G_ARRAY) {
2919         PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
2920         PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
2921         PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
2922     }
2923     RETURN;
2924 #endif /* MSDOS */
2925 }
2926
2927 PP(pp_localtime)
2928 {
2929     return pp_gmtime(ARGS);
2930 }
2931
2932 PP(pp_gmtime)
2933 {
2934     dSP;
2935     Time_t when;
2936     struct tm *tmbuf;
2937     static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
2938     static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
2939                               "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
2940
2941     if (MAXARG < 1)
2942         (void)time(&when);
2943     else
2944         when = (Time_t)SvIVx(POPs);
2945
2946     if (op->op_type == OP_LOCALTIME)
2947         tmbuf = localtime(&when);
2948     else
2949         tmbuf = gmtime(&when);
2950
2951     EXTEND(SP, 9);
2952     if (GIMME != G_ARRAY) {
2953         dTARGET;
2954         char mybuf[30];
2955         if (!tmbuf)
2956             RETPUSHUNDEF;
2957         sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
2958             dayname[tmbuf->tm_wday],
2959             monname[tmbuf->tm_mon],
2960             tmbuf->tm_mday,
2961             tmbuf->tm_hour,
2962             tmbuf->tm_min,
2963             tmbuf->tm_sec,
2964             tmbuf->tm_year + 1900);
2965         PUSHp(mybuf, strlen(mybuf));
2966     }
2967     else if (tmbuf) {
2968         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
2969         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
2970         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
2971         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
2972         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
2973         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
2974         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
2975         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
2976         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
2977     }
2978     RETURN;
2979 }
2980
2981 PP(pp_alarm)
2982 {
2983     dSP; dTARGET;
2984     int anum;
2985 #ifdef HAS_ALARM
2986     anum = POPi;
2987     anum = alarm((unsigned int)anum);
2988     EXTEND(SP, 1);
2989     if (anum < 0)
2990         RETPUSHUNDEF;
2991     PUSHi((I32)anum);
2992     RETURN;
2993 #else
2994     DIE(no_func, "Unsupported function alarm");
2995 #endif
2996 }
2997
2998 PP(pp_sleep)
2999 {
3000     dSP; dTARGET;
3001     I32 duration;
3002     Time_t lasttime;
3003     Time_t when;
3004
3005     (void)time(&lasttime);
3006     if (MAXARG < 1)
3007         pause();
3008     else {
3009         duration = POPi;
3010         sleep((unsigned int)duration);
3011     }
3012     (void)time(&when);
3013     XPUSHi(when - lasttime);
3014     RETURN;
3015 }
3016
3017 /* Shared memory. */
3018
3019 PP(pp_shmget)
3020 {
3021     return pp_semget(ARGS);
3022 }
3023
3024 PP(pp_shmctl)
3025 {
3026     return pp_semctl(ARGS);
3027 }
3028
3029 PP(pp_shmread)
3030 {
3031     return pp_shmwrite(ARGS);
3032 }
3033
3034 PP(pp_shmwrite)
3035 {
3036 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3037     dSP; dMARK; dTARGET;
3038     I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
3039     SP = MARK;
3040     PUSHi(value);
3041     RETURN;
3042 #else
3043     return pp_semget(ARGS);
3044 #endif
3045 }
3046
3047 /* Message passing. */
3048
3049 PP(pp_msgget)
3050 {
3051     return pp_semget(ARGS);
3052 }
3053
3054 PP(pp_msgctl)
3055 {
3056     return pp_semctl(ARGS);
3057 }
3058
3059 PP(pp_msgsnd)
3060 {
3061 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3062     dSP; dMARK; dTARGET;
3063     I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
3064     SP = MARK;
3065     PUSHi(value);
3066     RETURN;
3067 #else
3068     return pp_semget(ARGS);
3069 #endif
3070 }
3071
3072 PP(pp_msgrcv)
3073 {
3074 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3075     dSP; dMARK; dTARGET;
3076     I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
3077     SP = MARK;
3078     PUSHi(value);
3079     RETURN;
3080 #else
3081     return pp_semget(ARGS);
3082 #endif
3083 }
3084
3085 /* Semaphores. */
3086
3087 PP(pp_semget)
3088 {
3089 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3090     dSP; dMARK; dTARGET;
3091     int anum = do_ipcget(op->op_type, MARK, SP);
3092     SP = MARK;
3093     if (anum == -1)
3094         RETPUSHUNDEF;
3095     PUSHi(anum);
3096     RETURN;
3097 #else
3098     DIE("System V IPC is not implemented on this machine");
3099 #endif
3100 }
3101
3102 PP(pp_semctl)
3103 {
3104 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3105     dSP; dMARK; dTARGET;
3106     int anum = do_ipcctl(op->op_type, MARK, SP);
3107     SP = MARK;
3108     if (anum == -1)
3109         RETSETUNDEF;
3110     if (anum != 0) {
3111         PUSHi(anum);
3112     }
3113     else {
3114         PUSHp("0 but true",10);
3115     }
3116     RETURN;
3117 #else
3118     return pp_semget(ARGS);
3119 #endif
3120 }
3121
3122 PP(pp_semop)
3123 {
3124 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3125     dSP; dMARK; dTARGET;
3126     I32 value = (I32)(do_semop(MARK, SP) >= 0);
3127     SP = MARK;
3128     PUSHi(value);
3129     RETURN;
3130 #else
3131     return pp_semget(ARGS);
3132 #endif
3133 }
3134
3135 /* Get system info. */
3136
3137 PP(pp_ghbyname)
3138 {
3139 #ifdef HAS_SOCKET
3140     return pp_ghostent(ARGS);
3141 #else
3142     DIE(no_sock_func, "gethostbyname");
3143 #endif
3144 }
3145
3146 PP(pp_ghbyaddr)
3147 {
3148 #ifdef HAS_SOCKET
3149     return pp_ghostent(ARGS);
3150 #else
3151     DIE(no_sock_func, "gethostbyaddr");
3152 #endif
3153 }
3154
3155 PP(pp_ghostent)
3156 {
3157     dSP;
3158 #ifdef HAS_SOCKET
3159     I32 which = op->op_type;
3160     register char **elem;
3161     register SV *sv;
3162     struct hostent *gethostbyname();
3163     struct hostent *gethostbyaddr();
3164 #ifdef HAS_GETHOSTENT
3165     struct hostent *gethostent();
3166 #endif
3167     struct hostent *hent;
3168     unsigned long len;
3169
3170     EXTEND(SP, 10);
3171     if (which == OP_GHBYNAME) {
3172         hent = gethostbyname(POPp);
3173     }
3174     else if (which == OP_GHBYADDR) {
3175         int addrtype = POPi;
3176         SV *addrsv = POPs;
3177         STRLEN addrlen;
3178         char *addr = SvPV(addrsv, addrlen);
3179
3180         hent = gethostbyaddr(addr, addrlen, addrtype);
3181     }
3182     else
3183 #ifdef HAS_GETHOSTENT
3184         hent = gethostent();
3185 #else
3186         DIE("gethostent not implemented");
3187 #endif
3188
3189 #ifdef HOST_NOT_FOUND
3190     if (!hent)
3191         statusvalue = FIXSTATUS(h_errno);
3192 #endif
3193
3194     if (GIMME != G_ARRAY) {
3195         PUSHs(sv = sv_newmortal());
3196         if (hent) {
3197             if (which == OP_GHBYNAME) {
3198                 sv_setpvn(sv, hent->h_addr, hent->h_length);
3199             }
3200             else
3201                 sv_setpv(sv, (char*)hent->h_name);
3202         }
3203         RETURN;
3204     }
3205
3206     if (hent) {
3207         PUSHs(sv = sv_mortalcopy(&sv_no));
3208         sv_setpv(sv, (char*)hent->h_name);
3209         PUSHs(sv = sv_mortalcopy(&sv_no));
3210         for (elem = hent->h_aliases; elem && *elem; elem++) {
3211             sv_catpv(sv, *elem);
3212             if (elem[1])
3213                 sv_catpvn(sv, " ", 1);
3214         }
3215         PUSHs(sv = sv_mortalcopy(&sv_no));
3216         sv_setiv(sv, (I32)hent->h_addrtype);
3217         PUSHs(sv = sv_mortalcopy(&sv_no));
3218         len = hent->h_length;
3219         sv_setiv(sv, (I32)len);
3220 #ifdef h_addr
3221         for (elem = hent->h_addr_list; elem && *elem; elem++) {
3222             XPUSHs(sv = sv_mortalcopy(&sv_no));
3223             sv_setpvn(sv, *elem, len);
3224         }
3225 #else
3226         PUSHs(sv = sv_mortalcopy(&sv_no));
3227         sv_setpvn(sv, hent->h_addr, len);
3228 #endif /* h_addr */
3229     }
3230     RETURN;
3231 #else
3232     DIE(no_sock_func, "gethostent");
3233 #endif
3234 }
3235
3236 PP(pp_gnbyname)
3237 {
3238 #ifdef HAS_SOCKET
3239     return pp_gnetent(ARGS);
3240 #else
3241     DIE(no_sock_func, "getnetbyname");
3242 #endif
3243 }
3244
3245 PP(pp_gnbyaddr)
3246 {
3247 #ifdef HAS_SOCKET
3248     return pp_gnetent(ARGS);
3249 #else
3250     DIE(no_sock_func, "getnetbyaddr");
3251 #endif
3252 }
3253
3254 PP(pp_gnetent)
3255 {
3256     dSP;
3257 #ifdef HAS_SOCKET
3258     I32 which = op->op_type;
3259     register char **elem;
3260     register SV *sv;
3261     struct netent *getnetbyname();
3262     struct netent *getnetbyaddr();
3263     struct netent *getnetent();
3264     struct netent *nent;
3265
3266     if (which == OP_GNBYNAME)
3267         nent = getnetbyname(POPp);
3268     else if (which == OP_GNBYADDR) {
3269         int addrtype = POPi;
3270         unsigned long addr = U_L(POPn);
3271         nent = getnetbyaddr((long)addr, addrtype);
3272     }
3273     else
3274         nent = getnetent();
3275
3276     EXTEND(SP, 4);
3277     if (GIMME != G_ARRAY) {
3278         PUSHs(sv = sv_newmortal());
3279         if (nent) {
3280             if (which == OP_GNBYNAME)
3281                 sv_setiv(sv, (I32)nent->n_net);
3282             else
3283                 sv_setpv(sv, nent->n_name);
3284         }
3285         RETURN;
3286     }
3287
3288     if (nent) {
3289         PUSHs(sv = sv_mortalcopy(&sv_no));
3290         sv_setpv(sv, nent->n_name);
3291         PUSHs(sv = sv_mortalcopy(&sv_no));
3292         for (elem = nent->n_aliases; *elem; elem++) {
3293             sv_catpv(sv, *elem);
3294             if (elem[1])
3295                 sv_catpvn(sv, " ", 1);
3296         }
3297         PUSHs(sv = sv_mortalcopy(&sv_no));
3298         sv_setiv(sv, (I32)nent->n_addrtype);
3299         PUSHs(sv = sv_mortalcopy(&sv_no));
3300         sv_setiv(sv, (I32)nent->n_net);
3301     }
3302
3303     RETURN;
3304 #else
3305     DIE(no_sock_func, "getnetent");
3306 #endif
3307 }
3308
3309 PP(pp_gpbyname)
3310 {
3311 #ifdef HAS_SOCKET
3312     return pp_gprotoent(ARGS);
3313 #else
3314     DIE(no_sock_func, "getprotobyname");
3315 #endif
3316 }
3317
3318 PP(pp_gpbynumber)
3319 {
3320 #ifdef HAS_SOCKET
3321     return pp_gprotoent(ARGS);
3322 #else
3323     DIE(no_sock_func, "getprotobynumber");
3324 #endif
3325 }
3326
3327 PP(pp_gprotoent)
3328 {
3329     dSP;
3330 #ifdef HAS_SOCKET
3331     I32 which = op->op_type;
3332     register char **elem;
3333     register SV *sv;
3334     struct protoent *getprotobyname();
3335     struct protoent *getprotobynumber();
3336     struct protoent *getprotoent();
3337     struct protoent *pent;
3338
3339     if (which == OP_GPBYNAME)
3340         pent = getprotobyname(POPp);
3341     else if (which == OP_GPBYNUMBER)
3342         pent = getprotobynumber(POPi);
3343     else
3344         pent = getprotoent();
3345
3346     EXTEND(SP, 3);
3347     if (GIMME != G_ARRAY) {
3348         PUSHs(sv = sv_newmortal());
3349         if (pent) {
3350             if (which == OP_GPBYNAME)
3351                 sv_setiv(sv, (I32)pent->p_proto);
3352             else
3353                 sv_setpv(sv, pent->p_name);
3354         }
3355         RETURN;
3356     }
3357
3358     if (pent) {
3359         PUSHs(sv = sv_mortalcopy(&sv_no));
3360         sv_setpv(sv, pent->p_name);
3361         PUSHs(sv = sv_mortalcopy(&sv_no));
3362         for (elem = pent->p_aliases; *elem; elem++) {
3363             sv_catpv(sv, *elem);
3364             if (elem[1])
3365                 sv_catpvn(sv, " ", 1);
3366         }
3367         PUSHs(sv = sv_mortalcopy(&sv_no));
3368         sv_setiv(sv, (I32)pent->p_proto);
3369     }
3370
3371     RETURN;
3372 #else
3373     DIE(no_sock_func, "getprotoent");
3374 #endif
3375 }
3376
3377 PP(pp_gsbyname)
3378 {
3379 #ifdef HAS_SOCKET
3380     return pp_gservent(ARGS);
3381 #else
3382     DIE(no_sock_func, "getservbyname");
3383 #endif
3384 }
3385
3386 PP(pp_gsbyport)
3387 {
3388 #ifdef HAS_SOCKET
3389     return pp_gservent(ARGS);
3390 #else
3391     DIE(no_sock_func, "getservbyport");
3392 #endif
3393 }
3394
3395 PP(pp_gservent)
3396 {
3397     dSP;
3398 #ifdef HAS_SOCKET
3399     I32 which = op->op_type;
3400     register char **elem;
3401     register SV *sv;
3402     struct servent *getservbyname();
3403     struct servent *getservbynumber();
3404     struct servent *getservent();
3405     struct servent *sent;
3406
3407     if (which == OP_GSBYNAME) {
3408         char *proto = POPp;
3409         char *name = POPp;
3410
3411         if (proto && !*proto)
3412             proto = Nullch;
3413
3414         sent = getservbyname(name, proto);
3415     }
3416     else if (which == OP_GSBYPORT) {
3417         char *proto = POPp;
3418         int port = POPi;
3419
3420         sent = getservbyport(port, proto);
3421     }
3422     else
3423         sent = getservent();
3424
3425     EXTEND(SP, 4);
3426     if (GIMME != G_ARRAY) {
3427         PUSHs(sv = sv_newmortal());
3428         if (sent) {
3429             if (which == OP_GSBYNAME) {
3430 #ifdef HAS_NTOHS
3431                 sv_setiv(sv, (I32)ntohs(sent->s_port));
3432 #else
3433                 sv_setiv(sv, (I32)(sent->s_port));
3434 #endif
3435             }
3436             else
3437                 sv_setpv(sv, sent->s_name);
3438         }
3439         RETURN;
3440     }
3441
3442     if (sent) {
3443         PUSHs(sv = sv_mortalcopy(&sv_no));
3444         sv_setpv(sv, sent->s_name);
3445         PUSHs(sv = sv_mortalcopy(&sv_no));
3446         for (elem = sent->s_aliases; *elem; elem++) {
3447             sv_catpv(sv, *elem);
3448             if (elem[1])
3449                 sv_catpvn(sv, " ", 1);
3450         }
3451         PUSHs(sv = sv_mortalcopy(&sv_no));
3452 #ifdef HAS_NTOHS
3453         sv_setiv(sv, (I32)ntohs(sent->s_port));
3454 #else
3455         sv_setiv(sv, (I32)(sent->s_port));
3456 #endif
3457         PUSHs(sv = sv_mortalcopy(&sv_no));
3458         sv_setpv(sv, sent->s_proto);
3459     }
3460
3461     RETURN;
3462 #else
3463     DIE(no_sock_func, "getservent");
3464 #endif
3465 }
3466
3467 PP(pp_shostent)
3468 {
3469     dSP;
3470 #ifdef HAS_SOCKET
3471     sethostent(TOPi);
3472     RETSETYES;
3473 #else
3474     DIE(no_sock_func, "sethostent");
3475 #endif
3476 }
3477
3478 PP(pp_snetent)
3479 {
3480     dSP;
3481 #ifdef HAS_SOCKET
3482     setnetent(TOPi);
3483     RETSETYES;
3484 #else
3485     DIE(no_sock_func, "setnetent");
3486 #endif
3487 }
3488
3489 PP(pp_sprotoent)
3490 {
3491     dSP;
3492 #ifdef HAS_SOCKET
3493     setprotoent(TOPi);
3494     RETSETYES;
3495 #else
3496     DIE(no_sock_func, "setprotoent");
3497 #endif
3498 }
3499
3500 PP(pp_sservent)
3501 {
3502     dSP;
3503 #ifdef HAS_SOCKET
3504     setservent(TOPi);
3505     RETSETYES;
3506 #else
3507     DIE(no_sock_func, "setservent");
3508 #endif
3509 }
3510
3511 PP(pp_ehostent)
3512 {
3513     dSP;
3514 #ifdef HAS_SOCKET
3515     endhostent();
3516     EXTEND(sp,1);
3517     RETPUSHYES;
3518 #else
3519     DIE(no_sock_func, "endhostent");
3520 #endif
3521 }
3522
3523 PP(pp_enetent)
3524 {
3525     dSP;
3526 #ifdef HAS_SOCKET
3527     endnetent();
3528     EXTEND(sp,1);
3529     RETPUSHYES;
3530 #else
3531     DIE(no_sock_func, "endnetent");
3532 #endif
3533 }
3534
3535 PP(pp_eprotoent)
3536 {
3537     dSP;
3538 #ifdef HAS_SOCKET
3539     endprotoent();
3540     EXTEND(sp,1);
3541     RETPUSHYES;
3542 #else
3543     DIE(no_sock_func, "endprotoent");
3544 #endif
3545 }
3546
3547 PP(pp_eservent)
3548 {
3549     dSP;
3550 #ifdef HAS_SOCKET
3551     endservent();
3552     EXTEND(sp,1);
3553     RETPUSHYES;
3554 #else
3555     DIE(no_sock_func, "endservent");
3556 #endif
3557 }
3558
3559 PP(pp_gpwnam)
3560 {
3561 #ifdef HAS_PASSWD
3562     return pp_gpwent(ARGS);
3563 #else
3564     DIE(no_func, "getpwnam");
3565 #endif
3566 }
3567
3568 PP(pp_gpwuid)
3569 {
3570 #ifdef HAS_PASSWD
3571     return pp_gpwent(ARGS);
3572 #else
3573     DIE(no_func, "getpwuid");
3574 #endif
3575 }
3576
3577 PP(pp_gpwent)
3578 {
3579     dSP;
3580 #ifdef HAS_PASSWD
3581     I32 which = op->op_type;
3582     register SV *sv;
3583     struct passwd *pwent;
3584
3585     if (which == OP_GPWNAM)
3586         pwent = getpwnam(POPp);
3587     else if (which == OP_GPWUID)
3588         pwent = getpwuid(POPi);
3589     else
3590         pwent = (struct passwd *)getpwent();
3591
3592     EXTEND(SP, 10);
3593     if (GIMME != G_ARRAY) {
3594         PUSHs(sv = sv_newmortal());
3595         if (pwent) {
3596             if (which == OP_GPWNAM)
3597                 sv_setiv(sv, (I32)pwent->pw_uid);
3598             else
3599                 sv_setpv(sv, pwent->pw_name);
3600         }
3601         RETURN;
3602     }
3603
3604     if (pwent) {
3605         PUSHs(sv = sv_mortalcopy(&sv_no));
3606         sv_setpv(sv, pwent->pw_name);
3607         PUSHs(sv = sv_mortalcopy(&sv_no));
3608         sv_setpv(sv, pwent->pw_passwd);
3609         PUSHs(sv = sv_mortalcopy(&sv_no));
3610         sv_setiv(sv, (I32)pwent->pw_uid);
3611         PUSHs(sv = sv_mortalcopy(&sv_no));
3612         sv_setiv(sv, (I32)pwent->pw_gid);
3613         PUSHs(sv = sv_mortalcopy(&sv_no));
3614 #ifdef PWCHANGE
3615         sv_setiv(sv, (I32)pwent->pw_change);
3616 #else
3617 #ifdef PWQUOTA
3618         sv_setiv(sv, (I32)pwent->pw_quota);
3619 #else
3620 #ifdef PWAGE
3621         sv_setpv(sv, pwent->pw_age);
3622 #endif
3623 #endif
3624 #endif
3625         PUSHs(sv = sv_mortalcopy(&sv_no));
3626 #ifdef PWCLASS
3627         sv_setpv(sv, pwent->pw_class);
3628 #else
3629 #ifdef PWCOMMENT
3630         sv_setpv(sv, pwent->pw_comment);
3631 #endif
3632 #endif
3633         PUSHs(sv = sv_mortalcopy(&sv_no));
3634         sv_setpv(sv, pwent->pw_gecos);
3635         PUSHs(sv = sv_mortalcopy(&sv_no));
3636         sv_setpv(sv, pwent->pw_dir);
3637         PUSHs(sv = sv_mortalcopy(&sv_no));
3638         sv_setpv(sv, pwent->pw_shell);
3639 #ifdef PWEXPIRE
3640         PUSHs(sv = sv_mortalcopy(&sv_no));
3641         sv_setiv(sv, (I32)pwent->pw_expire);
3642 #endif
3643     }
3644     RETURN;
3645 #else
3646     DIE(no_func, "getpwent");
3647 #endif
3648 }
3649
3650 PP(pp_spwent)
3651 {
3652     dSP;
3653 #ifdef HAS_PASSWD
3654     setpwent();
3655     RETPUSHYES;
3656 #else
3657     DIE(no_func, "setpwent");
3658 #endif
3659 }
3660
3661 PP(pp_epwent)
3662 {
3663     dSP;
3664 #ifdef HAS_PASSWD
3665     endpwent();
3666     RETPUSHYES;
3667 #else
3668     DIE(no_func, "endpwent");
3669 #endif
3670 }
3671
3672 PP(pp_ggrnam)
3673 {
3674 #ifdef HAS_GROUP
3675     return pp_ggrent(ARGS);
3676 #else
3677     DIE(no_func, "getgrnam");
3678 #endif
3679 }
3680
3681 PP(pp_ggrgid)
3682 {
3683 #ifdef HAS_GROUP
3684     return pp_ggrent(ARGS);
3685 #else
3686     DIE(no_func, "getgrgid");
3687 #endif
3688 }
3689
3690 PP(pp_ggrent)
3691 {
3692     dSP;
3693 #ifdef HAS_GROUP
3694     I32 which = op->op_type;
3695     register char **elem;
3696     register SV *sv;
3697     struct group *grent;
3698
3699     if (which == OP_GGRNAM)
3700         grent = (struct group *)getgrnam(POPp);
3701     else if (which == OP_GGRGID)
3702         grent = (struct group *)getgrgid(POPi);
3703     else
3704         grent = (struct group *)getgrent();
3705
3706     EXTEND(SP, 4);
3707     if (GIMME != G_ARRAY) {
3708         PUSHs(sv = sv_newmortal());
3709         if (grent) {
3710             if (which == OP_GGRNAM)
3711                 sv_setiv(sv, (I32)grent->gr_gid);
3712             else
3713                 sv_setpv(sv, grent->gr_name);
3714         }
3715         RETURN;
3716     }
3717
3718     if (grent) {
3719         PUSHs(sv = sv_mortalcopy(&sv_no));
3720         sv_setpv(sv, grent->gr_name);
3721         PUSHs(sv = sv_mortalcopy(&sv_no));
3722         sv_setpv(sv, grent->gr_passwd);
3723         PUSHs(sv = sv_mortalcopy(&sv_no));
3724         sv_setiv(sv, (I32)grent->gr_gid);
3725         PUSHs(sv = sv_mortalcopy(&sv_no));
3726         for (elem = grent->gr_mem; *elem; elem++) {
3727             sv_catpv(sv, *elem);
3728             if (elem[1])
3729                 sv_catpvn(sv, " ", 1);
3730         }
3731     }
3732
3733     RETURN;
3734 #else
3735     DIE(no_func, "getgrent");
3736 #endif
3737 }
3738
3739 PP(pp_sgrent)
3740 {
3741     dSP;
3742 #ifdef HAS_GROUP
3743     setgrent();
3744     RETPUSHYES;
3745 #else
3746     DIE(no_func, "setgrent");
3747 #endif
3748 }
3749
3750 PP(pp_egrent)
3751 {
3752     dSP;
3753 #ifdef HAS_GROUP
3754     endgrent();
3755     RETPUSHYES;
3756 #else
3757     DIE(no_func, "endgrent");
3758 #endif
3759 }
3760
3761 PP(pp_getlogin)
3762 {
3763     dSP; dTARGET;
3764 #ifdef HAS_GETLOGIN
3765     char *tmps;
3766     EXTEND(SP, 1);
3767     if (!(tmps = getlogin()))
3768         RETPUSHUNDEF;
3769     PUSHp(tmps, strlen(tmps));
3770     RETURN;
3771 #else
3772     DIE(no_func, "getlogin");
3773 #endif
3774 }
3775
3776 /* Miscellaneous. */
3777
3778 PP(pp_syscall)
3779 {
3780 #ifdef HAS_SYSCALL
3781     dSP; dMARK; dORIGMARK; dTARGET;
3782     register I32 items = SP - MARK;
3783     unsigned long a[20];
3784     register I32 i = 0;
3785     I32 retval = -1;
3786     MAGIC *mg;
3787
3788     if (tainting) {
3789         while (++MARK <= SP) {
3790             if (SvGMAGICAL(*MARK) && SvSMAGICAL(*MARK) &&
3791               (mg = mg_find(*MARK, 't')) && mg->mg_len & 1)
3792                 tainted = TRUE;
3793         }
3794         MARK = ORIGMARK;
3795         TAINT_PROPER("syscall");
3796     }
3797
3798     /* This probably won't work on machines where sizeof(long) != sizeof(int)
3799      * or where sizeof(long) != sizeof(char*).  But such machines will
3800      * not likely have syscall implemented either, so who cares?
3801      */
3802     while (++MARK <= SP) {
3803         if (SvNIOK(*MARK) || !i)
3804             a[i++] = SvIV(*MARK);
3805         else if (*MARK == &sv_undef)
3806             a[i++] = 0;
3807         else
3808             a[i++] = (unsigned long)SvPV_force(*MARK, na);
3809         if (i > 15)
3810             break;
3811     }
3812     switch (items) {
3813     default:
3814         DIE("Too many args to syscall");
3815     case 0:
3816         DIE("Too few args to syscall");
3817     case 1:
3818         retval = syscall(a[0]);
3819         break;
3820     case 2:
3821         retval = syscall(a[0],a[1]);
3822         break;
3823     case 3:
3824         retval = syscall(a[0],a[1],a[2]);
3825         break;
3826     case 4:
3827         retval = syscall(a[0],a[1],a[2],a[3]);
3828         break;
3829     case 5:
3830         retval = syscall(a[0],a[1],a[2],a[3],a[4]);
3831         break;
3832     case 6:
3833         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]);
3834         break;
3835     case 7:
3836         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]);
3837         break;
3838     case 8:
3839         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
3840         break;
3841 #ifdef atarist
3842     case 9:
3843         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
3844         break;
3845     case 10:
3846         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
3847         break;
3848     case 11:
3849         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3850           a[10]);
3851         break;
3852     case 12:
3853         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3854           a[10],a[11]);
3855         break;
3856     case 13:
3857         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3858           a[10],a[11],a[12]);
3859         break;
3860     case 14:
3861         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3862           a[10],a[11],a[12],a[13]);
3863         break;
3864 #endif /* atarist */
3865     }
3866     SP = ORIGMARK;
3867     PUSHi(retval);
3868     RETURN;
3869 #else
3870     DIE(no_func, "syscall");
3871 #endif
3872 }
3873