This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl 5.001
[perl5.git] / doio.c
diff --git a/doio.c b/doio.c
index ce0eae3..e8cac8d 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,54 +1,17 @@
-/* $RCSfile: doio.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:42 $
+/*    doio.c
  *
- *    Copyright (c) 1991, Larry Wall
+ *    Copyright (c) 1991-1994, 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.
  *
- * $Log:       doio.c,v $
- * Revision 4.1  92/08/07  17:19:42  lwall
- * Stage 6 Snapshot
- * 
- * Revision 4.0.1.6  92/06/11  21:08:16  lwall
- * patch34: some systems don't declare h_errno extern in header files
- * 
- * Revision 4.0.1.5  92/06/08  13:00:21  lwall
- * patch20: some machines don't define ENOTSOCK in errno.h
- * patch20: new warnings for failed use of stat operators on filenames with \n
- * patch20: wait failed when STDOUT or STDERR reopened to a pipe
- * patch20: end of file latch not reset on reopen of STDIN
- * patch20: seek(HANDLE, 0, 1) went to eof because of ancient Ultrix workaround
- * patch20: fixed memory leak on system() for vfork() machines
- * patch20: get*by* routines now return something useful in a scalar context
- * patch20: h_errno now accessible via $?
- * 
- * Revision 4.0.1.4  91/11/05  16:51:43  lwall
- * patch11: prepared for ctype implementations that don't define isascii()
- * patch11: perl mistook some streams for sockets because they return mode 0 too
- * patch11: reopening STDIN, STDOUT and STDERR failed on some machines
- * patch11: certain perl errors should set EBADF so that $! looks better
- * patch11: truncate on a closed filehandle could dump
- * patch11: stats of _ forgot whether prior stat was actually lstat
- * patch11: -T returned true on NFS directory
- * 
- * Revision 4.0.1.3  91/06/10  01:21:19  lwall
- * patch10: read didn't work from character special files open for writing
- * patch10: close-on-exec wrongly set on system file descriptors
- * 
- * Revision 4.0.1.2  91/06/07  10:53:39  lwall
- * patch4: new copyright notice
- * patch4: system fd's are now treated specially
- * patch4: added $^F variable to specify maximum system fd, default 2
- * patch4: character special files now opened with bidirectional stdio buffers
- * patch4: taintchecks could improperly modify parent in vfork()
- * patch4: many, many itty-bitty portability fixes
- * 
- * Revision 4.0.1.1  91/04/11  17:41:06  lwall
- * patch1: hopefully straightened out some of the Xenix mess
- * 
- * Revision 4.0  91/03/20  01:07:06  lwall
- * 4.0 baseline.
- * 
+ */
+
+/*
+ * "Far below them they saw the white waters pour into a foaming bowl, and
+ * then swirl darkly about a deep oval basin in the rocks, until they found
+ * their way out again through a narrow gate, and flowed away, fuming and
+ * chattering, into calmer and more level reaches."
  */
 
 #include "EXTERN.h"
@@ -64,6 +27,9 @@
 #endif
 #ifdef HAS_SHM
 #include <sys/shm.h>
+# ifndef HAS_SHMAT_PROTOTYPE
+    extern Shmat_t shmat _((int, char *, int));
+# endif
 #endif
 #endif
 
 #endif
 
 bool
-do_open(gv,name,len)
+do_open(gv,name,len,supplied_fp)
 GV *gv;
 register char *name;
 I32 len;
+FILE *supplied_fp;
 {
     FILE *fp;
-    register IO *io = GvIO(gv);
-    char *myname = savestr(name);
+    register IO *io = GvIOn(gv);
+    char *myname = savepv(name);
     int result;
     int fd;
     int writing = 0;
+    int dodup;
     char mode[3];              /* stdio file mode ("r\0" or "r+\0") */
     FILE *saveifp = Nullfp;
     FILE *saveofp = Nullfp;
     char savetype = ' ';
 
+    SAVEFREEPV(myname);
     mode[0] = mode[1] = mode[2] = '\0';
     name = myname;
     forkprocess = 1;           /* assume true if no fork */
     while (len && isSPACE(name[len-1]))
        name[--len] = '\0';
-    if (!io)
-       io = GvIO(gv) = newIO();
-    else if (io->ifp) {
-       fd = fileno(io->ifp);
-       if (io->type == '-')
+    if (IoIFP(io)) {
+       fd = fileno(IoIFP(io));
+       if (IoTYPE(io) == '-')
            result = 0;
        else if (fd <= maxsysfd) {
-           saveifp = io->ifp;
-           saveofp = io->ofp;
-           savetype = io->type;
+           saveifp = IoIFP(io);
+           saveofp = IoOFP(io);
+           savetype = IoTYPE(io);
            result = 0;
        }
-       else if (io->type == '|')
-           result = my_pclose(io->ifp);
-       else if (io->ifp != io->ofp) {
-           if (io->ofp) {
-               result = fclose(io->ofp);
-               fclose(io->ifp);        /* clear stdio, fd already closed */
+       else if (IoTYPE(io) == '|')
+           result = my_pclose(IoIFP(io));
+       else if (IoIFP(io) != IoOFP(io)) {
+           if (IoOFP(io)) {
+               result = fclose(IoOFP(io));
+               fclose(IoIFP(io));      /* clear stdio, fd already closed */
            }
            else
-               result = fclose(io->ifp);
+               result = fclose(IoIFP(io));
        }
        else
-           result = fclose(io->ifp);
+           result = fclose(IoIFP(io));
        if (result == EOF && fd > maxsysfd)
            fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
              GvENAME(gv));
-       io->ofp = io->ifp = Nullfp;
+       IoOFP(io) = IoIFP(io) = Nullfp;
     }
     if (*name == '+' && len > 1 && name[len-1] != '|') {       /* scary */
        mode[1] = *name++;
@@ -137,13 +104,15 @@ I32 len;
     else  {
        mode[1] = '\0';
     }
-    io->type = *name;
+    IoTYPE(io) = *name;
     if (*name == '|') {
        /*SUPPRESS 530*/
        for (name++; isSPACE(*name); name++) ;
        if (strNE(name,"-"))
            TAINT_ENV();
        TAINT_PROPER("piped open");
+       if (dowarn && name[strlen(name)-1] == '|')
+           warn("Can't do bidirectional pipe");
        fp = my_popen(name,"w");
        writing = 1;
     }
@@ -151,7 +120,7 @@ I32 len;
        TAINT_PROPER("open");
        name++;
        if (*name == '>') {
-           mode[0] = io->type = 'a';
+           mode[0] = IoTYPE(io) = 'a';
            name++;
        }
        else
@@ -159,29 +128,42 @@ I32 len;
        writing = 1;
        if (*name == '&') {
          duplicity:
+           dodup = 1;
            name++;
-           while (isSPACE(*name))
+           if (*name == '=') {
+               dodup = 0;
                name++;
-           if (isDIGIT(*name))
-               fd = atoi(name);
+           }
+           if (!*name && supplied_fp)
+               fp = supplied_fp;
            else {
-               gv = gv_fetchpv(name,FALSE);
-               if (!gv || !GvIO(gv)) {
+               while (isSPACE(*name))
+                   name++;
+               if (isDIGIT(*name))
+                   fd = atoi(name);
+               else {
+                   IO* thatio;
+                   gv = gv_fetchpv(name,FALSE,SVt_PVIO);
+                   thatio = GvIO(gv);
+                   if (!thatio) {
 #ifdef EINVAL
-                   errno = EINVAL;
+                       SETERRNO(EINVAL,SS$_IVCHAN);
 #endif
-                   goto say_false;
-               }
-               if (GvIO(gv) && GvIO(gv)->ifp) {
-                   fd = fileno(GvIO(gv)->ifp);
-                   if (GvIO(gv)->type == 's')
-                       io->type = 's';
+                       goto say_false;
+                   }
+                   if (IoIFP(thatio)) {
+                       fd = fileno(IoIFP(thatio));
+                       if (IoTYPE(thatio) == 's')
+                           IoTYPE(io) = 's';
+                   }
+                   else
+                       fd = -1;
                }
-               else
-                   fd = -1;
-           }
-           if (!(fp = fdopen(fd = dup(fd),mode))) {
-               close(fd);
+               if (dodup)
+                   fd = dup(fd);
+               if (!(fp = fdopen(fd,mode)))
+                   if (dodup)
+                       close(fd);
            }
        }
        else {
@@ -189,7 +171,7 @@ I32 len;
                name++;
            if (strEQ(name,"-")) {
                fp = stdout;
-               io->type = '-';
+               IoTYPE(io) = '-';
            }
            else  {
                fp = fopen(name,mode);
@@ -206,7 +188,7 @@ I32 len;
                goto duplicity;
            if (strEQ(name,"-")) {
                fp = stdin;
-               io->type = '-';
+               IoTYPE(io) = '-';
            }
            else
                fp = fopen(name,mode);
@@ -221,35 +203,33 @@ I32 len;
                TAINT_ENV();
            TAINT_PROPER("piped open");
            fp = my_popen(name,"r");
-           io->type = '|';
+           IoTYPE(io) = '|';
        }
        else {
-           io->type = '<';
+           IoTYPE(io) = '<';
            /*SUPPRESS 530*/
            for (; isSPACE(*name); name++) ;
            if (strEQ(name,"-")) {
                fp = stdin;
-               io->type = '-';
+               IoTYPE(io) = '-';
            }
            else
                fp = fopen(name,"r");
        }
     }
     if (!fp) {
-       if (dowarn && io->type == '<' && index(name, '\n'))
+       if (dowarn && IoTYPE(io) == '<' && strchr(name, '\n'))
            warn(warn_nl, "open");
-       Safefree(myname);
        goto say_false;
     }
-    Safefree(myname);
-    if (io->type &&
-      io->type != '|' && io->type != '-') {
-       if (fstat(fileno(fp),&statbuf) < 0) {
+    if (IoTYPE(io) &&
+      IoTYPE(io) != '|' && IoTYPE(io) != '-') {
+       if (Fstat(fileno(fp),&statbuf) < 0) {
            (void)fclose(fp);
            goto say_false;
        }
        if (S_ISSOCK(statbuf.st_mode))
-           io->type = 's';     /* in case a socket was passed in to us */
+           IoTYPE(io) = 's';   /* in case a socket was passed in to us */
 #ifdef HAS_SOCKET
        else if (
 #ifdef S_IFMT
@@ -258,10 +238,10 @@ I32 len;
            !statbuf.st_mode
 #endif
        ) {
-           I32 buflen = sizeof tokenbuf;
-           if (getsockname(fileno(fp), tokenbuf, &buflen) >= 0
+           int buflen = sizeof tokenbuf;
+           if (getsockname(fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
                || errno != ENOTSOCK)
-               io->type = 's'; /* some OS's return 0 on fstat()ed socket */
+               IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
                                /* but some return 0 for streams too, sigh */
        }
 #endif
@@ -282,41 +262,41 @@ I32 len;
 
            dup2(fileno(fp), fd);
            sv = *av_fetch(fdpid,fileno(fp),TRUE);
-           SvUPGRADE(sv, SVt_IV);
-           pid = SvIV(sv);
-           SvIV(sv) = 0;
+           (void)SvUPGRADE(sv, SVt_IV);
+           pid = SvIVX(sv);
+           SvIVX(sv) = 0;
            sv = *av_fetch(fdpid,fd,TRUE);
-           SvUPGRADE(sv, SVt_IV);
-           SvIV(sv) = pid;
+           (void)SvUPGRADE(sv, SVt_IV);
+           SvIVX(sv) = pid;
            fclose(fp);
 
        }
        fp = saveifp;
        clearerr(fp);
     }
-#if defined(HAS_FCNTL) && defined(FFt_SETFD)
+#if defined(HAS_FCNTL) && defined(F_SETFD)
     fd = fileno(fp);
-    fcntl(fd,FFt_SETFD,fd > maxsysfd);
+    fcntl(fd,F_SETFD,fd > maxsysfd);
 #endif
-    io->ifp = fp;
+    IoIFP(io) = fp;
     if (writing) {
-       if (io->type == 's'
-         || (io->type == '>' && S_ISCHR(statbuf.st_mode)) ) {
-           if (!(io->ofp = fdopen(fileno(fp),"w"))) {
+       if (IoTYPE(io) == 's'
+         || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) {
+           if (!(IoOFP(io) = fdopen(fileno(fp),"w"))) {
                fclose(fp);
-               io->ifp = Nullfp;
+               IoIFP(io) = Nullfp;
                goto say_false;
            }
        }
        else
-           io->ofp = fp;
+           IoOFP(io) = fp;
     }
     return TRUE;
 
 say_false:
-    io->ifp = saveifp;
-    io->ofp = saveofp;
-    io->type = savetype;
+    IoIFP(io) = saveifp;
+    IoOFP(io) = saveofp;
+    IoTYPE(io) = savetype;
     return FALSE;
 }
 
@@ -333,9 +313,9 @@ register GV *gv;
     int filegid;
 
     if (!argvoutgv)
-       argvoutgv = gv_fetchpv("ARGVOUT",TRUE);
+       argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
     if (filemode & (S_ISUID|S_ISGID)) {
-       fflush(GvIO(argvoutgv)->ifp);  /* chmod must follow last write */
+       fflush(IoIFP(GvIOn(argvoutgv)));  /* chmod must follow last write */
 #ifdef HAS_FCHMOD
        (void)fchmod(lastfd,filemode);
 #else
@@ -344,17 +324,18 @@ register GV *gv;
     }
     filemode = 0;
     while (av_len(GvAV(gv)) >= 0) {
+       STRLEN len;
        sv = av_shift(GvAV(gv));
+       SAVEFREESV(sv);
        sv_setsv(GvSV(gv),sv);
        SvSETMAGIC(GvSV(gv));
-       oldname = SvPVnx(GvSV(gv));
-       if (do_open(gv,oldname,SvCUR(GvSV(gv)))) {
+       oldname = SvPVx(GvSV(gv), len);
+       if (do_open(gv,oldname,len,Nullfp)) {
            if (inplace) {
                TAINT_PROPER("inplace open");
                if (strEQ(oldname,"-")) {
-                   sv_free(sv);
-                   defoutgv = gv_fetchpv("STDOUT",TRUE);
-                   return GvIO(gv)->ifp;
+                   defoutgv = gv_fetchpv("STDOUT",TRUE,SVt_PVIO);
+                   return IoIFP(GvIOp(gv));
                }
 #ifndef FLEXFILENAMES
                filedev = statbuf.st_dev;
@@ -367,7 +348,6 @@ register GV *gv;
                    warn("Can't do inplace edit: %s is not a regular file",
                      oldname );
                    do_close(gv,FALSE);
-                   sv_free(sv);
                    continue;
                }
                if (*inplace) {
@@ -377,38 +357,35 @@ register GV *gv;
                    sv_catpv(sv,inplace);
 #endif
 #ifndef FLEXFILENAMES
-                   if (stat(SvPV(sv),&statbuf) >= 0
+                   if (Stat(SvPVX(sv),&statbuf) >= 0
                      && statbuf.st_dev == filedev
                      && statbuf.st_ino == fileino ) {
                        warn("Can't do inplace edit: %s > 14 characters",
-                         SvPV(sv) );
+                         SvPVX(sv) );
                        do_close(gv,FALSE);
-                       sv_free(sv);
                        continue;
                    }
 #endif
 #ifdef HAS_RENAME
 #ifndef DOSISH
-                   if (rename(oldname,SvPV(sv)) < 0) {
+                   if (rename(oldname,SvPVX(sv)) < 0) {
                        warn("Can't rename %s to %s: %s, skipping file",
-                         oldname, SvPV(sv), strerror(errno) );
+                         oldname, SvPVX(sv), Strerror(errno) );
                        do_close(gv,FALSE);
-                       sv_free(sv);
                        continue;
                    }
 #else
                    do_close(gv,FALSE);
-                   (void)unlink(SvPV(sv));
-                   (void)rename(oldname,SvPV(sv));
-                   do_open(gv,SvPV(sv),SvCUR(GvSV(gv)));
+                   (void)unlink(SvPVX(sv));
+                   (void)rename(oldname,SvPVX(sv));
+                   do_open(gv,SvPVX(sv),SvCUR(GvSV(gv)),Nullfp);
 #endif /* MSDOS */
 #else
-                   (void)UNLINK(SvPV(sv));
-                   if (link(oldname,SvPV(sv)) < 0) {
+                   (void)UNLINK(SvPVX(sv));
+                   if (link(oldname,SvPVX(sv)) < 0) {
                        warn("Can't rename %s to %s: %s, skipping file",
-                         oldname, SvPV(sv), strerror(errno) );
+                         oldname, SvPVX(sv), Strerror(errno) );
                        do_close(gv,FALSE);
-                       sv_free(sv);
                        continue;
                    }
                    (void)UNLINK(oldname);
@@ -418,29 +395,27 @@ register GV *gv;
 #ifndef DOSISH
                    if (UNLINK(oldname) < 0) {
                        warn("Can't rename %s to %s: %s, skipping file",
-                         oldname, SvPV(sv), strerror(errno) );
+                         oldname, SvPVX(sv), Strerror(errno) );
                        do_close(gv,FALSE);
-                       sv_free(sv);
                        continue;
                    }
 #else
-                   fatal("Can't do inplace edit without backup");
+                   croak("Can't do inplace edit without backup");
 #endif
                }
 
                sv_setpvn(sv,">",1);
                sv_catpv(sv,oldname);
-               errno = 0;              /* in case sprintf set errno */
-               if (!do_open(argvoutgv,SvPV(sv),SvCUR(sv))) {
+               SETERRNO(0,0);          /* in case sprintf set errno */
+               if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),Nullfp)) {
                    warn("Can't do inplace edit on %s: %s",
-                     oldname, strerror(errno) );
+                     oldname, Strerror(errno) );
                    do_close(gv,FALSE);
-                   sv_free(sv);
                    continue;
                }
                defoutgv = argvoutgv;
-               lastfd = fileno(GvIO(argvoutgv)->ifp);
-               (void)fstat(lastfd,&statbuf);
+               lastfd = fileno(IoIFP(GvIOp(argvoutgv)));
+               (void)Fstat(lastfd,&statbuf);
 #ifdef HAS_FCHMOD
                (void)fchmod(lastfd,filemode);
 #else
@@ -456,16 +431,14 @@ register GV *gv;
 #endif
                }
            }
-           sv_free(sv);
-           return GvIO(gv)->ifp;
+           return IoIFP(GvIOp(gv));
        }
        else
-           fprintf(stderr,"Can't open %s: %s\n",SvPVn(sv), strerror(errno));
-       sv_free(sv);
+           fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
     }
     if (inplace) {
        (void)do_close(argvoutgv,FALSE);
-       defoutgv = gv_fetchpv("STDOUT",TRUE);
+       defoutgv = gv_fetchpv("STDOUT",TRUE,SVt_PVIO);
     }
     return Nullfp;
 }
@@ -486,29 +459,25 @@ GV *wgv;
     if (!wgv)
        goto badexit;
 
-    rstio = GvIO(rgv);
-    wstio = GvIO(wgv);
+    rstio = GvIOn(rgv);
+    wstio = GvIOn(wgv);
 
-    if (!rstio)
-       rstio = GvIO(rgv) = newIO();
-    else if (rstio->ifp)
+    if (IoIFP(rstio))
        do_close(rgv,FALSE);
-    if (!wstio)
-       wstio = GvIO(wgv) = newIO();
-    else if (wstio->ifp)
+    if (IoIFP(wstio))
        do_close(wgv,FALSE);
 
     if (pipe(fd) < 0)
        goto badexit;
-    rstio->ifp = fdopen(fd[0], "r");
-    wstio->ofp = fdopen(fd[1], "w");
-    wstio->ifp = wstio->ofp;
-    rstio->type = '<';
-    wstio->type = '>';
-    if (!rstio->ifp || !wstio->ofp) {
-       if (rstio->ifp) fclose(rstio->ifp);
+    IoIFP(rstio) = fdopen(fd[0], "r");
+    IoOFP(wstio) = fdopen(fd[1], "w");
+    IoIFP(wstio) = IoOFP(wstio);
+    IoTYPE(rstio) = '<';
+    IoTYPE(wstio) = '>';
+    if (!IoIFP(rstio) || !IoOFP(wstio)) {
+       if (IoIFP(rstio)) fclose(IoIFP(rstio));
        else close(fd[0]);
-       if (wstio->ofp) fclose(wstio->ofp);
+       if (IoOFP(wstio)) fclose(IoOFP(wstio));
        else close(fd[1]);
        goto badexit;
     }
@@ -523,9 +492,13 @@ badexit:
 #endif
 
 bool
+#ifndef CAN_PROTOTYPE
 do_close(gv,explicit)
 GV *gv;
 bool explicit;
+#else
+do_close(GV *gv, bool explicit)
+#endif /* CAN_PROTOTYPE */
 {
     bool retval = FALSE;
     register IO *io;
@@ -533,8 +506,8 @@ bool explicit;
 
     if (!gv)
        gv = argvgv;
-    if (!gv) {
-       errno = EBADF;
+    if (!gv || SvTYPE(gv) != SVt_PVGV) {
+       SETERRNO(EBADF,SS$_IVCHAN);
        return FALSE;
     }
     io = GvIO(gv);
@@ -543,30 +516,30 @@ bool explicit;
            warn("Close on unopened file <%s>",GvENAME(gv));
        return FALSE;
     }
-    if (io->ifp) {
-       if (io->type == '|') {
-           status = my_pclose(io->ifp);
+    if (IoIFP(io)) {
+       if (IoTYPE(io) == '|') {
+           status = my_pclose(IoIFP(io));
            retval = (status == 0);
-           statusvalue = (unsigned short)status & 0xffff;
+           statusvalue = FIXSTATUS(status);
        }
-       else if (io->type == '-')
+       else if (IoTYPE(io) == '-')
            retval = TRUE;
        else {
-           if (io->ofp && io->ofp != io->ifp) {                /* a socket */
-               retval = (fclose(io->ofp) != EOF);
-               fclose(io->ifp);        /* clear stdio, fd already closed */
+           if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {          /* a socket */
+               retval = (fclose(IoOFP(io)) != EOF);
+               fclose(IoIFP(io));      /* clear stdio, fd already closed */
            }
            else
-               retval = (fclose(io->ifp) != EOF);
+               retval = (fclose(IoIFP(io)) != EOF);
        }
-       io->ofp = io->ifp = Nullfp;
+       IoOFP(io) = IoIFP(io) = Nullfp;
     }
     if (explicit) {
-       io->lines = 0;
-       io->page = 0;
-       io->lines_left = io->page_len;
+       IoLINES(io) = 0;
+       IoPAGE(io) = 0;
+       IoLINES_LEFT(io) = IoPAGE_LEN(io);
     }
-    io->type = ' ';
+    IoTYPE(io) = ' ';
     return retval;
 }
 
@@ -582,23 +555,23 @@ GV *gv;
     if (!io)
        return TRUE;
 
-    while (io->ifp) {
+    while (IoIFP(io)) {
 
-#ifdef STDSTDIO                        /* (the code works without this) */
-       if (io->ifp->_cnt > 0)  /* cheat a little, since */
+#ifdef USE_STD_STDIO                   /* (the code works without this) */
+       if (IoIFP(io)->_cnt > 0)        /* cheat a little, since */
            return FALSE;               /* this is the most usual case */
 #endif
 
-       ch = getc(io->ifp);
+       ch = getc(IoIFP(io));
        if (ch != EOF) {
-           (void)ungetc(ch, io->ifp);
+           (void)ungetc(ch, IoIFP(io));
            return FALSE;
        }
-#ifdef STDSTDIO
-       if (io->ifp->_cnt < -1)
-           io->ifp->_cnt = -1;
+#ifdef USE_STD_STDIO
+       if (IoIFP(io)->_cnt < -1)
+           IoIFP(io)->_cnt = -1;
 #endif
-       if (gv == argvgv) {             /* not necessarily a real EOF yet? */
+       if (op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
            if (!nextargv(argvgv))      /* get another fp handy */
                return TRUE;
        }
@@ -618,20 +591,20 @@ GV *gv;
        goto phooey;
 
     io = GvIO(gv);
-    if (!io || !io->ifp)
+    if (!io || !IoIFP(io))
        goto phooey;
 
 #ifdef ULTRIX_STDIO_BOTCH
-    if (feof(io->ifp))
-       (void)fseek (io->ifp, 0L, 2);           /* ultrix 1.2 workaround */
+    if (feof(IoIFP(io)))
+       (void)fseek (IoIFP(io), 0L, 2);         /* ultrix 1.2 workaround */
 #endif
 
-    return ftell(io->ifp);
+    return ftell(IoIFP(io));
 
 phooey:
     if (dowarn)
        warn("tell() on unopened file");
-    errno = EBADF;
+    SETERRNO(EBADF,RMS$_IFI);
     return -1L;
 }
 
@@ -647,108 +620,36 @@ int whence;
        goto nuts;
 
     io = GvIO(gv);
-    if (!io || !io->ifp)
+    if (!io || !IoIFP(io))
        goto nuts;
 
 #ifdef ULTRIX_STDIO_BOTCH
-    if (feof(io->ifp))
-       (void)fseek (io->ifp, 0L, 2);           /* ultrix 1.2 workaround */
+    if (feof(IoIFP(io)))
+       (void)fseek (IoIFP(io), 0L, 2);         /* ultrix 1.2 workaround */
 #endif
 
-    return fseek(io->ifp, pos, whence) >= 0;
+    return fseek(IoIFP(io), pos, whence) >= 0;
 
 nuts:
     if (dowarn)
        warn("seek() on unopened file");
-    errno = EBADF;
+    SETERRNO(EBADF,RMS$_IFI);
     return FALSE;
 }
 
-I32
-do_ctl(optype,gv,func,argstr)
-I32 optype;
-GV *gv;
-I32 func;
-SV *argstr;
-{
-    register IO *io;
-    register char *s;
-    I32 retval;
-
-    if (!gv || !argstr || !(io = GvIO(gv)) || !io->ifp) {
-       errno = EBADF;  /* well, sort of... */
-       return -1;
-    }
-
-    if (SvPOK(argstr) || !SvNIOK(argstr)) {
-       if (!SvPOK(argstr))
-           s = SvPVn(argstr);
-
-#ifdef IOCPARM_MASK
-#ifndef IOCPARM_LEN
-#define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
-#endif
-#endif
-#ifdef IOCPARM_LEN
-       retval = IOCPARM_LEN(func);     /* on BSDish systes we're safe */
-#else
-       retval = 256;                   /* otherwise guess at what's safe */
-#endif
-       if (SvCUR(argstr) < retval) {
-           Sv_Grow(argstr,retval+1);
-           SvCUR_set(argstr, retval);
-       }
-
-       s = SvPV(argstr);
-       s[SvCUR(argstr)] = 17;  /* a little sanity check here */
-    }
-    else {
-       retval = SvIVn(argstr);
-#ifdef DOSISH
-       s = (char*)(long)retval;                /* ouch */
-#else
-       s = (char*)retval;              /* ouch */
-#endif
-    }
-
-#ifndef lint
-    if (optype == OP_IOCTL)
-       retval = ioctl(fileno(io->ifp), func, s);
-    else
-#ifdef DOSISH
-       fatal("fcntl is not implemented");
-#else
-#ifdef HAS_FCNTL
-       retval = fcntl(fileno(io->ifp), func, s);
-#else
-       fatal("fcntl is not implemented");
-#endif
-#endif
-#else /* lint */
-    retval = 0;
-#endif /* lint */
-
-    if (SvPOK(argstr)) {
-       if (s[SvCUR(argstr)] != 17)
-           fatal("Return value overflowed string");
-       s[SvCUR(argstr)] = 0;           /* put our null back */
-    }
-    return retval;
-}
-
-#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(FFt_FREESP)
+#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
        /* code courtesy of William Kucharski */
 #define HAS_CHSIZE
 
 I32 chsize(fd, length)
 I32 fd;                        /* file descriptor */
-off_t length;          /* length to set file to */
+Off_t length;          /* length to set file to */
 {
     extern long lseek();
     struct flock fl;
     struct stat filebuf;
 
-    if (fstat(fd, &filebuf) < 0)
+    if (Fstat(fd, &filebuf) < 0)
        return -1;
 
     if (filebuf.st_size < length) {
@@ -769,24 +670,24 @@ off_t length;             /* length to set file to */
        fl.l_whence = 0;
        fl.l_len = 0;
        fl.l_start = length;
-       fl.l_type = FFt_WRLCK;    /* write lock on file space */
+       fl.l_type = F_WRLCK;    /* write lock on file space */
 
        /*
-       * This relies on the UNDOCUMENTED FFt_FREESP argument to
+       * This relies on the UNDOCUMENTED F_FREESP argument to
        * fcntl(2), which truncates the file so that it ends at the
        * position indicated by fl.l_start.
        *
        * Will minor miracles never cease?
        */
 
-       if (fcntl(fd, FFt_FREESP, &fl) < 0)
+       if (fcntl(fd, F_FREESP, &fl) < 0)
            return -1;
 
     }
 
     return 0;
 }
-#endif /* FFt_FREESP */
+#endif /* F_FREESP */
 
 I32
 looks_like_number(sv)
@@ -795,10 +696,17 @@ SV *sv;
     register char *s;
     register char *send;
 
-    if (!SvPOK(sv))
-       return TRUE;
-    s = SvPV(sv); 
-    send = s + SvCUR(sv);
+    if (!SvPOK(sv)) {
+       STRLEN len;
+       if (!SvPOKp(sv))
+           return TRUE;
+       s = SvPV(sv, len);
+       send = s + len;
+    }
+    else {
+       s = SvPVX(sv); 
+       send = s + SvCUR(sv);
+    }
     while (isSPACE(*s))
        s++;
     if (s >= send)
@@ -811,7 +719,7 @@ SV *sv;
        return TRUE;
     if (*s == '.') 
        s++;
-    else if (s == SvPV(sv))
+    else if (s == SvPVX(sv))
        return FALSE;
     while (isDIGIT(*s))
        s++;
@@ -837,40 +745,42 @@ register SV *sv;
 FILE *fp;
 {
     register char *tmps;
-    SV* tmpstr;
+    STRLEN len;
 
     /* assuming fp is checked earlier */
     if (!sv)
        return TRUE;
     if (ofmt) {
-       if (SvMAGICAL(sv))
+       if (SvGMAGICAL(sv))
            mg_get(sv);
-        if (SvIOK(sv) && SvIV(sv) != 0) {
-           fprintf(fp, ofmt, (double)SvIV(sv));
+        if (SvIOK(sv) && SvIVX(sv) != 0) {
+           fprintf(fp, ofmt, (double)SvIVX(sv));
            return !ferror(fp);
        }
-       if (  (SvNOK(sv) && SvNV(sv) != 0.0)
+       if (  (SvNOK(sv) && SvNVX(sv) != 0.0)
           || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) {
-           fprintf(fp, ofmt, SvNV(sv));
+           fprintf(fp, ofmt, SvNVX(sv));
            return !ferror(fp);
        }
     }
     switch (SvTYPE(sv)) {
     case SVt_NULL:
+       if (dowarn)
+           warn(warn_uninit);
        return TRUE;
-    case SVt_REF:
-       fprintf(fp, "%s", sv_2pv(sv));
-       return !ferror(fp);
     case SVt_IV:
-       if (SvMAGICAL(sv))
-           mg_get(sv);
-       fprintf(fp, "%d", SvIV(sv));
-       return !ferror(fp);
+       if (SvIOK(sv)) {
+           if (SvGMAGICAL(sv))
+               mg_get(sv);
+           fprintf(fp, "%ld", (long)SvIVX(sv));
+           return !ferror(fp);
+       }
+       /* FALL THROUGH */
     default:
-       tmps = SvPVn(sv);
+       tmps = SvPV(sv, len);
        break;
     }
-    if (SvCUR(sv) && (fwrite(tmps,1,SvCUR(sv),fp) == 0 || ferror(fp)))
+    if (len && (fwrite1(tmps,1,len,fp) == 0 || ferror(fp)))
        return FALSE;
     return TRUE;
 }
@@ -881,35 +791,47 @@ dARGS
 {
     dSP;
     IO *io;
+    GV* tmpgv;
 
-    if (op->op_flags & OPf_SPECIAL) {
+    if (op->op_flags & OPf_REF) {
        EXTEND(sp,1);
-       io = GvIO(cGVOP->op_gv);
-       if (io && io->ifp) {
-           statgv = cGVOP->op_gv;
+       tmpgv = cGVOP->op_gv;
+      do_fstat:
+       io = GvIO(tmpgv);
+       if (io && IoIFP(io)) {
+           statgv = tmpgv;
            sv_setpv(statname,"");
            laststype = OP_STAT;
-           return (laststatval = fstat(fileno(io->ifp), &statcache));
+           return (laststatval = Fstat(fileno(IoIFP(io)), &statcache));
        }
        else {
-           if (cGVOP->op_gv == defgv)
+           if (tmpgv == defgv)
                return laststatval;
            if (dowarn)
                warn("Stat on unopened file <%s>",
-                 GvENAME(cGVOP->op_gv));
+                 GvENAME(tmpgv));
            statgv = Nullgv;
            sv_setpv(statname,"");
            return (laststatval = -1);
        }
     }
     else {
-       dPOPss;
+       SV* sv = POPs;
        PUTBACK;
+       if (SvTYPE(sv) == SVt_PVGV) {
+           tmpgv = (GV*)sv;
+           goto do_fstat;
+       }
+       else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+           tmpgv = (GV*)SvRV(sv);
+           goto do_fstat;
+       }
+
        statgv = Nullgv;
-       sv_setpv(statname,SvPVn(sv));
+       sv_setpv(statname,SvPV(sv, na));
        laststype = OP_STAT;
-       laststatval = stat(SvPVn(sv),&statcache);
-       if (laststatval < 0 && dowarn && index(SvPVn(sv), '\n'))
+       laststatval = Stat(SvPV(sv, na),&statcache);
+       if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
            warn(warn_nl, "stat");
        return laststatval;
     }
@@ -921,27 +843,27 @@ dARGS
 {
     dSP;
     SV *sv;
-    if (op->op_flags & OPf_SPECIAL) {
+    if (op->op_flags & OPf_REF) {
        EXTEND(sp,1);
        if (cGVOP->op_gv == defgv) {
            if (laststype != OP_LSTAT)
-               fatal("The stat preceding -l _ wasn't an lstat");
+               croak("The stat preceding -l _ wasn't an lstat");
            return laststatval;
        }
-       fatal("You can't use -l on a filehandle");
+       croak("You can't use -l on a filehandle");
     }
 
     laststype = OP_LSTAT;
     statgv = Nullgv;
     sv = POPs;
     PUTBACK;
-    sv_setpv(statname,SvPVn(sv));
+    sv_setpv(statname,SvPV(sv, na));
 #ifdef HAS_LSTAT
-    laststatval = lstat(SvPVn(sv),&statcache);
+    laststatval = lstat(SvPV(sv, na),&statcache);
 #else
-    laststatval = stat(SvPVn(sv),&statcache);
+    laststatval = Stat(SvPV(sv, na),&statcache);
 #endif
-    if (laststatval < 0 && dowarn && index(SvPVn(sv), '\n'))
+    if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
        warn(warn_nl, "lstat");
     return laststatval;
 }
@@ -960,17 +882,19 @@ register SV **sp;
        a = Argv;
        while (++mark <= sp) {
            if (*mark)
-               *a++ = SvPVnx(*mark);
+               *a++ = SvPVx(*mark, na);
            else
                *a++ = "";
        }
        *a = Nullch;
        if (*Argv[0] != '/')    /* will execvp use PATH? */
            TAINT_ENV();                /* testing IFS here is overkill, probably */
-       if (really && *(tmps = SvPVn(really)))
+       if (really && *(tmps = SvPV(really, na)))
            execvp(tmps,Argv);
        else
            execvp(Argv[0],Argv);
+       if (dowarn)
+           warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
     }
     do_execfree();
     return FALSE;
@@ -997,6 +921,9 @@ char *cmd;
     register char *s;
     char flags[10];
 
+    while (*cmd && isSPACE(*cmd))
+       cmd++;
+
     /* save an extra exec if possible */
 
 #ifdef CSH
@@ -1028,12 +955,18 @@ char *cmd;
 
     /* see if there are shell metacharacters in it */
 
-    /*SUPPRESS 530*/
+    if (*cmd == '.' && isSPACE(cmd[1]))
+       goto doshell;
+
+    if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
+       goto doshell;
+
     for (s = cmd; *s && isALPHA(*s); s++) ;    /* catch VAR=val gizmo */
     if (*s == '=')
        goto doshell;
+
     for (s = cmd; *s; s++) {
-       if (*s != ' ' && !isALPHA(*s) && index("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+       if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
            if (*s == '\n' && !s[1]) {
                *s = '\0';
                break;
@@ -1043,8 +976,9 @@ char *cmd;
            return FALSE;
        }
     }
+
     New(402,Argv, (s - cmd) / 2 + 2, char*);
-    Cmd = nsavestr(cmd, s-cmd);
+    Cmd = savepvn(cmd, s-cmd);
     a = Argv;
     for (s = Cmd; *s;) {
        while (*s && isSPACE(*s)) s++;
@@ -1061,6 +995,8 @@ char *cmd;
            do_execfree();
            goto doshell;
        }
+       if (dowarn)
+           warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
     }
     do_execfree();
     return FALSE;
@@ -1078,19 +1014,22 @@ register SV **sp;
     char *s;
     SV **oldmark = mark;
 
-#ifdef TAINT
-    while (++mark <= sp)
-       TAINT_IF((*mark)->sv_tainted);
-    mark = oldmark;
-#endif
+    if (tainting) {
+       while (++mark <= sp) {
+           MAGIC *mg;
+           if (SvMAGICAL(*mark) && (mg = mg_find(*mark, 't')) && mg->mg_len & 1)
+               tainted = TRUE;
+       }
+       mark = oldmark;
+    }
     switch (type) {
     case OP_CHMOD:
        TAINT_PROPER("chmod");
        if (++mark <= sp) {
            tot = sp - mark;
-           val = SvIVnx(*mark);
+           val = SvIVx(*mark);
            while (++mark <= sp) {
-               if (chmod(SvPVnx(*mark),val))
+               if (chmod(SvPVx(*mark, na),val))
                    tot--;
            }
        }
@@ -1099,11 +1038,11 @@ register SV **sp;
     case OP_CHOWN:
        TAINT_PROPER("chown");
        if (sp - mark > 2) {
+           val = SvIVx(*++mark);
+           val2 = SvIVx(*++mark);
            tot = sp - mark;
-           val = SvIVnx(*++mark);
-           val2 = SvIVnx(*++mark);
            while (++mark <= sp) {
-               if (chown(SvPVnx(*mark),val,val2))
+               if (chown(SvPVx(*mark, na),val,val2))
                    tot--;
            }
        }
@@ -1112,20 +1051,20 @@ register SV **sp;
 #ifdef HAS_KILL
     case OP_KILL:
        TAINT_PROPER("kill");
-       s = SvPVnx(*++mark);
+       s = SvPVx(*++mark, na);
        tot = sp - mark;
        if (isUPPER(*s)) {
            if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
                s += 3;
            if (!(val = whichsig(s)))
-               fatal("Unrecognized signal name \"%s\"",s);
+               croak("Unrecognized signal name \"%s\"",s);
        }
        else
-           val = SvIVnx(*mark);
+           val = SvIVx(*mark);
        if (val < 0) {
            val = -val;
            while (++mark <= sp) {
-               I32 proc = SvIVnx(*mark);
+               I32 proc = SvIVx(*mark);
 #ifdef HAS_KILLPG
                if (killpg(proc,val))   /* BSD */
 #else
@@ -1136,7 +1075,7 @@ register SV **sp;
        }
        else {
            while (++mark <= sp) {
-               if (kill(SvIVnx(*mark),val))
+               if (kill(SvIVx(*mark),val))
                    tot--;
            }
        }
@@ -1146,7 +1085,7 @@ register SV **sp;
        TAINT_PROPER("unlink");
        tot = sp - mark;
        while (++mark <= sp) {
-           s = SvPVnx(*mark);
+           s = SvPVx(*mark, na);
            if (euid || unsafe) {
                if (UNLINK(s))
                    tot--;
@@ -1155,7 +1094,7 @@ register SV **sp;
 #ifdef HAS_LSTAT
                if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
 #else
-               if (stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
+               if (Stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
 #endif
                    tot--;
                else {
@@ -1165,10 +1104,11 @@ register SV **sp;
            }
        }
        break;
+#ifdef HAS_UTIME
     case OP_UTIME:
        TAINT_PROPER("utime");
        if (sp - mark > 2) {
-#ifdef I_UTIME
+#if defined(I_UTIME) || defined(VMS)
            struct utimbuf utbuf;
 #else
            struct {
@@ -1178,23 +1118,24 @@ register SV **sp;
 #endif
 
            Zero(&utbuf, sizeof utbuf, char);
-           utbuf.actime = SvIVnx(*++mark);    /* time accessed */
-           utbuf.modtime = SvIVnx(*++mark);    /* time modified */
+           utbuf.actime = SvIVx(*++mark);    /* time accessed */
+           utbuf.modtime = SvIVx(*++mark);    /* time modified */
            tot = sp - mark;
            while (++mark <= sp) {
-               if (utime(SvPVnx(*mark),&utbuf))
+               if (utime(SvPVx(*mark, na),&utbuf))
                    tot--;
            }
        }
        else
            tot = 0;
        break;
+#endif
     }
     return tot;
 }
 
 /* Do the permissions allow some operation?  Assumes statcache already set. */
-
+#ifndef VMS /* VMS' cando is in vms.c */
 I32
 cando(bit, effective, statbufp)
 I32 bit;
@@ -1248,6 +1189,7 @@ register struct stat *statbufp;
     return FALSE;
 #endif /* ! MSDOS */
 }
+#endif /* ! VMS */
 
 I32
 ingroup(testgid,effective)
@@ -1261,7 +1203,7 @@ I32 effective;
 #define NGROUPS 32
 #endif
     {
-       GROUPSTYPE gary[NGROUPS];
+       Groups_t gary[NGROUPS];
        I32 anum;
 
        anum = getgroups(NGROUPS,gary);
@@ -1284,10 +1226,10 @@ SV **sp;
     key_t key;
     I32 n, flags;
 
-    key = (key_t)SvNVnx(*++mark);
-    n = (optype == OP_MSGGET) ? 0 : SvIVnx(*++mark);
-    flags = SvIVnx(*++mark);
-    errno = 0;
+    key = (key_t)SvNVx(*++mark);
+    n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
+    flags = SvIVx(*++mark);
+    SETERRNO(0,0);
     switch (optype)
     {
 #ifdef HAS_MSG
@@ -1304,7 +1246,7 @@ SV **sp;
 #endif
 #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
     default:
-       fatal("%s not implemented", op_name[optype]);
+       croak("%s not implemented", op_name[optype]);
 #endif
     }
     return -1;                 /* should never happen */
@@ -1318,11 +1260,12 @@ SV **sp;
 {
     SV *astr;
     char *a;
-    I32 id, n, cmd, infosize, getinfo, ret;
+    I32 id, n, cmd, infosize, getinfo;
+    I32 ret = -1;
 
-    id = SvIVnx(*++mark);
-    n = (optype == OP_SEMCTL) ? SvIVnx(*++mark) : 0;
-    cmd = SvIVnx(*++mark);
+    id = SvIVx(*++mark);
+    n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
+    cmd = SvIVx(*++mark);
     astr = *++mark;
     infosize = 0;
     getinfo = (cmd == IPC_STAT);
@@ -1359,33 +1302,32 @@ SV **sp;
 #endif
 #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
     default:
-       fatal("%s not implemented", op_name[optype]);
+       croak("%s not implemented", op_name[optype]);
 #endif
     }
 
     if (infosize)
     {
+       STRLEN len;
        if (getinfo)
        {
-           SvGROW(astr, infosize+1);
-           a = SvPVn(astr);
+           SvPV_force(astr, len);
+           a = SvGROW(astr, infosize+1);
        }
        else
        {
-           a = SvPVn(astr);
-           if (SvCUR(astr) != infosize)
-           {
-               errno = EINVAL;
-               return -1;
-           }
+           a = SvPV(astr, len);
+           if (len != infosize)
+               croak("Bad arg length for %s, is %d, should be %d",
+                       op_name[optype], len, infosize);
        }
     }
     else
     {
-       I32 i = SvIVn(astr);
+       I32 i = SvIV(astr);
        a = (char *)i;          /* ouch */
     }
-    errno = 0;
+    SETERRNO(0,0);
     switch (optype)
     {
 #ifdef HAS_MSG
@@ -1407,6 +1349,7 @@ SV **sp;
     if (getinfo && ret >= 0) {
        SvCUR_set(astr, infosize);
        *SvEND(astr) = '\0';
+       SvSETMAGIC(astr);
     }
     return ret;
 }
@@ -1420,19 +1363,18 @@ SV **sp;
     SV *mstr;
     char *mbuf;
     I32 id, msize, flags;
+    STRLEN len;
 
-    id = SvIVnx(*++mark);
+    id = SvIVx(*++mark);
     mstr = *++mark;
-    flags = SvIVnx(*++mark);
-    mbuf = SvPVn(mstr);
-    if ((msize = SvCUR(mstr) - sizeof(long)) < 0) {
-       errno = EINVAL;
-       return -1;
-    }
-    errno = 0;
+    flags = SvIVx(*++mark);
+    mbuf = SvPV(mstr, len);
+    if ((msize = len - sizeof(long)) < 0)
+       croak("Arg too short for msgsnd");
+    SETERRNO(0,0);
     return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
 #else
-    fatal("msgsnd not implemented");
+    croak("msgsnd not implemented");
 #endif
 }
 
@@ -1446,18 +1388,23 @@ SV **sp;
     char *mbuf;
     long mtype;
     I32 id, msize, flags, ret;
+    STRLEN len;
 
-    id = SvIVnx(*++mark);
+    id = SvIVx(*++mark);
     mstr = *++mark;
-    msize = SvIVnx(*++mark);
-    mtype = (long)SvIVnx(*++mark);
-    flags = SvIVnx(*++mark);
-    mbuf = SvPVn(mstr);
-    if (SvCUR(mstr) < sizeof(long)+msize+1) {
-       SvGROW(mstr, sizeof(long)+msize+1);
-       mbuf = SvPVn(mstr);
+    msize = SvIVx(*++mark);
+    mtype = (long)SvIVx(*++mark);
+    flags = SvIVx(*++mark);
+    if (SvTHINKFIRST(mstr)) {
+       if (SvREADONLY(mstr))
+           croak("Can't msgrcv to readonly var");
+       if (SvROK(mstr))
+           sv_unref(mstr);
     }
-    errno = 0;
+    SvPV_force(mstr, len);
+    mbuf = SvGROW(mstr, sizeof(long)+msize+1);
+    
+    SETERRNO(0,0);
     ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
     if (ret >= 0) {
        SvCUR_set(mstr, sizeof(long)+ret);
@@ -1465,7 +1412,7 @@ SV **sp;
     }
     return ret;
 #else
-    fatal("msgrcv not implemented");
+    croak("msgrcv not implemented");
 #endif
 }
 
@@ -1477,21 +1424,21 @@ SV **sp;
 #ifdef HAS_SEM
     SV *opstr;
     char *opbuf;
-    I32 id, opsize;
+    I32 id;
+    STRLEN opsize;
 
-    id = SvIVnx(*++mark);
+    id = SvIVx(*++mark);
     opstr = *++mark;
-    opbuf = SvPVn(opstr);
-    opsize = SvCUR(opstr);
+    opbuf = SvPV(opstr, opsize);
     if (opsize < sizeof(struct sembuf)
        || (opsize % sizeof(struct sembuf)) != 0) {
-       errno = EINVAL;
+       SETERRNO(EINVAL,LIB$_INVARG);
        return -1;
     }
-    errno = 0;
+    SETERRNO(0,0);
     return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
 #else
-    fatal("semop not implemented");
+    croak("semop not implemented");
 #endif
 }
 
@@ -1505,39 +1452,37 @@ SV **sp;
     SV *mstr;
     char *mbuf, *shm;
     I32 id, mpos, msize;
+    STRLEN len;
     struct shmid_ds shmds;
-#ifndef VOIDSHMAT
-    extern char *shmat();
-#endif
 
-    id = SvIVnx(*++mark);
+    id = SvIVx(*++mark);
     mstr = *++mark;
-    mpos = SvIVnx(*++mark);
-    msize = SvIVnx(*++mark);
-    errno = 0;
+    mpos = SvIVx(*++mark);
+    msize = SvIVx(*++mark);
+    SETERRNO(0,0);
     if (shmctl(id, IPC_STAT, &shmds) == -1)
        return -1;
     if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
-       errno = EFAULT;         /* can't do as caller requested */
+       SETERRNO(EFAULT,SS$_ACCVIO);            /* can't do as caller requested */
        return -1;
     }
-    shm = (char*)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
+    shm = (Shmat_t)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
     if (shm == (char *)-1)     /* I hate System V IPC, I really do */
        return -1;
-    mbuf = SvPVn(mstr);
     if (optype == OP_SHMREAD) {
-       if (SvCUR(mstr) < msize) {
-           SvGROW(mstr, msize+1);
-           mbuf = SvPVn(mstr);
-       }
+       SvPV_force(mstr, len);
+       mbuf = SvGROW(mstr, msize+1);
+
        Copy(shm + mpos, mbuf, msize, char);
        SvCUR_set(mstr, msize);
        *SvEND(mstr) = '\0';
+       SvSETMAGIC(mstr);
     }
     else {
        I32 n;
 
-       if ((n = SvCUR(mstr)) > msize)
+       mbuf = SvPV(mstr, len);
+       if ((n = len) > msize)
            n = msize;
        Copy(mbuf, shm + mpos, n, char);
        if (n < msize)
@@ -1545,7 +1490,7 @@ SV **sp;
     }
     return shmdt(shm);
 #else
-    fatal("shm I/O not implemented");
+    croak("shm I/O not implemented");
 #endif
 }