From: Craig A. Berry Date: Mon, 25 Mar 2002 17:24:33 +0000 (-0600) Subject: yfix fix for VMS (was YYDEBUG etc.) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2ac72d6ee10eac553987a271a333c11a24d55989;p=p5sagit%2Fp5-mst-13.2.git yfix fix for VMS (was YYDEBUG etc.) From: "Craig A. Berry" 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 --- 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 0c5b80a8..9fd86d3 100644 --- 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 --- 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 --- 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 --- 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 --- a/vms/vms_yfix.pl +++ b/vms/vms_yfix.pl @@ -28,9 +28,12 @@ while () { $_ = "# 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; $_ = ; } - $_ .= "\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