X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=40628afcdb4fadf1c7334361334eadd143ca1701;hb=4beedc23b598a493399ba23c8c4bd5448e52283a;hp=0d8f53910b3c597c6011522ea999f7f8d739b7bb;hpb=b28d0864af067162e2d26cc66b6b8acb6d3cddc8;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index 0d8f539..40628af 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -259,7 +259,7 @@ PP(pp_glob)
     PL_rs = sv_2mortal(newSVpv("", 1));
 #ifndef DOSISH
 #ifndef CSH
-    *SvPVX(rs) = '\n';
+    *SvPVX(PL_rs) = '\n';
 #endif	/* !CSH */
 #endif	/* !DOSISH */
 
@@ -271,7 +271,7 @@ PP(pp_glob)
 #if 0		/* XXX never used! */
 PP(pp_indread)
 {
-    last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), PL_na), TRUE,SVt_PVIO);
+    PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), PL_na), TRUE,SVt_PVIO);
     return do_readline();
 }
 #endif
@@ -382,7 +382,7 @@ PP(pp_open)
     if (GvIOp(gv))
 	IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
     tmps = SvPV(sv, len);
-    if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp))
+    if (do_open(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp))
 	PUSHi( (I32)PL_forkprocess );
     else if (PL_forkprocess == 0)		/* we are a new child */
 	PUSHi(0);
@@ -504,7 +504,7 @@ PP(pp_umask)
      * since 'group' and 'other' concepts probably don't exist here. */
     if (MAXARG >= 1 && (POPi & 0700))
 	DIE("umask not implemented");
-    XPUSHs(&sv_undef);
+    XPUSHs(&PL_sv_undef);
 #endif
     RETURN;
 }
@@ -612,7 +612,7 @@ PP(pp_untie)
 
     sv = POPs;
 
-    if (PL_dowarn) {
+    if (ckWARN(WARN_UNTIE)) {
         MAGIC * mg ;
         if (SvMAGICAL(sv)) {
             if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
@@ -621,8 +621,9 @@ PP(pp_untie)
                 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 ) ;
+		warner(WARN_UNTIE,
+		    "untie attempted while %lu inner references still exist",
+		    (unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
         }
     }
  
@@ -754,7 +755,8 @@ PP(pp_sselect)
     }
 
 #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
-#if defined(__linux__) || defined(OS2)
+/* XXX Configure test needed. */
+#if defined(__linux__) || defined(OS2) || defined(NeXT) || defined(__osf__) || defined(sun)
     growsize = sizeof(fd_set);
 #else
     growsize = maxlen;		/* little endians can use vecs directly */
@@ -1082,18 +1084,18 @@ PP(pp_leavewrite)
 
     fp = IoOFP(io);
     if (!fp) {
-	if (PL_dowarn) {
+	if (ckWARN2(WARN_CLOSED,WARN_IO)) {
 	    if (IoIFP(io))
-		warn("Filehandle only opened for input");
-	    else
-		warn("Write on closed filehandle");
+		warner(WARN_IO, "Filehandle only opened for input");
+	    else if (ckWARN(WARN_CLOSED))
+		warner(WARN_CLOSED, "Write on closed filehandle");
 	}
 	PUSHs(&PL_sv_no);
     }
     else {
 	if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
-	    if (PL_dowarn)
-		warn("page overflow");
+	    if (ckWARN(WARN_IO))
+		warner(WARN_IO, "page overflow");
 	}
 	if (!PerlIO_write(ofp, SvPVX(PL_formtarget), SvCUR(PL_formtarget)) ||
 		PerlIO_error(fp))
@@ -1148,20 +1150,22 @@ PP(pp_prtf)
 
     sv = NEWSV(0,0);
     if (!(io = GvIO(gv))) {
-	if (PL_dowarn) {
+	if (ckWARN(WARN_UNOPENED)) {
 	    gv_fullname3(sv, gv, Nullch);
-	    warn("Filehandle %s never opened", SvPV(sv,PL_na));
+	    warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,PL_na));
 	}
 	SETERRNO(EBADF,RMS$_IFI);
 	goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
-	if (PL_dowarn)  {
+	if (ckWARN2(WARN_CLOSED,WARN_IO))  {
 	    gv_fullname3(sv, gv, Nullch);
 	    if (IoIFP(io))
-		warn("Filehandle %s opened only for input", SvPV(sv,PL_na));
-	    else
-		warn("printf on closed filehandle %s", SvPV(sv,PL_na));
+		warner(WARN_IO, "Filehandle %s opened only for input",
+			SvPV(sv,PL_na));
+	    else if (ckWARN(WARN_CLOSED))
+		warner(WARN_CLOSED, "printf on closed filehandle %s",
+			SvPV(sv,PL_na));
 	}
 	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
 	goto just_say_no;
@@ -1296,7 +1300,7 @@ PP(pp_sysread)
 	RETURN;
     }
 #else
-    if (op->op_type == OP_RECV)
+    if (PL_op->op_type == OP_RECV)
 	DIE(no_sock_func, "recv");
 #endif
     if (offset < 0) {
@@ -1395,11 +1399,11 @@ PP(pp_send)
     io = GvIO(gv);
     if (!io || !IoIFP(io)) {
 	length = -1;
-	if (PL_dowarn) {
+	if (ckWARN(WARN_CLOSED)) {
 	    if (PL_op->op_type == OP_SYSWRITE)
-		warn("Syswrite on closed filehandle");
+		warner(WARN_CLOSED, "Syswrite on closed filehandle");
 	    else
-		warn("Send on closed socket");
+		warner(WARN_CLOSED, "Send on closed socket");
 	}
     }
     else if (PL_op->op_type == OP_SYSWRITE) {
@@ -1812,8 +1816,8 @@ PP(pp_bind)
 	RETPUSHUNDEF;
 
 nuts:
-    if (PL_dowarn)
-	warn("bind() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	warner(WARN_CLOSED, "bind() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -1842,8 +1846,8 @@ PP(pp_connect)
 	RETPUSHUNDEF;
 
 nuts:
-    if (PL_dowarn)
-	warn("connect() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	warner(WARN_CLOSED, "connect() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -1868,8 +1872,8 @@ PP(pp_listen)
 	RETPUSHUNDEF;
 
 nuts:
-    if (PL_dowarn)
-	warn("listen() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	warner(WARN_CLOSED, "listen() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -1922,8 +1926,8 @@ PP(pp_accept)
     RETURN;
 
 nuts:
-    if (PL_dowarn)
-	warn("accept() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	warner(WARN_CLOSED, "accept() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
 
 badexit:
@@ -1949,8 +1953,8 @@ PP(pp_shutdown)
     RETURN;
 
 nuts:
-    if (PL_dowarn)
-	warn("shutdown() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	warner(WARN_CLOSED, "shutdown() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2027,8 +2031,8 @@ PP(pp_ssockopt)
     RETURN;
 
 nuts:
-    if (PL_dowarn)
-	warn("[gs]etsockopt() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	warner(WARN_CLOSED, "[gs]etsockopt() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
@@ -2100,8 +2104,8 @@ PP(pp_getpeername)
     RETURN;
 
 nuts:
-    if (PL_dowarn)
-	warn("get{sock, peer}name() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+	warner(WARN_CLOSED, "get{sock, peer}name() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
@@ -2158,8 +2162,8 @@ PP(pp_stat)
 #endif
 	    PL_laststatval = PerlLIO_stat(SvPV(PL_statname, PL_na), &PL_statcache);
 	if (PL_laststatval < 0) {
-	    if (PL_dowarn && strchr(SvPV(PL_statname, PL_na), '\n'))
-		warn(warn_nl, "stat");
+	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, PL_na), '\n'))
+		warner(WARN_NEWLINE, warn_nl, "stat");
 	    max = 0;
 	}
     }
@@ -2186,9 +2190,9 @@ PP(pp_stat)
 #endif
 	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_size)));
 #ifdef BIG_TIME
-	PUSHs(sv_2mortal(newSVnv((U32)statcache.st_atime)));
-	PUSHs(sv_2mortal(newSVnv((U32)statcache.st_mtime)));
-	PUSHs(sv_2mortal(newSVnv((U32)statcache.st_ctime)));
+	PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_atime)));
+	PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_mtime)));
+	PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_ctime)));
 #else
 	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_atime)));
 	PUSHs(sv_2mortal(newSViv((I32)PL_statcache.st_mtime)));
@@ -2563,8 +2567,8 @@ PP(pp_fttext)
 		len = 512;
 	}
 	else {
-	    if (PL_dowarn)
-		warn("Test on unopened file <%s>",
+	    if (ckWARN(WARN_UNOPENED))
+		warner(WARN_UNOPENED, "Test on unopened file <%s>",
 		  GvENAME(cGVOP->op_gv));
 	    SETERRNO(EBADF,RMS$_IFI);
 	    RETPUSHUNDEF;
@@ -2582,8 +2586,8 @@ PP(pp_fttext)
 	i = PerlLIO_open(SvPV(sv, PL_na), 0);
 #endif
 	if (i < 0) {
-	    if (PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
-		warn(warn_nl, "open");
+	    if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, PL_na), '\n'))
+		warner(WARN_NEWLINE, warn_nl, "open");
 	    RETPUSHUNDEF;
 	}
 	PL_laststatval = PerlLIO_fstat(i, &PL_statcache);
@@ -2607,12 +2611,17 @@ PP(pp_fttext)
 	    odd += len;
 	    break;
 	}
+#ifdef EBCDIC
+        else if (!(isPRINT(*s) || isSPACE(*s))) 
+            odd++;
+#else
 	else if (*s & 128)
 	    odd++;
 	else if (*s < 32 &&
 	  *s != '\n' && *s != '\r' && *s != '\b' &&
 	  *s != '\t' && *s != '\f' && *s != 27)
 	    odd++;
+#endif
     }
 
     if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
@@ -2650,7 +2659,7 @@ PP(pp_chdir)
     }
 #ifdef VMS
     if (!tmps || !*tmps) {
-       svp = hv_fetch(GvHVn(envgv), "SYS$LOGIN", 9, FALSE);
+       svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE);
        if (svp)
            tmps = SvPV(*svp, PL_na);
     }
@@ -2660,7 +2669,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,G_DISCARD);
+    hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD);
 #endif
     RETURN;
 }
@@ -2734,11 +2743,11 @@ PP(pp_rename)
 #ifdef HAS_RENAME
     anum = PerlLIO_rename(tmps, tmps2);
 #else
-    if (!(anum = PerlLIO_stat(tmps, &statbuf))) {
+    if (!(anum = PerlLIO_stat(tmps, &PL_statbuf))) {
 	if (same_dirent(tmps2, tmps))	/* can always rename to same name */
 	    anum = 1;
 	else {
-	    if (euid || PerlLIO_stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
+	    if (PL_euid || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode))
 		(void)UNLINK(tmps2);
 	    if (!(anum = link(tmps, tmps2)))
 		anum = UNLINK(tmps);
@@ -2826,7 +2835,7 @@ char *filename;
 
     if (myfp) {
 	SV *tmpsv = sv_newmortal();
-	/* Need to save/restore 'rs' ?? */
+	/* Need to save/restore 'PL_rs' ?? */
 	s = sv_gets(tmpsv, myfp, 0);
 	(void)PerlProc_pclose(myfp);
 	if (s != Nullch) {
@@ -2875,8 +2884,8 @@ char *filename;
 	    return 0;
 	}
 	else {	/* some mkdirs return no failure indication */
-	    anum = (PerlLIO_stat(save_filename, &statbuf) >= 0);
-	    if (op->op_type == OP_RMDIR)
+	    anum = (PerlLIO_stat(save_filename, &PL_statbuf) >= 0);
+	    if (PL_op->op_type == OP_RMDIR)
 		anum = !anum;
 	    if (anum)
 		SETERRNO(0,0);
@@ -3220,7 +3229,7 @@ PP(pp_system)
     }
     PerlProc__exit(-1);
 #else /* ! FORK or VMS or OS/2 */
-    if (op->op_flags & OPf_STACKED) {
+    if (PL_op->op_flags & OPf_STACKED) {
 	SV *really = *++MARK;
 	value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
     }
@@ -3422,7 +3431,7 @@ PP(pp_tms)
 #ifndef VMS
     (void)PerlProc_times(&PL_timesbuf);
 #else
-    (void)PerlProc_times((tbuffer_t *)&timesbuf);  /* time.h uses different name for */
+    (void)PerlProc_times((tbuffer_t *)&PL_timesbuf);  /* time.h uses different name for */
                                                    /* struct tms, though same data   */
                                                    /* is returned.                   */
 #endif
@@ -3749,7 +3758,7 @@ PP(pp_ghostent)
 	    sv_setpvn(sv, *elem, len);
 	}
 #else
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	if (hent->h_addr)
 	    sv_setpvn(sv, hent->h_addr, len);
 #endif /* h_addr */
@@ -4228,7 +4237,7 @@ PP(pp_gpwent)
 	sv_setpv(sv, pwent->pw_shell);
 
 #ifdef PWEXPIRE
-	PUSHs(sv = sv_mortalcopy(&sv_no));
+	PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 	sv_setiv(sv, (IV)pwent->pw_expire);
 #endif
     }