X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f4a7049d1e66956838433895a259b4fb84d25493..d909c5cbac67256df64d980d1bef90e973c0d139:/pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 5c9bfea..833e565 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1,7 +1,7 @@
 /*    pp_sys.c
  *
- *    Copyright (C) 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+ *    2004, 2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -297,22 +297,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 
     return res;
 }
-#   define PERL_EFF_ACCESS(p,f) (emulate_eaccess((p), (f)))
-#endif
-
-#if !defined(PERL_EFF_ACCESS)
-/* With it or without it: anyway you get a warning: either that
-   it is unused, or it is declared static and never defined.
- */
-STATIC int
-S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
-{
-    PERL_UNUSED_ARG(path);
-    PERL_UNUSED_ARG(mode);
-    Perl_croak(aTHX_ "switching effective uid is not implemented");
-    /*NOTREACHED*/
-    return -1;
-}
+#   define PERL_EFF_ACCESS(p,f) (S_emulate_eaccess(aTHX_ (p), (f)))
 #endif
 
 PP(pp_backtick)
@@ -330,14 +315,14 @@ PP(pp_backtick)
 	mode = "rt";
     fp = PerlProc_popen(tmps, mode);
     if (fp) {
-        const char * const type = PL_curcop->cop_io ? SvPV_nolen_const(PL_curcop->cop_io) : NULL;
+        const char * const type = Perl_PerlIO_context_layers(aTHX_ NULL);
 	if (type && *type)
 	    PerlIO_apply_layers(aTHX_ fp,mode,type);
 
 	if (gimme == G_VOID) {
 	    char tmpbuf[256];
 	    while (PerlIO_read(fp, tmpbuf, sizeof tmpbuf) > 0)
-		;
+		NOOP;
 	}
 	else if (gimme == G_SCALAR) {
 	    ENTER;
@@ -345,7 +330,7 @@ PP(pp_backtick)
 	    PL_rs = &PL_sv_undef;
 	    sv_setpvn(TARG, "", 0);	/* note that this preserves previous buffer */
 	    while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
-		;
+		NOOP;
 	    LEAVE;
 	    XPUSHs(TARG);
 	    SvTAINTED_on(TARG);
@@ -357,7 +342,7 @@ PP(pp_backtick)
 		    SvREFCNT_dec(sv);
 		    break;
 		}
-		XPUSHs(sv_2mortal(sv));
+		mXPUSHs(sv);
 		if (SvLEN(sv) - SvCUR(sv) > 20) {
 		    SvPV_shrink_to_cur(sv);
 		}
@@ -403,7 +388,7 @@ PP(pp_glob)
     PL_last_in_gv = (GV*)*PL_stack_sp--;
 
     SAVESPTR(PL_rs);		/* This is not permanent, either. */
-    PL_rs = sv_2mortal(newSVpvs("\000"));
+    PL_rs = newSVpvs_flags("\000", SVs_TEMP);
 #ifndef DOSISH
 #ifndef CSH
     *SvPVX(PL_rs) = '\n';
@@ -437,6 +422,7 @@ PP(pp_warn)
     else if (SP == MARK) {
 	tmpsv = &PL_sv_no;
 	EXTEND(SP, 1);
+	SP = MARK + 1;
     }
     else {
 	tmpsv = TOPs;
@@ -451,9 +437,9 @@ PP(pp_warn)
 	tmps = SvPV_const(tmpsv, len);
     }
     if (!tmps || !len)
-	tmpsv = sv_2mortal(newSVpvs("Warning: something's wrong"));
+	tmpsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP);
 
-    Perl_warn(aTHX_ "%"SVf, tmpsv);
+    Perl_warn(aTHX_ "%"SVf, SVfARG(tmpsv));
     RETSETYES;
 }
 
@@ -477,7 +463,7 @@ PP(pp_die)
     }
     else {
 	tmpsv = TOPs;
-        tmps = SvROK(tmpsv) ? NULL : SvPV_const(tmpsv, len);
+        tmps = SvROK(tmpsv) ? (const char *)NULL : SvPV_const(tmpsv, len);
     }
     if (!tmps || !len) {
 	SV * const error = ERRSV;
@@ -515,9 +501,9 @@ PP(pp_die)
 	}
     }
     if (!tmps || !len)
-	tmpsv = sv_2mortal(newSVpvs("Died"));
+	tmpsv = newSVpvs_flags("Died", SVs_TEMP);
 
-    DIE(aTHX_ "%"SVf, tmpsv);
+    DIE(aTHX_ "%"SVf, SVfARG(tmpsv));
 }
 
 /* I/O. */
@@ -537,11 +523,16 @@ PP(pp_open)
 
     if (!isGV(gv))
 	DIE(aTHX_ PL_no_usym, "filehandle");
-    if ((io = GvIOp(gv)))
+
+    if ((io = GvIOp(gv))) {
+	MAGIC *mg;
 	IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
-    if (io) {
-	MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+	if (IoDIRP(io) && ckWARN2(WARN_IO, WARN_DEPRECATED))
+	    Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+		    "Opening dirhandle %s also as a file", GvENAME(gv));
+
+	mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
 	if (mg) {
 	    /* Method's args are same as ours ... */
 	    /* ... except handle is replaced by the object */
@@ -578,21 +569,23 @@ PP(pp_open)
 PP(pp_close)
 {
     dVAR; dSP;
-    IO *io;
-    MAGIC *mg;
     GV * const gv = (MAXARG == 0) ? PL_defoutgv : (GV*)POPs;
 
-    if (gv && (io = GvIO(gv))
-	&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
-    {
-	PUSHMARK(SP);
-	XPUSHs(SvTIED_obj((SV*)io, mg));
-	PUTBACK;
-	ENTER;
-	call_method("CLOSE", G_SCALAR);
-	LEAVE;
-	SPAGAIN;
-	RETURN;
+    if (gv) {
+	IO * const io = GvIO(gv);
+	if (io) {
+	    MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+	    if (mg) {
+		PUSHMARK(SP);
+		XPUSHs(SvTIED_obj((SV*)io, mg));
+		PUTBACK;
+		ENTER;
+		call_method("CLOSE", G_SCALAR);
+		LEAVE;
+		SPAGAIN;
+		RETURN;
+	    }
+	}
     }
     EXTEND(SP, 1);
     PUSHs(boolSV(do_close(gv, TRUE)));
@@ -635,10 +628,14 @@ PP(pp_pipe_op)
     IoTYPE(wstio) = IoTYPE_WRONLY;
 
     if (!IoIFP(rstio) || !IoOFP(wstio)) {
-	if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
-	else PerlLIO_close(fd[0]);
-	if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
-	else PerlLIO_close(fd[1]);
+	if (IoIFP(rstio))
+	    PerlIO_close(IoIFP(rstio));
+	else
+	    PerlLIO_close(fd[0]);
+	if (IoOFP(wstio))
+	    PerlIO_close(IoOFP(wstio));
+	else
+	    PerlLIO_close(fd[1]);
 	goto badexit;
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
@@ -701,8 +698,12 @@ PP(pp_umask)
     Mode_t anum;
 
     if (MAXARG < 1) {
-	anum = PerlLIO_umask(0);
-	(void)PerlLIO_umask(anum);
+	anum = PerlLIO_umask(022);
+	/* setting it to 022 between the two calls to umask avoids
+	 * to have a window where the umask is set to 0 -- meaning
+	 * that another thread could create world-writeable files. */
+	if (anum != 022)
+	    (void)PerlLIO_umask(anum);
     }
     else
 	anum = PerlLIO_umask(POPi);
@@ -725,7 +726,6 @@ PP(pp_binmode)
     GV *gv;
     IO *io;
     PerlIO *fp;
-    MAGIC *mg;
     SV *discp = NULL;
 
     if (MAXARG < 1)
@@ -736,19 +736,20 @@ PP(pp_binmode)
 
     gv = (GV*)POPs;
 
-    if (gv && (io = GvIO(gv))
-	&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
-    {
-	PUSHMARK(SP);
-	XPUSHs(SvTIED_obj((SV*)io, mg));
-	if (discp)
-	    XPUSHs(discp);
-	PUTBACK;
-	ENTER;
-	call_method("BINMODE", G_SCALAR);
-	LEAVE;
-	SPAGAIN;
-	RETURN;
+    if (gv && (io = GvIO(gv))) {
+	MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+	if (mg) {
+	    PUSHMARK(SP);
+	    XPUSHs(SvTIED_obj((SV*)io, mg));
+	    if (discp)
+		XPUSHs(discp);
+	    PUTBACK;
+	    ENTER;
+	    call_method("BINMODE", G_SCALAR);
+	    LEAVE;
+	    SPAGAIN;
+	    RETURN;
+	}
     }
 
     EXTEND(SP, 1);
@@ -760,22 +761,27 @@ PP(pp_binmode)
     }
 
     PUTBACK;
-    if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
-                       (discp) ? SvPV_nolen_const(discp) : NULL)) {
-	if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
-	     if (!PerlIO_binmode(aTHX_ IoOFP(io),IoTYPE(io),
-			mode_from_discipline(discp),
-                       (discp) ? SvPV_nolen_const(discp) : NULL)) {
-		SPAGAIN;
-		RETPUSHUNDEF;
-	     }
+    {
+	STRLEN len = 0;
+	const char *d = NULL;
+	int mode;
+	if (discp)
+	    d = SvPV_const(discp, len);
+	mode = mode_from_discipline(d, len);
+	if (PerlIO_binmode(aTHX_ fp, IoTYPE(io), mode, d)) {
+	    if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
+		if (!PerlIO_binmode(aTHX_ IoOFP(io), IoTYPE(io), mode, d)) {
+		    SPAGAIN;
+		    RETPUSHUNDEF;
+		}
+	    }
+	    SPAGAIN;
+	    RETPUSHYES;
+	}
+	else {
+	    SPAGAIN;
+	    RETPUSHUNDEF;
 	}
-	SPAGAIN;
-	RETPUSHYES;
-    }
-    else {
-	SPAGAIN;
-	RETPUSHUNDEF;
     }
 }
 
@@ -819,7 +825,7 @@ PP(pp_tie)
 	    break;
     }
     items = SP - MARK++;
-    if (sv_isobject(*MARK)) {
+    if (sv_isobject(*MARK)) { /* Calls GET magic. */
 	ENTER;
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
@@ -833,10 +839,12 @@ PP(pp_tie)
 	/* Not clear why we don't call call_method here too.
 	 * perhaps to get different error message ?
 	 */
-	stash = gv_stashsv(*MARK, FALSE);
+	STRLEN len;
+	const char *name = SvPV_nomg_const(*MARK, len);
+	stash = gv_stashpvn(name, len, 0);
 	if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
 	    DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
-		 methname, *MARK);
+		 methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no));
 	}
 	ENTER;
 	PUSHSTACKi(PERLSI_MAGIC);
@@ -886,7 +894,7 @@ PP(pp_untie)
 	    if (gv && isGV(gv) && (cv = GvCV(gv))) {
 	       PUSHMARK(SP);
 	       XPUSHs(SvTIED_obj((SV*)gv, mg));
-	       XPUSHs(sv_2mortal(newSViv(SvREFCNT(obj)-1)));
+	       mXPUSHi(SvREFCNT(obj) - 1);
 	       PUTBACK;
 	       ENTER;
 	       call_sv((SV *)cv, G_VOID);
@@ -934,13 +942,13 @@ PP(pp_dbmopen)
     GV *gv;
 
     HV * const hv = (HV*)POPs;
-    SV * const sv = sv_2mortal(newSVpvs("AnyDBM_File"));
-    stash = gv_stashsv(sv, FALSE);
+    SV * const sv = newSVpvs_flags("AnyDBM_File", SVs_TEMP);
+    stash = gv_stashsv(sv, 0);
     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
 	PUTBACK;
 	require_pv("AnyDBM_File.pm");
 	SPAGAIN;
-	if (!(gv = gv_fetchmethod(stash, "TIEHASH")))
+	if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")))
 	    DIE(aTHX_ "No dbm on this machine");
     }
 
@@ -951,9 +959,9 @@ PP(pp_dbmopen)
     PUSHs(sv);
     PUSHs(left);
     if (SvIV(right))
-	PUSHs(sv_2mortal(newSVuv(O_RDWR|O_CREAT)));
+	mPUSHu(O_RDWR|O_CREAT);
     else
-	PUSHs(sv_2mortal(newSVuv(O_RDWR)));
+	mPUSHu(O_RDWR);
     PUSHs(right);
     PUTBACK;
     call_sv((SV*)GvCV(gv), G_SCALAR);
@@ -964,7 +972,7 @@ PP(pp_dbmopen)
 	PUSHMARK(SP);
 	PUSHs(sv);
 	PUSHs(left);
-	PUSHs(sv_2mortal(newSVuv(O_RDONLY)));
+	mPUSHu(O_RDONLY);
 	PUSHs(right);
 	PUTBACK;
 	call_sv((SV*)GvCV(gv), G_SCALAR);
@@ -1135,7 +1143,7 @@ PP(pp_sselect)
     if (GIMME == G_ARRAY && tbuf) {
 	value = (NV)(timebuf.tv_sec) +
 		(NV)(timebuf.tv_usec) / 1000000.0;
-	PUSHs(sv_2mortal(newSVnv(value)));
+	mPUSHn(value);
     }
     RETURN;
 #else
@@ -1157,7 +1165,7 @@ PP(pp_select)
 {
     dVAR; dSP; dTARGET;
     HV *hv;
-    GV * const newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL;
+    GV * const newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : NULL;
     GV * egv = GvEGV(PL_defoutgv);
 
     if (!egv)
@@ -1172,7 +1180,7 @@ PP(pp_select)
 	    XPUSHTARG;
 	}
 	else {
-	    XPUSHs(sv_2mortal(newRV((SV*)egv)));
+	    mXPUSHs(newRV((SV*)egv));
 	}
     }
 
@@ -1189,23 +1197,23 @@ PP(pp_getc)
 {
     dVAR; dSP; dTARGET;
     IO *io = NULL;
-    MAGIC *mg;
     GV * const gv = (MAXARG==0) ? PL_stdingv : (GV*)POPs;
 
-    if (gv && (io = GvIO(gv))
-	&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
-    {
-	const I32 gimme = GIMME_V;
-	PUSHMARK(SP);
-	XPUSHs(SvTIED_obj((SV*)io, mg));
-	PUTBACK;
-	ENTER;
-	call_method("GETC", gimme);
-	LEAVE;
-	SPAGAIN;
-	if (gimme == G_SCALAR)
-	    SvSetMagicSV_nosteal(TARG, TOPs);
-	RETURN;
+    if (gv && (io = GvIO(gv))) {
+	MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+	if (mg) {
+	    const I32 gimme = GIMME_V;
+	    PUSHMARK(SP);
+	    XPUSHs(SvTIED_obj((SV*)io, mg));
+	    PUTBACK;
+	    ENTER;
+	    call_method("GETC", gimme);
+	    LEAVE;
+	    SPAGAIN;
+	    if (gimme == G_SCALAR)
+		SvSetMagicSV_nosteal(TARG, TOPs);
+	    RETURN;
+	}
     }
     if (!gv || do_eof(gv)) { /* make sure we have fp with something */
 	if ((!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY))
@@ -1238,12 +1246,13 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
     register PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
 
+    PERL_ARGS_ASSERT_DOFORM;
+
     ENTER;
     SAVETMPS;
 
     PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
-    PUSHFORMAT(cx);
-    cx->blk_sub.retop = retop;
+    PUSHFORMAT(cx, retop);
     SAVECOMPPAD();
     PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
 
@@ -1259,6 +1268,7 @@ PP(pp_enterwrite)
     register IO *io;
     GV *fgv;
     CV *cv;
+    SV * tmpsv = NULL;
 
     if (MAXARG == 0)
 	gv = PL_defoutgv;
@@ -1277,17 +1287,19 @@ PP(pp_enterwrite)
     else
 	fgv = gv;
 
-    if (!fgv) {
-	DIE(aTHX_ "Not a format reference");
-    }
+    if (!fgv)
+	goto not_a_format_reference;
+
     cv = GvFORM(fgv);
     if (!cv) {
-	SV * const tmpsv = sv_newmortal();
 	const char *name;
+	tmpsv = sv_newmortal();
 	gv_efullname4(tmpsv, fgv, NULL, FALSE);
 	name = SvPV_nolen_const(tmpsv);
 	if (name && *name)
 	    DIE(aTHX_ "Undefined format \"%s\" called", name);
+
+	not_a_format_reference:
 	DIE(aTHX_ "Not a format reference");
     }
     if (CvCLONE(cv))
@@ -1300,7 +1312,7 @@ PP(pp_enterwrite)
 PP(pp_leavewrite)
 {
     dVAR; dSP;
-    GV * const gv = cxstack[cxstack_ix].blk_sub.gv;
+    GV * const gv = cxstack[cxstack_ix].blk_format.gv;
     register IO * const io = GvIOp(gv);
     PerlIO *ofp;
     PerlIO *fp;
@@ -1431,30 +1443,30 @@ PP(pp_prtf)
     IO *io;
     PerlIO *fp;
     SV *sv;
-    MAGIC *mg;
 
     GV * const gv = (PL_op->op_flags & OPf_STACKED) ? (GV*)*++MARK : PL_defoutgv;
 
-    if (gv && (io = GvIO(gv))
-	&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
-    {
-	if (MARK == ORIGMARK) {
-	    MEXTEND(SP, 1);
-	    ++MARK;
-	    Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
-	    ++SP;
+    if (gv && (io = GvIO(gv))) {
+	MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+	if (mg) {
+	    if (MARK == ORIGMARK) {
+		MEXTEND(SP, 1);
+		++MARK;
+		Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
+		++SP;
+	    }
+	    PUSHMARK(MARK - 1);
+	    *MARK = SvTIED_obj((SV*)io, mg);
+	    PUTBACK;
+	    ENTER;
+	    call_method("PRINTF", G_SCALAR);
+	    LEAVE;
+	    SPAGAIN;
+	    MARK = ORIGMARK + 1;
+	    *MARK = *SP;
+	    SP = MARK;
+	    RETURN;
 	}
-	PUSHMARK(MARK - 1);
-	*MARK = SvTIED_obj((SV*)io, mg);
-	PUTBACK;
-	ENTER;
-	call_method("PRINTF", G_SCALAR);
-	LEAVE;
-	SPAGAIN;
-	MARK = ORIGMARK + 1;
-	*MARK = *SP;
-	SP = MARK;
-	RETURN;
     }
 
     sv = newSV(0);
@@ -1475,6 +1487,8 @@ PP(pp_prtf)
 	goto just_say_no;
     }
     else {
+	if (SvTAINTED(MARK[1]))
+	    TAINT_PROPER("printf");
 	do_sprintf(sv, SP - MARK, MARK + 1);
 	if (!do_print(sv, fp))
 	    goto just_say_no;
@@ -1609,7 +1623,7 @@ PP(pp_sysread)
 	buffer = SvGROW(bufsv, (STRLEN)(length+1));
 	/* 'offset' means 'flags' here */
 	count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
-			  (struct sockaddr *)namebuf, &bufsize);
+				  (struct sockaddr *)namebuf, &bufsize);
 	if (count < 0)
 	    RETPUSHUNDEF;
 #ifdef EPOC
@@ -1777,102 +1791,163 @@ PP(pp_send)
     IO *io;
     SV *bufsv;
     const char *buffer;
-    Size_t length = 0;
     SSize_t retval;
     STRLEN blen;
-    MAGIC *mg;
+    STRLEN orig_blen_bytes;
     const int op_type = PL_op->op_type;
+    bool doing_utf8;
+    U8 *tmpbuf = NULL;
     
     GV *const gv = (GV*)*++MARK;
     if (PL_op->op_type == OP_SYSWRITE
-	&& gv && (io = GvIO(gv))
-	&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
-    {
-	SV *sv;
+	&& gv && (io = GvIO(gv))) {
+	MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+	if (mg) {
+	    SV *sv;
+
+	    if (MARK == SP - 1) {
+		EXTEND(SP, 1000);
+		sv = sv_2mortal(newSViv(sv_len(*SP)));
+		PUSHs(sv);
+		PUTBACK;
+	    }
 
-	if (MARK == SP - 1) {
-	    EXTEND(SP, 1000);
-	    sv = sv_2mortal(newSViv(sv_len(*SP)));
+	    PUSHMARK(ORIGMARK);
+	    *(ORIGMARK+1) = SvTIED_obj((SV*)io, mg);
+	    ENTER;
+	    call_method("WRITE", G_SCALAR);
+	    LEAVE;
+	    SPAGAIN;
+	    sv = POPs;
+	    SP = ORIGMARK;
 	    PUSHs(sv);
-	    PUTBACK;
+	    RETURN;
 	}
-	
-	PUSHMARK(ORIGMARK);
-	*(ORIGMARK+1) = SvTIED_obj((SV*)io, mg);
-	ENTER;
-	call_method("WRITE", G_SCALAR);
-	LEAVE;
-	SPAGAIN;
-	sv = POPs;
-	SP = ORIGMARK;
-	PUSHs(sv);
-	RETURN;
     }
     if (!gv)
 	goto say_undef;
 
     bufsv = *++MARK;
 
-    if (op_type == OP_SYSWRITE) {
-	if (MARK >= SP) {
-	    length = (Size_t) sv_len(bufsv);
-	} else {
-#if Size_t_size > IVSIZE
-	    length = (Size_t)SvNVx(*++MARK);
-#else
-	    length = (Size_t)SvIVx(*++MARK);
-#endif
-	    if ((SSize_t)length < 0)
-		DIE(aTHX_ "Negative length");
-	}
-    }
     SETERRNO(0,0);
     io = GvIO(gv);
-    if (!io || !IoIFP(io)) {
+    if (!io || !IoIFP(io) || IoTYPE(io) == IoTYPE_RDONLY) {
 	retval = -1;
-	if (ckWARN(WARN_CLOSED))
-	    report_evil_fh(gv, io, PL_op->op_type);
+	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
+	    if (io && IoIFP(io))
+		report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
+	    else
+		report_evil_fh(gv, io, PL_op->op_type);
+	}
 	SETERRNO(EBADF,RMS_IFI);
 	goto say_undef;
     }
 
+    /* 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))) {
 	if (!SvUTF8(bufsv)) {
-	    bufsv = sv_2mortal(newSVsv(bufsv));
-	    buffer = sv_2pvutf8(bufsv, &blen);
-	} else
-	    buffer = SvPV_const(bufsv, blen);
+	    /* We don't modify the original scalar.  */
+	    tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
+	    buffer = (char *) tmpbuf;
+	    doing_utf8 = TRUE;
+	}
     }
-    else {
-	 if (DO_UTF8(bufsv)) {
-	      /* Not modifying source SV, so making a temporary copy. */
-	      bufsv = sv_2mortal(newSVsv(bufsv));
-	      sv_utf8_downgrade(bufsv, FALSE);
-	 }
-	 buffer = SvPV_const(bufsv, blen);
+    else if (doing_utf8) {
+	STRLEN tmplen = blen;
+	U8 * const result = bytes_from_utf8((const U8*) buffer, &tmplen, &doing_utf8);
+	if (!doing_utf8) {
+	    tmpbuf = result;
+	    buffer = (char *) tmpbuf;
+	    blen = tmplen;
+	}
+	else {
+	    assert((char *)result == buffer);
+	    Perl_croak(aTHX_ "Wide character in %s", OP_DESC(PL_op));
+	}
     }
 
     if (op_type == OP_SYSWRITE) {
+	Size_t length = 0; /* This length is in characters.  */
+	STRLEN blen_chars;
 	IV offset;
-	if (DO_UTF8(bufsv)) {
-	    /* length and offset are in chars */
-	    blen   = sv_len_utf8(bufsv);
+
+	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.  */
+		if (SvGMAGICAL(bufsv) || SvAMAGIC(bufsv)) {
+		    /* Don't call sv_len_utf8 again because it will call magic
+		       or overloading a second time, and we might get back a
+		       different result.  */
+		    blen_chars = utf8_length((U8*)buffer, (U8*)buffer + blen);
+		} else {
+		    /* It's safe, and it may well be cached.  */
+		    blen_chars = sv_len_utf8(bufsv);
+		}
+	    }
+	} else {
+	    blen_chars = blen;
 	}
+
+	if (MARK >= SP) {
+	    length = blen_chars;
+	} else {
+#if Size_t_size > IVSIZE
+	    length = (Size_t)SvNVx(*++MARK);
+#else
+	    length = (Size_t)SvIVx(*++MARK);
+#endif
+	    if ((SSize_t)length < 0) {
+		Safefree(tmpbuf);
+		DIE(aTHX_ "Negative length");
+	    }
+	}
+
 	if (MARK < SP) {
 	    offset = SvIVx(*++MARK);
 	    if (offset < 0) {
-		if (-offset > (IV)blen)
+		if (-offset > (IV)blen_chars) {
+		    Safefree(tmpbuf);
 		    DIE(aTHX_ "Offset outside string");
-		offset += blen;
-	    } else if (offset >= (IV)blen && blen > 0)
+		}
+		offset += blen_chars;
+	    } else if (offset >= (IV)blen_chars && blen_chars > 0) {
+		Safefree(tmpbuf);
 		DIE(aTHX_ "Offset outside string");
+	    }
 	} else
 	    offset = 0;
-	if (length > blen - offset)
-	    length = blen - offset;
-	if (DO_UTF8(bufsv)) {
-	    buffer = (const char*)utf8_hop((const U8 *)buffer, offset);
-	    length = utf8_hop((U8 *)buffer, length) - (U8 *)buffer;
+	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;
@@ -1908,11 +1983,14 @@ PP(pp_send)
     else
 	DIE(aTHX_ PL_no_sock_func, "send");
 #endif
+
     if (retval < 0)
 	goto say_undef;
     SP = ORIGMARK;
-    if (DO_UTF8(bufsv))
+    if (doing_utf8)
         retval = utf8_length((U8*)buffer, (U8*)buffer + retval);
+
+    Safefree(tmpbuf);
 #if Size_t_size > IVSIZE
     PUSHn(retval);
 #else
@@ -1921,6 +1999,7 @@ PP(pp_send)
     RETURN;
 
   say_undef:
+    Safefree(tmpbuf);
     SP = ORIGMARK;
     RETPUSHUNDEF;
 }
@@ -1940,7 +2019,12 @@ PP(pp_eof)
 		    IoLINES(io) = 0;
 		    IoFLAGS(io) &= ~IOf_START;
 		    do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
-		    sv_setpvn(GvSV(gv), "-", 1);
+		    if ( GvSV(gv) ) {
+			sv_setpvn(GvSV(gv), "-", 1);
+		    }
+		    else {
+			GvSV(gv) = newSVpvn("-", 1);
+		    }
 		    SvSETMAGIC(GvSV(gv));
 		}
 		else if (!nextargv(gv))
@@ -1977,23 +2061,23 @@ PP(pp_tell)
     dVAR; dSP; dTARGET;
     GV *gv;
     IO *io;
-    MAGIC *mg;
 
     if (MAXARG != 0)
 	PL_last_in_gv = (GV*)POPs;
     gv = PL_last_in_gv;
 
-    if (gv && (io = GvIO(gv))
-	&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
-    {
-	PUSHMARK(SP);
-	XPUSHs(SvTIED_obj((SV*)io, mg));
-	PUTBACK;
-	ENTER;
-	call_method("TELL", G_SCALAR);
-	LEAVE;
-	SPAGAIN;
-	RETURN;
+    if (gv && (io = GvIO(gv))) {
+	MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+	if (mg) {
+	    PUSHMARK(SP);
+	    XPUSHs(SvTIED_obj((SV*)io, mg));
+	    PUTBACK;
+	    ENTER;
+	    call_method("TELL", G_SCALAR);
+	    LEAVE;
+	    SPAGAIN;
+	    RETURN;
+	}
     }
 
 #if LSEEKSIZE > IVSIZE
@@ -2007,34 +2091,34 @@ PP(pp_tell)
 PP(pp_sysseek)
 {
     dVAR; dSP;
-    IO *io;
     const int whence = POPi;
 #if LSEEKSIZE > IVSIZE
     const Off_t offset = (Off_t)SvNVx(POPs);
 #else
     const Off_t offset = (Off_t)SvIVx(POPs);
 #endif
-    MAGIC *mg;
 
     GV * const gv = PL_last_in_gv = (GV*)POPs;
+    IO *io;
 
-    if (gv && (io = GvIO(gv))
-	&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
-    {
-	PUSHMARK(SP);
-	XPUSHs(SvTIED_obj((SV*)io, mg));
+    if (gv && (io = GvIO(gv))) {
+	MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+	if (mg) {
+	    PUSHMARK(SP);
+	    XPUSHs(SvTIED_obj((SV*)io, mg));
 #if LSEEKSIZE > IVSIZE
-	XPUSHs(sv_2mortal(newSVnv((NV) offset)));
+	    mXPUSHn((NV) offset);
 #else
-	XPUSHs(sv_2mortal(newSViv(offset)));
+	    mXPUSHi(offset);
 #endif
-	XPUSHs(sv_2mortal(newSViv(whence)));
-	PUTBACK;
-	ENTER;
-	call_method("SEEK", G_SCALAR);
-	LEAVE;
-	SPAGAIN;
-	RETURN;
+	    mXPUSHi(whence);
+	    PUTBACK;
+	    ENTER;
+	    call_method("SEEK", G_SCALAR);
+	    LEAVE;
+	    SPAGAIN;
+	    RETURN;
+	}
     }
 
     if (PL_op->op_type == OP_SEEK)
@@ -2051,7 +2135,7 @@ PP(pp_sysseek)
                 newSViv(sought)
 #endif
                 : newSVpvn(zero_but_true, ZBTLEN);
-            PUSHs(sv_2mortal(sv));
+            mPUSHs(sv);
         }
     }
     RETURN;
@@ -2384,19 +2468,13 @@ PP(pp_bind)
     GV * const gv = (GV*)POPs;
     register IO * const io = GvIOn(gv);
     STRLEN len;
-    int bind_ok = 0;
 
     if (!io || !IoIFP(io))
 	goto nuts;
 
     addr = SvPV_const(addrsv, len);
     TAINT_PROPER("bind");
-    if (PerlSock_bind(PerlIO_fileno(IoIFP(io)),
-		      (struct sockaddr *)addr, len) >= 0)
-	bind_ok = 1;
-
-
-    if (bind_ok)
+    if (PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
 	RETPUSHYES;
     else
 	RETPUSHUNDEF;
@@ -2494,6 +2572,17 @@ PP(pp_accept)
 
     nstio = GvIOn(ngv);
     fd = PerlSock_accept(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
+	 * not bound. Simulate a non-zero-length sockaddr structure in
+	 * this case. */
+	namebuf[0] = 0;        /* sun_len */
+	namebuf[1] = AF_UNIX;  /* sun_family */
+	len = 2;
+    }
+#endif
+
     if (fd < 0)
 	goto badexit;
     if (IoIFP(nstio))
@@ -2706,7 +2795,8 @@ PP(pp_stat)
 {
     dVAR;
     dSP;
-    GV *gv;
+    GV *gv = NULL;
+    IO *io;
     I32 gimme;
     I32 max = 13;
 
@@ -2717,7 +2807,7 @@ PP(pp_stat)
 	    do_fstat_warning_check:
 		if (ckWARN(WARN_IO))
 		    Perl_warner(aTHX_ packWARN(WARN_IO),
-			"lstat() on filehandle %s", GvENAME(gv));
+			"lstat() on filehandle %s", gv ? GvENAME(gv) : "");
 	    } else if (PL_laststype != OP_LSTAT)
 		Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
 	}
@@ -2727,9 +2817,23 @@ PP(pp_stat)
 	    PL_laststype = OP_STAT;
 	    PL_statgv = gv;
 	    sv_setpvn(PL_statname, "", 0);
-	    PL_laststatval = (GvIO(gv) && IoIFP(GvIOp(gv))
-		? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(gv))), &PL_statcache) : -1);
-	}
+            if(gv) {
+                io = GvIO(gv);
+                do_fstat_have_io:
+                if (io) {
+                    if (IoIFP(io)) {
+                        PL_laststatval = 
+                            PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);   
+                    } else if (IoDIRP(io)) {
+                        PL_laststatval =
+                            PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);
+                    } else {
+                        PL_laststatval = -1;
+                    }
+	        }
+            }
+        }
+
 	if (PL_laststatval < 0) {
 	    if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
 		report_evil_fh(gv, GvIO(gv), PL_op->op_type);
@@ -2741,13 +2845,18 @@ PP(pp_stat)
 	if (SvTYPE(sv) == SVt_PVGV) {
 	    gv = (GV*)sv;
 	    goto do_fstat;
-	}
-	else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
-	    gv = (GV*)SvRV(sv);
-	    if (PL_op->op_type == OP_LSTAT)
-		goto do_fstat_warning_check;
-	    goto do_fstat;
-	}
+	} else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+            gv = (GV*)SvRV(sv);
+            if (PL_op->op_type == OP_LSTAT)
+                goto do_fstat_warning_check;
+            goto do_fstat;
+        } else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { 
+            io = (IO*)SvRV(sv);
+            if (PL_op->op_type == OP_LSTAT)
+                goto do_fstat_warning_check;
+            goto do_fstat_have_io; 
+        }
+        
 	sv_setpv(PL_statname, SvPV_nolen_const(sv));
 	PL_statgv = NULL;
 	PL_laststype = PL_op->op_type;
@@ -2771,53 +2880,53 @@ PP(pp_stat)
     if (max) {
 	EXTEND(SP, max);
 	EXTEND_MORTAL(max);
-	PUSHs(sv_2mortal(newSViv(PL_statcache.st_dev)));
-	PUSHs(sv_2mortal(newSViv(PL_statcache.st_ino)));
-	PUSHs(sv_2mortal(newSVuv(PL_statcache.st_mode)));
-	PUSHs(sv_2mortal(newSVuv(PL_statcache.st_nlink)));
+	mPUSHi(PL_statcache.st_dev);
+	mPUSHi(PL_statcache.st_ino);
+	mPUSHu(PL_statcache.st_mode);
+	mPUSHu(PL_statcache.st_nlink);
 #if Uid_t_size > IVSIZE
-	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_uid)));
+	mPUSHn(PL_statcache.st_uid);
 #else
 #   if Uid_t_sign <= 0
-	PUSHs(sv_2mortal(newSViv(PL_statcache.st_uid)));
+	mPUSHi(PL_statcache.st_uid);
 #   else
-	PUSHs(sv_2mortal(newSVuv(PL_statcache.st_uid)));
+	mPUSHu(PL_statcache.st_uid);
 #   endif
 #endif
 #if Gid_t_size > IVSIZE
-	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_gid)));
+	mPUSHn(PL_statcache.st_gid);
 #else
 #   if Gid_t_sign <= 0
-	PUSHs(sv_2mortal(newSViv(PL_statcache.st_gid)));
+	mPUSHi(PL_statcache.st_gid);
 #   else
-	PUSHs(sv_2mortal(newSVuv(PL_statcache.st_gid)));
+	mPUSHu(PL_statcache.st_gid);
 #   endif
 #endif
 #ifdef USE_STAT_RDEV
-	PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev)));
+	mPUSHi(PL_statcache.st_rdev);
 #else
-	PUSHs(sv_2mortal(newSVpvs("")));
+	PUSHs(newSVpvs_flags("", SVs_TEMP));
 #endif
 #if Off_t_size > IVSIZE
-	PUSHs(sv_2mortal(newSVnv((NV)PL_statcache.st_size)));
+	mPUSHn(PL_statcache.st_size);
 #else
-	PUSHs(sv_2mortal(newSViv(PL_statcache.st_size)));
+	mPUSHi(PL_statcache.st_size);
 #endif
 #ifdef BIG_TIME
-	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_atime)));
-	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime)));
-	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_ctime)));
+	mPUSHn(PL_statcache.st_atime);
+	mPUSHn(PL_statcache.st_mtime);
+	mPUSHn(PL_statcache.st_ctime);
 #else
-	PUSHs(sv_2mortal(newSViv(PL_statcache.st_atime)));
-	PUSHs(sv_2mortal(newSViv(PL_statcache.st_mtime)));
-	PUSHs(sv_2mortal(newSViv(PL_statcache.st_ctime)));
+	mPUSHi(PL_statcache.st_atime);
+	mPUSHi(PL_statcache.st_mtime);
+	mPUSHi(PL_statcache.st_ctime);
 #endif
 #ifdef USE_STAT_BLOCKS
-	PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blksize)));
-	PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blocks)));
+	mPUSHu(PL_statcache.st_blksize);
+	mPUSHu(PL_statcache.st_blocks);
 #else
-	PUSHs(sv_2mortal(newSVpvs("")));
-	PUSHs(sv_2mortal(newSVpvs("")));
+	PUSHs(newSVpvs_flags("", SVs_TEMP));
+	PUSHs(newSVpvs_flags("", SVs_TEMP));
 #endif
     }
     RETURN;
@@ -2897,10 +3006,9 @@ PP(pp_ftrread)
 	effective = TRUE;
 	break;
 
-
     case OP_FTEEXEC:
 #ifdef PERL_EFF_ACCESS
-	access_mode = W_OK;
+	access_mode = X_OK;
 #else
 	use_access = 0;
 #endif
@@ -2911,7 +3019,7 @@ PP(pp_ftrread)
 
     if (use_access) {
 #if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
-	const char *const name = POPpx;
+	const char *name = POPpx;
 	if (effective) {
 #  ifdef PERL_EFF_ACCESS
 	    result = PERL_EFF_ACCESS(name, access_mode);
@@ -3231,7 +3339,7 @@ PP(pp_fttext)
 
 #if defined(DOSISH) || defined(USEMYBINMODE)
     /* ignore trailing ^Z on short files */
-    if (len && len < sizeof(tbuf) && tbuf[len-1] == 26)
+    if (len && len < (I32)sizeof(tbuf) && tbuf[len-1] == 26)
 	--len;
 #endif
 
@@ -3300,7 +3408,7 @@ PP(pp_chdir)
             gv = (GV*)SvRV(sv);
         }
         else {
-	    tmps = SvPVx_nolen_const(sv);
+	    tmps = SvPV_nolen_const(sv);
 	}
     }
 
@@ -3331,15 +3439,10 @@ PP(pp_chdir)
 #ifdef HAS_FCHDIR
 	IO* const io = GvIO(gv);
 	if (io) {
-	    if (IoIFP(io)) {
-		PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
-	    }
-	    else if (IoDIRP(io)) {
-#ifdef HAS_DIRFD
-		PUSHi(fchdir(dirfd(IoDIRP(io))) >= 0);
-#else
-		DIE(aTHX_ PL_no_func, "dirfd");
-#endif
+	    if (IoDIRP(io)) {
+		PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0);
+	    } else if (IoIFP(io)) {
+                PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
 	    }
 	    else {
 		if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
@@ -3500,15 +3603,19 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename)
     char *s;
     PerlIO *myfp;
     int anum = 1;
+    Size_t size = strlen(cmd) + (strlen(filename) * 2) + 10;
+
+    PERL_ARGS_ASSERT_DOONELINER;
 
-    Newx(cmdline, strlen(cmd) + (strlen(filename) * 2) + 10, char);
-    strcpy(cmdline, cmd);
-    strcat(cmdline, " ");
+    Newx(cmdline, size, char);
+    my_strlcpy(cmdline, cmd, size);
+    my_strlcat(cmdline, " ", size);
     for (s = cmdline + strlen(cmdline); *filename; ) {
 	*s++ = '\\';
 	*s++ = *filename++;
     }
-    strcpy(s, " 2>&1");
+    if (s - cmdline < size)
+	my_strlcpy(s, " 2>&1", size - (s - cmdline));
     myfp = PerlProc_popen(cmdline, "r");
     Safefree(cmdline);
 
@@ -3657,6 +3764,9 @@ PP(pp_open_dir)
     if (!io)
 	goto nope;
 
+    if ((IoIFP(io) || IoOFP(io)) && ckWARN2(WARN_IO, WARN_DEPRECATED))
+	Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+		"Opening filehandle %s also as a directory", GvENAME(gv));
     if (IoDIRP(io))
 	PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
@@ -3710,9 +3820,8 @@ PP(pp_readdir)
         if (!(IoFLAGS(io) & IOf_UNTAINT))
             SvTAINTED_on(sv);
 #endif
-        XPUSHs(sv_2mortal(sv));
-    }
-    while (gimme == G_ARRAY);
+        mXPUSHs(sv);
+    } while (gimme == G_ARRAY);
 
     if (!dp && gimme != G_ARRAY)
         goto nope;
@@ -3897,7 +4006,7 @@ PP(pp_fork)
 
 PP(pp_wait)
 {
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
     dVAR; dSP; dTARGET;
     Pid_t childpid;
     int argflags;
@@ -3925,7 +4034,7 @@ PP(pp_wait)
 
 PP(pp_waitpid)
 {
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
     dVAR; dSP; dTARGET;
     const int optype = POPi;
     const Pid_t pid = TOPi;
@@ -3956,6 +4065,11 @@ PP(pp_waitpid)
 PP(pp_system)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+#if defined(__LIBCATAMOUNT__)
+    PL_statusvalue = -1;
+    SP = ORIGMARK;
+    XPUSHi(-1);
+#else
     I32 value;
     int result;
 
@@ -4013,7 +4127,8 @@ PP(pp_system)
 	    SP = ORIGMARK;
 	    if (did_pipes) {
 		int errkid;
-		int n = 0, n1;
+		unsigned n = 0;
+		SSize_t n1;
 
 		while (n < sizeof(int)) {
 		    n1 = PerlLIO_read(pp[0],
@@ -4056,14 +4171,14 @@ PP(pp_system)
     result = 0;
     if (PL_op->op_flags & OPf_STACKED) {
 	SV * const really = *++MARK;
-#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
+#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || 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) {
-#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
+#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__) || defined(__VMS)
 	value = (I32)do_aspawn(NULL, MARK, SP);
 #  else
 	value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP);
@@ -4078,7 +4193,8 @@ PP(pp_system)
     do_execfree();
     SP = ORIGMARK;
     XPUSHi(result ? value : STATUS_CURRENT);
-#endif /* !FORK or VMS */
+#endif /* !FORK or VMS or OS/2 */
+#endif
     RETURN;
 }
 
@@ -4259,22 +4375,22 @@ PP(pp_tms)
                                                    /* is returned.                   */
 #endif
 
-    PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_utime)/(NV)PL_clocktick)));
+    mPUSHn(((NV)PL_timesbuf.tms_utime)/(NV)PL_clocktick);
     if (GIMME == G_ARRAY) {
-	PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_stime)/(NV)PL_clocktick)));
-	PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cutime)/(NV)PL_clocktick)));
-	PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cstime)/(NV)PL_clocktick)));
+	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);
     }
     RETURN;
 #else
 #   ifdef PERL_MICRO
     dSP;
-    PUSHs(sv_2mortal(newSVnv((NV)0.0)));
+    mPUSHn(0.0);
     EXTEND(SP, 4);
     if (GIMME == G_ARRAY) {
-	 PUSHs(sv_2mortal(newSVnv((NV)0.0)));
-	 PUSHs(sv_2mortal(newSVnv((NV)0.0)));
-	 PUSHs(sv_2mortal(newSVnv((NV)0.0)));
+	 mPUSHn(0.0);
+	 mPUSHn(0.0);
+	 mPUSHn(0.0);
     }
     RETURN;
 #   else
@@ -4367,20 +4483,20 @@ PP(pp_gmtime)
 			    tmbuf->tm_min,
 			    tmbuf->tm_sec,
 			    tmbuf->tm_year + 1900);
-	PUSHs(sv_2mortal(tsv));
+	mPUSHs(tsv);
     }
     else if (tmbuf) {
         EXTEND(SP, 9);
         EXTEND_MORTAL(9);
-        PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec)));
-	PUSHs(sv_2mortal(newSViv(tmbuf->tm_min)));
-	PUSHs(sv_2mortal(newSViv(tmbuf->tm_hour)));
-	PUSHs(sv_2mortal(newSViv(tmbuf->tm_mday)));
-	PUSHs(sv_2mortal(newSViv(tmbuf->tm_mon)));
-	PUSHs(sv_2mortal(newSViv(tmbuf->tm_year)));
-	PUSHs(sv_2mortal(newSViv(tmbuf->tm_wday)));
-	PUSHs(sv_2mortal(newSViv(tmbuf->tm_yday)));
-	PUSHs(sv_2mortal(newSViv(tmbuf->tm_isdst)));
+        mPUSHi(tmbuf->tm_sec);
+	mPUSHi(tmbuf->tm_min);
+	mPUSHi(tmbuf->tm_hour);
+	mPUSHi(tmbuf->tm_mday);
+	mPUSHi(tmbuf->tm_mon);
+	mPUSHi(tmbuf->tm_year);
+	mPUSHi(tmbuf->tm_wday);
+	mPUSHi(tmbuf->tm_yday);
+	mPUSHi(tmbuf->tm_isdst);
     }
     RETURN;
 }
@@ -4498,8 +4614,10 @@ S_space_join_names_mortal(pTHX_ char *const *array)
 {
     SV *target;
 
+    PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL;
+
     if (array && *array) {
-	target = sv_2mortal(newSVpvs(""));
+	target = newSVpvs_flags("", SVs_TEMP);
 	while (1) {
 	    sv_catpv(target, *array);
 	    if (!*++array)
@@ -4543,7 +4661,7 @@ PP(pp_ghostent)
 	const int addrtype = POPi;
 	SV * const addrsv = POPs;
 	STRLEN addrlen;
-	Netdb_host_t addr = (Netdb_host_t) SvPVbyte(addrsv, addrlen);
+	const char *addr = (char *)SvPVbyte(addrsv, addrlen);
 
 	hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
 #else
@@ -4582,18 +4700,18 @@ PP(pp_ghostent)
     }
 
     if (hent) {
-	PUSHs(sv_2mortal(newSVpv((char*)hent->h_name, 0)));
-	PUSHs(S_space_join_names_mortal(aTHX_ hent->h_aliases));
-	PUSHs(sv_2mortal(newSViv((IV)hent->h_addrtype)));
+	mPUSHs(newSVpv((char*)hent->h_name, 0));
+	PUSHs(space_join_names_mortal(hent->h_aliases));
+	mPUSHi(hent->h_addrtype);
 	len = hent->h_length;
-	PUSHs(sv_2mortal(newSViv((IV)len)));
+	mPUSHi(len);
 #ifdef h_addr
 	for (elem = hent->h_addr_list; elem && *elem; elem++) {
-	    XPUSHs(sv_2mortal(newSVpvn(*elem, len)));
+	    mXPUSHp(*elem, len);
 	}
 #else
 	if (hent->h_addr)
-	    PUSHs(newSVpvn(hent->h_addr, len));
+	    mPUSHp(hent->h_addr, len);
 	else
 	    PUSHs(sv_mortalcopy(&PL_sv_no));
 #endif /* h_addr */
@@ -4665,10 +4783,10 @@ PP(pp_gnetent)
     }
 
     if (nent) {
-	PUSHs(sv_2mortal(newSVpv(nent->n_name, 0)));
-	PUSHs(S_space_join_names_mortal(aTHX_ nent->n_aliases));
-	PUSHs(sv_2mortal(newSViv((IV)nent->n_addrtype)));
-	PUSHs(sv_2mortal(newSViv((IV)nent->n_net)));
+	mPUSHs(newSVpv(nent->n_name, 0));
+	PUSHs(space_join_names_mortal(nent->n_aliases));
+	mPUSHi(nent->n_addrtype);
+	mPUSHi(nent->n_net);
     }
 
     RETURN;
@@ -4726,9 +4844,9 @@ PP(pp_gprotoent)
     }
 
     if (pent) {
-	PUSHs(sv_2mortal(newSVpv(pent->p_name, 0)));
-	PUSHs(S_space_join_names_mortal(aTHX_ pent->p_aliases));
-	PUSHs(sv_2mortal(newSViv((IV)pent->p_proto)));
+	mPUSHs(newSVpv(pent->p_name, 0));
+	PUSHs(space_join_names_mortal(pent->p_aliases));
+	mPUSHi(pent->p_proto);
     }
 
     RETURN;
@@ -4796,14 +4914,14 @@ PP(pp_gservent)
     }
 
     if (sent) {
-	PUSHs(sv_2mortal(newSVpv(sent->s_name, 0)));
-	PUSHs(S_space_join_names_mortal(aTHX_ sent->s_aliases));
+	mPUSHs(newSVpv(sent->s_name, 0));
+	PUSHs(space_join_names_mortal(sent->s_aliases));
 #ifdef HAS_NTOHS
-	PUSHs(sv_2mortal(newSViv((IV)PerlSock_ntohs(sent->s_port))));
+	mPUSHi(PerlSock_ntohs(sent->s_port));
 #else
-	PUSHs(sv_2mortal(newSViv((IV)(sent->s_port))));
+	mPUSHi(sent->s_port);
 #endif
-	PUSHs(sv_2mortal(newSVpv(sent->s_proto, 0)));
+	mPUSHs(newSVpv(sent->s_proto, 0));
     }
 
     RETURN;
@@ -4827,7 +4945,7 @@ PP(pp_snetent)
 {
 #ifdef HAS_SETNETENT
     dVAR; dSP;
-    PerlSock_setnetent(TOPi);
+    (void)PerlSock_setnetent(TOPi);
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setnetent");
@@ -4838,7 +4956,7 @@ PP(pp_sprotoent)
 {
 #ifdef HAS_SETPROTOENT
     dVAR; dSP;
-    PerlSock_setprotoent(TOPi);
+    (void)PerlSock_setprotoent(TOPi);
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setprotoent");
@@ -4849,7 +4967,7 @@ PP(pp_sservent)
 {
 #ifdef HAS_SETSERVENT
     dVAR; dSP;
-    PerlSock_setservent(TOPi);
+    (void)PerlSock_setservent(TOPi);
     RETSETYES;
 #else
     DIE(aTHX_ PL_no_sock_func, "setservent");
@@ -5019,9 +5137,10 @@ PP(pp_gpwent)
     }
 
     if (pwent) {
-	PUSHs(sv_2mortal(newSVpv(pwent->pw_name, 0)));
+	mPUSHs(newSVpv(pwent->pw_name, 0));
 
-	PUSHs(sv = sv_2mortal(newSViv(0)));
+	sv = newSViv(0);
+	mPUSHs(sv);
 	/* If we have getspnam(), we try to dig up the shadow
 	 * password.  If we are underprivileged, the shadow
 	 * interface will set the errno to EACCES or similar,
@@ -5065,15 +5184,15 @@ PP(pp_gpwent)
 #   endif
 
 #   if Uid_t_sign <= 0
-	PUSHs(sv_2mortal(newSViv((IV)pwent->pw_uid)));
+	mPUSHi(pwent->pw_uid);
 #   else
-	PUSHs(sv_2mortal(newSVuv((UV)pwent->pw_uid)));
+	mPUSHu(pwent->pw_uid);
 #   endif
 
 #   if Uid_t_sign <= 0
-	PUSHs(sv_2mortal(newSViv((IV)pwent->pw_gid)));
+	mPUSHi(pwent->pw_gid);
 #   else
-	PUSHs(sv_2mortal(newSVuv((UV)pwent->pw_gid)));
+	mPUSHu(pwent->pw_gid);
 #   endif
 	/* pw_change, pw_quota, and pw_age are mutually exclusive--
 	 * because of the poor interface of the Perl getpw*(),
@@ -5081,13 +5200,13 @@ PP(pp_gpwent)
 	 * A better interface would have been to return a hash,
 	 * but we are accursed by our history, alas. --jhi.  */
 #   ifdef PWCHANGE
-	PUSHs(sv_2mortal(newSViv((IV)pwent->pw_change)));
+	mPUSHi(pwent->pw_change);
 #   else
 #       ifdef PWQUOTA
-	PUSHs(sv_2mortal(newSViv((IV)pwent->pw_quota)));
+	mPUSHi(pwent->pw_quota);
 #       else
 #           ifdef PWAGE
-	PUSHs(sv_2mortal(newSVpv(pwent->pw_age, 0)));
+	mPUSHs(newSVpv(pwent->pw_age, 0));
 #	    else
 	/* I think that you can never get this compiled, but just in case.  */
 	PUSHs(sv_mortalcopy(&PL_sv_no));
@@ -5098,10 +5217,10 @@ PP(pp_gpwent)
 	/* pw_class and pw_comment are mutually exclusive--.
 	 * see the above note for pw_change, pw_quota, and pw_age. */
 #   ifdef PWCLASS
-	PUSHs(sv_2mortal(newSVpv(pwent->pw_class, 0)));
+	mPUSHs(newSVpv(pwent->pw_class, 0));
 #   else
 #       ifdef PWCOMMENT
-	PUSHs(sv_2mortal(newSVpv(pwent->pw_comment, 0)));
+	mPUSHs(newSVpv(pwent->pw_comment, 0));
 #	else
 	/* I think that you can never get this compiled, but just in case.  */
 	PUSHs(sv_mortalcopy(&PL_sv_no));
@@ -5111,14 +5230,14 @@ PP(pp_gpwent)
 #   ifdef PWGECOS
 	PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_gecos, 0)));
 #   else
-	PUSHs(sv_mortalcopy(&PL_sv_no));
+	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);
 #   endif
 
-	PUSHs(sv_2mortal(newSVpv(pwent->pw_dir, 0)));
+	mPUSHs(newSVpv(pwent->pw_dir, 0));
 
 	PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_shell, 0)));
 #   ifndef INCOMPLETE_TAINTS
@@ -5127,7 +5246,7 @@ PP(pp_gpwent)
 #   endif
 
 #   ifdef PWEXPIRE
-	PUSHs(sv_2mortal(newSViv((IV)pwent->pw_expire)));
+	mPUSHi(pwent->pw_expire);
 #   endif
     }
     RETURN;
@@ -5195,15 +5314,15 @@ PP(pp_ggrent)
     }
 
     if (grent) {
-	PUSHs(sv_2mortal(newSVpv(grent->gr_name, 0)));
+	mPUSHs(newSVpv(grent->gr_name, 0));
 
 #ifdef GRPASSWD
-	PUSHs(sv_2mortal(newSVpv(grent->gr_passwd, 0)));
+	mPUSHs(newSVpv(grent->gr_passwd, 0));
 #else
 	PUSHs(sv_mortalcopy(&PL_sv_no));
 #endif
 
-	PUSHs(sv_2mortal(newSViv((IV)grent->gr_gid)));
+	mPUSHi(grent->gr_gid);
 
 #if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API))
 	/* In UNICOS/mk (_CRAYMPP) the multithreading
@@ -5214,7 +5333,7 @@ PP(pp_ggrent)
 	 * but the gr_mem is poisonous anyway.
 	 * So yes, you cannot get the list of group
 	 * members if building multithreaded in UNICOS/mk. */
-	PUSHs(S_space_join_names_mortal(aTHX_ grent->gr_mem));
+	PUSHs(space_join_names_mortal(grent->gr_mem));
 #endif
     }