X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=712b003abb152a74b9612903dbc2f6aeaeedf333;hb=96e4d5b14cf2dfb0235faa8bc3f701c15b15bb05;hp=48182e1069316ec663f71991a942e4c9e06b6c48;hpb=748a93069b3d16374a9859d1456065dd3ae11394;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index 48182e1..712b003 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1,6 +1,6 @@
 /*    pp_sys.c
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, 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.
@@ -17,17 +17,17 @@
 #include "EXTERN.h"
 #include "perl.h"
 
-/* Omit this -- it causes too much grief on mixed systems.
+/* XXX If this causes problems, set i_unistd=undef in the hint file.  */
 #ifdef I_UNISTD
-#include <unistd.h>
+# include <unistd.h>
 #endif
-*/
 
-/* Put this after #includes because fork and vfork prototypes may
-   conflict.
-*/
-#ifndef HAS_VFORK
-#   define vfork fork
+#ifdef I_SYS_WAIT
+# include <sys/wait.h>
+#endif
+
+#ifdef I_SYS_RESOURCE
+# include <sys/resource.h>
 #endif
 
 #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
@@ -42,11 +42,9 @@
 
 #ifdef HAS_SELECT
 #ifdef I_SYS_SELECT
-#ifndef I_SYS_TIME
 #include <sys/select.h>
 #endif
 #endif
-#endif
 
 #ifdef HOST_NOT_FOUND
 extern int h_errno;
@@ -73,7 +71,11 @@ extern int h_errno;
 #endif
 
 #ifdef I_UTIME
-#include <utime.h>
+#  ifdef WIN32
+#    include <sys/utime.h>
+#  else
+#    include <utime.h>
+#  endif
 #endif
 #ifdef I_FCNTL
 #include <fcntl.h>
@@ -82,33 +84,101 @@ extern int h_errno;
 #include <sys/file.h>
 #endif
 
-#ifdef HAS_GETPGRP2
-#   define getpgrp getpgrp2
+/* Put this after #includes because fork and vfork prototypes may conflict. */
+#ifndef HAS_VFORK
+#   define vfork fork
 #endif
 
-#ifdef HAS_SETPGRP2
-#   define setpgrp setpgrp2
+/* Put this after #includes because <unistd.h> defines _XOPEN_*. */
+#ifndef Sock_size_t
+#  if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__)
+#    define Sock_size_t Size_t
+#  else
+#    define Sock_size_t int
+#  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
+# endif
+# define my_chsize chsize
+#endif
+
+#ifdef HAS_FLOCK
+#  define FLOCK flock
+#else /* no flock() */
+
+   /* fcntl.h might not have been included, even if it exists, because
+      the current Configure only sets I_FCNTL if it's needed to pick up
+      the *_OK constants.  Make sure it has been included before testing
+      the fcntl() locking constants. */
+#  if defined(HAS_FCNTL) && !defined(I_FCNTL)
+#    include <fcntl.h>
+#  endif
+
+#  if defined(HAS_FCNTL) && defined(F_SETLK) && defined (F_SETLKW)
+#    define FLOCK fcntl_emulate_flock
+#    define FCNTL_EMULATE_FLOCK
+#  else /* no flock() or fcntl(F_SETLK,...) */
+#    ifdef HAS_LOCKF
+#      define FLOCK lockf_emulate_flock
+#      define LOCKF_EMULATE_FLOCK
+#    endif /* lockf */
+#  endif /* no flock() or fcntl(F_SETLK,...) */
+
+#  ifdef FLOCK
+     static int FLOCK _((int, int));
+
+    /*
+     * These are the flock() constants.  Since this sytems doesn't have
+     * flock(), the values of the constants are probably not available.
+     */
+#    ifndef LOCK_SH
+#      define LOCK_SH 1
+#    endif
+#    ifndef LOCK_EX
+#      define LOCK_EX 2
+#    endif
+#    ifndef LOCK_NB
+#      define LOCK_NB 4
+#    endif
+#    ifndef LOCK_UN
+#      define LOCK_UN 8
+#    endif
+#  endif /* emulating flock() */
+
+#endif /* no flock() */
+
+
 /* Pushy I/O. */
 
 PP(pp_backtick)
 {
     dSP; dTARGET;
-    FILE *fp;
+    PerlIO *fp;
     char *tmps = POPp;
+    I32 gimme = GIMME_V;
+
     TAINT_PROPER("``");
     fp = my_popen(tmps, "r");
     if (fp) {
-	sv_setpv(TARG, "");	/* note that this preserves previous buffer */
-	if (GIMME == G_SCALAR) {
+	if (gimme == G_VOID) {
+	    while (PerlIO_read(fp, buf, sizeof buf) > 0)
+		/*SUPPRESS 530*/
+		;
+	}
+	else if (gimme == G_SCALAR) {
+	    sv_setpv(TARG, "");	/* note that this preserves previous buffer */
 	    while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
 		/*SUPPRESS 530*/
 		;
 	    XPUSHs(TARG);
+	    SvTAINTED_on(TARG);
 	}
 	else {
 	    SV *sv;
@@ -124,13 +194,15 @@ PP(pp_backtick)
 		    SvLEN_set(sv, SvCUR(sv)+1);
 		    Renew(SvPVX(sv), SvLEN(sv), char);
 		}
+		SvTAINTED_on(sv);
 	    }
 	}
-	statusvalue = my_pclose(fp);
+	STATUS_NATIVE_SET(my_pclose(fp));
+	TAINT;		/* "I believe that this is not gratuitous!" */
     }
     else {
-	statusvalue = -1;
-	if (GIMME == G_SCALAR)
+	STATUS_NATIVE_SET(-1);
+	if (gimme == G_SCALAR)
 	    RETPUSHUNDEF;
     }
 
@@ -141,22 +213,18 @@ PP(pp_glob)
 {
     OP *result;
     ENTER;
-    SAVEINT(rschar);
-    SAVEINT(rslen);
 
     SAVESPTR(last_in_gv);	/* We don't want this to be permanent. */
     last_in_gv = (GV*)*stack_sp--;
 
-    rslen = 1;
-#ifdef DOSISH
-    rschar = 0;
-#else
-#ifdef CSH
-    rschar = 0;
-#else
-    rschar = '\n';
+    SAVESPTR(rs);		/* This is not permanent, either. */
+    rs = sv_2mortal(newSVpv("", 1));
+#ifndef DOSISH
+#ifndef CSH
+    *SvPVX(rs) = '\n';
 #endif	/* !CSH */
-#endif	/* !MSDOS */
+#endif	/* !DOSISH */
+
     result = do_readline();
     LEAVE;
     return result;
@@ -188,7 +256,7 @@ PP(pp_warn)
 	tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-	SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
+	SV *error = GvSV(errgv);
 	(void)SvUPGRADE(error, SVt_PV);
 	if (SvPOK(error) && SvCUR(error))
 	    sv_catpv(error, "\t...caught");
@@ -214,7 +282,7 @@ PP(pp_die)
 	tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-	SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
+	SV *error = GvSV(errgv);
 	(void)SvUPGRADE(error, SVt_PV);
 	if (SvPOK(error) && SvCUR(error))
 	    sv_catpv(error, "\t...propagated");
@@ -237,14 +305,18 @@ PP(pp_open)
 
     if (MAXARG > 1)
 	sv = POPs;
-    else
+    if (!isGV(TOPs))
+	DIE(no_usym, "filehandle");
+    if (MAXARG <= 1)
 	sv = GvSV(TOPs);
     gv = (GV*)POPs;
+    if (!isGV(gv))
+	DIE(no_usym, "filehandle");
+    if (GvIOp(gv))
+	IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
     tmps = SvPV(sv, len);
-    if (do_open(gv, tmps, len,Nullfp)) {
-	IoLINES(GvIOp(gv)) = 0;
+    if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp))
 	PUSHi( (I32)forkprocess );
-    }
     else if (forkprocess == 0)		/* we are a new child */
 	PUSHi(0);
     else
@@ -262,7 +334,7 @@ PP(pp_close)
     else
 	gv = (GV*)POPs;
     EXTEND(SP, 1);
-    PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no );
+    PUSHs(boolSV(do_close(gv, TRUE)));
     RETURN;
 }
 
@@ -282,6 +354,8 @@ PP(pp_pipe_op)
     if (!rgv || !wgv)
 	goto badexit;
 
+    if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
+	DIE(no_usym, "filehandle");
     rstio = GvIOn(rgv);
     wstio = GvIOn(wgv);
 
@@ -293,16 +367,16 @@ PP(pp_pipe_op)
     if (pipe(fd) < 0)
 	goto badexit;
 
-    IoIFP(rstio) = fdopen(fd[0], "r");
-    IoOFP(wstio) = fdopen(fd[1], "w");
+    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
+    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
     IoIFP(wstio) = IoOFP(wstio);
     IoTYPE(rstio) = '<';
     IoTYPE(wstio) = '>';
 
     if (!IoIFP(rstio) || !IoOFP(wstio)) {
-	if (IoIFP(rstio)) fclose(IoIFP(rstio));
+	if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
 	else close(fd[0]);
-	if (IoOFP(wstio)) fclose(IoOFP(wstio));
+	if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
 	else close(fd[1]);
 	goto badexit;
     }
@@ -321,13 +395,13 @@ PP(pp_fileno)
     dSP; dTARGET;
     GV *gv;
     IO *io;
-    FILE *fp;
+    PerlIO *fp;
     if (MAXARG < 1)
 	RETPUSHUNDEF;
     gv = (GV*)POPs;
     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
 	RETPUSHUNDEF;
-    PUSHi(fileno(fp));
+    PUSHi(PerlIO_fileno(fp));
     RETURN;
 }
 
@@ -356,7 +430,7 @@ PP(pp_binmode)
     dSP;
     GV *gv;
     IO *io;
-    FILE *fp;
+    PerlIO *fp;
 
     if (MAXARG < 1)
 	RETPUSHUNDEF;
@@ -365,23 +439,31 @@ PP(pp_binmode)
 
     EXTEND(SP, 1);
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
-	RETSETUNDEF;
+	RETPUSHUNDEF;
 
 #ifdef DOSISH
 #ifdef atarist
-    if (!fflush(fp) && (fp->_flag |= _IOBIN))
+    if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
 	RETPUSHYES;
     else
 	RETPUSHUNDEF;
 #else
-    if (setmode(fileno(fp), OP_BINARY) != -1)
+    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)
@@ -395,6 +477,7 @@ PP(pp_tie)
     SV **mark = stack_base + ++*markstack_ptr;	/* reuse in entersub */
     I32 markoff = mark - stack_base - 1;
     char *methname;
+    bool oldcatch = CATCH_GET;
 
     varsv = mark[0];
     if (SvTYPE(varsv) == SVt_PVHV)
@@ -407,26 +490,30 @@ PP(pp_tie)
 	methname = "TIESCALAR";
 
     stash = gv_stashsv(mark[1], FALSE);
-    if (!stash || !(gv = gv_fetchmethod(stash, methname)) || !GvCV(gv))
+    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_KNOW|OPf_STACKED;
+    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(gv);
+    XPUSHs((SV*)GvCV(gv));
     PUTBACK;
 
     if (op = pp_entersub())
-        run();
+        runops();
     SPAGAIN;
 
+    CATCH_SET(oldcatch);
     sv = TOPs;
     if (sv_isobject(sv)) {
 	if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
@@ -447,11 +534,51 @@ PP(pp_tie)
 PP(pp_untie)
 {
     dSP;
-    if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV)
-	sv_unmagic(TOPs, 'P');
+    SV * sv ;
+
+    sv = POPs;
+
+    if (dowarn) {
+        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 && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
+		warn("untie attempted while %lu inner references still exist",
+			(unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
+        }
+    }
+ 
+    if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
+	sv_unmagic(sv, 'P');
     else
-	sv_unmagic(TOPs, 'q');
-    RETSETYES;
+	sv_unmagic(sv, 'q');
+    RETPUSHYES;
+}
+
+PP(pp_tied)
+{
+    dSP;
+    SV * sv ;
+    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 ;
+	}
+    }
+
+    RETPUSHUNDEF;
 }
 
 PP(pp_dbmopen)
@@ -463,28 +590,32 @@ PP(pp_dbmopen)
     GV *gv;
     BINOP myop;
     SV *sv;
+    bool oldcatch = CATCH_GET;
 
     hv = (HV*)POPs;
 
     sv = sv_mortalcopy(&sv_no);
     sv_setpv(sv, "AnyDBM_File");
     stash = gv_stashsv(sv, FALSE);
-    if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
+    if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
 	PUTBACK;
-	perl_requirepv("AnyDBM_File.pm");
+	perl_require_pv("AnyDBM_File.pm");
 	SPAGAIN;
-	if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
+	if (!(gv = gv_fetchmethod(stash, "TIEHASH")))
 	    DIE("No dbm on this machine");
     }
 
     Zero(&myop, 1, BINOP);
     myop.op_last = (OP *) &myop;
     myop.op_next = Nullop;
-    myop.op_flags = OPf_KNOW|OPf_STACKED;
+    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();
 
@@ -496,11 +627,11 @@ PP(pp_dbmopen)
     else
 	PUSHs(sv_2mortal(newSViv(O_RDWR)));
     PUSHs(right);
-    PUSHs(gv);
+    PUSHs((SV*)GvCV(gv));
     PUTBACK;
 
     if (op = pp_entersub())
-        run();
+        runops();
     SPAGAIN;
 
     if (!sv_isobject(TOPs)) {
@@ -513,14 +644,15 @@ PP(pp_dbmopen)
 	PUSHs(left);
 	PUSHs(sv_2mortal(newSViv(O_RDONLY)));
 	PUSHs(right);
-	PUSHs(gv);
+	PUSHs((SV*)GvCV(gv));
 	PUTBACK;
 
 	if (op = pp_entersub())
-	    run();
+	    runops();
 	SPAGAIN;
     }
 
+    CATCH_SET(oldcatch);
     if (sv_isobject(TOPs))
 	sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
     LEAVE;
@@ -570,7 +702,11 @@ PP(pp_sselect)
     }
 
 #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+#if defined(__linux__) || defined(OS2)
+    growsize = sizeof(fd_set);
+#else
     growsize = maxlen;		/* little endians can use vecs directly */
+#endif
 #else
 #ifdef NFDBITS
 
@@ -609,11 +745,13 @@ PP(pp_sselect)
 	j = SvLEN(sv);
 	if (j < growsize) {
 	    Sv_Grow(sv, growsize);
-	    s = SvPVX(sv) + j;
-	    while (++j <= growsize) {
-		*s++ = '\0';
-	    }
 	}
+	j = SvCUR(sv);
+	s = SvPVX(sv) + j;
+	while (++j <= growsize) {
+	    *s++ = '\0';
+	}
+
 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
 	s = SvPVX(sv);
 	New(403, fd_sets[i], growsize, char);
@@ -660,17 +798,48 @@ PP(pp_sselect)
 #endif
 }
 
+void
+setdefout(gv)
+GV *gv;
+{
+    if (gv)
+	(void)SvREFCNT_inc(gv);
+    if (defoutgv)
+	SvREFCNT_dec(defoutgv);
+    defoutgv = gv;
+}
+
 PP(pp_select)
 {
     dSP; dTARGET;
-    GV *oldgv = defoutgv;
-    if (op->op_private > 0) {
-	defoutgv = (GV*)POPs;
-	if (!GvIO(defoutgv))
-	    gv_IOadd(defoutgv);
+    GV *newdefout, *egv;
+    HV *hv;
+
+    newdefout = (op->op_private > 0) ? ((GV *) POPs) : NULL;
+
+    egv = GvEGV(defoutgv);
+    if (!egv)
+	egv = defoutgv;
+    hv = GvSTASH(egv);
+    if (! hv)
+	XPUSHs(&sv_undef);
+    else {
+	GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
+	if (gvp && *gvp == egv) {
+	    gv_efullname3(TARG, defoutgv, Nullch);
+	    XPUSHTARG;
+	}
+	else {
+	    XPUSHs(sv_2mortal(newRV((SV*)egv)));
+	}
+    }
+
+    if (newdefout) {
+	if (!GvIO(newdefout))
+	    gv_IOadd(newdefout);
+	setdefout(newdefout);
     }
-    gv_efullname(TARG, oldgv);
-    XPUSHTARG;
+
     RETURN;
 }
 
@@ -678,6 +847,7 @@ PP(pp_getc)
 {
     dSP; dTARGET;
     GV *gv;
+    MAGIC *mg;
 
     if (MAXARG <= 0)
 	gv = stdingv;
@@ -685,11 +855,25 @@ PP(pp_getc)
 	gv = (GV*)POPs;
     if (!gv)
 	gv = argvgv;
+
+    if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+	I32 gimme = GIMME_V;
+	PUSHMARK(SP);
+	XPUSHs(mg->mg_obj);
+	PUTBACK;
+	ENTER;
+	perl_call_method("GETC", gimme);
+	LEAVE;
+	SPAGAIN;
+	if (gimme == G_SCALAR)
+	    SvSetMagicSV_nosteal(TARG, TOPs);
+	RETURN;
+    }
     if (!gv || do_eof(gv)) /* make sure we have fp with something */
 	RETPUSHUNDEF;
-    TAINT_IF(1);
+    TAINT;
     sv_setpv(TARG, " ");
-    *SvPVX(TARG) = getc(IoIFP(GvIOp(gv))); /* should never be EOF */
+    *SvPVX(TARG) = PerlIO_getc(IoIFP(GvIOp(gv))); /* should never be EOF */
     PUSHTARG;
     RETURN;
 }
@@ -706,7 +890,7 @@ GV *gv;
 OP *retop;
 {
     register CONTEXT *cx;
-    I32 gimme = GIMME;
+    I32 gimme = GIMME_V;
     AV* padlist = CvPADLIST(cv);
     SV** svp = AvARRAY(padlist);
 
@@ -719,7 +903,7 @@ OP *retop;
     SAVESPTR(curpad);
     curpad = AvARRAY((AV*)svp[1]);
 
-    defoutgv = gv;		/* locally select filehandle so $% et al work */
+    setdefout(gv);	    /* locally select filehandle so $% et al work */
     return CvSTART(cv);
 }
 
@@ -749,17 +933,18 @@ PP(pp_enterwrite)
 	fgv = gv;
 
     cv = GvFORM(fgv);
-
     if (!cv) {
 	if (fgv) {
 	    SV *tmpsv = sv_newmortal();
-	    gv_efullname(tmpsv, gv);
+	    gv_efullname3(tmpsv, fgv, Nullch);
 	    DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
 	}
 	DIE("Not a format reference");
     }
-    IoFLAGS(io) &= ~IOf_DIDTOP;
+    if (CvCLONE(cv))
+	cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
 
+    IoFLAGS(io) &= ~IOf_DIDTOP;
     return doform(cv,gv,op->op_next);
 }
 
@@ -768,17 +953,19 @@ PP(pp_leavewrite)
     dSP;
     GV *gv = cxstack[cxstack_ix].blk_sub.gv;
     register IO *io = GvIOp(gv);
-    FILE *ofp = IoOFP(io);
-    FILE *fp;
+    PerlIO *ofp = IoOFP(io);
+    PerlIO *fp;
     SV **newsp;
     I32 gimme;
     register CONTEXT *cx;
 
-    DEBUG_f(fprintf(stderr,"left=%ld, todo=%ld\n",
+    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)
     {
+	GV *fgv;
+	CV *cv;
 	if (!IoTOP_GV(io)) {
 	    GV *topgv;
 	    char tmpbuf[256];
@@ -804,6 +991,8 @@ PP(pp_leavewrite)
 	if (IoFLAGS(io) & IOf_DIDTOP) {	/* Oh dear.  It still doesn't fit. */
 	    I32 lines = IoLINES_LEFT(io);
 	    char *s = SvPVX(formtarget);
+	    if (lines <= 0)		/* Yow, header didn't even fit!!! */
+		goto forget_top;
 	    while (lines-- > 0) {
 		s = strchr(s, '\n');
 		if (!s)
@@ -811,18 +1000,29 @@ PP(pp_leavewrite)
 		s++;
 	    }
 	    if (s) {
-		fwrite1(SvPVX(formtarget), s - SvPVX(formtarget), 1, ofp);
+		PerlIO_write(ofp, SvPVX(formtarget), s - SvPVX(formtarget));
 		sv_chop(formtarget, s);
 		FmLINES(formtarget) -= IoLINES_LEFT(io);
 	    }
 	}
 	if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
-	    fwrite1(SvPVX(formfeed), SvCUR(formfeed), 1, ofp);
+	    PerlIO_write(ofp, SvPVX(formfeed), SvCUR(formfeed));
 	IoLINES_LEFT(io) = IoPAGE_LEN(io);
 	IoPAGE(io)++;
 	formtarget = toptarget;
 	IoFLAGS(io) |= IOf_DIDTOP;
-	return doform(GvFORM(IoTOP_GV(io)),gv,op);
+	fgv = IoTOP_GV(io);
+	if (!fgv)
+	    DIE("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));
+	}
+	if (CvCLONE(cv))
+	    cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+	return doform(cv,gv,op);
     }
 
   forget_top:
@@ -845,15 +1045,15 @@ PP(pp_leavewrite)
 	    if (dowarn)
 		warn("page overflow");
 	}
-	if (!fwrite1(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) ||
-		ferror(fp))
+	if (!PerlIO_write(ofp, SvPVX(formtarget), SvCUR(formtarget)) ||
+		PerlIO_error(fp))
 	    PUSHs(&sv_no);
 	else {
 	    FmLINES(formtarget) = 0;
 	    SvCUR_set(formtarget, 0);
 	    *SvEND(formtarget) = '\0';
 	    if (IoFLAGS(io) & IOf_FLUSH)
-		(void)fflush(fp);
+		(void)PerlIO_flush(fp);
 	    PUSHs(&sv_yes);
 	}
     }
@@ -867,7 +1067,7 @@ PP(pp_prtf)
     dSP; dMARK; dORIGMARK;
     GV *gv;
     IO *io;
-    FILE *fp;
+    PerlIO *fp;
     SV *sv = NEWSV(0,0);
 
     if (op->op_flags & OPf_STACKED)
@@ -876,7 +1076,7 @@ PP(pp_prtf)
 	gv = defoutgv;
     if (!(io = GvIO(gv))) {
 	if (dowarn) {
-	    gv_fullname(sv,gv);
+	    gv_fullname3(sv, gv, Nullch);
 	    warn("Filehandle %s never opened", SvPV(sv,na));
 	}
 	SETERRNO(EBADF,RMS$_IFI);
@@ -884,7 +1084,7 @@ PP(pp_prtf)
     }
     else if (!(fp = IoOFP(io))) {
 	if (dowarn)  {
-	    gv_fullname(sv,gv);
+	    gv_fullname3(sv, gv, Nullch);
 	    if (IoIFP(io))
 		warn("Filehandle %s opened only for input", SvPV(sv,na));
 	    else
@@ -894,12 +1094,18 @@ PP(pp_prtf)
 	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;
 
 	if (IoFLAGS(io) & IOf_FLUSH)
-	    if (fflush(fp) == EOF)
+	    if (PerlIO_flush(fp) == EOF)
 		goto just_say_no;
     }
     SvREFCNT_dec(sv);
@@ -914,6 +1120,34 @@ PP(pp_prtf)
     RETURN;
 }
 
+PP(pp_sysopen)
+{
+    dSP;
+    GV *gv;
+    SV *sv;
+    char *tmps;
+    STRLEN len;
+    int mode, perm;
+
+    if (MAXARG > 3)
+	perm = POPi;
+    else
+	perm = 0666;
+    mode = POPi;
+    sv = POPs;
+    gv = (GV *)POPs;
+
+    tmps = SvPV(sv, len);
+    if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
+	IoLINES(GvIOp(gv)) = 0;
+	PUSHs(&sv_yes);
+    }
+    else {
+	PUSHs(&sv_undef);
+    }
+    RETURN;
+}
+
 PP(pp_sysread)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
@@ -921,15 +1155,35 @@ PP(pp_sysread)
     GV *gv;
     IO *io;
     char *buffer;
-    int length;
-    int bufsize;
+    SSize_t length;
+    Sock_size_t bufsize;
     SV *bufsv;
     STRLEN blen;
+    MAGIC *mg;
 
     gv = (GV*)*++MARK;
+    if (op->op_type == OP_READ &&
+	SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
+    {
+	SV *sv;
+	
+	PUSHMARK(MARK-1);
+	*MARK = mg->mg_obj;
+	ENTER;
+	perl_call_method("READ", G_SCALAR);
+	LEAVE;
+	SPAGAIN;
+	sv = POPs;
+	SP = ORIGMARK;
+	PUSHs(sv);
+	RETURN;
+    }
+
     if (!gv)
 	goto say_undef;
     bufsv = *++MARK;
+    if (! SvOK(bufsv))
+	sv_setpvn(bufsv, "", 0);
     buffer = SvPV_force(bufsv, blen);
     length = SvIVx(*++MARK);
     if (length < 0)
@@ -946,7 +1200,8 @@ PP(pp_sysread)
     if (op->op_type == OP_RECV) {
 	bufsize = sizeof buf;
 	buffer = SvGROW(bufsv, length+1);
-	length = recvfrom(fileno(IoIFP(io)), buffer, length, offset,
+	/* 'offset' means 'flags' here */
+	length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
 	    (struct sockaddr *)buf, &bufsize);
 	if (length < 0)
 	    RETPUSHUNDEF;
@@ -954,8 +1209,9 @@ PP(pp_sysread)
 	*SvEND(bufsv) = '\0';
 	(void)SvPOK_only(bufsv);
 	SvSETMAGIC(bufsv);
-	if (tainting)
-	    sv_magic(bufsv, Nullsv, 't', Nullch, 0);
+	/* This should not be marked tainted if the fp is marked clean */
+	if (!(IoFLAGS(io) & IOf_UNTAINT))
+	    SvTAINTED_on(bufsv);
 	SP = ORIGMARK;
 	sv_setpvn(TARG, buf, bufsize);
 	PUSHs(TARG);
@@ -965,28 +1221,38 @@ PP(pp_sysread)
     if (op->op_type == OP_RECV)
 	DIE(no_sock_func, "recv");
 #endif
+    if (offset < 0) {
+	if (-offset > blen)
+	    DIE("Offset outside string");
+	offset += blen;
+    }
+    bufsize = SvCUR(bufsv);
     buffer = SvGROW(bufsv, length+offset+1);
+    if (offset > bufsize) { /* Zero any newly allocated space */
+    	Zero(buffer+bufsize, offset-bufsize, char);
+    }
     if (op->op_type == OP_SYSREAD) {
-	length = read(fileno(IoIFP(io)), buffer+offset, length);
+	length = read(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
     }
     else
 #ifdef HAS_SOCKET__bad_code_maybe
     if (IoTYPE(io) == 's') {
 	bufsize = sizeof buf;
-	length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0,
+	length = recvfrom(PerlIO_fileno(IoIFP(io)), buffer+offset, length, 0,
 	    (struct sockaddr *)buf, &bufsize);
     }
     else
 #endif
-	length = fread(buffer+offset, 1, length, IoIFP(io));
+	length = PerlIO_read(IoIFP(io), buffer+offset, length);
     if (length < 0)
 	goto say_undef;
     SvCUR_set(bufsv, length+offset);
     *SvEND(bufsv) = '\0';
     (void)SvPOK_only(bufsv);
     SvSETMAGIC(bufsv);
-    if (tainting)
-	sv_magic(bufsv, Nullsv, 't', Nullch, 0);
+    /* This should not be marked tainted if the fp is marked clean */
+    if (!(IoFLAGS(io) & IOf_UNTAINT))
+	SvTAINTED_on(bufsv);
     SP = ORIGMARK;
     PUSHi(length);
     RETURN;
@@ -1032,24 +1298,30 @@ PP(pp_send)
 	}
     }
     else if (op->op_type == OP_SYSWRITE) {
-	if (MARK < SP)
+	if (MARK < SP) {
 	    offset = SvIVx(*++MARK);
-	else
+	    if (offset < 0) {
+		if (-offset > blen)
+		    DIE("Offset outside string");
+		offset += blen;
+	    } else if (offset >= blen)
+		DIE("Offset outside string");
+	} else
 	    offset = 0;
 	if (length > blen - offset)
 	    length = blen - offset;
-	length = write(fileno(IoIFP(io)), buffer+offset, length);
+	length = 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(fileno(IoIFP(io)), buffer, blen, length,
+	length = sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, length,
 				(struct sockaddr *)sockbuf, mlen);
     }
     else
-	length = send(fileno(IoIFP(io)), buffer, blen, length);
+	length = send(PerlIO_fileno(IoIFP(io)), buffer, blen, length);
 #else
     else
 	DIE(no_sock_func, "send");
@@ -1079,12 +1351,17 @@ PP(pp_eof)
 	gv = last_in_gv;
     else
 	gv = last_in_gv = (GV*)POPs;
-    PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no);
+    PUSHs(boolSV(!gv || do_eof(gv)));
     RETURN;
 }
 
 PP(pp_tell)
 {
+    return pp_systell(ARGS);
+}
+
+PP(pp_systell)
+{
     dSP; dTARGET;
     GV *gv;
 
@@ -1098,13 +1375,18 @@ PP(pp_tell)
 
 PP(pp_seek)
 {
+    return pp_sysseek(ARGS);
+}
+
+PP(pp_sysseek)
+{
     dSP;
     GV *gv;
     int whence = POPi;
     long offset = POPl;
 
     gv = last_in_gv = (GV*)POPs;
-    PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no );
+    PUSHs(boolSV(do_seek(gv, offset, whence)));
     RETURN;
 }
 
@@ -1116,35 +1398,50 @@ PP(pp_truncate)
     GV *tmpgv;
 
     SETERRNO(0,0);
-#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE)
-#ifdef HAS_TRUNCATE
+#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
     if (op->op_flags & OPf_SPECIAL) {
-	tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
+	tmpgv = gv_fetchpv(POPp, FALSE, SVt_PVIO);
+    do_ftruncate:
+	TAINT_PROPER("truncate");
 	if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
-	  ftruncate(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
-	    result = 0;
-    }
-    else if (truncate(POPp, len) < 0)
-	result = 0;
-#else
-    if (op->op_flags & OPf_SPECIAL) {
-	tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
-	if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
-	  chsize(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+#ifdef HAS_TRUNCATE
+	  ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+#else 
+	  my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+#endif
 	    result = 0;
     }
     else {
-	int tmpfd;
+	SV *sv = POPs;
+	char *name;
+
+	if (SvTYPE(sv) == SVt_PVGV) {
+	    tmpgv = (GV*)sv;		/* *main::FRED for example */
+	    goto do_ftruncate;
+	}
+	else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+	    tmpgv = (GV*) SvRV(sv);	/* \*main::FRED for example */
+	    goto do_ftruncate;
+	}
 
-	if ((tmpfd = open(POPp, 0)) < 0)
+	name = SvPV(sv, na);
+	TAINT_PROPER("truncate");
+#ifdef HAS_TRUNCATE
+	if (truncate(name, len) < 0)
 	    result = 0;
-	else {
-	    if (chsize(tmpfd, len) < 0)
+#else
+	{
+	    int tmpfd;
+	    if ((tmpfd = open(name, O_RDWR)) < 0)
 		result = 0;
-	    close(tmpfd);
+	    else {
+		if (my_chsize(tmpfd, len) < 0)
+		    result = 0;
+		close(tmpfd);
+	    }
 	}
-    }
 #endif
+    }
 
     if (result)
 	RETPUSHYES;
@@ -1201,19 +1498,19 @@ PP(pp_ioctl)
 
     if (optype == OP_IOCTL)
 #ifdef HAS_IOCTL
-	retval = ioctl(fileno(IoIFP(io)), func, s);
+	retval = ioctl(PerlIO_fileno(IoIFP(io)), func, s);
 #else
 	DIE("ioctl is not implemented");
 #endif
     else
-#ifdef DOSISH
-	DIE("fcntl is not implemented");
+#ifdef HAS_FCNTL
+#if defined(OS2) && defined(__EMX__)
+	retval = fcntl(PerlIO_fileno(IoIFP(io)), func, (int)s);
+#else
+	retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
+#endif 
 #else
-#   ifdef HAS_FCNTL
-	retval = fcntl(fileno(IoIFP(io)), func, s);
-#   else
 	DIE("fcntl is not implemented");
-#   endif
 #endif
 
     if (SvPOK(argsv)) {
@@ -1241,8 +1538,9 @@ PP(pp_flock)
     I32 value;
     int argtype;
     GV *gv;
-    FILE *fp;
-#ifdef HAS_FLOCK
+    PerlIO *fp;
+
+#ifdef FLOCK
     argtype = POPi;
     if (MAXARG <= 0)
 	gv = last_in_gv;
@@ -1253,18 +1551,15 @@ PP(pp_flock)
     else
 	fp = Nullfp;
     if (fp) {
-	value = (I32)(flock(fileno(fp), argtype) >= 0);
+	(void)PerlIO_flush(fp);
+	value = (I32)(FLOCK(PerlIO_fileno(fp), argtype) >= 0);
     }
     else
 	value = 0;
     PUSHi(value);
     RETURN;
 #else
-# ifdef HAS_LOCKF
-    DIE(no_func, "flock()"); /* XXX emulate flock() with lockf()? */
-# else
     DIE(no_func, "flock()");
-# endif
 #endif
 }
 
@@ -1296,12 +1591,12 @@ PP(pp_socket)
     fd = socket(domain, type, protocol);
     if (fd < 0)
 	RETPUSHUNDEF;
-    IoIFP(io) = fdopen(fd, "r");	/* stdio gets confused about sockets */
-    IoOFP(io) = fdopen(fd, "w");
+    IoIFP(io) = PerlIO_fdopen(fd, "r");	/* stdio gets confused about sockets */
+    IoOFP(io) = PerlIO_fdopen(fd, "w");
     IoTYPE(io) = 's';
     if (!IoIFP(io) || !IoOFP(io)) {
-	if (IoIFP(io)) fclose(IoIFP(io));
-	if (IoOFP(io)) fclose(IoOFP(io));
+	if (IoIFP(io)) PerlIO_close(IoIFP(io));
+	if (IoOFP(io)) PerlIO_close(IoOFP(io));
 	if (!IoIFP(io) && !IoOFP(io)) close(fd);
 	RETPUSHUNDEF;
     }
@@ -1340,18 +1635,18 @@ PP(pp_sockpair)
     TAINT_PROPER("socketpair");
     if (socketpair(domain, type, protocol, fd) < 0)
 	RETPUSHUNDEF;
-    IoIFP(io1) = fdopen(fd[0], "r");
-    IoOFP(io1) = fdopen(fd[0], "w");
+    IoIFP(io1) = PerlIO_fdopen(fd[0], "r");
+    IoOFP(io1) = PerlIO_fdopen(fd[0], "w");
     IoTYPE(io1) = 's';
-    IoIFP(io2) = fdopen(fd[1], "r");
-    IoOFP(io2) = fdopen(fd[1], "w");
+    IoIFP(io2) = PerlIO_fdopen(fd[1], "r");
+    IoOFP(io2) = PerlIO_fdopen(fd[1], "w");
     IoTYPE(io2) = 's';
     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
-	if (IoIFP(io1)) fclose(IoIFP(io1));
-	if (IoOFP(io1)) fclose(IoOFP(io1));
+	if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
+	if (IoOFP(io1)) PerlIO_close(IoOFP(io1));
 	if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
-	if (IoIFP(io2)) fclose(IoIFP(io2));
-	if (IoOFP(io2)) fclose(IoOFP(io2));
+	if (IoIFP(io2)) PerlIO_close(IoIFP(io2));
+	if (IoOFP(io2)) PerlIO_close(IoOFP(io2));
 	if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
 	RETPUSHUNDEF;
     }
@@ -1377,7 +1672,7 @@ PP(pp_bind)
 
     addr = SvPV(addrsv, len);
     TAINT_PROPER("bind");
-    if (bind(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+    if (bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
 	RETPUSHYES;
     else
 	RETPUSHUNDEF;
@@ -1407,7 +1702,7 @@ PP(pp_connect)
 
     addr = SvPV(addrsv, len);
     TAINT_PROPER("connect");
-    if (connect(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+    if (connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
 	RETPUSHYES;
     else
 	RETPUSHUNDEF;
@@ -1433,7 +1728,7 @@ PP(pp_listen)
     if (!io || !IoIFP(io))
 	goto nuts;
 
-    if (listen(fileno(IoIFP(io)), backlog) >= 0)
+    if (listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
 	RETPUSHYES;
     else
 	RETPUSHUNDEF;
@@ -1450,14 +1745,14 @@ nuts:
 
 PP(pp_accept)
 {
-    struct sockaddr_in saddr;	/* use a struct to avoid alignment problems */
     dSP; dTARGET;
 #ifdef HAS_SOCKET
     GV *ngv;
     GV *ggv;
     register IO *nstio;
     register IO *gstio;
-    int len = sizeof saddr;
+    struct sockaddr saddr;	/* use a struct to avoid alignment problems */
+    Sock_size_t len = sizeof saddr;
     int fd;
 
     ggv = (GV*)POPs;
@@ -1476,15 +1771,15 @@ PP(pp_accept)
     if (IoIFP(nstio))
 	do_close(ngv, FALSE);
 
-    fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
+    fd = accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
     if (fd < 0)
 	goto badexit;
-    IoIFP(nstio) = fdopen(fd, "r");
-    IoOFP(nstio) = fdopen(fd, "w");
+    IoIFP(nstio) = PerlIO_fdopen(fd, "r");
+    IoOFP(nstio) = PerlIO_fdopen(fd, "w");
     IoTYPE(nstio) = 's';
     if (!IoIFP(nstio) || !IoOFP(nstio)) {
-	if (IoIFP(nstio)) fclose(IoIFP(nstio));
-	if (IoOFP(nstio)) fclose(IoOFP(nstio));
+	if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
+	if (IoOFP(nstio)) PerlIO_close(IoOFP(nstio));
 	if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
 	goto badexit;
     }
@@ -1516,7 +1811,7 @@ PP(pp_shutdown)
     if (!io || !IoIFP(io))
 	goto nuts;
 
-    PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 );
+    PUSHi( shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
     RETURN;
 
 nuts:
@@ -1549,7 +1844,7 @@ PP(pp_ssockopt)
     unsigned int lvl;
     GV *gv;
     register IO *io;
-    int aint;
+    Sock_size_t len;
 
     if (optype == OP_GSOCKOPT)
 	sv = sv_2mortal(NEWSV(22, 257));
@@ -1563,31 +1858,33 @@ PP(pp_ssockopt)
     if (!io || !IoIFP(io))
 	goto nuts;
 
-    fd = fileno(IoIFP(io));
+    fd = PerlIO_fileno(IoIFP(io));
     switch (optype) {
     case OP_GSOCKOPT:
 	SvGROW(sv, 257);
 	(void)SvPOK_only(sv);
 	SvCUR_set(sv,256);
 	*SvEND(sv) ='\0';
-	aint = SvCUR(sv);
-	if (getsockopt(fd, lvl, optname, SvPVX(sv), &aint) < 0)
+	len = SvCUR(sv);
+	if (getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
 	    goto nuts2;
-	SvCUR_set(sv,aint);
+	SvCUR_set(sv, len);
 	*SvEND(sv) ='\0';
 	PUSHs(sv);
 	break;
     case OP_SSOCKOPT: {
-	    STRLEN len = 0;
-	    char *buf = 0;
-	    if (SvPOKp(sv))
-		buf = SvPV(sv, len);
+	    char *buf;
+	    int aint;
+	    if (SvPOKp(sv)) {
+		buf = SvPV(sv, na);
+		len = na;
+	    }
 	    else if (SvOK(sv)) {
 		aint = (int)SvIV(sv);
 		buf = (char*)&aint;
 		len = sizeof(int);
 	    }
-	    if (setsockopt(fd, lvl, optname, buf, (int)len) < 0)
+	    if (setsockopt(fd, lvl, optname, buf, len) < 0)
 		goto nuts2;
 	    PUSHs(&sv_yes);
 	}
@@ -1625,28 +1922,34 @@ PP(pp_getpeername)
     int fd;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
-    int aint;
+    Sock_size_t len;
 
     if (!io || !IoIFP(io))
 	goto nuts;
 
     sv = sv_2mortal(NEWSV(22, 257));
     (void)SvPOK_only(sv);
-    SvCUR_set(sv,256);
+    len = 256;
+    SvCUR_set(sv, len);
     *SvEND(sv) ='\0';
-    aint = SvCUR(sv);
-    fd = fileno(IoIFP(io));
+    fd = PerlIO_fileno(IoIFP(io));
     switch (optype) {
     case OP_GETSOCKNAME:
-	if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
+	if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
 	    goto nuts2;
 	break;
     case OP_GETPEERNAME:
-	if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
+	if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
 	    goto nuts2;
 	break;
     }
-    SvCUR_set(sv,aint);
+#ifdef BOGUS_GETNAME_RETURN
+    /* Interactive Unix, getpeername() and getsockname()
+      does not return valid namelen */
+    if (len == BOGUS_GETNAME_RETURN)
+	len = sizeof(struct sockaddr);
+#endif
+    SvCUR_set(sv, len);
     *SvEND(sv) ='\0';
     PUSHs(sv);
     RETURN;
@@ -1674,6 +1977,7 @@ PP(pp_stat)
 {
     dSP;
     GV *tmpgv;
+    I32 gimme;
     I32 max = 13;
 
     if (op->op_flags & OPf_REF) {
@@ -1683,13 +1987,10 @@ PP(pp_stat)
 	    laststype = OP_STAT;
 	    statgv = tmpgv;
 	    sv_setpv(statname, "");
-	    if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
-	      Fstat(fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) {
-		max = 0;
-		laststatval = -1;
-	    }
+	    laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv))
+		? Fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) : -1);
 	}
-	else if (laststatval < 0)
+	if (laststatval < 0)
 	    max = 0;
     }
     else {
@@ -1718,25 +2019,36 @@ PP(pp_stat)
 	}
     }
 
-    EXTEND(SP, 13);
-    if (GIMME != G_ARRAY) {
-	if (max)
-	    RETPUSHYES;
-	else
-	    RETPUSHUNDEF;
+    gimme = GIMME_V;
+    if (gimme != G_ARRAY) {
+	if (gimme != G_VOID)
+	    XPUSHs(boolSV(max));
+	RETURN;
     }
     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)));
+#ifdef USE_STAT_RDEV
 	PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
+#else
+	PUSHs(sv_2mortal(newSVpv("", 0)));
+#endif
 	PUSHs(sv_2mortal(newSViv((I32)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)));
+#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)));
+#endif
 #ifdef USE_STAT_BLOCKS
 	PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
 	PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
@@ -1866,7 +2178,7 @@ PP(pp_ftmtime)
     dSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( (basetime - statcache.st_mtime) / 86400.0 );
+    PUSHn( ((I32)basetime - (I32)statcache.st_mtime) / 86400.0 );
     RETURN;
 }
 
@@ -1876,7 +2188,7 @@ PP(pp_ftatime)
     dSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( (basetime - statcache.st_atime) / 86400.0 );
+    PUSHn( ((I32)basetime - (I32)statcache.st_atime) / 86400.0 );
     RETURN;
 }
 
@@ -1886,7 +2198,7 @@ PP(pp_ftctime)
     dSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( (basetime - statcache.st_ctime) / 86400.0 );
+    PUSHn( ((I32)basetime - (I32)statcache.st_ctime) / 86400.0 );
     RETURN;
 }
 
@@ -2022,7 +2334,7 @@ PP(pp_fttty)
     else
 	gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
-	fd = fileno(IoIFP(GvIOp(gv)));
+	fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
     else if (isDIGIT(*tmps))
 	fd = atoi(tmps);
     else
@@ -2032,18 +2344,12 @@ PP(pp_fttty)
     RETPUSHNO;
 }
 
-#if defined(USE_STD_STDIO) || defined(atarist) /* this will work with atariST */
-# define FBASE(f) ((f)->_base)
-# define FSIZE(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
-# define FPTR(f) ((f)->_ptr)
-# define FCOUNT(f) ((f)->_cnt)
-#else 
-# if defined(USE_LINUX_STDIO)
-#   define FBASE(f) ((f)->_IO_read_base)
-#   define FSIZE(f) ((f)->_IO_read_end - FBASE(f))
-#   define FPTR(f) ((f)->_IO_read_ptr)
-#   define FCOUNT(f) ((f)->_IO_read_end - FPTR(f))
-# endif
+#if defined(atarist) /* this will work with atariST. Configure will
+			make guesses for other systems. */
+# define FILE_base(f) ((f)->_base)
+# define FILE_ptr(f) ((f)->_ptr)
+# define FILE_cnt(f) ((f)->_cnt)
+# define FILE_bufsiz(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
 #endif
 
 PP(pp_fttext)
@@ -2055,11 +2361,21 @@ PP(pp_fttext)
     STDCHAR tbuf[512];
     register STDCHAR *s;
     register IO *io;
-    SV *sv;
+    register SV *sv;
+    GV *gv;
 
-    if (op->op_flags & OPf_REF) {
+    if (op->op_flags & OPf_REF)
+	gv = cGVOP->op_gv;
+    else if (isGV(TOPs))
+	gv = (GV*)POPs;
+    else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
+	gv = (GV*)SvRV(POPs);
+    else
+	gv = Nullgv;
+
+    if (gv) {
 	EXTEND(SP, 1);
-	if (cGVOP->op_gv == defgv) {
+	if (gv == defgv) {
 	    if (statgv)
 		io = GvIO(statgv);
 	    else {
@@ -2068,30 +2384,34 @@ PP(pp_fttext)
 	    }
 	}
 	else {
-	    statgv = cGVOP->op_gv;
+	    statgv = gv;
+	    laststatval = -1;
 	    sv_setpv(statname, "");
 	    io = GvIO(statgv);
 	}
 	if (io && IoIFP(io)) {
-#ifdef FBASE
-	    Fstat(fileno(IoIFP(io)), &statcache);
+	    if (! PerlIO_has_base(IoIFP(io)))
+		DIE("-T and -B not implemented on filehandles");
+	    laststatval = Fstat(PerlIO_fileno(IoIFP(io)), &statcache);
+	    if (laststatval < 0)
+		RETPUSHUNDEF;
 	    if (S_ISDIR(statcache.st_mode))	/* handle NFS glitch */
 		if (op->op_type == OP_FTTEXT)
 		    RETPUSHNO;
 		else
 		    RETPUSHYES;
-	    if (FCOUNT(IoIFP(io)) <= 0) {
-		i = getc(IoIFP(io));
+	    if (PerlIO_get_cnt(IoIFP(io)) <= 0) {
+		i = PerlIO_getc(IoIFP(io));
 		if (i != EOF)
-		    (void)ungetc(i, IoIFP(io));
+		    (void)PerlIO_ungetc(IoIFP(io),i);
 	    }
-	    if (FCOUNT(IoIFP(io)) <= 0)	/* null file is anything */
+	    if (PerlIO_get_cnt(IoIFP(io)) <= 0)	/* null file is anything */
 		RETPUSHYES;
-	    len = FSIZE(IoIFP(io));
-	    s = FBASE(IoIFP(io));
-#else
-	    DIE("-T and -B not implemented on filehandles");
-#endif
+	    len = PerlIO_get_bufsiz(IoIFP(io));
+	    s = (STDCHAR *) PerlIO_get_base(IoIFP(io));
+	    /* sfio can have large buffers - limit to 512 */
+	    if (len > 512)
+		len = 512;
 	}
 	else {
 	    if (dowarn)
@@ -2103,9 +2423,10 @@ PP(pp_fttext)
     }
     else {
 	sv = POPs;
+      really_filename:
 	statgv = Nullgv;
+	laststatval = -1;
 	sv_setpv(statname, SvPV(sv, na));
-      really_filename:
 #ifdef HAS_OPEN3
 	i = open(SvPV(sv, na), O_RDONLY, 0);
 #else
@@ -2116,7 +2437,9 @@ PP(pp_fttext)
 		warn(warn_nl, "open");
 	    RETPUSHUNDEF;
 	}
-	Fstat(i, &statcache);
+	laststatval = Fstat(i, &statcache);
+	if (laststatval < 0)
+	    RETPUSHUNDEF;
 	len = read(i, tbuf, 512);
 	(void)close(i);
 	if (len <= 0) {
@@ -2128,6 +2451,7 @@ PP(pp_fttext)
     }
 
     /* now scan s to look for textiness */
+    /*   XXX ASCII dependent code */
 
     for (i = 0; i < len; i++, s++) {
 	if (!*s) {			/* null never allowed in text */
@@ -2142,7 +2466,7 @@ PP(pp_fttext)
 	    odd++;
     }
 
-    if ((odd * 30 > len) == (op->op_type == OP_FTTEXT)) /* allow 30% odd */
+    if ((odd * 3 > len) == (op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
 	RETPUSHNO;
     else
 	RETPUSHYES;
@@ -2180,7 +2504,7 @@ PP(pp_chdir)
 #ifdef VMS
     /* Clear the DEFAULT element of ENV so we'll get the new value
      * in the future. */
-    hv_delete(GvHVn(envgv),"DEFAULT",7);
+    hv_delete(GvHVn(envgv),"DEFAULT",7,G_DISCARD);
 #endif
     RETURN;
 }
@@ -2254,13 +2578,15 @@ PP(pp_rename)
 #ifdef HAS_RENAME
     anum = rename(tmps, tmps2);
 #else
-    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))
-	    (void)UNLINK(tmps2);
-	if (!(anum = link(tmps, tmps2)))
-	    anum = UNLINK(tmps);
+    if (!(anum = 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))
+		(void)UNLINK(tmps2);
+	    if (!(anum = link(tmps, tmps2)))
+		anum = UNLINK(tmps);
+	}
     }
 #endif
     SETi( anum >= 0 );
@@ -2320,60 +2646,75 @@ dooneliner(cmd, filename)
 char *cmd;
 char *filename;
 {
-    char mybuf[8192];
-    char *s, *tmps;
+    char *save_filename = filename;
+    char *cmdline;
+    char *s;
+    PerlIO *myfp;
     int anum = 1;
-    FILE *myfp;
 
-    strcpy(mybuf, cmd);
-    strcat(mybuf, " ");
-    for (s = mybuf+strlen(mybuf); *filename; ) {
+    New(666, cmdline, strlen(cmd) + (strlen(filename) * 2) + 10, char);
+    strcpy(cmdline, cmd);
+    strcat(cmdline, " ");
+    for (s = cmdline + strlen(cmdline); *filename; ) {
 	*s++ = '\\';
 	*s++ = *filename++;
     }
     strcpy(s, " 2>&1");
-    myfp = my_popen(mybuf, "r");
+    myfp = my_popen(cmdline, "r");
+    Safefree(cmdline);
+
     if (myfp) {
-	*mybuf = '\0';
-	s = fgets(mybuf, sizeof mybuf, myfp);
+	SV *tmpsv = sv_newmortal();
+	/* Need to save/restore 'rs' ?? */
+	s = sv_gets(tmpsv, myfp, 0);
 	(void)my_pclose(myfp);
 	if (s != Nullch) {
-	    for (errno = 1; errno < sys_nerr; errno++) {
+	    int e;
+	    for (e = 1;
 #ifdef HAS_SYS_ERRLIST
-		if (instr(mybuf, sys_errlist[errno]))	/* you don't see this */
-		    return 0;
+		 e <= sys_nerr
+#endif
+		 ; e++)
+	    {
+		/* you don't see this */
+		char *errmsg =
+#ifdef HAS_SYS_ERRLIST
+		    sys_errlist[e]
 #else
-		char *errmsg;				/* especially if it isn't there */
-
-		if (instr(mybuf,
-		          (errmsg = strerror(errno)) ? errmsg : "NoErRoR"))
-		    return 0;
+		    strerror(e)
 #endif
+		    ;
+		if (!errmsg)
+		    break;
+		if (instr(s, errmsg)) {
+		    SETERRNO(e,0);
+		    return 0;
+		}
 	    }
 	    SETERRNO(0,0);
 #ifndef EACCES
 #define EACCES EPERM
 #endif
-	    if (instr(mybuf, "cannot make"))
+	    if (instr(s, "cannot make"))
 		SETERRNO(EEXIST,RMS$_FEX);
-	    else if (instr(mybuf, "existing file"))
+	    else if (instr(s, "existing file"))
 		SETERRNO(EEXIST,RMS$_FEX);
-	    else if (instr(mybuf, "ile exists"))
+	    else if (instr(s, "ile exists"))
 		SETERRNO(EEXIST,RMS$_FEX);
-	    else if (instr(mybuf, "non-exist"))
+	    else if (instr(s, "non-exist"))
 		SETERRNO(ENOENT,RMS$_FNF);
-	    else if (instr(mybuf, "does not exist"))
+	    else if (instr(s, "does not exist"))
 		SETERRNO(ENOENT,RMS$_FNF);
-	    else if (instr(mybuf, "not empty"))
+	    else if (instr(s, "not empty"))
 		SETERRNO(EBUSY,SS$_DEVOFFLINE);
-	    else if (instr(mybuf, "cannot access"))
+	    else if (instr(s, "cannot access"))
 		SETERRNO(EACCES,RMS$_PRV);
 	    else
 		SETERRNO(EPERM,RMS$_PRV);
 	    return 0;
 	}
 	else {	/* some mkdirs return no failure indication */
-	    anum = (Stat(filename, &statbuf) >= 0);
+	    anum = (Stat(save_filename, &statbuf) >= 0);
 	    if (op->op_type == OP_RMDIR)
 		anum = !anum;
 	    if (anum)
@@ -2399,7 +2740,7 @@ PP(pp_mkdir)
 
     TAINT_PROPER("mkdir");
 #ifdef HAS_MKDIR
-    SETi( mkdir(tmps, mode) >= 0 );
+    SETi( Mkdir(tmps, mode) >= 0 );
 #else
     SETi( dooneliner("mkdir", tmps) );
     oldumask = umask(0);
@@ -2601,19 +2942,19 @@ nope:
 
 PP(pp_fork)
 {
+#ifdef HAS_FORK
     dSP; dTARGET;
     int childpid;
     GV *tmpgv;
 
     EXTEND(SP, 1);
-#ifdef HAS_FORK
     childpid = fork();
     if (childpid < 0)
 	RETSETUNDEF;
     if (!childpid) {
 	/*SUPPRESS 560*/
 	if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
-	    sv_setiv(GvSV(tmpgv), (I32)getpid());
+	    sv_setiv(GvSV(tmpgv), (IV)getpid());
 	hv_clear(pidstatus);	/* no kids, so don't wait for 'em */
     }
     PUSHi(childpid);
@@ -2625,19 +2966,14 @@ PP(pp_fork)
 
 PP(pp_wait)
 {
+#if !defined(DOSISH) || defined(OS2)
     dSP; dTARGET;
     int childpid;
     int argflags;
-    I32 value;
 
-    EXTEND(SP, 1);
-#ifdef HAS_WAIT
-    childpid = wait(&argflags);
-    if (childpid > 0)
-	pidgone(childpid, argflags);
-    value = (I32)childpid;
-    statusvalue = FIXSTATUS(argflags);
-    PUSHi(value);
+    childpid = wait4pid(-1, &argflags, 0);
+    STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+    XPUSHi(childpid);
     RETURN;
 #else
     DIE(no_func, "Unsupported function wait");
@@ -2646,19 +2982,17 @@ PP(pp_wait)
 
 PP(pp_waitpid)
 {
+#if !defined(DOSISH) || defined(OS2)
     dSP; dTARGET;
     int childpid;
     int optype;
     int argflags;
-    I32 value;
 
-#ifdef HAS_WAIT
     optype = POPi;
     childpid = TOPi;
     childpid = wait4pid(childpid, &argflags, optype);
-    value = (I32)childpid;
-    statusvalue = FIXSTATUS(argflags);
-    SETi(value);
+    STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+    SETi(childpid);
     RETURN;
 #else
     DIE(no_func, "Unsupported function wait");
@@ -2672,10 +3006,8 @@ PP(pp_system)
     int childpid;
     int result;
     int status;
-    Signal_t (*ihand)();     /* place to save signal during system() */
-    Signal_t (*qhand)();     /* place to save signal during system() */
+    Sigsave_t ihand,qhand;     /* place to save signals during system() */
 
-#if defined(HAS_FORK) && !defined(VMS)
     if (SP - MARK == 1) {
 	if (tainting) {
 	    char *junk = SvPV(TOPs, na);
@@ -2683,6 +3015,7 @@ PP(pp_system)
 	    TAINT_PROPER("system");
 	}
     }
+#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2)
     while ((childpid = vfork()) == -1) {
 	if (errno != EAGAIN) {
 	    value = -1;
@@ -2693,22 +3026,17 @@ PP(pp_system)
 	sleep(5);
     }
     if (childpid > 0) {
-	ihand = signal(SIGINT, SIG_IGN);
-	qhand = signal(SIGQUIT, SIG_IGN);
+	rsignal_save(SIGINT, SIG_IGN, &ihand);
+	rsignal_save(SIGQUIT, SIG_IGN, &qhand);
 	do {
 	    result = wait4pid(childpid, &status, 0);
 	} while (result == -1 && errno == EINTR);
-	(void)signal(SIGINT, ihand);
-	(void)signal(SIGQUIT, qhand);
-	statusvalue = FIXSTATUS(status);
-	if (result < 0)
-	    value = -1;
-	else {
-	    value = (I32)((unsigned int)status & 0xffff);
-	}
+	(void)rsignal_restore(SIGINT, &ihand);
+	(void)rsignal_restore(SIGQUIT, &qhand);
+	STATUS_NATIVE_SET(result == -1 ? -1 : status);
 	do_execfree();	/* free any memory child malloced on vfork */
 	SP = ORIGMARK;
-	PUSHi(value);
+	PUSHi(STATUS_CURRENT);
 	RETURN;
     }
     if (op->op_flags & OPf_STACKED) {
@@ -2721,7 +3049,7 @@ PP(pp_system)
 	value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
     }
     _exit(-1);
-#else /* ! FORK or VMS */
+#else /* ! FORK or VMS or OS/2 */
     if (op->op_flags & OPf_STACKED) {
 	SV *really = *++MARK;
 	value = (I32)do_aspawn(really, MARK, SP);
@@ -2731,9 +3059,10 @@ PP(pp_system)
     else {
 	value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
     }
+    STATUS_NATIVE_SET(value);
     do_execfree();
     SP = ORIGMARK;
-    PUSHi(value);
+    PUSHi(STATUS_CURRENT);
 #endif /* !FORK or VMS */
     RETURN;
 }
@@ -2806,10 +3135,10 @@ PP(pp_getpgrp)
 	pid = 0;
     else
 	pid = SvIVx(POPs);
-#ifdef USE_BSDPGRP
-    value = (I32)getpgrp(pid);
+#ifdef BSD_GETPGRP
+    value = (I32)BSD_GETPGRP(pid);
 #else
-    if (pid != 0)
+    if (pid != 0 && pid != getpid())
 	DIE("POSIX getpgrp can't take an argument");
     value = (I32)getpgrp();
 #endif
@@ -2836,12 +3165,11 @@ PP(pp_setpgrp)
     }
 
     TAINT_PROPER("setpgrp");
-#ifdef USE_BSDPGRP
-    SETi( setpgrp(pid, pgrp) >= 0 );
+#ifdef BSD_SETPGRP
+    SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
 #else
-    if ((pgrp != 0) || (pid != 0)) {
+    if ((pgrp != 0 && pgrp != getpid())) || (pid != 0 && pid != getpid()))
 	DIE("POSIX setpgrp can't take an argument");
-    }
     SETi( setpgrp() >= 0 );
 #endif /* USE_BSDPGRP */
     RETURN;
@@ -2888,19 +3216,35 @@ PP(pp_setpriority)
 PP(pp_time)
 {
     dSP; dTARGET;
+#ifdef BIG_TIME
+    XPUSHn( time(Null(Time_t*)) );
+#else
     XPUSHi( time(Null(Time_t*)) );
+#endif
     RETURN;
 }
 
+/* XXX The POSIX name is CLK_TCK; it is to be preferred
+   to HZ.  Probably.  For now, assume that if the system
+   defines HZ, it does so correctly.  (Will this break
+   on VMS?)
+   Probably we ought to use _sysconf(_SC_CLK_TCK), if
+   it's supported.    --AD  9/96.
+*/
+
 #ifndef HZ
-#define HZ 60
+#  ifdef CLK_TCK
+#    define HZ CLK_TCK
+#  else
+#    define HZ 60
+#  endif
 #endif
 
 PP(pp_tms)
 {
     dSP;
 
-#if defined(MSDOS) || !defined(HAS_TIMES)
+#ifndef HAS_TIMES
     DIE("times not implemented");
 #else
     EXTEND(SP, 4);
@@ -2920,7 +3264,7 @@ PP(pp_tms)
 	PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
     }
     RETURN;
-#endif /* MSDOS */
+#endif /* HAS_TIMES */
 }
 
 PP(pp_localtime)
@@ -2940,7 +3284,11 @@ PP(pp_gmtime)
     if (MAXARG < 1)
 	(void)time(&when);
     else
+#ifdef BIG_TIME
+	when = (Time_t)SvNVx(POPs);
+#else
 	when = (Time_t)SvIVx(POPs);
+#endif
 
     if (op->op_type == OP_LOCALTIME)
 	tmbuf = localtime(&when);
@@ -2948,6 +3296,7 @@ PP(pp_gmtime)
 	tmbuf = gmtime(&when);
 
     EXTEND(SP, 9);
+    EXTEND_MORTAL(9);
     if (GIMME != G_ARRAY) {
 	dTARGET;
 	char mybuf[30];
@@ -3003,7 +3352,7 @@ PP(pp_sleep)
 
     (void)time(&lasttime);
     if (MAXARG < 1)
-	pause();
+	Pause();
     else {
 	duration = POPi;
 	sleep((unsigned int)duration);
@@ -3187,14 +3536,15 @@ PP(pp_ghostent)
 
 #ifdef HOST_NOT_FOUND
     if (!hent)
-	statusvalue = FIXSTATUS(h_errno);
+	STATUS_NATIVE_SET(h_errno);
 #endif
 
     if (GIMME != G_ARRAY) {
 	PUSHs(sv = sv_newmortal());
 	if (hent) {
 	    if (which == OP_GHBYNAME) {
-		sv_setpvn(sv, hent->h_addr, hent->h_length);
+		if (hent->h_addr)
+		    sv_setpvn(sv, hent->h_addr, hent->h_length);
 	    }
 	    else
 		sv_setpv(sv, (char*)hent->h_name);
@@ -3212,10 +3562,10 @@ PP(pp_ghostent)
 		sv_catpvn(sv, " ", 1);
 	}
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	sv_setiv(sv, (I32)hent->h_addrtype);
+	sv_setiv(sv, (IV)hent->h_addrtype);
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	len = hent->h_length;
-	sv_setiv(sv, (I32)len);
+	sv_setiv(sv, (IV)len);
 #ifdef h_addr
 	for (elem = hent->h_addr_list; elem && *elem; elem++) {
 	    XPUSHs(sv = sv_mortalcopy(&sv_no));
@@ -3223,7 +3573,8 @@ PP(pp_ghostent)
 	}
 #else
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	sv_setpvn(sv, hent->h_addr, len);
+	if (hent->h_addr)
+	    sv_setpvn(sv, hent->h_addr, len);
 #endif /* h_addr */
     }
     RETURN;
@@ -3277,7 +3628,7 @@ PP(pp_gnetent)
 	PUSHs(sv = sv_newmortal());
 	if (nent) {
 	    if (which == OP_GNBYNAME)
-		sv_setiv(sv, (I32)nent->n_net);
+		sv_setiv(sv, (IV)nent->n_net);
 	    else
 		sv_setpv(sv, nent->n_name);
 	}
@@ -3294,9 +3645,9 @@ PP(pp_gnetent)
 		sv_catpvn(sv, " ", 1);
 	}
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	sv_setiv(sv, (I32)nent->n_addrtype);
+	sv_setiv(sv, (IV)nent->n_addrtype);
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	sv_setiv(sv, (I32)nent->n_net);
+	sv_setiv(sv, (IV)nent->n_net);
     }
 
     RETURN;
@@ -3347,7 +3698,7 @@ PP(pp_gprotoent)
 	PUSHs(sv = sv_newmortal());
 	if (pent) {
 	    if (which == OP_GPBYNAME)
-		sv_setiv(sv, (I32)pent->p_proto);
+		sv_setiv(sv, (IV)pent->p_proto);
 	    else
 		sv_setpv(sv, pent->p_name);
 	}
@@ -3364,7 +3715,7 @@ PP(pp_gprotoent)
 		sv_catpvn(sv, " ", 1);
 	}
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	sv_setiv(sv, (I32)pent->p_proto);
+	sv_setiv(sv, (IV)pent->p_proto);
     }
 
     RETURN;
@@ -3414,8 +3765,11 @@ PP(pp_gservent)
     }
     else if (which == OP_GSBYPORT) {
 	char *proto = POPp;
-	int port = POPi;
+	unsigned short port = POPu;
 
+#ifdef HAS_HTONS
+	port = htons(port);
+#endif
 	sent = getservbyport(port, proto);
     }
     else
@@ -3427,9 +3781,9 @@ PP(pp_gservent)
 	if (sent) {
 	    if (which == OP_GSBYNAME) {
 #ifdef HAS_NTOHS
-		sv_setiv(sv, (I32)ntohs(sent->s_port));
+		sv_setiv(sv, (IV)ntohs(sent->s_port));
 #else
-		sv_setiv(sv, (I32)(sent->s_port));
+		sv_setiv(sv, (IV)(sent->s_port));
 #endif
 	    }
 	    else
@@ -3449,9 +3803,9 @@ PP(pp_gservent)
 	}
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 #ifdef HAS_NTOHS
-	sv_setiv(sv, (I32)ntohs(sent->s_port));
+	sv_setiv(sv, (IV)ntohs(sent->s_port));
 #else
-	sv_setiv(sv, (I32)(sent->s_port));
+	sv_setiv(sv, (IV)(sent->s_port));
 #endif
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setpv(sv, sent->s_proto);
@@ -3593,7 +3947,7 @@ PP(pp_gpwent)
 	PUSHs(sv = sv_newmortal());
 	if (pwent) {
 	    if (which == OP_GPWNAM)
-		sv_setiv(sv, (I32)pwent->pw_uid);
+		sv_setiv(sv, (IV)pwent->pw_uid);
 	    else
 		sv_setpv(sv, pwent->pw_name);
 	}
@@ -3606,15 +3960,15 @@ PP(pp_gpwent)
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setpv(sv, pwent->pw_passwd);
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	sv_setiv(sv, (I32)pwent->pw_uid);
+	sv_setiv(sv, (IV)pwent->pw_uid);
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	sv_setiv(sv, (I32)pwent->pw_gid);
+	sv_setiv(sv, (IV)pwent->pw_gid);
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 #ifdef PWCHANGE
-	sv_setiv(sv, (I32)pwent->pw_change);
+	sv_setiv(sv, (IV)pwent->pw_change);
 #else
 #ifdef PWQUOTA
-	sv_setiv(sv, (I32)pwent->pw_quota);
+	sv_setiv(sv, (IV)pwent->pw_quota);
 #else
 #ifdef PWAGE
 	sv_setpv(sv, pwent->pw_age);
@@ -3637,7 +3991,7 @@ PP(pp_gpwent)
 	sv_setpv(sv, pwent->pw_shell);
 #ifdef PWEXPIRE
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	sv_setiv(sv, (I32)pwent->pw_expire);
+	sv_setiv(sv, (IV)pwent->pw_expire);
 #endif
     }
     RETURN;
@@ -3649,7 +4003,7 @@ PP(pp_gpwent)
 PP(pp_spwent)
 {
     dSP;
-#ifdef HAS_PASSWD
+#if defined(HAS_PASSWD) && !defined(CYGWIN32)
     setpwent();
     RETPUSHYES;
 #else
@@ -3707,7 +4061,7 @@ PP(pp_ggrent)
 	PUSHs(sv = sv_newmortal());
 	if (grent) {
 	    if (which == OP_GGRNAM)
-		sv_setiv(sv, (I32)grent->gr_gid);
+		sv_setiv(sv, (IV)grent->gr_gid);
 	    else
 		sv_setpv(sv, grent->gr_name);
 	}
@@ -3720,7 +4074,7 @@ PP(pp_ggrent)
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	sv_setpv(sv, grent->gr_passwd);
 	PUSHs(sv = sv_mortalcopy(&sv_no));
-	sv_setiv(sv, (I32)grent->gr_gid);
+	sv_setiv(sv, (IV)grent->gr_gid);
 	PUSHs(sv = sv_mortalcopy(&sv_no));
 	for (elem = grent->gr_mem; *elem; elem++) {
 	    sv_catpv(sv, *elem);
@@ -3786,9 +4140,10 @@ PP(pp_syscall)
 
     if (tainting) {
 	while (++MARK <= SP) {
-	    if (SvGMAGICAL(*MARK) && SvSMAGICAL(*MARK) &&
-	      (mg = mg_find(*MARK, 't')) && mg->mg_len & 1)
-		tainted = TRUE;
+	    if (SvTAINTED(*MARK)) {
+		TAINT;
+		break;
+	    }
 	}
 	MARK = ORIGMARK;
 	TAINT_PROPER("syscall");
@@ -3870,3 +4225,109 @@ PP(pp_syscall)
 #endif
 }
 
+#ifdef FCNTL_EMULATE_FLOCK
+ 
+/*  XXX Emulate flock() with fcntl().
+    What's really needed is a good file locking module.
+*/
+
+static int
+fcntl_emulate_flock(fd, operation)
+int fd;
+int operation;
+{
+    struct flock flock;
+ 
+    switch (operation & ~LOCK_NB) {
+    case LOCK_SH:
+	flock.l_type = F_RDLCK;
+	break;
+    case LOCK_EX:
+	flock.l_type = F_WRLCK;
+	break;
+    case LOCK_UN:
+	flock.l_type = F_UNLCK;
+	break;
+    default:
+	errno = EINVAL;
+	return -1;
+    }
+    flock.l_whence = SEEK_SET;
+    flock.l_start = flock.l_len = 0L;
+ 
+    return fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock);
+}
+
+#endif /* FCNTL_EMULATE_FLOCK */
+
+#ifdef LOCKF_EMULATE_FLOCK
+
+/*  XXX Emulate flock() with lockf().  This is just to increase
+    portability of scripts.  The calls are not completely
+    interchangeable.  What's really needed is a good file
+    locking module.
+*/
+
+/*  The lockf() constants might have been defined in <unistd.h>.
+    Unfortunately, <unistd.h> causes troubles on some mixed
+    (BSD/POSIX) systems, such as SunOS 4.1.3.
+
+   Further, the lockf() constants aren't POSIX, so they might not be
+   visible if we're compiling with _POSIX_SOURCE defined.  Thus, we'll
+   just stick in the SVID values and be done with it.  Sigh.
+*/
+
+# ifndef F_ULOCK
+#  define F_ULOCK	0	/* Unlock a previously locked region */
+# endif
+# ifndef F_LOCK
+#  define F_LOCK	1	/* Lock a region for exclusive use */
+# endif
+# ifndef F_TLOCK
+#  define F_TLOCK	2	/* Test and lock a region for exclusive use */
+# endif
+# ifndef F_TEST
+#  define F_TEST	3	/* Test a region for other processes locks */
+# endif
+
+static int
+lockf_emulate_flock (fd, operation)
+int fd;
+int operation;
+{
+    int i;
+    switch (operation) {
+
+	/* LOCK_SH - get a shared lock */
+	case LOCK_SH:
+	/* LOCK_EX - get an exclusive lock */
+	case LOCK_EX:
+	    i = lockf (fd, F_LOCK, 0);
+	    break;
+
+	/* LOCK_SH|LOCK_NB - get a non-blocking shared lock */
+	case LOCK_SH|LOCK_NB:
+	/* LOCK_EX|LOCK_NB - get a non-blocking exclusive lock */
+	case LOCK_EX|LOCK_NB:
+	    i = lockf (fd, F_TLOCK, 0);
+	    if (i == -1)
+		if ((errno == EAGAIN) || (errno == EACCES))
+		    errno = EWOULDBLOCK;
+	    break;
+
+	/* LOCK_UN - unlock (non-blocking is a no-op) */
+	case LOCK_UN:
+	case LOCK_UN|LOCK_NB:
+	    i = lockf (fd, F_ULOCK, 0);
+	    break;
+
+	/* Default - can't decipher operation */
+	default:
+	    i = -1;
+	    errno = EINVAL;
+	    break;
+    }
+    return (i);
+}
+
+#endif /* LOCKF_EMULATE_FLOCK */