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
Perl_sv_vcatpvfn_flags: calc (width - elen) once
[perl5.git] / pp_sys.c
diff --git a/pp_sys.c b/pp_sys.c
index def63b8..74c8900 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
@@ -193,6 +192,10 @@ void setservent(int);
 void endservent(void);
 #endif
 
 void endservent(void);
 #endif
 
+#ifdef __amigaos4__
+#  include "amigaos4/amigaio.h"
+#endif
+
 #undef PERL_EFF_ACCESS /* EFFective uid/gid ACCESS */
 
 /* F_OK unused: if stat() cannot find it... */
 #undef PERL_EFF_ACCESS /* EFFective uid/gid ACCESS */
 
 /* F_OK unused: if stat() cannot find it... */
@@ -294,7 +297,7 @@ PP(pp_backtick)
     dSP; dTARGET;
     PerlIO *fp;
     const char * const tmps = POPpconstx;
     dSP; dTARGET;
     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("``");
@@ -317,7 +320,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");
@@ -459,7 +462,7 @@ 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;
 }
     else warn_sv(exsv);
     RETSETYES;
 }
@@ -530,17 +533,31 @@ Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv,
 {
     SV **orig_sp = sp;
     I32 ret_args;
 {
     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) {
@@ -612,8 +629,7 @@ 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);
                             HEKfARG(GvENAME_HEK(gv)));
 
        mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
@@ -678,8 +694,6 @@ 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);
 
-    assert (isGV_with_GP(rgv));
-    assert (isGV_with_GP(wgv));
     rstio = GvIOn(rgv);
     if (IoIFP(rstio))
        do_close(rgv, FALSE);
     rstio = GvIOn(rgv);
     if (IoIFP(rstio))
        do_close(rgv, FALSE);
@@ -691,8 +705,8 @@ PP(pp_pipe_op)
     if (PerlProc_pipe(fd) < 0)
        goto badexit;
 
     if (PerlProc_pipe(fd) < 0)
        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;
@@ -709,15 +723,15 @@ PP(pp_pipe_op)
            PerlLIO_close(fd[1]);
        goto badexit;
     }
            PerlLIO_close(fd[1]);
        goto badexit;
     }
-#if defined(HAS_FCNTL) && defined(F_SETFD)
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
     /* ensure close-on-exec */
     /* ensure close-on-exec */
-    if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) ||
-        (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0))
+    if ((fd[0] > PL_maxsysfd && fcntl(fd[0], F_SETFD, FD_CLOEXEC) < 0) ||
+        (fd[1] > PL_maxsysfd && fcntl(fd[1], F_SETFD, FD_CLOEXEC) < 0))
         goto badexit;
 #endif
     RETPUSHYES;
 
         goto badexit;
 #endif
     RETPUSHYES;
 
-badexit:
+  badexit:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_func, "pipe");
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_func, "pipe");
@@ -743,6 +757,22 @@ PP(pp_fileno)
        return tied_method0(SV_CONST(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))) {
        /* Can't do this because people seem to do things like
           defined(fileno($foo)) to check whether $foo is a valid fh.
     if (!io || !(fp = IoIFP(io))) {
        /* Can't do this because people seem to do things like
           defined(fileno($foo)) to check whether $foo is a valid fh.
@@ -921,10 +951,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);
@@ -954,6 +1010,9 @@ PP(pp_tie)
     RETURN;
 }
 
     RETURN;
 }
 
+
+/* also used for: pp_dbmclose() */
+
 PP(pp_untie)
 {
     dSP;
 PP(pp_untie)
 {
     dSP;
@@ -985,7 +1044,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 ) ;
            }
         }
@@ -1063,9 +1122,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);
     }
@@ -1228,7 +1289,7 @@ PP(pp_sselect)
     }
 
     PUSHi(nfound);
     }
 
     PUSHi(nfound);
-    if (GIMME == G_ARRAY && tbuf) {
+    if (GIMME_V == G_ARRAY && tbuf) {
        value = (NV)(timebuf.tv_sec) +
                (NV)(timebuf.tv_usec) / 1000000.0;
        mPUSHn(value);
        value = (NV)(timebuf.tv_sec) +
                (NV)(timebuf.tv_usec) / 1000000.0;
        mPUSHn(value);
@@ -1245,10 +1306,10 @@ PP(pp_sselect)
 
 =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
 */
@@ -1256,10 +1317,13 @@ of the typeglob that PL_defoutgv points to is decreased by one.
 void
 Perl_setdefout(pTHX_ GV *gv)
 {
 void
 Perl_setdefout(pTHX_ GV *gv)
 {
+    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)
@@ -1306,7 +1370,7 @@ 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;
+           const U8 gimme = GIMME_V;
            Perl_tied_method(aTHX_ SV_CONST(GETC), SP, MUTABLE_SV(io), mg, gimme, 0);
            if (gimme == G_SCALAR) {
                SPAGAIN;
            Perl_tied_method(aTHX_ SV_CONST(GETC), SP, MUTABLE_SV(io), mg, gimme, 0);
            if (gimme == G_SCALAR) {
                SPAGAIN;
@@ -1343,23 +1407,17 @@ STATIC OP *
 S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 {
     PERL_CONTEXT *cx;
 S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 {
     PERL_CONTEXT *cx;
-    const I32 gimme = GIMME_V;
+    const U8 gimme = GIMME_V;
 
     PERL_ARGS_ASSERT_DOFORM;
 
     if (CvCLONE(cv))
        cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
 
 
     PERL_ARGS_ASSERT_DOFORM;
 
     if (CvCLONE(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 */
@@ -1373,7 +1431,6 @@ PP(pp_enterwrite)
     IO *io;
     GV *fgv;
     CV *cv = NULL;
     IO *io;
     GV *fgv;
     CV *cv = NULL;
-    SV *tmpsv = NULL;
 
     if (MAXARG == 0) {
        EXTEND(SP, 1);
 
     if (MAXARG == 0) {
        EXTEND(SP, 1);
@@ -1397,9 +1454,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));
@@ -1408,16 +1465,15 @@ PP(pp_enterwrite)
 PP(pp_leavewrite)
 {
     dSP;
 PP(pp_leavewrite)
 {
     dSP;
-    GV * const gv = cxstack[cxstack_ix].blk_format.gv;
+    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",
@@ -1435,7 +1491,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)) ||
@@ -1483,19 +1539,28 @@ PP(pp_leavewrite)
        if (!cv) {
            SV * const sv = sv_newmortal();
            gv_efullname4(sv, fgv, NULL, FALSE);
        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);
+    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;
-    POPFORMAT(cx);
-    SP = newsp; /* ignore retval of formline */
-    LEAVE;
+    CX_POP(cx);
 
 
-    if (!io || !(fp = IoOFP(io))) {
+    if (is_return)
+        /* XXX the semantics of doing 'return' in a format aren't documented.
+         * Currently we ignore any args to 'return' and just return
+         * a single undef in both scalar and list contexts
+         */
+       PUSHs(&PL_sv_undef);
+    else if (!io || !(fp = IoOFP(io))) {
        if (io && IoIFP(io))
            report_wrongway_fh(gv, '<');
        else
        if (io && IoIFP(io))
            report_wrongway_fh(gv, '<');
        else
@@ -1518,7 +1583,6 @@ PP(pp_leavewrite)
        }
     }
     PL_formtarget = PL_bodytarget;
        }
     }
     PL_formtarget = PL_bodytarget;
-    PERL_UNUSED_VAR(gimme);
     RETURNOP(retop);
 }
 
     RETURNOP(retop);
 }
 
@@ -1594,7 +1658,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);
-    if (do_open_raw(gv, tmps, len, mode, perm)) {
+    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);
     }
@@ -1604,6 +1668,9 @@ PP(pp_sysopen)
     RETURN;
 }
 
     RETURN;
 }
 
+
+/* also used for: pp_read() and pp_recv() (where supported) */
+
 PP(pp_sysread)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
 PP(pp_sysread)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
@@ -1641,7 +1708,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");
@@ -1661,6 +1728,12 @@ PP(pp_sysread)
     fd = PerlIO_fileno(IoIFP(io));
 
     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
     fd = PerlIO_fileno(IoIFP(io));
 
     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
+        if (PL_op->op_type == OP_SYSREAD || PL_op->op_type == OP_RECV) {
+            Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+                             "%s() is deprecated on :utf8 handles. "
+                             "This will be a fatal error in Perl 5.30",
+                             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);
@@ -1750,7 +1823,7 @@ PP(pp_sysread)
        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
        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);
@@ -1860,6 +1933,9 @@ PP(pp_sysread)
     RETPUSHUNDEF;
 }
 
     RETPUSHUNDEF;
 }
 
+
+/* also used for: pp_send() where defined */
+
 PP(pp_syswrite)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
 PP(pp_syswrite)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
@@ -1917,6 +1993,10 @@ PP(pp_syswrite)
     doing_utf8 = DO_UTF8(bufsv);
 
     if (PerlIO_isutf8(IoIFP(io))) {
     doing_utf8 = DO_UTF8(bufsv);
 
     if (PerlIO_isutf8(IoIFP(io))) {
+        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+                         "%s() is deprecated on :utf8 handles. "
+                         "This will be a fatal error in Perl 5.30",
+                         OP_DESC(PL_op));
        if (!SvUTF8(bufsv)) {
            /* We don't modify the original scalar.  */
            tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
        if (!SvUTF8(bufsv)) {
            /* We don't modify the original scalar.  */
            tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
@@ -2106,16 +2186,20 @@ PP(pp_eof)
     if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) {  /* eof() */
        if (io && !IoIFP(io)) {
            if ((IoFLAGS(io) & IOf_START) && av_tindex(GvAVn(gv)) < 0) {
     if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) {  /* eof() */
        if (io && !IoIFP(io)) {
            if ((IoFLAGS(io) & IOf_START) && av_tindex(GvAVn(gv)) < 0) {
+               SV ** svp;
                IoLINES(io) = 0;
                IoFLAGS(io) &= ~IOf_START;
                do_open6(gv, "-", 1, NULL, NULL, 0);
                IoLINES(io) = 0;
                IoFLAGS(io) &= ~IOf_START;
                do_open6(gv, "-", 1, NULL, NULL, 0);
-               if (GvSV(gv))
-                   sv_setpvs(GvSV(gv), "-");
+               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;
        }
     }
@@ -2158,6 +2242,9 @@ PP(pp_tell)
     RETURN;
 }
 
     RETURN;
 }
 
+
+/* also used for: pp_seek() */
+
 PP(pp_sysseek)
 {
     dSP;
 PP(pp_sysseek)
 {
     dSP;
@@ -2249,13 +2336,18 @@ PP(pp_truncate)
                         SETERRNO(EBADF,RMS_IFI);
                         result = 0;
                     } else {
                         SETERRNO(EBADF,RMS_IFI);
                         result = 0;
                     } else {
-                        PerlIO_flush(fp);
+                        if (len < 0) {
+                            SETERRNO(EINVAL, LIB_INVARG);
+                            result = 0;
+                        } else {
+                           PerlIO_flush(fp);
 #ifdef HAS_TRUNCATE
 #ifdef HAS_TRUNCATE
-                        if (ftruncate(fd, len) < 0)
+                           if (ftruncate(fd, len) < 0)
 #else
 #else
-                        if (my_chsize(fd, len) < 0)
+                           if (my_chsize(fd, len) < 0)
 #endif
 #endif
-                            result = 0;
+                               result = 0;
+                        }
                     }
                }
            }
                     }
                }
            }
@@ -2272,10 +2364,22 @@ PP(pp_truncate)
                result = 0;
 #else
            {
                result = 0;
 #else
            {
-               const int tmpfd = PerlLIO_open(name, O_RDWR);
+                int mode = O_RDWR;
+                int tmpfd;
+
+#if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
+                mode |= O_LARGEFILE;   /* Transparently largefiley. */
+#endif
+#ifdef O_BINARY
+                /* On open(), the Win32 CRT tries to seek around text
+                 * files using 32-bit offsets, which causes the open()
+                 * to fail on large files, so open in binary mode.
+                 */
+                mode |= O_BINARY;
+#endif
+                tmpfd = PerlLIO_open(name, mode);
 
                if (tmpfd < 0) {
 
                if (tmpfd < 0) {
-                    SETERRNO(EBADF,RMS_IFI);
                    result = 0;
                } else {
                    if (my_chsize(tmpfd, len) < 0)
                    result = 0;
                } else {
                    if (my_chsize(tmpfd, len) < 0)
@@ -2294,6 +2398,9 @@ PP(pp_truncate)
     }
 }
 
     }
 }
 
+
+/* also used for: pp_fcntl() */
+
 PP(pp_ioctl)
 {
     dSP; dTARGET;
 PP(pp_ioctl)
 {
     dSP; dTARGET;
@@ -2416,11 +2523,10 @@ PP(pp_socket)
     TAINT_PROPER("socket");
     fd = PerlSock_socket(domain, type, protocol);
     if (fd < 0) {
     TAINT_PROPER("socket");
     fd = PerlSock_socket(domain, type, protocol);
     if (fd < 0) {
-        SETERRNO(EBADF,RMS_IFI);
        RETPUSHUNDEF;
     }
        RETPUSHUNDEF;
     }
-    IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE);        /* stdio gets confused about sockets */
-    IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
+    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));
@@ -2428,8 +2534,9 @@ 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)
-    if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0)      /* ensure close-on-exec */
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+    /* ensure close-on-exec */
+    if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0)
        RETPUSHUNDEF;
 #endif
 
        RETPUSHUNDEF;
 #endif
 
@@ -2459,11 +2566,11 @@ PP(pp_sockpair)
     TAINT_PROPER("socketpair");
     if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
        RETPUSHUNDEF;
     TAINT_PROPER("socketpair");
     if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
        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));
@@ -2474,10 +2581,10 @@ 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)
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
     /* ensure close-on-exec */
     /* ensure close-on-exec */
-    if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) ||
-        (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0))
+    if ((fd[0] > PL_maxsysfd && fcntl(fd[0], F_SETFD, FD_CLOEXEC) < 0) ||
+        (fd[1] > PL_maxsysfd && fcntl(fd[1], F_SETFD, FD_CLOEXEC) < 0))
        RETPUSHUNDEF;
 #endif
 
        RETPUSHUNDEF;
 #endif
 
@@ -2489,6 +2596,8 @@ PP(pp_sockpair)
 
 #ifdef HAS_SOCKET
 
 
 #ifdef HAS_SOCKET
 
+/* also used for: pp_connect() */
+
 PP(pp_bind)
 {
     dSP;
 PP(pp_bind)
 {
     dSP;
@@ -2518,7 +2627,7 @@ PP(pp_bind)
     else
        RETPUSHUNDEF;
 
     else
        RETPUSHUNDEF;
 
-nuts:
+  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
@@ -2539,7 +2648,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;
@@ -2580,8 +2689,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));
@@ -2589,8 +2698,9 @@ 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)
-    if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0)      /* ensure close-on-exec */
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+    /* ensure close-on-exec */
+    if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0)
         goto badexit;
 #endif
 
         goto badexit;
 #endif
 
@@ -2601,11 +2711,11 @@ 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;
 
 }
     RETPUSHUNDEF;
 
 }
@@ -2623,12 +2733,15 @@ PP(pp_shutdown)
     PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
     RETURN;
 
     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)
 {
     dSP;
 PP(pp_ssockopt)
 {
     dSP;
@@ -2656,6 +2769,11 @@ PP(pp_ssockopt)
        len = SvCUR(sv);
        if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
            goto nuts2;
        len = SvCUR(sv);
        if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
            goto nuts2;
+#if defined(_AIX)
+        /* XXX Configure test: does getsockopt set the length properly? */
+        if (len == 256)
+            len = sizeof(int);
+#endif
        SvCUR_set(sv, len);
        *SvEND(sv) ='\0';
        PUSHs(sv);
        SvCUR_set(sv, len);
        *SvEND(sv) ='\0';
        PUSHs(sv);
@@ -2695,14 +2813,17 @@ 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)
 {
     dSP;
 PP(pp_getpeername)
 {
     dSP;
@@ -2756,10 +2877,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;
 }
 
@@ -2767,12 +2888,14 @@ nuts2:
 
 /* Stat calls. */
 
 
 /* Stat calls. */
 
+/* also used for: pp_lstat() */
+
 PP(pp_stat)
 {
     dSP;
     GV *gv = NULL;
     IO *io = NULL;
 PP(pp_stat)
 {
     dSP;
     GV *gv = NULL;
     IO *io = NULL;
-    I32 gimme;
+    U8 gimme;
     I32 max = 13;
     SV* sv;
 
     I32 max = 13;
     SV* sv;
 
@@ -2782,7 +2905,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)))
@@ -2798,7 +2921,7 @@ PP(pp_stat)
            havefp = FALSE;
            PL_laststype = OP_STAT;
            PL_statgv = gv ? gv : (GV *)io;
            havefp = FALSE;
            PL_laststype = OP_STAT;
            PL_statgv = gv ? gv : (GV *)io;
-           sv_setpvs(PL_statname, "");
+            SvPVCLEAR(PL_statname);
             if(gv) {
                 io = GvIO(gv);
            }
             if(gv) {
                 io = GvIO(gv);
            }
@@ -2990,6 +3113,9 @@ S_try_amagic_ftest(pTHX_ char chr) {
 }
 
 
 }
 
 
+/* also used for: pp_fteexec() pp_fteread() pp_ftewrite() pp_ftrexec()
+ *                pp_ftrwrite() */
+
 PP(pp_ftrread)
 {
     I32 result;
 PP(pp_ftrread)
 {
     I32 result;
@@ -3107,6 +3233,9 @@ PP(pp_ftrread)
     FT_RETURNNO;
 }
 
     FT_RETURNNO;
 }
 
+
+/* also used for: pp_ftatime() pp_ftctime() pp_ftmtime() pp_ftsize() */
+
 PP(pp_ftis)
 {
     I32 result;
 PP(pp_ftis)
 {
     I32 result;
@@ -3158,6 +3287,11 @@ PP(pp_ftis)
     }
 }
 
     }
 }
 
+
+/* 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)
 {
     I32 result;
 PP(pp_ftrowned)
 {
     I32 result;
@@ -3279,6 +3413,7 @@ PP(pp_fttty)
     GV *gv;
     char *name = NULL;
     STRLEN namelen;
     GV *gv;
     char *name = NULL;
     STRLEN namelen;
+    UV uv;
 
     tryAMAGICftest_MG('t');
 
 
     tryAMAGICftest_MG('t');
 
@@ -3294,8 +3429,8 @@ 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 = grok_atou(name, NULL);
+    else if (name && isDIGIT(*name) && grok_atoUV(name, &uv, NULL) && uv <= PERL_INT_MAX)
+        fd = (int)uv;
     else
        FT_RETURNUNDEF;
     if (fd < 0) {
     else
        FT_RETURNUNDEF;
     if (fd < 0) {
@@ -3307,6 +3442,9 @@ PP(pp_fttty)
     FT_RETURNNO;
 }
 
     FT_RETURNNO;
 }
 
+
+/* also used for: pp_ftbinary() */
+
 PP(pp_fttext)
 {
     I32 i;
 PP(pp_fttext)
 {
     I32 i;
@@ -3343,7 +3481,7 @@ 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;
            io = GvIO(PL_statgv);
        }
        PL_laststatval = -1;
@@ -3418,8 +3556,9 @@ PP(pp_fttext)
         }
        PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
        if (PL_laststatval < 0) {
         }
        PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
        if (PL_laststatval < 0) {
+            dSAVE_ERRNO;
            (void)PerlIO_close(fp);
            (void)PerlIO_close(fp);
-            SETERRNO(EBADF,RMS_IFI);
+            RESTORE_ERRNO;
            FT_RETURNUNDEF;
        }
        PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
            FT_RETURNUNDEF;
        }
        PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
@@ -3442,15 +3581,11 @@ PP(pp_fttext)
 #endif
 
     assert(len);
 #endif
 
     assert(len);
-    if (! is_ascii_string((U8 *) s, len)) {
-        const U8 *ep;
-
-        /* Here contains a non-ASCII.  See if the entire string is UTF-8.  But
-         * the buffer may end in a partial character, so consider it UTF-8 if
-         * the first non-UTF8 char is an ending partial */
-        if (is_utf8_string_loc((U8 *) s, len, &ep)
-            || ep + UTF8SKIP(ep)  > (U8 *) (s + len))
-        {
+    if (! is_utf8_invariant_string((U8 *) s, len)) {
+
+        /* Here contains a variant under UTF-8 .  See if the entire string is
+         * UTF-8. */
+        if (is_utf8_fixed_width_buf_flags((U8 *) s, len, 0)) {
             if (PL_op->op_type == OP_FTTEXT) {
                 FT_RETURNYES;
             }
             if (PL_op->op_type == OP_FTTEXT) {
                 FT_RETURNYES;
             }
@@ -3476,14 +3611,14 @@ PP(pp_fttext)
         }
         else
 #endif
         }
         else
 #endif
-        if (isPRINT_A(*s)
-                   /* VT occurs so rarely in text, that we consider it odd */
-                || (isSPACE_A(*s) && *s != VT_NATIVE)
+             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 */
 
                     /* But there is a fair amount of backspaces and escapes in
                      * some text */
-                || *s == '\b'
-                || *s == ESC_NATIVE)
+                 || *s == '\b'
+                 || *s == ESC_NATIVE)
         {
             continue;
         }
         {
             continue;
         }
@@ -3508,15 +3643,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);
+                PUSHi(0);
+                TAINT_PROPER("chdir");
+                RETURN;
+            }
        }
         else if (!(gv = MAYBE_DEREF_GV(sv)))
                tmps = SvPV_nomg_const_nolen(sv);
     }
        }
         else if (!(gv = MAYBE_DEREF_GV(sv)))
                tmps = SvPV_nomg_const_nolen(sv);
     }
-
-    if( !gv && (!tmps || !*tmps) ) {
+    else {
        HV * const table = GvHVn(PL_envgv);
        SV **svp;
 
        HV * const table = GvHVn(PL_envgv);
        SV **svp;
 
+        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
@@ -3524,12 +3669,11 @@ PP(pp_chdir)
 #endif
            )
         {
 #endif
            )
         {
-            if( MAXARG == 1 )
-                deprecate("chdir('') or chdir(undef) as chdir()");
             tmps = SvPV_nolen_const(*svp);
         }
         else {
             PUSHi(0);
             tmps = SvPV_nolen_const(*svp);
         }
         else {
             PUSHi(0);
+            SETERRNO(EINVAL, LIB_INVARG);
             TAINT_PROPER("chdir");
             RETURN;
         }
             TAINT_PROPER("chdir");
             RETURN;
         }
@@ -3569,13 +3713,18 @@ PP(pp_chdir)
 #endif
     RETURN;
 
 #endif
     RETURN;
 
+#ifdef HAS_FCHDIR
  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,RMS_IFI);
     PUSHi(0);
     RETURN;
  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,RMS_IFI);
     PUSHi(0);
     RETURN;
+#endif
 }
 
 }
 
+
+/* also used for: pp_chmod() pp_kill() pp_unlink() pp_utime() */
+
 PP(pp_chown)
 {
     dSP; dMARK; dTARGET;
 PP(pp_chown)
 {
     dSP; dMARK; dTARGET;
@@ -3603,17 +3752,20 @@ PP(pp_rename)
 {
     dSP; dTARGET;
     int anum;
 {
     dSP; dTARGET;
     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);
@@ -3624,6 +3776,9 @@ 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)
 {
@@ -3666,6 +3821,9 @@ PP(pp_link)
     RETURN;
 }
 #else
     RETURN;
 }
 #else
+
+/* also used for: pp_symlink() */
+
 PP(pp_link)
 {
     /* Have neither.  */
 PP(pp_link)
 {
     /* Have neither.  */
@@ -3769,7 +3927,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)
@@ -3810,7 +3969,7 @@ PP(pp_mkdir)
     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);
 
@@ -3861,16 +4020,15 @@ PP(pp_open_dir)
     IO * const io = GvIOn(gv);
 
     if ((IoIFP(io) || IoOFP(io)))
     IO * const io = GvIOn(gv);
 
     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;
@@ -3890,14 +4048,14 @@ PP(pp_readdir)
     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);
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
     GV * const gv = MUTABLE_GV(POPs);
     const Direntry_t *dp;
     IO * const io = GvIOn(gv);
 
     if (!IoDIRP(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;
     }
@@ -3921,10 +4079,10 @@ PP(pp_readdir)
 
     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;
@@ -3947,14 +4105,14 @@ PP(pp_telldir)
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
 
     if (!IoDIRP(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;
@@ -3973,14 +4131,14 @@ PP(pp_seekdir)
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
 
     if (!IoDIRP(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;
@@ -3998,13 +4156,13 @@ PP(pp_rewinddir)
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
 
     if (!IoDIRP(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;
@@ -4022,7 +4180,7 @@ PP(pp_closedir)
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
 
     if (!IoDIRP(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;
     }
@@ -4037,7 +4195,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;
@@ -4088,7 +4246,7 @@ PP(pp_fork)
     PUSHi(childpid);
     RETURN;
 #else
     PUSHi(childpid);
     RETURN;
 #else
-#  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+#  if (defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)) || defined(__amigaos4__)
     dSP; dTARGET;
     Pid_t childpid;
 
     dSP; dTARGET;
     Pid_t childpid;
 
@@ -4140,6 +4298,12 @@ PP(pp_waitpid)
     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)
@@ -4156,6 +4320,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
@@ -4172,7 +4337,11 @@ PP(pp_system)
     XPUSHi(-1);
 #else
     I32 value;
     XPUSHi(-1);
 #else
     I32 value;
+# ifdef __amigaos4__
+    void * result;
+# else
     int result;
     int result;
+# endif
 
     if (TAINTING_get) {
        TAINT_ENV();
 
     if (TAINTING_get) {
        TAINT_ENV();
@@ -4185,17 +4354,33 @@ PP(pp_system)
        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;
+        bool child_success = FALSE;
 #ifdef HAS_SIGPROCMASK
        sigset_t newset, oldset;
 #endif
 
        if (PerlProc_pipe(pp) >= 0)
            did_pipes = 1;
 #ifdef HAS_SIGPROCMASK
        sigset_t newset, oldset;
 #endif
 
        if (PerlProc_pipe(pp) >= 0)
            did_pipes = 1;
+#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);
 #ifdef HAS_SIGPROCMASK
        sigemptyset(&newset);
        sigaddset(&newset, SIGCHLD);
@@ -4217,19 +4402,27 @@ PP(pp_system)
            }
            sleep(5);
        }
            }
            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);
@@ -4243,10 +4436,9 @@ PP(pp_system)
            if (did_pipes) {
                int errkid;
                unsigned n = 0;
            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)
@@ -4258,18 +4450,26 @@ 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;
        }
+#ifndef __amigaos4__
 #ifdef HAS_SIGPROCMASK
        sigprocmask(SIG_SETMASK, &oldset, NULL);
 #endif
        if (did_pipes) {
            PerlLIO_close(pp[0]);
 #ifdef HAS_SIGPROCMASK
        sigprocmask(SIG_SETMASK, &oldset, NULL);
 #endif
        if (did_pipes) {
            PerlLIO_close(pp[0]);
-#if defined(HAS_FCNTL) && defined(F_SETFD)
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
            if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
                 RETPUSHUNDEF;
 #endif
            if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
                 RETPUSHUNDEF;
 #endif
@@ -4283,6 +4483,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 */
@@ -4332,6 +4533,7 @@ PP(pp_exec)
        MARK = ORIGMARK;
        TAINT_PROPER("exec");
     }
        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;
@@ -4350,7 +4552,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;
@@ -4396,10 +4597,11 @@ PP(pp_setpgrp)
     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");
@@ -4478,7 +4680,7 @@ PP(pp_tms)
     (void)PerlProc_times(&timesbuf);
 
     mPUSHn(((NV)timesbuf.tms_utime)/(NV)PL_clocktick);
     (void)PerlProc_times(&timesbuf);
 
     mPUSHn(((NV)timesbuf.tms_utime)/(NV)PL_clocktick);
-    if (GIMME == G_ARRAY) {
+    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);
        mPUSHn(((NV)timesbuf.tms_stime)/(NV)PL_clocktick);
        mPUSHn(((NV)timesbuf.tms_cutime)/(NV)PL_clocktick);
        mPUSHn(((NV)timesbuf.tms_cstime)/(NV)PL_clocktick);
@@ -4489,7 +4691,7 @@ PP(pp_tms)
     dSP;
     mPUSHn(0.0);
     EXTEND(SP, 4);
     dSP;
     mPUSHn(0.0);
     EXTEND(SP, 4);
-    if (GIMME == G_ARRAY) {
+    if (GIMME_V == G_ARRAY) {
         mPUSHn(0.0);
         mPUSHn(0.0);
         mPUSHn(0.0);
         mPUSHn(0.0);
         mPUSHn(0.0);
         mPUSHn(0.0);
@@ -4510,6 +4712,9 @@ 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)
 {
     dSP;
 PP(pp_gmtime)
 {
     dSP;
@@ -4530,11 +4735,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;
+           }
        }
     }
 
        }
     }
 
@@ -4552,34 +4762,34 @@ 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) {
        /* diag_listed_as: gmtime(%f) failed */
        /* XXX %lld broken for quads */
     }
 
     if (err == NULL) {
        /* diag_listed_as: gmtime(%f) failed */
        /* 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 */
+    if (GIMME_V != G_ARRAY) {  /* scalar context */
         EXTEND(SP, 1);
         EXTEND(SP, 1);
-        EXTEND_MORTAL(1);
        if (err == NULL)
            RETPUSHUNDEF;
        else {
        if (err == NULL)
            RETPUSHUNDEF;
        else {
-           mPUSHs(Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %.0f",
+           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,
                                 dayname[tmbuf.tm_wday],
                                 monname[tmbuf.tm_mon],
                                 tmbuf.tm_mday,
                                 tmbuf.tm_hour,
                                 tmbuf.tm_min,
                                 tmbuf.tm_sec,
-                                /* XXX newSVpvf()'s %lld type is broken,
-                                 * so cheat with a double */
-                                (double)tmbuf.tm_year + 1900));
+                                (IV)tmbuf.tm_year + 1900);
         }
     }
     else {                     /* list context */
         }
     }
     else {                     /* list context */
@@ -4605,13 +4815,30 @@ PP(pp_alarm)
 {
 #ifdef HAS_ALARM
     dSP; dTARGET;
 {
 #ifdef HAS_ALARM
     dSP; dTARGET;
-    int anum;
-    anum = POPi;
-    anum = alarm((unsigned int)anum);
-    if (anum < 0)
-       RETPUSHUNDEF;
-    PUSHi(anum);
-    RETURN;
+    /* 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
@@ -4620,7 +4847,6 @@ PP(pp_alarm)
 PP(pp_sleep)
 {
     dSP; dTARGET;
 PP(pp_sleep)
 {
     dSP; dTARGET;
-    I32 duration;
     Time_t lasttime;
     Time_t when;
 
     Time_t lasttime;
     Time_t when;
 
@@ -4628,8 +4854,17 @@ 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);
+          XPUSHi(0);
+          RETURN;
+        } else {
+          PerlProc_sleep((unsigned int)duration);
+        }
     }
     (void)time(&when);
     XPUSHi(when - lasttime);
     }
     (void)time(&when);
     XPUSHi(when - lasttime);
@@ -4639,6 +4874,8 @@ PP(pp_sleep)
 /* Shared memory. */
 /* Merged with some message passing. */
 
 /* Shared memory. */
 /* Merged with some message passing. */
 
+/* also used for: pp_msgrcv() pp_msgsnd() pp_semop() pp_shmread() */
+
 PP(pp_shmwrite)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 PP(pp_shmwrite)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
@@ -4671,6 +4908,8 @@ 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)
@@ -4686,6 +4925,8 @@ 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)
@@ -4693,7 +4934,7 @@ PP(pp_semctl)
     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);
     }
@@ -4713,8 +4954,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) {
@@ -4731,6 +4970,8 @@ 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)
@@ -4785,7 +5026,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) {
@@ -4821,6 +5062,8 @@ 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)
@@ -4870,7 +5113,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)
@@ -4894,6 +5137,9 @@ 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)
@@ -4931,7 +5177,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)
@@ -4954,6 +5200,9 @@ 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)
@@ -4994,7 +5243,7 @@ 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) {
@@ -5019,6 +5268,9 @@ PP(pp_gservent)
 #endif
 }
 
 #endif
 }
 
+
+/* also used for: pp_snetent() pp_sprotoent() pp_sservent() */
+
 PP(pp_shostent)
 {
     dSP;
 PP(pp_shostent)
 {
     dSP;
@@ -5056,6 +5308,10 @@ 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)
 {
     dSP;
 PP(pp_ehostent)
 {
     dSP;
@@ -5121,6 +5377,9 @@ PP(pp_ehostent)
     RETPUSHYES;
 }
 
     RETPUSHYES;
 }
 
+
+/* also used for: pp_gpwnam() pp_gpwuid() */
+
 PP(pp_gpwent)
 {
 #ifdef HAS_PASSWD
 PP(pp_gpwent)
 {
 #ifdef HAS_PASSWD
@@ -5220,7 +5479,7 @@ 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)
@@ -5336,6 +5595,9 @@ PP(pp_gpwent)
 #endif
 }
 
 #endif
 }
 
+
+/* also used for: pp_ggrgid() pp_ggrnam() */
+
 PP(pp_ggrent)
 {
 #ifdef HAS_GROUP
 PP(pp_ggrent)
 {
 #ifdef HAS_GROUP
@@ -5348,7 +5610,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
@@ -5359,7 +5627,7 @@ 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);
        SV * const sv = sv_newmortal();
 
        PUSHs(sv);
@@ -5614,11 +5882,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.