Add files missing in 24314
[p5sagit/p5-mst-13.2.git] / doio.c
diff --git a/doio.c b/doio.c
index c8bc22d..1d7e56f 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -71,6 +71,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
              int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
              I32 num_svs)
 {
+    (void)num_svs;
     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
                    supplied_fp, &svs, 1);
 }
@@ -80,6 +81,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
              int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
              I32 num_svs)
 {
+    dVAR;
     register IO *io = GvIOn(gv);
     PerlIO *saveifp = Nullfp;
     PerlIO *saveofp = Nullfp;
@@ -156,7 +158,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
             |O_TRUNC
 #endif
             ;
-       int modifyingmode = O_WRONLY|O_RDWR|O_CREAT|appendtrunc;
+       const int modifyingmode = O_WRONLY|O_RDWR|O_CREAT|appendtrunc;
        int ismodifying;
 
        if (num_svs != 0) {
@@ -218,7 +220,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 
        if (num_svs) {
            /* New style explicit name, type is just mode and layer info */
-           STRLEN l = 0;
 #ifdef USE_STDIO
            if (SvROK(*svp) && !strchr(name,'&')) {
                if (ckWARN(WARN_IO))
@@ -228,9 +229,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                goto say_false;
            }
 #endif /* USE_STDIO */
-           name = SvOK(*svp) ? SvPV(*svp, l) : "";
-           len = (I32)l;
-           name = savepvn(name, len);
+           name = SvOK(*svp) ? savesvpv (*svp) : savepvn ("", 0);
            SAVEFREEPV(name);
        }
        else {
@@ -676,10 +675,10 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                 sv = *av_fetch(PL_fdpid,fd,TRUE);
                 (void)SvUPGRADE(sv, SVt_IV);
                 pid = SvIVX(sv);
-                SvIVX(sv) = 0;
+                SvIV_set(sv, 0);
                 sv = *av_fetch(PL_fdpid,savefd,TRUE);
                 (void)SvUPGRADE(sv, SVt_IV);
-                SvIVX(sv) = pid;
+                SvIV_set(sv, pid);
                 UNLOCK_FDPID_MUTEX;
             }
 #endif
@@ -1242,14 +1241,14 @@ Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
 }
 
-#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
+#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE)
+I32
+my_chsize(int fd, Off_t length)
+{
+#ifdef F_FREESP
        /* code courtesy of William Kucharski */
 #define HAS_CHSIZE
 
-I32 my_chsize(fd, length)
-I32 fd;                        /* file descriptor */
-Off_t length;          /* length to set file to */
-{
     struct flock fl;
     Stat_t filebuf;
 
@@ -1288,10 +1287,13 @@ Off_t length;           /* length to set file to */
            return -1;
 
     }
-
     return 0;
-}
+#else
+    Perl_croak_nocontext("truncate not implemented");
 #endif /* F_FREESP */
+    return -1;
+}
+#endif /* !HAS_TRUNCATE && !HAS_CHSIZE */
 
 bool
 Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
@@ -1415,7 +1417,7 @@ Perl_my_stat(pTHX)
     }
 }
 
-static char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
+static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
 
 I32
 Perl_my_lstat(pTHX)
@@ -1468,7 +1470,8 @@ bool
 Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
               int fd, int do_report)
 {
-#ifdef MACOS_TRADITIONAL
+    dVAR;
+#if defined(MACOS_TRADITIONAL) || defined(SYMBIAN)
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
     register char **a;
@@ -1524,7 +1527,7 @@ Perl_do_execfree(pTHX)
     }
 }
 
-#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(MACOS_TRADITIONAL)
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(SYMBIAN) && !defined(MACOS_TRADITIONAL)
 
 bool
 Perl_do_exec(pTHX_ char *cmd)
@@ -1535,6 +1538,7 @@ Perl_do_exec(pTHX_ char *cmd)
 bool
 Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 {
+    dVAR;
     register char **a;
     register char *s;
 
@@ -1608,7 +1612,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
                && s > cmd + 1 && s[-1] == '2' && isSPACE(s[-2])
                && (!s[3] || isSPACE(s[3])))
            {
-               char *t = s + 3;
+                const char *t = s + 3;
 
                while (*t && isSPACE(*t))
                    ++t;
@@ -1646,12 +1650,11 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
            goto doshell;
        }
        {
-           int e = errno;
-
            if (ckWARN(WARN_EXEC))
                Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
                    PL_Argv[0], Strerror(errno));
            if (do_report) {
+               int e = errno;
                PerlLIO_write(fd, (void*)&e, sizeof(int));
                PerlLIO_close(fd);
            }
@@ -1667,7 +1670,6 @@ I32
 Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 {
     register I32 val;
-    register I32 val2;
     register I32 tot = 0;
     const char *what;
     char *s;
@@ -1710,6 +1712,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
        what = "chown";
        APPLY_TAINT_PROPER();
        if (sp - mark > 2) {
+            register I32 val2;
            val = SvIVx(*++mark);
            val2 = SvIVx(*++mark);
            APPLY_TAINT_PROPER();
@@ -1828,16 +1831,17 @@ nothing in the core.
        if (sp - mark > 2) {
 #if defined(I_UTIME) || defined(VMS)
            struct utimbuf utbuf;
+           struct utimbuf *utbufp = &utbuf;
 #else
            struct {
                Time_t  actime;
                Time_t  modtime;
            } utbuf;
+           void *utbufp = &utbuf;
 #endif
 
            SV* accessed = *++mark;
            SV* modified = *++mark;
-           void * utbufp = &utbuf;
 
            /* Be like C, and if both times are undefined, let the C
             * library figure out what to do.  This usually means
@@ -1962,12 +1966,11 @@ Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective)
 I32
 Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
 {
-    key_t key;
-    I32 n, flags;
+    key_t key = (key_t)SvNVx(*++mark);
+    const I32 n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
+    const I32 flags = SvIVx(*++mark);
+    (void)sp;
 
-    key = (key_t)SvNVx(*++mark);
-    n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
-    flags = SvIVx(*++mark);
     SETERRNO(0,0);
     switch (optype)
     {
@@ -1996,12 +1999,13 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
 {
     SV *astr;
     char *a;
-    I32 id, n, cmd, infosize, getinfo;
+    I32 infosize, getinfo;
     I32 ret = -1;
+    const I32 id  = SvIVx(*++mark);
+    const I32 n   = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
+    const I32 cmd = SvIVx(*++mark);
+    (void)sp;
 
-    id = SvIVx(*++mark);
-    n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
-    cmd = SvIVx(*++mark);
     astr = *++mark;
     infosize = 0;
     getinfo = (cmd == IPC_STAT);
@@ -2120,10 +2124,11 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
 #ifdef HAS_MSG
     SV *mstr;
     char *mbuf;
-    I32 id, msize, flags;
+    I32 msize, flags;
     STRLEN len;
+    const I32 id = SvIVx(*++mark);
+    (void)sp;
 
-    id = SvIVx(*++mark);
     mstr = *++mark;
     flags = SvIVx(*++mark);
     mbuf = SvPV(mstr, len);
@@ -2143,10 +2148,11 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     SV *mstr;
     char *mbuf;
     long mtype;
-    I32 id, msize, flags, ret;
+    I32 msize, flags, ret;
     STRLEN len;
+    const I32 id = SvIVx(*++mark);
+    (void)sp;
 
-    id = SvIVx(*++mark);
     mstr = *++mark;
     /* suppress warning when reading into undef var --jhi */
     if (! SvOK(mstr))
@@ -2179,10 +2185,10 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
 #ifdef HAS_SEM
     SV *opstr;
     char *opbuf;
-    I32 id;
     STRLEN opsize;
+    const I32 id = SvIVx(*++mark);
+    (void)sp;
 
-    id = SvIVx(*++mark);
     opstr = *++mark;
     opbuf = SvPV(opstr, opsize);
     if (opsize < 3 * SHORTSIZE
@@ -2193,7 +2199,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
     SETERRNO(0,0);
     /* We can't assume that sizeof(struct sembuf) == 3 * sizeof(short). */
     {
-        int nsops  = opsize / (3 * sizeof (short));
+        const int nsops  = opsize / (3 * sizeof (short));
         int i      = nsops;
         short *ops = (short *) opbuf;
         short *o   = ops;
@@ -2232,11 +2238,12 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 #ifdef HAS_SHM
     SV *mstr;
     char *mbuf, *shm;
-    I32 id, mpos, msize;
+    I32 mpos, msize;
     STRLEN len;
     struct shmid_ds shmds;
+    const I32 id = SvIVx(*++mark);
+    (void)sp;
 
-    id = SvIVx(*++mark);
     mstr = *++mark;
     mpos = SvIVx(*++mark);
     msize = SvIVx(*++mark);
@@ -2300,6 +2307,7 @@ Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up.
 PerlIO *
 Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
 {
+    dVAR;
     SV *tmpcmd = NEWSV(55, 0);
     PerlIO *fp;
     ENTER;