Change run to runops

[p5sagit/p5-mst-13.2.git] / mg.c

diff --git a/mg.c b/mg.c
index 9d69be5..5e649bb 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -332,6 +332,25 @@ MAGIC *mg;
     case '\004':               /* ^D */
        sv_setiv(sv,(I32)(debug & 32767));
        break;
+    case '\005':  /* ^E */
+#ifdef VMS
+       {
+#          include <descrip.h>
+#          include <starlet.h>
+           char msg[255];
+           $DESCRIPTOR(msgdsc,msg);
+           sv_setnv(sv,(double)vaxc$errno);
+           if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
+               sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
+           else
+               sv_setpv(sv,"");
+       }
+#else
+       sv_setnv(sv,(double)errno);
+       sv_setpv(sv, errno ? Strerror(errno) : "");
+#endif
+       SvNOK_on(sv);   /* what a wonderful hack! */
+       break;
     case '\006':               /* ^F */
        sv_setiv(sv,(I32)maxsysfd);
        break;
@@ -344,6 +363,9 @@ MAGIC *mg;
        else
            sv_setsv(sv,&sv_undef);
        break;
+    case '\017':               /* ^O */
+       sv_setpv(sv,osname);
+       break;
     case '\020':               /* ^P */
        sv_setiv(sv,(I32)perldb);
        break;
@@ -461,7 +483,11 @@ MAGIC *mg;
        sv_setpv(sv,ofmt);
        break;
     case '!':
+#ifdef VMS
+       sv_setnv(sv,(double)((errno == EVMSERR) ? vaxc$errno : errno));
+#else
        sv_setnv(sv,(double)errno);
+#endif
        sv_setpv(sv, errno ? Strerror(errno) : "");
        SvNOK_on(sv);   /* what a wonderful hack! */
        break;
@@ -1040,6 +1066,13 @@ MAGIC* mg;
        debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
        DEBUG_x(dump_all());
        break;
+    case '\005':  /* ^E */
+#ifdef VMS
+       set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+#else
+       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4);         /* will anyone ever use this? */
+#endif
+       break;
     case '\006':       /* ^F */
        maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
        break;
@@ -1054,6 +1087,14 @@ MAGIC* mg;
        else
            inplace = Nullch;
        break;
+    case '\017':       /* ^O */
+       if (osname)
+           Safefree(osname);
+       if (SvOK(sv))
+           osname = savepv(SvPV(sv,na));
+       else
+           osname = Nullch;
+       break;
     case '\020':       /* ^P */
        i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
        if (i != perldb) {
@@ -1137,7 +1178,7 @@ MAGIC* mg;
        statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
        break;
     case '!':
-       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SS$_ABORT);         /* will anyone ever use this? */
+       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SvIV(sv) == EVMSERR ? 4 : vaxc$errno);              /* will anyone ever use this? */
        break;
     case '<':
        uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);