support OE/MVS

Message-Id: <199808010903.MAA09371@alpha.hut.fi> Subject: [PATCH] 5.005_01: OE MVS p4raw-id: //depot/maint-5.005/perl@1697
author: Jarkko Hietaniemi <jhi@iki.fi> 1998-08-01 15:03:02 +0300
committer: Gurusamy Sarathy <gsar@cpan.org> 1998-08-02 05:20:12 +0000
commit: 9d116dd7c895b17badf4ad422ae44da0c4df7bc2 (patch)
tree: 6e0cd77e3539952c892983238473264f672472b9
parent: e6df7ed16ebd06f5315f3016c00996876580109c (diff)
download: perl-9d116dd7c895b17badf4ad422ae44da0c4df7bc2.tar.gz
53 files changed, 887 insertions, 441 deletions
diff --git a/Configure b/Configure
index 197295fe2f..3977b87a85 100755
--- a/Configure
+++ b/Configure
@@ -12026,7 +12026,7 @@ esac
 case "$ebcdic" in
 $define)
     xxx=''
-    echo "This is an EBCDIC system, checking if any parser files may need regenerating." >&4
+    echo "This is an EBCDIC system, checking if any parser files need regenerating." >&4
     rm -f y.tab.c y.tab.h
     yacc -d perly.y >/dev/null 2>&1
     if cmp -s y.tab.c perly.c; then
@@ -12048,8 +12048,8 @@ $define)
     fi
     echo "x2p/a2p.y" >&4
     cd x2p
-    rm -f y.tab.c y.tab.h
-    yacc -d a2p.y >/dev/null 2>&1
+    rm -f y.tab.c
+    yacc a2p.y >/dev/null 2>&1
     if cmp -s y.tab.c a2p.c
     then
         rm -f y.tab.c
@@ -12061,14 +12061,6 @@ $define)
             -e 's/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c
         xxx="$xxx a2p.c"
     fi
-    if cmp -s y.tab.h a2p.h
-    then
-        rm -f y.tab.h
-    else
-        echo "a2p.h -> a2p.h" >&4
-        mv -f y.tab.h a2p.h
-        xxx="$xxx a2p.h"
-    fi
     cd ..
     case "$xxx" in
     '') echo "No parser files were regenerated.  That's okay." >&4 ;;
diff --git a/MANIFEST b/MANIFEST
index e5cfd9a5fd..1bf477cd59 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -34,6 +34,7 @@ README.cygwin32		Notes about Cygwin32 port
 README.dos		Notes about dos/djgpp port
 README.mpeix		Notes about MPE/iX port
 README.os2		Notes about OS/2 port
+README.os390		Notes about OS/390 (nee MVS) port
 README.plan9		Notes about Plan9 port
 README.qnx		Notes about QNX port
 README.threads		Notes about multithreading
@@ -73,6 +74,7 @@ doio.c			I/O operations
 doop.c			Support code for various operations
 dosish.h		Some defines for MS/DOSish machines
 dump.c			Debugging output
+ebcdic.c		EBCDIC support routines
 eg/ADB			An adb wrapper to put in your crash dir
 eg/README		Intro to example perl scripts
 eg/cgi/RunMeFirst		Setup script for CGI examples
diff --git a/README.os390 b/README.os390
new file mode 100644
index 0000000000..b5ddaffacc
--- /dev/null
+++ b/README.os390
@@ -0,0 +1,83 @@
+This is a fully ported perl for OS/390 Release 3.  It may work on
+other versions, but that's the one we've tested it on.
+
+If you've downloaded the binary distribution, it needs to be
+installed below /usr/local.  Source code distributions have an
+automated `make install` step that means you do not need to extract
+the source code below /usr/local (though that is where it will be
+installed by default).  You may need to worry about the networking
+configuration files discussed in the last bullet below.
+
+Gunzip/gzip for OS/390 is discussed at:
+
+   http://www.s390.ibm.com/products/oe/bpxqp1.html
+
+to extract an ASCII tar archive on OS/390, try this:
+
+   pax -o to=IBM-1047,from=ISO8859-1 -r < latest.tar
+
+GNU make for OS/390, which may be required for the build of perl, 
+is available from:
+
+  http://www.mks.com/s390/gnu/index.htm
+
+Once you've unpacked the distribution, run Configure (see INSTALL for
+full discussion of the Configure options), and then run make, then
+"make test" then "make install" (this last step may require UID=0
+privileges)
+
+There is a "hints" file for os390 that specifies the correct values
+for most things.  Some things to watch out for are
+
+	- this port doesn't support dynamic loading.  Although
+	  OS/390 has support for DLLs, there are some differences
+	  that cause problems for perl.
+
+        - You may see a "WHOA THERE!!!" message for $d_shmatprototype
+          it is OK to keep the recommended "define".
+
+	- Don't turn on the compiler optimization flag "-O".  There's
+	  a bug in either the optimizer or perl that causes perl to
+	  not work correctly when the optimizer is on.
+
+	- Some of the configuration files in /etc used by the
+	  networking APIs are either missing or have the wrong
+	  names.  In particular, make sure that there's either
+	  an /etc/resolv.conf or and /etc/hosts, so that
+	  gethostbyname() works, and make sure that the file
+	  /etc/proto has been renamed to /etc/protocol (NOT
+	  /etc/protocols, as used by other Unix systems).
+
+When using perl on OS/390 please keep in mind that the EBCDIC and ASCII
+character sets are different.  Perl builtin functions that may behave
+differently under EBCDIC are mentioned in the perlport.pod document.
+
+OpenEdition (UNIX System Services) does not (yet) support the #! means 
+of script invokation.
+See:
+
+    head `whence perldoc`
+
+for an example of how to use the "eval exec" trick to ask the shell to
+have perl run your scripts for you.
+
+perl-mvs mailing list: The Perl Institute (http://www.perl.org/)
+maintains a mailing list of interest to all folks building and/or
+using perl on EBCDIC platforms.  To subscibe, send a message of:
+
+    subscribe perl-mvs
+
+to majordomo@perl.org.
+
+Regression tests: as the 5.005 kit was was being assembled
+the following "failures" were known to appear on some machines
+during `make test` (mostly due to ASCII vs. EBCDIC conflicts),
+your results may differ:
+
+comp/cpp..........FAILED at test 0
+op/pack...........FAILED at test 58
+op/stat...........Out of memory!
+op/taint..........FAILED at test 73
+lib/errno.........FAILED at test 1
+lib/posix.........FAILED at test 19
+lib/searchdict....FAILED at test 1
diff --git a/doio.c b/doio.c
index ae35c6c385..85d604bc03 100644
--- a/doio.c
+++ b/doio.c
@@ -125,22 +125,37 @@ do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawpe
     }
 
     if (as_raw) {
-	result = rawmode & 3;
-	IoTYPE(io) = "<>++"[result];
+#ifndef O_ACCMODE
+#define O_ACCMODE 3		/* Assume traditional implementation */
+#endif
+	switch (result = rawmode & O_ACCMODE) {
+	case O_RDONLY:
+	     IoTYPE(io) = '<';
+	     break;
+	case O_WRONLY:
+	     IoTYPE(io) = '>';
+	     break;
+	case O_RDWR:
+	default:
+	     IoTYPE(io) = '+';
+	     break;
+	}
+
 	writing = (result > 0);
 	fd = PerlLIO_open3(name, rawmode, rawperm);
+
 	if (fd == -1)
 	    fp = NULL;
 	else {
 	    char *fpmode;
-	    if (result == 0)
+	    if (result == O_RDONLY)
 		fpmode = "r";
 #ifdef O_APPEND
 	    else if (rawmode & O_APPEND)
-		fpmode = (result == 1) ? "a" : "a+";
+		fpmode = (result == O_WRONLY) ? "a" : "a+";
 #endif
 	    else
-		fpmode = (result == 1) ? "w" : "r+";
+		fpmode = (result == O_WRONLY) ? "w" : "r+";
 	    fp = PerlIO_fdopen(fd, fpmode);
 	    if (!fp)
 		PerlLIO_close(fd);
@@ -400,7 +415,7 @@ nextargv(register GV *gv)
 	sv_setsv(GvSV(gv),sv);
 	SvSETMAGIC(GvSV(gv));
 	PL_oldname = SvPVx(GvSV(gv), oldlen);
-	if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,0,0,Nullfp)) {
+	if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,O_RDONLY,0,Nullfp)) {
 	    if (PL_inplace) {
 		TAINT_PROPER("inplace open");
 		if (oldlen == 1 && *PL_oldname == '-') {
@@ -462,7 +477,7 @@ nextargv(register GV *gv)
 		    do_close(gv,FALSE);
 		    (void)PerlLIO_unlink(SvPVX(sv));
 		    (void)PerlLIO_rename(PL_oldname,SvPVX(sv));
-		    do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,0,0,Nullfp);
+		    do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,O_RDONLY,0,Nullfp);
 #endif /* DOSISH */
 #else
 		    (void)UNLINK(SvPVX(sv));
diff --git a/ebcdic.c b/ebcdic.c
new file mode 100644
index 0000000000..890bd086d2
--- /dev/null
+++ b/ebcdic.c
@@ -0,0 +1,32 @@
+#include "EXTERN.h"
+#include "perl.h"
+
+/* in ASCII order, not that it matters */
+static const char controllablechars[] = "?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
+ 
+int
+ebcdic_control(int ch)
+{
+    	if (ch > 'a') {
+	        char *ctlp;
+ 
+ 	       if (islower(ch))
+  	              ch = toupper(ch);
+ 
+ 	       if ((ctlp = strchr(controllablechars, ch)) == 0) {
+  	              die("unrecognised control character '%c'\n", ch);
+     	       }
+ 
+        	if (ctlp == controllablechars)
+         	       return('\177'); /* DEL */
+        	else
+         	       return((unsigned char)(ctlp - controllablechars - 1));
+	} else { /* Want uncontrol */
+        	if (ch == '\177' || ch == -1)
+                	return('?');
+        	else if (0 < ch && ch < (sizeof(controllablechars) - 1))
+                	return(controllablechars[ch+1]);
+        	else
+                	die("invalid control request: '\\%03o'\n", ch & 0xFF);
+	}
+}
diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL
index a8a7cf73fe..f4d50206b5 100644
--- a/ext/Errno/Errno_pm.PL
+++ b/ext/Errno/Errno_pm.PL
@@ -53,6 +53,9 @@ sub get_files {
 	} elsif ($Config{vms_cc_type} eq 'gcc') {
 	    $file{'gnu_cc_include:[000000]errno.h'} = 1;
 	}
+    } elsif ($^O eq 'os390') {
+	# OS/390 C compiler doesn't generate #file or #line directives
+	$file{'/usr/include/errno.h'} = 1;
     } else {
 	open(CPPI,"> errno.c") or
 	    die "Cannot open errno.c";
@@ -104,7 +107,7 @@ sub write_errno_pm {
 	$cpp =~ s/sys\$input//i;
 	open(CPPO,"$cpp  errno.c |") or
           die "Cannot exec $Config{cppstdin}";
-    } elsif($^O eq 'next') {
+    } elsif(!$Config{'cpprun'} or $^O eq 'next') {
 	# NeXT will do syntax checking unless it is reading from stdin
 	my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
 	open(CPPO,"$cpp < errno.c |")
diff --git a/gv.c b/gv.c
index a01956fd25..531fbb55bb 100644
--- a/gv.c
+++ b/gv.c
@@ -502,25 +502,19 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
 	    bool global = FALSE;
 
 	    if (isUPPER(*name)) {
-		if (*name > 'I') {
-		    if (*name == 'S' && (
-		      strEQ(name, "SIG") ||
-		      strEQ(name, "STDIN") ||
-		      strEQ(name, "STDOUT") ||
-		      strEQ(name, "STDERR") ))
-			global = TRUE;
-		}
-		else if (*name > 'E') {
-		    if (*name == 'I' && strEQ(name, "INC"))
-			global = TRUE;
-		}
-		else if (*name > 'A') {
-		    if (*name == 'E' && strEQ(name, "ENV"))
-			global = TRUE;
-		}
+		if (*name == 'S' && (
+		    strEQ(name, "SIG") ||
+		    strEQ(name, "STDIN") ||
+		    strEQ(name, "STDOUT") ||
+		    strEQ(name, "STDERR")))
+		    global = TRUE;
+		else if (*name == 'I' && strEQ(name, "INC"))
+		    global = TRUE;
+		else if (*name == 'E' && strEQ(name, "ENV"))
+		    global = TRUE;
 		else if (*name == 'A' && (
 		  strEQ(name, "ARGV") ||
-		  strEQ(name, "ARGVOUT") ))
+		  strEQ(name, "ARGVOUT")))
 		    global = TRUE;
 	    }
 	    else if (*name == '_' && !name[1])
@@ -759,8 +753,8 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     case '\005':
     case '\006':
     case '\010':
+    case '\011':	/* NOT \t in EBCDIC */
     case '\017':
-    case '\t':
     case '\020':
     case '\024':
     case '\027':
diff --git a/handy.h b/handy.h
index e74a3069a8..eb26ed8deb 100644
--- a/handy.h
+++ b/handy.h
@@ -183,11 +183,20 @@ typedef unsigned short	U16;
 #define isSPACE(c) \
 	((c) == ' ' || (c) == '\t' || (c) == '\n' || (c) =='\r' || (c) == '\f')
 #define isDIGIT(c)	((c) >= '0' && (c) <= '9')
-#define isUPPER(c)	((c) >= 'A' && (c) <= 'Z')
-#define isLOWER(c)	((c) >= 'a' && (c) <= 'z')
-#define isPRINT(c)	(((c) > 32 && (c) < 127) || isSPACE(c))
-#define toUPPER(c)	(isLOWER(c) ? (c) - ('a' - 'A') : (c))
-#define toLOWER(c)	(isUPPER(c) ? (c) + ('a' - 'A') : (c))
+#ifdef EBCDIC
+    /* In EBCDIC we do not do locales: therefore() isupper() is fine. */
+#   define isUPPER(c)	isupper(c)
+#   define isLOWER(c)	islower(c)
+#   define isPRINT(c)	isprint(c)
+#   define toUPPER(c)	toupper(c)
+#   define toLOWER(c)	tolower(c)
+#else
+#   define isUPPER(c)	((c) >= 'A' && (c) <= 'Z')
+#   define isLOWER(c)	((c) >= 'a' && (c) <= 'z')
+#   define isPRINT(c)	(((c) > 32 && (c) < 127) || isSPACE(c))
+#   define toUPPER(c)	(isLOWER(c) ? (c) - ('a' - 'A') : (c))
+#   define toLOWER(c)	(isUPPER(c) ? (c) + ('a' - 'A') : (c))
+#endif
 
 #ifdef USE_NEXT_CTYPE
 
@@ -238,8 +247,13 @@ typedef unsigned short	U16;
 #  endif
 #endif /* USE_NEXT_CTYPE */
 
-/* This conversion works both ways, strangely enough. */
-#define toCTRL(c)    (toUPPER(c) ^ 64)
+#ifdef EBCDIC
+EXT int ebcdic_control _((int));
+#  define toCTRL(c)	ebcdic_control(c)
+#else
+  /* This conversion works both ways, strangely enough. */
+#  define toCTRL(c)    (toUPPER(c) ^ 64)
+#endif
 
 /* Line numbers are unsigned, 16 bits. */
 typedef U16 line_t;
diff --git a/hints/os390.sh b/hints/os390.sh
index fd590eaa4e..1cf945dca3 100644
--- a/hints/os390.sh
+++ b/hints/os390.sh
@@ -1,4 +1,7 @@
 # hints/os390.sh
+#
+# OS/390 hints by David J. Fiander <davidf@mks.com>
+#
 # OS/390 OpenEdition Release 3 Mon Sep 22 1997 thanks to:
 #     
 #     John Pfuntner <pfuntner@vnet.ibm.com>
@@ -11,23 +14,43 @@
 #  as well as the authors of the aix.sh file
 #
 
+# To get ANSI C, we need to use c89, and ld doesn't exist
 cc='c89'
-ccflags='-DMAXSIG=38 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE'
+ld='c89'
+# c89 hides most of the useful header stuff, _ALL_SOURCE turns it on again,
+# YYDYNAMIC ensures that the OS/390 yacc generated parser is reentrant.
+# -DEBCDIC should come from Configure.
+ccflags='-DMAXSIG=38 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE -DYYDYNAMIC'
+# Turning on optimization breaks perl
 optimize='none'
+
 alignbytes=8
-usemymalloc='y'
+
+usemymalloc='n'
+
 so='a'
+
+# On OS/390, libc.a doesn't really hold anything at all,
+# so running nm on it is pretty useless.
+usenm='n'
+
+# Dynamic loading doesn't work on OS/390 quite yet
+usedl='n'
 dlext='none'
+
+# Configure can't figure this out for some reason
 d_shmatprototype='define'
+
 usenm='false'
 i_time='define'
 i_systime='define'
-d_select='undef'
 
 # (from aix.sh)
 # uname -m output is too specific and not appropriate here
+# osname should come from Configure
 #
 case "$archname" in
 '') archname="$osname" ;;
 esac
 
+archobjs=ebcdic.o
diff --git a/lib/bigint.pl b/lib/bigint.pl
index bfd2efa88c..adeb17f28a 100644
--- a/lib/bigint.pl
+++ b/lib/bigint.pl
@@ -74,7 +74,7 @@ sub external { #(int_num_array) return num_str
 sub main'bneg { #(num_str) return num_str
     local($_) = &'bnorm(@_);
     vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0';
-    s/^H/N/;
+    s/^./N/ unless /^[-+]/; # works both in ASCII and EBCDIC
     $_;
 }
 
diff --git a/mg.c b/mg.c
index 35400e732b..1d78f1366e 100644
--- a/mg.c
+++ b/mg.c
@@ -422,7 +422,7 @@ magic_get(SV *sv, MAGIC *mg)
     case '\010':		/* ^H */
 	sv_setiv(sv, (IV)PL_hints);
 	break;
-    case '\t':			/* ^I */
+    case '\011':		/* ^I */ /* NOT \t in EBCDIC */
 	if (PL_inplace)
 	    sv_setpv(sv, PL_inplace);
 	else
@@ -1520,7 +1520,7 @@ magic_set(SV *sv, MAGIC *mg)
     case '\010':	/* ^H */
 	PL_hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 	break;
-    case '\t':	/* ^I */
+    case '\011':	/* ^I */ /* NOT \t in EBCDIC */
 	if (PL_inplace)
 	    Safefree(PL_inplace);
 	if (SvOK(sv))
diff --git a/patchlevel.h b/patchlevel.h
index 148b1b8607..135eeabb68 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1,5 +1,6 @@
 #ifndef __PATCHLEVEL_H_INCLUDED__
 #define PATCHLEVEL 5
+#undef SUBVERSION     /* OS/390 has a SUBVERSION in a system header */
 #define SUBVERSION 1
 
 /*
diff --git a/perl.c b/perl.c
index 27936cf64e..0e39dbeeab 100644
--- a/perl.c
+++ b/perl.c
@@ -1738,6 +1738,9 @@ moreswitches(char *s)
 #ifdef MPE
 	printf("MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-1998\n");
 #endif
+#ifdef OEMVS
+	printf("MVS (OS390) port by Mortice Kern Systems, 1997-1998\n");
+#endif
 #ifdef BINARY_BUILD_NOTICE
 	BINARY_BUILD_NOTICE;
 #endif
diff --git a/perl.h b/perl.h
index c5597aaf7f..c6cc872ec5 100644
--- a/perl.h
+++ b/perl.h
@@ -1423,6 +1423,7 @@ Gid_t getegid _((void));
 #ifndef Perl_debug_log
 #define Perl_debug_log	PerlIO_stderr()
 #endif
+#undef  YYDEBUG
 #define YYDEBUG 1
 #define DEB(a)     			a
 #define DEBUG(a)   if (PL_debug)		a
@@ -1489,8 +1490,13 @@ double atof _((const char*));
 /* All of these are in stdlib.h or time.h for ANSI C */
 Time_t time();
 struct tm *gmtime(), *localtime();
+#ifdef OEMVS
+char *(strchr)(), *(strrchr)();
+char *(strcpy)(), *(strcat)();
+#else
 char *strchr(), *strrchr();
 char *strcpy(), *strcat();
+#endif
 #endif /* ! STANDARD_C */
 
 
@@ -1668,6 +1674,42 @@ EXT SV  * psig_name[];
 /* fast case folding tables */
 
 #ifdef DOINIT
+#ifdef EBCDIC
+EXT unsigned char fold[] = { /* fast EBCDIC case folding table */
+    0,      1,      2,      3,      4,      5,      6,      7,
+    8,      9,      10,     11,     12,     13,     14,     15,
+    16,     17,     18,     19,     20,     21,     22,     23,
+    24,     25,     26,     27,     28,     29,     30,     31,
+    32,     33,     34,     35,     36,     37,     38,     39,
+    40,     41,     42,     43,     44,     45,     46,     47,
+    48,     49,     50,     51,     52,     53,     54,     55,
+    56,     57,     58,     59,     60,     61,     62,     63,
+    64,     65,     66,     67,     68,     69,     70,     71,
+    72,     73,     74,     75,     76,     77,     78,     79,
+    80,     81,     82,     83,     84,     85,     86,     87,
+    88,     89,     90,     91,     92,     93,     94,     95,
+    96,     97,     98,     99,     100,    101,    102,    103,
+    104,    105,    106,    107,    108,    109,    110,    111,
+    112,    113,    114,    115,    116,    117,    118,    119,
+    120,    121,    122,    123,    124,    125,    126,    127,
+    128,    'A',    'B',    'C',    'D',    'E',    'F',    'G',
+    'H',    'I',    138,    139,    140,    141,    142,    143,
+    144,    'J',    'K',    'L',    'M',    'N',    'O',    'P',
+    'Q',    'R',    154,    155,    156,    157,    158,    159,
+    160,    161,    'S',    'T',    'U',    'V',    'W',    'X',
+    'Y',    'Z',    170,    171,    172,    173,    174,    175,
+    176,    177,    178,    179,    180,    181,    182,    183,
+    184,    185,    186,    187,    188,    189,    190,    191,
+    192,    'a',    'b',    'c',    'd',    'e',    'f',    'g',
+    'h',    'i',    202,    203,    204,    205,    206,    207,
+    208,    'j',    'k',    'l',    'm',    'n',    'o',    'p',
+    'q',    'r',    218,    219,    220,    221,    222,    223,
+    224,    225,    's',    't',    'u',    'v',    'w',    'x',
+    'y',    'z',    234,    235,    236,    237,    238,    239,
+    240,    241,    242,    243,    244,    245,    246,    247,
+    248,    249,    250,    251,    252,    253,    254,    255
+};
+#else   /* ascii rather than ebcdic */
 EXTCONST  unsigned char fold[] = {
 	0,	1,	2,	3,	4,	5,	6,	7,
 	8,	9,	10,	11,	12,	13,	14,	15,
@@ -1702,6 +1744,7 @@ EXTCONST  unsigned char fold[] = {
 	240,	241,	242,	243,	244,	245,	246,	247,
 	248,	249,	250,	251,	252,	253,	254,	255
 };
+#endif  /* !EBCDIC */
 #else
 EXTCONST unsigned char fold[];
 #endif
@@ -1746,6 +1789,42 @@ EXT unsigned char fold_locale[];
 #endif
 
 #ifdef DOINIT
+#ifdef EBCDIC
+EXT unsigned char freq[] = {/* EBCDIC frequencies for mixed English/C */
+    1,      2,      84,     151,    154,    155,    156,    157,
+    165,    246,    250,    3,      158,    7,      18,     29,
+    40,     51,     62,     73,     85,     96,     107,    118,
+    129,    140,    147,    148,    149,    150,    152,    153,
+    255,      6,      8,      9,     10,     11,     12,     13,
+     14,     15,     24,     25,     26,     27,     28,    226,
+     29,     30,     31,     32,     33,     43,     44,     45,
+     46,     47,     48,     49,     50,     76,     77,     78,
+     79,     80,     81,     82,     83,     84,     85,     86,
+     87,     94,     95,    234,    181,    233,    187,    190,
+    180,     96,     97,     98,     99,    100,    101,    102,
+    104,    112,    182,    174,    236,    232,    229,    103,
+    228,    226,    114,    115,    116,    117,    118,    119,
+    120,    121,    122,    235,    176,    230,    194,    162,
+    130,    131,    132,    133,    134,    135,    136,    137,
+    138,    139,    201,    205,    163,    217,    220,    224,
+    5,      248,    227,    244,    242,    255,    241,    231,
+    240,    253,    16,     197,    19,     20,     21,     187,
+    23,     169,    210,    245,    237,    249,    247,    239,
+    168,    252,    34,     196,    36,     37,     38,     39,
+    41,     42,     251,    254,    238,    223,    221,    213,
+    225,    177,    52,     53,     54,     55,     56,     57,
+    58,     59,     60,     61,     63,     64,     65,     66,
+    67,     68,     69,     70,     71,     72,     74,     75,
+    205,    208,    186,    202,    200,    218,    198,    179,
+    178,    214,    88,     89,     90,     91,     92,     93,
+    217,    166,    170,    207,    199,    209,    206,    204,
+    160,    212,    105,    106,    108,    109,    110,    111,
+    203,    113,    216,    215,    192,    175,    193,    243,
+    172,    161,    123,    124,    125,    126,    127,    128,
+    222,    219,    211,    195,    188,    193,    185,    184,
+    191,    183,    141,    142,    143,    144,    145,    146
+};
+#else  /* ascii rather than ebcdic */
 EXTCONST unsigned char freq[] = {	/* letter frequencies for mixed English/C */
 	1,	2,	84,	151,	154,	155,	156,	157,
 	165,	246,	250,	3,	158,	7,	18,	29,
@@ -1780,6 +1859,7 @@ EXTCONST unsigned char freq[] = {	/* letter frequencies for mixed English/C */
 	130,	131,	132,	133,	134,	135,	136,	137,
 	138,	139,	141,	142,	143,	144,	145,	146
 };
+#endif
 #else
 EXTCONST unsigned char freq[];
 #endif
diff --git a/perly.c b/perly.c
index 9b2137f2bb..7a53d4b6f2 100644
--- a/perly.c
+++ b/perly.c
@@ -21,7 +21,7 @@ dep(void)
 }
 #endif
 
-#line 16 "perly.c"
+#line 30 "perly.y"
 #define YYERRCODE 256
 short yylhs[] = {                                        -1,
    45,    0,    9,    7,   10,    8,   11,   11,   11,   12,
@@ -1280,11 +1280,13 @@ int yydebug;
 int yynerrs;
 int yyerrflag;
 int yychar;
+short *yyssp;
+YYSTYPE *yyvsp;
 YYSTYPE yyval;
 YYSTYPE yylval;
-#line 635 "perly.y"
+#line 643 "perly.y"
  /* PROGRAM */
-#line 1349 "perly.c"
+#line 1353 "perly.c"
 #define YYABORT goto yyabort
 #define YYACCEPT goto yyaccept
 #define YYERROR goto yyerrlab
@@ -1513,7 +1515,7 @@ yyreduce:
     switch (yyn)
     {
 case 1:
-#line 86 "perly.y"
+#line 94 "perly.y"
 {
 #if defined(YYDEBUG) && defined(DEBUGGING)
 		    yydebug = (PL_debug & 1);
@@ -1522,50 +1524,50 @@ case 1:
 		}
 break;
 case 2:
-#line 93 "perly.y"
+#line 101 "perly.y"
 { newPROG(yyvsp[0].opval); }
 break;
 case 3:
-#line 97 "perly.y"
+#line 105 "perly.y"
 { if (PL_copline > (line_t)yyvsp[-3].ival)
 			      PL_copline = yyvsp[-3].ival;
 			  yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); }
 break;
 case 4:
-#line 103 "perly.y"
+#line 111 "perly.y"
 { yyval.ival = block_start(TRUE); }
 break;
 case 5:
-#line 107 "perly.y"
+#line 115 "perly.y"
 { if (PL_copline > (line_t)yyvsp[-3].ival)
 			      PL_copline = yyvsp[-3].ival;
 			  yyval.opval = block_end(yyvsp[-2].ival, yyvsp[-1].opval); }
 break;
 case 6:
-#line 113 "perly.y"
+#line 121 "perly.y"
 { yyval.ival = block_start(FALSE); }
 break;
 case 7:
-#line 117 "perly.y"
+#line 125 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 8:
-#line 119 "perly.y"
+#line 127 "perly.y"
 { yyval.opval = yyvsp[-1].opval; }
 break;
 case 9:
-#line 121 "perly.y"
+#line 129 "perly.y"
 {   yyval.opval = append_list(OP_LINESEQ,
 				(LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval);
 			    PL_pad_reset_pending = TRUE;
 			    if (yyvsp[-1].opval && yyvsp[0].opval) PL_hints |= HINT_BLOCK_SCOPE; }
 break;
 case 10:
-#line 128 "perly.y"
+#line 136 "perly.y"
 { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); }
 break;
 case 12:
-#line 131 "perly.y"
+#line 139 "perly.y"
 { if (yyvsp[-1].pval != Nullch) {
 			      yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0));
 			    }
@@ -1576,76 +1578,76 @@ case 12:
 			    PL_expect = XSTATE; }
 break;
 case 13:
-#line 140 "perly.y"
+#line 148 "perly.y"
 { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval);
 			  PL_expect = XSTATE; }
 break;
 case 14:
-#line 145 "perly.y"
+#line 153 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 15:
-#line 147 "perly.y"
+#line 155 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 16:
-#line 149 "perly.y"
+#line 157 "perly.y"
 { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); }
 break;
 case 17:
-#line 151 "perly.y"
+#line 159 "perly.y"
 { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); }
 break;
 case 18:
-#line 153 "perly.y"
+#line 161 "perly.y"
 { yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); }
 break;
 case 19:
-#line 155 "perly.y"
+#line 163 "perly.y"
 { yyval.opval = newLOOPOP(OPf_PARENS, 1, yyvsp[0].opval, yyvsp[-2].opval);}
 break;
 case 20:
-#line 157 "perly.y"
+#line 165 "perly.y"
 { yyval.opval = newFOROP(0, Nullch, yyvsp[-1].ival,
 					Nullop, yyvsp[0].opval, yyvsp[-2].opval, Nullop); }
 break;
 case 21:
-#line 162 "perly.y"
+#line 170 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 22:
-#line 164 "perly.y"
+#line 172 "perly.y"
 { yyval.opval = scope(yyvsp[0].opval); }
 break;
 case 23:
-#line 166 "perly.y"
+#line 174 "perly.y"
 { PL_copline = yyvsp[-5].ival;
 			    yyval.opval = newSTATEOP(0, Nullch,
 				   newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval));
 			    PL_hints |= HINT_BLOCK_SCOPE; }
 break;
 case 24:
-#line 173 "perly.y"
+#line 181 "perly.y"
 { PL_copline = yyvsp[-6].ival;
 			    yyval.opval = block_end(yyvsp[-4].ival,
 				   newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); }
 break;
 case 25:
-#line 177 "perly.y"
+#line 185 "perly.y"
 { PL_copline = yyvsp[-6].ival;
 			    yyval.opval = block_end(yyvsp[-4].ival,
 				   newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval)); }
 break;
 case 26:
-#line 183 "perly.y"
+#line 191 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 27:
-#line 185 "perly.y"
+#line 193 "perly.y"
 { yyval.opval = scope(yyvsp[0].opval); }
 break;
 case 28:
-#line 189 "perly.y"
+#line 197 "perly.y"
 { PL_copline = yyvsp[-6].ival;
 			    yyval.opval = block_end(yyvsp[-4].ival,
 				   newSTATEOP(0, yyvsp[-7].pval,
@@ -1653,7 +1655,7 @@ case 28:
 						yyvsp[-6].ival, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); }
 break;
 case 29:
-#line 195 "perly.y"
+#line 203 "perly.y"
 { PL_copline = yyvsp[-6].ival;
 			    yyval.opval = block_end(yyvsp[-4].ival,
 				   newSTATEOP(0, yyvsp[-7].pval,
@@ -1661,23 +1663,23 @@ case 29:
 						yyvsp[-6].ival, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval))); }
 break;
 case 30:
-#line 201 "perly.y"
+#line 209 "perly.y"
 { yyval.opval = block_end(yyvsp[-6].ival,
 				 newFOROP(0, yyvsp[-9].pval, yyvsp[-8].ival, yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); }
 break;
 case 31:
-#line 204 "perly.y"
+#line 212 "perly.y"
 { yyval.opval = block_end(yyvsp[-4].ival,
 				 newFOROP(0, yyvsp[-8].pval, yyvsp[-7].ival, mod(yyvsp[-6].opval, OP_ENTERLOOP),
 					  yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); }
 break;
 case 32:
-#line 208 "perly.y"
+#line 216 "perly.y"
 { yyval.opval = block_end(yyvsp[-4].ival,
 				 newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval)); }
 break;
 case 33:
-#line 212 "perly.y"
+#line 220 "perly.y"
 { OP *forop = append_elem(OP_LINESEQ,
 					scalar(yyvsp[-6].opval),
 					newWHILEOP(0, 1, (LOOP*)Nullop,
@@ -1687,89 +1689,89 @@ case 33:
 			  yyval.opval = block_end(yyvsp[-7].ival, newSTATEOP(0, yyvsp[-10].pval, forop)); }
 break;
 case 34:
-#line 220 "perly.y"
+#line 228 "perly.y"
 { yyval.opval = newSTATEOP(0, yyvsp[-2].pval,
 				 newWHILEOP(0, 1, (LOOP*)Nullop,
 					    NOLINE, Nullop, yyvsp[-1].opval, yyvsp[0].opval)); }
 break;
 case 35:
-#line 226 "perly.y"
+#line 234 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 37:
-#line 231 "perly.y"
+#line 239 "perly.y"
 { (void)scan_num("1"); yyval.opval = yylval.opval; }
 break;
 case 39:
-#line 236 "perly.y"
+#line 244 "perly.y"
 { yyval.opval = invert(scalar(yyvsp[0].opval)); }
 break;
 case 40:
-#line 240 "perly.y"
+#line 248 "perly.y"
 { yyval.opval = yyvsp[0].opval; intro_my(); }
 break;
 case 41:
-#line 244 "perly.y"
+#line 252 "perly.y"
 { yyval.opval = yyvsp[0].opval; intro_my(); }
 break;
 case 42:
-#line 248 "perly.y"
+#line 256 "perly.y"
 { yyval.opval = yyvsp[0].opval; intro_my(); }
 break;
 case 43:
-#line 252 "perly.y"
+#line 260 "perly.y"
 { yyval.opval = yyvsp[0].opval; intro_my(); }
 break;
 case 44:
-#line 256 "perly.y"
+#line 264 "perly.y"
 { yyval.pval = Nullch; }
 break;
 case 46:
-#line 261 "perly.y"
+#line 269 "perly.y"
 { yyval.ival = 0; }
 break;
 case 47:
-#line 263 "perly.y"
+#line 271 "perly.y"
 { yyval.ival = 0; }
 break;
 case 48:
-#line 265 "perly.y"
+#line 273 "perly.y"
 { yyval.ival = 0; }
 break;
 case 49:
-#line 267 "perly.y"
+#line 275 "perly.y"
 { yyval.ival = 0; }
 break;
 case 50:
-#line 271 "perly.y"
+#line 279 "perly.y"
 { newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
 break;
 case 51:
-#line 274 "perly.y"
+#line 282 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 52:
-#line 275 "perly.y"
+#line 283 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 53:
-#line 279 "perly.y"
+#line 287 "perly.y"
 { newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); }
 break;
 case 54:
-#line 283 "perly.y"
+#line 291 "perly.y"
 { yyval.ival = start_subparse(FALSE, 0); }
 break;
 case 55:
-#line 287 "perly.y"
+#line 295 "perly.y"
 { yyval.ival = start_subparse(FALSE, CVf_ANON); }
 break;
 case 56:
-#line 291 "perly.y"
+#line 299 "perly.y"
 { yyval.ival = start_subparse(TRUE, 0); }
 break;
 case 57:
-#line 294 "perly.y"
+#line 302 "perly.y"
 { char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na);
 			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
 			      || strEQ(name, "INIT"))
@@ -1777,297 +1779,297 @@ case 57:
 			  yyval.opval = yyvsp[0].opval; }
 break;
 case 58:
-#line 302 "perly.y"
+#line 310 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 60:
-#line 306 "perly.y"
+#line 314 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 61:
-#line 307 "perly.y"
+#line 315 "perly.y"
 { yyval.opval = Nullop; PL_expect = XSTATE; }
 break;
 case 62:
-#line 311 "perly.y"
+#line 319 "perly.y"
 { package(yyvsp[-1].opval); }
 break;
 case 63:
-#line 313 "perly.y"
+#line 321 "perly.y"
 { package(Nullop); }
 break;
 case 64:
-#line 317 "perly.y"
+#line 325 "perly.y"
 { CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ }
 break;
 case 65:
-#line 319 "perly.y"
+#line 327 "perly.y"
 { utilize(yyvsp[-6].ival, yyvsp[-5].ival, yyvsp[-3].opval, yyvsp[-2].opval, yyvsp[-1].opval); }
 break;
 case 66:
-#line 323 "perly.y"
+#line 331 "perly.y"
 { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
 case 67:
-#line 325 "perly.y"
+#line 333 "perly.y"
 { yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
 case 69:
-#line 330 "perly.y"
+#line 338 "perly.y"
 { yyval.opval = yyvsp[-1].opval; }
 break;
 case 70:
-#line 332 "perly.y"
+#line 340 "perly.y"
 { yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
 case 72:
-#line 337 "perly.y"
+#line 345 "perly.y"
 { yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED,
 				prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); }
 break;
 case 73:
-#line 340 "perly.y"
+#line 348 "perly.y"
 { yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED,
 				prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); }
 break;
 case 74:
-#line 343 "perly.y"
+#line 351 "perly.y"
 { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
 				append_elem(OP_LIST,
 				    prepend_elem(OP_LIST, scalar(yyvsp[-5].opval), yyvsp[-1].opval),
 				    newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); }
 break;
 case 75:
-#line 348 "perly.y"
+#line 356 "perly.y"
 { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
 				append_elem(OP_LIST,
 				    prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval),
 				    newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); }
 break;
 case 76:
-#line 353 "perly.y"
+#line 361 "perly.y"
 { yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
 				append_elem(OP_LIST,
 				    prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval),
 				    newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); }
 break;
 case 77:
-#line 358 "perly.y"
+#line 366 "perly.y"
 { yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
 case 78:
-#line 360 "perly.y"
+#line 368 "perly.y"
 { yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
 break;
 case 79:
-#line 362 "perly.y"
+#line 370 "perly.y"
 { yyvsp[0].opval = newANONSUB(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
 case 80:
-#line 364 "perly.y"
+#line 372 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				 append_elem(OP_LIST,
 				   prepend_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval), yyvsp[-4].opval)); }
 break;
 case 83:
-#line 374 "perly.y"
+#line 382 "perly.y"
 { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); }
 break;
 case 84:
-#line 376 "perly.y"
+#line 384 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
 case 85:
-#line 378 "perly.y"
+#line 386 "perly.y"
 {   if (yyvsp[-1].ival != OP_REPEAT)
 				scalar(yyvsp[-2].opval);
 			    yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); }
 break;
 case 86:
-#line 382 "perly.y"
+#line 390 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
 case 87:
-#line 384 "perly.y"
+#line 392 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
 case 88:
-#line 386 "perly.y"
+#line 394 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
 case 89:
-#line 388 "perly.y"
+#line 396 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
 case 90:
-#line 390 "perly.y"
+#line 398 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
 case 91:
-#line 392 "perly.y"
+#line 400 "perly.y"
 { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
 break;
 case 92:
-#line 394 "perly.y"
+#line 402 "perly.y"
 { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));}
 break;
 case 93:
-#line 396 "perly.y"
+#line 404 "perly.y"
 { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
 case 94:
-#line 398 "perly.y"
+#line 406 "perly.y"
 { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
 case 95:
-#line 400 "perly.y"
+#line 408 "perly.y"
 { yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
 case 96:
-#line 402 "perly.y"
+#line 410 "perly.y"
 { yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); }
 break;
 case 97:
-#line 405 "perly.y"
+#line 413 "perly.y"
 { yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); }
 break;
 case 98:
-#line 407 "perly.y"
+#line 415 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 99:
-#line 409 "perly.y"
+#line 417 "perly.y"
 { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
 break;
 case 100:
-#line 411 "perly.y"
+#line 419 "perly.y"
 { yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));}
 break;
 case 101:
-#line 413 "perly.y"
+#line 421 "perly.y"
 { yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); }
 break;
 case 102:
-#line 415 "perly.y"
+#line 423 "perly.y"
 { yyval.opval = newUNOP(OP_POSTINC, 0,
 					mod(scalar(yyvsp[-1].opval), OP_POSTINC)); }
 break;
 case 103:
-#line 418 "perly.y"
+#line 426 "perly.y"
 { yyval.opval = newUNOP(OP_POSTDEC, 0,
 					mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); }
 break;
 case 104:
-#line 421 "perly.y"
+#line 429 "perly.y"
 { yyval.opval = newUNOP(OP_PREINC, 0,
 					mod(scalar(yyvsp[0].opval), OP_PREINC)); }
 break;
 case 105:
-#line 424 "perly.y"
+#line 432 "perly.y"
 { yyval.opval = newUNOP(OP_PREDEC, 0,
 					mod(scalar(yyvsp[0].opval), OP_PREDEC)); }
 break;
 case 106:
-#line 427 "perly.y"
+#line 435 "perly.y"
 { yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); }
 break;
 case 107:
-#line 429 "perly.y"
+#line 437 "perly.y"
 { yyval.opval = sawparens(yyvsp[-1].opval); }
 break;
 case 108:
-#line 431 "perly.y"
+#line 439 "perly.y"
 { yyval.opval = sawparens(newNULLLIST()); }
 break;
 case 109:
-#line 433 "perly.y"
+#line 441 "perly.y"
 { yyval.opval = newANONLIST(yyvsp[-1].opval); }
 break;
 case 110:
-#line 435 "perly.y"
+#line 443 "perly.y"
 { yyval.opval = newANONLIST(Nullop); }
 break;
 case 111:
-#line 437 "perly.y"
+#line 445 "perly.y"
 { yyval.opval = newANONHASH(yyvsp[-2].opval); }
 break;
 case 112:
-#line 439 "perly.y"
+#line 447 "perly.y"
 { yyval.opval = newANONHASH(Nullop); }
 break;
 case 113:
-#line 441 "perly.y"
+#line 449 "perly.y"
 { yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
 break;
 case 114:
-#line 443 "perly.y"
+#line 451 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 115:
-#line 445 "perly.y"
+#line 453 "perly.y"
 { yyval.opval = newBINOP(OP_GELEM, 0, yyvsp[-4].opval, scalar(yyvsp[-2].opval)); }
 break;
 case 116:
-#line 447 "perly.y"
+#line 455 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 117:
-#line 449 "perly.y"
+#line 457 "perly.y"
 { yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); }
 break;
 case 118:
-#line 451 "perly.y"
+#line 459 "perly.y"
 { yyval.opval = newBINOP(OP_AELEM, 0,
 					ref(newAVREF(yyvsp[-4].opval),OP_RV2AV),
 					scalar(yyvsp[-1].opval));}
 break;
 case 119:
-#line 455 "perly.y"
+#line 463 "perly.y"
 { assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0,
 					ref(newAVREF(yyvsp[-3].opval),OP_RV2AV),
 					scalar(yyvsp[-1].opval));}
 break;
 case 120:
-#line 459 "perly.y"
+#line 467 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 121:
-#line 461 "perly.y"
+#line 469 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 122:
-#line 463 "perly.y"
+#line 471 "perly.y"
 { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));}
 break;
 case 123:
-#line 465 "perly.y"
+#line 473 "perly.y"
 { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval));
 			    PL_expect = XOPERATOR; }
 break;
 case 124:
-#line 468 "perly.y"
+#line 476 "perly.y"
 { yyval.opval = newBINOP(OP_HELEM, 0,
 					ref(newHVREF(yyvsp[-5].opval),OP_RV2HV),
 					jmaybe(yyvsp[-2].opval));
 			    PL_expect = XOPERATOR; }
 break;
 case 125:
-#line 473 "perly.y"
+#line 481 "perly.y"
 { assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0,
 					ref(newHVREF(yyvsp[-4].opval),OP_RV2HV),
 					jmaybe(yyvsp[-2].opval));
 			    PL_expect = XOPERATOR; }
 break;
 case 126:
-#line 478 "perly.y"
+#line 486 "perly.y"
 { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); }
 break;
 case 127:
-#line 480 "perly.y"
+#line 488 "perly.y"
 { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); }
 break;
 case 128:
-#line 482 "perly.y"
+#line 490 "perly.y"
 { yyval.opval = prepend_elem(OP_ASLICE,
 				newOP(OP_PUSHMARK, 0),
 				    newLISTOP(OP_ASLICE, 0,
@@ -2075,7 +2077,7 @@ case 128:
 					ref(yyvsp[-3].opval, OP_ASLICE))); }
 break;
 case 129:
-#line 488 "perly.y"
+#line 496 "perly.y"
 { yyval.opval = prepend_elem(OP_HSLICE,
 				newOP(OP_PUSHMARK, 0),
 				    newLISTOP(OP_HSLICE, 0,
@@ -2084,37 +2086,37 @@ case 129:
 			    PL_expect = XOPERATOR; }
 break;
 case 130:
-#line 495 "perly.y"
+#line 503 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 131:
-#line 497 "perly.y"
+#line 505 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); }
 break;
 case 132:
-#line 499 "perly.y"
+#line 507 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); }
 break;
 case 133:
-#line 501 "perly.y"
+#line 509 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
 			    append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); }
 break;
 case 134:
-#line 504 "perly.y"
+#line 512 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
 			    append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
 break;
 case 135:
-#line 507 "perly.y"
+#line 515 "perly.y"
 { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
 break;
 case 136:
-#line 509 "perly.y"
+#line 517 "perly.y"
 { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); }
 break;
 case 137:
-#line 511 "perly.y"
+#line 519 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB,
 			    OPf_SPECIAL|OPf_STACKED,
 			    prepend_elem(OP_LIST,
@@ -2124,7 +2126,7 @@ case 137:
 				)),Nullop)); dep();}
 break;
 case 138:
-#line 519 "perly.y"
+#line 527 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB,
 			    OPf_SPECIAL|OPf_STACKED,
 			    append_elem(OP_LIST,
@@ -2135,161 +2137,161 @@ case 138:
 				)))); dep();}
 break;
 case 139:
-#line 528 "perly.y"
+#line 536 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
 			    prepend_elem(OP_LIST,
 				scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();}
 break;
 case 140:
-#line 532 "perly.y"
+#line 540 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
 			    prepend_elem(OP_LIST,
 				yyvsp[-1].opval,
 				scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();}
 break;
 case 141:
-#line 537 "perly.y"
+#line 545 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				   newCVREF(0, scalar(yyvsp[-3].opval))); }
 break;
 case 142:
-#line 540 "perly.y"
+#line 548 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				   append_elem(OP_LIST, yyvsp[-1].opval,
 				       newCVREF(0, scalar(yyvsp[-4].opval)))); }
 break;
 case 143:
-#line 544 "perly.y"
+#line 552 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
 			    PL_hints |= HINT_BLOCK_SCOPE; }
 break;
 case 144:
-#line 547 "perly.y"
+#line 555 "perly.y"
 { yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
 break;
 case 145:
-#line 549 "perly.y"
+#line 557 "perly.y"
 { yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
 break;
 case 146:
-#line 551 "perly.y"
+#line 559 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, 0); }
 break;
 case 147:
-#line 553 "perly.y"
+#line 561 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
 case 148:
-#line 555 "perly.y"
+#line 563 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
 break;
 case 149:
-#line 557 "perly.y"
+#line 565 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
 			    append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
 break;
 case 150:
-#line 560 "perly.y"
+#line 568 "perly.y"
 { yyval.opval = newOP(yyvsp[0].ival, 0); }
 break;
 case 151:
-#line 562 "perly.y"
+#line 570 "perly.y"
 { yyval.opval = newOP(yyvsp[-2].ival, 0); }
 break;
 case 152:
-#line 564 "perly.y"
+#line 572 "perly.y"
 { yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				scalar(yyvsp[0].opval)); }
 break;
 case 153:
-#line 567 "perly.y"
+#line 575 "perly.y"
 { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); }
 break;
 case 154:
-#line 569 "perly.y"
+#line 577 "perly.y"
 { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
 break;
 case 155:
-#line 571 "perly.y"
+#line 579 "perly.y"
 { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); }
 break;
 case 156:
-#line 573 "perly.y"
+#line 581 "perly.y"
 { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); }
 break;
 case 159:
-#line 579 "perly.y"
+#line 587 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 160:
-#line 581 "perly.y"
+#line 589 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 161:
-#line 585 "perly.y"
+#line 593 "perly.y"
 { yyval.opval = Nullop; }
 break;
 case 162:
-#line 587 "perly.y"
+#line 595 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
 case 163:
-#line 589 "perly.y"
+#line 597 "perly.y"
 { yyval.opval = yyvsp[-1].opval; }
 break;
 case 164:
-#line 592 "perly.y"
+#line 600 "perly.y"
 { yyval.ival = 0; }
 break;
 case 165:
-#line 593 "perly.y"
+#line 601 "perly.y"
 { yyval.ival = 1; }
 break;
 case 166:
-#line 597 "perly.y"
+#line 605 "perly.y"
 { PL_in_my = 0; yyval.opval = my(yyvsp[0].opval); }
 break;
 case 167:
-#line 601 "perly.y"
+#line 609 "perly.y"
 { yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
 break;
 case 168:
-#line 605 "perly.y"
+#line 613 "perly.y"
 { yyval.opval = newSVREF(yyvsp[0].opval); }
 break;
 case 169:
-#line 609 "perly.y"
+#line 617 "perly.y"
 { yyval.opval = newAVREF(yyvsp[0].opval); }
 break;
 case 170:
-#line 613 "perly.y"
+#line 621 "perly.y"
 { yyval.opval = newHVREF(yyvsp[0].opval); }
 break;
 case 171:
-#line 617 "perly.y"
+#line 625 "perly.y"
 { yyval.opval = newAVREF(yyvsp[0].opval); }
 break;
 case 172:
-#line 621 "perly.y"
+#line 629 "perly.y"
 { yyval.opval = newGVREF(0,yyvsp[0].opval); }
 break;
 case 173:
-#line 625 "perly.y"
+#line 633 "perly.y"
 { yyval.opval = scalar(yyvsp[0].opval); }
 break;
 case 174:
-#line 627 "perly.y"
+#line 635 "perly.y"
 { yyval.opval = scalar(yyvsp[0].opval);  }
 break;
 case 175:
-#line 629 "perly.y"
+#line 637 "perly.y"
 { yyval.opval = scope(yyvsp[0].opval); }
 break;
 case 176:
-#line 632 "perly.y"
+#line 640 "perly.y"
 { yyval.opval = yyvsp[0].opval; }
 break;
-#line 2266 "perly.c"
+#line 2270 "perly.c"
     }
     yyssp -= yym;
     yystate = *yyssp;
diff --git a/perly.h b/perly.h
index 9907727001..c1f7806e3f 100644
--- a/perly.h
+++ b/perly.h
@@ -63,4 +63,3 @@ typedef union {
     GV *gvval;
 } YYSTYPE;
 extern YYSTYPE yylval;
-extern YYSTYPE yylval;
diff --git a/perly.y b/perly.y
index f9c5f74c15..e016cf431d 100644
--- a/perly.y
+++ b/perly.y
@@ -26,6 +26,10 @@ dep(void)
 
 %start prog
 
+%{
+#ifndef OEMVS
+%}
+
 %union {
     I32	ival;
     char *pval;
@@ -33,6 +37,10 @@ dep(void)
     GV *gvval;
 }
 
+%{
+#endif /* OEMVS */
+%}
+
 %token <ival> '{' ')'
 
 %token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF
diff --git a/perly_c.diff b/perly_c.diff
index 0ee7cb2d7f..aa0555b034 100644
--- a/perly_c.diff
+++ b/perly_c.diff
@@ -1,92 +1,96 @@
-Index: perly.c
-*** perly.c.old	Wed Jun 10 03:48:43 1998
---- perly.c	Wed Jun 10 03:55:10 1998
+*** perly.c.orig	Tue Jul 28 15:02:41 1998
+--- perly.c	Tue Jul 28 15:14:54 1998
 ***************
-*** 7,10 ****
---- 7,18 ----
+*** 7,11 ****
+--- 7,19 ----
   #include "perl.h"
   
 + #ifdef PERL_OBJECT
-+ static void
+  static void
 + Dep(CPerlObj *pPerl)
 + {
 +     pPerl->deprecate("\"do\" to call subroutines");
 + }
 + #define dep() Dep(this)
 + #else
-  static void
++ static void
   dep(void)
+  {
 ***************
-*** 12,82 ****
+*** 12,86 ****
       deprecate("\"do\" to call subroutines");
   }
   
-! #line 29 "perly.y"
-! typedef union {
-!     I32	ival;
-!     char *pval;
-!     OP *opval;
-!     GV *gvval;
-! } YYSTYPE;
-! #line 23 "y.tab.c"
-! #define WORD 257
-! #define METHOD 258
-! #define FUNCMETH 259
-! #define THING 260
-! #define PMFUNC 261
-! #define PRIVATEREF 262
-! #define FUNC0SUB 263
-! #define UNIOPSUB 264
-! #define LSTOPSUB 265
-! #define LABEL 266
-! #define FORMAT 267
-! #define SUB 268
-! #define ANONSUB 269
-! #define PACKAGE 270
-! #define USE 271
-! #define WHILE 272
-! #define UNTIL 273
-! #define IF 274
-! #define UNLESS 275
-! #define ELSE 276
-! #define ELSIF 277
-! #define CONTINUE 278
-! #define FOR 279
-! #define LOOPEX 280
-! #define DOTDOT 281
-! #define FUNC0 282
-! #define FUNC1 283
-! #define FUNC 284
-! #define UNIOP 285
-! #define LSTOP 286
-! #define RELOP 287
-! #define EQOP 288
-! #define MULOP 289
-! #define ADDOP 290
-! #define DOLSHARP 291
-! #define DO 292
-! #define HASHBRACK 293
-! #define NOAMP 294
-! #define LOCAL 295
-! #define MY 296
-! #define OROP 297
-! #define ANDOP 298
-! #define NOTOP 299
-! #define ASSIGNOP 300
-! #define OROR 301
-! #define ANDAND 302
-! #define BITOROP 303
-! #define BITANDOP 304
-! #define SHIFTOP 305
-! #define MATCHOP 306
-! #define UMINUS 307
-! #define REFGEN 308
-! #define POWOP 309
-! #define PREINC 310
-! #define PREDEC 311
-! #define POSTINC 312
-! #define POSTDEC 313
-! #define ARROW 314
+  #line 30 "perly.y"
+- #ifndef OEMVS
+- #line 33 "perly.y"
+- typedef union {
+-     I32	ival;
+-     char *pval;
+-     OP *opval;
+-     GV *gvval;
+- } YYSTYPE;
+- #line 41 "perly.y"
+- #endif /* OEMVS */
+- #line 27 "y.tab.c"
+- #define WORD 257
+- #define METHOD 258
+- #define FUNCMETH 259
+- #define THING 260
+- #define PMFUNC 261
+- #define PRIVATEREF 262
+- #define FUNC0SUB 263
+- #define UNIOPSUB 264
+- #define LSTOPSUB 265
+- #define LABEL 266
+- #define FORMAT 267
+- #define SUB 268
+- #define ANONSUB 269
+- #define PACKAGE 270
+- #define USE 271
+- #define WHILE 272
+- #define UNTIL 273
+- #define IF 274
+- #define UNLESS 275
+- #define ELSE 276
+- #define ELSIF 277
+- #define CONTINUE 278
+- #define FOR 279
+- #define LOOPEX 280
+- #define DOTDOT 281
+- #define FUNC0 282
+- #define FUNC1 283
+- #define FUNC 284
+- #define UNIOP 285
+- #define LSTOP 286
+- #define RELOP 287
+- #define EQOP 288
+- #define MULOP 289
+- #define ADDOP 290
+- #define DOLSHARP 291
+- #define DO 292
+- #define HASHBRACK 293
+- #define NOAMP 294
+- #define LOCAL 295
+- #define MY 296
+- #define OROP 297
+- #define ANDOP 298
+- #define NOTOP 299
+- #define ASSIGNOP 300
+- #define OROR 301
+- #define ANDAND 302
+- #define BITOROP 303
+- #define BITANDOP 304
+- #define SHIFTOP 305
+- #define MATCHOP 306
+- #define UMINUS 307
+- #define REFGEN 308
+- #define POWOP 309
+- #define PREINC 310
+- #define PREDEC 311
+- #define POSTINC 312
+- #define POSTDEC 313
+- #define ARROW 314
   #define YYERRCODE 256
   short yylhs[] = {                                        -1,
 --- 20,26 ----
@@ -94,23 +98,19 @@ Index: perly.c
   }
 + #endif
   
-! #line 16 "perly.c"
+  #line 30 "perly.y"
   #define YYERRCODE 256
   short yylhs[] = {                                        -1,
 ***************
-*** 1337,1361 ****
-  int yyerrflag;
-  int yychar;
-- short *yyssp;
-- YYSTYPE *yyvsp;
+*** 1345,1365 ****
   YYSTYPE yyval;
   YYSTYPE yylval;
 - short yyss[YYSTACKSIZE];
 - YYSTYPE yyvs[YYSTACKSIZE];
 - #define yystacksize YYSTACKSIZE
-  #line 635 "perly.y"
+  #line 643 "perly.y"
    /* PROGRAM */
-! #line 1349 "y.tab.c"
+! #line 1353 "y.tab.c"
   #define YYABORT goto yyabort
   #define YYACCEPT goto yyaccept
   #define YYERROR goto yyerrlab
@@ -124,14 +124,12 @@ Index: perly.c
   
       if (yys = getenv("YYDEBUG"))
       {
---- 1281,1347 ----
-  int yyerrflag;
-  int yychar;
+--- 1285,1349 ----
   YYSTYPE yyval;
   YYSTYPE yylval;
-  #line 635 "perly.y"
+  #line 643 "perly.y"
    /* PROGRAM */
-! #line 1349 "perly.c"
+! #line 1353 "perly.c"
   #define YYABORT goto yyabort
   #define YYACCEPT goto yyaccept
   #define YYERROR goto yyerrlab
@@ -178,7 +176,7 @@ Index: perly.c
       extern char *getenv();
 + #endif
 + #endif
-+ 
+  
 +     struct ysv *ysave;
 +     New(73, ysave, 1, struct ysv);
 +     SAVEDESTRUCTOR(yydestruct, ysave);
@@ -188,13 +186,13 @@ Index: perly.c
 +     ysave->oldyychar	= yychar;
 +     ysave->oldyyval	= yyval;
 +     ysave->oldyylval	= yylval;
-  
++ 
 + #if YYDEBUG
       if (yys = getenv("YYDEBUG"))
       {
 ***************
-*** 1370,1373 ****
---- 1356,1369 ----
+*** 1374,1377 ****
+--- 1358,1371 ----
       yychar = (-1);
   
 +     /*
@@ -210,36 +208,39 @@ Index: perly.c
       yyssp = yyss;
       yyvsp = yyvs;
 ***************
-*** 1385,1389 ****
+*** 1389,1393 ****
               if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
               if (!yys) yys = "illegal-symbol";
 !             printf("yydebug: state %d, reading %d (%s)\n", yystate,
                       yychar, yys);
           }
---- 1381,1385 ----
+--- 1383,1387 ----
               if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
               if (!yys) yys = "illegal-symbol";
 !             PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", yystate,
                       yychar, yys);
           }
 ***************
-*** 1395,1404 ****
+*** 1399,1403 ****
   #if YYDEBUG
           if (yydebug)
 !             printf("yydebug: state %d, shifting to state %d\n",
                       yystate, yytable[yyn]);
   #endif
-          if (yyssp >= yyss + yystacksize - 1)
-          {
-!             goto yyoverflow;
-          }
-          *++yyssp = yystate = yytable[yyn];
---- 1391,1414 ----
+--- 1393,1397 ----
   #if YYDEBUG
           if (yydebug)
 !             PerlIO_printf(Perl_debug_log, "yydebug: state %d, shifting to state %d\n",
                       yystate, yytable[yyn]);
   #endif
+***************
+*** 1404,1408 ****
+          if (yyssp >= yyss + yystacksize - 1)
+          {
+!             goto yyoverflow;
+          }
+          *++yyssp = yystate = yytable[yyn];
+--- 1398,1416 ----
           if (yyssp >= yyss + yystacksize - 1)
           {
 ! 	    /*
@@ -260,7 +261,7 @@ Index: perly.c
           }
           *++yyssp = yystate = yytable[yyn];
 ***************
-*** 1436,1445 ****
+*** 1440,1449 ****
   #if YYDEBUG
                   if (yydebug)
 !                     printf("yydebug: state %d, error recovery shifting\
@@ -271,7 +272,7 @@ Index: perly.c
 !                     goto yyoverflow;
                   }
                   *++yyssp = yystate = yytable[yyn];
---- 1446,1470 ----
+--- 1448,1472 ----
   #if YYDEBUG
                   if (yydebug)
 !                     PerlIO_printf(Perl_debug_log,
@@ -298,14 +299,14 @@ Index: perly.c
                   }
                   *++yyssp = yystate = yytable[yyn];
 ***************
-*** 1451,1456 ****
+*** 1455,1460 ****
   #if YYDEBUG
                   if (yydebug)
 !                     printf("yydebug: error recovery discarding state %d\n",
 !                             *yyssp);
   #endif
                   if (yyssp <= yyss) goto yyabort;
---- 1476,1482 ----
+--- 1478,1484 ----
   #if YYDEBUG
                   if (yydebug)
 !                     PerlIO_printf(Perl_debug_log,
@@ -314,14 +315,14 @@ Index: perly.c
   #endif
                   if (yyssp <= yyss) goto yyabort;
 ***************
-*** 1469,1474 ****
+*** 1473,1478 ****
               if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
               if (!yys) yys = "illegal-symbol";
 !             printf("yydebug: state %d, error recovery discards token %d (%s)\n",
 !                     yystate, yychar, yys);
           }
   #endif
---- 1495,1501 ----
+--- 1497,1503 ----
               if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
               if (!yys) yys = "illegal-symbol";
 !             PerlIO_printf(Perl_debug_log,
@@ -330,40 +331,40 @@ Index: perly.c
           }
   #endif
 ***************
-*** 1479,1483 ****
+*** 1483,1487 ****
   #if YYDEBUG
       if (yydebug)
 !         printf("yydebug: state %d, reducing by rule %d (%s)\n",
                   yystate, yyn, yyrule[yyn]);
   #endif
---- 1506,1510 ----
+--- 1508,1512 ----
   #if YYDEBUG
       if (yydebug)
 !         PerlIO_printf(Perl_debug_log, "yydebug: state %d, reducing by rule %d (%s)\n",
                   yystate, yyn, yyrule[yyn]);
   #endif
 ***************
-*** 2263,2267 ****
+*** 2267,2271 ****
   { yyval.opval = yyvsp[0].opval; }
   break;
-! #line 2266 "y.tab.c"
+! #line 2270 "y.tab.c"
       }
       yyssp -= yym;
---- 2290,2294 ----
+--- 2292,2296 ----
   { yyval.opval = yyvsp[0].opval; }
   break;
-! #line 2266 "perly.c"
+! #line 2270 "perly.c"
       }
       yyssp -= yym;
 ***************
-*** 2273,2278 ****
+*** 2277,2282 ****
   #if YYDEBUG
           if (yydebug)
 !             printf("yydebug: after reduction, shifting from state 0 to\
 !  state %d\n", YYFINAL);
   #endif
           yystate = YYFINAL;
---- 2300,2306 ----
+--- 2302,2308 ----
   #if YYDEBUG
           if (yydebug)
 !             PerlIO_printf(Perl_debug_log,
@@ -372,20 +373,20 @@ Index: perly.c
   #endif
           yystate = YYFINAL;
 ***************
-*** 2288,2292 ****
+*** 2292,2296 ****
                   if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
                   if (!yys) yys = "illegal-symbol";
 !                 printf("yydebug: state %d, reading %d (%s)\n",
                           YYFINAL, yychar, yys);
               }
---- 2316,2320 ----
+--- 2318,2322 ----
                   if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
                   if (!yys) yys = "illegal-symbol";
 !                 PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n",
                           YYFINAL, yychar, yys);
               }
 ***************
-*** 2303,2312 ****
+*** 2307,2316 ****
   #if YYDEBUG
       if (yydebug)
 !         printf("yydebug: after reduction, shifting from state %d \
@@ -396,7 +397,7 @@ Index: perly.c
 !         goto yyoverflow;
       }
       *++yyssp = yystate;
---- 2331,2355 ----
+--- 2333,2357 ----
   #if YYDEBUG
       if (yydebug)
 !         PerlIO_printf(Perl_debug_log,
@@ -423,7 +424,7 @@ Index: perly.c
       }
       *++yyssp = yystate;
 ***************
-*** 2314,2321 ****
+*** 2318,2325 ****
       goto yyloop;
   yyoverflow:
 !     yyerror("yacc stack overflow");
@@ -432,7 +433,7 @@ Index: perly.c
   yyaccept:
 !     return (0);
   }
---- 2357,2364 ----
+--- 2359,2366 ----
       goto yyloop;
   yyoverflow:
 !     yyerror("Out of memory for yacc stack");
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 2816665ced..a3c6b6cc05 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -502,6 +502,8 @@ DOS is now supported under the DJGPP tools.  See L<README.dos>.
 
 MPE/iX is now supported.  See L<README.mpeix>.
 
+MVS (OS390) is now supported.  See L<README.os390>.
+
 =head2 Changes in existing support
 
 Win32 support has been vastly enhanced.  Support for Perl Object, a C++
diff --git a/pod/perlport.pod b/pod/perlport.pod
index 83654689a6..d4c4db8c27 100644
--- a/pod/perlport.pod
+++ b/pod/perlport.pod
@@ -681,13 +681,14 @@ general usage issues for all EBCDIC Perls.  Send a message body of
 
 =head2 Other perls
 
-Perl has been ported to a variety of platforms that do not fit into any of
-the above categories.  Some, such as AmigaOS, BeOS, QNX, and Plan 9, have
-been well integrated into the standard Perl source code kit.  You may need
-to see the F<ports/> directory on CPAN for information, and possibly
-binaries, for the likes of: acorn, aos, atari, lynxos, HP-MPE/iX, riscos,
-Tandem Guardian, vos, I<etc.> (yes we know that some of these OSes may fall
-under the Unix category but we are not a standards body.)
+Perl has been ported to a variety of platforms that do not fit into
+any of the above categories.  Some, such as AmigaOS, BeOS, MPE/iX,
+OS/390 (MVS), QNX, and Plan 9, have been well integrated into the
+standard Perl source code kit.  You may need to see the F<ports/>
+directory on CPAN for information, and possibly binaries, for the
+likes of: acorn, aos, atari, lynxos, riscos, Tandem Guardian, vos,
+I<etc.> (yes we know that some of these OSes may fall under the Unix
+category but we are not a standards body.)
 
 See also:
 
diff --git a/pp.c b/pp.c
index 4eb8f2f09f..35c76bc44f 100644
--- a/pp.c
+++ b/pp.c
@@ -2908,6 +2908,20 @@ mul128(SV *sv, U8 m)
 
 /* Explosives and implosives. */
 
+static const char uuemap[] =
+    "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
+static char uudmap[256];        /* Initialised on first use */
+#if 'I' == 73 && 'J' == 74
+/* On an ASCII/ISO kind of system */
+#define ISUUCHAR(ch)    ((ch) > ' ' && (ch) < 'a')
+#else
+/*
+  Some other sort of character set - use memchr() so we don't match
+  the null byte.
+ */
+#define ISUUCHAR(ch)    (memchr(uuemap, (ch), sizeof(uuemap)-1))
+#endif
+
 PP(pp_unpack)
 {
     djSP;
@@ -3534,31 +3548,48 @@ PP(pp_unpack)
 	    }
 	    break;
 	case 'u':
+	    /* MKS:
+	     * Initialise the decode mapping.  By using a table driven
+             * algorithm, the code will be character-set independent
+             * (and just as fast as doing character arithmetic)
+             */
+            if (uudmap['M'] == 0) {
+                int i;
+ 
+                for (i = 0; i < sizeof(uuemap); i += 1)
+                    uudmap[uuemap[i]] = i;
+                /*
+                 * Because ' ' and '`' map to the same value,
+                 * we need to decode them both the same.
+                 */
+                uudmap[' '] = 0;
+            }
+
 	    along = (strend - s) * 3 / 4;
 	    sv = NEWSV(42, along);
 	    if (along)
 		SvPOK_on(sv);
-	    while (s < strend && *s > ' ' && *s < 'a') {
+	    while (s < strend && *s > ' ' && ISUUCHAR(*s)) {
 		I32 a, b, c, d;
 		char hunk[4];
 
 		hunk[3] = '\0';
 		len = (*s++ - ' ') & 077;
 		while (len > 0) {
-		    if (s < strend && *s >= ' ')
-			a = (*s++ - ' ') & 077;
-		    else
-			a = 0;
-		    if (s < strend && *s >= ' ')
-			b = (*s++ - ' ') & 077;
-		    else
-			b = 0;
-		    if (s < strend && *s >= ' ')
-			c = (*s++ - ' ') & 077;
-		    else
-			c = 0;
-		    if (s < strend && *s >= ' ')
-			d = (*s++ - ' ') & 077;
+		    if (s < strend && ISUUCHAR(*s))
+			a = uudmap[*s++] & 077;
+ 		    else
+ 			a = 0;
+		    if (s < strend && ISUUCHAR(*s))
+			b = uudmap[*s++] & 077;
+ 		    else
+ 			b = 0;
+		    if (s < strend && ISUUCHAR(*s))
+			c = uudmap[*s++] & 077;
+ 		    else
+ 			c = 0;
+		    if (s < strend && ISUUCHAR(*s))
+			d = uudmap[*s++] & 077;
 		    else
 			d = 0;
 		    hunk[0] = (a << 2) | (b >> 4);
@@ -3619,22 +3650,18 @@ doencodes(register SV *sv, register char *s, register I32 len)
 {
     char hunk[5];
 
-    *hunk = len + ' ';
+    *hunk = uuemap[len];
     sv_catpvn(sv, hunk, 1);
     hunk[4] = '\0';
     while (len > 0) {
-	hunk[0] = ' ' + (077 & (*s >> 2));
-	hunk[1] = ' ' + (077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)));
-	hunk[2] = ' ' + (077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)));
-	hunk[3] = ' ' + (077 & (s[2] & 077));
+	hunk[0] = uuemap[(077 & (*s >> 2))];
+	hunk[1] = uuemap[(077 & ((*s << 4) & 060 | (s[1] >> 4) & 017))];
+	hunk[2] = uuemap[(077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03))];
+	hunk[3] = uuemap[(077 & (s[2] & 077))];
 	sv_catpvn(sv, hunk, 4);
 	s += 3;
 	len -= 3;
     }
-    for (s = SvPVX(sv); *s; s++) {
-	if (*s == ' ')
-	    *s = '`';
-    }
     sv_catpvn(sv, "\n", 1);
 }
 
diff --git a/pp_ctl.c b/pp_ctl.c
index 8d4b7f71ab..7a1ad799b8 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -436,15 +436,13 @@ PP(pp_formline)
 	    arg = itemsize;
 	    s = item;
 	    while (arg--) {
-#if 'z' - 'a' != 25
+#ifdef EBCDIC
 		int ch = *t++ = *s++;
-		if (!iscntrl(ch))
-		    t[-1] = ' ';
+		if (iscntrl(ch))
 #else
 		if ( !((*t++ = *s++) & ~31) )
-		    t[-1] = ' ';
 #endif
-
+		    t[-1] = ' ';
 	    }
 	    break;
 
diff --git a/pp_hot.c b/pp_hot.c
index 29f654219a..9b68c1caa7 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -21,6 +21,12 @@
 #ifdef I_UNISTD
 #include <unistd.h>
 #endif
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
 
 /* Hot code. */
 
@@ -1063,7 +1069,7 @@ do_readline(void)
 		    IoFLAGS(io) &= ~IOf_START;
 		    IoLINES(io) = 0;
 		    if (av_len(GvAVn(PL_last_in_gv)) < 0) {
-			do_open(PL_last_in_gv,"-",1,FALSE,0,0,Nullfp);
+			do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp);
 			sv_setpvn(GvSV(PL_last_in_gv), "-", 1);
 			SvSETMAGIC(GvSV(PL_last_in_gv));
 			fp = IoIFP(io);
@@ -1197,7 +1203,7 @@ do_readline(void)
 #endif /* !CSH */
 #endif /* !DOSISH */
 		(void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
-			      FALSE, 0, 0, Nullfp);
+			      FALSE, O_RDONLY, 0, Nullfp);
 		fp = IoIFP(io);
 #endif /* !VMS */
 		LEAVE;
diff --git a/pp_sys.c b/pp_sys.c
index 5e570754c5..2630e050b8 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -382,7 +382,7 @@ PP(pp_open)
     if (GvIOp(gv))
 	IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
     tmps = SvPV(sv, len);
-    if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp))
+    if (do_open(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp))
 	PUSHi( (I32)PL_forkprocess );
     else if (PL_forkprocess == 0)		/* we are a new child */
 	PUSHi(0);
@@ -2608,12 +2608,17 @@ PP(pp_fttext)
 	    odd += len;
 	    break;
 	}
+#ifdef EBCDIC
+        else if (!(isPRINT(*s) || isSPACE(*s))) 
+            odd++;
+#else
 	else if (*s & 128)
 	    odd++;
 	else if (*s < 32 &&
 	  *s != '\n' && *s != '\r' && *s != '\b' &&
 	  *s != '\t' && *s != '\f' && *s != 27)
 	    odd++;
+#endif
     }
 
     if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
diff --git a/sv.c b/sv.c
index d669ee71a6..a53e76979e 100644
--- a/sv.c
+++ b/sv.c
@@ -3540,10 +3540,24 @@ sv_inc(register SV *sv)
 	    *(d--) = '0';
 	}
 	else {
+#ifdef EBCDIC
+	    /* MKS: The original code here died if letters weren't consecutive.
+	     * at least it didn't have to worry about non-C locales.  The
+	     * new code assumes that ('z'-'a')==('Z'-'A'), letters are
+	     * arranged in order (although not consecutively) and that only 
+	     * [A-Za-z] are accepted by isALPHA in the C locale.
+	     */
+	    if (*d != 'z' && *d != 'Z') {
+		do { ++*d; } while (!isALPHA(*d));
+		return;
+	    }
+	    *(d--) -= 'z' - 'a';
+#else
 	    ++*d;
 	    if (isALPHA(*d))
 		return;
 	    *(d--) -= 'z' - 'a' + 1;
+#endif
 	}
     }
     /* oh,oh, the number grew */
diff --git a/t/base/term.t b/t/base/term.t
index 782ad397d3..e96313dec5 100755
--- a/t/base/term.t
+++ b/t/base/term.t
@@ -2,12 +2,22 @@
 
 # $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:07 $
 
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Config;
+
 print "1..7\n";
 
 # check "" interpretation
 
 $x = "\n";
-if ($x eq chr(10)) {print "ok 1\n";} else {print "not ok 1\n";}
+# 10 is ASCII/Iso Latin, 21 is EBCDIC.
+if ($x eq chr(10) ||
+    ($Config{ebcdic} eq 'define' && $x eq chr(21))) {print "ok 1\n";}
+else {print "not ok 1\n";}
 
 # check `` processing
 
diff --git a/t/comp/package.t b/t/comp/package.t
index cef02c5cb4..d7d19ae882 100755
--- a/t/comp/package.t
+++ b/t/comp/package.t
@@ -23,7 +23,11 @@ $main = join(':', sort(keys %main::));
 $xyz = join(':', sort(keys %xyz::));
 $ABC = join(':', sort(keys %ABC::));
 
-print $xyz eq 'ABC:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n";
+if ('a' lt 'A') {
+    print $xyz eq 'bar:main:xyz:ABC' ? "ok 1\n" : "not ok 1 '$xyz'\n";
+} else {
+    print $xyz eq 'ABC:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n";
+}    
 print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n";
 print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
 
diff --git a/t/comp/require.t b/t/comp/require.t
index bae0712dfa..819c7774b2 100755
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -25,7 +25,7 @@ print "ok ",$i++,"\n";
 
 # compile-time failure in require
 do_require "1)\n";
-print "# $@\nnot " unless $@ =~ /syntax error/;
+print "# $@\nnot " unless $@ =~ /syntax error/i;
 print "ok ",$i++,"\n";
 
 # successful require
diff --git a/t/lib/bigintpm.t b/t/lib/bigintpm.t
index 4357975f2b..e7cac26323 100755
--- a/t/lib/bigintpm.t
+++ b/t/lib/bigintpm.t
@@ -5,7 +5,6 @@ BEGIN {
     @INC = '../lib';
 }
 
-use Config;
 use Math::BigInt;
 
 $test = 0;
diff --git a/t/lib/cgi-html.t b/t/lib/cgi-html.t
index d7f3ffb4aa..16aa824c51 100755
--- a/t/lib/cgi-html.t
+++ b/t/lib/cgi-html.t
@@ -9,7 +9,8 @@ BEGIN {
 }
 
 BEGIN {$| = 1; print "1..17\n"; }
-BEGIN {$eol = $^O eq 'VMS' ? "\n" : "\cM\cJ";}
+BEGIN {$eol = $^O eq 'VMS' ? "\n" : "\cM\cJ";
+       $eol = "\r\n" if $^O eq 'os390'; }
 END {print "not ok 1\n" unless $loaded;}
 use CGI (':standard','-no_debug');
 $loaded = 1;
diff --git a/t/lib/filehand.t b/t/lib/filehand.t
index 08cae71872..b8ec95f320 100755
--- a/t/lib/filehand.t
+++ b/t/lib/filehand.t
@@ -31,7 +31,7 @@ $buffer = <$fh>;
 print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
 
 
-ungetc $fh 65;
+ungetc $fh ord 'A';
 CORE::read($fh, $buf,1);
 print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
 
diff --git a/t/lib/ph.t b/t/lib/ph.t
index d0a48f6c51..de27dee5e2 100755
--- a/t/lib/ph.t
+++ b/t/lib/ph.t
@@ -9,8 +9,6 @@ BEGIN {
     @INC = '../lib';
 }
 
-use Config;
-
 # All the constants which Socket.pm tries to make available:
 my @possibly_defined = qw(
     INADDR_ANY INADDR_LOOPBACK INADDR_NONE AF_802 AF_APPLETALK AF_CCITT
diff --git a/t/op/auto.t b/t/op/auto.t
index 93a42f8472..2eb0097650 100755
--- a/t/op/auto.t
+++ b/t/op/auto.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: auto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:39 $
 
-print "1..34\n";
+print "1..37\n";
 
 $x = 10000;
 if (0 + ++$x - 1 == 10000) { print "ok 1\n";} else {print "not ok 1\n";}
@@ -46,3 +46,7 @@ if (++($foo = '99') eq '100') {print "ok 31\n";} else {print "not ok 31\n";}
 if (++($foo = 'a0') eq 'a1') {print "ok 32\n";} else {print "not ok 32\n";}
 if (++($foo = 'Az') eq 'Ba') {print "ok 33\n";} else {print "not ok 33\n";}
 if (++($foo = 'zz') eq 'aaa') {print "ok 34\n";} else {print "not ok 34\n";}
+if (++($foo = 'A99') eq 'B00') {print "ok 35\n";} else {print "not ok 35\n";}
+# EBCDIC guards: i and j, r and s, are not contiguous.
+if (++($foo = 'zi') eq 'zj') {print "ok 36\n";} else {print "not ok 36\n";}
+if (++($foo = 'zr') eq 'zs') {print "ok 37\n";} else {print "not ok 37\n";}
diff --git a/t/op/bop.t b/t/op/bop.t
index 0c55029b93..b247341417 100755
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -42,14 +42,23 @@ print ((($cusp >> 1) == ($cusp / 2) &&
 	do { use integer; $cusp >> 1 } == -($cusp / 2))
        ? "ok 12\n" : "not ok 12\n");
 
+$Aaz = chr(ord("A") & ord("z"));
+$Aoz = chr(ord("A") | ord("z"));
+$Axz = chr(ord("A") ^ ord("z"));
+
 # short strings
-print (("AAAAA" & "zzzzz") eq '@@@@@' ? "ok 13\n" : "not ok 13\n");
-print (("AAAAA" | "zzzzz") eq '{{{{{' ? "ok 14\n" : "not ok 14\n");
-print (("AAAAA" ^ "zzzzz") eq ';;;;;' ? "ok 15\n" : "not ok 15\n");
+print (("AAAAA" & "zzzzz") eq ($Aaz x 5) ? "ok 13\n" : "not ok 13\n");
+print (("AAAAA" | "zzzzz") eq ($Aoz x 5) ? "ok 14\n" : "not ok 14\n");
+print (("AAAAA" ^ "zzzzz") eq ($Axz x 5) ? "ok 15\n" : "not ok 15\n");
 
 # long strings
 $foo = "A" x 150;
 $bar = "z" x 75;
-print (($foo & $bar) eq ('@'x75 ) ? "ok 16\n" : "not ok 16\n");
-print (($foo | $bar) eq ('{'x75 . 'A'x75) ? "ok 17\n" : "not ok 17\n");
-print (($foo ^ $bar) eq (';'x75 . 'A'x75) ? "ok 18\n" : "not ok 18\n");
+$zap = "A" x 75;
+# & truncates
+print (($foo & $bar) eq ($Aaz x 75 ) ? "ok 16\n" : "not ok 16\n");
+# | does not truncate
+print (($foo | $bar) eq ($Aoz x 75 . $zap) ? "ok 17\n" : "not ok 17\n");
+# ^ does not truncate
+print (($foo ^ $bar) eq ($Axz x 75 . $zap) ? "ok 18\n" : "not ok 18\n");
+
diff --git a/t/op/each.t b/t/op/each.t
index 420fdc09c3..9063c2c3ed 100755
--- a/t/op/each.t
+++ b/t/op/each.t
@@ -43,7 +43,8 @@ if ($#keys == 29 && $#values == 29) {print "ok 1\n";} else {print "not ok 1\n";}
 $i = 0;		# stop -w complaints
 
 while (($key,$value) = each(%h)) {
-    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+    if ($key eq $keys[$i] && $value eq $values[$i]
+        && (('a' lt 'A' && $key lt $value) || $key gt $value)) {
 	$key =~ y/a-z/A-Z/;
 	$i++ if $key eq $value;
     }
diff --git a/t/op/magic.t b/t/op/magic.t
index 61e4522913..7f08e06f85 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -135,6 +135,12 @@ __END__
 :endofperl
 EOT
     }
+    if ($^O eq 'os390') {  # no shebang
+	$headmaybe = <<EOH ;
+    eval 'exec ./perl -S \$0 \${1+"\$\@"}'
+        if 0;
+EOH
+    }
     $s1 = $s2 = "\$^X is $perl, \$0 is $script\n";
     ok 19, open(SCRIPT, ">$script"), $!;
     ok 20, print(SCRIPT $headmaybe . <<EOB . <<'EOF' . $tailmaybe), $!;
diff --git a/t/op/misc.t b/t/op/misc.t
index 449d87cea1..7292ffebd4 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -36,6 +36,7 @@ for (@prgs){
     $status = $?;
     $results = `$CAT $tmpfile`;
     $results =~ s/\n+$//;
+    $results =~ s/syntax error/syntax error/i;
     $expected =~ s/\n+$//;
     if ( $results ne $expected){
 	print STDERR "PROG: $switch\n$prog\n";
diff --git a/t/op/ord.t b/t/op/ord.t
index 37128382d8..ba943f4e8c 100755
--- a/t/op/ord.t
+++ b/t/op/ord.t
@@ -6,11 +6,13 @@ print "1..3\n";
 
 # compile time evaluation
 
-if (ord('A') == 65) {print "ok 1\n";} else {print "not ok 1\n";}
+# 65	ASCII
+# 193	EBCDIC
+if (ord('A') == 65 || ord('A') == 193) {print "ok 1\n";} else {print "not ok 1\n";}
 
 # run time evaluation
 
 $x = 'ABC';
-if (ord($x) == 65) {print "ok 2\n";} else {print "not ok 2\n";}
+if (ord($x) == 65 || ord($x) == 193) {print "ok 2\n";} else {print "not ok 2\n";}
 
-if (chr 65 == A) {print "ok 3\n";} else {print "not ok 3\n";}
+if (chr 65 == 'A' || chr 193 == 'A') {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/t/op/pack.t b/t/op/pack.t
index b8aece6b6b..02efb66717 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $
 
-print "1..56\n";
+print "1..58\n";
 
 $format = "c2 x5 C C x s d i l a6";
 # Need the expression in here to force ary[5] to be numeric.  This avoids
@@ -30,7 +30,10 @@ print +($x = unpack("%32b69", "\001\002\004\010\020\040\100\200\017")) == 12
 print +($x = unpack("%32B69", "\001\002\004\010\020\040\100\200\017")) == 9
 	? "ok 6\n" : "not ok 6 $x\n";
 
-print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == 129
+my $sum = 129; # ASCII
+$sum = 103 if ($^O eq 'os390'); # An EBCDIC variant.
+
+print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == $sum
 	? "ok 7\n" : "not ok 7 $x\n";
 
 open(BIN, "./perl") || open(BIN, "./perl.exe") 
@@ -154,3 +157,22 @@ foreach my $t (@templates) {
       unless @t == 2 and (($t[0] == 12 and $t[1] == 34) or ($t =~ /[nv]/i));
     print "ok ", $test++, "\n";
 }
+
+# 57..58: uuencode/decode
+
+$in = join "", map { chr } 0..255;
+$uu = <<'EOUU';
+M``$"`P0%!@<("0H+#`T.#Q`1$A,4%187&!D:&QP='A\@(2(C)"4F)R@I*BLL
+M+2XO,#$R,S0U-C<X.3H[/#T^/T!!0D-$149'2$E*2TQ-3D]045)35%565UA9
+M6EM<75Y?8&%B8V1E9F=H:6IK;&UN;W!Q<G-T=79W>'EZ>WQ]?G^`@8*#A(6&
+MAXB)BHN,C8Z/D)&2DY25EI>8F9J;G)V>GZ"AHJ.DI::GJ*FJJZRMKJ^PL;*S
+MM+6VM[BYNKN\O;Z_P,'"P\3%QL?(R<K+S,W.S]#1TM/4U=;7V-G:V]S=WM_@
+?X>+CY.7FY^CIZNOL[>[O\/'R\_3U]O?X^?K[_/W^_P``
+EOUU
+
+print "not " unless pack('u', $in) eq $uu;
+print "ok ", $test++, "\n";
+
+print "not " unless unpack('u', $uu) eq $in;
+print "ok ", $test++, "\n";
+
diff --git a/t/op/quotemeta.t b/t/op/quotemeta.t
index 20dd312b31..913e07cdd6 100755
--- a/t/op/quotemeta.t
+++ b/t/op/quotemeta.t
@@ -1,14 +1,26 @@
 #!./perl
+
 print "1..15\n";
 
-$_=join "", map chr($_), 32..127;
+if ($^O eq 'os390') { # An EBCDIC variant.
+    $_=join "", map chr($_), 129..233;
+
+    # 105 characters - 52 letters = 53 backslashes
+    # 105 characters + 53 backslashes = 158 characters
+    $_=quotemeta $_;
+    if ( length == 158 ){print "ok 1\n"} else {print "not ok 1\n"}
+    # 104 non-backslash characters
+    if (tr/\\//cd == 104){print "ok 2\n"} else {print "not ok 2\n"}
+} else { # some ASCII descendant, then.
+    $_=join "", map chr($_), 32..127;
 
-# 96 characters - 52 letters - 10 digits - 1 underscore = 33 backslashes
-# 96 characters + 33 backslashes = 129 characters
-$_=quotemeta $_;
-if ( length == 129 ){print "ok 1\n"} else {print "not ok 1\n"}
-# 95 non-backslash characters
-if (tr/\\//cd == 95){print "ok 2\n"} else {print "not ok 2\n"}
+    # 96 characters - 52 letters - 10 digits - 1 underscore = 33 backslashes
+    # 96 characters + 33 backslashes = 129 characters
+    $_=quotemeta $_;
+    if ( length == 129 ){print "ok 1\n"} else {print "not ok 1\n"}
+    # 95 non-backslash characters
+    if (tr/\\//cd == 95){print "ok 2\n"} else {print "not ok 2\n"}
+}
 
 if (length quotemeta "" == 0){print "ok 3\n"} else {print "not ok 3\n"}
 
diff --git a/t/op/re_tests b/t/op/re_tests
index 7ac20c3852..a5295f5aae 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -151,8 +151,8 @@ a[bcd]+dcdcde	adcdcde	n	-	-
 (bc+d$|ef*g.|h?i(j|k))	reffgz	y	$&-$1-$2	effgz-effgz-
 ((((((((((a))))))))))	a	y	$10	a
 ((((((((((a))))))))))\10	aa	y	$&	aa
-((((((((((a))))))))))\41	aa	n	-	-
-((((((((((a))))))))))\41	a!	y	$&	a!
+((((((((((a))))))))))${bang}	aa	n	-	-
+((((((((((a))))))))))${bang}	a!	y	$&	a!
 (((((((((a)))))))))	a	y	$&	a
 multiple words of text	uh-uh	n	-	-
 multiple words	multiple words, yeah	y	$&	multiple words
@@ -291,8 +291,8 @@ a[-]?c	ac	y	$&	ac
 '(bc+d$|ef*g.|h?i(j|k))'i	REFFGZ	y	$&-$1-$2	EFFGZ-EFFGZ-
 '((((((((((a))))))))))'i	A	y	$10	A
 '((((((((((a))))))))))\10'i	AA	y	$&	AA
-'((((((((((a))))))))))\41'i	AA	n	-	-
-'((((((((((a))))))))))\41'i	A!	y	$&	A!
+'((((((((((a))))))))))${bang}'i	AA	n	-	-
+'((((((((((a))))))))))${bang}'i	A!	y	$&	A!
 '(((((((((a)))))))))'i	A	y	$&	A
 '(?:(?:(?:(?:(?:(?:(?:(?:(?:(a))))))))))'i	A	y	$1	A
 '(?:(?:(?:(?:(?:(?:(?:(?:(?:(a|b|c))))))))))'i	C	y	$1	C
diff --git a/t/op/regexp.t b/t/op/regexp.t
index 0ec069b19a..b0b08855b8 100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -24,7 +24,7 @@ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
 # Column 5 contains the expected result of double-quote
 # interpolating that string after the match, or start of error message.
 #
-# \n in the tests are interpolated.
+# \n in the tests are interpolated, as are variables of the form ${\w+}.
 #
 # If you want to add a regular expression test that can't be expressed
 # in this format, don't add it here: put it in op/pat.t instead.
@@ -46,6 +46,8 @@ $numtests = $.;
 seek(TESTS,0,0);
 $. = 0;
 
+$bang = sprintf "\\%03o", ord "!"; # \41 would not be portable.
+
 $| = 1;
 print "1..$numtests\n# $iters iterations\n";
 TEST:
@@ -58,6 +60,7 @@ while (<TESTS>) {
     infty_subst(\$expect);
     $pat = "'$pat'" unless $pat =~ /^[:']/;
     $pat =~ s/\\n/\n/g;
+    $pat =~ s/(\$\{\w+\})/$1/eeg;
     $subject =~ s/\\n/\n/g;
     $expect =~ s/\\n/\n/g;
     $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
diff --git a/t/op/sort.t b/t/op/sort.t
index a6829e01e4..70341b9106 100755
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,20 +6,41 @@ print "1..21\n";
 
 sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 }
 
+my $upperfirst = 'A' lt 'a';
+
+# Beware: in future this may become hairier because of possible
+# collation complications: qw(A a B c) can be sorted at least as
+# any of the following
+#
+#	A a B b
+#	A B a b
+#	a b A B
+#	a A b B
+#
+# All the above orders make sense.
+#
+# That said, EBCDIC sorts all small letters first, as opposed
+# to ASCII which sorts all big letters first.
+
 @harry = ('dog','cat','x','Cain','Abel');
 @george = ('gone','chased','yz','punished','Axed');
 
 $x = join('', sort @harry);
-print ($x eq 'AbelCaincatdogx' ? "ok 1\n" : "not ok 1\n");
-print "# x = '$x'\n";
+$expected = $upperfirst ? 'AbelCaincatdogx' : 'catdogxAbelCain';
+print "# 1: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ? "ok 1\n" : "not ok 1\n");
 
 $x = join('', sort( backwards @harry));
-print ($x eq 'xdogcatCainAbel' ? "ok 2\n" : "not ok 2\n");
-print "# x = '$x'\n";
+$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
+print "# 2: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ? "ok 2\n" : "not ok 2\n");
 
 $x = join('', sort @george, 'to', @harry);
-print ($x eq 'AbelAxedCaincatchaseddoggonepunishedtoxyz'?"ok 3\n":"not ok 3\n");
-print "# x = '$x'\n";
+$expected = $upperfirst ?
+    'AbelAxedCaincatchaseddoggonepunishedtoxyz' :
+    'catchaseddoggonepunishedtoxyzAbelAxedCain' ;
+print "# 3: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ?"ok 3\n":"not ok 3\n");
 
 @a = ();
 @b = reverse @a;
@@ -47,7 +68,9 @@ print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n");
 
 $sub = 'backwards';
 $x = join('', sort $sub @harry);
-print ($x eq 'xdogcatCainAbel' ? "ok 10\n" : "not ok 10\n");
+$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
+print "# 10: x = $x, expected = '$expected'\n";
+print ($x eq $expected ? "ok 10\n" : "not ok 10\n");
 
 # literals, combinations
 
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 7556c80a41..b9b4751c79 100755
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -14,7 +14,7 @@ $SIG{__WARN__} = sub {
 };
 
 $w = 0;
-$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f","hi",123,0,456,0,65,3.0999);
+$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f","hi",123,0,456,0,ord('A'),3.0999);
 if ($x eq ' hi 123 %foo   456 0A3.1' && $w == 0) {
     print "ok 1\n";
 } else {
diff --git a/t/op/subst.t b/t/op/subst.t
index 2d42eeb386..afa06ab772 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -1,11 +1,5 @@
 #!./perl
 
-
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib' if -d '../lib';
-}
-
 print "1..71\n";
 
 $x = 'foo';
@@ -187,13 +181,21 @@ tr/a-z/A-Z/;
 print $_ eq 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' ? "ok 52\n" : "not ok 52\n";
 
 # same as tr/A-Z/a-z/;
-y[\101-\132][\141-\172];
+if ($^O eq 'os390') {	# An EBCDIC variant.
+    y[\301-\351][\201-\251];
+} else {		# Ye Olde ASCII.  Or something like it.
+    y[\101-\132][\141-\172];
+}
 
 print $_ eq 'abcdefghijklmnopqrstuvwxyz0123456789' ? "ok 53\n" : "not ok 53\n";
 
-$_ = '+,-';
-tr/+--/a-c/;
-print $_ eq 'abc' ? "ok 54\n" : "not ok 54\n";
+if (ord("+") == ord(",") - 1 && ord(",") == ord("-") - 1 &&
+    ord("a") == ord("b") - 1 && ord("b") == ord("c") - 1) {
+  $_ = '+,-';
+  tr/+--/a-c/;
+  print "not " unless $_ eq 'abc';
+}
+print "ok 54\n";
 
 $_ = '+,-';
 tr/+\--/a\/c/;
diff --git a/t/op/taint.t b/t/op/taint.t
index f2181d82fd..d2cae8e70a 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -15,6 +15,10 @@ BEGIN {
 use strict;
 use Config;
 
+# We do not want the whole taint.t to fail
+# just because Errno possibly failing.
+eval { require Errno; import Errno };
+
 my $Is_VMS = $^O eq 'VMS';
 my $Is_MSWin32 = $^O eq 'MSWin32';
 my $Is_Dos = $^O eq 'dos';
@@ -360,7 +364,9 @@ else {
 
     test 71, eval { open FOO, $foo } eq '', 'open for read';
     test 72, $@ eq '', $@;		# NB: This should be allowed
-    test 73, $! == 2 || ($Is_Dos && $! == 22); # File not found
+
+    # Try first new style but allow also old style.
+    test 73, $!{ENOENT} || $! == 2 || ($Is_Dos && $! == 22); # File not found
 
     test 74, eval { open FOO, "> $foo" } eq '', 'open for write';
     test 75, $@ =~ /^Insecure dependency/, $@;
diff --git a/t/op/universal.t b/t/op/universal.t
index bd6c73afe9..bde78fd04c 100755
--- a/t/op/universal.t
+++ b/t/op/universal.t
@@ -75,7 +75,11 @@ test ! (eval { $a->VERSION(2.719) }) &&
 test (eval { $a->VERSION(2.718) }) && ! $@;
 
 my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
-test $subs eq "VERSION can isa";
+if ('a' lt 'A') {
+    test $subs eq "can isa VERSION";
+} else {
+    test $subs eq "VERSION can isa";
+}
 
 test $a->isa("UNIVERSAL");
 
@@ -86,7 +90,11 @@ test $a->isa("UNIVERSAL");
 
 my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; 
 # XXX import being here is really a bug
-test $sub2 eq "VERSION can import isa";
+if ('a' lt 'A') {
+    test $sub2 eq "can import isa VERSION";
+} else {
+    test $sub2 eq "VERSION can import isa";
+}
 
 eval 'sub UNIVERSAL::sleep {}';
 test $a->can("sleep");
diff --git a/t/pragma/constant.t b/t/pragma/constant.t
index 0095f3b627..0b58bae607 100755
--- a/t/pragma/constant.t
+++ b/t/pragma/constant.t
@@ -81,7 +81,7 @@ test 18, (COUNTLIST)[1] == 4;
 use constant ABC	=> 'ABC';
 test 19, "abc${\( ABC )}abc" eq "abcABCabc";
 
-use constant DEF	=> 'D', "\x45", chr 70;
+use constant DEF	=> 'D', 'E', chr ord 'F';
 test 20, "d e f @{[ DEF ]} d e f" eq "d e f D E F d e f";
 
 use constant SINGLE	=> "'";
diff --git a/t/pragma/overload.t b/t/pragma/overload.t
index 64ab7ab6e2..afba8a3221 100755
--- a/t/pragma/overload.t
+++ b/t/pragma/overload.t
@@ -5,8 +5,6 @@ BEGIN {
     @INC = '../lib';
 }
 
-use Config;
-
 package Oscalar;
 use overload ( 
 				# Anonymous subroutines:
diff --git a/t/pragma/subs.t b/t/pragma/subs.t
index 056c4bd7cf..680564f843 100755
--- a/t/pragma/subs.t
+++ b/t/pragma/subs.t
@@ -55,6 +55,7 @@ for (@prgs){
     # allow expected output to be written as if $prog is on STDIN
     $results =~ s/tmp\d+/-/g;
     $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
+    $results =~ s/Syntax/syntax/;  # non-standard yacc
     $expected =~ s/\n+$//;
     my $prefix = ($results =~ s/^PREFIX\n//) ;
     if ( $results =~ s/^SKIPPED\n//) {
diff --git a/toke.c b/toke.c
index 9475b25fcf..b5315fa06a 100644
--- 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:
diff --git a/x2p/a2p.h b/x2p/a2p.h
index 2db5f36ebc..80530469ed 100644
--- a/x2p/a2p.h
+++ b/x2p/a2p.h
@@ -412,6 +412,10 @@ EXT int debug INIT(0);
 EXT int dlevel INIT(0);
 #define YYDEBUG 1
 extern int yydebug;
+#else
+# ifndef YYDEBUG
+#  define YYDEBUG 0
+# endif
 #endif
 
 EXT STR *freestrroot INIT(Nullstr);
diff --git a/x2p/a2py.c b/x2p/a2py.c
index a4753ab864..8a6155f455 100644
--- a/x2p/a2py.c
+++ b/x2p/a2py.c
@@ -66,7 +66,7 @@ main(register int argc, register char **argv, register char **env)
 #ifdef DEBUGGING
 	case 'D':
 	    debug = atoi(argv[0]+2);
-#ifdef YYDEBUG
+#if YYDEBUG
 	    yydebug = (debug & 1);
 #endif
 	    break;
@@ -211,7 +211,7 @@ yylex(void)
     register int tmp;
 
   retry:
-#ifdef YYDEBUG
+#if YYDEBUG
     if (yydebug)
 	if (strchr(s,'\n'))
 	    fprintf(stderr,"Tokener at %s",s);
@@ -273,7 +273,11 @@ yylex(void)
     case ':':
 	tmp = *s++;
 	XOP(tmp);
+#ifdef EBCDIC
+    case 7:
+#else
     case 127:
+#endif
 	s++;
 	XTERM('}');
     case '}':
author	Jarkko Hietaniemi <jhi@iki.fi>	1998-08-01 15:03:02 +0300
committer	Gurusamy Sarathy <gsar@cpan.org>	1998-08-02 05:20:12 +0000
commit	9d116dd7c895b17badf4ad422ae44da0c4df7bc2 (patch)
tree	6e0cd77e3539952c892983238473264f672472b9
parent	e6df7ed16ebd06f5315f3016c00996876580109c (diff)
download	perl-9d116dd7c895b17badf4ad422ae44da0c4df7bc2.tar.gz