support OE/MVS

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

diff --git a/toke.c b/toke.c
index 9475b25..b5315fa 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -185,7 +185,13 @@ missingterm(char *s)
        if (nl)
            *nl = '\0';
     }
-    else if (PL_multi_close < 32 || PL_multi_close == 127) {
+    else if (
+#ifdef EBCDIC
+       iscntrl(PL_multi_close)
+#else
+       PL_multi_close < 32 || PL_multi_close == 127
+#endif
+       ) {
        *tmpbuf = '^';
        tmpbuf[1] = toCTRL(PL_multi_close);
        s = "\\n";
@@ -989,8 +995,15 @@ scan_const(char *start)
            /* \c is a control character */
            case 'c':
                s++;
+#ifdef EBCDIC
+               *d = *s++;
+               if (isLOWER(*d))
+                  *d = toUPPER(*d);
+               *d++ = toCTRL(*d); 
+#else
                len = *s++;
                *d++ = toCTRL(len);
+#endif
                continue;
 
            /* printf-style backslashes, formfeeds, newlines, etc */
@@ -1390,7 +1403,7 @@ filter_gets(register SV *sv, register PerlIO *fp, STRLEN append)
         else
            return Nullch ;
     }
-    else 
+    else
         return (sv_gets(sv, fp, append));
 }
 
@@ -4057,7 +4070,17 @@ yylex(void)
            FUN0(OP_WANTARRAY);
 
        case KEY_write:
-           gv_fetchpv("\f",TRUE, SVt_PV);      /* Make sure $^L is defined */
+#ifdef EBCDIC
+       {
+           static char ctl_l[2];
+
+           if (ctl_l[0] == '\0') 
+               ctl_l[0] = toCTRL('L');
+           gv_fetchpv(ctl_l,TRUE, SVt_PV);
+       }
+#else
+           gv_fetchpv("\f",TRUE, SVt_PV);      /* Make sure $^L is defined */
+#endif
            UNI(OP_ENTERWRITE);
 
        case KEY_x: