This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: Use compiled-in inversion lists
[perl5.git] / pp_sys.c
index 7144bc3..d4f1b9f 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
 #   include <shadow.h>
 #endif
 
-#ifdef I_SYS_WAIT
-# include <sys/wait.h>
-#endif
-
 #ifdef I_SYS_RESOURCE
 # include <sys/resource.h>
 #endif
@@ -252,6 +248,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresuid(euid, ruid, (Uid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective uid failed");
 #endif
 
@@ -265,6 +262,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresgid(egid, rgid, (Gid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective gid failed");
 #endif
 
@@ -277,6 +275,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresuid(ruid, euid, (Uid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: leaving effective %s failed */
        Perl_croak(aTHX_ "leaving effective uid failed");
 
 #ifdef HAS_SETREGID
@@ -286,6 +285,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresgid(rgid, egid, (Gid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: leaving effective %s failed */
        Perl_croak(aTHX_ "leaving effective gid failed");
 
     return res;
@@ -358,6 +358,12 @@ PP(pp_glob)
 {
     dVAR;
     OP *result;
+    dSP;
+    /* 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));
+
+    tryAMAGICunTARGET(iter_amg, -1, (PL_op->op_flags & OPf_SPECIAL));
 
     if (PL_op->op_flags & OPf_SPECIAL) {
        /* call Perl-level glob function instead. Stack args are:
@@ -368,7 +374,11 @@ PP(pp_glob)
     }
     /* stack args are: wildcard, gv(_GEN_n) */
 
-    tryAMAGICunTARGET(iter_amg, -1);
+    if (PL_globhook) {
+       SETs(GvSV(TOPs));
+       PL_globhook(aTHX);
+       return NORMAL;
+    }
 
     /* Note that we only ever get here if File::Glob fails to load
      * without at the same time croaking, for some reason, or if
@@ -414,7 +424,6 @@ PP(pp_warn)
 {
     dVAR; dSP; dMARK;
     SV *exsv;
-    const char *pv;
     STRLEN len;
     if (SP - MARK > 1) {
        dTARGET;
@@ -431,7 +440,7 @@ PP(pp_warn)
        exsv = TOPs;
     }
 
-    if (SvROK(exsv) || (pv = SvPV_const(exsv, len), len)) {
+    if (SvROK(exsv) || (SvPV_const(exsv, len), len)) {
        /* well-formed exception supplied */
     }
     else if (SvROK(ERRSV)) {
@@ -444,7 +453,9 @@ PP(pp_warn)
     else {
        exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
     }
-    warn_sv(exsv);
+    if (SvROK(exsv) && !PL_warnhook)
+        Perl_warn(aTHX_ "%"SVf, SVfARG(exsv));
+    else warn_sv(exsv);
     RETSETYES;
 }
 
@@ -452,7 +463,6 @@ PP(pp_die)
 {
     dVAR; dSP; dMARK;
     SV *exsv;
-    const char *pv;
     STRLEN len;
 #ifdef VMS
     VMSISH_HUSHED  = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
@@ -467,7 +477,7 @@ PP(pp_die)
        exsv = TOPs;
     }
 
-    if (SvROK(exsv) || (pv = SvPV_const(exsv, len), len)) {
+    if (SvROK(exsv) || (SvPV_const(exsv, len), len)) {
        /* well-formed exception supplied */
     }
     else if (SvROK(ERRSV)) {
@@ -502,6 +512,73 @@ PP(pp_die)
 
 /* I/O. */
 
+OP *
+Perl_tied_method(pTHX_ const char *const methname, SV **sp, SV *const sv,
+                const MAGIC *const mg, const U32 flags, U32 argc, ...)
+{
+    SV **orig_sp = sp;
+    I32 ret_args;
+
+    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);
+
+    PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */
+    PUSHSTACKi(PERLSI_MAGIC);
+    EXTEND(SP, argc+1); /* object + args */
+    PUSHMARK(sp);
+    PUSHs(SvTIED_obj(sv, mg));
+    if (flags & TIED_METHOD_ARGUMENTS_ON_STACK) {
+       Copy(orig_sp + 2, sp + 1, argc, SV*); /* copy args to new stack */
+       sp += argc;
+    }
+    else if (argc) {
+       const U32 mortalize_not_needed
+           = flags & TIED_METHOD_MORTALIZE_NOT_NEEDED;
+       va_list args;
+       va_start(args, argc);
+       do {
+           SV *const arg = va_arg(args, SV *);
+           if(mortalize_not_needed)
+               PUSHs(arg);
+           else
+               mPUSHs(arg);
+       } while (--argc);
+       va_end(args);
+    }
+
+    PUTBACK;
+    ENTER_with_name("call_tied_method");
+    if (flags & TIED_METHOD_SAY) {
+       /* local $\ = "\n" */
+       SAVEGENERICSV(PL_ors_sv);
+       PL_ors_sv = newSVpvs("\n");
+    }
+    ret_args = call_method(methname, flags & G_WANT);
+    SPAGAIN;
+    orig_sp = sp;
+    POPSTACK;
+    SPAGAIN;
+    if (ret_args) { /* copy results back to original stack */
+       EXTEND(sp, ret_args);
+       Copy(orig_sp - ret_args + 1, sp + 1, ret_args, SV*);
+       sp += ret_args;
+       PUTBACK;
+    }
+    LEAVE_with_name("call_tied_method");
+    return NORMAL;
+}
+
+#define tied_method0(a,b,c,d)          \
+    Perl_tied_method(aTHX_ a,b,c,d,G_SCALAR,0)
+#define tied_method1(a,b,c,d,e)                \
+    Perl_tied_method(aTHX_ a,b,c,d,G_SCALAR,1,e)
+#define tied_method2(a,b,c,d,e,f)      \
+    Perl_tied_method(aTHX_ a,b,c,d,G_SCALAR,2,e,f)
+
 PP(pp_open)
 {
     dVAR; dSP;
@@ -519,25 +596,21 @@ PP(pp_open)
        DIE(aTHX_ PL_no_usym, "filehandle");
 
     if ((io = GvIOp(gv))) {
-       MAGIC *mg;
+       const MAGIC *mg;
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
        if (IoDIRP(io))
            Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                            "Opening dirhandle %s also as a file",
-                            GvENAME(gv));
+                            "Opening dirhandle %"HEKf" also as a file",
+                            HEKfARG(GvENAME_HEK(gv)));
 
        mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            /* Method's args are same as ours ... */
            /* ... except handle is replaced by the object */
-           *MARK-- = SvTIED_obj(MUTABLE_SV(io), mg);
-           PUSHMARK(MARK);
-           PUTBACK;
-           ENTER_with_name("call_OPEN");
-           call_method("OPEN", G_SCALAR);
-           LEAVE_with_name("call_OPEN");
-           return NORMAL;
+           return Perl_tied_method(aTHX_ "OPEN", mark - 1, MUTABLE_SV(io), mg,
+                                   G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
+                                   sp - mark);
        }
     }
 
@@ -560,58 +633,11 @@ PP(pp_open)
     RETURN;
 }
 
-/* These are private to this function, which is private to this file.
-   Use 0x04 rather than the next available bit, to help the compiler if the
-   architecture can generate more efficient instructions.  */
-#define MORTALIZE_NOT_NEEDED   0x04
-#define TIED_HANDLE_ARGC_SHIFT 3
-
-static OP *
-S_tied_handle_method(pTHX_ const char *const methname, SV **sp,
-                    IO *const io, MAGIC *const mg, const U32 flags, ...)
-{
-    U32 argc = flags >> TIED_HANDLE_ARGC_SHIFT;
-
-    PERL_ARGS_ASSERT_TIED_HANDLE_METHOD;
-
-    /* Ensure that our flag bits do not overlap.  */
-    assert((MORTALIZE_NOT_NEEDED & G_WANT) == 0);
-    assert((G_WANT >> TIED_HANDLE_ARGC_SHIFT) == 0);
-
-    PUSHMARK(sp);
-    PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-    if (argc) {
-       const U32 mortalize_not_needed = flags & MORTALIZE_NOT_NEEDED;
-       va_list args;
-       va_start(args, flags);
-       do {
-           SV *const arg = va_arg(args, SV *);
-           if(mortalize_not_needed)
-               PUSHs(arg);
-           else
-               mPUSHs(arg);
-       } while (--argc);
-       va_end(args);
-    }
-
-    PUTBACK;
-    ENTER_with_name("call_tied_handle_method");
-    call_method(methname, flags & G_WANT);
-    LEAVE_with_name("call_tied_handle_method");
-    return NORMAL;
-}
-
-#define tied_handle_method(a,b,c,d)            \
-    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR)
-#define tied_handle_method1(a,b,c,d,e) \
-    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR | (1 << TIED_HANDLE_ARGC_SHIFT),e)
-#define tied_handle_method2(a,b,c,d,e,f)       \
-    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR | (2 << TIED_HANDLE_ARGC_SHIFT), e,f)
-
 PP(pp_close)
 {
     dVAR; dSP;
-    GV * const gv = (MAXARG == 0) ? PL_defoutgv : MUTABLE_GV(POPs);
+    GV * const gv =
+       MAXARG == 0 || (!TOPs && !POPs) ? PL_defoutgv : MUTABLE_GV(POPs);
 
     if (MAXARG == 0)
        EXTEND(SP, 1);
@@ -619,9 +645,9 @@ PP(pp_close)
     if (gv) {
        IO * const io = GvIO(gv);
        if (io) {
-           MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+           const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
            if (mg) {
-               return tied_handle_method("CLOSE", SP, io, mg);
+               return tied_method0("CLOSE", SP, MUTABLE_SV(io), mg);
            }
        }
     }
@@ -694,19 +720,20 @@ PP(pp_fileno)
     GV *gv;
     IO *io;
     PerlIO *fp;
-    MAGIC  *mg;
+    const MAGIC *mg;
 
     if (MAXARG < 1)
        RETPUSHUNDEF;
     gv = MUTABLE_GV(POPs);
+    io = GvIO(gv);
 
-    if (gv && (io = GvIO(gv))
+    if (io
        && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
     {
-       return tied_handle_method("FILENO", SP, io, mg);
+       return tied_method0("FILENO", SP, MUTABLE_SV(io), mg);
     }
 
-    if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) {
+    if (!io || !(fp = IoIFP(io))) {
        /* Can't do this because people seem to do things like
           defined(fileno($foo)) to check whether $foo is a valid fh.
 
@@ -727,7 +754,7 @@ PP(pp_umask)
     dTARGET;
     Mode_t anum;
 
-    if (MAXARG < 1) {
+    if (MAXARG < 1 || (!TOPs && !POPs)) {
        anum = PerlLIO_umask(022);
        /* setting it to 022 between the two calls to umask avoids
         * to have a window where the umask is set to 0 -- meaning
@@ -743,7 +770,7 @@ PP(pp_umask)
     /* Only DIE if trying to restrict permissions on "user" (self).
      * Otherwise it's harmless and more useful to just return undef
      * since 'group' and 'other' concepts probably don't exist here. */
-    if (MAXARG >= 1 && (POPi & 0700))
+    if (MAXARG >= 1 && (TOPs||POPs) && (POPi & 0700))
        DIE(aTHX_ "umask not implemented");
     XPUSHs(&PL_sv_undef);
 #endif
@@ -765,23 +792,22 @@ PP(pp_binmode)
     }
 
     gv = MUTABLE_GV(POPs);
+    io = GvIO(gv);
 
-    if (gv && (io = GvIO(gv))) {
-       MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+    if (io) {
+       const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            /* This takes advantage of the implementation of the varargs
               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 S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg,
-                                       G_SCALAR|MORTALIZE_NOT_NEEDED
-                                       | (discp
-                                          ? (1 << TIED_HANDLE_ARGC_SHIFT) : 0),
-                                       discp);
+           return Perl_tied_method(aTHX_ "BINMODE", SP, MUTABLE_SV(io), mg,
+                                   G_SCALAR|TIED_METHOD_MORTALIZE_NOT_NEEDED,
+                                   discp ? 1 : 0, discp);
        }
     }
 
-    if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) {
+    if (!io || !(fp = IoIFP(io))) {
        report_evil_fh(gv);
        SETERRNO(EBADF,RMS_IFI);
         RETPUSHUNDEF;
@@ -831,14 +857,17 @@ PP(pp_tie)
            break;
        case SVt_PVAV:
            methname = "TIEARRAY";
+           if (!AvREAL(varsv)) {
+               if (!AvREIFY(varsv))
+                   Perl_croak(aTHX_ "Cannot tie unreifiable array");
+               av_clear((AV *)varsv);
+               AvREIFY_off(varsv);
+               AvREAL_on(varsv);
+           }
            break;
        case SVt_PVGV:
        case SVt_PVLV:
-           if (isGV_with_GP(varsv)) {
-               if (SvFAKE(varsv) && !(GvFLAGS(varsv) & GVf_TIEWARNED)) {
-                   deprecate("tie on a handle without *");
-                   GvFLAGS(varsv) |= GVf_TIEWARNED;
-               }
+           if (isGV_with_GP(varsv) && !SvFAKE(varsv)) {
                methname = "TIEHANDLE";
                how = PERL_MAGIC_tiedscalar;
                /* For tied filehandles, we apply tiedscalar magic to the IO
@@ -871,10 +900,8 @@ PP(pp_tie)
         * wrong error message, and worse case, supreme action at a distance.
         * (Sorry obfuscation writers. You're not going to be given this one.)
         */
-       STRLEN len;
-       const char *name = SvPV_nomg_const(*MARK, len);
-       stash = gv_stashpvn(name, len, 0);
-       if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
+       stash = gv_stashsv(*MARK, 0);
+       if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
            DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
                 methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no));
        }
@@ -915,14 +942,8 @@ PP(pp_untie)
     const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
                ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
 
-    if (isGV_with_GP(sv)) {
-      if (SvFAKE(sv) && !(GvFLAGS(sv) & GVf_TIEWARNED)) {
-       deprecate("untie on a handle without *");
-       GvFLAGS(sv) |= GVf_TIEWARNED;
-      }
-      if (!(sv = MUTABLE_SV(GvIOp(sv))))
+    if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
        RETPUSHYES;
-    }
 
     if ((mg = SvTIED_mg(sv, how))) {
        SV * const obj = SvRV(SvTIED_obj(sv, mg));
@@ -959,20 +980,11 @@ PP(pp_tied)
     const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
                ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
 
-    if (isGV_with_GP(sv)) {
-      if (SvFAKE(sv) && !(GvFLAGS(sv) & GVf_TIEWARNED)) {
-       deprecate("tied on a handle without *");
-       GvFLAGS(sv) |= GVf_TIEWARNED;
-      }
-      if (!(sv = MUTABLE_SV(GvIOp(sv))))
+    if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
        RETPUSHUNDEF;
-    }
 
     if ((mg = SvTIED_mg(sv, how))) {
-       SV *osv = SvTIED_obj(sv, mg);
-       if (osv == mg->mg_obj)
-           osv = sv_mortalcopy(osv);
-       PUSHs(osv);
+       PUSHs(SvTIED_obj(sv, mg));
        RETURN;
     }
     RETPUSHUNDEF;
@@ -1005,7 +1017,10 @@ PP(pp_dbmopen)
     if (SvIV(right))
        mPUSHu(O_RDWR|O_CREAT);
     else
+    {
        mPUSHu(O_RDWR);
+       if (!SvOK(right)) right = &PL_sv_no;
+    }
     PUSHs(right);
     PUTBACK;
     call_sv(MUTABLE_SV(GvCV(gv)), G_SCALAR);
@@ -1062,6 +1077,7 @@ PP(pp_sselect)
     SP -= 4;
     for (i = 1; i <= 3; i++) {
        SV * const sv = SP[i];
+       SvGETMAGIC(sv);
        if (!SvOK(sv))
            continue;
        if (SvREADONLY(sv)) {
@@ -1071,8 +1087,10 @@ PP(pp_sselect)
                Perl_croak_no_modify(aTHX);
        }
        if (!SvPOK(sv)) {
-           Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Non-string passed as bitmask");
-           SvPV_force_nolen(sv);       /* force string conversion */
+           if (!SvPOKp(sv))
+               Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+                                   "Non-string passed as bitmask");
+           SvPV_force_nomg_nolen(sv);  /* force string conversion */
        }
        j = SvCUR(sv);
        if (maxlen < j)
@@ -1220,21 +1238,20 @@ PP(pp_select)
     HV *hv;
     GV * const newdefout = (PL_op->op_private > 0) ? (MUTABLE_GV(POPs)) : NULL;
     GV * egv = GvEGVx(PL_defoutgv);
+    GV * const *gvp;
 
     if (!egv)
        egv = PL_defoutgv;
     hv = isGV_with_GP(egv) ? GvSTASH(egv) : NULL;
-    if (! hv)
-       XPUSHs(&PL_sv_undef);
-    else {
-       GV * const * const gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
-       if (gvp && *gvp == egv) {
+    gvp = hv && HvENAME(hv)
+               ? (GV**)hv_fetch(hv, GvNAME(egv), HEK_UTF8(GvNAME_HEK(egv)) ? -GvNAMELEN(egv) : GvNAMELEN(egv), FALSE)
+               : NULL;
+    if (gvp && *gvp == egv) {
            gv_efullname4(TARG, PL_defoutgv, NULL, TRUE);
            XPUSHTARG;
-       }
-       else {
+    }
+    else {
            mXPUSHs(newRV(MUTABLE_SV(egv)));
-       }
     }
 
     if (newdefout) {
@@ -1249,17 +1266,18 @@ PP(pp_select)
 PP(pp_getc)
 {
     dVAR; dSP; dTARGET;
-    IO *io = NULL;
-    GV * const gv = (MAXARG==0) ? PL_stdingv : MUTABLE_GV(POPs);
+    GV * const gv =
+       MAXARG==0 || (!TOPs && !POPs) ? PL_stdingv : MUTABLE_GV(POPs);
+    IO *const io = GvIO(gv);
 
     if (MAXARG == 0)
        EXTEND(SP, 1);
 
-    if (gv && (io = GvIO(gv))) {
-       MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+    if (io) {
+       const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            const U32 gimme = GIMME_V;
-           S_tied_handle_method(aTHX_ "GETC", SP, io, mg, gimme);
+           Perl_tied_method(aTHX_ "GETC", SP, MUTABLE_SV(io), mg, gimme, 0);
            if (gimme == G_SCALAR) {
                SPAGAIN;
                SvSetMagicSV_nosteal(TARG, TOPs);
@@ -1347,12 +1365,10 @@ PP(pp_enterwrite)
 
     cv = GvFORM(fgv);
     if (!cv) {
-       const char *name;
        tmpsv = sv_newmortal();
        gv_efullname4(tmpsv, fgv, NULL, FALSE);
-       name = SvPV_nolen_const(tmpsv);
-       if (name && *name)
-           DIE(aTHX_ "Undefined format \"%s\" called", name);
+       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");
@@ -1391,7 +1407,8 @@ PP(pp_leavewrite)
                SV *topname;
                if (!IoFMT_NAME(io))
                    IoFMT_NAME(io) = savepv(GvNAME(gv));
-               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv)));
+               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%"HEKf"_TOP",
+                                        HEKfARG(GvNAME_HEK(gv))));
                topgv = gv_fetchsv(topname, 0, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
                  !gv_fetchpvs("top", GV_NOTQUAL, SVt_PVFM))
@@ -1438,11 +1455,9 @@ PP(pp_leavewrite)
        cv = GvFORM(fgv);
        if (!cv) {
            SV * const sv = sv_newmortal();
-           const char *name;
            gv_efullname4(sv, fgv, NULL, FALSE);
-           name = SvPV_nolen_const(sv);
-           if (name && *name)
-               DIE(aTHX_ "Undefined top format \"%s\" called", name);
+           if (SvPOK(sv) && *SvPV_nolen_const(sv))
+               DIE(aTHX_ "Undefined top format \"%"SVf"\" called", SVfARG(sv));
            else
                DIE(aTHX_ "Undefined top format called");
        }
@@ -1489,15 +1504,15 @@ PP(pp_leavewrite)
 PP(pp_prtf)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    IO *io;
     PerlIO *fp;
     SV *sv;
 
     GV * const gv
        = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
+    IO *const io = GvIO(gv);
 
-    if (gv && (io = GvIO(gv))) {
-       MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+    if (io) {
+       const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            if (MARK == ORIGMARK) {
                MEXTEND(SP, 1);
@@ -1505,18 +1520,15 @@ PP(pp_prtf)
                Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
                ++SP;
            }
-           PUSHMARK(MARK - 1);
-           *MARK = SvTIED_obj(MUTABLE_SV(io), mg);
-           PUTBACK;
-           ENTER;
-           call_method("PRINTF", G_SCALAR);
-           LEAVE;
-           return NORMAL;
+           return Perl_tied_method(aTHX_ "PRINTF", mark - 1, MUTABLE_SV(io),
+                                   mg,
+                                   G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
+                                   sp - mark);
        }
     }
 
     sv = newSV(0);
-    if (!(io = GvIO(gv))) {
+    if (!io) {
        report_evil_fh(gv);
        SETERRNO(EBADF,RMS_IFI);
        goto just_say_no;
@@ -1530,8 +1542,6 @@ PP(pp_prtf)
        goto just_say_no;
     }
     else {
-       if (SvTAINTED(MARK[1]))
-           TAINT_PROPER("printf");
        do_sprintf(sv, SP - MARK, MARK + 1);
        if (!do_print(sv, fp))
            goto just_say_no;
@@ -1556,7 +1566,7 @@ PP(pp_sysopen)
 {
     dVAR;
     dSP;
-    const int perm = (MAXARG > 3) ? POPi : 0666;
+    const int perm = (MAXARG > 3 && (TOPs || POPs)) ? POPi : 0666;
     const int mode = POPi;
     SV * const sv = POPs;
     GV * const gv = MUTABLE_GV(POPs);
@@ -1578,12 +1588,12 @@ PP(pp_sysopen)
 PP(pp_sysread)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
-    int offset;
+    SSize_t offset;
     IO *io;
     char *buffer;
+    STRLEN orig_size;
     SSize_t length;
     SSize_t count;
-    Sock_size_t bufsize;
     SV *bufsv;
     STRLEN blen;
     int fp_utf8;
@@ -1599,14 +1609,11 @@ PP(pp_sysread)
     if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
        && gv && (io = GvIO(gv)) )
     {
-       const MAGIC * mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+       const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
-           PUSHMARK(MARK-1);
-           *MARK = SvTIED_obj(MUTABLE_SV(io), mg);
-           ENTER;
-           call_method("READ", G_SCALAR);
-           LEAVE;
-           return NORMAL;
+           return Perl_tied_method(aTHX_ "READ", mark - 1, MUTABLE_SV(io), mg,
+                                   G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
+                                   sp - mark);
        }
     }
 
@@ -1647,6 +1654,7 @@ PP(pp_sysread)
 
 #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__)
        bufsize = sizeof (struct sockaddr_in);
@@ -1684,16 +1692,13 @@ PP(pp_sysread)
        PUSHs(TARG);
        RETURN;
     }
-#else
-    if (PL_op->op_type == OP_RECV)
-       DIE(aTHX_ PL_no_sock_func, "recv");
 #endif
     if (DO_UTF8(bufsv)) {
        /* offset adjust in characters not bytes */
        blen = sv_len_utf8(bufsv);
     }
     if (offset < 0) {
-       if (-offset > (int)blen)
+       if (-offset > (SSize_t)blen)
            DIE(aTHX_ "Offset outside string");
        offset += blen;
     }
@@ -1705,15 +1710,15 @@ PP(pp_sysread)
            offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
     }
  more_bytes:
-    bufsize = SvCUR(bufsv);
+    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) */
     buffer  = SvGROW(bufsv, (STRLEN)(length+offset+1));
-    if (offset > 0 && (Sock_size_t)offset > bufsize) { /* Zero any newly allocated space */
-       Zero(buffer+bufsize, offset-bufsize, char);
+    if (offset > 0 && offset > (SSize_t)orig_size) { /* Zero any newly allocated space */
+       Zero(buffer+orig_size, offset-orig_size, char);
     }
     buffer = buffer + offset;
     if (!buffer_utf8) {
@@ -1747,6 +1752,7 @@ PP(pp_sysread)
     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);
@@ -1825,10 +1831,9 @@ PP(pp_sysread)
     RETPUSHUNDEF;
 }
 
-PP(pp_send)
+PP(pp_syswrite)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
-    IO *io;
     SV *bufsv;
     const char *buffer;
     SSize_t retval;
@@ -1837,11 +1842,11 @@ PP(pp_send)
     const int op_type = PL_op->op_type;
     bool doing_utf8;
     U8 *tmpbuf = NULL;
-    
     GV *const gv = MUTABLE_GV(*++MARK);
-    if (PL_op->op_type == OP_SYSWRITE
-       && gv && (io = GvIO(gv))) {
-       MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+    IO *const io = GvIO(gv);
+
+    if (op_type == OP_SYSWRITE && io) {
+       const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            if (MARK == SP - 1) {
                SV *sv = *SP;
@@ -1849,12 +1854,9 @@ PP(pp_send)
                PUTBACK;
            }
 
-           PUSHMARK(ORIGMARK);
-           *(ORIGMARK+1) = SvTIED_obj(MUTABLE_SV(io), mg);
-           ENTER;
-           call_method("WRITE", G_SCALAR);
-           LEAVE;
-           return NORMAL;
+           return Perl_tied_method(aTHX_ "WRITE", mark - 1, MUTABLE_SV(io), mg,
+                                   G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK,
+                                   sp - mark);
        }
     }
     if (!gv)
@@ -1863,7 +1865,6 @@ PP(pp_send)
     bufsv = *++MARK;
 
     SETERRNO(0,0);
-    io = GvIO(gv);
     if (!io || !IoIFP(io) || IoTYPE(io) == IoTYPE_RDONLY) {
        retval = -1;
        if (io && IoIFP(io))
@@ -1901,7 +1902,23 @@ PP(pp_send)
        }
     }
 
-    if (op_type == OP_SYSWRITE) {
+#ifdef HAS_SOCKET
+    if (op_type == OP_SEND) {
+       const int flags = SvIVx(*++MARK);
+       if (SP > MARK) {
+           STRLEN mlen;
+           char * const sockbuf = SvPVx(*++MARK, mlen);
+           retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
+                                    flags, (struct sockaddr *)sockbuf, mlen);
+       }
+       else {
+           retval
+               = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags);
+       }
+    }
+    else
+#endif
+    {
        Size_t length = 0; /* This length is in characters.  */
        STRLEN blen_chars;
        IV offset;
@@ -1996,24 +2013,6 @@ PP(pp_send)
                                   buffer, length);
        }
     }
-#ifdef HAS_SOCKET
-    else {
-       const int flags = SvIVx(*++MARK);
-       if (SP > MARK) {
-           STRLEN mlen;
-           char * const sockbuf = SvPVx(*++MARK, mlen);
-           retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
-                                    flags, (struct sockaddr *)sockbuf, mlen);
-       }
-       else {
-           retval
-               = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags);
-       }
-    }
-#else
-    else
-       DIE(aTHX_ PL_no_sock_func, "send");
-#endif
 
     if (retval < 0)
        goto say_undef;
@@ -2040,7 +2039,7 @@ PP(pp_eof)
     dVAR; dSP;
     GV *gv;
     IO *io;
-    MAGIC *mg;
+    const MAGIC *mg;
     /*
      * in Perl 5.12 and later, the additional parameter is a bitmask:
      * 0 = eof
@@ -2074,7 +2073,7 @@ PP(pp_eof)
        RETPUSHNO;
 
     if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
-       return tied_handle_method1("EOF", SP, io, mg, newSVuv(which));
+       return tied_method1("EOF", SP, MUTABLE_SV(io), mg, newSVuv(which));
     }
 
     if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) {  /* eof() */
@@ -2104,16 +2103,17 @@ PP(pp_tell)
     GV *gv;
     IO *io;
 
-    if (MAXARG != 0)
+    if (MAXARG != 0 && (TOPs || POPs))
        PL_last_in_gv = MUTABLE_GV(POPs);
     else
        EXTEND(SP, 1);
     gv = PL_last_in_gv;
 
-    if (gv && (io = GvIO(gv))) {
-       MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+    io = GvIO(gv);
+    if (io) {
+       const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
-           return tied_handle_method("TELL", SP, io, mg);
+           return tied_method0("TELL", SP, MUTABLE_SV(io), mg);
        }
     }
     else if (!gv) {
@@ -2142,10 +2142,10 @@ PP(pp_sysseek)
 #endif
 
     GV * const gv = PL_last_in_gv = MUTABLE_GV(POPs);
-    IO *io;
+    IO *const io = GvIO(gv);
 
-    if (gv && (io = GvIO(gv))) {
-       MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
+    if (io) {
+       const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
 #if LSEEKSIZE > IVSIZE
            SV *const offset_sv = newSVnv((NV) offset);
@@ -2153,8 +2153,8 @@ PP(pp_sysseek)
            SV *const offset_sv = newSViv(offset);
 #endif
 
-           return tied_handle_method2("SEEK", SP, io, mg, offset_sv,
-                                      newSViv(whence));
+           return tied_method2("SEEK", SP, MUTABLE_SV(io), mg, offset_sv,
+                               newSViv(whence));
        }
     }
 
@@ -2199,19 +2199,19 @@ PP(pp_truncate)
     /* XXX Configure probe for the signedness of the length type of *truncate() needed? XXX */
     SETERRNO(0,0);
     {
+       SV * const sv = POPs;
        int result = 1;
        GV *tmpgv;
        IO *io;
 
-       if (PL_op->op_flags & OPf_SPECIAL) {
-           tmpgv = gv_fetchsv(POPs, 0, SVt_PVIO);
-
-       do_ftruncate_gv:
-           if (!GvIO(tmpgv))
+       if ((tmpgv = PL_op->op_flags & OPf_SPECIAL
+                      ? gv_fetchsv(sv, 0, SVt_PVIO)
+                      : MAYBE_DEREF_GV(sv) )) {
+           io = GvIO(tmpgv);
+           if (!io)
                result = 0;
            else {
                PerlIO *fp;
-               io = GvIOp(tmpgv);
            do_ftruncate_io:
                TAINT_PROPER("truncate");
                if (!(fp = IoIFP(io))) {
@@ -2228,24 +2228,12 @@ PP(pp_truncate)
                }
            }
        }
-       else {
-           SV * const sv = POPs;
-           const char *name;
-
-           if (isGV_with_GP(sv)) {
-               tmpgv = MUTABLE_GV(sv);         /* *main::FRED for example */
-               goto do_ftruncate_gv;
-           }
-           else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
-               tmpgv = MUTABLE_GV(SvRV(sv));   /* \*main::FRED for example */
-               goto do_ftruncate_gv;
-           }
-           else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
+       else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
                io = MUTABLE_IO(SvRV(sv)); /* *main::FRED{IO} for example */
                goto do_ftruncate_io;
-           }
-
-           name = SvPV_nolen_const(sv);
+       }
+       else {
+           const char * const name = SvPV_nomg_const_nolen(sv);
            TAINT_PROPER("truncate");
 #ifdef HAS_TRUNCATE
            if (truncate(name, len) < 0)
@@ -2352,17 +2340,11 @@ PP(pp_flock)
 #ifdef FLOCK
     dVAR; dSP; dTARGET;
     I32 value;
-    IO *io = NULL;
-    PerlIO *fp;
     const int argtype = POPi;
     GV * const gv = (MAXARG == 0) ? PL_last_in_gv : MUTABLE_GV(POPs);
+    IO *const io = GvIO(gv);
+    PerlIO *const fp = io ? IoIFP(io) : NULL;
 
-    if (gv && (io = GvIO(gv)))
-       fp = IoIFP(io);
-    else {
-       fp = NULL;
-       io = NULL;
-    }
     /* XXX Looks to me like io is always NULL at this point */
     if (fp) {
        (void)PerlIO_flush(fp);
@@ -2382,9 +2364,10 @@ PP(pp_flock)
 
 /* Sockets. */
 
+#ifdef HAS_SOCKET
+
 PP(pp_socket)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP;
     const int protocol = POPi;
     const int type = POPi;
@@ -2393,7 +2376,7 @@ PP(pp_socket)
     register IO * const io = gv ? GvIOn(gv) : NULL;
     int fd;
 
-    if (!gv || !io) {
+    if (!io) {
        report_evil_fh(gv);
        if (io && IoIFP(io))
            do_close(gv, FALSE);
@@ -2426,10 +2409,8 @@ PP(pp_socket)
 #endif
 
     RETPUSHYES;
-#else
-    DIE(aTHX_ PL_no_sock_func, "socket");
-#endif
 }
+#endif
 
 PP(pp_sockpair)
 {
@@ -2444,12 +2425,10 @@ PP(pp_sockpair)
     register IO * const io2 = gv2 ? GvIOn(gv2) : NULL;
     int fd[2];
 
-    if (!gv1 || !gv2 || !io1 || !io2) {
-       if (!gv1 || !io1)
-           report_evil_fh(gv1);
-       if (!gv2 || !io2)
-           report_evil_fh(gv2);
-    }
+    if (!io1)
+       report_evil_fh(gv1);
+    if (!io2)
+       report_evil_fh(gv2);
 
     if (io1 && IoIFP(io1))
        do_close(gv1, FALSE);
@@ -2488,9 +2467,10 @@ PP(pp_sockpair)
 #endif
 }
 
+#ifdef HAS_SOCKET
+
 PP(pp_bind)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP;
     SV * const addrsv = POPs;
     /* OK, so on what platform does bind modify addr?  */
@@ -2517,20 +2497,16 @@ nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
-#else
-    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
-#endif
 }
 
 PP(pp_listen)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP;
     const int backlog = POPi;
     GV * const gv = MUTABLE_GV(POPs);
     register IO * const io = gv ? GvIOn(gv) : NULL;
 
-    if (!gv || !io || !IoIFP(io))
+    if (!io || !IoIFP(io))
        goto nuts;
 
     if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
@@ -2542,14 +2518,10 @@ nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
-#else
-    DIE(aTHX_ PL_no_sock_func, "listen");
-#endif
 }
 
 PP(pp_accept)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP; dTARGET;
     register IO *nstio;
     register IO *gstio;
@@ -2620,14 +2592,10 @@ nuts:
 badexit:
     RETPUSHUNDEF;
 
-#else
-    DIE(aTHX_ PL_no_sock_func, "accept");
-#endif
 }
 
 PP(pp_shutdown)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP; dTARGET;
     const int how = POPi;
     GV * const gv = MUTABLE_GV(POPs);
@@ -2643,14 +2611,10 @@ nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
-#else
-    DIE(aTHX_ PL_no_sock_func, "shutdown");
-#endif
 }
 
 PP(pp_ssockopt)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP;
     const int optype = PL_op->op_type;
     SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(newSV(257)) : POPs;
@@ -2719,14 +2683,10 @@ nuts:
 nuts2:
     RETPUSHUNDEF;
 
-#else
-    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
-#endif
 }
 
 PP(pp_getpeername)
 {
-#ifdef HAS_SOCKET
     dVAR; dSP;
     const int optype = PL_op->op_type;
     GV * const gv = MUTABLE_GV(POPs);
@@ -2781,11 +2741,9 @@ nuts:
     SETERRNO(EBADF,SS_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
+}
 
-#else
-    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
 
 /* Stat calls. */
 
@@ -2794,66 +2752,67 @@ PP(pp_stat)
     dVAR;
     dSP;
     GV *gv = NULL;
-    IO *io;
+    IO *io = NULL;
     I32 gimme;
     I32 max = 13;
+    SV* sv;
 
-    if (PL_op->op_flags & OPf_REF) {
-       gv = cGVOP_gv;
+    if (PL_op->op_flags & OPf_REF ? (gv = cGVOP_gv, 1)
+                                  : !!(sv=POPs, gv = MAYBE_DEREF_GV(sv))) {
        if (PL_op->op_type == OP_LSTAT) {
            if (gv != PL_defgv) {
            do_fstat_warning_check:
                Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                              "lstat() on filehandle %s", gv ? GvENAME(gv) : "");
+                              "lstat() on filehandle%s%"SVf,
+                               gv ? " " : "",
+                               SVfARG(gv
+                                        ? sv_2mortal(newSVhek(GvENAME_HEK(gv)))
+                                        : &PL_sv_no));
            } else if (PL_laststype != OP_LSTAT)
+               /* diag_listed_as: The stat preceding %s wasn't an lstat */
                Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
        }
 
-      do_fstat:
        if (gv != PL_defgv) {
+           bool havefp;
+          do_fstat_have_io:
+           havefp = FALSE;
            PL_laststype = OP_STAT;
-           PL_statgv = gv;
+           PL_statgv = gv ? gv : (GV *)io;
            sv_setpvs(PL_statname, "");
             if(gv) {
                 io = GvIO(gv);
-                do_fstat_have_io:
-                if (io) {
+           }
+            if (io) {
                     if (IoIFP(io)) {
                         PL_laststatval = 
                             PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);   
+                        havefp = TRUE;
                     } else if (IoDIRP(io)) {
                         PL_laststatval =
                             PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);
+                        havefp = TRUE;
                     } else {
                         PL_laststatval = -1;
                     }
-               }
             }
+           else PL_laststatval = -1;
+           if (PL_laststatval < 0 && !havefp) report_evil_fh(gv);
         }
 
        if (PL_laststatval < 0) {
-           report_evil_fh(gv);
            max = 0;
        }
     }
     else {
-       SV* const sv = POPs;
-       if (isGV_with_GP(sv)) {
-           gv = MUTABLE_GV(sv);
-           goto do_fstat;
-       } else if(SvROK(sv) && isGV_with_GP(SvRV(sv))) {
-            gv = MUTABLE_GV(SvRV(sv));
-            if (PL_op->op_type == OP_LSTAT)
-                goto do_fstat_warning_check;
-            goto do_fstat;
-        } else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { 
+       if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { 
             io = MUTABLE_IO(SvRV(sv));
             if (PL_op->op_type == OP_LSTAT)
                 goto do_fstat_warning_check;
             goto do_fstat_have_io; 
         }
         
-       sv_setpv(PL_statname, SvPV_nolen_const(sv));
+       sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
        PL_statgv = NULL;
        PL_laststype = PL_op->op_type;
        if (PL_op->op_type == OP_LSTAT)
@@ -2877,7 +2836,15 @@ PP(pp_stat)
        EXTEND(SP, max);
        EXTEND_MORTAL(max);
        mPUSHi(PL_statcache.st_dev);
+#if ST_INO_SIZE > IVSIZE
+       mPUSHn(PL_statcache.st_ino);
+#else
+#   if ST_INO_SIGN <= 0
        mPUSHi(PL_statcache.st_ino);
+#   else
+       mPUSHu(PL_statcache.st_ino);
+#   endif
+#endif
        mPUSHu(PL_statcache.st_mode);
        mPUSHu(PL_statcache.st_nlink);
 #if Uid_t_size > IVSIZE
@@ -2928,62 +2895,81 @@ PP(pp_stat)
     RETURN;
 }
 
+/* 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_stacking_return_false(pTHX_ SV *ret) {
+    dSP;
+    OP *next = NORMAL;
+    while (OP_IS_FILETEST(next->op_type)
+       && next->op_private & OPpFT_STACKED)
+       next = next->op_next;
+    if (PL_op->op_flags & OPf_REF) PUSHs(ret);
+    else                          SETs(ret);
+    PUTBACK;
+    return next;
+}
+
+#define FT_RETURN_FALSE(X)                          \
+    STMT_START {                                     \
+       if (PL_op->op_private & OPpFT_STACKING)        \
+           return S_ft_stacking_return_false(aTHX_ X); \
+       RETURNX(PUSHs(X));                               \
+    } STMT_END
+#define FT_RETURN_TRUE(X)               \
+    RETURNX((void)(                      \
+       PL_op->op_private & OPpFT_STACKING \
+           ? PL_op->op_flags & OPf_REF     \
+               ? PUSHs((SV *)cGVOP_gv)      \
+               : 0                           \
+           : PUSHs(X)                         \
+    ))
+
+#define FT_RETURNNO    FT_RETURN_FALSE(&PL_sv_no)
+#define FT_RETURNUNDEF FT_RETURN_FALSE(&PL_sv_undef)
+#define FT_RETURNYES   FT_RETURN_TRUE(&PL_sv_yes)
+
 #define tryAMAGICftest_MG(chr) STMT_START { \
        if ( (SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG)) \
-               && S_try_amagic_ftest(aTHX_ chr)) \
-           return NORMAL; \
+               && PL_op->op_flags & OPf_KIDS) {     \
+           OP *next = S_try_amagic_ftest(aTHX_ chr);   \
+           if (next) return next;                        \
+       }                                                  \
     } STMT_END
 
-STATIC bool
+STATIC OP *
 S_try_amagic_ftest(pTHX_ char chr) {
     dVAR;
     dSP;
     SV* const arg = TOPs;
 
     assert(chr != '?');
-    SvGETMAGIC(arg);
+    if (!(PL_op->op_private & OPpFT_STACKING)) SvGETMAGIC(arg);
 
-    if ((PL_op->op_flags & OPf_KIDS)
-           && SvAMAGIC(TOPs))
+    if (SvAMAGIC(TOPs))
     {
        const char tmpchr = chr;
-       const OP *next;
        SV * const tmpsv = amagic_call(arg,
                                newSVpvn_flags(&tmpchr, 1, SVs_TEMP),
                                ftest_amg, AMGf_unary);
 
        if (!tmpsv)
-           return FALSE;
+           return NULL;
 
        SPAGAIN;
 
-       next = PL_op->op_next;
-       if (next->op_type >= OP_FTRREAD &&
-           next->op_type <= OP_FTBINARY &&
-           next->op_private & OPpFT_STACKED
-       ) {
-           if (SvTRUE(tmpsv))
-               /* leave the object alone */
-               return TRUE;
-       }
-
-       SETs(tmpsv);
-       PUTBACK;
-       return TRUE;
+       if (SvTRUE(tmpsv)) FT_RETURN_TRUE(tmpsv);
+       FT_RETURN_FALSE(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; } \
-    }
-
 PP(pp_ftrread)
 {
     dVAR;
@@ -3019,8 +3005,6 @@ PP(pp_ftrread)
     }
     tryAMAGICftest_MG(opchar);
 
-    STACKED_FTEST_CHECK;
-
     switch (PL_op->op_type) {
     case OP_FTRREAD:
 #if !(defined(HAS_ACCESS) && defined(R_OK))
@@ -3100,10 +3084,10 @@ PP(pp_ftrread)
     result = my_stat_flags(0);
     SPAGAIN;
     if (result < 0)
-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;
     if (cando(stat_mode, effective, &PL_statcache))
-       RETPUSHYES;
-    RETPUSHNO;
+       FT_RETURNYES;
+    FT_RETURNNO;
 }
 
 PP(pp_ftis)
@@ -3123,14 +3107,12 @@ PP(pp_ftis)
     }
     tryAMAGICftest_MG(opchar);
 
-    STACKED_FTEST_CHECK;
-
     result = my_stat_flags(0);
     SPAGAIN;
     if (result < 0)
-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;
     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.  */
@@ -3138,23 +3120,28 @@ PP(pp_ftis)
        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
-           PUSHi(PL_statcache.st_size);
+           sv_setiv(TARG, (IV)PL_statcache.st_size);
 #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:
-           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:
-           PUSHn( (((NV)PL_basetime - PL_statcache.st_ctime)) / 86400.0 );
+           sv_setnv(TARG,
+                   ((NV)PL_basetime - PL_statcache.st_ctime) / 86400.0 );
            break;
        }
+       SvSETMAGIC(TARG);
+       if (SvTRUE_nomg(TARG)) FT_RETURN_TRUE(TARG);
+       else                   FT_RETURN_FALSE(TARG);
     }
-    RETURN;
 }
 
 PP(pp_ftrowned)
@@ -3180,93 +3167,91 @@ PP(pp_ftrowned)
     }
     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) {
-       if ((PL_op->op_flags & OPf_REF) == 0 && (PL_op->op_private & OPpFT_STACKED) == 0)
+       if ((PL_op->op_flags & OPf_REF) == 0 && !(PL_op->op_private & OPpFT_STACKING))
            (void) POPs;
-       RETPUSHNO;
+       FT_RETURNNO;
     }
 #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)
+       if ((PL_op->op_flags & OPf_REF) == 0 && !(PL_op->op_private & OPpFT_STACKING))
            (void) POPs;
-       RETPUSHNO;
+       FT_RETURNNO;
     }
 #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)
+       if ((PL_op->op_flags & OPf_REF) == 0 && !(PL_op->op_private & OPpFT_STACKING))
            (void) POPs;
-       RETPUSHNO;
+       FT_RETURNNO;
     }
 #endif
 
     result = my_stat_flags(0);
     SPAGAIN;
     if (result < 0)
-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;
     switch (PL_op->op_type) {
     case OP_FTROWNED:
        if (PL_statcache.st_uid == PL_uid)
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
     case OP_FTEOWNED:
        if (PL_statcache.st_uid == PL_euid)
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
     case OP_FTZERO:
        if (PL_statcache.st_size == 0)
-           RETPUSHYES;
+           FT_RETURNYES;
        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))
-           RETPUSHYES;
+           FT_RETURNYES;
        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))
-           RETPUSHYES;
+           FT_RETURNYES;
        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))
-           RETPUSHYES;
+           FT_RETURNYES;
        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)
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
 #endif
 #ifdef S_ISVTX
     case OP_FTSVTX:
        if (PL_statcache.st_mode & S_ISVTX)
-           RETPUSHYES;
+           FT_RETURNYES;
        break;
 #endif
     }
-    RETPUSHNO;
+    FT_RETURNNO;
 }
 
 PP(pp_ftlink)
@@ -3280,10 +3265,10 @@ PP(pp_ftlink)
     SPAGAIN;
 
     if (result < 0)
-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;
     if (S_ISLNK(PL_statcache.st_mode))
-       RETPUSHYES;
-    RETPUSHNO;
+       FT_RETURNYES;
+    FT_RETURNNO;
 }
 
 PP(pp_fttty)
@@ -3292,39 +3277,30 @@ PP(pp_fttty)
     dSP;
     int fd;
     GV *gv;
-    SV *tmpsv = NULL;
     char *name = NULL;
     STRLEN namelen;
 
     tryAMAGICftest_MG('t');
 
-    STACKED_FTEST_CHECK;
-
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
-    else if (isGV_with_GP(TOPs))
-       gv = MUTABLE_GV(POPs);
-    else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
-       gv = MUTABLE_GV(SvRV(POPs));
     else {
-       tmpsv = POPs;
+      SV *tmpsv = PL_op->op_private & OPpFT_STACKING ? TOPs : POPs;
+      if (!(gv = MAYBE_DEREF_GV_nomg(tmpsv))) {
        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)));
-    else if (tmpsv && SvOK(tmpsv)) {
-       if (isDIGIT(*name))
+    else if (name && isDIGIT(*name))
            fd = atoi(name);
-       else 
-           RETPUSHUNDEF;
-    }
     else
-       RETPUSHUNDEF;
+       FT_RETURNUNDEF;
     if (PerlLIO_isatty(fd))
-       RETPUSHYES;
-    RETPUSHNO;
+       FT_RETURNYES;
+    FT_RETURNNO;
 }
 
 #if defined(atarist) /* this will work with atariST. Configure will
@@ -3345,50 +3321,53 @@ PP(pp_fttext)
     STDCHAR tbuf[512];
     register STDCHAR *s;
     register IO *io;
-    register SV *sv;
+    register SV *sv = NULL;
     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;
-    else if (isGV_with_GP(TOPs))
-       gv = MUTABLE_GV(POPs);
-    else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
-       gv = MUTABLE_GV(SvRV(POPs));
-    else
-       gv = NULL;
+       EXTEND(SP, 1);
+    }
+    else {
+      sv = PL_op->op_private & OPpFT_STACKING ? TOPs : POPs;
+      if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
+            == OPpFT_STACKED)
+       gv = PL_defgv;
+      else gv = MAYBE_DEREF_GV_nomg(sv);
+    }
 
     if (gv) {
-       EXTEND(SP, 1);
        if (gv == PL_defgv) {
            if (PL_statgv)
-               io = GvIO(PL_statgv);
+               io = SvTYPE(PL_statgv) == SVt_PVIO
+                   ? (IO *)PL_statgv
+                   : GvIO(PL_statgv);
            else {
-               sv = PL_statname;
                goto really_filename;
            }
        }
        else {
            PL_statgv = gv;
-           PL_laststatval = -1;
            sv_setpvs(PL_statname, "");
            io = GvIO(PL_statgv);
        }
+       PL_laststatval = -1;
+       PL_laststype = OP_STAT;
        if (io && IoIFP(io)) {
            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);
            if (PL_laststatval < 0)
-               RETPUSHUNDEF;
+               FT_RETURNUNDEF;
            if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */
                if (PL_op->op_type == OP_FTTEXT)
-                   RETPUSHNO;
+                   FT_RETURNNO;
                else
-                   RETPUSHYES;
+                   FT_RETURNYES;
             }
            if (PerlIO_get_cnt(IoIFP(io)) <= 0) {
                i = PerlIO_getc(IoIFP(io));
@@ -3396,7 +3375,7 @@ PP(pp_fttext)
                    (void)PerlIO_ungetc(IoIFP(io),i);
            }
            if (PerlIO_get_cnt(IoIFP(io)) <= 0) /* null file is anything */
-               RETPUSHYES;
+               FT_RETURNYES;
            len = PerlIO_get_bufsiz(IoIFP(io));
            s = (STDCHAR *) PerlIO_get_base(IoIFP(io));
            /* sfio can have large buffers - limit to 512 */
@@ -3404,35 +3383,39 @@ PP(pp_fttext)
                len = 512;
        }
        else {
-           report_evil_fh(cGVOP_gv);
            SETERRNO(EBADF,RMS_IFI);
-           RETPUSHUNDEF;
+           report_evil_fh(gv);
+           SETERRNO(EBADF,RMS_IFI);
+           FT_RETURNUNDEF;
        }
     }
     else {
-       sv = POPs;
+       sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
       really_filename:
        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 (!gv) {
+               PL_laststatval = -1;
+               PL_laststype = OP_STAT;
+           }
            if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
                                               '\n'))
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
-           RETPUSHUNDEF;
+           FT_RETURNUNDEF;
        }
+       PL_laststype = OP_STAT;
        PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
        if (PL_laststatval < 0) {
            (void)PerlIO_close(fp);
-           RETPUSHUNDEF;
+           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)
-               RETPUSHNO;              /* special case NFS directories */
-           RETPUSHYES;         /* null file is anything */
+               FT_RETURNNO;            /* special case NFS directories */
+           FT_RETURNYES;               /* null file is anything */
        }
        s = tbuf;
     }
@@ -3486,9 +3469,9 @@ PP(pp_fttext)
     }
 
     if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
-       RETPUSHNO;
+       FT_RETURNNO;
     else
-       RETPUSHYES;
+       FT_RETURNYES;
 }
 
 /* File calls. */
@@ -3504,15 +3487,8 @@ PP(pp_chdir)
        if (PL_op->op_flags & OPf_SPECIAL) {
            gv = gv_fetchsv(sv, 0, SVt_PVIO);
        }
-        else if (isGV_with_GP(sv)) {
-           gv = MUTABLE_GV(sv);
-        }
-       else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
-            gv = MUTABLE_GV(SvRV(sv));
-        }
-        else {
-           tmps = SvPV_nolen_const(sv);
-       }
+        else if (!(gv = MAYBE_DEREF_GV(sv)))
+               tmps = SvPV_nomg_const_nolen(sv);
     }
 
     if( !gv && (!tmps || !*tmps) ) {
@@ -3811,7 +3787,7 @@ PP(pp_mkdir)
     STRLEN len;
     const char *tmps;
     bool copy = FALSE;
-    const int mode = (MAXARG > 1) ? POPi : 0777;
+    const int mode = (MAXARG > 1 && (TOPs||((void)POPs,0))) ? POPi : 0777;
 
     TRIMSLASHES(tmps,len,copy);
 
@@ -3866,8 +3842,8 @@ PP(pp_open_dir)
 
     if ((IoIFP(io) || IoOFP(io)))
        Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                        "Opening filehandle %s also as a directory",
-                        GvENAME(gv));
+                        "Opening filehandle %"HEKf" also as a directory",
+                            HEKfARG(GvENAME_HEK(gv)) );
     if (IoDIRP(io))
        PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
@@ -3902,7 +3878,8 @@ PP(pp_readdir)
 
     if (!io || !IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "readdir() attempted on invalid dirhandle %s", GvENAME(gv));
+                      "readdir() attempted on invalid dirhandle %"HEKf,
+                            HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
 
@@ -3953,7 +3930,8 @@ PP(pp_telldir)
 
     if (!io || !IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "telldir() attempted on invalid dirhandle %s", GvENAME(gv));
+                      "telldir() attempted on invalid dirhandle %"HEKf,
+                            HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
 
@@ -3978,7 +3956,8 @@ PP(pp_seekdir)
 
     if (!io || !IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "seekdir() attempted on invalid dirhandle %s", GvENAME(gv));
+                      "seekdir() attempted on invalid dirhandle %"HEKf,
+                                HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
     (void)PerlDir_seek(IoDIRP(io), along);
@@ -4002,7 +3981,8 @@ PP(pp_rewinddir)
 
     if (!io || !IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "rewinddir() attempted on invalid dirhandle %s", GvENAME(gv));
+                      "rewinddir() attempted on invalid dirhandle %"HEKf,
+                                HEKfARG(GvENAME_HEK(gv)));
        goto nope;
     }
     (void)PerlDir_rewind(IoDIRP(io));
@@ -4025,7 +4005,8 @@ PP(pp_closedir)
 
     if (!io || !IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "closedir() attempted on invalid dirhandle %s", GvENAME(gv));
+                      "closedir() attempted on invalid dirhandle %"HEKf,
+                                HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
 #ifdef VOID_CLOSEDIR
@@ -4062,12 +4043,6 @@ PP(pp_fork)
     if (childpid < 0)
        RETSETUNDEF;
     if (!childpid) {
-       GV * const tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV);
-       if (tmpgv) {
-            SvREADONLY_off(GvSV(tmpgv));
-           sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
-            SvREADONLY_on(GvSV(tmpgv));
-        }
 #ifdef THREADS_HAVE_PIDS
        PL_ppid = (IV)getppid();
 #endif
@@ -4180,9 +4155,17 @@ PP(pp_system)
        Pid_t childpid;
        int pp[2];
        I32 did_pipes = 0;
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+       sigset_t newset, oldset;
+#endif
 
        if (PerlProc_pipe(pp) >= 0)
            did_pipes = 1;
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+       sigemptyset(&newset);
+       sigaddset(&newset, SIGCHLD);
+       sigprocmask(SIG_BLOCK, &newset, &oldset);
+#endif
        while ((childpid = PerlProc_fork()) == -1) {
            if (errno != EAGAIN) {
                value = -1;
@@ -4192,6 +4175,9 @@ PP(pp_system)
                    PerlLIO_close(pp[0]);
                    PerlLIO_close(pp[1]);
                }
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+               sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
                RETURN;
            }
            sleep(5);
@@ -4210,6 +4196,9 @@ PP(pp_system)
                result = wait4pid(childpid, &status, 0);
            } while (result == -1 && errno == EINTR);
 #ifndef PERL_MICRO
+#ifdef HAS_SIGPROCMASK
+           sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
            (void)rsignal_restore(SIGINT, &ihand);
            (void)rsignal_restore(SIGQUIT, &qhand);
 #endif
@@ -4232,7 +4221,7 @@ PP(pp_system)
                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 */
                    STATUS_NATIVE_CHILD_SET(-1);
                }
@@ -4240,6 +4229,9 @@ PP(pp_system)
            XPUSHi(STATUS_CURRENT);
            RETURN;
        }
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+       sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
        if (did_pipes) {
            PerlLIO_close(pp[0]);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
@@ -4363,7 +4355,8 @@ PP(pp_getpgrp)
 #ifdef HAS_GETPGRP
     dVAR; dSP; dTARGET;
     Pid_t pgrp;
-    const Pid_t pid = (MAXARG < 1) ? 0 : SvIVx(POPs);
+    const Pid_t pid =
+       (MAXARG < 1) ? 0 : TOPs ? SvIVx(POPs) : ((void)POPs, 0);
 
 #ifdef BSD_GETPGRP
     pgrp = (I32)BSD_GETPGRP(pid);
@@ -4385,15 +4378,12 @@ PP(pp_setpgrp)
     dVAR; dSP; dTARGET;
     Pid_t pgrp;
     Pid_t pid;
-    if (MAXARG < 2) {
-       pgrp = 0;
+    pgrp = MAXARG == 2 && (TOPs||POPs) ? POPi : 0;
+    if (MAXARG > 0) pid = TOPs && TOPi;
+    else {
        pid = 0;
        XPUSHi(-1);
     }
-    else {
-       pgrp = POPi;
-       pid = TOPi;
-    }
 
     TAINT_PROPER("setpgrp");
 #ifdef BSD_SETPGRP
@@ -4522,7 +4512,7 @@ PP(pp_gmtime)
        {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
         "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
 
-    if (MAXARG < 1) {
+    if (MAXARG < 1 || (!TOPs && ((void)POPs, 1))) {
        time_t now;
        (void)time(&now);
        when = (Time64_T)now;
@@ -4531,17 +4521,20 @@ PP(pp_gmtime)
        NV input = Perl_floor(POPn);
        when = (Time64_T)input;
        if (when != input) {
+           /* diag_listed_as: gmtime(%f) too large */
            Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                           "%s(%.0" NVff ") too large", opname, input);
        }
     }
 
     if ( TIME_LOWER_BOUND > when ) {
+       /* diag_listed_as: gmtime(%f) too small */
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "%s(%.0" NVff ") too small", opname, when);
        err = NULL;
     }
     else if( when > TIME_UPPER_BOUND ) {
+       /* diag_listed_as: gmtime(%f) too small */
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "%s(%.0" NVff ") too large", opname, when);
        err = NULL;
@@ -4622,7 +4615,7 @@ PP(pp_sleep)
     Time_t when;
 
     (void)time(&lasttime);
-    if (MAXARG < 1)
+    if (MAXARG < 1 || (!TOPs && !POPs))
        PerlProc_pause();
     else {
        duration = POPi;
@@ -4662,7 +4655,7 @@ PP(pp_shmwrite)
     PUSHi(value);
     RETURN;
 #else
-    return pp_semget();
+    return Perl_pp_semget(aTHX);
 #endif
 }
 
@@ -4699,7 +4692,7 @@ PP(pp_semctl)
     }
     RETURN;
 #else
-    return pp_semget();
+    return Perl_pp_semget(aTHX);
 #endif
 }
 
@@ -4814,7 +4807,7 @@ PP(pp_ghostent)
     }
     RETURN;
 #else
-    DIE(aTHX_ PL_no_sock_func, "gethostent");
+    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
 }
 
@@ -4887,7 +4880,7 @@ PP(pp_gnetent)
 
     RETURN;
 #else
-    DIE(aTHX_ PL_no_sock_func, "getnetent");
+    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
 }
 
@@ -4947,7 +4940,7 @@ PP(pp_gprotoent)
 
     RETURN;
 #else
-    DIE(aTHX_ PL_no_sock_func, "getprotoent");
+    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
 }
 
@@ -5022,100 +5015,110 @@ PP(pp_gservent)
 
     RETURN;
 #else
-    DIE(aTHX_ PL_no_sock_func, "getservent");
+    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
 }
 
 PP(pp_shostent)
 {
-#ifdef HAS_SETHOSTENT
     dVAR; dSP;
-    PerlSock_sethostent(TOPi);
-    RETSETYES;
+    const int stayopen = TOPi;
+    switch(PL_op->op_type) {
+    case OP_SHOSTENT:
+#ifdef HAS_SETHOSTENT
+       PerlSock_sethostent(stayopen);
 #else
-    DIE(aTHX_ PL_no_sock_func, "sethostent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_snetent)
-{
+       break;
 #ifdef HAS_SETNETENT
-    dVAR; dSP;
-    (void)PerlSock_setnetent(TOPi);
-    RETSETYES;
+    case OP_SNETENT:
+       PerlSock_setnetent(stayopen);
 #else
-    DIE(aTHX_ PL_no_sock_func, "setnetent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_sprotoent)
-{
+       break;
+    case OP_SPROTOENT:
 #ifdef HAS_SETPROTOENT
-    dVAR; dSP;
-    (void)PerlSock_setprotoent(TOPi);
-    RETSETYES;
+       PerlSock_setprotoent(stayopen);
 #else
-    DIE(aTHX_ PL_no_sock_func, "setprotoent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_sservent)
-{
+       break;
+    case OP_SSERVENT:
 #ifdef HAS_SETSERVENT
-    dVAR; dSP;
-    (void)PerlSock_setservent(TOPi);
-    RETSETYES;
+       PerlSock_setservent(stayopen);
 #else
-    DIE(aTHX_ PL_no_sock_func, "setservent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
+       break;
+    }
+    RETSETYES;
 }
 
 PP(pp_ehostent)
 {
-#ifdef HAS_ENDHOSTENT
     dVAR; dSP;
-    PerlSock_endhostent();
-    EXTEND(SP,1);
-    RETPUSHYES;
+    switch(PL_op->op_type) {
+    case OP_EHOSTENT:
+#ifdef HAS_ENDHOSTENT
+       PerlSock_endhostent();
 #else
-    DIE(aTHX_ PL_no_sock_func, "endhostent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_enetent)
-{
+       break;
+    case OP_ENETENT:
 #ifdef HAS_ENDNETENT
-    dVAR; dSP;
-    PerlSock_endnetent();
-    EXTEND(SP,1);
-    RETPUSHYES;
+       PerlSock_endnetent();
 #else
-    DIE(aTHX_ PL_no_sock_func, "endnetent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_eprotoent)
-{
+       break;
+    case OP_EPROTOENT:
 #ifdef HAS_ENDPROTOENT
-    dVAR; dSP;
-    PerlSock_endprotoent();
-    EXTEND(SP,1);
-    RETPUSHYES;
+       PerlSock_endprotoent();
 #else
-    DIE(aTHX_ PL_no_sock_func, "endprotoent");
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
-}
-
-PP(pp_eservent)
-{
+       break;
+    case OP_ESERVENT:
 #ifdef HAS_ENDSERVENT
-    dVAR; dSP;
-    PerlSock_endservent();
-    EXTEND(SP,1);
-    RETPUSHYES;
+       PerlSock_endservent();
+#else
+       DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
+#endif
+       break;
+    case OP_SGRENT:
+#if defined(HAS_GROUP) && defined(HAS_SETGRENT)
+       setgrent();
+#else
+       DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+#endif
+       break;
+    case OP_EGRENT:
+#if defined(HAS_GROUP) && defined(HAS_ENDGRENT)
+       endgrent();
+#else
+       DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+#endif
+       break;
+    case OP_SPWENT:
+#if defined(HAS_PASSWD) && defined(HAS_SETPWENT)
+       setpwent();
+#else
+       DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+#endif
+       break;
+    case OP_EPWENT:
+#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
+       endpwent();
 #else
-    DIE(aTHX_ PL_no_sock_func, "endservent");
+       DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
 #endif
+       break;
+    }
+    EXTEND(SP,1);
+    RETPUSHYES;
 }
 
 PP(pp_gpwent)
@@ -5261,7 +5264,7 @@ PP(pp_gpwent)
            const struct spwd * const spwent = getspnam(pwent->pw_name);
                          /* Save and restore errno so that
                           * underprivileged attempts seem
-                          * to have never made the unsccessful
+                          * to have never made the unsuccessful
                           * attempt to retrieve the shadow password. */
            RESTORE_ERRNO;
            if (spwent && spwent->sp_pwdp)
@@ -5351,28 +5354,6 @@ PP(pp_gpwent)
 #endif
 }
 
-PP(pp_spwent)
-{
-#if defined(HAS_PASSWD) && defined(HAS_SETPWENT)
-    dVAR; dSP;
-    setpwent();
-    RETPUSHYES;
-#else
-    DIE(aTHX_ PL_no_func, "setpwent");
-#endif
-}
-
-PP(pp_epwent)
-{
-#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
-    dVAR; dSP;
-    endpwent();
-    RETPUSHYES;
-#else
-    DIE(aTHX_ PL_no_func, "endpwent");
-#endif
-}
-
 PP(pp_ggrent)
 {
 #ifdef HAS_GROUP
@@ -5447,28 +5428,6 @@ PP(pp_ggrent)
 #endif
 }
 
-PP(pp_sgrent)
-{
-#if defined(HAS_GROUP) && defined(HAS_SETGRENT)
-    dVAR; dSP;
-    setgrent();
-    RETPUSHYES;
-#else
-    DIE(aTHX_ PL_no_func, "setgrent");
-#endif
-}
-
-PP(pp_egrent)
-{
-#if defined(HAS_GROUP) && defined(HAS_ENDGRENT)
-    dVAR; dSP;
-    endgrent();
-    RETPUSHYES;
-#else
-    DIE(aTHX_ PL_no_func, "endgrent");
-#endif
-}
-
 PP(pp_getlogin)
 {
 #ifdef HAS_GETLOGIN