X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/e366b469b913fe3bb59ea9a1de1949e15e2e2633..dc9da78b70f004446f5a9327eea553687ad8c180:/pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 593fd6c..1f19fbd 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1,6 +1,7 @@
 /*    pp_sys.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, 2004, 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.
@@ -80,7 +81,11 @@ extern int h_errno;
 #  endif
 # endif
 # ifdef HAS_GETPWENT
+#ifndef getpwent
   struct passwd *getpwent (void);
+#elif defined (VMS) && defined (my_getpwent)
+  struct passwd *Perl_my_getpwent (void);
+#endif
 # endif
 #endif
 
@@ -92,7 +97,9 @@ extern int h_errno;
     struct group *getgrgid (Gid_t);
 # endif
 # ifdef HAS_GETGRENT
+#ifndef getgrent
     struct group *getgrent (void);
+#endif
 # endif
 #endif
 
@@ -167,6 +174,20 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
 #  define FD_CLOEXEC 1		/* NeXT needs this */
 #endif
 
+#include "reentr.h"
+
+#ifdef __Lynx__
+/* Missing protos on LynxOS */
+void sethostent(int);
+void endhostent(void);
+void setnetent(int);
+void endnetent(void);
+void setprotoent(int);
+void endprotoent(void);
+void setservent(int);
+void endservent(void);
+#endif
+
 #undef PERL_EFF_ACCESS_R_OK	/* EFFective uid/gid ACCESS R_OK */
 #undef PERL_EFF_ACCESS_W_OK
 #undef PERL_EFF_ACCESS_X_OK
@@ -315,10 +336,13 @@ PP(pp_backtick)
 		;
 	}
 	else if (gimme == G_SCALAR) {
+	    SV *oldrs = PL_rs;
+	    PL_rs = &PL_sv_undef;
 	    sv_setpv(TARG, "");	/* note that this preserves previous buffer */
 	    while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
 		/*SUPPRESS 530*/
 		;
+	    PL_rs = oldrs;
 	    XPUSHs(TARG);
 	    SvTAINTED_on(TARG);
 	}
@@ -411,7 +435,7 @@ PP(pp_warn)
 	tmpsv = TOPs;
     }
     tmps = SvPV(tmpsv, len);
-    if (!tmps || !len) {
+    if ((!tmps || !len) && PL_errgv) {
   	SV *error = ERRSV;
 	(void)SvUPGRADE(error, SVt_PV);
 	if (SvPOK(error) && SvCUR(error))
@@ -446,7 +470,7 @@ PP(pp_die)
     }
     else {
 	tmpsv = TOPs;
-        tmps = (SvROK(tmpsv) && PL_in_eval) ? Nullch : SvPV(tmpsv, len);
+        tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, len);
     }
     if (!tmps || !len) {
   	SV *error = ERRSV;
@@ -597,8 +621,9 @@ PP(pp_pipe_op)
     if (PerlProc_pipe(fd) < 0)
 	goto badexit;
 
-    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
-    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
+    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;
     IoTYPE(wstio) = IoTYPE_WRONLY;
@@ -722,14 +747,28 @@ PP(pp_binmode)
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) {
 	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
 	    report_evil_fh(gv, io, PL_op->op_type);
+	SETERRNO(EBADF,RMS_IFI);
         RETPUSHUNDEF;
     }
 
+    PUTBACK;
     if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
-                       (discp) ? SvPV_nolen(discp) : Nullch))
+                       (discp) ? SvPV_nolen(discp) : Nullch)) {
+	if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
+	     if (!PerlIO_binmode(aTHX_ IoOFP(io),IoTYPE(io),
+			mode_from_discipline(discp),
+                       (discp) ? SvPV_nolen(discp) : Nullch)) {
+		SPAGAIN;
+		RETPUSHUNDEF;
+	     }
+	}
+	SPAGAIN;
 	RETPUSHYES;
-    else
+    }
+    else {
+	SPAGAIN;
 	RETPUSHUNDEF;
+    }
 }
 
 PP(pp_tie)
@@ -744,7 +783,6 @@ PP(pp_tie)
     char *methname;
     int how = PERL_MAGIC_tied;
     U32 items;
-    STRLEN n_a;
 
     varsv = *++MARK;
     switch(SvTYPE(varsv)) {
@@ -779,7 +817,7 @@ PP(pp_tie)
 	ENTER;
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
-	EXTEND(SP,items);
+	EXTEND(SP,(I32)items);
 	while (items--)
 	    PUSHs(*MARK++);
 	PUTBACK;
@@ -791,13 +829,13 @@ PP(pp_tie)
 	 */
 	stash = gv_stashsv(*MARK, FALSE);
 	if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
-	    DIE(aTHX_ "Can't locate object method \"%s\" via package \"%s\"",
-		 methname, SvPV(*MARK,n_a));
+	    DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
+		 methname, *MARK);
 	}
 	ENTER;
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
-	EXTEND(SP,items);
+	EXTEND(SP,(I32)items);
 	while (items--)
 	    PUSHs(*MARK++);
 	PUTBACK;
@@ -811,11 +849,11 @@ PP(pp_tie)
 	sv_unmagic(varsv, how);
 	/* Croak if a self-tie on an aggregate is attempted. */
 	if (varsv == SvRV(sv) &&
-	    (SvTYPE(sv) == SVt_PVAV ||
-	     SvTYPE(sv) == SVt_PVHV))
+	    (SvTYPE(varsv) == SVt_PVAV ||
+	     SvTYPE(varsv) == SVt_PVHV))
 	    Perl_croak(aTHX_
 		       "Self-ties of arrays and hashes are not supported");
-	sv_magic(varsv, sv, how, Nullch, 0);
+	sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0);
     }
     LEAVE;
     SP = PL_stack_base + markoff;
@@ -835,7 +873,7 @@ PP(pp_untie)
 	RETPUSHYES;
 
     if ((mg = SvTIED_mg(sv, how))) {
-	SV *obj = SvRV(mg->mg_obj);
+	SV *obj = SvRV(SvTIED_obj(sv, mg));
 	GV *gv;
 	CV *cv = NULL;
         if (obj) {
@@ -852,13 +890,13 @@ PP(pp_untie)
             }
            else if (ckWARN(WARN_UNTIE)) {
 	       if (mg && SvREFCNT(obj) > 1)
-		  Perl_warner(aTHX_ WARN_UNTIE,
+		  Perl_warner(aTHX_ packWARN(WARN_UNTIE),
 		      "untie attempted while %"UVuf" inner references still exist",
 		       (UV)SvREFCNT(obj) - 1 ) ;
            }
         }
-	sv_unmagic(sv, how) ;
     }
+    sv_unmagic(sv, how) ;
     RETPUSHYES;
 }
 
@@ -998,15 +1036,19 @@ PP(pp_sselect)
     Zero(&fd_sets[0], 4, char*);
 #endif
 
-#  if SELECT_MIN_BITS > 1
+#  if SELECT_MIN_BITS == 1
+    growsize = sizeof(fd_set);
+#  else
+#   if defined(__GLIBC__) && defined(__FD_SETSIZE)
+#      undef SELECT_MIN_BITS
+#      define SELECT_MIN_BITS __FD_SETSIZE
+#   endif
     /* If SELECT_MIN_BITS is greater than one we most probably will want
      * to align the sizes with SELECT_MIN_BITS/8 because for example
      * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
      * UNIX, Solaris, NeXT, Darwin) the smallest quantum select() operates
      * on (sets/tests/clears bits) is 32 bits.  */
     growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
-#  else
-    growsize = sizeof(fd_set);
 #  endif
 
     sv = SP[4];
@@ -1051,12 +1093,23 @@ PP(pp_sselect)
 #endif
     }
 
+#ifdef PERL_IRIX5_SELECT_TIMEVAL_VOID_CAST
+    /* Can't make just the (void*) conditional because that would be
+     * cpp #if within cpp macro, and not all compilers like that. */
+    nfound = PerlSock_select(
+	maxlen * 8,
+	(Select_fd_set_t) fd_sets[1],
+	(Select_fd_set_t) fd_sets[2],
+	(Select_fd_set_t) fd_sets[3],
+	(void*) tbuf); /* Workaround for compiler bug. */
+#else
     nfound = PerlSock_select(
 	maxlen * 8,
 	(Select_fd_set_t) fd_sets[1],
 	(Select_fd_set_t) fd_sets[2],
 	(Select_fd_set_t) fd_sets[3],
 	tbuf);
+#endif
     for (i = 1; i <= 3; i++) {
 	if (fd_sets[i]) {
 	    sv = SP[i];
@@ -1160,6 +1213,7 @@ PP(pp_getc)
 	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)
 		&& (!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY)))
 	    report_evil_fh(gv, io, PL_op->op_type);
+	SETERRNO(EBADF,RMS_IFI);
 	RETPUSHUNDEF;
     }
     TAINT;
@@ -1189,8 +1243,6 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 {
     register PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
-    AV* padlist = CvPADLIST(cv);
-    SV** svp = AvARRAY(padlist);
 
     ENTER;
     SAVETMPS;
@@ -1198,8 +1250,7 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
     push_return(retop);
     PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
     PUSHFORMAT(cx);
-    SAVEVPTR(PL_curpad);
-    PL_curpad = AvARRAY((AV*)svp[1]);
+    PAD_SET_CUR(CvPADLIST(cv), 1);
 
     setdefout(gv);	    /* locally select filehandle so $% et al work */
     return CvSTART(cv);
@@ -1276,7 +1327,7 @@ PP(pp_leavewrite)
 	    if (!IoTOP_NAME(io)) {
 		if (!IoFMT_NAME(io))
 		    IoFMT_NAME(io) = savepv(GvNAME(gv));
-		topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", IoFMT_NAME(io)));
+		topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv)));
 		topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM);
 		if ((topgv && GvFORM(topgv)) ||
 		  !gv_fetchpv("top",FALSE,SVt_PVFM))
@@ -1348,21 +1399,8 @@ PP(pp_leavewrite)
     fp = IoOFP(io);
     if (!fp) {
 	if (ckWARN2(WARN_CLOSED,WARN_IO)) {
-	    if (IoIFP(io)) {
-		/* integrate with report_evil_fh()? */
-	        char *name = NULL;
-		if (isGV(gv)) {
-		    SV* sv = sv_newmortal();
-		    gv_efullname4(sv, gv, Nullch, FALSE);
-		    name = SvPV_nolen(sv);
-		}
-		if (name && *name)
-		    Perl_warner(aTHX_ WARN_IO,
-				"Filehandle %s opened only for input", name);
-		else
-		    Perl_warner(aTHX_ WARN_IO,
-				"Filehandle opened only for input");
-	    }
+	    if (IoIFP(io))
+		report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
 	    else if (ckWARN(WARN_CLOSED))
 		report_evil_fh(gv, io, PL_op->op_type);
 	}
@@ -1371,7 +1409,7 @@ PP(pp_leavewrite)
     else {
 	if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
 	    if (ckWARN(WARN_IO))
-		Perl_warner(aTHX_ WARN_IO, "page overflow");
+		Perl_warner(aTHX_ packWARN(WARN_IO), "page overflow");
 	}
 	if (!do_print(PL_formtarget, fp))
 	    PUSHs(&PL_sv_no);
@@ -1430,29 +1468,17 @@ PP(pp_prtf)
     if (!(io = GvIO(gv))) {
 	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
 	    report_evil_fh(gv, io, PL_op->op_type);
-	SETERRNO(EBADF,RMS$_IFI);
+	SETERRNO(EBADF,RMS_IFI);
 	goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
 	if (ckWARN2(WARN_CLOSED,WARN_IO))  {
-	    /* integrate with report_evil_fh()? */
-	    if (IoIFP(io)) {
-	        char *name = NULL;
-		if (isGV(gv)) {
-		    gv_efullname4(sv, gv, Nullch, FALSE);
-		    name = SvPV_nolen(sv);
-		}
-		if (name && *name)
-		    Perl_warner(aTHX_ WARN_IO,
-				"Filehandle %s opened only for input", name);
-		else
-		    Perl_warner(aTHX_ WARN_IO,
-				"Filehandle opened only for input");
-	    }
+	    if (IoIFP(io))
+		report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
 	    else if (ckWARN(WARN_CLOSED))
 		report_evil_fh(gv, io, PL_op->op_type);
 	}
-	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
+	SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI);
 	goto just_say_no;
     }
     else {
@@ -1557,11 +1583,15 @@ PP(pp_sysread)
     else
 	offset = 0;
     io = GvIO(gv);
-    if (!io || !IoIFP(io))
+    if (!io || !IoIFP(io)) {
+	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	    report_evil_fh(gv, io, PL_op->op_type);
+	SETERRNO(EBADF,RMS_IFI);
 	goto say_undef;
+    }
     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
 	buffer = SvPVutf8_force(bufsv, blen);
-	/* UTF8 may not have been set if they are all low bytes */
+	/* UTF-8 may not have been set if they are all low bytes */
 	SvUTF8_on(bufsv);
     }
     else {
@@ -1578,7 +1608,7 @@ PP(pp_sysread)
 #ifdef HAS_SOCKET
     if (PL_op->op_type == OP_RECV) {
 	char namebuf[MAXPATHLEN];
-#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE)
+#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE) || defined(__QNXNTO__)
 	bufsize = sizeof (struct sockaddr_in);
 #else
 	bufsize = sizeof namebuf;
@@ -1587,7 +1617,7 @@ PP(pp_sysread)
 	if (bufsize >= 256)
 	    bufsize = 255;
 #endif
-	buffer = SvGROW(bufsv, length+1);
+	buffer = SvGROW(bufsv, (STRLEN)(length+1));
 	/* 'offset' means 'flags' here */
 	count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
 			  (struct sockaddr *)namebuf, &bufsize);
@@ -1620,7 +1650,7 @@ PP(pp_sysread)
 	blen = sv_len_utf8(bufsv);
     }
     if (offset < 0) {
-	if (-offset > blen)
+	if (-offset > (int)blen)
 	    DIE(aTHX_ "Offset outside string");
 	offset += blen;
     }
@@ -1630,7 +1660,7 @@ PP(pp_sysread)
     }
  more_bytes:
     bufsize = SvCUR(bufsv);
-    buffer  = SvGROW(bufsv, length+offset+1);
+    buffer  = SvGROW(bufsv, (STRLEN)(length+offset+1));
     if (offset > bufsize) { /* Zero any newly allocated space */
     	Zero(buffer+bufsize, offset-bufsize, char);
     }
@@ -1671,21 +1701,7 @@ PP(pp_sysread)
     }
     if (count < 0) {
 	if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO))
-	{
-	    /* integrate with report_evil_fh()? */
-	    char *name = NULL;
-	    if (isGV(gv)) {
-		SV* sv = sv_newmortal();
-		gv_efullname4(sv, gv, Nullch, FALSE);
-		name = SvPV_nolen(sv);
-	    }
-	    if (name && *name)
-		Perl_warner(aTHX_ WARN_IO,
-			    "Filehandle %s opened only for output", name);
-	    else
-		Perl_warner(aTHX_ WARN_IO,
-			    "Filehandle opened only for output");
-	}
+		report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY);
 	goto say_undef;
     }
     SvCUR_set(bufsv, count+(buffer - SvPVX(bufsv)));
@@ -1799,16 +1815,24 @@ PP(pp_send)
 	retval = -1;
 	if (ckWARN(WARN_CLOSED))
 	    report_evil_fh(gv, io, PL_op->op_type);
+	SETERRNO(EBADF,RMS_IFI);
 	goto say_undef;
     }
 
     if (PerlIO_isutf8(IoIFP(io))) {
-	buffer = SvPVutf8(bufsv, blen);
+	if (!SvUTF8(bufsv)) {
+	    bufsv = sv_2mortal(newSVsv(bufsv));
+	    buffer = sv_2pvutf8(bufsv, &blen);
+	} else
+	    buffer = SvPV(bufsv, blen);
     }
     else {
-	if (DO_UTF8(bufsv))
-	    sv_utf8_downgrade(bufsv, FALSE);
-	buffer = SvPV(bufsv, blen);
+	 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(bufsv, blen);
     }
 
     if (PL_op->op_type == OP_SYSWRITE) {
@@ -1820,10 +1844,10 @@ PP(pp_send)
 	if (MARK < SP) {
 	    offset = SvIVx(*++MARK);
 	    if (offset < 0) {
-		if (-offset > blen)
+		if (-offset > (IV)blen)
 		    DIE(aTHX_ "Offset outside string");
 		offset += blen;
-	    } else if (offset >= blen && blen > 0)
+	    } else if (offset >= (IV)blen && blen > 0)
 		DIE(aTHX_ "Offset outside string");
 	} else
 	    offset = 0;
@@ -2036,7 +2060,7 @@ PP(pp_truncate)
     /* XXX Configure probe for the length type of *truncate() needed XXX */
     Off_t len;
 
-#if Size_t_size > IVSIZE
+#if Off_t_size > IVSIZE
     len = (Off_t)POPn;
 #else
     len = (Off_t)POPi;
@@ -2050,22 +2074,31 @@ PP(pp_truncate)
         STRLEN n_a;
 	int result = 1;
 	GV *tmpgv;
-	
+	IO *io;
+
 	if (PL_op->op_flags & OPf_SPECIAL) {
 	    tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
 
-	do_ftruncate:
-	    TAINT_PROPER("truncate");
-	    if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)))
-	        result = 0;
+	do_ftruncate_gv:
+	    if (!GvIO(tmpgv))
+		result = 0;
 	    else {
-	        PerlIO_flush(IoIFP(GvIOp(tmpgv)));
+		PerlIO *fp;
+		io = GvIOp(tmpgv);
+	    do_ftruncate_io:
+		TAINT_PROPER("truncate");
+		if (!(fp = IoIFP(io))) {
+		    result = 0;
+		}
+		else {
+		    PerlIO_flush(fp);
 #ifdef HAS_TRUNCATE
-		if (ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+		    if (ftruncate(PerlIO_fileno(fp), len) < 0)
 #else
-		if (my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+		    if (my_chsize(PerlIO_fileno(fp), len) < 0)
 #endif
-		    result = 0;
+			result = 0;
+		}
 	    }
 	}
 	else {
@@ -2074,11 +2107,15 @@ PP(pp_truncate)
 	
 	    if (SvTYPE(sv) == SVt_PVGV) {
 	        tmpgv = (GV*)sv;		/* *main::FRED for example */
-		goto do_ftruncate;
+		goto do_ftruncate_gv;
 	    }
 	    else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
 	        tmpgv = (GV*) SvRV(sv);	/* \*main::FRED for example */
-		goto do_ftruncate;
+		goto do_ftruncate_gv;
+	    }
+	    else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
+		io = (IO*) SvRV(sv); /* *main::FRED{IO} for example */
+		goto do_ftruncate_io;
 	    }
 
 	    name = SvPV(sv, n_a);
@@ -2104,7 +2141,7 @@ PP(pp_truncate)
 	if (result)
 	    RETPUSHYES;
 	if (!errno)
-	    SETERRNO(EBADF,RMS$_IFI);
+	    SETERRNO(EBADF,RMS_IFI);
 	RETPUSHUNDEF;
     }
 #else
@@ -2131,7 +2168,7 @@ PP(pp_ioctl)
     if (!io || !argsv || !IoIFP(io)) {
 	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
 	    report_evil_fh(gv, io, PL_op->op_type);
-	SETERRNO(EBADF,RMS$_IFI);	/* well, sort of... */
+	SETERRNO(EBADF,RMS_IFI);	/* well, sort of... */
 	RETPUSHUNDEF;
     }
 
@@ -2161,16 +2198,17 @@ PP(pp_ioctl)
 	DIE(aTHX_ "ioctl is not implemented");
 #endif
     else
-#ifdef HAS_FCNTL
+#ifndef HAS_FCNTL
+      DIE(aTHX_ "fcntl is not implemented");
+#else
 #if defined(OS2) && defined(__EMX__)
 	retval = fcntl(PerlIO_fileno(IoIFP(io)), func, (int)s);
 #else
 	retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
 #endif
-#else
-	DIE(aTHX_ "fcntl is not implemented");
 #endif
 
+#if defined(HAS_IOCTL) || defined(HAS_FCNTL)
     if (SvPOK(argsv)) {
 	if (s[SvCUR(argsv)] != 17)
 	    DIE(aTHX_ "Possible memory corruption: %s overflowed 3rd argument",
@@ -2187,6 +2225,7 @@ PP(pp_ioctl)
     else {
 	PUSHp(zero_but_true, ZBTLEN);
     }
+#endif
     RETURN;
 }
 
@@ -2219,7 +2258,7 @@ PP(pp_flock)
 	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
 	    report_evil_fh(gv, io, PL_op->op_type);
 	value = 0;
-	SETERRNO(EBADF,RMS$_IFI);
+	SETERRNO(EBADF,RMS_IFI);
     }
     PUSHi(value);
     RETURN;
@@ -2249,7 +2288,7 @@ PP(pp_socket)
 	    report_evil_fh(gv, io, PL_op->op_type);
 	if (IoIFP(io))
 	    do_close(gv, FALSE);
-	SETERRNO(EBADF,LIB$_INVARG);
+	SETERRNO(EBADF,LIB_INVARG);
 	RETPUSHUNDEF;
     }
 
@@ -2260,8 +2299,8 @@ PP(pp_socket)
     fd = PerlSock_socket(domain, type, protocol);
     if (fd < 0)
 	RETPUSHUNDEF;
-    IoIFP(io) = PerlIO_fdopen(fd, "r");	/* stdio gets confused about sockets */
-    IoOFP(io) = PerlIO_fdopen(fd, "w");
+    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));
@@ -2322,11 +2361,11 @@ PP(pp_sockpair)
     TAINT_PROPER("socketpair");
     if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
 	RETPUSHUNDEF;
-    IoIFP(io1) = PerlIO_fdopen(fd[0], "r");
-    IoOFP(io1) = PerlIO_fdopen(fd[0], "w");
+    IoIFP(io1) = PerlIO_fdopen(fd[0], "r"SOCKET_OPEN_MODE);
+    IoOFP(io1) = PerlIO_fdopen(fd[0], "w"SOCKET_OPEN_MODE);
     IoTYPE(io1) = IoTYPE_SOCKET;
-    IoIFP(io2) = PerlIO_fdopen(fd[1], "r");
-    IoOFP(io2) = PerlIO_fdopen(fd[1], "w");
+    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));
@@ -2400,7 +2439,7 @@ PP(pp_bind)
 nuts:
     if (ckWARN(WARN_CLOSED))
 	report_evil_fh(gv, io, PL_op->op_type);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "bind");
@@ -2430,7 +2469,7 @@ PP(pp_connect)
 nuts:
     if (ckWARN(WARN_CLOSED))
 	report_evil_fh(gv, io, PL_op->op_type);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "connect");
@@ -2456,7 +2495,7 @@ PP(pp_listen)
 nuts:
     if (ckWARN(WARN_CLOSED))
 	report_evil_fh(gv, io, PL_op->op_type);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "listen");
@@ -2471,10 +2510,13 @@ PP(pp_accept)
     GV *ggv;
     register IO *nstio;
     register IO *gstio;
-    struct sockaddr saddr;	/* use a struct to avoid alignment problems */
-    Sock_size_t len = sizeof saddr;
+    char namebuf[MAXPATHLEN];
+#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE) || defined(__QNXNTO__)
+    Sock_size_t len = sizeof (struct sockaddr_in);
+#else
+    Sock_size_t len = sizeof namebuf;
+#endif
     int fd;
-    int fd2;
 
     ggv = (GV*)POPs;
     ngv = (GV*)POPs;
@@ -2489,17 +2531,13 @@ PP(pp_accept)
 	goto nuts;
 
     nstio = GvIOn(ngv);
-    fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
+    fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len);
     if (fd < 0)
 	goto badexit;
     if (IoIFP(nstio))
 	do_close(ngv, FALSE);
-    IoIFP(nstio) = PerlIO_fdopen(fd, "r");
-    /* FIXME: we dup(fd) here so that refcounting of fd's does not inhibit
-       fclose of IoOFP's FILE * - and hence leak memory.
-       Special treatment of _this_ case of IoIFP != IoOFP seems wrong.
-     */
-    IoOFP(nstio) = PerlIO_fdopen(fd2 = PerlLIO_dup(fd), "w");
+    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));
@@ -2509,21 +2547,23 @@ PP(pp_accept)
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     fcntl(fd, F_SETFD, fd > PL_maxsysfd);	/* ensure close-on-exec */
-    fcntl(fd2, F_SETFD, fd2 > PL_maxsysfd);	/* ensure close-on-exec */
 #endif
 
 #ifdef EPOC
-    len = sizeof saddr;          /* EPOC somehow truncates info */
+    len = sizeof (struct sockaddr_in); /* EPOC somehow truncates info */
     setbuf( IoIFP(nstio), NULL); /* EPOC gets confused about sockets */
 #endif
+#ifdef __SCO_VERSION__
+    len = sizeof (struct sockaddr_in); /* OpenUNIX 8 somehow truncates info */
+#endif
 
-    PUSHp((char *)&saddr, len);
+    PUSHp(namebuf, len);
     RETURN;
 
 nuts:
     if (ckWARN(WARN_CLOSED))
 	report_evil_fh(ggv, ggv ? GvIO(ggv) : 0, PL_op->op_type);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
 
 badexit:
     RETPUSHUNDEF;
@@ -2550,7 +2590,7 @@ PP(pp_shutdown)
 nuts:
     if (ckWARN(WARN_CLOSED))
 	report_evil_fh(gv, io, PL_op->op_type);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_sock_func, "shutdown");
@@ -2629,7 +2669,7 @@ PP(pp_ssockopt)
 nuts:
     if (ckWARN(WARN_CLOSED))
 	report_evil_fh(gv, io, optype);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
 
@@ -2702,7 +2742,7 @@ PP(pp_getpeername)
 nuts:
     if (ckWARN(WARN_CLOSED))
 	report_evil_fh(gv, io, optype);
-    SETERRNO(EBADF,SS$_IVCHAN);
+    SETERRNO(EBADF,SS_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
 
@@ -2731,7 +2771,7 @@ PP(pp_stat)
 	if (PL_op->op_type == OP_LSTAT) {
 	    if (gv != PL_defgv) {
 		if (ckWARN(WARN_IO))
-		    Perl_warner(aTHX_ WARN_IO,
+		    Perl_warner(aTHX_ packWARN(WARN_IO),
 			"lstat() on filehandle %s", GvENAME(gv));
 	    } else if (PL_laststype != OP_LSTAT)
 		Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
@@ -2760,7 +2800,7 @@ PP(pp_stat)
 	else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
 	    gv = (GV*)SvRV(sv);
 	    if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO))
-		Perl_warner(aTHX_ WARN_IO,
+		Perl_warner(aTHX_ packWARN(WARN_IO),
 			"lstat() on filehandle %s", GvENAME(gv));
 	    goto do_fstat;
 	}
@@ -2775,7 +2815,7 @@ PP(pp_stat)
 	    PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
 	if (PL_laststatval < 0) {
 	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
-		Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "stat");
+		Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
 	    max = 0;
 	}
     }
@@ -2817,7 +2857,7 @@ PP(pp_stat)
 	PUSHs(sv_2mortal(newSVpvn("", 0)));
 #endif
 #if Off_t_size > IVSIZE
-	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_size)));
+	PUSHs(sv_2mortal(newSVnv((NV)PL_statcache.st_size)));
 #else
 	PUSHs(sv_2mortal(newSViv(PL_statcache.st_size)));
 #endif
@@ -2841,14 +2881,24 @@ PP(pp_stat)
     RETURN;
 }
 
+/* This macro is used by the stacked filetest operators :
+ * if the previous filetest failed, short-circuit and pass its value.
+ * Else, discard it from the stack and continue. --rgs
+ */
+#define STACKED_FTEST_CHECK if (PL_op->op_private & OPpFT_STACKED) { \
+	if (TOPs == &PL_sv_no || TOPs == &PL_sv_undef) { RETURN; } \
+	else { (void)POPs; PUTBACK; } \
+    }
+
 PP(pp_ftrread)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #if defined(HAS_ACCESS) && defined(R_OK)
-    STRLEN n_a;
-    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
-	result = access(TOPpx, R_OK);
+    if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+	STRLEN n_a;
+	result = access(POPpx, R_OK);
 	if (result == 0)
 	    RETPUSHYES;
 	if (result < 0)
@@ -2872,10 +2922,11 @@ PP(pp_ftrwrite)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #if defined(HAS_ACCESS) && defined(W_OK)
-    STRLEN n_a;
-    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
-	result = access(TOPpx, W_OK);
+    if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+	STRLEN n_a;
+	result = access(POPpx, W_OK);
 	if (result == 0)
 	    RETPUSHYES;
 	if (result < 0)
@@ -2899,10 +2950,11 @@ PP(pp_ftrexec)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #if defined(HAS_ACCESS) && defined(X_OK)
-    STRLEN n_a;
-    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
-	result = access(TOPpx, X_OK);
+    if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+	STRLEN n_a;
+	result = access(POPpx, X_OK);
 	if (result == 0)
 	    RETPUSHYES;
 	if (result < 0)
@@ -2926,10 +2978,11 @@ PP(pp_fteread)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #ifdef PERL_EFF_ACCESS_R_OK
-    STRLEN n_a;
-    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
-	result = PERL_EFF_ACCESS_R_OK(TOPpx);
+    if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+	STRLEN n_a;
+	result = PERL_EFF_ACCESS_R_OK(POPpx);
 	if (result == 0)
 	    RETPUSHYES;
 	if (result < 0)
@@ -2953,10 +3006,11 @@ PP(pp_ftewrite)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #ifdef PERL_EFF_ACCESS_W_OK
-    STRLEN n_a;
-    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
-	result = PERL_EFF_ACCESS_W_OK(TOPpx);
+    if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+	STRLEN n_a;
+	result = PERL_EFF_ACCESS_W_OK(POPpx);
 	if (result == 0)
 	    RETPUSHYES;
 	if (result < 0)
@@ -2980,10 +3034,11 @@ PP(pp_fteexec)
 {
     I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
 #ifdef PERL_EFF_ACCESS_X_OK
-    STRLEN n_a;
-    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
-	result = PERL_EFF_ACCESS_X_OK(TOPpx);
+    if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
+	STRLEN n_a;
+	result = PERL_EFF_ACCESS_X_OK(POPpx);
 	if (result == 0)
 	    RETPUSHYES;
 	if (result < 0)
@@ -3005,8 +3060,11 @@ PP(pp_fteexec)
 
 PP(pp_ftis)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
     RETPUSHYES;
@@ -3019,8 +3077,11 @@ PP(pp_fteowned)
 
 PP(pp_ftrowned)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
     if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ?
@@ -3031,8 +3092,11 @@ PP(pp_ftrowned)
 
 PP(pp_ftzero)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
     if (PL_statcache.st_size == 0)
@@ -3042,8 +3106,11 @@ PP(pp_ftzero)
 
 PP(pp_ftsize)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP; dTARGET;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
 #if Off_t_size > IVSIZE
@@ -3056,38 +3123,50 @@ PP(pp_ftsize)
 
 PP(pp_ftmtime)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP; dTARGET;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( (PL_basetime - PL_statcache.st_mtime) / 86400.0 );
+    PUSHn( (((NV)PL_basetime - PL_statcache.st_mtime)) / 86400.0 );
     RETURN;
 }
 
 PP(pp_ftatime)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP; dTARGET;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( (PL_basetime - PL_statcache.st_atime) / 86400.0 );
+    PUSHn( (((NV)PL_basetime - PL_statcache.st_atime)) / 86400.0 );
     RETURN;
 }
 
 PP(pp_ftctime)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP; dTARGET;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( (PL_basetime - PL_statcache.st_ctime) / 86400.0 );
+    PUSHn( (((NV)PL_basetime - PL_statcache.st_ctime)) / 86400.0 );
     RETURN;
 }
 
 PP(pp_ftsock)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISSOCK(PL_statcache.st_mode))
@@ -3097,8 +3176,11 @@ PP(pp_ftsock)
 
 PP(pp_ftchr)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISCHR(PL_statcache.st_mode))
@@ -3108,8 +3190,11 @@ PP(pp_ftchr)
 
 PP(pp_ftblk)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISBLK(PL_statcache.st_mode))
@@ -3119,8 +3204,11 @@ PP(pp_ftblk)
 
 PP(pp_ftfile)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISREG(PL_statcache.st_mode))
@@ -3130,8 +3218,11 @@ PP(pp_ftfile)
 
 PP(pp_ftdir)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISDIR(PL_statcache.st_mode))
@@ -3141,8 +3232,11 @@ PP(pp_ftdir)
 
 PP(pp_ftpipe)
 {
-    I32 result = my_stat();
+    I32 result;
     dSP;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISFIFO(PL_statcache.st_mode))
@@ -3165,7 +3259,9 @@ PP(pp_ftsuid)
 {
     dSP;
 #ifdef S_ISUID
-    I32 result = my_stat();
+    I32 result;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
     SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
@@ -3179,7 +3275,9 @@ PP(pp_ftsgid)
 {
     dSP;
 #ifdef S_ISGID
-    I32 result = my_stat();
+    I32 result;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
     SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
@@ -3193,7 +3291,9 @@ PP(pp_ftsvtx)
 {
     dSP;
 #ifdef S_ISVTX
-    I32 result = my_stat();
+    I32 result;
+    STACKED_FTEST_CHECK;
+    result = my_stat();
     SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
@@ -3211,6 +3311,8 @@ PP(pp_fttty)
     char *tmps = Nullch;
     STRLEN n_a;
 
+    STACKED_FTEST_CHECK;
+
     if (PL_op->op_flags & OPf_REF)
 	gv = cGVOP_gv;
     else if (isGV(TOPs))
@@ -3253,6 +3355,8 @@ PP(pp_fttext)
     STRLEN n_a;
     PerlIO *fp;
 
+    STACKED_FTEST_CHECK;
+
     if (PL_op->op_flags & OPf_REF)
 	gv = cGVOP_gv;
     else if (isGV(TOPs))
@@ -3308,7 +3412,7 @@ PP(pp_fttext)
 		gv = cGVOP_gv;
 		report_evil_fh(gv, GvIO(gv), PL_op->op_type);
 	    }
-	    SETERRNO(EBADF,RMS$_IFI);
+	    SETERRNO(EBADF,RMS_IFI);
 	    RETPUSHUNDEF;
 	}
     }
@@ -3320,8 +3424,8 @@ PP(pp_fttext)
 	PL_laststype = OP_STAT;
 	sv_setpv(PL_statname, SvPV(sv, n_a));
 	if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) {
-	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
-		Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
+	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
+		Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
 	    RETPUSHUNDEF;
 	}
 	PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
@@ -3422,7 +3526,7 @@ PP(pp_chdir)
            )
         {
             if( MAXARG == 1 )
-                deprecate_old("chdir('') or chdir(undef) as chdir()");
+                deprecate("chdir('') or chdir(undef) as chdir()");
             tmps = SvPV(*svp, n_a);
         }
         else {
@@ -3637,21 +3741,21 @@ S_dooneliner(pTHX_ char *cmd, char *filename)
 #define EACCES EPERM
 #endif
 	    if (instr(s, "cannot make"))
-		SETERRNO(EEXIST,RMS$_FEX);
+		SETERRNO(EEXIST,RMS_FEX);
 	    else if (instr(s, "existing file"))
-		SETERRNO(EEXIST,RMS$_FEX);
+		SETERRNO(EEXIST,RMS_FEX);
 	    else if (instr(s, "ile exists"))
-		SETERRNO(EEXIST,RMS$_FEX);
+		SETERRNO(EEXIST,RMS_FEX);
 	    else if (instr(s, "non-exist"))
-		SETERRNO(ENOENT,RMS$_FNF);
+		SETERRNO(ENOENT,RMS_FNF);
 	    else if (instr(s, "does not exist"))
-		SETERRNO(ENOENT,RMS$_FNF);
+		SETERRNO(ENOENT,RMS_FNF);
 	    else if (instr(s, "not empty"))
-		SETERRNO(EBUSY,SS$_DEVOFFLINE);
+		SETERRNO(EBUSY,SS_DEVOFFLINE);
 	    else if (instr(s, "cannot access"))
-		SETERRNO(EACCES,RMS$_PRV);
+		SETERRNO(EACCES,RMS_PRV);
 	    else
-		SETERRNO(EPERM,RMS$_PRV);
+		SETERRNO(EPERM,RMS_PRV);
 	    return 0;
 	}
 	else {	/* some mkdirs return no failure indication */
@@ -3661,7 +3765,7 @@ S_dooneliner(pTHX_ char *cmd, char *filename)
 	    if (anum)
 		SETERRNO(0,0);
 	    else
-		SETERRNO(EACCES,RMS$_PRV);	/* a guess */
+		SETERRNO(EACCES,RMS_PRV);	/* a guess */
 	}
 	return anum;
     }
@@ -3670,6 +3774,26 @@ S_dooneliner(pTHX_ char *cmd, char *filename)
 }
 #endif
 
+/* This macro removes trailing slashes from a directory name.
+ * Different operating and file systems take differently to
+ * trailing slashes.  According to POSIX 1003.1 1996 Edition
+ * any number of trailing slashes should be allowed.
+ * Thusly we snip them away so that even non-conforming
+ * systems are happy.
+ * We should probably do this "filtering" for all
+ * the functions that expect (potentially) directory names:
+ * -d, chdir(), chmod(), chown(), chroot(), fcntl()?,
+ * (mkdir()), opendir(), rename(), rmdir(), stat(). --jhi */
+
+#define TRIMSLASHES(tmps,len,copy) (tmps) = SvPV(TOPs, (len)); \
+    if ((len) > 1 && (tmps)[(len)-1] == '/') { \
+	do { \
+	    (len)--; \
+	} while ((len) > 1 && (tmps)[(len)-1] == '/'); \
+	(tmps) = savepvn((tmps), (len)); \
+	(copy) = TRUE; \
+    }
+
 PP(pp_mkdir)
 {
     dSP; dTARGET;
@@ -3686,22 +3810,7 @@ PP(pp_mkdir)
     else
 	mode = 0777;
 
-    tmps = SvPV(TOPs, len);
-    /* Different operating and file systems take differently to
-     * trailing slashes.  According to POSIX 1003.1 1996 Edition
-     * any number of trailing slashes should be allowed.
-     * Thusly we snip them away so that even non-conforming
-     * systems are happy. */
-    /* We should probably do this "filtering" for all
-     * the functions that expect (potentially) directory names:
-     * -d, chdir(), chmod(), chown(), chroot(), fcntl()?,
-     * (mkdir()), opendir(), rename(), rmdir(), stat(). --jhi */
-    if (len > 1 && tmps[len-1] == '/') {
-	while (tmps[len] == '/' && len > 1)
-	    len--;
-	tmps = savepvn(tmps, len);
-	copy = TRUE;
-    }
+    TRIMSLASHES(tmps,len,copy);
 
     TAINT_PROPER("mkdir");
 #ifdef HAS_MKDIR
@@ -3720,16 +3829,19 @@ PP(pp_mkdir)
 PP(pp_rmdir)
 {
     dSP; dTARGET;
+    STRLEN len;
     char *tmps;
-    STRLEN n_a;
+    bool copy = FALSE;
 
-    tmps = POPpx;
+    TRIMSLASHES(tmps,len,copy);
     TAINT_PROPER("rmdir");
 #ifdef HAS_RMDIR
-    XPUSHi( PerlDir_rmdir(tmps) >= 0 );
+    SETi( PerlDir_rmdir(tmps) >= 0 );
 #else
-    XPUSHi( dooneliner("rmdir", tmps) );
+    SETi( dooneliner("rmdir", tmps) );
 #endif
+    if (copy)
+	Safefree(tmps);
     RETURN;
 }
 
@@ -3755,7 +3867,7 @@ PP(pp_open_dir)
     RETPUSHYES;
 nope:
     if (!errno)
-	SETERRNO(EBADF,RMS$_DIR);
+	SETERRNO(EBADF,RMS_DIR);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "opendir");
@@ -3764,59 +3876,52 @@ nope:
 
 PP(pp_readdir)
 {
-#if defined(Direntry_t) && defined(HAS_READDIR)
-    dSP;
+#if !defined(Direntry_t) || !defined(HAS_READDIR)
+    DIE(aTHX_ PL_no_dir_func, "readdir");
+#else
 #if !defined(I_DIRENT) && !defined(VMS)
     Direntry_t *readdir (DIR *);
 #endif
+    dSP;
+
+    SV *sv;
+    I32 gimme = GIMME;
+    GV *gv = (GV *)POPs;
     register Direntry_t *dp;
-    GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
-    SV *sv;
 
     if (!io || !IoDIRP(io))
 	goto nope;
 
-    if (GIMME == G_ARRAY) {
-	/*SUPPRESS 560*/
-	while ((dp = (Direntry_t *)PerlDir_read(IoDIRP(io)))) {
-#ifdef DIRNAMLEN
-	    sv = newSVpvn(dp->d_name, dp->d_namlen);
-#else
-	    sv = newSVpv(dp->d_name, 0);
-#endif
-#ifndef INCOMPLETE_TAINTS
-	    if (!(IoFLAGS(io) & IOf_UNTAINT))
-		SvTAINTED_on(sv);
-#endif
-	    XPUSHs(sv_2mortal(sv));
-	}
-    }
-    else {
-	if (!(dp = (Direntry_t *)PerlDir_read(IoDIRP(io))))
-	    goto nope;
+    do {
+        dp = (Direntry_t *)PerlDir_read(IoDIRP(io));
+        if (!dp)
+            break;
 #ifdef DIRNAMLEN
-	sv = newSVpvn(dp->d_name, dp->d_namlen);
+        sv = newSVpvn(dp->d_name, dp->d_namlen);
 #else
-	sv = newSVpv(dp->d_name, 0);
+        sv = newSVpv(dp->d_name, 0);
 #endif
 #ifndef INCOMPLETE_TAINTS
-	if (!(IoFLAGS(io) & IOf_UNTAINT))
-	    SvTAINTED_on(sv);
+        if (!(IoFLAGS(io) & IOf_UNTAINT))
+            SvTAINTED_on(sv);
 #endif
-	XPUSHs(sv_2mortal(sv));
+        XPUSHs(sv_2mortal(sv));
     }
+    while (gimme == G_ARRAY);
+
+    if (!dp && gimme != G_ARRAY)
+        goto nope;
+
     RETURN;
 
 nope:
     if (!errno)
-	SETERRNO(EBADF,RMS$_ISI);
+	SETERRNO(EBADF,RMS_ISI);
     if (GIMME == G_ARRAY)
 	RETURN;
     else
 	RETPUSHUNDEF;
-#else
-    DIE(aTHX_ PL_no_dir_func, "readdir");
 #endif
 }
 
@@ -3841,7 +3946,7 @@ PP(pp_telldir)
     RETURN;
 nope:
     if (!errno)
-	SETERRNO(EBADF,RMS$_ISI);
+	SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "telldir");
@@ -3864,7 +3969,7 @@ PP(pp_seekdir)
     RETPUSHYES;
 nope:
     if (!errno)
-	SETERRNO(EBADF,RMS$_ISI);
+	SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "seekdir");
@@ -3885,7 +3990,7 @@ PP(pp_rewinddir)
     RETPUSHYES;
 nope:
     if (!errno)
-	SETERRNO(EBADF,RMS$_ISI);
+	SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "rewinddir");
@@ -3915,7 +4020,7 @@ PP(pp_closedir)
     RETPUSHYES;
 nope:
     if (!errno)
-	SETERRNO(EBADF,RMS$_IFI);
+	SETERRNO(EBADF,RMS_IFI);
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_dir_func, "closedir");
@@ -3943,6 +4048,9 @@ PP(pp_fork)
 	    sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
             SvREADONLY_on(GvSV(tmpgv));
         }
+#ifdef THREADS_HAVE_PIDS
+	PL_ppid = (IV)getppid();
+#endif
 	hv_clear(PL_pidstatus);	/* no kids, so don't wait for 'em */
     }
     PUSHi(childpid);
@@ -3972,13 +4080,14 @@ PP(pp_wait)
     Pid_t childpid;
     int argflags;
 
-#ifdef PERL_OLD_SIGNALS
-    childpid = wait4pid(-1, &argflags, 0);
-#else
-    while ((childpid = wait4pid(-1, &argflags, 0)) == -1 && errno == EINTR) {
-	PERL_ASYNC_CHECK();
+    if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
+        childpid = wait4pid(-1, &argflags, 0);
+    else {
+        while ((childpid = wait4pid(-1, &argflags, 0)) == -1 &&
+	       errno == EINTR) {
+	  PERL_ASYNC_CHECK();
+	}
     }
-#endif
 #  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
     /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
     STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
@@ -3996,26 +4105,28 @@ PP(pp_waitpid)
 {
 #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
     dSP; dTARGET;
-    Pid_t childpid;
+    Pid_t pid;
+    Pid_t result;
     int optype;
     int argflags;
 
     optype = POPi;
-    childpid = TOPi;
-#ifdef PERL_OLD_SIGNALS
-    childpid = wait4pid(childpid, &argflags, optype);
-#else
-    while ((childpid = wait4pid(childpid, &argflags, optype)) == -1 && errno == EINTR) {
-	PERL_ASYNC_CHECK();
+    pid = TOPi;
+    if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
+        result = wait4pid(pid, &argflags, optype);
+    else {
+        while ((result = wait4pid(pid, &argflags, optype)) == -1 &&
+	       errno == EINTR) {
+	  PERL_ASYNC_CHECK();
+	}
     }
-#endif
 #  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
     /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
-    STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
+    STATUS_NATIVE_SET((result && result != -1) ? argflags : -1);
 #  else
-    STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+    STATUS_NATIVE_SET((result > 0) ? argflags : -1);
 #  endif
-    SETi(childpid);
+    SETi(result);
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "waitpid");
@@ -4028,114 +4139,117 @@ PP(pp_system)
     I32 value;
     STRLEN n_a;
     int result;
-    int pp[2];
     I32 did_pipes = 0;
 
     if (PL_tainting) {
 	TAINT_ENV();
 	while (++MARK <= SP) {
 	    (void)SvPV_nolen(*MARK);      /* stringify for taint check */
-	    if (PL_tainted) 
+	    if (PL_tainted)
 		break;
 	}
 	MARK = ORIGMARK;
-	/* XXX Remove warning at end of deprecation cycle --RD 2002-02  */
-	if (SP - MARK == 1) {
-	    TAINT_PROPER("system");
-	}
-	else if (ckWARN2(WARN_TAINT, WARN_DEPRECATED)) {
-	    Perl_warner(aTHX_ packWARN2(WARN_TAINT, WARN_DEPRECATED),
-		"Use of tainted arguments in %s is deprecated", "system");
-	}
+	TAINT_PROPER("system");
     }
     PERL_FLUSHALL_FOR_CHILD;
 #if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)
     {
-	 Pid_t childpid;
-	 int status;
-	 Sigsave_t ihand,qhand;     /* place to save signals during system() */
-
-	 if (PerlProc_pipe(pp) >= 0)
-	      did_pipes = 1;
-	 while ((childpid = PerlProc_fork()) == -1) {
-	      if (errno != EAGAIN) {
-		   value = -1;
-		   SP = ORIGMARK;
-		   PUSHi(value);
-		   if (did_pipes) {
-			PerlLIO_close(pp[0]);
-			PerlLIO_close(pp[1]);
-		   }
-		   RETURN;
-	      }
-	      sleep(5);
-	 }
-	 if (childpid > 0) {
-	      if (did_pipes)
-		   PerlLIO_close(pp[1]);
+	Pid_t childpid;
+	int pp[2];
+
+	if (PerlProc_pipe(pp) >= 0)
+	    did_pipes = 1;
+	while ((childpid = PerlProc_fork()) == -1) {
+	    if (errno != EAGAIN) {
+		value = -1;
+		SP = ORIGMARK;
+		PUSHi(value);
+		if (did_pipes) {
+		    PerlLIO_close(pp[0]);
+		    PerlLIO_close(pp[1]);
+		}
+		RETURN;
+	    }
+	    sleep(5);
+	}
+	if (childpid > 0) {
+	    Sigsave_t ihand,qhand; /* place to save signals during system() */
+	    int status;
+
+	    if (did_pipes)
+		PerlLIO_close(pp[1]);
 #ifndef PERL_MICRO
-	      rsignal_save(SIGINT, SIG_IGN, &ihand);
-	      rsignal_save(SIGQUIT, SIG_IGN, &qhand);
+	    rsignal_save(SIGINT, SIG_IGN, &ihand);
+	    rsignal_save(SIGQUIT, SIG_IGN, &qhand);
 #endif
-	      do {
-		   result = wait4pid(childpid, &status, 0);
-	      } while (result == -1 && errno == EINTR);
+	    do {
+		result = wait4pid(childpid, &status, 0);
+	    } while (result == -1 && errno == EINTR);
 #ifndef PERL_MICRO
-	      (void)rsignal_restore(SIGINT, &ihand);
-	      (void)rsignal_restore(SIGQUIT, &qhand);
-#endif
-	      STATUS_NATIVE_SET(result == -1 ? -1 : status);
-	      do_execfree();	/* free any memory child malloced on fork */
-	      SP = ORIGMARK;
-	      if (did_pipes) {
-		   int errkid;
-		   int n = 0, n1;
-		
-		   while (n < sizeof(int)) {
-			n1 = PerlLIO_read(pp[0],
-					  (void*)(((char*)&errkid)+n),
-					  (sizeof(int)) - n);
-			if (n1 <= 0)
-			     break;
-			n += n1;
-		   }
-		   PerlLIO_close(pp[0]);
-		   if (n) {			/* Error */
-			if (n != sizeof(int))
-			     DIE(aTHX_ "panic: kid popen errno read");
-			errno = errkid;		/* Propagate errno from kid */
-			STATUS_CURRENT = -1;
-		   }
-	      }
-	      PUSHi(STATUS_CURRENT);
-	      RETURN;
-	 }
-	 if (did_pipes) {
-	      PerlLIO_close(pp[0]);
+	    (void)rsignal_restore(SIGINT, &ihand);
+	    (void)rsignal_restore(SIGQUIT, &qhand);
+#endif
+	    STATUS_NATIVE_SET(result == -1 ? -1 : status);
+	    do_execfree();	/* free any memory child malloced on fork */
+	    SP = ORIGMARK;
+	    if (did_pipes) {
+		int errkid;
+		int n = 0, n1;
+
+		while (n < sizeof(int)) {
+		    n1 = PerlLIO_read(pp[0],
+				      (void*)(((char*)&errkid)+n),
+				      (sizeof(int)) - n);
+		    if (n1 <= 0)
+			break;
+		    n += n1;
+		}
+		PerlLIO_close(pp[0]);
+		if (n) {			/* Error */
+		    if (n != sizeof(int))
+			DIE(aTHX_ "panic: kid popen errno read");
+		    errno = errkid;		/* Propagate errno from kid */
+		    STATUS_CURRENT = -1;
+		}
+	    }
+	    PUSHi(STATUS_CURRENT);
+	    RETURN;
+	}
+	if (did_pipes) {
+	    PerlLIO_close(pp[0]);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-	      fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+	    fcntl(pp[1], F_SETFD, FD_CLOEXEC);
 #endif
-	 }
-    }
-    if (PL_op->op_flags & OPf_STACKED) {
-	SV *really = *++MARK;
-	value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
-    }
-    else if (SP - MARK != 1)
-	value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes);
-    else {
-	value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes);
+	}
+	if (PL_op->op_flags & OPf_STACKED) {
+	    SV *really = *++MARK;
+	    value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
+	}
+	else if (SP - MARK != 1)
+	    value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes);
+	else {
+	    value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes);
+	}
+	PerlProc__exit(-1);
     }
-    PerlProc__exit(-1);
 #else /* ! FORK or VMS or OS/2 */
     PL_statusvalue = 0;
     result = 0;
     if (PL_op->op_flags & OPf_STACKED) {
 	SV *really = *++MARK;
+#  if defined(WIN32) || defined(OS2)
+	value = (I32)do_aspawn(really, MARK, SP);
+#  else
 	value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
+#  endif
     }
-    else if (SP - MARK != 1)
+    else if (SP - MARK != 1) {
+#  if defined(WIN32) || defined(OS2)
+	value = (I32)do_aspawn(Nullsv, MARK, SP);
+#  else
 	value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
+#  endif
+    }
     else {
 	value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
     }
@@ -4159,18 +4273,11 @@ PP(pp_exec)
 	TAINT_ENV();
 	while (++MARK <= SP) {
 	    (void)SvPV_nolen(*MARK);      /* stringify for taint check */
-	    if (PL_tainted) 
+	    if (PL_tainted)
 		break;
 	}
 	MARK = ORIGMARK;
-	/* XXX Remove warning at end of deprecation cycle --RD 2002-02  */
-	if (SP - MARK == 1) {
-	    TAINT_PROPER("exec");
-	}
-	else if (ckWARN2(WARN_TAINT, WARN_DEPRECATED)) {
-	    Perl_warner(aTHX_ packWARN2(WARN_TAINT, WARN_DEPRECATED),
-		"Use of tainted arguments in %s is deprecated", "exec");
-	}
+	TAINT_PROPER("exec");
     }
     PERL_FLUSHALL_FOR_CHILD;
     if (PL_op->op_flags & OPf_STACKED) {
@@ -4226,7 +4333,11 @@ PP(pp_getppid)
 {
 #ifdef HAS_GETPPID
     dSP; dTARGET;
+#   ifdef THREADS_HAVE_PIDS
+    XPUSHi( PL_ppid );
+#   else
     XPUSHi( getppid() );
+#   endif
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getppid");
@@ -4331,26 +4442,6 @@ PP(pp_time)
     RETURN;
 }
 
-/* XXX The POSIX name is CLK_TCK; it is to be preferred
-   to HZ.  Probably.  For now, assume that if the system
-   defines HZ, it does so correctly.  (Will this break
-   on VMS?)
-   Probably we ought to use _sysconf(_SC_CLK_TCK), if
-   it's supported.    --AD  9/96.
-*/
-
-#ifdef __BEOS__
-#  define HZ 1000000
-#endif
-
-#ifndef HZ
-#  ifdef CLK_TCK
-#    define HZ CLK_TCK
-#  else
-#    define HZ 60
-#  endif
-#endif
-
 PP(pp_tms)
 {
 #ifdef HAS_TIMES
@@ -4364,15 +4455,27 @@ PP(pp_tms)
                                                    /* is returned.                   */
 #endif
 
-    PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_utime)/HZ)));
+    PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_utime)/(NV)PL_clocktick)));
     if (GIMME == G_ARRAY) {
-	PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_stime)/HZ)));
-	PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cutime)/HZ)));
-	PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cstime)/HZ)));
+	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)));
     }
     RETURN;
 #else
+#   ifdef PERL_MICRO
+    dSP;
+    PUSHs(sv_2mortal(newSVnv((NV)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)));
+    }
+    RETURN;
+#   else
     DIE(aTHX_ "times not implemented");
+#   endif
 #endif /* HAS_TIMES */
 }
 
@@ -4618,21 +4721,23 @@ PP(pp_ghostent)
     register char **elem;
     register SV *sv;
 #ifndef HAS_GETHOST_PROTOS /* XXX Do we need individual probes? */
-    struct hostent *PerlSock_gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int);
-    struct hostent *PerlSock_gethostbyname(Netdb_name_t);
-    struct hostent *PerlSock_gethostent(void);
+    struct hostent *gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int);
+    struct hostent *gethostbyname(Netdb_name_t);
+    struct hostent *gethostent(void);
 #endif
     struct hostent *hent;
     unsigned long len;
     STRLEN n_a;
 
     EXTEND(SP, 10);
-    if (which == OP_GHBYNAME)
+    if (which == OP_GHBYNAME) {
 #ifdef HAS_GETHOSTBYNAME
-	hent = PerlSock_gethostbyname(POPpbytex);
+        char* name = POPpbytex;
+	hent = PerlSock_gethostbyname(name);
 #else
 	DIE(aTHX_ PL_no_sock_func, "gethostbyname");
 #endif
+    }
     else if (which == OP_GHBYADDR) {
 #ifdef HAS_GETHOSTBYADDR
 	int addrtype = POPi;
@@ -4653,8 +4758,14 @@ PP(pp_ghostent)
 #endif
 
 #ifdef HOST_NOT_FOUND
-    if (!hent)
-	STATUS_NATIVE_SET(h_errno);
+	if (!hent) {
+#ifdef USE_REENTRANT_API
+#   ifdef USE_GETHOSTENT_ERRNO
+	    h_errno = PL_reentrant_buffer->_gethostent_errno;
+#   endif
+#endif
+	    STATUS_NATIVE_SET(h_errno);
+	}
 #endif
 
     if (GIMME != G_ARRAY) {
@@ -4727,19 +4838,21 @@ PP(pp_gnetent)
     register char **elem;
     register SV *sv;
 #ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
-    struct netent *PerlSock_getnetbyaddr(Netdb_net_t, int);
-    struct netent *PerlSock_getnetbyname(Netdb_name_t);
-    struct netent *PerlSock_getnetent(void);
+    struct netent *getnetbyaddr(Netdb_net_t, int);
+    struct netent *getnetbyname(Netdb_name_t);
+    struct netent *getnetent(void);
 #endif
     struct netent *nent;
     STRLEN n_a;
 
-    if (which == OP_GNBYNAME)
+    if (which == OP_GNBYNAME){
 #ifdef HAS_GETNETBYNAME
-	nent = PerlSock_getnetbyname(POPpbytex);
+        char *name = POPpbytex;
+	nent = PerlSock_getnetbyname(name);
 #else
         DIE(aTHX_ PL_no_sock_func, "getnetbyname");
 #endif
+    }
     else if (which == OP_GNBYADDR) {
 #ifdef HAS_GETNETBYADDR
 	int addrtype = POPi;
@@ -4756,6 +4869,17 @@ PP(pp_gnetent)
         DIE(aTHX_ PL_no_sock_func, "getnetent");
 #endif
 
+#ifdef HOST_NOT_FOUND
+	if (!nent) {
+#ifdef USE_REENTRANT_API
+#   ifdef USE_GETNETENT_ERRNO
+	     h_errno = PL_reentrant_buffer->_getnetent_errno;
+#   endif
+#endif
+	    STATUS_NATIVE_SET(h_errno);
+	}
+#endif
+
     EXTEND(SP, 4);
     if (GIMME != G_ARRAY) {
 	PUSHs(sv = sv_newmortal());
@@ -4815,25 +4939,29 @@ PP(pp_gprotoent)
     register char **elem;
     register SV *sv;
 #ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
-    struct protoent *PerlSock_getprotobyname(Netdb_name_t);
-    struct protoent *PerlSock_getprotobynumber(int);
-    struct protoent *PerlSock_getprotoent(void);
+    struct protoent *getprotobyname(Netdb_name_t);
+    struct protoent *getprotobynumber(int);
+    struct protoent *getprotoent(void);
 #endif
     struct protoent *pent;
     STRLEN n_a;
 
-    if (which == OP_GPBYNAME)
+    if (which == OP_GPBYNAME) {
 #ifdef HAS_GETPROTOBYNAME
-	pent = PerlSock_getprotobyname(POPpbytex);
+        char* name = POPpbytex;
+	pent = PerlSock_getprotobyname(name);
 #else
 	DIE(aTHX_ PL_no_sock_func, "getprotobyname");
 #endif
-    else if (which == OP_GPBYNUMBER)
+    }
+    else if (which == OP_GPBYNUMBER) {
 #ifdef HAS_GETPROTOBYNUMBER
-	pent = PerlSock_getprotobynumber(POPi);
+        int number = POPi;
+	pent = PerlSock_getprotobynumber(number);
 #else
-    DIE(aTHX_ PL_no_sock_func, "getprotobynumber");
+	DIE(aTHX_ PL_no_sock_func, "getprotobynumber");
 #endif
+    }
     else
 #ifdef HAS_GETPROTOENT
 	pent = PerlSock_getprotoent();
@@ -4898,9 +5026,9 @@ PP(pp_gservent)
     register char **elem;
     register SV *sv;
 #ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
-    struct servent *PerlSock_getservbyname(Netdb_name_t, Netdb_name_t);
-    struct servent *PerlSock_getservbyport(int, Netdb_name_t);
-    struct servent *PerlSock_getservent(void);
+    struct servent *getservbyname(Netdb_name_t, Netdb_name_t);
+    struct servent *getservbyport(int, Netdb_name_t);
+    struct servent *getservent(void);
 #endif
     struct servent *sent;
     STRLEN n_a;
@@ -4921,7 +5049,10 @@ PP(pp_gservent)
     else if (which == OP_GSBYPORT) {
 #ifdef HAS_GETSERVBYPORT
 	char *proto = POPpbytex;
-	unsigned short port = POPu;
+	unsigned short port = (unsigned short)POPu;
+
+	if (proto && !*proto)
+	    proto = Nullch;
 
 #ifdef HAS_HTONS
 	port = PerlSock_htons(port);
@@ -5108,7 +5239,7 @@ PP(pp_gpwent)
      * AIX getpwnam() is clever enough to return the encrypted password
      * only if the caller (euid?) is root.
      *
-     * There are at least two other shadow password APIs.  Many platforms
+     * There are at least three other shadow password APIs.  Many platforms
      * seem to contain more than one interface for accessing the shadow
      * password databases, possibly for compatibility reasons.
      * The getsp*() is by far he simplest one, the other two interfaces
@@ -5130,6 +5261,12 @@ PP(pp_gpwent)
      * char *(getespw*(...).ufld.fd_encrypt)
      * Mention HAS_GETESPWNAM here so that Configure probes for it.
      *
+     * <userpw.h> (AIX)
+     * struct userpw *getuserpw();
+     * The password is in
+     * char *(getuserpw(...)).spw_upw_passwd
+     * (but the de facto standard getpwnam() should work okay)
+     *
      * Mention I_PROT here so that Configure probes for it.
      *
      * In HP-UX for getprpw*() the manual page claims that one should include
@@ -5152,16 +5289,31 @@ PP(pp_gpwent)
      * --jhi
      */
 
+#   if defined(__CYGWIN__) && defined(USE_REENTRANT_API)
+    /* Cygwin 1.5.3-1 has buggy getpwnam_r() and getpwuid_r():
+     * the pw_comment is left uninitialized. */
+    PL_reentrant_buffer->_pwent_struct.pw_comment = NULL;
+#   endif
+
     switch (which) {
     case OP_GPWNAM:
-	pwent  = getpwnam(POPpbytex);
-	break;
+      {
+	char* name = POPpbytex;
+	pwent  = getpwnam(name);
+      }
+      break;
     case OP_GPWUID:
-	pwent = getpwuid((Uid_t)POPi);
+      {
+	Uid_t uid = POPi;
+	pwent = getpwuid(uid);
+      }
 	break;
     case OP_GPWENT:
 #   ifdef HAS_GETPWENT
 	pwent  = getpwent();
+#ifdef POSIX_BC   /* In some cases pw_passwd has invalid addresses */
+	if (pwent) pwent = getpwnam(pwent->pw_name);
+#endif
 #   else
 	DIE(aTHX_ PL_no_func, "getpwent");
 #   endif
@@ -5206,7 +5358,9 @@ PP(pp_gpwent)
 	 * Divert the urge to writing an extension instead.
 	 *
 	 * --jhi */
-#   ifdef HAS_GETSPNAM
+	/* Some AIX setups falsely(?) detect some getspnam(), which
+	 * has a different API than the Solaris/IRIX one. */
+#   if defined(HAS_GETSPNAM) && !defined(_AIX)
 	{
 	    struct spwd *spwent;
 	    int saverrno; /* Save and restore errno so that
@@ -5354,10 +5508,14 @@ PP(pp_ggrent)
     struct group *grent;
     STRLEN n_a;
 
-    if (which == OP_GGRNAM)
-	grent = (struct group *)getgrnam(POPpbytex);
-    else if (which == OP_GGRGID)
-	grent = (struct group *)getgrgid(POPi);
+    if (which == OP_GGRNAM) {
+        char* name = POPpbytex;
+	grent = (struct group *)getgrnam(name);
+    }
+    else if (which == OP_GGRGID) {
+        Gid_t gid = POPi;
+	grent = (struct group *)getgrgid(gid);
+    }
     else
 #ifdef HAS_GETGRENT
 	grent = (struct group *)getgrent();
@@ -5389,12 +5547,22 @@ PP(pp_ggrent)
 	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setiv(sv, (IV)grent->gr_gid);
 
+#if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API))
 	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+	/* In UNICOS/mk (_CRAYMPP) the multithreading
+	 * versions (getgrnam_r, getgrgid_r)
+	 * seem to return an illegal pointer
+	 * as the group members list, gr_mem.
+	 * getgrent() doesn't even have a _r version
+	 * but the gr_mem is poisonous anyway.
+	 * So yes, you cannot get the list of group
+	 * members if building multithreaded in UNICOS/mk. */
 	for (elem = grent->gr_mem; elem && *elem; elem++) {
 	    sv_catpv(sv, *elem);
 	    if (elem[1])
 		sv_catpvn(sv, " ", 1);
 	}
+#endif
     }
 
     RETURN;