X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=5e649bb9b985582df9eac726b36bf1421d087f09;hb=cf8a192df3df82f50274b83f7996aab39275728a;hp=9d69be5b79ddc5ba0820d848f13bc4f7d68d5007;hpb=c6496cc7fc2c48aca71f04ae322477979e67d744;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 9d69be5..5e649bb 100644
--- 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);