X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=98ecfac5688768ce895169afdd7c6f7b2ccaa281;hb=11faa288e292c27cb2ddc4ccdc483b523d26ce19;hp=55d00edba89aba9fdf8a733ed4f3d3fee081c7c0;hpb=9e67d94e6e4396a78a2012441f9359240f5b4bdd;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index 55d00ed..98ecfac 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1,6 +1,6 @@
 /*    pp_sys.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -15,8 +15,21 @@
  */
 
 #include "EXTERN.h"
+#define PERL_IN_PP_SYS_C
 #include "perl.h"
 
+#ifdef I_SHADOW
+/* Shadow password support for solaris - pdo@cs.umd.edu
+ * Not just Solaris: at least HP-UX, IRIX, Linux.
+ * the API is from SysV. --jhi */
+#ifdef __hpux__
+/* There is a MAXINT coming from <shadow.h> <- <hpsecurity.h> <- <values.h>
+ * and another MAXINT from "perl.h" <- <sys/param.h>. */ 
+#undef MAXINT
+#endif
+#include <shadow.h>
+#endif
+
 /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
 #ifdef I_UNISTD
 # include <unistd.h>
@@ -38,6 +51,9 @@ extern "C" int syscall(unsigned long,...);
 
 #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
 # include <sys/socket.h>
+# if defined(USE_SOCKS) && defined(I_SOCKS)
+#   include <socks.h>
+# endif 
 # ifdef I_NETDB
 #  include <netdb.h>
 # endif
@@ -54,7 +70,14 @@ extern "C" int syscall(unsigned long,...);
 #endif
 #endif
 
-#ifdef HOST_NOT_FOUND
+/* XXX Configure test needed.
+   h_errno might not be a simple 'int', especially for multi-threaded
+   applications, see "extern int errno in perl.h".  Creating such
+   a test requires taking into account the differences between
+   compiling multithreaded and singlethreaded ($ccflags et al).
+   HOST_NOT_FOUND is typically defined in <netdb.h>.
+*/
+#if defined(HOST_NOT_FOUND) && !defined(h_errno)
 extern int h_errno;
 #endif
 
@@ -62,24 +85,28 @@ extern int h_errno;
 # ifdef I_PWD
 #  include <pwd.h>
 # else
-    struct passwd *getpwnam _((char *));
-    struct passwd *getpwuid _((Uid_t));
+    struct passwd *getpwnam (char *);
+    struct passwd *getpwuid (Uid_t);
+# endif
+# ifdef HAS_GETPWENT
+  struct passwd *getpwent (void);
 # endif
-  struct passwd *getpwent _((void));
 #endif
 
 #ifdef HAS_GROUP
 # ifdef I_GRP
 #  include <grp.h>
 # else
-    struct group *getgrnam _((char *));
-    struct group *getgrgid _((Gid_t));
+    struct group *getgrnam (char *);
+    struct group *getgrgid (Gid_t);
+# endif
+# ifdef HAS_GETGRENT
+    struct group *getgrent (void);
 # endif
-    struct group *getgrent _((void));
 #endif
 
 #ifdef I_UTIME
-#  ifdef _MSC_VER
+#  if defined(_MSC_VER) || defined(__MINGW32__)
 #    include <sys/utime.h>
 #  else
 #    include <utime.h>
@@ -106,10 +133,6 @@ extern int h_errno;
 #  endif
 #endif
 
-#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
-static int dooneliner _((char *cmd, char *filename));
-#endif
-
 #ifdef HAS_CHSIZE
 # ifdef my_chsize  /* Probably #defined to Perl_my_chsize in embed.h */
 #   undef my_chsize
@@ -140,7 +163,7 @@ static int dooneliner _((char *cmd, char *filename));
 #  endif /* no flock() or fcntl(F_SETLK,...) */
 
 #  ifdef FLOCK
-     static int FLOCK _((int, int));
+     static int FLOCK (int, int);
 
     /*
      * These are the flock() constants.  Since this sytems doesn't have
@@ -162,24 +185,139 @@ static int dooneliner _((char *cmd, char *filename));
 
 #endif /* no flock() */
 
-#ifndef MAXPATHLEN
-#  ifdef PATH_MAX
-#    define MAXPATHLEN PATH_MAX
-#  else
-#    define MAXPATHLEN 1024
-#  endif
-#endif
-
 #define ZBTLEN 10
 static char zero_but_true[ZBTLEN + 1] = "0 but true";
 
-/* Pushy I/O. */
+#if defined(I_SYS_ACCESS) && !defined(R_OK)
+#  include <sys/access.h>
+#endif
+
+#if defined(HAS_FCNTL) && defined(F_SETFD) && !defined(FD_CLOEXEC)
+#  define FD_CLOEXEC 1		/* NeXT needs this */
+#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
+
+/* F_OK unused: if stat() cannot find it... */
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESS) && defined(EFF_ONLY_OK) && !defined(NO_EFF_ONLY_OK)
+    /* Digital UNIX (when the EFF_ONLY_OK gets fixed), UnixWare */
+#   define PERL_EFF_ACCESS_R_OK(p) (access((p), R_OK | EFF_ONLY_OK))
+#   define PERL_EFF_ACCESS_W_OK(p) (access((p), W_OK | EFF_ONLY_OK))
+#   define PERL_EFF_ACCESS_X_OK(p) (access((p), X_OK | EFF_ONLY_OK))
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_EACCESS)
+#   if defined(I_SYS_SECURITY)
+#       include <sys/security.h>
+#   endif
+    /* XXX Configure test needed for eaccess */
+#   ifdef ACC_SELF
+        /* HP SecureWare */
+#       define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
+#       define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
+#       define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
+#   else
+        /* SCO */
+#       define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK))
+#       define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK))
+#       define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK))
+#   endif
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF)
+    /* AIX */
+#   define PERL_EFF_ACCESS_R_OK(p) (accessx((p), R_OK, ACC_SELF))
+#   define PERL_EFF_ACCESS_W_OK(p) (accessx((p), W_OK, ACC_SELF))
+#   define PERL_EFF_ACCESS_X_OK(p) (accessx((p), X_OK, ACC_SELF))
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESS)	\
+    && (defined(HAS_SETREUID) || defined(HAS_SETRESUID)		\
+	|| defined(HAS_SETREGID) || defined(HAS_SETRESGID))
+/* The Hard Way. */
+STATIC int
+S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
+{
+    Uid_t ruid = getuid();
+    Uid_t euid = geteuid();
+    Gid_t rgid = getgid();
+    Gid_t egid = getegid();
+    int res;
+
+    MUTEX_LOCK(&PL_cred_mutex);
+#if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID)
+    Perl_croak(aTHX_ "switching effective uid is not implemented");
+#else
+#ifdef HAS_SETREUID
+    if (setreuid(euid, ruid))
+#else
+#ifdef HAS_SETRESUID
+    if (setresuid(euid, ruid, (Uid_t)-1))
+#endif
+#endif
+	Perl_croak(aTHX_ "entering effective uid failed");
+#endif
+
+#if !defined(HAS_SETREGID) && !defined(HAS_SETRESGID)
+    Perl_croak(aTHX_ "switching effective gid is not implemented");
+#else
+#ifdef HAS_SETREGID
+    if (setregid(egid, rgid))
+#else
+#ifdef HAS_SETRESGID
+    if (setresgid(egid, rgid, (Gid_t)-1))
+#endif
+#endif
+	Perl_croak(aTHX_ "entering effective gid failed");
+#endif
+
+    res = access(path, mode);
+
+#ifdef HAS_SETREUID
+    if (setreuid(ruid, euid))
+#else
+#ifdef HAS_SETRESUID
+    if (setresuid(ruid, euid, (Uid_t)-1))
+#endif
+#endif
+	Perl_croak(aTHX_ "leaving effective uid failed");
+
+#ifdef HAS_SETREGID
+    if (setregid(rgid, egid))
+#else
+#ifdef HAS_SETRESGID
+    if (setresgid(rgid, egid, (Gid_t)-1))
+#endif
+#endif
+	Perl_croak(aTHX_ "leaving effective gid failed");
+    MUTEX_UNLOCK(&PL_cred_mutex);
+
+    return res;
+}
+#   define PERL_EFF_ACCESS_R_OK(p) (emulate_eaccess((p), R_OK))
+#   define PERL_EFF_ACCESS_W_OK(p) (emulate_eaccess((p), W_OK))
+#   define PERL_EFF_ACCESS_X_OK(p) (emulate_eaccess((p), X_OK))
+#endif
+
+#if !defined(PERL_EFF_ACCESS_R_OK)
+STATIC int
+S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
+{
+    Perl_croak(aTHX_ "switching effective uid is not implemented");
+    /*NOTREACHED*/
+    return -1;
+}
+#endif
 
 PP(pp_backtick)
 {
     djSP; dTARGET;
     PerlIO *fp;
-    char *tmps = POPp;
+    STRLEN n_a;
+    char *tmps = POPpx;
     I32 gimme = GIMME_V;
 
     TAINT_PROPER("``");
@@ -203,7 +341,7 @@ PP(pp_backtick)
 	    SV *sv;
 
 	    for (;;) {
-		sv = NEWSV(56, 80);
+		sv = NEWSV(56, 79);
 		if (sv_gets(sv, fp, 0) == Nullch) {
 		    SvREFCNT_dec(sv);
 		    break;
@@ -231,27 +369,29 @@ PP(pp_backtick)
 PP(pp_glob)
 {
     OP *result;
+    tryAMAGICunTARGET(iter, -1);
+
     ENTER;
 
 #ifndef VMS
-    if (tainting) {
+    if (PL_tainting) {
 	/*
 	 * The external globbing program may use things we can't control,
 	 * so for security reasons we must assume the worst.
 	 */
 	TAINT;
-	taint_proper(no_security, "glob");
+	taint_proper(PL_no_security, "glob");
     }
 #endif /* !VMS */
 
-    SAVESPTR(last_in_gv);	/* We don't want this to be permanent. */
-    last_in_gv = (GV*)*stack_sp--;
+    SAVESPTR(PL_last_in_gv);	/* We don't want this to be permanent. */
+    PL_last_in_gv = (GV*)*PL_stack_sp--;
 
-    SAVESPTR(rs);		/* This is not permanent, either. */
-    rs = sv_2mortal(newSVpv("", 1));
+    SAVESPTR(PL_rs);		/* This is not permanent, either. */
+    PL_rs = sv_2mortal(newSVpvn("\000", 1));
 #ifndef DOSISH
 #ifndef CSH
-    *SvPVX(rs) = '\n';
+    *SvPVX(PL_rs) = '\n';
 #endif	/* !CSH */
 #endif	/* !DOSISH */
 
@@ -260,40 +400,49 @@ PP(pp_glob)
     return result;
 }
 
+#if 0		/* XXX never used! */
 PP(pp_indread)
 {
-    last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
+    STRLEN n_a;
+    PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), n_a), TRUE,SVt_PVIO);
     return do_readline();
 }
+#endif
 
 PP(pp_rcatline)
 {
-    last_in_gv = cGVOP->op_gv;
+    PL_last_in_gv = cGVOP;
     return do_readline();
 }
 
 PP(pp_warn)
 {
     djSP; dMARK;
+    SV *tmpsv;
     char *tmps;
+    STRLEN len;
     if (SP - MARK != 1) {
 	dTARGET;
-	do_join(TARG, &sv_no, MARK, SP);
-	tmps = SvPV(TARG, na);
+	do_join(TARG, &PL_sv_no, MARK, SP);
+	tmpsv = TARG;
 	SP = MARK + 1;
     }
     else {
-	tmps = SvPV(TOPs, na);
+	tmpsv = TOPs;
     }
-    if (!tmps || !*tmps) {
-	(void)SvUPGRADE(ERRSV, SVt_PV);
-	if (SvPOK(ERRSV) && SvCUR(ERRSV))
-	    sv_catpv(ERRSV, "\t...caught");
-	tmps = SvPV(ERRSV, na);
-    }
-    if (!tmps || !*tmps)
-	tmps = "Warning: something's wrong";
-    warn("%s", tmps);
+    tmps = SvPV(tmpsv, len);
+    if (!tmps || !len) {
+  	SV *error = ERRSV;
+	(void)SvUPGRADE(error, SVt_PV);
+	if (SvPOK(error) && SvCUR(error))
+	    sv_catpv(error, "\t...caught");
+	tmpsv = error;
+	tmps = SvPV(tmpsv, len);
+    }
+    if (!tmps || !len)
+	tmpsv = sv_2mortal(newSVpvn("Warning: something's wrong", 26));
+
+    Perl_warn(aTHX_ "%_", tmpsv);
     RETSETYES;
 }
 
@@ -301,24 +450,57 @@ PP(pp_die)
 {
     djSP; dMARK;
     char *tmps;
+    SV *tmpsv;
+    STRLEN len;
+    bool multiarg = 0;
     if (SP - MARK != 1) {
 	dTARGET;
-	do_join(TARG, &sv_no, MARK, SP);
-	tmps = SvPV(TARG, na);
+	do_join(TARG, &PL_sv_no, MARK, SP);
+	tmpsv = TARG;
+	tmps = SvPV(tmpsv, len);
+	multiarg = 1;
 	SP = MARK + 1;
     }
     else {
-	tmps = SvPV(TOPs, na);
+	tmpsv = TOPs;
+	tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, len);
     }
-    if (!tmps || !*tmps) {
-	(void)SvUPGRADE(ERRSV, SVt_PV);
-	if (SvPOK(ERRSV) && SvCUR(ERRSV))
-	    sv_catpv(ERRSV, "\t...propagated");
-	tmps = SvPV(ERRSV, na);
+    if (!tmps || !len) {
+  	SV *error = ERRSV;
+	(void)SvUPGRADE(error, SVt_PV);
+	if (multiarg ? SvROK(error) : SvROK(tmpsv)) {
+	    if (!multiarg)
+		SvSetSV(error,tmpsv);
+	    else if (sv_isobject(error)) {
+		HV *stash = SvSTASH(SvRV(error));
+		GV *gv = gv_fetchmethod(stash, "PROPAGATE");
+		if (gv) {
+		    SV *file = sv_2mortal(newSVsv(CopFILESV(PL_curcop)));
+		    SV *line = sv_2mortal(newSViv(CopLINE(PL_curcop)));
+		    EXTEND(SP, 3);
+		    PUSHMARK(SP);
+		    PUSHs(error);
+		    PUSHs(file);
+ 		    PUSHs(line);
+		    PUTBACK;
+		    call_sv((SV*)GvCV(gv),
+			    G_SCALAR|G_EVAL|G_KEEPERR);
+		    sv_setsv(error,*PL_stack_sp--);
+		}
+	    }
+	    DIE(aTHX_ Nullch);
+	}
+	else {
+	    if (SvPOK(error) && SvCUR(error))
+		sv_catpv(error, "\t...propagated");
+	    tmpsv = error;
+	    tmps = SvPV(tmpsv, len);
+	}
     }
-    if (!tmps || !*tmps)
-	tmps = "Died";
-    DIE("%s", tmps);
+    if (!tmps || !len)
+	tmpsv = sv_2mortal(newSVpvn("Died", 4));
+
+    DIE(aTHX_ "%_", tmpsv);
 }
 
 /* I/O. */
@@ -328,24 +510,46 @@ PP(pp_open)
     djSP; dTARGET;
     GV *gv;
     SV *sv;
+    SV *name;
+    I32 have_name = 0;
     char *tmps;
     STRLEN len;
+    MAGIC *mg;
 
+    if (MAXARG > 2) {
+	name = POPs;
+	have_name = 1;
+    }
     if (MAXARG > 1)
 	sv = POPs;
     if (!isGV(TOPs))
-	DIE(no_usym, "filehandle");
+	DIE(aTHX_ PL_no_usym, "filehandle");
     if (MAXARG <= 1)
 	sv = GvSV(TOPs);
     gv = (GV*)POPs;
     if (!isGV(gv))
-	DIE(no_usym, "filehandle");
+	DIE(aTHX_ PL_no_usym, "filehandle");
     if (GvIOp(gv))
 	IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
+
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
+	PUSHMARK(SP);
+	XPUSHs(SvTIED_obj((SV*)gv, mg));
+	XPUSHs(sv);
+	if (have_name)
+	    XPUSHs(name);
+	PUTBACK;
+	ENTER;
+	call_method("OPEN", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	RETURN;
+    }
+
     tmps = SvPV(sv, len);
-    if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp))
-	PUSHi( (I32)forkprocess );
-    else if (forkprocess == 0)		/* we are a new child */
+    if (do_open9(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, name, have_name))
+	PUSHi( (I32)PL_forkprocess );
+    else if (PL_forkprocess == 0)		/* we are a new child */
 	PUSHi(0);
     else
 	RETPUSHUNDEF;
@@ -356,11 +560,23 @@ PP(pp_close)
 {
     djSP;
     GV *gv;
+    MAGIC *mg;
 
     if (MAXARG == 0)
-	gv = defoutgv;
+	gv = PL_defoutgv;
     else
 	gv = (GV*)POPs;
+
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
+	PUSHMARK(SP);
+	XPUSHs(SvTIED_obj((SV*)gv, mg));
+	PUTBACK;
+	ENTER;
+	call_method("CLOSE", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	RETURN;
+    }
     EXTEND(SP, 1);
     PUSHs(boolSV(do_close(gv, TRUE)));
     RETURN;
@@ -383,7 +599,7 @@ PP(pp_pipe_op)
 	goto badexit;
 
     if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
-	DIE(no_usym, "filehandle");
+	DIE(aTHX_ PL_no_usym, "filehandle");
     rstio = GvIOn(rgv);
     wstio = GvIOn(wgv);
 
@@ -408,13 +624,16 @@ PP(pp_pipe_op)
 	else PerlLIO_close(fd[1]);
 	goto badexit;
     }
-
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+    fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd);	/* ensure close-on-exec */
+    fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd);	/* ensure close-on-exec */
+#endif
     RETPUSHYES;
 
 badexit:
     RETPUSHUNDEF;
 #else
-    DIE(no_func, "pipe");
+    DIE(aTHX_ PL_no_func, "pipe");
 #endif
 }
 
@@ -424,9 +643,23 @@ PP(pp_fileno)
     GV *gv;
     IO *io;
     PerlIO *fp;
+    MAGIC  *mg;
+
     if (MAXARG < 1)
 	RETPUSHUNDEF;
     gv = (GV*)POPs;
+
+    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+	PUSHMARK(SP);
+	XPUSHs(SvTIED_obj((SV*)gv, mg));
+	PUTBACK;
+	ENTER;
+	call_method("FILENO", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	RETURN;
+    }
+
     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
 	RETPUSHUNDEF;
     PUSHi(PerlIO_fileno(fp));
@@ -436,7 +669,7 @@ PP(pp_fileno)
 PP(pp_umask)
 {
     djSP; dTARGET;
-    int anum;
+    Mode_t anum;
 
 #ifdef HAS_UMASK
     if (MAXARG < 1) {
@@ -448,7 +681,12 @@ PP(pp_umask)
     TAINT_PROPER("umask");
     XPUSHi(anum);
 #else
-    DIE(no_func, "Unsupported function umask");
+    /* Only DIE if trying to restrict permissions on `user' (self).
+     * Otherwise it's harmless and more useful to just return undef
+     * since 'group' and 'other' concepts probably don't exist here. */
+    if (MAXARG >= 1 && (POPi & 0700))
+	DIE(aTHX_ "umask not implemented");
+    XPUSHs(&PL_sv_undef);
 #endif
     RETURN;
 }
@@ -459,66 +697,50 @@ PP(pp_binmode)
     GV *gv;
     IO *io;
     PerlIO *fp;
+    MAGIC *mg;
 
     if (MAXARG < 1)
 	RETPUSHUNDEF;
 
-    gv = (GV*)POPs;
+    gv = (GV*)POPs; 
+
+    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+	PUSHMARK(SP);
+	XPUSHs(SvTIED_obj((SV*)gv, mg));
+	PUTBACK;
+	ENTER;
+	call_method("BINMODE", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	RETURN;
+    }
 
     EXTEND(SP, 1);
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
 	RETPUSHUNDEF;
 
-#ifdef DOSISH
-#ifdef atarist
-    if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
-	RETPUSHYES;
-    else
-	RETPUSHUNDEF;
-#else
-    if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -1) {
-#if defined(WIN32) && defined(__BORLANDC__)
-	/* The translation mode of the stream is maintained independent
-	 * of the translation mode of the fd in the Borland RTL (heavy
-	 * digging through their runtime sources reveal).  User has to
-	 * set the mode explicitly for the stream (though they don't
-	 * document this anywhere). GSAR 97-5-24
-	 */
-	PerlIO_seek(fp,0L,0);
-	fp->flags |= _F_BIN;
-#endif
+    if (do_binmode(fp,IoTYPE(io),TRUE)) 
 	RETPUSHYES;
-    }
     else
 	RETPUSHUNDEF;
-#endif
-#else
-#if defined(USEMYBINMODE)
-    if (my_binmode(fp,IoTYPE(io)) != NULL)
-	RETPUSHYES;
-	else
-	RETPUSHUNDEF;
-#else
-    RETPUSHYES;
-#endif
-#endif
-
 }
 
 
 PP(pp_tie)
 {
     djSP;
+    dMARK;
     SV *varsv;
     HV* stash;
     GV *gv;
     SV *sv;
-    SV **mark = stack_base + ++*markstack_ptr;	/* reuse in entersub */
-    I32 markoff = mark - stack_base - 1;
+    I32 markoff = MARK - PL_stack_base;
     char *methname;
     int how = 'P';
+    U32 items;
+    STRLEN n_a;
 
-    varsv = mark[0];  
+    varsv = *++MARK;
     switch(SvTYPE(varsv)) {
 	case SVt_PVHV:
 	    methname = "TIEHASH";
@@ -535,32 +757,45 @@ PP(pp_tie)
 	    how = 'q';
 	    break;
     }
-
-    if (sv_isobject(mark[1])) {
+    items = SP - MARK++;
+    if (sv_isobject(*MARK)) {
 	ENTER;
-	perl_call_method(methname, G_SCALAR);
+	PUSHSTACKi(PERLSI_MAGIC);
+	PUSHMARK(SP);
+	EXTEND(SP,items);
+	while (items--)
+	    PUSHs(*MARK++);
+	PUTBACK;
+	call_method(methname, G_SCALAR);
     } 
     else {
-	/* Not clear why we don't call perl_call_method here too.
+	/* Not clear why we don't call call_method here too.
 	 * perhaps to get different error message ?
 	 */
-	stash = gv_stashsv(mark[1], FALSE);
+	stash = gv_stashsv(*MARK, FALSE);
 	if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
-	    DIE("Can't locate object method \"%s\" via package \"%s\"",
-		 methname, SvPV(mark[1],na));                   
+	    DIE(aTHX_ "Can't locate object method \"%s\" via package \"%s\"",
+		 methname, SvPV(*MARK,n_a));                   
 	}
 	ENTER;
-	perl_call_sv((SV*)GvCV(gv), G_SCALAR);
+	PUSHSTACKi(PERLSI_MAGIC);
+	PUSHMARK(SP);
+	EXTEND(SP,items);
+	while (items--)
+	    PUSHs(*MARK++);
+	PUTBACK;
+	call_sv((SV*)GvCV(gv), G_SCALAR);
     }
     SPAGAIN;
 
     sv = TOPs;
+    POPSTACK;
     if (sv_isobject(sv)) {
-	sv_unmagic(varsv, how);            
-	sv_magic(varsv, sv, how, Nullch, 0);
+	sv_unmagic(varsv, how);
+	sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0);
     }
     LEAVE;
-    SP = stack_base + markoff;
+    SP = PL_stack_base + markoff;
     PUSHs(sv);
     RETURN;
 }
@@ -568,47 +803,36 @@ PP(pp_tie)
 PP(pp_untie)
 {
     djSP;
-    SV * sv ;
-    sv = POPs;          
+    SV *sv = POPs;
+    char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
 
-    if (dowarn) {
+    if (ckWARN(WARN_UNTIE)) {
         MAGIC * mg ;
-        if (SvMAGICAL(sv)) {
-            if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
-                mg = mg_find(sv, 'P') ;
-            else
-                mg = mg_find(sv, 'q') ;
-    
+        if (mg = SvTIED_mg(sv, how)) {
             if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
-		warn("untie attempted while %lu inner references still exist",
-			(unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
+		Perl_warner(aTHX_ WARN_UNTIE,
+		    "untie attempted while %"UVuf" inner references still exist",
+		    (UV)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
         }
     }
  
-    if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
-	sv_unmagic(sv, 'P');
-    else
-	sv_unmagic(sv, 'q');
+    sv_unmagic(sv, how);
     RETPUSHYES;
 }
 
 PP(pp_tied)
 {
     djSP;
-    SV * sv ;
-    MAGIC * mg ;
+    SV *sv = POPs;
+    char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
+    MAGIC *mg;
 
-    sv = POPs;
-    if (SvMAGICAL(sv)) {
-        if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
-            mg = mg_find(sv, 'P') ;
-        else
-            mg = mg_find(sv, 'q') ;
-
-        if (mg)  {
-            PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ; 
-            RETURN ;
-	}
+    if (mg = SvTIED_mg(sv, how)) {
+	SV *osv = SvTIED_obj(sv, mg);
+	if (osv == mg->mg_obj)
+	    osv = sv_mortalcopy(osv);
+	PUSHs(osv);
+	RETURN;
     }
     RETPUSHUNDEF;
 }
@@ -624,21 +848,21 @@ PP(pp_dbmopen)
 
     hv = (HV*)POPs;
 
-    sv = sv_mortalcopy(&sv_no);
+    sv = sv_mortalcopy(&PL_sv_no);
     sv_setpv(sv, "AnyDBM_File");
     stash = gv_stashsv(sv, FALSE);
     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
 	PUTBACK;
-	perl_require_pv("AnyDBM_File.pm");
+	require_pv("AnyDBM_File.pm");
 	SPAGAIN;
 	if (!(gv = gv_fetchmethod(stash, "TIEHASH")))
-	    DIE("No dbm on this machine");
+	    DIE(aTHX_ "No dbm on this machine");
     }
 
     ENTER;
-    PUSHMARK(sp);
+    PUSHMARK(SP);
 
-    EXTEND(sp, 5);
+    EXTEND(SP, 5);
     PUSHs(sv);
     PUSHs(left);
     if (SvIV(right))
@@ -647,18 +871,18 @@ PP(pp_dbmopen)
 	PUSHs(sv_2mortal(newSViv(O_RDWR)));
     PUSHs(right);
     PUTBACK;
-    perl_call_sv((SV*)GvCV(gv), G_SCALAR);
+    call_sv((SV*)GvCV(gv), G_SCALAR);
     SPAGAIN;
 
     if (!sv_isobject(TOPs)) {
-	sp--;
-	PUSHMARK(sp);
+	SP--;
+	PUSHMARK(SP);
 	PUSHs(sv);
 	PUSHs(left);
 	PUSHs(sv_2mortal(newSViv(O_RDONLY)));
 	PUSHs(right);
 	PUTBACK;
-	perl_call_sv((SV*)GvCV(gv), G_SCALAR);
+	call_sv((SV*)GvCV(gv), G_SCALAR);
 	SPAGAIN;
     }
 
@@ -672,7 +896,7 @@ PP(pp_dbmopen)
 
 PP(pp_dbmclose)
 {
-    return pp_untie(ARGS);
+    return pp_untie();
 }
 
 PP(pp_sselect)
@@ -683,13 +907,14 @@ PP(pp_sselect)
     register I32 j;
     register char *s;
     register SV *sv;
-    double value;
+    NV value;
     I32 maxlen = 0;
     I32 nfound;
     struct timeval timebuf;
     struct timeval *tbuf = &timebuf;
     I32 growsize;
     char *fd_sets[4];
+    STRLEN n_a;
 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
 	I32 masksize;
 	I32 offset;
@@ -712,23 +937,29 @@ PP(pp_sselect)
 	    maxlen = j;
     }
 
+/* little endians can use vecs directly */
 #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
-#if defined(__linux__) || defined(OS2)
+#  if SELECT_MIN_BITS > 1
+    /* 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, Rhapsody) 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);
-#else
-    growsize = maxlen;		/* little endians can use vecs directly */
-#endif
-#else
-#ifdef NFDBITS
+#  endif
+# else
+#  ifdef NFDBITS
 
-#ifndef NBBY
-#define NBBY 8
-#endif
+#    ifndef NBBY
+#     define NBBY 8
+#    endif
 
     masksize = NFDBITS / NBBY;
-#else
+#  else
     masksize = sizeof(long);	/* documented int, everyone seems to use long */
-#endif
+#  endif
     growsize = maxlen + (masksize - (maxlen % masksize));
     Zero(&fd_sets[0], 4, char*);
 #endif
@@ -739,7 +970,7 @@ PP(pp_sselect)
 	if (value < 0.0)
 	    value = 0.0;
 	timebuf.tv_sec = (long)value;
-	value -= (double)timebuf.tv_sec;
+	value -= (NV)timebuf.tv_sec;
 	timebuf.tv_usec = (long)(value * 1000000.0);
     }
     else
@@ -752,7 +983,7 @@ PP(pp_sselect)
 	    continue;
 	}
 	else if (!SvPOK(sv))
-	    SvPV_force(sv,na);	/* force string conversion */
+	    SvPV_force(sv,n_a);	/* force string conversion */
 	j = SvLEN(sv);
 	if (j < growsize) {
 	    Sv_Grow(sv, growsize);
@@ -798,26 +1029,26 @@ PP(pp_sselect)
 
     PUSHi(nfound);
     if (GIMME == G_ARRAY && tbuf) {
-	value = (double)(timebuf.tv_sec) +
-		(double)(timebuf.tv_usec) / 1000000.0;
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	value = (NV)(timebuf.tv_sec) +
+		(NV)(timebuf.tv_usec) / 1000000.0;
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setnv(sv, value);
     }
     RETURN;
 #else
-    DIE("select not implemented");
+    DIE(aTHX_ "select not implemented");
 #endif
 }
 
 void
-setdefout(GV *gv)
+Perl_setdefout(pTHX_ GV *gv)
 {
     dTHR;
     if (gv)
 	(void)SvREFCNT_inc(gv);
-    if (defoutgv)
-	SvREFCNT_dec(defoutgv);
-    defoutgv = gv;
+    if (PL_defoutgv)
+	SvREFCNT_dec(PL_defoutgv);
+    PL_defoutgv = gv;
 }
 
 PP(pp_select)
@@ -826,18 +1057,18 @@ PP(pp_select)
     GV *newdefout, *egv;
     HV *hv;
 
-    newdefout = (op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL;
+    newdefout = (PL_op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL;
 
-    egv = GvEGV(defoutgv);
+    egv = GvEGV(PL_defoutgv);
     if (!egv)
-	egv = defoutgv;
+	egv = PL_defoutgv;
     hv = GvSTASH(egv);
     if (! hv)
-	XPUSHs(&sv_undef);
+	XPUSHs(&PL_sv_undef);
     else {
 	GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
 	if (gvp && *gvp == egv) {
-	    gv_efullname3(TARG, defoutgv, Nullch);
+	    gv_efullname3(TARG, PL_defoutgv, Nullch);
 	    XPUSHTARG;
 	}
 	else {
@@ -861,19 +1092,19 @@ PP(pp_getc)
     MAGIC *mg;
 
     if (MAXARG <= 0)
-	gv = stdingv;
+	gv = PL_stdingv;
     else
 	gv = (GV*)POPs;
     if (!gv)
-	gv = argvgv;
+	gv = PL_argvgv;
 
-    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
 	I32 gimme = GIMME_V;
 	PUSHMARK(SP);
-	XPUSHs(mg->mg_obj);
+	XPUSHs(SvTIED_obj((SV*)gv, mg));
 	PUTBACK;
 	ENTER;
-	perl_call_method("GETC", gimme);
+	call_method("GETC", gimme);
 	LEAVE;
 	SPAGAIN;
 	if (gimme == G_SCALAR)
@@ -891,11 +1122,11 @@ PP(pp_getc)
 
 PP(pp_read)
 {
-    return pp_sysread(ARGS);
+    return pp_sysread();
 }
 
 STATIC OP *
-doform(CV *cv, GV *gv, OP *retop)
+S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 {
     dTHR;
     register PERL_CONTEXT *cx;
@@ -907,10 +1138,10 @@ doform(CV *cv, GV *gv, OP *retop)
     SAVETMPS;
 
     push_return(retop);
-    PUSHBLOCK(cx, CXt_SUB, stack_sp);
+    PUSHBLOCK(cx, CXt_SUB, PL_stack_sp);
     PUSHFORMAT(cx);
-    SAVESPTR(curpad);
-    curpad = AvARRAY((AV*)svp[1]);
+    SAVESPTR(PL_curpad);
+    PL_curpad = AvARRAY((AV*)svp[1]);
 
     setdefout(gv);	    /* locally select filehandle so $% et al work */
     return CvSTART(cv);
@@ -925,11 +1156,11 @@ PP(pp_enterwrite)
     CV *cv;
 
     if (MAXARG == 0)
-	gv = defoutgv;
+	gv = PL_defoutgv;
     else {
 	gv = (GV*)POPs;
 	if (!gv)
-	    gv = defoutgv;
+	    gv = PL_defoutgv;
     }
     EXTEND(SP, 1);
     io = GvIO(gv);
@@ -946,15 +1177,15 @@ PP(pp_enterwrite)
 	if (fgv) {
 	    SV *tmpsv = sv_newmortal();
 	    gv_efullname3(tmpsv, fgv, Nullch);
-	    DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
+	    DIE(aTHX_ "Undefined format \"%s\" called",SvPVX(tmpsv));
 	}
-	DIE("Not a format reference");
+	DIE(aTHX_ "Not a format reference");
     }
     if (CvCLONE(cv))
 	cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
 
     IoFLAGS(io) &= ~IOf_DIDTOP;
-    return doform(cv,gv,op->op_next);
+    return doform(cv,gv,PL_op->op_next);
 }
 
 PP(pp_leavewrite)
@@ -969,9 +1200,9 @@ PP(pp_leavewrite)
     register PERL_CONTEXT *cx;
 
     DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n",
-	  (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
-    if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
-	formtarget != toptarget)
+	  (long)IoLINES_LEFT(io), (long)FmLINES(PL_formtarget)));
+    if (IoLINES_LEFT(io) < FmLINES(PL_formtarget) &&
+	PL_formtarget != PL_toptarget)
     {
 	GV *fgv;
 	CV *cv;
@@ -982,7 +1213,7 @@ PP(pp_leavewrite)
 	    if (!IoTOP_NAME(io)) {
 		if (!IoFMT_NAME(io))
 		    IoFMT_NAME(io) = savepv(GvNAME(gv));
-		topname = sv_2mortal(newSVpvf("%s_TOP", IoFMT_NAME(io)));
+		topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", IoFMT_NAME(io)));
 		topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM);
 		if ((topgv && GvFORM(topgv)) ||
 		  !gv_fetchpv("top",FALSE,SVt_PVFM))
@@ -999,7 +1230,7 @@ PP(pp_leavewrite)
 	}
 	if (IoFLAGS(io) & IOf_DIDTOP) {	/* Oh dear.  It still doesn't fit. */
 	    I32 lines = IoLINES_LEFT(io);
-	    char *s = SvPVX(formtarget);
+	    char *s = SvPVX(PL_formtarget);
 	    if (lines <= 0)		/* Yow, header didn't even fit!!! */
 		goto forget_top;
 	    while (lines-- > 0) {
@@ -1009,64 +1240,69 @@ PP(pp_leavewrite)
 		s++;
 	    }
 	    if (s) {
-		PerlIO_write(ofp, SvPVX(formtarget), s - SvPVX(formtarget));
-		sv_chop(formtarget, s);
-		FmLINES(formtarget) -= IoLINES_LEFT(io);
+		PerlIO_write(ofp, SvPVX(PL_formtarget), s - SvPVX(PL_formtarget));
+		sv_chop(PL_formtarget, s);
+		FmLINES(PL_formtarget) -= IoLINES_LEFT(io);
 	    }
 	}
 	if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
-	    PerlIO_write(ofp, SvPVX(formfeed), SvCUR(formfeed));
+	    PerlIO_write(ofp, SvPVX(PL_formfeed), SvCUR(PL_formfeed));
 	IoLINES_LEFT(io) = IoPAGE_LEN(io);
 	IoPAGE(io)++;
-	formtarget = toptarget;
+	PL_formtarget = PL_toptarget;
 	IoFLAGS(io) |= IOf_DIDTOP;
 	fgv = IoTOP_GV(io);
 	if (!fgv)
-	    DIE("bad top format reference");
+	    DIE(aTHX_ "bad top format reference");
 	cv = GvFORM(fgv);
 	if (!cv) {
 	    SV *tmpsv = sv_newmortal();
 	    gv_efullname3(tmpsv, fgv, Nullch);
-	    DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
+	    DIE(aTHX_ "Undefined top format \"%s\" called",SvPVX(tmpsv));
 	}
 	if (CvCLONE(cv))
 	    cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
-	return doform(cv,gv,op);
+	return doform(cv,gv,PL_op);
     }
 
   forget_top:
-    POPBLOCK(cx,curpm);
+    POPBLOCK(cx,PL_curpm);
     POPFORMAT(cx);
     LEAVE;
 
     fp = IoOFP(io);
     if (!fp) {
-	if (dowarn) {
+	if (ckWARN2(WARN_CLOSED,WARN_IO)) {
+	    SV* sv = sv_newmortal();
+	    gv_efullname3(sv, gv, Nullch);
 	    if (IoIFP(io))
-		warn("Filehandle only opened for input");
-	    else
-		warn("Write on closed filehandle");
+		Perl_warner(aTHX_ WARN_IO,
+			    "Filehandle %s opened only for input",
+			    SvPV_nolen(sv));
+	    else if (ckWARN(WARN_CLOSED))
+		Perl_warner(aTHX_ WARN_CLOSED,
+			    "Write on closed filehandle %s", SvPV_nolen(sv));
 	}
-	PUSHs(&sv_no);
+	PUSHs(&PL_sv_no);
     }
     else {
-	if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) {
-	    if (dowarn)
-		warn("page overflow");
+	if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
+	    if (ckWARN(WARN_IO))
+		Perl_warner(aTHX_ WARN_IO, "page overflow");
 	}
-	if (!PerlIO_write(ofp, SvPVX(formtarget), SvCUR(formtarget)) ||
+	if (!PerlIO_write(ofp, SvPVX(PL_formtarget), SvCUR(PL_formtarget)) ||
 		PerlIO_error(fp))
-	    PUSHs(&sv_no);
+	    PUSHs(&PL_sv_no);
 	else {
-	    FmLINES(formtarget) = 0;
-	    SvCUR_set(formtarget, 0);
-	    *SvEND(formtarget) = '\0';
+	    FmLINES(PL_formtarget) = 0;
+	    SvCUR_set(PL_formtarget, 0);
+	    *SvEND(PL_formtarget) = '\0';
 	    if (IoFLAGS(io) & IOf_FLUSH)
 		(void)PerlIO_flush(fp);
-	    PUSHs(&sv_yes);
+	    PUSHs(&PL_sv_yes);
 	}
     }
-    formtarget = bodytarget;
+    PL_formtarget = PL_bodytarget;
     PUTBACK;
     return pop_return();
 }
@@ -1079,13 +1315,14 @@ PP(pp_prtf)
     PerlIO *fp;
     SV *sv;
     MAGIC *mg;
+    STRLEN n_a;
 
-    if (op->op_flags & OPf_STACKED)
+    if (PL_op->op_flags & OPf_STACKED)
 	gv = (GV*)*++MARK;
     else
-	gv = defoutgv;
+	gv = PL_defoutgv;
 
-    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
 	if (MARK == ORIGMARK) {
 	    MEXTEND(SP, 1);
 	    ++MARK;
@@ -1093,10 +1330,10 @@ PP(pp_prtf)
 	    ++SP;
 	}
 	PUSHMARK(MARK - 1);
-	*MARK = mg->mg_obj;
+	*MARK = SvTIED_obj((SV*)gv, mg);
 	PUTBACK;
 	ENTER;
-	perl_call_method("PRINTF", G_SCALAR);
+	call_method("PRINTF", G_SCALAR);
 	LEAVE;
 	SPAGAIN;
 	MARK = ORIGMARK + 1;
@@ -1107,31 +1344,29 @@ PP(pp_prtf)
 
     sv = NEWSV(0,0);
     if (!(io = GvIO(gv))) {
-	if (dowarn) {
-	    gv_fullname3(sv, gv, Nullch);
-	    warn("Filehandle %s never opened", SvPV(sv,na));
+	if (ckWARN(WARN_UNOPENED)) {
+	    gv_efullname3(sv, gv, Nullch);
+	    Perl_warner(aTHX_ WARN_UNOPENED,
+			"Filehandle %s never opened", SvPV(sv,n_a));
 	}
 	SETERRNO(EBADF,RMS$_IFI);
 	goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
-	if (dowarn)  {
-	    gv_fullname3(sv, gv, Nullch);
+	if (ckWARN2(WARN_CLOSED,WARN_IO))  {
+	    gv_efullname3(sv, gv, Nullch);
 	    if (IoIFP(io))
-		warn("Filehandle %s opened only for input", SvPV(sv,na));
-	    else
-		warn("printf on closed filehandle %s", SvPV(sv,na));
+		Perl_warner(aTHX_ WARN_IO,
+			    "Filehandle %s opened only for input",
+			    SvPV(sv,n_a));
+	    else if (ckWARN(WARN_CLOSED))
+		Perl_warner(aTHX_ WARN_CLOSED,
+			    "printf on closed filehandle %s", SvPV(sv,n_a));
 	}
 	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
 	goto just_say_no;
     }
     else {
-#ifdef USE_LOCALE_NUMERIC
-	if (op->op_private & OPpLOCALE)
-	    SET_NUMERIC_LOCAL();
-	else
-	    SET_NUMERIC_STANDARD();
-#endif
 	do_sprintf(sv, SP - MARK, MARK + 1);
 	if (!do_print(sv, fp))
 	    goto just_say_no;
@@ -1142,13 +1377,13 @@ PP(pp_prtf)
     }
     SvREFCNT_dec(sv);
     SP = ORIGMARK;
-    PUSHs(&sv_yes);
+    PUSHs(&PL_sv_yes);
     RETURN;
 
   just_say_no:
     SvREFCNT_dec(sv);
     SP = ORIGMARK;
-    PUSHs(&sv_undef);
+    PUSHs(&PL_sv_undef);
     RETURN;
 }
 
@@ -1169,13 +1404,15 @@ PP(pp_sysopen)
     sv = POPs;
     gv = (GV *)POPs;
 
+    /* Need TIEHANDLE method ? */
+
     tmps = SvPV(sv, len);
     if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
 	IoLINES(GvIOp(gv)) = 0;
-	PUSHs(&sv_yes);
+	PUSHs(&PL_sv_yes);
     }
     else {
-	PUSHs(&sv_undef);
+	PUSHs(&PL_sv_undef);
     }
     RETURN;
 }
@@ -1194,15 +1431,15 @@ PP(pp_sysread)
     MAGIC *mg;
 
     gv = (GV*)*++MARK;
-    if ((op->op_type == OP_READ || op->op_type == OP_SYSREAD) &&
-	SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
+    if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) &&
+	(mg = SvTIED_mg((SV*)gv, 'q')))
     {
 	SV *sv;
 	
 	PUSHMARK(MARK-1);
-	*MARK = mg->mg_obj;
+	*MARK = SvTIED_obj((SV*)gv, mg);
 	ENTER;
-	perl_call_method("READ", G_SCALAR);
+	call_method("READ", G_SCALAR);
 	LEAVE;
 	SPAGAIN;
 	sv = POPs;
@@ -1219,7 +1456,7 @@ PP(pp_sysread)
     buffer = SvPV_force(bufsv, blen);
     length = SvIVx(*++MARK);
     if (length < 0)
-	DIE("Negative length");
+	DIE(aTHX_ "Negative length");
     SETERRNO(0,0);
     if (MARK < SP)
 	offset = SvIVx(*++MARK);
@@ -1229,13 +1466,21 @@ PP(pp_sysread)
     if (!io || !IoIFP(io))
 	goto say_undef;
 #ifdef HAS_SOCKET
-    if (op->op_type == OP_RECV) {
+    if (PL_op->op_type == OP_RECV) {
 	char namebuf[MAXPATHLEN];
-#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
+#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE)
 	bufsize = sizeof (struct sockaddr_in);
 #else
 	bufsize = sizeof namebuf;
 #endif
+#ifdef OS2	/* At least Warp3+IAK: only the first byte of bufsize set */
+	if (bufsize >= 256)
+	    bufsize = 255;
+#endif
+#ifdef OS2	/* At least Warp3+IAK: only the first byte of bufsize set */
+	if (bufsize >= 256)
+	    bufsize = 255;
+#endif
 	buffer = SvGROW(bufsv, length+1);
 	/* 'offset' means 'flags' here */
 	length = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
@@ -1255,12 +1500,12 @@ PP(pp_sysread)
 	RETURN;
     }
 #else
-    if (op->op_type == OP_RECV)
-	DIE(no_sock_func, "recv");
+    if (PL_op->op_type == OP_RECV)
+	DIE(aTHX_ PL_no_sock_func, "recv");
 #endif
     if (offset < 0) {
 	if (-offset > blen)
-	    DIE("Offset outside string");
+	    DIE(aTHX_ "Offset outside string");
 	offset += blen;
     }
     bufsize = SvCUR(bufsv);
@@ -1268,8 +1513,18 @@ PP(pp_sysread)
     if (offset > bufsize) { /* Zero any newly allocated space */
     	Zero(buffer+bufsize, offset-bufsize, char);
     }
-    if (op->op_type == OP_SYSREAD) {
-	length = PerlLIO_read(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
+    if (PL_op->op_type == OP_SYSREAD) {
+#ifdef PERL_SOCK_SYSREAD_IS_RECV
+	if (IoTYPE(io) == 's') {
+	    length = PerlSock_recv(PerlIO_fileno(IoIFP(io)),
+				   buffer+offset, length, 0);
+	}
+	else
+#endif
+	{
+	    length = PerlLIO_read(PerlIO_fileno(IoIFP(io)),
+				  buffer+offset, length);
+	}
     }
     else
 #ifdef HAS_SOCKET__bad_code_maybe
@@ -1285,9 +1540,23 @@ PP(pp_sysread)
     }
     else
 #endif
+    {
 	length = PerlIO_read(IoIFP(io), buffer+offset, length);
-    if (length < 0)
+	/* fread() returns 0 on both error and EOF */
+	if (length == 0 && PerlIO_error(IoIFP(io)))
+	    length = -1;
+    }
+    if (length < 0) {
+	if ((IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+	    || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO))
+	{
+	    SV* sv = sv_newmortal();
+	    gv_efullname3(sv, gv, Nullch);
+	    Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
+			SvPV_nolen(sv));
+	}
 	goto say_undef;
+    }
     SvCUR_set(bufsv, length+offset);
     *SvEND(bufsv) = '\0';
     (void)SvPOK_only(bufsv);
@@ -1306,7 +1575,16 @@ PP(pp_sysread)
 
 PP(pp_syswrite)
 {
-    return pp_send(ARGS);
+    djSP;
+    int items = (SP - PL_stack_base) - TOPMARK;
+    if (items == 2) {
+	SV *sv;
+        EXTEND(SP, 1);
+	sv = sv_2mortal(newSViv(sv_len(*SP)));
+	PUSHs(sv);
+        PUTBACK;
+    }
+    return pp_send();
 }
 
 PP(pp_send)
@@ -1319,40 +1597,66 @@ PP(pp_send)
     char *buffer;
     int length;
     STRLEN blen;
+    MAGIC *mg;
 
     gv = (GV*)*++MARK;
+    if (PL_op->op_type == OP_SYSWRITE && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+	SV *sv;
+	
+	PUSHMARK(MARK-1);
+	*MARK = SvTIED_obj((SV*)gv, mg);
+	ENTER;
+	call_method("WRITE", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	sv = POPs;
+	SP = ORIGMARK;
+	PUSHs(sv);
+	RETURN;
+    }
     if (!gv)
 	goto say_undef;
     bufsv = *++MARK;
     buffer = SvPV(bufsv, blen);
     length = SvIVx(*++MARK);
     if (length < 0)
-	DIE("Negative length");
+	DIE(aTHX_ "Negative length");
     SETERRNO(0,0);
     io = GvIO(gv);
     if (!io || !IoIFP(io)) {
 	length = -1;
-	if (dowarn) {
-	    if (op->op_type == OP_SYSWRITE)
-		warn("Syswrite on closed filehandle");
+	if (ckWARN(WARN_CLOSED)) {
+	    if (PL_op->op_type == OP_SYSWRITE)
+		Perl_warner(aTHX_ WARN_CLOSED, "Syswrite on closed filehandle");
 	    else
-		warn("Send on closed socket");
+		Perl_warner(aTHX_ WARN_CLOSED, "Send on closed socket");
 	}
     }
-    else if (op->op_type == OP_SYSWRITE) {
+    else if (PL_op->op_type == OP_SYSWRITE) {
 	if (MARK < SP) {
 	    offset = SvIVx(*++MARK);
 	    if (offset < 0) {
 		if (-offset > blen)
-		    DIE("Offset outside string");
+		    DIE(aTHX_ "Offset outside string");
 		offset += blen;
 	    } else if (offset >= blen && blen > 0)
-		DIE("Offset outside string");
+		DIE(aTHX_ "Offset outside string");
 	} else
 	    offset = 0;
 	if (length > blen - offset)
 	    length = blen - offset;
-	length = PerlLIO_write(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
+#ifdef PERL_SOCK_SYSWRITE_IS_SEND
+	if (IoTYPE(io) == 's') {
+	    length = PerlSock_send(PerlIO_fileno(IoIFP(io)),
+				   buffer+offset, length, 0);
+	}
+	else
+#endif
+	{
+	    /* See the note at doio.c:do_print about filesize limits. --jhi */
+	    length = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
+				   buffer+offset, length);
+	}
     }
 #ifdef HAS_SOCKET
     else if (SP > MARK) {
@@ -1367,7 +1671,7 @@ PP(pp_send)
 
 #else
     else
-	DIE(no_sock_func, "send");
+	DIE(aTHX_ PL_no_sock_func, "send");
 #endif
     if (length < 0)
 	goto say_undef;
@@ -1382,18 +1686,31 @@ PP(pp_send)
 
 PP(pp_recv)
 {
-    return pp_sysread(ARGS);
+    return pp_sysread();
 }
 
 PP(pp_eof)
 {
     djSP;
     GV *gv;
+    MAGIC *mg;
 
     if (MAXARG <= 0)
-	gv = last_in_gv;
+	gv = PL_last_in_gv;
     else
-	gv = last_in_gv = (GV*)POPs;
+	gv = PL_last_in_gv = (GV*)POPs;
+
+    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+	PUSHMARK(SP);
+	XPUSHs(SvTIED_obj((SV*)gv, mg));
+	PUTBACK;
+	ENTER;
+	call_method("EOF", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	RETURN;
+    }
+
     PUSHs(boolSV(!gv || do_eof(gv)));
     RETURN;
 }
@@ -1401,19 +1718,32 @@ PP(pp_eof)
 PP(pp_tell)
 {
     djSP; dTARGET;
-    GV *gv;
+    GV *gv;     
+    MAGIC *mg;
 
     if (MAXARG <= 0)
-	gv = last_in_gv;
+	gv = PL_last_in_gv;
     else
-	gv = last_in_gv = (GV*)POPs;
+	gv = PL_last_in_gv = (GV*)POPs;
+
+    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+	PUSHMARK(SP);
+	XPUSHs(SvTIED_obj((SV*)gv, mg));
+	PUTBACK;
+	ENTER;
+	call_method("TELL", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	RETURN;
+    }
+
     PUSHi( do_tell(gv) );
     RETURN;
 }
 
 PP(pp_seek)
 {
-    return pp_sysseek(ARGS);
+    return pp_sysseek();
 }
 
 PP(pp_sysseek)
@@ -1421,16 +1751,31 @@ PP(pp_sysseek)
     djSP;
     GV *gv;
     int whence = POPi;
-    long offset = POPl;
+    Off_t offset = (Off_t)SvIVx(POPs);
+    MAGIC *mg;
+
+    gv = PL_last_in_gv = (GV*)POPs;
 
-    gv = last_in_gv = (GV*)POPs;
-    if (op->op_type == OP_SEEK)
+    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+	PUSHMARK(SP);
+	XPUSHs(SvTIED_obj((SV*)gv, mg));
+	XPUSHs(sv_2mortal(newSViv((IV) offset)));
+	XPUSHs(sv_2mortal(newSViv((IV) whence)));
+	PUTBACK;
+	ENTER;
+	call_method("SEEK", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	RETURN;
+    }
+
+    if (PL_op->op_type == OP_SEEK)
 	PUSHs(boolSV(do_seek(gv, offset, whence)));
     else {
-	long n = do_sysseek(gv, offset, whence);
-	PUSHs((n < 0) ? &sv_undef
+	Off_t n = do_sysseek(gv, offset, whence);
+	PUSHs((n < 0) ? &PL_sv_undef
 	      : sv_2mortal(n ? newSViv((IV)n)
-			   : newSVpv(zero_but_true, ZBTLEN)));
+			   : newSVpvn(zero_but_true, ZBTLEN)));
     }
     RETURN;
 }
@@ -1441,11 +1786,12 @@ PP(pp_truncate)
     Off_t len = (Off_t)POPn;
     int result = 1;
     GV *tmpgv;
+    STRLEN n_a;
 
     SETERRNO(0,0);
 #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
-    if (op->op_flags & OPf_SPECIAL) {
-	tmpgv = gv_fetchpv(POPp, FALSE, SVt_PVIO);
+    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)) ||
@@ -1459,6 +1805,7 @@ PP(pp_truncate)
     else {
 	SV *sv = POPs;
 	char *name;
+	STRLEN n_a;
 
 	if (SvTYPE(sv) == SVt_PVGV) {
 	    tmpgv = (GV*)sv;		/* *main::FRED for example */
@@ -1469,7 +1816,7 @@ PP(pp_truncate)
 	    goto do_ftruncate;
 	}
 
-	name = SvPV(sv, na);
+	name = SvPV(sv, n_a);
 	TAINT_PROPER("truncate");
 #ifdef HAS_TRUNCATE
 	if (truncate(name, len) < 0)
@@ -1494,13 +1841,13 @@ PP(pp_truncate)
 	SETERRNO(EBADF,RMS$_IFI);
     RETPUSHUNDEF;
 #else
-    DIE("truncate not implemented");
+    DIE(aTHX_ "truncate not implemented");
 #endif
 }
 
 PP(pp_fcntl)
 {
-    return pp_ioctl(ARGS);
+    return pp_ioctl();
 }
 
 PP(pp_ioctl)
@@ -1508,7 +1855,7 @@ PP(pp_ioctl)
     djSP; dTARGET;
     SV *argsv = POPs;
     unsigned int func = U_I(POPn);
-    int optype = op->op_type;
+    int optype = PL_op->op_type;
     char *s;
     IV retval;
     GV *gv = (GV*)POPs;
@@ -1533,7 +1880,7 @@ PP(pp_ioctl)
     }
     else {
 	retval = SvIV(argsv);
-	s = (char*)retval;		/* ouch */
+	s = INT2PTR(char*,retval);		/* ouch */
     }
 
     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
@@ -1542,7 +1889,7 @@ PP(pp_ioctl)
 #ifdef HAS_IOCTL
 	retval = PerlLIO_ioctl(PerlIO_fileno(IoIFP(io)), func, s);
 #else
-	DIE("ioctl is not implemented");
+	DIE(aTHX_ "ioctl is not implemented");
 #endif
     else
 #ifdef HAS_FCNTL
@@ -1552,13 +1899,13 @@ PP(pp_ioctl)
 	retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
 #endif 
 #else
-	DIE("fcntl is not implemented");
+	DIE(aTHX_ "fcntl is not implemented");
 #endif
 
     if (SvPOK(argsv)) {
 	if (s[SvCUR(argsv)] != 17)
-	    DIE("Possible memory corruption: %s overflowed 3rd argument",
-		op_name[optype]);
+	    DIE(aTHX_ "Possible memory corruption: %s overflowed 3rd argument",
+		PL_op_name[optype]);
 	s[SvCUR(argsv)] = 0;		/* put our null back */
 	SvSETMAGIC(argsv);		/* Assume it has changed */
     }
@@ -1585,7 +1932,7 @@ PP(pp_flock)
 #ifdef FLOCK
     argtype = POPi;
     if (MAXARG <= 0)
-	gv = last_in_gv;
+	gv = PL_last_in_gv;
     else
 	gv = (GV*)POPs;
     if (gv && GvIO(gv))
@@ -1601,7 +1948,7 @@ PP(pp_flock)
     PUSHi(value);
     RETURN;
 #else
-    DIE(no_func, "flock()");
+    DIE(aTHX_ PL_no_func, "flock()");
 #endif
 }
 
@@ -1645,7 +1992,7 @@ PP(pp_socket)
 
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "socket");
+    DIE(aTHX_ PL_no_sock_func, "socket");
 #endif
 }
 
@@ -1695,7 +2042,7 @@ PP(pp_sockpair)
 
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "socketpair");
+    DIE(aTHX_ PL_no_sock_func, "socketpair");
 #endif
 }
 
@@ -1703,29 +2050,58 @@ PP(pp_bind)
 {
     djSP;
 #ifdef HAS_SOCKET
+#ifdef MPE /* Requires PRIV mode to bind() to ports < 1024 */
+    extern GETPRIVMODE();
+    extern GETUSERMODE();
+#endif
     SV *addrsv = POPs;
     char *addr;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
     STRLEN len;
+    int bind_ok = 0;
+#ifdef MPE
+    int mpeprivmode = 0;
+#endif
 
     if (!io || !IoIFP(io))
 	goto nuts;
 
     addr = SvPV(addrsv, len);
     TAINT_PROPER("bind");
-    if (PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+#ifdef MPE /* Deal with MPE bind() peculiarities */
+    if (((struct sockaddr *)addr)->sa_family == AF_INET) {
+        /* The address *MUST* stupidly be zero. */
+        ((struct sockaddr_in *)addr)->sin_addr.s_addr = INADDR_ANY;
+        /* PRIV mode is required to bind() to ports < 1024. */
+        if (((struct sockaddr_in *)addr)->sin_port < 1024 &&
+            ((struct sockaddr_in *)addr)->sin_port > 0) {
+            GETPRIVMODE(); /* If this fails, we are aborted by MPE/iX. */
+	    mpeprivmode = 1;
+	}
+    }
+#endif /* MPE */
+    if (PerlSock_bind(PerlIO_fileno(IoIFP(io)),
+		      (struct sockaddr *)addr, len) >= 0)
+	bind_ok = 1;
+
+#ifdef MPE /* Switch back to USER mode */
+    if (mpeprivmode)
+	GETUSERMODE();
+#endif /* MPE */
+
+    if (bind_ok)
 	RETPUSHYES;
     else
 	RETPUSHUNDEF;
 
 nuts:
-    if (dowarn)
-	warn("bind() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
-    DIE(no_sock_func, "bind");
+    DIE(aTHX_ PL_no_sock_func, "bind");
 #endif
 }
 
@@ -1750,12 +2126,12 @@ PP(pp_connect)
 	RETPUSHUNDEF;
 
 nuts:
-    if (dowarn)
-	warn("connect() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
-    DIE(no_sock_func, "connect");
+    DIE(aTHX_ PL_no_sock_func, "connect");
 #endif
 }
 
@@ -1776,12 +2152,12 @@ PP(pp_listen)
 	RETPUSHUNDEF;
 
 nuts:
-    if (dowarn)
-	warn("listen() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
-    DIE(no_sock_func, "listen");
+    DIE(aTHX_ PL_no_sock_func, "listen");
 #endif
 }
 
@@ -1830,15 +2206,15 @@ PP(pp_accept)
     RETURN;
 
 nuts:
-    if (dowarn)
-	warn("accept() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
 
 badexit:
     RETPUSHUNDEF;
 
 #else
-    DIE(no_sock_func, "accept");
+    DIE(aTHX_ PL_no_sock_func, "accept");
 #endif
 }
 
@@ -1857,21 +2233,21 @@ PP(pp_shutdown)
     RETURN;
 
 nuts:
-    if (dowarn)
-	warn("shutdown() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
-    DIE(no_sock_func, "shutdown");
+    DIE(aTHX_ PL_no_sock_func, "shutdown");
 #endif
 }
 
 PP(pp_gsockopt)
 {
 #ifdef HAS_SOCKET
-    return pp_ssockopt(ARGS);
+    return pp_ssockopt();
 #else
-    DIE(no_sock_func, "getsockopt");
+    DIE(aTHX_ PL_no_sock_func, "getsockopt");
 #endif
 }
 
@@ -1879,7 +2255,7 @@ PP(pp_ssockopt)
 {
     djSP;
 #ifdef HAS_SOCKET
-    int optype = op->op_type;
+    int optype = PL_op->op_type;
     SV *sv;
     int fd;
     unsigned int optname;
@@ -1918,40 +2294,41 @@ PP(pp_ssockopt)
 	    char *buf;
 	    int aint;
 	    if (SvPOKp(sv)) {
-		buf = SvPV(sv, na);
-		len = na;
+		STRLEN l;
+		buf = SvPV(sv, l);
+		len = l;
 	    }
-	    else if (SvOK(sv)) {
+	    else {
 		aint = (int)SvIV(sv);
 		buf = (char*)&aint;
 		len = sizeof(int);
 	    }
 	    if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
 		goto nuts2;
-	    PUSHs(&sv_yes);
+	    PUSHs(&PL_sv_yes);
 	}
 	break;
     }
     RETURN;
 
 nuts:
-    if (dowarn)
-	warn("[gs]etsockopt() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	Perl_warner(aTHX_ WARN_CLOSED, "[gs]etsockopt() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
 
 #else
-    DIE(no_sock_func, "setsockopt");
+    DIE(aTHX_ PL_no_sock_func, "setsockopt");
 #endif
 }
 
 PP(pp_getsockname)
 {
 #ifdef HAS_SOCKET
-    return pp_getpeername(ARGS);
+    return pp_getpeername();
 #else
-    DIE(no_sock_func, "getsockname");
+    DIE(aTHX_ PL_no_sock_func, "getsockname");
 #endif
 }
 
@@ -1959,7 +2336,7 @@ PP(pp_getpeername)
 {
     djSP;
 #ifdef HAS_SOCKET
-    int optype = op->op_type;
+    int optype = PL_op->op_type;
     SV *sv;
     int fd;
     GV *gv = (GV*)POPs;
@@ -2008,14 +2385,14 @@ PP(pp_getpeername)
     RETURN;
 
 nuts:
-    if (dowarn)
-	warn("get{sock, peer}name() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	Perl_warner(aTHX_ WARN_CLOSED, "get{sock, peer}name() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
 
 #else
-    DIE(no_sock_func, "getpeername");
+    DIE(aTHX_ PL_no_sock_func, "getpeername");
 #endif
 }
 
@@ -2023,7 +2400,7 @@ nuts2:
 
 PP(pp_lstat)
 {
-    return pp_stat(ARGS);
+    return pp_stat();
 }
 
 PP(pp_stat)
@@ -2032,18 +2409,19 @@ PP(pp_stat)
     GV *tmpgv;
     I32 gimme;
     I32 max = 13;
+    STRLEN n_a;
 
-    if (op->op_flags & OPf_REF) {
-	tmpgv = cGVOP->op_gv;
+    if (PL_op->op_flags & OPf_REF) {
+	tmpgv = cGVOP;
       do_fstat:
-	if (tmpgv != defgv) {
-	    laststype = OP_STAT;
-	    statgv = tmpgv;
-	    sv_setpv(statname, "");
-	    laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv))
-		? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) : -1);
+	if (tmpgv != PL_defgv) {
+	    PL_laststype = OP_STAT;
+	    PL_statgv = tmpgv;
+	    sv_setpv(PL_statname, "");
+	    PL_laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv))
+		? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &PL_statcache) : -1);
 	}
-	if (laststatval < 0)
+	if (PL_laststatval < 0)
 	    max = 0;
     }
     else {
@@ -2056,18 +2434,18 @@ PP(pp_stat)
 	    tmpgv = (GV*)SvRV(sv);
 	    goto do_fstat;
 	}
-	sv_setpv(statname, SvPV(sv,na));
-	statgv = Nullgv;
+	sv_setpv(PL_statname, SvPV(sv,n_a));
+	PL_statgv = Nullgv;
 #ifdef HAS_LSTAT
-	laststype = op->op_type;
-	if (op->op_type == OP_LSTAT)
-	    laststatval = PerlLIO_lstat(SvPV(statname, na), &statcache);
+	PL_laststype = PL_op->op_type;
+	if (PL_op->op_type == OP_LSTAT)
+	    PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache);
 	else
 #endif
-	    laststatval = PerlLIO_stat(SvPV(statname, na), &statcache);
-	if (laststatval < 0) {
-	    if (dowarn && strchr(SvPV(statname, na), '\n'))
-		warn(warn_nl, "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");
 	    max = 0;
 	}
     }
@@ -2081,33 +2459,33 @@ PP(pp_stat)
     if (max) {
 	EXTEND(SP, max);
 	EXTEND_MORTAL(max);
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_dev)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_ino)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_mode)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_nlink)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_uid)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_gid)));
 #ifdef USE_STAT_RDEV
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev)));
 #else
-	PUSHs(sv_2mortal(newSVpv("", 0)));
+	PUSHs(sv_2mortal(newSVpvn("", 0)));
 #endif
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_size)));
 #ifdef BIG_TIME
-	PUSHs(sv_2mortal(newSVnv((U32)statcache.st_atime)));
-	PUSHs(sv_2mortal(newSVnv((U32)statcache.st_mtime)));
-	PUSHs(sv_2mortal(newSVnv((U32)statcache.st_ctime)));
+	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_atime)));
+	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime)));
+	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_ctime)));
 #else
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime)));
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_atime)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_mtime)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_ctime)));
 #endif
 #ifdef USE_STAT_BLOCKS
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
-	PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_blksize)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_blocks)));
 #else
-	PUSHs(sv_2mortal(newSVpv("", 0)));
-	PUSHs(sv_2mortal(newSVpv("", 0)));
+	PUSHs(sv_2mortal(newSVpvn("", 0)));
+	PUSHs(sv_2mortal(newSVpvn("", 0)));
 #endif
     }
     RETURN;
@@ -2115,73 +2493,169 @@ PP(pp_stat)
 
 PP(pp_ftrread)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#if defined(HAS_ACCESS) && defined(R_OK)
+    STRLEN n_a;
+    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+	result = access(TOPpx, R_OK);
+	if (result == 0)
+	    RETPUSHYES;
+	if (result < 0)
+	    RETPUSHUNDEF;
+	RETPUSHNO;
+    }
+    else
+	result = my_stat();
+#else
+    result = my_stat();
+#endif
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (cando(S_IRUSR, 0, &statcache))
+    if (cando(S_IRUSR, 0, &PL_statcache))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftrwrite)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#if defined(HAS_ACCESS) && defined(W_OK)
+    STRLEN n_a;
+    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+	result = access(TOPpx, W_OK);
+	if (result == 0)
+	    RETPUSHYES;
+	if (result < 0)
+	    RETPUSHUNDEF;
+	RETPUSHNO;
+    }
+    else
+	result = my_stat();
+#else
+    result = my_stat();
+#endif
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (cando(S_IWUSR, 0, &statcache))
+    if (cando(S_IWUSR, 0, &PL_statcache))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftrexec)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#if defined(HAS_ACCESS) && defined(X_OK)
+    STRLEN n_a;
+    if ((PL_hints & HINT_FILETEST_ACCESS) && SvPOK(TOPs)) {
+	result = access(TOPpx, X_OK);
+	if (result == 0)
+	    RETPUSHYES;
+	if (result < 0)
+	    RETPUSHUNDEF;
+	RETPUSHNO;
+    }
+    else
+	result = my_stat();
+#else
+    result = my_stat();
+#endif
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (cando(S_IXUSR, 0, &statcache))
+    if (cando(S_IXUSR, 0, &PL_statcache))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_fteread)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#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 (result == 0)
+	    RETPUSHYES;
+	if (result < 0)
+	    RETPUSHUNDEF;
+	RETPUSHNO;
+    }
+    else
+	result = my_stat();
+#else
+    result = my_stat();
+#endif
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (cando(S_IRUSR, 1, &statcache))
+    if (cando(S_IRUSR, 1, &PL_statcache))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftewrite)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#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 (result == 0)
+	    RETPUSHYES;
+	if (result < 0)
+	    RETPUSHUNDEF;
+	RETPUSHNO;
+    }
+    else
+	result = my_stat();
+#else
+    result = my_stat();
+#endif
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (cando(S_IWUSR, 1, &statcache))
+    if (cando(S_IWUSR, 1, &PL_statcache))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_fteexec)
 {
-    I32 result = my_stat(ARGS);
+    I32 result;
     djSP;
+#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 (result == 0)
+	    RETPUSHYES;
+	if (result < 0)
+	    RETPUSHUNDEF;
+	RETPUSHNO;
+    }
+    else
+	result = my_stat();
+#else
+    result = my_stat();
+#endif
+    SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (cando(S_IXUSR, 1, &statcache))
+    if (cando(S_IXUSR, 1, &PL_statcache))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftis)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
@@ -2190,144 +2664,144 @@ PP(pp_ftis)
 
 PP(pp_fteowned)
 {
-    return pp_ftrowned(ARGS);
+    return pp_ftrowned();
 }
 
 PP(pp_ftrowned)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
+    if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ? PL_euid : PL_uid) )
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftzero)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (!statcache.st_size)
+    if (!PL_statcache.st_size)
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftsize)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHi(statcache.st_size);
+    PUSHi(PL_statcache.st_size);
     RETURN;
 }
 
 PP(pp_ftmtime)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( ((I32)basetime - (I32)statcache.st_mtime) / 86400.0 );
+    PUSHn( (PL_basetime - PL_statcache.st_mtime) / 86400.0 );
     RETURN;
 }
 
 PP(pp_ftatime)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( ((I32)basetime - (I32)statcache.st_atime) / 86400.0 );
+    PUSHn( (PL_basetime - PL_statcache.st_atime) / 86400.0 );
     RETURN;
 }
 
 PP(pp_ftctime)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( ((I32)basetime - (I32)statcache.st_ctime) / 86400.0 );
+    PUSHn( (PL_basetime - PL_statcache.st_ctime) / 86400.0 );
     RETURN;
 }
 
 PP(pp_ftsock)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (S_ISSOCK(statcache.st_mode))
+    if (S_ISSOCK(PL_statcache.st_mode))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftchr)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (S_ISCHR(statcache.st_mode))
+    if (S_ISCHR(PL_statcache.st_mode))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftblk)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (S_ISBLK(statcache.st_mode))
+    if (S_ISBLK(PL_statcache.st_mode))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftfile)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (S_ISREG(statcache.st_mode))
+    if (S_ISREG(PL_statcache.st_mode))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftdir)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (S_ISDIR(statcache.st_mode))
+    if (S_ISDIR(PL_statcache.st_mode))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftpipe)
 {
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (S_ISFIFO(statcache.st_mode))
+    if (S_ISFIFO(PL_statcache.st_mode))
 	RETPUSHYES;
     RETPUSHNO;
 }
 
 PP(pp_ftlink)
 {
-    I32 result = my_lstat(ARGS);
+    I32 result = my_lstat();
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (S_ISLNK(statcache.st_mode))
+    if (S_ISLNK(PL_statcache.st_mode))
 	RETPUSHYES;
     RETPUSHNO;
 }
@@ -2336,11 +2810,11 @@ PP(pp_ftsuid)
 {
     djSP;
 #ifdef S_ISUID
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (statcache.st_mode & S_ISUID)
+    if (PL_statcache.st_mode & S_ISUID)
 	RETPUSHYES;
 #endif
     RETPUSHNO;
@@ -2350,11 +2824,11 @@ PP(pp_ftsgid)
 {
     djSP;
 #ifdef S_ISGID
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (statcache.st_mode & S_ISGID)
+    if (PL_statcache.st_mode & S_ISGID)
 	RETPUSHYES;
 #endif
     RETPUSHNO;
@@ -2364,11 +2838,11 @@ PP(pp_ftsvtx)
 {
     djSP;
 #ifdef S_ISVTX
-    I32 result = my_stat(ARGS);
+    I32 result = my_stat();
     SPAGAIN;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (statcache.st_mode & S_ISVTX)
+    if (PL_statcache.st_mode & S_ISVTX)
 	RETPUSHYES;
 #endif
     RETPUSHNO;
@@ -2380,15 +2854,16 @@ PP(pp_fttty)
     int fd;
     GV *gv;
     char *tmps = Nullch;
+    STRLEN n_a;
 
-    if (op->op_flags & OPf_REF)
-	gv = cGVOP->op_gv;
+    if (PL_op->op_flags & OPf_REF)
+	gv = cGVOP;
     else if (isGV(TOPs))
 	gv = (GV*)POPs;
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
 	gv = (GV*)SvRV(POPs);
     else
-	gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
+	gv = gv_fetchpv(tmps = POPpx, FALSE, SVt_PVIO);
 
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
 	fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
@@ -2420,9 +2895,10 @@ PP(pp_fttext)
     register IO *io;
     register SV *sv;
     GV *gv;
+    STRLEN n_a;
 
-    if (op->op_flags & OPf_REF)
-	gv = cGVOP->op_gv;
+    if (PL_op->op_flags & OPf_REF)
+	gv = cGVOP;
     else if (isGV(TOPs))
 	gv = (GV*)POPs;
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
@@ -2432,28 +2908,28 @@ PP(pp_fttext)
 
     if (gv) {
 	EXTEND(SP, 1);
-	if (gv == defgv) {
-	    if (statgv)
-		io = GvIO(statgv);
+	if (gv == PL_defgv) {
+	    if (PL_statgv)
+		io = GvIO(PL_statgv);
 	    else {
-		sv = statname;
+		sv = PL_statname;
 		goto really_filename;
 	    }
 	}
 	else {
-	    statgv = gv;
-	    laststatval = -1;
-	    sv_setpv(statname, "");
-	    io = GvIO(statgv);
+	    PL_statgv = gv;
+	    PL_laststatval = -1;
+	    sv_setpv(PL_statname, "");
+	    io = GvIO(PL_statgv);
 	}
 	if (io && IoIFP(io)) {
 	    if (! PerlIO_has_base(IoIFP(io)))
-		DIE("-T and -B not implemented on filehandles");
-	    laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &statcache);
-	    if (laststatval < 0)
+		DIE(aTHX_ "-T and -B not implemented on filehandles");
+	    PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);
+	    if (PL_laststatval < 0)
 		RETPUSHUNDEF;
-	    if (S_ISDIR(statcache.st_mode))	/* handle NFS glitch */
-		if (op->op_type == OP_FTTEXT)
+	    if (S_ISDIR(PL_statcache.st_mode))	/* handle NFS glitch */
+		if (PL_op->op_type == OP_FTTEXT)
 		    RETPUSHNO;
 		else
 		    RETPUSHYES;
@@ -2471,9 +2947,9 @@ PP(pp_fttext)
 		len = 512;
 	}
 	else {
-	    if (dowarn)
-		warn("Test on unopened file <%s>",
-		  GvENAME(cGVOP->op_gv));
+	    if (ckWARN(WARN_UNOPENED))
+		Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file <%s>",
+			    GvENAME(cGVOP));
 	    SETERRNO(EBADF,RMS$_IFI);
 	    RETPUSHUNDEF;
 	}
@@ -2481,26 +2957,26 @@ PP(pp_fttext)
     else {
 	sv = POPs;
       really_filename:
-	statgv = Nullgv;
-	laststatval = -1;
-	sv_setpv(statname, SvPV(sv, na));
+	PL_statgv = Nullgv;
+	PL_laststatval = -1;
+	sv_setpv(PL_statname, SvPV(sv, n_a));
 #ifdef HAS_OPEN3
-	i = PerlLIO_open3(SvPV(sv, na), O_RDONLY, 0);
+	i = PerlLIO_open3(SvPV(sv, n_a), O_RDONLY, 0);
 #else
-	i = PerlLIO_open(SvPV(sv, na), 0);
+	i = PerlLIO_open(SvPV(sv, n_a), 0);
 #endif
 	if (i < 0) {
-	    if (dowarn && strchr(SvPV(sv, na), '\n'))
-		warn(warn_nl, "open");
+	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
+		Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
 	    RETPUSHUNDEF;
 	}
-	laststatval = PerlLIO_fstat(i, &statcache);
-	if (laststatval < 0)
+	PL_laststatval = PerlLIO_fstat(i, &PL_statcache);
+	if (PL_laststatval < 0)
 	    RETPUSHUNDEF;
 	len = PerlLIO_read(i, tbuf, 512);
 	(void)PerlLIO_close(i);
 	if (len <= 0) {
-	    if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
+	    if (S_ISDIR(PL_statcache.st_mode) && PL_op->op_type == OP_FTTEXT)
 		RETPUSHNO;		/* special case NFS directories */
 	    RETPUSHYES;		/* null file is anything */
 	}
@@ -2515,15 +2991,20 @@ PP(pp_fttext)
 	    odd += len;
 	    break;
 	}
+#ifdef EBCDIC
+        else if (!(isPRINT(*s) || isSPACE(*s))) 
+            odd++;
+#else
 	else if (*s & 128)
 	    odd++;
 	else if (*s < 32 &&
 	  *s != '\n' && *s != '\r' && *s != '\b' &&
 	  *s != '\t' && *s != '\f' && *s != 27)
 	    odd++;
+#endif
     }
 
-    if ((odd * 3 > len) == (op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
+    if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
 	RETPUSHNO;
     else
 	RETPUSHYES;
@@ -2531,7 +3012,7 @@ PP(pp_fttext)
 
 PP(pp_ftbinary)
 {
-    return pp_fttext(ARGS);
+    return pp_fttext();
 }
 
 /* File calls. */
@@ -2541,27 +3022,35 @@ PP(pp_chdir)
     djSP; dTARGET;
     char *tmps;
     SV **svp;
+    STRLEN n_a;
 
     if (MAXARG < 1)
 	tmps = Nullch;
     else
-	tmps = POPp;
+	tmps = POPpx;
     if (!tmps || !*tmps) {
-	svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE);
+	svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE);
 	if (svp)
-	    tmps = SvPV(*svp, na);
+	    tmps = SvPV(*svp, n_a);
     }
     if (!tmps || !*tmps) {
-	svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE);
+	svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE);
 	if (svp)
-	    tmps = SvPV(*svp, na);
+	    tmps = SvPV(*svp, n_a);
+    }
+#ifdef VMS
+    if (!tmps || !*tmps) {
+       svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE);
+       if (svp)
+           tmps = SvPV(*svp, n_a);
     }
+#endif
     TAINT_PROPER("chdir");
     PUSHi( PerlDir_chdir(tmps) >= 0 );
 #ifdef VMS
     /* Clear the DEFAULT element of ENV so we'll get the new value
      * in the future. */
-    hv_delete(GvHVn(envgv),"DEFAULT",7,G_DISCARD);
+    hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD);
 #endif
     RETURN;
 }
@@ -2571,12 +3060,12 @@ PP(pp_chown)
     djSP; dMARK; dTARGET;
     I32 value;
 #ifdef HAS_CHOWN
-    value = (I32)apply(op->op_type, MARK, SP);
+    value = (I32)apply(PL_op->op_type, MARK, SP);
     SP = MARK;
     PUSHi(value);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function chown");
+    DIE(aTHX_ PL_no_func, "Unsupported function chown");
 #endif
 }
 
@@ -2585,12 +3074,13 @@ PP(pp_chroot)
     djSP; dTARGET;
     char *tmps;
 #ifdef HAS_CHROOT
-    tmps = POPp;
+    STRLEN n_a;
+    tmps = POPpx;
     TAINT_PROPER("chroot");
     PUSHi( chroot(tmps) >= 0 );
     RETURN;
 #else
-    DIE(no_func, "chroot");
+    DIE(aTHX_ PL_no_func, "chroot");
 #endif
 }
 
@@ -2598,7 +3088,7 @@ PP(pp_unlink)
 {
     djSP; dMARK; dTARGET;
     I32 value;
-    value = (I32)apply(op->op_type, MARK, SP);
+    value = (I32)apply(PL_op->op_type, MARK, SP);
     SP = MARK;
     PUSHi(value);
     RETURN;
@@ -2608,7 +3098,7 @@ PP(pp_chmod)
 {
     djSP; dMARK; dTARGET;
     I32 value;
-    value = (I32)apply(op->op_type, MARK, SP);
+    value = (I32)apply(PL_op->op_type, MARK, SP);
     SP = MARK;
     PUSHi(value);
     RETURN;
@@ -2618,7 +3108,7 @@ PP(pp_utime)
 {
     djSP; dMARK; dTARGET;
     I32 value;
-    value = (I32)apply(op->op_type, MARK, SP);
+    value = (I32)apply(PL_op->op_type, MARK, SP);
     SP = MARK;
     PUSHi(value);
     RETURN;
@@ -2628,18 +3118,19 @@ PP(pp_rename)
 {
     djSP; dTARGET;
     int anum;
+    STRLEN n_a;
 
-    char *tmps2 = POPp;
-    char *tmps = SvPV(TOPs, na);
+    char *tmps2 = POPpx;
+    char *tmps = SvPV(TOPs, n_a);
     TAINT_PROPER("rename");
 #ifdef HAS_RENAME
-    anum = rename(tmps, tmps2);
+    anum = PerlLIO_rename(tmps, tmps2);
 #else
-    if (!(anum = Stat(tmps, &statbuf))) {
+    if (!(anum = PerlLIO_stat(tmps, &PL_statbuf))) {
 	if (same_dirent(tmps2, tmps))	/* can always rename to same name */
 	    anum = 1;
 	else {
-	    if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
+	    if (PL_euid || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode))
 		(void)UNLINK(tmps2);
 	    if (!(anum = link(tmps, tmps2)))
 		anum = UNLINK(tmps);
@@ -2654,12 +3145,13 @@ PP(pp_link)
 {
     djSP; dTARGET;
 #ifdef HAS_LINK
-    char *tmps2 = POPp;
-    char *tmps = SvPV(TOPs, na);
+    STRLEN n_a;
+    char *tmps2 = POPpx;
+    char *tmps = SvPV(TOPs, n_a);
     TAINT_PROPER("link");
     SETi( link(tmps, tmps2) >= 0 );
 #else
-    DIE(no_func, "Unsupported function link");
+    DIE(aTHX_ PL_no_func, "Unsupported function link");
 #endif
     RETURN;
 }
@@ -2668,13 +3160,14 @@ PP(pp_symlink)
 {
     djSP; dTARGET;
 #ifdef HAS_SYMLINK
-    char *tmps2 = POPp;
-    char *tmps = SvPV(TOPs, na);
+    STRLEN n_a;
+    char *tmps2 = POPpx;
+    char *tmps = SvPV(TOPs, n_a);
     TAINT_PROPER("symlink");
     SETi( symlink(tmps, tmps2) >= 0 );
     RETURN;
 #else
-    DIE(no_func, "symlink");
+    DIE(aTHX_ PL_no_func, "symlink");
 #endif
 }
 
@@ -2685,11 +3178,12 @@ PP(pp_readlink)
     char *tmps;
     char buf[MAXPATHLEN];
     int len;
+    STRLEN n_a;
 
 #ifndef INCOMPLETE_TAINTS
     TAINT;
 #endif
-    tmps = POPp;
+    tmps = POPpx;
     len = readlink(tmps, buf, sizeof buf);
     EXTEND(SP, 1);
     if (len < 0)
@@ -2703,10 +3197,8 @@ PP(pp_readlink)
 }
 
 #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
-static int
-dooneliner(cmd, filename)
-char *cmd;
-char *filename;
+STATIC int
+S_dooneliner(pTHX_ char *cmd, char *filename)
 {
     char *save_filename = filename;
     char *cmdline;
@@ -2727,7 +3219,7 @@ char *filename;
 
     if (myfp) {
 	SV *tmpsv = sv_newmortal();
-	/* Need to save/restore 'rs' ?? */
+	/* Need to save/restore 'PL_rs' ?? */
 	s = sv_gets(tmpsv, myfp, 0);
 	(void)PerlProc_pclose(myfp);
 	if (s != Nullch) {
@@ -2776,8 +3268,8 @@ char *filename;
 	    return 0;
 	}
 	else {	/* some mkdirs return no failure indication */
-	    anum = (Stat(save_filename, &statbuf) >= 0);
-	    if (op->op_type == OP_RMDIR)
+	    anum = (PerlLIO_stat(save_filename, &PL_statbuf) >= 0);
+	    if (PL_op->op_type == OP_RMDIR)
 		anum = !anum;
 	    if (anum)
 		SETERRNO(0,0);
@@ -2798,7 +3290,8 @@ PP(pp_mkdir)
 #ifndef HAS_MKDIR
     int oldumask;
 #endif
-    char *tmps = SvPV(TOPs, na);
+    STRLEN n_a;
+    char *tmps = SvPV(TOPs, n_a);
 
     TAINT_PROPER("mkdir");
 #ifdef HAS_MKDIR
@@ -2816,8 +3309,9 @@ PP(pp_rmdir)
 {
     djSP; dTARGET;
     char *tmps;
+    STRLEN n_a;
 
-    tmps = POPp;
+    tmps = POPpx;
     TAINT_PROPER("rmdir");
 #ifdef HAS_RMDIR
     XPUSHi( PerlDir_rmdir(tmps) >= 0 );
@@ -2833,7 +3327,8 @@ PP(pp_open_dir)
 {
     djSP;
 #if defined(Direntry_t) && defined(HAS_READDIR)
-    char *dirname = POPp;
+    STRLEN n_a;
+    char *dirname = POPpx;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
 
@@ -2851,7 +3346,7 @@ nope:
 	SETERRNO(EBADF,RMS$_DIR);
     RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "opendir");
+    DIE(aTHX_ PL_no_dir_func, "opendir");
 #endif
 }
 
@@ -2860,7 +3355,7 @@ PP(pp_readdir)
     djSP;
 #if defined(Direntry_t) && defined(HAS_READDIR)
 #ifndef I_DIRENT
-    Direntry_t *readdir _((DIR *));
+    Direntry_t *readdir (DIR *);
 #endif
     register Direntry_t *dp;
     GV *gv = (GV*)POPs;
@@ -2874,7 +3369,7 @@ PP(pp_readdir)
 	/*SUPPRESS 560*/
 	while (dp = (Direntry_t *)PerlDir_read(IoDIRP(io))) {
 #ifdef DIRNAMLEN
-	    sv = newSVpv(dp->d_name, dp->d_namlen);
+	    sv = newSVpvn(dp->d_name, dp->d_namlen);
 #else
 	    sv = newSVpv(dp->d_name, 0);
 #endif
@@ -2888,7 +3383,7 @@ PP(pp_readdir)
 	if (!(dp = (Direntry_t *)PerlDir_read(IoDIRP(io))))
 	    goto nope;
 #ifdef DIRNAMLEN
-	sv = newSVpv(dp->d_name, dp->d_namlen);
+	sv = newSVpvn(dp->d_name, dp->d_namlen);
 #else
 	sv = newSVpv(dp->d_name, 0);
 #endif
@@ -2907,7 +3402,7 @@ nope:
     else
 	RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "readdir");
+    DIE(aTHX_ PL_no_dir_func, "readdir");
 #endif
 }
 
@@ -2915,9 +3410,13 @@ PP(pp_telldir)
 {
     djSP; dTARGET;
 #if defined(HAS_TELLDIR) || defined(telldir)
-#if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE) && !defined(DONT_DECLARE_STD)
-    long telldir _((DIR *));
-#endif
+ /* XXX does _anyone_ need this? --AD 2/20/1998 */
+ /* XXX netbsd still seemed to.
+    XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style.
+    --JHI 1999-Feb-02 */
+# if !defined(HAS_TELLDIR_PROTO) || defined(NEED_TELLDIR_PROTO)
+    long telldir (DIR *);
+# endif
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
 
@@ -2931,7 +3430,7 @@ nope:
 	SETERRNO(EBADF,RMS$_ISI);
     RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "telldir");
+    DIE(aTHX_ PL_no_dir_func, "telldir");
 #endif
 }
 
@@ -2954,7 +3453,7 @@ nope:
 	SETERRNO(EBADF,RMS$_ISI);
     RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "seekdir");
+    DIE(aTHX_ PL_no_dir_func, "seekdir");
 #endif
 }
 
@@ -2975,7 +3474,7 @@ nope:
 	SETERRNO(EBADF,RMS$_ISI);
     RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "rewinddir");
+    DIE(aTHX_ PL_no_dir_func, "rewinddir");
 #endif
 }
 
@@ -3005,7 +3504,7 @@ nope:
 	SETERRNO(EBADF,RMS$_IFI);
     RETPUSHUNDEF;
 #else
-    DIE(no_dir_func, "closedir");
+    DIE(aTHX_ PL_no_dir_func, "closedir");
 #endif
 }
 
@@ -3015,10 +3514,11 @@ PP(pp_fork)
 {
 #ifdef HAS_FORK
     djSP; dTARGET;
-    int childpid;
+    Pid_t childpid;
     GV *tmpgv;
 
     EXTEND(SP, 1);
+    PERL_FLUSHALL_FOR_CHILD;
     childpid = fork();
     if (childpid < 0)
 	RETSETUNDEF;
@@ -3026,12 +3526,12 @@ PP(pp_fork)
 	/*SUPPRESS 560*/
 	if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
 	    sv_setiv(GvSV(tmpgv), (IV)getpid());
-	hv_clear(pidstatus);	/* no kids, so don't wait for 'em */
+	hv_clear(PL_pidstatus);	/* no kids, so don't wait for 'em */
     }
     PUSHi(childpid);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function fork");
+    DIE(aTHX_ PL_no_func, "Unsupported function fork");
 #endif
 }
 
@@ -3039,7 +3539,7 @@ PP(pp_wait)
 {
 #if !defined(DOSISH) || defined(OS2) || defined(WIN32)
     djSP; dTARGET;
-    int childpid;
+    Pid_t childpid;
     int argflags;
 
     childpid = wait4pid(-1, &argflags, 0);
@@ -3047,7 +3547,7 @@ PP(pp_wait)
     XPUSHi(childpid);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function wait");
+    DIE(aTHX_ PL_no_func, "Unsupported function wait");
 #endif
 }
 
@@ -3055,7 +3555,7 @@ PP(pp_waitpid)
 {
 #if !defined(DOSISH) || defined(OS2) || defined(WIN32)
     djSP; dTARGET;
-    int childpid;
+    Pid_t childpid;
     int optype;
     int argflags;
 
@@ -3066,7 +3566,7 @@ PP(pp_waitpid)
     SETi(childpid);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function waitpid");
+    DIE(aTHX_ PL_no_func, "Unsupported function waitpid");
 #endif
 }
 
@@ -3074,29 +3574,41 @@ PP(pp_system)
 {
     djSP; dMARK; dORIGMARK; dTARGET;
     I32 value;
-    int childpid;
+    Pid_t childpid;
     int result;
     int status;
     Sigsave_t ihand,qhand;     /* place to save signals during system() */
+    STRLEN n_a;
+    I32 did_pipes = 0;
+    int pp[2];
 
     if (SP - MARK == 1) {
-	if (tainting) {
-	    char *junk = SvPV(TOPs, na);
+	if (PL_tainting) {
+	    char *junk = SvPV(TOPs, n_a);
 	    TAINT_ENV();
 	    TAINT_PROPER("system");
 	}
     }
+    PERL_FLUSHALL_FOR_CHILD;
 #if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2)
+    if (PerlProc_pipe(pp) >= 0)
+	did_pipes = 1;
     while ((childpid = vfork()) == -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]);
 	rsignal_save(SIGINT, SIG_IGN, &ihand);
 	rsignal_save(SIGQUIT, SIG_IGN, &qhand);
 	do {
@@ -3107,28 +3619,54 @@ PP(pp_system)
 	STATUS_NATIVE_SET(result == -1 ? -1 : status);
 	do_execfree();	/* free any memory child malloced on vfork */
 	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 (op->op_flags & OPf_STACKED) {
+    if (did_pipes) {
+	PerlLIO_close(pp[0]);
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+	fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+#endif
+    }
+    if (PL_op->op_flags & OPf_STACKED) {
 	SV *really = *++MARK;
-	value = (I32)do_aexec(really, MARK, SP);
+	value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
     }
     else if (SP - MARK != 1)
-	value = (I32)do_aexec(Nullsv, MARK, SP);
+	value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes);
     else {
-	value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
+	value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes);
     }
     PerlProc__exit(-1);
 #else /* ! FORK or VMS or OS/2 */
-    if (op->op_flags & OPf_STACKED) {
+    if (PL_op->op_flags & OPf_STACKED) {
 	SV *really = *++MARK;
 	value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
     }
     else if (SP - MARK != 1)
 	value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
     else {
-	value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
+	value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
     }
     STATUS_NATIVE_SET(value);
     do_execfree();
@@ -3142,8 +3680,10 @@ PP(pp_exec)
 {
     djSP; dMARK; dORIGMARK; dTARGET;
     I32 value;
+    STRLEN n_a;
 
-    if (op->op_flags & OPf_STACKED) {
+    PERL_FLUSHALL_FOR_CHILD;
+    if (PL_op->op_flags & OPf_STACKED) {
 	SV *really = *++MARK;
 	value = (I32)do_aexec(really, MARK, SP);
     }
@@ -3151,18 +3691,30 @@ PP(pp_exec)
 #ifdef VMS
 	value = (I32)vms_do_aexec(Nullsv, MARK, SP);
 #else
+#  ifdef __OPEN_VM
+	{
+	   (void ) do_aspawn(Nullsv, MARK, SP);
+	   value = 0;
+	}
+#  else
 	value = (I32)do_aexec(Nullsv, MARK, SP);
+#  endif
 #endif
     else {
-	if (tainting) {
-	    char *junk = SvPV(*SP, na);
+	if (PL_tainting) {
+	    char *junk = SvPV(*SP, n_a);
 	    TAINT_ENV();
 	    TAINT_PROPER("exec");
 	}
 #ifdef VMS
-	value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
+	value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
 #else
-	value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
+#  ifdef __OPEN_VM
+	(void) do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
+	value = 0;
+#  else
+	value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
+#  endif
 #endif
     }
     SP = ORIGMARK;
@@ -3175,12 +3727,12 @@ PP(pp_kill)
     djSP; dMARK; dTARGET;
     I32 value;
 #ifdef HAS_KILL
-    value = (I32)apply(op->op_type, MARK, SP);
+    value = (I32)apply(PL_op->op_type, MARK, SP);
     SP = MARK;
     PUSHi(value);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function kill");
+    DIE(aTHX_ PL_no_func, "Unsupported function kill");
 #endif
 }
 
@@ -3191,7 +3743,7 @@ PP(pp_getppid)
     XPUSHi( getppid() );
     RETURN;
 #else
-    DIE(no_func, "getppid");
+    DIE(aTHX_ PL_no_func, "getppid");
 #endif
 }
 
@@ -3199,24 +3751,24 @@ PP(pp_getpgrp)
 {
 #ifdef HAS_GETPGRP
     djSP; dTARGET;
-    int pid;
-    I32 value;
+    Pid_t pid;
+    Pid_t pgrp;
 
     if (MAXARG < 1)
 	pid = 0;
     else
 	pid = SvIVx(POPs);
 #ifdef BSD_GETPGRP
-    value = (I32)BSD_GETPGRP(pid);
+    pgrp = (I32)BSD_GETPGRP(pid);
 #else
     if (pid != 0 && pid != getpid())
-	DIE("POSIX getpgrp can't take an argument");
-    value = (I32)getpgrp();
+	DIE(aTHX_ "POSIX getpgrp can't take an argument");
+    pgrp = getpgrp();
 #endif
-    XPUSHi(value);
+    XPUSHi(pgrp);
     RETURN;
 #else
-    DIE(no_func, "getpgrp()");
+    DIE(aTHX_ PL_no_func, "getpgrp()");
 #endif
 }
 
@@ -3224,8 +3776,8 @@ PP(pp_setpgrp)
 {
 #ifdef HAS_SETPGRP
     djSP; dTARGET;
-    int pgrp;
-    int pid;
+    Pid_t pgrp;
+    Pid_t pid;
     if (MAXARG < 2) {
 	pgrp = 0;
 	pid = 0;
@@ -3240,12 +3792,12 @@ PP(pp_setpgrp)
     SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
 #else
     if ((pgrp != 0 && pgrp != getpid()) || (pid != 0 && pid != getpid()))
-	DIE("POSIX setpgrp can't take an argument");
+	DIE(aTHX_ "setpgrp can't take arguments");
     SETi( setpgrp() >= 0 );
 #endif /* USE_BSDPGRP */
     RETURN;
 #else
-    DIE(no_func, "setpgrp()");
+    DIE(aTHX_ PL_no_func, "setpgrp()");
 #endif
 }
 
@@ -3260,7 +3812,7 @@ PP(pp_getpriority)
     SETi( getpriority(which, who) );
     RETURN;
 #else
-    DIE(no_func, "getpriority()");
+    DIE(aTHX_ PL_no_func, "getpriority()");
 #endif
 }
 
@@ -3278,7 +3830,7 @@ PP(pp_setpriority)
     SETi( setpriority(which, who, niceval) >= 0 );
     RETURN;
 #else
-    DIE(no_func, "setpriority()");
+    DIE(aTHX_ PL_no_func, "setpriority()");
 #endif
 }
 
@@ -3316,23 +3868,23 @@ PP(pp_tms)
     djSP;
 
 #ifndef HAS_TIMES
-    DIE("times not implemented");
+    DIE(aTHX_ "times not implemented");
 #else
     EXTEND(SP, 4);
 
 #ifndef VMS
-    (void)PerlProc_times(&timesbuf);
+    (void)PerlProc_times(&PL_timesbuf);
 #else
-    (void)PerlProc_times((tbuffer_t *)&timesbuf);  /* time.h uses different name for */
+    (void)PerlProc_times((tbuffer_t *)&PL_timesbuf);  /* time.h uses different name for */
                                                    /* struct tms, though same data   */
                                                    /* is returned.                   */
 #endif
 
-    PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
+    PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_utime)/HZ)));
     if (GIMME == G_ARRAY) {
-	PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
-	PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
-	PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
+	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)));
     }
     RETURN;
 #endif /* HAS_TIMES */
@@ -3340,7 +3892,7 @@ PP(pp_tms)
 
 PP(pp_localtime)
 {
-    return pp_gmtime(ARGS);
+    return pp_gmtime();
 }
 
 PP(pp_gmtime)
@@ -3361,7 +3913,7 @@ PP(pp_gmtime)
 	when = (Time_t)SvIVx(POPs);
 #endif
 
-    if (op->op_type == OP_LOCALTIME)
+    if (PL_op->op_type == OP_LOCALTIME)
 	tmbuf = localtime(&when);
     else
 	tmbuf = gmtime(&when);
@@ -3373,26 +3925,26 @@ PP(pp_gmtime)
 	SV *tsv;
 	if (!tmbuf)
 	    RETPUSHUNDEF;
-	tsv = newSVpvf("%s %s %2d %02d:%02d:%02d %d",
-		       dayname[tmbuf->tm_wday],
-		       monname[tmbuf->tm_mon],
-		       tmbuf->tm_mday,
-		       tmbuf->tm_hour,
-		       tmbuf->tm_min,
-		       tmbuf->tm_sec,
-		       tmbuf->tm_year + 1900);
+	tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %d",
+			    dayname[tmbuf->tm_wday],
+			    monname[tmbuf->tm_mon],
+			    tmbuf->tm_mday,
+			    tmbuf->tm_hour,
+			    tmbuf->tm_min,
+			    tmbuf->tm_sec,
+			    tmbuf->tm_year + 1900);
 	PUSHs(sv_2mortal(tsv));
     }
     else if (tmbuf) {
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
+	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)));
     }
     RETURN;
 }
@@ -3407,10 +3959,10 @@ PP(pp_alarm)
     EXTEND(SP, 1);
     if (anum < 0)
 	RETPUSHUNDEF;
-    PUSHi((I32)anum);
+    PUSHi(anum);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function alarm");
+    DIE(aTHX_ PL_no_func, "Unsupported function alarm");
 #endif
 }
 
@@ -3437,29 +3989,29 @@ PP(pp_sleep)
 
 PP(pp_shmget)
 {
-    return pp_semget(ARGS);
+    return pp_semget();
 }
 
 PP(pp_shmctl)
 {
-    return pp_semctl(ARGS);
+    return pp_semctl();
 }
 
 PP(pp_shmread)
 {
-    return pp_shmwrite(ARGS);
+    return pp_shmwrite();
 }
 
 PP(pp_shmwrite)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
     djSP; dMARK; dTARGET;
-    I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
+    I32 value = (I32)(do_shmio(PL_op->op_type, MARK, SP) >= 0);
     SP = MARK;
     PUSHi(value);
     RETURN;
 #else
-    return pp_semget(ARGS);
+    return pp_semget();
 #endif
 }
 
@@ -3467,12 +4019,12 @@ PP(pp_shmwrite)
 
 PP(pp_msgget)
 {
-    return pp_semget(ARGS);
+    return pp_semget();
 }
 
 PP(pp_msgctl)
 {
-    return pp_semctl(ARGS);
+    return pp_semctl();
 }
 
 PP(pp_msgsnd)
@@ -3484,7 +4036,7 @@ PP(pp_msgsnd)
     PUSHi(value);
     RETURN;
 #else
-    return pp_semget(ARGS);
+    return pp_semget();
 #endif
 }
 
@@ -3497,7 +4049,7 @@ PP(pp_msgrcv)
     PUSHi(value);
     RETURN;
 #else
-    return pp_semget(ARGS);
+    return pp_semget();
 #endif
 }
 
@@ -3507,14 +4059,14 @@ PP(pp_semget)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
     djSP; dMARK; dTARGET;
-    int anum = do_ipcget(op->op_type, MARK, SP);
+    int anum = do_ipcget(PL_op->op_type, MARK, SP);
     SP = MARK;
     if (anum == -1)
 	RETPUSHUNDEF;
     PUSHi(anum);
     RETURN;
 #else
-    DIE("System V IPC is not implemented on this machine");
+    DIE(aTHX_ "System V IPC is not implemented on this machine");
 #endif
 }
 
@@ -3522,7 +4074,7 @@ PP(pp_semctl)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
     djSP; dMARK; dTARGET;
-    int anum = do_ipcctl(op->op_type, MARK, SP);
+    int anum = do_ipcctl(PL_op->op_type, MARK, SP);
     SP = MARK;
     if (anum == -1)
 	RETSETUNDEF;
@@ -3534,7 +4086,7 @@ PP(pp_semctl)
     }
     RETURN;
 #else
-    return pp_semget(ARGS);
+    return pp_semget();
 #endif
 }
 
@@ -3547,7 +4099,7 @@ PP(pp_semop)
     PUSHi(value);
     RETURN;
 #else
-    return pp_semget(ARGS);
+    return pp_semget();
 #endif
 }
 
@@ -3555,56 +4107,62 @@ PP(pp_semop)
 
 PP(pp_ghbyname)
 {
-#ifdef HAS_SOCKET
-    return pp_ghostent(ARGS);
+#ifdef HAS_GETHOSTBYNAME
+    return pp_ghostent();
 #else
-    DIE(no_sock_func, "gethostbyname");
+    DIE(aTHX_ PL_no_sock_func, "gethostbyname");
 #endif
 }
 
 PP(pp_ghbyaddr)
 {
-#ifdef HAS_SOCKET
-    return pp_ghostent(ARGS);
+#ifdef HAS_GETHOSTBYADDR
+    return pp_ghostent();
 #else
-    DIE(no_sock_func, "gethostbyaddr");
+    DIE(aTHX_ PL_no_sock_func, "gethostbyaddr");
 #endif
 }
 
 PP(pp_ghostent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    I32 which = op->op_type;
+#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
+    I32 which = PL_op->op_type;
     register char **elem;
     register SV *sv;
-#if defined(HAS_GETHOSTENT) && !defined(DONT_DECLARE_STD)
+#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);
-#ifndef PerlSock_gethostent
     struct hostent *PerlSock_gethostent(void);
 #endif
-#endif
     struct hostent *hent;
     unsigned long len;
+    STRLEN n_a;
 
     EXTEND(SP, 10);
-    if (which == OP_GHBYNAME) {
-	hent = PerlSock_gethostbyname(POPp);
-    }
+    if (which == OP_GHBYNAME)
+#ifdef HAS_GETHOSTBYNAME
+	hent = PerlSock_gethostbyname(POPpx);
+#else
+	DIE(aTHX_ PL_no_sock_func, "gethostbyname");
+#endif
     else if (which == OP_GHBYADDR) {
+#ifdef HAS_GETHOSTBYADDR
 	int addrtype = POPi;
 	SV *addrsv = POPs;
 	STRLEN addrlen;
 	Netdb_host_t addr = (Netdb_host_t) SvPV(addrsv, addrlen);
 
 	hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
+#else
+	DIE(aTHX_ PL_no_sock_func, "gethostbyaddr");
+#endif
     }
     else
 #ifdef HAS_GETHOSTENT
 	hent = PerlSock_gethostent();
 #else
-	DIE("gethostent not implemented");
+	DIE(aTHX_ PL_no_sock_func, "gethostent");
 #endif
 
 #ifdef HOST_NOT_FOUND
@@ -3626,77 +4184,90 @@ PP(pp_ghostent)
     }
 
     if (hent) {
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setpv(sv, (char*)hent->h_name);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	for (elem = hent->h_aliases; elem && *elem; elem++) {
 	    sv_catpv(sv, *elem);
 	    if (elem[1])
 		sv_catpvn(sv, " ", 1);
 	}
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setiv(sv, (IV)hent->h_addrtype);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	len = hent->h_length;
 	sv_setiv(sv, (IV)len);
 #ifdef h_addr
 	for (elem = hent->h_addr_list; elem && *elem; elem++) {
-	    XPUSHs(sv = sv_mortalcopy(&sv_no));
+	    XPUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	    sv_setpvn(sv, *elem, len);
 	}
 #else
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	if (hent->h_addr)
 	    sv_setpvn(sv, hent->h_addr, len);
 #endif /* h_addr */
     }
     RETURN;
 #else
-    DIE(no_sock_func, "gethostent");
+    DIE(aTHX_ PL_no_sock_func, "gethostent");
 #endif
 }
 
 PP(pp_gnbyname)
 {
-#ifdef HAS_SOCKET
-    return pp_gnetent(ARGS);
+#ifdef HAS_GETNETBYNAME
+    return pp_gnetent();
 #else
-    DIE(no_sock_func, "getnetbyname");
+    DIE(aTHX_ PL_no_sock_func, "getnetbyname");
 #endif
 }
 
 PP(pp_gnbyaddr)
 {
-#ifdef HAS_SOCKET
-    return pp_gnetent(ARGS);
+#ifdef HAS_GETNETBYADDR
+    return pp_gnetent();
 #else
-    DIE(no_sock_func, "getnetbyaddr");
+    DIE(aTHX_ PL_no_sock_func, "getnetbyaddr");
 #endif
 }
 
 PP(pp_gnetent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    I32 which = op->op_type;
+#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
+    I32 which = PL_op->op_type;
     register char **elem;
     register SV *sv;
-#ifdef NETDB_H_OMITS_GETNET
-    struct netent *getnetbyaddr(Netdb_net_t, int);
-    struct netent *getnetbyname(Netdb_name_t);
-    struct netent *getnetent(void);
+#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);
 #endif
     struct netent *nent;
+    STRLEN n_a;
 
     if (which == OP_GNBYNAME)
-	nent = PerlSock_getnetbyname(POPp);
+#ifdef HAS_GETNETBYNAME
+	nent = PerlSock_getnetbyname(POPpx);
+#else
+        DIE(aTHX_ PL_no_sock_func, "getnetbyname");
+#endif
     else if (which == OP_GNBYADDR) {
+#ifdef HAS_GETNETBYADDR
 	int addrtype = POPi;
 	Netdb_net_t addr = (Netdb_net_t) U_L(POPn);
 	nent = PerlSock_getnetbyaddr(addr, addrtype);
+#else
+	DIE(aTHX_ PL_no_sock_func, "getnetbyaddr");
+#endif
     }
     else
+#ifdef HAS_GETNETENT
 	nent = PerlSock_getnetent();
+#else
+        DIE(aTHX_ PL_no_sock_func, "getnetent");
+#endif
 
     EXTEND(SP, 4);
     if (GIMME != G_ARRAY) {
@@ -3711,66 +4282,77 @@ PP(pp_gnetent)
     }
 
     if (nent) {
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setpv(sv, nent->n_name);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	for (elem = nent->n_aliases; elem && *elem; elem++) {
 	    sv_catpv(sv, *elem);
 	    if (elem[1])
 		sv_catpvn(sv, " ", 1);
 	}
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setiv(sv, (IV)nent->n_addrtype);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setiv(sv, (IV)nent->n_net);
     }
 
     RETURN;
 #else
-    DIE(no_sock_func, "getnetent");
+    DIE(aTHX_ PL_no_sock_func, "getnetent");
 #endif
 }
 
 PP(pp_gpbyname)
 {
-#ifdef HAS_SOCKET
-    return pp_gprotoent(ARGS);
+#ifdef HAS_GETPROTOBYNAME
+    return pp_gprotoent();
 #else
-    DIE(no_sock_func, "getprotobyname");
+    DIE(aTHX_ PL_no_sock_func, "getprotobyname");
 #endif
 }
 
 PP(pp_gpbynumber)
 {
-#ifdef HAS_SOCKET
-    return pp_gprotoent(ARGS);
+#ifdef HAS_GETPROTOBYNUMBER
+    return pp_gprotoent();
 #else
-    DIE(no_sock_func, "getprotobynumber");
+    DIE(aTHX_ PL_no_sock_func, "getprotobynumber");
 #endif
 }
 
 PP(pp_gprotoent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    I32 which = op->op_type;
+#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
+    I32 which = PL_op->op_type;
     register char **elem;
     register SV *sv;  
-#ifndef DONT_DECLARE_STD
+#ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
     struct protoent *PerlSock_getprotobyname(Netdb_name_t);
     struct protoent *PerlSock_getprotobynumber(int);
-#ifndef PerlSock_getprotoent
     struct protoent *PerlSock_getprotoent(void);
 #endif
-#endif
     struct protoent *pent;
+    STRLEN n_a;
 
     if (which == OP_GPBYNAME)
-	pent = PerlSock_getprotobyname(POPp);
+#ifdef HAS_GETPROTOBYNAME
+	pent = PerlSock_getprotobyname(POPpx);
+#else
+	DIE(aTHX_ PL_no_sock_func, "getprotobyname");
+#endif
     else if (which == OP_GPBYNUMBER)
+#ifdef HAS_GETPROTOBYNUMBER
 	pent = PerlSock_getprotobynumber(POPi);
+#else
+    DIE(aTHX_ PL_no_sock_func, "getprotobynumber");
+#endif
     else
+#ifdef HAS_GETPROTOENT
 	pent = PerlSock_getprotoent();
+#else
+	DIE(aTHX_ PL_no_sock_func, "getprotoent");
+#endif
 
     EXTEND(SP, 3);
     if (GIMME != G_ARRAY) {
@@ -3785,78 +4367,89 @@ PP(pp_gprotoent)
     }
 
     if (pent) {
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setpv(sv, pent->p_name);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	for (elem = pent->p_aliases; elem && *elem; elem++) {
 	    sv_catpv(sv, *elem);
 	    if (elem[1])
 		sv_catpvn(sv, " ", 1);
 	}
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setiv(sv, (IV)pent->p_proto);
     }
 
     RETURN;
 #else
-    DIE(no_sock_func, "getprotoent");
+    DIE(aTHX_ PL_no_sock_func, "getprotoent");
 #endif
 }
 
 PP(pp_gsbyname)
 {
-#ifdef HAS_SOCKET
-    return pp_gservent(ARGS);
+#ifdef HAS_GETSERVBYNAME
+    return pp_gservent();
 #else
-    DIE(no_sock_func, "getservbyname");
+    DIE(aTHX_ PL_no_sock_func, "getservbyname");
 #endif
 }
 
 PP(pp_gsbyport)
 {
-#ifdef HAS_SOCKET
-    return pp_gservent(ARGS);
+#ifdef HAS_GETSERVBYPORT
+    return pp_gservent();
 #else
-    DIE(no_sock_func, "getservbyport");
+    DIE(aTHX_ PL_no_sock_func, "getservbyport");
 #endif
 }
 
 PP(pp_gservent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    I32 which = op->op_type;
+#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
+    I32 which = PL_op->op_type;
     register char **elem;
     register SV *sv;
-#ifndef DONT_DECLARE_STD
+#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);
-#ifndef PerlSock_getservent
     struct servent *PerlSock_getservent(void);
 #endif
-#endif
     struct servent *sent;
+    STRLEN n_a;
 
     if (which == OP_GSBYNAME) {
-	char *proto = POPp;
-	char *name = POPp;
+#ifdef HAS_GETSERVBYNAME
+	char *proto = POPpx;
+	char *name = POPpx;
 
 	if (proto && !*proto)
 	    proto = Nullch;
 
 	sent = PerlSock_getservbyname(name, proto);
+#else
+	DIE(aTHX_ PL_no_sock_func, "getservbyname");
+#endif
     }
     else if (which == OP_GSBYPORT) {
-	char *proto = POPp;
+#ifdef HAS_GETSERVBYPORT
+	char *proto = POPpx;
 	unsigned short port = POPu;
 
 #ifdef HAS_HTONS
 	port = PerlSock_htons(port);
 #endif
 	sent = PerlSock_getservbyport(port, proto);
+#else
+	DIE(aTHX_ PL_no_sock_func, "getservbyport");
+#endif
     }
     else
+#ifdef HAS_GETSERVENT
 	sent = PerlSock_getservent();
+#else
+	DIE(aTHX_ PL_no_sock_func, "getservent");
+#endif
 
     EXTEND(SP, 4);
     if (GIMME != G_ARRAY) {
@@ -3876,155 +4469,176 @@ PP(pp_gservent)
     }
 
     if (sent) {
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setpv(sv, sent->s_name);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	for (elem = sent->s_aliases; elem && *elem; elem++) {
 	    sv_catpv(sv, *elem);
 	    if (elem[1])
 		sv_catpvn(sv, " ", 1);
 	}
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #ifdef HAS_NTOHS
 	sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port));
 #else
 	sv_setiv(sv, (IV)(sent->s_port));
 #endif
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setpv(sv, sent->s_proto);
     }
 
     RETURN;
 #else
-    DIE(no_sock_func, "getservent");
+    DIE(aTHX_ PL_no_sock_func, "getservent");
 #endif
 }
 
 PP(pp_shostent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#ifdef HAS_SETHOSTENT
     PerlSock_sethostent(TOPi);
     RETSETYES;
 #else
-    DIE(no_sock_func, "sethostent");
+    DIE(aTHX_ PL_no_sock_func, "sethostent");
 #endif
 }
 
 PP(pp_snetent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#ifdef HAS_SETNETENT
     PerlSock_setnetent(TOPi);
     RETSETYES;
 #else
-    DIE(no_sock_func, "setnetent");
+    DIE(aTHX_ PL_no_sock_func, "setnetent");
 #endif
 }
 
 PP(pp_sprotoent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#ifdef HAS_SETPROTOENT
     PerlSock_setprotoent(TOPi);
     RETSETYES;
 #else
-    DIE(no_sock_func, "setprotoent");
+    DIE(aTHX_ PL_no_sock_func, "setprotoent");
 #endif
 }
 
 PP(pp_sservent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#ifdef HAS_SETSERVENT
     PerlSock_setservent(TOPi);
     RETSETYES;
 #else
-    DIE(no_sock_func, "setservent");
+    DIE(aTHX_ PL_no_sock_func, "setservent");
 #endif
 }
 
 PP(pp_ehostent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#ifdef HAS_ENDHOSTENT
     PerlSock_endhostent();
-    EXTEND(sp,1);
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "endhostent");
+    DIE(aTHX_ PL_no_sock_func, "endhostent");
 #endif
 }
 
 PP(pp_enetent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#ifdef HAS_ENDNETENT
     PerlSock_endnetent();
-    EXTEND(sp,1);
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "endnetent");
+    DIE(aTHX_ PL_no_sock_func, "endnetent");
 #endif
 }
 
 PP(pp_eprotoent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#ifdef HAS_ENDPROTOENT
     PerlSock_endprotoent();
-    EXTEND(sp,1);
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "endprotoent");
+    DIE(aTHX_ PL_no_sock_func, "endprotoent");
 #endif
 }
 
 PP(pp_eservent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#ifdef HAS_ENDSERVENT
     PerlSock_endservent();
-    EXTEND(sp,1);
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
-    DIE(no_sock_func, "endservent");
+    DIE(aTHX_ PL_no_sock_func, "endservent");
 #endif
 }
 
 PP(pp_gpwnam)
 {
 #ifdef HAS_PASSWD
-    return pp_gpwent(ARGS);
+    return pp_gpwent();
 #else
-    DIE(no_func, "getpwnam");
+    DIE(aTHX_ PL_no_func, "getpwnam");
 #endif
 }
 
 PP(pp_gpwuid)
 {
 #ifdef HAS_PASSWD
-    return pp_gpwent(ARGS);
+    return pp_gpwent();
 #else
-    DIE(no_func, "getpwuid");
+    DIE(aTHX_ PL_no_func, "getpwuid");
 #endif
 }
 
 PP(pp_gpwent)
 {
     djSP;
-#ifdef HAS_PASSWD
-    I32 which = op->op_type;
+#if defined(HAS_PASSWD) && defined(HAS_GETPWENT)
+    I32 which = PL_op->op_type;
     register SV *sv;
     struct passwd *pwent;
+    STRLEN n_a;
+#if defined(HAS_GETSPENT) || defined(HAS_GETSPNAM)
+    struct spwd *spwent = NULL;
+#endif
 
     if (which == OP_GPWNAM)
-	pwent = getpwnam(POPp);
+	pwent = getpwnam(POPpx);
     else if (which == OP_GPWUID)
 	pwent = getpwuid(POPi);
     else
 	pwent = (struct passwd *)getpwent();
 
+#ifdef HAS_GETSPNAM
+    if (which == OP_GPWNAM) {
+	if (pwent)
+	    spwent = getspnam(pwent->pw_name);
+    }
+#  ifdef HAS_GETSPUID /* AFAIK there isn't any anywhere. --jhi */ 
+    else if (which == OP_GPWUID) {
+	if (pwent)
+	    spwent = getspnam(pwent->pw_name);
+    }
+#  endif
+#  ifdef HAS_GETSPENT
+    else
+	spwent = (struct spwd *)getspent();
+#  endif
+#endif
+
     EXTEND(SP, 10);
     if (GIMME != G_ARRAY) {
 	PUSHs(sv = sv_newmortal());
@@ -4038,105 +4652,135 @@ PP(pp_gpwent)
     }
 
     if (pwent) {
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setpv(sv, pwent->pw_name);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+#ifdef PWPASSWD
+#   if defined(HAS_GETSPENT) || defined(HAS_GETSPNAM)
+      if (spwent)
+              sv_setpv(sv, spwent->sp_pwdp);
+      else
+              sv_setpv(sv, pwent->pw_passwd);
+#   else
 	sv_setpv(sv, pwent->pw_passwd);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+#   endif
+#endif
+
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setiv(sv, (IV)pwent->pw_uid);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setiv(sv, (IV)pwent->pw_gid);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+
+	/* pw_change, pw_quota, and pw_age are mutually exclusive. */
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #ifdef PWCHANGE
 	sv_setiv(sv, (IV)pwent->pw_change);
 #else
-#ifdef PWQUOTA
+#   ifdef PWQUOTA
 	sv_setiv(sv, (IV)pwent->pw_quota);
-#else
-#ifdef PWAGE
+#   else
+#       ifdef PWAGE
 	sv_setpv(sv, pwent->pw_age);
+#       endif
+#   endif
 #endif
-#endif
-#endif
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+
+	/* pw_class and pw_comment are mutually exclusive. */
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #ifdef PWCLASS
 	sv_setpv(sv, pwent->pw_class);
 #else
-#ifdef PWCOMMENT
+#   ifdef PWCOMMENT
 	sv_setpv(sv, pwent->pw_comment);
+#   endif
 #endif
-#endif
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+#ifdef PWGECOS
 	sv_setpv(sv, pwent->pw_gecos);
+#endif
 #ifndef INCOMPLETE_TAINTS
+	/* pw_gecos is tainted because user himself can diddle with it. */
 	SvTAINTED_on(sv);
 #endif
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setpv(sv, pwent->pw_dir);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setpv(sv, pwent->pw_shell);
+
 #ifdef PWEXPIRE
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setiv(sv, (IV)pwent->pw_expire);
 #endif
     }
     RETURN;
 #else
-    DIE(no_func, "getpwent");
+    DIE(aTHX_ PL_no_func, "getpwent");
 #endif
 }
 
 PP(pp_spwent)
 {
     djSP;
-#if defined(HAS_PASSWD) && !defined(CYGWIN32)
+#if defined(HAS_PASSWD) && defined(HAS_SETPWENT)
     setpwent();
+#   ifdef HAS_SETSPENT
+    setspent();
+#   endif
     RETPUSHYES;
 #else
-    DIE(no_func, "setpwent");
+    DIE(aTHX_ PL_no_func, "setpwent");
 #endif
 }
 
 PP(pp_epwent)
 {
     djSP;
-#ifdef HAS_PASSWD
+#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
     endpwent();
+#   ifdef HAS_ENDSPENT
+    endspent();
+#   endif
     RETPUSHYES;
 #else
-    DIE(no_func, "endpwent");
+    DIE(aTHX_ PL_no_func, "endpwent");
 #endif
 }
 
 PP(pp_ggrnam)
 {
 #ifdef HAS_GROUP
-    return pp_ggrent(ARGS);
+    return pp_ggrent();
 #else
-    DIE(no_func, "getgrnam");
+    DIE(aTHX_ PL_no_func, "getgrnam");
 #endif
 }
 
 PP(pp_ggrgid)
 {
 #ifdef HAS_GROUP
-    return pp_ggrent(ARGS);
+    return pp_ggrent();
 #else
-    DIE(no_func, "getgrgid");
+    DIE(aTHX_ PL_no_func, "getgrgid");
 #endif
 }
 
 PP(pp_ggrent)
 {
     djSP;
-#ifdef HAS_GROUP
-    I32 which = op->op_type;
+#if defined(HAS_GROUP) && defined(HAS_GETGRENT)
+    I32 which = PL_op->op_type;
     register char **elem;
     register SV *sv;
     struct group *grent;
+    STRLEN n_a;
 
     if (which == OP_GGRNAM)
-	grent = (struct group *)getgrnam(POPp);
+	grent = (struct group *)getgrnam(POPpx);
     else if (which == OP_GGRGID)
 	grent = (struct group *)getgrgid(POPi);
     else
@@ -4155,13 +4799,18 @@ PP(pp_ggrent)
     }
 
     if (grent) {
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setpv(sv, grent->gr_name);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+#ifdef GRPASSWD
 	sv_setpv(sv, grent->gr_passwd);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+#endif
+
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setiv(sv, (IV)grent->gr_gid);
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	for (elem = grent->gr_mem; elem && *elem; elem++) {
 	    sv_catpv(sv, *elem);
 	    if (elem[1])
@@ -4171,29 +4820,29 @@ PP(pp_ggrent)
 
     RETURN;
 #else
-    DIE(no_func, "getgrent");
+    DIE(aTHX_ PL_no_func, "getgrent");
 #endif
 }
 
 PP(pp_sgrent)
 {
     djSP;
-#ifdef HAS_GROUP
+#if defined(HAS_GROUP) && defined(HAS_SETGRENT)
     setgrent();
     RETPUSHYES;
 #else
-    DIE(no_func, "setgrent");
+    DIE(aTHX_ PL_no_func, "setgrent");
 #endif
 }
 
 PP(pp_egrent)
 {
     djSP;
-#ifdef HAS_GROUP
+#if defined(HAS_GROUP) && defined(HAS_ENDGRENT)
     endgrent();
     RETPUSHYES;
 #else
-    DIE(no_func, "endgrent");
+    DIE(aTHX_ PL_no_func, "endgrent");
 #endif
 }
 
@@ -4208,7 +4857,7 @@ PP(pp_getlogin)
     PUSHp(tmps, strlen(tmps));
     RETURN;
 #else
-    DIE(no_func, "getlogin");
+    DIE(aTHX_ PL_no_func, "getlogin");
 #endif
 }
 
@@ -4216,15 +4865,16 @@ PP(pp_getlogin)
 
 PP(pp_syscall)
 {
-#ifdef HAS_SYSCALL   
+#ifdef HAS_SYSCALL
     djSP; dMARK; dORIGMARK; dTARGET;
     register I32 items = SP - MARK;
     unsigned long a[20];
     register I32 i = 0;
     I32 retval = -1;
     MAGIC *mg;
+    STRLEN n_a;
 
-    if (tainting) {
+    if (PL_tainting) {
 	while (++MARK <= SP) {
 	    if (SvTAINTED(*MARK)) {
 		TAINT;
@@ -4242,18 +4892,18 @@ PP(pp_syscall)
     while (++MARK <= SP) {
 	if (SvNIOK(*MARK) || !i)
 	    a[i++] = SvIV(*MARK);
-	else if (*MARK == &sv_undef)
+	else if (*MARK == &PL_sv_undef)
 	    a[i++] = 0;
 	else 
-	    a[i++] = (unsigned long)SvPV_force(*MARK, na);
+	    a[i++] = (unsigned long)SvPV_force(*MARK, n_a);
 	if (i > 15)
 	    break;
     }
     switch (items) {
     default:
-	DIE("Too many args to syscall");
+	DIE(aTHX_ "Too many args to syscall");
     case 0:
-	DIE("Too few args to syscall");
+	DIE(aTHX_ "Too few args to syscall");
     case 1:
 	retval = syscall(a[0]);
 	break;
@@ -4307,7 +4957,7 @@ PP(pp_syscall)
     PUSHi(retval);
     RETURN;
 #else
-    DIE(no_func, "syscall");
+    DIE(aTHX_ PL_no_func, "syscall");
 #endif
 }
 
@@ -4337,7 +4987,7 @@ fcntl_emulate_flock(int fd, int operation)
 	return -1;
     }
     flock.l_whence = SEEK_SET;
-    flock.l_start = flock.l_len = 0L;
+    flock.l_start = flock.l_len = (Off_t)0;
  
     return fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock);
 }
@@ -4375,9 +5025,7 @@ fcntl_emulate_flock(int fd, int operation)
 # endif
 
 static int
-lockf_emulate_flock (fd, operation)
-int fd;
-int operation;
+lockf_emulate_flock(int fd, int operation)
 {
     int i;
     int save_errno;
@@ -4430,4 +5078,3 @@ int operation;
 }
 
 #endif /* LOCKF_EMULATE_FLOCK */
-