X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/92479810ad7bcca524d84878cb8fc5387a2d262c..0bfc1ec4be2c76cee8aace7737f6fec3baae5189:/pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 0527fef..df0fb42 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -22,6 +22,11 @@
 /* Shadow password support for solaris - pdo@cs.umd.edu
  * Not just Solaris: at least HP-UX, IRIX, Linux.
  * the API is from SysV. --jhi */
+#ifdef __hpux__
+/* There is a MAXINT coming from <shadow.h> <- <hpsecurity.h> <- <values.h>
+ * and another MAXINT from "perl.h" <- <sys/param.h>. */ 
+#undef MAXINT
+#endif
 #include <shadow.h>
 #endif
 
@@ -187,6 +192,10 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
 #  include <sys/access.h>
 #endif
 
+#if defined(HAS_FCNTL) && defined(F_SETFD) && !defined(FD_CLOEXEC)
+#  define FD_CLOEXEC 1		/* NeXT needs this */
+#endif
+
 #undef PERL_EFF_ACCESS_R_OK	/* EFFective uid/gid ACCESS R_OK */
 #undef PERL_EFF_ACCESS_W_OK
 #undef PERL_EFF_ACCESS_X_OK
@@ -230,7 +239,7 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
 	|| defined(HAS_SETREGID) || defined(HAS_SETRESGID))
 /* The Hard Way. */
 STATIC int
-S_emulate_eaccess(pTHX_ const char* path, int mode)
+S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 {
     Uid_t ruid = getuid();
     Uid_t euid = geteuid();
@@ -238,7 +247,7 @@ S_emulate_eaccess(pTHX_ const char* path, int mode)
     Gid_t egid = getegid();
     int res;
 
-    MUTEX_LOCK(&PL_cred_mutex);
+    LOCK_CRED_MUTEX;
 #if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID)
     Perl_croak(aTHX_ "switching effective uid is not implemented");
 #else
@@ -284,7 +293,7 @@ S_emulate_eaccess(pTHX_ const char* path, int mode)
 #endif
 #endif
 	Perl_croak(aTHX_ "leaving effective gid failed");
-    MUTEX_UNLOCK(&PL_cred_mutex);
+    UNLOCK_CRED_MUTEX;
 
     return res;
 }
@@ -295,7 +304,7 @@ S_emulate_eaccess(pTHX_ const char* path, int mode)
 
 #if !defined(PERL_EFF_ACCESS_R_OK)
 STATIC int
-S_emulate_eaccess(pTHX_ const char* path, int mode)
+S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
 {
     Perl_croak(aTHX_ "switching effective uid is not implemented");
     /*NOTREACHED*/
@@ -402,7 +411,7 @@ PP(pp_indread)
 
 PP(pp_rcatline)
 {
-    PL_last_in_gv = cGVOP->op_gv;
+    PL_last_in_gv = cGVOP_gv;
     return do_readline();
 }
 
@@ -433,7 +442,7 @@ PP(pp_warn)
     if (!tmps || !len)
 	tmpsv = sv_2mortal(newSVpvn("Warning: something's wrong", 26));
 
-    Perl_warn(aTHX_ "%_", tmpsv);
+    Perl_warn(aTHX_ "%"SVf, tmpsv);
     RETSETYES;
 }
 
@@ -466,8 +475,8 @@ PP(pp_die)
 		HV *stash = SvSTASH(SvRV(error));
 		GV *gv = gv_fetchmethod(stash, "PROPAGATE");
 		if (gv) {
-		    SV *file = sv_2mortal(newSVsv(GvSV(PL_curcop->cop_filegv)));
-		    SV *line = sv_2mortal(newSViv(PL_curcop->cop_line));
+		    SV *file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
+		    SV *line = sv_2mortal(newSViv(CopLINE(PL_curcop)));
 		    EXTEND(SP, 3);
 		    PUSHMARK(SP);
 		    PUSHs(error);
@@ -491,7 +500,7 @@ PP(pp_die)
     if (!tmps || !len)
 	tmpsv = sv_2mortal(newSVpvn("Died", 4));
 
-    DIE(aTHX_ "%_", tmpsv);
+    DIE(aTHX_ "%"SVf, tmpsv);
 }
 
 /* I/O. */
@@ -523,22 +532,6 @@ PP(pp_open)
     if (GvIOp(gv))
 	IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
-#if 0 /* no undef means tmpfile() yet */
-    if (sv == &PL_sv_undef) {
-#ifdef PerlIO
-	PerlIO *fp = PerlIO_tmpfile();
-#else
-	PerlIO *fp = tmpfile();
-#endif                   
-	if (fp != Nullfp && do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) 
-	    PUSHi( (I32)PL_forkprocess );
-	else
-	    RETPUSHUNDEF;
-	RETURN;
-    }   
-#endif /* no undef means tmpfile() yet */
-
-
     if (mg = SvTIED_mg((SV*)gv, 'q')) {
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj((SV*)gv, mg));
@@ -816,17 +809,10 @@ PP(pp_untie)
     if (ckWARN(WARN_UNTIE)) {
         MAGIC * mg ;
         if (mg = SvTIED_mg(sv, how)) {
-#ifdef IV_IS_QUAD
             if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
 		Perl_warner(aTHX_ WARN_UNTIE,
-		    "untie attempted while %" PERL_PRIu64 " inner references still exist",
+		    "untie attempted while %"UVuf" inner references still exist",
 		    (UV)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
-#else
-            if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
-		Perl_warner(aTHX_ WARN_UNTIE,
-		    "untie attempted while %lu inner references still exist",
-		    (unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
-#endif
         }
     }
  
@@ -1109,8 +1095,6 @@ PP(pp_getc)
 	gv = PL_stdingv;
     else
 	gv = (GV*)POPs;
-    if (!gv)
-	gv = PL_argvgv;
 
     if (mg = SvTIED_mg((SV*)gv, 'q')) {
 	I32 gimme = GIMME_V;
@@ -1152,9 +1136,9 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
     SAVETMPS;
 
     push_return(retop);
-    PUSHBLOCK(cx, CXt_SUB, PL_stack_sp);
+    PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
     PUSHFORMAT(cx);
-    SAVESPTR(PL_curpad);
+    SAVEVPTR(PL_curpad);
     PL_curpad = AvARRAY((AV*)svp[1]);
 
     setdefout(gv);	    /* locally select filehandle so $% et al work */
@@ -1287,15 +1271,15 @@ PP(pp_leavewrite)
     fp = IoOFP(io);
     if (!fp) {
 	if (ckWARN2(WARN_CLOSED,WARN_IO)) {
-	    SV* sv = sv_newmortal();
-	    gv_efullname3(sv, gv, Nullch);
-	    if (IoIFP(io))
+	    if (IoIFP(io)) {
+		SV* sv = sv_newmortal();
+		gv_efullname3(sv, gv, Nullch);
 		Perl_warner(aTHX_ WARN_IO,
 			    "Filehandle %s opened only for input",
 			    SvPV_nolen(sv));
+	    }
 	    else if (ckWARN(WARN_CLOSED))
-		Perl_warner(aTHX_ WARN_CLOSED,
-			    "Write on closed filehandle %s", SvPV_nolen(sv));
+		report_closed_fh(gv, io, "write", "filehandle");
 	}
 	PUSHs(&PL_sv_no);
     }
@@ -1368,14 +1352,14 @@ PP(pp_prtf)
     }
     else if (!(fp = IoOFP(io))) {
 	if (ckWARN2(WARN_CLOSED,WARN_IO))  {
-	    gv_efullname3(sv, gv, Nullch);
-	    if (IoIFP(io))
+	    if (IoIFP(io)) {
+		gv_efullname3(sv, gv, Nullch);
 		Perl_warner(aTHX_ WARN_IO,
 			    "Filehandle %s opened only for input",
 			    SvPV(sv,n_a));
+	    }
 	    else if (ckWARN(WARN_CLOSED))
-		Perl_warner(aTHX_ WARN_CLOSED,
-			    "printf on closed filehandle %s", SvPV(sv,n_a));
+		report_closed_fh(gv, io, "printf", "filehandle");
 	}
 	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
 	goto just_say_no;
@@ -1561,8 +1545,8 @@ PP(pp_sysread)
 	    length = -1;
     }
     if (length < 0) {
-	if (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
-	    || IoIFP(io) == PerlIO_stderr())
+	if ((IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+	    || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO))
 	{
 	    SV* sv = sv_newmortal();
 	    gv_efullname3(sv, gv, Nullch);
@@ -1606,10 +1590,10 @@ PP(pp_send)
     djSP; dMARK; dORIGMARK; dTARGET;
     GV *gv;
     IO *io;
-    int offset;
+    Off_t offset;
     SV *bufsv;
     char *buffer;
-    int length;
+    Off_t length;
     STRLEN blen;
     MAGIC *mg;
 
@@ -1632,7 +1616,11 @@ PP(pp_send)
 	goto say_undef;
     bufsv = *++MARK;
     buffer = SvPV(bufsv, blen);
+#if Off_t_SIZE > IVSIZE
+    length = SvNVx(*++MARK);
+#else
     length = SvIVx(*++MARK);
+#endif
     if (length < 0)
 	DIE(aTHX_ "Negative length");
     SETERRNO(0,0);
@@ -1641,14 +1629,18 @@ PP(pp_send)
 	length = -1;
 	if (ckWARN(WARN_CLOSED)) {
 	    if (PL_op->op_type == OP_SYSWRITE)
-		Perl_warner(aTHX_ WARN_CLOSED, "Syswrite on closed filehandle");
+		report_closed_fh(gv, io, "syswrite", "filehandle");
 	    else
-		Perl_warner(aTHX_ WARN_CLOSED, "Send on closed socket");
+		report_closed_fh(gv, io, "send", "socket");
 	}
     }
     else if (PL_op->op_type == OP_SYSWRITE) {
 	if (MARK < SP) {
+#if Off_t_SIZE > IVSIZE
+	    offset = SvNVx(*++MARK);
+#else
 	    offset = SvIVx(*++MARK);
+#endif
 	    if (offset < 0) {
 		if (-offset > blen)
 		    DIE(aTHX_ "Offset outside string");
@@ -1667,6 +1659,7 @@ PP(pp_send)
 	else
 #endif
 	{
+	    /* See the note at doio.c:do_print about filesize limits. --jhi */
 	    length = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
 				   buffer+offset, length);
 	}
@@ -1708,10 +1701,28 @@ PP(pp_eof)
     GV *gv;
     MAGIC *mg;
 
-    if (MAXARG <= 0)
-	gv = PL_last_in_gv;
+    if (MAXARG <= 0) {
+	if (PL_op->op_flags & OPf_SPECIAL) {	/* eof() */
+	    IO *io;
+	    gv = PL_last_in_gv = PL_argvgv;
+	    io = GvIO(gv);
+	    if (io && !IoIFP(io)) {
+		if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
+		    IoLINES(io) = 0;
+		    IoFLAGS(io) &= ~IOf_START;
+		    do_open(gv, "-", 1, FALSE, O_RDONLY, 0, Nullfp);
+		    sv_setpvn(GvSV(gv), "-", 1);
+		    SvSETMAGIC(GvSV(gv));
+		}
+		else if (!nextargv(gv))
+		    RETPUSHYES;
+	    }
+	}
+	else
+	    gv = PL_last_in_gv;			/* eof */
+    }
     else
-	gv = PL_last_in_gv = (GV*)POPs;
+	gv = PL_last_in_gv = (GV*)POPs;		/* eof(FH) */
 
     if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
 	PUSHMARK(SP);
@@ -1750,7 +1761,11 @@ PP(pp_tell)
 	RETURN;
     }
 
+#if LSEEKSIZE > IVSIZE
+    PUSHn( do_tell(gv) );
+#else
     PUSHi( do_tell(gv) );
+#endif
     RETURN;
 }
 
@@ -1764,7 +1779,11 @@ PP(pp_sysseek)
     djSP;
     GV *gv;
     int whence = POPi;
-    Off_t offset = POPl;
+#if LSEEKSIZE > IVSIZE
+    Off_t offset = (Off_t)SvNVx(POPs);
+#else
+    Off_t offset = (Off_t)SvIVx(POPs);
+#endif
     MAGIC *mg;
 
     gv = PL_last_in_gv = (GV*)POPs;
@@ -1786,9 +1805,18 @@ PP(pp_sysseek)
 	PUSHs(boolSV(do_seek(gv, offset, whence)));
     else {
 	Off_t n = do_sysseek(gv, offset, whence);
-	PUSHs((n < 0) ? &PL_sv_undef
-	      : sv_2mortal(n ? newSViv((IV)n)
-			   : newSVpvn(zero_but_true, ZBTLEN)));
+        if (n < 0)
+            PUSHs(&PL_sv_undef);
+        else {
+            SV* sv = n ?
+#if LSEEKSIZE > IVSIZE
+                newSVnv((NV)n)
+#else
+                newSViv((IV)n)
+#endif
+                : newSVpvn(zero_but_true, ZBTLEN);
+            PUSHs(sv_2mortal(sv));
+        }
     }
     RETURN;
 }
@@ -1807,13 +1835,17 @@ PP(pp_truncate)
 	tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
     do_ftruncate:
 	TAINT_PROPER("truncate");
-	if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
+	if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)))
+	    result = 0;
+	else {
+	    PerlIO_flush(IoIFP(GvIOp(tmpgv)));
 #ifdef HAS_TRUNCATE
-	  ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+	    if (ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
 #else 
-	  my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+	    if (my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
 #endif
-	    result = 0;
+		result = 0;
+	}
     }
     else {
 	SV *sv = POPs;
@@ -1893,7 +1925,7 @@ PP(pp_ioctl)
     }
     else {
 	retval = SvIV(argsv);
-	s = (char*)retval;		/* ouch */
+	s = INT2PTR(char*,retval);		/* ouch */
     }
 
     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
@@ -1956,8 +1988,12 @@ PP(pp_flock)
 	(void)PerlIO_flush(fp);
 	value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0);
     }
-    else
+    else {
 	value = 0;
+	SETERRNO(EBADF,RMS$_IFI);
+	if (ckWARN(WARN_CLOSED))
+	    report_closed_fh(gv, GvIO(gv), "flock", "filehandle");
+    }
     PUSHi(value);
     RETURN;
 #else
@@ -2110,7 +2146,7 @@ PP(pp_bind)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed fd");
+	report_closed_fh(gv, io, "bind", "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2140,7 +2176,7 @@ PP(pp_connect)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed fd");
+	report_closed_fh(gv, io, "connect", "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2166,7 +2202,7 @@ PP(pp_listen)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed fd");
+	report_closed_fh(gv, io, "listen", "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2220,7 +2256,7 @@ PP(pp_accept)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed fd");
+	report_closed_fh(ggv, ggv ? GvIO(ggv) : 0, "accept", "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
 
 badexit:
@@ -2247,7 +2283,7 @@ PP(pp_shutdown)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed fd");
+	report_closed_fh(gv, io, "shutdown", "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2326,7 +2362,9 @@ PP(pp_ssockopt)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "[gs]etsockopt() on closed fd");
+	report_closed_fh(gv, io,
+			 optype == OP_GSOCKOPT ? "getsockopt" : "setsockopt",
+			 "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
@@ -2399,7 +2437,10 @@ PP(pp_getpeername)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "get{sock, peer}name() on closed fd");
+	report_closed_fh(gv, io,
+			 optype == OP_GETSOCKNAME ? "getsockname"
+						  : "getpeername",
+			 "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
@@ -2425,7 +2466,7 @@ PP(pp_stat)
     STRLEN n_a;
 
     if (PL_op->op_flags & OPf_REF) {
-	tmpgv = cGVOP->op_gv;
+	tmpgv = cGVOP_gv;
       do_fstat:
 	if (tmpgv != PL_defgv) {
 	    PL_laststype = OP_STAT;
@@ -2472,30 +2513,42 @@ PP(pp_stat)
     if (max) {
 	EXTEND(SP, max);
 	EXTEND_MORTAL(max);
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_dev)));
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_ino)));
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_mode)));
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_nlink)));
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_uid)));
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_gid)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_dev)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_ino)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_mode)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_nlink)));
+#if Uid_t_size > IVSIZE
+	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_uid)));
+#else
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_uid)));
+#endif
+#if Gid_t_size > IVSIZE 
+	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_gid)));
+#else
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_gid)));
+#endif
 #ifdef USE_STAT_RDEV
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_rdev)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev)));
 #else
 	PUSHs(sv_2mortal(newSVpvn("", 0)));
 #endif
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_size)));
+#if Off_t_size > IVSIZE
+	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_size)));
+#else
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_size)));
+#endif
 #ifdef BIG_TIME
-	PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_atime)));
-	PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_mtime)));
-	PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_ctime)));
+	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_atime)));
+	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime)));
+	PUSHs(sv_2mortal(newSVnv(PL_statcache.st_ctime)));
 #else
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_atime)));
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_mtime)));
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_ctime)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_atime)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_mtime)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_ctime)));
 #endif
 #ifdef USE_STAT_BLOCKS
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_blksize)));
-	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_blocks)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_blksize)));
+	PUSHs(sv_2mortal(newSViv(PL_statcache.st_blocks)));
 #else
 	PUSHs(sv_2mortal(newSVpvn("", 0)));
 	PUSHs(sv_2mortal(newSVpvn("", 0)));
@@ -2686,7 +2739,8 @@ PP(pp_ftrowned)
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ? PL_euid : PL_uid) )
+    if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ?
+				PL_euid : PL_uid) )
 	RETPUSHYES;
     RETPUSHNO;
 }
@@ -2697,7 +2751,7 @@ PP(pp_ftzero)
     djSP;
     if (result < 0)
 	RETPUSHUNDEF;
-    if (!PL_statcache.st_size)
+    if (PL_statcache.st_size == 0)
 	RETPUSHYES;
     RETPUSHNO;
 }
@@ -2708,7 +2762,11 @@ PP(pp_ftsize)
     djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
+#if Off_t_size > IVSIZE
+    PUSHn(PL_statcache.st_size);
+#else
     PUSHi(PL_statcache.st_size);
+#endif
     RETURN;
 }
 
@@ -2718,7 +2776,7 @@ PP(pp_ftmtime)
     djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_mtime) / 86400.0 );
+    PUSHn( (PL_basetime - PL_statcache.st_mtime) / 86400.0 );
     RETURN;
 }
 
@@ -2728,7 +2786,7 @@ PP(pp_ftatime)
     djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_atime) / 86400.0 );
+    PUSHn( (PL_basetime - PL_statcache.st_atime) / 86400.0 );
     RETURN;
 }
 
@@ -2738,7 +2796,7 @@ PP(pp_ftctime)
     djSP; dTARGET;
     if (result < 0)
 	RETPUSHUNDEF;
-    PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_ctime) / 86400.0 );
+    PUSHn( (PL_basetime - PL_statcache.st_ctime) / 86400.0 );
     RETURN;
 }
 
@@ -2870,7 +2928,7 @@ PP(pp_fttty)
     STRLEN n_a;
 
     if (PL_op->op_flags & OPf_REF)
-	gv = cGVOP->op_gv;
+	gv = cGVOP_gv;
     else if (isGV(TOPs))
 	gv = (GV*)POPs;
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
@@ -2909,9 +2967,10 @@ PP(pp_fttext)
     register SV *sv;
     GV *gv;
     STRLEN n_a;
+    PerlIO *fp;
 
     if (PL_op->op_flags & OPf_REF)
-	gv = cGVOP->op_gv;
+	gv = cGVOP_gv;
     else if (isGV(TOPs))
 	gv = (GV*)POPs;
     else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
@@ -2946,23 +3005,25 @@ PP(pp_fttext)
 		    RETPUSHNO;
 		else
 		    RETPUSHYES;
-	    if (PerlIO_get_cnt(aTHX_ IoIFP(io)) <= 0) {
+	    if (PerlIO_get_cnt(IoIFP(io)) <= 0) {
 		i = PerlIO_getc(IoIFP(io));
 		if (i != EOF)
 		    (void)PerlIO_ungetc(IoIFP(io),i);
 	    }
-	    if (PerlIO_get_cnt(aTHX_ IoIFP(io)) <= 0)	/* null file is anything */
+	    if (PerlIO_get_cnt(IoIFP(io)) <= 0)	/* null file is anything */
 		RETPUSHYES;
-	    len = PerlIO_get_bufsiz(aTHX_ IoIFP(io));
-	    s = (STDCHAR *) PerlIO_get_base(aTHX_ IoIFP(io));
+	    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 (ckWARN(WARN_UNOPENED))
+	    if (ckWARN(WARN_UNOPENED)) {
+		gv = cGVOP_gv;
 		Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file <%s>",
-		  GvENAME(cGVOP->op_gv));
+			    GvENAME(gv));
+	    }
 	    SETERRNO(EBADF,RMS$_IFI);
 	    RETPUSHUNDEF;
 	}
@@ -2973,21 +3034,19 @@ PP(pp_fttext)
 	PL_statgv = Nullgv;
 	PL_laststatval = -1;
 	sv_setpv(PL_statname, SvPV(sv, n_a));
-#ifdef HAS_OPEN3
-	i = PerlLIO_open3(SvPV(sv, n_a), O_RDONLY, 0);
-#else
-	i = PerlLIO_open(SvPV(sv, n_a), 0);
-#endif
-	if (i < 0) {
+	if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) {
 	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
 		Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
 	    RETPUSHUNDEF;
 	}
-	PL_laststatval = PerlLIO_fstat(i, &PL_statcache);
-	if (PL_laststatval < 0)
+	PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
+	if (PL_laststatval < 0)	{
+	    (void)PerlIO_close(fp);
 	    RETPUSHUNDEF;
-	len = PerlLIO_read(i, tbuf, 512);
-	(void)PerlLIO_close(i);
+	}
+	do_binmode(fp, '<', TRUE);
+	len = PerlIO_read(fp, tbuf, sizeof(tbuf));
+	(void)PerlIO_close(fp);
 	if (len <= 0) {
 	    if (S_ISDIR(PL_statcache.st_mode) && PL_op->op_type == OP_FTTEXT)
 		RETPUSHNO;		/* special case NFS directories */
@@ -2999,6 +3058,12 @@ PP(pp_fttext)
     /* now scan s to look for textiness */
     /*   XXX ASCII dependent code */
 
+#if defined(DOSISH) || defined(USEMYBINMODE)
+    /* ignore trailing ^Z on short files */
+    if (len && len < sizeof(tbuf) && tbuf[len-1] == 26)
+	--len;
+#endif
+
     for (i = 0; i < len; i++, s++) {
 	if (!*s) {			/* null never allowed in text */
 	    odd += len;
@@ -3008,8 +3073,12 @@ PP(pp_fttext)
         else if (!(isPRINT(*s) || isSPACE(*s))) 
             odd++;
 #else
-	else if (*s & 128)
-	    odd++;
+	else if (*s & 128) {
+#ifdef USE_LOCALE
+	    if (!(PL_op->op_private & OPpLOCALE) || !isALPHA_LC(*s))
+#endif
+		odd++;
+	}
 	else if (*s < 32 &&
 	  *s != '\n' && *s != '\r' && *s != '\b' &&
 	  *s != '\t' && *s != '\f' && *s != 27)
@@ -3162,7 +3231,7 @@ PP(pp_link)
     char *tmps2 = POPpx;
     char *tmps = SvPV(TOPs, n_a);
     TAINT_PROPER("link");
-    SETi( link(tmps, tmps2) >= 0 );
+    SETi( PerlLIO_link(tmps, tmps2) >= 0 );
 #else
     DIE(aTHX_ PL_no_func, "Unsupported function link");
 #endif
@@ -3538,19 +3607,30 @@ PP(pp_fork)
     if (!childpid) {
 	/*SUPPRESS 560*/
 	if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
-	    sv_setiv(GvSV(tmpgv), (IV)getpid());
+	    sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
 	hv_clear(PL_pidstatus);	/* no kids, so don't wait for 'em */
     }
     PUSHi(childpid);
     RETURN;
 #else
+#  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+    djSP; dTARGET;
+    Pid_t childpid;
+
+    EXTEND(SP, 1);
+    PERL_FLUSHALL_FOR_CHILD;
+    childpid = PerlProc_fork();
+    PUSHi(childpid);
+    RETURN;
+#  else
     DIE(aTHX_ PL_no_func, "Unsupported function fork");
+#  endif
 #endif
 }
 
 PP(pp_wait)
 {
-#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) 
     djSP; dTARGET;
     Pid_t childpid;
     int argflags;
@@ -3566,7 +3646,7 @@ PP(pp_wait)
 
 PP(pp_waitpid)
 {
-#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) 
     djSP; dTARGET;
     Pid_t childpid;
     int optype;
@@ -3647,7 +3727,7 @@ PP(pp_system)
 	    PerlLIO_close(pp[0]);
 	    if (n) {			/* Error */
 		if (n != sizeof(int))
-		    Perl_croak(aTHX_ "panic: kid popen errno read");
+		    DIE(aTHX_ "panic: kid popen errno read");
 		errno = errkid;		/* Propagate errno from kid */
 		STATUS_CURRENT = -1;
 	    }
@@ -3730,6 +3810,12 @@ PP(pp_exec)
 #  endif
 #endif
     }
+
+#if !defined(HAS_FORK) && defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+    if (value >= 0)
+	my_exit(value);
+#endif
+
     SP = ORIGMARK;
     PUSHi(value);
     RETURN;
@@ -3764,21 +3850,21 @@ PP(pp_getpgrp)
 {
 #ifdef HAS_GETPGRP
     djSP; dTARGET;
-    int pid;
-    I32 value;
+    Pid_t pid;
+    Pid_t pgrp;
 
     if (MAXARG < 1)
 	pid = 0;
     else
 	pid = SvIVx(POPs);
 #ifdef BSD_GETPGRP
-    value = (I32)BSD_GETPGRP(pid);
+    pgrp = (I32)BSD_GETPGRP(pid);
 #else
-    if (pid != 0 && pid != getpid())
+    if (pid != 0 && pid != PerlProc_getpid())
 	DIE(aTHX_ "POSIX getpgrp can't take an argument");
-    value = (I32)getpgrp();
+    pgrp = getpgrp();
 #endif
-    XPUSHi(value);
+    XPUSHi(pgrp);
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "getpgrp()");
@@ -3789,8 +3875,8 @@ PP(pp_setpgrp)
 {
 #ifdef HAS_SETPGRP
     djSP; dTARGET;
-    int pgrp;
-    int pid;
+    Pid_t pgrp;
+    Pid_t pid;
     if (MAXARG < 2) {
 	pgrp = 0;
 	pid = 0;
@@ -3804,8 +3890,11 @@ PP(pp_setpgrp)
 #ifdef BSD_SETPGRP
     SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
 #else
-    if ((pgrp != 0 && pgrp != getpid()) || (pid != 0 && pid != getpid()))
-	DIE(aTHX_ "POSIX setpgrp can't take an argument");
+    if ((pgrp != 0 && pgrp != PerlProc_getpid())
+	|| (pid != 0 && pid != PerlProc_getpid()))
+    {
+	DIE(aTHX_ "setpgrp can't take arguments");
+    }
     SETi( setpgrp() >= 0 );
 #endif /* USE_BSDPGRP */
     RETURN;
@@ -3939,25 +4028,25 @@ PP(pp_gmtime)
 	if (!tmbuf)
 	    RETPUSHUNDEF;
 	tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %d",
-		       dayname[tmbuf->tm_wday],
-		       monname[tmbuf->tm_mon],
-		       tmbuf->tm_mday,
-		       tmbuf->tm_hour,
-		       tmbuf->tm_min,
-		       tmbuf->tm_sec,
-		       tmbuf->tm_year + 1900);
+			    dayname[tmbuf->tm_wday],
+			    monname[tmbuf->tm_mon],
+			    tmbuf->tm_mday,
+			    tmbuf->tm_hour,
+			    tmbuf->tm_min,
+			    tmbuf->tm_sec,
+			    tmbuf->tm_year + 1900);
 	PUSHs(sv_2mortal(tsv));
     }
     else if (tmbuf) {
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
-	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
+	PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec)));
+	PUSHs(sv_2mortal(newSViv(tmbuf->tm_min)));
+	PUSHs(sv_2mortal(newSViv(tmbuf->tm_hour)));
+	PUSHs(sv_2mortal(newSViv(tmbuf->tm_mday)));
+	PUSHs(sv_2mortal(newSViv(tmbuf->tm_mon)));
+	PUSHs(sv_2mortal(newSViv(tmbuf->tm_year)));
+	PUSHs(sv_2mortal(newSViv(tmbuf->tm_wday)));
+	PUSHs(sv_2mortal(newSViv(tmbuf->tm_yday)));
+	PUSHs(sv_2mortal(newSViv(tmbuf->tm_isdst)));
     }
     RETURN;
 }
@@ -3972,7 +4061,7 @@ PP(pp_alarm)
     EXTEND(SP, 1);
     if (anum < 0)
 	RETPUSHUNDEF;
-    PUSHi((I32)anum);
+    PUSHi(anum);
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "Unsupported function alarm");
@@ -4739,7 +4828,7 @@ PP(pp_gpwent)
 PP(pp_spwent)
 {
     djSP;
-#if defined(HAS_PASSWD) && defined(HAS_SETPWENT) && !defined(CYGWIN)
+#if defined(HAS_PASSWD) && defined(HAS_SETPWENT)
     setpwent();
 #   ifdef HAS_SETSPENT
     setspent();
@@ -5000,7 +5089,7 @@ fcntl_emulate_flock(int fd, int operation)
 	return -1;
     }
     flock.l_whence = SEEK_SET;
-    flock.l_start = flock.l_len = 0L;
+    flock.l_start = flock.l_len = (Off_t)0;
  
     return fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock);
 }