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)
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, *tmps;
2325     int anum = 1;
2326     FILE *myfp;
2327
2328     strcpy(mybuf, cmd);
2329     strcat(mybuf, " ");
2330     for (s = mybuf+strlen(mybuf); *filename; ) {
2331         *s++ = '\\';
2332         *s++ = *filename++;
2333     }
2334     strcpy(s, " 2>&1");
2335     myfp = my_popen(mybuf, "r");
2336     if (myfp) {
2337         *mybuf = '\0';
2338         s = fgets(mybuf, sizeof mybuf, myfp);
2339         (void)my_pclose(myfp);
2340         if (s != Nullch) {
2341             for (errno = 1; errno < sys_nerr; errno++) {
2342 #ifdef HAS_SYS_ERRLIST
2343                 if (instr(mybuf, sys_errlist[errno]))   /* you don't see this */
2344                     return 0;
2345 #else
2346                 char *errmsg;                           /* especially if it isn't there */
2347
2348                 if (instr(mybuf,
2349                           (errmsg = strerror(errno)) ? errmsg : "NoErRoR"))
2350                     return 0;
2351 #endif
2352             }
2353             SETERRNO(0,0);
2354 #ifndef EACCES
2355 #define EACCES EPERM
2356 #endif
2357             if (instr(mybuf, "cannot make"))
2358                 SETERRNO(EEXIST,RMS$_FEX);
2359             else if (instr(mybuf, "existing file"))
2360                 SETERRNO(EEXIST,RMS$_FEX);
2361             else if (instr(mybuf, "ile exists"))
2362                 SETERRNO(EEXIST,RMS$_FEX);
2363             else if (instr(mybuf, "non-exist"))
2364                 SETERRNO(ENOENT,RMS$_FNF);
2365             else if (instr(mybuf, "does not exist"))
2366                 SETERRNO(ENOENT,RMS$_FNF);
2367             else if (instr(mybuf, "not empty"))
2368                 SETERRNO(EBUSY,SS$_DEVOFFLINE);
2369             else if (instr(mybuf, "cannot access"))
2370                 SETERRNO(EACCES,RMS$_PRV);
2371             else
2372                 SETERRNO(EPERM,RMS$_PRV);
2373             return 0;
2374         }
2375         else {  /* some mkdirs return no failure indication */
2376             anum = (Stat(filename, &statbuf) >= 0);
2377             if (op->op_type == OP_RMDIR)
2378                 anum = !anum;
2379             if (anum)
2380                 SETERRNO(0,0);
2381             else
2382                 SETERRNO(EACCES,RMS$_PRV);      /* a guess */
2383         }
2384         return anum;
2385     }
2386     else
2387         return 0;
2388 }
2389 #endif
2390
2391 PP(pp_mkdir)
2392 {
2393     dSP; dTARGET;
2394     int mode = POPi;
2395 #ifndef HAS_MKDIR
2396     int oldumask;
2397 #endif
2398     char *tmps = SvPV(TOPs, na);
2399
2400     TAINT_PROPER("mkdir");
2401 #ifdef HAS_MKDIR
2402     SETi( mkdir(tmps, mode) >= 0 );
2403 #else
2404     SETi( dooneliner("mkdir", tmps) );
2405     oldumask = umask(0);
2406     umask(oldumask);
2407     chmod(tmps, (mode & ~oldumask) & 0777);
2408 #endif
2409     RETURN;
2410 }
2411
2412 PP(pp_rmdir)
2413 {
2414     dSP; dTARGET;
2415     char *tmps;
2416
2417     tmps = POPp;
2418     TAINT_PROPER("rmdir");
2419 #ifdef HAS_RMDIR
2420     XPUSHi( rmdir(tmps) >= 0 );
2421 #else
2422     XPUSHi( dooneliner("rmdir", tmps) );
2423 #endif
2424     RETURN;
2425 }
2426
2427 /* Directory calls. */
2428
2429 PP(pp_open_dir)
2430 {
2431     dSP;
2432 #if defined(Direntry_t) && defined(HAS_READDIR)
2433     char *dirname = POPp;
2434     GV *gv = (GV*)POPs;
2435     register IO *io = GvIOn(gv);
2436
2437     if (!io)
2438         goto nope;
2439
2440     if (IoDIRP(io))
2441         closedir(IoDIRP(io));
2442     if (!(IoDIRP(io) = opendir(dirname)))
2443         goto nope;
2444
2445     RETPUSHYES;
2446 nope:
2447     if (!errno)
2448         SETERRNO(EBADF,RMS$_DIR);
2449     RETPUSHUNDEF;
2450 #else
2451     DIE(no_dir_func, "opendir");
2452 #endif
2453 }
2454
2455 PP(pp_readdir)
2456 {
2457     dSP;
2458 #if defined(Direntry_t) && defined(HAS_READDIR)
2459 #ifndef I_DIRENT
2460     Direntry_t *readdir _((DIR *));
2461 #endif
2462     register Direntry_t *dp;
2463     GV *gv = (GV*)POPs;
2464     register IO *io = GvIOn(gv);
2465
2466     if (!io || !IoDIRP(io))
2467         goto nope;
2468
2469     if (GIMME == G_ARRAY) {
2470         /*SUPPRESS 560*/
2471         while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
2472 #ifdef DIRNAMLEN
2473             XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
2474 #else
2475             XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
2476 #endif
2477         }
2478     }
2479     else {
2480         if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
2481             goto nope;
2482 #ifdef DIRNAMLEN
2483         XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
2484 #else
2485         XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
2486 #endif
2487     }
2488     RETURN;
2489
2490 nope:
2491     if (!errno)
2492         SETERRNO(EBADF,RMS$_ISI);
2493     if (GIMME == G_ARRAY)
2494         RETURN;
2495     else
2496         RETPUSHUNDEF;
2497 #else
2498     DIE(no_dir_func, "readdir");
2499 #endif
2500 }
2501
2502 PP(pp_telldir)
2503 {
2504     dSP; dTARGET;
2505 #if defined(HAS_TELLDIR) || defined(telldir)
2506 #if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE)
2507     long telldir _((DIR *));
2508 #endif
2509     GV *gv = (GV*)POPs;
2510     register IO *io = GvIOn(gv);
2511
2512     if (!io || !IoDIRP(io))
2513         goto nope;
2514
2515     PUSHi( telldir(IoDIRP(io)) );
2516     RETURN;
2517 nope:
2518     if (!errno)
2519         SETERRNO(EBADF,RMS$_ISI);
2520     RETPUSHUNDEF;
2521 #else
2522     DIE(no_dir_func, "telldir");
2523 #endif
2524 }
2525
2526 PP(pp_seekdir)
2527 {
2528     dSP;
2529 #if defined(HAS_SEEKDIR) || defined(seekdir)
2530     long along = POPl;
2531     GV *gv = (GV*)POPs;
2532     register IO *io = GvIOn(gv);
2533
2534     if (!io || !IoDIRP(io))
2535         goto nope;
2536
2537     (void)seekdir(IoDIRP(io), along);
2538
2539     RETPUSHYES;
2540 nope:
2541     if (!errno)
2542         SETERRNO(EBADF,RMS$_ISI);
2543     RETPUSHUNDEF;
2544 #else
2545     DIE(no_dir_func, "seekdir");
2546 #endif
2547 }
2548
2549 PP(pp_rewinddir)
2550 {
2551     dSP;
2552 #if defined(HAS_REWINDDIR) || defined(rewinddir)
2553     GV *gv = (GV*)POPs;
2554     register IO *io = GvIOn(gv);
2555
2556     if (!io || !IoDIRP(io))
2557         goto nope;
2558
2559     (void)rewinddir(IoDIRP(io));
2560     RETPUSHYES;
2561 nope:
2562     if (!errno)
2563         SETERRNO(EBADF,RMS$_ISI);
2564     RETPUSHUNDEF;
2565 #else
2566     DIE(no_dir_func, "rewinddir");
2567 #endif
2568 }
2569
2570 PP(pp_closedir)
2571 {
2572     dSP;
2573 #if defined(Direntry_t) && defined(HAS_READDIR)
2574     GV *gv = (GV*)POPs;
2575     register IO *io = GvIOn(gv);
2576
2577     if (!io || !IoDIRP(io))
2578         goto nope;
2579
2580 #ifdef VOID_CLOSEDIR
2581     closedir(IoDIRP(io));
2582 #else
2583     if (closedir(IoDIRP(io)) < 0) {
2584         IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */
2585         goto nope;
2586     }
2587 #endif
2588     IoDIRP(io) = 0;
2589
2590     RETPUSHYES;
2591 nope:
2592     if (!errno)
2593         SETERRNO(EBADF,RMS$_IFI);
2594     RETPUSHUNDEF;
2595 #else
2596     DIE(no_dir_func, "closedir");
2597 #endif
2598 }
2599
2600 /* Process control. */
2601
2602 PP(pp_fork)
2603 {
2604     dSP; dTARGET;
2605     int childpid;
2606     GV *tmpgv;
2607
2608     EXTEND(SP, 1);
2609 #ifdef HAS_FORK
2610     childpid = fork();
2611     if (childpid < 0)
2612         RETSETUNDEF;
2613     if (!childpid) {
2614         /*SUPPRESS 560*/
2615         if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
2616             sv_setiv(GvSV(tmpgv), (I32)getpid());
2617         hv_clear(pidstatus);    /* no kids, so don't wait for 'em */
2618     }
2619     PUSHi(childpid);
2620     RETURN;
2621 #else
2622     DIE(no_func, "Unsupported function fork");
2623 #endif
2624 }
2625
2626 PP(pp_wait)
2627 {
2628     dSP; dTARGET;
2629     int childpid;
2630     int argflags;
2631     I32 value;
2632
2633     EXTEND(SP, 1);
2634 #ifdef HAS_WAIT
2635     childpid = wait(&argflags);
2636     if (childpid > 0)
2637         pidgone(childpid, argflags);
2638     value = (I32)childpid;
2639     statusvalue = FIXSTATUS(argflags);
2640     PUSHi(value);
2641     RETURN;
2642 #else
2643     DIE(no_func, "Unsupported function wait");
2644 #endif
2645 }
2646
2647 PP(pp_waitpid)
2648 {
2649     dSP; dTARGET;
2650     int childpid;
2651     int optype;
2652     int argflags;
2653     I32 value;
2654
2655 #ifdef HAS_WAIT
2656     optype = POPi;
2657     childpid = TOPi;
2658     childpid = wait4pid(childpid, &argflags, optype);
2659     value = (I32)childpid;
2660     statusvalue = FIXSTATUS(argflags);
2661     SETi(value);
2662     RETURN;
2663 #else
2664     DIE(no_func, "Unsupported function wait");
2665 #endif
2666 }
2667
2668 PP(pp_system)
2669 {
2670     dSP; dMARK; dORIGMARK; dTARGET;
2671     I32 value;
2672     int childpid;
2673     int result;
2674     int status;
2675     Signal_t (*ihand)();     /* place to save signal during system() */
2676     Signal_t (*qhand)();     /* place to save signal during system() */
2677
2678 #if defined(HAS_FORK) && !defined(VMS)
2679     if (SP - MARK == 1) {
2680         if (tainting) {
2681             char *junk = SvPV(TOPs, na);
2682             TAINT_ENV();
2683             TAINT_PROPER("system");
2684         }
2685     }
2686     while ((childpid = vfork()) == -1) {
2687         if (errno != EAGAIN) {
2688             value = -1;
2689             SP = ORIGMARK;
2690             PUSHi(value);
2691             RETURN;
2692         }
2693         sleep(5);
2694     }
2695     if (childpid > 0) {
2696         ihand = signal(SIGINT, SIG_IGN);
2697         qhand = signal(SIGQUIT, SIG_IGN);
2698         do {
2699             result = wait4pid(childpid, &status, 0);
2700         } while (result == -1 && errno == EINTR);
2701         (void)signal(SIGINT, ihand);
2702         (void)signal(SIGQUIT, qhand);
2703         statusvalue = FIXSTATUS(status);
2704         if (result < 0)
2705             value = -1;
2706         else {
2707             value = (I32)((unsigned int)status & 0xffff);
2708         }
2709         do_execfree();  /* free any memory child malloced on vfork */
2710         SP = ORIGMARK;
2711         PUSHi(value);
2712         RETURN;
2713     }
2714     if (op->op_flags & OPf_STACKED) {
2715         SV *really = *++MARK;
2716         value = (I32)do_aexec(really, MARK, SP);
2717     }
2718     else if (SP - MARK != 1)
2719         value = (I32)do_aexec(Nullsv, MARK, SP);
2720     else {
2721         value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
2722     }
2723     _exit(-1);
2724 #else /* ! FORK or VMS */
2725     if (op->op_flags & OPf_STACKED) {
2726         SV *really = *++MARK;
2727         value = (I32)do_aspawn(really, MARK, SP);
2728     }
2729     else if (SP - MARK != 1)
2730         value = (I32)do_aspawn(Nullsv, MARK, SP);
2731     else {
2732         value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
2733     }
2734     do_execfree();
2735     SP = ORIGMARK;
2736     PUSHi(value);
2737 #endif /* !FORK or VMS */
2738     RETURN;
2739 }
2740
2741 PP(pp_exec)
2742 {
2743     dSP; dMARK; dORIGMARK; dTARGET;
2744     I32 value;
2745
2746     if (op->op_flags & OPf_STACKED) {
2747         SV *really = *++MARK;
2748         value = (I32)do_aexec(really, MARK, SP);
2749     }
2750     else if (SP - MARK != 1)
2751 #ifdef VMS
2752         value = (I32)vms_do_aexec(Nullsv, MARK, SP);
2753 #else
2754         value = (I32)do_aexec(Nullsv, MARK, SP);
2755 #endif
2756     else {
2757         if (tainting) {
2758             char *junk = SvPV(*SP, na);
2759             TAINT_ENV();
2760             TAINT_PROPER("exec");
2761         }
2762 #ifdef VMS
2763         value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
2764 #else
2765         value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
2766 #endif
2767     }
2768     SP = ORIGMARK;
2769     PUSHi(value);
2770     RETURN;
2771 }
2772
2773 PP(pp_kill)
2774 {
2775     dSP; dMARK; dTARGET;
2776     I32 value;
2777 #ifdef HAS_KILL
2778     value = (I32)apply(op->op_type, MARK, SP);
2779     SP = MARK;
2780     PUSHi(value);
2781     RETURN;
2782 #else
2783     DIE(no_func, "Unsupported function kill");
2784 #endif
2785 }
2786
2787 PP(pp_getppid)
2788 {
2789 #ifdef HAS_GETPPID
2790     dSP; dTARGET;
2791     XPUSHi( getppid() );
2792     RETURN;
2793 #else
2794     DIE(no_func, "getppid");
2795 #endif
2796 }
2797
2798 PP(pp_getpgrp)
2799 {
2800 #ifdef HAS_GETPGRP
2801     dSP; dTARGET;
2802     int pid;
2803     I32 value;
2804
2805     if (MAXARG < 1)
2806         pid = 0;
2807     else
2808         pid = SvIVx(POPs);
2809 #ifdef USE_BSDPGRP
2810     value = (I32)getpgrp(pid);
2811 #else
2812     if (pid != 0)
2813         DIE("POSIX getpgrp can't take an argument");
2814     value = (I32)getpgrp();
2815 #endif
2816     XPUSHi(value);
2817     RETURN;
2818 #else
2819     DIE(no_func, "getpgrp()");
2820 #endif
2821 }
2822
2823 PP(pp_setpgrp)
2824 {
2825 #ifdef HAS_SETPGRP
2826     dSP; dTARGET;
2827     int pgrp;
2828     int pid;
2829     if (MAXARG < 2) {
2830         pgrp = 0;
2831         pid = 0;
2832     }
2833     else {
2834         pgrp = POPi;
2835         pid = TOPi;
2836     }
2837
2838     TAINT_PROPER("setpgrp");
2839 #ifdef USE_BSDPGRP
2840     SETi( setpgrp(pid, pgrp) >= 0 );
2841 #else
2842     if ((pgrp != 0) || (pid != 0)) {
2843         DIE("POSIX setpgrp can't take an argument");
2844     }
2845     SETi( setpgrp() >= 0 );
2846 #endif /* USE_BSDPGRP */
2847     RETURN;
2848 #else
2849     DIE(no_func, "setpgrp()");
2850 #endif
2851 }
2852
2853 PP(pp_getpriority)
2854 {
2855     dSP; dTARGET;
2856     int which;
2857     int who;
2858 #ifdef HAS_GETPRIORITY
2859     who = POPi;
2860     which = TOPi;
2861     SETi( getpriority(which, who) );
2862     RETURN;
2863 #else
2864     DIE(no_func, "getpriority()");
2865 #endif
2866 }
2867
2868 PP(pp_setpriority)
2869 {
2870     dSP; dTARGET;
2871     int which;
2872     int who;
2873     int niceval;
2874 #ifdef HAS_SETPRIORITY
2875     niceval = POPi;
2876     who = POPi;
2877     which = TOPi;
2878     TAINT_PROPER("setpriority");
2879     SETi( setpriority(which, who, niceval) >= 0 );
2880     RETURN;
2881 #else
2882     DIE(no_func, "setpriority()");
2883 #endif
2884 }
2885
2886 /* Time calls. */
2887
2888 PP(pp_time)
2889 {
2890     dSP; dTARGET;
2891     XPUSHi( time(Null(Time_t*)) );
2892     RETURN;
2893 }
2894
2895 #ifndef HZ
2896 #define HZ 60
2897 #endif
2898
2899 PP(pp_tms)
2900 {
2901     dSP;
2902
2903 #if defined(MSDOS) || !defined(HAS_TIMES)
2904     DIE("times not implemented");
2905 #else
2906     EXTEND(SP, 4);
2907
2908 #ifndef VMS
2909     (void)times(&timesbuf);
2910 #else
2911     (void)times((tbuffer_t *)&timesbuf);  /* time.h uses different name for */
2912                                           /* struct tms, though same data   */
2913                                           /* is returned.                   */
2914 #endif
2915
2916     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
2917     if (GIMME == G_ARRAY) {
2918         PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
2919         PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
2920         PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
2921     }
2922     RETURN;
2923 #endif /* MSDOS */
2924 }
2925
2926 PP(pp_localtime)
2927 {
2928     return pp_gmtime(ARGS);
2929 }
2930
2931 PP(pp_gmtime)
2932 {
2933     dSP;
2934     Time_t when;
2935     struct tm *tmbuf;
2936     static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
2937     static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
2938                               "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
2939
2940     if (MAXARG < 1)
2941         (void)time(&when);
2942     else
2943         when = (Time_t)SvIVx(POPs);
2944
2945     if (op->op_type == OP_LOCALTIME)
2946         tmbuf = localtime(&when);
2947     else
2948         tmbuf = gmtime(&when);
2949
2950     EXTEND(SP, 9);
2951     if (GIMME != G_ARRAY) {
2952         dTARGET;
2953         char mybuf[30];
2954         if (!tmbuf)
2955             RETPUSHUNDEF;
2956         sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
2957             dayname[tmbuf->tm_wday],
2958             monname[tmbuf->tm_mon],
2959             tmbuf->tm_mday,
2960             tmbuf->tm_hour,
2961             tmbuf->tm_min,
2962             tmbuf->tm_sec,
2963             tmbuf->tm_year + 1900);
2964         PUSHp(mybuf, strlen(mybuf));
2965     }
2966     else if (tmbuf) {
2967         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
2968         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
2969         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
2970         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
2971         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
2972         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
2973         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
2974         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
2975         PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
2976     }
2977     RETURN;
2978 }
2979
2980 PP(pp_alarm)
2981 {
2982     dSP; dTARGET;
2983     int anum;
2984 #ifdef HAS_ALARM
2985     anum = POPi;
2986     anum = alarm((unsigned int)anum);
2987     EXTEND(SP, 1);
2988     if (anum < 0)
2989         RETPUSHUNDEF;
2990     PUSHi((I32)anum);
2991     RETURN;
2992 #else
2993     DIE(no_func, "Unsupported function alarm");
2994 #endif
2995 }
2996
2997 PP(pp_sleep)
2998 {
2999     dSP; dTARGET;
3000     I32 duration;
3001     Time_t lasttime;
3002     Time_t when;
3003
3004     (void)time(&lasttime);
3005     if (MAXARG < 1)
3006         pause();
3007     else {
3008         duration = POPi;
3009         sleep((unsigned int)duration);
3010     }
3011     (void)time(&when);
3012     XPUSHi(when - lasttime);
3013     RETURN;
3014 }
3015
3016 /* Shared memory. */
3017
3018 PP(pp_shmget)
3019 {
3020     return pp_semget(ARGS);
3021 }
3022
3023 PP(pp_shmctl)
3024 {
3025     return pp_semctl(ARGS);
3026 }
3027
3028 PP(pp_shmread)
3029 {
3030     return pp_shmwrite(ARGS);
3031 }
3032
3033 PP(pp_shmwrite)
3034 {
3035 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3036     dSP; dMARK; dTARGET;
3037     I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
3038     SP = MARK;
3039     PUSHi(value);
3040     RETURN;
3041 #else
3042     return pp_semget(ARGS);
3043 #endif
3044 }
3045
3046 /* Message passing. */
3047
3048 PP(pp_msgget)
3049 {
3050     return pp_semget(ARGS);
3051 }
3052
3053 PP(pp_msgctl)
3054 {
3055     return pp_semctl(ARGS);
3056 }
3057
3058 PP(pp_msgsnd)
3059 {
3060 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3061     dSP; dMARK; dTARGET;
3062     I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
3063     SP = MARK;
3064     PUSHi(value);
3065     RETURN;
3066 #else
3067     return pp_semget(ARGS);
3068 #endif
3069 }
3070
3071 PP(pp_msgrcv)
3072 {
3073 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3074     dSP; dMARK; dTARGET;
3075     I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
3076     SP = MARK;
3077     PUSHi(value);
3078     RETURN;
3079 #else
3080     return pp_semget(ARGS);
3081 #endif
3082 }
3083
3084 /* Semaphores. */
3085
3086 PP(pp_semget)
3087 {
3088 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3089     dSP; dMARK; dTARGET;
3090     int anum = do_ipcget(op->op_type, MARK, SP);
3091     SP = MARK;
3092     if (anum == -1)
3093         RETPUSHUNDEF;
3094     PUSHi(anum);
3095     RETURN;
3096 #else
3097     DIE("System V IPC is not implemented on this machine");
3098 #endif
3099 }
3100
3101 PP(pp_semctl)
3102 {
3103 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3104     dSP; dMARK; dTARGET;
3105     int anum = do_ipcctl(op->op_type, MARK, SP);
3106     SP = MARK;
3107     if (anum == -1)
3108         RETSETUNDEF;
3109     if (anum != 0) {
3110         PUSHi(anum);
3111     }
3112     else {
3113         PUSHp("0 but true",10);
3114     }
3115     RETURN;
3116 #else
3117     return pp_semget(ARGS);
3118 #endif
3119 }
3120
3121 PP(pp_semop)
3122 {
3123 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3124     dSP; dMARK; dTARGET;
3125     I32 value = (I32)(do_semop(MARK, SP) >= 0);
3126     SP = MARK;
3127     PUSHi(value);
3128     RETURN;
3129 #else
3130     return pp_semget(ARGS);
3131 #endif
3132 }
3133
3134 /* Get system info. */
3135
3136 PP(pp_ghbyname)
3137 {
3138 #ifdef HAS_SOCKET
3139     return pp_ghostent(ARGS);
3140 #else
3141     DIE(no_sock_func, "gethostbyname");
3142 #endif
3143 }
3144
3145 PP(pp_ghbyaddr)
3146 {
3147 #ifdef HAS_SOCKET
3148     return pp_ghostent(ARGS);
3149 #else
3150     DIE(no_sock_func, "gethostbyaddr");
3151 #endif
3152 }
3153
3154 PP(pp_ghostent)
3155 {
3156     dSP;
3157 #ifdef HAS_SOCKET
3158     I32 which = op->op_type;
3159     register char **elem;
3160     register SV *sv;
3161     struct hostent *gethostbyname();
3162     struct hostent *gethostbyaddr();
3163 #ifdef HAS_GETHOSTENT
3164     struct hostent *gethostent();
3165 #endif
3166     struct hostent *hent;
3167     unsigned long len;
3168
3169     EXTEND(SP, 10);
3170     if (which == OP_GHBYNAME) {
3171         hent = gethostbyname(POPp);
3172     }
3173     else if (which == OP_GHBYADDR) {
3174         int addrtype = POPi;
3175         SV *addrsv = POPs;
3176         STRLEN addrlen;
3177         char *addr = SvPV(addrsv, addrlen);
3178
3179         hent = gethostbyaddr(addr, addrlen, addrtype);
3180     }
3181     else
3182 #ifdef HAS_GETHOSTENT
3183         hent = gethostent();
3184 #else
3185         DIE("gethostent not implemented");
3186 #endif
3187
3188 #ifdef HOST_NOT_FOUND
3189     if (!hent)
3190         statusvalue = FIXSTATUS(h_errno);
3191 #endif
3192
3193     if (GIMME != G_ARRAY) {
3194         PUSHs(sv = sv_newmortal());
3195         if (hent) {
3196             if (which == OP_GHBYNAME) {
3197                 sv_setpvn(sv, hent->h_addr, hent->h_length);
3198             }
3199             else
3200                 sv_setpv(sv, (char*)hent->h_name);
3201         }
3202         RETURN;
3203     }
3204
3205     if (hent) {
3206         PUSHs(sv = sv_mortalcopy(&sv_no));
3207         sv_setpv(sv, (char*)hent->h_name);
3208         PUSHs(sv = sv_mortalcopy(&sv_no));
3209         for (elem = hent->h_aliases; elem && *elem; elem++) {
3210             sv_catpv(sv, *elem);
3211             if (elem[1])
3212                 sv_catpvn(sv, " ", 1);
3213         }
3214         PUSHs(sv = sv_mortalcopy(&sv_no));
3215         sv_setiv(sv, (I32)hent->h_addrtype);
3216         PUSHs(sv = sv_mortalcopy(&sv_no));
3217         len = hent->h_length;
3218         sv_setiv(sv, (I32)len);
3219 #ifdef h_addr
3220         for (elem = hent->h_addr_list; elem && *elem; elem++) {
3221             XPUSHs(sv = sv_mortalcopy(&sv_no));
3222             sv_setpvn(sv, *elem, len);
3223         }
3224 #else
3225         PUSHs(sv = sv_mortalcopy(&sv_no));
3226         sv_setpvn(sv, hent->h_addr, len);
3227 #endif /* h_addr */
3228     }
3229     RETURN;
3230 #else
3231     DIE(no_sock_func, "gethostent");
3232 #endif
3233 }
3234
3235 PP(pp_gnbyname)
3236 {
3237 #ifdef HAS_SOCKET
3238     return pp_gnetent(ARGS);
3239 #else
3240     DIE(no_sock_func, "getnetbyname");
3241 #endif
3242 }
3243
3244 PP(pp_gnbyaddr)
3245 {
3246 #ifdef HAS_SOCKET
3247     return pp_gnetent(ARGS);
3248 #else
3249     DIE(no_sock_func, "getnetbyaddr");
3250 #endif
3251 }
3252
3253 PP(pp_gnetent)
3254 {
3255     dSP;
3256 #ifdef HAS_SOCKET
3257     I32 which = op->op_type;
3258     register char **elem;
3259     register SV *sv;
3260     struct netent *getnetbyname();
3261     struct netent *getnetbyaddr();
3262     struct netent *getnetent();
3263     struct netent *nent;
3264
3265     if (which == OP_GNBYNAME)
3266         nent = getnetbyname(POPp);
3267     else if (which == OP_GNBYADDR) {
3268         int addrtype = POPi;
3269         unsigned long addr = U_L(POPn);
3270         nent = getnetbyaddr((long)addr, addrtype);
3271     }
3272     else
3273         nent = getnetent();
3274
3275     EXTEND(SP, 4);
3276     if (GIMME != G_ARRAY) {
3277         PUSHs(sv = sv_newmortal());
3278         if (nent) {
3279             if (which == OP_GNBYNAME)
3280                 sv_setiv(sv, (I32)nent->n_net);
3281             else
3282                 sv_setpv(sv, nent->n_name);
3283         }
3284         RETURN;
3285     }
3286
3287     if (nent) {
3288         PUSHs(sv = sv_mortalcopy(&sv_no));
3289         sv_setpv(sv, nent->n_name);
3290         PUSHs(sv = sv_mortalcopy(&sv_no));
3291         for (elem = nent->n_aliases; *elem; elem++) {
3292             sv_catpv(sv, *elem);
3293             if (elem[1])
3294                 sv_catpvn(sv, " ", 1);
3295         }
3296         PUSHs(sv = sv_mortalcopy(&sv_no));
3297         sv_setiv(sv, (I32)nent->n_addrtype);
3298         PUSHs(sv = sv_mortalcopy(&sv_no));
3299         sv_setiv(sv, (I32)nent->n_net);
3300     }
3301
3302     RETURN;
3303 #else
3304     DIE(no_sock_func, "getnetent");
3305 #endif
3306 }
3307
3308 PP(pp_gpbyname)
3309 {
3310 #ifdef HAS_SOCKET
3311     return pp_gprotoent(ARGS);
3312 #else
3313     DIE(no_sock_func, "getprotobyname");
3314 #endif
3315 }
3316
3317 PP(pp_gpbynumber)
3318 {
3319 #ifdef HAS_SOCKET
3320     return pp_gprotoent(ARGS);
3321 #else
3322     DIE(no_sock_func, "getprotobynumber");
3323 #endif
3324 }
3325
3326 PP(pp_gprotoent)
3327 {
3328     dSP;
3329 #ifdef HAS_SOCKET
3330     I32 which = op->op_type;
3331     register char **elem;
3332     register SV *sv;
3333     struct protoent *getprotobyname();
3334     struct protoent *getprotobynumber();
3335     struct protoent *getprotoent();
3336     struct protoent *pent;
3337
3338     if (which == OP_GPBYNAME)
3339         pent = getprotobyname(POPp);
3340     else if (which == OP_GPBYNUMBER)
3341         pent = getprotobynumber(POPi);
3342     else
3343         pent = getprotoent();
3344
3345     EXTEND(SP, 3);
3346     if (GIMME != G_ARRAY) {
3347         PUSHs(sv = sv_newmortal());
3348         if (pent) {
3349             if (which == OP_GPBYNAME)
3350                 sv_setiv(sv, (I32)pent->p_proto);
3351             else
3352                 sv_setpv(sv, pent->p_name);
3353         }
3354         RETURN;
3355     }
3356
3357     if (pent) {
3358         PUSHs(sv = sv_mortalcopy(&sv_no));
3359         sv_setpv(sv, pent->p_name);
3360         PUSHs(sv = sv_mortalcopy(&sv_no));
3361         for (elem = pent->p_aliases; *elem; elem++) {
3362             sv_catpv(sv, *elem);
3363             if (elem[1])
3364                 sv_catpvn(sv, " ", 1);
3365         }
3366         PUSHs(sv = sv_mortalcopy(&sv_no));
3367         sv_setiv(sv, (I32)pent->p_proto);
3368     }
3369
3370     RETURN;
3371 #else
3372     DIE(no_sock_func, "getprotoent");
3373 #endif
3374 }
3375
3376 PP(pp_gsbyname)
3377 {
3378 #ifdef HAS_SOCKET
3379     return pp_gservent(ARGS);
3380 #else
3381     DIE(no_sock_func, "getservbyname");
3382 #endif
3383 }
3384
3385 PP(pp_gsbyport)
3386 {
3387 #ifdef HAS_SOCKET
3388     return pp_gservent(ARGS);
3389 #else
3390     DIE(no_sock_func, "getservbyport");
3391 #endif
3392 }
3393
3394 PP(pp_gservent)
3395 {
3396     dSP;
3397 #ifdef HAS_SOCKET
3398     I32 which = op->op_type;
3399     register char **elem;
3400     register SV *sv;
3401     struct servent *getservbyname();
3402     struct servent *getservbynumber();
3403     struct servent *getservent();
3404     struct servent *sent;
3405
3406     if (which == OP_GSBYNAME) {
3407         char *proto = POPp;
3408         char *name = POPp;
3409
3410         if (proto && !*proto)
3411             proto = Nullch;
3412
3413         sent = getservbyname(name, proto);
3414     }
3415     else if (which == OP_GSBYPORT) {
3416         char *proto = POPp;
3417         int port = POPi;
3418
3419         sent = getservbyport(port, proto);
3420     }
3421     else
3422         sent = getservent();
3423
3424     EXTEND(SP, 4);
3425     if (GIMME != G_ARRAY) {
3426         PUSHs(sv = sv_newmortal());
3427         if (sent) {
3428             if (which == OP_GSBYNAME) {
3429 #ifdef HAS_NTOHS
3430                 sv_setiv(sv, (I32)ntohs(sent->s_port));
3431 #else
3432                 sv_setiv(sv, (I32)(sent->s_port));
3433 #endif
3434             }
3435             else
3436                 sv_setpv(sv, sent->s_name);
3437         }
3438         RETURN;
3439     }
3440
3441     if (sent) {
3442         PUSHs(sv = sv_mortalcopy(&sv_no));
3443         sv_setpv(sv, sent->s_name);
3444         PUSHs(sv = sv_mortalcopy(&sv_no));
3445         for (elem = sent->s_aliases; *elem; elem++) {
3446             sv_catpv(sv, *elem);
3447             if (elem[1])
3448                 sv_catpvn(sv, " ", 1);
3449         }
3450         PUSHs(sv = sv_mortalcopy(&sv_no));
3451 #ifdef HAS_NTOHS
3452         sv_setiv(sv, (I32)ntohs(sent->s_port));
3453 #else
3454         sv_setiv(sv, (I32)(sent->s_port));
3455 #endif
3456         PUSHs(sv = sv_mortalcopy(&sv_no));
3457         sv_setpv(sv, sent->s_proto);
3458     }
3459
3460     RETURN;
3461 #else
3462     DIE(no_sock_func, "getservent");
3463 #endif
3464 }
3465
3466 PP(pp_shostent)
3467 {
3468     dSP;
3469 #ifdef HAS_SOCKET
3470     sethostent(TOPi);
3471     RETSETYES;
3472 #else
3473     DIE(no_sock_func, "sethostent");
3474 #endif
3475 }
3476
3477 PP(pp_snetent)
3478 {
3479     dSP;
3480 #ifdef HAS_SOCKET
3481     setnetent(TOPi);
3482     RETSETYES;
3483 #else
3484     DIE(no_sock_func, "setnetent");
3485 #endif
3486 }
3487
3488 PP(pp_sprotoent)
3489 {
3490     dSP;
3491 #ifdef HAS_SOCKET
3492     setprotoent(TOPi);
3493     RETSETYES;
3494 #else
3495     DIE(no_sock_func, "setprotoent");
3496 #endif
3497 }
3498
3499 PP(pp_sservent)
3500 {
3501     dSP;
3502 #ifdef HAS_SOCKET
3503     setservent(TOPi);
3504     RETSETYES;
3505 #else
3506     DIE(no_sock_func, "setservent");
3507 #endif
3508 }
3509
3510 PP(pp_ehostent)
3511 {
3512     dSP;
3513 #ifdef HAS_SOCKET
3514     endhostent();
3515     EXTEND(sp,1);
3516     RETPUSHYES;
3517 #else
3518     DIE(no_sock_func, "endhostent");
3519 #endif
3520 }
3521
3522 PP(pp_enetent)
3523 {
3524     dSP;
3525 #ifdef HAS_SOCKET
3526     endnetent();
3527     EXTEND(sp,1);
3528     RETPUSHYES;
3529 #else
3530     DIE(no_sock_func, "endnetent");
3531 #endif
3532 }
3533
3534 PP(pp_eprotoent)
3535 {
3536     dSP;
3537 #ifdef HAS_SOCKET
3538     endprotoent();
3539     EXTEND(sp,1);
3540     RETPUSHYES;
3541 #else
3542     DIE(no_sock_func, "endprotoent");
3543 #endif
3544 }
3545
3546 PP(pp_eservent)
3547 {
3548     dSP;
3549 #ifdef HAS_SOCKET
3550     endservent();
3551     EXTEND(sp,1);
3552     RETPUSHYES;
3553 #else
3554     DIE(no_sock_func, "endservent");
3555 #endif
3556 }
3557
3558 PP(pp_gpwnam)
3559 {
3560 #ifdef HAS_PASSWD
3561     return pp_gpwent(ARGS);
3562 #else
3563     DIE(no_func, "getpwnam");
3564 #endif
3565 }
3566
3567 PP(pp_gpwuid)
3568 {
3569 #ifdef HAS_PASSWD
3570     return pp_gpwent(ARGS);
3571 #else
3572     DIE(no_func, "getpwuid");
3573 #endif
3574 }
3575
3576 PP(pp_gpwent)
3577 {
3578     dSP;
3579 #ifdef HAS_PASSWD
3580     I32 which = op->op_type;
3581     register SV *sv;
3582     struct passwd *pwent;
3583
3584     if (which == OP_GPWNAM)
3585         pwent = getpwnam(POPp);
3586     else if (which == OP_GPWUID)
3587         pwent = getpwuid(POPi);
3588     else
3589         pwent = (struct passwd *)getpwent();
3590
3591     EXTEND(SP, 10);
3592     if (GIMME != G_ARRAY) {
3593         PUSHs(sv = sv_newmortal());
3594         if (pwent) {
3595             if (which == OP_GPWNAM)
3596                 sv_setiv(sv, (I32)pwent->pw_uid);
3597             else
3598                 sv_setpv(sv, pwent->pw_name);
3599         }
3600         RETURN;
3601     }
3602
3603     if (pwent) {
3604         PUSHs(sv = sv_mortalcopy(&sv_no));
3605         sv_setpv(sv, pwent->pw_name);
3606         PUSHs(sv = sv_mortalcopy(&sv_no));
3607         sv_setpv(sv, pwent->pw_passwd);
3608         PUSHs(sv = sv_mortalcopy(&sv_no));
3609         sv_setiv(sv, (I32)pwent->pw_uid);
3610         PUSHs(sv = sv_mortalcopy(&sv_no));
3611         sv_setiv(sv, (I32)pwent->pw_gid);
3612         PUSHs(sv = sv_mortalcopy(&sv_no));
3613 #ifdef PWCHANGE
3614         sv_setiv(sv, (I32)pwent->pw_change);
3615 #else
3616 #ifdef PWQUOTA
3617         sv_setiv(sv, (I32)pwent->pw_quota);
3618 #else
3619 #ifdef PWAGE
3620         sv_setpv(sv, pwent->pw_age);
3621 #endif
3622 #endif
3623 #endif
3624         PUSHs(sv = sv_mortalcopy(&sv_no));
3625 #ifdef PWCLASS
3626         sv_setpv(sv, pwent->pw_class);
3627 #else
3628 #ifdef PWCOMMENT
3629         sv_setpv(sv, pwent->pw_comment);
3630 #endif
3631 #endif
3632         PUSHs(sv = sv_mortalcopy(&sv_no));
3633         sv_setpv(sv, pwent->pw_gecos);
3634         PUSHs(sv = sv_mortalcopy(&sv_no));
3635         sv_setpv(sv, pwent->pw_dir);
3636         PUSHs(sv = sv_mortalcopy(&sv_no));
3637         sv_setpv(sv, pwent->pw_shell);
3638 #ifdef PWEXPIRE
3639         PUSHs(sv = sv_mortalcopy(&sv_no));
3640         sv_setiv(sv, (I32)pwent->pw_expire);
3641 #endif
3642     }
3643     RETURN;
3644 #else
3645     DIE(no_func, "getpwent");
3646 #endif
3647 }
3648
3649 PP(pp_spwent)
3650 {
3651     dSP;
3652 #ifdef HAS_PASSWD
3653     setpwent();
3654     RETPUSHYES;
3655 #else
3656     DIE(no_func, "setpwent");
3657 #endif
3658 }
3659
3660 PP(pp_epwent)
3661 {
3662     dSP;
3663 #ifdef HAS_PASSWD
3664     endpwent();
3665     RETPUSHYES;
3666 #else
3667     DIE(no_func, "endpwent");
3668 #endif
3669 }
3670
3671 PP(pp_ggrnam)
3672 {
3673 #ifdef HAS_GROUP
3674     return pp_ggrent(ARGS);
3675 #else
3676     DIE(no_func, "getgrnam");
3677 #endif
3678 }
3679
3680 PP(pp_ggrgid)
3681 {
3682 #ifdef HAS_GROUP
3683     return pp_ggrent(ARGS);
3684 #else
3685     DIE(no_func, "getgrgid");
3686 #endif
3687 }
3688
3689 PP(pp_ggrent)
3690 {
3691     dSP;
3692 #ifdef HAS_GROUP
3693     I32 which = op->op_type;
3694     register char **elem;
3695     register SV *sv;
3696     struct group *grent;
3697
3698     if (which == OP_GGRNAM)
3699         grent = (struct group *)getgrnam(POPp);
3700     else if (which == OP_GGRGID)
3701         grent = (struct group *)getgrgid(POPi);
3702     else
3703         grent = (struct group *)getgrent();
3704
3705     EXTEND(SP, 4);
3706     if (GIMME != G_ARRAY) {
3707         PUSHs(sv = sv_newmortal());
3708         if (grent) {
3709             if (which == OP_GGRNAM)
3710                 sv_setiv(sv, (I32)grent->gr_gid);
3711             else
3712                 sv_setpv(sv, grent->gr_name);
3713         }
3714         RETURN;
3715     }
3716
3717     if (grent) {
3718         PUSHs(sv = sv_mortalcopy(&sv_no));
3719         sv_setpv(sv, grent->gr_name);
3720         PUSHs(sv = sv_mortalcopy(&sv_no));
3721         sv_setpv(sv, grent->gr_passwd);
3722         PUSHs(sv = sv_mortalcopy(&sv_no));
3723         sv_setiv(sv, (I32)grent->gr_gid);
3724         PUSHs(sv = sv_mortalcopy(&sv_no));
3725         for (elem = grent->gr_mem; *elem; elem++) {
3726             sv_catpv(sv, *elem);
3727             if (elem[1])
3728                 sv_catpvn(sv, " ", 1);
3729         }
3730     }
3731
3732     RETURN;
3733 #else
3734     DIE(no_func, "getgrent");
3735 #endif
3736 }
3737
3738 PP(pp_sgrent)
3739 {
3740     dSP;
3741 #ifdef HAS_GROUP
3742     setgrent();
3743     RETPUSHYES;
3744 #else
3745     DIE(no_func, "setgrent");
3746 #endif
3747 }
3748
3749 PP(pp_egrent)
3750 {
3751     dSP;
3752 #ifdef HAS_GROUP
3753     endgrent();
3754     RETPUSHYES;
3755 #else
3756     DIE(no_func, "endgrent");
3757 #endif
3758 }
3759
3760 PP(pp_getlogin)
3761 {
3762     dSP; dTARGET;
3763 #ifdef HAS_GETLOGIN
3764     char *tmps;
3765     EXTEND(SP, 1);
3766     if (!(tmps = getlogin()))
3767         RETPUSHUNDEF;
3768     PUSHp(tmps, strlen(tmps));
3769     RETURN;
3770 #else
3771     DIE(no_func, "getlogin");
3772 #endif
3773 }
3774
3775 /* Miscellaneous. */
3776
3777 PP(pp_syscall)
3778 {
3779 #ifdef HAS_SYSCALL
3780     dSP; dMARK; dORIGMARK; dTARGET;
3781     register I32 items = SP - MARK;
3782     unsigned long a[20];
3783     register I32 i = 0;
3784     I32 retval = -1;
3785     MAGIC *mg;
3786
3787     if (tainting) {
3788         while (++MARK <= SP) {
3789             if (SvGMAGICAL(*MARK) && SvSMAGICAL(*MARK) &&
3790               (mg = mg_find(*MARK, 't')) && mg->mg_len & 1)
3791                 tainted = TRUE;
3792         }
3793         MARK = ORIGMARK;
3794         TAINT_PROPER("syscall");
3795     }
3796
3797     /* This probably won't work on machines where sizeof(long) != sizeof(int)
3798      * or where sizeof(long) != sizeof(char*).  But such machines will
3799      * not likely have syscall implemented either, so who cares?
3800      */
3801     while (++MARK <= SP) {
3802         if (SvNIOK(*MARK) || !i)
3803             a[i++] = SvIV(*MARK);
3804         else if (*MARK == &sv_undef)
3805             a[i++] = 0;
3806         else
3807             a[i++] = (unsigned long)SvPV_force(*MARK, na);
3808         if (i > 15)
3809             break;
3810     }
3811     switch (items) {
3812     default:
3813         DIE("Too many args to syscall");
3814     case 0:
3815         DIE("Too few args to syscall");
3816     case 1:
3817         retval = syscall(a[0]);
3818         break;
3819     case 2:
3820         retval = syscall(a[0],a[1]);
3821         break;
3822     case 3:
3823         retval = syscall(a[0],a[1],a[2]);
3824         break;
3825     case 4:
3826         retval = syscall(a[0],a[1],a[2],a[3]);
3827         break;
3828     case 5:
3829         retval = syscall(a[0],a[1],a[2],a[3],a[4]);
3830         break;
3831     case 6:
3832         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]);
3833         break;
3834     case 7:
3835         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]);
3836         break;
3837     case 8:
3838         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
3839         break;
3840 #ifdef atarist
3841     case 9:
3842         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
3843         break;
3844     case 10:
3845         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
3846         break;
3847     case 11:
3848         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3849           a[10]);
3850         break;
3851     case 12:
3852         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3853           a[10],a[11]);
3854         break;
3855     case 13:
3856         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3857           a[10],a[11],a[12]);
3858         break;
3859     case 14:
3860         retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3861           a[10],a[11],a[12],a[13]);
3862         break;
3863 #endif /* atarist */
3864     }
3865     SP = ORIGMARK;
3866     PUSHi(retval);
3867     RETURN;
3868 #else
3869     DIE(no_func, "syscall");
3870 #endif
3871 }
3872