This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
malloc.c tweaks
[perl5.git] / pp_sys.c
index 82cc932..2630e05 100644 (file)
--- 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--)), 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;
 }
@@ -754,7 +754,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 */
@@ -1296,7 +1297,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) {
@@ -2186,9 +2187,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)));
@@ -2579,7 +2580,7 @@ PP(pp_fttext)
 #ifdef HAS_OPEN3
        i = PerlLIO_open3(SvPV(sv, PL_na), O_RDONLY, 0);
 #else
-       i = PerlLIO_open(SvPV(sv, na), 0);
+       i = PerlLIO_open(SvPV(sv, PL_na), 0);
 #endif
        if (i < 0) {
            if (PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
@@ -2607,12 +2608,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,9 +2656,9 @@ 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, na);
+           tmps = SvPV(*svp, PL_na);
     }
 #endif
     TAINT_PROPER("chdir");
@@ -2660,7 +2666,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 +2740,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 +2832,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 +2881,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,14 +3226,14 @@ 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);
     }
     else if (SP - MARK != 1)
        value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
     else {
-       value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
+       value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), PL_na));
     }
     STATUS_NATIVE_SET(value);
     do_execfree();
@@ -3259,7 +3265,7 @@ PP(pp_exec)
            TAINT_PROPER("exec");
        }
 #ifdef VMS
-       value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
+       value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
 #else
        value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
 #endif
@@ -3422,7 +3428,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 +3755,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 +4234,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
     }