This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Update epigraphs.pod with quote from Max Weber
[perl5.git] / pp_sys.c
diff --git a/pp_sys.c b/pp_sys.c
index 8fb75f5..8a6445e 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
@@ -77,18 +76,16 @@ extern int h_errno;
 #ifdef HAS_PASSWD
 # ifdef I_PWD
 #  include <pwd.h>
 #ifdef HAS_PASSWD
 # ifdef I_PWD
 #  include <pwd.h>
-# else
-#  if !defined(VMS)
+# elif !defined(VMS)
     struct passwd *getpwnam (char *);
     struct passwd *getpwuid (Uid_t);
     struct passwd *getpwnam (char *);
     struct passwd *getpwuid (Uid_t);
-#  endif
 # endif
 # ifdef HAS_GETPWENT
 # endif
 # ifdef HAS_GETPWENT
-#ifndef getpwent
+#  ifndef getpwent
   struct passwd *getpwent (void);
   struct passwd *getpwent (void);
-#elif defined (VMS) && defined (my_getpwent)
+#  elif defined (VMS) && defined (my_getpwent)
   struct passwd *Perl_my_getpwent (pTHX);
   struct passwd *Perl_my_getpwent (pTHX);
-#endif
+#  endif
 # endif
 #endif
 
 # endif
 #endif
 
@@ -100,9 +97,9 @@ extern int h_errno;
     struct group *getgrgid (Gid_t);
 # endif
 # ifdef HAS_GETGRENT
     struct group *getgrgid (Gid_t);
 # endif
 # ifdef HAS_GETGRENT
-#ifndef getgrent
+#  ifndef getgrent
     struct group *getgrent (void);
     struct group *getgrent (void);
-#endif
+#  endif
 # endif
 #endif
 
 # endif
 #endif
 
@@ -119,12 +116,10 @@ extern int h_errno;
 #   undef my_chsize
 # endif
 # define my_chsize PerlLIO_chsize
 #   undef my_chsize
 # endif
 # define my_chsize PerlLIO_chsize
+#elif defined(HAS_TRUNCATE)
+# define my_chsize PerlLIO_chsize
 #else
 #else
-# ifdef HAS_TRUNCATE
-#   define my_chsize PerlLIO_chsize
-# else
 I32 my_chsize(int fd, Off_t length);
 I32 my_chsize(int fd, Off_t length);
-# endif
 #endif
 
 #ifdef HAS_FLOCK
 #endif
 
 #ifdef HAS_FLOCK
@@ -142,12 +137,10 @@ I32 my_chsize(int fd, Off_t length);
 #  if defined(HAS_FCNTL) && defined(FCNTL_CAN_LOCK)
 #    define FLOCK fcntl_emulate_flock
 #    define FCNTL_EMULATE_FLOCK
 #  if defined(HAS_FCNTL) && defined(FCNTL_CAN_LOCK)
 #    define FLOCK fcntl_emulate_flock
 #    define FCNTL_EMULATE_FLOCK
-#  else /* no flock() or fcntl(F_SETLK,...) */
-#    ifdef HAS_LOCKF
-#      define FLOCK lockf_emulate_flock
-#      define LOCKF_EMULATE_FLOCK
-#    endif /* lockf */
-#  endif /* no flock() or fcntl(F_SETLK,...) */
+#  elif defined(HAS_LOCKF)
+#    define FLOCK lockf_emulate_flock
+#    define LOCKF_EMULATE_FLOCK
+#  endif
 
 #  ifdef FLOCK
      static int FLOCK (int, int);
 
 #  ifdef FLOCK
      static int FLOCK (int, int);
@@ -179,10 +172,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 +186,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... */
@@ -220,8 +213,8 @@ void endservent(void);
 #endif
 
 #if !defined(PERL_EFF_ACCESS) && defined(HAS_ACCESSX) && defined(ACC_SELF)
 #endif
 
 #if !defined(PERL_EFF_ACCESS) && defined(HAS_ACCESSX) && defined(ACC_SELF)
-    /* AIX */
-#   define PERL_EFF_ACCESS(p,f) (accessx((p), (f), ACC_SELF))
+    /* AIX's accessx() doesn't declare its argument const, unlike every other platform */
+#   define PERL_EFF_ACCESS(p,f) (accessx((char*)(p), (f), ACC_SELF))
 #endif
 
 
 #endif
 
 
@@ -241,13 +234,11 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 #if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID)
     Perl_croak(aTHX_ "switching effective uid is not implemented");
 #else
 #if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID)
     Perl_croak(aTHX_ "switching effective uid is not implemented");
 #else
-#ifdef HAS_SETREUID
+#  ifdef HAS_SETREUID
     if (setreuid(euid, ruid))
     if (setreuid(euid, ruid))
-#else
-#ifdef HAS_SETRESUID
+#  elif defined(HAS_SETRESUID)
     if (setresuid(euid, ruid, (Uid_t)-1))
     if (setresuid(euid, ruid, (Uid_t)-1))
-#endif
-#endif
+#  endif
        /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective uid failed");
 #endif
        /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective uid failed");
 #endif
@@ -255,13 +246,11 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 #if !defined(HAS_SETREGID) && !defined(HAS_SETRESGID)
     Perl_croak(aTHX_ "switching effective gid is not implemented");
 #else
 #if !defined(HAS_SETREGID) && !defined(HAS_SETRESGID)
     Perl_croak(aTHX_ "switching effective gid is not implemented");
 #else
-#ifdef HAS_SETREGID
+#  ifdef HAS_SETREGID
     if (setregid(egid, rgid))
     if (setregid(egid, rgid))
-#else
-#ifdef HAS_SETRESGID
+#  elif defined(HAS_SETRESGID)
     if (setresgid(egid, rgid, (Gid_t)-1))
     if (setresgid(egid, rgid, (Gid_t)-1))
-#endif
-#endif
+#  endif
        /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective gid failed");
 #endif
        /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective gid failed");
 #endif
@@ -270,21 +259,17 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 
 #ifdef HAS_SETREUID
     if (setreuid(ruid, euid))
 
 #ifdef HAS_SETREUID
     if (setreuid(ruid, euid))
-#else
-#ifdef HAS_SETRESUID
+#elif defined(HAS_SETRESUID)
     if (setresuid(ruid, euid, (Uid_t)-1))
 #endif
     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
     if (setregid(rgid, egid))
        /* diag_listed_as: leaving effective %s failed */
        Perl_croak(aTHX_ "leaving effective uid failed");
 
 #ifdef HAS_SETREGID
     if (setregid(rgid, egid))
-#else
-#ifdef HAS_SETRESGID
+#elif defined(HAS_SETRESGID)
     if (setresgid(rgid, egid, (Gid_t)-1))
 #endif
     if (setresgid(rgid, egid, (Gid_t)-1))
 #endif
-#endif
        /* diag_listed_as: leaving effective %s failed */
        Perl_croak(aTHX_ "leaving effective gid failed");
 
        /* diag_listed_as: leaving effective %s failed */
        Perl_croak(aTHX_ "leaving effective gid failed");
 
@@ -295,10 +280,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("``");
@@ -321,7 +306,7 @@ PP(pp_backtick)
            ENTER_with_name("backtick");
            SAVESPTR(PL_rs);
            PL_rs = &PL_sv_undef;
            ENTER_with_name("backtick");
            SAVESPTR(PL_rs);
            PL_rs = &PL_sv_undef;
-           sv_setpvs(TARG, "");        /* note that this preserves previous buffer */
+            SvPVCLEAR(TARG);        /* note that this preserves previous buffer */
            while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
                NOOP;
            LEAVE_with_name("backtick");
            while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
                NOOP;
            LEAVE_with_name("backtick");
@@ -356,26 +341,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));
 
 
-    tryAMAGICunTARGETlist(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 +372,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 +383,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 +400,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) {
@@ -433,7 +417,7 @@ PP(pp_warn)
     }
     else if (SP == MARK) {
        exsv = &PL_sv_no;
     }
     else if (SP == MARK) {
        exsv = &PL_sv_no;
-       EXTEND(SP, 1);
+       MEXTEND(SP, 1);
        SP = MARK + 1;
     }
     else {
        SP = MARK + 1;
     }
     else {
@@ -445,17 +429,18 @@ PP(pp_warn)
        /* well-formed exception supplied */
     }
     else {
        /* well-formed exception supplied */
     }
     else {
-      SvGETMAGIC(ERRSV);
-      if (SvROK(ERRSV)) {
-       if (SvGMAGICAL(ERRSV)) {
+      SV * const errsv = ERRSV;
+      SvGETMAGIC(errsv);
+      if (SvROK(errsv)) {
+       if (SvGMAGICAL(errsv)) {
            exsv = sv_newmortal();
            exsv = sv_newmortal();
-           sv_setsv_nomg(exsv, ERRSV);
+           sv_setsv_nomg(exsv, errsv);
        }
        }
-       else exsv = ERRSV;
+       else exsv = errsv;
       }
       }
-      else if (SvPOKp(ERRSV) ? SvCUR(ERRSV) : SvNIOKp(ERRSV)) {
+      else if (SvPOKp(errsv) ? SvCUR(errsv) : SvNIOKp(errsv)) {
        exsv = sv_newmortal();
        exsv = sv_newmortal();
-       sv_setsv_nomg(exsv, ERRSV);
+       sv_setsv_nomg(exsv, errsv);
        sv_catpvs(exsv, "\t...caught");
       }
       else {
        sv_catpvs(exsv, "\t...caught");
       }
       else {
@@ -463,18 +448,19 @@ PP(pp_warn)
       }
     }
     if (SvROK(exsv) && !PL_warnhook)
       }
     }
     if (SvROK(exsv) && !PL_warnhook)
-        Perl_warn(aTHX_ "%"SVf, SVfARG(exsv));
+        Perl_warn(aTHX_ "%" SVf, SVfARG(exsv));
     else warn_sv(exsv);
     RETSETYES;
 }
 
 PP(pp_die)
 {
     else warn_sv(exsv);
     RETSETYES;
 }
 
 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;
@@ -489,55 +475,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 (SvOK(errsv) && (SvPV_nomg(errsv,len), len)) {
+           exsv = sv_mortalcopy(errsv);
+           sv_catpvs(exsv, "\t...propagated");
+       }
+       else {
+           exsv = newSVpvs_flags("Died", SVs_TEMP);
+       }
     }
     }
-    else if (SvPV_const(ERRSV, len), len) {
-       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) {
@@ -566,7 +572,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;
@@ -590,7 +596,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;
@@ -609,15 +615,14 @@ PP(pp_open)
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
        if (IoDIRP(io))
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
        if (IoDIRP(io))
-           Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                            "Opening dirhandle %"HEKf" also as a file",
+           Perl_croak(aTHX_ "Cannot open %" HEKf " as a filehandle: it is already open as a dirhandle",
                             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 */
                             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 */
-           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);
        }
@@ -631,12 +636,12 @@ 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 );
     else if (PL_forkprocess == 0)              /* we are a new child */
     SP = ORIGMARK;
     if (ok)
        PUSHi( (I32)PL_forkprocess );
     else if (PL_forkprocess == 0)              /* we are a new child */
-       PUSHi(0);
+       PUSHs(&PL_sv_zero);
     else
        RETPUSHUNDEF;
     RETURN;
     else
        RETPUSHUNDEF;
     RETURN;
@@ -644,7 +649,9 @@ PP(pp_open)
 
 PP(pp_close)
 {
 
 PP(pp_close)
 {
-    dVAR; dSP;
+    dSP;
+    /* pp_coreargs pushes a NULL to indicate no args passed to
+     * CORE::close() */
     GV * const gv =
        MAXARG == 0 || (!TOPs && !POPs) ? PL_defoutgv : MUTABLE_GV(POPs);
 
     GV * const gv =
        MAXARG == 0 || (!TOPs && !POPs) ? PL_defoutgv : MUTABLE_GV(POPs);
 
@@ -656,7 +663,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);
            }
        }
     }
            }
        }
     }
@@ -667,7 +674,6 @@ PP(pp_close)
 PP(pp_pipe_op)
 {
 #ifdef HAS_PIPE
 PP(pp_pipe_op)
 {
 #ifdef HAS_PIPE
-    dVAR;
     dSP;
     IO *rstio;
     IO *wstio;
     dSP;
     IO *rstio;
     IO *wstio;
@@ -676,24 +682,19 @@ PP(pp_pipe_op)
     GV * const wgv = MUTABLE_GV(POPs);
     GV * const rgv = MUTABLE_GV(POPs);
 
     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);
 
-    if (PerlProc_pipe(fd) < 0)
+    if (PerlProc_pipe_cloexec(fd) < 0)
        goto badexit;
 
        goto badexit;
 
-    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPE_OPEN_MODE);
-    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPE_OPEN_MODE);
+    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r" PIPE_OPEN_MODE);
+    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w" PIPE_OPEN_MODE);
     IoOFP(rstio) = IoIFP(rstio);
     IoIFP(wstio) = IoOFP(wstio);
     IoTYPE(rstio) = IoTYPE_RDONLY;
     IoOFP(rstio) = IoIFP(rstio);
     IoIFP(wstio) = IoOFP(wstio);
     IoTYPE(rstio) = IoTYPE_RDONLY;
@@ -710,13 +711,9 @@ 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 */
-#endif
     RETPUSHYES;
 
     RETPUSHYES;
 
-badexit:
+  badexit:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_func, "pipe");
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_func, "pipe");
@@ -725,7 +722,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;
@@ -739,7 +736,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))) {
@@ -757,7 +770,6 @@ PP(pp_fileno)
 
 PP(pp_umask)
 {
 
 PP(pp_umask)
 {
-    dVAR;
     dSP;
 #ifdef HAS_UMASK
     dTARGET;
     dSP;
 #ifdef HAS_UMASK
     dTARGET;
@@ -788,7 +800,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;
@@ -810,7 +822,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);
        }
@@ -849,7 +861,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;
@@ -893,7 +905,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;
@@ -917,10 +933,36 @@ PP(pp_tie)
         * (Sorry obfuscation writers. You're not going to be given this one.)
         */
        stash = gv_stashsv(*MARK, 0);
         * (Sorry obfuscation writers. You're not going to be given this one.)
         */
        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));
-       }
+       if (!stash) {
+           if (SvROK(*MARK))
+               DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" SVf "\"",
+                   methname, SVfARG(*MARK));
+           else if (isGV(*MARK)) {
+               /* If the glob doesn't name an existing package, using
+                * SVfARG(*MARK) would yield "*Foo::Bar" or *main::Foo. So
+                * generate the name for the error message explicitly. */
+               SV *stashname = sv_2mortal(newSV(0));
+               gv_fullname4(stashname, (GV *) *MARK, NULL, FALSE);
+               DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" SVf "\"",
+                   methname, SVfARG(stashname));
+           }
+           else {
+               SV *stashname = !SvPOK(*MARK) ? &PL_sv_no
+                             : SvCUR(*MARK)  ? *MARK
+                             :                 sv_2mortal(newSVpvs("main"));
+               DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" SVf "\""
+                   " (perhaps you forgot to load \"%" SVf "\"?)",
+                   methname, SVfARG(stashname), SVfARG(stashname));
+           }
+       }
+       else if (!(gv = gv_fetchmethod(stash, methname))) {
+           /* The effective name can only be NULL for stashes that have
+            * been deleted from the symbol table, which this one can't
+            * be, since we just looked it up by name.
+            */
+           DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" HEKf "\"",
+               methname, HvENAME_HEK_NN(stash));
+       }
        ENTER_with_name("call_TIE");
        PUSHSTACKi(PERLSI_MAGIC);
        PUSHMARK(SP);
        ENTER_with_name("call_TIE");
        PUSHSTACKi(PERLSI_MAGIC);
        PUSHMARK(SP);
@@ -950,9 +992,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)
@@ -961,9 +1006,12 @@ 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 ((mg = SvTIED_mg(sv, how))) {
        SV * const obj = SvRV(SvTIED_obj(sv, mg));
-        if (obj) {
+        if (obj && SvSTASH(obj)) {
            GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE);
            CV *cv;
            if (gv && isGV(gv) && (cv = GvCV(gv))) {
            GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE);
            CV *cv;
            if (gv && isGV(gv) && (cv = GvCV(gv))) {
@@ -978,7 +1026,7 @@ PP(pp_untie)
             }
            else if (mg && SvREFCNT(obj) > 1) {
                Perl_ck_warner(aTHX_ packWARN(WARN_UNTIE),
             }
            else if (mg && SvREFCNT(obj) > 1) {
                Perl_ck_warner(aTHX_ packWARN(WARN_UNTIE),
-                              "untie attempted while %"UVuf" inner references still exist",
+                              "untie attempted while %" UVuf " inner references still exist",
                               (UV)SvREFCNT(obj) - 1 ) ;
            }
         }
                               (UV)SvREFCNT(obj) - 1 ) ;
            }
         }
@@ -989,26 +1037,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;
@@ -1052,9 +1104,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);
     }
@@ -1065,7 +1119,7 @@ PP(pp_dbmopen)
 PP(pp_sselect)
 {
 #ifdef HAS_SELECT
 PP(pp_sselect)
 {
 #ifdef HAS_SELECT
-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;
     I32 i;
     I32 j;
     char *s;
     I32 i;
     I32 j;
     char *s;
@@ -1077,6 +1131,7 @@ PP(pp_sselect)
     struct timeval *tbuf = &timebuf;
     I32 growsize;
     char *fd_sets[4];
     struct timeval *tbuf = &timebuf;
     I32 growsize;
     char *fd_sets[4];
+    SV *svs[4];
 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
        I32 masksize;
        I32 offset;
 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
        I32 masksize;
        I32 offset;
@@ -1092,23 +1147,27 @@ PP(pp_sselect)
 
     SP -= 4;
     for (i = 1; i <= 3; i++) {
 
     SP -= 4;
     for (i = 1; i <= 3; i++) {
-       SV * const sv = SP[i];
+       SV * const sv = svs[i] = SP[i];
        SvGETMAGIC(sv);
        if (!SvOK(sv))
            continue;
        if (SvREADONLY(sv)) {
        SvGETMAGIC(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),
                                    "Non-string passed as bitmask");
        if (!SvPOK(sv)) {
            if (!SvPOKp(sv))
                Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
                                    "Non-string passed as bitmask");
-           SvPV_force_nomg_nolen(sv);  /* force string conversion */
+           if (SvGAMAGIC(sv)) {
+               svs[i] = sv_newmortal();
+               sv_copypv_nomg(svs[i], sv);
+           }
+           else
+               SvPV_force_nomg_nolen(sv); /* force string conversion */
        }
        }
-       j = SvCUR(sv);
+       j = SvCUR(svs[i]);
        if (maxlen < j)
            maxlen = j;
     }
        if (maxlen < j)
            maxlen = j;
     }
@@ -1138,14 +1197,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;
@@ -1156,7 +1216,7 @@ PP(pp_sselect)
        tbuf = NULL;
 
     for (i = 1; i <= 3; i++) {
        tbuf = NULL;
 
     for (i = 1; i <= 3; i++) {
-       sv = SP[i];
+       sv = svs[i];
        if (!SvOK(sv) || SvCUR(sv) == 0) {
            fd_sets[i] = 0;
            continue;
        if (!SvOK(sv) || SvCUR(sv) == 0) {
            fd_sets[i] = 0;
            continue;
@@ -1203,7 +1263,7 @@ PP(pp_sselect)
 #endif
     for (i = 1; i <= 3; i++) {
        if (fd_sets[i]) {
 #endif
     for (i = 1; i <= 3; i++) {
        if (fd_sets[i]) {
-           sv = SP[i];
+           sv = svs[i];
 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
            s = SvPVX(sv);
            for (offset = 0; offset < growsize; offset += masksize) {
 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
            s = SvPVX(sv);
            for (offset = 0; offset < growsize; offset += masksize) {
@@ -1212,12 +1272,15 @@ PP(pp_sselect)
            }
            Safefree(fd_sets[i]);
 #endif
            }
            Safefree(fd_sets[i]);
 #endif
-           SvSETMAGIC(sv);
+           if (sv != SP[i])
+               SvSetMagicSV(SP[i], sv);
+           else
+               SvSETMAGIC(sv);
        }
     }
 
     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);
@@ -1229,12 +1292,15 @@ PP(pp_sselect)
 }
 
 /*
 }
 
 /*
+
+=for apidoc_section $GV
+
 =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
 */
@@ -1242,16 +1308,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;
+    GV *oldgv = PL_defoutgv;
+
     PERL_ARGS_ASSERT_SETDEFOUT;
     PERL_ARGS_ASSERT_SETDEFOUT;
+
     SvREFCNT_inc_simple_void_NN(gv);
     SvREFCNT_inc_simple_void_NN(gv);
-    SvREFCNT_dec(PL_defoutgv);
     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);
@@ -1282,7 +1350,9 @@ PP(pp_select)
 
 PP(pp_getc)
 {
 
 PP(pp_getc)
 {
-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;
+    /* pp_coreargs pushes a NULL to indicate no args passed to
+     * CORE::getc() */
     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);
@@ -1293,8 +1363,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);
@@ -1321,6 +1391,7 @@ PP(pp_getc)
        }
        SvUTF8_on(TARG);
     }
        }
        SvUTF8_on(TARG);
     }
+    else SvUTF8_off(TARG);
     PUSHTARG;
     RETURN;
 }
     PUSHTARG;
     RETURN;
 }
@@ -1328,25 +1399,18 @@ 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;
     PERL_CONTEXT *cx;
     PERL_CONTEXT *cx;
-    const I32 gimme = GIMME_V;
+    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);
-    if (CvDEPTH(cv) >= 2) {
-       PERL_STACK_OVERFLOW_CHECK();
+    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_push(CvPADLIST(cv), CvDEPTH(cv));
-    }
-    SAVECOMPPAD();
     PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
 
     setdefout(gv);         /* locally select filehandle so $% et al work */
     PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
 
     setdefout(gv);         /* locally select filehandle so $% et al work */
@@ -1355,17 +1419,15 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 
 PP(pp_enterwrite)
 {
 
 PP(pp_enterwrite)
 {
-    dVAR;
     dSP;
     GV *gv;
     IO *io;
     GV *fgv;
     CV *cv = NULL;
     dSP;
     GV *gv;
     IO *io;
     GV *fgv;
     CV *cv = NULL;
-    SV *tmpsv = NULL;
 
     if (MAXARG == 0) {
 
     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);
@@ -1385,9 +1447,9 @@ PP(pp_enterwrite)
 
     cv = GvFORM(fgv);
     if (!cv) {
 
     cv = GvFORM(fgv);
     if (!cv) {
-       tmpsv = sv_newmortal();
+        SV * const tmpsv = sv_newmortal();
        gv_efullname4(tmpsv, fgv, NULL, FALSE);
        gv_efullname4(tmpsv, fgv, NULL, FALSE);
-       DIE(aTHX_ "Undefined format \"%"SVf"\" called", SVfARG(tmpsv));
+       DIE(aTHX_ "Undefined format \"%" SVf "\" called", SVfARG(tmpsv));
     }
     IoFLAGS(io) &= ~IOf_DIDTOP;
     RETURNOP(doform(cv,gv,PL_op->op_next));
     }
     IoFLAGS(io) &= ~IOf_DIDTOP;
     RETURNOP(doform(cv,gv,PL_op->op_next));
@@ -1395,17 +1457,16 @@ PP(pp_enterwrite)
 
 PP(pp_leavewrite)
 {
 
 PP(pp_leavewrite)
 {
-    dVAR; dSP;
-    GV * const gv = cxstack[cxstack_ix].blk_format.gv;
+    dSP;
+    GV * const gv = CX_CUR()->blk_format.gv;
     IO * const io = GvIOp(gv);
     PerlIO *ofp;
     PerlIO *fp;
     IO * const io = GvIOp(gv);
     PerlIO *ofp;
     PerlIO *fp;
-    SV **newsp;
-    I32 gimme;
     PERL_CONTEXT *cx;
     OP *retop;
     PERL_CONTEXT *cx;
     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",
@@ -1423,7 +1484,7 @@ PP(pp_leavewrite)
                SV *topname;
                if (!IoFMT_NAME(io))
                    IoFMT_NAME(io) = savepv(GvNAME(gv));
                SV *topname;
                if (!IoFMT_NAME(io))
                    IoFMT_NAME(io) = savepv(GvNAME(gv));
-               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%"HEKf"_TOP",
+               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%" HEKf "_TOP",
                                         HEKfARG(GvNAME_HEK(gv))));
                topgv = gv_fetchsv(topname, 0, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
                                         HEKfARG(GvNAME_HEK(gv))));
                topgv = gv_fetchsv(topname, 0, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
@@ -1442,10 +1503,11 @@ PP(pp_leavewrite)
        if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear.  It still doesn't fit. */
            I32 lines = IoLINES_LEFT(io);
            const char *s = SvPVX_const(PL_formtarget);
        if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear.  It still doesn't fit. */
            I32 lines = IoLINES_LEFT(io);
            const char *s = SvPVX_const(PL_formtarget);
+            const char *e = SvEND(PL_formtarget);
            if (lines <= 0)             /* Yow, header didn't even fit!!! */
                goto forget_top;
            while (lines-- > 0) {
            if (lines <= 0)             /* Yow, header didn't even fit!!! */
                goto forget_top;
            while (lines-- > 0) {
-               s = strchr(s, '\n');
+               s = (char *) memchr(s, '\n', e - s);
                if (!s)
                    break;
                s++;
                if (!s)
                    break;
                s++;
@@ -1466,25 +1528,35 @@ PP(pp_leavewrite)
        PL_formtarget = PL_toptarget;
        IoFLAGS(io) |= IOf_DIDTOP;
        fgv = IoTOP_GV(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);
-           DIE(aTHX_ "Undefined top format \"%"SVf"\" called", SVfARG(sv));
+           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;
-    SP = newsp; /* ignore retval of formline */
-    LEAVE;
+    CX_POP(cx);
 
 
-    if (!io || !(fp = IoOFP(io))) {
+    EXTEND(SP, 1);
+
+    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
        if (io && IoIFP(io))
            report_wrongway_fh(gv, '<');
        else
@@ -1507,15 +1579,13 @@ PP(pp_leavewrite)
        }
     }
     PL_formtarget = PL_bodytarget;
        }
     }
     PL_formtarget = PL_bodytarget;
-    PERL_UNUSED_VAR(gimme);
     RETURNOP(retop);
 }
 
 PP(pp_prtf)
 {
     RETURNOP(retop);
 }
 
 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;
 
     GV * const gv
        = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
@@ -1533,14 +1603,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);
@@ -1555,6 +1624,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;
@@ -1563,13 +1633,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;
@@ -1577,7 +1645,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;
@@ -1587,8 +1654,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, NULL)) {
        IoLINES(GvIOp(gv)) = 0;
        PUSHs(&PL_sv_yes);
     }
        IoLINES(GvIOp(gv)) = 0;
        PUSHs(&PL_sv_yes);
     }
@@ -1598,9 +1664,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;
@@ -1617,14 +1686,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);
        }
@@ -1634,7 +1704,7 @@ PP(pp_sysread)
        goto say_undef;
     bufsv = *++MARK;
     if (! SvOK(bufsv))
        goto say_undef;
     bufsv = *++MARK;
     if (! SvOK(bufsv))
-       sv_setpvs(bufsv, "");
+        SvPVCLEAR(bufsv);
     length = SvIVx(*++MARK);
     if (length < 0)
        DIE(aTHX_ "Negative length");
     length = SvIVx(*++MARK);
     if (length < 0)
        DIE(aTHX_ "Negative length");
@@ -1649,7 +1719,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_croak(aTHX_
+                       "%s() isn't allowed 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);
@@ -1657,7 +1736,7 @@ PP(pp_sysread)
     }
     else {
        buffer = SvPV_force(bufsv, blen);
     }
     else {
        buffer = SvPV_force(bufsv, blen);
-       buffer_utf8 = !IN_BYTES && SvUTF8(bufsv);
+       buffer_utf8 = DO_UTF8(bufsv);
     }
     if (DO_UTF8(bufsv)) {
        blen = sv_len_utf8_nomg(bufsv);
     }
     if (DO_UTF8(bufsv)) {
        blen = sv_len_utf8_nomg(bufsv);
@@ -1672,6 +1751,10 @@ PP(pp_sysread)
     if (PL_op->op_type == OP_RECV) {
        Sock_size_t bufsize;
        char namebuf[MAXPATHLEN];
     if (PL_op->op_type == OP_RECV) {
        Sock_size_t bufsize;
        char namebuf[MAXPATHLEN];
+        if (fd < 0) {
+            SETERRNO(EBADF,SS_IVCHAN);
+            goto say_undef;
+        }
 #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
        bufsize = sizeof (struct sockaddr_in);
 #else
 #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
        bufsize = sizeof (struct sockaddr_in);
 #else
@@ -1683,17 +1766,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)
                                  (struct sockaddr *)namebuf, &bufsize);
        if (count < 0)
-           RETPUSHUNDEF;
+            goto say_undef;
        /* MSG_TRUNC can give oversized count; quietly lose it */
        if (count > length)
            count = length;
        /* 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);
@@ -1704,6 +1783,14 @@ 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;
        sv_setpvn(TARG, namebuf, bufsize);
        PUSHs(TARG);
        RETURN;
@@ -1721,13 +1808,17 @@ PP(pp_sysread)
        else
            offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
     }
        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);
@@ -1751,31 +1842,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 */
@@ -1843,19 +1928,22 @@ 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;
     STRLEN blen;
     SV *bufsv;
     const char *buffer;
     SSize_t retval;
     STRLEN blen;
-    STRLEN orig_blen_bytes;
     const int op_type = PL_op->op_type;
     bool doing_utf8;
     U8 *tmpbuf = NULL;
     GV *const gv = MUTABLE_GV(*++MARK);
     IO *const io = GvIO(gv);
     const int op_type = PL_op->op_type;
     bool doing_utf8;
     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);
@@ -1866,7 +1954,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);
        }
@@ -1886,19 +1974,21 @@ 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);
-    orig_blen_bytes = blen;
     doing_utf8 = DO_UTF8(bufsv);
 
     if (PerlIO_isutf8(IoIFP(io))) {
     doing_utf8 = DO_UTF8(bufsv);
 
     if (PerlIO_isutf8(IoIFP(io))) {
-       if (!SvUTF8(bufsv)) {
-           /* We don't modify the original scalar.  */
-           tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
-           buffer = (char *) tmpbuf;
-           doing_utf8 = TRUE;
-       }
+        Perl_croak(aTHX_
+                   "%s() isn't allowed on :utf8 handles",
+                   OP_DESC(PL_op));
     }
     else if (doing_utf8) {
        STRLEN tmplen = blen;
     }
     else if (doing_utf8) {
        STRLEN tmplen = blen;
@@ -1920,37 +2010,21 @@ 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
 #endif
     {
        Size_t length = 0; /* This length is in characters.  */
        }
     }
     else
 #endif
     {
        Size_t length = 0; /* This length is in characters.  */
-       STRLEN blen_chars;
        IV offset;
 
        IV offset;
 
-       if (doing_utf8) {
-           if (tmpbuf) {
-               /* The SV is bytes, and we've had to upgrade it.  */
-               blen_chars = orig_blen_bytes;
-           } else {
-               /* The SV really is UTF-8.  */
-               /* 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;
-       }
-
        if (MARK >= SP) {
        if (MARK >= SP) {
-           length = blen_chars;
+           length = blen;
        } else {
 #if Size_t_size > IVSIZE
            length = (Size_t)SvNVx(*++MARK);
        } else {
 #if Size_t_size > IVSIZE
            length = (Size_t)SvNVx(*++MARK);
@@ -1966,65 +2040,36 @@ PP(pp_syswrite)
        if (MARK < SP) {
            offset = SvIVx(*++MARK);
            if (offset < 0) {
        if (MARK < SP) {
            offset = SvIVx(*++MARK);
            if (offset < 0) {
-               if (-offset > (IV)blen_chars) {
+               if (-offset > (IV)blen) {
                    Safefree(tmpbuf);
                    DIE(aTHX_ "Offset outside string");
                }
                    Safefree(tmpbuf);
                    DIE(aTHX_ "Offset outside string");
                }
-               offset += blen_chars;
-           } else if (offset > (IV)blen_chars) {
+               offset += blen;
+           } else if (offset > (IV)blen) {
                Safefree(tmpbuf);
                DIE(aTHX_ "Offset outside string");
            }
        } else
            offset = 0;
                Safefree(tmpbuf);
                DIE(aTHX_ "Offset outside string");
            }
        } else
            offset = 0;
-       if (length > blen_chars - offset)
-           length = blen_chars - offset;
-       if (doing_utf8) {
-           /* Here we convert length from characters to bytes.  */
-           if (tmpbuf || SvGMAGICAL(bufsv) || SvAMAGIC(bufsv)) {
-               /* Either we had to convert the SV, or the SV is magical, or
-                  the SV has overloading, in which case we can't or mustn't
-                  or mustn't call it again.  */
-
-               buffer = (const char*)utf8_hop((const U8 *)buffer, offset);
-               length = utf8_hop((U8 *)buffer, length) - (U8 *)buffer;
-           } else {
-               /* It's a real UTF-8 SV, and it's not going to change under
-                  us.  Take advantage of any cache.  */
-               I32 start = offset;
-               I32 len_I32 = length;
-
-               /* Convert the start and end character positions to bytes.
-                  Remember that the second argument to sv_pos_u2b is relative
-                  to the first.  */
-               sv_pos_u2b(bufsv, &start, &len_I32);
-
-               buffer += start;
-               length = len_I32;
-           }
-       }
-       else {
-           buffer = buffer+offset;
-       }
+       if (length > blen - offset)
+           length = blen - offset;
+        buffer = buffer+offset;
+
 #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);
        }
     }
 
     if (retval < 0)
        goto say_undef;
     SP = ORIGMARK;
        }
     }
 
     if (retval < 0)
        goto say_undef;
     SP = ORIGMARK;
-    if (doing_utf8)
-        retval = utf8_length((U8*)buffer, (U8*)buffer + retval);
 
     Safefree(tmpbuf);
 #if Size_t_size > IVSIZE
 
     Safefree(tmpbuf);
 #if Size_t_size > IVSIZE
@@ -2042,7 +2087,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;
@@ -2076,25 +2121,29 @@ PP(pp_eof)
     }
 
     if (!gv)
     }
 
     if (!gv)
-       RETPUSHNO;
+       RETPUSHYES;
 
     if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
 
     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_count(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;
        }
     }
@@ -2105,7 +2154,7 @@ PP(pp_eof)
 
 PP(pp_tell)
 {
 
 PP(pp_tell)
 {
-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;
     GV *gv;
     IO *io;
 
     GV *gv;
     IO *io;
 
@@ -2119,7 +2168,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) {
@@ -2130,16 +2179,19 @@ PP(pp_tell)
     }
 
 #if LSEEKSIZE > IVSIZE
     }
 
 #if LSEEKSIZE > IVSIZE
-    PUSHn( do_tell(gv) );
+    PUSHn( (NV)do_tell(gv) );
 #else
 #else
-    PUSHi( do_tell(gv) );
+    PUSHi( (IV)do_tell(gv) );
 #endif
     RETURN;
 }
 
 #endif
     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);
@@ -2159,7 +2211,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));
        }
     }
@@ -2186,7 +2238,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
@@ -2224,13 +2275,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;
+                        }
+                    }
                }
            }
        }
                }
            }
        }
@@ -2246,11 +2308,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 (tmpfd < 0)
+#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_cloexec(name, mode);
+
+               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);
@@ -2267,18 +2342,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;
@@ -2301,6 +2379,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)
@@ -2312,13 +2391,11 @@ PP(pp_ioctl)
     else
 #ifndef HAS_FCNTL
       DIE(aTHX_ "fcntl is not implemented");
     else
 #ifndef HAS_FCNTL
       DIE(aTHX_ "fcntl is not implemented");
-#else
-#if defined(OS2) && defined(__EMX__)
+#elif defined(OS2) && defined(__EMX__)
        retval = fcntl(PerlIO_fileno(IoIFP(io)), func, (int)s);
 #else
        retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
 #endif
        retval = fcntl(PerlIO_fileno(IoIFP(io)), func, (int)s);
 #else
        retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
 #endif
-#endif
 
 #if defined(HAS_IOCTL) || defined(HAS_FCNTL)
     if (SvPOK(argsv)) {
 
 #if defined(HAS_IOCTL) || defined(HAS_FCNTL)
     if (SvPOK(argsv)) {
@@ -2344,7 +2421,7 @@ PP(pp_ioctl)
 PP(pp_flock)
 {
 #ifdef FLOCK
 PP(pp_flock)
 {
 #ifdef FLOCK
-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;
     I32 value;
     const int argtype = POPi;
     GV * const gv = MUTABLE_GV(POPs);
     I32 value;
     const int argtype = POPi;
     GV * const gv = MUTABLE_GV(POPs);
@@ -2364,7 +2441,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
 }
 
@@ -2374,31 +2451,24 @@ 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);
-    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");
     if (IoIFP(io))
        do_close(gv, FALSE);
 
     TAINT_PROPER("socket");
-    fd = PerlSock_socket(domain, type, protocol);
-    if (fd < 0)
+    fd = PerlSock_socket_cloexec(domain, type, protocol);
+    if (fd < 0) {
        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);
+    }
+    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;
     if (!IoIFP(io) || !IoOFP(io)) {
        if (IoIFP(io)) PerlIO_close(IoIFP(io));
     IoTYPE(io) = IoTYPE_SOCKET;
     if (!IoIFP(io) || !IoOFP(io)) {
        if (IoIFP(io)) PerlIO_close(IoIFP(io));
@@ -2406,13 +2476,6 @@ 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 */
-#endif
 
     RETPUSHYES;
 }
 
     RETPUSHYES;
 }
@@ -2421,37 +2484,30 @@ 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);
-    IO * const io1 = gv1 ? GvIOn(gv1) : NULL;
-    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");
     TAINT_PROPER("socketpair");
-    if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
+    if (PerlSock_socketpair_cloexec(domain, type, protocol, fd) < 0)
        RETPUSHUNDEF;
        RETPUSHUNDEF;
-    IoIFP(io1) = PerlIO_fdopen(fd[0], "r"SOCKET_OPEN_MODE);
-    IoOFP(io1) = PerlIO_fdopen(fd[0], "w"SOCKET_OPEN_MODE);
+    IoIFP(io1) = PerlIO_fdopen(fd[0], "r" SOCKET_OPEN_MODE);
+    IoOFP(io1) = PerlIO_fdopen(fd[0], "w" SOCKET_OPEN_MODE);
     IoTYPE(io1) = IoTYPE_SOCKET;
     IoTYPE(io1) = IoTYPE_SOCKET;
-    IoIFP(io2) = PerlIO_fdopen(fd[1], "r"SOCKET_OPEN_MODE);
-    IoOFP(io2) = PerlIO_fdopen(fd[1], "w"SOCKET_OPEN_MODE);
+    IoIFP(io2) = PerlIO_fdopen(fd[1], "r" SOCKET_OPEN_MODE);
+    IoOFP(io2) = PerlIO_fdopen(fd[1], "w" SOCKET_OPEN_MODE);
     IoTYPE(io2) = IoTYPE_SOCKET;
     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
        if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
     IoTYPE(io2) = IoTYPE_SOCKET;
     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
        if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
@@ -2462,10 +2518,6 @@ 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 */
-#endif
 
     RETPUSHYES;
 #else
 
     RETPUSHYES;
 #else
@@ -2475,31 +2527,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);
     IO * const io = GvIOn(gv);
     STRLEN len;
     SV * const addrsv = POPs;
     /* OK, so on what platform does bind modify addr?  */
     const char *addr;
     GV * const gv = MUTABLE_GV(POPs);
     IO * const io = GvIOn(gv);
     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;
@@ -2507,12 +2566,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);
-    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)
@@ -2520,7 +2579,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;
@@ -2528,9 +2587,8 @@ nuts:
 
 PP(pp_accept)
 {
 
 PP(pp_accept)
 {
-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;
     IO *nstio;
     IO *nstio;
-    IO *gstio;
     char namebuf[MAXPATHLEN];
 #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
     Sock_size_t len = sizeof (struct sockaddr_in);
     char namebuf[MAXPATHLEN];
 #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
     Sock_size_t len = sizeof (struct sockaddr_in);
@@ -2541,17 +2599,12 @@ 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;
 
     nstio = GvIOn(ngv);
     if (!gstio || !IoIFP(gstio))
        goto nuts;
 
     nstio = GvIOn(ngv);
-    fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len);
+    fd = PerlSock_accept_cloexec(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len);
 #if defined(OEMVS)
     if (len == 0) {
        /* Some platforms indicate zero length when an AF_UNIX client is
 #if defined(OEMVS)
     if (len == 0) {
        /* Some platforms indicate zero length when an AF_UNIX client is
@@ -2567,8 +2620,8 @@ PP(pp_accept)
        goto badexit;
     if (IoIFP(nstio))
        do_close(ngv, FALSE);
        goto badexit;
     if (IoIFP(nstio))
        do_close(ngv, FALSE);
-    IoIFP(nstio) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE);
-    IoOFP(nstio) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
+    IoIFP(nstio) = PerlIO_fdopen(fd, "r" SOCKET_OPEN_MODE);
+    IoOFP(nstio) = PerlIO_fdopen(fd, "w" SOCKET_OPEN_MODE);
     IoTYPE(nstio) = IoTYPE_SOCKET;
     if (!IoIFP(nstio) || !IoOFP(nstio)) {
        if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
     IoTYPE(nstio) = IoTYPE_SOCKET;
     if (!IoIFP(nstio) || !IoOFP(nstio)) {
        if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
@@ -2576,14 +2629,7 @@ 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 */
-#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
@@ -2591,37 +2637,40 @@ 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);
     IO * const io = GvIOn(gv);
 
     const int how = POPi;
     GV * const gv = MUTABLE_GV(POPs);
     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 int optype = PL_op->op_type;
     SV * const sv = (optype == OP_GSOCKOPT) ? sv_2mortal(newSV(257)) : POPs;
     const unsigned int optname = (unsigned int) POPi;
@@ -2631,10 +2680,12 @@ PP(pp_ssockopt)
     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);
@@ -2644,35 +2695,26 @@ 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);
        break;
     case OP_SSOCKOPT: {
        SvCUR_set(sv, len);
        *SvEND(sv) ='\0';
        PUSHs(sv);
        break;
     case OP_SSOCKOPT: {
-#if defined(__SYMBIAN32__)
-# define SETSOCKOPT_OPTION_VALUE_T void *
-#else
-# define SETSOCKOPT_OPTION_VALUE_T const char *
-#endif
-       /* XXX TODO: We need to have a proper type (a Configure probe,
-        * etc.) for what the C headers think of the third argument of
-        * setsockopt(), the option_value read-only buffer: is it
-        * a "char *", or a "void *", const or not.  Some compilers
-        * don't take kindly to e.g. assuming that "char *" implicitly
-        * promotes to a "void *", or to explicitly promoting/demoting
-        * consts to non/vice versa.  The "const void *" is the SUS
-        * definition, but that does not fly everywhere for the above
-        * reasons. */
-           SETSOCKOPT_OPTION_VALUE_T buf;
+           const char *buf;
            int aint;
            if (SvPOKp(sv)) {
                STRLEN l;
            int aint;
            if (SvPOKp(sv)) {
                STRLEN l;
-               buf = (SETSOCKOPT_OPTION_VALUE_T) SvPV_const(sv, l);
+               buf = SvPV_const(sv, l);
                len = l;
            }
            else {
                aint = (int)SvIV(sv);
                len = l;
            }
            else {
                aint = (int)SvIV(sv);
-               buf = (SETSOCKOPT_OPTION_VALUE_T) &aint;
+               buf = (const char *) &aint;
                len = sizeof(int);
            }
            if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
                len = sizeof(int);
            }
            if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
@@ -2683,17 +2725,20 @@ 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);
     IO * const io = GvIOn(gv);
     const int optype = PL_op->op_type;
     GV * const gv = MUTABLE_GV(POPs);
     IO * const io = GvIOn(gv);
@@ -2701,15 +2746,21 @@ PP(pp_getpeername)
     SV *sv;
     int fd;
 
     SV *sv;
     int fd;
 
-    if (!io || !IoIFP(io))
+    if (!IoIFP(io))
        goto nuts;
 
        goto nuts;
 
-    sv = sv_2mortal(newSV(257));
-    (void)SvPOK_only(sv);
+#ifdef HAS_SOCKADDR_STORAGE
+    len = sizeof(struct sockaddr_storage);
+#else
     len = 256;
     len = 256;
+#endif
+    sv = sv_2mortal(newSV(len+1));
+    (void)SvPOK_only(sv);
     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)
@@ -2742,10 +2793,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;
 }
 
@@ -2753,13 +2804,14 @@ nuts2:
 
 /* Stat calls. */
 
 
 /* Stat calls. */
 
+/* also used for: pp_lstat() */
+
 PP(pp_stat)
 {
 PP(pp_stat)
 {
-    dVAR;
     dSP;
     GV *gv = NULL;
     IO *io = NULL;
     dSP;
     GV *gv = NULL;
     IO *io = NULL;
-    I32 gimme;
+    U8 gimme;
     I32 max = 13;
     SV* sv;
 
     I32 max = 13;
     SV* sv;
 
@@ -2769,7 +2821,7 @@ 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%s%"SVf,
+                              "lstat() on filehandle%s%" SVf,
                                gv ? " " : "",
                                SVfARG(gv
                                         ? sv_2mortal(newSVhek(GvENAME_HEK(gv)))
                                gv ? " " : "",
                                SVfARG(gv
                                         ? sv_2mortal(newSVhek(GvENAME_HEK(gv)))
@@ -2779,31 +2831,40 @@ PP(pp_stat)
                Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
        }
 
                Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
        }
 
-       if (gv != PL_defgv) {
-           bool havefp;
+       if (gv == PL_defgv) {
+           if (PL_laststatval < 0)
+               SETERRNO(EBADF,RMS_IFI);
+       } else {
           do_fstat_have_io:
           do_fstat_have_io:
-           havefp = FALSE;
            PL_laststype = OP_STAT;
            PL_statgv = gv ? gv : (GV *)io;
            PL_laststype = OP_STAT;
            PL_statgv = gv ? gv : (GV *)io;
-           sv_setpvs(PL_statname, "");
+            SvPVCLEAR(PL_statname);
             if(gv) {
                 io = GvIO(gv);
            }
             if (io) {
                     if (IoIFP(io)) {
             if(gv) {
                 io = GvIO(gv);
            }
             if (io) {
                     if (IoIFP(io)) {
-                        PL_laststatval = 
-                            PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);   
-                        havefp = TRUE;
+                        int fd = PerlIO_fileno(IoIFP(io));
+                        if (fd < 0) {
+                           report_evil_fh(gv);
+                            PL_laststatval = -1;
+                            SETERRNO(EBADF,RMS_IFI);
+                        } else {
+                            PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
+                        }
                     } 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 {
                     } else {
+                       report_evil_fh(gv);
                         PL_laststatval = -1;
                         PL_laststatval = -1;
+                       SETERRNO(EBADF,RMS_IFI);
                     }
                     }
-            }
-           else PL_laststatval = -1;
-           if (PL_laststatval < 0 && !havefp) report_evil_fh(gv);
+            } else {
+               report_evil_fh(gv);
+               PL_laststatval = -1;
+               SETERRNO(EBADF,RMS_IFI);
+           }
         }
 
        if (PL_laststatval < 0) {
         }
 
        if (PL_laststatval < 0) {
@@ -2811,24 +2872,35 @@ PP(pp_stat)
        }
     }
     else {
        }
     }
     else {
+        const char *file;
+        const char *temp;
+        STRLEN len;
        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; 
         }
        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; 
         }
-        
        SvTAINTED_off(PL_statname); /* previous tainting irrelevant */
        SvTAINTED_off(PL_statname); /* previous tainting irrelevant */
-       sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
+        temp = SvPV_nomg_const(sv, len);
+       sv_setpv(PL_statname, temp);
        PL_statgv = NULL;
        PL_laststype = PL_op->op_type;
        PL_statgv = NULL;
        PL_laststype = PL_op->op_type;
-       if (PL_op->op_type == OP_LSTAT)
-           PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(PL_statname), &PL_statcache);
+        file = SvPV_nolen_const(PL_statname);
+        if (!IS_SAFE_PATHNAME(temp, len, OP_NAME(PL_op))) {
+            PL_laststatval = -1;
+        }
+       else if (PL_op->op_type == OP_LSTAT)
+           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_STMT(-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_STMT;
+            }
            max = 0;
        }
     }
            max = 0;
        }
     }
@@ -2843,35 +2915,69 @@ PP(pp_stat)
        EXTEND(SP, max);
        EXTEND_MORTAL(max);
        mPUSHi(PL_statcache.st_dev);
        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
+       {
+           /*
+            * We try to represent st_ino as a native IV or UV where
+            * possible, but fall back to a decimal string where
+            * necessary.  The code to generate these decimal strings
+            * is quite obtuse, because (a) we're portable to non-POSIX
+            * platforms where st_ino might be signed; (b) we didn't
+            * necessarily detect at Configure time whether st_ino is
+            * signed; (c) we're portable to non-POSIX platforms where
+            * ino_t isn't defined, so have no name for the type of
+            * st_ino; and (d) sprintf() doesn't necessarily support
+            * integers as large as st_ino.
+            */
+           bool neg;
+           Stat_t s;
+           CLANG_DIAG_IGNORE_STMT(-Wtautological-compare);
+           GCC_DIAG_IGNORE_STMT(-Wtype-limits);
+           neg = PL_statcache.st_ino < 0;
+           GCC_DIAG_RESTORE_STMT;
+           CLANG_DIAG_RESTORE_STMT;
+           if (neg) {
+               s.st_ino = (IV)PL_statcache.st_ino;
+               if (LIKELY(s.st_ino == PL_statcache.st_ino)) {
+                   mPUSHi(s.st_ino);
+               } else {
+                   char buf[sizeof(s.st_ino)*3+1], *p;
+                   s.st_ino = PL_statcache.st_ino;
+                   for (p = buf + sizeof(buf); p != buf+1; ) {
+                       Stat_t t;
+                       t.st_ino = s.st_ino / 10;
+                       *--p = '0' + (int)(t.st_ino*10 - s.st_ino);
+                       s.st_ino = t.st_ino;
+                   }
+                   while (*p == '0')
+                       p++;
+                   *--p = '-';
+                   mPUSHp(p, buf+sizeof(buf) - p);
+               }
+           } else {
+               s.st_ino = (UV)PL_statcache.st_ino;
+               if (LIKELY(s.st_ino == PL_statcache.st_ino)) {
+                   mPUSHu(s.st_ino);
+               } else {
+                   char buf[sizeof(s.st_ino)*3], *p;
+                   s.st_ino = PL_statcache.st_ino;
+                   for (p = buf + sizeof(buf); p != buf; ) {
+                       Stat_t t;
+                       t.st_ino = s.st_ino / 10;
+                       *--p = '0' + (int)(s.st_ino - t.st_ino*10);
+                       s.st_ino = t.st_ino;
+                   }
+                   while (*p == '0')
+                       p++;
+                   mPUSHp(p, buf+sizeof(buf) - p);
+               }
+           }
+       }
        mPUSHu(PL_statcache.st_mode);
        mPUSHu(PL_statcache.st_nlink);
        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
@@ -2926,7 +3032,7 @@ S_ft_return_false(pTHX_ SV *ret) {
     PUTBACK;
 
     if (PL_op->op_private & OPpFT_STACKING) {
     PUTBACK;
 
     if (PL_op->op_private & OPpFT_STACKING) {
-        while (OP_IS_FILETEST(next->op_type)
+        while (next && OP_IS_FILETEST(next->op_type)
                && next->op_private & OPpFT_STACKED)
             next = next->op_next;
     }
                && next->op_private & OPpFT_STACKED)
             next = next->op_next;
     }
@@ -2958,11 +3064,10 @@ S_ft_return_true(pTHX_ SV *ret) {
 
 STATIC OP *
 S_try_amagic_ftest(pTHX_ char chr) {
 
 STATIC OP *
 S_try_amagic_ftest(pTHX_ char chr) {
-    dVAR;
     SV *const arg = *PL_stack_sp;
 
     assert(chr != '?');
     SV *const arg = *PL_stack_sp;
 
     assert(chr != '?');
-    if (!(PL_op->op_private & OPpFT_STACKING)) SvGETMAGIC(arg);
+    if (!(PL_op->op_private & OPpFT_STACKED)) SvGETMAGIC(arg);
 
     if (SvAMAGIC(arg))
     {
 
     if (SvAMAGIC(arg))
     {
@@ -2981,12 +3086,14 @@ S_try_amagic_ftest(pTHX_ char chr) {
 }
 
 
 }
 
 
+/* 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.  */
@@ -3045,7 +3152,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
@@ -3067,8 +3174,12 @@ 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 = SvPV_nolen(*PL_stack_sp);
-       if (effective) {
+        STRLEN len;
+       const char *name = SvPV(*PL_stack_sp, len);
+        if (!IS_SAFE_PATHNAME(name, len, OP_NAME(PL_op))) {
+            result = -1;
+        }
+       else if (effective) {
 #  ifdef PERL_EFF_ACCESS
            result = PERL_EFF_ACCESS(name, access_mode);
 #  else
 #  ifdef PERL_EFF_ACCESS
            result = PERL_EFF_ACCESS(name, access_mode);
 #  else
@@ -3099,9 +3210,11 @@ PP(pp_ftrread)
     FT_RETURNNO;
 }
 
     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 = '?';
@@ -3146,14 +3259,18 @@ PP(pp_ftis)
            break;
        }
        SvSETMAGIC(TARG);
            break;
        }
        SvSETMAGIC(TARG);
-       return SvTRUE_nomg(TARG)
+       return SvTRUE_nomg_NN(TARG)
             ? S_ft_return_true(aTHX_ TARG) : S_ft_return_false(aTHX_ TARG);
     }
 }
 
             ? S_ft_return_true(aTHX_ TARG) : S_ft_return_false(aTHX_ TARG);
     }
 }
 
+
+/* 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 = '?';
 
@@ -3173,24 +3290,6 @@ PP(pp_ftrowned)
     }
     tryAMAGICftest_MG(opchar);
 
     }
     tryAMAGICftest_MG(opchar);
 
-    /* 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) {
-       FT_RETURNNO;
-    }
-#endif
-#ifndef S_ISGID
-    if(PL_op->op_type == OP_FTSGID) {
-       FT_RETURNNO;
-    }
-#endif
-#ifndef S_ISVTX
-    if(PL_op->op_type == OP_FTSVTX) {
-       FT_RETURNNO;
-    }
-#endif
-
     result = my_stat_flags(0);
     if (result < 0)
        FT_RETURNUNDEF;
     result = my_stat_flags(0);
     if (result < 0)
        FT_RETURNUNDEF;
@@ -3255,7 +3354,6 @@ PP(pp_ftrowned)
 
 PP(pp_ftlink)
 {
 
 PP(pp_ftlink)
 {
-    dVAR;
     I32 result;
 
     tryAMAGICftest_MG('l');
     I32 result;
 
     tryAMAGICftest_MG('l');
@@ -3270,11 +3368,11 @@ PP(pp_ftlink)
 
 PP(pp_fttty)
 {
 
 PP(pp_fttty)
 {
-    dVAR;
     int fd;
     GV *gv;
     char *name = NULL;
     STRLEN namelen;
     int fd;
     GV *gv;
     char *name = NULL;
     STRLEN namelen;
+    UV uv;
 
     tryAMAGICftest_MG('t');
 
 
     tryAMAGICftest_MG('t');
 
@@ -3290,20 +3388,26 @@ PP(pp_fttty)
 
     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 (name && isDIGIT(*name))
-           fd = atoi(name);
+    else if (name && isDIGIT(*name) && grok_atoUV(name, &uv, NULL) && uv <= PERL_INT_MAX)
+        fd = (int)uv;
     else
     else
+       fd = -1;
+    if (fd < 0) {
+        SETERRNO(EBADF,RMS_IFI);
        FT_RETURNUNDEF;
        FT_RETURNUNDEF;
+    }
     if (PerlLIO_isatty(fd))
        FT_RETURNYES;
     FT_RETURNNO;
 }
 
     if (PerlLIO_isatty(fd))
        FT_RETURNYES;
     FT_RETURNNO;
 }
 
+
+/* also used for: pp_ftbinary() */
+
 PP(pp_fttext)
 {
 PP(pp_fttext)
 {
-    dVAR;
     I32 i;
     I32 i;
-    I32 len;
+    SSize_t len;
     I32 odd = 0;
     STDCHAR tbuf[512];
     STDCHAR *s;
     I32 odd = 0;
     STDCHAR tbuf[512];
     STDCHAR *s;
@@ -3311,6 +3415,7 @@ PP(pp_fttext)
     SV *sv = NULL;
     GV *gv;
     PerlIO *fp;
     SV *sv = NULL;
     GV *gv;
     PerlIO *fp;
+    const U8 * first_variant;
 
     tryAMAGICftest_MG(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
 
 
     tryAMAGICftest_MG(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
 
@@ -3336,15 +3441,21 @@ PP(pp_fttext)
        }
        else {
            PL_statgv = gv;
        }
        else {
            PL_statgv = gv;
-           sv_setpvs(PL_statname, "");
+            SvPVCLEAR(PL_statname);
            io = GvIO(PL_statgv);
        }
        PL_laststatval = -1;
        PL_laststype = OP_STAT;
        if (io && IoIFP(io)) {
            io = GvIO(PL_statgv);
        }
        PL_laststatval = -1;
        PL_laststype = OP_STAT;
        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)
                FT_RETURNUNDEF;
            if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */
            if (PL_laststatval < 0)
                FT_RETURNUNDEF;
            if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */
@@ -3357,9 +3468,10 @@ PP(pp_fttext)
                i = PerlIO_getc(IoIFP(io));
                if (i != EOF)
                    (void)PerlIO_ungetc(IoIFP(io),i);
                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 */
-               FT_RETURNYES;
            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 */
@@ -3374,23 +3486,47 @@ PP(pp_fttext)
        }
     }
     else {
        }
     }
     else {
-       sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
+        const char *file;
+        const char *temp;
+        STRLEN temp_len;
+        int fd; 
+
+        assert(sv);
+        temp = SvPV_nomg_const(sv, temp_len);
+       sv_setpv(PL_statname, temp);
+        if (!IS_SAFE_PATHNAME(temp, temp_len, OP_NAME(PL_op))) {
+            PL_laststatval = -1;
+            PL_laststype = OP_STAT;
+            FT_RETURNUNDEF;
+        }
       really_filename:
       really_filename:
+        file = SvPVX_const(PL_statname);
        PL_statgv = NULL;
        PL_statgv = NULL;
-       if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
+       if (!(fp = PerlIO_open(file, "r"))) {
            if (!gv) {
                PL_laststatval = -1;
                PL_laststype = OP_STAT;
            }
            if (!gv) {
                PL_laststatval = -1;
                PL_laststype = OP_STAT;
            }
-           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_STMT(-Wformat-nonliteral);
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
+                GCC_DIAG_RESTORE_STMT;
+            }
            FT_RETURNUNDEF;
        }
        PL_laststype = OP_STAT;
            FT_RETURNUNDEF;
        }
        PL_laststype = OP_STAT;
-       PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
+        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) {
        if (PL_laststatval < 0) {
+            dSAVE_ERRNO;
            (void)PerlIO_close(fp);
            (void)PerlIO_close(fp);
+            RESTORE_ERRNO;
            FT_RETURNUNDEF;
        }
        PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
            FT_RETURNUNDEF;
        }
        PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
@@ -3405,7 +3541,6 @@ PP(pp_fttext)
     }
 
     /* now scan s to look for textiness */
     }
 
     /* 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 */
@@ -3413,43 +3548,52 @@ PP(pp_fttext)
        --len;
 #endif
 
        --len;
 #endif
 
+    assert(len);
+    if (! is_utf8_invariant_string_loc((U8 *) s, len, &first_variant)) {
+
+        /* Here contains a variant under UTF-8 .  See if the entire string is
+         * UTF-8. */
+        if (is_utf8_fixed_width_buf_flags(first_variant,
+                                          len - ((char *) first_variant - (char *) s),
+                                          0))
+        {
+            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 */
@@ -3462,7 +3606,7 @@ PP(pp_fttext)
 
 PP(pp_chdir)
 {
 
 PP(pp_chdir)
 {
-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;
     const char *tmps = NULL;
     GV *gv = NULL;
 
     const char *tmps = NULL;
     GV *gv = NULL;
 
@@ -3470,15 +3614,25 @@ 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);
+                PUSHs(&PL_sv_zero);
+                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;
 
+        EXTEND(SP, 1);
         if (    (svp = hv_fetchs(table, "HOME", FALSE))
              || (svp = hv_fetchs(table, "LOGDIR", FALSE))
 #ifdef VMS
         if (    (svp = hv_fetchs(table, "HOME", FALSE))
              || (svp = hv_fetchs(table, "LOGDIR", FALSE))
 #ifdef VMS
@@ -3486,12 +3640,11 @@ PP(pp_chdir)
 #endif
            )
         {
 #endif
            )
         {
-            if( MAXARG == 1 )
-                deprecate("chdir('') or chdir(undef) as chdir()");
             tmps = SvPV_nolen_const(*svp);
         }
         else {
             tmps = SvPV_nolen_const(*svp);
         }
         else {
-            PUSHi(0);
+            PUSHs(&PL_sv_zero);
+            SETERRNO(EINVAL, LIB_INVARG);
             TAINT_PROPER("chdir");
             RETURN;
         }
             TAINT_PROPER("chdir");
             RETURN;
         }
@@ -3505,19 +3658,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
@@ -3530,11 +3683,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);
+    PUSHs(&PL_sv_zero);
+    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;
@@ -3545,7 +3709,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 );
@@ -3557,19 +3721,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 (PerlProc_geteuid() || 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);
@@ -3580,10 +3747,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;
 
@@ -3601,20 +3771,16 @@ PP(pp_link)
        const char * const tmps = SvPV_nolen_const(TOPs);
        TAINT_PROPER(PL_op_desc[op_type]);
        result =
        const char * const tmps = SvPV_nolen_const(TOPs);
        TAINT_PROPER(PL_op_desc[op_type]);
        result =
-#  if defined(HAS_LINK)
-#    if defined(HAS_SYMLINK)
+#  if defined(HAS_LINK) && defined(HAS_SYMLINK)
            /* Both present - need to choose which.  */
            (op_type == OP_LINK) ?
            /* Both present - need to choose which.  */
            (op_type == OP_LINK) ?
-           PerlLIO_link(tmps, tmps2) : symlink(tmps, tmps2);
-#    else
+           PerlLIO_link(tmps, tmps2) : PerlLIO_symlink(tmps, tmps2);
+#  elif defined(HAS_LINK)
     /* Only have link, so calls to pp_symlink will have DIE()d above.  */
        PerlLIO_link(tmps, tmps2);
     /* Only have link, so calls to pp_symlink will have DIE()d above.  */
        PerlLIO_link(tmps, tmps2);
-#    endif
-#  else
-#    if defined(HAS_SYMLINK)
+#  elif defined(HAS_SYMLINK)
     /* Only have symlink, so calls to pp_link will have DIE()d above.  */
     /* Only have symlink, so calls to pp_link will have DIE()d above.  */
-       symlink(tmps, tmps2);
-#    endif
+       PerlLIO_symlink(tmps, tmps2);
 #  endif
     }
 
 #  endif
     }
 
@@ -3622,6 +3788,9 @@ PP(pp_link)
     RETURN;
 }
 #else
     RETURN;
 }
 #else
+
+/* also used for: pp_symlink() */
+
 PP(pp_link)
 {
     /* Have neither.  */
 PP(pp_link)
 {
     /* Have neither.  */
@@ -3631,21 +3800,21 @@ 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;
-    len = readlink(tmps, buf, sizeof(buf) - 1);
+    /* NOTE: if the length returned by readlink() is sizeof(buf) - 1,
+     * it is impossible to know whether the result was truncated. */
+    len = PerlLIO_readlink(tmps, buf, sizeof(buf) - 1);
     if (len < 0)
        RETPUSHUNDEF;
     if (len < 0)
        RETPUSHUNDEF;
+    buf[len] = '\0';
     PUSHp(buf, len);
     RETURN;
 #else
     PUSHp(buf, len);
     RETURN;
 #else
@@ -3693,13 +3862,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)) {
@@ -3730,7 +3893,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)
@@ -3767,11 +3931,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);
 
@@ -3794,7 +3958,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;
@@ -3816,25 +3980,21 @@ 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);
     IO * const io = GvIOn(gv);
 
     const char * const dirname = POPpconstx;
     GV * const gv = MUTABLE_GV(POPs);
     IO * const io = GvIOn(gv);
 
-    if (!io)
-       goto nope;
-
     if ((IoIFP(io) || IoOFP(io)))
     if ((IoIFP(io) || IoOFP(io)))
-       Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                        "Opening filehandle %"HEKf" also as a directory",
-                            HEKfARG(GvENAME_HEK(gv)) );
+       Perl_croak(aTHX_ "Cannot open %" HEKf " as a dirhandle: it is already open as a filehandle",
+                        HEKfARG(GvENAME_HEK(gv)));
     if (IoDIRP(io))
        PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
        goto nope;
 
     RETPUSHYES;
     if (IoDIRP(io))
        PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
        goto nope;
 
     RETPUSHYES;
-nope:
+  nope:
     if (!errno)
        SETERRNO(EBADF,RMS_DIR);
     RETPUSHUNDEF;
     if (!errno)
        SETERRNO(EBADF,RMS_DIR);
     RETPUSHUNDEF;
@@ -3851,18 +4011,17 @@ 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);
     const Direntry_t *dp;
     IO * const io = GvIOn(gv);
 
     GV * const gv = MUTABLE_GV(POPs);
     const Direntry_t *dp;
     IO * const io = GvIOn(gv);
 
-    if (!io || !IoDIRP(io)) {
+    if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "readdir() attempted on invalid dirhandle %"HEKf,
+                      "readdir() attempted on invalid dirhandle %" HEKf,
                             HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
                             HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
@@ -3876,22 +4035,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;
@@ -3901,7 +4058,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.
@@ -3912,16 +4069,16 @@ PP(pp_telldir)
     GV * const gv = MUTABLE_GV(POPs);
     IO * const io = GvIOn(gv);
 
     GV * const gv = MUTABLE_GV(POPs);
     IO * const io = GvIOn(gv);
 
-    if (!io || !IoDIRP(io)) {
+    if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "telldir() attempted on invalid dirhandle %"HEKf,
+                      "telldir() attempted on invalid dirhandle %" HEKf,
                             HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
 
     PUSHi( PerlDir_tell(IoDIRP(io)) );
     RETURN;
                             HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
 
     PUSHi( PerlDir_tell(IoDIRP(io)) );
     RETURN;
-nope:
+  nope:
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
@@ -3933,21 +4090,21 @@ 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);
     IO * const io = GvIOn(gv);
 
     const long along = POPl;
     GV * const gv = MUTABLE_GV(POPs);
     IO * const io = GvIOn(gv);
 
-    if (!io || !IoDIRP(io)) {
+    if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "seekdir() attempted on invalid dirhandle %"HEKf,
+                      "seekdir() attempted on invalid dirhandle %" HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
     (void)PerlDir_seek(IoDIRP(io), along);
 
     RETPUSHYES;
                                 HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
     (void)PerlDir_seek(IoDIRP(io), along);
 
     RETPUSHYES;
-nope:
+  nope:
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
@@ -3959,19 +4116,19 @@ 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);
     IO * const io = GvIOn(gv);
 
     GV * const gv = MUTABLE_GV(POPs);
     IO * const io = GvIOn(gv);
 
-    if (!io || !IoDIRP(io)) {
+    if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "rewinddir() attempted on invalid dirhandle %"HEKf,
+                      "rewinddir() attempted on invalid dirhandle %" HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));
        goto nope;
     }
     (void)PerlDir_rewind(IoDIRP(io));
     RETPUSHYES;
                                 HEKfARG(GvENAME_HEK(gv)));
        goto nope;
     }
     (void)PerlDir_rewind(IoDIRP(io));
     RETPUSHYES;
-nope:
+  nope:
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
@@ -3983,13 +4140,13 @@ 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);
     IO * const io = GvIOn(gv);
 
     GV * const gv = MUTABLE_GV(POPs);
     IO * const io = GvIOn(gv);
 
-    if (!io || !IoDIRP(io)) {
+    if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "closedir() attempted on invalid dirhandle %"HEKf,
+                      "closedir() attempted on invalid dirhandle %" HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
                                 HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
@@ -4004,7 +4161,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;
@@ -4018,15 +4175,15 @@ nope:
 PP(pp_fork)
 {
 #ifdef HAS_FORK
 PP(pp_fork)
 {
 #ifdef HAS_FORK
-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;
     Pid_t childpid;
     Pid_t childpid;
-#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+#ifdef HAS_SIGPROCMASK
     sigset_t oldmask, newmask;
 #endif
 
     EXTEND(SP, 1);
     PERL_FLUSHALL_FOR_CHILD;
     sigset_t oldmask, newmask;
 #endif
 
     EXTEND(SP, 1);
     PERL_FLUSHALL_FOR_CHILD;
-#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+#ifdef HAS_SIGPROCMASK
     sigfillset(&newmask);
     sigprocmask(SIG_SETMASK, &newmask, &oldmask);
 #endif
     sigfillset(&newmask);
     sigprocmask(SIG_SETMASK, &newmask, &oldmask);
 #endif
@@ -4038,7 +4195,7 @@ PP(pp_fork)
            for (sig = 1; sig < SIG_SIZE; sig++)
                PL_psig_pend[sig] = 0;
     }
            for (sig = 1; sig < SIG_SIZE; sig++)
                PL_psig_pend[sig] = 0;
     }
-#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+#ifdef HAS_SIGPROCMASK
     {
        dSAVE_ERRNO;
        sigprocmask(SIG_SETMASK, &oldmask, NULL);
     {
        dSAVE_ERRNO;
        sigprocmask(SIG_SETMASK, &oldmask, NULL);
@@ -4046,7 +4203,7 @@ PP(pp_fork)
     }
 #endif
     if (childpid < 0)
     }
 #endif
     if (childpid < 0)
-       RETSETUNDEF;
+       RETPUSHUNDEF;
     if (!childpid) {
 #ifdef PERL_USES_PL_PIDSTATUS
        hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
     if (!childpid) {
 #ifdef PERL_USES_PL_PIDSTATUS
        hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
@@ -4054,8 +4211,7 @@ PP(pp_fork)
     }
     PUSHi(childpid);
     RETURN;
     }
     PUSHi(childpid);
     RETURN;
-#else
-#  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+#elif (defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)) || defined(__amigaos4__)
     dSP; dTARGET;
     Pid_t childpid;
 
     dSP; dTARGET;
     Pid_t childpid;
 
@@ -4063,19 +4219,18 @@ 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;
     PUSHi(childpid);
     RETURN;
-#  else
+#else
     DIE(aTHX_ PL_no_func, "fork");
     DIE(aTHX_ PL_no_func, "fork");
-#  endif
 #endif
 }
 
 PP(pp_wait)
 {
 #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)
 #endif
 }
 
 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;
 
@@ -4103,10 +4258,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)
@@ -4123,6 +4284,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
@@ -4132,38 +4294,89 @@ 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) {
-       TAINT_ENV();
-       while (++MARK <= SP) {
-           (void)SvPV_nolen_const(*MARK);      /* stringify for taint check */
-           if (PL_tainted)
-               break;
+    while (++MARK <= SP) {
+       SV *origsv = *MARK, *copysv;
+       STRLEN len;
+       char *pv;
+       SvGETMAGIC(origsv);
+#if defined(WIN32) || defined(__VMS)
+       /*
+        * Because of a nasty platform-specific variation on the meaning
+        * of arguments to this op, we must preserve numeric arguments
+        * as numeric, not just retain the string value.
+        */
+       if (SvNIOK(origsv) || SvNIOKp(origsv)) {
+           copysv = newSV_type(SVt_PVNV);
+           sv_2mortal(copysv);
+           if (SvPOK(origsv) || SvPOKp(origsv)) {
+               pv = SvPV_nomg(origsv, len);
+               sv_setpvn(copysv, pv, len);
+               SvPOK_off(copysv);
+           }
+           if (SvIOK(origsv) || SvIOKp(origsv))
+               SvIV_set(copysv, SvIVX(origsv));
+           if (SvNOK(origsv) || SvNOKp(origsv))
+               SvNV_set(copysv, SvNVX(origsv));
+           SvFLAGS(copysv) |= SvFLAGS(origsv) &
+               (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK|
+                   SVf_UTF8|SVf_IVisUV);
+       } else
+#endif
+       {
+           pv = SvPV_nomg(origsv, len);
+           copysv = newSVpvn_flags(pv, len,
+                       (SvFLAGS(origsv) & SVf_UTF8) | SVs_TEMP);
        }
        }
-       MARK = ORIGMARK;
+       *MARK = copysv;
+    }
+    MARK = ORIGMARK;
+
+    if (TAINTING_get) {
+       TAINT_ENV();
        TAINT_PROPER("system");
     }
     PERL_FLUSHALL_FOR_CHILD;
        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
 
        sigset_t newset, oldset;
 #endif
 
-       if (PerlProc_pipe(pp) >= 0)
+       if (PerlProc_pipe_cloexec(pp) >= 0)
            did_pipes = 1;
            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);
@@ -4177,26 +4390,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);
@@ -4205,15 +4426,13 @@ PP(pp_system)
            (void)rsignal_restore(SIGQUIT, &qhand);
 #endif
            STATUS_NATIVE_CHILD_SET(result == -1 ? -1 : status);
            (void)rsignal_restore(SIGQUIT, &qhand);
 #endif
            STATUS_NATIVE_CHILD_SET(result == -1 ? -1 : status);
-           do_execfree();      /* free any memory child malloced on fork */
            SP = ORIGMARK;
            if (did_pipes) {
                int errkid;
                unsigned n = 0;
            SP = ORIGMARK;
            if (did_pipes) {
                int errkid;
                unsigned n = 0;
-               SSize_t n1;
 
                while (n < sizeof(int)) {
 
                while (n < sizeof(int)) {
-                   n1 = PerlLIO_read(pp[0],
+                    const SSize_t n1 = PerlLIO_read(pp[0],
                                      (void*)(((char*)&errkid)+n),
                                      (sizeof(int)) - n);
                    if (n1 <= 0)
                                      (void*)(((char*)&errkid)+n),
                                      (sizeof(int)) - n);
                    if (n1 <= 0)
@@ -4225,21 +4444,25 @@ PP(pp_system)
                    if (n != sizeof(int))
                        DIE(aTHX_ "panic: kid popen errno read, n=%u", n);
                    errno = errkid;             /* Propagate errno from kid */
                    if (n != sizeof(int))
                        DIE(aTHX_ "panic: kid popen errno read, n=%u", n);
                    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
        sigprocmask(SIG_SETMASK, &oldset, NULL);
 #endif
-       if (did_pipes) {
+       if (did_pipes)
            PerlLIO_close(pp[0]);
            PerlLIO_close(pp[0]);
-#if defined(HAS_FCNTL) && defined(F_SETFD)
-           fcntl(pp[1], F_SETFD, FD_CLOEXEC);
-#endif
-       }
        if (PL_op->op_flags & OPf_STACKED) {
            SV * const really = *++MARK;
            value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
        if (PL_op->op_flags & OPf_STACKED) {
            SV * const really = *++MARK;
            value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
@@ -4249,6 +4472,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 */
@@ -4256,14 +4480,14 @@ PP(pp_system)
     result = 0;
     if (PL_op->op_flags & OPf_STACKED) {
        SV * const really = *++MARK;
     result = 0;
     if (PL_op->op_flags & OPf_STACKED) {
        SV * const really = *++MARK;
-#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
+#  if defined(WIN32) || defined(OS2) || defined(__VMS)
        value = (I32)do_aspawn(really, MARK, SP);
 #  else
        value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
 #  endif
     }
     else if (SP - MARK != 1) {
        value = (I32)do_aspawn(really, MARK, SP);
 #  else
        value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
 #  endif
     }
     else if (SP - MARK != 1) {
-#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
+#  if defined(WIN32) || defined(OS2) || defined(__VMS)
        value = (I32)do_aspawn(NULL, MARK, SP);
 #  else
        value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP);
        value = (I32)do_aspawn(NULL, MARK, SP);
 #  else
        value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP);
@@ -4275,7 +4499,6 @@ PP(pp_system)
     if (PL_statusvalue == -1)  /* hint that value must be returned as is */
        result = 1;
     STATUS_NATIVE_CHILD_SET(value);
     if (PL_statusvalue == -1)  /* hint that value must be returned as is */
        result = 1;
     STATUS_NATIVE_CHILD_SET(value);
-    do_execfree();
     SP = ORIGMARK;
     XPUSHi(result ? value : STATUS_CURRENT);
 #endif /* !FORK or VMS or OS/2 */
     SP = ORIGMARK;
     XPUSHi(result ? value : STATUS_CURRENT);
 #endif /* !FORK or VMS or OS/2 */
@@ -4285,19 +4508,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;
@@ -4316,7 +4540,6 @@ PP(pp_exec)
        value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
 #endif
     }
        value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
 #endif
     }
-
     SP = ORIGMARK;
     XPUSHi(value);
     RETURN;
     SP = ORIGMARK;
     XPUSHi(value);
     RETURN;
@@ -4325,7 +4548,7 @@ PP(pp_exec)
 PP(pp_getppid)
 {
 #ifdef HAS_GETPPID
 PP(pp_getppid)
 {
 #ifdef HAS_GETPPID
-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;
     XPUSHi( getppid() );
     RETURN;
 #else
     XPUSHi( getppid() );
     RETURN;
 #else
@@ -4336,7 +4559,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);
@@ -4351,21 +4574,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");
@@ -4381,10 +4605,15 @@ 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
 }
 
+/*
+ * The glibc headers typedef __priority_which_t to an enum under C, but
+ * under C++, it keeps it as int. -Wc++-compat doesn't know this, so we
+ * need to explicitly cast it to shut up the warning.
+ */
 #if defined(__GLIBC__) && ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 3) || (__GLIBC__ > 2))
 #  define PRIORITY_WHICH_T(which) (__priority_which_t)which
 #else
 #if defined(__GLIBC__) && ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 3) || (__GLIBC__ > 2))
 #  define PRIORITY_WHICH_T(which) (__priority_which_t)which
 #else
@@ -4394,20 +4623,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;
@@ -4415,7 +4644,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
 }
 
@@ -4425,11 +4654,11 @@ PP(pp_setpriority)
 
 PP(pp_time)
 {
 
 PP(pp_time)
 {
-    dVAR; dSP; dTARGET;
+    dSP; dTARGET;
 #ifdef BIG_TIME
 #ifdef BIG_TIME
-    XPUSHn( time(NULL) );
+    XPUSHn( (NV)time(NULL) );
 #else
 #else
-    XPUSHi( time(NULL) );
+    XPUSHu( (UV)time(NULL) );
 #endif
     RETURN;
 }
 #endif
     RETURN;
 }
@@ -4437,38 +4666,31 @@ 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;
     }
     RETURN;
-#else
-#   ifdef PERL_MICRO
+#elif defined(PERL_MICRO)
     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);
     }
     RETURN;
         mPUSHn(0.0);
         mPUSHn(0.0);
         mPUSHn(0.0);
     }
     RETURN;
-#   else
+#else
     DIE(aTHX_ "times not implemented");
     DIE(aTHX_ "times not implemented");
-#   endif
 #endif /* HAS_TIMES */
 }
 
 #endif /* HAS_TIMES */
 }
 
@@ -4481,9 +4703,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;
@@ -4502,11 +4726,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;
+           }
        }
     }
 
        }
     }
 
@@ -4524,36 +4753,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 )
@@ -4577,14 +4805,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
@@ -4592,8 +4837,7 @@ PP(pp_alarm)
 
 PP(pp_sleep)
 {
 
 PP(pp_sleep)
 {
-    dVAR; dSP; dTARGET;
-    I32 duration;
+    dSP; dTARGET;
     Time_t lasttime;
     Time_t when;
 
     Time_t lasttime;
     Time_t when;
 
@@ -4601,21 +4845,32 @@ PP(pp_sleep)
     if (MAXARG < 1 || (!TOPs && !POPs))
        PerlProc_pause();
     else {
     if (MAXARG < 1 || (!TOPs && !POPs))
        PerlProc_pause();
     else {
-       duration = POPi;
-       PerlProc_sleep((unsigned int)duration);
+        const I32 duration = POPi;
+        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);
+          XPUSHs(&PL_sv_zero);
+          RETURN;
+        } else {
+          PerlProc_sleep((unsigned int)duration);
+        }
     }
     (void)time(&when);
     }
     (void)time(&when);
-    XPUSHi(when - lasttime);
+    XPUSHu((UV)(when - lasttime));
     RETURN;
 }
 
 /* Shared memory. */
 /* Merged with some message passing. */
 
     RETURN;
 }
 
 /* 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;
 
@@ -4644,10 +4899,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)
@@ -4659,14 +4916,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);
     }
@@ -4686,8 +4945,6 @@ S_space_join_names_mortal(pTHX_ char *const *array)
 {
     SV *target;
 
 {
     SV *target;
 
-    PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL;
-
     if (array && *array) {
        target = newSVpvs_flags("", SVs_TEMP);
        while (1) {
     if (array && *array) {
        target = newSVpvs_flags("", SVs_TEMP);
        while (1) {
@@ -4704,10 +4961,12 @@ 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;
     char **elem;
     SV *sv;
     I32 which = PL_op->op_type;
     char **elem;
     SV *sv;
@@ -4758,7 +5017,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) {
@@ -4794,10 +5053,12 @@ 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;
     SV *sv;
 #ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
     I32 which = PL_op->op_type;
     SV *sv;
 #ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
@@ -4843,7 +5104,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)
@@ -4867,10 +5128,13 @@ 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;
     SV *sv;
 #ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
     I32 which = PL_op->op_type;
     SV *sv;
 #ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
@@ -4904,7 +5168,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)
@@ -4927,10 +5191,13 @@ 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;
     SV *sv;
 #ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
     I32 which = PL_op->op_type;
     SV *sv;
 #ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
@@ -4953,9 +5220,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");
@@ -4969,15 +5234,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);
@@ -4988,11 +5249,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));
     }
 
@@ -5002,9 +5259,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:
@@ -5014,8 +5274,8 @@ PP(pp_shostent)
        DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
        break;
        DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
        break;
-#ifdef HAS_SETNETENT
     case OP_SNETENT:
     case OP_SNETENT:
+#ifdef HAS_SETNETENT
        PerlSock_setnetent(stayopen);
 #else
        DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
        PerlSock_setnetent(stayopen);
 #else
        DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
@@ -5039,9 +5299,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
@@ -5104,10 +5368,13 @@ 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;
     SV *sv;
     struct passwd *pwent  = NULL;
     I32 which = PL_op->op_type;
     SV *sv;
     struct passwd *pwent  = NULL;
@@ -5160,7 +5427,7 @@ PP(pp_gpwent)
      * it is only included in special cases.
      *
      * In Digital UNIX/Tru64 if using the getespw*() (which seems to be
      * it is only included in special cases.
      *
      * In Digital UNIX/Tru64 if using the getespw*() (which seems to be
-     * be preferred interface, even though also the getprpw*() interface
+     * the preferred interface, even though also the getprpw*() interface
      * is available) one needs to link with -lsecurity -ldb -laud -lm.
      * One also needs to call set_auth_parameters() in main() before
      * doing anything else, whether one is using getespw*() or getprpw*().
      * is available) one needs to link with -lsecurity -ldb -laud -lm.
      * One also needs to call set_auth_parameters() in main() before
      * doing anything else, whether one is using getespw*() or getprpw*().
@@ -5203,15 +5470,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);
        }
@@ -5259,23 +5522,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.
@@ -5283,30 +5536,24 @@ PP(pp_gpwent)
         * but we are accursed by our history, alas. --jhi.  */
 #   ifdef PWCHANGE
        mPUSHi(pwent->pw_change);
         * but we are accursed by our history, alas. --jhi.  */
 #   ifdef PWCHANGE
        mPUSHi(pwent->pw_change);
-#   else
-#       ifdef PWQUOTA
+#   elif defined(PWQUOTA)
        mPUSHi(pwent->pw_quota);
        mPUSHi(pwent->pw_quota);
-#       else
-#           ifdef PWAGE
+#   elif defined(PWAGE)
        mPUSHs(newSVpv(pwent->pw_age, 0));
        mPUSHs(newSVpv(pwent->pw_age, 0));
-#          else
+#   else
        /* I think that you can never get this compiled, but just in case.  */
        PUSHs(sv_mortalcopy(&PL_sv_no));
        /* I think that you can never get this compiled, but just in case.  */
        PUSHs(sv_mortalcopy(&PL_sv_no));
-#           endif
-#       endif
 #   endif
 
        /* pw_class and pw_comment are mutually exclusive--.
         * see the above note for pw_change, pw_quota, and pw_age. */
 #   ifdef PWCLASS
        mPUSHs(newSVpv(pwent->pw_class, 0));
 #   endif
 
        /* pw_class and pw_comment are mutually exclusive--.
         * see the above note for pw_change, pw_quota, and pw_age. */
 #   ifdef PWCLASS
        mPUSHs(newSVpv(pwent->pw_class, 0));
-#   else
-#       ifdef PWCOMMENT
+#   elif defined(PWCOMMENT)
        mPUSHs(newSVpv(pwent->pw_comment, 0));
        mPUSHs(newSVpv(pwent->pw_comment, 0));
-#      else
+#   else
        /* I think that you can never get this compiled, but just in case.  */
        PUSHs(sv_mortalcopy(&PL_sv_no));
        /* I think that you can never get this compiled, but just in case.  */
        PUSHs(sv_mortalcopy(&PL_sv_no));
-#       endif
 #   endif
 
 #   ifdef PWGECOS
 #   endif
 
 #   ifdef PWGECOS
@@ -5314,18 +5561,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);
@@ -5337,10 +5580,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;
 
@@ -5349,7 +5595,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
@@ -5360,17 +5612,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);
        }
@@ -5386,11 +5634,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
@@ -5414,7 +5658,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()))
@@ -5432,13 +5676,13 @@ PP(pp_getlogin)
 PP(pp_syscall)
 {
 #ifdef HAS_SYSCALL
 PP(pp_syscall)
 {
 #ifdef HAS_SYSCALL
-    dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+    dSP; dMARK; dORIGMARK; dTARGET;
     I32 items = SP - MARK;
     unsigned long a[20];
     I32 i = 0;
     IV retval = -1;
 
     I32 items = SP - MARK;
     unsigned long a[20];
     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;
@@ -5623,11 +5867,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: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */
  * ex: set ts=8 sts=4 sw=4 et:
  */
Unnamed repository; edit this file 'description' to name the repository.