yfix fix for VMS (was YYDEBUG etc.)

From: "Craig A. Berry" <craig.berry@SignalTreeSolutions.com>
Message-Id: <5.1.0.14.2.20020325135745.01aeabc0@exchi01>

p4raw-id: //depot/perl@15506

diff --git a/perl.c b/perl.c
index 3c2861f..84ef3af 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2288,7 +2288,7 @@ Perl_moreswitches(pTHX_ char *s)
            PL_debug = atoi(s+1);
            for (s++; isDIGIT(*s); s++) ;
        }
-#if defined(EBCDIC) || defined(VMS)
+#ifdef EBCDIC
        if (DEBUG_p_TEST_ && ckWARN_d(WARN_DEBUGGING))
            Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
                    "-Dp not implemented on this platform\n");

diff --git a/perly.c b/perly.c
index 0c5b80a..9fd86d3 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -6,7 +6,7 @@
 #include "EXTERN.h"
 #define PERL_IN_PERLY_C
 #include "perl.h"
-#if defined(EBCDIC) || defined(VMS)
+#ifdef EBCDIC
 #undef YYDEBUG
 #endif
 #define dep() deprecate_old("\"do\" to call subroutines")

diff --git a/perly.y b/perly.y
index 6b7df9b..48049eb 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -16,7 +16,7 @@
 #include "EXTERN.h"
 #define PERL_IN_PERLY_C
 #include "perl.h"
-#if defined(EBCDIC) || defined(VMS)
+#ifdef EBCDIC
 #undef YYDEBUG
 #endif
 #define dep() deprecate("\"do\" to call subroutines")

diff --git a/perly_c.diff b/perly_c.diff
index 5fac710..c0db93a 100644 (file)
--- a/perly_c.diff
+++ b/perly_c.diff
@@ -1,5 +1,5 @@
-*** perly.c.orig       ma 25 maalis 17.32.52 2002
---- perly.c    ma 25 maalis 17.32.53 2002
+*** perly.c.orig       Tue Mar 26 01:38:52 2002
+--- perly.c    Tue Mar 26 01:38:54 2002
 ***************
 *** 1,5 ****
   #ifndef lint
@@ -15,7 +15,7 @@
   #line 16 "perly.y"
 ***************
 *** 9,15 ****
-  #if defined(EBCDIC) || defined(VMS)
+  #ifdef EBCDIC
   #undef YYDEBUG
   #endif
 ! #define dep() deprecate("\"do\" to call subroutines")
@@ -23,7 +23,7 @@
   /* stuff included here to make perly_c.diff apply better */
   
 --- 9,15 ----
-  #if defined(EBCDIC) || defined(VMS)
+  #ifdef EBCDIC
   #undef YYDEBUG
   #endif
 ! #define dep() deprecate_old("\"do\" to call subroutines")

diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index 634dba9..90726fe 100644 (file)
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -7,7 +7,7 @@
 #include "EXTERN.h"
 #define PERL_IN_PERLY_C
 #include "perl.h"
-#if defined(EBCDIC) || defined(VMS)
+#ifdef EBCDIC
 #undef YYDEBUG
 #endif
 #define dep() deprecate_old("\"do\" to call subroutines")
@@ -1438,13 +1438,21 @@ yyparse()
     ysave->oldyylval   = yylval;
 
 #if YYDEBUG
+  {
+    register int saved_errno = errno;
+#ifdef VMS
+    register int saved_vaxc_errno = vaxc$errno;
+#else
+    register int saved_vaxc_errno = 0;
+#endif
     if ((yys = getenv("YYDEBUG")))
     {
         yyn = *yys;
         if (yyn >= '0' && yyn <= '9')
             yydebug = yyn - '0';
     }
-       else SETERRNO(0,SS$_NORMAL);
+    else SETERRNO(saved_errno,saved_vaxc_errno);
+  }
 #endif
 
     yynerrs = 0;

diff --git a/vms/vms_yfix.pl b/vms/vms_yfix.pl
index fbeb039..37fefad 100644 (file)
--- a/vms/vms_yfix.pl
+++ b/vms/vms_yfix.pl
@@ -28,9 +28,12 @@ while (<C>) {
     $_ = "#   ifndef getenv\n$_#   endif\n";
   }
   elsif ( /getenv\("YYDEBUG"\)/ ) {
+    $_ = "  {\n    register int saved_errno = errno;\n"
+       . "#ifdef VMS\n    register int saved_vaxc_errno = vaxc\$errno;\n"
+       . "#else\n    register int saved_vaxc_errno = 0;\n#endif\n" . $_;
     # Reset the "error" status if an optional lookup fails
     while (not /^\s+\}/) { print COUT; $_ = <C>; }
-    $_ .= "\telse SETERRNO(0,SS\$_NORMAL);\n";
+    $_ .= "    else SETERRNO(saved_errno,saved_vaxc_errno);\n  }\n";
   }
   else {
     # add the dEXT tag to definitions of global vars, so we'll insert