Remove some autoderef leftovers

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index e9958b3..33cba46 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -30,7 +30,6 @@
 #define PERL_IN_PP_SYS_C
 #include "perl.h"
 #include "time64.h"
 #define PERL_IN_PP_SYS_C
 #include "perl.h"
 #include "time64.h"

-#include "time64.c"

 
 #ifdef I_SHADOW
 /* Shadow password support for solaris - pdo@cs.umd.edu
 
 #ifdef I_SHADOW
 /* Shadow password support for solaris - pdo@cs.umd.edu


@@ -179,10 +178,6 @@ static const char zero_but_true[ZBTLEN + 1] = "0 but true";
 #  include <sys/access.h>
 #endif
 
 #  include <sys/access.h>
 #endif
 

-#if defined(HAS_FCNTL) && defined(F_SETFD) && !defined(FD_CLOEXEC)
-#  define FD_CLOEXEC 1         /* NeXT needs this */
-#endif
-

 #include "reentr.h"
 
 #ifdef __Lynx__
 #include "reentr.h"
 
 #ifdef __Lynx__


@@ -197,6 +192,10 @@ void setservent(int);
 void endservent(void);
 #endif
 
 void endservent(void);
 #endif
 

+#ifdef __amigaos4__
+#  include "amigaos4/amigaio.h"
+#endif
+

 #undef PERL_EFF_ACCESS /* EFFective uid/gid ACCESS */
 
 /* F_OK unused: if stat() cannot find it... */
 #undef PERL_EFF_ACCESS /* EFFective uid/gid ACCESS */
 
 /* F_OK unused: if stat() cannot find it... */


@@ -295,10 +294,10 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 
 PP(pp_backtick)
 {
 
 PP(pp_backtick)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     PerlIO *fp;
     const char * const tmps = POPpconstx;
     PerlIO *fp;
     const char * const tmps = POPpconstx;

-    const I32 gimme = GIMME_V;
+    const U8 gimme = GIMME_V;

     const char *mode = "r";
 
     TAINT_PROPER("``");
     const char *mode = "r";
 
     TAINT_PROPER("``");


@@ -356,26 +355,26 @@ PP(pp_backtick)
 
 PP(pp_glob)
 {
 
 PP(pp_glob)
 {

-    dVAR;

     OP *result;
     dSP;
     OP *result;
     dSP;

+    GV * const gv = (PL_op->op_flags & OPf_SPECIAL) ? NULL : (GV *)POPs;
+
+    PUTBACK;
+

     /* make a copy of the pattern if it is gmagical, to ensure that magic
      * is called once and only once */
     /* make a copy of the pattern if it is gmagical, to ensure that magic
      * is called once and only once */

-    if (SvGMAGICAL(TOPm1s)) TOPm1s = sv_2mortal(newSVsv(TOPm1s));
+    if (SvGMAGICAL(TOPs)) TOPs = sv_2mortal(newSVsv(TOPs));

 
 

-    tryAMAGICunTARGET(iter_amg, -1, (PL_op->op_flags & OPf_SPECIAL));
+    tryAMAGICunTARGETlist(iter_amg, (PL_op->op_flags & OPf_SPECIAL));

 
     if (PL_op->op_flags & OPf_SPECIAL) {
        /* call Perl-level glob function instead. Stack args are:
 
     if (PL_op->op_flags & OPf_SPECIAL) {
        /* call Perl-level glob function instead. Stack args are:

-        * MARK, wildcard, csh_glob context index
+        * MARK, wildcard

         * and following OPs should be: gv(CORE::GLOBAL::glob), entersub
         * */
        return NORMAL;
     }
         * and following OPs should be: gv(CORE::GLOBAL::glob), entersub
         * */
        return NORMAL;
     }

-    /* stack args are: wildcard, gv(_GEN_n) */
-

     if (PL_globhook) {
     if (PL_globhook) {

-       SETs(GvSV(TOPs));

        PL_globhook(aTHX);
        return NORMAL;
     }
        PL_globhook(aTHX);
        return NORMAL;
     }


@@ -387,7 +386,7 @@ PP(pp_glob)
     ENTER_with_name("glob");
 
 #ifndef VMS
     ENTER_with_name("glob");
 
 #ifndef VMS

-    if (PL_tainting) {
+    if (TAINTING_get) {

        /*
         * The external globbing program may use things we can't control,
         * so for security reasons we must assume the worst.
        /*
         * The external globbing program may use things we can't control,
         * so for security reasons we must assume the worst.


@@ -398,7 +397,7 @@ PP(pp_glob)
 #endif /* !VMS */
 
     SAVESPTR(PL_last_in_gv);   /* We don't want this to be permanent. */
 #endif /* !VMS */
 
     SAVESPTR(PL_last_in_gv);   /* We don't want this to be permanent. */

-    PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--);
+    PL_last_in_gv = gv;

 
     SAVESPTR(PL_rs);           /* This is not permanent, either. */
     PL_rs = newSVpvs_flags("\000", SVs_TEMP);
 
     SAVESPTR(PL_rs);           /* This is not permanent, either. */
     PL_rs = newSVpvs_flags("\000", SVs_TEMP);


@@ -415,14 +414,13 @@ PP(pp_glob)
 
 PP(pp_rcatline)
 {
 
 PP(pp_rcatline)
 {

-    dVAR;

     PL_last_in_gv = cGVOP_gv;
     return do_readline();
 }
 
 PP(pp_warn)
 {
     PL_last_in_gv = cGVOP_gv;
     return do_readline();
 }
 
 PP(pp_warn)
 {

-    dVAR; dSP; dMARK;
+    dSP; dMARK;

     SV *exsv;
     STRLEN len;
     if (SP - MARK > 1) {
     SV *exsv;
     STRLEN len;
     if (SP - MARK > 1) {


@@ -438,20 +436,30 @@ PP(pp_warn)
     }
     else {
        exsv = TOPs;
     }
     else {
        exsv = TOPs;

+       if (SvGMAGICAL(exsv)) exsv = sv_mortalcopy(exsv);

     }
 
     if (SvROK(exsv) || (SvPV_const(exsv, len), len)) {
        /* well-formed exception supplied */
     }
     }
 
     if (SvROK(exsv) || (SvPV_const(exsv, len), len)) {
        /* well-formed exception supplied */
     }

-    else if (SvROK(ERRSV)) {
-       exsv = ERRSV;
-    }
-    else if (SvPOK(ERRSV) && SvCUR(ERRSV)) {
-       exsv = sv_mortalcopy(ERRSV);
-       sv_catpvs(exsv, "\t...caught");
-    }

     else {
     else {

+      SV * const errsv = ERRSV;
+      SvGETMAGIC(errsv);
+      if (SvROK(errsv)) {
+       if (SvGMAGICAL(errsv)) {
+           exsv = sv_newmortal();
+           sv_setsv_nomg(exsv, errsv);
+       }
+       else exsv = errsv;
+      }
+      else if (SvPOKp(errsv) ? SvCUR(errsv) : SvNIOKp(errsv)) {
+       exsv = sv_newmortal();
+       sv_setsv_nomg(exsv, errsv);
+       sv_catpvs(exsv, "\t...caught");
+      }
+      else {

        exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
        exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);

+      }

     }
     if (SvROK(exsv) && !PL_warnhook)
         Perl_warn(aTHX_ "%"SVf, SVfARG(exsv));
     }
     if (SvROK(exsv) && !PL_warnhook)
         Perl_warn(aTHX_ "%"SVf, SVfARG(exsv));


@@ -461,11 +469,12 @@ PP(pp_warn)
 
 PP(pp_die)
 {
 
 PP(pp_die)
 {

-    dVAR; dSP; dMARK;
+    dSP; dMARK;

     SV *exsv;
     STRLEN len;
 #ifdef VMS
     SV *exsv;
     STRLEN len;
 #ifdef VMS

-    VMSISH_HUSHED  = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
+    VMSISH_HUSHED  =
+       VMSISH_HUSHED || (PL_curcop->op_private & OPpHUSH_VMSISH);

 #endif
     if (SP - MARK != 1) {
        dTARGET;
 #endif
     if (SP - MARK != 1) {
        dTARGET;


@@ -480,55 +489,75 @@ PP(pp_die)
     if (SvROK(exsv) || (SvPV_const(exsv, len), len)) {
        /* well-formed exception supplied */
     }
     if (SvROK(exsv) || (SvPV_const(exsv, len), len)) {
        /* well-formed exception supplied */
     }

-    else if (SvROK(ERRSV)) {
-       exsv = ERRSV;
-       if (sv_isobject(exsv)) {
-           HV * const stash = SvSTASH(SvRV(exsv));
-           GV * const gv = gv_fetchmethod(stash, "PROPAGATE");
-           if (gv) {
-               SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
-               SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
-               EXTEND(SP, 3);
-               PUSHMARK(SP);
-               PUSHs(exsv);
-               PUSHs(file);
-               PUSHs(line);
-               PUTBACK;
-               call_sv(MUTABLE_SV(GvCV(gv)),
-                       G_SCALAR|G_EVAL|G_KEEPERR);
-               exsv = sv_mortalcopy(*PL_stack_sp--);
+    else {
+       SV * const errsv = ERRSV;
+       SvGETMAGIC(errsv);
+       if (SvROK(errsv)) {
+           exsv = errsv;
+           if (sv_isobject(exsv)) {
+               HV * const stash = SvSTASH(SvRV(exsv));
+               GV * const gv = gv_fetchmethod(stash, "PROPAGATE");
+               if (gv) {
+                   SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
+                   SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
+                   EXTEND(SP, 3);
+                   PUSHMARK(SP);
+                   PUSHs(exsv);
+                   PUSHs(file);
+                   PUSHs(line);
+                   PUTBACK;
+                   call_sv(MUTABLE_SV(GvCV(gv)),
+                           G_SCALAR|G_EVAL|G_KEEPERR);
+                   exsv = sv_mortalcopy(*PL_stack_sp--);
+               }

            }
        }
            }
        }

+       else if (SvPOK(errsv) && SvCUR(errsv)) {
+           exsv = sv_mortalcopy(errsv);
+           sv_catpvs(exsv, "\t...propagated");
+       }
+       else {
+           exsv = newSVpvs_flags("Died", SVs_TEMP);
+       }

     }
     }

-    else if (SvPOK(ERRSV) && SvCUR(ERRSV)) {
-       exsv = sv_mortalcopy(ERRSV);
-       sv_catpvs(exsv, "\t...propagated");
-    }
-    else {
-       exsv = newSVpvs_flags("Died", SVs_TEMP);
-    }
-    return die_sv(exsv);
+    die_sv(exsv);
+    NOT_REACHED; /* NOTREACHED */
+    return NULL; /* avoid missing return from non-void function warning */

 }
 
 /* I/O. */
 
 OP *
 }
 
 /* I/O. */
 
 OP *

-Perl_tied_method(pTHX_ const char *const methname, SV **sp, SV *const sv,
+Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv,

                 const MAGIC *const mg, const U32 flags, U32 argc, ...)
 {
     SV **orig_sp = sp;
     I32 ret_args;
                 const MAGIC *const mg, const U32 flags, U32 argc, ...)
 {
     SV **orig_sp = sp;
     I32 ret_args;

+    SSize_t extend_size;

 
     PERL_ARGS_ASSERT_TIED_METHOD;
 
     /* Ensure that our flag bits do not overlap.  */
 
     PERL_ARGS_ASSERT_TIED_METHOD;
 
     /* Ensure that our flag bits do not overlap.  */

-    assert((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0);
-    assert((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0);
-    assert((TIED_METHOD_SAY & G_WANT) == 0);
+    STATIC_ASSERT_STMT((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0);
+    STATIC_ASSERT_STMT((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0);
+    STATIC_ASSERT_STMT((TIED_METHOD_SAY & G_WANT) == 0);

 
     PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */
     PUSHSTACKi(PERLSI_MAGIC);
 
     PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */
     PUSHSTACKi(PERLSI_MAGIC);

-    EXTEND(SP, argc+1); /* object + args */
+    /* extend for object + args. If argc might wrap/truncate when cast
+     * to SSize_t and incremented, set to -1, which will trigger a panic in
+     * EXTEND().
+     * The weird way this is written is because g++ is dumb enough to
+     * warn "comparison is always false" on something like:
+     *
+     * sizeof(a) >= sizeof(b) && a >= B_t_MAX -1
+     *
+     * (where the LH condition is false)
+     */
+    extend_size =
+        (argc > (sizeof(argc) >= sizeof(SSize_t) ? SSize_t_MAX - 1 : argc))
+            ? -1 : (SSize_t)argc + 1;
+    EXTEND(SP, extend_size);

     PUSHMARK(sp);
     PUSHs(SvTIED_obj(sv, mg));
     if (flags & TIED_METHOD_ARGUMENTS_ON_STACK) {
     PUSHMARK(sp);
     PUSHs(SvTIED_obj(sv, mg));
     if (flags & TIED_METHOD_ARGUMENTS_ON_STACK) {


@@ -557,7 +586,7 @@ Perl_tied_method(pTHX_ const char *const methname, SV **sp, SV *const sv,
        SAVEGENERICSV(PL_ors_sv);
        PL_ors_sv = newSVpvs("\n");
     }
        SAVEGENERICSV(PL_ors_sv);
        PL_ors_sv = newSVpvs("\n");
     }

-    ret_args = call_method(methname, flags & G_WANT);
+    ret_args = call_sv(methname, (flags & G_WANT)|G_METHOD_NAMED);

     SPAGAIN;
     orig_sp = sp;
     POPSTACK;
     SPAGAIN;
     orig_sp = sp;
     POPSTACK;


@@ -581,7 +610,7 @@ Perl_tied_method(pTHX_ const char *const methname, SV **sp, SV *const sv,
 
 PP(pp_open)
 {
 
 PP(pp_open)
 {

-    dVAR; dSP;
+    dSP;

     dMARK; dORIGMARK;
     dTARGET;
     SV *sv;
     dMARK; dORIGMARK;
     dTARGET;
     SV *sv;


@@ -608,7 +637,7 @@ PP(pp_open)
        if (mg) {
            /* Method's args are same as ours ... */
            /* ... except handle is replaced by the object */
        if (mg) {
            /* Method's args are same as ours ... */
            /* ... except handle is replaced by the object */

-           return Perl_tied_method(aTHX_ "OPEN", mark - 1, MUTABLE_SV(io), mg,
+           return Perl_tied_method(aTHX_ SV_CONST(OPEN), mark - 1, MUTABLE_SV(io), mg,

                                    G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
                                    sp - mark);
        }
                                    G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
                                    sp - mark);
        }


@@ -622,7 +651,7 @@ PP(pp_open)
     }
 
     tmps = SvPV_const(sv, len);
     }
 
     tmps = SvPV_const(sv, len);

-    ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, NULL, MARK+1, (SP-MARK));
+    ok = do_open6(gv, tmps, len, NULL, MARK+1, (SP-MARK));

     SP = ORIGMARK;
     if (ok)
        PUSHi( (I32)PL_forkprocess );
     SP = ORIGMARK;
     if (ok)
        PUSHi( (I32)PL_forkprocess );


@@ -635,7 +664,7 @@ PP(pp_open)
 
 PP(pp_close)
 {
 
 PP(pp_close)
 {

-    dVAR; dSP;
+    dSP;

     GV * const gv =
        MAXARG == 0 || (!TOPs && !POPs) ? PL_defoutgv : MUTABLE_GV(POPs);
 
     GV * const gv =
        MAXARG == 0 || (!TOPs && !POPs) ? PL_defoutgv : MUTABLE_GV(POPs);
 


@@ -647,7 +676,7 @@ PP(pp_close)
        if (io) {
            const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
            if (mg) {
        if (io) {
            const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
            if (mg) {

-               return tied_method0("CLOSE", SP, MUTABLE_SV(io), mg);
+               return tied_method0(SV_CONST(CLOSE), SP, MUTABLE_SV(io), mg);

            }
        }
     }
            }
        }
     }


@@ -658,25 +687,19 @@ PP(pp_close)
 PP(pp_pipe_op)
 {
 #ifdef HAS_PIPE
 PP(pp_pipe_op)
 {
 #ifdef HAS_PIPE

-    dVAR;

     dSP;
     dSP;

-    register IO *rstio;
-    register IO *wstio;
+    IO *rstio;
+    IO *wstio;

     int fd[2];
 
     GV * const wgv = MUTABLE_GV(POPs);
     GV * const rgv = MUTABLE_GV(POPs);
 
     int fd[2];
 
     GV * const wgv = MUTABLE_GV(POPs);
     GV * const rgv = MUTABLE_GV(POPs);
 

-    if (!rgv || !wgv)
-       goto badexit;
-
-    if (!isGV_with_GP(rgv) || !isGV_with_GP(wgv))
-       DIE(aTHX_ PL_no_usym, "filehandle");

     rstio = GvIOn(rgv);
     rstio = GvIOn(rgv);

-    wstio = GvIOn(wgv);
-

     if (IoIFP(rstio))
        do_close(rgv, FALSE);
     if (IoIFP(rstio))
        do_close(rgv, FALSE);

+
+    wstio = GvIOn(wgv);

     if (IoIFP(wstio))
        do_close(wgv, FALSE);
 
     if (IoIFP(wstio))
        do_close(wgv, FALSE);
 


@@ -701,13 +724,15 @@ PP(pp_pipe_op)
            PerlLIO_close(fd[1]);
        goto badexit;
     }
            PerlLIO_close(fd[1]);
        goto badexit;
     }

-#if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd);  /* ensure close-on-exec */
-    fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd);  /* ensure close-on-exec */
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+    /* ensure close-on-exec */
+    if ((fd[0] > PL_maxsysfd && fcntl(fd[0], F_SETFD, FD_CLOEXEC) < 0) ||
+        (fd[1] > PL_maxsysfd && fcntl(fd[1], F_SETFD, FD_CLOEXEC) < 0))
+        goto badexit;

 #endif
     RETPUSHYES;
 
 #endif
     RETPUSHYES;
 

-badexit:
+  badexit:

     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_func, "pipe");
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_func, "pipe");


@@ -716,7 +741,7 @@ badexit:
 
 PP(pp_fileno)
 {
 
 PP(pp_fileno)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     GV *gv;
     IO *io;
     PerlIO *fp;
     GV *gv;
     IO *io;
     PerlIO *fp;


@@ -730,7 +755,23 @@ PP(pp_fileno)
     if (io
        && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
     {
     if (io
        && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
     {

-       return tied_method0("FILENO", SP, MUTABLE_SV(io), mg);
+       return tied_method0(SV_CONST(FILENO), SP, MUTABLE_SV(io), mg);
+    }
+
+    if (io && IoDIRP(io)) {
+#if defined(HAS_DIRFD) || defined(HAS_DIR_DD_FD)
+        PUSHi(my_dirfd(IoDIRP(io)));
+        RETURN;
+#elif defined(ENOTSUP)
+        errno = ENOTSUP;        /* Operation not supported */
+        RETPUSHUNDEF;
+#elif defined(EOPNOTSUPP)
+        errno = EOPNOTSUPP;     /* Operation not supported on socket */
+        RETPUSHUNDEF;
+#else
+        errno = EINVAL;         /* Invalid argument */
+        RETPUSHUNDEF;
+#endif

     }
 
     if (!io || !(fp = IoIFP(io))) {
     }
 
     if (!io || !(fp = IoIFP(io))) {


@@ -748,7 +789,6 @@ PP(pp_fileno)
 
 PP(pp_umask)
 {
 
 PP(pp_umask)
 {

-    dVAR;

     dSP;
 #ifdef HAS_UMASK
     dTARGET;
     dSP;
 #ifdef HAS_UMASK
     dTARGET;


@@ -779,7 +819,7 @@ PP(pp_umask)
 
 PP(pp_binmode)
 {
 
 PP(pp_binmode)
 {

-    dVAR; dSP;
+    dSP;

     GV *gv;
     IO *io;
     PerlIO *fp;
     GV *gv;
     IO *io;
     PerlIO *fp;


@@ -801,7 +841,7 @@ PP(pp_binmode)
               function, which I don't think that the optimiser will be able to
               figure out. Although, as it's a static function, in theory it
               could.  */
               function, which I don't think that the optimiser will be able to
               figure out. Although, as it's a static function, in theory it
               could.  */

-           return Perl_tied_method(aTHX_ "BINMODE", SP, MUTABLE_SV(io), mg,
+           return Perl_tied_method(aTHX_ SV_CONST(BINMODE), SP, MUTABLE_SV(io), mg,

                                    G_SCALAR|TIED_METHOD_MORTALIZE_NOT_NEEDED,
                                    discp ? 1 : 0, discp);
        }
                                    G_SCALAR|TIED_METHOD_MORTALIZE_NOT_NEEDED,
                                    discp ? 1 : 0, discp);
        }


@@ -840,7 +880,7 @@ PP(pp_binmode)
 
 PP(pp_tie)
 {
 
 PP(pp_tie)
 {

-    dVAR; dSP; dMARK;
+    dSP; dMARK;

     HV* stash;
     GV *gv = NULL;
     SV *sv;
     HV* stash;
     GV *gv = NULL;
     SV *sv;


@@ -852,9 +892,16 @@ PP(pp_tie)
 
     switch(SvTYPE(varsv)) {
        case SVt_PVHV:
 
     switch(SvTYPE(varsv)) {
        case SVt_PVHV:

+       {
+           HE *entry;

            methname = "TIEHASH";
            methname = "TIEHASH";

+           if (HvLAZYDEL(varsv) && (entry = HvEITER((HV *)varsv))) {
+               HvLAZYDEL_off(varsv);
+               hv_free_ent((HV *)varsv, entry);
+           }

            HvEITER_set(MUTABLE_HV(varsv), 0);
            break;
            HvEITER_set(MUTABLE_HV(varsv), 0);
            break;

+       }

        case SVt_PVAV:
            methname = "TIEARRAY";
            if (!AvREAL(varsv)) {
        case SVt_PVAV:
            methname = "TIEARRAY";
            if (!AvREAL(varsv)) {


@@ -877,7 +924,11 @@ PP(pp_tie)
                varsv = MUTABLE_SV(GvIOp(varsv));
                break;
            }
                varsv = MUTABLE_SV(GvIOp(varsv));
                break;
            }

-           /* FALL THROUGH */
+           if (SvTYPE(varsv) == SVt_PVLV && LvTYPE(varsv) == 'y') {
+               vivify_defelem(varsv);
+               varsv = LvTARG(varsv);
+           }
+           /* FALLTHROUGH */

        default:
            methname = "TIESCALAR";
            how = PERL_MAGIC_tiedscalar;
        default:
            methname = "TIESCALAR";
            how = PERL_MAGIC_tiedscalar;


@@ -934,9 +985,12 @@ PP(pp_tie)
     RETURN;
 }
 
     RETURN;
 }
 

+
+/* also used for: pp_dbmclose() */
+

 PP(pp_untie)
 {
 PP(pp_untie)
 {

-    dVAR; dSP;
+    dSP;

     MAGIC *mg;
     SV *sv = POPs;
     const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
     MAGIC *mg;
     SV *sv = POPs;
     const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)


@@ -945,6 +999,9 @@ PP(pp_untie)
     if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
        RETPUSHYES;
 
     if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
        RETPUSHYES;
 

+    if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y' &&
+       !(sv = defelem_target(sv, NULL))) RETPUSHUNDEF;
+

     if ((mg = SvTIED_mg(sv, how))) {
        SV * const obj = SvRV(SvTIED_obj(sv, mg));
         if (obj) {
     if ((mg = SvTIED_mg(sv, how))) {
        SV * const obj = SvRV(SvTIED_obj(sv, mg));
         if (obj) {


@@ -973,26 +1030,30 @@ PP(pp_untie)
 
 PP(pp_tied)
 {
 
 PP(pp_tied)
 {

-    dVAR;

     dSP;
     const MAGIC *mg;
     dSP;
     const MAGIC *mg;

-    SV *sv = POPs;
+    dTOPss;

     const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
                ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
 
     if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
     const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
                ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
 
     if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))

-       RETPUSHUNDEF;
+       goto ret_undef;
+
+    if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y' &&
+       !(sv = defelem_target(sv, NULL))) goto ret_undef;

 
     if ((mg = SvTIED_mg(sv, how))) {
 
     if ((mg = SvTIED_mg(sv, how))) {

-       PUSHs(SvTIED_obj(sv, mg));
-       RETURN;
+       SETs(SvTIED_obj(sv, mg));
+       return NORMAL; /* PUTBACK not needed, pp_tied never moves SP */

     }
     }

-    RETPUSHUNDEF;
+    ret_undef:
+    SETs(&PL_sv_undef);
+    return NORMAL;

 }
 
 PP(pp_dbmopen)
 {
 }
 
 PP(pp_dbmopen)
 {

-    dVAR; dSP;
+    dSP;

     dPOPPOPssrl;
     HV* stash;
     GV *gv = NULL;
     dPOPPOPssrl;
     HV* stash;
     GV *gv = NULL;


@@ -1036,9 +1097,11 @@ PP(pp_dbmopen)
        PUTBACK;
        call_sv(MUTABLE_SV(GvCV(gv)), G_SCALAR);
        SPAGAIN;
        PUTBACK;
        call_sv(MUTABLE_SV(GvCV(gv)), G_SCALAR);
        SPAGAIN;

+        if (sv_isobject(TOPs))
+            goto retie;

     }
     }

-
-    if (sv_isobject(TOPs)) {
+    else {
+        retie:

        sv_unmagic(MUTABLE_SV(hv), PERL_MAGIC_tied);
        sv_magic(MUTABLE_SV(hv), TOPs, PERL_MAGIC_tied, NULL, 0);
     }
        sv_unmagic(MUTABLE_SV(hv), PERL_MAGIC_tied);
        sv_magic(MUTABLE_SV(hv), TOPs, PERL_MAGIC_tied, NULL, 0);
     }


@@ -1049,11 +1112,11 @@ PP(pp_dbmopen)
 PP(pp_sselect)
 {
 #ifdef HAS_SELECT
 PP(pp_sselect)
 {
 #ifdef HAS_SELECT

-    dVAR; dSP; dTARGET;
-    register I32 i;
-    register I32 j;
-    register char *s;
-    register SV *sv;
+    dSP; dTARGET;
+    I32 i;
+    I32 j;
+    char *s;
+    SV *sv;

     NV value;
     I32 maxlen = 0;
     I32 nfound;
     NV value;
     I32 maxlen = 0;
     I32 nfound;


@@ -1081,11 +1144,10 @@ PP(pp_sselect)
        if (!SvOK(sv))
            continue;
        if (SvREADONLY(sv)) {
        if (!SvOK(sv))
            continue;
        if (SvREADONLY(sv)) {

-           if (SvIsCOW(sv))
-               sv_force_normal_flags(sv, 0);
-           if (SvREADONLY(sv) && !(SvPOK(sv) && SvCUR(sv) == 0))
-               Perl_croak_no_modify(aTHX);
+           if (!(SvPOK(sv) && SvCUR(sv) == 0))
+               Perl_croak_no_modify();

        }
        }

+       else if (SvIsCOW(sv)) sv_force_normal_flags(sv, 0);

        if (!SvPOK(sv)) {
            if (!SvPOKp(sv))
                Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
        if (!SvPOK(sv)) {
            if (!SvPOKp(sv))
                Perl_ck_warner(aTHX_ packWARN(WARN_MISC),


@@ -1122,14 +1184,15 @@ PP(pp_sselect)
     /* If SELECT_MIN_BITS is greater than one we most probably will want
      * to align the sizes with SELECT_MIN_BITS/8 because for example
      * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
     /* If SELECT_MIN_BITS is greater than one we most probably will want
      * to align the sizes with SELECT_MIN_BITS/8 because for example
      * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital

-     * UNIX, Solaris, NeXT, Darwin) the smallest quantum select() operates
+     * UNIX, Solaris, Darwin) the smallest quantum select() operates

      * on (sets/tests/clears bits) is 32 bits.  */
     growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
 #  endif
 
     sv = SP[4];
      * on (sets/tests/clears bits) is 32 bits.  */
     growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
 #  endif
 
     sv = SP[4];

+    SvGETMAGIC(sv);

     if (SvOK(sv)) {
     if (SvOK(sv)) {

-       value = SvNV(sv);
+       value = SvNV_nomg(sv);

        if (value < 0.0)
            value = 0.0;
        timebuf.tv_sec = (long)value;
        if (value < 0.0)
            value = 0.0;
        timebuf.tv_sec = (long)value;


@@ -1201,7 +1264,7 @@ PP(pp_sselect)
     }
 
     PUSHi(nfound);
     }
 
     PUSHi(nfound);

-    if (GIMME == G_ARRAY && tbuf) {
+    if (GIMME_V == G_ARRAY && tbuf) {

        value = (NV)(timebuf.tv_sec) +
                (NV)(timebuf.tv_usec) / 1000000.0;
        mPUSHn(value);
        value = (NV)(timebuf.tv_sec) +
                (NV)(timebuf.tv_usec) / 1000000.0;
        mPUSHn(value);


@@ -1213,12 +1276,15 @@ PP(pp_sselect)
 }
 
 /*
 }
 
 /*

+
+=head1 GV Functions
+

 =for apidoc setdefout
 
 =for apidoc setdefout
 

-Sets PL_defoutgv, the default file handle for output, to the passed in
-typeglob. As PL_defoutgv "owns" a reference on its typeglob, the reference
+Sets C<PL_defoutgv>, the default file handle for output, to the passed in
+typeglob.  As C<PL_defoutgv> "owns" a reference on its typeglob, the reference

 count of the passed in typeglob is increased by one, and the reference count
 count of the passed in typeglob is increased by one, and the reference count

-of the typeglob that PL_defoutgv points to is decreased by one.
+of the typeglob that C<PL_defoutgv> points to is decreased by one.

 
 =cut
 */
 
 =cut
 */


@@ -1226,15 +1292,18 @@ of the typeglob that PL_defoutgv points to is decreased by one.
 void
 Perl_setdefout(pTHX_ GV *gv)
 {
 void
 Perl_setdefout(pTHX_ GV *gv)
 {

-    dVAR;
-    SvREFCNT_inc_simple_void(gv);
-    SvREFCNT_dec(PL_defoutgv);
+    GV *oldgv = PL_defoutgv;
+
+    PERL_ARGS_ASSERT_SETDEFOUT;
+
+    SvREFCNT_inc_simple_void_NN(gv);

     PL_defoutgv = gv;
     PL_defoutgv = gv;

+    SvREFCNT_dec(oldgv);

 }
 
 PP(pp_select)
 {
 }
 
 PP(pp_select)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     HV *hv;
     GV * const newdefout = (PL_op->op_private > 0) ? (MUTABLE_GV(POPs)) : NULL;
     GV * egv = GvEGVx(PL_defoutgv);
     HV *hv;
     GV * const newdefout = (PL_op->op_private > 0) ? (MUTABLE_GV(POPs)) : NULL;
     GV * egv = GvEGVx(PL_defoutgv);


@@ -1265,7 +1334,7 @@ PP(pp_select)
 
 PP(pp_getc)
 {
 
 PP(pp_getc)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     GV * const gv =
        MAXARG==0 || (!TOPs && !POPs) ? PL_stdingv : MUTABLE_GV(POPs);
     IO *const io = GvIO(gv);
     GV * const gv =
        MAXARG==0 || (!TOPs && !POPs) ? PL_stdingv : MUTABLE_GV(POPs);
     IO *const io = GvIO(gv);


@@ -1276,8 +1345,8 @@ PP(pp_getc)
     if (io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
     if (io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {

-           const U32 gimme = GIMME_V;
-           Perl_tied_method(aTHX_ "GETC", SP, MUTABLE_SV(io), mg, gimme, 0);
+           const U8 gimme = GIMME_V;
+           Perl_tied_method(aTHX_ SV_CONST(GETC), SP, MUTABLE_SV(io), mg, gimme, 0);

            if (gimme == G_SCALAR) {
                SPAGAIN;
                SvSetMagicSV_nosteal(TARG, TOPs);
            if (gimme == G_SCALAR) {
                SPAGAIN;
                SvSetMagicSV_nosteal(TARG, TOPs);


@@ -1304,6 +1373,7 @@ PP(pp_getc)
        }
        SvUTF8_on(TARG);
     }
        }
        SvUTF8_on(TARG);
     }

+    else SvUTF8_off(TARG);

     PUSHTARG;
     RETURN;
 }
     PUSHTARG;
     RETURN;
 }


@@ -1311,22 +1381,19 @@ PP(pp_getc)
 STATIC OP *
 S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 {
 STATIC OP *
 S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 {

-    dVAR;
-    register PERL_CONTEXT *cx;
-    const I32 gimme = GIMME_V;
+    PERL_CONTEXT *cx;
+    const U8 gimme = GIMME_V;

 
     PERL_ARGS_ASSERT_DOFORM;
 
 
     PERL_ARGS_ASSERT_DOFORM;
 

-    if (cv && CvCLONE(cv))
+    if (CvCLONE(cv))

        cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
 
        cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
 

-    ENTER;
-    SAVETMPS;
-
-    PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
-    PUSHFORMAT(cx, retop);
-    SAVECOMPPAD();
-    PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
+    cx = cx_pushblock(CXt_FORMAT, gimme, PL_stack_sp, PL_savestack_ix);
+    cx_pushformat(cx, cv, retop, gv);
+    if (CvDEPTH(cv) >= 2)
+       pad_push(CvPADLIST(cv), CvDEPTH(cv));
+    PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));

 
     setdefout(gv);         /* locally select filehandle so $% et al work */
     return CvSTART(cv);
 
     setdefout(gv);         /* locally select filehandle so $% et al work */
     return CvSTART(cv);


@@ -1334,17 +1401,16 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 
 PP(pp_enterwrite)
 {
 
 PP(pp_enterwrite)
 {

-    dVAR;

     dSP;
     dSP;

-    register GV *gv;
-    register IO *io;
+    GV *gv;
+    IO *io;

     GV *fgv;
     CV *cv = NULL;
     SV *tmpsv = NULL;
 
     if (MAXARG == 0) {
     GV *fgv;
     CV *cv = NULL;
     SV *tmpsv = NULL;
 
     if (MAXARG == 0) {

-       gv = PL_defoutgv;

        EXTEND(SP, 1);
        EXTEND(SP, 1);

+       gv = PL_defoutgv;

     }
     else {
        gv = MUTABLE_GV(POPs);
     }
     else {
        gv = MUTABLE_GV(POPs);


@@ -1360,36 +1426,30 @@ PP(pp_enterwrite)
     else
        fgv = gv;
 
     else
        fgv = gv;
 

-    if (!fgv)
-       goto not_a_format_reference;
+    assert(fgv);

 
     cv = GvFORM(fgv);
     if (!cv) {
        tmpsv = sv_newmortal();
        gv_efullname4(tmpsv, fgv, NULL, FALSE);
 
     cv = GvFORM(fgv);
     if (!cv) {
        tmpsv = sv_newmortal();
        gv_efullname4(tmpsv, fgv, NULL, FALSE);

-       if (SvPOK(tmpsv) && *SvPV_nolen_const(tmpsv))
-           DIE(aTHX_ "Undefined format \"%"SVf"\" called", SVfARG(tmpsv));
-
-       not_a_format_reference:
-       DIE(aTHX_ "Not a format reference");
+       DIE(aTHX_ "Undefined format \"%"SVf"\" called", SVfARG(tmpsv));

     }
     IoFLAGS(io) &= ~IOf_DIDTOP;
     }
     IoFLAGS(io) &= ~IOf_DIDTOP;

-    return doform(cv,gv,PL_op->op_next);
+    RETURNOP(doform(cv,gv,PL_op->op_next));

 }
 
 PP(pp_leavewrite)
 {
 }
 
 PP(pp_leavewrite)
 {

-    dVAR; dSP;
-    GV * const gv = cxstack[cxstack_ix].blk_format.gv;
-    register IO * const io = GvIOp(gv);
+    dSP;
+    GV * const gv = CX_CUR()->blk_format.gv;
+    IO * const io = GvIOp(gv);

     PerlIO *ofp;
     PerlIO *fp;
     PerlIO *ofp;
     PerlIO *fp;

-    SV **newsp;
-    I32 gimme;
-    register PERL_CONTEXT *cx;
+    PERL_CONTEXT *cx;

     OP *retop;
     OP *retop;

+    bool is_return = cBOOL(PL_op->op_type == OP_RETURN);

 
 

-    if (!io || !(ofp = IoOFP(io)))
+    if (is_return || !io || !(ofp = IoOFP(io)))

         goto forget_top;
 
     DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n",
         goto forget_top;
 
     DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n",


@@ -1444,35 +1504,40 @@ PP(pp_leavewrite)
            }
        }
        if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
            }
        }
        if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)

-           do_print(PL_formfeed, ofp);
+           do_print(GvSV(gv_fetchpvs("\f", GV_ADD, SVt_PV)), ofp);

        IoLINES_LEFT(io) = IoPAGE_LEN(io);
        IoPAGE(io)++;
        PL_formtarget = PL_toptarget;
        IoFLAGS(io) |= IOf_DIDTOP;
        fgv = IoTOP_GV(io);
        IoLINES_LEFT(io) = IoPAGE_LEN(io);
        IoPAGE(io)++;
        PL_formtarget = PL_toptarget;
        IoFLAGS(io) |= IOf_DIDTOP;
        fgv = IoTOP_GV(io);

-       if (!fgv)
-           DIE(aTHX_ "bad top format reference");
+       assert(fgv); /* IoTOP_GV(io) should have been set above */

        cv = GvFORM(fgv);
        if (!cv) {
            SV * const sv = sv_newmortal();
            gv_efullname4(sv, fgv, NULL, FALSE);
        cv = GvFORM(fgv);
        if (!cv) {
            SV * const sv = sv_newmortal();
            gv_efullname4(sv, fgv, NULL, FALSE);

-           if (SvPOK(sv) && *SvPV_nolen_const(sv))
-               DIE(aTHX_ "Undefined top format \"%"SVf"\" called", SVfARG(sv));
-           else
-               DIE(aTHX_ "Undefined top format called");
+           DIE(aTHX_ "Undefined top format \"%"SVf"\" called", SVfARG(sv));

        }
        return doform(cv, gv, PL_op);
     }
 
   forget_top:
        }
        return doform(cv, gv, PL_op);
     }
 
   forget_top:

-    POPBLOCK(cx,PL_curpm);
-    POPFORMAT(cx);
+    cx = CX_CUR();
+    assert(CxTYPE(cx) == CXt_FORMAT);
+    SP = PL_stack_base + cx->blk_oldsp; /* ignore retval of formline */
+    CX_LEAVE_SCOPE(cx);
+    cx_popformat(cx);
+    cx_popblock(cx);

     retop = cx->blk_sub.retop;
     retop = cx->blk_sub.retop;

-    LEAVE;
+    CX_POP(cx);

 
 

-    fp = IoOFP(io);
-    if (!fp) {
-       if (IoIFP(io))
+    if (is_return)
+        /* XXX the semantics of doing 'return' in a format aren't documented.
+         * Currently we ignore any args to 'return' and just return
+         * a single undef in both scalar and list contexts
+         */
+       PUSHs(&PL_sv_undef);
+    else if (!io || !(fp = IoOFP(io))) {
+       if (io && IoIFP(io))

            report_wrongway_fh(gv, '<');
        else
            report_evil_fh(gv);
            report_wrongway_fh(gv, '<');
        else
            report_evil_fh(gv);


@@ -1493,24 +1558,22 @@ PP(pp_leavewrite)
            PUSHs(&PL_sv_yes);
        }
     }
            PUSHs(&PL_sv_yes);
        }
     }

-    /* bad_ofp: */

     PL_formtarget = PL_bodytarget;
     PL_formtarget = PL_bodytarget;

-    PUTBACK;
-    PERL_UNUSED_VAR(newsp);
-    PERL_UNUSED_VAR(gimme);
-    return retop;
+    RETURNOP(retop);

 }
 
 PP(pp_prtf)
 {
 }
 
 PP(pp_prtf)
 {

-    dVAR; dSP; dMARK; dORIGMARK;
+    dSP; dMARK; dORIGMARK;

     PerlIO *fp;
     PerlIO *fp;

-    SV *sv;

 
     GV * const gv
        = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
     IO *const io = GvIO(gv);
 
 
     GV * const gv
        = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
     IO *const io = GvIO(gv);
 

+    /* Treat empty list as "" */
+    if (MARK == SP) XPUSHs(&PL_sv_no);
+

     if (io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
     if (io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {


@@ -1520,14 +1583,13 @@ PP(pp_prtf)
                Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
                ++SP;
            }
                Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
                ++SP;
            }

-           return Perl_tied_method(aTHX_ "PRINTF", mark - 1, MUTABLE_SV(io),
+           return Perl_tied_method(aTHX_ SV_CONST(PRINTF), mark - 1, MUTABLE_SV(io),

                                    mg,
                                    G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
                                    sp - mark);
        }
     }
 
                                    mg,
                                    G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
                                    sp - mark);
        }
     }
 

-    sv = newSV(0);

     if (!io) {
        report_evil_fh(gv);
        SETERRNO(EBADF,RMS_IFI);
     if (!io) {
        report_evil_fh(gv);
        SETERRNO(EBADF,RMS_IFI);


@@ -1542,6 +1604,7 @@ PP(pp_prtf)
        goto just_say_no;
     }
     else {
        goto just_say_no;
     }
     else {

+       SV *sv = sv_newmortal();

        do_sprintf(sv, SP - MARK, MARK + 1);
        if (!do_print(sv, fp))
            goto just_say_no;
        do_sprintf(sv, SP - MARK, MARK + 1);
        if (!do_print(sv, fp))
            goto just_say_no;


@@ -1550,13 +1613,11 @@ PP(pp_prtf)
            if (PerlIO_flush(fp) == EOF)
                goto just_say_no;
     }
            if (PerlIO_flush(fp) == EOF)
                goto just_say_no;
     }

-    SvREFCNT_dec(sv);

     SP = ORIGMARK;
     PUSHs(&PL_sv_yes);
     RETURN;
 
   just_say_no:
     SP = ORIGMARK;
     PUSHs(&PL_sv_yes);
     RETURN;
 
   just_say_no:

-    SvREFCNT_dec(sv);

     SP = ORIGMARK;
     PUSHs(&PL_sv_undef);
     RETURN;
     SP = ORIGMARK;
     PUSHs(&PL_sv_undef);
     RETURN;


@@ -1564,7 +1625,6 @@ PP(pp_prtf)
 
 PP(pp_sysopen)
 {
 
 PP(pp_sysopen)
 {

-    dVAR;

     dSP;
     const int perm = (MAXARG > 3 && (TOPs || POPs)) ? POPi : 0666;
     const int mode = POPi;
     dSP;
     const int perm = (MAXARG > 3 && (TOPs || POPs)) ? POPi : 0666;
     const int mode = POPi;


@@ -1574,8 +1634,7 @@ PP(pp_sysopen)
 
     /* Need TIEHANDLE method ? */
     const char * const tmps = SvPV_const(sv, len);
 
     /* Need TIEHANDLE method ? */
     const char * const tmps = SvPV_const(sv, len);

-    /* FIXME? do_open should do const  */
-    if (do_open(gv, tmps, len, TRUE, mode, perm, NULL)) {
+    if (do_open_raw(gv, tmps, len, mode, perm)) {

        IoLINES(GvIOp(gv)) = 0;
        PUSHs(&PL_sv_yes);
     }
        IoLINES(GvIOp(gv)) = 0;
        PUSHs(&PL_sv_yes);
     }


@@ -1585,9 +1644,12 @@ PP(pp_sysopen)
     RETURN;
 }
 
     RETURN;
 }
 

+
+/* also used for: pp_read() and pp_recv() (where supported) */
+

 PP(pp_sysread)
 {
 PP(pp_sysread)
 {

-    dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+    dSP; dMARK; dORIGMARK; dTARGET;

     SSize_t offset;
     IO *io;
     char *buffer;
     SSize_t offset;
     IO *io;
     char *buffer;


@@ -1604,14 +1666,15 @@ PP(pp_sysread)
     bool charstart = FALSE;
     STRLEN charskip = 0;
     STRLEN skip = 0;
     bool charstart = FALSE;
     STRLEN charskip = 0;
     STRLEN skip = 0;

-

     GV * const gv = MUTABLE_GV(*++MARK);
     GV * const gv = MUTABLE_GV(*++MARK);

+    int fd;
+

     if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
        && gv && (io = GvIO(gv)) )
     {
        const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
     if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
        && gv && (io = GvIO(gv)) )
     {
        const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {

-           return Perl_tied_method(aTHX_ "READ", mark - 1, MUTABLE_SV(io), mg,
+           return Perl_tied_method(aTHX_ SV_CONST(READ), mark - 1, MUTABLE_SV(io), mg,

                                    G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
                                    sp - mark);
        }
                                    G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
                                    sp - mark);
        }


@@ -1623,6 +1686,8 @@ PP(pp_sysread)
     if (! SvOK(bufsv))
        sv_setpvs(bufsv, "");
     length = SvIVx(*++MARK);
     if (! SvOK(bufsv))
        sv_setpvs(bufsv, "");
     length = SvIVx(*++MARK);

+    if (length < 0)
+       DIE(aTHX_ "Negative length");

     SETERRNO(0,0);
     if (MARK < SP)
        offset = SvIVx(*++MARK);
     SETERRNO(0,0);
     if (MARK < SP)
        offset = SvIVx(*++MARK);


@@ -1634,7 +1699,16 @@ PP(pp_sysread)
        SETERRNO(EBADF,RMS_IFI);
        goto say_undef;
     }
        SETERRNO(EBADF,RMS_IFI);
        goto say_undef;
     }

+
+    /* Note that fd can here validly be -1, don't check it yet. */
+    fd = PerlIO_fileno(IoIFP(io));
+

     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {

+        if (PL_op->op_type == OP_SYSREAD || PL_op->op_type == OP_RECV) {
+            Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                           "%s() is deprecated on :utf8 handles",
+                           OP_DESC(PL_op));
+        }

        buffer = SvPVutf8_force(bufsv, blen);
        /* UTF-8 may not have been set if they are all low bytes */
        SvUTF8_on(bufsv);
        buffer = SvPVutf8_force(bufsv, blen);
        /* UTF-8 may not have been set if they are all low bytes */
        SvUTF8_on(bufsv);


@@ -1644,19 +1718,24 @@ PP(pp_sysread)
        buffer = SvPV_force(bufsv, blen);
        buffer_utf8 = !IN_BYTES && SvUTF8(bufsv);
     }
        buffer = SvPV_force(bufsv, blen);
        buffer_utf8 = !IN_BYTES && SvUTF8(bufsv);
     }

-    if (length < 0)
-       DIE(aTHX_ "Negative length");
-    wanted = length;
+    if (DO_UTF8(bufsv)) {
+       blen = sv_len_utf8_nomg(bufsv);
+    }

 
     charstart = TRUE;
     charskip  = 0;
     skip = 0;
 
     charstart = TRUE;
     charskip  = 0;
     skip = 0;

+    wanted = length;

 
 #ifdef HAS_SOCKET
     if (PL_op->op_type == OP_RECV) {
        Sock_size_t bufsize;
        char namebuf[MAXPATHLEN];
 
 #ifdef HAS_SOCKET
     if (PL_op->op_type == OP_RECV) {
        Sock_size_t bufsize;
        char namebuf[MAXPATHLEN];

-#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE) || defined(__QNXNTO__)
+        if (fd < 0) {
+            SETERRNO(EBADF,SS_IVCHAN);
+            RETPUSHUNDEF;
+        }
+#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)

        bufsize = sizeof (struct sockaddr_in);
 #else
        bufsize = sizeof namebuf;
        bufsize = sizeof (struct sockaddr_in);
 #else
        bufsize = sizeof namebuf;


@@ -1667,17 +1746,13 @@ PP(pp_sysread)
 #endif
        buffer = SvGROW(bufsv, (STRLEN)(length+1));
        /* 'offset' means 'flags' here */
 #endif
        buffer = SvGROW(bufsv, (STRLEN)(length+1));
        /* 'offset' means 'flags' here */

-       count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
+       count = PerlSock_recvfrom(fd, buffer, length, offset,

                                  (struct sockaddr *)namebuf, &bufsize);
        if (count < 0)
            RETPUSHUNDEF;
        /* MSG_TRUNC can give oversized count; quietly lose it */
        if (count > length)
            count = length;
                                  (struct sockaddr *)namebuf, &bufsize);
        if (count < 0)
            RETPUSHUNDEF;
        /* MSG_TRUNC can give oversized count; quietly lose it */
        if (count > length)
            count = length;

-#ifdef EPOC
-        /* Bogus return without padding */
-       bufsize = sizeof (struct sockaddr_in);
-#endif

        SvCUR_set(bufsv, count);
        *SvEND(bufsv) = '\0';
        (void)SvPOK_only(bufsv);
        SvCUR_set(bufsv, count);
        *SvEND(bufsv) = '\0';
        (void)SvPOK_only(bufsv);


@@ -1688,15 +1763,19 @@ PP(pp_sysread)
        if (!(IoFLAGS(io) & IOf_UNTAINT))
            SvTAINTED_on(bufsv);
        SP = ORIGMARK;
        if (!(IoFLAGS(io) & IOf_UNTAINT))
            SvTAINTED_on(bufsv);
        SP = ORIGMARK;

+#if defined(__CYGWIN__)
+        /* recvfrom() on cygwin doesn't set bufsize at all for
+           connected sockets, leaving us with trash in the returned
+           name, so use the same test as the Win32 code to check if it
+           wasn't set, and set it [perl #118843] */
+        if (bufsize == sizeof namebuf)
+            bufsize = 0;
+#endif

        sv_setpvn(TARG, namebuf, bufsize);
        PUSHs(TARG);
        RETURN;
     }
 #endif
        sv_setpvn(TARG, namebuf, bufsize);
        PUSHs(TARG);
        RETURN;
     }
 #endif

-    if (DO_UTF8(bufsv)) {
-       /* offset adjust in characters not bytes */
-       blen = sv_len_utf8(bufsv);
-    }

     if (offset < 0) {
        if (-offset > (SSize_t)blen)
            DIE(aTHX_ "Offset outside string");
     if (offset < 0) {
        if (-offset > (SSize_t)blen)
            DIE(aTHX_ "Offset outside string");


@@ -1704,18 +1783,22 @@ PP(pp_sysread)
     }
     if (DO_UTF8(bufsv)) {
        /* convert offset-as-chars to offset-as-bytes */
     }
     if (DO_UTF8(bufsv)) {
        /* convert offset-as-chars to offset-as-bytes */

-       if (offset >= (int)blen)
+       if (offset >= (SSize_t)blen)

            offset += SvCUR(bufsv) - blen;
        else
            offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
     }
            offset += SvCUR(bufsv) - blen;
        else
            offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
     }

+

  more_bytes:
  more_bytes:

+    /* Reestablish the fd in case it shifted from underneath us. */
+    fd = PerlIO_fileno(IoIFP(io));
+

     orig_size = SvCUR(bufsv);
     /* Allocating length + offset + 1 isn't perfect in the case of reading
        bytes from a byte file handle into a UTF8 buffer, but it won't harm us
        unduly.
        (should be 2 * length + offset + 1, or possibly something longer if
     orig_size = SvCUR(bufsv);
     /* Allocating length + offset + 1 isn't perfect in the case of reading
        bytes from a byte file handle into a UTF8 buffer, but it won't harm us
        unduly.
        (should be 2 * length + offset + 1, or possibly something longer if

-       PL_encoding is true) */
+       IN_ENCODING Is true) */

     buffer  = SvGROW(bufsv, (STRLEN)(length+offset+1));
     if (offset > 0 && offset > (SSize_t)orig_size) { /* Zero any newly allocated space */
        Zero(buffer+orig_size, offset-orig_size, char);
     buffer  = SvGROW(bufsv, (STRLEN)(length+offset+1));
     if (offset > 0 && offset > (SSize_t)orig_size) { /* Zero any newly allocated space */
        Zero(buffer+orig_size, offset-orig_size, char);


@@ -1739,31 +1822,25 @@ PP(pp_sysread)
     if (PL_op->op_type == OP_SYSREAD) {
 #ifdef PERL_SOCK_SYSREAD_IS_RECV
        if (IoTYPE(io) == IoTYPE_SOCKET) {
     if (PL_op->op_type == OP_SYSREAD) {
 #ifdef PERL_SOCK_SYSREAD_IS_RECV
        if (IoTYPE(io) == IoTYPE_SOCKET) {

-           count = PerlSock_recv(PerlIO_fileno(IoIFP(io)),
-                                  buffer, length, 0);
+            if (fd < 0) {
+                SETERRNO(EBADF,SS_IVCHAN);
+                count = -1;
+            }
+            else
+                count = PerlSock_recv(fd, buffer, length, 0);

        }
        else
 #endif
        {
        }
        else
 #endif
        {

-           count = PerlLIO_read(PerlIO_fileno(IoIFP(io)),
-                                 buffer, length);
+            if (fd < 0) {
+                SETERRNO(EBADF,RMS_IFI);
+                count = -1;
+            }
+            else
+                count = PerlLIO_read(fd, buffer, length);

        }
     }
     else
        }
     }
     else

-#ifdef HAS_SOCKET__bad_code_maybe
-    if (IoTYPE(io) == IoTYPE_SOCKET) {
-       Sock_size_t bufsize;
-       char namebuf[MAXPATHLEN];
-#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
-       bufsize = sizeof (struct sockaddr_in);
-#else
-       bufsize = sizeof namebuf;
-#endif
-       count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, 0,
-                         (struct sockaddr *)namebuf, &bufsize);
-    }
-    else
-#endif

     {
        count = PerlIO_read(IoIFP(io), buffer, length);
        /* PerlIO_read() - like fread() returns 0 on both error and EOF */
     {
        count = PerlIO_read(IoIFP(io), buffer, length);
        /* PerlIO_read() - like fread() returns 0 on both error and EOF */


@@ -1831,9 +1908,12 @@ PP(pp_sysread)
     RETPUSHUNDEF;
 }
 
     RETPUSHUNDEF;
 }
 

+
+/* also used for: pp_send() where defined */
+

 PP(pp_syswrite)
 {
 PP(pp_syswrite)
 {

-    dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+    dSP; dMARK; dORIGMARK; dTARGET;

     SV *bufsv;
     const char *buffer;
     SSize_t retval;
     SV *bufsv;
     const char *buffer;
     SSize_t retval;


@@ -1844,6 +1924,7 @@ PP(pp_syswrite)
     U8 *tmpbuf = NULL;
     GV *const gv = MUTABLE_GV(*++MARK);
     IO *const io = GvIO(gv);
     U8 *tmpbuf = NULL;
     GV *const gv = MUTABLE_GV(*++MARK);
     IO *const io = GvIO(gv);

+    int fd;

 
     if (op_type == OP_SYSWRITE && io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
 
     if (op_type == OP_SYSWRITE && io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);


@@ -1854,7 +1935,7 @@ PP(pp_syswrite)
                PUTBACK;
            }
 
                PUTBACK;
            }
 

-           return Perl_tied_method(aTHX_ "WRITE", mark - 1, MUTABLE_SV(io), mg,
+           return Perl_tied_method(aTHX_ SV_CONST(WRITE), mark - 1, MUTABLE_SV(io), mg,

                                    G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
                                    sp - mark);
        }
                                    G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
                                    sp - mark);
        }


@@ -1874,6 +1955,12 @@ PP(pp_syswrite)
        SETERRNO(EBADF,RMS_IFI);
        goto say_undef;
     }
        SETERRNO(EBADF,RMS_IFI);
        goto say_undef;
     }

+    fd = PerlIO_fileno(IoIFP(io));
+    if (fd < 0) {
+        SETERRNO(EBADF,SS_IVCHAN);
+        retval = -1;
+        goto say_undef;
+    }

 
     /* Do this first to trigger any overloading.  */
     buffer = SvPV_const(bufsv, blen);
 
     /* Do this first to trigger any overloading.  */
     buffer = SvPV_const(bufsv, blen);


@@ -1881,6 +1968,9 @@ PP(pp_syswrite)
     doing_utf8 = DO_UTF8(bufsv);
 
     if (PerlIO_isutf8(IoIFP(io))) {
     doing_utf8 = DO_UTF8(bufsv);
 
     if (PerlIO_isutf8(IoIFP(io))) {

+        Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                       "%s() is deprecated on :utf8 handles",
+                       OP_DESC(PL_op));

        if (!SvUTF8(bufsv)) {
            /* We don't modify the original scalar.  */
            tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
        if (!SvUTF8(bufsv)) {
            /* We don't modify the original scalar.  */
            tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);


@@ -1908,12 +1998,11 @@ PP(pp_syswrite)
        if (SP > MARK) {
            STRLEN mlen;
            char * const sockbuf = SvPVx(*++MARK, mlen);
        if (SP > MARK) {
            STRLEN mlen;
            char * const sockbuf = SvPVx(*++MARK, mlen);

-           retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
+           retval = PerlSock_sendto(fd, buffer, blen,

                                     flags, (struct sockaddr *)sockbuf, mlen);
        }
        else {
                                     flags, (struct sockaddr *)sockbuf, mlen);
        }
        else {

-           retval
-               = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags);
+           retval = PerlSock_send(fd, buffer, blen, flags);

        }
     }
     else
        }
     }
     else


@@ -1929,15 +2018,9 @@ PP(pp_syswrite)
                blen_chars = orig_blen_bytes;
            } else {
                /* The SV really is UTF-8.  */
                blen_chars = orig_blen_bytes;
            } else {
                /* The SV really is UTF-8.  */

-               if (SvGMAGICAL(bufsv) || SvAMAGIC(bufsv)) {
-                   /* Don't call sv_len_utf8 again because it will call magic
-                      or overloading a second time, and we might get back a
-                      different result.  */
-                   blen_chars = utf8_length((U8*)buffer, (U8*)buffer + blen);
-               } else {
-                   /* It's safe, and it may well be cached.  */
-                   blen_chars = sv_len_utf8(bufsv);
-               }
+               /* Don't call sv_len_utf8 on a magical or overloaded
+                  scalar, as we might get back a different result.  */
+               blen_chars = sv_or_pv_len_utf8(bufsv, buffer, blen);

            }
        } else {
            blen_chars = blen;
            }
        } else {
            blen_chars = blen;


@@ -2002,15 +2085,13 @@ PP(pp_syswrite)
        }
 #ifdef PERL_SOCK_SYSWRITE_IS_SEND
        if (IoTYPE(io) == IoTYPE_SOCKET) {
        }
 #ifdef PERL_SOCK_SYSWRITE_IS_SEND
        if (IoTYPE(io) == IoTYPE_SOCKET) {

-           retval = PerlSock_send(PerlIO_fileno(IoIFP(io)),
-                                  buffer, length, 0);
+           retval = PerlSock_send(fd, buffer, length, 0);

        }
        else
 #endif
        {
            /* See the note at doio.c:do_print about filesize limits. --jhi */
        }
        else
 #endif
        {
            /* See the note at doio.c:do_print about filesize limits. --jhi */

-           retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
-                                  buffer, length);
+            retval = PerlLIO_write(fd, buffer, length);

        }
     }
 
        }
     }
 


@@ -2036,7 +2117,7 @@ PP(pp_syswrite)
 
 PP(pp_eof)
 {
 
 PP(pp_eof)
 {

-    dVAR; dSP;
+    dSP;

     GV *gv;
     IO *io;
     const MAGIC *mg;
     GV *gv;
     IO *io;
     const MAGIC *mg;


@@ -2073,22 +2154,26 @@ PP(pp_eof)
        RETPUSHNO;
 
     if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
        RETPUSHNO;
 
     if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {

-       return tied_method1("EOF", SP, MUTABLE_SV(io), mg, newSVuv(which));
+       return tied_method1(SV_CONST(EOF), SP, MUTABLE_SV(io), mg, newSVuv(which));

     }
 
     if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) {  /* eof() */
        if (io && !IoIFP(io)) {
     }
 
     if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) {  /* eof() */
        if (io && !IoIFP(io)) {

-           if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
+           if ((IoFLAGS(io) & IOf_START) && av_tindex(GvAVn(gv)) < 0) {
+               SV ** svp;

                IoLINES(io) = 0;
                IoFLAGS(io) &= ~IOf_START;
                IoLINES(io) = 0;
                IoFLAGS(io) &= ~IOf_START;

-               do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
-               if (GvSV(gv))
-                   sv_setpvs(GvSV(gv), "-");
+               do_open6(gv, "-", 1, NULL, NULL, 0);
+               svp = &GvSV(gv);
+               if (*svp) {
+                   SV * sv = *svp;
+                   sv_setpvs(sv, "-");
+                   SvSETMAGIC(sv);
+               }

                else
                else

-                   GvSV(gv) = newSVpvs("-");
-               SvSETMAGIC(GvSV(gv));
+                   *svp = newSVpvs("-");

            }
            }

-           else if (!nextargv(gv))
+           else if (!nextargv(gv, FALSE))

                RETPUSHYES;
        }
     }
                RETPUSHYES;
        }
     }


@@ -2099,7 +2184,7 @@ PP(pp_eof)
 
 PP(pp_tell)
 {
 
 PP(pp_tell)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     GV *gv;
     IO *io;
 
     GV *gv;
     IO *io;
 


@@ -2113,7 +2198,7 @@ PP(pp_tell)
     if (io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
     if (io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {

-           return tied_method0("TELL", SP, MUTABLE_SV(io), mg);
+           return tied_method0(SV_CONST(TELL), SP, MUTABLE_SV(io), mg);

        }
     }
     else if (!gv) {
        }
     }
     else if (!gv) {


@@ -2131,9 +2216,12 @@ PP(pp_tell)
     RETURN;
 }
 
     RETURN;
 }
 

+
+/* also used for: pp_seek() */
+

 PP(pp_sysseek)
 {
 PP(pp_sysseek)
 {

-    dVAR; dSP;
+    dSP;

     const int whence = POPi;
 #if LSEEKSIZE > IVSIZE
     const Off_t offset = (Off_t)SvNVx(POPs);
     const int whence = POPi;
 #if LSEEKSIZE > IVSIZE
     const Off_t offset = (Off_t)SvNVx(POPs);


@@ -2153,7 +2241,7 @@ PP(pp_sysseek)
            SV *const offset_sv = newSViv(offset);
 #endif
 
            SV *const offset_sv = newSViv(offset);
 #endif
 

-           return tied_method2("SEEK", SP, MUTABLE_SV(io), mg, offset_sv,
+           return tied_method2(SV_CONST(SEEK), SP, MUTABLE_SV(io), mg, offset_sv,

                                newSViv(whence));
        }
     }
                                newSViv(whence));
        }
     }


@@ -2180,7 +2268,6 @@ PP(pp_sysseek)
 
 PP(pp_truncate)
 {
 
 PP(pp_truncate)
 {

-    dVAR;

     dSP;
     /* There seems to be no consensus on the length type of truncate()
      * and ftruncate(), both off_t and size_t have supporters. In
     dSP;
     /* There seems to be no consensus on the length type of truncate()
      * and ftruncate(), both off_t and size_t have supporters. In


@@ -2204,9 +2291,9 @@ PP(pp_truncate)
        GV *tmpgv;
        IO *io;
 
        GV *tmpgv;
        IO *io;
 

-       if ((tmpgv = PL_op->op_flags & OPf_SPECIAL
-                      ? gv_fetchsv(sv, 0, SVt_PVIO)
-                      : MAYBE_DEREF_GV(sv) )) {
+       if (PL_op->op_flags & OPf_SPECIAL
+                      ? (tmpgv = gv_fetchsv(sv, 0, SVt_PVIO), 1)
+                      : !!(tmpgv = MAYBE_DEREF_GV(sv)) ) {

            io = GvIO(tmpgv);
            if (!io)
                result = 0;
            io = GvIO(tmpgv);
            if (!io)
                result = 0;


@@ -2218,13 +2305,24 @@ PP(pp_truncate)
                    result = 0;
                }
                else {
                    result = 0;
                }
                else {

-                   PerlIO_flush(fp);
+                    int fd = PerlIO_fileno(fp);
+                    if (fd < 0) {
+                        SETERRNO(EBADF,RMS_IFI);
+                        result = 0;
+                    } else {
+                        if (len < 0) {
+                            SETERRNO(EINVAL, LIB_INVARG);
+                            result = 0;
+                        } else {
+                           PerlIO_flush(fp);

 #ifdef HAS_TRUNCATE
 #ifdef HAS_TRUNCATE

-                   if (ftruncate(PerlIO_fileno(fp), len) < 0)
+                           if (ftruncate(fd, len) < 0)

 #else
 #else

-                   if (my_chsize(PerlIO_fileno(fp), len) < 0)
+                           if (my_chsize(fd, len) < 0)

 #endif
 #endif

-                       result = 0;
+                               result = 0;
+                        }
+                    }

                }
            }
        }
                }
            }
        }


@@ -2240,11 +2338,24 @@ PP(pp_truncate)
                result = 0;
 #else
            {
                result = 0;
 #else
            {

-               const int tmpfd = PerlLIO_open(name, O_RDWR);
+                int mode = O_RDWR;
+                int tmpfd;
+
+#if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
+                mode |= O_LARGEFILE;   /* Transparently largefiley. */
+#endif
+#ifdef O_BINARY
+                /* On open(), the Win32 CRT tries to seek around text
+                 * files using 32-bit offsets, which causes the open()
+                 * to fail on large files, so open in binary mode.
+                 */
+                mode |= O_BINARY;
+#endif
+                tmpfd = PerlLIO_open(name, mode);

 
 

-               if (tmpfd < 0)
+               if (tmpfd < 0) {

                    result = 0;
                    result = 0;

-               else {
+               } else {

                    if (my_chsize(tmpfd, len) < 0)
                        result = 0;
                    PerlLIO_close(tmpfd);
                    if (my_chsize(tmpfd, len) < 0)
                        result = 0;
                    PerlLIO_close(tmpfd);


@@ -2261,18 +2372,21 @@ PP(pp_truncate)
     }
 }
 
     }
 }
 

+
+/* also used for: pp_fcntl() */
+

 PP(pp_ioctl)
 {
 PP(pp_ioctl)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     SV * const argsv = POPs;
     const unsigned int func = POPu;
     SV * const argsv = POPs;
     const unsigned int func = POPu;

-    const int optype = PL_op->op_type;
+    int optype;

     GV * const gv = MUTABLE_GV(POPs);
     GV * const gv = MUTABLE_GV(POPs);

-    IO * const io = gv ? GvIOn(gv) : NULL;
+    IO * const io = GvIOn(gv);

     char *s;
     IV retval;
 
     char *s;
     IV retval;
 

-    if (!io || !argsv || !IoIFP(io)) {
+    if (!IoIFP(io)) {

        report_evil_fh(gv);
        SETERRNO(EBADF,RMS_IFI);        /* well, sort of... */
        RETPUSHUNDEF;
        report_evil_fh(gv);
        SETERRNO(EBADF,RMS_IFI);        /* well, sort of... */
        RETPUSHUNDEF;


@@ -2295,6 +2409,7 @@ PP(pp_ioctl)
        s = INT2PTR(char*,retval);              /* ouch */
     }
 
        s = INT2PTR(char*,retval);              /* ouch */
     }
 

+    optype = PL_op->op_type;

     TAINT_PROPER(PL_op_desc[optype]);
 
     if (optype == OP_IOCTL)
     TAINT_PROPER(PL_op_desc[optype]);
 
     if (optype == OP_IOCTL)


@@ -2338,10 +2453,10 @@ PP(pp_ioctl)
 PP(pp_flock)
 {
 #ifdef FLOCK
 PP(pp_flock)
 {
 #ifdef FLOCK

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     I32 value;
     const int argtype = POPi;
     I32 value;
     const int argtype = POPi;

-    GV * const gv = (MAXARG == 0) ? PL_last_in_gv : MUTABLE_GV(POPs);
+    GV * const gv = MUTABLE_GV(POPs);

     IO *const io = GvIO(gv);
     PerlIO *const fp = io ? IoIFP(io) : NULL;
 
     IO *const io = GvIO(gv);
     PerlIO *const fp = io ? IoIFP(io) : NULL;
 


@@ -2358,7 +2473,7 @@ PP(pp_flock)
     PUSHi(value);
     RETURN;
 #else
     PUSHi(value);
     RETURN;
 #else

-    DIE(aTHX_ PL_no_func, "flock()");
+    DIE(aTHX_ PL_no_func, "flock");

 #endif
 }
 
 #endif
 }
 


@@ -2368,29 +2483,23 @@ PP(pp_flock)
 
 PP(pp_socket)
 {
 
 PP(pp_socket)
 {

-    dVAR; dSP;
+    dSP;

     const int protocol = POPi;
     const int type = POPi;
     const int domain = POPi;
     GV * const gv = MUTABLE_GV(POPs);
     const int protocol = POPi;
     const int type = POPi;
     const int domain = POPi;
     GV * const gv = MUTABLE_GV(POPs);

-    register IO * const io = gv ? GvIOn(gv) : NULL;
+    IO * const io = GvIOn(gv);

     int fd;
 
     int fd;
 

-    if (!io) {
-       report_evil_fh(gv);
-       if (io && IoIFP(io))
-           do_close(gv, FALSE);
-       SETERRNO(EBADF,LIB_INVARG);
-       RETPUSHUNDEF;
-    }
-

     if (IoIFP(io))
        do_close(gv, FALSE);
 
     TAINT_PROPER("socket");
     fd = PerlSock_socket(domain, type, protocol);
     if (IoIFP(io))
        do_close(gv, FALSE);
 
     TAINT_PROPER("socket");
     fd = PerlSock_socket(domain, type, protocol);

-    if (fd < 0)
+    if (fd < 0) {
+        SETERRNO(EBADF,RMS_IFI);

        RETPUSHUNDEF;
        RETPUSHUNDEF;

+    }

     IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE);        /* stdio gets confused about sockets */
     IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
     IoTYPE(io) = IoTYPE_SOCKET;
     IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE);        /* stdio gets confused about sockets */
     IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
     IoTYPE(io) = IoTYPE_SOCKET;


@@ -2400,12 +2509,10 @@ PP(pp_socket)
        if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd);
        RETPUSHUNDEF;
     }
        if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd);
        RETPUSHUNDEF;
     }

-#if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(fd, F_SETFD, fd > PL_maxsysfd);      /* ensure close-on-exec */
-#endif
-
-#ifdef EPOC
-    setbuf( IoIFP(io), NULL); /* EPOC gets confused about sockets */
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+    /* ensure close-on-exec */
+    if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0)
+       RETPUSHUNDEF;

 #endif
 
     RETPUSHYES;
 #endif
 
     RETPUSHYES;


@@ -2415,29 +2522,22 @@ PP(pp_socket)
 PP(pp_sockpair)
 {
 #if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET))
 PP(pp_sockpair)
 {
 #if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET))

-    dVAR; dSP;
+    dSP;
+    int fd[2];

     const int protocol = POPi;
     const int type = POPi;
     const int domain = POPi;
     const int protocol = POPi;
     const int type = POPi;
     const int domain = POPi;

+

     GV * const gv2 = MUTABLE_GV(POPs);
     GV * const gv2 = MUTABLE_GV(POPs);

+    IO * const io2 = GvIOn(gv2);

     GV * const gv1 = MUTABLE_GV(POPs);
     GV * const gv1 = MUTABLE_GV(POPs);

-    register IO * const io1 = gv1 ? GvIOn(gv1) : NULL;
-    register IO * const io2 = gv2 ? GvIOn(gv2) : NULL;
-    int fd[2];
-
-    if (!io1)
-       report_evil_fh(gv1);
-    if (!io2)
-       report_evil_fh(gv2);
+    IO * const io1 = GvIOn(gv1);

 
 

-    if (io1 && IoIFP(io1))
+    if (IoIFP(io1))

        do_close(gv1, FALSE);
        do_close(gv1, FALSE);

-    if (io2 && IoIFP(io2))
+    if (IoIFP(io2))

        do_close(gv2, FALSE);
 
        do_close(gv2, FALSE);
 

-    if (!io1 || !io2)
-       RETPUSHUNDEF;
-

     TAINT_PROPER("socketpair");
     if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
        RETPUSHUNDEF;
     TAINT_PROPER("socketpair");
     if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
        RETPUSHUNDEF;


@@ -2456,9 +2556,11 @@ PP(pp_sockpair)
        if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]);
        RETPUSHUNDEF;
     }
        if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]);
        RETPUSHUNDEF;
     }

-#if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd);  /* ensure close-on-exec */
-    fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd);  /* ensure close-on-exec */
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+    /* ensure close-on-exec */
+    if ((fd[0] > PL_maxsysfd && fcntl(fd[0], F_SETFD, FD_CLOEXEC) < 0) ||
+        (fd[1] > PL_maxsysfd && fcntl(fd[1], F_SETFD, FD_CLOEXEC) < 0))
+       RETPUSHUNDEF;

 #endif
 
     RETPUSHYES;
 #endif
 
     RETPUSHYES;


@@ -2469,31 +2571,38 @@ PP(pp_sockpair)
 
 #ifdef HAS_SOCKET
 
 
 #ifdef HAS_SOCKET
 

+/* also used for: pp_connect() */
+

 PP(pp_bind)
 {
 PP(pp_bind)
 {

-    dVAR; dSP;
+    dSP;

     SV * const addrsv = POPs;
     /* OK, so on what platform does bind modify addr?  */
     const char *addr;
     GV * const gv = MUTABLE_GV(POPs);
     SV * const addrsv = POPs;
     /* OK, so on what platform does bind modify addr?  */
     const char *addr;
     GV * const gv = MUTABLE_GV(POPs);

-    register IO * const io = GvIOn(gv);
+    IO * const io = GvIOn(gv);

     STRLEN len;
     STRLEN len;

-    const int op_type = PL_op->op_type;
+    int op_type;
+    int fd;

 
 

-    if (!io || !IoIFP(io))
+    if (!IoIFP(io))

        goto nuts;
        goto nuts;

+    fd = PerlIO_fileno(IoIFP(io));
+    if (fd < 0)
+        goto nuts;

 
     addr = SvPV_const(addrsv, len);
 
     addr = SvPV_const(addrsv, len);

+    op_type = PL_op->op_type;

     TAINT_PROPER(PL_op_desc[op_type]);
     if ((op_type == OP_BIND
     TAINT_PROPER(PL_op_desc[op_type]);
     if ((op_type == OP_BIND

-        ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)
-        : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len))
+        ? PerlSock_bind(fd, (struct sockaddr *)addr, len)
+        : PerlSock_connect(fd, (struct sockaddr *)addr, len))

        >= 0)
        RETPUSHYES;
     else
        RETPUSHUNDEF;
 
        >= 0)
        RETPUSHYES;
     else
        RETPUSHUNDEF;
 

-nuts:
+  nuts:

     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;


@@ -2501,12 +2610,12 @@ nuts:
 
 PP(pp_listen)
 {
 
 PP(pp_listen)
 {

-    dVAR; dSP;
+    dSP;

     const int backlog = POPi;
     GV * const gv = MUTABLE_GV(POPs);
     const int backlog = POPi;
     GV * const gv = MUTABLE_GV(POPs);

-    register IO * const io = gv ? GvIOn(gv) : NULL;
+    IO * const io = GvIOn(gv);

 
 

-    if (!io || !IoIFP(io))
+    if (!IoIFP(io))

        goto nuts;
 
     if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
        goto nuts;
 
     if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)


@@ -2514,7 +2623,7 @@ PP(pp_listen)
     else
        RETPUSHUNDEF;
 
     else
        RETPUSHUNDEF;
 

-nuts:
+  nuts:

     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;


@@ -2522,11 +2631,10 @@ nuts:
 
 PP(pp_accept)
 {
 
 PP(pp_accept)
 {

-    dVAR; dSP; dTARGET;
-    register IO *nstio;
-    register IO *gstio;
+    dSP; dTARGET;
+    IO *nstio;

     char namebuf[MAXPATHLEN];
     char namebuf[MAXPATHLEN];

-#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE) || defined(__QNXNTO__)
+#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)

     Sock_size_t len = sizeof (struct sockaddr_in);
 #else
     Sock_size_t len = sizeof namebuf;
     Sock_size_t len = sizeof (struct sockaddr_in);
 #else
     Sock_size_t len = sizeof namebuf;


@@ -2535,12 +2643,7 @@ PP(pp_accept)
     GV * const ngv = MUTABLE_GV(POPs);
     int fd;
 
     GV * const ngv = MUTABLE_GV(POPs);
     int fd;
 

-    if (!ngv)
-       goto badexit;
-    if (!ggv)
-       goto nuts;
-
-    gstio = GvIO(ggv);
+    IO * const gstio = GvIO(ggv);

     if (!gstio || !IoIFP(gstio))
        goto nuts;
 
     if (!gstio || !IoIFP(gstio))
        goto nuts;
 


@@ -2570,14 +2673,12 @@ PP(pp_accept)
        if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd);
        goto badexit;
     }
        if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd);
        goto badexit;
     }

-#if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(fd, F_SETFD, fd > PL_maxsysfd);      /* ensure close-on-exec */
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+    /* ensure close-on-exec */
+    if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0)
+        goto badexit;

 #endif
 
 #endif
 

-#ifdef EPOC
-    len = sizeof (struct sockaddr_in); /* EPOC somehow truncates info */
-    setbuf( IoIFP(nstio), NULL); /* EPOC gets confused about sockets */
-#endif

 #ifdef __SCO_VERSION__
     len = sizeof (struct sockaddr_in); /* OpenUNIX 8 somehow truncates info */
 #endif
 #ifdef __SCO_VERSION__
     len = sizeof (struct sockaddr_in); /* OpenUNIX 8 somehow truncates info */
 #endif


@@ -2585,50 +2686,55 @@ PP(pp_accept)
     PUSHp(namebuf, len);
     RETURN;
 
     PUSHp(namebuf, len);
     RETURN;
 

-nuts:
+  nuts:

     report_evil_fh(ggv);
     SETERRNO(EBADF,SS_IVCHAN);
 
     report_evil_fh(ggv);
     SETERRNO(EBADF,SS_IVCHAN);
 

-badexit:
+  badexit:

     RETPUSHUNDEF;
 
 }
 
 PP(pp_shutdown)
 {
     RETPUSHUNDEF;
 
 }
 
 PP(pp_shutdown)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     const int how = POPi;
     GV * const gv = MUTABLE_GV(POPs);
     const int how = POPi;
     GV * const gv = MUTABLE_GV(POPs);

-    register IO * const io = GvIOn(gv);
+    IO * const io = GvIOn(gv);

 
 

-    if (!io || !IoIFP(io))
+    if (!IoIFP(io))

        goto nuts;
 
     PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
     RETURN;
 
        goto nuts;
 
     PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
     RETURN;
 

-nuts:
+  nuts:

     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
 }
 
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
 }
 

+
+/* also used for: pp_gsockopt() */
+

 PP(pp_ssockopt)
 {
 PP(pp_ssockopt)
 {

-    dVAR; dSP;
+    dSP;

     const int optype = PL_op->op_type;
     SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(newSV(257)) : POPs;
     const unsigned int optname = (unsigned int) POPi;
     const unsigned int lvl = (unsigned int) POPi;
     GV * const gv = MUTABLE_GV(POPs);
     const int optype = PL_op->op_type;
     SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(newSV(257)) : POPs;
     const unsigned int optname = (unsigned int) POPi;
     const unsigned int lvl = (unsigned int) POPi;
     GV * const gv = MUTABLE_GV(POPs);

-    register IO * const io = GvIOn(gv);
+    IO * const io = GvIOn(gv);

     int fd;
     Sock_size_t len;
 
     int fd;
     Sock_size_t len;
 

-    if (!io || !IoIFP(io))
+    if (!IoIFP(io))

        goto nuts;
 
     fd = PerlIO_fileno(IoIFP(io));
        goto nuts;
 
     fd = PerlIO_fileno(IoIFP(io));

+    if (fd < 0)
+        goto nuts;

     switch (optype) {
     case OP_GSOCKOPT:
        SvGROW(sv, 257);
     switch (optype) {
     case OP_GSOCKOPT:
        SvGROW(sv, 257);


@@ -2638,6 +2744,11 @@ PP(pp_ssockopt)
        len = SvCUR(sv);
        if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
            goto nuts2;
        len = SvCUR(sv);
        if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
            goto nuts2;

+#if defined(_AIX)
+        /* XXX Configure test: does getsockopt set the length properly? */
+        if (len == 256)
+            len = sizeof(int);
+#endif

        SvCUR_set(sv, len);
        *SvEND(sv) ='\0';
        PUSHs(sv);
        SvCUR_set(sv, len);
        *SvEND(sv) ='\0';
        PUSHs(sv);


@@ -2677,25 +2788,28 @@ PP(pp_ssockopt)
     }
     RETURN;
 
     }
     RETURN;
 

-nuts:
+  nuts:

     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);

-nuts2:
+  nuts2:

     RETPUSHUNDEF;
 
 }
 
     RETPUSHUNDEF;
 
 }
 

+
+/* also used for: pp_getsockname() */
+

 PP(pp_getpeername)
 {
 PP(pp_getpeername)
 {

-    dVAR; dSP;
+    dSP;

     const int optype = PL_op->op_type;
     GV * const gv = MUTABLE_GV(POPs);
     const int optype = PL_op->op_type;
     GV * const gv = MUTABLE_GV(POPs);

-    register IO * const io = GvIOn(gv);
+    IO * const io = GvIOn(gv);

     Sock_size_t len;
     SV *sv;
     int fd;
 
     Sock_size_t len;
     SV *sv;
     int fd;
 

-    if (!io || !IoIFP(io))
+    if (!IoIFP(io))

        goto nuts;
 
     sv = sv_2mortal(newSV(257));
        goto nuts;
 
     sv = sv_2mortal(newSV(257));


@@ -2704,6 +2818,8 @@ PP(pp_getpeername)
     SvCUR_set(sv, len);
     *SvEND(sv) ='\0';
     fd = PerlIO_fileno(IoIFP(io));
     SvCUR_set(sv, len);
     *SvEND(sv) ='\0';
     fd = PerlIO_fileno(IoIFP(io));

+    if (fd < 0)
+        goto nuts;

     switch (optype) {
     case OP_GETSOCKNAME:
        if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
     switch (optype) {
     case OP_GETSOCKNAME:
        if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)


@@ -2736,10 +2852,10 @@ PP(pp_getpeername)
     PUSHs(sv);
     RETURN;
 
     PUSHs(sv);
     RETURN;
 

-nuts:
+  nuts:

     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);

-nuts2:
+  nuts2:

     RETPUSHUNDEF;
 }
 
     RETPUSHUNDEF;
 }
 


@@ -2747,13 +2863,14 @@ nuts2:
 
 /* Stat calls. */
 
 
 /* Stat calls. */
 

+/* also used for: pp_lstat() */
+

 PP(pp_stat)
 {
 PP(pp_stat)
 {

-    dVAR;

     dSP;
     GV *gv = NULL;
     dSP;
     GV *gv = NULL;

-    IO *io;
-    I32 gimme;
+    IO *io = NULL;
+    U8 gimme;

     I32 max = 13;
     SV* sv;
 
     I32 max = 13;
     SV* sv;
 


@@ -2763,7 +2880,9 @@ PP(pp_stat)
            if (gv != PL_defgv) {
            do_fstat_warning_check:
                Perl_ck_warner(aTHX_ packWARN(WARN_IO),
            if (gv != PL_defgv) {
            do_fstat_warning_check:
                Perl_ck_warner(aTHX_ packWARN(WARN_IO),

-                              "lstat() on filehandle %"SVf, SVfARG(gv
+                              "lstat() on filehandle%s%"SVf,
+                               gv ? " " : "",
+                               SVfARG(gv

                                         ? sv_2mortal(newSVhek(GvENAME_HEK(gv)))
                                         : &PL_sv_no));
            } else if (PL_laststype != OP_LSTAT)
                                         ? sv_2mortal(newSVhek(GvENAME_HEK(gv)))
                                         : &PL_sv_no));
            } else if (PL_laststype != OP_LSTAT)


@@ -2772,32 +2891,43 @@ PP(pp_stat)
        }
 
        if (gv != PL_defgv) {
        }
 
        if (gv != PL_defgv) {

+           bool havefp;
+          do_fstat_have_io:
+           havefp = FALSE;

            PL_laststype = OP_STAT;
            PL_laststype = OP_STAT;

-           PL_statgv = gv;
+           PL_statgv = gv ? gv : (GV *)io;

            sv_setpvs(PL_statname, "");
             if(gv) {
                 io = GvIO(gv);
            sv_setpvs(PL_statname, "");
             if(gv) {
                 io = GvIO(gv);

-                do_fstat_have_io:
-                if (io) {
+           }
+            if (io) {

                     if (IoIFP(io)) {
                     if (IoIFP(io)) {

-                        PL_laststatval = 
-                            PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);   
+                        int fd = PerlIO_fileno(IoIFP(io));
+                        if (fd < 0) {
+                            PL_laststatval = -1;
+                            SETERRNO(EBADF,RMS_IFI);
+                        } else {
+                            PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
+                            havefp = TRUE;
+                        }

                     } else if (IoDIRP(io)) {
                         PL_laststatval =
                             PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);
                     } else if (IoDIRP(io)) {
                         PL_laststatval =
                             PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);

+                        havefp = TRUE;

                     } else {
                         PL_laststatval = -1;
                     }
                     } else {
                         PL_laststatval = -1;
                     }

-               }

             }
             }

+           else PL_laststatval = -1;
+           if (PL_laststatval < 0 && !havefp) report_evil_fh(gv);

         }
 
        if (PL_laststatval < 0) {
         }
 
        if (PL_laststatval < 0) {

-           report_evil_fh(gv);

            max = 0;
        }
     }
     else {
            max = 0;
        }
     }
     else {

+        const char *file;

        if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { 
             io = MUTABLE_IO(SvRV(sv));
             if (PL_op->op_type == OP_LSTAT)
        if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { 
             io = MUTABLE_IO(SvRV(sv));
             if (PL_op->op_type == OP_LSTAT)


@@ -2805,16 +2935,22 @@ PP(pp_stat)
             goto do_fstat_have_io; 
         }
         
             goto do_fstat_have_io; 
         }
         

+       SvTAINTED_off(PL_statname); /* previous tainting irrelevant */

        sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
        PL_statgv = NULL;
        PL_laststype = PL_op->op_type;
        sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
        PL_statgv = NULL;
        PL_laststype = PL_op->op_type;

+        file = SvPV_nolen_const(PL_statname);

        if (PL_op->op_type == OP_LSTAT)
        if (PL_op->op_type == OP_LSTAT)

-           PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(PL_statname), &PL_statcache);
+           PL_laststatval = PerlLIO_lstat(file, &PL_statcache);

        else
        else

-           PL_laststatval = PerlLIO_stat(SvPV_nolen_const(PL_statname), &PL_statcache);
+           PL_laststatval = PerlLIO_stat(file, &PL_statcache);

        if (PL_laststatval < 0) {
        if (PL_laststatval < 0) {

-           if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname), '\n'))
+           if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) {
+                /* PL_warn_nl is constant */
+                GCC_DIAG_IGNORE(-Wformat-nonliteral);

                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");

+                GCC_DIAG_RESTORE;
+            }

            max = 0;
        }
     }
            max = 0;
        }
     }


@@ -2840,24 +2976,10 @@ PP(pp_stat)
 #endif
        mPUSHu(PL_statcache.st_mode);
        mPUSHu(PL_statcache.st_nlink);
 #endif
        mPUSHu(PL_statcache.st_mode);
        mPUSHu(PL_statcache.st_nlink);

-#if Uid_t_size > IVSIZE
-       mPUSHn(PL_statcache.st_uid);
-#else
-#   if Uid_t_sign <= 0
-       mPUSHi(PL_statcache.st_uid);
-#   else
-       mPUSHu(PL_statcache.st_uid);
-#   endif
-#endif
-#if Gid_t_size > IVSIZE
-       mPUSHn(PL_statcache.st_gid);
-#else
-#   if Gid_t_sign <= 0
-       mPUSHi(PL_statcache.st_gid);
-#   else
-       mPUSHu(PL_statcache.st_gid);
-#   endif
-#endif
+       
+        sv_setuid(PUSHmortal, PL_statcache.st_uid);
+        sv_setgid(PUSHmortal, PL_statcache.st_gid);
+

 #ifdef USE_STAT_RDEV
        mPUSHi(PL_statcache.st_rdev);
 #else
 #ifdef USE_STAT_RDEV
        mPUSHi(PL_statcache.st_rdev);
 #else


@@ -2888,23 +3010,68 @@ PP(pp_stat)
     RETURN;
 }
 
     RETURN;
 }
 

+/* All filetest ops avoid manipulating the perl stack pointer in their main
+   bodies (since commit d2c4d2d1e22d3125), and return using either
+   S_ft_return_false() or S_ft_return_true().  These two helper functions are
+   the only two which manipulate the perl stack.  To ensure that no stack
+   manipulation macros are used, the filetest ops avoid defining a local copy
+   of the stack pointer with dSP.  */
+
+/* If the next filetest is stacked up with this one
+   (PL_op->op_private & OPpFT_STACKING), we leave
+   the original argument on the stack for success,
+   and skip the stacked operators on failure.
+   The next few macros/functions take care of this.
+*/
+
+static OP *
+S_ft_return_false(pTHX_ SV *ret) {
+    OP *next = NORMAL;
+    dSP;
+
+    if (PL_op->op_flags & OPf_REF) XPUSHs(ret);
+    else                          SETs(ret);
+    PUTBACK;
+
+    if (PL_op->op_private & OPpFT_STACKING) {
+        while (OP_IS_FILETEST(next->op_type)
+               && next->op_private & OPpFT_STACKED)
+            next = next->op_next;
+    }
+    return next;
+}
+
+PERL_STATIC_INLINE OP *
+S_ft_return_true(pTHX_ SV *ret) {
+    dSP;
+    if (PL_op->op_flags & OPf_REF)
+        XPUSHs(PL_op->op_private & OPpFT_STACKING ? (SV *)cGVOP_gv : (ret));
+    else if (!(PL_op->op_private & OPpFT_STACKING))
+        SETs(ret);
+    PUTBACK;
+    return NORMAL;
+}
+
+#define FT_RETURNNO    return S_ft_return_false(aTHX_ &PL_sv_no)
+#define FT_RETURNUNDEF return S_ft_return_false(aTHX_ &PL_sv_undef)
+#define FT_RETURNYES   return S_ft_return_true(aTHX_ &PL_sv_yes)
+

 #define tryAMAGICftest_MG(chr) STMT_START { \
 #define tryAMAGICftest_MG(chr) STMT_START { \

-       if ( (SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG)) \
-               && PL_op->op_flags & OPf_KIDS    \
-               && S_try_amagic_ftest(aTHX_ chr)) \
-           return NORMAL; \
+       if ( (SvFLAGS(*PL_stack_sp) & (SVf_ROK|SVs_GMG)) \
+               && PL_op->op_flags & OPf_KIDS) {     \
+           OP *next = S_try_amagic_ftest(aTHX_ chr);   \
+           if (next) return next;                        \
+       }                                                  \

     } STMT_END
 
     } STMT_END
 

-STATIC bool
+STATIC OP *

 S_try_amagic_ftest(pTHX_ char chr) {
 S_try_amagic_ftest(pTHX_ char chr) {

-    dVAR;
-    dSP;
-    SV* const arg = TOPs;
+    SV *const arg = *PL_stack_sp;

 
     assert(chr != '?');
 
     assert(chr != '?');

-    SvGETMAGIC(arg);
+    if (!(PL_op->op_private & OPpFT_STACKING)) SvGETMAGIC(arg);

 
 

-    if (SvAMAGIC(TOPs))
+    if (SvAMAGIC(arg))

     {
        const char tmpchr = chr;
        SV * const tmpsv = amagic_call(arg,
     {
        const char tmpchr = chr;
        SV * const tmpsv = amagic_call(arg,


@@ -2912,39 +3079,23 @@ S_try_amagic_ftest(pTHX_ char chr) {
                                ftest_amg, AMGf_unary);
 
        if (!tmpsv)
                                ftest_amg, AMGf_unary);
 
        if (!tmpsv)

-           return FALSE;
-
-       SPAGAIN;
+           return NULL;

 
 

-       if (PL_op->op_private & OPpFT_STACKING) {
-           if (SvTRUE(tmpsv))
-               /* leave the object alone */
-               return TRUE;
-       }
-
-       SETs(tmpsv);
-       PUTBACK;
-       return TRUE;
+       return SvTRUE(tmpsv)
+            ? S_ft_return_true(aTHX_ tmpsv) : S_ft_return_false(aTHX_ tmpsv);

     }
     }

-    return FALSE;
+    return NULL;

 }
 
 
 }
 
 

-/* This macro is used by the stacked filetest operators :
- * if the previous filetest failed, short-circuit and pass its value.
- * Else, discard it from the stack and continue. --rgs
- */
-#define STACKED_FTEST_CHECK if (PL_op->op_private & OPpFT_STACKED) { \
-       if (!SvTRUE(TOPs)) { RETURN; } \
-       else { (void)POPs; PUTBACK; } \
-    }
+/* also used for: pp_fteexec() pp_fteread() pp_ftewrite() pp_ftrexec()
+ *                pp_ftrwrite() */

 
 PP(pp_ftrread)
 {
 
 PP(pp_ftrread)
 {

-    dVAR;

     I32 result;
     /* Not const, because things tweak this below. Not bool, because there's
     I32 result;
     /* Not const, because things tweak this below. Not bool, because there's

-       no guarantee that OPp_FT_ACCESS is <= CHAR_MAX  */
+       no guarantee that OPpFT_ACCESS is <= CHAR_MAX  */

 #if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
     I32 use_access = PL_op->op_private & OPpFT_ACCESS;
     /* Giving some sort of initial value silences compilers.  */
 #if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
     I32 use_access = PL_op->op_private & OPpFT_ACCESS;
     /* Giving some sort of initial value silences compilers.  */


@@ -2962,7 +3113,6 @@ PP(pp_ftrread)
 
     bool effective = FALSE;
     char opchar = '?';
 
     bool effective = FALSE;
     char opchar = '?';

-    dSP;

 
     switch (PL_op->op_type) {
     case OP_FTRREAD:   opchar = 'R'; break;
 
     switch (PL_op->op_type) {
     case OP_FTRREAD:   opchar = 'R'; break;


@@ -2974,8 +3124,6 @@ PP(pp_ftrread)
     }
     tryAMAGICftest_MG(opchar);
 
     }
     tryAMAGICftest_MG(opchar);
 

-    STACKED_FTEST_CHECK;
-

     switch (PL_op->op_type) {
     case OP_FTRREAD:
 #if !(defined(HAS_ACCESS) && defined(R_OK))
     switch (PL_op->op_type) {
     case OP_FTRREAD:
 #if !(defined(HAS_ACCESS) && defined(R_OK))


@@ -3006,7 +3154,7 @@ PP(pp_ftrread)
        access_mode = W_OK;
 #endif
        stat_mode = S_IWUSR;
        access_mode = W_OK;
 #endif
        stat_mode = S_IWUSR;

-       /* fall through */
+       /* FALLTHROUGH */

 
     case OP_FTEREAD:
 #ifndef PERL_EFF_ACCESS
 
     case OP_FTEREAD:
 #ifndef PERL_EFF_ACCESS


@@ -3028,7 +3176,7 @@ PP(pp_ftrread)
 
     if (use_access) {
 #if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
 
     if (use_access) {
 #if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)

-       const char *name = POPpx;
+       const char *name = SvPV_nolen(*PL_stack_sp);

        if (effective) {
 #  ifdef PERL_EFF_ACCESS
            result = PERL_EFF_ACCESS(name, access_mode);
        if (effective) {
 #  ifdef PERL_EFF_ACCESS
            result = PERL_EFF_ACCESS(name, access_mode);


@@ -3045,29 +3193,29 @@ PP(pp_ftrread)
 #  endif
        }
        if (result == 0)
 #  endif
        }
        if (result == 0)

-           RETPUSHYES;
+           FT_RETURNYES;

        if (result < 0)
        if (result < 0)

-           RETPUSHUNDEF;
-       RETPUSHNO;
+           FT_RETURNUNDEF;
+       FT_RETURNNO;

 #endif
     }
 
     result = my_stat_flags(0);
 #endif
     }
 
     result = my_stat_flags(0);

-    SPAGAIN;

     if (result < 0)
     if (result < 0)

-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;

     if (cando(stat_mode, effective, &PL_statcache))
     if (cando(stat_mode, effective, &PL_statcache))

-       RETPUSHYES;
-    RETPUSHNO;
+       FT_RETURNYES;
+    FT_RETURNNO;

 }
 
 }
 

+
+/* also used for: pp_ftatime() pp_ftctime() pp_ftmtime() pp_ftsize() */
+

 PP(pp_ftis)
 {
 PP(pp_ftis)
 {

-    dVAR;

     I32 result;
     const int op_type = PL_op->op_type;
     char opchar = '?';
     I32 result;
     const int op_type = PL_op->op_type;
     char opchar = '?';

-    dSP;

 
     switch (op_type) {
     case OP_FTIS:      opchar = 'e'; break;
 
     switch (op_type) {
     case OP_FTIS:      opchar = 'e'; break;


@@ -3078,14 +3226,11 @@ PP(pp_ftis)
     }
     tryAMAGICftest_MG(opchar);
 
     }
     tryAMAGICftest_MG(opchar);
 

-    STACKED_FTEST_CHECK;
-

     result = my_stat_flags(0);
     result = my_stat_flags(0);

-    SPAGAIN;

     if (result < 0)
     if (result < 0)

-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;

     if (op_type == OP_FTIS)
     if (op_type == OP_FTIS)

-       RETPUSHYES;
+       FT_RETURNYES;

     {
        /* You can't dTARGET inside OP_FTIS, because you'll get
           "panic: pad_sv po" - the op is not flagged to have a target.  */
     {
        /* You can't dTARGET inside OP_FTIS, because you'll get
           "panic: pad_sv po" - the op is not flagged to have a target.  */


@@ -3093,31 +3238,39 @@ PP(pp_ftis)
        switch (op_type) {
        case OP_FTSIZE:
 #if Off_t_size > IVSIZE
        switch (op_type) {
        case OP_FTSIZE:
 #if Off_t_size > IVSIZE

-           PUSHn(PL_statcache.st_size);
+           sv_setnv(TARG, (NV)PL_statcache.st_size);

 #else
 #else

-           PUSHi(PL_statcache.st_size);
+           sv_setiv(TARG, (IV)PL_statcache.st_size);

 #endif
            break;
        case OP_FTMTIME:
 #endif
            break;
        case OP_FTMTIME:

-           PUSHn( (((NV)PL_basetime - PL_statcache.st_mtime)) / 86400.0 );
+           sv_setnv(TARG,
+                   ((NV)PL_basetime - PL_statcache.st_mtime) / 86400.0 );

            break;
        case OP_FTATIME:
            break;
        case OP_FTATIME:

-           PUSHn( (((NV)PL_basetime - PL_statcache.st_atime)) / 86400.0 );
+           sv_setnv(TARG,
+                   ((NV)PL_basetime - PL_statcache.st_atime) / 86400.0 );

            break;
        case OP_FTCTIME:
            break;
        case OP_FTCTIME:

-           PUSHn( (((NV)PL_basetime - PL_statcache.st_ctime)) / 86400.0 );
+           sv_setnv(TARG,
+                   ((NV)PL_basetime - PL_statcache.st_ctime) / 86400.0 );

            break;
        }
            break;
        }

+       SvSETMAGIC(TARG);
+       return SvTRUE_nomg(TARG)
+            ? S_ft_return_true(aTHX_ TARG) : S_ft_return_false(aTHX_ TARG);

     }
     }

-    RETURN;

 }
 
 }
 

+
+/* also used for: pp_ftblk() pp_ftchr() pp_ftdir() pp_fteowned()
+ *                pp_ftfile() pp_ftpipe() pp_ftsgid() pp_ftsock()
+ *                pp_ftsuid() pp_ftsvtx() pp_ftzero() */
+

 PP(pp_ftrowned)
 {
 PP(pp_ftrowned)
 {

-    dVAR;

     I32 result;
     char opchar = '?';
     I32 result;
     char opchar = '?';

-    dSP;

 
     switch (PL_op->op_type) {
     case OP_FTROWNED:  opchar = 'O'; break;
 
     switch (PL_op->op_type) {
     case OP_FTROWNED:  opchar = 'O'; break;


@@ -3135,215 +3288,205 @@ PP(pp_ftrowned)
     }
     tryAMAGICftest_MG(opchar);
 
     }
     tryAMAGICftest_MG(opchar);
 

-    STACKED_FTEST_CHECK;
-

     /* I believe that all these three are likely to be defined on most every
        system these days.  */
 #ifndef S_ISUID
     if(PL_op->op_type == OP_FTSUID) {
     /* I believe that all these three are likely to be defined on most every
        system these days.  */
 #ifndef S_ISUID
     if(PL_op->op_type == OP_FTSUID) {

-       if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0)
-           (void) POPs;
-       RETPUSHNO;
+       FT_RETURNNO;

     }
 #endif
 #ifndef S_ISGID
     if(PL_op->op_type == OP_FTSGID) {
     }
 #endif
 #ifndef S_ISGID
     if(PL_op->op_type == OP_FTSGID) {

-       if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0)
-           (void) POPs;
-       RETPUSHNO;
+       FT_RETURNNO;

     }
 #endif
 #ifndef S_ISVTX
     if(PL_op->op_type == OP_FTSVTX) {
     }
 #endif
 #ifndef S_ISVTX
     if(PL_op->op_type == OP_FTSVTX) {

-       if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0)
-           (void) POPs;
-       RETPUSHNO;
+       FT_RETURNNO;

     }
 #endif
 
     result = my_stat_flags(0);
     }
 #endif
 
     result = my_stat_flags(0);

-    SPAGAIN;

     if (result < 0)
     if (result < 0)

-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;

     switch (PL_op->op_type) {
     case OP_FTROWNED:
     switch (PL_op->op_type) {
     case OP_FTROWNED:

-       if (PL_statcache.st_uid == PL_uid)
-           RETPUSHYES;
+       if (PL_statcache.st_uid == PerlProc_getuid())
+           FT_RETURNYES;

        break;
     case OP_FTEOWNED:
        break;
     case OP_FTEOWNED:

-       if (PL_statcache.st_uid == PL_euid)
-           RETPUSHYES;
+       if (PL_statcache.st_uid == PerlProc_geteuid())
+           FT_RETURNYES;

        break;
     case OP_FTZERO:
        if (PL_statcache.st_size == 0)
        break;
     case OP_FTZERO:
        if (PL_statcache.st_size == 0)

-           RETPUSHYES;
+           FT_RETURNYES;

        break;
     case OP_FTSOCK:
        if (S_ISSOCK(PL_statcache.st_mode))
        break;
     case OP_FTSOCK:
        if (S_ISSOCK(PL_statcache.st_mode))

-           RETPUSHYES;
+           FT_RETURNYES;

        break;
     case OP_FTCHR:
        if (S_ISCHR(PL_statcache.st_mode))
        break;
     case OP_FTCHR:
        if (S_ISCHR(PL_statcache.st_mode))

-           RETPUSHYES;
+           FT_RETURNYES;

        break;
     case OP_FTBLK:
        if (S_ISBLK(PL_statcache.st_mode))
        break;
     case OP_FTBLK:
        if (S_ISBLK(PL_statcache.st_mode))

-           RETPUSHYES;
+           FT_RETURNYES;

        break;
     case OP_FTFILE:
        if (S_ISREG(PL_statcache.st_mode))
        break;
     case OP_FTFILE:
        if (S_ISREG(PL_statcache.st_mode))

-           RETPUSHYES;
+           FT_RETURNYES;

        break;
     case OP_FTDIR:
        if (S_ISDIR(PL_statcache.st_mode))
        break;
     case OP_FTDIR:
        if (S_ISDIR(PL_statcache.st_mode))

-           RETPUSHYES;
+           FT_RETURNYES;

        break;
     case OP_FTPIPE:
        if (S_ISFIFO(PL_statcache.st_mode))
        break;
     case OP_FTPIPE:
        if (S_ISFIFO(PL_statcache.st_mode))

-           RETPUSHYES;
+           FT_RETURNYES;

        break;
 #ifdef S_ISUID
     case OP_FTSUID:
        if (PL_statcache.st_mode & S_ISUID)
        break;
 #ifdef S_ISUID
     case OP_FTSUID:
        if (PL_statcache.st_mode & S_ISUID)

-           RETPUSHYES;
+           FT_RETURNYES;

        break;
 #endif
 #ifdef S_ISGID
     case OP_FTSGID:
        if (PL_statcache.st_mode & S_ISGID)
        break;
 #endif
 #ifdef S_ISGID
     case OP_FTSGID:
        if (PL_statcache.st_mode & S_ISGID)

-           RETPUSHYES;
+           FT_RETURNYES;

        break;
 #endif
 #ifdef S_ISVTX
     case OP_FTSVTX:
        if (PL_statcache.st_mode & S_ISVTX)
        break;
 #endif
 #ifdef S_ISVTX
     case OP_FTSVTX:
        if (PL_statcache.st_mode & S_ISVTX)

-           RETPUSHYES;
+           FT_RETURNYES;

        break;
 #endif
     }
        break;
 #endif
     }

-    RETPUSHNO;
+    FT_RETURNNO;

 }
 
 PP(pp_ftlink)
 {
 }
 
 PP(pp_ftlink)
 {

-    dVAR;
-    dSP;

     I32 result;
 
     tryAMAGICftest_MG('l');
     I32 result;
 
     tryAMAGICftest_MG('l');

-    STACKED_FTEST_CHECK;

     result = my_lstat_flags(0);
     result = my_lstat_flags(0);

-    SPAGAIN;

 
     if (result < 0)
 
     if (result < 0)

-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;

     if (S_ISLNK(PL_statcache.st_mode))
     if (S_ISLNK(PL_statcache.st_mode))

-       RETPUSHYES;
-    RETPUSHNO;
+       FT_RETURNYES;
+    FT_RETURNNO;

 }
 
 PP(pp_fttty)
 {
 }
 
 PP(pp_fttty)
 {

-    dVAR;
-    dSP;

     int fd;
     GV *gv;
     int fd;
     GV *gv;

-    SV *tmpsv = NULL;

     char *name = NULL;
     STRLEN namelen;
     char *name = NULL;
     STRLEN namelen;

+    UV uv;

 
     tryAMAGICftest_MG('t');
 
 
     tryAMAGICftest_MG('t');
 

-    STACKED_FTEST_CHECK;
-

     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;

-    else if (!(gv = MAYBE_DEREF_GV_nomg(TOPs))) {
-       tmpsv = POPs;
+    else {
+      SV *tmpsv = *PL_stack_sp;
+      if (!(gv = MAYBE_DEREF_GV_nomg(tmpsv))) {

        name = SvPV_nomg(tmpsv, namelen);
        gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO);
        name = SvPV_nomg(tmpsv, namelen);
        gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO);

+      }

     }
 
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
        fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
     }
 
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
        fd = PerlIO_fileno(IoIFP(GvIOp(gv)));

-    else if (tmpsv && SvOK(tmpsv)) {
-       if (isDIGIT(*name))
-           fd = atoi(name);
-       else 
-           RETPUSHUNDEF;
-    }
+    else if (name && isDIGIT(*name) && grok_atoUV(name, &uv, NULL) && uv <= PERL_INT_MAX)
+        fd = (int)uv;

     else
     else

-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;
+    if (fd < 0) {
+        SETERRNO(EBADF,RMS_IFI);
+       FT_RETURNUNDEF;
+    }

     if (PerlLIO_isatty(fd))
     if (PerlLIO_isatty(fd))

-       RETPUSHYES;
-    RETPUSHNO;
+       FT_RETURNYES;
+    FT_RETURNNO;

 }
 
 }
 

-#if defined(atarist) /* this will work with atariST. Configure will
-                       make guesses for other systems. */
-# define FILE_base(f) ((f)->_base)
-# define FILE_ptr(f) ((f)->_ptr)
-# define FILE_cnt(f) ((f)->_cnt)
-# define FILE_bufsiz(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
-#endif
+
+/* also used for: pp_ftbinary() */

 
 PP(pp_fttext)
 {
 
 PP(pp_fttext)
 {

-    dVAR;
-    dSP;

     I32 i;
     I32 i;

-    I32 len;
+    SSize_t len;

     I32 odd = 0;
     STDCHAR tbuf[512];
     I32 odd = 0;
     STDCHAR tbuf[512];

-    register STDCHAR *s;
-    register IO *io;
-    register SV *sv;
+    STDCHAR *s;
+    IO *io;
+    SV *sv = NULL;

     GV *gv;
     PerlIO *fp;
 
     tryAMAGICftest_MG(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
 
     GV *gv;
     PerlIO *fp;
 
     tryAMAGICftest_MG(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
 

-    STACKED_FTEST_CHECK;
-

     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;

-    else gv = MAYBE_DEREF_GV_nomg(TOPs);
+    else if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
+            == OPpFT_STACKED)
+       gv = PL_defgv;
+    else {
+       sv = *PL_stack_sp;
+       gv = MAYBE_DEREF_GV_nomg(sv);
+    }

 
     if (gv) {
 
     if (gv) {

-       EXTEND(SP, 1);

        if (gv == PL_defgv) {
            if (PL_statgv)
        if (gv == PL_defgv) {
            if (PL_statgv)

-               io = GvIO(PL_statgv);
+               io = SvTYPE(PL_statgv) == SVt_PVIO
+                   ? (IO *)PL_statgv
+                   : GvIO(PL_statgv);

            else {
            else {

-               sv = PL_statname;

                goto really_filename;
            }
        }
        else {
            PL_statgv = gv;
                goto really_filename;
            }
        }
        else {
            PL_statgv = gv;

-           PL_laststatval = -1;

            sv_setpvs(PL_statname, "");
            io = GvIO(PL_statgv);
        }
            sv_setpvs(PL_statname, "");
            io = GvIO(PL_statgv);
        }

+       PL_laststatval = -1;
+       PL_laststype = OP_STAT;

        if (io && IoIFP(io)) {
        if (io && IoIFP(io)) {

+           int fd;

            if (! PerlIO_has_base(IoIFP(io)))
                DIE(aTHX_ "-T and -B not implemented on filehandles");
            if (! PerlIO_has_base(IoIFP(io)))
                DIE(aTHX_ "-T and -B not implemented on filehandles");

-           PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);
+           fd = PerlIO_fileno(IoIFP(io));
+           if (fd < 0) {
+                SETERRNO(EBADF,RMS_IFI);
+               FT_RETURNUNDEF;
+            }
+           PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);

            if (PL_laststatval < 0)
            if (PL_laststatval < 0)

-               RETPUSHUNDEF;
+               FT_RETURNUNDEF;

            if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */
                if (PL_op->op_type == OP_FTTEXT)
            if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */
                if (PL_op->op_type == OP_FTTEXT)

-                   RETPUSHNO;
+                   FT_RETURNNO;

                else
                else

-                   RETPUSHYES;
+                   FT_RETURNYES;

             }
            if (PerlIO_get_cnt(IoIFP(io)) <= 0) {
                i = PerlIO_getc(IoIFP(io));
                if (i != EOF)
                    (void)PerlIO_ungetc(IoIFP(io),i);
             }
            if (PerlIO_get_cnt(IoIFP(io)) <= 0) {
                i = PerlIO_getc(IoIFP(io));
                if (i != EOF)
                    (void)PerlIO_ungetc(IoIFP(io),i);

+                else
+                    /* null file is anything */
+                    FT_RETURNYES;

            }
            }

-           if (PerlIO_get_cnt(IoIFP(io)) <= 0) /* null file is anything */
-               RETPUSHYES;

            len = PerlIO_get_bufsiz(IoIFP(io));
            s = (STDCHAR *) PerlIO_get_base(IoIFP(io));
            /* sfio can have large buffers - limit to 512 */
            len = PerlIO_get_bufsiz(IoIFP(io));
            s = (STDCHAR *) PerlIO_get_base(IoIFP(io));
            /* sfio can have large buffers - limit to 512 */


@@ -3351,41 +3494,59 @@ PP(pp_fttext)
                len = 512;
        }
        else {
                len = 512;
        }
        else {

+           SETERRNO(EBADF,RMS_IFI);

            report_evil_fh(gv);
            SETERRNO(EBADF,RMS_IFI);
            report_evil_fh(gv);
            SETERRNO(EBADF,RMS_IFI);

-           RETPUSHUNDEF;
+           FT_RETURNUNDEF;

        }
     }
     else {
        }
     }
     else {

-       sv = POPs;
+        const char *file;
+        int fd; 
+
+        assert(sv);
+       sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));

       really_filename:
       really_filename:

+        file = SvPVX_const(PL_statname);

        PL_statgv = NULL;
        PL_statgv = NULL;

-       PL_laststype = OP_STAT;
-       sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
-       if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
-           if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
-                                              '\n'))
+       if (!(fp = PerlIO_open(file, "r"))) {
+           if (!gv) {
+               PL_laststatval = -1;
+               PL_laststype = OP_STAT;
+           }
+           if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) {
+                /* PL_warn_nl is constant */
+                GCC_DIAG_IGNORE(-Wformat-nonliteral);

                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");

-           RETPUSHUNDEF;
+                GCC_DIAG_RESTORE;
+            }
+           FT_RETURNUNDEF;

        }
        }

-       PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
+       PL_laststype = OP_STAT;
+        fd = PerlIO_fileno(fp);
+        if (fd < 0) {
+           (void)PerlIO_close(fp);
+            SETERRNO(EBADF,RMS_IFI);
+           FT_RETURNUNDEF;
+        }
+       PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);

        if (PL_laststatval < 0) {
            (void)PerlIO_close(fp);
        if (PL_laststatval < 0) {
            (void)PerlIO_close(fp);

-           RETPUSHUNDEF;
+            SETERRNO(EBADF,RMS_IFI);
+           FT_RETURNUNDEF;

        }
        PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
        len = PerlIO_read(fp, tbuf, sizeof(tbuf));
        (void)PerlIO_close(fp);
        if (len <= 0) {
            if (S_ISDIR(PL_statcache.st_mode) && PL_op->op_type == OP_FTTEXT)
        }
        PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
        len = PerlIO_read(fp, tbuf, sizeof(tbuf));
        (void)PerlIO_close(fp);
        if (len <= 0) {
            if (S_ISDIR(PL_statcache.st_mode) && PL_op->op_type == OP_FTTEXT)

-               RETPUSHNO;              /* special case NFS directories */
-           RETPUSHYES;         /* null file is anything */
+               FT_RETURNNO;            /* special case NFS directories */
+           FT_RETURNYES;               /* null file is anything */

        }
        s = tbuf;
     }
 
     /* now scan s to look for textiness */
        }
        s = tbuf;
     }
 
     /* now scan s to look for textiness */

-    /*   XXX ASCII dependent code */

 
 #if defined(DOSISH) || defined(USEMYBINMODE)
     /* ignore trailing ^Z on short files */
 
 #if defined(DOSISH) || defined(USEMYBINMODE)
     /* ignore trailing ^Z on short files */


@@ -3393,56 +3554,66 @@ PP(pp_fttext)
        --len;
 #endif
 
        --len;
 #endif
 

+    assert(len);
+    if (! is_invariant_string((U8 *) s, len)) {
+        const U8 *ep;
+
+        /* Here contains a variant under UTF-8 .  See if the entire string is
+         * UTF-8.  But the buffer may end in a partial character, so consider
+         * it UTF-8 if the first non-UTF8 char is an ending partial */
+        if (is_utf8_string_loc((U8 *) s, len, &ep)
+            || ep + UTF8SKIP(ep)  > (U8 *) (s + len))
+        {
+            if (PL_op->op_type == OP_FTTEXT) {
+                FT_RETURNYES;
+            }
+            else {
+                FT_RETURNNO;
+            }
+        }
+    }
+
+    /* Here, is not UTF-8 or is entirely ASCII.  Look through the buffer for
+     * things that wouldn't be in ASCII text or rich ASCII text.  Count these
+     * in 'odd' */

     for (i = 0; i < len; i++, s++) {
        if (!*s) {                      /* null never allowed in text */
            odd += len;
            break;
        }
     for (i = 0; i < len; i++, s++) {
        if (!*s) {                      /* null never allowed in text */
            odd += len;
            break;
        }

-#ifdef EBCDIC
-        else if (!(isPRINT(*s) || isSPACE(*s)))
-            odd++;
-#else
-       else if (*s & 128) {
-#ifdef USE_LOCALE
-           if (IN_LOCALE_RUNTIME && isALPHA_LC(*s))
+#ifdef USE_LOCALE_CTYPE
+        if (IN_LC_RUNTIME(LC_CTYPE)) {
+            if ( isPRINT_LC(*s) || isSPACE_LC(*s)) {

                continue;
                continue;

+            }
+        }
+        else

 #endif
 #endif

-           /* utf8 characters don't count as odd */
-           if (UTF8_IS_START(*s)) {
-               int ulen = UTF8SKIP(s);
-               if (ulen < len - i) {
-                   int j;
-                   for (j = 1; j < ulen; j++) {
-                       if (!UTF8_IS_CONTINUATION(s[j]))
-                           goto not_utf8;
-                   }
-                   --ulen;     /* loop does extra increment */
-                   s += ulen;
-                   i += ulen;
-                   continue;
-               }
-           }
-         not_utf8:
-           odd++;
-       }
-       else if (*s < 32 &&
-         *s != '\n' && *s != '\r' && *s != '\b' &&
-         *s != '\t' && *s != '\f' && *s != 27)
-           odd++;
-#endif
+        if (isPRINT_A(*s)
+                   /* VT occurs so rarely in text, that we consider it odd */
+                || (isSPACE_A(*s) && *s != VT_NATIVE)
+
+                    /* But there is a fair amount of backspaces and escapes in
+                     * some text */
+                || *s == '\b'
+                || *s == ESC_NATIVE)
+        {
+            continue;
+        }
+        odd++;

     }
 
     if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
     }
 
     if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */

-       RETPUSHNO;
+       FT_RETURNNO;

     else
     else

-       RETPUSHYES;
+       FT_RETURNYES;

 }
 
 /* File calls. */
 
 PP(pp_chdir)
 {
 }
 
 /* File calls. */
 
 PP(pp_chdir)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     const char *tmps = NULL;
     GV *gv = NULL;
 
     const char *tmps = NULL;
     GV *gv = NULL;
 


@@ -3450,12 +3621,21 @@ PP(pp_chdir)
        SV * const sv = POPs;
        if (PL_op->op_flags & OPf_SPECIAL) {
            gv = gv_fetchsv(sv, 0, SVt_PVIO);
        SV * const sv = POPs;
        if (PL_op->op_flags & OPf_SPECIAL) {
            gv = gv_fetchsv(sv, 0, SVt_PVIO);

+            if (!gv) {
+                if (ckWARN(WARN_UNOPENED)) {
+                    Perl_warner(aTHX_ packWARN(WARN_UNOPENED),
+                                "chdir() on unopened filehandle %" SVf, sv);
+                }
+                SETERRNO(EBADF,RMS_IFI);
+                PUSHi(0);
+                TAINT_PROPER("chdir");
+                RETURN;
+            }

        }
         else if (!(gv = MAYBE_DEREF_GV(sv)))
                tmps = SvPV_nomg_const_nolen(sv);
     }
        }
         else if (!(gv = MAYBE_DEREF_GV(sv)))
                tmps = SvPV_nomg_const_nolen(sv);
     }

-
-    if( !gv && (!tmps || !*tmps) ) {
+    else {

        HV * const table = GvHVn(PL_envgv);
        SV **svp;
 
        HV * const table = GvHVn(PL_envgv);
        SV **svp;
 


@@ -3466,12 +3646,11 @@ PP(pp_chdir)
 #endif
            )
         {
 #endif
            )
         {

-            if( MAXARG == 1 )
-                deprecate("chdir('') or chdir(undef) as chdir()");

             tmps = SvPV_nolen_const(*svp);
         }
         else {
             PUSHi(0);
             tmps = SvPV_nolen_const(*svp);
         }
         else {
             PUSHi(0);

+            SETERRNO(EINVAL, LIB_INVARG);

             TAINT_PROPER("chdir");
             RETURN;
         }
             TAINT_PROPER("chdir");
             RETURN;
         }


@@ -3485,19 +3664,19 @@ PP(pp_chdir)
            if (IoDIRP(io)) {
                PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0);
            } else if (IoIFP(io)) {
            if (IoDIRP(io)) {
                PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0);
            } else if (IoIFP(io)) {

-                PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
+                int fd = PerlIO_fileno(IoIFP(io));
+                if (fd < 0) {
+                    goto nuts;
+                }
+                PUSHi(fchdir(fd) >= 0);

            }
            else {
            }
            else {

-               report_evil_fh(gv);
-               SETERRNO(EBADF, RMS_IFI);
-               PUSHi(0);
+                goto nuts;

            }
            }

+        } else {
+            goto nuts;

         }
         }

-       else {
-           report_evil_fh(gv);
-           SETERRNO(EBADF,RMS_IFI);
-           PUSHi(0);
-       }
+

 #else
        DIE(aTHX_ PL_no_func, "fchdir");
 #endif
 #else
        DIE(aTHX_ PL_no_func, "fchdir");
 #endif


@@ -3510,11 +3689,22 @@ PP(pp_chdir)
     hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD);
 #endif
     RETURN;
     hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD);
 #endif
     RETURN;

+
+#ifdef HAS_FCHDIR
+ nuts:
+    report_evil_fh(gv);
+    SETERRNO(EBADF,RMS_IFI);
+    PUSHi(0);
+    RETURN;
+#endif

 }
 
 }
 

+
+/* also used for: pp_chmod() pp_kill() pp_unlink() pp_utime() */
+

 PP(pp_chown)
 {
 PP(pp_chown)
 {

-    dVAR; dSP; dMARK; dTARGET;
+    dSP; dMARK; dTARGET;

     const I32 value = (I32)apply(PL_op->op_type, MARK, SP);
 
     SP = MARK;
     const I32 value = (I32)apply(PL_op->op_type, MARK, SP);
 
     SP = MARK;


@@ -3525,7 +3715,7 @@ PP(pp_chown)
 PP(pp_chroot)
 {
 #ifdef HAS_CHROOT
 PP(pp_chroot)
 {
 #ifdef HAS_CHROOT

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     char * const tmps = POPpx;
     TAINT_PROPER("chroot");
     PUSHi( chroot(tmps) >= 0 );
     char * const tmps = POPpx;
     TAINT_PROPER("chroot");
     PUSHi( chroot(tmps) >= 0 );


@@ -3537,19 +3727,22 @@ PP(pp_chroot)
 
 PP(pp_rename)
 {
 
 PP(pp_rename)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     int anum;
     int anum;

+#ifndef HAS_RENAME
+    Stat_t statbuf;
+#endif

     const char * const tmps2 = POPpconstx;
     const char * const tmps = SvPV_nolen_const(TOPs);
     TAINT_PROPER("rename");
 #ifdef HAS_RENAME
     anum = PerlLIO_rename(tmps, tmps2);
 #else
     const char * const tmps2 = POPpconstx;
     const char * const tmps = SvPV_nolen_const(TOPs);
     TAINT_PROPER("rename");
 #ifdef HAS_RENAME
     anum = PerlLIO_rename(tmps, tmps2);
 #else

-    if (!(anum = PerlLIO_stat(tmps, &PL_statbuf))) {
+    if (!(anum = PerlLIO_stat(tmps, &statbuf))) {

        if (same_dirent(tmps2, tmps))   /* can always rename to same name */
            anum = 1;
        else {
        if (same_dirent(tmps2, tmps))   /* can always rename to same name */
            anum = 1;
        else {

-           if (PL_euid || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode))
+           if (PerlProc_geteuid() || PerlLIO_stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))

                (void)UNLINK(tmps2);
            if (!(anum = link(tmps, tmps2)))
                anum = UNLINK(tmps);
                (void)UNLINK(tmps2);
            if (!(anum = link(tmps, tmps2)))
                anum = UNLINK(tmps);


@@ -3560,10 +3753,13 @@ PP(pp_rename)
     RETURN;
 }
 
     RETURN;
 }
 

+
+/* also used for: pp_symlink() */
+

 #if defined(HAS_LINK) || defined(HAS_SYMLINK)
 PP(pp_link)
 {
 #if defined(HAS_LINK) || defined(HAS_SYMLINK)
 PP(pp_link)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     const int op_type = PL_op->op_type;
     int result;
 
     const int op_type = PL_op->op_type;
     int result;
 


@@ -3602,6 +3798,9 @@ PP(pp_link)
     RETURN;
 }
 #else
     RETURN;
 }
 #else

+
+/* also used for: pp_symlink() */
+

 PP(pp_link)
 {
     /* Have neither.  */
 PP(pp_link)
 {
     /* Have neither.  */


@@ -3611,21 +3810,22 @@ PP(pp_link)
 
 PP(pp_readlink)
 {
 
 PP(pp_readlink)
 {

-    dVAR;

     dSP;
 #ifdef HAS_SYMLINK
     dTARGET;
     const char *tmps;
     char buf[MAXPATHLEN];
     dSP;
 #ifdef HAS_SYMLINK
     dTARGET;
     const char *tmps;
     char buf[MAXPATHLEN];

-    int len;
+    SSize_t len;

 
 

-#ifndef INCOMPLETE_TAINTS

     TAINT;
     TAINT;

-#endif

     tmps = POPpconstx;
     tmps = POPpconstx;

+    /* NOTE: if the length returned by readlink() is sizeof(buf) - 1,
+     * it is impossible to know whether the result was truncated. */

     len = readlink(tmps, buf, sizeof(buf) - 1);
     if (len < 0)
        RETPUSHUNDEF;
     len = readlink(tmps, buf, sizeof(buf) - 1);
     if (len < 0)
        RETPUSHUNDEF;

+    if (len != -1)
+        buf[len] = '\0';

     PUSHp(buf, len);
     RETURN;
 #else
     PUSHp(buf, len);
     RETURN;
 #else


@@ -3673,13 +3873,7 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename)
                 ; e++)
            {
                /* you don't see this */
                 ; e++)
            {
                /* you don't see this */

-               const char * const errmsg =
-#ifdef HAS_SYS_ERRLIST
-                   sys_errlist[e]
-#else
-                   strerror(e)
-#endif
-                   ;
+               const char * const errmsg = Strerror(e) ;

                if (!errmsg)
                    break;
                if (instr(s, errmsg)) {
                if (!errmsg)
                    break;
                if (instr(s, errmsg)) {


@@ -3710,7 +3904,8 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename)
            return 0;
        }
        else {  /* some mkdirs return no failure indication */
            return 0;
        }
        else {  /* some mkdirs return no failure indication */

-           anum = (PerlLIO_stat(save_filename, &PL_statbuf) >= 0);
+           Stat_t statbuf;
+           anum = (PerlLIO_stat(save_filename, &statbuf) >= 0);

            if (PL_op->op_type == OP_RMDIR)
                anum = !anum;
            if (anum)
            if (PL_op->op_type == OP_RMDIR)
                anum = !anum;
            if (anum)


@@ -3747,11 +3942,11 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename)
 
 PP(pp_mkdir)
 {
 
 PP(pp_mkdir)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     STRLEN len;
     const char *tmps;
     bool copy = FALSE;
     STRLEN len;
     const char *tmps;
     bool copy = FALSE;

-    const int mode = (MAXARG > 1 && (TOPs||((void)POPs,0))) ? POPi : 0777;
+    const unsigned int mode = (MAXARG > 1 && (TOPs||((void)POPs,0))) ? POPu : 0777;

 
     TRIMSLASHES(tmps,len,copy);
 
 
     TRIMSLASHES(tmps,len,copy);
 


@@ -3774,7 +3969,7 @@ PP(pp_mkdir)
 
 PP(pp_rmdir)
 {
 
 PP(pp_rmdir)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     STRLEN len;
     const char *tmps;
     bool copy = FALSE;
     STRLEN len;
     const char *tmps;
     bool copy = FALSE;


@@ -3796,13 +3991,10 @@ PP(pp_rmdir)
 PP(pp_open_dir)
 {
 #if defined(Direntry_t) && defined(HAS_READDIR)
 PP(pp_open_dir)
 {
 #if defined(Direntry_t) && defined(HAS_READDIR)

-    dVAR; dSP;
+    dSP;

     const char * const dirname = POPpconstx;
     GV * const gv = MUTABLE_GV(POPs);
     const char * const dirname = POPpconstx;
     GV * const gv = MUTABLE_GV(POPs);

-    register IO * const io = GvIOn(gv);
-
-    if (!io)
-       goto nope;
+    IO * const io = GvIOn(gv);

 
     if ((IoIFP(io) || IoOFP(io)))
        Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
 
     if ((IoIFP(io) || IoOFP(io)))
        Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),


@@ -3814,7 +4006,7 @@ PP(pp_open_dir)
        goto nope;
 
     RETPUSHYES;
        goto nope;
 
     RETPUSHYES;

-nope:
+  nope:

     if (!errno)
        SETERRNO(EBADF,RMS_DIR);
     RETPUSHUNDEF;
     if (!errno)
        SETERRNO(EBADF,RMS_DIR);
     RETPUSHUNDEF;


@@ -3831,16 +4023,15 @@ PP(pp_readdir)
 #if !defined(I_DIRENT) && !defined(VMS)
     Direntry_t *readdir (DIR *);
 #endif
 #if !defined(I_DIRENT) && !defined(VMS)
     Direntry_t *readdir (DIR *);
 #endif

-    dVAR;

     dSP;
 
     SV *sv;
     dSP;
 
     SV *sv;

-    const I32 gimme = GIMME;
+    const U8 gimme = GIMME_V;

     GV * const gv = MUTABLE_GV(POPs);
     GV * const gv = MUTABLE_GV(POPs);

-    register const Direntry_t *dp;
-    register IO * const io = GvIOn(gv);
+    const Direntry_t *dp;
+    IO * const io = GvIOn(gv);

 
 

-    if (!io || !IoDIRP(io)) {
+    if (!IoDIRP(io)) {

        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
                       "readdir() attempted on invalid dirhandle %"HEKf,
                             HEKfARG(GvENAME_HEK(gv)));
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
                       "readdir() attempted on invalid dirhandle %"HEKf,
                             HEKfARG(GvENAME_HEK(gv)));


@@ -3856,22 +4047,20 @@ PP(pp_readdir)
 #else
         sv = newSVpv(dp->d_name, 0);
 #endif
 #else
         sv = newSVpv(dp->d_name, 0);
 #endif

-#ifndef INCOMPLETE_TAINTS

         if (!(IoFLAGS(io) & IOf_UNTAINT))
             SvTAINTED_on(sv);
         if (!(IoFLAGS(io) & IOf_UNTAINT))
             SvTAINTED_on(sv);

-#endif

         mXPUSHs(sv);
     } while (gimme == G_ARRAY);
 
     if (!dp && gimme != G_ARRAY)
         mXPUSHs(sv);
     } while (gimme == G_ARRAY);
 
     if (!dp && gimme != G_ARRAY)

-        goto nope;
+        RETPUSHUNDEF;

 
     RETURN;
 
 
     RETURN;
 

-nope:
+  nope:

     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);

-    if (GIMME == G_ARRAY)
+    if (gimme == G_ARRAY)

        RETURN;
     else
        RETPUSHUNDEF;
        RETURN;
     else
        RETPUSHUNDEF;


@@ -3881,7 +4070,7 @@ nope:
 PP(pp_telldir)
 {
 #if defined(HAS_TELLDIR) || defined(telldir)
 PP(pp_telldir)
 {
 #if defined(HAS_TELLDIR) || defined(telldir)

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

  /* XXX does _anyone_ need this? --AD 2/20/1998 */
  /* XXX netbsd still seemed to.
     XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style.
  /* XXX does _anyone_ need this? --AD 2/20/1998 */
  /* XXX netbsd still seemed to.
     XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style.


@@ -3890,9 +4079,9 @@ PP(pp_telldir)
     long telldir (DIR *);
 # endif
     GV * const gv = MUTABLE_GV(POPs);
     long telldir (DIR *);
 # endif
     GV * const gv = MUTABLE_GV(POPs);

-    register IO * const io = GvIOn(gv);
+    IO * const io = GvIOn(gv);

 
 

-    if (!io || !IoDIRP(io)) {
+    if (!IoDIRP(io)) {

        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
                       "telldir() attempted on invalid dirhandle %"HEKf,
                             HEKfARG(GvENAME_HEK(gv)));
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
                       "telldir() attempted on invalid dirhandle %"HEKf,
                             HEKfARG(GvENAME_HEK(gv)));


@@ -3901,7 +4090,7 @@ PP(pp_telldir)
 
     PUSHi( PerlDir_tell(IoDIRP(io)) );
     RETURN;
 
     PUSHi( PerlDir_tell(IoDIRP(io)) );
     RETURN;

-nope:
+  nope:

     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;


@@ -3913,12 +4102,12 @@ nope:
 PP(pp_seekdir)
 {
 #if defined(HAS_SEEKDIR) || defined(seekdir)
 PP(pp_seekdir)
 {
 #if defined(HAS_SEEKDIR) || defined(seekdir)

-    dVAR; dSP;
+    dSP;

     const long along = POPl;
     GV * const gv = MUTABLE_GV(POPs);
     const long along = POPl;
     GV * const gv = MUTABLE_GV(POPs);

-    register IO * const io = GvIOn(gv);
+    IO * const io = GvIOn(gv);

 
 

-    if (!io || !IoDIRP(io)) {
+    if (!IoDIRP(io)) {

        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
                       "seekdir() attempted on invalid dirhandle %"HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
                       "seekdir() attempted on invalid dirhandle %"HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));


@@ -3927,7 +4116,7 @@ PP(pp_seekdir)
     (void)PerlDir_seek(IoDIRP(io), along);
 
     RETPUSHYES;
     (void)PerlDir_seek(IoDIRP(io), along);
 
     RETPUSHYES;

-nope:
+  nope:

     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;


@@ -3939,11 +4128,11 @@ nope:
 PP(pp_rewinddir)
 {
 #if defined(HAS_REWINDDIR) || defined(rewinddir)
 PP(pp_rewinddir)
 {
 #if defined(HAS_REWINDDIR) || defined(rewinddir)

-    dVAR; dSP;
+    dSP;

     GV * const gv = MUTABLE_GV(POPs);
     GV * const gv = MUTABLE_GV(POPs);

-    register IO * const io = GvIOn(gv);
+    IO * const io = GvIOn(gv);

 
 

-    if (!io || !IoDIRP(io)) {
+    if (!IoDIRP(io)) {

        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
                       "rewinddir() attempted on invalid dirhandle %"HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
                       "rewinddir() attempted on invalid dirhandle %"HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));


@@ -3951,7 +4140,7 @@ PP(pp_rewinddir)
     }
     (void)PerlDir_rewind(IoDIRP(io));
     RETPUSHYES;
     }
     (void)PerlDir_rewind(IoDIRP(io));
     RETPUSHYES;

-nope:
+  nope:

     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;


@@ -3963,11 +4152,11 @@ nope:
 PP(pp_closedir)
 {
 #if defined(Direntry_t) && defined(HAS_READDIR)
 PP(pp_closedir)
 {
 #if defined(Direntry_t) && defined(HAS_READDIR)

-    dVAR; dSP;
+    dSP;

     GV * const gv = MUTABLE_GV(POPs);
     GV * const gv = MUTABLE_GV(POPs);

-    register IO * const io = GvIOn(gv);
+    IO * const io = GvIOn(gv);

 
 

-    if (!io || !IoDIRP(io)) {
+    if (!IoDIRP(io)) {

        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
                       "closedir() attempted on invalid dirhandle %"HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
                       "closedir() attempted on invalid dirhandle %"HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));


@@ -3984,7 +4173,7 @@ PP(pp_closedir)
     IoDIRP(io) = 0;
 
     RETPUSHYES;
     IoDIRP(io) = 0;
 
     RETPUSHYES;

-nope:
+  nope:

     if (!errno)
        SETERRNO(EBADF,RMS_IFI);
     RETPUSHUNDEF;
     if (!errno)
        SETERRNO(EBADF,RMS_IFI);
     RETPUSHUNDEF;


@@ -3998,18 +4187,36 @@ nope:
 PP(pp_fork)
 {
 #ifdef HAS_FORK
 PP(pp_fork)
 {
 #ifdef HAS_FORK

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     Pid_t childpid;
     Pid_t childpid;

+#ifdef HAS_SIGPROCMASK
+    sigset_t oldmask, newmask;
+#endif

 
     EXTEND(SP, 1);
     PERL_FLUSHALL_FOR_CHILD;
 
     EXTEND(SP, 1);
     PERL_FLUSHALL_FOR_CHILD;

+#ifdef HAS_SIGPROCMASK
+    sigfillset(&newmask);
+    sigprocmask(SIG_SETMASK, &newmask, &oldmask);
+#endif

     childpid = PerlProc_fork();
     childpid = PerlProc_fork();

+    if (childpid == 0) {
+       int sig;
+       PL_sig_pending = 0;
+       if (PL_psig_pend)
+           for (sig = 1; sig < SIG_SIZE; sig++)
+               PL_psig_pend[sig] = 0;
+    }
+#ifdef HAS_SIGPROCMASK
+    {
+       dSAVE_ERRNO;
+       sigprocmask(SIG_SETMASK, &oldmask, NULL);
+       RESTORE_ERRNO;
+    }
+#endif

     if (childpid < 0)
     if (childpid < 0)

-       RETSETUNDEF;
+       RETPUSHUNDEF;

     if (!childpid) {
     if (!childpid) {

-#ifdef THREADS_HAVE_PIDS
-       PL_ppid = (IV)getppid();
-#endif

 #ifdef PERL_USES_PL_PIDSTATUS
        hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
 #endif
 #ifdef PERL_USES_PL_PIDSTATUS
        hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
 #endif


@@ -4017,7 +4224,7 @@ PP(pp_fork)
     PUSHi(childpid);
     RETURN;
 #else
     PUSHi(childpid);
     RETURN;
 #else

-#  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+#  if (defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)) || defined(__amigaos4__)

     dSP; dTARGET;
     Pid_t childpid;
 
     dSP; dTARGET;
     Pid_t childpid;
 


@@ -4025,7 +4232,7 @@ PP(pp_fork)
     PERL_FLUSHALL_FOR_CHILD;
     childpid = PerlProc_fork();
     if (childpid == -1)
     PERL_FLUSHALL_FOR_CHILD;
     childpid = PerlProc_fork();
     if (childpid == -1)

-       RETSETUNDEF;
+       RETPUSHUNDEF;

     PUSHi(childpid);
     RETURN;
 #  else
     PUSHi(childpid);
     RETURN;
 #  else


@@ -4037,7 +4244,7 @@ PP(pp_fork)
 PP(pp_wait)
 {
 #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)
 PP(pp_wait)
 {
 #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     Pid_t childpid;
     int argflags;
 
     Pid_t childpid;
     int argflags;
 


@@ -4065,10 +4272,16 @@ PP(pp_wait)
 PP(pp_waitpid)
 {
 #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)
 PP(pp_waitpid)
 {
 #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     const int optype = POPi;
     const Pid_t pid = TOPi;
     Pid_t result;
     const int optype = POPi;
     const Pid_t pid = TOPi;
     Pid_t result;

+#ifdef __amigaos4__
+    int argflags = 0;
+    result = amigaos_waitpid(aTHX_ optype, pid, &argflags);
+    STATUS_NATIVE_CHILD_SET((result >= 0) ? argflags : -1);
+    result = result == 0 ? pid : -1;
+#else

     int argflags;
 
     if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
     int argflags;
 
     if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)


@@ -4085,6 +4298,7 @@ PP(pp_waitpid)
 #  else
     STATUS_NATIVE_CHILD_SET((result > 0) ? argflags : -1);
 #  endif
 #  else
     STATUS_NATIVE_CHILD_SET((result > 0) ? argflags : -1);
 #  endif

+# endif /* __amigaos4__ */

     SETi(result);
     RETURN;
 #else
     SETi(result);
     RETURN;
 #else


@@ -4094,38 +4308,58 @@ PP(pp_waitpid)
 
 PP(pp_system)
 {
 
 PP(pp_system)
 {

-    dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+    dSP; dMARK; dORIGMARK; dTARGET;

 #if defined(__LIBCATAMOUNT__)
     PL_statusvalue = -1;
     SP = ORIGMARK;
     XPUSHi(-1);
 #else
     I32 value;
 #if defined(__LIBCATAMOUNT__)
     PL_statusvalue = -1;
     SP = ORIGMARK;
     XPUSHi(-1);
 #else
     I32 value;

+# ifdef __amigaos4__
+    void * result;
+# else

     int result;
     int result;

+# endif

 
 

-    if (PL_tainting) {
+    if (TAINTING_get) {

        TAINT_ENV();
        while (++MARK <= SP) {
            (void)SvPV_nolen_const(*MARK);      /* stringify for taint check */
        TAINT_ENV();
        while (++MARK <= SP) {
            (void)SvPV_nolen_const(*MARK);      /* stringify for taint check */

-           if (PL_tainted)
+           if (TAINT_get)

                break;
        }
        MARK = ORIGMARK;
        TAINT_PROPER("system");
     }
     PERL_FLUSHALL_FOR_CHILD;
                break;
        }
        MARK = ORIGMARK;
        TAINT_PROPER("system");
     }
     PERL_FLUSHALL_FOR_CHILD;

-#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)
+#if (defined(HAS_FORK) || defined(__amigaos4__)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)

     {
     {

+#ifdef __amigaos4__
+        struct UserData userdata;
+        pthread_t proc;
+#else

        Pid_t childpid;
        Pid_t childpid;

+#endif

        int pp[2];
        I32 did_pipes = 0;
        int pp[2];
        I32 did_pipes = 0;

-#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+        bool child_success = FALSE;
+#ifdef HAS_SIGPROCMASK

        sigset_t newset, oldset;
 #endif
 
        if (PerlProc_pipe(pp) >= 0)
            did_pipes = 1;
        sigset_t newset, oldset;
 #endif
 
        if (PerlProc_pipe(pp) >= 0)
            did_pipes = 1;

-#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+#ifdef __amigaos4__
+        amigaos_fork_set_userdata(aTHX_
+                                  &userdata,
+                                  did_pipes,
+                                  pp[1],
+                                  SP,
+                                  mark);
+        pthread_create(&proc,NULL,amigaos_system_child,(void *)&userdata);
+        child_success = proc > 0;
+#else
+#ifdef HAS_SIGPROCMASK

        sigemptyset(&newset);
        sigaddset(&newset, SIGCHLD);
        sigprocmask(SIG_BLOCK, &newset, &oldset);
        sigemptyset(&newset);
        sigaddset(&newset, SIGCHLD);
        sigprocmask(SIG_BLOCK, &newset, &oldset);


@@ -4139,26 +4373,34 @@ PP(pp_system)
                    PerlLIO_close(pp[0]);
                    PerlLIO_close(pp[1]);
                }
                    PerlLIO_close(pp[0]);
                    PerlLIO_close(pp[1]);
                }

-#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+#ifdef HAS_SIGPROCMASK

                sigprocmask(SIG_SETMASK, &oldset, NULL);
 #endif
                RETURN;
            }
            sleep(5);
        }
                sigprocmask(SIG_SETMASK, &oldset, NULL);
 #endif
                RETURN;
            }
            sleep(5);
        }

-       if (childpid > 0) {
+        child_success = childpid > 0;
+#endif
+       if (child_success) {

            Sigsave_t ihand,qhand; /* place to save signals during system() */
            int status;
 
            Sigsave_t ihand,qhand; /* place to save signals during system() */
            int status;
 

+#ifndef __amigaos4__

            if (did_pipes)
                PerlLIO_close(pp[1]);
            if (did_pipes)
                PerlLIO_close(pp[1]);

+#endif

 #ifndef PERL_MICRO
            rsignal_save(SIGINT,  (Sighandler_t) SIG_IGN, &ihand);
            rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
 #endif
 #ifndef PERL_MICRO
            rsignal_save(SIGINT,  (Sighandler_t) SIG_IGN, &ihand);
            rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
 #endif

+#ifdef __amigaos4__
+            result = pthread_join(proc, (void **)&status);
+#else

            do {
                result = wait4pid(childpid, &status, 0);
            } while (result == -1 && errno == EINTR);
            do {
                result = wait4pid(childpid, &status, 0);
            } while (result == -1 && errno == EINTR);

+#endif

 #ifndef PERL_MICRO
 #ifdef HAS_SIGPROCMASK
            sigprocmask(SIG_SETMASK, &oldset, NULL);
 #ifndef PERL_MICRO
 #ifdef HAS_SIGPROCMASK
            sigprocmask(SIG_SETMASK, &oldset, NULL);


@@ -4185,21 +4427,30 @@ PP(pp_system)
                PerlLIO_close(pp[0]);
                if (n) {                        /* Error */
                    if (n != sizeof(int))
                PerlLIO_close(pp[0]);
                if (n) {                        /* Error */
                    if (n != sizeof(int))

-                       DIE(aTHX_ "panic: kid popen errno read");
+                       DIE(aTHX_ "panic: kid popen errno read, n=%u", n);

                    errno = errkid;             /* Propagate errno from kid */
                    errno = errkid;             /* Propagate errno from kid */

-                   STATUS_NATIVE_CHILD_SET(-1);
+#ifdef __amigaos4__
+                    /* The pipe always has something in it
+                     * so n alone is not enough. */
+                    if (errno > 0)
+#endif
+                    {
+                        STATUS_NATIVE_CHILD_SET(-1);
+                    }

                }
            }
            XPUSHi(STATUS_CURRENT);
            RETURN;
        }
                }
            }
            XPUSHi(STATUS_CURRENT);
            RETURN;
        }

-#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+#ifndef __amigaos4__
+#ifdef HAS_SIGPROCMASK

        sigprocmask(SIG_SETMASK, &oldset, NULL);
 #endif
        if (did_pipes) {
            PerlLIO_close(pp[0]);
        sigprocmask(SIG_SETMASK, &oldset, NULL);
 #endif
        if (did_pipes) {
            PerlLIO_close(pp[0]);

-#if defined(HAS_FCNTL) && defined(F_SETFD)
-           fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+           if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
+                RETPUSHUNDEF;

 #endif
        }
        if (PL_op->op_flags & OPf_STACKED) {
 #endif
        }
        if (PL_op->op_flags & OPf_STACKED) {


@@ -4211,6 +4462,7 @@ PP(pp_system)
        else {
            value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes);
        }
        else {
            value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes);
        }

+#endif /* __amigaos4__ */

        PerlProc__exit(-1);
     }
 #else /* ! FORK or VMS or OS/2 */
        PerlProc__exit(-1);
     }
 #else /* ! FORK or VMS or OS/2 */


@@ -4247,19 +4499,20 @@ PP(pp_system)
 
 PP(pp_exec)
 {
 
 PP(pp_exec)
 {

-    dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+    dSP; dMARK; dORIGMARK; dTARGET;

     I32 value;
 
     I32 value;
 

-    if (PL_tainting) {
+    if (TAINTING_get) {

        TAINT_ENV();
        while (++MARK <= SP) {
            (void)SvPV_nolen_const(*MARK);      /* stringify for taint check */
        TAINT_ENV();
        while (++MARK <= SP) {
            (void)SvPV_nolen_const(*MARK);      /* stringify for taint check */

-           if (PL_tainted)
+           if (TAINT_get)

                break;
        }
        MARK = ORIGMARK;
        TAINT_PROPER("exec");
     }
                break;
        }
        MARK = ORIGMARK;
        TAINT_PROPER("exec");
     }

+

     PERL_FLUSHALL_FOR_CHILD;
     if (PL_op->op_flags & OPf_STACKED) {
        SV * const really = *++MARK;
     PERL_FLUSHALL_FOR_CHILD;
     if (PL_op->op_flags & OPf_STACKED) {
        SV * const really = *++MARK;


@@ -4269,28 +4522,15 @@ PP(pp_exec)
 #ifdef VMS
        value = (I32)vms_do_aexec(NULL, MARK, SP);
 #else
 #ifdef VMS
        value = (I32)vms_do_aexec(NULL, MARK, SP);
 #else

-#  ifdef __OPEN_VM
-       {
-          (void ) do_aspawn(NULL, MARK, SP);
-          value = 0;
-       }
-#  else

        value = (I32)do_aexec(NULL, MARK, SP);
        value = (I32)do_aexec(NULL, MARK, SP);

-#  endif

 #endif
     else {
 #ifdef VMS
        value = (I32)vms_do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
 #else
 #endif
     else {
 #ifdef VMS
        value = (I32)vms_do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
 #else

-#  ifdef __OPEN_VM
-       (void) do_spawn(SvPVx_nolen(sv_mortalcopy(*SP)));
-       value = 0;
-#  else

        value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
        value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));

-#  endif

 #endif
     }
 #endif
     }

-

     SP = ORIGMARK;
     XPUSHi(value);
     RETURN;
     SP = ORIGMARK;
     XPUSHi(value);
     RETURN;


@@ -4299,15 +4539,8 @@ PP(pp_exec)
 PP(pp_getppid)
 {
 #ifdef HAS_GETPPID
 PP(pp_getppid)
 {
 #ifdef HAS_GETPPID

-    dVAR; dSP; dTARGET;
-#   ifdef THREADS_HAVE_PIDS
-    if (PL_ppid != 1 && getppid() == 1)
-       /* maybe the parent process has died. Refresh ppid cache */
-       PL_ppid = 1;
-    XPUSHi( PL_ppid );
-#   else
+    dSP; dTARGET;

     XPUSHi( getppid() );
     XPUSHi( getppid() );

-#   endif

     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getppid");
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getppid");


@@ -4317,7 +4550,7 @@ PP(pp_getppid)
 PP(pp_getpgrp)
 {
 #ifdef HAS_GETPGRP
 PP(pp_getpgrp)
 {
 #ifdef HAS_GETPGRP

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     Pid_t pgrp;
     const Pid_t pid =
        (MAXARG < 1) ? 0 : TOPs ? SvIVx(POPs) : ((void)POPs, 0);
     Pid_t pgrp;
     const Pid_t pid =
        (MAXARG < 1) ? 0 : TOPs ? SvIVx(POPs) : ((void)POPs, 0);


@@ -4332,21 +4565,22 @@ PP(pp_getpgrp)
     XPUSHi(pgrp);
     RETURN;
 #else
     XPUSHi(pgrp);
     RETURN;
 #else

-    DIE(aTHX_ PL_no_func, "getpgrp()");
+    DIE(aTHX_ PL_no_func, "getpgrp");

 #endif
 }
 
 PP(pp_setpgrp)
 {
 #ifdef HAS_SETPGRP
 #endif
 }
 
 PP(pp_setpgrp)
 {
 #ifdef HAS_SETPGRP

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     Pid_t pgrp;
     Pid_t pid;
     pgrp = MAXARG == 2 && (TOPs||POPs) ? POPi : 0;
     Pid_t pgrp;
     Pid_t pid;
     pgrp = MAXARG == 2 && (TOPs||POPs) ? POPi : 0;

-    if (MAXARG > 0) pid = TOPs && TOPi;
+    if (MAXARG > 0) pid = TOPs ? TOPi : 0;

     else {
        pid = 0;
     else {
        pid = 0;

-       XPUSHi(-1);
+       EXTEND(SP,1);
+       SP++;

     }
 
     TAINT_PROPER("setpgrp");
     }
 
     TAINT_PROPER("setpgrp");


@@ -4362,7 +4596,7 @@ PP(pp_setpgrp)
 #endif /* USE_BSDPGRP */
     RETURN;
 #else
 #endif /* USE_BSDPGRP */
     RETURN;
 #else

-    DIE(aTHX_ PL_no_func, "setpgrp()");
+    DIE(aTHX_ PL_no_func, "setpgrp");

 #endif
 }
 
 #endif
 }
 


@@ -4375,20 +4609,20 @@ PP(pp_setpgrp)
 PP(pp_getpriority)
 {
 #ifdef HAS_GETPRIORITY
 PP(pp_getpriority)
 {
 #ifdef HAS_GETPRIORITY

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     const int who = POPi;
     const int which = TOPi;
     SETi( getpriority(PRIORITY_WHICH_T(which), who) );
     RETURN;
 #else
     const int who = POPi;
     const int which = TOPi;
     SETi( getpriority(PRIORITY_WHICH_T(which), who) );
     RETURN;
 #else

-    DIE(aTHX_ PL_no_func, "getpriority()");
+    DIE(aTHX_ PL_no_func, "getpriority");

 #endif
 }
 
 PP(pp_setpriority)
 {
 #ifdef HAS_SETPRIORITY
 #endif
 }
 
 PP(pp_setpriority)
 {
 #ifdef HAS_SETPRIORITY

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     const int niceval = POPi;
     const int who = POPi;
     const int which = TOPi;
     const int niceval = POPi;
     const int who = POPi;
     const int which = TOPi;


@@ -4396,7 +4630,7 @@ PP(pp_setpriority)
     SETi( setpriority(PRIORITY_WHICH_T(which), who, niceval) >= 0 );
     RETURN;
 #else
     SETi( setpriority(PRIORITY_WHICH_T(which), who, niceval) >= 0 );
     RETURN;
 #else

-    DIE(aTHX_ PL_no_func, "setpriority()");
+    DIE(aTHX_ PL_no_func, "setpriority");

 #endif
 }
 
 #endif
 }
 


@@ -4406,7 +4640,7 @@ PP(pp_setpriority)
 
 PP(pp_time)
 {
 
 PP(pp_time)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

 #ifdef BIG_TIME
     XPUSHn( time(NULL) );
 #else
 #ifdef BIG_TIME
     XPUSHn( time(NULL) );
 #else


@@ -4418,22 +4652,17 @@ PP(pp_time)
 PP(pp_tms)
 {
 #ifdef HAS_TIMES
 PP(pp_tms)
 {
 #ifdef HAS_TIMES

-    dVAR;

     dSP;
     dSP;

+    struct tms timesbuf;
+

     EXTEND(SP, 4);
     EXTEND(SP, 4);

-#ifndef VMS
-    (void)PerlProc_times(&PL_timesbuf);
-#else
-    (void)PerlProc_times((tbuffer_t *)&PL_timesbuf);  /* time.h uses different name for */
-                                                   /* struct tms, though same data   */
-                                                   /* is returned.                   */
-#endif
+    (void)PerlProc_times(&timesbuf);

 
 

-    mPUSHn(((NV)PL_timesbuf.tms_utime)/(NV)PL_clocktick);
-    if (GIMME == G_ARRAY) {
-       mPUSHn(((NV)PL_timesbuf.tms_stime)/(NV)PL_clocktick);
-       mPUSHn(((NV)PL_timesbuf.tms_cutime)/(NV)PL_clocktick);
-       mPUSHn(((NV)PL_timesbuf.tms_cstime)/(NV)PL_clocktick);
+    mPUSHn(((NV)timesbuf.tms_utime)/(NV)PL_clocktick);
+    if (GIMME_V == G_ARRAY) {
+       mPUSHn(((NV)timesbuf.tms_stime)/(NV)PL_clocktick);
+       mPUSHn(((NV)timesbuf.tms_cutime)/(NV)PL_clocktick);
+       mPUSHn(((NV)timesbuf.tms_cstime)/(NV)PL_clocktick);

     }
     RETURN;
 #else
     }
     RETURN;
 #else


@@ -4441,7 +4670,7 @@ PP(pp_tms)
     dSP;
     mPUSHn(0.0);
     EXTEND(SP, 4);
     dSP;
     mPUSHn(0.0);
     EXTEND(SP, 4);

-    if (GIMME == G_ARRAY) {
+    if (GIMME_V == G_ARRAY) {

         mPUSHn(0.0);
         mPUSHn(0.0);
         mPUSHn(0.0);
         mPUSHn(0.0);
         mPUSHn(0.0);
         mPUSHn(0.0);


@@ -4462,9 +4691,11 @@ PP(pp_tms)
 /* Sun Dec 29 12:00:00  2147483647 */
 #define TIME_UPPER_BOUND  67767976233316800.0
 
 /* Sun Dec 29 12:00:00  2147483647 */
 #define TIME_UPPER_BOUND  67767976233316800.0
 

+
+/* also used for: pp_localtime() */
+

 PP(pp_gmtime)
 {
 PP(pp_gmtime)
 {

-    dVAR;

     dSP;
     Time64_T when;
     struct TM tmbuf;
     dSP;
     Time64_T when;
     struct TM tmbuf;


@@ -4483,11 +4714,16 @@ PP(pp_gmtime)
     }
     else {
        NV input = Perl_floor(POPn);
     }
     else {
        NV input = Perl_floor(POPn);

+       const bool pl_isnan = Perl_isnan(input);

        when = (Time64_T)input;
        when = (Time64_T)input;

-       if (when != input) {
+       if (UNLIKELY(pl_isnan || when != input)) {

            /* diag_listed_as: gmtime(%f) too large */
            Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                           "%s(%.0" NVff ") too large", opname, input);
            /* diag_listed_as: gmtime(%f) too large */
            Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                           "%s(%.0" NVff ") too large", opname, input);

+           if (pl_isnan) {
+               err = NULL;
+               goto failed;
+           }

        }
     }
 
        }
     }
 


@@ -4505,36 +4741,35 @@ PP(pp_gmtime)
     }
     else {
        if (PL_op->op_type == OP_LOCALTIME)
     }
     else {
        if (PL_op->op_type == OP_LOCALTIME)

-           err = S_localtime64_r(&when, &tmbuf);
+           err = Perl_localtime64_r(&when, &tmbuf);

        else
        else

-           err = S_gmtime64_r(&when, &tmbuf);
+           err = Perl_gmtime64_r(&when, &tmbuf);

     }
 
     if (err == NULL) {
     }
 
     if (err == NULL) {

+       /* diag_listed_as: gmtime(%f) failed */

        /* XXX %lld broken for quads */
        /* XXX %lld broken for quads */

+      failed:

        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "%s(%.0" NVff ") failed", opname, when);
     }
 
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "%s(%.0" NVff ") failed", opname, when);
     }
 

-    if (GIMME != G_ARRAY) {    /* scalar context */
-       SV *tsv;
-       /* XXX newSVpvf()'s %lld type is broken, so cheat with a double */
-       double year = (double)tmbuf.tm_year + 1900;
-
+    if (GIMME_V != G_ARRAY) {  /* scalar context */

         EXTEND(SP, 1);
         EXTEND(SP, 1);

-        EXTEND_MORTAL(1);

        if (err == NULL)
            RETPUSHUNDEF;
        if (err == NULL)
            RETPUSHUNDEF;

-
-       tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %.0f",
-                           dayname[tmbuf.tm_wday],
-                           monname[tmbuf.tm_mon],
-                           tmbuf.tm_mday,
-                           tmbuf.tm_hour,
-                           tmbuf.tm_min,
-                           tmbuf.tm_sec,
-                           year);
-       mPUSHs(tsv);
+       else {
+           dTARGET;
+           PUSHs(TARG);
+           Perl_sv_setpvf_mg(aTHX_ TARG, "%s %s %2d %02d:%02d:%02d %"IVdf,
+                                dayname[tmbuf.tm_wday],
+                                monname[tmbuf.tm_mon],
+                                tmbuf.tm_mday,
+                                tmbuf.tm_hour,
+                                tmbuf.tm_min,
+                                tmbuf.tm_sec,
+                                (IV)tmbuf.tm_year + 1900);
+        }

     }
     else {                     /* list context */
        if ( err == NULL )
     }
     else {                     /* list context */
        if ( err == NULL )


@@ -4558,14 +4793,31 @@ PP(pp_gmtime)
 PP(pp_alarm)
 {
 #ifdef HAS_ALARM
 PP(pp_alarm)
 {
 #ifdef HAS_ALARM

-    dVAR; dSP; dTARGET;
-    int anum;
-    anum = POPi;
-    anum = alarm((unsigned int)anum);
-    if (anum < 0)
-       RETPUSHUNDEF;
-    PUSHi(anum);
-    RETURN;
+    dSP; dTARGET;
+    /* alarm() takes an unsigned int number of seconds, and return the
+     * unsigned int number of seconds remaining in the previous alarm
+     * (alarms don't stack).  Therefore negative return values are not
+     * possible. */
+    int anum = POPi;
+    if (anum < 0) {
+        /* Note that while the C library function alarm() as such has
+         * no errors defined (or in other words, properly behaving client
+         * code shouldn't expect any), alarm() being obsoleted by
+         * setitimer() and often being implemented in terms of
+         * setitimer(), can fail. */
+        /* diag_listed_as: %s() with negative argument */
+        Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC),
+                         "alarm() with negative argument");
+        SETERRNO(EINVAL, LIB_INVARG);
+        RETPUSHUNDEF;
+    }
+    else {
+        unsigned int retval = alarm(anum);
+        if ((int)retval < 0) /* Strictly speaking "cannot happen". */
+            RETPUSHUNDEF;
+        PUSHu(retval);
+        RETURN;
+    }

 #else
     DIE(aTHX_ PL_no_func, "alarm");
 #endif
 #else
     DIE(aTHX_ PL_no_func, "alarm");
 #endif


@@ -4573,7 +4825,7 @@ PP(pp_alarm)
 
 PP(pp_sleep)
 {
 
 PP(pp_sleep)
 {

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     I32 duration;
     Time_t lasttime;
     Time_t when;
     I32 duration;
     Time_t lasttime;
     Time_t when;


@@ -4583,7 +4835,16 @@ PP(pp_sleep)
        PerlProc_pause();
     else {
        duration = POPi;
        PerlProc_pause();
     else {
        duration = POPi;

-       PerlProc_sleep((unsigned int)duration);
+        if (duration < 0) {
+          /* diag_listed_as: %s() with negative argument */
+          Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC),
+                           "sleep() with negative argument");
+          SETERRNO(EINVAL, LIB_INVARG);
+          XPUSHi(0);
+          RETURN;
+        } else {
+          PerlProc_sleep((unsigned int)duration);
+        }

     }
     (void)time(&when);
     XPUSHi(when - lasttime);
     }
     (void)time(&when);
     XPUSHi(when - lasttime);


@@ -4593,10 +4854,12 @@ PP(pp_sleep)
 /* Shared memory. */
 /* Merged with some message passing. */
 
 /* Shared memory. */
 /* Merged with some message passing. */
 

+/* also used for: pp_msgrcv() pp_msgsnd() pp_semop() pp_shmread() */
+

 PP(pp_shmwrite)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 PP(pp_shmwrite)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)

-    dVAR; dSP; dMARK; dTARGET;
+    dSP; dMARK; dTARGET;

     const int op_type = PL_op->op_type;
     I32 value;
 
     const int op_type = PL_op->op_type;
     I32 value;
 


@@ -4625,10 +4888,12 @@ PP(pp_shmwrite)
 
 /* Semaphores. */
 
 
 /* Semaphores. */
 

+/* also used for: pp_msgget() pp_shmget() */
+

 PP(pp_semget)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 PP(pp_semget)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)

-    dVAR; dSP; dMARK; dTARGET;
+    dSP; dMARK; dTARGET;

     const int anum = do_ipcget(PL_op->op_type, MARK, SP);
     SP = MARK;
     if (anum == -1)
     const int anum = do_ipcget(PL_op->op_type, MARK, SP);
     SP = MARK;
     if (anum == -1)


@@ -4640,14 +4905,16 @@ PP(pp_semget)
 #endif
 }
 
 #endif
 }
 

+/* also used for: pp_msgctl() pp_shmctl() */
+

 PP(pp_semctl)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 PP(pp_semctl)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)

-    dVAR; dSP; dMARK; dTARGET;
+    dSP; dMARK; dTARGET;

     const int anum = do_ipcctl(PL_op->op_type, MARK, SP);
     SP = MARK;
     if (anum == -1)
     const int anum = do_ipcctl(PL_op->op_type, MARK, SP);
     SP = MARK;
     if (anum == -1)

-       RETSETUNDEF;
+       RETPUSHUNDEF;

     if (anum != 0) {
        PUSHi(anum);
     }
     if (anum != 0) {
        PUSHi(anum);
     }


@@ -4669,7 +4936,7 @@ S_space_join_names_mortal(pTHX_ char *const *array)
 
     PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL;
 
 
     PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL;
 

-    if (array && *array) {
+    if (*array) {

        target = newSVpvs_flags("", SVs_TEMP);
        while (1) {
            sv_catpv(target, *array);
        target = newSVpvs_flags("", SVs_TEMP);
        while (1) {
            sv_catpv(target, *array);


@@ -4685,13 +4952,15 @@ S_space_join_names_mortal(pTHX_ char *const *array)
 
 /* Get system info. */
 
 
 /* Get system info. */
 

+/* also used for: pp_ghbyaddr() pp_ghbyname() */
+

 PP(pp_ghostent)
 {
 #if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
 PP(pp_ghostent)
 {
 #if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)

-    dVAR; dSP;
+    dSP;

     I32 which = PL_op->op_type;
     I32 which = PL_op->op_type;

-    register char **elem;
-    register SV *sv;
+    char **elem;
+    SV *sv;

 #ifndef HAS_GETHOST_PROTOS /* XXX Do we need individual probes? */
     struct hostent *gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int);
     struct hostent *gethostbyname(Netdb_name_t);
 #ifndef HAS_GETHOST_PROTOS /* XXX Do we need individual probes? */
     struct hostent *gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int);
     struct hostent *gethostbyname(Netdb_name_t);


@@ -4739,7 +5008,7 @@ PP(pp_ghostent)
        }
 #endif
 
        }
 #endif
 

-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {

        PUSHs(sv = sv_newmortal());
        if (hent) {
            if (which == OP_GHBYNAME) {
        PUSHs(sv = sv_newmortal());
        if (hent) {
            if (which == OP_GHBYNAME) {


@@ -4775,12 +5044,14 @@ PP(pp_ghostent)
 #endif
 }
 
 #endif
 }
 

+/* also used for: pp_gnbyaddr() pp_gnbyname() */
+

 PP(pp_gnetent)
 {
 #if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
 PP(pp_gnetent)
 {
 #if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)

-    dVAR; dSP;
+    dSP;

     I32 which = PL_op->op_type;
     I32 which = PL_op->op_type;

-    register SV *sv;
+    SV *sv;

 #ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
     struct netent *getnetbyaddr(Netdb_net_t, int);
     struct netent *getnetbyname(Netdb_name_t);
 #ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
     struct netent *getnetbyaddr(Netdb_net_t, int);
     struct netent *getnetbyname(Netdb_name_t);


@@ -4824,7 +5095,7 @@ PP(pp_gnetent)
 #endif
 
     EXTEND(SP, 4);
 #endif
 
     EXTEND(SP, 4);

-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {

        PUSHs(sv = sv_newmortal());
        if (nent) {
            if (which == OP_GNBYNAME)
        PUSHs(sv = sv_newmortal());
        if (nent) {
            if (which == OP_GNBYNAME)


@@ -4848,12 +5119,15 @@ PP(pp_gnetent)
 #endif
 }
 
 #endif
 }
 

+
+/* also used for: pp_gpbyname() pp_gpbynumber() */
+

 PP(pp_gprotoent)
 {
 #if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
 PP(pp_gprotoent)
 {
 #if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)

-    dVAR; dSP;
+    dSP;

     I32 which = PL_op->op_type;
     I32 which = PL_op->op_type;

-    register SV *sv;
+    SV *sv;

 #ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
     struct protoent *getprotobyname(Netdb_name_t);
     struct protoent *getprotobynumber(int);
 #ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
     struct protoent *getprotobyname(Netdb_name_t);
     struct protoent *getprotobynumber(int);


@@ -4885,7 +5159,7 @@ PP(pp_gprotoent)
 #endif
 
     EXTEND(SP, 3);
 #endif
 
     EXTEND(SP, 3);

-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {

        PUSHs(sv = sv_newmortal());
        if (pent) {
            if (which == OP_GPBYNAME)
        PUSHs(sv = sv_newmortal());
        if (pent) {
            if (which == OP_GPBYNAME)


@@ -4908,12 +5182,15 @@ PP(pp_gprotoent)
 #endif
 }
 
 #endif
 }
 

+
+/* also used for: pp_gsbyname() pp_gsbyport() */
+

 PP(pp_gservent)
 {
 #if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
 PP(pp_gservent)
 {
 #if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)

-    dVAR; dSP;
+    dSP;

     I32 which = PL_op->op_type;
     I32 which = PL_op->op_type;

-    register SV *sv;
+    SV *sv;

 #ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
     struct servent *getservbyname(Netdb_name_t, Netdb_name_t);
     struct servent *getservbyport(int, Netdb_name_t);
 #ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
     struct servent *getservbyname(Netdb_name_t, Netdb_name_t);
     struct servent *getservbyport(int, Netdb_name_t);


@@ -4934,9 +5211,7 @@ PP(pp_gservent)
 #ifdef HAS_GETSERVBYPORT
        const char * const proto = POPpbytex;
        unsigned short port = (unsigned short)POPu;
 #ifdef HAS_GETSERVBYPORT
        const char * const proto = POPpbytex;
        unsigned short port = (unsigned short)POPu;

-#ifdef HAS_HTONS

        port = PerlSock_htons(port);
        port = PerlSock_htons(port);

-#endif

        sent = PerlSock_getservbyport(port, (proto && !*proto) ? NULL : proto);
 #else
        DIE(aTHX_ PL_no_sock_func, "getservbyport");
        sent = PerlSock_getservbyport(port, (proto && !*proto) ? NULL : proto);
 #else
        DIE(aTHX_ PL_no_sock_func, "getservbyport");


@@ -4950,15 +5225,11 @@ PP(pp_gservent)
 #endif
 
     EXTEND(SP, 4);
 #endif
 
     EXTEND(SP, 4);

-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {

        PUSHs(sv = sv_newmortal());
        if (sent) {
            if (which == OP_GSBYNAME) {
        PUSHs(sv = sv_newmortal());
        if (sent) {
            if (which == OP_GSBYNAME) {

-#ifdef HAS_NTOHS

                sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port));
                sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port));

-#else
-               sv_setiv(sv, (IV)(sent->s_port));
-#endif

            }
            else
                sv_setpv(sv, sent->s_name);
            }
            else
                sv_setpv(sv, sent->s_name);


@@ -4969,11 +5240,7 @@ PP(pp_gservent)
     if (sent) {
        mPUSHs(newSVpv(sent->s_name, 0));
        PUSHs(space_join_names_mortal(sent->s_aliases));
     if (sent) {
        mPUSHs(newSVpv(sent->s_name, 0));
        PUSHs(space_join_names_mortal(sent->s_aliases));

-#ifdef HAS_NTOHS

        mPUSHi(PerlSock_ntohs(sent->s_port));
        mPUSHi(PerlSock_ntohs(sent->s_port));

-#else
-       mPUSHi(sent->s_port);
-#endif

        mPUSHs(newSVpv(sent->s_proto, 0));
     }
 
        mPUSHs(newSVpv(sent->s_proto, 0));
     }
 


@@ -4983,9 +5250,12 @@ PP(pp_gservent)
 #endif
 }
 
 #endif
 }
 

+
+/* also used for: pp_snetent() pp_sprotoent() pp_sservent() */
+

 PP(pp_shostent)
 {
 PP(pp_shostent)
 {

-    dVAR; dSP;
+    dSP;

     const int stayopen = TOPi;
     switch(PL_op->op_type) {
     case OP_SHOSTENT:
     const int stayopen = TOPi;
     switch(PL_op->op_type) {
     case OP_SHOSTENT:


@@ -5020,9 +5290,13 @@ PP(pp_shostent)
     RETSETYES;
 }
 
     RETSETYES;
 }
 

+
+/* also used for: pp_egrent() pp_enetent() pp_eprotoent() pp_epwent()
+ *                pp_eservent() pp_sgrent() pp_spwent() */
+

 PP(pp_ehostent)
 {
 PP(pp_ehostent)
 {

-    dVAR; dSP;
+    dSP;

     switch(PL_op->op_type) {
     case OP_EHOSTENT:
 #ifdef HAS_ENDHOSTENT
     switch(PL_op->op_type) {
     case OP_EHOSTENT:
 #ifdef HAS_ENDHOSTENT


@@ -5085,12 +5359,15 @@ PP(pp_ehostent)
     RETPUSHYES;
 }
 
     RETPUSHYES;
 }
 

+
+/* also used for: pp_gpwnam() pp_gpwuid() */
+

 PP(pp_gpwent)
 {
 #ifdef HAS_PASSWD
 PP(pp_gpwent)
 {
 #ifdef HAS_PASSWD

-    dVAR; dSP;
+    dSP;

     I32 which = PL_op->op_type;
     I32 which = PL_op->op_type;

-    register SV *sv;
+    SV *sv;

     struct passwd *pwent  = NULL;
     /*
      * We currently support only the SysV getsp* shadow password interface.
     struct passwd *pwent  = NULL;
     /*
      * We currently support only the SysV getsp* shadow password interface.


@@ -5184,15 +5461,11 @@ PP(pp_gpwent)
     }
 
     EXTEND(SP, 10);
     }
 
     EXTEND(SP, 10);

-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {

        PUSHs(sv = sv_newmortal());
        if (pwent) {
            if (which == OP_GPWNAM)
        PUSHs(sv = sv_newmortal());
        if (pwent) {
            if (which == OP_GPWNAM)

-#   if Uid_t_sign <= 0
-               sv_setiv(sv, (IV)pwent->pw_uid);
-#   else
-               sv_setuv(sv, (UV)pwent->pw_uid);
-#   endif
+               sv_setuid(sv, pwent->pw_uid);

            else
                sv_setpv(sv, pwent->pw_name);
        }
            else
                sv_setpv(sv, pwent->pw_name);
        }


@@ -5240,23 +5513,13 @@ PP(pp_gpwent)
            sv_setpv(sv, pwent->pw_passwd);
 #   endif
 
            sv_setpv(sv, pwent->pw_passwd);
 #   endif
 

-#   ifndef INCOMPLETE_TAINTS

        /* passwd is tainted because user himself can diddle with it.
         * admittedly not much and in a very limited way, but nevertheless. */
        SvTAINTED_on(sv);
        /* passwd is tainted because user himself can diddle with it.
         * admittedly not much and in a very limited way, but nevertheless. */
        SvTAINTED_on(sv);

-#   endif

 
 

-#   if Uid_t_sign <= 0
-       mPUSHi(pwent->pw_uid);
-#   else
-       mPUSHu(pwent->pw_uid);
-#   endif
+        sv_setuid(PUSHmortal, pwent->pw_uid);
+        sv_setgid(PUSHmortal, pwent->pw_gid);

 
 

-#   if Uid_t_sign <= 0
-       mPUSHi(pwent->pw_gid);
-#   else
-       mPUSHu(pwent->pw_gid);
-#   endif

        /* pw_change, pw_quota, and pw_age are mutually exclusive--
         * because of the poor interface of the Perl getpw*(),
         * not because there's some standard/convention saying so.
        /* pw_change, pw_quota, and pw_age are mutually exclusive--
         * because of the poor interface of the Perl getpw*(),
         * not because there's some standard/convention saying so.


@@ -5295,18 +5558,14 @@ PP(pp_gpwent)
 #   else
        PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #   endif
 #   else
        PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #   endif

-#   ifndef INCOMPLETE_TAINTS

        /* pw_gecos is tainted because user himself can diddle with it. */
        SvTAINTED_on(sv);
        /* pw_gecos is tainted because user himself can diddle with it. */
        SvTAINTED_on(sv);

-#   endif

 
        mPUSHs(newSVpv(pwent->pw_dir, 0));
 
        PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_shell, 0)));
 
        mPUSHs(newSVpv(pwent->pw_dir, 0));
 
        PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_shell, 0)));

-#   ifndef INCOMPLETE_TAINTS

        /* pw_shell is tainted because user himself can diddle with it. */
        SvTAINTED_on(sv);
        /* pw_shell is tainted because user himself can diddle with it. */
        SvTAINTED_on(sv);

-#   endif

 
 #   ifdef PWEXPIRE
        mPUSHi(pwent->pw_expire);
 
 #   ifdef PWEXPIRE
        mPUSHi(pwent->pw_expire);


@@ -5318,10 +5577,13 @@ PP(pp_gpwent)
 #endif
 }
 
 #endif
 }
 

+
+/* also used for: pp_ggrgid() pp_ggrnam() */
+

 PP(pp_ggrent)
 {
 #ifdef HAS_GROUP
 PP(pp_ggrent)
 {
 #ifdef HAS_GROUP

-    dVAR; dSP;
+    dSP;

     const I32 which = PL_op->op_type;
     const struct group *grent;
 
     const I32 which = PL_op->op_type;
     const struct group *grent;
 


@@ -5330,7 +5592,13 @@ PP(pp_ggrent)
        grent = (const struct group *)getgrnam(name);
     }
     else if (which == OP_GGRGID) {
        grent = (const struct group *)getgrnam(name);
     }
     else if (which == OP_GGRGID) {

+#if Gid_t_sign == 1
+       const Gid_t gid = POPu;
+#elif Gid_t_sign == -1

        const Gid_t gid = POPi;
        const Gid_t gid = POPi;

+#else
+#  error "Unexpected Gid_t_sign"
+#endif

        grent = (const struct group *)getgrgid(gid);
     }
     else
        grent = (const struct group *)getgrgid(gid);
     }
     else


@@ -5341,17 +5609,13 @@ PP(pp_ggrent)
 #endif
 
     EXTEND(SP, 4);
 #endif
 
     EXTEND(SP, 4);

-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {

        SV * const sv = sv_newmortal();
 
        PUSHs(sv);
        if (grent) {
            if (which == OP_GGRNAM)
        SV * const sv = sv_newmortal();
 
        PUSHs(sv);
        if (grent) {
            if (which == OP_GGRNAM)

-#if Gid_t_sign <= 0
-               sv_setiv(sv, (IV)grent->gr_gid);
-#else
-               sv_setuv(sv, (UV)grent->gr_gid);
-#endif
+               sv_setgid(sv, grent->gr_gid);

            else
                sv_setpv(sv, grent->gr_name);
        }
            else
                sv_setpv(sv, grent->gr_name);
        }


@@ -5367,11 +5631,7 @@ PP(pp_ggrent)
        PUSHs(sv_mortalcopy(&PL_sv_no));
 #endif
 
        PUSHs(sv_mortalcopy(&PL_sv_no));
 #endif
 

-#if Gid_t_sign <= 0
-       mPUSHi(grent->gr_gid);
-#else
-       mPUSHu(grent->gr_gid);
-#endif
+        sv_setgid(PUSHmortal, grent->gr_gid);

 
 #if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API))
        /* In UNICOS/mk (_CRAYMPP) the multithreading
 
 #if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API))
        /* In UNICOS/mk (_CRAYMPP) the multithreading


@@ -5395,7 +5655,7 @@ PP(pp_ggrent)
 PP(pp_getlogin)
 {
 #ifdef HAS_GETLOGIN
 PP(pp_getlogin)
 {
 #ifdef HAS_GETLOGIN

-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;

     char *tmps;
     EXTEND(SP, 1);
     if (!(tmps = PerlProc_getlogin()))
     char *tmps;
     EXTEND(SP, 1);
     if (!(tmps = PerlProc_getlogin()))


@@ -5413,13 +5673,13 @@ PP(pp_getlogin)
 PP(pp_syscall)
 {
 #ifdef HAS_SYSCALL
 PP(pp_syscall)
 {
 #ifdef HAS_SYSCALL

-    dVAR; dSP; dMARK; dORIGMARK; dTARGET;
-    register I32 items = SP - MARK;
+    dSP; dMARK; dORIGMARK; dTARGET;
+    I32 items = SP - MARK;

     unsigned long a[20];
     unsigned long a[20];

-    register I32 i = 0;
-    I32 retval = -1;
+    I32 i = 0;
+    IV retval = -1;

 
 

-    if (PL_tainting) {
+    if (TAINTING_get) {

        while (++MARK <= SP) {
            if (SvTAINTED(*MARK)) {
                TAINT;
        while (++MARK <= SP) {
            if (SvTAINTED(*MARK)) {
                TAINT;


@@ -5473,30 +5733,6 @@ PP(pp_syscall)
     case 8:
        retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
        break;
     case 8:
        retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
        break;

-#ifdef atarist
-    case 9:
-       retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
-       break;
-    case 10:
-       retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
-       break;
-    case 11:
-       retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
-         a[10]);
-       break;
-    case 12:
-       retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
-         a[10],a[11]);
-       break;
-    case 13:
-       retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
-         a[10],a[11],a[12]);
-       break;
-    case 14:
-       retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
-         a[10],a[11],a[12],a[13]);
-       break;
-#endif /* atarist */

     }
     SP = ORIGMARK;
     PUSHi(retval);
     }
     SP = ORIGMARK;
     PUSHi(retval);


@@ -5628,11 +5864,5 @@ lockf_emulate_flock(int fd, int operation)
 #endif /* LOCKF_EMULATE_FLOCK */
 
 /*
 #endif /* LOCKF_EMULATE_FLOCK */
 
 /*

- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: t
- * End:
- *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:

  */
  */