Extend UTF-EBCDIC to handle up to 2**64-1
authorKarl Williamson <khw@cpan.org>
Thu, 19 Nov 2015 04:28:14 +0000 (21:28 -0700)
committerKarl Williamson <khw@cpan.org>
Wed, 25 Nov 2015 22:48:17 +0000 (15:48 -0700)
This uses for UTF-EBCDIC essentially the same mechanism that Perl
already uses for UTF-8 on ASCII platforms to extend it beyond what might
be its natural maximum.  That is, when the UTF-8 start byte is 0xFF, it
adds a bunch more bytes to the character than it otherwise would,
bringing it to a total of 14 for UTF-EBCDIC.  This is enough to handle
any code point that fits in a 64 bit word.

The downside of this is that this extension is not compatible with
previous perls for the range 2**30 up through the previous max,
2**30 - 1.  A simple program could be written to convert files that were
written out using an older perl so that they can be read with newer
perls, and the perldelta says we will do this should anyone ask.
However, I strongly suspect that the number of such files in existence
is zero, as people in EBCDIC land don't seem to use Unicode much, and
these are very large code points, which are associated with a
portability warning every time they are output in some way.

This extension brings UTF-EBCDIC to parity with UTF-8, so that both can
cover a 64-bit word.  It allows some removal of special cases for EBCDIC
in core code and core tests.  And it is a necessary step to handle Perl
6's NFG, which I'd like eventually to bring to Perl 5.

This commit causes two implementations of a macro in utf8.h and
utfebcdic.h to become the same, and both are moved to a single one in
the portion of utf8.h common to both.

To illustrate, the I8 for U+3FFFFFFF (2**30-1) is
"\xFE\xBF\xBF\xBF\xBF\xBF\xBF" before and after this commit, but the I8
for the next code point, U+40000000 is now
"\xFF\xA0\xA0\xA0\xA0\xA0\xA0\xA1\xA0\xA0\xA0\xA0\xA0\xA0",
and before this commit it was "\xFF\xA0\xA0\xA0\xA0\xA0\xA0".

The I8 for 2**64-1 (U+FFFFFFFFFFFFFFFF) is
"\xFF\xAF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF", whereas
before this commit it was unrepresentable.

Commit 7c560c3beefbb9946463c9f7b946a13f02f319d8 said in its message that
it was moving something that hadn't been needed on EBCDIC until the
"next commit".  That statement turned out to be wrong, overtaken by
events.  This now is the commit it was referring to.
commit I prematurely
pushed that

22 files changed:
autodoc.pl
charclass_invlists.h
ebcdic_tables.h
ext/XS-APItest/t/utf8.t
pod/perldelta.pod
pod/perldiag.pod
pod/perlebcdic.pod
pod/perlport.pod
pod/perlunicode.pod
regcharclass.h
regen/charset_translations.pl
regen/ebcdic.pl
t/lib/warnings/utf8
t/op/bop.t
t/op/chop.t
t/op/index.t
t/op/ver.t
t/re/pat_advanced.t
toke.c
utf8.c
utf8.h
utfebcdic.h

index 4a55c3c..865ee08 100644 (file)
@@ -417,8 +417,8 @@ whenever this documentation refers to C<utf8>
 (and variants of that name, including in function names),
 it also (essentially transparently) means C<UTF-EBCDIC>.
 But the ordinals of characters differ between ASCII, EBCDIC, and
-the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes
-than in UTF-8.
+the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy a different
+number of bytes than in UTF-8.
 
 The listing below is alphabetical, case insensitive.
 
index 53af072..1abf154 100644 (file)
@@ -99539,6 +99539,6 @@ static const UV XPosixXDigit_invlist[] = { /* for EBCDIC POSIX-BC */
  * a18d502bad39d527ac5586d7bc93e29f565859e3bcc24ada627eff606d6f5fed lib/unicore/extracted/DNumValues.txt
  * 602994a2249dfd84ae106940eb48450e3e6f1a69d489274f2618861a86f5d8e0 lib/unicore/mktables
  * 462c9aaa608fb2014cd9649af1c5c009485c60b9c8b15b89401fdc10cf6161c6 lib/unicore/version
- * c6884f4d629f04d1316f3476cb1050b6a1b98ca30c903262955d4eae337c6b1e regen/charset_translations.pl
+ * 996abda3c0fbc2bfd575092af09e3b9b0331e624eb2e969a268457f8fd31ecbb regen/charset_translations.pl
  * 8a097f8f726bb1619af2f27f149ab87e60a1602f790147e3a561358be16abd27 regen/mk_invlists.pl
  * ex: set ro: */
index 1669bbd..5344d39 100644 (file)
@@ -126,7 +126,7 @@ EXTCONST U8 PL_utf8skip[] = {
    1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   3,   3,   3,   3,   3,   3,
    1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   3,   3,   4,   4,   4,   4,
    1,   4,   1,   1,   1,   1,   1,   1,   1,   1,   4,   4,   4,   5,   5,   5,
-   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   5,   6,   6,   7,   7,   1
+   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   5,   6,   6,   7,  14,   1
 };
 
 /* Index is EBCDIC 1047 code point; value is its lowercase equivalent */
@@ -339,7 +339,7 @@ EXTCONST U8 PL_utf8skip[] = {
    1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   3,   3,   3,   3,   3,   3,
    1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   3,   3,   4,   4,   4,   4,
    1,   4,   1,   1,   1,   1,   1,   1,   1,   1,   4,   4,   4,   5,   5,   5,
-   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   5,   6,   6,   7,   7,   1
+   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   5,   6,   6,   7,  14,   1
 };
 
 /* Index is EBCDIC 037 code point; value is its lowercase equivalent */
@@ -552,7 +552,7 @@ EXTCONST U8 PL_utf8skip[] = {
    3,   1,   1,   1,   1,   1,   1,   1,   1,   1,   3,   3,   3,   3,   3,   3,
    3,   1,   1,   1,   1,   1,   1,   1,   1,   1,   3,   4,   4,   4,   4,   4,
    4,   4,   1,   1,   1,   1,   1,   1,   1,   1,   4,   5,   5,   5,   5,   6,
-   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   6,   1,   7,   1,   7,   1
+   1,   1,   1,   1,   1,   1,   1,   1,   1,   1,   6,   1,   7,   1,  14,   1
 };
 
 /* Index is EBCDIC POSIX-BC code point; value is its lowercase equivalent */
index 4cafe2f..61a3ff8 100644 (file)
@@ -206,13 +206,10 @@ my %code_points = (
     0x40000000 - 1 => (isASCII) ? "\xfc\xbf\xbf\xbf\xbf\xbf" : I8_to_native("\xfe\xbf\xbf\xbf\xbf\xbf\xbf"),
     0x40000000     => (isASCII) ? "\xfd\x80\x80\x80\x80\x80" : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa1\xa0\xa0\xa0\xa0\xa0\xa0"),
     0x80000000 - 1 => (isASCII) ? "\xfd\xbf\xbf\xbf\xbf\xbf" : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa1\xbf\xbf\xbf\xbf\xbf\xbf"),
+    0x80000000     => (isASCII) ? "\xfe\x82\x80\x80\x80\x80\x80" : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa2\xa0\xa0\xa0\xa0\xa0\xa0"),
+    0xFFFFFFFF     => (isASCII) ? "\xfe\x83\xbf\xbf\xbf\xbf\xbf" : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa3\xbf\xbf\xbf\xbf\xbf\xbf"),
 );
 
-if (isASCII) {
-    $code_points{0x80000000} = "\xfe\x82\x80\x80\x80\x80\x80";
-    $code_points{0xFFFFFFFF} = "\xfe\x83\xbf\xbf\xbf\xbf\xbf";
-}
-
 if ($is64bit) {
     no warnings qw(overflow portable);
     $code_points{0x100000000}        = (isASCII) ? "\xfe\x84\x80\x80\x80\x80\x80" : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa4\xa0\xa0\xa0\xa0\xa0\xa0");
@@ -292,8 +289,8 @@ for my $u (sort { utf8::unicode_to_native($a) <=> utf8::unicode_to_native($b) }
                $u < 0x4000      ? 3 :
                $u < 0x40000     ? 4 :
                $u < 0x400000    ? 5 :
-               $u < 0x4000000   ? 6 : 7
-            );
+               $u < 0x4000000   ? 6 :
+               $u < 0x40000000  ? 7 : 14 );
     }
 
     # If this test fails, subsequent ones are meaningless.
@@ -466,22 +463,19 @@ my @malformations = (
         0,   # NUL
         2,
         qr/2 bytes, need 1/
-    ]
-);
-
-if (isASCII) {
-    push @malformations,
+    ],
     [ "overflow malformation",
                     # These are the smallest overflowing on 64 byte machines:
                     # 2**64
-        "\xff\x80\x90\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0",
-        13,
+        (isASCII) ? "\xff\x80\x90\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0"
+                  : I8_to_native("\xff\xB0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0"),
+        (isASCII) ? 13 : 14,
         0,  # There is no way to allow this malformation
         $REPLACEMENT,
-        13,
+        (isASCII) ? 13 : 14,
         qr/overflow/
-    ];
-}
+    ],
+);
 
 foreach my $test (@malformations) {
     my ($testname, $bytes, $length, $allow_flags, $allowed_uv, $expected_len, $message ) = @$test;
@@ -535,16 +529,6 @@ foreach my $test (@malformations) {
     }
 }
 
-my $FF_ret;
-
-if ($is64bit) {
-    no warnings qw{portable overflow};
-    $FF_ret = 0x1000000000;
-}
-else {  # The above overflows unless a quad platform
-    $FF_ret = 0;
-}
-
 # Now test the cases where a legal code point is generated, but may or may not
 # be allowed/warned on.
 my @tests = (
@@ -829,54 +813,60 @@ my @tests = (
         (isASCII) ? 4 : 5,
         qr/Unicode non-character.*is not recommended for open interchange/
     ],
-);
-
-
-if (isASCII) {
-    push @tests,
     [ "requires at least 32 bits",
-         "\xfe\x82\x80\x80\x80\x80\x80",
-
+        (isASCII)
+         ? "\xfe\x82\x80\x80\x80\x80\x80"
+         : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa2\xa0\xa0\xa0\xa0\xa0\xa0"),
         # This code point is chosen so that it is representable in a UV on
         # 32-bit machines
         $UTF8_WARN_ABOVE_31_BIT, $UTF8_DISALLOW_ABOVE_31_BIT,
-        'utf8', 0x80000000, 7,
+        'utf8', 0x80000000, (isASCII) ? 7 :14,
         qr/Code point 0x80000000 is not Unicode, and not portable/
     ],
     [ "requires at least 32 bits, and use SUPER-type flags, instead of ABOVE_31_BIT",
-         "\xfe\x82\x80\x80\x80\x80\x80",
+        (isASCII)
+         ? "\xfe\x82\x80\x80\x80\x80\x80"
+         : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa2\xa0\xa0\xa0\xa0\xa0\xa0"),
         $UTF8_WARN_SUPER, $UTF8_DISALLOW_SUPER,
-        'utf8', 0x80000000, 7,
+        'utf8', 0x80000000, (isASCII) ? 7 :14,
         qr/Code point 0x80000000 is not Unicode, and not portable/
     ],
     [ "overflow with warnings/disallow for more than 31 bits",
         # This tests the interaction of WARN_ABOVE_31_BIT/DISALLOW_ABOVE_31_BIT
         # with overflow.  The overflow malformation is never allowed, so
         # preventing it takes precedence if the ABOVE_31_BIT options would
-        # otherwise allow in an overflowing value.  These two code points (1
+        # otherwise allow in an overflowing value.  The ASCII code points (1
         # for 32-bits; 1 for 64) were chosen because the old overflow
         # detection algorithm did not catch them; this means this test also
-        # checks for that fix.
-        ($is64bit)
-            ? "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf"
-            : "\xfe\x86\x80\x80\x80\x80\x80",
+        # checks for that fix.  The EBCDIC are arbitrary overflowing ones
+        # since we have no reports of failures with it.
+       (($is64bit)
+        ? ((isASCII)
+           ? "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf"
+           : I8_to_native("\xff\xB0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0"))
+        : ((isASCII)
+           ? "\xfe\x86\x80\x80\x80\x80\x80"
+           : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa4\xa0\xa0\xa0\xa0\xa0\xa0"))),
 
         # We include both warning categories to make sure the ABOVE_31_BIT one
         # has precedence
         "$UTF8_WARN_ABOVE_31_BIT|$UTF8_WARN_SUPER",
         "$UTF8_DISALLOW_ABOVE_31_BIT",
         'utf8', 0,
-        ($is64bit) ? 13 : 7,
+        (! isASCII) ? 14 : ($is64bit) ? 13 : 7,
         qr/overflow at byte .*, after start byte 0xf/
     ],
-    ;
-}
+);
 
-if ($is64bit) {    # All FF's will overflow on 32 bit
+if ($is64bit) {
+    no warnings qw{portable overflow};
     push @tests,
-        [ "More than 32 bits", "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80",
+        [ "More than 32 bits",
+            (isASCII)
+            ? "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80"
+            : I8_to_native("\xff\xa0\xa0\xa0\xa0\xa0\xa2\xa0\xa0\xa0\xa0\xa0\xa0\xa0"),
             $UTF8_WARN_ABOVE_31_BIT, $UTF8_DISALLOW_ABOVE_31_BIT,
-            'utf8', $FF_ret, 13,
+            'utf8', 0x1000000000, (isASCII) ? 13 : 14,
             qr/Code point 0x.* is not Unicode, and not portable/
         ];
 }
index c856a43..7bfa959 100644 (file)
@@ -305,9 +305,19 @@ L</Modules and Pragmata> section.
 
 =over 4
 
-=item XXX-some-platform
-
-XXX
+=item EBCDIC platforms, such as z/OS
+
+UTF-EBCDIC is like UTF-8, but for EBCDIC platforms.  It now has been
+extended so that it can represent code points up to 2 ** 64 - 1 on
+platforms with 64-bit words.  This brings it into parity with UTF-8.
+This enhancement requires an incompatible change to the representation
+of code points in the range 2 ** 30 to 2 ** 31 -1 (the latter was the
+previous maximum representable code point).  This means that a file that
+contains one of these code points, written out with previous versions of
+perl cannot be read in, without conversion, by a perl containing this
+change.  We do not believe any such files are in existence, but if you
+do have one, submit a ticket at L<mailto:perlbug@perl.org>, and we will
+write a conversion script for you.
 
 =back
 
index 5111410..38f1350 100644 (file)
@@ -1623,17 +1623,41 @@ This subroutine cannot be called.
 (F) You had a (sub-)template that ends with a '/'.  There must be
 another template code following the slash.  See L<perlfunc/pack>.
 
+=item Code point 0x%X is not Unicode, and not portable
+
+(S non_unicode) You had a code point that has never been in any
+standard, so it is likely that languages other than Perl will NOT
+understand it.  At one time, it was legal in some standards to have code
+points up to 0x7FFF_FFFF, but not higher, and this code point is higher.
+
+Acceptance of these code points is a Perl extension, and you should
+expect that nothing other than Perl can handle them; Perl itself on
+EBCDIC platforms before v5.24 does not handle them.
+
+Code points above 0xFFFF_FFFF require larger than a 32 bit word.
+
+Perl also makes no guarantees that the representation of these code
+points won't change at some point in the future, say when machines
+become available that have larger than a 64-bit word.  At that time,
+files written by an older Perl would require conversion before being
+readable by a newer Perl.
+
 =item Code point 0x%X is not Unicode, may not be portable
 
 (S non_unicode) You had a code point above the Unicode maximum
 of U+10FFFF.
 
-Perl allows strings to contain a superset of Unicode code points, up
-to the limit of what is storable in an unsigned integer on your system,
-but these may not be accepted by other languages/systems.  At one time,
-it was legal in some standards to have code points up to 0x7FFF_FFFF,
-but not higher.  Code points above 0xFFFF_FFFF require larger than a
-32 bit word.
+Perl allows strings to contain a superset of Unicode code points, but
+these may not be accepted by other languages/systems.  Further, even if
+these languages/systems accept these large code points, they may have
+chosen a different representation for them than the UTF-8-like one that
+Perl has, which would mean files are not exchangeable between them and
+Perl.
+
+On EBCDIC platforms, code points above 0x3FFF_FFFF have a different
+representation in Perl v5.24 than before, so any file containing these
+that was written before that version will require conversion before
+being readable by a later Perl.
 
 =item %s: Command not found
 
@@ -2597,12 +2621,6 @@ parent '%s'
 C3-consistent, and you have enabled the C3 MRO for this class.  See the C3
 documentation in L<mro> for more information.
 
-=item In EBCDIC the v-string components cannot exceed 2147483647
-
-(F) An error peculiar to EBCDIC.  Internally, v-strings are stored as
-Unicode code points, and encoded in EBCDIC as UTF-EBCDIC.  The UTF-EBCDIC
-encoding is limited to code points no larger than 2147483647 (0x7FFFFFFF).
-
 =item Infinite recursion in regex
 
 (F) You used a pattern that references itself without consuming any input
index e54084a..552a8a3 100644 (file)
@@ -243,15 +243,15 @@ In UTF-EBCDIC, there are 160 invariant characters.
 which have ASCII equivalents, plus those that correspond to
 the C1 controls (128 - 159 on ASCII platforms).)
 
-A string encoded in UTF-EBCDIC may be longer (but never shorter) than
-one encoded in UTF-8.  Perl extends UTF-8 so that it can encode code
-points above the Unicode maximum of U+10FFFF.  It extends UTF-EBCDIC as
-well, but due to the inherent limitations in UTF-EBCDIC, the maximum
-code point expressible is U+7FFF_FFFF, even if the word size is more
-than 32 bits.
+A string encoded in UTF-EBCDIC may be longer (very rarely shorter) than
+one encoded in UTF-8.  Perl extends both UTF-8 and UTF-EBCDIC so that
+they can encode code points above the Unicode maximum of U+10FFFF.  Both
+extensions are constructed to allow encoding of any code point that fits
+in a 64-bit word.
 
 UTF-EBCDIC is defined by
-L<Unicode Technical Report #16|http://www.unicode.org/reports/tr16>.
+L<Unicode Technical Report #16|http://www.unicode.org/reports/tr16>
+(often referred to as just TR16).
 It is defined based on CCSID 1047, not allowing for the differences for
 other code pages.  This allows for easy interchange of text between
 computers running different code pages, but makes it unusable, without
@@ -268,6 +268,11 @@ invariant.  This means that text generated on a computer running one
 version of Perl's UTF-EBCDIC has to be translated to be intelligible to
 a computer running another.
 
+TR16 implies a method to extend UTF-EBCDIC to encode points up through
+S<C<2 ** 31 - 1>>.  Perl uses this method for code points up through
+S<C<2 ** 30 - 1>>, but uses an incompatible method for larger ones, to
+enable it to handle much larger code points than otherwise.
+
 =head2 Using Encode
 
 Starting from Perl 5.8 you can use the standard module Encode
@@ -1226,10 +1231,6 @@ character return value on an EBCDIC platform.  For example:
 
     $CAPITAL_LETTER_A = chr(193);
 
-The largest code point that is representable in UTF-EBCDIC is
-U+7FFF_FFFF.  If you do C<chr()> on a larger value, a runtime error
-(similar to division by 0) will happen.
-
 =item C<ord()>
 
 C<ord()> will return EBCDIC code number values on an EBCDIC platform.
@@ -1264,10 +1265,6 @@ is true on all platforms.  If you want native code points for the low
 
 will hold.
 
-The largest code point that is representable in UTF-EBCDIC is
-U+7FFF_FFFF.  If you try to pack a larger value into a character, a
-runtime error (similar to division by 0) will happen.
-
 =item C<print()>
 
 One must be careful with scalars and strings that are passed to
index 8e872e4..031b2b1 100644 (file)
@@ -242,9 +242,6 @@ C<Storable>
 (included as of Perl 5.8).  Keeping all data as text significantly
 simplifies matters.
 
-The v-strings are portable only up to v2147483647 (0x7FFF_FFFF), that's
-how far EBCDIC, or more precisely UTF-EBCDIC will go.
-
 =head2 Files and Filesystems
 
 Most platforms these days structure files in a hierarchical fashion.
index a407faf..aa0fdca 100644 (file)
@@ -1300,10 +1300,11 @@ This means that all the basic characters (which includes all
 those that have ASCII equivalents (like C<"A">, C<"0">, C<"%">, I<etc.>)
 are the same in both EBCDIC and UTF-EBCDIC.)
 
-UTF-EBCDIC is used on EBCDIC platforms.  The largest Unicode code points
-take 5 bytes to represent (instead of 4 in UTF-8), and Perl extends it
-to a maximum of 7 bytes to encode pode points up to what can fit in a
-32-bit word (instead of 13 bytes and a 64-bit word in UTF-8).
+UTF-EBCDIC is used on EBCDIC platforms.  It generally requires more
+bytes to represent a given code point than UTF-8 does; the largest
+Unicode code points take 5 bytes to represent (instead of 4 in UTF-8),
+and, extended for 64-bit words, it uses 14 bytes instead of 13 bytes in
+UTF-8.
 
 =item *
 
index b947bf2..54a5011 100644 (file)
  * a18d502bad39d527ac5586d7bc93e29f565859e3bcc24ada627eff606d6f5fed lib/unicore/extracted/DNumValues.txt
  * 602994a2249dfd84ae106940eb48450e3e6f1a69d489274f2618861a86f5d8e0 lib/unicore/mktables
  * 462c9aaa608fb2014cd9649af1c5c009485c60b9c8b15b89401fdc10cf6161c6 lib/unicore/version
- * c6884f4d629f04d1316f3476cb1050b6a1b98ca30c903262955d4eae337c6b1e regen/charset_translations.pl
+ * 996abda3c0fbc2bfd575092af09e3b9b0331e624eb2e969a268457f8fd31ecbb regen/charset_translations.pl
  * d9c04ac46bdd81bb3e26519f2b8eb6242cb12337205add3f7cf092b0c58dccc4 regen/regcharclass.pl
  * 393f8d882713a3ba227351ad0f00ea4839fda74fcf77dcd1cdf31519925adba5 regen/regcharclass_multi_char_folds.pl
  * ex: set ro: */
index 9696560..b37c3cd 100644 (file)
@@ -2,6 +2,10 @@
 use strict;
 use warnings;
 
+# WARNING: This must be kept in sync with the UTF8_MAXBYTES value in
+# utfebcdic.h
+$CHARSET_TRANSLATIONS::UTF_EBCDIC_MAXBYTES = 14;
+
 # Utilities for various character set issues.  Currently handles ASCII and
 # EBCDIC only.  It is trivial to add support for new EBCDIC code pages (unless
 # they have identical variant character signatures as existing ones, and there
@@ -234,12 +238,13 @@ sub get_I8_2_utf($) {
 sub _UTF_START_MASK($) {
     # Internal
     my $len = shift;
-    return ((($len) >= 6) ? 0x01 : (0x1F >> (($len)-2)));
+    return (($len >= 7) ? 0x00 : (0x1F >> ($len - 2)));
 }
 
 sub _UTF_START_MARK($) {
     # Internal
-    return (0xFF & (0xFE << (7-(shift))));
+    my $len = shift;
+    return (($len >  7) ? 0xFF : (0xFF & (0xFE << (7- $len))));
 }
 
 sub cp_2_utfbytes($$) {
@@ -269,7 +274,9 @@ sub cp_2_utfbytes($$) {
                  $ucp < 0x4000    ? 3 :
                  $ucp < 0x40000   ? 4 :
                  $ucp < 0x400000  ? 5 :
-                 $ucp < 0x4000000 ? 6 : 7;
+                 $ucp < 0x4000000 ? 6 :
+                 $ucp < 0x40000000? 7 :
+                                    $CHARSET_TRANSLATIONS::UTF_EBCDIC_MAXBYTES;
 
         my @str;
        for (1 .. $len - 1) {
index b50d11a..fa8a051 100644 (file)
@@ -102,7 +102,11 @@ END
         # order 1-bits (up to 7)
         for my $i (0xC0 .. 255) {
             my $count;
-            if (($i & 0b11111110) == 0b11111110) {
+            if ($i == 0b11111111) {
+                no warnings 'once';
+                $count = $CHARSET_TRANSLATIONS::UTF_EBCDIC_MAXBYTES;
+            }
+            elsif (($i & 0b11111110) == 0b11111110) {
                 $count= 7;
             }
             elsif (($i & 0b11111100) == 0b11111100) {
index 809785b..df1ccd6 100644 (file)
@@ -88,18 +88,12 @@ Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 2.
 Operation "uc" returns its argument for non-Unicode code point 0x110000 at - line 3.
 Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 5.
 ########
-BEGIN {
-    if (ord('A') == 193) {
-        print "SKIPPED\n# ebcdic platforms can't handle this large a code point";
-        exit 0;
-    }
-}
 use warnings 'utf8';
 my $big_nonUnicode = uc(chr(0x8000_0000));
 no warnings 'non_unicode';
 my $big_nonUnicode = uc(chr(0x8000_0000));
 EXPECT
-Operation "uc" returns its argument for non-Unicode code point 0x80000000 at - line 8.
+Operation "uc" returns its argument for non-Unicode code point 0x80000000 at - line 2.
 ########
 use warnings 'utf8';
 my $d7ff  = lc pack("U", 0xD7FF);
index 409c91b..a037b06 100644 (file)
@@ -136,9 +136,7 @@ is (sprintf("%vd", v120.300 ^ v200.400), '176.188');
 # UTF8 ~ behaviour
 #
 
-SKIP: {
-    skip "Complements exceed maximum representable on EBCDIC ", 5 if $::IS_EBCDIC;
-
+{
     my @not36;
 
     for (0x100...0xFFF) {
index bdeaf0d..a1126dc 100644 (file)
@@ -7,7 +7,6 @@ BEGIN {
 }
 
 my $tests_count = 148;
-$tests_count -= 2 if $::IS_EBCDIC;
 plan tests => $tests_count;
 
 $_ = 'abc';
@@ -249,31 +248,24 @@ foreach my $start (@chars) {
     ok(1, "extend sp in pp_chomp");
 }
 
-SKIP: {
+{
     # [perl #73246] chop doesn't support utf8
     # the problem was UTF8_IS_START() didn't handle perl's extended UTF8
-    skip("Not representable in EBCDIC", 2) if $::IS_EBCDIC;
 
-    # We use hex constants instead of literal chars to avoid compilation
-    # errors in EBCDIC.
-    my $first_char =  0x80000001;
-    my $second_char = 0x80000000;
-    my $utf = chr($first_char) . chr($second_char);
+    my $utf = "\x{80000001}\x{80000000}";
     my $result = chop($utf);
-    is($utf, chr $first_char, "chopping high 'unicode'- remnant");
-    is($result, chr $second_char, "chopping high 'unicode' - result");
+    is($utf, "\x{80000001}", "chopping high 'unicode'- remnant");
+    is($result, "\x{80000000}", "chopping high 'unicode' - result");
 
     SKIP: {
         no warnings 'overflow'; # avoid compile-time warnings below on 32-bit architectures
         use Config;
         $Config{ivsize} >= 8
          or skip("this build can't handle very large characters", 2);
-        my $first_char =  0xffffffffffffffff;
-        my $second_char = 0xfffffffffffffffe;
-        my $utf = chr($first_char) . chr($second_char);
+        my $utf = "\x{ffffffffffffffff}\x{fffffffffffffffe}";
         my $result = chop $utf;
-        is($utf, chr $first_char, "chop even higher 'unicode' - remnant");
-        is($result, chr $second_char, "chop even higher 'unicode' - result");
+        is($utf, "\x{ffffffffffffffff}", "chop even higher 'unicode' - remnant");
+        is($result, "\x{fffffffffffffffe}", "chop even higher 'unicode' - result");
     }
 }
 
index 243cc1b..8d21de7 100644 (file)
@@ -129,9 +129,7 @@ is(rindex($a, "foo",    ), 0);
     is (rindex($text, $search_octets), -1);
 }
 
-SKIP: {
-    skip "UTF-EBCDIC is limited to 0x7fffffff", 3 if $::IS_EBCDIC;
-
+{
     my $a = eval q{"\x{80000000}"};
     my $s = $a.'defxyz';
     is(index($s, 'def'), 1, "0x80000000 is a single character");
index 144a352..cbbebba 100644 (file)
@@ -223,9 +223,7 @@ $v = $revision + $version/1000 + $subversion/1000000;
 
 ok( abs($v - $]) < 10**-8 , "\$^V == \$] (numeric)" );
 
-SKIP: {
-  skip("In EBCDIC the v-string components cannot exceed 2147483647", 6)
-    if $::IS_EBCDIC;
+{
 
   # [ID 20010902.001] check if v-strings handle full UV range or not
   if ( $Config{'uvsize'} >= 4 ) {
index df8090c..8627753 100644 (file)
@@ -2372,15 +2372,13 @@ EOF
     sub Is_32_Bit_Super { return "110000\tFFFFFFFF\n" }
     sub Is_Portable_Super { return '!utf8::Any' }   # Matches beyond 32 bits
 
-  SKIP:
     {   # Assertion was failing on on 64-bit platforms; just didn't work on 32.
-        skip("EBCDIC only goes to 31 bits", 4) if $::IS_EBCDIC;
         no warnings qw(non_unicode portable);
         use Config;
 
         # We use 'ok' instead of 'like' because the warnings are lexically
         # scoped, and want to turn them off, so have to do the match in this
-        # scope.   (EBCDIC platforms can't handle above 2**32 - 1
+        # scope.
         if ($Config{uvsize} < 8) {
             ok(chr(0xFFFF_FFFE) =~ /\p{Is_32_Bit_Super}/,
                             "chr(0xFFFF_FFFE) can match a Unicode property");
diff --git a/toke.c b/toke.c
index f7d4e53..b9fe9ae 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -11393,10 +11393,7 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv)
                                         "Integer overflow in decimal number");
                }
            }
-#ifdef EBCDIC
-           if (rev > 0x7FFFFFFF)
-                Perl_croak(aTHX_ "In EBCDIC the v-string components cannot exceed 2147483647");
-#endif
+
            /* Append native character for the rev point */
            tmpend = uvchr_to_utf8(tmpbuf, rev);
            sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
diff --git a/utf8.c b/utf8.c
index 6382cf0..52b6b98 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -109,11 +109,6 @@ Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
        return d;
     }
 
-#ifdef EBCDIC
-    /* Not representable in UTF-EBCDIC */
-    flags |= UNICODE_DISALLOW_FE_FF;
-#endif
-
     /* The first problematic code point is the first surrogate */
     if (   flags    /* It's common to turn off all these */
         && uv >= UNICODE_SURROGATE_FIRST)
@@ -142,10 +137,6 @@ Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
            if (flags & UNICODE_DISALLOW_SUPER
                || (UNICODE_IS_FE_FF(uv) && (flags & UNICODE_DISALLOW_FE_FF)))
            {
-#ifdef EBCDIC
-                Perl_die(aTHX_ "Can't represent character for Ox%"UVXf" on this platform", uv);
-                NOT_REACHED; /* NOTREACHED */
-#endif
                return NULL;
            }
        }
@@ -591,7 +582,6 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
 
     for (s = s0 + 1; s < send; s++) {
        if (LIKELY(UTF8_IS_CONTINUATION(*s))) {
-#ifndef EBCDIC /* Can't overflow in EBCDIC */
            if (uv & UTF_ACCUMULATION_OVERFLOW_MASK) {
 
                /* The original implementors viewed this malformation as more
@@ -603,7 +593,6 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
                overflowed = TRUE;
                overflow_byte = *s; /* Save for warning message's use */
            }
-#endif
            uv = UTF8_ACCUMULATE(uv, *s);
        }
        else {
@@ -670,12 +659,10 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
        }
     }
 
-#ifndef EBCDIC /* EBCDIC can't overflow */
     if (UNLIKELY(overflowed)) {
        sv = sv_2mortal(Perl_newSVpvf(aTHX_ "%s (overflow at byte 0x%02x, after start byte 0x%02x)", malformed_text, overflow_byte, *s0));
        goto malformed;
     }
-#endif
 
     if (do_overlong_test
        && expectlen > (STRLEN) OFFUNISKIP(uv)
@@ -720,14 +707,39 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
                    uv));
                pack_warn = packWARN(WARN_NON_UNICODE);
            }
-#ifndef EBCDIC /* Can never have the equivalent of FE nor FF on EBCDIC, since
-                   not representable in UTF-EBCDIC */
-
-            /* The first byte being 0xFE or 0xFF is a subset of the SUPER code
-             * points.  We test for these after the regular SUPER ones, and
-             * before possibly bailing out, so that the more dire warning
-             * overrides the regular one, if applicable */
-            if ((*s0 & 0xFE) == 0xFE   /* matches both FE, FF */
+
+            /* The maximum code point ever specified by a standard was
+             * 2**31 - 1.  Anything larger than that is a Perl extension that
+             * very well may not be understood by other applications (including
+             * earlier perl versions on EBCDIC platforms).  On ASCII platforms,
+             * these code points are indicated by the first UTF-8 byte being
+             * 0xFE or 0xFF, hence names like 'UTF8_WARN_FE_FF'.  These names
+             * are ASCII-centric, because the criteria is different On EBCDIC
+             * platforms.  We test for these after the regular SUPER ones, and
+             * before possibly bailing out, so that the slightly more dire
+             * warning will override the regular one. */
+            if (
+#ifndef EBCDIC
+                (*s0 & 0xFE) == 0xFE   /* matches both FE, FF */
+#else
+                 /* The I8 for 2**31 (U+80000000) is
+                  *   \xFF\xA0\xA0\xA0\xA0\xA0\xA0\xA2\xA0\xA0\xA0\xA0\xA0\xA0
+                  * and it turns out that on all EBCDIC pages recognized that
+                  * the UTF-EBCDIC for that code point is
+                  *   \xFE\x41\x41\x41\x41\x41\x41\x43\x41\x41\x41\x41\x41\x41
+                  * For the next lower code point, the 1047 UTF-EBCDIC is
+                  *   \xFE\x41\x41\x41\x41\x41\x41\x42\x73\x73\x73\x73\x73\x73
+                  * The other code pages differ only in the bytes following
+                  * \x42.  Thus the following works (the minimum continuation
+                  * byte is \x41). */
+                *s0 == 0xFE && send - s0 > 7 && (   s0[1] > 0x41
+                                                 || s0[2] > 0x41
+                                                 || s0[3] > 0x41
+                                                 || s0[4] > 0x41
+                                                 || s0[5] > 0x41
+                                                 || s0[6] > 0x41
+                                                 || s0[7] > 0x42)
+#endif
                 && (flags & (UTF8_WARN_FE_FF|UTF8_WARN_SUPER|UTF8_DISALLOW_FE_FF)))
             {
                 if (  ! (flags & UTF8_CHECK_ONLY)
@@ -743,7 +755,7 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
                     goto disallowed;
                 }
             }
-#endif
+
            if (flags & UTF8_DISALLOW_SUPER) {
                goto disallowed;
            }
diff --git a/utf8.h b/utf8.h
index 4f01277..c3704de 100644 (file)
--- a/utf8.h
+++ b/utf8.h
@@ -231,16 +231,6 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
  * represent a code point > 255? */
 #define UTF8_IS_ABOVE_LATIN1(c)     ((U8)(c) >= 0xc4)
 
-/* This defines the 1-bits that are to be in the first byte of a multi-byte
- * UTF-8 encoded character that give the number of bytes that comprise the
- * character. 'len' is the number of bytes in the multi-byte sequence. */
-#define UTF_START_MARK(len) (((len) >  7) ? 0xFF : (0xFF & (0xFE << (7-(len)))))
-
-/* Masks out the initial one bits in a start byte, leaving the real data ones.
- * Doesn't work on an invariant byte.  'len' is the number of bytes in the
- * multi-byte sequence that comprises the character. */
-#define UTF_START_MASK(len) (((len) >= 7) ? 0x00 : (0x1F >> ((len)-2)))
-
 /* This defines the bits that are to be in the continuation bytes of a multi-byte
  * UTF-8 encoded character that indicate it is a continuation byte. */
 #define UTF_CONTINUATION_MARK          0x80
@@ -329,6 +319,16 @@ encoded as UTF-8.  C<cp> is a native (ASCII or EBCDIC) code point if less than
 #define I8_TO_NATIVE(ch)         I8_TO_NATIVE_UTF8(ch)
 #define NATIVE8_TO_UNI(ch)       NATIVE_TO_LATIN1(ch)
 
+/* This defines the 1-bits that are to be in the first byte of a multi-byte
+ * UTF-8 encoded character that give the number of bytes that comprise the
+ * character. 'len' is the number of bytes in the multi-byte sequence. */
+#define UTF_START_MARK(len) (((len) >  7) ? 0xFF : (0xFF & (0xFE << (7-(len)))))
+
+/* Masks out the initial one bits in a start byte, leaving the real data ones.
+ * Doesn't work on an invariant byte.  'len' is the number of bytes in the
+ * multi-byte sequence that comprises the character. */
+#define UTF_START_MASK(len) (((len) >= 7) ? 0x00 : (0x1F >> ((len)-2)))
+
 /* Adds a UTF8 continuation byte 'new' of information to a running total code
  * point 'old' of all the continuation bytes so far.  This is designed to be
  * used in a loop to convert from UTF-8 to the code point represented.  Note
index 1e4dc7c..bf54d4c 100644 (file)
  *     invariant byte      starts with 0       starts with 0 or 100
  *     continuation byte   starts with 10      starts with 101
  *     start byte          same in both: if the code point requires N bytes,
- *                         then the leading N bits are 1, followed by a 0.  (No
- *                         trailing 0 for the very largest possible allocation
- *                         in I8, far beyond the current Unicode standard's
- *                         max, as shown in the comment later in this file.)
+ *                         then the leading N bits are 1, followed by a 0.  If
+ *                         all 8 bits in the first byte are 1, the code point
+ *                         will occupy 14 bytes (compared to 13 in Perl's
+ *                         extended UTF-8).  This is incompatible with what
+ *                         tr16 implies should be the representation of code
+ *                         points 2**30 and above, but allows Perl to be able
+ *                         to represent all code points that fit in a 64-bit
+ *                         word in either our extended UTF-EBCDIC or UTF-8.
  *  3) Use the algorithm in tr16 to convert each byte from step 2 into
  *     final UTF-EBCDIC.  This is done by table lookup from a table
  *     constructed from the algorithm, reproduced in ebcdic_tables.h as
@@ -149,13 +153,17 @@ END_EXTERN_C
 /* NOTE: Strictly speaking Perl's UTF-8 should not be called UTF-8 since UTF-8
  * is an encoding of Unicode, and Unicode's upper limit, 0x10FFFF, can be
  * expressed with 5 bytes.  However, Perl thinks of UTF-8 as a way to encode
- * non-negative integers in a binary format, even those above Unicode. */
-#define UTF8_MAXBYTES 7
+ * non-negative integers in a binary format, even those above Unicode.  14 is
+ * the smallest number that covers 2**64
+ *
+ * WARNING: This number must be in sync with the value in
+ * regen/charset_translations.pl. */
+#define UTF8_MAXBYTES 14
 
 /*
-  The following table is adapted from tr16, it shows I8 encoding of Unicode code points.
+  The following table is adapted from tr16, it shows the I8 encoding of Unicode code points.
 
-        Unicode                         U32 Bit pattern 1st Byte 2nd Byte 3rd Byte 4th Byte 5th Byte 6th Byte 7th byte
+        Unicode                         U32 Bit pattern 1st Byte 2nd Byte 3rd Byte 4th Byte 5th Byte 6th Byte 7th Byte
     U+0000..U+007F                     000000000xxxxxxx 0xxxxxxx
     U+0080..U+009F                     00000000100xxxxx 100xxxxx
     U+00A0..U+03FF                     000000yyyyyxxxxx 110yyyyy 101xxxxx
@@ -163,12 +171,17 @@ END_EXTERN_C
     U+4000..U+3FFFF                 0wwwzzzzzyyyyyxxxxx 11110www 101zzzzz 101yyyyy 101xxxxx
    U+40000..U+3FFFFF            0vvwwwwwzzzzzyyyyyxxxxx 111110vv 101wwwww 101zzzzz 101yyyyy 101xxxxx
   U+400000..U+3FFFFFF       0uvvvvvwwwwwzzzzzyyyyyxxxxx 1111110u 101vvvvv 101wwwww 101zzzzz 101yyyyy 101xxxxx
- U+4000000..U+7FFFFFFF 0tuuuuuvvvvvwwwwwzzzzzyyyyyxxxxx 1111111t 101uuuuu 101vvvvv 101wwwww 101zzzzz 101yyyyy 101xxxxx
+ U+4000000..U+3FFFFFFF 00uuuuuvvvvvwwwwwzzzzzyyyyyxxxxx 11111110 101uuuuu 101vvvvv 101wwwww 101zzzzz 101yyyyy 101xxxxx
 
-  Note: The I8 transformation is valid for UCS-4 values X'0' to
-  X'7FFFFFFF' (the full extent of ISO/IEC 10646 coding space).
+Beyond this, Perl uses an incompatible extension, similar to the one used in
+regular UTF-8.  There are now 14 bytes.  A full 32 bits of information thus looks like this:
+                                                        1st Byte  2nd-7th 8th Byte 9th Byte 10th B   11th B   12th B   13th B   14th B
+U+40000000..U+FFFFFFFF ttuuuuuvvvvvwwwwwzzzzzyyyyyxxxxx 11111111 10100000 101000tt 101uuuuu 101vvvvv 101wwwww 101zzzzz 101yyyyy 101xxxxx
 
- */
+For 32-bit words, the 2nd through 7th bytes effectively function as leading
+zeros.  Above 32 bits, these fill up, with each byte yielding 5 bits of
+information, so that with 13 continuation bytes, we can handle 65 bits, just
+above what a 64 bit word can hold */
 
 /* Input is a true Unicode (not-native) code point */
 #define OFFUNISKIP(uv) ( (uv) < 0xA0        ? 1 :                   \
@@ -193,7 +206,8 @@ END_EXTERN_C
                        (uv) < 0x4000           ? 3 :                       \
                        (uv) < 0x40000          ? 4 :                       \
                        (uv) < 0x400000         ? 5 :                       \
-                       (uv) < 0x4000000        ? 6 : UTF8_MAXBYTES )
+                       (uv) < 0x4000000        ? 6 :                       \
+                       (uv) < 0x40000000       ? 7 : UTF8_MAXBYTES )
 
 /* UTF-EBCDIC semantic macros - We used to transform back into I8 and then
  * compare, but now only have to do a single lookup by using a bit in
@@ -221,10 +235,6 @@ END_EXTERN_C
 #define isUTF8_POSSIBLY_PROBLEMATIC(c)                                          \
                 _generic_isCC(c, _CC_UTF8_START_BYTE_IS_FOR_AT_LEAST_SURROGATE)
 
-/* Can't exceed 7 on EBCDIC platforms */
-#define UTF_START_MARK(len) (0xFF & (0xFE << (7-(len))))
-
-#define UTF_START_MASK(len) (((len) >= 6) ? 0x01 : (0x1F >> ((len)-2)))
 #define UTF_CONTINUATION_MARK          0xA0
 #define UTF_CONTINUATION_MASK          ((U8)0x1f)
 #define UTF_ACCUMULATION_SHIFT         5