X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=f4827bb5d90b9a233d75bee21a70cacca29ea5f3;hb=7b8d334a971230040a212bc5038097b3f600a094;hp=6d18ac96bc8ac44e26b74ce838212c5a92c367c1;hpb=8903cb82b09fb34870c757f52ce481b09be4b606;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index 6d18ac9..f4827bb 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -22,6 +22,12 @@
 # include <unistd.h>
 #endif
 
+#ifdef HAS_SYSCALL   
+#ifdef __cplusplus              
+extern "C" int syscall(unsigned long,...);
+#endif
+#endif
+
 #ifdef I_SYS_WAIT
 # include <sys/wait.h>
 #endif
@@ -32,7 +38,9 @@
 
 #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
 # include <sys/socket.h>
-# include <netdb.h>
+# ifdef I_NETDB
+#  include <netdb.h>
+# endif
 # ifndef ENOTSOCK
 #  ifdef I_NET_ERRNO
 #   include <net/errno.h>
@@ -46,7 +54,11 @@
 #endif
 #endif
 
-#ifdef HOST_NOT_FOUND
+/* XXX Configure test needed.
+   h_errno might not be a simple 'int', especially for multi-threaded
+   applications.  HOST_NOT_FOUND is typically defined in <netdb.h>.
+*/
+#if defined(HOST_NOT_FOUND) && !defined(h_errno)
 extern int h_errno;
 #endif
 
@@ -71,7 +83,7 @@ extern int h_errno;
 #endif
 
 #ifdef I_UTIME
-#  ifdef WIN32
+#  if defined(_MSC_VER) || defined(__MINGW32__)
 #    include <sys/utime.h>
 #  else
 #    include <utime.h>
@@ -106,7 +118,7 @@ static int dooneliner _((char *cmd, char *filename));
 # ifdef my_chsize  /* Probably #defined to Perl_my_chsize in embed.h */
 #   undef my_chsize
 # endif
-# define my_chsize chsize
+# define my_chsize PerlLIO_chsize
 #endif
 
 #ifdef HAS_FLOCK
@@ -154,6 +166,13 @@ 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";
@@ -162,16 +181,17 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
 
 PP(pp_backtick)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     PerlIO *fp;
     char *tmps = POPp;
     I32 gimme = GIMME_V;
 
     TAINT_PROPER("``");
-    fp = my_popen(tmps, "r");
+    fp = PerlProc_popen(tmps, "r");
     if (fp) {
 	if (gimme == G_VOID) {
-	    while (PerlIO_read(fp, buf, sizeof buf) > 0)
+	    char tmpbuf[256];
+	    while (PerlIO_read(fp, tmpbuf, sizeof tmpbuf) > 0)
 		/*SUPPRESS 530*/
 		;
 	}
@@ -200,7 +220,7 @@ PP(pp_backtick)
 		SvTAINTED_on(sv);
 	    }
 	}
-	STATUS_NATIVE_SET(my_pclose(fp));
+	STATUS_NATIVE_SET(PerlProc_pclose(fp));
 	TAINT;		/* "I believe that this is not gratuitous!" */
     }
     else {
@@ -217,6 +237,17 @@ PP(pp_glob)
     OP *result;
     ENTER;
 
+#ifndef VMS
+    if (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");
+    }
+#endif /* !VMS */
+
     SAVESPTR(last_in_gv);	/* We don't want this to be permanent. */
     last_in_gv = (GV*)*stack_sp--;
 
@@ -247,7 +278,7 @@ PP(pp_rcatline)
 
 PP(pp_warn)
 {
-    dSP; dMARK;
+    djSP; dMARK;
     char *tmps;
     if (SP - MARK != 1) {
 	dTARGET;
@@ -259,11 +290,10 @@ PP(pp_warn)
 	tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-	SV *error = GvSV(errgv);
-	(void)SvUPGRADE(error, SVt_PV);
-	if (SvPOK(error) && SvCUR(error))
-	    sv_catpv(error, "\t...caught");
-	tmps = SvPV(error, na);
+	(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";
@@ -273,7 +303,7 @@ PP(pp_warn)
 
 PP(pp_die)
 {
-    dSP; dMARK;
+    djSP; dMARK;
     char *tmps;
     if (SP - MARK != 1) {
 	dTARGET;
@@ -285,11 +315,10 @@ PP(pp_die)
 	tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-	SV *error = GvSV(errgv);
-	(void)SvUPGRADE(error, SVt_PV);
-	if (SvPOK(error) && SvCUR(error))
-	    sv_catpv(error, "\t...propagated");
-	tmps = SvPV(error, na);
+	(void)SvUPGRADE(ERRSV, SVt_PV);
+	if (SvPOK(ERRSV) && SvCUR(ERRSV))
+	    sv_catpv(ERRSV, "\t...propagated");
+	tmps = SvPV(ERRSV, na);
     }
     if (!tmps || !*tmps)
 	tmps = "Died";
@@ -300,7 +329,7 @@ PP(pp_die)
 
 PP(pp_open)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     GV *gv;
     SV *sv;
     char *tmps;
@@ -329,13 +358,25 @@ PP(pp_open)
 
 PP(pp_close)
 {
-    dSP;
+    djSP;
     GV *gv;
+    MAGIC *mg;
 
     if (MAXARG == 0)
 	gv = defoutgv;
     else
 	gv = (GV*)POPs;
+
+    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+	PUSHMARK(SP);
+	XPUSHs(mg->mg_obj);
+	PUTBACK;
+	ENTER;
+	perl_call_method("CLOSE", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	RETURN;
+    }
     EXTEND(SP, 1);
     PUSHs(boolSV(do_close(gv, TRUE)));
     RETURN;
@@ -343,7 +384,7 @@ PP(pp_close)
 
 PP(pp_pipe_op)
 {
-    dSP;
+    djSP;
 #ifdef HAS_PIPE
     GV *rgv;
     GV *wgv;
@@ -367,7 +408,7 @@ PP(pp_pipe_op)
     if (IoIFP(wstio))
 	do_close(wgv, FALSE);
 
-    if (pipe(fd) < 0)
+    if (PerlProc_pipe(fd) < 0)
 	goto badexit;
 
     IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
@@ -378,9 +419,9 @@ PP(pp_pipe_op)
 
     if (!IoIFP(rstio) || !IoOFP(wstio)) {
 	if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
-	else close(fd[0]);
+	else PerlLIO_close(fd[0]);
 	if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
-	else close(fd[1]);
+	else PerlLIO_close(fd[1]);
 	goto badexit;
     }
 
@@ -395,7 +436,7 @@ badexit:
 
 PP(pp_fileno)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     GV *gv;
     IO *io;
     PerlIO *fp;
@@ -410,27 +451,27 @@ PP(pp_fileno)
 
 PP(pp_umask)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     int anum;
 
 #ifdef HAS_UMASK
     if (MAXARG < 1) {
-	anum = umask(0);
-	(void)umask(anum);
+	anum = PerlLIO_umask(0);
+	(void)PerlLIO_umask(anum);
     }
     else
-	anum = umask(POPi);
+	anum = PerlLIO_umask(POPi);
     TAINT_PROPER("umask");
     XPUSHi(anum);
 #else
-    DIE(no_func, "Unsupported function umask");
+    XPUSHs(&sv_undef)
 #endif
     RETURN;
 }
 
 PP(pp_binmode)
 {
-    dSP;
+    djSP;
     GV *gv;
     IO *io;
     PerlIO *fp;
@@ -444,89 +485,79 @@ PP(pp_binmode)
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
 	RETPUSHUNDEF;
 
-#ifdef DOSISH
-#ifdef atarist
-    if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
+    if (do_binmode(fp,IoTYPE(io),TRUE)) 
 	RETPUSHYES;
     else
 	RETPUSHUNDEF;
-#else
-    if (setmode(PerlIO_fileno(fp), OP_BINARY) != -1)
-	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)
 {
-    dSP;
+    djSP;
+    dMARK;
     SV *varsv;
     HV* stash;
     GV *gv;
-    BINOP myop;
     SV *sv;
-    SV **mark = stack_base + ++*markstack_ptr;	/* reuse in entersub */
-    I32 markoff = mark - stack_base - 1;
+    I32 markoff = MARK - stack_base;
     char *methname;
-    bool oldcatch = CATCH_GET;
-
-    varsv = mark[0];
-    if (SvTYPE(varsv) == SVt_PVHV)
-	methname = "TIEHASH";
-    else if (SvTYPE(varsv) == SVt_PVAV)
-	methname = "TIEARRAY";
-    else if (SvTYPE(varsv) == SVt_PVGV)
-	methname = "TIEHANDLE";
-    else
-	methname = "TIESCALAR";
-
-    stash = gv_stashsv(mark[1], FALSE);
-    if (!stash || !(gv = gv_fetchmethod(stash, methname)))
-	DIE("Can't locate object method \"%s\" via package \"%s\"",
-		methname, SvPV(mark[1],na));
-
-    Zero(&myop, 1, BINOP);
-    myop.op_last = (OP *) &myop;
-    myop.op_next = Nullop;
-    myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
-    CATCH_SET(TRUE);
-
-    ENTER;
-    SAVESPTR(op);
-    op = (OP *) &myop;
-    if (perldb && curstash != debstash)
-	op->op_private |= OPpENTERSUB_DB;
-
-    XPUSHs((SV*)GvCV(gv));
-    PUTBACK;
+    int how = 'P';
+    U32 items;
 
-    if (op = pp_entersub())
-        runops();
+    varsv = *++MARK;
+    switch(SvTYPE(varsv)) {
+	case SVt_PVHV:
+	    methname = "TIEHASH";
+	    break;
+	case SVt_PVAV:
+	    methname = "TIEARRAY";
+	    break;
+	case SVt_PVGV:
+	    methname = "TIEHANDLE";
+	    how = 'q';
+	    break;
+	default:
+	    methname = "TIESCALAR";
+	    how = 'q';
+	    break;
+    }
+    items = SP - MARK++;
+    if (sv_isobject(*MARK)) {
+	ENTER;
+	PUSHSTACK(SI_MAGIC);
+	PUSHMARK(SP);
+	EXTEND(SP,items);
+	while (items--)
+	    PUSHs(*MARK++);
+	PUTBACK;
+	perl_call_method(methname, G_SCALAR);
+    } 
+    else {
+	/* Not clear why we don't call perl_call_method here too.
+	 * perhaps to get different error message ?
+	 */
+	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,na));                   
+	}
+	ENTER;
+	PUSHSTACK(SI_MAGIC);
+	PUSHMARK(SP);
+	EXTEND(SP,items);
+	while (items--)
+	    PUSHs(*MARK++);
+	PUTBACK;
+	perl_call_sv((SV*)GvCV(gv), G_SCALAR);
+    }
     SPAGAIN;
 
-    CATCH_SET(oldcatch);
     sv = TOPs;
+    POPSTACK();
     if (sv_isobject(sv)) {
-	if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
-	    sv_unmagic(varsv, 'P');
-	    sv_magic(varsv, sv, 'P', Nullch, 0);
-	}
-	else {
-	    sv_unmagic(varsv, 'q');
-	    sv_magic(varsv, sv, 'q', Nullch, 0);
-	}
+	sv_unmagic(varsv, how);            
+	sv_magic(varsv, sv, how, Nullch, 0);
     }
     LEAVE;
     SP = stack_base + markoff;
@@ -536,10 +567,9 @@ PP(pp_tie)
 
 PP(pp_untie)
 {
-    dSP;
+    djSP;
     SV * sv ;
-
-    sv = POPs;
+    sv = POPs;          
 
     if (dowarn) {
         MAGIC * mg ;
@@ -564,7 +594,7 @@ PP(pp_untie)
 
 PP(pp_tied)
 {
-    dSP;
+    djSP;
     SV * sv ;
     MAGIC * mg ;
 
@@ -580,20 +610,17 @@ PP(pp_tied)
             RETURN ;
 	}
     }
-
     RETPUSHUNDEF;
 }
 
 PP(pp_dbmopen)
 {
-    dSP;
+    djSP;
     HV *hv;
     dPOPPOPssrl;
     HV* stash;
     GV *gv;
-    BINOP myop;
     SV *sv;
-    bool oldcatch = CATCH_GET;
 
     hv = (HV*)POPs;
 
@@ -608,21 +635,10 @@ PP(pp_dbmopen)
 	    DIE("No dbm on this machine");
     }
 
-    Zero(&myop, 1, BINOP);
-    myop.op_last = (OP *) &myop;
-    myop.op_next = Nullop;
-    myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
-    CATCH_SET(TRUE);
-
     ENTER;
-    SAVESPTR(op);
-    op = (OP *) &myop;
-    if (perldb && curstash != debstash)
-	op->op_private |= OPpENTERSUB_DB;
-    PUTBACK;
-    pp_pushmark();
+    PUSHMARK(SP);
 
-    EXTEND(sp, 5);
+    EXTEND(SP, 5);
     PUSHs(sv);
     PUSHs(left);
     if (SvIV(right))
@@ -630,34 +646,26 @@ PP(pp_dbmopen)
     else
 	PUSHs(sv_2mortal(newSViv(O_RDWR)));
     PUSHs(right);
-    PUSHs((SV*)GvCV(gv));
     PUTBACK;
-
-    if (op = pp_entersub())
-        runops();
+    perl_call_sv((SV*)GvCV(gv), G_SCALAR);
     SPAGAIN;
 
     if (!sv_isobject(TOPs)) {
-	sp--;
-	op = (OP *) &myop;
-	PUTBACK;
-	pp_pushmark();
-
+	SP--;
+	PUSHMARK(SP);
 	PUSHs(sv);
 	PUSHs(left);
 	PUSHs(sv_2mortal(newSViv(O_RDONLY)));
 	PUSHs(right);
-	PUSHs((SV*)GvCV(gv));
 	PUTBACK;
-
-	if (op = pp_entersub())
-	    runops();
+	perl_call_sv((SV*)GvCV(gv), G_SCALAR);
 	SPAGAIN;
     }
 
-    CATCH_SET(oldcatch);
-    if (sv_isobject(TOPs))
+    if (sv_isobject(TOPs)) {
+	sv_unmagic((SV *) hv, 'P');            
 	sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
+    }
     LEAVE;
     RETURN;
 }
@@ -669,7 +677,7 @@ PP(pp_dbmclose)
 
 PP(pp_sselect)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
 #ifdef HAS_SELECT
     register I32 i;
     register I32 j;
@@ -767,7 +775,7 @@ PP(pp_sselect)
 #endif
     }
 
-    nfound = select(
+    nfound = PerlSock_select(
 	maxlen * 8,
 	(Select_fd_set_t) fd_sets[1],
 	(Select_fd_set_t) fd_sets[2],
@@ -802,9 +810,9 @@ PP(pp_sselect)
 }
 
 void
-setdefout(gv)
-GV *gv;
+setdefout(GV *gv)
 {
+    dTHR;
     if (gv)
 	(void)SvREFCNT_inc(gv);
     if (defoutgv)
@@ -814,11 +822,11 @@ GV *gv;
 
 PP(pp_select)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     GV *newdefout, *egv;
     HV *hv;
 
-    newdefout = (op->op_private > 0) ? ((GV *) POPs) : NULL;
+    newdefout = (op->op_private > 0) ? ((GV *) POPs) : (GV *) NULL;
 
     egv = GvEGV(defoutgv);
     if (!egv)
@@ -848,7 +856,7 @@ PP(pp_select)
 
 PP(pp_getc)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     GV *gv;
     MAGIC *mg;
 
@@ -859,7 +867,7 @@ PP(pp_getc)
     if (!gv)
 	gv = argvgv;
 
-    if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
 	I32 gimme = GIMME_V;
 	PUSHMARK(SP);
 	XPUSHs(mg->mg_obj);
@@ -887,12 +895,10 @@ PP(pp_read)
 }
 
 static OP *
-doform(cv,gv,retop)
-CV *cv;
-GV *gv;
-OP *retop;
+doform(CV *cv, GV *gv, OP *retop)
 {
-    register CONTEXT *cx;
+    dTHR;
+    register PERL_CONTEXT *cx;
     I32 gimme = GIMME_V;
     AV* padlist = CvPADLIST(cv);
     SV** svp = AvARRAY(padlist);
@@ -912,7 +918,7 @@ OP *retop;
 
 PP(pp_enterwrite)
 {
-    dSP;
+    djSP;
     register GV *gv;
     register IO *io;
     GV *fgv;
@@ -953,14 +959,14 @@ PP(pp_enterwrite)
 
 PP(pp_leavewrite)
 {
-    dSP;
+    djSP;
     GV *gv = cxstack[cxstack_ix].blk_sub.gv;
     register IO *io = GvIOp(gv);
     PerlIO *ofp = IoOFP(io);
     PerlIO *fp;
     SV **newsp;
     I32 gimme;
-    register CONTEXT *cx;
+    register PERL_CONTEXT *cx;
 
     DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n",
 	  (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
@@ -971,16 +977,16 @@ PP(pp_leavewrite)
 	CV *cv;
 	if (!IoTOP_GV(io)) {
 	    GV *topgv;
-	    char tmpbuf[256];
+	    SV *topname;
 
 	    if (!IoTOP_NAME(io)) {
 		if (!IoFMT_NAME(io))
 		    IoFMT_NAME(io) = savepv(GvNAME(gv));
-		sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
-		topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
+		topname = sv_2mortal(newSVpvf("%s_TOP", IoFMT_NAME(io)));
+		topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM);
 		if ((topgv && GvFORM(topgv)) ||
 		  !gv_fetchpv("top",FALSE,SVt_PVFM))
-		    IoTOP_NAME(io) = savepv(tmpbuf);
+		    IoTOP_NAME(io) = savepv(SvPVX(topname));
 		else
 		    IoTOP_NAME(io) = savepv("top");
 	    }
@@ -1067,16 +1073,39 @@ PP(pp_leavewrite)
 
 PP(pp_prtf)
 {
-    dSP; dMARK; dORIGMARK;
+    djSP; dMARK; dORIGMARK;
     GV *gv;
     IO *io;
     PerlIO *fp;
-    SV *sv = NEWSV(0,0);
+    SV *sv;
+    MAGIC *mg;
 
     if (op->op_flags & OPf_STACKED)
 	gv = (GV*)*++MARK;
     else
 	gv = defoutgv;
+
+    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+	if (MARK == ORIGMARK) {
+	    MEXTEND(SP, 1);
+	    ++MARK;
+	    Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
+	    ++SP;
+	}
+	PUSHMARK(MARK - 1);
+	*MARK = mg->mg_obj;
+	PUTBACK;
+	ENTER;
+	perl_call_method("PRINTF", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	MARK = ORIGMARK + 1;
+	*MARK = *SP;
+	SP = MARK;
+	RETURN;
+    }
+
+    sv = NEWSV(0,0);
     if (!(io = GvIO(gv))) {
 	if (dowarn) {
 	    gv_fullname3(sv, gv, Nullch);
@@ -1125,7 +1154,7 @@ PP(pp_prtf)
 
 PP(pp_sysopen)
 {
-    dSP;
+    djSP;
     GV *gv;
     SV *sv;
     char *tmps;
@@ -1153,7 +1182,7 @@ PP(pp_sysopen)
 
 PP(pp_sysread)
 {
-    dSP; dMARK; dORIGMARK; dTARGET;
+    djSP; dMARK; dORIGMARK; dTARGET;
     int offset;
     GV *gv;
     IO *io;
@@ -1165,8 +1194,8 @@ PP(pp_sysread)
     MAGIC *mg;
 
     gv = (GV*)*++MARK;
-    if (op->op_type == OP_READ &&
-	SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
+    if ((op->op_type == OP_READ || op->op_type == OP_SYSREAD) &&
+	SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
     {
 	SV *sv;
 	
@@ -1201,11 +1230,16 @@ PP(pp_sysread)
 	goto say_undef;
 #ifdef HAS_SOCKET
     if (op->op_type == OP_RECV) {
-	bufsize = sizeof buf;
+	char namebuf[MAXPATHLEN];
+#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
+	bufsize = sizeof (struct sockaddr_in);
+#else
+	bufsize = sizeof namebuf;
+#endif
 	buffer = SvGROW(bufsv, length+1);
 	/* 'offset' means 'flags' here */
-	length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
-	    (struct sockaddr *)buf, &bufsize);
+	length = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
+			  (struct sockaddr *)namebuf, &bufsize);
 	if (length < 0)
 	    RETPUSHUNDEF;
 	SvCUR_set(bufsv, length);
@@ -1216,7 +1250,7 @@ PP(pp_sysread)
 	if (!(IoFLAGS(io) & IOf_UNTAINT))
 	    SvTAINTED_on(bufsv);
 	SP = ORIGMARK;
-	sv_setpvn(TARG, buf, bufsize);
+	sv_setpvn(TARG, namebuf, bufsize);
 	PUSHs(TARG);
 	RETURN;
     }
@@ -1235,14 +1269,19 @@ PP(pp_sysread)
     	Zero(buffer+bufsize, offset-bufsize, char);
     }
     if (op->op_type == OP_SYSREAD) {
-	length = read(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
+	length = PerlLIO_read(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
     }
     else
 #ifdef HAS_SOCKET__bad_code_maybe
     if (IoTYPE(io) == 's') {
-	bufsize = sizeof buf;
-	length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0,
-	    (struct sockaddr *)buf, &bufsize);
+	char namebuf[MAXPATHLEN];
+#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
+	bufsize = sizeof (struct sockaddr_in);
+#else
+	bufsize = sizeof namebuf;
+#endif
+	length = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0,
+			  (struct sockaddr *)namebuf, &bufsize);
     }
     else
 #endif
@@ -1272,7 +1311,7 @@ PP(pp_syswrite)
 
 PP(pp_send)
 {
-    dSP; dMARK; dORIGMARK; dTARGET;
+    djSP; dMARK; dORIGMARK; dTARGET;
     GV *gv;
     IO *io;
     int offset;
@@ -1280,8 +1319,25 @@ PP(pp_send)
     char *buffer;
     int length;
     STRLEN blen;
+    MAGIC *mg;
 
     gv = (GV*)*++MARK;
+    if (op->op_type == OP_SYSWRITE &&
+	SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
+    {
+	SV *sv;
+	
+	PUSHMARK(MARK-1);
+	*MARK = mg->mg_obj;
+	ENTER;
+	perl_call_method("WRITE", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	sv = POPs;
+	SP = ORIGMARK;
+	PUSHs(sv);
+	RETURN;
+    }
     if (!gv)
 	goto say_undef;
     bufsv = *++MARK;
@@ -1307,24 +1363,25 @@ PP(pp_send)
 		if (-offset > blen)
 		    DIE("Offset outside string");
 		offset += blen;
-	    } else if (offset >= blen)
+	    } else if (offset >= blen && blen > 0)
 		DIE("Offset outside string");
 	} else
 	    offset = 0;
 	if (length > blen - offset)
 	    length = blen - offset;
-	length = write(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
+	length = PerlLIO_write(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
     }
 #ifdef HAS_SOCKET
     else if (SP > MARK) {
 	char *sockbuf;
 	STRLEN mlen;
 	sockbuf = SvPVx(*++MARK, mlen);
-	length = sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length,
+	length = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length,
 				(struct sockaddr *)sockbuf, mlen);
     }
     else
-	length = send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
+	length = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
+
 #else
     else
 	DIE(no_sock_func, "send");
@@ -1347,7 +1404,7 @@ PP(pp_recv)
 
 PP(pp_eof)
 {
-    dSP;
+    djSP;
     GV *gv;
 
     if (MAXARG <= 0)
@@ -1360,7 +1417,7 @@ PP(pp_eof)
 
 PP(pp_tell)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     GV *gv;
 
     if (MAXARG <= 0)
@@ -1378,7 +1435,7 @@ PP(pp_seek)
 
 PP(pp_sysseek)
 {
-    dSP;
+    djSP;
     GV *gv;
     int whence = POPi;
     long offset = POPl;
@@ -1397,7 +1454,7 @@ PP(pp_sysseek)
 
 PP(pp_truncate)
 {
-    dSP;
+    djSP;
     Off_t len = (Off_t)POPn;
     int result = 1;
     GV *tmpgv;
@@ -1437,12 +1494,12 @@ PP(pp_truncate)
 #else
 	{
 	    int tmpfd;
-	    if ((tmpfd = open(name, O_RDWR)) < 0)
+	    if ((tmpfd = PerlLIO_open(name, O_RDWR)) < 0)
 		result = 0;
 	    else {
 		if (my_chsize(tmpfd, len) < 0)
 		    result = 0;
-		close(tmpfd);
+		PerlLIO_close(tmpfd);
 	    }
 	}
 #endif
@@ -1465,12 +1522,12 @@ PP(pp_fcntl)
 
 PP(pp_ioctl)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     SV *argsv = POPs;
     unsigned int func = U_I(POPn);
     int optype = op->op_type;
     char *s;
-    int retval;
+    IV retval;
     GV *gv = (GV*)POPs;
     IO *io = GvIOn(gv);
 
@@ -1481,22 +1538,19 @@ PP(pp_ioctl)
 
     if (SvPOK(argsv) || !SvNIOK(argsv)) {
 	STRLEN len;
+	STRLEN need;
 	s = SvPV_force(argsv, len);
-	retval = IOCPARM_LEN(func);
-	if (len < retval) {
-	    s = Sv_Grow(argsv, retval+1);
-	    SvCUR_set(argsv, retval);
+	need = IOCPARM_LEN(func);
+	if (len < need) {
+	    s = Sv_Grow(argsv, need + 1);
+	    SvCUR_set(argsv, need);
 	}
 
 	s[SvCUR(argsv)] = 17;	/* a little sanity check here */
     }
     else {
 	retval = SvIV(argsv);
-#ifdef DOSISH
-	s = (char*)(long)retval;	/* ouch */
-#else
 	s = (char*)retval;		/* ouch */
-#endif
     }
 
     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
@@ -1539,7 +1593,7 @@ PP(pp_ioctl)
 
 PP(pp_flock)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     I32 value;
     int argtype;
     GV *gv;
@@ -1572,7 +1626,7 @@ PP(pp_flock)
 
 PP(pp_socket)
 {
-    dSP;
+    djSP;
 #ifdef HAS_SOCKET
     GV *gv;
     register IO *io;
@@ -1593,7 +1647,7 @@ PP(pp_socket)
 	do_close(gv, FALSE);
 
     TAINT_PROPER("socket");
-    fd = socket(domain, type, protocol);
+    fd = PerlSock_socket(domain, type, protocol);
     if (fd < 0)
 	RETPUSHUNDEF;
     IoIFP(io) = PerlIO_fdopen(fd, "r");	/* stdio gets confused about sockets */
@@ -1602,7 +1656,7 @@ PP(pp_socket)
     if (!IoIFP(io) || !IoOFP(io)) {
 	if (IoIFP(io)) PerlIO_close(IoIFP(io));
 	if (IoOFP(io)) PerlIO_close(IoOFP(io));
-	if (!IoIFP(io) && !IoOFP(io)) close(fd);
+	if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd);
 	RETPUSHUNDEF;
     }
 
@@ -1614,7 +1668,7 @@ PP(pp_socket)
 
 PP(pp_sockpair)
 {
-    dSP;
+    djSP;
 #ifdef HAS_SOCKETPAIR
     GV *gv1;
     GV *gv2;
@@ -1638,7 +1692,7 @@ PP(pp_sockpair)
 	do_close(gv2, FALSE);
 
     TAINT_PROPER("socketpair");
-    if (socketpair(domain, type, protocol, fd) < 0)
+    if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
 	RETPUSHUNDEF;
     IoIFP(io1) = PerlIO_fdopen(fd[0], "r");
     IoOFP(io1) = PerlIO_fdopen(fd[0], "w");
@@ -1649,10 +1703,10 @@ PP(pp_sockpair)
     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
 	if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
 	if (IoOFP(io1)) PerlIO_close(IoOFP(io1));
-	if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
+	if (!IoIFP(io1) && !IoOFP(io1)) PerlLIO_close(fd[0]);
 	if (IoIFP(io2)) PerlIO_close(IoIFP(io2));
 	if (IoOFP(io2)) PerlIO_close(IoOFP(io2));
-	if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
+	if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]);
 	RETPUSHUNDEF;
     }
 
@@ -1664,7 +1718,7 @@ PP(pp_sockpair)
 
 PP(pp_bind)
 {
-    dSP;
+    djSP;
 #ifdef HAS_SOCKET
     SV *addrsv = POPs;
     char *addr;
@@ -1677,7 +1731,7 @@ PP(pp_bind)
 
     addr = SvPV(addrsv, len);
     TAINT_PROPER("bind");
-    if (bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+    if (PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
 	RETPUSHYES;
     else
 	RETPUSHUNDEF;
@@ -1694,7 +1748,7 @@ nuts:
 
 PP(pp_connect)
 {
-    dSP;
+    djSP;
 #ifdef HAS_SOCKET
     SV *addrsv = POPs;
     char *addr;
@@ -1707,7 +1761,7 @@ PP(pp_connect)
 
     addr = SvPV(addrsv, len);
     TAINT_PROPER("connect");
-    if (connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+    if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
 	RETPUSHYES;
     else
 	RETPUSHUNDEF;
@@ -1724,7 +1778,7 @@ nuts:
 
 PP(pp_listen)
 {
-    dSP;
+    djSP;
 #ifdef HAS_SOCKET
     int backlog = POPi;
     GV *gv = (GV*)POPs;
@@ -1733,7 +1787,7 @@ PP(pp_listen)
     if (!io || !IoIFP(io))
 	goto nuts;
 
-    if (listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
+    if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
 	RETPUSHYES;
     else
 	RETPUSHUNDEF;
@@ -1750,7 +1804,7 @@ nuts:
 
 PP(pp_accept)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
 #ifdef HAS_SOCKET
     GV *ngv;
     GV *ggv;
@@ -1776,7 +1830,7 @@ PP(pp_accept)
     if (IoIFP(nstio))
 	do_close(ngv, FALSE);
 
-    fd = accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
+    fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
     if (fd < 0)
 	goto badexit;
     IoIFP(nstio) = PerlIO_fdopen(fd, "r");
@@ -1785,7 +1839,7 @@ PP(pp_accept)
     if (!IoIFP(nstio) || !IoOFP(nstio)) {
 	if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
 	if (IoOFP(nstio)) PerlIO_close(IoOFP(nstio));
-	if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
+	if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd);
 	goto badexit;
     }
 
@@ -1807,7 +1861,7 @@ badexit:
 
 PP(pp_shutdown)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
 #ifdef HAS_SOCKET
     int how = POPi;
     GV *gv = (GV*)POPs;
@@ -1816,7 +1870,7 @@ PP(pp_shutdown)
     if (!io || !IoIFP(io))
 	goto nuts;
 
-    PUSHi( shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
+    PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
     RETURN;
 
 nuts:
@@ -1840,7 +1894,7 @@ PP(pp_gsockopt)
 
 PP(pp_ssockopt)
 {
-    dSP;
+    djSP;
 #ifdef HAS_SOCKET
     int optype = op->op_type;
     SV *sv;
@@ -1871,7 +1925,7 @@ PP(pp_ssockopt)
 	SvCUR_set(sv,256);
 	*SvEND(sv) ='\0';
 	len = SvCUR(sv);
-	if (getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
+	if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
 	    goto nuts2;
 	SvCUR_set(sv, len);
 	*SvEND(sv) ='\0';
@@ -1889,7 +1943,7 @@ PP(pp_ssockopt)
 		buf = (char*)&aint;
 		len = sizeof(int);
 	    }
-	    if (setsockopt(fd, lvl, optname, buf, len) < 0)
+	    if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
 		goto nuts2;
 	    PUSHs(&sv_yes);
 	}
@@ -1920,7 +1974,7 @@ PP(pp_getsockname)
 
 PP(pp_getpeername)
 {
-    dSP;
+    djSP;
 #ifdef HAS_SOCKET
     int optype = op->op_type;
     SV *sv;
@@ -1940,12 +1994,23 @@ PP(pp_getpeername)
     fd = PerlIO_fileno(IoIFP(io));
     switch (optype) {
     case OP_GETSOCKNAME:
-	if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
+	if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
 	    goto nuts2;
 	break;
     case OP_GETPEERNAME:
-	if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
+	if (PerlSock_getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
 	    goto nuts2;
+#if defined(VMS_DO_SOCKETS) && defined (DECCRTL_SOCKETS)
+	{
+	    static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
+	    /* If the call succeeded, make sure we don't have a zeroed port/addr */
+	    if (((struct sockaddr *)SvPVX(sv))->sa_family == AF_INET &&
+		!memcmp((char *)SvPVX(sv) + sizeof(u_short), nowhere,
+			sizeof(u_short) + sizeof(struct in_addr))) {
+		goto nuts2;	    
+	    }
+	}
+#endif
 	break;
     }
 #ifdef BOGUS_GETNAME_RETURN
@@ -1980,7 +2045,7 @@ PP(pp_lstat)
 
 PP(pp_stat)
 {
-    dSP;
+    djSP;
     GV *tmpgv;
     I32 gimme;
     I32 max = 13;
@@ -1993,7 +2058,7 @@ PP(pp_stat)
 	    statgv = tmpgv;
 	    sv_setpv(statname, "");
 	    laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv))
-		? Fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) : -1);
+		? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) : -1);
 	}
 	if (laststatval < 0)
 	    max = 0;
@@ -2013,10 +2078,10 @@ PP(pp_stat)
 #ifdef HAS_LSTAT
 	laststype = op->op_type;
 	if (op->op_type == OP_LSTAT)
-	    laststatval = lstat(SvPV(statname, na), &statcache);
+	    laststatval = PerlLIO_lstat(SvPV(statname, na), &statcache);
 	else
 #endif
-	    laststatval = Stat(SvPV(statname, na), &statcache);
+	    laststatval = PerlLIO_stat(SvPV(statname, na), &statcache);
 	if (laststatval < 0) {
 	    if (dowarn && strchr(SvPV(statname, na), '\n'))
 		warn(warn_nl, "stat");
@@ -2068,7 +2133,7 @@ PP(pp_stat)
 PP(pp_ftrread)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (cando(S_IRUSR, 0, &statcache))
@@ -2079,7 +2144,7 @@ PP(pp_ftrread)
 PP(pp_ftrwrite)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (cando(S_IWUSR, 0, &statcache))
@@ -2090,7 +2155,7 @@ PP(pp_ftrwrite)
 PP(pp_ftrexec)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (cando(S_IXUSR, 0, &statcache))
@@ -2101,7 +2166,7 @@ PP(pp_ftrexec)
 PP(pp_fteread)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (cando(S_IRUSR, 1, &statcache))
@@ -2112,7 +2177,7 @@ PP(pp_fteread)
 PP(pp_ftewrite)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (cando(S_IWUSR, 1, &statcache))
@@ -2123,7 +2188,7 @@ PP(pp_ftewrite)
 PP(pp_fteexec)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (cando(S_IXUSR, 1, &statcache))
@@ -2134,7 +2199,7 @@ PP(pp_fteexec)
 PP(pp_ftis)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     RETPUSHYES;
@@ -2148,7 +2213,7 @@ PP(pp_fteowned)
 PP(pp_ftrowned)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
@@ -2159,7 +2224,7 @@ PP(pp_ftrowned)
 PP(pp_ftzero)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (!statcache.st_size)
@@ -2170,7 +2235,7 @@ PP(pp_ftzero)
 PP(pp_ftsize)
 {
     I32 result = my_stat(ARGS);
-    dSP; dTARGET;
+    djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
     PUSHi(statcache.st_size);
@@ -2180,7 +2245,7 @@ PP(pp_ftsize)
 PP(pp_ftmtime)
 {
     I32 result = my_stat(ARGS);
-    dSP; dTARGET;
+    djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
     PUSHn( ((I32)basetime - (I32)statcache.st_mtime) / 86400.0 );
@@ -2190,7 +2255,7 @@ PP(pp_ftmtime)
 PP(pp_ftatime)
 {
     I32 result = my_stat(ARGS);
-    dSP; dTARGET;
+    djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
     PUSHn( ((I32)basetime - (I32)statcache.st_atime) / 86400.0 );
@@ -2200,7 +2265,7 @@ PP(pp_ftatime)
 PP(pp_ftctime)
 {
     I32 result = my_stat(ARGS);
-    dSP; dTARGET;
+    djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
     PUSHn( ((I32)basetime - (I32)statcache.st_ctime) / 86400.0 );
@@ -2210,7 +2275,7 @@ PP(pp_ftctime)
 PP(pp_ftsock)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISSOCK(statcache.st_mode))
@@ -2221,7 +2286,7 @@ PP(pp_ftsock)
 PP(pp_ftchr)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISCHR(statcache.st_mode))
@@ -2232,7 +2297,7 @@ PP(pp_ftchr)
 PP(pp_ftblk)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISBLK(statcache.st_mode))
@@ -2243,7 +2308,7 @@ PP(pp_ftblk)
 PP(pp_ftfile)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISREG(statcache.st_mode))
@@ -2254,7 +2319,7 @@ PP(pp_ftfile)
 PP(pp_ftdir)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISDIR(statcache.st_mode))
@@ -2265,7 +2330,7 @@ PP(pp_ftdir)
 PP(pp_ftpipe)
 {
     I32 result = my_stat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISFIFO(statcache.st_mode))
@@ -2276,7 +2341,7 @@ PP(pp_ftpipe)
 PP(pp_ftlink)
 {
     I32 result = my_lstat(ARGS);
-    dSP;
+    djSP;
     if (result < 0)
 	RETPUSHUNDEF;
     if (S_ISLNK(statcache.st_mode))
@@ -2286,7 +2351,7 @@ PP(pp_ftlink)
 
 PP(pp_ftsuid)
 {
-    dSP;
+    djSP;
 #ifdef S_ISUID
     I32 result = my_stat(ARGS);
     SPAGAIN;
@@ -2300,7 +2365,7 @@ PP(pp_ftsuid)
 
 PP(pp_ftsgid)
 {
-    dSP;
+    djSP;
 #ifdef S_ISGID
     I32 result = my_stat(ARGS);
     SPAGAIN;
@@ -2314,7 +2379,7 @@ PP(pp_ftsgid)
 
 PP(pp_ftsvtx)
 {
-    dSP;
+    djSP;
 #ifdef S_ISVTX
     I32 result = my_stat(ARGS);
     SPAGAIN;
@@ -2328,23 +2393,27 @@ PP(pp_ftsvtx)
 
 PP(pp_fttty)
 {
-    dSP;
+    djSP;
     int fd;
     GV *gv;
-    char *tmps;
-    if (op->op_flags & OPf_REF) {
+    char *tmps = Nullch;
+
+    if (op->op_flags & OPf_REF)
 	gv = cGVOP->op_gv;
-	tmps = "";
-    }
+    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);
+
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
 	fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
-    else if (isDIGIT(*tmps))
+    else if (tmps && isDIGIT(*tmps))
 	fd = atoi(tmps);
     else
 	RETPUSHUNDEF;
-    if (isatty(fd))
+    if (PerlLIO_isatty(fd))
 	RETPUSHYES;
     RETPUSHNO;
 }
@@ -2359,7 +2428,7 @@ PP(pp_fttty)
 
 PP(pp_fttext)
 {
-    dSP;
+    djSP;
     I32 i;
     I32 len;
     I32 odd = 0;
@@ -2397,7 +2466,7 @@ PP(pp_fttext)
 	if (io && IoIFP(io)) {
 	    if (! PerlIO_has_base(IoIFP(io)))
 		DIE("-T and -B not implemented on filehandles");
-	    laststatval = Fstat(PerlIO_fileno(IoIFP(io)), &statcache);
+	    laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &statcache);
 	    if (laststatval < 0)
 		RETPUSHUNDEF;
 	    if (S_ISDIR(statcache.st_mode))	/* handle NFS glitch */
@@ -2433,20 +2502,20 @@ PP(pp_fttext)
 	laststatval = -1;
 	sv_setpv(statname, SvPV(sv, na));
 #ifdef HAS_OPEN3
-	i = open(SvPV(sv, na), O_RDONLY, 0);
+	i = PerlLIO_open3(SvPV(sv, na), O_RDONLY, 0);
 #else
-	i = open(SvPV(sv, na), 0);
+	i = PerlLIO_open(SvPV(sv, na), 0);
 #endif
 	if (i < 0) {
 	    if (dowarn && strchr(SvPV(sv, na), '\n'))
 		warn(warn_nl, "open");
 	    RETPUSHUNDEF;
 	}
-	laststatval = Fstat(i, &statcache);
+	laststatval = PerlLIO_fstat(i, &statcache);
 	if (laststatval < 0)
 	    RETPUSHUNDEF;
-	len = read(i, tbuf, 512);
-	(void)close(i);
+	len = PerlLIO_read(i, tbuf, 512);
+	(void)PerlLIO_close(i);
 	if (len <= 0) {
 	    if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
 		RETPUSHNO;		/* special case NFS directories */
@@ -2486,7 +2555,7 @@ PP(pp_ftbinary)
 
 PP(pp_chdir)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     char *tmps;
     SV **svp;
 
@@ -2504,8 +2573,15 @@ PP(pp_chdir)
 	if (svp)
 	    tmps = SvPV(*svp, na);
     }
+#ifdef VMS
+    if (!tmps || !*tmps) {
+       svp = hv_fetch(GvHVn(envgv), "SYS$LOGIN", 9, FALSE);
+       if (svp)
+           tmps = SvPV(*svp, na);
+    }
+#endif
     TAINT_PROPER("chdir");
-    PUSHi( chdir(tmps) >= 0 );
+    PUSHi( PerlDir_chdir(tmps) >= 0 );
 #ifdef VMS
     /* Clear the DEFAULT element of ENV so we'll get the new value
      * in the future. */
@@ -2516,7 +2592,7 @@ PP(pp_chdir)
 
 PP(pp_chown)
 {
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     I32 value;
 #ifdef HAS_CHOWN
     value = (I32)apply(op->op_type, MARK, SP);
@@ -2530,7 +2606,7 @@ PP(pp_chown)
 
 PP(pp_chroot)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     char *tmps;
 #ifdef HAS_CHROOT
     tmps = POPp;
@@ -2544,7 +2620,7 @@ PP(pp_chroot)
 
 PP(pp_unlink)
 {
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     I32 value;
     value = (I32)apply(op->op_type, MARK, SP);
     SP = MARK;
@@ -2554,7 +2630,7 @@ PP(pp_unlink)
 
 PP(pp_chmod)
 {
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     I32 value;
     value = (I32)apply(op->op_type, MARK, SP);
     SP = MARK;
@@ -2564,7 +2640,7 @@ PP(pp_chmod)
 
 PP(pp_utime)
 {
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     I32 value;
     value = (I32)apply(op->op_type, MARK, SP);
     SP = MARK;
@@ -2574,7 +2650,7 @@ PP(pp_utime)
 
 PP(pp_rename)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     int anum;
 
     char *tmps2 = POPp;
@@ -2583,11 +2659,11 @@ PP(pp_rename)
 #ifdef HAS_RENAME
     anum = rename(tmps, tmps2);
 #else
-    if (!(anum = Stat(tmps, &statbuf))) {
+    if (!(anum = PerlLIO_stat(tmps, &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 (euid || PerlLIO_stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
 		(void)UNLINK(tmps2);
 	    if (!(anum = link(tmps, tmps2)))
 		anum = UNLINK(tmps);
@@ -2600,7 +2676,7 @@ PP(pp_rename)
 
 PP(pp_link)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
 #ifdef HAS_LINK
     char *tmps2 = POPp;
     char *tmps = SvPV(TOPs, na);
@@ -2614,7 +2690,7 @@ PP(pp_link)
 
 PP(pp_symlink)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
 #ifdef HAS_SYMLINK
     char *tmps2 = POPp;
     char *tmps = SvPV(TOPs, na);
@@ -2628,10 +2704,15 @@ PP(pp_symlink)
 
 PP(pp_readlink)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
 #ifdef HAS_SYMLINK
     char *tmps;
+    char buf[MAXPATHLEN];
     int len;
+
+#ifndef INCOMPLETE_TAINTS
+    TAINT;
+#endif
     tmps = POPp;
     len = readlink(tmps, buf, sizeof buf);
     EXTEND(SP, 1);
@@ -2665,14 +2746,14 @@ char *filename;
 	*s++ = *filename++;
     }
     strcpy(s, " 2>&1");
-    myfp = my_popen(cmdline, "r");
+    myfp = PerlProc_popen(cmdline, "r");
     Safefree(cmdline);
 
     if (myfp) {
 	SV *tmpsv = sv_newmortal();
 	/* Need to save/restore 'rs' ?? */
 	s = sv_gets(tmpsv, myfp, 0);
-	(void)my_pclose(myfp);
+	(void)PerlProc_pclose(myfp);
 	if (s != Nullch) {
 	    int e;
 	    for (e = 1;
@@ -2719,7 +2800,7 @@ char *filename;
 	    return 0;
 	}
 	else {	/* some mkdirs return no failure indication */
-	    anum = (Stat(save_filename, &statbuf) >= 0);
+	    anum = (PerlLIO_stat(save_filename, &statbuf) >= 0);
 	    if (op->op_type == OP_RMDIR)
 		anum = !anum;
 	    if (anum)
@@ -2736,7 +2817,7 @@ char *filename;
 
 PP(pp_mkdir)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     int mode = POPi;
 #ifndef HAS_MKDIR
     int oldumask;
@@ -2745,25 +2826,25 @@ PP(pp_mkdir)
 
     TAINT_PROPER("mkdir");
 #ifdef HAS_MKDIR
-    SETi( Mkdir(tmps, mode) >= 0 );
+    SETi( PerlDir_mkdir(tmps, mode) >= 0 );
 #else
     SETi( dooneliner("mkdir", tmps) );
-    oldumask = umask(0);
-    umask(oldumask);
-    chmod(tmps, (mode & ~oldumask) & 0777);
+    oldumask = PerlLIO_umask(0);
+    PerlLIO_umask(oldumask);
+    PerlLIO_chmod(tmps, (mode & ~oldumask) & 0777);
 #endif
     RETURN;
 }
 
 PP(pp_rmdir)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     char *tmps;
 
     tmps = POPp;
     TAINT_PROPER("rmdir");
 #ifdef HAS_RMDIR
-    XPUSHi( rmdir(tmps) >= 0 );
+    XPUSHi( PerlDir_rmdir(tmps) >= 0 );
 #else
     XPUSHi( dooneliner("rmdir", tmps) );
 #endif
@@ -2774,7 +2855,7 @@ PP(pp_rmdir)
 
 PP(pp_open_dir)
 {
-    dSP;
+    djSP;
 #if defined(Direntry_t) && defined(HAS_READDIR)
     char *dirname = POPp;
     GV *gv = (GV*)POPs;
@@ -2784,8 +2865,8 @@ PP(pp_open_dir)
 	goto nope;
 
     if (IoDIRP(io))
-	closedir(IoDIRP(io));
-    if (!(IoDIRP(io) = opendir(dirname)))
+	PerlDir_close(IoDIRP(io));
+    if (!(IoDIRP(io) = PerlDir_open(dirname)))
 	goto nope;
 
     RETPUSHYES;
@@ -2800,7 +2881,7 @@ nope:
 
 PP(pp_readdir)
 {
-    dSP;
+    djSP;
 #if defined(Direntry_t) && defined(HAS_READDIR)
 #ifndef I_DIRENT
     Direntry_t *readdir _((DIR *));
@@ -2808,28 +2889,37 @@ PP(pp_readdir)
     register Direntry_t *dp;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
+    SV *sv;
 
     if (!io || !IoDIRP(io))
 	goto nope;
 
     if (GIMME == G_ARRAY) {
 	/*SUPPRESS 560*/
-	while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
+	while (dp = (Direntry_t *)PerlDir_read(IoDIRP(io))) {
 #ifdef DIRNAMLEN
-	    XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
+	    sv = newSVpv(dp->d_name, dp->d_namlen);
 #else
-	    XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
+	    sv = newSVpv(dp->d_name, 0);
+#endif
+#ifndef INCOMPLETE_TAINTS
+  	    SvTAINTED_on(sv);
 #endif
+	    XPUSHs(sv_2mortal(sv));
 	}
     }
     else {
-	if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
+	if (!(dp = (Direntry_t *)PerlDir_read(IoDIRP(io))))
 	    goto nope;
 #ifdef DIRNAMLEN
-	XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
+	sv = newSVpv(dp->d_name, dp->d_namlen);
 #else
-	XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
+	sv = newSVpv(dp->d_name, 0);
 #endif
+#ifndef INCOMPLETE_TAINTS
+	SvTAINTED_on(sv);
+#endif
+	XPUSHs(sv_2mortal(sv));
     }
     RETURN;
 
@@ -2847,18 +2937,18 @@ nope:
 
 PP(pp_telldir)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
 #if defined(HAS_TELLDIR) || defined(telldir)
-#if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE)
+# ifdef NEED_TELLDIR_PROTO /* XXX does _anyone_ need this? --AD 2/20/1998 */
     long telldir _((DIR *));
-#endif
+# endif
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
 
     if (!io || !IoDIRP(io))
 	goto nope;
 
-    PUSHi( telldir(IoDIRP(io)) );
+    PUSHi( PerlDir_tell(IoDIRP(io)) );
     RETURN;
 nope:
     if (!errno)
@@ -2871,7 +2961,7 @@ nope:
 
 PP(pp_seekdir)
 {
-    dSP;
+    djSP;
 #if defined(HAS_SEEKDIR) || defined(seekdir)
     long along = POPl;
     GV *gv = (GV*)POPs;
@@ -2880,7 +2970,7 @@ PP(pp_seekdir)
     if (!io || !IoDIRP(io))
 	goto nope;
 
-    (void)seekdir(IoDIRP(io), along);
+    (void)PerlDir_seek(IoDIRP(io), along);
 
     RETPUSHYES;
 nope:
@@ -2894,7 +2984,7 @@ nope:
 
 PP(pp_rewinddir)
 {
-    dSP;
+    djSP;
 #if defined(HAS_REWINDDIR) || defined(rewinddir)
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
@@ -2902,7 +2992,7 @@ PP(pp_rewinddir)
     if (!io || !IoDIRP(io))
 	goto nope;
 
-    (void)rewinddir(IoDIRP(io));
+    (void)PerlDir_rewind(IoDIRP(io));
     RETPUSHYES;
 nope:
     if (!errno)
@@ -2915,7 +3005,7 @@ nope:
 
 PP(pp_closedir)
 {
-    dSP;
+    djSP;
 #if defined(Direntry_t) && defined(HAS_READDIR)
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
@@ -2924,9 +3014,9 @@ PP(pp_closedir)
 	goto nope;
 
 #ifdef VOID_CLOSEDIR
-    closedir(IoDIRP(io));
+    PerlDir_close(IoDIRP(io));
 #else
-    if (closedir(IoDIRP(io)) < 0) {
+    if (PerlDir_close(IoDIRP(io)) < 0) {
 	IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */
 	goto nope;
     }
@@ -2948,7 +3038,7 @@ nope:
 PP(pp_fork)
 {
 #ifdef HAS_FORK
-    dSP; dTARGET;
+    djSP; dTARGET;
     int childpid;
     GV *tmpgv;
 
@@ -2971,8 +3061,8 @@ PP(pp_fork)
 
 PP(pp_wait)
 {
-#if !defined(DOSISH) || defined(OS2)
-    dSP; dTARGET;
+#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
+    djSP; dTARGET;
     int childpid;
     int argflags;
 
@@ -2987,8 +3077,8 @@ PP(pp_wait)
 
 PP(pp_waitpid)
 {
-#if !defined(DOSISH) || defined(OS2)
-    dSP; dTARGET;
+#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
+    djSP; dTARGET;
     int childpid;
     int optype;
     int argflags;
@@ -3000,13 +3090,13 @@ PP(pp_waitpid)
     SETi(childpid);
     RETURN;
 #else
-    DIE(no_func, "Unsupported function wait");
+    DIE(no_func, "Unsupported function waitpid");
 #endif
 }
 
 PP(pp_system)
 {
-    dSP; dMARK; dORIGMARK; dTARGET;
+    djSP; dMARK; dORIGMARK; dTARGET;
     I32 value;
     int childpid;
     int result;
@@ -3053,14 +3143,14 @@ PP(pp_system)
     else {
 	value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
     }
-    _exit(-1);
+    PerlProc__exit(-1);
 #else /* ! FORK or VMS or OS/2 */
     if (op->op_flags & OPf_STACKED) {
 	SV *really = *++MARK;
-	value = (I32)do_aspawn(really, MARK, SP);
+	value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
     }
     else if (SP - MARK != 1)
-	value = (I32)do_aspawn(Nullsv, MARK, SP);
+	value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
     else {
 	value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
     }
@@ -3074,7 +3164,7 @@ PP(pp_system)
 
 PP(pp_exec)
 {
-    dSP; dMARK; dORIGMARK; dTARGET;
+    djSP; dMARK; dORIGMARK; dTARGET;
     I32 value;
 
     if (op->op_flags & OPf_STACKED) {
@@ -3106,7 +3196,7 @@ PP(pp_exec)
 
 PP(pp_kill)
 {
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     I32 value;
 #ifdef HAS_KILL
     value = (I32)apply(op->op_type, MARK, SP);
@@ -3121,7 +3211,7 @@ PP(pp_kill)
 PP(pp_getppid)
 {
 #ifdef HAS_GETPPID
-    dSP; dTARGET;
+    djSP; dTARGET;
     XPUSHi( getppid() );
     RETURN;
 #else
@@ -3132,7 +3222,7 @@ PP(pp_getppid)
 PP(pp_getpgrp)
 {
 #ifdef HAS_GETPGRP
-    dSP; dTARGET;
+    djSP; dTARGET;
     int pid;
     I32 value;
 
@@ -3157,7 +3247,7 @@ PP(pp_getpgrp)
 PP(pp_setpgrp)
 {
 #ifdef HAS_SETPGRP
-    dSP; dTARGET;
+    djSP; dTARGET;
     int pgrp;
     int pid;
     if (MAXARG < 2) {
@@ -3173,7 +3263,7 @@ PP(pp_setpgrp)
 #ifdef BSD_SETPGRP
     SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
 #else
-    if ((pgrp != 0 && pgrp != getpid())) || (pid != 0 && pid != getpid()))
+    if ((pgrp != 0 && pgrp != getpid()) || (pid != 0 && pid != getpid()))
 	DIE("POSIX setpgrp can't take an argument");
     SETi( setpgrp() >= 0 );
 #endif /* USE_BSDPGRP */
@@ -3185,7 +3275,7 @@ PP(pp_setpgrp)
 
 PP(pp_getpriority)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     int which;
     int who;
 #ifdef HAS_GETPRIORITY
@@ -3200,7 +3290,7 @@ PP(pp_getpriority)
 
 PP(pp_setpriority)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     int which;
     int who;
     int niceval;
@@ -3220,7 +3310,7 @@ PP(pp_setpriority)
 
 PP(pp_time)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
 #ifdef BIG_TIME
     XPUSHn( time(Null(Time_t*)) );
 #else
@@ -3247,7 +3337,7 @@ PP(pp_time)
 
 PP(pp_tms)
 {
-    dSP;
+    djSP;
 
 #ifndef HAS_TIMES
     DIE("times not implemented");
@@ -3279,7 +3369,7 @@ PP(pp_localtime)
 
 PP(pp_gmtime)
 {
-    dSP;
+    djSP;
     Time_t when;
     struct tm *tmbuf;
     static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
@@ -3304,18 +3394,18 @@ PP(pp_gmtime)
     EXTEND_MORTAL(9);
     if (GIMME != G_ARRAY) {
 	dTARGET;
-	char mybuf[30];
+	SV *tsv;
 	if (!tmbuf)
 	    RETPUSHUNDEF;
-	sprintf(mybuf, "%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);
-	PUSHp(mybuf, strlen(mybuf));
+	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);
+	PUSHs(sv_2mortal(tsv));
     }
     else if (tmbuf) {
 	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
@@ -3333,7 +3423,7 @@ PP(pp_gmtime)
 
 PP(pp_alarm)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     int anum;
 #ifdef HAS_ALARM
     anum = POPi;
@@ -3350,7 +3440,7 @@ PP(pp_alarm)
 
 PP(pp_sleep)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
     I32 duration;
     Time_t lasttime;
     Time_t when;
@@ -3387,7 +3477,7 @@ PP(pp_shmread)
 PP(pp_shmwrite)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
     SP = MARK;
     PUSHi(value);
@@ -3412,7 +3502,7 @@ PP(pp_msgctl)
 PP(pp_msgsnd)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
     SP = MARK;
     PUSHi(value);
@@ -3425,7 +3515,7 @@ PP(pp_msgsnd)
 PP(pp_msgrcv)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
     SP = MARK;
     PUSHi(value);
@@ -3440,7 +3530,7 @@ PP(pp_msgrcv)
 PP(pp_semget)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     int anum = do_ipcget(op->op_type, MARK, SP);
     SP = MARK;
     if (anum == -1)
@@ -3455,7 +3545,7 @@ PP(pp_semget)
 PP(pp_semctl)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     int anum = do_ipcctl(op->op_type, MARK, SP);
     SP = MARK;
     if (anum == -1)
@@ -3475,7 +3565,7 @@ PP(pp_semctl)
 PP(pp_semop)
 {
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
-    dSP; dMARK; dTARGET;
+    djSP; dMARK; dTARGET;
     I32 value = (I32)(do_semop(MARK, SP) >= 0);
     SP = MARK;
     PUSHi(value);
@@ -3489,7 +3579,7 @@ PP(pp_semop)
 
 PP(pp_ghbyname)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETHOSTBYNAME
     return pp_ghostent(ARGS);
 #else
     DIE(no_sock_func, "gethostbyname");
@@ -3498,7 +3588,7 @@ PP(pp_ghbyname)
 
 PP(pp_ghbyaddr)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETHOSTBYADDR
     return pp_ghostent(ARGS);
 #else
     DIE(no_sock_func, "gethostbyaddr");
@@ -3507,36 +3597,43 @@ PP(pp_ghbyaddr)
 
 PP(pp_ghostent)
 {
-    dSP;
-#ifdef HAS_SOCKET
+    djSP;
+#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
     I32 which = op->op_type;
     register char **elem;
     register SV *sv;
-    struct hostent *gethostbyname();
-    struct hostent *gethostbyaddr();
-#ifdef HAS_GETHOSTENT
-    struct hostent *gethostent();
+#ifndef HAS_GETHOST_PROTOS /* XXX Do we need individual probes? */
+    struct hostent *PerlSock_gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int);
+    struct hostent *PerlSock_gethostbyname(Netdb_name_t);
+    struct hostent *PerlSock_gethostent(void);
 #endif
     struct hostent *hent;
     unsigned long len;
 
     EXTEND(SP, 10);
-    if (which == OP_GHBYNAME) {
-	hent = gethostbyname(POPp);
-    }
+    if (which == OP_GHBYNAME)
+#ifdef HAS_GETHOSTBYNAME
+	hent = PerlSock_gethostbyname(POPp);
+#else
+	DIE(no_sock_func, "gethostbyname");
+#endif
     else if (which == OP_GHBYADDR) {
+#ifdef HAS_GETHOSTBYADDR
 	int addrtype = POPi;
 	SV *addrsv = POPs;
 	STRLEN addrlen;
-	char *addr = SvPV(addrsv, addrlen);
+	Netdb_host_t addr = (Netdb_host_t) SvPV(addrsv, addrlen);
 
-	hent = gethostbyaddr(addr, addrlen, addrtype);
+	hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
+#else
+	DIE(no_sock_func, "gethostbyaddr");
+#endif
     }
     else
 #ifdef HAS_GETHOSTENT
-	hent = gethostent();
+	hent = PerlSock_gethostent();
 #else
-	DIE("gethostent not implemented");
+	DIE(no_sock_func, "gethostent");
 #endif
 
 #ifdef HOST_NOT_FOUND
@@ -3590,7 +3687,7 @@ PP(pp_ghostent)
 
 PP(pp_gnbyname)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETNETBYNAME
     return pp_gnetent(ARGS);
 #else
     DIE(no_sock_func, "getnetbyname");
@@ -3599,7 +3696,7 @@ PP(pp_gnbyname)
 
 PP(pp_gnbyaddr)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETNETBYADDR
     return pp_gnetent(ARGS);
 #else
     DIE(no_sock_func, "getnetbyaddr");
@@ -3608,25 +3705,39 @@ PP(pp_gnbyaddr)
 
 PP(pp_gnetent)
 {
-    dSP;
-#ifdef HAS_SOCKET
+    djSP;
+#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
     I32 which = op->op_type;
     register char **elem;
     register SV *sv;
-    struct netent *getnetbyname();
-    struct netent *getnetbyaddr();
-    struct netent *getnetent();
+#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;
 
     if (which == OP_GNBYNAME)
-	nent = getnetbyname(POPp);
+#ifdef HAS_GETNETBYNAME
+	nent = PerlSock_getnetbyname(POPp);
+#else
+        DIE(no_sock_func, "getnetbyname");
+#endif
     else if (which == OP_GNBYADDR) {
+#ifdef HAS_GETNETBYADDR
 	int addrtype = POPi;
-	unsigned long addr = U_L(POPn);
-	nent = getnetbyaddr((long)addr, addrtype);
+	Netdb_net_t addr = (Netdb_net_t) U_L(POPn);
+	nent = PerlSock_getnetbyaddr(addr, addrtype);
+#else
+	DIE(no_sock_func, "getnetbyaddr");
+#endif
     }
     else
-	nent = getnetent();
+#ifdef HAS_GETNETENT
+	nent = PerlSock_getnetent();
+#else
+        DIE(no_sock_func, "getnetent");
+#endif
 
     EXTEND(SP, 4);
     if (GIMME != G_ARRAY) {
@@ -3644,7 +3755,7 @@ PP(pp_gnetent)
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setpv(sv, nent->n_name);
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	for (elem = nent->n_aliases; *elem; elem++) {
+	for (elem = nent->n_aliases; elem && *elem; elem++) {
 	    sv_catpv(sv, *elem);
 	    if (elem[1])
 		sv_catpvn(sv, " ", 1);
@@ -3663,7 +3774,7 @@ PP(pp_gnetent)
 
 PP(pp_gpbyname)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETPROTOBYNAME
     return pp_gprotoent(ARGS);
 #else
     DIE(no_sock_func, "getprotobyname");
@@ -3672,7 +3783,7 @@ PP(pp_gpbyname)
 
 PP(pp_gpbynumber)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETPROTOBYNUMBER
     return pp_gprotoent(ARGS);
 #else
     DIE(no_sock_func, "getprotobynumber");
@@ -3681,22 +3792,36 @@ PP(pp_gpbynumber)
 
 PP(pp_gprotoent)
 {
-    dSP;
-#ifdef HAS_SOCKET
+    djSP;
+#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
     I32 which = op->op_type;
     register char **elem;
-    register SV *sv;
-    struct protoent *getprotobyname();
-    struct protoent *getprotobynumber();
-    struct protoent *getprotoent();
+    register SV *sv;  
+#ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
+    struct protoent *PerlSock_getprotobyname(Netdb_name_t);
+    struct protoent *PerlSock_getprotobynumber(int);
+    struct protoent *PerlSock_getprotoent(void);
+#endif
     struct protoent *pent;
 
     if (which == OP_GPBYNAME)
-	pent = getprotobyname(POPp);
+#ifdef HAS_GETPROTOBYNAME
+	pent = PerlSock_getprotobyname(POPp);
+#else
+	DIE(no_sock_func, "getprotobyname");
+#endif
     else if (which == OP_GPBYNUMBER)
-	pent = getprotobynumber(POPi);
+#ifdef HAS_GETPROTOBYNUMBER
+	pent = PerlSock_getprotobynumber(POPi);
+#else
+    DIE(no_sock_func, "getprotobynumber");
+#endif
     else
-	pent = getprotoent();
+#ifdef HAS_GETPROTOENT
+	pent = PerlSock_getprotoent();
+#else
+	DIE(no_sock_func, "getprotoent");
+#endif
 
     EXTEND(SP, 3);
     if (GIMME != G_ARRAY) {
@@ -3714,7 +3839,7 @@ PP(pp_gprotoent)
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setpv(sv, pent->p_name);
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	for (elem = pent->p_aliases; *elem; elem++) {
+	for (elem = pent->p_aliases; elem && *elem; elem++) {
 	    sv_catpv(sv, *elem);
 	    if (elem[1])
 		sv_catpvn(sv, " ", 1);
@@ -3731,7 +3856,7 @@ PP(pp_gprotoent)
 
 PP(pp_gsbyname)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETSERVBYNAME
     return pp_gservent(ARGS);
 #else
     DIE(no_sock_func, "getservbyname");
@@ -3740,7 +3865,7 @@ PP(pp_gsbyname)
 
 PP(pp_gsbyport)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETSERVBYPORT
     return pp_gservent(ARGS);
 #else
     DIE(no_sock_func, "getservbyport");
@@ -3749,36 +3874,50 @@ PP(pp_gsbyport)
 
 PP(pp_gservent)
 {
-    dSP;
-#ifdef HAS_SOCKET
+    djSP;
+#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
     I32 which = op->op_type;
     register char **elem;
     register SV *sv;
-    struct servent *getservbyname();
-    struct servent *getservbynumber();
-    struct servent *getservent();
+#ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
+    struct servent *PerlSock_getservbyname(Netdb_name_t, Netdb_name_t);
+    struct servent *PerlSock_getservbyport(int, Netdb_name_t);
+    struct servent *PerlSock_getservent(void);
+#endif
     struct servent *sent;
 
     if (which == OP_GSBYNAME) {
+#ifdef HAS_GETSERVBYNAME
 	char *proto = POPp;
 	char *name = POPp;
 
 	if (proto && !*proto)
 	    proto = Nullch;
 
-	sent = getservbyname(name, proto);
+	sent = PerlSock_getservbyname(name, proto);
+#else
+	DIE(no_sock_func, "getservbyname");
+#endif
     }
     else if (which == OP_GSBYPORT) {
+#ifdef HAS_GETSERVBYPORT
 	char *proto = POPp;
 	unsigned short port = POPu;
 
 #ifdef HAS_HTONS
-	port = htons(port);
+	port = PerlSock_htons(port);
+#endif
+	sent = PerlSock_getservbyport(port, proto);
+#else
+	DIE(no_sock_func, "getservbyport");
 #endif
-	sent = getservbyport(port, proto);
     }
     else
-	sent = getservent();
+#ifdef HAS_GETSERVENT
+	sent = PerlSock_getservent();
+#else
+	DIE(no_sock_func, "getservent");
+#endif
 
     EXTEND(SP, 4);
     if (GIMME != G_ARRAY) {
@@ -3786,7 +3925,7 @@ PP(pp_gservent)
 	if (sent) {
 	    if (which == OP_GSBYNAME) {
 #ifdef HAS_NTOHS
-		sv_setiv(sv, (IV)ntohs(sent->s_port));
+		sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port));
 #else
 		sv_setiv(sv, (IV)(sent->s_port));
 #endif
@@ -3801,7 +3940,7 @@ PP(pp_gservent)
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setpv(sv, sent->s_name);
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	for (elem = sent->s_aliases; *elem; elem++) {
+	for (elem = sent->s_aliases; elem && *elem; elem++) {
 	    sv_catpv(sv, *elem);
 	    if (elem[1])
 		sv_catpvn(sv, " ", 1);
@@ -3824,8 +3963,8 @@ PP(pp_gservent)
 
 PP(pp_shostent)
 {
-    dSP;
-#ifdef HAS_SOCKET
+    djSP;
+#ifdef HAS_SETHOSTENT
     sethostent(TOPi);
     RETSETYES;
 #else
@@ -3835,8 +3974,8 @@ PP(pp_shostent)
 
 PP(pp_snetent)
 {
-    dSP;
-#ifdef HAS_SOCKET
+    djSP;
+#ifdef HAS_SETNETENT
     setnetent(TOPi);
     RETSETYES;
 #else
@@ -3846,8 +3985,8 @@ PP(pp_snetent)
 
 PP(pp_sprotoent)
 {
-    dSP;
-#ifdef HAS_SOCKET
+    djSP;
+#ifdef HAS_SETPROTOENT
     setprotoent(TOPi);
     RETSETYES;
 #else
@@ -3857,8 +3996,8 @@ PP(pp_sprotoent)
 
 PP(pp_sservent)
 {
-    dSP;
-#ifdef HAS_SOCKET
+    djSP;
+#ifdef HAS_SETSERVENT
     setservent(TOPi);
     RETSETYES;
 #else
@@ -3868,10 +4007,10 @@ PP(pp_sservent)
 
 PP(pp_ehostent)
 {
-    dSP;
-#ifdef HAS_SOCKET
-    endhostent();
-    EXTEND(sp,1);
+    djSP;
+#ifdef HAS_ENDHOSTENT
+    PerlSock_endhostent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endhostent");
@@ -3880,10 +4019,10 @@ PP(pp_ehostent)
 
 PP(pp_enetent)
 {
-    dSP;
-#ifdef HAS_SOCKET
-    endnetent();
-    EXTEND(sp,1);
+    djSP;
+#ifdef HAS_ENDNETENT
+    PerlSock_endnetent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endnetent");
@@ -3892,10 +4031,10 @@ PP(pp_enetent)
 
 PP(pp_eprotoent)
 {
-    dSP;
-#ifdef HAS_SOCKET
-    endprotoent();
-    EXTEND(sp,1);
+    djSP;
+#ifdef HAS_ENDPROTOENT
+    PerlSock_endprotoent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endprotoent");
@@ -3904,10 +4043,10 @@ PP(pp_eprotoent)
 
 PP(pp_eservent)
 {
-    dSP;
-#ifdef HAS_SOCKET
-    endservent();
-    EXTEND(sp,1);
+    djSP;
+#ifdef HAS_ENDSERVENT
+    PerlSock_endservent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endservent");
@@ -3934,7 +4073,7 @@ PP(pp_gpwuid)
 
 PP(pp_gpwent)
 {
-    dSP;
+    djSP;
 #ifdef HAS_PASSWD
     I32 which = op->op_type;
     register SV *sv;
@@ -3962,38 +4101,55 @@ PP(pp_gpwent)
     if (pwent) {
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setpv(sv, pwent->pw_name);
+
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setpv(sv, pwent->pw_passwd);
+
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setiv(sv, (IV)pwent->pw_uid);
+
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setiv(sv, (IV)pwent->pw_gid);
+
+	/* pw_change, pw_quota, and pw_age are mutually exclusive. */
 	PUSHs(sv = sv_mortalcopy(&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
+
+	/* pw_class and pw_comment are mutually exclusive. */
 	PUSHs(sv = sv_mortalcopy(&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));
+#ifdef PWGECOS
 	sv_setpv(sv, pwent->pw_gecos);
+#endif
+#ifndef INCOMPLETE_TAINTS
+	/* pw_gecos is tainted. */
+	SvTAINTED_on(sv);
+#endif
+
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setpv(sv, pwent->pw_dir);
+
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setpv(sv, pwent->pw_shell);
+
 #ifdef PWEXPIRE
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setiv(sv, (IV)pwent->pw_expire);
@@ -4007,7 +4163,7 @@ PP(pp_gpwent)
 
 PP(pp_spwent)
 {
-    dSP;
+    djSP;
 #if defined(HAS_PASSWD) && !defined(CYGWIN32)
     setpwent();
     RETPUSHYES;
@@ -4018,7 +4174,7 @@ PP(pp_spwent)
 
 PP(pp_epwent)
 {
-    dSP;
+    djSP;
 #ifdef HAS_PASSWD
     endpwent();
     RETPUSHYES;
@@ -4047,7 +4203,7 @@ PP(pp_ggrgid)
 
 PP(pp_ggrent)
 {
-    dSP;
+    djSP;
 #ifdef HAS_GROUP
     I32 which = op->op_type;
     register char **elem;
@@ -4081,7 +4237,7 @@ PP(pp_ggrent)
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setiv(sv, (IV)grent->gr_gid);
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	for (elem = grent->gr_mem; *elem; elem++) {
+	for (elem = grent->gr_mem; elem && *elem; elem++) {
 	    sv_catpv(sv, *elem);
 	    if (elem[1])
 		sv_catpvn(sv, " ", 1);
@@ -4096,7 +4252,7 @@ PP(pp_ggrent)
 
 PP(pp_sgrent)
 {
-    dSP;
+    djSP;
 #ifdef HAS_GROUP
     setgrent();
     RETPUSHYES;
@@ -4107,7 +4263,7 @@ PP(pp_sgrent)
 
 PP(pp_egrent)
 {
-    dSP;
+    djSP;
 #ifdef HAS_GROUP
     endgrent();
     RETPUSHYES;
@@ -4118,7 +4274,7 @@ PP(pp_egrent)
 
 PP(pp_getlogin)
 {
-    dSP; dTARGET;
+    djSP; dTARGET;
 #ifdef HAS_GETLOGIN
     char *tmps;
     EXTEND(SP, 1);
@@ -4135,8 +4291,8 @@ PP(pp_getlogin)
 
 PP(pp_syscall)
 {
-#ifdef HAS_SYSCALL
-    dSP; dMARK; dORIGMARK; dTARGET;
+#ifdef HAS_SYSCALL   
+    djSP; dMARK; dORIGMARK; dTARGET;
     register I32 items = SP - MARK;
     unsigned long a[20];
     register I32 i = 0;
@@ -4237,9 +4393,7 @@ PP(pp_syscall)
 */
 
 static int
-fcntl_emulate_flock(fd, operation)
-int fd;
-int operation;
+fcntl_emulate_flock(int fd, int operation)
 {
     struct flock flock;
  
@@ -4301,6 +4455,17 @@ int fd;
 int operation;
 {
     int i;
+    int save_errno;
+    Off_t pos;
+
+    /* flock locks entire file so for lockf we need to do the same	*/
+    save_errno = errno;
+    pos = PerlLIO_lseek(fd, (Off_t)0, SEEK_CUR);    /* get pos to restore later */
+    if (pos > 0)	/* is seekable and needs to be repositioned	*/
+	if (PerlLIO_lseek(fd, (Off_t)0, SEEK_SET) < 0)
+	    pos = -1;	/* seek failed, so don't seek back afterwards	*/
+    errno = save_errno;
+
     switch (operation) {
 
 	/* LOCK_SH - get a shared lock */
@@ -4332,7 +4497,12 @@ int operation;
 	    errno = EINVAL;
 	    break;
     }
+
+    if (pos > 0)      /* need to restore position of the handle	*/
+	PerlLIO_lseek(fd, pos, SEEK_SET);	/* ignore error here	*/
+
     return (i);
 }
 
 #endif /* LOCKF_EMULATE_FLOCK */
+